- 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 Feb 18, 2025@23:35:17 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 ;