IBCERP2 ;ALB/CXW - ELECTRONIC ERROR REPORT ; 3/13/07 1:14pm
;;2.0;INTEGRATED BILLING;**137,367**;21-MAR-94;Build 11
Q
BEG ; Report of electronic error
N DIR,DIRUT,DIROUT,DTOUT,DUOUT,DIC,%DT,IBZ
N IB0,IBBDD,IBEDT,IBST1,IBST2,IBST3,IBST4,IBERR,IBTYE,Y
S IB0="No ERROR CODE as sort level when error messages are not displayed"
S DIR("A")="DO YOU WANT TO INCLUDE THE ERROR MESSAGES? ",DIR(0)="YA",DIR("B")="YES"
S DIR("?")="YES indicates to display the error record with messages, or NO indicates to display the error record without messages."
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) Q
S IBERR=+Y
BDT S %DT="AEPX",%DT("A")="Begin TRANSMIT DATE: "
D ^%DT K %DT G BEGQ:Y<0
I $D(DTOUT)!($D(DUOUT)) Q
S IBBDD=Y
EDT S %DT="EX" R !,"End TRANSMIT DATE: ",X:DTIME
S:X=" " X=IBBDD G BEGQ:(X="")!(X["^") D ^%DT K %DT G EDT:Y<0
I $D(DTOUT)!($D(DUOUT)) Q
S IBEDT=Y
I Y<IBBDD W *7," ??",!,"END DATE must follow BEGIN DATE." G BDT
S DIR(0)="SBM^E:EDI;M:MRA;B:EDI/MRA",DIR("A")="BILL TRANSMISSION TYPE"
S DIR("?")="Select the code to indicate the transmission type: EDI, MRA or both of EDI/MAR."
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) Q
S IBTYE=Y
S DIC="^VA(200,",DIC(0)="AMEQ",DIC("A")="Select AUTHORIZING BILLER: ALL// " D ^DIC
I $D(DTOUT)!($D(DUOUT)) Q
I Y<0 W "ALL" G EN0
S ^TMP($J,"IBBIL",+Y)=""
S DIC("A")="Select Another AUTHORIZING BILLER: "
F D Q:Y<0
. D ^DIC
. I $D(DTOUT)!($D(DUOUT)) Q
. Q:Y<0
. S ^TMP($J,"IBBIL",+Y)=""
I $D(DTOUT)!($D(DUOUT)) G BEGQ
EN0 K DIC
S (IBZ,DIR(0))="SBM^A:AUTHORIZING BILLER;B:BILLED AMOUNT;E:EPISODE OF CARE;P:PATIENT NAME;S:PATIENT SSN;Y:PAYER NAME;C:ERROR CODE",DIR("A")="PRIMARY SORT BY"
S DIR("?")="Enter a code to indicate how the messages should be organized within the first sort level"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) G BEGQ
I 'IBERR,Y="C" W !,IB0 G EN0
S IBST1=Y,IBST3=Y(0)
ST2 S DIR(0)=IBZ,DIR("A")="SECONDARY SORT BY"
S DIR("?")="Enter a code to indicate how the messages should be organized within the second sort level"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) G BEGQ
I 'IBERR,Y="C" W !,IB0 G ST2
S IBST2=Y,IBST4=Y(0)
I IBST1=IBST2 W !,"SECONDARY SORT must be different from PRIMARY SORT." G ST2
;
N %ZIS,ZTSAVE,ZTRTN,ZTDESC
S %ZIS="QM" D ^%ZIS Q:POP
I $D(IO("Q")) K IO("Q") D G BEGQ
. S ZTRTN="EN^IBCERP2"
. S ZTSAVE("IBST*")="",ZTSAVE("IBERR")="",ZTSAVE("IBTYE")=""
. S ZTSAVE("IBBDD")="",ZTSAVE("IBEDT")=""
. S ZTSAVE("^TMP($J,""IBSORT"",")=""
. S ZTDESC="IB - Electronic Error Report"
. D ^%ZTLOAD K ZTSK D HOME^%ZIS
U IO
EN ; Queued job entrypoint
N IBSTOP,IBIFN,IBPAGE,IBLINE,IB,IB1,IBMRA,IBNAM,IBTOL,IBPAY,IBSSN,IBUER,IBDPT,IBCOD,IBDDT,IBSO1,IBSO2,IBEPO,IB399
W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
S IBDDT=IBBDD-1 F S IBDDT=$O(^DGCR(399,"ALEX",IBDDT)) Q:'IBDDT!(IBDDT<IBBDD)!(IBDDT>IBEDT) S IBIFN=0 F S IBIFN=$O(^DGCR(399,"ALEX",IBDDT,IBIFN)) Q:'IBIFN D
. ;episode of care by event dt for op, adm dt for in
. S IB399=$G(^DGCR(399,IBIFN,0))
. S IBEPO=$P(IB399,U,5)
. S IBEPO=$S(IBEPO<3:"I",1:"O")
. I IBEPO="I" D ;inpatient with adm date
.. S IBEPO=$P(IB399,U,2),IBEPO=$S($D(^DPT(IBEPO,.105)):$P(^DGPM(^DPT(IBEPO,.105),0),U),1:$P(IB399,U,3))
. I IBEPO="O" S IBEPO=$P(IB399,U,3)
. S IBUER=$P($G(^DGCR(399,IBIFN,"S")),U,11)
. I $O(^TMP($J,"IBBIL",""))'="",'$D(^TMP($J,"IBBIL",+IBUER)) Q
. S IBDPT=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0))
. S IBUER=$S(IBUER="":"UNKNOWN",1:$P($G(^VA(200,IBUER,0)),U))
. S IBTOL=-$P($G(^DGCR(399,IBIFN,"U1")),U)
. S IBNAM=$E($P(IBDPT,U),1,26)
. S IBSSN=$E($P(IBDPT,U,9),1,9)
. S IBPAY=$G(^DGCR(399,IBIFN,"MP"))
. S IBPAY=$S(+IBPAY:$P($G(^DIC(36,+IBPAY,0)),U,1),$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)):"MEDICARE (WNR)",1:"PAYER NAME NOT FOUND")
. S IB=0 F S IB=$O(^IBM(361,"B",IBIFN,IB)) Q:'IB D
.. S IB1=$G(^IBM(361,IB,0))
.. Q:$P(IB1,U,3)'="R" ;only display record with error message
.. S IBMRA=$$MCRWNR^IBEFUNC(+$$POLICY^IBCEF(IBIFN,1,$P(IB1,U,7)))
.. I IBTYE="M",'IBMRA Q
.. I IBTYE="E",IBMRA Q
.. S IBCOD=0
.. S IBSO1=0 F S IBSO1=$O(^IBM(361,IB,1,IBSO1)) Q:'IBSO1 S IBSO2=$G(^IBM(361,IB,1,IBSO1,0)) I IBSO2["Error" S IBCOD=IBSO2 Q
.. S IBSO1=$S(IBST1="B":IBTOL,IBST1="A":IBUER,IBST1="E":IBEPO,IBST1="P":IBNAM,IBST1="S":IBSSN,IBST1="Y":IBPAY,1:IBCOD)
.. S IBSO2=$S(IBST2="B":IBTOL,IBST2="A":IBUER,IBST2="E":IBEPO,IBST2="P":IBNAM,IBST2="S":IBSSN,IBST2="Y":IBPAY,1:IBCOD)
.. S ^TMP($J,"IBSORT",IBSO1,IBSO2,IB)=IBIFN_U_IBTOL_U_IBUER_U_IBSSN_U_IBNAM_U_$S(IBPAY=0:"",1:IBPAY)_U_IBCOD_U_$S($P(IB1,U,4):"PAYER",1:"NONE PAYER")_U_IBDDT_U_$P(IB1,U,2)_U_IBEPO
;
LIST ;display
N IBFLG,IBPAT,IBFST,IBSEC,IBWNR,IBUER,IBWR
S (IBFLG,IBSO2,IBSTOP,IBPAGE,IBWNR,IBWR)=0
I '$D(^TMP($J,"IBSORT")) D G BEGQ
. D HDR1
. W !,"No entries found for this report"
S IBFST="" F S IBFST=$O(^TMP($J,"IBSORT",IBFST)) Q:IBFST=""!IBSTOP D
. I 'IBFLG D HDR1 Q:IBSTOP S IBFLG=1
. I (IBST1="A")!(IBST1="P") S IBSO1=0,IBFLG=0
. S IBSEC="" F S IBSEC=$O(^TMP($J,"IBSORT",IBFST,IBSEC)) Q:IBSEC=""!IBSTOP S IB1=0 F S IB1=$O(^TMP($J,"IBSORT",IBFST,IBSEC,IB1)) Q:'IB1!IBSTOP S IB=^TMP($J,"IBSORT",IBFST,IBSEC,IB1) D
.. I (IBST1="A")!(IBST1="P") S IBSO1=IBSO1+1
.. I $P(IB,U,6)["WNR" S IBWNR=IBWNR+1
.. E S IBWR=IBWR+1
.. S IBSO2=IBSO2+1
.. I IBST1="E"!(IBST2="E") W "EPISODE OF CARE: "_$$DAT1^IBOUTL($P(IB,U,11)),!
.. W:IBST2="A" "AUTHORIZING BILLER: "_$P(IB,U,3),!
.. W $$BN1^PRCAFN(+IB),?13,$P(IB,U,4),?25,$E($P(IB,U,6),1,20),?50,$$DAT1^IBOUTL($P(IB,U,10)),?61,$$DAT1^IBOUTL($P(IB,U,9)),?71,$J(-$P(IB,U,2),0,2),!
.. I IBST1'="P",'IBERR W "PATIENT: "_$P(IB,U,5),!!
.. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
.. Q:'IBERR ;no display error msg
.. S IB0=0 F S IB0=$O(^IBM(361,IB1,1,IB0)) Q:'IB0!IBSTOP D
... N IBX,IBY S IBX=$G(^IBM(361,IB1,1,IB0,0))
... F IBY=1:80:$L(IBX) D Q:IBSTOP
.... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
.... W $E(IBX,IBY,IBY+79),!
.. Q:IBSTOP
.. W !
.. S IBCOD=0
.. S IBX=0 F S IBX=$O(^IBM(361.1,"B",+IB,IBX)) Q:'IBX!IBCOD D
... S IBY=$P($G(^IBM(361.1,IBX,0)),U,15)
... S IBY=$S(IBY=1:"P",IBY=2:"S",1:"T")
... I $P($G(^IBM(361,IB1,0)),7)=IBY S IBCOD=IBX
.. I IBCOD,$P($G(^IBM(361.1,IBCOD,0)),U,13)=2 D Q:IBSTOP ;denied msg
... S IB0=0
... F S IB0=$O(^IBM(361.1,IBCOD,"ERR",IB0)) Q:'IB0!IBSTOP D
.... W ?11,$G(^IBM(361.1,1,IBCOD,"ERR",IB0,0)),!
.... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
. Q:IBSTOP
. I (IBST1="A")!(IBST1="P") D Q:IBSTOP
.. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
.. W:'IBERR ! W "SUBTOTAL # OF BILLS FOR "_IBFST_"= ",IBSO1,!!
G:IBSTOP BEGQ
I IBTYE="M"!(IBTYE="B") D G:IBSTOP BEGQ
. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
. W !,"TOTAL # OF MEDICARE (WNR) BILLS = ",IBWNR
I IBTYE="E"!(IBTYE="B") D G:IBSTOP BEGQ
. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
. W !,"TOTAL # OF EDI BILLS = ",IBWR
I ($Y+5)>IOSL D HDR1 G:IBSTOP BEGQ
W !,"GRAND TOTAL # OF BILLS = ",IBSO2
I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
BEGQ K ^TMP($J,"IBSORT"),^TMP($J,"IBBIL")
I $D(ZTQUEUED) S ZTREQ="@"
I '$D(ZTQUEUED) W ! D ^%ZISC
Q
HDR1 ;
N DIR,Y
I IBPAGE D Q:IBSTOP
. I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
. W @IOF
S IBPAGE=IBPAGE+1
W !,?25,"ELECTRONIC ERROR REPORT",?72,"PAGE: ",IBPAGE,!,?25,"RUN DATE: ",$$HTE^XLFDT($H,"2")
W !,?25,"DATE TRANSMITTED: ",$$DAT1^IBOUTL(IBBDD)_" - "_$$DAT1^IBOUTL(IBEDT)
W !,?25,"BILL TRANSMISSION TYPE: ",$S(IBTYE="E":"EDI",IBTYE="M":"MRA",1:"EDI/MRA")
W !,?25,"SORT BY: "_IBST3_", "_IBST4
I (IBST1="A")!(IBST1="P") W !,$S(IBST1="A":"AUTHORIZING BILLER: ",1:"PATIENT NAME: "),$G(IBFST)
W !,?61,"DATE OF"
W !,?51,"DATE OF",?62,"LAST",?71,"BILLED"
W !,"BILL NUMBER",?13,"SSN",?25,"PAYER NAME",?50,"REJECTION",?61,"TRANSMIT",?71,"AMOUNT"
W !,$TR($J("",80)," ","-"),!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCERP2 7820 printed Apr 09, 2024@21:26:56 Page 2
IBCERP2 ;ALB/CXW - ELECTRONIC ERROR REPORT ; 3/13/07 1:14pm
+1 ;;2.0;INTEGRATED BILLING;**137,367**;21-MAR-94;Build 11
+2 QUIT
BEG ; Report of electronic error
+1 NEW DIR,DIRUT,DIROUT,DTOUT,DUOUT,DIC,%DT,IBZ
+2 NEW IB0,IBBDD,IBEDT,IBST1,IBST2,IBST3,IBST4,IBERR,IBTYE,Y
+3 SET IB0="No ERROR CODE as sort level when error messages are not displayed"
+4 SET DIR("A")="DO YOU WANT TO INCLUDE THE ERROR MESSAGES? "
SET DIR(0)="YA"
SET DIR("B")="YES"
+5 SET DIR("?")="YES indicates to display the error record with messages, or NO indicates to display the error record without messages."
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+8 SET IBERR=+Y
BDT SET %DT="AEPX"
SET %DT("A")="Begin TRANSMIT DATE: "
+1 DO ^%DT
KILL %DT
if Y<0
GOTO BEGQ
+2 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+3 SET IBBDD=Y
EDT SET %DT="EX"
READ !,"End TRANSMIT DATE: ",X:DTIME
+1 if X=" "
SET X=IBBDD
if (X="")!(X["^")
GOTO BEGQ
DO ^%DT
KILL %DT
if Y<0
GOTO EDT
+2 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+3 SET IBEDT=Y
+4 IF Y<IBBDD
WRITE *7," ??",!,"END DATE must follow BEGIN DATE."
GOTO BDT
+5 SET DIR(0)="SBM^E:EDI;M:MRA;B:EDI/MRA"
SET DIR("A")="BILL TRANSMISSION TYPE"
+6 SET DIR("?")="Select the code to indicate the transmission type: EDI, MRA or both of EDI/MAR."
+7 DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+9 SET IBTYE=Y
+10 SET DIC="^VA(200,"
SET DIC(0)="AMEQ"
SET DIC("A")="Select AUTHORIZING BILLER: ALL// "
DO ^DIC
+11 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+12 IF Y<0
WRITE "ALL"
GOTO EN0
+13 SET ^TMP($JOB,"IBBIL",+Y)=""
+14 SET DIC("A")="Select Another AUTHORIZING BILLER: "
+15 FOR
Begin DoDot:1
+16 DO ^DIC
+17 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+18 if Y<0
QUIT
+19 SET ^TMP($JOB,"IBBIL",+Y)=""
End DoDot:1
if Y<0
QUIT
+20 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO BEGQ
EN0 KILL DIC
+1 SET (IBZ,DIR(0))="SBM^A:AUTHORIZING BILLER;B:BILLED AMOUNT;E:EPISODE OF CARE;P:PATIENT NAME;S:PATIENT SSN;Y:PAYER NAME;C:ERROR CODE"
SET DIR("A")="PRIMARY SORT BY"
+2 SET DIR("?")="Enter a code to indicate how the messages should be organized within the first sort level"
+3 DO ^DIR
KILL DIR
+4 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO BEGQ
+5 IF 'IBERR
IF Y="C"
WRITE !,IB0
GOTO EN0
+6 SET IBST1=Y
SET IBST3=Y(0)
ST2 SET DIR(0)=IBZ
SET DIR("A")="SECONDARY SORT BY"
+1 SET DIR("?")="Enter a code to indicate how the messages should be organized within the second sort level"
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO BEGQ
+4 IF 'IBERR
IF Y="C"
WRITE !,IB0
GOTO ST2
+5 SET IBST2=Y
SET IBST4=Y(0)
+6 IF IBST1=IBST2
WRITE !,"SECONDARY SORT must be different from PRIMARY SORT."
GOTO ST2
+7 ;
+8 NEW %ZIS,ZTSAVE,ZTRTN,ZTDESC
+9 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
+10 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+11 SET ZTRTN="EN^IBCERP2"
+12 SET ZTSAVE("IBST*")=""
SET ZTSAVE("IBERR")=""
SET ZTSAVE("IBTYE")=""
+13 SET ZTSAVE("IBBDD")=""
SET ZTSAVE("IBEDT")=""
+14 SET ZTSAVE("^TMP($J,""IBSORT"",")=""
+15 SET ZTDESC="IB - Electronic Error Report"
+16 DO ^%ZTLOAD
KILL ZTSK
DO HOME^%ZIS
End DoDot:1
GOTO BEGQ
+17 USE IO
EN ; Queued job entrypoint
+1 NEW IBSTOP,IBIFN,IBPAGE,IBLINE,IB,IB1,IBMRA,IBNAM,IBTOL,IBPAY,IBSSN,IBUER,IBDPT,IBCOD,IBDDT,IBSO1,IBSO2,IBEPO,IB399
+2 ;Only initial form feed for print to screen
if $EXTRACT(IOST,1,2)["C-"
WRITE @IOF
+3 SET IBDDT=IBBDD-1
FOR
SET IBDDT=$ORDER(^DGCR(399,"ALEX",IBDDT))
if 'IBDDT!(IBDDT<IBBDD)!(IBDDT>IBEDT)
QUIT
SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,"ALEX",IBDDT,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+4 ;episode of care by event dt for op, adm dt for in
+5 SET IB399=$GET(^DGCR(399,IBIFN,0))
+6 SET IBEPO=$PIECE(IB399,U,5)
+7 SET IBEPO=$SELECT(IBEPO<3:"I",1:"O")
+8 ;inpatient with adm date
IF IBEPO="I"
Begin DoDot:2
+9 SET IBEPO=$PIECE(IB399,U,2)
SET IBEPO=$SELECT($DATA(^DPT(IBEPO,.105)):$PIECE(^DGPM(^DPT(IBEPO,.105),0),U),1:$PIECE(IB399,U,3))
End DoDot:2
+10 IF IBEPO="O"
SET IBEPO=$PIECE(IB399,U,3)
+11 SET IBUER=$PIECE($GET(^DGCR(399,IBIFN,"S")),U,11)
+12 IF $ORDER(^TMP($JOB,"IBBIL",""))'=""
IF '$DATA(^TMP($JOB,"IBBIL",+IBUER))
QUIT
+13 SET IBDPT=$GET(^DPT(+$PIECE($GET(^DGCR(399,IBIFN,0)),U,2),0))
+14 SET IBUER=$SELECT(IBUER="":"UNKNOWN",1:$PIECE($GET(^VA(200,IBUER,0)),U))
+15 SET IBTOL=-$PIECE($GET(^DGCR(399,IBIFN,"U1")),U)
+16 SET IBNAM=$EXTRACT($PIECE(IBDPT,U),1,26)
+17 SET IBSSN=$EXTRACT($PIECE(IBDPT,U,9),1,9)
+18 SET IBPAY=$GET(^DGCR(399,IBIFN,"MP"))
+19 SET IBPAY=$SELECT(+IBPAY:$PIECE($GET(^DIC(36,+IBPAY,0)),U,1),$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)):"MEDICARE (WNR)",1:"PAYER NAME NOT FOUND")
+20 SET IB=0
FOR
SET IB=$ORDER(^IBM(361,"B",IBIFN,IB))
if 'IB
QUIT
Begin DoDot:2
+21 SET IB1=$GET(^IBM(361,IB,0))
+22 ;only display record with error message
if $PIECE(IB1,U,3)'="R"
QUIT
+23 SET IBMRA=$$MCRWNR^IBEFUNC(+$$POLICY^IBCEF(IBIFN,1,$PIECE(IB1,U,7)))
+24 IF IBTYE="M"
IF 'IBMRA
QUIT
+25 IF IBTYE="E"
IF IBMRA
QUIT
+26 SET IBCOD=0
+27 SET IBSO1=0
FOR
SET IBSO1=$ORDER(^IBM(361,IB,1,IBSO1))
if 'IBSO1
QUIT
SET IBSO2=$GET(^IBM(361,IB,1,IBSO1,0))
IF IBSO2["Error"
SET IBCOD=IBSO2
QUIT
+28 SET IBSO1=$SELECT(IBST1="B":IBTOL,IBST1="A":IBUER,IBST1="E":IBEPO,IBST1="P":IBNAM,IBST1="S":IBSSN,IBST1="Y":IBPAY,1:IBCOD)
+29 SET IBSO2=$SELECT(IBST2="B":IBTOL,IBST2="A":IBUER,IBST2="E":IBEPO,IBST2="P":IBNAM,IBST2="S":IBSSN,IBST2="Y":IBPAY,1:IBCOD)
+30 SET ^TMP($JOB,"IBSORT",IBSO1,IBSO2,IB)=IBIFN_U_IBTOL_U_IBUER_U_IBSSN_U_IBNAM_U_$SELECT(IBPAY=0:"",1:IBPAY)_U_IBCOD_U_$SELECT($PIECE(IB1,U,4):"PAYER",1:"NONE PAYER")_U_IBDDT_U_$PIECE(IB1,U,2)_U_IBEPO
End DoDot:2
End DoDot:1
+31 ;
LIST ;display
+1 NEW IBFLG,IBPAT,IBFST,IBSEC,IBWNR,IBUER,IBWR
+2 SET (IBFLG,IBSO2,IBSTOP,IBPAGE,IBWNR,IBWR)=0
+3 IF '$DATA(^TMP($JOB,"IBSORT"))
Begin DoDot:1
+4 DO HDR1
+5 WRITE !,"No entries found for this report"
End DoDot:1
GOTO BEGQ
+6 SET IBFST=""
FOR
SET IBFST=$ORDER(^TMP($JOB,"IBSORT",IBFST))
if IBFST=""!IBSTOP
QUIT
Begin DoDot:1
+7 IF 'IBFLG
DO HDR1
if IBSTOP
QUIT
SET IBFLG=1
+8 IF (IBST1="A")!(IBST1="P")
SET IBSO1=0
SET IBFLG=0
+9 SET IBSEC=""
FOR
SET IBSEC=$ORDER(^TMP($JOB,"IBSORT",IBFST,IBSEC))
if IBSEC=""!IBSTOP
QUIT
SET IB1=0
FOR
SET IB1=$ORDER(^TMP($JOB,"IBSORT",IBFST,IBSEC,IB1))
if 'IB1!IBSTOP
QUIT
SET IB=^TMP($JOB,"IBSORT",IBFST,IBSEC,IB1)
Begin DoDot:2
+10 IF (IBST1="A")!(IBST1="P")
SET IBSO1=IBSO1+1
+11 IF $PIECE(IB,U,6)["WNR"
SET IBWNR=IBWNR+1
+12 IF '$TEST
SET IBWR=IBWR+1
+13 SET IBSO2=IBSO2+1
+14 IF IBST1="E"!(IBST2="E")
WRITE "EPISODE OF CARE: "_$$DAT1^IBOUTL($PIECE(IB,U,11)),!
+15 if IBST2="A"
WRITE "AUTHORIZING BILLER: "_$PIECE(IB,U,3),!
+16 WRITE $$BN1^PRCAFN(+IB),?13,$PIECE(IB,U,4),?25,$EXTRACT($PIECE(IB,U,6),1,20),?50,$$DAT1^IBOUTL($PIECE(IB,U,10)),?61,$$DAT1^IBOUTL($PIECE(IB,U,9)),?71,$JUSTIFY(-$PIECE(IB,U,2),0,2),!
+17 IF IBST1'="P"
IF 'IBERR
WRITE "PATIENT: "_$PIECE(IB,U,5),!!
+18 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
QUIT
+19 ;no display error msg
if 'IBERR
QUIT
+20 SET IB0=0
FOR
SET IB0=$ORDER(^IBM(361,IB1,1,IB0))
if 'IB0!IBSTOP
QUIT
Begin DoDot:3
+21 NEW IBX,IBY
SET IBX=$GET(^IBM(361,IB1,1,IB0,0))
+22 FOR IBY=1:80:$LENGTH(IBX)
Begin DoDot:4
+23 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
QUIT
+24 WRITE $EXTRACT(IBX,IBY,IBY+79),!
End DoDot:4
if IBSTOP
QUIT
End DoDot:3
+25 if IBSTOP
QUIT
+26 WRITE !
+27 SET IBCOD=0
+28 SET IBX=0
FOR
SET IBX=$ORDER(^IBM(361.1,"B",+IB,IBX))
if 'IBX!IBCOD
QUIT
Begin DoDot:3
+29 SET IBY=$PIECE($GET(^IBM(361.1,IBX,0)),U,15)
+30 SET IBY=$SELECT(IBY=1:"P",IBY=2:"S",1:"T")
+31 IF $PIECE($GET(^IBM(361,IB1,0)),7)=IBY
SET IBCOD=IBX
End DoDot:3
+32 ;denied msg
IF IBCOD
IF $PIECE($GET(^IBM(361.1,IBCOD,0)),U,13)=2
Begin DoDot:3
+33 SET IB0=0
+34 FOR
SET IB0=$ORDER(^IBM(361.1,IBCOD,"ERR",IB0))
if 'IB0!IBSTOP
QUIT
Begin DoDot:4
+35 WRITE ?11,$GET(^IBM(361.1,1,IBCOD,"ERR",IB0,0)),!
+36 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
QUIT
End DoDot:4
End DoDot:3
if IBSTOP
QUIT
End DoDot:2
+37 if IBSTOP
QUIT
+38 IF (IBST1="A")!(IBST1="P")
Begin DoDot:2
+39 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
QUIT
+40 if 'IBERR
WRITE !
WRITE "SUBTOTAL # OF BILLS FOR "_IBFST_"= ",IBSO1,!!
End DoDot:2
if IBSTOP
QUIT
End DoDot:1
+41 if IBSTOP
GOTO BEGQ
+42 IF IBTYE="M"!(IBTYE="B")
Begin DoDot:1
+43 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
QUIT
+44 WRITE !,"TOTAL # OF MEDICARE (WNR) BILLS = ",IBWNR
End DoDot:1
if IBSTOP
GOTO BEGQ
+45 IF IBTYE="E"!(IBTYE="B")
Begin DoDot:1
+46 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
QUIT
+47 WRITE !,"TOTAL # OF EDI BILLS = ",IBWR
End DoDot:1
if IBSTOP
GOTO BEGQ
+48 IF ($Y+5)>IOSL
DO HDR1
if IBSTOP
GOTO BEGQ
+49 WRITE !,"GRAND TOTAL # OF BILLS = ",IBSO2
+50 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
BEGQ KILL ^TMP($JOB,"IBSORT"),^TMP($JOB,"IBBIL")
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 IF '$DATA(ZTQUEUED)
WRITE !
DO ^%ZISC
+3 QUIT
HDR1 ;
+1 NEW DIR,Y
+2 IF IBPAGE
Begin DoDot:1
+3 IF $EXTRACT(IOST,1,2)["C-"
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET IBSTOP=('Y)
if IBSTOP
QUIT
+4 WRITE @IOF
End DoDot:1
if IBSTOP
QUIT
+5 SET IBPAGE=IBPAGE+1
+6 WRITE !,?25,"ELECTRONIC ERROR REPORT",?72,"PAGE: ",IBPAGE,!,?25,"RUN DATE: ",$$HTE^XLFDT($HOROLOG,"2")
+7 WRITE !,?25,"DATE TRANSMITTED: ",$$DAT1^IBOUTL(IBBDD)_" - "_$$DAT1^IBOUTL(IBEDT)
+8 WRITE !,?25,"BILL TRANSMISSION TYPE: ",$SELECT(IBTYE="E":"EDI",IBTYE="M":"MRA",1:"EDI/MRA")
+9 WRITE !,?25,"SORT BY: "_IBST3_", "_IBST4
+10 IF (IBST1="A")!(IBST1="P")
WRITE !,$SELECT(IBST1="A":"AUTHORIZING BILLER: ",1:"PATIENT NAME: "),$GET(IBFST)
+11 WRITE !,?61,"DATE OF"
+12 WRITE !,?51,"DATE OF",?62,"LAST",?71,"BILLED"
+13 WRITE !,"BILL NUMBER",?13,"SSN",?25,"PAYER NAME",?50,"REJECTION",?61,"TRANSMIT",?71,"AMOUNT"
+14 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-"),!
+15 QUIT
+16 ;
