form6.frm

VB+SQL住院管理系统

 Text15.Text = ""
End Sub

Private Sub Command2_Click()
Dim sql1  As String
Dim sql2  As String
Dim str1  As String
Dim str2 As String
Dim str3 As String
Dim str4 As String

Dim mrc As ADODB.Recordset
Dim mrz As ADODB.Recordset
Dim mrs As ADODB.Recordset

 If Text8.Text = Empty Then
        MsgBox "请输入要修改信息的病人的住院号！"
        
ElseIf Text10.Text = Empty And Text7.Text = Empty Then
        MsgBox "请输入修改信息！"
        
       Exit Sub


Else

str4 = "select count(*) from 病人 where 住院号='" & Text8.Text & "'"
Set mrs = con.Execute(str4)
    If mrs.Fields(0).Value > 0 Then


 str3 = "select count(*) from 病床 where 床位号='" & Text10.Text & "'"
 Set mrz = con.Execute(str3)
    If mrz.Fields(0).Value > 0 Then



     str2 = "select   count(*)   from   病人   where   床位号='" & Text10.Text & "'and 出院日期 is null"
     Set mrc = con.Execute(str2)
      If mrc.Fields(0).Value > 0 Then
         MsgBox "此床位已有人！不能使用！"
     
     
       
        ElseIf Text10.Text = Empty Then
         sql2 = "update   病人   set   出院日期='" & Text7.Text & "'   where   住院号='" & Text8.Text & "'"
         If querydata(sql2) = True Then
          MsgBox ("已更新")
         End If
        ElseIf Text7.Text = Empty Then
         sql1 = "update   病人   set   床位号='" & Text10.Text & "'   where   住院号='" & Text8.Text & "'"
         str1 = "update   病床   set   空床标志='否'   where   床位号='" & Text10.Text & "'"
         If querydata(str1) = True Then
          If querydata(sql1) = True Then
           MsgBox ("已更新")
          End If
         End If

        Else
         sql1 = "update   病人   set   床位号='" & Text10.Text & "'   where   住院号='" & Text8.Text & "'"
         sql2 = "update   病人   set   出院日期='" & Text7.Text & "'   where   住院号='" & Text8.Text & "'"
         str1 = "update   病床   set   空床标志='否'   where   床位号='" & Text10.Text & "'"
         If querydata(str1) = True Then
          If querydata(sql1) = True Then
           If querydata(sql2) = True Then
   
   
            MsgBox ("已更新")
           Else
            MsgBox ("未更新")
           End If
          End If
         End If
      End If
      
   Else
    MsgBox ("该病床不存在！")
    Text10.Text = ""
    Text10.SetFocus
  End If
  
  Else
    MsgBox ("该住院号不存在！")
    
  End If
  End If
End Sub

Private Sub Command3_Click()

          Dim txtsql     As String
          Dim mrc     As ADODB.Recordset
          Dim mrz     As ADODB.Recordset
          
          Dim msgtext     As String
          Dim str1  As String
          Dim str2  As String
 
           
        If Text11.Text = "" Then
                  MsgBox "请输入病人床位号！", vbOKOnly + vbExclamation, "警告"
                  Exit Sub
                  Text11.SetFocus
        Else
                  
            str2 = "select   count(*)   from   病床   where   床位号='" & Text11.Text & "'"
            Set mrz = con.Execute(str2)
            If mrz.Fields(0).Value > 0 Then
                  
                  
                    txtsql = "select   count(*)   from   病人   where   床位号='" & Text11.Text & "'and 出院日期 is null"
                    Set mrc = con.Execute(txtsql)
                    If mrc.Fields(0).Value > 0 Then
                          If MsgBox("病人存在，确认要删除该病人吗？", vbYesNo) = vbYes Then
                             
                                  txtsql = "delete   病人   where   床位号='" & Text11.Text & "'and 出院日期 is null"
                                  Set mrc = con.Execute(txtsql)
                                  
                                  str1 = "update   病床   set   空床标志='是'   where   床位号='" & Text11.Text & "'"
                                  If querydata(str1) = True Then
                                  
                                  MsgBox "删除病人成功！", vbOKOnly + vbExclamation, "删除病人"
                                 'Unload Me
                                  End If
                          
                          End If
                     Else
                          MsgBox "病人不存在！"
                          Exit Sub
                    End If
             Else
                 MsgBox "病床不存在！"
             End If
        
        End If
   
End Sub

Private Sub Command4_Click()
Unload Me
End Sub



Private Sub DataCombo1_Click(Area As Integer)

End Sub

Private Sub Command5_Click()
Dim sql1  As String
Dim sql2  As String
Dim sql3  As String
Dim sql4  As String
Dim sql5  As String
Dim sql6  As String

Dim str1  As String
Dim str2 As String
Dim str3 As String
Dim mrc As ADODB.Recordset
Dim mrs As ADODB.Recordset

 If Text9.Text = Empty Then
        MsgBox "请输入要修改信息的病人的住院号！"
        
 ElseIf Text12.Text = Empty Then
        MsgBox "手术时间不能为空！"
    ElseIf Text13.Text = Empty Then
        MsgBox "手术日期不能为空！"
    ElseIf Text14.Text = Empty Then
        MsgBox "手术费用不能为空！"
    ElseIf Text23.Text = Empty Then
        MsgBox "医生工号不能为空！"
ElseIf Text24.Text = Empty Then
        MsgBox "手术标识号不能为空！"



Else
str2 = "select   count(*)   from   医生   where   医生工号='" & Text23.Text & "'"
    Set mrc = con.Execute(str2)
    If mrc.Fields(0).Value > 0 Then
   
      str3 = "select   count(*)   from   病人_手术   where   住院号='" & Text9.Text & "'"
      Set mrs = con.Execute(str3)
      If mrs.Fields(0).Value > 0 Then
        'MsgBox "此病人不存在！"
        'Text9.Text = ""
       'Text9.SetFocus
        
     
       
        
    
    '  Else
     
       sql1 = "update   病人_手术   set   医生工号='" & Text23.Text & "'   where   住院号='" & Text9.Text & "'"
       sql2 = "update   病人_手术   set   时间='" & Text12.Text & "'   where   住院号='" & Text9.Text & "'"
       sql3 = "update   病人_手术   set   日期='" & Text13.Text & "'   where   住院号='" & Text9.Text & "'"
       sql4 = "update   病人_手术   set   费用='" & Text14.Text & "'   where   住院号='" & Text9.Text & "'"
       sql5 = "update   病人_手术   set   住院号='" & Text9.Text & "'   where   住院号='" & Text9.Text & "'"
       sql6 = "update   病人_手术   set   手术标识号='" & Text24.Text & "'   where   住院号='" & Text9.Text & "'"
       If querydata(sql1) = True Then
       
       If querydata(sql2) = True Then
       If querydata(sql3) = True Then
       If querydata(sql4) = True Then
       If querydata(sql5) = True Then
       If querydata(sql6) = True Then
   
        MsgBox ("已更新")
        
        Text9.Text = ""
              Text12.Text = ""
              Text13.Text = ""
              Text14.Text = ""
              Text23.Text = ""
              Text24.Text = ""
       Else
         MsgBox ("未更新")
       End If
      End If
      End If
      End If
      End If
    End If
 
 
 
 Else
    MsgBox "此病人不存在！"
        Text9.Text = ""
        Text9.SetFocus
    
    
    End If
  Else
  MsgBox "此医生不存在！"
       Text23.Text = ""
       Text23.SetFocus
  End If
  End If
 
End Sub



Private Sub Command6_Click()

End Sub

Private Sub Command8_Click()
Dim str As String
Dim str1 As String
Dim str2 As String
Dim mrc As ADODB.Recordset
    
 If Text18.Text = Empty Then
        MsgBox "住院号不能为空！"
    ElseIf Text19.Text = Empty Then
        MsgBox "项目不能为空！"
    ElseIf Text20.Text = Empty Then
        MsgBox "金额不能为空！"
    ElseIf Text21.Text = Empty Then
        MsgBox "收款员不能为空！"
    ElseIf Text22.Text = Empty Then
        MsgBox "日期不能为空！"
       ' ElseIf Text27.Text = Empty Then
       ' MsgBox "收据编号不能为空！"
        

   Else
    str2 = "select   count(*)   from   病人   where   住院号='" & Text18.Text & "'and 出院日期 is null"
                  Set mrc = con.Execute(str2)
                  If mrc.Fields(0).Value > 0 Then
                          'MsgBox "此床位已有人！不能使用！"
                  
              
   ' Else
          str = "select * from 收据"
         If querydata(str) = True Then
            rct.AddNew
            rct.Fields("住院号").Value = Text18.Text
            rct.Fields("项目").Value = Text19.Text
            rct.Fields("金额").Value = Text20.Text
            rct.Fields("收款员").Value = Text21.Text
            rct.Fields("收据编号").Value = Text18.Text
            rct.Fields("日期").Value = Format(Text22.Text, "yyyy-mm-dd")
          
            rct.Update
           
          MsgBox "添加成功！"
          Text18.Text = ""
          Text19.Text = ""
          Text20.Text = ""
          Text21.Text = ""
          Text22.Text = ""
             
         End If
        Else
          MsgBox "该病人不存在！"
          Text18.Text = ""
          Text18.SetFocus
        End If
        
        End If
End Sub

Private Sub Command9_Click()
Dim str As String
Dim str1 As String
Dim str2 As String
Dim mrc As ADODB.Recordset

Dim str3 As String
Dim mrs As ADODB.Recordset

    
 If Text9.Text = Empty Then
        MsgBox "住院号不能为空！"
    ElseIf Text12.Text = Empty Then
        MsgBox "手术时间不能为空！"
    ElseIf Text13.Text = Empty Then
        MsgBox "手术日期不能为空！"
    ElseIf Text14.Text = Empty Then
        MsgBox "手术费用不能为空！"
    ElseIf Text23.Text = Empty Then
        MsgBox "医生工号不能为空！"
        ElseIf Text24.Text = Empty Then
        MsgBox "手术标识号不能为空！"
        

   Else
   
   str3 = "select   count(*)   from   医生   where   医生工号='" & Text23.Text & "'"
    Set mrs = con.Execute(str3)
    If mrs.Fields(0).Value > 0 Then
   
   
   
   
    str2 = "select   count(*)   from   病人   where   住院号='" & Text9.Text & "'and 出院日期 is null"
    Set mrc = con.Execute(str2)
    If mrc.Fields(0).Value < 0 Then
       MsgBox "此病人不存在！"
       Text9.Text = ""
       Text9.SetFocus
        
                  
              
    Else
          str = "select * from 病人_手术"
         If querydata(str) = True Then
            rct.AddNew
            rct.Fields("住院号").Value = Text9.Text
            rct.Fields("手术标识号").Value = Text24.Text
            rct.Fields("时间").Value = Text12.Text
           ' rct.Fields("日期").Value = Text13.Text
            rct.Fields("费用").Value = Text14.Text
            rct.Fields("医生工号").Value = Text23.Text
            rct.Fields("日期").Value = Format(Text13.Text, "yyyy-mm-dd")
          
            rct.Update
            
             
              MsgBox ("添加成功！")
              Text9.Text = ""
              Text12.Text = ""
              Text13.Text = ""
              Text14.Text = ""
              Text23.Text = ""
              Text24.Text = ""
             
        
        Else
        MsgBox "此病人不存在！"
       Text9.Text = ""
       Text9.SetFocus
        End If
        End If
        Else
        MsgBox "此医生不存在！"
       Text23.Text = ""
       Text23.SetFocus
     
        
    End If
        
End If
End Sub