📄 main_js.frm
字号:
VERSION 5.00
Begin VB.Form Main_JS
BackColor = &H00E0E0E0&
ClientHeight = 3525
ClientLeft = 60
ClientTop = 60
ClientWidth = 5985
ControlBox = 0 'False
LinkTopic = "Form1"
ScaleHeight = 3525
ScaleWidth = 5985
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton CmdEnd
Caption = "返回"
Enabled = 0 'False
Height = 390
Left = 3855
TabIndex = 8
Top = 3000
Width = 1305
End
Begin VB.CommandButton CmdCancel
Caption = "放弃"
Height = 390
Left = 2565
TabIndex = 9
Top = 3000
Width = 1305
End
Begin VB.CommandButton CmdOK
Caption = "确认（打印收据）"
Height = 390
Left = 930
TabIndex = 10
Top = 3000
Width = 1650
End
Begin VB.Frame Frame1
BackColor = &H00C0FFC0&
Height = 2730
Left = 120
TabIndex = 0
Top = 120
Width = 5760
Begin VB.TextBox Txtzje
Height = 300
Left = 2295
Locked = -1 'True
TabIndex = 4
Top = 960
Width = 1740
End
Begin VB.TextBox Txtss
Height = 300
Left = 2295
TabIndex = 3
Top = 1740
Width = 1740
End
Begin VB.TextBox Txtzl
ForeColor = &H000000FF&
Height = 300
Left = 2295
Locked = -1 'True
TabIndex = 2
Top = 2115
Width = 1740
End
Begin VB.ComboBox Cbofkfs
Height = 300
Left = 2295
TabIndex = 1
Top = 1365
Width = 1740
End
Begin VB.Label Label10
Appearance = 0 'Flat
BackColor = &H00E3D9E6&
BorderStyle = 1 'Fixed Single
Caption = " 结算"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 435
Left = 1935
TabIndex = 6
Top = 210
Width = 1905
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "总金额： 结算方式： 实收： 找零： "
Height = 1365
Left = 1305
TabIndex = 5
Top = 1065
Width = 900
End
Begin VB.Label Label9
Appearance = 0 'Flat
BackColor = &H00000000&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 435
Left = 2010
TabIndex = 7
Top = 270
Width = 1890
End
End
End
Attribute VB_Name = "Main_JS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Cbofkfs_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Txtss.SetFocus
End Sub
Private Sub CmdCancel_Click()
EnaT Main_Charge
Unload Me
End Sub
Private Sub Cmdend_Click()
EnaT Main_Charge
Main_Charge.CmdNextZD.Enabled = True
Unload Me
End Sub
Private Sub cmdOK_Click()
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
rs1.Open "select * from 门诊收费信息表", cnn, adOpenKeyset, adLockOptimistic
rs2.Open "select * from 编码表", cnn, adOpenKeyset, adLockOptimistic
rs3.Open "select * from 收费单据信息表", cnn, adOpenKeyset, adLockOptimistic
For i = 1 To Main_Charge.MS1.Row
rs1.AddNew
rs1.Fields("病案类型") = Main_Charge.Cbo1(0).Text
rs1.Fields("病案号") = Main_Charge.Txt1(0).Text
rs1.Fields("患者姓名") = Main_Charge.Txt1(1).Text
rs1.Fields("费用类别") = Main_Charge.Cbo1(1).Text
rs1.Fields("就诊科室") = Main_Charge.Txt1(2).Text
rs1.Fields("医生") = Main_Charge.Txt1(3).Text
rs1.Fields("就诊次数") = Val(Main_Charge.Lbljztime.Caption)
rs1.Fields("帐单号") = Val(Main_Charge.Lblzdn.Caption)
rs1.Fields("处方号") = Val(Main_Charge.Lblcfn.Caption)
rs1.Fields("项目号") = Main_Charge.MS1.TextMatrix(i, 1)
rs1.Fields("类别") = Main_Charge.MS1.TextMatrix(i, 2)
rs1.Fields("药品或诊疗项目名称") = Main_Charge.MS1.TextMatrix(i, 3)
rs1.Fields("数量") = Val(Main_Charge.MS1.TextMatrix(i, 4))
rs1.Fields("单价") = Val(Main_Charge.MS1.TextMatrix(i, 5))
rs1.Fields("金额") = Val(Main_Charge.MS1.TextMatrix(i, 6))
rs1.Fields("执行科室") = Main_Charge.MS1.TextMatrix(i, 7)
rs1.Fields("日期") = Date
rs1.Fields("收据号") = sjh
rs1.Fields("结算方式") = Cbofkfs.Text
rs1.Fields("操作员") = czy
rs1.Fields("工号") = gh
rs1.Fields("窗口号") = ckh
rs1.Update
If Main_Charge.MS1.TextMatrix(i, 2) = "西药费" Or Main_Charge.MS1.TextMatrix(i, 2) = "中药费" Then
rs4.Open "select * from 药品信息表 where 品名='" + Main_Charge.MS1.TextMatrix(i, 3) + "'", cnn, adOpenKeyset, adLockOptimistic
If rs4.RecordCount > 0 Then
rs4.Fields("库存数量") = Val(rs4.Fields("库存数量")) - Val(Main_Charge.MS1.TextMatrix(i, 4))
rs4.Update
End If
rs4.Close
End If
Next i
If rs2.RecordCount > 0 Then
rs2.Fields("原起始收据号") = sjh
rs2.Fields("新起始收据号") = Format(Val(sjh) + 1, "0000000")
End If
rs2.Update
rs3.AddNew
rs3.Fields("收据号") = sjh
rs3.Fields("总金额") = Val(Txtzje.Text)
rs3.Fields("结算方式") = Cbofkfs.Text
rs3.Fields("实收金额") = Val(Txtss.Text)
rs3.Fields("找零") = Val(Txtzl.Text)
rs3.Fields("操作员") = czy
rs3.Fields("工号") = gh
rs3.Fields("窗口号") = ckh
rs3.Fields("日期") = Date
rs3.Update
rs1.Close
rs2.Close
rs3.Close
Dim newcnn As New ADODB.Connection
Dim SQL1, SQL2 As String
newcnn.Open cnn
SQL1 = "insert 门诊收费信息表(病案类型,病案号,患者姓名,费用类别,就诊科室,医生,就诊次数,帐单号,处方号,项目号,类别,药品或诊疗项目名称,数量,单价,金额,执行科室,日期,收据号,结算方式,操作员,工号,窗口号) select 病案类型,病案号,患者姓名,费用类别,就诊科室,医生,就诊次数,帐单号,处方号,项目号,类别,药品或诊疗项目名称,数量,单价,金额,执行科室,日期,收据号,结算方式,操作员,工号,窗口号 from 门诊收费临时表 where 病案类型='" + Main_Charge.Cbo1(0).Text + "'and 病案号='" + Main_Charge.Txt1(0).Text + "'order by 收据号"
newcnn.Execute (SQL1)
SQL2 = "delete from 门诊收费临时表"
newcnn.Execute (SQL2)
newcnn.Close
MsgBox "收据号为: " & sjh
Frame1.Enabled = False
CmdOK.Enabled = False
CmdEnd.Enabled = True
End Sub
Private Sub Form_Load()
Cbofkfs.AddItem ("现金")
Cbofkfs.AddItem ("支票")
Cbofkfs.AddItem ("计账")
End Sub
Private Sub Txtss_Change()
Txtzl.Text = Format(Val(Txtss.Text) - Val(Txtzje.Text), "0.00")
End Sub
Private Sub Txtss_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then CmdOK.SetFocus
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -