Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCBEPAY

RCBEPAY.m

Go to the documentation of this file.
  1. RCBEPAY ;WISC/RFJ - payment processing (top routine) ;1 Jun 00
  1. ;;4.5;Accounts Receivable;**153,304,301,326**;Mar 20, 1995;Build 26
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. ;
  1. PROCESS(RCRECTDA,RCPAYDA) ; process a payment for receipt
  1. ; rcrectda - receipt ien file 344
  1. ; rcpayda - payment ien file 344 under rcrectda
  1. ; returns 0 if processed, 1^error if not processed
  1. ;
  1. N RCACCT,RCBILLDA,RCDATA,RCERROR,RCPAYAMT,RCPAYDAT,RCTRANDA,X,RCERROR
  1. ;
  1. ; lock the receipt payment
  1. L +^RCY(344,RCRECTDA,1,RCPAYDA):10
  1. I '$T Q "1^Another user is working with this payment"
  1. ;
  1. ; get the payment data
  1. S RCDATA=^RCY(344,RCRECTDA,1,RCPAYDA,0)
  1. ;
  1. ; there is no account, this will go to suspense
  1. I $P(RCDATA,"^",3)="" L -^RCY(344,RCRECTDA,1,RCPAYDA) D Q RCERROR
  1. . S RCERROR=0
  1. . I '$T S RCERROR="1^Another user is updating the Suspense File Audit Log." Q
  1. . ;
  1. . ;file a "P"ending entry in the Suspense Audit Log File and for the disposition
  1. . ;if not already there and not $0 payment (auto-adjustment back to FMS).
  1. . I '$D(^RCY(344,RCRECTDA,1,RCPAYDA,3)),($P($G(^RCY(344,RCRECTDA,1,RCPAYDA,0)),U,4)'=0) D
  1. . . D AUDIT(RCRECTDA,RCPAYDA,"I")
  1. . . ;
  1. . . ;update disposition
  1. . . D SUSPDIS(RCRECTDA,RCPAYDA,"P")
  1. ;
  1. ; check the payment for errors
  1. S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
  1. I X L -^RCY(344,RCRECTDA,1,RCPAYDA) Q X
  1. ;
  1. ; get the payment date from the payment. if not on payment get it
  1. ; from the deposit. if not on deposit, set equal to today
  1. S RCPAYDAT=$P($P(RCDATA,"^",6),".") I 'RCPAYDAT S RCPAYDAT=$P($G(^RCY(344.1,+$P(^RCY(344,RCRECTDA,0),"^",6),0)),"^",3) I 'RCPAYDAT S RCPAYDAT=DT
  1. ; get the payment amount (amount paid minus amount processed).
  1. ; if the payment amount is not greater than zero, do not post.
  1. S RCPAYAMT=$P(RCDATA,"^",4)-$P(RCDATA,"^",5) I RCPAYAMT'>0 L -^RCY(344,RCRECTDA,1,RCPAYDA) Q 0
  1. ;
  1. ; get the account
  1. S RCACCT=$P(RCDATA,"^",3)
  1. ; if the account is a bill and the debtor is first party,
  1. ; then get the account from the debtor file
  1. I RCACCT["PRCA(430," S X=$P($G(^RCD(340,+$P($G(^PRCA(430,+RCACCT,0)),"^",9),0)),"^") I X["DPT(" S RCACCT=X
  1. ;
  1. ;
  1. ; ----------------- START PROCESSING PAYMENT -----------------
  1. ;
  1. ; === benefit debt (example: first party account) ===
  1. I RCACCT["DPT(" D Q RCERROR
  1. . S RCERROR=$$FIRSTPTY^RCBEPAYF
  1. . ; store or clear error
  1. . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
  1. . L -^RCY(344,RCRECTDA,1,RCPAYDA)
  1. ;
  1. ;
  1. ; === non-benefit debt (example: third party) ===
  1. S RCBILLDA=+$P(RCDATA,"^",3)
  1. ; lock the bill to prevent another used from changing the balance
  1. L +^PRCA(430,RCBILLDA):10
  1. I '$T D Q RCERROR
  1. . S RCERROR="1^Another user is working with bill "_$P(^PRCA(430,RCBILLDA,0),"^")
  1. . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
  1. . L -^RCY(344,RCRECTDA,1,RCPAYDA)
  1. ;
  1. ; exempt any interest/admin/penalty charges added on or after
  1. ; the payment date
  1. D EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
  1. ;
  1. ; once charges have been exempted, recheck the payment for errors
  1. S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
  1. I X D Q RCERROR
  1. . S RCERROR="1^"_$P(X,"^",2)
  1. . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
  1. . L -^PRCA(430,RCBILLDA)
  1. . L -^RCY(344,RCRECTDA,1,RCPAYDA)
  1. ;
  1. ; apply payment to bill
  1. ; return error if problem adding payment transaction
  1. S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT)
  1. I 'RCTRANDA D Q RCERROR
  1. . S RCERROR="1^"_$P(RCTRANDA,"^",2)
  1. . D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
  1. . L -^PRCA(430,RCBILLDA)
  1. . L -^RCY(344,RCRECTDA,1,RCPAYDA)
  1. ;
  1. ; set the amount processed in the receipt
  1. D SETAMT(RCRECTDA,RCPAYDA,$P($G(^PRCA(433,RCTRANDA,1)),"^",5))
  1. ;
  1. ; payment applied to bill
  1. D SETERROR(RCRECTDA,RCPAYDA,"")
  1. L -^PRCA(430,RCBILLDA)
  1. L -^RCY(344,RCRECTDA,1,RCPAYDA)
  1. Q 0
  1. ;
  1. ;
  1. SETAMT(RCRECTDA,RCPAYDA,RCAMOUNT) ; update the amount posted on the receipt
  1. N DATA
  1. S DATA=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
  1. I DATA="" Q
  1. S $P(^RCY(344,RCRECTDA,1,RCPAYDA,0),"^",5)=$P(DATA,"^",5)+RCAMOUNT
  1. Q
  1. ;
  1. ;
  1. SETERROR(RCRECTDA,RCPAYDA,RCERROR) ; store the error on the receipt
  1. ; or clear the posting error if null and defined
  1. ; error is null and posting error data in file is null
  1. I RCERROR="",$P($G(^RCY(344,RCRECTDA,1,RCPAYDA,1)),"^")="" Q
  1. ; error is null, clear posting error
  1. I RCERROR="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")="" Q
  1. ; error exists, set the posting error
  1. I RCERROR'="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=$E(RCERROR,1,60)
  1. Q
  1. ;
  1. ;
  1. AUDIT(RCRECTDA,RCPAYDA,RCSTAT,RCMTS) ; store entry in Suspense Audit Log
  1. ; Input
  1. ; RCRECTDA - IEN of Receipt file #344
  1. ; RCPAYDA - IEN of Receipt Transaction file #344.01
  1. ; RCSTAT - Status I = In Suspense, P = Paid or R = Refund
  1. ; RCMTS(N) - Array of Multi-Trans split information (OPTIONAL)
  1. ; $P(2) = AMOUNT
  1. ; $P(3) = Suspense comment
  1. ; $P(4) = Account/Claim
  1. ; e.g.
  1. ; RCMTS(1)="290613;PRCA(430,^2^^K100005"
  1. ; RCMTS(2)="290618;PRCA(430,^2^^K100010"
  1. ; RCMTS(3)="^2.42^Collected/Closed^"
  1. ;
  1. ; Output - Update RCDPE SUSPENSE AUDIT file #344.71
  1. N FDAIEN,RCAUDIT,RCDATA,RCDATA1,RCDATA0 ; PRCA*4.5*326
  1. ;
  1. ; get the data elements
  1. S RCDATA=$G(^RCY(344,RCRECTDA,0)) ;double check these
  1. S RCDATA0=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
  1. S RCDATA1=$G(^RCY(344,RCRECTDA,1,RCPAYDA,1))
  1. ;
  1. ; set up array
  1. S RCAUDIT(344.71,"+1,",.01)=$$NOW^XLFDT ;Date/Time Stamp
  1. S RCAUDIT(344.71,"+1,",.02)=DUZ ;User
  1. S RCAUDIT(344.71,"+1,",.03)=$P(RCDATA,U,1) ;Receipt #
  1. S RCAUDIT(344.71,"+1,",.04)=RCPAYDA ;Transaction #
  1. S RCAUDIT(344.71,"+1,",.05)=$P(RCDATA0,U,4) ;Amount
  1. S RCAUDIT(344.71,"+1,",.06)=$P(RCDATA0,U,9) ;Claim #
  1. S RCAUDIT(344.71,"+1,",.07)=RCSTAT ;Status
  1. S RCAUDIT(344.71,"+1,",.08)=$P(RCDATA1,U,2) ;Reason text
  1. ;
  1. ;file entry
  1. D UPDATE^DIE(,"RCAUDIT","FDAIEN") ; Added FDAIEN - PRCA*4.5*326
  1. ;
  1. ; BEGIN PRCA*4.5*326
  1. ; check if filing was successful
  1. Q:'$G(FDAIEN(1))
  1. ; if this is a multi-trans split update #344.711
  1. Q:'$D(RCMTS)
  1. ;
  1. N DA,DD,DIC,DLAYGO,DO,DR,RCACC,RCAMT,RCCOM,RCSUB,X,Y,Z
  1. ; Save details of each claim/suspense line in the split
  1. S RCSUB=0
  1. F S RCSUB=$O(RCMTS(RCSUB)) Q:'RCSUB D
  1. .S RCAMT=$P(RCMTS(RCSUB),U,2)
  1. .S RCCOM=$P(RCMTS(RCSUB),U,3)
  1. .S RCACC=$P(RCMTS(RCSUB),U,4)
  1. .S:RCACC="" RCACC="SUSPENSE"
  1. .S DLAYGO=344.711,DA(1)=FDAIEN(1),DIC(0)="L",X=RCSUB,DIC="^RCY(344.71,"_DA(1)_",1,"
  1. .S DIC("DR")=".02///"_RCACC_";.03///"_$J(+RCAMT,"",2)_";.04///"_RCCOM
  1. .D FILE^DICN
  1. .K DIC,DD,DO,DLAYGO
  1. Q
  1. ; END PRCA*4.5*326
  1. ;
  1. SUSPDIS(RCRECTDA,RCTRANDA,RCSTAT) ;Update the disposition field
  1. ;
  1. N DA,DR,DIE,DTOUT
  1. S DA=RCTRANDA,DA(1)=RCRECTDA,DIE="^RCY(344,"_DA(1)_",1,"
  1. S DR="3.01////"_RCSTAT_";"
  1. I RCSTAT="P" D
  1. . S DR=DR_"3.02////"_$$NOW^XLFDT_";"
  1. . S DR=DR_"3.03////"_DUZ_";"
  1. I RCSTAT'="P" D
  1. . S DR=DR_"3.04////"_$$NOW^XLFDT_";"
  1. . S DR=DR_"3.05////"_DUZ_";"
  1. S DR=$P(DR,";",1,$L(DR,";")-1)
  1. ;
  1. D ^DIE
  1. Q
  1. ;