ICD1893P.m

ICD1893P ;ALB/JDG - YEARLY DRG UPDATE;8/9/2010

 ;;18.0;DRG Grouper;**93**;Oct 20, 2000;Build 6

 ;

 ;This routine will kick off Routines needed for 

 ;FY 2018 updates to the DRG Grouper.

 ;

 ;

 Q

 ;

EN ; start update

 D PRES

 D DRG^ICD1893A ;FY2018 updates to MS-DRGS

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

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

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

 D INACTDRG^ICD1893O ; Inactivate DRGs

 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 ---ICD1893P   1379     printed  Apr 09, 2024@20:53:07                                                                                                                                                                                                    Page 2

ICD1893P  ;ALB/JDG - YEARLY DRG UPDATE;8/9/2010

 +1       ;;18.0;DRG Grouper;**93**;Oct 20, 2000;Build 6

 +2       ;

 +3       ;This routine will kick off Routines needed for 

 +4       ;FY 2018 updates to the DRG Grouper.

 +5       ;

 +6       ;

 +7        QUIT 

 +8       ;

EN        ; start update

 +1        DO PRES

 +2       ;FY2018 updates to MS-DRGS

           DO DRG^ICD1893A

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

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

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

 +6       ; Inactivate DRGs

           DO INACTDRG^ICD1893O

 +7        QUIT 

 +8       ;

PRES      ;

 +1        SET DIK="^ICDD(83,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +2        SET DIK="^ICDD(83.1,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.1,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +3        SET DIK="^ICDD(83.11,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.11,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +4        SET DIK="^ICDD(83.2,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.2,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +5        SET DIK="^ICDD(83.3,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.3,DA))

               if DA=0

                   QUIT 

               DO ^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        SET DIK="^ICDD(83.51,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.51,DA))

               if DA=0

                   QUIT 

               DO ^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        SET DIK="^ICDD(83.61,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.61,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +10       SET DIK="^ICDD(83.7,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.7,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +11       SET DIK="^ICDD(83.71,"

           SET DA=0

           FOR 

               SET DA=$ORDER(^ICDD(83.71,DA))

               if DA=0

                   QUIT 

               DO ^DIK

 +12       QUIT