tychlfrm.frm

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

VERSION 5.00
Begin VB.Form tychlfrm 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "退药处理"
   ClientHeight    =   7575
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   8805
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   7575
   ScaleWidth      =   8805
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Data Data2 
      Caption         =   "Data2"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   6840
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   0
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.Frame Frame2 
      Caption         =   "退药"
      ForeColor       =   &H00C000C0&
      Height          =   5535
      Left            =   120
      TabIndex        =   6
      Top             =   1560
      Width           =   8535
      Begin VB.CommandButton Command2 
         Caption         =   "确定"
         Height          =   855
         Left            =   3680
         Picture         =   "tychlfrm.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   10
         Top             =   3000
         Width           =   855
      End
      Begin VB.CommandButton Command1 
         Height          =   735
         Left            =   3680
         Picture         =   "tychlfrm.frx":0442
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   1560
         Width           =   855
      End
      Begin VB.ListBox List2 
         Height          =   4740
         Left            =   4680
         TabIndex        =   8
         Top             =   600
         Width           =   3615
      End
      Begin VB.ListBox List1 
         Height          =   4740
         Left            =   120
         TabIndex        =   7
         Top             =   600
         Width           =   3375
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "现退药！"
         ForeColor       =   &H000000FF&
         Height          =   180
         Left            =   4680
         TabIndex        =   12
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "已购药！"
         ForeColor       =   &H000000FF&
         Height          =   180
         Left            =   120
         TabIndex        =   11
         Top             =   240
         Width           =   720
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "操作？"
      ForeColor       =   &H00FF0000&
      Height          =   735
      Left            =   120
      TabIndex        =   1
      Top             =   720
      Width           =   8535
      Begin VB.CommandButton Command4 
         Caption         =   "查  找"
         Enabled         =   0   'False
         Height          =   375
         Left            =   6960
         TabIndex        =   13
         Top             =   240
         Width           =   1220
      End
      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   5230
         TabIndex        =   5
         Text            =   "Text1"
         Top             =   240
         Width           =   1220
      End
      Begin VB.OptionButton Option1 
         Caption         =   "门诊退药"
         Height          =   375
         Left            =   360
         Style           =   1  'Graphical
         TabIndex        =   3
         Top             =   240
         Width           =   1220
      End
      Begin VB.OptionButton Option2 
         Caption         =   "病房退药"
         Height          =   375
         Left            =   2090
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   240
         Width           =   1220
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "处 方 代 码："
         Height          =   180
         Left            =   3825
         TabIndex        =   4
         Top             =   360
         Width           =   1170
      End
   End
   Begin VB.Data Data1 
      Caption         =   "Data1"
      Connect         =   "Access"
      DatabaseName    =   ""
      DefaultCursorType=   0  '缺省游标
      DefaultType     =   2  '使用 ODBC
      Exclusive       =   0   'False
      Height          =   375
      Left            =   0
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   ""
      Top             =   0
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "退药金额："
      ForeColor       =   &H000000FF&
      Height          =   180
      Left            =   120
      TabIndex        =   14
      Top             =   7200
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "卓资县人民医院处方退药处理"
      BeginProperty Font 
         Name            =   "华文行楷"
         Size            =   21.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00004000&
      Height          =   450
      Left            =   1320
      TabIndex        =   0
      Top             =   120
      Width           =   5850
   End
End
Attribute VB_Name = "tychlfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ty(21, 4)
Dim tyje

Private Sub Command1_Click()
  If Option1.Value = True Then
   If List1.ListIndex = -1 Then
      MsgBox "请选择退药！！"
      Exit Sub
   End If
   sltemp = Val(InputBox("请输入退药数量！！"))
   hh = List1.ListIndex
   If sltemp > 0 Then
      If sltemp > ty(hh, 3) Then
         MsgBox "退药数量超出购买数量，不能退药！！", vbOKOnly + 16
         Exit Sub
      End If
      If sltemp <= ty(hh, 3) Then
         mm = MsgBox("确认退药吗？", vbYesNo + 32)
         If mm = 7 Then Exit Sub
         List2.AddItem ty(hh, 1) & "     " & sltemp & ty(hh, 2)
         '退药入库
         Data2.Refresh
         Data2.Recordset.FindFirst "药品品名=" + "'" + ty(hh, 1) + "'"
         If Data2.Recordset.NoMatch = True Then
            MsgBox "此药品现有库存量为零，原则上" & Chr(13) & Chr(10) & "不可以退药！！如果必须退药，请手工操作！！", vbOKOnly + 48
            Exit Sub
         Else
            
            tyje = tyje + sltemp * ty(hh, 4)
            Label5.Caption = "退药金额：" & tyje
            dr = Data2.Recordset.Fields("数量") + sltemp
            kchj = Data2.Recordset.Fields("进价") * dr
            Data2.Recordset.Edit
            Data2.Recordset.Fields("数量") = dr
            Data2.Recordset.Fields("合计") = kchj
            Data2.Recordset.Update
            ty(hh, 3) = ty(hh, 3) - sltemp '从购药中减去退药
            For i = 20 To 96 Step 4
                If Trim(Data1.Recordset.Fields(i)) = Trim(ty(hh, 1)) Then
                   a = Data1.Recordset.Fields(i) '品名
                   b = Data1.Recordset.Fields(i + 1) '单位
                   c = Data1.Recordset.Fields(i + 2) - sltemp '数量
                   d = Data1.Recordset.Fields(i + 3) '单价
                   hj = Data1.Recordset.Fields("合计") - tyje
                   Data1.Recordset.Edit
                   Data1.Recordset.Fields(i + 2) = c
                   Data1.Recordset.Fields("合计") = hj
                   Data1.Recordset.Update
                   Exit For
                End If
            Next i
         End If
      End If
   End If
 End If
 If Option2.Value = True Then '病房处方退药
    If List1.ListIndex = -1 Then
      MsgBox "请选择退药！！"
      Exit Sub
   End If
   sltemp = Val(InputBox("请输入退药数量！！"))
   hh = List1.ListIndex
   If sltemp > 0 Then
      If sltemp > ty(hh, 3) Then
         MsgBox "退药数量超出购买数量，不能退药！！", vbOKOnly + 16
         Exit Sub
      End If
      If sltemp <= ty(hh, 3) Then
         mm = MsgBox("确认退药吗？", vbYesNo + 32)
         If mm = 7 Then Exit Sub
         List2.AddItem ty(hh, 1) & "     " & sltemp & ty(hh, 2)
         '退药入库
         Data2.Refresh
         Data2.Recordset.FindFirst "药品品名=" + "'" + ty(hh, 1) + "'"
         If Data2.Recordset.NoMatch = True Then
            MsgBox "此药品现有库存量为零，原则上" & Chr(13) & Chr(10) & "不可以退药！！如果必须退药，请手工操作！！", vbOKOnly + 48
            Exit Sub
         Else
            
            tyje = tyje + sltemp * ty(hh, 4)
            Label5.Caption = "退药金额：" & tyje
            dr = Data2.Recordset.Fields("数量") + sltemp
            kchj = Data2.Recordset.Fields("进价") * dr
            Data2.Recordset.Edit
            Data2.Recordset.Fields("数量") = dr
            Data2.Recordset.Fields("合计") = kchj
            Data2.Recordset.Update
            ty(hh, 3) = ty(hh, 3) - sltemp '从购药中减去退药
            For i = 26 To 106 Step 4
                If Trim(Data1.Recordset.Fields(i)) = Trim(ty(hh, 1)) Then
                   a = Data1.Recordset.Fields(i) '品名
                   b = Data1.Recordset.Fields(i + 1) '单位
                   c = Data1.Recordset.Fields(i + 2) - sltemp '数量
                   d = Data1.Recordset.Fields(i + 3) '单价
                   hj = Data1.Recordset.Fields("合计") - tyje
                   Data1.Recordset.Edit
                   Data1.Recordset.Fields(i + 2) = c
                   Data1.Recordset.Fields("合计") = hj
                   Data1.Recordset.Update
                   Exit For
                End If
            Next i
         End If
      End If
   End If
 End If
End Sub

Private Sub Command3_Click()

End Sub

Private Sub Command2_Click()
   If List2.ListCount > 0 Then
      MsgBox "退药操作成功！请收药并付款！！"
   End If
   Frame2.Enabled = False
   Frame1.Enabled = True
   Text1.Text = ""
   Text1.SetFocus
   List1.Clear
   List2.Clear
   
End Sub

Private Sub Command4_Click()
  If Option1.Value = True Then
    List1.Clear
    Data1.Refresh
    Data1.Recordset.FindFirst "trim(处方代码)=" + "'" + Trim(Text1.Text) + "'"
    If Data1.Recordset.NoMatch = True Then
       MsgBox "该处方不存在，不能退药！！", vbOKOnly + 16
       Frame2.Enabled = False
       Text1.Text = ""
       Text1.SetFocus
       List1.Clear
       List2.Clear
       Exit Sub
    End If
    h = 0
    For i = 20 To 96 Step 4
       If IsNull(Data1.Recordset.Fields(i)) = False And Trim(Data1.Recordset.Fields(i)) <> "0" Then
          a = Data1.Recordset.Fields(i)
          b = Data1.Recordset.Fields(i + 1)
          c = Data1.Recordset.Fields(i + 2) '数量
          d = Data1.Recordset.Fields(i + 3) '单价
          List1.AddItem a & "   " & c & b & "    " & d & "元/" & b
          ty(h, 1) = a: ty(h, 2) = b: ty(h, 3) = c: ty(h, 4) = d
          h = h + 1
       End If
    Next i
    If Trim(Data1.Recordset.Fields("收费")) = "未" Then
       MsgBox "该处方划价后没有收费，故不能退药！！", vbOKOnly + 16
       Frame2.Enabled = False
       Frame1.Enabled = True
    Else
       Frame2.Enabled = True
       Frame1.Enabled = False
    End If
  End If
  If Option2.Value = True Then '病房退药
     List1.Clear
     Data1.RecordSource = "病房处方"
     Data1.Refresh
     Data1.Recordset.FindFirst "trim(处方代码)=" + "'" + Trim(Text1.Text) + "'"
    If Data1.Recordset.NoMatch = True Then
       MsgBox "该处方不存在，不能退药！！", vbOKOnly + 16
       Frame2.Enabled = False
       Text1.Text = ""
       Text1.SetFocus
       List1.Clear
       List2.Clear
       Exit Sub
    End If
    h = 0
    For i = 26 To 103 Step 4
       If IsNull(Data1.Recordset.Fields(i)) = False Then
          a = Data1.Recordset.Fields(i)
          b = Data1.Recordset.Fields(i + 1)
          c = Data1.Recordset.Fields(i + 2) '数量
          d = Data1.Recordset.Fields(i + 3) '单价
          List1.AddItem a & "   " & c & b & "    " & d & "元/" & b
          ty(h, 1) = a: ty(h, 2) = b: ty(h, 3) = c: ty(h, 4) = d
          h = h + 1
       End If
    Next i
    If Trim(Data1.Recordset.Fields("收费")) = "未" Then
       MsgBox "该处方划价后没有收费，故不能退药！！", vbOKOnly + 16
       Frame2.Enabled = False
       Frame1.Enabled = True
    Else
       Frame2.Enabled = True
       Frame1.Enabled = False
    End If
  End If
End Sub

Private Sub Form_Activate()
   Text1.Text = ""
   Text1.SetFocus
End Sub

Private Sub Form_Load()
  Option1.Value = True
  Option2.Value = False
  Frame2.Enabled = False
  Data1.DatabaseName = dbstr
  Data1.RecordSource = "门诊处方"
  Data1.Refresh
  Data2.DatabaseName = dbstr
  Data2.RecordSource = "药品库存"
  Data2.Refresh
End Sub

Private Sub Text1_Change()
   If Len(Text1.Text) > 0 Then Command4.Enabled = True Else Command4.Enabled = False
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Command4.SetFocus
End Sub