frmopserbillpayments.frm

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

         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   195
      Left            =   420
      TabIndex        =   25
      Top             =   3240
      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            =   7920
      TabIndex        =   24
      Top             =   3240
      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            =   6030
      TabIndex        =   23
      Top             =   6690
      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            =   1440
      TabIndex        =   22
      Top             =   6690
      Width           =   1905
   End
End
Attribute VB_Name = "frmOPSerBillPayments"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RowNo As Integer
Private Sub cmbBillNo_Click()
Dim ctl As Control

For Each ctl In Controls
    If TypeOf ctl Is TextBox And TypeOf ctl Is ComboBox Then
    ctl.Text = ""
    End If
Next
MFG.clear
Refresh_Data

Dim rsPay As Recordset
Set rsPay = New ADODB.Recordset
Dim rsBill As Recordset
Set rsBill = New ADODB.Recordset


Dim i As Integer
Dim s As Double


If cmbBillNo.Text = "" Then
    Exit Sub
End If

rsBill.Open "Select * from Service_Appointment_Bill where Appointment_Bill_ID = '" & cmbBillNo & "'", cnPatients, adOpenDynamic, adLockPessimistic

If rsBill.EOF = True Then
    rsBill.Close
Else
    txtBillDate.Text = Format(rsBill!Bill_Date, "dd-MMM-yyyy")
    'txtBillTerms.Text = rsBill!CreditYN
    txtBillAmt.Text = rsBill!Grand_Total
    txtDiscount.Text = rsBill!Discount
    txtNetValue.Text = rsBill!Net_Value
    
    'rsPay.open "Select count(*) from OPBillDetails where BillId=" & cmbBillNo.ItemData(cmbBillNo.ListIndex))
    'If rsPay.EOF = True Then
        'rsPay.Close
    'Else
        'txtBillItems.Text = rsPay(0)
        'rsPay.Close
    'End If
    rsBill.Close
End If

rsBill.Open "Select * from Service_Appointment_Bill_Payment where Appointment_Bill_ID='" & cmbBillNo & "'", 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













End Sub

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

Dim i As Integer
i = 0
If cmbPatientID.Text = "" Then
    Exit Sub
End If
cmbBillNo.clear

rsBill.Open "Select * from Service_Appointment_Bill where Patient_ID ='" & cmbPatientID.Text & "'", cnPatients, adOpenDynamic, adLockPessimistic
If rsBill.EOF = True Then
    rsBill.Close
Else
    Do While rsBill.EOF = False
        cmbBillNo.AddItem (rsBill(0))
        rsBill.MoveNext
        i = i + 1
    Loop
    rsBill.Close
End If

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, "PayID_")

    rsAddBill.Open "Select * from Service_Appointment_Bill_Payment", cnPatients, adOpenKeyset, adLockPessimistic
      
    While rsAddBill.EOF = False
        If rsAddBill(0) = BillPayID Then
            BillPayID = Functions.UID(6, "PayID_")
            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 Service_Appointment_Bill_Payment values('" & BillPayID & "','" & cmbBillNo & "'," & 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 Service_Appointment_Bill_Payment values('" & BillPayID & "','" & cmbBillNo & "'," & 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 Command1_Click()
Dim strReport As String
Dim strTXT As String
strTXT = cmbBillNo.Text
strReport = App.Path & "\Reports\OPSerInvoice.rpt"


SInvoice.ReportFileName = App.Path & "\Reports\OPSerInvoice.rpt"
SInvoice.DiscardSavedData = True
SInvoice.ReplaceSelectionFormula ("{Service_Appointment_Bill_Payment.Appointment_Bill_ID} = '" & strTXT & "'")


SInvoice.WindowState = crptMaximized
SInvoice.Action = 1




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
    Me.WindowState = vbMaximized
    Dim i As Integer
Dim rsBill As Recordset

Set rsBill = New ADODB.Recordset
i = 0
rsBill.Open "Select * from Patient_Details where Patient_ID in (Select Distinct Patient_ID from Service_Appointment_Bill)", cnPatients, adOpenDynamic, adLockPessimistic
If rsBill.EOF = True Then
    rsBill.Close
Else
    Do While rsBill.EOF = False
        cmbPatientID.AddItem (rsBill(0))
        rsBill.MoveNext
        i = i + 1
    Loop
    rsBill.Close
End If
    
    
    
    
    
    Refresh_Data
    RowNo = 0
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 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



Private Sub Form_Unload(Cancel As Integer)
Call Functions.EnableMenu
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(txtCustomerAdv.Text) <> 0 Then
        'If Val(txtCustomerAdv.Text) > Val(txtBalAmt.Text) Then
            'txtCustomerAdv.Text = Val(txtCustomerAdv.Text) - Val(txtBalAmt.Text)
            'txtBalAdv.Text = Val(txtCustomerAdv.Text) - Val(txtBalAmt.Text)
            'txtBalAmt.Text = "0"
        'Else
            'txtBalAmt.Text = Round(Val(txtBalAmt.Text) - Val(txtCustomerAdv.Text), 2)
            'txtCustomerAdv.Text = "0"
            'txtBalAdv.Text = "0"
        'End If
    'Else
        'txtBalAdv.Text = "0"
    'End If
    If Val(txtBalAmt.Text) = 0 Then
        txtBillStatus.Text = "Paid"
    Else
        txtBillStatus.Text = "Un-Paid"
    End If


End If

End Sub