frmaddoutpatientdetails.frm

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

Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim WithEvents adoPrimaryRS As Recordset
Attribute adoPrimaryRS.VB_VarHelpID = -1
Dim mbChangedByCode As Boolean
Dim mvBookMark As Variant
Dim mbEditFlag As Boolean
Dim mbAddNewFlag As Boolean
Dim mbDataChanged As Boolean

Private Sub cmdAddtoAppointment_Click()
Dim PatID As String

PatID = txtFields(0)
Unload Me

If optApp(0) = True Then
frmAddDocAppointments.cmbPatientID = PatID
frmAddDocAppointments.Show
ElseIf optApp(1) = True Then
frmAddSerAppointments.cmbPatientID = PatID
frmAddSerAppointments.Show
End If

Me.Hide


End Sub





Private Sub cmdFCancel_Click()
Picture1.Visible = False
Frame3.Enabled = True
End Sub

Private Sub cmdFFind_Click()
Dim strText As String
Dim SQL As String
'strText = InputBox("Please Enter The patient ID", "Search Patient", "OPID_")

strText = txtSearch
If optSearch(0) = True Then
    SearchFor = "Patient_ID"
ElseIf optSearch(1) = True Then
    SearchFor = "First_Name"
ElseIf optSearch(2) = True Then
    SearchFor = "Last_Name"
ElseIf optSearch(3) = True Then
    SearchFor = "Telephone"
End If

varBookMark = adoPrimaryRS.Bookmark
adoPrimaryRS.MoveFirst

SQL = SearchFor & "=" & "'" & strText & "'"

adoPrimaryRS.Find SQL

If (adoPrimaryRS.BOF = True) Or (adoPrimaryRS.EOF = True) Then
   MsgBox "Record not found"
   adoPrimaryRS.Bookmark = varBookMark
End If





End Sub

Private Sub cmdSearch_Click()
Picture1.Visible = True
Frame3.Enabled = False
End Sub

Private Sub cmdViewAll_Click()
frmDisplayOutPatient.Show
End Sub

Private Sub Command1_Click()
Picture1.Visible = False
Frame3.Enabled = True
End Sub

Private Sub Form_Activate()
Call Functions.DisableMenu
End Sub

Private Sub Form_Load()


Me.WindowState = vbMaximized


Call Functions.DisableMenu



  Set adoPrimaryRS = New Recordset
  adoPrimaryRS.Open "select Patient_ID,First_Name,Last_Name,Gender,Telephone,Address,Status,Notes from Patient_Details ", cnPatients, adOpenStatic, adLockOptimistic

  Dim oText As TextBox
  'Bind the text boxes to the data provider
  For Each oText In Me.txtFields
    Set oText.DataSource = adoPrimaryRS
    oText.Locked = True
  Next
  
  
  
  
  
  mbDataChanged = False
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 22 Then KeyAscii = 0: Exit Sub
    KeyAscii = DataEntryValidation(KeyAscii, ActiveControl.Tag)
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 = "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 If
End Sub

Private Sub cmdAdd_Click()
  On Error GoTo AddErr
    
    Dim rsAddPatient As New Recordset
    Dim PID As String
    Set rsAddPatient = New ADODB.Recordset
  
    PID = Functions.UID(6, "OPID_")
    rsAddPatient.Open " Select * from Patient_Details", cnPatients, adOpenKeyset, adLockPessimistic
    While rsAddPatient.EOF = False
        If rsAddPatient(0) = PID Then
            ID = True
            PID = Functions.UID(6, "OPID_")
            rsAddPatient.MoveFirst
        Else
            ID = False
        End If
    rsAddPatient.MoveNext
    Wend
    rsAddPatient.Close
    
  Dim oText As TextBox
  'Bind the text boxes to the data provider
  For Each oText In Me.txtFields
    oText.Locked = False
  Next
    
  txtFields(0).Locked = True
  
  
  
  With adoPrimaryRS
    If Not (.BOF And .EOF) Then
      mvBookMark = .Bookmark
    End If
    .AddNew
    txtFields(0).Text = PID
    
    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, "Confirm Delete") = 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
  
  Dim oText As TextBox
  For Each oText In Me.txtFields
    oText.Locked = False
  Next
    
  txtFields(0).Locked = True
  

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

EditErr:
  MsgBox Err.Description
End Sub
Private Sub cmdCancel_Click()
  On Error Resume Next
  Dim oText As TextBox
  For Each oText In Me.txtFields
    oText.Locked = True
  Next
  

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

End Sub

Private Sub cmdUpdate_Click()
  On Error GoTo UpdateErr
  Dim fl As Integer
  Dim oText As TextBox
  For Each oText In Me.txtFields
    oText.Locked = True
  Next
   fl = 0
   If txtFields(1) = "" Then
        MsgBox "Please Enter Patient First Name"
        txtFields(1).SetFocus
        fl = 1
    ElseIf txtFields(2) = "" Then
        MsgBox "Please Enter Patient Last Name"
        fl = 1
        txtFields(2).SetFocus
    ElseIf txtFields(5) = "" Then
        MsgBox "Please Enter Address"
        fl = 1
        txtFields(5).SetFocus
    ElseIf txtFields(4) = "" Then
        MsgBox "Please Enter Contact Number"
        fl = 1
        txtFields(4).SetFocus
    ElseIf txtFields(6) = "" Then
        MsgBox "Please Enter Patient Status"
        fl = 1
        txtFields(6).SetFocus
    ElseIf txtFields(0) = "" Then
        MsgBox "Please Enter Patient ID"
        fl = 1
    End If
    
    If OptGender(0).Value = True Then
        txtFields(3) = "Male"
    ElseIf OptGender(1).Value = True Then
        txtFields(3) = "FeMale"
    End If
  If fl <> 1 Then
    adoPrimaryRS.UpdateBatch adAffectAll
   
  
  If mbAddNewFlag Then
        adoPrimaryRS.MoveLast              'move to the new record
  End If
    mbEditFlag = False
    mbAddNewFlag = False
    SetButtons True
    Picture1.Visible = False
    mbDataChanged = False
  Exit Sub
  ElseIf fl = 1 Then
    For Each oText In Me.txtFields
        oText.Locked = False
    Next
        txtFields(0).Locked = True
    Exit Sub
    

  End If
 
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
  Frame1.Visible = Not bVal
  txtFields(3).Visible = bVal
  cmdAddtoAppointment.Visible = bVal
  Picture1.Visible = bVal
  'cmdSearch.Visible = bVal
  Frame5.Visible = bVal
  
  cmdViewAll.Visible = bVal
  
End Sub

Private Sub OptGender_Click(Index As Integer)
Select Case (Index)
        Case "0" ' Male
        txtFields(3) = "Male"
        Case "1" 'Female
        txtFields(3) = "FeMale"

        Case Else 'None
            
End Select

End Sub