form6.frm

VB+SQL住院管理系统

      Caption         =   "删除病人基本信息"
      Height          =   1935
      Left            =   240
      TabIndex        =   12
      Top             =   5520
      Width           =   2895
      Begin VB.TextBox Text11 
         Height          =   375
         Left            =   1200
         TabIndex        =   25
         Top             =   480
         Width           =   1215
      End
      Begin VB.CommandButton Command3 
         Caption         =   "删除"
         Height          =   495
         Left            =   720
         TabIndex        =   13
         Top             =   1200
         Width           =   1215
      End
      Begin VB.Label Label11 
         Caption         =   "病床号:"
         Height          =   375
         Left            =   240
         TabIndex        =   24
         Top             =   600
         Width           =   735
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "新增病人基本信息"
      Height          =   5175
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   2895
      Begin VB.ComboBox Text3 
         Height          =   300
         ItemData        =   "Form6.frx":0047
         Left            =   1080
         List            =   "Form6.frx":0051
         TabIndex        =   26
         Top             =   1560
         Width           =   1575
      End
      Begin VB.CommandButton Command1 
         Caption         =   "新增"
         Height          =   495
         Left            =   840
         TabIndex        =   14
         Top             =   4440
         Width           =   1215
      End
      Begin VB.TextBox Text6 
         Height          =   375
         Left            =   1200
         TabIndex        =   10
         Top             =   3480
         Width           =   1455
      End
      Begin VB.TextBox Text5 
         Height          =   375
         Left            =   1080
         TabIndex        =   8
         Top             =   2880
         Width           =   1575
      End
      Begin VB.TextBox Text4 
         Height          =   375
         Left            =   1320
         TabIndex        =   7
         Top             =   2280
         Width           =   1335
      End
      Begin VB.TextBox Text2 
         Height          =   375
         Left            =   1080
         TabIndex        =   4
         Top             =   960
         Width           =   1575
      End
      Begin VB.TextBox Text1 
         Height          =   390
         Left            =   1080
         TabIndex        =   2
         Top             =   360
         Width           =   1575
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "入院日期:"
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   3600
         Width           =   810
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "床位号:"
         Height          =   180
         Left            =   240
         TabIndex        =   9
         Top             =   3000
         Width           =   630
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "主治医生工号:"
         Height          =   180
         Left            =   120
         TabIndex        =   6
         Top             =   2400
         Width           =   1170
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "性别:"
         Height          =   180
         Left            =   360
         TabIndex        =   5
         Top             =   1680
         Width           =   450
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "姓名:"
         Height          =   180
         Left            =   360
         TabIndex        =   3
         Top             =   1080
         Width           =   450
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "住院号:"
         Height          =   180
         Left            =   240
         TabIndex        =   1
         Top             =   480
         Width           =   630
      End
   End
End
Attribute VB_Name = "Form6"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim str As String
Dim str1 As String
Dim str2 As String
Dim str3 As String
Dim str4 As String


Dim mrc As ADODB.Recordset
Dim mrs As ADODB.Recordset
Dim mrz As ADODB.Recordset
    
 If Text1.Text = Empty Then
        MsgBox "住院号不能为空"
    ElseIf Text2.Text = Empty Then
        MsgBox "病人姓名不能为空"
    ElseIf Text3.Text = Empty Then
        MsgBox "病人性别不能为空"
    ElseIf Text5.Text = Empty Then
        MsgBox "床位不能为空"
    ElseIf Text6.Text = Empty Then
        MsgBox "入院日期不能为空"
        

   Else
   
   
    str4 = "select   count(*)   from   医生   where   医生工号='" & Text4.Text & "'"
    Set mrz = con.Execute(str4)
    If mrz.Fields(0).Value > 0 Then
   
   
   
      str3 = "select   count(*)   from   病床   where   床位号='" & Text5.Text & "'"
      Set mrs = con.Execute(str3)
      If mrs.Fields(0).Value > 0 Then
      
       
        str2 = "select   count(*)   from   病人   where   床位号='" & Text5.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 = Text1.Text
            rct.Fields("姓名").Value = Text2.Text
            rct.Fields("性别").Value = Text3.Text
            rct.Fields("床位号").Value = Text5.Text
            rct.Fields("主治医生工号").Value = Text4.Text
            rct.Fields("入院日期").Value = Format(Text6.Text, "yyyy-mm-dd")
          
            rct.Update
            
            str1 = "update   病床   set   空床标志='否'   where   床位号='" & Text5.Text & "'"
             If querydata(str1) = True Then
              MsgBox ("添加成功！")
             End If
         End If
        End If
      Else
        MsgBox "该病床不存在！"
        Text5.Text = ""
        Text5.SetFocus
      End If
   Else
    MsgBox "该医生不存在！"
        Text4.Text = ""
        Text4.SetFocus
End If

End If
     
End Sub

Private Sub Command10_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 Text15.Text = Empty Then
        MsgBox "住院号不能为空！"
   ' ElseIf Text25.Text = Empty Then
   '     MsgBox "诊断书编号不能为空！"
    ElseIf Text16.Text = Empty Then
        MsgBox "科别不能为空！"
        ElseIf Text26.Text = Empty Then
        MsgBox "医生工号不能为空！"
    'ElseIf Text25.Text = Empty Then
     '   MsgBox "诊断不能为空！"
    

   Else
   
   str3 = "select   count(*)   from   医生   where   医生工号='" & Text26.Text & "'"
    Set mrs = con.Execute(str3)
    If mrs.Fields(0).Value > 0 Then
   
   
   
   
    str2 = "select   count(*)   from   病人   where   住院号='" & Text15.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 = Text15.Text
            rct.Fields("诊断书编号").Value = Text15.Text
           ' rct.Fields("时间").Value = Text12.Text
            
            rct.Fields("科别").Value = Text16.Text
            rct.Fields("医生工号").Value = Text26.Text
            rct.Fields("诊断").Value = Text17.Text
            rct.Update
            
             
              MsgBox ("添加成功！")
              Text15.Text = ""
              
              Text16.Text = ""
              Text26.Text = ""
              Text27.Text = ""
             ' Text24.Text = ""
             End If
          Else
          MsgBox "此病人不存在！"
          Text9.Text = ""
          Text9.SetFocus
        
          
          
        
        End If
        Else
        MsgBox "此医生不存在！"
       Text23.Text = ""
       Text23.SetFocus
     
        
    End If
        
End If
End Sub

Private Sub Command11_Click()
 
          Dim txtsql     As String
          Dim mrc     As ADODB.Recordset
          Dim msgtext     As String
            
        If Text9.Text = "" Then
                  MsgBox "请输入住院号！", vbOKOnly + vbExclamation, "警告"
                  Exit Sub
                  Text9.SetFocus
          Else
                  txtsql = "select   count(*)   from   病人_手术   where   住院号='" & Text9.Text & "'"
                  Set mrc = con.Execute(txtsql)
                  If mrc.Fields(0).Value > 0 Then
                          If MsgBox("信息存在，确认要删除吗？", vbYesNo) = vbYes Then
                                  txtsql = "delete   病人_手术   where   住院号='" & Text9.Text & "'"
                                  Set mrc = con.Execute(txtsql)
                                  MsgBox "删除用户成功！", vbOKOnly + vbExclamation, "删除用户"
                                   
                          End If
                  Else
                          MsgBox "信息不存在"
                          Exit Sub
                  End If
          End If
 Text9.Text = ""

End Sub

Private Sub Command12_Click()

          Dim txtsql     As String
          Dim mrc     As ADODB.Recordset
          Dim msgtext     As String
            
        If Text18.Text = "" Then
                  MsgBox "请输入住院号！", vbOKOnly + vbExclamation, "警告"
                  Exit Sub
                  Text18.SetFocus
          Else
                  txtsql = "select   count(*)   from   收据   where   住院号='" & Text18.Text & "'"
                  Set mrc = con.Execute(txtsql)
                  If mrc.Fields(0).Value > 0 Then
                          If MsgBox("信息存在，确认要删除吗？", vbYesNo) = vbYes Then
                                  txtsql = "delete   收据   where   住院号='" & Text18.Text & "'"
                                  Set mrc = con.Execute(txtsql)
                                  MsgBox "删除用户成功！", vbOKOnly + vbExclamation, "删除用户"
                                   
                          End If
                  Else
                          MsgBox "信息不存在"
                          Exit Sub
                  End If
          End If
 Text18.Text = ""
End Sub

Private Sub Command13_Click()

          Dim txtsql     As String
          Dim mrc     As ADODB.Recordset
          Dim msgtext     As String
            
        If Text15.Text = "" Then
                  MsgBox "请输入住院号！", vbOKOnly + vbExclamation, "警告"
                  Exit Sub
                  Text15.SetFocus
          Else
                  txtsql = "select   count(*)   from   诊断书   where   住院号='" & Text15.Text & "'"
                  Set mrc = con.Execute(txtsql)
                  If mrc.Fields(0).Value > 0 Then
                          If MsgBox("信息存在，确认要删除吗？", vbYesNo) = vbYes Then
                                  txtsql = "delete   诊断书   where   住院号='" & Text15.Text & "'"
                                  Set mrc = con.Execute(txtsql)
                                  MsgBox "删除用户成功！", vbOKOnly + vbExclamation, "删除用户"
                                   
                          End If
                  Else
                          MsgBox "信息不存在"
                          Exit Sub
                  End If
          End If