RCSTATU ;EDE/YMG - AR PERFORMACE METRICS UTILITIES;02/03/2021 8:40 AM
;;4.5;Accounts Receivable;**378**;Mar 20, 1995;Build 54
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
UPDMET(RCFIELD,RCVALUE) ; Update the AR Metrics file.
;INPUT: RCFIELD = The field # in the AR Metrics File to Update
; RCVALUE = Amount to add to the data already in the field
;
N RCSTIEN,RCDATE,RCCURAMT,RCNEWAMT,Y,DLAYGO,DIC,DIK,DR,DA,X
;
;Lock the AR Metrics file until daily entry is confirmed to exist or is created.
L +^RCSTAT(340.7):5
S RCDATE=$$DT^XLFDT
S RCSTIEN=$O(^RCSTAT(340.7,"B",RCDATE,""))
S DLAYGO=340.7,DIC="^RCSTAT(340.7,",DIC(0)="L",X=RCDATE
;
;Create new entry if necessary
I 'RCSTIEN D
. D FILE^DICN
. S RCSTIEN=+Y
. K DIC,DINUM,DLAYGO
. ;Ensure it is indexed
. S DA=RCSTIEN,DIK="^RCSTAT(340.7,"
. D IX^DIK
. K DR
;Unlock the file
L -^RCSTAT(340.7):5
;
; File the update along with inactivate the ACTION TYPE
S RCCURAMT=$$GET1^DIQ(340.7,RCSTIEN_",",RCFIELD,"I")
S RCNEWAMT=RCCURAMT+RCVALUE
S DR=RCFIELD_"///"_RCNEWAMT ;Update the amount
;
S DIE="^RCSTAT(340.7,",DA=RCSTIEN
D ^DIE
;
Q
;
CSALERT(RCBILLDA,RCIEN) ;Send a bulletin to alert staff if a Debtor has a bill sent to Cross Servicing if they also have an active Repayment Plan.
;
;INPUT: RCBILLDA - AR Bill IEN for file 430
; RCIEN - Repayment Plan IEN for fiel 340.5
;
N %,RCBILL,XMY,RCRPID
K ^TMP($J,"RCRPPALERT") ; used to store message to send
;
S LINE=0
S RCBILL=$$GET1^DIQ(430,RCBILLDA_",",.01,"E")
S RCRPID=$$GET1^DIQ(340.5,RCIEN_",",.01,"E")
D SET("Bill "_RCBILL_" was referred to the Treasury Cross Servicing (CS) Referral")
D SET("Program when it should have been added to the Debtor's Active Repayment Plan,")
D SET(RCRPID_".")
D SET("")
D SET("Please investigate and recall from CS if necessary.")
;
S XMY("G.RC REPAY PLAN EXTERNAL")=""
S %=$$SENDMSG("ALERT: Bill sent to Cross Servicing for Debtor with Repayment Plan",.XMY)
K ^TMP($J,"RCRPPALERT") ; used to store message to send
Q
;
;
SET(DATA) ; store report
S LINE=LINE+1,^TMP($J,"RCRPPALERT",LINE)=DATA
Q
;
;
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
N %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
S XMDUZ="AR PACKAGE",XMTEXT="^TMP($J,""RCRPPALERT"","
D ^XMD
Q +$G(XMZ)
;
CLEANUP ; Remove entries from the AR Metrics File that are older than the METRICS RETENTION DAYS paramenter (#.16, file 342) allows.
;
N RCSITE,RCNUMDAY,DIK,DA,RCI,RCDT,RCMAXDT,RCNUMDY
;
;Get the oldest date to keep.
S RCNUMDY=$$GET1^DIQ(342,"1,",.16,"I") ;METRICS RETENTION DAYS PARAMETER
S RCMAXDT=$$FMADD^XLFDT($$DT^XLFDT,-RCNUMDY)
;Loop through all of the entry older than RCMAXDT and delete
S RCI=0
F S RCI=$O(^RCSTAT(340.7,RCI)) Q:'RCI D
. S RCDT=$G(^RCSTAT(340.7,RCI,0))
. Q:RCDT'<RCMAXDT
. S DIK="^RCSTAT(340.7,",DA=RCI
. D ^DIK
. K DIK,DA
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCSTATU 3027 printed Oct 16, 2024@17:49:25 Page 2
RCSTATU ;EDE/YMG - AR PERFORMACE METRICS UTILITIES;02/03/2021 8:40 AM
+1 ;;4.5;Accounts Receivable;**378**;Mar 20, 1995;Build 54
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
UPDMET(RCFIELD,RCVALUE) ; Update the AR Metrics file.
+1 ;INPUT: RCFIELD = The field # in the AR Metrics File to Update
+2 ; RCVALUE = Amount to add to the data already in the field
+3 ;
+4 NEW RCSTIEN,RCDATE,RCCURAMT,RCNEWAMT,Y,DLAYGO,DIC,DIK,DR,DA,X
+5 ;
+6 ;Lock the AR Metrics file until daily entry is confirmed to exist or is created.
+7 LOCK +^RCSTAT(340.7):5
+8 SET RCDATE=$$DT^XLFDT
+9 SET RCSTIEN=$ORDER(^RCSTAT(340.7,"B",RCDATE,""))
+10 SET DLAYGO=340.7
SET DIC="^RCSTAT(340.7,"
SET DIC(0)="L"
SET X=RCDATE
+11 ;
+12 ;Create new entry if necessary
+13 IF 'RCSTIEN
Begin DoDot:1
+14 DO FILE^DICN
+15 SET RCSTIEN=+Y
+16 KILL DIC,DINUM,DLAYGO
+17 ;Ensure it is indexed
+18 SET DA=RCSTIEN
SET DIK="^RCSTAT(340.7,"
+19 DO IX^DIK
+20 KILL DR
End DoDot:1
+21 ;Unlock the file
+22 LOCK -^RCSTAT(340.7):5
+23 ;
+24 ; File the update along with inactivate the ACTION TYPE
+25 SET RCCURAMT=$$GET1^DIQ(340.7,RCSTIEN_",",RCFIELD,"I")
+26 SET RCNEWAMT=RCCURAMT+RCVALUE
+27 ;Update the amount
SET DR=RCFIELD_"///"_RCNEWAMT
+28 ;
+29 SET DIE="^RCSTAT(340.7,"
SET DA=RCSTIEN
+30 DO ^DIE
+31 ;
+32 QUIT
+33 ;
CSALERT(RCBILLDA,RCIEN) ;Send a bulletin to alert staff if a Debtor has a bill sent to Cross Servicing if they also have an active Repayment Plan.
+1 ;
+2 ;INPUT: RCBILLDA - AR Bill IEN for file 430
+3 ; RCIEN - Repayment Plan IEN for fiel 340.5
+4 ;
+5 NEW %,RCBILL,XMY,RCRPID
+6 ; used to store message to send
KILL ^TMP($JOB,"RCRPPALERT")
+7 ;
+8 SET LINE=0
+9 SET RCBILL=$$GET1^DIQ(430,RCBILLDA_",",.01,"E")
+10 SET RCRPID=$$GET1^DIQ(340.5,RCIEN_",",.01,"E")
+11 DO SET("Bill "_RCBILL_" was referred to the Treasury Cross Servicing (CS) Referral")
+12 DO SET("Program when it should have been added to the Debtor's Active Repayment Plan,")
+13 DO SET(RCRPID_".")
+14 DO SET("")
+15 DO SET("Please investigate and recall from CS if necessary.")
+16 ;
+17 SET XMY("G.RC REPAY PLAN EXTERNAL")=""
+18 SET %=$$SENDMSG("ALERT: Bill sent to Cross Servicing for Debtor with Repayment Plan",.XMY)
+19 ; used to store message to send
KILL ^TMP($JOB,"RCRPPALERT")
+20 QUIT
+21 ;
+22 ;
SET(DATA) ; store report
+1 SET LINE=LINE+1
SET ^TMP($JOB,"RCRPPALERT",LINE)=DATA
+2 QUIT
+3 ;
+4 ;
SENDMSG(XMSUB,XMY) ; send message with subject and recipients
+1 NEW %X,D0,D1,D2,DIC,DICR,DIW,X,XCNP,XMDISPI,XMDUN,XMDUZ,XMTEXT,XMZ,ZTPAR
+2 SET XMDUZ="AR PACKAGE"
SET XMTEXT="^TMP($J,""RCRPPALERT"","
+3 DO ^XMD
+4 QUIT +$GET(XMZ)
+5 ;
CLEANUP ; Remove entries from the AR Metrics File that are older than the METRICS RETENTION DAYS paramenter (#.16, file 342) allows.
+1 ;
+2 NEW RCSITE,RCNUMDAY,DIK,DA,RCI,RCDT,RCMAXDT,RCNUMDY
+3 ;
+4 ;Get the oldest date to keep.
+5 ;METRICS RETENTION DAYS PARAMETER
SET RCNUMDY=$$GET1^DIQ(342,"1,",.16,"I")
+6 SET RCMAXDT=$$FMADD^XLFDT($$DT^XLFDT,-RCNUMDY)
+7 ;Loop through all of the entry older than RCMAXDT and delete
+8 SET RCI=0
+9 FOR
SET RCI=$ORDER(^RCSTAT(340.7,RCI))
if 'RCI
QUIT
Begin DoDot:1
+10 SET RCDT=$GET(^RCSTAT(340.7,RCI,0))
+11 if RCDT'<RCMAXDT
QUIT
+12 SET DIK="^RCSTAT(340.7,"
SET DA=RCI
+13 DO ^DIK
+14 KILL DIK,DA
End DoDot:1
+15 ;
+16 QUIT
