| 1 | PSDPSTK1 ;BIR/JPW-Print Data for CS Drugs (cont'd) ; 2 Aug 94
|
|---|
| 2 | ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
|
|---|
| 3 | PRINT ;print data for stock drugs
|
|---|
| 4 | K LN S (PG,PSDOUT)=0,$P(LN,"-",132)="",%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y D HEADER Q:PSDOUT
|
|---|
| 5 | I '$D(^TMP("PSDPSTK",$J)) W !!,?45,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G END
|
|---|
| 6 | S DRUG="" F S DRUG=$O(^TMP("PSDPSTK",$J,DRUG)) Q:DRUG=""!(PSDOUT) D:$Y+5>IOSL HEADER Q:PSDOUT W !,"=> ",$S(DRUG["ZZ/":"#"_$P(DRUG,"/",2)_" NAME MISSING",1:DRUG) D Q:PSDOUT
|
|---|
| 7 | .F NAOU=0:0 S NAOU=$O(^TMP("PSDPSTK",$J,DRUG,NAOU)) Q:'NAOU!(PSDOUT) D Q:PSDOUT
|
|---|
| 8 | ..S NODE=^TMP("PSDPSTK",$J,DRUG,NAOU,0) S NAOUN=$S($P(^PSD(58.8,NAOU,0),"^")]"":$P(^(0),"^"),1:"NAOU #"_NAOU_"/NAME MISSING")
|
|---|
| 9 | ..I $P(NODE,"^")="I" S Y=$P(NODE,"^",2) X ^DD("DD") S DATEI=Y D:$Y+5>IOSL HEADER Q:PSDOUT W !,?4,NAOUN_" (NAOU INACTIVE AS OF "_DATEI_")",! Q
|
|---|
| 10 | ..S LOC=$P(NODE,"^"),STK=$P(NODE,"^",2),TYPE=$P(NODE,"^",3)
|
|---|
| 11 | ..S WARD=$G(^TMP("PSDPSTK",$J,DRUG,NAOU,1))
|
|---|
| 12 | ..S CNTW=$L(WARD,";;"),CNTT=$L(TYPE,";;"),CNT=$S(CNTT>CNTW!(CNTT=CNTW):CNTT,CNTW>CNTT:CNTW,1:2)
|
|---|
| 13 | ..I $Y+5>IOSL D HEADER Q:PSDOUT W !,"=> ",$S(DRUG["ZZ/":"#"_$P(DRUG,"/",2)_" NAME MISSING",1:DRUG)
|
|---|
| 14 | ..W !,?4,NAOUN,?45,LOC,?55,$J(STK,6),?67 S WARDN=$P(WARD,";;",2) D:WARDN WARD W WARDN,?101 S TYPEN=$P(TYPE,";;",2) D:TYPEN TYPE W TYPEN,!
|
|---|
| 15 | ..I CNT>2 F JJ=3:1:CNT D:$Y+5>IOSL HEADER W ?67 S WARDN=$P(WARD,";;",JJ) D:WARDN WARD W WARDN,?101 S TYPEN=$P(TYPE,";;",JJ) D:TYPEN TYPE W TYPEN,!
|
|---|
| 16 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 17 | 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
|
|---|
| 18 | END ;
|
|---|
| 19 | K %DT,%ZIS,CNT,CNTT,CNTW,DA,DATEI,DIK,DIR,DIRUT,DRUG,DRUGN,JJ,LN,LOC,NAOU,NAOUN,NODE,PG,POP,PSDIO,PSDT,PSDOUT,RPDT,STK,TYP,TYPE,TYPEN,WARD,WARDN,WRD
|
|---|
| 20 | K X,Y,ZTDESC,ZTDTH,ZTIO,ZTSAVE,ZTRTN,^TMP("PSDPSTK",$J) D ^%ZISC
|
|---|
| 21 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 22 | Q
|
|---|
| 23 | HEADER ;lists header infomation
|
|---|
| 24 | 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
|
|---|
| 25 | W:$Y @IOF S PG=PG+1 W !,RPDT,?122,"PAGE: "_PG,!,?55,"DATA FOR CS STOCK DRUGS",!!,"=> DRUG",!,?57,"STOCK",!,?14,"NAOU",?45,"LOCATION",?57,"LEVEL",?67,"WARD (FOR DRUG)",?101,"TYPE",!,LN,!
|
|---|
| 26 | Q
|
|---|
| 27 | WARD ;checks for vaild ward name
|
|---|
| 28 | I $D(^DIC(42,WARDN,0)),$P(^(0),"^")]"" S WARDN=$P(^(0),"^") Q
|
|---|
| 29 | S WARDN="WARD #"_WARD_"/NO NAME OR DELETED"
|
|---|
| 30 | Q
|
|---|
| 31 | TYPE ;ckecks for valid type name
|
|---|
| 32 | I $D(^PSI(58.16,TYPEN,0)),$P(^(0),"^")]"" S TYPEN=$P(^(0),"^") Q
|
|---|
| 33 | S TYPEN="TYPE #"_TYPEN_"/NO NAME OR DELETED"
|
|---|
| 34 | Q
|
|---|
