PSDNACT ;BIR/JPW-Inactivate NAOUs ; 6 July 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)
W !!,?10,"Inactivate NAOUs" D NOW^%DTC S PSDT=X
NAOU ;
K DIC F W ! S DIC=58.8,DIC(0)="QEA",DIC("A")="Select NAOU: ",DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$P(^(0),""^"",2)'=""P""" D ^DIC K DIC Q:Y<0 S PSDA=+Y,PSDN=$P(Y,"^",2) K DA,DIE,DR S DIE=58.8,DA=+PSDA,DR="4" D ^DIE K DIE,DR D LOOP
END K %,%H,%I,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSDA,PSDN,PSDR,PSDT,X,Y
Q
LOOP ;asks for inactivating drugs and loops to complete
I $S('$D(^PSD(58.8,PSDA,"I")):1,'^("I"):1,^("I")>DT:1,1:0) W !!,"This NAOU is now ACTIVE. Use the Inactivate NAOU Stock Drug option",!,"to reactivate stocked drugs within "_PSDN_"." Q
W !! K DA,DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to inactivate ALL stocked drugs within this NAOU"
S DIR("?",1)="Answer 'YES' to inactivate all stocked drugs in this NAOU,",DIR("?")="answer 'NO' to leave all stocked drugs ACTIVE in this NAOU."
D ^DIR K DIR I 'Y!$D(DIRUT) D MSG Q
I '$D(^PSD(58.8,PSDA,1,0)) W !!,"There are no stocked drugs for this NAOU!!",!! Q
W !!,"Inactivating all stocked drugs within "_PSDN_"..."
F PSDR=0:0 S PSDR=$O(^PSD(58.8,PSDA,1,PSDR)) Q:'PSDR I $D(^PSD(58.8,PSDA,1,PSDR,0)) K DA,DIE,DR S DA=+PSDR,DA(1)=+PSDA,DIE="^PSD(58.8,"_PSDA_",1,",DR="13////"_PSDT_";14////O;14.5////NAOU INACTIVATED" D ^DIE K DIE,DR W "."
MSG W !!,PSDN," has been inactivated.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNACT 1470 printed Dec 13, 2024@01:46:46 Page 2
PSDNACT ;BIR/JPW-Inactivate NAOUs ; 6 July 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
+2 IF '$DATA(PSDSITE)
DO ^PSDSET
if '$DATA(PSDSITE)
QUIT
+3 WRITE !!,?10,"Inactivate NAOUs"
DO NOW^%DTC
SET PSDT=X
NAOU ;
+1 KILL DIC
FOR
WRITE !
SET DIC=58.8
SET DIC(0)="QEA"
SET DIC("A")="Select NAOU: "
SET DIC("S")="I $P(^(0),""^"",3)=+PSDSITE,$P(^(0),""^"",2)'=""P"""
DO ^DIC
KILL DIC
if Y<0
QUIT
SET PSDA=+Y
SET PSDN=$PIECE(Y,"^",2)
KILL DA,DIE,DR
SET DIE=58.8
SET DA=+PSDA
SET DR="4"
DO ^DIE
KILL DIE,DR
DO LOOP
END KILL %,%H,%I,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,PSDA,PSDN,PSDR,PSDT,X,Y
+1 QUIT
LOOP ;asks for inactivating drugs and loops to complete
+1 IF $SELECT('$DATA(^PSD(58.8,PSDA,"I")):1,'^("I"):1,^("I")>DT:1,1:0)
WRITE !!,"This NAOU is now ACTIVE. Use the Inactivate NAOU Stock Drug option",!,"to reactivate stocked drugs within "_PSDN_"."
QUIT
+2 WRITE !!
KILL DA,DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to inactivate ALL stocked drugs within this NAOU"
+3 SET DIR("?",1)="Answer 'YES' to inactivate all stocked drugs in this NAOU,"
SET DIR("?")="answer 'NO' to leave all stocked drugs ACTIVE in this NAOU."
+4 DO ^DIR
KILL DIR
IF 'Y!$DATA(DIRUT)
DO MSG
QUIT
+5 IF '$DATA(^PSD(58.8,PSDA,1,0))
WRITE !!,"There are no stocked drugs for this NAOU!!",!!
QUIT
+6 WRITE !!,"Inactivating all stocked drugs within "_PSDN_"..."
+7 FOR PSDR=0:0
SET PSDR=$ORDER(^PSD(58.8,PSDA,1,PSDR))
if 'PSDR
QUIT
IF $DATA(^PSD(58.8,PSDA,1,PSDR,0))
KILL DA,DIE,DR
SET DA=+PSDR
SET DA(1)=+PSDA
SET DIE="^PSD(58.8,"_PSDA_",1,"
SET DR="13////"_PSDT_";14////O;14.5////NAOU INACTIVATED"
DO ^DIE
KILL DIE,DR
WRITE "."
MSG WRITE !!,PSDN," has been inactivated.",!
+1 QUIT
