PSOAMIS ;BHAM ISC/SAB,BHW - pharmacy amis report ; 04/05/93 12:44
 ;;7.0;OUTPATIENT PHARMACY;**158**;DEC 1997
 ;
 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)
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
DEV W $C(7),!!,"PRINTOUT MUST BE SENT TO A 132 COLUMNS PRINTER !!",!!
 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
 K PSOION
 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)=""
 I  K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued !" K G,ZTSAVE,ZTSK,Y,X,%DT G END
ENQ ;START COMPUTATIONS
 K ^TMP("PSOAMIS",$J),X
 D COM
 S PSDATE=SDT-1
 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
 . S X=^PS(59.1,PSDATE,1,I,0)
 . 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)
 . 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)
 . Q
 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
 . S DAT=^TMP("PSOAMIS",$J,DIV,PSDATE) I ($Y+4)>IOSL,$E(IOST)'="C" D RPT
 . I ($Y+4)>IOSL,$E(IOST)="C" D DIR Q:$D(DIRUT)
 . W !,$E(PSDATE,4,5)_"-"_$E(PSDATE,6,8)_"-"_$E(PSDATE,2,3) D  S GR=1,ST=DIV
 . . F K=1:1:14 W $J(+$P(DAT,"^",K),8)
 . . Q
 . Q
 G:$G(DIRUT) END D SUB,GR I $Y+4>IOSL,$E(IOST)="C" D DIR Q:$D(DIRUT)
 ;
END W ! W:$E(IOST)'["C" @IOF D ^%ZISC
 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="@"
 Q
RPT ; HEADER
 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),"^")
 W !!,"DATE    "
 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)
 W ! F K=1:1:132 W "-"
 Q
COM ;COMPILE SUB-TOTALS AND GRAND TOTALS
 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV  F G=1:1:14 S (DAT(DIV,G),GT(G))=0
 Q
SUB ;PRINT SUB TOTALS
 W:$Y+4>IOSL&($E(IOST)'["C") @IOF W !?8 F K=1:1:14 W $J("-------",8)
 W !,"SUB-TOTALS",!,?8 F K=1:1:14 W:$D(ST) $J(DAT(ST,K),8)
 D:$E(IOST)["C"&(DIV) DIR
 Q
GR ;PRINT GRAND TOTALS
 W:$Y+4>IOSL @IOF W !?8 F K=1:1:14 W $J("-------",8)
 W !,"GRAND TOTALS",!,?8 F K=1:1:14 W $J(GT(K),8)
 W ! Q
DIR K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E" D ^DIR K DIR
 Q