Next Chapter 20 Admission form

Admission form

Dim rst As New Recordset

Dim rst1 As New Recordset

Dim a As String

Dim b As String

Private Sub chameleonButton1_Click()

On Error GoTo ErHand

registration.Enabled = True

Unload SearchFrm

Unload Me

ErHand:

ErrHandler "Addmission.chameleonButton1_Click() [Close]"

End Sub

Private Sub chameleonButton2_Click()

On Error GoTo ErHand

newbed.Show

ErHand:

ErrHandler "Addmission.chameleonButton2_Click() [New Bed]"

End Sub

Private Sub chameleonButton3_Click()

On Error GoTo ErHand

If Admission.TxtRegno.Text = "" Then

MsgBox "No Referrence No. has Given!", vbInformation

Exit Sub

Else

Admission.Enabled = False

Appointment.Show

End If

ErHand:

ErrHandler "Addmission.chameleonButton3_Click() [Appointment]"

End Sub

Private Sub chameleonButton4_Click()

On Error GoTo ErHand

operation.Show

ErHand:

ErrHandler "Addmission.chameleonButton4_Click() [Operation]"

End Sub

Private Sub chameleonButton5_Click()

On Error GoTo ErHand

Discharge_Patient_List.Show

ErHand:

ErrHandler "Addmission.chameleonButton5_Click() [Discharge Patient List]"

End Sub

Private Sub chameleonButton6_Click()

On Error GoTo ErHand

If TxtRegno.Text = "" Then

MsgBox "Please Enter Registration No.", vbInformation

TxtRegno.SetFocus

Exit Sub

End If

If TxtBedNo.Text = "" Then

MsgBox "Please Enter Bed No.", vbInformation

TxtBedNo.SetFocus

Exit Sub

End If

Set rst = New ADODB.Recordset

rst.Open "select * from addmission where refno=" & TxtRegno.Text & "", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

Conn.Execute "insert into addmission (refno,name,catname,Bedno,doa,Status,docincharge,diagnosis,aot) values (" & TxtRegno.Text & ", '" & TxtPatient.Text & "','" & TxtBedCategory.Text & "' , " & TxtBedNo.Text & ",'" & TxtAddmissionDate & "','Admit','" & TxtAttentDoctor.Text & "','" & TxtDiognosis.Text & "','" & TxtAddmissionTime & "')"

Conn.Execute "insert into addmission1 (refno,name,catname,Bedno,doa,Status,docincharge,diagnosis,aot) values (" & TxtRegno.Text & ", '" & TxtPatient.Text & "','" & TxtBedCategory.Text & "' , " & TxtBedNo.Text & ",'" & TxtAddmissionDate & "','Admit','" & TxtAttentDoctor.Text & "','" & TxtDiognosis.Text & "','" & TxtAddmissionTime & "')"

Conn.Execute "update beddetail set status ='Full' where bedno = '" & TxtBedNo.Text & "' and detail = '" & TxtBedCategory.Text & "'"

Conn.Execute "update beddetail set refno =" & Val(TxtRegno.Text) & " where bedno = '" & TxtBedNo.Text & "' and detail = '" & TxtBedCategory.Text & "'"

MsgBox "Patient Admitted! ", vbInformation

rst.Close

Else

MsgBox "Patient is Admitted Already", vbInformation

End If

MSFlexGrid1.Clear

MSFlexGrid1.Rows = 1

MSFlexGrid1.FormatString = "Category |Bed No. | Status | Ref No. | Patient Name | Date of Ad.. |Time of Ad.. | Doctor Inch.. | Diagnosis "

Set rst = New ADODB.Recordset

rst.Open "SELECT catname,bedno,status,refno,name,doa,aot,docincharge,diagnosis FROM addmission where status <> 'Discharge'", Conn, adOpenDynamic, adLockOptimistic

While Not rst.EOF

MSFlexGrid1.AddItem rst!catname & " " & Chr(9) & rst!bedno & " " & Chr(9) & rst!Status & " " & Chr(9) & rst!refno & " " & Chr(9) & rst!Name & " " & Chr(9) & _

rst!doa & " " & Chr(9) & rst!aot & " " & Chr(9) & rst!docincharge & " " & Chr(9) & rst!Diagnosis & " "

rst.MoveNext

Wend

rst.Close

Call gridRefresh

Exit Sub

ErHand:

ErrHandler "Addmission.chameleonButton6_Click() [Admit]"

End Sub

Private Sub chameleonButton7_Click()

On Error GoTo ErHand

Set rst = New ADODB.Recordset

rst.Open "select bedno,catname from addmission where refno=" & Val(registration.TxtRegno.Text) & " ORDER BY DOA desc", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

MsgBox "Patient is not Admitted", vbInformation, "Sifting Problem"

rst.Close

Exit Sub

End If

Dim a As String

Dim b As String

a = rst!bedno & ""

b = rst!catname & ""

rst.Close

Set rst = New ADODB.Recordset

rst.Open "select * from beddetail where detail='" & TxtBedCategory.Text & "' and bedno = '" & TxtBedNo.Text & "' and status = 'Empty'", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

MsgBox "Bed is not empty", vbInformation, "Shifting Problem"

rst.Close

Exit Sub

End If

Set rst1 = New ADODB.Recordset

rst1.Open "select max(doa) from addmission1 where refno=" & Val(Admission.TxtRegno.Text) & " ", Conn, adOpenDynamic, adLockOptimistic

If rst1.EOF = False Then

Conn.Execute "update addmission1 set dod = '" & TxtAddmissionDate & "',dot = '" & TxtAddmissionTime & "' where refno= " & Val(Admission.TxtRegno.Text) & " and doa = '" & Format(rst1.Fields(0), "dd-mmm-yy") & "'"

End If

rst1.Close

i = MsgBox(" Are you Sure to shift the Patient?", vbQuestion + vbYesNo)

If i = 6 Then

Conn.Execute " insert into addmission1 (refno,name,catname,Bedno,doa,Status,docincharge,diagnosis,aot) values (" & TxtRegno.Text & ", '" & TxtPatient.Text & "','" & TxtBedCategory.Text & "' , " & TxtBedNo.Text & ",'" & TxtAddmissionDate & "','Shifted','" & TxtAttentDoctor & "','" & TxtDiognosis.Text & "','" & TxtAddmissionTime & "')"

Conn.Execute "update beddetail set status = 'Full' where detail='" & TxtBedCategory.Text & "' and bedno = '" & TxtBedNo.Text & "'"

Conn.Execute "update beddetail set refno = " & TxtRegno.Text & " where detail='" & TxtBedCategory.Text & "' and bedno = '" & TxtBedNo.Text & "'"

Conn.Execute "update beddetail set status = 'Empty' where detail='" & Trim(b) & "' and bedno = '" & Trim(a) & "'"

Conn.Execute "update beddetail set refno = " & TxtRegno.Text & " where detail='" & Trim(b) & "' and bedno = '" & Trim(a) & "'"

Conn.Execute "update addmission set catname = '" & TxtBedCategory.Text & "',bedno = " & TxtBedNo.Text & " where refno= " & Val(Admission.TxtRegno.Text) & ""

End If

Call gridRefresh

ErHand:

ErrHandler "Addmission.chameleonButton7_Click() [Shift]"

End Sub

Private Sub chameleonButton8_Click()

On Error GoTo ErHand

Dat.Show

ErHand:

ErrHandler "Addmission.chameleonButton8_Click()"

End Sub

Private Sub Command9_Click()

On Error GoTo ErHand

Me.Enabled = False

Load BedDetail

ErHand:

ErrHandler "Addmission.Command9_Click() [Bed]"

End Sub

Private Sub Form_Load()

On Error GoTo ErHand

Me.Top = 100

Me.Left = 2050

TxtAddmissionTime = Time

TxtRegno.Text = registration.TxtRegno.Text

TxtDiognosis.Clear

Set rst = New ADODB.Recordset

rst.Open "select Distinct DiName from DIMast Order by DiName", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then rst.Close: Exit Sub

While Not rst.EOF = True

Me.TxtDiognosis.AddItem rst!DiName

Me.TxtDiognosis.Text = rst!DiName

rst.MoveNext

Wend

Set rst = New ADODB.Recordset

rst.Open "select doa,catname,bedno,diagnosis from addmission where refno=" & registration.TxtRegno.Text & " order by doa desc", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = False Then

'Rst.MoveLast

TxtBedCategory.Text = rst!catname & ""

TxtBedNo.Text = rst!bedno & ""

Me.TxtDiognosis.Text = rst!Diagnosis & ""

Else

rst.Close

End If

MSFlexGrid1.Clear

MSFlexGrid1.Rows = 1

MSFlexGrid1.FormatString = "Category |Bed No. | Status | Ref No. | Patient Name | Date of Ad.. |Time of Ad.. | Doctor Inch.. | Diagnosis "

Set rst = New ADODB.Recordset

rst.Open "SELECT catname,bedno,status,refno,name,doa,aot,docincharge,diagnosis FROM addmission where status <> 'Discharge'", Conn, adOpenDynamic, adLockOptimistic

While Not rst.EOF

MSFlexGrid1.AddItem rst!catname & " " & Chr(9) & rst!bedno & " " & Chr(9) & rst!Status & " " & Chr(9) & rst!refno & " " & Chr(9) & rst!Name & " " & Chr(9) & _

rst!doa & " " & Chr(9) & rst!aot & " " & Chr(9) & rst!docincharge & " " & Chr(9) & rst!Diagnosis & " "

rst.MoveNext

Wend

rst.Close

TxtPatient.Text = registration.TxtTitle + " " + registration.txtfirst + " " + registration.txtmiddle + " " + registration.txtlast

TxtAddmissionDate = registration.TxtRegDate

TxtAttentDoctor.AddItem registration.TxtDoctorIncharge

TxtAttentDoctor.Text = registration.TxtDoctorIncharge

ErHand:

ErrHandler "Addmission.Form_Load"

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo ErHand

registration.Enabled = True

Unload SearchFrm

ErHand:

ErrHandler "Addmission.Form_Unload"

End Sub

Private Sub gridRefresh()

On Error GoTo ErHand

MSFlexGrid1.Clear

MSFlexGrid1.Rows = 1

MSFlexGrid1.Cols = 8

MSFlexGrid1.FormatString = "Category |Bed No. | Status | Ref No. | Patient Name | Date of Ad.. | Time of Ad.. | Doctor Inch.. | Diagnosis "

Set rst = New Recordset

rst.Open "select * from addmission where status ='Shifted' or status='Admit'", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

MsgBox "There is No Record", vbInformation

rst.Close

Exit Sub

Else

While Not rst.EOF

MSFlexGrid1.AddItem rst!catname & " " & Chr(9) & rst!bedno & " " & Chr(9) & rst!Status & " " & Chr(9) & rst!refno & " " & Chr(9) & rst!Name & " " & Chr(9) & _

rst!doa & " " & Chr(9) & rst!aot & " " & Chr(9) & rst!Diagnosis & " "

rst.MoveNext

Wend

End If

ErHand:

ErrHandler "Addmission.GridRefresh()"

End Sub

Private Sub Text1_KeyPress(Index As Integer, 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 TxtAddmissionTime_GotFocus()

TxtAddmissionTime = Time

End Sub

Private Sub TxtBedNo_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

Sponsored Links

Next Chapter 21 Anasthestic