Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
Public Function getFeeBalance(passedWriteTmpPmntRecs As Long) As Double ' getFeeBalance = 0 ' ' This routine matches fee payments against fees with a balance due. Prior to this routine ' ' Property specific Fee payments have been loaded into into 'tblzTmpWk_tblPayments_Fees_Sub_Local' ' ' Property specific Fee records have been loaded into 'tblzTmpWk_tblTaxRecs_Fees_Local' ' ' Prior to processing the record are sorted into order by FeePayment Priority (Court Costs are always last) and Fee Date, oldest first ' ' The fee payments are applied in 3 passes. ' First Pass matches fee payments against fee records based on GRB Fee Desc, which is the long more specific description. ' Second Pass matches fee payments against fee records based on COP Fee Desc, which is the short less specific. ' Third pass just applies any remaining payment balances to the fees in the order they ares sorted until all payments havbe been applied. ' ' Lastly, if we are doing this for payment distribution purposes records are written to the table 'tblzTmpWk_TaxRecFees_BalDue_Local' at the end ' ' ' First every payment record must set the 'PaymentWorkingBalance' to the FeePaymentAmount since it always defaults ' to zero when the table is loaded ' updateString = "Update tblzTmpWk_tblPayments_Fees_Sub_Local " & _ " SET [PaymentWorkingBalance] = [FeePayment] " DoCmd.SetWarnings False DoCmd.RunSQL updateString ' ' Also ' ' First every fee record must set the 'FeeWorkingBalance' to the CurrBalanceAmt since it always defaults ' to zero when the table is loaded ' updateString = "Update tblzTmpWk_tblTaxRecs_Fees_Local " & _ " SET [FeeWorkingBalance] = [CurrBalanceAmt] " DoCmd.SetWarnings False DoCmd.RunSQL updateString ' ' ' Dim rsFeesIn As ADODB.Recordset Set rsFeesIn = New ADODB.Recordset rsFeesIn.Open "tblzTmpWk_tblTaxRecs_Fees_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic ' Dim rsPayIn As ADODB.Recordset Set rsPayIn = New ADODB.Recordset rsPayIn.Open "tblzTmpWk_tblPayments_Fees_Sub_Local", CurrentProject.Connection, adOpenKeyset, adLockOptimistic ' Dim matched As Boolean Dim loopCnt As Long ' Dim wkPayBal As Double Dim wkFeeBal As Double 'Dim wkPayOrigAmt As Double 'Dim wkFeeOrigAmt As Double ' Dim wkAmountPaid As Double ' For loopCnt = 1 To 3 ' ' Position fee recs to first rec ' If rsFeesIn.EOF Then Else If rsFeesIn.RecordCount > 0 Then rsFeesIn.MoveFirst End If End If ' ' Position fee payments to first rec ' If rsPayIn.EOF Then Else If rsPayIn.RecordCount > 0 Then rsPayIn.MoveFirst End If End If ' ' Payments will be the driver ' While Not rsPayIn.EOF ' each payment record is matched against all of the fees before the next payment is read ' ' First time thru for every payment must move the payment amount to ' ' set payment balance for loop ' wkPayBal = rsPayIn!PaymentWorkingBalance ' ' Have payment record, match it against fee records ' While Not rsFeesIn.EOF ' lopps thru the fee records looking to match any payments ' ' The fee payments are applied in 3 passes. ' First Pass matches fee payments against fee records based on GRB Fee Desc, which is the long more specific description. ' Second Pass matches fee payments against fee records based on COP Fee Desc, which is the short less specific. ' Third pass just applies any remaining payment balances to the fees in the order they ares sorted until all payments havbe been applied. ' matched = False ' ' make sure there is a balance on the payment ' If rsPayIn!PaymentWorkingBalance > 0 Then ' ' If there is a balance see if it matches this tax rec. ' If loopCnt = 1 Then ' If Nz(rsPayIn!GRBFeeType, "Pay") = Nz(rsFeesIn!GRBFeeType, "Fee") Then matched = True End If ' ElseIf loopCnt = 2 Then ' If Nz(rsPayIn!COPFeeType, "Pay") = Nz(rsFeesIn!COPFeeType, "Fee") Then matched = True End If ' Else matched = True End If ' If matched = True Then ' apply the payment to the fee record. ' wkAmountPaid = 0 ' wkFeeBal = rsFeesIn!FeeWorkingBalance 'wkFeeOrigAmt = rsFeesIn!CurrBalanceAmt ' If wkFeeBal > 0 Then ' If wkPayBal <= wkFeeBal Then wkAmountPaid = wkPayBal Else wkAmountPaid = wkFeeBal End If ' wkFeeBal = wkFeeBal - wkAmountPaid wkPayBal = wkPayBal - wkAmountPaid ' ' update the working balance on the fee record ' rsFeesIn!FeeWorkingBalance = wkFeeBal rsFeesIn.Update ' ' update the working balance on the fee record ' ' End If ' the fee record already has a blance of zero ' End If ' payment record work balance = 0 ' rsFeesIn.MoveNext ' Wend ' ' Any payment appllications have been done and the final balance is in this variable ' update the balance on the pay record for any subseqent loops. ' rsPayIn!PaymentWorkingBalance = wkPayBal rsPayIn.Update ' rsPayIn.MoveNext Wend ' ' reset for next cyear ' rsPayIn.MoveFirst ' End If ' Next loopCnt ' rsFeesIn.Close Set rsFeesIn = Nothing ' rsPayIn.Close Set rsPayIn = Nothing ' On Error Resume Next ' getFeeBalance = DSum("[FeeWorkingBalance]", "rsFeesIn") ' On Error GoTo 0 ' End Function
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.