?? global.bas
字號(hào):
Attribute VB_Name = "Global"
Public second As Boolean '是否為第二次調(diào)用該窗體
Public who As String '判斷輸入號(hào)碼到底是何人員類別
Public database_data As String
Public YY1 As String
Public MM1 As String
Public nodename As String
Public czry_flag As String
Public Startmonth As Integer
Public Endmonth As Integer
Public iscx As Boolean
Public isadd As Boolean
Public isxg As Boolean '判段該密碼是否用來修改還是新添
Public cn As ADODB.Connection '總的數(shù)據(jù)源
Public rsrmkbh As ADODB.Recordset
Public rsrmkpcl As ADODB.Recordset
Public rspsw As ADODB.Recordset
Public rsdoctor As ADODB.Recordset
Public rsYF As ADODB.Recordset
Public cntemp As ADODB.Connection '用在學(xué)生信息數(shù)據(jù)導(dǎo)入
Public rsrate As ADODB.Recordset
Public rsleibie As ADODB.Recordset '連接到leibie的記錄集
Public rsfeiyong As ADODB.Recordset '連接到feiyong的記錄集
Public rsload As ADODB.Recordset
Public rsrmk As ADODB.Recordset '連接rmk的記錄集
Public Sub condatabase() '創(chuàng)建連接到feiyong數(shù)據(jù)庫的記錄源 '連接本地?cái)?shù)據(jù)庫JIMMY
Set cn = New ADODB.Connection
cn.Provider = "sqloledb"
cn.Properties("Data Source").Value = "JIMMY" '建立與本地?cái)?shù)據(jù)庫的連接
cn.Properties("Initial Catalog").Value = "YAOFEI" '數(shù)據(jù)庫的名稱
cn.Properties("Integrated Security").Value = "SSPI"
cn.open
End Sub
Public Sub check_condatabase()
If cn.State = 1 Then
Else
Call condatabase
End If
End Sub
Public Sub close_condatabase() '關(guān)閉數(shù)據(jù)源
If cn.State = 1 Then
cn.close
End If
End Sub
'***************************************************************
'作為檢查操作員使用權(quán)限的函數(shù),該函數(shù)通過截取load表中的ql_flag字段來
'判斷該操作員所具有的權(quán)限和使用范圍
'ql_flag字段的設(shè)置
'第一位:編輯查詢?nèi)藛T '第二位:批處理人員信息
'第三位:學(xué)生數(shù)據(jù)導(dǎo)入 '第四位:醫(yī)生信息維護(hù)
'第五位:醫(yī)療費(fèi)用調(diào)整 '第六位:藥費(fèi)輸入
'第七位:打印日明細(xì)表 '第八位:打印日?qǐng)?bào)表
'第九位:打印月報(bào)表 '第十位:打印年報(bào)表
'第十一位:查詢帳單 '第十二位:查詢報(bào)表
'第十三位:數(shù)據(jù)備份 '第十四位:數(shù)據(jù)恢復(fù)
'第十五位:操作員維護(hù) '第十六位:系統(tǒng)工具
'第十七位:導(dǎo)出每月數(shù)據(jù)
Public Function check_qx(qx_flag As String, i As Integer) As Boolean
Dim temp As Integer
If qx_flag <> "" Then
temp = Mid(qx_flag, i, 1)
If temp = 0 Then
MsgBox "您無權(quán)限使用該功能!", vbOKOnly + vbExclamation, "注意了:)"
check_qx = False
Else
check_qx = True
End If
Else
MsgBox "未經(jīng)管理員授權(quán),您無權(quán)限使用所有功能!", vbOKOnly + vbExclamation, "注意了:)"
check_qx = False
End If
End Function
Public Function Mtable_name() As String 'earn the month table's name of nowtime
Dim mon As String
mon = Month(Date)
If mon < 10 Then 'if the month less than 10
Mtable_name = "YF0" & mon
Else
Mtable_name = "YF" & mon ' if the month more than 10
End If
End Function
'兩個(gè)記錄集之間的數(shù)據(jù)拷貝
Public Function RescordSet_Copy(rs_source As ADODB.Recordset, rs_destinate As ADODB.Recordset)
'檢查源記錄表中是否有數(shù)據(jù),如果沒有,跳出該函數(shù)
If rs_source.EOF <> True Then
If rs_destinate.EOF <> True And rs_destinate.BOF <> True Then '如果目的表的記錄不為空
Do Until rs_destinate.EOF
rs_destinate.Delete
rs_destinate.MoveNext
Loop
Dim id As String
id = rs_destinate.Fields(0) '記錄編號(hào)的變化
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
Public Sub crystal_init() '對(duì)水晶報(bào)表進(jìn)行初始化
Call check_condatabase
Dim rs_rpt As ADODB.Recordset
Dim rs_feiyong As ADODB.Recordset
Set rs_rpt = New ADODB.Recordset
Set rs_feiyong = New ADODB.Recordset
rs_rpt.open "select * from feiyong_rpt", cn, adOpenStatic, adLockPessimistic
rs_feiyong.open "select * from feiyong", cn, adOpenStatic, adLockPessimistic
If rs_rpt.BOF <> True Then
If rs_feiyong.BOF <> True Then rs_feiyong.MoveFirst
Do Until rs_feiyong.EOF
If rs_rpt.EOF <> True Then
For i = 0 To 7
rs_rpt.Fields(i).Value = rs_feiyong.Fields(i).Value
Next
Else
rs_rpt.AddNew
For i = 0 To 7
rs_rpt.Fields(i).Value = rs_feiyong.Fields(i).Value
Next
End If
rs_rpt.Update
rs_rpt.MoveNext
rs_feiyong.MoveNext
Loop
Else
If rs_rpt.BOF <> True Then rs_rpt.MoveLast
If rs_feiyong.BOF <> True Then rs_feiyong.MoveFirst
Do Until rs_feiyong.EOF
rs_rpt.AddNew
For i = 0 To 7
rs_rpt.Fields(i).Value = rs_feiyong.Fields(i).Value
Next
rs_rpt.Update
rs_rpt.MoveNext
rs_feiyong.MoveNext
Loop
Exit Sub
End If
If rs_rpt.EOF <> True Then
Do Until rs_rpt.EOF
rs_rpt.Delete
rs_rpt.MoveNext
Loop
End If
End Sub
Public Sub import_server() 'put the daily data into the month's table
Call check_condatabase 'use the function to check the connect
Dim rs_month As ADODB.Recordset
Dim rs_feiyong_bak As ADODB.Recordset
Set rs_month = New ADODB.Recordset
Set rs_feiyong_bak = New ADODB.Recordset
rs_month.open "select * from " & Mtable_name & "", cn, adOpenStatic, adLockPessimistic
rs_feiyong_bak.open "select * from feiyong", cn, adOpenStatic, adLockPessimistic
'copy the source's rescordset to the destination's rescordset
Call RescordSet_Copy_Month(rs_feiyong_bak, rs_month)
End Sub
'打印日?qǐng)?bào)表
Public Sub printrbb()
'**********按醫(yī)生人數(shù)進(jìn)行醫(yī)藥費(fèi)的匯總***************
Call check_condatabase
Dim rsdatareport As ADODB.Recordset
Set rsdatareport = New ADODB.Recordset
rsdatareport.open "SELECT doctor.id,doctor.DOCTOR_NAME AS 醫(yī)生, COUNT(feiyong.醫(yī)生) AS 處方量," & _
"SUM(feiyong.醫(yī)藥費(fèi)) AS 醫(yī)藥費(fèi), " & _
"SUM(feiyong.自負(fù)金) As 自負(fù)金 " & _
"From doctor, feiyong " & _
"Where doctor.Id = feiyong.醫(yī)生 " & _
"GROUP BY doctor.DOCTOR_NAME,doctor.id ", cn, adOpenStatic, adLockPessimistic
'****************************************************************
'以上為從FEIYONG表中獲取統(tǒng)計(jì)和獲取數(shù)據(jù)
If rsdatareport.BOF <> True And rsdatareport.EOF <> True Then
'復(fù)制數(shù)據(jù)到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
'設(shè)置中間記錄,當(dāng)復(fù)制時(shí)刪除原來的記錄,再打開該表
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
'使數(shù)據(jù)能夠按照醫(yī)生的實(shí)際人數(shù)進(jìn)行匯總(有可能某醫(yī)生當(dāng)天未參加門診)
Set rsdoctor = New ADODB.Recordset
If rsdoctor.State = 0 Then rsdoctor.open "select * from doctor", cn, adOpenStatic, adLockPessimistic
'如果的確有醫(yī)生未參加該天的門診,則進(jìn)行數(shù)據(jù)的人工輔助匯總
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
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -