RCDPEWLE ;AITC/CJE - ELECTRONIC EOB WORKLIST ACTIONS ;Jun 06, 2014@19:11:19
;;4.5;Accounts Receivable;**439**;Mar 20, 1995;Build 29
;Per VA Directive 6402, this routine should not be modified.
Q
;
ERADET() ; Created for PRCA*4.5*439 - EP from ^RCDPEWL0
N DIR,X,Y
S DIR("?",1)="Including expanded detail will significantly increase the size of this report"
S DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE"
S DIR("?")="listed. If you want just summary data for each EEOB, do NOT include it."
S DIR(0)="YA",DIR("A")="Do you want to include expanded EEOB detail?: ",DIR("B")="NO"
W !
D ^DIR
I $D(DUOUT)!$D(DTOUT) Q -1
Q +Y
;
AUDIT() ; Created for PRCA*4.5*439 - EP from ^RCDPEWL0
N DIR,X,Y
S DIR("?",1)="Choosing to show audit information will cause auto-post and match status"
S DIR("?")="audit information to be displayed below the EEOB details."
S DIR(0)="YA",DIR("A")="Display Auto-Post and Match Status Audit Information?: ",DIR("B")="NO"
W !
D ^DIR
I $D(DUOUT)!$D(DTOUT) Q -1
Q +Y
;
GETAUD(ERAIEN,OUTARR) ; Get auto-post and match audit information for a single ERA (EP)
; Input : ERAIEN - Internal entry number for file #344.4
; Output: OUTARR - Passed by reference - returns array of text information for a report.
;
N CNT,DATA,EFT,IEN,IEN2,STAMP,OLD,NEW,USER,REASON
S CNT=1
S OUTARR(CNT)=" **AUTO POST STATUS**"
S IEN=0
I '$O(^RCY(344.72,"E",ERAIEN,IEN)) D ;
. S CNT=CNT+1,OUTARR(CNT)=" No audit entries for this ERA"
. S CNT=CNT+1,OUTARR(CNT)=""
E F S IEN=$O(^RCY(344.72,"E",ERAIEN,IEN)) Q:'IEN D ;
. S DATA=$G(^RCY(344.72,IEN,0))
. S STAMP=$$FMTSTAMP($P(DATA,"^",1))
. S OLD=$$GET1^DIQ(344.72,IEN_",",.04,"E")
. I OLD="" S OLD="NULL"
. S NEW=$$GET1^DIQ(344.72,IEN_",",.05,"E")
. I NEW="" S NEW="NULL"
. S REASON=$P(DATA,"^",6)
. S USER=$$GET1^DIQ(344.72,IEN_",",.02,"E")
. S CNT=CNT+1
. S OUTARR(CNT)=" "_$$PAD(STAMP,17)_" "_$$PAD(OLD,12)_" "_$$PAD(NEW,18)_" "_$E(USER,1,21)
. S CNT=CNT+1
. S OUTARR(CNT)=" "_REASON
. S CNT=CNT+1
. S OUTARR(CNT)=""
;
S CNT=CNT+1,OUTARR(CNT)=" **MATCH STATUS**"
S IEN2=0
I '$O(^RCY(344.4,ERAIEN,10,IEN2)) D ;
. S CNT=CNT+1,OUTARR(CNT)=" No audit entries for this ERA"
. S CNT=CNT+1,OUTARR(CNT)=""
E F S IEN2=$O(^RCY(344.4,ERAIEN,10,IEN2)) Q:'IEN2 D ;
. S DATA=^RCY(344.4,ERAIEN,10,IEN2,0)
. S STAMP=$$FMTSTAMP($P(DATA,"^",1))
. S USER=$$GET1^DIQ(344.43,IEN2_","_ERAIEN_",",.02,"E")
. S OLD=$$GET1^DIQ(344.43,IEN2_","_ERAIEN_",",.03,"E")
. S OLD=$$ABB(OLD)
. I OLD="" S OLD="NULL"
. S NEW=$$GET1^DIQ(344.43,IEN2_","_ERAIEN_",",.04,"E")
. S NEW=$$ABB(NEW)
. I NEW="" S NEW="NULL"
. S EFT=$P(DATA,"^",5)
. I EFT S EFT=$$GET1^DIQ(344.31,EFT_",",.01,"E")
. I EFT'="" S EFT=" ("_EFT_")"
. S CNT=CNT+1
. S OUTARR(CNT)=" "_$$PAD(STAMP,17)_" "_$$PAD(OLD,12)_" "_$$PAD(NEW_EFT,18)_" "_$E(USER,1,21)
Q
FMTSTAMP(X) ; Format date stamp
; Input : X date/time in fileman format
; Return : date/time in format MM/DD/YY:HH:MM:SS
N DATE,STAMP,TIME
S DATE=$P(X,".",1),TIME=$P(X,".",2)
S DATE=$E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_$E(DATE,2,3)
S STAMP=DATE_"@"_$E(TIME,1,2)_":"_$E(TIME,3,4)_":"_$E(TIME,5,6)
Q STAMP
PAD(X,Y) ; Right pad X to length Y
; Input : X - String to PAD
; Y - Length
; Return: X padded to length Y.
Q $E(X_$J("",80),1,Y)
;
ABB(X) ; Abbreviate match status to be no more than 10 chars
N RETURN
S RETURN=X
I X="MATCHED TO PAPER CHECK" S RETURN="PAPER CHK"
I X="MATCHED WITH ERRORS" S RETURN="MATCH ERR"
I X="MATCH-0 PAYMENT" S RETURN="MATCH-0"
I X="REMOVED FROM WORKLIST" S RETURN="REMOVED"
I X="MATCHED TO TDA" S RETURN="MATCH TDA"
S RETURN=$E(RETURN,1,10)
Q RETURN
;
ERASTR ; Enter here for new style ERA Status Change Report with ERA Detail, Auto-Post and Match Audit - PRCA*4.5*439
;
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,QUIT,RCALL,RCTYPE,RCERA,RCRANGE
S DIR(0)="SA^S:SINGLE ERA;A:ALL"
S DIR("A")="SELECT (S)ingle ERA or (A)LL: ",DIR("B")="ALL"
D ^DIR
I Y'="S",Y'="A" Q
S RCALL=Y
;
; If Single ERA, select the ERA
S RCERA="",RCTYPE="A",RCRANGE="",QUIT=0
I RCALL="S" D Q:'RCERA
. S RCERA=$$SELERA^RCDPEAPS()
E D I QUIT Q
. S RCRANGE=$$DTRNG^RCDPEAPS()
. I 'RCRANGE S QUIT=1 Q
. S RCTYPE=$$RTYPE^RCDPEU1("A")
. I RCTYPE=-1 S QUIT=1
;
; Prompt for device
N %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
S %ZIS="QM"
D ^%ZIS
I POP G ENQ
I $D(IO("Q")) D G ENQ
. S ZTRTN="RUN^RCDPEWLE(RCERA,RCRANGE,RCTYPE)"
. S ZTIO=ION
. S ZTSAVE("*")=""
. S ZTDESC="ERA STATUS CHANGE AUDIT REPORT"
. D ^%ZTLOAD
. W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
. D HOME^%ZIS
U IO
;
D RUN(RCERA,RCRANGE,RCTYPE)
;
ENQ ;
Q
;
RUN(RCERA,RCRANGE,RCTYPE) ;
N DASH,EQL,RCD1,RCD2,RCDATE
S DASH="",$P(DASH,"-",IOM+1)=""
S EQL="",$P(EQL,"=",IOM+1)=""
S RCDATE=$$FMTE^XLFDT($$DT^XLFDT(),"2Z")
;
K ^TMP("RCDPEWLE",$J)
;
S (RCD1,RCD2)=""
I 'RCERA S RCD1=$$FMTE^XLFDT($P(RCRANGE,U,1),"2Z"),RCD2=$$FMTE^XLFDT($P(RCRANGE,U,2),"2Z")
; Compile Data
D COMPILE
;
; Generate Report
D REPORT
;
K ^TMP("RCDPEAPS",$J)
Q
;
COMPILE ; Compile report data
N CNT,BDATE,EDATE,AUDDATE,IEN,CNT,DATA,RCDATE
S CNT=0
;
; If RCERA is non-zero, then we are doing a single ERA
I RCERA D Q
. D ONE(RCERA,.CNT)
;
; If RCERA is zero, then we are gathering data by date filed
I 'RCERA D Q
. S BDATE=$P(RCRANGE,U,1)-.000001,EDATE=$P(RCRANGE,U,2)+.999999
. S AUDDATE=BDATE F S AUDDATE=$O(^RCY(344.4,"AFD",AUDDATE)) Q:'AUDDATE!(AUDDATE>EDATE) D
.. S IEN="" F S IEN=$O(^RCY(344.4,"AFD",AUDDATE,IEN)) Q:'IEN D
... I $$ISTYPE^RCDPEU1(344.4,IEN,RCTYPE) D ONE(IEN,.CNT)
;
Q
REPORT ; Print Report
N CNT,LINE,PAGE,RCSCR
S (CNT,LINE,PAGE)=0
S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
D HDR1
F S CNT=$O(^TMP("RCDPEWLE",$J,CNT)) Q:'CNT D I PAGE=0 Q
. I LINE=(IOSL-2) D I PAGE=0 Q
.. I RCSCR,'$$PAUSE^RCDPEAPS() S PAGE=0 Q
.. D HDR1
. W !,^TMP("RCDPEWLE",$J,CNT)
. S LINE=LINE+1
;
I PAGE>0,$$PAUSE^RCDPEAPS()
Q
ONE(RCERA,CNT) ; Extract data for one ERA
; Input : RCERA - Internal entry number from file 344.4
; Output : Lines of Text in ^TMP("RCDPEWLE",$J,CNT)
;
N J,RC,RCAUDIT,RCDIQ,RCSCR1,RCXM1
S RC=0
D GETS^DIQ(344.4,RCERA_",","*","IEN","RCDIQ")
D TXT0^RCDPEX31(RCERA,.RCDIQ,.RCXM1,.RC) ; Get top level 0-node captioned flds
;
I $O(^RCY(344.4,RCERA,2,0)) S RC=RC+1,RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
S RCSCR1=0 F S RCSCR1=$O(^RCY(344.4,RCERA,2,RCSCR1)) Q:'RCSCR1 D
. K RCDIQ2
. D GETS^DIQ(344.42,RCSCR1_","_RCERA_",","*","IEN","RCDIQ2")
. D TXT2^RCDPEX31(RCERA,RCSCR1,.RCDIQ2,.RCXM1,.RC) ; Get top level ERA adjs
;
F J=1:1:RC S CNT=CNT+1,^TMP("RCDPEWLE",$J,CNT)=RCXM1(J)
;
D HDR2
D GETAUD(RCERA,.RCAUDIT)
S RC=0 F S RC=$O(RCAUDIT(RC)) Q:'RC D ;
. S CNT=CNT+1,^TMP("RCDPEWLE",$J,CNT)=RCAUDIT(RC)
S CNT=CNT+2,^TMP("RCDPEWLE",$J,CNT-1)=EQL,^TMP("RCDPEWLE",$J,CNT)=""
Q
HDR1 ; Print main header for report
N HDR
W @IOF
S PAGE=PAGE+1
S HDR=" ERA STATUS AND AUDIT INFORMATION"
I RCD1="" D ;
. S HDR=HDR_$J("",17)_$J(RCDATE,8)
E D ;
. S HDR=HDR_$J("",8)_$$PAD(RCD1,8)_"-"_$$PAD(RCD2,8)
S HDR=HDR_$J("",8)_"Page: "_PAGE
W HDR
W !,EQL
S LINE=2
Q
HDR2 ; Print header for audit trail
N HDR
S HDR=" Date/Time Edited Status (Old/New)"_$J("",41)_"User"
S CNT=CNT+1 S ^TMP("RCDPEWLE",$J,CNT)=HDR
S HDR=" Reason Text"
S CNT=CNT+1 S ^TMP("RCDPEWLE",$J,CNT)=HDR
S CNT=CNT+1 S ^TMP("RCDPEWLE",$J,CNT)=DASH
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEWLE 7645 printed Aug 26, 2025@22:01:39 Page 2
RCDPEWLE ;AITC/CJE - ELECTRONIC EOB WORKLIST ACTIONS ;Jun 06, 2014@19:11:19
+1 ;;4.5;Accounts Receivable;**439**;Mar 20, 1995;Build 29
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
ERADET() ; Created for PRCA*4.5*439 - EP from ^RCDPEWL0
+1 NEW DIR,X,Y
+2 SET DIR("?",1)="Including expanded detail will significantly increase the size of this report"
+3 SET DIR("?",2)="IF YOU CHOOSE TO INCLUDE IT, ALL PAYMENT DETAILS FOR EACH EEOB WILL BE"
+4 SET DIR("?")="listed. If you want just summary data for each EEOB, do NOT include it."
+5 SET DIR(0)="YA"
SET DIR("A")="Do you want to include expanded EEOB detail?: "
SET DIR("B")="NO"
+6 WRITE !
+7 DO ^DIR
+8 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT -1
+9 QUIT +Y
+10 ;
AUDIT() ; Created for PRCA*4.5*439 - EP from ^RCDPEWL0
+1 NEW DIR,X,Y
+2 SET DIR("?",1)="Choosing to show audit information will cause auto-post and match status"
+3 SET DIR("?")="audit information to be displayed below the EEOB details."
+4 SET DIR(0)="YA"
SET DIR("A")="Display Auto-Post and Match Status Audit Information?: "
SET DIR("B")="NO"
+5 WRITE !
+6 DO ^DIR
+7 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT -1
+8 QUIT +Y
+9 ;
GETAUD(ERAIEN,OUTARR) ; Get auto-post and match audit information for a single ERA (EP)
+1 ; Input : ERAIEN - Internal entry number for file #344.4
+2 ; Output: OUTARR - Passed by reference - returns array of text information for a report.
+3 ;
+4 NEW CNT,DATA,EFT,IEN,IEN2,STAMP,OLD,NEW,USER,REASON
+5 SET CNT=1
+6 SET OUTARR(CNT)=" **AUTO POST STATUS**"
+7 SET IEN=0
+8 ;
IF '$ORDER(^RCY(344.72,"E",ERAIEN,IEN))
Begin DoDot:1
+9 SET CNT=CNT+1
SET OUTARR(CNT)=" No audit entries for this ERA"
+10 SET CNT=CNT+1
SET OUTARR(CNT)=""
End DoDot:1
+11 ;
IF '$TEST
FOR
SET IEN=$ORDER(^RCY(344.72,"E",ERAIEN,IEN))
if 'IEN
QUIT
Begin DoDot:1
+12 SET DATA=$GET(^RCY(344.72,IEN,0))
+13 SET STAMP=$$FMTSTAMP($PIECE(DATA,"^",1))
+14 SET OLD=$$GET1^DIQ(344.72,IEN_",",.04,"E")
+15 IF OLD=""
SET OLD="NULL"
+16 SET NEW=$$GET1^DIQ(344.72,IEN_",",.05,"E")
+17 IF NEW=""
SET NEW="NULL"
+18 SET REASON=$PIECE(DATA,"^",6)
+19 SET USER=$$GET1^DIQ(344.72,IEN_",",.02,"E")
+20 SET CNT=CNT+1
+21 SET OUTARR(CNT)=" "_$$PAD(STAMP,17)_" "_$$PAD(OLD,12)_" "_$$PAD(NEW,18)_" "_$EXTRACT(USER,1,21)
+22 SET CNT=CNT+1
+23 SET OUTARR(CNT)=" "_REASON
+24 SET CNT=CNT+1
+25 SET OUTARR(CNT)=""
End DoDot:1
+26 ;
+27 SET CNT=CNT+1
SET OUTARR(CNT)=" **MATCH STATUS**"
+28 SET IEN2=0
+29 ;
IF '$ORDER(^RCY(344.4,ERAIEN,10,IEN2))
Begin DoDot:1
+30 SET CNT=CNT+1
SET OUTARR(CNT)=" No audit entries for this ERA"
+31 SET CNT=CNT+1
SET OUTARR(CNT)=""
End DoDot:1
+32 ;
IF '$TEST
FOR
SET IEN2=$ORDER(^RCY(344.4,ERAIEN,10,IEN2))
if 'IEN2
QUIT
Begin DoDot:1
+33 SET DATA=^RCY(344.4,ERAIEN,10,IEN2,0)
+34 SET STAMP=$$FMTSTAMP($PIECE(DATA,"^",1))
+35 SET USER=$$GET1^DIQ(344.43,IEN2_","_ERAIEN_",",.02,"E")
+36 SET OLD=$$GET1^DIQ(344.43,IEN2_","_ERAIEN_",",.03,"E")
+37 SET OLD=$$ABB(OLD)
+38 IF OLD=""
SET OLD="NULL"
+39 SET NEW=$$GET1^DIQ(344.43,IEN2_","_ERAIEN_",",.04,"E")
+40 SET NEW=$$ABB(NEW)
+41 IF NEW=""
SET NEW="NULL"
+42 SET EFT=$PIECE(DATA,"^",5)
+43 IF EFT
SET EFT=$$GET1^DIQ(344.31,EFT_",",.01,"E")
+44 IF EFT'=""
SET EFT=" ("_EFT_")"
+45 SET CNT=CNT+1
+46 SET OUTARR(CNT)=" "_$$PAD(STAMP,17)_" "_$$PAD(OLD,12)_" "_$$PAD(NEW_EFT,18)_" "_$EXTRACT(USER,1,21)
End DoDot:1
+47 QUIT
FMTSTAMP(X) ; Format date stamp
+1 ; Input : X date/time in fileman format
+2 ; Return : date/time in format MM/DD/YY:HH:MM:SS
+3 NEW DATE,STAMP,TIME
+4 SET DATE=$PIECE(X,".",1)
SET TIME=$PIECE(X,".",2)
+5 SET DATE=$EXTRACT(DATE,4,5)_"/"_$EXTRACT(DATE,6,7)_"/"_$EXTRACT(DATE,2,3)
+6 SET STAMP=DATE_"@"_$EXTRACT(TIME,1,2)_":"_$EXTRACT(TIME,3,4)_":"_$EXTRACT(TIME,5,6)
+7 QUIT STAMP
PAD(X,Y) ; Right pad X to length Y
+1 ; Input : X - String to PAD
+2 ; Y - Length
+3 ; Return: X padded to length Y.
+4 QUIT $EXTRACT(X_$JUSTIFY("",80),1,Y)
+5 ;
ABB(X) ; Abbreviate match status to be no more than 10 chars
+1 NEW RETURN
+2 SET RETURN=X
+3 IF X="MATCHED TO PAPER CHECK"
SET RETURN="PAPER CHK"
+4 IF X="MATCHED WITH ERRORS"
SET RETURN="MATCH ERR"
+5 IF X="MATCH-0 PAYMENT"
SET RETURN="MATCH-0"
+6 IF X="REMOVED FROM WORKLIST"
SET RETURN="REMOVED"
+7 IF X="MATCHED TO TDA"
SET RETURN="MATCH TDA"
+8 SET RETURN=$EXTRACT(RETURN,1,10)
+9 QUIT RETURN
+10 ;
ERASTR ; Enter here for new style ERA Status Change Report with ERA Detail, Auto-Post and Match Audit - PRCA*4.5*439
+1 ;
+2 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,QUIT,RCALL,RCTYPE,RCERA,RCRANGE
+3 SET DIR(0)="SA^S:SINGLE ERA;A:ALL"
+4 SET DIR("A")="SELECT (S)ingle ERA or (A)LL: "
SET DIR("B")="ALL"
+5 DO ^DIR
+6 IF Y'="S"
IF Y'="A"
QUIT
+7 SET RCALL=Y
+8 ;
+9 ; If Single ERA, select the ERA
+10 SET RCERA=""
SET RCTYPE="A"
SET RCRANGE=""
SET QUIT=0
+11 IF RCALL="S"
Begin DoDot:1
+12 SET RCERA=$$SELERA^RCDPEAPS()
End DoDot:1
if 'RCERA
QUIT
+13 IF '$TEST
Begin DoDot:1
+14 SET RCRANGE=$$DTRNG^RCDPEAPS()
+15 IF 'RCRANGE
SET QUIT=1
QUIT
+16 SET RCTYPE=$$RTYPE^RCDPEU1("A")
+17 IF RCTYPE=-1
SET QUIT=1
End DoDot:1
IF QUIT
QUIT
+18 ;
+19 ; Prompt for device
+20 NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP
+21 SET %ZIS="QM"
+22 DO ^%ZIS
+23 IF POP
GOTO ENQ
+24 IF $DATA(IO("Q"))
Begin DoDot:1
+25 SET ZTRTN="RUN^RCDPEWLE(RCERA,RCRANGE,RCTYPE)"
+26 SET ZTIO=ION
+27 SET ZTSAVE("*")=""
+28 SET ZTDESC="ERA STATUS CHANGE AUDIT REPORT"
+29 DO ^%ZTLOAD
+30 WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
+31 DO HOME^%ZIS
End DoDot:1
GOTO ENQ
+32 USE IO
+33 ;
+34 DO RUN(RCERA,RCRANGE,RCTYPE)
+35 ;
ENQ ;
+1 QUIT
+2 ;
RUN(RCERA,RCRANGE,RCTYPE) ;
+1 NEW DASH,EQL,RCD1,RCD2,RCDATE
+2 SET DASH=""
SET $PIECE(DASH,"-",IOM+1)=""
+3 SET EQL=""
SET $PIECE(EQL,"=",IOM+1)=""
+4 SET RCDATE=$$FMTE^XLFDT($$DT^XLFDT(),"2Z")
+5 ;
+6 KILL ^TMP("RCDPEWLE",$JOB)
+7 ;
+8 SET (RCD1,RCD2)=""
+9 IF 'RCERA
SET RCD1=$$FMTE^XLFDT($PIECE(RCRANGE,U,1),"2Z")
SET RCD2=$$FMTE^XLFDT($PIECE(RCRANGE,U,2),"2Z")
+10 ; Compile Data
+11 DO COMPILE
+12 ;
+13 ; Generate Report
+14 DO REPORT
+15 ;
+16 KILL ^TMP("RCDPEAPS",$JOB)
+17 QUIT
+18 ;
COMPILE ; Compile report data
+1 NEW CNT,BDATE,EDATE,AUDDATE,IEN,CNT,DATA,RCDATE
+2 SET CNT=0
+3 ;
+4 ; If RCERA is non-zero, then we are doing a single ERA
+5 IF RCERA
Begin DoDot:1
+6 DO ONE(RCERA,.CNT)
End DoDot:1
QUIT
+7 ;
+8 ; If RCERA is zero, then we are gathering data by date filed
+9 IF 'RCERA
Begin DoDot:1
+10 SET BDATE=$PIECE(RCRANGE,U,1)-.000001
SET EDATE=$PIECE(RCRANGE,U,2)+.999999
+11 SET AUDDATE=BDATE
FOR
SET AUDDATE=$ORDER(^RCY(344.4,"AFD",AUDDATE))
if 'AUDDATE!(AUDDATE>EDATE)
QUIT
Begin DoDot:2
+12 SET IEN=""
FOR
SET IEN=$ORDER(^RCY(344.4,"AFD",AUDDATE,IEN))
if 'IEN
QUIT
Begin DoDot:3
+13 IF $$ISTYPE^RCDPEU1(344.4,IEN,RCTYPE)
DO ONE(IEN,.CNT)
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+14 ;
+15 QUIT
REPORT ; Print Report
+1 NEW CNT,LINE,PAGE,RCSCR
+2 SET (CNT,LINE,PAGE)=0
+3 SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)
+4 DO HDR1
+5 FOR
SET CNT=$ORDER(^TMP("RCDPEWLE",$JOB,CNT))
if 'CNT
QUIT
Begin DoDot:1
+6 IF LINE=(IOSL-2)
Begin DoDot:2
+7 IF RCSCR
IF '$$PAUSE^RCDPEAPS()
SET PAGE=0
QUIT
+8 DO HDR1
End DoDot:2
IF PAGE=0
QUIT
+9 WRITE !,^TMP("RCDPEWLE",$JOB,CNT)
+10 SET LINE=LINE+1
End DoDot:1
IF PAGE=0
QUIT
+11 ;
+12 IF PAGE>0
IF $$PAUSE^RCDPEAPS()
+13 QUIT
ONE(RCERA,CNT) ; Extract data for one ERA
+1 ; Input : RCERA - Internal entry number from file 344.4
+2 ; Output : Lines of Text in ^TMP("RCDPEWLE",$J,CNT)
+3 ;
+4 NEW J,RC,RCAUDIT,RCDIQ,RCSCR1,RCXM1
+5 SET RC=0
+6 DO GETS^DIQ(344.4,RCERA_",","*","IEN","RCDIQ")
+7 ; Get top level 0-node captioned flds
DO TXT0^RCDPEX31(RCERA,.RCDIQ,.RCXM1,.RC)
+8 ;
+9 IF $ORDER(^RCY(344.4,RCERA,2,0))
SET RC=RC+1
SET RCXM1(RC)=" **ERA LEVEL ADJUSTMENTS**"
+10 SET RCSCR1=0
FOR
SET RCSCR1=$ORDER(^RCY(344.4,RCERA,2,RCSCR1))
if 'RCSCR1
QUIT
Begin DoDot:1
+11 KILL RCDIQ2
+12 DO GETS^DIQ(344.42,RCSCR1_","_RCERA_",","*","IEN","RCDIQ2")
+13 ; Get top level ERA adjs
DO TXT2^RCDPEX31(RCERA,RCSCR1,.RCDIQ2,.RCXM1,.RC)
End DoDot:1
+14 ;
+15 FOR J=1:1:RC
SET CNT=CNT+1
SET ^TMP("RCDPEWLE",$JOB,CNT)=RCXM1(J)
+16 ;
+17 DO HDR2
+18 DO GETAUD(RCERA,.RCAUDIT)
+19 ;
SET RC=0
FOR
SET RC=$ORDER(RCAUDIT(RC))
if 'RC
QUIT
Begin DoDot:1
+20 SET CNT=CNT+1
SET ^TMP("RCDPEWLE",$JOB,CNT)=RCAUDIT(RC)
End DoDot:1
+21 SET CNT=CNT+2
SET ^TMP("RCDPEWLE",$JOB,CNT-1)=EQL
SET ^TMP("RCDPEWLE",$JOB,CNT)=""
+22 QUIT
HDR1 ; Print main header for report
+1 NEW HDR
+2 WRITE @IOF
+3 SET PAGE=PAGE+1
+4 SET HDR=" ERA STATUS AND AUDIT INFORMATION"
+5 ;
IF RCD1=""
Begin DoDot:1
+6 SET HDR=HDR_$JUSTIFY("",17)_$JUSTIFY(RCDATE,8)
End DoDot:1
+7 ;
IF '$TEST
Begin DoDot:1
+8 SET HDR=HDR_$JUSTIFY("",8)_$$PAD(RCD1,8)_"-"_$$PAD(RCD2,8)
End DoDot:1
+9 SET HDR=HDR_$JUSTIFY("",8)_"Page: "_PAGE
+10 WRITE HDR
+11 WRITE !,EQL
+12 SET LINE=2
+13 QUIT
HDR2 ; Print header for audit trail
+1 NEW HDR
+2 SET HDR=" Date/Time Edited Status (Old/New)"_$JUSTIFY("",41)_"User"
+3 SET CNT=CNT+1
SET ^TMP("RCDPEWLE",$JOB,CNT)=HDR
+4 SET HDR=" Reason Text"
+5 SET CNT=CNT+1
SET ^TMP("RCDPEWLE",$JOB,CNT)=HDR
+6 SET CNT=CNT+1
SET ^TMP("RCDPEWLE",$JOB,CNT)=DASH
+7 QUIT
