ICD112P.m

ICD112P ;ALB/MJF - YEARLY DRG UPDATE; October 01, 2020@15:42

 ;;18.0;DRG Grouper;**112**;October 20, 2000;Build 8

 ;

 ;This routine will kick off routines needed for 

 ;FY 2023 updates to the DRG Grouper.

 ;

 ;

 Q

 ;

EN ; start update

 D PRES

 D DRG^ICD112A ;FY2023 updates to MS-DRGS

 ; ********************************************************************************

 ; *****routines ICD112F-K contain the data needed for the DRG Grouper update****

 ; ********************************************************************************

 ;D INACTDRG^ICD112O ; Inactivate DRGs (no DRG inactivations for FY2023)

 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 ---ICD112P   1529     printed  Apr 09, 2024@20:53:58                                                                                                                                                                                                     Page 2

ICD112P   ;ALB/MJF - YEARLY DRG UPDATE; October 01, 2020@15:42

 +1       ;;18.0;DRG Grouper;**112**;October 20, 2000;Build 8

 +2       ;

 +3       ;This routine will kick off routines needed for 

 +4       ;FY 2023 updates to the DRG Grouper.

 +5       ;

 +6       ;

 +7        QUIT 

 +8       ;

EN        ; start update

 +1        DO PRES

 +2       ;FY2023 updates to MS-DRGS

           DO DRG^ICD112A

 +3       ; ********************************************************************************

 +4       ; *****routines ICD112F-K contain the data needed for the DRG Grouper update****

 +5       ; ********************************************************************************

 +6       ;D INACTDRG^ICD112O ; Inactivate DRGs (no DRG inactivations for FY2023)

 +7        QUIT 

 +8       ;

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