frmviewserviceappointments.frm

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

         Name            =   "Verdana"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   435
      Left            =   3210
      TabIndex        =   18
      Top             =   480
      Width           =   6345
   End
End
Attribute VB_Name = "frmViewServiceAppointments"
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 Service_Appointment, Patient_Details WHERE Service_Appointment.Appointment_Date =#" & SQLDate(DateClicked) & "#" & " and Service_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, , "Service 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])
                
                If rsAppointment![First_Name] <> "" Then
                    LItem.SubItems(1) = rsAppointment![First_Name]
                End If
                If rsAppointment![Last_Name] <> "" Then
                    LItem.SubItems(2) = rsAppointment![Last_Name]
                End If
                If rsAppointment![address] <> "" Then
                    LItem.SubItems(3) = rsAppointment![address]
                End If
                If rsAppointment![Telephone] <> "" Then
                    LItem.SubItems(4) = rsAppointment![Telephone]
                End If
                If rsAppointment![Hospital_SErvice_ID] <> "" Then
                    LItem.SubItems(5) = rsAppointment![Hospital_SErvice_ID]
                End If
                If rsAppointment![Appointment_Time] <> "" Then
                    LItem.SubItems(6) = rsAppointment![Appointment_Time]
                End If
                
                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 Service_Appointment where Appointment_Date between #" & SQLDate(dtpDateFrom) & "#  AND #" & SQLDate(dtpDateTo) & "#"
ElseIf chkDoc.Value = 1 Then
    SQL = "select * from Service_Appointment where Hospital_Service_ID='" & cmbService & "' and  Appointment_Date between #" & SQLDate(dtpDateFrom) & "#  AND #" & SQLDate(dtpDateTo) & "#"
End If

Dim rsSerAppointments As Recordset
Set rsSerAppointments = New ADODB.Recordset


rsSerAppointments.Open SQL, cnPatients, adOpenDynamic, adLockPessimistic


For i = 0 To rsSerAppointments.Fields.Count - 1 Step 1
    cmbSearch.AddItem rsSerAppointments(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, , "Service ID", 2000)
Set LHeader = ListView1.ColumnHeaders.add(4, , "Appointment Date", 2000)
Set LHeader = ListView1.ColumnHeaders.add(5, , "Apointment Time", 2000)


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



















End Sub

Private Sub Command3_Click()
Form_Load
End Sub

Private Sub Command4_Click()
Unload Me
End Sub

Private Sub Form_Load()
Call Functions.DisableMenu
Dim LItem As ListItem
Dim i As Integer


Dim rsSerAppointments As Recordset
Set rsSerAppointments = New ADODB.Recordset

rsSerAppointments.Open "select * from Service_Appointment order by Appointment_Date,Appointment_Time", cnPatients, adOpenDynamic, adLockPessimistic


For i = 0 To rsSerAppointments.Fields.Count - 1 Step 1
    cmbSearch.AddItem rsSerAppointments(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, , "Medical Service ID", 3000)
Set LHeader = ListView1.ColumnHeaders.add(4, , "Appointment Date", 2500)
Set LHeader = ListView1.ColumnHeaders.add(5, , "Apointment Time", 2500)


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


dtpDateFrom = Date
dtpDateTo = Date

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

While rsAddServices.EOF = False
cmbService.AddItem rsAddServices(0)
rsAddServices.MoveNext
Wend

rsAddServices.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, , "Service 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 Service_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