RCDPEAR ;ALB/TMK - ELECTRONIC ERA AGING REPORTS FROM NIGHTLY JOB ;04-NOV-02
;;4.5;Accounts Receivable;**173,276**;Mar 20, 1995;Build 87
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
AGERPT ; Entry from nightly job to run the AR EDI Lockbox Aging reports
; Bulletin is not wanted if aging parameter does not have a value
;
; ERA Aging Report
I $P($G(^RC(342,1,7)),U,3)'="" D ; Check for ERA Aging Parameter
. K ^TMP($J,"RCERAAGE")
. D RPTOUT^RCDPEAR1("RCERAAGE") ; prca 276
. D BULL("EDI LBOX ERA UNMATCHED AGING REPORT FOR "_$$FMTE^XLFDT(DT,2),"RCERAAGE")
. K ^TMP($J,"RCERAAGE")
;
; EFT Aging Report
I $P($G(^RC(342,1,7)),U,2)'="" D ; Check for EFT Aging Parameter
. K ^TMP($J,"RCEFTAGE")
. D RPTOUT^RCDPEAR2("RCEFTAGE") ;prca276
. D BULL("EDI LBOX EFT UNMATCHED AGING REPORT FOR "_$$FMTE^XLFDT(DT,2),"RCEFTAGE")
. K ^TMP($J,"RCEFTAGE")
;
Q
;
BULL(RCSUBJ,RCSUB) ; Send bulletin for aging reports
N XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR
S XMTO("I:G.RCDPE PAYMENTS")=""
S XMBODY="^TMP("_$J_","""_RCSUB_""")"
D
. N DUZ S DUZ=.5,DUZ(0)="@"
. D SENDMSG^XMXAPI(.5,RCSUBJ,XMBODY,.XMTO,,.XMZ)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAR 1197 printed Sep 23, 2025@19:20:24 Page 2
RCDPEAR ;ALB/TMK - ELECTRONIC ERA AGING REPORTS FROM NIGHTLY JOB ;04-NOV-02
+1 ;;4.5;Accounts Receivable;**173,276**;Mar 20, 1995;Build 87
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
AGERPT ; Entry from nightly job to run the AR EDI Lockbox Aging reports
+1 ; Bulletin is not wanted if aging parameter does not have a value
+2 ;
+3 ; ERA Aging Report
+4 ; Check for ERA Aging Parameter
IF $PIECE($GET(^RC(342,1,7)),U,3)'=""
Begin DoDot:1
+5 KILL ^TMP($JOB,"RCERAAGE")
+6 ; prca 276
DO RPTOUT^RCDPEAR1("RCERAAGE")
+7 DO BULL("EDI LBOX ERA UNMATCHED AGING REPORT FOR "_$$FMTE^XLFDT(DT,2),"RCERAAGE")
+8 KILL ^TMP($JOB,"RCERAAGE")
End DoDot:1
+9 ;
+10 ; EFT Aging Report
+11 ; Check for EFT Aging Parameter
IF $PIECE($GET(^RC(342,1,7)),U,2)'=""
Begin DoDot:1
+12 KILL ^TMP($JOB,"RCEFTAGE")
+13 ;prca276
DO RPTOUT^RCDPEAR2("RCEFTAGE")
+14 DO BULL("EDI LBOX EFT UNMATCHED AGING REPORT FOR "_$$FMTE^XLFDT(DT,2),"RCEFTAGE")
+15 KILL ^TMP($JOB,"RCEFTAGE")
End DoDot:1
+16 ;
+17 QUIT
+18 ;
BULL(RCSUBJ,RCSUB) ; Send bulletin for aging reports
+1 NEW XMBODY,XMB,XMINSTR,XMTYPE,XMFULL,XMTO,RCXM,XMZ,XMERR
+2 SET XMTO("I:G.RCDPE PAYMENTS")=""
+3 SET XMBODY="^TMP("_$JOB_","""_RCSUB_""")"
+4 Begin DoDot:1
+5 NEW DUZ
SET DUZ=.5
SET DUZ(0)="@"
+6 DO SENDMSG^XMXAPI(.5,RCSUBJ,XMBODY,.XMTO,,.XMZ)
End DoDot:1
+7 QUIT
+8 ;
