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