frmickgl.frm

本系统可用于医院和专业体检中心的健康体检管理

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0B81E4A9-BE4E-4AEF-9272-33AB5B51C6FC}#1.0#0"; "XPControls.ocx"
Begin VB.Form FrmICKGL 
   BackColor       =   &H80000018&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "会员卡注销"
   ClientHeight    =   5850
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8415
   Icon            =   "FrmICKGL.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5850
   ScaleWidth      =   8415
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      BackColor       =   &H80000018&
      Caption         =   "查询条件"
      Height          =   750
      Left            =   90
      TabIndex        =   4
      Top             =   60
      Width           =   8235
      Begin VB.TextBox txtName 
         Height          =   315
         Left            =   690
         TabIndex        =   5
         Top             =   300
         Width           =   1845
      End
      Begin MSComCtl2.DTPicker dtpDate 
         Height          =   315
         Index           =   0
         Left            =   4290
         TabIndex        =   6
         Top             =   300
         Width           =   1275
         _ExtentX        =   2249
         _ExtentY        =   556
         _Version        =   393216
         Format          =   61669377
         CurrentDate     =   37987
      End
      Begin MSComCtl2.DTPicker dtpDate 
         Height          =   315
         Index           =   1
         Left            =   6030
         TabIndex        =   7
         Top             =   300
         Width           =   1275
         _ExtentX        =   2249
         _ExtentY        =   556
         _Version        =   393216
         Format          =   61669377
         CurrentDate     =   37987
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "到"
         Height          =   285
         Index           =   2
         Left            =   5670
         TabIndex        =   10
         Top             =   345
         Width           =   255
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "姓名"
         Height          =   195
         Left            =   270
         TabIndex        =   9
         Top             =   360
         Width           =   495
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "体检日期"
         Height          =   225
         Left            =   3420
         TabIndex        =   8
         Top             =   345
         Width           =   855
      End
   End
   Begin VB.Frame Frame9 
      BackColor       =   &H80000018&
      Caption         =   "操作"
      Height          =   975
      Left            =   90
      TabIndex        =   0
      Top             =   4740
      Width           =   8235
      Begin XPControls.XPCommandButton cmdExit 
         Height          =   405
         Left            =   5850
         TabIndex        =   1
         Top             =   330
         Width           =   1245
         _ExtentX        =   2196
         _ExtentY        =   714
         Caption         =   "退出"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin XPControls.XPCommandButton cmdQuery 
         Height          =   405
         Left            =   1185
         TabIndex        =   2
         Top             =   330
         Width           =   1245
         _ExtentX        =   2196
         _ExtentY        =   714
         Caption         =   "查询"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin XPControls.XPCommandButton cmdZhuXiao 
         Height          =   405
         Left            =   3517
         TabIndex        =   3
         Top             =   330
         Width           =   1245
         _ExtentX        =   2196
         _ExtentY        =   714
         Caption         =   "注销"
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
   End
   Begin MSComctlLib.ListView lvwSJRY 
      Height          =   3795
      Left            =   90
      TabIndex        =   11
      Top             =   870
      Width           =   8235
      _ExtentX        =   14526
      _ExtentY        =   6694
      View            =   3
      LabelEdit       =   1
      MultiSelect     =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   0   'False
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   12648384
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      NumItems        =   7
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Text            =   "健康档案号"
         Object.Width           =   2364
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   1
         Text            =   "卡号"
         Object.Width           =   2011
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "体检序号"
         Object.Width           =   1588
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "姓名"
         Object.Width           =   1940
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "性别"
         Object.Width           =   1059
      EndProperty
      BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   5
         Text            =   "身份证号"
         Object.Width           =   2647
      EndProperty
      BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   6
         Text            =   "体检日期"
         Object.Width           =   2540
      EndProperty
   End
End
Attribute VB_Name = "FrmICKGL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub cmdExit_Click()
    Me.Hide
    Set FrmICKGL = Nothing
    
End Sub

Private Sub cmdQuery_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim strGSQL As String
    Dim strTSQL As String
    Dim strQuery1 As String '条件串
    Dim strQuery2 As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    Dim itmTemp As ListItem
    
'    EnablCommand False
    
    strGSQL = "select SET_ICKGL_Index.HealthID as ICKHealthID" _
            & ",SET_GRXX.SelfBH as " & g_strSelfIDTitle _
            & ",SET_ICKGL_Index.ICKNum as 卡号,SET_GRXX.GUID as 流水号" _
            & ",SET_GRXX.HealthID as " & g_strSystemIDTitle & ",TJSerialNum as 体检序号" _
            & ",YYRXM as 姓名,Sex as 性别,YYRSFZH as 身份证号,SET_GRXX.TJRQ as 体检日期" _
            & " from SET_ICKGL_Index,SET_GRXX,YY_SJDJ" _
            & " where ((YYID is null) or (YYID=''))" _
            & " and (SFTJ=2 or SFTJ=1 or SFTJ=0)" _
            & " and SET_ICKGL_INDEX.Status=0" _
            & " and SET_GRXX.GUID=YY_SJDJ.GUID" _
            & " and SET_ICKGL_Index.HealthID=SET_GRXX.HealthID"
    strTSQL = "select SET_ICKGL_Index.HealthID as ICKHealthID" _
            & ",SET_GRXX.SelfBH as " & g_strSelfIDTitle _
            & ",SET_ICKGL_Index.ICKNum as 卡号,SET_GRXX.GUID as 流水号" _
            & ",SET_GRXX.HealthID as " & g_strSystemIDTitle & ",TJSerialNum as 体检序号" _
            & ",YYRXM as 姓名,Sex as 性别,YYRSFZH as 身份证号,SET_GRXX.TJRQ as 体检日期" _
            & " from SET_ICKGL_Index,SET_GRXX,YY_TJDJ" _
            & " where not (SET_GRXX.YYID is null)" _
            & " and (SFTJ=2 or SFTJ=1 or SFTJ=0)" _
            & " and SET_ICKGL_INDEX.Status=0" _
            & " and SET_GRXX.YYID=YY_TJDJ.YYID" _
            & " and SET_ICKGL_Index.HealthID=SET_GRXX.HealthID"
    '构造条件语句
    If txtName.Text <> "" Then '姓名
        strQuery1 = strQuery1 & " and YYRXM like '%" & txtName.Text & "%'"
    End If
    
    strQuery2 = strQuery1
    
    If dtpDate(0).Value > dtpDate(1).Value Then
        MsgBox "起始日期不能大于终止日期！", vbInformation, "提示"
        dtpDate(0).SetFocus
        Exit Sub
    ElseIf dtpDate(1).Value > Date Then
        MsgBox "终止日期不能大于当天日期!", vbInformation, "提示"
        dtpDate(1).SetFocus
        Exit Sub
    End If
    strQuery1 = strQuery1 & " and SET_GRXX.TJRQ>='" & dtpDate(0).Value & "'" _
            & " and SET_GRXX.TJRQ<='" & dtpDate(1).Value & "'"
    strQuery2 = strQuery2 & " and SET_GRXX.TJRQ>='" & dtpDate(0).Value & "'" _
            & " and SET_GRXX.TJRQ<='" & dtpDate(1).Value & "'"
    
    '构建最后的sql语句
    strGSQL = strGSQL & strQuery1
    strTSQL = strTSQL & strQuery2 & " order by 体检日期"
    strSQL = strGSQL & " union " & strTSQL
    
    '执行查询
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rstemp.RecordCount >= 1 Then
        rstemp.MoveFirst
        lvwSJRY.ListItems.Clear
        Do
            Set itmTemp = lvwSJRY.ListItems.Add(, "W" & rstemp("流水号"), rstemp(g_strSystemIDTitle))
            itmTemp.SubItems(1) = rstemp(g_strSelfIDTitle) & ""
            itmTemp.SubItems(2) = rstemp("体检序号")
            itmTemp.SubItems(3) = rstemp("姓名")
            itmTemp.SubItems(4) = rstemp("性别")
            itmTemp.SubItems(5) = rstemp("身份证号")
            itmTemp.SubItems(6) = rstemp("体检日期")
            
            rstemp.MoveNext
        Loop Until rstemp.EOF
        rstemp.Close
        Set rstemp = Nothing
        
        '选中第一行
        Set lvwSJRY.SelectedItem = lvwSJRY.ListItems(1)

'        mstrSQL = strSQL
        
'        EnablCommand True
    Else
        MsgBox "没有找到匹配记录！请重新输入查询条件", vbInformation, "提示"
        lvwSJRY.ListItems.Clear
    End If
    
'    lvwSJRY_Click
    
    Exit Sub
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Sub

Private Sub cmdZhuXiao_Click()
    Dim cmdTemp As ADODB.Command
    Dim strSQL As String
    
    Me.MousePointer = vbHourglass
    '是否有选择
    If lvwSJRY.SelectedItem Is Nothing Then GoTo ExitLab
    
    If lvwSJRY.SelectedItem <> "" Then
        If SendCardW(Me.lvwSJRY.SelectedItem.Text, "", GCon, True) = True Then
            cmdQuery_Click
        End If
    End If
    
    GoTo ExitLab
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    Me.dtpDate(1).Value = Date
    
    '设置列名和列宽
    Call SetObjectTitleAndWidth(Me.lvwSJRY, 1, 2)
End Sub