ICD18109P.m

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 ---ICD18109P   1452     printed  Mar 13, 2025@20:52:38                                                                                                                                                                                                   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