Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
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