PSDNU1 ;BIR/JPW-Print NAOU Usage Report by Drug ; 2 Aug 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;entry point for report
K ^TMP("PSDNU",$J),^TMP("PSDNUS",$J),^TMP("PSDNUT",$J),^TMP("PSDNUG",$J),^TMP("PSDNUQT",$J),^TMP("PSDNUQ",$J)
I $D(ALL) D ALL G PRINT
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
.F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK)) Q:'KK D SET
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
I '$D(^TMP("PSDNU",$J)) D HDR W !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G DONE
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
.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
..S NODE=^TMP("PSDNU",$J,PSDR,NAOU,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,"=> ",NAOU,!!
..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 NAOU,NAOUN,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),^TMP("PSDNUQT",$J)
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
ALL ;loops for all drugs
Q:'$D(ALL)
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
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 !,"DRUG/NAOU USAGE REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
I $D(PSDR),PSDR]"" W "DRUG: ",PSDR,!
W "From ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
W !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?37,"ORDERED BY",?72,"TYPE",!,LN,!
Q
TOT Q:PSDOUT W !,"---------",?25,"----------",!,?3,^TMP("PSDNUS",$J,PSDR,NAOU),?25,$J(^TMP("PSDNUQ",$J,PSDR,NAOU),6),?37,"Totals",!
Q
NTOT Q:PSDOUT W !,"DRUG Subtotal # of Orders: ",^TMP("PSDNUT",$J,PSDR)," Total Quantity: ",^TMP("PSDNUQT",$J,PSDR),!
Q
GTOT ;grand total
Q:PSDOUT
W !,"Grand Total # of Orders: ",^TMP("PSDNUG",$J),!
Q
SET ;sets data
Q:'$D(^PSD(58.81,KK,0)) S NODE=^PSD(58.81,KK,0),PSD=+$P(NODE,"^",18)
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 NAOUN=$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($G(^(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,PSDRN,NAOUN,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,PSDRN)) ^TMP("PSDNUT",$J,PSDRN)=0 S:'PSDOK ^TMP("PSDNUT",$J,PSDRN)=+^TMP("PSDNUT",$J,PSDRN)+1
S:'$D(^TMP("PSDNUQT",$J,PSDRN)) ^TMP("PSDNUQT",$J,PSDRN)=0 S ^TMP("PSDNUQT",$J,PSDRN)=+^TMP("PSDNUQT",$J,PSDRN)+QTY
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
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
S:'$D(^TMP("PSDNUG",$J)) ^TMP("PSDNUG",$J)=0 S:'PSDOK ^TMP("PSDNUG",$J)=+^TMP("PSDNUG",$J)+1
S PSDOK=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDNU1 4713 printed Apr 09, 2024@20:52:51 Page 2
PSDNU1 ;BIR/JPW-Print NAOU Usage Report by Drug ; 2 Aug 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;entry point for report
+1 KILL ^TMP("PSDNU",$JOB),^TMP("PSDNUS",$JOB),^TMP("PSDNUT",$JOB),^TMP("PSDNUG",$JOB),^TMP("PSDNUQT",$JOB),^TMP("PSDNUQ",$JOB)
+2 IF $DATA(ALL)
DO ALL
GOTO PRINT
+3 FOR JJ2=2,3,4,5
FOR PSDR=0:0
SET PSDR=$ORDER(LOC(PSDR))
if 'PSDR
QUIT
FOR JJ=PSDSD:0
SET JJ=$ORDER(^PSD(58.81,"ACT",JJ))
if 'JJ!(JJ>PSDED)
QUIT
FOR JJ1=0:0
SET JJ1=$ORDER(^PSD(58.81,"ACT",JJ,JJ1))
if 'JJ1
QUIT
Begin DoDot:1
+4 FOR KK=0:0
SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK))
if 'KK
QUIT
DO SET
End DoDot:1
PRINT ;prints data for stock drugs
+1 IF SUM
DO ^PSDNU3
GOTO DONE
+2 KILL LN
SET $PIECE(LN,"-",80)=""
SET (PG,PSDOUT)=0
SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET RPDT=Y
+3 IF '$DATA(^TMP("PSDNU",$JOB))
DO HDR
WRITE !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****"
GOTO DONE
+4 SET PSDR=""
FOR
SET PSDR=$ORDER(^TMP("PSDNU",$JOB,PSDR))
if PSDR=""
DO GTOT
if PSDR=""!(PSDOUT)
QUIT
DO HDR
SET NAOU=""
FOR
SET NAOU=$ORDER(^TMP("PSDNU",$JOB,PSDR,NAOU))
if NAOU=""
DO NTOT
if NAOU=""!(PSDOUT)
QUIT
WRITE !,?2,"=> ",NAOU,!!
Begin DoDot:1
+5 SET NUM=""
FOR
SET NUM=$ORDER(^TMP("PSDNU",$JOB,PSDR,NAOU,NUM))
if NUM=""
DO TOT
if NUM=""!(PSDOUT)
QUIT
FOR JJ=0:0
SET JJ=$ORDER(^TMP("PSDNU",$JOB,PSDR,NAOU,NUM,JJ))
if 'JJ!(PSDOUT)
QUIT
Begin DoDot:2
+6 SET NODE=^TMP("PSDNU",$JOB,PSDR,NAOU,NUM,JJ)
SET DATE=$EXTRACT(JJ,4,5)_"/"_$EXTRACT(JJ,6,7)_"/"_$EXTRACT(JJ,2,3)
+7 IF $Y+8>IOSL
DO HDR
if PSDOUT
QUIT
WRITE !,?2,"=> ",NAOU,!!
+8 WRITE NUM,?16,DATE,?25,$JUSTIFY($PIECE(NODE,"^"),6),?37,$PIECE(NODE,"^",2),?70,$PIECE(NODE,"^",3),!
End DoDot:2
End DoDot:1
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST,1,2)="C-"
IF 'PSDOUT
WRITE !
KILL DIR,DIRUT
SET DIR(0)="EA"
SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
DO ^DIR
KILL DIR
END ;
+1 KILL %,%DT,%H,%I,%ZIS,ALL,ANS,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,IO("Q"),JJ,JJ1,JJ2,KK,LOC,LN
+2 KILL NAOU,NAOUN,NODE,NUM,NURS,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOK,PSDOUT,PSDPN,PSDR,PSDRN,PSDSD,PSDT,PSDTR,RPDT,SUM,X,Y
+3 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+4 KILL ^TMP("PSDNU",$JOB),^TMP("PSDNUT",$JOB),^TMP("PSDNUG",$JOB),^TMP("PSDNUQ",$JOB),^TMP("PSDNUS",$JOB),^TMP("PSDNUQT",$JOB)
+5 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+6 QUIT
ALL ;loops for all drugs
+1 if '$DATA(ALL)
QUIT
+2 FOR JJ2=2,3,4,5
FOR JJ=PSDSD:0
SET JJ=$ORDER(^PSD(58.81,"ACT",JJ))
if 'JJ!(JJ>PSDED)
QUIT
FOR JJ1=0:0
SET JJ1=$ORDER(^PSD(58.81,"ACT",JJ,JJ1))
if 'JJ1
QUIT
FOR PSDR=0:0
SET PSDR=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR))
if 'PSDR
QUIT
Begin DoDot:1
+3 FOR KK=0:0
SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,JJ2,KK))
if 'KK
QUIT
DO SET
End DoDot:1
+4 QUIT
HDR ;lists header information
+1 IF $EXTRACT(IOST,1,2)="C-"
IF PG
KILL DA,DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET PSDOUT=1
QUIT
+2 if $Y
WRITE @IOF
SET PG=PG+1
WRITE !,"DRUG/NAOU USAGE REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
+3 IF $DATA(PSDR)
IF PSDR]""
WRITE "DRUG: ",PSDR,!
+4 WRITE "From ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!
+5 WRITE !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?37,"ORDERED BY",?72,"TYPE",!,LN,!
+6 QUIT
TOT if PSDOUT
QUIT
WRITE !,"---------",?25,"----------",!,?3,^TMP("PSDNUS",$JOB,PSDR,NAOU),?25,$JUSTIFY(^TMP("PSDNUQ",$JOB,PSDR,NAOU),6),?37,"Totals",!
+1 QUIT
NTOT if PSDOUT
QUIT
WRITE !,"DRUG Subtotal # of Orders: ",^TMP("PSDNUT",$JOB,PSDR)," Total Quantity: ",^TMP("PSDNUQT",$JOB,PSDR),!
+1 QUIT
GTOT ;grand total
+1 if PSDOUT
QUIT
+2 WRITE !,"Grand Total # of Orders: ",^TMP("PSDNUG",$JOB),!
+3 QUIT
SET ;sets data
+1 if '$DATA(^PSD(58.81,KK,0))
QUIT
SET NODE=^PSD(58.81,KK,0)
SET PSD=+$PIECE(NODE,"^",18)
+2 if $PIECE($GET(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE
QUIT
SET PSDOK=0
+3 SET PSDRN=$SELECT($PIECE($GET(^PSDRUG(PSDR,0)),"^")]"":$PIECE(^(0),"^"),1:"DRUG NAME MISSING")
+4 SET NAOUN=$SELECT($PIECE($GET(^PSD(58.8,PSD,0)),"^")]"":$PIECE(^(0),"^"),1:"NAOU NAME MISSING")
+5 SET PSDPN=$SELECT($PIECE(NODE,"^",17)]"":$PIECE(NODE,"^",17),1:"DISP W/O GS")
SET QTY=+$PIECE(NODE,"^",6)
+6 if +$PIECE($GET(^PSD(58.81,KK,4)),"^",3)
SET QTY=+$PIECE($GET(^(4)),"^",3)
+7 IF JJ2=2
IF $DATA(^PSD(58.81,KK,7))
IF +$PIECE($GET(^(7)),"^",3)'=PSD
SET QTY=QTY-(+$PIECE(^(7),"^",7))
+8 SET QTY=$SELECT(JJ2=3:-(+$PIECE($GET(^PSD(58.81,KK,3)),"^",2)),JJ2=4:-(+$PIECE($GET(^PSD(58.81,KK,3)),"^",5)),JJ2=14:+$PIECE($GET(^PSD(58.81,KK,4)),"^",3),1:QTY)
+9 IF JJ2=5
SET PSDTR=+$PIECE($GET(^PSD(58.81,KK,7)),"^",6)
if PSDTR
Begin DoDot:1
+10 IF +$PIECE($GET(^PSD(58.81,PSDTR,0)),"^",18)=PSD
SET PSDOK=1
End DoDot:1
+11 SET NURS=$SELECT(+$PIECE($GET(^PSD(58.81,KK,1)),"^",7):+$PIECE($GET(^(1)),"^",7),1:+$PIECE($GET(^PSD(58.81,KK,1)),"^",3))
+12 SET NURS=$SELECT($PIECE($GET(^VA(200,NURS,0)),"^")]"":$PIECE(^(0),"^"),PSDPN="DISP W/O GS":"N/A",1:"UNKNOWN")
+13 SET ^TMP("PSDNU",$JOB,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_NURS_"^"_$SELECT(JJ2=2:"DISPENSE",JJ2=3:"RET/STK",JJ2=4:"DESTROY",JJ2=5:"TRANSFER",1:"N/A")
+14 if '$DATA(^TMP("PSDNUT",$JOB,PSDRN))
SET ^TMP("PSDNUT",$JOB,PSDRN)=0
if 'PSDOK
SET ^TMP("PSDNUT",$JOB,PSDRN)=+^TMP("PSDNUT",$JOB,PSDRN)+1
+15 if '$DATA(^TMP("PSDNUQT",$JOB,PSDRN))
SET ^TMP("PSDNUQT",$JOB,PSDRN)=0
SET ^TMP("PSDNUQT",$JOB,PSDRN)=+^TMP("PSDNUQT",$JOB,PSDRN)+QTY
+16 if '$DATA(^TMP("PSDNUS",$JOB,PSDRN,NAOUN))
SET ^TMP("PSDNUS",$JOB,PSDRN,NAOUN)=0
if 'PSDOK
SET ^TMP("PSDNUS",$JOB,PSDRN,NAOUN)=+^TMP("PSDNUS",$JOB,PSDRN,NAOUN)+1
+17 if '$DATA(^TMP("PSDNUQ",$JOB,PSDRN,NAOUN))
SET ^TMP("PSDNUQ",$JOB,PSDRN,NAOUN)=0
SET ^TMP("PSDNUQ",$JOB,PSDRN,NAOUN)=+^TMP("PSDNUQ",$JOB,PSDRN,NAOUN)+QTY
+18 if '$DATA(^TMP("PSDNUG",$JOB))
SET ^TMP("PSDNUG",$JOB)=0
if 'PSDOK
SET ^TMP("PSDNUG",$JOB)=+^TMP("PSDNUG",$JOB)+1
+19 SET PSDOK=0
+20 QUIT
