frmquerybook.frm

医务收费系统,主要的功能不用我说大家都知道的

         End
         Begin VB.Label Label5 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   5
            Left            =   2340
            TabIndex        =   10
            Top             =   3960
            Width           =   90
         End
         Begin VB.Label Label5 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   6
            Left            =   2340
            TabIndex        =   9
            Top             =   4380
            Width           =   90
         End
         Begin VB.Label Label5 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   7
            Left            =   2340
            TabIndex        =   8
            Top             =   4860
            Width           =   90
         End
         Begin VB.Label Label5 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   8
            Left            =   2340
            TabIndex        =   7
            Top             =   5220
            Width           =   90
         End
         Begin VB.Label Label6 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   4
            Left            =   3390
            TabIndex        =   6
            Top             =   3600
            Width           =   90
         End
         Begin VB.Label Label6 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   5
            Left            =   3390
            TabIndex        =   5
            Top             =   3960
            Width           =   90
         End
         Begin VB.Label Label6 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   6
            Left            =   3390
            TabIndex        =   4
            Top             =   4380
            Width           =   90
         End
         Begin VB.Label Label6 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   7
            Left            =   3390
            TabIndex        =   3
            Top             =   4860
            Width           =   90
         End
         Begin VB.Label Label6 
            AutoSize        =   -1  'True
            BackStyle       =   0  'Transparent
            Height          =   180
            Index           =   8
            Left            =   3390
            TabIndex        =   2
            Top             =   5220
            Width           =   90
         End
      End
   End
End
Attribute VB_Name = "frmquerybook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rstemp As ADODB.Recordset
Dim rsrbb As ADODB.Recordset
Private Sub Combo1_Click()
If Combo1.Text = "查询日报表" Then
   Label1(0).Caption = "今日医药费总额："
   Label8.Caption = "医务财务日报表"
   DTPicker1.Visible = True
   Combo2.Visible = False
Else
   Label1(0).Caption = "本月医药费总额："
   Label8.Caption = "医务财务月报表"
   Combo2.Visible = True
   DTPicker1.Visible = False
End If
End Sub

Private Sub Combo2_Click()
Command1.SetFocus
End Sub

Private Sub Command1_Click()

If Combo1.Text = "查询日报表" Then
 
      If DTPicker1.Month < 10 Then
         MM = "YF" & "0" & DTPicker1.Month
      Else
         MM = "YF" & DTPicker1.Month
      End If
Dim YY As String
YY = Year(Date)
'获得您所选择的日期
today = YY & "-" & DTPicker1.Month & "-" & DTPicker1.Day
      
On Error GoTo err1
      Call check_condatabase
      Set rsfeiyong = New ADODB.Recordset
          rsfeiyong.open "select * from feiyong", cn, adOpenStatic, adLockPessimistic
      If rsfeiyong.BOF = True And rsfeiyong.EOF = True Then
          Set rsrbb = New ADODB.Recordset
              rsrbb.open "select * from " & MM & " where 日期='" & today & "' ", cn, adOpenStatic, adLockPessimistic
          If rsrbb.BOF <> True And rsrbb.EOF <> True Then
             Call RescordSet_Copy(rsrbb, rsfeiyong)
          Else
              MsgBox "您所选择的日期没有记录，请另作选择！", vbOKOnly + vbExclamation, "无记录"
              Exit Sub
          End If
          '关闭记录源，如果不关闭的话会发生错误或是导致不能同步进行
          cn.close
          '调用打印日报表的算法，根据feiyong的数据进行汇总和统计
          Call printrbb
          '调用数据填充的过程，使窗体中的label的caption显示统计后的数据
          Call huizong_count
          '************************************************************
      ElseIf rsfeiyong.BOF <> True And rsfeiyong.EOF <> True Then
          If First = False Then
                    If rsfeiyong.State = 1 Then rsfeiyong.close
                       rsfeiyong.open "select * from feiyong", cn, adOpenStatic, adLockPessimistic
                    If rsfeiyong.BOF <> True And rsfeiyong.EOF <> True Then
                       Do Until rsfeiyong.EOF
                          rsfeiyong.Delete
                          rsfeiyong.MoveNext
                       Loop
                    End If
                    
                Set rsrbb = New ADODB.Recordset
                    rsrbb.open "select * from " & MM & " where 日期='" & today & "'", cn, adOpenStatic, adLockPessimistic
                    If rsrbb.EOF <> True And rsrbb.BOF <> True Then
                       If rsfeiyong.State = 1 Then rsfeiyong.close
                       rsfeiyong.open "select * from feiyong", cn, adOpenStatic, adLockPessimistic
                       Do Until rsrbb.EOF
                          rsfeiyong.AddNew
                          For i = 0 To 7
                              rsfeiyong.Fields(i).Value = rsrbb.Fields(i).Value
                          Next i
                          rsrbb.MoveNext
                          rsfeiyong.Update
                       Loop
                       '关闭记录源，如果不关闭的话会发生错误或是导致不能同步进行
                       cn.close
                    Else
                       MsgBox "您所选择的日期没有记录，请另作选择！", vbOKOnly + vbExclamation, "无记录"
                       Call cancel_count
                       Exit Sub
                    End If
          End If
         '调用打印日报表的算法，根据feiyong的数据进行汇总和统计
         Call printrbb
         '*********************统计数据进行汇总，并在窗体中显示********
         '调用数据填充的过程，使窗体中的label的caption显示统计后的数据
         Call cancel_count
         Call huizong_count
         '***********************************************************
          
      End If

ElseIf Combo1.Text = "查询月报表" Then
   If Combo2.Text <> "" Then
      Call printybb_query
      Call cancel_count
      Call huizong_count
   Else
      MsgBox "请选择您所要查询的月份！", vbOKOnly + vbExclamation, "注意了:)"
   End If
End If
Exit Sub
err1:
If err.Number = -2147467259 Then
   t = MsgBox("没有该月份的数据表！", vbOKCancel + vbExclamation, "无表")
   If t = vbOK Then
   ElseIf t = vbCancel Then
       End
   End If
Else
   MsgBox err.Description, vbOKOnly + vbCritical, "出错了:("
End If
End Sub

Private Sub Command2_Click()
On Error GoTo err
Unload Me
Exit Sub
err:
MsgBox err.Description, vbOKOnly + vbCritical, "错误了:("
End Sub

Private Sub Command3_Click()
On Error GoTo err
If Label7.Caption <> "" Then
    If Combo1.Text = "查询日报表" Then
       'print rbb
'       Call printrbb
       CrystalReport1.ReportFileName = App.Path & "\rep\rbb.rpt"
       CrystalReport1.PrintReport
       CrystalReport1.Destination = crptToWindow
       CrystalReport1.Action = 1
       
    ElseIf Combo1.Text = "查询月报表" Then
       'print ybb
       Call printybb_query
       CrystalReport1.ReportFileName = App.Path & "\rep\ybb.rpt"
       CrystalReport1.PrintReport
       CrystalReport1.Destination = crptToWindow
       CrystalReport1.Action = 1
       
    End If
   
Else
    MsgBox "您所选择的日期没有数据可供打印！", vbOKOnly + vbInformation, "注意了：）"
End If
Exit Sub
err:
MsgBox err.Description, vbOKOnly + vbCritical, "出错了"
End Sub

Private Sub Form_Load()
Combo1.AddItem "查询日报表"
Combo1.AddItem "查询月报表"
For i = 1 To 12
    Combo2.AddItem i
Next i
End Sub

'清除label的caption
Public Sub cancel_count()
For c = 1 To 9
    Label3(c - 1).Caption = ""
    Label4(c - 1).Caption = ""
    Label5(c - 1).Caption = ""
    Label6(c - 1).Caption = ""
    lbl_zfj = 0
    lbl_cfl = 0
Next c
Dim sum_yyf As Currency
    sum_yyf = 0
'显示医药费的总额
Label7.Caption = ""
'显示处方量、挂号费和自负金额
label2(4).Caption = ""
label2(5).Caption = ""
label2(6).Caption = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
mainform.StatusBar1.Panels(1).Text = "状态： 无"
End Sub

Public Sub huizong_count()
'*********************统计数据进行汇总，并在窗体中显示******************
Dim sum_yyf As Currency  '显示医药费的总额
Dim lbl_zfj, lbl_cfl As Currency
Dim rsdatareport1 As ADODB.Recordset
Call check_condatabase
Set rsdatareport1 = New ADODB.Recordset
    rsdatareport1.open "select * from datareport", cn, adOpenStatic, adLockPessimistic
'显示datareport表中的数据，也就是医生每天的工作统计
Dim recordcount As Integer
Do Until rsdatareport1.EOF
   rsdatareport1.MoveNext
   recordcount = recordcount + 1
Loop
rsdatareport1.MoveFirst

For c = 1 To recordcount
    Label3(c - 1).Caption = rsdatareport1.Fields(1).Value
    Label4(c - 1).Caption = rsdatareport1.Fields(2).Value
    Label5(c - 1).Caption = rsdatareport1.Fields(3).Value
    Label6(c - 1).Caption = rsdatareport1.Fields(4).Value
    
    lbl_zfj = lbl_zfj + rsdatareport1.Fields(5).Value
    lbl_cfl = lbl_cfl + rsdatareport1.Fields(2).Value
    sum_yyf = sum_yyf + rsdatareport1.Fields(3).Value
    rsdatareport1.MoveNext
Next c
rsdatareport1.close

Label7.Caption = sum_yyf

'显示处方量、挂号费和自负金额
label2(4).Caption = lbl_cfl
label2(5).Caption = lbl_cfl & ".00"
label2(6).Caption = lbl_zfj
End Sub