亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

? 歡迎來到蟲蟲下載站! | ?? 資源下載 ?? 資源專輯 ?? 關(guān)于我們
? 蟲蟲下載站

?? global.bas

?? 一個(gè)醫(yī)院系統(tǒng)的VB源碼
?? BAS
?? 第 1 頁 / 共 2 頁
字號(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 + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频
国产剧情av麻豆香蕉精品| 国产高清亚洲一区| 久久免费午夜影院| 欧美最新大片在线看| 国产乱子轮精品视频| 亚洲国产成人tv| 国产精品护士白丝一区av| 欧美一级片在线看| 精品视频一区二区三区免费| 风流少妇一区二区| 蜜桃视频在线一区| 亚洲成人7777| 一区二区三区在线免费视频| xnxx国产精品| 欧美一区二区三区男人的天堂| 91色porny在线视频| 国产精品一品二品| 精品一区二区三区视频| 亚洲国产人成综合网站| 亚洲欧美成人一区二区三区| 亚洲国产精品国自产拍av| 欧美一级免费观看| 欧美日韩高清影院| 91女厕偷拍女厕偷拍高清| 成人综合婷婷国产精品久久| 激情综合色播五月| 天天操天天综合网| 一二三区精品福利视频| 亚洲国产精品成人综合色在线婷婷| 日韩美女视频在线| 制服丝袜亚洲播放| 欧美日韩免费视频| 欧美猛男gaygay网站| 色综合中文综合网| 在线欧美小视频| 成人va在线观看| 国产凹凸在线观看一区二区| 久久成人精品无人区| 婷婷六月综合亚洲| 午夜精品福利一区二区三区蜜桃| 亚洲激情图片一区| 亚洲综合视频网| 一区二区三区日本| 亚洲精品美国一| 亚洲国产aⅴ天堂久久| 亚洲永久免费视频| 亚洲成人免费看| 日韩精品国产欧美| 美脚の诱脚舐め脚责91| 经典一区二区三区| 国产剧情一区在线| 成人av在线影院| 色一情一乱一乱一91av| 欧美性生交片4| 制服丝袜中文字幕一区| 日韩欧美国产精品| 久久久久久久综合| 国产精品久久久久久久久搜平片 | 国产精品麻豆久久久| 国产精品久久久久久久久晋中 | 国产一区999| 粉嫩aⅴ一区二区三区四区五区| 成人性生交大片免费看中文网站| 成人aa视频在线观看| 91一区二区三区在线观看| 在线免费一区三区| 日韩一区二区三区在线观看| 久久精品夜色噜噜亚洲a∨| 国产拍欧美日韩视频二区| 中文字幕日本乱码精品影院| 一区二区理论电影在线观看| 五月婷婷久久丁香| 久久99精品国产.久久久久| 成人av网站大全| 欧美日韩国产成人在线91| 精品久久国产字幕高潮| 国产精品麻豆99久久久久久| 亚洲午夜羞羞片| 久久69国产一区二区蜜臀| 99久久er热在这里只有精品66| 欧洲人成人精品| 欧美大度的电影原声| 国产精品久久久爽爽爽麻豆色哟哟| 亚洲一区二区视频| 国产一区久久久| 91丝袜高跟美女视频| 日韩精品在线网站| 亚洲天堂av一区| 免费欧美日韩国产三级电影| 99热99精品| 欧美成人高清电影在线| 亚洲人成在线播放网站岛国| 老汉av免费一区二区三区 | 欧美色偷偷大香| 久久综合给合久久狠狠狠97色69| 一区二区三区中文字幕在线观看| 美女一区二区久久| 91亚洲资源网| 久久午夜国产精品| 亚洲高清三级视频| 成人一级片网址| 日韩欧美一区二区久久婷婷| 亚洲欧美日韩在线| 国产精一区二区三区| 欧美福利视频一区| 亚洲色欲色欲www| 国产精品69久久久久水密桃| 8v天堂国产在线一区二区| 亚洲视频电影在线| 国产成人在线看| 日韩色视频在线观看| 亚洲超碰97人人做人人爱| av毛片久久久久**hd| 久久影院视频免费| 青草av.久久免费一区| 欧洲精品在线观看| 国产精品色哟哟| 韩国av一区二区三区| 欧美一区二区视频免费观看| 亚洲宅男天堂在线观看无病毒| www.一区二区| 国产日韩欧美a| 精品亚洲aⅴ乱码一区二区三区| 欧美日韩国产成人在线免费| 夜夜嗨av一区二区三区中文字幕| bt7086福利一区国产| 欧美激情综合在线| 国产福利一区二区三区视频在线| 日韩三级.com| 毛片av一区二区三区| 日韩三级视频在线看| 蜜臀av性久久久久av蜜臀妖精| 7777精品伊人久久久大香线蕉 | 亚洲.国产.中文慕字在线| 99久免费精品视频在线观看 | 日本一区二区三区四区在线视频 | 国产精品免费久久| 国产精品99精品久久免费| 久久久久久麻豆| 国产美女久久久久| 国产人成亚洲第一网站在线播放| 国产一区在线视频| 精品电影一区二区| 国产成人精品一区二| 国产精品视频一二| 色综合久久88色综合天天| 一区二区欧美国产| 欧美精品三级在线观看| 日韩福利电影在线观看| 777色狠狠一区二区三区| 美女视频网站黄色亚洲| 日韩亚洲欧美中文三级| 国内精品写真在线观看| 日本一区二区三区电影| 99在线精品观看| 亚洲第一av色| 日韩欧美国产综合一区| 国产高清不卡一区| 亚洲欧美另类图片小说| 欧美视频一区二区三区四区 | 国产精品日韩精品欧美在线| av在线播放一区二区三区| 一区二区三区在线视频观看58| 欧美日韩亚洲综合在线| 美女在线视频一区| 国产精品网站一区| 欧美在线free| 美女视频免费一区| 国产蜜臀97一区二区三区| 色老头久久综合| 免费视频最近日韩| 中文字幕第一区二区| 91成人免费网站| 久久66热偷产精品| 国产精品二三区| 欧美一区二区在线不卡| 风间由美中文字幕在线看视频国产欧美| 亚洲欧美日韩中文播放| 欧美成人aa大片| 99久久99久久久精品齐齐| 天堂一区二区在线免费观看| 久久久精品国产99久久精品芒果| 日本高清无吗v一区| 国内精品在线播放| 一区二区久久久久| www亚洲一区| 色偷偷久久一区二区三区| 精品夜夜嗨av一区二区三区| 亚洲精品一二三| 久久久久久一级片| 欧美性猛片aaaaaaa做受| 国产精品一区一区三区| 亚洲一区二区视频在线| 国产区在线观看成人精品| 欧美精品久久一区| 91在线视频网址| 国产精品一二三| 日本欧美在线观看| 亚洲三级在线免费观看| xnxx国产精品|