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

IBCBB1.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; *** Begin IB*2.0*488 VD  (Issue 46 RBN)
  1.  N I
  1.  S I=""
  1.  S X=+$G(^DGCR(399,IBIFN,"MP"))
  1.  I 'X,$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S X=+$$CURR^IBCEF2(IBIFN)
  1.  ;JWS;IB*2.0*592:US1108 - Dental form check
  1.  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))
  1.  S I=$$UP^XLFSTR(I)
  1.  I (I'=""&(I["PRNT")&($G(IBER)'["IB488")) D 
  1.  . S IBER=$G(IBER)_"IB488;"
  1.  ;
  1.  ; Cause an error if FORCED TO PRINT TO CLEARINGHOUSE
  1.  I $P($G(^DGCR(399,IBIFN,"TX")),U,8)=2 D
  1.  . S IBER=$G(IBER)_"IB489;"
  1.  ;
  1.  ; Cause a fatal error if the claim has no procedures & is NOT a UB-04 Inpatient claim.
  1.  I +$O(^DGCR(399,IBIFN,"CP",0))=0 D
  1.  .I $$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN) Q   ; inpatient UB-04 check
  1.  .I '$$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN) D  Q      ; Outpatient Institutional Claim.
  1.  ..I IBER["IB352" Q
  1.  ..S IBER=IBER_"IB352;"
  1.  .;
  1.  .; Professional claim
  1.  .I IBER["IB353" Q
  1.  .S IBER=IBER_"IB353;"
  1.  .Q
  1.  ; *** End IB*2.0*488 -- VD
  1.  ;
  1.  ;MAP TO DGCRBB1
  1.  ;
  1. % ;Bill Status
  1.  N Z,Z0,Z1,IBFT
  1.  I $S(+IBST=0:1,1:"^1^2^3^4^7^"'[(U_IBST_U)) S IBER=IBER_"IB045;"
  1.  ;
  1.  ;Statement Covers From
  1.  I IBFDT="" S IBER=IBER_"IB061;"
  1.  I IBFDT]"",IBFDT'?7N&(IBFDT'?7N1".".N) S IBER=IBER_"IB061;"
  1.  I IBFDT>IBTDT S IBER=IBER_"IB061;" ; from must be on or before the to date 
  1.  S IBFFY=$$FY^IBOUTL(IBFDT)
  1.  ; if inpat - from date must not be prior to admit date.
  1.  I $$INPAT^IBCEF(IBIFN,1),(IBFDT<($P($G(^DGPT(+$P(IBND0,U,8),0)),U,2)\1))  S IBER=IBER_"IB061;"
  1.  ;
  1.  ;Statement Covers To
  1.  I IBTDT="" S IBER=IBER_"IB062;"
  1.  I IBTDT]"",IBTDT'?7N&(IBTDT'?7N1".".N) S IBER=IBER_"IB062;"
  1.  I IBTDT>DT!(IBTDT<IBFDT) S IBER=IBER_"IB062;"  ; to date must not be >than today's date
  1.  S IBTFY=$$FY^IBOUTL(IBTDT)
  1.  ;
  1.  ;Total Charges
  1.  ; IB*2.0*447/TAZ Removed this error so that zero dollar revenue codes can process on the 837
  1.  ;I +IBTC'>0!(+IBTC'=IBTC) S IBER=IBER_"IB064;"
  1.  ; IB*2.0*641 v9/WCJ added back so $0 claims won't go out
  1.  I +IBTC'>0 S IBER=IBER_"IB064;"
  1.  ;
  1.  ;Billable charges for secondary claim
  1.  I $$MCRONBIL^IBEFUNC(IBIFN)&(($P(IBNDU1,U,1)-$P(IBNDU1,U,2))'>0) S IBER=IBER_"IB094;"
  1.  ;Fiscal Year 1
  1.  S IBFFY=$$FY^IBOUTL(IBFDT)
  1.  ;
  1.  ;Check provider link for current user, enterer, reviewer and Authorizor
  1.  I '$D(^VA(200,DUZ,0)) S IBER=IBER_"IB048;"
  1.  I IBEU]"",'$D(^VA(200,IBEU,0)) S IBER=IBER_"IB048;"
  1.  I IBRU]"",'$D(^VA(200,IBRU,0)) S IBER=IBER_"IB060;"
  1.  I IBAU]"",'$D(^VA(200,IBAU,0)) S IBER=IBER_"IB041;"
  1.  ;
  1.  I IBER="",+$$STA^PRCAFN(IBIFN)=104 S IBER=IBER_"IB040;"
  1.  ; If ins bill, must have valid COB sequence
  1.  I $P(IBND0,U,11)="i",$S($P(IBND0,U,21)="":1,1:"PST"'[$P(IBND0,U,21)) S IBER=IBER_"IB324;"
  1.  ;
  1.  ; Check for valid sec provider id for current ins
  1.  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
  1.  . 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")
  1.  ; Check NPIs
  1.  D NPICHK^IBCBB11
  1.  ;
  1.  ; Check multiple rx NPIs
  1.  D RXNPI^IBCBB11(IBIFN)
  1.  ;
  1.  ; Check taxonomies
  1.  D TAXCHK^IBCBB11
  1.  ;
  1.  ; Check for Physician Name
  1.  K IBXDATA D F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
  1.  ; IB*2.0*432 - CMS1500 no longer needs a claim level rendering
  1.  S IBFT=$$FT^IBCEF(IBIFN)
  1.  ;JWS;IB*2.0*592:US1108 - Dental form check
  1.  I IBFT'=2,IBFT'=7,$P($G(IBXDATA),U)="" S IBER=IBER_"IB303;"
  1.  ;
  1.  N FUNCTION,IBINS
  1.  ; IB*2.0*432 - CMS1500 no longer needs a claim level rendering
  1.  ;S FUNCTION=$S($$FT^IBCEF(IBIFN)=3:4,1:3)
  1.  S FUNCTION=$S(IBFT=3:4,1:3)
  1.  ;JWS;IB*2.0*592:US1108 - Dental form check
  1.  I IBFT'=2,IBFT'=7,IBER'["IB303;" D
  1.  . F IBINS=1:1:3 D
  1.  .. S Z=$$GETTYP^IBCEP2A(IBIFN,IBINS)
  1.  .. I Z,$P(Z,U,2) D  ; Rendering/attending prov secondary id required
  1.  ... N IBID,IBOK,Q0
  1.  ... D PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C")  ; check all as though they were current
  1.  ... S IBOK=0
  1.  ... 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
  1.  ... I 'IBOK S IBER=IBER_$S(IBINS=1:"IB236;",IBINS=2:"IB237;",IBINS=3:"IB238;",1:"")
  1.  ;
  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
  1.  ; D PRIIDCHK^IBCBB11
  1.  ;
  1.  N IBM,IBM1
  1.  S IBM=$G(^DGCR(399,IBIFN,"M"))
  1.  S IBM1=$G(^DGCR(399,IBIFN,"M1"))
  1.  I $P(IBM,U),$P($G(^DIC(36,$P(IBM,U),4)),U,6),$P(IBM1,U,2)="" S IBER=IBER_"IB244;"
  1.  I $P(IBM,U,2),$P($G(^DIC(36,$P(IBM,U,2),4)),U,6),$P(IBM1,U,3)="" S IBER=IBER_"IB245;"
  1.  I $P(IBM,U,3),$P($G(^DIC(36,$P(IBM,U,3),4)),U,6),$P(IBM1,U,4)="" S IBER=IBER_"IB246;"
  1.  ;
  1.  ; If outside facility, check for ID and qualifier in 355.93
  1.  ; 5/15/06 - esg - hard error IB243 turned into warning message instead
  1.  S Z=$P($G(^DGCR(399,IBIFN,"U2")),U,10)
  1.  I Z D
  1.  . I $P($G(^IBA(355.93,Z,0)),U,9)=""!($P($G(^IBA(355.93,Z,0)),U,13)="") D
  1.  .. N Z1,Z2
  1.  .. S Z1="Missing Lab or Facility Primary ID for non-VA facility, "
  1.  .. S Z2=$$EXTERNAL^DILFD(399,232,,Z)
  1.  .. I $L(Z2)'>19 D WARN^IBCBB11(Z1_Z2) Q
  1.  .. D WARN^IBCBB11(Z1),WARN^IBCBB11("     "_Z2)
  1.  .. Q
  1.  . Q
  1.  ;
  1.  ; Must be one and only one division on bill
  1.  S IBZ=$$MULTDIV^IBCBB11(IBIFN,IBND0)
  1.  ; I IBZ S IBER=IBER_$S(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
  1.  ; Allow multi-divisional for OP instutional claims
  1.  I IBZ,$$INPAT^IBCEF(IBIFN)!'($$INSPRF^IBCEF(IBIFN)) S IBER=IBER_$S(IBZ=1:"IB095;",IBZ=2:"IB104;",1:"IB105;")
  1.  ; Still need error msg on OP Institutional if No Default division
  1.  I IBZ=3,'$$INPAT^IBCEF(IBIFN),$$INSPRF^IBCEF(IBIFN) S IBER=IBER_"IB105;"
  1.  ; Division address must be defined in institution file
  1.  I $P(IBND0,U,22) D
  1.  . N Z,Z0,Z1
  1.  . S Z0=$G(^DIC(4,+$P($G(^DG(40.8,+$P(IBND0,U,22),0)),U,7),0))
  1.  . S Z1=$G(^DIC(4,+$P($G(^DG(40.8,+$P(IBND0,U,22),0)),U,7),1))
  1.  . I $P(Z0,U,2)="" S IBER=IBER_"IB097;" Q
  1.  . F Z=1,3,4 I $P(Z1,U,Z)="" S IBER=IBER_"IB097;" Q
  1.  ;
  1.  ; IB*2.0*432 Check ambulance addresses, COB Non-covered amt. & Attachment Control
  1.  I $$AMBCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB329;"
  1.  I $$COBAMT^IBCBB11(IBIFN)=1 S IBER=IBER_"IB330;"
  1.  I $$TMCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB331;"
  1.  I $$ACCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB332;"
  1.  I $$COBMRA^IBCBB11(IBIFN)=1 S IBER=IBER_"IB342;"
  1.  I $$COBSEC^IBCBB11(IBIFN)=1 S IBER=IBER_"IB343;"
  1.  ;
  1.  ;CHAMPVA Rate Type and Primary Insurance Carriers Type of Coverage must match
  1.  S (IBRTCHV,IBPICHV)=0
  1.  I $P($G(^DGCR(399.3,+IBAT,0)),U,1)="CHAMPVA" S IBRTCHV=1
  1.  I $P($G(^IBE(355.2,+$P($G(^DIC(36,+IBNDMP,0)),U,13),0)),U,1)="CHAMPVA" S IBPICHV=1
  1.  I (+IBRTCHV!+IBPICHV)&('IBRTCHV!'IBPICHV) S IBER=IBER_"IB085;"
  1.  ;
  1.  ;Non-VA bill must use FEE REIMB INS rate type; FEE REIMB INS rate type can only be used for Non-VA bill
  1.  ;IB*2.0*554/DRF 10/9/2015
  1.  ;N IBNVART,IBNVAST
  1.  ;S (IBNVART,IBNVAST)=0
  1.  ;I $P($G(^DGCR(399.3,+IBAT,0)),U,1)="FEE REIMB INS" S IBNVART=1
  1.  ;S IBNVAST=$$NONVAFLG(IBIFN)
  1.  ;I IBNVART,'IBNVAST S IBER=IBER_"IB360;"  ;Non-VA rate type used for bill that is not Non-VA
  1.  ;I 'IBNVART,IBNVAST S IBER=IBER_"IB361;"  ;Non-VA rate type not used for bill that is Non-VA
  1.  ;
  1.  N IBZPRC,IBZPRCUB
  1.  D F^IBCEF("N-ALL PROCEDURES","IBZPRC",,IBIFN)
  1.  ; Procedure Clinic is required for Surgical Procedures Outpt Facility Charges
  1.  I +$P(IBND0,U,27)'=2,$$BILLRATE^IBCRU3(IBAT,IBCL,IBEVDT,"RC OUTPATIENT") D
  1.  . 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
  1.  .. S Z0=$G(^DGCR(399,IBIFN,"CP",Z,0)),Z1=+Z0 I Z0'[";ICPT(" Q
  1.  .. I '((Z1'<10000)&(Z1'>69999))&'((Z1'<93501)&(Z1'>93533)) Q
  1.  .. I '$P(Z0,U,7) S ZE=1
  1.  ;
  1.  ; Extract procedures for UB-04
  1.  D F^IBCEF("N-UB-04 PROCEDURES","IBZPRCUB",,IBIFN)
  1.  ; Does this bill have ANY prescriptions associated with it?
  1.  ; Must bill prescriptions separately from other charges
  1.  ;
  1.  ; DEM;432 - Call line level provider edit checks.
  1.  D LNPROV^IBCBB12(IBIFN)  ; DEM;432 - If there are line provider edits, then routine LNPROV^IBCBB12(IBIFN) updates IBER string.
  1.  ; DEM;432 - Call to Other Operating/Operating Provider edit checks.
  1.  I $$OPPROVCK^IBCBB12(IBIFN)=1 S IBER=IBER_"IB337;"  ; DEM;432
  1.  ; DEM;432 - Line level Attachment Control edits.
  1.  I $$LNTMCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB331;"  ; DEM;432
  1.  I $$LNACCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB332;"  ; DEM;432
  1.  ;
  1.  ; vd/Beginning of IB*2*577 - Validate Line Level NDC edits.
  1.  I $$LNNDCCK^IBCBB11(IBIFN)=1 S IBER=IBER_"IB365;"  ;IB*2*577;JWS;11/20/17 FIX
  1.  ; vd/End of IB*2*577
  1.  I $$ISRX^IBCEF1(IBIFN) D
  1.  . N IBZ,IBRXDEF
  1.  . S IBRXDEF=$P($G(^IBE(350.9,1,1)),U,30),IBZ=0
  1.  . F  S IBZ=$O(IBZPRCUB(IBZ)) Q:'IBZ  I IBZPRCUB(IBZ),+$P(IBZPRCUB(IBZ),U)'=IBRXDEF S IBER=IBER_"IB102;" Q
  1.  . K IBZ
  1.  ;
  1.  ; Check that COB sequences are not skipped
  1.  K Z
  1.  F Z=1:1:3 S:+$G(^DGCR(399,IBIFN,"I"_Z)) Z(Z)=""
  1.  F Z=0:1:2 S Z0=$O(Z(Z)) Q:'Z0  I Z0'=(Z+1) S IBER=IBER_"IB322;" Q
  1.  K Z
  1.  ; HD64676  IB*2*371 - OK for payer sequence to be blank when the Rate
  1.  ;    Type is either Interagency or Sharing Agreement
  1.  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;"
  1.  K IBXDATA D F^IBCEF("N-PROCEDURE CODING METHD",,,IBIFN)
  1.  ; Coding method should agree with types of procedure codes
  1.  S IBOK=$S('$O(IBZPRC(0))!(IBXDATA=""):1,1:0)
  1.  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
  1.  I 'IBOK D WARN^IBCBB11("Coding Method does not agree with all procedure codes found on bill")
  1.  D EDITMRA^IBCBB3(.IBQUIT,.IBER,IBIFN,IBFT)
  1.  Q:$G(IBQUIT)
  1.  ;
  1.  ;Other things that could be added:  Rev Code - calculating charges
  1.  ;        Diagnosis Coding, if MT copay - check for other co-payments
  1.  ;
  1.  I $P(IBNDTX,U,8),$$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB121;"   ; can't force MRAs to print
  1.  I $P(IBNDTX,U,8)!$P(IBNDTX,U,9) D
  1.  . Q:$P(IBNDTX,U,8)=2    ; Don't want to do this for option 2 any more.
  1.  . 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"))
  1.  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
  1.  . D WARN^IBCBB11($P($G(^DIC(36,+IBXZ,0)),U,1)_" requires Amb Care Certification")
  1.  ;
  1.  D VALNDC^IBCBB11(IBIFN,DFN)  ;validate NDC#
  1.  ;
  1.  ;Build AR array if no errors and MRA not needed or already rec'd
  1.  I IBER="",$S($$NEEDMRA^IBEFUNC(IBIFN)!($$REQMRA^IBEFUNC(IBIFN)):0,1:1) D ARRAY
  1.  ;
  1.  ;Check ROI
  1.  N ROIERR
  1.  ;/vd - IB*2.0*623 (US4995) - Modified the following 2 lines of code with the following conditional.
  1.  ;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
  1.  ;I $$ROICHK^IBCBB11(IBIFN,DFN,+IBNDMP) S ROIERR=1 ; check file for sensitive Rx and missing ROI
  1.  S ROIERR=0
  1.  I $$ROIDTCK^IBCEU7(IBIFN) D    ; ROI Eligible based upon Service Date of Claim
  1.  . 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
  1.  . I $$ROICHK^IBCBB11(IBIFN,DFN,+IBNDMP) S ROIERR=1 ; check file for sensitive Rx and missing ROI
  1.  I ROIERR S IBER=IBER_"IB328;"
  1.  ;
  1.  ;Verify Line Charges Match Claim Total Charge. IB*2.0*447 BI
  1.  I +$$GET1^DIQ(399,IBIFN_",",201)'=+$$IBLNTOT^IBCBB13(IBIFN) S IBER=IBER_"IB344;"
  1.  ;
  1.  ;Test for valid EIN/SY ID Values. IB*2.0*447 BI
  1.  I $$IBSYEI^IBCBB13(IBIFN) S IBER=IBER_"IB345;"
  1.  ;
  1.  ;Test for a missing ICN. IB*2.0*447 BI
  1.  I $$IBMICN^IBCBB13(IBIFN) S IBER=IBER_"IB346;"
  1.  ;
  1.  ;Test for a ZERO charge amounts. IB*2.0*447 BI
  1.  ;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
  1.  I IBER'["IB064;",$$IBRCCHK^IBCBB13(IBIFN) D WARN^IBCBB11("Claim contains revenue codes with no associated charges.")
  1.  ;
  1.  ;Test for missing "Patient reason for visit". IB*2.0*447 BI
  1.  I $$FT^IBCEF(IBIFN)=3,'$$INPAT^IBCEF(IBIFN),$$IBPRV3^IBCBB13(IBIFN) S IBER=IBER_"IB347;"
  1.  ;
  1.  ;Test for missing Payer ID. IB*2.0*447 BI
  1.  ;I $$IBMPID^IBCBB13(IBIFN) S IBER=IBER_"IB348;"
  1.  ;Changed Error to Warning. IB*2.0*447 TAZ
  1.  I $$IBMPID^IBCBB13(IBIFN) D WARN^IBCBB11("Not all payers have Payer IDs.")
  1.  ;
  1.  ;Test for missing "Priority (Type) of Admission" for UB-04. IB*2.0*447 BI
  1.  ;IB*2.0*665v1;JWS;Institutional Claims - prevent > 24 codes to be entered
  1.  I $$FT^IBCEF(IBIFN)=3 D
  1.  . I $$GET1^DIQ(399,IBIFN_",",158)="" S IBER=IBER_"IB349;"
  1.  . I '$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  .. N X,I,IS
  1.  .. 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
  1.  .. ;IB*2.0*702;JWS;remove 665 fatal error for Occ Codes > 24, make it a warning
  1.  .. ;I I>24 S IBER=IBER_"IB383;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB384;"
  1.  .. I I>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  ... D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Occurrence Codes.")
  1.  ... ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Occurrence Codes will be submitted.")
  1.  .. ;IB*2.0*702;JWS;remove 665 fatal error for Occ Span Codes > 24, make it a warning
  1.  .. ;I IS>24 S IBER=IBER_"IB385;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB386;"
  1.  .. I IS>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  ... D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Occurrence Span"),WARN^IBCBB11("Codes.")
  1.  ... ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Occurrence Span Codes will be submitted.")
  1.  .. ;IB*2.0*702;JWS;remove 665 fatal error for Value Codes > 23, make it a warning
  1.  .. ;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
  1.  .. I $P($G(^DGCR(399,IBIFN,"CV",0)),U,4)>23,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  ... D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 23 Value Codes.")
  1.  ... ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 23 Value Codes will be submitted.")
  1.  .. Q
  1.  ;IB*2.0*665v1;end
  1.  ;
  1.  ;IB*2.0*665v2; Inpatient Institutional Claims - prevent > 25 procedure codes electronically
  1.  I $$INPAT^IBCEF(IBIFN,1),$$INSPRF^IBCEF(IBIFN),'$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  . N IBPROC,IBXIEN,Z
  1.  . S IBXIEN=IBIFN
  1.  . D PROCX^IBCVA1
  1.  . ;IB*2.0*702;JWS;remove 665 fatal error for Inpatient Institutional Procedure Codes > 25, make it a warning
  1.  . ;I $G(IBPROC)>25 S IBER=IBER_"IB387;" I '$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN)) S IBER=IBER_"IB388;"
  1.  . I $G(IBPROC)>25,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  .. D WARN^IBCBB11("A HIPAA Compliant EDI Institutional Claim cannot contain more than"),WARN^IBCBB11("25 Procedure Codes. If this claim is submitted electronically,")
  1.  .. D WARN^IBCBB11("only the first 25 Procedure Codes will be included on the claim.")
  1.  ;IB*2.0*665v2;end 
  1.  ;IB*2.0*702;end
  1.  ;
  1.  ;IB*2.0*702;JWS;remove 665 fatal error for Condition Codes > 24, make it a warning
  1.  ;IB*2.0*665v5;WCJ;prevent > 24 condition codes to be entered unless going to paper.
  1.  ;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
  1.  I $P($G(^DGCR(399,IBIFN,"CC",0)),U,4)>24,'$$GET1^DIQ(399,IBIFN_",",27,"I") D
  1.  . D WARN^IBCBB11("A HIPAA Compliant EDI Claim cannot contain more than 24 Condition Codes.")
  1.  . ;;D WARN^IBCBB11("If this claim is sent electronically, only the first 24 Condition Codes will be submitted.")
  1.  ;
  1.  I $$FT^IBCEF(IBIFN)=2 S IBER=IBER_$$CMNCHK^IBCBB13(IBIFN)  ;JRA;IB*2.0*608 Check for missing CMN info
  1.  ;
  1.  ;IB*2.0*759;JWS;5/22/23;EBILL-2923;Prevent claims going out via EDI with NOEXC Payer ID
  1.  ; check COB TOTAL NON-COVERED AMOUNT exist and claim is secondary 
  1.  ;IB*2.0*759;v11;WCJ;2/14/24;EBILL-3841;commented out check - see defect for more information
  1.  ;I $P($G(^DGCR(399,IBIFN,"U4")),"^")'="",$$COBN^IBCEF(IBIFN)=2 D
  1.  ;. N IBP
  1.  ;. ; if there is a primary bill#, use it to determine if an MRA was requested
  1.  ;. S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) I IBP="" S IBP=IBIFN
  1.  ;. ; 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
  1.  ;. 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;"
  1.  ;. Q
  1.  ;
  1. END ;Don't kill IBIFN, IBER, DFN
  1.  I $O(^TMP($J,"BILL-WARN",0)),$G(IBER)="" S IBER="WARN" ;Warnings only
  1.  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
  1.  K IBNDS,IBND0,IBNDU,IBNDM,IBNDMP,IBNDU1,IBFFY,IBTFY,IBFT,IBRTCHV,IBPICHV,IBXDATA,IBOK
  1.  I $D(IBER),IBER="" W !,"No Errors found for National edits"
  1.  Q
  1.  ;
  1. ARRAY ;Build PRCASV(array)
  1.  N IBCOBN,X
  1.  K PRCASV
  1.  Q:$$MCRWNR^IBEFUNC(+$$CURR^IBCEF2(IBIFN))
  1.  S IBCOBN=$$COBN^IBCEF(IBIFN)
  1.  S X=IBIFN
  1.  S PRCASV("BDT")=DT,PRCASV("ARREC")=IBIFN
  1.  S PRCASV("APR")=DUZ
  1.  S PRCASV("PAT")=DFN,PRCASV("CAT")=$P(^DGCR(399.3,IBAT,0),"^",6)
  1.  I IBWHO="i" S PRCASV("DEBTOR")=+IBNDMP_";DIC(36,"
  1.  S PRCASV("DEBTOR")=$S(IBWHO="p":DFN_";DPT(",IBWHO="o":$P(IBNDM,"^",11)_";DIC(4,",IBWHO="i":PRCASV("DEBTOR"),1:"")
  1.  S PRCASV("CARE")=$E($$TOB^IBCEF1(IBIFN),1,2)
  1.  S PRCASV("FY")=$$FY^IBOUTL(DT)_U_($P(IBNDU1,U)-$P(IBNDU1,U,2))
  1.  ;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:"")
  1. PLUS I IBWHO="i",$P(IBNDM,"^",2),$D(^DIC(36,$P(IBNDM,"^",2),0)) S PRCASV("2NDINS")=$P(IBNDM,"^",2)
  1.  I IBWHO="i",$P(IBNDM,"^",3),$D(^DIC(36,$P(IBNDM,"^",3),0)) S PRCASV("3RDINS")=$P(IBNDM,"^",3)
  1.  ;
  1.  N IBX S IBX=$P(IBND0,U,21),IBX=$S(IBX="P":"I1",IBX="S":"I2",IBX="T":"I3",1:"") Q:IBX=""
  1.  N IBNDI1
  1.  Q:'$D(^DGCR(399,IBIFN,IBX))  S IBNDI1=^(IBX)
  1.  S:$P(IBNDI1,"^",3)]"" PRCASV("GPNO")=$P(IBNDI1,"^",3)
  1.  S:$P(IBNDI1,"^",15)]"" PRCASV("GPNM")=$P(IBNDI1,"^",15)
  1.  S:$P(IBNDI1,"^",17)]"" PRCASV("INPA")=$P(IBNDI1,"^",17)
  1.  S:$P(IBNDI1,"^",2)]"" PRCASV("IDNO")=$P(IBNDI1,"^",2),PRCASV("INID")=PRCASV("IDNO")
  1.  ; Check that this is a secondary or tertiary bill and insurance for previous
  1.  ; COB sequence is Medicare WNR and MRA is active --> send data elements to AR
  1.  I IBCOBN>1,$$WNRBILL^IBEFUNC(IBIFN,IBCOBN-1),$$EDIACTV^IBCEF4(2) D MRA
  1.  Q
  1.  ;
  1. MRA N IBEOB S IBEOB=0
  1.  ;
  1.  K PRCASV("MEDURE"),PRCASV("MEDCA")
  1.  ; Get EOB data
  1.  F  S IBEOB=$O(^IBM(361.1,"B",IBIFN,IBEOB)) Q:'IBEOB  D
  1.  . D MRACALC^IBCEMU2(IBEOB,IBIFN,1,.PRCASV)
  1.  Q  ;MRA
  1.  ;
  1.  ;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
  1.  ;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
  1.  ;
  1. NONVAFLG(IBIFN) ; Check if Non-VA bill
  1.  ; Function returns 1 if Non-VA bill
  1.  ; IB*2.0*554/DRF 10/9/2015
  1.  N FLAG,PTF
  1.  S FLAG=0
  1.  I $P($G(^DGCR(399,IBIFN,"U2")),U,10)]"" S FLAG=1 ;Non-VA provider defined
  1.  S PTF=$P($G(^DGCR(399,IBIFN,0)),U,8)
  1.  I PTF,$P($G(^DGPT(PTF,0)),U,4)=1 S FLAG=1 ;PTF entry indicates Non-VA
  1.  Q FLAG