RCDPEAR.m

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 ---RCDPEAR   1197     printed  Apr 09, 2024@20:44:44                                                                                                                                                                                                     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       ;