PSDAMIS0 ;BIR/JPW-Print NAOU AMIS Report by Drug ; 1 Sept 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
EN ;entry to print report
I SUM D ^PSDAMIS4 G DONE
PRINT ;prints data for stock drugs
K LN S $P(LN,"-",80)="",(PG,PSDOUT)=0,%DT="",X="T" D ^%DT X ^DD("DD") S RPDT=Y
I '$D(^TMP("PSDAMIS",$J)) D HDR W !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****" G DONE
S PSDR="" F S PSDR=$O(^TMP("PSDAMIS",$J,PSDR)) D:PSDR="" GTOT Q:PSDR=""!(PSDOUT) D HDR S NAOU="" F S NAOU=$O(^TMP("PSDAMIS",$J,PSDR,NAOU)) D:NAOU="" NTOT Q:NAOU=""!(PSDOUT) W !,?2,"=> ",NAOU,! D G:PSDOUT DONE
.S NUM="" F S NUM=$O(^TMP("PSDAMIS",$J,PSDR,NAOU,NUM)) D:NUM="" TOT Q:NUM=""!(PSDOUT) F JJ=0:0 S JJ=$O(^TMP("PSDAMIS",$J,PSDR,NAOU,NUM,JJ)) Q:'JJ!(PSDOUT) D Q:PSDOUT
..S NODE=^TMP("PSDAMIS",$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),?44,$J($P(NODE,"^",2),8,2)
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,COST,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLAG,IO("Q"),JJ,JJ1,KK,LOC,LN
K NAOU,NAOUN,NODE,NUM,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSD,PSDSN,PSDT,RPDT,SUM,X,Y
K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
K ^TMP("PSDAMIS",$J),^TMP("PSDAMIST",$J),^TMP("PSDAMISG",$J),^TMP("PSDAMISQ",$J),^TMP("PSDAMISS",$J),^TMP("PSDAMISQT",$J),^TMP("PSDAMISC",$J),^TMP("PSDAMISCN",$J),^TMP("PSDAMISCG",$J)
K ^TMP("PSDAMISVG",$J),^TMP("PSDAMISCVG",$J)
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
HDR ;lists header information
Q:PSDOUT
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 AMIS REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
W:$G(PSDR)]"" "DRUG: ",PSDR,!
W "From ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
W !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?40,"COST PER ORDER",!,LN,!
Q
TOT Q:PSDOUT W !,"---------",?25,"----------",!,?3,^TMP("PSDAMISS",$J,PSDR,NAOU),?25,$J(^TMP("PSDAMISQ",$J,PSDR,NAOU),6),?44,$J(^TMP("PSDAMISC",$J,PSDR,NAOU),8,2),?60,"** NAOU Totals **",!
W "=========",?25,"=========",?40,"=============",!
Q
NTOT ;print drug subtotals
Q:PSDOUT I $Y+8>IOSL D HDR Q:PSDOUT
W:$D(FLAG) !,?5,"** ",PSDR," **",!
W:'$D(FLAG) !,"Drug Subtotals: " W !,"Number of Orders: ",?25,$J(^TMP("PSDAMIST",$J,PSDR),7)
W !,"Total Quantity of Orders: ",?25,$J(^TMP("PSDAMISQT",$J,PSDR),6)
W !,"Total Cost of Orders: ",?44,$J(^TMP("PSDAMISCN",$J,PSDR),8,2)
W !,"Average Cost Per Order: ",?44,$S(+^TMP("PSDAMIST",$J,PSDR):$J((^TMP("PSDAMISCN",$J,PSDR)/^TMP("PSDAMIST",$J,PSDR)),8,2),1:$J("0.00",8,2)),!
Q
GTOT ;grand total
Q:PSDOUT
D HDR Q:PSDOUT S FLAG=1 W !!,?35,"Drug Subtotals Summary",!!
S PSDR="" F S PSDR=$O(^TMP("PSDAMIST",$J,PSDR)) Q:PSDR="" D NTOT Q:PSDOUT
D HDR Q:PSDOUT
W !,"Grand Totals by Dispensing Site: ",PSDSN,!
S PSDSN="" F S PSDSN=$O(^TMP("PSDAMISVG",$J,PSDSN)) Q:PSDSN=""!PSDOUT D Q:PSDOUT
.I $Y+6>IOSL D HDR Q:PSDOUT
.W !,"Number of Orders: ",?25,$J(^TMP("PSDAMISVG",$J,PSDSN),6),!,"Cost of Orders: ",?44,$J(^TMP("PSDAMISCVG",$J,PSDSN),8,2),!
.W "Average Cost Per Order: ",?44,$S(+^TMP("PSDAMISVG",$J,PSDSN):$J((^TMP("PSDAMISCVG",$J,PSDSN)/^TMP("PSDAMISVG",$J,PSDSN)),8,2),1:$J("0.00",8,2)),!
D HDR
W !,"Grand Totals: ",!,"Number of Orders: ",?25,$J(^TMP("PSDAMISG",$J),6),!,"Cost of Orders: ",?44,$J(^TMP("PSDAMISCG",$J),8,2),!
W "Average Cost Per Order: ",?44,$S(+^TMP("PSDAMISG",$J):$J((^TMP("PSDAMISCG",$J)/^TMP("PSDAMISG",$J)),8,2),1:$J("0.00",8,2)),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDAMIS0 3716 printed Nov 22, 2024@16:55:12 Page 2
PSDAMIS0 ;BIR/JPW-Print NAOU AMIS Report by Drug ; 1 Sept 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
EN ;entry to print report
+1 IF SUM
DO ^PSDAMIS4
GOTO DONE
PRINT ;prints data for stock drugs
+1 KILL LN
SET $PIECE(LN,"-",80)=""
SET (PG,PSDOUT)=0
SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET RPDT=Y
+2 IF '$DATA(^TMP("PSDAMIS",$JOB))
DO HDR
WRITE !!,?10,"***** NO DATA AVAILABLE FOR THIS REPORT *****"
GOTO DONE
+3 SET PSDR=""
FOR
SET PSDR=$ORDER(^TMP("PSDAMIS",$JOB,PSDR))
if PSDR=""
DO GTOT
if PSDR=""!(PSDOUT)
QUIT
DO HDR
SET NAOU=""
FOR
SET NAOU=$ORDER(^TMP("PSDAMIS",$JOB,PSDR,NAOU))
if NAOU=""
DO NTOT
if NAOU=""!(PSDOUT)
QUIT
WRITE !,?2,"=> ",NAOU,!
Begin DoDot:1
+4 SET NUM=""
FOR
SET NUM=$ORDER(^TMP("PSDAMIS",$JOB,PSDR,NAOU,NUM))
if NUM=""
DO TOT
if NUM=""!(PSDOUT)
QUIT
FOR JJ=0:0
SET JJ=$ORDER(^TMP("PSDAMIS",$JOB,PSDR,NAOU,NUM,JJ))
if 'JJ!(PSDOUT)
QUIT
Begin DoDot:2
+5 SET NODE=^TMP("PSDAMIS",$JOB,PSDR,NAOU,NUM,JJ)
SET DATE=$EXTRACT(JJ,4,5)_"/"_$EXTRACT(JJ,6,7)_"/"_$EXTRACT(JJ,2,3)
+6 IF $Y+8>IOSL
DO HDR
if PSDOUT
QUIT
WRITE !,?2,"=> ",NAOU,!
+7 WRITE !,NUM,?16,DATE,?25,$JUSTIFY($PIECE(NODE,"^"),6),?44,$JUSTIFY($PIECE(NODE,"^",2),8,2)
End DoDot:2
if PSDOUT
QUIT
End DoDot:1
if PSDOUT
GOTO DONE
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,COST,DA,DATE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLAG,IO("Q"),JJ,JJ1,KK,LOC,LN
+2 KILL NAOU,NAOUN,NODE,NUM,QTY,PG,POP,PSD,PSDATE,PSDED,PSDOUT,PSDPN,PSDR,PSDRN,PSDS,PSDSD,PSDSN,PSDT,RPDT,SUM,X,Y
+3 KILL ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+4 KILL ^TMP("PSDAMIS",$JOB),^TMP("PSDAMIST",$JOB),^TMP("PSDAMISG",$JOB),^TMP("PSDAMISQ",$JOB),^TMP("PSDAMISS",$JOB),^TMP("PSDAMISQT",$JOB),^TMP("PSDAMISC",$JOB),^TMP("PSDAMISCN",$JOB),^TMP("PSDAMISCG",$JOB)
+5 KILL ^TMP("PSDAMISVG",$JOB),^TMP("PSDAMISCVG",$JOB)
+6 DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
HDR ;lists header information
+1 if PSDOUT
QUIT
+2 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
+3 if $Y
WRITE @IOF
SET PG=PG+1
WRITE !,"DRUG/NAOU AMIS REPORT - DATE: "_RPDT,?70,"PAGE: ",PG,!
+4 if $GET(PSDR)]""
WRITE "DRUG: ",PSDR,!
+5 WRITE "From ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!
+6 WRITE !,?2,"=> NAOU",!,?16,"DATE",!,"DISP #",?15,"FILLED",?25,"QUANTITY",?40,"COST PER ORDER",!,LN,!
+7 QUIT
TOT if PSDOUT
QUIT
WRITE !,"---------",?25,"----------",!,?3,^TMP("PSDAMISS",$JOB,PSDR,NAOU),?25,$JUSTIFY(^TMP("PSDAMISQ",$JOB,PSDR,NAOU),6),?44,$JUSTIFY(^TMP("PSDAMISC",$JOB,PSDR,NAOU),8,2),?60,"** NAOU Totals **",!
+1 WRITE "=========",?25,"=========",?40,"=============",!
+2 QUIT
NTOT ;print drug subtotals
+1 if PSDOUT
QUIT
IF $Y+8>IOSL
DO HDR
if PSDOUT
QUIT
+2 if $DATA(FLAG)
WRITE !,?5,"** ",PSDR," **",!
+3 if '$DATA(FLAG)
WRITE !,"Drug Subtotals: "
WRITE !,"Number of Orders: ",?25,$JUSTIFY(^TMP("PSDAMIST",$JOB,PSDR),7)
+4 WRITE !,"Total Quantity of Orders: ",?25,$JUSTIFY(^TMP("PSDAMISQT",$JOB,PSDR),6)
+5 WRITE !,"Total Cost of Orders: ",?44,$JUSTIFY(^TMP("PSDAMISCN",$JOB,PSDR),8,2)
+6 WRITE !,"Average Cost Per Order: ",?44,$SELECT(+^TMP("PSDAMIST",$JOB,PSDR):$JUSTIFY((^TMP("PSDAMISCN",$JOB,PSDR)/^TMP("PSDAMIST",$JOB,PSDR)),8,2),1:$JUSTIFY("0.00",8,2)),!
+7 QUIT
GTOT ;grand total
+1 if PSDOUT
QUIT
+2 DO HDR
if PSDOUT
QUIT
SET FLAG=1
WRITE !!,?35,"Drug Subtotals Summary",!!
+3 SET PSDR=""
FOR
SET PSDR=$ORDER(^TMP("PSDAMIST",$JOB,PSDR))
if PSDR=""
QUIT
DO NTOT
if PSDOUT
QUIT
+4 DO HDR
if PSDOUT
QUIT
+5 WRITE !,"Grand Totals by Dispensing Site: ",PSDSN,!
+6 SET PSDSN=""
FOR
SET PSDSN=$ORDER(^TMP("PSDAMISVG",$JOB,PSDSN))
if PSDSN=""!PSDOUT
QUIT
Begin DoDot:1
+7 IF $Y+6>IOSL
DO HDR
if PSDOUT
QUIT
+8 WRITE !,"Number of Orders: ",?25,$JUSTIFY(^TMP("PSDAMISVG",$JOB,PSDSN),6),!,"Cost of Orders: ",?44,$JUSTIFY(^TMP("PSDAMISCVG",$JOB,PSDSN),8,2),!
+9 WRITE "Average Cost Per Order: ",?44,$SELECT(+^TMP("PSDAMISVG",$JOB,PSDSN):$JUSTIFY((^TMP("PSDAMISCVG",$JOB,PSDSN)/^TMP("PSDAMISVG",$JOB,PSDSN)),8,2),1:$JUSTIFY("0.00",8,2)),!
End DoDot:1
if PSDOUT
QUIT
+10 DO HDR
+11 WRITE !,"Grand Totals: ",!,"Number of Orders: ",?25,$JUSTIFY(^TMP("PSDAMISG",$JOB),6),!,"Cost of Orders: ",?44,$JUSTIFY(^TMP("PSDAMISCG",$JOB),8,2),!
+12 WRITE "Average Cost Per Order: ",?44,$SELECT(+^TMP("PSDAMISG",$JOB):$JUSTIFY((^TMP("PSDAMISCG",$JOB)/^TMP("PSDAMISG",$JOB)),8,2),1:$JUSTIFY("0.00",8,2)),!
+13 QUIT
