RCWROFF1 ;WISC/RFJ-partial waiver ;1 Feb 2000
;;4.5;Accounts Receivable;**168,204,233,301,377**;Mar 20, 1995;Build 45
;;Per VA Directive 6402, this routine should not be modified.
Q
;
;
PARTIAL ; enter a partial waived (menu option)
N DR,RCBILLDA,RCCURPRI,RCFYCNT,RCTOTAL,RCTRANDA,RCWAIVED,Y
F D Q:RCBILLDA<1
. K RCTRANDA ;do not leave around in for loop
. ; select a bill
. S RCBILLDA=$$GETABILL^RCBEUBIL I RCBILLDA<1 Q
. I $D(^PRCA(430,"TCSP",RCBILLDA)) D Q ;prca*4.5*301
. . W !,"BILL HAS BEEN REFERRED TO CROSS-SERVICING.",!,"NO TRANSACTIONS ARE ALLOWED.",!,"** THE RECALL PROCESS MUST BE UTILIZED PRIOR TO PERFORMING THIS FUNCTION **" ;prca*4.5*301 Q
. ; lock the bill
. L +^PRCA(430,RCBILLDA):5 I '$T W !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL." Q
. D SHOWBILL(RCBILLDA)
. I '$G(^PRCA(430,RCBILLDA,7)) W !,"THIS BILL HAS NO PRINCIPAL BALANCE." D UNLOCK^RCWROFF Q
. W !
. ; add a new partial waiver transaction to file 433
. S RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,11) I 'RCTRANDA W !,$P(RCTRANDA,"^",2) D UNLOCK^RCWROFF Q
. W !," Transaction number ",RCTRANDA," added ..."
. ; transfer fy multiple from bill
. D FY433^RCBEUTRA(RCTRANDA)
. ;
. ; build dr string for call to die
. S DR="11WAIVED IN PART DATE;"
. ; determine if there is more than one fiscal year for build DR string
. S RCFYCNT=$P($G(^PRCA(433,RCTRANDA,4,0)),"^",4)
. ; single fiscal year in multiple
. I RCFYCNT'>1 D
. . ; get the current principal balance
. . S RCCURPRI=+$P($G(^PRCA(433,RCTRANDA,4,+$O(^PRCA(433,RCTRANDA,4,0)),0)),"^",2)
. . S DR=DR_"15WAIVED AMOUNT;"
. . S DR=DR_"S RCWAIVED=+X;"
. . S DR=DR_"I RCWAIVED'>0 W !,""Amount must be greater than ZERO. Press ^ to exit."" S Y=15;"
. . S DR=DR_"I RCWAIVED>RCCURPRI W !,""Waived amount CAN NOT EXCEED Principal amount ($ "",$J(RCCURPRI,0,2),"")."" S Y=15;"
. . S DR=DR_"I RCWAIVED=RCCURPRI W !,""If you are creating a waiver for the FULL AMOUNT, use the option Full Waiver."" S Y=15;"
. . S DR=DR_"81///^S X=RCWAIVED;"
. ; multiple fiscal years in multiple
. I RCFYCNT>1 D
. . S DR=DR_"S RCTOTAL=0;"
. . S DR=DR_".02;"
. . S DR(2,433.01)="4WAIVED AMOUNT;"
. . S DR(2,433.01)=DR(2,433.01)_"S RCWAIVED=+X,RCCURPRI=+$P(^PRCA(433,DA(1),4,DA,0),U,2);"
. . S DR(2,433.01)=DR(2,433.01)_"I RCWAIVED>RCCURPRI W !,""Waived amount CAN NOT EXCEED Principal Amount ($ "",$J(RCCURPRI,0,2),"") for this Fiscal Year."" S Y=4;"
. . S DR(2,433.01,1)="I RCWAIVED=RCCURPRI W !,""If you are creating a waiver for the FULL AMOUNT, use the option Full Waiver."" S Y=4;"
. . S DR(2,433.01,1)=DR(2,433.01,1)_"1///^S X=$P(^PRCA(433,DA(1),4,DA,0),U,2)-RCWAIVED;"
. . S DR(2,433.01,1)=DR(2,433.01,1)_"S RCTOTAL=$G(RCTOTAL)+RCWAIVED;"
. . S DR=DR_"I RCTOTAL'>0 W !,""Amount must be greater than ZERO. Press ^ to exit."" S Y=.02;"
. . S DR=DR_"15///^S X=RCTOTAL;"
. . S DR=DR_"81///^S X=RCTOTAL;"
. ;
. ; allow user to edit key fields
. S Y=$$EDIT433^RCBEUTRA(RCTRANDA,.DR)
. I 'Y W !,$P(Y,"^",2) D DEL433^RCBEUTRA(RCTRANDA,"",0),UNLOCK^RCWROFF Q
. ;
. ; if only one fiscal year, update the multiple since it was not done
. ; by the user in the die call
. I RCFYCNT=1 D
. . N DA40,DATA40,RCTOTAL
. . S RCTOTAL=$P($G(^PRCA(433,RCTRANDA,8)),"^") ;amount waived
. . S DA40=+$O(^PRCA(433,RCTRANDA,4,0)) I 'DA40 Q
. . S DATA40=$G(^PRCA(433,RCTRANDA,4,DA40,0)) I DATA40="" Q
. . S $P(DATA40,"^",2)=$P(DATA40,"^",2)-RCTOTAL ;principal remaining
. . S $P(DATA40,"^",5)=RCTOTAL ;amount waived
. . S ^PRCA(433,RCTRANDA,4,DA40,0)=DATA40
. ;
. D SHOWTRAN(RCTRANDA)
. I $$ASKOK^RCWROFF("Partial Waiver")'=1 D DEL433^RCBEUTRA(RCTRANDA,"",0),UNLOCK^RCWROFF Q
. ;
. ; move the fy multiple from 433 to 430
. D FYMULT^RCBEUBIL(RCTRANDA)
. ; mark transaction as processed
. D PROCESS^RCBEUTRA(RCTRANDA)
. ; update the principal balance on the bill (subtract the waived amount)
. D SETBAL^RCBEUBIL(RCTRANDA)
. ;PRCA*4.5*377 - Update active repayment plan attached to bill.
. D UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
. ; create fms write off document, if not accrued
. I '$$ACCK^PRCAACC(RCBILLDA) D FMSDOC^RCWROFF(RCTRANDA)
. ;
. W !," * * * * * Partial Waiver has been PROCESSED! * * * * *"
.I '$G(REFMS)&(DT>$$LDATE^RCRJR(DT)) S Y=$E($$FPS^RCAMFN01(DT,1),1,5)_"01" D DD^%DT W !!," * * * * Transmission will be held until "_Y_" * * * *"
. D UNLOCK^RCWROFF
Q
;
;
SHOWTRAN(RCTRANDA) ; show data for transaction
N %,DATA0,DATA1,DATA40,RCWRLINE,Y
S DATA0=$G(^PRCA(433,RCTRANDA,0))
S DATA1=$G(^PRCA(433,RCTRANDA,1))
S RCWRLINE="",$P(RCWRLINE,"=",79)=""
W !!,RCWRLINE
W !,"BILL NUMBER: ",$P($G(^PRCA(430,+$P(DATA0,"^",2),0)),"^")
W ?40,"WAIVED AMOUNT: ",$J($P(DATA1,"^",5),0,2)
S Y=$P($P(DATA1,"^"),".") I Y D DD^%DT
W !?42,"WAIVED DATE: ",Y
W !!,"FISCAL YEAR",?30,"WAIVED AMOUNT",?50,"NEW PRINCIPAL BALANCE DUE"
S %=0 F S %=$O(^PRCA(433,RCTRANDA,4,%)) Q:'% D
. S DATA40=$G(^PRCA(433,RCTRANDA,4,%,0))
. W !,$P(DATA40,"^"),?30,$J($P(DATA40,"^",5),13,2),?50,$J($P(DATA40,"^",2),25,2)
W !!,RCWRLINE
Q
;
;
SHOWBILL(RCBILLDA) ; show data for bill
N DATA7,DATA20,FYDA
S DATA7=$G(^PRCA(430,RCBILLDA,7))
W !?8,"Principal Balance: ",$J($P(DATA7,"^"),11,2)
;
; show fy data
S FYDA=$O(^PRCA(430,RCBILLDA,2,0)),DATA20=$G(^PRCA(430,RCBILLDA,2,FYDA,0))
W ?40,"FY: ",$P(DATA20,"^"),?48,"Principal Balance: ",$J($P(DATA20,"^",2),0,2)
; if multiple fiscal years, show them here
F S FYDA=$O(^PRCA(430,RCBILLDA,2,FYDA)) Q:'FYDA D
. S DATA20=$G(^PRCA(430,RCBILLDA,2,FYDA,0))
. W !?40,"FY: ",$P(DATA20,"^"),?48,"Principal Balance: ",$J($P(DATA20,"^",2),0,2)
;
W !?8," Interest Balance: ",$J($P(DATA7,"^",2),11,2)
W !?8," Admin Balance: ",$J($P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),11,2)
W !?27,"-----------"
W !?8," TOTAL Balance: ",$J($P(DATA7,"^")+$P(DATA7,"^",2)+$P(DATA7,"^",3)+$P(DATA7,"^",4)+$P(DATA7,"^",5),11,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCWROFF1 6208 printed Oct 16, 2024@17:50:04 Page 2
RCWROFF1 ;WISC/RFJ-partial waiver ;1 Feb 2000
+1 ;;4.5;Accounts Receivable;**168,204,233,301,377**;Mar 20, 1995;Build 45
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PARTIAL ; enter a partial waived (menu option)
+1 NEW DR,RCBILLDA,RCCURPRI,RCFYCNT,RCTOTAL,RCTRANDA,RCWAIVED,Y
+2 FOR
Begin DoDot:1
+3 ;do not leave around in for loop
KILL RCTRANDA
+4 ; select a bill
+5 SET RCBILLDA=$$GETABILL^RCBEUBIL
IF RCBILLDA<1
QUIT
+6 ;prca*4.5*301
IF $DATA(^PRCA(430,"TCSP",RCBILLDA))
Begin DoDot:2
+7 ;prca*4.5*301 Q
WRITE !,"BILL HAS BEEN REFERRED TO CROSS-SERVICING.",!,"NO TRANSACTIONS ARE ALLOWED.",!,"** THE RECALL PROCESS MUST BE UTILIZED PRIOR TO PERFORMING THIS FUNCTION **"
End DoDot:2
QUIT
+8 ; lock the bill
+9 LOCK +^PRCA(430,RCBILLDA):5
IF '$TEST
WRITE !,"ANOTHER USER IS CURRENTLY WORKING WITH THIS BILL."
QUIT
+10 DO SHOWBILL(RCBILLDA)
+11 IF '$GET(^PRCA(430,RCBILLDA,7))
WRITE !,"THIS BILL HAS NO PRINCIPAL BALANCE."
DO UNLOCK^RCWROFF
QUIT
+12 WRITE !
+13 ; add a new partial waiver transaction to file 433
+14 SET RCTRANDA=$$ADD433^RCBEUTRA(RCBILLDA,11)
IF 'RCTRANDA
WRITE !,$PIECE(RCTRANDA,"^",2)
DO UNLOCK^RCWROFF
QUIT
+15 WRITE !," Transaction number ",RCTRANDA," added ..."
+16 ; transfer fy multiple from bill
+17 DO FY433^RCBEUTRA(RCTRANDA)
+18 ;
+19 ; build dr string for call to die
+20 SET DR="11WAIVED IN PART DATE;"
+21 ; determine if there is more than one fiscal year for build DR string
+22 SET RCFYCNT=$PIECE($GET(^PRCA(433,RCTRANDA,4,0)),"^",4)
+23 ; single fiscal year in multiple
+24 IF RCFYCNT'>1
Begin DoDot:2
+25 ; get the current principal balance
+26 SET RCCURPRI=+$PIECE($GET(^PRCA(433,RCTRANDA,4,+$ORDER(^PRCA(433,RCTRANDA,4,0)),0)),"^",2)
+27 SET DR=DR_"15WAIVED AMOUNT;"
+28 SET DR=DR_"S RCWAIVED=+X;"
+29 SET DR=DR_"I RCWAIVED'>0 W !,""Amount must be greater than ZERO. Press ^ to exit."" S Y=15;"
+30 SET DR=DR_"I RCWAIVED>RCCURPRI W !,""Waived amount CAN NOT EXCEED Principal amount ($ "",$J(RCCURPRI,0,2),"")."" S Y=15;"
+31 SET DR=DR_"I RCWAIVED=RCCURPRI W !,""If you are creating a waiver for the FULL AMOUNT, use the option Full Waiver."" S Y=15;"
+32 SET DR=DR_"81///^S X=RCWAIVED;"
End DoDot:2
+33 ; multiple fiscal years in multiple
+34 IF RCFYCNT>1
Begin DoDot:2
+35 SET DR=DR_"S RCTOTAL=0;"
+36 SET DR=DR_".02;"
+37 SET DR(2,433.01)="4WAIVED AMOUNT;"
+38 SET DR(2,433.01)=DR(2,433.01)_"S RCWAIVED=+X,RCCURPRI=+$P(^PRCA(433,DA(1),4,DA,0),U,2);"
+39 SET DR(2,433.01)=DR(2,433.01)_"I RCWAIVED>RCCURPRI W !,""Waived amount CAN NOT EXCEED Principal Amount ($ "",$J(RCCURPRI,0,2),"") for this Fiscal Year."" S Y=4;"
+40 SET DR(2,433.01,1)="I RCWAIVED=RCCURPRI W !,""If you are creating a waiver for the FULL AMOUNT, use the option Full Waiver."" S Y=4;"
+41 SET DR(2,433.01,1)=DR(2,433.01,1)_"1///^S X=$P(^PRCA(433,DA(1),4,DA,0),U,2)-RCWAIVED;"
+42 SET DR(2,433.01,1)=DR(2,433.01,1)_"S RCTOTAL=$G(RCTOTAL)+RCWAIVED;"
+43 SET DR=DR_"I RCTOTAL'>0 W !,""Amount must be greater than ZERO. Press ^ to exit."" S Y=.02;"
+44 SET DR=DR_"15///^S X=RCTOTAL;"
+45 SET DR=DR_"81///^S X=RCTOTAL;"
End DoDot:2
+46 ;
+47 ; allow user to edit key fields
+48 SET Y=$$EDIT433^RCBEUTRA(RCTRANDA,.DR)
+49 IF 'Y
WRITE !,$PIECE(Y,"^",2)
DO DEL433^RCBEUTRA(RCTRANDA,"",0)
DO UNLOCK^RCWROFF
QUIT
+50 ;
+51 ; if only one fiscal year, update the multiple since it was not done
+52 ; by the user in the die call
+53 IF RCFYCNT=1
Begin DoDot:2
+54 NEW DA40,DATA40,RCTOTAL
+55 ;amount waived
SET RCTOTAL=$PIECE($GET(^PRCA(433,RCTRANDA,8)),"^")
+56 SET DA40=+$ORDER(^PRCA(433,RCTRANDA,4,0))
IF 'DA40
QUIT
+57 SET DATA40=$GET(^PRCA(433,RCTRANDA,4,DA40,0))
IF DATA40=""
QUIT
+58 ;principal remaining
SET $PIECE(DATA40,"^",2)=$PIECE(DATA40,"^",2)-RCTOTAL
+59 ;amount waived
SET $PIECE(DATA40,"^",5)=RCTOTAL
+60 SET ^PRCA(433,RCTRANDA,4,DA40,0)=DATA40
End DoDot:2
+61 ;
+62 DO SHOWTRAN(RCTRANDA)
+63 IF $$ASKOK^RCWROFF("Partial Waiver")'=1
DO DEL433^RCBEUTRA(RCTRANDA,"",0)
DO UNLOCK^RCWROFF
QUIT
+64 ;
+65 ; move the fy multiple from 433 to 430
+66 DO FYMULT^RCBEUBIL(RCTRANDA)
+67 ; mark transaction as processed
+68 DO PROCESS^RCBEUTRA(RCTRANDA)
+69 ; update the principal balance on the bill (subtract the waived amount)
+70 DO SETBAL^RCBEUBIL(RCTRANDA)
+71 ;PRCA*4.5*377 - Update active repayment plan attached to bill.
+72 DO UPDBAL^RCRPU1(RCBILLDA,RCTRANDA)
+73 ; create fms write off document, if not accrued
+74 IF '$$ACCK^PRCAACC(RCBILLDA)
DO FMSDOC^RCWROFF(RCTRANDA)
+75 ;
+76 WRITE !," * * * * * Partial Waiver has been PROCESSED! * * * * *"
+77 IF '$GET(REFMS)&(DT>$$LDATE^RCRJR(DT))
SET Y=$EXTRACT($$FPS^RCAMFN01(DT,1),1,5)_"01"
DO DD^%DT
WRITE !!," * * * * Transmission will be held until "_Y_" * * * *"
+78 DO UNLOCK^RCWROFF
End DoDot:1
if RCBILLDA<1
QUIT
+79 QUIT
+80 ;
+81 ;
SHOWTRAN(RCTRANDA) ; show data for transaction
+1 NEW %,DATA0,DATA1,DATA40,RCWRLINE,Y
+2 SET DATA0=$GET(^PRCA(433,RCTRANDA,0))
+3 SET DATA1=$GET(^PRCA(433,RCTRANDA,1))
+4 SET RCWRLINE=""
SET $PIECE(RCWRLINE,"=",79)=""
+5 WRITE !!,RCWRLINE
+6 WRITE !,"BILL NUMBER: ",$PIECE($GET(^PRCA(430,+$PIECE(DATA0,"^",2),0)),"^")
+7 WRITE ?40,"WAIVED AMOUNT: ",$JUSTIFY($PIECE(DATA1,"^",5),0,2)
+8 SET Y=$PIECE($PIECE(DATA1,"^"),".")
IF Y
DO DD^%DT
+9 WRITE !?42,"WAIVED DATE: ",Y
+10 WRITE !!,"FISCAL YEAR",?30,"WAIVED AMOUNT",?50,"NEW PRINCIPAL BALANCE DUE"
+11 SET %=0
FOR
SET %=$ORDER(^PRCA(433,RCTRANDA,4,%))
if '%
QUIT
Begin DoDot:1
+12 SET DATA40=$GET(^PRCA(433,RCTRANDA,4,%,0))
+13 WRITE !,$PIECE(DATA40,"^"),?30,$JUSTIFY($PIECE(DATA40,"^",5),13,2),?50,$JUSTIFY($PIECE(DATA40,"^",2),25,2)
End DoDot:1
+14 WRITE !!,RCWRLINE
+15 QUIT
+16 ;
+17 ;
SHOWBILL(RCBILLDA) ; show data for bill
+1 NEW DATA7,DATA20,FYDA
+2 SET DATA7=$GET(^PRCA(430,RCBILLDA,7))
+3 WRITE !?8,"Principal Balance: ",$JUSTIFY($PIECE(DATA7,"^"),11,2)
+4 ;
+5 ; show fy data
+6 SET FYDA=$ORDER(^PRCA(430,RCBILLDA,2,0))
SET DATA20=$GET(^PRCA(430,RCBILLDA,2,FYDA,0))
+7 WRITE ?40,"FY: ",$PIECE(DATA20,"^"),?48,"Principal Balance: ",$JUSTIFY($PIECE(DATA20,"^",2),0,2)
+8 ; if multiple fiscal years, show them here
+9 FOR
SET FYDA=$ORDER(^PRCA(430,RCBILLDA,2,FYDA))
if 'FYDA
QUIT
Begin DoDot:1
+10 SET DATA20=$GET(^PRCA(430,RCBILLDA,2,FYDA,0))
+11 WRITE !?40,"FY: ",$PIECE(DATA20,"^"),?48,"Principal Balance: ",$JUSTIFY($PIECE(DATA20,"^",2),0,2)
End DoDot:1
+12 ;
+13 WRITE !?8," Interest Balance: ",$JUSTIFY($PIECE(DATA7,"^",2),11,2)
+14 WRITE !?8," Admin Balance: ",$JUSTIFY($PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5),11,2)
+15 WRITE !?27,"-----------"
+16 WRITE !?8," TOTAL Balance: ",$JUSTIFY($PIECE(DATA7,"^")+$PIECE(DATA7,"^",2)+$PIECE(DATA7,"^",3)+$PIECE(DATA7,"^",4)+$PIECE(DATA7,"^",5),11,2)
+17 QUIT
