source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOAMIS1.m@ 1423

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1PSOAMIS1 ;BHAM ISC/SAB,BHW - daily amis total report ; 11/04/92 17:45
2 ;;7.0;OUTPATIENT PHARMACY;**158**;DEC 1997
3 ;
4 W !!,"Daily AMIS Report. Prints Daily, Monthly and Quarterly AMIS Data",!!,"PLEASE PRINT ON WIDE PAPER, I.E., 132 COLUMNS."
5DA W !! S %DT(0)=-DT,%DT("A")="Compute AMIS for what day: " S %DT="EXPA" D ^%DT G:"^"[X END G:Y<0 DA S PSDATE=Y,MON=$E(Y,1,5)_"00",EDT=MON+32 K %DT(0)
6 S MONTH=$E(Y,4,5),MONTH=MONTH-1\3*3+1,BQTR=$E(Y,1,3)_$S($L(MONTH)<2:"0"_MONTH,1:MONTH)_"00",EQTR=$E(Y,1,3)_MONTH+2_32 I $L(EQTR)<7 S EQTR=$E(EQTR,1,3)_"0"_$E(EQTR,4,6)
7DEV 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 I $D(IO("Q")) K PSOION S ZTDTH=$H,ZTDESC="Compile and print daily, monthly and quarterly amis totals",ZTIO=IO,ZTRTN="ENQ^PSOAMIS1" F G="PSDATE","BQTR","EQTR","MON","EDT" S:$D(@G) ZTSAVE(G)=""
9 I D ^%ZTLOAD W:$D(ZTSK) !,"Report queued to print!" K G,ZTSAVE,ZTSK,ZTIO,PSDATE,BQTR,EQTR,MON,EDT Q
10ENQ ;start computations
11 K ^TMP("PSOAMIS",$J) S PG=0 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV D
12 .S (^TMP("PSOAMIS",$J,"SUB",DIV),^TMP("PSOAMIS",$J,"SUBMONTH",DIV),^TMP("PSOAMIS",$J,"SUBQTR",DIV),^TMP("PSOAMIS",$J,"GT"),^TMP("PSOAMIS",$J,"GTMON"),^TMP("PSOAMIS",$J,"GTQTR"))=0
13 .S (^TMP("PSOAMIS",$J,"MTH",DIV),^TMP("PSOAMIS",$J,"QTR",DIV))=0
14 I $D(^PS(59.1,PSDATE)) F I=0:0 S I=$O(^PS(59.1,PSDATE,1,I)) Q:'I D
15 . S X=^PS(59.1,PSDATE,1,I,0)
16 . 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)
17 . F S=1:1:14 S ^TMP("PSOAMIS",$J,"SUB",I)=^TMP("PSOAMIS",$J,"SUB",I)+$P(^TMP("PSOAMIS",$J,I,PSDATE),"^",S),^TMP("PSOAMIS",$J,"GT")=$P(^TMP("PSOAMIS",$J,I,PSDATE),"^",S)+^TMP("PSOAMIS",$J,"GT")
18 . Q
19 E F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV F I=1:1:17 S $P(^TMP("PSOAMIS",$J,DIV,PSDATE),"^",I)=0
20 ;monthly data
21 F G=0:0 S MON=$O(^PS(59.1,MON)) Q:MON>EDT!('MON) F I=0:0 S I=$O(^PS(59.1,MON,1,I)) Q:'I S MT=1 D COMP
22 ;quarterly data
23 F G=0:0 S BQTR=$O(^PS(59.1,BQTR)) Q:'BQTR!(BQTR>EQTR) F I=0:0 S I=$O(^PS(59.1,BQTR,1,I)) Q:'I S MT=0 D COMP
24PRI ;OUTPUT DATA
25 S ZDIV="" F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV!($D(DIRUT)) D HDR F I=1:1:14 W !,$P("INPAT^SC^A&A^OTHER^NVA^CNTLD^METHA^PAT REQ^FEE^STAFF^NEW^REFILL^WINDOW^MAIL","^",I) D Q:$D(DIRUT) S ZDIV=DIV D:I=14 SUB
26 .W ?20,$J(+$P(^TMP("PSOAMIS",$J,DIV,PSDATE),"^",I),9),?50,$J(+$P(^TMP("PSOAMIS",$J,"MTH",DIV),"^",I),9),?80,$J(+$P(^TMP("PSOAMIS",$J,"QTR",DIV),"^",I),9)
27 .I $E(IOST)["C",($Y+4)>IOSL D DIR
28 W:'$D(DIRUT) !!,"GRAND TOTALS",?20,$J("=========",9),?50,$J("=========",9),?80,$J("=========",9),!,?20,$J(^TMP("PSOAMIS",$J,"GT"),9),?50,$J(^TMP("PSOAMIS",$J,"GTMON"),9),?80,$J(^TMP("PSOAMIS",$J,"GTQTR"),9)
29END W ! W:$E(IOST)'["C" @IOF D ^%ZISC K DIRUT,^TMP("PSOAMIS",$J),MON,S,K,PSDATE,MONTH,BQTR,EQTR,SDT,SUB,I,G,GT,%DT,GR,Y,X,POP,PG,DIV,EDT,INPAT,SC,AA,OTH,CNTLD,METH,PREQ,FEE,STAFF,NEW,REF,WIND,MAIL,ZDIV S:$D(ZTQUEUED) ZTREQ="@"
30 Q
31HDR ;report header
32 S PG=PG+1
33 U IO W @IOF,?20,"Daily/Monthly/Quarterly AMIS report for " S Y=$E(PSDATE,1,5)_"00" X ^DD("DD") W Y,!?20,"Division: "_$P(^PS(59,DIV,0),"^"),?115,"Page: "_PG
34 W !,?20,$E(PSDATE,4,5)_"-"_$E(PSDATE,6,7)_"-"_$E(PSDATE,2,3),?50,"Monthly Totals",?80,"Quarterly Totals" W ! F K=1:1:132 W "-"
35 W ! Q
36SUB W !!,"Sub Totals",?20,$J("=========",9),?50,$J("=========",9),?80,$J("=========",9),!,?20,$J(^TMP("PSOAMIS",$J,"SUB",DIV),9),?50,$J(^TMP("PSOAMIS",$J,"SUBMONTH",DIV),9),?80,$J(^TMP("PSOAMIS",$J,"SUBQTR",DIV),9) D:$E(IOST)["C" DIR
37 Q
38COMP S IFN=1 F AFN=2,3,5,7,18,8,9,10,11,12,14,15,16,17 Q:IFN>14 D S IFN=IFN+1
39 .S $P(^TMP("PSOAMIS",$J,$S(MT:"MTH",1:"QTR"),I),"^",IFN)=$P(^TMP("PSOAMIS",$J,$S(MT:"MTH",1:"QTR"),I),"^",IFN)+$P(^PS(59.1,$S(MT:MON,1:BQTR),1,I,0),"^",AFN)
40 .S ^TMP("PSOAMIS",$J,$S(MT:"SUBMONTH",1:"SUBQTR"),I)=^TMP("PSOAMIS",$J,$S(MT:"SUBMONTH",1:"SUBQTR"),I)+$P(^PS(59.1,$S(MT:MON,1:BQTR),1,I,0),"^",AFN)
41 .S ^TMP("PSOAMIS",$J,$S(MT:"GTMON",1:"GTQTR"))=^TMP("PSOAMIS",$J,$S(MT:"GTMON",1:"GTQTR"))+$P(^PS(59.1,$S(MT:MON,1:BQTR),1,I,0),"^",AFN)
42 Q
43DIR K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E" D ^DIR K DIR,DUOUT,DTOUT Q
Note: See TracBrowser for help on using the repository browser.