frmadddoctorvisits.frm

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

If rsDoctor.EOF = False Then
RowNo = 1

With MSFlexGrid1
    .clear
    .Rows = 1
    .Cols = rsDoctor.Fields.Count
   
  

    While Not rsDoctor.EOF
        .Rows = .Rows + 1
        '.Row = .Rows - 1
        
    .TextMatrix(RowNo, 0) = rsDoctor(0)
    .TextMatrix(RowNo, 1) = rsDoctor(1)
    .TextMatrix(RowNo, 2) = rsDoctor(2)
    .TextMatrix(RowNo, 3) = rsDoctor(9)
    .TextMatrix(RowNo, 4) = rsDoctor(10)
    
    RowNo = RowNo + 1

      
    rsDoctor.MoveNext
    Wend
    
    
    .TextMatrix(0, 0) = "Doctor ID"
    .TextMatrix(0, 1) = "First Name"
    .TextMatrix(0, 2) = "Last Name"
    .TextMatrix(0, 3) = "Specialization"
    .TextMatrix(0, 4) = "Type"
    
    .FixedRows = 1
    .RowHeight(0) = .RowHeight(1) * 1.5
     Functions.SizeColumns MSFlexGrid1, Me
     .SetFocus
     .RowSel = 1
End With



rsDoctor.Close

End If







End Sub

Private Sub cmdExit_Click()


Frame1.Visible = False
Frame1.Caption = ""
If IDType = 0 Then
    cmbDoctorID.SetFocus
ElseIf IDType = 1 Then
    cmbPatientID.SetFocus
End If


End Sub

Private Sub cmdOK_Click()
If IDType = 0 Then
cmbDoctorID = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
cmbPatientID.SetFocus
End If
If IDType = 1 Then
cmbPatientID = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
txtFields(5).SetFocus
End If
Frame1.Caption = ""
Frame1.Visible = False

End Sub

Private Sub cmdPatient_Click()

Frame1.Caption = "Patient Details"
Frame1.Visible = True
IDType = 1
Dim RowNo As Integer
Dim rsPatient As New Recordset

Set rsPatient = New ADODB.Recordset
'create sql statement

'Set rsDocs.ActiveConnection = cnPatients

rsPatient.Open "Select * from In_Patient_Details", cnPatients, adOpenDynamic, adLockReadOnly

If rsPatient.EOF = False Then
RowNo = 1

With MSFlexGrid1
    .clear
    .Rows = 1
    .Cols = rsPatient.Fields.Count
  

    While Not rsPatient.EOF
        .Rows = .Rows + 1
        '.Row = .Rows - 1
    If Not rsPatient(0) = "" Then
        .TextMatrix(RowNo, 0) = rsPatient(0)
    End If
    If Not rsPatient(1) = "" Then
        .TextMatrix(RowNo, 1) = rsPatient(1)
    End If
    If Not rsPatient(2) = "" Then
        .TextMatrix(RowNo, 2) = rsPatient(2)
    End If
    If Not rsPatient(4) = "" Then
        .TextMatrix(RowNo, 3) = rsPatient(4)
    End If
    If Not rsPatient(5) = "" Then
        .TextMatrix(RowNo, 4) = rsPatient(5)
    End If
    
    RowNo = RowNo + 1

      
    rsPatient.MoveNext
    Wend
    
    
    .TextMatrix(0, 0) = "Patient ID"
    .TextMatrix(0, 1) = "First Name"
    .TextMatrix(0, 2) = "Last Name"
    .TextMatrix(0, 3) = "Sex"
    .TextMatrix(0, 4) = "NIC Number"
    
    .FixedRows = 1
    .RowHeight(0) = .RowHeight(1) * 1.5
     Functions.SizeColumns MSFlexGrid1, Me
End With



rsPatient.Close

End If

















End Sub

Private Sub Form_Load()
    Call Functions.DisableMenu
  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select Visit_ID,Visit_Date,Visit_Time,Doctor_ID,Patient_ID,Admission_ID,Description from Visit_Details", cnPatients, adOpenDynamic, adLockPessimistic

  Dim oText As TextBox
  'Bind the text boxes to the data provider
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
  Next

    DTPDate1 = Date
    DTPTime1 = Time
    Call addPatientID
    Call addDoctorID
    
  mbDataChanged = False
End Sub

Private Sub Form_Resize()
  On Error Resume Next
  'lblStatus.Width = Me.Width - 1500
  'cmdNext.Left = lblStatus.Width + 700
  'cmdLast.Left = cmdNext.Left + 340
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  If mbEditFlag Or mbAddNewFlag Then Exit Sub

  Select Case KeyCode
    Case vbKeyEscape
      cmdClose_Click
    Case vbKeyEnd
      cmdLast_Click
    Case vbKeyHome
      cmdFirst_Click
    Case vbKeyUp, vbKeyPageUp
      If Shift = vbCtrlMask Then
        cmdFirst_Click
      Else
        cmdPrevious_Click
      End If
    Case vbKeyDown, vbKeyPageDown
      If Shift = vbCtrlMask Then
        cmdLast_Click
      Else
        cmdNext_Click
      End If
  End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Screen.MousePointer = vbDefault
  Call Functions.EnableMenu
End Sub

Private Sub adoPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  'This will display the current record position for this recordset
  lblStatus.Caption = "Doctor Visit Record: " & CStr(adoPrimaryRS.AbsolutePosition)
End Sub

Private Sub adoPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
  'This is where you put validation code
  'This event gets called when the following actions occur
  Dim bCancel As Boolean

  Select Case adReason
  Case adRsnAddNew
  Case adRsnClose
  Case adRsnDelete
  Case adRsnFirstChange
  Case adRsnMove
  Case adRsnRequery
  Case adRsnResynch
  Case adRsnUndoAddNew
  Case adRsnUndoDelete
  Case adRsnUndoUpdate
  Case adRsnUpdate
  End Select

  If bCancel Then adStatus = adStatusCancel
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
    
  With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
    Call addVisitID
    
    lblStatus.Caption = "Add record"
    mbAddNewFlag = True
    SetButtons False
  End With

  Exit Sub
AddErr:
  MsgBox Err.Description
End Sub

Private Sub cmdDelete_Click()
  On Error GoTo DeleteErr
  If MsgBox("Are you sure you want to delete this record?", vbQuestion + vbYesNo, "Delete Record") = vbNo Then
    Exit Sub
  End If
  With adoPrimaryRS
    .Delete
    .MoveNext
    If .EOF Then .MoveLast
  End With
  Exit Sub
DeleteErr:
  MsgBox Err.Description
End Sub

Private Sub cmdRefresh_Click()
  'This is only needed for multi user apps
  On Error GoTo RefreshErr
  adoPrimaryRS.Requery
  Exit Sub
RefreshErr:
  MsgBox Err.Description
End Sub

Private Sub cmdEdit_Click()
  On Error GoTo EditErr
    
    DTPDate1 = txtFields(1)
    DTPTime1 = txtFields(2)
    cmbDoctorID = txtFields(3)
    cmbPatientID = txtFields(4)

  lblStatus.Caption = "Edit record"
  mbEditFlag = True
  SetButtons False
  Exit Sub

EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click()
  On Error Resume Next

  SetButtons True
  mbEditFlag = False
  mbAddNewFlag = False
  adoPrimaryRS.CancelUpdate
  If mvBookMark > 0 Then
    adoPrimaryRS.Bookmark = mvBookMark
  Else
    adoPrimaryRS.MoveFirst
  End If
  mbDataChanged = False

End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr

    
    txtFields(1) = DTPDate1.Value
    txtFields(2) = DTPTime1.Value
    txtFields(3) = cmbDoctorID
    txtFields(4) = cmbPatientID
    txtFields(6) = cmbAdmitID

  If txtFields(3) = "" Or txtFields(4) = "" Or txtFields(6) = "" Then
    MsgBox "Please Enter all the relavant fields", vbCritical
    Exit Sub
  End If
  
  adoPrimaryRS.UpdateBatch adAffectAll

  If mbAddNewFlag Then
    adoPrimaryRS.MoveLast              'move to the new record
  End If

  mbEditFlag = False
  mbAddNewFlag = False
  SetButtons True
  mbDataChanged = False

  Exit Sub
UpdateErr:
  MsgBox Err.Description
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdFirst_Click()
  On Error GoTo GoFirstError

  adoPrimaryRS.MoveFirst
  mbDataChanged = False

  Exit Sub

GoFirstError:
  MsgBox Err.Description
End Sub

Private Sub cmdLast_Click()
  On Error GoTo GoLastError

  adoPrimaryRS.MoveLast
  mbDataChanged = False

  Exit Sub

GoLastError:
  MsgBox Err.Description
End Sub

Private Sub cmdNext_Click()
  On Error GoTo GoNextError

  If Not adoPrimaryRS.EOF Then adoPrimaryRS.MoveNext
  If adoPrimaryRS.EOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
     'moved off the end so go back
    adoPrimaryRS.MoveLast
  End If
  'show the current record
  mbDataChanged = False

  Exit Sub
GoNextError:
  MsgBox Err.Description
End Sub

Private Sub cmdPrevious_Click()
  On Error GoTo GoPrevError

  If Not adoPrimaryRS.BOF Then adoPrimaryRS.MovePrevious
  If adoPrimaryRS.BOF And adoPrimaryRS.RecordCount > 0 Then
    Beep
    'moved off the end so go back
    adoPrimaryRS.MoveFirst
  End If
  'show the current record
  mbDataChanged = False

  Exit Sub

GoPrevError:
  MsgBox Err.Description
End Sub

Private Sub SetButtons(bVal As Boolean)
  cmdAdd.Visible = bVal
  cmdEdit.Visible = bVal
  cmdUpdate.Visible = Not bVal
  cmdCancel.Visible = Not bVal
  cmdDelete.Visible = bVal
  cmdClose.Visible = bVal
  cmdRefresh.Visible = bVal
  cmdNext.Enabled = bVal
  cmdFirst.Enabled = bVal
  cmdLast.Enabled = bVal
  cmdPrevious.Enabled = bVal
  txtFields(5).Locked = bVal
  DTPDate1.Visible = Not bVal
  DTPTime1.Visible = Not bVal
  cmbDoctorID.Visible = Not bVal
  cmbPatientID.Visible = Not bVal
  cmbAdmitID.Visible = Not bVal
  cmdAdmission.Visible = Not bVal
  cmdDoc.Visible = Not bVal
  cmdPatient.Visible = Not bVal
  
End Sub


Private Sub addPatientID()

Dim rsAddPatientID As Recordset
Set rsAddPatientID = New ADODB.Recordset

rsAddPatientID.Open "select * from In_Patient_Details", cnPatients, adOpenDynamic, adLockReadOnly

While rsAddPatientID.EOF = False
cmbPatientID.AddItem rsAddPatientID(0)
rsAddPatientID.MoveNext
Wend


rsAddPatientID.Close


End Sub
Private Sub addDoctorID()

Dim rsAddDoctorID As Recordset
Set rsAddDoctorID = New ADODB.Recordset

rsAddDoctorID.Open "select * from Doctor_Details", cnPatients, adOpenDynamic, adLockReadOnly

While rsAddDoctorID.EOF = False
cmbDoctorID.AddItem rsAddDoctorID(0)
rsAddDoctorID.MoveNext
Wend


rsAddDoctorID.Close

End Sub


Private Sub addVisitID()
Dim VisitID As String
Dim rsAddVisitID As Recordset

    VisitID = Functions.UID(6, "DocVis_")
    
    Set rsAddVisitID = New ADODB.Recordset
    rsAddVisitID.Open "Select * from Visit_Details", cnPatients, adOpenKeyset, adLockPessimistic
              
            While rsAddVisitID.EOF = False
                If rsAddVisitID(0) = VisitID Then
                    VisitID = Functions.UID(6, "DocVis_")
                    rsAddVisitID.MoveFirst
                End If
                rsAddVisitID.MoveNext
            Wend
             
txtFields(0) = VisitID
End Sub



Private Sub MSFlexGrid1_DblClick()


    If IDType = 0 Then
        cmbDoctorID = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
    End If
    If IDType = 1 Then
        cmbPatientID = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
    End If
    cmbPatientID.SetFocus
    Frame1.Visible = False
End Sub

Private Sub MSFlexGrid1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
    If IDType = 0 Then
        cmbDoctorID = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
        cmbPatientID.SetFocus
    End If
    If IDType = 1 Then
        cmbPatientID = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
        txtFields(5).SetFocus
    End If
    Frame1.Visible = False
End If

If KeyAscii = 27 Then
    If IDType = 0 Then
        cmbDoctorID.SetFocus
    ElseIf IDType = 1 Then
        cmbPatientID.SetFocus
    End If

    Frame1.Visible = False
End If

End Sub