ATX21FX.m

ATX21FX ; IHS/OHPRD/TMJ - FIX ATXAX GLOBAL MULTIPLE 21 NODE ; 

 ;;5.1;TAXONOMY;;FEB 04, 1997

 ;

 ;This Routine fixes the 0 Node of Subscript 21 of the Taxonomy Global

 ;The file # in multiple sub-file (on some old Taxonomies) is 9002226.2101

 ;The file # should be 9002226.02101A

 ;

START ;

 D PROCESS

 D END

 Q

 ;

 ;

PROCESS ;$O to get IEN of Taxonomy

 S ATXTDFN=0

 F  S ATXTDFN=$O(^ATXAX(ATXTDFN)) Q:'ATXTDFN  D

 .Q:'$D(^ATXAX(ATXTDFN,0))

 .Q:'$D(^ATXAX(ATXTDFN,21,0))

 .S $P(^ATXAX(ATXTDFN,21,0),U,2)="9002226.02101A"

 .Q

 Q

END ;

 W !!,?10,"Fix of Taxonomy Global Subscript 21 Now Complete",!

 K ATXTDFN

 Q

ATX21FX   ; IHS/OHPRD/TMJ - FIX ATXAX GLOBAL MULTIPLE 21 NODE ; 

 +1       ;;5.1;TAXONOMY;;FEB 04, 1997

 +2       ;

 +3       ;This Routine fixes the 0 Node of Subscript 21 of the Taxonomy Global

 +4       ;The file # in multiple sub-file (on some old Taxonomies) is 9002226.2101

 +5       ;The file # should be 9002226.02101A

 +6       ;

START     ;

 +1        DO PROCESS

 +2        DO END

 +3        QUIT 

 +4       ;

 +5       ;

PROCESS   ;$O to get IEN of Taxonomy

 +1        SET ATXTDFN=0

 +2        FOR 

               SET ATXTDFN=$ORDER(^ATXAX(ATXTDFN))

               IF 'ATXTDFN

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^ATXAX(ATXTDFN,0))

                       QUIT 

 +4                IF '$DATA(^ATXAX(ATXTDFN,21,0))

                       QUIT 

 +5                SET $PIECE(^ATXAX(ATXTDFN,21,0),U,2)="9002226.02101A"

 +6                QUIT 

               End DoDot:1

 +7        QUIT 

END       ;

 +1        WRITE !!,?10,"Fix of Taxonomy Global Subscript 21 Now Complete",!

 +2        KILL ATXTDFN

 +3        QUIT