Routine: RCDPEM4

RCDPEM4 ;OIFO-BAYPINES/PJH - EPAYMENTS AUDIT REPORTS ;Nov 17, 2014@17:00:41

 ;;4.5;Accounts Receivable;**276,284,298,304,321,326,332,432**;Mar 20, 1995;Build 16

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

EOB ; EEOB Move/Copy/Rmove Audit Report [RCDPE EEOB MOVE/COPY/RMOVE RPT]

 N RCRTYP S RCRTYP="EOB"  ; record type

 D ASKUSR

POST ; ERAs Posted with Paper EOB Audit Report [RCDPE ERA W/PAPER EOB REPORT]

 N RCRTYP S RCRTYP="ERA"  ; record type

 D ASKUSR

ASKUSR ;collect filter and device options

 Q:$G(RCRTYP)=""  ; must have record type

 N %ZIS,POP,RCACT,RCDISPTY,RCDIV,RCDTRNG,RCHDR,RCLSTMGR,RCLNCNT,RCPGNUM,RCPROG,RCSTA,RCSTOP

 N RCTMPND,RCTYPE,VAUTD,X,Y

 ; RCACT - selected actions for EOB

 ; RCDISPTY - display type

 ; RCDIV - selected divs.

 ; RCDTRNG - date range for report

 ; RCHDR - header array

 ; RCLSTMGR - ListMan output flag

 ; RCPGNUM - report page count

 ; RCPROG - ^TMP storage node for entries

 ; RCSTA - station

 ; RCSTOP - flag to stop report

 ; RCTMPND - ListMan storage node

 ; RCTYPE - Type of EEOBs to include M/P/T/C/A MEDICAL/PHARMACY/TRICARE/CHAMPVA/ALL

 S RCPROG=$T(+0),RCLSTMGR="",RCACT="",(RCLNCNT,RCSTOP)=0,RCTMPND=""

 ; S (RCXCLUDE("CHAMPVA"),RCXCLUDE("TRICARE"))=0  ; default to false

 ;Select Date Range for Report

 S RCDTRNG=$$DTRNG() G:'RCDTRNG EXIT

 ;Select Filter for Action Type (Move,Copy,Remove or All)

 I RCRTYP="EOB" S RCACT=$$ACTION G:RCACT<0 EXIT

 ;Select Filter/Sort by Division

 D STADIV G:'RCDIV EXIT

 ; Begin PRCA*4.5*326 Tricare filter

 S RCTYPE=$$RTYPE^RCDPEU1("A") I RCTYPE=-1 G EXIT

 ; Select Display Type , exit if indicated

 S RCDISPTY=$$DISPTY() G:RCDISPTY<0 EXIT

 ;Display capture information for Excel, set RCLSTMGR to prevent question

 I RCDISPTY D INFO^RCDPEM6 S RCLSTMGR="^"

 I RCLSTMGR="" S RCLSTMGR=$$ASKLM^RCDPEARL G:RCLSTMGR<0 EXIT

 I RCLSTMGR D  G EXIT

 .X "S RCTMPND=$T(+0)_U_$$HDR"_RCRTYP K ^TMP($J,RCTMPND)  ; ^TMP storage node, clean any residue

 .D RPRTCMPL

 .N H,L,HDR S L=0

 .X "S HDR(""TITLE"")=$$HDR"_RCRTYP

 .F H=1:1:7 I $D(RCHDR(H)) S L=H,HDR(H)=RCHDR(H)  ; take first 7 lines of report header

 .I $O(RCHDR(L)) D  ; any remaining header lines at top of report

 ..N N S N=0,H=L F  S H=$O(RCHDR(H)) Q:'H  S N=N+.001,^TMP($J,RCTMPND,N)=RCHDR(H)

 .; invoke ListMan

 .D LMRPT^RCDPEARL(.HDR,$NA(^TMP($J,RCTMPND))) ; generate ListMan display

 ;Select output device

 S %ZIS="QM" D ^%ZIS Q:POP

 ;Option to queue

 I 'RCDISPTY,$D(IO("Q")) D  Q

 .N ZTSK,ZTDESC,ZTSAVE,ZTQUEUED,ZTRTN

 .S ZTRTN="RPRTCMPL^RCDPEM4"

 .S ZTDESC="EDI LOCKBOX PAPER EOB AUDIT REPORT"

 .S ZTSAVE("RC*")="",ZTSAVE("VAUTD")=""

 .D ^%ZTLOAD

 .W !!,$S($G(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task."),!

 .K ZTSK,IO("Q") D HOME^%ZIS

 ;Compile and Print Report

 D RPRTCMPL

RPRTCMPL ;Compile and print report

 K ^TMP(RCPROG,$J),^TMP($J,"RC TOTAL")

 ;Scan ERA file for entries in date range

 I RCRTYP="ERA" D CMPLERA

 ;Scan EOB file for entries in date range

 I RCRTYP="EOB" D CMPLEOB

 ;Display Report

 D DISP

EXIT ;

 ;Clear old data

 K ^TMP(RCPROG,$J),^TMP($J,"RC TOTAL")

CMPLERA ;Generate the ERA posted with paper EOB report ^TMP array

 ; ^RCY(344.4,0) = ELECTRONIC REMITTANCE ADVICE^344.4I^

 N START,END,ERAIEN,STA,STNAM,STNUM

 ;Date Range

 S START=0,END="9999999",SUB=0

 S:$P(RCDTRNG,U) START=$P(RCDTRNG,U,2),END=$P(RCDTRNG,U,3)_".24" ; PRCA*4.5*326 allow for time at end of date range

 ;Selected division or All

 ;Scan AFL index for ERA within date range

 F  S START=$O(^RCY(344.4,"AFL",START)) Q:'START  Q:START>END  D

 .S ERAIEN=""

 .F  S ERAIEN=$O(^RCY(344.4,"AFL",START,ERAIEN)) Q:'ERAIEN  D

 ..;Ignore if not posted with paper EOB

 ..Q:'$D(^RCY(344.4,ERAIEN,7))

 ..;Check division

 ..D ERASTA(ERAIEN,.STA,.STNUM,.STNAM)

 ..I RCDIV=2,'$D(VAUTD(STA)) Q

 ..I '$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE) Q  ; PRCA*4.5*326 - M/P/T/A filter

..;

 ..D SVERA^RCDPEM41(ERAIEN,STA,STNUM,STNAM)

CMPLEOB ;Generate the EOB Moved/Copy/Remove report ^TMP array

 N DTSUB,START,END,EOBIEN,IEN101,STA,STNAM,STNUM

 ;Date Range

 S START=$P(RCDTRNG,U,2),END=$P(RCDTRNG,U,3)

 ;Selected division or All

 ;Scan AEOB index for EOB within date range

 F  S START=$O(^IBM(361.1,"AEOB",START)) Q:'START  Q:(START\1)>END  D

 .S EOBIEN=""

 .F  S EOBIEN=$O(^IBM(361.1,"AEOB",START,EOBIEN)) Q:'EOBIEN  D

 ..; Ignore if not MOVED/COPIED

 ..S IEN101="" F  S IEN101=$O(^IBM(361.1,"AEOB",START,EOBIEN,IEN101)) Q:'IEN101  D  ;

 ...; Check division

 ...D EOBSTA(EOBIEN,.STA,.STNUM,.STNAM)

 ...I RCDIV=2,'$D(VAUTD(STA)) Q

 ...I '$$ISTYPE^RCDPEU1(361.1,EOBIEN,RCTYPE) Q  ; PRCA*4.5*326 - M/P/T/A filter

 ...;

 ...;

 ...D SVEOB^RCDPEM41(EOBIEN,IEN101,STA,STNUM,STNAM)

DISP ; Format the display for screen/printer or MS Excel

 N DVFLTR,IEN,RCNTRY,SUB,Y

 ;Format Division Filter

 S DVFLTR=$S(RCRTYP="EOB":"ALL STATIONS/DIVISIONS",1:"ALL") I RCDIV=2 S DVFLTR=$$LINE(.VAUTD)

 D:'RCLSTMGR HDRBLD  ; Report header

 D:RCLSTMGR HDRLM  ; Listman header

 ; RCNTRY - entry from ^TMP(RCPROG,$J)

 U IO

 ; Display Header for first time

 D:'RCLSTMGR HDRLST^RCDPEARL(.RCSTOP,.RCHDR)

 ;Report by division or 'ALL'

 S SUB=0,RCSTOP=0

 F  S SUB=$O(^TMP(RCPROG,$J,SUB)) Q:SUB=""!RCSTOP  D

 .S IEN=0 F  S IEN=$O(^TMP(RCPROG,$J,SUB,IEN)) Q:'IEN!RCSTOP  S RCNTRY=^(IEN) D

 ..I RCDISPTY W !,RCNTRY Q  ; spreadsheet format

 ..I RCRTYP="ERA" D  ; ERA posted with paper EOB

 ...I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP

 ...S Y=$$PAD^RCDPEARL($P(RCNTRY,U,5),11)  ; ERA#

 ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,6),13) ;RECEIPT#

 ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,3),18) ;DATE/TIME

 ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,4),16) ;USER LASTNAME,FIRSTNAME

 ...S Y=Y_$P(RCNTRY,U,7) ;MATCH STATUS

 ...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 ...D SL^RCDPEARL($J("",61)_$P(RCNTRY,U,8),.RCLNCNT,RCTMPND) ;POST STATUS

..;

 ..I RCRTYP="EOB" D  ; EOB Moved/Copied

 ...I 'RCLSTMGR,$Y>(IOSL-RCHDR(0)) D HDRLST^RCDPEARL(.RCSTOP,.RCHDR) Q:RCSTOP

 ...S Y=$$PAD^RCDPEARL($P(RCNTRY,U,5),20) ; ORIGINAL BILL

 ...S Y=Y_$P(RCNTRY,U,8) ; TRACE #

 ...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 ...S Y=$$PAD^RCDPEARL($J("",6)_$P(RCNTRY,U,7),15) ;ERA

 ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,3),20) ;DATE/TIME

 ...S Y=Y_$$PAD^RCDPEARL($P(RCNTRY,U,12),15) ;MOVED/COPIED/REMOVED

 ...S Y=Y_$$PAD^RCDPEARL("$"_$P(RCNTRY,U,9),11) ;PAYMENT AMOUNT

 ...S Y=Y_$P(RCNTRY,U,4) ; USER LASTNAME,FIRSTNAME

 ...D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 ...D:$P(RCNTRY,U,12)'="REMOVED"

 ....S Y=$$PAD^RCDPEARL("New Bill: "_$P(RCNTRY,U,6),25) ;NEW BILL

 ....S Y=Y_"Other Bill Number(s): "_$P(RCNTRY,U,11) ;OTHER BILLS

 ....D SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 ...;

 ...D WP($P(RCNTRY,U,10))  ; Justification comments

 ...D SL^RCDPEARL("",.RCLNCNT,RCTMPND)  ; skip a line

.;

 .; end of report

 .I 'RCSTOP D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND),SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)

 D:'$D(^TMP(RCPROG,$J))

 .D SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)  ; skip line

 .D SL^RCDPEARL("     *** NO RECORDS TO PRINT ***",.RCLNCNT,RCTMPND)

 ;Close device

 I '$D(ZTQUEUED),'RCLSTMGR D ^%ZISC

 S:$D(ZTQUEUED) ZTREQ="@"

LINE(VAUTD) ;List selected stations

 N LINE,SUB

 S LINE="",SUB=""

 F  S SUB=$O(VAUTD(SUB)) Q:'SUB  D

 .S LINE=LINE_$G(VAUTD(SUB))_", "

 Q $E(LINE,1,$L(LINE)-2)

SELDIV(VAUTD,Z) ;Devisions are organized as Z(1)="DIV1,DIV2,..., Z(2)="DIVN,DIVN+1,... etc.

 ; Input:

 ;   VAUTD (required/pass-by-ref) - Division(s) array; result of call to DIVISION^VAUTOMA

 ; Output:

 ;   Z (required/pass-by-ref) - reformatted array of divisions

 N SUB,CNT

 S CNT=1,Z(CNT)="DIVISIONS: "

 I $D(VAUTD)=1 D  Q

 . S Z(CNT)=Z(CNT)_"ALL"

 .S Z(CNT)=$J("",80-$L(Z(CNT))\2)_Z(CNT)

 I $D(VAUTD)>1,'VAUTD D

 .S SUB=VAUTD

 .F  S SUB=$O(VAUTD(SUB)) Q:'SUB  D

 ..I Z(CNT)="DIVISIONS: " S Z(CNT)=Z(CNT)_VAUTD(SUB) Q

 ..S Z(CNT)=Z(CNT)_$S(Z(CNT)]"":",",1:"")_VAUTD(SUB)

 ..I $L(Z(CNT))>50 S Z(CNT)=$J("",80-$L(Z(CNT))\2)_Z(CNT),CNT=CNT+1,Z(CNT)=""

 I Z(CNT)]"" S Z(CNT)=$J("",80-$L(Z(CNT))\2)_Z(CNT)

 I Z(CNT)="" K Z(CNT)

HDRBLD ; create the report header

 ; returns RCHDR, RCPGNUM, RCSTOP

 ;   RCHDR(0) = header text line count

 ;   RCHDR("XECUTE") = M code for page number

 ;   RCHDR("RUNDATE") = date/time report generated, external format

 ;   RCPGNUM - page counter

 ;   RCSTOP - flag to exit

 ; INPUT:

 ;   RCDISPTY - Display/print/Excel flag

 ;   RCDTRNG - date range

 ;   RCRTYP - Report Type (EOB or ERA)

 ;   VAUTD

 K RCHDR S RCHDR("RUNDATE")=$$NOW^RCDPEARL,RCPGNUM=0,RCSTOP=0

 I RCDISPTY D  Q  ; Excel format, xecute code is QUIT, null page number

 .S RCHDR(0)=1,RCHDR(1)="^^^",RCHDR("XECUTE")="Q",RCPGNUM=""

 .S:RCRTYP="ERA" RCHDR(1)="STATION^STATION NUMBER^DATE/TIME^USER^ERA^RECEIPT^MATCH STATUS^POSTED STATUS"

 .S:RCRTYP="EOB" RCHDR(1)="STATION^STATION NUMBER^DATE/TIME^USER^ORIGINAL BILL^NEW BILL^ERA#^TRACE#^PAYMENT AMOUNT^JUSTIFICATION^OTHER BILLS^MOVED/COPIED"

 N START,END,MSG,DATE,Y,DIV,HCNT,J

 S START=$$FMTE^XLFDT($P(RCDTRNG,U,2),"2Z"),END=$$FMTE^XLFDT($P(RCDTRNG,U,3),"2Z"),HCNT=0

 S RCHDR(0)=0  ; header line count

 X "S Y=$$HDR"_RCRTYP S HCNT=1

 I RCRTYP="ERA" D

 .D HDRXEC(RCRTYP)  ; xecute code for line 1

 .S Y="Run Date/Time: "_RCHDR("RUNDATE")

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S Y="DIVISIONS: "_$S(VAUTD=1:"ALL",1:DVFLTR)

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S Y="Date Range: "_START_" - "_END_" (DATE ERA UPDATED)"

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .; PRCA*4.5*326

 .S Y="MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S HCNT=HCNT+1,RCHDR(HCNT)=""

 .S HCNT=HCNT+1,RCHDR(HCNT)="                        Date/Time         User Who        EFT Match Status"

 .S HCNT=HCNT+1,RCHDR(HCNT)="ERA #      Receipt #    ERA Updated       Updated             Detail Post Status"

 .S RCHDR(0)=HCNT  ; header line count

 I RCRTYP="EOB" D

 .D HDRXEC(RCRTYP)  ; xecute code for line 1

 .S Y="Run Date/Time: "_RCHDR("RUNDATE")

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S Y="Divisions: "_$S(VAUTD=1:"ALL",1:DVFLTR)

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S Y="Date Range: "_START_" - "_END_" (Date EEOB was Moved/Copied/Removed)"

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .; PRCA*4.5*326

 .S Y="MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S Y=" Action(s) Selected: "_$S(RCACT="M":"MOVE",RCACT="C":"COPY",RCACT="R":"REMOVE",1:"ALL")

 .S HCNT=HCNT+1,RCHDR(HCNT)=$J("",80-$L(Y)\2)_Y

 .S HCNT=HCNT+1,RCHDR(HCNT)=""

 .S HCNT=HCNT+1,RCHDR(HCNT)="Orig Bill#          Trace #"

 .S HCNT=HCNT+1,RCHDR(HCNT)="                                  Moved/Copied/   Total Amt  User Who Moved/"

 .S HCNT=HCNT+1,RCHDR(HCNT)="     ERA #     Date/Time          Removed         Paid       Copied/Removed"

 .S RCHDR(0)=HCNT  ; header line count

 ; add row of equal signs, not for ListMan

 S Y=RCHDR(0)+1,RCHDR(0)=Y,RCHDR(Y)=$TR($J("",80)," ","=")

HDRLM ; create the Listman header

 ; returns RCHDR

 ;   RCHDR(0) = header text line count

 ; INPUT:

 ;   RCDTRNG - date range

 ;   VAUTD - Division  filter value(s)

 N START,END,MSG,DATE,Y,DIV,HCNT,J

 S START=$$FMTE^XLFDT($P(RCDTRNG,U,2),"2Z"),END=$$FMTE^XLFDT($P(RCDTRNG,U,3),"2Z"),HCNT=0

 S RCHDR(0)=0  ; header line count

 X "S Y=$$HDR"_RCRTYP

 I RCRTYP="ERA" D

 .D HDRXEC(RCRTYP)  ; xecute code for line 1

 .S HCNT=1,RCHDR(HCNT)=""

 .S Y="Divisions: "_$S(VAUTD=1:"ALL",1:DVFLTR)_"     "

 .; PRCA*4.5*326

 .S Y=Y_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 .S HCNT=HCNT+1,RCHDR(HCNT)=Y

 .S HCNT=HCNT+1,RCHDR(HCNT)=""

 .S Y="Date Range: "_START_" - "_END_" (DATE ERA UPDATED)"

 .S HCNT=HCNT+1,RCHDR(HCNT)=Y

 .S HCNT=HCNT+1,RCHDR(HCNT)=""

 .S HCNT=HCNT+1,RCHDR(HCNT)="                        Date/Time         User Who        EFT Match Status"

 .S HCNT=HCNT+1,RCHDR(HCNT)="ERA #      Receipt #    ERA Updated       Updated             Detail Post Status"

 .S RCHDR(0)=HCNT  ; header line count

 I RCRTYP="EOB" D

 .D HDRXEC(RCRTYP)  ; xecute code for line 1

 .S Y="Divisions: "_$S(VAUTD=1:"ALL",1:DVFLTR)_"     "

 .; PRCA*4.5*326

 .S Y=Y_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 .S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 .S HCNT=1,RCHDR(HCNT)=Y

 .S Y="Date Range: "_START_" - "_END_" (Date EEOB was Moved/Copied/Removed)"

 .S HCNT=2,RCHDR(HCNT)=Y

 .S Y="Action(s) Selected: "_$S(RCACT="M":"MOVE",RCACT="C":"COPY",RCACT="R":"REMOVE",1:"ALL")

 .S HCNT=3,RCHDR(HCNT)=Y

 .S HCNT=4,RCHDR(HCNT)=""

 .S HCNT=5,RCHDR(HCNT)="Orig Bill#          Trace #"

 .S HCNT=6,RCHDR(HCNT)="                                  Moved/Copied/   Total Amt  User Who Moved/"

 .S HCNT=7,RCHDR(HCNT)="     ERA #     Date/Time          Removed         Paid       Copied/Removed"

 .S RCHDR(0)=HCNT  ; header line count

 ; add row of equal signs, not for ListMan

 S:'RCLSTMGR Y=RCHDR(0)+1,RCHDR(0)=Y,RCHDR(Y)=" "_$TR($J("",78)," ","=")

HDREOB() ; extrinsic variable, header for EOB report

 Q "EEOB Move/Copy/Remove - Audit Report"

HDRERA() ; extrinsic variable, header for ERA report

 Q "ERAs Posted with Paper EOB - Audit Report"

HDRXEC(TYP) ; create xecute code for header

 S RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDR"_TYP_"^"_$T(+0)_",RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"_"_""          Page: ""_RCPGNUM"

DTRNG() ; function, return date range for a report

 N DIR,DUOUT,X,Y,RCSTART,RCEND

 D DATES(.RCSTART,.RCEND)

 Q:RCSTART=-1 0

 Q:RCSTART "1^"_RCSTART_"^"_RCEND

 Q:'RCSTART "0^^"

Q 0

DATES(BDATE,EDATE) ;Get a date range.

 S (BDATE,EDATE)=0

 S DIR("?")="Enter the latest date of receipt of deposit to include on the report."

 S DIR(0)="DAO^:"_DT_":APE",DIR("A")="Start date: " D ^DIR K DIR

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

 S BDATE=Y

 S DIR("?")="Enter the latest date of receipt of deposit to include on the report."

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

 S DIR(0)="DAO^"_BDATE_":"_DT_":APE",DIR("A")="  End date: " D ^DIR K DIR

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

 S EDATE=Y

STADIV ;Division/Station Filter/Sort

 ;Sort selection

 N DIR,DUOUT,Y

 S RCDIV=0

 ;Division selection - IA 664

 ;RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD)

 D DIVISION^VAUTOMA Q:Y<0

 ;If ALL selected

 I VAUTD=1 S RCDIV=1 Q

 ;If some DIVISIONS selected

 S RCDIV=2

ACTION() ; Get action type

 N DIR,X,Y,DIROUT,DUOUT

 S DIR("A")="Move/Copy/Remove or All (M/C/R/A): "

 S DIR("B")="All"  ; default to ALL

 S DIR(0)="SAB^M:Move;C:Copy;R:Remove;A:All"

 D ^DIR Q:$G(DIROUT)!$G(DUOUT) -1

Q Y

DISPTY() ; Get display/output type

 N DIR,DTOUT,DUOUT,X,Y

 S DIR(0)="YA"

 S DIR("A")="Export the report to Microsoft Excel? "

 S DIR("B")="NO"

 D ^DIR I $G(DUOUT) Q -1

Q Y

ERASTA(ERAIEN,STA,STNUM,STNAM) ; Get the station for this ERA

 ; read allowed on BILL/CLAIMS file (#399) via IA 3820

 ; returns STA: station IEN, STNAM: station name, STNUM: station number

 N ERAEOB,ERABILL,STAIEN

 S (ERAEOB,ERABILL)=""

 S (STA,STNUM,STNAM)="UNKNOWN"

 .S ERAEOB=$P($G(^RCY(344.4,ERAIEN,1,1,0)),U,2) Q:'ERAEOB  ; if EOB pointer not on first sub-file entry then stop

 .S ERABILL=$P($G(^IBM(361.1,ERAEOB,0)),U,1) Q:'ERABILL  ; EXPLANATION OF BENEFITS file (#361.1)

 .S STAIEN=$P($G(^DGCR(399,ERABILL,0)),U,22) Q:'STAIEN  ;(#.22) DEFAULT DIVISION [22P:40.8]

 .S STA=STAIEN

 .S STNAM=$$EXTERNAL^DILFD(399,.22,,STA)

 .S STNUM=$P($G(^DG(40.8,STAIEN,0)),U,2) ;IA 417

EOBSTA(EOBIEN,STA,STNUM,STNAM) ; Get the station for this EOB

 ;Allowed read on 399 via IA 3820

 N BILL,STAIEN

 S (BILL)=""

 S (STA,STNUM,STNAM)="UNKNOWN"

 .S BILL=$P(^IBM(361.1,EOBIEN,0),U,1) Q:'BILL

 .S STAIEN=$P($G(^DGCR(399,BILL,0)),U,22) Q:'STAIEN

 .S STA=STAIEN

 .S STNAM=$$EXTERNAL^DILFD(399,.22,,STA)

 .S STNUM=$P($G(^DG(40.8,STAIEN,0)),U,2) ;IA 417

DTPRB() ; Get the Start Date type

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

 S DIR(0)="SABO^W:Date Removed from Worklist;R:Date ERA Received;B:Both Dates"

 S DIR("A")="Select Start Date Type: "

 D ^DIR K DIR

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

Q Y

WP(JC) ; format justification comments

 ; JC - Justification Comment

 I JC="" Q

 N PCS,I,CNTR,CMNT,Y

 ; PCS - Number of " " $pieces in the comment

 ; CNTR - CMNT line counter

 ; CMNT - comment text to be displayed

 S PCS=$L(JC," "),CNTR=1,CMNT(CNTR)=" Justification Comments: "

 F I=1:1:PCS D

 .S Y=$P(JC," ",I)

 .S:$L(CMNT(CNTR))+$L(Y)>72 CNTR=CNTR+1,CMNT(CNTR)=$J(" ",25)

 .S CMNT(CNTR)=CMNT(CNTR)_" "_Y

 F I=1:1:CNTR D SL^RCDPEARL(CMNT(I),.RCLNCNT,RCTMPND)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM4   17142     printed  Feb 18, 2025@23:11:11                                                                                                                                                                                                    Page 2

RCDPEM4   ;OIFO-BAYPINES/PJH - EPAYMENTS AUDIT REPORTS ;Nov 17, 2014@17:00:41

 +1       ;;4.5;Accounts Receivable;**276,284,298,304,321,326,332,432**;Mar 20, 1995;Build 16

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

 +3       ;

EOB       ; EEOB Move/Copy/Rmove Audit Report [RCDPE EEOB MOVE/COPY/RMOVE RPT]

 +1       ; record type

           NEW RCRTYP

           SET RCRTYP="EOB"

 +2        DO ASKUSR

 +3        QUIT

 +4       ;

POST      ; ERAs Posted with Paper EOB Audit Report [RCDPE ERA W/PAPER EOB REPORT]

 +1       ; record type

           NEW RCRTYP

           SET RCRTYP="ERA"

 +2        DO ASKUSR

 +3        QUIT

 +4       ;

ASKUSR    ;collect filter and device options

 +1       ; must have record type

           if $GET(RCRTYP)=""

               QUIT

 +2        NEW %ZIS,POP,RCACT,RCDISPTY,RCDIV,RCDTRNG,RCHDR,RCLSTMGR,RCLNCNT,RCPGNUM,RCPROG,RCSTA,RCSTOP

 +3        NEW RCTMPND,RCTYPE,VAUTD,X,Y

 +4       ; RCACT - selected actions for EOB

 +5       ; RCDISPTY - display type

 +6       ; RCDIV - selected divs.

 +7       ; RCDTRNG - date range for report

 +8       ; RCHDR - header array

 +9       ; RCLSTMGR - ListMan output flag

 +10      ; RCPGNUM - report page count

 +11      ; RCPROG - ^TMP storage node for entries

 +12      ; RCSTA - station

 +13      ; RCSTOP - flag to stop report

 +14      ; RCTMPND - ListMan storage node

 +15      ; RCTYPE - Type of EEOBs to include M/P/T/C/A MEDICAL/PHARMACY/TRICARE/CHAMPVA/ALL

 +16      ;

 +17       SET RCPROG=$TEXT(+0)

           SET RCLSTMGR=""

           SET RCACT=""

           SET (RCLNCNT,RCSTOP)=0

           SET RCTMPND=""

 +18      ; S (RCXCLUDE("CHAMPVA"),RCXCLUDE("TRICARE"))=0  ; default to false

 +19      ;Select Date Range for Report

 +20       SET RCDTRNG=$$DTRNG()

           if 'RCDTRNG

               GOTO EXIT

 +21      ;Select Filter for Action Type (Move,Copy,Remove or All)

 +22       IF RCRTYP="EOB"

               SET RCACT=$$ACTION

               if RCACT<0

                   GOTO EXIT

 +23      ;Select Filter/Sort by Division

 +24       DO STADIV

           if 'RCDIV

               GOTO EXIT

 +25      ; Begin PRCA*4.5*326 Tricare filter

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

           IF RCTYPE=-1

               GOTO EXIT

 +27      ;

 +28      ; Select Display Type , exit if indicated

 +29       SET RCDISPTY=$$DISPTY()

           if RCDISPTY<0

               GOTO EXIT

 +30      ;Display capture information for Excel, set RCLSTMGR to prevent question

 +31       IF RCDISPTY

               DO INFO^RCDPEM6

               SET RCLSTMGR="^"

 +32       IF RCLSTMGR=""

               SET RCLSTMGR=$$ASKLM^RCDPEARL

               if RCLSTMGR<0

                   GOTO EXIT

 +33       IF RCLSTMGR

               Begin DoDot:1

 +34      ; ^TMP storage node, clean any residue

                   XECUTE "S RCTMPND=$T(+0)_U_$$HDR"_RCRTYP

                   KILL ^TMP($JOB,RCTMPND)

 +35               DO RPRTCMPL

 +36               NEW H,L,HDR

                   SET L=0

 +37               XECUTE "S HDR(""TITLE"")=$$HDR"_RCRTYP

 +38      ; take first 7 lines of report header

                   FOR H=1:1:7

                       IF $DATA(RCHDR(H))

                           SET L=H

                           SET HDR(H)=RCHDR(H)

 +39      ; any remaining header lines at top of report

                   IF $ORDER(RCHDR(L))

                       Begin DoDot:2

 +40                       NEW N

                           SET N=0

                           SET H=L

FOR

                               SET H=$ORDER(RCHDR(H))

                               if 'H

                                   QUIT

                               SET N=N+.001

                               SET ^TMP($JOB,RCTMPND,N)=RCHDR(H)

                       End DoDot:2

 +41      ; invoke ListMan

 +42      ; generate ListMan display

                   DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP($JOB,RCTMPND)))

               End DoDot:1

               GOTO EXIT

 +43      ;

 +44      ;Select output device

 +45       SET %ZIS="QM"

           DO ^%ZIS

           if POP

               QUIT

 +46      ;Option to queue

 +47       IF 'RCDISPTY

               IF $DATA(IO("Q"))

                   Begin DoDot:1

 +48                   NEW ZTSK,ZTDESC,ZTSAVE,ZTQUEUED,ZTRTN

 +49                   SET ZTRTN="RPRTCMPL^RCDPEM4"

 +50                   SET ZTDESC="EDI LOCKBOX PAPER EOB AUDIT REPORT"

 +51                   SET ZTSAVE("RC*")=""

                       SET ZTSAVE("VAUTD")=""

 +52                   DO ^%ZTLOAD

 +53                   WRITE !!,$SELECT($GET(ZTSK):"Task number "_ZTSK_" was queued.",1:"Unable to queue this task."),!

 +54                   KILL ZTSK,IO("Q")

                       DO HOME^%ZIS

                   End DoDot:1

                   QUIT

 +55      ;

 +56      ;Compile and Print Report

 +57       DO RPRTCMPL

 +58       QUIT

 +59      ;

RPRTCMPL  ;Compile and print report

 +1        KILL ^TMP(RCPROG,$JOB),^TMP($JOB,"RC TOTAL")

 +2       ;Scan ERA file for entries in date range

 +3        IF RCRTYP="ERA"

               DO CMPLERA

 +4       ;Scan EOB file for entries in date range

 +5        IF RCRTYP="EOB"

               DO CMPLEOB

 +6       ;Display Report

 +7        DO DISP

 +8       ;

EXIT      ;

 +1       ;Clear old data

 +2        KILL ^TMP(RCPROG,$JOB),^TMP($JOB,"RC TOTAL")

 +3        QUIT

 +4       ;

CMPLERA   ;Generate the ERA posted with paper EOB report ^TMP array

 +1       ; ^RCY(344.4,0) = ELECTRONIC REMITTANCE ADVICE^344.4I^

 +2        NEW START,END,ERAIEN,STA,STNAM,STNUM

 +3       ;Date Range

 +4        SET START=0

           SET END="9999999"

           SET SUB=0

 +5       ; PRCA*4.5*326 allow for time at end of date range

           if $PIECE(RCDTRNG,U)

               SET START=$PIECE(RCDTRNG,U,2)

               SET END=$PIECE(RCDTRNG,U,3)_".24"

 +6       ;Selected division or All

 +7       ;Scan AFL index for ERA within date range

 +8        FOR

               SET START=$ORDER(^RCY(344.4,"AFL",START))

               if 'START

                   QUIT

               if START>END

                   QUIT

               Begin DoDot:1

 +9                SET ERAIEN=""

 +10               FOR

                       SET ERAIEN=$ORDER(^RCY(344.4,"AFL",START,ERAIEN))

                       if 'ERAIEN

                           QUIT

                       Begin DoDot:2

 +11      ;Ignore if not posted with paper EOB

 +12                       if '$DATA(^RCY(344.4,ERAIEN,7))

                               QUIT

 +13      ;Check division

 +14                       DO ERASTA(ERAIEN,.STA,.STNUM,.STNAM)

 +15                       IF RCDIV=2

                               IF '$DATA(VAUTD(STA))

                                   QUIT

 +16      ; PRCA*4.5*326 - M/P/T/A filter

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

                               QUIT

 +17      ;

 +18                       DO SVERA^RCDPEM41(ERAIEN,STA,STNUM,STNAM)

                       End DoDot:2

               End DoDot:1

 +19      ;

 +20       QUIT

 +21      ;

CMPLEOB   ;Generate the EOB Moved/Copy/Remove report ^TMP array

 +1        NEW DTSUB,START,END,EOBIEN,IEN101,STA,STNAM,STNUM

 +2       ;Date Range

 +3        SET START=$PIECE(RCDTRNG,U,2)

           SET END=$PIECE(RCDTRNG,U,3)

 +4       ;Selected division or All

 +5       ;Scan AEOB index for EOB within date range

 +6        FOR

               SET START=$ORDER(^IBM(361.1,"AEOB",START))

               if 'START

                   QUIT

               if (START\1)>END

                   QUIT

               Begin DoDot:1

 +7                SET EOBIEN=""

 +8                FOR

                       SET EOBIEN=$ORDER(^IBM(361.1,"AEOB",START,EOBIEN))

                       if 'EOBIEN

                           QUIT

                       Begin DoDot:2

 +9       ; Ignore if not MOVED/COPIED

 +10      ;

                           SET IEN101=""

FOR

                               SET IEN101=$ORDER(^IBM(361.1,"AEOB",START,EOBIEN,IEN101))

                               if 'IEN101

                                   QUIT

                               Begin DoDot:3

 +11      ; Check division

 +12                               DO EOBSTA(EOBIEN,.STA,.STNUM,.STNAM)

 +13                               IF RCDIV=2

                                       IF '$DATA(VAUTD(STA))

                                           QUIT

 +14      ; PRCA*4.5*326 - M/P/T/A filter

                                   IF '$$ISTYPE^RCDPEU1(361.1,EOBIEN,RCTYPE)

                                       QUIT

 +15      ;

 +16      ;

 +17                               DO SVEOB^RCDPEM41(EOBIEN,IEN101,STA,STNUM,STNAM)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +18      ;

 +19       QUIT

 +20      ;

DISP      ; Format the display for screen/printer or MS Excel

 +1        NEW DVFLTR,IEN,RCNTRY,SUB,Y

 +2       ;Format Division Filter

 +3        SET DVFLTR=$SELECT(RCRTYP="EOB":"ALL STATIONS/DIVISIONS",1:"ALL")

           IF RCDIV=2

               SET DVFLTR=$$LINE(.VAUTD)

 +4       ; Report header

           if 'RCLSTMGR

               DO HDRBLD

 +5       ; Listman header

           if RCLSTMGR

               DO HDRLM

 +6       ; RCNTRY - entry from ^TMP(RCPROG,$J)

 +7       ;

 +8        USE IO

 +9       ;

 +10      ; Display Header for first time

 +11       if 'RCLSTMGR

               DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)

 +12      ;Report by division or 'ALL'

 +13       SET SUB=0

           SET RCSTOP=0

 +14       FOR

               SET SUB=$ORDER(^TMP(RCPROG,$JOB,SUB))

               if SUB=""!RCSTOP

                   QUIT

               Begin DoDot:1

 +15               SET IEN=0

FOR

                       SET IEN=$ORDER(^TMP(RCPROG,$JOB,SUB,IEN))

                       if 'IEN!RCSTOP

                           QUIT

                       SET RCNTRY=^(IEN)

                       Begin DoDot:2

 +16      ; spreadsheet format

                           IF RCDISPTY

                               WRITE !,RCNTRY

                               QUIT

 +17      ; ERA posted with paper EOB

                           IF RCRTYP="ERA"

                               Begin DoDot:3

 +18                               IF 'RCLSTMGR

                                       IF $Y>(IOSL-RCHDR(0))

                                           DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)

                                           if RCSTOP

                                               QUIT

 +19      ; ERA#

                                   SET Y=$$PAD^RCDPEARL($PIECE(RCNTRY,U,5),11)

 +20      ;RECEIPT#

                                   SET Y=Y_$$PAD^RCDPEARL($PIECE(RCNTRY,U,6),13)

 +21      ;DATE/TIME

                                   SET Y=Y_$$PAD^RCDPEARL($PIECE(RCNTRY,U,3),18)

 +22      ;USER LASTNAME,FIRSTNAME

                                   SET Y=Y_$$PAD^RCDPEARL($PIECE(RCNTRY,U,4),16)

 +23      ;MATCH STATUS

                                   SET Y=Y_$PIECE(RCNTRY,U,7)

 +24                               DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 +25      ;POST STATUS

                                   DO SL^RCDPEARL($JUSTIFY("",61)_$PIECE(RCNTRY,U,8),.RCLNCNT,RCTMPND)

                               End DoDot:3

 +26      ;

 +27      ; EOB Moved/Copied

                           IF RCRTYP="EOB"

                               Begin DoDot:3

 +28                               IF 'RCLSTMGR

                                       IF $Y>(IOSL-RCHDR(0))

                                           DO HDRLST^RCDPEARL(.RCSTOP,.RCHDR)

                                           if RCSTOP

                                               QUIT

 +29      ; ORIGINAL BILL

                                   SET Y=$$PAD^RCDPEARL($PIECE(RCNTRY,U,5),20)

 +30      ; TRACE #

                                   SET Y=Y_$PIECE(RCNTRY,U,8)

 +31                               DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 +32      ;ERA

                                   SET Y=$$PAD^RCDPEARL($JUSTIFY("",6)_$PIECE(RCNTRY,U,7),15)

 +33      ;DATE/TIME

                                   SET Y=Y_$$PAD^RCDPEARL($PIECE(RCNTRY,U,3),20)

 +34      ;MOVED/COPIED/REMOVED

                                   SET Y=Y_$$PAD^RCDPEARL($PIECE(RCNTRY,U,12),15)

 +35      ;PAYMENT AMOUNT

                                   SET Y=Y_$$PAD^RCDPEARL("$"_$PIECE(RCNTRY,U,9),11)

 +36      ; USER LASTNAME,FIRSTNAME

                                   SET Y=Y_$PIECE(RCNTRY,U,4)

 +37                               DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

 +38                               if $PIECE(RCNTRY,U,12)'="REMOVED"

                                       Begin DoDot:4

 +39      ;NEW BILL

                                           SET Y=$$PAD^RCDPEARL("New Bill: "_$PIECE(RCNTRY,U,6),25)

 +40      ;OTHER BILLS

                                           SET Y=Y_"Other Bill Number(s): "_$PIECE(RCNTRY,U,11)

 +41                                       DO SL^RCDPEARL(Y,.RCLNCNT,RCTMPND)

                                       End DoDot:4

 +42      ;

 +43      ; Justification comments

                                   DO WP($PIECE(RCNTRY,U,10))

 +44      ; skip a line

                                   DO SL^RCDPEARL("",.RCLNCNT,RCTMPND)

                               End DoDot:3

                       End DoDot:2

 +45      ;

 +46      ; end of report

 +47               IF 'RCSTOP

                       DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)

                       DO SL^RCDPEARL($$ENDORPRT^RCDPEARL,.RCLNCNT,RCTMPND)

               End DoDot:1

 +48      ;

 +49       if '$DATA(^TMP(RCPROG,$JOB))

               Begin DoDot:1

 +50      ; skip line

                   DO SL^RCDPEARL(" ",.RCLNCNT,RCTMPND)

 +51               DO SL^RCDPEARL("     *** NO RECORDS TO PRINT ***",.RCLNCNT,RCTMPND)

               End DoDot:1

 +52      ;

 +53      ;Close device

 +54       IF '$DATA(ZTQUEUED)

               IF 'RCLSTMGR

                   DO ^%ZISC

 +55       if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +56       QUIT

 +57      ;

LINE(VAUTD) ;List selected stations

 +1        NEW LINE,SUB

 +2        SET LINE=""

           SET SUB=""

 +3        FOR

               SET SUB=$ORDER(VAUTD(SUB))

               if 'SUB

                   QUIT

               Begin DoDot:1

 +4                SET LINE=LINE_$GET(VAUTD(SUB))_", "

               End DoDot:1

 +5        QUIT $EXTRACT(LINE,1,$LENGTH(LINE)-2)

 +6       ;

SELDIV(VAUTD,Z) ;Devisions are organized as Z(1)="DIV1,DIV2,..., Z(2)="DIVN,DIVN+1,... etc.

 +1       ; Input:

 +2       ;   VAUTD (required/pass-by-ref) - Division(s) array; result of call to DIVISION^VAUTOMA

 +3       ; Output:

 +4       ;   Z (required/pass-by-ref) - reformatted array of divisions

 +5       ;

 +6        NEW SUB,CNT

 +7        SET CNT=1

           SET Z(CNT)="DIVISIONS: "

 +8        IF $DATA(VAUTD)=1

               Begin DoDot:1

 +9                SET Z(CNT)=Z(CNT)_"ALL"

 +10               SET Z(CNT)=$JUSTIFY("",80-$LENGTH(Z(CNT))\2)_Z(CNT)

               End DoDot:1

               QUIT

 +11       IF $DATA(VAUTD)>1

               IF 'VAUTD

                   Begin DoDot:1

 +12                   SET SUB=VAUTD

 +13                   FOR

                           SET SUB=$ORDER(VAUTD(SUB))

                           if 'SUB

                               QUIT

                           Begin DoDot:2

 +14                           IF Z(CNT)="DIVISIONS: "

                                   SET Z(CNT)=Z(CNT)_VAUTD(SUB)

                                   QUIT

 +15                           SET Z(CNT)=Z(CNT)_$SELECT(Z(CNT)]"":",",1:"")_VAUTD(SUB)

 +16                           IF $LENGTH(Z(CNT))>50

                                   SET Z(CNT)=$JUSTIFY("",80-$LENGTH(Z(CNT))\2)_Z(CNT)

                                   SET CNT=CNT+1

                                   SET Z(CNT)=""

                           End DoDot:2

                   End DoDot:1

 +17      ;

 +18       IF Z(CNT)]""

               SET Z(CNT)=$JUSTIFY("",80-$LENGTH(Z(CNT))\2)_Z(CNT)

 +19       IF Z(CNT)=""

               KILL Z(CNT)

 +20       QUIT

 +21      ;

HDRBLD    ; create the report header

 +1       ; returns RCHDR, RCPGNUM, RCSTOP

 +2       ;   RCHDR(0) = header text line count

 +3       ;   RCHDR("XECUTE") = M code for page number

 +4       ;   RCHDR("RUNDATE") = date/time report generated, external format

 +5       ;   RCPGNUM - page counter

 +6       ;   RCSTOP - flag to exit

 +7       ; INPUT:

 +8       ;   RCDISPTY - Display/print/Excel flag

 +9       ;   RCDTRNG - date range

 +10      ;   RCRTYP - Report Type (EOB or ERA)

 +11      ;   VAUTD

 +12       KILL RCHDR

           SET RCHDR("RUNDATE")=$$NOW^RCDPEARL

           SET RCPGNUM=0

           SET RCSTOP=0

 +13      ;

 +14      ; Excel format, xecute code is QUIT, null page number

           IF RCDISPTY

               Begin DoDot:1

 +15               SET RCHDR(0)=1

                   SET RCHDR(1)="^^^"

                   SET RCHDR("XECUTE")="Q"

                   SET RCPGNUM=""

 +16               if RCRTYP="ERA"

                       SET RCHDR(1)="STATION^STATION NUMBER^DATE/TIME^USER^ERA^RECEIPT^MATCH STATUS^POSTED STATUS"

 +17               if RCRTYP="EOB"

                       SET RCHDR(1)="STATION^STATION NUMBER^DATE/TIME^USER^ORIGINAL BILL^NEW BILL^ERA#^TRACE#^PAYMENT AMOUNT^JUSTIFICATION^OTHER BILLS^MOVED/COPIED"

               End DoDot:1

               QUIT

 +18      ;

 +19       NEW START,END,MSG,DATE,Y,DIV,HCNT,J

 +20       SET START=$$FMTE^XLFDT($PIECE(RCDTRNG,U,2),"2Z")

           SET END=$$FMTE^XLFDT($PIECE(RCDTRNG,U,3),"2Z")

           SET HCNT=0

 +21      ;

 +22      ; header line count

           SET RCHDR(0)=0

 +23       XECUTE "S Y=$$HDR"_RCRTYP

           SET HCNT=1

 +24      ;

 +25       IF RCRTYP="ERA"

               Begin DoDot:1

 +26      ; xecute code for line 1

                   DO HDRXEC(RCRTYP)

 +27               SET Y="Run Date/Time: "_RCHDR("RUNDATE")

 +28               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +29               SET Y="DIVISIONS: "_$SELECT(VAUTD=1:"ALL",1:DVFLTR)

 +30               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +31               SET Y="Date Range: "_START_" - "_END_" (DATE ERA UPDATED)"

 +32               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +33      ; PRCA*4.5*326

 +34               SET Y="MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 +35               SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 +36               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +37               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=""

 +38               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="                        Date/Time         User Who        EFT Match Status"

 +39               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="ERA #      Receipt #    ERA Updated       Updated             Detail Post Status"

 +40      ; header line count

                   SET RCHDR(0)=HCNT

               End DoDot:1

 +41      ;

 +42       IF RCRTYP="EOB"

               Begin DoDot:1

 +43      ; xecute code for line 1

                   DO HDRXEC(RCRTYP)

 +44               SET Y="Run Date/Time: "_RCHDR("RUNDATE")

 +45               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +46               SET Y="Divisions: "_$SELECT(VAUTD=1:"ALL",1:DVFLTR)

 +47               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +48               SET Y="Date Range: "_START_" - "_END_" (Date EEOB was Moved/Copied/Removed)"

 +49               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +50      ; PRCA*4.5*326

 +51               SET Y="MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 +52               SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 +53               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +54               SET Y=" Action(s) Selected: "_$SELECT(RCACT="M":"MOVE",RCACT="C":"COPY",RCACT="R":"REMOVE",1:"ALL")

 +55               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=$JUSTIFY("",80-$LENGTH(Y)\2)_Y

 +56               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=""

 +57               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="Orig Bill#          Trace #"

 +58               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="                                  Moved/Copied/   Total Amt  User Who Moved/"

 +59               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="     ERA #     Date/Time          Removed         Paid       Copied/Removed"

 +60      ; header line count

                   SET RCHDR(0)=HCNT

               End DoDot:1

 +61      ;

 +62      ; add row of equal signs, not for ListMan

 +63       SET Y=RCHDR(0)+1

           SET RCHDR(0)=Y

           SET RCHDR(Y)=$TRANSLATE($JUSTIFY("",80)," ","=")

 +64       QUIT

 +65      ;

HDRLM     ; create the Listman header

 +1       ; returns RCHDR

 +2       ;   RCHDR(0) = header text line count

 +3       ; INPUT:

 +4       ;   RCDTRNG - date range

 +5       ;   VAUTD - Division  filter value(s)

 +6        NEW START,END,MSG,DATE,Y,DIV,HCNT,J

 +7        SET START=$$FMTE^XLFDT($PIECE(RCDTRNG,U,2),"2Z")

           SET END=$$FMTE^XLFDT($PIECE(RCDTRNG,U,3),"2Z")

           SET HCNT=0

 +8       ;

 +9       ; header line count

           SET RCHDR(0)=0

 +10       XECUTE "S Y=$$HDR"_RCRTYP

 +11       IF RCRTYP="ERA"

               Begin DoDot:1

 +12      ; xecute code for line 1

                   DO HDRXEC(RCRTYP)

 +13               SET HCNT=1

                   SET RCHDR(HCNT)=""

 +14               SET Y="Divisions: "_$SELECT(VAUTD=1:"ALL",1:DVFLTR)_"     "

 +15      ; PRCA*4.5*326

 +16               SET Y=Y_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 +17               SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 +18               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=Y

 +19               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=""

 +20               SET Y="Date Range: "_START_" - "_END_" (DATE ERA UPDATED)"

 +21               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=Y

 +22               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)=""

 +23               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="                        Date/Time         User Who        EFT Match Status"

 +24               SET HCNT=HCNT+1

                   SET RCHDR(HCNT)="ERA #      Receipt #    ERA Updated       Updated             Detail Post Status"

 +25      ; header line count

                   SET RCHDR(0)=HCNT

               End DoDot:1

 +26      ;

 +27       IF RCRTYP="EOB"

               Begin DoDot:1

 +28      ; xecute code for line 1

                   DO HDRXEC(RCRTYP)

 +29               SET Y="Divisions: "_$SELECT(VAUTD=1:"ALL",1:DVFLTR)_"     "

 +30      ; PRCA*4.5*326

 +31               SET Y=Y_"MEDICAL/PHARMACY/TRICARE/CHAMPVA: "

 +32               SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",RCTYPE="C":"CHAMPVA",1:"ALL")

 +33               SET HCNT=1

                   SET RCHDR(HCNT)=Y

 +34               SET Y="Date Range: "_START_" - "_END_" (Date EEOB was Moved/Copied/Removed)"

 +35               SET HCNT=2

                   SET RCHDR(HCNT)=Y

 +36               SET Y="Action(s) Selected: "_$SELECT(RCACT="M":"MOVE",RCACT="C":"COPY",RCACT="R":"REMOVE",1:"ALL")

 +37               SET HCNT=3

                   SET RCHDR(HCNT)=Y

 +38               SET HCNT=4

                   SET RCHDR(HCNT)=""

 +39               SET HCNT=5

                   SET RCHDR(HCNT)="Orig Bill#          Trace #"

 +40               SET HCNT=6

                   SET RCHDR(HCNT)="                                  Moved/Copied/   Total Amt  User Who Moved/"

 +41               SET HCNT=7

                   SET RCHDR(HCNT)="     ERA #     Date/Time          Removed         Paid       Copied/Removed"

 +42      ; header line count

                   SET RCHDR(0)=HCNT

               End DoDot:1

 +43      ;

 +44      ; add row of equal signs, not for ListMan

 +45       if 'RCLSTMGR

               SET Y=RCHDR(0)+1

               SET RCHDR(0)=Y

               SET RCHDR(Y)=" "_$TRANSLATE($JUSTIFY("",78)," ","=")

 +46       QUIT

 +47      ;

HDREOB()  ; extrinsic variable, header for EOB report

 +1        QUIT "EEOB Move/Copy/Remove - Audit Report"

 +2       ;

HDRERA()  ; extrinsic variable, header for ERA report

 +1        QUIT "ERAs Posted with Paper EOB - Audit Report"

 +2       ;

HDRXEC(TYP) ; create xecute code for header

 +1        SET RCHDR("XECUTE")="N Y S RCPGNUM=RCPGNUM+1,Y=$$HDR"_TYP_"^"_$TEXT(+0)_",RCHDR(1)=$J("" "",80-$L(Y)\2)_Y"_"_""          Page: ""_RCPGNUM"

 +2        QUIT

 +3       ;

DTRNG()   ; function, return date range for a report

 +1        NEW DIR,DUOUT,X,Y,RCSTART,RCEND

 +2        DO DATES(.RCSTART,.RCEND)

 +3        if RCSTART=-1

               QUIT 0

 +4        if RCSTART

               QUIT "1^"_RCSTART_"^"_RCEND

 +5        if 'RCSTART

               QUIT "0^^"

 +6        QUIT 0

 +7       ;

DATES(BDATE,EDATE) ;Get a date range.

 +1        SET (BDATE,EDATE)=0

 +2        SET DIR("?")="Enter the latest date of receipt of deposit to include on the report."

 +3        SET DIR(0)="DAO^:"_DT_":APE"

           SET DIR("A")="Start date: "

           DO ^DIR

           KILL DIR

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

               SET BDATE=-1

               QUIT

 +5        SET BDATE=Y

 +6        SET DIR("?")="Enter the latest date of receipt of deposit to include on the report."

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

 +8        SET DIR(0)="DAO^"_BDATE_":"_DT_":APE"

           SET DIR("A")="  End date: "

           DO ^DIR

           KILL DIR

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

               SET BDATE=-1

               QUIT

 +10       SET EDATE=Y

 +11       QUIT

 +12      ;

STADIV    ;Division/Station Filter/Sort

 +1       ;

 +2       ;Sort selection

 +3        NEW DIR,DUOUT,Y

 +4        SET RCDIV=0

 +5       ;

 +6       ;Division selection - IA 664

 +7       ;RETURNS Y=-1 (quit), VAUTD=1 (for all),VAUTD=0 (selected divisions in VAUTD)

 +8        DO DIVISION^VAUTOMA

           if Y<0

               QUIT

 +9       ;

 +10      ;If ALL selected

 +11       IF VAUTD=1

               SET RCDIV=1

               QUIT

 +12      ;If some DIVISIONS selected

 +13       SET RCDIV=2

 +14       QUIT

 +15      ;

ACTION()  ; Get action type

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

 +2        SET DIR("A")="Move/Copy/Remove or All (M/C/R/A): "

 +3       ; default to ALL

           SET DIR("B")="All"

 +4        SET DIR(0)="SAB^M:Move;C:Copy;R:Remove;A:All"

 +5        DO ^DIR

           if $GET(DIROUT)!$GET(DUOUT)

               QUIT -1

 +6       ;

 +7        QUIT Y

 +8       ;

DISPTY()  ; Get display/output type

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

 +2        SET DIR(0)="YA"

 +3        SET DIR("A")="Export the report to Microsoft Excel? "

 +4        SET DIR("B")="NO"

 +5        DO ^DIR

           IF $GET(DUOUT)

               QUIT -1

 +6        QUIT Y

 +7       ;

ERASTA(ERAIEN,STA,STNUM,STNAM) ; Get the station for this ERA

 +1       ; read allowed on BILL/CLAIMS file (#399) via IA 3820

 +2       ; returns STA: station IEN, STNAM: station name, STNUM: station number

 +3        NEW ERAEOB,ERABILL,STAIEN

 +4        SET (ERAEOB,ERABILL)=""

 +5        SET (STA,STNUM,STNAM)="UNKNOWN"

 +6        Begin DoDot:1

 +7       ; if EOB pointer not on first sub-file entry then stop

               SET ERAEOB=$PIECE($GET(^RCY(344.4,ERAIEN,1,1,0)),U,2)

               if 'ERAEOB

                   QUIT

 +8       ; EXPLANATION OF BENEFITS file (#361.1)

               SET ERABILL=$PIECE($GET(^IBM(361.1,ERAEOB,0)),U,1)

               if 'ERABILL

                   QUIT

 +9       ;(#.22) DEFAULT DIVISION [22P:40.8]

               SET STAIEN=$PIECE($GET(^DGCR(399,ERABILL,0)),U,22)

               if 'STAIEN

                   QUIT

 +10           SET STA=STAIEN

 +11           SET STNAM=$$EXTERNAL^DILFD(399,.22,,STA)

 +12      ;IA 417

               SET STNUM=$PIECE($GET(^DG(40.8,STAIEN,0)),U,2)

           End DoDot:1

 +13      ;

 +14       QUIT

 +15      ;

EOBSTA(EOBIEN,STA,STNUM,STNAM) ; Get the station for this EOB

 +1       ;Allowed read on 399 via IA 3820

 +2        NEW BILL,STAIEN

 +3        SET (BILL)=""

 +4        SET (STA,STNUM,STNAM)="UNKNOWN"

 +5        Begin DoDot:1

 +6            SET BILL=$PIECE(^IBM(361.1,EOBIEN,0),U,1)

               if 'BILL

                   QUIT

 +7            SET STAIEN=$PIECE($GET(^DGCR(399,BILL,0)),U,22)

               if 'STAIEN

                   QUIT

 +8            SET STA=STAIEN

 +9            SET STNAM=$$EXTERNAL^DILFD(399,.22,,STA)

 +10      ;IA 417

               SET STNUM=$PIECE($GET(^DG(40.8,STAIEN,0)),U,2)

           End DoDot:1

 +11       QUIT

 +12      ;

DTPRB()   ; Get the Start Date type

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

 +2        SET DIR(0)="SABO^W:Date Removed from Worklist;R:Date ERA Received;B:Both Dates"

 +3        SET DIR("A")="Select Start Date Type: "

 +4        DO ^DIR

           KILL DIR

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

               SET Y=0

 +6        QUIT Y

 +7       ;

WP(JC)    ; format justification comments

 +1       ; JC - Justification Comment

 +2        IF JC=""

               QUIT

 +3        NEW PCS,I,CNTR,CMNT,Y

 +4       ; PCS - Number of " " $pieces in the comment

 +5       ; CNTR - CMNT line counter

 +6       ; CMNT - comment text to be displayed

 +7        SET PCS=$LENGTH(JC," ")

           SET CNTR=1

           SET CMNT(CNTR)=" Justification Comments: "

 +8        FOR I=1:1:PCS

               Begin DoDot:1

 +9                SET Y=$PIECE(JC," ",I)

 +10               if $LENGTH(CMNT(CNTR))+$LENGTH(Y)>72

                       SET CNTR=CNTR+1

                       SET CMNT(CNTR)=$JUSTIFY(" ",25)

 +11               SET CMNT(CNTR)=CMNT(CNTR)_" "_Y

               End DoDot:1

 +12      ;

 +13       FOR I=1:1:CNTR

               DO SL^RCDPEARL(CMNT(I),.RCLNCNT,RCTMPND)

 +14       QUIT

 +15      ;

RCDPEM4.m