- 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
- 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
