- IBCU73 ;ALB/ARH - ADD/DELETE MODIFIER 26 TO SPECIFIED CPTS ; 1-SEP-00
- ;;2.0;INTEGRATED BILLING;**138,51,148,169,245**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; Based on Reasonable Charges v1.1, certain CPT codes should be reported with a modifier 26, indicating the
- ; charge is only the professional portion of the charge for the procedure.
- ;
- ; Auto add/remove modifier 26 for specific CPT codes on a bill
- ; - must be a Reasonable Charges v1.1 bill or greater
- ; - the CPT must be part of a specific set of CPT's (MOD26)
- ; - there must be both institutional and professional RC charges for the CPT
- ; - if the bill is an institutional bill then modifier 26 is deleted, if it is defined for the CPT
- ; - if the bill is a professional bill then modifier 26 is added, if it is not already defined for the CPT
- ;
- CPTMOD26(IBIFN) ; add/remove modifier 26 from specific CPT codes on Reasonable Charges bills
- N IB0,IBEVDT,IBBCT,IBCSI,IBCSP,IBBCPT,IBLN,IBMODS,IB26,IBX,IBCHANGE,IBBU,IBEND S IBCHANGE=0
- I '$O(^DGCR(399,+$G(IBIFN),"CP",0)) Q
- S IB0=$G(^DGCR(399,+IBIFN,0)) Q:IB0="" S IBBCT=$P(IB0,U,27) Q:'IBBCT
- S IBBU=$G(^DGCR(399,+IBIFN,"U")),IBEND=$$VERSDT^IBCRU8(2)
- I 3001102>$P(IBBU,U,2) Q ; starts with v1.1
- I +IBBU>IBEND Q ; ends with v2
- I '$$BILLRATE^IBCRU3($P(IB0,U,7),$P(IB0,U,5),$P(IB0,U,3),"RC") Q
- ;
- S IBX=$O(^IBE(363.1,"B","RC-OPT FAC")),IBCSI=$O(^IBE(363.1,"B",IBX,0)) Q:'IBCSI S IBCSI="AIVDTS"_IBCSI
- S IBX=$O(^IBE(363.1,"B","RC-PHYSICI")),IBCSP=$O(^IBE(363.1,"B",IBX,0)) Q:'IBCSP S IBCSP="AIVDTS"_IBCSP
- ;
- S IBBCPT=0 F S IBBCPT=$O(^DGCR(399,IBIFN,"CP",IBBCPT)) Q:'IBBCPT D
- . S IBLN=$G(^DGCR(399,IBIFN,"CP",IBBCPT,0)),IBEVDT=$P(IBLN,U,2) Q:IBLN'[";ICPT("
- . I 3001102>IBEVDT Q
- . I IBEVDT'<IBEND Q
- . ;
- . I '$$MOD26(+IBLN,IBEVDT) Q
- . ;
- . S IBX=$O(^IBA(363.2,IBCSI,+IBLN,-IBEVDT)) Q:'IBX I IBX'=$O(^IBA(363.2,IBCSP,+IBLN,-IBEVDT)) Q
- . ;
- . S IB26=",7,",IBMODS=","_$$GETMOD^IBEFUNC(IBIFN,IBBCPT)_","
- . ;
- . I IBBCT=1,IBMODS[IB26 D DELMOD(IBIFN,IBBCPT,7) S IBCHANGE=1
- . I IBBCT=2,IBMODS'[IB26 D ADDMOD(IBIFN,IBBCPT,7) S IBCHANGE=2
- ;
- I '$D(ZTQUEUED),'$G(IBAUTO),+IBCHANGE W !,"Modifier 26 "_$S(IBCHANGE=1:"Deleted from",1:"Added to")_" CPT procedures."
- Q
- ;
- MOD26(CPT,IBDT) ; returns true if CPT should have a 26-modifier for professional bill
- ;
- N IBX,IBCPTX S IBX=0,IBCPTX=","_$G(CPT)_",",IBDT=$S(+$G(IBDT):IBDT,1:DT) I '$G(CPT) G MOD26Q
- I CPT'<70000,CPT'>79999 S IBX=1
- I CPT'<90000,CPT'>99199 S IBX=1
- I CPT'<51725,CPT'>51797 S IBX=1
- I ",54240,54250,59020,59025,62252,62367,62368,"[IBCPTX S IBX=1
- ;
- I ",75952,75953,78990,90870,90871,91100,91105,92018,92019,92502,"[IBCPTX S IBX=0
- I ",92950,92953,92960,92961,93503,93536,93650,93651,93652,94660,94662,"[IBCPTX S IBX=0
- I ",96405,96406,96440,96445,96450,96542,96570,96571,96902,"[IBCPTX S IBX=0
- I CPT'<90918,CPT'>90997 S IBX=0
- ;
- I IBDT>3030428,",75952,75953,"[IBCPTX S IBX=1 ; should have modifier 26 in v1.4 but not v1.2
- MOD26Q Q IBX
- ;
- DELMOD(IBIFN,BCPT,MOD) ; delete the modifier from the CPT
- ; Input: BCPT - the ifn of the CPT in the 304 multiple
- ; MOD - internal form of the modifier to delete
- N DA,DR,DIE,DIC,IBLN,X,Y Q:'$G(MOD)
- S IBLN=+$O(^DGCR(399,+$G(IBIFN),"CP",+$G(BCPT),"MOD","C",MOD,0)) Q:'IBLN
- ;
- S DA(2)=IBIFN,DA(1)=BCPT,DA=IBLN,DIE="^DGCR(399,"_DA(2)_",""CP"","_DA(1)_",""MOD"",",DR=".01///@" D ^DIE
- Q
- ;
- ADDMOD(IBIFN,BCPT,MOD) ; add the modifier to the CPT
- ; Input: BCPT - the ifn of the CPT in the 304 multiple
- ; MOD - internal form of the modifier to add
- N DA,DR,DIE,DINUM,DIC,IBLN,IBM,IBCPM,X,Y Q:'$G(MOD)
- S IBLN=+$O(^DGCR(399,+$G(IBIFN),"CP",+$G(BCPT),"MOD","C",MOD,0)) Q:IBLN
- ;I $$MODP^ICPTMOD(+$G(^DGCR(399,+$G(IBIFN),"CP",+$G(BCPT),0)),MOD,"I")<1 Q ; CPT 2001 too restrictive for RC
- ;
- I $D(^DGCR(399,IBIFN,"CP",BCPT,"MOD",1)) D ;Move modifiers out of 1
- . S IBCPM="A"
- . F S IBCPM=$O(^DGCR(399,IBIFN,"CP",BCPT,"MOD",IBCPM),-1) Q:'IBCPM S IBM=$G(^(IBCPM,0)) I $P(IBM,U,2) D
- .. N DA,DO,DD,X,Y,DINUM
- .. S DA(2)=IBIFN,DA(1)=BCPT,DIC="^DGCR(399,"_DA(2)_",""CP"","_DA(1)_",""MOD"","
- .. S DINUM=IBCPM+1,X=IBM+1,DIC("DR")=".02////"_$P(IBM,U,2),DIC(0)="L" D FILE^DICN K DO,DD
- .. I Y>0 S DIE=DIC,DA(2)=IBIFN,DA(1)=BCPT,DA=IBCPM,DR=".01///@" D ^DIE
- S DINUM=1,DA(2)=IBIFN,DA(1)=BCPT,DIC="^DGCR(399,"_DA(2)_",""CP"","_DA(1)_",""MOD"",",DIC("DR")=".02////"_MOD,X=1,DIC(0)="L" D FILE^DICN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCU73 4465 printed Jan 18, 2025@03:22:02 Page 2
- IBCU73 ;ALB/ARH - ADD/DELETE MODIFIER 26 TO SPECIFIED CPTS ; 1-SEP-00
- +1 ;;2.0;INTEGRATED BILLING;**138,51,148,169,245**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 ; Based on Reasonable Charges v1.1, certain CPT codes should be reported with a modifier 26, indicating the
- +5 ; charge is only the professional portion of the charge for the procedure.
- +6 ;
- +7 ; Auto add/remove modifier 26 for specific CPT codes on a bill
- +8 ; - must be a Reasonable Charges v1.1 bill or greater
- +9 ; - the CPT must be part of a specific set of CPT's (MOD26)
- +10 ; - there must be both institutional and professional RC charges for the CPT
- +11 ; - if the bill is an institutional bill then modifier 26 is deleted, if it is defined for the CPT
- +12 ; - if the bill is a professional bill then modifier 26 is added, if it is not already defined for the CPT
- +13 ;
- CPTMOD26(IBIFN) ; add/remove modifier 26 from specific CPT codes on Reasonable Charges bills
- +1 NEW IB0,IBEVDT,IBBCT,IBCSI,IBCSP,IBBCPT,IBLN,IBMODS,IB26,IBX,IBCHANGE,IBBU,IBEND
- SET IBCHANGE=0
- +2 IF '$ORDER(^DGCR(399,+$GET(IBIFN),"CP",0))
- QUIT
- +3 SET IB0=$GET(^DGCR(399,+IBIFN,0))
- if IB0=""
- QUIT
- SET IBBCT=$PIECE(IB0,U,27)
- if 'IBBCT
- QUIT
- +4 SET IBBU=$GET(^DGCR(399,+IBIFN,"U"))
- SET IBEND=$$VERSDT^IBCRU8(2)
- +5 ; starts with v1.1
- IF 3001102>$PIECE(IBBU,U,2)
- QUIT
- +6 ; ends with v2
- IF +IBBU>IBEND
- QUIT
- +7 IF '$$BILLRATE^IBCRU3($PIECE(IB0,U,7),$PIECE(IB0,U,5),$PIECE(IB0,U,3),"RC")
- QUIT
- +8 ;
- +9 SET IBX=$ORDER(^IBE(363.1,"B","RC-OPT FAC"))
- SET IBCSI=$ORDER(^IBE(363.1,"B",IBX,0))
- if 'IBCSI
- QUIT
- SET IBCSI="AIVDTS"_IBCSI
- +10 SET IBX=$ORDER(^IBE(363.1,"B","RC-PHYSICI"))
- SET IBCSP=$ORDER(^IBE(363.1,"B",IBX,0))
- if 'IBCSP
- QUIT
- SET IBCSP="AIVDTS"_IBCSP
- +11 ;
- +12 SET IBBCPT=0
- FOR
- SET IBBCPT=$ORDER(^DGCR(399,IBIFN,"CP",IBBCPT))
- if 'IBBCPT
- QUIT
- Begin DoDot:1
- +13 SET IBLN=$GET(^DGCR(399,IBIFN,"CP",IBBCPT,0))
- SET IBEVDT=$PIECE(IBLN,U,2)
- if IBLN'[";ICPT("
- QUIT
- +14 IF 3001102>IBEVDT
- QUIT
- +15 IF IBEVDT'<IBEND
- QUIT
- +16 ;
- +17 IF '$$MOD26(+IBLN,IBEVDT)
- QUIT
- +18 ;
- +19 SET IBX=$ORDER(^IBA(363.2,IBCSI,+IBLN,-IBEVDT))
- if 'IBX
- QUIT
- IF IBX'=$ORDER(^IBA(363.2,IBCSP,+IBLN,-IBEVDT))
- QUIT
- +20 ;
- +21 SET IB26=",7,"
- SET IBMODS=","_$$GETMOD^IBEFUNC(IBIFN,IBBCPT)_","
- +22 ;
- +23 IF IBBCT=1
- IF IBMODS[IB26
- DO DELMOD(IBIFN,IBBCPT,7)
- SET IBCHANGE=1
- +24 IF IBBCT=2
- IF IBMODS'[IB26
- DO ADDMOD(IBIFN,IBBCPT,7)
- SET IBCHANGE=2
- End DoDot:1
- +25 ;
- +26 IF '$DATA(ZTQUEUED)
- IF '$GET(IBAUTO)
- IF +IBCHANGE
- WRITE !,"Modifier 26 "_$SELECT(IBCHANGE=1:"Deleted from",1:"Added to")_" CPT procedures."
- +27 QUIT
- +28 ;
- MOD26(CPT,IBDT) ; returns true if CPT should have a 26-modifier for professional bill
- +1 ;
- +2 NEW IBX,IBCPTX
- SET IBX=0
- SET IBCPTX=","_$GET(CPT)_","
- SET IBDT=$SELECT(+$GET(IBDT):IBDT,1:DT)
- IF '$GET(CPT)
- GOTO MOD26Q
- +3 IF CPT'<70000
- IF CPT'>79999
- SET IBX=1
- +4 IF CPT'<90000
- IF CPT'>99199
- SET IBX=1
- +5 IF CPT'<51725
- IF CPT'>51797
- SET IBX=1
- +6 IF ",54240,54250,59020,59025,62252,62367,62368,"[IBCPTX
- SET IBX=1
- +7 ;
- +8 IF ",75952,75953,78990,90870,90871,91100,91105,92018,92019,92502,"[IBCPTX
- SET IBX=0
- +9 IF ",92950,92953,92960,92961,93503,93536,93650,93651,93652,94660,94662,"[IBCPTX
- SET IBX=0
- +10 IF ",96405,96406,96440,96445,96450,96542,96570,96571,96902,"[IBCPTX
- SET IBX=0
- +11 IF CPT'<90918
- IF CPT'>90997
- SET IBX=0
- +12 ;
- +13 ; should have modifier 26 in v1.4 but not v1.2
- IF IBDT>3030428
- IF ",75952,75953,"[IBCPTX
- SET IBX=1
- MOD26Q QUIT IBX
- +1 ;
- DELMOD(IBIFN,BCPT,MOD) ; delete the modifier from the CPT
- +1 ; Input: BCPT - the ifn of the CPT in the 304 multiple
- +2 ; MOD - internal form of the modifier to delete
- +3 NEW DA,DR,DIE,DIC,IBLN,X,Y
- if '$GET(MOD)
- QUIT
- +4 SET IBLN=+$ORDER(^DGCR(399,+$GET(IBIFN),"CP",+$GET(BCPT),"MOD","C",MOD,0))
- if 'IBLN
- QUIT
- +5 ;
- +6 SET DA(2)=IBIFN
- SET DA(1)=BCPT
- SET DA=IBLN
- SET DIE="^DGCR(399,"_DA(2)_",""CP"","_DA(1)_",""MOD"","
- SET DR=".01///@"
- DO ^DIE
- +7 QUIT
- +8 ;
- ADDMOD(IBIFN,BCPT,MOD) ; add the modifier to the CPT
- +1 ; Input: BCPT - the ifn of the CPT in the 304 multiple
- +2 ; MOD - internal form of the modifier to add
- +3 NEW DA,DR,DIE,DINUM,DIC,IBLN,IBM,IBCPM,X,Y
- if '$GET(MOD)
- QUIT
- +4 SET IBLN=+$ORDER(^DGCR(399,+$GET(IBIFN),"CP",+$GET(BCPT),"MOD","C",MOD,0))
- if IBLN
- QUIT
- +5 ;I $$MODP^ICPTMOD(+$G(^DGCR(399,+$G(IBIFN),"CP",+$G(BCPT),0)),MOD,"I")<1 Q ; CPT 2001 too restrictive for RC
- +6 ;
- +7 ;Move modifiers out of 1
- IF $DATA(^DGCR(399,IBIFN,"CP",BCPT,"MOD",1))
- Begin DoDot:1
- +8 SET IBCPM="A"
- +9 FOR
- SET IBCPM=$ORDER(^DGCR(399,IBIFN,"CP",BCPT,"MOD",IBCPM),-1)
- if 'IBCPM
- QUIT
- SET IBM=$GET(^(IBCPM,0))
- IF $PIECE(IBM,U,2)
- Begin DoDot:2
- +10 NEW DA,DO,DD,X,Y,DINUM
- +11 SET DA(2)=IBIFN
- SET DA(1)=BCPT
- SET DIC="^DGCR(399,"_DA(2)_",""CP"","_DA(1)_",""MOD"","
- +12 SET DINUM=IBCPM+1
- SET X=IBM+1
- SET DIC("DR")=".02////"_$PIECE(IBM,U,2)
- SET DIC(0)="L"
- DO FILE^DICN
- KILL DO,DD
- +13 IF Y>0
- SET DIE=DIC
- SET DA(2)=IBIFN
- SET DA(1)=BCPT
- SET DA=IBCPM
- SET DR=".01///@"
- DO ^DIE
- End DoDot:2
- End DoDot:1
- +14 SET DINUM=1
- SET DA(2)=IBIFN
- SET DA(1)=BCPT
- SET DIC="^DGCR(399,"_DA(2)_",""CP"","_DA(1)_",""MOD"","
- SET DIC("DR")=".02////"_MOD
- SET X=1
- SET DIC(0)="L"
- DO FILE^DICN
- +15 QUIT