frmipbillpayments.frm

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

      Y1              =   1380
      Y2              =   1380
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FFFFFF&
      BorderColor     =   &H00C0FFFF&
      BorderWidth     =   2
      Height          =   1305
      Left            =   360
      Shape           =   4  'Rounded Rectangle
      Top             =   2400
      Width           =   11565
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      BackColor       =   &H00E0E0E0&
      BackStyle       =   0  'Transparent
      Caption         =   "BILL PAYMENT DETAILS :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   480
      TabIndex        =   25
      Top             =   3900
      Width           =   2385
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00C0FFFF&
      BorderWidth     =   2
      X1              =   360
      X2              =   12000
      Y1              =   7095
      Y2              =   7080
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Bill Amt :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   660
      TabIndex        =   24
      Top             =   3120
      Width           =   870
   End
   Begin VB.Label Label6 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Net Value :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   8160
      TabIndex        =   23
      Top             =   3120
      Width           =   1050
   End
   Begin VB.Label Label13 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Balance :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   6870
      TabIndex        =   22
      Top             =   6570
      Width           =   885
   End
   Begin VB.Label Label12 
      AutoSize        =   -1  'True
      BackColor       =   &H00C96C59&
      BackStyle       =   0  'Transparent
      Caption         =   "Total Amount Paid :"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   2280
      TabIndex        =   21
      Top             =   6570
      Width           =   1905
   End
End
Attribute VB_Name = "frmIPBillPayments"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RowNo As Integer




Private Sub cmbAdmitID_Click()
Dim rsAddBillID As Recordset
Set rsAddBillID = New ADODB.Recordset
Dim rsBill As Recordset
Set rsBill = New ADODB.Recordset

Dim i As Integer
Dim s As Double

rsAddBillID.Open "select * from Patient_Bill Where Admission_ID = '" & cmbAdmitID & "'", cnPatients, adOpenDynamic, adLockReadOnly

If rsAddBillID.EOF = True Then
    MsgBox "Cannot Pay the bill unitl patient discharge", vbCritical, "An Error Occured"
    rsAddBillID.Close
    Exit Sub
ElseIf rsAddBillID.RecordCount = 1 Then
    txtBillNo = rsAddBillID(0)
    txtNetValue = rsAddBillID![Net_Value]
    txtDiscount = rsAddBillID![Discount]
    
    txtBillAmt = Val(txtNetValue) + (Val(txtNetValue) * Val(txtDiscount))
    
    
rsBill.Open "Select * from Patient_Bill_Payment where PatientBill_ID='" & txtBillNo & "'", cnPatients, adOpenDynamic, adLockPessimistic
If rsBill.EOF = True Then
    rsBill.Close
    txtPaidAmt.Text = "0"
    txtBal.Text = txtNetValue.Text
Else
    i = 1
    s = 0
    MFG.Rows = 2
    Do While rsBill.EOF = False
        MFG.TextMatrix(i, 0) = i
        MFG.TextMatrix(i, 1) = rsBill!Amount_Paid
        MFG.TextMatrix(i, 2) = Format(rsBill!Paid_Date, "dd-MMM-yyyy")
        MFG.TextMatrix(i, 3) = rsBill!Payment_Type
        If IsNull(rsBill!CheckNo) = False Then
            MFG.TextMatrix(i, 4) = rsBill!CheckNo
        End If
        If IsNull(rsBill!CheckDate) = False Then
            MFG.TextMatrix(i, 5) = rsBill!CheckDate
        End If
        If IsNull(rsBill!Bank) = False Then
            MFG.TextMatrix(i, 6) = rsBill!Bank
        End If
        s = s + Val(rsBill!Amount_Paid)
        rsBill.MoveNext
        i = i + 1
        MFG.Rows = MFG.Rows + 1
    Loop
    rsBill.Close
    txtPaidAmt.Text = s
    txtBal.Text = Round(Val(txtNetValue.Text) - Val(txtPaidAmt.Text), 2)
End If
RowNo = MFG.Rows - 1

txtPayingAmt.SetFocus

    
    
    
    
    
    
    
    
    
    
    
    
    
   
ElseIf rsAddBillID.RecordCount > 1 Then
    MsgBox "Error", vbCritical
    rsAddBillID.Close
    Exit Sub
End If



End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdSave_Click()
Dim str1 As String
Dim BillPayID As String
Dim rsAddBill As New Recordset


If txtPayingAmt.Text = "" Then
    MsgBox "Paying Amount Not Found...", vbCritical + vbOKOnly
    txtPayingAmt.SetFocus
    Exit Sub
End If

If optCash.Value = True Then
    str1 = "CASH"
ElseIf optDD.Value = True Then
    str1 = "Credit Card"
ElseIf optCheque.Value = True Then
    str1 = "Cheque"
Else
    str1 = "Others"
End If


    Set rsAddBill = New ADODB.Recordset
    BillPayID = Functions.UID(6, "IPBPay_")

    rsAddBill.Open "Select * from Patient_Bill_Payment", cnPatients, adOpenKeyset, adLockPessimistic
      
    While rsAddBill.EOF = False
        If rsAddBill(0) = BillPayID Then
            BillPayID = Functions.UID(6, "IPBPay_")
            rsAddBill.MoveFirst
            
        Else
            
        End If
      
    rsAddBill.MoveNext
    
    Wend




If MsgBox("Confirm To Save Bill Information ?", vbQuestion + vbYesNo) = vbYes Then
   
    'cnPatients.BeginTrans
    
    If optCash.Value = True Then
        cnPatients.Execute ("Insert into Patient_Bill_Payment values('" & BillPayID & "','" & txtBillNo & "'," & Val(txtPayingAmt.Text) & ",'" & Format(dtpPayDate.Value, "mm/dd/yy") & "','" & str1 & "',Null,Null,Null)")
        MFG.TextMatrix(RowNo, 0) = RowNo
        MFG.TextMatrix(RowNo, 1) = Val(txtPayingAmt.Text)
        MFG.TextMatrix(RowNo, 2) = Format(dtpPayDate.Value, "dd-MMM-yyyy")
        MFG.TextMatrix(RowNo, 3) = str1
        RowNo = RowNo + 1
        MFG.Rows = MFG.Rows + 1
    Else
        If txtDDNo.Text = "" Or cmbBank.Text = "" Then
            MsgBox "Check Number or Bank Name Not Found...", vbCritical + vbOKOnly
            txtDDNo.SetFocus
            Exit Sub
        End If
        Debug.Print BillPayID
        Debug.Print cmbBillNo
        Debug.Print txtPayingAmt
        Debug.Print dtpPayDate
        Debug.Print str1
        Debug.Print txtDDNo
        Debug.Print dtpDDDate
        Debug.Print cmbBank
        
        
        cnPatients.Execute ("Insert into Patient_Bill_Payment values('" & BillPayID & "','" & txtBillNo & "'," & Val(txtPayingAmt.Text) & ",#" & Format(dtpPayDate.Value, "short date") & "#,'" & str1 & "','" & txtDDNo.Text & "',#" & Format(dtpDDDate.Value, "short date") & "#,'" & cmbBank.Text & "')")
        MFG.TextMatrix(RowNo, 0) = RowNo
        MFG.TextMatrix(RowNo, 1) = Val(txtPayingAmt.Text)
        MFG.TextMatrix(RowNo, 2) = Format(dtpPayDate.Value, "dd-MMM-yyyy")
        MFG.TextMatrix(RowNo, 3) = str1
        MFG.TextMatrix(RowNo, 4) = txtDDNo.Text
        MFG.TextMatrix(RowNo, 5) = Format(dtpDDDate.Value, "dd-MMM-yyyy")
        MFG.TextMatrix(RowNo, 6) = cmbBank.Text
        RowNo = RowNo + 1
        MFG.Rows = MFG.Rows + 1
    End If
   Call Txt_Clear
    txtPayingAmt.SetFocus
    'cnPatients.CommitTrans


End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 22 Then KeyAscii = 0: Exit Sub
    KeyAscii = DataEntryValidation(KeyAscii, ActiveControl.Tag)
End Sub

Private Sub Form_Load()
Call Functions.DisableMenu
dtpPayDate = Date



txtBillDate = Date
Call addPatientID
Call GenerateBillID
Call FinalBillAmount
Refresh_Data
RowNo = 0

End Sub

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

Private Sub GenerateBillID()
    Dim rsAddPatient As Recordset
    Dim PID As String
    Set rsAddPatient = New ADODB.Recordset
  
    PID = Functions.UID(6, "IPBillID_")
    rsAddPatient.Open " Select * from Patient_Bill_Payment", cnPatients, adOpenDynamic, adLockPessimistic
    While rsAddPatient.EOF = False
        If rsAddPatient(0) = PID Then
            ID = True
            PID = Functions.UID(6, "IPBillID_")
            rsAddPatient.MoveFirst
        Else
            ID = False
        End If
    rsAddPatient.MoveNext
    Wend
    rsAddPatient.Close
    txtPayNo = PID


End Sub

Private Sub FinalBillAmount()
Debug.Print "as"
End Sub

Private Sub addPatientID()

Dim rsAddPatient As Recordset
Set rsAddPatient = New ADODB.Recordset

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

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

Wend

rsAddPatient.Close
End Sub
Private Sub Refresh_Data()

dtpPayDate = Date

MFG.clear
MFG.ColWidth(0) = 1000
MFG.ColAlignment(0) = 4
For i = 1 To 6 Step 1
    MFG.ColWidth(i) = 2000
    MFG.ColAlignment(i) = 4
Next i
MFG.TextMatrix(0, 0) = "NO"
MFG.TextMatrix(0, 1) = "AMOUNT PAID"
MFG.TextMatrix(0, 2) = "PAID DATE"
MFG.TextMatrix(0, 3) = "PAY TYPE"
MFG.TextMatrix(0, 4) = "CREDIT CARD/CHEQUE NO"
MFG.TextMatrix(0, 5) = "CHEQUE DATE"
MFG.TextMatrix(0, 6) = "BANK"
End Sub

Private Sub txtPayingAmt_LostFocus()
If txtPayingAmt.Text <> "" Then
    If Val(txtPayingAmt.Text) = 0 Then
        MsgBox "Paying Amount Cannot Be Zero...", vbInformation + vbOKOnly
        txtPayingAmt.SetFocus
        Exit Sub
    End If
    If Val(txtPayingAmt.Text) > Val(txtBal.Text) Then
        MsgBox "Paying Amount Cannot Be Greater Than Balance Amount...", vbCritical + vbOKOnly
        txtPayingAmt.Text = ""
        txtPayingAmt.SetFocus
        Exit Sub
    End If
     txtBalAmt.Text = Round((Val(txtBal.Text) - Val(txtPayingAmt.Text)), 2)
 
    If Val(txtBalAmt.Text) = 0 Then
        txtBillStatus.Text = "Paid"
    Else
        txtBillStatus.Text = "Un-Paid"
    End If
End If
End Sub

Private Sub Txt_Clear()
Dim i As Integer
Dim s As Double
s = 0
txtPayingAmt.Text = ""
txtBalAmt.Text = ""
'txtBalAdv.Text = ""
txtBillStatus.Text = ""
txtDDNo.Text = ""

For i = 1 To MFG.Rows - 2 Step 1
  s = s + Val(MFG.TextMatrix(i, 1))
  Debug.Print MFG.TextMatrix(i, 1)
Next i
txtPaidAmt.Text = s
txtBalAmt.Text = Round(Val(txtBal.Text) - Val(txtPaidAmt.Text), 2)
txtBal.Text = Round(Val(txtNetValue.Text) - Val(txtPaidAmt.Text), 2)
txtBalAmt = ""
End Sub