shffrm.frm

医院管理系统已经在运行中

         End
         Begin VB.Label Label14 
            AutoSize        =   -1  'True
            Caption         =   "检药："
            Height          =   180
            Left            =   4320
            TabIndex        =   40
            Top             =   5955
            Width           =   540
         End
         Begin VB.Label Label15 
            AutoSize        =   -1  'True
            Caption         =   "日期："
            Height          =   180
            Left            =   6300
            TabIndex        =   39
            Top             =   5955
            Width           =   540
         End
      End
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "卓资县人民医院门诊处方收费"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF00FF&
      Height          =   435
      Index           =   0
      Left            =   2595
      TabIndex        =   53
      Top             =   15
      Width           =   6045
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "卓资县人民医院门诊处方收费"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   435
      Index           =   1
      Left            =   2640
      TabIndex        =   52
      Top             =   45
      Width           =   6045
   End
End
Attribute VB_Name = "shffrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mdbstr2 As String

Private Sub Command1_Click()
  sf = MsgBox("患者是否已经交费", vbYesNo + 32)
  If sf = 6 Then
     Data1.Recordset.Edit
     Data1.Recordset.Fields(105) = "收"
     Data1.Recordset.Fields(106) = Str(Date)
     Data1.Recordset.Update
     pt = MsgBox("收费操作成功，是否打印收据！？", vbYesNo + 32)
     If pt = 6 Then Call prt
     Call Command3_Click
     Text1.SetFocus
  End If
End Sub
Sub prt()
On Error GoTo er
    Dim f(22)
    For i = 0 To 13
        f(i) = Val(Label17(i).Caption)
    Next i
    For i = 0 To 13
        f(i) = f(i) & Space(11 - Len(Str(f(i))))
    Next i
    f(13) = Label20.Caption
    f(13) = f(13) & Space(37 - Len(f(13)))
    dx = changemoney(Val(Label20.Caption)) & "整"
    f(14) = dx
    f(14) = f(14) & Space(64 - Len(f(14)))
    f(15) = czyxm
    f(15) = f(15) & Space(28 - Len(f(15)))
    f(16) = Date
    f(16) = f(16) & Space(24 - Len(f(16)))
    Printer.FontSize = 18
    Printer.FontName = "宋体"
    Printer.FontBold = True
    Printer.CurrentX = 1100
    Printer.CurrentY = 1800
    Printer.Print "卓资县人民医院门诊收费收据"
    Printer.FontSize = 11
    Printer.FontBold = False
    Printer.CurrentX = 1100
    Printer.CurrentY = 3100
    Printer.Print "姓名：" & Text3.Text
    Printer.CurrentX = 1100
    Printer.CurrentY = 2450
    Printer.Print "流水号：" & Date & Text1.Text
    Printer.CurrentX = 2800
    Printer.CurrentY = 2450
    Printer.Print "┏━━━━━━┯━━━━━┯━━━━━━┯━━━━━┯━━━━━━┯━━━━━┓"
    Printer.Print "┃   项目　 　│   金额   │   项目     │ 　金额   │   项目     │　 金额   ┃"
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  西药费    │" & f(0) & "│  透照费    │" & f(8) & "│  基础费    │" & f(12) & "┃" '在住院收费中把基础费改为住院费
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  中药费    │" & f(1) & "│  针灸费    │" & f(6) & "│  陪床费    │          ┃收"
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  注射费    │" & f(3) & "│  体检费    │          │  取暖费    │          ┃费"
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  处置费    │" & f(4) & "│  心电费    │" & f(9) & "│  挂号费    │          ┃收"
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  手术费    │" & f(2) & "│  超声波    │" & f(11) & "│  护理费    │          ┃据"
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  化验费    │" & f(7) & "│  脑电费    │" & f(10) & "│  抢救费    │          ┃遗"
    Printer.Print "┠──────┼─────┼──────┼─────┼──────┼─────┨"
    Printer.Print "┃  理疗费    │" & f(5) & "│  胃镜费    │          │  CT费      │          ┃失"
    Printer.Print "┠──────┼─────┼──────┼─────┴──────┴─────┨"
    Printer.Print "┃  其  他    │" & f(13) & "│  合  计    │" & f(13) & "┃不 "
    Printer.Print "┠──────┴─────┴──────┴──────────────────┨"
    Printer.Print "┃人民币(大写):" & f(14) & "┃补"
    Printer.Print "┠────┬──────────────┬─────┬────────────┨"
    Printer.Print "┃收费员：│" & f(15) & "│ 日期：   │" & f(16) & "┃"
    Printer.Print "┗━━━━┷━━━━━━━━━━━━━━┷━━━━━┷━━━━━━━━━━━━┛"
    Printer.EndDoc
    Exit Sub
er:
    MsgBox "打印或打印机出现故障！"
    End
End Sub
Private Sub Command2_Click()
On Error GoTo er
   Data1.RecordSource = "select * from 门诊处方 where trim(收费日期)=" + "'" + Str(Date) + "'"
   Data1.Refresh
   hj1 = 0
   While Data1.Recordset.EOF = False
      hj1 = hj1 + Val(Data1.Recordset.Fields(100))
      Data1.Recordset.MoveNext
   Wend
   MsgBox "今日收费总和为：" & hj1 & "元,请核对数字后单击确定！！", vbOKOnly + 64
   Exit Sub
er:
  MsgBox "计算数据过程出现错误！，可能是网络连接错误！"
End Sub

Private Sub Command3_Click()
   Command1.Enabled = False
   Command3.Enabled = False
   Text1.Text = ""
   Text2.Text = ""
   Text3.Text = ""
   Text4.Text = ""
   Text5.Text = ""
   Text6.Text = ""
   Text7.Text = ""
   Text8.Text = ""
   Text9.Text = ""
   List1.Clear
   List2.Clear
   List3.Clear
   List4.Clear
   For k = 0 To 13
     Label17(k).Caption = "0"
   Next k
   Label20.Caption = ""
   Text1.SetFocus
End Sub

Private Sub Command4_Click()
   Unload Me
End Sub

Private Sub Command5_Click()
  Call prt
End Sub

Private Sub Form_Activate()
  Text1.Text = ""
  Text2.Text = ""
  Text3.Text = ""
  Text4.Text = ""
  Text5.Text = ""
  Text6.Text = ""
  Text7.Text = ""
  Text8.Text = ""
  Text9.Text = ""
  Label11.Caption = ""
  Label20.Caption = ""
  Label20.AutoSize = True
  Label20.Top = Label10.Top - 35
  Label20.Left = Label10.Left + Label10.Width + 20
  For k = 0 To 13
    Label17(k).Visible = False
    Label17(k).Caption = ""
  Next k
  For h = 6 To 19
     Label16(h - 6).Visible = True
     Label16(h - 6).Caption = Data1.Recordset.Fields(h).Name
  Next h
  Text1.SetFocus
End Sub

Private Sub Form_Load()
  Data1.DatabaseName = dbstr
  Data1.RecordSource = "门诊处方"
  Data1.Refresh
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Or KeyAscii = 13 Then
   Else
      KeyAscii = 0
      Exit Sub
   End If
   If KeyAscii = 13 Then
      If Text1.Text = "" Then
         Exit Sub
      End If
      List1.Clear
      List2.Clear
      List3.Clear
      List4.Clear
       For k = 0 To 13
         Label17(k).Caption = ""
      Next k
      Data1.RecordSource = "select * from 门诊处方 where trim(处方代码)=" + "'" + Trim(Text1.Text) + "'"
      Data1.Refresh
      If Data1.Recordset.EOF = True Then
         MsgBox "处方记录不存在，请输入一张已经划价的处方代码！"
         Text1.Text = ""
         Text1.SetFocus
         Exit Sub
      End If
      Text2.Text = Data1.Recordset.Fields(1)
      Text3.Text = Data1.Recordset.Fields(2)
      Text4.Text = Data1.Recordset.Fields(3)
      Text5.Text = Data1.Recordset.Fields(4)
      Text6.Text = Data1.Recordset.Fields(5)
      For k = 6 To 19
        If Data1.Recordset.Fields(k) <> "" Then
           Label17(k - 6).Caption = Data1.Recordset.Fields(k)
           Label17(k - 6).Visible = True
        End If
      Next k
      h = 0
      For k = 20 To 96 Step 4
         If Data1.Recordset.Fields(k) <> "" Then
            List1.AddItem Data1.Recordset.Fields(k)
            List2.AddItem Data1.Recordset.Fields(k + 1)
            List3.AddItem Data1.Recordset.Fields(k + 2) & Trim(List2.List(h))
            List4.AddItem Data1.Recordset.Fields(k + 3) & "元/每" & Trim(List2.List(h))
            h = h + 1
         End If
      Next k
      Label20.Caption = Data1.Recordset.Fields(100) & "元"
      If IsNull(Data1.Recordset.Fields(101)) = False Then
         Text7.Text = Data1.Recordset.Fields(101)
      Else
         Text7.Text = ""
      End If
      If IsNull(Data1.Recordset.Fields(102)) = False Then
         Text8.Text = Data1.Recordset.Fields(102)
      Else
         Text8.Text = ""
      End If
      If IsNull(Data1.Recordset.Fields(103)) = False Then
         Text9.Text = Data1.Recordset.Fields(103)
      Else
         Text9.Text = ""
      End If
      If IsNull(Data1.Recordset.Fields(104)) = False Then
         Label11.Caption = Data1.Recordset.Fields(104)
      Else
         Label11.Caption = "未知"
      End If
      If Data1.Recordset.Fields(105) = "收" Then
         MsgBox "处方已经收费，不能重复收费！！"
         Call Command3_Click
         Command1.Enabled = False
         Command3.Enabled = False
         Exit Sub
      Else
        Command1.Enabled = True
        Command3.Enabled = True
        Command1.SetFocus
      End If
   End If
End Sub