Routine: IBCBB2

IBCBB2 ;ALB/ARH - CONTINUATION OF EDIT CHECKS ROUTINE (CMS-1500) ;04/14/92

 ;;2.0;INTEGRATED BILLING;**51,137,210,245,232,296,320,349,371,403,432,447,473,488,461,623,641,665,702**;21-MAR-94;Build 53

 ;;Per VA Directive 6402, this routine should not be modified.

 ;MAP TO DGCRBB2

EN ;

 N IBI,IBJ,IBN,IBY,IBDX,IBDXO,IBDXL,IBDXTYP,IBDXVER,IBCPT,IBCPTL,IBOLAB,Z,IBXSAVE,IBLOC,IBTX,IBPS,IBSP,IBLCT,IBNVFLG,IBU3

 I '$D(IBER) S IBER=""

 S IBTX=$$TXMT^IBCEF4(IBIFN)

 ; Max 4 modifiers per CPT code allowed before warning

 K IBXDATA

 D F^IBCEF("N-HCFA 1500 MODIFIERS",,,IBIFN) ;Get modifiers

 S Z=0 F  S Z=$O(IBZPRC92(Z)) Q:'Z  I $P(IBZPRC92(Z),U)["ICPT(",$L($P(IBZPRC92(Z),U,15),",")>4 S IBI="Proc "_$$PRCD^IBCEF1($P(IBZPRC92(Z),U))_" has > 4 modifiers - only first 4 will be used" D WARN^IBCBB11(IBI)

 ; ICD diagnosis, at least 1 required

 D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBER=IBER_"IB071;"

 ; Principle diagnosis - updated for ICD-10 **461

 S IBI=$O(IBDXO(0)) I IBI S IBDXTYP=$$ICD9^IBACSV(+$P(IBDXO(IBI),U),$$BDATE^IBACSV(IBIFN)) D

 . S IBDXVER=$P(IBDXTYP,U,19),IBDXTYP=$E(IBDXTYP)

 . I IBDXVER=1,IBDXTYP="E" S IBER=IBER_"IB117;"

 . I IBDXVER=1,$$INPAT^IBCEF(IBIFN,1),IBDXTYP="V" S Z="Principal Dx V-code may not be valid" D WARN^IBCBB11(Z)

 . I IBDXVER=30,"VWXY"[IBDXTYP S IBER=IBER_"IB355;"

 . I IBDXVER=30,$$INPAT^IBCEF(IBIFN,1),IBDXTYP="Z" S Z="Principal Dx Z-code may not be valid" D WARN^IBCBB11(Z)

 I '$$OCC10(IBIFN,.IBDX,2) S IBER=IBER_"IB093;"

 ; CPT procs must be associated with a dx, must have a defined provider

 S (IBLOC,IBN,IBI,IBY)=0 F  S IBI=$O(^DGCR(399,IBIFN,"CP",IBI)) Q:IBI'?1N.N  S IBCPT=^(IBI,0) D  I +IBY S IBN=1

 . I 'IBLOC,$P(IBCPT,U,15)'="",IBTX S Z="At least 1 charge has local box 24K data that will not be transmitted - " S IBLOC=1 D WARN^IBCBB11(Z) S Z="  This data will only print locally" D WARN^IBCBB11(Z)

 . I $P(IBCPT,U)'["ICPT(" S:IBER'["IB092" IBER=IBER_"IB092;" Q

 . S IBY=1 F IBJ=11:1:14 I +$P(IBCPT,"^",IBJ) S IBCPTL(+$P(IBCPT,"^",IBJ))="",IBY=0

 I +IBN S IBER=IBER_"IB072;"

 ; CMS-1500: dxs associated with procs must be defined dxs for the bill

 S IBI=0 F  S IBI=$O(IBDX(IBI))  Q:'IBI  S IBDXL(IBDX(IBI))=""

 S (IBN,IBI)=0 F  S IBI=$O(IBCPTL(IBI)) Q:'IBI  I '$D(IBDXL(IBI)) S IBN=1 Q

 I +IBN S IBER=IBER_"IB073;"

 ; ejk *296* Change # of diagnoses codes from 4 to 8 on CMS-1500 Claims.

 ; baa *488* Change # of diagnoses codes from 8 to 12.

 ; vd *623-US4055* Modified the logic for dental claims to check for # of diagnosis codes greater than 4.

 ;IB*2.0*702;JWS;remove 665 fatal error for Professional claims with >12 Diagnosis Codes, make it a warning

 ;WCJ;IB*2.0*665v4;more than 12 diag on CMS-1500 is an error PERIOD

 ;I IBTX,$$FT^IBCEF(IBIFN)'=7 S IBI=12 F  S IBI=$O(IBDXO(IBI)) Q:'IBI  S Z=+$G(IBDX(+$G(IBDXO(IBI)))) I Z,$D(IBCPTL(Z)) D WARN^IBCBB11("Too many diagnoses for claim & will be rejected - consider printing locally")

 ;I IBTX,$$FT^IBCEF(IBIFN)'=7,$O(IBDXO(12)) S IBER=IBER_"IB397;"

 I IBTX,$$FT^IBCEF(IBIFN)'=7,$O(IBDXO(12)) D WARN^IBCBB11("A HIPAA Compliant EDI Professional claim cannot contain more than 12"),WARN^IBCBB11("diagnosis codes.")

 ;IB*2.0*702;JWS;remove 665 fatal error for Dental claims with >4 Diagnosis Codes, make it a warning

 ;WCJ;IB*2.0*665v4;more than 4 diag on Dental (J-something something) is an error PERIOD

 ;I $$FT^IBCEF(IBIFN)=7,$P($G(IBDXO),U,2)>4 D WARN^IBCBB11("Only 4 diagnosis codes are allowed on a dental transaction")

 ;I $$FT^IBCEF(IBIFN)=7,$O(IBDXO(4)) S IBER=IBER_"IB398;"

 I $$FT^IBCEF(IBIFN)=7,$O(IBDXO(4)) D WARN^IBCBB11("A HIPAA Compliant EDI Dental claim cannot contain more than 4"),WARN^IBCBB11("diagnosis codes.")

 I $$WNRBILL^IBEFUNC(IBIFN),$$MRATYPE^IBEFUNC(IBIFN)'="B" S IBER=IBER_"IB087;"

 ; IB*320 - CLIA# error/warning - error msg for MRA claims, else warning

 I $P(IBNDU2,U,13)="",$$CLIAREQ^IBCEP8A(IBIFN) D

 . I $$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB235;" Q

 . D WARN^IBCBB11("Claim contains laboratory services. The payer may require a CLIA #.")

. Q

 ; Only one occurrence code can be present for event date for box 14

 S Z=$$EVENT^IBCF22(IBIFN,.IBXSAVE,.IBI)

 I IBI S IBER=IBER_"IB099;"

 ; esg - 6/6/07 - warning if missing non-VA care type for outside facility

 S IBNVFLG=0

 I $P(IBNDU2,U,10),'$P(IBNDU2,U,11) D WARN^IBCBB11("Non-VA facility indicated, but the Non-VA Care Type field is not defined") S IBNVFLG=1

 ; unit/charge limits

 K IBXDATA

 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN) ;Get charge lines

 S (IBLCT,IBOLAB)=0,IBPS="",IBSP=$$BILLSPEC^IBCEU3(IBIFN)

 S IBI=0 F  S IBI=$O(IBXDATA(IBI)) Q:'IBI  D  Q:IBER["IB310"!(IBER["IB311")

 . S IBLCT=IBLCT+1

 . I $P(IBNDU2,U,11) D

 .. I '$P(IBXDATA(IBI),U,11) S IBPS=IBPS_$S(IBPS'="":",",1:"")_IBI Q

 .. I $P(IBXDATA(IBI),U,14),"24"'[$P(IBNDU2,U,11) D WARN^IBCBB11("Outside lab charges exist on a non-lab NON-VA bill")

 . ; Start IB*2.0*473 Changed the following two warnings to errors.

 . ;I '$P(IBNDU2,U,11),$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Purchased service amounts are invalid unless this is a NON-VA bill")

 . ;I IBNVFLG,'$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Non-VA facility indicated, but no purchased service charge on line# "_IBI)

 . I $G(IBER)'["IB350" I '$P(IBNDU2,U,11),$P(IBXDATA(IBI),U,11) S IBER=IBER_"IB350;"

 . I $G(IBER)'["IB351" I IBNVFLG,'$P(IBXDATA(IBI),U,11) S IBER=IBER_"IB351;"

 . ; End IB*2.0*473

 . I $G(IBER)'["IB310" I $D(IBXDATA(IBI,"A")) S IBER=IBER_"IB310;" Q

 . I $D(IBXDATA(IBI,"ARX")),IBER'["311;" S IBER=IBER_"IB311;" Q

 . I $P(IBXDATA(IBI),U,14) S IBOLAB=IBOLAB+1

 . ;JWS;IB*2.0*641v9; put back the edit for Place of Service

 . ; Place of service required => remove edit below for IB*2.0*488 ; baa

 . I $G(IBER)'["IB314;",$P(IBXDATA(IBI),U,3)="" S IBER=IBER_"IB314;"

 . ; Type of service required => remove edit below for IB*2.0*488 ; baa

 . ;I $G(IBER)'["IB313;",$P(IBXDATA(IBI),U,4)="" S IBER=IBER_"IB313;"

 . ; 43 and 53 are invalid types of service

 . I $G(IBER)'["IB110;",($P(IBXDATA(IBI),U,4)=43!($P(IBXDATA(IBI),U,4)=53)) S IBER=IBER_"IB110;"

 . ; Units for the line item must be less than 100/1000 => Remove edit baa *488

 . ;I IBER'["IB088",$P(IBXDATA(IBI),U,9)'<100 D

 . ;. I $P(IBXDATA(IBI),U,4)'=7 S IBER=IBER_"IB088;" Q

 . ;. I $P(IBXDATA(IBI),U,9)'<1000 S IBER=IBER_"IB088;"

 . ; Line item total charge must be less than $10,000.00, greater than 0

 . ; IB*2.0*432 - The IB system shall provide the ability for users to enter maximum line item dollar amounts of 9999999.99.

 . ; I IBER'["IB090",$P(IBXDATA(IBI),U,9)'<10000 S IBER=IBER_"IB090;"

 . I IBER'["IB090",$P(IBXDATA(IBI),U,9)'<10000000 S IBER=IBER_"IB090;"

 . ; IB*2.0*447 BI Removed individual warning replaced by a claim level warning.

 . ; I '($P(IBXDATA(IBI),U,9)*$P(IBXDATA(IBI),U,8)),$$COBN^IBCEF(IBIFN)'>1 S Z="Procedure "_$P(IBXDATA(IBI),U,5)_" has a 0-charge and will not be transmitted" D WARN^IBCBB11(Z)

 I IBTX,IBLCT>50 D

 . I $G(IBER)'["IB308" I '$$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB308;" Q

 . I $G(IBER)'["IB325" I '$P(IBNDTX,U,9) S IBER=IBER_"IB325;"

 S IBU3=$P($G(^DGCR(399,IBIFN,"U3")),U,4,7) I $TR(IBU3,U)'="" D

 .; ib*2.0*432 add line-level check

 .;I +IBSP'=35 D WARN^IBCBB11("Chiropractic service details only valid if provider specialty is '35'")

 .I $$LINSPEC^IBCEU3(IBIFN)'[35 D WARN^IBCBB11("Chiropractic service details only valid if provider specialty is '35'")

 .I $G(IBER)'["IB137" I $P(IBU3,U,2)="" S IBER=IBER_"IB137;"

 .I $G(IBER)'["IB338" I $P(IBU3,U,4)="" S IBER=IBER_"IB138;" Q

 .I $G(IBER)'["IB139" I $P(IBU3,U,3)="","AM"[$P(IBU3,U,4) S IBER=IBER_"IB139;"

.Q

 ; IB*2.0*473 BI Changed the following warning to an error.

 ;I IBPS'="" D WARN^IBCBB11("NON-VA facility indicated, but no purchased service charge on line item"_$S(IBPS[",":"s",1:"")_" #"_IBPS)

 I $G(IBER)'["IB351" I IBPS'="" S IBER=IBER_"IB351;"

 I $P(IBNDU2,U,11),$P(IBNDU2,U,11)=4,IBOLAB>1 D WARN^IBCBB11("For proper payment, you must bill each outside lab on a separate claim form")

 K IBXDATA

 ;       ; Check for Physician Name

 D F^IBCEF("N-REFERRING PROVIDER NAME",,,IBIFN)

 I $P($G(IBXDATA),U)]"" D

 .N IBZ,FUNCTION,IBINS

 .S FUNCTION=1

 .F IBINS=1:1:3 D

 .. S Z=$$GETTYP^IBCEP2A(IBIFN,IBINS,FUNCTION)

 .. 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:"IB239;",IBINS=2:"IB240;",IBINS=3:"IB241;",1:"")

OCC10(IBIFN,IBARR,IBFT) ; Determine if occurrence code 10 exists for pregnancy dx

 ; IBARR=array subscripted by ien of DX code if IBFT=2 (CMS-1500 form)

 ;                         by seq # and = ien of DX code if IBFT'=2

 N IBN,IBI,IBXDATA,IBXSAVE,IBDX,Z

 S IBN=1

 ; If a pregnancy DX exists, must be an occurrence code 10 for LMP date

 ; ICD-9  dx ranges are: V22*-V24*, V27*-V28*, 630*-677*

 ; ICD-10 dx ranges are: O00.*-O9A.*, Z34.*-Z36.*, Z37.*-Z39.*, Z3A.*

 I '$D(^TMP($J,"LMD")) D

 . D F^IBCEF("N-OCCURRENCE CODES",,,IBIFN)

 . S ^TMP($J,"LMD")=""

 . S Z=0 F  S Z=$O(IBXSAVE("OCC",Z)) Q:'Z  I +IBXSAVE("OCC",Z)=10 S ^TMP($J,"LMD")=1 Q

 I '^TMP($J,"LMD") S IBI=0 F  S IBI=$O(IBARR(IBI))  Q:'IBI  D  Q:'IBN

 . N Z,Z1,ZC

 . S IBDX=$S($G(IBFT)'=2:+IBARR(IBI),1:IBI)

 . S ZC=$$ICD9^IBACSV(IBDX,$$BDATE^IBACSV(IBIFN)),Z=$E(ZC,1,3),Z1=$E(Z,2,3) ; Pregnancy Dx exists

 . I $P(ZC,U,19)=1,$S(Z'<630&(Z<678):1,$E(Z)="V":$S(Z1'<22&(Z1<25):1,1:Z1'<27&(Z1<28)),1:0) S IBN=0 ; ICD-9 Dx

 . I $P(ZC,U,19)=30,$S(Z?1"O"2N:1,Z="O9A":1,$E(Z)="Z"&(Z1'<34)&(Z1<40):1,Z="Z3A":1,1:0) S IBN=0 ; ICD-10 Dx

OCC10Q K ^TMP($J,"LMD")

 Q IBN

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB2   9858     printed  Feb 18, 2025@23:35:15                                                                                                                                                                                                      Page 2

IBCBB2    ;ALB/ARH - CONTINUATION OF EDIT CHECKS ROUTINE (CMS-1500) ;04/14/92

 +1       ;;2.0;INTEGRATED BILLING;**51,137,210,245,232,296,320,349,371,403,432,447,473,488,461,623,641,665,702**;21-MAR-94;Build 53

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;MAP TO DGCRBB2

 +5       ;

EN        ;

 +1        NEW IBI,IBJ,IBN,IBY,IBDX,IBDXO,IBDXL,IBDXTYP,IBDXVER,IBCPT,IBCPTL,IBOLAB,Z,IBXSAVE,IBLOC,IBTX,IBPS,IBSP,IBLCT,IBNVFLG,IBU3

 +2        IF '$DATA(IBER)

               SET IBER=""

 +3        SET IBTX=$$TXMT^IBCEF4(IBIFN)

 +4       ;

 +5       ; Max 4 modifiers per CPT code allowed before warning

 +6        KILL IBXDATA

 +7       ;Get modifiers

           DO F^IBCEF("N-HCFA 1500 MODIFIERS",,,IBIFN)

 +8       ;

 +9        SET Z=0

FOR

               SET Z=$ORDER(IBZPRC92(Z))

               if 'Z

                   QUIT

               IF $PIECE(IBZPRC92(Z),U)["ICPT("

                   IF $LENGTH($PIECE(IBZPRC92(Z),U,15),",")>4

                       SET IBI="Proc "_$$PRCD^IBCEF1($PIECE(IBZPRC92(Z),U))_" has > 4 modifiers - only first 4 will be used"

                       DO WARN^IBCBB11(IBI)

 +10      ;

 +11      ; ICD diagnosis, at least 1 required

 +12       DO SET^IBCSC4D(IBIFN,.IBDX,.IBDXO)

           IF '$PIECE(IBDX,U,2)

               SET IBER=IBER_"IB071;"

 +13      ;

 +14      ; Principle diagnosis - updated for ICD-10 **461

 +15       SET IBI=$ORDER(IBDXO(0))

           IF IBI

               SET IBDXTYP=$$ICD9^IBACSV(+$PIECE(IBDXO(IBI),U),$$BDATE^IBACSV(IBIFN))

               Begin DoDot:1

 +16               SET IBDXVER=$PIECE(IBDXTYP,U,19)

                   SET IBDXTYP=$EXTRACT(IBDXTYP)

 +17               IF IBDXVER=1

                       IF IBDXTYP="E"

                           SET IBER=IBER_"IB117;"

 +18               IF IBDXVER=1

                       IF $$INPAT^IBCEF(IBIFN,1)

                           IF IBDXTYP="V"

                               SET Z="Principal Dx V-code may not be valid"

                               DO WARN^IBCBB11(Z)

 +19               IF IBDXVER=30

                       IF "VWXY"[IBDXTYP

                           SET IBER=IBER_"IB355;"

 +20               IF IBDXVER=30

                       IF $$INPAT^IBCEF(IBIFN,1)

                           IF IBDXTYP="Z"

                               SET Z="Principal Dx Z-code may not be valid"

                               DO WARN^IBCBB11(Z)

               End DoDot:1

 +21      ;

 +22       IF '$$OCC10(IBIFN,.IBDX,2)

               SET IBER=IBER_"IB093;"

 +23      ;

 +24      ; CPT procs must be associated with a dx, must have a defined provider

 +25       SET (IBLOC,IBN,IBI,IBY)=0

FOR

               SET IBI=$ORDER(^DGCR(399,IBIFN,"CP",IBI))

               if IBI'?1N.N

                   QUIT

               SET IBCPT=^(IBI,0)

               Begin DoDot:1

 +26               IF 'IBLOC

                       IF $PIECE(IBCPT,U,15)'=""

                           IF IBTX

                               SET Z="At least 1 charge has local box 24K data that will not be transmitted - "

                               SET IBLOC=1

                               DO WARN^IBCBB11(Z)

                               SET Z="  This data will only print locally"

                               DO WARN^IBCBB11(Z)

 +27               IF $PIECE(IBCPT,U)'["ICPT("

                       if IBER'["IB092"

                           SET IBER=IBER_"IB092;"

                       QUIT

 +28               SET IBY=1

                   FOR IBJ=11:1:14

                       IF +$PIECE(IBCPT,"^",IBJ)

                           SET IBCPTL(+$PIECE(IBCPT,"^",IBJ))=""

                           SET IBY=0

               End DoDot:1

               IF +IBY

                   SET IBN=1

 +29       IF +IBN

               SET IBER=IBER_"IB072;"

 +30      ;

 +31      ; CMS-1500: dxs associated with procs must be defined dxs for the bill

 +32       SET IBI=0

FOR

               SET IBI=$ORDER(IBDX(IBI))

               if 'IBI

                   QUIT

               SET IBDXL(IBDX(IBI))=""

 +33       SET (IBN,IBI)=0

FOR

               SET IBI=$ORDER(IBCPTL(IBI))

               if 'IBI

                   QUIT

               IF '$DATA(IBDXL(IBI))

                   SET IBN=1

                   QUIT

 +34       IF +IBN

               SET IBER=IBER_"IB073;"

 +35      ; ejk *296* Change # of diagnoses codes from 4 to 8 on CMS-1500 Claims.

 +36      ; baa *488* Change # of diagnoses codes from 8 to 12.

 +37      ; vd *623-US4055* Modified the logic for dental claims to check for # of diagnosis codes greater than 4.

 +38      ;

 +39      ;IB*2.0*702;JWS;remove 665 fatal error for Professional claims with >12 Diagnosis Codes, make it a warning

 +40      ;WCJ;IB*2.0*665v4;more than 12 diag on CMS-1500 is an error PERIOD

 +41      ;I IBTX,$$FT^IBCEF(IBIFN)'=7 S IBI=12 F  S IBI=$O(IBDXO(IBI)) Q:'IBI  S Z=+$G(IBDX(+$G(IBDXO(IBI)))) I Z,$D(IBCPTL(Z)) D WARN^IBCBB11("Too many diagnoses for claim & will be rejected - consider printing locally")

 +42      ;I IBTX,$$FT^IBCEF(IBIFN)'=7,$O(IBDXO(12)) S IBER=IBER_"IB397;"

 +43       IF IBTX

               IF $$FT^IBCEF(IBIFN)'=7

                   IF $ORDER(IBDXO(12))

                       DO WARN^IBCBB11("A HIPAA Compliant EDI Professional claim cannot contain more than 12")

                       DO WARN^IBCBB11("diagnosis codes.")

 +44      ;

 +45      ;IB*2.0*702;JWS;remove 665 fatal error for Dental claims with >4 Diagnosis Codes, make it a warning

 +46      ;WCJ;IB*2.0*665v4;more than 4 diag on Dental (J-something something) is an error PERIOD

 +47      ;I $$FT^IBCEF(IBIFN)=7,$P($G(IBDXO),U,2)>4 D WARN^IBCBB11("Only 4 diagnosis codes are allowed on a dental transaction")

 +48      ;I $$FT^IBCEF(IBIFN)=7,$O(IBDXO(4)) S IBER=IBER_"IB398;"

 +49       IF $$FT^IBCEF(IBIFN)=7

               IF $ORDER(IBDXO(4))

                   DO WARN^IBCBB11("A HIPAA Compliant EDI Dental claim cannot contain more than 4")

                   DO WARN^IBCBB11("diagnosis codes.")

 +50      ;

 +51       IF $$WNRBILL^IBEFUNC(IBIFN)

               IF $$MRATYPE^IBEFUNC(IBIFN)'="B"

                   SET IBER=IBER_"IB087;"

 +52      ;

 +53      ; IB*320 - CLIA# error/warning - error msg for MRA claims, else warning

 +54       IF $PIECE(IBNDU2,U,13)=""

               IF $$CLIAREQ^IBCEP8A(IBIFN)

                   Begin DoDot:1

 +55                   IF $$REQMRA^IBEFUNC(IBIFN)

                           SET IBER=IBER_"IB235;"

                           QUIT

 +56                   DO WARN^IBCBB11("Claim contains laboratory services. The payer may require a CLIA #.")

 +57                   QUIT

                   End DoDot:1

 +58      ;

 +59      ; Only one occurrence code can be present for event date for box 14

 +60       SET Z=$$EVENT^IBCF22(IBIFN,.IBXSAVE,.IBI)

 +61       IF IBI

               SET IBER=IBER_"IB099;"

 +62      ;

 +63      ; esg - 6/6/07 - warning if missing non-VA care type for outside facility

 +64       SET IBNVFLG=0

 +65       IF $PIECE(IBNDU2,U,10)

               IF '$PIECE(IBNDU2,U,11)

                   DO WARN^IBCBB11("Non-VA facility indicated, but the Non-VA Care Type field is not defined")

                   SET IBNVFLG=1

 +66      ;

 +67      ; unit/charge limits

 +68       KILL IBXDATA

 +69      ;Get charge lines

           DO F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)

 +70       SET (IBLCT,IBOLAB)=0

           SET IBPS=""

           SET IBSP=$$BILLSPEC^IBCEU3(IBIFN)

 +71       SET IBI=0

FOR

               SET IBI=$ORDER(IBXDATA(IBI))

               if 'IBI

                   QUIT

               Begin DoDot:1

 +72               SET IBLCT=IBLCT+1

 +73               IF $PIECE(IBNDU2,U,11)

                       Begin DoDot:2

 +74                       IF '$PIECE(IBXDATA(IBI),U,11)

                               SET IBPS=IBPS_$SELECT(IBPS'="":",",1:"")_IBI

                               QUIT

 +75                       IF $PIECE(IBXDATA(IBI),U,14)

                               IF "24"'[$PIECE(IBNDU2,U,11)

                                   DO WARN^IBCBB11("Outside lab charges exist on a non-lab NON-VA bill")

                       End DoDot:2

 +76      ; Start IB*2.0*473 Changed the following two warnings to errors.

 +77      ;I '$P(IBNDU2,U,11),$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Purchased service amounts are invalid unless this is a NON-VA bill")

 +78      ;I IBNVFLG,'$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Non-VA facility indicated, but no purchased service charge on line# "_IBI)

 +79               IF $GET(IBER)'["IB350"

                       IF '$PIECE(IBNDU2,U,11)

                           IF $PIECE(IBXDATA(IBI),U,11)

                               SET IBER=IBER_"IB350;"

 +80               IF $GET(IBER)'["IB351"

                       IF IBNVFLG

                           IF '$PIECE(IBXDATA(IBI),U,11)

                               SET IBER=IBER_"IB351;"

 +81      ; End IB*2.0*473

 +82               IF $GET(IBER)'["IB310"

                       IF $DATA(IBXDATA(IBI,"A"))

                           SET IBER=IBER_"IB310;"

                           QUIT

 +83               IF $DATA(IBXDATA(IBI,"ARX"))

                       IF IBER'["311;"

                           SET IBER=IBER_"IB311;"

                           QUIT

 +84               IF $PIECE(IBXDATA(IBI),U,14)

                       SET IBOLAB=IBOLAB+1

 +85      ;JWS;IB*2.0*641v9; put back the edit for Place of Service

 +86      ; Place of service required => remove edit below for IB*2.0*488 ; baa

 +87               IF $GET(IBER)'["IB314;"

                       IF $PIECE(IBXDATA(IBI),U,3)=""

                           SET IBER=IBER_"IB314;"

 +88      ; Type of service required => remove edit below for IB*2.0*488 ; baa

 +89      ;I $G(IBER)'["IB313;",$P(IBXDATA(IBI),U,4)="" S IBER=IBER_"IB313;"

 +90      ; 43 and 53 are invalid types of service

 +91               IF $GET(IBER)'["IB110;"

                       IF ($PIECE(IBXDATA(IBI),U,4)=43!($PIECE(IBXDATA(IBI),U,4)=53))

                           SET IBER=IBER_"IB110;"

 +92      ; Units for the line item must be less than 100/1000 => Remove edit baa *488

 +93      ;I IBER'["IB088",$P(IBXDATA(IBI),U,9)'<100 D

 +94      ;. I $P(IBXDATA(IBI),U,4)'=7 S IBER=IBER_"IB088;" Q

 +95      ;. I $P(IBXDATA(IBI),U,9)'<1000 S IBER=IBER_"IB088;"

 +96      ; Line item total charge must be less than $10,000.00, greater than 0

 +97      ; IB*2.0*432 - The IB system shall provide the ability for users to enter maximum line item dollar amounts of 9999999.99.

 +98      ; I IBER'["IB090",$P(IBXDATA(IBI),U,9)'<10000 S IBER=IBER_"IB090;"

 +99               IF IBER'["IB090"

                       IF $PIECE(IBXDATA(IBI),U,9)'<10000000

                           SET IBER=IBER_"IB090;"

 +100     ; IB*2.0*447 BI Removed individual warning replaced by a claim level warning.

 +101     ; I '($P(IBXDATA(IBI),U,9)*$P(IBXDATA(IBI),U,8)),$$COBN^IBCEF(IBIFN)'>1 S Z="Procedure "_$P(IBXDATA(IBI),U,5)_" has a 0-charge and will not be transmitted" D WARN^IBCBB11(Z)

               End DoDot:1

               if IBER["IB310"!(IBER["IB311")

                   QUIT

 +102      IF IBTX

               IF IBLCT>50

                   Begin DoDot:1

 +103                  IF $GET(IBER)'["IB308"

                           IF '$$REQMRA^IBEFUNC(IBIFN)

                               SET IBER=IBER_"IB308;"

                               QUIT

 +104                  IF $GET(IBER)'["IB325"

                           IF '$PIECE(IBNDTX,U,9)

                               SET IBER=IBER_"IB325;"

                   End DoDot:1

 +105      SET IBU3=$PIECE($GET(^DGCR(399,IBIFN,"U3")),U,4,7)

           IF $TRANSLATE(IBU3,U)'=""

               Begin DoDot:1

 +106     ; ib*2.0*432 add line-level check

 +107     ;I +IBSP'=35 D WARN^IBCBB11("Chiropractic service details only valid if provider specialty is '35'")

 +108              IF $$LINSPEC^IBCEU3(IBIFN)'[35

                       DO WARN^IBCBB11("Chiropractic service details only valid if provider specialty is '35'")

 +109              IF $GET(IBER)'["IB137"

                       IF $PIECE(IBU3,U,2)=""

                           SET IBER=IBER_"IB137;"

 +110              IF $GET(IBER)'["IB338"

                       IF $PIECE(IBU3,U,4)=""

                           SET IBER=IBER_"IB138;"

                           QUIT

 +111              IF $GET(IBER)'["IB139"

                       IF $PIECE(IBU3,U,3)=""

                           IF "AM"[$PIECE(IBU3,U,4)

                               SET IBER=IBER_"IB139;"

 +112              QUIT

               End DoDot:1

 +113     ; IB*2.0*473 BI Changed the following warning to an error.

 +114     ;I IBPS'="" D WARN^IBCBB11("NON-VA facility indicated, but no purchased service charge on line item"_$S(IBPS[",":"s",1:"")_" #"_IBPS)

 +115      IF $GET(IBER)'["IB351"

               IF IBPS'=""

                   SET IBER=IBER_"IB351;"

 +116      IF $PIECE(IBNDU2,U,11)

               IF $PIECE(IBNDU2,U,11)=4

                   IF IBOLAB>1

                       DO WARN^IBCBB11("For proper payment, you must bill each outside lab on a separate claim form")

 +117      KILL IBXDATA

 +118     ;

 +119     ;       ; Check for Physician Name

 +120      DO F^IBCEF("N-REFERRING PROVIDER NAME",,,IBIFN)

 +121      IF $PIECE($GET(IBXDATA),U)]""

               Begin DoDot:1

 +122              NEW IBZ,FUNCTION,IBINS

 +123              SET FUNCTION=1

 +124              FOR IBINS=1:1:3

                       Begin DoDot:2

 +125                      SET Z=$$GETTYP^IBCEP2A(IBIFN,IBINS,FUNCTION)

 +126     ; Rendering/attending prov secondary id required

                           IF Z

                               IF $PIECE(Z,U,2)

                                   Begin DoDot:3

 +127                                  NEW IBID,IBOK,Q0

 +128     ; check all as though they were current

                                       DO PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C")

 +129                                  SET IBOK=0

 +130                                  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

 +131                                  IF 'IBOK

                                           SET IBER=IBER_$SELECT(IBINS=1:"IB239;",IBINS=2:"IB240;",IBINS=3:"IB241;",1:"")

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +132     ;

 +133      QUIT

 +134     ;

OCC10(IBIFN,IBARR,IBFT) ; Determine if occurrence code 10 exists for pregnancy dx

 +1       ; IBARR=array subscripted by ien of DX code if IBFT=2 (CMS-1500 form)

 +2       ;                         by seq # and = ien of DX code if IBFT'=2

 +3       ;

 +4        NEW IBN,IBI,IBXDATA,IBXSAVE,IBDX,Z

 +5        SET IBN=1

 +6       ;

 +7       ; If a pregnancy DX exists, must be an occurrence code 10 for LMP date

 +8       ; ICD-9  dx ranges are: V22*-V24*, V27*-V28*, 630*-677*

 +9       ; ICD-10 dx ranges are: O00.*-O9A.*, Z34.*-Z36.*, Z37.*-Z39.*, Z3A.*

 +10      ;

 +11       IF '$DATA(^TMP($JOB,"LMD"))

               Begin DoDot:1

 +12               DO F^IBCEF("N-OCCURRENCE CODES",,,IBIFN)

 +13               SET ^TMP($JOB,"LMD")=""

 +14               SET Z=0

FOR

                       SET Z=$ORDER(IBXSAVE("OCC",Z))

                       if 'Z

                           QUIT

                       IF +IBXSAVE("OCC",Z)=10

                           SET ^TMP($JOB,"LMD")=1

                           QUIT

               End DoDot:1

 +15      ;

 +16       IF '^TMP($JOB,"LMD")

               SET IBI=0

FOR

                   SET IBI=$ORDER(IBARR(IBI))

                   if 'IBI

                       QUIT

                   Begin DoDot:1

 +17                   NEW Z,Z1,ZC

 +18                   SET IBDX=$SELECT($GET(IBFT)'=2:+IBARR(IBI),1:IBI)

 +19      ; Pregnancy Dx exists

                       SET ZC=$$ICD9^IBACSV(IBDX,$$BDATE^IBACSV(IBIFN))

                       SET Z=$EXTRACT(ZC,1,3)

                       SET Z1=$EXTRACT(Z,2,3)

 +20      ; ICD-9 Dx

                       IF $PIECE(ZC,U,19)=1

                           IF $SELECT(Z'<630&(Z<678):1,$EXTRACT(Z)="V":$SELECT(Z1'<22&(Z1<25):1,1:Z1'<27&(Z1<28)),1:0)

                               SET IBN=0

 +21      ; ICD-10 Dx

                       IF $PIECE(ZC,U,19)=30

                           IF $SELECT(Z?1"O"2N:1,Z="O9A":1,$EXTRACT(Z)="Z"&(Z1'<34)&(Z1<40):1,Z="Z3A":1,1:0)

                               SET IBN=0

                   End DoDot:1

                   if 'IBN

                       QUIT

 +22      ;

OCC10Q     KILL ^TMP($JOB,"LMD")

 +1        QUIT IBN

 +2       ;

IBCBB2.m