frmsum.frm

大型医院管理源代码

            DXStr = DXStr
       Case Else
            DXStr = TempStr + DXStr
      End Select
      Else
       DXStr = TempStr + DXStr
    End If
     Next
'计算小数
   Dim DxstrX As String, XStr As String
      XStr = Right(Trim(Dxs), Sw - SzP)
        For i = 1 To Sw - SzP
         TempStr = Left(XStr, i)
         TempStr = Right(TempStr, 1)
         TempStr = Converts(TempStr)
         Select Case i
           Case 1
            If TempStr = "零" Then
               TempStr = ""
               Else
               TempStr = TempStr + "角"
            End If
           Case 2
            If TempStr = "零" Then
               TempStr = ""
               Else
               TempStr = TempStr + "分"
               End If
            Case Else
              '超过两位小数时，自动删除
              TempStr = ""
         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 cw1
Dim i As Integer
Dim yue As Currency
yue = 0
With Adodc1
.RecordSource = " select * from zyf where 住院证号='" & Text1.text & "' and 出院标记=false"
.Refresh
For i = 0 To 26
.Recordset.Fields(i + 12) = .Recordset.Fields(i + 12) + Text17(i).text
Text17(i).Enabled = False
yue = yue + Text17(i)
Next
.Recordset.Fields("备注") = .Recordset.Fields("备注") & "【" & Text42.text & "】"
.Recordset.Fields("费用合计") = .Recordset.Fields("费用合计") + yue
    If (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计")) >= 0 Then
        Label44.Caption = "最新余额：" & (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计")) & "元"
        .Recordset.Fields("退费") = .Recordset.Fields("预交费") - .Recordset.Fields("费用合计")
    Else
        Label44.Caption = "该患者欠费：" & (-1) * (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计")) & "元"
        .Recordset.Fields("欠费") = (-1) * (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计"))
    End If
.Recordset.UpdateBatch
    Command1.Enabled = False
    Command4.Enabled = True
End With
Exit Sub
cw1:
MsgBox "数值类型不匹配!"
End Sub

Private Sub Command2_Click()
On Error GoTo cw2
Dim daxie As String
Dim i As Integer
Dim yjf, ssf, qf, tf, jcf, qtf As Currency
Dim text(26) As Currency
With Adodc1
.RecordSource = " select * from zyf where 住院证号='" & Text1.text & "'" ' and 出院标记=false"
.Refresh
yjf = .Recordset.Fields("预交费")
qf = .Recordset.Fields("欠费")
bool = qf
tf = .Recordset.Fields("退费")
ssf = .Recordset.Fields("预交费") - .Recordset.Fields("费用合计")
If ssf < 0 Then
    ssf = .Recordset.Fields("预交费")
Else
    ssf = .Recordset.Fields("预交费") - tf
End If
For i = 0 To 26
text(i) = .Recordset.Fields(i + 12)
Next
zfy = .Recordset.Fields("费用合计")
jcf = text(25) + text(12) + text(16) + text(20) + text(8) + text(24)
qtf = text(26) + text(9) + text(22)
rq1 = Text11.text & "-" & Text12.text & "-" & Text13.text
rq2 = Text14.text & "-" & Text15.text & "-" & Text16.text
.Recordset.Fields("出院日期") = CDate(rq2)
If (Text14.text <> "" And Text15 <> "" And Text16 <> "") Then
    If bool > 0 Then
        MsgBox "请续交所欠费用后再办理出院手续!"
    Else
        If (CDate(rq2) >= CDate(rq1)) Then
            .Recordset.Fields("出院标记") = "True"
            .Recordset.UpdateBatch
            daxie = Up(CCur(zfy))
            '打印出院手续
            Printer.FontName = "黑体"
            Printer.FontSize = 18
            Printer.FontBold = False
            Printer.Print Tab(28); "住院医疗费收据"
            Printer.FontName = "仿宋_GB2312"
            Printer.FontSize = 10
            Printer.FontBold = False
            Printer.Print
            Printer.Print Tab(2); "收费单位："; frmlogin.userdwname; Tab(50); "日期："; Text14.text; "年"; Text15.text; "月"; Text16.text; "日"; Tab(86); "收费员："; frmlogin.username
            Printer.Print Tab(0); "┌────┬────┬──┬──┬──┬───────────────────┬────┬───────┐"
            Printer.Print Tab(0); "│姓    名│"; Tab(13); Text2.text; Tab(21); "│性别│"; Text40.text; Tab(33); "│地址│"; Text6.text; Tab(79); "│住 院 号│"; Text1.text; Tab(105); "│"
            Printer.Print Tab(0); "├────┼────┴──┴──┴──┴───────────────────┼────┼───────┤"
            Printer.Print Tab(0); "│住院日期│"; Tab(13); Text11.text; "年"; Text12.text; "月"; Text13.text; "日至"; Text14.text; "年"; Text15.text; "月"; Text16.text; "日"; Tab(79); "│科    别│"; Text7.text; Tab(105); "│"
            Printer.Print Tab(0); "├────┼───────┬────┬───────┬────┬───────┼────┼───────┤"
            Printer.Print Tab(0); "│费    别│  金      额  │费    别│  金      额  │费    别│  金      额  │费    别│  金      额  │"
            Printer.Print Tab(0); "├────┼───────┼────┼───────┼────┼───────┼────┼───────┤"
            Printer.Print Tab(0); "│床 位 费│"; Tab(13); text(0); Tab(27); "│五    防│"; text(5); Tab(53); "│生 活 费│"; text(13); Tab(79); "│鼻    饲│"; text(18); Tab(105); "│"
            Printer.Print Tab(0); "├────┼───────┼────┼───────┼────┼───────┼────┼───────┤"
            Printer.Print Tab(0); "│检 查 费│"; Tab(13); jcf; Tab(27); "│材 料 费│"; text(23); Tab(53); "│保 护 费│"; text(14); Tab(79); "│导 尿 费│"; text(21); Tab(105); "│"
            Printer.Print Tab(0); "├────┼───────┼────┼───────┼────┼───────┼────┼───────┤"
            Printer.Print Tab(0); "│治 疗 费│"; Tab(13); text(3); Tab(27); "│化 验 费│"; text(7); Tab(53); "│取 暖 费│"; text(15); Tab(79); "│其    他│"; qtf; Tab(105); "│"
            Printer.Print Tab(0); "├────┼───────┼────┼───────┼────┼───────┼────┼───────┤"
            Printer.Print Tab(0); "│诊 疗 费│"; Tab(13); text(4); Tab(27); "│输 血 费│"; text(11); Tab(53); "│西 药 费│"; text(2); Tab(79); "│陪 住 费│"; text(19); Tab(105); "│"
            Printer.Print Tab(0); "├────┼───────┼────┼───────┼────┼───────┼────┼───────┤"
            Printer.Print Tab(0); "│放 射 费│"; Tab(13); text(1); Tab(27); "│输 氧 费│"; text(10); Tab(53); "│卫 生 费│"; text(17); Tab(79); "│护 理 费│"; text(6); Tab(105); "│"
            Printer.Print Tab(0); "├────┼───────┴────┴───────┴────┴───────┴────┴───────┤"
            Printer.Print Tab(0); "│合计金额│"; Tab(13); "大写："; daxie; "整"; Tab(71); "￥："; zfy; Tab(105); "│"
            Printer.Print Tab(0); "├────┴──────────────────────────────────────────────┤"
            Printer.Print Tab(0); "│                                医    疗    保    险    结    算    栏                                │"
            Printer.Print Tab(0); "├───┬────┬─────┬────┬─────┬────┬──────┬────┬───┬────┤"
            Printer.Print Tab(0); "│起付额│        │共付段自付│        │乙级药自付│        │特诊特治自付│        │全自费│        │"
            Printer.Print Tab(0); "├───┴──┬─┴───┬─┴────┴─────┴────┴──────┼────┴───┼────┤"
            Printer.Print Tab(0); "│个人支付小计│          │其中：帐户支付：            现金支付：          │统筹基金支付小计│  　    │"
            Printer.Print Tab(0); "├──────┴─────┴────────────────────────┼────────┴────┤"
            Printer.Print Tab(0); "│交费金额：                                           ￥：             　  │超过最高支付限额：        │"
            Printer.Print Tab(0); "├────┬───────┬────┬───────┬────┬──────┴┬────┬───────┤"
            Printer.Print Tab(0); "│ 已  交 │"; Tab(13); yjf; Tab(27); "│收 现 金│"; ssf; Tab(53); "│ 欠  费 │"; qf; Tab(79); "│ 退  款 │"; tf; Tab(105); "│"
            Printer.Print Tab(0); "└────┴───────┴────┴───────┴────┴───────┴────┴───────┘"
            Printer.EndDoc
        Else
            MsgBox "出院日期不能小于住院日期！"
        End If
    End If
Else
    Command2.Enabled = False
    .Recordset.Fields("出院标记") = False
MsgBox "出院日期填写不完整！"
    '保存时给出院标记和出院日期赋值
End If
'Text14.text = ""
'Text15.text = ""
'Text16.text = ""
'Command2.Enabled = False
Command4.Enabled = False
End With
Exit Sub
cw2:
MsgBox "无法预知的错误!"
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Command4_Click()
'限制数字输入
Dim i As Integer
Command1.Enabled = True
Command4.Enabled = False
For i = 0 To 26
Text17(i).Enabled = True
Text17(i).text = 0
Next
End Sub

Private Sub Command5_Click()
MsgBox "目前本院尚未实行医疗保险结算制度！"
End Sub

Private Sub Form_Activate()
frmmain.StatusBar1.Panels(2) = "活动窗口：" & frmsum.Caption
End Sub

Private Sub Form_Load()
On Error GoTo err0
frmsum.Top = (frmmain.Height - frmsum.Height) / 2 - 500
frmsum.Left = (frmmain.Width - frmsum.Width) / 2
Adodc1.ConnectionString = frmlogin.conn
Adodc2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\systemset.mdb;Persist Security Info=False"
Adodc2.RecordSource = "select 单位名称 from setinfo order by ID"
Adodc2.Refresh
frmlogin.userdwname = Adodc2.Recordset.Fields("单位名称")
Command1.Enabled = False
Command2.Enabled = False
Command4.Enabled = False
Text42.text = ""
frmsum.Height = 2755
Exit Sub
err0:
MsgBox "数据库连接失败！"
End Sub

Private Sub Text1_Change()
Dim i As Integer
On Error GoTo err1
Command2.Enabled = False
Text14.text = ""
Text15.text = ""
Text16.text = ""
'If Not IsNumeric(Text1.text) Then
'MsgBox "只能输入“0-9”数字！"
'Text1.SetFocus
'Else
With Adodc1
.RecordSource = " select * from zyf where 住院证号='" & Text1.text & "' and 出院标记=false"
.Refresh
If .Recordset.AbsolutePosition <> adPosUnknown Then
Text2.text = .Recordset.Fields("患者姓名")
Text40.text = .Recordset.Fields("性别")
Text3.text = .Recordset.Fields("年龄")
Text4.text = .Recordset.Fields("病种")
Text5.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("住院日期"))
Command4.Enabled = True
frmsum.Height = 6480
For i = 0 To 26
Text17(i).Enabled = False
Next
    If (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计")) >= 0 Then
        Label44.Caption = "最新余额：" & (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计")) & "元"
    Else
        Label44.Caption = "该患者欠费：" & (-1) * (.Recordset.Fields("预交费") - .Recordset.Fields("费用合计")) & "元"
    End If
Else
frmsum.Height = 2755
Command4.Enabled = False
Text2.text = ""
Text40.text = ""
Text3.text = ""
Text4.text = ""
Text5.text = ""
Text6.text = ""
Text7.text = ""
Text8.text = ""
Text9.text = ""
Text10.text = ""
Text11.text = ""
Text12.text = ""
Text13.text = ""
End If
End With
'End If
Exit Sub
err1:
MsgBox "原始数据库字段值不完整或输入数据有错！"
End Sub
Private Sub text14_Change()
If Text14.text <> "" Then
    If Not IsNumeric(Text14.text) Then
        MsgBox "只能输入“0-9”数字！"
        Text14.text = ""
        Text14.SetFocus
    End If
End If
End Sub
Private Sub text15_Change()
If Text15.text <> "" Then
If Not IsNumeric(Text15.text) Then
    MsgBox "只能输入“0-9”数字！"
    Text15.SetFocus
    Text15.text = ""
Else
    If Text15.text > 12 Or Text15.text < 1 Then
        MsgBox "月份不能大于12，小于1！"
        Text15.text = ""
        Text15.SetFocus
    End If
End If
End If
End Sub
Private Sub text16_Change()
If Text16.text <> "" Then
If Not IsNumeric(Text16.text) Then
    MsgBox "只能输入“0-9”数字！"
    Text16.text = ""
    Text16.SetFocus
Else
    If Text16.text > 31 Or Text16.text < 1 Then
        MsgBox "日期不能大于31，小于1！"
        Text16.SetFocus
        Command2.Enabled = False
    Else
        Command2.Enabled = True
    End If
End If
End If
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 Text17_GotFocus(Index As Integer)
Text17(Index).SelStart = 0
Text17(Index).SelLength = Len(Text17(Index).text)
End Sub

Private Sub Text17_Change(Index As Integer)
If Not IsNumeric(Text17(Index).text) Then
    MsgBox "只能输入“0-9”数字！"
    Text17(Index).SetFocus
    'Text17(Index).text = 0
End If
End Sub