frmipbill.frm

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

txtRoomWardID.Alignment = 0
txtBedID.Alignment = 0

Dim rsCheckStatus As Recordset
Dim rsAddData As Recordset

Set rsCheckStatus = New ADODB.Recordset
Set rsAddData = New ADODB.Recordset
DTPDisDate.Enabled = True

rsCheckStatus.Open "Select * from In_Patient_Discharge where Admission_ID = '" & cmbAdmissionID & " ' ", cnPatients, adOpenDynamic, adLockReadOnly
If rsCheckStatus.EOF = False Then
    txtStatus = "Discharged"
    DTPDisDate = rsCheckStatus(2)
    DTPDisDate.Enabled = False
Else
    txtStatus = "Under Treatements"
End If

rsCheckStatus.Close

rsAddData.Open "Select * from Admission_Details where Admission_ID = '" & cmbAdmissionID & "'", cnPatients, adOpenDynamic, adLockReadOnly

If rsAddData.EOF = False Then
    txtAdmitDate = Format(rsAddData(6), "short date")
    DTPAdmit = Format(txtAdmitDate, "short date")
    txtRoomWardID = rsAddData(3)
    txtBedID = rsAddData(4)
End If
rsAddData.Close
Call FillData
Call MedicineCharges
Call ServiceCharges
Call HospitalCharges
DTPDisDate_Change
End Sub



Private Sub cmbPatient_Click()
    cmbAdmissionID.clear
    Dim ctl As Control
    For Each ctl In Controls
         If TypeOf ctl Is TextBox Then
           ctl.Text = ""
        End If
Next
    addAdmissionID cmbPatient
    
End Sub






Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub Command1_Click()

End Sub

Private Sub cmdDocVisit_Click()
frmDoctorVisit.Show
End Sub

Private Sub cmdMedicine_Click()
frmInPatientOrders.Show
End Sub

Private Sub cmdPayBill_Click()
Dim ct As Control

For Each ctl In Controls
    If TypeOf ctl Is TextBox Then
        If ctl.Text = "" Then
            MsgBox "one of Required Field is missing", vbCritical
            ctl.SetFocus
            Exit Sub
        End If
    End If
Next





If Trim(txtStatus) <> "Discharged" Then
    MsgBox "You Cannot save the bill details until patient discharge", vbInformation
    Exit Sub
End If

If MsgBox("Do you want to save the record and view patient bill?", vbQuestion + vbYesNo) = vbNo Then
    Exit Sub
End If


Dim rsAdmit As Recordset
Set rsAdmit = New ADODB.Recordset

rsAdmit.Open "select * from Patient_Bill where Admission_ID = '" & cmbAdmissionID & "'", cnPatients, adOpenDynamic, adLockReadOnly
If rsAdmit.EOF = False Then
    MsgBox "The information has already stored in the database." & vbCrLf & "You can not add the same record again", vbCritical, "Error Occured"
    rsAdmit.Close
    Exit Sub
End If
rsAdmit.Close


Call SaveData

End Sub

Private Sub cmdServiceCharges_Click()
frmIPServiceDetails.Show
End Sub

Private Sub Command3_Click()

End Sub

Private Sub DTPDisDate_Change()
Dim tot As Double
If txtAdmitDate <> "" Then
 txtRoomCharges = RoomCharge * DateDiff("d", txtAdmitDate, DTPDisDate)
 

tot = Val(txtVisitCharges) + Val(txtService) + Val(txtMedCharges) + Val(txtRoomCharges) + Val(txtHospitalCharges)
txtTotal = tot + (Val(txtVat) * tot / 100)
txtNetValue = Format(txtTotal - (Val(txtTotal) * Val(txtDiscount)), "Standard")
 
End If
End Sub

Private Sub Form_Load()

If frmIPDischarge.FromDischarge = True Then
     Call addPatientID
     
     cmbPatient = frmIPDischarge.strPatID
     cmbPatient_Click
     
     cmbAdmissionID = frmIPDischarge.strAdmitID
     cmbAdmissionID_Click
    
    frmIPDischarge.FromDischarge = False
    Exit Sub
End If


Call addPatientID
DTPDisDate = Date
Call Functions.DisableMenu
End Sub

Private Sub addPatientID()

Dim rsAddPatient As Recordset
Set rsAddPatient = New ADODB.Recordset

rsAddPatient.Open "Select * from In_Patient_Details", cnPatients, adOpenDynamic, adLockReadOnly

While rsAddPatient.EOF = False
cmbPatient.AddItem (rsAddPatient(0))
rsAddPatient.MoveNext

Wend

rsAddPatient.Close
End Sub

Private Sub addAdmissionID(AddID As String)
Dim rsAddID As Recordset
Set rsAddID = New ADODB.Recordset

rsAddID.Open "Select * from Admission_Details where Patient_ID = '" & AddID & "'", cnPatients, adOpenDynamic, adLockReadOnly

While rsAddID.EOF = False
cmbAdmissionID.AddItem rsAddID(0)
rsAddID.MoveNext
Wend

rsAddID.Close
End Sub

Private Sub FillData()
Dim chk As Integer
Dim DocCharge As Double
Dim rsFill As Recordset
Set rsFill = New ADODB.Recordset
Dim rsDoc As Recordset
Set rsDoc = New ADODB.Recordset
Dim rsRoom As Recordset
Set rsRoom = New ADODB.Recordset


chk = 0
rsFill.Open "Select * from Visit_Details where Admission_ID = '" & cmbAdmissionID & "'", cnPatients, adOpenDynamic, adLockReadOnly

While rsFill.EOF = False
    rsDoc.Open "Select * from Doctor_Details where Doctor_ID = '" & rsFill(3) & "'", cnPatients, adOpenDynamic, adLockReadOnly
        If rsDoc.EOF = False Then
            DocCharge = DocCharge + Val(rsDoc(11))
        End If
    rsDoc.Close
    rsFill.MoveNext
Wend
rsFill.Close
txtVisitCharges = Format(DocCharge, "Standard")


rsFill.Open "Select * from Room_Details where Room_ID = '" & Trim(txtRoomWardID) & "'", cnPatients, adOpenDynamic, adLockReadOnly
    If rsFill.EOF = False Then
        rsRoom.Open "Select * from Room_Types Where Room_Type= '" & rsFill(1) & "'", cnPatients, adOpenDynamic, adLockReadOnly
            If rsRoom.EOF = False Then
                RoomCharge = Val(rsRoom(1))
                txtRoomCharges = Format(Val(rsRoom(1)) * DateDiff("d", txtAdmitDate, DTPDisDate), "Standard")
                chk = 1
            Else
                MsgBox "Database Error" & vbCrLf & "Please Contact Database Administrator", vbCritical
                Exit Sub
            End If
    End If
rsFill.Close


rsFill.Open "Select * from Ward_Details where Ward_ID = ' " & Trim(txtRoomWardID) & "'", cnPatients, adOpenDynamic, adLockReadOnly
    If rsFill.EOF = False Then
        If chk = 1 Then
            MsgBox "Data Error.. Please Contact Database Administrator", vbCritical
            Exit Sub
        End If
        RoomCharge = Val(rsFill(2))
        txtRoomCharges = Format(Val(rsFill(2)) * DateDiff("d", txtAdmitDate, DTPDisDate), "Standard")
    End If
rsFill.Close

End Sub


Private Sub MedicineCharges()
Dim amount As Double
Dim rsMed As Recordset
Set rsMed = New ADODB.Recordset
Dim rsMedDetails As Recordset
Set rsMedDetails = New ADODB.Recordset

If cmbAdmissionID = "" Then
    Exit Sub
End If


rsMed.Open "Select * from InPatient_Orders where AdmissionID = '" & cmbAdmissionID & "'", cnPatients, adOpenDynamic, adLockReadOnly
    
    While rsMed.EOF = False
        rsMedDetails.Open "Select * from InPatient_Order_Details where OrderID = '" & rsMed(0) & "'", cnPatients, adOpenDynamic, adLockReadOnly
            While rsMedDetails.EOF = False
                amount = amount + ((rsMedDetails(4) * Val(rsMedDetails(5))) - Val(rsMedDetails(6)))
                rsMedDetails.MoveNext
            Wend
        rsMed.MoveNext
        rsMedDetails.Close
    Wend

rsMed.Close


txtMedCharges = Format(amount, "Standard")

End Sub

Private Sub ServiceCharges()
Dim rsSer As Recordset
Dim amount As Double
Set rsSer = New ADODB.Recordset

If cmbAdmissionID = "" Then
    Exit Sub
End If

rsSer.Open "Select * from InPatient_Services where AdmissionID = '" & cmbAdmissionID & "'", cnPatients, adOpenDynamic, adLockReadOnly

While rsSer.EOF = False
    amount = amount + rsSer(9)
    rsSer.MoveNext
Wend

rsSer.Close

txtService = Format(amount, "Standard")

End Sub

Private Sub HospitalCharges()
Dim rsHospital As Recordset
Set rsHospital = New ADODB.Recordset
Dim tot As Double
rsHospital.Open "Select * from Hospital_Charges", cnPatients, adOpenDynamic, adLockReadOnly

If rsHospital.EOF = False Then

txtHospitalCharges = Format(rsHospital(4), "Standard")
txtVat = rsHospital(2)
tot = Val(txtVisitCharges) + Val(txtService) + Val(txtMedCharges) + Val(txtRoomCharges) + Val(txtHospitalCharges)
txtTotal = tot + (rsHospital(2) * tot / 100)

txtDiscount = rsHospital(3)

txtNetValue = Format(txtTotal - (Val(txtTotal) * rsHospital(3)), "Standard")


End If

rsHospital.Close
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Functions.EnableMenu
End Sub


Private Sub SaveData()

    Dim rsAddPatient As Recordset
    Dim MID As String
    Set rsAddPatient = New ADODB.Recordset
  
    MID = Functions.UID(6, "IPBID_")
    rsAddPatient.Open " Select * from Patient_Bill", cnPatients, adOpenDynamic, adLockReadOnly
    While rsAddPatient.EOF = False
        If rsAddPatient(0) = MID Then
            MID = Functions.UID(6, "IPBID_")
            rsAddPatient.MoveFirst
        End If
    rsAddPatient.MoveNext
    Wend
    rsAddPatient.Close


    Dim rsAddBill As Recordset
    Set rsAddBill = New ADODB.Recordset
    
    rsAddBill.Open "Patient_Bill", cnPatients, adOpenDynamic, adLockPessimistic
    
    rsAddBill.AddNew
        rsAddBill(0) = MID
        rsAddBill(1) = cmbPatient
        rsAddBill(2) = cmbAdmissionID
        rsAddBill(3) = Format(DTPDisDate, "short Date")
        rsAddBill(4) = Val(txtVisitCharges)
        rsAddBill(5) = Val(txtMedCharges)
        rsAddBill(6) = Val(txtService)
        rsAddBill(7) = Val(txtRoomCharges)
        rsAddBill(8) = Val(txtHospitalCharges)
        rsAddBill(9) = Val(txtDiscount)
        rsAddBill(10) = Format(txtNetValue, "Currency")
        rsAddBill(11) = ""
    rsAddBill.Update

MsgBox "Record Saved Sucessfully", vbInformation

rsAddBill.Close

End Sub