frmdisplayophistory.frm

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

   Begin ActiveResizeCtl.ActiveResize ActiveResize1 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      Resolution      =   4
      ScreenHeight    =   1024
      ScreenWidth     =   1280
      ScreenHeightDT  =   1024
      ScreenWidthDT   =   1280
      FormHeightDT    =   10035
      FormWidthDT     =   12720
      FormScaleHeightDT=   9525
      FormScaleWidthDT=   12600
      ResizeFormBackground=   -1  'True
      ResizePictureBoxContents=   -1  'True
   End
   Begin VB.Label Label6 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00FF8080&
      Caption         =   "VIEW OUT PATIENT HISTORY"
      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            =   3420
      TabIndex        =   17
      Top             =   480
      Width           =   5925
   End
End
Attribute VB_Name = "frmDisplayOPHistory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command2_Click()

End Sub

Private Sub Command3_Click()

End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDisplay_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 OutPatient_Treatments where Date between #" & SQLDate(dtpDateFrom) & "#  AND #" & SQLDate(dtpDateTo) & "#"
ElseIf chkDoc.Value = 1 Then
    SQL = "select * from OutPatient_Treatments where Patient_ID='" & cmbPatient & "' and  Date between #" & SQLDate(dtpDateFrom) & "#  AND #" & SQLDate(dtpDateTo) & "#"
End If

Dim rsOPHistory As Recordset
Set rsOPHistory = New ADODB.Recordset


rsOPHistory.Open SQL, cnPatients, adOpenDynamic, adLockPessimistic


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

ListView1.ListItems.clear

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

While rsOPHistory.EOF = False
        Set LItem = ListView1.ListItems.add(, , rsOPHistory(0))
        
        For j = 1 To rsOPHistory.Fields.Count - 1 Step 1
            If rsOPHistory(j) <> "" Then
                LItem.SubItems(j) = rsOPHistory(j)
            End If
        Next j
    
        
rsOPHistory.MoveNext
Wend



rsOPHistory.Close






















End Sub

Private Sub cmdPatientID_Click()
frmDisplayOutPatient.Show
End Sub

Private Sub cmdRefresh_Click()
txtSearchText = ""
Form_Load
End Sub

Private Sub Command1_Click()

End Sub

Private Sub Form_Activate()
Call Functions.DisableMenu
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 Form_Load()

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

dtpDateFrom = Date
dtpDateTo = Date + 1

Dim rsPatientID As Recordset
Set rsPatientID = New ADODB.Recordset

rsPatientID.Open "select * from OutPatient_Treatments", cnPatients, adOpenDynamic, adLockPessimistic
cmbSearch.clear

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


If rsPatientID.EOF = False Then
    rsPatientID.MoveFirst
Else
    Exit Sub
End If

ListView1.ListItems.clear

While rsPatientID.EOF = False
        Set LItem = ListView1.ListItems.add(, , rsPatientID(0))
        
        For j = 1 To rsPatientID.Fields.Count - 1 Step 1
            If rsPatientID(j) <> "" Then
                LItem.SubItems(j) = rsPatientID(j)
            End If
        Next j
    
        
rsPatientID.MoveNext
Wend
rsPatientID.Close
cmbSearch.Text = cmbSearch.List(0)


cmbPatient.clear
Dim rsAddPat As Recordset
Set rsAddPat = New ADODB.Recordset
rsAddPat.Open "Select * from Patient_Details", cnPatients, adOpenDynamic, adLockReadOnly

While rsAddPat.EOF = False
cmbPatient.AddItem rsAddPat(0)
rsAddPat.MoveNext
Wend

rsAddPat.Close



End Sub

Private Sub txtSearchText_Change()
Dim rsFind As Recordset
Dim strSQl As String
Dim SQL As String
Dim LItem As ListItem

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

ListView1.ListItems.clear

Set rsFind = New ADODB.Recordset



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

   
        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))
        
           
        For j = 1 To rsFind.Fields.Count - 1 Step 1
            If rsFind(j) <> "" Then
                LItem.SubItems(j) = rsFind(j)
            End If
        Next j
            
        rsFind.MoveNext
        Wend
    End If
 
 
 'show number of records found
    Me.Caption = CStr(rsFind.RecordCount) & " records found"
    
 'close the recordset
    rsFind.Close
    
End Sub