global.bas

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

                 rsdoctor.MoveNext
              End If
           End If
       Loop
    End If
End If

End Sub
'打印月报表
Public Sub printybb()

'**********按医生人数进行医药费的汇总***************
Call check_condatabase

Dim rs_month_temp As ADODB.Recordset
Dim rs_month As ADODB.Recordset
Set rs_month_temp = New ADODB.Recordset
Set rs_month = New ADODB.Recordset
rs_month.open "select * from " & Mtable_name & "", cn, adOpenStatic, adLockPessimistic
rs_month_temp.open "select * from YF_month_temp", cn, adOpenStatic, adLockPessimistic

If rs_month_temp.BOF <> True And rs_month_temp.EOF <> True Then
   Do Until rs_month_temp.EOF
            rs_month_temp.Delete
            rs_month_temp.MoveNext
   Loop
End If

Do Until rs_month.EOF
         rs_month_temp.AddNew
         For i = 0 To 7
             rs_month_temp.Fields(i).Value = rs_month.Fields(i).Value
         Next
             rs_month.MoveNext
             rs_month_temp.Update
Loop


Dim rsdatareport As ADODB.Recordset
Set rsdatareport = New ADODB.Recordset
    rsdatareport.open "SELECT doctor.id,doctor.DOCTOR_NAME AS 医生, COUNT(YF_month_temp.医生) AS 处方量," & _
                      "SUM(YF_month_temp.医药费) AS 医药费, " & _
                      "SUM(YF_month_temp.自负金) As 自负金 " & _
                      "From doctor, YF_month_temp " & _
                      "Where doctor.Id = YF_month_temp.医生 " & _
                      "GROUP BY doctor.DOCTOR_NAME,doctor.id ", cn, adOpenStatic, adLockPessimistic


'****************************************************************
'以上为从YF_month_temp表中获取统计和获取数据
If rsdatareport.BOF <> True And rsdatareport.EOF <> True Then
    '复制数据到DATAREPORT表中
    Set rstemp = New ADODB.Recordset
        rstemp.open "select * from datareport", cn, adOpenStatic, adLockPessimistic
    If rstemp.BOF <> True And rstemp.EOF <> True Then
       Do Until rstemp.EOF
          rstemp.Delete
          rstemp.MoveNext
       Loop
    End If
    If rstemp.State = 1 Then rstemp.close
    rstemp.open "select * from datareport", cn, adOpenStatic, adLockPessimistic

    '设置中间记录，当复制时删除原来的记录，再打开该表
    Do Until rsdatareport.EOF
       rstemp.AddNew
       For i = 0 To 4
           If i = 4 Then
              rstemp.Fields(i + 1).Value = rsdatareport.Fields(i).Value
              rstemp.Fields(i).Value = rsdatareport.Fields(3) / rsdatareport.Fields(2)
           Else
               rstemp.Fields(i).Value = rsdatareport.Fields(i).Value
           End If
       Next i
       rstemp.Update
       rsdatareport.MoveNext
    Loop
    '使数据能够按照医生的实际人数进行汇总（有可能某医生当天未参加门诊）
    Set rsdoctor = New ADODB.Recordset
    If rsdoctor.State = 0 Then rsdoctor.open "select * from doctor", cn, adOpenStatic, adLockPessimistic
    '如果的确有医生未参加该天的门诊，则进行数据的人工辅助汇总
    If rsdatareport.recordcount <> rsdoctor.recordcount Then
       rstemp.close
       rstemp.open "select * from datareport", cn, adOpenStatic, adLockPessimistic
       Do Until rsdoctor.EOF
           If rstemp.EOF Then
              Do Until rsdoctor.EOF
                 rstemp.AddNew
                 rstemp.Fields(0).Value = rsdoctor.Fields("id").Value
                 rstemp.Fields(1).Value = rsdoctor.Fields("doctor_name").Value
                 For i = 2 To 5
                     rstemp.Fields(i).Value = 0
                 Next i
                 rstemp.Update
                 rsdoctor.MoveNext
              Loop
           Else
              If rsdoctor.Fields("id").Value <> rstemp.Fields("id").Value Then
                 rstemp.AddNew
                 rstemp.Fields(0).Value = rsdoctor.Fields("id").Value
                 rstemp.Fields(1).Value = rsdoctor.Fields("doctor_name").Value
                 For i = 2 To 5
                     rstemp.Fields(i).Value = 0
                 Next i
                 With rstemp
                      .Update
                      .close
                      .open "select * from datareport", cn, adOpenStatic, adLockPessimistic
                 End With
                 rsdoctor.MoveFirst
              Else
                 rstemp.MoveNext
                 rsdoctor.MoveNext
              End If
           End If
       Loop
    End If
End If
End Sub
'打印月报表
Public Sub printybb_query()
Dim table_name As String
table_name = frmquerybook.Combo2.Text
If table_name < 10 Then
   table_name = "YF0" & table_name
Else
   table_name = "YF" & table_name
End If
'**********按医生人数进行医药费的汇总***************
Call check_condatabase

Dim rs_month_temp As ADODB.Recordset
Dim rs_month As ADODB.Recordset
Set rs_month_temp = New ADODB.Recordset
Set rs_month = New ADODB.Recordset
rs_month.open "select * from " & table_name & "", cn, adOpenStatic, adLockPessimistic
rs_month_temp.open "select * from YF_month_temp", cn, adOpenStatic, adLockPessimistic
If rs_month_temp.BOF <> True And rs_month_temp.EOF <> True Then
   Do Until rs_month_temp.EOF
            rs_month_temp.Delete
            rs_month_temp.MoveNext
   Loop
End If
Do Until rs_month.EOF
         rs_month_temp.AddNew
         For i = 0 To 7
             rs_month_temp.Fields(i).Value = rs_month.Fields(i).Value
         Next
             rs_month.MoveNext
             rs_month_temp.Update
Loop

Dim rsdatareport As ADODB.Recordset
Set rsdatareport = New ADODB.Recordset
    rsdatareport.open "SELECT doctor.id,doctor.DOCTOR_NAME AS 医生, COUNT(YF_month_temp.医生) AS 处方量," & _
                      "SUM(YF_month_temp.医药费) AS 医药费, " & _
                      "SUM(YF_month_temp.自负金) As 自负金 " & _
                      "From doctor, YF_month_temp " & _
                      "Where doctor.Id = YF_month_temp.医生 " & _
                      "GROUP BY doctor.DOCTOR_NAME,doctor.id ", cn, adOpenStatic, adLockPessimistic


'****************************************************************
'以上为从YF_month_temp表中获取统计和获取数据
If rsdatareport.BOF <> True And rsdatareport.EOF <> True Then
    '复制数据到DATAREPORT表中
    Set rstemp = New ADODB.Recordset
        rstemp.open "select * from datareport", cn, adOpenStatic, adLockPessimistic
    If rstemp.BOF <> True And rstemp.EOF <> True Then
       Do Until rstemp.EOF
          rstemp.Delete
          rstemp.MoveNext
       Loop
    End If
    If rstemp.State = 1 Then rstemp.close
    rstemp.open "select * from datareport", cn, adOpenStatic, adLockPessimistic

    '设置中间记录，当复制时删除原来的记录，再打开该表
    Do Until rsdatareport.EOF
       rstemp.AddNew
       For i = 0 To 4
           If i = 4 Then
              rstemp.Fields(i + 1).Value = rsdatareport.Fields(i).Value
              rstemp.Fields(i).Value = rsdatareport.Fields(3) / rsdatareport.Fields(2)
           Else
               rstemp.Fields(i).Value = rsdatareport.Fields(i).Value
           End If
       Next i
       rstemp.Update
       rsdatareport.MoveNext
    Loop
    '使数据能够按照医生的实际人数进行汇总（有可能某医生当天未参加门诊）
    Set rsdoctor = New ADODB.Recordset
    If rsdoctor.State = 0 Then rsdoctor.open "select * from doctor", cn, adOpenStatic, adLockPessimistic
    '如果的确有医生未参加该天的门诊，则进行数据的人工辅助汇总
    If rsdatareport.recordcount <> rsdoctor.recordcount Then
       rstemp.close
       rstemp.open "select * from datareport", cn, adOpenStatic, adLockPessimistic
       Do Until rsdoctor.EOF
           If rstemp.EOF Then
              Do Until rsdoctor.EOF
                 rstemp.AddNew
                 rstemp.Fields(0).Value = rsdoctor.Fields("id").Value
                 rstemp.Fields(1).Value = rsdoctor.Fields("doctor_name").Value
                 For i = 2 To 5
                     rstemp.Fields(i).Value = 0
                 Next i
                 rstemp.Update
                 rsdoctor.MoveNext
              Loop
           Else
              If rsdoctor.Fields("id").Value <> rstemp.Fields("id").Value Then
                 rstemp.AddNew
                 rstemp.Fields(0).Value = rsdoctor.Fields("id").Value
                 rstemp.Fields(1).Value = rsdoctor.Fields("doctor_name").Value
                 For i = 2 To 5
                     rstemp.Fields(i).Value = 0
                 Next i
                 With rstemp
                      .Update
                      .close
                      .open "select * from datareport", cn, adOpenStatic, adLockPessimistic
                 End With
                 rsdoctor.MoveFirst
              Else
                 rstemp.MoveNext
                 rsdoctor.MoveNext
              End If
           End If
       Loop
    End If
End If
End Sub


'主要用于将记录拷贝到月表中去
Public Function RescordSet_Copy_Month(rs_source As ADODB.Recordset, rs_destinate As ADODB.Recordset)
'检查源记录表中是否有数据,如果没有,跳出该函数
If rs_source.EOF <> True Then
    If rs_destinate.EOF <> True And rs_destinate.BOF <> True Then  '如果目的表的记录不为空
            Dim id As String
            id = rs_destinate.Fields(0)  '记录编号的变化
            Do Until rs_source.EOF
               rs_destinate.AddNew
               For i = 1 To 7
                   rs_destinate.Fields(i).Value = rs_source.Fields(i).Value
               Next
               id = id + 1
               rs_destinate.Fields(0).Value = id
               rs_destinate.Update
               rs_destinate.MoveNext
               rs_source.MoveNext
            Loop
    
    Else              '**************如果目的表的记录为空
           Do Until rs_source.EOF
              rs_destinate.AddNew
           For i = 0 To 7
               rs_destinate.Fields(i).Value = rs_source.Fields(i).Value
           Next
           rs_destinate.Update
           rs_destinate.MoveNext
           rs_source.MoveNext
        Loop

    End If
End If
End Function