IBCBB1 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE ;2-NOV-89
;;2.0;INTEGRATED BILLING;**27,52,80,93,106,51,151,148,153,137,232,280,155,320,343,349,363,371,395,384,432,447,488,554,577,592,608,623,641,665,702,759**;21-MAR-94;Build 24
;Per VA Directive 6402, this routine should not be modified.
;
; *** Begin IB*2.0*488 VD (Issue 46 RBN)
N I
S I=""
S X=+$G(^DGCR(399,IBIFN,"MP"))
I 'X,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S X=+$$CURR^IBCEF2(IBIFN)
;JWS;IB*2.0*592:US1108 - Dental form check
I X,+$G(^DIC(36,X,3)) S I=$P(^(3),U,$S($$FT^IBCEF(IBIFN)=2:2,$$FT^IBCEF(IBIFN)=7:15,1:4))
S I=$$UP^XLFSTR(I)
I (I'=""&(I["PRNT")&($G(IBER)'["IB488")) D
. S IBER=$G(IBER)_"IB488;"
;
; Cause an error if FORCED TO PRINT TO CLEARINGHOUSE
I $P($G(^DGCR(399,IBIFN,"TX")),U,8)=2 D
. S IBER=$G(IBER)_"IB489;"
;
; Cause a fatal error if the claim has no procedures & is NOT a UB-04 Inpatient claim.
I +$O(^DGCR(399,IBIFN,"CP",0))=0 D
.I $$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN) Q ; inpatient UB-04 check
.I '$$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN) D Q ; Outpatient Institutional Claim.
..I IBER["IB352" Q
..S IBER=IBER_"IB352;"
.;
.; Professional claim
.I IBER["IB353" Q
.S IBER=IBER_"IB353;"
.Q
; *** End IB*2.0*488 -- VD
;
;MAP TO DGCRBB1
;
% ;Bill Status
N Z,Z0,Z1,IBFT
I $S(+IBST=0:1,1:"^1^2^3^4^7^"'[(U_IBST_U)) S IBER=IBER_"IB045;"
;
;Statement Covers From
I IBFDT="" S IBER=IBER_"IB061;"
I IBFDT]"",IBFDT'?7N&(IBFDT'?7N1".".N) S IBER=IBER_"IB061;"
I IBFDT>IBTDT S IBER=IBER_"IB061;" ; from must be on or before the to date
S IBFFY=$$FY^IBOUTL(IBFDT)
; if inpat - from date must not be prior to admit date.
I $$INPAT^IBCEF(IBIFN,1),(IBFDT<($P($G(^DGPT(+$P(IBND0,U,8),0)),U,2)\1)) S IBER=IBER_"IB061;"
;
;Statement Covers To
I IBTDT="" S IBER=IBER_"IB062;"
I IBTDT]"",IBTDT'?7N&(IBTDT'?7N1".".N) S IBER=IBER_"IB062;"
I IBTDT>DT!(IBTDT<IBFDT) S IBER=IBER_"IB062;" ; to date must not be >than today's date
S IBTFY=$$FY^IBOUTL(IBTDT)
;
;Total Charges
; IB*2.0*447/TAZ Removed this error so that zero dollar revenue codes can process on the 837
;I +IBTC'>0!(+IBTC'=IBTC) S IBER=IBER_"IB064;"
; IB*2.0*641 v9/WCJ added back so $0 claims won't go out
I +IBTC'>0 S IBER=IBER_"IB064;"
;
;Billable charges for secondary claim
I $$MCRONBIL^IBEFUNC(IBIFN)&(($P(IBNDU1,U,1)-$P(IBNDU1,U,2))'>0) S IBER=IBER_"IB094;"
;Fiscal Year 1
S IBFFY=$$FY^IBOUTL(IBFDT)
;
;Check provider link for current user, enterer, reviewer and Authorizor
I '$D(^VA(200,DUZ,0)) S IBER=IBER_"IB048;"
I IBEU]"",'$D(^VA(200,IBEU,0)) S IBER=IBER_"IB048;"
I IBRU]"",'$D(^VA(200,IBRU,0)) S IBER=IBER_"IB060;"
I IBAU]"",'$D(^VA(200,IBAU,0)) S IBER=IBER_"IB041;"
;
I IBER="",+$$STA^PRCAFN(IBIFN)=104 S IBER=IBER_"IB040;"
; If ins bill, must have valid COB sequence
I $P(IBND0,U,11)="i",$S($P(IBND0,U,21)="":1,1:"PST"'[$P(IBND0,U,21)) S IBER=IBER_"IB324;"
;
; Check for valid sec provider id for current ins
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
. 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")
; Check NPIs
D NPICHK^IBCBB11
;
; Check multiple rx NPIs
D RXNPI^IBCBB11(IBIFN)
;
; Check taxonomies
D TAXCHK^IBCBB11
;
; Check for Physician Name
K IBXDATA D F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
; IB*2.0*432 - CMS1500 no longer needs a claim level rendering
S IBFT=$$FT^IBCEF(IBIFN)
;JWS;IB*2.0*592:US1108 - Dental form check
I IBFT'=2,IBFT'=7,$P($G(IBXDATA),U)="" S IBER=IBER_"IB303;"
;
N FUNCTION,IBINS
; IB*2.0*432 - CMS1500 no longer needs a claim level rendering
;S FUNCTION=$S($$FT^IBCEF(IBIFN)=3:4,1:3)
S FUNCTION=$S(IBFT=3:4,1:3)
;JWS;IB*2.0*592:US1108 - Dental form check
I IBFT'=2,IBFT'=7,IBER'["IB303;" D
. F IBINS=1:1:3 D
.. S Z=$$GETTYP^IBCEP2A(IBIFN,IBINS)
.. I Z,$P(Z,U,2) D ; Rendering/attending prov secondary id required
... N IBID,IBOK,Q0
... D PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C") ; check all as though they were current
... S IBOK=0
... 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
... I 'IBOK S IBER=IBER_$S(IBINS=1:"IB236;",IBINS=2:"IB237;",IBINS=3:"IB238;",1:"")
;
; Patch 432 enh5:The IB system shall no longer prevent users from authorizing(fatal error message)a claim because the system cannot find the providersSSNorEIN
; D PRIIDCHK^IBCBB11
;
N IBM,IBM1
S IBM=$G(^DGCR(399,IBIFN,"M"))
S IBM1=$G(^DGCR(399,IBIFN,"M1"))
I $P(IBM,U),$P($G(^DIC(36,$P(IBM,U),4)),U,6),$P(IBM1,U,2)="" S IBER=IBER_"IB244;"
I $P(IBM,U,2),$P($G(^DIC(36,$P(IBM,U,2),4)),U,6),$P(IBM1,U,3)="" S IBER=IBER_"IB245;"
I $P(IBM,U,3),$P($G(^DIC(36,$P(IBM,U,3),4)),U,6),$P(IBM1,U,4)="" S IBER=IBER_"IB246;"
;
; If outside facility, check for ID and qualifier in 355.93
; 5/15/06 - esg - hard error IB243 turned into warning message instead
S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10)
I Z D
. I $P($G(^IBA(355.93,Z,0)),U,9)=""!($P($G(^IBA(355.93,Z,0)),U,13)="") D
.. N Z1,Z2
.. S Z1="Missing Lab or Facility Primary ID for non-VA facility, "
.. S Z2=$$EXTERNAL^DILFD(399,232,,Z)
.. I $L(Z2)'>19 D WARN^IBCBB11(Z1_Z2) Q
.. D WARN^IBCBB11(Z1),WARN^IBCBB11(" "_Z2)
.. Q
. Q
;
; Must be one and only one division on bill
S IBZ=$$MULTDIV^IBCBB11(IBIFN,IBND0)
; I IBZ S IBER=IBER_$S(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
; Allow multi-divisional for OP instutional claims
I IBZ,$$INPAT^IBCEF(IBIFN)!'($$INSPRF^IBCEF(IBIFN)) S IBER=IBER_$S(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
; Still need error msg on OP Institutional if No Default division
I IBZ=3,'$$INPAT^IBCEF(IBIFN),$$INSPRF^IBCEF(IBIFN) S IBER=IBER_"IB105;"
; Division address must be defined in institution file
I $P(IBND0,U,22) D
. N Z,Z0,Z1
. S Z0=$G(^DIC(4,+$P($G(^DG(40.8,+$P(IBND0,U,22),0)),U,7),0))
. S Z1=$G(^DIC(4,+$P($G(^DG(40.8,+$P(IBND0,U,22),0)),U,7),1))
. I $P(Z0,U,2)="" S IBER=IBER_"IB097;" Q
. F Z=1,3,4 I $P(Z1,U,Z)="" S IBER=IBER_"IB097;" Q
;
; IB*2.0*432 Check ambulance addresses, COB Non-covered amt. & Attachment Control
I $$AMBCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB329;"
I $$COBAMT^IBCBB11(IBIFN)=1 S IBER=IBER_"IB330;"
I $$TMCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB331;"
I $$ACCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB332;"
I $$COBMRA^IBCBB11(IBIFN)=1 S IBER=IBER_"IB342;"
I $$COBSEC^IBCBB11(IBIFN)=1 S IBER=IBER_"IB343;"
;
;CHAMPVA Rate Type and Primary Insurance Carriers Type of Coverage must match
S (IBRTCHV,IBPICHV)=0
I $P($G(^DGCR(399.3,+IBAT,0)),U,1)="CHAMPVA" S IBRTCHV=1
I $P($G(^IBE(355.2,+$P($G(^DIC(36,+IBNDMP,0)),U,13),0)),U,1)="CHAMPVA" S IBPICHV=1
I (+IBRTCHV!+IBPICHV)&('IBRTCHV!'IBPICHV) S IBER=IBER_"IB085;"
;
;Non-VA bill must use FEE REIMB INS rate type; FEE REIMB INS rate type can only be used for Non-VA bill
;IB*2.0*554/DRF 10/9/2015
;N IBNVART,IBNVAST
;S (IBNVART,IBNVAST)=0
;I $P($G(^DGCR(399.3,+IBAT,0)),U,1)="FEE REIMB INS" S IBNVART=1
;S IBNVAST=$$NONVAFLG(IBIFN)
;I IBNVART,'IBNVAST S IBER=IBER_"IB360;" ;Non-VA rate type used for bill that is not Non-VA
;I 'IBNVART,IBNVAST S IBER=IBER_"IB361;" ;Non-VA rate type not used for bill that is Non-VA
;
N IBZPRC,IBZPRCUB
D F^IBCEF("N-ALL PROCEDURES","IBZPRC",,IBIFN)
; Procedure Clinic is required for Surgical Procedures Outpt Facility Charges
I +$P(IBND0,U,27)'=2,$$BILLRATE^IBCRU3(IBAT,IBCL,IBEVDT,"RC OUTPATIENT") D
. 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
.. S Z0=$G(^DGCR(399,IBIFN,"CP",Z,0)),Z1=+Z0 I Z0'[";ICPT(" Q
.. I '((Z1'<10000)&(Z1'>69999))&'((Z1'<93501)&(Z1'>93533)) Q
.. I '$P(Z0,U,7) S ZE=1
;
; Extract procedures for UB-04
D F^IBCEF("N-UB-04 PROCEDURES","IBZPRCUB",,IBIFN)
; Does this bill have ANY prescriptions associated with it?
; Must bill prescriptions separately from other charges
;
; DEM;432 - Call line level provider edit checks.
D LNPROV^IBCBB12(IBIFN) ; DEM;432 - If there are line provider edits, then routine LNPROV^IBCBB12(IBIFN) updates IBER string.
; DEM;432 - Call to Other Operating/Operating Provider edit checks.
I $$OPPROVCK^IBCBB12(IBIFN)=1 S IBER=IBER_"IB337;" ; DEM;432
; DEM;432 - Line level Attachment Control edits.
I $$LNTMCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB331;" ; DEM;432
I $$LNACCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB332;" ; DEM;432
;
; vd/Beginning of IB*2*577 - Validate Line Level NDC edits.
I $$LNNDCCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB365;" ;IB*2*577;JWS;11/20/17 FIX
; vd/End of IB*2*577
I $$ISRX^IBCEF1(IBIFN) D
. N IBZ,IBRXDEF
. S IBRXDEF=$P($G(^IBE(350.9,1,1)),U,30),IBZ=0
. F S IBZ=$O(IBZPRCUB(IBZ)) Q:'IBZ I IBZPRCUB(IBZ),+$P(IBZPRCUB(IBZ),U)'=IBRXDEF S IBER=IBER_"IB102;" Q
. K IBZ
;
; Check that COB sequences are not skipped
K Z
F Z=1:1:3 S:+$G(^DGCR(399,IBIFN,"I"_Z)) Z(Z)=""
F Z=0:1:2 S Z0=$O(Z(Z)) Q:'Z0 I Z0'=(Z+1) S IBER=IBER_"IB322;" Q
K Z
; HD64676 IB*2*371 - OK for payer sequence to be blank when the Rate
; Type is either Interagency or Sharing Agreement
I $P($G(^DGCR(399,IBIFN,0)),U,21)="",$P($G(^DGCR(399,IBIFN,0)),U,7)'=4,$P($G(^DGCR(399,IBIFN,0)),U,7)'=9 S IBER=IBER_"IB323;"
K IBXDATA D F^IBCEF("N-PROCEDURE CODING METHD",,,IBIFN)
; Coding method should agree with types of procedure codes
S IBOK=$S('$O(IBZPRC(0))!(IBXDATA=""):1,1:0)
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
I 'IBOK D WARN^IBCBB11("Coding Method does not agree with all procedure codes found on bill")
D EDITMRA^IBCBB3(.IBQUIT,.IBER,IBIFN,IBFT)
Q:$G(IBQUIT)
;
;Other things that could be added: Rev Code - calculating charges
; Diagnosis Coding, if MT copay - check for other co-payments
;
I $P(IBNDTX,U,8),$$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB121;" ; can't force MRAs to print
I $P(IBNDTX,U,8)!$P(IBNDTX,U,9) D
. Q:$P(IBNDTX,U,8)=2 ; Don't want to do this for option 2 any more.
. 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"))
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
. D WARN^IBCBB11($P($G(^DIC(36,+IBXZ,0)),U,1)_" requires Amb Care Certification")
;
D VALNDC^IBCBB11(IBIFN,DFN) ;validate NDC#
;
;Build AR array if no errors and MRA not needed or already rec'd
I IBER="",$S($$NEEDMRA^IBEFUNC(IBIFN)!($$REQMRA^IBEFUNC(IBIFN)):0,1:1) D ARRAY
;
;Check ROI
N ROIERR
;/vd - IB*2.0*623 (US4995) - Modified the following 2 lines of code with the following conditional.
;S ROIERR=0 I $P($G(^DGCR(399,IBIFN,"U")),U,5)=1,+$P($G(^DGCR(399,IBIFN,"U")),U,7)=0 S ROIERR=1 ; screen 7 sensitive record and no ROI
;I $$ROICHK^IBCBB11(IBIFN,DFN,+IBNDMP) S ROIERR=1 ; check file for sensitive Rx and missing ROI
S ROIERR=0
I $$ROIDTCK^IBCEU7(IBIFN) D ; ROI Eligible based upon Service Date of Claim
. I $P($G(^DGCR(399,IBIFN,"U")),U,5)=1,+$P($G(^DGCR(399,IBIFN,"U")),U,7)=0 S ROIERR=1 ; screen 7 sensitive record and no ROI
. I $$ROICHK^IBCBB11(IBIFN,DFN,+IBNDMP) S ROIERR=1 ; check file for sensitive Rx and missing ROI
I ROIERR S IBER=IBER_"IB328;"
;
;Verify Line Charges Match Claim Total Charge. IB*2.0*447 BI
I +$$GET1^DIQ(399,IBIFN_",",201)'=+$$IBLNTOT^IBCBB13(IBIFN) S IBER=IBER_"IB344;"
;
;Test for valid EIN/SY ID Values. IB*2.0*447 BI
I $$IBSYEI^IBCBB13(IBIFN) S IBER=IBER_"IB345;"
;
;Test for a missing ICN. IB*2.0*447 BI
I $$IBMICN^IBCBB13(IBIFN) S IBER=IBER_"IB346;"
;
;Test for a ZERO charge amounts. IB*2.0*447 BI
;no use looking for a warning when you already flagged a fatal edit for a similar issue;WCJ;IB*2.0*641 v9;added check for IB064
I IBER'["IB064;",$$IBRCCHK^IBCBB13(IBIFN) D WARN^IBCBB11("Claim contains revenue codes with no associated charges.")
;
;Test for missing "Patient reason for visit". IB*2.0*447 BI
I $$FT^IBCEF(IBIFN)=3,'$$INPAT^IBCEF(IBIFN),$$IBPRV3^IBCBB13(IBIFN) S IBER=IBER_"IB347;"
;
;Test for missing Payer ID. IB*2.0*447 BI
;I $$IBMPID^IBCBB13(IBIFN) S IBER=IBER_"IB348;"
;Changed Error to Warning. IB*2.0*447 TAZ
I $$IBMPID^IBCBB13(IBIFN) D WARN^IBCBB11("Not all payers have Payer IDs.")
;
;Test for missing "Priority (Type) of Admission" for UB-04. IB*2.0*447 BI
;IB*2.0*665v1;JWS;Institutional Claims - prevent > 24 codes to be entered
I $$FT^IBCEF(IBIFN)=3 D
. I $$GET1^DIQ(399,IBIFN_",",158)="" S IBER=IBER_"IB349;"
. I '$$GET1^DIQ(399,IBIFN_",",27,"I") D
.. N X,I,IS
.. S (I,IS,X)=0 F S X=$O(^DGCR(399,IBIFN,"OC",X)) Q:X'=+X S:$P(^(X,0),"^",4)="" I=$G(I)+1 I $P(^(0),"^",4)'="" S IS=$G(IS)+1
.. ;IB*2.0*702;JWS;remove 665 fatal error for Occ Codes > 24, make it a warning
.. ;I I>24 S IBER=IBER_"IB383;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB384;"
.. I I>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
... D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Occurrence Codes.")
... ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Occurrence Codes will be submitted.")
.. ;IB*2.0*702;JWS;remove 665 fatal error for Occ Span Codes > 24, make it a warning
.. ;I IS>24 S IBER=IBER_"IB385;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB386;"
.. I IS>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
... D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Occurrence Span"),WARN^IBCBB11("Codes.")
... ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Occurrence Span Codes will be submitted.")
.. ;IB*2.0*702;JWS;remove 665 fatal error for Value Codes > 23, make it a warning
.. ;I $P($G(^DGCR(399,IBIFN,"CV",0)),U,4)>23 S IBER=IBER_"IB389;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB390;" ;IB*2.0*665v2
.. I $P($G(^DGCR(399,IBIFN,"CV",0)),U,4)>23,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
... D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 23 Value Codes.")
... ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 23 Value Codes will be submitted.")
.. Q
;IB*2.0*665v1;end
;
;IB*2.0*665v2; Inpatient Institutional Claims - prevent > 25 procedure codes electronically
I $$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN),'$$GET1^DIQ(399,IBIFN_",",27,"I") D
. N IBPROC,IBXIEN,Z
. S IBXIEN=IBIFN
. D PROCX^IBCVA1
. ;IB*2.0*702;JWS;remove 665 fatal error for Inpatient Institutional Procedure Codes > 25, make it a warning
. ;I $G(IBPROC)>25 S IBER=IBER_"IB387;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB388;"
. I $G(IBPROC)>25,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
.. D WARN^IBCBB11("A HIPAA Compliant EDI Institutional Claim cannot contain more than"),WARN^IBCBB11("25 Procedure Codes. If this claim is submitted electronically,")
.. D WARN^IBCBB11("only the first 25 Procedure Codes will be included on the claim.")
;IB*2.0*665v2;end
;IB*2.0*702;end
;
;IB*2.0*702;JWS;remove 665 fatal error for Condition Codes > 24, make it a warning
;IB*2.0*665v5;WCJ;prevent > 24 condition codes to be entered unless going to paper.
;I $P($G(^DGCR(399,IBIFN,"CC",0)),U,4)>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") S IBER=IBER_"IB391;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB392;" ;IB*2.0*665v5
I $P($G(^DGCR(399,IBIFN,"CC",0)),U,4)>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
. D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Condition Codes.")
. ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Condition Codes will be submitted.")
;
I $$FT^IBCEF(IBIFN)=2 S IBER=IBER_$$CMNCHK^IBCBB13(IBIFN) ;JRA;IB*2.0*608 Check for missing CMN info
;
;IB*2.0*759;JWS;5/22/23;EBILL-2923;Prevent claims going out via EDI with NOEXC Payer ID
; check COB TOTAL NON-COVERED AMOUNT exist and claim is secondary
;IB*2.0*759;v11;WCJ;2/14/24;EBILL-3841;commented out check - see defect for more information
;I $P($G(^DGCR(399,IBIFN,"U4")),"^")'="",$$COBN^IBCEF(IBIFN)=2 D
;. N IBP
;. ; if there is a primary bill#, use it to determine if an MRA was requested
;. S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) I IBP="" S IBP=IBIFN
;. ; if primary insurance is Medicare and MRA was not requested, and FORCE CLAIM TO PRINT is not true, and Payer ID is not approved for excluded services EDI submission
;. I $$WNRBILL^IBEFUNC(IBIFN,1),$P($G(^DGCR(399,IBP,"S")),U,7)="",$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1,$$SW^IBCE837Q(IBIFN) S IBER=$G(IBER)_"IB400;IB401;"
;. Q
;
END ;Don't kill IBIFN, IBER, DFN
I $O(^TMP($J,"BILL-WARN",0)),$G(IBER)="" S IBER="WARN" ;Warnings only
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
K IBNDS,IBND0,IBNDU,IBNDM,IBNDMP,IBNDU1,IBFFY,IBTFY,IBFT,IBRTCHV,IBPICHV,IBXDATA,IBOK
I $D(IBER),IBER="" W !,"No Errors found for National edits"
Q
;
ARRAY ;Build PRCASV(array)
N IBCOBN,X
K PRCASV
Q:$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))
S IBCOBN=$$COBN^IBCEF(IBIFN)
S X=IBIFN
S PRCASV("BDT")=DT,PRCASV("ARREC")=IBIFN
S PRCASV("APR")=DUZ
S PRCASV("PAT")=DFN,PRCASV("CAT")=$P(^DGCR(399.3,IBAT,0),"^",6)
I IBWHO="i" S PRCASV("DEBTOR")=+IBNDMP_";DIC(36,"
S PRCASV("DEBTOR")=$S(IBWHO="p":DFN_";DPT(",IBWHO="o":$P(IBNDM,"^",11)_";DIC(4,",IBWHO="i":PRCASV("DEBTOR"),1:"")
S PRCASV("CARE")=$E($$TOB^IBCEF1(IBIFN),1,2)
S PRCASV("FY")=$$FY^IBOUTL(DT)_U_($P(IBNDU1,U)-$P(IBNDU1,U,2))
;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:"")
PLUS I IBWHO="i",$P(IBNDM,"^",2),$D(^DIC(36,$P(IBNDM,"^",2),0)) S PRCASV("2NDINS")=$P(IBNDM,"^",2)
I IBWHO="i",$P(IBNDM,"^",3),$D(^DIC(36,$P(IBNDM,"^",3),0)) S PRCASV("3RDINS")=$P(IBNDM,"^",3)
;
N IBX S IBX=$P(IBND0,U,21),IBX=$S(IBX="P":"I1",IBX="S":"I2",IBX="T":"I3",1:"") Q:IBX=""
N IBNDI1
Q:'$D(^DGCR(399,IBIFN,IBX)) S IBNDI1=^(IBX)
S:$P(IBNDI1,"^",3)]"" PRCASV("GPNO")=$P(IBNDI1,"^",3)
S:$P(IBNDI1,"^",15)]"" PRCASV("GPNM")=$P(IBNDI1,"^",15)
S:$P(IBNDI1,"^",17)]"" PRCASV("INPA")=$P(IBNDI1,"^",17)
S:$P(IBNDI1,"^",2)]"" PRCASV("IDNO")=$P(IBNDI1,"^",2),PRCASV("INID")=PRCASV("IDNO")
; Check that this is a secondary or tertiary bill and insurance for previous
; COB sequence is Medicare WNR and MRA is active --> send data elements to AR
I IBCOBN>1,$$WNRBILL^IBEFUNC(IBIFN,IBCOBN-1),$$EDIACTV^IBCEF4(2) D MRA
Q
;
MRA N IBEOB S IBEOB=0
;
K PRCASV("MEDURE"),PRCASV("MEDCA")
; Get EOB data
F S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB D
. D MRACALC^IBCEMU2(IBEOB,IBIFN,1,.PRCASV)
Q ;MRA
;
;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
;
NONVAFLG(IBIFN) ; Check if Non-VA bill
; Function returns 1 if Non-VA bill
; IB*2.0*554/DRF 10/9/2015
N FLAG,PTF
S FLAG=0
I $P($G(^DGCR(399,IBIFN,"U2")),U,10)]"" S FLAG=1 ;Non-VA provider defined
S PTF=$P($G(^DGCR(399,IBIFN,0)),U,8)
I PTF,$P($G(^DGPT(PTF,0)),U,4)=1 S FLAG=1 ;PTF entry indicates Non-VA
Q FLAG
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB1 19544 printed Apr 09, 2024@21:14:15 Page 2
IBCBB1 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE ;2-NOV-89
+1 ;;2.0;INTEGRATED BILLING;**27,52,80,93,106,51,151,148,153,137,232,280,155,320,343,349,363,371,395,384,432,447,488,554,577,592,608,623,641,665,702,759**;21-MAR-94;Build 24
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; *** Begin IB*2.0*488 VD (Issue 46 RBN)
+5 NEW I
+6 SET I=""
+7 SET X=+$GET(^DGCR(399,IBIFN,"MP"))
+8 IF 'X
IF $$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))
SET X=+$$CURR^IBCEF2(IBIFN)
+9 ;JWS;IB*2.0*592:US1108 - Dental form check
+10 IF X
IF +$GET(^DIC(36,X,3))
SET I=$PIECE(^(3),U,$SELECT($$FT^IBCEF(IBIFN)=2:2,$$FT^IBCEF(IBIFN)=7:15,1:4))
+11 SET I=$$UP^XLFSTR(I)
+12 IF (I'=""&(I["PRNT")&($GET(IBER)'["IB488"))
Begin DoDot:1
+13 SET IBER=$GET(IBER)_"IB488;"
End DoDot:1
+14 ;
+15 ; Cause an error if FORCED TO PRINT TO CLEARINGHOUSE
+16 IF $PIECE($GET(^DGCR(399,IBIFN,"TX")),U,8)=2
Begin DoDot:1
+17 SET IBER=$GET(IBER)_"IB489;"
End DoDot:1
+18 ;
+19 ; Cause a fatal error if the claim has no procedures & is NOT a UB-04 Inpatient claim.
+20 IF +$ORDER(^DGCR(399,IBIFN,"CP",0))=0
Begin DoDot:1
+21 ; inpatient UB-04 check
IF $$INPAT^IBCEF(IBIFN,1)
IF $$INSPRF^IBCEF(IBIFN)
QUIT
+22 ; Outpatient Institutional Claim.
IF '$$INPAT^IBCEF(IBIFN,1)
IF $$INSPRF^IBCEF(IBIFN)
Begin DoDot:2
+23 IF IBER["IB352"
QUIT
+24 SET IBER=IBER_"IB352;"
End DoDot:2
QUIT
+25 ;
+26 ; Professional claim
+27 IF IBER["IB353"
QUIT
+28 SET IBER=IBER_"IB353;"
+29 QUIT
End DoDot:1
+30 ; *** End IB*2.0*488 -- VD
+31 ;
+32 ;MAP TO DGCRBB1
+33 ;
% ;Bill Status
+1 NEW Z,Z0,Z1,IBFT
+2 IF $SELECT(+IBST=0:1,1:"^1^2^3^4^7^"'[(U_IBST_U))
SET IBER=IBER_"IB045;"
+3 ;
+4 ;Statement Covers From
+5 IF IBFDT=""
SET IBER=IBER_"IB061;"
+6 IF IBFDT]""
IF IBFDT'?7N&(IBFDT'?7N1".".N)
SET IBER=IBER_"IB061;"
+7 ; from must be on or before the to date
IF IBFDT>IBTDT
SET IBER=IBER_"IB061;"
+8 SET IBFFY=$$FY^IBOUTL(IBFDT)
+9 ; if inpat - from date must not be prior to admit date.
+10 IF $$INPAT^IBCEF(IBIFN,1)
IF (IBFDT<($PIECE($GET(^DGPT(+$PIECE(IBND0,U,8),0)),U,2)\1))
SET IBER=IBER_"IB061;"
+11 ;
+12 ;Statement Covers To
+13 IF IBTDT=""
SET IBER=IBER_"IB062;"
+14 IF IBTDT]""
IF IBTDT'?7N&(IBTDT'?7N1".".N)
SET IBER=IBER_"IB062;"
+15 ; to date must not be >than today's date
IF IBTDT>DT!(IBTDT<IBFDT)
SET IBER=IBER_"IB062;"
+16 SET IBTFY=$$FY^IBOUTL(IBTDT)
+17 ;
+18 ;Total Charges
+19 ; IB*2.0*447/TAZ Removed this error so that zero dollar revenue codes can process on the 837
+20 ;I +IBTC'>0!(+IBTC'=IBTC) S IBER=IBER_"IB064;"
+21 ; IB*2.0*641 v9/WCJ added back so $0 claims won't go out
+22 IF +IBTC'>0
SET IBER=IBER_"IB064;"
+23 ;
+24 ;Billable charges for secondary claim
+25 IF $$MCRONBIL^IBEFUNC(IBIFN)&(($PIECE(IBNDU1,U,1)-$PIECE(IBNDU1,U,2))'>0)
SET IBER=IBER_"IB094;"
+26 ;Fiscal Year 1
+27 SET IBFFY=$$FY^IBOUTL(IBFDT)
+28 ;
+29 ;Check provider link for current user, enterer, reviewer and Authorizor
+30 IF '$DATA(^VA(200,DUZ,0))
SET IBER=IBER_"IB048;"
+31 IF IBEU]""
IF '$DATA(^VA(200,IBEU,0))
SET IBER=IBER_"IB048;"
+32 IF IBRU]""
IF '$DATA(^VA(200,IBRU,0))
SET IBER=IBER_"IB060;"
+33 IF IBAU]""
IF '$DATA(^VA(200,IBAU,0))
SET IBER=IBER_"IB041;"
+34 ;
+35 IF IBER=""
IF +$$STA^PRCAFN(IBIFN)=104
SET IBER=IBER_"IB040;"
+36 ; If ins bill, must have valid COB sequence
+37 IF $PIECE(IBND0,U,11)="i"
IF $SELECT($PIECE(IBND0,U,21)="":1,1:"PST"'[$PIECE(IBND0,U,21))
SET IBER=IBER_"IB324;"
+38 ;
+39 ; Check for valid sec provider id for current ins
+40 SET Z=0
FOR
SET Z=$ORDER(^DGCR(399,IBIFN,"PRV",Z))
if 'Z
QUIT
SET Z0=$GET(^(Z,0))
SET Z1=+$$COBN^IBCEF(IBIFN)
IF $PIECE(Z0,U,4+Z1)'=""
IF $PIECE(Z0,U,11+Z1)'=""
Begin DoDot:1
+41 IF '$$SECIDCK^IBCEF74(IBIFN,Z1,$PIECE(Z0,U,11+Z1),Z)
DO WARN^IBCBB11("Prov secondary id type for the "_$PIECE("PRIMARY^SECONDARY^TERTIARY",U,Z1)_" "_$$EXTERNAL^DILFD(399.0222,.01,,+Z0)_" is invalid/won't transmit")
End DoDot:1
+42 ; Check NPIs
+43 DO NPICHK^IBCBB11
+44 ;
+45 ; Check multiple rx NPIs
+46 DO RXNPI^IBCBB11(IBIFN)
+47 ;
+48 ; Check taxonomies
+49 DO TAXCHK^IBCBB11
+50 ;
+51 ; Check for Physician Name
+52 KILL IBXDATA
DO F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
+53 ; IB*2.0*432 - CMS1500 no longer needs a claim level rendering
+54 SET IBFT=$$FT^IBCEF(IBIFN)
+55 ;JWS;IB*2.0*592:US1108 - Dental form check
+56 IF IBFT'=2
IF IBFT'=7
IF $PIECE($GET(IBXDATA),U)=""
SET IBER=IBER_"IB303;"
+57 ;
+58 NEW FUNCTION,IBINS
+59 ; IB*2.0*432 - CMS1500 no longer needs a claim level rendering
+60 ;S FUNCTION=$S($$FT^IBCEF(IBIFN)=3:4,1:3)
+61 SET FUNCTION=$SELECT(IBFT=3:4,1:3)
+62 ;JWS;IB*2.0*592:US1108 - Dental form check
+63 IF IBFT'=2
IF IBFT'=7
IF IBER'["IB303;"
Begin DoDot:1
+64 FOR IBINS=1:1:3
Begin DoDot:2
+65 SET Z=$$GETTYP^IBCEP2A(IBIFN,IBINS)
+66 ; Rendering/attending prov secondary id required
IF Z
IF $PIECE(Z,U,2)
Begin DoDot:3
+67 NEW IBID,IBOK,Q0
+68 ; check all as though they were current
DO PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C")
+69 SET IBOK=0
+70 SET Q0=0
FOR
SET Q0=$ORDER(IBID(1,FUNCTION,Q0))
if 'Q0
QUIT
IF $PIECE(IBID(1,FUNCTION,Q0),U,9)=+Z
SET IBOK=1
QUIT
+71 IF 'IBOK
SET IBER=IBER_$SELECT(IBINS=1:"IB236;",IBINS=2:"IB237;",IBINS=3:"IB238;",1:"")
End DoDot:3
End DoDot:2
End DoDot:1
+72 ;
+73 ; Patch 432 enh5:The IB system shall no longer prevent users from authorizing(fatal error message)a claim because the system cannot find the providersSSNorEIN
+74 ; D PRIIDCHK^IBCBB11
+75 ;
+76 NEW IBM,IBM1
+77 SET IBM=$GET(^DGCR(399,IBIFN,"M"))
+78 SET IBM1=$GET(^DGCR(399,IBIFN,"M1"))
+79 IF $PIECE(IBM,U)
IF $PIECE($GET(^DIC(36,$PIECE(IBM,U),4)),U,6)
IF $PIECE(IBM1,U,2)=""
SET IBER=IBER_"IB244;"
+80 IF $PIECE(IBM,U,2)
IF $PIECE($GET(^DIC(36,$PIECE(IBM,U,2),4)),U,6)
IF $PIECE(IBM1,U,3)=""
SET IBER=IBER_"IB245;"
+81 IF $PIECE(IBM,U,3)
IF $PIECE($GET(^DIC(36,$PIECE(IBM,U,3),4)),U,6)
IF $PIECE(IBM1,U,4)=""
SET IBER=IBER_"IB246;"
+82 ;
+83 ; If outside facility, check for ID and qualifier in 355.93
+84 ; 5/15/06 - esg - hard error IB243 turned into warning message instead
+85 SET Z=$PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)
+86 IF Z
Begin DoDot:1
+87 IF $PIECE($GET(^IBA(355.93,Z,0)),U,9)=""!($PIECE($GET(^IBA(355.93,Z,0)),U,13)="")
Begin DoDot:2
+88 NEW Z1,Z2
+89 SET Z1="Missing Lab or Facility Primary ID for non-VA facility, "
+90 SET Z2=$$EXTERNAL^DILFD(399,232,,Z)
+91 IF $LENGTH(Z2)'>19
DO WARN^IBCBB11(Z1_Z2)
QUIT
+92 DO WARN^IBCBB11(Z1)
DO WARN^IBCBB11(" "_Z2)
+93 QUIT
End DoDot:2
+94 QUIT
End DoDot:1
+95 ;
+96 ; Must be one and only one division on bill
+97 SET IBZ=$$MULTDIV^IBCBB11(IBIFN,IBND0)
+98 ; I IBZ S IBER=IBER_$S(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
+99 ; Allow multi-divisional for OP instutional claims
+100 IF IBZ
IF $$INPAT^IBCEF(IBIFN)!'($$INSPRF^IBCEF(IBIFN))
SET IBER=IBER_$SELECT(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
+101 ; Still need error msg on OP Institutional if No Default division
+102 IF IBZ=3
IF '$$INPAT^IBCEF(IBIFN)
IF $$INSPRF^IBCEF(IBIFN)
SET IBER=IBER_"IB105;"
+103 ; Division address must be defined in institution file
+104 IF $PIECE(IBND0,U,22)
Begin DoDot:1
+105 NEW Z,Z0,Z1
+106 SET Z0=$GET(^DIC(4,+$PIECE($GET(^DG(40.8,+$PIECE(IBND0,U,22),0)),U,7),0))
+107 SET Z1=$GET(^DIC(4,+$PIECE($GET(^DG(40.8,+$PIECE(IBND0,U,22),0)),U,7),1))
+108 IF $PIECE(Z0,U,2)=""
SET IBER=IBER_"IB097;"
QUIT
+109 FOR Z=1,3,4
IF $PIECE(Z1,U,Z)=""
SET IBER=IBER_"IB097;"
QUIT
End DoDot:1
+110 ;
+111 ; IB*2.0*432 Check ambulance addresses, COB Non-covered amt. & Attachment Control
+112 IF $$AMBCK^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB329;"
+113 IF $$COBAMT^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB330;"
+114 IF $$TMCK^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB331;"
+115 IF $$ACCK^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB332;"
+116 IF $$COBMRA^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB342;"
+117 IF $$COBSEC^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB343;"
+118 ;
+119 ;CHAMPVA Rate Type and Primary Insurance Carriers Type of Coverage must match
+120 SET (IBRTCHV,IBPICHV)=0
+121 IF $PIECE($GET(^DGCR(399.3,+IBAT,0)),U,1)="CHAMPVA"
SET IBRTCHV=1
+122 IF $PIECE($GET(^IBE(355.2,+$PIECE($GET(^DIC(36,+IBNDMP,0)),U,13),0)),U,1)="CHAMPVA"
SET IBPICHV=1
+123 IF (+IBRTCHV!+IBPICHV)&('IBRTCHV!'IBPICHV)
SET IBER=IBER_"IB085;"
+124 ;
+125 ;Non-VA bill must use FEE REIMB INS rate type; FEE REIMB INS rate type can only be used for Non-VA bill
+126 ;IB*2.0*554/DRF 10/9/2015
+127 ;N IBNVART,IBNVAST
+128 ;S (IBNVART,IBNVAST)=0
+129 ;I $P($G(^DGCR(399.3,+IBAT,0)),U,1)="FEE REIMB INS" S IBNVART=1
+130 ;S IBNVAST=$$NONVAFLG(IBIFN)
+131 ;I IBNVART,'IBNVAST S IBER=IBER_"IB360;" ;Non-VA rate type used for bill that is not Non-VA
+132 ;I 'IBNVART,IBNVAST S IBER=IBER_"IB361;" ;Non-VA rate type not used for bill that is Non-VA
+133 ;
+134 NEW IBZPRC,IBZPRCUB
+135 DO F^IBCEF("N-ALL PROCEDURES","IBZPRC",,IBIFN)
+136 ; Procedure Clinic is required for Surgical Procedures Outpt Facility Charges
+137 IF +$PIECE(IBND0,U,27)'=2
IF $$BILLRATE^IBCRU3(IBAT,IBCL,IBEVDT,"RC OUTPATIENT")
Begin DoDot:1
+138 NEW Z,Z0,Z1,ZE
SET (ZE,Z)=0
FOR
SET Z=$ORDER(^DGCR(399,IBIFN,"CP",Z))
if 'Z
QUIT
Begin DoDot:2
+139 SET Z0=$GET(^DGCR(399,IBIFN,"CP",Z,0))
SET Z1=+Z0
IF Z0'[";ICPT("
QUIT
+140 IF '((Z1'<10000)&(Z1'>69999))&'((Z1'<93501)&(Z1'>93533))
QUIT
+141 IF '$PIECE(Z0,U,7)
SET ZE=1
End DoDot:2
IF +ZE
SET IBER=IBER_"IB320;"
QUIT
End DoDot:1
+142 ;
+143 ; Extract procedures for UB-04
+144 DO F^IBCEF("N-UB-04 PROCEDURES","IBZPRCUB",,IBIFN)
+145 ; Does this bill have ANY prescriptions associated with it?
+146 ; Must bill prescriptions separately from other charges
+147 ;
+148 ; DEM;432 - Call line level provider edit checks.
+149 ; DEM;432 - If there are line provider edits, then routine LNPROV^IBCBB12(IBIFN) updates IBER string.
DO LNPROV^IBCBB12(IBIFN)
+150 ; DEM;432 - Call to Other Operating/Operating Provider edit checks.
+151 ; DEM;432
IF $$OPPROVCK^IBCBB12(IBIFN)=1
SET IBER=IBER_"IB337;"
+152 ; DEM;432 - Line level Attachment Control edits.
+153 ; DEM;432
IF $$LNTMCK^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB331;"
+154 ; DEM;432
IF $$LNACCK^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB332;"
+155 ;
+156 ; vd/Beginning of IB*2*577 - Validate Line Level NDC edits.
+157 ;IB*2*577;JWS;11/20/17 FIX
IF $$LNNDCCK^IBCBB11(IBIFN)=1
SET IBER=IBER_"IB365;"
+158 ; vd/End of IB*2*577
+159 IF $$ISRX^IBCEF1(IBIFN)
Begin DoDot:1
+160 NEW IBZ,IBRXDEF
+161 SET IBRXDEF=$PIECE($GET(^IBE(350.9,1,1)),U,30)
SET IBZ=0
+162 FOR
SET IBZ=$ORDER(IBZPRCUB(IBZ))
if 'IBZ
QUIT
IF IBZPRCUB(IBZ)
IF +$PIECE(IBZPRCUB(IBZ),U)'=IBRXDEF
SET IBER=IBER_"IB102;"
QUIT
+163 KILL IBZ
End DoDot:1
+164 ;
+165 ; Check that COB sequences are not skipped
+166 KILL Z
+167 FOR Z=1:1:3
if +$GET(^DGCR(399,IBIFN,"I"_Z))
SET Z(Z)=""
+168 FOR Z=0:1:2
SET Z0=$ORDER(Z(Z))
if 'Z0
QUIT
IF Z0'=(Z+1)
SET IBER=IBER_"IB322;"
QUIT
+169 KILL Z
+170 ; HD64676 IB*2*371 - OK for payer sequence to be blank when the Rate
+171 ; Type is either Interagency or Sharing Agreement
+172 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,21)=""
IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,7)'=4
IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,7)'=9
SET IBER=IBER_"IB323;"
+173 KILL IBXDATA
DO F^IBCEF("N-PROCEDURE CODING METHD",,,IBIFN)
+174 ; Coding method should agree with types of procedure codes
+175 SET IBOK=$SELECT('$ORDER(IBZPRC(0))!(IBXDATA=""):1,1:0)
+176 IF 'IBOK
SET IBOK=1
SET IBZ=0
FOR
SET IBZ=$ORDER(IBZPRC(IBZ))
if 'IBZ
QUIT
IF IBZPRC(IBZ)
IF $PIECE(IBZPRC(IBZ),U)'[$SELECT(IBXDATA=9:"ICD",1:"ICP")
SET IBOK=0
QUIT
+177 IF 'IBOK
DO WARN^IBCBB11("Coding Method does not agree with all procedure codes found on bill")
+178 DO EDITMRA^IBCBB3(.IBQUIT,.IBER,IBIFN,IBFT)
+179 if $GET(IBQUIT)
QUIT
+180 ;
+181 ;Other things that could be added: Rev Code - calculating charges
+182 ; Diagnosis Coding, if MT copay - check for other co-payments
+183 ;
+184 ; can't force MRAs to print
IF $PIECE(IBNDTX,U,8)
IF $$REQMRA^IBEFUNC(IBIFN)
SET IBER=IBER_"IB121;"
+185 IF $PIECE(IBNDTX,U,8)!$PIECE(IBNDTX,U,9)
Begin DoDot:1
+186 ; Don't want to do this for option 2 any more.
if $PIECE(IBNDTX,U,8)=2
QUIT
+187 DO WARN^IBCBB11($SELECT($$REQMRA^IBEFUNC(IBIFN)&($PIECE(IBNDTX,U,9)):"MRA Secondary ",1:"")_"Bill has been forced to print "_$SELECT($PIECE(IBNDTX,U,8)=1!($PIECE(IBNDTX,U,9)=1):"locally",1:"at clearinghouse"))
End DoDot:1
+188 NEW IBXZ,IBIZ
FOR IBIZ=12,13,14
SET IBXZ=$PIECE(IBNDM,U,IBIZ)
IF +IBXZ
SET IBXZ=$PIECE($GET(^DPT(DFN,.312,IBXZ,0)),U,18)
IF +IBXZ
SET IBXZ=$GET(^IBA(355.3,+IBXZ,0))
IF +$PIECE(IBXZ,U,12)
Begin DoDot:1
+189 DO WARN^IBCBB11($PIECE($GET(^DIC(36,+IBXZ,0)),U,1)_" requires Amb Care Certification")
End DoDot:1
+190 ;
+191 ;validate NDC#
DO VALNDC^IBCBB11(IBIFN,DFN)
+192 ;
+193 ;Build AR array if no errors and MRA not needed or already rec'd
+194 IF IBER=""
IF $SELECT($$NEEDMRA^IBEFUNC(IBIFN)!($$REQMRA^IBEFUNC(IBIFN)):0,1:1)
DO ARRAY
+195 ;
+196 ;Check ROI
+197 NEW ROIERR
+198 ;/vd - IB*2.0*623 (US4995) - Modified the following 2 lines of code with the following conditional.
+199 ;S ROIERR=0 I $P($G(^DGCR(399,IBIFN,"U")),U,5)=1,+$P($G(^DGCR(399,IBIFN,"U")),U,7)=0 S ROIERR=1 ; screen 7 sensitive record and no ROI
+200 ;I $$ROICHK^IBCBB11(IBIFN,DFN,+IBNDMP) S ROIERR=1 ; check file for sensitive Rx and missing ROI
+201 SET ROIERR=0
+202 ; ROI Eligible based upon Service Date of Claim
IF $$ROIDTCK^IBCEU7(IBIFN)
Begin DoDot:1
+203 ; screen 7 sensitive record and no ROI
IF $PIECE($GET(^DGCR(399,IBIFN,"U")),U,5)=1
IF +$PIECE($GET(^DGCR(399,IBIFN,"U")),U,7)=0
SET ROIERR=1
+204 ; check file for sensitive Rx and missing ROI
IF $$ROICHK^IBCBB11(IBIFN,DFN,+IBNDMP)
SET ROIERR=1
End DoDot:1
+205 IF ROIERR
SET IBER=IBER_"IB328;"
+206 ;
+207 ;Verify Line Charges Match Claim Total Charge. IB*2.0*447 BI
+208 IF +$$GET1^DIQ(399,IBIFN_",",201)'=+$$IBLNTOT^IBCBB13(IBIFN)
SET IBER=IBER_"IB344;"
+209 ;
+210 ;Test for valid EIN/SY ID Values. IB*2.0*447 BI
+211 IF $$IBSYEI^IBCBB13(IBIFN)
SET IBER=IBER_"IB345;"
+212 ;
+213 ;Test for a missing ICN. IB*2.0*447 BI
+214 IF $$IBMICN^IBCBB13(IBIFN)
SET IBER=IBER_"IB346;"
+215 ;
+216 ;Test for a ZERO charge amounts. IB*2.0*447 BI
+217 ;no use looking for a warning when you already flagged a fatal edit for a similar issue;WCJ;IB*2.0*641 v9;added check for IB064
+218 IF IBER'["IB064;"
IF $$IBRCCHK^IBCBB13(IBIFN)
DO WARN^IBCBB11("Claim contains revenue codes with no associated charges.")
+219 ;
+220 ;Test for missing "Patient reason for visit". IB*2.0*447 BI
+221 IF $$FT^IBCEF(IBIFN)=3
IF '$$INPAT^IBCEF(IBIFN)
IF $$IBPRV3^IBCBB13(IBIFN)
SET IBER=IBER_"IB347;"
+222 ;
+223 ;Test for missing Payer ID. IB*2.0*447 BI
+224 ;I $$IBMPID^IBCBB13(IBIFN) S IBER=IBER_"IB348;"
+225 ;Changed Error to Warning. IB*2.0*447 TAZ
+226 IF $$IBMPID^IBCBB13(IBIFN)
DO WARN^IBCBB11("Not all payers have Payer IDs.")
+227 ;
+228 ;Test for missing "Priority (Type) of Admission" for UB-04. IB*2.0*447 BI
+229 ;IB*2.0*665v1;JWS;Institutional Claims - prevent > 24 codes to be entered
+230 IF $$FT^IBCEF(IBIFN)=3
Begin DoDot:1
+231 IF $$GET1^DIQ(399,IBIFN_",",158)=""
SET IBER=IBER_"IB349;"
+232 IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:2
+233 NEW X,I,IS
+234 SET (I,IS,X)=0
FOR
SET X=$ORDER(^DGCR(399,IBIFN,"OC",X))
if X'=+X
QUIT
if $PIECE(^(X,0),"^",4)=""
SET I=$GET(I)+1
IF $PIECE(^(0),"^",4)'=""
SET IS=$GET(IS)+1
+235 ;IB*2.0*702;JWS;remove 665 fatal error for Occ Codes > 24, make it a warning
+236 ;I I>24 S IBER=IBER_"IB383;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB384;"
+237 IF I>24
IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:3
+238 DO WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Occurrence Codes.")
+239 ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Occurrence Codes will be submitted.")
End DoDot:3
+240 ;IB*2.0*702;JWS;remove 665 fatal error for Occ Span Codes > 24, make it a warning
+241 ;I IS>24 S IBER=IBER_"IB385;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB386;"
+242 IF IS>24
IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:3
+243 DO WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Occurrence Span")
DO WARN^IBCBB11("Codes.")
+244 ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Occurrence Span Codes will be submitted.")
End DoDot:3
+245 ;IB*2.0*702;JWS;remove 665 fatal error for Value Codes > 23, make it a warning
+246 ;I $P($G(^DGCR(399,IBIFN,"CV",0)),U,4)>23 S IBER=IBER_"IB389;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB390;" ;IB*2.0*665v2
+247 IF $PIECE($GET(^DGCR(399,IBIFN,"CV",0)),U,4)>23
IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:3
+248 DO WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 23 Value Codes.")
+249 ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 23 Value Codes will be submitted.")
End DoDot:3
+250 QUIT
End DoDot:2
End DoDot:1
+251 ;IB*2.0*665v1;end
+252 ;
+253 ;IB*2.0*665v2; Inpatient Institutional Claims - prevent > 25 procedure codes electronically
+254 IF $$INPAT^IBCEF(IBIFN,1)
IF $$INSPRF^IBCEF(IBIFN)
IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:1
+255 NEW IBPROC,IBXIEN,Z
+256 SET IBXIEN=IBIFN
+257 DO PROCX^IBCVA1
+258 ;IB*2.0*702;JWS;remove 665 fatal error for Inpatient Institutional Procedure Codes > 25, make it a warning
+259 ;I $G(IBPROC)>25 S IBER=IBER_"IB387;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB388;"
+260 IF $GET(IBPROC)>25
IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:2
+261 DO WARN^IBCBB11("A HIPAA Compliant EDI Institutional Claim cannot contain more than")
DO WARN^IBCBB11("25 Procedure Codes. If this claim is submitted electronically,")
+262 DO WARN^IBCBB11("only the first 25 Procedure Codes will be included on the claim.")
End DoDot:2
End DoDot:1
+263 ;IB*2.0*665v2;end
+264 ;IB*2.0*702;end
+265 ;
+266 ;IB*2.0*702;JWS;remove 665 fatal error for Condition Codes > 24, make it a warning
+267 ;IB*2.0*665v5;WCJ;prevent > 24 condition codes to be entered unless going to paper.
+268 ;I $P($G(^DGCR(399,IBIFN,"CC",0)),U,4)>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") S IBER=IBER_"IB391;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB392;" ;IB*2.0*665v5
+269 IF $PIECE($GET(^DGCR(399,IBIFN,"CC",0)),U,4)>24
IF '$$GET1^DIQ(399,IBIFN_",",27,"I")
Begin DoDot:1
+270 DO WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Condition Codes.")
+271 ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Condition Codes will be submitted.")
End DoDot:1
+272 ;
+273 ;JRA;IB*2.0*608 Check for missing CMN info
IF $$FT^IBCEF(IBIFN)=2
SET IBER=IBER_$$CMNCHK^IBCBB13(IBIFN)
+274 ;
+275 ;IB*2.0*759;JWS;5/22/23;EBILL-2923;Prevent claims going out via EDI with NOEXC Payer ID
+276 ; check COB TOTAL NON-COVERED AMOUNT exist and claim is secondary
+277 ;IB*2.0*759;v11;WCJ;2/14/24;EBILL-3841;commented out check - see defect for more information
+278 ;I $P($G(^DGCR(399,IBIFN,"U4")),"^")'="",$$COBN^IBCEF(IBIFN)=2 D
+279 ;. N IBP
+280 ;. ; if there is a primary bill#, use it to determine if an MRA was requested
+281 ;. S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) I IBP="" S IBP=IBIFN
+282 ;. ; if primary insurance is Medicare and MRA was not requested, and FORCE CLAIM TO PRINT is not true, and Payer ID is not approved for excluded services EDI submission
+283 ;. I $$WNRBILL^IBEFUNC(IBIFN,1),$P($G(^DGCR(399,IBP,"S")),U,7)="",$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1,$$SW^IBCE837Q(IBIFN) S IBER=$G(IBER)_"IB400;IB401;"
+284 ;. Q
+285 ;
END ;Don't kill IBIFN, IBER, DFN
+1 ;Warnings only
IF $ORDER(^TMP($JOB,"BILL-WARN",0))
IF $GET(IBER)=""
SET IBER="WARN"
+2 KILL 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
+3 KILL IBNDS,IBND0,IBNDU,IBNDM,IBNDMP,IBNDU1,IBFFY,IBTFY,IBFT,IBRTCHV,IBPICHV,IBXDATA,IBOK
+4 IF $DATA(IBER)
IF IBER=""
WRITE !,"No Errors found for National edits"
+5 QUIT
+6 ;
ARRAY ;Build PRCASV(array)
+1 NEW IBCOBN,X
+2 KILL PRCASV
+3 if $$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))
QUIT
+4 SET IBCOBN=$$COBN^IBCEF(IBIFN)
+5 SET X=IBIFN
+6 SET PRCASV("BDT")=DT
SET PRCASV("ARREC")=IBIFN
+7 SET PRCASV("APR")=DUZ
+8 SET PRCASV("PAT")=DFN
SET PRCASV("CAT")=$PIECE(^DGCR(399.3,IBAT,0),"^",6)
+9 IF IBWHO="i"
SET PRCASV("DEBTOR")=+IBNDMP_";DIC(36,"
+10 SET PRCASV("DEBTOR")=$SELECT(IBWHO="p":DFN_";DPT(",IBWHO="o":$PIECE(IBNDM,"^",11)_";DIC(4,",IBWHO="i":PRCASV("DEBTOR"),1:"")
+11 SET PRCASV("CARE")=$EXTRACT($$TOB^IBCEF1(IBIFN),1,2)
+12 SET PRCASV("FY")=$$FY^IBOUTL(DT)_U_($PIECE(IBNDU1,U)-$PIECE(IBNDU1,U,2))
+13 ;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:"")
PLUS IF IBWHO="i"
IF $PIECE(IBNDM,"^",2)
IF $DATA(^DIC(36,$PIECE(IBNDM,"^",2),0))
SET PRCASV("2NDINS")=$PIECE(IBNDM,"^",2)
+1 IF IBWHO="i"
IF $PIECE(IBNDM,"^",3)
IF $DATA(^DIC(36,$PIECE(IBNDM,"^",3),0))
SET PRCASV("3RDINS")=$PIECE(IBNDM,"^",3)
+2 ;
+3 NEW IBX
SET IBX=$PIECE(IBND0,U,21)
SET IBX=$SELECT(IBX="P":"I1",IBX="S":"I2",IBX="T":"I3",1:"")
if IBX=""
QUIT
+4 NEW IBNDI1
+5 if '$DATA(^DGCR(399,IBIFN,IBX))
QUIT
SET IBNDI1=^(IBX)
+6 if $PIECE(IBNDI1,"^",3)]""
SET PRCASV("GPNO")=$PIECE(IBNDI1,"^",3)
+7 if $PIECE(IBNDI1,"^",15)]""
SET PRCASV("GPNM")=$PIECE(IBNDI1,"^",15)
+8 if $PIECE(IBNDI1,"^",17)]""
SET PRCASV("INPA")=$PIECE(IBNDI1,"^",17)
+9 if $PIECE(IBNDI1,"^",2)]""
SET PRCASV("IDNO")=$PIECE(IBNDI1,"^",2)
SET PRCASV("INID")=PRCASV("IDNO")
+10 ; Check that this is a secondary or tertiary bill and insurance for previous
+11 ; COB sequence is Medicare WNR and MRA is active --> send data elements to AR
+12 IF IBCOBN>1
IF $$WNRBILL^IBEFUNC(IBIFN,IBCOBN-1)
IF $$EDIACTV^IBCEF4(2)
DO MRA
+13 QUIT
+14 ;
MRA NEW IBEOB
SET IBEOB=0
+1 ;
+2 KILL PRCASV("MEDURE"),PRCASV("MEDCA")
+3 ; Get EOB data
+4 FOR
SET IBEOB=$ORDER(^IBM(361.1,"B",IBIFN,IBEOB))
if 'IBEOB
QUIT
Begin DoDot:1
+5 DO MRACALC^IBCEMU2(IBEOB,IBIFN,1,.PRCASV)
End DoDot:1
+6 ;MRA
QUIT
+7 ;
+8 ;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
+9 ;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
+10 ;
NONVAFLG(IBIFN) ; Check if Non-VA bill
+1 ; Function returns 1 if Non-VA bill
+2 ; IB*2.0*554/DRF 10/9/2015
+3 NEW FLAG,PTF
+4 SET FLAG=0
+5 ;Non-VA provider defined
IF $PIECE($GET(^DGCR(399,IBIFN,"U2")),U,10)]""
SET FLAG=1
+6 SET PTF=$PIECE($GET(^DGCR(399,IBIFN,0)),U,8)
+7 ;PTF entry indicates Non-VA
IF PTF
IF $PIECE($GET(^DGPT(PTF,0)),U,4)=1
SET FLAG=1
+8 QUIT FLAG
