Next Chapter 22 Appointment
Appointment
Dim rst As New ADODB.Recordset
Public s As String
Dim Check1 As String
Private Sub Update()
On Error GoTo ErHand
Conn.Execute "update apnt set doap = '" & DTPicker2 & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set time1 = '" & DTPicker1 & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set surgeon = '" & TxtDoctor & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set nameofsur = '" & TxtsurName & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set placeofsur = '" & TxtSurPlace & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set anas = '" & TxtAnasthetist & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set instopat = '" & Text8 & "' where aptno= " & Val(s) & ""
Conn.Execute "update apnt set notes = '" & Text7 & "' where aptno= " & Val(s) & ""
chameleonButton2.Caption = "Edit"
ErHand:
ErrHandler "Appointment.Update() "
End Sub
Private Sub chameleonButton1_Click()
On Error Resume Next
Unload Me
Unload AppointmentSearch
End Sub
Private Sub chameleonButton2_Click()
On Error GoTo ErHand
If chameleonButton2.Caption = "Update" Then
Call Update
Call chameleonButton3_Click
Exit Sub
End If
s = InputBox("Enter the Appointment No")
If s = "" Then
Exit Sub
End If
Set rst = New ADODB.Recordset
rst.Open "select * from apnt where aptno= " & Val(s) & "", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF = True Then
MsgBox "This Appointment No. does not exist", vbInformation
rst.Close
Exit Sub
End If
MsgBox "Are You Sure to Edit the Record", vbYesNo
If vbYes Then
Set rst = New ADODB.Recordset
rst.Open "select * from apnt where aptno= " & Val(s) & "", Conn, adOpenDynamic, adLockOptimistic
Me.Text1 = rst!refno
Me.Text2 = rst!Name
Me.Text3 = rst!aptno
Me.DTPicker1 = rst!doap
Me.DTPicker2 = rst!time1
Me.TxtDoctor = rst!Surgeon
Me.TxtsurName = rst!nameofsur
Me.TxtSurPlace = rst!placeofsur
Me.TxtAnasthetist = rst!anas
Me.Text8 = rst!instopat
Me.Text7 = rst!notes
chameleonButton5.Enabled = False
chameleonButton2.Caption = "Update"
End If
ErHand:
ErrHandler "Appointment.chameleonButton2_Click() [Edit]"
End Sub
Private Sub chameleonButton3_Click()
On Error GoTo ErHand
Set rst = New ADODB.Recordset
rst.Open "select max(aptno) from apnt", Conn, adOpenDynamic, adLockOptimistic
If IsNull(rst.Fields(0)) = False Then
Text3 = rst.Fields(0) + 1
Else
Text3 = 1
End If
rst.Close
DTPicker2 = Date
DTPicker1 = Time
TxtDoctor = ""
TxtsurName = ""
TxtSurPlace = ""
TxtAnasthetist = ""
Text8 = ""
Text7 = ""
chameleonButton2.Caption = "Edit"
chameleonButton5.Enabled = True
ErHand:
ErrHandler "Appointment.chameleonButton3_Click() [New]"
End Sub
Private Sub chameleonButton4_Click()
On Error GoTo ErHand
s = InputBox("Enter the Appoint No")
If s = "" Then Exit Sub
MsgBox "Are You Sure to Delete the Record", vbYesNo
If vbYes Then
Set rst = New ADODB.Recordset
rst.Open "delete from apnt where aptno= " & Val(s) & "", Conn, adOpenDynamic, adLockOptimistic
MsgBox "Record Deleted!"
Call chameleonButton3_Click
Else
Exit Sub
End If
ErHand:
ErrHandler "Appointment.chameleonButton4_Click() [Delete]"
End Sub
Private Sub chameleonButton5_Click()
On Error GoTo ErHand
If Text1 = "" Then
MsgBox "Please Enter Registration No.", vbInformation
Text1.SetFocus
Exit Sub
End If
If Text3 = "" Then
MsgBox "Please Enter appointmentNo.", vbInformation
Text3.SetFocus
Exit Sub
End If
If TxtAnasthetist.Text = "" Then
If Me.TxtDoctor.Text = "" Then
MsgBox "Please Select Doctor Or Anasthetist Name", vbInformation
Me.TxtDoctor.SetFocus
Exit Sub
End If
End If
If Me.TxtsurName.Text = "" Then
MsgBox "Please Select Surgery Name", vbInformation
Me.TxtsurName.SetFocus
Exit Sub
End If
If Me.TxtSurPlace.Text = "" Then
MsgBox "Please Select surgery Place", vbInformation
Me.TxtSurPlace.SetFocus
Exit Sub
End If
Dim RstSave As New ADODB.Recordset
RstSave.Open "Select * from APNT Where refno=" & Text1.Text & " And time1='" & DTPicker1 & "' And doap='" & DTPicker2 & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If RstSave.EOF Then
Set rst = New ADODB.Recordset
rst.Open "select max(aptno) from apnt", Conn, adOpenDynamic, adLockOptimistic
Text3 = IIf(IsNull(rst.Fields(0)) = False, rst.Fields(0) + 1, 1)
rst.Close
RstSave.AddNew
Else
i = MsgBox("You Are Going To Update Appointment Of [ " & Me.Text2 & " ]" & vbCrLf & "With Doctor/Anasthetist [" & TxtDoctor.Text & "," & TxtAnasthetist.Text & "]" & vbCrLf & " Do You Want To Continue", vbExclamation + vbYesNo)
If i = vbNo Then Exit Sub
End If
RstSave.Fields("refno") = Text1.Text
RstSave.Fields("AptNo") = Text3.Text
RstSave.Fields("Name") = Text2.Text
RstSave.Fields("DoaP") = Format(DTPicker2, "dd-MMM-yyyy")
RstSave.Fields("Time1") = Format(DTPicker1, "hh:mm:ss")
RstSave.Fields("Surgeon") = TxtDoctor.Text
RstSave.Fields("NameOfSur") = TxtsurName.Text
RstSave.Fields("PlaceOfSur") = TxtSurPlace.Text
RstSave.Fields("Anas") = TxtAnasthetist.Text
RstSave.Fields("instopat") = Text8.Text & ""
RstSave.Fields("Notes") = Text7.Text & ""
RstSave.UpdateBatch
Call chameleonButton3_Click
ErHand:
ErrHandler "Appointment.chameleonButton5_Click() [Save]"
End Sub
Private Sub chameleonButton6_Click()
On Error GoTo ErHand
AppointmentSearch.Show
ErHand:
ErrHandler "Appointment.chameleonButton6_Click() [Search]"
End Sub
Private Sub chameleonButton7_Click()
On Error GoTo ErHand
Set rst = New ADODB.Recordset
rst.Open " select * from apnt order by aptno ", Conn, adOpenDynamic, adLockOptimistic
s = InputBox("Enter the Appointment No.", "Print")
If s = "" Or IsNumeric(s) = False Then
Exit Sub
rst.Close
End If
If rst.EOF = True Then
MsgBox " Sorry, Record not found ", vbInformation
Exit Sub
rst.Close
End If
On Error Resume Next
DataEnvironment1.Recordsets.Item("command22").Close
DataEnvironment1.Recordsets.Item("command22").Open " select * from apnt where aptno= " & s & " order by aptno", Conn, adOpenDynamic, adLockOptimistic
AppointmentReport.Sections(1).Controls.Item("label16").Caption = hos_name
AppointmentReport.Sections(1).Controls.Item("label17").Caption = hos_add
AppointmentReport.Show
ErHand:
ErrHandler "Appointment.chameleonButton7_Click() [Print]"
End Sub
Private Sub Form_Load()
On Error GoTo ErHand
Me.Top = 400
Me.Left = 2050
Call chameleonButton3_Click
Text1 = Admission.TxtRegno.Text
Text2 = Admission.TxtPatient.Text
DTPicker1 = Time
DTPicker2 = Date
Set rst = New ADODB.Recordset
rst.Open "select * from apnt where refno = " & Admission.TxtRegno.Text & "", Conn, adOpenDynamic, adLockOptimistic
If Not rst.EOF = True Then
Call apnt
End If
rst.Close
Set rst = New ADODB.Recordset
rst.Open "select title,fname,mname,lname from docmast ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF Then rst.Close: Exit Sub
While Not rst.EOF
TxtDoctor.AddItem rst!Title & " " & rst!FName & " " & rst!MName & " " & rst!LName & " "
TxtDoctor.Text = rst!Title & " " & rst!FName & " " & rst!MName & " " & rst!LName & " "
rst.MoveNext
Wend
TxtAnasthetist.Clear
Set rst = New ADODB.Recordset
rst.Open "select title,fname,mname,lname from anaes ", Conn, adOpenDynamic, adLockOptimistic
If rst.EOF Then rst.Close: Exit Sub
While Not rst.EOF
TxtAnasthetist.AddItem rst!Title & " " & rst!FName & " " & rst!MName & " " & rst!LName & " "
TxtAnasthetist.Text = rst!Title & " " & rst!FName & " " & rst!MName & " " & rst!LName & " "
rst.MoveNext
Wend
Set rst = Nothing
Check1 = "Load"
ErHand:
ErrHandler "Appointment.Form_Load"
End Sub
Public Function apnt()
On Error GoTo ErHand
Text1 = rst!refno & ""
Text2 = rst!Name & ""
Text3 = rst!aptno & ""
DTPicker2 = rst!doap & ""
DTPicker1 = rst!time1 & ""
TxtDoctor = rst!Surgeon & ""
TxtsurName = rst!nameofsur & ""
TxtSurPlace = rst!placeofsur & ""
TxtAnasthetist = rst!anas & ""
Text8 = rst!instopat & ""
Text7 = rst!notes & ""
Text2 = rst!Name & ""
ErHand:
ErrHandler "Appointment.Apnt() [Get Data]"
End Function
Private Sub Form_Unload(Cancel As Integer)
Admission.Enabled = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If (KeyAscii >= vbKey0 And KeyAscii <= vbKey9) Or KeyAscii = vbKeyBack Or (KeyAscii = 46) Then
Exit Sub
Else
KeyAscii = 0
Beep
End If
End Sub
Private Sub TxtAnasthetist_Click()
On Error GoTo ErHand
If Not Check1 = "Load" Then Exit Sub
Dim RstSave As New ADODB.Recordset
RstSave.Open "Select * from APNT Where anas='" & TxtAnasthetist.Text & "' And time1='" & DTPicker1 & "' And doap='" & DTPicker2 & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If Not RstSave.EOF Then MsgBox "Sorry Anasthetist [ " & TxtAnasthetist.Text & " ] is Already Busy " & vbCrLf & " With [ " & RstSave.Fields("Name") & " ]", vbExclamation, App.Title
ErHand:
ErrHandler "Appointment.TxtAnasthetist_Click()"
End Sub
Private Sub TxtDoctor_Click()
On Error GoTo ErHand
If Not Check1 = "Load" Then Exit Sub
Dim RstSave As New ADODB.Recordset
RstSave.Open "Select * from APNT Where surgeon='" & TxtDoctor.Text & "' And time1='" & DTPicker1.Value & "' And doap='" & Format(DTPicker2, "dd-MMM-yyyy") & "'", Conn, adOpenDynamic, adLockBatchOptimistic
If Not RstSave.EOF Then MsgBox "Sorry Surgeon [ " & TxtDoctor.Text & " ] is Already Busy " & vbCrLf & " With [ " & RstSave.Fields("Name") & " ]", vbExclamation, App.Title
ErHand:
ErrHandler "Appointment.TxtDoctor_Click()"
End Sub
Sponsored Links
This site is designed to help BCA MCA student to develop final project and synopsis Download Free BCA Project, MCA Project, IT Projects, Final report and Project synopsis with Full documentation and code