📄 frmouthosp.frm
字号:
Begin VB.Label lblPtType
AutoSize = -1 'True
Caption = "lblType"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 1080
TabIndex = 11
Tag = "Dyn"
Top = 690
Width = 735
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "类 型:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 300
TabIndex = 10
Top = 690
Width = 735
End
Begin VB.Label lblContactorAddr
AutoSize = -1 'True
Caption = "lblContactorAddr"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 3075
TabIndex = 9
Tag = "Dyn"
Top = 1425
Width = 2100
End
Begin VB.Label lblContactor
AutoSize = -1 'True
Caption = "lblContactor"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 1080
TabIndex = 8
Tag = "Dyn"
Top = 1425
Width = 1110
End
End
Begin UseMaintainCtl.MaiControl mcr
Height = 570
Left = 3480
TabIndex = 1
Top = 3450
Width = 4965
_ExtentX = 8758
_ExtentY = 1005
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Status = 0
BackColorForAdd = -2147483638
BackColorForUpdate= -2147483638
ButtonCaption = "&R.更新 &A.确定 &D.删除 &C.清除 &T.录入 &Q.查询 &P.打印 &E退出"
KeyEnabled = "0#1#0#1#1#0#0#1#"
End
Begin VB.TextBox txtSkID
BackColor = &H80000009&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 1185
MaxLength = 10
TabIndex = 0
Text = "txtSkID"
Top = 615
Width = 1695
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "出院情况:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 3000
TabIndex = 35
Top = 690
Width = 945
End
Begin VB.Label Label16
Caption = "出院日期："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 5790
TabIndex = 33
Top = 690
Width = 1095
End
Begin VB.Label Label13
Caption = "Label13"
Height = 525
Left = 3690
TabIndex = 6
Top = 2130
Width = 1245
End
Begin VB.Line Line5
BorderColor = &H80000005&
X1 = 30
X2 = 8535
Y1 = 3390
Y2 = 3390
End
Begin VB.Line Line4
BorderColor = &H80000003&
X1 = 30
X2 = 8535
Y1 = 3375
Y2 = 3375
End
Begin VB.Label lblInDays
AutoSize = -1 'True
Caption = "lblInDays"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000D&
Height = 210
Left = 1080
TabIndex = 5
Tag = "Dyn"
Top = 2970
Width = 945
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "住院天数:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 210
Left = 60
TabIndex = 4
Top = 2970
Width = 945
End
Begin VB.Line Line3
BorderColor = &H80000005&
X1 = 3105
X2 = 5340
Y1 = 420
Y2 = 420
End
Begin VB.Line Line2
BorderColor = &H80000003&
X1 = 3105
X2 = 5340
Y1 = 435
Y2 = 435
End
Begin VB.Label lblCaption
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "出院通知"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 300
Left = 3660
TabIndex = 3
Top = 45
Width = 1275
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "病 案 号:"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 45
TabIndex = 2
Top = 675
Width = 1155
End
Begin VB.Label Label15
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "出院通知"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 300
Left = 3630
TabIndex = 32
Top = 60
Width = 1275
End
End
Attribute VB_Name = "frmOutHosp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Event OutHosp(TSickObj As clsSick)
Private OldSkID As String
Public SickObj As clsSick
Private Sub InitForm()
Dim i As Integer
hisFormClear Me
If Not (SickObj Is Nothing) Then
txtSkID = SickObj.skid
Call gfnFillDataBySickRegInfo(Me, SickObj)
lblInDays = DateDiff("d", SickObj.InDate, DtpOutDate.Value) & " 天"
End If
Me.cboOutCase.Clear
For i = 1 To gOutWayObj.Count
cboOutCase.AddItem gOutWayObj.Item(i).Code & " " & gOutWayObj.Item(i).Des
Next i
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
hisToActiveCtl(Me, True).SetFocus
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
hisFormToCenter Me, frmMain
DtpOutDate.Value = gfnGetTime()
InitForm
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmOutHosp = Nothing
End Sub
Private Sub mcr_Click(ByVal WhichB As UseMaintainCtl.BUTTONKEY)
Dim TmpObj As Object
Select Case WhichB
Case BK_ADD
If SickObj Is Nothing Then
MsgBox gstrERROR_SKID, vbCritical
Exit Sub
End If
If Not SickObj.IsStopForADV Then
MsgBox "请停止病人长期医嘱", vbCritical
init
txtSkID.SetFocus
Exit Sub
End If
If Not SickObj.IsMarkForTempADV Then
If MsgBox("病人 " & SickObj.Name & " 有临时医嘱未记帐,是否继续！", vbYesNo) = vbNo Then
init
txtSkID.SetFocus
Exit Sub
End If
End If
' If Not CheckOutdate Then Exit Sub
SickObj.OutWay = hisStrTok(cboOutCase.Text, " ")
SickObj.OutDate = Format(DtpOutDate.Value, "yyyy/mm/dd hh:mm:ss")
If Not SickObj.OutHosp Then
MsgBox gdbobj.ErrDes, vbCritical
Else
RaiseEvent OutHosp(SickObj)
init
txtSkID.SetFocus
If gstrMODULEID = "B6" And txtSkID.Locked Then Unload Me
End If
Case BK_CLEAR
init
txtSkID.SetFocus
Case BK_EXIT
init
Unload Me
End Select
End Sub
Private Sub txtSkID_GotFocus()
OldSkID = txtSkID
End Sub
Private Sub txtSkID_LostFocus()
If txtSkID = OldSkID Then Exit Sub
If txtSkID = "" Then
init
Exit Sub
End If
If SickObj Is Nothing Then
Set SickObj = New clsSick
End If
SickObj.SkIDByQuery = txtSkID
If SickObj.IfRegInfo Then
If SickObj.num <> 0 Then
If SickObj.IFOutHosp Then
MsgBox "病人已出院!", vbCritical
init
txtSkID.SetFocus
Exit Sub
End If
End If
If SickObj.num <> 0 Then
If Not SickObj.IsStopForADV Then
MsgBox "病人有长期医嘱未停止！不能申请转科!", vbCritical
init
txtSkID.SetFocus
Exit Sub
End If
If Not SickObj.IsMarkForTempADV Then
If MsgBox("病人有临时医嘱未记帐！是否继续!", vbYesNo + vbInformation) = vbNo Then
init
txtSkID.SetFocus
Exit Sub
End If
End If
Call gfnFillDataBySickRegInfo(Me, SickObj)
lblInDays = DateDiff("d", SickObj.InDate, gfnGetTime) & " 天"
Else
MsgBox "病人未住院", vbCritical
init
txtSkID.SetFocus
Exit Sub
End If
Else
MsgBox "病人未注册！", vbCritical
init
txtSkID.SetFocus
End If
End Sub
Private Sub init()
hisFormClear Me
If Not (SickObj Is Nothing) Then
Set SickObj = Nothing
End If
DtpOutDate.Value = gfnGetTime()
End Sub
Private Function CheckOutdate() As Boolean
Dim LastDate As String
If gdbobj.GetRs("select Max(MarkDate) from fairmarkMain where skserial='" & SickObj.SkSerial & "'") > 0 Then
If Not IsNull(gdbobj.Rs(0)) Then LastDate = Format(gdbobj.Rs(0), "yyyy-mm-dd")
End If
If Format(DtpOutDate, "yyyy-mm-dd") < LastDate Then
MsgBox "出院日期不能小与最后的记帐日期：" & LastDate, vbCritical
Exit Function
End If
CheckOutdate = True
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -