PSN4P26.m

PSN4P26 ;BIR/DMA-fix bad interaction names ;17 Feb 00 / 8:12 AM

 ;;4.0; NATIONAL DRUG FILE;**26**; 30 Oct 98

 ;

 S DA=0 F  S DA=$O(^PS(56,DA)) Q:'DA  S X=^(DA,0) D

 .K PSN,PSNN

 .S NAM=$P(X,"^"),PSN=$P(X,"^",2),PSN=$P(^PS(50.416,PSN,0),"^"),PSNN(PSN)="",PSN=$P(X,"^",3),PSN=$P(^PS(50.416,PSN,0),"^"),PSNN(PSN)=""

 .S NA1="",NA1=$O(PSNN(""))_"/"_$O(PSNN($O(PSNN(""))))

 .I NA1'=NAM W "." S DIE="^PS(56,",DR=".01////"_NA1 D ^DIE

 K DA,DIE,DR,NA1,NAM,PSN,PSNN,X

 Q

PSN4P26   ;BIR/DMA-fix bad interaction names ;17 Feb 00 / 8:12 AM

 +1       ;;4.0; NATIONAL DRUG FILE;**26**; 30 Oct 98

 +2       ;

 +3        SET DA=0

           FOR 

               SET DA=$ORDER(^PS(56,DA))

               IF 'DA

                   QUIT 

               SET X=^(DA,0)

               Begin DoDot:1

 +4                KILL PSN,PSNN

 +5                SET NAM=$PIECE(X,"^")

                   SET PSN=$PIECE(X,"^",2)

                   SET PSN=$PIECE(^PS(50.416,PSN,0),"^")

                   SET PSNN(PSN)=""

                   SET PSN=$PIECE(X,"^",3)

                   SET PSN=$PIECE(^PS(50.416,PSN,0),"^")

                   SET PSNN(PSN)=""

 +6                SET NA1=""

                   SET NA1=$ORDER(PSNN(""))_"/"_$ORDER(PSNN($ORDER(PSNN(""))))

 +7                IF NA1'=NAM

                       WRITE "."

                       SET DIE="^PS(56,"

                       SET DR=".01////"_NA1

                       DO ^DIE

               End DoDot:1

 +8        KILL DA,DIE,DR,NA1,NAM,PSN,PSNN,X

 +9        QUIT