Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNERP6

IBCNERP6.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; eIV - Insurance Verification Interface
  1. ;
  1. ; Called by IBCNERPA
  1. ;
  1. ; Input variables from IBCNERP4 and IBCNERP5:
  1. ; IBCNERTN = "IBCNERP4"
  1. ; IBCNESPC("BEGDT") = Start Date for dt range
  1. ; IBCNESPC("ENDDT") = End Date for dt range
  1. ; IBCNESPC("PYR") = Payer IEN for report, if = "", then include all
  1. ; IBCNESPC("SORT") = 1 - Payer name OR 2 - Total Inquiries
  1. ; IBCNESPC("DTL")= 1 - YES OR 0 - NO - display Rejection detail
  1. ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3)=InqCreatedCount^InqCancelledCt^
  1. ; InqQueuedCt^1stTransCount^
  1. ; RetryCount^Non-ErrorRespCount^
  1. ; ErrorRespCount^TotRespTime-days^
  1. ; CommFailRespCount^PendRespCount^
  1. ; DeactivationDTM
  1. ; IBCNERTN = "IBCNERP4"
  1. ; SORT1 = PayerName (SORT=1) or -InquiryCount(SORT=2)
  1. ; SORT2 = PayerIEN (SORT=1) or PayerName (SORT=2)
  1. ; SORT3 = "*" (SORT=1) or PayerIEN (SORT=2)
  1. ;
  1. ; ^TMP($J,IBCNERTN,SORT1,SORT2,SORT3,ERRCD)=InquiryCount
  1. ; (see above)
  1. ; ERRCD = Error Condition code (ptr to 365.018)
  1. ;
  1. ; Must call at appropriate tag
  1. Q
  1. ;
  1. ;
  1. ;IB*737/TAZ - Removed reference to Most Popular Payer and "~NO PAYER"
  1. PRINT(RTN,BDT,EDT,PYR,RDTL,SRT,PGC,PXT,MAX,CRT,IBOUT) ; Print data
  1. ; Input params: RNT = "IBCNERP4" - routine, BDT = starting dt,
  1. ; EDT = ending dt, PYR = payer ien,
  1. ; RDTL = 0/1, SRT = 0/1, PGC = page ct, PXT = exit flg, MAX = max line
  1. ; ct/page, CRT = 0/1
  1. ;
  1. ; Init vars
  1. N EORMSG,NONEMSG,COUNT,TOTDASHS,DISPDATA,SORT1,SORT2,SORT3,CT,PRT1,PRT2,TOTALS
  1. ;
  1. S EORMSG="*** END OF REPORT ***"
  1. S NONEMSG="* * * N O D A T A F O U N D * * *"
  1. S $P(TOTDASHS,"=",89)=""
  1. S CT=0
  1. ;
  1. I '$D(^TMP($J,RTN)) D HEADER W !,?(132-$L(NONEMSG)\2),NONEMSG,!! G PRINT2
  1. I IBOUT="E" D EXHDR
  1. S SORT1=""
  1. F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:$G(ZTSTOP)!PXT
  1. . S PRT1=SORT1
  1. . S SORT2=""
  1. . F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:$G(ZTSTOP)!PXT
  1. . . S PRT2=SORT2
  1. . . S SORT3=""
  1. . . F S SORT3=$O(^TMP($J,RTN,SORT1,SORT2,SORT3)) Q:SORT3="" D Q:$G(ZTSTOP)!PXT
  1. . . . S CT=CT+1
  1. . . . ; Build lines of data to display
  1. . . . KILL DISPDATA
  1. . . . D DATA(.DISPDATA)
  1. . . . ; Display lines of response
  1. . . . D LINE(.DISPDATA)
  1. . . . Q
  1. . . Q
  1. . Q
  1. ;
  1. ; Display totals line if space is available
  1. I $G(ZTSTOP)!PXT G PRINTX
  1. I IBOUT="R" I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
  1. I IBOUT="R" W !,?43,TOTDASHS
  1. ; Print totals for report
  1. KILL DISPDATA
  1. D TOTALS(.DISPDATA)
  1. ; Display lines of totals
  1. D LINE(.DISPDATA)
  1. ;
  1. PRINT2 I $G(ZTSTOP)!PXT G PRINTX
  1. I IBOUT="R" I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT G PRINTX
  1. W !,?(132-$L(EORMSG)\2),EORMSG
  1. ;
  1. PRINTX ; PRINT exit point
  1. Q
  1. ;
  1. ; Assumes vars from PRINT: CRT,PGC,PXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
  1. ; Init vars
  1. N DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,LIN
  1. ;
  1. I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
  1. . I MAX<51 F LIN=1:1:(MAX-$Y) W !
  1. . S DIR(0)="E" D ^DIR K DIR
  1. . I $D(DTOUT)!$D(DUOUT) S PXT=1 Q
  1. I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,PXT)=1 G HEADERX
  1. S PGC=PGC+1
  1. W @IOF,!,?1,"eIV Payer Report"
  1. S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
  1. S OFFSET=131-$L(HDR)
  1. W ?OFFSET,HDR
  1. W !,?1,"Sorted by: "_$S(SRT=1:"Payer",1:"Total Inquiries")
  1. S HDR="Rejection Detail: "_$S('RDTL:"Not",1:"")_" Included"
  1. S OFFSET=131-$L(HDR)
  1. W ?OFFSET,HDR
  1. S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
  1. S OFFSET=132-$L(HDR)\2
  1. W !,?OFFSET,HDR
  1. ; Display Payer Range
  1. S HDR=""
  1. I PYR="" S HDR="All Payers"
  1. I HDR="" S HDR=$P($G(^IBE(365.12,PYR,0)),U,1)
  1. S OFFSET=132-$L(HDR)\2
  1. W !,?OFFSET,HDR
  1. W ! ; Skip line
  1. ; Display column headings
  1. W !,?70,"***** SENT *****",?88,"*** RECEIVED ***",?106,"AvgResp"
  1. 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"
  1. S $P(DASHES,"=",131)=""
  1. W !,?1,DASHES
  1. ;
  1. HEADERX ; HEADER exit pt
  1. Q
  1. ;
  1. EXHDR ; format for Excel report ; 528 - baa
  1. N HDR,HDR1
  1. W !,"eIV Payer Report"
  1. W !,"Sorted by: "_$S(SRT=1:"Payer",1:"Total Inquiries")
  1. S HDR="Rejection Detail: "_$S('RDTL:"Not",1:"")_" Included"
  1. W !,HDR
  1. S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
  1. W !,HDR
  1. S HDR1="Payer [Inactive Date]^Created^Cancel^Queued^SENT 1st Att^Sent Retry^Received Good^Error^AvgResp (Days)^Timeout^Pending"
  1. W !,HDR1
  1. Q
  1. ;
  1. LINE(DISPDATA) ; Print line of data
  1. ; Assumes vars from PRINT: PGC,PXT,MAX
  1. ; Init vars
  1. N CT,II
  1. ;
  1. S CT=+$O(DISPDATA(""),-1)
  1. I IBOUT="R" I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!PXT G LINEX
  1. F II=1:1:CT D Q:$G(ZTSTOP)!PXT
  1. . I IBOUT="R" I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!PXT Q
  1. . I $D(DISPDATA(II)) W !,?1,DISPDATA(II)
  1. . Q
  1. ;
  1. LINEX ; LINE exit pt
  1. Q
  1. ;
  1. 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
  1. ; Init vars
  1. N LINECT,INQS,TIME,AVG,APPS,REJS,DASHES2,ERRCD,ERROR,DEACMSG
  1. N REJDASHS,RPTDATA,FAIL,PEND,RETS,CT2,FIRST,QUED,CANC,PAYER,DEACDT
  1. ;
  1. S $P(DASHES2,"-",89)=""
  1. S $P(REJDASHS,"-",8)=""
  1. S LINECT=1
  1. M RPTDATA=^TMP($J,RTN,SORT1,SORT2,SORT3)
  1. S INQS=+$P(RPTDATA,U,1)
  1. S CANC=+$P(RPTDATA,U,2)
  1. S QUED=+$P(RPTDATA,U,3)
  1. S FIRST=+$P(RPTDATA,U,4)
  1. S RETS=+$P(RPTDATA,U,5)
  1. S APPS=+$P(RPTDATA,U,6)
  1. S REJS=+$P(RPTDATA,U,7)
  1. S TIME=+$P(RPTDATA,U,8)
  1. S FAIL=+$P(RPTDATA,U,9)
  1. S PEND=+$P(RPTDATA,U,10)
  1. S AVG=$FN($S((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
  1. S PAYER=$S(SRT=1:PRT1,1:PRT2)
  1. I $P(RPTDATA,U,11) D
  1. . S DEACMSG=" [Inactive"
  1. . S DEACDT=" "_$$FMTE^XLFDT($P(RPTDATA,U,11)\1,"5Z")
  1. . I $L(PAYER)+$L(DEACMSG)+$L(DEACDT)<40 S PAYER=PAYER_DEACMSG_DEACDT_"]" Q
  1. . I $L(PAYER)+$L(DEACMSG)<40 S PAYER=PAYER_DEACMSG_"]" Q
  1. . S PAYER=$E(PAYER,1,39-$L(DEACMSG))_DEACMSG_"]"
  1. ; Update Report Totals
  1. F CT2=1:1:10 S $P(TOTALS,U,CT2)=$P($G(TOTALS),U,CT2)+$P(RPTDATA,U,CT2)
  1. 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
  1. I IBOUT="R" D
  1. .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")
  1. .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")
  1. S LINECT=LINECT+1
  1. I 'RDTL!(REJS=0) G DATAX
  1. ; Include Rejection Detail - if necessary
  1. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
  1. I IBOUT="E" S DISPDATA(LINECT)="Rejection Detail"
  1. S LINECT=LINECT+1
  1. S ERRCD=""
  1. F S ERRCD=$O(RPTDATA(ERRCD)) Q:ERRCD="" D
  1. . ; Determine Error Condition Description based on ERRCD
  1. . ; If just Error Text 4.01 field, then keep it as is
  1. . I 'ERRCD D
  1. .. S ERROR=$P(ERRCD,U,2,99)
  1. .. I IBOUT="E" S DISPDATA(LINECT)=ERROR_U_ERRCD
  1. .. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+RPTDATA(ERRCD),9,"R")
  1. . ; If IEN, get the code and description
  1. . I ERRCD D
  1. .. S ERROR=$G(^IBE(365.017,ERRCD,0))
  1. .. I IBOUT="E" S DISPDATA(LINECT)=$P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2))_U_+RPTDATA(ERRCD)
  1. .. 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")
  1. . S LINECT=LINECT+1
  1. . ; Update Report Totals
  1. . S TOTALS(ERRCD)=+$G(TOTALS(ERRCD))+RPTDATA(ERRCD)
  1. . Q
  1. ;
  1. DATAX ; DATA exit pt
  1. ; Display end of record dashes only if other records follow
  1. I IBOUT="R" D
  1. .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
  1. Q
  1. ;
  1. TOTALS(DISPDATA) ; Gather and format lines of totals to be printed
  1. ; Assumes vars from PRINT: RDTL,MAR
  1. ; Init vars
  1. N LINECT,INQS,TIME,AVG,APPS,REJS,ERRCD,DASHES,REJDASHS,FAIL,PEND,RETS
  1. N FIRST,QUED,ERROR,CANC
  1. ;
  1. S $P(DASHES,"=",131)=""
  1. S $P(REJDASHS,"-",8)=""
  1. S LINECT=1
  1. S INQS=+$P(TOTALS,U,1)
  1. S CANC=+$P(TOTALS,U,2)
  1. S QUED=+$P(TOTALS,U,3)
  1. S FIRST=+$P(TOTALS,U,4)
  1. S RETS=+$P(TOTALS,U,5)
  1. S APPS=+$P(TOTALS,U,6)
  1. S REJS=+$P(TOTALS,U,7)
  1. S TIME=+$P(TOTALS,U,8)
  1. S FAIL=+$P(TOTALS,U,9)
  1. S PEND=+$P(TOTALS,U,10)
  1. S AVG=$FN($S((APPS+REJS)>0:TIME/(APPS+REJS),1:0),"",2)
  1. 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
  1. I IBOUT="R" D
  1. .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")
  1. .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")
  1. S LINECT=LINECT+1
  1. I 'RDTL!(REJS=0) G TOTALSX
  1. ; Include Rejection Detail - if necessary
  1. I IBOUT="E" S DISPDATA(LINECT)="Rejection Detail"
  1. I IBOUT="R" D
  1. .S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_$$FO^IBCNEUT1("Rejection Detail",56)_REJDASHS
  1. .S LINECT=LINECT+1
  1. S ERRCD=""
  1. F S ERRCD=$O(TOTALS(ERRCD)) Q:ERRCD="" D
  1. . ; If IEN, get the code and description
  1. . I ERRCD D
  1. .. S ERROR=$G(^IBE(365.017,ERRCD,0))
  1. .. I IBOUT="E" S DISPDATA(LINECT)=$P(ERROR,U)_$S($P(ERROR,U,2)'="":"-"_$P(ERROR,U,2),1:"")_U_+TOTALS(ERRCD)
  1. .. 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")
  1. . ; If error text display as is
  1. . I 'ERRCD D
  1. .. S ERROR=$P(ERRCD,U,2,99)
  1. .. I IBOUT="E" S DISPDATA(LINECT)=ERROR_U_+TOTALS(ERRCD)
  1. .. I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("",41)_" "_$$FO^IBCNEUT1(ERROR,53)_$$FO^IBCNEUT1(+TOTALS(ERRCD),9,"R")
  1. . S LINECT=LINECT+1
  1. . Q
  1. ;
  1. TOTALSX ; DATA exit pt
  1. I IBOUT="R" S DISPDATA(LINECT)=DASHES
  1. Q
  1. ;
  1. ;