source: WorldVistAEHR/trunk/r/CONTROLLED_SUBSTANCES-PSD/PSDNU1.m@ 701

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1PSDNU1 ;BIR/JPW-Print NAOU Usage Report by Drug ; 2 Aug 94
2 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
3START ;entry point for report
4 K ^TMP("PSDNU",$J),^TMP("PSDNUS",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQT",$J),^TMP("PSDNUQ",$J)
5 I $D(ALL) D ALL G PRINT
6 F JJ2=2,3,4,5 F PSDR=0:0 S PSDR=$O(LOC(PSDR)) Q:'PSDR F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"ACT",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"ACT",JJ,JJ1)) Q:'JJ1 D
7 .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK)) Q:'KK D SET
8PRINT ;prints data for stock drugs
9 I SUM D ^PSDNU3 G DONE
10 K LN S $P(LN,"-",80)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
11 I '$D(^TMP("PSDNU",$J)) D HDR W !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G DONE
12 S PSDR="" F S PSDR=$O(^TMP("PSDNU",$J,PSDR)) D:PSDR="" GTOT Q:PSDR=""!(PSDOUT) D HDR S NAOU="" F S NAOU=$O(^TMP("PSDNU",$J,PSDR,NAOU)) D:NAOU="" NTOT Q:NAOU=""!(PSDOUT) W !,?2,"=> ",NAOU,!! D
13 .S NUM="" F S NUM=$O(^TMP("PSDNU",$J,PSDR,NAOU,NUM)) D:NUM="" TOT Q:NUM=""!(PSDOUT) F JJ=0:0 S JJ=$O(^TMP("PSDNU",$J,PSDR,NAOU,NUM,JJ)) Q:'JJ!(PSDOUT) D
14 ..S NODE=^TMP("PSDNU",$J,PSDR,NAOU,NUM,JJ),DATE=$E(JJ,4,5)_"/"_$E(JJ,6,7)_"/"_$E(JJ,2,3)
15 ..I $Y+8>IOSL D HDR Q:PSDOUT W !,?2,"=> ",NAOU,!!
16 ..W NUM,?16,DATE,?25,$J($P(NODE,"^"),6),?37,$P(NODE,"^",2),?70,$P(NODE,"^",3),!
17DONE 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
19END ;
20 K %,%DT,%H,%I,%ZIS,ALL,ANS,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IO("Q"),JJ,JJ1,JJ2,KK,LOC,LN
21 K NAOU,NAOUN,NODE,NUM,NURS,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDSD,PSDT,PSDTR,RPDT,SUM,X,Y
22 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
23 K ^TMP("PSDNU",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQ",$J),^TMP("PSDNUS",$J),^TMP("PSDNUQT",$J)
24 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
25 Q
26ALL ;loops for all drugs
27 Q:'$D(ALL)
28 F JJ2=2,3,4,5 F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"ACT",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"ACT",JJ,JJ1)) Q:'JJ1 F PSDR=0:0 S PSDR=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR)) Q:'PSDR D
29 .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK)) Q:'KK D SET
30 Q
31HDR ;lists header information
32 I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
33 W:$Y @IOF S PG=PG+1 W !,"DRUG/NAOU USAGE REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
34 I $D(PSDR),PSDR]"" W "DRUG: ",PSDR,!
35 W "From ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
36 W !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?37,"ORDERED BY",?72,"TYPE",!,LN,!
37 Q
38TOT Q:PSDOUT W !,"---------",?25,"----------",!,?3,^TMP("PSDNUS",$J,PSDR,NAOU),?25,$J(^TMP("PSDNUQ",$J,PSDR,NAOU),6),?37,"Totals",!
39 Q
40NTOT Q:PSDOUT W !,"DRUG Subtotal # of Orders: ",^TMP("PSDNUT",$J,PSDR)," Total Quantity: ",^TMP("PSDNUQT",$J,PSDR),!
41 Q
42GTOT ;grand total
43 Q:PSDOUT
44 W !,"Grand Total # of Orders: ",^TMP("PSDNUG",$J),!
45 Q
46SET ;sets data
47 Q:'$D(^PSD(58.81,KK,0)) S NODE=^PSD(58.81,KK,0),PSD=+$P(NODE,"^",18)
48 Q:$P($G(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE S PSDOK=0
49 S PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING")
50 S NAOUN=$S($P($G(^PSD(58.8,PSD,0)),"^")]"":$P(^(0),"^"),1:"NAOU NAME MISSING")
51 S PSDPN=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"DISP W/O GS"),QTY=+$P(NODE,"^",6)
52 S:+$P($G(^PSD(58.81,KK,4)),"^",3) QTY=+$P($G(^(4)),"^",3)
53 I JJ2=2,$D(^PSD(58.81,KK,7)),+$P($G(^(7)),"^",3)'=PSD S QTY=QTY-(+$P(^(7),"^",7))
54 S QTY=$S(JJ2=3:-(+$P($G(^PSD(58.81,KK,3)),"^",2)),JJ2=4:-(+$P($G(^PSD(58.81,KK,3)),"^",5)),JJ2=14:+$P($G(^PSD(58.81,KK,4)),"^",3),1:QTY)
55 I JJ2=5 S PSDTR=+$P($G(^PSD(58.81,KK,7)),"^",6) D:PSDTR
56 .I +$P($G(^PSD(58.81,PSDTR,0)),"^",18)=PSD S PSDOK=1
57 S NURS=$S(+$P($G(^PSD(58.81,KK,1)),"^",7):+$P($G(^(1)),"^",7),1:+$P($G(^PSD(58.81,KK,1)),"^",3))
58 S NURS=$S($P($G(^VA(200,NURS,0)),"^")]"":$P(^(0),"^"),PSDPN="DISP W/O GS":"N/A",1:"UNKNOWN")
59 S ^TMP("PSDNU",$J,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_NURS_"^"_$S(JJ2=2:"DISPENSE",JJ2=3:"RET/STK",JJ2=4:"DESTROY",JJ2=5:"TRANSFER",1:"N/A")
60 S:'$D(^TMP("PSDNUT",$J,PSDRN)) ^TMP("PSDNUT",$J,PSDRN)=0 S:'PSDOK ^TMP("PSDNUT",$J,PSDRN)=+^TMP("PSDNUT",$J,PSDRN)+1
61 S:'$D(^TMP("PSDNUQT",$J,PSDRN)) ^TMP("PSDNUQT",$J,PSDRN)=0 S ^TMP("PSDNUQT",$J,PSDRN)=+^TMP("PSDNUQT",$J,PSDRN)+QTY
62 S:'$D(^TMP("PSDNUS",$J,PSDRN,NAOUN)) ^TMP("PSDNUS",$J,PSDRN,NAOUN)=0 S:'PSDOK ^TMP("PSDNUS",$J,PSDRN,NAOUN)=+^TMP("PSDNUS",$J,PSDRN,NAOUN)+1
63 S:'$D(^TMP("PSDNUQ",$J,PSDRN,NAOUN)) ^TMP("PSDNUQ",$J,PSDRN,NAOUN)=0 S ^TMP("PSDNUQ",$J,PSDRN,NAOUN)=+^TMP("PSDNUQ",$J,PSDRN,NAOUN)+QTY
64 S:'$D(^TMP("PSDNUG",$J)) ^TMP("PSDNUG",$J)=0 S:'PSDOK ^TMP("PSDNUG",$J)=+^TMP("PSDNUG",$J)+1
65 S PSDOK=0
66 Q
Note: See TracBrowser for help on using the repository browser.