52 lines
2.6 KiB
Mathematica
52 lines
2.6 KiB
Mathematica
|
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
|