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

IBCERP2.m

Go to the documentation of this file.
  1. IBCERP2 ;ALB/CXW - ELECTRONIC ERROR REPORT ; 3/13/07 1:14pm
  1. ;;2.0;INTEGRATED BILLING;**137,367**;21-MAR-94;Build 11
  1. Q
  1. BEG ; Report of electronic error
  1. N DIR,DIRUT,DIROUT,DTOUT,DUOUT,DIC,%DT,IBZ
  1. N IB0,IBBDD,IBEDT,IBST1,IBST2,IBST3,IBST4,IBERR,IBTYE,Y
  1. S IB0="No ERROR CODE as sort level when error messages are not displayed"
  1. S DIR("A")="DO YOU WANT TO INCLUDE THE ERROR MESSAGES? ",DIR(0)="YA",DIR("B")="YES"
  1. S DIR("?")="YES indicates to display the error record with messages, or NO indicates to display the error record without messages."
  1. D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S IBERR=+Y
  1. BDT S %DT="AEPX",%DT("A")="Begin TRANSMIT DATE: "
  1. D ^%DT K %DT G BEGQ:Y<0
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S IBBDD=Y
  1. EDT S %DT="EX" R !,"End TRANSMIT DATE: ",X:DTIME
  1. S:X=" " X=IBBDD G BEGQ:(X="")!(X["^") D ^%DT K %DT G EDT:Y<0
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S IBEDT=Y
  1. I Y<IBBDD W *7," ??",!,"END DATE must follow BEGIN DATE." G BDT
  1. S DIR(0)="SBM^E:EDI;M:MRA;B:EDI/MRA",DIR("A")="BILL TRANSMISSION TYPE"
  1. S DIR("?")="Select the code to indicate the transmission type: EDI, MRA or both of EDI/MAR."
  1. D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. S IBTYE=Y
  1. S DIC="^VA(200,",DIC(0)="AMEQ",DIC("A")="Select AUTHORIZING BILLER: ALL// " D ^DIC
  1. I $D(DTOUT)!($D(DUOUT)) Q
  1. I Y<0 W "ALL" G EN0
  1. S ^TMP($J,"IBBIL",+Y)=""
  1. S DIC("A")="Select Another AUTHORIZING BILLER: "
  1. F D Q:Y<0
  1. . D ^DIC
  1. . I $D(DTOUT)!($D(DUOUT)) Q
  1. . Q:Y<0
  1. . S ^TMP($J,"IBBIL",+Y)=""
  1. I $D(DTOUT)!($D(DUOUT)) G BEGQ
  1. EN0 K DIC
  1. 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"
  1. S DIR("?")="Enter a code to indicate how the messages should be organized within the first sort level"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) G BEGQ
  1. I 'IBERR,Y="C" W !,IB0 G EN0
  1. S IBST1=Y,IBST3=Y(0)
  1. ST2 S DIR(0)=IBZ,DIR("A")="SECONDARY SORT BY"
  1. S DIR("?")="Enter a code to indicate how the messages should be organized within the second sort level"
  1. D ^DIR K DIR
  1. I $D(DTOUT)!($D(DUOUT)) G BEGQ
  1. I 'IBERR,Y="C" W !,IB0 G ST2
  1. S IBST2=Y,IBST4=Y(0)
  1. I IBST1=IBST2 W !,"SECONDARY SORT must be different from PRIMARY SORT." G ST2
  1. ;
  1. N %ZIS,ZTSAVE,ZTRTN,ZTDESC
  1. S %ZIS="QM" D ^%ZIS Q:POP
  1. I $D(IO("Q")) K IO("Q") D G BEGQ
  1. . S ZTRTN="EN^IBCERP2"
  1. . S ZTSAVE("IBST*")="",ZTSAVE("IBERR")="",ZTSAVE("IBTYE")=""
  1. . S ZTSAVE("IBBDD")="",ZTSAVE("IBEDT")=""
  1. . S ZTSAVE("^TMP($J,""IBSORT"",")=""
  1. . S ZTDESC="IB - Electronic Error Report"
  1. . D ^%ZTLOAD K ZTSK D HOME^%ZIS
  1. U IO
  1. EN ; Queued job entrypoint
  1. N IBSTOP,IBIFN,IBPAGE,IBLINE,IB,IB1,IBMRA,IBNAM,IBTOL,IBPAY,IBSSN,IBUER,IBDPT,IBCOD,IBDDT,IBSO1,IBSO2,IBEPO,IB399
  1. W:$E(IOST,1,2)["C-" @IOF ;Only initial form feed for print to screen
  1. 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
  1. . ;episode of care by event dt for op, adm dt for in
  1. . S IB399=$G(^DGCR(399,IBIFN,0))
  1. . S IBEPO=$P(IB399,U,5)
  1. . S IBEPO=$S(IBEPO<3:"I",1:"O")
  1. . I IBEPO="I" D ;inpatient with adm date
  1. .. S IBEPO=$P(IB399,U,2),IBEPO=$S($D(^DPT(IBEPO,.105)):$P(^DGPM(^DPT(IBEPO,.105),0),U),1:$P(IB399,U,3))
  1. . I IBEPO="O" S IBEPO=$P(IB399,U,3)
  1. . S IBUER=$P($G(^DGCR(399,IBIFN,"S")),U,11)
  1. . I $O(^TMP($J,"IBBIL",""))'="",'$D(^TMP($J,"IBBIL",+IBUER)) Q
  1. . S IBDPT=$G(^DPT(+$P($G(^DGCR(399,IBIFN,0)),U,2),0))
  1. . S IBUER=$S(IBUER="":"UNKNOWN",1:$P($G(^VA(200,IBUER,0)),U))
  1. . S IBTOL=-$P($G(^DGCR(399,IBIFN,"U1")),U)
  1. . S IBNAM=$E($P(IBDPT,U),1,26)
  1. . S IBSSN=$E($P(IBDPT,U,9),1,9)
  1. . S IBPAY=$G(^DGCR(399,IBIFN,"MP"))
  1. . S IBPAY=$S(+IBPAY:$P($G(^DIC(36,+IBPAY,0)),U,1),$$MCRWNR^IBEFUNC($$CURR^IBCEF2(IBIFN)):"MEDICARE (WNR)",1:"PAYER NAME NOT FOUND")
  1. . S IB=0 F S IB=$O(^IBM(361,"B",IBIFN,IB)) Q:'IB D
  1. .. S IB1=$G(^IBM(361,IB,0))
  1. .. Q:$P(IB1,U,3)'="R" ;only display record with error message
  1. .. S IBMRA=$$MCRWNR^IBEFUNC(+$$POLICY^IBCEF(IBIFN,1,$P(IB1,U,7)))
  1. .. I IBTYE="M",'IBMRA Q
  1. .. I IBTYE="E",IBMRA Q
  1. .. S IBCOD=0
  1. .. 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
  1. .. S IBSO1=$S(IBST1="B":IBTOL,IBST1="A":IBUER,IBST1="E":IBEPO,IBST1="P":IBNAM,IBST1="S":IBSSN,IBST1="Y":IBPAY,1:IBCOD)
  1. .. S IBSO2=$S(IBST2="B":IBTOL,IBST2="A":IBUER,IBST2="E":IBEPO,IBST2="P":IBNAM,IBST2="S":IBSSN,IBST2="Y":IBPAY,1:IBCOD)
  1. .. 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
  1. ;
  1. LIST ;display
  1. N IBFLG,IBPAT,IBFST,IBSEC,IBWNR,IBUER,IBWR
  1. S (IBFLG,IBSO2,IBSTOP,IBPAGE,IBWNR,IBWR)=0
  1. I '$D(^TMP($J,"IBSORT")) D G BEGQ
  1. . D HDR1
  1. . W !,"No entries found for this report"
  1. S IBFST="" F S IBFST=$O(^TMP($J,"IBSORT",IBFST)) Q:IBFST=""!IBSTOP D
  1. . I 'IBFLG D HDR1 Q:IBSTOP S IBFLG=1
  1. . I (IBST1="A")!(IBST1="P") S IBSO1=0,IBFLG=0
  1. . 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
  1. .. I (IBST1="A")!(IBST1="P") S IBSO1=IBSO1+1
  1. .. I $P(IB,U,6)["WNR" S IBWNR=IBWNR+1
  1. .. E S IBWR=IBWR+1
  1. .. S IBSO2=IBSO2+1
  1. .. I IBST1="E"!(IBST2="E") W "EPISODE OF CARE: "_$$DAT1^IBOUTL($P(IB,U,11)),!
  1. .. W:IBST2="A" "AUTHORIZING BILLER: "_$P(IB,U,3),!
  1. .. 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),!
  1. .. I IBST1'="P",'IBERR W "PATIENT: "_$P(IB,U,5),!!
  1. .. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  1. .. Q:'IBERR ;no display error msg
  1. .. S IB0=0 F S IB0=$O(^IBM(361,IB1,1,IB0)) Q:'IB0!IBSTOP D
  1. ... N IBX,IBY S IBX=$G(^IBM(361,IB1,1,IB0,0))
  1. ... F IBY=1:80:$L(IBX) D Q:IBSTOP
  1. .... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  1. .... W $E(IBX,IBY,IBY+79),!
  1. .. Q:IBSTOP
  1. .. W !
  1. .. S IBCOD=0
  1. .. S IBX=0 F S IBX=$O(^IBM(361.1,"B",+IB,IBX)) Q:'IBX!IBCOD D
  1. ... S IBY=$P($G(^IBM(361.1,IBX,0)),U,15)
  1. ... S IBY=$S(IBY=1:"P",IBY=2:"S",1:"T")
  1. ... I $P($G(^IBM(361,IB1,0)),7)=IBY S IBCOD=IBX
  1. .. I IBCOD,$P($G(^IBM(361.1,IBCOD,0)),U,13)=2 D Q:IBSTOP ;denied msg
  1. ... S IB0=0
  1. ... F S IB0=$O(^IBM(361.1,IBCOD,"ERR",IB0)) Q:'IB0!IBSTOP D
  1. .... W ?11,$G(^IBM(361.1,1,IBCOD,"ERR",IB0,0)),!
  1. .... I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  1. . Q:IBSTOP
  1. . I (IBST1="A")!(IBST1="P") D Q:IBSTOP
  1. .. I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  1. .. W:'IBERR ! W "SUBTOTAL # OF BILLS FOR "_IBFST_"= ",IBSO1,!!
  1. G:IBSTOP BEGQ
  1. I IBTYE="M"!(IBTYE="B") D G:IBSTOP BEGQ
  1. . I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  1. . W !,"TOTAL # OF MEDICARE (WNR) BILLS = ",IBWNR
  1. I IBTYE="E"!(IBTYE="B") D G:IBSTOP BEGQ
  1. . I ($Y+5)>IOSL D HDR1 Q:IBSTOP
  1. . W !,"TOTAL # OF EDI BILLS = ",IBWR
  1. I ($Y+5)>IOSL D HDR1 G:IBSTOP BEGQ
  1. W !,"GRAND TOTAL # OF BILLS = ",IBSO2
  1. I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR
  1. BEGQ K ^TMP($J,"IBSORT"),^TMP($J,"IBBIL")
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. I '$D(ZTQUEUED) W ! D ^%ZISC
  1. Q
  1. HDR1 ;
  1. N DIR,Y
  1. I IBPAGE D Q:IBSTOP
  1. . I $E(IOST,1,2)["C-" K DIR S DIR(0)="E" D ^DIR K DIR S IBSTOP=('Y) Q:IBSTOP
  1. . W @IOF
  1. S IBPAGE=IBPAGE+1
  1. W !,?25,"ELECTRONIC ERROR REPORT",?72,"PAGE: ",IBPAGE,!,?25,"RUN DATE: ",$$HTE^XLFDT($H,"2")
  1. W !,?25,"DATE TRANSMITTED: ",$$DAT1^IBOUTL(IBBDD)_" - "_$$DAT1^IBOUTL(IBEDT)
  1. W !,?25,"BILL TRANSMISSION TYPE: ",$S(IBTYE="E":"EDI",IBTYE="M":"MRA",1:"EDI/MRA")
  1. W !,?25,"SORT BY: "_IBST3_", "_IBST4
  1. I (IBST1="A")!(IBST1="P") W !,$S(IBST1="A":"AUTHORIZING BILLER: ",1:"PATIENT NAME: "),$G(IBFST)
  1. W !,?61,"DATE OF"
  1. W !,?51,"DATE OF",?62,"LAST",?71,"BILLED"
  1. W !,"BILL NUMBER",?13,"SSN",?25,"PAYER NAME",?50,"REJECTION",?61,"TRANSMIT",?71,"AMOUNT"
  1. W !,$TR($J("",80)," ","-"),!
  1. Q
  1. ;