PSAFIX ;BHM/DB - FIX INACTIVE DRUGS IN 58.8;10/3/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
D NOW^%DTC W @IOF K PSALOC,PSACNT
W !!,"Correcting erroneous Drug entries in file 58.8.",!
BGN ;begin the loop
S PSALOC=$S('$D(PSALOC):$O(^PSD(58.8,0)),1:$O(^PSD(58.8,PSALOC))) G DONE:PSALOC'>0
;
K DRUG
DRUG S DRUG=$S('$D(DRUG):$O(^PSD(58.8,PSALOC,1,0)),1:$O(^PSD(58.8,PSALOC,1,DRUG))) G BGN:DRUG'>0 G DRUG:'$D(^PSD(58.8,PSALOC,1,DRUG,0)) S DATA=^PSD(58.8,PSALOC,1,DRUG,0) I $P(DATA,"^",1)'="" G DRUG
S $P(^PSD(58.8,PSALOC,1,DRUG,0),"^",1)=DRUG,^PSD(58.8,PSALOC,1,"B",DRUG,DRUG)="",PSACNT=$G(PSACNT)+1
G DRUG
DONE W !!,"Patch PSA*3*3 has finished, and corrected ",$G(PSACNT)," bad entries.",!
Q Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSAFIX 733 printed Dec 13, 2024@01:49:18 Page 2
PSAFIX ;BHM/DB - FIX INACTIVE DRUGS IN 58.8;10/3/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3**; 10/24/97
+2 DO NOW^%DTC
WRITE @IOF
KILL PSALOC,PSACNT
+3 WRITE !!,"Correcting erroneous Drug entries in file 58.8.",!
BGN ;begin the loop
+1 SET PSALOC=$SELECT('$DATA(PSALOC):$ORDER(^PSD(58.8,0)),1:$ORDER(^PSD(58.8,PSALOC)))
if PSALOC'>0
GOTO DONE
+2 ;
+3 KILL DRUG
DRUG SET DRUG=$SELECT('$DATA(DRUG):$ORDER(^PSD(58.8,PSALOC,1,0)),1:$ORDER(^PSD(58.8,PSALOC,1,DRUG)))
if DRUG'>0
GOTO BGN
if '$DATA(^PSD(58.8,PSALOC,1,DRUG,0))
GOTO DRUG
SET DATA=^PSD(58.8,PSALOC,1,DRUG,0)
IF $PIECE(DATA,"^",1)'=""
GOTO DRUG
+1 SET $PIECE(^PSD(58.8,PSALOC,1,DRUG,0),"^",1)=DRUG
SET ^PSD(58.8,PSALOC,1,"B",DRUG,DRUG)=""
SET PSACNT=$GET(PSACNT)+1
+2 GOTO DRUG
DONE WRITE !!,"Patch PSA*3*3 has finished, and corrected ",$GET(PSACNT)," bad entries.",!
Q QUIT
