frmquery.frm

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

      BackColorBkg    =   12648447
      SelectionMode   =   1
      AllowUserResizing=   3
      RowSizingMode   =   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
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
End
Attribute VB_Name = "frmQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub chkAge_Click()
    If chkAge.Value = 1 Then
        txtAge(0).Enabled = True
        txtAge(1).Enabled = True
    Else
        txtAge(0).Enabled = False
        txtAge(1).Enabled = False
    End If
End Sub

Private Sub chkDate_Click()
    If chkDate.Value = 1 Then
        dtpDate(0).Enabled = True
        dtpDate(1).Enabled = True
        
        dtpDate(0).SetFocus
    Else
        dtpDate(0).Enabled = False
        dtpDate(1).Enabled = False
    End If
End Sub

Private Sub chkDWei_Click()
    If chkDWei.Value = 1 Then
        cmbDWei.Enabled = True
    Else
        cmbDWei.Enabled = False
    End If
End Sub

Private Sub chkHealthID_Click()
    If chkHealthID.Value = 1 Then
        txtHealthID.Enabled = True
        txtHealthID.SetFocus
    Else
        txtHealthID.Enabled = False
    End If
End Sub

Private Sub chkName_Click()
    If chkName.Value = 1 Then
        txtName.Enabled = True
        txtName.SetFocus
    Else
        txtName.Enabled = False
    End If
End Sub

Private Sub chkSelfBH_Click()
    If chkSelfBH.Value = 1 Then
        txtSelfBH.Enabled = True
    Else
        txtSelfBH.Enabled = False
    End If
End Sub

Private Sub chkSex_Click()
    If chkSex.Value = 1 Then
        cmbSex.Enabled = True
        cmbSex.SetFocus
    Else
        cmbSex.Enabled = False
    End If
End Sub

Private Sub ChkSFZH_Click()
    If ChkSFZH.Value = 1 Then
        TxtSFZH.Enabled = True
        TxtSFZH.SetFocus
    Else
        TxtSFZH.Enabled = False
    End If
End Sub

Private Sub cmbDWei_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub CmbPXFC_Click()
    Select Case CmbPXFC.Text
        Case "自定义编号"
            gintPXFC = 2
        Case "健康档案号"
            gintPXFC = 1
        Case "姓名"
            gintPXFC = 4
        Case "体检日期"
            gintPXFC = 7
    End Select
    MSHFlexGrid1.col = gintPXFC
    MSHFlexGrid1.Sort = 5

End Sub

Private Sub cmbSex_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub cmdBrowser_Click()
    If Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0) = "" Then
        MsgBox "请在右边的网格中选择一个客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    frmTJResult.ShowPersonInfo Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0), Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 4)
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
    
    cmdBrowser.Enabled = False
    
    strGSQL = "select SET_GRXX.GUID as 流水号,TJSerialNum as 序号,SelfBH as 档案号,YYRXM as 姓名,Sex as 性别,Age as 年龄,单位='',SET_GRXX.TJRQ as 体检日期" _
            & ",体检类型='散检',YYRBGDH as 办公电话,YYRJTDH as 家庭电话,YYRYDDH as 移动电话,EMail as 'E-mail'" _
            & " from SET_GRXX,YY_SJDJ" _
            & " where ((YYID is null) or (YYID=''))" _
            & " and SET_GRXX.GUID=YY_SJDJ.GUID"
    strTSQL = "select SET_GRXX.GUID as 流水号,TJSerialNum as 序号,SelfBH as 档案号,YYRXM as 姓名,Sex as 性别,Age as 年龄,DWMC as 单位,SET_GRXX.TJRQ as 体检日期" _
            & ",体检类型='团检',YYRBGDH as 办公电话,YYRJTDH as 家庭电话,YYRYDDH as 移动电话,EMail as 'E-mail'" _
            & " from SET_GRXX,YY_TJDJ,SET_DW" _
            & " where not (SET_GRXX.YYID is null)" _
            & " and SET_GRXX.YYID=YY_TJDJ.YYID" _
            & " and YY_TJDJ.DWID=SET_DW.DWID"
    
    '构造条件语句
    If chkName.Value = 1 Then '姓名
        strQuery1 = strQuery1 & " and YYRXM like '%" & txtName.Text & "%'"
    End If
    If chkHealthID.Value = 1 Then '健康档案号
        strQuery1 = strQuery1 & " and (SET_GRXX.HealthID like '%" & txtHealthID.Text & "%'" _
                & " or SET_GRXX.SelfBH like '%" & txtHealthID.Text & "%')"
    End If
        
    '自定义编号
    If chkSelfBH.Value = 1 Then
        strQuery1 = strQuery1 & " and SelfBH like '%" & txtSelfBH.Text & "%'"
    End If
    '*****************20040416加入 闻******************************
    '身份证号
    If ChkSFZH.Value = 1 Then
        strQuery1 = strQuery1 & " and YYRSFZH like '%" & txtSelfBH.Text & "%'"
    End If
    '*****************20040416加入完 闻******************************
    If chkSex.Value = 1 Then '性别
        strQuery1 = strQuery1 & " and Sex='" & cmbSex.Text & "'"
    End If
    
    strQuery2 = strQuery1
    
    If chkDate.Value = 1 Then '体检日期
        If dtpDate(0).Value > dtpDate(1).Value Then
            MsgBox "登记起始日期不能大于终止日期！", vbInformation, "提示"
            dtpDate(0).SetFocus
            Exit Sub
        End If
        strQuery1 = strQuery1 & " and SET_GRXX.TJRQ>='" & dtpDate(0).Value & "'" _
                & " and SET_GRXX.TJRQ<='" & dtpDate(1).Value & " 23:59:59'"
        strQuery2 = strQuery2 & " and SET_GRXX.TJRQ>='" & dtpDate(0).Value & "'" _
                & " and SET_GRXX.TJRQ<='" & dtpDate(1).Value & " 23:59:59'"
    End If
    If chkAge.Value = 1 Then '年龄
        If (txtAge(0).Text = "") Or (txtAge(1).Text = "") Then
            MsgBox "请输入年龄！", vbInformation, "提示"
            txtAge(0).SetFocus
            Exit Sub
        End If
        
        If Val(txtAge(0).Text) > Val(txtAge(1).Text) Then
            MsgBox "起始年龄不能大于大于终止年龄！", vbInformation, "提示"
            Exit Sub
        End If
        
        strQuery1 = strQuery1 & " and Age>=" & Val(txtAge(0).Text) _
                & " and Age<=" & Val(txtAge(1).Text)
        strQuery2 = strQuery2 & " and Age>=" & Val(txtAge(0).Text) _
                & " and Age<=" & Val(txtAge(1).Text)
    End If
    
    If chkDWei.Value = 1 Then '单位
        If cmbDWei.Text = "" Then
            MsgBox "请选择单位名称！", vbInformation, "提示"
            cmbDWei.SetFocus
            Exit Sub
        End If
        strQuery2 = strQuery2 & " and YY_TJDJ.DWID='" _
                & LongToString(cmbDWei.ItemData(cmbDWei.ListIndex), 5) & "'"
    End If
    
    '构建最后的sql语句
    strGSQL = strGSQL & strQuery1
    strTSQL = strTSQL & strQuery2 & " order by 体检日期"
    If chkDWei.Value = 1 Then '单位
        strSQL = strTSQL
    Else
        strSQL = strGSQL & " union " & strTSQL
    End If
    
    '执行查询
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rstemp.RecordCount >= 1 Then
        '按花名册形式显示名单
'        With Me.MSHFlexGrid1
'            .Rows = rsTemp.RecordCount + 2
'
'        End With
        
        rstemp.Close
        Set rstemp = Nothing
        
        
        RefreshGrid Me, MSHFlexGrid1, strSQL
        '选中第一行
        Me.MSHFlexGrid1.Row = 1
        Me.MSHFlexGrid1.col = 0
        Me.MSHFlexGrid1.ColSel = Me.MSHFlexGrid1.Cols - 1
        MSHFlexGrid1_Click
    Else
        MsgBox "没有找到匹配记录！请重新输入查询条件", vbInformation, "提示"
    End If
    
    Exit Sub
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Sub

Private Sub dtpDate_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        KeyCode = 0
        cmdQuery_Click
    End If
End Sub

Private Sub Form_Load()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    
'    Me.Width = 12960
'    Me.Height = 8250
    
    '****************************会员卡接口控制20040505加入***********************
    If gICSupport = False Then
        FrmHYKGL.Enabled = False
    End If
    '****************************会员卡接口控制完*********************************

    cmbSex.ListIndex = 0
    dtpDate(0).Value = Date
    dtpDate(1).Value = Date
    With Me.MSHFlexGrid1
        .ColWidth(0) = 0
'        .Cols = 13
'        .MergeCol(9) = True
'        .MergeCol(10) = True
'        .MergeCol(11) = True
'        .MergeCol(12) = True
'        .TextMatrix(0, 0) = "序号"
'        .TextMatrix(0, 1) = "卡号"
'        .TextMatrix(0, 2) = "姓名"
'        .TextMatrix(0, 3) = "性别"
'        .TextMatrix(0, 4) = "出生日期"
'        .TextMatrix(0, 5) = "年龄"
'        .TextMatrix(0, 6) = "单位"
'        .TextMatrix(0, 7) = "体检日期"
'        .TextMatrix(0, 8) = "体检类型"
'        .TextMatrix(0, 9) = "联系方式"
'        .TextMatrix(0, 10) = "联系方式"
'        .TextMatrix(0, 11) = "联系方式"
'        .TextMatrix(0, 12) = "联系方式"
'        .TextMatrix(1, 9) = "单位"
'        .TextMatrix(1, 10) = "家庭"
'        .TextMatrix(1, 11) = "手机"
'        .TextMatrix(1, 12) = "E-mail"
    End With
    
    '加载单位名称
    strSQL = "select DWID,DWMC from SET_DW"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rstemp.RecordCount >= 1 Then
        rstemp.MoveFirst
        Do
            cmbDWei.AddItem rstemp("DWMC")
            cmbDWei.ItemData(cmbDWei.NewIndex) = rstemp("DWID")
            rstemp.MoveNext
        Loop Until rstemp.EOF
        rstemp.Close
    End If
    Set rstemp = Nothing

    Exit Sub
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmQuery = Nothing
End Sub

Private Sub MSHFlexGrid1_Click()
    If Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0) <> "" Then
        cmdBrowser.Enabled = True
    Else
        cmdBrowser.Enabled = False
    End If
End Sub

Private Sub MSHFlexGrid1_DblClick()
    If Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0) <> "" Then
        cmdBrowser_Click
    End If
End Sub

Private Sub txtAge_Change(Index As Integer)
    txtAge(Index).Text = Val(txtAge(Index).Text)
End Sub

Private Sub txtAge_KeyPress(Index As Integer, KeyAscii As Integer)
    If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
        If (KeyAscii < vbKey0) Or (KeyAscii > vbKey9) Then
            Beep 50, 10
            KeyAscii = 0
        End If
        
        If Len(txtAge(Index).Text) >= 4 Then
            MsgBox "您输入的数字太长了吧！", vbInformation, "提示"
            KeyAscii = 0
            txtAge(Index).SetFocus
            Exit Sub
        End If
    End If
    
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub txtHealthID_KeyPress(KeyAscii As Integer)
'    If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) And (KeyAscii <> vbKeyA) Then
'        If (KeyAscii < vbKey0) Or (KeyAscii > vbKey9) Then
'            Beep 50, 10
'            KeyAscii = 0
'        End If
'    End If
    
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub TxtICKNum_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub txtName_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub txtSelfBH_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub

Private Sub TxtSFZH_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdQuery_Click
    End If
End Sub