IB20P829 ;MNTVBB/DMR - IB*2.0*829 COST BASED & INTER AGENCY RATE UPDATE ; 08/21/2025@13:38
;;2.0;INTEGRATED BILLING;**829**;21-MAR-94;Build 1
;;Per VA Directive 6402, this routine should not be modified.
;
;
; Add FY26 Cost Based/Interagency Charges to Charge Master 363.2
Q
POST ;
; Backup 363.2 Charge Item File
;N IB829FILES
;S IB829FILE=""
;S IB829FILES="363.2"
;S IBCNT=0
;F IBCNT=1:1:$L(IB829FILES,"^") D
;. S IB829FILE=$P(IB829FILES,"^",IBCNT)
;. D GLBBKUP
;. Q
; Begin Update
N IBEFFDT,IBA,U S U="^"
D MSG(" IB*2.0*829 Post-Install .....")
S IBEFFDT=3251001 ; effective date of 10/01/2025
D ADDCI(IBEFFDT) ; add Charge Items (363.2) with new rates
D MSG(" IB*2.0*829 Post-Install Complete")
Q
;
ADDCI(IBEFFDT) ; pass in the effective date to add charge items with new charges
N IBCNT,IBCNT1,IBDFLTDT,IBI,IBLN
D MSG("")
S (IBCNT,IBCNT1)=0,IBDFLTDT=+$G(IBEFFDT)
I 'IBDFLTDT D MSG("** Error: No Effective Date, No Charges Added") G CIQ
;
F IBI=1:1 S IBLN=$P($T(CIF+IBI),";;",2) Q:+IBLN!(IBLN="") I $E(IBLN)?1A D SETCI
;
I +IBCNT1 D MSG(" >> "_IBCNT1_" Duplicate Charge Items already exist, not re-added")
;
CIQ D MSG(" >> "_IBCNT_" Cost Based/Interagency Charge Items added to CHARGE ITEM file (#363.2)")
D MSG("")
Q
;
SETCI ; set Charge Item (duplicates based on item, CS, eff dt, rev cd)
;
N IBCHG,IBCI,IBCS,IBDT,IBFN,IBPE,IBRVCD,IBX,IBXRF,IBZ,DA,DD,DO,DLAYGO,DIC,DIE,DR,X,Y
S IBCS=$P(IBLN,U,2),IBCS=+$O(^IBE(363.1,"B",IBCS,0)) I 'IBCS D MSG("** Error: Charge Set "_$P(IBLN,U,2)_" undefined") Q
S IBCI=+$$MCCRUTL($P(IBLN,U,1),5) I 'IBCI D MSG("** Error: Bed Section "_$P(IBLN,U,1)_" undefined") Q
S IBDT=IBDFLTDT I +$P(IBLN,U,3) S IBDT=+$P(IBLN,U,3)
S IBRVCD=$$RVCD($P(IBLN,U,4))
S IBCHG=+$P(IBLN,U,5)
S IBXRF="AIVDTS"_IBCS
;
S IBX=0 F S IBX=$O(^IBA(363.2,IBXRF,IBCI,-IBDT,IBX)) Q:'IBX S IBZ=$G(^IBA(363.2,IBX,0)) I $P(IBZ,U,6)=IBRVCD D
. S IBCI=0,IBCNT1=IBCNT1+1 I +$P(IBZ,U,5)'=IBCHG D MSG("** Error: Item exists, wrong charge: "_IBLN)
Q:'IBCI
;
S DLAYGO=363.2,DIC="^IBA(363.2,",DIC(0)="L",X=IBCI_";DGCR(399.1," D FILE^DICN
I Y<1 D MSG("** Error: when adding the charge item "_$P(IBLN,U,2)_" with rate "_IBCHG_" to the file, Log a ticket!") Q
S IBFN=+Y,IBCNT=IBCNT+1
;
S DR=".02///"_IBCS_";.03///"_IBDT_";.05///"_IBCHG I +IBRVCD S DR=DR_";.06///"_IBRVCD
S DIE="^IBA(363.2,",DA=+IBFN D ^DIE
Q
;
;
MCCRUTL(IBC,IBPE) ; returns IEN in 399.1 if Name is found and piece P is true
N IBX,IBY S IBY=""
I $G(IBC)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"B",IBC,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(IBPE)) S IBY=IBX
Q IBY
;
RVCD(RVCD) ; returns IFN if revenue code is valid and active
N IBX,IBY S IBY=""
I +$G(RVCD) S IBX=$G(^DGCR(399.2,+RVCD,0)) I +$P(IBX,U,3) S IBY=+RVCD
Q IBY
;
MSG(IBA) ;
D MES^XPDUTL(IBA)
Q
;GLBBKUP ; XTMP Backup of file(s)
;S IBBKUPNDE="IB*2*829-FY25 CBIAR Update (#363.2)"
;S ^XTMP("IB20P829",0)=$$FMADD^XLFDT(DT,120)_"^"_DT_"^"_IBBKUPNDE
;M ^XTMP("IB20P829",IB829FILE,$H)=^IBA(IB829FILE)
;Q
;
CIF ; 68 Charge Items (363.2): Bedsection ^ Charge Set ^Effective Date ^ Revenue Code ^ Charge
;;
TORT ;; Cost Based (Tortiously Liable) - All Inclusive
;;
;;ALCOHOL AND DRUG TREATMENT^TL-INPT (INCLUSIVE)^^^3922
;;BLIND REHABILITATION^TL-INPT (INCLUSIVE)^^^3853
;;GENERAL MEDICAL CARE^TL-INPT (INCLUSIVE)^^^6683
;;INTERMEDIATE CARE^TL-INPT (INCLUSIVE)^^^5064
;;NEUROLOGY^TL-INPT (INCLUSIVE)^^^6440
;;NURSING HOME CARE^TL-INPT (INCLUSIVE)^^^2758
;;POLYTRAUMA INPATIENT^TL-INPT (INCLUSIVE)^^^5825
;;PRRTP^TL-INPT (INCLUSIVE)^^^521
;;PSYCHIATRIC CARE^TL-INPT (INCLUSIVE)^^^4867
;;REHABILITATION MEDICINE^TL-INPT (INCLUSIVE)^^^4936
;;SPINAL CORD INJURY CARE^TL-INPT (INCLUSIVE)^^^5582
;;SURGICAL CARE^TL-INPT (INCLUSIVE)^^^10620
;;
;; Non-Professional: Nursing/Room/Board 101 & Ancillary 240
;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^101^2640
;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^240^908
;;BLIND REHABILITATION^TL-INPT (NPF)^^101^1629
;;BLIND REHABILITATION^TL-INPT (NPF)^^240^1914
;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^101^4141
;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^240^1742
;;INTERMEDIATE CARE^TL-INPT (NPF)^^101^4072
;;INTERMEDIATE CARE^TL-INPT (NPF)^^240^743
;;NEUROLOGY^TL-INPT (NPF)^^101^3797
;;NEUROLOGY^TL-INPT (NPF)^^240^1700
;;NURSING HOME CARE^TL-INPT (NPF)^^101^2299
;;NURSING HOME CARE^TL-INPT (NPF)^^240^373
;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^101^3383
;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^240^1780
;;PRRTP^TL-INPT (NPF)^^101^433
;;PRRTP^TL-INPT (NPF)^^240^55
;;PSYCHIATRIC CARE^TL-INPT (NPF)^^101^3642
;;PSYCHIATRIC CARE^TL-INPT (NPF)^^240^766
;;REHABILITATION MEDICINE^TL-INPT (NPF)^^101^2867
;;REHABILITATION MEDICINE^TL-INPT (NPF)^^240^1508
;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^101^3485
;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^240^1405
;;SURGICAL CARE^TL-INPT (NPF)^^101^6229
;;SURGICAL CARE^TL-INPT (NPF)^^240^3221
;;
;; Professional Physician
;;ALCOHOL AND DRUG TREATMENT^TL-INPT (PF)^^^374
;;BLIND REHABILITATION^TL-INPT (PF)^^^310
;;GENERAL MEDICAL CARE^TL-INPT (PF)^^^800
;;INTERMEDIATE CARE^TL-INPT (PF)^^^249
;;NEUROLOGY^TL-INPT (PF)^^^943
;;NURSING HOME CARE^TL-INPT (PF)^^^86
;;POLYTRAUMA INPATIENT^TL-INPT (PF)^^^662
;;PRRTP^TL-INPT (PF)^^^33
;;PSYCHIATRIC CARE^TL-INPT (PF)^^^459
;;REHABILITATION MEDICINE^TL-INPT (PF)^^^561
;;SPINAL CORD INJURY CARE^TL-INPT (PF)^^^692
;;SURGICAL CARE^TL-INPT (PF)^^^1170
;;
;; Outpatient Care Other
;;OUTPATIENT DENTAL^TL-OPT DENTAL^^^579
;;OUTPATIENT VISIT^TL-OPT VST^^^579
;;POLYTRAUMA OUTPATIENT VISIT^TL-OPT VST POLYTRAUMA^^^802
;;PM&RS OUTPATIENT VISIT^TL-OPT VST PM&RS^^^378
;;
IA ;; Interagency
;;
;;ALCOHOL AND DRUG TREATMENT^IA-INPT^^^3729
;;BLIND REHABILITATION^IA-INPT^^^3665
;;GENERAL MEDICAL CARE^IA-INPT^^^6381
;;INTERMEDIATE CARE^IA-INPT^^^4824
;;NEUROLOGY^IA-INPT^^^6145
;;NURSING HOME CARE^IA-INPT^^^2627
;;POLYTRAUMA INPATIENT^IA-INPT^^^5528
;;PRRTP^IA-INPT^^^498
;;PSYCHIATRIC CARE^IA-INPT^^^4627
;;REHABILITATION MEDICINE^IA-INPT^^^4697
;;SPINAL CORD INJURY CARE^IA-INPT^^^5314
;;SURGICAL CARE^IA-INPT^^^10145
;;
;; Outpatient Care Other
;;OUTPATIENT DENTAL^IA-OPT DENTAL^^^554
;;OUTPATIENT VISIT^IA-OPT VST^^^554
;;POLYTRAUMA OUTPATIENT VISIT^IA-OPT VST POLYTRAUMA^^^765
;;PM&RS OUTPATIENT VISIT^IA-OPT VST PM&RS^^^357
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P829 6553 printed Jan 29, 2026@15:03:49 Page 2
IB20P829 ;MNTVBB/DMR - IB*2.0*829 COST BASED & INTER AGENCY RATE UPDATE ; 08/21/2025@13:38
+1 ;;2.0;INTEGRATED BILLING;**829**;21-MAR-94;Build 1
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 ; Add FY26 Cost Based/Interagency Charges to Charge Master 363.2
+6 QUIT
POST ;
+1 ; Backup 363.2 Charge Item File
+2 ;N IB829FILES
+3 ;S IB829FILE=""
+4 ;S IB829FILES="363.2"
+5 ;S IBCNT=0
+6 ;F IBCNT=1:1:$L(IB829FILES,"^") D
+7 ;. S IB829FILE=$P(IB829FILES,"^",IBCNT)
+8 ;. D GLBBKUP
+9 ;. Q
+10 ; Begin Update
+11 NEW IBEFFDT,IBA,U
SET U="^"
+12 DO MSG(" IB*2.0*829 Post-Install .....")
+13 ; effective date of 10/01/2025
SET IBEFFDT=3251001
+14 ; add Charge Items (363.2) with new rates
DO ADDCI(IBEFFDT)
+15 DO MSG(" IB*2.0*829 Post-Install Complete")
+16 QUIT
+17 ;
ADDCI(IBEFFDT) ; pass in the effective date to add charge items with new charges
+1 NEW IBCNT,IBCNT1,IBDFLTDT,IBI,IBLN
+2 DO MSG("")
+3 SET (IBCNT,IBCNT1)=0
SET IBDFLTDT=+$GET(IBEFFDT)
+4 IF 'IBDFLTDT
DO MSG("** Error: No Effective Date, No Charges Added")
GOTO CIQ
+5 ;
+6 FOR IBI=1:1
SET IBLN=$PIECE($TEXT(CIF+IBI),";;",2)
if +IBLN!(IBLN="")
QUIT
IF $EXTRACT(IBLN)?1A
DO SETCI
+7 ;
+8 IF +IBCNT1
DO MSG(" >> "_IBCNT1_" Duplicate Charge Items already exist, not re-added")
+9 ;
CIQ DO MSG(" >> "_IBCNT_" Cost Based/Interagency Charge Items added to CHARGE ITEM file (#363.2)")
+1 DO MSG("")
+2 QUIT
+3 ;
SETCI ; set Charge Item (duplicates based on item, CS, eff dt, rev cd)
+1 ;
+2 NEW IBCHG,IBCI,IBCS,IBDT,IBFN,IBPE,IBRVCD,IBX,IBXRF,IBZ,DA,DD,DO,DLAYGO,DIC,DIE,DR,X,Y
+3 SET IBCS=$PIECE(IBLN,U,2)
SET IBCS=+$ORDER(^IBE(363.1,"B",IBCS,0))
IF 'IBCS
DO MSG("** Error: Charge Set "_$PIECE(IBLN,U,2)_" undefined")
QUIT
+4 SET IBCI=+$$MCCRUTL($PIECE(IBLN,U,1),5)
IF 'IBCI
DO MSG("** Error: Bed Section "_$PIECE(IBLN,U,1)_" undefined")
QUIT
+5 SET IBDT=IBDFLTDT
IF +$PIECE(IBLN,U,3)
SET IBDT=+$PIECE(IBLN,U,3)
+6 SET IBRVCD=$$RVCD($PIECE(IBLN,U,4))
+7 SET IBCHG=+$PIECE(IBLN,U,5)
+8 SET IBXRF="AIVDTS"_IBCS
+9 ;
+10 SET IBX=0
FOR
SET IBX=$ORDER(^IBA(363.2,IBXRF,IBCI,-IBDT,IBX))
if 'IBX
QUIT
SET IBZ=$GET(^IBA(363.2,IBX,0))
IF $PIECE(IBZ,U,6)=IBRVCD
Begin DoDot:1
+11 SET IBCI=0
SET IBCNT1=IBCNT1+1
IF +$PIECE(IBZ,U,5)'=IBCHG
DO MSG("** Error: Item exists, wrong charge: "_IBLN)
End DoDot:1
+12 if 'IBCI
QUIT
+13 ;
+14 SET DLAYGO=363.2
SET DIC="^IBA(363.2,"
SET DIC(0)="L"
SET X=IBCI_";DGCR(399.1,"
DO FILE^DICN
+15 IF Y<1
DO MSG("** Error: when adding the charge item "_$PIECE(IBLN,U,2)_" with rate "_IBCHG_" to the file, Log a ticket!")
QUIT
+16 SET IBFN=+Y
SET IBCNT=IBCNT+1
+17 ;
+18 SET DR=".02///"_IBCS_";.03///"_IBDT_";.05///"_IBCHG
IF +IBRVCD
SET DR=DR_";.06///"_IBRVCD
+19 SET DIE="^IBA(363.2,"
SET DA=+IBFN
DO ^DIE
+20 QUIT
+21 ;
+22 ;
MCCRUTL(IBC,IBPE) ; returns IEN in 399.1 if Name is found and piece P is true
+1 NEW IBX,IBY
SET IBY=""
+2 IF $GET(IBC)'=""
SET IBX=0
FOR
SET IBX=$ORDER(^DGCR(399.1,"B",IBC,IBX))
if 'IBX
QUIT
IF $PIECE($GET(^DGCR(399.1,IBX,0)),U,+$GET(IBPE))
SET IBY=IBX
+3 QUIT IBY
+4 ;
RVCD(RVCD) ; returns IFN if revenue code is valid and active
+1 NEW IBX,IBY
SET IBY=""
+2 IF +$GET(RVCD)
SET IBX=$GET(^DGCR(399.2,+RVCD,0))
IF +$PIECE(IBX,U,3)
SET IBY=+RVCD
+3 QUIT IBY
+4 ;
MSG(IBA) ;
+1 DO MES^XPDUTL(IBA)
+2 QUIT
+3 ;GLBBKUP ; XTMP Backup of file(s)
+4 ;S IBBKUPNDE="IB*2*829-FY25 CBIAR Update (#363.2)"
+5 ;S ^XTMP("IB20P829",0)=$$FMADD^XLFDT(DT,120)_"^"_DT_"^"_IBBKUPNDE
+6 ;M ^XTMP("IB20P829",IB829FILE,$H)=^IBA(IB829FILE)
+7 ;Q
+8 ;
CIF ; 68 Charge Items (363.2): Bedsection ^ Charge Set ^Effective Date ^ Revenue Code ^ Charge
+1 ;;
TORT ;; Cost Based (Tortiously Liable) - All Inclusive
+1 ;;
+2 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (INCLUSIVE)^^^3922
+3 ;;BLIND REHABILITATION^TL-INPT (INCLUSIVE)^^^3853
+4 ;;GENERAL MEDICAL CARE^TL-INPT (INCLUSIVE)^^^6683
+5 ;;INTERMEDIATE CARE^TL-INPT (INCLUSIVE)^^^5064
+6 ;;NEUROLOGY^TL-INPT (INCLUSIVE)^^^6440
+7 ;;NURSING HOME CARE^TL-INPT (INCLUSIVE)^^^2758
+8 ;;POLYTRAUMA INPATIENT^TL-INPT (INCLUSIVE)^^^5825
+9 ;;PRRTP^TL-INPT (INCLUSIVE)^^^521
+10 ;;PSYCHIATRIC CARE^TL-INPT (INCLUSIVE)^^^4867
+11 ;;REHABILITATION MEDICINE^TL-INPT (INCLUSIVE)^^^4936
+12 ;;SPINAL CORD INJURY CARE^TL-INPT (INCLUSIVE)^^^5582
+13 ;;SURGICAL CARE^TL-INPT (INCLUSIVE)^^^10620
+14 ;;
+15 ;; Non-Professional: Nursing/Room/Board 101 & Ancillary 240
+16 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^101^2640
+17 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (NPF)^^240^908
+18 ;;BLIND REHABILITATION^TL-INPT (NPF)^^101^1629
+19 ;;BLIND REHABILITATION^TL-INPT (NPF)^^240^1914
+20 ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^101^4141
+21 ;;GENERAL MEDICAL CARE^TL-INPT (NPF)^^240^1742
+22 ;;INTERMEDIATE CARE^TL-INPT (NPF)^^101^4072
+23 ;;INTERMEDIATE CARE^TL-INPT (NPF)^^240^743
+24 ;;NEUROLOGY^TL-INPT (NPF)^^101^3797
+25 ;;NEUROLOGY^TL-INPT (NPF)^^240^1700
+26 ;;NURSING HOME CARE^TL-INPT (NPF)^^101^2299
+27 ;;NURSING HOME CARE^TL-INPT (NPF)^^240^373
+28 ;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^101^3383
+29 ;;POLYTRAUMA INPATIENT^TL-INPT (NPF)^^240^1780
+30 ;;PRRTP^TL-INPT (NPF)^^101^433
+31 ;;PRRTP^TL-INPT (NPF)^^240^55
+32 ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^101^3642
+33 ;;PSYCHIATRIC CARE^TL-INPT (NPF)^^240^766
+34 ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^101^2867
+35 ;;REHABILITATION MEDICINE^TL-INPT (NPF)^^240^1508
+36 ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^101^3485
+37 ;;SPINAL CORD INJURY CARE^TL-INPT (NPF)^^240^1405
+38 ;;SURGICAL CARE^TL-INPT (NPF)^^101^6229
+39 ;;SURGICAL CARE^TL-INPT (NPF)^^240^3221
+40 ;;
+41 ;; Professional Physician
+42 ;;ALCOHOL AND DRUG TREATMENT^TL-INPT (PF)^^^374
+43 ;;BLIND REHABILITATION^TL-INPT (PF)^^^310
+44 ;;GENERAL MEDICAL CARE^TL-INPT (PF)^^^800
+45 ;;INTERMEDIATE CARE^TL-INPT (PF)^^^249
+46 ;;NEUROLOGY^TL-INPT (PF)^^^943
+47 ;;NURSING HOME CARE^TL-INPT (PF)^^^86
+48 ;;POLYTRAUMA INPATIENT^TL-INPT (PF)^^^662
+49 ;;PRRTP^TL-INPT (PF)^^^33
+50 ;;PSYCHIATRIC CARE^TL-INPT (PF)^^^459
+51 ;;REHABILITATION MEDICINE^TL-INPT (PF)^^^561
+52 ;;SPINAL CORD INJURY CARE^TL-INPT (PF)^^^692
+53 ;;SURGICAL CARE^TL-INPT (PF)^^^1170
+54 ;;
+55 ;; Outpatient Care Other
+56 ;;OUTPATIENT DENTAL^TL-OPT DENTAL^^^579
+57 ;;OUTPATIENT VISIT^TL-OPT VST^^^579
+58 ;;POLYTRAUMA OUTPATIENT VISIT^TL-OPT VST POLYTRAUMA^^^802
+59 ;;PM&RS OUTPATIENT VISIT^TL-OPT VST PM&RS^^^378
+60 ;;
IA ;; Interagency
+1 ;;
+2 ;;ALCOHOL AND DRUG TREATMENT^IA-INPT^^^3729
+3 ;;BLIND REHABILITATION^IA-INPT^^^3665
+4 ;;GENERAL MEDICAL CARE^IA-INPT^^^6381
+5 ;;INTERMEDIATE CARE^IA-INPT^^^4824
+6 ;;NEUROLOGY^IA-INPT^^^6145
+7 ;;NURSING HOME CARE^IA-INPT^^^2627
+8 ;;POLYTRAUMA INPATIENT^IA-INPT^^^5528
+9 ;;PRRTP^IA-INPT^^^498
+10 ;;PSYCHIATRIC CARE^IA-INPT^^^4627
+11 ;;REHABILITATION MEDICINE^IA-INPT^^^4697
+12 ;;SPINAL CORD INJURY CARE^IA-INPT^^^5314
+13 ;;SURGICAL CARE^IA-INPT^^^10145
+14 ;;
+15 ;; Outpatient Care Other
+16 ;;OUTPATIENT DENTAL^IA-OPT DENTAL^^^554
+17 ;;OUTPATIENT VISIT^IA-OPT VST^^^554
+18 ;;POLYTRAUMA OUTPATIENT VISIT^IA-OPT VST POLYTRAUMA^^^765
+19 ;;PM&RS OUTPATIENT VISIT^IA-OPT VST PM&RS^^^357
+20 ;;
+21 QUIT