frmbatchinput.frm

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

    dtpBegin.Value = Date
    dtpStop.Value = Date
    
    Me.MSHFlexGrid1.ColWidth(0) = 0 'GUID
    If Not g_blnSystemID Then
        Me.MSHFlexGrid1.ColWidth(1) = False '系统档案号
    End If
    If Not g_blnSelfID Then
        Me.MSHFlexGrid1.ColWidth(2) = False '自定义档案号
    End If

    Set rsDX = Nothing
    Set rsXX = Nothing
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Sub

Private Sub optDate_Click()
    dtpBegin.Enabled = True
    dtpStop.Enabled = True
    cmbDWei.Enabled = False
    txtBeginID.Enabled = False
    txtStopID.Enabled = False
    
    dtpBegin_Change
End Sub

Private Sub optDWei_Click()
    dtpBegin.Enabled = False
    dtpStop.Enabled = False
    cmbDWei.Enabled = True
    txtBeginID.Enabled = False
    txtStopID.Enabled = False
    
    cmbDWei_Click
End Sub

Private Sub optHealthID_Click()
    dtpBegin.Enabled = False
    dtpStop.Enabled = False
    cmbDWei.Enabled = False
    txtBeginID.Enabled = True
    txtStopID.Enabled = True
    
    txtBeginID_Change
End Sub

Private Sub tvwDXiang_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim strKey As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    Dim strTmpXMID As String
    
    '清除可能存在的输入
    cmdDelete_Click
    
    If tvwDXiang.SelectedItem Is Nothing Then
        lblTitle.Caption = ""
        CmbInfo.Visible = False
        CmdMB.Visible = False
        cmdSave.Enabled = False
        Exit Sub
    End If
    
    strKey = tvwDXiang.SelectedItem.Key
    
    If Len(strKey) <= 3 Then '选择了根节点或者科室节点
        lblTitle.Caption = ""
        lblDWei.Caption = ""
        CmbInfo.Visible = False
        CmdMB.Visible = False
        cmdSave.Enabled = False
        
    ElseIf Len(strKey) = 6 Then '选择了大项
        lblDWei.Caption = ""
        '判断是否含有子项
        lblTitle.Caption = ""
        CmbInfo.Visible = False
        CmdMB.Visible = False
        cmdSave.Enabled = False
        
    ElseIf Len(strKey) > 8 Then '选择了小项
        lblTitle.Caption = tvwDXiang.SelectedItem.Text & "："
        CmbInfo.Visible = True
        CmdMB.Visible = True
        
        '检查该小项的类型
        strSQL = "select XXType from SET_XX" _
                & " where XXID='" & Mid(tvwDXiang.SelectedItem.Key, 6, 7) & "'"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        If rstemp("XXType") = 1 Then
            CmbInfo.Tag = 1
        Else
            CmbInfo.Tag = ""
        End If
        
        '***************20040618加入 闻*********************
        '查找该项目的数据模板，并添加到CmbInfo中
        strTmpXMID = Mid(strKey, 6, 7)
        Set rstemp = New ADODB.Recordset
        strSQL = "select * from DM_XM_Value where XMID='" & strTmpXMID & "'"
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rstemp.RecordCount > 0 Then
            rstemp.MoveFirst
            Do While Not rstemp.EOF
                CmbInfo.AddItem rstemp("DMValue")
                rstemp.MoveNext
            Loop
        End If
        '***************20040618加入 闻*********************
        
'        lblDWei.Caption = rsTemp("XXDW")
'        cmbinfo.Text = ""
    End If
    
    Exit Sub
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Sub

Private Sub txtBeginID_Change()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    
    If (CheckHealthID(txtBeginID.Text) = True) And (CheckHealthID(txtStopID.Text) = True) Then
        '表明输入了正确的健康号
        strSQL = "select SET_GRXX.GUID as 流水号,HealthID as " & g_strSystemIDTitle _
                & ",SelfBH as " & g_strSelfIDTitle _
                & ",TJSerialNum as 体检序号,YYRXM as 姓名,SET_GRXX.TJRQ as 体检日期" _
                & " from SET_GRXX,YY_SJDJ" _
                & " where YYID is null" _
                & " and HealthID>='" & txtBeginID.Text & "'" _
                & " and HealthID<='" & txtStopID.Text & "'" _
                & " and SET_GRXX.GUID=YY_SJDJ.GUID"
        If genuVersion = WLB Then
            strSQL = strSQL & " and (SFTJ=1 or SFTJ=2)" _
                    & " and SET_GRXX.QRDJ=1"
        End If
        strSQL = strSQL & " and SET_GRXX.GUID not in (select GUID from DATA_ZJJL)" _
                & " union " _
                & "select SET_GRXX.GUID as 流水号,HealthID as " & g_strSystemIDTitle _
                & ",SelfBH as " & g_strSelfIDTitle _
                & ",TJSerialNum as 体检序号,YYRXM as 姓名,SET_GRXX.TJRQ as 体检日期" _
                & " from SET_GRXX,YY_TJDJ" _
                & " where not (SET_GRXX.YYID is null)" _
                & " and HealthID>='" & txtBeginID.Text & "'" _
                & " and HealthID<='" & txtStopID.Text & "'" _
                & " and SET_GRXX.YYID=YY_TJDJ.YYID"
        If genuVersion = WLB Then
            strSQL = strSQL & " and (SFTJ=1 or SFTJ=2)" _
                    & " and SET_GRXX.QRDJ=1"
        End If
        strSQL = strSQL & " and SET_GRXX.GUID not in (select GUID from DATA_ZJJL)" _
                & " order by 体检日期,YYRXM"
        
        RefreshGrid Me, Me.MSHFlexGrid1, strSQL
    End If
    
    Exit Sub
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Sub

Private Sub txtBeginID_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
        
        '校验长度
        If Len(txtBeginID.Text) >= 13 Then
            MsgBox "您输入的数字太长！", vbInformation, "提示"
            KeyAscii = 0
            Exit Sub
        End If
    End If
End Sub

Private Sub cmbinfo_Change()
    If CmbInfo.Text = "" Then
        cmdDelete.Enabled = False
    Else
        cmdDelete.Enabled = True
    End If
    
    If cmdSave.Enabled = False Then cmdSave.Enabled = True
    
    If CmbInfo.Tag = "1" Then
'        If Trim(cmbinfo.Text) <> "" Then
'            cmbinfo.Text = Val(cmbinfo.Text)
'        End If
    End If
End Sub

Private Sub cmdmb_Click()
On Error GoTo ErrMsg
    Dim strRet As String
    Dim strSQL As String
    Dim Status
    
    If Len(tvwDXiang.SelectedItem.Key) >= 8 Then '是小项
        '如果是数字型，无需弹出模板
        If CmbInfo.Tag = "1" Then Exit Sub
        
        '小结
        strSQL = "select XXDMID,DMValue from DM_XX where XXID='" _
                & Mid(tvwDXiang.SelectedItem.Key, 6, 7) & "'"
        
        '弹出模板框
        strRet = dlgSelTemplate.ShowTemplate(strSQL, 1)
        Unload dlgSelTemplate
        Set dlgSelTemplate = Nothing
        CmbInfo.Text = strRet
    End If
    
    Exit Sub
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
End Sub

Private Sub cmbinfo_GotFocus()
    CmbInfo.SelStart = 0
    CmbInfo.SelLength = Len(CmbInfo.Text)
End Sub

Private Sub cmbinfo_KeyPress(KeyAscii As Integer)
    If CmbInfo.Tag = "1" Then
        '不是回车和退格键的时候，校验长度和字符
        If (KeyAscii <> vbKeyBack) And (KeyAscii <> vbKeyReturn) Then
            '是否输入了数字
'            If (KeyAscii < vbKey0 Or KeyAscii > vbKey9) And KeyAscii <> 46 Then
'                Beep 50, 10
'                KeyAscii = 0
'            End If
            If ((KeyAscii < vbKey0) Or (KeyAscii > vbKey9)) And KeyAscii <> 46 Then
                Beep 50, 10
'                KeyAscii = 0
                Exit Sub
            End If
            
            '校验长度
            If Len(CmbInfo.Text) >= 5 Then
                MsgBox "您输入的数字太长！", vbInformation, "提示"
                KeyAscii = 0
                Exit Sub
            End If
        End If
    End If
    If KeyAscii = vbKeyReturn Then
        EnterToTab KeyAscii
    End If
End Sub

'校验健康号的合法性
Private Function CheckHealthID(ByVal strHealthID As String) As Boolean
    Dim datDate As Date
    Dim strDate As String
    
    CheckHealthID = False
    
    If (Len(strHealthID) = 12) Or (Len(strHealthID) = 13) Then
        strDate = Left(strHealthID, 4) & "-" & Mid(strHealthID, 5, 2) & "-" & Mid(strHealthID, 7, 2)
        If IsDate(strDate) Then
            CheckHealthID = True
        End If
    End If
End Function

Private Sub txtStopID_Change()
    txtBeginID_Change
End Sub

Private Sub txtStopID_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
        
        '校验长度
        If Len(txtStopID.Text) >= 13 Then
            MsgBox "您输入的数字太长！", vbInformation, "提示"
            KeyAscii = 0
            Exit Sub
        End If
    End If
End Sub

'版本控制
Private Sub VersionControl()
    If genuVersion <> WLB Then
        optHealthID.Visible = False
        txtBeginID.Visible = False
        Label1(1).Visible = False
        txtStopID.Visible = False
        fraCondition.Height = fraCondition.Height - txtStopID.Height
    End If
End Sub