frmquery_b.frm

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

        TxtICKNum.Enabled = False
    End If
End Sub

Private Sub chkName_Click()
    If chkName.Value = 1 Then
        txtName.Enabled = True
    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
    Else
        cmbSex.Enabled = False
    End If
End Sub

Private Sub ChkSFZH_Click()
    If ChkSFZH.Value = 1 Then
        TxtSFZH.Enabled = True
    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 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(1, 0) = "" Then
        MsgBox "请先设置查询条件，然后单击“查询”按钮！", vbInformation, "提示"
        Exit Sub
    End If
    
    '当前是否选择了客户
    If Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0) = "" Then
        MsgBox "请在左边的网格中选择一个客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    Screen.MousePointer = vbArrowHourglass
    If genuVersion = WLB Then
        Load frmRegister
        frmRegister.ReCheck Val(Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0)), True
        frmRegister.ZOrder 0
    ElseIf (genuVersion = BZB Or genuVersion = PJB Or genuVersion = ZYB) Then
        Load FrmBZB_Input
        FrmBZB_Input.ReCheck Val(Me.MSHFlexGrid1.TextMatrix(Me.MSHFlexGrid1.Row, 0)), True
        FrmBZB_Input.ZOrder 0
    End If
    Screen.MousePointer = vbDefault
    'Unload Me
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
    
    '***************************20040507加入 闻*********************************
    '会员卡号
    If ChkHYKGL.Value = 1 Then
        strGSQL = "select SET_GRXX.GUID as 流水号,SET_GRXX.HealthID as 健康档案号,TJSerialNum as 体检序号,YYRXM as 姓名,Sex as 性别,YYRSFZH as 身份证号,SET_GRXX.TJRQ as 体检日期,SET_ICKGL_Index.HealthID,ICKNum" _
                & " from SET_GRXX,YY_SJDJ,SET_ICKGL_Index" _
                & " where ((YYID is null) or (YYID=''))" _
                & " and SFTJ=2" _
                & " and SET_GRXX.GUID=YY_SJDJ.GUID"
        strTSQL = "select SET_GRXX.GUID as 流水号,SET_GRXX.HealthID as 健康档案号,TJSerialNum as 体检序号,YYRXM as 姓名,Sex as 性别,YYRSFZH as 身份证号,SET_GRXX.TJRQ as 体检日期,SET_ICKGL_Index.HealthID,ICKNum" _
                & " from SET_GRXX,YY_TJDJ,SET_ICKGL_Index" _
                & " where not (SET_GRXX.YYID is null)" _
                & " and SFTJ=2" _
                & " and SET_GRXX.YYID=YY_TJDJ.YYID"
        strQuery1 = strQuery1 & " and SET_GRXX.HealthID=SET_ICKGL_Index.HealthID and ICKNum like '%" & TxtICKNum.Text & "&'"
    Else
        strGSQL = "select SET_GRXX.GUID as 流水号,HealthID as 健康档案号,TJSerialNum as 体检序号,YYRXM as 姓名,Sex as 性别,YYRSFZH as 身份证号,SET_GRXX.TJRQ as 体检日期" _
                & " from SET_GRXX,YY_SJDJ" _
                & " where ((YYID is null) or (YYID=''))" _
                & " and SFTJ=2" _
                & " and SET_GRXX.GUID=YY_SJDJ.GUID"
        strTSQL = "select SET_GRXX.GUID as 流水号,HealthID as 健康档案号,TJSerialNum as 体检序号,YYRXM as 姓名,Sex as 性别,YYRSFZH as 身份证号,SET_GRXX.TJRQ as 体检日期" _
                & " from SET_GRXX,YY_TJDJ" _
                & " where not (SET_GRXX.YYID is null)" _
                & " and SFTJ=2" _
                & " and SET_GRXX.YYID=YY_TJDJ.YYID"
    End If
    '***************************20040507加入完 闻*******************************
    
    '构造条件语句
    If chkName.Value = 1 Then '姓名
        strQuery1 = strQuery1 & " and YYRXM like '%" & txtName.Text & "%'"
    End If
    If chkHealthID.Value = 1 Then '健康档案号
        strQuery1 = strQuery1 & " and HealthID 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 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
        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, "提示"
        
'        If chkName.Value = True Then '姓名
'            txtName.SetFocus
'        ElseIf chkHealthID.Value = True Then '健康档案号
'            txtHealthID.SetFocus
'        ElseIf chkSex.Value = True Then '性别
'            cmbSex.SetFocus
'        ElseIf chkDate.Value = True Then '体检日期
'            dtpDate(0).SetFocus
'        ElseIf chkDWei.Value = True Then '单位
'            cmbDWei.SetFocus
'        ElseIf chkAge.Value = True Then '年龄
'            txtAge(0).SetFocus
'        Else '身高
'            txtSGao(1).SetFocus
'        End If
    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
    Me.MSHFlexGrid1.ColWidth(0) = 0
    
    '加载单位名称
    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_B = 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) >= 5 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_Change()
'    txtHealthID.Text = Val(txtHealthID.Text)
End Sub

Private Sub txtHealthID_KeyPress(KeyAscii As Integer)
    If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) 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