114 lines
4.2 KiB
Mathematica
114 lines
4.2 KiB
Mathematica
PRCPRUSP ;WISC/RFJ/VAC-usage demand item report (print report) ; 3/6/07 9:00am
|
|
V ;;5.1;IFCAP;**1,98**;Oct 20, 2000;Build 37
|
|
;Per VHA Directive 2004-038, this routine should not be modified.
|
|
;*98 Modified to accommodate On-Demand Items
|
|
Q
|
|
;
|
|
;
|
|
PRINT ; print report
|
|
D NOW^%DTC S Y=% D DD^%DT S NOW=Y
|
|
S PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
|
|
;
|
|
; whse
|
|
I PRCP("DPTYPE")="W" D
|
|
. S NSN=""
|
|
. F S NSN=$O(^TMP($J,"PRCPRUSE",NSN)) Q:NSN="" D Q:$D(PRCPFLAG)
|
|
. . S DESCR=0
|
|
. . F S DESCR=$O(^TMP($J,"PRCPRUSE",NSN,DESCR)) Q:DESCR']"" D Q:$D(PRCPFLAG)
|
|
. . . S ITEMDA=0
|
|
. . . F S ITEMDA=$O(^TMP($J,"PRCPRUSE",NSN,DESCR,ITEMDA)) Q:'ITEMDA D Q:$D(PRCPFLAG)
|
|
. . . . S DATA=^TMP($J,"PRCPRUSE",NSN,DESCR,ITEMDA)
|
|
. . . . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|
. . . . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
. . . . W !,$TR(NSN,"-"),?15,$E($P(DATA,"^"),1,15)
|
|
. . . . D USAGE
|
|
. . . . Q:$D(PRCPFLAG)
|
|
;
|
|
Q:$D(PRCPFLAG)
|
|
; primary and secondary
|
|
I PRCP("DPTYPE")'="W" D
|
|
. S GROUP=""
|
|
. F S GROUP=$O(^TMP($J,"PRCPRUSE",GROUP)) Q:GROUP="" D Q:$D(PRCPFLAG)
|
|
. . I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
|
|
. . Q:$D(PRCPFLAG)
|
|
. . I $Y>(IOSL-8) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
. . W !!?5,"GROUP: ",$S(GROUP=" ":"<<NONE>>",1:GROUP)
|
|
. . S DESCR=""
|
|
. . F S DESCR=$O(^TMP($J,"PRCPRUSE",GROUP,DESCR)) Q:DESCR="" D Q:$D(PRCPFLAG)
|
|
. . . S ITEMDA=0
|
|
. . . F S ITEMDA=$O(^TMP($J,"PRCPRUSE",GROUP,DESCR,ITEMDA)) Q:'ITEMDA D Q:$D(PRCPFLAG)
|
|
. . . . S DATA=^TMP($J,"PRCPRUSE",GROUP,DESCR,ITEMDA)
|
|
. . . . S ODITEM=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
|
|
. . . . Q:ODITEM="Y"&(ODIFLG=1)
|
|
. . . . Q:ODITEM=""&(ODIFLG=2)
|
|
. . . . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
. . . . W !,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,25)
|
|
. . . . D USAGE
|
|
. . . . Q:$D(PRCPFLAG)
|
|
. . . Q:$D(PRCPFLAG)
|
|
. . Q:$D(PRCPFLAG)
|
|
. Q:$D(PRCPFLAG)
|
|
;
|
|
I '$D(PRCPFLAG) D END^PRCPUREP
|
|
K ^TMP($J,"PRCPRUSE"),^TMP($J,"PRCPURS1")
|
|
D ^%ZISC
|
|
Q
|
|
;
|
|
;
|
|
USAGE ; display usage
|
|
I PRCP("DPTYPE")="W" D
|
|
.W ?31,ITEMDA
|
|
.W ?38,$J($P(DATA,"^",2),8)
|
|
.W $J($P(DATA,"^",3),12,3)
|
|
.W $J($P(DATA,"^",4),12,3)
|
|
.W $J($P(DATA,"^",5),9)
|
|
I PRCP("DPTYPE")'="W" D
|
|
.S ODITEM=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
|
|
.W ?27,ITEMDA
|
|
.I ODITEM="Y" W ?35,"D"
|
|
.W ?38,$J($P(DATA,"^",2),8)
|
|
.W ?47,$J($P(DATA,"^",3),12,3)
|
|
.W $J($P(DATA,"^",4),12,3)
|
|
.W $J($P(DATA,"^",5),9),!
|
|
.I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H W !
|
|
.S REORDER=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
|
|
.W ?4,"NORM: ",$P(REORDER,"^",9)
|
|
.W ?26,"REORD: ",$P(REORDER,"^",10)
|
|
.W ?48,"OPT: ",$P(REORDER,"^",4)
|
|
.W ?67,"EMER: ",$P(REORDER,"^",11)
|
|
.I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
Q:$D(PRCPFLAG)
|
|
S (COLUMN,TOTUSED,TOTCOST,TTOTUSED,TTOTCOST)=0
|
|
S DATE=$E(DATESTRT,1,5)-1
|
|
F S DATE=DATE+1 S:$E(DATE,4,5)=13 DATE=($E(DATE,1,3)+1)_"01" Q:DATE>$E(DATEEND,1,5)!($D(PRCPFLAG)) D
|
|
. I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
|
|
. S DATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE,0))
|
|
. S MONYR=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+$E(DATE,4,5))_$E(DATE,2,3)
|
|
. S TOTUSED=TOTUSED+$P(DATA,"^",2),TOTCOST=TOTCOST+$P(DATA,"^",3)
|
|
. S COLUMN=COLUMN+1
|
|
. W:COLUMN=1 !?4 W:COLUMN=2 ?31 W:COLUMN=3 ?58
|
|
. W MONYR,$J(+$P(DATA,"^",2),7),$J(+$P(DATA,"^",3),10,2)
|
|
. I COLUMN=3 S COLUMN=0
|
|
Q:$D(PRCPFLAG)
|
|
S TTOTUSED=TTOTUSED+TOTUSED,TTOTCOST=TTOTCOST+TOTCOST
|
|
W !?4,"---------------------------------------- CUMULATIVE TOTAL"
|
|
W ?63,$J(TTOTUSED,7),$J(TTOTCOST,10,2),!
|
|
Q
|
|
;
|
|
;
|
|
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
|
|
W $C(13),"USAGE DEMAND ITEM REPORT: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
|
|
S %="",$P(%,"-",81)=""
|
|
W !?5,"USAGE DATE RANGE FROM ",DATESTRD," TO ",DATEENDD," (",TOTALDAY," DAYS)"
|
|
I PRCP("DPTYPE")'="W" D
|
|
.I ODIFLG=1 W !,?5,"STANDARD ITEMS ONLY"
|
|
.I ODIFLG=2 W !,?5,"ON-DEMAND ITEMS ONLY"
|
|
.I ODIFLG=3 W !,?5,"ALL ITEMS (STANDARD AND ON-DEMAND)"
|
|
I PRCP("DPTYPE")="W" W !,"NSN",?15,"DESCRIPTION"
|
|
E W !,"DESCRIPTION"
|
|
I PRCP("DPTYPE")'="W" D
|
|
. W ?27,"IM",?35,"OD",?40,"UNIT/IS",?53,"LAST $",?66,"AVG $",?73,"ON-HAND",!,%
|
|
I PRCP("DPTYPE")="W" D
|
|
. W ?31,"IM",?38,$J("UNIT/IS",8),$J("LAST $",12),$J("AVG $",12),$J("ON-HAND",9),!,%
|
|
Q
|