IBCBB3 ;ALB/TMP - CONTINUATION OF EDIT CHECKS ROUTINE (MEDICARE) ;06/23/98
;;2.0;INTEGRATED BILLING;**51,137,155,349,371,377,432,592**;21-MAR-94;Build 58
;;Per VA Directive 6402, this routine should not be modified.
;
EDITMRA(IBQUIT,IBER,IBIFN,IBFT) ;
; Requires execution of GVAR^IBCBB, IBIFN defined
; File IB ERROR (350.8) contains error codes/text
;
N IBMRATYP,Z,IBZP,IBZP1,IBOK
S IBQUIT=0 ;Flag to say we have too many errors - quit edits
;
S IBMRATYP=$$MRATYPE^IBEFUNC(IBIFN,"C")
;
I IBFT=3 D
. D PARTA
I IBFT=2 D PARTB^IBCBB9
;
K IBXDATA D F^IBCEF("N-ADMITTING DIAGNOSIS",,,IBIFN)
; Req. for UB-04 type of bills 11x!18x
I $G(IBXDATA)="",IBFT=3 D Q:IBQUIT
. N Z
. I "^11^18^"[(U_IBTOB12_U) S IBQUIT=$$IBER(.IBER,231) Q
. I $$INPAT^IBCEF(IBIFN,1) S Z="Admitting Diagnosis may be required by payer, please verify" D WARN^IBCBB11(Z)
;
D GETPRV^IBCEU(IBIFN,"2,3,4",.Z)
S IBOK=1,Z=0,IBZP=U F S Z=$O(Z(Z)) Q:'Z S:$S($P($G(Z(Z,1)),U,3)["VA(200":1,1:0) IBZP=IBZP_+$P(Z(Z,1),U,3)_U
D ALLPROC^IBCVA1(IBIFN,.IBZP1)
;patch 432, enh5: The IB system shall no longer provide users with a warning message when authorizing a claim when line level and claim level providers are not the same.
;S Z=0 F S Z=$O(IBZP1(Z)) Q:'Z I $P(IBZP1(Z),U,18),IBZP'[(U_$P(IBZP1(Z),U,18)_U) S IBOK=0 Q
;I 'IBOK D WARN^IBCBB11("At least one provider on a procedure does not match your "_$S(IBFT=2:"render",1:"attend")_"ing or operating provider")
; JWS;IB*2.0*592 US1108 - Dental form check
I IBFT=2!(IBFT=7) D EN^IBCBB2
; edit checks for UB-04 (institutional) forms
I IBFT=3 D EN^IBCBB21(.IBZPRC92)
;
Q
;
PARTA ; MEDICARE specific edit checks for PART A claims (UB-04 formats)
;
N IBI,IBJ,IBX,IBCTYP,VADM,VAPA,IBSTOP,IBDXC,IBDXARY,IBPR,IBLABS,REQMRA
N IBS,IBTUNIT,IBCAGE,IBREV1,IBOCCS,IBOCSDT,IBVALCD,IBOCCD,IBNOPR
N IBCCARY1,IBPATST,IBZADMIT,IBZDISCH,IBXIEN,IBXERR,IBXDATA,IBOCSP
N IBCOV,IBNCOV,IBREVC,IBREVDUP,IBBCPT,IBREVC12,IBREVTOT,IBECAT,IBINC
;
; Medicare is the current payer, but no diagnosis codes
I $$WNRBILL^IBEFUNC(IBIFN) D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBQUIT=$$IBER(.IBER,120) Q:IBQUIT
;
; Type of Bill must be three digits
I IBTOB'?3N S X=$$IBER(.IBER,103) Q
;
; Covered Days
S IBCTYP=0
S IBCOV=$P(IBNDU2,U,2),IBNCOV=$P(IBNDU2,U,3)
;
; If interim bill, covered days must not be greater than 60
; remove for IB*2.0*432
; I "23"[$E(IBTOB,3),IBCOV>60 S IBQUIT=$$IBER(.IBER,"096") Q:IBQUIT
;
; I bill type is 11x or 18x or 21x then we need covered days
; remove for IB*2.0*432
; I "^11^18^21^"[(U_IBTOB12_U) S IBCTYP=1 I IBCOV="" S IBQUIT=$$IBER(.IBER,106) Q:IBQUIT
;
S (IBI,IBJ)=0
K IBXDATA D F^IBCEF("N-CONDITION CODES",,,IBIFN)
; Re-sort the condition codes by code
S IBI=0 F S IBI=$O(IBXDATA(IBI)) Q:'IBI S IBCCARY1($P(IBXDATA(IBI),U))=""
;
; for condition code 40, covered days must be 0
; remove for IB*2.0*432
; I $D(IBCCARY1(40)),IBCOV'=0 S IBQUIT=$$IBER(.IBER,107) Q:IBQUIT
;
; cov days+non=to date -from date unless the patient status = 30 (still
; pt) or outpatient or if the to date and from date are same then add 1
S IBPATST="",IBX=$P(IBNDU,U,12),IBPATST=$P($G(^DGCR(399.1,+IBX,0)),U,2)
S IBINC=$S(IBPATST=30!(IBFDT=IBTDT):1,1:0)
; remove for IB*2.0*432
;I $$INPAT^IBCEF(IBIFN,1),(IBCOV+IBNCOV)'=($$FMDIFF^XLFDT(IBTDT,IBFDT)+IBINC) S IBQUIT=$$IBER(.IBER,108) Q:IBQUIT
;
; if covered days >100 and type of bill is 21x or 18x error
; remove for IB*2.0*432
; I IBCOV>100,(IBTOB12=18!(IBTOB12=21)) S IBQUIT=$$IBER(.IBER,109) Q:IBQUIT
;
S (IBJ,IBTUNIT,IBS,IBREVTOT("AC"),IBREVTOT("AI"),IBREVTOT("AO"),IBREVTOT)=0
;
K IBXDATA D F^IBCEF("N-UB-04 SERVICE LINE (EDI)",,,IBIFN) ;Get rev codes
;
; Re-sort the revenue codes by code
;>> IBREV1(rev code,x)=Rev code^ptr cpt^unit chg^units^total^tot unc
; IBREV1(rev code) = revenue code edit category
;
; IBNOPR = flag that determines if there are revenue codes with
; charges that do not have a procedure - no need to check
; for billable MCR procedures if at least one RC is billable
; 1 = there is at least one billable revenue code without a
; procedure
;
S REQMRA=$$REQMRA^IBEFUNC(IBIFN)
S (IBNOPR,IBI)=0
F S IBI=$O(IBXDATA(IBI)) Q:'IBI D
. I REQMRA D GYMODCHK(IBXDATA(IBI)) ; IB*2*377 GY modifier check
. S IBJ=$P(IBXDATA(IBI),U),IBECAT=""
. I 'IBNOPR D
.. I $P(IBXDATA(IBI),U,2)'="" S IBPR($P(IBXDATA(IBI),U,2))=IBI Q
.. S IBNOPR=1 K IBPR
. S:$D(IBREV1(IBJ)) IBECAT=$G(IBREV1(IBJ))
. I '$D(IBREV1(IBJ))!(IBECAT="") D S IBREV1(IBJ)=IBECAT
. . ;
. . ; Accomodations (AC)
. . I (IBJ'<100&(IBJ'>219))!(IBJ=224) S IBECAT="AC" Q
. . ;
. . ; Ancillary Outpatient (AO)
. . I '$$INPAT^IBCEF(IBIFN,1) S IBECAT="AO" Q
. . ;
. . ; Ancillary Inpatient (AI)
. . S IBECAT="AI"
. ;
. S IBREV1(IBJ,+$O(IBREV1(IBJ,""),-1)+1)=IBXDATA(IBI)
. S IBREVTOT(IBECAT)=IBREVTOT(IBECAT)+$P(IBXDATA(IBI),U,6)
. I IBECAT="AC" S IBTUNIT=IBTUNIT+$P(IBXDATA(IBI),U,4)
;
I $$NEEDMRA^IBEFUNC(IBIFN),$O(IBPR(""))'="" D Q:IBQUIT
. ; Don't allow a bill containing only billable procedures for:
. ; Oxygen, labs, or influenza shots
. ; OR a bill with prosthetics on it
. ; to be sent to MEDICARE for an MRA
. D NONMCR(.IBPR,.IBLABS) ; Remove Oxygen, labs, influenza shots
. I $G(IBLABS) D WARN^IBCBB11("There are Lab procedures on this claim."),WARN^IBCBB11("Please verify that MEDICARE does not reimburse these labs at 100%") Q
. I $O(IBPR(""))="" D
.. S IBQUIT=$$IBER(.IBER,"098")
;
; covered days+non covered = units of accom rev codes
; Check room and board
; remove for IB*2.0*432
;I IBTUNIT,IBTUNIT'=(IBCOV+IBNCOV) S IBQUIT=$$IBER(.IBER,114) Q:IBQUIT
;
; Non Covered Days
; required when the type of bill is 11x,18x,21x or covered days=0
; remove for IB*2.0*432
; I IBNCOV="",(IBCTYP!(IBCOV=0)) S IBQUIT=$$IBER(.IBER,115) Q:IBQUIT
;
; if cc code=40 then non-covered days must be 1
; remove for IB*2.0*432
; I $D(IBCCARY1(40)),IBNCOV'=1 S IBQUIT=$$IBER(.IBER,116) Q:IBQUIT
;
; Patient Sex
; must be "M" or "F"
D DEM^VADPT
I $P(VADM(5),U)'="M",$P(VADM(5),U)'="F" S IBQUIT=$$IBER(.IBER,124) Q:IBQUIT
;
; esg - 10/17/07 - patch 371
; For Part A replacement MRA request claims, make sure
; the Medicare ICN/DCN number is present and also text in FL-80.
I $$REQMRA^IBEFUNC(IBIFN),$F(".137.138.117.118.","."_IBTOB_".") D Q:IBQUIT
. N IBZ,FL80TXT
. D F^IBCEF("N-CURR INS FORM LOC 64","IBZ",,IBIFN) ; see CI3-11
. I IBZ="" S IBQUIT=$$IBER(.IBER,205) Q:IBQUIT ; missing ICN/DCN
. S FL80TXT=$P($G(^DGCR(399,IBIFN,"UF2")),U,3)
. I FL80TXT="" S IBQUIT=$$IBER(.IBER,206) Q:IBQUIT ; missing FL80 text
. Q
;
D ^IBCBB4
Q
;
IBER(IBER,ERRNO) ; Sets error list
; NOTE: add code to check error list > 20 ... If so, display message and
; quit so we don't get too many errors at once to handle
; Print all if printing list
;
I '$G(IBQUIT) D
. I ERRNO?1N.N S:$L(ERRNO)<3 ERRNO=$E("00",1,3-$L(ERRNO))_ERRNO
. I $L(IBER,";")>19,'$G(IBPRT("PRT")) S IBER=IBER_"IB999;",IBQUIT=1
. I $G(IBER)'[("IB"_ERRNO_";") S IBER=IBER_"IB"_ERRNO_";"
Q IBQUIT
;
NONMCR(IBPR,IBLABS) ; Delete all oxygen and lab, flu shot CPT entries from IBPR
; IBPR = array subscripted by CPT codes from bill
; IBLABS = flag returned =1 if labs found on bill
N Z S IBLABS=0
; Oxygen
F Z="A0422","A4575","A4616","A4619","A4620","A4621","E0455","E1353","E1355" K IBPR(Z)
F Z=77:1:85 S Z0="E13"_Z K IBPR(Z0)
; Labs
S Z="80000" F S Z=$O(IBPR(Z)) Q:Z'?1"8"4N S IBLABS=1
; Flu shots
F Z="90724","G0008","90732","G0009","90657","90658","90659","90660" K IBPR(Z)
Q
;
MCRANUM(IBIFN) ; Determine MEDICARE A provider ID # from bedsection for
; bill ien IBIFN
N IBX
; PART A MRA (only) needed - determine if psych/non-psych claim
N IBX,IBI
S IBI=$P($G(^DGCR(399,IBIFN,"U")),U,11)
S IBX=$S($TR($P($G(^DGCR(399.1,+IBI,0)),U),"psych","PSYCH")'["PSYCH":670899,1:674499)
Q IBX
;
MCRACK(IBIFN,X,IBFLD) ; Check for MEDICARE A for bill IBIFN
; Called from CLAIM STATUS MRA field (#24) xrefs in file 399
; X = current value of field 399;24
; IBFLD = 1 for primary ins co, 2 for secondary, 3 for tertiary
N IB
S IB=0
I +X,$$COBN^IBCEF(IBIFN)=IBFLD,$$WNRBILL^IBEFUNC(IBIFN,IBFLD),$$MRATYPE^IBEFUNC(IBIFN,"C")="A" S IB=1
Q IB
;
GYMODCHK(Z) ; GY modifier check procedure. IB*2*377 - 2/4/08
; Z is the IBXDATA(IBI) service line EDI
N MODS
I IBER["IB123" Q ; error already found
S MODS=$P(Z,U,9) ; list of modifiers separated by commas
I MODS'["GY" Q ; GY modifier not here on this line item
I $P(Z,U,6) Q ; non-covered charges exist on this line item
S IBQUIT=$$IBER(.IBER,123)
GYMODX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCBB3 8861 printed Oct 16, 2024@18:09:34 Page 2
IBCBB3 ;ALB/TMP - CONTINUATION OF EDIT CHECKS ROUTINE (MEDICARE) ;06/23/98
+1 ;;2.0;INTEGRATED BILLING;**51,137,155,349,371,377,432,592**;21-MAR-94;Build 58
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EDITMRA(IBQUIT,IBER,IBIFN,IBFT) ;
+1 ; Requires execution of GVAR^IBCBB, IBIFN defined
+2 ; File IB ERROR (350.8) contains error codes/text
+3 ;
+4 NEW IBMRATYP,Z,IBZP,IBZP1,IBOK
+5 ;Flag to say we have too many errors - quit edits
SET IBQUIT=0
+6 ;
+7 SET IBMRATYP=$$MRATYPE^IBEFUNC(IBIFN,"C")
+8 ;
+9 IF IBFT=3
Begin DoDot:1
+10 DO PARTA
End DoDot:1
+11 IF IBFT=2
DO PARTB^IBCBB9
+12 ;
+13 KILL IBXDATA
DO F^IBCEF("N-ADMITTING DIAGNOSIS",,,IBIFN)
+14 ; Req. for UB-04 type of bills 11x!18x
+15 IF $GET(IBXDATA)=""
IF IBFT=3
Begin DoDot:1
+16 NEW Z
+17 IF "^11^18^"[(U_IBTOB12_U)
SET IBQUIT=$$IBER(.IBER,231)
QUIT
+18 IF $$INPAT^IBCEF(IBIFN,1)
SET Z="Admitting Diagnosis may be required by payer, please verify"
DO WARN^IBCBB11(Z)
End DoDot:1
if IBQUIT
QUIT
+19 ;
+20 DO GETPRV^IBCEU(IBIFN,"2,3,4",.Z)
+21 SET IBOK=1
SET Z=0
SET IBZP=U
FOR
SET Z=$ORDER(Z(Z))
if 'Z
QUIT
if $SELECT($PIECE($GET(Z(Z,1)),U,3)["VA(200"
SET IBZP=IBZP_+$PIECE(Z(Z,1),U,3)_U
+22 DO ALLPROC^IBCVA1(IBIFN,.IBZP1)
+23 ;patch 432, enh5: The IB system shall no longer provide users with a warning message when authorizing a claim when line level and claim level providers are not the same.
+24 ;S Z=0 F S Z=$O(IBZP1(Z)) Q:'Z I $P(IBZP1(Z),U,18),IBZP'[(U_$P(IBZP1(Z),U,18)_U) S IBOK=0 Q
+25 ;I 'IBOK D WARN^IBCBB11("At least one provider on a procedure does not match your "_$S(IBFT=2:"render",1:"attend")_"ing or operating provider")
+26 ; JWS;IB*2.0*592 US1108 - Dental form check
+27 IF IBFT=2!(IBFT=7)
DO EN^IBCBB2
+28 ; edit checks for UB-04 (institutional) forms
+29 IF IBFT=3
DO EN^IBCBB21(.IBZPRC92)
+30 ;
+31 QUIT
+32 ;
PARTA ; MEDICARE specific edit checks for PART A claims (UB-04 formats)
+1 ;
+2 NEW IBI,IBJ,IBX,IBCTYP,VADM,VAPA,IBSTOP,IBDXC,IBDXARY,IBPR,IBLABS,REQMRA
+3 NEW IBS,IBTUNIT,IBCAGE,IBREV1,IBOCCS,IBOCSDT,IBVALCD,IBOCCD,IBNOPR
+4 NEW IBCCARY1,IBPATST,IBZADMIT,IBZDISCH,IBXIEN,IBXERR,IBXDATA,IBOCSP
+5 NEW IBCOV,IBNCOV,IBREVC,IBREVDUP,IBBCPT,IBREVC12,IBREVTOT,IBECAT,IBINC
+6 ;
+7 ; Medicare is the current payer, but no diagnosis codes
+8 IF $$WNRBILL^IBEFUNC(IBIFN)
DO SET^IBCSC4D(IBIFN,.IBDX,.IBDXO)
IF '$PIECE(IBDX,U,2)
SET IBQUIT=$$IBER(.IBER,120)
if IBQUIT
QUIT
+9 ;
+10 ; Type of Bill must be three digits
+11 IF IBTOB'?3N
SET X=$$IBER(.IBER,103)
QUIT
+12 ;
+13 ; Covered Days
+14 SET IBCTYP=0
+15 SET IBCOV=$PIECE(IBNDU2,U,2)
SET IBNCOV=$PIECE(IBNDU2,U,3)
+16 ;
+17 ; If interim bill, covered days must not be greater than 60
+18 ; remove for IB*2.0*432
+19 ; I "23"[$E(IBTOB,3),IBCOV>60 S IBQUIT=$$IBER(.IBER,"096") Q:IBQUIT
+20 ;
+21 ; I bill type is 11x or 18x or 21x then we need covered days
+22 ; remove for IB*2.0*432
+23 ; I "^11^18^21^"[(U_IBTOB12_U) S IBCTYP=1 I IBCOV="" S IBQUIT=$$IBER(.IBER,106) Q:IBQUIT
+24 ;
+25 SET (IBI,IBJ)=0
+26 KILL IBXDATA
DO F^IBCEF("N-CONDITION CODES",,,IBIFN)
+27 ; Re-sort the condition codes by code
+28 SET IBI=0
FOR
SET IBI=$ORDER(IBXDATA(IBI))
if 'IBI
QUIT
SET IBCCARY1($PIECE(IBXDATA(IBI),U))=""
+29 ;
+30 ; for condition code 40, covered days must be 0
+31 ; remove for IB*2.0*432
+32 ; I $D(IBCCARY1(40)),IBCOV'=0 S IBQUIT=$$IBER(.IBER,107) Q:IBQUIT
+33 ;
+34 ; cov days+non=to date -from date unless the patient status = 30 (still
+35 ; pt) or outpatient or if the to date and from date are same then add 1
+36 SET IBPATST=""
SET IBX=$PIECE(IBNDU,U,12)
SET IBPATST=$PIECE($GET(^DGCR(399.1,+IBX,0)),U,2)
+37 SET IBINC=$SELECT(IBPATST=30!(IBFDT=IBTDT):1,1:0)
+38 ; remove for IB*2.0*432
+39 ;I $$INPAT^IBCEF(IBIFN,1),(IBCOV+IBNCOV)'=($$FMDIFF^XLFDT(IBTDT,IBFDT)+IBINC) S IBQUIT=$$IBER(.IBER,108) Q:IBQUIT
+40 ;
+41 ; if covered days >100 and type of bill is 21x or 18x error
+42 ; remove for IB*2.0*432
+43 ; I IBCOV>100,(IBTOB12=18!(IBTOB12=21)) S IBQUIT=$$IBER(.IBER,109) Q:IBQUIT
+44 ;
+45 SET (IBJ,IBTUNIT,IBS,IBREVTOT("AC"),IBREVTOT("AI"),IBREVTOT("AO"),IBREVTOT)=0
+46 ;
+47 ;Get rev codes
KILL IBXDATA
DO F^IBCEF("N-UB-04 SERVICE LINE (EDI)",,,IBIFN)
+48 ;
+49 ; Re-sort the revenue codes by code
+50 ;>> IBREV1(rev code,x)=Rev code^ptr cpt^unit chg^units^total^tot unc
+51 ; IBREV1(rev code) = revenue code edit category
+52 ;
+53 ; IBNOPR = flag that determines if there are revenue codes with
+54 ; charges that do not have a procedure - no need to check
+55 ; for billable MCR procedures if at least one RC is billable
+56 ; 1 = there is at least one billable revenue code without a
+57 ; procedure
+58 ;
+59 SET REQMRA=$$REQMRA^IBEFUNC(IBIFN)
+60 SET (IBNOPR,IBI)=0
+61 FOR
SET IBI=$ORDER(IBXDATA(IBI))
if 'IBI
QUIT
Begin DoDot:1
+62 ; IB*2*377 GY modifier check
IF REQMRA
DO GYMODCHK(IBXDATA(IBI))
+63 SET IBJ=$PIECE(IBXDATA(IBI),U)
SET IBECAT=""
+64 IF 'IBNOPR
Begin DoDot:2
+65 IF $PIECE(IBXDATA(IBI),U,2)'=""
SET IBPR($PIECE(IBXDATA(IBI),U,2))=IBI
QUIT
+66 SET IBNOPR=1
KILL IBPR
End DoDot:2
+67 if $DATA(IBREV1(IBJ))
SET IBECAT=$GET(IBREV1(IBJ))
+68 IF '$DATA(IBREV1(IBJ))!(IBECAT="")
Begin DoDot:2
+69 ;
+70 ; Accomodations (AC)
+71 IF (IBJ'<100&(IBJ'>219))!(IBJ=224)
SET IBECAT="AC"
QUIT
+72 ;
+73 ; Ancillary Outpatient (AO)
+74 IF '$$INPAT^IBCEF(IBIFN,1)
SET IBECAT="AO"
QUIT
+75 ;
+76 ; Ancillary Inpatient (AI)
+77 SET IBECAT="AI"
End DoDot:2
SET IBREV1(IBJ)=IBECAT
+78 ;
+79 SET IBREV1(IBJ,+$ORDER(IBREV1(IBJ,""),-1)+1)=IBXDATA(IBI)
+80 SET IBREVTOT(IBECAT)=IBREVTOT(IBECAT)+$PIECE(IBXDATA(IBI),U,6)
+81 IF IBECAT="AC"
SET IBTUNIT=IBTUNIT+$PIECE(IBXDATA(IBI),U,4)
End DoDot:1
+82 ;
+83 IF $$NEEDMRA^IBEFUNC(IBIFN)
IF $ORDER(IBPR(""))'=""
Begin DoDot:1
+84 ; Don't allow a bill containing only billable procedures for:
+85 ; Oxygen, labs, or influenza shots
+86 ; OR a bill with prosthetics on it
+87 ; to be sent to MEDICARE for an MRA
+88 ; Remove Oxygen, labs, influenza shots
DO NONMCR(.IBPR,.IBLABS)
+89 IF $GET(IBLABS)
DO WARN^IBCBB11("There are Lab procedures on this claim.")
DO WARN^IBCBB11("Please verify that MEDICARE does not reimburse these labs at 100%")
QUIT
+90 IF $ORDER(IBPR(""))=""
Begin DoDot:2
+91 SET IBQUIT=$$IBER(.IBER,"098")
End DoDot:2
End DoDot:1
if IBQUIT
QUIT
+92 ;
+93 ; covered days+non covered = units of accom rev codes
+94 ; Check room and board
+95 ; remove for IB*2.0*432
+96 ;I IBTUNIT,IBTUNIT'=(IBCOV+IBNCOV) S IBQUIT=$$IBER(.IBER,114) Q:IBQUIT
+97 ;
+98 ; Non Covered Days
+99 ; required when the type of bill is 11x,18x,21x or covered days=0
+100 ; remove for IB*2.0*432
+101 ; I IBNCOV="",(IBCTYP!(IBCOV=0)) S IBQUIT=$$IBER(.IBER,115) Q:IBQUIT
+102 ;
+103 ; if cc code=40 then non-covered days must be 1
+104 ; remove for IB*2.0*432
+105 ; I $D(IBCCARY1(40)),IBNCOV'=1 S IBQUIT=$$IBER(.IBER,116) Q:IBQUIT
+106 ;
+107 ; Patient Sex
+108 ; must be "M" or "F"
+109 DO DEM^VADPT
+110 IF $PIECE(VADM(5),U)'="M"
IF $PIECE(VADM(5),U)'="F"
SET IBQUIT=$$IBER(.IBER,124)
if IBQUIT
QUIT
+111 ;
+112 ; esg - 10/17/07 - patch 371
+113 ; For Part A replacement MRA request claims, make sure
+114 ; the Medicare ICN/DCN number is present and also text in FL-80.
+115 IF $$REQMRA^IBEFUNC(IBIFN)
IF $FIND(".137.138.117.118.","."_IBTOB_".")
Begin DoDot:1
+116 NEW IBZ,FL80TXT
+117 ; see CI3-11
DO F^IBCEF("N-CURR INS FORM LOC 64","IBZ",,IBIFN)
+118 ; missing ICN/DCN
IF IBZ=""
SET IBQUIT=$$IBER(.IBER,205)
if IBQUIT
QUIT
+119 SET FL80TXT=$PIECE($GET(^DGCR(399,IBIFN,"UF2")),U,3)
+120 ; missing FL80 text
IF FL80TXT=""
SET IBQUIT=$$IBER(.IBER,206)
if IBQUIT
QUIT
+121 QUIT
End DoDot:1
if IBQUIT
QUIT
+122 ;
+123 DO ^IBCBB4
+124 QUIT
+125 ;
IBER(IBER,ERRNO) ; Sets error list
+1 ; NOTE: add code to check error list > 20 ... If so, display message and
+2 ; quit so we don't get too many errors at once to handle
+3 ; Print all if printing list
+4 ;
+5 IF '$GET(IBQUIT)
Begin DoDot:1
+6 IF ERRNO?1N.N
if $LENGTH(ERRNO)<3
SET ERRNO=$EXTRACT("00",1,3-$LENGTH(ERRNO))_ERRNO
+7 IF $LENGTH(IBER,";")>19
IF '$GET(IBPRT("PRT"))
SET IBER=IBER_"IB999;"
SET IBQUIT=1
+8 IF $GET(IBER)'[("IB"_ERRNO_";")
SET IBER=IBER_"IB"_ERRNO_";"
End DoDot:1
+9 QUIT IBQUIT
+10 ;
NONMCR(IBPR,IBLABS) ; Delete all oxygen and lab, flu shot CPT entries from IBPR
+1 ; IBPR = array subscripted by CPT codes from bill
+2 ; IBLABS = flag returned =1 if labs found on bill
+3 NEW Z
SET IBLABS=0
+4 ; Oxygen
+5 FOR Z="A0422","A4575","A4616","A4619","A4620","A4621","E0455","E1353","E1355"
KILL IBPR(Z)
+6 FOR Z=77:1:85
SET Z0="E13"_Z
KILL IBPR(Z0)
+7 ; Labs
+8 SET Z="80000"
FOR
SET Z=$ORDER(IBPR(Z))
if Z'?1"8"4N
QUIT
SET IBLABS=1
+9 ; Flu shots
+10 FOR Z="90724","G0008","90732","G0009","90657","90658","90659","90660"
KILL IBPR(Z)
+11 QUIT
+12 ;
MCRANUM(IBIFN) ; Determine MEDICARE A provider ID # from bedsection for
+1 ; bill ien IBIFN
+2 NEW IBX
+3 ; PART A MRA (only) needed - determine if psych/non-psych claim
+4 NEW IBX,IBI
+5 SET IBI=$PIECE($GET(^DGCR(399,IBIFN,"U")),U,11)
+6 SET IBX=$SELECT($TRANSLATE($PIECE($GET(^DGCR(399.1,+IBI,0)),U),"psych","PSYCH")'["PSYCH":670899,1:674499)
+7 QUIT IBX
+8 ;
MCRACK(IBIFN,X,IBFLD) ; Check for MEDICARE A for bill IBIFN
+1 ; Called from CLAIM STATUS MRA field (#24) xrefs in file 399
+2 ; X = current value of field 399;24
+3 ; IBFLD = 1 for primary ins co, 2 for secondary, 3 for tertiary
+4 NEW IB
+5 SET IB=0
+6 IF +X
IF $$COBN^IBCEF(IBIFN)=IBFLD
IF $$WNRBILL^IBEFUNC(IBIFN,IBFLD)
IF $$MRATYPE^IBEFUNC(IBIFN,"C")="A"
SET IB=1
+7 QUIT IB
+8 ;
GYMODCHK(Z) ; GY modifier check procedure. IB*2*377 - 2/4/08
+1 ; Z is the IBXDATA(IBI) service line EDI
+2 NEW MODS
+3 ; error already found
IF IBER["IB123"
QUIT
+4 ; list of modifiers separated by commas
SET MODS=$PIECE(Z,U,9)
+5 ; GY modifier not here on this line item
IF MODS'["GY"
QUIT
+6 ; non-covered charges exist on this line item
IF $PIECE(Z,U,6)
QUIT
+7 SET IBQUIT=$$IBER(.IBER,123)
GYMODX ;
+1 QUIT
+2 ;
