frmdwbhhzdc.frm

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

    
    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_TJDJDX" _
                & " 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 DXID from YY_TJDJDX" _
                        & " 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()
    Dim strYYID As String
    
    If lvwDWei.SelectedItem Is Nothing Then GoTo ExitLab
    
    '记录当前选择单位的预约编号
    strYYID = lvwDWei.SelectedItem.Text
    Call ShowXiangMu(False, strYYID)
    
    GoTo ExitLab
ExitLab:
    '
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