📄 ihms_newpatient.frm
字号:
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 2040
Locked = -1 'True
TabIndex = 1
TabStop = 0 'False
Top = 720
Width = 1695
End
Begin VB.Frame fraPersonal
Caption = "患者信息(&P)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2415
Left = 240
TabIndex = 2
Top = 1080
Width = 6495
Begin VB.TextBox txtDoB
Height = 285
Left = 1320
TabIndex = 8
ToolTipText = "日期格式：YYYY/MM/DD"
Top = 720
Width = 1935
End
Begin VB.TextBox txtStateOfOrigin
Height = 285
Left = 4560
TabIndex = 14
Top = 1080
Width = 1695
End
Begin VB.TextBox txtHomeAdd
Height = 765
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 12
Top = 1560
Width = 3015
End
Begin VB.TextBox txtSName
Height = 285
Left = 1320
TabIndex = 4
Top = 360
Width = 1935
End
Begin VB.TextBox txtFName
Height = 285
Left = 4560
TabIndex = 6
Top = 360
Width = 1695
End
Begin VB.TextBox txtOccupation
Height = 285
Left = 4560
TabIndex = 16
Top = 1440
Width = 1695
End
Begin VB.ComboBox cboSex
Height = 300
ItemData = "IHMS_NewPatient.frx":6891
Left = 4560
List = "IHMS_NewPatient.frx":689B
Style = 2 'Dropdown List
TabIndex = 10
Top = 720
Width = 1695
End
Begin VB.Label Label19
Alignment = 1 'Right Justify
Caption = "籍贯:"
Height = 255
Left = 3360
TabIndex = 13
Top = 1080
Width = 1095
End
Begin VB.Label lblHomeAdd
Caption = "住址:"
Height = 255
Left = 240
TabIndex = 11
Top = 1320
Width = 1335
End
Begin VB.Label lblSName
Alignment = 1 'Right Justify
Caption = "患者姓:"
Height = 255
Left = 240
TabIndex = 3
Top = 360
Width = 975
End
Begin VB.Label lblFName
Alignment = 1 'Right Justify
Caption = "患者名:"
Height = 255
Left = 3360
TabIndex = 5
Top = 360
Width = 1095
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "出生年月:"
Height = 255
Left = 240
TabIndex = 7
ToolTipText = "DD/MM/YYYY"
Top = 720
Width = 975
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "性别:"
Height = 255
Left = 4080
TabIndex = 9
Top = 720
Width = 375
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
Caption = "职业:"
Height = 255
Left = 3360
TabIndex = 15
Top = 1440
Width = 1095
End
End
Begin VB.Label Label7
Alignment = 2 'Center
Caption = "新患者登记"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 495
Left = 3533
TabIndex = 42
Top = 120
Width = 5175
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 = 360
TabIndex = 0
Top = 720
Width = 1575
End
End
Attribute VB_Name = "frmNewReg"
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
Public thisNewPatient As CPatient 'Public so that it can be accessed by frmAdmission
Private nextPatientNum As Integer
Private Sub cmdCancelReg_Click()
If MsgBox("Are you sure you want to abort the current patient registration?" & vbCrLf & "(NOTE: You will loose all information you have entered.)", vbCritical + vbYesNo) = vbYes Then
Unload Me
End If
End Sub
Private Sub cmdRegAndAdmit_Click()
Set thisNewPatient = New CPatient 'Create a Patient Object
'write the info into a "patient" object
With thisNewPatient
.HospNo = Val(txtHospNo)
.SName = Trim(txtSName)
.FName = Trim(txtFName)
.DoB = Trim(txtDoB)
.Sex = cboSex
.HomeAdd = Trim(txtHomeAdd)
.StateOfOrigin = Trim(txtStateOfOrigin)
.Occupation = Trim(txtOccupation)
'NEXT OF KIN'S INFO
.NameNoK = Trim(txtKinName)
.RelaNok = Trim(txtRelationship)
.AddNok = Trim(txtKinAddress)
'SPONSOR'S INFO
.SponsorName = Trim(txtNameOfSponsor)
.SponsorAdd = Trim(txtAddOfSponsor)
'LABORATORY INFO
'.LabRefNo = Val(txtLabRefNo)
.BloodGrp = Trim(cboBloodGrp)
.RHFactor = cboRHFactor
.Allergy = Trim(txtAllergy)
End With
frmAdmission.Show 1
Call ClearRegForm 'clear the form b4 hiding it, in readiness for next use
Unload Me
End Sub
Private Sub cmdRegOnly_Click()
On Error GoTo errhnd
'Collect the input
With datPerInfo.Recordset
'PERSONAL INFO
.Fields("Hosp_No") = Val(txtHospNo)
.Fields("SName") = Trim(txtSName)
.Fields("FName") = Trim(txtFName)
.Fields("Date_Of_Birth") = Trim(txtDoB)
.Fields("Sex") = cboSex
.Fields("Home_Add") = Trim(txtHomeAdd)
.Fields("State_of_Origin") = Trim(txtStateOfOrigin)
.Fields("Occupation") = Trim(txtOccupation)
'NEXT OF KIN'S INFO
.Fields("Name_of_NoK") = Trim(txtKinName)
.Fields("Relationship_to_NoK") = Trim(txtRelationship)
.Fields("Add_of_NoK") = Trim(txtKinAddress)
'SPONSOR'S INFO
.Fields("Name_of_Sponsor") = Trim(txtNameOfSponsor)
.Fields("Add_of_Sponsor") = Trim(txtAddOfSponsor)
End With
With datLabInfo.Recordset
'LABORATORY INFO
'.Fields("Lab_Ref_No") = Val(txtLabRefNo)
.Fields("Hosp_No") = Val(txtHospNo)
.Fields("Blood_Group") = cboBloodGrp
.Fields("RhFactor") = cboRHFactor
.Fields("Allergy") = Trim(txtAllergy)
End With
'update d records into the db
datPerInfo.Recordset.Update
datLabInfo.Recordset.Update
MsgBox "New Patient Registered Successfully.", vbInformation, "Success"
Call ClearRegForm
Unload Me
Exit Sub
errhnd:
Debug.Print Err.Number; " "; Err.Description
MsgBox "An error has occured.", vbInformation, "Unhandled error!"
Resume Next
End Sub
Private Sub cmdRestartReg_Click()
If MsgBox("Are you sure you want to clear the form and start over?", vbQuestion + vbYesNo) = vbYes Then
'clear form
Call ClearRegForm
End If
End Sub
Private Sub Form_Load()
'On Error Resume Next
datPerInfo.DatabaseName = App.Path & "\IHMS_97.mdb"
datPerInfo.RecordSource = "Patient_Personal_Info"
datPerInfo.Refresh
datLabInfo.DatabaseName = App.Path + "\IHMS_97.mdb"
datLabInfo.RecordSource = "Patient_Lab_Info"
datLabInfo.Refresh
'Automatically generate the next hosp. no.
'Note that this has to be done before adding a new record, otherwise, you will get 0 (zero)
datPerInfo.Recordset.MoveLast
nextPatientNum = datPerInfo.Recordset.Fields("Hosp_No") + 1
'Insert a new record at end of the DB.
datPerInfo.Recordset.AddNew
datLabInfo.Recordset.AddNew
txtHospNo = nextPatientNum
txtLabRefNo = datLabInfo.Recordset.Fields("Lab_Ref_No")
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = 4 Then Exit Sub 'The MDI child form is closing because the MDI form is closing.
If UnloadMode = 1 Then Exit Sub 'The Unload statement is invoked from code.
If MsgBox("Are you sure you want to abort the current patient registration?" & vbCrLf & "(NOTE: You will loose all information you have entered.)", vbCritical + vbYesNo) = vbYes Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmMain.mnuNewPatient.Enabled = True 'enable new patient menu item
frmMain.tbrMainToolbar.Buttons(2).Enabled = True 'enable new patient toolbar button
End Sub
Private Sub txtSName_GotFocus()
'Display the next hosp. number
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -