PSS1P43.m

PSS1P43 ;BIR/DMA-fix bad interaction names ; 03/15/01 12:52

 ;;1.0; PHARMACY DATA MANAGEMENT;**43**;9/30/97

 ;

 ;Reference to ^PS(56 supported by DBIA #2133

 ;Reference to ^PS(50.416 supported by DBIA #2196

 ;

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSS1P43   573     printed  Apr 09, 2024@21:32:34                                                                                                                                                                                                      Page 2

PSS1P43   ;BIR/DMA-fix bad interaction names ; 03/15/01 12:52

 +1       ;;1.0; PHARMACY DATA MANAGEMENT;**43**;9/30/97

 +2       ;

 +3       ;Reference to ^PS(56 supported by DBIA #2133

 +4       ;Reference to ^PS(50.416 supported by DBIA #2196

 +5       ;

 +6        SET DA=0

           FOR 

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

               if 'DA

                   QUIT 

               SET X=^(DA,0)

               Begin DoDot:1

 +7                KILL PSN,PSNN

 +8                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)=""

 +9                SET NA1=""

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

 +10               IF NA1'=NAM

                       WRITE "."

                       SET DIE="^PS(56,"

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

                       DO ^DIE

               End DoDot:1

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

 +12       QUIT