RCRPU ;EDE/SAB - REPAYMENT PLAN UTILITIES;11/16/2020 8:40 AM
;;4.5;Accounts Receivable;**377,381,388,378,389**;Mar 20, 1995;Build 36
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
GETDBTR() ;Look up debtor by name or bill #
N DIC,X,Y,DTOUT,DUOUT,RCOK,RCDBTR,RCDBTRN
;
;Reset screen to the top.
;
;Ask for Debtor Name
S RCOK=0,RCDBTR=""
F D Q:RCOK
. R "Select DEBTOR NAME: ",X:DTIME
. I X["^"!(X="") S RCOK=1,RCDBTR=""
. S X=$$UPPER^VALM1(X)
. S DIC="^RCD(340,",DIC(0)="EX" D ^DIC W !
. I $D(DTOUT)!($D(DUOUT)) S RCOK=1,RCDBTR=0 Q
. Q:+Y=-1
. Q:'$$CORRECT(2)
. S RCOK=1,RCDBTR=+Y
I +RCDBTR,$P(Y,U,2)[";DPT" S RCDBTRN=$$GET1^DIQ(2,$P($P(Y,U,2),";")_",",.01,"E")
Q RCDBTR_U_$G(RCDBTRN) ;If looked up by debtor name
;
PRTACTS(RCCTS) ;Display accounts in ARR
; RCCTS - # of Active bills in active node of ^TMP("RCRPP).
;
N RCI,RCDATA,RCBILLNO,RCAMT,RCDOS,RCSTAT,RCCAT,RCSTATN,RCCATN,QUIT
;initialize screen and exit variables.
S QUIT=0
;
D PRTHDR
S RCTOT=0
; Loop through Active Node in the ^TMP("RCRPP") array.
F RCI=1:1:RCCTS D Q:QUIT
. S RCDATA=$G(^TMP("RCRPP",$J,"ACTIVE",RCI))
. S RCBILLNO=$P(RCDATA,U,2),RCAMT=$P(RCDATA,U,3),RCDOS=$P(RCDATA,U,4),RCSTAT=$P(RCDATA,U,5),RCCAT=$P(RCDATA,U,6)
. S RCCATN=$P($G(^PRCA(430.2,RCCAT,0)),U,1),RCSTATN=$P($G(^PRCA(430.3,RCSTAT,0)),U,1)
. S RCTOT=RCTOT+RCAMT
. I $Y+3>IOSL D PAUSE,PRTHDR W ! S $Y=0 I QUIT Q
. W RCI,?5,RCBILLNO,?24,$E(RCCATN,1,24),?50,$$MDY(RCDOS,"-"),?61,RCSTATN,?70,"$",$J(RCAMT,8,2),!
F X=1:1:(IOM-1) W "="
W !,?55,"TOTAL OWED:",?70,"$",$J(RCTOT,8,2),!
I QUIT Q 0
W !
Q
;
PRTHDR() ; Print the header for account listing
;
W !,?70," AMOUNT",! ; PRCA*4.5*389
W "No.",?5,"BILL NO.",?24,"AR CATEGORY",?50,"BILL DATE",?61,"STATUS",?70,"OWED ($)",! ; PRCA*4.5*389
F X=1:1:(IOM-1) W "-"
W !
Q
;
GETACTS(RCDBTR) ;Find all active accounts for a debtor
;Input:
; RCDBTR - Pointer to #340
;
; Returns: ARRAY(COUNTER,PRCABN)=BILL IEN (FILE 430)^BILL#^BALANCE DUE^DOS^STATUS^CATEGORY
;
N RCSTAT,RCBILL,RCAMT,RCBILLNO,RCCAT,RCCS,RCDOS
N D0,D7,D1,D4,RCACT,RCCSCT,RCEXIT
S (RCACT,RCCSCT)=0 ;init counters
S RCSTAT=+$O(^PRCA(430.3,"AC",102,0)) ; get active status ien
S RCBILL=0 F S RCBILL=$O(^PRCA(430,"AS",RCDBTR,RCSTAT,RCBILL)) Q:'RCBILL D
. S D0=$G(^PRCA(430,RCBILL,0)) ;General bill info
. S D1=$G(^PRCA(430,RCBILL,1)) ;ELIG for RPP flag
. S D4=$G(^PRCA(430,RCBILL,4)) ;Repayment Plan info in Bill
. S D7=$G(^PRCA(430,RCBILL,7)) ;Remaining Balance info for bill
. S RCAMT=$S(+D7:$P(D7,U,1)+$P(D7,U,2)+$P(D7,U,3)+$P(D7,U,4)+$P(D7,U,5),1:$P(D0,U,3))
. S RCDOS=$P(D0,U,10)
. S RCBILLNO=$P(D0,U,1),RCCAT=$P(D0,U,2)
. ;
. ;If the bill is already in a plan, then skip over adding it to list.
. I ($P(D4,U,5)>0) Q
. ;
. ;If Bill has an AR Category that is not eligible (field 1.06 in the AR Cat file (430.2)
. ;to be on a Repayment Plan, stop and get the next bill
. Q:'$$GET1^DIQ(430.2,RCCAT_",",1.06,"I")
. ;
. S RCCS=0
. S:$D(^PRCA(430,"TCSP",RCBILL)) RCCS=1 ;Bill is in cross-servicing
. S:+$G(^PRCA(430,RCBILL,12)) RCCS=2 ;Bill is in DMC
. ;Disable TOP exclusion for now.
. ;S:+$G(^PRCA(430,RCBILL,14)) RCCS=3 ;Bill is in TOP
. ; If bill not in CS, add to Active Queue
. I 'RCCS D Q
. . S RCACT=RCACT+1
. . S ^TMP("RCRPP",$J,"ACTIVE",RCACT)=RCBILL_U_RCBILLNO_U_RCAMT_U_RCDOS_U_RCSTAT_U_RCCAT
. ; If bill in CS, add to CS queue
. S RCCSCT=RCCSCT+1
. S ^TMP("RCRPP",$J,"CS",RCCSCT)=RCBILL_U_RCBILLNO_U_RCAMT_U_RCDOS_U_RCSTAT_U_RCCAT_U_RCCS
Q RCACT_U_RCCSCT
;
MDY(DATE,DEL) ;Return date format of mm-dd-yy
; DATE - Date in FileMan format
; DEL - Delimiter used to separate month, day, year
;
; Returns: Date in mmddyy format delimited by DEL
N %DT,X,Y
S X=$G(DATE),DEL=$S($G(DEL)="":"-",1:DEL),%DT="T"
D ^%DT S DATE=Y S:Y<0 DATE="0000000"
Q $E(DATE,4,5)_DEL_$E(DATE,6,7)_DEL_$E(DATE,2,3)
;
PAUSE ;Press Return to Continue
N DIR,DUOUT,DTOUT,DIRUT
S DIR(0)="E" D ^DIR
I $D(DIRUT) S QUIT=1
W !
Q
;
GETBILLS(RCCTS) ;Select the bills to add to the plan
; RCCTS - The upper limit that can be chosen
;
; This function will eliminate duplicates and return choices in numerical error
; regardless of input order.
;
; Returns: All bills select flag ^ comma delimited list of pointers to file #430 in ascending date order
;
N DIR,X,Y,DTOUT,DUOUT
N RCOK,RCPC,RCLIST,RCSTR,RCCNT,RCERR,RCJ,RCFIRST,RCLAST,RCI,RCRPBILL,RCALLFLG
;
S (RCOK,RCALLFLG)=0
F RCCNT=1:1 I 'RCOK D Q:RCOK
. K RCSTR S RCERR=""
. I RCCTS>1 W " Select bills using the following formats: (A)ll or (N)one or 1,2,3 and/or 1-3",!
. S DIR(0)="FO^^"
. S DIR("A")="Choose Bills to Add to Repayment Plan: "
. S DIR("B")="ALL"
. S DIR("?")="Select bills using the following formats: (A)ll or (N)one or 1,2,3 and/or 1-3"
. D ^DIR
. I $D(DTOUT)!$D(DUOUT) S RCLIST="",RCOK=1,RCEXIT=1 Q
. S X=$$UPPER^VALM1(X)
. I $E("NONE",1,$L(X))=X S RCLIST="",RCOK=1,RCEXIT=1 Q
. I $E("ALL",1,$L(X))=X D Q
.. F RCI=1:1:RCCTS S RCSTR(RCI)=""
.. S (RCOK,RCALLFLG)=1
. F RCI=1:1:$L(X,",") S RCPC=$P(X,",",RCI) D Q:RCERR]""
.. I RCPC'?1.N,RCPC'?1.N1"-"1.N S RCERR="Invalid response" Q
.. I RCPC'>0!(RCPC>RCCTS) S RCERR="Number out of range" Q
.. I RCPC?1.N,RCPC>0,RCPC'>RCCTS S RCSTR(RCPC)="" Q
.. I RCPC?1.N1"-"1.N D Q:RCERR]""
... S RCFIRST=$P(RCPC,"-",1),RCLAST=$P(RCPC,"-",2)
... I RCFIRST'>0!(RCFIRST>RCCTS)!(RCLAST'>0)!(RCLAST>RCCTS) S RCERR="Number out of range" Q
... I RCFIRST>0,RCFIRST'>RCCTS,RCLAST>0,RCLAST'>RCCTS F RCJ=RCFIRST:1:RCLAST S RCSTR(RCJ)=""
. I RCERR="" S RCOK=1 Q
. S RCOK=0 W " "_RCERR,!
S RCI=0,RCLIST=""
F S RCI=$O(RCSTR(RCI)) Q:RCI="" D
. S RCLIST=RCLIST_$S(RCLIST="":"",1:",")_RCI
. S RCRPBILL=$P($G(^TMP("RCRPP",$J,"ACTIVE",RCI)),U)
. S ^TMP("RCRPP",$J,"BILLS",RCRPBILL)=""
Q RCALLFLG_U_RCLIST
;
TOT(RCBLCH) ; calculate the total amount into the Repayment Plan.
;
N RCLN,RCTOT,RCI
;
;Find # of bills to sum up.
S RCLN=$L(RCBLCH,","),RCTOT=0
;
;Calculate the total
F RCI=1:1:RCLN D
. S RCTOT=RCTOT+$P($G(^TMP("RCRPP",$J,"ACTIVE",$P(RCBLCH,",",RCI))),U,3)
;
; Display total, confirm with user, and exit
W !,"Total Amount chosen is $",$J(RCTOT,8,2),!
Q $$CORRECT_U_RCTOT
;
CORRECT(RCTYPE) ;Are you sure this is correct?
; Input: (Optional) Prompt to display
; Return: 1 for Yes
; 0 for No
;
N DIR,X,Y,RCPROMPT
S RCTYPE=$G(RCTYPE)
I RCTYPE="" S RCTYPE=1
S RCPROMPT="Is this correct"
I RCTYPE=2 S RCPROMPT="Is this the correct Debtor"
I RCTYPE=3 S RCPROMPT="Are you sure you wish to Close this plan"
S DIR(0)="Y",DIR("B")="YES",DIR("A")=RCPROMPT_"? (Y/N) "
D ^DIR
W !
Q Y
;
GETDET(RCBLCH,RCTOT,RCDBTR,RCAUTO) ;Finish Gathering the details and File
;
; RCBLCH - list of bills in plan.
; RCTOT - Amount due from selected bills
; RCDBTR - Debtor IEN^Debtor Name
; RCAUTO - auto-add flag
; Returns: 1 if completed
;
N RCPLN,RCSTDT,RCDAY,RCCRDT,RCSVFLG
;
;Get site and # of RPP for the Debtor
S RCRPID=$$GETID(+RCDBTR)
Q:RCRPID=0 0
;
;Get Amount^# Payments
S RCPLN=$$GETPLN(RCDBTR,RCTOT)
Q:+RCPLN=0 0
;
;Set the Creation date and Start date. Build the plan schedule
S RCCRDT=$$DT^XLFDT
S RCSTDT=$$GETSTART(RCCRDT)
D BLDPLN(RCSTDT,$P(RCPLN,U,2))
;
;Set the day of the month a payment is due to the 28th
S RCDAY=28
S RCSVFLG=$$RPDIS($P(RCDBTR,U,2),RCPLN,RCSTDT,RCCRDT,RCTOT,RCAUTO) ; PRCA*4.5*389
I 'RCSVFLG D Q 0
. W !,"Repayment Plan not Saved.",!
. D PAUSE
;
;Save the plan
S RCSVFLG=$$SAVEPLAN(+RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO)
;
Q RCSVFLG
;
RPDIS(RCDBTR,RCPLN,RCSTDT,RCCRDT,RCTOT,RCAUTO) ;Display Repayment Plan
;
W !,"Summary of the Created Repayment Plan for AR Debtor: ",RCDBTR,!
W "--------------------------------------------------------------------------------",!
W "Monthly Repayment Amount:",?32,"$",$J($P(RCPLN,U),0,2)
W ?45,"Number of Payments:",?72,$P(RCPLN,U,2),!
W "Date Plan Created:",?32,$$FMTE^XLFDT(RCCRDT,2)
W ?45,"Due Date of First Payment:",?72,$$FMTE^XLFDT(RCSTDT,2),!
W "Total Amount of Bills in Plan:",?32,"$",$J(RCTOT,0,2)
W ?45,"Auto-Add Bills?:",?72,$S(RCAUTO:"Yes",1:"No"),! ; PRCA*4.5*389
W "--------------------------------------------------------------------------------",!
Q $$CORRECT()
;
GETID(RCDBTR) ; Get the Site and # Plans for a debtor
;
N RCSITEID,RCI,RCCT
;
S RCSITEID=$P($$SITE^VASITE(),U)
S RCCT=0,RCI=0
F S RCI=$O(^RCRP(340.5,"E",RCDBTR,RCI)) Q:RCI="" S RCCT=RCCT+1
;
;Add 1 for new plan and add leading 0's
S RCCT=RCCT+1,RCCT="00"_RCCT,RCCT=$E(RCCT,$L(RCCT)-1,$L(RCCT))
;
Q RCSITEID_"-RPP-"_RCCT_"-"
;
GETPLN(RCDBTR,RCTOT,RCEDIT) ; Get the amount due and length of plan
;Repayment amount
;INPUT RCTOT - Total $ amount of bills in plan
; RCEDIT - (Optional) 1 - Editing a Plan
; NULL or 0 - Entering a new plan.
;Returns Amount^# PAYMENTS or 0
N DIR,X,Y,DIRUT
N RCAMT,RCPAY,RCOK,QUIT,RCSPFLG
;
S RCEDIT=$G(RCEDIT)
S DIR(0)="NA^.01:999999:2"
S DIR("A")=$S('RCEDIT:"",1:"New ")_"Monthly Payment Amount: "
S DIR("?")="This is the amount the debtor will pay each month"
S RCOK=0,QUIT=0 F D Q:RCOK!(QUIT)
. S RCAMT=0
. D ^DIR
. I $D(DIRUT) S RCOK=1 Q
. S RCAMT=+Y
. ;If amount < 25, Supervisor approval needed, re-ask otherwise
. I RCAMT<25 D Q:RCSPFLG'=1
. . S RCSPFLG=$$SUPAPPR(RCDBTR,1)
. . Q:RCSPFLG'=1
. . S ^TMP("RCRPP",$J,"SUP25")=1 ;Store the approval for an audit log later
. ;continue
. S RCPAY=RCTOT\RCAMT I RCTOT#RCAMT>0 S RCPAY=RCPAY+1
. W !!,"Number of Payments will be ",RCPAY,!
. I RCPAY>60 D Q
. . W !,"The number of payments cannot exceed 60. Please re-enter the payment amount.",!
. I RCPAY>36 D Q:RCSPFLG'=1
. . W !,"The number of payments exceeds 36 payments.",!
. . S RCSPFLG=$$SUPAPPR(RCDBTR,2)
. . Q:RCSPFLG'=1
. . S ^TMP("RCRPP",$J,"SUP36")=1 ;Store the approval for an audit log later
. . D PAUSE
. S RCOK=1
I $D(DIRUT) Q 0
I QUIT Q 0
;
Q RCAMT_U_RCPAY
;
GETSTART(RCCRDT) ; Calculate the start date .
;
; This routine calculates the start date to be a minimum
; of 45 days after the creation date, and then finds the
; 28th of the month.
;
N RCSTDT,RCSTYR,RCSTMN,RCSTDY,RES
;
;Calculate a minimum of 45 days
S RCSTDT=$$FMADD^XLFDT(RCCRDT,45)
;
S RCSTYR=$E(RCSTDT,1,3)
S RCSTMN=$E(RCSTDT,4,5)
S RCSTDY=$E(RCSTDT,6,7)
;
;If the day calculated is the 28th, return the date.
I RCSTDY=28 S RES=RCSTDT
;
;Find the next 28th.
; If day <28 move to the 28th and quit
I RCSTDY<28 S RES=RCSTYR_RCSTMN_28
;
;If start day needs to move into the next month, then add the necessary days and return the new date.
I RCSTDY>28 D
.S RCSTMN=RCSTMN+1
.I RCSTMN<10 S RCSTMN="0"_RCSTMN
.I RCSTMN>12 S RCSTMN="01",RCSTYR=RCSTYR+1
.S RES=RCSTYR_RCSTMN_28
.Q
;
I RES<3211028 S RES=3211028 ; if calculated date is prior to 10/28/21, set it to 10/28/21
Q RES
;
SUPAPPR(RCDBTR,RCTXTFLG) ; Confirm Supervisor approval, file Debtor Comment for Supervisor Approval
;
N DIR,X,Y,RCPROMPT
S RCTYPE=$G(RCTYPE)
S DIR(0)="Y"
I RCTXTFLG=1 S DIR("A")="Has your Supervisor approved this amount? (Y/N) "
I RCTXTFLG=2 S DIR("A")="Has your Supervisor approved the number of payments? (Y/N) "
D ^DIR
I +Y<1 Q -1
;
Q 1
;
SAVEPLAN(RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO) ; Save the repayment plan details
;
N FDA,FDAIEN,IENS,LIEN,RCRPIEN,RCSUB,RCRPIEN,RCIEN
;
;Lock the file to grab the Next IEN to construct the RPP ID before filing.
;
L +^RCRP(340.5):5 I '$T W !,"Another user is creating a Repayment Plan. Please try again later." L -^RCRP(340.5) Q -1
S RCIEN=$P($G(^RCRP(340.5,0)),U,3)+1,RCIEN="000000"_RCIEN
;
S RCRPID=RCRPID_$E(RCIEN,$L(RCIEN)-5,$L(RCIEN))
S IENS="+1,"
S FDA(340.5,IENS,.01)=RCRPID ;Plan ID
S FDA(340.5,IENS,.02)=RCDBTR ;Debtor
S FDA(340.5,IENS,.03)=RCCRDT ;Creation Date
S FDA(340.5,IENS,.04)=RCSTDT ;Start Date
S FDA(340.5,IENS,.05)=$P(RCPLN,U,2) ;Length (# payments)
S FDA(340.5,IENS,.06)=$P(RCPLN,U,1) ;Amount Per Month
S FDA(340.5,IENS,.07)=1 ;Status (NEW on creation)
S FDA(340.5,IENS,.08)=RCCRDT ;Status Date
S FDA(340.5,IENS,.11)=RCTOT ;Total amount due in plan.
S FDA(340.5,IENS,.12)=RCAUTO ;Auto-add bills PRCA*4.5*378
S FDA(340.5,IENS,.13)=RCTOT ;Store total as original amount as well
S FDA(340.5,IENS,.14)=$P(RCPLN,U,2) ;Store Length as original # payments as well
;
; first parameter is currently "" so internal it is for now
D UPDATE^DIE("","FDA","FDAIEN","RETURN")
L -^RCRP(340.5)
;
S RCRPIEN=FDAIEN(1)
;
;Update the Audit Log
D UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N","N")
;
;Update Audit Log with Supervisor Approvals, if any.
D:$G(^TMP("RCRPP",$J,"SUP25")) UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N","SA")
D:$G(^TMP("RCRPP",$J,"SUP36")) UPDFLG36^RCRPU1(RCRPIEN,1),UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N","SM") ; PRCA*4.5*389
;
;Update the Schedule Node
S RCSUB=0
F S RCSUB=$O(^TMP("RCRPP",$J,"PLAN",RCSUB)) Q:'RCSUB D UPDSCHED(RCRPIEN,RCSUB)
;
;Update Debtor file
D UPDDBTR(RCRPIEN,RCDBTR)
;
;Update the Bills in file 430 and file transactions for each bill included,
;then update the Bill node in the Repayment Plan
S RCSUB=0
F S RCSUB=$O(^TMP("RCRPP",$J,"BILLS",RCSUB)) Q:'RCSUB D
. D ADDPLAN(RCRPIEN,RCSUB,RCCRDT) ;Update the Bills and the Transaction file
. D UPDBILL(RCRPIEN,RCSUB) ;Update the Bill Node in the RPP
;
;PRCA*4.5*381
;If bills referral to CS was detected, updated AT CS field (#1.04)
I $D(^TMP("RCRPP",$J,"CS")) D UPDATCS^RCRPU2(RCRPIEN,1,1)
;
W !,"The Repayment Plan "_RCRPID_" has been established.",!!
;
;Update the Metrics File
D UPDMET^RCSTATU(1.07,1)
D UPDMET^RCSTATU(1.35,1) ; PRCA*4.5*389
Q 1
;
UPDSCHED(RCRPIEN,RCSUB) ; Add a month to the schedule in the RPP file (#340.5)
;
N DA,DD,DIC,DLAYGO,DO,DR
S DLAYGO=340.5,DA(1)=RCRPIEN,DIC(0)="L",X=RCSUB,DIC="^RCRP(340.5,"_DA(1)_",2,"
D FILE^DICN
Q
;
UPDDBTR(RCRPIEN,RCDBTR) ; Add a Plan to the Debtor file (#340)
;
N DA,DD,DIC,DLAYGO,DO,DR
S DLAYGO=340,DA(1)=RCDBTR,DIC(0)="L",X=RCRPIEN,DIC="^RCD(340,"_DA(1)_",9,"
D FILE^DICN
Q
;
UPDBILL(RCRPIEN,RCBILLDA) ; Add a new bill to the Bill Node in the RPP file (#340.5)
;
N DA,DD,DIC,DLAYGO,DO,DR
S DLAYGO=340.5,DA(1)=RCRPIEN,DIC(0)="L",X=RCBILLDA,DIC="^RCRP(340.5,"_DA(1)_",6,"
D FILE^DICN
Q
;
REMBILL(RCRPIEN,RCBILLDA) ; remove bill from sub-file 340.5
;
; RCRPIEN - file 340.5 ien
; RCBILLDA - file 430 ien (bill to remove)
;
N DA,DIK
I RCRPIEN'>0!(RCBILLDA'>0) Q
S DA=$O(^RCRP(340.5,RCRPIEN,6,"B",RCBILLDA,"")) Q:DA'>0
S DA(1)=RCRPIEN
S DIK="^RCRP(340.5,"_DA(1)_",6,"
D ^DIK
Q
;
BLDPLN(RCSTDT,RCLEN,RCSTFLG) ; Build the Payment Schedule
;INPUT - RCSTDT - Initial proposed start date
; RCLEN - Total Number of months
; RCSTFLG - (Optional) Flag to indicate if Start Date should be included in payment schedule
;
N RCMNARY,RCSTART,RCMONTH,RCYEAR,RCCOUNT,RCDATE
;
;If Start flag is set, then skip the adding the start date to the schedule
S RCSTFLG=$G(RCSTFLG)
S RCSTART=$E(RCSTDT,1,5),RCMONTH=$E(RCSTART,4,5),RCYEAR=$E(RCSTART,1,3)
;
S:'RCSTFLG RCMNARY(RCSTDT)=""
S:RCSTFLG RCLEN=RCLEN+1
;
F RCCOUNT=2:1:RCLEN D
. S RCMONTH=RCMONTH+1
. S:RCMONTH=13 RCMONTH=1,RCYEAR=RCYEAR+1
. I RCMONTH<10 S RCMONTH="0"_RCMONTH
. S RCDATE=RCYEAR_RCMONTH_28
. S RCMNARY(RCDATE)=""
M ^TMP("RCRPP",$J,"PLAN")=RCMNARY
Q
;
UPDPAYST(RCRPID) ;Update the Paid flag in the Schedule Multiple
;
N RCD0,RCNOPY,RCAMTMN,RCAMT,RCLOOP,RCTOTPD,RCDL,RCAMTPD,RCCMP
;
;Calc total payments
S RCD0=$G(^RCRP(340.5,RCRPID,0))
S RCNOPY=$P(RCD0,U,5),RCAMTMN=$P(RCD0,U,6),RCAMT=$P(RCD0,U,11)
;
;Calc amount received (Payments Node)
S RCLOOP=0,RCTOTPD=0
F S RCLOOP=$O(^RCRP(340.5,RCRPID,3,RCLOOP)) Q:RCLOOP="" D
. S RCDL=$G(^RCRP(340.5,RCRPID,3,RCLOOP,0))
. S RCAMTPD=$P(RCDL,U,2),RCTOTPD=RCTOTPD+RCAMTPD
;
;Determine # payments completed
S RCCMP=RCTOTPD\RCAMTMN
;
;If the total paid = total amount owed, add a month to the # payments completed
; (as the final month owed is not the full monthly amount) and change the status of the
; plan to Paid in Full.
I RCAMT=RCTOTPD D
. S RCCMP=RCCMP+1
. D UPDSTAT^RCRPU1(RCRPID,8)
;
;Review and update the payment node (Schedule Node)
D UPDPAID^RCRPU1(RCRPID,RCCMP)
Q
;
ADDPLAN(RCRPIEN,RCBILLDA,RCCRDT) ;Record the Plan info into each bill and to the Transaction file.
; Input: RCRPIEN - IEN of the Repayment Plan (from file #340.5)
; RCBILLDA - IEN of the Bill to add the plan to
; RCCRDT - Date to add to the plan.
;
N X,Y,DIC,DIE,DR,RCAMT,PRCA
;Store the RPP IEN into the AR file (#430) AR Repayment Plan (#45) field.
S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA,DR="41////"_RCCRDT_";45////"_RCRPIEN
S PRCA("LOCK")=0 D LOCKF^PRCAWO1 D:PRCA("LOCK")=0 ^DIE
K DA,DIC,DIE,DR
;get the current amount owed.
S RCAMT=$P($G(^PRCA(430,RCBILLDA,7)),U)
;File a Transaction into the Transaction file.
D TRAN(RCBILLDA,RCAMT,16)
Q
;
TRAN(RCBILLDA,RCAMT,RCTRANS) ;File plan add transaction in 433
N DIE,DA,DR,PRCAEN,PRCAKTY
S PRCAKTY=$O(^PRCA(430.3,"AC",RCTRANS,""))
S PRCAEN=-1 D SETTR^PRCAUTL Q:PRCAEN<0 S DA=PRCAEN
S DIE="^PRCA(433,",DR=".03////"_RCBILLDA_";11///"_DT_";12///"_PRCAKTY_";15///0" D ^DIE
S $P(^PRCA(433,PRCAEN,0),U,4)=2
Q
;
CHKACT(RCDBTR) ;Check to see if the Debtor has an Active Repayment Plan.
;
;INPUT - RCDBTR - Debtor to check
;Return: 0 if no Active Plans, 1 if an Active Plan (non Terminated, closed, or Paid in Full plans)
;
N RCACTV,RCLOOP,RCSTATUS,RCDATA
;
S RCACTV=0
;
S RCLOOP=0
F S RCLOOP=$O(^RCRP(340.5,"E",RCDBTR,RCLOOP)) Q:'RCLOOP D Q:RCACTV
. S RCDATA=$G(^RCRP(340.5,RCLOOP,0)),RCSTATUS=$P(RCDATA,U,7)
. I RCSTATUS<6 S RCACTV=1_U_RCLOOP ;Active Plan
Q RCACTV ;No active plan
;
GETNXTPY(RCRPID) ; Retrieve the next payment due date
;
;Input - RCRPID - Repayment Plan IEN
;Output - Date of Next Repayment Plan Payment.
;
N RCNXTDT,RCLOOP,RCDONE,RCDATA,RCPAID,RCFOR
;
S RCLOOP="",RCDONE=0
;Loop through the Schedule Multiple. Locate the next payment due.
F S RCLOOP=$O(^RCRP(340.5,RCRPID,2,RCLOOP)) Q:RCLOOP="" D Q:RCDONE
. S RCDATA=$G(^RCRP(340.5,RCRPID,2,RCLOOP,0))
. Q:RCDATA=""
. S RCNXTDT=$P(RCDATA,U),RCPAID=$P(RCDATA,U,2),RCFOR=$P(RCDATA,U,3)
. I 'RCPAID,'RCFOR S RCDONE=1
;Return the Payment Due date.
Q RCNXTDT
;
GETPLANS(RCDBTR) ; Get a list of Repayment Plans for a debtor.
;
;INPUT - RCDBTR - Debtor to check
;Return: 0 if no Active Plans, 1 if an Active Plan (non Terminated, closed, or Paid in Full plans)
;
N RCACTV,RCLOOP,RCPLNS
;
S RCPLNS=0
;
S RCLOOP=0
F S RCLOOP=$O(^RCRP(340.5,"E",RCDBTR,RCLOOP)) Q:'RCLOOP D
. S RCPLNS=RCPLNS+1 ;Active Plan
. S ^TMP("RCRPP",$J,"PLANS",RCPLNS)=RCLOOP_U_$G(^RCRP(340.5,RCLOOP,0))
Q RCPLNS ;No active plan
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPU 19323 printed Apr 09, 2024@20:52:32 Page 2
RCRPU ;EDE/SAB - REPAYMENT PLAN UTILITIES;11/16/2020 8:40 AM
+1 ;;4.5;Accounts Receivable;**377,381,388,378,389**;Mar 20, 1995;Build 36
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
GETDBTR() ;Look up debtor by name or bill #
+1 NEW DIC,X,Y,DTOUT,DUOUT,RCOK,RCDBTR,RCDBTRN
+2 ;
+3 ;Reset screen to the top.
+4 ;
+5 ;Ask for Debtor Name
+6 SET RCOK=0
SET RCDBTR=""
+7 FOR
Begin DoDot:1
+8 READ "Select DEBTOR NAME: ",X:DTIME
+9 IF X["^"!(X="")
SET RCOK=1
SET RCDBTR=""
+10 SET X=$$UPPER^VALM1(X)
+11 SET DIC="^RCD(340,"
SET DIC(0)="EX"
DO ^DIC
WRITE !
+12 IF $DATA(DTOUT)!($DATA(DUOUT))
SET RCOK=1
SET RCDBTR=0
QUIT
+13 if +Y=-1
QUIT
+14 if '$$CORRECT(2)
QUIT
+15 SET RCOK=1
SET RCDBTR=+Y
End DoDot:1
if RCOK
QUIT
+16 IF +RCDBTR
IF $PIECE(Y,U,2)[";DPT"
SET RCDBTRN=$$GET1^DIQ(2,$PIECE($PIECE(Y,U,2),";")_",",.01,"E")
+17 ;If looked up by debtor name
QUIT RCDBTR_U_$GET(RCDBTRN)
+18 ;
PRTACTS(RCCTS) ;Display accounts in ARR
+1 ; RCCTS - # of Active bills in active node of ^TMP("RCRPP).
+2 ;
+3 NEW RCI,RCDATA,RCBILLNO,RCAMT,RCDOS,RCSTAT,RCCAT,RCSTATN,RCCATN,QUIT
+4 ;initialize screen and exit variables.
+5 SET QUIT=0
+6 ;
+7 DO PRTHDR
+8 SET RCTOT=0
+9 ; Loop through Active Node in the ^TMP("RCRPP") array.
+10 FOR RCI=1:1:RCCTS
Begin DoDot:1
+11 SET RCDATA=$GET(^TMP("RCRPP",$JOB,"ACTIVE",RCI))
+12 SET RCBILLNO=$PIECE(RCDATA,U,2)
SET RCAMT=$PIECE(RCDATA,U,3)
SET RCDOS=$PIECE(RCDATA,U,4)
SET RCSTAT=$PIECE(RCDATA,U,5)
SET RCCAT=$PIECE(RCDATA,U,6)
+13 SET RCCATN=$PIECE($GET(^PRCA(430.2,RCCAT,0)),U,1)
SET RCSTATN=$PIECE($GET(^PRCA(430.3,RCSTAT,0)),U,1)
+14 SET RCTOT=RCTOT+RCAMT
+15 IF $Y+3>IOSL
DO PAUSE
DO PRTHDR
WRITE !
SET $Y=0
IF QUIT
QUIT
+16 WRITE RCI,?5,RCBILLNO,?24,$EXTRACT(RCCATN,1,24),?50,$$MDY(RCDOS,"-"),?61,RCSTATN,?70,"$",$JUSTIFY(RCAMT,8,2),!
End DoDot:1
if QUIT
QUIT
+17 FOR X=1:1:(IOM-1)
WRITE "="
+18 WRITE !,?55,"TOTAL OWED:",?70,"$",$JUSTIFY(RCTOT,8,2),!
+19 IF QUIT
QUIT 0
+20 WRITE !
+21 QUIT
+22 ;
PRTHDR() ; Print the header for account listing
+1 ;
+2 ; PRCA*4.5*389
WRITE !,?70," AMOUNT",!
+3 ; PRCA*4.5*389
WRITE "No.",?5,"BILL NO.",?24,"AR CATEGORY",?50,"BILL DATE",?61,"STATUS",?70,"OWED ($)",!
+4 FOR X=1:1:(IOM-1)
WRITE "-"
+5 WRITE !
+6 QUIT
+7 ;
GETACTS(RCDBTR) ;Find all active accounts for a debtor
+1 ;Input:
+2 ; RCDBTR - Pointer to #340
+3 ;
+4 ; Returns: ARRAY(COUNTER,PRCABN)=BILL IEN (FILE 430)^BILL#^BALANCE DUE^DOS^STATUS^CATEGORY
+5 ;
+6 NEW RCSTAT,RCBILL,RCAMT,RCBILLNO,RCCAT,RCCS,RCDOS
+7 NEW D0,D7,D1,D4,RCACT,RCCSCT,RCEXIT
+8 ;init counters
SET (RCACT,RCCSCT)=0
+9 ; get active status ien
SET RCSTAT=+$ORDER(^PRCA(430.3,"AC",102,0))
+10 SET RCBILL=0
FOR
SET RCBILL=$ORDER(^PRCA(430,"AS",RCDBTR,RCSTAT,RCBILL))
if 'RCBILL
QUIT
Begin DoDot:1
+11 ;General bill info
SET D0=$GET(^PRCA(430,RCBILL,0))
+12 ;ELIG for RPP flag
SET D1=$GET(^PRCA(430,RCBILL,1))
+13 ;Repayment Plan info in Bill
SET D4=$GET(^PRCA(430,RCBILL,4))
+14 ;Remaining Balance info for bill
SET D7=$GET(^PRCA(430,RCBILL,7))
+15 SET RCAMT=$SELECT(+D7:$PIECE(D7,U,1)+$PIECE(D7,U,2)+$PIECE(D7,U,3)+$PIECE(D7,U,4)+$PIECE(D7,U,5),1:$PIECE(D0,U,3))
+16 SET RCDOS=$PIECE(D0,U,10)
+17 SET RCBILLNO=$PIECE(D0,U,1)
SET RCCAT=$PIECE(D0,U,2)
+18 ;
+19 ;If the bill is already in a plan, then skip over adding it to list.
+20 IF ($PIECE(D4,U,5)>0)
QUIT
+21 ;
+22 ;If Bill has an AR Category that is not eligible (field 1.06 in the AR Cat file (430.2)
+23 ;to be on a Repayment Plan, stop and get the next bill
+24 if '$$GET1^DIQ(430.2,RCCAT_",",1.06,"I")
QUIT
+25 ;
+26 SET RCCS=0
+27 ;Bill is in cross-servicing
if $DATA(^PRCA(430,"TCSP",RCBILL))
SET RCCS=1
+28 ;Bill is in DMC
if +$GET(^PRCA(430,RCBILL,12))
SET RCCS=2
+29 ;Disable TOP exclusion for now.
+30 ;S:+$G(^PRCA(430,RCBILL,14)) RCCS=3 ;Bill is in TOP
+31 ; If bill not in CS, add to Active Queue
+32 IF 'RCCS
Begin DoDot:2
+33 SET RCACT=RCACT+1
+34 SET ^TMP("RCRPP",$JOB,"ACTIVE",RCACT)=RCBILL_U_RCBILLNO_U_RCAMT_U_RCDOS_U_RCSTAT_U_RCCAT
End DoDot:2
QUIT
+35 ; If bill in CS, add to CS queue
+36 SET RCCSCT=RCCSCT+1
+37 SET ^TMP("RCRPP",$JOB,"CS",RCCSCT)=RCBILL_U_RCBILLNO_U_RCAMT_U_RCDOS_U_RCSTAT_U_RCCAT_U_RCCS
End DoDot:1
+38 QUIT RCACT_U_RCCSCT
+39 ;
MDY(DATE,DEL) ;Return date format of mm-dd-yy
+1 ; DATE - Date in FileMan format
+2 ; DEL - Delimiter used to separate month, day, year
+3 ;
+4 ; Returns: Date in mmddyy format delimited by DEL
+5 NEW %DT,X,Y
+6 SET X=$GET(DATE)
SET DEL=$SELECT($GET(DEL)="":"-",1:DEL)
SET %DT="T"
+7 DO ^%DT
SET DATE=Y
if Y<0
SET DATE="0000000"
+8 QUIT $EXTRACT(DATE,4,5)_DEL_$EXTRACT(DATE,6,7)_DEL_$EXTRACT(DATE,2,3)
+9 ;
PAUSE ;Press Return to Continue
+1 NEW DIR,DUOUT,DTOUT,DIRUT
+2 SET DIR(0)="E"
DO ^DIR
+3 IF $DATA(DIRUT)
SET QUIT=1
+4 WRITE !
+5 QUIT
+6 ;
GETBILLS(RCCTS) ;Select the bills to add to the plan
+1 ; RCCTS - The upper limit that can be chosen
+2 ;
+3 ; This function will eliminate duplicates and return choices in numerical error
+4 ; regardless of input order.
+5 ;
+6 ; Returns: All bills select flag ^ comma delimited list of pointers to file #430 in ascending date order
+7 ;
+8 NEW DIR,X,Y,DTOUT,DUOUT
+9 NEW RCOK,RCPC,RCLIST,RCSTR,RCCNT,RCERR,RCJ,RCFIRST,RCLAST,RCI,RCRPBILL,RCALLFLG
+10 ;
+11 SET (RCOK,RCALLFLG)=0
+12 FOR RCCNT=1:1
IF 'RCOK
Begin DoDot:1
+13 KILL RCSTR
SET RCERR=""
+14 IF RCCTS>1
WRITE " Select bills using the following formats: (A)ll or (N)one or 1,2,3 and/or 1-3",!
+15 SET DIR(0)="FO^^"
+16 SET DIR("A")="Choose Bills to Add to Repayment Plan: "
+17 SET DIR("B")="ALL"
+18 SET DIR("?")="Select bills using the following formats: (A)ll or (N)one or 1,2,3 and/or 1-3"
+19 DO ^DIR
+20 IF $DATA(DTOUT)!$DATA(DUOUT)
SET RCLIST=""
SET RCOK=1
SET RCEXIT=1
QUIT
+21 SET X=$$UPPER^VALM1(X)
+22 IF $EXTRACT("NONE",1,$LENGTH(X))=X
SET RCLIST=""
SET RCOK=1
SET RCEXIT=1
QUIT
+23 IF $EXTRACT("ALL",1,$LENGTH(X))=X
Begin DoDot:2
+24 FOR RCI=1:1:RCCTS
SET RCSTR(RCI)=""
+25 SET (RCOK,RCALLFLG)=1
End DoDot:2
QUIT
+26 FOR RCI=1:1:$LENGTH(X,",")
SET RCPC=$PIECE(X,",",RCI)
Begin DoDot:2
+27 IF RCPC'?1.N
IF RCPC'?1.N1"-"1.N
SET RCERR="Invalid response"
QUIT
+28 IF RCPC'>0!(RCPC>RCCTS)
SET RCERR="Number out of range"
QUIT
+29 IF RCPC?1.N
IF RCPC>0
IF RCPC'>RCCTS
SET RCSTR(RCPC)=""
QUIT
+30 IF RCPC?1.N1"-"1.N
Begin DoDot:3
+31 SET RCFIRST=$PIECE(RCPC,"-",1)
SET RCLAST=$PIECE(RCPC,"-",2)
+32 IF RCFIRST'>0!(RCFIRST>RCCTS)!(RCLAST'>0)!(RCLAST>RCCTS)
SET RCERR="Number out of range"
QUIT
+33 IF RCFIRST>0
IF RCFIRST'>RCCTS
IF RCLAST>0
IF RCLAST'>RCCTS
FOR RCJ=RCFIRST:1:RCLAST
SET RCSTR(RCJ)=""
End DoDot:3
if RCERR]""
QUIT
End DoDot:2
if RCERR]""
QUIT
+34 IF RCERR=""
SET RCOK=1
QUIT
+35 SET RCOK=0
WRITE " "_RCERR,!
End DoDot:1
if RCOK
QUIT
+36 SET RCI=0
SET RCLIST=""
+37 FOR
SET RCI=$ORDER(RCSTR(RCI))
if RCI=""
QUIT
Begin DoDot:1
+38 SET RCLIST=RCLIST_$SELECT(RCLIST="":"",1:",")_RCI
+39 SET RCRPBILL=$PIECE($GET(^TMP("RCRPP",$JOB,"ACTIVE",RCI)),U)
+40 SET ^TMP("RCRPP",$JOB,"BILLS",RCRPBILL)=""
End DoDot:1
+41 QUIT RCALLFLG_U_RCLIST
+42 ;
TOT(RCBLCH) ; calculate the total amount into the Repayment Plan.
+1 ;
+2 NEW RCLN,RCTOT,RCI
+3 ;
+4 ;Find # of bills to sum up.
+5 SET RCLN=$LENGTH(RCBLCH,",")
SET RCTOT=0
+6 ;
+7 ;Calculate the total
+8 FOR RCI=1:1:RCLN
Begin DoDot:1
+9 SET RCTOT=RCTOT+$PIECE($GET(^TMP("RCRPP",$JOB,"ACTIVE",$PIECE(RCBLCH,",",RCI))),U,3)
End DoDot:1
+10 ;
+11 ; Display total, confirm with user, and exit
+12 WRITE !,"Total Amount chosen is $",$JUSTIFY(RCTOT,8,2),!
+13 QUIT $$CORRECT_U_RCTOT
+14 ;
CORRECT(RCTYPE) ;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 RCTYPE=$GET(RCTYPE)
+7 IF RCTYPE=""
SET RCTYPE=1
+8 SET RCPROMPT="Is this correct"
+9 IF RCTYPE=2
SET RCPROMPT="Is this the correct Debtor"
+10 IF RCTYPE=3
SET RCPROMPT="Are you sure you wish to Close this plan"
+11 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")=RCPROMPT_"? (Y/N) "
+12 DO ^DIR
+13 WRITE !
+14 QUIT Y
+15 ;
GETDET(RCBLCH,RCTOT,RCDBTR,RCAUTO) ;Finish Gathering the details and File
+1 ;
+2 ; RCBLCH - list of bills in plan.
+3 ; RCTOT - Amount due from selected bills
+4 ; RCDBTR - Debtor IEN^Debtor Name
+5 ; RCAUTO - auto-add flag
+6 ; Returns: 1 if completed
+7 ;
+8 NEW RCPLN,RCSTDT,RCDAY,RCCRDT,RCSVFLG
+9 ;
+10 ;Get site and # of RPP for the Debtor
+11 SET RCRPID=$$GETID(+RCDBTR)
+12 if RCRPID=0
QUIT 0
+13 ;
+14 ;Get Amount^# Payments
+15 SET RCPLN=$$GETPLN(RCDBTR,RCTOT)
+16 if +RCPLN=0
QUIT 0
+17 ;
+18 ;Set the Creation date and Start date. Build the plan schedule
+19 SET RCCRDT=$$DT^XLFDT
+20 SET RCSTDT=$$GETSTART(RCCRDT)
+21 DO BLDPLN(RCSTDT,$PIECE(RCPLN,U,2))
+22 ;
+23 ;Set the day of the month a payment is due to the 28th
+24 SET RCDAY=28
+25 ; PRCA*4.5*389
SET RCSVFLG=$$RPDIS($PIECE(RCDBTR,U,2),RCPLN,RCSTDT,RCCRDT,RCTOT,RCAUTO)
+26 IF 'RCSVFLG
Begin DoDot:1
+27 WRITE !,"Repayment Plan not Saved.",!
+28 DO PAUSE
End DoDot:1
QUIT 0
+29 ;
+30 ;Save the plan
+31 SET RCSVFLG=$$SAVEPLAN(+RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO)
+32 ;
+33 QUIT RCSVFLG
+34 ;
RPDIS(RCDBTR,RCPLN,RCSTDT,RCCRDT,RCTOT,RCAUTO) ;Display Repayment Plan
+1 ;
+2 WRITE !,"Summary of the Created Repayment Plan for AR Debtor: ",RCDBTR,!
+3 WRITE "--------------------------------------------------------------------------------",!
+4 WRITE "Monthly Repayment Amount:",?32,"$",$JUSTIFY($PIECE(RCPLN,U),0,2)
+5 WRITE ?45,"Number of Payments:",?72,$PIECE(RCPLN,U,2),!
+6 WRITE "Date Plan Created:",?32,$$FMTE^XLFDT(RCCRDT,2)
+7 WRITE ?45,"Due Date of First Payment:",?72,$$FMTE^XLFDT(RCSTDT,2),!
+8 WRITE "Total Amount of Bills in Plan:",?32,"$",$JUSTIFY(RCTOT,0,2)
+9 ; PRCA*4.5*389
WRITE ?45,"Auto-Add Bills?:",?72,$SELECT(RCAUTO:"Yes",1:"No"),!
+10 WRITE "--------------------------------------------------------------------------------",!
+11 QUIT $$CORRECT()
+12 ;
GETID(RCDBTR) ; Get the Site and # Plans for a debtor
+1 ;
+2 NEW RCSITEID,RCI,RCCT
+3 ;
+4 SET RCSITEID=$PIECE($$SITE^VASITE(),U)
+5 SET RCCT=0
SET RCI=0
+6 FOR
SET RCI=$ORDER(^RCRP(340.5,"E",RCDBTR,RCI))
if RCI=""
QUIT
SET RCCT=RCCT+1
+7 ;
+8 ;Add 1 for new plan and add leading 0's
+9 SET RCCT=RCCT+1
SET RCCT="00"_RCCT
SET RCCT=$EXTRACT(RCCT,$LENGTH(RCCT)-1,$LENGTH(RCCT))
+10 ;
+11 QUIT RCSITEID_"-RPP-"_RCCT_"-"
+12 ;
GETPLN(RCDBTR,RCTOT,RCEDIT) ; Get the amount due and length of plan
+1 ;Repayment amount
+2 ;INPUT RCTOT - Total $ amount of bills in plan
+3 ; RCEDIT - (Optional) 1 - Editing a Plan
+4 ; NULL or 0 - Entering a new plan.
+5 ;Returns Amount^# PAYMENTS or 0
+6 NEW DIR,X,Y,DIRUT
+7 NEW RCAMT,RCPAY,RCOK,QUIT,RCSPFLG
+8 ;
+9 SET RCEDIT=$GET(RCEDIT)
+10 SET DIR(0)="NA^.01:999999:2"
+11 SET DIR("A")=$SELECT('RCEDIT:"",1:"New ")_"Monthly Payment Amount: "
+12 SET DIR("?")="This is the amount the debtor will pay each month"
+13 SET RCOK=0
SET QUIT=0
FOR
Begin DoDot:1
+14 SET RCAMT=0
+15 DO ^DIR
+16 IF $DATA(DIRUT)
SET RCOK=1
QUIT
+17 SET RCAMT=+Y
+18 ;If amount < 25, Supervisor approval needed, re-ask otherwise
+19 IF RCAMT<25
Begin DoDot:2
+20 SET RCSPFLG=$$SUPAPPR(RCDBTR,1)
+21 if RCSPFLG'=1
QUIT
+22 ;Store the approval for an audit log later
SET ^TMP("RCRPP",$JOB,"SUP25")=1
End DoDot:2
if RCSPFLG'=1
QUIT
+23 ;continue
+24 SET RCPAY=RCTOT\RCAMT
IF RCTOT#RCAMT>0
SET RCPAY=RCPAY+1
+25 WRITE !!,"Number of Payments will be ",RCPAY,!
+26 IF RCPAY>60
Begin DoDot:2
+27 WRITE !,"The number of payments cannot exceed 60. Please re-enter the payment amount.",!
End DoDot:2
QUIT
+28 IF RCPAY>36
Begin DoDot:2
+29 WRITE !,"The number of payments exceeds 36 payments.",!
+30 SET RCSPFLG=$$SUPAPPR(RCDBTR,2)
+31 if RCSPFLG'=1
QUIT
+32 ;Store the approval for an audit log later
SET ^TMP("RCRPP",$JOB,"SUP36")=1
+33 DO PAUSE
End DoDot:2
if RCSPFLG'=1
QUIT
+34 SET RCOK=1
End DoDot:1
if RCOK!(QUIT)
QUIT
+35 IF $DATA(DIRUT)
QUIT 0
+36 IF QUIT
QUIT 0
+37 ;
+38 QUIT RCAMT_U_RCPAY
+39 ;
GETSTART(RCCRDT) ; Calculate the start date .
+1 ;
+2 ; This routine calculates the start date to be a minimum
+3 ; of 45 days after the creation date, and then finds the
+4 ; 28th of the month.
+5 ;
+6 NEW RCSTDT,RCSTYR,RCSTMN,RCSTDY,RES
+7 ;
+8 ;Calculate a minimum of 45 days
+9 SET RCSTDT=$$FMADD^XLFDT(RCCRDT,45)
+10 ;
+11 SET RCSTYR=$EXTRACT(RCSTDT,1,3)
+12 SET RCSTMN=$EXTRACT(RCSTDT,4,5)
+13 SET RCSTDY=$EXTRACT(RCSTDT,6,7)
+14 ;
+15 ;If the day calculated is the 28th, return the date.
+16 IF RCSTDY=28
SET RES=RCSTDT
+17 ;
+18 ;Find the next 28th.
+19 ; If day <28 move to the 28th and quit
+20 IF RCSTDY<28
SET RES=RCSTYR_RCSTMN_28
+21 ;
+22 ;If start day needs to move into the next month, then add the necessary days and return the new date.
+23 IF RCSTDY>28
Begin DoDot:1
+24 SET RCSTMN=RCSTMN+1
+25 IF RCSTMN<10
SET RCSTMN="0"_RCSTMN
+26 IF RCSTMN>12
SET RCSTMN="01"
SET RCSTYR=RCSTYR+1
+27 SET RES=RCSTYR_RCSTMN_28
+28 QUIT
End DoDot:1
+29 ;
+30 ; if calculated date is prior to 10/28/21, set it to 10/28/21
IF RES<3211028
SET RES=3211028
+31 QUIT RES
+32 ;
SUPAPPR(RCDBTR,RCTXTFLG) ; Confirm Supervisor approval, file Debtor Comment for Supervisor Approval
+1 ;
+2 NEW DIR,X,Y,RCPROMPT
+3 SET RCTYPE=$GET(RCTYPE)
+4 SET DIR(0)="Y"
+5 IF RCTXTFLG=1
SET DIR("A")="Has your Supervisor approved this amount? (Y/N) "
+6 IF RCTXTFLG=2
SET DIR("A")="Has your Supervisor approved the number of payments? (Y/N) "
+7 DO ^DIR
+8 IF +Y<1
QUIT -1
+9 ;
+10 QUIT 1
+11 ;
SAVEPLAN(RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO) ; Save the repayment plan details
+1 ;
+2 NEW FDA,FDAIEN,IENS,LIEN,RCRPIEN,RCSUB,RCRPIEN,RCIEN
+3 ;
+4 ;Lock the file to grab the Next IEN to construct the RPP ID before filing.
+5 ;
+6 LOCK +^RCRP(340.5):5
IF '$TEST
WRITE !,"Another user is creating a Repayment Plan. Please try again later."
LOCK -^RCRP(340.5)
QUIT -1
+7 SET RCIEN=$PIECE($GET(^RCRP(340.5,0)),U,3)+1
SET RCIEN="000000"_RCIEN
+8 ;
+9 SET RCRPID=RCRPID_$EXTRACT(RCIEN,$LENGTH(RCIEN)-5,$LENGTH(RCIEN))
+10 SET IENS="+1,"
+11 ;Plan ID
SET FDA(340.5,IENS,.01)=RCRPID
+12 ;Debtor
SET FDA(340.5,IENS,.02)=RCDBTR
+13 ;Creation Date
SET FDA(340.5,IENS,.03)=RCCRDT
+14 ;Start Date
SET FDA(340.5,IENS,.04)=RCSTDT
+15 ;Length (# payments)
SET FDA(340.5,IENS,.05)=$PIECE(RCPLN,U,2)
+16 ;Amount Per Month
SET FDA(340.5,IENS,.06)=$PIECE(RCPLN,U,1)
+17 ;Status (NEW on creation)
SET FDA(340.5,IENS,.07)=1
+18 ;Status Date
SET FDA(340.5,IENS,.08)=RCCRDT
+19 ;Total amount due in plan.
SET FDA(340.5,IENS,.11)=RCTOT
+20 ;Auto-add bills PRCA*4.5*378
SET FDA(340.5,IENS,.12)=RCAUTO
+21 ;Store total as original amount as well
SET FDA(340.5,IENS,.13)=RCTOT
+22 ;Store Length as original # payments as well
SET FDA(340.5,IENS,.14)=$PIECE(RCPLN,U,2)
+23 ;
+24 ; first parameter is currently "" so internal it is for now
+25 DO UPDATE^DIE("","FDA","FDAIEN","RETURN")
+26 LOCK -^RCRP(340.5)
+27 ;
+28 SET RCRPIEN=FDAIEN(1)
+29 ;
+30 ;Update the Audit Log
+31 DO UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N","N")
+32 ;
+33 ;Update Audit Log with Supervisor Approvals, if any.
+34 if $GET(^TMP("RCRPP",$JOB,"SUP25"))
DO UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N","SA")
+35 ; PRCA*4.5*389
if $GET(^TMP("RCRPP",$JOB,"SUP36"))
DO UPDFLG36^RCRPU1(RCRPIEN,1)
DO UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N","SM")
+36 ;
+37 ;Update the Schedule Node
+38 SET RCSUB=0
+39 FOR
SET RCSUB=$ORDER(^TMP("RCRPP",$JOB,"PLAN",RCSUB))
if 'RCSUB
QUIT
DO UPDSCHED(RCRPIEN,RCSUB)
+40 ;
+41 ;Update Debtor file
+42 DO UPDDBTR(RCRPIEN,RCDBTR)
+43 ;
+44 ;Update the Bills in file 430 and file transactions for each bill included,
+45 ;then update the Bill node in the Repayment Plan
+46 SET RCSUB=0
+47 FOR
SET RCSUB=$ORDER(^TMP("RCRPP",$JOB,"BILLS",RCSUB))
if 'RCSUB
QUIT
Begin DoDot:1
+48 ;Update the Bills and the Transaction file
DO ADDPLAN(RCRPIEN,RCSUB,RCCRDT)
+49 ;Update the Bill Node in the RPP
DO UPDBILL(RCRPIEN,RCSUB)
End DoDot:1
+50 ;
+51 ;PRCA*4.5*381
+52 ;If bills referral to CS was detected, updated AT CS field (#1.04)
+53 IF $DATA(^TMP("RCRPP",$JOB,"CS"))
DO UPDATCS^RCRPU2(RCRPIEN,1,1)
+54 ;
+55 WRITE !,"The Repayment Plan "_RCRPID_" has been established.",!!
+56 ;
+57 ;Update the Metrics File
+58 DO UPDMET^RCSTATU(1.07,1)
+59 ; PRCA*4.5*389
DO UPDMET^RCSTATU(1.35,1)
+60 QUIT 1
+61 ;
UPDSCHED(RCRPIEN,RCSUB) ; Add a month to the schedule in the RPP file (#340.5)
+1 ;
+2 NEW DA,DD,DIC,DLAYGO,DO,DR
+3 SET DLAYGO=340.5
SET DA(1)=RCRPIEN
SET DIC(0)="L"
SET X=RCSUB
SET DIC="^RCRP(340.5,"_DA(1)_",2,"
+4 DO FILE^DICN
+5 QUIT
+6 ;
UPDDBTR(RCRPIEN,RCDBTR) ; Add a Plan to the Debtor file (#340)
+1 ;
+2 NEW DA,DD,DIC,DLAYGO,DO,DR
+3 SET DLAYGO=340
SET DA(1)=RCDBTR
SET DIC(0)="L"
SET X=RCRPIEN
SET DIC="^RCD(340,"_DA(1)_",9,"
+4 DO FILE^DICN
+5 QUIT
+6 ;
UPDBILL(RCRPIEN,RCBILLDA) ; Add a new bill to the Bill Node in the RPP file (#340.5)
+1 ;
+2 NEW DA,DD,DIC,DLAYGO,DO,DR
+3 SET DLAYGO=340.5
SET DA(1)=RCRPIEN
SET DIC(0)="L"
SET X=RCBILLDA
SET DIC="^RCRP(340.5,"_DA(1)_",6,"
+4 DO FILE^DICN
+5 QUIT
+6 ;
REMBILL(RCRPIEN,RCBILLDA) ; remove bill from sub-file 340.5
+1 ;
+2 ; RCRPIEN - file 340.5 ien
+3 ; RCBILLDA - file 430 ien (bill to remove)
+4 ;
+5 NEW DA,DIK
+6 IF RCRPIEN'>0!(RCBILLDA'>0)
QUIT
+7 SET DA=$ORDER(^RCRP(340.5,RCRPIEN,6,"B",RCBILLDA,""))
if DA'>0
QUIT
+8 SET DA(1)=RCRPIEN
+9 SET DIK="^RCRP(340.5,"_DA(1)_",6,"
+10 DO ^DIK
+11 QUIT
+12 ;
BLDPLN(RCSTDT,RCLEN,RCSTFLG) ; Build the Payment Schedule
+1 ;INPUT - RCSTDT - Initial proposed start date
+2 ; RCLEN - Total Number of months
+3 ; RCSTFLG - (Optional) Flag to indicate if Start Date should be included in payment schedule
+4 ;
+5 NEW RCMNARY,RCSTART,RCMONTH,RCYEAR,RCCOUNT,RCDATE
+6 ;
+7 ;If Start flag is set, then skip the adding the start date to the schedule
+8 SET RCSTFLG=$GET(RCSTFLG)
+9 SET RCSTART=$EXTRACT(RCSTDT,1,5)
SET RCMONTH=$EXTRACT(RCSTART,4,5)
SET RCYEAR=$EXTRACT(RCSTART,1,3)
+10 ;
+11 if 'RCSTFLG
SET RCMNARY(RCSTDT)=""
+12 if RCSTFLG
SET RCLEN=RCLEN+1
+13 ;
+14 FOR RCCOUNT=2:1:RCLEN
Begin DoDot:1
+15 SET RCMONTH=RCMONTH+1
+16 if RCMONTH=13
SET RCMONTH=1
SET RCYEAR=RCYEAR+1
+17 IF RCMONTH<10
SET RCMONTH="0"_RCMONTH
+18 SET RCDATE=RCYEAR_RCMONTH_28
+19 SET RCMNARY(RCDATE)=""
End DoDot:1
+20 MERGE ^TMP("RCRPP",$JOB,"PLAN")=RCMNARY
+21 QUIT
+22 ;
UPDPAYST(RCRPID) ;Update the Paid flag in the Schedule Multiple
+1 ;
+2 NEW RCD0,RCNOPY,RCAMTMN,RCAMT,RCLOOP,RCTOTPD,RCDL,RCAMTPD,RCCMP
+3 ;
+4 ;Calc total payments
+5 SET RCD0=$GET(^RCRP(340.5,RCRPID,0))
+6 SET RCNOPY=$PIECE(RCD0,U,5)
SET RCAMTMN=$PIECE(RCD0,U,6)
SET RCAMT=$PIECE(RCD0,U,11)
+7 ;
+8 ;Calc amount received (Payments Node)
+9 SET RCLOOP=0
SET RCTOTPD=0
+10 FOR
SET RCLOOP=$ORDER(^RCRP(340.5,RCRPID,3,RCLOOP))
if RCLOOP=""
QUIT
Begin DoDot:1
+11 SET RCDL=$GET(^RCRP(340.5,RCRPID,3,RCLOOP,0))
+12 SET RCAMTPD=$PIECE(RCDL,U,2)
SET RCTOTPD=RCTOTPD+RCAMTPD
End DoDot:1
+13 ;
+14 ;Determine # payments completed
+15 SET RCCMP=RCTOTPD\RCAMTMN
+16 ;
+17 ;If the total paid = total amount owed, add a month to the # payments completed
+18 ; (as the final month owed is not the full monthly amount) and change the status of the
+19 ; plan to Paid in Full.
+20 IF RCAMT=RCTOTPD
Begin DoDot:1
+21 SET RCCMP=RCCMP+1
+22 DO UPDSTAT^RCRPU1(RCRPID,8)
End DoDot:1
+23 ;
+24 ;Review and update the payment node (Schedule Node)
+25 DO UPDPAID^RCRPU1(RCRPID,RCCMP)
+26 QUIT
+27 ;
ADDPLAN(RCRPIEN,RCBILLDA,RCCRDT) ;Record the Plan info into each bill and to the Transaction file.
+1 ; Input: RCRPIEN - IEN of the Repayment Plan (from file #340.5)
+2 ; RCBILLDA - IEN of the Bill to add the plan to
+3 ; RCCRDT - Date to add to the plan.
+4 ;
+5 NEW X,Y,DIC,DIE,DR,RCAMT,PRCA
+6 ;Store the RPP IEN into the AR file (#430) AR Repayment Plan (#45) field.
+7 SET (DIC,DIE)="^PRCA(430,"
SET DA=RCBILLDA
SET DR="41////"_RCCRDT_";45////"_RCRPIEN
+8 SET PRCA("LOCK")=0
DO LOCKF^PRCAWO1
if PRCA("LOCK")=0
DO ^DIE
+9 KILL DA,DIC,DIE,DR
+10 ;get the current amount owed.
+11 SET RCAMT=$PIECE($GET(^PRCA(430,RCBILLDA,7)),U)
+12 ;File a Transaction into the Transaction file.
+13 DO TRAN(RCBILLDA,RCAMT,16)
+14 QUIT
+15 ;
TRAN(RCBILLDA,RCAMT,RCTRANS) ;File plan add transaction in 433
+1 NEW DIE,DA,DR,PRCAEN,PRCAKTY
+2 SET PRCAKTY=$ORDER(^PRCA(430.3,"AC",RCTRANS,""))
+3 SET PRCAEN=-1
DO SETTR^PRCAUTL
if PRCAEN<0
QUIT
SET DA=PRCAEN
+4 SET DIE="^PRCA(433,"
SET DR=".03////"_RCBILLDA_";11///"_DT_";12///"_PRCAKTY_";15///0"
DO ^DIE
+5 SET $PIECE(^PRCA(433,PRCAEN,0),U,4)=2
+6 QUIT
+7 ;
CHKACT(RCDBTR) ;Check to see if the Debtor has an Active Repayment Plan.
+1 ;
+2 ;INPUT - RCDBTR - Debtor to check
+3 ;Return: 0 if no Active Plans, 1 if an Active Plan (non Terminated, closed, or Paid in Full plans)
+4 ;
+5 NEW RCACTV,RCLOOP,RCSTATUS,RCDATA
+6 ;
+7 SET RCACTV=0
+8 ;
+9 SET RCLOOP=0
+10 FOR
SET RCLOOP=$ORDER(^RCRP(340.5,"E",RCDBTR,RCLOOP))
if 'RCLOOP
QUIT
Begin DoDot:1
+11 SET RCDATA=$GET(^RCRP(340.5,RCLOOP,0))
SET RCSTATUS=$PIECE(RCDATA,U,7)
+12 ;Active Plan
IF RCSTATUS<6
SET RCACTV=1_U_RCLOOP
End DoDot:1
if RCACTV
QUIT
+13 ;No active plan
QUIT RCACTV
+14 ;
GETNXTPY(RCRPID) ; Retrieve the next payment due date
+1 ;
+2 ;Input - RCRPID - Repayment Plan IEN
+3 ;Output - Date of Next Repayment Plan Payment.
+4 ;
+5 NEW RCNXTDT,RCLOOP,RCDONE,RCDATA,RCPAID,RCFOR
+6 ;
+7 SET RCLOOP=""
SET RCDONE=0
+8 ;Loop through the Schedule Multiple. Locate the next payment due.
+9 FOR
SET RCLOOP=$ORDER(^RCRP(340.5,RCRPID,2,RCLOOP))
if RCLOOP=""
QUIT
Begin DoDot:1
+10 SET RCDATA=$GET(^RCRP(340.5,RCRPID,2,RCLOOP,0))
+11 if RCDATA=""
QUIT
+12 SET RCNXTDT=$PIECE(RCDATA,U)
SET RCPAID=$PIECE(RCDATA,U,2)
SET RCFOR=$PIECE(RCDATA,U,3)
+13 IF 'RCPAID
IF 'RCFOR
SET RCDONE=1
End DoDot:1
if RCDONE
QUIT
+14 ;Return the Payment Due date.
+15 QUIT RCNXTDT
+16 ;
GETPLANS(RCDBTR) ; Get a list of Repayment Plans for a debtor.
+1 ;
+2 ;INPUT - RCDBTR - Debtor to check
+3 ;Return: 0 if no Active Plans, 1 if an Active Plan (non Terminated, closed, or Paid in Full plans)
+4 ;
+5 NEW RCACTV,RCLOOP,RCPLNS
+6 ;
+7 SET RCPLNS=0
+8 ;
+9 SET RCLOOP=0
+10 FOR
SET RCLOOP=$ORDER(^RCRP(340.5,"E",RCDBTR,RCLOOP))
if 'RCLOOP
QUIT
Begin DoDot:1
+11 ;Active Plan
SET RCPLNS=RCPLNS+1
+12 SET ^TMP("RCRPP",$JOB,"PLANS",RCPLNS)=RCLOOP_U_$GET(^RCRP(340.5,RCLOOP,0))
End DoDot:1
+13 ;No active plan
QUIT RCPLNS
