📄 ihms_admitpatient.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 960
TabIndex = 6
Top = 720
Width = 2055
End
Begin VB.TextBox txtStateOfOrigin
BackColor = &H80000016&
DataSource = "datPerInfo"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1440
TabIndex = 14
Top = 1440
Width = 1575
End
Begin VB.Label lblHospNo
Caption = "病例编号(&H):"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 3
Top = 360
Width = 1575
End
Begin VB.Label Label5
Caption = "职业:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3585
TabIndex = 15
Top = 1485
Width = 600
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "性别:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3570
TabIndex = 11
Top = 1125
Width = 525
End
Begin VB.Label Label1
Caption = "出生年月:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 9
ToolTipText = "DD/MM/YYYY"
Top = 1095
Width = 975
End
Begin VB.Label lblFName
Caption = "名称:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3570
TabIndex = 7
Top = 765
Width = 855
End
Begin VB.Label lblSName
Caption = "患者姓:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 5
Top = 720
Width = 735
End
Begin VB.Label Label19
Caption = "国籍:"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 240
TabIndex = 13
Top = 1440
Width = 1095
End
End
Begin VB.Label Label3
Alignment = 2 'Center
Caption = "住院情况"
BeginProperty Font
Name = "Courier New"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 420
TabIndex = 27
Top = 600
Width = 6015
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "新进病人"
BeginProperty Font
Name = "Courier New"
Size = 18
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 495
Left = 420
TabIndex = 1
Top = 120
Width = 6015
End
End
Attribute VB_Name = "frmAdmission"
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 cmdAbortAdmission_Click()
If MsgBox("确认停办当前住院手续登记吗?" & vbCrLf & "(提示: 登记的信息不准确.)", vbCritical + vbYesNo, "提示") = vbYes Then
Unload Me
End If
End Sub
Private Sub cmdConfirmAdmission_Click()
'On Error GoTo errHnd
With frmNewReg.datPerInfo.Recordset
'PERSONAL INFO
.Fields("Hosp_No") = frmNewReg.thisNewPatient.HospNo
.Fields("SName") = frmNewReg.thisNewPatient.SName
.Fields("FName") = frmNewReg.thisNewPatient.FName
.Fields("Sex") = frmNewReg.thisNewPatient.Sex
.Fields("Home_Add") = frmNewReg.thisNewPatient.HomeAdd
.Fields("State_of_Origin") = frmNewReg.thisNewPatient.StateOfOrigin
.Fields("Occupation") = frmNewReg.thisNewPatient.Occupation
'NEXT OF KIN'S INFO
.Fields("Name_of_NoK") = frmNewReg.thisNewPatient.NameNoK
.Fields("Relationship_to_NoK") = frmNewReg.thisNewPatient.RelaNok
.Fields("Add_of_NoK") = frmNewReg.thisNewPatient.AddNok
'SPONSOR'S INFO
.Fields("Name_of_Sponsor") = frmNewReg.thisNewPatient.SponsorName
.Fields("Add_of_Sponsor") = frmNewReg.thisNewPatient.SponsorAdd
End With
With frmNewReg.datLabInfo.Recordset
'LABORATORY INFO
.Fields("Hosp_No") = frmNewReg.thisNewPatient.HospNo
.Fields("Blood_Group") = frmNewReg.thisNewPatient.BloodGrp
.Fields("RhFactor") = frmNewReg.thisNewPatient.RHFactor
.Fields("Allergy") = frmNewReg.thisNewPatient.Allergy
End With
With Me.datHospHist.Recordset
.Fields("Hosp_No") = Val(txtHospNo)
.Fields("Admission_Status") = "IN"
.Fields("Date_of_Admission") = txtDateOfAdmission
.Fields("Name_of_Doctor") = txtDoctorInCharge
.Fields("Doctors_Diagnosis") = txtDoctorsDiag
End With
frmNewReg.datPerInfo.Recordset.Update
frmNewReg.datLabInfo.Recordset.Update
Me.datHospHist.Recordset.Update
MsgBox "新病人的住院手续登记成功.", vbInformation, "成功"
Unload Me
Exit Sub
errhnd:
Debug.Print Err.Number; " "; Err.Description
MsgBox "一个未知错误.", vbInformation, "未知错误!"
Resume Next
End Sub
Private Sub Form_Load()
datHospHist.DatabaseName = App.Path & "\IHMS_97.mdb"
datHospHist.RecordSource = "Patient_Hospital_History"
datHospHist.Refresh
datHospHist.Recordset.AddNew
With frmNewReg.thisNewPatient
txtHospNo = .HospNo
txtSName = .SName
txtFName = .FName
txtDoB = .DoB
txtSex = .Sex
txtStateOfOrigin = .StateOfOrigin
txtOccupation = .Occupation
txtCaseRefNo = datHospHist.Recordset.Fields("Case_Ref_No")
End With
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 1 Then Exit Sub
If MsgBox("确认停办当前住院手续登记吗?" & vbCrLf & "(提示: 登记的信息不准确.)", vbCritical + vbYesNo, "提示") = vbYes Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -