| 1 | PSORPTS1 ;BHAM ISC/SAB - MOST COMMONLY DISPENSED DRUGS REPORT ; 03/29/93 13:04
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**29,55**;DEC 1997
|
|---|
| 3 | ;External Ref. to ^PSDRUG is supp. by DBIA# 221
|
|---|
| 4 | SDT W ! S %DT("A")="STARTING DATE: ",%DT="EXAP" D ^%DT G:"^"[X END G:Y<0 SDT S (%DT(0),SDT)=Y
|
|---|
| 5 | EDT W ! S %DT("A")="ENDING DATE: ",%DT="EXAP" D ^%DT G:"^"[X END G:Y<0 EDT S EDT=Y K %DT
|
|---|
| 6 | P0 S DIR("A")="DO NOT PRINT DRUG IF COUNT IS LESS THAN ",DIR("B")=20,DIR(0)="N^1:100:0"
|
|---|
| 7 | D ^DIR S PSMIN=Y K DIR G:$D(DIRUT) END
|
|---|
| 8 | 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
|
|---|
| 9 | K PSOION I $D(IO("Q")) S ZTRTN="RPT^PSORPTS1" F G="SDT","EDT","PSMIN" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 10 | 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
|
|---|
| 11 | RPT U IO K ^TMP($J) S PG=0,X="",PSDT=SDT-1,PFT=""
|
|---|
| 12 | 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
|
|---|
| 13 | .Q:'$D(^PSRX(IRN,0)) S Y=^PSRX(IRN,0),Y2=$G(^(2))
|
|---|
| 14 | .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)))
|
|---|
| 15 | 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
|
|---|
| 16 | .S Y=$S($D(^PSDRUG(I,0)):$E($P(^(0),"^"),1,30),1:I)
|
|---|
| 17 | .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
|
|---|
| 18 | I '$O(^TMP($J,0)) W !!?30,">>>>> NO DISPENSED DRUGS FOUND <<<<<" D HD G END
|
|---|
| 19 | S (DVH,DV)=0,II=""
|
|---|
| 20 | 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
|
|---|
| 21 | .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
|
|---|
| 22 | ..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
|
|---|
| 23 | 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="@"
|
|---|
| 24 | K PSDT,Y2 Q
|
|---|
| 25 | 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)
|
|---|
| 26 | 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)
|
|---|
| 27 | Q
|
|---|
| 28 | HD I PG,$E(IOST)="C" K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
|
|---|
| 29 | 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)
|
|---|
| 30 | W !?15,"MINIMUM DRUG COUNT OF "_PSMIN,?70,"Pg: "_PG,!,"ENTRY",!,"NUMBER",?10,"DRUG",?55,"QUANTITY",?68,"FILLS",! F ZI=1:1:80 W "-"
|
|---|
| 31 | W:$G(DV) !,"Division: "_$P(^PS(59,DV,0),"^"),! Q
|
|---|
