Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCBB3

IBCBB3.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EDITMRA(IBQUIT,IBER,IBIFN,IBFT) ;
  1. ; Requires execution of GVAR^IBCBB, IBIFN defined
  1. ; File IB ERROR (350.8) contains error codes/text
  1. ;
  1. N IBMRATYP,Z,IBZP,IBZP1,IBOK
  1. S IBQUIT=0 ;Flag to say we have too many errors - quit edits
  1. ;
  1. S IBMRATYP=$$MRATYPE^IBEFUNC(IBIFN,"C")
  1. ;
  1. I IBFT=3 D
  1. . D PARTA
  1. I IBFT=2 D PARTB^IBCBB9
  1. ;
  1. K IBXDATA D F^IBCEF("N-ADMITTING DIAGNOSIS",,,IBIFN)
  1. ; Req. for UB-04 type of bills 11x!18x
  1. I $G(IBXDATA)="",IBFT=3 D Q:IBQUIT
  1. . N Z
  1. . I "^11^18^"[(U_IBTOB12_U) S IBQUIT=$$IBER(.IBER,231) Q
  1. . I $$INPAT^IBCEF(IBIFN,1) S Z="Admitting Diagnosis may be required by payer, please verify" D WARN^IBCBB11(Z)
  1. ;
  1. D GETPRV^IBCEU(IBIFN,"2,3,4",.Z)
  1. 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
  1. D ALLPROC^IBCVA1(IBIFN,.IBZP1)
  1. ;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.
  1. ;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
  1. ;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")
  1. ; JWS;IB*2.0*592 US1108 - Dental form check
  1. I IBFT=2!(IBFT=7) D EN^IBCBB2
  1. ; edit checks for UB-04 (institutional) forms
  1. I IBFT=3 D EN^IBCBB21(.IBZPRC92)
  1. ;
  1. Q
  1. ;
  1. PARTA ; MEDICARE specific edit checks for PART A claims (UB-04 formats)
  1. ;
  1. N IBI,IBJ,IBX,IBCTYP,VADM,VAPA,IBSTOP,IBDXC,IBDXARY,IBPR,IBLABS,REQMRA
  1. N IBS,IBTUNIT,IBCAGE,IBREV1,IBOCCS,IBOCSDT,IBVALCD,IBOCCD,IBNOPR
  1. N IBCCARY1,IBPATST,IBZADMIT,IBZDISCH,IBXIEN,IBXERR,IBXDATA,IBOCSP
  1. N IBCOV,IBNCOV,IBREVC,IBREVDUP,IBBCPT,IBREVC12,IBREVTOT,IBECAT,IBINC
  1. ;
  1. ; Medicare is the current payer, but no diagnosis codes
  1. I $$WNRBILL^IBEFUNC(IBIFN) D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBQUIT=$$IBER(.IBER,120) Q:IBQUIT
  1. ;
  1. ; Type of Bill must be three digits
  1. I IBTOB'?3N S X=$$IBER(.IBER,103) Q
  1. ;
  1. ; Covered Days
  1. S IBCTYP=0
  1. S IBCOV=$P(IBNDU2,U,2),IBNCOV=$P(IBNDU2,U,3)
  1. ;
  1. ; If interim bill, covered days must not be greater than 60
  1. ; remove for IB*2.0*432
  1. ; I "23"[$E(IBTOB,3),IBCOV>60 S IBQUIT=$$IBER(.IBER,"096") Q:IBQUIT
  1. ;
  1. ; I bill type is 11x or 18x or 21x then we need covered days
  1. ; remove for IB*2.0*432
  1. ; I "^11^18^21^"[(U_IBTOB12_U) S IBCTYP=1 I IBCOV="" S IBQUIT=$$IBER(.IBER,106) Q:IBQUIT
  1. ;
  1. S (IBI,IBJ)=0
  1. K IBXDATA D F^IBCEF("N-CONDITION CODES",,,IBIFN)
  1. ; Re-sort the condition codes by code
  1. S IBI=0 F S IBI=$O(IBXDATA(IBI)) Q:'IBI S IBCCARY1($P(IBXDATA(IBI),U))=""
  1. ;
  1. ; for condition code 40, covered days must be 0
  1. ; remove for IB*2.0*432
  1. ; I $D(IBCCARY1(40)),IBCOV'=0 S IBQUIT=$$IBER(.IBER,107) Q:IBQUIT
  1. ;
  1. ; cov days+non=to date -from date unless the patient status = 30 (still
  1. ; pt) or outpatient or if the to date and from date are same then add 1
  1. S IBPATST="",IBX=$P(IBNDU,U,12),IBPATST=$P($G(^DGCR(399.1,+IBX,0)),U,2)
  1. S IBINC=$S(IBPATST=30!(IBFDT=IBTDT):1,1:0)
  1. ; remove for IB*2.0*432
  1. ;I $$INPAT^IBCEF(IBIFN,1),(IBCOV+IBNCOV)'=($$FMDIFF^XLFDT(IBTDT,IBFDT)+IBINC) S IBQUIT=$$IBER(.IBER,108) Q:IBQUIT
  1. ;
  1. ; if covered days >100 and type of bill is 21x or 18x error
  1. ; remove for IB*2.0*432
  1. ; I IBCOV>100,(IBTOB12=18!(IBTOB12=21)) S IBQUIT=$$IBER(.IBER,109) Q:IBQUIT
  1. ;
  1. S (IBJ,IBTUNIT,IBS,IBREVTOT("AC"),IBREVTOT("AI"),IBREVTOT("AO"),IBREVTOT)=0
  1. ;
  1. K IBXDATA D F^IBCEF("N-UB-04 SERVICE LINE (EDI)",,,IBIFN) ;Get rev codes
  1. ;
  1. ; Re-sort the revenue codes by code
  1. ;>> IBREV1(rev code,x)=Rev code^ptr cpt^unit chg^units^total^tot unc
  1. ; IBREV1(rev code) = revenue code edit category
  1. ;
  1. ; IBNOPR = flag that determines if there are revenue codes with
  1. ; charges that do not have a procedure - no need to check
  1. ; for billable MCR procedures if at least one RC is billable
  1. ; 1 = there is at least one billable revenue code without a
  1. ; procedure
  1. ;
  1. S REQMRA=$$REQMRA^IBEFUNC(IBIFN)
  1. S (IBNOPR,IBI)=0
  1. F S IBI=$O(IBXDATA(IBI)) Q:'IBI D
  1. . I REQMRA D GYMODCHK(IBXDATA(IBI)) ; IB*2*377 GY modifier check
  1. . S IBJ=$P(IBXDATA(IBI),U),IBECAT=""
  1. . I 'IBNOPR D
  1. .. I $P(IBXDATA(IBI),U,2)'="" S IBPR($P(IBXDATA(IBI),U,2))=IBI Q
  1. .. S IBNOPR=1 K IBPR
  1. . S:$D(IBREV1(IBJ)) IBECAT=$G(IBREV1(IBJ))
  1. . I '$D(IBREV1(IBJ))!(IBECAT="") D S IBREV1(IBJ)=IBECAT
  1. . . ;
  1. . . ; Accomodations (AC)
  1. . . I (IBJ'<100&(IBJ'>219))!(IBJ=224) S IBECAT="AC" Q
  1. . . ;
  1. . . ; Ancillary Outpatient (AO)
  1. . . I '$$INPAT^IBCEF(IBIFN,1) S IBECAT="AO" Q
  1. . . ;
  1. . . ; Ancillary Inpatient (AI)
  1. . . S IBECAT="AI"
  1. . ;
  1. . S IBREV1(IBJ,+$O(IBREV1(IBJ,""),-1)+1)=IBXDATA(IBI)
  1. . S IBREVTOT(IBECAT)=IBREVTOT(IBECAT)+$P(IBXDATA(IBI),U,6)
  1. . I IBECAT="AC" S IBTUNIT=IBTUNIT+$P(IBXDATA(IBI),U,4)
  1. ;
  1. I $$NEEDMRA^IBEFUNC(IBIFN),$O(IBPR(""))'="" D Q:IBQUIT
  1. . ; Don't allow a bill containing only billable procedures for:
  1. . ; Oxygen, labs, or influenza shots
  1. . ; OR a bill with prosthetics on it
  1. . ; to be sent to MEDICARE for an MRA
  1. . D NONMCR(.IBPR,.IBLABS) ; Remove Oxygen, labs, influenza shots
  1. . 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
  1. . I $O(IBPR(""))="" D
  1. .. S IBQUIT=$$IBER(.IBER,"098")
  1. ;
  1. ; covered days+non covered = units of accom rev codes
  1. ; Check room and board
  1. ; remove for IB*2.0*432
  1. ;I IBTUNIT,IBTUNIT'=(IBCOV+IBNCOV) S IBQUIT=$$IBER(.IBER,114) Q:IBQUIT
  1. ;
  1. ; Non Covered Days
  1. ; required when the type of bill is 11x,18x,21x or covered days=0
  1. ; remove for IB*2.0*432
  1. ; I IBNCOV="",(IBCTYP!(IBCOV=0)) S IBQUIT=$$IBER(.IBER,115) Q:IBQUIT
  1. ;
  1. ; if cc code=40 then non-covered days must be 1
  1. ; remove for IB*2.0*432
  1. ; I $D(IBCCARY1(40)),IBNCOV'=1 S IBQUIT=$$IBER(.IBER,116) Q:IBQUIT
  1. ;
  1. ; Patient Sex
  1. ; must be "M" or "F"
  1. D DEM^VADPT
  1. I $P(VADM(5),U)'="M",$P(VADM(5),U)'="F" S IBQUIT=$$IBER(.IBER,124) Q:IBQUIT
  1. ;
  1. ; esg - 10/17/07 - patch 371
  1. ; For Part A replacement MRA request claims, make sure
  1. ; the Medicare ICN/DCN number is present and also text in FL-80.
  1. I $$REQMRA^IBEFUNC(IBIFN),$F(".137.138.117.118.","."_IBTOB_".") D Q:IBQUIT
  1. . N IBZ,FL80TXT
  1. . D F^IBCEF("N-CURR INS FORM LOC 64","IBZ",,IBIFN) ; see CI3-11
  1. . I IBZ="" S IBQUIT=$$IBER(.IBER,205) Q:IBQUIT ; missing ICN/DCN
  1. . S FL80TXT=$P($G(^DGCR(399,IBIFN,"UF2")),U,3)
  1. . I FL80TXT="" S IBQUIT=$$IBER(.IBER,206) Q:IBQUIT ; missing FL80 text
  1. . Q
  1. ;
  1. D ^IBCBB4
  1. Q
  1. ;
  1. IBER(IBER,ERRNO) ; Sets error list
  1. ; NOTE: add code to check error list > 20 ... If so, display message and
  1. ; quit so we don't get too many errors at once to handle
  1. ; Print all if printing list
  1. ;
  1. I '$G(IBQUIT) D
  1. . I ERRNO?1N.N S:$L(ERRNO)<3 ERRNO=$E("00",1,3-$L(ERRNO))_ERRNO
  1. . I $L(IBER,";")>19,'$G(IBPRT("PRT")) S IBER=IBER_"IB999;",IBQUIT=1
  1. . I $G(IBER)'[("IB"_ERRNO_";") S IBER=IBER_"IB"_ERRNO_";"
  1. Q IBQUIT
  1. ;
  1. NONMCR(IBPR,IBLABS) ; Delete all oxygen and lab, flu shot CPT entries from IBPR
  1. ; IBPR = array subscripted by CPT codes from bill
  1. ; IBLABS = flag returned =1 if labs found on bill
  1. N Z S IBLABS=0
  1. ; Oxygen
  1. F Z="A0422","A4575","A4616","A4619","A4620","A4621","E0455","E1353","E1355" K IBPR(Z)
  1. F Z=77:1:85 S Z0="E13"_Z K IBPR(Z0)
  1. ; Labs
  1. S Z="80000" F S Z=$O(IBPR(Z)) Q:Z'?1"8"4N S IBLABS=1
  1. ; Flu shots
  1. F Z="90724","G0008","90732","G0009","90657","90658","90659","90660" K IBPR(Z)
  1. Q
  1. ;
  1. MCRANUM(IBIFN) ; Determine MEDICARE A provider ID # from bedsection for
  1. ; bill ien IBIFN
  1. N IBX
  1. ; PART A MRA (only) needed - determine if psych/non-psych claim
  1. N IBX,IBI
  1. S IBI=$P($G(^DGCR(399,IBIFN,"U")),U,11)
  1. S IBX=$S($TR($P($G(^DGCR(399.1,+IBI,0)),U),"psych","PSYCH")'["PSYCH":670899,1:674499)
  1. Q IBX
  1. ;
  1. MCRACK(IBIFN,X,IBFLD) ; Check for MEDICARE A for bill IBIFN
  1. ; Called from CLAIM STATUS MRA field (#24) xrefs in file 399
  1. ; X = current value of field 399;24
  1. ; IBFLD = 1 for primary ins co, 2 for secondary, 3 for tertiary
  1. N IB
  1. S IB=0
  1. I +X,$$COBN^IBCEF(IBIFN)=IBFLD,$$WNRBILL^IBEFUNC(IBIFN,IBFLD),$$MRATYPE^IBEFUNC(IBIFN,"C")="A" S IB=1
  1. Q IB
  1. ;
  1. GYMODCHK(Z) ; GY modifier check procedure. IB*2*377 - 2/4/08
  1. ; Z is the IBXDATA(IBI) service line EDI
  1. N MODS
  1. I IBER["IB123" Q ; error already found
  1. S MODS=$P(Z,U,9) ; list of modifiers separated by commas
  1. I MODS'["GY" Q ; GY modifier not here on this line item
  1. I $P(Z,U,6) Q ; non-covered charges exist on this line item
  1. S IBQUIT=$$IBER(.IBER,123)
  1. GYMODX ;
  1. Q
  1. ;