IBCBB21 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE FOR UB-04 ;2-NOV-89
;;2.0;INTEGRATED BILLING;**51,137,210,232,155,291,348,349,403,400,432,447,461,665,702,727**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
EN(IBZPRC92) ;
;
N ECODE,IBTXMT,IBXDATA,IBDXTYP,IBDXVER,IBLPRT,IBI,Z,Z0,Z1,IBREQMRA,IBFTP
I '$D(IBZPRC92) D ALLPROC^IBCVA1(IBIFN,.IBZPRC92)
S IBREQMRA=$$REQMRA^IBEFUNC(IBIFN) ; MRA?
K IBQUIT S IBQUIT=0
S (Z,Z0,Z1)=0
F S Z=$O(IBZPRC92(Z)) Q:'Z S:IBZPRC92(Z)["CPT" Z0=Z0+1 S:IBZPRC92(Z)["ICD" Z1=Z1+1
S IBTXMT=$$TXMT^IBCEF4(IBIFN)
S IBZPRC92=Z0_U_Z1 ;Save # of CPT's and ICD9's
; More than 50 procedures on a bill - must print locally
I IBTXMT,(+IBZPRC92>50!(+$P(IBZPRC92,U,2)>50)) D Q:IBQUIT
. I 'IBREQMRA S IBQUIT=$$IBER^IBCBB3(.IBER,308) Q
. I '$P(IBNDTX,U,9) S IBQUIT=$$IBER^IBCBB3(.IBER,325)
; removed 11x check ;WCJ IB*2.0*432
; If ICD9 procedures with dates and charges, bill 11x or 83x needs operating physician
;I IBTOB12="11",$P(IBZPRC92,U,2),'$$CKPROV^IBCEU(IBIFN,2) S IBER=IBER_"IB304;"
;modify 83x check for line level providers and also chacnged the erro check slightly
;I IBTOB12="83",$P(IBZPRC92,U,2),'$$CKPROV^IBCEU(IBIFN,2) S IBER=IBER_"IB312;"
I IBTOB12="83",'$$UBPRVCK^IBCBB12(IBIFN) S IBER=IBER_"IB312;" ; DEM;432
;
; If any CPT procedures have more than 2 modifiers, warn
;S Z=0 F S Z=$O(IBZPRC92(Z)) Q:'Z I $P(IBZPRC92(Z),U)["ICPT(",$L($P(IBZPRC92(Z),U,15),",")>2 S Z0="Proc "_$$PRCD^IBCEF1($P(IBZPRC92(Z),U))_" has > 2 modifiers - only first 2 will be used" D WARN^IBCBB11(Z0)
;TPF;IB*2.0*727;EBILL-1564;05/10/2022
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 Z0="Proc "_$$PRCD^IBCEF1($P(IBZPRC92(Z),U))_" has > 4 modifiers - only first 4 will be used" D WARN^IBCBB11(Z0)
;
I $$WNRBILL^IBEFUNC(IBIFN),$$MRATYPE^IBEFUNC(IBIFN)'="A" S IBER=IBER_"IB086;"
;
; UB-04 Diagnosis Codes
K IBXDATA D F^IBCEF("N-DIAGNOSES",,,IBIFN)
;
; Only 24 other dx's + 1 principal dx + 3 ecode dx's are allowed per claim
;S (Z,ECODE,IBI)=0 F S Z=$O(IBXDATA(Z)) Q:'Z D Q:IBER["309;"!(ECODE>3)
;. S IBI=IBI+1
;. S IBDXTYP=$$ICD9^IBACSV(+$P(IBXDATA(Z),U),$$BDATE^IBACSV(IBIFN)) I $P(IBDXTYP,U,19)=1,$E(IBDXTYP)="E" D
;.. S:ECODE<=3 ECODE=ECODE+1,IBI=IBI-1
;.. I ECODE>3 D WARN^IBCBB11("Claim contains more than 3 External Cause of Injury codes.")
;. ;
;. ; max DX check does not apply to MRAs
;. I IBTXMT,IBI>25 D
;.. I 'IBREQMRA Q:$P(IBNDTX,U,8) S IBER=IBER_"IB309;" Q
;.. I '$P(IBNDTX,U,9) S IBER=IBER_"IB326;"
;
;WCJ;IB*2.0*650v6
; Only 24 other dx's/17 printed + 1 principal dx + 12 ecode dx's are allowed per claim electronic/3 printed
S IBFTP=$$GET1^DIQ(399,IBIFN_",",27,"I") ; force to print
S (Z,ECODE,IBI)=0 F S Z=$O(IBXDATA(Z)) Q:'Z D
. S IBI=IBI+1
. S IBDXTYP=$$ICD9^IBACSV(+$P(IBXDATA(Z),U),$$BDATE^IBACSV(IBIFN))
. I $P(IBDXTYP,U,19)=30,"VWXY"[$E(IBDXTYP) D
.. S ECODE=ECODE+1,IBI=IBI-1
;IB*2.0*702;JWS;remove 665 fatal error for Diagnosis Codes > allowed amount by claim type, make it a warning
;I IBI>$S(IBFTP:18,1:25) S IBER=IBER_$S(IBFTP:"IB393;",1:"IB394;")
I IBI>$S(IBFTP:18,1:25) D
. I IBFTP D WARN^IBCBB11("Only the first 17 diagnosis codes will print on a UB-04.") Q
. D WARN^IBCBB11("A HIPAA Compliant EDI Institutional claim cannot contain more than 24"),WARN^IBCBB11("other diagnosis codes.")
;IB*2.0*702;JWS;remove 665 fatal error for External Diagnosis Codes > allow number, make it a warning
;I ECODE>$S(IBFTP:3,1:12) S IBER=IBER_$S(IBFTP:"IB395;",1:"IB396;")
I ECODE>$S(IBFTP:3,1:12) D
. I IBFTP D WARN^IBCBB11("Only the first 3 e-diagnosis codes will print on a UB-04.") Q
. D WARN^IBCBB11("A HIPAA Compliant EDI Institutional claim cannot contain more than 12"),WARN^IBCBB11("e-diagnosis codes.")
;
I '$O(IBXDATA(0)) S IBER=IBER_"IB071;" ;Require Diag code NOIS:OKL-0304-72495
;
; Principle diagnosis - updated for ICD-10 **461
I $O(IBXDATA(0)) S IBDXTYP=$$ICD9^IBACSV(+$P(IBXDATA(1),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),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),IBDXTYP="Z" S Z="Principal Dx Z-code may not be valid" D WARN^IBCBB11(Z)
;
I '$$OCC10^IBCBB2(IBIFN,.IBXDATA,3) S IBER=IBER_"IB093;"
;
; At least one PRV diagnosis is required for outpatient UB-04 claim
; IB*2.0*447 BI This warning was removed and replaced with an Error Message in routine IBCBB1.
;I '$$INPAT^IBCEF(IBIFN),$$CHKPRV^IBCSC10B=3 D WARN^IBCBB11("Outpatient Institutional claims should contain a Patient Reason for Visit.")
;
K ^TMP($J,"IBC-RC")
D F^IBCEF("N-UB-04 SERVICE LINE (PRINT)",,,IBIFN)
;JWS;IB*2.0*665;US40781;Institutional inpatient claims no greater than 999 X12 2400 loop entries
I $O(^DGCR(399,IBIFN,"RC","A"),-1)>999 D
. N IBRC,I
. S IBRC=0
. F I=0:1 S IBRC=$O(^DGCR(399,IBIFN,"RC",IBRC)) Q:'+IBRC
. I I>999,IBER'["IB399" S IBER=IBER_"IB399;"
. Q
;JWS;end IB*2.0*665
S (Z0,IBI)=0 F S IBI=$O(^TMP($J,"IBC-RC",IBI)) Q:'IBI S Z=$G(^(IBI)) Q:+$P(Z,U,2)=1 I $P(Z,U,2),$P(Z,U,1)=1 D
. ; 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(Z,U,2)>1,($P(Z,U,7)>99999.99!($P(Z,U,8)>99999.99)) S IBER=IBER_"IB090;"
. I IBER'["IB090;",$P(Z,U,2)>1,($P(Z,U,7)>9999999.99!($P(Z,U,8)>9999999.99)) S IBER=IBER_"IB090;"
. Q:$P(Z,U,2)'<180&($P(Z,U,2)'>189) ;Pass days (LOA) don't matter
. ; Removed the following warning IB*2.0*447 BI Replaced in IBCBB1.
. ;I '$P(Z,U,7),'$P(Z,U,8),'Z0,$$COBN^IBCEF(IBIFN)'>1 S Z0="Rev Code(s) having a 0-charge will not be transmitted for the bill" D WARN^IBCBB11(Z0) S Z0=1
K ^TMP($J,"IBC-RC")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB21 5988 printed Oct 16, 2024@18:09:33 Page 2
IBCBB21 ;ALB/AAS - CONTINUATION OF EDIT CHECK ROUTINE FOR UB-04 ;2-NOV-89
+1 ;;2.0;INTEGRATED BILLING;**51,137,210,232,155,291,348,349,403,400,432,447,461,665,702,727**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN(IBZPRC92) ;
+1 ;
+2 NEW ECODE,IBTXMT,IBXDATA,IBDXTYP,IBDXVER,IBLPRT,IBI,Z,Z0,Z1,IBREQMRA,IBFTP
+3 IF '$DATA(IBZPRC92)
DO ALLPROC^IBCVA1(IBIFN,.IBZPRC92)
+4 ; MRA?
SET IBREQMRA=$$REQMRA^IBEFUNC(IBIFN)
+5 KILL IBQUIT
SET IBQUIT=0
+6 SET (Z,Z0,Z1)=0
+7 FOR
SET Z=$ORDER(IBZPRC92(Z))
if 'Z
QUIT
if IBZPRC92(Z)["CPT"
SET Z0=Z0+1
if IBZPRC92(Z)["ICD"
SET Z1=Z1+1
+8 SET IBTXMT=$$TXMT^IBCEF4(IBIFN)
+9 ;Save # of CPT's and ICD9's
SET IBZPRC92=Z0_U_Z1
+10 ; More than 50 procedures on a bill - must print locally
+11 IF IBTXMT
IF (+IBZPRC92>50!(+$PIECE(IBZPRC92,U,2)>50))
Begin DoDot:1
+12 IF 'IBREQMRA
SET IBQUIT=$$IBER^IBCBB3(.IBER,308)
QUIT
+13 IF '$PIECE(IBNDTX,U,9)
SET IBQUIT=$$IBER^IBCBB3(.IBER,325)
End DoDot:1
if IBQUIT
QUIT
+14 ; removed 11x check ;WCJ IB*2.0*432
+15 ; If ICD9 procedures with dates and charges, bill 11x or 83x needs operating physician
+16 ;I IBTOB12="11",$P(IBZPRC92,U,2),'$$CKPROV^IBCEU(IBIFN,2) S IBER=IBER_"IB304;"
+17 ;modify 83x check for line level providers and also chacnged the erro check slightly
+18 ;I IBTOB12="83",$P(IBZPRC92,U,2),'$$CKPROV^IBCEU(IBIFN,2) S IBER=IBER_"IB312;"
+19 ; DEM;432
IF IBTOB12="83"
IF '$$UBPRVCK^IBCBB12(IBIFN)
SET IBER=IBER_"IB312;"
+20 ;
+21 ; If any CPT procedures have more than 2 modifiers, warn
+22 ;S Z=0 F S Z=$O(IBZPRC92(Z)) Q:'Z I $P(IBZPRC92(Z),U)["ICPT(",$L($P(IBZPRC92(Z),U,15),",")>2 S Z0="Proc "_$$PRCD^IBCEF1($P(IBZPRC92(Z),U))_" has > 2 modifiers - only first 2 will be used" D WARN^IBCBB11(Z0)
+23 ;TPF;IB*2.0*727;EBILL-1564;05/10/2022
+24 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 Z0="Proc "_$$PRCD^IBCEF1($PIECE(IBZPRC92(Z),U))_" has > 4 modifiers - only first 4 will be used"
DO WARN^IBCBB11(Z0)
+25 ;
+26 IF $$WNRBILL^IBEFUNC(IBIFN)
IF $$MRATYPE^IBEFUNC(IBIFN)'="A"
SET IBER=IBER_"IB086;"
+27 ;
+28 ; UB-04 Diagnosis Codes
+29 KILL IBXDATA
DO F^IBCEF("N-DIAGNOSES",,,IBIFN)
+30 ;
+31 ; Only 24 other dx's + 1 principal dx + 3 ecode dx's are allowed per claim
+32 ;S (Z,ECODE,IBI)=0 F S Z=$O(IBXDATA(Z)) Q:'Z D Q:IBER["309;"!(ECODE>3)
+33 ;. S IBI=IBI+1
+34 ;. S IBDXTYP=$$ICD9^IBACSV(+$P(IBXDATA(Z),U),$$BDATE^IBACSV(IBIFN)) I $P(IBDXTYP,U,19)=1,$E(IBDXTYP)="E" D
+35 ;.. S:ECODE<=3 ECODE=ECODE+1,IBI=IBI-1
+36 ;.. I ECODE>3 D WARN^IBCBB11("Claim contains more than 3 External Cause of Injury codes.")
+37 ;. ;
+38 ;. ; max DX check does not apply to MRAs
+39 ;. I IBTXMT,IBI>25 D
+40 ;.. I 'IBREQMRA Q:$P(IBNDTX,U,8) S IBER=IBER_"IB309;" Q
+41 ;.. I '$P(IBNDTX,U,9) S IBER=IBER_"IB326;"
+42 ;
+43 ;WCJ;IB*2.0*650v6
+44 ; Only 24 other dx's/17 printed + 1 principal dx + 12 ecode dx's are allowed per claim electronic/3 printed
+45 ; force to print
SET IBFTP=$$GET1^DIQ(399,IBIFN_",",27,"I")
+46 SET (Z,ECODE,IBI)=0
FOR
SET Z=$ORDER(IBXDATA(Z))
if 'Z
QUIT
Begin DoDot:1
+47 SET IBI=IBI+1
+48 SET IBDXTYP=$$ICD9^IBACSV(+$PIECE(IBXDATA(Z),U),$$BDATE^IBACSV(IBIFN))
+49 IF $PIECE(IBDXTYP,U,19)=30
IF "VWXY"[$EXTRACT(IBDXTYP)
Begin DoDot:2
+50 SET ECODE=ECODE+1
SET IBI=IBI-1
End DoDot:2
End DoDot:1
+51 ;IB*2.0*702;JWS;remove 665 fatal error for Diagnosis Codes > allowed amount by claim type, make it a warning
+52 ;I IBI>$S(IBFTP:18,1:25) S IBER=IBER_$S(IBFTP:"IB393;",1:"IB394;")
+53 IF IBI>$SELECT(IBFTP:18,1:25)
Begin DoDot:1
+54 IF IBFTP
DO WARN^IBCBB11("Only the first 17 diagnosis codes will print on a UB-04.")
QUIT
+55 DO WARN^IBCBB11("A HIPAA Compliant EDI Institutional claim cannot contain more than 24")
DO WARN^IBCBB11("other diagnosis codes.")
End DoDot:1
+56 ;IB*2.0*702;JWS;remove 665 fatal error for External Diagnosis Codes > allow number, make it a warning
+57 ;I ECODE>$S(IBFTP:3,1:12) S IBER=IBER_$S(IBFTP:"IB395;",1:"IB396;")
+58 IF ECODE>$SELECT(IBFTP:3,1:12)
Begin DoDot:1
+59 IF IBFTP
DO WARN^IBCBB11("Only the first 3 e-diagnosis codes will print on a UB-04.")
QUIT
+60 DO WARN^IBCBB11("A HIPAA Compliant EDI Institutional claim cannot contain more than 12")
DO WARN^IBCBB11("e-diagnosis codes.")
End DoDot:1
+61 ;
+62 ;Require Diag code NOIS:OKL-0304-72495
IF '$ORDER(IBXDATA(0))
SET IBER=IBER_"IB071;"
+63 ;
+64 ; Principle diagnosis - updated for ICD-10 **461
+65 IF $ORDER(IBXDATA(0))
SET IBDXTYP=$$ICD9^IBACSV(+$PIECE(IBXDATA(1),U),$$BDATE^IBACSV(IBIFN))
Begin DoDot:1
+66 SET IBDXVER=$PIECE(IBDXTYP,U,19)
SET IBDXTYP=$EXTRACT(IBDXTYP)
+67 IF IBDXVER=1
IF IBDXTYP="E"
SET IBER=IBER_"IB117;"
+68 IF IBDXVER=1
IF $$INPAT^IBCEF(IBIFN)
IF IBDXTYP="V"
SET Z="Principal Dx V-code may not be valid"
DO WARN^IBCBB11(Z)
+69 IF IBDXVER=30
IF "VWXY"[IBDXTYP
SET IBER=IBER_"IB355;"
+70 IF IBDXVER=30
IF $$INPAT^IBCEF(IBIFN)
IF IBDXTYP="Z"
SET Z="Principal Dx Z-code may not be valid"
DO WARN^IBCBB11(Z)
End DoDot:1
+71 ;
+72 IF '$$OCC10^IBCBB2(IBIFN,.IBXDATA,3)
SET IBER=IBER_"IB093;"
+73 ;
+74 ; At least one PRV diagnosis is required for outpatient UB-04 claim
+75 ; IB*2.0*447 BI This warning was removed and replaced with an Error Message in routine IBCBB1.
+76 ;I '$$INPAT^IBCEF(IBIFN),$$CHKPRV^IBCSC10B=3 D WARN^IBCBB11("Outpatient Institutional claims should contain a Patient Reason for Visit.")
+77 ;
+78 KILL ^TMP($JOB,"IBC-RC")
+79 DO F^IBCEF("N-UB-04 SERVICE LINE (PRINT)",,,IBIFN)
+80 ;JWS;IB*2.0*665;US40781;Institutional inpatient claims no greater than 999 X12 2400 loop entries
+81 IF $ORDER(^DGCR(399,IBIFN,"RC","A"),-1)>999
Begin DoDot:1
+82 NEW IBRC,I
+83 SET IBRC=0
+84 FOR I=0:1
SET IBRC=$ORDER(^DGCR(399,IBIFN,"RC",IBRC))
if '+IBRC
QUIT
+85 IF I>999
IF IBER'["IB399"
SET IBER=IBER_"IB399;"
+86 QUIT
End DoDot:1
+87 ;JWS;end IB*2.0*665
+88 SET (Z0,IBI)=0
FOR
SET IBI=$ORDER(^TMP($JOB,"IBC-RC",IBI))
if 'IBI
QUIT
SET Z=$GET(^(IBI))
if +$PIECE(Z,U,2)=1
QUIT
IF $PIECE(Z,U,2)
IF $PIECE(Z,U,1)=1
Begin DoDot:1
+89 ; IB*2.0*432 - The IB system shall provide the ability for users to enter maximum line item dollar amounts of 9999999.99.
+90 ;I IBER'["IB090;",$P(Z,U,2)>1,($P(Z,U,7)>99999.99!($P(Z,U,8)>99999.99)) S IBER=IBER_"IB090;"
+91 IF IBER'["IB090;"
IF $PIECE(Z,U,2)>1
IF ($PIECE(Z,U,7)>9999999.99!($PIECE(Z,U,8)>9999999.99))
SET IBER=IBER_"IB090;"
+92 ;Pass days (LOA) don't matter
if $PIECE(Z,U,2)'<180&($PIECE(Z,U,2)'>189)
QUIT
+93 ; Removed the following warning IB*2.0*447 BI Replaced in IBCBB1.
+94 ;I '$P(Z,U,7),'$P(Z,U,8),'Z0,$$COBN^IBCEF(IBIFN)'>1 S Z0="Rev Code(s) having a 0-charge will not be transmitted for the bill" D WARN^IBCBB11(Z0) S Z0=1
End DoDot:1
+95 KILL ^TMP($JOB,"IBC-RC")
+96 QUIT
+97 ;
