Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSDNU2

PSDNU2.m

Go to the documentation of this file.
PSDNU2 ;BIR/JPW-Print NAOU Usage Report by NAOU ; 2 Aug 94
 ;;3.0;CONTROLLED SUBSTANCES ;**75**;13 Feb 97;Build 2
START ;entry point for report
 K ^TMP("PSDNU",$J),^TMP("PSDNUS",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQ",$J)
 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
 .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK)) Q:'KK  D SET
 D NODATA  ;; RJS*75
PRINT ;prints data for stock drugs
 I SUM D ^PSDNU3 G DONE
 K LN S $P(LN,"-",80)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
 S PSDNAOU="" F  S PSDNAOU=$O(^TMP("PSDNU",$J,PSDNAOU)) D:PSDNAOU="" GTOT Q:PSDNAOU=""!(PSDOUT)  D HDR D
 .I $D(^TMP("PSDNU",$J,PSDNAOU,0)) W !,"*****  NO DATA AVAILABLE FOR THIS REPORT  *****",! D NTOT Q  ;; RJS*75
 .S PSDR="" F  S PSDR=$O(^TMP("PSDNU",$J,PSDNAOU,PSDR)) D:PSDR="" NTOT Q:PSDR=""!(PSDOUT)  W !,?2,"=> ",PSDR,!! D
 ..S NUM="" F  S NUM=$O(^TMP("PSDNU",$J,PSDNAOU,PSDR,NUM)) D:NUM="" TOT Q:NUM=""!(PSDOUT)  F JJ=0:0 S JJ=$O(^TMP("PSDNU",$J,PSDNAOU,PSDR,NUM,JJ)) Q:'JJ!(PSDOUT)  D
 ...S NODE=^TMP("PSDNU",$J,PSDNAOU,PSDR,NUM,JJ),DATE=$E(JJ,4,5)_"/"_$E(JJ,6,7)_"/"_$E(JJ,2,3)
 ...I $Y+8>IOSL D HDR Q:PSDOUT  W !,?2,"=> ",PSDR,!!
 ...W NUM,?16,DATE,?25,$J($P(NODE,"^"),6),?37,$P(NODE,"^",2),?70,$P(NODE,"^",3),!
DONE I $E(IOST)'="C" W @IOF
 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
END ;
 K %,%DT,%H,%I,%ZIS,ALL,ANS,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IO("Q"),JJ,JJ1,JJ2,KK,LOC,LN
 K PSDNAOU,PSDNAOUN,NODE,NUM,NURS,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDSD,PSDT,PSDTR,RPDT,SUM,X,Y
 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
 K ^TMP("PSDNU",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQ",$J),^TMP("PSDNUS",$J)
 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
 Q
SET ;sets data
 Q:'$D(^PSD(58.81,KK,0))  S NODE=^PSD(58.81,KK,0),PSD=+$P(NODE,"^",18)
 Q:'$D(LOC(PSD))  Q:+$P($G(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE  S PSDOK=0
 S PSDRN=$S($P($G(^PSDRUG(PSDR,0)),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING")
 S PSDNAOUN=$S($P($G(^PSD(58.8,PSD,0)),"^")]"":$P(^(0),"^"),1:"NAOU NAME MISSING")
 S PSDPN=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"DISP W/O GS"),QTY=+$P(NODE,"^",6)
 S:+$P($G(^PSD(58.81,KK,4)),"^",3) QTY=+$P($G(^(4)),"^",3)
 I JJ2=2,$D(^PSD(58.81,KK,7)),+$P(^(7),"^",3)'=PSD S QTY=QTY-(+$P(^(7),"^",7))
 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)
 I JJ2=5 S PSDTR=+$P($G(^PSD(58.81,KK,7)),"^",6) D:PSDTR
 .I +$P($G(^PSD(58.81,PSDTR,0)),"^",18)=PSD S PSDOK=1
 S NURS=$S(+$P($G(^PSD(58.81,KK,1)),"^",7):+$P($G(^(1)),"^",7),1:+$P($G(^PSD(58.81,KK,1)),"^",3))
 S NURS=$S($P($G(^VA(200,NURS,0)),"^")]"":$P(^(0),"^"),PSDPN="DISP W/O GS":"N/A",1:"UNKNOWN")
 S ^TMP("PSDNU",$J,PSDNAOUN,PSDRN,PSDPN,JJ)=QTY_"^"_NURS_"^"_$S(JJ2=2:"DISPENSE",JJ2=3:"RET/STK",JJ2=4:"DESTROY",JJ2=5:"TRANSFER",1:"N/A")
 S:'$D(^TMP("PSDNUT",$J,PSDNAOUN)) ^TMP("PSDNUT",$J,PSDNAOUN)=0 S:'PSDOK ^TMP("PSDNUT",$J,PSDNAOUN)=+^TMP("PSDNUT",$J,PSDNAOUN)+1
 S:'$D(^TMP("PSDNUS",$J,PSDNAOUN,PSDRN)) ^TMP("PSDNUS",$J,PSDNAOUN,PSDRN)=0 S:'PSDOK ^TMP("PSDNUS",$J,PSDNAOUN,PSDRN)=+^TMP("PSDNUS",$J,PSDNAOUN,PSDRN)+1
 S:'$D(^TMP("PSDNUQ",$J,PSDNAOUN,PSDRN)) ^TMP("PSDNUQ",$J,PSDNAOUN,PSDRN)=0 S ^TMP("PSDNUQ",$J,PSDNAOUN,PSDRN)=+^TMP("PSDNUQ",$J,PSDNAOUN,PSDRN)+QTY
 S:'$D(^TMP("PSDNUG",$J)) ^TMP("PSDNUG",$J)=0 S:'PSDOK ^TMP("PSDNUG",$J)=+^TMP("PSDNUG",$J)+1
 S PSDOK=0
 Q
HDR ;lists header information
 I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
 W:$Y @IOF S PG=PG+1 W !,"NAOU/DRUG USAGE REPORT  -  DATE: "_RPDT,?70,"PAGE: ",PG,!
 W:$D(PSDNAOU) "NAOU: ",PSDNAOU,!
 W "From ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
 W !,?2,"=> DRUG",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?37,"ORDERED BY",?70,"TYPE",!,LN,!
 Q
TOT Q:PSDOUT  W !,"---------",?25,"----------",!,?3,^TMP("PSDNUS",$J,PSDNAOU,PSDR),?25,$J(^TMP("PSDNUQ",$J,PSDNAOU,PSDR),6),?37,"Totals",!
 Q
NTOT Q:PSDOUT  W !,"NAOU Subtotal # of Orders: ",^TMP("PSDNUT",$J,PSDNAOU),!
 Q
GTOT ;grand total
 Q:PSDOUT
 W !,"Grand Total # of Orders: ",+$G(^TMP("PSDNUG",$J)),!
 Q
NODATA ; PRINT NO DATA MESSAGE FOR NAOUS THAT HAVE NO USAGE  ;; RJS*75
 I $D(LOC) D
 .S PSDLOC=0 F  S PSDLOC=$O(LOC(PSDLOC)) Q:'PSDLOC  D
 ..S PSDNAOUN=$P($G(^PSD(58.8,PSDLOC,0)),"^",1)
 ..I '$D(^TMP("PSDNU",$J,PSDNAOUN)) S ^TMP("PSDNU",$J,PSDNAOUN,0)="",^TMP("PSDNUT",$J,PSDNAOUN)=0,^TMP("PSDNUS",$J,PSDNAOUN,0)=0
 Q