hjcxfrm.frm

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

         zehj = zehj + Val(Data1.Recordset.Fields("合计"))
         Data1.Recordset.MoveNext
      Wend
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      
      tchx "病房处方查询"
      Call bfdisp
      Combo1.Visible = False
      Option5.Value = False
   End If
   If Option3.Value = True Then
      Data1.RecordSource = "select * from 门诊处方 where 医师=" + "'" + Trim(Combo1.Text) + "'" & " and 收费='未'"
      Data1.Refresh
      zehj = 0
      While Data1.Recordset.EOF = False
         zehj = zehj + Val(Data1.Recordset.Fields("合计"))
         Data1.Recordset.MoveNext
      Wend
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      
      tchx "门诊处方查询"
      Call disp8
      Option3.Value = False
      Combo1.Visible = False
   End If
   If Option6.Value = True Then
      Data1.RecordSource = "select * from 病房处方 where 医师=" + "'" + Trim(Combo1.Text) + "'" & " and 收费='未'"
      Data1.Refresh
      zehj = 0
      While Data1.Recordset.EOF = False
         zehj = zehj + Val(Data1.Recordset.Fields("合计"))
         Data1.Recordset.MoveNext
      Wend
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      
      tchx "病房处方查询"
      Call bfdisp
      Option6.Value = False
      Combo1.Visible = False
   End If
   If Option7.Value = True Then '门诊科别
      Data1.RecordSource = "select * from 门诊处方 where 科别=" + "'" + Trim(Combo1.Text) + "'" & " and 收费='未'"
      Data1.Refresh
      zehj = 0
      While Data1.Recordset.EOF = False
         zehj = zehj + Val(Data1.Recordset.Fields("合计"))
         Data1.Recordset.MoveNext
      Wend
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      
      tchx "门诊处方查询"
      Call disp8
      Option7.Value = False
      Combo1.Visible = False
   End If
   If Option8.Value = True Then '病房科别
      Data1.RecordSource = "select * from 病房处方 where 科别=" + "'" + Trim(Combo1.Text) + "'" & " and 收费='未'"
      Data1.Refresh
      zehj = 0
      While Data1.Recordset.EOF = False
         zehj = zehj + Val(Data1.Recordset.Fields("合计"))
         Data1.Recordset.MoveNext
      Wend
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      
      tchx "病房处方查询"
      Call bfdisp
      Option8.Value = False
      Combo1.Visible = False
   End If
   Label3.Caption = zehj & "元"
   Exit Sub
er:
   MsgBox "查询过程中出现数据访问错误或其他未知错误！"
End Sub

Private Sub Combo1_KeyPress(KeyAscii As Integer)
   KeyAscii = 0
End Sub

Private Sub Command1_Click()
If mzbf = 2 Then
  Call tec("病房处方查询")
Else
  Call tec("门诊处方查询")
End If
End Sub


Private Sub Form_Activate()
On Error GoTo er
   Option1.Value = False
   Option2.Value = False
   Option3.Value = False
   Option4.Value = False
   Option5.Value = False
   Option6.Value = False
   Option7.Value = False
   Option8.Value = False
   Option9.Value = False
   Option10.Value = False
   Call yc
   mzbf = 1
   Data1.RecordSource = "select * from 门诊处方 where 收费='未'"
   Data1.Refresh
   zehj = 0
   While Data1.Recordset.EOF = False
      zehj = zehj + Val(Data1.Recordset.Fields(100))
      Data1.Recordset.MoveNext
   Wend
   Label3.Caption = zehj & "元"
   Adodc1.RecordSource = Data1.RecordSource
   Adodc1.Refresh
   Call disp8
   Command1.SetFocus
   Exit Sub
er:
  MsgBox "服务器连接失败。不能进行数据查询！"

End Sub

Private Sub Form_Load()
On Error GoTo er
  mdbstr3 = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" + dbstr
  Adodc1.ConnectionString = mdbstr3
  Adodc1.RecordSource = "病房处方"
  Adodc1.Refresh
  Data1.DatabaseName = dbstr
  Data1.RecordSource = "门诊处方"
  Data1.Refresh
  Adodc2.ConnectionString = mdbstr3
  Adodc2.RecordSource = "czy"
  Adodc2.Refresh
  Adodc3.ConnectionString = mdbstr3
  Adodc3.RecordSource = "医师"
  Adodc3.Refresh
  
  Exit Sub
er:
  MsgBox "服务器连接失败。不能进行数据查询！"
End Sub
Sub disp8()
  DBGrid1.Columns(0).Width = 900
  DBGrid1.Columns(1).Width = 1111
  DBGrid1.Columns(3).Width = 500
  DBGrid1.Columns(4).Width = 500
  For k = 6 To 19
     DBGrid1.Columns(k).Width = 700
  Next k
  For k = 20 To 99
     DBGrid1.Columns(k).Visible = False
  Next k
End Sub
Sub bfdisp()
  DBGrid1.Columns(0).Width = 900
  DBGrid1.Columns(1).Width = 1111
  DBGrid1.Columns(3).Width = 500
  DBGrid1.Columns(4).Width = 500
  For k = 6 To 19
     DBGrid1.Columns(k).Width = 700
  Next k
  For k = 26 To 105
     DBGrid1.Columns(k).Visible = False
  Next k
End Sub
Private Sub Option1_Click()
On Error GoTo er
   If Option1.Value = True Then
      Combo1.Visible = False
      Call yc
      
      Data1.RecordSource = "select * from 门诊处方 where 收费='未'"
      Data1.Refresh
      
      
      mzbf = 1
      zehj = 0
      While Data1.Recordset.EOF = False
         zehj = zehj + Val(Data1.Recordset.Fields(100))
         Data1.Recordset.MoveNext
      Wend
      Label3.Caption = zehj & "元"
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      
      tchx "门诊处方查询"
      Call disp8
   End If
    
   Exit Sub
er:
   MsgBox "查询过程中出现数据访问错误或其他未知错误！"
End Sub

Private Sub Option10_Click()
  Call xs
  mzbf = 2
  Text1.SetFocus
  Combo1.Visible = False
  
End Sub

Private Sub Option2_Click()
  On Error GoTo er
   If Option2.Value = True Then
      Combo1.Top = Option2.Top + Option2.Height + 50
      Combo1.Left = Option2.Left
      Combo1.Visible = True
      mzbf = 1
      Call yc
      Combo1.Clear
      Adodc2.Refresh
      While Adodc2.Recordset.EOF = False
         Combo1.AddItem Adodc2.Recordset.Fields(1)
         Adodc2.Recordset.MoveNext
      Wend
      Combo1.SetFocus
   End If
   Exit Sub
er:
   MsgBox "查询过程中出现操作员数据加载错误或其他未知错误！"
End Sub

Private Sub Option3_Click()
   On Error GoTo er
   If Option3.Value = True Then
      Combo1.Top = Option3.Top + Option3.Height + 50
      Combo1.Left = Option3.Left
      Combo1.Visible = True
      Combo1.Clear
      Call yc
      mzbf = 1
      Adodc3.Refresh
      While Adodc3.Recordset.EOF = False
         Combo1.AddItem Adodc3.Recordset.Fields(1)
         Adodc3.Recordset.MoveNext
      Wend
      Combo1.SetFocus
   End If
   Exit Sub
er:
   MsgBox "查询过程中医师数据加载错误或其他未知错误！"
   
End Sub

Private Sub Option4_Click()
On Error GoTo er
   If Option4.Value = True Then
      Combo1.Visible = False
      Call yc
      Data1.RecordSource = "select * from 病房处方 where 收费='未'"
      Data1.Refresh
      mzbf = 2
      zehj = 0
      While Data1.Recordset.EOF = False
         zehj = zehj + Val(Data1.Recordset.Fields("合计"))
         Data1.Recordset.MoveNext
      Wend
      Label3.Caption = zehj & "元"
      Adodc1.RecordSource = Data1.RecordSource
      Adodc1.Refresh
      tchx "病房处方查询"
      Call bfdisp
   End If
   Exit Sub
er:
  MsgBox "查询过程中出现数据访问错误或其他未知错误！"
End Sub

Private Sub Option5_Click()
   If Option5.Value = True Then
      Combo1.Top = Option5.Top + Option5.Height + 50
      Combo1.Left = Option5.Left
      Combo1.Visible = True
      Combo1.Clear
      Call yc
      mzbf = 2
      Adodc2.Refresh
      While Adodc2.Recordset.EOF = False
         Combo1.AddItem Adodc2.Recordset.Fields(1)
         Adodc2.Recordset.MoveNext
      Wend
      Combo1.SetFocus
   End If
End Sub

Private Sub Option6_Click()
On Error GoTo er
If Option6.Value = True Then
      Combo1.Top = Option6.Top + Option6.Height + 50
      Combo1.Left = Option6.Left
      Combo1.Visible = True
      mzbf = 2
      Call yc
      Combo1.Clear
      Adodc3.Refresh
      While Adodc3.Recordset.EOF = False
         Combo1.AddItem Adodc3.Recordset.Fields(1)
         Adodc3.Recordset.MoveNext
      Wend
      Combo1.SetFocus
   End If
   Exit Sub
er:
   MsgBox "查询过程中医师数据加载错误或其他未知错误！"
End Sub

Private Sub Option7_Click()
   If Option7.Value = True Then
      Combo1.Top = Option7.Top + Option7.Height + 50
      Combo1.Left = Option7.Left
      Combo1.Visible = True
      Combo1.Clear
      Call yc
      mzbf = 1
      Adodc1.RecordSource = "科别"
      Adodc1.Refresh
      While Adodc1.Recordset.EOF = False
         Combo1.AddItem Adodc1.Recordset.Fields(1)
         Adodc1.Recordset.MoveNext
      Wend
      Combo1.SetFocus
   End If
End Sub

Private Sub Option8_Click()
   If Option8.Value = True Then
      Combo1.Top = Option8.Top + Option8.Height + 50
      Combo1.Left = Option8.Left
      Combo1.Visible = True
      Combo1.Clear
      Call yc
      mzbf = 2
      Adodc1.RecordSource = "科别"
      Adodc1.Refresh
      While Adodc1.Recordset.EOF = False
         Combo1.AddItem Adodc1.Recordset.Fields(1)
         Adodc1.Recordset.MoveNext
      Wend
      Combo1.SetFocus
   End If
End Sub
Sub yc()
   Text1.Visible = False
   Text2.Visible = False
   Label4.Visible = False
End Sub
Sub xs()
   If Option9.Value = True Then
      Text1.Left = 9765
      Text2.Left = 11160
      Label4.Left = 10920
   End If
   If Option10.Value = True Then
      Text1.Left = 10965
      Text2.Left = 12360
      Label4.Left = 12120
   End If
   Text1.Visible = True
   Text2.Visible = True
   Label4.Visible = True
End Sub
Private Sub Option9_Click()
   Call xs
   mzbf = 1
   Text1.SetFocus
   Combo1.Visible = Fals
End Sub

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

Private Sub Text2_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
     If Text1.Text = "" Or Text2.Text = "" Or Len(Text1.Text) < 8 Or Len(Text2.Text) < 8 Then
        MsgBox "日期输入不正确，请输入正确格式的日期！", vbOKOnly + 16
        Exit Sub
     End If
     If Option9.Value = True Then
        Data1.RecordSource = "select * from 门诊处方 where 日期>=" + "'" + Trim(Text1.Text) + "'" & " and 日期<=" + "'" + Trim(Text2.Text) + "'" & " and 收费='未'"
        Data1.Refresh
        zehj = 0
        While Data1.Recordset.EOF = False
           zehj = zehj + Val(Data1.Recordset.Fields("合计"))
           Data1.Recordset.MoveNext
        Wend
        Adodc1.RecordSource = Data1.RecordSource
        Adodc1.Refresh
        Call disp8
        tchx "门诊处方查询"
        Option9.Value = False
        Call yc
     End If
     If Option10.Value = True Then  '按病房划价日期
        Data1.RecordSource = "select * from 病房处方 where 日期>=" + "'" + Trim(Text1.Text) + "'" & " and 日期<=" + "'" + Trim(Text2.Text) + "'" & " and 收费='未'"
        Data1.Refresh
        zehj = 0
        While Data1.Recordset.EOF = False
           zehj = zehj + Val(Data1.Recordset.Fields("合计"))
           Data1.Recordset.MoveNext
        Wend
        Adodc1.RecordSource = Data1.RecordSource
        Adodc1.Refresh
        Call bfdisp
        tchx "病房处方查询"
        Option10.Value = False
        Call yc
     End If
  End If
End Sub

Sub tchx(tbl)
    If tbl = "病房处方查询" Then zdgs = 113
    If tbl = "门诊处方查询" Then zdgs = 107
    Data2.DatabaseName = dbstr
    Data2.RecordSource = tbl
    Data2.Refresh
    While Data2.Recordset.EOF = False
      Data2.Recordset.Delete
      Data2.Recordset.MoveNext
    Wend
    Data2.Refresh
    Data1.Refresh
    While Data1.Recordset.EOF = False
       Data2.Recordset.AddNew
       For i = 0 To zdgs
          If IsNull(Data1.Recordset.Fields(i)) = False And Data1.Recordset.Fields(i) <> "" Then
             Data2.Recordset.Fields(i) = Trim(Data1.Recordset.Fields(i))
          Else
             Data2.Recordset.Fields(i) = "Null"
          End If
       Next i
       Data2.Recordset.Update
       Data1.Recordset.MoveNext
    Wend
End Sub