ICD118P ;ALB/RFS - SEMI-ANNUAL DRG UPDATE; March 03, 2024@09:54
;;18.0;DRG Grouper;**118**;October 20, 2000;Build 7
;Per VA Directive 6402, this routine should not be modified.
;This routine will kick off routines needed for
;FY 2024 Semi-annual updates to the DRG Grouper V41R1.
;
;
Q
;
EN ; start update
D PRES
;follwing lines not needed for V41R1 as there are no DRG changes
;D DRG^ICD115A ;FY2024 updates to MS-DRGS
; ********************************************************************************
; *****routines ICD115F-K contain the data needed for the DRG Grouper update****
; ********************************************************************************
;D INACTDRG^ICD115O ; Inactivate DRGs (DRG inactivations for FY2024)
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[HICD118P 1675 printed Sep 15, 2024@21:11:39 Page 2
ICD118P ;ALB/RFS - SEMI-ANNUAL DRG UPDATE; March 03, 2024@09:54
+1 ;;18.0;DRG Grouper;**118**;October 20, 2000;Build 7
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;This routine will kick off routines needed for
+4 ;FY 2024 Semi-annual updates to the DRG Grouper V41R1.
+5 ;
+6 ;
+7 QUIT
+8 ;
EN ; start update
+1 DO PRES
+2 ;follwing lines not needed for V41R1 as there are no DRG changes
+3 ;D DRG^ICD115A ;FY2024 updates to MS-DRGS
+4 ; ********************************************************************************
+5 ; *****routines ICD115F-K contain the data needed for the DRG Grouper update****
+6 ; ********************************************************************************
+7 ;D INACTDRG^ICD115O ; Inactivate DRGs (DRG inactivations for FY2024)
+8 QUIT
+9 ;
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
