RCBEUTR2 ;WISC/RFJ - create an exempt transaction ;1 Jun 00
;;4.5;Accounts Receivable;**153,169,353,377**;Mar 20, 1995;Build 45
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;PRCA*4.5*353 Added RCVALL flag parameter to ensure
; Marshall Cost and Court Cost are used
; as correct total increase when clearing
; all associated cost when Principal value
; goes to zero via a decrease transaction
;
EXEMPT(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCVALL) ; exempt an intererst/admin charge
; for a bill. rcvalue = interest ^ admin ^ penalty ^ mf ^ cc
; for the transaction. rcdate = process date (optional)
; rcval indicates to also account for marshall cost & court cost in value calc
; returns transaction number if successful
;
N RCDRSTRG,RCTRANDA,Y,RCDTOTL,RCDATA7,RCTOTB
; add the transaction (if added to 433, transaction is locked)
S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,14) I 'RCTRANDA Q 0
;
; build dr string
; transaction date (strip off time)
S RCDRSTRG="11////"_$S($G(RCDATE):$P(RCDATE,"."),1:DT)_";"
; transaction values
S RCDTOTL=0 S RCDTOTL=$P(RCVALUE,"^")+$P(RCVALUE,"^",2)+$P(RCVALUE,"^",3) ;PRCA*4.5*353
I $G(RCVALL) D ;PRCA*4.5*353
. S RCDTOTL=RCDTOTL+$P(RCVALUE,"^",4)+$P(RCVALUE,"^",5)
. S RCCOMMNT(1)=RCCOMMNT
S RCDRSTRG=RCDRSTRG_"15////"_RCDTOTL_";" ;PRCA*4.5*353
I $P(RCVALUE,"^",1) S RCDRSTRG=RCDRSTRG_"27////"_$P(RCVALUE,"^",1)_";" ;interest
I $P(RCVALUE,"^",2) S RCDRSTRG=RCDRSTRG_"28////"_$P(RCVALUE,"^",2)_";" ;admin
I $P(RCVALUE,"^",3) S RCDRSTRG=RCDRSTRG_"29////"_$P(RCVALUE,"^",3)_";" ;penalty
I $P(RCVALUE,"^",4) S RCDRSTRG=RCDRSTRG_"25////"_$P(RCVALUE,"^",4)_";" ;mf
I $P(RCVALUE,"^",5) S RCDRSTRG=RCDRSTRG_"26////"_$P(RCVALUE,"^",5)_";" ;cc
I $G(RCDATE) S RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";" ;date entered
;
; input the fields for the transaction
S Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG) I 'Y L -^PRCA(433,RCTRANDA) Q 0
;
; set the comment
I $D(RCCOMMNT(1)) D ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
;
; move over 433 from 430 (no principal, just move it)
D FY433^RCBEUTRA(RCTRANDA)
;
; mark the transaction as processed
D PROCESS^RCBEUTRA(RCTRANDA)
;
;PRCA*4.5*377 - update Repayment Plan with Exemption amount
D UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
;
; update the bill file with the balance of the transaction
D SETBAL^RCBEUBIL(RCTRANDA)
;
; if the bill has no balance, close or cancel it
D CLOSEIT^RCBEUTR1(RCBILLDA)
;
; clear the lock and return the transaction added
L -^PRCA(433,RCTRANDA)
Q RCTRANDA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCBEUTR2 2663 printed Apr 09, 2024@20:54:53 Page 2
RCBEUTR2 ;WISC/RFJ - create an exempt transaction ;1 Jun 00
+1 ;;4.5;Accounts Receivable;**153,169,353,377**;Mar 20, 1995;Build 45
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;PRCA*4.5*353 Added RCVALL flag parameter to ensure
+6 ; Marshall Cost and Court Cost are used
+7 ; as correct total increase when clearing
+8 ; all associated cost when Principal value
+9 ; goes to zero via a decrease transaction
+10 ;
EXEMPT(RCBILLDA,RCVALUE,RCCOMMNT,RCDATE,RCVALL) ; exempt an intererst/admin charge
+1 ; for a bill. rcvalue = interest ^ admin ^ penalty ^ mf ^ cc
+2 ; for the transaction. rcdate = process date (optional)
+3 ; rcval indicates to also account for marshall cost & court cost in value calc
+4 ; returns transaction number if successful
+5 ;
+6 NEW RCDRSTRG,RCTRANDA,Y,RCDTOTL,RCDATA7,RCTOTB
+7 ; add the transaction (if added to 433, transaction is locked)
+8 SET RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,14)
IF 'RCTRANDA
QUIT 0
+9 ;
+10 ; build dr string
+11 ; transaction date (strip off time)
+12 SET RCDRSTRG="11////"_$SELECT($GET(RCDATE):$PIECE(RCDATE,"."),1:DT)_";"
+13 ; transaction values
+14 ;PRCA*4.5*353
SET RCDTOTL=0
SET RCDTOTL=$PIECE(RCVALUE,"^")+$PIECE(RCVALUE,"^",2)+$PIECE(RCVALUE,"^",3)
+15 ;PRCA*4.5*353
IF $GET(RCVALL)
Begin DoDot:1
+16 SET RCDTOTL=RCDTOTL+$PIECE(RCVALUE,"^",4)+$PIECE(RCVALUE,"^",5)
+17 SET RCCOMMNT(1)=RCCOMMNT
End DoDot:1
+18 ;PRCA*4.5*353
SET RCDRSTRG=RCDRSTRG_"15////"_RCDTOTL_";"
+19 ;interest
IF $PIECE(RCVALUE,"^",1)
SET RCDRSTRG=RCDRSTRG_"27////"_$PIECE(RCVALUE,"^",1)_";"
+20 ;admin
IF $PIECE(RCVALUE,"^",2)
SET RCDRSTRG=RCDRSTRG_"28////"_$PIECE(RCVALUE,"^",2)_";"
+21 ;penalty
IF $PIECE(RCVALUE,"^",3)
SET RCDRSTRG=RCDRSTRG_"29////"_$PIECE(RCVALUE,"^",3)_";"
+22 ;mf
IF $PIECE(RCVALUE,"^",4)
SET RCDRSTRG=RCDRSTRG_"25////"_$PIECE(RCVALUE,"^",4)_";"
+23 ;cc
IF $PIECE(RCVALUE,"^",5)
SET RCDRSTRG=RCDRSTRG_"26////"_$PIECE(RCVALUE,"^",5)_";"
+24 ;date entered
IF $GET(RCDATE)
SET RCDRSTRG=RCDRSTRG_"19////"_RCDATE_";"
+25 ;
+26 ; input the fields for the transaction
+27 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,RCDRSTRG)
IF 'Y
LOCK -^PRCA(433,RCTRANDA)
QUIT 0
+28 ;
+29 ; set the comment
+30 IF $DATA(RCCOMMNT(1))
DO ADDCOMM^RCBEUTRA(RCTRANDA,.RCCOMMNT)
+31 ;
+32 ; move over 433 from 430 (no principal, just move it)
+33 DO FY433^RCBEUTRA(RCTRANDA)
+34 ;
+35 ; mark the transaction as processed
+36 DO PROCESS^RCBEUTRA(RCTRANDA)
+37 ;
+38 ;PRCA*4.5*377 - update Repayment Plan with Exemption amount
+39 DO UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
+40 ;
+41 ; update the bill file with the balance of the transaction
+42 DO SETBAL^RCBEUBIL(RCTRANDA)
+43 ;
+44 ; if the bill has no balance, close or cancel it
+45 DO CLOSEIT^RCBEUTR1(RCBILLDA)
+46 ;
+47 ; clear the lock and return the transaction added
+48 LOCK -^PRCA(433,RCTRANDA)
+49 QUIT RCTRANDA
