PSDNACT.m

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

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