frmaddserappointments.frm

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

            fl = 1

            For i = 0 To UBound(strDIn)
                If InStr(1, arrDays(i), strDate) > 0 Then
                    If strTime >= strDIn(i) And strTime <= strDOut(i) Then
                        strInTime = Format(strDIn(i), "short time")
                        strOutTime = Format(strDOut(i), "short time")
                        newTime = DateDiff("s", strDIn(i), strDOut(i)) / 60
                        newTime2 = newTime / 60
                        
                        Debug.Print "Total Time in Minutes : " & newTime & " Minutes"
                        Debug.Print "Total Time in hours   : " & newTime2 & " Hours"
                        Debug.Print "Possible Appointments : " & newTime / 15
                        Debug.Print "Service Starts        : " & strInTime
                        Debug.Print "Service Ends          : " & strOutTime
                        fl = 0
                        Exit For
                    Else
                        fl = 1
                    End If
                End If
                
            Next i
            
                       
            
            If fl = 0 Then
                Debug.Print "Appointment Possible (Time and Date)"
            Else
                MsgBox "The Appointment Date or Time does not valid", vbInformation, "Out Patient Apointment"
                Exit Sub
            End If

            
            rsPrevApp.Open "select * from Service_Appointment where Hospital_Service_ID='" & StrServiceID & "' 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]
                rsPrevApp.MoveNext
            Wend
            
            If NoOfSchedules > (newTime / 15) Then      '15 mins per patient
                MsgBox "No Space Available For This Appointment"
                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 Service Appoinment") = vbYes Then
                
                cnPatients.Execute ("Insert into Service_Appointment values('" & PID & "','" & cmbPatientID & "','" & StrServiceID & "','" & DTPDate1.Value & "','" & strTime & "')")
                cnPatients.Execute ("Insert into Service_Appointment_Bill values('" & BID & "','" & PID & "','" & cmbPatientID & "','" & Format(Date, "mm/dd/yy") & "'," & strAmount & "," & HospitalCharge & "," & GrandTotal & "," & Discount & "," & Val(NetValue) & ")")
                
       
                
            rsAddBill.Close
            rsAddAppointment.Close
            rsInfo.Close
            rsPrevApp.Close
            rsSched.Close
                

                
                Unload Me
                frmSerAppoinmnetCharges.Show
                
            
            End If
        
        




End Sub

Private Sub cmdCancel_Click()
fra.Visible = False

End Sub

Private Sub cmdDocIDSel_Click()

Dim rsSerPat As Recordset
Set rsSerPat = New ADODB.Recordset

ch = 1

rsSerPat.Open "select * from Services where Channel_Service_ID like '" & UCase(Trim(cmbHospitalServiceID.Text)) & "%'", cnPatients, adOpenDynamic, adLockPessimistic
If rsSerPat.RecordCount > 0 Then
dupid = fdata.TextMatrix(fdata.Row, 0)
cmbHospitalServiceID.Text = dupid

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

End If

rsSerPat.Close
dupid = 0
ch = 0
fra.Visible = False

End Sub



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

ch = 1

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

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

End If

rsSerPat.Close
dupid = 0
ch = 0
fra.Visible = False
End Sub

Private Sub cmdSerSched_Click()



Dim rsSched As Recordset
Set rsSched = New ADODB.Recordset

   

rsSched.Open "Select * from Service_Schedule_Details where Service_ID='" & cmbHospitalServiceID & "'", cnPatients, adOpenKeyset, adLockPessimistic
            
            ' Retreive Doctor Available days from the table
If rsSched.EOF = False Then
        
    MSFlexGrid1.clear
    
    rsSched.MoveFirst
    
  
    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)
            
            
            
            
            rsSched.MoveNext
        Wend
    
    
        .TextMatrix(0, 0) = "Service 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
        
        .ColWidth(0) = 1500
        .ColWidth(1) = 2500
        .ColWidth(2) = 2500
        .ColWidth(3) = 2500
        .ColWidth(4) = 2500
        .ColWidth(5) = 2500
        
        'Functions.SizeColumns MSFlexGrid1, Me
        'Functions.SizeColumnHeaders MSFlexGrid1, Me
    End With
    
 Else
 Debug.Print "No Records Found"
 End If









End Sub

Private Sub Command1_Click()
frmService.Show
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub fdata_Click()
dupid = fdata.TextMatrix(fdata.Row, 0)
End Sub

Private Sub fdata_KeyPress(KeyAscii As Integer)

Dim rsSerPat As Recordset
Set rsSerPat = 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

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

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









End Sub

Private Sub Form_Load()


    Me.WindowState = vbMaximized



Call Functions.DisableMenu

Dim SQL2 As String
Dim rsServices As Recordset
Dim rsPID As Recordset

Set rsServices = New ADODB.Recordset
Set rsPID = New ADODB.Recordset


If cnPatients.State = adStateOpen Then

SQL2 = "SELECT * FROM Services"

rsServices.Open SQL2, cnPatients, adOpenStatic, adLockPessimistic

    While rsServices.EOF = False
        cmbHospitalServiceID.AddItem rsServices(0)
        rsServices.MoveNext
    Wend
    
    rsServices.MoveFirst
    cmbHospitalServiceID.Text = rsServices(0)
    rsServices.Close
    
    rsPID.Open "select * from Patient_Details", cnPatients, adOpenStatic, adLockPessimistic
    
   
    
    While rsPID.EOF = False
        cmbPatientID.AddItem rsPID(0)
        rsPID.MoveNext
    Wend
   
   
   
    rsPID.MoveLast
    cmbPatientID.Text = rsPID(0)
    
    rsPID.Close
    
    Calendar1.Value = Date
    DTPDate1.Value = Date
    DTPTime1.Value = Time
    fra.Visible = False
    
       MSFlexGrid1.ColWidth(0) = 1500
    MSFlexGrid1.ColWidth(1) = 3500
    MSFlexGrid1.ColWidth(2) = 2000
    MSFlexGrid1.ColWidth(3) = 2000
    MSFlexGrid1.ColWidth(4) = 2000
    MSFlexGrid1.ColWidth(5) = 2000
    
    
Else
    'when database connection error occurs
    MsgBox "Database Connection Error", vbCritical, "SD Hospitals PVT LTD"
End

End If

End Sub



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