Next Chapter 35 Discharge Ticket

Discharge Ticket

Dim rst As New ADODB.Recordset

Private Sub cmd1_Click()

Unload Me

registration.Show

End Sub

Private Sub Cmd2_Click()

Me.TxtAge = ""

Me.TxtRegno = ""

Me.TxtRegno.Locked = False

Me.TxtName = ""

Me.TxtSex = ""

Me.TxtBed = ""

Me.TxtCategory = ""

Combo4(0) = ""

Text7 = ""

Text8 = ""

Text9 = ""

Command1.Enabled = False

Command2.Enabled = False

Command3.Enabled = False

Command4.Enabled = False

End Sub

Private Sub Combo2_Click()

Text9 = Text9 + " " + Combo2 + vbCrLf

End Sub

Private Sub Command2_Click()

Dim s As String

On Error GoTo ErHand

If Command2.Caption = "&Edit" Then

s = InputBox("Enter the Reg. no. to update.")

If s = "" Then

Exit Sub

End If

Set rst = New Recordset

rst.Open "select * from DischargeTicket where regno = " & s & " ", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

MsgBox "No Record Found", vbInformation

rst.Close

Exit Sub

End If

TxtRegno = rst!regno

TxtName = rst!Name

TxtAge = rst!Age

TxtSex = rst!sex

TxtBed = rst!bno

TxtCategory = rst!bcateg

TxtAdmissionDate = rst!doa

TxtDischargeDate = rst!dod

TxtDischargeTime = rst!tod

TxtAdmissionTime = rst!toa

Combo4(0).Text = rst!diag

Text7 = Replace(rst!invest, "@", vbTab)

Text8 = rst!treat

Text9 = rst!advise

End If

If Command2.Caption = "&Update" Then

s = TxtRegno

Conn.Execute "update DischargeTicket set name='" & TxtName & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set age =" & TxtAge & " where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set sex ='" & TxtSex & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set dname ='" & Combo1(0) & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set doa='" & TxtAdmissionDate & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set toa='" & TxtAdmissionTime & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set bno =" & TxtBed & " where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set bcateg ='" & TxtCategory & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set dod ='" & TxtDischargeDate & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set tod ='" & TxtDischargeTime & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set diag ='" & Combo4(0) & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set invest ='" & Text7 & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set treat ='" & Text8 & "' where regno=" & Val(s) & ""

Conn.Execute "update DischargeTicket set advise ='" & ChangeStr(Text9) & "' where regno=" & Val(s) & ""

End If

If Command2.Caption = "&Edit" Then

Command2.Caption = "&Update"

Else

If Command2.Caption = "&Update" Then

Command2.Caption = "&Edit"

End If

End If

ErHand:

ErrHandler "DischargeTicket.Command2_Click() [Edit]"

End Sub

Private Sub Command1_Click()

On Error GoTo ErHand

Dim a As String

a = InputBox("Enter the Refference No. to Delete")

Set rst = New ADODB.Recordset

rst.Open "select * from DischargeTicket where regno = " & Val(a) & "", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

MsgBox "No Record Matched with Registration No", vbInformation

rst.Close

Exit Sub

Else

i = MsgBox("Are you Sure ! To Delete the Record.?", vbYesNo + vbQuestion)

End If

If i = 6 Then

Conn.Execute "delete from DischargeTicket where regno = " & Val(a) & ""

MsgBox "Record ... Deleted!"

Else

Exit Sub

End If

ErHand:

ErrHandler "DischargeTicket.Command1_Click() [Delete]"

End Sub

Private Sub Command3_Click()

On Error GoTo ErHand

If TxtRegno.Text = "" Then MsgBox "Registration Should Not Be Empty", vbExclamation, App.Title: Exit Sub

Set rst = New ADODB.Recordset

rst.Open "select * from dischargeticket where regno=" & TxtRegno & "", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = False Then

MsgBox " This record already exist !", vbInformation

Exit Sub

End If

rst.AddNew

rst.Fields(0) = TxtRegno.Text

rst.Fields(1) = TxtName.Text

rst.Fields(2) = Val(TxtAge.Text)

rst.Fields(3) = TxtSex.Text

rst.Fields(4) = Combo1(0).Text

rst.Fields(5) = TxtAdmissionDate

rst.Fields(6) = TxtBed.Text

rst.Fields(7) = TxtCategory.Text

rst.Fields(8) = TxtDischargeDate

rst.Fields(9) = Combo4(0).Text

rst.Fields(10) = Replace(StrConv(Text7.Text, vbProperCase), CStr(vbTab), "@")

rst.Fields(11) = Text8.Text

rst.Fields(12) = ChangeStr(Text9.Text)

rst.Fields(13) = TxtAdmissionTime

rst.Fields(14) = TxtDischargeTime

rst.UpdateBatch

Set rst = Nothing

Call Cmd2_Click

ErHand:

ErrHandler "DischargeTicket.Command3_Click() [Save]"

End Sub

Private Sub Command4_Click()

On Error GoTo ErHand

DataEnvironment1.Recordsets.Item("Discharge_ticket").Open "select * from DischargeTicket where regno =" & Val(TxtRegno) & "", Conn, adOpenDynamic, adLockOptimistic

Disticket.Sections(1).Controls.Item("label57").Caption = hos_name

Disticket.Sections(1).Controls.Item("label58").Caption = hos_add

Disticket.Show

ErHand:

ErrHandler "DischargeTicket.Command4_Click() [Print]"

End Sub

Private Sub Form_Load()

On Error GoTo ErHand

Me.Top = (MDIForm1.ScaleHeight - Me.Height) / 2

Me.Left = (MDIForm1.ScaleWidth - Me.Width) / 2

Me.TxtDischargeDate = Date

TxtDischargeTime = Time

Me.TxtRegno = registration.TxtRegno

Me.TxtAge = registration.TxtAge

Me.TxtSex = registration.TxtSex

Me.TxtName = registration.TxtTitle + " " + registration.txtfirst + " " + registration.txtmiddle + " " + registration.txtlast

Me.Combo1(0) = registration.TxtDoctorIncharge.Text

Set rst = New ADODB.Recordset

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

If rst.EOF = False Then

'Rst.MoveLast

Me.TxtCategory = rst!catname & ""

Me.TxtAdmissionDate = rst!doa & ""

Me.TxtAdmissionTime = rst!aot & ""

Me.TxtBed = rst!bedno & ""

Me.Combo4(0) = rst!Diagnosis & ""

Else

rst.Close

End If

Set rst = New Recordset

rst.Open "select * from remark ", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = False Then

Do While Not rst.EOF = True

Combo2.AddItem rst!remark1

rst.MoveNext

Loop

End If

rst.Close

Call TxtRegNo_KeyPress(13)

ErHand:

ErrHandler "DischargeTicket.Form_Load()"

End Sub

Private Sub Form_Unload(Cancel As Integer)

registration.Enabled = True

End Sub

Private Sub TxtRegNo_KeyPress(KeyAscii As Integer)

On Error GoTo ErHand

If TxtRegno = "" Then

Exit Sub

End If

If KeyAscii = vbKeyReturn Then

Set rst = New Recordset

rst.Open "select * from Hospital where Registration = " & TxtRegno & " ", Conn, adOpenDynamic, adLockOptimistic

If rst.EOF = True Then

MsgBox "No Record Found", vbInformation

rst.Close

Exit Sub

End If

TxtName = rst.Fields(6) & " " + rst.Fields(7) & " " + rst.Fields(8) & " "

TxtAge = rst!Age & ""

TxtSex = rst!sex & ""

rst.Close

Set rst = New Recordset

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

If rst.EOF = True Then

rst.Close

Exit Sub

End If

TxtBed = rst.Fields("bedno") & " "

TxtCategory = rst.Fields("catname") & ""

Combo1(0) = rst.Fields("docincharge")

TxtAdmissionDate = Format(rst.Fields("doa"), "dd-MMM-yyyy")

TxtAdmissionTime = IIf(IsNull(rst.Fields("aot")) = True, "12:00", rst.Fields("aot"))

TxtDischargeDate = IIf(IsNull(rst.Fields("dod")) = True, Format(Date, "dd-MMM-yyyy"), rst.Fields("dod"))

Me.TxtDischargeTime = IIf(IsNull(rst.Fields("dot")) = True, "12:00", rst.Fields("dot"))

Combo4(0) = rst.Fields("diagnosis")

Call Investigation

Command1.Enabled = True

Command2.Enabled = True

Command3.Enabled = True

Command4.Enabled = True

If IsNull(rst.Fields("dod")) = True Then

MsgBox "First Discharge The Patient", vbInformation

Command1.Enabled = False

Command2.Enabled = False

Command3.Enabled = False

Command4.Enabled = False

rst.Close

Exit Sub

End If

End If

ErHand:

ErrHandler "DischargeTicket.TxtRegNo_KeyPress()"

End Sub

Private Sub Investigation()

On Error GoTo ErHand

Dim STR As String

Dim RstInv As New ADODB.Recordset

RstInv.Open "select * from datewiseinvest where regno=" & Val(TxtRegno) & "", Conn, adOpenDynamic, adLockOptimistic

If RstInv.EOF = True Then

RstInv.Close

Exit Sub

End If

Do While (RstInv.EOF = False)

If Not RstInv!invest_date = "" Then

s = s & vbTab & vbTab & "Date :" + Format(RstInv!invest_date, "dd/MM/yyyy") & vbCrLf

End If

If Not RstInv!XRAY = "" Then

s = s + "XRAY :" + CStr(RstInv!XRAY) & vbTab

End If

If Not RstInv!EDD = "" Then

s = s + "EDD :" + RstInv!EDD & vbTab

End If

If Not RstInv!HIV = "" Then

s = s + "HIV :" + RstInv!HIV & vbCrLf

End If

If Not RstInv!HBS = "" Then

s = s + "HBsAg :" + RstInv!HBS & vbTab

End If

If Not RstInv!GPRH = "" Then

s = s + "GpRH :" + RstInv!GPRH & vbTab

End If

If Not RstInv!VDRL = "" Then

s = s + "VDRL :" + RstInv!VDRL & vbCrLf

End If

If Not RstInv!Gravindex_text = "" Then

s = s + "Gravindex Test :" + RstInv!Gravindex_text & vbTab

End If

If Not RstInv!PPBS = "" Then

s = s + "PPBS :" + RstInv!PPBS & vbTab

End If

If Not RstInv!FBS = "" Then

s = s + "FBS :" + RstInv!FBS & vbCrLf

End If

If Not RstInv!MH = "" Then

s = s + "MH :" + RstInv!MH & vbTab

End If

If Not RstInv!HB = "" Then

s = s + "HB % :" + RstInv!HB & vbTab

End If

If Not RstInv!OBST = "" Then

s = s + "OBST :" + RstInv!OBST & vbCrLf

End If

If Not RstInv!URINE = "" Then

s = s + "URINE :" + RstInv!URINE & vbTab

End If

If Not RstInv!USG = "" Then

s = s + "USG :" + RstInv!USG & vbTab

End If

If Not RstInv!DIABETES = "" Then

s = s + "DIABETES :" + RstInv!DIABETES & vbCrLf

End If

If Not RstInv!HYPER = "" Then

s = s + "HYPERTENSION :" + RstInv!HYPER & vbTab

End If

If Not RstInv!GENERALcase = "" Then

s = s + "GENERAL EXAMINATION :" + RstInv!GENERALcase & vbTab

End If

If Not RstInv!Pcase = "" Then

s = s + "CASE HISTORY :" + RstInv!Pcase & vbCrLf

End If

Text7 = Text7 + s & vbCrLf

Text7.Text = StrConv(Text7.Text, vbProperCase)

s = ""

RstInv.MoveNext

Loop

ErHand:

ErrHandler "DischargeTicket.Investigation()"

End Sub