- 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="@"
- Q
- 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,!
- Q
- 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
- +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
