- 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 Feb 18, 2025@23:38:39 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 ;