IBCNERP6 ;DAOU/BHS - eIV PAYER REPORT PRINT ;05-JUN-2002
;;2.0;INTEGRATED BILLING;**184,271,416,528,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance Verification Interface
;
; Called by IBCNERPA
;
; Input variables from IBCNERP4 and IBCNERP5:
; IBCNERTN = "IBCNERP4"
; IBCNESPC("BEGDT") = Start Date for dt range
; IBCNESPC("ENDDT") = End Date for dt range
; IBCNESPC("PYR") = Payer IEN for report, if = "", then include all
; IBCNESPC("SORT") = 1 - Payer name OR 2 - Total Inquiries
; IBCNESPC("DTL")= 1 - YES OR 0 - NO - display Rejection detail
; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3)=InqCreatedCount^InqCancelledCt^
; InqQueuedCt^1stTransCount^
; RetryCount^Non-ErrorRespCount^
; ErrorRespCount^TotRespTime-days^
; CommFailRespCount^PendRespCount^
; DeactivationDTM
; IBCNERTN = "IBCNERP4"
; SORT1 = PayerName (SORT=1) or -InquiryCount(SORT=2)
; SORT2 = PayerIEN (SORT=1) or PayerName (SORT=2)
; SORT3 = "*" (SORT=1) or PayerIEN (SORT=2)
;
; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,ERRCD)=InquiryCount
; (see above)
; ERRCD = Error Condition code (ptr to 365.018)
;
; Must call at appropriate tag
Q
;
;
;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
PRINT(RTN,BDT,EDT,PYR,RDTL,SRT,PGC,PXT,MAX,CRT,IBOUT) ; Print data
; Input params: RNT = "IBCNERP4" - routine, BDT = starting dt,
; EDT = ending dt, PYR = payer ien,
; RDTL = 0/1, SRT = 0/1, PGC = page ct, PXT = exit flg, MAX = max line
; ct/page, CRT = 0/1
;
; Init vars
N EORMSG,NONEMSG,COUNT,TOTDASHS,DISPDATA,SORT1,SORT2,SORT3,CT,PRT1,PRT2,TOTALS
;
S EORMSG="*** END OF REPORT ***"
S NONEMSG="* * * N O D A T A F O U N D * * *"
S $P(TOTDASHS,"=",89)=""
S CT=0
;
I '$D(^TMP($J,RTN)) D HEADER W !,?(132-$L(NONEMSG)\2),NONEMSG,!! G PRINT2
I IBOUT="E" D EXHDR
S SORT1=""
F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:$G(ZTSTOP)!PXT
. S PRT1=SORT1
. S SORT2=""
. F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:$G(ZTSTOP)!PXT
. . S PRT2=SORT2
. . S SORT3=""
. . F S SORT3=$O(^TMP($J,RTN,SORT1,SORT2,SORT3)) Q:SORT3="" D Q:$G(ZTSTOP)!PXT
. . . S CT=CT+1
. . . ; Build lines of data to display
. . . KILL DISPDATA
. . . D DATA(.DISPDATA)
. . . ; Display lines of response
. . . D LINE(.DISPDATA)
. . . Q
. . Q
. Q
;
; Display totals line if space is available
I $G(ZTSTOP)!PXT G PRINTX
I IBOUT="R" I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
I IBOUT="R" W !,?43,TOTDASHS
; Print totals for report
KILL DISPDATA
D TOTALS(.DISPDATA)
; Display lines of totals
D LINE(.DISPDATA)
;
PRINT2 I $G(ZTSTOP)!PXT G PRINTX
I IBOUT="R" I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
W !,?(132-$L(EORMSG)\2),EORMSG
;
PRINTX ; PRINT exit point
Q
;
; Assumes vars from PRINT: CRT,PGC,PXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
; Init vars
N DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,LIN
;
I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
. I MAX<51 F LIN=1:1:(MAX-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S PXT=1 Q
I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,PXT)=1 G HEADERX
S PGC=PGC+1
W @IOF,!,?1,"eIV Payer Report"
S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
S OFFSET=131-$L(HDR)
W ?OFFSET,HDR
W !,?1,"Sorted by: "_$S(SRT=1:"Payer",1:"Total Inquiries")
S HDR="Rejection Detail: "_$S('RDTL:"Not",1:"")_" Included"
S OFFSET=131-$L(HDR)
W ?OFFSET,HDR
S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
S OFFSET=132-$L(HDR)\2
W !,?OFFSET,HDR
; Display Payer Range
S HDR=""
I PYR="" S HDR="All Payers"
I HDR="" S HDR=$P($G(^IBE(365.12,PYR,0)),U,1)
S OFFSET=132-$L(HDR)\2
W !,?OFFSET,HDR
W ! ; Skip line
; Display column headings
W !,?70,"***** SENT *****",?88,"*** RECEIVED ***",?106,"AvgResp"
W !,?1,"Payer [Inactive Date]",?43,"Created",?52," Cancel",?61," Queued",?70,"1st Att",?79," Retry",?88," Good",?97," Error",?106," (Days)",?115,"Timeout",?124,"Pending"
S $P(DASHES,"=",131)=""
W !,?1,DASHES
;
Q
;
EXHDR ; format for Excel report ; 528 - baa
N HDR,HDR1
W !,"eIV Payer Report"
W !,"Sorted by: "_$S(SRT=1:"Payer",1:"Total Inquiries")
S HDR="Rejection Detail: "_$S('RDTL:"Not",1:"")_" Included"
W !,HDR
S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
W !,HDR
S HDR1="Payer [Inactive Date]^Created^Cancel^Queued^SENT 1st Att^Sent Retry^Received Good^Error^AvgResp (Days)^Timeout^Pending"
W !,HDR1
Q
;
LINE(DISPDATA) ; Print line of data
; Assumes vars from PRINT: PGC,PXT,MAX
; Init vars
N CT,II
;
S CT=+$O(DISPDATA(""),-1)
I IBOUT="R" I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!PXT G LINEX
F II=1:1:CT D Q:$G(ZTSTOP)!PXT
. I IBOUT="R" I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT Q
. I $D(DISPDATA(II)) W !,?1,DISPDATA(II)
. Q
;
LINEX ; LINE exit pt
Q
;
DATA(DISPDATA) ; Gather and format lines of data to be printed
; Assumes vars from PRINT: RTN,SRT,SORT1,SORT2,SORT3,RDTL,CT,PRT1,PRT2
; Init vars
N LINECT,INQS,TIME,AVG,APPS,REJS,DASHES2,ERRCD,ERROR,DEACMSG
N REJDASHS,RPTDATA,FAIL,PEND,RETS,CT2,FIRST,QUED,CANC,PAYER,DEACDT
;
S $P(DASHES2,"-",89)=""
S $P(REJDASHS,"-",8)=""
S LINECT=1
M RPTDATA=^TMP($J,RTN,SORT1,SORT2,SORT3)
S INQS=+$P(RPTDATA,U,1)
S CANC=+$P(RPTDATA,U,2)
S QUED=+$P(RPTDATA,U,3)
S FIRST=+$P(RPTDATA,U,4)
S RETS=+$P(RPTDATA,U,5)
S APPS=+$P(RPTDATA,U,6)
S REJS=+$P(RPTDATA,U,7)
S TIME=+$P(RPTDATA,U,8)
S FAIL=+$P(RPTDATA,U,9)
S PEND=+$P(RPTDATA,U,10)
S AVG=$FN($S((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
S PAYER=$S(SRT=1:PRT1,1:PRT2)
I $P(RPTDATA,U,11) D
. S DEACMSG=" [Inactive"
. S DEACDT=" "_$$FMTE^XLFDT($P(RPTDATA,U,11)\1,"5Z")
. I $L(PAYER)+$L(DEACMSG)+$L(DEACDT)<40 S PAYER=PAYER_DEACMSG_DEACDT_"]" Q
. I $L(PAYER)+$L(DEACMSG)<40 S PAYER=PAYER_DEACMSG_"]" Q
. S PAYER=$E(PAYER,1,39-$L(DEACMSG))_DEACMSG_"]"
; Update Report Totals
F CT2=1:1:10 S $P(TOTALS,U,CT2)=$P($G(TOTALS),U,CT2)+$P(RPTDATA,U,CT2)
I IBOUT="E" S DISPDATA(LINECT)=PAYER_U_INQS_U_CANC_U_QUED_U_FIRST_U_RETS_U_APPS_U_REJS_U_AVG_U_FAIL_U_PEND
I IBOUT="R" D
.S DISPDATA(LINECT)=$$FO^IBCNEUT1(PAYER,40)_$$FO^IBCNEUT1(INQS,9,"R")_$$FO^IBCNEUT1(CANC,9,"R")_$$FO^IBCNEUT1(QUED,9,"R")_$$FO^IBCNEUT1(FIRST,9,"R")_$$FO^IBCNEUT1(RETS,9,"R")
.S DISPDATA(LINECT)=DISPDATA(LINECT)_$$FO^IBCNEUT1(APPS,9,"R")_$$FO^IBCNEUT1(REJS,9,"R")_$$FO^IBCNEUT1(AVG,9,"R")_$$FO^IBCNEUT1(FAIL,9,"R")_$$FO^IBCNEUT1(PEND,9,"R")
S LINECT=LINECT+1
I 'RDTL!(REJS=0) G DATAX
; Include Rejection Detail - if necessary
I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
I IBOUT="E" S DISPDATA(LINECT)="Rejection Detail"
S LINECT=LINECT+1
S ERRCD=""
F S ERRCD=$O(RPTDATA(ERRCD)) Q:ERRCD="" D
. ; Determine Error Condition Description based on ERRCD
. ; If just Error Text 4.01 field, then keep it as is
. I 'ERRCD D
.. S ERROR=$P(ERRCD,U,2,99)
.. I IBOUT="E" S DISPDATA(LINECT)=ERROR_U_ERRCD
.. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
. ; If IEN, get the code and description
. I ERRCD D
.. S ERROR=$G(^IBE(365.017,ERRCD,0))
.. I IBOUT="E" S DISPDATA(LINECT)=$P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2))_U_+RPTDATA(ERRCD)
.. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1($P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2),1:""),53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
. S LINECT=LINECT+1
. ; Update Report Totals
. S TOTALS(ERRCD)=+$G(TOTALS(ERRCD))+RPTDATA(ERRCD)
. Q
;
DATAX ; DATA exit pt
; Display end of record dashes only if other records follow
I IBOUT="R" D
.I $O(^TMP($J,RTN,SORT1,SORT2,SORT3))'=""!($O(^TMP($J,RTN,SORT1,SORT2))'="")!($O(^TMP($J,RTN,SORT1))'="") S DISPDATA(LINECT)=$$FO^IBCNEUT1("",42)_DASHES2,LINECT=LINECT+1
Q
;
TOTALS(DISPDATA) ; Gather and format lines of totals to be printed
; Assumes vars from PRINT: RDTL,MAR
; Init vars
N LINECT,INQS,TIME,AVG,APPS,REJS,ERRCD,DASHES,REJDASHS,FAIL,PEND,RETS
N FIRST,QUED,ERROR,CANC
;
S $P(DASHES,"=",131)=""
S $P(REJDASHS,"-",8)=""
S LINECT=1
S INQS=+$P(TOTALS,U,1)
S CANC=+$P(TOTALS,U,2)
S QUED=+$P(TOTALS,U,3)
S FIRST=+$P(TOTALS,U,4)
S RETS=+$P(TOTALS,U,5)
S APPS=+$P(TOTALS,U,6)
S REJS=+$P(TOTALS,U,7)
S TIME=+$P(TOTALS,U,8)
S FAIL=+$P(TOTALS,U,9)
S PEND=+$P(TOTALS,U,10)
S AVG=$FN($S((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
I IBOUT="E" S DISPDATA(LINECT)="Grand Totals"_U_INQS_U_CANC_U_QUED_U_FIRST_U_RETS_U_APPS_U_AVG_U_FAIL_U_PEND
I IBOUT="R" D
.S DISPDATA(LINECT)=$$FO^IBCNEUT1("Grand Totals",40)_$$FO^IBCNEUT1(INQS,9,"R")_$$FO^IBCNEUT1(CANC,9,"R")_$$FO^IBCNEUT1(QUED,9,"R")_$$FO^IBCNEUT1(FIRST,9,"R")_$$FO^IBCNEUT1(RETS,9,"R")
.S DISPDATA(LINECT)=DISPDATA(LINECT)_$$FO^IBCNEUT1(APPS,9,"R")_$$FO^IBCNEUT1(REJS,9,"R")_$$FO^IBCNEUT1(AVG,9,"R")_$$FO^IBCNEUT1(FAIL,9,"R")_$$FO^IBCNEUT1(PEND,9,"R")
S LINECT=LINECT+1
I 'RDTL!(REJS=0) G TOTALSX
; Include Rejection Detail - if necessary
I IBOUT="E" S DISPDATA(LINECT)="Rejection Detail"
I IBOUT="R" D
.S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
.S LINECT=LINECT+1
S ERRCD=""
F S ERRCD=$O(TOTALS(ERRCD)) Q:ERRCD="" D
. ; If IEN, get the code and description
. I ERRCD D
.. S ERROR=$G(^IBE(365.017,ERRCD,0))
.. I IBOUT="E" S DISPDATA(LINECT)=$P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2),1:"")_U_+TOTALS(ERRCD)
.. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1($P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2),1:""),53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
. ; If error text display as is
. I 'ERRCD D
.. S ERROR=$P(ERRCD,U,2,99)
.. I IBOUT="E" S DISPDATA(LINECT)=ERROR_U_+TOTALS(ERRCD)
.. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
. S LINECT=LINECT+1
. Q
;
TOTALSX ; DATA exit pt
I IBOUT="R" S DISPDATA(LINECT)=DASHES
Q
;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERP6 10522 printed Apr 09, 2024@21:27:08 Page 2
IBCNERP6 ;DAOU/BHS - eIV PAYER REPORT PRINT ;05-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,416,528,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; eIV - Insurance Verification Interface
+5 ;
+6 ; Called by IBCNERPA
+7 ;
+8 ; Input variables from IBCNERP4 and IBCNERP5:
+9 ; IBCNERTN = "IBCNERP4"
+10 ; IBCNESPC("BEGDT") = Start Date for dt range
+11 ; IBCNESPC("ENDDT") = End Date for dt range
+12 ; IBCNESPC("PYR") = Payer IEN for report, if = "", then include all
+13 ; IBCNESPC("SORT") = 1 - Payer name OR 2 - Total Inquiries
+14 ; IBCNESPC("DTL")= 1 - YES OR 0 - NO - display Rejection detail
+15 ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3)=InqCreatedCount^InqCancelledCt^
+16 ; InqQueuedCt^1stTransCount^
+17 ; RetryCount^Non-ErrorRespCount^
+18 ; ErrorRespCount^TotRespTime-days^
+19 ; CommFailRespCount^PendRespCount^
+20 ; DeactivationDTM
+21 ; IBCNERTN = "IBCNERP4"
+22 ; SORT1 = PayerName (SORT=1) or -InquiryCount(SORT=2)
+23 ; SORT2 = PayerIEN (SORT=1) or PayerName (SORT=2)
+24 ; SORT3 = "*" (SORT=1) or PayerIEN (SORT=2)
+25 ;
+26 ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,ERRCD)=InquiryCount
+27 ; (see above)
+28 ; ERRCD = Error Condition code (ptr to 365.018)
+29 ;
+30 ; Must call at appropriate tag
+31 QUIT
+32 ;
+33 ;
+34 ;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
PRINT(RTN,BDT,EDT,PYR,RDTL,SRT,PGC,PXT,MAX,CRT,IBOUT) ; Print data
+1 ; Input params: RNT = "IBCNERP4" - routine, BDT = starting dt,
+2 ; EDT = ending dt, PYR = payer ien,
+3 ; RDTL = 0/1, SRT = 0/1, PGC = page ct, PXT = exit flg, MAX = max line
+4 ; ct/page, CRT = 0/1
+5 ;
+6 ; Init vars
+7 NEW EORMSG,NONEMSG,COUNT,TOTDASHS,DISPDATA,SORT1,SORT2,SORT3,CT,PRT1,PRT2,TOTALS
+8 ;
+9 SET EORMSG="*** END OF REPORT ***"
+10 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+11 SET $PIECE(TOTDASHS,"=",89)=""
+12 SET CT=0
+13 ;
+14 IF '$DATA(^TMP($JOB,RTN))
DO HEADER
WRITE !,?(132-$LENGTH(NONEMSG)\2),NONEMSG,!!
GOTO PRINT2
+15 IF IBOUT="E"
DO EXHDR
+16 SET SORT1=""
+17 FOR
SET SORT1=$ORDER(^TMP($JOB,RTN,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+18 SET PRT1=SORT1
+19 SET SORT2=""
+20 FOR
SET SORT2=$ORDER(^TMP($JOB,RTN,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+21 SET PRT2=SORT2
+22 SET SORT3=""
+23 FOR
SET SORT3=$ORDER(^TMP($JOB,RTN,SORT1,SORT2,SORT3))
if SORT3=""
QUIT
Begin DoDot:3
+24 SET CT=CT+1
+25 ; Build lines of data to display
+26 KILL DISPDATA
+27 DO DATA(.DISPDATA)
+28 ; Display lines of response
+29 DO LINE(.DISPDATA)
+30 QUIT
End DoDot:3
if $GET(ZTSTOP)!PXT
QUIT
+31 QUIT
End DoDot:2
if $GET(ZTSTOP)!PXT
QUIT
+32 QUIT
End DoDot:1
if $GET(ZTSTOP)!PXT
QUIT
+33 ;
+34 ; Display totals line if space is available
+35 IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+36 IF IBOUT="R"
IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+37 IF IBOUT="R"
WRITE !,?43,TOTDASHS
+38 ; Print totals for report
+39 KILL DISPDATA
+40 DO TOTALS(.DISPDATA)
+41 ; Display lines of totals
+42 DO LINE(.DISPDATA)
+43 ;
PRINT2 IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+1 IF IBOUT="R"
IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+2 WRITE !,?(132-$LENGTH(EORMSG)\2),EORMSG
+3 ;
PRINTX ; PRINT exit point
+1 QUIT
+2 ;
+1 ; Assumes vars from PRINT: CRT,PGC,PXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
+2 ; Init vars
+3 NEW DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,LIN
+4 ;
+5 IF CRT
IF PGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+6 IF MAX<51
FOR LIN=1:1:(MAX-$Y)
WRITE !
+7 SET DIR(0)="E"
DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXT=1
QUIT
End DoDot:1
IF PXT
GOTO HEADERX
+9 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET (ZTSTOP,PXT)=1
GOTO HEADERX
+10 SET PGC=PGC+1
+11 WRITE @IOF,!,?1,"eIV Payer Report"
+12 SET HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
+13 SET OFFSET=131-$LENGTH(HDR)
+14 WRITE ?OFFSET,HDR
+15 WRITE !,?1,"Sorted by: "_$SELECT(SRT=1:"Payer",1:"Total Inquiries")
+16 SET HDR="Rejection Detail: "_$SELECT('RDTL:"Not",1:"")_" Included"
+17 SET OFFSET=131-$LENGTH(HDR)
+18 WRITE ?OFFSET,HDR
+19 SET HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
+20 SET OFFSET=132-$LENGTH(HDR)\2
+21 WRITE !,?OFFSET,HDR
+22 ; Display Payer Range
+23 SET HDR=""
+24 IF PYR=""
SET HDR="All Payers"
+25 IF HDR=""
SET HDR=$PIECE($GET(^IBE(365.12,PYR,0)),U,1)
+26 SET OFFSET=132-$LENGTH(HDR)\2
+27 WRITE !,?OFFSET,HDR
+28 ; Skip line
WRITE !
+29 ; Display column headings
+30 WRITE !,?70,"***** SENT *****",?88,"*** RECEIVED ***",?106,"AvgResp"
+31 WRITE !,?1,"Payer [Inactive Date]",?43,"Created",?52," Cancel",?61," Queued",?70,"1st Att",?79," Retry",?88," Good",?97," Error",?106," (Days)",?115,"Timeout",?124,"Pending"
+32 SET $PIECE(DASHES,"=",131)=""
+33 WRITE !,?1,DASHES
+34 ;
+1 QUIT
+2 ;
EXHDR ; format for Excel report ; 528 - baa
+1 NEW HDR,HDR1
+2 WRITE !,"eIV Payer Report"
+3 WRITE !,"Sorted by: "_$SELECT(SRT=1:"Payer",1:"Total Inquiries")
+4 SET HDR="Rejection Detail: "_$SELECT('RDTL:"Not",1:"")_" Included"
+5 WRITE !,HDR
+6 SET HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
+7 WRITE !,HDR
+8 SET HDR1="Payer [Inactive Date]^Created^Cancel^Queued^SENT 1st Att^Sent Retry^Received Good^Error^AvgResp (Days)^Timeout^Pending"
+9 WRITE !,HDR1
+10 QUIT
+11 ;
LINE(DISPDATA) ; Print line of data
+1 ; Assumes vars from PRINT: PGC,PXT,MAX
+2 ; Init vars
+3 NEW CT,II
+4 ;
+5 SET CT=+$ORDER(DISPDATA(""),-1)
+6 IF IBOUT="R"
IF $Y+1+CT>MAX
DO HEADER
IF $GET(ZTSTOP)!PXT
GOTO LINEX
+7 FOR II=1:1:CT
Begin DoDot:1
+8 IF IBOUT="R"
IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!PXT
QUIT
+9 IF $DATA(DISPDATA(II))
WRITE !,?1,DISPDATA(II)
+10 QUIT
End DoDot:1
if $GET(ZTSTOP)!PXT
QUIT
+11 ;
LINEX ; LINE exit pt
+1 QUIT
+2 ;
DATA(DISPDATA) ; Gather and format lines of data to be printed
+1 ; Assumes vars from PRINT: RTN,SRT,SORT1,SORT2,SORT3,RDTL,CT,PRT1,PRT2
+2 ; Init vars
+3 NEW LINECT,INQS,TIME,AVG,APPS,REJS,DASHES2,ERRCD,ERROR,DEACMSG
+4 NEW REJDASHS,RPTDATA,FAIL,PEND,RETS,CT2,FIRST,QUED,CANC,PAYER,DEACDT
+5 ;
+6 SET $PIECE(DASHES2,"-",89)=""
+7 SET $PIECE(REJDASHS,"-",8)=""
+8 SET LINECT=1
+9 MERGE RPTDATA=^TMP($JOB,RTN,SORT1,SORT2,SORT3)
+10 SET INQS=+$PIECE(RPTDATA,U,1)
+11 SET CANC=+$PIECE(RPTDATA,U,2)
+12 SET QUED=+$PIECE(RPTDATA,U,3)
+13 SET FIRST=+$PIECE(RPTDATA,U,4)
+14 SET RETS=+$PIECE(RPTDATA,U,5)
+15 SET APPS=+$PIECE(RPTDATA,U,6)
+16 SET REJS=+$PIECE(RPTDATA,U,7)
+17 SET TIME=+$PIECE(RPTDATA,U,8)
+18 SET FAIL=+$PIECE(RPTDATA,U,9)
+19 SET PEND=+$PIECE(RPTDATA,U,10)
+20 SET AVG=$FNUMBER($SELECT((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
+21 SET PAYER=$SELECT(SRT=1:PRT1,1:PRT2)
+22 IF $PIECE(RPTDATA,U,11)
Begin DoDot:1
+23 SET DEACMSG=" [Inactive"
+24 SET DEACDT=" "_$$FMTE^XLFDT($PIECE(RPTDATA,U,11)\1,"5Z")
+25 IF $LENGTH(PAYER)+$LENGTH(DEACMSG)+$LENGTH(DEACDT)<40
SET PAYER=PAYER_DEACMSG_DEACDT_"]"
QUIT
+26 IF $LENGTH(PAYER)+$LENGTH(DEACMSG)<40
SET PAYER=PAYER_DEACMSG_"]"
QUIT
+27 SET PAYER=$EXTRACT(PAYER,1,39-$LENGTH(DEACMSG))_DEACMSG_"]"
End DoDot:1
+28 ; Update Report Totals
+29 FOR CT2=1:1:10
SET $PIECE(TOTALS,U,CT2)=$PIECE($GET(TOTALS),U,CT2)+$PIECE(RPTDATA,U,CT2)
+30 IF IBOUT="E"
SET DISPDATA(LINECT)=PAYER_U_INQS_U_CANC_U_QUED_U_FIRST_U_RETS_U_APPS_U_REJS_U_AVG_U_FAIL_U_PEND
+31 IF IBOUT="R"
Begin DoDot:1
+32 SET DISPDATA(LINECT)=$$FO^IBCNEUT1(PAYER,40)_$$FO^IBCNEUT1(INQS,9,"R")_$$FO^IBCNEUT1(CANC,9,"R")_$$FO^IBCNEUT1(QUED,9,"R")_$$FO^IBCNEUT1(FIRST,9,"R")_$$FO^IBCNEUT1(RETS,9,"R")
+33 SET DISPDATA(LINECT)=DISPDATA(LINECT)_$$FO^IBCNEUT1(APPS,9,"R")_$$FO^IBCNEUT1(REJS,9,"R")_$$FO^IBCNEUT1(AVG,9,"R")_$$FO^IBCNEUT1(FAIL,9,"R")_$$FO^IBCNEUT1(PEND,9,"R")
End DoDot:1
+34 SET LINECT=LINECT+1
+35 IF 'RDTL!(REJS=0)
GOTO DATAX
+36 ; Include Rejection Detail - if necessary
+37 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
+38 IF IBOUT="E"
SET DISPDATA(LINECT)="Rejection Detail"
+39 SET LINECT=LINECT+1
+40 SET ERRCD=""
+41 FOR
SET ERRCD=$ORDER(RPTDATA(ERRCD))
if ERRCD=""
QUIT
Begin DoDot:1
+42 ; Determine Error Condition Description based on ERRCD
+43 ; If just Error Text 4.01 field, then keep it as is
+44 IF 'ERRCD
Begin DoDot:2
+45 SET ERROR=$PIECE(ERRCD,U,2,99)
+46 IF IBOUT="E"
SET DISPDATA(LINECT)=ERROR_U_ERRCD
+47 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
End DoDot:2
+48 ; If IEN, get the code and description
+49 IF ERRCD
Begin DoDot:2
+50 SET ERROR=$GET(^IBE(365.017,ERRCD,0))
+51 IF IBOUT="E"
SET DISPDATA(LINECT)=$PIECE(ERROR,U)_$SELECT($PIECE(ERROR,U,2)'="":"-"_$PIECE(ERROR,U,2))_U_+RPTDATA(ERRCD)
+52 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1($PIECE(ERROR,U)_$SELECT($PIECE(ERROR,U,2)'="":"-"_$PIECE(ERROR,U,2),1:""),53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
End DoDot:2
+53 SET LINECT=LINECT+1
+54 ; Update Report Totals
+55 SET TOTALS(ERRCD)=+$GET(TOTALS(ERRCD))+RPTDATA(ERRCD)
+56 QUIT
End DoDot:1
+57 ;
DATAX ; DATA exit pt
+1 ; Display end of record dashes only if other records follow
+2 IF IBOUT="R"
Begin DoDot:1
+3 IF $ORDER(^TMP($JOB,RTN,SORT1,SORT2,SORT3))'=""!($ORDER(^TMP($JOB,RTN,SORT1,SORT2))'="")!($ORDER(^TMP($JOB,RTN,SORT1))'="")
SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",42)_DASHES2
SET LINECT=LINECT+1
End DoDot:1
+4 QUIT
+5 ;
TOTALS(DISPDATA) ; Gather and format lines of totals to be printed
+1 ; Assumes vars from PRINT: RDTL,MAR
+2 ; Init vars
+3 NEW LINECT,INQS,TIME,AVG,APPS,REJS,ERRCD,DASHES,REJDASHS,FAIL,PEND,RETS
+4 NEW FIRST,QUED,ERROR,CANC
+5 ;
+6 SET $PIECE(DASHES,"=",131)=""
+7 SET $PIECE(REJDASHS,"-",8)=""
+8 SET LINECT=1
+9 SET INQS=+$PIECE(TOTALS,U,1)
+10 SET CANC=+$PIECE(TOTALS,U,2)
+11 SET QUED=+$PIECE(TOTALS,U,3)
+12 SET FIRST=+$PIECE(TOTALS,U,4)
+13 SET RETS=+$PIECE(TOTALS,U,5)
+14 SET APPS=+$PIECE(TOTALS,U,6)
+15 SET REJS=+$PIECE(TOTALS,U,7)
+16 SET TIME=+$PIECE(TOTALS,U,8)
+17 SET FAIL=+$PIECE(TOTALS,U,9)
+18 SET PEND=+$PIECE(TOTALS,U,10)
+19 SET AVG=$FNUMBER($SELECT((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
+20 IF IBOUT="E"
SET DISPDATA(LINECT)="Grand Totals"_U_INQS_U_CANC_U_QUED_U_FIRST_U_RETS_U_APPS_U_AVG_U_FAIL_U_PEND
+21 IF IBOUT="R"
Begin DoDot:1
+22 SET DISPDATA(LINECT)=$$FO^IBCNEUT1("Grand Totals",40)_$$FO^IBCNEUT1(INQS,9,"R")_$$FO^IBCNEUT1(CANC,9,"R")_$$FO^IBCNEUT1(QUED,9,"R")_$$FO^IBCNEUT1(FIRST,9,"R")_$$FO^IBCNEUT1(RETS,9,"R")
+23 SET DISPDATA(LINECT)=DISPDATA(LINECT)_$$FO^IBCNEUT1(APPS,9,"R")_$$FO^IBCNEUT1(REJS,9,"R")_$$FO^IBCNEUT1(AVG,9,"R")_$$FO^IBCNEUT1(FAIL,9,"R")_$$FO^IBCNEUT1(PEND,9,"R")
End DoDot:1
+24 SET LINECT=LINECT+1
+25 IF 'RDTL!(REJS=0)
GOTO TOTALSX
+26 ; Include Rejection Detail - if necessary
+27 IF IBOUT="E"
SET DISPDATA(LINECT)="Rejection Detail"
+28 IF IBOUT="R"
Begin DoDot:1
+29 SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
+30 SET LINECT=LINECT+1
End DoDot:1
+31 SET ERRCD=""
+32 FOR
SET ERRCD=$ORDER(TOTALS(ERRCD))
if ERRCD=""
QUIT
Begin DoDot:1
+33 ; If IEN, get the code and description
+34 IF ERRCD
Begin DoDot:2
+35 SET ERROR=$GET(^IBE(365.017,ERRCD,0))
+36 IF IBOUT="E"
SET DISPDATA(LINECT)=$PIECE(ERROR,U)_$SELECT($PIECE(ERROR,U,2)'="":"-"_$PIECE(ERROR,U,2),1:"")_U_+TOTALS(ERRCD)
+37 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1($PIECE(ERROR,U)_$SELECT($PIECE(ERROR,U,2)'="":"-"_$PIECE(ERROR,U,2),1:""),53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
End DoDot:2
+38 ; If error text display as is
+39 IF 'ERRCD
Begin DoDot:2
+40 SET ERROR=$PIECE(ERRCD,U,2,99)
+41 IF IBOUT="E"
SET DISPDATA(LINECT)=ERROR_U_+TOTALS(ERRCD)
+42 IF IBOUT="R"
SET DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
End DoDot:2
+43 SET LINECT=LINECT+1
+44 QUIT
End DoDot:1
+45 ;
TOTALSX ; DATA exit pt
+1 IF IBOUT="R"
SET DISPDATA(LINECT)=DASHES
+2 QUIT
+3 ;
+4 ;
