PSORPTS1 ;BHAM ISC/SAB  - MOST COMMONLY DISPENSED DRUGS REPORT ; 03/29/93 13:04
 ;;7.0;OUTPATIENT PHARMACY;**29,55**;DEC 1997
 ;External Ref. to ^PSDRUG is supp. by DBIA# 221
SDT W ! S %DT("A")="STARTING DATE: ",%DT="EXAP" D ^%DT G:"^"[X END G:Y<0 SDT S (%DT(0),SDT)=Y
EDT W ! S %DT("A")="ENDING DATE: ",%DT="EXAP" D ^%DT G:"^"[X END G:Y<0 EDT S EDT=Y K %DT
P0 S DIR("A")="DO NOT PRINT DRUG IF COUNT IS LESS THAN ",DIR("B")=20,DIR(0)="N^1:100:0"
 D ^DIR S PSMIN=Y K DIR G:$D(DIRUT) END
 K %ZIS,IOP,ZTSK,POP S PSOION=ION,%ZIS="QM" D ^%ZIS K %ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION G END
 K PSOION I $D(IO("Q")) S ZTRTN="RPT^PSORPTS1" F G="SDT","EDT","PSMIN" S:$D(@G) ZTSAVE(G)=""
 I  K IO("Q") S ZTDESC="MOST COMMON DISPENSED DRUGS REPORT" D ^%ZTLOAD W:$D(ZTSK) !,"REPORT IS QUEUED TO PRINT",! K ZTSK G END
RPT U IO K ^TMP($J) S PG=0,X="",PSDT=SDT-1,PFT=""
 F  S PSDT=$O(^PSRX("AD",PSDT)) Q:'PSDT!(PSDT>EDT)  F IRN=0:0 S IRN=$O(^PSRX("AD",PSDT,IRN)) Q:'IRN  F  S PFT=$O(^PSRX("AD",PSDT,IRN,PFT)) Q:PFT=""  D
 .Q:'$D(^PSRX(IRN,0))  S Y=^PSRX(IRN,0),Y2=$G(^(2))
 .S DRG=+$P(Y,"^",6),Y=+$P(Y,"^",7),DV=$S($P(Y2,"^",9):$P(Y2,"^",9),1:$O(^PS(59,0))) D P1:DV&($D(^PSDRUG(DRG,0)))
 F DV=0:0 S DV=$O(^TMP($J,DV)) Q:'DV  F I=0:0 S I=$O(^TMP($J,DV,0,I)) Q:'I  D
 .S Y=$S($D(^PSDRUG(I,0)):$E($P(^(0),"^"),1,30),1:I)
 .F II=0:0 S II=$O(^TMP($J,DV,0,I,II)) Q:'II  I ^TMP($J,DV,0,I,II)'<PSMIN S ST=999999-^(II) F J=1:1 I '$D(^TMP($J,DV,1,ST,Y,J)) S ^(J)=I_"^"_II Q
 I '$O(^TMP($J,0)) W !!?30,">>>>> NO DISPENSED DRUGS FOUND  <<<<<" D HD G END
 S (DVH,DV)=0,II=""
 F  S DV=$O(^TMP($J,DV)) Q:'DV!($D(DIRUT))  I $O(^TMP($J,+$G(DV),1,0)) D:DVH'=DV HD F ST=0:0 S ST=$O(^TMP($J,DV,1,ST)) Q:'ST!($D(DIRUT))  D
 .F J=0:0 S II=$O(^TMP($J,DV,1,ST,II)) Q:II=""!($D(DIRUT))  F T=0:0 S T=$O(^TMP($J,DV,1,ST,II,T)) Q:'T!($D(DIRUT))  D
 ..S DRG=+^TMP($J,DV,1,ST,II,T),QTY=+$P(^(T),"^",2) D:$Y+4>IOSL HD Q:$D(DIRUT)  W !,$J(DRG,5),"  ",$S($D(^PSDRUG(DRG,0)):$P(^(0),"^"),1:"********"),?52,$J(QTY,12),?64,$J($P(^TMP($J,DV,0,DRG,QTY),"^"),7) S DVH=DV
END W ! D ^%ZISC K T,SDT,IRN,PFT,^TMP($J),DIROUT,DTOUT,DUOUT,DIRUT,SDT,ST,EDT,PSMIN,DAT,%DT,G,I,II,J,PSOION,X,Y,ZI,DRG,PG,DIR,DV,QTY S:$D(ZTQUEUED) ZTREQ="@"
 K PSDT,Y2 Q
P1 I 'PFT,$S($P(Y2,"^",2):$P(Y2,"^",2),1:$P(Y,"^",13))'<SDT,$S($P(Y2,"^",2):$P(Y2,"^",2),1:$P(Y,"^",13))'>EDT S ^TMP($J,DV,0,DRG)=$S($D(^TMP($J,DV,0,DRG)):^(DRG)+1,1:1) S ^(Y)=$S($D(^(DRG,Y)):^(Y)+1,1:1)
 I PFT,$D(^PSRX(IRN,1,PFT,0)),+^(0)'<SDT,+^(0)'>EDT S ^TMP($J,DV,0,DRG)=$S($D(^TMP($J,DV,0,DRG)):^(DRG)+1,1:1) S ^(Y)=$S($D(^(DRG,Y)):^(Y)+1,1:1)
 Q
HD I PG,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
 S PG=PG+1 W @IOF,"MOST COMMONLY DISPENSED DRUGS FROM ",$E(SDT,4,5),"-",$E(SDT,6,7),"-",$E(SDT,2,3)," THRU ",$E(EDT,4,5),"-",$E(EDT,6,7),"-",$E(EDT,2,3),?70,$E(DT,4,5),"-",$E(DT,6,7),"-",$E(DT,2,3)
 W !?15,"MINIMUM DRUG COUNT OF "_PSMIN,?70,"Pg: "_PG,!,"ENTRY",!,"NUMBER",?10,"DRUG",?55,"QUANTITY",?68,"FILLS",! F ZI=1:1:80 W "-"
  W:$G(DV) !,"Division: "_$P(^PS(59,DV,0),"^"),! Q