| [623] | 1 | IBCBB1 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE ;2-NOV-89
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**27,52,80,93,106,51,151,148,153,137,232,280,155,320,343,349,363**;21-MAR-94;Build 35
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;MAP TO DGCRBB1
|
|---|
| 6 | ;
|
|---|
| 7 | % ;Bill Status
|
|---|
| 8 | N Z,Z0,Z1
|
|---|
| 9 | I $S(+IBST=0:1,1:"^1^2^3^4^7^"'[(U_IBST_U)) S IBER=IBER_"IB045;"
|
|---|
| 10 | ;
|
|---|
| 11 | ;Statement Covers From
|
|---|
| 12 | I IBFDT="" S IBER=IBER_"IB061;"
|
|---|
| 13 | I IBFDT]"",IBFDT'?7N&(IBFDT'?7N1".".N) S IBER=IBER_"IB061;"
|
|---|
| 14 | I IBFDT>IBTDT S IBER=IBER_"IB061;" ; from must be on or before the to date
|
|---|
| 15 | S IBFFY=$$FY^IBOUTL(IBFDT)
|
|---|
| 16 | ; if inpat - from date must not be prior to admit date.
|
|---|
| 17 | I $$INPAT^IBCEF(IBIFN,1),(IBFDT<($P($G(^DGPT(+$P(IBND0,U,8),0)),U,2)\1)) S IBER=IBER_"IB061;"
|
|---|
| 18 | ;
|
|---|
| 19 | ;Statement Covers To
|
|---|
| 20 | I IBTDT="" S IBER=IBER_"IB062;"
|
|---|
| 21 | I IBTDT]"",IBTDT'?7N&(IBTDT'?7N1".".N) S IBER=IBER_"IB062;"
|
|---|
| 22 | I IBTDT>DT!(IBTDT<IBFDT) S IBER=IBER_"IB062;" ; to date must not be >than today's date
|
|---|
| 23 | S IBTFY=$$FY^IBOUTL(IBTDT)
|
|---|
| 24 | ;
|
|---|
| 25 | ;Statement crosses fiscal years
|
|---|
| 26 | ;I IBTFY'=IBFFY S IBER=IBER_"IB047;"
|
|---|
| 27 | ;
|
|---|
| 28 | ;Statement crosses calendar years
|
|---|
| 29 | ;I $E(IBTDT,1,3)'=$E(IBFDT,1,3) S IBER=IBER_"IB046;"
|
|---|
| 30 | ;
|
|---|
| 31 | ;Total Charges
|
|---|
| 32 | I +IBTC'>0!(+IBTC'=IBTC) S IBER=IBER_"IB064;"
|
|---|
| 33 | ;
|
|---|
| 34 | ;Billable charges for secondary claim
|
|---|
| 35 | I $$MCRONBIL^IBEFUNC(IBIFN)&(($P(IBNDU1,U,1)-$P(IBNDU1,U,2))'>0) S IBER=IBER_"IB094;"
|
|---|
| 36 | ;Fiscal Year 1
|
|---|
| 37 | S IBFFY=$$FY^IBOUTL(IBFDT)
|
|---|
| 38 | ;
|
|---|
| 39 | ;Check provider link for current user, enterer, reviewer and Authorizor
|
|---|
| 40 | I '$D(^VA(200,DUZ,0)) S IBER=IBER_"IB048;"
|
|---|
| 41 | I IBEU]"",'$D(^VA(200,IBEU,0)) S IBER=IBER_"IB048;"
|
|---|
| 42 | I IBRU]"",'$D(^VA(200,IBRU,0)) S IBER=IBER_"IB060;"
|
|---|
| 43 | I IBAU]"",'$D(^VA(200,IBAU,0)) S IBER=IBER_"IB041;"
|
|---|
| 44 | ;
|
|---|
| 45 | ;Bill exists and not already new bill
|
|---|
| 46 | ;I $S('$D(^PRCA(430,IBIFN,0)):1,$P($P(^PRCA(430,IBIFN,0),"^"),"-",2)'=IBBNO:1,1:0) S IBER=IBER_"IB056;"
|
|---|
| 47 | ;I $P($$BN^PRCAFN(IBIFN),"-",2)'=IBBNO S IBER=IBER_"IB056;"
|
|---|
| 48 | ;I IBER="",$P(^PRCA(430,IBIFN,0),"^",8)=$O(^PRCA(430.3,"AC",104,"")) S IBER=IBER_"IB040;"
|
|---|
| 49 | I IBER="",+$$STA^PRCAFN(IBIFN)=104 S IBER=IBER_"IB040;"
|
|---|
| 50 | ; If ins bill, must have valid COB sequence
|
|---|
| 51 | I $P(IBND0,U,11)="i",$S($P(IBND0,U,21)="":1,1:"PST"'[$P(IBND0,U,21)) S IBER=IBER_"IB324;"
|
|---|
| 52 | ;
|
|---|
| 53 | ; Check for valid sec provider id for current ins
|
|---|
| 54 | S Z=0 F S Z=$O(^DGCR(399,IBIFN,"PRV",Z)) Q:'Z S Z0=$G(^(Z,0)),Z1=+$$COBN^IBCEF(IBIFN) I $P(Z0,U,4+Z1)'="",$P(Z0,U,11+Z1)'="" D
|
|---|
| 55 | . I '$$SECIDCK^IBCEF74(IBIFN,Z1,$P(Z0,U,11+Z1),Z) D WARN^IBCBB11("Prov secondary id type for the "_$P("PRIMARY^SECONDARY^TERTIARY",U,Z1)_" "_$$EXTERNAL^DILFD(399.0222,.01,,+Z0)_" is invalid/won't transmit")
|
|---|
| 56 | ; Check NPIs
|
|---|
| 57 | D NPICHK^IBCBB11
|
|---|
| 58 | ;
|
|---|
| 59 | ; Check taxonomies
|
|---|
| 60 | D TAXCHK^IBCBB11
|
|---|
| 61 | ;
|
|---|
| 62 | ; Check for Physician Name
|
|---|
| 63 | K IBXDATA D F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
|
|---|
| 64 | I $P($G(IBXDATA),U)="" S IBER=IBER_"IB303;"
|
|---|
| 65 | ;
|
|---|
| 66 | N FUNCTION,IBINS
|
|---|
| 67 | S FUNCTION=$S($$FT^IBCEF(IBIFN)=3:4,1:3)
|
|---|
| 68 | I IBER'["IB303;" D
|
|---|
| 69 | . F IBINS=1:1:3 D
|
|---|
| 70 | .. S Z=$$GETTYP^IBCEP2A(IBIFN,IBINS)
|
|---|
| 71 | .. I Z,$P(Z,U,2) D ; Rendering/attending prov secondary id required
|
|---|
| 72 | ... N IBID,IBOK,Q0
|
|---|
| 73 | ... D PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C") ; check all as though they were current
|
|---|
| 74 | ... S IBOK=0
|
|---|
| 75 | ... S Q0=0 F S Q0=$O(IBID(1,FUNCTION,Q0)) Q:'Q0 I $P(IBID(1,FUNCTION,Q0),U,9)=+Z S IBOK=1 Q
|
|---|
| 76 | ... I 'IBOK S IBER=IBER_$S(IBINS=1:"IB236;",IBINS=2:"IB237;",IBINS=3:"IB238;",1:"")
|
|---|
| 77 | . I $$TXMT^IBCEF4(IBIFN) D
|
|---|
| 78 | .. D F^IBCEF("N-ALL ATT/REND PROV SSN/EI","IBZ",,IBIFN)
|
|---|
| 79 | .. I $P(IBZ,U,3)=""&($P(IBZ,U,4)="") S IBER=IBER_"IB321;" ; SSN/IEN required for rend/att
|
|---|
| 80 | ;
|
|---|
| 81 | N IBM,IBM1
|
|---|
| 82 | S IBM=$G(^DGCR(399,IBIFN,"M"))
|
|---|
| 83 | S IBM1=$G(^DGCR(399,IBIFN,"M1"))
|
|---|
| 84 | I $P(IBM,U),$P($G(^DIC(36,$P(IBM,U),4)),U,6),$P(IBM1,U,2)="" S IBER=IBER_"IB244;"
|
|---|
| 85 | I $P(IBM,U,2),$P($G(^DIC(36,$P(IBM,U,2),4)),U,6),$P(IBM1,U,3)="" S IBER=IBER_"IB245;"
|
|---|
| 86 | I $P(IBM,U,3),$P($G(^DIC(36,$P(IBM,U,3),4)),U,6),$P(IBM1,U,4)="" S IBER=IBER_"IB246;"
|
|---|
| 87 | ;
|
|---|
| 88 | ; If outside facility, check for ID and qualifier in 355.93
|
|---|
| 89 | ; 5/15/06 - esg - hard error IB243 turned into warning message instead
|
|---|
| 90 | S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10)
|
|---|
| 91 | I Z D
|
|---|
| 92 | . I $P($G(^IBA(355.93,Z,0)),U,9)=""!($P($G(^IBA(355.93,Z,0)),U,13)="") D
|
|---|
| 93 | .. N Z1,Z2
|
|---|
| 94 | .. S Z1="Missing Lab or Facility Primary ID for non-VA facility, "
|
|---|
| 95 | .. S Z2=$$EXTERNAL^DILFD(399,232,,Z)
|
|---|
| 96 | .. I $L(Z2)'>19 D WARN^IBCBB11(Z1_Z2) Q
|
|---|
| 97 | .. D WARN^IBCBB11(Z1),WARN^IBCBB11(" "_Z2)
|
|---|
| 98 | .. Q
|
|---|
| 99 | . Q
|
|---|
| 100 | ;
|
|---|
| 101 | ; Must be one and only one division on bill
|
|---|
| 102 | S IBZ=$$MULTDIV^IBCBB11(IBIFN,IBND0)
|
|---|
| 103 | I IBZ S IBER=IBER_$S(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
|
|---|
| 104 | ; Division address must be defined in institution file
|
|---|
| 105 | I $P(IBND0,U,22) D
|
|---|
| 106 | . N Z,Z0,Z1
|
|---|
| 107 | . S Z0=$G(^DIC(4,+$P($G(^DG(40.8,+$P(IBND0,U,22),0)),U,7),0))
|
|---|
| 108 | . S Z1=$G(^DIC(4,+$P($G(^DG(40.8,+$P(IBND0,U,22),0)),U,7),1))
|
|---|
| 109 | . I $P(Z0,U,2)="" S IBER=IBER_"IB097;" Q
|
|---|
| 110 | . F Z=1,3,4 I $P(Z1,U,Z)="" S IBER=IBER_"IB097;" Q
|
|---|
| 111 | ;
|
|---|
| 112 | ;CHAMPVA Rate Type and Primary Insurance Carriers Type of Coverage must match
|
|---|
| 113 | S (IBRTCHV,IBPICHV)=0
|
|---|
| 114 | I $P($G(^DGCR(399.3,+IBAT,0)),U,1)="CHAMPVA" S IBRTCHV=1
|
|---|
| 115 | I $P($G(^IBE(355.2,+$P($G(^DIC(36,+IBNDMP,0)),U,13),0)),U,1)="CHAMPVA" S IBPICHV=1
|
|---|
| 116 | I (+IBRTCHV!+IBPICHV)&('IBRTCHV!'IBPICHV) S IBER=IBER_"IB085;"
|
|---|
| 117 | ;
|
|---|
| 118 | N IBZPRC,IBZPRCUB
|
|---|
| 119 | D F^IBCEF("N-ALL PROCEDURES","IBZPRC",,IBIFN)
|
|---|
| 120 | ; Procedure Clinic is required for Surgical Procedures Outpt Facility Charges
|
|---|
| 121 | I +$P(IBND0,U,27)'=2,$$BILLRATE^IBCRU3(IBAT,IBCL,IBEVDT,"RC OUTPATIENT") D
|
|---|
| 122 | . N Z,Z0,Z1,ZE S (ZE,Z)=0 F S Z=$O(^DGCR(399,IBIFN,"CP",Z)) Q:'Z D I +ZE S IBER=IBER_"IB320;" Q
|
|---|
| 123 | .. S Z0=$G(^DGCR(399,IBIFN,"CP",Z,0)),Z1=+Z0 I Z0'[";ICPT(" Q
|
|---|
| 124 | .. I '((Z1'<10000)&(Z1'>69999))&'((Z1'<93501)&(Z1'>93533)) Q
|
|---|
| 125 | .. I '$P(Z0,U,7) S ZE=1
|
|---|
| 126 | ;
|
|---|
| 127 | ; Extract procedures for UB-04
|
|---|
| 128 | D F^IBCEF("N-UB-04 PROCEDURES","IBZPRCUB",,IBIFN)
|
|---|
| 129 | ; Does this bill have ANY prescriptions associated with it?
|
|---|
| 130 | ; Must bill prescriptions separately from other charges
|
|---|
| 131 | ;
|
|---|
| 132 | I $$ISRX^IBCEF1(IBIFN) D
|
|---|
| 133 | . N IBZ,IBRXDEF
|
|---|
| 134 | . S IBRXDEF=$P($G(^IBE(350.9,1,1)),U,30),IBZ=0
|
|---|
| 135 | . F S IBZ=$O(IBZPRCUB(IBZ)) Q:'IBZ I IBZPRCUB(IBZ),+$P(IBZPRCUB(IBZ),U)'=IBRXDEF S IBER=IBER_"IB102;" Q
|
|---|
| 136 | . K IBZ
|
|---|
| 137 | ;
|
|---|
| 138 | ; Check that COB sequences are not skipped
|
|---|
| 139 | K Z
|
|---|
| 140 | F Z=1:1:3 S:+$G(^DGCR(399,IBIFN,"I"_Z)) Z(Z)=""
|
|---|
| 141 | F Z=0:1:2 S Z0=$O(Z(Z)) Q:'Z0 I Z0'=(Z+1) S IBER=IBER_"IB322;" Q
|
|---|
| 142 | K Z
|
|---|
| 143 | I $P($G(^DGCR(399,IBIFN,0)),U,21)="" S IBER=IBER_"IB323;"
|
|---|
| 144 | K IBXDATA D F^IBCEF("N-PROCEDURE CODING METHD",,,IBIFN)
|
|---|
| 145 | ; Coding method should agree with types of procedure codes
|
|---|
| 146 | S IBOK=$S('$O(IBZPRC(0))!(IBXDATA=""):1,1:0)
|
|---|
| 147 | I 'IBOK S IBOK=1,IBZ=0 F S IBZ=$O(IBZPRC(IBZ)) Q:'IBZ I IBZPRC(IBZ),$P(IBZPRC(IBZ),U)'[$S(IBXDATA=9:"ICD",1:"ICP") S IBOK=0 Q
|
|---|
| 148 | I 'IBOK D WARN^IBCBB11("Coding Method does not agree with all procedure codes found on bill")
|
|---|
| 149 | D EDITMRA^IBCBB3(.IBQUIT,.IBER,IBIFN,IBFT)
|
|---|
| 150 | Q:$G(IBQUIT)
|
|---|
| 151 | ;
|
|---|
| 152 | ;Other things that could be added: Rev Code - calculating charges
|
|---|
| 153 | ; Diagnosis Coding, if MT copay - check for other co-payments
|
|---|
| 154 | ;
|
|---|
| 155 | I $P(IBNDTX,U,8),$$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB121;" ; can't force MRAs to print
|
|---|
| 156 | I $P(IBNDTX,U,8)!$P(IBNDTX,U,9) D WARN^IBCBB11($S($$REQMRA^IBEFUNC(IBIFN)&($P(IBNDTX,U,9)):"MRA Secondary ",1:"")_"Bill has been forced to print "_$S($P(IBNDTX,U,8)=1!($P(IBNDTX,U,9)=1):"locally",1:"at clearinghouse"))
|
|---|
| 157 | N IBXZ,IBIZ F IBIZ=12,13,14 S IBXZ=$P(IBNDM,U,IBIZ) I +IBXZ S IBXZ=$P($G(^DPT(DFN,.312,IBXZ,0)),U,18) I +IBXZ S IBXZ=$G(^IBA(355.3,+IBXZ,0)) I +$P(IBXZ,U,12) D
|
|---|
| 158 | . D WARN^IBCBB11($P($G(^DIC(36,+IBXZ,0)),U,1)_" requires Amb Care Certification")
|
|---|
| 159 | ;
|
|---|
| 160 | D VALNDC^IBCBB11(IBIFN,DFN) ;validate NDC#
|
|---|
| 161 | ;Build AR array if no errors and MRA not needed or already rec'd
|
|---|
| 162 | I IBER="",$S($$NEEDMRA^IBEFUNC(IBIFN)!($$REQMRA^IBEFUNC(IBIFN)):0,1:1) D ARRAY
|
|---|
| 163 | ;
|
|---|
| 164 | END ;Don't kill IBIFN, IBER, DFN
|
|---|
| 165 | I $O(^TMP($J,"BILL-WARN",0)),$G(IBER)="" S IBER="WARN" ;Warnings only
|
|---|
| 166 | K IBBNO,IBEVDT,IBLOC,IBCL,IBTF,IBAT,IBWHO,IBST,IBFDT,IBTDT,IBTC,IBFY,IBFY1,IBAU,IBRU,IBEU,IBARTP,IBFYC,IBMRA,IBTOB,IBTOB12,IBNDU2,IBNDUF3,IBNDUF31,IBNDTX
|
|---|
| 167 | K IBNDS,IBND0,IBNDU,IBNDM,IBNDMP,IBNDU1,IBFFY,IBTFY,IBFT,IBRTCHV,IBPICHV,IBXDATA,IBOK
|
|---|
| 168 | I $D(IBER),IBER="" W !,"No Errors found for National edits"
|
|---|
| 169 | Q
|
|---|
| 170 | ;
|
|---|
| 171 | ARRAY ;Build PRCASV(array)
|
|---|
| 172 | N IBCOBN,X
|
|---|
| 173 | K PRCASV
|
|---|
| 174 | Q:$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))
|
|---|
| 175 | S IBCOBN=$$COBN^IBCEF(IBIFN)
|
|---|
| 176 | S X=IBIFN
|
|---|
| 177 | S PRCASV("BDT")=DT,PRCASV("ARREC")=IBIFN
|
|---|
| 178 | S PRCASV("APR")=DUZ
|
|---|
| 179 | S PRCASV("PAT")=DFN,PRCASV("CAT")=$P(^DGCR(399.3,IBAT,0),"^",6)
|
|---|
| 180 | I IBWHO="i" S PRCASV("DEBTOR")=+IBNDMP_";DIC(36,"
|
|---|
| 181 | S PRCASV("DEBTOR")=$S(IBWHO="p":DFN_";DPT(",IBWHO="o":$P(IBNDM,"^",11)_";DIC(4,",IBWHO="i":PRCASV("DEBTOR"),1:"")
|
|---|
| 182 | S PRCASV("CARE")=$E($$TOB^IBCEF1(IBIFN),1,2)
|
|---|
| 183 | S PRCASV("FY")=$$FY^IBOUTL(DT)_U_($P(IBNDU1,U)-$P(IBNDU1,U,2))
|
|---|
| 184 | ;S PRCASV("FY")=$P(IBNDU1,U,9)_U_$S($P(IBNDU1,U,2)]"":($P(IBNDU1,U,10)-$P(IBNDU1,U,2)),1:$P(IBNDU1,U,10))_$S($P(IBNDU1,U,11)]"":U_$P(IBNDU1,U,11)_U_$P(IBNDU1,U,12),1:"")
|
|---|
| 185 | PLUS I IBWHO="i",$P(IBNDM,"^",2),$D(^DIC(36,$P(IBNDM,"^",2),0)) S PRCASV("2NDINS")=$P(IBNDM,"^",2)
|
|---|
| 186 | I IBWHO="i",$P(IBNDM,"^",3),$D(^DIC(36,$P(IBNDM,"^",3),0)) S PRCASV("3RDINS")=$P(IBNDM,"^",3)
|
|---|
| 187 | ;
|
|---|
| 188 | N IBX S IBX=$P(IBND0,U,21),IBX=$S(IBX="P":"I1",IBX="S":"I2",IBX="T":"I3",1:"") Q:IBX=""
|
|---|
| 189 | N IBNDI1
|
|---|
| 190 | Q:'$D(^DGCR(399,IBIFN,IBX)) S IBNDI1=^(IBX)
|
|---|
| 191 | S:$P(IBNDI1,"^",3)]"" PRCASV("GPNO")=$P(IBNDI1,"^",3)
|
|---|
| 192 | S:$P(IBNDI1,"^",15)]"" PRCASV("GPNM")=$P(IBNDI1,"^",15)
|
|---|
| 193 | S:$P(IBNDI1,"^",17)]"" PRCASV("INPA")=$P(IBNDI1,"^",17)
|
|---|
| 194 | S:$P(IBNDI1,"^",2)]"" PRCASV("IDNO")=$P(IBNDI1,"^",2),PRCASV("INID")=PRCASV("IDNO")
|
|---|
| 195 | ; Check that this is a secondary or tertiary bill and insurance for previous
|
|---|
| 196 | ; COB sequence is Medicare WNR and MRA is active --> send data elements to AR
|
|---|
| 197 | I IBCOBN>1,$$WNRBILL^IBEFUNC(IBIFN,IBCOBN-1),$$EDIACTV^IBCEF4(2) D MRA
|
|---|
| 198 | Q
|
|---|
| 199 | ;
|
|---|
| 200 | MRA N IBEOB S IBEOB=0
|
|---|
| 201 | ;
|
|---|
| 202 | K PRCASV("MEDURE"),PRCASV("MEDCA")
|
|---|
| 203 | ; Get EOB data
|
|---|
| 204 | F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D
|
|---|
| 205 | . D MRACALC^IBCEMU2(IBEOB,IBIFN,1,.PRCASV)
|
|---|
| 206 | Q ;MRA
|
|---|
| 207 | ;
|
|---|
| 208 | ;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
|
|---|
| 209 | ;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
|
|---|
