Routine: RCDPEAPS

RCDPEAPS ;ALB/DMB - ERA STATUS CHANGE AUDIT REPORT ;Nov 25, 2015

 ;;4.5;Accounts Receivable;**304,326,432**;Mar 20, 1995;Build 16

 ;Per VA Directive 6402, this routine should not be modified.

EN ;

 ; Prompt for report type

 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,RCALL,RCTYPE,RCERA,RCRANGE ; PRCA*4.5*326

 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 ; PRCA*4.5*326

 ; If Single ERA, select the ERA

 S RCERA="",RCTYPE="A"

 I RCALL="S" S RCERA=$$SELERA() Q:'RCERA  G RANGE  ; PRCA*4.5*326

 ; If ALL ERAs, select Type of Payers to include and Date Range for Report

 S RCTYPE=$$RTYPE^RCDPEU1("A") I RCTYPE=-1 Q  ; PRCA*4.5*326

RANGE ; Select date range for audit transactions

 S RCRANGE=""

 S RCRANGE=$$DTRNG() I 'RCRANGE Q

 ; 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^RCDPEAPS(RCERA,RCRANGE)"

 . 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)

ENQ ;

RUN(RCERA,RCRANGE) ;

 K ^TMP("RCDPEAPS",$J)

 ; Compile Data

 D COMPILE(RCERA,RCRANGE)

 ; Generate Report

 D REPORT(RCRANGE)

 K ^TMP("RCDPEAPS",$J)

COMPILE(RCERA,RCRANGE) ;

 ; Compile the data

 N CNT,BDATE,EDATE,AUDDATE,IEN,CNT,DATA

 S CNT=0,BDATE=$P(RCRANGE,U,1)-.000001,EDATE=$P(RCRANGE,U,2)+.999999

 ; If RCERA is non-zero, then we are doing a single ERA

 I RCERA D  Q

 . S IEN="" F  S IEN=$O(^RCY(344.72,"E",RCERA,IEN)) Q:'IEN  D

 .. S DATA=$G(^RCY(344.72,IEN,0))

 .. S AUDDATE=$P(DATA,U,1)

 .. I AUDDATE="" Q

 .. I AUDDATE<BDATE!(AUDDATE>EDATE) Q

 .. S CNT=CNT+1

 .. S ^TMP("RCDPEAPS",$J,RCERA,AUDDATE,CNT)=$P(DATA,U,4)_U_$P(DATA,U,5)_U_$P(DATA,U,2)_U_$P(DATA,U,6)

 ; If RCERA is zero, then we are gathering data by date

 I 'RCERA D  Q

 . S AUDDATE=BDATE F  S AUDDATE=$O(^RCY(344.72,"B",AUDDATE)) Q:'AUDDATE!(AUDDATE>EDATE)  D

 .. S IEN="" F  S IEN=$O(^RCY(344.72,"B",AUDDATE,IEN)) Q:'IEN  D

 ... S DATA=$G(^RCY(344.72,IEN,0))

 ... I $P(DATA,U,3)="" Q

 ... S CNT=CNT+1

 ... S ^TMP("RCDPEAPS",$J,$P(DATA,U,3),AUDDATE,CNT)=$P(DATA,U,4)_U_$P(DATA,U,5)_U_$P(DATA,U,2)_U_$P(DATA,U,6)

REPORT(RCRANGE) ;

 ; Display output

 ; Initialize Report Date, Page Number and Sting of underscores

 N RCSCR,RCNOW,RCPG,RCHR,ERA,DATE,CNT,DATA,LINES

 S RCSCR=$S($E($G(IOST),1,2)="C-":1,1:0)

 S RCNOW=$$UP^XLFSTR($$NOW^RCDPRU()),RCPG=0,RCHR="",$P(RCHR,"-",IOM+1)=""

 U IO

 D HEADER(RCNOW,.RCPG,RCHR,RCRANGE)

 I '$D(^TMP("RCDPEAPS",$J)) W !,"No data found"

 ; Display the detail

 S ERA="" F  S ERA=$O(^TMP("RCDPEAPS",$J,ERA)) Q:'ERA  D  I RCPG=0 Q

 . I RCTYPE'="A",'$$ISTYPE^RCDPEU1(344.4,ERA,RCTYPE) Q  ; PRCA*4.5*326 Filter by Medical, Tricare, CHAMPVA or Pharmacy

 . S DATE="" F  S DATE=$O(^TMP("RCDPEAPS",$J,ERA,DATE)) Q:'DATE  D  I RCPG=0 Q

 .. S CNT=0 F  S CNT=$O(^TMP("RCDPEAPS",$J,ERA,DATE,CNT)) Q:'CNT  D  I RCPG=0 Q

 ... S DATA=^TMP("RCDPEAPS",$J,ERA,DATE,CNT)

 ... S LINES=2

 ... I $P(DATA,U,4)]"" S LINES=3

 ... I RCSCR S LINES=LINES+1

 ... D CHKP(RCNOW,.RCPG,RCHR,RCRANGE,RCSCR,LINES) I RCPG=0 Q

 ... W !,ERA,?15,$$FMTE^XLFDT(DATE,"2Z"),?38,$$STATUS($P(DATA,U,1)),?49,$$STATUS($P(DATA,U,2))

 ... W ?63,$E($$GET1^DIQ(200,+$P(DATA,U,3)_",",.01),1,IOM-63)

 ... I $P(DATA,U,4)]"" W !,?3,$E($P(DATA,U,4),1,IOM-4)

 ... W !

 I 'RCSCR W !,@IOF

 I $D(ZTQUEUED) S ZTREQ="@" Q

 D ^%ZISC

 I RCPG,RCSCR D PAUSE

HEADER(RCNOW,RCPG,RCHR,RCRANGE) ;

 ; Print Header

 N LINE

 W @IOF

 S RCPG=RCPG+1

 S LINE="EDI Lockbox ERA Status Change Audit Report"

 W ?(IOM-$L(LINE)\2),LINE

 S LINE="Page: "_RCPG_" "

 W ?(IOM-$L(LINE)),LINE

 S LINE="RUN DATE: "_RCNOW

 S LINE=LINE_"       MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 S LINE=LINE_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARAMCY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")  ;PRCA*4.5*432 Add CHAMPVA

 W !?(IOM-$L(LINE)\2),LINE

 S LINE="DATE RANGE: "_$$FMTE^XLFDT($P(RCRANGE,U,1),"5DZ")_" - "_$$FMTE^XLFDT($P(RCRANGE,U,2),"5DZ")

 W !?(IOM-$L(LINE)\2),LINE

 W !!,"ERA#",?15,"Date/Time Edited",?38,"Status (Old/New)",?63,"User"

 W !?3,"Reason Text"

 W !,RCHR

PAUSE() ;

 N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT

 S DIR(0)="E"

 D ^DIR

Q Y

CHKP(RCNOW,RCPG,RCHR,RCRANGE,RCSCR,LINES) ;

 ; Check if we need to do a page break

 I $Y'>(IOSL-LINES) Q

 I RCSCR,'$$PAUSE S RCPG=0 Q

 D HEADER(RCNOW,.RCPG,RCHR,RCRANGE)

SELERA() ;

 ; Lookup on the Electronic Remittance Advice (#344.4) file

 N DIC,X,Y,DTOUT,DUOUT

 S DIC="^RCY(344.4,",DIC(0)="QEAMn"

 D ^DIC

 I $G(DTOUT)!$G(DUOUT)!(Y=-1) Q 0

 Q +Y

DTRNG() ;

 ; Get the date range for the report

 N DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,BDATE

 S DIR("?")="ENTER THE EARLIEST AUDIT DATE TO INCLUDE ON THE REPORT"

 S DIR(0)="DA^:"_DT_":APE",DIR("A")="START DATE: ",DIR("B")="T" D ^DIR

 I $D(DTOUT)!$D(DUOUT)!(Y="") S BDATE=-1 Q 0

 S BDATE=Y

 K DIR

 S DIR("?")="ENTER THE LATEST AUDIT DATE TO INCLUDE ON THE REPORT"

 S DIR("B")=Y(0)

 S DIR(0)="DA^"_BDATE_":"_DT_":APE",DIR("A")="END DATE: ",DIR("B")="T" D ^DIR

 I $D(DTOUT)!$D(DUOUT)!(Y="") Q 0

 Q BDATE_"^"_Y

STATUS(STATUS) ;

 ; Convert internal status to external status

 I '$D(STATUS) Q ""

 I STATUS="" Q "NULL"

 Q $$EXTERNAL^DILFD(344.4,4.02,,STATUS)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAPS   5528     printed  Mar 13, 2025@20:49:01                                                                                                                                                                                                    Page 2

RCDPEAPS  ;ALB/DMB - ERA STATUS CHANGE AUDIT REPORT ;Nov 25, 2015

 +1       ;;4.5;Accounts Receivable;**304,326,432**;Mar 20, 1995;Build 16

 +2       ;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;

EN        ;

 +1       ; Prompt for report type

 +2       ; PRCA*4.5*326

           NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,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       ; PRCA*4.5*326

           SET RCALL=Y

 +8       ;

 +9       ; If Single ERA, select the ERA

 +10       SET RCERA=""

           SET RCTYPE="A"

 +11      ; PRCA*4.5*326

           IF RCALL="S"

               SET RCERA=$$SELERA()

               if 'RCERA

                   QUIT

               GOTO RANGE

 +12      ;

 +13      ; If ALL ERAs, select Type of Payers to include and Date Range for Report

 +14      ; PRCA*4.5*326

           SET RCTYPE=$$RTYPE^RCDPEU1("A")

           IF RCTYPE=-1

               QUIT

 +15      ;

RANGE     ; Select date range for audit transactions

 +1        SET RCRANGE=""

 +2        SET RCRANGE=$$DTRNG()

           IF 'RCRANGE

               QUIT

 +3       ;

 +4       ; Prompt for device

 +5        NEW %ZIS,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP

 +6        SET %ZIS="QM"

 +7        DO ^%ZIS

 +8        IF POP

               GOTO ENQ

 +9        IF $DATA(IO("Q"))

               Begin DoDot:1

 +10               SET ZTRTN="RUN^RCDPEAPS(RCERA,RCRANGE)"

 +11               SET ZTIO=ION

 +12               SET ZTSAVE("*")=""

 +13               SET ZTDESC="ERA STATUS CHANGE AUDIT REPORT"

 +14               DO ^%ZTLOAD

 +15               WRITE !,$SELECT($DATA(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")

 +16               DO HOME^%ZIS

               End DoDot:1

               GOTO ENQ

 +17       USE IO

 +18      ;

 +19       DO RUN(RCERA,RCRANGE)

 +20      ;

ENQ       ;

 +1        QUIT

 +2       ;

RUN(RCERA,RCRANGE) ;

 +1       ;

 +2        KILL ^TMP("RCDPEAPS",$JOB)

 +3       ;

 +4       ; Compile Data

 +5        DO COMPILE(RCERA,RCRANGE)

 +6       ;

 +7       ; Generate Report

 +8        DO REPORT(RCRANGE)

 +9       ;

 +10       KILL ^TMP("RCDPEAPS",$JOB)

 +11       QUIT

 +12      ;

COMPILE(RCERA,RCRANGE) ;

 +1       ; Compile the data

 +2       ;

 +3        NEW CNT,BDATE,EDATE,AUDDATE,IEN,CNT,DATA

 +4        SET CNT=0

           SET BDATE=$PIECE(RCRANGE,U,1)-.000001

           SET EDATE=$PIECE(RCRANGE,U,2)+.999999

 +5       ;

 +6       ; If RCERA is non-zero, then we are doing a single ERA

 +7        IF RCERA

               Begin DoDot:1

 +8                SET IEN=""

FOR

                       SET IEN=$ORDER(^RCY(344.72,"E",RCERA,IEN))

                       if 'IEN

                           QUIT

                       Begin DoDot:2

 +9                        SET DATA=$GET(^RCY(344.72,IEN,0))

 +10                       SET AUDDATE=$PIECE(DATA,U,1)

 +11                       IF AUDDATE=""

                               QUIT

 +12                       IF AUDDATE<BDATE!(AUDDATE>EDATE)

                               QUIT

 +13                       SET CNT=CNT+1

 +14                       SET ^TMP("RCDPEAPS",$JOB,RCERA,AUDDATE,CNT)=$PIECE(DATA,U,4)_U_$PIECE(DATA,U,5)_U_$PIECE(DATA,U,2)_U_$PIECE(DATA,U,6)

                       End DoDot:2

               End DoDot:1

               QUIT

 +15      ;

 +16      ; If RCERA is zero, then we are gathering data by date

 +17       IF 'RCERA

               Begin DoDot:1

 +18               SET AUDDATE=BDATE

FOR

                       SET AUDDATE=$ORDER(^RCY(344.72,"B",AUDDATE))

                       if 'AUDDATE!(AUDDATE>EDATE)

                           QUIT

                       Begin DoDot:2

 +19                       SET IEN=""

FOR

                               SET IEN=$ORDER(^RCY(344.72,"B",AUDDATE,IEN))

                               if 'IEN

                                   QUIT

                               Begin DoDot:3

 +20                               SET DATA=$GET(^RCY(344.72,IEN,0))

 +21                               IF $PIECE(DATA,U,3)=""

                                       QUIT

 +22                               SET CNT=CNT+1

 +23                               SET ^TMP("RCDPEAPS",$JOB,$PIECE(DATA,U,3),AUDDATE,CNT)=$PIECE(DATA,U,4)_U_$PIECE(DATA,U,5)_U_$PIECE(DATA,U,2)_U_$PIECE(DATA,U,6)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

               QUIT

 +24       QUIT

 +25      ;

REPORT(RCRANGE) ;

 +1       ; Display output

 +2       ;

 +3       ; Initialize Report Date, Page Number and Sting of underscores

 +4        NEW RCSCR,RCNOW,RCPG,RCHR,ERA,DATE,CNT,DATA,LINES

 +5        SET RCSCR=$SELECT($EXTRACT($GET(IOST),1,2)="C-":1,1:0)

 +6        SET RCNOW=$$UP^XLFSTR($$NOW^RCDPRU())

           SET RCPG=0

           SET RCHR=""

           SET $PIECE(RCHR,"-",IOM+1)=""

 +7       ;

 +8        USE IO

 +9        DO HEADER(RCNOW,.RCPG,RCHR,RCRANGE)

 +10       IF '$DATA(^TMP("RCDPEAPS",$JOB))

               WRITE !,"No data found"

 +11      ;

 +12      ; Display the detail

 +13       SET ERA=""

FOR

               SET ERA=$ORDER(^TMP("RCDPEAPS",$JOB,ERA))

               if 'ERA

                   QUIT

               Begin DoDot:1

 +14      ; PRCA*4.5*326 Filter by Medical, Tricare, CHAMPVA or Pharmacy

                   IF RCTYPE'="A"

                       IF '$$ISTYPE^RCDPEU1(344.4,ERA,RCTYPE)

                           QUIT

 +15               SET DATE=""

FOR

                       SET DATE=$ORDER(^TMP("RCDPEAPS",$JOB,ERA,DATE))

                       if 'DATE

                           QUIT

                       Begin DoDot:2

 +16                       SET CNT=0

FOR

                               SET CNT=$ORDER(^TMP("RCDPEAPS",$JOB,ERA,DATE,CNT))

                               if 'CNT

                                   QUIT

                               Begin DoDot:3

 +17                               SET DATA=^TMP("RCDPEAPS",$JOB,ERA,DATE,CNT)

 +18                               SET LINES=2

 +19                               IF $PIECE(DATA,U,4)]""

                                       SET LINES=3

 +20                               IF RCSCR

                                       SET LINES=LINES+1

 +21                               DO CHKP(RCNOW,.RCPG,RCHR,RCRANGE,RCSCR,LINES)

                                   IF RCPG=0

                                       QUIT

 +22                               WRITE !,ERA,?15,$$FMTE^XLFDT(DATE,"2Z"),?38,$$STATUS($PIECE(DATA,U,1)),?49,$$STATUS($PIECE(DATA,U,2))

 +23                               WRITE ?63,$EXTRACT($$GET1^DIQ(200,+$PIECE(DATA,U,3)_",",.01),1,IOM-63)

 +24                               IF $PIECE(DATA,U,4)]""

                                       WRITE !,?3,$EXTRACT($PIECE(DATA,U,4),1,IOM-4)

 +25                               WRITE !

                               End DoDot:3

                               IF RCPG=0

                                   QUIT

                       End DoDot:2

                       IF RCPG=0

                           QUIT

               End DoDot:1

               IF RCPG=0

                   QUIT

 +26      ;

 +27       IF 'RCSCR

               WRITE !,@IOF

 +28       IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               QUIT

 +29       DO ^%ZISC

 +30      ;

 +31       IF RCPG

               IF RCSCR

                   DO PAUSE

 +32       QUIT

 +33      ;

HEADER(RCNOW,RCPG,RCHR,RCRANGE) ;

 +1       ; Print Header

 +2       ;

 +3        NEW LINE

 +4        WRITE @IOF

 +5        SET RCPG=RCPG+1

 +6        SET LINE="EDI Lockbox ERA Status Change Audit Report"

 +7        WRITE ?(IOM-$LENGTH(LINE)\2),LINE

 +8        SET LINE="Page: "_RCPG_" "

 +9        WRITE ?(IOM-$LENGTH(LINE)),LINE

 +10       SET LINE="RUN DATE: "_RCNOW

 +11       SET LINE=LINE_"       MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 +12      ;PRCA*4.5*432 Add CHAMPVA

           SET LINE=LINE_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARAMCY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 +13       WRITE !?(IOM-$LENGTH(LINE)\2),LINE

 +14       SET LINE="DATE RANGE: "_$$FMTE^XLFDT($PIECE(RCRANGE,U,1),"5DZ")_" - "_$$FMTE^XLFDT($PIECE(RCRANGE,U,2),"5DZ")

 +15       WRITE !?(IOM-$LENGTH(LINE)\2),LINE

 +16      ;

 +17       WRITE !!,"ERA#",?15,"Date/Time Edited",?38,"Status (Old/New)",?63,"User"

 +18       WRITE !?3,"Reason Text"

 +19       WRITE !,RCHR

 +20       QUIT

 +21      ;

PAUSE()   ;

 +1        NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT

 +2        SET DIR(0)="E"

 +3        DO ^DIR

 +4        QUIT Y

 +5       ;

CHKP(RCNOW,RCPG,RCHR,RCRANGE,RCSCR,LINES) ;

 +1       ; Check if we need to do a page break

 +2       ;

 +3        IF $Y'>(IOSL-LINES)

               QUIT

 +4        IF RCSCR

               IF '$$PAUSE

                   SET RCPG=0

                   QUIT

 +5        DO HEADER(RCNOW,.RCPG,RCHR,RCRANGE)

 +6        QUIT

 +7       ;

SELERA()  ;

 +1       ; Lookup on the Electronic Remittance Advice (#344.4) file

 +2       ;

 +3        NEW DIC,X,Y,DTOUT,DUOUT

 +4        SET DIC="^RCY(344.4,"

           SET DIC(0)="QEAMn"

 +5        DO ^DIC

 +6        IF $GET(DTOUT)!$GET(DUOUT)!(Y=-1)

               QUIT 0

 +7        QUIT +Y

 +8       ;

DTRNG()   ;

 +1       ; Get the date range for the report

 +2       ;

 +3        NEW DIR,X,Y,DTOUT,DUOUT,DIROUT,DIRUT,BDATE

 +4        SET DIR("?")="ENTER THE EARLIEST AUDIT DATE TO INCLUDE ON THE REPORT"

 +5        SET DIR(0)="DA^:"_DT_":APE"

           SET DIR("A")="START DATE: "

           SET DIR("B")="T"

           DO ^DIR

 +6        IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               SET BDATE=-1

               QUIT 0

 +7        SET BDATE=Y

 +8        KILL DIR

 +9        SET DIR("?")="ENTER THE LATEST AUDIT DATE TO INCLUDE ON THE REPORT"

 +10       SET DIR("B")=Y(0)

 +11       SET DIR(0)="DA^"_BDATE_":"_DT_":APE"

           SET DIR("A")="END DATE: "

           SET DIR("B")="T"

           DO ^DIR

 +12       IF $DATA(DTOUT)!$DATA(DUOUT)!(Y="")

               QUIT 0

 +13       QUIT BDATE_"^"_Y

 +14      ;

STATUS(STATUS) ;

 +1       ; Convert internal status to external status

 +2        IF '$DATA(STATUS)

               QUIT ""

 +3        IF STATUS=""

               QUIT "NULL"

 +4        QUIT $$EXTERNAL^DILFD(344.4,4.02,,STATUS)

RCDPEAPS.m