RCBEPAY ;WISC/RFJ - payment processing (top routine) ;1 Jun 00
;;4.5;Accounts Receivable;**153,304,301,326**;Mar 20, 1995;Build 26
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;
PROCESS(RCRECTDA,RCPAYDA) ; process a payment for receipt
; rcrectda - receipt ien file 344
; rcpayda - payment ien file 344 under rcrectda
; returns 0 if processed, 1^error if not processed
;
N RCACCT,RCBILLDA,RCDATA,RCERROR,RCPAYAMT,RCPAYDAT,RCTRANDA,X,RCERROR
;
; lock the receipt payment
L +^RCY(344,RCRECTDA,1,RCPAYDA):10
I '$T Q "1^Another user is working with this payment"
;
; get the payment data
S RCDATA=^RCY(344,RCRECTDA,1,RCPAYDA,0)
;
; there is no account, this will go to suspense
I $P(RCDATA,"^",3)="" L -^RCY(344,RCRECTDA,1,RCPAYDA) D Q RCERROR
. S RCERROR=0
. I '$T S RCERROR="1^Another user is updating the Suspense File Audit Log." Q
. ;
. ;file a "P"ending entry in the Suspense Audit Log File and for the disposition
. ;if not already there and not $0 payment (auto-adjustment back to FMS).
. I '$D(^RCY(344,RCRECTDA,1,RCPAYDA,3)),($P($G(^RCY(344,RCRECTDA,1,RCPAYDA,0)),U,4)'=0) D
. . D AUDIT(RCRECTDA,RCPAYDA,"I")
. . ;
. . ;update disposition
. . D SUSPDIS(RCRECTDA,RCPAYDA,"P")
;
; check the payment for errors
S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
I X L -^RCY(344,RCRECTDA,1,RCPAYDA) Q X
;
; get the payment date from the payment. if not on payment get it
; from the deposit. if not on deposit, set equal to today
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
; get the payment amount (amount paid minus amount processed).
; if the payment amount is not greater than zero, do not post.
S RCPAYAMT=$P(RCDATA,"^",4)-$P(RCDATA,"^",5) I RCPAYAMT'>0 L -^RCY(344,RCRECTDA,1,RCPAYDA) Q 0
;
; get the account
S RCACCT=$P(RCDATA,"^",3)
; if the account is a bill and the debtor is first party,
; then get the account from the debtor file
I RCACCT["PRCA(430," S X=$P($G(^RCD(340,+$P($G(^PRCA(430,+RCACCT,0)),"^",9),0)),"^") I X["DPT(" S RCACCT=X
;
;
; ----------------- START PROCESSING PAYMENT -----------------
;
; === benefit debt (example: first party account) ===
I RCACCT["DPT(" D Q RCERROR
. S RCERROR=$$FIRSTPTY^RCBEPAYF
. ; store or clear error
. D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
. L -^RCY(344,RCRECTDA,1,RCPAYDA)
;
;
; === non-benefit debt (example: third party) ===
S RCBILLDA=+$P(RCDATA,"^",3)
; lock the bill to prevent another used from changing the balance
L +^PRCA(430,RCBILLDA):10
I '$T D Q RCERROR
. S RCERROR="1^Another user is working with bill "_$P(^PRCA(430,RCBILLDA,0),"^")
. D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
. L -^RCY(344,RCRECTDA,1,RCPAYDA)
;
; exempt any interest/admin/penalty charges added on or after
; the payment date
D EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
;
; once charges have been exempted, recheck the payment for errors
S X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
I X D Q RCERROR
. S RCERROR="1^"_$P(X,"^",2)
. D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
. L -^PRCA(430,RCBILLDA)
. L -^RCY(344,RCRECTDA,1,RCPAYDA)
;
; apply payment to bill
; return error if problem adding payment transaction
S RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT)
I 'RCTRANDA D Q RCERROR
. S RCERROR="1^"_$P(RCTRANDA,"^",2)
. D SETERROR(RCRECTDA,RCPAYDA,$P(RCERROR,"^",2))
. L -^PRCA(430,RCBILLDA)
. L -^RCY(344,RCRECTDA,1,RCPAYDA)
;
; set the amount processed in the receipt
D SETAMT(RCRECTDA,RCPAYDA,$P($G(^PRCA(433,RCTRANDA,1)),"^",5))
;
; payment applied to bill
D SETERROR(RCRECTDA,RCPAYDA,"")
L -^PRCA(430,RCBILLDA)
L -^RCY(344,RCRECTDA,1,RCPAYDA)
Q 0
;
;
SETAMT(RCRECTDA,RCPAYDA,RCAMOUNT) ; update the amount posted on the receipt
N DATA
S DATA=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
I DATA="" Q
S $P(^RCY(344,RCRECTDA,1,RCPAYDA,0),"^",5)=$P(DATA,"^",5)+RCAMOUNT
Q
;
;
SETERROR(RCRECTDA,RCPAYDA,RCERROR) ; store the error on the receipt
; or clear the posting error if null and defined
; error is null and posting error data in file is null
I RCERROR="",$P($G(^RCY(344,RCRECTDA,1,RCPAYDA,1)),"^")="" Q
; error is null, clear posting error
I RCERROR="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")="" Q
; error exists, set the posting error
I RCERROR'="" S $P(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=$E(RCERROR,1,60)
Q
;
;
AUDIT(RCRECTDA,RCPAYDA,RCSTAT,RCMTS) ; store entry in Suspense Audit Log
; Input
; RCRECTDA - IEN of Receipt file #344
; RCPAYDA - IEN of Receipt Transaction file #344.01
; RCSTAT - Status I = In Suspense, P = Paid or R = Refund
; RCMTS(N) - Array of Multi-Trans split information (OPTIONAL)
; $P(2) = AMOUNT
; $P(3) = Suspense comment
; $P(4) = Account/Claim
; e.g.
; RCMTS(1)="290613;PRCA(430,^2^^K100005"
; RCMTS(2)="290618;PRCA(430,^2^^K100010"
; RCMTS(3)="^2.42^Collected/Closed^"
;
; Output - Update RCDPE SUSPENSE AUDIT file #344.71
N FDAIEN,RCAUDIT,RCDATA,RCDATA1,RCDATA0 ; PRCA*4.5*326
;
; get the data elements
S RCDATA=$G(^RCY(344,RCRECTDA,0)) ;double check these
S RCDATA0=$G(^RCY(344,RCRECTDA,1,RCPAYDA,0))
S RCDATA1=$G(^RCY(344,RCRECTDA,1,RCPAYDA,1))
;
; set up array
S RCAUDIT(344.71,"+1,",.01)=$$NOW^XLFDT ;Date/Time Stamp
S RCAUDIT(344.71,"+1,",.02)=DUZ ;User
S RCAUDIT(344.71,"+1,",.03)=$P(RCDATA,U,1) ;Receipt #
S RCAUDIT(344.71,"+1,",.04)=RCPAYDA ;Transaction #
S RCAUDIT(344.71,"+1,",.05)=$P(RCDATA0,U,4) ;Amount
S RCAUDIT(344.71,"+1,",.06)=$P(RCDATA0,U,9) ;Claim #
S RCAUDIT(344.71,"+1,",.07)=RCSTAT ;Status
S RCAUDIT(344.71,"+1,",.08)=$P(RCDATA1,U,2) ;Reason text
;
;file entry
D UPDATE^DIE(,"RCAUDIT","FDAIEN") ; Added FDAIEN - PRCA*4.5*326
;
; BEGIN PRCA*4.5*326
; check if filing was successful
Q:'$G(FDAIEN(1))
; if this is a multi-trans split update #344.711
Q:'$D(RCMTS)
;
N DA,DD,DIC,DLAYGO,DO,DR,RCACC,RCAMT,RCCOM,RCSUB,X,Y,Z
; Save details of each claim/suspense line in the split
S RCSUB=0
F S RCSUB=$O(RCMTS(RCSUB)) Q:'RCSUB D
.S RCAMT=$P(RCMTS(RCSUB),U,2)
.S RCCOM=$P(RCMTS(RCSUB),U,3)
.S RCACC=$P(RCMTS(RCSUB),U,4)
.S:RCACC="" RCACC="SUSPENSE"
.S DLAYGO=344.711,DA(1)=FDAIEN(1),DIC(0)="L",X=RCSUB,DIC="^RCY(344.71,"_DA(1)_",1,"
.S DIC("DR")=".02///"_RCACC_";.03///"_$J(+RCAMT,"",2)_";.04///"_RCCOM
.D FILE^DICN
.K DIC,DD,DO,DLAYGO
Q
; END PRCA*4.5*326
;
SUSPDIS(RCRECTDA,RCTRANDA,RCSTAT) ;Update the disposition field
;
N DA,DR,DIE,DTOUT
S DA=RCTRANDA,DA(1)=RCRECTDA,DIE="^RCY(344,"_DA(1)_",1,"
S DR="3.01////"_RCSTAT_";"
I RCSTAT="P" D
. S DR=DR_"3.02////"_$$NOW^XLFDT_";"
. S DR=DR_"3.03////"_DUZ_";"
I RCSTAT'="P" D
. S DR=DR_"3.04////"_$$NOW^XLFDT_";"
. S DR=DR_"3.05////"_DUZ_";"
S DR=$P(DR,";",1,$L(DR,";")-1)
;
D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEPAY 7113 printed Apr 09, 2024@20:50:40 Page 2
RCBEPAY ;WISC/RFJ - payment processing (top routine) ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,304,301,326**;Mar 20, 1995;Build 26
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;
PROCESS(RCRECTDA,RCPAYDA) ; process a payment for receipt
+1 ; rcrectda - receipt ien file 344
+2 ; rcpayda - payment ien file 344 under rcrectda
+3 ; returns 0 if processed, 1^error if not processed
+4 ;
+5 NEW RCACCT,RCBILLDA,RCDATA,RCERROR,RCPAYAMT,RCPAYDAT,RCTRANDA,X,RCERROR
+6 ;
+7 ; lock the receipt payment
+8 LOCK +^RCY(344,RCRECTDA,1,RCPAYDA):10
+9 IF '$TEST
QUIT "1^Another user is working with this payment"
+10 ;
+11 ; get the payment data
+12 SET RCDATA=^RCY(344,RCRECTDA,1,RCPAYDA,0)
+13 ;
+14 ; there is no account, this will go to suspense
+15 IF $PIECE(RCDATA,"^",3)=""
LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
Begin DoDot:1
+16 SET RCERROR=0
+17 IF '$TEST
SET RCERROR="1^Another user is updating the Suspense File Audit Log."
QUIT
+18 ;
+19 ;file a "P"ending entry in the Suspense Audit Log File and for the disposition
+20 ;if not already there and not $0 payment (auto-adjustment back to FMS).
+21 IF '$DATA(^RCY(344,RCRECTDA,1,RCPAYDA,3))
IF ($PIECE($GET(^RCY(344,RCRECTDA,1,RCPAYDA,0)),U,4)'=0)
Begin DoDot:2
+22 DO AUDIT(RCRECTDA,RCPAYDA,"I")
+23 ;
+24 ;update disposition
+25 DO SUSPDIS(RCRECTDA,RCPAYDA,"P")
End DoDot:2
End DoDot:1
QUIT RCERROR
+26 ;
+27 ; check the payment for errors
+28 SET X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
+29 IF X
LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
QUIT X
+30 ;
+31 ; get the payment date from the payment. if not on payment get it
+32 ; from the deposit. if not on deposit, set equal to today
+33 SET RCPAYDAT=$PIECE($PIECE(RCDATA,"^",6),".")
IF 'RCPAYDAT
SET RCPAYDAT=$PIECE($GET(^RCY(344.1,+$PIECE(^RCY(344,RCRECTDA,0),"^",6),0)),"^",3)
IF 'RCPAYDAT
SET RCPAYDAT=DT
+34 ; get the payment amount (amount paid minus amount processed).
+35 ; if the payment amount is not greater than zero, do not post.
+36 SET RCPAYAMT=$PIECE(RCDATA,"^",4)-$PIECE(RCDATA,"^",5)
IF RCPAYAMT'>0
LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
QUIT 0
+37 ;
+38 ; get the account
+39 SET RCACCT=$PIECE(RCDATA,"^",3)
+40 ; if the account is a bill and the debtor is first party,
+41 ; then get the account from the debtor file
+42 IF RCACCT["PRCA(430,"
SET X=$PIECE($GET(^RCD(340,+$PIECE($GET(^PRCA(430,+RCACCT,0)),"^",9),0)),"^")
IF X["DPT("
SET RCACCT=X
+43 ;
+44 ;
+45 ; ----------------- START PROCESSING PAYMENT -----------------
+46 ;
+47 ; === benefit debt (example: first party account) ===
+48 IF RCACCT["DPT("
Begin DoDot:1
+49 SET RCERROR=$$FIRSTPTY^RCBEPAYF
+50 ; store or clear error
+51 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
+52 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
End DoDot:1
QUIT RCERROR
+53 ;
+54 ;
+55 ; === non-benefit debt (example: third party) ===
+56 SET RCBILLDA=+$PIECE(RCDATA,"^",3)
+57 ; lock the bill to prevent another used from changing the balance
+58 LOCK +^PRCA(430,RCBILLDA):10
+59 IF '$TEST
Begin DoDot:1
+60 SET RCERROR="1^Another user is working with bill "_$PIECE(^PRCA(430,RCBILLDA,0),"^")
+61 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
+62 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
End DoDot:1
QUIT RCERROR
+63 ;
+64 ; exempt any interest/admin/penalty charges added on or after
+65 ; the payment date
+66 DO EXEMPT^RCBECHGE(RCBILLDA,RCPAYDAT)
+67 ;
+68 ; once charges have been exempted, recheck the payment for errors
+69 SET X=$$CHECKPAY^RCBEPAYC(RCRECTDA,RCPAYDA)
+70 IF X
Begin DoDot:1
+71 SET RCERROR="1^"_$PIECE(X,"^",2)
+72 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
+73 LOCK -^PRCA(430,RCBILLDA)
+74 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
End DoDot:1
QUIT RCERROR
+75 ;
+76 ; apply payment to bill
+77 ; return error if problem adding payment transaction
+78 SET RCTRANDA=$$PAYTRAN^RCBEPAY1(RCBILLDA,RCPAYAMT,RCRECTDA,RCPAYDA,RCPAYDAT)
+79 IF 'RCTRANDA
Begin DoDot:1
+80 SET RCERROR="1^"_$PIECE(RCTRANDA,"^",2)
+81 DO SETERROR(RCRECTDA,RCPAYDA,$PIECE(RCERROR,"^",2))
+82 LOCK -^PRCA(430,RCBILLDA)
+83 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
End DoDot:1
QUIT RCERROR
+84 ;
+85 ; set the amount processed in the receipt
+86 DO SETAMT(RCRECTDA,RCPAYDA,$PIECE($GET(^PRCA(433,RCTRANDA,1)),"^",5))
+87 ;
+88 ; payment applied to bill
+89 DO SETERROR(RCRECTDA,RCPAYDA,"")
+90 LOCK -^PRCA(430,RCBILLDA)
+91 LOCK -^RCY(344,RCRECTDA,1,RCPAYDA)
+92 QUIT 0
+93 ;
+94 ;
SETAMT(RCRECTDA,RCPAYDA,RCAMOUNT) ; update the amount posted on the receipt
+1 NEW DATA
+2 SET DATA=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,0))
+3 IF DATA=""
QUIT
+4 SET $PIECE(^RCY(344,RCRECTDA,1,RCPAYDA,0),"^",5)=$PIECE(DATA,"^",5)+RCAMOUNT
+5 QUIT
+6 ;
+7 ;
SETERROR(RCRECTDA,RCPAYDA,RCERROR) ; store the error on the receipt
+1 ; or clear the posting error if null and defined
+2 ; error is null and posting error data in file is null
+3 IF RCERROR=""
IF $PIECE($GET(^RCY(344,RCRECTDA,1,RCPAYDA,1)),"^")=""
QUIT
+4 ; error is null, clear posting error
+5 IF RCERROR=""
SET $PIECE(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=""
QUIT
+6 ; error exists, set the posting error
+7 IF RCERROR'=""
SET $PIECE(^RCY(344,RCRECTDA,1,RCPAYDA,1),"^")=$EXTRACT(RCERROR,1,60)
+8 QUIT
+9 ;
+10 ;
AUDIT(RCRECTDA,RCPAYDA,RCSTAT,RCMTS) ; store entry in Suspense Audit Log
+1 ; Input
+2 ; RCRECTDA - IEN of Receipt file #344
+3 ; RCPAYDA - IEN of Receipt Transaction file #344.01
+4 ; RCSTAT - Status I = In Suspense, P = Paid or R = Refund
+5 ; RCMTS(N) - Array of Multi-Trans split information (OPTIONAL)
+6 ; $P(2) = AMOUNT
+7 ; $P(3) = Suspense comment
+8 ; $P(4) = Account/Claim
+9 ; e.g.
+10 ; RCMTS(1)="290613;PRCA(430,^2^^K100005"
+11 ; RCMTS(2)="290618;PRCA(430,^2^^K100010"
+12 ; RCMTS(3)="^2.42^Collected/Closed^"
+13 ;
+14 ; Output - Update RCDPE SUSPENSE AUDIT file #344.71
+15 ; PRCA*4.5*326
NEW FDAIEN,RCAUDIT,RCDATA,RCDATA1,RCDATA0
+16 ;
+17 ; get the data elements
+18 ;double check these
SET RCDATA=$GET(^RCY(344,RCRECTDA,0))
+19 SET RCDATA0=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,0))
+20 SET RCDATA1=$GET(^RCY(344,RCRECTDA,1,RCPAYDA,1))
+21 ;
+22 ; set up array
+23 ;Date/Time Stamp
SET RCAUDIT(344.71,"+1,",.01)=$$NOW^XLFDT
+24 ;User
SET RCAUDIT(344.71,"+1,",.02)=DUZ
+25 ;Receipt #
SET RCAUDIT(344.71,"+1,",.03)=$PIECE(RCDATA,U,1)
+26 ;Transaction #
SET RCAUDIT(344.71,"+1,",.04)=RCPAYDA
+27 ;Amount
SET RCAUDIT(344.71,"+1,",.05)=$PIECE(RCDATA0,U,4)
+28 ;Claim #
SET RCAUDIT(344.71,"+1,",.06)=$PIECE(RCDATA0,U,9)
+29 ;Status
SET RCAUDIT(344.71,"+1,",.07)=RCSTAT
+30 ;Reason text
SET RCAUDIT(344.71,"+1,",.08)=$PIECE(RCDATA1,U,2)
+31 ;
+32 ;file entry
+33 ; Added FDAIEN - PRCA*4.5*326
DO UPDATE^DIE(,"RCAUDIT","FDAIEN")
+34 ;
+35 ; BEGIN PRCA*4.5*326
+36 ; check if filing was successful
+37 if '$GET(FDAIEN(1))
QUIT
+38 ; if this is a multi-trans split update #344.711
+39 if '$DATA(RCMTS)
QUIT
+40 ;
+41 NEW DA,DD,DIC,DLAYGO,DO,DR,RCACC,RCAMT,RCCOM,RCSUB,X,Y,Z
+42 ; Save details of each claim/suspense line in the split
+43 SET RCSUB=0
+44 FOR
SET RCSUB=$ORDER(RCMTS(RCSUB))
if 'RCSUB
QUIT
Begin DoDot:1
+45 SET RCAMT=$PIECE(RCMTS(RCSUB),U,2)
+46 SET RCCOM=$PIECE(RCMTS(RCSUB),U,3)
+47 SET RCACC=$PIECE(RCMTS(RCSUB),U,4)
+48 if RCACC=""
SET RCACC="SUSPENSE"
+49 SET DLAYGO=344.711
SET DA(1)=FDAIEN(1)
SET DIC(0)="L"
SET X=RCSUB
SET DIC="^RCY(344.71,"_DA(1)_",1,"
+50 SET DIC("DR")=".02///"_RCACC_";.03///"_$JUSTIFY(+RCAMT,"",2)_";.04///"_RCCOM
+51 DO FILE^DICN
+52 KILL DIC,DD,DO,DLAYGO
End DoDot:1
+53 QUIT
+54 ; END PRCA*4.5*326
+55 ;
SUSPDIS(RCRECTDA,RCTRANDA,RCSTAT) ;Update the disposition field
+1 ;
+2 NEW DA,DR,DIE,DTOUT
+3 SET DA=RCTRANDA
SET DA(1)=RCRECTDA
SET DIE="^RCY(344,"_DA(1)_",1,"
+4 SET DR="3.01////"_RCSTAT_";"
+5 IF RCSTAT="P"
Begin DoDot:1
+6 SET DR=DR_"3.02////"_$$NOW^XLFDT_";"
+7 SET DR=DR_"3.03////"_DUZ_";"
End DoDot:1
+8 IF RCSTAT'="P"
Begin DoDot:1
+9 SET DR=DR_"3.04////"_$$NOW^XLFDT_";"
+10 SET DR=DR_"3.05////"_DUZ_";"
End DoDot:1
+11 SET DR=$PIECE(DR,";",1,$LENGTH(DR,";")-1)
+12 ;
+13 DO ^DIE
+14 QUIT
+15 ;
