- 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 Feb 18, 2025@23:14:59 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