ICD18103P.m

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 ---ICD18103P   540     printed  Apr 09, 2024@20:55:03                                                                                                                                                                                                    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