frmadmissiondetails.frm

This file came from Planet-Source-Code.com...the home millions of lines of source code You can view

         Strikethrough   =   0   'False
      EndProperty
      Format          =   20709378
      CurrentDate     =   38327
   End
   Begin MSComCtl2.DTPicker DTPDate 
      Height          =   285
      Left            =   2280
      TabIndex        =   21
      Top             =   2640
      Visible         =   0   'False
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   503
      _Version        =   393216
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Format          =   20709377
      CurrentDate     =   38327
   End
   Begin VB.TextBox txtFields 
      DataField       =   "Admission_Date"
      Height          =   285
      Index           =   3
      Left            =   2280
      TabIndex        =   7
      Top             =   2700
      Width           =   2655
   End
   Begin ActiveResizeCtl.ActiveResize ActiveResize1 
      Left            =   120
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      Resolution      =   4
      ScreenHeight    =   1024
      ScreenWidth     =   1280
      ScreenHeightDT  =   1024
      ScreenWidthDT   =   1280
      FormHeightDT    =   11070
      FormWidthDT     =   11595
      FormScaleHeightDT=   10560
      FormScaleWidthDT=   11475
      ResizeFormBackground=   -1  'True
      ResizePictureBoxContents=   -1  'True
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      BackColor       =   &H00FF8080&
      Caption         =   "ADMISSION DETAILS"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   435
      Index           =   9
      Left            =   3960
      TabIndex        =   51
      Top             =   360
      Width           =   4290
   End
   Begin VB.Shape Shape4 
      BorderColor     =   &H00FFFFFF&
      Height          =   2415
      Left            =   120
      Shape           =   4  'Rounded Rectangle
      Top             =   4200
      Width           =   11175
   End
   Begin VB.Label lblStatus 
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Height          =   285
      Left            =   4170
      TabIndex        =   48
      Top             =   7200
      Width           =   3360
   End
   Begin VB.Shape Shape3 
      BorderColor     =   &H00FFFFFF&
      Height          =   2175
      Left            =   2520
      Shape           =   4  'Rounded Rectangle
      Top             =   8040
      Width           =   6855
   End
   Begin VB.Shape Shape2 
      BorderColor     =   &H00FFFFFF&
      Height          =   975
      Left            =   2160
      Shape           =   4  'Rounded Rectangle
      Top             =   6960
      Width           =   7455
   End
   Begin VB.Label lblBedStat 
      BackColor       =   &H00FF8080&
      Caption         =   "Bed Availability"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   5880
      TabIndex        =   36
      Top             =   5280
      Visible         =   0   'False
      Width           =   1815
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00FFFFFF&
      Height          =   2415
      Left            =   120
      Shape           =   4  'Rounded Rectangle
      Top             =   1680
      Width           =   11175
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Bed ID:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   8
      Left            =   5880
      TabIndex        =   16
      Top             =   4800
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Room/Ward ID:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   7
      Left            =   360
      TabIndex        =   14
      Top             =   4920
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Reffered Doctor:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   6
      Left            =   5760
      TabIndex        =   12
      Top             =   3240
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Emergency:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   5
      Left            =   360
      TabIndex        =   10
      Top             =   3240
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Admission Time:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   4
      Left            =   5760
      TabIndex        =   8
      Top             =   2640
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Admission Date:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   3
      Left            =   360
      TabIndex        =   6
      Top             =   2640
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Guardian ID:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   2
      Left            =   5760
      TabIndex        =   4
      Top             =   2040
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Patient ID:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   1
      Left            =   360
      TabIndex        =   2
      Top             =   2040
      Width           =   1815
   End
   Begin VB.Label lblLabels 
      BackColor       =   &H00FF8080&
      Caption         =   "Admission ID:"
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   0
      Top             =   1200
      Width           =   1815
   End
End
Attribute VB_Name = "frmAdmissionDetails"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim BMngID As String
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean


Private Function ChkBedAvailability(bed As String) As Boolean


Dim rsBedAvail As Recordset
Set rsBedAvail = New ADODB.Recordset

rsBedAvail.Open "select * from Bed_Details where Bed_ID = '" & cmbBedID.Text & "'", cnPatients, adOpenDynamic, adLockPessimistic

If rsBedAvail.EOF = True Then
    Debug.Print "The Selected Bed is Available"
    ChkBedAvailability = True
ElseIf rsBedAvail![available] = False Then
    ChkBedAvailability = False
ElseIf rsBedAvail![available] = True Then
    ChkBedAvailability = True
End If

rsBedAvail.Close




End Function



Private Sub cmbBedID_Click()

Dim result As Boolean
result = ChkBedAvailability(cmbBedID.Text)
If result = True Then
    txtBedAvail = "Available"
ElseIf result = False Then
    txtBedAvail = "Not Available"
End If

Debug.Print "Bed Availability = " & result
End Sub

Private Sub cmbRoomID_Click()

Dim rsBedID As Recordset
Dim rsRoomID As Recordset

Set rsRoomID = New ADODB.Recordset
Set rsBedID = New ADODB.Recordset

rsRoomID.Open " select Room_ID from Room_Details where Room_Type = '" & cmbRoomID.Text & "'", cnPatients, adOpenDynamic, adLockPessimistic
cmbBedID.clear
While rsRoomID.EOF = False
    rsBedID.Open "Select Bed_ID from Bed_Details where Room_Ward_ID= '" & rsRoomID(0) & "'", cnPatients, adOpenDynamic, adLockPessimistic
    
    Debug.Print rsBedID.RecordCount
    
    While rsBedID.EOF = False
        cmbBedID.AddItem (rsBedID(0))
        cmbBedID.Text = rsBedID(0)
        rsBedID.MoveNext
     Wend

    
    If rsBedID.EOF = False Then
        cmbBedID.AddItem (rsBedID(0))
        cmbBedID.Text = rsBedID(0)
    End If
    
    
    rsBedID.Close
    
    rsRoomID.MoveNext
Wend

rsRoomID.Close
cmbBedID_Click
cmbBedID.Enabled = True

End Sub




Private Sub cmbWardID_Click()


Dim rsBedID As Recordset
Dim rsWardID As Recordset

Set rsWardID = New ADODB.Recordset
Set rsBedID = New ADODB.Recordset

rsWardID.Open " select Ward_ID from Ward_Details where Ward_Name = '" & cmbWardID.Text & "'", cnPatients, adOpenDynamic, adLockPessimistic
cmbBedID.clear
While rsWardID.EOF = False
    rsBedID.Open "Select Bed_ID from Bed_Details where Room_Ward_ID= '" & rsWardID(0) & "'", cnPatients, adOpenDynamic, adLockPessimistic
    Debug.Print rsBedID.RecordCount
    
   If rsBedID.EOF = True Then
    txtBedAvail = "Not Available"
    Exit Sub
   End If
    
     While rsBedID.EOF = False
        cmbBedID.AddItem (rsBedID(0))
        cmbBedID.Text = rsBedID(0)
        rsBedID.MoveNext
     Wend
    
    
    
    rsBedID.Close
    
    rsWardID.MoveNext
Wend

rsWardID.Close
cmbBedID_Click
cmbBedID.Enabled = True

End Sub

Private Sub cmdBedDetails_Click()
frmBedDetails.Show
End Sub

Private Sub cmdCheckBed_Click()
frmBEDDisplay.Show
End Sub



Private Sub cmdInGuardianID_Click()
frmDisplayGuardian.Show
End Sub

Private Sub cmdInPatientID_Click()
frmDisplayInPatient.Show
End Sub

Private Sub cmdRefDoc_Click()
frmDoctorDetails.Show
End Sub

Private Sub cmdView_Click()
frmDisplayAdmissionDetails.Show

End Sub

Private Sub cmdViewRoom_Click()
frmRoomDetails.Show
End Sub

Private Sub cmdViewWard_Click()
frmWardDetails.Show
End Sub

Private Sub Command1_Click()

End Sub

Private Sub Form_Activate()
Call Functions.DisableMenu
End Sub



Private Sub Form_Load()

     Me.WindowState = vbMaximized


   Call Functions.DisableMenu
   Set adoPrimaryRS = New Recordset
   adoPrimaryRS.Open "select Admission_ID,Patient_ID,Guardian_ID,Admission_Date,Admission_Time,Emergency,Ref_Doctor,Room_Ward_ID,Bed_ID from Admission_Details", cnPatients, adOpenDynamic, adLockOptimistic

    DTPDate = Date
    DTPTime = Time
 
  
    
    Dim rsPID As Recordset
    Set rsPID = New ADODB.Recordset
    rsPID.Open "select * from In_Patient_Details", cnPatients, adOpenStatic, adLockPessimistic
    While rsPID.EOF = False
        cmbPatientID.AddItem rsPID(0)
        rsPID.MoveNext
    Wend
   
    rsPID.MoveLast
    cmbPatientID.Text = rsPID(0)
    rsPID.Close
    
    Dim rsGID As Recordset
    Set rsGID = New ADODB.Recordset
    rsGID.Open "select * from Guardian_Details", cnPatients, adOpenStatic, adLockPessimistic
    While rsGID.EOF = False
        cmbGuardianID.AddItem rsGID(0)
        rsGID.MoveNext
    Wend
   
    rsGID.MoveLast
    cmbGuardianID.Text = rsGID(0)
    rsGID.Close
    
    Dim rsDID As Recordset
    Set rsDID = New ADODB.Recordset
    rsDID.Open "select * from Doctor_Details", cnPatients, adOpenStatic, adLockPessimistic
    While rsDID.EOF = False
        cmbDoctorID.AddItem rsDID(0)
        rsDID.MoveNext
    Wend
   
    rsDID.MoveLast
    cmbDoctorID.Text = rsDID(0)
    rsDID.Close
    
    
    Option1_Click (1)
    Option1_Click (0)
    cmbRoomID_Click
    

    

  
  Dim oText As TextBox
  'Bind the text boxes to the data provider
  For Each oText In Me.txtFields