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

RCRPU1.m

Go to the documentation of this file.
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
 ;
 ;
 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
 ;