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:"")
;
Q
;
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 Dec 13, 2024@02:08:51 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 ;
