- 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 Feb 18, 2025@23:15:37 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