- PSOAMIS1 ;BHAM ISC/SAB,BHW - daily amis total report ; 11/04/92 17:45
- ;;7.0;OUTPATIENT PHARMACY;**158**;DEC 1997
- ;
- W !!,"Daily AMIS Report. Prints Daily, Monthly and Quarterly AMIS Data",!!,"PLEASE PRINT ON WIDE PAPER, I.E., 132 COLUMNS."
- DA 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)
- 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)
- DEV 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
- 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)=""
- I D ^%ZTLOAD W:$D(ZTSK) !,"Report queued to print!" K G,ZTSAVE,ZTSK,ZTIO,PSDATE,BQTR,EQTR,MON,EDT Q
- ENQ ;start computations
- K ^TMP("PSOAMIS",$J) S PG=0 F DIV=0:0 S DIV=$O(^PS(59,DIV)) Q:'DIV D
- .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
- .S (^TMP("PSOAMIS",$J,"MTH",DIV),^TMP("PSOAMIS",$J,"QTR",DIV))=0
- I $D(^PS(59.1,PSDATE)) 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 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")
- . Q
- 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
- ;monthly data
- 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
- ;quarterly data
- 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
- PRI ;OUTPUT DATA
- 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
- .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)
- .I $E(IOST)["C",($Y+4)>IOSL D DIR
- 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)
- END 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="@"
- Q
- HDR ;report header
- S PG=PG+1
- 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
- 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 "-"
- W ! Q
- SUB 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
- Q
- COMP 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
- .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)
- .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)
- .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)
- Q
- DIR K DIR,DUOUT,DTOUT,DIRUT S DIR(0)="E" D ^DIR K DIR,DUOUT,DTOUT Q
- PSOAMIS1 ;BHAM ISC/SAB,BHW - daily amis total report ; 11/04/92 17:45
- +1 ;;7.0;OUTPATIENT PHARMACY;**158**;DEC 1997
- +2 ;
- +3 WRITE !!,"Daily AMIS Report. Prints Daily, Monthly and Quarterly AMIS Data",!!,"PLEASE PRINT ON WIDE PAPER, I.E., 132 COLUMNS."
- DA WRITE !!
- SET %DT(0)=-DT
- SET %DT("A")="Compute AMIS for what day: "
- SET %DT="EXPA"
- DO ^%DT
- IF "^"[X
- GOTO END
- IF Y<0
- GOTO DA
- SET PSDATE=Y
- SET MON=$EXTRACT(Y,1,5)_"00"
- SET EDT=MON+32
- KILL %DT(0)
- +1 SET MONTH=$EXTRACT(Y,4,5)
- SET MONTH=MONTH-1\3*3+1
- SET BQTR=$EXTRACT(Y,1,3)_$SELECT($LENGTH(MONTH)<2:"0"_MONTH,1:MONTH)_"00"
- SET EQTR=$EXTRACT(Y,1,3)_MONTH+2_32
- IF $LENGTH(EQTR)<7
- SET EQTR=$EXTRACT(EQTR,1,3)_"0"_$EXTRACT(EQTR,4,6)
- DEV KILL %ZIS,IOP,ZTSK
- SET %ZIS("B")=""
- SET PSOION=ION
- SET %ZIS="QM"
- DO ^%ZIS
- IF POP
- SET IOP=PSOION
- DO ^%ZIS
- KILL IOP,PSOION
- GOTO END
- +1 IF $DATA(IO("Q"))
- KILL PSOION
- SET ZTDTH=$HOROLOG
- SET ZTDESC="Compile and print daily, monthly and quarterly amis totals"
- SET ZTIO=IO
- SET ZTRTN="ENQ^PSOAMIS1"
- FOR G="PSDATE","BQTR","EQTR","MON","EDT"
- IF $DATA(@G)
- SET ZTSAVE(G)=""
- +2 IF $TEST
- DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"Report queued to print!"
- KILL G,ZTSAVE,ZTSK,ZTIO,PSDATE,BQTR,EQTR,MON,EDT
- QUIT
- ENQ ;start computations
- +1 KILL ^TMP("PSOAMIS",$JOB)
- SET PG=0
- FOR DIV=0:0
- SET DIV=$ORDER(^PS(59,DIV))
- IF 'DIV
- QUIT
- Begin DoDot:1
- +2 SET (^TMP("PSOAMIS",$JOB,"SUB",DIV),^TMP("PSOAMIS",$JOB,"SUBMONTH",DIV),^TMP("PSOAMIS",$JOB,"SUBQTR",DIV),^TMP("PSOAMIS",$JOB,"GT"),^TMP("PSOAMIS",$JOB,"GTMON"),^TMP("PSOAMIS",$JOB,"GTQTR"))=0
- +3 SET (^TMP("PSOAMIS",$JOB,"MTH",DIV),^TMP("PSOAMIS",$JOB,"QTR",DIV))=0
- End DoDot:1
- +4 IF $DATA(^PS(59.1,PSDATE))
- FOR I=0:0
- SET I=$ORDER(^PS(59.1,PSDATE,1,I))
- IF 'I
- QUIT
- Begin DoDot:1
- +5 SET X=^PS(59.1,PSDATE,1,I,0)
- +6 SET ^TMP("PSOAMIS",$JOB,I,PSDATE)=$PIECE(X,"^",2,3)_"^"_$PIECE(X,"^",5)_"^"_$PIECE(X,"^",7)_"^"_$PIECE(X,"^",18)_"^"_$PIECE(X,"^",8,12)_"^"_$PIECE(X,"^",14,17)
- +7 FOR S=1:1:14
- SET ^TMP("PSOAMIS",$JOB,"SUB",I)=^TMP("PSOAMIS",$JOB,"SUB",I)+$PIECE(^TMP("PSOAMIS",$JOB,I,PSDATE),"^",S)
- SET ^TMP("PSOAMIS",$JOB,"GT")=$PIECE(^TMP("PSOAMIS",$JOB,I,PSDATE),"^",S)+^TMP("PSOAMIS",$JOB,"GT")
- +8 QUIT
- End DoDot:1
- +9 IF '$TEST
- FOR DIV=0:0
- SET DIV=$ORDER(^PS(59,DIV))
- IF 'DIV
- QUIT
- FOR I=1:1:17
- SET $PIECE(^TMP("PSOAMIS",$JOB,DIV,PSDATE),"^",I)=0
- +10 ;monthly data
- +11 FOR G=0:0
- SET MON=$ORDER(^PS(59.1,MON))
- IF MON>EDT!('MON)
- QUIT
- FOR I=0:0
- SET I=$ORDER(^PS(59.1,MON,1,I))
- IF 'I
- QUIT
- SET MT=1
- DO COMP
- +12 ;quarterly data
- +13 FOR G=0:0
- SET BQTR=$ORDER(^PS(59.1,BQTR))
- IF 'BQTR!(BQTR>EQTR)
- QUIT
- FOR I=0:0
- SET I=$ORDER(^PS(59.1,BQTR,1,I))
- IF 'I
- QUIT
- SET MT=0
- DO COMP
- PRI ;OUTPUT DATA
- +1 SET ZDIV=""
- FOR DIV=0:0
- SET DIV=$ORDER(^PS(59,DIV))
- IF 'DIV!($DATA(DIRUT))
- QUIT
- DO HDR
- FOR I=1:1:14
- WRITE !,$PIECE("INPAT^SC^A&A^OTHER^NVA^CNTLD^METHA^PAT REQ^FEE^STAFF^NEW^REFILL^WINDOW^MAIL","^",I)
- Begin DoDot:1
- +2 WRITE ?20,$JUSTIFY(+$PIECE(^TMP("PSOAMIS",$JOB,DIV,PSDATE),"^",I),9),?50,$JUSTIFY(+$PIECE(^TMP("PSOAMIS",$JOB,"MTH",DIV),"^",I),9),?80,$JUSTIFY(+$PIECE(^TMP("PSOAMIS",$JOB,"QTR",DIV),"^",I),9)
- +3 IF $EXTRACT(IOST)["C"
- IF ($Y+4)>IOSL
- DO DIR
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- SET ZDIV=DIV
- IF I=14
- DO SUB
- +4 IF '$DATA(DIRUT)
- WRITE !!,"GRAND TOTALS",?20,$JUSTIFY("=========",9),?50,$JUSTIFY("=========",9),?80,$JUSTIFY("=========",9),!,?20,$JUSTIFY(^TMP("PSOAMIS",$JOB,"GT"),9),?50,$JUSTIFY(^TMP("PSOAMIS",$JOB,"GTMON"),9),?80,$JUSTIFY(^TMP("PSOAMIS",$JOB,"GTQTR"),9
- )
- END WRITE !
- IF $EXTRACT(IOST)'["C"
- WRITE @IOF
- DO ^%ZISC
- KILL DIRUT,^TMP("PSOAMIS",$JOB),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
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 QUIT
- HDR ;report header
- +1 SET PG=PG+1
- +2 USE IO
- WRITE @IOF,?20,"Daily/Monthly/Quarterly AMIS report for "
- SET Y=$EXTRACT(PSDATE,1,5)_"00"
- XECUTE ^DD("DD")
- WRITE Y,!?20,"Division: "_$PIECE(^PS(59,DIV,0),"^"),?115,"Page: "_PG
- +3 WRITE !,?20,$EXTRACT(PSDATE,4,5)_"-"_$EXTRACT(PSDATE,6,7)_"-"_$EXTRACT(PSDATE,2,3),?50,"Monthly Totals",?80,"Quarterly Totals"
- WRITE !
- FOR K=1:1:132
- WRITE "-"
- +4 WRITE !
- QUIT
- SUB WRITE !!,"Sub Totals",?20,$JUSTIFY("=========",9),?50,$JUSTIFY("=========",9),?80,$JUSTIFY("=========",9),!,?20,$JUSTIFY(^TMP("PSOAMIS",$JOB,"SUB",DIV),9),?50,$JUSTIFY(^TMP("PSOAMIS",$JOB,"SUBMONTH",DIV),9),?80,$JUSTIFY(^TMP("PSOAMIS",...
- ... $JOB,"SUBQTR",DIV),9)
- IF $EXTRACT(IOST)["C"
- DO DIR
- +1 QUIT
- COMP SET IFN=1
- FOR AFN=2,3,5,7,18,8,9,10,11,12,14,15,16,17
- IF IFN>14
- QUIT
- Begin DoDot:1
- +1 SET $PIECE(^TMP("PSOAMIS",$JOB,$SELECT(MT:"MTH",1:"QTR"),I),"^",IFN)=$PIECE(^TMP("PSOAMIS",$JOB,$SELECT(MT:"MTH",1:"QTR"),I),"^",IFN)+$PIECE(^PS(59.1,$SELECT(MT:MON,1:BQTR),1,I,0),"^",AFN)
- +2 SET ^TMP("PSOAMIS",$JOB,$SELECT(MT:"SUBMONTH",1:"SUBQTR"),I)=^TMP("PSOAMIS",$JOB,$SELECT(MT:"SUBMONTH",1:"SUBQTR"),I)+$PIECE(^PS(59.1,$SELECT(MT:MON,1:BQTR),1,I,0),"^",AFN)
- +3 SET ^TMP("PSOAMIS",$JOB,$SELECT(MT:"GTMON",1:"GTQTR"))=^TMP("PSOAMIS",$JOB,$SELECT(MT:"GTMON",1:"GTQTR"))+$PIECE(^PS(59.1,$SELECT(MT:MON,1:BQTR),1,I,0),"^",AFN)
- End DoDot:1
- SET IFN=IFN+1
- +4 QUIT
- DIR KILL DIR,DUOUT,DTOUT,DIRUT
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR,DUOUT,DTOUT
- QUIT
