PRCPRSO1 ;WISC/RFJ/VAC-days of stock on hand report (print) ; 9/20/06 11:15am
;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
;
;*98 Modified to show Standard, ODI or Both
Q
;
;
PRINT ; print report
N %,%H,%I,D,DESCR,GROUP,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTAL,X,Y
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
I PRCP("DPTYPE")="W" D WHSE
I PRCP("DPTYPE")'="W" D PRIMARY
I '$G(PRCPFLAG),$Y>(IOSL-3) D:SCREEN P^PRCPUREP I '$G(PRCPFLAG) D H
I $G(PRCPFLAG) Q
W !!?38,"TOTAL SELLING VALUE IN STOCK: ",$J(TOTAL,12,2)
D END^PRCPUREP
Q
;
;
WHSE ; print whse report
S TOTAL=0,NSN="" F S NSN=$O(^TMP($J,"PRCPRSOH",NSN)) Q:NSN=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRSOH",NSN,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S D=^(ITEMDA) D
. I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
. W !,$TR(NSN,"-"),?15,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,15),?31,ITEMDA,?37,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
. S TOTAL=TOTAL+$P(D,"^",5)
. I $P(D,"^",5)>99999.99 S $P(D,"^",5)=">99999"
. I $P(D,"^",4)>9999 S $P(D,"^",4)=">9999"
. I $P(D,"^",3)>9999 S $P(D,"^",3)=">9999"
. I $P(D,"^",2)>99.99 S $P(D,"^",2)=">99.99"
. I $P(D,"^")>99999 S $P(D,"^")=">99999"
. W ?45,$J($P(D,"^"),7),$J($P(D,"^",2),7),$J($P(D,"^",3),6),$J($P(D,"^",4),6),$J($P(D,"^",5),9)
. I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
Q
;
;
PRIMARY ; print primary or secondary report
S TOTAL=0,GROUP="" F S GROUP=$O(^TMP($J,"PRCPRSOH",GROUP)) Q:GROUP=""!($G(PRCPFLAG)) D
. I $G(ZTQUEUED),$$S^%ZTLOAD S PRCPFLAG=1 W !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>" Q
. I $Y>(IOSL-6) 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,"PRCPRSOH",GROUP,DESCR)) Q:DESCR=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRSOH",GROUP,DESCR,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S D=^(ITEMDA) D
. . W !,$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,30),?31,ITEMDA,?37,$J($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
. . S TOTAL=TOTAL+$P(D,"^",5)
. . I $P(D,"^",5)>99999.99 S $P(D,"^",5)=">99999"
. . I $P(D,"^",4)>9999 S $P(D,"^",4)=">9999"
. . I $P(D,"^",3)>9999 S $P(D,"^",3)=">9999"
. . I $P(D,"^",2)>99.99 S $P(D,"^",2)=">99.99"
. . I $P(D,"^")>99999 S $P(D,"^")=">99999"
. . W ?45,$J($P(D,"^"),7),$J($P(D,"^",2),7),$J($P(D,"^",3),6),$J($P(D,"^",4),6),$J($P(D,"^",5),9)
. . I $Y>(IOSL-4) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
Q
;
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"DAYS OF STOCK ON HAND REPORT: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
S %="",$P(%,"-",81)=""
W !?5,"USAGE DATE RANGE FROM ",DATESTRD," TO ",DATEENDD," (",TOTALDAY," DAYS)"
W !?5,"ITEMS WITH STOCK ON HAND ",$S(PRCPTYPE=1:"LESS",1:"GREATER")," THAN ",PRCPDAYS," DAYS"
I PRCP("DPTYPE")'="W" D
. I ODIFLG=1 W !?5,"REPORT SHOWS STANDARD ITEMS ONLY"
. I ODIFLG=2 W !?5,"REPORT SHOWS ON-DEMAND ITEMS ONLY"
. I ODIFLG=3 W !?5,"REPORT SHOWS BOTH STANDARD AND ON-DEMAND ITEMS"
W !?45,$J("TOTAL",7),$J("DAYS",7),$J("QTY",6),$J("DAYS",6),$J("SELL",9)
I PRCP("DPTYPE")="W" W !,"NSN",?15,"DESCRIPTION"
E W !,"DESCRIPTION"
W ?31,"IM",$J("UNIT/IS",12),?45,$J("USAGE",7),$J("AVG",7),$J("ONHND",6),$J("LEFT",6),$J("VALUE",9),!,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRSO1 3514 printed Apr 09, 2024@21:04:18 Page 2
PRCPRSO1 ;WISC/RFJ/VAC-days of stock on hand report (print) ; 9/20/06 11:15am
+1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;*98 Modified to show Standard, ODI or Both
+5 QUIT
+6 ;
+7 ;
PRINT ; print report
+1 NEW %,%H,%I,D,DESCR,GROUP,ITEMDA,NOW,NSN,PAGE,PRCPFLAG,SCREEN,TOTAL,X,Y
+2 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
USE IO
DO H
+3 IF PRCP("DPTYPE")="W"
DO WHSE
+4 IF PRCP("DPTYPE")'="W"
DO PRIMARY
+5 IF '$GET(PRCPFLAG)
IF $Y>(IOSL-3)
if SCREEN
DO P^PRCPUREP
IF '$GET(PRCPFLAG)
DO H
+6 IF $GET(PRCPFLAG)
QUIT
+7 WRITE !!?38,"TOTAL SELLING VALUE IN STOCK: ",$JUSTIFY(TOTAL,12,2)
+8 DO END^PRCPUREP
+9 QUIT
+10 ;
+11 ;
WHSE ; print whse report
+1 SET TOTAL=0
SET NSN=""
FOR
SET NSN=$ORDER(^TMP($JOB,"PRCPRSOH",NSN))
if NSN=""!($GET(PRCPFLAG))
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRSOH",NSN,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
SET D=^(ITEMDA)
Begin DoDot:1
+2 IF $GET(ZTQUEUED)
IF $$S^%ZTLOAD
SET PRCPFLAG=1
WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
QUIT
+3 WRITE !,$TRANSLATE(NSN,"-"),?15,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,15),?31,ITEMDA,?37,$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
+4 SET TOTAL=TOTAL+$PIECE(D,"^",5)
+5 IF $PIECE(D,"^",5)>99999.99
SET $PIECE(D,"^",5)=">99999"
+6 IF $PIECE(D,"^",4)>9999
SET $PIECE(D,"^",4)=">9999"
+7 IF $PIECE(D,"^",3)>9999
SET $PIECE(D,"^",3)=">9999"
+8 IF $PIECE(D,"^",2)>99.99
SET $PIECE(D,"^",2)=">99.99"
+9 IF $PIECE(D,"^")>99999
SET $PIECE(D,"^")=">99999"
+10 WRITE ?45,$JUSTIFY($PIECE(D,"^"),7),$JUSTIFY($PIECE(D,"^",2),7),$JUSTIFY($PIECE(D,"^",3),6),$JUSTIFY($PIECE(D,"^",4),6),$JUSTIFY($PIECE(D,"^",5),9)
+11 IF $Y>(IOSL-4)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
End DoDot:1
+12 QUIT
+13 ;
+14 ;
PRIMARY ; print primary or secondary report
+1 SET TOTAL=0
SET GROUP=""
FOR
SET GROUP=$ORDER(^TMP($JOB,"PRCPRSOH",GROUP))
if GROUP=""!($GET(PRCPFLAG))
QUIT
Begin DoDot:1
+2 IF $GET(ZTQUEUED)
IF $$S^%ZTLOAD
SET PRCPFLAG=1
WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
QUIT
+3 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+4 WRITE !!?5,"GROUP: ",$SELECT(GROUP=" ":"<<NONE>>",1:GROUP)
+5 SET DESCR=""
FOR
SET DESCR=$ORDER(^TMP($JOB,"PRCPRSOH",GROUP,DESCR))
if DESCR=""!($GET(PRCPFLAG))
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRSOH",GROUP,DESCR,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
SET D=^(ITEMDA)
Begin DoDot:2
+6 WRITE !,$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,30),?31,ITEMDA,?37,$JUSTIFY($$UNIT^PRCPUX1(PRCP("I"),ITEMDA,"/"),8)
+7 SET TOTAL=TOTAL+$PIECE(D,"^",5)
+8 IF $PIECE(D,"^",5)>99999.99
SET $PIECE(D,"^",5)=">99999"
+9 IF $PIECE(D,"^",4)>9999
SET $PIECE(D,"^",4)=">9999"
+10 IF $PIECE(D,"^",3)>9999
SET $PIECE(D,"^",3)=">9999"
+11 IF $PIECE(D,"^",2)>99.99
SET $PIECE(D,"^",2)=">99.99"
+12 IF $PIECE(D,"^")>99999
SET $PIECE(D,"^")=">99999"
+13 WRITE ?45,$JUSTIFY($PIECE(D,"^"),7),$JUSTIFY($PIECE(D,"^",2),7),$JUSTIFY($PIECE(D,"^",3),6),$JUSTIFY($PIECE(D,"^",4),6),$JUSTIFY($PIECE(D,"^",5),9)
+14 IF $Y>(IOSL-4)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
+17 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"DAYS OF STOCK ON HAND REPORT: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
+2 SET %=""
SET $PIECE(%,"-",81)=""
+3 WRITE !?5,"USAGE DATE RANGE FROM ",DATESTRD," TO ",DATEENDD," (",TOTALDAY," DAYS)"
+4 WRITE !?5,"ITEMS WITH STOCK ON HAND ",$SELECT(PRCPTYPE=1:"LESS",1:"GREATER")," THAN ",PRCPDAYS," DAYS"
+5 IF PRCP("DPTYPE")'="W"
Begin DoDot:1
+6 IF ODIFLG=1
WRITE !?5,"REPORT SHOWS STANDARD ITEMS ONLY"
+7 IF ODIFLG=2
WRITE !?5,"REPORT SHOWS ON-DEMAND ITEMS ONLY"
+8 IF ODIFLG=3
WRITE !?5,"REPORT SHOWS BOTH STANDARD AND ON-DEMAND ITEMS"
End DoDot:1
+9 WRITE !?45,$JUSTIFY("TOTAL",7),$JUSTIFY("DAYS",7),$JUSTIFY("QTY",6),$JUSTIFY("DAYS",6),$JUSTIFY("SELL",9)
+10 IF PRCP("DPTYPE")="W"
WRITE !,"NSN",?15,"DESCRIPTION"
+11 IF '$TEST
WRITE !,"DESCRIPTION"
+12 WRITE ?31,"IM",$JUSTIFY("UNIT/IS",12),?45,$JUSTIFY("USAGE",7),$JUSTIFY("AVG",7),$JUSTIFY("ONHND",6),$JUSTIFY("LEFT",6),$JUSTIFY("VALUE",9),!,%
+13 QUIT
