RCDPELA1 ;EDE/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016
;;4.5;Accounts Receivable;**318,326,432**;Mar 20, 1995;Build 16
;Per VA Directive 6402, this routine should not be modified.
;
Q ; no direct entry
;
RPTOUT(INPUT) ; Output the report to paper/screen, listman or excel
; Input: INPUT - See REPORT for a complete description
; ^TMP($J,A1,"SEL",A2,A3,A4,A5)="" - if record passed filters Where:
; A1 - "RCDPE_LAR"
; A2 - Uppercased Payer Name (primary sort)
; A3 - Secondary Sort Value
; A4 - Internal IEN for file 344.4
; A5 - Internal IEN for file 344.41
; Output: ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
; for output to Listman
; Only set when A7-1
;
; ^TMP($J,A1,"ZERO",A3,A4)="" - List of EEOBs with zero balance Where:
; A1 - "RCDPE_LAR"
; A3 - IEN of #344.4 (ERA #)
; A4 - IEN of #344.41 (original sequence #)
;
N A1,DATA,EXCEL,FIRST,IEN3444,LNCNT,LSTMAN
N ONEERA,OUTTYP,PAGE,PAYER,STOP,SVAL
S (LNCNT,PAGE)=0 ; Initialize Line/Page counters
S $P(INPUT,"^",9)=0 ; Line Counter for Listman output
S EXCEL=$P(INPUT,"^",8)
S LSTMAN=$P(INPUT,"^",7)
S DATA=0
S OUTYPE=$S(EXCEL:2,LSTMAN:1,1:0)
I OUTYPE=2 D ; Excel Ouput
. S XX="Payer^ERA^Date Received^Date Posted^Receipt^Trace #"
. S XX=XX_"^Receipt Total^ERA Total^Missing Receipts^User^Amount^FMS Doc #"
. W !,XX
. ;
S A1="RCDPE_LAR",PAYER="",STOP=0
S FIRST=$O(^TMP($J,A1,"SEL","")) ; First payer on the report
F D Q:PAYER="" Q:STOP
. S PAYER=$O(^TMP($J,A1,"SEL",PAYER))
. Q:PAYER=""
. S DATA=1 ; found data
. ;
. I OUTYPE=1 D ; Listman Output
. . S XX=$P(INPUT,"^",9)+1
. . S $P(INPUT,"^",9)=XX
. . S ^TMP(A1,$J,XX)=PAYER
. ;
. I OUTYPE=0 D Q:STOP ; Paper/Screen output
. . S:PAGE>1!(PAYER'=FIRST) STOP=$$ASKSTOP^RCDPELAR()
. . Q:STOP
. . S LNCNT=0
. . D HEADER(INPUT,.LNCNT,.PAGE)
. . D:'EXCEL ERAHDR(PAYER,.LNCNT,PAGE)
. S SVAL=""
. F D Q:SVAL="" Q:STOP
. . S SVAL=$O(^TMP($J,A1,"SEL",PAYER,SVAL))
. . Q:SVAL=""
. . S IEN3444=""
. . F D Q:IEN3444="" Q:STOP
. . . S IEN3444=$O(^TMP($J,A1,"SEL",PAYER,SVAL,IEN3444))
. . . Q:IEN3444=""
. . . D ZEROBAL(IEN3444) ; determine which IEN34441 lines are zero balance
. . . K ONEERA
. . . S XX=$$GET1^DIQ(344.4,IEN3444,.05,"I") ; Total Amount Paid
. . . S XX=$J(XX,12,2)
. . . S ONEERA="0^"_XX_"^0^0" ; Initial ERA values
. . . S IEN34441=""
. . . F D Q:IEN34441="" Q:STOP
. . . . S IEN34441=$O(^TMP($J,A1,"SEL",PAYER,SVAL,IEN3444,IEN34441))
. . . . Q:IEN34441=""
. . . . ;
. . . . Q:$D(^TMP($J,A1,"ZERO",IEN3444,IEN34441)) ; eliminates reversals
. . . . ;
. . . . ; Get all the detail lines needed to output one ERA record
. . . . D ONEDLN(OUTYPE,IEN3444,IEN34441,.ONEERA)
. . . D ADDERAH(OUTYPE,.ONEERA,IEN3444) ; Add the ERA Header lines
. . . ;
. . . ; Output all the lines for one ERA
. . . S STOP=$$OUTERA(.INPUT,OUTYPE,PAYER,.ONEERA,.LNCNT,.PAGE)
I 'DATA,'EXCEL,'LSTMAN D
. D HEADER(INPUT,.LNCNT,.PAGE)
. D ERAHDR(PAYER,.LNCNT,PAGE)
I 'EXCEL D
. S XX=$$ENDORPRT^RCDPEARL
. I OUTYPE=1 D Q
. . S YY=$P(INPUT,"^",9)+1
. . S $P(INPUT,"^",9)=YY
. . S ^TMP(A1,$J,YY)=XX
. W !,XX
. I 'STOP S STOP=$$ASKSTOP^RCDPELAR()
. Q:STOP
Q
;
ZEROBAL(IEN3444) ; Is it a zero value EEOB
; Those EEOB with reversals will have a zero value. This builds
; an array of them.
; Input: IEN3444 - Internal IEN for file 344.4
; Output:
; ^TMP($J,A1,"ZERO",A3,A4)="" - List of EEOBs with zero balance Where:
; A1 - "RCDPE_LAR"
; A3 - IEN of #344.4 (ERA #)
; A4 - IEN of #344.41 (original sequence #)
;
N A1,A2,AMTPOST,IENS,ORIGSEQ,RCSEQ,RCDA1,XX
K ^TMP($J,"RCDPE_LAR","ZERO",IEN3444)
;
S A1="RCDPE_LAR",A2="ZERO"
S RCSEQ=0
F S RCSEQ=$O(^RCY(344.49,IEN3444,1,"B",RCSEQ)) Q:'RCSEQ D
. Q:RCSEQ#1'=0
. S RCDA1=+$O(^RCY(344.49,IEN3444,1,"B",RCSEQ,0))
. Q:'RCDA1
. S IENS=RCDA1_","_IEN3444_","
. S AMTPOST=$$GET1^DIQ(344.491,IENS,.03,"I") ; Amount to post on receipt
. I AMTPOST>0 Q ; Not zero value line
. S ORIGSEQ=$$GET1^DIQ(344.491,IENS,.09,"I") ; list of original seq #s with zero balance
. S XX=0
. F XX=1:1 Q:$P(ORIGSEQ,",",XX)="" S ^TMP($J,A1,A2,IEN3444,($P(ORIGSEQ,",",XX)))=""
Q
;
ONEDLN(OUTYPE,IEN3444,IEN34441,ONEERA) ; Gather all of the ERA Detail lines to display
; one ERA record
; Input: OUTYPE - O - Output to Screen or paper
; 1 - Output to Listman
; 2 - Output to Excel
; IEN3444 - Internal IEN for file 344.4
; IEN34441 - Internal IEN for sub file 344.41 of the ERA detail
; line being processed
; ONEERA - A1^A2^A3^A4 Where:
; A1 - Current Number of lines in the ERA display
; A2 - ERA Total for the ERA (formatted)
; A3 - Current Receipt Total for the ERA (formatted)
; A4 - 1 if ERA contains at least one detail record
; with a missing receipt.
; 0 otherwise
; ONEERA(LN)=A4- Where
; LN - Line number for ERA Display
; A4 - Actual display line
; Ouput: ONEERA - A1^A2^A3^A4 Where:
; A1 - Updated Number of lines in the ERA display
; A2 - ERA Total for the ERA (formatted)
; A3 - Updated Receipt Total for the ERA (formatted)
; A4 - 1 if ERA contains at least one detail record
; with a missing receipt.
; 0 otherwise
; ONEERA(LN)=A4- Where
; LN - Line number for ERA Display
; A4 - Actual display line
N AMT,DTPOST,DTREC,LCNT,IENS,LN,PAYER,RECEIPT,TRDOC,USER,XX,YY
S IENS=IEN34441_","_IEN3444_","
S LCNT=$P(ONEERA,"^",1)+1
S $P(ONEERA,"^",1)=LCNT ; ERA Line counter
;
; Build detail line for ERA Detail record being process
S XX=$$GET1^DIQ(344.4,IEN3444,.07,"I") ; ERA Date Received
S DTREC=$$FMTE^XLFDT(XX,"2DZ")
S XX=$$GET1^DIQ(344.41,IENS,9,"I") ; Auto-Post Date
S DTPOST=$$FMTE^XLFDT(XX,"2DZ")
S XX=$$GET1^DIQ(344.41,IENS,.25,"I") ; Receipt Pointer
S RECEIPT=$$GET1^DIQ(344,XX,.01,"I") ; Receipt Number
S TRDOC=$$GET1^DIQ(344,XX,200,"I") ; FMS Document #
I RECEIPT="" D
. S $P(ONEERA,"^",4)=1
. S RECEIPT="* Missing *"
S XX=$O(^RCY(344.72,"E",IEN3444,"")) ; IEN of the Auto-Post Audit File entry
S USER=$$GET1^DIQ(344.72,XX,.02,"I") ; User IEN who marked for Auto-Post
S USER=$$GET1^DIQ(200,USER,1,"I") ; Initials of User who marked for Auto-Post
S AMT=$$GET1^DIQ(344.41,IENS,.03,"I") ; Amount Paid
I RECEIPT'="* Missing *" D
. S YY=$P(ONEERA,"^",3) ; Current Receipt Total
. S $P(ONEERA,"^",3)=AMT+YY ; Updated Receipt Total
S AMT=$J(AMT,12,2) ; Formatted Paid
I OUTYPE=2 D Q ; Output to Excel
. S LN=$$GET1^DIQ(344.4,IEN3444,.06,"I") ; Payment From
. S LN=LN_"^"_IEN3444_"^"_DTREC_"^"_DTPOST_"^"_RECEIPT
. S $P(LN,"^",10)=USER
. S $P(LN,"^",11)=AMT
. S $P(LN,"^",12)=TRDOC
. S ONEERA(LCNT)=LN
;
S LN=" "
S LN=$$SETSTR^VALM1(DTREC,LN,9,10)
S LN=$$SETSTR^VALM1(DTPOST,LN,19,10)
S LN=$$SETSTR^VALM1(RECEIPT,LN,30,$L(RECEIPT))
S LN=$$SETSTR^VALM1(USER,LN,43,$L(USER))
S LN=$$SETSTR^VALM1(AMT,LN,50,$L(AMT))
S LN=$$SETSTR^VALM1(TRDOC,LN,65,$L(TRDOC))
S ONEERA(LCNT)=LN
Q
;
ADDERAH(OUTYPE,ONEERA,IEN3444) ; Add the header lines to ERA output array
; Input: OUTYPE - O - Output to Screen or paper
; 1 - Output to Listman
; 2 - Output to Excel
; ONEERA - A1^A2^A3^A4 Where:
; A1 - Number of lines in the ERA display
; A2 - Total Receipt amount for the ERA (formatted)
; A3 - Total Amount paid for the ERA (formatted)
; A4 - 1 if ERA contains at least one detail record
; with a missing receipt.
; 0 otherwise
; ONEERA(LN)=A4- Where
; LN - Line number for ERA Display
; A4 - Actual display line
; IEN3444 - Internal IEN for file 344.4
; Ouput: ONEERA - Receipt Total Formatted, ERA Lines 1-4 added
N LN,MISSINGR,TOTERA,TOTREC,TRACE,XX
S XX=$P(ONEERA,"^",3) ; Final Receipt Total
S TOTREC=$J(XX,12,2) ; Formatted total
S TOTERA=$P(ONEERA,"^",2) ; Formatted ERA Total
S XX=$$COMPLETE^RCDPELAR(IEN3444)
S MISSINGR=$S(XX=0:"* Missing Receipts *",1:"")
S TRACE=$$GET1^DIQ(344.4,IEN3444,.02,"I") ; Trace Number
I OUTYPE=2 D Q ; Excel output
. S XX=""
. F D Q:XX=""
. . S XX=$O(ONEERA(XX))
. . Q:XX=""
. . S $P(ONEERA(XX),"^",6)=TRACE ; Formatted Receipt Total
. . S $P(ONEERA(XX),"^",7)=TOTREC ; Formatted Receipt Total
. . S $P(ONEERA(XX),"^",8)=$P(ONEERA,"^",2) ; Formatted ERA Total
. . S $P(ONEERA(XX),"^",9)=MISSINGR
;
; 1st Main ERA display line
S LN="ERA: "
S LN=$$SETSTR^VALM1(IEN3444,LN,6,$L(IEN3444))
S LN=$$SETSTR^VALM1("ERA Total: ",LN,20,11)
S LN=$$SETSTR^VALM1(TOTERA,LN,32,$L(TOTERA))
S LN=$$SETSTR^VALM1(MISSINGR,LN,53,$L(MISSINGR))
S XX=$P(ONEERA,"^",1)+1
S $P(ONEERA,"^",1)=XX ; Update Line counter
S ONEERA(.1)=LN
;
; 2nd Main ERA display line
S LN=" Receipt Total:"
S LN=$$SETSTR^VALM1(TOTREC,LN,32,$L(TOTREC))
S XX=$P(ONEERA,"^",1)+1
S $P(ONEERA,"^",1)=XX ; Update Line counter
S ONEERA(.2)=LN
;
; 3rd Main ERA display line
S LN=" Trace #:"
S XX=$$GET1^DIQ(344.4,IEN3444,.02,"I") ; Trace Number
S LN=$$SETSTR^VALM1(XX,LN,32,$L(XX))
S XX=$P(ONEERA,"^",1)+1
S $P(ONEERA,"^",1)=XX ; Update Line counter
S ONEERA(.3)=LN
Q
;
OUTERA(INPUT,OUTYPE,PAYER,ONEERA,LNCNT,PAGE) ; Output the display lines for one ERA
; Input: INPUT - See REPORT for a complete description
; OUTYPE - O - Output to Screen or paper
; 1 - Output to Listman
; 2 - Output to Excel
; PAYER - Payer Name
; ONEERA - Array of lines to display for one ERA
; LNCNT - Current Line Count
; PAGE - Current Page Count
; Output: LNCNT - Updated Line Count
; PAGE - Updated Page Count
; A9 - Part of Input above
; Updated Line counter for Listman Output
; ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
; for output to Listman
; Only set when A7-1
; Returns: 1 if user quit, 0 otherwise
N LN,STOP,XX
S STOP=0
S XX=LNCNT-4+$P(ONEERA,"^",1) ; LNCNT + # of lines to display
I 'OUTYPE,(XX>(IOSL-3)) D Q:STOP 1
. S STOP=$$ASKSTOP^RCDPELAR()
. Q:STOP
. S LNCNT=0
. D HEADER(INPUT,.LNCNT,.PAGE)
. D ERAHDR(PAYER,.LNCNT,.PAGE)
S LN=""
F D Q:LN="" Q:STOP
. S LN=$O(ONEERA(LN))
. Q:LN=""
. S LNCNT=LNCNT+1
. I OUTYPE=1 D Q
. . S XX=$P(INPUT,"^",9)+1
. . S $P(INPUT,"^",9)=XX
. . S ^TMP("RCDPE_LAR",$J,XX)=ONEERA(LN)
. W !,ONEERA(LN)
S LNCNT=LNCNT+1
W:OUTYPE=0 !
I OUTYPE=1 D
. S XX=$P(INPUT,"^",9)+1
. S $P(INPUT,"^",9)=XX
. S ^TMP("RCDPE_LAR",$J,XX)=" "
Q STOP
;
; Input: INPUT - See REPORT for a complete description
; LNCNT - Current Line Count
; PAGE - Current Page Count
; Output: LNCNT - Updated Line Count
; PAGE - Updated Page Count
N XX,YY,ZZ
S YY="AUTO-POSTED RECEIPT REPORT",PAGE=PAGE+1
S XX=$$NOW^XLFDT(),XX=$$FMTE^XLFDT(XX)
S XX=$$SETSTR^VALM1(XX,YY,40,21)
S YY="Page: "_$J(PAGE,3)
S XX=$$SETSTR^VALM1(YY,XX,72,$L(YY))
S LNCNT=LNCNT+1
W @IOF,XX
;
S LNCNT=LNCNT+1
S XX=$$HDRLN2(INPUT)
W !,XX
;
S LNCNT=LNCNT+1
S XX=$$HDRLN3(INPUT)
W !,XX
;
S LNCNT=LNCNT+1
W ! ; Blank line
Q
;
HDRLN2(INPUT) ; Build the 2nd header line
; Input: INPUT - See REPORT for a complete description
; Returns: Text for 2nd header line
N XX,YY,ZZ
S XX="FILTERS: "_$S($P(INPUT,"^",1)=1:"All",1:"Sel")_" Divs;"
S XX=XX_$S($P(INPUT,"^",5)=1:" All",1:" Sel")_" Payers;"
S YY=$P(INPUT,"^",10)
S XX=XX_" "_$S(YY="M":"Medical",YY="P":"Pharmacy",YY="T":"Tricare",YY="C":"CHAMPVA",1:"All")_";"
S XX=XX_$S($P(INPUT,"^",2)=1:" Auto-Post Date",1:" ERA Dt Received")
S YY=$P($P(INPUT,"^",3),"|",1),YY=$$FMTE^XLFDT(YY,"2Z")
S ZZ=$P($P(INPUT,"^",3),"|",2),ZZ=$$FMTE^XLFDT(ZZ,"2Z")
S XX=XX_" "_YY_"-"_ZZ
Q XX
;
HDRLN3(INPUT) ; Build the 2nd header line
; Input: INPUT - A1^A2^A3^...^An Where:
; A1 - 1 - All divisions selected
; 2 - Selected divisions
; A2 - 1 - Filter by Auto-Post date range
; 2 - Filter by ERA Date Received date range
; A3 - B1|B2 - Where:
; B1 - ERA Date Received Start Date if A2=2
; Auto-Post Start Date of A2=1
; B2 - ERA Date Received End Date if A2=2
; Auto-Post End Date of A2=1
; A4 - 1 - Posted/Completed Receipts
; 2 - Only ERAs with Missing Receipts
; 3 - Both Posted/Completed and Missing Receipts
; A5 - 1 - All insurance companies selected
; 2 - Selected insurance companies chosen
; A6 - 1 - Auto-Post Date/ERA Date Received Sort
; 2 - Payer sort
; 3 - Missing Receipts
; A7 - 0 - Do not display in a listman template
; 1 - Display in a listman template
; A8 - 0 - Output to paper
; 1 - Output to Excel
; A9 - Line counter for Listman output
; A10 - M/P/T/A - Medical/Pharmacy/tricare/CHAMPVA/All
; Returns: Text for 2nd header line
N XX,YY,ZZ
S YY=$P(INPUT,"^",4)
S:YY=1 ZZ="Posted/Completed Receipts" ; Receipt filter
S:YY=2 ZZ="Missing Receipts Only"
S:YY=3 ZZ="All Receipts"
S XX=" ERA: "_ZZ
S XX=$$SETSTR^VALM1("SORT: ",XX,40,6)
S YY=$P(INPUT,"^",6) ; Selected Sort
I YY=1,$P(INPUT,"^",2)=1 S ZZ="Auto-Post Date"
I YY=1,$P(INPUT,"^",2)=2 S ZZ="ERA Date Received"
I YY=2 S ZZ="Payer"
I YY=3 S ZZ="Missing Receipts"
S XX=$$SETSTR^VALM1(ZZ,XX,46,$L(ZZ))
Q XX
;
ERAHDR(PAYER,LNCNT,PAGE) ; Display ERA Header Lines
; Input: PAYER - Payer Name
; LNCNT - Current Line Count
; PAGE - Current Page Count
; Output: LNCNT - Updated Line Count
; PAGE - Updated Page Count
N XX,YY,ZZ
S LNCNT=LNCNT+1
S XX=" DATE DATE"
W !,XX
;
S LNCNT=LNCNT+1
S XX=$$ERAHDR2()
W !,XX
;
S LNCNT=LNCNT+1
S XX=$J("",80),XX=$TR(XX," ","-")
W !,XX
;
S LNCNT=LNCNT+1
W !,"Payer: ",PAYER
Q
;
ERAHDR2() ; Build the 2nd ERA header line
; Input: None
; Returns: Text for 2nd ERA header line
N XX
S XX=" " ;RECEIVED POSTED RECEIPT"
S XX=$$SETSTR^VALM1("RECEIVED",XX,9,8)
S XX=$$SETSTR^VALM1("POSTED",XX,19,6)
S XX=$$SETSTR^VALM1("RECEIPT",XX,30,7)
S XX=$$SETSTR^VALM1("USER",XX,43,4)
S XX=$$SETSTR^VALM1(" AMOUNT",XX,50,12)
S XX=$$SETSTR^VALM1("FMS DOC",XX,65,7)
Q XX
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPELA1 16940 printed Sep 23, 2025@19:20:42 Page 2
RCDPELA1 ;EDE/FA - LIST ALL AUTO-POSTED RECEIPTS REPORT ;Nov 17, 2016
+1 ;;4.5;Accounts Receivable;**318,326,432**;Mar 20, 1995;Build 16
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; no direct entry
QUIT
+5 ;
RPTOUT(INPUT) ; Output the report to paper/screen, listman or excel
+1 ; Input: INPUT - See REPORT for a complete description
+2 ; ^TMP($J,A1,"SEL",A2,A3,A4,A5)="" - if record passed filters Where:
+3 ; A1 - "RCDPE_LAR"
+4 ; A2 - Uppercased Payer Name (primary sort)
+5 ; A3 - Secondary Sort Value
+6 ; A4 - Internal IEN for file 344.4
+7 ; A5 - Internal IEN for file 344.41
+8 ; Output: ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
+9 ; for output to Listman
+10 ; Only set when A7-1
+11 ;
+12 ; ^TMP($J,A1,"ZERO",A3,A4)="" - List of EEOBs with zero balance Where:
+13 ; A1 - "RCDPE_LAR"
+14 ; A3 - IEN of #344.4 (ERA #)
+15 ; A4 - IEN of #344.41 (original sequence #)
+16 ;
+17 NEW A1,DATA,EXCEL,FIRST,IEN3444,LNCNT,LSTMAN
+18 NEW ONEERA,OUTTYP,PAGE,PAYER,STOP,SVAL
+19 ; Initialize Line/Page counters
SET (LNCNT,PAGE)=0
+20 ; Line Counter for Listman output
SET $PIECE(INPUT,"^",9)=0
+21 SET EXCEL=$PIECE(INPUT,"^",8)
+22 SET LSTMAN=$PIECE(INPUT,"^",7)
+23 SET DATA=0
+24 SET OUTYPE=$SELECT(EXCEL:2,LSTMAN:1,1:0)
+25 ; Excel Ouput
IF OUTYPE=2
Begin DoDot:1
+26 SET XX="Payer^ERA^Date Received^Date Posted^Receipt^Trace #"
+27 SET XX=XX_"^Receipt Total^ERA Total^Missing Receipts^User^Amount^FMS Doc #"
+28 WRITE !,XX
+29 ;
End DoDot:1
+30 SET A1="RCDPE_LAR"
SET PAYER=""
SET STOP=0
+31 ; First payer on the report
SET FIRST=$ORDER(^TMP($JOB,A1,"SEL",""))
+32 FOR
Begin DoDot:1
+33 SET PAYER=$ORDER(^TMP($JOB,A1,"SEL",PAYER))
+34 if PAYER=""
QUIT
+35 ; found data
SET DATA=1
+36 ;
+37 ; Listman Output
IF OUTYPE=1
Begin DoDot:2
+38 SET XX=$PIECE(INPUT,"^",9)+1
+39 SET $PIECE(INPUT,"^",9)=XX
+40 SET ^TMP(A1,$JOB,XX)=PAYER
End DoDot:2
+41 ;
+42 ; Paper/Screen output
IF OUTYPE=0
Begin DoDot:2
+43 if PAGE>1!(PAYER'=FIRST)
SET STOP=$$ASKSTOP^RCDPELAR()
+44 if STOP
QUIT
+45 SET LNCNT=0
+46 DO HEADER(INPUT,.LNCNT,.PAGE)
+47 if 'EXCEL
DO ERAHDR(PAYER,.LNCNT,PAGE)
End DoDot:2
if STOP
QUIT
+48 SET SVAL=""
+49 FOR
Begin DoDot:2
+50 SET SVAL=$ORDER(^TMP($JOB,A1,"SEL",PAYER,SVAL))
+51 if SVAL=""
QUIT
+52 SET IEN3444=""
+53 FOR
Begin DoDot:3
+54 SET IEN3444=$ORDER(^TMP($JOB,A1,"SEL",PAYER,SVAL,IEN3444))
+55 if IEN3444=""
QUIT
+56 ; determine which IEN34441 lines are zero balance
DO ZEROBAL(IEN3444)
+57 KILL ONEERA
+58 ; Total Amount Paid
SET XX=$$GET1^DIQ(344.4,IEN3444,.05,"I")
+59 SET XX=$JUSTIFY(XX,12,2)
+60 ; Initial ERA values
SET ONEERA="0^"_XX_"^0^0"
+61 SET IEN34441=""
+62 FOR
Begin DoDot:4
+63 SET IEN34441=$ORDER(^TMP($JOB,A1,"SEL",PAYER,SVAL,IEN3444,IEN34441))
+64 if IEN34441=""
QUIT
+65 ;
+66 ; eliminates reversals
if $DATA(^TMP($JOB,A1,"ZERO",IEN3444,IEN34441))
QUIT
+67 ;
+68 ; Get all the detail lines needed to output one ERA record
+69 DO ONEDLN(OUTYPE,IEN3444,IEN34441,.ONEERA)
End DoDot:4
if IEN34441=""
QUIT
if STOP
QUIT
+70 ; Add the ERA Header lines
DO ADDERAH(OUTYPE,.ONEERA,IEN3444)
+71 ;
+72 ; Output all the lines for one ERA
+73 SET STOP=$$OUTERA(.INPUT,OUTYPE,PAYER,.ONEERA,.LNCNT,.PAGE)
End DoDot:3
if IEN3444=""
QUIT
if STOP
QUIT
End DoDot:2
if SVAL=""
QUIT
if STOP
QUIT
End DoDot:1
if PAYER=""
QUIT
if STOP
QUIT
+74 IF 'DATA
IF 'EXCEL
IF 'LSTMAN
Begin DoDot:1
+75 DO HEADER(INPUT,.LNCNT,.PAGE)
+76 DO ERAHDR(PAYER,.LNCNT,PAGE)
End DoDot:1
+77 IF 'EXCEL
Begin DoDot:1
+78 SET XX=$$ENDORPRT^RCDPEARL
+79 IF OUTYPE=1
Begin DoDot:2
+80 SET YY=$PIECE(INPUT,"^",9)+1
+81 SET $PIECE(INPUT,"^",9)=YY
+82 SET ^TMP(A1,$JOB,YY)=XX
End DoDot:2
QUIT
+83 WRITE !,XX
+84 IF 'STOP
SET STOP=$$ASKSTOP^RCDPELAR()
+85 if STOP
QUIT
End DoDot:1
+86 QUIT
+87 ;
ZEROBAL(IEN3444) ; Is it a zero value EEOB
+1 ; Those EEOB with reversals will have a zero value. This builds
+2 ; an array of them.
+3 ; Input: IEN3444 - Internal IEN for file 344.4
+4 ; Output:
+5 ; ^TMP($J,A1,"ZERO",A3,A4)="" - List of EEOBs with zero balance Where:
+6 ; A1 - "RCDPE_LAR"
+7 ; A3 - IEN of #344.4 (ERA #)
+8 ; A4 - IEN of #344.41 (original sequence #)
+9 ;
+10 NEW A1,A2,AMTPOST,IENS,ORIGSEQ,RCSEQ,RCDA1,XX
+11 KILL ^TMP($JOB,"RCDPE_LAR","ZERO",IEN3444)
+12 ;
+13 SET A1="RCDPE_LAR"
SET A2="ZERO"
+14 SET RCSEQ=0
+15 FOR
SET RCSEQ=$ORDER(^RCY(344.49,IEN3444,1,"B",RCSEQ))
if 'RCSEQ
QUIT
Begin DoDot:1
+16 if RCSEQ#1'=0
QUIT
+17 SET RCDA1=+$ORDER(^RCY(344.49,IEN3444,1,"B",RCSEQ,0))
+18 if 'RCDA1
QUIT
+19 SET IENS=RCDA1_","_IEN3444_","
+20 ; Amount to post on receipt
SET AMTPOST=$$GET1^DIQ(344.491,IENS,.03,"I")
+21 ; Not zero value line
IF AMTPOST>0
QUIT
+22 ; list of original seq #s with zero balance
SET ORIGSEQ=$$GET1^DIQ(344.491,IENS,.09,"I")
+23 SET XX=0
+24 FOR XX=1:1
if $PIECE(ORIGSEQ,",",XX)=""
QUIT
SET ^TMP($JOB,A1,A2,IEN3444,($PIECE(ORIGSEQ,",",XX)))=""
End DoDot:1
+25 QUIT
+26 ;
ONEDLN(OUTYPE,IEN3444,IEN34441,ONEERA) ; Gather all of the ERA Detail lines to display
+1 ; one ERA record
+2 ; Input: OUTYPE - O - Output to Screen or paper
+3 ; 1 - Output to Listman
+4 ; 2 - Output to Excel
+5 ; IEN3444 - Internal IEN for file 344.4
+6 ; IEN34441 - Internal IEN for sub file 344.41 of the ERA detail
+7 ; line being processed
+8 ; ONEERA - A1^A2^A3^A4 Where:
+9 ; A1 - Current Number of lines in the ERA display
+10 ; A2 - ERA Total for the ERA (formatted)
+11 ; A3 - Current Receipt Total for the ERA (formatted)
+12 ; A4 - 1 if ERA contains at least one detail record
+13 ; with a missing receipt.
+14 ; 0 otherwise
+15 ; ONEERA(LN)=A4- Where
+16 ; LN - Line number for ERA Display
+17 ; A4 - Actual display line
+18 ; Ouput: ONEERA - A1^A2^A3^A4 Where:
+19 ; A1 - Updated Number of lines in the ERA display
+20 ; A2 - ERA Total for the ERA (formatted)
+21 ; A3 - Updated Receipt Total for the ERA (formatted)
+22 ; A4 - 1 if ERA contains at least one detail record
+23 ; with a missing receipt.
+24 ; 0 otherwise
+25 ; ONEERA(LN)=A4- Where
+26 ; LN - Line number for ERA Display
+27 ; A4 - Actual display line
+28 NEW AMT,DTPOST,DTREC,LCNT,IENS,LN,PAYER,RECEIPT,TRDOC,USER,XX,YY
+29 SET IENS=IEN34441_","_IEN3444_","
+30 SET LCNT=$PIECE(ONEERA,"^",1)+1
+31 ; ERA Line counter
SET $PIECE(ONEERA,"^",1)=LCNT
+32 ;
+33 ; Build detail line for ERA Detail record being process
+34 ; ERA Date Received
SET XX=$$GET1^DIQ(344.4,IEN3444,.07,"I")
+35 SET DTREC=$$FMTE^XLFDT(XX,"2DZ")
+36 ; Auto-Post Date
SET XX=$$GET1^DIQ(344.41,IENS,9,"I")
+37 SET DTPOST=$$FMTE^XLFDT(XX,"2DZ")
+38 ; Receipt Pointer
SET XX=$$GET1^DIQ(344.41,IENS,.25,"I")
+39 ; Receipt Number
SET RECEIPT=$$GET1^DIQ(344,XX,.01,"I")
+40 ; FMS Document #
SET TRDOC=$$GET1^DIQ(344,XX,200,"I")
+41 IF RECEIPT=""
Begin DoDot:1
+42 SET $PIECE(ONEERA,"^",4)=1
+43 SET RECEIPT="* Missing *"
End DoDot:1
+44 ; IEN of the Auto-Post Audit File entry
SET XX=$ORDER(^RCY(344.72,"E",IEN3444,""))
+45 ; User IEN who marked for Auto-Post
SET USER=$$GET1^DIQ(344.72,XX,.02,"I")
+46 ; Initials of User who marked for Auto-Post
SET USER=$$GET1^DIQ(200,USER,1,"I")
+47 ; Amount Paid
SET AMT=$$GET1^DIQ(344.41,IENS,.03,"I")
+48 IF RECEIPT'="* Missing *"
Begin DoDot:1
+49 ; Current Receipt Total
SET YY=$PIECE(ONEERA,"^",3)
+50 ; Updated Receipt Total
SET $PIECE(ONEERA,"^",3)=AMT+YY
End DoDot:1
+51 ; Formatted Paid
SET AMT=$JUSTIFY(AMT,12,2)
+52 ; Output to Excel
IF OUTYPE=2
Begin DoDot:1
+53 ; Payment From
SET LN=$$GET1^DIQ(344.4,IEN3444,.06,"I")
+54 SET LN=LN_"^"_IEN3444_"^"_DTREC_"^"_DTPOST_"^"_RECEIPT
+55 SET $PIECE(LN,"^",10)=USER
+56 SET $PIECE(LN,"^",11)=AMT
+57 SET $PIECE(LN,"^",12)=TRDOC
+58 SET ONEERA(LCNT)=LN
End DoDot:1
QUIT
+59 ;
+60 SET LN=" "
+61 SET LN=$$SETSTR^VALM1(DTREC,LN,9,10)
+62 SET LN=$$SETSTR^VALM1(DTPOST,LN,19,10)
+63 SET LN=$$SETSTR^VALM1(RECEIPT,LN,30,$LENGTH(RECEIPT))
+64 SET LN=$$SETSTR^VALM1(USER,LN,43,$LENGTH(USER))
+65 SET LN=$$SETSTR^VALM1(AMT,LN,50,$LENGTH(AMT))
+66 SET LN=$$SETSTR^VALM1(TRDOC,LN,65,$LENGTH(TRDOC))
+67 SET ONEERA(LCNT)=LN
+68 QUIT
+69 ;
ADDERAH(OUTYPE,ONEERA,IEN3444) ; Add the header lines to ERA output array
+1 ; Input: OUTYPE - O - Output to Screen or paper
+2 ; 1 - Output to Listman
+3 ; 2 - Output to Excel
+4 ; ONEERA - A1^A2^A3^A4 Where:
+5 ; A1 - Number of lines in the ERA display
+6 ; A2 - Total Receipt amount for the ERA (formatted)
+7 ; A3 - Total Amount paid for the ERA (formatted)
+8 ; A4 - 1 if ERA contains at least one detail record
+9 ; with a missing receipt.
+10 ; 0 otherwise
+11 ; ONEERA(LN)=A4- Where
+12 ; LN - Line number for ERA Display
+13 ; A4 - Actual display line
+14 ; IEN3444 - Internal IEN for file 344.4
+15 ; Ouput: ONEERA - Receipt Total Formatted, ERA Lines 1-4 added
+16 NEW LN,MISSINGR,TOTERA,TOTREC,TRACE,XX
+17 ; Final Receipt Total
SET XX=$PIECE(ONEERA,"^",3)
+18 ; Formatted total
SET TOTREC=$JUSTIFY(XX,12,2)
+19 ; Formatted ERA Total
SET TOTERA=$PIECE(ONEERA,"^",2)
+20 SET XX=$$COMPLETE^RCDPELAR(IEN3444)
+21 SET MISSINGR=$SELECT(XX=0:"* Missing Receipts *",1:"")
+22 ; Trace Number
SET TRACE=$$GET1^DIQ(344.4,IEN3444,.02,"I")
+23 ; Excel output
IF OUTYPE=2
Begin DoDot:1
+24 SET XX=""
+25 FOR
Begin DoDot:2
+26 SET XX=$ORDER(ONEERA(XX))
+27 if XX=""
QUIT
+28 ; Formatted Receipt Total
SET $PIECE(ONEERA(XX),"^",6)=TRACE
+29 ; Formatted Receipt Total
SET $PIECE(ONEERA(XX),"^",7)=TOTREC
+30 ; Formatted ERA Total
SET $PIECE(ONEERA(XX),"^",8)=$PIECE(ONEERA,"^",2)
+31 SET $PIECE(ONEERA(XX),"^",9)=MISSINGR
End DoDot:2
if XX=""
QUIT
End DoDot:1
QUIT
+32 ;
+33 ; 1st Main ERA display line
+34 SET LN="ERA: "
+35 SET LN=$$SETSTR^VALM1(IEN3444,LN,6,$LENGTH(IEN3444))
+36 SET LN=$$SETSTR^VALM1("ERA Total: ",LN,20,11)
+37 SET LN=$$SETSTR^VALM1(TOTERA,LN,32,$LENGTH(TOTERA))
+38 SET LN=$$SETSTR^VALM1(MISSINGR,LN,53,$LENGTH(MISSINGR))
+39 SET XX=$PIECE(ONEERA,"^",1)+1
+40 ; Update Line counter
SET $PIECE(ONEERA,"^",1)=XX
+41 SET ONEERA(.1)=LN
+42 ;
+43 ; 2nd Main ERA display line
+44 SET LN=" Receipt Total:"
+45 SET LN=$$SETSTR^VALM1(TOTREC,LN,32,$LENGTH(TOTREC))
+46 SET XX=$PIECE(ONEERA,"^",1)+1
+47 ; Update Line counter
SET $PIECE(ONEERA,"^",1)=XX
+48 SET ONEERA(.2)=LN
+49 ;
+50 ; 3rd Main ERA display line
+51 SET LN=" Trace #:"
+52 ; Trace Number
SET XX=$$GET1^DIQ(344.4,IEN3444,.02,"I")
+53 SET LN=$$SETSTR^VALM1(XX,LN,32,$LENGTH(XX))
+54 SET XX=$PIECE(ONEERA,"^",1)+1
+55 ; Update Line counter
SET $PIECE(ONEERA,"^",1)=XX
+56 SET ONEERA(.3)=LN
+57 QUIT
+58 ;
OUTERA(INPUT,OUTYPE,PAYER,ONEERA,LNCNT,PAGE) ; Output the display lines for one ERA
+1 ; Input: INPUT - See REPORT for a complete description
+2 ; OUTYPE - O - Output to Screen or paper
+3 ; 1 - Output to Listman
+4 ; 2 - Output to Excel
+5 ; PAYER - Payer Name
+6 ; ONEERA - Array of lines to display for one ERA
+7 ; LNCNT - Current Line Count
+8 ; PAGE - Current Page Count
+9 ; Output: LNCNT - Updated Line Count
+10 ; PAGE - Updated Page Count
+11 ; A9 - Part of Input above
+12 ; Updated Line counter for Listman Output
+13 ; ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
+14 ; for output to Listman
+15 ; Only set when A7-1
+16 ; Returns: 1 if user quit, 0 otherwise
+17 NEW LN,STOP,XX
+18 SET STOP=0
+19 ; LNCNT + # of lines to display
SET XX=LNCNT-4+$PIECE(ONEERA,"^",1)
+20 IF 'OUTYPE
IF (XX>(IOSL-3))
Begin DoDot:1
+21 SET STOP=$$ASKSTOP^RCDPELAR()
+22 if STOP
QUIT
+23 SET LNCNT=0
+24 DO HEADER(INPUT,.LNCNT,.PAGE)
+25 DO ERAHDR(PAYER,.LNCNT,.PAGE)
End DoDot:1
if STOP
QUIT 1
+26 SET LN=""
+27 FOR
Begin DoDot:1
+28 SET LN=$ORDER(ONEERA(LN))
+29 if LN=""
QUIT
+30 SET LNCNT=LNCNT+1
+31 IF OUTYPE=1
Begin DoDot:2
+32 SET XX=$PIECE(INPUT,"^",9)+1
+33 SET $PIECE(INPUT,"^",9)=XX
+34 SET ^TMP("RCDPE_LAR",$JOB,XX)=ONEERA(LN)
End DoDot:2
QUIT
+35 WRITE !,ONEERA(LN)
End DoDot:1
if LN=""
QUIT
if STOP
QUIT
+36 SET LNCNT=LNCNT+1
+37 if OUTYPE=0
WRITE !
+38 IF OUTYPE=1
Begin DoDot:1
+39 SET XX=$PIECE(INPUT,"^",9)+1
+40 SET $PIECE(INPUT,"^",9)=XX
+41 SET ^TMP("RCDPE_LAR",$JOB,XX)=" "
End DoDot:1
+42 QUIT STOP
+43 ;
+1 ; Input: INPUT - See REPORT for a complete description
+2 ; LNCNT - Current Line Count
+3 ; PAGE - Current Page Count
+4 ; Output: LNCNT - Updated Line Count
+5 ; PAGE - Updated Page Count
+6 NEW XX,YY,ZZ
+7 SET YY="AUTO-POSTED RECEIPT REPORT"
SET PAGE=PAGE+1
+8 SET XX=$$NOW^XLFDT()
SET XX=$$FMTE^XLFDT(XX)
+9 SET XX=$$SETSTR^VALM1(XX,YY,40,21)
+10 SET YY="Page: "_$JUSTIFY(PAGE,3)
+11 SET XX=$$SETSTR^VALM1(YY,XX,72,$LENGTH(YY))
+12 SET LNCNT=LNCNT+1
+13 WRITE @IOF,XX
+14 ;
+15 SET LNCNT=LNCNT+1
+16 SET XX=$$HDRLN2(INPUT)
+17 WRITE !,XX
+18 ;
+19 SET LNCNT=LNCNT+1
+20 SET XX=$$HDRLN3(INPUT)
+21 WRITE !,XX
+22 ;
+23 SET LNCNT=LNCNT+1
+24 ; Blank line
WRITE !
+25 QUIT
+26 ;
HDRLN2(INPUT) ; Build the 2nd header line
+1 ; Input: INPUT - See REPORT for a complete description
+2 ; Returns: Text for 2nd header line
+3 NEW XX,YY,ZZ
+4 SET XX="FILTERS: "_$SELECT($PIECE(INPUT,"^",1)=1:"All",1:"Sel")_" Divs;"
+5 SET XX=XX_$SELECT($PIECE(INPUT,"^",5)=1:" All",1:" Sel")_" Payers;"
+6 SET YY=$PIECE(INPUT,"^",10)
+7 SET XX=XX_" "_$SELECT(YY="M":"Medical",YY="P":"Pharmacy",YY="T":"Tricare",YY="C":"CHAMPVA",1:"All")_";"
+8 SET XX=XX_$SELECT($PIECE(INPUT,"^",2)=1:" Auto-Post Date",1:" ERA Dt Received")
+9 SET YY=$PIECE($PIECE(INPUT,"^",3),"|",1)
SET YY=$$FMTE^XLFDT(YY,"2Z")
+10 SET ZZ=$PIECE($PIECE(INPUT,"^",3),"|",2)
SET ZZ=$$FMTE^XLFDT(ZZ,"2Z")
+11 SET XX=XX_" "_YY_"-"_ZZ
+12 QUIT XX
+13 ;
HDRLN3(INPUT) ; Build the 2nd header line
+1 ; Input: INPUT - A1^A2^A3^...^An Where:
+2 ; A1 - 1 - All divisions selected
+3 ; 2 - Selected divisions
+4 ; A2 - 1 - Filter by Auto-Post date range
+5 ; 2 - Filter by ERA Date Received date range
+6 ; A3 - B1|B2 - Where:
+7 ; B1 - ERA Date Received Start Date if A2=2
+8 ; Auto-Post Start Date of A2=1
+9 ; B2 - ERA Date Received End Date if A2=2
+10 ; Auto-Post End Date of A2=1
+11 ; A4 - 1 - Posted/Completed Receipts
+12 ; 2 - Only ERAs with Missing Receipts
+13 ; 3 - Both Posted/Completed and Missing Receipts
+14 ; A5 - 1 - All insurance companies selected
+15 ; 2 - Selected insurance companies chosen
+16 ; A6 - 1 - Auto-Post Date/ERA Date Received Sort
+17 ; 2 - Payer sort
+18 ; 3 - Missing Receipts
+19 ; A7 - 0 - Do not display in a listman template
+20 ; 1 - Display in a listman template
+21 ; A8 - 0 - Output to paper
+22 ; 1 - Output to Excel
+23 ; A9 - Line counter for Listman output
+24 ; A10 - M/P/T/A - Medical/Pharmacy/tricare/CHAMPVA/All
+25 ; Returns: Text for 2nd header line
+26 NEW XX,YY,ZZ
+27 SET YY=$PIECE(INPUT,"^",4)
+28 ; Receipt filter
if YY=1
SET ZZ="Posted/Completed Receipts"
+29 if YY=2
SET ZZ="Missing Receipts Only"
+30 if YY=3
SET ZZ="All Receipts"
+31 SET XX=" ERA: "_ZZ
+32 SET XX=$$SETSTR^VALM1("SORT: ",XX,40,6)
+33 ; Selected Sort
SET YY=$PIECE(INPUT,"^",6)
+34 IF YY=1
IF $PIECE(INPUT,"^",2)=1
SET ZZ="Auto-Post Date"
+35 IF YY=1
IF $PIECE(INPUT,"^",2)=2
SET ZZ="ERA Date Received"
+36 IF YY=2
SET ZZ="Payer"
+37 IF YY=3
SET ZZ="Missing Receipts"
+38 SET XX=$$SETSTR^VALM1(ZZ,XX,46,$LENGTH(ZZ))
+39 QUIT XX
+40 ;
ERAHDR(PAYER,LNCNT,PAGE) ; Display ERA Header Lines
+1 ; Input: PAYER - Payer Name
+2 ; LNCNT - Current Line Count
+3 ; PAGE - Current Page Count
+4 ; Output: LNCNT - Updated Line Count
+5 ; PAGE - Updated Page Count
+6 NEW XX,YY,ZZ
+7 SET LNCNT=LNCNT+1
+8 SET XX=" DATE DATE"
+9 WRITE !,XX
+10 ;
+11 SET LNCNT=LNCNT+1
+12 SET XX=$$ERAHDR2()
+13 WRITE !,XX
+14 ;
+15 SET LNCNT=LNCNT+1
+16 SET XX=$JUSTIFY("",80)
SET XX=$TRANSLATE(XX," ","-")
+17 WRITE !,XX
+18 ;
+19 SET LNCNT=LNCNT+1
+20 WRITE !,"Payer: ",PAYER
+21 QUIT
+22 ;
ERAHDR2() ; Build the 2nd ERA header line
+1 ; Input: None
+2 ; Returns: Text for 2nd ERA header line
+3 NEW XX
+4 ;RECEIVED POSTED RECEIPT"
SET XX=" "
+5 SET XX=$$SETSTR^VALM1("RECEIVED",XX,9,8)
+6 SET XX=$$SETSTR^VALM1("POSTED",XX,19,6)
+7 SET XX=$$SETSTR^VALM1("RECEIPT",XX,30,7)
+8 SET XX=$$SETSTR^VALM1("USER",XX,43,4)
+9 SET XX=$$SETSTR^VALM1(" AMOUNT",XX,50,12)
+10 SET XX=$$SETSTR^VALM1("FMS DOC",XX,65,7)
+11 QUIT XX
+12 ;
