📄 出院费用汇总查询.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 7
Left = 3375
TabIndex = 32
Top = 2865
Width = 1605
End
Begin VB.Label Label1
Caption = "CT 费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 8
Left = 630
TabIndex = 31
Top = 3510
Width = 1020
End
Begin VB.Label Label1
Caption = "其它费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 9
Left = 4020
TabIndex = 30
Top = 3510
Width = 1020
End
Begin VB.Label Label1
Caption = "120车费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 10
Left = 450
TabIndex = 29
Top = 4170
Width = 1110
End
Begin VB.Label Label1
Caption = "化验费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 11
Left = 4020
TabIndex = 28
Top = 4185
Width = 1020
End
Begin VB.Label Label1
Caption = "婴儿费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 12
Left = 3345
TabIndex = 27
Top = 7290
Width = 1020
End
Begin VB.Label Label1
Caption = "放疗费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 13
Left = 6435
TabIndex = 26
Top = 7290
Width = 1020
End
Begin VB.Label Label1
Caption = "理疗费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 14
Left = 9195
TabIndex = 25
Top = 7305
Width = 1020
End
Begin VB.Label Label1
Caption = "镜检费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 15
Left = 3345
TabIndex = 24
Top = 7890
Width = 1020
End
Begin VB.Label Label1
Caption = "病理费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 16
Left = 6435
TabIndex = 23
Top = 7890
Width = 1020
End
Begin VB.Label Label1
Caption = "电诊费"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 17
Left = 9195
TabIndex = 22
Top = 7905
Width = 1020
End
Begin VB.Label Label1
Caption = "其 它"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 330
Index = 18
Left = 3330
TabIndex = 21
Top = 8445
Width = 1020
End
End
Attribute VB_Name = "frmLeaveHospitalCollectQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim HzName As String
Private Sub Command1_Click()
Unload Me
frmLeaveHospitalQuery.Enabled = True
frmLeaveHospitalQuery.SetFocus
End Sub
Private Sub Command2_Click()
Dim U As String
Dim U1 As String
Dim U2 As String
Dim I As Integer
Dim j As Integer
Printer.PaperSize = 256
Printer.Height = 8000
Printer.Width = 100000
Printer.Font = "宋体"
Printer.FontSize = 15
Printer.Print " 患者费用汇总清单"
Printer.FontSize = 10.5
Printer.Print " ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━"
Printer.Print
Printer.Print " 打印时间：" + CStr(Date) + " " + CStr(Time) + " 患者住院号：" + CxZyh
U = "┏━━━━┯━━━━━━━━━━┯━━━━┯━━━━━━━━━━┯━━━━┯━━━━━━━━━━┓"
U2 = "┠────┼──────────┼────┼──────────┼────┼──────────┨"
Printer.Print U
For I = 0 To 5
U1 = "┃ "
For j = 0 To 2
U1 = U1 + Space(6 - DxLen(Label1(j + 3 * I).Caption)) + Label1(j + 3 * I).Caption + " │" + Space(20 - DxLen(Text1(j + I * 3).Text)) + Text1(j + I * 3).Text
If j = 2 Then
U1 = U1 + "┃"
Else
U1 = U1 + "│ "
End If
Next j
Printer.Print U1
Printer.Print U2
Next I
U1 = "┃ 其 它 │" + Space(20 - DxLen(Text1(18).Text)) + Text1(18).Text + "│ │ │ │ ┃"
U = "┗━━━━┷━━━━━━━━━━┷━━━━┷━━━━━━━━━━┷━━━━┷━━━━━━━━━━┛"
Printer.Print U1
Printer.Print U
Printer.EndDoc
End Sub
Private Sub Command3_Click()
Dim maxD As Date
Dim M As Integer
Dim U1 As String
Dim U2 As String
Dim I As Integer
Dim minD As Date
Dim su As Currency
If DBGrid1.Visible = False Then
Exit Sub
End If
Data1.Refresh
If Data1.Recordset.EOF Then
MsgBox "无可打印数据"
Exit Sub
End If
Printer.Font = 17
Printer.CurrentX = 100
Printer.CurrentY = 10
Printer.Print "患者: " + frmLeaveHospitalQuery.Text1(0).Text + " " + HzName + " 费用清单"
M = 0
Printer.Print "──────────────────────────────────────────────────"
Printer.ScaleMode = 6
Printer.Font = "隶书"
Printer.FontSize = 10
U1 = U1 + Space(5)
For I = 0 To Data1.Recordset.Fields.Count - 1
U1 = U1 + Space(20 - DxLen(Data1.Recordset.Fields(I).Name)) + DxLeft(Data1.Recordset.Fields(I).Name, 20)
Next I
Printer.Print U1
su = 0
While Not Data1.Recordset.EOF
U2 = Space(5)
For I = 0 To Data1.Recordset.Fields.Count - 1
If Data1.Recordset.Fields(I).Name = "项目收费" Then
U2 = U2 + Space(20 - DxLen(CStr(Format(Data1.Recordset.Fields(I), "0.00")))) + DxLeft(CStr(Format(Data1.Recordset.Fields(I), "0.00")), 20)
Else
U2 = U2 + Space(20 - DxLen(CStr(Data1.Recordset.Fields(I)))) + DxLeft(CStr(Data1.Recordset.Fields(I)), 20)
End If
Next I
su = su + Data1.Recordset.Fields("项目收费")
Printer.Print U2
minD = Date + 1
If M = 0 Then
If Data1.Recordset!收款日期 > maxD Then
maxD = Data1.Recordset!收款日期
End If
If Data1.Recordset!收款日期 < minD Then
minD = Data1.Recordset!收款日期
End If
Else
If Data1.Recordset!划价日期 > maxD Then
maxD = Data1.Recordset!划价日期
End If
If Data1.Recordset!划价日期 < minD Then
minD = Data1.Recordset!划价日期
End If
End If
Data1.Recordset.MoveNext
Wend
Printer.Print "──────────────────────────────────────────────────"
Printer.FontSize = 15
Printer.Print Space(5) + "费用打印时间段：" + CStr(minD) + "----" + Left(CStr(maxD), 10) + " 合计金额：" + CStr(Format(su, "0.00"))
Printer.EndDoc
End Sub
Private Sub DBGrid1_DblClick()
DBGrid1.Visible = False
End Sub
Private Sub Form_Load()
Dim rs As Recordset
Dim CII(30) As Currency
Dim I As Integer
For I = 0 To 18
Text1(I).Text = ""
Next I
Data1.Connect = MyConnect
Data1.DatabaseName = MyDatabase
Set rs = DB.OpenRecordset("SELECT * FROM ZY_CYHZFYMX,XM_TABLE WHERE LEFT(ZY_CYHZFYMX.XMDM,2)=LEFT(XM_TABLE.XM_ID,2) AND ZY_ID='" + Trim(CxZyh) + "'")
While Not rs.EOF
CII(Val(Left(Trim(rs!JSBZ), 2))) = CII(Val(Left(Trim(rs!JSBZ), 2))) + rs!ZJE
rs.MoveNext
Wend
rs.Close
CII(29) = 0
For I = 1 To 19
If CII(I) <> 0 Then
Text1(I - 1).Text = CStr(CII(I))
CII(29) = CII(29) + CII(I)
End If
Next I
Set rs = DB.OpenRecordset("SELECT SUM(ZY_MONEY) AS ZE FROM ZY_HZYJJ WHERE CYSI<>'0' AND ZY_ID='" + Trim(CxZyh) + "'")
If Not rs.EOF Then
Text1(19).Text = Format(rs!ZE, "0.00")
Text1(20).Text = Format(CII(29), "0.00")
Text1(21).Text = Format(rs!ZE - CII(29), "0.00")
End If
rs.Close
End Sub
Private Sub Text1_DblClick(Index As Integer)
If Index > 19 Then
Exit Sub
End If
HzName = Label1(Index).Caption
Data1.RecordSource = "SELECT MZFLOW AS 流水号,zy_cyhzfymx.XM_NAME AS 项目名称,SKRQ AS 收款日期,ZJE AS 项目收费,xm_sl as 项目数量,XM_DW AS 项目单位 FROM ZY_CYHZFYMX LEFT JOIN XMMX_TABLE ON ZY_CYHZFYMX.XMDM=XMMX_TABLE.XM_ID WHERE ZY_ID='" + Trim(CxZyh) + "' AND EXISTS (SELECT * FROM XM_TABLE WHERE JSBZ='" + CStr(Index + 1) + "' AND LEFT(ZY_CYHZFYMX.XMDM,2)=LEFT(XM_TABLE.XM_ID,2)) order by skrq"
Data1.Refresh
DBGrid1.Visible = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -