IBCBB11 ;ALB/AAS/OIFO-BP/PIJ - CONTINUATION OF EDIT CHECK ROUTINE ;12 Jun 2006 3:45 PM
;;2.0;INTEGRATED BILLING;**51,343,363,371,395,392,401,384,400,436,432,516,550,577,568,591,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
WARN(IBDISP) ; Set warning in global
; DISP = warning text to display
;
N Z
S Z=+$O(^TMP($J,"BILL-WARN",""),-1)
I Z=0 S ^TMP($J,"BILL-WARN",1)=$J("",5)_"**Warnings**:",Z=1
S Z=Z+1,^TMP($J,"BILL-WARN",Z)=$J("",5)_IBDISP
Q
;
MULTDIV(IBIFN,IBND0) ; Check for multiple divisions on a bill ien IBIFN
; IBND0 = 0-node of bill
;
; Function returns 1 if more than 1 division found on bill
N Z,Z0,Z1,MULT
S MULT=0,Z1=$P(IBND0,U,22)
I Z1 D
. S Z=0 F S Z=$O(^DGCR(399,IBIFN,"RC",Z)) Q:'Z S Z0=$P(^(Z,0),U,7) I Z0,Z0'=Z1 S MULT=1 Q
. S Z=0 F S Z=$O(^DGCR(399,IBIFN,"CP",Z)) Q:'Z S Z0=$P(^(Z,0),U,6) I Z0,Z0'=Z1 S MULT=2 Q
I 'Z1 S MULT=3
Q MULT
;
;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
;
NPICHK ; Check for required NPIs
N IBNPIS,IBNONPI,IBNPIREQ,Z,IBNFI,IBTF,IBWC,IBXSAVE,IBPRV,IBLINE,IBPRVNT1,IBPRVNT2
;*** pij start IB*20*436 ***
N IBRATYPE,IBLEGAL
S (IBRATYPE,IBLEGAL)=""
S IBRATYPE=$P($G(^DGCR(399,IBIFN,0)),U,7)
; Legal types for this use.
; 7=NO FAULT INS.
; 10=TORT FEASOR
; 11=WORKERS' COMP.
S IBNFI=$O(^DGCR(399.3,"B","NO FAULT INS.",0)) S:'IBNFI IBNFI=7
S IBTF=$O(^DGCR(399.3,"B","TORT FEASOR",0)) S:'IBTF IBTF=10
S IBWC=$O(^DGCR(399.3,"B","WORKERS' COMP.",0)) S:'IBWC IBWC=11
;
I IBRATYPE=IBNFI!(IBRATYPE=IBTF)!(IBRATYPE=IBWC) D
. ; One of the legal types - force local print
. S IBLEGAL=1
;*** pij end ***
S IBNPIREQ=$$NPIREQ^IBCEP81(DT) ; Check if NPI is required
; Check providers
; IB*2.0*432 changed the NPI check to the new Provider Array
;S IBNPIS=$$PROVNPI^IBCEF73A(IBIFN,.IBNONPI)
D ALLIDS^IBCEFP(IBIFN,.IBXSAVE,1)
S IBPRV=""
F S IBPRV=$O(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV)) Q:'IBPRV D
. I $P($G(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV,0)),U,4)="" S IBNONPI(IBPRV)=""
S IBLINE=""
F S IBLINE=$O(IBXSAVE("L-PROV",IBIFN,IBLINE)) Q:'IBLINE D
. S IBPRV=""
. F S IBPRV=$O(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV)) Q:IBPRV="" D
.. I $P($G(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV,0)),U,4)="" S IBNONPI(IBPRV)=""
I $D(IBNONPI) S IBPRV="" F S IBPRV=$O(IBNONPI(IBPRV)) Q:'IBPRV D
. ;JWS;IB*2.0*592;Assistant Surgeon for dental
. I IBPRV=6 S IBER=IBER_"IB358;" Q
. S IBER=IBER_"IB"_(140+IBPRV)_";" Q ; If required, set error IB*2*516
; Check organizations
S IBNONPI=""
S IBNPIS=$$ORGNPI^IBCEF73A(IBIFN,.IBNONPI)
I $L(IBNONPI) F Z=1:1:$L(IBNONPI,U) D
. S IBER=IBER_$P("IB339;^IB340;^IB341;",U,$P(IBNONPI,U,Z)) ; DEM;432 Added NPI errors.
Q
;
TAXCHK ; Check for required taxonomies
N IBDT,IBLINE,IBNOTAX,IBNOTAX1,IBNOTAX2,IBPRV,IBTAXS,IBXSAVE,Z
;
; MRD;IB*2.0*516 - This check is now moot; 'today' is always on or
; after May 23, 2008, so taxonomy codes are always required
; for certain providers.
;S IBTAXREQ=$$TAXREQ^IBCEP81(DT) ; Check if taxonomy is required
;
; Check providers
; IB*2.0*432 changed the Taxonomy check to the new Provider Array
;S IBTAXS=$$PROVTAX^IBCEF73A(IBIFN,.IBNOTAX)
D ALLIDS^IBCEFP(IBIFN,.IBXSAVE,1)
;JWS;IB*2.0*592; prevent having both RENDERING and ASSISTANT SURGEON providers at the claim level
; ;performing check here after providers are 'merged' into the claim level, if only at line level
; ;done in ALLIDS^IBCEFP
I $$FT^IBCEF(IBIFN)=7 D
. I $D(IBXSAVE("PROVINF",IBIFN,"C",1,3)),$D(IBXSAVE("PROVINF",IBIFN,"C",1,6)) D
.. I '$F(IBER,"IB363;") S IBER=IBER_"IB363;"
.. Q
. ;JWS;IB*2.0*592 - US1108 start
. I '$D(IBXSAVE("PROVINF",IBIFN,"C",1,3)),'$D(IBXSAVE("PROVINF",IBIFN,"C",1,6)) D
.. N IBX,OK S OK=0,IBX=""
.. F S IBX=$O(IBXSAVE("L-PROV",IBX)) Q:IBX="" D Q:OK
... I $D(IBXSAVE("L-PROV",IBX,"C",1,3)) S OK=1 Q
... I $D(IBXSAVE("L-PROV",IBX,"C",1,6)) S OK=1 Q
.. I 'OK S IBER=IBER_"IB357;"
.. Q
. Q
;JWS;IB*2.0*592 - US1108 end
S IBPRV=""
F S IBPRV=$O(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV)) Q:'IBPRV D
. I $G(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV,"TAXONOMY"))="" D
.. S IBNOTAX(IBPRV)=""
.. S IBNOTAX1=$P(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV),";",1) ; New variables IBNOTAX1 and IBNOTAX2 for IB*2.0*568 - Deactivated Provider
.. S IBNOTAX2(IBPRV,IBNOTAX1)=""
.. Q
. Q
;
S IBLINE=""
F S IBLINE=$O(IBXSAVE("L-PROV",IBIFN,IBLINE)) Q:'IBLINE D
. S IBPRV=""
. F S IBPRV=$O(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV)) Q:IBPRV="" D
.. I $G(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV,"TAXONOMY"))="" D
... S IBNOTAX(IBPRV)=""
... S IBNOTAX1=$P(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV),";",1) ; New variables IBNOTAX1 and IBNOTAX2 for IB*2.0*568 - Deactivated Provider
... S IBNOTAX2(IBPRV,IBNOTAX1)=""
... Q
.. Q
. Q
;
; IB251 = Referring provider taxonomy missing.
; IB253 = Rendering provider taxonomy missing.
; IB254 = Attending provider taxonomy missing.
; IB256 = Assistant Surgeon taxonomy missing. ;JWS;IB*2.0*592
;JWS;IB*2.0*592;dental start
I $D(IBNOTAX) S IBPRV="" F S IBPRV=$O(IBNOTAX(IBPRV)) Q:'IBPRV D
. ; Only Referring, Rendering and Attending are currently sent to the payer
. ;I IBTAXREQ,"134"[IBPRV S IBER=IBER_"IB"_(250+IBPRV)_";" Q ; MRD;IB*2.0*516 - Always required.
. I "134"[IBPRV D Q
.. S IBER=IBER_"IB"_(250+IBPRV)_";" ; If required, set error
.. S IBPRVNT1=$O(IBNOTAX2(IBPRV,"")) ; New check for Deactivated Provider IB*2.0*568 next three lines
.. S IBPRVNT2=$$SPEC^IBCEU(IBPRVNT1,IBEVDT)
.. I '$G(IBPRVNT2) D WARN($P("Referring^Operating^Rendering^Attending^Supervising^^^^Other",U,IBPRV)_" Provider PERSON CLASS/taxonomy was not active at DOS.") ; set warning
. D WARN("Taxonomy for the "_$P("referring^operating^rendering^attending^supervising^^^^other",U,IBPRV)_" provider has no value") ; Else, set warning
. Q
;JWS;IB*2.0*592;end
;
; Check organizations. The function ORGTAX will set IBNOTAX to be a
; list of entities missing taxonomy codes, if any (n, n^m, n^m^p,
; where each 1 is service facility, 2 is non-VA service facility and
; 3 is billing provider.
;
S IBNOTAX=""
S IBTAXS=$$ORGTAX^IBCEF73A(IBIFN,.IBNOTAX)
I $L(IBNOTAX) F Z=1:1:$L(IBNOTAX,U) D
. ; IB167 = Billing Provider taxonomy missing.
. ;I IBTAXREQ,$P(IBNOTAX,U,Z)=3 S IBER=IBER_"IB167;" Q ; MRD;IB*2.0*516 - Always required.
. I $P(IBNOTAX,U,Z)=3 S IBER=IBER_"IB167;" Q
. ; MRD;IB*2.0*516 - Remove warning message for missing taxonomy code for lab or facility.
. ; D WARN("Taxonomy for the "_$P("Service Facility^Non-VA Service Facility^Billing Provider",U,$P(IBNOTAX,U,Z))_" has no value") ; Else, set warning
. Q
;
Q
;
VALNDC(IBIFN,IBDFN) ; Moving pharmacy checks to reduce likelihood of patch collision
D VALNDC^IBCBB14(IBIFN,IBDFN)
Q
;
PRIIDCHK ; Check for required Pimarary ID (SSN/EIN)
; If the provider is on the claim, he must have one
;
N IBI,IBZ
I $$TXMT^IBCEF4(IBIFN) D
. D F^IBCEF("N-ALL ATT/REND PROV SSN/EI","IBZ",,IBIFN)
. S IBI="" F S IBI=$O(^DGCR(399,IBIFN,"PRV","B",IBI)) Q:IBI="" D
.. I $P(IBZ,U,IBI)="" S IBER=IBER_$S(IBI=1:"IB151;",IBI=2:"IB152;",IBI=3!(IBI=4):"IB321;",IBI=5:"IB153;",IBI=9:"IB154;",1:"")
Q
;
RXNPI(IBIFN) ; Moving pharmacy checks to reduce likelihood of patch collision
D RXNPI^IBCBB14(IBIFN)
Q
;
ROICHK(IBIFN,IBDFN,IBINS) ; Moving pharmacy checks to reduce likelihood of patch collision
Q $$ROICHK^IBCBB14(IBIFN,IBDFN,IBINS)
;
AMBCK(IBIFN) ; IB*2.0*432 - if ambulance location defined, address must be defined
; if there is anything entered in any of the address fields (either p/up or drop/off fields), than there needs to be:
; Address 1, State and ZIP unless the State is not a US state or possession, then zip code is not needed (CMS1500 only)
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - 0 = no error
; 1 = Error
;
N IBPAMB,IBDAMB,IBAMBR,IBCK
S IBAMBR=0
Q:$$INSPRF^IBCEF(IBIFN)'=0 IBAMBR
S IBPAMB=$G(^DGCR(399,IBIFN,"U5")),IBDAMB=$G(^DGCR(399,IBIFN,"U6"))
S IBCK(5)=$$NOPUNCT^IBCEF($P(IBPAMB,U,2,6),1),IBCK(6)=$$NOPUNCT^IBCEF($P(IBDAMB,U,1,6),1)
I IBCK(5)="",IBCK(6)="" Q IBAMBR
; at this point we know that at least one ambulance field has data, so check to see if all have data
I IBCK(5)'="" F I=2,4,5 I $P(IBPAMB,U,I)="" S IBAMBR=1
I IBCK(6)'="" F I=1,2,4,5 I $P(IBDAMB,U,I)="" S IBAMBR=1
Q:IBAMBR=1 IBAMBR
; now check zip code. OK to be null if state is not a US Posession
F I="IBPAMB","IBDAMB" I $P(I,U,5)'="",$P($G(^DIC(5,$P(I,U,5),0)),U,6)=1,$P(I,U,6)="" S IBAMBR=1
Q IBAMBR
;
COBAMT(IBIFN) ; IB*2.0*432 - IF there is a COB amt. it must equal the Total Claim Charge Amount
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - 0 = no error
; 1 = Error
;
Q:IBIFN="" 0
Q:$P($G(^DGCR(399,IBIFN,"U4")),U)="" 0
Q:+$P($G(^DGCR(399,IBIFN,"U1")),U)'=+$P($G(^DGCR(399,IBIFN,"U4")),U) 1
Q 0
;
COBMRA(IBIFN) ; IB*2.0*432 - If there is a 'COB total non-covered amount' (File#399, Field#260),
; Primary Insurance must be Medicare that never went to Medicare, and this must be a 2ndary or tertiary claim
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - 0 = no error
; 1 = Error
;
N IBP
Q:IBIFN="" 0
Q:$P($G(^DGCR(399,IBIFN,"U4")),U)="" 0
S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) S:IBP="" IBP=IBIFN
I $$WNRBILL^IBEFUNC(IBIFN,1),$P($G(^DGCR(399,IBP,"S")),U,7)="",$$COBN^IBCEF(IBIFN)>1 Q 0
Q 1
;
COBSEC(IBIFN) ; IB*2.0*432 - If there is NOT a 'COB total non-covered amount' (File#399, Field#260),
; and Primary Insurance is Medicare that never went to Medicare, 2ndary or tertiary claim cannot be set to transmit
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - 0 = no error
; 1 = Error
;
N IBP
Q:IBIFN="" 0
Q:$P($G(^DGCR(399,IBIFN,"U4")),U)'="" 0
Q:$$COBN^IBCEF(IBIFN)<2 0
S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) S:IBP="" IBP=IBIFN
I $$WNRBILL^IBEFUNC(IBIFN,1),$P($G(^DGCR(399,IBP,"S")),U,7)="",$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1 Q 1
Q 0
;
TMCK(IBIFN) ; IB*2.0*432 - Attachment Control Number - REQUIRED when Transmission Method = BM, EL, EM, or FT
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - 0 = no error
; 1 = Error
;
N IBAC
Q:IBIFN="" 0
F I=1,3 S IBAC(I)=$P($G(^DGCR(399,IBIFN,"U8")),U,I)
Q:IBAC(3)="" 0
Q:IBAC(1)'="" 0
Q:IBAC(3)="AA" 0
Q 1
;
ACCK(IBIFN) ; IB*2.0*432 If any of the loop info is present, then Report Type & Transmission Method req'd
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - 0 = no error
; 1 = Error
;
N IBAC
Q:IBIFN="" 0
F I=1:1:3 S IBAC(I)=$P($G(^DGCR(399,IBIFN,"U8")),U,I)
; All fields null, no error
I IBAC(1)="",IBAC(2)="",IBAC(3)="" Q 0
; Both required fields complete, no error
I IBAC(2)'="",IBAC(3)'="" Q 0
; At this point, one of the 2 required fields has data and one does not, so error
Q 1
;
LNTMCK(IBIFN) ; DEM;IB*2.0*432 - (Line Level) Attachment Control Number - REQUIRED when Transmission Method = BM, EL, EM, or FT
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - IBLNERR = 0 = no error
; IBLNERR = 1 = Error
;
N IBAC,IBPROCP,I,IBLNERR
S IBLNERR=0 ; DEM;432 - Initialize error flag IBLNERR to '0' for no errors.
Q:IBIFN="" IBLNERR
S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBLNERR
. Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,0))#10) ; DEM;432 - Node '0' is procedure node.
. Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,1))#10) ; DEM;432 - Node '1' is line level Attachment Control fields.
. F I=1,3 S IBAC(I)=$P(^DGCR(399,IBIFN,"CP",IBPROCP,1),U,I)
. I IBAC(3)="" S IBLNERR=0 Q
. I IBAC(1)'="" S IBLNERR=0 Q
. I (IBAC(3)="AA") S IBLNERR=0 Q
. S IBLNERR=1
. Q
;
Q IBLNERR
;
LNACCK(IBIFN) ; DEM;IB*2.0*432 (Line Level) If any of the loop info is present, then Report Type & Transmission Method req'd
; input - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - IBLNERR = 0 = no error
; IBLNERR = 1 = Error
;
N IBAC,IBPROCP,I,IBLNERR
S IBLNERR=0 ; DEM;432 - Initialize error flag IBLNERR to '0' for no errors.
Q:IBIFN="" IBLNERR
S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBLNERR
. Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,0))#10) ; DEM;432 - Node '0' is procedure node.
. Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,1))#10) ; DEM;432 - Node '1' is line level Attachment Control fields.
. F I=1:1:3 S IBAC(I)=$P(^DGCR(399,IBIFN,"CP",IBPROCP,1),U,I)
. ; All fields null, no error
. I IBAC(1)="",IBAC(2)="",IBAC(3)="" S IBLNERR=0 Q
. ; Both required fields complete, no error
. I IBAC(2)'="",IBAC(3)'="" S IBLNERR=0 Q
. ; At this point, one of the 2 required fields has data and one does not, so error
. S IBLNERR=1
. Q
;
Q IBLNERR
;
;vd/Beginning of IB*2*577 - Validate Line Level for NDC
LNNDCCK(IBIFN) ;IB*2*577 (Line Level) The Units and Units/Basis of Measurement fields are required if the NDC field is populated.
; INPUT - IBIFN = IEN of the Bill/Claims file (#399)
; OUTPUT - IBLNERR = 0 = no error
; IBLNERR = 1 = Error
;
N IBAC,IBPROCP,I,IBLNERR
S IBLNERR=0 ; IB*2*577 - Initialize error flag IBLNERR to '0' for no errors.
Q:IBIFN="" IBLNERR
S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBLNERR
. Q:($$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","NDC","I")="") ; IB*2*577 - No NDC Code
. ; If there is an NDC Code, then the UNITS and UNITS/BASIS OF MEASUREMENT are Required.
. I $$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","UNITS/BASIS OF MEASUREMENT","I")="" S IBLNERR=1 Q
. I $$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","UNITS","I")="" S IBLNERR=1 Q ;Units (Quantity) is required if there is an NDC Code.
. Q
;
Q IBLNERR
;vd/End of IB*2*577
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB11 14114 printed Dec 13, 2024@02:08:47 Page 2
IBCBB11 ;ALB/AAS/OIFO-BP/PIJ - CONTINUATION OF EDIT CHECK ROUTINE ;12 Jun 2006 3:45 PM
+1 ;;2.0;INTEGRATED BILLING;**51,343,363,371,395,392,401,384,400,436,432,516,550,577,568,591,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
WARN(IBDISP) ; Set warning in global
+1 ; DISP = warning text to display
+2 ;
+3 NEW Z
+4 SET Z=+$ORDER(^TMP($JOB,"BILL-WARN",""),-1)
+5 IF Z=0
SET ^TMP($JOB,"BILL-WARN",1)=$JUSTIFY("",5)_"**Warnings**:"
SET Z=1
+6 SET Z=Z+1
SET ^TMP($JOB,"BILL-WARN",Z)=$JUSTIFY("",5)_IBDISP
+7 QUIT
+8 ;
MULTDIV(IBIFN,IBND0) ; Check for multiple divisions on a bill ien IBIFN
+1 ; IBND0 = 0-node of bill
+2 ;
+3 ; Function returns 1 if more than 1 division found on bill
+4 NEW Z,Z0,Z1,MULT
+5 SET MULT=0
SET Z1=$PIECE(IBND0,U,22)
+6 IF Z1
Begin DoDot:1
+7 SET Z=0
FOR
SET Z=$ORDER(^DGCR(399,IBIFN,"RC",Z))
if 'Z
QUIT
SET Z0=$PIECE(^(Z,0),U,7)
IF Z0
IF Z0'=Z1
SET MULT=1
QUIT
+8 SET Z=0
FOR
SET Z=$ORDER(^DGCR(399,IBIFN,"CP",Z))
if 'Z
QUIT
SET Z0=$PIECE(^(Z,0),U,6)
IF Z0
IF Z0'=Z1
SET MULT=2
QUIT
End DoDot:1
+9 IF 'Z1
SET MULT=3
+10 QUIT MULT
+11 ;
+12 ;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
+13 ;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
+14 ;
NPICHK ; Check for required NPIs
+1 NEW IBNPIS,IBNONPI,IBNPIREQ,Z,IBNFI,IBTF,IBWC,IBXSAVE,IBPRV,IBLINE,IBPRVNT1,IBPRVNT2
+2 ;*** pij start IB*20*436 ***
+3 NEW IBRATYPE,IBLEGAL
+4 SET (IBRATYPE,IBLEGAL)=""
+5 SET IBRATYPE=$PIECE($GET(^DGCR(399,IBIFN,0)),U,7)
+6 ; Legal types for this use.
+7 ; 7=NO FAULT INS.
+8 ; 10=TORT FEASOR
+9 ; 11=WORKERS' COMP.
+10 SET IBNFI=$ORDER(^DGCR(399.3,"B","NO FAULT INS.",0))
if 'IBNFI
SET IBNFI=7
+11 SET IBTF=$ORDER(^DGCR(399.3,"B","TORT FEASOR",0))
if 'IBTF
SET IBTF=10
+12 SET IBWC=$ORDER(^DGCR(399.3,"B","WORKERS' COMP.",0))
if 'IBWC
SET IBWC=11
+13 ;
+14 IF IBRATYPE=IBNFI!(IBRATYPE=IBTF)!(IBRATYPE=IBWC)
Begin DoDot:1
+15 ; One of the legal types - force local print
+16 SET IBLEGAL=1
End DoDot:1
+17 ;*** pij end ***
+18 ; Check if NPI is required
SET IBNPIREQ=$$NPIREQ^IBCEP81(DT)
+19 ; Check providers
+20 ; IB*2.0*432 changed the NPI check to the new Provider Array
+21 ;S IBNPIS=$$PROVNPI^IBCEF73A(IBIFN,.IBNONPI)
+22 DO ALLIDS^IBCEFP(IBIFN,.IBXSAVE,1)
+23 SET IBPRV=""
+24 FOR
SET IBPRV=$ORDER(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV))
if 'IBPRV
QUIT
Begin DoDot:1
+25 IF $PIECE($GET(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV,0)),U,4)=""
SET IBNONPI(IBPRV)=""
End DoDot:1
+26 SET IBLINE=""
+27 FOR
SET IBLINE=$ORDER(IBXSAVE("L-PROV",IBIFN,IBLINE))
if 'IBLINE
QUIT
Begin DoDot:1
+28 SET IBPRV=""
+29 FOR
SET IBPRV=$ORDER(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV))
if IBPRV=""
QUIT
Begin DoDot:2
+30 IF $PIECE($GET(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV,0)),U,4)=""
SET IBNONPI(IBPRV)=""
End DoDot:2
End DoDot:1
+31 IF $DATA(IBNONPI)
SET IBPRV=""
FOR
SET IBPRV=$ORDER(IBNONPI(IBPRV))
if 'IBPRV
QUIT
Begin DoDot:1
+32 ;JWS;IB*2.0*592;Assistant Surgeon for dental
+33 IF IBPRV=6
SET IBER=IBER_"IB358;"
QUIT
+34 ; If required, set error IB*2*516
SET IBER=IBER_"IB"_(140+IBPRV)_";"
QUIT
End DoDot:1
+35 ; Check organizations
+36 SET IBNONPI=""
+37 SET IBNPIS=$$ORGNPI^IBCEF73A(IBIFN,.IBNONPI)
+38 IF $LENGTH(IBNONPI)
FOR Z=1:1:$LENGTH(IBNONPI,U)
Begin DoDot:1
+39 ; DEM;432 Added NPI errors.
SET IBER=IBER_$PIECE("IB339;^IB340;^IB341;",U,$PIECE(IBNONPI,U,Z))
End DoDot:1
+40 QUIT
+41 ;
TAXCHK ; Check for required taxonomies
+1 NEW IBDT,IBLINE,IBNOTAX,IBNOTAX1,IBNOTAX2,IBPRV,IBTAXS,IBXSAVE,Z
+2 ;
+3 ; MRD;IB*2.0*516 - This check is now moot; 'today' is always on or
+4 ; after May 23, 2008, so taxonomy codes are always required
+5 ; for certain providers.
+6 ;S IBTAXREQ=$$TAXREQ^IBCEP81(DT) ; Check if taxonomy is required
+7 ;
+8 ; Check providers
+9 ; IB*2.0*432 changed the Taxonomy check to the new Provider Array
+10 ;S IBTAXS=$$PROVTAX^IBCEF73A(IBIFN,.IBNOTAX)
+11 DO ALLIDS^IBCEFP(IBIFN,.IBXSAVE,1)
+12 ;JWS;IB*2.0*592; prevent having both RENDERING and ASSISTANT SURGEON providers at the claim level
+13 ; ;performing check here after providers are 'merged' into the claim level, if only at line level
+14 ; ;done in ALLIDS^IBCEFP
+15 IF $$FT^IBCEF(IBIFN)=7
Begin DoDot:1
+16 IF $DATA(IBXSAVE("PROVINF",IBIFN,"C",1,3))
IF $DATA(IBXSAVE("PROVINF",IBIFN,"C",1,6))
Begin DoDot:2
+17 IF '$FIND(IBER,"IB363;")
SET IBER=IBER_"IB363;"
+18 QUIT
End DoDot:2
+19 ;JWS;IB*2.0*592 - US1108 start
+20 IF '$DATA(IBXSAVE("PROVINF",IBIFN,"C",1,3))
IF '$DATA(IBXSAVE("PROVINF",IBIFN,"C",1,6))
Begin DoDot:2
+21 NEW IBX,OK
SET OK=0
SET IBX=""
+22 FOR
SET IBX=$ORDER(IBXSAVE("L-PROV",IBX))
if IBX=""
QUIT
Begin DoDot:3
+23 IF $DATA(IBXSAVE("L-PROV",IBX,"C",1,3))
SET OK=1
QUIT
+24 IF $DATA(IBXSAVE("L-PROV",IBX,"C",1,6))
SET OK=1
QUIT
End DoDot:3
if OK
QUIT
+25 IF 'OK
SET IBER=IBER_"IB357;"
+26 QUIT
End DoDot:2
+27 QUIT
End DoDot:1
+28 ;JWS;IB*2.0*592 - US1108 end
+29 SET IBPRV=""
+30 FOR
SET IBPRV=$ORDER(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV))
if 'IBPRV
QUIT
Begin DoDot:1
+31 IF $GET(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV,"TAXONOMY"))=""
Begin DoDot:2
+32 SET IBNOTAX(IBPRV)=""
+33 ; New variables IBNOTAX1 and IBNOTAX2 for IB*2.0*568 - Deactivated Provider
SET IBNOTAX1=$PIECE(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV),";",1)
+34 SET IBNOTAX2(IBPRV,IBNOTAX1)=""
+35 QUIT
End DoDot:2
+36 QUIT
End DoDot:1
+37 ;
+38 SET IBLINE=""
+39 FOR
SET IBLINE=$ORDER(IBXSAVE("L-PROV",IBIFN,IBLINE))
if 'IBLINE
QUIT
Begin DoDot:1
+40 SET IBPRV=""
+41 FOR
SET IBPRV=$ORDER(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV))
if IBPRV=""
QUIT
Begin DoDot:2
+42 IF $GET(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV,"TAXONOMY"))=""
Begin DoDot:3
+43 SET IBNOTAX(IBPRV)=""
+44 ; New variables IBNOTAX1 and IBNOTAX2 for IB*2.0*568 - Deactivated Provider
SET IBNOTAX1=$PIECE(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV),";",1)
+45 SET IBNOTAX2(IBPRV,IBNOTAX1)=""
+46 QUIT
End DoDot:3
+47 QUIT
End DoDot:2
+48 QUIT
End DoDot:1
+49 ;
+50 ; IB251 = Referring provider taxonomy missing.
+51 ; IB253 = Rendering provider taxonomy missing.
+52 ; IB254 = Attending provider taxonomy missing.
+53 ; IB256 = Assistant Surgeon taxonomy missing. ;JWS;IB*2.0*592
+54 ;JWS;IB*2.0*592;dental start
+55 IF $DATA(IBNOTAX)
SET IBPRV=""
FOR
SET IBPRV=$ORDER(IBNOTAX(IBPRV))
if 'IBPRV
QUIT
Begin DoDot:1
+56 ; Only Referring, Rendering and Attending are currently sent to the payer
+57 ;I IBTAXREQ,"134"[IBPRV S IBER=IBER_"IB"_(250+IBPRV)_";" Q ; MRD;IB*2.0*516 - Always required.
+58 IF "134"[IBPRV
Begin DoDot:2
+59 ; If required, set error
SET IBER=IBER_"IB"_(250+IBPRV)_";"
+60 ; New check for Deactivated Provider IB*2.0*568 next three lines
SET IBPRVNT1=$ORDER(IBNOTAX2(IBPRV,""))
+61 SET IBPRVNT2=$$SPEC^IBCEU(IBPRVNT1,IBEVDT)
+62 ; set warning
IF '$GET(IBPRVNT2)
DO WARN($PIECE("Referring^Operating^Rendering^Attending^Supervising^^^^Other",U,IBPRV)_" Provider PERSON CLASS/taxonomy was not active at DOS.")
End DoDot:2
QUIT
+63 ; Else, set warning
DO WARN("Taxonomy for the "_$PIECE("referring^operating^rendering^attending^supervising^^^^other",U,IBPRV)_" provider has no value")
+64 QUIT
End DoDot:1
+65 ;JWS;IB*2.0*592;end
+66 ;
+67 ; Check organizations. The function ORGTAX will set IBNOTAX to be a
+68 ; list of entities missing taxonomy codes, if any (n, n^m, n^m^p,
+69 ; where each 1 is service facility, 2 is non-VA service facility and
+70 ; 3 is billing provider.
+71 ;
+72 SET IBNOTAX=""
+73 SET IBTAXS=$$ORGTAX^IBCEF73A(IBIFN,.IBNOTAX)
+74 IF $LENGTH(IBNOTAX)
FOR Z=1:1:$LENGTH(IBNOTAX,U)
Begin DoDot:1
+75 ; IB167 = Billing Provider taxonomy missing.
+76 ;I IBTAXREQ,$P(IBNOTAX,U,Z)=3 S IBER=IBER_"IB167;" Q ; MRD;IB*2.0*516 - Always required.
+77 IF $PIECE(IBNOTAX,U,Z)=3
SET IBER=IBER_"IB167;"
QUIT
+78 ; MRD;IB*2.0*516 - Remove warning message for missing taxonomy code for lab or facility.
+79 ; D WARN("Taxonomy for the "_$P("Service Facility^Non-VA Service Facility^Billing Provider",U,$P(IBNOTAX,U,Z))_" has no value") ; Else, set warning
+80 QUIT
End DoDot:1
+81 ;
+82 QUIT
+83 ;
VALNDC(IBIFN,IBDFN) ; Moving pharmacy checks to reduce likelihood of patch collision
+1 DO VALNDC^IBCBB14(IBIFN,IBDFN)
+2 QUIT
+3 ;
PRIIDCHK ; Check for required Pimarary ID (SSN/EIN)
+1 ; If the provider is on the claim, he must have one
+2 ;
+3 NEW IBI,IBZ
+4 IF $$TXMT^IBCEF4(IBIFN)
Begin DoDot:1
+5 DO F^IBCEF("N-ALL ATT/REND PROV SSN/EI","IBZ",,IBIFN)
+6 SET IBI=""
FOR
SET IBI=$ORDER(^DGCR(399,IBIFN,"PRV","B",IBI))
if IBI=""
QUIT
Begin DoDot:2
+7 IF $PIECE(IBZ,U,IBI)=""
SET IBER=IBER_$SELECT(IBI=1:"IB151;",IBI=2:"IB152;",IBI=3!(IBI=4):"IB321;",IBI=5:"IB153;",IBI=9:"IB154;",1:"")
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
RXNPI(IBIFN) ; Moving pharmacy checks to reduce likelihood of patch collision
+1 DO RXNPI^IBCBB14(IBIFN)
+2 QUIT
+3 ;
ROICHK(IBIFN,IBDFN,IBINS) ; Moving pharmacy checks to reduce likelihood of patch collision
+1 QUIT $$ROICHK^IBCBB14(IBIFN,IBDFN,IBINS)
+2 ;
AMBCK(IBIFN) ; IB*2.0*432 - if ambulance location defined, address must be defined
+1 ; if there is anything entered in any of the address fields (either p/up or drop/off fields), than there needs to be:
+2 ; Address 1, State and ZIP unless the State is not a US state or possession, then zip code is not needed (CMS1500 only)
+3 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+4 ; OUTPUT - 0 = no error
+5 ; 1 = Error
+6 ;
+7 NEW IBPAMB,IBDAMB,IBAMBR,IBCK
+8 SET IBAMBR=0
+9 if $$INSPRF^IBCEF(IBIFN)'=0
QUIT IBAMBR
+10 SET IBPAMB=$GET(^DGCR(399,IBIFN,"U5"))
SET IBDAMB=$GET(^DGCR(399,IBIFN,"U6"))
+11 SET IBCK(5)=$$NOPUNCT^IBCEF($PIECE(IBPAMB,U,2,6),1)
SET IBCK(6)=$$NOPUNCT^IBCEF($PIECE(IBDAMB,U,1,6),1)
+12 IF IBCK(5)=""
IF IBCK(6)=""
QUIT IBAMBR
+13 ; at this point we know that at least one ambulance field has data, so check to see if all have data
+14 IF IBCK(5)'=""
FOR I=2,4,5
IF $PIECE(IBPAMB,U,I)=""
SET IBAMBR=1
+15 IF IBCK(6)'=""
FOR I=1,2,4,5
IF $PIECE(IBDAMB,U,I)=""
SET IBAMBR=1
+16 if IBAMBR=1
QUIT IBAMBR
+17 ; now check zip code. OK to be null if state is not a US Posession
+18 FOR I="IBPAMB","IBDAMB"
IF $PIECE(I,U,5)'=""
IF $PIECE($GET(^DIC(5,$PIECE(I,U,5),0)),U,6)=1
IF $PIECE(I,U,6)=""
SET IBAMBR=1
+19 QUIT IBAMBR
+20 ;
COBAMT(IBIFN) ; IB*2.0*432 - IF there is a COB amt. it must equal the Total Claim Charge Amount
+1 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+2 ; OUTPUT - 0 = no error
+3 ; 1 = Error
+4 ;
+5 if IBIFN=""
QUIT 0
+6 if $PIECE($GET(^DGCR(399,IBIFN,"U4")),U)=""
QUIT 0
+7 if +$PIECE($GET(^DGCR(399,IBIFN,"U1")),U)'=+$PIECE($GET(^DGCR(399,IBIFN,"U4")),U)
QUIT 1
+8 QUIT 0
+9 ;
COBMRA(IBIFN) ; IB*2.0*432 - If there is a 'COB total non-covered amount' (File#399, Field#260),
+1 ; Primary Insurance must be Medicare that never went to Medicare, and this must be a 2ndary or tertiary claim
+2 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+3 ; OUTPUT - 0 = no error
+4 ; 1 = Error
+5 ;
+6 NEW IBP
+7 if IBIFN=""
QUIT 0
+8 if $PIECE($GET(^DGCR(399,IBIFN,"U4")),U)=""
QUIT 0
+9 SET IBP=$PIECE($GET(^DGCR(399,IBIFN,"M1")),U,5)
if IBP=""
SET IBP=IBIFN
+10 IF $$WNRBILL^IBEFUNC(IBIFN,1)
IF $PIECE($GET(^DGCR(399,IBP,"S")),U,7)=""
IF $$COBN^IBCEF(IBIFN)>1
QUIT 0
+11 QUIT 1
+12 ;
COBSEC(IBIFN) ; IB*2.0*432 - If there is NOT a 'COB total non-covered amount' (File#399, Field#260),
+1 ; and Primary Insurance is Medicare that never went to Medicare, 2ndary or tertiary claim cannot be set to transmit
+2 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+3 ; OUTPUT - 0 = no error
+4 ; 1 = Error
+5 ;
+6 NEW IBP
+7 if IBIFN=""
QUIT 0
+8 if $PIECE($GET(^DGCR(399,IBIFN,"U4")),U)'=""
QUIT 0
+9 if $$COBN^IBCEF(IBIFN)<2
QUIT 0
+10 SET IBP=$PIECE($GET(^DGCR(399,IBIFN,"M1")),U,5)
if IBP=""
SET IBP=IBIFN
+11 IF $$WNRBILL^IBEFUNC(IBIFN,1)
IF $PIECE($GET(^DGCR(399,IBP,"S")),U,7)=""
IF $PIECE($GET(^DGCR(399,IBIFN,"TX")),U,8)'=1
QUIT 1
+12 QUIT 0
+13 ;
TMCK(IBIFN) ; IB*2.0*432 - Attachment Control Number - REQUIRED when Transmission Method = BM, EL, EM, or FT
+1 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+2 ; OUTPUT - 0 = no error
+3 ; 1 = Error
+4 ;
+5 NEW IBAC
+6 if IBIFN=""
QUIT 0
+7 FOR I=1,3
SET IBAC(I)=$PIECE($GET(^DGCR(399,IBIFN,"U8")),U,I)
+8 if IBAC(3)=""
QUIT 0
+9 if IBAC(1)'=""
QUIT 0
+10 if IBAC(3)="AA"
QUIT 0
+11 QUIT 1
+12 ;
ACCK(IBIFN) ; IB*2.0*432 If any of the loop info is present, then Report Type & Transmission Method req'd
+1 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+2 ; OUTPUT - 0 = no error
+3 ; 1 = Error
+4 ;
+5 NEW IBAC
+6 if IBIFN=""
QUIT 0
+7 FOR I=1:1:3
SET IBAC(I)=$PIECE($GET(^DGCR(399,IBIFN,"U8")),U,I)
+8 ; All fields null, no error
+9 IF IBAC(1)=""
IF IBAC(2)=""
IF IBAC(3)=""
QUIT 0
+10 ; Both required fields complete, no error
+11 IF IBAC(2)'=""
IF IBAC(3)'=""
QUIT 0
+12 ; At this point, one of the 2 required fields has data and one does not, so error
+13 QUIT 1
+14 ;
LNTMCK(IBIFN) ; DEM;IB*2.0*432 - (Line Level) Attachment Control Number - REQUIRED when Transmission Method = BM, EL, EM, or FT
+1 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+2 ; OUTPUT - IBLNERR = 0 = no error
+3 ; IBLNERR = 1 = Error
+4 ;
+5 NEW IBAC,IBPROCP,I,IBLNERR
+6 ; DEM;432 - Initialize error flag IBLNERR to '0' for no errors.
SET IBLNERR=0
+7 if IBIFN=""
QUIT IBLNERR
+8 SET IBPROCP=0
FOR
SET IBPROCP=$ORDER(^DGCR(399,IBIFN,"CP",IBPROCP))
if 'IBPROCP
QUIT
Begin DoDot:1
+9 ; DEM;432 - Node '0' is procedure node.
if '($DATA(^DGCR(399,IBIFN,"CP",IBPROCP,0))#10)
QUIT
+10 ; DEM;432 - Node '1' is line level Attachment Control fields.
if '($DATA(^DGCR(399,IBIFN,"CP",IBPROCP,1))#10)
QUIT
+11 FOR I=1,3
SET IBAC(I)=$PIECE(^DGCR(399,IBIFN,"CP",IBPROCP,1),U,I)
+12 IF IBAC(3)=""
SET IBLNERR=0
QUIT
+13 IF IBAC(1)'=""
SET IBLNERR=0
QUIT
+14 IF (IBAC(3)="AA")
SET IBLNERR=0
QUIT
+15 SET IBLNERR=1
+16 QUIT
End DoDot:1
if IBLNERR
QUIT
+17 ;
+18 QUIT IBLNERR
+19 ;
LNACCK(IBIFN) ; DEM;IB*2.0*432 (Line Level) If any of the loop info is present, then Report Type & Transmission Method req'd
+1 ; input - IBIFN = IEN of the Bill/Claims file (#399)
+2 ; OUTPUT - IBLNERR = 0 = no error
+3 ; IBLNERR = 1 = Error
+4 ;
+5 NEW IBAC,IBPROCP,I,IBLNERR
+6 ; DEM;432 - Initialize error flag IBLNERR to '0' for no errors.
SET IBLNERR=0
+7 if IBIFN=""
QUIT IBLNERR
+8 SET IBPROCP=0
FOR
SET IBPROCP=$ORDER(^DGCR(399,IBIFN,"CP",IBPROCP))
if 'IBPROCP
QUIT
Begin DoDot:1
+9 ; DEM;432 - Node '0' is procedure node.
if '($DATA(^DGCR(399,IBIFN,"CP",IBPROCP,0))#10)
QUIT
+10 ; DEM;432 - Node '1' is line level Attachment Control fields.
if '($DATA(^DGCR(399,IBIFN,"CP",IBPROCP,1))#10)
QUIT
+11 FOR I=1:1:3
SET IBAC(I)=$PIECE(^DGCR(399,IBIFN,"CP",IBPROCP,1),U,I)
+12 ; All fields null, no error
+13 IF IBAC(1)=""
IF IBAC(2)=""
IF IBAC(3)=""
SET IBLNERR=0
QUIT
+14 ; Both required fields complete, no error
+15 IF IBAC(2)'=""
IF IBAC(3)'=""
SET IBLNERR=0
QUIT
+16 ; At this point, one of the 2 required fields has data and one does not, so error
+17 SET IBLNERR=1
+18 QUIT
End DoDot:1
if IBLNERR
QUIT
+19 ;
+20 QUIT IBLNERR
+21 ;
+22 ;vd/Beginning of IB*2*577 - Validate Line Level for NDC
LNNDCCK(IBIFN) ;IB*2*577 (Line Level) The Units and Units/Basis of Measurement fields are required if the NDC field is populated.
+1 ; INPUT - IBIFN = IEN of the Bill/Claims file (#399)
+2 ; OUTPUT - IBLNERR = 0 = no error
+3 ; IBLNERR = 1 = Error
+4 ;
+5 NEW IBAC,IBPROCP,I,IBLNERR
+6 ; IB*2*577 - Initialize error flag IBLNERR to '0' for no errors.
SET IBLNERR=0
+7 if IBIFN=""
QUIT IBLNERR
+8 SET IBPROCP=0
FOR
SET IBPROCP=$ORDER(^DGCR(399,IBIFN,"CP",IBPROCP))
if 'IBPROCP
QUIT
Begin DoDot:1
+9 ; IB*2*577 - No NDC Code
if ($$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","NDC","I")="")
QUIT
+10 ; If there is an NDC Code, then the UNITS and UNITS/BASIS OF MEASUREMENT are Required.
+11 IF $$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","UNITS/BASIS OF MEASUREMENT","I")=""
SET IBLNERR=1
QUIT
+12 ;Units (Quantity) is required if there is an NDC Code.
IF $$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","UNITS","I")=""
SET IBLNERR=1
QUIT
+13 QUIT
End DoDot:1
if IBLNERR
QUIT
+14 ;
+15 QUIT IBLNERR
+16 ;vd/End of IB*2*577
