PSDPSTK.m

PSDPSTK ;BIR/JPW-Print Data for CS Stock Drugs ; 7 Sept 92

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

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

 W !!,"This report lists data stored for CS Stock Drugs.",!!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!

 I '$O(^PSD(58.8,0)) W !!,"You MUST create NAOUs before running this report!" Q

 D NOW^%DTC S PSDT=X

DEV ;ask device and queueing information

 K %ZIS,IOP,IO("Q"),POP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END

 I $D(IO("Q")) K IO("Q") S PSDIO=ION,ZTIO="" K ZTSAVE,ZTDTH,ZTSK S ZTRTN="START^PSDPSTK",ZTDESC="Compile Data for CS PHARM Stock Drugs",ZTSAVE("PSDIO")="",ZTSAVE("PSDSITE")="",ZTSAVE("PSDT")="" D ^%ZTLOAD K ZTSK G END

 U IO

START ;compile data for stock drug report

 K ^TMP("PSDPSTK",$J)

 F NAOU=0:0 S NAOU=$O(^PSD(58.8,NAOU)) G:('NAOU)&($D(ZTQUEUED)) PRTQUE G:'NAOU PRINT^PSDPSTK1 I $D(^PSD(58.8,NAOU,0)),$P(^(0),"^",3)=+PSDSITE,$P(^(0),"^",2)'="P" F DRUG=0:0 S DRUG=$O(^PSD(58.8,NAOU,1,DRUG)) Q:'DRUG  D

 .Q:'$D(^PSD(58.8,NAOU,1,DRUG,0))  I +$P(^PSD(58.8,NAOU,1,DRUG,0),"^",14) D NOW^%DTC I $P(^PSD(58.8,NAOU,1,DRUG,0),"^",14)'>X Q

 .Q:'$D(^PSDRUG(DRUG,0))  I $D(^PSDRUG(DRUG,0)) S DRUGN=$S($P(^PSDRUG(DRUG,0),"^")]"":$P(^(0),"^"),1:"ZZ/"_DRUG)

 .I $D(^PSD(58.8,NAOU,"I")),$P(^("I"),"^"),$P(^("I"),"^")'>PSDT S ^TMP("PSDPSTK",$J,DRUGN,NAOU,0)="I^"_$P(^("I"),"^") Q

 .S NODE=^PSD(58.8,NAOU,1,DRUG,0),LOC=$S($P(NODE,"^",2)]"":$P(NODE,"^",2),1:"NONE"),STK=$S($P(NODE,"^",3)]"":$P(NODE,"^",3),1:"NONE")

 .S TYPE="" F TYP=0:0 S TYP=$O(^PSD(58.8,NAOU,1,DRUG,2,TYP)) Q:'TYP  S TYPE=TYPE_";;"_TYP

 .S WARD="" F WRD=0:0 S WRD=$O(^PSD(58.8,NAOU,1,DRUG,1,WRD)) Q:'WRD  S WARD=WARD_";;"_WRD

 .S:TYPE="" TYPE=";;NONE" S:WARD="" WARD=";;NONE" S ^TMP("PSDPSTK",$J,DRUGN,NAOU,0)=LOC_"^"_STK_"^"_TYPE

 .S ^TMP("PSDPSTK",$J,DRUGN,NAOU,1)=WARD

 Q

END ;

 K %,%H,%I,%ZIS,DA,DATEI,DIK,DRUG,DRUGN,IO("Q"),LOC,NAOU,NODE,POP,PSDIO,PSDT,STK,TYP,TYPE,WARD,WRD

 K X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPSTK",$J) D ^%ZISC

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

 Q

PRTQUE ;queues print after data is compiled

 K ZTSAVE,ZTIO S ZTIO=PSDIO,ZTRTN="PRINT^PSDPSTK1",ZTDESC="Print Data for CS PHARM Stock Drugs",ZTDTH=$H,ZTSAVE("^TMP(""PSDPSTK"",$J,")=""

 D ^%ZTLOAD K ^TMP("PSDPSTK",$J) K ZTSK G END

PSDPSTK   ;BIR/JPW-Print Data for CS Stock Drugs ; 7 Sept 92

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

 +2        IF '$DATA(PSDSITE)

               DO ^PSDSET

               IF '$DATA(PSDSITE)

                   QUIT 

 +3        WRITE !!,"This report lists data stored for CS Stock Drugs.",!!,"This report is designed for a 132 column format.",!,"You may queue this report to print at a later time.",!!

 +4        IF '$ORDER(^PSD(58.8,0))

               WRITE !!,"You MUST create NAOUs before running this report!"

               QUIT 

 +5        DO NOW^%DTC

           SET PSDT=X

DEV       ;ask device and queueing information

 +1        KILL %ZIS,IOP,IO("Q"),POP

           SET %ZIS="QM"

           SET %ZIS("B")=""

           DO ^%ZIS

           IF POP

               WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"

               GOTO END

 +2        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET PSDIO=ION

               SET ZTIO=""

               KILL ZTSAVE,ZTDTH,ZTSK

               SET ZTRTN="START^PSDPSTK"

               SET ZTDESC="Compile Data for CS PHARM Stock Drugs"

               SET ZTSAVE("PSDIO")=""

               SET ZTSAVE("PSDSITE")=""

               SET ZTSAVE("PSDT")=""

               DO ^%ZTLOAD

               KILL ZTSK

               GOTO END

 +3        USE IO

START     ;compile data for stock drug report

 +1        KILL ^TMP("PSDPSTK",$JOB)

 +2        FOR NAOU=0:0

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

               IF ('NAOU)&($DATA(ZTQUEUED))

                   GOTO PRTQUE

               IF 'NAOU

                   GOTO PRINT^PSDPSTK1

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

                   IF $PIECE(^(0),"^",3)=+PSDSITE

                       IF $PIECE(^(0),"^",2)'="P"

                           FOR DRUG=0:0

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

                               IF 'DRUG

                                   QUIT 

                               Begin DoDot:1

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

                                       QUIT 

                                   IF +$PIECE(^PSD(58.8,NAOU,1,DRUG,0),"^",14)

                                       DO NOW^%DTC

                                       IF $PIECE(^PSD(58.8,NAOU,1,DRUG,0),"^",14)'>X

                                           QUIT 

 +4                                IF '$DATA(^PSDRUG(DRUG,0))

                                       QUIT 

                                   IF $DATA(^PSDRUG(DRUG,0))

                                       SET DRUGN=$SELECT($PIECE(^PSDRUG(DRUG,0),"^")]"":$PIECE(^(0),"^"),1:"ZZ/"_DRUG)

 +5                                IF $DATA(^PSD(58.8,NAOU,"I"))

                                       IF $PIECE(^("I"),"^")

                                           IF $PIECE(^("I"),"^")'>PSDT

                                               SET ^TMP("PSDPSTK",$JOB,DRUGN,NAOU,0)="I^"_$PIECE(^("I"),"^")

                                               QUIT 

 +6                                SET NODE=^PSD(58.8,NAOU,1,DRUG,0)

                                   SET LOC=$SELECT($PIECE(NODE,"^",2)]"":$PIECE(NODE,"^",2),1:"NONE")

                                   SET STK=$SELECT($PIECE(NODE,"^",3)]"":$PIECE(NODE,"^",3),1:"NONE")

 +7                                SET TYPE=""

                                   FOR TYP=0:0

                                       SET TYP=$ORDER(^PSD(58.8,NAOU,1,DRUG,2,TYP))

                                       IF 'TYP

                                           QUIT 

                                       SET TYPE=TYPE_";;"_TYP

 +8                                SET WARD=""

                                   FOR WRD=0:0

                                       SET WRD=$ORDER(^PSD(58.8,NAOU,1,DRUG,1,WRD))

                                       IF 'WRD

                                           QUIT 

                                       SET WARD=WARD_";;"_WRD

 +9                                IF TYPE=""

                                       SET TYPE=";;NONE"

                                   IF WARD=""

                                       SET WARD=";;NONE"

                                   SET ^TMP("PSDPSTK",$JOB,DRUGN,NAOU,0)=LOC_"^"_STK_"^"_TYPE

 +10                               SET ^TMP("PSDPSTK",$JOB,DRUGN,NAOU,1)=WARD

                               End DoDot:1

 +11       QUIT 

END       ;

 +1        KILL %,%H,%I,%ZIS,DA,DATEI,DIK,DRUG,DRUGN,IO("Q"),LOC,NAOU,NODE,POP,PSDIO,PSDT,STK,TYP,TYPE,WARD,WRD

 +2        KILL X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPSTK",$JOB)

           DO ^%ZISC

 +3        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        QUIT 

PRTQUE    ;queues print after data is compiled

 +1        KILL ZTSAVE,ZTIO

           SET ZTIO=PSDIO

           SET ZTRTN="PRINT^PSDPSTK1"

           SET ZTDESC="Print Data for CS PHARM Stock Drugs"

           SET ZTDTH=$HOROLOG

           SET ZTSAVE("^TMP(""PSDPSTK"",$J,")=""

 +2        DO ^%ZTLOAD

           KILL ^TMP("PSDPSTK",$JOB)

           KILL ZTSK

           GOTO END