ICD18103P ;ALB/JDG - DRG UPDATE COVID19; 4/1/2020@13:36
;;18.0;DRG Grouper;**103**;Oct 20, 2000;Build 4
;
;This routine will kick off FY 2020 COVID-19
;updates to the DRG Grouper.
;
;
Q
;
EN ; start update
D PRES
Q
;
PRES ;
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.2," S DA=0 F S DA=$O(^ICDD(83.2,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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD18103P 540 printed Dec 13, 2024@01:47:43 Page 2
ICD18103P ;ALB/JDG - DRG UPDATE COVID19; 4/1/2020@13:36
+1 ;;18.0;DRG Grouper;**103**;Oct 20, 2000;Build 4
+2 ;
+3 ;This routine will kick off FY 2020 COVID-19
+4 ;updates to the DRG Grouper.
+5 ;
+6 ;
+7 QUIT
+8 ;
EN ; start update
+1 DO PRES
+2 QUIT
+3 ;
PRES ;
+1 SET DIK="^ICDD(83.1,"
SET DA=0
FOR
SET DA=$ORDER(^ICDD(83.1,DA))
if DA=0
QUIT
DO ^DIK
+2 SET DIK="^ICDD(83.2,"
SET DA=0
FOR
SET DA=$ORDER(^ICDD(83.2,DA))
if DA=0
QUIT
DO ^DIK
+3 SET DIK="^ICDD(83.5,"
SET DA=0
FOR
SET DA=$ORDER(^ICDD(83.5,DA))
if DA=0
QUIT
DO ^DIK
+4 SET DIK="^ICDD(83.51,"
SET DA=0
FOR
SET DA=$ORDER(^ICDD(83.51,DA))
if DA=0
QUIT
DO ^DIK
+5 QUIT
