📄 ihms_dischargepatient.frm
字号:
VERSION 5.00
Begin VB.Form frmDischarge
BorderStyle = 1 'Fixed Single
Caption = "出院手续办理"
ClientHeight = 5040
ClientLeft = 45
ClientTop = 330
ClientWidth = 6915
ControlBox = 0 'False
Icon = "IHMS_DischargePatient.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5040
ScaleWidth = 6915
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox txtDateDischarged
DataField = "Date_of_Birth"
DataSource = "datPerInfo"
Height = 285
Left = 600
TabIndex = 0
ToolTipText = "日期格式:YYYY/MM/DD"
Top = 3840
Width = 2055
End
Begin VB.ComboBox cboDischargeStatus
DataField = "Sex"
DataSource = "datPerInfo"
Height = 315
ItemData = "IHMS_DischargePatient.frx":6852
Left = 3000
List = "IHMS_DischargePatient.frx":6862
Style = 2 'Dropdown List
TabIndex = 14
Top = 3840
Width = 3255
End
Begin VB.Data datHospHist
Caption = "Hospital History"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 345
Left = 0
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 0
Visible = 0 'False
Width = 2415
End
Begin VB.CommandButton cmdAbortDischarge
Cancel = -1 'True
Caption = "取消任务(&T)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3600
TabIndex = 11
Top = 4320
Width = 2895
End
Begin VB.CommandButton cmdConfirmDischarge
Caption = "允许出院(&D)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 10
Top = 4320
Width = 2895
End
Begin VB.Frame Frame1
Caption = "住院信息(&A)"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 360
TabIndex = 1
Top = 1080
Width = 6135
Begin VB.TextBox txtDoctorsDiag
BackColor = &H80000016&
DataSource = "datContactInfo"
Height = 1725
Left = 2640
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 480
Width = 3255
End
Begin VB.TextBox txtAdmissionDate
BackColor = &H80000016&
DataField = "Surname"
DataSource = "datPerInfo"
Height = 285
Left = 240
TabIndex = 3
Top = 480
Width = 2055
End
Begin VB.TextBox txtCaseRefNo
BackColor = &H80000016&
DataField = "First_Name"
DataSource = "datPerInfo"
Height = 285
Left = 240
TabIndex = 5
Top = 1200
Width = 2055
End
Begin VB.TextBox txtDoctorInCharge
BackColor = &H80000016&
DataField = "Date_of_Birth"
DataSource = "datPerInfo"
Height = 285
Left = 240
TabIndex = 7
ToolTipText = "DD/MM/YYYY"
Top = 1920
Width = 2055
End
Begin VB.Label Label11
Caption = "医师诊断："
Height = 255
Left = 2640
TabIndex = 8
Top = 240
Width = 1455
End
Begin VB.Label Label10
Caption = "住院日期:"
Height = 255
Left = 240
TabIndex = 2
Top = 240
Width = 1335
End
Begin VB.Label Label9
Caption = "办理参考 #:"
Height = 255
Left = 240
TabIndex = 4
Top = 960
Width = 1455
End
Begin VB.Label Label8
Caption = "主治医师:"
Height = 255
Left = 240
TabIndex = 6
ToolTipText = "DD/MM/YYYY"
Top = 1680
Width = 1335
End
End
Begin VB.Label Label3
Caption = "出院日期:"
Height = 255
Left = 600
TabIndex = 16
ToolTipText = "DD/MM/YYYY"
Top = 3600
Width = 1335
End
Begin VB.Label Label4
Caption = "出院情况:"
Height = 255
Left = 3000
TabIndex = 15
ToolTipText = "DD/MM/YYYY"
Top = 3600
Width = 1695
End
Begin VB.Label Label6
Alignment = 2 'Center
Caption = "出院手续办理"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 1410
TabIndex = 13
Top = 600
Width = 4095
End
Begin VB.Label lblHeading
Alignment = 2 'Center
Caption = "患者编号#"
BeginProperty Font
Name = "宋体"
Size = 18
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 495
Left = 1830
TabIndex = 12
Top = 120
Width = 3255
End
End
Attribute VB_Name = "frmDischarge"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：06/02/21
'描 述：智能医院管理系统 Version 1.0
'网 站：http://www.mndsoft.com/
'e-mail ：mnd@mndsoft.com
'OICQ ：88382850
'****************************************************************************
Option Explicit
Private Sub cmdAbortDischarge_Click()
If MsgBox("中止当前病人出院手续办理吗?", vbCritical + vbYesNo, "提示") = vbYes Then
Unload Me
End If
End Sub
Private Sub cmdConfirmDischarge_Click()
With datHospHist.Recordset
.Edit
.Fields("Admission_Status") = "OUT"
.Fields("Date_of_Discharge") = txtDateDischarged
.Fields("Status_Upon_Discharge") = cboDischargeStatus
.Update
End With
MsgBox "恭喜，患者已经康复，出院手续办理完毕.", vbInformation, "成功"
Unload frmOldPatient
Unload Me
End Sub
Private Sub Form_Load()
Dim flgFound As Boolean
lblHeading.Caption = lblHeading.Caption + Str(somePatient.HospNo)
datHospHist.DatabaseName = App.Path & "\IHMS_97.mdb"
datHospHist.RecordSource = "Patient_Hospital_History"
datHospHist.Refresh
'SEARCH THE PATIENT_HOSPITAL_HISTORY TABLE (for the patient's MOST RECENT record:
datHospHist.Recordset.MoveLast
With datHospHist.Recordset
Do
If .Fields("Hosp_No") = somePatient.HospNo Then
flgFound = True
Else
.MovePrevious
End If
Loop Until (.BOF) Or (flgFound)
End With
'Display information that's already been collected.
'If flgFound = False Then 'Although highly unlikely
With somePatient
txtAdmissionDate = .AdmissionDate
txtCaseRefNo = datHospHist.Recordset.Fields("Case_Ref_No")
txtDoctorInCharge = .DocName
txtDoctorsDiag = .Diagnosis
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -