frmadddoctorappointments.frm

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

                Exit Sub
            End If

            
            rsPrevApp.Open "select * from Doctor_Appointment where Doctor_ID='" & StrDoctorID & "' and  Appointment_Date=#" & DTPDate1.Value & "# and Appointment_Time >= #" & strInTime & "# and  Appointment_time <= #" & strOutTime & "#", cnPatients, adOpenKeyset, adLockPessimistic
            NoOfSchedules = rsPrevApp.RecordCount
            
            While rsPrevApp.EOF = False
                Debug.Print "Current Appointments at :" & rsPrevApp![Appointment_Time]
                lastAppTime = Format(rsPrevApp![Appointment_Time], "short time")
                rsPrevApp.MoveNext
            Wend
            

            
            If NoOfSchedules > 0 Then
            If lastAppTime >= Format(DTPTime1.Value, "short time") Then
                MsgBox "Appointment Time should be greater than previous appointment"
                rsAddBill.Close
                rsAddAppointment.Close
                rsInfo.Close
                rsPrevApp.Close
                rsSched.Close
                Exit Sub
            End If
            End If
            
            
            If NoOfSchedules >= (newTime / 15) Then      '15 mins per patient
                MsgBox "No Space Available For This Appointment", vbInformation, "Doctor Appointments"
                rsAddBill.Close
                rsAddAppointment.Close
                rsInfo.Close
                rsPrevApp.Close
                rsSched.Close
                Exit Sub
            End If
            
            
                 
            ' Add data to the database if no errors occured
      
           
            If MsgBox("Are you sure you want to add this record to the database?", vbYesNo, "Add Doctor Appoinment") = vbYes Then
                cnPatients.Execute ("Insert into Doctor_Appointment values('" & PID & "','" & cmbPatientID & "','" & StrDoctorID & "','" & DTPDate1.Value & "','" & strTime & "')")
                cnPatients.Execute ("Insert into Appointment_Bill values('" & BID & "','" & PID & "','" & cmbPatientID & "','" & Format(Date, "mm/dd/yy") & "'," & strAmount & "," & HospitalCharge & "," & GrandTotal & "," & Discount & "," & Val(NetValue) & ")")
            
            'cnPatients.CommitTrans
            rsAddBill.Close
            rsAddAppointment.Close
            rsInfo.Close
            rsPrevApp.Close
            rsSched.Close
            
            Unload Me
            frmAppoinmnetCharges.Show
            
            Else
            Exit Sub
            End If
            
      
    Else
        'when database connection error occurs
        MsgBox "Database Connection Error", vbCritical, "SD Hospitals PVT LTD"
    End If
    Exit Sub
AddErr:
MsgBox Err.Description
End Sub

Private Sub cmdCancel_Click()
fra.Visible = False
frameAppointment.Enabled = True
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDocIDSel_Click()

Dim rsDocPat As Recordset
Set rsDocPat = New ADODB.Recordset

ch = 1

rsDocPat.Open "select * from Doctor_Details where Doctor_ID like '" & UCase(Trim(cmbDoctorID.Text)) & "%'", cnPatients, adOpenDynamic, adLockPessimistic
If rsDocPat.RecordCount > 0 Then
dupid = fdata.TextMatrix(fdata.Row, 0)
cmbDoctorID.Text = dupid
'cmbDoctorID.SetFocus

Else
MsgBox "Select the Appropiate Data from the [[GridBox]]", vbInformation + vbOKOnly, "Error"

End If

rsDocPat.Close
dupid = 0
ch = 0
fra.Visible = False
frameAppointment.Enabled = True





End Sub

Private Sub cmdPatientID_Click()
frmSelPatientID.Show
End Sub

Private Sub cmdDocSched_Click()

Dim rsSched As Recordset
Set rsSched = New ADODB.Recordset


rsSched.Open "Select * from Doctor_Schedule_Details where Doctor_ID='" & cmbDoctorID & "'", cnPatients, adOpenKeyset, adLockPessimistic
            
            ' Retreive Doctor Available days from the table
If rsSched.EOF = False Then
        

    
    rsSched.MoveFirst
    
    MSFlexGrid1.clear
    
    With MSFlexGrid1
        .clear
        .Rows = 1
        .Cols = rsSched.Fields.Count
   
  

        While Not rsSched.EOF
            .Rows = .Rows + 1
         .Row = .Rows - 1


        .TextMatrix(.Row, 0) = rsSched(1)
        .TextMatrix(.Row, 1) = rsSched(4)
        .TextMatrix(.Row, 2) = rsSched(2)
        .TextMatrix(.Row, 3) = rsSched(3)
        .TextMatrix(.Row, 4) = rsSched(0)
        .TextMatrix(.Row, 5) = rsSched(5)
            
            
            
            
            rsSched.MoveNext
        Wend
    
    
        .TextMatrix(0, 0) = "Doctor ID"
        .TextMatrix(0, 1) = "Available Date"
        .TextMatrix(0, 2) = "Time In"
        .TextMatrix(0, 3) = "Time Out"
        .TextMatrix(0, 4) = "Schedule ID"
        .TextMatrix(0, 5) = "Notes"
   
        .FixedRows = 1
        .RowHeight(0) = .RowHeight(1) * 1.5
        'Functions.SizeColumns MSFlexGrid1, Me
        Functions.SizeColumnHeaders MSFlexGrid1, Me
    End With
    
 Else
 Debug.Print "No Records Found"
 End If
    
End Sub

Private Sub cmdPatSel_Click()
Dim rsDocPat As Recordset
Set rsDocPat = New ADODB.Recordset

ch = 1

rsDocPat.Open "select * from Patient_Details where Patient_ID like '" & UCase(Trim(cmbPatientID.Text)) & "%'", cnPatients, adOpenDynamic, adLockPessimistic
If rsDocPat.RecordCount > 0 Then
dupid = fdata.TextMatrix(fdata.Row, 0)
cmbPatientID.Text = dupid
frameAppointment.Enabled = True
cmbDoctorID.SetFocus

Else
MsgBox "Select the Appropiate Data from the [[GridBox]]", vbInformation + vbOKOnly, "Error"

End If

rsDocPat.Close
dupid = 0
ch = 0
fra.Visible = False
frameAppointment.Enabled = True

End Sub


Private Sub fdata_Click()

dupid = fdata.TextMatrix(fdata.Row, 0)

End Sub

Private Sub fdata_KeyPress(KeyAscii As Integer)

Dim rsDocPat As Recordset
Set rsDocPat = New ADODB.Recordset

If KeyAscii = 13 Then
    If flex = 20 Then
          dupid = fdata.TextMatrix(fdata.Row, 0)
        dupid1 = fdata.TextMatrix(fdata.Row, 0)
        customer_code = fdata.TextMatrix(fdata.Row, 0)
        ch = 1

        rsDocPat.Open "select * from Doctor_Details where Doctor_ID like '" & cmbDoctorID.Text & "%'", cnPatients, adOpenDynamic, adLockPessimistic
        If rsDocPat.RecordCount > 0 Then
            dupid = fdata.TextMatrix(fdata.Row, 0)
            cmbDoctorID.Text = dupid
           
            
        Else
            MsgBox "Select the Appropiate Data from the [[GridBox]]", vbInformation + vbOKOnly, "Error"
        End If
            rsDocPat.Close
            dupid = 0
            ch = 0
            fra.Visible = False
            frameAppointment.Enabled = True
    ElseIf flex = 10 Then
        dupid = fdata.TextMatrix(fdata.Row, 0)
        dupid1 = fdata.TextMatrix(fdata.Row, 0)
        customer_code = fdata.TextMatrix(fdata.Row, 0)
        ch = 1

        rsDocPat.Open "select * from Patient_Details where Patient_ID like '" & cmbPatientID.Text & "%'", cnPatients, adOpenDynamic, adLockPessimistic
        If rsDocPat.RecordCount > 0 Then
            dupid = fdata.TextMatrix(fdata.Row, 0)
            cmbPatientID.Text = dupid
            Debug.Print dupid
            frameAppointment.Enabled = True
            cmbDoctorID.SetFocus
           
        Else
            MsgBox "Select the Appropiate Data from the [[GridBox]]", vbInformation + vbOKOnly, "Error"
        End If
            rsDocPat.Close
            dupid = 0
            ch = 0
            fra.Visible = False
            frameAppointment.Enabled = True
    End If
    
ElseIf KeyAscii = 27 Then
    If flex = 20 Then
        fra.Visible = False
        cmbDoctorID.SetFocus
        frameAppointment.Enabled = True
    Else
        fra.Visible = False
        cmbPatientID.SetFocus
        frameAppointment.Enabled = True
    End If
End If





















End Sub

Private Sub Form_Activate()
Call Functions.DisableMenu
End Sub

Private Sub Form_Load()

Call Functions.DisableMenu

Dim SQL1 As String
Dim rsDoctors As Recordset
Dim rsPID As Recordset

Set rsDoctors = New ADODB.Recordset
Set rsPID = New ADODB.Recordset

COUNT1 = 0
rs = 1
del_i = 0
rgrid = 0
ch = 0
ch1 = 0


If cnPatients.State = adStateOpen Then
    'create sql statements
    SQL1 = "SELECT * FROM Doctor_Details"
    
    rsDoctors.Open SQL1, cnPatients, adOpenStatic, adLockPessimistic
       
    
    ' Add ID's to Combo Box
    While rsDoctors.EOF = False
        cmbDoctorID.AddItem rsDoctors(0)
        rsDoctors.MoveNext
    Wend
   
   
    
    rsPID.Open "select * from Patient_Details", cnPatients, adOpenStatic, adLockPessimistic
    
    While rsPID.EOF = False
        cmbPatientID.AddItem rsPID(0)
        rsPID.MoveNext
    Wend
  

   
   
    rsDoctors.Close
    rsPID.Close
    
    
    DTPDate1.Value = Date
    DTPTime1.Value = Time
    Calendar1.Value = Date
    
    MSFlexGrid1.ColWidth(0) = 1500
    MSFlexGrid1.ColWidth(1) = 3500
    MSFlexGrid1.ColWidth(2) = 2000
    MSFlexGrid1.ColWidth(3) = 2000
    MSFlexGrid1.ColWidth(4) = 2000
    MSFlexGrid1.ColWidth(5) = 2000
    
    fdata.RowHeight(0) = fdata.RowHeight(1) * 1.5
    


Else
    'when database connection error occurs
    MsgBox "Database Connection Error", vbCritical, "SD Hospitals PVT LTD"
End

End If

End Sub



Private Sub Command2_Click()
frmDoctorDetails.Show
End Sub




Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Functions.EnableMenu
End Sub