AULMICD.m

AULMICD ;CODE TO CHANGE INTERNAL NUMBERS [ 10/07/86  2:20 PM ]

 ;IN THE ICD FILE, DELETE OLD ONES AND CROSS REFERENCE NEW ONES

 S OS=12262,NS=20000,FO=20001,U="^"

 F I=0:0 S OS=$O(^LORIICD(OS)) Q:(OS="")!(OS=FO)!(OS'?5N)  S FROM="^LORIICD("_OS_",",NS=NS+1,TO="^LORIICD("_NS_"," D ^AIMUGTR1 S $P(^LORIICD(0),U,4)=$P(^LORIICD(0),U,4)+1 S DIK="^LORIICD(",DA=OS D ^DIK

RECROSS F I=FO:1:NS S DIK="^LORIICD(",DA=I D IX1^DIK

 S $P(^LORIICD(0),"^",3)=NS

 Q

AULMICD   ;CODE TO CHANGE INTERNAL NUMBERS [ 10/07/86  2:20 PM ]

 +1       ;IN THE ICD FILE, DELETE OLD ONES AND CROSS REFERENCE NEW ONES

 +2        SET OS=12262

           SET NS=20000

           SET FO=20001

           SET U="^"

 +3        FOR I=0:0

               SET OS=$ORDER(^LORIICD(OS))

               IF (OS="")!(OS=FO)!(OS'?5N)

                   QUIT 

               SET FROM="^LORIICD("_OS_","

               SET NS=NS+1

               SET TO="^LORIICD("_NS_","

               DO ^AIMUGTR1

               SET $PIECE(^LORIICD(0),U,4)=$PIECE(^LORIICD(0),U,4)+1

               SET DIK="^LORIICD("

               SET DA=OS

               DO ^DIK

RECROSS    FOR I=FO:1:NS

               SET DIK="^LORIICD("

               SET DA=I

               DO IX1^DIK

 +1        SET $PIECE(^LORIICD(0),"^",3)=NS

 +2        QUIT