source: FOIAVistA/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDLSTK2.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.3 KB
Line 
1PSDLSTK2 ;BIR/JPW-Print Stock Drugs Alphabetically ; 2 Aug 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3START ;entry point for report
4 K ^TMP("PSDLSTK",$J)
5 F PSD=0:0 S PSD=$O(NAOU(PSD)) G:'PSD PRINT S:$D(^PSD(58.8,PSD,0)) NAOUN=$S($P(^(0),"^")]"":$P(^(0),"^"),1:"ZZ/"_PSD) F DRUG=0:0 S DRUG=$O(^PSD(58.8,PSD,1,DRUG)) Q:'DRUG I $D(^PSD(58.8,PSD,1,DRUG,0)) 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 .S NODE=^PSD(58.8,PSD,1,DRUG,0),LOC=$S($P(NODE,"^",2)]"":$P(NODE,"^",2),1:"NOT LISTED"),STK=$S($P(NODE,"^",3)]"":$P(NODE,"^",3),1:"NOT LISTED"),RSTK=$S($P(NODE,"^",5)]"":$P(NODE,"^",5),1:"NOT LISTED")
9 .S ^TMP("PSDLSTK",$J,NAOUN,DRUGN)=LOC_"^"_STK_"^"_RSTK
10PRINT ;prints 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 HEADER Q:PSDOUT
12 I '$D(^TMP("PSDLSTK",$J)) W !!,?45,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G DONE
13 S NAOU="" F S NAOU=$O(^TMP("PSDLSTK",$J,NAOU)) Q:NAOU=""!(PSDOUT) D:$Y+5>IOSL HEADER Q:PSDOUT W !!,"=> ",$S(NAOU["ZZ/":"#"_$P(NAOU,"/",2)_" NAME MISSING",1:NAOU) D
14 .S DRUG="" F S DRUG=$O(^TMP("PSDLSTK",$J,NAOU,DRUG)) Q:DRUG=""!(PSDOUT) D Q:PSDOUT
15 ..S NODE=^TMP("PSDLSTK",$J,NAOU,DRUG),LOC=$P(NODE,"^"),STK=$P(NODE,"^",2),RSTK=$P(NODE,"^",3)
16 ..I $Y+5>IOSL D HEADER Q:PSDOUT W !!,"=> ",$S(NAOU["ZZ/":"#"_$P(NAOU,"/",2)_" NAME MISSING",1:NAOU)
17 ..W !,?4,DRUG,?58,LOC,?75,$J(STK,6),?93,$J(RSTK,6)
18DONE I $E(IOST)'="C" W @IOF
19 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
20END ;
21 K %,%DT,%H,%I,%ZIS,ANS,DA,DIR,DIROUT,DIRUT,DRUG,DRUGN,DTOUT,DUOUT,IO("Q"),LOC,LN,NAOU,NAOUN,NODE,PG,POP,PSD,PSDT,PSDOUT,RPDT,RSTK,STK,TYP,TYPE,X,Y,^TMP("PSDLSTK",$J)
22 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
23 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
24 Q
25HEADER ;lists header information
26 I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
27 W:$Y @IOF S PG=PG+1 W !,"ALPHABETICAL LISTING OF NAOU STOCK - DATE: "_RPDT,?121,"PAGE: "_PG,!!,?2,"NARCOTIC AREA OF USE"
28 W !,?12,"DRUG",?57,"LOCATION",?74,"STOCK LEVEL",?92,"REORDER LEVEL",!,LN,!
29 Q
Note: See TracBrowser for help on using the repository browser.