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