ICD125PT.m

ICD125PT ;ALB/ABR - RESTORE NAME TO ICD (DRG) GLOBAL - AUG 9 1996

 ;;12.0;DRG GROUPER;**5**;APR 12, 1995

 ;This routine will restore the .01 name value in file 80.2

 ;

EN ;

 N X,Y,DA,DR,DIE

 D BMES^XPDUTL("Cleaning up DRG file.")

 S DA=0

 S DIE="^ICD("

 F  S DA=$O(^ICD(DA)) Q:'DA  I $E(^(DA,0))="^" D

 . S DR=".01///DRG"_DA D ^DIE

 D MES^XPDUTL(">> DONE!")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ICD125PT   374     printed  Apr 09, 2024@20:55:18                                                                                                                                                                                                     Page 2

ICD125PT  ;ALB/ABR - RESTORE NAME TO ICD (DRG) GLOBAL - AUG 9 1996

 +1       ;;12.0;DRG GROUPER;**5**;APR 12, 1995

 +2       ;This routine will restore the .01 name value in file 80.2

 +3       ;

EN        ;

 +1        NEW X,Y,DA,DR,DIE

 +2        DO BMES^XPDUTL("Cleaning up DRG file.")

 +3        SET DA=0

 +4        SET DIE="^ICD("

 +5        FOR 

               SET DA=$ORDER(^ICD(DA))

               if 'DA

                   QUIT 

               IF $EXTRACT(^(DA,0))="^"

                   Begin DoDot:1

 +6                    SET DR=".01///DRG"_DA

                       DO ^DIE

                   End DoDot:1

 +7        DO MES^XPDUTL(">> DONE!")

 +8        QUIT