- RCRPU1 ;EDE/SAB - REPAYMENT PLAN UTILITIES;12/11/2020 8:40 AM
- ;;4.5;Accounts Receivable;**377,381,378,389,423,422**;Mar 20, 1995;Build 13
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- Q
- ;
- UPDTERMS(RCRPIEN,RCPLNS,RCRVW) ; Update the terms of the plan. PRCA*4.5*389
- ;
- N DR,DIE,DA,X,Y
- N FLG36,FLG60,N1,PMNTS,RPMNTS
- S N1=$G(^RCRP(340.5,RCRPIEN,1))
- S FLG36=$P(N1,U,6) ; 36 months review flag
- S FLG60=$P(N1,U) ; 60 months review flag
- S PMNTS=+$P(RCPLNS,U,2)
- S DR=".05////"_PMNTS_";.06////"_+RCPLNS
- S:$G(RCRVW) DR=DR_";1.01////1"
- S DIE="^RCRP(340.5,",DA=RCRPIEN
- D ^DIE
- I $P($G(^RCRP(340.5,RCRPIEN,0)),U,7)'=1 S RPMNTS=$$REMPMNTS^RCRPU3(RCRPIEN,+RCPLNS) D CHKFLGS(RCRPIEN,RPMNTS,FLG36,FLG60) ; PRCA*4.5*422
- Q
- ;
- CHKFLGS(RCRPIEN,RPMNTS,FLG36,FLG60) ; check if we need to update 36 months and 60 months review flags PRCA*4.5*423
- ;
- ; RCRPIEN - file 340.5 ien
- ; RPMNTS - # of payments remaining
- ; FLG36 - current value of 36 months review flag
- ; FLG60 - current value of 60 months review flag
- ;
- I RPMNTS>36,FLG36="" D UPDAUDIT^RCRPU2(RCRPIEN,DT,"E","SR",""),UPDFLG36(RCRPIEN,0) ; set 36 months review flag to "needs approval" and update audit log
- I RPMNTS<37,FLG36=2!(FLG36=0) D UPDFLG36(RCRPIEN,"") ; clear "denied" or "needs approval" 36 months review flag
- I RPMNTS>57,'FLG60 D UPDRVW^RCRPU2(RCRPIEN,1) ; set 60 months review flag
- I RPMNTS<58,FLG60 D UPDRVW^RCRPU2(RCRPIEN,0) ; clear 60 months review flag
- Q
- ;
- UPDFLG36(RCRPIEN,VAL) ; update 36 months review flag (field 340.5/1.06) PRCA*4.5*389
- ;
- ; RCRPIEN - file 340.5 ien
- ; VAL - new value for field 340.5/1.06 (internal)
- ;
- N FDA
- L +^RCRP(340.5,RCRPIEN):10 I '$T Q
- S FDA(340.5,RCRPIEN_",",1.06)=VAL
- D FILE^DIE("","FDA")
- L -^RCRP(340.5,RCRPIEN)
- Q
- ;
- GETRSN() ; Get the reason the plan was closed.
- N X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCIEN,RCDONE
- ;
- ; Prompt Summary or Detail version
- S DIR("A")="Reason for closing the plan: (A)dministrative or (D)efaulted "
- S DIR(0)="SA^D:Defaulted for Non-Payment;A:Administratively Closed"
- S DIR("?")="Select a reason to close the plan. to peform the plan lookup by Debtor or Repayment Plan ID."
- ;
- D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT)!($G(Y)="") Q -1
- Q Y
- ;
- UPDSTAT(RCRPIEN,RCNWSTAT) ; Update the status of the plan
- ;INPUT - RCRPIEN: IEN of the Repayment Plan
- ; RCSTATUS: The Status to update to.
- ;
- N DA,DR,DIE,X,Y,RCSTTXT,RCCURST,RCFIELD,RCBILLDA,Z
- ;
- S RCCURST=$$GET1^DIQ(340.5,RCRPIEN_",",.07,"I") ;retrieve the current status
- ;
- S DA=RCRPIEN,DIE="^RCRP(340.5,"
- S DR=".07///"_RCNWSTAT_";.08///"_DT
- D ^DIE
- ;
- ;Update the Metrics File if the new status is not NEW
- ;
- I RCNWSTAT>1 D
- . ;Initialize the TMP array.
- . D BLDSTARY^RCRPNP
- . ;
- . ; Update the Metrics
- . S RCFIELD=$G(^TMP($J,"RPPFLDNO",RCCURST,RCNWSTAT))
- . D:+RCFIELD UPDMET^RCSTATU(RCFIELD,1)
- . K ^TMP($J,"RPPFLDNO")
- ;
- ;Update the Audit Log with a Status comment
- S RCSTTXT=$$GET1^DIQ(340.5,RCRPIEN_",",.07,"E")
- D UPDAUDIT^RCRPU2(RCRPIEN,DT,"S","",RCSTTXT)
- ;
- ;Clear the Term Length Exceeded Flag if the Plan is Closed, Terminated, or Paid In Full
- I RCNWSTAT>5 D UPDRVW^RCRPU2(RCRPIEN,0)
- ;
- ;Clear the Default and Delinquent Flags if the Plan is Closed or Paid in Full
- I RCNWSTAT>6 D
- . D UPDPRDL^RCRPNP(RCRPIEN,0)
- . D UPDPRDF^RCRPNP(RCRPIEN,0)
- ; PRCA*4.5*422
- I RCNWSTAT=6 D
- .S Z=0 F S Z=$O(^RCRP(340.5,RCRPIEN,6,Z)) Q:'Z D
- ..S RCBILLDA=$G(^RCRP(340.5,RCRPIEN,6,Z,0)) Q:'RCBILLDA
- ..; remove fields 41 and 45 from the bill
- ..D RMVPLN^RCRPU1(RCBILLDA)
- ..D TRAN^RCRPU(RCBILLDA,0,69) ; file "RPP Terminated" transaction
- .D UPDAUDIT^RCRPU2(RCRPIEN,DT,"C","S") ; update Audit Log with System Termination Comment
- .Q
- ; end PRCA*4.5*422
- Q
- ;
- RMBILL(RCIEN) ; Remove the Repayment Plan info from the bills in the plan
- ;INPUT - RCIEN: IEN of the Repayment Plan
- ;
- N RCLP,RCBLIEN,RCI,RCD7,RCTOT
- ;
- S RCLP=0
- F S RCLP=$O(^RCRP(340.5,RCIEN,6,RCLP)) Q:'RCLP D
- . S RCBLIEN=+$G(^RCRP(340.5,RCIEN,6,RCLP,0))
- . S DA=RCBLIEN,DIE="^PRCA(430,"
- . S DR="41///@;45///@"
- . D ^DIE
- . K DA,DR,DIE,X,Y
- . S RCD7=$G(^PRCA(430,RCBLIEN,7)),RCTOT=0
- . F RCI=1:1:5 S RCTOT=RCTOT+$P(RCD7,U,RCI)
- . D TRAN^RCRPU(RCBLIEN,RCTOT,68)
- Q
- ;
- UPDTRAN(RCIEN) ; Update all bills on a plan if an edit to the plan is made
- ;INPUT - RCIEN: IEN of the Repayment Plan
- ;
- N RCLP,RCBLIEN,RCI,RCD7,RCTOT
- ;
- S RCLP=0
- F S RCLP=$O(^RCRP(340.5,RCIEN,6,RCLP)) Q:'RCLP D
- . S RCBLIEN=+$G(^RCRP(340.5,RCIEN,6,RCLP,0))
- . K DLAYGO,DD,DO,DIC,DA,X,Y
- . S RCD7=$G(^PRCA(430,RCBLIEN,7)),RCTOT=0
- . F RCI=1:1:5 S RCTOT=RCTOT+$P(RCD7,U,RCI)
- . D TRAN^RCRPU(RCBLIEN,RCTOT,67)
- Q
- ;
- DBTCOM(RCTRANDA,RCTXTFLG) ;Add Transaction comments
- ; RCDBTR - Referance to #433 - IEN^Name
- ; RCTXTFLG - Comment text
- ;
- N DIC,X,Y,RCTEXT
- ;
- S RCTEXT="Supervisor Approval Obtained for "_$S(RCTXTFLG=1:"<$25 payment.",1:">36 months.")
- S DIC="^PRCA(433,"_+RCTRANDA_",7,",DIC(0)="L",X=RCTEXT
- D FILE^DICN
- Q
- ;
- SELRPP() ; select RPP to display
- ;
- ; returns selected ien in file 340.5 or -1 for user exit / timeout
- ;
- N DIC,DTOUT,DUOUT,X,Y
- S X=$G(X)
- S DIC=340.5,DIC(0)="AEQM"
- S DIC("W")="W $$CJ^XLFSTR($$EXTERNAL^DILFD(340.5,.07,,$P(^RCRP(340.5,Y,0),U,7)),15),$$CJ^XLFSTR($$FMTE^XLFDT($P(^RCRP(340.5,Y,0),U,3),""5DZ""),12)"
- S DIC("A")="Select Repayment Plan: "
- D ^DIC
- Q $S(+Y>0:+Y,1:-1)
- ;
- UPDPAY(RCIEN,RCTRAN,RCAMT) ; Update the payment information, schedule, and status.
- ;INPUT - RCIEN - IEN of the repayment Plan to update
- ; RCTRAN - AR Transaction file (#433) IEN to store)
- ; RCAMT - (Optional) Amount paid
- ;
- ;Update the Payment Node in the Plan
- N DA,DD,DIC,DLAYGO,DO,DR
- N RCCURST,RCSTAT
- ;
- Q:$G(RCIEN)="" ; No RPP IEN sent it.
- ;
- S DLAYGO=340.5,DA(1)=RCIEN,DIC(0)="L",X=$$DT^XLFDT,DIC="^RCRP(340.5,"_DA(1)_",3,"
- S DIC("DR")="1///"_RCAMT_";2///"_RCTRAN
- D FILE^DICN
- ;
- ;Update the Paid status in the schedule, as appropriate
- D UPDPAYST^RCRPU(RCIEN)
- ;
- ;Calculate a new status and update if different.
- S RCCURST=$$GET1^DIQ(340.5,RCIEN_",",.07,"I") ; PRCA*4.5*389
- S RCSTAT=$$STATUS(RCIEN)
- D:RCCURST'=RCSTAT UPDSTAT(RCIEN,RCSTAT)
- Q
- ;
- UPDPAID(RCIEN,RCCMP) ; Update the Paid flag in the payments.
- ;INPUT: RCIEN - IEN of plan to update
- ; RCCMP - # payments completed.
- ;
- N DR,DIE,DA,X,Y
- N RCI,RCPD,RCPDFLG,RCFBFLG,RCCNT
- ;
- S RCCNT=0
- F RCI=0:1 Q:RCCNT>RCCMP D
- . S RCPD=$G(^RCRP(340.5,RCIEN,2,RCI,0)),RCPDFLG=$P(RCPD,U,2),RCFBFLG=$P(RCPD,U,3)
- . I RCPDFLG S RCCNT=RCCNT+1 Q
- . I 'RCPDFLG,'RCFBFLG D
- . . S DR="1////1"
- . . S DA(1)=RCIEN,DA=RCI
- . . S DIE="^RCRP(340.5,"_DA(1)_",2,"
- . . D ^DIE
- . . S RCCNT=RCCNT+1 ;Increment the # of months counter update
- Q
- ;
- UPDBAL(RCBILLDA,RCTRANDA,RCSPFLG) ; Update the Plan Amount Owed (#.11) in the AR
- ; REPAYMENT PLAN file (#340.5).
- ;
- ;INPUT: RCBILLDA - IEN to ACCOUNTS RECEIVABLE file (#430)
- ; RCTRANDA - IEN to the AR TRANSACTION file (#433)
- ; RCSPFLG - (Optional) Is the update a result of a bill being suspended.
- ;
- N RCIEN,RCTRTYPE,RCRPPFLG,RCAMT,RCPYMNTS,RCRMBAL,RCMNPY,RCNOMN,RCNWLN,RCNWMOD
- ;
- ;Initialize the RCSPFLG if not sent in
- S RCSPFLG=+$G(RCSPFLG)
- ;
- ; Check to see if Bill has an active Repayment Plan. Exit if not
- S RCIEN=$$GET1^DIQ(430,RCBILLDA_",",45,"I")
- Q:RCIEN=""
- ;
- S RCTRTYPE=$$GET1^DIQ(433,RCTRANDA_",",12,"I")
- Q:RCTRTYPE=""
- ;
- ; remove bill from RPP if action caused by any write off transaction type (Termination/Suspension/et al)
- I RCSPFLG>0 D
- . D REMBILL^RCRPU(RCIEN,RCBILLDA) ; REMOVE BILL FROM PLAN
- . D RMVPLN(RCBILLDA,0) ; REMOVE PLAN FROM BILL,but don't file close transaction.
- ;
- ; Check to see if the Transaction type has an affect on the Repayment Plan
- ; Exit if the Transaction will not affect it.
- S RCRPPFLG=$$GET1^DIQ(430.3,RCTRTYPE_",",6,"I")
- Q:RCRPPFLG=""
- ;
- ; Extract the amount of the transaction. Quit if no transaction amount filed.
- S RCAMT=$$GET1^DIQ(433,RCTRANDA_",",15,"I")
- Q:+RCAMT=0
- ;
- ; If the Transaction Type Repayment Plan Processing flag is set to P
- ; then process the Transaction Type as a Payment and exit.
- I RCRPPFLG="P" D Q
- . D UPDPAY(RCIEN,RCTRANDA,RCAMT)
- ;
- ; Retrieve the remaining Balance.
- S RCRMBAL=$$GET1^DIQ(340.5,RCIEN_",",.11,"I")
- ;
- ; If the transaction is supposed to be a decrease, then make the
- ; transaction amount negative
- S:RCRPPFLG="D" RCAMT=-RCAMT
- ;
- ; Add (subtract if it is a decrease) the amount to the remaining balance.
- S RCRMBAL=RCRMBAL+RCAMT
- ;
- ; Store the new Balance.
- D UPDPAO(RCIEN,RCRMBAL)
- ;
- ; Recalculate terms with the new balance
- S RCMNPY=$$GET1^DIQ(340.5,RCIEN_",",.06,"I")
- S RCNOMN=$$GET1^DIQ(340.5,RCIEN_",",.05,"I")
- S RCNWLN=RCRMBAL\RCMNPY,RCNWMOD=RCRMBAL#RCMNPY
- I RCNWMOD>0 S RCNWLN=RCNWLN+1
- ;
- ; If there is a change in term length, update the plan.
- I RCNOMN'=RCNWLN D UPDTERMS(RCIEN,RCMNPY_U_RCNWLN),ADJSCHED^RCRPENTR(RCIEN,RCNOMN,RCNWLN)
- ;
- ;Check current balance. If 0 or lower, close the plan as paid in full
- S RCPYMNTS=$$PMNTS^RCRPU3(RCIEN)
- I (RCRMBAL-RCPYMNTS)'>0 D
- . D PAID(RCIEN,RCSPFLG)
- . I RCSPFLG=1 D TRAN^RCRPU(RCBILLDA,0,68) ; file transaction if the bill which closed the plan was suspended.
- ;
- Q
- ;
- UPDPAO(RCIEN,RCAMT) ; Update the PLAN AMOUNT OWE3D field
- ;
- N DR,DIE,DA,X,Y
- S DR=".11////"_RCAMT
- S DIE="^RCRP(340.5,",DA=RCIEN
- D ^DIE
- Q
- ;
- PAID(RCIEN,RCSPFLG) ; Repayment Plan is paid in full, update the status to PAID IN FULL and attempt to remove plan information from bills in plan.
- ;
- N RCI,RCBILLDA,RCSTAT,RCPYFLG
- ;
- ;Update the plan status to Paid in Full. If not suspended
- I '+RCSPFLG D
- . D UPDSTAT(RCIEN,8)
- . I '$D(ZTQUEUED) W !!,"This repayment plan has been closed and is PAID IN FULL.",!!
- ;
- ;Update the plan status to Closed because remaining bill(s) suspended AND exit.
- I RCSPFLG=1 D Q
- . D UPDSTAT(RCIEN,7)
- . D UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"C","A") ; AUDIT LOG
- . I '$D(ZTQUEUED) W !!,"This repayment plan has been CLOSED.",!!
- ;
- ;Update the status caused by other types of Bill Termination
- I RCSPFLG=2 D
- . S RCPYFLG=$D(^RCRP(340.5,RCIEN,3)) ; check to see if any payments associated with the plan
- . S RCSTAT=7 ; set the status to closed
- . S:RCPYFLG>9 RCSTAT=8 ; reset status to Paid in Full if any payments associated with the terminated transaction
- . D UPDSTAT(RCIEN,RCSTAT)
- . D:RCPYFLG>9 UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"C","A") ; Update Audit Log with a close entry if plan is closed and not paid in full.
- . I (RCPYFLG>9),'$D(ZTQUEUED) W !!,"This repayment plan has been CLOSED.",!! Q
- . I '$D(ZTQUEUED) W !!,"This repayment plan has been closed and is PAID IN FULL.",!!
- ;
- ;Remove the Plan info from the bills is the Bill is at a 0 balance, or is Suspended, Terminated or written off.
- S RCI=0
- F S RCI=$O(^RCRP(340.5,RCIEN,6,RCI)) Q:'RCI D
- . S RCBILLDA=$G(^RCRP(340.5,RCIEN,6,RCI,0))
- . Q:'RCBILLDA
- . D RMVPLN(RCBILLDA,1)
- Q
- ;
- RMVPLN(RCBILLDA,RCNOCLS) ;Remove the Plan info from a bill and file a Close Plan Transaction file.
- ; Input: RCBILLDA - IEN of the AR Bill (from file #430) to remove
- ; RCNOCLS - (Optional) - Flag to indicate whether to file a close Repayment Plan transaction or not.
- N X,Y,DIC,DIE,DR,RCAMT,PRCA
- ;
- ;Init RC NOCLS if necessary
- S RCNOCLS=+$G(RCNOCLS)
- ;
- ;Store the RPP IEN into the AR file (#430) AR Repayment Plan (#45) field.
- S (DIC,DIE)="^PRCA(430,",DA=RCBILLDA,DR="41////@;45////@"
- S PRCA("LOCK")=0 D LOCKF^PRCAWO1 D:PRCA("LOCK")=0 ^DIE
- K DA,DIC,DIE,DR
- ;get the current amount owed.
- ;File a Close Plan Transaction into the Transaction file.
- D:RCNOCLS TRAN^RCRPU(RCBILLDA,0,68)
- Q
- ;
- AUTOADD(DEF) ; display "allow bills to be auto-added?" prompt PRCA*4.5*378
- ;
- ; DEF - default value (1 = YES, 0 = NO, "" = no default)
- ;
- ; returns 1 for Yes, 0 for No, -1 for no selection
- ;
- N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="Y" I $G(DEF)'="" S DIR("B")=$S(DEF:"YES",1:"NO")
- S DIR("A")="Allow bills to be auto-added to the repayment plan? (Y/N)"
- D ^DIR I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) Q -1
- Q Y
- ;
- UPDAUTO(RCIEN,RCAUTO) ; Update "auto-add bills" flag. PRCA*4.5*378
- ;
- ; RCIEN - file 340.5 ien
- ; RCAUTO - new value for field 340.5/.12 (internal)
- ;
- N DR,DIE,DA,X,Y
- S DR=".12////"_RCAUTO,DIE="^RCRP(340.5,",DA=RCIEN
- D ^DIE
- ;
- ;Update the Audit Log
- D UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"S","","AUTO ADD")
- Q
- ;
- STATUS(RCRPIEN) ; Returns the current status of the plan.
- ;
- N RCD0,RCFRDT,RCSTAT,RCLSTDT,RCSTATDT,RCCURDT,RCDIFF,RCOLDST
- ;
- S RCD0=$G(^RCRP(340.5,RCRPIEN,0))
- S RCFRDT=$P(RCD0,U,4)
- S (RCSTAT,RCOLDST)=$P(RCD0,U,7)
- S RCSTATDT=$P(RCD0,U,8)
- S RCCURDT=$$DT^XLFDT ;Get current date
- I RCSTAT=5,RCCURDT>RCSTATDT Q 6 ;plan is defaulted, set new status to terminate and exit.
- I RCSTAT>5 Q RCSTAT ;Plan is closed
- I RCSTAT=1,RCCURDT<RCFRDT Q 1 ;Plan hasn't started yet. Status stays New
- S RCLSTDT=$$GETNXTPY^RCRPU(RCRPIEN) ;get the date of the next payment due
- I RCLSTDT="" D Q 8 ;No payments left, plan is Paid in Full. Update Delinquent/Default flags if necessary.
- . D UPDPRDL^RCRPNP(RCRPIEN,0)
- . D UPDPRDF^RCRPNP(RCRPIEN,0)
- ;
- S RCDIFF=$$FMDIFF^XLFDT(RCCURDT,RCLSTDT,1)
- S RCSTAT=$S(RCDIFF>90:5,RCDIFF>30:4,RCDIFF>0:3,1:2)
- I RCOLDST=4,RCSTAT'=4 D UPDPRDL^RCRPNP(RCRPIEN,0)
- I RCOLDST=5,RCSTAT<5 D UPDPRDF^RCRPNP(RCRPIEN,0)
- Q RCSTAT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPU1 13681 printed Feb 18, 2025@23:14:53 Page 2
- RCRPU1 ;EDE/SAB - REPAYMENT PLAN UTILITIES;12/11/2020 8:40 AM
- +1 ;;4.5;Accounts Receivable;**377,381,378,389,423,422**;Mar 20, 1995;Build 13
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 QUIT
- +5 ;
- UPDTERMS(RCRPIEN,RCPLNS,RCRVW) ; Update the terms of the plan. PRCA*4.5*389
- +1 ;
- +2 NEW DR,DIE,DA,X,Y
- +3 NEW FLG36,FLG60,N1,PMNTS,RPMNTS
- +4 SET N1=$GET(^RCRP(340.5,RCRPIEN,1))
- +5 ; 36 months review flag
- SET FLG36=$PIECE(N1,U,6)
- +6 ; 60 months review flag
- SET FLG60=$PIECE(N1,U)
- +7 SET PMNTS=+$PIECE(RCPLNS,U,2)
- +8 SET DR=".05////"_PMNTS_";.06////"_+RCPLNS
- +9 if $GET(RCRVW)
- SET DR=DR_";1.01////1"
- +10 SET DIE="^RCRP(340.5,"
- SET DA=RCRPIEN
- +11 DO ^DIE
- +12 ; PRCA*4.5*422
- IF $PIECE($GET(^RCRP(340.5,RCRPIEN,0)),U,7)'=1
- SET RPMNTS=$$REMPMNTS^RCRPU3(RCRPIEN,+RCPLNS)
- DO CHKFLGS(RCRPIEN,RPMNTS,FLG36,FLG60)
- +13 QUIT
- +14 ;
- CHKFLGS(RCRPIEN,RPMNTS,FLG36,FLG60) ; check if we need to update 36 months and 60 months review flags PRCA*4.5*423
- +1 ;
- +2 ; RCRPIEN - file 340.5 ien
- +3 ; RPMNTS - # of payments remaining
- +4 ; FLG36 - current value of 36 months review flag
- +5 ; FLG60 - current value of 60 months review flag
- +6 ;
- +7 ; set 36 months review flag to "needs approval" and update audit log
- IF RPMNTS>36
- IF FLG36=""
- DO UPDAUDIT^RCRPU2(RCRPIEN,DT,"E","SR","")
- DO UPDFLG36(RCRPIEN,0)
- +8 ; clear "denied" or "needs approval" 36 months review flag
- IF RPMNTS<37
- IF FLG36=2!(FLG36=0)
- DO UPDFLG36(RCRPIEN,"")
- +9 ; set 60 months review flag
- IF RPMNTS>57
- IF 'FLG60
- DO UPDRVW^RCRPU2(RCRPIEN,1)
- +10 ; clear 60 months review flag
- IF RPMNTS<58
- IF FLG60
- DO UPDRVW^RCRPU2(RCRPIEN,0)
- +11 QUIT
- +12 ;
- UPDFLG36(RCRPIEN,VAL) ; update 36 months review flag (field 340.5/1.06) PRCA*4.5*389
- +1 ;
- +2 ; RCRPIEN - file 340.5 ien
- +3 ; VAL - new value for field 340.5/1.06 (internal)
- +4 ;
- +5 NEW FDA
- +6 LOCK +^RCRP(340.5,RCRPIEN):10
- IF '$TEST
- QUIT
- +7 SET FDA(340.5,RCRPIEN_",",1.06)=VAL
- +8 DO FILE^DIE("","FDA")
- +9 LOCK -^RCRP(340.5,RCRPIEN)
- +10 QUIT
- +11 ;
- GETRSN() ; Get the reason the plan was closed.
- +1 NEW X,Y,DTOUT,DUOUT,DIR,DIROUT,DIRUT,RCIEN,RCDONE
- +2 ;
- +3 ; Prompt Summary or Detail version
- +4 SET DIR("A")="Reason for closing the plan: (A)dministrative or (D)efaulted "
- +5 SET DIR(0)="SA^D:Defaulted for Non-Payment;A:Administratively Closed"
- +6 SET DIR("?")="Select a reason to close the plan. to peform the plan lookup by Debtor or Repayment Plan ID."
- +7 ;
- +8 DO ^DIR
- KILL DIR
- +9 IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)="")
- QUIT -1
- +10 QUIT Y
- +11 ;
- UPDSTAT(RCRPIEN,RCNWSTAT) ; Update the status of the plan
- +1 ;INPUT - RCRPIEN: IEN of the Repayment Plan
- +2 ; RCSTATUS: The Status to update to.
- +3 ;
- +4 NEW DA,DR,DIE,X,Y,RCSTTXT,RCCURST,RCFIELD,RCBILLDA,Z
- +5 ;
- +6 ;retrieve the current status
- SET RCCURST=$$GET1^DIQ(340.5,RCRPIEN_",",.07,"I")
- +7 ;
- +8 SET DA=RCRPIEN
- SET DIE="^RCRP(340.5,"
- +9 SET DR=".07///"_RCNWSTAT_";.08///"_DT
- +10 DO ^DIE
- +11 ;
- +12 ;Update the Metrics File if the new status is not NEW
- +13 ;
- +14 IF RCNWSTAT>1
- Begin DoDot:1
- +15 ;Initialize the TMP array.
- +16 DO BLDSTARY^RCRPNP
- +17 ;
- +18 ; Update the Metrics
- +19 SET RCFIELD=$GET(^TMP($JOB,"RPPFLDNO",RCCURST,RCNWSTAT))
- +20 if +RCFIELD
- DO UPDMET^RCSTATU(RCFIELD,1)
- +21 KILL ^TMP($JOB,"RPPFLDNO")
- End DoDot:1
- +22 ;
- +23 ;Update the Audit Log with a Status comment
- +24 SET RCSTTXT=$$GET1^DIQ(340.5,RCRPIEN_",",.07,"E")
- +25 DO UPDAUDIT^RCRPU2(RCRPIEN,DT,"S","",RCSTTXT)
- +26 ;
- +27 ;Clear the Term Length Exceeded Flag if the Plan is Closed, Terminated, or Paid In Full
- +28 IF RCNWSTAT>5
- DO UPDRVW^RCRPU2(RCRPIEN,0)
- +29 ;
- +30 ;Clear the Default and Delinquent Flags if the Plan is Closed or Paid in Full
- +31 IF RCNWSTAT>6
- Begin DoDot:1
- +32 DO UPDPRDL^RCRPNP(RCRPIEN,0)
- +33 DO UPDPRDF^RCRPNP(RCRPIEN,0)
- End DoDot:1
- +34 ; PRCA*4.5*422
- +35 IF RCNWSTAT=6
- Begin DoDot:1
- +36 SET Z=0
- FOR
- SET Z=$ORDER(^RCRP(340.5,RCRPIEN,6,Z))
- if 'Z
- QUIT
- Begin DoDot:2
- +37 SET RCBILLDA=$GET(^RCRP(340.5,RCRPIEN,6,Z,0))
- if 'RCBILLDA
- QUIT
- +38 ; remove fields 41 and 45 from the bill
- +39 DO RMVPLN^RCRPU1(RCBILLDA)
- +40 ; file "RPP Terminated" transaction
- DO TRAN^RCRPU(RCBILLDA,0,69)
- End DoDot:2
- +41 ; update Audit Log with System Termination Comment
- DO UPDAUDIT^RCRPU2(RCRPIEN,DT,"C","S")
- +42 QUIT
- End DoDot:1
- +43 ; end PRCA*4.5*422
- +44 QUIT
- +45 ;
- RMBILL(RCIEN) ; Remove the Repayment Plan info from the bills in the plan
- +1 ;INPUT - RCIEN: IEN of the Repayment Plan
- +2 ;
- +3 NEW RCLP,RCBLIEN,RCI,RCD7,RCTOT
- +4 ;
- +5 SET RCLP=0
- +6 FOR
- SET RCLP=$ORDER(^RCRP(340.5,RCIEN,6,RCLP))
- if 'RCLP
- QUIT
- Begin DoDot:1
- +7 SET RCBLIEN=+$GET(^RCRP(340.5,RCIEN,6,RCLP,0))
- +8 SET DA=RCBLIEN
- SET DIE="^PRCA(430,"
- +9 SET DR="41///@;45///@"
- +10 DO ^DIE
- +11 KILL DA,DR,DIE,X,Y
- +12 SET RCD7=$GET(^PRCA(430,RCBLIEN,7))
- SET RCTOT=0
- +13 FOR RCI=1:1:5
- SET RCTOT=RCTOT+$PIECE(RCD7,U,RCI)
- +14 DO TRAN^RCRPU(RCBLIEN,RCTOT,68)
- End DoDot:1
- +15 QUIT
- +16 ;
- UPDTRAN(RCIEN) ; Update all bills on a plan if an edit to the plan is made
- +1 ;INPUT - RCIEN: IEN of the Repayment Plan
- +2 ;
- +3 NEW RCLP,RCBLIEN,RCI,RCD7,RCTOT
- +4 ;
- +5 SET RCLP=0
- +6 FOR
- SET RCLP=$ORDER(^RCRP(340.5,RCIEN,6,RCLP))
- if 'RCLP
- QUIT
- Begin DoDot:1
- +7 SET RCBLIEN=+$GET(^RCRP(340.5,RCIEN,6,RCLP,0))
- +8 KILL DLAYGO,DD,DO,DIC,DA,X,Y
- +9 SET RCD7=$GET(^PRCA(430,RCBLIEN,7))
- SET RCTOT=0
- +10 FOR RCI=1:1:5
- SET RCTOT=RCTOT+$PIECE(RCD7,U,RCI)
- +11 DO TRAN^RCRPU(RCBLIEN,RCTOT,67)
- End DoDot:1
- +12 QUIT
- +13 ;
- DBTCOM(RCTRANDA,RCTXTFLG) ;Add Transaction comments
- +1 ; RCDBTR - Referance to #433 - IEN^Name
- +2 ; RCTXTFLG - Comment text
- +3 ;
- +4 NEW DIC,X,Y,RCTEXT
- +5 ;
- +6 SET RCTEXT="Supervisor Approval Obtained for "_$SELECT(RCTXTFLG=1:"<$25 payment.",1:">36 months.")
- +7 SET DIC="^PRCA(433,"_+RCTRANDA_",7,"
- SET DIC(0)="L"
- SET X=RCTEXT
- +8 DO FILE^DICN
- +9 QUIT
- +10 ;
- SELRPP() ; select RPP to display
- +1 ;
- +2 ; returns selected ien in file 340.5 or -1 for user exit / timeout
- +3 ;
- +4 NEW DIC,DTOUT,DUOUT,X,Y
- +5 SET X=$GET(X)
- +6 SET DIC=340.5
- SET DIC(0)="AEQM"
- +7 SET DIC("W")="W $$CJ^XLFSTR($$EXTERNAL^DILFD(340.5,.07,,$P(^RCRP(340.5,Y,0),U,7)),15),$$CJ^XLFSTR($$FMTE^XLFDT($P(^RCRP(340.5,Y,0),U,3),""5DZ""),12)"
- +8 SET DIC("A")="Select Repayment Plan: "
- +9 DO ^DIC
- +10 QUIT $SELECT(+Y>0:+Y,1:-1)
- +11 ;
- UPDPAY(RCIEN,RCTRAN,RCAMT) ; Update the payment information, schedule, and status.
- +1 ;INPUT - RCIEN - IEN of the repayment Plan to update
- +2 ; RCTRAN - AR Transaction file (#433) IEN to store)
- +3 ; RCAMT - (Optional) Amount paid
- +4 ;
- +5 ;Update the Payment Node in the Plan
- +6 NEW DA,DD,DIC,DLAYGO,DO,DR
- +7 NEW RCCURST,RCSTAT
- +8 ;
- +9 ; No RPP IEN sent it.
- if $GET(RCIEN)=""
- QUIT
- +10 ;
- +11 SET DLAYGO=340.5
- SET DA(1)=RCIEN
- SET DIC(0)="L"
- SET X=$$DT^XLFDT
- SET DIC="^RCRP(340.5,"_DA(1)_",3,"
- +12 SET DIC("DR")="1///"_RCAMT_";2///"_RCTRAN
- +13 DO FILE^DICN
- +14 ;
- +15 ;Update the Paid status in the schedule, as appropriate
- +16 DO UPDPAYST^RCRPU(RCIEN)
- +17 ;
- +18 ;Calculate a new status and update if different.
- +19 ; PRCA*4.5*389
- SET RCCURST=$$GET1^DIQ(340.5,RCIEN_",",.07,"I")
- +20 SET RCSTAT=$$STATUS(RCIEN)
- +21 if RCCURST'=RCSTAT
- DO UPDSTAT(RCIEN,RCSTAT)
- +22 QUIT
- +23 ;
- UPDPAID(RCIEN,RCCMP) ; Update the Paid flag in the payments.
- +1 ;INPUT: RCIEN - IEN of plan to update
- +2 ; RCCMP - # payments completed.
- +3 ;
- +4 NEW DR,DIE,DA,X,Y
- +5 NEW RCI,RCPD,RCPDFLG,RCFBFLG,RCCNT
- +6 ;
- +7 SET RCCNT=0
- +8 FOR RCI=0:1
- if RCCNT>RCCMP
- QUIT
- Begin DoDot:1
- +9 SET RCPD=$GET(^RCRP(340.5,RCIEN,2,RCI,0))
- SET RCPDFLG=$PIECE(RCPD,U,2)
- SET RCFBFLG=$PIECE(RCPD,U,3)
- +10 IF RCPDFLG
- SET RCCNT=RCCNT+1
- QUIT
- +11 IF 'RCPDFLG
- IF 'RCFBFLG
- Begin DoDot:2
- +12 SET DR="1////1"
- +13 SET DA(1)=RCIEN
- SET DA=RCI
- +14 SET DIE="^RCRP(340.5,"_DA(1)_",2,"
- +15 DO ^DIE
- +16 ;Increment the # of months counter update
- SET RCCNT=RCCNT+1
- End DoDot:2
- End DoDot:1
- +17 QUIT
- +18 ;
- UPDBAL(RCBILLDA,RCTRANDA,RCSPFLG) ; Update the Plan Amount Owed (#.11) in the AR
- +1 ; REPAYMENT PLAN file (#340.5).
- +2 ;
- +3 ;INPUT: RCBILLDA - IEN to ACCOUNTS RECEIVABLE file (#430)
- +4 ; RCTRANDA - IEN to the AR TRANSACTION file (#433)
- +5 ; RCSPFLG - (Optional) Is the update a result of a bill being suspended.
- +6 ;
- +7 NEW RCIEN,RCTRTYPE,RCRPPFLG,RCAMT,RCPYMNTS,RCRMBAL,RCMNPY,RCNOMN,RCNWLN,RCNWMOD
- +8 ;
- +9 ;Initialize the RCSPFLG if not sent in
- +10 SET RCSPFLG=+$GET(RCSPFLG)
- +11 ;
- +12 ; Check to see if Bill has an active Repayment Plan. Exit if not
- +13 SET RCIEN=$$GET1^DIQ(430,RCBILLDA_",",45,"I")
- +14 if RCIEN=""
- QUIT
- +15 ;
- +16 SET RCTRTYPE=$$GET1^DIQ(433,RCTRANDA_",",12,"I")
- +17 if RCTRTYPE=""
- QUIT
- +18 ;
- +19 ; remove bill from RPP if action caused by any write off transaction type (Termination/Suspension/et al)
- +20 IF RCSPFLG>0
- Begin DoDot:1
- +21 ; REMOVE BILL FROM PLAN
- DO REMBILL^RCRPU(RCIEN,RCBILLDA)
- +22 ; REMOVE PLAN FROM BILL,but don't file close transaction.
- DO RMVPLN(RCBILLDA,0)
- End DoDot:1
- +23 ;
- +24 ; Check to see if the Transaction type has an affect on the Repayment Plan
- +25 ; Exit if the Transaction will not affect it.
- +26 SET RCRPPFLG=$$GET1^DIQ(430.3,RCTRTYPE_",",6,"I")
- +27 if RCRPPFLG=""
- QUIT
- +28 ;
- +29 ; Extract the amount of the transaction. Quit if no transaction amount filed.
- +30 SET RCAMT=$$GET1^DIQ(433,RCTRANDA_",",15,"I")
- +31 if +RCAMT=0
- QUIT
- +32 ;
- +33 ; If the Transaction Type Repayment Plan Processing flag is set to P
- +34 ; then process the Transaction Type as a Payment and exit.
- +35 IF RCRPPFLG="P"
- Begin DoDot:1
- +36 DO UPDPAY(RCIEN,RCTRANDA,RCAMT)
- End DoDot:1
- QUIT
- +37 ;
- +38 ; Retrieve the remaining Balance.
- +39 SET RCRMBAL=$$GET1^DIQ(340.5,RCIEN_",",.11,"I")
- +40 ;
- +41 ; If the transaction is supposed to be a decrease, then make the
- +42 ; transaction amount negative
- +43 if RCRPPFLG="D"
- SET RCAMT=-RCAMT
- +44 ;
- +45 ; Add (subtract if it is a decrease) the amount to the remaining balance.
- +46 SET RCRMBAL=RCRMBAL+RCAMT
- +47 ;
- +48 ; Store the new Balance.
- +49 DO UPDPAO(RCIEN,RCRMBAL)
- +50 ;
- +51 ; Recalculate terms with the new balance
- +52 SET RCMNPY=$$GET1^DIQ(340.5,RCIEN_",",.06,"I")
- +53 SET RCNOMN=$$GET1^DIQ(340.5,RCIEN_",",.05,"I")
- +54 SET RCNWLN=RCRMBAL\RCMNPY
- SET RCNWMOD=RCRMBAL#RCMNPY
- +55 IF RCNWMOD>0
- SET RCNWLN=RCNWLN+1
- +56 ;
- +57 ; If there is a change in term length, update the plan.
- +58 IF RCNOMN'=RCNWLN
- DO UPDTERMS(RCIEN,RCMNPY_U_RCNWLN)
- DO ADJSCHED^RCRPENTR(RCIEN,RCNOMN,RCNWLN)
- +59 ;
- +60 ;Check current balance. If 0 or lower, close the plan as paid in full
- +61 SET RCPYMNTS=$$PMNTS^RCRPU3(RCIEN)
- +62 IF (RCRMBAL-RCPYMNTS)'>0
- Begin DoDot:1
- +63 DO PAID(RCIEN,RCSPFLG)
- +64 ; file transaction if the bill which closed the plan was suspended.
- IF RCSPFLG=1
- DO TRAN^RCRPU(RCBILLDA,0,68)
- End DoDot:1
- +65 ;
- +66 QUIT
- +67 ;
- UPDPAO(RCIEN,RCAMT) ; Update the PLAN AMOUNT OWE3D field
- +1 ;
- +2 NEW DR,DIE,DA,X,Y
- +3 SET DR=".11////"_RCAMT
- +4 SET DIE="^RCRP(340.5,"
- SET DA=RCIEN
- +5 DO ^DIE
- +6 QUIT
- +7 ;
- PAID(RCIEN,RCSPFLG) ; Repayment Plan is paid in full, update the status to PAID IN FULL and attempt to remove plan information from bills in plan.
- +1 ;
- +2 NEW RCI,RCBILLDA,RCSTAT,RCPYFLG
- +3 ;
- +4 ;Update the plan status to Paid in Full. If not suspended
- +5 IF '+RCSPFLG
- Begin DoDot:1
- +6 DO UPDSTAT(RCIEN,8)
- +7 IF '$DATA(ZTQUEUED)
- WRITE !!,"This repayment plan has been closed and is PAID IN FULL.",!!
- End DoDot:1
- +8 ;
- +9 ;Update the plan status to Closed because remaining bill(s) suspended AND exit.
- +10 IF RCSPFLG=1
- Begin DoDot:1
- +11 DO UPDSTAT(RCIEN,7)
- +12 ; AUDIT LOG
- DO UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"C","A")
- +13 IF '$DATA(ZTQUEUED)
- WRITE !!,"This repayment plan has been CLOSED.",!!
- End DoDot:1
- QUIT
- +14 ;
- +15 ;Update the status caused by other types of Bill Termination
- +16 IF RCSPFLG=2
- Begin DoDot:1
- +17 ; check to see if any payments associated with the plan
- SET RCPYFLG=$DATA(^RCRP(340.5,RCIEN,3))
- +18 ; set the status to closed
- SET RCSTAT=7
- +19 ; reset status to Paid in Full if any payments associated with the terminated transaction
- if RCPYFLG>9
- SET RCSTAT=8
- +20 DO UPDSTAT(RCIEN,RCSTAT)
- +21 ; Update Audit Log with a close entry if plan is closed and not paid in full.
- if RCPYFLG>9
- DO UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"C","A")
- +22 IF (RCPYFLG>9)
- IF '$DATA(ZTQUEUED)
- WRITE !!,"This repayment plan has been CLOSED.",!!
- QUIT
- +23 IF '$DATA(ZTQUEUED)
- WRITE !!,"This repayment plan has been closed and is PAID IN FULL.",!!
- End DoDot:1
- +24 ;
- +25 ;Remove the Plan info from the bills is the Bill is at a 0 balance, or is Suspended, Terminated or written off.
- +26 SET RCI=0
- +27 FOR
- SET RCI=$ORDER(^RCRP(340.5,RCIEN,6,RCI))
- if 'RCI
- QUIT
- Begin DoDot:1
- +28 SET RCBILLDA=$GET(^RCRP(340.5,RCIEN,6,RCI,0))
- +29 if 'RCBILLDA
- QUIT
- +30 DO RMVPLN(RCBILLDA,1)
- End DoDot:1
- +31 QUIT
- +32 ;
- RMVPLN(RCBILLDA,RCNOCLS) ;Remove the Plan info from a bill and file a Close Plan Transaction file.
- +1 ; Input: RCBILLDA - IEN of the AR Bill (from file #430) to remove
- +2 ; RCNOCLS - (Optional) - Flag to indicate whether to file a close Repayment Plan transaction or not.
- +3 NEW X,Y,DIC,DIE,DR,RCAMT,PRCA
- +4 ;
- +5 ;Init RC NOCLS if necessary
- +6 SET RCNOCLS=+$GET(RCNOCLS)
- +7 ;
- +8 ;Store the RPP IEN into the AR file (#430) AR Repayment Plan (#45) field.
- +9 SET (DIC,DIE)="^PRCA(430,"
- SET DA=RCBILLDA
- SET DR="41////@;45////@"
- +10 SET PRCA("LOCK")=0
- DO LOCKF^PRCAWO1
- if PRCA("LOCK")=0
- DO ^DIE
- +11 KILL DA,DIC,DIE,DR
- +12 ;get the current amount owed.
- +13 ;File a Close Plan Transaction into the Transaction file.
- +14 if RCNOCLS
- DO TRAN^RCRPU(RCBILLDA,0,68)
- +15 QUIT
- +16 ;
- AUTOADD(DEF) ; display "allow bills to be auto-added?" prompt PRCA*4.5*378
- +1 ;
- +2 ; DEF - default value (1 = YES, 0 = NO, "" = no default)
- +3 ;
- +4 ; returns 1 for Yes, 0 for No, -1 for no selection
- +5 ;
- +6 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
- +7 SET DIR(0)="Y"
- IF $GET(DEF)'=""
- SET DIR("B")=$SELECT(DEF:"YES",1:"NO")
- +8 SET DIR("A")="Allow bills to be auto-added to the repayment plan? (Y/N)"
- +9 DO ^DIR
- IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT -1
- +10 QUIT Y
- +11 ;
- UPDAUTO(RCIEN,RCAUTO) ; Update "auto-add bills" flag. PRCA*4.5*378
- +1 ;
- +2 ; RCIEN - file 340.5 ien
- +3 ; RCAUTO - new value for field 340.5/.12 (internal)
- +4 ;
- +5 NEW DR,DIE,DA,X,Y
- +6 SET DR=".12////"_RCAUTO
- SET DIE="^RCRP(340.5,"
- SET DA=RCIEN
- +7 DO ^DIE
- +8 ;
- +9 ;Update the Audit Log
- +10 DO UPDAUDIT^RCRPU2(RCIEN,$$DT^XLFDT,"S","","AUTO ADD")
- +11 QUIT
- +12 ;
- STATUS(RCRPIEN) ; Returns the current status of the plan.
- +1 ;
- +2 NEW RCD0,RCFRDT,RCSTAT,RCLSTDT,RCSTATDT,RCCURDT,RCDIFF,RCOLDST
- +3 ;
- +4 SET RCD0=$GET(^RCRP(340.5,RCRPIEN,0))
- +5 SET RCFRDT=$PIECE(RCD0,U,4)
- +6 SET (RCSTAT,RCOLDST)=$PIECE(RCD0,U,7)
- +7 SET RCSTATDT=$PIECE(RCD0,U,8)
- +8 ;Get current date
- SET RCCURDT=$$DT^XLFDT
- +9 ;plan is defaulted, set new status to terminate and exit.
- IF RCSTAT=5
- IF RCCURDT>RCSTATDT
- QUIT 6
- +10 ;Plan is closed
- IF RCSTAT>5
- QUIT RCSTAT
- +11 ;Plan hasn't started yet. Status stays New
- IF RCSTAT=1
- IF RCCURDT<RCFRDT
- QUIT 1
- +12 ;get the date of the next payment due
- SET RCLSTDT=$$GETNXTPY^RCRPU(RCRPIEN)
- +13 ;No payments left, plan is Paid in Full. Update Delinquent/Default flags if necessary.
- IF RCLSTDT=""
- Begin DoDot:1
- +14 DO UPDPRDL^RCRPNP(RCRPIEN,0)
- +15 DO UPDPRDF^RCRPNP(RCRPIEN,0)
- End DoDot:1
- QUIT 8
- +16 ;
- +17 SET RCDIFF=$$FMDIFF^XLFDT(RCCURDT,RCLSTDT,1)
- +18 SET RCSTAT=$SELECT(RCDIFF>90:5,RCDIFF>30:4,RCDIFF>0:3,1:2)
- +19 IF RCOLDST=4
- IF RCSTAT'=4
- DO UPDPRDL^RCRPNP(RCRPIEN,0)
- +20 IF RCOLDST=5
- IF RCSTAT<5
- DO UPDPRDF^RCRPNP(RCRPIEN,0)
- +21 QUIT RCSTAT
- +22 ;