- 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
- 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
