frmtjrstj.frm

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

            strFZMC = Left(tvwDWei.SelectedItem.Text, InStrRev(tvwDWei.SelectedItem.Text, "(") - 1)
            Call ShowTJStatistic(True, Left(strYYID, 11), Mid(strYYID, 12), strFZMC, mdtmStart, mdtmEnd)
    End Select
    Call ShowSumRatio
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

'显示所有团体/某团体/某团体分组的统计结果
'参数1：是否团检
'参数2：团体预约ID
'参数3：分组ID
'参数4：分组名称
'参数5，6：起止日期
Private Sub ShowTJStatistic(ByVal blnTJ As Boolean, ByVal strYYID As String, _
        ByVal intFZID As Integer, ByVal strFZMC As String, _
        ByVal dtmStart As Date, ByVal dtmEnd As Date)
On Error GoTo ErrMsg
    Dim Status
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim rsNum As ADODB.Recordset
    Dim intSJZRS, intSJNXZRS, intSJYDJRS, intSJYDJNXRS As Integer
    Dim i, intTJDWS As Integer
    Dim itemX As ListItem
    Dim strDWMC As String
    Dim strBFB As String
    Dim intTTZRS, intTTMaleZRS, intTTFemaleZRS, intTTYJRS, intTTYJMaleRS, intTTYJFemaleRS As Integer
    
    Me.MousePointer = vbHourglass
    
    If blnTJ Then
        '******************************************************************
        '                               显示团体
        '******************************************************************
        '首先检索满足条件的团体
        strSQL = "select YY_TJDJ.YYID,DWMC,Count(GUID) as Number from YY_TJDJ,SET_DW,FZ_FZSJ" _
                & " where YY_TJDJ.DWID=SET_DW.DWID" _
                & " and YY_TJDJ.TJRQ between '" & dtmStart & "' and '" & dtmEnd & "'" _
                & " and YY_TJDJ.YYID=FZ_FZSJ.YYID"
        If strYYID <> "" Then
            strSQL = strSQL & " and YY_TJDJ.YYID='" & strYYID & "'"
            If intFZID > 0 Then
                strSQL = strSQL & " and FZ_FZSJ.FZID=" & intFZID
            End If
        End If
        strSQL = strSQL & " group by YY_TJDJ.YYID,DWMC"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rstemp.RecordCount > 0 Then
            rstemp.MoveFirst
            Do While Not rstemp.EOF
                '单位名称
                strDWMC = rstemp("DWMC")
                If intFZID > 0 Then
                    strDWMC = strDWMC & " 分组 " & strFZMC
                End If
                
                '获得该团体的总人数
                intTTZRS = rstemp("Number")
                '向lvwRS中添加
                If intTTZRS > 0 Then
                    Set itemX = lvwRS.ListItems.Add(, , strDWMC) '"W" & rsTemp("YYID")
                    
                    Call ShowPersonRatio(itemX, rstemp("YYID"), intFZID)
                End If
                rstemp.MoveNext
            Loop
            rstemp.Close
        End If
        
    Else
        '******************************************************************
        '                              显示散检
        '******************************************************************
        Set itemX = lvwRS.ListItems.Add(, , "散检")
        Call ShowPersonRatio(itemX, "", , "((YYID IS Null) or (YYID=''))" _
                & " and TJRQ between '" & dtmStart & "' and '" & dtmEnd & "'")
    End If
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub tvwXMu_DblClick()
    If tvwXMu.SelectedItem Is Nothing Then Exit Sub
    
    If Len(tvwXMu.SelectedItem.Key) >= 5 Then
        cmdQuery_Click
    End If
End Sub

'以比例方式显示各个年龄段的体检人数
Private Sub ShowPersonRatio(ByRef itmRatio As ListItem, ByVal strYYID As String, _
        Optional ByVal intFZID As Integer = -1, _
        Optional ByVal strAppendCondition As String)
    Dim lngTotalPerson As Long, lngTotalPerson_YJ As Long
    Dim lngMalePerson As Long, lngMalePerson_YJ As Long
    Dim lngFemalePerson As Long, lngFemalePerson_YJ As Long
    Dim strCondition As String
    Dim strRatio As String
    
    '获得总人数
    strCondition = ""
    If strAppendCondition <> "" Then
        strCondition = strAppendCondition
    End If
    lngTotalPerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    
    '获得男性总人数
    strCondition = "SEX='男'"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , False, strCondition)
    
    '获得女性总人数
    lngFemalePerson = lngTotalPerson - lngMalePerson
    
    '获得已体检总人数
    strCondition = ""
    If strAppendCondition <> "" Then
        strCondition = strAppendCondition
    End If
    lngTotalPerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    
    '计算已体检人数占总人数的百分比
    strRatio = GetRatio(lngTotalPerson_YJ, lngTotalPerson)
    itmRatio.SubItems(1) = CStr(lngTotalPerson & "/" & lngTotalPerson_YJ & "/" & strRatio)
    
    '获得男性已检人数
    strCondition = "SEX='男'"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(2) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '计算女性已体检人数
    lngFemalePerson_YJ = lngTotalPerson_YJ - lngMalePerson_YJ
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(3) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
    
    '男<=24
    strCondition = "SEX='男' and (Age<=24 or Age is null)"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(4) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '女<=24
    strCondition = "SEX='女' and (Age<=24 or Age is null)"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngFemalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngFemalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(5) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
    
    '男25～34
    strCondition = "SEX='男' and Age between 25 and 34"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(6) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '女25～34
    strCondition = "SEX='女' and Age between 25 and 34"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngFemalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngFemalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(7) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
    
    '男35～44
    strCondition = "SEX='男' and Age between 35 and 44"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(8) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '女35～44
    strCondition = "SEX='女' and Age between 35 and 44"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngFemalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngFemalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(9) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
    
    '男45～54
    strCondition = "SEX='男' and Age between 45 and 54"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(10) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '女45～54
    strCondition = "SEX='女' and Age between 45 and 54"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngFemalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngFemalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(11) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
    
    '男55～64
    strCondition = "SEX='男' and Age between 55 and 64"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(12) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '女55～64
    strCondition = "SEX='女' and Age between 55 and 64"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngFemalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngFemalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(13) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
    
    '男>=65
    strCondition = "SEX='男' and Age>=65"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngMalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngMalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngMalePerson_YJ, lngMalePerson)
    itmRatio.SubItems(14) = CStr(lngMalePerson & "/" & lngMalePerson_YJ & "/" & strRatio)
    
    '女>=65
    strCondition = "SEX='女' and Age>=65"
    If strAppendCondition <> "" Then
        strCondition = strCondition & " and " & strAppendCondition
    End If
    lngFemalePerson = GetPersonCheckStatus(ALL_PERSON, strYYID, intFZID, , , , strCondition)
    lngFemalePerson_YJ = GetPersonCheckStatus(FINISHED, strYYID, intFZID, , , , strCondition)
    strRatio = GetRatio(lngFemalePerson_YJ, lngFemalePerson)
    itmRatio.SubItems(15) = CStr(lngFemalePerson & "/" & lngFemalePerson_YJ & "/" & strRatio)
End Sub

'显示合计
Private Sub ShowSumRatio()
    Dim itmSum As ListItem
    Dim lngSum As Long, lngSum_YJ As Long
    Dim strCount
    Dim i As Integer, j As Integer
    Dim strRatio As String
    
    If lvwRS.ListItems.Count < 1 Then GoTo ExitLab
    
    Set itmSum = lvwRS.ListItems.Add(, , "合计")
    With lvwRS
        For i = 1 To 15
            lngSum = 0: lngSum_YJ = 0
            For j = 1 To .ListItems.Count - 1
                strCount = Split(.ListItems(j).SubItems(i), "/")
                lngSum = lngSum + CLng(Val(strCount(0)))
                lngSum_YJ = lngSum_YJ + CLng(Val(strCount(1)))
            Next j
            strRatio = GetRatio(lngSum_YJ, lngSum)
            itmSum.SubItems(i) = CStr(lngSum & "/" & lngSum_YJ & "/" & strRatio)
        Next i
    End With
    
    GoTo ExitLab
ExitLab:
    '
End Sub