frmdwyxhzdc.frm

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

        ShowXiangMu False, lvwDWei.SelectedItem.Text
        
        cmdOK.Enabled = True
    Else
        cmdOK.Enabled = False
    End If
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Screen.MousePointer = vbDefault
End Sub

'显示所有项目（对团检和散检），部分项目（对团检）
Private Sub ShowXiangMu(ByVal blnAll As Boolean, Optional ByVal strYYID As String)
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim nodTemp As Node
    Dim nodRoot As MSComctlLib.Node
    Dim rsKShi As ADODB.Recordset
    Dim rsDX As ADODB.Recordset
    Dim rsXX As ADODB.Recordset
    Dim i As Integer
    
    Me.MousePointer = vbHourglass
    
    tvwXMu.Nodes.Clear
    
    If blnAll = False Then
        tvwXMu.CheckBoxes = True
    Else
        tvwXMu.CheckBoxes = False
    End If
    
    '首先显示一个根节点
    Set nodRoot = tvwXMu.Nodes.Add(, , "W", "所有项目")
    nodRoot.Expanded = True
    
    '显示所有科室
    strSQL = "select KSID,KSMC from SET_KSSZ"
    If blnAll = False Then
        '如果不是显示所有科室，则只显示有选择的科室
        strSQL = strSQL & " where KSID in (" _
                & "select left(DXID,2) from YY_SJDJDX" _
                & " where GUID in (" _
                    & "select GUID from SET_GRXX" _
                    & " where YYID='" & strYYID & "')" _
                & ")"
    End If
    '按顺序号排序
    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"))
'            nodTemp.Expanded = True
            
            strSQL = "select DXID,DXMC,DXSFYZX from SET_DX" _
                    & " where left(DXID,2)='" & rsKShi("KSID") & "'"
            If blnAll = False Then
                '如果不是显示所有项目，则只显示有选择的大项
                strSQL = strSQL & " and DXID in(" _
                        & "select distinct DXID from YY_SJDJDX" _
                        & " where GUID in (" _
                            & "select GUID from SET_GRXX" _
                            & " where YYID='" & strYYID & "')" _
                        & ")"
            End If
            '判断性别
            If optMale.Value = True Then '男性
                strSQL = strSQL & " and DXNNTY<>2"
            ElseIf optFemale.Value = True Then '女性
                strSQL = strSQL & " and DXNNTY<>1"
            End If
            
            '按顺序号排序
            strSQL = strSQL & " order by SXH"
            Set rsDX = New ADODB.Recordset
            rsDX.Open strSQL, GCon, adOpenStatic, adLockOptimistic
            If rsDX.RecordCount > 0 Then
                rsDX.MoveFirst
                Do
                    '添加大项
                    '关键字长度：1＋4＝5
                    Set nodTemp = tvwXMu.Nodes.Add("W" & rsKShi("KSID"), tvwChild, "W" & rsDX("DXID"), rsDX("DXMC"))
                    nodTemp.Expanded = True
                    
                    If rsDX("DXSFYZX") = 1 Then '有子项
                        strSQL = "select XXID,XXMC from SET_XX" _
                                & " where XXID in (" _
                                    & "select XXID from SET_ZH_Data" _
                                    & " where DXID='" & rsDX("DXID") & "'" _
                                & ")"
'                        '判断性别
'                        If optMale.Value = True Then '男性
'                            strSQL = strSQL & " and XXNNTY<>2"
'                        ElseIf optFemale.Value = True Then '女性
'                            strSQL = strSQL & " and XXNNTY<>1"
'                        End If
                        
                        '按顺序号排序
                        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＋4＋7＝12
                                tvwXMu.Nodes.Add "W" & rsDX("DXID"), tvwChild, "W" & rsDX("DXID") & rsXX("XXID"), rsXX("XXMC")
                                
                                rsXX.MoveNext
                            Loop Until rsXX.EOF
                            rsXX.Close
                        End If
                    End If
                     
                    rsDX.MoveNext
                Loop Until rsDX.EOF
                rsDX.Close
            End If
            
            rsKShi.MoveNext
        Loop Until rsKShi.EOF
        rsKShi.Close
    End If
    
    '如果是团检，则选中根节点
    If blnAll = False Then
        nodRoot.Checked = True
        tvwXMu_NodeCheck nodRoot
    End If
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub LvwDWei_Click()
    ShowXiangMu False, lvwDWei.SelectedItem.Text
End Sub

Private Sub tvwXMu_NodeCheck(ByVal Node As MSComctlLib.Node)
On Error Resume Next
    Dim strKey As String
    Dim i As Integer
    
'    If tvwXMu.SelectedItem Is Nothing Then Exit Sub
    If lvwDWei.SelectedItem.SubItems(1) = "" Then Exit Sub
    
    '如果选择的结点类型判断是否取消其下的项目
    Select Case Len(Node.Key)
        Case 1      '根结点
            If Node.Checked = False Then
                For i = 1 To tvwXMu.Nodes.Count
                    tvwXMu.Nodes(i).Checked = False
                Next i
            End If
        Case 3      '科室结点
            If Node.Checked = False Then
                For i = 1 To tvwXMu.Nodes.Count
                    If tvwXMu.Nodes(i).Parent Is Node Or tvwXMu.Nodes(i).Parent.Parent Is Node Then
                        tvwXMu.Nodes(i).Checked = False
                    End If
                Next i
            End If
        Case 5      '项目结合结点
            If Node.Checked = False Then
                For i = 1 To tvwXMu.Nodes.Count
                    If tvwXMu.Nodes(i).Parent Is Node Then
                        tvwXMu.Nodes(i).Checked = False
                    End If
                Next i
            End If
        
        Case 8      '项目结点
        
    End Select
    strKey = Mid(Node.Key, 2)
    
    If Node.Checked = False Then
        For i = 1 To tvwXMu.Nodes.Count
            If Node.Parent Is tvwXMu.Nodes(i) Then
                If Err.Number = 0 Then
                    tvwXMu.Nodes(i).Checked = False
                Else
                    Err.Clear
                End If
            End If
            
            If Node.Parent.Parent Is tvwXMu.Nodes(i) Then
                If Err.Number = 0 Then
                    tvwXMu.Nodes(i).Checked = False
                Else
                    Err.Clear
                End If
            End If
            
            If Node.Parent.Parent.Parent Is tvwXMu.Nodes(i) Then
                If Err.Number = 0 Then
                    tvwXMu.Nodes(i).Checked = False
                Else
                    Err.Clear
                End If
            End If
        Next

        Exit Sub
    End If

''*********************************20040609加入 闻***********************************
'    If Node.Checked = False Then
'        For i = 1 To tvwXMu.Nodes.Count
'            If Node.Parent Is tvwXMu.Nodes(i) Or tvwXMu.Nodes(i).Parent Is Node Then
'                tvwXMu.Nodes(i).Checked = False
'            ElseIf Node.Parent.Parent Is tvwXMu.Nodes(i) Or tvwXMu.Nodes(i).Parent.Parent Is Node Then
'                tvwXMu.Nodes(i).Checked = False
'            ElseIf Node.Parent.Parent.Parent Is tvwXMu.Nodes(i) Or tvwXMu.Nodes(i).Parent.Parent.Parent Is Node Then
'                tvwXMu.Nodes(i).Checked = False
'            End If
'        Next
'
'        Exit Sub
'    End If
''*********************************20040609加入完 闻***********************************


    Err.Clear
    Select Case Len(strKey)
        Case 0 '选择了根节点
            '选中所有节点
            If Node.Checked = True Then
                For i = 1 To tvwXMu.Nodes.Count
                    tvwXMu.Nodes(i).Checked = True
                Next
            End If
        Case 2 '选择了科室
            '选中科室下的所有节点
            For i = 1 To tvwXMu.Nodes.Count
                If tvwXMu.Nodes(i).Parent Is Node Then
                    If Err.Number = 0 Then
                        tvwXMu.Nodes(i).Checked = True
                    Else
                        Err.Clear
                    End If
                Else
                    If tvwXMu.Nodes(i).Parent.Parent Is Node Then
                        If Err.Number = 0 Then
                            tvwXMu.Nodes(i).Checked = True
                        Else
                            Err.Clear
                        End If
                    End If
                End If
            Next
        Case 4 '选择了大项
            '选中大项下的所有节点
            For i = 1 To tvwXMu.Nodes.Count
                If tvwXMu.Nodes(i).Parent Is Node Then
                    If Err.Number = 0 Then
                        tvwXMu.Nodes(i).Checked = True
                    Else
                        Err.Clear
                    End If
                End If
            Next
        Case 7 '选择了小项
        '将小项所属大项、科室及所有项目节点均设为true
'            Node.Parent.Checked = True
'            Node.Parent.Parent.Checked = True
'            Node.Parent.Parent.Parent.Checked = True
    End Select
End Sub

Private Sub SelectNodeAll()
    Dim i As Integer
    
    For i = 1 To tvwXMu.Nodes.Count
        tvwXMu.Nodes(i).Selected = True
    Next i
End Sub