| 1 | PRCPRUS1 ;WISC/RFJ/DL/VAC-usage increase,decrease usage report ; 2/19/07 12:52pm
|
|---|
| 2 | V ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;*98 Modified to accommodate On-Demand Items
|
|---|
| 5 | D ^PRCPUSEL Q:'$G(PRCP("I"))
|
|---|
| 6 | I $P(PRCP("PAR"),"^",3)'="W" D ^PRCPRUS2 Q
|
|---|
| 7 | N %,AVERAGE,CHANGE,COMDATA,COMDT,COMPARE,DATA,DATE,DEFAULT,DESCR,END,ENDDT,ITEMDA,LASTMO,MAXDT,MONTHS,NOW,NOWDT,PAGE,PERCENT,PRCPEND,PRCPFLAG,REPTYPE,SCREEN,START,STARTDT,TOTAL,X,Y,Z,X1,X2
|
|---|
| 8 | D NOW^%DTC S NOWDT=X,Y=% D DD^%DT S NOW=Y,X1=$E(NOWDT,1,5)_"15",X2=-30 D C^%DTC S (LASTMO,Y)=$E(X,1,5)_"00" D DD^%DT S DEFAULT=Y
|
|---|
| 9 | S PRCPEND=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(NOWDT,4,5))
|
|---|
| 10 | I PRCPEND=28 S Z=$E(NOWDT,1,3)+1700,PRCPEND=$S(Z#400=0:29,(Z#4=0&(Z#100'=0)):29,1:28)
|
|---|
| 11 | S MAXDT=$E(NOWDT,1,5)_PRCPEND,Y=($E(LASTMO,1,3)-1)_$E(LASTMO,4,5)_"00" D DD^%DT S START=Y
|
|---|
| 12 | S %DT="AEP",%DT("A")="Compare Usage to Date (Month Year): ",%DT("B")=DEFAULT,%DT(0)=-MAXDT W ! D ^%DT K %DT Q:Y<0 S COMDT=$E(Y,1,5)
|
|---|
| 13 | START S %DT="AEP",%DT("A")="Start Comparison Usage with Date (Month Year): ",%DT("B")=START,%DT(0)=-MAXDT W ! D ^%DT K %DT Q:Y<0 S STARTDT=$E(Y,1,5)
|
|---|
| 14 | S %DT="AEP",%DT("A")=" End Comparison Usage with Date (Month Year): ",%DT("B")=DEFAULT,%DT(0)=-MAXDT D ^%DT K %DT Q:Y<0 S ENDDT=$E(Y,1,5)
|
|---|
| 15 | I ENDDT<STARTDT W !,"END DATE MUST BE GREATER THAN OR EQUAL TO THE START DATE." G START
|
|---|
| 16 | S DIR(0)="N^1:1000",DIR("A")="Enter the percentage of change",DIR("?",1)="Enter a whole number change between 1 and 1000 which represents the percentage",DIR("?")="between the average (from start to end month) and the compare month."
|
|---|
| 17 | S DIR("B")=50 W ! D ^DIR K DIR Q:'+Y S PERCENT=+Y
|
|---|
| 18 | S DIR(0)="S^D:Decrease in Usage;I:Increase in Usage",DIR("A")="Show Items with Increase or Decrease in Usage",DIR("B")="Decrease in Usage" W ! D ^DIR K DIR
|
|---|
| 19 | S REPTYPE=$S(Y="D":"DECREASE",1:"INCREASE"),SCREEN=$S(Y="D":"I COMDATA<AVERAGE",Y="I":"I COMDATA>AVERAGE",1:"") Q:SCREEN=""
|
|---|
| 20 | S %ZIS="Q" D ^%ZIS Q:POP I $D(IO("Q")) D D ^%ZTLOAD K IO("Q"),ZTSK Q
|
|---|
| 21 | . S ZTDESC="Usage Demand Analysis Report",ZTRTN="DQ^PRCPRUS1"
|
|---|
| 22 | . S ZTSAVE("PRCP*")="",ZTSAVE("REPTYPE")="",ZTSAVE("S*")="",ZTSAVE("END*")="",ZTSAVE("NOW*")="",ZTSAVE("COMDT")="",ZTSAVE("PERCENT")="",ZTSAVE("REP")="",ZTSAVE("ZTREQ")="@"
|
|---|
| 23 | W !!,"<*> please wait <*>"
|
|---|
| 24 | DQ ;queue comes here
|
|---|
| 25 | K ^TMP($J,"USAGE") S X1=ENDDT_"00",X2=STARTDT_"00" D ^%DTC S MONTHS=(X+12)\30 S:'MONTHS MONTHS=1
|
|---|
| 26 | S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
|
|---|
| 27 | . Q:$D(PRCPFLAG)
|
|---|
| 28 | . S DATE=STARTDT-1,TOTAL=0 F S DATE=$O(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE)) Q:'DATE!(DATE>ENDDT) S TOTAL=TOTAL+$P($G(^(DATE,0)),"^",2)
|
|---|
| 29 | . Q:'TOTAL S AVERAGE=TOTAL/MONTHS,COMDATA=+$P($G(^PRCP(445,PRCP("I"),1,ITEMDA,2,COMDT,0)),"^",2) X SCREEN Q:'$T
|
|---|
| 30 | . S CHANGE=$S(AVERAGE=0:"***.**",1:(COMDATA-AVERAGE)/AVERAGE*100) S:CHANGE<0 CHANGE=-CHANGE I CHANGE'["*",CHANGE<PERCENT Q
|
|---|
| 31 | . S ^TMP($J,"USAGE",CHANGE,ITEMDA)=COMDATA_"^"_$J(AVERAGE,0,2)_"^"_$S(CHANGE["*":CHANGE,1:$J(CHANGE,0,2))
|
|---|
| 32 | S Y=COMDT_"00" D DD^%DT S COMPARE=Y,Y=STARTDT_"00" D DD^%DT S START=Y,Y=ENDDT_"00" D DD^%DT S END=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|---|
| 33 | S CHANGE="" F S CHANGE=$O(^TMP($J,"USAGE",CHANGE)) Q:CHANGE=""!($D(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"USAGE",CHANGE,ITEMDA)) Q:'ITEMDA!($D(PRCPFLAG)) S DATA=^(ITEMDA) D
|
|---|
| 34 | . Q:$D(PRCPFLAG)
|
|---|
| 35 | . W !,ITEMDA,?10,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,20),?32,$J($P(DATA,"^"),16),$J($P(DATA,"^",2),16),$J($P(DATA,"^",3),16)
|
|---|
| 36 | . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|---|
| 37 | . Q:$D(PRCPFLAG)
|
|---|
| 38 | . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
|
|---|
| 39 | Q:$D(PRCPFLAG)
|
|---|
| 40 | I '$D(PRCPFLAG) D END^PRCPUREP
|
|---|
| 41 | D ^%ZISC K ^TMP($J,"USAGE") Q
|
|---|
| 42 | ;
|
|---|
| 43 | H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|---|
| 44 | W $C(13),"USAGE DEMAND ANALYSIS FOR: ",PRCP("IN"),?(80-$L(%)),%
|
|---|
| 45 | W !?5,"AVERAGE USAGE FROM ",START," TO ",END," (",MONTHS," MONTHS)"
|
|---|
| 46 | W !?5,"COMPARE USAGE WITH ",COMPARE,?40,"PERCENT ",REPTYPE," AT LEAST: ",PERCENT," %"
|
|---|
| 47 | S %="",$P(%,"-",81)="" W !,"IM#",?10,"DESCRIPTION",?32,$J("COMPARE QTY",16),$J("AVERAGE QTY",16),$J("% "_REPTYPE,16),!,% Q
|
|---|
