frmyyhdjrs.frm

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

End
Attribute VB_Name = "FrmYYHDJRS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdOK_Click()
    FrmYYHDJRS.Hide
    Set FrmYYHDJRS = Nothing
End Sub

Private Sub cmdQuery_Click()
    Dim rstemp As ADODB.Recordset
    Dim strSQL As String
    Dim arrRS(1 To 2, 1 To 2)
    Dim i As Integer
    Dim itemX As ListItem
    
    arrRS(1, 1) = "预约总人数"
    arrRS(2, 1) = "登记总人数"
    
    If dtpBegin.Value > dtpStop.Value Then
        MsgBox "起始时间不能大于终止时间！", vbInformation, ""
        dtpBegin.SetFocus
        Exit Sub
    End If
    
    If optGRen.Value = True Then
        lvwDWei.ListItems.Clear
        LblRS.Visible = True
        '查询个人预约的总人数
        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"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        arrRS(1, 2) = rstemp.RecordCount
        
        '查询已登记的人数
        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)"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        arrRS(2, 2) = rstemp.RecordCount
        
        '在图表中显示
'        ChangeMschart1Type
        
        MSChart1.ChartData = arrRS
        If arrRS(1, 2) <> 0 Then
            LblRS.Caption = "登记人数占预约人数的" & Format(arrRS(2, 2) * 100 / arrRS(1, 2), "##.##") & "%。"
        End If
    ElseIf Me.optTTi.Value = True Then
        '查询团体预约
        lvwDWei.ListItems.Clear
        LblRS.Visible = False
        
        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"
        Set rstemp = New ADODB.Recordset
        rstemp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rstemp.RecordCount > 0 Then
            '向lvwDWei中加入单位预约的信息列表
            rstemp.MoveFirst
            Do While Not rstemp.EOF
                Set itemX = lvwDWei.ListItems.Add(, "W" & rstemp("YYID"), rstemp("YYID"))
                itemX.SubItems(1) = rstemp("DWMC")
                itemX.SubItems(2) = rstemp("TJRQ")
                rstemp.MoveNext
            Loop
        End If
        
    End If
End Sub

Private Sub ChangeMschart1Type()
   ' 首先，将图表类型改为 3D 图表
   ' 这样可以看到图的所有部分。
   MSChart1.ChartType = VtChChartType3dArea

   ' 用 Plot 对象将
   ' 背景变为浅蓝色。
   With MSChart1.Plot.Backdrop
      ' 除非将样式属性正确地设置为VtFillStyleBrush
      ' 否则不会有颜色显示。
      .Fill.Style = VtFillStyleBrush
      .Fill.Brush.FillColor.Set 100, 255, 200
      ' 添加边框。
      .Frame.Style = VtFrameStyleThickInner
      ' 将样式设置为显示阴影。
      .Shadow.Style = VtShadowStyleDrop
   End With

   '将绘图墙的颜色设置为黄色。
   With MSChart1.Plot
      ' 将样式设置为实心。
      .Wall.Brush.Style = VtBrushStyleSolid
      ' 将颜色设置为黄色。
      .Wall.Brush.FillColor.Set 255, 255, 0
   End With
   
   With MSChart1.Plot '将绘图底色设置为蓝色。
      .PlotBase.BaseHeight = 200
      .PlotBase.Brush.Style = VtBrushStyleSolid
      .PlotBase.Brush.FillColor.Set 0, 0, 255
   End With
End Sub

Private Sub Form_Load()
    MSChart1.ChartType = VtChChartType2dBar
    
    dtpBegin.Value = Date
    dtpStop.Value = Date
End Sub

Private Sub LvwDWei_Click()
On Error GoTo ErrMsg
    Dim Status
    Dim tmpYYID As String
    Dim rsCount As ADODB.Recordset
    Dim arrRS(1 To 3, 1 To 2)
    Dim strSQL As String
    Dim tmpGUID As Long
    Dim rsTmp As ADODB.Recordset
    Dim intTmpDJRS As Integer
    
    Me.MousePointer = vbHourglass
    
    arrRS(1, 1) = "预约人数"
    arrRS(2, 1) = "建档人数"
    arrRS(3, 1) = "登记人数"
    intTmpDJRS = 0
    
    If lvwDWei.SelectedItem Is Nothing Then GoTo ExitLab
    
    If lvwDWei.SelectedItem <> "" Then
        tmpYYID = lvwDWei.SelectedItem
        Set rsCount = New ADODB.Recordset
        '查询预约总人数
'        rsCount.Open "select count(*) from SET_GRXX where YYID='" & rsTemp("YYID") & "'", GCon, adOpenStatic, adLockReadOnly
        strSQL = "select DJRS from YY_TJDJ where YYID='" & tmpYYID & "'"
        rsCount.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        If rsCount("DJRS") = 0 Or IsNull(rsCount("DJRS")) Then
            arrRS(1, 1) = "预约人数" & "(0人)"
            arrRS(1, 2) = 0
        Else
            arrRS(1, 1) = "预约人数" & "(" & rsCount("DJRS") & "人)"
            arrRS(1, 2) = rsCount("DJRS")
        End If
        '查询建档人数
        strSQL = "select * from SET_GRXX where YYID='" & tmpYYID & "'"
        Set rsCount = New ADODB.Recordset
        rsCount.Open strSQL, GCon, adOpenStatic, adLockReadOnly
'        arrRS(2, 2) = rsCount.RecordCount
        If rsCount.RecordCount = 0 Then
            arrRS(2, 1) = "建档人数" & "(0人)"
            arrRS(2, 2) = 0
        Else
            arrRS(2, 1) = "建档人数" & "(" & rsCount.RecordCount & "人)"
            arrRS(2, 2) = rsCount.RecordCount
        End If
        
        '查询已登记人数
'        If rsCount.RecordCount > 0 Then
'            rsCount.MoveFirst
'            Do While Not rsCount.EOF
'                strSQL = "select * from YY_SJDJDX where GUID=" & rsCount("GUID")
'                Set rsTmp = New ADODB.Recordset
'                rsTmp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
'                If rsTmp.RecordCount > 0 Then
'                    intTmpDJRS = intTmpDJRS + 1
'                End If
'                rsCount.MoveNext
'            Loop
'        End If

        '查询已登记人数
'        strSQL = "select SET_GRXX.GUID,HealthID,TJSerialNum,YYRXM,DWMC as 所属团体,SET_GRXX.TJRQ,FZ_FZSJ.SFTJ as 是否体检"
        strSQL = "select Count(SET_GRXX.GUID)" _
            & " from SET_GRXX,FZ_FZSJ,YY_TJDJ,SET_DW" _
            & " where " _
            & " SET_GRXX.GUID=FZ_FZSJ.GUID" _
            & " and FZ_FZSJ.SFTJ in (1)" _
            & " and FZ_FZSJ.YYID=YY_TJDJ.YYID" _
            & " and YY_TJDJ.DWID=SET_DW.DWID" _
            & " and YY_TJDJ.YYID='" & lvwDWei.SelectedItem & "'"
        Set rsTmp = New ADODB.Recordset
        rsTmp.Open strSQL, GCon, adOpenStatic, adLockReadOnly
        arrRS(3, 1) = "登记人数" & "(" & rsTmp(0) & "人)"
        arrRS(3, 2) = rsTmp(0)
        MSChart1.ChartData = arrRS
        
    End If
    
    GoTo ExitLab
ErrMsg:
    Status = SetError(Err.Number, Err.Description, Err.Source)
    ErrMsg Status
ExitLab:
    Me.MousePointer = vbDefault
End Sub