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

RCRPU.m

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