ICD18109P ;ALB/JDG - YEARLY DRG UPDATE; March 01, 2022@15:42
;;18.0;DRG Grouper;**109**;October 20, 2000;Build 2
;
;This routine will kick off routines needed for
;FY 2022 COVID updates to the DRG Grouper.
;
;
Q
;
EN ; start update
D PRES
;D DRG^ICD18109A ;FY2022 updates to MS-DRGS
; ********************************************************************************
; *****routines ICD18109F-K contain the data needed for the DRG Grouper update*****
; ********************************************************************************
;D INACTDRG^ICD18109O ; Inactivate DRGs (no DRG inactivations for FY2022)
Q
;
PRES ;
;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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD18109P 1452 printed Nov 22, 2024@16:58:09 Page 2
ICD18109P ;ALB/JDG - YEARLY DRG UPDATE; March 01, 2022@15:42
+1 ;;18.0;DRG Grouper;**109**;October 20, 2000;Build 2
+2 ;
+3 ;This routine will kick off routines needed for
+4 ;FY 2022 COVID updates to the DRG Grouper.
+5 ;
+6 ;
+7 QUIT
+8 ;
EN ; start update
+1 DO PRES
+2 ;D DRG^ICD18109A ;FY2022 updates to MS-DRGS
+3 ; ********************************************************************************
+4 ; *****routines ICD18109F-K contain the data needed for the DRG Grouper update*****
+5 ; ********************************************************************************
+6 ;D INACTDRG^ICD18109O ; Inactivate DRGs (no DRG inactivations for FY2022)
+7 QUIT
+8 ;
PRES ;
+1 ;S DIK="^ICDD(83," S DA=0 F S DA=$O(^ICDD(83,DA)) Q:DA=0 D ^DIK
+2 ;S DIK="^ICDD(83.1," S DA=0 F S DA=$O(^ICDD(83.1,DA)) Q:DA=0 D ^DIK
+3 ;S DIK="^ICDD(83.11," S DA=0 F S DA=$O(^ICDD(83.11,DA)) Q:DA=0 D ^DIK
+4 ;S DIK="^ICDD(83.2," S DA=0 F S DA=$O(^ICDD(83.2,DA)) Q:DA=0 D ^DIK
+5 ;S DIK="^ICDD(83.3," S DA=0 F S DA=$O(^ICDD(83.3,DA)) Q:DA=0 D ^DIK
+6 SET DIK="^ICDD(83.5,"
SET DA=0
FOR
SET DA=$ORDER(^ICDD(83.5,DA))
if DA=0
QUIT
DO ^DIK
+7 ;S DIK="^ICDD(83.51," S DA=0 F S DA=$O(^ICDD(83.51,DA)) Q:DA=0 D ^DIK
+8 SET DIK="^ICDD(83.6,"
SET DA=0
FOR
SET DA=$ORDER(^ICDD(83.6,DA))
if DA=0
QUIT
DO ^DIK
+9 ;S DIK="^ICDD(83.61," S DA=0 F S DA=$O(^ICDD(83.61,DA)) Q:DA=0 D ^DIK
+10 ;S DIK="^ICDD(83.7," S DA=0 F S DA=$O(^ICDD(83.7,DA)) Q:DA=0 D ^DIK
+11 ;S DIK="^ICDD(83.71," S DA=0 F S DA=$O(^ICDD(83.71,DA)) Q:DA=0 D ^DIK
+12 QUIT
