PSDNSTK.m

PSDNSTK ;BIR/JPW-Inactivate Stocked Drugs ; 8 Aug 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 I '$D(PSDSITE) D ^PSDSET Q:'$D(PSDSITE)

 W !!,?5,"You may inactivate a Stocked Drug for a single NAOU,",!,?5,"or enter ^ALL  to inactivate the Drug in ALL NAOUs.",!

 K DA,DIC,PSDOUT F  Q:$D(PSDOUT)  W ! S ALL=1,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&(X'="^ALL")  D:X'="^ALL" INACT1 I ALL D ASK Q:$D(PSDOUT)

END K %,%DT,%H,%I,ALL,ANS1,ANS2,CNT,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,NAOU,NAOUN,PSDOUT,PSDR,PSDRN,PSDT,QUE,RDT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y

 K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("PSDMSG",$J)

 S:$D(ZTQUEUED) ZTREQ="@"

 Q

INACT1 ;inactivate a drug for a single NAOU

 S NAOU=+Y,NAOUN=$P(Y,"^",2),ALL=0

 I '$D(^PSD(58.8,NAOU,1,0)) W !!,"There are no stocked drugs for this NAOU!!",!! Q

LOOP K DA,DIC S DIC("W")="W:$P(^PSDRUG(Y,0),""^"",9) ""   N/F"" I $P(^PSD(58.8,NAOU,1,Y,0),""^"",14)]"""",$P(^(0),""^"",14)'>DT W $C(7),""   *** INACTIVE ***"""

 W ! S DIC="^PSD(58.8,"_NAOU_",1,",DA(1)=+NAOU,DIC(0)="QEAM" D ^DIC K DIC I $D(DTOUT)!$D(DUOUT) S PSDOUT=1 Q

 Q:Y<0  S PSDR=+Y K DA,DIE,DR S DA(1)=+NAOU,DIE="^PSD(58.8,"_NAOU_",1,",DA=+PSDR,DR="13;I X="""" S Y=""@1"";14;I X'=""O"" S Y=""@1"";14.5;@1" D ^DIE K DIE I $D(Y)!$D(DTOUT) S PSDOUT=1 Q

 S PSDRN=$P($G(^PSDRUG(+PSDR,0)),"^")

 I $P($G(^PSD(58.8,+NAOU,1,+PSDR,0)),"^",14) W !!,PSDRN," is now INACTIVE.",!! G LOOP

 W !!,"This "_PSDRN_" is ACTIVE on "_NAOUN_".",!!

 G LOOP

ASK ;ask inactivation date and reason

 ;clashed with CMOP W ! K DA,DIR,DIRUT S DIR(0)="50,.01O",DIR("A")="Select DRUG",DIR("?")="Enter the DRUG you wish to inactivate in all NAOUs." D ^DIR K DIR I $D(DIRUT) S PSDOUT=1 Q

 K DA,DIC S DIC=50,DIC("S")="I $P($G(^(2)),""^"",3)[""N""",DIC(0)="AQEOM",DIC("A")="Select DRUG: " D ^DIC K DIC S:Y<0 PSDOUT=1 Q:$G(PSDOUT)  S PSDR=+Y,PSDRN=$P(Y,"^",2),(ANS1,ANS2)=""

 W !! K DA,DIR,DIRUT S DIR(0)="58.8001,13" D ^DIR K DIR I $D(DIRUT)!'Y S PSDOUT=1 Q

 S PSDT=Y K DA,DIR,DIRUT,DTOUT,DUOUT S DIR(0)="58.8001,14" D ^DIR K DIR I $D(DUOUT)!$D(DTOUT) S PSDOUT=1 Q

 S ANS1=Y G:ANS1'="O" QUE K DA,DIR,DIRUT,DTOUT,DUOUT S DIR(0)="58.8001,14.5" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S PSDOUT=1 Q

 S ANS2=Y

QUE ;asks queueing information

 S QUE=0 W !! K DA,DIR,DIRUT S DIR(0)="Y",DIR("B")="YES",DIR("A")="Do you want to queue this job",DIR("?",1)="To queue this job to run at a later time and free up your terminal now,"

 S DIR("?")="accept the default, enter 'N' to run immediately or '^' to quit." D ^DIR K DIR I $D(DIRUT) S PSDOUT=1 W $C(7),!!,"The DRUG you selected will not be inactivated.",!! Q

 I 'Y W !!,"Inactivating now..." G START

 S QUE=1 W !!,"You will be notified by MailMan when the job is completed. ",!!

 S ZTIO="",ZTRTN="START^PSDNSTK",ZTDESC="CS PHARM MASS DRUG INACTIVATION" S (ZTSAVE("PSDR"),ZTSAVE("PSDRN"),ZTSAVE("ANS1"),ZTSAVE("ANS2"),ZTSAVE("QUE"),ZTSAVE("PSDT"),ZTSAVE("PSDSITE"))="" D ^%ZTLOAD K ZTSK Q

START ;

 S CNT=0 F NAOU=0:0 S NAOU=$O(^PSD(58.8,NAOU)) Q:'NAOU  I $P($G(^PSD(58.8,NAOU,0)),"^",3)=+PSDSITE,$P($G(^PSD(58.8,NAOU,0)),"^",2)'="P",$D(^PSD(58.8,NAOU,1,PSDR,0)),$P(^(0),"^",14)="" D DIE S CNT=CNT+1

 I 'QUE W $C(7),!!,PSDRN_" has been inactivated in "_CNT_" NAOU(s).",! Q

MSG ;send mailman message with completed info

 K XMY,^TMP("PSDMSG",$J) D NOW^%DTC S Y=X X ^DD("DD") S RDT=Y S ^TMP("PSDMSG",$J,1,0)="CS PHARM DRUG Inactivation background job has run to completion."

 S ^TMP("PSDMSG",$J,2,0)="Run Date: "_RDT,^TMP("PSDMSG",$J,3,0)="",^TMP("PSDMSG",$J,4,0)="**  "_PSDRN_" has been inactivated as of "_RDT_" in "_CNT_" NAOU(s)."

 S XMSUB="CS PHARM MASS DRUG INACTIVATION SUMMARY",XMDUZ="CONTROLLED SUBSTANCES PHARMACY",XMTEXT="^TMP(""PSDMSG"",$J,",XMY(DUZ)="" S:'$D(XMY) XMY(.5)="" D ^XMD K XMY,^TMP("PSDMSG",$J)

 G END

DIE ;inactivate a Drug for NAOUs

 K DA,DIE,DR S DA(1)=+NAOU,DA=+PSDR,DIE="^PSD(58.8,"_NAOU_",1,",DR="13////"_PSDT_";14////"_ANS1_";14.5////"_ANS2 D ^DIE K DIE,DR

 Q

PSDNSTK   ;BIR/JPW-Inactivate Stocked Drugs ; 8 Aug 94

 +1       ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

 +2        IF '$DATA(PSDSITE)

               DO ^PSDSET

               IF '$DATA(PSDSITE)

                   QUIT 

 +3        WRITE !!,?5,"You may inactivate a Stocked Drug for a single NAOU,",!,?5,"or enter ^ALL  to inactivate the Drug in ALL NAOUs.",!

 +4        KILL DA,DIC,PSDOUT

           FOR 

               IF $DATA(PSDOUT)

                   QUIT 

               WRITE !

               SET ALL=1

               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&(X'="^ALL")

                   QUIT 

               IF X'="^ALL"

                   DO INACT1

               IF ALL

                   DO ASK

                   IF $DATA(PSDOUT)

                       QUIT 

END        KILL %,%DT,%H,%I,ALL,ANS1,ANS2,CNT,DA,DIC,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,NAOU,NAOUN,PSDOUT,PSDR,PSDRN,PSDT,QUE,RDT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y

 +1        KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,^TMP("PSDMSG",$JOB)

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT 

INACT1    ;inactivate a drug for a single NAOU

 +1        SET NAOU=+Y

           SET NAOUN=$PIECE(Y,"^",2)

           SET ALL=0

 +2        IF '$DATA(^PSD(58.8,NAOU,1,0))

               WRITE !!,"There are no stocked drugs for this NAOU!!",!!

               QUIT 

LOOP       KILL DA,DIC

           SET DIC("W")="W:$P(^PSDRUG(Y,0),""^"",9) ""   N/F"" I $P(^PSD(58.8,NAOU,1,Y,0),""^"",14)]"""",$P(^(0),""^"",14)'>DT W $C(7),""   *** INACTIVE ***"""

 +1        WRITE !

           SET DIC="^PSD(58.8,"_NAOU_",1,"

           SET DA(1)=+NAOU

           SET DIC(0)="QEAM"

           DO ^DIC

           KILL DIC

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET PSDOUT=1

               QUIT 

 +2        IF Y<0

               QUIT 

           SET PSDR=+Y

           KILL DA,DIE,DR

           SET DA(1)=+NAOU

           SET DIE="^PSD(58.8,"_NAOU_",1,"

           SET DA=+PSDR

           SET DR="13;I X="""" S Y=""@1"";14;I X'=""O"" S Y=""@1"";14.5;@1"

           DO ^DIE

           KILL DIE

           IF $DATA(Y)!$DATA(DTOUT)

               SET PSDOUT=1

               QUIT 

 +3        SET PSDRN=$PIECE($GET(^PSDRUG(+PSDR,0)),"^")

 +4        IF $PIECE($GET(^PSD(58.8,+NAOU,1,+PSDR,0)),"^",14)

               WRITE !!,PSDRN," is now INACTIVE.",!!

               GOTO LOOP

 +5        WRITE !!,"This "_PSDRN_" is ACTIVE on "_NAOUN_".",!!

 +6        GOTO LOOP

ASK       ;ask inactivation date and reason

 +1       ;clashed with CMOP W ! K DA,DIR,DIRUT S DIR(0)="50,.01O",DIR("A")="Select DRUG",DIR("?")="Enter the DRUG you wish to inactivate in all NAOUs." D ^DIR K DIR I $D(DIRUT) S PSDOUT=1 Q

 +2        KILL DA,DIC

           SET DIC=50

           SET DIC("S")="I $P($G(^(2)),""^"",3)[""N"""

           SET DIC(0)="AQEOM"

           SET DIC("A")="Select DRUG: "

           DO ^DIC

           KILL DIC

           IF Y<0

               SET PSDOUT=1

           IF $GET(PSDOUT)

               QUIT 

           SET PSDR=+Y

           SET PSDRN=$PIECE(Y,"^",2)

           SET (ANS1,ANS2)=""

 +3        WRITE !!

           KILL DA,DIR,DIRUT

           SET DIR(0)="58.8001,13"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!'Y

               SET PSDOUT=1

               QUIT 

 +4        SET PSDT=Y

           KILL DA,DIR,DIRUT,DTOUT,DUOUT

           SET DIR(0)="58.8001,14"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)!$DATA(DTOUT)

               SET PSDOUT=1

               QUIT 

 +5        SET ANS1=Y

           IF ANS1'="O"

               GOTO QUE

           KILL DA,DIR,DIRUT,DTOUT,DUOUT

           SET DIR(0)="58.8001,14.5"

           DO ^DIR

           KILL DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET PSDOUT=1

               QUIT 

 +6        SET ANS2=Y

QUE       ;asks queueing information

 +1        SET QUE=0

           WRITE !!

           KILL DA,DIR,DIRUT

           SET DIR(0)="Y"

           SET DIR("B")="YES"

           SET DIR("A")="Do you want to queue this job"

           SET DIR("?",1)="To queue this job to run at a later time and free up your terminal now,"

 +2        SET DIR("?")="accept the default, enter 'N' to run immediately or '^' to quit."

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               SET PSDOUT=1

               WRITE $CHAR(7),!!,"The DRUG you selected will not be inactivated.",!!

               QUIT 

 +3        IF 'Y

               WRITE !!,"Inactivating now..."

               GOTO START

 +4        SET QUE=1

           WRITE !!,"You will be notified by MailMan when the job is completed. ",!!

 +5        SET ZTIO=""

           SET ZTRTN="START^PSDNSTK"

           SET ZTDESC="CS PHARM MASS DRUG INACTIVATION"

           SET (ZTSAVE("PSDR"),ZTSAVE("PSDRN"),ZTSAVE("ANS1"),ZTSAVE("ANS2"),ZTSAVE("QUE"),ZTSAVE("PSDT"),ZTSAVE("PSDSITE"))=""

           DO ^%ZTLOAD

           KILL ZTSK

           QUIT 

START     ;

 +1        SET CNT=0

           FOR NAOU=0:0

               SET NAOU=$ORDER(^PSD(58.8,NAOU))

               IF 'NAOU

                   QUIT 

               IF $PIECE($GET(^PSD(58.8,NAOU,0)),"^",3)=+PSDSITE

                   IF $PIECE($GET(^PSD(58.8,NAOU,0)),"^",2)'="P"

                       IF $DATA(^PSD(58.8,NAOU,1,PSDR,0))

                           IF $PIECE(^(0),"^",14)=""

                               DO DIE

                               SET CNT=CNT+1

 +2        IF 'QUE

               WRITE $CHAR(7),!!,PSDRN_" has been inactivated in "_CNT_" NAOU(s).",!

               QUIT 

MSG       ;send mailman message with completed info

 +1        KILL XMY,^TMP("PSDMSG",$JOB)

           DO NOW^%DTC

           SET Y=X

           XECUTE ^DD("DD")

           SET RDT=Y

           SET ^TMP("PSDMSG",$JOB,1,0)="CS PHARM DRUG Inactivation background job has run to completion."

 +2        SET ^TMP("PSDMSG",$JOB,2,0)="Run Date: "_RDT

           SET ^TMP("PSDMSG",$JOB,3,0)=""

           SET ^TMP("PSDMSG",$JOB,4,0)="**  "_PSDRN_" has been inactivated as of "_RDT_" in "_CNT_" NAOU(s)."

 +3        SET XMSUB="CS PHARM MASS DRUG INACTIVATION SUMMARY"

           SET XMDUZ="CONTROLLED SUBSTANCES PHARMACY"

           SET XMTEXT="^TMP(""PSDMSG"",$J,"

           SET XMY(DUZ)=""

           IF '$DATA(XMY)

               SET XMY(.5)=""

           DO ^XMD

           KILL XMY,^TMP("PSDMSG",$JOB)

 +4        GOTO END

DIE       ;inactivate a Drug for NAOUs

 +1        KILL DA,DIE,DR

           SET DA(1)=+NAOU

           SET DA=+PSDR

           SET DIE="^PSD(58.8,"_NAOU_",1,"

           SET DR="13////"_PSDT_";14////"_ANS1_";14.5////"_ANS2

           DO ^DIE

           KILL DIE,DR

 +2        QUIT