PSAFIX.m

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 ---PSAFIX   733     printed  Apr 09, 2024@20:53:52                                                                                                                                                                                                       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