- ICD120P ;ALB/RFS - YEARLY DRG UPDATE; AUGUST 15, 2024@15:09
- ;;18.0;DRG Grouper;**120**;October 20, 2000;Build 4
- ;Per VA Directive 6402, this routine should not be modified.
- ;This routine will kick off routines needed for
- ;FY 2025 updates to the DRG Grouper.
- ;
- ;
- Q
- ;
- EN ; start update
- D PRES
- D DRG^ICD120A ;FY2025 updates to MS-DRGS
- ; ********************************************************************************
- ; *****routines ICD120F-K contain the data needed for the DRG Grouper update****
- ; ********************************************************************************
- D INACTDRG^ICD120O ; Inactivate DRGs (DRG inactivations for FY2025)
- Q
- ;
- PRES ;
- D BMES^XPDUTL(">>> Killing the DRG Calculation (#83.x) files to upload clean data...")
- S DIK="^ICDD(83," S DA=0 F S DA=$O(^ICDD(83,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.1," S DA=0 F S DA=$O(^ICDD(83.1,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.11," S DA=0 F S DA=$O(^ICDD(83.11,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.2," S DA=0 F S DA=$O(^ICDD(83.2,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.3," S DA=0 F S DA=$O(^ICDD(83.3,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.5," S DA=0 F S DA=$O(^ICDD(83.5,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.51," S DA=0 F S DA=$O(^ICDD(83.51,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.6," S DA=0 F S DA=$O(^ICDD(83.6,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.61," S DA=0 F S DA=$O(^ICDD(83.61,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.7," S DA=0 F S DA=$O(^ICDD(83.7,DA)) Q:DA=0 D ^DIK
- S DIK="^ICDD(83.71," S DA=0 F S DA=$O(^ICDD(83.71,DA)) Q:DA=0 D ^DIK
- K DA,DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD120P 1583 printed Mar 13, 2025@20:52:12 Page 2
- ICD120P ;ALB/RFS - YEARLY DRG UPDATE; AUGUST 15, 2024@15:09
- +1 ;;18.0;DRG Grouper;**120**;October 20, 2000;Build 4
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;This routine will kick off routines needed for
- +4 ;FY 2025 updates to the DRG Grouper.
- +5 ;
- +6 ;
- +7 QUIT
- +8 ;
- EN ; start update
- +1 DO PRES
- +2 ;FY2025 updates to MS-DRGS
- DO DRG^ICD120A
- +3 ; ********************************************************************************
- +4 ; *****routines ICD120F-K contain the data needed for the DRG Grouper update****
- +5 ; ********************************************************************************
- +6 ; Inactivate DRGs (DRG inactivations for FY2025)
- DO INACTDRG^ICD120O
- +7 QUIT
- +8 ;
- PRES ;
- +1 DO BMES^XPDUTL(">>> Killing the DRG Calculation (#83.x) files to upload clean data...")
- +2 SET DIK="^ICDD(83,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83,DA))
- if DA=0
- QUIT
- DO ^DIK
- +3 SET DIK="^ICDD(83.1,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.1,DA))
- if DA=0
- QUIT
- DO ^DIK
- +4 SET DIK="^ICDD(83.11,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.11,DA))
- if DA=0
- QUIT
- DO ^DIK
- +5 SET DIK="^ICDD(83.2,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.2,DA))
- if DA=0
- QUIT
- DO ^DIK
- +6 SET DIK="^ICDD(83.3,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.3,DA))
- if DA=0
- QUIT
- DO ^DIK
- +7 SET DIK="^ICDD(83.5,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.5,DA))
- if DA=0
- QUIT
- DO ^DIK
- +8 SET DIK="^ICDD(83.51,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.51,DA))
- if DA=0
- QUIT
- DO ^DIK
- +9 SET DIK="^ICDD(83.6,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.6,DA))
- if DA=0
- QUIT
- DO ^DIK
- +10 SET DIK="^ICDD(83.61,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.61,DA))
- if DA=0
- QUIT
- DO ^DIK
- +11 SET DIK="^ICDD(83.7,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.7,DA))
- if DA=0
- QUIT
- DO ^DIK
- +12 SET DIK="^ICDD(83.71,"
- SET DA=0
- FOR
- SET DA=$ORDER(^ICDD(83.71,DA))
- if DA=0
- QUIT
- DO ^DIK
- +13 KILL DA,DIK
- +14 QUIT
