frmsf.frm

大型医院管理源代码

         End Select
        DxstrX = DxstrX + TempStr
     Next
     DXStr = DXStr + DxstrX
End If
    Up = DXStr
End Function

Function Converts(NumStr As String) As String
    Select Case Val(NumStr)
      Case 0
        Converts = "零"
      Case 1
        Converts = "壹"
      Case 2
        Converts = "贰"
      Case 3
        Converts = "叁"
      Case 4
        Converts = "肆"
      Case 5
        Converts = "伍"
      Case 6
         Converts = "陆"
      Case 7
         Converts = "柒"
      Case 8
         Converts = "捌"
      Case 9
         Converts = "玖"
    End Select
End Function

Private Sub Command1_Click()
On Error GoTo err1
If Text1.Text = "" Or Text17.Text = "" Or CCur(Text7.Text) + CCur(Text9.Text) + CCur(Text11.Text) + CCur(Text13.Text) + CCur(Text15.Text) <= 0 Then
    MsgBox "科室类别和患者姓名不能为空，费用总额不能小于或等于零。"
    Text1.SetFocus
Else
    With Adodc1
    .RecordSource = "select * from mzsf order by ID"
    .Refresh
        If .Recordset.BOF And .Recordset.EOF Then
            numb = 1
        Else
            .RecordSource = "select * from mzsf order by 序号"
            .Recordset.MoveLast
            numb = .Recordset.Fields("序号") + 1
        End If
    .Recordset.AddNew
    .Recordset.Fields("序号") = Str(numb)
    .Recordset.Fields("科室类别") = Text17.Text
    .Recordset.Fields("患者姓名") = Text1.Text
    .Recordset.Fields("帐户支付") = Text4.Text
    .Recordset.Fields("现金支付") = Text5.Text
    riqi = Text2.Text & "-" & Text3.Text & "-" & Text16.Text
    nyr = Text2.Text & "年" & Text3.Text & "月" & Text16.Text
    nyr1 = nyr & "日"
    .Recordset.Fields("就诊日期") = CDate(riqi)
    .Recordset.Fields("费用合计") = CCur(Text7.Text) + CCur(Text9.Text) ' + CCur(Text11.Text) + CCur(Text13.Text) + CCur(Text15.Text)
    fyhj = CCur(Text7.Text) + CCur(Text9.Text) ' + CCur(Text11.Text) + CCur(Text13.Text) + CCur(Text15.Text)
    .Recordset.Fields("收费员") = frmlogin.username
    .Recordset.Fields("备注") = Text6.Text & "|" & Text8.Text ' & "|" & Text10.Text & "|" & Text12.Text & "|" & Text14.Text
    .Recordset.UpdateBatch
    MsgBox "基本费用登记成功！"
    Command2.Enabled = True
    Command1.Enabled = False
    End With
Text1.Locked = True
Text2.Locked = True
Text3.Locked = True
Text4.Locked = True
Text5.Locked = True
Text6.Locked = True
Text7.Locked = True
Text8.Locked = True
Text9.Locked = True
Text10.Locked = True
Text11.Locked = True
Text12.Locked = True
Text13.Locked = True
Text14.Locked = True
Text15.Locked = True
Text16.Locked = True
Text17.Locked = True
End If
Exit Sub
err1:
MsgBox "输入数据不完整或类型不匹配！"
Command2.Enabled = False
Command1.Enabled = True
End Sub

Private Sub Command2_Click()
On Error GoTo cw1
Dim daxie As String
daxie = Up(CCur(Text7.Text) + CCur(Text9.Text))
Text1.Locked = False
Text2.Locked = False
Text3.Locked = False
Text4.Locked = False
Text5.Locked = False
Text6.Locked = False
Text7.Locked = False
Text8.Locked = False
Text9.Locked = False
Text10.Locked = False
Text11.Locked = False
Text12.Locked = False
Text13.Locked = False
Text14.Locked = False
Text15.Locked = False
Text16.Locked = False
Text17.Locked = False
Printer.FontName = "黑体"
Printer.FontSize = 18
Printer.FontBold = False
Printer.Print Tab(19); "门诊医疗费收费票据"
Printer.FontSize = 10
Printer.FontBold = False
Printer.Print Tab(79); "科室存根"; Tab(95); "科室存根"
Printer.Print
Printer.FontName = "仿宋_GB2312"
Printer.Print Tab(8); "门诊收费存根"; Tab(32); "患者姓名："; Text1.Text; Tab(79); Text17.Text; Tab(95); Text17.Text
Printer.Print Tab(0); "┌────┬──────┐　┌────┬────┬────┬────┐　　┌──────┐┌──────┐"
Printer.Print Tab(0); "│患者姓名│"; Tab(13); Text1.Text; Tab(25); "│  │费用名称│费用金额│费用名称│费用金额│"; Tab(75); "│  费用名称  ││  费用名称  │"
Printer.Print Tab(0); "│        │            │  ├────┼────┼────┼────┤　　│"; Tab(79); Text6.Text; Tab(89); "││"; Tab(95); Text8.Text; Tab(105); "│"
Printer.Print Tab(0); "│就诊日期│"; Tab(13); nyr; Tab(25); "│  │"; Tab(31); Text6.Text; Tab(39); "│"; Tab(41); Text7.Text; Tab(49); "│"; Tab(51); Text8.Text; Tab(59); "│"; Tab(61); Text9.Text; Tab(69); "│　　│"; Tab(89); "││"; Tab(105); "│"
Printer.Print Tab(0); "│　　　　│　　　　　　│　├────┼────┼────┼────┤　　│　费用金额　││　费用金额　│"
Printer.Print Tab(0); "│"; Tab(3); Text6.Text; Tab(11); "│"; Tab(13); Text7.Text; Tab(25); "│　│　　　　│　　　　│　　　　│　　　　│　　│"; Tab(80); Text7.Text; Tab(89); "││"; Tab(96); Text9.Text; Tab(105); "│"
Printer.Print Tab(0); "│"; Tab(3); Text8.Text; Tab(11); "│"; Tab(13); Text9.Text; Tab(25); "│　├────┴────┴────┴────┤　　│　　　　　　││　　　　　　│"
Printer.Print Tab(0); "│　　　　│　　　　　　│　│合计金额："; Tab(41); daxie; "整"; Tab(69); "│　　│　患者姓名　││　患者姓名　│"
Printer.Print Tab(0); "│　　　　│　　　　　　│　├───────────────────┤　　│"; Tab(79); Text1.Text; Tab(89); "││"; Tab(95); Text1.Text; Tab(105); "│"
Printer.Print Tab(0); "│合　　计│"; Tab(13); fyhj; Tab(25); "│　│　　 　　医 疗 保 险 结 算 栏 　　　　│　　│　序　　号　││　序　　号　│"
Printer.Print Tab(0); "│　　　　│　　　　　　│　├───────────────────┤　　│"; Tab(78); numb; Tab(89); "││"; Tab(94); numb; Tab(105); "│"
Printer.Print Tab(0); "│　　　　│　　　　　　│　│帐户支付："; Tab(41); Text4.Text; Tab(50); "现金支付："; Tab(61); Text5.Text; Tab(69); "│　　│　　　　　　││　　　　　　│"
Printer.Print Tab(0); "│帐户支付│"; Tab(13); Text4.Text; Tab(25); "│　├───────────────────┤　　│　就诊日期　││　就诊日期　│"
Printer.Print Tab(0); "│现金支付│"; Tab(13); Text5.Text; Tab(25); "│　│交费金额："; Tab(41); Text4.Text; Tab(48); "收费员："; Tab(57); frmlogin.username; Tab(69); "│　　│"; Tab(77); nyr; Tab(89); "││"; Tab(93); nyr; Tab(105); "│"
Printer.Print Tab(0); "│　　　　│　　　　　　│　├───────────────────┤　　│　　　　　　││　　　　　　│";
Printer.Print Tab(0); "│序    号│"; Tab(13); numb; Tab(25); "│　│医院名称："; Tab(41); frmlogin.userdwname; Tab(69); "│　　│　收 费 员　││　收 费 员　│"
Printer.Print Tab(0); "│收 费 员│"; Tab(13); frmlogin.username; Tab(25); "│　└───────────────────┘　　│"; Tab(79); frmlogin.username; Tab(89); "││"; Tab(95); frmlogin.username; Tab(105); "│"
Printer.Print Tab(0); "└────┴──────┘　　序号："; Tab(37); numb; Tab(50); "日期："; Tab(56); nyr1; Tab(75); "└──────┘└──────┘"
Printer.EndDoc
Exit Sub
cw1:
MsgBox "无法预知的错误!"
End Sub

Private Sub Command3_Click()
Command1.Enabled = True
Command2.Enabled = False
Text17.Text = ""
Text1.Text = ""
Text2.Text = Year(Date)
Text3.Text = Month(Date)
Text4.Text = 0
Text5.Text = 0
Text6.Text = ""
Text7.Text = 0
Text8.Text = ""
Text9.Text = 0
Text10.Text = ""
Text11.Text = 0
Text12.Text = ""
Text13.Text = 0
Text14.Text = ""
Text15.Text = 0
Text16.Text = Day(Date)
Text17.SetFocus
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Form_Load()
On Error GoTo err3
frmsf.Top = (frmmain.Height - frmsf.Height) / 2 - 500
frmsf.Left = (frmmain.Width - frmsf.Width) / 2
Text1.Text = ""
Text2.Text = Year(Date)
Text3.Text = Month(Date)
Text4.Text = 0
Text5.Text = 0
Text7.Text = 0
Text9.Text = 0
Text11.Text = 0
Text13.Text = 0
Text15.Text = 0
Text16.Text = Day(Date)
Adodc1.ConnectionString = frmlogin.conn
Adodc2.ConnectionString = frmlogin.conn
Adodc3.ConnectionString = frmlogin.conn
Adodc4.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\systemset.mdb;Persist Security Info=False"
Adodc4.RecordSource = "select 单位名称 from setinfo order by ID"
Adodc4.Refresh
frmlogin.userdwname = Adodc4.Recordset.Fields("单位名称")
Command2.Enabled = False
Exit Sub
err3:
MsgBox "数据库连接失败！"
'不能用最大记录号+1自动填写门诊序号
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text16_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub Text17_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
Private Sub Text9_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub

Private Sub Text17_Change()
On Error GoTo err2
With Adodc2
.RecordSource = "select * from kscode where 代码='" & Text17.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text17.Text = .Recordset.Fields("科室名称")
End If
End With
Exit Sub
err2:
MsgBox "数据类型不匹配！"
End Sub
Private Sub Form_Unload(Cancel As Integer)
frmmain.StatusBar1.Panels(2) = "目前没有窗口被激活"
End Sub
Private Sub Form_Activate()
frmmain.StatusBar1.Panels(2) = "活动窗口：" & frmsf.Caption
End Sub

Private Sub Text6_Change()
On Error GoTo cw1
With Adodc3
.RecordSource = "select * from othercode where 代码='" & Text6.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text6.Text = .Recordset.Fields("名称")
End If
End With
Exit Sub
cw1:
MsgBox "数据类型不匹配或数据库连接失败！"
End Sub

Private Sub Text9_Change()
If Not IsNumeric(Text9.Text) Then
MsgBox "只能输入“0-9”数字！"
Text9.SetFocus
Text9.Text = 0
End If
End Sub

Private Sub Text9_GotFocus()
Text9.SelStart = 0
Text9.SelLength = Len(Text9.Text)
End Sub
Private Sub Text11_GotFocus()
Text11.SelStart = 0
Text11.SelLength = Len(Text11.Text)
End Sub
Private Sub Text13_GotFocus()
Text13.SelStart = 0
Text13.SelLength = Len(Text13.Text)
End Sub
Private Sub Text15_GotFocus()
Text15.SelStart = 0
Text15.SelLength = Len(Text15.Text)
End Sub
Private Sub Text7_GotFocus()
Text7.SelStart = 0
Text7.SelLength = Len(Text7.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_Change()
On Error GoTo cw2
With Adodc3
.RecordSource = "select * from othercode where 代码='" & Text8.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text8.Text = .Recordset.Fields("名称")
End If
End With
Exit Sub
cw2:
MsgBox "数据类型不匹配或数据库连接失败！"
End Sub
Private Sub Text10_Change()
On Error GoTo cw3
With Adodc3
.RecordSource = "select * from othercode where 代码='" & Text10.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text10.Text = .Recordset.Fields("名称")
End If
End With
Exit Sub
cw3:
MsgBox "数据类型不匹配或数据库连接失败！"
End Sub
Private Sub Text12_Change()
On Error GoTo cw4
With Adodc3
.RecordSource = "select * from othercode where 代码='" & Text12.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text12.Text = .Recordset.Fields("名称")
End If
End With
Exit Sub
cw4:
MsgBox "数据类型不匹配或数据库连接失败！"
End Sub
Private Sub Text14_Change()
On Error GoTo cw5
With Adodc3
.RecordSource = "select * from othercode where 代码='" & Text14.Text & "'"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text14.Text = .Recordset.Fields("名称")
End If
End With
Exit Sub
cw5:
MsgBox "数据类型不匹配或数据库连接失败！"
End Sub
Private Sub Text7_Change()
If Not IsNumeric(Text7.Text) Then
MsgBox "只能输入“0-9”数字！"
Text7.SetFocus
Text7.Text = 0
End If
End Sub