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

RCRPADD.m

Go to the documentation of this file. 
  1. RCRPADD ;EDE/YMG - REPAYMENT PLAN FORBEARBANCE;03/31/2021  8:40 AM
  1.  ;;4.5;Accounts Receivable;**381,388,378,389,422**;Mar 20, 1995;Build 13
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  Q
  1.  ;
  1. EN1(RCRPIEN) ; entry point from repayment plan worklist, called from ^RCRPWL1  PRCA*4.5*389
  1.  ;
  1.  ; RCRPIEN - file 340.5 ien
  1.  ;
  1.  N RCDONE,QUIT,RCDONE1,RCRVW,LN
  1.  N IOBOFF,IOBON,IORVON,IORVOFF,X
  1.  S (RCDONE,LN)=0,QUIT=""
  1.  D PROCPLN1
  1.  ;Clean up working TMP array when exiting
  1.  K ^TMP("RCRPP",$J)
  1.  Q
  1.  ;
  1. MAIN ; Entry point for Forbearance Option
  1.  ;
  1.  N RCDONE,RCFLG36,QUIT,RCRVW,RCRPIEN,RCDONE1,LN
  1.  N IOBOFF,IOBON,IORVON,IORVOFF,X
  1.  ;
  1.  S (RCDONE,LN)=0,QUIT=""
  1.  F  Q:RCDONE  D PROCPLAN  Q:RCDONE
  1.  ;Clean up working TMP array when exiting
  1.  K ^TMP("RCRPP",$J)
  1.  Q
  1.  ;
  1. PROCPLAN ;
  1.  S RCDONE1=0,LN=0
  1.  I $E(IOST,1,2)["C-" W @IOF
  1.  S RCRPIEN=$$SELRPP^RCRPU1() S QUIT=0 I RCRPIEN=-1 S RCDONE=1 Q
  1.  ;I RCRPIEN="" S RCDONE=1 Q
  1.  I "^6^7^8^"[(U_$P($G(^RCRP(340.5,RCRPIEN,0)),U,7)_U) D  S:QUIT RCDONE=1 Q  ; PRCA*4.5*389
  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.  .D PAUSE^RCRPU
  1.  .Q
  1.  S RCFLG36=$P($G(^RCRP(340.5,RCRPIEN,1)),U,6) I RCFLG36=0 D  S:QUIT RCDONE=1 Q  ; PRCA*4.5*389
  1.  .W !!,"This plan is pending review on the Repayment Plan Worklist."
  1.  .W !,"Unable to add new bills at this time.",!
  1.  .D PAUSE^RCRPU
  1.  .Q
  1. PROCPLN1 ; PRCA*4.5*389
  1.  S RCRVW=$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I") I RCRVW D  S:QUIT RCDONE=1 Q  ; PRCA*4.5*389
  1.  .W !!,"The selected plan currently has more than 60 payments outstanding."
  1.  .W !,"Unable to add new bills to this plan until the plan's terms"
  1.  .W !,"are adjusted.",!
  1.  .D PAUSE^RCRPU
  1.  .Q
  1.  S LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
  1.  Q:'LN
  1.  D PAUSE^RCRPU
  1.  Q:$G(QUIT)
  1.  I $E(IOST,1,2)["C-" W @IOF
  1.  ;
  1.  S LN=0
  1.  S LN=$$PRTBILLS^RCRPINQ(RCRPIEN,LN)
  1.  ; User requested an exit, reset flag and quit
  1.  Q:'LN
  1.  S LN=0
  1.  D PAUSE^RCRPU
  1.  Q:$G(QUIT)
  1.  ;
  1.  ; reset screen output to the top
  1.  I $E(IOST,1,2)["C-" W @IOF
  1.  S RCDONE1=$$ADDNEW(RCRPIEN)
  1.  ; If user selected No at supervisor approval print message nothing updated and quit out to prompt for Payment Plan.
  1.  Q:RCDONE1>0
  1.  I RCDONE1=-1 D  Q:$G(QUIT)
  1.  . W !!,"The Repayment Plan was not updated."
  1.  . D PAUSE^RCRPU
  1.  . S QUIT=1
  1.  Q:RCDONE
  1.  ;
  1.  ; Reprint the Header and Bills
  1.  S LN=0
  1.  S LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
  1.  Q:'LN
  1.  ;
  1.  W !
  1.  ;
  1.  S LN=0
  1.  D PAUSE^RCRPU
  1.  Q:$G(QUIT)
  1.  I $E(IOST,1,2)["C-" W @IOF
  1.  S LN=$$PRTBILLS^RCRPINQ(RCRPIEN,LN)
  1.  D PAUSE^RCRPU
  1.  I 'LN S RCDONE=1
  1.  ;
  1.  Q
  1.  ;
  1. PRTHDR(RPIEN) ; display repayment plan data
  1.  ;
  1.  ; RPIEN is defined in tag EN
  1.  ;
  1.  N ADDRSTR,BAMNT,BILL,BSTAT,CBAL,CNT,DEBDOB,DEBPHN,DEBSSN,DEBTOR,LN,N0,RAMNT,TMP,TMPDT,TMPIEN
  1.  I $G(RPIEN)'>0 Q
  1.  S N0=$G(^RCRP(340.5,RPIEN,0)) ; 0-node in file 340.5
  1.  S DEBTOR=$P(N0,U,2)
  1.  S ADDRSTR=$$DADD^RCAMADD(DEBTOR,1)  ; ADDRSTR = Str1^Str2^Str3^City^State^ZIP^Telephone^Forein Country Code
  1.  U IO
  1.  I $E(IOST,1,2)["C-" W @IOF
  1.  S DEBSSN=+$$SSN^RCFN01(DEBTOR),DEBDOB=$$GETDOB^RCRPINQ(DEBTOR),DEBPHN=+$P(ADDRSTR,U,7)
  1.  W !!,"Debtor: ",$$NAM^RCFN01(DEBTOR)
  1.  W ?40,"SSN/TIN: ",$S(DEBSSN>0:$E(DEBSSN,1,3)_"-"_$E(DEBSSN,4,5)_"-"_$E(DEBSSN,6,9),1:"N/A")
  1.  W ?64,"DOB: ",$S(DEBDOB="":"N/A",1:DEBDOB)
  1.  W !,"Address: ",$P(ADDRSTR,U)," ",$P(ADDRSTR,U,2)," ",$P(ADDRSTR,U,3),", ",$P(ADDRSTR,U,4),", ",$P(ADDRSTR,U,5)," ",$P(ADDRSTR,U,6)
  1.  W !,"Phone: ",$S(DEBPHN>0:$$FMTPHONE^RCRPINQ(DEBPHN),1:"N/A"),!
  1.  W !,"Plan #: ",$P(N0,U),?28,"Status: ",$$EXTERNAL^DILFD(340.5,.07,"",$P(N0,U,7)),?49,"Last status date: ",$$FMTE^XLFDT($P(N0,U,8),"5DZ"),!
  1.  S CBAL=$$CBAL^RCRPU3(RPIEN,$P(N0,U,11)),RAMNT=$P(N0,U,6)  ; PRCA*4.5*389
  1.  W !,?2,"Current balance: $",$FN(CBAL,"",2),?37,"Number of payments remaining: ",$$REMPMNTS^RCRPU3(RPIEN,RAMNT)  ; PRCA*4.5*389
  1.  W !,?1,"Orig amount owed: $",$FN($P(N0,U,13),"",2),?38,"Original number of payments: ",$P(N0,U,14)
  1.  W !,"Total amount owed: $",$FN($P(N0,U,11),"",2),?41,"Total number of payments: ",$P(N0,U,5)
  1.  W !,?1,"Repayment amount: $",$FN(RAMNT,"",2),?47,"Auto-add New Bills: ",$$GET1^DIQ(340.5,RPIEN_",",.12,"E"),!!
  1.  Q
  1.  ;
  1. ADDNEW(RPIEN) ; Ask the user for the bills to add.
  1.  ;
  1.  N RCDONE,RCCTS,Y,DIRUT,RCALLFLG,RCBLCH,RCTOT,RCORBAL,RCNOMN,RCNWMN,RCDBTR,RCSPFLG,RCFLG36
  1.  N RCMNPAY,RCNEWTOT,RCNEWLN,RCBILLDA,RCACTDT,RCRMBAL,RCRMLN,RCPLNBL,RCNWMOD,QUIT
  1.  S RCSPFLG=0,RCFLG36=""  ; PRCA*4.5*389
  1.  ;
  1.  ;Clear ^TMP array
  1.  K ^TMP("RCRPP",$J)
  1.  S RCDBTR=$$GET1^DIQ(340.5,RPIEN_",",.02,"I")
  1.  S RCDONE=0,RCACTDT=$$DT^XLFDT
  1.  ; Retrieve new bills for Debtor
  1.  S RCCTS=$$GETACTS^RCRPU(RCDBTR)   ;Look for only new bills to add to the account.
  1.  ; If no new bills, alert user and exit.
  1.  I +RCCTS<1 D  Q 1
  1.  . W !!,"No new bills available to add to this Debtor's plan.",!
  1.  . D PAUSE^RCRPU
  1.  ;
  1.  ;Print New Bills to be added
  1.  D PRTNB(+RCCTS)
  1.  ;
  1.  ;Ask user which Active bills to add to new plan (single, range, or all)
  1.  S RCBLCH=$$GETBILLS^RCRPU(+RCCTS)
  1.  S RCALLFLG=+RCBLCH
  1.  S RCBLCH=$P(RCBLCH,U,2)
  1.  ;
  1.  ;Escape of no bills were selected.
  1.  I RCBLCH="" D  Q 1
  1.  . W !,"No Bills selected",!
  1.  . D PAUSE^RCRPU
  1.  . W @IOF
  1.  ;
  1.  I 'RCALLFLG D  Q:'RCDONE 1
  1.  .  S RCDONE=$$ECHOBL(RCBLCH)
  1.  ;
  1.  ;Display total sum of bills chosen and confirm with user, exit if no.
  1.  S RCTOT=$$TOT^RCRPU(RCBLCH)
  1.  I '+RCTOT D  Q 1
  1.  . D PAUSE^RCRPU    ;Any key to continue prompt
  1.  ;
  1.  ;Strip confirm flag to get total.
  1.  S RCTOT=$P(RCTOT,U,2)
  1.  ;
  1.  ;Get existing Plan info
  1.  S RCORBAL=$$GET1^DIQ(340.5,RPIEN_",",.11,"I")
  1.  S RCMNPAY=$$GET1^DIQ(340.5,RPIEN_",",.06,"I")
  1.  ;
  1.  ;Calculate the new Potential remaining balance
  1.  S RCRMBAL=$$CBAL^RCRPU3(RPIEN,RCORBAL)  ; PRCA*4.5*389
  1.  S RCNEWTOT=RCTOT+RCRMBAL,RCNEWLN=RCNEWTOT/RCMNPAY
  1.  ;
  1.  ;If the new term length will become >57 months by adding these bills,
  1.  ; display a warning message to the user and exit.
  1.  I RCNEWLN>57 D  Q 1  ; PRCA*4.5*389
  1.  .W !,"Adding these bills will make the number of remaining payments on the"
  1.  .W !,"plan > 57 months.  Unable to add new bills to this plan until the"
  1.  .W !,"plan's terms are adjusted."
  1.  .D PAUSE^RCRPU
  1.  .Q
  1.  ;
  1.  I RCNEWLN>36 D  ; PRCA*4.5*389
  1.  .S RCFLG36=$$GET36^RCRPWLUT(RPIEN)
  1.  .I RCFLG36=2 D  ; denied 36 months approval
  1.  ..W !,"Adding these bills will make the number of remaining payments on the"
  1.  ..W !,"plan > 36 months. 36 months supervisor approval was denied for this"
  1.  ..W !,"plan - no bills may be added to it."
  1.  ..S RCSPFLG=-1
  1.  ..Q
  1.  .I RCFLG36=0 D  ; 36 month approval needed  PRCA*4.5*422
  1.  ..W !,"The number of payments exceeds 36 payments.",!
  1.  ..I $$SUPAPPR^RCRPU(2)=1 S RCSPFLG=1 D UPDFLG36^RCRPU1(RPIEN,1),UPDAUDIT^RCRPU2(RPIEN,DT,"E","SM","")
  1.  ..Q
  1.  .I RCFLG36=1 S RCSPFLG=1  ; already have 36 months approval
  1.  .Q
  1.  I RCNEWLN>36,(RCSPFLG<1) Q -1 ; No Supervisor approval when required
  1.  ;
  1.  ; Add the Bill to the plan.
  1.  S RCBILLDA=0
  1.  F  S RCBILLDA=$O(^TMP("RCRPP",$J,"BILLS",RCBILLDA)) Q:'RCBILLDA  D
  1.  . D UPDBILL^RCRPU(RPIEN,RCBILLDA)
  1.  . ; Add Plan to the Bill
  1.  . D ADDPLAN^RCRPU(RPIEN,RCBILLDA,RCACTDT)
  1.  . D UPDMET^RCSTATU(1.01,1)
  1.  ;
  1.  ; Update the Total balance Owed.
  1.  S RCPLNBL=RCTOT+RCORBAL
  1.  D UPDPAO^RCRPU1(RPIEN,RCPLNBL)
  1.  ;
  1.  ; Recalculate the total # payments.
  1.  S RCNOMN=$$GET1^DIQ(340.5,RPIEN_",",.05,"I")
  1.  S RCNWMN=RCPLNBL\RCMNPAY,RCNWMOD=RCPLNBL#RCMNPAY
  1.  I RCNWMOD>0 S RCNWMN=RCNWMN+1
  1.  ;
  1.  ; If there is a change in term length, update the plan and the schedule.
  1.  I RCNOMN'=RCNWMN D
  1.  .  D UPDTERMS^RCRPU1(RPIEN,RCMNPAY_"^"_RCNWMN)
  1.  .  D ADJSCHED^RCRPENTR(RPIEN,RCNOMN,RCNWMN)
  1.  ;
  1.  ;Update Audit Log
  1.  I RCSPFLG<1!(RCSPFLG=1&(RCFLG36=1)) D UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"A","")  ; PRCA*4.5*389
  1.  I RCSPFLG=1,RCFLG36=0 D UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"A","SM"),UPDFLG36^RCRPU1(RCRPIEN,1)  ; PRCA*4.5*389
  1.  ;
  1.  W !,"Bills successfully added to the Plan.",!
  1.  ;
  1.  ;Pause for the user to read the output, then escape the option if they wish to.
  1.  D PAUSE^RCRPU W ! S $Y=0 I $G(QUIT) Q 1
  1.  Q 0
  1.  ;
  1. PRTNB(RCCTS) ;Print the new Bills to be added, with header
  1.  ;
  1.  W !!,?26,"Bills Available for Selection"
  1.  W ! D DASH^RCRPRPU(80)
  1.  ;
  1.  D PRTACTS^RCRPU(RCCTS)
  1.  Q
  1.  ;
  1. ECHOBL(RCBLCH) ; Echo the Lits of Bills selected
  1.  ; Input:  RCBLCH - List of bills to added.
  1.  ;
  1.  N RCBILL,RCBILLDA
  1.  ;
  1.  S RCBILLDA=0
  1.  ;Display the bills selected
  1.  W !,"You chose to add the following bill(s) to this plan:",!!
  1.  F  S RCBILLDA=$O(^TMP("RCRPP",$J,"BILLS",RCBILLDA)) Q:'RCBILLDA  D
  1.  .  S RCBILL=$P($G(^PRCA(430,RCBILLDA,0)),U)
  1.  .  W RCBILL,!
  1.  ;
  1.  ;Ask if correct and exit with the answer
  1.  Q $$CORRECT^RCRPU