📄 计费信息.frm
字号:
TabIndex = 43
Top = 2520
Width = 615
End
Begin VB.Label Label8
Caption = "年"
Height = 375
Index = 4
Left = 4320
TabIndex = 42
Top = 2520
Width = 495
End
Begin VB.Label Label10
Caption = "日"
Height = 255
Index = 0
Left = 6720
TabIndex = 38
Top = 2160
Width = 375
End
Begin VB.Label Label9
Caption = "月"
Height = 375
Index = 2
Left = 5520
TabIndex = 37
Top = 2160
Width = 615
End
Begin VB.Label Label8
Caption = "年"
Height = 375
Index = 1
Left = 4320
TabIndex = 36
Top = 2160
Width = 495
End
Begin VB.Label Label3
Caption = "性别"
Height = 375
Left = 5220
TabIndex = 32
Top = 360
Width = 615
End
Begin VB.Label Label2
Caption = "姓名"
Height = 330
Left = 2700
TabIndex = 31
Top = 360
Width = 975
End
Begin VB.Label Label1
Caption = "编号"
Height = 375
Left = 120
TabIndex = 30
Top = 345
Width = 735
End
Begin VB.Label Label9
Caption = "元"
Height = 255
Index = 1
Left = 2280
TabIndex = 21
Top = 4680
Width = 735
End
Begin VB.Label Label9
Caption = "元"
Height = 255
Index = 0
Left = 2280
TabIndex = 19
Top = 4200
Width = 735
End
Begin VB.Label Label8
Caption = "总计费用"
Height = 255
Index = 14
Left = 120
TabIndex = 11
Top = 4800
Width = 735
End
Begin VB.Label Label8
Caption = "医院名称"
Height = 375
Index = 11
Left = 2400
TabIndex = 10
Top = 1680
Width = 735
End
Begin VB.Label Label8
Caption = "开药医生"
Height = 375
Index = 8
Left = 120
TabIndex = 9
Top = 3240
Width = 735
End
Begin VB.Label Label8
Caption = "病人姓名"
Height = 375
Index = 7
Left = 120
TabIndex = 8
Top = 1680
Width = 735
End
Begin VB.Label Label8
Caption = "诊费"
Height = 375
Index = 6
Left = 120
TabIndex = 7
Top = 4200
Width = 495
End
Begin VB.Label Label8
Caption = "药品价格"
Height = 255
Index = 3
Left = 2400
TabIndex = 6
Top = 3000
Width = 855
End
Begin VB.Label Label8
Caption = "开药日期"
Height = 375
Index = 0
Left = 2400
TabIndex = 5
Top = 2640
Width = 735
End
Begin VB.Label Label7
Caption = "首诊医师"
Height = 375
Left = 120
TabIndex = 4
Top = 2760
Width = 1095
End
Begin VB.Label Label6
Caption = "初步诊断"
Height = 255
Left = 7320
TabIndex = 3
Top = 1800
Width = 855
End
Begin VB.Label Label5
Caption = "就诊日期"
Height = 255
Left = 2400
TabIndex = 2
Top = 2160
Width = 855
End
Begin VB.Label Label4
Caption = "就诊科室"
Height = 255
Left = 120
TabIndex = 1
Top = 2160
Width = 735
End
End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim i As Double
Dim xingbie As String
Private Sub Command1_Click(Index As Integer)
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Set Rs1 = New Recordset
chaxun = " select * from 患者信息 where 编号 = '" & Text1.Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Text2.Text = Rs1(1)
xingbie = Rs1(2)
If Rs1(2) = "男" Then
Option1.Value = True
Else
Option2.Value = True
End If
Text3.Text = Rs1(1)
Text5.Text = Rs1(12)
Dim s() As String
Dim a As String
a = Rs1(13)
s = Split(a, "-")
Combo2(0).Text = s(0)
Combo3(0).Text = s(1)
Combo4(0).Text = s(2)
Text6.Text = Rs1(24)
Text7.Text = Rs1(25)
Text10.Text = Rs1(26)
Dim Rs2 As New ADODB.Recordset
Dim chaxun2 As String
Set Rs2 = New Recordset
chaxun = " select * from 药品使用情况信息 where 病人id = '" & Text1.Text & "'"
Rs2.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
Dim s1() As String
Dim a1 As String
a1 = Rs2(2)
s1 = Split(a, "-")
Combo2(1).Text = s1(0)
Combo3(1).Text = s1(1)
Combo4(1).Text = s1(2)
Text4.Text = Rs2(1)
Text8.Text = Rs2(5)
Text11.Text = Rs2(6)
GoTo li1
li2: MsgBox "查询失败"
li1:
End Sub
Private Sub Command2_Click()
If MsgBox("确实要退出吗?", vbOKCancel + vbQuestion, "系统退出") = vbOK Then
Unload Me
Else
Exit Sub
End If
End Sub
Private Sub Command3_Click()
i = 0
Dim Rs3 As New ADODB.Recordset
Dim chaxun3 As String
Set Rs3 = New Recordset
chaxun3 = " select * from 药品使用情况信息 where 病人id = '" & Text1.Text & "' "
Rs3.Open chaxun3, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
If Rs3.EOF = False Then
Rs3.MoveFirst
End If
Do While Rs3.EOF = False
Text15 = Text15 + Rs3(3) & ", " & Rs3(4) & "支,箱,克, " & Rs3(7) & "元/ "
i = i + Rs3(4) * Rs3(7)
Rs3.MoveNext
If MsgBox("退出查询", vbOKCancel + vbQuestion, "记录查询") = vbOK Then Exit Sub
Loop
GoTo li1
li2: MsgBox "查询失败"
li1:
End Sub
Private Sub Command4_Click()
Dim Rs1 As New ADODB.Recordset
Dim chaxun As String
Set Rs1 = New Recordset
chaxun = " select * from 患者信息 where 编号 = '" & Text1.Text & "'"
Rs1.Open chaxun, Str, adOpenKeyset, adLockOptimistic, adCmdText
On Error GoTo li2
i = i + Rs1(26)
Text14.Text = i
GoTo li1
li2: MsgBox "查询失败"
li1:
End Sub
Private Sub OLE1_Updated(Code As Integer)
End Sub
Private Sub Command5_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim q1 As Date
Dim q2 As Date
q1 = Combo2(0).Text - Combo3(0).Text - Combo4(0).Text
q2 = Combo2(1).Text - Combo3(1).Text - Combo4(1).Text
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("F:\医疗系统1\系统程序\计费员界面\打印.xls")
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Activate
xlSheet.Cells(1, 2) = Text1.Text ' 编号
xlSheet.Cells(2, 2) = Text5.Text '就诊科室
xlSheet.Cells(3, 2) = Text8.Text '开药医生
xlSheet.Cells(4, 2) = Text11.Text '经受药师
xlSheet.Cells(5, 2) = Text10.Text '诊费
xlSheet.Cells(6, 2) = Text14.Text '总计费用
xlSheet.Cells(1, 4) = Text3.Text '病人姓名
xlSheet.Cells(2, 4) = q1 '就诊日期
xlSheet.Cells(3, 4) = Text15.Text '药品价格
xlSheet.Cells(1, 6) = xingbie '性别
xlSheet.Cells(2, 6) = q2 '开药日期
xlSheet.Cells(1, 8) = Text4.Text '医院名称
xlSheet.Cells(2, 8) = Text7.Text '首诊医师
xlSheet.Cells(3, 7) = Text6.Text '初步诊断
xlSheet.PrintOut
xlBook.Close
xlApp.Quit
Set xlApp = Nothing
End Sub
Private Sub Command6_Click()
Unload Me
Form6.Show
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -