source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAMIS.m@ 1732

Last change on this file since 1732 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PSOAMIS ;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)
5EDT 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
6DEV 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
11ENQ ;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 ;
29END 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
32RPT ; 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
38COM ;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
41SUB ;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
46GR ;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
50DIR K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E" D ^DIR K DIR
51 Q
Note: See TracBrowser for help on using the repository browser.