PRCAEXM ;SF-ISC/YJK-ADMIN.COST CHARGE TRANSACTION ;15 Nov 2018 13:51:18
;;4.5;Accounts Receivable;**67,103,196,301,318,315,332,381,371**;Mar 20, 1995;Build 29
;Per VA Directive 6402, this routine should not be modified.
;
;Update Int/adm.balance and Administrative cost charge transaction, is called by ^PRCAWO.
;
D EN1(0) ; Administrative Cost Adjustment [PRCAF ADJ ADMIN] option entry point, PRCA*4.5*332
Q
;
EN1(KEYCHK) ;Adjustment Interest/admin.cost from an AR - this makes the int/adm.balance
; ,marshal fee and court cost zero,0.
; KEYCHK (optional) - 1 check for RCDPEAR security key, zero otherwise, defaults to zero
N PRCAIND,ADMINTOT,PRCAERR,PRCABN0
I '$D(KEYCHK) N KEYCHK S KEYCHK=0
I $G(KEYCHK)=1,'$D(^XUSEC("RCDPEAR",DUZ)) D Q ; PRCA*4.5*318 Added security key check
. W !!,"This action can only be taken by users that have the RCDPEAR security key.",!
. S VALMBCK="R"
. D PAUSE^VALM1
RTRN ; line tag for GOTO return
D BEGIN^PRCAWO G:('$D(PRCABN))!('$D(PRCAEN)) END G:'$D(^PRCA(430,PRCABN,7)) END
L +^PRCA(430,PRCABN):1 I '$T W !!,*7,"ANOTHER USER IS EDITING THIS BILL" G RTRN
S PRCABN0=PRCABN
S PRCAIND=$G(^PRCA(430,PRCABN,7))
S PRCAMT=$P(PRCAIND,U,2)+$P(PRCAIND,U,3)+$P(PRCAIND,U,4)+$P(PRCAIND,U,5)
S %=$P(^PRCA(430,PRCABN,0),U,2) I "PC"'[$P(^PRCA(430.2,%,0),U,6) W *7,!,"This AR may not be appropriate to charge Interest/Administrative cost.",!,"Please check the category of this AR.",! H 3
K % W !!,"You may exempt the account from all the interest and administrative cost balances - making those balances zero (0),",!,"or adjust them."
EN011 S %=2 W !!,"Do you want to exempt the account from all the Int/Adm. costs" D YN^DICN I %<0 S PRCACOMM="User Cancelled" D DELETE^PRCAWO1 K PRCACOMM G RTRN
I %=1 D EN11,END G RTRN
I %=0 W !,"ANSWER 'YES' OR 'NO' " G EN011
W !,"Adjusting the administrative/Interest charge ...",!
D DIEEN^PRCAWO1,END G RTRN
;
; exempt interest and admin charges
EN11 S PRCATYPE=14,DIE="^PRCA(433,",DA=PRCAEN
S DR=".03////^S X="_PRCABN_";11////^S X="_DT_";12////^S X="_PRCATYPE_";15////^S X="_PRCAMT_";"
S DR=DR_"27////^S X="_+$P(PRCAIND,U,2)_";" ;interest
S DR=DR_"28////^S X="_+$P(PRCAIND,U,3)_";" ;admin charge
S DR=DR_"25////^S X="_+$P(PRCAIND,U,4)_";" ;marshal fee
S DR=DR_"26////^S X="_+$P(PRCAIND,U,5)_";" ;court cost
S DIC=DIE,PRCA("LOCK")=0 D LOCKF^PRCAWO1 Q:PRCA("LOCK")=1 D ^DIE
I PRCAEN,$D(^PRCA(430,"TCSP",PRCABN)) D DECADJ^RCTCSPU(PRCABN,PRCAEN) ;prca*4.5*301 add cs 5B flag
; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
N PRCFDA S PRCFDA(430,PRCABN_",",72)=0,PRCFDA(430,PRCABN_",",73)=0,PRCFDA(430,PRCABN_",",74)=0,PRCFDA(430,PRCABN_",",75)=0
D FILE^DIE(,"PRCFDA"),TRANST^PRCAWO1
;
;PRCA*4.5*381 - Update Repayment Plan balance, if in a plan.
D UPDBAL^RCRPU1(PRCABN,PRCAEN)
;
Q
;
;
EN2 Q:'$D(PRCAEN) Q:($P(^PRCA(433,PRCAEN,2),U,8)="")&($P(^PRCA(433,PRCAEN,2),U,7)="")
W !,"MONTHLY ADMIN. CHARGE: ",?25,+$P(^PRCA(433,PRCAEN,2),U,8),?40,"INTEREST CHARGE: ",+$P(^PRCA(433,PRCAEN,2),U,7) Q
;
END L -^PRCA(433,+$G(PRCAEN)),-^PRCA(430,+$G(PRCABN))
S X(1)=0,X=$G(^PRCA(430,+$G(PRCABN0),7)),X(1)=+X,X(1)=$P(X,"^",2)+X(1),X(1)=$P(X,"^",3)+X(1),X(1)=$P(X,"^",4)+X(1),X(1)=$P(X,"^",5)+X(1)
K PRCA("STATUS")
I X(1)=0,$G(PRCABN0) D
.;Check for payment transactions
.F X=0:0 S X=$O(^PRCA(433,"C",PRCABN0,X)) Q:'X I ",2,7,20,"[(","_$P($G(^PRCA(430.3,+$P($G(^PRCA(433,X,1)),"^",2),0)),"^",3)_",") S PRCA("STATUS")=$O(^PRCA(430.3,"AC",108,0))
.S:'$D(PRCA("STATUS")) PRCA("STATUS")=$O(^PRCA(430.3,"AC",111,0))
.S DA=PRCABN0,DIE="^PRCA(430,",DR="8////"_PRCA("STATUS") D ^DIE
K PRCATY,PRCA,PRCA2,PRCAD,PRCABN,PRCAEN,PRCATYPE,DA,DIE,DIC,PRCAMT,DR,X,% Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAEXM 3772 printed Dec 13, 2024@01:39:26 Page 2
PRCAEXM ;SF-ISC/YJK-ADMIN.COST CHARGE TRANSACTION ;15 Nov 2018 13:51:18
+1 ;;4.5;Accounts Receivable;**67,103,196,301,318,315,332,381,371**;Mar 20, 1995;Build 29
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Update Int/adm.balance and Administrative cost charge transaction, is called by ^PRCAWO.
+5 ;
+6 ; Administrative Cost Adjustment [PRCAF ADJ ADMIN] option entry point, PRCA*4.5*332
DO EN1(0)
+7 QUIT
+8 ;
EN1(KEYCHK) ;Adjustment Interest/admin.cost from an AR - this makes the int/adm.balance
+1 ; ,marshal fee and court cost zero,0.
+2 ; KEYCHK (optional) - 1 check for RCDPEAR security key, zero otherwise, defaults to zero
+3 NEW PRCAIND,ADMINTOT,PRCAERR,PRCABN0
+4 IF '$DATA(KEYCHK)
NEW KEYCHK
SET KEYCHK=0
+5 ; PRCA*4.5*318 Added security key check
IF $GET(KEYCHK)=1
IF '$DATA(^XUSEC("RCDPEAR",DUZ))
Begin DoDot:1
+6 WRITE !!,"This action can only be taken by users that have the RCDPEAR security key.",!
+7 SET VALMBCK="R"
+8 DO PAUSE^VALM1
End DoDot:1
QUIT
RTRN ; line tag for GOTO return
+1 DO BEGIN^PRCAWO
if ('$DATA(PRCABN))!('$DATA(PRCAEN))
GOTO END
if '$DATA(^PRCA(430,PRCABN,7))
GOTO END
+2 LOCK +^PRCA(430,PRCABN):1
IF '$TEST
WRITE !!,*7,"ANOTHER USER IS EDITING THIS BILL"
GOTO RTRN
+3 SET PRCABN0=PRCABN
+4 SET PRCAIND=$GET(^PRCA(430,PRCABN,7))
+5 SET PRCAMT=$PIECE(PRCAIND,U,2)+$PIECE(PRCAIND,U,3)+$PIECE(PRCAIND,U,4)+$PIECE(PRCAIND,U,5)
+6 SET %=$PIECE(^PRCA(430,PRCABN,0),U,2)
IF "PC"'[$PIECE(^PRCA(430.2,%,0),U,6)
WRITE *7,!,"This AR may not be appropriate to charge Interest/Administrative cost.",!,"Please check the category of this AR.",!
HANG 3
+7 KILL %
WRITE !!,"You may exempt the account from all the interest and administrative cost balances - making those balances zero (0),",!,"or adjust them."
EN011 SET %=2
WRITE !!,"Do you want to exempt the account from all the Int/Adm. costs"
DO YN^DICN
IF %<0
SET PRCACOMM="User Cancelled"
DO DELETE^PRCAWO1
KILL PRCACOMM
GOTO RTRN
+1 IF %=1
DO EN11
DO END
GOTO RTRN
+2 IF %=0
WRITE !,"ANSWER 'YES' OR 'NO' "
GOTO EN011
+3 WRITE !,"Adjusting the administrative/Interest charge ...",!
+4 DO DIEEN^PRCAWO1
DO END
GOTO RTRN
+5 ;
+6 ; exempt interest and admin charges
EN11 SET PRCATYPE=14
SET DIE="^PRCA(433,"
SET DA=PRCAEN
+1 SET DR=".03////^S X="_PRCABN_";11////^S X="_DT_";12////^S X="_PRCATYPE_";15////^S X="_PRCAMT_";"
+2 ;interest
SET DR=DR_"27////^S X="_+$PIECE(PRCAIND,U,2)_";"
+3 ;admin charge
SET DR=DR_"28////^S X="_+$PIECE(PRCAIND,U,3)_";"
+4 ;marshal fee
SET DR=DR_"25////^S X="_+$PIECE(PRCAIND,U,4)_";"
+5 ;court cost
SET DR=DR_"26////^S X="_+$PIECE(PRCAIND,U,5)_";"
+6 SET DIC=DIE
SET PRCA("LOCK")=0
DO LOCKF^PRCAWO1
if PRCA("LOCK")=1
QUIT
DO ^DIE
+7 ;prca*4.5*301 add cs 5B flag
IF PRCAEN
IF $DATA(^PRCA(430,"TCSP",PRCABN))
DO DECADJ^RCTCSPU(PRCABN,PRCAEN)
+8 ; PRCA*4.5*371 - Replace direct global sets in 7 node with FileMan calls so indexes get updated
+9 NEW PRCFDA
SET PRCFDA(430,PRCABN_",",72)=0
SET PRCFDA(430,PRCABN_",",73)=0
SET PRCFDA(430,PRCABN_",",74)=0
SET PRCFDA(430,PRCABN_",",75)=0
+10 DO FILE^DIE(,"PRCFDA")
DO TRANST^PRCAWO1
+11 ;
+12 ;PRCA*4.5*381 - Update Repayment Plan balance, if in a plan.
+13 DO UPDBAL^RCRPU1(PRCABN,PRCAEN)
+14 ;
+15 QUIT
+16 ;
+17 ;
EN2 if '$DATA(PRCAEN)
QUIT
if ($PIECE(^PRCA(433,PRCAEN,2),U,8)="")&($PIECE(^PRCA(433,PRCAEN,2),U,7)="")
QUIT
+1 WRITE !,"MONTHLY ADMIN. CHARGE: ",?25,+$PIECE(^PRCA(433,PRCAEN,2),U,8),?40,"INTEREST CHARGE: ",+$PIECE(^PRCA(433,PRCAEN,2),U,7)
QUIT
+2 ;
END LOCK -^PRCA(433,+$GET(PRCAEN)),-^PRCA(430,+$GET(PRCABN))
+1 SET X(1)=0
SET X=$GET(^PRCA(430,+$GET(PRCABN0),7))
SET X(1)=+X
SET X(1)=$PIECE(X,"^",2)+X(1)
SET X(1)=$PIECE(X,"^",3)+X(1)
SET X(1)=$PIECE(X,"^",4)+X(1)
SET X(1)=$PIECE(X,"^",5)+X(1)
+2 KILL PRCA("STATUS")
+3 IF X(1)=0
IF $GET(PRCABN0)
Begin DoDot:1
+4 ;Check for payment transactions
+5 FOR X=0:0
SET X=$ORDER(^PRCA(433,"C",PRCABN0,X))
if 'X
QUIT
IF ",2,7,20,"[(","_$PIECE($GET(^PRCA(430.3,+$PIECE($GET(^PRCA(433,X,1)),"^",2),0)),"^",3)_",")
SET PRCA("STATUS")=$ORDER(^PRCA(430.3,"AC",108,0))
+6 if '$DATA(PRCA("STATUS"))
SET PRCA("STATUS")=$ORDER(^PRCA(430.3,"AC",111,0))
+7 SET DA=PRCABN0
SET DIE="^PRCA(430,"
SET DR="8////"_PRCA("STATUS")
DO ^DIE
End DoDot:1
+8 KILL PRCATY,PRCA,PRCA2,PRCAD,PRCABN,PRCAEN,PRCATYPE,DA,DIE,DIC,PRCAMT,DR,X,%
QUIT
+9 ;
