📄 ihms_admitexisting.frm
字号:
VERSION 5.00
Begin VB.Form frmAdmitExisting
BorderStyle = 1 'Fixed Single
Caption = "现有住院患者信息"
ClientHeight = 4635
ClientLeft = 45
ClientTop = 330
ClientWidth = 6915
ControlBox = 0 'False
Icon = "IHMS_AdmitExisting.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4635
ScaleWidth = 6915
StartUpPosition = 2 '屏幕中心
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 cmdAbortAdmission
Cancel = -1 'True
Caption = "取消(&C)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3600
TabIndex = 10
Top = 3960
Width = 2895
End
Begin VB.CommandButton cmdConfirmAdmission
Caption = "确认(&O)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 360
TabIndex = 9
Top = 3960
Width = 2895
End
Begin VB.Frame Frame1
Caption = "住院信息(&A)"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2655
Left = 360
TabIndex = 1
Top = 1200
Width = 6135
Begin VB.TextBox txtDoctorsComments
DataSource = "datContactInfo"
Height = 1725
Left = 2640
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 8
Top = 600
Width = 3255
End
Begin VB.TextBox txtDateOfAdmission
DataField = "Surname"
DataSource = "datPerInfo"
Height = 285
Left = 240
TabIndex = 0
ToolTipText = "DD/MM/YYYY"
Top = 1440
Width = 2055
End
Begin VB.TextBox txtCaseRefNo
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 = 240
Locked = -1 'True
TabIndex = 3
TabStop = 0 'False
Top = 720
Width = 2055
End
Begin VB.TextBox txtDoctorInCharge
Height = 285
Left = 240
TabIndex = 6
ToolTipText = "DD/MM/YYYY"
Top = 2040
Width = 2055
End
Begin VB.Label Label11
Caption = "医师备注："
Height = 255
Left = 2640
TabIndex = 7
Top = 360
Width = 1455
End
Begin VB.Label Label10
Caption = "住院日期:"
Height = 255
Left = 240
TabIndex = 4
ToolTipText = "DD/MM/YYYY"
Top = 1200
Width = 2535
End
Begin VB.Label Label9
Caption = "病例参考 #:"
Height = 255
Left = 240
TabIndex = 2
Top = 480
Width = 1455
End
Begin VB.Label Label8
Caption = "主治医师:"
Height = 255
Left = 240
TabIndex = 5
ToolTipText = "DD/MM/YYYY"
Top = 1800
Width = 1335
End
End
Begin VB.Label lblHeading
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 = &H00C00000&
Height = 495
Left = 1830
TabIndex = 12
Top = 120
Width = 3255
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 = 1410
TabIndex = 11
Top = 600
Width = 4095
End
End
Attribute VB_Name = "frmAdmitExisting"
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("中止当前患者的住院手续办理?", vbCritical + vbYesNo, "提示") = vbYes Then
Unload Me
End If
End Sub
Private Sub cmdConfirmAdmission_Click()
'On Error GoTo errHnd
With Me.datHospHist.Recordset
.Fields("Hosp_No") = somePatient.HospNo
.Fields("Admission_Status") = "IN"
.Fields("Date_of_Admission") = txtDateOfAdmission
.Fields("Name_of_Doctor") = txtDoctorInCharge
.Fields("Doctors_Diagnosis") = txtDoctorsComments
.Update
End With
MsgBox "住院手续登记成功.", vbInformation, "成功"
Unload frmOldPatient
Unload Me
Exit Sub
errhnd:
Debug.Print Err.Number; " "; Err.Description
MsgBox "一个未知错误.", vbInformation, "未知错误!"
Resume Next
End Sub
Private Sub Form_Load()
lblHeading.Caption = lblHeading.Caption + Str(somePatient.HospNo)
datHospHist.DatabaseName = App.Path & "\IHMS_97.mdb"
datHospHist.RecordSource = "Patient_Hospital_History"
datHospHist.Refresh
datHospHist.Recordset.AddNew
'Display information that's already been collected.
txtCaseRefNo = datHospHist.Recordset.Fields("Case_Ref_No")
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -