RCRPNP ;EDE/SAB - REPAYMENT PLAN UTILITIES;12/31/2020 8:40 AM
;;4.5;Accounts Receivable;**378,389,423**;Mar 20, 1995;Build 8
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
MAIN ; Entry Point for the nightly process
;
D UPDSTAT
D ADDBILLS
D UPDCS
Q
;
UPDSTAT ;Review all active plans to determine their current status.
;
N RCI,RCJ,RCD0,RCCURST,RCNEWST,RCCRDT,RCSTSTRT,RCSTEND
;Loop through the Repayment Plan file
;
; Start calculating execution time
S RCSTSTRT=$H
;
S RCI=0
S RCCRDT=$$DT^XLFDT ;Set the current date
;
F S RCI=$O(^RCRP(340.5,RCI)) Q:'RCI D
. S RCD0=$G(^RCRP(340.5,RCI,0))
. Q:'RCD0
. ; Extract current status.
. S RCCURST=$P(RCD0,U,7)
. ;recalculate the status
. S RCNEWST=$$STATUS^RCRPU1(RCI)
. ;
. ;If the status is different
. I RCCURST'=RCNEWST D
. . ; Update the status to the New Status
. . D UPDSTAT^RCRPU1(RCI,RCNEWST)
. . ; If the new status is Defaulted (5), update the PRINT DEFAULTED flag (1.02)
. . I RCNEWST=5 D UPDPRDF(RCI,1)
. . ; If the new status is Delinquent (4), update the PRINT DEFAULTED flag (1.03)
. . I RCNEWST=4 D UPDPRDL(RCI,1)
. . ; If the new status is Terminated
. . I RCNEWST=6 D
. . . ; Loop through each Bill
. . . S RCJ=0
. . . F S RCJ=$O(^RCRP(340.5,RCI,6,RCJ)) Q:'RCJ D
. . . . S RCBILLDA=$G(^RCRP(340.5,RCI,6,RCJ,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 PRCA*4.5*389
. . . D UPDAUDIT^RCRPU2(RCI,RCCRDT,"C","S") ;Update Audit Log with System Termination Comment
;
; Update Processing time metrics
S RCSTEND=$H
D UPDMET^RCSTATU(2.03,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
Q
;
ADDBILLS ;Review a debtor and all non referred, Active bills to the plan.
;
N RCACTDT,RCBILLDA,RCRPIEN,RCSTAT,RCACTIVE,RCDBTR,RCSTP,RCD0,RCRPSTAT,RCD7,RCAMT,RCMNPY,RCNOMN,RCNWLN,RCRPD0
N RCNWMN,RCPLNBL,RCRMLN,RCSTSTRT,RCSTEND,RCREV36
N RCFLG36,RCFLG60,RCQUIT ; PRCA*4.5*423
;
; Start calculating execution time
S RCSTSTRT=$H
;
S RCACTDT=$$DT^XLFDT
S (RCREV36,RCRPIEN)=0 ; PRCA*4.5*389
F S RCRPIEN=$O(^RCRP(340.5,RCRPIEN)) Q:'RCRPIEN D
.; Check to see if the plan is active. If not, skip it and grab the next
.S RCRPD0=$G(^RCRP(340.5,RCRPIEN,0)) Q:RCRPD0=""
.Q:'+$P(RCRPD0,U,12) ; Quit if the Repayment Plan's AUTO ADD field is not set to Yes (it is No or NULL)
.S RCRPSTAT=$P(RCRPD0,U,7)
.Q:RCRPSTAT>5 ;Plan is TERMINATED, CLOSED or PAID IN FULL.
.; If the plan is under review, don't attempt to add bills
.S RCFLG60=+$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I") ; PRCA*4.5*423
.S RCFLG36=$$GET36^RCRPWLUT(RCRPIEN) ; PRCA*4.5*423
.S RCRMLN=$$REMPMNTS^RCRPU3(RCRPIEN,$$GET1^DIQ(340.5,RCRPIEN_",",.06,"I")) ; PRCA*4.5*423
.D CHKFLGS^RCRPU1(RCRPIEN,RCRMLN,RCFLG36,RCFLG60) ; PRCA*4.5*423
.I RCFLG60 Q ; don't add bills if plan length > 57 months PRCA*4.5*423
.I RCRMLN>36,RCFLG36'=1 Q ; don't add bills if plan length > 36 months and there's no approval PRCA*4.5*423
.; Find the Debtor.
.S RCDBTR=$$GET1^DIQ(340.5,RCRPIEN_",",.02,"I")
.; Loop through the Active Bills for the Debtor
.S RCACTIVE=$O(^PRCA(430.3,"B","ACTIVE","")) ; Get the Active Status IEN
.S (RCQUIT,RCBILLDA)=0 ; PRCA*4.5*423
.; Loop through all bills or until plan is flagged for review.
.F S RCBILLDA=$O(^PRCA(430,"AS",RCDBTR,RCACTIVE,RCBILLDA)) Q:'RCBILLDA Q:RCQUIT D
..; Only look at First Party Bills
..Q:'$$FIRSTPAR(+RCBILLDA)
..; Skip if bill already in plan.
..Q:+$$GET1^DIQ(430,RCBILLDA_",",45,"I")
..; Exclude bills referred to CS, TOP, or DMC
..S RCCSDT=+$$GET1^DIQ(430,RCBILLDA_",",151,"I") ; get CS Date referral date
..S RCCSRCDT=+$$GET1^DIQ(430,RCBILLDA_",",153,"I") ; get CS Recall date
..I RCCSDT,'RCCSRCDT Q ;If still at Cross Servicing, the don't add bill to plan.
..Q:+$$GET1^DIQ(430,RCBILLDA_",",121,"I") ; Bill at DMC, quit, don't add bill to plan
..I +$$GET1^DIQ(430,RCBILLDA_",",141,"I"),+$$GET1^DIQ(430,RCDBTR_",",6.02,"I") Q ; Bill still at TOP, quit, don't add bill to plan
..; Add the Bill to the plan.
..D UPDBILL^RCRPU(RCRPIEN,RCBILLDA)
..; Add Plan to the Bill
..D ADDPLAN^RCRPU(RCRPIEN,RCBILLDA,RCACTDT)
..; Update the Total balance Owed.
..S RCD7=$G(^PRCA(430,RCBILLDA,7))
..S RCD0=$G(^PRCA(430,RCBILLDA,0))
..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))
..S RCPLNBL=$$GET1^DIQ(340.5,RCRPIEN_",",.11,"I") ;get the current Plan amount Owed value.
..D UPDPAO^RCRPU1(RCRPIEN,RCAMT+RCPLNBL)
..;Calculate the new remaining balance
..S RCPLNBL=$$GET1^DIQ(340.5,RCRPIEN_",",.11,"I") ;get the new Plan amount Owed value.
..; Recalculate the total # payments.
..S RCMNPY=$$GET1^DIQ(340.5,RCRPIEN_",",.06,"I")
..S RCNOMN=$$GET1^DIQ(340.5,RCRPIEN_",",.05,"I")
..S RCNWMN=RCPLNBL\RCMNPY,RCNWMOD=RCPLNBL#RCMNPY
..I RCNWMOD>0 S RCNWMN=RCNWMN+1
..; Calculate the # payments remaining
..S RCRMLN=$$REMPMNTS^RCRPU3(RCRPIEN,RCMNPY) ; PRCA*4.5*389
..; If there is a change in term length, update the plan and the schedule.
..I RCNOMN'=RCNWMN D
...D UPDTERMS^RCRPU1(RCRPIEN,RCMNPY_"^"_RCNWMN)
...D ADJSCHED^RCRPENTR(RCRPIEN,RCNOMN,RCNWMN)
...I RCNWMN>36,RCFLG36'=1 S RCREV36=1 ; PRCA*4.5*389
...Q
..D CHKFLGS^RCRPU1(RCRPIEN,RCRMLN,RCFLG36,RCFLG60) ; PRCA*4.5*423
..I +$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I")!($$GET36^RCRPWLUT(RCRPIEN)=0) S RCQUIT=1 ; PRCA*4.5*423
..;
..;Update Audit Log
..D UPDAUDIT^RCRPU2(RCRPIEN,$$DT^XLFDT,"A","")
..;
..;Update the AR Metrics File with activity
..D UPDMET^RCSTATU(1.02,1)
..Q
.Q
I RCREV36 D MSGREV^RCRPWLUT ; send Mailman notification for plans that need 36 months review PRCA*4.5*389
; Update Processing time metrics
S RCSTEND=$H
D UPDMET^RCSTATU(2.02,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
Q
;
UPDCS ;Review all bills for the Debtor to see if any are still in Cross Service Debt Referral
;
N RCIEN,RCD0,RCD1,RCSTAT,RCDBTR,RCOLDCS,RCNEWCS,RCBILL,RCBLSTAT,RCCSDT,RCCSRCDT
;
; Start calculating execution time
S RCSTSTRT=$H
;
;Loop through all active Repayment Plans
S RCIEN=0
F S RCIEN=$O(^RCRP(340.5,RCIEN)) Q:'RCIEN D
. S RCD0=$G(^RCRP(340.5,RCIEN,0)),RCD1=$G(^RCRP(340.5,RCIEN,1))
. S RCSTAT=$P(RCD0,U,7)
. Q:RCSTAT>5
. ; extract the debtor, and the AT CS flag
. S RCDBTR=$P(RCD0,U,2),RCOLDCS=$P(RCD1,U,4)
. ; find all of the bills associated with that debtor
. ; Initialize new AT CS flag to NULL
. S RCNEWCS=0,RCBILL=0
. F S RCBILL=$O(^PRCA(430,"C",RCDBTR,RCBILL)) Q:'RCBILL D Q:RCNEWCS=1
. . ; for each active bill
. . S RCBLSTAT=$$GET1^DIQ(430,RCBILL_",",8,"I")
. . Q:RCBLSTAT'=16
. . ; Check to see if it is at cross servicing
. . S RCCSDT=$$GET1^DIQ(430,RCBILL_",",151,"I")
. . Q:'+RCCSDT ;quit if not at Cross Servicing
. . ;If at cross servicing (field 151 with data and 153 with no data), then set new AT CS flag = 1 and quit loop
. . S RCCSRCDT=$$GET1^DIQ(430,RCBILL_",",153,"I")
. . S:'+RCCSRCDT RCNEWCS=1
. ; If the current AT CS flag matches the new AT CS flag get the next debtor
. I +RCOLDCS'=+RCNEWCS D UPDATCS^RCRPU2(RCIEN,RCNEWCS)
. ;If a bill has been newly referred to CS, send an alert to investigate
. I '+RCOLDCS,+RCNEWCS D CSALERT^RCSTATU(RCBILL,RCIEN)
;
; Update Processing time metrics
S RCSTEND=$H
D UPDMET^RCSTATU(2.01,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
Q
;
UPDPRDL(RCIEN,RCFLG) ; Update the Print Deliquent Flag
;INPUT - RCIEN: IEN of the Repayment Plan
; RCFLG: Value of the flag.
; 1 : To appear on the Print Delinquent Report
; 0 or NULL: Does not appear on the Print Delinquent Report
;
N DA,DR,DIE,X,Y
S DA=RCIEN,DIE="^RCRP(340.5,"
S DR="1.03///"_RCFLG
D ^DIE
Q
;
UPDPRDF(RCIEN,RCFLG) ; Update the Print Default flag
;INPUT - RCIEN: IEN of the Repayment Plan
; RCFLG: Value of the flag.
; 1 : To appear on the Print Default Report
; 0 or NULL: Does not appear on the Print Default Report
;
N DA,DR,DIE,X,Y
S DA=RCIEN,DIE="^RCRP(340.5,"
S DR="1.02///"_RCFLG
D ^DIE
Q
;
FIRSTPAR(RCBILLDA) ; Check to see if the AR Category is a First Party AR Category.
N RCCAT
;
S RCCAT=+$$GET1^DIQ(430,RCBILLDA_",",2,"I")
;Retrieve whether or not the category is eligible for inclusion into a Repayment Plan.
Q $$GET1^DIQ(430.2,RCCAT_",",1.06,"I")
;
BLDSTARY() ;Build a ^TMP array to define the field to store any status movement metrics in file #340.7
;
; Status Set of Code values
; NEW - 1
; CURRENT - 2
; LATE - 3
; DELINQUENT - 4
; DEFAULT - 5
; TERMINATED - 6
; CLOSED - 7
; PAID IN FULL - 8
;
;Clear any potential older arrays
K ^TMP($J,"RPPFLDNO")
;
;Set the array
S ^TMP($J,"RPPFLDNO",1,2)=1.11 ;New to Current
S ^TMP($J,"RPPFLDNO",2,3)=1.12 ;Current to Late
S ^TMP($J,"RPPFLDNO",3,4)=1.13 ;Late to Delinquent
S ^TMP($J,"RPPFLDNO",4,5)=1.14 ;Delinquent to Defaulted
S ^TMP($J,"RPPFLDNO",5,6)=1.15 ;Defaulted to Terminated
S ^TMP($J,"RPPFLDNO",3,2)=1.16 ;Late to Current
S ^TMP($J,"RPPFLDNO",4,3)=1.17 ;Delinquent to Late
S ^TMP($J,"RPPFLDNO",4,2)=1.18 ;Delinquent to Current
S ^TMP($J,"RPPFLDNO",5,4)=1.19 ;Defaulted to Delinquent
S ^TMP($J,"RPPFLDNO",5,3)=1.21 ;Defaulted to Late
S ^TMP($J,"RPPFLDNO",5,2)=1.22 ;Defaulted to Current
S ^TMP($J,"RPPFLDNO",2,8)=1.23 ;Current to Paid in Full
S ^TMP($J,"RPPFLDNO",3,8)=1.24 ;Late to Paid in Full
S ^TMP($J,"RPPFLDNO",4,8)=1.25 ;Delinquent to Paid in Full
S ^TMP($J,"RPPFLDNO",5,8)=1.26 ;Defaulted to Paid in Full
S ^TMP($J,"RPPFLDNO",2,7)=1.29 ;New to Closed
S ^TMP($J,"RPPFLDNO",3,7)=1.31 ;Current to Closed
S ^TMP($J,"RPPFLDNO",4,7)=1.32 ;Late to Closed
S ^TMP($J,"RPPFLDNO",5,7)=1.33 ;Delinquent to Closed
S ^TMP($J,"RPPFLDNO",1,8)=1.34 ;New to Paid in Full
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCRPNP 10079 printed Apr 09, 2024@20:46:17 Page 2
RCRPNP ;EDE/SAB - REPAYMENT PLAN UTILITIES;12/31/2020 8:40 AM
+1 ;;4.5;Accounts Receivable;**378,389,423**;Mar 20, 1995;Build 8
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
MAIN ; Entry Point for the nightly process
+1 ;
+2 DO UPDSTAT
+3 DO ADDBILLS
+4 DO UPDCS
+5 QUIT
+6 ;
UPDSTAT ;Review all active plans to determine their current status.
+1 ;
+2 NEW RCI,RCJ,RCD0,RCCURST,RCNEWST,RCCRDT,RCSTSTRT,RCSTEND
+3 ;Loop through the Repayment Plan file
+4 ;
+5 ; Start calculating execution time
+6 SET RCSTSTRT=$HOROLOG
+7 ;
+8 SET RCI=0
+9 ;Set the current date
SET RCCRDT=$$DT^XLFDT
+10 ;
+11 FOR
SET RCI=$ORDER(^RCRP(340.5,RCI))
if 'RCI
QUIT
Begin DoDot:1
+12 SET RCD0=$GET(^RCRP(340.5,RCI,0))
+13 if 'RCD0
QUIT
+14 ; Extract current status.
+15 SET RCCURST=$PIECE(RCD0,U,7)
+16 ;recalculate the status
+17 SET RCNEWST=$$STATUS^RCRPU1(RCI)
+18 ;
+19 ;If the status is different
+20 IF RCCURST'=RCNEWST
Begin DoDot:2
+21 ; Update the status to the New Status
+22 DO UPDSTAT^RCRPU1(RCI,RCNEWST)
+23 ; If the new status is Defaulted (5), update the PRINT DEFAULTED flag (1.02)
+24 IF RCNEWST=5
DO UPDPRDF(RCI,1)
+25 ; If the new status is Delinquent (4), update the PRINT DEFAULTED flag (1.03)
+26 IF RCNEWST=4
DO UPDPRDL(RCI,1)
+27 ; If the new status is Terminated
+28 IF RCNEWST=6
Begin DoDot:3
+29 ; Loop through each Bill
+30 SET RCJ=0
+31 FOR
SET RCJ=$ORDER(^RCRP(340.5,RCI,6,RCJ))
if 'RCJ
QUIT
Begin DoDot:4
+32 SET RCBILLDA=$GET(^RCRP(340.5,RCI,6,RCJ,0))
+33 if 'RCBILLDA
QUIT
+34 ; remove fields 41 and 45 from the bill
+35 DO RMVPLN^RCRPU1(RCBILLDA)
+36 ; file "RPP Terminated" transaction PRCA*4.5*389
DO TRAN^RCRPU(RCBILLDA,0,69)
End DoDot:4
+37 ;Update Audit Log with System Termination Comment
DO UPDAUDIT^RCRPU2(RCI,RCCRDT,"C","S")
End DoDot:3
End DoDot:2
End DoDot:1
+38 ;
+39 ; Update Processing time metrics
+40 SET RCSTEND=$HOROLOG
+41 DO UPDMET^RCSTATU(2.03,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
+42 QUIT
+43 ;
ADDBILLS ;Review a debtor and all non referred, Active bills to the plan.
+1 ;
+2 NEW RCACTDT,RCBILLDA,RCRPIEN,RCSTAT,RCACTIVE,RCDBTR,RCSTP,RCD0,RCRPSTAT,RCD7,RCAMT,RCMNPY,RCNOMN,RCNWLN,RCRPD0
+3 NEW RCNWMN,RCPLNBL,RCRMLN,RCSTSTRT,RCSTEND,RCREV36
+4 ; PRCA*4.5*423
NEW RCFLG36,RCFLG60,RCQUIT
+5 ;
+6 ; Start calculating execution time
+7 SET RCSTSTRT=$HOROLOG
+8 ;
+9 SET RCACTDT=$$DT^XLFDT
+10 ; PRCA*4.5*389
SET (RCREV36,RCRPIEN)=0
+11 FOR
SET RCRPIEN=$ORDER(^RCRP(340.5,RCRPIEN))
if 'RCRPIEN
QUIT
Begin DoDot:1
+12 ; Check to see if the plan is active. If not, skip it and grab the next
+13 SET RCRPD0=$GET(^RCRP(340.5,RCRPIEN,0))
if RCRPD0=""
QUIT
+14 ; Quit if the Repayment Plan's AUTO ADD field is not set to Yes (it is No or NULL)
if '+$PIECE(RCRPD0,U,12)
QUIT
+15 SET RCRPSTAT=$PIECE(RCRPD0,U,7)
+16 ;Plan is TERMINATED, CLOSED or PAID IN FULL.
if RCRPSTAT>5
QUIT
+17 ; If the plan is under review, don't attempt to add bills
+18 ; PRCA*4.5*423
SET RCFLG60=+$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I")
+19 ; PRCA*4.5*423
SET RCFLG36=$$GET36^RCRPWLUT(RCRPIEN)
+20 ; PRCA*4.5*423
SET RCRMLN=$$REMPMNTS^RCRPU3(RCRPIEN,$$GET1^DIQ(340.5,RCRPIEN_",",.06,"I"))
+21 ; PRCA*4.5*423
DO CHKFLGS^RCRPU1(RCRPIEN,RCRMLN,RCFLG36,RCFLG60)
+22 ; don't add bills if plan length > 57 months PRCA*4.5*423
IF RCFLG60
QUIT
+23 ; don't add bills if plan length > 36 months and there's no approval PRCA*4.5*423
IF RCRMLN>36
IF RCFLG36'=1
QUIT
+24 ; Find the Debtor.
+25 SET RCDBTR=$$GET1^DIQ(340.5,RCRPIEN_",",.02,"I")
+26 ; Loop through the Active Bills for the Debtor
+27 ; Get the Active Status IEN
SET RCACTIVE=$ORDER(^PRCA(430.3,"B","ACTIVE",""))
+28 ; PRCA*4.5*423
SET (RCQUIT,RCBILLDA)=0
+29 ; Loop through all bills or until plan is flagged for review.
+30 FOR
SET RCBILLDA=$ORDER(^PRCA(430,"AS",RCDBTR,RCACTIVE,RCBILLDA))
if 'RCBILLDA
QUIT
if RCQUIT
QUIT
Begin DoDot:2
+31 ; Only look at First Party Bills
+32 if '$$FIRSTPAR(+RCBILLDA)
QUIT
+33 ; Skip if bill already in plan.
+34 if +$$GET1^DIQ(430,RCBILLDA_",",45,"I")
QUIT
+35 ; Exclude bills referred to CS, TOP, or DMC
+36 ; get CS Date referral date
SET RCCSDT=+$$GET1^DIQ(430,RCBILLDA_",",151,"I")
+37 ; get CS Recall date
SET RCCSRCDT=+$$GET1^DIQ(430,RCBILLDA_",",153,"I")
+38 ;If still at Cross Servicing, the don't add bill to plan.
IF RCCSDT
IF 'RCCSRCDT
QUIT
+39 ; Bill at DMC, quit, don't add bill to plan
if +$$GET1^DIQ(430,RCBILLDA_",",121,"I")
QUIT
+40 ; Bill still at TOP, quit, don't add bill to plan
IF +$$GET1^DIQ(430,RCBILLDA_",",141,"I")
IF +$$GET1^DIQ(430,RCDBTR_",",6.02,"I")
QUIT
+41 ; Add the Bill to the plan.
+42 DO UPDBILL^RCRPU(RCRPIEN,RCBILLDA)
+43 ; Add Plan to the Bill
+44 DO ADDPLAN^RCRPU(RCRPIEN,RCBILLDA,RCACTDT)
+45 ; Update the Total balance Owed.
+46 SET RCD7=$GET(^PRCA(430,RCBILLDA,7))
+47 SET RCD0=$GET(^PRCA(430,RCBILLDA,0))
+48 SET RCAMT=$SELECT(+RCD7:$PIECE(RCD7,U,1)+$PIECE(RCD7,U,2)+$PIECE(RCD7,U,3)+$PIECE(RCD7,U,4)+$PIECE(RCD7,U,5),1:$PIECE(RCD0,U,3))
+49 ;get the current Plan amount Owed value.
SET RCPLNBL=$$GET1^DIQ(340.5,RCRPIEN_",",.11,"I")
+50 DO UPDPAO^RCRPU1(RCRPIEN,RCAMT+RCPLNBL)
+51 ;Calculate the new remaining balance
+52 ;get the new Plan amount Owed value.
SET RCPLNBL=$$GET1^DIQ(340.5,RCRPIEN_",",.11,"I")
+53 ; Recalculate the total # payments.
+54 SET RCMNPY=$$GET1^DIQ(340.5,RCRPIEN_",",.06,"I")
+55 SET RCNOMN=$$GET1^DIQ(340.5,RCRPIEN_",",.05,"I")
+56 SET RCNWMN=RCPLNBL\RCMNPY
SET RCNWMOD=RCPLNBL#RCMNPY
+57 IF RCNWMOD>0
SET RCNWMN=RCNWMN+1
+58 ; Calculate the # payments remaining
+59 ; PRCA*4.5*389
SET RCRMLN=$$REMPMNTS^RCRPU3(RCRPIEN,RCMNPY)
+60 ; If there is a change in term length, update the plan and the schedule.
+61 IF RCNOMN'=RCNWMN
Begin DoDot:3
+62 DO UPDTERMS^RCRPU1(RCRPIEN,RCMNPY_"^"_RCNWMN)
+63 DO ADJSCHED^RCRPENTR(RCRPIEN,RCNOMN,RCNWMN)
+64 ; PRCA*4.5*389
IF RCNWMN>36
IF RCFLG36'=1
SET RCREV36=1
+65 QUIT
End DoDot:3
+66 ; PRCA*4.5*423
DO CHKFLGS^RCRPU1(RCRPIEN,RCRMLN,RCFLG36,RCFLG60)
+67 ; PRCA*4.5*423
IF +$$GET1^DIQ(340.5,RCRPIEN_",",1.01,"I")!($$GET36^RCRPWLUT(RCRPIEN)=0)
SET RCQUIT=1
+68 ;
+69 ;Update Audit Log
+70 DO UPDAUDIT^RCRPU2(RCRPIEN,$$DT^XLFDT,"A","")
+71 ;
+72 ;Update the AR Metrics File with activity
+73 DO UPDMET^RCSTATU(1.02,1)
+74 QUIT
End DoDot:2
+75 QUIT
End DoDot:1
+76 ; send Mailman notification for plans that need 36 months review PRCA*4.5*389
IF RCREV36
DO MSGREV^RCRPWLUT
+77 ; Update Processing time metrics
+78 SET RCSTEND=$HOROLOG
+79 DO UPDMET^RCSTATU(2.02,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
+80 QUIT
+81 ;
UPDCS ;Review all bills for the Debtor to see if any are still in Cross Service Debt Referral
+1 ;
+2 NEW RCIEN,RCD0,RCD1,RCSTAT,RCDBTR,RCOLDCS,RCNEWCS,RCBILL,RCBLSTAT,RCCSDT,RCCSRCDT
+3 ;
+4 ; Start calculating execution time
+5 SET RCSTSTRT=$HOROLOG
+6 ;
+7 ;Loop through all active Repayment Plans
+8 SET RCIEN=0
+9 FOR
SET RCIEN=$ORDER(^RCRP(340.5,RCIEN))
if 'RCIEN
QUIT
Begin DoDot:1
+10 SET RCD0=$GET(^RCRP(340.5,RCIEN,0))
SET RCD1=$GET(^RCRP(340.5,RCIEN,1))
+11 SET RCSTAT=$PIECE(RCD0,U,7)
+12 if RCSTAT>5
QUIT
+13 ; extract the debtor, and the AT CS flag
+14 SET RCDBTR=$PIECE(RCD0,U,2)
SET RCOLDCS=$PIECE(RCD1,U,4)
+15 ; find all of the bills associated with that debtor
+16 ; Initialize new AT CS flag to NULL
+17 SET RCNEWCS=0
SET RCBILL=0
+18 FOR
SET RCBILL=$ORDER(^PRCA(430,"C",RCDBTR,RCBILL))
if 'RCBILL
QUIT
Begin DoDot:2
+19 ; for each active bill
+20 SET RCBLSTAT=$$GET1^DIQ(430,RCBILL_",",8,"I")
+21 if RCBLSTAT'=16
QUIT
+22 ; Check to see if it is at cross servicing
+23 SET RCCSDT=$$GET1^DIQ(430,RCBILL_",",151,"I")
+24 ;quit if not at Cross Servicing
if '+RCCSDT
QUIT
+25 ;If at cross servicing (field 151 with data and 153 with no data), then set new AT CS flag = 1 and quit loop
+26 SET RCCSRCDT=$$GET1^DIQ(430,RCBILL_",",153,"I")
+27 if '+RCCSRCDT
SET RCNEWCS=1
End DoDot:2
if RCNEWCS=1
QUIT
+28 ; If the current AT CS flag matches the new AT CS flag get the next debtor
+29 IF +RCOLDCS'=+RCNEWCS
DO UPDATCS^RCRPU2(RCIEN,RCNEWCS)
+30 ;If a bill has been newly referred to CS, send an alert to investigate
+31 IF '+RCOLDCS
IF +RCNEWCS
DO CSALERT^RCSTATU(RCBILL,RCIEN)
End DoDot:1
+32 ;
+33 ; Update Processing time metrics
+34 SET RCSTEND=$HOROLOG
+35 DO UPDMET^RCSTATU(2.01,$$HDIFF^XLFDT(RCSTEND,RCSTSTRT,2))
+36 QUIT
+37 ;
UPDPRDL(RCIEN,RCFLG) ; Update the Print Deliquent Flag
+1 ;INPUT - RCIEN: IEN of the Repayment Plan
+2 ; RCFLG: Value of the flag.
+3 ; 1 : To appear on the Print Delinquent Report
+4 ; 0 or NULL: Does not appear on the Print Delinquent Report
+5 ;
+6 NEW DA,DR,DIE,X,Y
+7 SET DA=RCIEN
SET DIE="^RCRP(340.5,"
+8 SET DR="1.03///"_RCFLG
+9 DO ^DIE
+10 QUIT
+11 ;
UPDPRDF(RCIEN,RCFLG) ; Update the Print Default flag
+1 ;INPUT - RCIEN: IEN of the Repayment Plan
+2 ; RCFLG: Value of the flag.
+3 ; 1 : To appear on the Print Default Report
+4 ; 0 or NULL: Does not appear on the Print Default Report
+5 ;
+6 NEW DA,DR,DIE,X,Y
+7 SET DA=RCIEN
SET DIE="^RCRP(340.5,"
+8 SET DR="1.02///"_RCFLG
+9 DO ^DIE
+10 QUIT
+11 ;
FIRSTPAR(RCBILLDA) ; Check to see if the AR Category is a First Party AR Category.
+1 NEW RCCAT
+2 ;
+3 SET RCCAT=+$$GET1^DIQ(430,RCBILLDA_",",2,"I")
+4 ;Retrieve whether or not the category is eligible for inclusion into a Repayment Plan.
+5 QUIT $$GET1^DIQ(430.2,RCCAT_",",1.06,"I")
+6 ;
BLDSTARY() ;Build a ^TMP array to define the field to store any status movement metrics in file #340.7
+1 ;
+2 ; Status Set of Code values
+3 ; NEW - 1
+4 ; CURRENT - 2
+5 ; LATE - 3
+6 ; DELINQUENT - 4
+7 ; DEFAULT - 5
+8 ; TERMINATED - 6
+9 ; CLOSED - 7
+10 ; PAID IN FULL - 8
+11 ;
+12 ;Clear any potential older arrays
+13 KILL ^TMP($JOB,"RPPFLDNO")
+14 ;
+15 ;Set the array
+16 ;New to Current
SET ^TMP($JOB,"RPPFLDNO",1,2)=1.11
+17 ;Current to Late
SET ^TMP($JOB,"RPPFLDNO",2,3)=1.12
+18 ;Late to Delinquent
SET ^TMP($JOB,"RPPFLDNO",3,4)=1.13
+19 ;Delinquent to Defaulted
SET ^TMP($JOB,"RPPFLDNO",4,5)=1.14
+20 ;Defaulted to Terminated
SET ^TMP($JOB,"RPPFLDNO",5,6)=1.15
+21 ;Late to Current
SET ^TMP($JOB,"RPPFLDNO",3,2)=1.16
+22 ;Delinquent to Late
SET ^TMP($JOB,"RPPFLDNO",4,3)=1.17
+23 ;Delinquent to Current
SET ^TMP($JOB,"RPPFLDNO",4,2)=1.18
+24 ;Defaulted to Delinquent
SET ^TMP($JOB,"RPPFLDNO",5,4)=1.19
+25 ;Defaulted to Late
SET ^TMP($JOB,"RPPFLDNO",5,3)=1.21
+26 ;Defaulted to Current
SET ^TMP($JOB,"RPPFLDNO",5,2)=1.22
+27 ;Current to Paid in Full
SET ^TMP($JOB,"RPPFLDNO",2,8)=1.23
+28 ;Late to Paid in Full
SET ^TMP($JOB,"RPPFLDNO",3,8)=1.24
+29 ;Delinquent to Paid in Full
SET ^TMP($JOB,"RPPFLDNO",4,8)=1.25
+30 ;Defaulted to Paid in Full
SET ^TMP($JOB,"RPPFLDNO",5,8)=1.26
+31 ;New to Closed
SET ^TMP($JOB,"RPPFLDNO",2,7)=1.29
+32 ;Current to Closed
SET ^TMP($JOB,"RPPFLDNO",3,7)=1.31
+33 ;Late to Closed
SET ^TMP($JOB,"RPPFLDNO",4,7)=1.32
+34 ;Delinquent to Closed
SET ^TMP($JOB,"RPPFLDNO",5,7)=1.33
+35 ;New to Paid in Full
SET ^TMP($JOB,"RPPFLDNO",1,8)=1.34
+36 QUIT
