- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCBB3.m
r613 r623 1 IBCBB3 ;ALB/TMP - CONTINUATION OF EDIT CHECKS ROUTINE (MEDICARE) ;06/23/98 2 ;;2.0;INTEGRATED BILLING;**51,137,155,349,371,377**;21-MAR-94;Build 23 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EDITMRA(IBQUIT,IBER,IBIFN,IBFT) ; 6 ; Requires execution of GVAR^IBCBB, IBIFN defined 7 ; File IB ERROR (350.8) contains error codes/text 8 ; 9 N IBMRATYP,Z,IBZP,IBZP1,IBOK 10 S IBQUIT=0 ;Flag to say we have too many errors - quit edits 11 ; 12 S IBMRATYP=$$MRATYPE^IBEFUNC(IBIFN,"C") 13 ; 14 I IBFT=3 D 15 . D PARTA 16 ; 17 I IBFT=2 D PARTB^IBCBB9 18 ; 19 K IBXDATA D F^IBCEF("N-ADMITTING DIAGNOSIS",,,IBIFN) 20 ; Req. for UB-04 type of bills 11x!18x 21 I $G(IBXDATA)="",IBFT=3 D Q:IBQUIT 22 . N Z 23 . I "^11^18^"[(U_IBTOB12_U) S IBQUIT=$$IBER(.IBER,231) Q 24 . I $$INPAT^IBCEF(IBIFN,1) S Z="Admitting Diagnosis may be required by payer, please verify" D WARN^IBCBB11(Z) 25 ; 26 D GETPRV^IBCEU(IBIFN,"2,3,4",.Z) 27 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 28 D ALLPROC^IBCVA1(IBIFN,.IBZP1) 29 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 30 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") 31 I IBFT=2 D EN^IBCBB2 32 ; edit checks for UB-04 (institutional) forms 33 I IBFT=3 D EN^IBCBB21(.IBZPRC92) 34 ; 35 Q 36 ; 37 PARTA ; MEDICARE specific edit checks for PART A claims (UB-04 formats) 38 ; 39 N IBI,IBJ,IBX,IBCTYP,VADM,VAPA,IBSTOP,IBDXC,IBDXARY,IBPR,IBLABS,REQMRA 40 N IBS,IBTUNIT,IBCAGE,IBREV1,IBOCCS,IBOCSDT,IBVALCD,IBOCCD,IBNOPR 41 N IBCCARY1,IBPATST,IBZADMIT,IBZDISCH,IBXIEN,IBXERR,IBXDATA,IBOCSP 42 N IBCOV,IBNCOV,IBREVC,IBREVDUP,IBBCPT,IBREVC12,IBREVTOT,IBECAT,IBINC 43 ; 44 ; Medicare is the current payer, but no diagnosis codes 45 I $$WNRBILL^IBEFUNC(IBIFN) D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBQUIT=$$IBER(.IBER,120) Q:IBQUIT 46 ; 47 ; Type of Bill must be three digits 48 I IBTOB'?3N S X=$$IBER(.IBER,103) Q 49 ; 50 ; Covered Days 51 S IBCTYP=0 52 S IBCOV=$P(IBNDU2,U,2),IBNCOV=$P(IBNDU2,U,3) 53 ; 54 ; If interim bill, covered days must not be greater than 60 55 I "23"[$E(IBTOB,3),IBCOV>60 S IBQUIT=$$IBER(.IBER,"096") Q:IBQUIT 56 ; 57 ; I bill type is 11x or 18x or 21x then we need covered days 58 I "^11^18^21^"[(U_IBTOB12_U) S IBCTYP=1 I IBCOV="" S IBQUIT=$$IBER(.IBER,106) Q:IBQUIT 59 ; 60 S (IBI,IBJ)=0 61 K IBXDATA D F^IBCEF("N-CONDITION CODES",,,IBIFN) 62 ; Re-sort the condition codes by code 63 S IBI=0 F S IBI=$O(IBXDATA(IBI)) Q:'IBI S IBCCARY1($P(IBXDATA(IBI),U))="" 64 ; 65 ; for condition code 40, covered days must be 0 66 I $D(IBCCARY1(40)),IBCOV'=0 S IBQUIT=$$IBER(.IBER,107) Q:IBQUIT 67 ; 68 ; cov days+non=to date -from date unless the patient status = 30 (still 69 ; pt) or outpatient or if the to date and from date are same then add 1 70 S IBPATST="",IBX=$P(IBNDU,U,12),IBPATST=$P($G(^DGCR(399.1,+IBX,0)),U,2) 71 S IBINC=$S(IBPATST=30!(IBFDT=IBTDT):1,1:0) 72 I $$INPAT^IBCEF(IBIFN,1),(IBCOV+IBNCOV)'=($$FMDIFF^XLFDT(IBTDT,IBFDT)+IBINC) S IBQUIT=$$IBER(.IBER,108) Q:IBQUIT 73 ; 74 ; if covered days >100 and type of bill is 21x or 18x error 75 I IBCOV>100,(IBTOB12=18!(IBTOB12=21)) S IBQUIT=$$IBER(.IBER,109) Q:IBQUIT 76 ; 77 S (IBJ,IBTUNIT,IBS,IBREVTOT("AC"),IBREVTOT("AI"),IBREVTOT("AO"),IBREVTOT)=0 78 ; 79 K IBXDATA D F^IBCEF("N-UB-04 SERVICE LINE (EDI)",,,IBIFN) ;Get rev codes 80 ; 81 ; Re-sort the revenue codes by code 82 ;>> IBREV1(rev code,x)=Rev code^ptr cpt^unit chg^units^total^tot unc 83 ; IBREV1(rev code) = revenue code edit category 84 ; 85 ; IBNOPR = flag that determines if there are revenue codes with 86 ; charges that do not have a procedure - no need to check 87 ; for billable MCR procedures if at least one RC is billable 88 ; 1 = there is at least one billable revenue code without a 89 ; procedure 90 ; 91 S REQMRA=$$REQMRA^IBEFUNC(IBIFN) 92 S (IBNOPR,IBI)=0 93 F S IBI=$O(IBXDATA(IBI)) Q:'IBI D 94 . I REQMRA D GYMODCHK(IBXDATA(IBI)) ; IB*2*377 GY modifier check 95 . S IBJ=$P(IBXDATA(IBI),U),IBECAT="" 96 . I 'IBNOPR D 97 .. I $P(IBXDATA(IBI),U,2)'="" S IBPR($P(IBXDATA(IBI),U,2))=IBI Q 98 .. S IBNOPR=1 K IBPR 99 . S:$D(IBREV1(IBJ)) IBECAT=$G(IBREV1(IBJ)) 100 . I '$D(IBREV1(IBJ))!(IBECAT="") D S IBREV1(IBJ)=IBECAT 101 . . ; 102 . . ; Accomodations (AC) 103 . . I (IBJ'<100&(IBJ'>219))!(IBJ=224) S IBECAT="AC" Q 104 . . ; 105 . . ; Ancillary Outpatient (AO) 106 . . I '$$INPAT^IBCEF(IBIFN,1) S IBECAT="AO" Q 107 . . ; 108 . . ; Ancillary Inpatient (AI) 109 . . S IBECAT="AI" 110 . ; 111 . S IBREV1(IBJ,+$O(IBREV1(IBJ,""),-1)+1)=IBXDATA(IBI) 112 . S IBREVTOT(IBECAT)=IBREVTOT(IBECAT)+$P(IBXDATA(IBI),U,6) 113 . I IBECAT="AC" S IBTUNIT=IBTUNIT+$P(IBXDATA(IBI),U,4) 114 ; 115 I $$NEEDMRA^IBEFUNC(IBIFN),$O(IBPR(""))'="" D Q:IBQUIT 116 . ; Don't allow a bill containing only billable procedures for: 117 . ; Oxygen, labs, or influenza shots 118 . ; OR a bill with prosthetics on it 119 . ; to be sent to MEDICARE for an MRA 120 . D NONMCR(.IBPR,.IBLABS) ; Remove Oxygen, labs, influenza shots 121 . I $G(IBLABS) D WARN^IBCBB11("The only possible billable procedures on this bill are labs -"),WARN^IBCBB11(" Please verify that MEDICARE does not reimburse these labs at 100%") Q 122 . I $O(IBPR(""))="" D 123 .. S IBQUIT=$$IBER(.IBER,"098") 124 ; 125 ; covered days+non covered = units of accom rev codes 126 ; Check room and board 127 I IBTUNIT,IBTUNIT'=(IBCOV+IBNCOV) S IBQUIT=$$IBER(.IBER,114) Q:IBQUIT 128 ; 129 ; Non Covered Days 130 ; required when the type of bill is 11x,18x,21x or covered days=0 131 I IBNCOV="",(IBCTYP!(IBCOV=0)) S IBQUIT=$$IBER(.IBER,115) Q:IBQUIT 132 ; 133 ; if cc code=40 then non-covered days must be 1 134 I $D(IBCCARY1(40)),IBNCOV'=1 S IBQUIT=$$IBER(.IBER,116) Q:IBQUIT 135 ; 136 ; Patient Sex 137 ; must be "M" or "F" 138 D DEM^VADPT 139 I $P(VADM(5),U)'="M",$P(VADM(5),U)'="F" S IBQUIT=$$IBER(.IBER,124) Q:IBQUIT 140 ; 141 ; esg - 10/17/07 - patch 371 142 ; For Part A replacement MRA request claims, make sure 143 ; the Medicare ICN/DCN number is present and also text in FL-80. 144 I $$REQMRA^IBEFUNC(IBIFN),$F(".137.138.117.118.","."_IBTOB_".") D Q:IBQUIT 145 . N IBZ,FL80TXT 146 . D F^IBCEF("N-CURR INS FORM LOC 64","IBZ",,IBIFN) ; see CI3-11 147 . I IBZ="" S IBQUIT=$$IBER(.IBER,205) Q:IBQUIT ; missing ICN/DCN 148 . S FL80TXT=$P($G(^DGCR(399,IBIFN,"UF2")),U,3) 149 . I FL80TXT="" S IBQUIT=$$IBER(.IBER,206) Q:IBQUIT ; missing FL80 text 150 . Q 151 ; 152 D ^IBCBB4 153 Q 154 ; 155 IBER(IBER,ERRNO) ; Sets error list 156 ; NOTE: add code to check error list > 20 ... If so, display message and 157 ; quit so we don't get too many errors at once to handle 158 ; Print all if printing list 159 ; 160 I '$G(IBQUIT) D 161 . I ERRNO?1N.N S:$L(ERRNO)<3 ERRNO=$E("00",1,3-$L(ERRNO))_ERRNO 162 . I $L(IBER,";")>19,'$G(IBPRT("PRT")) S IBER=IBER_"IB999;",IBQUIT=1 163 . I $G(IBER)'[("IB"_ERRNO_";") S IBER=IBER_"IB"_ERRNO_";" 164 Q IBQUIT 165 ; 166 NONMCR(IBPR,IBLABS) ; Delete all oxygen and lab, flu shot CPT entries from IBPR 167 ; IBPR = array subscripted by CPT codes from bill 168 ; IBLABS = flag returned =1 if labs found on bill 169 N Z S IBLABS=0 170 ; Oxygen 171 F Z="A0422","A4575","A4616","A4619","A4620","A4621","E0455","E1353","E1355" K IBPR(Z) 172 F Z=77:1:85 S Z0="E13"_Z K IBPR(Z0) 173 ; Labs 174 S Z="80000" F S Z=$O(IBPR(Z)) Q:Z'?1"8"4N S IBLABS=1 175 ; Flu shots 176 F Z="90724","G0008","90732","G0009","90657","90658","90659","90660" K IBPR(Z) 177 Q 178 ; 179 MCRANUM(IBIFN) ; Determine MEDICARE A provider ID # from bedsection for 180 ; bill ien IBIFN 181 N IBX 182 ; PART A MRA (only) needed - determine if psych/non-psych claim 183 N IBX,IBI 184 S IBI=$P($G(^DGCR(399,IBIFN,"U")),U,11) 185 S IBX=$S($TR($P($G(^DGCR(399.1,+IBI,0)),U),"psych","PSYCH")'["PSYCH":670899,1:674499) 186 Q IBX 187 ; 188 MCRACK(IBIFN,X,IBFLD) ; Check for MEDICARE A for bill IBIFN 189 ; Called from CLAIM STATUS MRA field (#24) xrefs in file 399 190 ; X = current value of field 399;24 191 ; IBFLD = 1 for primary ins co, 2 for secondary, 3 for tertiary 192 N IB 193 S IB=0 194 I +X,$$COBN^IBCEF(IBIFN)=IBFLD,$$WNRBILL^IBEFUNC(IBIFN,IBFLD),$$MRATYPE^IBEFUNC(IBIFN,"C")="A" S IB=1 195 Q IB 196 ; 197 GYMODCHK(Z) ; GY modifier check procedure. IB*2*377 - 2/4/08 198 ; Z is the IBXDATA(IBI) service line EDI 199 N MODS 200 I IBER["IB123" Q ; error already found 201 S MODS=$P(Z,U,9) ; list of modifiers separated by commas 202 I MODS'["GY" Q ; GY modifier not here on this line item 203 I $P(Z,U,6) Q ; non-covered charges exist on this line item 204 S IBQUIT=$$IBER(.IBER,123) 205 GYMODX ; 206 Q 207 ; 1 IBCBB3 ;ALB/TMP - CONTINUATION OF EDIT CHECKS ROUTINE (MEDICARE) ;06/23/98 2 ;;2.0;INTEGRATED BILLING;**51,137,155,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 EDITMRA(IBQUIT,IBER,IBIFN,IBFT) ; 6 ; Requires execution of GVAR^IBCBB, IBIFN defined 7 ; File IB ERROR (350.8) contains error codes/text 8 ; 9 N IBMRATYP,Z,IBZP,IBZP1,IBOK 10 S IBQUIT=0 ;Flag to say we have too many errors - quit edits 11 ; 12 S IBMRATYP=$$MRATYPE^IBEFUNC(IBIFN,"C") 13 ; 14 I IBFT=3 D 15 . D PARTA 16 ; 17 I IBFT=2 D PARTB^IBCBB9 18 ; 19 K IBXDATA D F^IBCEF("N-ADMITTING DIAGNOSIS",,,IBIFN) 20 ; Req. for UB-04 type of bills 11x!18x 21 I $G(IBXDATA)="",IBFT=3 D Q:IBQUIT 22 . N Z 23 . I "^11^18^"[(U_IBTOB12_U) S IBQUIT=$$IBER^IBCBB3(.IBER,231) Q 24 . I $$INPAT^IBCEF(IBIFN,1) S Z="Admitting Diagnosis may be required by payer, please verify" D WARN^IBCBB11(Z) 25 ; 26 D GETPRV^IBCEU(IBIFN,"2,3,4",.Z) 27 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 28 D ALLPROC^IBCVA1(IBIFN,.IBZP1) 29 S Z=0 F S Z=$O(IBZP1(Z)) Q:'Z I $P(IBZP1(Z),U,18),(U_$P(IBZP1(Z),U,18)_U)'[IBZP S IBOK=0 Q 30 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") 31 I IBFT=2 D EN^IBCBB2 32 ; edit checks for UB-04 (institutional) forms 33 I IBFT=3 D EN^IBCBB21(.IBZPRC92) 34 ; 35 Q 36 ; 37 PARTA ; MEDICARE specific edit checks for PART A claims (UB-04 formats) 38 ; 39 N IBI,IBJ,IBX,IBCTYP,VADM,VAPA,IBSTOP,IBDXC,IBDXARY,IBPR,IBLABS 40 N IBS,IBTUNIT,IBCAGE,IBREV1,IBOCCS,IBOCSDT,IBVALCD,IBOCCD,IBNOPR 41 N IBCCARY1,IBPATST,IBZADMIT,IBZDISCH,IBXIEN,IBXERR,IBXDATA,IBOCSP 42 N IBCOV,IBNCOV,IBREVC,IBREVDUP,IBBCPT,IBREVC12,IBREVTOT,IBECAT,IBINC 43 ; 44 ; Medicare is the current payer, but no diagnosis codes 45 I $$WNRBILL^IBEFUNC(IBIFN) D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBQUIT=$$IBER(.IBER,120) Q:IBQUIT 46 ; 47 ; Type of Bill must be three digits 48 I IBTOB'?3N S X=$$IBER(.IBER,103) Q 49 ; 50 ; Covered Days 51 S IBCTYP=0 52 S IBCOV=$P(IBNDU2,U,2),IBNCOV=$P(IBNDU2,U,3) 53 ; 54 ; If interim bill, covered days must not be greater than 60 55 I "23"[$E(IBTOB,3),IBCOV>60 S IBQUIT=$$IBER(.IBER,"096") Q:IBQUIT 56 ; 57 ; I bill type is 11x or 18x or 21x then we need covered days 58 I "^11^18^21^"[(U_IBTOB12_U) S IBCTYP=1 I IBCOV="" S IBQUIT=$$IBER(.IBER,106) Q:IBQUIT 59 ; 60 S (IBI,IBJ)=0 61 K IBXDATA D F^IBCEF("N-CONDITION CODES",,,IBIFN) 62 ; Re-sort the condition codes by code 63 S IBI=0 F S IBI=$O(IBXDATA(IBI)) Q:'IBI S IBCCARY1($P(IBXDATA(IBI),U))="" 64 ; 65 ; for condition code 40, covered days must be 0 66 I $D(IBCCARY1(40)),IBCOV'=0 S IBQUIT=$$IBER(.IBER,107) Q:IBQUIT 67 ; 68 ; cov days+non=to date -from date unless the patient status = 30 (still 69 ; pt) or outpatient or if the to date and from date are same then add 1 70 S IBPATST="",IBX=$P(IBNDU,U,12),IBPATST=$P($G(^DGCR(399.1,+IBX,0)),U,2) 71 S IBINC=$S(IBPATST=30!(IBFDT=IBTDT):1,1:0) 72 I $$INPAT^IBCEF(IBIFN,1),(IBCOV+IBNCOV)'=($$FMDIFF^XLFDT(IBTDT,IBFDT)+IBINC) S IBQUIT=$$IBER(.IBER,108) Q:IBQUIT 73 ; 74 ; if covered days >100 and type of bill is 21x or 18x error 75 I IBCOV>100,(IBTOB12=18!(IBTOB12=21)) S IBQUIT=$$IBER(.IBER,109) Q:IBQUIT 76 ; 77 S (IBJ,IBTUNIT,IBS,IBREVTOT("AC"),IBREVTOT("AI"),IBREVTOT("AO"),IBREVTOT)=0 78 ; 79 K IBXDATA D F^IBCEF("N-UB-04 SERVICE LINE (EDI)",,,IBIFN) ;Get rev codes 80 ; 81 ; Re-sort the revenue codes by code 82 ;>> IBREV1(rev code,x)=Rev code^ptr cpt^unit chg^units^total^tot unc 83 ; IBREV1(rev code) = revenue code edit category 84 ; 85 ; IBNOPR = flag that determines if there are revenue codes with 86 ; charges that do not have a procedure - no need to check 87 ; for billable MCR procedures if at least one RC is billable 88 ; 1 = there is at least one billable revenue code without a 89 ; procedure 90 ; 91 S (IBNOPR,IBI)=0 92 F S IBI=$O(IBXDATA(IBI)) Q:'IBI D 93 . S IBJ=$P(IBXDATA(IBI),U),IBECAT="" 94 . I 'IBNOPR D 95 .. I $P(IBXDATA(IBI),U,2)'="" S IBPR($P(IBXDATA(IBI),U,2))=IBI Q 96 .. S IBNOPR=1 K IBPR 97 . S:$D(IBREV1(IBJ)) IBECAT=$G(IBREV1(IBJ)) 98 . I '$D(IBREV1(IBJ))!(IBECAT="") D S IBREV1(IBJ)=IBECAT 99 . . ; 100 . . ; Accomodations (AC) 101 . . I (IBJ'<100&(IBJ'>219))!(IBJ=224) S IBECAT="AC" Q 102 . . ; 103 . . ; Ancillary Outpatient (AO) 104 . . I '$$INPAT^IBCEF(IBIFN,1) S IBECAT="AO" Q 105 . . ; 106 . . ; Ancillary Inpatient (AI) 107 . . S IBECAT="AI" 108 . ; 109 . S IBREV1(IBJ,+$O(IBREV1(IBJ,""),-1)+1)=IBXDATA(IBI) 110 . S IBREVTOT(IBECAT)=IBREVTOT(IBECAT)+$P(IBXDATA(IBI),U,6) 111 . I IBECAT="AC" S IBTUNIT=IBTUNIT+$P(IBXDATA(IBI),U,4) 112 ; 113 I $$NEEDMRA^IBEFUNC(IBIFN),$O(IBPR(""))'="" D Q:IBQUIT 114 . ; Don't allow a bill containing only billable procedures for: 115 . ; Oxygen, labs, or influenza shots 116 . ; OR a bill with prosthetics on it 117 . ; to be sent to MEDICARE for an MRA 118 . D NONMCR(.IBPR,.IBLABS) ; Remove Oxygen, labs, influenza shots 119 . ;I $O(IBPR(""))="" D 120 . I $G(IBLABS) D WARN^IBCBB11("The only possible billable procedures on this bill are labs -"),WARN^IBCBB11(" Please verify that MEDICARE does not reimburse these labs at 100%") Q 121 . I $O(IBPR(""))="" D 122 .. S IBQUIT=$$IBER(.IBER,"098") 123 ; 124 ; covered days+non covered = units of accom rev codes 125 ; Check room and board 126 I IBTUNIT,IBTUNIT'=(IBCOV+IBNCOV) S IBQUIT=$$IBER(.IBER,114) Q:IBQUIT 127 ; 128 ; Non Covered Days 129 ; required when the type of bill is 11x,18x,21x or covered days=0 130 I IBNCOV="",(IBCTYP!(IBCOV=0)) S IBQUIT=$$IBER(.IBER,115) Q:IBQUIT 131 ; 132 ; if cc code=40 then non-covered days must be 1 133 I $D(IBCCARY1(40)),IBNCOV'=1 S IBQUIT=$$IBER(.IBER,116) Q:IBQUIT 134 ; 135 ; Patient Sex 136 ; must be "M" or "F" 137 D DEM^VADPT 138 I $P(VADM(5),U)'="M",$P(VADM(5),U)'="F" S IBQUIT=$$IBER(.IBER,124) Q:IBQUIT 139 ; 140 D ^IBCBB4 141 Q 142 ; 143 IBER(IBER,ERRNO) ; Sets error list 144 ; NOTE: add code to check error list > 20 ... If so, display message and 145 ; quit so we don't get too many errors at once to handle 146 ; Print all if printing list 147 ; 148 I '$G(IBQUIT) D 149 . I ERRNO?1N.N S:$L(ERRNO)<3 ERRNO=$E("00",1,3-$L(ERRNO))_ERRNO 150 . I $L(IBER,";")>19,'$G(IBPRT("PRT")) S IBER=IBER_"IB999;",IBQUIT=1 151 . I $G(IBER)'[("IB"_ERRNO_";") S IBER=IBER_"IB"_ERRNO_";" 152 Q IBQUIT 153 ; 154 NONMCR(IBPR,IBLABS) ; Delete all oxygen and lab, flu shot CPT entries from IBPR 155 ; IBPR = array subscripted by CPT codes from bill 156 ; IBLABS = flag returned =1 if labs found on bill 157 N Z S IBLABS=0 158 ; Oxygen 159 F Z="A0422","A4575","A4616","A4619","A4620","A4621","E0455","E1353","E1355" K IBPR(Z) 160 F Z=77:1:85 S Z0="E13"_Z K IBPR(Z0) 161 ; Labs 162 ;S Z="80000" F S Z=$O(IBPR(Z)) Q:Z'?1"8"4N K IBPR(Z) S IBLABS=1 163 S Z="80000" F S Z=$O(IBPR(Z)) Q:Z'?1"8"4N S IBLABS=1 164 ; Flu shots 165 F Z="90724","G0008","90732","G0009","90657","90658","90659","90660" K IBPR(Z) 166 Q 167 ; 168 MCRANUM(IBIFN) ; Determine MEDICARE A provider ID # from bedsection for 169 ; bill ien IBIFN 170 N IBX 171 ; PART A MRA (only) needed - determine if psych/non-psych claim 172 N IBX,IBI 173 S IBI=$P($G(^DGCR(399,IBIFN,"U")),U,11) 174 S IBX=$S($TR($P($G(^DGCR(399.1,+IBI,0)),U),"psych","PSYCH")'["PSYCH":670899,1:674499) 175 Q IBX 176 ; 177 MCRACK(IBIFN,X,IBFLD) ; Check for MEDICARE A for bill IBIFN 178 ; Called from CLAIM STATUS MRA field (#24) xrefs in file 399 179 ; X = current value of field 399;24 180 ; IBFLD = 1 for primary ins co, 2 for secondary, 3 for tertiary 181 N IB 182 S IB=0 183 I +X,$$COBN^IBCEF(IBIFN)=IBFLD,$$WNRBILL^IBEFUNC(IBIFN,IBFLD),$$MRATYPE^IBEFUNC(IBIFN,"C")="A" S IB=1 184 Q IB 185 ;
Note:
See TracChangeset
for help on using the changeset viewer.
