source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCERP2.m@ 1261

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
 ;