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

IBCBB11.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. WARN(IBDISP) ; Set warning in global
  1. ; DISP = warning text to display
  1. ;
  1. N Z
  1. S Z=+$O(^TMP($J,"BILL-WARN",""),-1)
  1. I Z=0 S ^TMP($J,"BILL-WARN",1)=$J("",5)_"**Warnings**:",Z=1
  1. S Z=Z+1,^TMP($J,"BILL-WARN",Z)=$J("",5)_IBDISP
  1. Q
  1. ;
  1. MULTDIV(IBIFN,IBND0) ; Check for multiple divisions on a bill ien IBIFN
  1. ; IBND0 = 0-node of bill
  1. ;
  1. ; Function returns 1 if more than 1 division found on bill
  1. N Z,Z0,Z1,MULT
  1. S MULT=0,Z1=$P(IBND0,U,22)
  1. I Z1 D
  1. . 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
  1. . 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
  1. I 'Z1 S MULT=3
  1. Q MULT
  1. ;
  1. ;; PREGNANCY DX CODES: V22**-V24**, V27**-V28**, 630**-677**
  1. ;; FLU SHOTS PROCEDURE CODES: 90724, G0008, 90732, G0009
  1. ;
  1. NPICHK ; Check for required NPIs
  1. N IBNPIS,IBNONPI,IBNPIREQ,Z,IBNFI,IBTF,IBWC,IBXSAVE,IBPRV,IBLINE,IBPRVNT1,IBPRVNT2
  1. ;*** pij start IB*20*436 ***
  1. N IBRATYPE,IBLEGAL
  1. S (IBRATYPE,IBLEGAL)=""
  1. S IBRATYPE=$P($G(^DGCR(399,IBIFN,0)),U,7)
  1. ; Legal types for this use.
  1. ; 7=NO FAULT INS.
  1. ; 10=TORT FEASOR
  1. ; 11=WORKERS' COMP.
  1. S IBNFI=$O(^DGCR(399.3,"B","NO FAULT INS.",0)) S:'IBNFI IBNFI=7
  1. S IBTF=$O(^DGCR(399.3,"B","TORT FEASOR",0)) S:'IBTF IBTF=10
  1. S IBWC=$O(^DGCR(399.3,"B","WORKERS' COMP.",0)) S:'IBWC IBWC=11
  1. ;
  1. I IBRATYPE=IBNFI!(IBRATYPE=IBTF)!(IBRATYPE=IBWC) D
  1. . ; One of the legal types - force local print
  1. . S IBLEGAL=1
  1. ;*** pij end ***
  1. S IBNPIREQ=$$NPIREQ^IBCEP81(DT) ; Check if NPI is required
  1. ; Check providers
  1. ; IB*2.0*432 changed the NPI check to the new Provider Array
  1. ;S IBNPIS=$$PROVNPI^IBCEF73A(IBIFN,.IBNONPI)
  1. D ALLIDS^IBCEFP(IBIFN,.IBXSAVE,1)
  1. S IBPRV=""
  1. F S IBPRV=$O(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV)) Q:'IBPRV D
  1. . I $P($G(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV,0)),U,4)="" S IBNONPI(IBPRV)=""
  1. S IBLINE=""
  1. F S IBLINE=$O(IBXSAVE("L-PROV",IBIFN,IBLINE)) Q:'IBLINE D
  1. . S IBPRV=""
  1. . F S IBPRV=$O(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV)) Q:IBPRV="" D
  1. .. I $P($G(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV,0)),U,4)="" S IBNONPI(IBPRV)=""
  1. I $D(IBNONPI) S IBPRV="" F S IBPRV=$O(IBNONPI(IBPRV)) Q:'IBPRV D
  1. . ;JWS;IB*2.0*592;Assistant Surgeon for dental
  1. . I IBPRV=6 S IBER=IBER_"IB358;" Q
  1. . S IBER=IBER_"IB"_(140+IBPRV)_";" Q ; If required, set error IB*2*516
  1. ; Check organizations
  1. S IBNONPI=""
  1. S IBNPIS=$$ORGNPI^IBCEF73A(IBIFN,.IBNONPI)
  1. I $L(IBNONPI) F Z=1:1:$L(IBNONPI,U) D
  1. . S IBER=IBER_$P("IB339;^IB340;^IB341;",U,$P(IBNONPI,U,Z)) ; DEM;432 Added NPI errors.
  1. Q
  1. ;
  1. TAXCHK ; Check for required taxonomies
  1. N IBDT,IBLINE,IBNOTAX,IBNOTAX1,IBNOTAX2,IBPRV,IBTAXS,IBXSAVE,Z
  1. ;
  1. ; MRD;IB*2.0*516 - This check is now moot; 'today' is always on or
  1. ; after May 23, 2008, so taxonomy codes are always required
  1. ; for certain providers.
  1. ;S IBTAXREQ=$$TAXREQ^IBCEP81(DT) ; Check if taxonomy is required
  1. ;
  1. ; Check providers
  1. ; IB*2.0*432 changed the Taxonomy check to the new Provider Array
  1. ;S IBTAXS=$$PROVTAX^IBCEF73A(IBIFN,.IBNOTAX)
  1. D ALLIDS^IBCEFP(IBIFN,.IBXSAVE,1)
  1. ;JWS;IB*2.0*592; prevent having both RENDERING and ASSISTANT SURGEON providers at the claim level
  1. ; ;performing check here after providers are 'merged' into the claim level, if only at line level
  1. ; ;done in ALLIDS^IBCEFP
  1. I $$FT^IBCEF(IBIFN)=7 D
  1. . I $D(IBXSAVE("PROVINF",IBIFN,"C",1,3)),$D(IBXSAVE("PROVINF",IBIFN,"C",1,6)) D
  1. .. I '$F(IBER,"IB363;") S IBER=IBER_"IB363;"
  1. .. Q
  1. . ;JWS;IB*2.0*592 - US1108 start
  1. . I '$D(IBXSAVE("PROVINF",IBIFN,"C",1,3)),'$D(IBXSAVE("PROVINF",IBIFN,"C",1,6)) D
  1. .. N IBX,OK S OK=0,IBX=""
  1. .. F S IBX=$O(IBXSAVE("L-PROV",IBX)) Q:IBX="" D Q:OK
  1. ... I $D(IBXSAVE("L-PROV",IBX,"C",1,3)) S OK=1 Q
  1. ... I $D(IBXSAVE("L-PROV",IBX,"C",1,6)) S OK=1 Q
  1. .. I 'OK S IBER=IBER_"IB357;"
  1. .. Q
  1. . Q
  1. ;JWS;IB*2.0*592 - US1108 end
  1. S IBPRV=""
  1. F S IBPRV=$O(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV)) Q:'IBPRV D
  1. . I $G(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV,"TAXONOMY"))="" D
  1. .. S IBNOTAX(IBPRV)=""
  1. .. S IBNOTAX1=$P(IBXSAVE("PROVINF",IBIFN,"C",1,IBPRV),";",1) ; New variables IBNOTAX1 and IBNOTAX2 for IB*2.0*568 - Deactivated Provider
  1. .. S IBNOTAX2(IBPRV,IBNOTAX1)=""
  1. .. Q
  1. . Q
  1. ;
  1. S IBLINE=""
  1. F S IBLINE=$O(IBXSAVE("L-PROV",IBIFN,IBLINE)) Q:'IBLINE D
  1. . S IBPRV=""
  1. . F S IBPRV=$O(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV)) Q:IBPRV="" D
  1. .. I $G(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV,"TAXONOMY"))="" D
  1. ... S IBNOTAX(IBPRV)=""
  1. ... S IBNOTAX1=$P(IBXSAVE("L-PROV",IBIFN,IBLINE,"C",1,IBPRV),";",1) ; New variables IBNOTAX1 and IBNOTAX2 for IB*2.0*568 - Deactivated Provider
  1. ... S IBNOTAX2(IBPRV,IBNOTAX1)=""
  1. ... Q
  1. .. Q
  1. . Q
  1. ;
  1. ; IB251 = Referring provider taxonomy missing.
  1. ; IB253 = Rendering provider taxonomy missing.
  1. ; IB254 = Attending provider taxonomy missing.
  1. ; IB256 = Assistant Surgeon taxonomy missing. ;JWS;IB*2.0*592
  1. ;JWS;IB*2.0*592;dental start
  1. I $D(IBNOTAX) S IBPRV="" F S IBPRV=$O(IBNOTAX(IBPRV)) Q:'IBPRV D
  1. . ; Only Referring, Rendering and Attending are currently sent to the payer
  1. . ;I IBTAXREQ,"134"[IBPRV S IBER=IBER_"IB"_(250+IBPRV)_";" Q ; MRD;IB*2.0*516 - Always required.
  1. . I "134"[IBPRV D Q
  1. .. S IBER=IBER_"IB"_(250+IBPRV)_";" ; If required, set error
  1. .. S IBPRVNT1=$O(IBNOTAX2(IBPRV,"")) ; New check for Deactivated Provider IB*2.0*568 next three lines
  1. .. S IBPRVNT2=$$SPEC^IBCEU(IBPRVNT1,IBEVDT)
  1. .. 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
  1. . D WARN("Taxonomy for the "_$P("referring^operating^rendering^attending^supervising^^^^other",U,IBPRV)_" provider has no value") ; Else, set warning
  1. . Q
  1. ;JWS;IB*2.0*592;end
  1. ;
  1. ; Check organizations. The function ORGTAX will set IBNOTAX to be a
  1. ; list of entities missing taxonomy codes, if any (n, n^m, n^m^p,
  1. ; where each 1 is service facility, 2 is non-VA service facility and
  1. ; 3 is billing provider.
  1. ;
  1. S IBNOTAX=""
  1. S IBTAXS=$$ORGTAX^IBCEF73A(IBIFN,.IBNOTAX)
  1. I $L(IBNOTAX) F Z=1:1:$L(IBNOTAX,U) D
  1. . ; IB167 = Billing Provider taxonomy missing.
  1. . ;I IBTAXREQ,$P(IBNOTAX,U,Z)=3 S IBER=IBER_"IB167;" Q ; MRD;IB*2.0*516 - Always required.
  1. . I $P(IBNOTAX,U,Z)=3 S IBER=IBER_"IB167;" Q
  1. . ; MRD;IB*2.0*516 - Remove warning message for missing taxonomy code for lab or facility.
  1. . ; 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
  1. . Q
  1. ;
  1. Q
  1. ;
  1. VALNDC(IBIFN,IBDFN) ; Moving pharmacy checks to reduce likelihood of patch collision
  1. D VALNDC^IBCBB14(IBIFN,IBDFN)
  1. Q
  1. ;
  1. PRIIDCHK ; Check for required Pimarary ID (SSN/EIN)
  1. ; If the provider is on the claim, he must have one
  1. ;
  1. N IBI,IBZ
  1. I $$TXMT^IBCEF4(IBIFN) D
  1. . D F^IBCEF("N-ALL ATT/REND PROV SSN/EI","IBZ",,IBIFN)
  1. . S IBI="" F S IBI=$O(^DGCR(399,IBIFN,"PRV","B",IBI)) Q:IBI="" D
  1. .. 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:"")
  1. Q
  1. ;
  1. RXNPI(IBIFN) ; Moving pharmacy checks to reduce likelihood of patch collision
  1. D RXNPI^IBCBB14(IBIFN)
  1. Q
  1. ;
  1. ROICHK(IBIFN,IBDFN,IBINS) ; Moving pharmacy checks to reduce likelihood of patch collision
  1. Q $$ROICHK^IBCBB14(IBIFN,IBDFN,IBINS)
  1. ;
  1. 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:
  1. ; Address 1, State and ZIP unless the State is not a US state or possession, then zip code is not needed (CMS1500 only)
  1. ; input - IBIFN = IEN of the Bill/Claims file (#399)
  1. ; OUTPUT - 0 = no error
  1. ; 1 = Error
  1. ;
  1. N IBPAMB,IBDAMB,IBAMBR,IBCK
  1. S IBAMBR=0
  1. Q:$$INSPRF^IBCEF(IBIFN)'=0 IBAMBR
  1. S IBPAMB=$G(^DGCR(399,IBIFN,"U5")),IBDAMB=$G(^DGCR(399,IBIFN,"U6"))
  1. S IBCK(5)=$$NOPUNCT^IBCEF($P(IBPAMB,U,2,6),1),IBCK(6)=$$NOPUNCT^IBCEF($P(IBDAMB,U,1,6),1)
  1. I IBCK(5)="",IBCK(6)="" Q IBAMBR
  1. ; at this point we know that at least one ambulance field has data, so check to see if all have data
  1. I IBCK(5)'="" F I=2,4,5 I $P(IBPAMB,U,I)="" S IBAMBR=1
  1. I IBCK(6)'="" F I=1,2,4,5 I $P(IBDAMB,U,I)="" S IBAMBR=1
  1. Q:IBAMBR=1 IBAMBR
  1. ; now check zip code. OK to be null if state is not a US Posession
  1. 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
  1. Q IBAMBR
  1. ;
  1. 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)
  1. ; OUTPUT - 0 = no error
  1. ; 1 = Error
  1. ;
  1. Q:IBIFN="" 0
  1. Q:$P($G(^DGCR(399,IBIFN,"U4")),U)="" 0
  1. Q:+$P($G(^DGCR(399,IBIFN,"U1")),U)'=+$P($G(^DGCR(399,IBIFN,"U4")),U) 1
  1. Q 0
  1. ;
  1. 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
  1. ; input - IBIFN = IEN of the Bill/Claims file (#399)
  1. ; OUTPUT - 0 = no error
  1. ; 1 = Error
  1. ;
  1. N IBP
  1. Q:IBIFN="" 0
  1. Q:$P($G(^DGCR(399,IBIFN,"U4")),U)="" 0
  1. S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) S:IBP="" IBP=IBIFN
  1. I $$WNRBILL^IBEFUNC(IBIFN,1),$P($G(^DGCR(399,IBP,"S")),U,7)="",$$COBN^IBCEF(IBIFN)>1 Q 0
  1. Q 1
  1. ;
  1. 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
  1. ; input - IBIFN = IEN of the Bill/Claims file (#399)
  1. ; OUTPUT - 0 = no error
  1. ; 1 = Error
  1. ;
  1. N IBP
  1. Q:IBIFN="" 0
  1. Q:$P($G(^DGCR(399,IBIFN,"U4")),U)'="" 0
  1. Q:$$COBN^IBCEF(IBIFN)<2 0
  1. S IBP=$P($G(^DGCR(399,IBIFN,"M1")),U,5) S:IBP="" IBP=IBIFN
  1. I $$WNRBILL^IBEFUNC(IBIFN,1),$P($G(^DGCR(399,IBP,"S")),U,7)="",$P($G(^DGCR(399,IBIFN,"TX")),U,8)'=1 Q 1
  1. Q 0
  1. ;
  1. 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)
  1. ; OUTPUT - 0 = no error
  1. ; 1 = Error
  1. ;
  1. N IBAC
  1. Q:IBIFN="" 0
  1. F I=1,3 S IBAC(I)=$P($G(^DGCR(399,IBIFN,"U8")),U,I)
  1. Q:IBAC(3)="" 0
  1. Q:IBAC(1)'="" 0
  1. Q:IBAC(3)="AA" 0
  1. Q 1
  1. ;
  1. 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)
  1. ; OUTPUT - 0 = no error
  1. ; 1 = Error
  1. ;
  1. N IBAC
  1. Q:IBIFN="" 0
  1. F I=1:1:3 S IBAC(I)=$P($G(^DGCR(399,IBIFN,"U8")),U,I)
  1. ; All fields null, no error
  1. I IBAC(1)="",IBAC(2)="",IBAC(3)="" Q 0
  1. ; Both required fields complete, no error
  1. I IBAC(2)'="",IBAC(3)'="" Q 0
  1. ; At this point, one of the 2 required fields has data and one does not, so error
  1. Q 1
  1. ;
  1. 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)
  1. ; OUTPUT - IBLNERR = 0 = no error
  1. ; IBLNERR = 1 = Error
  1. ;
  1. N IBAC,IBPROCP,I,IBLNERR
  1. S IBLNERR=0 ; DEM;432 - Initialize error flag IBLNERR to '0' for no errors.
  1. Q:IBIFN="" IBLNERR
  1. S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBLNERR
  1. . Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,0))#10) ; DEM;432 - Node '0' is procedure node.
  1. . Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,1))#10) ; DEM;432 - Node '1' is line level Attachment Control fields.
  1. . F I=1,3 S IBAC(I)=$P(^DGCR(399,IBIFN,"CP",IBPROCP,1),U,I)
  1. . I IBAC(3)="" S IBLNERR=0 Q
  1. . I IBAC(1)'="" S IBLNERR=0 Q
  1. . I (IBAC(3)="AA") S IBLNERR=0 Q
  1. . S IBLNERR=1
  1. . Q
  1. ;
  1. Q IBLNERR
  1. ;
  1. 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)
  1. ; OUTPUT - IBLNERR = 0 = no error
  1. ; IBLNERR = 1 = Error
  1. ;
  1. N IBAC,IBPROCP,I,IBLNERR
  1. S IBLNERR=0 ; DEM;432 - Initialize error flag IBLNERR to '0' for no errors.
  1. Q:IBIFN="" IBLNERR
  1. S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBLNERR
  1. . Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,0))#10) ; DEM;432 - Node '0' is procedure node.
  1. . Q:'($D(^DGCR(399,IBIFN,"CP",IBPROCP,1))#10) ; DEM;432 - Node '1' is line level Attachment Control fields.
  1. . F I=1:1:3 S IBAC(I)=$P(^DGCR(399,IBIFN,"CP",IBPROCP,1),U,I)
  1. . ; All fields null, no error
  1. . I IBAC(1)="",IBAC(2)="",IBAC(3)="" S IBLNERR=0 Q
  1. . ; Both required fields complete, no error
  1. . I IBAC(2)'="",IBAC(3)'="" S IBLNERR=0 Q
  1. . ; At this point, one of the 2 required fields has data and one does not, so error
  1. . S IBLNERR=1
  1. . Q
  1. ;
  1. Q IBLNERR
  1. ;
  1. ;vd/Beginning of IB*2*577 - Validate Line Level for NDC
  1. 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)
  1. ; OUTPUT - IBLNERR = 0 = no error
  1. ; IBLNERR = 1 = Error
  1. ;
  1. N IBAC,IBPROCP,I,IBLNERR
  1. S IBLNERR=0 ; IB*2*577 - Initialize error flag IBLNERR to '0' for no errors.
  1. Q:IBIFN="" IBLNERR
  1. S IBPROCP=0 F S IBPROCP=$O(^DGCR(399,IBIFN,"CP",IBPROCP)) Q:'IBPROCP D Q:IBLNERR
  1. . Q:($$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","NDC","I")="") ; IB*2*577 - No NDC Code
  1. . ; If there is an NDC Code, then the UNITS and UNITS/BASIS OF MEASUREMENT are Required.
  1. . I $$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","UNITS/BASIS OF MEASUREMENT","I")="" S IBLNERR=1 Q
  1. . I $$GET1^DIQ(399.0304,IBPROCP_","_IBIFN_",","UNITS","I")="" S IBLNERR=1 Q ;Units (Quantity) is required if there is an NDC Code.
  1. . Q
  1. ;
  1. Q IBLNERR
  1. ;vd/End of IB*2*577