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