| 1 | PSOAMIS ;BHAM ISC/SAB,BHW - pharmacy amis report ; 04/05/93 12:44
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**158**;DEC 1997
|
|---|
| 3 | ;
|
|---|
| 4 | W ! S %DT(0)=-DT,%DT("A")="PRINT AMIS STATS STARTING: " S %DT="EPXA" D ^%DT G:"^"[X END G PSOAMIS:Y<0 S SDT=Y K %DT(0)
|
|---|
| 5 | EDT W ! S %DT(0)=SDT,%DT("A")="ENDING STATS DATE: " D ^%DT G:"^"[X END S EDT=Y I Y<0 G EDT K %DT
|
|---|
| 6 | DEV W $C(7),!!,"PRINTOUT MUST BE SENT TO A 132 COLUMNS PRINTER !!",!!
|
|---|
| 7 | K %ZIS,IOP,ZTSK S %ZIS("B")="",PSOION=ION,%ZIS="QM" D ^%ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION G END
|
|---|
| 8 | K PSOION
|
|---|
| 9 | I $D(IO("Q")) S ZTDESC="Option to print the Outpatient AMIS report",ZTRTN="ENQ^PSOAMIS" F G="SDT","EDT" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 10 | I K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued !" K G,ZTSAVE,ZTSK,Y,X,%DT G END
|
|---|
| 11 | ENQ ;START COMPUTATIONS
|
|---|
| 12 | K ^TMP("PSOAMIS",$J),X
|
|---|
| 13 | D COM
|
|---|
| 14 | S PSDATE=SDT-1
|
|---|
| 15 | F G=0:0 S PSDATE=$O(^PS(59.1,PSDATE)) Q:'PSDATE!(PSDATE>EDT) F I=0:0 S I=$O(^PS(59.1,PSDATE,1,I)) Q:'I D
|
|---|
| 16 | . S X=^PS(59.1,PSDATE,1,I,0)
|
|---|
| 17 | . S ^TMP("PSOAMIS",$J,I,PSDATE)=$P(X,"^",2,3)_"^"_$P(X,"^",5)_"^"_$P(X,"^",7)_"^"_$P(X,"^",18)_"^"_$P(X,"^",8,12)_"^"_$P(X,"^",14,17)
|
|---|
| 18 | . F G=1:1:14 S DAT(I,G)=$P(^TMP("PSOAMIS",$J,I,PSDATE),"^",G)+DAT(I,G),GT(G)=$P(^TMP("PSOAMIS",$J,I,PSDATE),"^",G)+GT(G)
|
|---|
| 19 | . Q
|
|---|
| 20 | S GR=0 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV!($D(DIRUT)) D:GR SUB D:'$D(DIRUT) RPT F PSDATE=0:0 S PSDATE=$O(^TMP("PSOAMIS",$J,DIV,PSDATE)) Q:'PSDATE!($D(DIRUT)) D
|
|---|
| 21 | . S DAT=^TMP("PSOAMIS",$J,DIV,PSDATE) I ($Y+4)>IOSL,$E(IOST)'="C" D RPT
|
|---|
| 22 | . I ($Y+4)>IOSL,$E(IOST)="C" D DIR Q:$D(DIRUT)
|
|---|
| 23 | . W !,$E(PSDATE,4,5)_"-"_$E(PSDATE,6,8)_"-"_$E(PSDATE,2,3) D S GR=1,ST=DIV
|
|---|
| 24 | . . F K=1:1:14 W $J(+$P(DAT,"^",K),8)
|
|---|
| 25 | . . Q
|
|---|
| 26 | . Q
|
|---|
| 27 | G:$G(DIRUT) END D SUB,GR I $Y+4>IOSL,$E(IOST)="C" D DIR Q:$D(DIRUT)
|
|---|
| 28 | ;
|
|---|
| 29 | END W ! W:$E(IOST)'["C" @IOF D ^%ZISC
|
|---|
| 30 | K DTOUT,DUOUT,DIRUT,GR,ST,%DT,G,SDT,EDT,X,Y,POP,^TMP("PSOAMIS",$J),K,PSDATE,I,DAT,G,GT,DIV S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 31 | Q
|
|---|
| 32 | RPT ; HEADER
|
|---|
| 33 | U IO W @IOF,!?55,"A M I S R E P O R T",!!?40,"FROM "_$E(SDT,4,5)_"-"_$E(SDT,6,7)_"-"_$E(SDT,2,3),?60,"TO "_$E(EDT,4,5)_"-"_$E(EDT,6,7)_"-"_$E(EDT,2,3)_" DIVISION: "_$P(^PS(59,DIV,0),"^")
|
|---|
| 34 | W !!,"DATE "
|
|---|
| 35 | F K=1:1:14 W $J($P("INPAT^SC^A&A^OTHER^NVA^CNTLD^METHA^PAT REQ^FEE^STAFF^NEW^REFILL^WINDOW^MAIL","^",K),8)
|
|---|
| 36 | W ! F K=1:1:132 W "-"
|
|---|
| 37 | Q
|
|---|
| 38 | COM ;COMPILE SUB-TOTALS AND GRAND TOTALS
|
|---|
| 39 | F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV F G=1:1:14 S (DAT(DIV,G),GT(G))=0
|
|---|
| 40 | Q
|
|---|
| 41 | SUB ;PRINT SUB TOTALS
|
|---|
| 42 | W:$Y+4>IOSL&($E(IOST)'["C") @IOF W !?8 F K=1:1:14 W $J("-------",8)
|
|---|
| 43 | W !,"SUB-TOTALS",!,?8 F K=1:1:14 W:$D(ST) $J(DAT(ST,K),8)
|
|---|
| 44 | D:$E(IOST)["C"&(DIV) DIR
|
|---|
| 45 | Q
|
|---|
| 46 | GR ;PRINT GRAND TOTALS
|
|---|
| 47 | W:$Y+4>IOSL @IOF W !?8 F K=1:1:14 W $J("-------",8)
|
|---|
| 48 | W !,"GRAND TOTALS",!,?8 F K=1:1:14 W $J(GT(K),8)
|
|---|
| 49 | W ! Q
|
|---|
| 50 | DIR K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E" D ^DIR K DIR
|
|---|
| 51 | Q
|
|---|
