Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCRPFB

RCRPFB.m

Go to the documentation of this file. 
  1. RCRPFB ;EDE/SAB - REPAYMENT PLAN FORBEARBANCE;03/31/2021  8:40 AM
  1.  ;;4.5;Accounts Receivable;**378,389**;Mar 20, 1995;Build 36
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. MAIN ; Entry point for Forbearance Option
  1.  ;
  1.  N RCDONE
  1.  N IOBOFF,IOBON,IORVON,IORVOFF,X,LN
  1.  S RCDONE=0
  1.  F  D  Q:RCDONE
  1.  . S RCDONE1=0
  1.  . S RCRPIEN=$$SELRPP^RCRPU1() I RCRPIEN=-1 S RCDONE=1 Q
  1.  . I "^6^7^8^"[(U_$P($G(^RCRP(340.5,RCRPIEN,0)),U,7)_U) D  Q
  1.  . . S X="IOBON;IORVON;IOBOFF;IORVOFF" D ENDR^%ZISS
  1.  . . W !!,IOBON,IORVON,$$CJ^XLFSTR("*** WARNING: YOU HAVE SELECTED A CLOSED REPAYMENT PLAN ***",80),IORVOFF,IOBOFF,!!
  1.  . ;
  1.  . S LN=0
  1.  . S LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
  1.  . Q:'LN
  1.  . ;
  1.  . S LN=$$PRTSCHED^RCRPINQ(RCRPIEN,LN)
  1.  . Q:'LN
  1.  . ;
  1.  . S RCDONE1=$$PRTFORB^RCRPINQ(RCRPIEN,LN)
  1.  . Q:'LN
  1.  . ;
  1.  . S RCDONE1=$$FORBEAR(RCRPIEN,LN)
  1.  . Q:'LN
  1.  . ;
  1.  ;
  1.  Q
  1.  ;
  1. FORBEAR(RPIEN,LN) ; Ask the user for the month and year to move.
  1.  ;
  1.  N RCDONE,Y,DIR,DIRUT,RCSCHIEN,RCNEWDT,RCCONT,RCFBDT,LN
  1.  S RCDONE=0
  1.  S LN=1
  1.  S DIR(0)="DA"
  1.  S DIR("A")="Enter scheduled payment to Forbear (MM/DD/YY) or ""^"" to Quit: "
  1.  S DIR("?")="The payment the Debtor needs to be skip and reschedule."
  1.  F  D  Q:RCDONE>0
  1.  . S LN=$$WRTLN^RCRPINQ("",LN) Q:'LN
  1.  . D ^DIR
  1.  . I $D(DIRUT) S RCDONE=1 Q
  1.  . S RCFBDT=+Y
  1.  . S RCSCHIEN=$O(^RCRP(340.5,RPIEN,2,"B",Y,0))
  1.  . I 'RCSCHIEN D  Q
  1.  . . W !,"The payment date entered is not in the repayment plan.",!
  1.  . . W "Please try again.",!
  1.  . . D PAUSE^RCRPU
  1.  . ; PRCA*4.5*389
  1.  . I $P(^RCRP(340.5,RPIEN,2,RCSCHIEN,0),U,2) D  Q
  1.  . . W !!,"This scheduled payment cannot be forborne because the payment has"
  1.  . . W !,"already been received."
  1.  . . W !,"Please select another month to forbear.",!
  1.  . . D PAUSE^RCRPU
  1.  . I $P(^RCRP(340.5,RPIEN,2,RCSCHIEN,0),U,3) D  Q
  1.  . . W !!,"This scheduled payment cannot be forborne because the forbearance"
  1.  . . W !,"has already been granted."
  1.  . . W !,"Please select another month to forbear.",!
  1.  . . D PAUSE^RCRPU
  1.  . ;
  1.  . W !
  1.  . S RCNEWDT=$$CALCNWDT(RPIEN)
  1.  . S RCCONT=$$CORRECT($$FMTE^XLFDT(RCFBDT,2),$$FMTE^XLFDT(RCNEWDT,2))   ;Confirm that this is correct
  1.  . Q:'RCCONT
  1.  . ;Add new month to the plan
  1.  . D UPDSCHED(RPIEN,RCNEWDT)
  1.  . ;
  1.  . ;Update the forborne month Forbearance Field to Yes
  1.  . D UPDFRBFG(RPIEN,RCFBDT)
  1.  . ;
  1.  . ;File Audit Node entry
  1.  . D UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"E","F")
  1.  . ;
  1.  . ;File Forbearance Node Entry
  1.  . D UPDFORB(RPIEN,$$DT^XLFDT,RCFBDT,RCNEWDT,"H")
  1.  . ; update # of forbearances granted
  1.  . D INCFRBN(RPIEN)  ; PRCA*4.5*389
  1.  . ;
  1.  . S LN=13,LN=$$WRTLN^RCRPINQ($$CJ^XLFSTR("Forbearance granted successfully.",80),LN) Q:'LN
  1.  . ;
  1.  . ;Update AR Metrics File
  1.  . D UPDMET^RCSTATU(1.09,1)
  1.  . ;
  1.  . ; Pause here so user see's the confirmation.
  1.  . D PAUSE^RCRPU
  1.  . ;
  1.  . ;Re-display updated schedule
  1.  . S LN=$$PRTSCHED^RCRPINQ(RCRPIEN,LN)
  1.  . Q:'LN
  1.  . ;
  1.  . ;re-display forbearances granted
  1.  . S LN=$$PRTFORB^RCRPINQ(RCRPIEN,LN)
  1.  . I 'LN S RCDONE=1
  1.  ;
  1.  Q RCDONE
  1.  ;
  1. CORRECT(RCDT,RCNEWDT) ;Are you sure this is correct?
  1.  ; Input: (Optional) Prompt to display
  1.  ; Return: 1 for Yes
  1.  ;         0 for No
  1.  ;
  1.  N DIR,X,Y,RCPROMPT
  1.  S DIR(0)="Y",DIR("B")="YES",DIR("A")="Are you sure you wish to move the "_RCDT_" payment to "_RCNEWDT_"? (Y/N) "
  1.  D ^DIR
  1.  W !
  1.  Q Y
  1.  ;
  1. CALCNWDT(RCPIEN) ;Calculate the next date in the repayment plan.
  1.  N RCNEWDT,RCLSTDT,RCMN,RCYR
  1.  ;Retrieve the last payment date on the plan
  1.  S RCLSTDT=+$G(^RCRP(340.5,RCPIEN,2,$O(^RCRP(340.5,RCPIEN,2,"A"),-1),0))
  1.  ;
  1.  ;Get the month and year
  1.  S RCMN=+$E(RCLSTDT,4,5),RCYR=+$E(RCLSTDT,1,3)
  1.  ;
  1.  ;Add a Month
  1.  S RCMN=RCMN+1
  1.  ;
  1.  ;If the new month is month 13, reset the month to 1 and Add 1 to the year.
  1.  I RCMN>12 S RCMN=1,RCYR=RCYR+1
  1.  ;
  1.  ;Update the month to have 2 digits
  1.  I $L(RCMN)=1 S RCMN="0"_RCMN
  1.  ;
  1.  ;Rebuild the date in FileMan format.
  1.  S RCNEWDT=RCYR_RCMN_28
  1.  Q RCNEWDT
  1.  ;
  1. UPDFORB(RCRPIEN,RCCHGDT,RCLSTDT,RCNEWDT,RCCMMNT) ; Update the Audit Log for the Plan
  1.  ;
  1.  ;INPUT - RCRPIEN - IEN of the repayment plan to update
  1.  ;        RCCHGDT - date of the change
  1.  ;        RCCTYPE - RCTYPE (N)ew, (E)dit, or (C)lose
  1.  ;        RCCMMNT - Code for the reason
  1.  ;                   N - New Plan
  1.  ;                   T - Terms Adjustment
  1.  ;                   F - Forbearance Granted
  1.  ;                   S - System Termination
  1.  ;                   D - Defaulted for Non Payment (manual Default)
  1.  ;                   A - Administratively Closed (manual non default closing)
  1.  ;
  1.  N DLAYGO,DD,DO,DIC,DA,X,Y
  1.  N RCLSTMY,RCNEWMY
  1.  S RCLSTMY=$E(RCLSTDT,4,5)_"/"_($E(RCLSTDT,1,3)+1700)
  1.  S RCNEWMY=$E(RCNEWDT,4,5)_"/"_($E(RCNEWDT,1,3)+1700)
  1.  S DLAYGO=340.5,DA(1)=RCRPIEN,DIC(0)="",DIC="^RCRP(340.5,"_DA(1)_",5,",X=RCCHGDT
  1.  S DIC("DR")="1///"_RCLSTMY_";2///"_RCNEWMY_";3///"_DUZ_";4///"_RCCMMNT
  1.  D FILE^DICN
  1.  Q
  1.  ;
  1. UPDFRBFG(RCPIEN,RCLSTDT) ; Update the Forbearance flag in the plan schedule.
  1.  ;INPUT: RCPIEN  - IEN of plan to update
  1.  ;       RCLSTDT - Scheduled Payment to mark as forborne
  1.  ;
  1.  N DR,DIE,DA,X,Y
  1.  N RCI
  1.  ;
  1.  S RCI=$O(^RCRP(340.5,RCPIEN,2,"B",RCLSTDT,""))
  1.  S DR="2////1"
  1.  S DA(1)=RCPIEN,DA=RCI
  1.  S DIE="^RCRP(340.5,"_DA(1)_",2,"
  1.  D ^DIE
  1.  Q
  1.  ;
  1. UPDSCHED(RCRPIEN,RCNEWDT) ; Add another month to the schedule - For Forbearances only.
  1.  ;
  1.  ;Allowing for other activities that may need to occur in the future when moving the payment to a new month.
  1.  ;Add the new month to the schedule
  1.  D UPDSCHED^RCRPU(RCRPIEN,RCNEWDT)
  1.  ;
  1.  Q
  1.  ;
  1. INCFRBN(RCPIEN) ; increase # of forbearances (340.5/.09) by 1  PRCA*4.5*389
  1.  ;
  1.  ; RCPIEN  - file 340.5 ien
  1.  ;
  1.  N DR,DIE,DA,X,Y
  1.  N CURNUM
  1.  Q:+$G(RCPIEN)'>0
  1.  S CURNUM=+$P(^RCRP(340.5,RCPIEN,0),U,9)
  1.  S DR=".09///"_(CURNUM+1),DA=RCPIEN,DIE="^RCRP(340.5,"
  1.  D ^DIE
  1.  Q