frmviewdoctorappointments.frm

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

      ScreenWidthDT   =   1280
      FormHeightDT    =   8430
      FormWidthDT     =   12960
      FormScaleHeightDT=   7920
      FormScaleWidthDT=   12840
      ResizeFormBackground=   -1  'True
      ResizePictureBoxContents=   -1  'True
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00FF8080&
      Caption         =   "VIEW DOCTOR APPOINTMENTS"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   435
      Left            =   3480
      TabIndex        =   10
      Top             =   360
      Width           =   6285
   End
End
Attribute VB_Name = "frmViewDoctorAppointments"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strCol As Variant

Private Sub Calendar1_Click()

Dim DateClicked As Date
Dim rsAppointment As Recordset
Dim LItem As ListItem
Dim LHeader As ColumnHeader
Dim SQL As String

Set rsAppointment = New ADODB.Recordset

DateClicked = Calendar1.Value
SQL = "SELECT * From Doctor_Appointment, Patient_Details WHERE Doctor_Appointment.Appointment_Date =#" & SQLDate(DateClicked) & "#" & " and Doctor_Appointment.Patient_ID=Patient_Details.Patient_ID ORDER BY Appointment_Time" & ";"
    
Set rsAppointment = New ADODB.Recordset

ListView1.ListItems.clear
ListView1.ColumnHeaders.clear

rsAppointment.Open SQL, cnPatients, adOpenDynamic, adLockPessimistic

LWidth = ListView1.Width - 5 * Screen.TwipsPerPixelX
Set LHeader = ListView1.ColumnHeaders.add(1, , "Appointment ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(2, , "Patient First Name", 2000)
Set LHeader = ListView1.ColumnHeaders.add(3, , "Patient Last Name", 2000)
Set LHeader = ListView1.ColumnHeaders.add(4, , "Address", 2000)
Set LHeader = ListView1.ColumnHeaders.add(5, , "Telephone", 2000)
Set LHeader = ListView1.ColumnHeaders.add(6, , "Doctor ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(7, , "Appointment Time", 2000)


Dim rsDocName As Recordset
Set rsDocName = New ADODB.Recordset


If Not rsAppointment.EOF Then ' If results found
   

            While Not rsAppointment.EOF
                'rsDocName.Open "select Doctor_Fname,Doctor_LName from Doctor_Details where Doctor_ID='" & rsAppointment![Doctor_ID] & "'", cnPatients, adOpenDynamic, adLockPessimistic
        
                Set LItem = ListView1.ListItems.add(, , rsAppointment![Appointment_ID])
                LItem.SubItems(1) = rsAppointment![First_Name]
                LItem.SubItems(2) = rsAppointment![Last_Name]
                If rsAppointment![address] <> "" Then
                    LItem.SubItems(3) = rsAppointment![address]
                End If
                If rsAppointment![Telephone] <> "" Then
                    LItem.SubItems(4) = rsAppointment![Telephone]
                End If
                LItem.SubItems(5) = rsAppointment![Doctor_ID]
                'LItem.SubItems(5) = rsDocName(0) & " " & rsDocName(1)
                LItem.SubItems(6) = rsAppointment![Appointment_Time]

                rsAppointment.MoveNext
                'rsDocName.Close

            Wend


Else ' If no Results Found

End If

rsAppointment.Close




















End Sub





Private Sub cmbSearch_Click()
txtSearchText_Change
End Sub

Private Sub Command1_Click()
If dtpDateFrom > dtpDateTo Then
    MsgBox "The (From) date has to be less than the (To) Date", vbCritical
    Exit Sub
End If

Dim LItem As ListItem
Dim i As Integer
Dim SQL As String

If chkDoc.Value = 0 Then
    SQL = "select * from Doctor_Appointment where Appointment_Date between #" & SQLDate(dtpDateFrom) & "#  AND #" & SQLDate(dtpDateTo) & "#"
ElseIf chkDoc.Value = 1 Then
    SQL = "select * from Doctor_Appointment where doctor_ID='" & cmbDocID & "' and  Appointment_Date between #" & SQLDate(dtpDateFrom) & "#  AND #" & SQLDate(dtpDateTo) & "#"
End If

Dim rsDocAppointments As Recordset
Set rsDocAppointments = New ADODB.Recordset


rsDocAppointments.Open SQL, cnPatients, adOpenDynamic, adLockPessimistic


For i = 0 To rsDocAppointments.Fields.Count - 1 Step 1
    cmbSearch.AddItem rsDocAppointments(i).name, i
Next i

ListView1.ListItems.clear
ListView1.ColumnHeaders.clear

Set LHeader = ListView1.ColumnHeaders.add(1, , "Appointment ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(2, , "Patient ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(3, , "Doctor ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(4, , "Appointment Date", 2000)
Set LHeader = ListView1.ColumnHeaders.add(5, , "Apointment Time", 2000)
'Set LHeader = ListView1.ColumnHeaders.add(6, , "Doctor ID", 2000)
'Set LHeader = ListView1.ColumnHeaders.add(7, , "Appointment Time", 2000)


ListView1.ListItems.clear
While rsDocAppointments.EOF = False
        Set LItem = ListView1.ListItems.add(, , rsDocAppointments(0))
        LItem.SubItems(1) = rsDocAppointments(1)
        LItem.SubItems(2) = rsDocAppointments(2)
        LItem.SubItems(3) = Format(rsDocAppointments(3), "short Date")
        LItem.SubItems(4) = Format(rsDocAppointments(4), "short time")
        'LItem.SubItems(5) = rsDocAppointments(5)
        
rsDocAppointments.MoveNext
Wend
rsDocAppointments.Close



















End Sub

Private Sub Command3_Click()
Form_Load
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Form_Load()


Me.WindowState = vbMaximized


Call Functions.DisableMenu
Dim LItem As ListItem
Dim i As Integer


Dim rsDocAppointments As Recordset
Set rsDocAppointments = New ADODB.Recordset

rsDocAppointments.Open "select * from Doctor_Appointment order by Appointment_Date,Appointment_Time", cnPatients, adOpenDynamic, adLockPessimistic


For i = 0 To rsDocAppointments.Fields.Count - 1 Step 1
    cmbSearch.AddItem rsDocAppointments(i).name, i
Next i

ListView1.ListItems.clear
ListView1.ColumnHeaders.clear

Set LHeader = ListView1.ColumnHeaders.add(1, , "Appointment ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(2, , "Patient ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(3, , "Doctor ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(4, , "Appointment Date", 2000)
Set LHeader = ListView1.ColumnHeaders.add(5, , "Apointment Time", 2000)


ListView1.ListItems.clear
While rsDocAppointments.EOF = False
        Set LItem = ListView1.ListItems.add(, , rsDocAppointments(0))
        LItem.SubItems(1) = rsDocAppointments(1)
        LItem.SubItems(2) = rsDocAppointments(2)
        LItem.SubItems(3) = Format(rsDocAppointments(3), "short Date")
        LItem.SubItems(4) = Format(rsDocAppointments(4), "short time")
        'LItem.SubItems(5) = rsDocAppointments(5)
        
rsDocAppointments.MoveNext
Wend
rsDocAppointments.Close
cmbSearch.Text = cmbSearch.List(0)


dtpDateFrom = Date
dtpDateTo = Date

Dim rsAddDocs As Recordset
Set rsAddDocs = New ADODB.Recordset
rsAddDocs.Open "Select * from Doctor_Details", cnPatients, adOpenDynamic, adLockReadOnly

While rsAddDocs.EOF = False
cmbDocID.AddItem rsAddDocs(0)
rsAddDocs.MoveNext
Wend

rsAddDocs.Close





End Sub



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

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
If strCol <> ColumnHeader Then
    ListView1.SortOrder = lvwAscending
    ListView1.SortKey = ColumnHeader.Index - 1
    strCol = ColumnHeader
Else
    ListView1.SortOrder = lvwDescending
    ListView1.SortKey = ColumnHeader.Index - 1
    strCol = ""
End If
End Sub

Private Sub txtSearchText_Change()

Dim rsFind As Recordset
Dim strSQl As String
Dim SQL As String
Dim LItem As ListItem
Dim LHeader As ColumnHeader

'if there is nothing to search for then exit
If txtSearchText = "" Then
    Exit Sub
End If


ListView1.ListItems.clear
ListView1.ColumnHeaders.clear

Set rsFind = New ADODB.Recordset

Set LHeader = ListView1.ColumnHeaders.add(1, , "Appointment ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(2, , "Patient ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(3, , "Doctor ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(4, , "Appointment Date", 2000)
Set LHeader = ListView1.ColumnHeaders.add(5, , "Apointment Time", 2000)


'make the search
        strSQl = "SELECT * FROM Doctor_Appointment WHERE "
        strSQl = strSQl & cmbSearch & " Like " & "'%" & txtSearchText & "%'"

        'SQL = strSQl & " WHERE language LIKE '*" & Text1.Text & "*'"
        'strSQl = strSQl & SQL
        Debug.Print strSQl

        
'show the found records
    rsFind.Open strSQl, cnPatients, adOpenDynamic, adLockPessimistic
    
    
    Debug.Print rsFind.RecordCount
    Debug.Print rsFind.Fields.Count
    
    If Not (rsFind.BOF And rsFind.EOF) Then
        While rsFind.EOF = False
        Set LItem = ListView1.ListItems.add(, , rsFind(0))
        LItem.SubItems(1) = rsFind(1)
        LItem.SubItems(2) = rsFind(2)
        LItem.SubItems(3) = Format(rsFind(3), "short date")
        LItem.SubItems(4) = Format(rsFind(4), "long time")
        'LItem.SubItems(5) = rsFind(5)
        
        rsFind.MoveNext
        Wend
    End If
 
 
 'show number of records found
    Me.Caption = CStr(rsFind.RecordCount) & " records found"
    
 'close the recordset
    rsFind.Close




End Sub