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

RCRPNP.m

Go to the documentation of this file. 
  1. RCRPNP ;EDE/SAB - REPAYMENT PLAN UTILITIES;12/31/2020  8:40 AM
  1.  ;;4.5;Accounts Receivable;**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. MAIN ; Entry Point for the nightly process
  1.  ;
  1.  D UPDSTAT
  1.  D ADDBILLS
  1.  D UPDCS
  1.  Q
  1.  ;
  1. UPDSTAT ;Review all active plans to determine their current status.
  1.  ;
  1.  N RCFLG36,RCFLG60,RCI,RCIENS,RCD0,RCCURST,RCNEWST,RCSTSTRT,RCSTEND
  1.  ;Loop through the Repayment Plan file
  1.  ;
  1.  ; Start calculating execution time
  1.  S RCSTSTRT=$H
  1.  ;
  1.  S RCI=0 F  S RCI=$O(^RCRP(340.5,RCI)) Q:'RCI  D
  1.  .S RCD0=$G(^RCRP(340.5,RCI,0)) Q:'RCD0
  1.  .; Extract current status.
  1.  .S RCCURST=$P(RCD0,U,7)
  1.  .; Recalculate the status
  1.  .S RCNEWST=$$STATUS^RCRPU1(RCI)
  1.  .; If the status is different
  1.  .I RCCURST'=RCNEWST D
  1.  ..; Update the status to the New Status
  1.  ..D UPDSTAT^RCRPU1(RCI,RCNEWST)
  1.  ..; If the new status is Defaulted (5), update the PRINT DEFAULTED flag (1.02)
  1.  ..I RCNEWST=5 D UPDPRDF(RCI,1)
  1.  ..; If the new status is Delinquent (4), update the PRINT DEFAULTED flag (1.03)
  1.  ..I RCNEWST=4 D UPDPRDL(RCI,1)
  1.  ..; If going from "new" to a diff. status, check review flags
  1.  ..I RCCURST=1 D  ; PRCA*4.5*422
  1.  ...S RCIENS=RCI_","
  1.  ...S RCFLG36=$$GET1^DIQ(340.5,RCIENS,1.06,"I")
  1.  ...S RCFLG60=+$$GET1^DIQ(340.5,RCIENS,1.01,"I")
  1.  ...D CHKFLGS^RCRPU1(RCI,$$REMPMNTS^RCRPU3(RCI,$$GET1^DIQ(340.5,RCIENS,.06,"I")),RCFLG36,RCFLG60)
  1.  ...I $$GET1^DIQ(340.5,RCIENS,1.06,"I")=0 D MSGREV^RCRPWLUT
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  ; Update Processing time metrics
  1.  S RCSTEND=$H
  1.  D UPDMET^RCSTATU(2.03,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
  1.  Q
  1.  ;
  1. ADDBILLS ;Review a debtor and all non referred, Active bills to the plan.
  1.  ;
  1.  N RCACTDT,RCBILLDA,RCRPIEN,RCSTAT,RCACTIVE,RCDBTR,RCSTP,RCD0,RCRPSTAT,RCD7,RCAMT,RCMNPY,RCNOMN,RCNWLN,RCRPD0
  1.  N RCNWMN,RCNWMOD,RCPLNBL,RCRMLN,RCSTSTRT,RCSTEND,RCREV36
  1.  N RCFLG36,RCFLG60,RCIENS,RCQUIT
  1.  ;
  1.  ; Start calculating execution time
  1.  S RCSTSTRT=$H
  1.  ;
  1.  S RCACTDT=$$DT^XLFDT
  1.  S (RCREV36,RCRPIEN)=0  ; PRCA*4.5*389
  1.  F  S RCRPIEN=$O(^RCRP(340.5,RCRPIEN)) Q:'RCRPIEN  D
  1.  .; Check to see if the plan is active.  If not, skip it and grab the next
  1.  .S RCRPD0=$G(^RCRP(340.5,RCRPIEN,0)) Q:RCRPD0=""
  1.  .Q:'+$P(RCRPD0,U,12)  ; Quit if the Repayment Plan's AUTO ADD field is not set to Yes (it is No or NULL)
  1.  .S RCRPSTAT=$P(RCRPD0,U,7)
  1.  .Q:RCRPSTAT>5   ;Plan is TERMINATED, CLOSED or PAID IN FULL.
  1.  .; If the plan is under review, don't attempt to add bills
  1.  .S RCIENS=RCRPIEN_","
  1.  .S RCFLG60=+$$GET1^DIQ(340.5,RCIENS,1.01,"I")
  1.  .S RCFLG36=$$GET1^DIQ(340.5,RCIENS,1.06,"I")
  1.  .S RCRMLN=$$REMPMNTS^RCRPU3(RCRPIEN,$$GET1^DIQ(340.5,RCIENS,.06,"I"))
  1.  .D:RCRPSTAT'=1 CHKFLGS^RCRPU1(RCRPIEN,RCRMLN,RCFLG36,RCFLG60)
  1.  .I RCFLG60 Q  ; don't add bills if plan length > 57 months PRCA*4.5*423
  1.  .; Find the Debtor.
  1.  .S RCDBTR=$$GET1^DIQ(340.5,RCIENS,.02,"I")
  1.  .; Loop through the Active Bills for the Debtor
  1.  .S RCACTIVE=$O(^PRCA(430.3,"B","ACTIVE",""))  ; Get the Active Status IEN
  1.  .S (RCQUIT,RCBILLDA)=0 ;  PRCA*4.5*423
  1.  .; Loop through all bills or until plan is flagged for review.
  1.  .F  S RCBILLDA=$O(^PRCA(430,"AS",RCDBTR,RCACTIVE,RCBILLDA)) Q:'RCBILLDA  Q:RCQUIT  D
  1.  ..; Only look at First Party Bills
  1.  ..Q:'$$FIRSTPAR(+RCBILLDA)
  1.  ..; Skip if bill already in plan.
  1.  ..Q:+$$GET1^DIQ(430,RCBILLDA_",",45,"I")
  1.  ..; Exclude bills referred to CS, TOP, or DMC
  1.  ..S RCCSDT=+$$GET1^DIQ(430,RCBILLDA_",",151,"I")    ; get CS Date referral date
  1.  ..S RCCSRCDT=+$$GET1^DIQ(430,RCBILLDA_",",153,"I")  ; get CS Recall date
  1.  ..I RCCSDT,'RCCSRCDT Q    ;If still at Cross Servicing, the don't add bill to plan.
  1.  ..Q:+$$GET1^DIQ(430,RCBILLDA_",",121,"I")    ; Bill at DMC, quit, don't add bill to plan
  1.  ..I +$$GET1^DIQ(430,RCBILLDA_",",141,"I"),'+$$GET1^DIQ(340,RCDBTR_",",6.02,"I") Q    ; Bill still at TOP, quit, don't add bill to plan  PRCA*4.5*422
  1.  ..; Add the Bill to the plan.
  1.  ..D UPDBILL^RCRPU(RCRPIEN,RCBILLDA)
  1.  ..; Add Plan to the Bill
  1.  ..D ADDPLAN^RCRPU(RCRPIEN,RCBILLDA,RCACTDT)
  1.  ..; Update the Total balance Owed.
  1.  ..S RCD7=$G(^PRCA(430,RCBILLDA,7))
  1.  ..S RCD0=$G(^PRCA(430,RCBILLDA,0))
  1.  ..S RCAMT=$S(+RCD7:$P(RCD7,U,1)+$P(RCD7,U,2)+$P(RCD7,U,3)+$P(RCD7,U,4)+$P(RCD7,U,5),1:$P(RCD0,U,3))
  1.  ..S RCPLNBL=$$GET1^DIQ(340.5,RCIENS,.11,"I")  ;get the current Plan amount Owed value.
  1.  ..D UPDPAO^RCRPU1(RCRPIEN,RCAMT+RCPLNBL)
  1.  ..;Calculate the new remaining balance
  1.  ..S RCPLNBL=$$GET1^DIQ(340.5,RCIENS,.11,"I")  ;get the new Plan amount Owed value.
  1.  ..; Recalculate the total # payments.
  1.  ..S RCMNPY=$$GET1^DIQ(340.5,RCIENS,.06,"I")
  1.  ..S RCNOMN=$$GET1^DIQ(340.5,RCIENS,.05,"I")
  1.  ..S RCNWMN=RCPLNBL\RCMNPY,RCNWMOD=RCPLNBL#RCMNPY
  1.  ..I RCNWMOD>0 S RCNWMN=RCNWMN+1
  1.  ..; Calculate the # payments remaining
  1.  ..S RCRMLN=$$REMPMNTS^RCRPU3(RCRPIEN,RCMNPY)  ; PRCA*4.5*389
  1.  ..; If there is a change in term length, update the plan and the schedule.
  1.  ..I RCNOMN'=RCNWMN D
  1.  ...D UPDTERMS^RCRPU1(RCRPIEN,RCMNPY_"^"_RCNWMN)
  1.  ...D ADJSCHED^RCRPENTR(RCRPIEN,RCNOMN,RCNWMN)
  1.  ...I RCRPSTAT'=1,RCRMLN>36,RCFLG36'=1 S RCREV36=1  ; PRCA*4.5*422
  1.  ...Q
  1.  ..D:RCRPSTAT'=1 CHKFLGS^RCRPU1(RCRPIEN,RCRMLN,RCFLG36,RCFLG60)  ; PRCA*4.5*422
  1.  ..I RCRPSTAT'=1,+$$GET1^DIQ(340.5,RCIENS,1.01,"I") S RCQUIT=1 ;  PRCA*4.5*422
  1.  ..;
  1.  ..;Update Audit Log
  1.  ..D UPDAUDIT^RCRPU2(RCRPIEN,$$DT^XLFDT,"A","")
  1.  ..;
  1.  ..;Update the AR Metrics File with activity
  1.  ..D UPDMET^RCSTATU(1.02,1)
  1.  ..Q
  1.  .Q
  1.  I RCREV36 D MSGREV^RCRPWLUT  ; send Mailman notification for plans that need 36 months review  PRCA*4.5*422
  1.  ; Update Processing time metrics
  1.  S RCSTEND=$H
  1.  D UPDMET^RCSTATU(2.02,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
  1.  Q
  1.  ;
  1. UPDCS ;Review all bills for the Debtor to see if any are still in Cross Service Debt Referral
  1.  ;
  1.  N RCIEN,RCD0,RCD1,RCSTAT,RCDBTR,RCOLDCS,RCNEWCS,RCBILL,RCBLSTAT,RCCSDT,RCCSRCDT
  1.  ;
  1.  ; Start calculating execution time
  1.  S RCSTSTRT=$H
  1.  ;
  1.  ;Loop through all active Repayment Plans
  1.  S RCIEN=0
  1.  F  S RCIEN=$O(^RCRP(340.5,RCIEN)) Q:'RCIEN  D
  1.  . S RCD0=$G(^RCRP(340.5,RCIEN,0)),RCD1=$G(^RCRP(340.5,RCIEN,1))
  1.  . S RCSTAT=$P(RCD0,U,7)
  1.  . Q:RCSTAT>5
  1.  . ; extract the debtor, and the AT CS flag
  1.  . S RCDBTR=$P(RCD0,U,2),RCOLDCS=$P(RCD1,U,4)
  1.  . ; find all of the bills associated with that debtor
  1.  . ; Initialize new AT CS flag to NULL
  1.  . S RCNEWCS=0,RCBILL=0
  1.  . F  S RCBILL=$O(^PRCA(430,"C",RCDBTR,RCBILL)) Q:'RCBILL  D  Q:RCNEWCS=1
  1.  . . ; for each active bill
  1.  . . S RCBLSTAT=$$GET1^DIQ(430,RCBILL_",",8,"I")
  1.  . . Q:RCBLSTAT'=16
  1.  . . ; Check to see if it is at cross servicing
  1.  . . S RCCSDT=$$GET1^DIQ(430,RCBILL_",",151,"I")
  1.  . . Q:'+RCCSDT           ;quit if not at Cross Servicing
  1.  . . ;If at cross servicing (field 151 with data and 153 with no data), then set new AT CS flag = 1 and quit loop
  1.  . . S RCCSRCDT=$$GET1^DIQ(430,RCBILL_",",153,"I")
  1.  . . S:'+RCCSRCDT RCNEWCS=1
  1.  . ; If the current AT CS flag matches the new AT CS flag get the next debtor
  1.  . I +RCOLDCS'=+RCNEWCS D UPDATCS^RCRPU2(RCIEN,RCNEWCS)
  1.  . ;If a bill has been newly referred to CS, send an alert to investigate
  1.  . I '+RCOLDCS,+RCNEWCS D CSALERT^RCSTATU(RCBILL,RCIEN)
  1.  ;
  1.  ; Update Processing time metrics
  1.  S RCSTEND=$H
  1.  D UPDMET^RCSTATU(2.01,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
  1.  Q
  1.  ;
  1. UPDPRDL(RCIEN,RCFLG) ; Update the Print Deliquent Flag
  1.  ;INPUT - RCIEN:  IEN of the Repayment Plan
  1.  ;        RCFLG:  Value of the flag.
  1.  ;                1        : To appear on the Print Delinquent Report
  1.  ;                0 or NULL: Does not appear on the Print Delinquent Report
  1.  ;
  1.  N DA,DR,DIE,X,Y
  1.  S DA=RCIEN,DIE="^RCRP(340.5,"
  1.  S DR="1.03///"_RCFLG
  1.  D ^DIE
  1.  Q
  1.  ;
  1. UPDPRDF(RCIEN,RCFLG) ; Update the Print Default flag
  1.  ;INPUT - RCIEN:  IEN of the Repayment Plan
  1.  ;        RCFLG:  Value of the flag.
  1.  ;                1        : To appear on the Print Default Report
  1.  ;                0 or NULL: Does not appear on the Print Default Report
  1.  ;
  1.  N DA,DR,DIE,X,Y
  1.  S DA=RCIEN,DIE="^RCRP(340.5,"
  1.  S DR="1.02///"_RCFLG
  1.  D ^DIE
  1.  Q
  1.  ;
  1. FIRSTPAR(RCBILLDA) ; Check to see if the AR Category is a First Party AR Category.
  1.  N RCCAT
  1.  ;
  1.  S RCCAT=+$$GET1^DIQ(430,RCBILLDA_",",2,"I")
  1.  ;Retrieve whether or not the category is eligible for inclusion into a Repayment Plan.
  1.  Q $$GET1^DIQ(430.2,RCCAT_",",1.06,"I")
  1.  ;
  1. BLDSTARY() ;Build a ^TMP array to define the field to store any status movement metrics in file #340.7
  1.  ;
  1.  ; Status Set of Code values
  1.  ; NEW - 1
  1.  ; CURRENT - 2
  1.  ; LATE - 3
  1.  ; DELINQUENT - 4
  1.  ; DEFAULT - 5
  1.  ; TERMINATED - 6
  1.  ; CLOSED - 7
  1.  ; PAID IN FULL - 8
  1.  ;
  1.  ;Clear any potential older arrays
  1.  K ^TMP($J,"RPPFLDNO")
  1.  ;
  1.  ;Set the array
  1.  S ^TMP($J,"RPPFLDNO",1,2)=1.11    ;New to Current
  1.  S ^TMP($J,"RPPFLDNO",2,3)=1.12    ;Current to Late
  1.  S ^TMP($J,"RPPFLDNO",3,4)=1.13    ;Late to Delinquent
  1.  S ^TMP($J,"RPPFLDNO",4,5)=1.14    ;Delinquent to Defaulted
  1.  S ^TMP($J,"RPPFLDNO",5,6)=1.15    ;Defaulted to Terminated
  1.  S ^TMP($J,"RPPFLDNO",3,2)=1.16    ;Late to Current
  1.  S ^TMP($J,"RPPFLDNO",4,3)=1.17    ;Delinquent to Late
  1.  S ^TMP($J,"RPPFLDNO",4,2)=1.18    ;Delinquent to Current
  1.  S ^TMP($J,"RPPFLDNO",5,4)=1.19    ;Defaulted to Delinquent
  1.  S ^TMP($J,"RPPFLDNO",5,3)=1.21    ;Defaulted to Late
  1.  S ^TMP($J,"RPPFLDNO",5,2)=1.22    ;Defaulted to Current
  1.  S ^TMP($J,"RPPFLDNO",2,8)=1.23    ;Current to Paid in Full
  1.  S ^TMP($J,"RPPFLDNO",3,8)=1.24    ;Late to Paid in Full
  1.  S ^TMP($J,"RPPFLDNO",4,8)=1.25    ;Delinquent to Paid in Full
  1.  S ^TMP($J,"RPPFLDNO",5,8)=1.26    ;Defaulted to Paid in Full
  1.  S ^TMP($J,"RPPFLDNO",2,7)=1.29    ;New to Closed
  1.  S ^TMP($J,"RPPFLDNO",3,7)=1.31    ;Current to Closed
  1.  S ^TMP($J,"RPPFLDNO",4,7)=1.32    ;Late to Closed
  1.  S ^TMP($J,"RPPFLDNO",5,7)=1.33    ;Delinquent to Closed
  1.  S ^TMP($J,"RPPFLDNO",1,8)=1.34    ;New to Paid in Full
  1.  Q