- 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/IBCBB2.m
r613 r623 1 IBCBB2 ;ALB/ARH - CONTINUATION OF EDIT CHECKS ROUTINE (CMS-1500) ;04/14/92 2 ;;2.0;INTEGRATED BILLING;**51,137,210,245,232,296,320,349,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRBB2 6 ; 7 EN ; 8 N IBI,IBJ,IBN,IBY,IBDX,IBDXO,IBDXL,IBCPT,IBCPTL,IBOLAB,Z,IBXSAVE,IBLOC,IBTX,IBPS,IBSP,IBLCT,IBNVFLG,IBU3 9 I '$D(IBER) S IBER="" 10 S IBTX=$$TXMT^IBCEF4(IBIFN) 11 ; 12 ; Max 4 modifiers per CPT code allowed before warning 13 K IBXDATA 14 D F^IBCEF("N-HCFA 1500 MODIFIERS",,,IBIFN) ;Get modifiers 15 ; 16 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 IBI="Proc "_$$PRCD^IBCEF1($P(IBZPRC92(Z),U))_" has > 4 modifiers - only first 4 will be used" D WARN^IBCBB11(IBI) 17 ; ICD-9 diagnosis, at least 1 required 18 D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBER=IBER_"IB071;" 19 S IBI=$O(IBDXO(0)) 20 I IBI,$$INPAT^IBCEF(IBIFN,1),$E($$ICD9^IBACSV(+$P(IBDXO(IBI),U)))="V" S Z="Principal Dx V-code may not be valid" D WARN^IBCBB11(Z) 21 ; 22 ; CPT procs must be associated with a dx, must have a defined provider 23 S (IBLOC,IBN,IBI,IBY)=0 F S IBI=$O(^DGCR(399,IBIFN,"CP",IBI)) Q:IBI'?1N.N S IBCPT=^(IBI,0) D I +IBY S IBN=1 24 . I 'IBLOC,$P(IBCPT,U,15)'="",IBTX S Z="At least 1 charge has local box 24K data that will not be transmitted - " S IBLOC=1 D WARN^IBCBB11(Z) S Z=" This data will only print locally" D WARN^IBCBB11(Z) 25 . I $P(IBCPT,U)'["ICPT(" S:IBER'["IB092" IBER=IBER_"IB092;" Q 26 . S IBY=1 F IBJ=11:1:14 I +$P(IBCPT,"^",IBJ) S IBCPTL(+$P(IBCPT,"^",IBJ))="",IBY=0 27 I +IBN S IBER=IBER_"IB072;" 28 ; 29 I '$$OCC10(IBIFN,.IBDX,2) S IBER=IBER_"IB093;" 30 ; CMS-1500: dxs associated with procs must be defined dxs for the bill 31 S IBI=0 F S IBI=$O(IBDX(IBI)) Q:'IBI S IBDXL(IBDX(IBI))="" 32 S (IBN,IBI)=0 F S IBI=$O(IBCPTL(IBI)) Q:'IBI I '$D(IBDXL(IBI)) S IBN=1 Q 33 I +IBN S IBER=IBER_"IB073;" 34 ; ejk *296* Change # of diagnoses codes from 4 to 8 on CMS-1500 Claims. 35 I IBTX S IBI=8 F S IBI=$O(IBDXO(IBI)) Q:'IBI S Z=+$G(IBDX(+$G(IBDXO(IBI)))) I Z,$D(IBCPTL(Z)) D WARN^IBCBB11("Too many diagnoses for claim & will be rejected - consider printing locally") 36 ; 37 I $$WNRBILL^IBEFUNC(IBIFN),$$MRATYPE^IBEFUNC(IBIFN)'="B" S IBER=IBER_"IB087;" 38 ; 39 ; IB*320 - CLIA# error/warning - error msg for MRA claims, else warning 40 I $P(IBNDU2,U,13)="",$$CLIAREQ^IBCEP8A(IBIFN) D 41 . I $$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB235;" Q 42 . D WARN^IBCBB11("Claim contains laboratory services. The payer may require a CLIA #.") 43 . Q 44 ; 45 ; Only one occurrence code can be present for event date for box 14 46 S Z=$$EVENT^IBCF22(IBIFN,.IBXSAVE,.IBI) 47 I IBI S IBER=IBER_"IB099;" 48 ; 49 ; esg - 6/6/07 - warning if missing non-VA care type for outside facility 50 S IBNVFLG=0 51 I $P(IBNDU2,U,10),'$P(IBNDU2,U,11) D WARN^IBCBB11("Non-VA facility indicated, but the Non-VA Care Type field is not defined") S IBNVFLG=1 52 ; 53 ; unit/charge limits 54 K IBXDATA 55 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN) ;Get charge lines 56 S (IBLCT,IBOLAB)=0,IBPS="",IBSP=$$BILLSPEC^IBCEU3(IBIFN) 57 S IBI=0 F S IBI=$O(IBXDATA(IBI)) Q:'IBI D Q:IBER["IB310"!(IBER["IB311") 58 . S IBLCT=IBLCT+1 59 . I $P(IBNDU2,U,11) D 60 .. I '$P(IBXDATA(IBI),U,11) S IBPS=IBPS_$S(IBPS'="":",",1:"")_IBI Q 61 .. I $P(IBXDATA(IBI),U,14),"24"'[$P(IBNDU2,U,11) D WARN^IBCBB11("Outside lab charges exist on a non-lab NON-VA bill") 62 . I '$P(IBNDU2,U,11),$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Purchased service amounts are invalid unless this is a NON-VA bill") 63 . I IBNVFLG,'$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Non-VA facility indicated, but no purchased service charge on line# "_IBI) 64 . I $D(IBXDATA(IBI,"A")) S IBER=IBER_"IB310;" Q 65 . I $D(IBXDATA(IBI,"ARX")),IBER'["311;" S IBER=IBER_"IB311;" Q 66 . I $P(IBXDATA(IBI),U,14) S IBOLAB=IBOLAB+1 67 . ; Place of service required 68 . I $G(IBER)'["IB314;",$P(IBXDATA(IBI),U,3)="" S IBER=IBER_"IB314;" 69 . ; Type of service required 70 . I $G(IBER)'["IB313;",$P(IBXDATA(IBI),U,4)="" S IBER=IBER_"IB313;" 71 . ; 43 and 53 are invalid types of service 72 . I $G(IBER)'["IB110;",($P(IBXDATA(IBI),U,4)=43!($P(IBXDATA(IBI),U,4)=53)) S IBER=IBER_"IB110;" 73 . ; Units for the line item must be less than 100/1000 74 . I IBER'["IB088",$P(IBXDATA(IBI),U,9)'<100 D 75 .. I $P(IBXDATA(IBI),U,4)'=7 S IBER=IBER_"IB088;" Q 76 .. I $P(IBXDATA(IBI),U,9)'<1000 S IBER=IBER_"IB088;" 77 . ; Line item total charge must be less than $10,000.00, greater than 0 78 . I IBER'["IB090",$P(IBXDATA(IBI),U,9)'<10000 S IBER=IBER_"IB090;" 79 . I '($P(IBXDATA(IBI),U,9)*$P(IBXDATA(IBI),U,8)),$$COBN^IBCEF(IBIFN)'>1 S Z="Procedure "_$P(IBXDATA(IBI),U,5)_" has a 0-charge and will not be transmitted" D WARN^IBCBB11(Z) 80 I IBTX,IBLCT>50 D 81 . I '$$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB308;" Q 82 . I '$P(IBNDTX,U,9) S IBER=IBER_"IB325;" 83 S IBU3=$P($G(^DGCR(399,IBIFN,"U3")),U,4,7) I $TR(IBU3,U)'="" D 84 .I +IBSP'=35 D WARN^IBCBB11("Chiropractic service details only valid if provider specialty is '35'") 85 .I $P(IBU3,U,2)="" S IBER=IBER_"IB137;" 86 .I $P(IBU3,U,4)="" S IBER=IBER_"IB138;" Q 87 .I $P(IBU3,U,3)="","AM"[$P(IBU3,U,4) S IBER=IBER_"IB139;" 88 .Q 89 I IBPS'="" D WARN^IBCBB11("NON-VA facility indicated, but no purchased service charge on line item"_$S(IBPS[",":"s",1:"")_" #"_IBPS) 90 I $P(IBNDU2,U,11),$P(IBNDU2,U,11)=4,IBOLAB>1 D WARN^IBCBB11("For proper payment, you must bill each outside lab on a separate claim form") 91 K IBXDATA 92 ; 93 ; ; Check for Physician Name 94 D F^IBCEF("N-REFERRING PROVIDER NAME",,,IBIFN) 95 I $P($G(IBXDATA),U)]"" D 96 .N IBZ,FUNCTION,IBINS 97 .S FUNCTION=1 98 .F IBINS=1:1:3 D 99 .. S Z=$$GETTYP^IBCEP2A(IBIFN,IBINS,FUNCTION) 100 .. I Z,$P(Z,U,2) D ; Rendering/attending prov secondary id required 101 ... N IBID,IBOK,Q0 102 ... D PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C") ; check all as though they were current 103 ... S IBOK=0 104 ... S Q0=0 F S Q0=$O(IBID(1,FUNCTION,Q0)) Q:'Q0 I $P(IBID(1,FUNCTION,Q0),U,9)=+Z S IBOK=1 Q 105 ... I 'IBOK S IBER=IBER_$S(IBINS=1:"IB239;",IBINS=2:"IB240;",IBINS=3:"IB241;",1:"") 106 ; 107 Q 108 ; 109 OCC10(IBIFN,IBARR,IBFT) ; Determine if occurrence code 10 exists for pregnancy dx 110 ; IBARR=array subscripted by ien of DX code if IBFT=2 (CMS-1500 form) 111 ; by seq # and = ien of DX code if IBFT'=2 112 ; 113 N IBN,IBI,IBXDATA,IBXSAVE,IBDX,Z 114 S IBN=1 115 ; 116 I '$D(^TMP($J,"LMD")) D 117 . D F^IBCEF("N-OCCURRENCE CODES",,,IBIFN) 118 . S ^TMP($J,"LMD")="" 119 . S Z=0 F S Z=$O(IBXSAVE("OCC",Z)) Q:'Z I +IBXSAVE("OCC",Z)=10 S ^TMP($J,"LMD")=1 Q 120 ; 121 I '^TMP($J,"LMD") S IBI=0 F S IBI=$O(IBARR(IBI)) Q:'IBI D Q:'IBN 122 . N Z,Z1 123 . ; If a pregnancy DX exists, must be an occurrence code 10 for LMP date 124 . ; dx ranges are: V22*-V24*, V27*-V28*, 630*-677* 125 . S IBDX=$S($G(IBFT)'=2:+IBARR(IBI),1:IBI) 126 . S Z=$E($P($$ICD9^IBACSV(IBDX),U),1,3),Z1=$E(Z,2,3) 127 . I $S(Z'<630&(Z<678):1,$E(Z)="V":$S(Z1'<22&(Z1<25):1,1:Z1'<27&(Z1<28)),1:0) S IBN=0 ;Pregnancy Dx exists 128 ; 129 OCC10Q K ^TMP($J,"LMD") 130 Q IBN 131 ; 1 IBCBB2 ;ALB/ARH - CONTINUATION OF EDIT CHECKS ROUTINE (CMS-1500) ;04/14/92 2 ;;2.0;INTEGRATED BILLING;**51,137,210,245,232,296,320,349**;21-MAR-94;Build 46 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ;MAP TO DGCRBB2 6 ; 7 EN ; 8 N IBI,IBJ,IBN,IBY,IBDX,IBDXO,IBDXL,IBCPT,IBCPTL,IBOLAB,Z,IBXSAVE,IBLOC,IBTX,IBPS,IBSP,IBLCT 9 I '$D(IBER) S IBER="" 10 S IBTX=$$TXMT^IBCEF4(IBIFN) 11 ; 12 ; Warn if no group provider id (MCRWNR is a default) 13 ; I '$$WNRBILL^IBEFUNC(IBIFN) D 14 ; . S Z=$P($G(^DGCR(399,IBIFN,"M1")),U,$$COBN^IBCEF(IBIFN)+1) 15 ; . I Z="" D WARN^IBCBB11("No group prov # for the current ins co - site tax id will be used") 16 ; Max 4 modifiers per CPT code allowed before warning 17 K IBXDATA 18 D F^IBCEF("N-HCFA 1500 MODIFIERS",,,IBIFN) ;Get modifiers 19 ; 20 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 IBI="Proc "_$$PRCD^IBCEF1($P(IBZPRC92(Z),U))_" has > 4 modifiers - only first 4 will be used" D WARN^IBCBB11(IBI) 21 ; ICD-9 diagnosis, at least 1 required 22 D SET^IBCSC4D(IBIFN,.IBDX,.IBDXO) I '$P(IBDX,U,2) S IBER=IBER_"IB071;" 23 S IBI=$O(IBDXO(0)) 24 I IBI,$$INPAT^IBCEF(IBIFN,1),$E($$ICD9^IBACSV(+$P(IBDXO(IBI),U)))="V" S Z="Principal Dx V-code may not be valid" D WARN^IBCBB11(Z) 25 ; 26 ; CPT procs must be associated with a dx, must have a defined provider 27 S (IBLOC,IBN,IBI,IBY)=0 F S IBI=$O(^DGCR(399,IBIFN,"CP",IBI)) Q:IBI'?1N.N S IBCPT=^(IBI,0) D I +IBY S IBN=1 28 . ;I IBER'["IB089",$P(IBCPT,U,10)=7,$S('$P(IBCPT,U,16):1,1:$P(IBCPT,U,16)#15) S IBER=IBER_"IB089;" ;anesthesia needs minutes in multiple of 15 29 . I 'IBLOC,$P(IBCPT,U,15)'="",IBTX S Z="At least 1 charge has local box 24K data that will not be transmitted - " S IBLOC=1 D WARN^IBCBB11(Z) S Z=" This data will only print locally" D WARN^IBCBB11(Z) 30 . I $P(IBCPT,U)'["ICPT(" S:IBER'["IB092" IBER=IBER_"IB092;" Q 31 . S IBY=1 F IBJ=11:1:14 I +$P(IBCPT,"^",IBJ) S IBCPTL(+$P(IBCPT,"^",IBJ))="",IBY=0 32 . ;I '$P(IBCPT,U,18) S:IBER'["IB094;" IBER=IBER_"IB094;" Q 33 I +IBN S IBER=IBER_"IB072;" 34 ; 35 I '$$OCC10(IBIFN,.IBDX,2) S IBER=IBER_"IB093;" 36 ; CMS-1500: dxs associated with procs must be defined dxs for the bill 37 S IBI=0 F S IBI=$O(IBDX(IBI)) Q:'IBI S IBDXL(IBDX(IBI))="" 38 S (IBN,IBI)=0 F S IBI=$O(IBCPTL(IBI)) Q:'IBI I '$D(IBDXL(IBI)) S IBN=1 Q 39 I +IBN S IBER=IBER_"IB073;" 40 ; ejk *296* Change # of diagnoses codes from 4 to 8 on CMS-1500 Claims. 41 I IBTX S IBI=8 F S IBI=$O(IBDXO(IBI)) Q:'IBI S Z=+$G(IBDX(+$G(IBDXO(IBI)))) I Z,$D(IBCPTL(Z)) D WARN^IBCBB11("Too many diagnoses for claim & will be rejected - consider printing locally") 42 ; 43 I $$WNRBILL^IBEFUNC(IBIFN),$$MRATYPE^IBEFUNC(IBIFN)'="B" S IBER=IBER_"IB087;" 44 ; 45 ; IB*320 - CLIA# error/warning - error msg for MRA claims, else warning 46 I $P(IBNDU2,U,13)="",$$CLIAREQ^IBCEP8A(IBIFN) D 47 . I $$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB235;" Q 48 . D WARN^IBCBB11("Claim contains laboratory services. The payer may require a CLIA #.") 49 . Q 50 ; 51 ; Only one occurrence code can be present for event date for box 14 52 S Z=$$EVENT^IBCF22(IBIFN,.IBXSAVE,.IBI) 53 I IBI S IBER=IBER_"IB099;" 54 ; unit/charge limits 55 K IBXDATA 56 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN) ;Get charge lines 57 S (IBLCT,IBOLAB)=0,IBPS="",IBSP=$$BILLSPEC^IBCEU3(IBIFN) 58 S IBI=0 F S IBI=$O(IBXDATA(IBI)) Q:'IBI D Q:IBER["IB310"!(IBER["IB311") 59 . S IBLCT=IBLCT+1 60 . I $P(IBNDU2,U,11) D 61 .. I '$P(IBXDATA(IBI),U,11) S IBPS=IBPS_$S(IBPS'="":",",1:"")_IBI Q 62 .. I $P(IBXDATA(IBI),U,14),"24"'[$P(IBNDU2,U,11) D WARN^IBCBB11("Outside lab charges exist on a non-lab NON-VA bill") 63 . I '$P(IBNDU2,U,11),$P(IBXDATA(IBI),U,11) D WARN^IBCBB11("Purchased service amounts are invalid unless this is a NON-VA bill") 64 . I $D(IBXDATA(IBI,"A")) S IBER=IBER_"IB310;" Q 65 . I $D(IBXDATA(IBI,"ARX")),IBER'["311;" S IBER=IBER_"IB311;" Q 66 . I $P(IBXDATA(IBI),U,14) S IBOLAB=IBOLAB+1 67 . ; Place of service required 68 . I $G(IBER)'["IB314;",$P(IBXDATA(IBI),U,3)="" S IBER=IBER_"IB314;" 69 . ; Type of service required 70 . I $G(IBER)'["IB313;",$P(IBXDATA(IBI),U,4)="" S IBER=IBER_"IB313;" 71 . ; 43 and 53 are invalid types of service 72 . I $G(IBER)'["IB110;",($P(IBXDATA(IBI),U,4)=43!($P(IBXDATA(IBI),U,4)=53)) S IBER=IBER_"IB110;" 73 . ; Units for the line item must be less than 100/1000 74 . I IBER'["IB088",$P(IBXDATA(IBI),U,9)'<100 D 75 .. I $P(IBXDATA(IBI),U,4)'=7 S IBER=IBER_"IB088;" Q 76 .. I $P(IBXDATA(IBI),U,9)'<1000 S IBER=IBER_"IB088;" 77 . ; Line item total charge must be less than $10,000.00, greater than 0 78 . I IBER'["IB090",$P(IBXDATA(IBI),U,9)'<10000 S IBER=IBER_"IB090;" 79 . I '($P(IBXDATA(IBI),U,9)*$P(IBXDATA(IBI),U,8)),$$COBN^IBCEF(IBIFN)'>1 S Z="Procedure "_$P(IBXDATA(IBI),U,5)_" has a 0-charge and will not be transmitted" D WARN^IBCBB11(Z) 80 . I $G(IBXDATA(IBI,"AUX"))'="",'$G(IBSP(1)),+IBSP'=35,$TR($P(IBXDATA(IBI,"AUX"),U,4,6)_$P(IBXDATA(IBI,"AUX"),U,2),U)'="" S IBSP(1)=1 81 I IBTX,IBLCT>50 D 82 . I '$$REQMRA^IBEFUNC(IBIFN) S IBER=IBER_"IB308;" Q 83 . I '$P(IBNDTX,U,9) S IBER=IBER_"IB325;" 84 I $G(IBSP(1)) D WARN^IBCBB11("Chiropractic service details only valid if provider specialty is '35'") 85 I IBPS'="" D WARN^IBCBB11("NON-VA facility indicated, but no purchased service charge on line item"_$S(IBPS[",":"s",1:"")_" #"_IBPS) 86 I $P(IBNDU2,U,11),$P(IBNDU2,U,11)=4,IBOLAB>1 D WARN^IBCBB11("For proper payment, you must bill each outside lab on a separate claim form") 87 K IBXDATA 88 ; 89 ; ; Check for Physician Name 90 D F^IBCEF("N-REFERRING PROVIDER NAME",,,IBIFN) 91 I $P($G(IBXDATA),U)]"" D 92 .N IBZ,FUNCTION,IBINS 93 .S FUNCTION=1 94 .F IBINS=1:1:3 D 95 .. S Z=$$GETTYP^IBCEP2A(IBIFN,IBINS,FUNCTION) 96 .. I Z,$P(Z,U,2) D ; Rendering/attending prov secondary id required 97 ... N IBID,IBOK,Q0 98 ... D PROVINF^IBCEF74(IBIFN,IBINS,.IBID,1,"C") ; check all as though they were current 99 ... S IBOK=0 100 ... S Q0=0 F S Q0=$O(IBID(1,FUNCTION,Q0)) Q:'Q0 I $P(IBID(1,FUNCTION,Q0),U,9)=+Z S IBOK=1 Q 101 ... I 'IBOK S IBER=IBER_$S(IBINS=1:"IB239;",IBINS=2:"IB240;",IBINS=3:"IB241;",1:"") 102 ; 103 Q 104 ; 105 OCC10(IBIFN,IBARR,IBFT) ; Determine if occurrence code 10 exists for pregnancy dx 106 ; IBARR=array subscripted by ien of DX code if IBFT=2 (CMS-1500 form) 107 ; by seq # and = ien of DX code if IBFT'=2 108 ; 109 N IBN,IBI,IBXDATA,IBXSAVE,IBDX,Z 110 S IBN=1 111 ; 112 I '$D(^TMP($J,"LMD")) D 113 . D F^IBCEF("N-OCCURRENCE CODES",,,IBIFN) 114 . S ^TMP($J,"LMD")="" 115 . S Z=0 F S Z=$O(IBXSAVE("OCC",Z)) Q:'Z I +IBXSAVE("OCC",Z)=10 S ^TMP($J,"LMD")=1 Q 116 ; 117 I '^TMP($J,"LMD") S IBI=0 F S IBI=$O(IBARR(IBI)) Q:'IBI D Q:'IBN 118 . N Z,Z1 119 . ; If a pregnancy DX exists, must be an occurrence code 10 for LMP date 120 . ; dx ranges are: V22*-V24*, V27*-V28*, 630*-677* 121 . S IBDX=$S($G(IBFT)'=2:+IBARR(IBI),1:IBI) 122 . S Z=$E($P($$ICD9^IBACSV(IBDX),U),1,3),Z1=$E(Z,2,3) 123 . I $S(Z'<630&(Z<678):1,$E(Z)="V":$S(Z1'<22&(Z1<25):1,1:Z1'<27&(Z1<28)),1:0) S IBN=0 ;Pregnancy Dx exists 124 ; 125 OCC10Q K ^TMP($J,"LMD") 126 Q IBN 127 ;
Note:
See TracChangeset
for help on using the changeset viewer.
