formyytx.frm

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

      Width           =   2295
   End
   Begin VB.Label LabelGRYYRS 
      BackColor       =   &H80000018&
      BackStyle       =   0  'Transparent
      Caption         =   "个人预约人数："
      Height          =   285
      Left            =   2880
      TabIndex        =   12
      Top             =   7080
      Width           =   2295
   End
End
Attribute VB_Name = "FormYYTX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_blnSystemID As Boolean
Dim m_blnSelfID As Boolean

Private Sub cmdOK_Click()
    Unload Me
End Sub

Private Sub cmdQuery_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim itemX As ListItem
    Dim nodeTemp As Node
    Dim rsDWMC As ADODB.Recordset
    Dim rsCount As ADODB.Recordset
    Dim rsFZ As ADODB.Recordset
    Dim intTCount, intGCount As Integer
    
    Me.MousePointer = vbHourglass
    
    Set rstemp = New ADODB.Recordset
    lvwPerson.ListItems.Clear
    
    '按条件查询
    If optGRen.Value = True Then
        Me.tvwDWei.Nodes.Clear
        '个人预约
'        strSql = "select HealthID as 健康档案号,TJSerialNum as 体检序号,YYRXM as 姓名,JLRQ as 预约日期,SET_GRXX.TJRQ as 体检日期" _
                & " from SET_GRXX,YY_SJDJ" _
                & " where ((YYID is null) or (YYID=''))" _
                & " and SET_GRXX.TJRQ>='" & dtpBegin.Value & "'" _
                & " and SET_GRXX.TJRQ<='" & dtpStop.Value & " 23:59:59'" _
                & " and SET_GRXX.GUID=YY_SJDJ.GUID" _
                & " and (SFTJ=0 or SFTJ=1)"
        strSQL = "select SET_GRXX.*,YY_SJDJ.*" _
                & " from SET_GRXX,YY_SJDJ" _
                & " where ((YYID is null) or (YYID=''))" _
                & " and SET_GRXX.TJRQ>='" & dtpBegin.Value & "'" _
                & " and SET_GRXX.TJRQ<='" & dtpStop.Value & " 23:59:59'" _
                & " and SET_GRXX.GUID=YY_SJDJ.GUID" _
                & " and (SFTJ=0)"
        rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        If rstemp.RecordCount > 0 Then
            '向lvwPerson中加入个人预约的信息列表
            rstemp.MoveFirst
            Do While Not rstemp.EOF
                Set itemX = lvwPerson.ListItems.Add(, HEADER & rstemp("GUID"), rstemp("HealthID"))
                itemX.SubItems(1) = rstemp("SelfBH") & ""
                itemX.SubItems(2) = rstemp("YYRXM")
                itemX.SubItems(3) = rstemp("Sex")
                itemX.SubItems(4) = rstemp("Age") & ""
                itemX.SubItems(5) = rstemp("TJRQ")
                rstemp.MoveNext
            Loop
        End If
    Else
        '团体预约
'        strSql = "select YYID as 预约ID,DWMC as 单位名称,LXR as 联系人,JLRQ as 预约日期,TJRQ as 体检日期" _
                & " from YY_TJDJ,SET_DW" _
                & " where TJRQ>='" & dtpBegin.Value & "'" _
                & " and TJRQ<='" & dtpStop.Value & " 23:59:59'" _
                & " and YY_TJDJ.DWID=SET_DW.DWID" _
                & " and (SFTJ=0 or SFTJ=1)"
                
        '添加一个根节点
        '关键字长度：1＝1
        tvwDWei.Nodes.Clear
        Set nodeTemp = tvwDWei.Nodes.Add(, , HEADER, "所有预约单位")
        nodeTemp.Expanded = True
        Set nodeTemp = Nothing
        
        strSQL = "select YY_TJDJ.*,SET_DW.*" _
                & " from YY_TJDJ,SET_DW" _
                & " where TJRQ>='" & dtpBegin.Value & "'" _
                & " and TJRQ<='" & dtpStop.Value & " 23:59:59'" _
                & " and YY_TJDJ.DWID=SET_DW.DWID" _
                & " and (SFTJ in (0,1,2))"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockOptimistic
        '有预约的团体
        If rstemp.RecordCount > 0 Then
            rstemp.MoveFirst
            Do While Not rstemp.EOF
                Set rsDWMC = New ADODB.Recordset
                Set rsCount = New ADODB.Recordset
                rsDWMC.Open "select * from set_dw where DWID='" & rstemp("DWID") & "'", GCon, adOpenDynamic, adLockOptimistic
                rsCount.Open "select count(*) from SET_GRXX where YYID='" & rstemp("YYID") & "'", GCon, adOpenDynamic, adLockOptimistic
                Set nodeTemp = tvwDWei.Nodes.Add("W", tvwChild, "W" & rstemp("YYID"), rsDWMC("DWMC") & " " & rsCount(0) & "人")
                '获取当前YYID中的分组信息
                Set rsFZ = New ADODB.Recordset
                strSQL = "select * from FZ_FZSY WHERE YYID='" & rstemp("YYID") & "'"
                rsFZ.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
                If rsFZ.RecordCount > 0 Then
                    rsFZ.MoveFirst
                    Do While Not rsFZ.EOF
                        Set rsCount = New ADODB.Recordset
                        strSQL = "select count(*) from FZ_FZSJ where YYID='" & rstemp("YYID") & "'" _
                                & " and FZID='" & rsFZ("FZID") & "'"
                        rsCount.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
                        Set nodeTemp = tvwDWei.Nodes.Add("W" & rstemp("YYID"), tvwChild, "W" & rstemp("YYID") & rsFZ("FZID"), rsFZ("FZMC") & " " & rsCount(0) & "人")
                    
                        rsFZ.MoveNext
                    Loop
                
                End If
                rstemp.MoveNext
            
            Loop
        
        End If
    End If
    '*****************20040328封闭*************************
'    RefreshGrid Me, Me.MSHFlexGrid1, strSql
    '*****************20040328封闭完*************************
    
'    '取得团体预约总人数
'    strSql = "select COUNT(*) from SET_GRXX where YYID<>'" & "'" _
'             & " and YYID in (select YYID from YY_TJDJ where SFTJ=0 or SFTJ=1)"
'    Set rsCount = New ADODB.Recordset
'    rsCount.Open strSql, GCon, adOpenDynamic, adLockOptimistic
'    If rsCount(0) = 0 Then
'        LabelTTYYRS.Caption = "团体预约人数：0 人"
'    Else
'        LabelTTYYRS.Caption = "团体预约人数：" & rsCount(0) & " 人"
'        intTCount = rsCount(0)
'    End If
'
'    '取得个人预约总人数
'    strSql = "select COUNT(*) from YY_SJDJ where SFTJ=0 or SFTJ=1"
'    Set rsCount = New ADODB.Recordset
'    rsCount.Open strSql, GCon, adOpenDynamic, adLockOptimistic
'    If rsCount(0) = 0 Then
'        LabelGRYYRS.Caption = "个人预约人数：0 人"
'    Else
'        LabelGRYYRS.Caption = "个人预约人数：" & rsCount(0) & " 人"
'        intGCount = rsCount(0)
'    End If
'
'    '显示总的预约人数
'    LabelYYRSZJ.Caption = "预约人数总计：" & intTCount + intGCount & " 人"
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub dtpStop_Change()
'    dtpBegin_Change
End Sub

Private Sub Form_Load()
On Error GoTo ErrMsg
    Dim Status
    Dim rsCount As ADODB.Recordset
    Dim strSQL As String
    Dim intTCount, intGCount As Integer
    
    Screen.MousePointer = vbArrowHourglass
    
    m_blnSystemID = g_blnSystemID
    m_blnSelfID = g_blnSelfID
    '设置ListView的列名及列宽
    Call SetObjectTitleAndWidth(Me.lvwPerson, 1, 2)
    
    dtpBegin.Value = Date
    dtpStop.Value = Date
'    dtpBegin_Change

     lvwPerson.View = lvwReport
     lvwPerson.FullRowSelect = True
    ' ListView1.GridLines = True
     lvwPerson.LabelEdit = lvwManual

    '取得团体预约总人数
    strSQL = "select COUNT(*) from SET_GRXX where YYID<>'" & "'" _
             & " and YYID in (select YYID from YY_TJDJ where SFTJ=0)"
    Set rsCount = New ADODB.Recordset
    rsCount.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
    If rsCount(0) = 0 Then
        LabelTTYYRS.Caption = "团体预约人数：0 人"
    Else
        LabelTTYYRS.Caption = "团体预约人数：" & rsCount(0) & " 人"
        intTCount = rsCount(0)
    End If
    
    '取得个人预约总人数
    strSQL = "select COUNT(*) from YY_SJDJ where SFTJ=0"
    Set rsCount = New ADODB.Recordset
    rsCount.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
    If rsCount(0) = 0 Then
        LabelGRYYRS.Caption = "个人预约人数：0 人"
    Else
        LabelGRYYRS.Caption = "个人预约人数：" & rsCount(0) & " 人"
        intGCount = rsCount(0)
    End If

    '显示总的预约人数
    LabelYYRSZJ.Caption = "预约人数总计：" & intTCount + intGCount & " 人"

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



Private Sub optGRen_Click()
'    dtpBegin_Change
End Sub

Private Sub optTTi_Click()
'    dtpBegin_Change
End Sub

Private Sub tvwDWei_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo ErrMsg
    Dim Status
    Dim tmpYYID As String
    Dim tmpFZID As Integer
    Dim rstemp As ADODB.Recordset
    Dim strSQL As String
    Dim itemX As ListItem
    
    Me.MousePointer = vbHourglass
    
    lvwPerson.ListItems.Clear
    Select Case Len(Node.Key)
        Case 13, 14    '是分组节点
            '显示当前分组的人员
            tmpYYID = Left(Mid(Node.Key, 2), 11)
            tmpFZID = Mid(Node.Key, 13)
            Set rstemp = New ADODB.Recordset
            strSQL = "select * from SET_GRXX where YYID='" & tmpYYID & "'" _
                    & " and GUID in ( select GUID from FZ_FZSJ where YYID='" & tmpYYID & "'" _
                    & " and FZID=" & tmpFZID & ")"
            rstemp.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
            
            If rstemp.RecordCount > 0 Then
                '向lvwPerson中加入个人预约的信息列表
             rstemp.MoveFirst
                Do While Not rstemp.EOF
                    Set itemX = lvwPerson.ListItems.Add(, HEADER & rstemp("GUID"), rstemp("HealthID"))
                    itemX.SubItems(1) = rstemp("SelfBH") & ""
                    itemX.SubItems(2) = rstemp("YYRXM")
                    itemX.SubItems(3) = rstemp("Sex")
                    itemX.SubItems(4) = rstemp("Age") & ""
                    itemX.SubItems(5) = rstemp("TJRQ")
                    rstemp.MoveNext
                Loop
            End If

'        Case 14     '是分组节点
'            '显示当前分组的人员
'            tmpYYID = Left(Mid(Node.Key, 2), 11)
'            tmpFZID = Mid(Node.Key, 13)
'            Set rsTemp = New ADODB.Recordset
'            strSQL = "select * from SET_GRXX where YYID='" & tmpYYID & "'" _
'                    & " and GUID in ( select GUID from FZ_FZSJ where YYID='" & tmpYYID & "'" _
'                    & " and FZID=" & tmpFZID & ")"
'            rsTemp.Open strSQL, GCon, adOpenDynamic, adLockOptimistic
'
'            If rsTemp.RecordCount > 0 Then
'                '向lvwPerson中加入个人预约的信息列表
'             rsTemp.MoveFirst
'                Do While Not rsTemp.EOF
'                    Set itemX = lvwPerson.ListItems.Add(, "W" & rsTemp("HealthID"), rsTemp("HealthID"))
'                    itemX.SubItems(1) = rsTemp("YYRXM")
'                    itemX.SubItems(2) = rsTemp("Sex")
'                    itemX.SubItems(3) = rsTemp("Age") & ""
'                    itemX.SubItems(4) = rsTemp("TJRQ")
'                    itemX.SubItems(5) = rsTemp("GUID")
'                    rsTemp.MoveNext
'                Loop
'            End If
        Case Else   '其它节点
            '清除列表显示
'            lvwPerson.ListItems.Clear'前面已经清空
    End Select
    
    GoTo ExitLab
    
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub