RCRPFB ;EDE/SAB - REPAYMENT PLAN FORBEARBANCE;03/31/2021 8:40 AM
;;4.5;Accounts Receivable;**378,389**;Mar 20, 1995;Build 36
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
MAIN ; Entry point for Forbearance Option
;
N RCDONE
N IOBOFF,IOBON,IORVON,IORVOFF,X,LN
S RCDONE=0
F D Q:RCDONE
. S RCDONE1=0
. S RCRPIEN=$$SELRPP^RCRPU1() I RCRPIEN=-1 S RCDONE=1 Q
. I "^6^7^8^"[(U_$P($G(^RCRP(340.5,RCRPIEN,0)),U,7)_U) D Q
. . S X="IOBON;IORVON;IOBOFF;IORVOFF" D ENDR^%ZISS
. . W !!,IOBON,IORVON,$$CJ^XLFSTR("*** WARNING: YOU HAVE SELECTED A CLOSED REPAYMENT PLAN ***",80),IORVOFF,IOBOFF,!!
. ;
. S LN=0
. S LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
. Q:'LN
. ;
. S LN=$$PRTSCHED^RCRPINQ(RCRPIEN,LN)
. Q:'LN
. ;
. S RCDONE1=$$PRTFORB^RCRPINQ(RCRPIEN,LN)
. Q:'LN
. ;
. S RCDONE1=$$FORBEAR(RCRPIEN,LN)
. Q:'LN
. ;
;
Q
;
FORBEAR(RPIEN,LN) ; Ask the user for the month and year to move.
;
N RCDONE,Y,DIR,DIRUT,RCSCHIEN,RCNEWDT,RCCONT,RCFBDT,LN
S RCDONE=0
S LN=1
S DIR(0)="DA"
S DIR("A")="Enter scheduled payment to Forbear (MM/DD/YY) or ""^"" to Quit: "
S DIR("?")="The payment the Debtor needs to be skip and reschedule."
F D Q:RCDONE>0
. S LN=$$WRTLN^RCRPINQ("",LN) Q:'LN
. D ^DIR
. I $D(DIRUT) S RCDONE=1 Q
. S RCFBDT=+Y
. S RCSCHIEN=$O(^RCRP(340.5,RPIEN,2,"B",Y,0))
. I 'RCSCHIEN D Q
. . W !,"The payment date entered is not in the repayment plan.",!
. . W "Please try again.",!
. . D PAUSE^RCRPU
. ; PRCA*4.5*389
. I $P(^RCRP(340.5,RPIEN,2,RCSCHIEN,0),U,2) D Q
. . W !!,"This scheduled payment cannot be forborne because the payment has"
. . W !,"already been received."
. . W !,"Please select another month to forbear.",!
. . D PAUSE^RCRPU
. I $P(^RCRP(340.5,RPIEN,2,RCSCHIEN,0),U,3) D Q
. . W !!,"This scheduled payment cannot be forborne because the forbearance"
. . W !,"has already been granted."
. . W !,"Please select another month to forbear.",!
. . D PAUSE^RCRPU
. ;
. W !
. S RCNEWDT=$$CALCNWDT(RPIEN)
. S RCCONT=$$CORRECT($$FMTE^XLFDT(RCFBDT,2),$$FMTE^XLFDT(RCNEWDT,2)) ;Confirm that this is correct
. Q:'RCCONT
. ;Add new month to the plan
. D UPDSCHED(RPIEN,RCNEWDT)
. ;
. ;Update the forborne month Forbearance Field to Yes
. D UPDFRBFG(RPIEN,RCFBDT)
. ;
. ;File Audit Node entry
. D UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"E","F")
. ;
. ;File Forbearance Node Entry
. D UPDFORB(RPIEN,$$DT^XLFDT,RCFBDT,RCNEWDT,"H")
. ; update # of forbearances granted
. D INCFRBN(RPIEN) ; PRCA*4.5*389
. ;
. S LN=13,LN=$$WRTLN^RCRPINQ($$CJ^XLFSTR("Forbearance granted successfully.",80),LN) Q:'LN
. ;
. ;Update AR Metrics File
. D UPDMET^RCSTATU(1.09,1)
. ;
. ; Pause here so user see's the confirmation.
. D PAUSE^RCRPU
. ;
. ;Re-display updated schedule
. S LN=$$PRTSCHED^RCRPINQ(RCRPIEN,LN)
. Q:'LN
. ;
. ;re-display forbearances granted
. S LN=$$PRTFORB^RCRPINQ(RCRPIEN,LN)
. I 'LN S RCDONE=1
;
Q RCDONE
;
CORRECT(RCDT,RCNEWDT) ;Are you sure this is correct?
; Input: (Optional) Prompt to display
; Return: 1 for Yes
; 0 for No
;
N DIR,X,Y,RCPROMPT
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you sure you wish to move the "_RCDT_" payment to "_RCNEWDT_"? (Y/N) "
D ^DIR
W !
Q Y
;
CALCNWDT(RCPIEN) ;Calculate the next date in the repayment plan.
N RCNEWDT,RCLSTDT,RCMN,RCYR
;Retrieve the last payment date on the plan
S RCLSTDT=+$G(^RCRP(340.5,RCPIEN,2,$O(^RCRP(340.5,RCPIEN,2,"A"),-1),0))
;
;Get the month and year
S RCMN=+$E(RCLSTDT,4,5),RCYR=+$E(RCLSTDT,1,3)
;
;Add a Month
S RCMN=RCMN+1
;
;If the new month is month 13, reset the month to 1 and Add 1 to the year.
I RCMN>12 S RCMN=1,RCYR=RCYR+1
;
;Update the month to have 2 digits
I $L(RCMN)=1 S RCMN="0"_RCMN
;
;Rebuild the date in FileMan format.
S RCNEWDT=RCYR_RCMN_28
Q RCNEWDT
;
UPDFORB(RCRPIEN,RCCHGDT,RCLSTDT,RCNEWDT,RCCMMNT) ; Update the Audit Log for the Plan
;
;INPUT - RCRPIEN - IEN of the repayment plan to update
; RCCHGDT - date of the change
; RCCTYPE - RCTYPE (N)ew, (E)dit, or (C)lose
; RCCMMNT - Code for the reason
; N - New Plan
; T - Terms Adjustment
; F - Forbearance Granted
; S - System Termination
; D - Defaulted for Non Payment (manual Default)
; A - Administratively Closed (manual non default closing)
;
N DLAYGO,DD,DO,DIC,DA,X,Y
N RCLSTMY,RCNEWMY
S RCLSTMY=$E(RCLSTDT,4,5)_"/"_($E(RCLSTDT,1,3)+1700)
S RCNEWMY=$E(RCNEWDT,4,5)_"/"_($E(RCNEWDT,1,3)+1700)
S DLAYGO=340.5,DA(1)=RCRPIEN,DIC(0)="",DIC="^RCRP(340.5,"_DA(1)_",5,",X=RCCHGDT
S DIC("DR")="1///"_RCLSTMY_";2///"_RCNEWMY_";3///"_DUZ_";4///"_RCCMMNT
D FILE^DICN
Q
;
UPDFRBFG(RCPIEN,RCLSTDT) ; Update the Forbearance flag in the plan schedule.
;INPUT: RCPIEN - IEN of plan to update
; RCLSTDT - Scheduled Payment to mark as forborne
;
N DR,DIE,DA,X,Y
N RCI
;
S RCI=$O(^RCRP(340.5,RCPIEN,2,"B",RCLSTDT,""))
S DR="2////1"
S DA(1)=RCPIEN,DA=RCI
S DIE="^RCRP(340.5,"_DA(1)_",2,"
D ^DIE
Q
;
UPDSCHED(RCRPIEN,RCNEWDT) ; Add another month to the schedule - For Forbearances only.
;
;Allowing for other activities that may need to occur in the future when moving the payment to a new month.
;Add the new month to the schedule
D UPDSCHED^RCRPU(RCRPIEN,RCNEWDT)
;
Q
;
INCFRBN(RCPIEN) ; increase # of forbearances (340.5/.09) by 1 PRCA*4.5*389
;
; RCPIEN - file 340.5 ien
;
N DR,DIE,DA,X,Y
N CURNUM
Q:+$G(RCPIEN)'>0
S CURNUM=+$P(^RCRP(340.5,RCPIEN,0),U,9)
S DR=".09///"_(CURNUM+1),DA=RCPIEN,DIE="^RCRP(340.5,"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPFB 5766 printed Apr 09, 2024@20:47:53 Page 2
RCRPFB ;EDE/SAB - REPAYMENT PLAN FORBEARBANCE;03/31/2021 8:40 AM
+1 ;;4.5;Accounts Receivable;**378,389**;Mar 20, 1995;Build 36
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
MAIN ; Entry point for Forbearance Option
+1 ;
+2 NEW RCDONE
+3 NEW IOBOFF,IOBON,IORVON,IORVOFF,X,LN
+4 SET RCDONE=0
+5 FOR
Begin DoDot:1
+6 SET RCDONE1=0
+7 SET RCRPIEN=$$SELRPP^RCRPU1()
IF RCRPIEN=-1
SET RCDONE=1
QUIT
+8 IF "^6^7^8^"[(U_$PIECE($GET(^RCRP(340.5,RCRPIEN,0)),U,7)_U)
Begin DoDot:2
+9 SET X="IOBON;IORVON;IOBOFF;IORVOFF"
DO ENDR^%ZISS
+10 WRITE !!,IOBON,IORVON,$$CJ^XLFSTR("*** WARNING: YOU HAVE SELECTED A CLOSED REPAYMENT PLAN ***",80),IORVOFF,IOBOFF,!!
End DoDot:2
QUIT
+11 ;
+12 SET LN=0
+13 SET LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
+14 if 'LN
QUIT
+15 ;
+16 SET LN=$$PRTSCHED^RCRPINQ(RCRPIEN,LN)
+17 if 'LN
QUIT
+18 ;
+19 SET RCDONE1=$$PRTFORB^RCRPINQ(RCRPIEN,LN)
+20 if 'LN
QUIT
+21 ;
+22 SET RCDONE1=$$FORBEAR(RCRPIEN,LN)
+23 if 'LN
QUIT
+24 ;
End DoDot:1
if RCDONE
QUIT
+25 ;
+26 QUIT
+27 ;
FORBEAR(RPIEN,LN) ; Ask the user for the month and year to move.
+1 ;
+2 NEW RCDONE,Y,DIR,DIRUT,RCSCHIEN,RCNEWDT,RCCONT,RCFBDT,LN
+3 SET RCDONE=0
+4 SET LN=1
+5 SET DIR(0)="DA"
+6 SET DIR("A")="Enter scheduled payment to Forbear (MM/DD/YY) or ""^"" to Quit: "
+7 SET DIR("?")="The payment the Debtor needs to be skip and reschedule."
+8 FOR
Begin DoDot:1
+9 SET LN=$$WRTLN^RCRPINQ("",LN)
if 'LN
QUIT
+10 DO ^DIR
+11 IF $DATA(DIRUT)
SET RCDONE=1
QUIT
+12 SET RCFBDT=+Y
+13 SET RCSCHIEN=$ORDER(^RCRP(340.5,RPIEN,2,"B",Y,0))
+14 IF 'RCSCHIEN
Begin DoDot:2
+15 WRITE !,"The payment date entered is not in the repayment plan.",!
+16 WRITE "Please try again.",!
+17 DO PAUSE^RCRPU
End DoDot:2
QUIT
+18 ; PRCA*4.5*389
+19 IF $PIECE(^RCRP(340.5,RPIEN,2,RCSCHIEN,0),U,2)
Begin DoDot:2
+20 WRITE !!,"This scheduled payment cannot be forborne because the payment has"
+21 WRITE !,"already been received."
+22 WRITE !,"Please select another month to forbear.",!
+23 DO PAUSE^RCRPU
End DoDot:2
QUIT
+24 IF $PIECE(^RCRP(340.5,RPIEN,2,RCSCHIEN,0),U,3)
Begin DoDot:2
+25 WRITE !!,"This scheduled payment cannot be forborne because the forbearance"
+26 WRITE !,"has already been granted."
+27 WRITE !,"Please select another month to forbear.",!
+28 DO PAUSE^RCRPU
End DoDot:2
QUIT
+29 ;
+30 WRITE !
+31 SET RCNEWDT=$$CALCNWDT(RPIEN)
+32 ;Confirm that this is correct
SET RCCONT=$$CORRECT($$FMTE^XLFDT(RCFBDT,2),$$FMTE^XLFDT(RCNEWDT,2))
+33 if 'RCCONT
QUIT
+34 ;Add new month to the plan
+35 DO UPDSCHED(RPIEN,RCNEWDT)
+36 ;
+37 ;Update the forborne month Forbearance Field to Yes
+38 DO UPDFRBFG(RPIEN,RCFBDT)
+39 ;
+40 ;File Audit Node entry
+41 DO UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"E","F")
+42 ;
+43 ;File Forbearance Node Entry
+44 DO UPDFORB(RPIEN,$$DT^XLFDT,RCFBDT,RCNEWDT,"H")
+45 ; update # of forbearances granted
+46 ; PRCA*4.5*389
DO INCFRBN(RPIEN)
+47 ;
+48 SET LN=13
SET LN=$$WRTLN^RCRPINQ($$CJ^XLFSTR("Forbearance granted successfully.",80),LN)
if 'LN
QUIT
+49 ;
+50 ;Update AR Metrics File
+51 DO UPDMET^RCSTATU(1.09,1)
+52 ;
+53 ; Pause here so user see's the confirmation.
+54 DO PAUSE^RCRPU
+55 ;
+56 ;Re-display updated schedule
+57 SET LN=$$PRTSCHED^RCRPINQ(RCRPIEN,LN)
+58 if 'LN
QUIT
+59 ;
+60 ;re-display forbearances granted
+61 SET LN=$$PRTFORB^RCRPINQ(RCRPIEN,LN)
+62 IF 'LN
SET RCDONE=1
End DoDot:1
if RCDONE>0
QUIT
+63 ;
+64 QUIT RCDONE
+65 ;
CORRECT(RCDT,RCNEWDT) ;Are you sure this is correct?
+1 ; Input: (Optional) Prompt to display
+2 ; Return: 1 for Yes
+3 ; 0 for No
+4 ;
+5 NEW DIR,X,Y,RCPROMPT
+6 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Are you sure you wish to move the "_RCDT_" payment to "_RCNEWDT_"? (Y/N) "
+7 DO ^DIR
+8 WRITE !
+9 QUIT Y
+10 ;
CALCNWDT(RCPIEN) ;Calculate the next date in the repayment plan.
+1 NEW RCNEWDT,RCLSTDT,RCMN,RCYR
+2 ;Retrieve the last payment date on the plan
+3 SET RCLSTDT=+$GET(^RCRP(340.5,RCPIEN,2,$ORDER(^RCRP(340.5,RCPIEN,2,"A"),-1),0))
+4 ;
+5 ;Get the month and year
+6 SET RCMN=+$EXTRACT(RCLSTDT,4,5)
SET RCYR=+$EXTRACT(RCLSTDT,1,3)
+7 ;
+8 ;Add a Month
+9 SET RCMN=RCMN+1
+10 ;
+11 ;If the new month is month 13, reset the month to 1 and Add 1 to the year.
+12 IF RCMN>12
SET RCMN=1
SET RCYR=RCYR+1
+13 ;
+14 ;Update the month to have 2 digits
+15 IF $LENGTH(RCMN)=1
SET RCMN="0"_RCMN
+16 ;
+17 ;Rebuild the date in FileMan format.
+18 SET RCNEWDT=RCYR_RCMN_28
+19 QUIT RCNEWDT
+20 ;
UPDFORB(RCRPIEN,RCCHGDT,RCLSTDT,RCNEWDT,RCCMMNT) ; Update the Audit Log for the Plan
+1 ;
+2 ;INPUT - RCRPIEN - IEN of the repayment plan to update
+3 ; RCCHGDT - date of the change
+4 ; RCCTYPE - RCTYPE (N)ew, (E)dit, or (C)lose
+5 ; RCCMMNT - Code for the reason
+6 ; N - New Plan
+7 ; T - Terms Adjustment
+8 ; F - Forbearance Granted
+9 ; S - System Termination
+10 ; D - Defaulted for Non Payment (manual Default)
+11 ; A - Administratively Closed (manual non default closing)
+12 ;
+13 NEW DLAYGO,DD,DO,DIC,DA,X,Y
+14 NEW RCLSTMY,RCNEWMY
+15 SET RCLSTMY=$EXTRACT(RCLSTDT,4,5)_"/"_($EXTRACT(RCLSTDT,1,3)+1700)
+16 SET RCNEWMY=$EXTRACT(RCNEWDT,4,5)_"/"_($EXTRACT(RCNEWDT,1,3)+1700)
+17 SET DLAYGO=340.5
SET DA(1)=RCRPIEN
SET DIC(0)=""
SET DIC="^RCRP(340.5,"_DA(1)_",5,"
SET X=RCCHGDT
+18 SET DIC("DR")="1///"_RCLSTMY_";2///"_RCNEWMY_";3///"_DUZ_";4///"_RCCMMNT
+19 DO FILE^DICN
+20 QUIT
+21 ;
UPDFRBFG(RCPIEN,RCLSTDT) ; Update the Forbearance flag in the plan schedule.
+1 ;INPUT: RCPIEN - IEN of plan to update
+2 ; RCLSTDT - Scheduled Payment to mark as forborne
+3 ;
+4 NEW DR,DIE,DA,X,Y
+5 NEW RCI
+6 ;
+7 SET RCI=$ORDER(^RCRP(340.5,RCPIEN,2,"B",RCLSTDT,""))
+8 SET DR="2////1"
+9 SET DA(1)=RCPIEN
SET DA=RCI
+10 SET DIE="^RCRP(340.5,"_DA(1)_",2,"
+11 DO ^DIE
+12 QUIT
+13 ;
UPDSCHED(RCRPIEN,RCNEWDT) ; Add another month to the schedule - For Forbearances only.
+1 ;
+2 ;Allowing for other activities that may need to occur in the future when moving the payment to a new month.
+3 ;Add the new month to the schedule
+4 DO UPDSCHED^RCRPU(RCRPIEN,RCNEWDT)
+5 ;
+6 QUIT
+7 ;
INCFRBN(RCPIEN) ; increase # of forbearances (340.5/.09) by 1 PRCA*4.5*389
+1 ;
+2 ; RCPIEN - file 340.5 ien
+3 ;
+4 NEW DR,DIE,DA,X,Y
+5 NEW CURNUM
+6 if +$GET(RCPIEN)'>0
QUIT
+7 SET CURNUM=+$PIECE(^RCRP(340.5,RCPIEN,0),U,9)
+8 SET DR=".09///"_(CURNUM+1)
SET DA=RCPIEN
SET DIE="^RCRP(340.5,"
+9 DO ^DIE
+10 QUIT
