RCDPEM4 ;OIFO-BAYPINES/PJH - EPAYMENTS AUDIT REPORTS ;Nov 17, 2014@17:00:41
;;4.5;Accounts Receivable;**276,284,298,304,321,326,332**;Mar 20, 1995;Build 40
;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
Q
;
POST ; ERAs Posted with Paper EOB Audit Report [RCDPE ERA W/PAPER EOB REPORT]
N RCRTYP S RCRTYP="ERA" ; record type
D ASKUSR
Q
;
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/A MEDICAL/PHARMACY/TRICARE/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
Q
;
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")
Q
;
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)
;
Q
;
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)
;
Q
;
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="@"
Q
;
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)
Q
;
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: "
.S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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: "
.S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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)," ","=")
Q
;
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: "
.S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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: "
.S Y=Y_$S(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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)," ","=")
Q
;
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"
Q
;
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
Q
;
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
Q
;
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"
D
.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
;
Q
;
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"
D
.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
Q
;
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)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEM4 17012 printed Apr 09, 2024@20:53:03 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**;Mar 20, 1995;Build 40
+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/A MEDICAL/PHARMACY/TRICARE/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: "
+35 SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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: "
+52 SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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: "
+17 SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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: "
+32 SET Y=Y_$SELECT(RCTYPE="M":"MEDICAL",RCTYPE="P":"PHARMACY",RCTYPE="T":"TRICARE",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 ;
