| 1 | PSDLSTK1 ;BIR/JPW-Print Stock Drugs by Type/Location ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | START ;entry point for report
|
|---|
| 4 | K ^TMP("PSDLSTK",$J)
|
|---|
| 5 | F PSD=0:0 S PSD=$O(NAOU(PSD)) G:'PSD PRINT I $D(^PSD(58.8,PSD,0)) F DRUG=0:0 S DRUG=$O(^PSD(58.8,PSD,1,DRUG)) Q:'DRUG D
|
|---|
| 6 | .Q:'$D(^PSD(58.8,PSD,1,DRUG,0)) I +$P(^PSD(58.8,PSD,1,DRUG,0),"^",14) D NOW^%DTC I $P(^PSD(58.8,PSD,1,DRUG,0),"^",14)'>X Q
|
|---|
| 7 | .Q:'$D(^PSDRUG(DRUG,0)) I $D(^PSDRUG(DRUG,0)) S DRUGN=$S($P(^PSDRUG(DRUG,0),"^")]"":$P(^(0),"^"),1:"ZZ/"_DRUG)
|
|---|
| 8 | .I '$D(^PSD(58.8,PSD,1,DRUG,2,0)) S TYPE="9999" D SET Q
|
|---|
| 9 | .F TYP=0:0 S TYP=$O(^PSD(58.8,PSD,1,DRUG,2,TYP)) Q:'TYP S TYPE=TYP D SET
|
|---|
| 10 | PRINT ;print data for stock drugs
|
|---|
| 11 | K LN S $P(LN,"-",132)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y D HDR Q:PSDOUT
|
|---|
| 12 | I '$D(^TMP("PSDLSTK",$J)) W !!,?45,"***** NO DATA FOR THIS REPORT *****" G DONE
|
|---|
| 13 | F NAOU=0:0 S NAOU=$O(^TMP("PSDLSTK",$J,NAOU)) Q:'NAOU!(PSDOUT) D:$Y+5>IOSL HDR W !,"=>",$S($P(^PSD(58.8,NAOU,0),"^")]"":$P(^(0),"^"),1:"#"_NAOU_" NAME MISSING") D
|
|---|
| 14 | .F TYP=0:0 S TYP=$O(^TMP("PSDLSTK",$J,NAOU,TYP)) Q:'TYP!(PSDOUT) S TYPE=$S(TYP=9999:"UNCLASSIFIED BY TYPE",$D(^PSI(58.16,TYP,0)):$P(^(0),"^"),1:"TYPE NAME MISSING") D:$Y+5>IOSL HDR Q:PSDOUT W !,?5,"TYPE: "_TYPE,! D
|
|---|
| 15 | ..S LOC="" F S LOC=$O(^TMP("PSDLSTK",$J,NAOU,TYP,LOC)) Q:LOC=""!(PSDOUT) S LOCN=$S(LOC["Z":"NOT LISTED",1:LOC) S DRUG="" F S DRUG=$O(^TMP("PSDLSTK",$J,NAOU,TYP,LOC,DRUG)) Q:DRUG=""!(PSDOUT) D:$Y+5>IOSL HDR Q:PSDOUT D
|
|---|
| 16 | ...W ?8,LOCN,?30,$S(DRUG["ZZ/":"#"_$P(DRUG,"/",2)_" NAME MISSING",1:DRUG),?81,$J($P(^TMP("PSDLSTK",$J,NAOU,TYP,LOC,DRUG),"^"),6),?116,$J($P(^(DRUG),"^",2),6),!
|
|---|
| 17 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 18 | 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
|
|---|
| 19 | END ;
|
|---|
| 20 | K %,%DT,%H,%I,%ZIS,ANS,DA,DIR,DIROUT,DIRUT,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),LN,LOC,LOCN,NAOU,NODE,PG,POP,PSD,PSDOUT,PSDT,RPDT,RSTK,STK,TYP,TYPE,X,Y,^TMP("PSDLSTK",$J)
|
|---|
| 21 | K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
|
|---|
| 22 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 23 | Q
|
|---|
| 24 | HDR ;lists header information
|
|---|
| 25 | I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
|
|---|
| 26 | W:$Y @IOF S PG=PG+1 W !,"NAOU STOCK LIST BY TYPE/LOCATION - DATE: "_RPDT,?121,"PAGE: "_PG,!!,?2,"NARCOTIC AREA OF USE"
|
|---|
| 27 | W !,?5,"TYPE",!,?8,"LOCATION",?44,"DRUG",?80,"STOCK LEVEL",?115,"REORDER LEVEL",!,LN,!
|
|---|
| 28 | Q
|
|---|
| 29 | SET ;sets data in ^TMP global
|
|---|
| 30 | S NODE=^PSD(58.8,PSD,1,DRUG,0)
|
|---|
| 31 | S LOC=$S($P(NODE,"^",2)]"":$P(NODE,"^",2),1:"Z"),STK=$S($P(NODE,"^",3)]"":$P(NODE,"^",3),1:"NOT LISTED")
|
|---|
| 32 | S RSTK=$S($P(NODE,"^",5)]"":$P(NODE,"^",5),1:"NOT LISTED")
|
|---|
| 33 | S ^TMP("PSDLSTK",$J,PSD,TYPE,LOC,DRUGN)=STK_"^"_RSTK
|
|---|
| 34 | Q
|
|---|
