frmjbqctj.frm

来自「本系统可用于医院和专业体检中心的健康体检管理」· FRM 代码 · 共 1,259 行 · 第 1/4 页

'    '计算男性人数
'    strSQL = strSQL & " and SEX='男'"
'    Set rsTemp = New ADODB.Recordset
'    rsTemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
'    mlngBRCount_Male = rsTemp(0)
'    rsTemp.Close
'    '女性人数
'    mlngBRCount_Female = mlngBRCount - mlngBRCount_Male
    
    '计算共选择了多少种病患
    For i = 1 To lvwBH.ListItems.Count
        If lvwBH.ListItems(i).Checked = True Then
            mintBHCount = mintBHCount + 1
        End If
    Next i
    
    If mintBHCount = 0 Then
        '如果没有记录，清空图表控件的显示
        With MSChart1
            .ColumnCount = 1
            .RowCount = 1
'            .RowLabel = "无"
    
            .ShowLegend = False
        End With
        GoTo ExitLab
    End If
    
    '如果有选择的病患
    ReDim arrResult(1 To 8, 1 To 3)   '共分为8个年龄段
    ReDim arrBHMC(1 To mintBHCount)
    ReDim arrBHJYDMID(1 To mintBHCount)
    ReDim m_lngSelectedPersons(1 To mintBHCount)
    ReDim m_lngSelectedPersons_Male(1 To mintBHCount)
    ReDim m_lngSelectedPersons_Female(1 To mintBHCount)
    
    K = 1
    With lvwBH
        For i = 1 To .ListItems.Count
            If .ListItems(i).Checked = True Then
                arrBHMC(K) = .ListItems(i)
                arrBHJYDMID(K) = Mid(.ListItems(i).Key, 2)
                m_lngSelectedPersons(K) = GetCountFromSpecifyIll(.ListItems(i).SubItems(1), _
                        arrBHMC(K), strCondition)
                DoEvents
                If m_lngSelectedPersons(K) > 0 Then
                    m_lngSelectedPersons_Male(K) = GetCountFromSpecifyIll(.ListItems(i).SubItems(1), _
                            arrBHMC(K), strCondition & " and SEX='男'")
                    m_lngSelectedPersons_Female(K) = m_lngSelectedPersons(K) - m_lngSelectedPersons_Male(K)
                End If
                
                K = K + 1
                
                DoEvents
            End If
        Next i
    End With
    K = 1
    
    DoEvents
    ShowBHList
    
    If lvwJG.ListItems.Count > 0 Then
        Set lvwJG.SelectedItem = lvwJG.ListItems(1)
    End If
    lvwJG_Click
    '标识已进行过查询
    mblQuery = True
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub dtpEnd_Click()
    mblQuery = False
End Sub

Private Sub dtpStart_Click()
    mblQuery = False
End Sub

Private Sub Form_Load()
    '刷新单位显示
    RefreshTJDW
    
    '显示全部疾病
    OptAll.Value = True
    
    mblQuery = False
    '初始化日期为最近一周
    dtpEnd.Value = Date
    dtpStart.Value = DateAdd("d", -6, Date)
End Sub

Private Sub lvwJG_Click()
    Dim intBHNumber As Integer
    
    Me.MousePointer = vbHourglass
    
    '清空MSCchart1的显示
'    With MSChart1
'        .ColumnCount = 2
'        .RowCount = 1
'        .ShowLegend = False
'    End With
    If lvwJG.SelectedItem Is Nothing Then GoTo ExitLab
    
    intBHNumber = CInt(Mid(lvwJG.SelectedItem.Key, 7))
    ShowChart (intBHNumber)
    
    GoTo ExitLab
ExitLab:
    Me.MousePointer = vbDefault
End Sub

Private Sub OptAll_Click()
    refreshBH 0
    mblQuery = False
End Sub

Private Sub OptCJB_Click()
    refreshBH 2
    mblQuery = False
End Sub

Private Sub OptJB_Click()
    refreshBH 1
    mblQuery = False
End Sub

Private Sub refreshBH(ByVal intType As Integer)
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim itemX As ListItem
    
    lvwBH.ListItems.Clear
    
    Set rstemp = New ADODB.Recordset
    strSQL = "select * from DM_ZJJY,SET_KSSZ" _
            & " where DM_ZJJY.KSID=SET_KSSZ.KSID and"
    If intType = 0 Then         '全部病患
        strSQL = strSQL & " (SFJB=1 or SFCJB=1)"
    ElseIf intType = 1 Then     '疾病
        strSQL = strSQL & " SFJB=1"
    ElseIf intType = 2 Then     '常见病
         strSQL = strSQL & " SFCJB=1"
    End If
    '排序
    strSQL = strSQL & " order by SET_KSSZ.SXH,JYMC"
    rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
    If rstemp.RecordCount > 0 Then
        rstemp.MoveFirst
        Do While Not rstemp.EOF
            Set itemX = lvwBH.ListItems.Add(, "W" & rstemp("JYDMID"), rstemp("DMValue"))
            itemX.SubItems(1) = rstemp("KSID")
            rstemp.MoveNext
        Loop
    End If
    
    GoTo ExitLab
ExitLab:
    '
End Sub

Private Sub RefreshTJDW()
    Dim strSQL As String
    Dim rstemp As ADODB.Recordset
    Dim i As Integer
    
    strSQL = "select YYID,DWMC" _
            & " from YY_TJDJ,SET_DW" _
            & " where YY_TJDJ.DWID=SET_DW.DWID" _
            & " order by JLRQ desc"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenKeyset, adLockOptimistic
    CmbTJDW.Clear
    If rstemp.RecordCount > 0 Then
        CmbTJDW.AddItem "" '首先添加一个空行，便于用户修改
        
        ReDim arrYYID(rstemp.RecordCount)
    
        '添加已经预约过的团体
        rstemp.MoveFirst
        For i = 1 To rstemp.RecordCount
            CmbTJDW.AddItem rstemp("DWMC")
            CmbTJDW.ItemData(CmbTJDW.NewIndex) = i
            arrYYID(i) = rstemp("YYID") 'YYID字段太长，ItemData属性无法存放，只能存入数组
            
            rstemp.MoveNext
        Next
        rstemp.Close
        Set rstemp = Nothing
    End If

End Sub

'获得在inYYID中,dateStart到dateEnd 时间内,一定年龄段内,总检结论中有instrBHMX疾病的人(男或女,若inSex为空，则是全部)的数目,如inYYID为空，则只统计时间段内的人数
Private Function getJBCount(ByVal inYYID As String, ByVal instrBHMC As String, _
        dateStart As Date, dateEnd As Date, inSEX As String, _
        inAgeStart As Integer, inAgeEnd As Integer) As Long
    Dim rstemp As ADODB.Recordset
    Dim strSQL As String
    
    strSQL = "select Count(GUID) from DATA_ZJJL" _
            & " where GUID in(" _
                & "select GUID from SET_GRXX" _
                & " where TJRQ between '" & dateStart & "' and '" & dateEnd & "'" _
                & " and AGE between " & inAgeStart & " and " & inAgeEnd
    '是否团体
    If inYYID <> "" Then
        strSQL = strSQL & " and YYID='" & inYYID & "'"
    End If
    '是否包含性别
    If inSEX <> "" Then
        strSQL = strSQL & " and SEX='" & inSEX & "'"
    End If
    strSQL = strSQL & ")" _
            & " and DATA_ZJJL.JLValue like '%" & instrBHMC & "%'"
    Set rstemp = New ADODB.Recordset
    rstemp.Open strSQL, GCon, adOpenForwardOnly, adLockReadOnly
    getJBCount = rstemp(0)
    rstemp.Close
End Function

'在lvwJG中显示病患的人数清单
Private Sub ShowBHList()
    Dim i As Integer
    Dim strYYID As String
    Dim itmTemp As ListItem
    Dim lngTemp As Long
    
    lvwJG.ListItems.Clear
    
    If CmbTJDW.Text = "" Then
        strYYID = ""
    Else
        strYYID = arrYYID(CmbTJDW.ListIndex)
    End If
    For i = 1 To mintBHCount
        '病患名称
        Set itmTemp = lvwJG.ListItems.Add(, "W" & arrBHJYDMID(i) & i, arrBHMC(i))
        '选择相关组合的总人数
        itmTemp.SubItems(1) = CStr(m_lngSelectedPersons(i))
        
        '添加患此病的总人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "", 0, 150)
        itmTemp.SubItems(2) = lngTemp
        '添加患此病的百分比
        itmTemp.SubItems(3) = GetRatio(lngTemp, m_lngSelectedPersons(i))
        
        '添加患此病的0-29男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 0, 29)
        itmTemp.SubItems(4) = lngTemp
        '添加患此病的0-29男性百分比
        itmTemp.SubItems(5) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的0-29女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 0, 29)
        itmTemp.SubItems(6) = lngTemp
        '添加患此病的0-29女性百分比
        itmTemp.SubItems(7) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的30-39男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 30, 39)
        itmTemp.SubItems(8) = lngTemp
        '添加患此病的30-39男性百分比
        itmTemp.SubItems(9) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的30-39女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 30, 39)
        itmTemp.SubItems(10) = lngTemp
        '添加患此病的30-39女性百分比
        itmTemp.SubItems(11) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的40-49男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 40, 49)
        itmTemp.SubItems(12) = lngTemp
        '添加患此病的40-49男性百分比
        itmTemp.SubItems(13) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的40-49女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 40, 49)
        itmTemp.SubItems(14) = lngTemp
        '添加患此病的40-49女性百分比
        itmTemp.SubItems(15) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的50-59男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 50, 59)
        itmTemp.SubItems(16) = lngTemp
        '添加患此病的50-59男性百分比
        itmTemp.SubItems(17) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的50-59女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 50, 59)
        itmTemp.SubItems(18) = lngTemp
        '添加患此病的50-59女性百分比
        itmTemp.SubItems(19) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的60-69男性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "男", 60, 69)
        itmTemp.SubItems(20) = lngTemp
        '添加患此病的60-69男性百分比
        itmTemp.SubItems(21) = GetRatio(lngTemp, m_lngSelectedPersons_Male(i))
        
        '添加患此病的60-69女性人数
        lngTemp = getJBCount(strYYID, arrBHMC(i), dtpStart.Value, dtpEnd.Value, "女", 60, 69)
        itmTemp.SubItems(22) = lngTemp
        '添加患此病的60-69女性百分比
        itmTemp.SubItems(23) = GetRatio(lngTemp, m_lngSelectedPersons_Female(i))
        
        '添加患此病的70-79男性人数