📄 在院患者查询.frm
字号:
ForeColor = &H00FF0000&
Height = 375
Index = 19
Left = 6690
TabIndex = 35
Top = 2550
Width = 1455
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 = &H00FF0000&
Height = 375
Index = 16
Left = 165
TabIndex = 34
Top = 2550
Width = 1455
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 = &H00FF0000&
Height = 375
Index = 17
Left = 2730
TabIndex = 33
Top = 2550
Width = 855
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 = &H00FF0000&
Height = 375
Index = 18
Left = 4080
TabIndex = 32
Top = 2550
Width = 855
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 = &H00FF0000&
Height = 375
Index = 2
Left = 3690
TabIndex = 31
Top = 225
Width = 1455
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 = &H00FF0000&
Height = 375
Index = 6
Left = 4020
TabIndex = 30
Top = 690
Width = 975
End
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "在院患者查询.frx":143C
Height = 4170
Left = 90
OleObjectBlob = "在院患者查询.frx":144C
TabIndex = 57
Top = 1245
Width = 9315
End
Begin VB.Label Label1
Caption = "——"
BeginProperty Font
Name = "隶书"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808000&
Height = 315
Index = 20
Left = 4470
TabIndex = 61
Top = 855
Width = 600
End
End
Attribute VB_Name = "frmPatientQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub DisHz28()
Dim rs As Recordset
Dim r1 As Recordset
frmPatientQuery.Tag = ""
Set rs = db.OpenRecordset("SELECT * FROM ZY_ZYHZ WHERE ZY_ZYID='" + Trim(txtZYH.Text) + "'")
If rs.EOF Then
rs.Close
txtZYH.Text = ""
txtZYH.SetFocus
Exit Sub
End If
Text1(0).Text = rs!zy_name
If Not IsNull(rs!ZY_SEX) Then
Text1(1).Text = rs!ZY_SEX
End If
Text1(2).Text = CStr(rs!ZY_BIRTH)
Text1(3).Text = rs!ZY_AGE
Text1(4).Text = CStr(rs!ZY_MARRY)
Text1(5).Text = CStr(rs!ZY_ZY)
Text1(6).Text = CStr(rs!ZY_SHENG)
Text1(7).Text = CStr(rs!ZY_XIAN)
Text1(8).Text = CStr(rs!ZY_MZ)
Text1(9).Text = CStr(rs!ZY_GJ)
Text1(10).Text = CStr(rs!ZY_SFZH)
Text1(11).Text = rs!ZY_GZDW
Text1(12).Text = rs!ZY_DHHM
Text1(13).Text = rs!ZY_YZBM1
Text1(14).Text = rs!ZY_HKDZ
Text1(15).Text = rs!ZY_YZBM2
Text1(16).Text = rs!ZY_LXRNAME
Text1(17).Text = rs!ZY_GX
Text1(18).Text = rs!ZY_DZ
Text1(19).Text = rs!ZY_DH
If Trim(rs!ZY_RYKS) <> "" Then
Set r1 = db.OpenRecordset("SELECT * FROM KS_TABLE WHERE KS_ID='" + Trim(rs!ZY_RYKS) + "'")
If Not r1.EOF Then
Text3.Text = Trim(rs!ZY_RYKS) + "-" + r1!ks_name
End If
r1.Close
End If
If Not IsNull(rs!ZY_BS) Then
Text4.Text = rs!ZY_BS
End If
rs.Close
Cxzyh = Trim(txtZYH.Text)
Data1.RecordSource = "SELECT MZFLOW AS 流水号,xmmx_table.xm_name AS 项目名称,SKRQ AS 收款日期,ZJE AS 项目收费,XM_SL AS 项目数量,sky_id as 操作员代码,ys_id as 医师代码 FROM ZY_ZYHZFY LEFT JOIN XMMX_TABLE ON ZY_ZYHZFY.XMDM=XMMX_TABLE.XM_ID WHERE ZY_ID='" + Trim(txtZYH.Text) + "' order by SKRQ"
Data1.Refresh
End Sub
Private Sub Command1_Click()
If Len(Trim(txtZYH.Text)) <> 8 Then
MsgBox "请输入正确的住院号！"
Exit Sub
End If
Cxzyh = txtZYH.Text
Me.Enabled = False
frmPatientCollectQuery.Show
End Sub
Private Sub Command2_Click()
yscxID = Trim(txtZYH.Text)
frmPatientDoctorQuery.Show
End Sub
Private Sub Command3_Click()
Dim rs As Recordset
frmPatientQuery.Tag = ""
If Len(Trim(txtZYH.Text)) <> 8 Then
Exit Sub
End If
Set rs = db.OpenRecordset("select zy_ryrq from zy_in_out where zy_id='" + txtZYH.Text + "'")
If rs.EOF Then
rs.Close
Exit Sub
End If
If Command3.Caption = "药品明细查询" Then
Data1.RecordSource = "SELECT HJ_DATE AS 划价日期,HJ_ID AS 划价号,hj_money as 金额,YP_NAME AS 药品名称,AMOUNT AS 数量,STANDARD AS 规格,UNIT AS 单位,HJ_MONEY AS 划价金额,TF_ID AS 统方号,ys_id as 医师代码 FROM YJ3_HJ WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND JK_FLAG='1' and hj_date>cast('" + CStr(rs!zy_ryrq) + "' as datetime) " _
& " UNION " & "SELECT HJ_DATE AS 划价日期,HJ_ID AS 划价号,hj_money as 金额,YP_NAME AS 药品名称,AMOUNT AS 数量,STANDARD AS 规格,UNIT AS 单位,HJ_MONEY AS 划价金额,TF_ID AS 统方号,ys_id as 医师代码 FROM YJ2_HJ WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND JK_FLAG='1' and hj_date>cast('" + CStr(rs!zy_ryrq) + "' as datetime) " _
& " UNION " & "SELECT HJ_DATE AS 划价日期,HJ_ID AS 划价号,hj_money as 金额,YP_NAME AS 药品名称,AMOUNT AS 数量,STANDARD AS 规格,UNIT AS 单位,HJ_MONEY AS 划价金额,TF_ID AS 统方号,ys_id as 医师代码 FROM YJ1_HJ WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND JK_FLAG='1' and hj_date>cast('" + CStr(rs!zy_ryrq) + "' as datetime) order by hj_date"
rs.Close
Data1.Refresh
Command3.Caption = "费用明细查询"
Else
Data1.RecordSource = "SELECT MZFLOW AS 流水号,xmmx_table.xm_name AS 项目名称,SKRQ AS 收款日期,ZJE AS 项目收费,XM_SL AS 项目数量,sky_id as 操作员代码,ys_id as 医师代码 FROM ZY_ZYHZFY LEFT JOIN XMMX_TABLE ON ZY_ZYHZFY.XMDM=XMMX_TABLE.XM_ID WHERE ZY_ID='" + Trim(txtZYH.Text) + "' order by SKRQ"
Data1.Refresh
Command3.Caption = "药品明细查询"
End If
End Sub
Private Sub Command4_Click()
'ZZZ = 28
'Me.Enabled = False
'frmPatientIdQuery.Show
Frame1.Visible = True
Command6.Visible = True
End Sub
Private Sub Command5_Click()
Unload Me
Form3.Enabled = True
Form3.SetFocus
End Sub
Private Sub Command6_Click()
Frame1.Visible = False
Command6.Visible = False
End Sub
Private Sub Command7_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 Data1.RecordSource = "" 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
If Data1.Recordset.Fields(0).Name = "流水号" Then
Printer.Print "患者: " + Text1(0).Text + frmPatientQuery.Tag + " 费用清单"
M = 0
Else
Printer.Print "患者: " + Text1(0).Text + " 用药清单"
M = 1
End If
Printer.Print "──────────────────────────────────────────────────"
Printer.ScaleMode = 6
Printer.Font = "隶书"
Printer.FontSize = 10
U1 = U1 + Space(5)
For i = 0 To Data1.Recordset.Fields.Count - 1
If Data1.Recordset.Fields(i).Name = "流水号" Or Data1.Recordset.Fields(i).Name = "划价号" _
Or Data1.Recordset.Fields(i).Name = "数量" Or Data1.Recordset.Fields(i).Name = "项目数量" Then
U1 = U1 + Space(10 - DxLen(Data1.Recordset.Fields(i).Name)) + DxLeft(Data1.Recordset.Fields(i).Name, 10)
Else
U1 = U1 + Space(20 - DxLen(Data1.Recordset.Fields(i).Name)) + DxLeft(Data1.Recordset.Fields(i).Name, 20)
End If
Next i
Printer.Print U1
su = 0
minD = Date + 1
While Not Data1.Recordset.EOF
U2 = Space(5)
For i = 0 To Data1.Recordset.Fields.Count - 1
If Data1.Recordset.Fields(i).Name = "项目收费" Or 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)
su = su + Data1.Recordset.Fields(i)
ElseIf Data1.Recordset.Fields(i).Name = "流水号" Or Data1.Recordset.Fields(i).Name = "划价号" _
Or Data1.Recordset.Fields(i).Name = "数量" Or Data1.Recordset.Fields(i).Name = "项目数量" Then
U2 = U2 + Space(10 - DxLen(CStr(Data1.Recordset.Fields(i)))) + DxLeft(CStr(Data1.Recordset.Fields(i)), 10)
Else
U2 = U2 + Space(20 - DxLen(CStr(Data1.Recordset.Fields(i)))) + DxLeft(CStr(Data1.Recordset.Fields(i)), 20)
End If
Next i
Printer.Print U2
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(10) + "费用打印时间段：" + Left(CStr(minD), 10) + "----" + Left(CStr(maxD), 10) + " 合计金额：" + CStr(Format(su, "0.00"))
Printer.EndDoc
End Sub
Private Sub Command8_Click()
Dim rs As Recordset
Set rs = db.OpenRecordset("select zy_ryrq from zy_in_out where zy_id='" + txtZYH.Text + "'")
If rs.EOF Then
rs.Close
Exit Sub
End If
If Command3.Caption = "费用明细查询" Then
Data1.RecordSource = "SELECT HJ_DATE AS 划价日期,HJ_ID AS 划价号,YP_NAME AS 药品名称,AMOUNT AS 数量,STANDARD AS 规格,UNIT AS 单位,HJ_MONEY AS 划价金额,TF_ID AS 统方号 FROM YJ3_HJ WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND JK_FLAG='1' AND HJ_DATE>=CONVERT(DATETIME,'" + Text2.Text + " 00:00:00') AND HJ_DATE<=CONVERT(DATETIME,'" + Text5.Text + " 00:00:00') and hj_date>cast('" + CStr(rs!zy_ryrq) + "' as datetime)" _
& " UNION " & "SELECT HJ_DATE AS 划价日期,HJ_ID AS 划价号,YP_NAME AS 药品名称,AMOUNT AS 数量,STANDARD AS 规格,UNIT AS 单位,HJ_MONEY AS 划价金额,TF_ID AS 统方号 FROM YJ2_HJ WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND JK_FLAG='1' AND HJ_DATE>=CONVERT(DATETIME,'" + Text2.Text + " 00:00:00') AND HJ_DATE<=CONVERT(DATETIME,'" + Text5.Text + " 00:00:00')+1 and hj_date>cast('" + CStr(rs!zy_ryrq) + "' as datetime)"
rs.Close
Data1.Refresh
Else
Data1.RecordSource = "SELECT MZFLOW AS 流水号,xmmx_table.xm_name AS 项目名称,SKRQ AS 收款日期,ZJE AS 项目收费,XM_DW AS 项目单位,sky_id as 操作员代码 FROM ZY_ZYHZFY LEFT JOIN XMMX_TABLE ON ZY_ZYHZFY.XMDM=XMMX_TABLE.XM_ID WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND SKRQ>=CONVERT(DATETIME,'" + Text2.Text + "') AND SKRQ<=CONVERT(DATETIME,'" + Text5.Text + "')+1 order by cast(mzflow as int)"
Data1.Refresh
End If
End Sub
Private Sub Command9_Click()
Data1.RecordSource = "SELECT MZFLOW AS 流水号,xmmx_table.xm_name AS 项目名称,SKRQ AS 收款日期,ZJE AS 项目收费,sky_id as 操作员代码,XM_DW AS 项目单位 FROM ZY_ZYHZFY LEFT JOIN XMMX_TABLE ON ZY_ZYHZFY.XMDM=XMMX_TABLE.XM_ID WHERE ZY_ID='" + Trim(txtZYH.Text) + "' AND EXISTS (SELECT * FROM XM_TABLE WHERE JSBZ='" + Trim(Left(Combo1.Text, 2)) + "' AND LEFT(ZY_ZYHZFY.XMDM,2)=LEFT(XM_TABLE.XM_ID,2)) order by skrq"
Data1.Refresh
End Sub
Private Sub Form_Activate()
If Data1.RecordSource <> "" Then
Data1.Refresh
End If
End Sub
Private Sub Form_Load()
Me.Top = 0
Me.Left = 0
Me.Width = Screen.Width
Me.Height = Screen.Height
Dim t As Control
For Each t In frmPatientQuery.Controls
If TypeOf t Is TextBox Then
t.Text = ""
End If
Next
Data1.Connect = MyConnect
Data1.DatabaseName = MyDatabase
Text2.Text = CStr(Date - 1)
Text5.Text = CStr(Date)
End Sub
Private Sub txtZYH_Change()
Dim i As Integer
If Len(txtZYH.Text) = 8 Then
DisHz28
Exit Sub
End If
If Len(txtZYH.Text) = 1 Then
For i = 0 To 19
Text1(i).Text = ""
Next i
Text3.Text = ""
Text4.Text = ""
Cxzyh = ""
End If
End Sub
Private Sub txtZyh_GotFocus()
txtZYH.BackColor = vbWhite
Label2(0).ForeColor = vbRed
txtZYH.SelStart = 0
txtZYH.SelLength = Len(txtZYH.Text)
End Sub
Private Sub txtZyh_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And txtZYH.Text <> "" Then
txtZYH.Text = Format(txtZYH, "00000000")
End If
End Sub
Private Sub txtZYH_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 222 Then
txtZYH.Text = ""
Exit Sub
End If
If KeyCode = 13 Then
Command1.SetFocus
End If
End Sub
Private Sub txtZYH_LostFocus()
txtZYH.BackColor = &HC0E0FF
Label2(0).ForeColor = &H8000&
End Sub
Private Sub VScroll1_Change()
Text2.Text = CStr(Date + VScroll1.Value)
End Sub
Private Sub VScroll2_Change()
Text5.Text = CStr(Date + VScroll2.Value)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -