Routine: PSDPMFG1

PSDPMFG1 ;BIR/JPW-Print Mfg data for CS Drugs (cont'd) ; 2 Aug 94

 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97

PRINT ;print data for stock drugs

 K LN S (PG,PSDOUT)=0,$P(LN,"-",132)="",%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y D HEADER Q:PSDOUT

 I '$D(^TMP("PSDPMFG",$J)) W !!,?45,"*****  NO DATA AVAILABLE FOR THIS REPORT  *****" G END

 S VAR1="" F  S VAR1=$O(^TMP("PSDPMFG",$J,VAR1)) Q:VAR1=""!(PSDOUT)  D:$Y+5>IOSL HEADER Q:PSDOUT  W !,"=> ",$S(VAR1["ZZ/":"#"_$P(VAR1,"/",2)_" NAME MISSING",1:VAR1) D  Q:PSDOUT

 .S VAR2="" F  S VAR2=$O(^TMP("PSDPMFG",$J,VAR1,VAR2)) Q:VAR2=""!(PSDOUT)  D  Q:PSDOUT

 ..S NODE=^TMP("PSDPMFG",$J,VAR1,VAR2) S VAR2N=$S(VAR2["ZZ/":"#"_$P(VAR2,"/",2)_" NAME MISSING",1:VAR2)

 ..S MFG=$P(NODE,"^"),LOT=$P(NODE,"^",2),BKU=$P(NODE,"^",4),PKG=$P(NODE,"^",5),EXP=$P(NODE,"^",3)

 ..D:$Y+5>IOSL HEADER Q:PSDOUT  W !,?4,VAR2N,?46,MFG,?80,LOT,?95,EXP,?110,BKU,?122,PKG

DONE I $E(IOST)'="C" W @IOF

 I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT!  Press <RET> to return to the menu" D ^DIR K DIR

END ;

 K %DT,%ZIS,ANS,BKU,CNT,DA,DIK,DIR,DIROUT,DIRUT,DRUG,DRUGN,DTOUT,DUOUT,EXP,LN,LOT,MFG,NAOU,NAOUN,NODE,PG,PKG,POP,PSD,PSDIO,PSDT,PSDOUT,RPDT

 K VAR1,VAR2,VAR2N,X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPMFG",$J) D ^%ZISC

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

HEADER ;lists header infomation

 I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q

 W:$Y @IOF S PG=PG+1 W !,RPDT,?122,"PAGE: "_PG,!,?50,"MANUFACTURER and NARCOTIC INFORMATION",!,?60,"FOR CS STOCK DRUGS",!!

 W "=> ",$S(CNT=1:"NAOU",ANS="N":"NAOU",1:"DRUG"),?95,"EXPIRATION",?110,"BREAKDOWN",?122,"PACKAGE",!,?14,$S(CNT=1:"DRUG",ANS="N":"DRUG",1:"NAOU")

 W ?46,"MANUFACTURER",?80,"LOT #",?95,"DATE",?110,"UNIT",?122,"SIZE",!,LN,!

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDPMFG1   1788     printed  Apr 09, 2024@20:54:35                                                                                                                                                                                                    Page 2

PSDPMFG1  ;BIR/JPW-Print Mfg data for CS Drugs (cont'd) ; 2 Aug 94

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

PRINT     ;print data for stock drugs

 +1        KILL LN

           SET (PG,PSDOUT)=0

           SET $PIECE(LN,"-",132)=""

           SET %DT=""

           SET X="T"

           DO ^%DT

           XECUTE ^DD("DD")

           SET RPDT=Y

           DO HEADER

           if PSDOUT

               QUIT

 +2        IF '$DATA(^TMP("PSDPMFG",$JOB))

               WRITE !!,?45,"*****  NO DATA AVAILABLE FOR THIS REPORT  *****"

               GOTO END

 +3        SET VAR1=""

FOR

               SET VAR1=$ORDER(^TMP("PSDPMFG",$JOB,VAR1))

               if VAR1=""!(PSDOUT)

                   QUIT

               if $Y+5>IOSL

                   DO HEADER

               if PSDOUT

                   QUIT

               WRITE !,"=> ",$SELECT(VAR1["ZZ/":"#"_$PIECE(VAR1,"/",2)_" NAME MISSING",1:VAR1)

               Begin DoDot:1

 +4                SET VAR2=""

FOR

                       SET VAR2=$ORDER(^TMP("PSDPMFG",$JOB,VAR1,VAR2))

                       if VAR2=""!(PSDOUT)

                           QUIT

                       Begin DoDot:2

 +5                        SET NODE=^TMP("PSDPMFG",$JOB,VAR1,VAR2)

                           SET VAR2N=$SELECT(VAR2["ZZ/":"#"_$PIECE(VAR2,"/",2)_" NAME MISSING",1:VAR2)

 +6                        SET MFG=$PIECE(NODE,"^")

                           SET LOT=$PIECE(NODE,"^",2)

                           SET BKU=$PIECE(NODE,"^",4)

                           SET PKG=$PIECE(NODE,"^",5)

                           SET EXP=$PIECE(NODE,"^",3)

 +7                        if $Y+5>IOSL

                               DO HEADER

                           if PSDOUT

                               QUIT

                           WRITE !,?4,VAR2N,?46,MFG,?80,LOT,?95,EXP,?110,BKU,?122,PKG

                       End DoDot:2

                       if PSDOUT

                           QUIT

               End DoDot:1

               if PSDOUT

                   QUIT

DONE       IF $EXTRACT(IOST)'="C"

               WRITE @IOF

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF 'PSDOUT

                   WRITE !

                   KILL DIR,DIRUT

                   SET DIR(0)="EA"

                   SET DIR("A")="END OF REPORT!  Press <RET> to return to the menu"

                   DO ^DIR

                   KILL DIR

END       ;

 +1        KILL %DT,%ZIS,ANS,BKU,CNT,DA,DIK,DIR,DIROUT,DIRUT,DRUG,DRUGN,DTOUT,DUOUT,EXP,LN,LOT,MFG,NAOU,NAOUN,NODE,PG,PKG,POP,PSD,PSDIO,PSDT,PSDOUT,RPDT

 +2        KILL VAR1,VAR2,VAR2N,X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPMFG",$JOB)

           DO ^%ZISC

 +3        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +4        QUIT

HEADER    ;lists header infomation

 +1        IF $EXTRACT(IOST,1,2)="C-"

               IF PG

                   WRITE !

                   KILL DA,DIR

                   SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

                   IF 'Y

                       SET PSDOUT=1

                       QUIT

 +2        if $Y

               WRITE @IOF

           SET PG=PG+1

           WRITE !,RPDT,?122,"PAGE: "_PG,!,?50,"MANUFACTURER and NARCOTIC INFORMATION",!,?60,"FOR CS STOCK DRUGS",!!

 +3        WRITE "=> ",$SELECT(CNT=1:"NAOU",ANS="N":"NAOU",1:"DRUG"),?95,"EXPIRATION",?110,"BREAKDOWN",?122,"PACKAGE",!,?14,$SELECT(CNT=1:"DRUG",ANS="N":"DRUG",1:"NAOU")

 +4        WRITE ?46,"MANUFACTURER",?80,"LOT #",?95,"DATE",?110,"UNIT",?122,"SIZE",!,LN,!

 +5        QUIT

PSDPMFG1.m