yprkfrm.frm

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

   Command1.Enabled = False
   Command2.Enabled = False
   Command3.Enabled = False
   Command4.Enabled = True
   Command5.Enabled = False
End Sub

Private Sub Command4_Click()
On Error GoTo er
  If Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Or Text7.Text = "" Or Text10.Text = "" Or Combo2.Text = "" Or Text2.Text = "" Or Combo3.Text = "" Then
     MsgBox "输入数据不完全，请检查输入数据的完整性，然后再保存！"
     Exit Sub
  End If
  If qq = 111 Then
       Adodc4.Refresh
       Data1.Refresh
       Data1.Recordset.FindFirst "生产厂家+药品品名+规格=" + "'" + Trim(Combo2.Text) + Trim(Text2.Text) + Trim(Text3.Text) + "'"
       If Data1.Recordset.NoMatch = False Then
          Adodc4.Recordset.AbsolutePosition = Data1.Recordset.AbsolutePosition + 1
          Adodc4.Recordset.Fields(6) = Int((Val(Adodc4.Recordset.Fields(6)) + Val(Text4.Text)) / 2 * 100 + 0.5) / 100
          Adodc4.Recordset.Fields(7) = Int((Val(Adodc4.Recordset.Fields(7)) + Val(Text5.Text)) / 2 * 100 + 0.5) / 100
          Adodc4.Recordset.Fields(8) = Int((Val(Adodc4.Recordset.Fields(8)) + Val(Text6.Text)) / 2 * 100 + 0.5) / 100
          Adodc4.Recordset.Fields(9) = Int(Val(Adodc4.Recordset.Fields(9)) + Val(Text7.Text))
          Adodc4.Recordset.Fields(10) = Int((Val(Adodc4.Recordset.Fields(10)) + Val(Text8.Text)) * 100 + 0.5) / 100
          If Text9.Text <> "" Then
             Adodc4.Recordset.Fields(11) = Text9.Text
          Else
             Adodc4.Recordset.Fields(11) = ""
          End If
          Adodc4.Recordset.Update
       Else
        Adodc4.Recordset.AddNew
        Adodc4.Recordset.Fields(0) = Text10.Text
        Adodc4.Recordset.Fields(1) = Combo2.Text
        Adodc4.Recordset.Fields(2) = Text1.Text
        Adodc4.Recordset.Fields(3) = Trim(Text2.Text)
        Adodc4.Recordset.Fields(4) = Trim(Text3.Text)
        Adodc4.Recordset.Fields(5) = Trim(Combo3.Text)
        Adodc4.Recordset.Fields(6) = Val(Text4.Text)
        Adodc4.Recordset.Fields(7) = Val(Text5.Text)
        Adodc4.Recordset.Fields(8) = Val(Text6.Text)
        Adodc4.Recordset.Fields(9) = Val(Text7.Text)
        Adodc4.Recordset.Fields(10) = Int(Val(Text8.Text) * 100 + 0.5) / 100
        If Text9.Text <> "" Then
           Adodc4.Recordset.Fields(11) = Text9.Text
        Else
           Adodc4.Recordset.Fields(11) = ""
        End If
        Adodc4.Recordset.Update
      End If
  End If
  If qq = 222 Then
        Adodc4.Recordset.Fields(0) = Text10.Text
        Adodc4.Recordset.Fields(1) = Combo2.Text
        Adodc4.Recordset.Fields(2) = Text1.Text
        Adodc4.Recordset.Fields(3) = Trim(Text2.Text)
        Adodc4.Recordset.Fields(4) = Trim(Text3.Text)
        Adodc4.Recordset.Fields(5) = Trim(Combo3.Text)
        Adodc4.Recordset.Fields(6) = Val(Text4.Text)
        Adodc4.Recordset.Fields(7) = Val(Text5.Text)
        Adodc4.Recordset.Fields(8) = Val(Text6.Text)
        Adodc4.Recordset.Fields(9) = Val(Text7.Text)
        Adodc4.Recordset.Fields(10) = Val(Text8.Text)
        If Text9.Text <> "" Then
           Adodc4.Recordset.Fields(11) = Text9.Text
        Else
           Adodc4.Recordset.Fields(11) = ""
        End If
        Adodc4.Recordset.Update
  End If
  Command1.Enabled = True
  Command2.Enabled = True
  Command3.Enabled = True
  Command4.Enabled = False
  Command5.Enabled = True
  Command1.SetFocus
  Frame4.Enabled = False
  List1.Visible = False
  Call grd
  Exit Sub
er:
  MsgBox "数据库或网络连接出现错误！或出现其他未知错误！"
End Sub

Private Sub Command5_Click()
ypmc = InputBox("请输入您要查找的药品名称")
If ypmc <> "" Then
   Adodc4.Refresh
   Adodc4.Recordset.Find ("药品品名=" + "'" + ypmc + "'")
   If Adodc4.Recordset.EOF = False Then
      Call disp7
      Call grd
   Else
      MsgBox " 没有找到匹配的药品！"
   End If
End If

End Sub

Private Sub Command6_Click()
   Command1.Enabled = True
   Command2.Enabled = True
   Command3.Enabled = True
   Command4.Enabled = False
   Command5.Enabled = True
   Frame4.Enabled = False
   Text10.Text = ""
   Combo2.Text = ""
   Combo3.Text = ""
   Text1.Text = ""
   Text2.Text = ""
   Text3.Text = ""
   Text4.Text = ""
   Text5.Text = ""
   Text6.Text = ""
   Text7.Text = ""
   Text8.Text = ""
   Text9.Text = ""
End Sub

Private Sub DataGrid1_Click()
  If Adodc4.Recordset.EOF = False Then
     Command1.Enabled = True
     Command2.Enabled = True
     Command3.Enabled = True
     Command4.Enabled = False
     Command5.Enabled = True
     Command1.SetFocus
     Frame4.Enabled = False
     Call grd
     Call disp7
     Command3.SetFocus
  End If
End Sub

Private Sub DataGrid1_DblClick()
  Adodc4.RecordSource = "药品库存"
  Adodc4.Refresh
  If moues = 1 Then
     Adodc4.Refresh
     moues = 2
  Else
     Call grd
     moues = 1
  End If
End Sub
Sub disp7()
    Text10.Text = Adodc4.Recordset.Fields(0)
    Combo2.Text = Adodc4.Recordset.Fields(1)
    Text1.Text = Adodc4.Recordset.Fields(2)
    Text2.Text = Adodc4.Recordset.Fields(3)
    Text3.Text = Adodc4.Recordset.Fields(4)
    Combo3.Text = Adodc4.Recordset.Fields(5)
    Text4.Text = Adodc4.Recordset.Fields(6)
    Text5.Text = Adodc4.Recordset.Fields(7)
    Text6.Text = Adodc4.Recordset.Fields(8)
    Text7.Text = Adodc4.Recordset.Fields(9)
    Text8.Text = Adodc4.Recordset.Fields(10)
    Text9.Text = Adodc4.Recordset.Fields(11)
End Sub
Private Sub Form_Activate()
On Error GoTo er
  Text10.Text = ""
  Combo2.Text = ""
  Text1.Text = ""
  
  Text3.Text = ""
  Text4.Text = ""
  Combo3.Text = ""
  Text4.Text = ""
  Text5.Text = ""
  Text6.Text = ""
  Text7.Text = ""
  Text8.Text = ""
  Text9.Text = ""
  List1.Visible = False
  List1.Clear
  Frame4.Enabled = False
  ReDim yp(rc + 1, 3) As String
  Adodc3.Refresh
  k = 1
  While Adodc3.Recordset.EOF = False
     yp(k, 1) = Adodc3.Recordset.Fields(0)
     yp(k, 2) = Adodc3.Recordset.Fields(1)
     yp(k, 3) = Adodc3.Recordset.Fields(2)
     k = k + 1
     Adodc3.Recordset.MoveNext
  Wend
  Command1.SetFocus
  moues = 1
  Adodc4.Refresh
  While Adodc4.Recordset.EOF = False
    If Adodc4.Recordset.Fields(9) = 0 Then
       Adodc4.Recordset.Delete
    End If
    Adodc4.Recordset.MoveNext
  Wend
  Adodc4.Refresh
  Call grd
  Exit Sub
er:
  MsgBox "服务器数据库连接错误！"
End Sub
Sub grd()
    DataGrid1.Refresh
    DataGrid1.Columns(0).Visible = False
    DataGrid1.Columns(1).Visible = False
    DataGrid1.Columns(5).Visible = False
    DataGrid1.Columns(6).Visible = False
    DataGrid1.Columns(7).Visible = False
    DataGrid1.Columns(2).Width = 1100
    DataGrid1.Columns(4).Width = 900
    DataGrid1.Columns(8).Width = 900
    DataGrid1.Columns(9).Width = 750
    DataGrid1.Columns(10).Width = 1200
End Sub
Private Sub Form_Load()
  mdbstr = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" + dbstr
  Adodc1.ConnectionString = mdbstr
  Adodc1.RecordSource = "处方类别"
  Adodc1.Refresh
  Adodc2.ConnectionString = mdbstr
  Adodc2.RecordSource = "厂家"
  Adodc2.Refresh
  Adodc3.ConnectionString = mdbstr
  Adodc3.RecordSource = "药品代码"
  Adodc3.Refresh
  Adodc4.ConnectionString = mdbstr
  Adodc4.RecordSource = "药品库存"
  Adodc4.Refresh
  Data1.DatabaseName = dbstr
  Data1.RecordSource = "药品库存"
  Data1.Refresh
  'Combo1.Clear
  'While Adodc1.Recordset.EOF = False
  '   Combo1.AddItem Adodc1.Recordset.Fields(1)
  '   Adodc1.Recordset.MoveNext
  'Wend
  Combo2.Clear
  While Adodc2.Recordset.EOF = False
     Combo2.AddItem Adodc2.Recordset.Fields(1)
     Adodc2.Recordset.MoveNext
  Wend
  rc = 0
  While Adodc3.Recordset.EOF = False
     rc = rc + 1
     Adodc3.Recordset.MoveNext
  Wend
End Sub

Private Sub List1_DblClick()
   Text2.Text = List1.List(List1.ListIndex)
   List1.Visible = False
   h = 1
       While h <= rc And Trim(yp(h, 2)) <> Trim(Text2.Text)
          h = h + 1
       Wend
       If h <= rc Then
           Text10.Text = yp(h, 3)
       Else
           Text10.Text = "其他"
       End If
   Text3.SetFocus
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Or KeyAscii = 13 Then
       Text2.Text = List1.List(List1.ListIndex)
       List1.Visible = False
       h = 1
       While h <= rc And Trim(yp(h, 2)) <> Trim(Text2.Text)
          h = h + 1
       Wend
       If h <= rc Then
           Text10.Text = yp(h, 3)
       Else
           Text10.Text = "其他"
       End If
       Text3.SetFocus
    End If
End Sub

Private Sub Text2_Change()
   'yp是药品数组  1号元素是输入码， 2号元素是名称
   Ln = Len(Text2.Text)
   List1.Clear
   k = 1
   While k <= rc
      If Left(yp(k, 1), Ln) = Trim(Text2.Text) Then List1.AddItem yp(k, 2)
      k = k + 1
   Wend
   If List1.ListCount > 0 Then
      List1.Visible = True
      List1.Selected(0) = True
   Else
      List1.Visible = False
   End If
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = 32 Or KeyCode = 13 Then
      If List1.ListCount > 0 Or List1.Visible = True Then
         Text2.Text = List1.List(List1.ListIndex)
         List1.Visible = False
      End If
      h = 1
       While h <= rc And Trim(yp(h, 2)) <> Trim(Text2.Text)
          h = h + 1
       Wend
       If h <= rc Then
           Text10.Text = yp(h, 3)
       Else
           Text10.Text = "其他"
       End If
      Text3.SetFocus
   End If
   If KeyCode = 40 Then List1.SetFocus
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
   If KeyAscii = 32 Then KeyAscii = 0
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Combo3.SetFocus
   If KeyAscii = 8 Then
      Text2.SetFocus
      Text2.SelStart = 0
      Text2.SelLength = Len(Text2.Text)
   End If
End Sub

Private Sub Text4_Change()
  Text8.Text = Int(Val(Text4.Text) * Val(Text7.Text) * 100 + 0.5) / 100
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Text5.SetFocus
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Text6.SetFocus
End Sub

Private Sub Text6_KeyPress(KeyAscii As Integer)
   If KeyAscii = 13 Then Text7.SetFocus
End Sub

Private Sub Text7_Change()
   Text8.Text = Int(Val(Text4.Text) * Val(Text7.Text) * 100 + 0.5) / 100
End Sub

Private Sub Text7_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then Text9.SetFocus
End Sub

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