frmquery_a.frm

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

                End If
            Next j
            '每个客户提交一次打印任务
            Printer.EndDoc
        End If
    Next i
        
    Me.MousePointer = vbDefault
    
    Exit Sub
Print_Cancel:
    MousePointer = vbDefault
    If Err.Number <> cdlCancel Then
        Status = SetError(Err.Number, "无法完成打印，请确认打印机电源已经开启并与计算机正确连接！:" _
                & vbCrLf & Err.Description, Err.Source)
        ErrMsg Status
    End If
End Sub

Private Sub cmdPrintUniversal_Click()
    Dim i As Integer
    
    '是否有客户
    If Me.lvwSJRY.ListItems.Count < 1 Then
        MsgBox "当前没有要打印资料的客户！请在左侧设置查询条件，然后单击“查询”列出要打印资料的客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    '是否有选择客户
    If Me.lvwSJRY.SelectedItem Is Nothing Then
        MsgBox "当前没有选择要打印资料的客户！请在下方的列表中选择要打印资料的客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    '循环每一个人
    For i = 1 To lvwSJRY.ListItems.Count
        If lvwSJRY.ListItems(i).Selected = True Then
            PrintUniversalReport Val(Mid(lvwSJRY.ListItems(i).Key, 2)), txtUniversal, txtLongText, Printer
        End If
    Next i
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_GRXX.GUID as 流水号,HealthID as " & g_strSystemIDTitle _
            & ",SelfBH as " & g_strSelfIDTitle & ",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 in (1,2)" _
            & " and SET_GRXX.GUID=YY_SJDJ.GUID"
    strTSQL = "select SET_GRXX.GUID as 流水号,HealthID as " & g_strSystemIDTitle _
            & ",SelfBH as " & g_strSelfIDTitle & ",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 in (1,2)" _
            & " and SET_GRXX.YYID=YY_TJDJ.YYID"
            
    '构造条件语句
    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 & "%'" _
                & " or SelfBH like '%" & txtHealthID.Text & "%')"
    End If
    
    '*****************20040416加入 闻******************************
    '身份证号
    If ChkSFZH.Value = 1 Then
        strQuery1 = strQuery1 & " and YYRSFZH like '%" & TxtSFZH.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 Not rsTemp.EOF 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, "提示"
    End If
    
    lvwSJRY_Click
    
    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
    
    cmbSex.ListIndex = 0
    dtpDate(0).Value = Date
    dtpDate(1).Value = Date
    
    SetResize txtTemp.hWnd, Me.hWnd
    
    '加载单位名称
    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
    
    '加载所有报表组合
    strSQL = "select * from REPORT_ZH"
    Set rsTemp = New ADODB.Recordset
    rsTemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If Not rsTemp.EOF Then
        rsTemp.MoveFirst
        Do
            cmbBBZH.AddItem rsTemp("ZHMC")
            cmbBBZH.ItemData(cmbBBZH.NewIndex) = rsTemp("ZHID")
            
            rsTemp.MoveNext
        Loop Until rsTemp.EOF
        rsTemp.Close
        
        '选中第一个组合
        cmbBBZH.ListIndex = 0
    End If
    
    '设置ListView的列名及列宽
    Call SetObjectTitleAndWidth(Me.lvwSJRY, 1, 2)
    
    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_A = Nothing
End Sub

Private Sub lvwSJRY_Click()
    If Not (Me.lvwSJRY.SelectedItem Is Nothing) Then
        EnablCommand True
    Else
        EnablCommand False
    End If
End Sub

Private Sub lvwSJRY_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    If mintlvPXFC = 1 Then
         mintlvPXFC = 0
         lvwSJRY.SortOrder = lvwAscending
    Else
        mintlvPXFC = 1
        lvwSJRY.SortOrder = lvwDescending
    End If
    '单击 ColumnHeader 对象时，将根据
    '那一列的子项目把 ListView 控件排序。
    '设置 SortKey 为 ColumnHeader 的索引值减 1
    lvwSJRY.SortKey = ColumnHeader.Index - 1
    '设置 Sorted 为 True 以将列表排序。
    lvwSJRY.Sorted = True

End Sub

Private Sub lvwSJRY_DblClick()
    If Me.lvwSJRY.SelectedItem Is Nothing Then
'        MsgBox "请在右边的网格中选择一个客户！", vbInformation, "提示"
        Exit Sub
    End If
    
    frmTJResult.ShowPersonInfo Val(Mid(Me.lvwSJRY.SelectedItem.Key, 2)), Me.lvwSJRY.SelectedItem.SubItems(4)
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_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 EnablCommand(ByVal blnFlag As Boolean)
    cmdPrintUniversal.Enabled = blnFlag
    cmdPreviewUniversal.Enabled = blnFlag
End Sub

Private Sub txtName_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