📄 frmnote.frm
字号:
BorderColor = &H000000FF&
X1 = 120
X2 = 6600
Y1 = 2250
Y2 = 2250
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "住院证号"
ForeColor = &H00000000&
Height = 180
Left = 360
TabIndex = 30
Top = 285
Width = 720
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "患者姓名"
ForeColor = &H00000000&
Height = 180
Left = 2415
TabIndex = 29
Top = 285
Width = 720
End
Begin VB.Label Label3
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "性 别"
ForeColor = &H00000000&
Height = 180
Left = 4560
TabIndex = 28
Top = 285
Width = 720
End
Begin VB.Label Label4
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "年 龄"
ForeColor = &H00000000&
Height = 180
Left = 360
TabIndex = 27
Top = 660
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "病 种"
ForeColor = &H00000000&
Height = 180
Left = 2415
TabIndex = 26
Top = 660
Width = 720
End
Begin VB.Label Label6
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "预交费用"
ForeColor = &H00000000&
Height = 180
Left = 4560
TabIndex = 25
Top = 660
Width = 720
End
Begin VB.Label Label7
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "科室类别"
ForeColor = &H00000000&
Height = 180
Left = 360
TabIndex = 24
Top = 1380
Width = 720
End
Begin VB.Label Label8
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "病 房 号"
ForeColor = &H00000000&
Height = 180
Left = 2415
TabIndex = 23
Top = 1380
Width = 720
End
Begin VB.Label Label9
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "床 位 号"
ForeColor = &H00000000&
Height = 180
Left = 4560
TabIndex = 22
Top = 1380
Width = 720
End
Begin VB.Label Label10
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "主治医生"
ForeColor = &H00000000&
Height = 180
Left = 360
TabIndex = 21
Top = 1755
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "住院日期"
ForeColor = &H00000000&
Height = 180
Left = 2415
TabIndex = 20
Top = 1755
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "地 址"
ForeColor = &H00000000&
Height = 180
Left = 360
TabIndex = 19
Top = 1005
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "年"
ForeColor = &H00000000&
Height = 180
Left = 3930
TabIndex = 18
Top = 1755
Width = 180
End
Begin VB.Label Label14
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "月"
ForeColor = &H00000000&
Height = 180
Left = 4680
TabIndex = 17
Top = 1755
Width = 180
End
Begin VB.Label Label15
AutoSize = -1 'True
BackColor = &H00404040&
BackStyle = 0 'Transparent
Caption = "日"
ForeColor = &H00000000&
Height = 180
Left = 5370
TabIndex = 16
Top = 1755
Width = 180
End
End
Attribute VB_Name = "frmnote"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public add1 As Integer
Private Sub Command1_Click()
Dim rq1 As String
On Error GoTo err1
With Adodc1
If Text5.text < 1 Then
MsgBox "预交住院费不能少于1元。"
Else
.RecordSource = "select * from zyf where 住院证号='" & Text1.text & "'"
.Refresh
.Recordset.AddNew
.Recordset.Fields("住院证号") = Text1.text
.Recordset.Fields("患者姓名") = Text2.text
.Recordset.Fields("性别") = Combo1.text
.Recordset.Fields("年龄") = Text3.text
.Recordset.Fields("病种") = Text4.text
.Recordset.Fields("预交费") = CCur(Text5.text)
.Recordset.Fields("地址") = Text6.text
.Recordset.Fields("科室类别") = Text7.text
.Recordset.Fields("病房号") = Text8.text
.Recordset.Fields("床位号") = Text9.text
.Recordset.Fields("主治大夫") = Text10.text
rq1 = Text11.text & "-" & Text12.text & "-" & Text13.text
.Recordset.Fields("住院日期") = CDate(rq1)
.Recordset.Fields("操作员") = frmlogin.username
.Recordset.Update
With Adodc5
.RecordSource = "select * from fyjl order by ID"
.Refresh
.Recordset.AddNew
.Recordset.Fields(1) = Text1.text
.Recordset.Fields(2) = Text2.text
.Recordset.Fields(3) = Text7.text
.Recordset.Fields(4) = CDate(rq1)
.Recordset.Fields(5) = CCur(Text5.text)
.Recordset.Fields(6) = frmlogin.username
.Recordset.UpdateBatch
End With
Text1.text = ""
Text2.text = ""
Text3.text = ""
Text4.text = ""
Text5.text = ""
Text6.text = ""
Text7.text = ""
Text8.text = ""
Text9.text = ""
Text10.text = ""
Command1.Enabled = False
End If
End With
Exit Sub
err1:
MsgBox "住院登记项目填写不完整或数据类型不匹配！"
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Activate()
frmmain.StatusBar1.Panels(2) = "活动窗口：" & frmnote.Caption
End Sub
Private Sub Form_Load()
On Error GoTo err3
frmnote.Top = (frmmain.Height - frmnote.Height) / 2 - 500
frmnote.Left = (frmmain.Width - frmnote.Width) / 2
Adodc1.ConnectionString = frmlogin.conn
Adodc2.ConnectionString = frmlogin.conn
Adodc3.ConnectionString = frmlogin.conn
Adodc4.ConnectionString = frmlogin.conn
Adodc5.ConnectionString = frmlogin.conn
Command1.Enabled = False
Text11.text = Year(Date)
Text12.text = Month(Date)
Text13.text = Day(Date)
Text5.text = 0
Text3.text = 1
Combo1.text = "男"
Exit Sub
err3:
MsgBox "数据库连接失败！"
End Sub
Private Sub Text1_Change()
On Error GoTo err2
Dim respone As Integer
With Adodc1
.RecordSource = "select * from zyf where 住院证号='" & Text1.text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Command1.Enabled = False
If .Recordset.Fields("出院标记") = True Then
Text2.text = .Recordset.Fields("患者姓名")
Combo1.text = .Recordset.Fields("性别")
Text3.text = .Recordset.Fields("年龄")
Text4.text = .Recordset.Fields("病种")
Text7.text = .Recordset.Fields("预交费")
Text6.text = .Recordset.Fields("地址")
Text7.text = .Recordset.Fields("科室类别")
Text8.text = .Recordset.Fields("病房号")
Text9.text = .Recordset.Fields("床位号")
Text10.text = .Recordset.Fields("主治大夫")
Text11.text = Year(.Recordset.Fields("住院日期"))
Text12.text = Month(.Recordset.Fields("住院日期"))
Text13.text = Day(.Recordset.Fields("住院日期"))
respone = MsgBox("该患者已经出院，是否重新办理住院手续?", vbYesNo, "特别警告")
If respone = vbYes Then
Text3.text = ""
Text4.text = ""
Text5.text = 0
Text7.text = ""
Text8.text = ""
Text9.text = ""
Text10.text = ""
Text11.text = ""
Text12.text = ""
Text13.text = ""
.Recordset.Delete
.Recordset.UpdateBatch
Command1.Enabled = True
Else
Command1.Enabled = False
Text1.text = ""
Text2.text = ""
Text3.text = ""
Text4.text = ""
Text5.text = 0
Text6.text = ""
Text7.text = ""
Text8.text = ""
Text9.text = ""
Text10.text = ""
Text11.text = ""
Text12.text = ""
Text13.text = ""
End If
Else
MsgBox "该编号的患者已经存在,您所编的住院证号可能重复!"
Text1.text = ""
End If
Else
Command1.Enabled = True
End If
End With
If Text1.text = "" Then
Command1.Enabled = False
Else
Command1.Enabled = True
End If
Exit Sub
err2:
MsgBox "数据库出错或数据类型不匹配！"
End Sub
Private Sub Text10_Change()
On Error GoTo err3
With Adodc3
.RecordSource = "select 姓名,代码 from dotcode where 代码='" & Text10.text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text10.text = .Recordset.Fields("姓名")
End If
End With
Exit Sub
err3:
MsgBox "数据库连接失败！"
End Sub
Private Sub Text5_LostFocus()
If Not IsNumeric(Text5.text) Or Text5.text Like "%.%" Then
MsgBox "非法输入，预交费用必须输入数值。"
Text5.SetFocus
Text5.text = 0
End If
End Sub
Private Sub Text7_Change()
On Error GoTo err4
With Adodc2
.RecordSource = "select 科室名称,代码 from kscode where 代码='" & Text7.text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text7.text = .Recordset.Fields("科室名称")
End If
End With
Exit Sub
err4:
MsgBox "数据库连接失败！"
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmmain.StatusBar1.Panels(2) = "目前没有窗口被激活"
End Sub
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.text)
End Sub
Private Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text2.text)
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3.text)
End Sub
Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4.text)
End Sub
Private Sub Text5_GotFocus()
Text5.SelStart = 0
Text5.SelLength = Len(Text5.text)
End Sub
Private Sub Text8_GotFocus()
Text8.SelStart = 0
Text8.SelLength = Len(Text8.text)
End Sub
Private Sub Text9_GotFocus()
Text9.SelStart = 0
Text9.SelLength = Len(Text9.text)
End Sub
Private Sub Text4_Change()
On Error GoTo err0
With Adodc4
.RecordSource = "select 名称,代码 from othercode where 代码='" & Text4.text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text4.text = .Recordset.Fields("名称")
End If
End With
Exit Sub
err0:
MsgBox "数据库连接失败！"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -