RCDPEM7 ;OIFO-BAYPINES/PJH - OVERDUE EFT AND ERA BULLETINS ; 6/7/19 7:24am
;;4.5;Accounts Receivable;**276,298,303,304,321,326,345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;
EN ; Main entry point for overdue EFT/ERA bulletins
;
N TODAY,ERACNT,ERATOT,ERA1CNT,ERA2CNT,ERA1TOT,ERA2TOT,EFTCNT,EFTTOT,RCPROG,RCSUSCNT,RCSUSAMT,RCMXDYS
;Clear workfiles
S RCPROG="RCDPEM7" K ^TMP(RCPROG,$J)
;Set counters and totals
S (EFTCNT,ERACNT,ERA1CNT,ERA2CNT,EFTTOT,ERATOT,ERA1TOT,ERA2TOT,RCSUSCNT,RCSUSAMT)=0
;Cuttoff of 12:00 am today
S TODAY=$P($$NOW^XLFDT,".")
I $E(TODAY,6,7)="01" D ; PRCA*4.5*349 Things to run on the first of the month
. D BULL^RCDPEFA4("M") ; PRCA*4.5*349 Monthy 1st Party Decrease Stats
;
;Verify this is correct day for bulletins - PRCA*4.5*321
N X
S X=TODAY
D DW^%DTC
I $$GET1^DIQ(344.61,"1,",.1)'=X Q
;
;Retrieve the max days allowed in suspense parameter
S RCMXDYS=$$GET1^DIQ(342,"1,",7.04)
;
;Scan for overdue ERA and unposted ERA
D ERASCAN
;Scan for overdue EFT
D EFTSCAN
;Scan for overdue Suspended ERA's - PRCA*4.5*304
D SUSPSCAN
;Bulletins
D BULLETIN
;
D BULL^RCDPEFA4("W") ; PRCA*4.5*349 Weekly 1st party auto-decrease stats
;Clear workfiles
K ^TMP(RCPROG,$J)
Q
;
ERASCAN ;Scan ERA
N AMT,ERAIEN,FDATE,PNAME,REC0,SUB,STATUS,TRACE ; PRCA*4.5*326
;Scan for unmatched ERA
S ERAIEN=0,STATUS=0,SUB="ERA"
F S ERAIEN=$O(^RCY(344.4,"AMATCH",STATUS,ERAIEN)) Q:'ERAIEN D
.S REC0=$G(^RCY(344.4,ERAIEN,0))
.;Get ERA file date/time
.S FDATE=$P(REC0,U,7) Q:'FDATE
.;Ignore if <31 days overdue
.Q:$$FMDIFF^XLFDT(TODAY,FDATE,1)<31
.;Trace, Payer Name and Amount
.S PNAME=$P(REC0,U,6),AMT=$P(REC0,U,5),TRACE=$P(REC0,U,2) ; PRCA*4.5*326
.I $L(PNAME)>35 S PNAME=$E(PNAME,1,35) ; limit size of the name
.;Update count and totals
.S ERACNT=ERACNT+1,ERATOT=ERATOT+AMT
. ; PRCA*4.5*303 added the FDATE subscript to the global so that the line
. ; items collate in date ascending order.
. ;Save ERA#, Payer Name, File Date, Trace# and Amount Paid
.S ^TMP(RCPROG,$J,"ERA",FDATE,ERACNT)=$$ERAL(ERAIEN,PNAME,FDATE,AMT)
.S ^TMP(RCPROG,$J,"ERA",FDATE,ERACNT,"TR")=" "_TRACE ; PRCA*4.5*326
;
;Scan for Matched/Unposted ERA
S SUB="ERA1"
F STATUS=-1,1,2,3 D
. S ERAIEN=0 F S ERAIEN=$O(^RCY(344.4,"AMATCH",STATUS,ERAIEN)) Q:'ERAIEN D
.. S REC0=$G(^RCY(344.4,ERAIEN,0))
.. ;Get ERA file date/time
.. S FDATE=$P(REC0,U,7) Q:'FDATE
.. ;Ignore if <31 days overdue
.. Q:$$FMDIFF^XLFDT(TODAY,FDATE,1)<31
.. ;Ignore if not unposted posted
.. Q:$P($G(^RCY(344.4,ERAIEN,0)),U,14)>0
.. ;Payer Name, Trace and Amount
.. S PNAME=$P(REC0,U,6),AMT=$P(REC0,U,5),TRACE=$P(REC0,U,2) ; PRCA*4.5*326
.. I $L(PNAME)>35 S PNAME=$E(PNAME,1,35) ; limit size of the name
.. ; PRCA*4.5*303 Split into "ACH" and not "ACH"
.. ;Update count and totals
.. S:$P(REC0,U,15)="ACH" ERA1CNT=ERA1CNT+1,ERA1TOT=ERA1TOT+AMT
.. S:$P(REC0,U,15)'="ACH" ERA2CNT=ERA2CNT+1,ERA2TOT=ERA2TOT+AMT
.. ;PRCA*4.5*303 added the FDATE subscript to the global so that the line
.. ;items collate in date ascending order.
.. ; BEGIN PRCA*4.5*326
.. ;Save ERA#, Payer Name, File Date, Trace# and Amount Paid
.. I $P(REC0,U,15)="ACH" D
... S ^TMP(RCPROG,$J,"ERA1",FDATE,ERA1CNT)=$$ERAL(ERAIEN,PNAME,FDATE,AMT)
... S ^TMP(RCPROG,$J,"ERA1",FDATE,ERA1CNT,"TR")=" "_TRACE
..I $P(REC0,U,15)'="ACH" D
... S ^TMP(RCPROG,$J,"ERA2",FDATE,ERA2CNT)=$$ERAL(ERAIEN,PNAME,FDATE,AMT)
... S ^TMP(RCPROG,$J,"ERA2",FDATE,ERA2CNT,"TR")=" "_TRACE
.. ; END PRCA*4.5*326
.. Q
. Q
Q
;
EFTSCAN ;Scan EFT
N DEPN,EFTIEN,IEN3443,EFTDATE,TRACE,REC0,REC31,REC4,STATUS,PAYER,DEPAMT
;Scan for unmatched EFT
S EFTIEN=0,STATUS=0
; PRCA*4.5*303 Check all statuses report on unmatched EFTs, Matched EFTs with unposted ERAs
; 4-7-2016 Removed F STATUS=-1,0,1 per issue identifying duplicate EFTs this will need to be
; addressed in another project
S STATUS=0 F S EFTIEN=$O(^RCY(344.31,"AMATCH",STATUS,EFTIEN)) Q:'EFTIEN D
.S REC31=$G(^RCY(344.31,EFTIEN,0))
.;PRCA*4.5*303 Get zero node of the associated ERA if matched
.S REC4=$S($P(REC31,U,10)'="":$G(^RCY(344.4,$P(REC31,U,10),0)),1:"")
.;Get pointer to EFT file
.S IEN3443=$P(REC31,U) Q:'IEN3443
.S REC0=$G(^RCY(344.3,IEN3443,0))
.;Get EFT file date
.S EFTDATE=$P(REC0,U,2) Q:'EFTDATE
.;Ignore if <15 days overdue
.Q:$$FMDIFF^XLFDT(TODAY,EFTDATE,1)<15
.;PRCA*4.5*303 - if we have a ERA check to see if we include this record or quit
.I REC4'="" Q:$P(REC4,U,14)'=0 ; Not posted status is 0 - everything else is ignored
.;Deposit number and payment amount
.S DEPN=$P(REC0,U,6),DEPAMT=$P(REC31,U,7)
.;Payer ID and Trace from EFT detail file
.S PAYER=$P(REC31,U,2),TRACE=$P(REC31,U,4) S:PAYER="" PAYER="NO PAYER NAME RECEIVED" ; PRCA*4.5*298
.;If payer and trace combined are >40 truncate payer name first
.I $L(PAYER_TRACE)>40 D
..I $L(PAYER)>20 S PAYER=$E(PAYER,1,20) ; limit size of the name
..Q:$L(PAYER_TRACE)<41
..S TRACE=$E(TRACE,1,20) ; limit size of the trace
.;Update count and totals
.S EFTCNT=EFTCNT+1,EFTTOT=EFTTOT+DEPAMT
.; PRCA*4.5*303 added EFTDATE to the subscripts before EFTCNT so report will sort in
.; date ascending order.
.;Save Deposit No, Receipt, Payer ID, EFT Date and Deposit Amount
.S ^TMP(RCPROG,$J,"EFT",EFTDATE,EFTCNT)=$$EFTL(DEPN,TRACE,PAYER,EFTDATE,DEPAMT)
Q
;
; PRCA*4.5*304
; Scan for ERA's older than allowed by parameter
SUSPSCAN ;
N RCCT,RCDATA,RCSDATE,RCDATA0,RCDATA2,RCDATA3,RCMAXDAY,RCRECTDA,RCTRANDA
N RCDEP,RCTRACE,RCPAYER,RCEFTDT,RCDEPAMT,RCDAYS,RCUSER,RCREC,RCDISP,RCRSN,RCSREC
;
;initialize counters
S (RCSUSAMT,RCSUSCNT)=0
;
;calculate the last date to stop gathering entries on
S RCMAXDAY=TODAY-RCMXDYS
;
;Loop through the In Suspense index
S (RCRECTDA,RCCT)=0
F S RCRECTDA=$O(^RCY(344,"AN",RCRECTDA)) Q:'RCRECTDA D
. S RCDATA=$G(^RCY(344,RCRECTDA,0))
. S RCREC=$P(RCDATA,U)
. S RCTRANDA=0 F S RCTRANDA=$O(^RCY(344,"AN",RCRECTDA,RCTRANDA)) Q:'RCTRANDA D
. . S RCDATA0=$G(^RCY(344,RCRECTDA,1,RCTRANDA,0))
. . S RCDATA2=$G(^RCY(344,RCRECTDA,1,RCTRANDA,2))
. . S RCDATA3=$G(^RCY(344,RCRECTDA,1,RCTRANDA,3))
. . ;get date into suspense
. . S RCSDATE=$P(RCDATA3,U,2)
. . S RCDAYS=$$FMTH^XLFDT(TODAY,1)-$$FMTH^XLFDT(RCSDATE,1)
. . Q:RCSDATE=""
. . ;
. . ;if younger than the cutoff date, quit
. . Q:RCDAYS'>RCMXDYS
. . ;
. . ; get the user and disposition
. . S RCUSER=$$GET1^DIQ(200,$P(RCDATA3,U,3)_",",1,"E")
. . S RCDISP=$$UP^XLFSTR($$GET1^DIQ(344.01,RCTRANDA_","_RCRECTDA_",",3.01))
. . ;
. . ;Suspense status has been cleared quit
. . Q:$P(RCDATA2,U,6)'=""
. . ;
. . ;Extract needed info for report
. . S RCEFTDT=$P(RCDATA0,U,6),RCDEPAMT=$P(RCDATA0,U,4)
. . ;
. . ;update counter and amount info
. . S RCSUSCNT=RCSUSCNT+1
. . S RCSUSAMT=RCSUSAMT+RCDEPAMT
. . S RCRSN=$E($P($G(^RCY(344,RCRECTDA,1,RCTRANDA,1)),U,2),1,12)
. . S RCSREC=RCREC_"@"_RCTRANDA
. . ;
. . ;update temporary array
. . S ^TMP(RCPROG,$J,"SUSPENSE",RCSDATE,RCSUSCNT)=$$ESUSPL(RCSDATE,RCDAYS,RCUSER,RCSREC,RCDEPAMT,RCDISP,RCRSN)
;
Q
;
BULLETIN ;Create bulletins only if overdue EFT/ERA found
;
N ARRAY,SBJ,SUB,CNT,CNT1,RCPROG1,GLB,RCMXDYS,IDX
S RCPROG1="RCDPEM7A",GLB=$NA(^TMP(RCPROG1,$J,"XMTEXT"))
;
;Unmatched ERA bulletins
I ERACNT D
.;Build header
.S SUB="ERA" K @GLB
.S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-ACTION REQ-Unmatched ERAs > 30 days"
.S @GLB@(1)="The listed ERAs were received more than 30 days ago and have not yet been"
.S @GLB@(2)="matched."
.S @GLB@(3)=" "
.S @GLB@(4)="Total # of ERAs - "_ERACNT
.S @GLB@(5)="Total Dollar Amount - "_"$"_$FN(ERATOT,",",2)
.S @GLB@(6)=" "
.S @GLB@(7)="ERA# PAYER NAME FILE DATE AMOUNT PAID"
.S @GLB@(8)=" TRACE#" ; PRCA*4.5*326
.;
.;Move unmatched ERA search findings into message
.S CNT=0,CNT1=9,SUB="ERA" ; PRCA*4.5*326
.S IDX="" F S IDX=$O(^TMP(RCPROG,$J,SUB,IDX)) Q:'IDX F S CNT=$O(^TMP(RCPROG,$J,SUB,IDX,CNT)) Q:'CNT D
..S CNT1=CNT1+1,@GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT)
..S CNT1=CNT1+1,@GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT,"TR") ; PRCA*4.5*326
.S @GLB@(CNT1+1)="** END OF REPORT **"
.D SEND
.K @GLB
;
;Unposted "ACH" ERA bulletins
; PRCA*4.5*303 - modified this bulletin to show only "ACH" expected payments
I ERA1CNT D
.;Build header
.S SUB="ERA1" K @GLB
.; PRCA*4.5*303 - Changed SBJ to make sure it was less than 65 characters
.S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-ACTION REQ-EFT:Matched/Not Posted ERA>30 days"
.S @GLB@(1)="The listed ERAs were received more than 30 days ago and have been matched but"
.S @GLB@(2)="have not been posted"
.S @GLB@(3)=" "
.S @GLB@(4)="Total # of ERAs - ""MATCHED TO EFT"" - "_ERA1CNT
.S @GLB@(5)="Total Dollar Amount - "_"$"_$FN(ERA1TOT,",",2)
.S @GLB@(6)=" "
.S @GLB@(7)="ERA# PAYER NAME FILE DATE AMOUNT PAID"
.S @GLB@(8)=" TRACE#" ; PRCA*4.5*326
.;
.;Move unposted ERA search findings into message
.S CNT=0,CNT1=9,IDX="" ; PRCA*4.5*326
.F S IDX=$O(^TMP(RCPROG,$J,SUB,IDX)) Q:'IDX F S CNT=$O(^TMP(RCPROG,$J,SUB,IDX,CNT)) Q:'CNT D
..S CNT1=CNT1+1
..S @GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT)
..S CNT1=CNT1+1 ; PRCA*4.5*326
..S @GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT,"TR") ; PRCA*4.5*326
.S @GLB@(CNT1+1)="** END OF REPORT **"
.D SEND
.K @GLB
;
;Unposted "CHK" ERA bulletins or ERAs, that don't match "ACH"
; PRCA*4.5*303 - modified this bulletin to show "CHK" expected payments (or don't match "ACH")
I ERA2CNT D
.;Build header
.S SUB="ERA2" K @GLB
.; PRCA*4.5*303 - Changed SBJ to make sure it was less than 65 characters
.S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-ACTION REQ-PAPER:Matched/Not Posted ERA>30 days"
.S @GLB@(1)="The listed ERAs were received more than 30 days ago and have been matched but"
.S @GLB@(2)="have not been posted"
.S @GLB@(3)=" "
.S @GLB@(4)="Total # of ERAs - ""MATCHED TO PAPER CHECK"" - "_ERA2CNT
.S @GLB@(5)="Total Dollar Amount - "_"$"_$FN(ERA2TOT,",",2)
.S @GLB@(6)=" "
.S @GLB@(7)="ERA# PAYER NAME FILE DATE AMOUNT PAID"
.S @GLB@(8)=" TRACE#" ; PRCA*4.5*326
.;
.;Move unposted ERA search findings into message
.S CNT=0,CNT1=9,IDX="" ; PRCA*4.5*326
.F S IDX=$O(^TMP(RCPROG,$J,SUB,IDX)) Q:'IDX F S CNT=$O(^TMP(RCPROG,$J,SUB,IDX,CNT)) Q:'CNT D
..S CNT1=CNT1+1,@GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT)
..S CNT1=CNT1+1,@GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT,"TR") ; PRCA*4.5*326
.S @GLB@(CNT1+1)="** END OF REPORT **"
.D SEND
.K @GLB
;
;Unmatched EFT bulletins
; PRCA*4.5*303 - Changed logic to send "No EFTs more than 14 days..." message if no EFTs
;I EFTCNT D
;Build header
S SUB="EFT" K @GLB
S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-ACTION REQ-EFTs > 14 days"
I EFTCNT=0 D G B1
. S @GLB@(1)="**** There are NO EFTs more than 14 days old that have not yet been matched."
. S @GLB@(2)=" "
. S @GLB@(3)="Total # of EFTs - "_EFTCNT
. S @GLB@(4)="Total Dollar Amount - $"_$FN(0,",",2)
. S @GLB@(5)=" "
. S @GLB@(6)="** END OF REPORT **"
;
I EFTCNT>0 D
.S @GLB@(1)="The following EFTs were received more than 14 days ago and have not yet"
.S @GLB@(2)="been matched."
.S @GLB@(3)=" "
.S @GLB@(4)="Total # of EFTs - "_EFTCNT
.S @GLB@(5)="Total Dollar Amount - "_"$"_$FN(EFTTOT,",",2)
.S @GLB@(6)=" "
.S @GLB@(7)="DEPOSIT# PAYER NAME/TRACE# EFT DATE DEPOSIT AMT"
.;
.;Move EFT search findings into message
.S CNT=0,CNT1=8,SUB="EFT",IDX=""
.F S IDX=$O(^TMP(RCPROG,$J,SUB,IDX)) Q:'IDX F S CNT=$O(^TMP(RCPROG,$J,SUB,IDX,CNT)) Q:'CNT D
..S CNT1=CNT1+1,@GLB@(CNT1)=^TMP(RCPROG,$J,SUB,IDX,CNT)
.S @GLB@(CNT1+1)="** END OF REPORT **"
B1 ;
D SEND
K @GLB
;
;PRCA*4.5*304 - Add suspense bulletin
; Suspense bulletins
;
; Send bulletin if items in suspense
I RCSUSCNT D
. ;
. N DT
. ;Retrieve the parameter
. S RCMXDYS=$$GET1^DIQ(342,"1,",7.04)
. ;
. ;Build header
. S SUB="SUSPENSE" K @GLB
. S SBJ="EDI LBOX-STA# "_$P($$SITE^VASITE,"^",3)_"-SUSPENSE ENTRIES OVERDUE FOR PROCESSING"
. S @GLB@(1)="The following entries have been in Suspense past the #days allowed by site"
. S @GLB@(2)="parameter - which is currently set at "_RCMXDYS_" days."
. S @GLB@(3)=" "
. S @GLB@(4)="Total # of Overdue Entries in Suspense - "_RCSUSCNT
. S @GLB@(5)="Total Dollar Amount Overdue in Suspense - "_"$"_$FN(RCSUSAMT,",",2)
. S @GLB@(6)=" "
. S @GLB@(7)="SUSP DATE #DAYS USER RECEIPT# AMOUNT DISP REASON"
. ;
. ;Move Suspense search findings into message
. S CNT=0,CNT1=8,SUB="SUSPENSE",DT=0
. F S DT=$O(^TMP(RCPROG,$J,SUB,DT)) Q:'DT D
. . F S CNT=$O(^TMP(RCPROG,$J,SUB,DT,CNT)) Q:'CNT D
. . . S CNT1=CNT1+1,@GLB@(CNT1)=^TMP(RCPROG,$J,SUB,DT,CNT)
. S @GLB@(CNT1+1)="** END OF REPORT **"
. D SEND
. K @GLB
Q
;
SEND ;Transmit mail message
N XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
S XMDUZ=DUZ,XMTEXT=GLB,XMSUB=SBJ,XMY("I:G.RCDPE AUDIT")=""
S XMINSTR("FROM")="POSTMASTER"
S XMINSTR("FLAGS")="P"
D SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
Q
;
ERAL(X1,X2,X3,X4) ;Format ERA Message line
N SPACE
S SPACE=$J("",80)
S X1=X1_$E(SPACE,1,12-$L(X1))
S X2=X1_$E(X2,1,43)_$E(SPACE,1,43-$L(X2))
S X3=$$FMTE^XLFDT(X3,"2D")
S X4="$"_$FN(X4,",",2)
Q X2_$J(X3,8)_$J(X4,15)
;
EFTL(X1,X2,X3,X4,X5) ;Format EFT Message line
N SPACE
S SPACE=$J("",80)
S X1=X1_$E(SPACE,1,10-$L(X1))_" "
S X2=X3_"/"_X2 ;Payer and Trace
S X2=X1_$E(X2,1,41)_$E(SPACE,1,42-$L(X2))
S X4=$$FMTE^XLFDT(X4,"2D")
S X5="$"_$FN(X5,",",2)
Q X2_$J(X4,8)_$J(X5,15)
;
;PRCA*4.5*304
ESUSPL(X1,X2,X3,X4,X5,X6,X7) ;Format Suspense Message line
N SPACE
S SPACE=$J("",80)
;spacing for Suspense Date
S X1=$$FMTE^XLFDT(X1,"2D")
S X1=X1_$E(SPACE,1,10-$L(X1))
;spacing for # days in suspense
S X2=$E(SPACE,1,6-$L(X2))_X2
;spacing for USER
S X3=" "_X3_$E(SPACE,1,5-$L(X3))
;spacing for RECEIPT NUMBER_TRANS #
S X4=$E(X4_SPACE,1,16)
;spacing for amount in suspense
S X5=$J("$"_$FN(X5,",",2),13)_" "
;spacing for STATUS
S X6=X6_$E(SPACE,1,12-$L(X6))
;spacing for REASON
S X7=X7_$E(SPACE,1,12-$L(X7))
;return concatenated string
Q X1_X2_X3_X4_X5_X6_X7
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM7 14477 printed Oct 16, 2024@17:45:42 Page 2
RCDPEM7 ;OIFO-BAYPINES/PJH - OVERDUE EFT AND ERA BULLETINS ; 6/7/19 7:24am
+1 ;;4.5;Accounts Receivable;**276,298,303,304,321,326,345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; Main entry point for overdue EFT/ERA bulletins
+1 ;
+2 NEW TODAY,ERACNT,ERATOT,ERA1CNT,ERA2CNT,ERA1TOT,ERA2TOT,EFTCNT,EFTTOT,RCPROG,RCSUSCNT,RCSUSAMT,RCMXDYS
+3 ;Clear workfiles
+4 SET RCPROG="RCDPEM7"
KILL ^TMP(RCPROG,$JOB)
+5 ;Set counters and totals
+6 SET (EFTCNT,ERACNT,ERA1CNT,ERA2CNT,EFTTOT,ERATOT,ERA1TOT,ERA2TOT,RCSUSCNT,RCSUSAMT)=0
+7 ;Cuttoff of 12:00 am today
+8 SET TODAY=$PIECE($$NOW^XLFDT,".")
+9 ; PRCA*4.5*349 Things to run on the first of the month
IF $EXTRACT(TODAY,6,7)="01"
Begin DoDot:1
+10 ; PRCA*4.5*349 Monthy 1st Party Decrease Stats
DO BULL^RCDPEFA4("M")
End DoDot:1
+11 ;
+12 ;Verify this is correct day for bulletins - PRCA*4.5*321
+13 NEW X
+14 SET X=TODAY
+15 DO DW^%DTC
+16 IF $$GET1^DIQ(344.61,"1,",.1)'=X
QUIT
+17 ;
+18 ;Retrieve the max days allowed in suspense parameter
+19 SET RCMXDYS=$$GET1^DIQ(342,"1,",7.04)
+20 ;
+21 ;Scan for overdue ERA and unposted ERA
+22 DO ERASCAN
+23 ;Scan for overdue EFT
+24 DO EFTSCAN
+25 ;Scan for overdue Suspended ERA's - PRCA*4.5*304
+26 DO SUSPSCAN
+27 ;Bulletins
+28 DO BULLETIN
+29 ;
+30 ; PRCA*4.5*349 Weekly 1st party auto-decrease stats
DO BULL^RCDPEFA4("W")
+31 ;Clear workfiles
+32 KILL ^TMP(RCPROG,$JOB)
+33 QUIT
+34 ;
ERASCAN ;Scan ERA
+1 ; PRCA*4.5*326
NEW AMT,ERAIEN,FDATE,PNAME,REC0,SUB,STATUS,TRACE
+2 ;Scan for unmatched ERA
+3 SET ERAIEN=0
SET STATUS=0
SET SUB="ERA"
+4 FOR
SET ERAIEN=$ORDER(^RCY(344.4,"AMATCH",STATUS,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:1
+5 SET REC0=$GET(^RCY(344.4,ERAIEN,0))
+6 ;Get ERA file date/time
+7 SET FDATE=$PIECE(REC0,U,7)
if 'FDATE
QUIT
+8 ;Ignore if <31 days overdue
+9 if $$FMDIFF^XLFDT(TODAY,FDATE,1)<31
QUIT
+10 ;Trace, Payer Name and Amount
+11 ; PRCA*4.5*326
SET PNAME=$PIECE(REC0,U,6)
SET AMT=$PIECE(REC0,U,5)
SET TRACE=$PIECE(REC0,U,2)
+12 ; limit size of the name
IF $LENGTH(PNAME)>35
SET PNAME=$EXTRACT(PNAME,1,35)
+13 ;Update count and totals
+14 SET ERACNT=ERACNT+1
SET ERATOT=ERATOT+AMT
+15 ; PRCA*4.5*303 added the FDATE subscript to the global so that the line
+16 ; items collate in date ascending order.
+17 ;Save ERA#, Payer Name, File Date, Trace# and Amount Paid
+18 SET ^TMP(RCPROG,$JOB,"ERA",FDATE,ERACNT)=$$ERAL(ERAIEN,PNAME,FDATE,AMT)
+19 ; PRCA*4.5*326
SET ^TMP(RCPROG,$JOB,"ERA",FDATE,ERACNT,"TR")=" "_TRACE
End DoDot:1
+20 ;
+21 ;Scan for Matched/Unposted ERA
+22 SET SUB="ERA1"
+23 FOR STATUS=-1,1,2,3
Begin DoDot:1
+24 SET ERAIEN=0
FOR
SET ERAIEN=$ORDER(^RCY(344.4,"AMATCH",STATUS,ERAIEN))
if 'ERAIEN
QUIT
Begin DoDot:2
+25 SET REC0=$GET(^RCY(344.4,ERAIEN,0))
+26 ;Get ERA file date/time
+27 SET FDATE=$PIECE(REC0,U,7)
if 'FDATE
QUIT
+28 ;Ignore if <31 days overdue
+29 if $$FMDIFF^XLFDT(TODAY,FDATE,1)<31
QUIT
+30 ;Ignore if not unposted posted
+31 if $PIECE($GET(^RCY(344.4,ERAIEN,0)),U,14)>0
QUIT
+32 ;Payer Name, Trace and Amount
+33 ; PRCA*4.5*326
SET PNAME=$PIECE(REC0,U,6)
SET AMT=$PIECE(REC0,U,5)
SET TRACE=$PIECE(REC0,U,2)
+34 ; limit size of the name
IF $LENGTH(PNAME)>35
SET PNAME=$EXTRACT(PNAME,1,35)
+35 ; PRCA*4.5*303 Split into "ACH" and not "ACH"
+36 ;Update count and totals
+37 if $PIECE(REC0,U,15)="ACH"
SET ERA1CNT=ERA1CNT+1
SET ERA1TOT=ERA1TOT+AMT
+38 if $PIECE(REC0,U,15)'="ACH"
SET ERA2CNT=ERA2CNT+1
SET ERA2TOT=ERA2TOT+AMT
+39 ;PRCA*4.5*303 added the FDATE subscript to the global so that the line
+40 ;items collate in date ascending order.
+41 ; BEGIN PRCA*4.5*326
+42 ;Save ERA#, Payer Name, File Date, Trace# and Amount Paid
+43 IF $PIECE(REC0,U,15)="ACH"
Begin DoDot:3
+44 SET ^TMP(RCPROG,$JOB,"ERA1",FDATE,ERA1CNT)=$$ERAL(ERAIEN,PNAME,FDATE,AMT)
+45 SET ^TMP(RCPROG,$JOB,"ERA1",FDATE,ERA1CNT,"TR")=" "_TRACE
End DoDot:3
+46 IF $PIECE(REC0,U,15)'="ACH"
Begin DoDot:3
+47 SET ^TMP(RCPROG,$JOB,"ERA2",FDATE,ERA2CNT)=$$ERAL(ERAIEN,PNAME,FDATE,AMT)
+48 SET ^TMP(RCPROG,$JOB,"ERA2",FDATE,ERA2CNT,"TR")=" "_TRACE
End DoDot:3
+49 ; END PRCA*4.5*326
+50 QUIT
End DoDot:2
+51 QUIT
End DoDot:1
+52 QUIT
+53 ;
EFTSCAN ;Scan EFT
+1 NEW DEPN,EFTIEN,IEN3443,EFTDATE,TRACE,REC0,REC31,REC4,STATUS,PAYER,DEPAMT
+2 ;Scan for unmatched EFT
+3 SET EFTIEN=0
SET STATUS=0
+4 ; PRCA*4.5*303 Check all statuses report on unmatched EFTs, Matched EFTs with unposted ERAs
+5 ; 4-7-2016 Removed F STATUS=-1,0,1 per issue identifying duplicate EFTs this will need to be
+6 ; addressed in another project
+7 SET STATUS=0
FOR
SET EFTIEN=$ORDER(^RCY(344.31,"AMATCH",STATUS,EFTIEN))
if 'EFTIEN
QUIT
Begin DoDot:1
+8 SET REC31=$GET(^RCY(344.31,EFTIEN,0))
+9 ;PRCA*4.5*303 Get zero node of the associated ERA if matched
+10 SET REC4=$SELECT($PIECE(REC31,U,10)'="":$GET(^RCY(344.4,$PIECE(REC31,U,10),0)),1:"")
+11 ;Get pointer to EFT file
+12 SET IEN3443=$PIECE(REC31,U)
if 'IEN3443
QUIT
+13 SET REC0=$GET(^RCY(344.3,IEN3443,0))
+14 ;Get EFT file date
+15 SET EFTDATE=$PIECE(REC0,U,2)
if 'EFTDATE
QUIT
+16 ;Ignore if <15 days overdue
+17 if $$FMDIFF^XLFDT(TODAY,EFTDATE,1)<15
QUIT
+18 ;PRCA*4.5*303 - if we have a ERA check to see if we include this record or quit
+19 ; Not posted status is 0 - everything else is ignored
IF REC4'=""
if $PIECE(REC4,U,14)'=0
QUIT
+20 ;Deposit number and payment amount
+21 SET DEPN=$PIECE(REC0,U,6)
SET DEPAMT=$PIECE(REC31,U,7)
+22 ;Payer ID and Trace from EFT detail file
+23 ; PRCA*4.5*298
SET PAYER=$PIECE(REC31,U,2)
SET TRACE=$PIECE(REC31,U,4)
if PAYER=""
SET PAYER="NO PAYER NAME RECEIVED"
+24 ;If payer and trace combined are >40 truncate payer name first
+25 IF $LENGTH(PAYER_TRACE)>40
Begin DoDot:2
+26 ; limit size of the name
IF $LENGTH(PAYER)>20
SET PAYER=$EXTRACT(PAYER,1,20)
+27 if $LENGTH(PAYER_TRACE)<41
QUIT
+28 ; limit size of the trace
SET TRACE=$EXTRACT(TRACE,1,20)
End DoDot:2
+29 ;Update count and totals
+30 SET EFTCNT=EFTCNT+1
SET EFTTOT=EFTTOT+DEPAMT
+31 ; PRCA*4.5*303 added EFTDATE to the subscripts before EFTCNT so report will sort in
+32 ; date ascending order.
+33 ;Save Deposit No, Receipt, Payer ID, EFT Date and Deposit Amount
+34 SET ^TMP(RCPROG,$JOB,"EFT",EFTDATE,EFTCNT)=$$EFTL(DEPN,TRACE,PAYER,EFTDATE,DEPAMT)
End DoDot:1
+35 QUIT
+36 ;
+37 ; PRCA*4.5*304
+38 ; Scan for ERA's older than allowed by parameter
SUSPSCAN ;
+1 NEW RCCT,RCDATA,RCSDATE,RCDATA0,RCDATA2,RCDATA3,RCMAXDAY,RCRECTDA,RCTRANDA
+2 NEW RCDEP,RCTRACE,RCPAYER,RCEFTDT,RCDEPAMT,RCDAYS,RCUSER,RCREC,RCDISP,RCRSN,RCSREC
+3 ;
+4 ;initialize counters
+5 SET (RCSUSAMT,RCSUSCNT)=0
+6 ;
+7 ;calculate the last date to stop gathering entries on
+8 SET RCMAXDAY=TODAY-RCMXDYS
+9 ;
+10 ;Loop through the In Suspense index
+11 SET (RCRECTDA,RCCT)=0
+12 FOR
SET RCRECTDA=$ORDER(^RCY(344,"AN",RCRECTDA))
if 'RCRECTDA
QUIT
Begin DoDot:1
+13 SET RCDATA=$GET(^RCY(344,RCRECTDA,0))
+14 SET RCREC=$PIECE(RCDATA,U)
+15 SET RCTRANDA=0
FOR
SET RCTRANDA=$ORDER(^RCY(344,"AN",RCRECTDA,RCTRANDA))
if 'RCTRANDA
QUIT
Begin DoDot:2
+16 SET RCDATA0=$GET(^RCY(344,RCRECTDA,1,RCTRANDA,0))
+17 SET RCDATA2=$GET(^RCY(344,RCRECTDA,1,RCTRANDA,2))
+18 SET RCDATA3=$GET(^RCY(344,RCRECTDA,1,RCTRANDA,3))
+19 ;get date into suspense
+20 SET RCSDATE=$PIECE(RCDATA3,U,2)
+21 SET RCDAYS=$$FMTH^XLFDT(TODAY,1)-$$FMTH^XLFDT(RCSDATE,1)
+22 if RCSDATE=""
QUIT
+23 ;
+24 ;if younger than the cutoff date, quit
+25 if RCDAYS'>RCMXDYS
QUIT
+26 ;
+27 ; get the user and disposition
+28 SET RCUSER=$$GET1^DIQ(200,$PIECE(RCDATA3,U,3)_",",1,"E")
+29 SET RCDISP=$$UP^XLFSTR($$GET1^DIQ(344.01,RCTRANDA_","_RCRECTDA_",",3.01))
+30 ;
+31 ;Suspense status has been cleared quit
+32 if $PIECE(RCDATA2,U,6)'=""
QUIT
+33 ;
+34 ;Extract needed info for report
+35 SET RCEFTDT=$PIECE(RCDATA0,U,6)
SET RCDEPAMT=$PIECE(RCDATA0,U,4)
+36 ;
+37 ;update counter and amount info
+38 SET RCSUSCNT=RCSUSCNT+1
+39 SET RCSUSAMT=RCSUSAMT+RCDEPAMT
+40 SET RCRSN=$EXTRACT($PIECE($GET(^RCY(344,RCRECTDA,1,RCTRANDA,1)),U,2),1,12)
+41 SET RCSREC=RCREC_"@"_RCTRANDA
+42 ;
+43 ;update temporary array
+44 SET ^TMP(RCPROG,$JOB,"SUSPENSE",RCSDATE,RCSUSCNT)=$$ESUSPL(RCSDATE,RCDAYS,RCUSER,RCSREC,RCDEPAMT,RCDISP,RCRSN)
End DoDot:2
End DoDot:1
+45 ;
+46 QUIT
+47 ;
BULLETIN ;Create bulletins only if overdue EFT/ERA found
+1 ;
+2 NEW ARRAY,SBJ,SUB,CNT,CNT1,RCPROG1,GLB,RCMXDYS,IDX
+3 SET RCPROG1="RCDPEM7A"
SET GLB=$NAME(^TMP(RCPROG1,$JOB,"XMTEXT"))
+4 ;
+5 ;Unmatched ERA bulletins
+6 IF ERACNT
Begin DoDot:1
+7 ;Build header
+8 SET SUB="ERA"
KILL @GLB
+9 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-ACTION REQ-Unmatched ERAs > 30 days"
+10 SET @GLB@(1)="The listed ERAs were received more than 30 days ago and have not yet been"
+11 SET @GLB@(2)="matched."
+12 SET @GLB@(3)=" "
+13 SET @GLB@(4)="Total # of ERAs - "_ERACNT
+14 SET @GLB@(5)="Total Dollar Amount - "_"$"_$FNUMBER(ERATOT,",",2)
+15 SET @GLB@(6)=" "
+16 SET @GLB@(7)="ERA# PAYER NAME FILE DATE AMOUNT PAID"
+17 ; PRCA*4.5*326
SET @GLB@(8)=" TRACE#"
+18 ;
+19 ;Move unmatched ERA search findings into message
+20 ; PRCA*4.5*326
SET CNT=0
SET CNT1=9
SET SUB="ERA"
+21 SET IDX=""
FOR
SET IDX=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX))
if 'IDX
QUIT
FOR
SET CNT=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX,CNT))
if 'CNT
QUIT
Begin DoDot:2
+22 SET CNT1=CNT1+1
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT)
+23 ; PRCA*4.5*326
SET CNT1=CNT1+1
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT,"TR")
End DoDot:2
+24 SET @GLB@(CNT1+1)="** END OF REPORT **"
+25 DO SEND
+26 KILL @GLB
End DoDot:1
+27 ;
+28 ;Unposted "ACH" ERA bulletins
+29 ; PRCA*4.5*303 - modified this bulletin to show only "ACH" expected payments
+30 IF ERA1CNT
Begin DoDot:1
+31 ;Build header
+32 SET SUB="ERA1"
KILL @GLB
+33 ; PRCA*4.5*303 - Changed SBJ to make sure it was less than 65 characters
+34 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-ACTION REQ-EFT:Matched/Not Posted ERA>30 days"
+35 SET @GLB@(1)="The listed ERAs were received more than 30 days ago and have been matched but"
+36 SET @GLB@(2)="have not been posted"
+37 SET @GLB@(3)=" "
+38 SET @GLB@(4)="Total # of ERAs - ""MATCHED TO EFT"" - "_ERA1CNT
+39 SET @GLB@(5)="Total Dollar Amount - "_"$"_$FNUMBER(ERA1TOT,",",2)
+40 SET @GLB@(6)=" "
+41 SET @GLB@(7)="ERA# PAYER NAME FILE DATE AMOUNT PAID"
+42 ; PRCA*4.5*326
SET @GLB@(8)=" TRACE#"
+43 ;
+44 ;Move unposted ERA search findings into message
+45 ; PRCA*4.5*326
SET CNT=0
SET CNT1=9
SET IDX=""
+46 FOR
SET IDX=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX))
if 'IDX
QUIT
FOR
SET CNT=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX,CNT))
if 'CNT
QUIT
Begin DoDot:2
+47 SET CNT1=CNT1+1
+48 SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT)
+49 ; PRCA*4.5*326
SET CNT1=CNT1+1
+50 ; PRCA*4.5*326
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT,"TR")
End DoDot:2
+51 SET @GLB@(CNT1+1)="** END OF REPORT **"
+52 DO SEND
+53 KILL @GLB
End DoDot:1
+54 ;
+55 ;Unposted "CHK" ERA bulletins or ERAs, that don't match "ACH"
+56 ; PRCA*4.5*303 - modified this bulletin to show "CHK" expected payments (or don't match "ACH")
+57 IF ERA2CNT
Begin DoDot:1
+58 ;Build header
+59 SET SUB="ERA2"
KILL @GLB
+60 ; PRCA*4.5*303 - Changed SBJ to make sure it was less than 65 characters
+61 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-ACTION REQ-PAPER:Matched/Not Posted ERA>30 days"
+62 SET @GLB@(1)="The listed ERAs were received more than 30 days ago and have been matched but"
+63 SET @GLB@(2)="have not been posted"
+64 SET @GLB@(3)=" "
+65 SET @GLB@(4)="Total # of ERAs - ""MATCHED TO PAPER CHECK"" - "_ERA2CNT
+66 SET @GLB@(5)="Total Dollar Amount - "_"$"_$FNUMBER(ERA2TOT,",",2)
+67 SET @GLB@(6)=" "
+68 SET @GLB@(7)="ERA# PAYER NAME FILE DATE AMOUNT PAID"
+69 ; PRCA*4.5*326
SET @GLB@(8)=" TRACE#"
+70 ;
+71 ;Move unposted ERA search findings into message
+72 ; PRCA*4.5*326
SET CNT=0
SET CNT1=9
SET IDX=""
+73 FOR
SET IDX=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX))
if 'IDX
QUIT
FOR
SET CNT=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX,CNT))
if 'CNT
QUIT
Begin DoDot:2
+74 SET CNT1=CNT1+1
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT)
+75 ; PRCA*4.5*326
SET CNT1=CNT1+1
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT,"TR")
End DoDot:2
+76 SET @GLB@(CNT1+1)="** END OF REPORT **"
+77 DO SEND
+78 KILL @GLB
End DoDot:1
+79 ;
+80 ;Unmatched EFT bulletins
+81 ; PRCA*4.5*303 - Changed logic to send "No EFTs more than 14 days..." message if no EFTs
+82 ;I EFTCNT D
+83 ;Build header
+84 SET SUB="EFT"
KILL @GLB
+85 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-ACTION REQ-EFTs > 14 days"
+86 IF EFTCNT=0
Begin DoDot:1
+87 SET @GLB@(1)="**** There are NO EFTs more than 14 days old that have not yet been matched."
+88 SET @GLB@(2)=" "
+89 SET @GLB@(3)="Total # of EFTs - "_EFTCNT
+90 SET @GLB@(4)="Total Dollar Amount - $"_$FNUMBER(0,",",2)
+91 SET @GLB@(5)=" "
+92 SET @GLB@(6)="** END OF REPORT **"
End DoDot:1
GOTO B1
+93 ;
+94 IF EFTCNT>0
Begin DoDot:1
+95 SET @GLB@(1)="The following EFTs were received more than 14 days ago and have not yet"
+96 SET @GLB@(2)="been matched."
+97 SET @GLB@(3)=" "
+98 SET @GLB@(4)="Total # of EFTs - "_EFTCNT
+99 SET @GLB@(5)="Total Dollar Amount - "_"$"_$FNUMBER(EFTTOT,",",2)
+100 SET @GLB@(6)=" "
+101 SET @GLB@(7)="DEPOSIT# PAYER NAME/TRACE# EFT DATE DEPOSIT AMT"
+102 ;
+103 ;Move EFT search findings into message
+104 SET CNT=0
SET CNT1=8
SET SUB="EFT"
SET IDX=""
+105 FOR
SET IDX=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX))
if 'IDX
QUIT
FOR
SET CNT=$ORDER(^TMP(RCPROG,$JOB,SUB,IDX,CNT))
if 'CNT
QUIT
Begin DoDot:2
+106 SET CNT1=CNT1+1
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,IDX,CNT)
End DoDot:2
+107 SET @GLB@(CNT1+1)="** END OF REPORT **"
End DoDot:1
B1 ;
+1 DO SEND
+2 KILL @GLB
+3 ;
+4 ;PRCA*4.5*304 - Add suspense bulletin
+5 ; Suspense bulletins
+6 ;
+7 ; Send bulletin if items in suspense
+8 IF RCSUSCNT
Begin DoDot:1
+9 ;
+10 NEW DT
+11 ;Retrieve the parameter
+12 SET RCMXDYS=$$GET1^DIQ(342,"1,",7.04)
+13 ;
+14 ;Build header
+15 SET SUB="SUSPENSE"
KILL @GLB
+16 SET SBJ="EDI LBOX-STA# "_$PIECE($$SITE^VASITE,"^",3)_"-SUSPENSE ENTRIES OVERDUE FOR PROCESSING"
+17 SET @GLB@(1)="The following entries have been in Suspense past the #days allowed by site"
+18 SET @GLB@(2)="parameter - which is currently set at "_RCMXDYS_" days."
+19 SET @GLB@(3)=" "
+20 SET @GLB@(4)="Total # of Overdue Entries in Suspense - "_RCSUSCNT
+21 SET @GLB@(5)="Total Dollar Amount Overdue in Suspense - "_"$"_$FNUMBER(RCSUSAMT,",",2)
+22 SET @GLB@(6)=" "
+23 SET @GLB@(7)="SUSP DATE #DAYS USER RECEIPT# AMOUNT DISP REASON"
+24 ;
+25 ;Move Suspense search findings into message
+26 SET CNT=0
SET CNT1=8
SET SUB="SUSPENSE"
SET DT=0
+27 FOR
SET DT=$ORDER(^TMP(RCPROG,$JOB,SUB,DT))
if 'DT
QUIT
Begin DoDot:2
+28 FOR
SET CNT=$ORDER(^TMP(RCPROG,$JOB,SUB,DT,CNT))
if 'CNT
QUIT
Begin DoDot:3
+29 SET CNT1=CNT1+1
SET @GLB@(CNT1)=^TMP(RCPROG,$JOB,SUB,DT,CNT)
End DoDot:3
End DoDot:2
+30 SET @GLB@(CNT1+1)="** END OF REPORT **"
+31 DO SEND
+32 KILL @GLB
End DoDot:1
+33 QUIT
+34 ;
SEND ;Transmit mail message
+1 NEW XMDUZ,XMTEXT,XMSUB,XMY,XMINSTR
+2 SET XMDUZ=DUZ
SET XMTEXT=GLB
SET XMSUB=SBJ
SET XMY("I:G.RCDPE AUDIT")=""
+3 SET XMINSTR("FROM")="POSTMASTER"
+4 SET XMINSTR("FLAGS")="P"
+5 DO SENDMSG^XMXAPI(XMDUZ,XMSUB,XMTEXT,.XMY,.XMINSTR)
+6 QUIT
+7 ;
ERAL(X1,X2,X3,X4) ;Format ERA Message line
+1 NEW SPACE
+2 SET SPACE=$JUSTIFY("",80)
+3 SET X1=X1_$EXTRACT(SPACE,1,12-$LENGTH(X1))
+4 SET X2=X1_$EXTRACT(X2,1,43)_$EXTRACT(SPACE,1,43-$LENGTH(X2))
+5 SET X3=$$FMTE^XLFDT(X3,"2D")
+6 SET X4="$"_$FNUMBER(X4,",",2)
+7 QUIT X2_$JUSTIFY(X3,8)_$JUSTIFY(X4,15)
+8 ;
EFTL(X1,X2,X3,X4,X5) ;Format EFT Message line
+1 NEW SPACE
+2 SET SPACE=$JUSTIFY("",80)
+3 SET X1=X1_$EXTRACT(SPACE,1,10-$LENGTH(X1))_" "
+4 ;Payer and Trace
SET X2=X3_"/"_X2
+5 SET X2=X1_$EXTRACT(X2,1,41)_$EXTRACT(SPACE,1,42-$LENGTH(X2))
+6 SET X4=$$FMTE^XLFDT(X4,"2D")
+7 SET X5="$"_$FNUMBER(X5,",",2)
+8 QUIT X2_$JUSTIFY(X4,8)_$JUSTIFY(X5,15)
+9 ;
+10 ;PRCA*4.5*304
ESUSPL(X1,X2,X3,X4,X5,X6,X7) ;Format Suspense Message line
+1 NEW SPACE
+2 SET SPACE=$JUSTIFY("",80)
+3 ;spacing for Suspense Date
+4 SET X1=$$FMTE^XLFDT(X1,"2D")
+5 SET X1=X1_$EXTRACT(SPACE,1,10-$LENGTH(X1))
+6 ;spacing for # days in suspense
+7 SET X2=$EXTRACT(SPACE,1,6-$LENGTH(X2))_X2
+8 ;spacing for USER
+9 SET X3=" "_X3_$EXTRACT(SPACE,1,5-$LENGTH(X3))
+10 ;spacing for RECEIPT NUMBER_TRANS #
+11 SET X4=$EXTRACT(X4_SPACE,1,16)
+12 ;spacing for amount in suspense
+13 SET X5=$JUSTIFY("$"_$FNUMBER(X5,",",2),13)_" "
+14 ;spacing for STATUS
+15 SET X6=X6_$EXTRACT(SPACE,1,12-$LENGTH(X6))
+16 ;spacing for REASON
+17 SET X7=X7_$EXTRACT(SPACE,1,12-$LENGTH(X7))
+18 ;return concatenated string
+19 QUIT X1_X2_X3_X4_X5_X6_X7
+20 ;
