- RCRPU ;EDE/SAB - REPAYMENT PLAN UTILITIES;11/16/2020 8:40 AM
- ;;4.5;Accounts Receivable;**377,381,388,378,389,422**;Mar 20, 1995;Build 13
- ;;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
- . I +$G(^PRCA(430,RCBILL,14)),'$P($G(^RCD(340,RCDBTR,6)),U,2) S RCCS=3 ; Bill at TOP PRCA*4.5*422
- . ; 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,RCAUCMT,RCPLN) ;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
- ; RCAUCMT - audit log comment ("N" or "T")
- ; RCPLN - new plan monthly amount ^ new plan # of payments, or 0
- ; Returns: 1 if completed
- ;
- N RCSTDT,RCDAY,RCCRDT,RCSVFLG
- ;
- ;Get site and # of RPP for the Debtor
- S RCRPID=$$GETID(+RCDBTR)
- Q:RCRPID=0 0
- ;
- ;Get Amount^# Payments
- I '+RCPLN S RCPLN=$$GETPLN(RCDBTR,RCTOT) ; PRCA*4.5*422
- 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
- I RCAUCMT'="T",'$$RPDIS($P(RCDBTR,U,2),RCPLN,RCSTDT,RCCRDT,RCTOT,RCAUTO) W !,"Repayment Plan not Saved.",! D PAUSE Q 0 ; PRCA*4.5*422
- ;
- ;Save the plan
- S RCSVFLG=$$SAVEPLAN(+RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO,RCAUCMT) ; PRCA*4.5*422
- ;
- 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(1) ; PRCA*4.5*422
- . . 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(2) ; PRCA*4.5*422
- . . 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(RCTXTFLG) ; Confirm Supervisor approval, file Debtor Comment for Supervisor Approval PRCA*4.5*422
- ;
- N DIR,X,Y
- 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,RCAUCMT) ; 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",RCAUCMT) ; PRCA*4.5*422
- ;
- ;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 19507 printed Feb 18, 2025@23:14:52 Page 2
- RCRPU ;EDE/SAB - REPAYMENT PLAN UTILITIES;11/16/2020 8:40 AM
- +1 ;;4.5;Accounts Receivable;**377,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 ;
- 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 ; Bill at TOP PRCA*4.5*422
- IF +$GET(^PRCA(430,RCBILL,14))
- IF '$PIECE($GET(^RCD(340,RCDBTR,6)),U,2)
- SET RCCS=3
- +30 ; If bill not in CS, add to Active Queue
- +31 IF 'RCCS
- Begin DoDot:2
- +32 SET RCACT=RCACT+1
- +33 SET ^TMP("RCRPP",$JOB,"ACTIVE",RCACT)=RCBILL_U_RCBILLNO_U_RCAMT_U_RCDOS_U_RCSTAT_U_RCCAT
- End DoDot:2
- QUIT
- +34 ; If bill in CS, add to CS queue
- +35 SET RCCSCT=RCCSCT+1
- +36 SET ^TMP("RCRPP",$JOB,"CS",RCCSCT)=RCBILL_U_RCBILLNO_U_RCAMT_U_RCDOS_U_RCSTAT_U_RCCAT_U_RCCS
- End DoDot:1
- +37 QUIT RCACT_U_RCCSCT
- +38 ;
- 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,RCAUCMT,RCPLN) ;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 ; RCAUCMT - audit log comment ("N" or "T")
- +7 ; RCPLN - new plan monthly amount ^ new plan # of payments, or 0
- +8 ; Returns: 1 if completed
- +9 ;
- +10 NEW RCSTDT,RCDAY,RCCRDT,RCSVFLG
- +11 ;
- +12 ;Get site and # of RPP for the Debtor
- +13 SET RCRPID=$$GETID(+RCDBTR)
- +14 if RCRPID=0
- QUIT 0
- +15 ;
- +16 ;Get Amount^# Payments
- +17 ; PRCA*4.5*422
- IF '+RCPLN
- SET RCPLN=$$GETPLN(RCDBTR,RCTOT)
- +18 if +RCPLN=0
- QUIT 0
- +19 ;
- +20 ;Set the Creation date and Start date. Build the plan schedule
- +21 SET RCCRDT=$$DT^XLFDT
- +22 SET RCSTDT=$$GETSTART(RCCRDT)
- +23 DO BLDPLN(RCSTDT,$PIECE(RCPLN,U,2))
- +24 ;
- +25 ;Set the day of the month a payment is due to the 28th
- +26 SET RCDAY=28
- +27 ; PRCA*4.5*422
- IF RCAUCMT'="T"
- IF '$$RPDIS($PIECE(RCDBTR,U,2),RCPLN,RCSTDT,RCCRDT,RCTOT,RCAUTO)
- WRITE !,"Repayment Plan not Saved.",!
- DO PAUSE
- QUIT 0
- +28 ;
- +29 ;Save the plan
- +30 ; PRCA*4.5*422
- SET RCSVFLG=$$SAVEPLAN(+RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO,RCAUCMT)
- +31 ;
- +32 QUIT RCSVFLG
- +33 ;
- 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 ; PRCA*4.5*422
- SET RCSPFLG=$$SUPAPPR(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 ; PRCA*4.5*422
- SET RCSPFLG=$$SUPAPPR(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(RCTXTFLG) ; Confirm Supervisor approval, file Debtor Comment for Supervisor Approval PRCA*4.5*422
- +1 ;
- +2 NEW DIR,X,Y
- +3 SET DIR(0)="Y"
- +4 IF RCTXTFLG=1
- SET DIR("A")="Has your Supervisor approved this amount? (Y/N) "
- +5 IF RCTXTFLG=2
- SET DIR("A")="Has your Supervisor approved the number of payments? (Y/N) "
- +6 DO ^DIR
- +7 IF +Y<1
- QUIT -1
- +8 ;
- +9 QUIT 1
- +10 ;
- SAVEPLAN(RCDBTR,RCRPID,RCPLN,RCCRDT,RCDAY,RCSTDT,RCTOT,RCAUTO,RCAUCMT) ; 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 ; PRCA*4.5*422
- DO UPDAUDIT^RCRPU2(RCRPIEN,RCCRDT,"N",RCAUCMT)
- +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