RCRPADD ;EDE/YMG - REPAYMENT PLAN FORBEARBANCE;03/31/2021 8:40 AM
;;4.5;Accounts Receivable;**381,388,378,389,422**;Mar 20, 1995;Build 13
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN1(RCRPIEN) ; entry point from repayment plan worklist, called from ^RCRPWL1 PRCA*4.5*389
;
; RCRPIEN - file 340.5 ien
;
N RCDONE,QUIT,RCDONE1,RCRVW,LN
N IOBOFF,IOBON,IORVON,IORVOFF,X
S (RCDONE,LN)=0,QUIT=""
D PROCPLN1
;Clean up working TMP array when exiting
K ^TMP("RCRPP",$J)
Q
;
MAIN ; Entry point for Forbearance Option
;
N RCDONE,RCFLG36,QUIT,RCRVW,RCRPIEN,RCDONE1,LN
N IOBOFF,IOBON,IORVON,IORVOFF,X
;
S (RCDONE,LN)=0,QUIT=""
F Q:RCDONE D PROCPLAN Q:RCDONE
;Clean up working TMP array when exiting
K ^TMP("RCRPP",$J)
Q
;
PROCPLAN ;
S RCDONE1=0,LN=0
I $E(IOST,1,2)["C-" W @IOF
S RCRPIEN=$$SELRPP^RCRPU1() S QUIT=0 I RCRPIEN=-1 S RCDONE=1 Q
;I RCRPIEN="" S RCDONE=1 Q
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
.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,!!
.D PAUSE^RCRPU
.Q
S RCFLG36=$P($G(^RCRP(340.5,RCRPIEN,1)),U,6) I RCFLG36=0 D S:QUIT RCDONE=1 Q ; PRCA*4.5*389
.W !!,"This plan is pending review on the Repayment Plan Worklist."
.W !,"Unable to add new bills at this time.",!
.D PAUSE^RCRPU
.Q
PROCPLN1 ; PRCA*4.5*389
S RCRVW=$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I") I RCRVW D S:QUIT RCDONE=1 Q ; PRCA*4.5*389
.W !!,"The selected plan currently has more than 60 payments outstanding."
.W !,"Unable to add new bills to this plan until the plan's terms"
.W !,"are adjusted.",!
.D PAUSE^RCRPU
.Q
S LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
Q:'LN
D PAUSE^RCRPU
Q:$G(QUIT)
I $E(IOST,1,2)["C-" W @IOF
;
S LN=0
S LN=$$PRTBILLS^RCRPINQ(RCRPIEN,LN)
; User requested an exit, reset flag and quit
Q:'LN
S LN=0
D PAUSE^RCRPU
Q:$G(QUIT)
;
; reset screen output to the top
I $E(IOST,1,2)["C-" W @IOF
S RCDONE1=$$ADDNEW(RCRPIEN)
; If user selected No at supervisor approval print message nothing updated and quit out to prompt for Payment Plan.
Q:RCDONE1>0
I RCDONE1=-1 D Q:$G(QUIT)
. W !!,"The Repayment Plan was not updated."
. D PAUSE^RCRPU
. S QUIT=1
Q:RCDONE
;
; Reprint the Header and Bills
S LN=0
S LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
Q:'LN
;
W !
;
S LN=0
D PAUSE^RCRPU
Q:$G(QUIT)
I $E(IOST,1,2)["C-" W @IOF
S LN=$$PRTBILLS^RCRPINQ(RCRPIEN,LN)
D PAUSE^RCRPU
I 'LN S RCDONE=1
;
Q
;
PRTHDR(RPIEN) ; display repayment plan data
;
; RPIEN is defined in tag EN
;
N ADDRSTR,BAMNT,BILL,BSTAT,CBAL,CNT,DEBDOB,DEBPHN,DEBSSN,DEBTOR,LN,N0,RAMNT,TMP,TMPDT,TMPIEN
I $G(RPIEN)'>0 Q
S N0=$G(^RCRP(340.5,RPIEN,0)) ; 0-node in file 340.5
S DEBTOR=$P(N0,U,2)
S ADDRSTR=$$DADD^RCAMADD(DEBTOR,1) ; ADDRSTR = Str1^Str2^Str3^City^State^ZIP^Telephone^Forein Country Code
U IO
I $E(IOST,1,2)["C-" W @IOF
S DEBSSN=+$$SSN^RCFN01(DEBTOR),DEBDOB=$$GETDOB^RCRPINQ(DEBTOR),DEBPHN=+$P(ADDRSTR,U,7)
W !!,"Debtor: ",$$NAM^RCFN01(DEBTOR)
W ?40,"SSN/TIN: ",$S(DEBSSN>0:$E(DEBSSN,1,3)_"-"_$E(DEBSSN,4,5)_"-"_$E(DEBSSN,6,9),1:"N/A")
W ?64,"DOB: ",$S(DEBDOB="":"N/A",1:DEBDOB)
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)
W !,"Phone: ",$S(DEBPHN>0:$$FMTPHONE^RCRPINQ(DEBPHN),1:"N/A"),!
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"),!
S CBAL=$$CBAL^RCRPU3(RPIEN,$P(N0,U,11)),RAMNT=$P(N0,U,6) ; PRCA*4.5*389
W !,?2,"Current balance: $",$FN(CBAL,"",2),?37,"Number of payments remaining: ",$$REMPMNTS^RCRPU3(RPIEN,RAMNT) ; PRCA*4.5*389
W !,?1,"Orig amount owed: $",$FN($P(N0,U,13),"",2),?38,"Original number of payments: ",$P(N0,U,14)
W !,"Total amount owed: $",$FN($P(N0,U,11),"",2),?41,"Total number of payments: ",$P(N0,U,5)
W !,?1,"Repayment amount: $",$FN(RAMNT,"",2),?47,"Auto-add New Bills: ",$$GET1^DIQ(340.5,RPIEN_",",.12,"E"),!!
Q
;
ADDNEW(RPIEN) ; Ask the user for the bills to add.
;
N RCDONE,RCCTS,Y,DIRUT,RCALLFLG,RCBLCH,RCTOT,RCORBAL,RCNOMN,RCNWMN,RCDBTR,RCSPFLG,RCFLG36
N RCMNPAY,RCNEWTOT,RCNEWLN,RCBILLDA,RCACTDT,RCRMBAL,RCRMLN,RCPLNBL,RCNWMOD,QUIT
S RCSPFLG=0,RCFLG36="" ; PRCA*4.5*389
;
;Clear ^TMP array
K ^TMP("RCRPP",$J)
S RCDBTR=$$GET1^DIQ(340.5,RPIEN_",",.02,"I")
S RCDONE=0,RCACTDT=$$DT^XLFDT
; Retrieve new bills for Debtor
S RCCTS=$$GETACTS^RCRPU(RCDBTR) ;Look for only new bills to add to the account.
; If no new bills, alert user and exit.
I +RCCTS<1 D Q 1
. W !!,"No new bills available to add to this Debtor's plan.",!
. D PAUSE^RCRPU
;
;Print New Bills to be added
D PRTNB(+RCCTS)
;
;Ask user which Active bills to add to new plan (single, range, or all)
S RCBLCH=$$GETBILLS^RCRPU(+RCCTS)
S RCALLFLG=+RCBLCH
S RCBLCH=$P(RCBLCH,U,2)
;
;Escape of no bills were selected.
I RCBLCH="" D Q 1
. W !,"No Bills selected",!
. D PAUSE^RCRPU
. W @IOF
;
I 'RCALLFLG D Q:'RCDONE 1
. S RCDONE=$$ECHOBL(RCBLCH)
;
;Display total sum of bills chosen and confirm with user, exit if no.
S RCTOT=$$TOT^RCRPU(RCBLCH)
I '+RCTOT D Q 1
. D PAUSE^RCRPU ;Any key to continue prompt
;
;Strip confirm flag to get total.
S RCTOT=$P(RCTOT,U,2)
;
;Get existing Plan info
S RCORBAL=$$GET1^DIQ(340.5,RPIEN_",",.11,"I")
S RCMNPAY=$$GET1^DIQ(340.5,RPIEN_",",.06,"I")
;
;Calculate the new Potential remaining balance
S RCRMBAL=$$CBAL^RCRPU3(RPIEN,RCORBAL) ; PRCA*4.5*389
S RCNEWTOT=RCTOT+RCRMBAL,RCNEWLN=RCNEWTOT/RCMNPAY
;
;If the new term length will become >57 months by adding these bills,
; display a warning message to the user and exit.
I RCNEWLN>57 D Q 1 ; PRCA*4.5*389
.W !,"Adding these bills will make the number of remaining payments on the"
.W !,"plan > 57 months. Unable to add new bills to this plan until the"
.W !,"plan's terms are adjusted."
.D PAUSE^RCRPU
.Q
;
I RCNEWLN>36 D ; PRCA*4.5*389
.S RCFLG36=$$GET36^RCRPWLUT(RPIEN)
.I RCFLG36=2 D ; denied 36 months approval
..W !,"Adding these bills will make the number of remaining payments on the"
..W !,"plan > 36 months. 36 months supervisor approval was denied for this"
..W !,"plan - no bills may be added to it."
..S RCSPFLG=-1
..Q
.I RCFLG36=0 D ; 36 month approval needed PRCA*4.5*422
..W !,"The number of payments exceeds 36 payments.",!
..I $$SUPAPPR^RCRPU(2)=1 S RCSPFLG=1 D UPDFLG36^RCRPU1(RPIEN,1),UPDAUDIT^RCRPU2(RPIEN,DT,"E","SM","")
..Q
.I RCFLG36=1 S RCSPFLG=1 ; already have 36 months approval
.Q
I RCNEWLN>36,(RCSPFLG<1) Q -1 ; No Supervisor approval when required
;
; Add the Bill to the plan.
S RCBILLDA=0
F S RCBILLDA=$O(^TMP("RCRPP",$J,"BILLS",RCBILLDA)) Q:'RCBILLDA D
. D UPDBILL^RCRPU(RPIEN,RCBILLDA)
. ; Add Plan to the Bill
. D ADDPLAN^RCRPU(RPIEN,RCBILLDA,RCACTDT)
. D UPDMET^RCSTATU(1.01,1)
;
; Update the Total balance Owed.
S RCPLNBL=RCTOT+RCORBAL
D UPDPAO^RCRPU1(RPIEN,RCPLNBL)
;
; Recalculate the total # payments.
S RCNOMN=$$GET1^DIQ(340.5,RPIEN_",",.05,"I")
S RCNWMN=RCPLNBL\RCMNPAY,RCNWMOD=RCPLNBL#RCMNPAY
I RCNWMOD>0 S RCNWMN=RCNWMN+1
;
; If there is a change in term length, update the plan and the schedule.
I RCNOMN'=RCNWMN D
. D UPDTERMS^RCRPU1(RPIEN,RCMNPAY_"^"_RCNWMN)
. D ADJSCHED^RCRPENTR(RPIEN,RCNOMN,RCNWMN)
;
;Update Audit Log
I RCSPFLG<1!(RCSPFLG=1&(RCFLG36=1)) D UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"A","") ; PRCA*4.5*389
I RCSPFLG=1,RCFLG36=0 D UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"A","SM"),UPDFLG36^RCRPU1(RCRPIEN,1) ; PRCA*4.5*389
;
W !,"Bills successfully added to the Plan.",!
;
;Pause for the user to read the output, then escape the option if they wish to.
D PAUSE^RCRPU W ! S $Y=0 I $G(QUIT) Q 1
Q 0
;
PRTNB(RCCTS) ;Print the new Bills to be added, with header
;
W !!,?26,"Bills Available for Selection"
W ! D DASH^RCRPRPU(80)
;
D PRTACTS^RCRPU(RCCTS)
Q
;
ECHOBL(RCBLCH) ; Echo the Lits of Bills selected
; Input: RCBLCH - List of bills to added.
;
N RCBILL,RCBILLDA
;
S RCBILLDA=0
;Display the bills selected
W !,"You chose to add the following bill(s) to this plan:",!!
F S RCBILLDA=$O(^TMP("RCRPP",$J,"BILLS",RCBILLDA)) Q:'RCBILLDA D
. S RCBILL=$P($G(^PRCA(430,RCBILLDA,0)),U)
. W RCBILL,!
;
;Ask if correct and exit with the answer
Q $$CORRECT^RCRPU
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPADD 8589 printed Dec 13, 2024@01:48:20 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN1(RCRPIEN) ; entry point from repayment plan worklist, called from ^RCRPWL1 PRCA*4.5*389
+1 ;
+2 ; RCRPIEN - file 340.5 ien
+3 ;
+4 NEW RCDONE,QUIT,RCDONE1,RCRVW,LN
+5 NEW IOBOFF,IOBON,IORVON,IORVOFF,X
+6 SET (RCDONE,LN)=0
SET QUIT=""
+7 DO PROCPLN1
+8 ;Clean up working TMP array when exiting
+9 KILL ^TMP("RCRPP",$JOB)
+10 QUIT
+11 ;
MAIN ; Entry point for Forbearance Option
+1 ;
+2 NEW RCDONE,RCFLG36,QUIT,RCRVW,RCRPIEN,RCDONE1,LN
+3 NEW IOBOFF,IOBON,IORVON,IORVOFF,X
+4 ;
+5 SET (RCDONE,LN)=0
SET QUIT=""
+6 FOR
if RCDONE
QUIT
DO PROCPLAN
if RCDONE
QUIT
+7 ;Clean up working TMP array when exiting
+8 KILL ^TMP("RCRPP",$JOB)
+9 QUIT
+10 ;
PROCPLAN ;
+1 SET RCDONE1=0
SET LN=0
+2 IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 SET RCRPIEN=$$SELRPP^RCRPU1()
SET QUIT=0
IF RCRPIEN=-1
SET RCDONE=1
QUIT
+4 ;I RCRPIEN="" S RCDONE=1 Q
+5 ; PRCA*4.5*389
IF "^6^7^8^"[(U_$PIECE($GET(^RCRP(340.5,RCRPIEN,0)),U,7)_U)
Begin DoDot:1
+6 SET X="IOBON;IORVON;IOBOFF;IORVOFF"
DO ENDR^%ZISS
+7 WRITE !!,IOBON,IORVON,$$CJ^XLFSTR("*** WARNING: YOU HAVE SELECTED A CLOSED REPAYMENT PLAN ***",80),IORVOFF,IOBOFF,!!
+8 DO PAUSE^RCRPU
+9 QUIT
End DoDot:1
if QUIT
SET RCDONE=1
QUIT
+10 ; PRCA*4.5*389
SET RCFLG36=$PIECE($GET(^RCRP(340.5,RCRPIEN,1)),U,6)
IF RCFLG36=0
Begin DoDot:1
+11 WRITE !!,"This plan is pending review on the Repayment Plan Worklist."
+12 WRITE !,"Unable to add new bills at this time.",!
+13 DO PAUSE^RCRPU
+14 QUIT
End DoDot:1
if QUIT
SET RCDONE=1
QUIT
PROCPLN1 ; PRCA*4.5*389
+1 ; PRCA*4.5*389
SET RCRVW=$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I")
IF RCRVW
Begin DoDot:1
+2 WRITE !!,"The selected plan currently has more than 60 payments outstanding."
+3 WRITE !,"Unable to add new bills to this plan until the plan's terms"
+4 WRITE !,"are adjusted.",!
+5 DO PAUSE^RCRPU
+6 QUIT
End DoDot:1
if QUIT
SET RCDONE=1
QUIT
+7 SET LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
+8 if 'LN
QUIT
+9 DO PAUSE^RCRPU
+10 if $GET(QUIT)
QUIT
+11 IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+12 ;
+13 SET LN=0
+14 SET LN=$$PRTBILLS^RCRPINQ(RCRPIEN,LN)
+15 ; User requested an exit, reset flag and quit
+16 if 'LN
QUIT
+17 SET LN=0
+18 DO PAUSE^RCRPU
+19 if $GET(QUIT)
QUIT
+20 ;
+21 ; reset screen output to the top
+22 IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+23 SET RCDONE1=$$ADDNEW(RCRPIEN)
+24 ; If user selected No at supervisor approval print message nothing updated and quit out to prompt for Payment Plan.
+25 if RCDONE1>0
QUIT
+26 IF RCDONE1=-1
Begin DoDot:1
+27 WRITE !!,"The Repayment Plan was not updated."
+28 DO PAUSE^RCRPU
+29 SET QUIT=1
End DoDot:1
if $GET(QUIT)
QUIT
+30 if RCDONE
QUIT
+31 ;
+32 ; Reprint the Header and Bills
+33 SET LN=0
+34 SET LN=$$PRTHDR^RCRPINQ(RCRPIEN,LN)
+35 if 'LN
QUIT
+36 ;
+37 WRITE !
+38 ;
+39 SET LN=0
+40 DO PAUSE^RCRPU
+41 if $GET(QUIT)
QUIT
+42 IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+43 SET LN=$$PRTBILLS^RCRPINQ(RCRPIEN,LN)
+44 DO PAUSE^RCRPU
+45 IF 'LN
SET RCDONE=1
+46 ;
+47 QUIT
+48 ;
PRTHDR(RPIEN) ; display repayment plan data
+1 ;
+2 ; RPIEN is defined in tag EN
+3 ;
+4 NEW ADDRSTR,BAMNT,BILL,BSTAT,CBAL,CNT,DEBDOB,DEBPHN,DEBSSN,DEBTOR,LN,N0,RAMNT,TMP,TMPDT,TMPIEN
+5 IF $GET(RPIEN)'>0
QUIT
+6 ; 0-node in file 340.5
SET N0=$GET(^RCRP(340.5,RPIEN,0))
+7 SET DEBTOR=$PIECE(N0,U,2)
+8 ; ADDRSTR = Str1^Str2^Str3^City^State^ZIP^Telephone^Forein Country Code
SET ADDRSTR=$$DADD^RCAMADD(DEBTOR,1)
+9 USE IO
+10 IF $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+11 SET DEBSSN=+$$SSN^RCFN01(DEBTOR)
SET DEBDOB=$$GETDOB^RCRPINQ(DEBTOR)
SET DEBPHN=+$PIECE(ADDRSTR,U,7)
+12 WRITE !!,"Debtor: ",$$NAM^RCFN01(DEBTOR)
+13 WRITE ?40,"SSN/TIN: ",$SELECT(DEBSSN>0:$EXTRACT(DEBSSN,1,3)_"-"_$EXTRACT(DEBSSN,4,5)_"-"_$EXTRACT(DEBSSN,6,9),1:"N/A")
+14 WRITE ?64,"DOB: ",$SELECT(DEBDOB="":"N/A",1:DEBDOB)
+15 WRITE !,"Address: ",$PIECE(ADDRSTR,U)," ",$PIECE(ADDRSTR,U,2)," ",$PIECE(ADDRSTR,U,3),", ",$PIECE(ADDRSTR,U,4),", ",$PIECE(ADDRSTR,U,5)," ",$PIECE(ADDRSTR,U,6)
+16 WRITE !,"Phone: ",$SELECT(DEBPHN>0:$$FMTPHONE^RCRPINQ(DEBPHN),1:"N/A"),!
+17 WRITE !,"Plan #: ",$PIECE(N0,U),?28,"Status: ",$$EXTERNAL^DILFD(340.5,.07,"",$PIECE(N0,U,7)),?49,"Last status date: ",$$FMTE^XLFDT($PIECE(N0,U,8),"5DZ"),!
+18 ; PRCA*4.5*389
SET CBAL=$$CBAL^RCRPU3(RPIEN,$PIECE(N0,U,11))
SET RAMNT=$PIECE(N0,U,6)
+19 ; PRCA*4.5*389
WRITE !,?2,"Current balance: $",$FNUMBER(CBAL,"",2),?37,"Number of payments remaining: ",$$REMPMNTS^RCRPU3(RPIEN,RAMNT)
+20 WRITE !,?1,"Orig amount owed: $",$FNUMBER($PIECE(N0,U,13),"",2),?38,"Original number of payments: ",$PIECE(N0,U,14)
+21 WRITE !,"Total amount owed: $",$FNUMBER($PIECE(N0,U,11),"",2),?41,"Total number of payments: ",$PIECE(N0,U,5)
+22 WRITE !,?1,"Repayment amount: $",$FNUMBER(RAMNT,"",2),?47,"Auto-add New Bills: ",$$GET1^DIQ(340.5,RPIEN_",",.12,"E"),!!
+23 QUIT
+24 ;
ADDNEW(RPIEN) ; Ask the user for the bills to add.
+1 ;
+2 NEW RCDONE,RCCTS,Y,DIRUT,RCALLFLG,RCBLCH,RCTOT,RCORBAL,RCNOMN,RCNWMN,RCDBTR,RCSPFLG,RCFLG36
+3 NEW RCMNPAY,RCNEWTOT,RCNEWLN,RCBILLDA,RCACTDT,RCRMBAL,RCRMLN,RCPLNBL,RCNWMOD,QUIT
+4 ; PRCA*4.5*389
SET RCSPFLG=0
SET RCFLG36=""
+5 ;
+6 ;Clear ^TMP array
+7 KILL ^TMP("RCRPP",$JOB)
+8 SET RCDBTR=$$GET1^DIQ(340.5,RPIEN_",",.02,"I")
+9 SET RCDONE=0
SET RCACTDT=$$DT^XLFDT
+10 ; Retrieve new bills for Debtor
+11 ;Look for only new bills to add to the account.
SET RCCTS=$$GETACTS^RCRPU(RCDBTR)
+12 ; If no new bills, alert user and exit.
+13 IF +RCCTS<1
Begin DoDot:1
+14 WRITE !!,"No new bills available to add to this Debtor's plan.",!
+15 DO PAUSE^RCRPU
End DoDot:1
QUIT 1
+16 ;
+17 ;Print New Bills to be added
+18 DO PRTNB(+RCCTS)
+19 ;
+20 ;Ask user which Active bills to add to new plan (single, range, or all)
+21 SET RCBLCH=$$GETBILLS^RCRPU(+RCCTS)
+22 SET RCALLFLG=+RCBLCH
+23 SET RCBLCH=$PIECE(RCBLCH,U,2)
+24 ;
+25 ;Escape of no bills were selected.
+26 IF RCBLCH=""
Begin DoDot:1
+27 WRITE !,"No Bills selected",!
+28 DO PAUSE^RCRPU
+29 WRITE @IOF
End DoDot:1
QUIT 1
+30 ;
+31 IF 'RCALLFLG
Begin DoDot:1
+32 SET RCDONE=$$ECHOBL(RCBLCH)
End DoDot:1
if 'RCDONE
QUIT 1
+33 ;
+34 ;Display total sum of bills chosen and confirm with user, exit if no.
+35 SET RCTOT=$$TOT^RCRPU(RCBLCH)
+36 IF '+RCTOT
Begin DoDot:1
+37 ;Any key to continue prompt
DO PAUSE^RCRPU
End DoDot:1
QUIT 1
+38 ;
+39 ;Strip confirm flag to get total.
+40 SET RCTOT=$PIECE(RCTOT,U,2)
+41 ;
+42 ;Get existing Plan info
+43 SET RCORBAL=$$GET1^DIQ(340.5,RPIEN_",",.11,"I")
+44 SET RCMNPAY=$$GET1^DIQ(340.5,RPIEN_",",.06,"I")
+45 ;
+46 ;Calculate the new Potential remaining balance
+47 ; PRCA*4.5*389
SET RCRMBAL=$$CBAL^RCRPU3(RPIEN,RCORBAL)
+48 SET RCNEWTOT=RCTOT+RCRMBAL
SET RCNEWLN=RCNEWTOT/RCMNPAY
+49 ;
+50 ;If the new term length will become >57 months by adding these bills,
+51 ; display a warning message to the user and exit.
+52 ; PRCA*4.5*389
IF RCNEWLN>57
Begin DoDot:1
+53 WRITE !,"Adding these bills will make the number of remaining payments on the"
+54 WRITE !,"plan > 57 months. Unable to add new bills to this plan until the"
+55 WRITE !,"plan's terms are adjusted."
+56 DO PAUSE^RCRPU
+57 QUIT
End DoDot:1
QUIT 1
+58 ;
+59 ; PRCA*4.5*389
IF RCNEWLN>36
Begin DoDot:1
+60 SET RCFLG36=$$GET36^RCRPWLUT(RPIEN)
+61 ; denied 36 months approval
IF RCFLG36=2
Begin DoDot:2
+62 WRITE !,"Adding these bills will make the number of remaining payments on the"
+63 WRITE !,"plan > 36 months. 36 months supervisor approval was denied for this"
+64 WRITE !,"plan - no bills may be added to it."
+65 SET RCSPFLG=-1
+66 QUIT
End DoDot:2
+67 ; 36 month approval needed PRCA*4.5*422
IF RCFLG36=0
Begin DoDot:2
+68 WRITE !,"The number of payments exceeds 36 payments.",!
+69 IF $$SUPAPPR^RCRPU(2)=1
SET RCSPFLG=1
DO UPDFLG36^RCRPU1(RPIEN,1)
DO UPDAUDIT^RCRPU2(RPIEN,DT,"E","SM","")
+70 QUIT
End DoDot:2
+71 ; already have 36 months approval
IF RCFLG36=1
SET RCSPFLG=1
+72 QUIT
End DoDot:1
+73 ; No Supervisor approval when required
IF RCNEWLN>36
IF (RCSPFLG<1)
QUIT -1
+74 ;
+75 ; Add the Bill to the plan.
+76 SET RCBILLDA=0
+77 FOR
SET RCBILLDA=$ORDER(^TMP("RCRPP",$JOB,"BILLS",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+78 DO UPDBILL^RCRPU(RPIEN,RCBILLDA)
+79 ; Add Plan to the Bill
+80 DO ADDPLAN^RCRPU(RPIEN,RCBILLDA,RCACTDT)
+81 DO UPDMET^RCSTATU(1.01,1)
End DoDot:1
+82 ;
+83 ; Update the Total balance Owed.
+84 SET RCPLNBL=RCTOT+RCORBAL
+85 DO UPDPAO^RCRPU1(RPIEN,RCPLNBL)
+86 ;
+87 ; Recalculate the total # payments.
+88 SET RCNOMN=$$GET1^DIQ(340.5,RPIEN_",",.05,"I")
+89 SET RCNWMN=RCPLNBL\RCMNPAY
SET RCNWMOD=RCPLNBL#RCMNPAY
+90 IF RCNWMOD>0
SET RCNWMN=RCNWMN+1
+91 ;
+92 ; If there is a change in term length, update the plan and the schedule.
+93 IF RCNOMN'=RCNWMN
Begin DoDot:1
+94 DO UPDTERMS^RCRPU1(RPIEN,RCMNPAY_"^"_RCNWMN)
+95 DO ADJSCHED^RCRPENTR(RPIEN,RCNOMN,RCNWMN)
End DoDot:1
+96 ;
+97 ;Update Audit Log
+98 ; PRCA*4.5*389
IF RCSPFLG<1!(RCSPFLG=1&(RCFLG36=1))
DO UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"A","")
+99 ; PRCA*4.5*389
IF RCSPFLG=1
IF RCFLG36=0
DO UPDAUDIT^RCRPU2(RPIEN,$$DT^XLFDT,"A","SM")
DO UPDFLG36^RCRPU1(RCRPIEN,1)
+100 ;
+101 WRITE !,"Bills successfully added to the Plan.",!
+102 ;
+103 ;Pause for the user to read the output, then escape the option if they wish to.
+104 DO PAUSE^RCRPU
WRITE !
SET $Y=0
IF $GET(QUIT)
QUIT 1
+105 QUIT 0
+106 ;
PRTNB(RCCTS) ;Print the new Bills to be added, with header
+1 ;
+2 WRITE !!,?26,"Bills Available for Selection"
+3 WRITE !
DO DASH^RCRPRPU(80)
+4 ;
+5 DO PRTACTS^RCRPU(RCCTS)
+6 QUIT
+7 ;
ECHOBL(RCBLCH) ; Echo the Lits of Bills selected
+1 ; Input: RCBLCH - List of bills to added.
+2 ;
+3 NEW RCBILL,RCBILLDA
+4 ;
+5 SET RCBILLDA=0
+6 ;Display the bills selected
+7 WRITE !,"You chose to add the following bill(s) to this plan:",!!
+8 FOR
SET RCBILLDA=$ORDER(^TMP("RCRPP",$JOB,"BILLS",RCBILLDA))
if 'RCBILLDA
QUIT
Begin DoDot:1
+9 SET RCBILL=$PIECE($GET(^PRCA(430,RCBILLDA,0)),U)
+10 WRITE RCBILL,!
End DoDot:1
+11 ;
+12 ;Ask if correct and exit with the answer
+13 QUIT $$CORRECT^RCRPU
