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 ---[H[J[2J[HPSS1P43 573 printed Dec 13, 2024@02:29:28 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
