formtjbzwh.frm

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

    GCon.Execute "update set_xx_bz set zcz='正常值'  where BZ_ID=" & Val(cmbBZMC.ItemData(cmbBZMC.ListIndex)) _
                    & " and XX_ID='" & Mid(tvwXMu.SelectedItem.Key, 2) & "'" _
                    & " and Sex=" & intSex & "and Xindex=" & LsvBZ.SelectedItem.Index
                
    tvwXMuClick
End Sub

Private Sub Form_Load()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim nodTemp As Node
    Dim rsKShi As ADODB.Recordset
    Dim rsDX As ADODB.Recordset
    Dim rsXX As ADODB.Recordset
    
    Screen.MousePointer = vbArrowHourglass
    
    '根节点
    Set nodTemp = tvwXMu.Nodes.Add(, , "W", "所有项目")
    nodTemp.Expanded = True
    
    '显示所有科室
    strSQL = "select KSID,KSMC from SET_KSSZ"
    '按顺序号排序
    strSQL = strSQL & " order by SXH"
    Set rsKShi = New ADODB.Recordset
    rsKShi.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rsKShi.RecordCount > 0 Then
        rsKShi.MoveFirst
        Do
            '添加科室
            '关键字长度：1＋2＝3
            Set nodTemp = tvwXMu.Nodes.Add("W", tvwChild, "W" & rsKShi("KSID"), rsKShi("KSMC"))
            
            strSQL = "select XXID,XXMC from SET_XX" _
                    & " where left(XXID,2)='" & rsKShi("KSID") & "'"
            '按顺序号排序
            strSQL = strSQL & " order by SXH"
            Set rsXX = New ADODB.Recordset
            rsXX.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
            If rsXX.RecordCount > 0 Then
                rsXX.MoveFirst
                Do
                    '关键字长度：1＋7＝8
                    tvwXMu.Nodes.Add "W" & rsKShi("KSID"), tvwChild, "W" & rsXX("XXID"), rsXX("XXMC")
                    
                    rsXX.MoveNext
                Loop Until rsXX.EOF
                rsXX.Close
            End If
            
            rsKShi.MoveNext
        Loop Until rsKShi.EOF
        rsKShi.Close
    End If
    
    '加载所有体检标准
    strSQL = "select BZID,BZMC from SET_TJBZIndex where SFQY=1"
    Set rsXX = New ADODB.Recordset
    rsXX.Open strSQL, GCon, adOpenStatic, adLockOptimistic
    If rsXX.RecordCount > 0 Then
        rsXX.MoveFirst
        Do
            cmbBZMC.AddItem rsXX("BZMC")
            cmbBZMC.ItemData(cmbBZMC.NewIndex) = rsXX("BZID")
            
            rsXX.MoveNext
        Loop Until rsXX.EOF
        rsXX.Close
        
        cmbBZMC.ListIndex = 0
    Else
        cmbBZMC_Click
    End If
    fraNumTyp.Left = fraInfo.Left + fraBZMX.Left
    fraNumTyp.Top = fraInfo.Top + fraBZMX.Top
    CreateTable
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Sub

'模拟tvwXMu_Click()
Private Sub tvwXMuClick()
'On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rsBZ As ADODB.Recordset
    Dim strID As String
    Dim intLength As Integer
    Dim intSex As Integer
    
    Me.MousePointer = vbHourglass
    
    '检查有无选择
    If (tvwXMu.SelectedItem Is Nothing) Or (cmbBZMC.ListIndex < 0) Then
        ClearInfo
        fraBZMX.Enabled = False
        fraSex.Enabled = False
        
        GoTo ExitLab
    End If
    
    strID = Mid(tvwXMu.SelectedItem.Key, 2)
    '判断当前选择的是什么节点
    intLength = Len(strID)
    If intLength <= 2 Then
        '选择了科室
        ClearInfo
        fraBZMX.Enabled = False
        fraSex.Enabled = False
        
    ElseIf intLength = 7 Then
        '选择了子项
        If optMale.Value Then
            intSex = 1
        ElseIf optFemale.Value Then
            intSex = 2
        Else
            intSex = 0
        End If
        strSQL = "select * from SET_TJBZDT" _
                & " where BZID=" & Val(cmbBZMC.ItemData(cmbBZMC.ListIndex)) _
                & " and XMID='" & strID & "'" _
                & " and Sex=" & intSex
    End If
    
    If strSQL <> "" Then
        Set rsBZ = New ADODB.Recordset
        rsBZ.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        If rsBZ.RecordCount > 0 Then
            txtNormalVal.Text = rsBZ("NormalVal") & ""
''''            txtCKSX.Text = rsBZ("CKSX") & ""
''''            txtCKXX.Text = rsBZ("CKXX") & ""
            txtDW.Text = rsBZ("DW") & ""
''''            txtLowInfo.Text = rsBZ("LowInfo") & ""
''''            txtHighInfo.Text = rsBZ("HighInfo") & ""
''''            txtMinVal.Text = rsBZ("MinVal") & ""
''''            txtMaxVal.Text = rsBZ("MaxVal") & ""
            rsBZ.Close
        Else
            ClearInfo
        End If
        
        fraBZMX.Enabled = True
        fraSex.Enabled = True
        strSQL = "select XXType from SET_XX" _
                & " where XXID='" & strID & "'"
        Set rsBZ = New ADODB.Recordset
        rsBZ.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        If rsBZ.RecordCount > 0 Then
            If rsBZ(0) <> 1 And rsBZ(0) <> 3 Then '如果不是数值型
''''                txtNormalVal.Tag = "0"
                
''''                txtCKSX.Enabled = False
''''                txtCKSX.Visible = False '''''
''''                txtCKXX.Enabled = False
''''                txtCKXX.Visible = False ''''''''
''''                txtDW.Enabled = False
''''                txtDW.Visible = False '''''''''''
''''                txtMinVal.Enabled = False
''''                txtMinVal.Visible = False ''''''''''
''''                txtMaxVal.Enabled = False
''''                txtMaxVal.Visible = False ''''''''
''''
''''                txtCKSX.Text = ""
''''                txtCKXX.Text = ""
''''                txtDW.Text = ""
''''                txtMinVal.Text = ""
''''                txtMaxVal.Text = ""
                
                fraNumTyp.Visible = False
                fraBZMX.Visible = True
            ElseIf rsBZ(0) = 1 Or rsBZ(0) = 3 Then
''''                txtNormalVal.Tag = "1"
''''
''''                txtCKSX.Enabled = True
''''                txtCKSX.Visible = True ''''''''
''''                txtCKXX.Enabled = True
''''                txtCKXX.Visible = True '''''
'                txtDW.Enabled = True
'                txtDW.Visible = True '''''''
''''                txtMinVal.Enabled = True
''''                txtMinVal.Visible = True '''''''
''''                txtMaxVal.Enabled = True
''''                txtMaxVal.Visible = True ''''''''''
                
                fraNumTyp.Visible = True
                fraNumTyp.Tag = strID
                fraBZMX.Visible = False


                showBz "select * from set_xx_bz where XX_ID='" & strID & "' And SEX = " & intSex & " and BZ_iD= " & Val(cmbBZMC.ItemData(cmbBZMC.ListIndex)) & " order by Xindex"
            End If
        End If
    End If
    
    cmdSaveInfo.Enabled = False
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub



Private Sub LsvBZ_ItemClick(ByVal item As MSComctlLib.ListItem)
    txtXX.Text = item.SubItems(1)
    txtSX.Text = item.SubItems(2)
    TxtResult.Text = item.SubItems(3)
    XPCmdEdit.Enabled = True
    XPCmdSave.Enabled = False
'    Me.Caption = item.Index
    XPCmdAdd.Enabled = True
    XPCmdDel.Enabled = True
    txtXX.Enabled = False
    txtSX.Enabled = False
    TxtResult.Enabled = False
End Sub

Private Sub optFemale_Click()
    tvwXMuClick
End Sub

Private Sub optMale_Click()
    tvwXMuClick
End Sub

Private Sub optNNTY_Click()
    tvwXMuClick
End Sub

Private Sub tvwXMu_NodeClick(ByVal Node As MSComctlLib.Node)
    tvwXMuClick
End Sub

Private Sub txtBZSM_KeyPress(KeyAscii As Integer)
    If (cmdAdd.Enabled = True) And (cmdChange.Enabled = True) Then
        KeyAscii = 0
    End If
End Sub

'清除所有标准明细
Private Sub ClearInfo()
    txtNormalVal.Text = ""
    txtCKSX.Text = ""
    txtCKXX.Text = ""
    txtDW.Text = ""
    txtLowInfo.Text = ""
    txtHighInfo.Text = ""
    txtMinVal.Text = ""
    txtMaxVal.Text = ""
End Sub

Private Sub txtCKSX_Change()
    cmdSaveInfo.Enabled = True
End Sub

Private Sub txtCKSX_KeyPress(KeyAscii As Integer)
    '不是回车和退格键的时候，校验长度和字符
    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 Len(txtCKSX.Text) >= 8 Then
            MsgBox "您输入的数字太长！", vbInformation, "提示"
            KeyAscii = 0
            txtCKSX.SetFocus
            Exit Sub
        End If
    End If
    
    EnterToTab KeyAscii
End Sub

Private Sub txtCKXX_Change()
    cmdSaveInfo.Enabled = True
End Sub

Private Sub txtCKXX_KeyPress(KeyAscii As Integer)
    '不是回车和退格键的时候，校验长度和字符
'    MsgBox KeyAscii
    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 Len(txtCKXX.Text) >= 8 Then
            MsgBox "您输入的数字太长！", vbInformation, "提示"
            KeyAscii = 0
            txtCKXX.SetFocus
            Exit Sub
        End If
    End If
    
    EnterToTab KeyAscii
End Sub

Private Sub txtDW_Change()
    cmdSaveInfo.Enabled = True
End Sub

Private Sub txtDW_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtHighInfo_Change()
    cmdSaveInfo.Enabled = True
End Sub

Private Sub txtHighInfo_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtLowInfo_Change()
    cmdSaveInfo.Enabled = True
End Sub

Private Sub txtLowInfo_KeyPress(KeyAscii As Integer)
    EnterToTab KeyAscii
End Sub

Private Sub txtMaxVal_Change()
    cmdSaveInfo.Enabled = True
End Sub

Private Sub txtMaxVal_KeyPress(KeyAscii As Integer)
    '不是回车和退格键的时候，校验长度和字符
    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 Len(txtMaxVal.Text) >= 5 Then
            MsgBox "您输入的数字太长！", vbInformation, "提示"
            KeyAscii = 0
            txtMaxVal.SetFocus
            Exit Sub
        End If
    End If

    If KeyAscii = 13 Then
        cmdSaveInfo_Click
    End If
End Sub

Private Sub txtMinVal_Change()
    cmdSaveInfo.Enabled = True
End Sub

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