PRCPRAL1 ;WISC/RFJ/DST-automatic level setter (print report) ;28 Dec 93
;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
PRINT ; print report
N %,AVERAGE,DATE,DESCR,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,PRCPFNOT,PRCPNESL,PRCPNNSL,PRCPNORP,PRCPNSRP,PRCPSTDD,SCREEN,SORT,TOTAL,Y
N ODI ; On-Demand Item flag
K ^TMP($J,"PRCPRALS")
S ITEMDA=0 F S ITEMDA=$O(^PRCP(445,PRCP("I"),1,ITEMDA)) Q:'ITEMDA D
. I $G(PRCPFITM),'$D(^TMP($J,"PRCPURS4",ITEMDA)),'$G(PRCPALLI) Q
. S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
. S GROUP=+$P(ITEMDATA,"^",21)
. S PRCPFLAG=0
. I '$G(PRCPFITM) D Q:PRCPFLAG
. . I 'GROUP,'$G(GROUPALL) S PRCPFLAG=1 Q
. . I $G(GROUPALL),$D(^TMP($J,"PRCPURS1","NO",GROUP)) S PRCPFLAG=1 Q
. . I '$G(GROUPALL),'$D(^TMP($J,"PRCPURS1","YES",GROUP)) S PRCPFLAG=1 Q
. S GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
. I GROUPNM'="" S GROUPNM=$E(GROUPNM,1,20)_" (#"_GROUP_")"
. S:GROUPNM="" GROUPNM=" "
. S SORT=$S(PRCP("DPTYPE")="W":$$NSN^PRCPUX1(ITEMDA),1:$E($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,15)) S:SORT="" SORT=" "
. ; calc daily usage
. S DATE=PRCPSTDT-1,TOTAL=0 F S DATE=$O(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE)) Q:'DATE S TOTAL=TOTAL+$P($G(^(DATE,0)),"^",2)
. S AVERAGE=$J(TOTAL/PRCPTDAY,0,5)
. S ^TMP($J,"PRCPRALS",GROUPNM,SORT,ITEMDA)=AVERAGE
; print report
K PRCPFLAG
S Y=PRCPSTDT_"00" D DD^%DT S PRCPSTDD=Y
D NOW^%DTC S Y=% D DD^%DT S NOW=Y,PAGE=1,SCREEN=$$SCRPAUSE^PRCPUREP U IO D H
S GROUP="" F S GROUP=$O(^TMP($J,"PRCPRALS",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 SORT="" F S SORT=$O(^TMP($J,"PRCPRALS",GROUP,SORT)) Q:SORT=""!($G(PRCPFLAG)) S ITEMDA=0 F S ITEMDA=$O(^TMP($J,"PRCPRALS",GROUP,SORT,ITEMDA)) Q:'ITEMDA!($G(PRCPFLAG)) S AVERAGE=^(ITEMDA) D
. . I $Y>(IOSL-6) D:SCREEN P^PRCPUREP Q:$D(PRCPFLAG) D H
. . S ITEMDATA=$G(^PRCP(445,PRCP("I"),1,ITEMDA,0))
. . S DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA),NSN=$$NSN^PRCPUX1(ITEMDA)
. . I PRCP("DPTYPE")="W" W !!,NSN,?18,$E(DESCR,1,18)
. . ; On-Demand Item display
. . S ODI=""
. . I PRCP("DPTYPE")'="W" S ODI=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
. . Q:PRCP("DPTYPE")'="W"&((($G(ODIS)=1)&(ODI="Y"))!(($G(ODIS)=2)&(ODI'="Y")))
. . I PRCP("DPTYPE")'="W" W !!,$E(DESCR,1,18),?25,$S(ODI="Y":"D",1:"")
. . ;
. . W ?38,ITEMDA,?45,"OLD",$J(+$P(ITEMDATA,"^",9),8),$J(+$P(ITEMDATA,"^",11),8),$J(+$P(ITEMDATA,"^",10),8),$J(+$P(ITEMDATA,"^",4),8)
. . I AVERAGE>.06,$G(PRCPFSET) K PRCPFNOT L +^PRCP(445,PRCP("I"),1,ITEMDA,0):5 I '$T S PRCPFNOT=1
. . W !?3,"AVG USAGE: ",$J(AVERAGE,0,4)
. . W ?22,$J($S('$G(PRCPFSET):"ESTIMATED VALUES",AVERAGE'>.06:"LOW USAGE (NOT UPDATED)",$G(PRCPFNOT):"UNABLE TO UPDATE (LOCKED)",1:"NEW VALUES"),26),?48
. . ; normal stock level
. . S PRCPNNSL=AVERAGE*PRCPDNSL\1 S:PRCPNNSL>999999 PRCPNNSL=999999 W $J(PRCPNNSL,8)
. . ; emergency stock level
. . S PRCPNESL=$J(PRCPNNSL*PRCPPESL/100,0,0) S:PRCPNESL>999999 PRCPNESL=999999 W $J(PRCPNESL,8)
. . ; standard reorder point
. . S PRCPNSRP=$J(PRCPNNSL*PRCPPSRP/100,0,0) S:PRCPNSRP>999999 PRCPPSRP=999999 W $J(PRCPNSRP,8)
. . ; optional reorder point
. . S PRCPNORP=$J(PRCPNNSL*PRCPPORP/100,0,0) S:PRCPNORP>999999 PRCPNORP=999999 W $J(PRCPNORP,8)
. . I AVERAGE>.06,$G(PRCPFSET),'$G(PRCPFNOT) S $P(^PRCP(445,PRCP("I"),1,ITEMDA,0),"^",4)=PRCPNORP,$P(^(0),"^",9,11)=PRCPNNSL_"^"_PRCPNSRP_"^"_PRCPNESL L -^PRCP(445,PRCP("I"),1,ITEMDA,0)
I '$G(PRCPFLAG) D END^PRCPUREP
Q
;
;
H S %=NOW_" PAGE "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"AUTOMATIC LEVEL SETTER FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
I PRCP("DPTYPE")'="W",('$D(^TMP($J,"PRCPURS4"))) W !?5,$S(ODIS=2:"ON-DEMAND ITEMS ONLY",ODIS=3:"ALL ITEMS (STANDARD AND ON-DEMAND)",1:"STANDARD ITEMS ONLY")
W !?5,"AVG USAGE START DATE: ",PRCPSTDD," (",PRCPTDAY," TOTAL DAYS)"
W !?5,"DAYS/PERCENTAGE USED FOR CALCULATION:",?48,$J(PRCPDNSL,8),$J(PRCPPESL_"%",8),$J(PRCPPSRP_"%",8),$J(PRCPPORP_"%",8)
S %="",$P(%,"-",81)=""
W !?48,$J("NORMAL",8),$J("EMERG",8),$J("STAND",8),$J("OPTION",8),!
I PRCP("DPTYPE")="W" W "NSN",?18,"DESCRIPTION"
E W "DESCRIPTION",?25,"OD"
W ?38,"IM#",?48,$J("STKLVL",8),$J("STKLVL",8),$J("REO PT",8),$J("REO PT",8),!,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRAL1 4614 printed Apr 09, 2024@21:15 Page 2
PRCPRAL1 ;WISC/RFJ/DST-automatic level setter (print report) ;28 Dec 93
+1 ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
PRINT ; print report
+1 NEW %,AVERAGE,DATE,DESCR,GROUP,GROUPNM,ITEMDA,ITEMDATA,NOW,NSN,PAGE,PRCPFLAG,PRCPFNOT,PRCPNESL,PRCPNNSL,PRCPNORP,PRCPNSRP,PRCPSTDD,SCREEN,SORT,TOTAL,Y
+2 ; On-Demand Item flag
NEW ODI
+3 KILL ^TMP($JOB,"PRCPRALS")
+4 SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA))
if 'ITEMDA
QUIT
Begin DoDot:1
+5 IF $GET(PRCPFITM)
IF '$DATA(^TMP($JOB,"PRCPURS4",ITEMDA))
IF '$GET(PRCPALLI)
QUIT
+6 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
+7 SET GROUP=+$PIECE(ITEMDATA,"^",21)
+8 SET PRCPFLAG=0
+9 IF '$GET(PRCPFITM)
Begin DoDot:2
+10 IF 'GROUP
IF '$GET(GROUPALL)
SET PRCPFLAG=1
QUIT
+11 IF $GET(GROUPALL)
IF $DATA(^TMP($JOB,"PRCPURS1","NO",GROUP))
SET PRCPFLAG=1
QUIT
+12 IF '$GET(GROUPALL)
IF '$DATA(^TMP($JOB,"PRCPURS1","YES",GROUP))
SET PRCPFLAG=1
QUIT
End DoDot:2
if PRCPFLAG
QUIT
+13 SET GROUPNM=$$GROUPNM^PRCPEGRP(GROUP)
+14 IF GROUPNM'=""
SET GROUPNM=$EXTRACT(GROUPNM,1,20)_" (#"_GROUP_")"
+15 if GROUPNM=""
SET GROUPNM=" "
+16 SET SORT=$SELECT(PRCP("DPTYPE")="W":$$NSN^PRCPUX1(ITEMDA),1:$EXTRACT($$DESCR^PRCPUX1(PRCP("I"),ITEMDA),1,15))
if SORT=""
SET SORT=" "
+17 ; calc daily usage
+18 SET DATE=PRCPSTDT-1
SET TOTAL=0
FOR
SET DATE=$ORDER(^PRCP(445,PRCP("I"),1,ITEMDA,2,DATE))
if 'DATE
QUIT
SET TOTAL=TOTAL+$PIECE($GET(^(DATE,0)),"^",2)
+19 SET AVERAGE=$JUSTIFY(TOTAL/PRCPTDAY,0,5)
+20 SET ^TMP($JOB,"PRCPRALS",GROUPNM,SORT,ITEMDA)=AVERAGE
End DoDot:1
+21 ; print report
+22 KILL PRCPFLAG
+23 SET Y=PRCPSTDT_"00"
DO DD^%DT
SET PRCPSTDD=Y
+24 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
SET PAGE=1
SET SCREEN=$$SCRPAUSE^PRCPUREP
USE IO
DO H
+25 SET GROUP=""
FOR
SET GROUP=$ORDER(^TMP($JOB,"PRCPRALS",GROUP))
if GROUP=""!($GET(PRCPFLAG))
QUIT
Begin DoDot:1
+26 IF $GET(ZTQUEUED)
IF $$S^%ZTLOAD
SET PRCPFLAG=1
WRITE !?10,"<<< TASKMANAGER JOB TERMINATED BY USER >>>"
QUIT
+27 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+28 WRITE !!?5,"GROUP: ",$SELECT(GROUP=" ":"<<NONE>>",1:GROUP)
+29 SET SORT=""
FOR
SET SORT=$ORDER(^TMP($JOB,"PRCPRALS",GROUP,SORT))
if SORT=""!($GET(PRCPFLAG))
QUIT
SET ITEMDA=0
FOR
SET ITEMDA=$ORDER(^TMP($JOB,"PRCPRALS",GROUP,SORT,ITEMDA))
if 'ITEMDA!($GET(PRCPFLAG))
QUIT
SET AVERAGE=^(ITEMDA)
Begin DoDot:2
+30 IF $Y>(IOSL-6)
if SCREEN
DO P^PRCPUREP
if $DATA(PRCPFLAG)
QUIT
DO H
+31 SET ITEMDATA=$GET(^PRCP(445,PRCP("I"),1,ITEMDA,0))
+32 SET DESCR=$$DESCR^PRCPUX1(PRCP("I"),ITEMDA)
SET NSN=$$NSN^PRCPUX1(ITEMDA)
+33 IF PRCP("DPTYPE")="W"
WRITE !!,NSN,?18,$EXTRACT(DESCR,1,18)
+34 ; On-Demand Item display
+35 SET ODI=""
+36 IF PRCP("DPTYPE")'="W"
SET ODI=$$ODITEM^PRCPUX2(PRCP("I"),ITEMDA)
+37 if PRCP("DPTYPE")'="W"&((($GET(ODIS)=1)&(ODI="Y"))!(($GET(ODIS)=2)&(ODI'="Y")))
QUIT
+38 IF PRCP("DPTYPE")'="W"
WRITE !!,$EXTRACT(DESCR,1,18),?25,$SELECT(ODI="Y":"D",1:"")
+39 ;
+40 WRITE ?38,ITEMDA,?45,"OLD",$JUSTIFY(+$PIECE(ITEMDATA,"^",9),8),$JUSTIFY(+$PIECE(ITEMDATA,"^",11),8),$JUSTIFY(+$PIECE(ITEMDATA,"^",10),8),$JUSTIFY(+$PIECE(ITEMDATA,"^",4),8)
+41 IF AVERAGE>.06
IF $GET(PRCPFSET)
KILL PRCPFNOT
LOCK +^PRCP(445,PRCP("I"),1,ITEMDA,0):5
IF '$TEST
SET PRCPFNOT=1
+42 WRITE !?3,"AVG USAGE: ",$JUSTIFY(AVERAGE,0,4)
+43 WRITE ?22,$JUSTIFY($SELECT('$GET(PRCPFSET):"ESTIMATED VALUES",AVERAGE'>.06:"LOW USAGE (NOT UPDATED)",$GET(PRCPFNOT):"UNABLE TO UPDATE (LOCKED)",1:"NEW VALUES"),26),?48
+44 ; normal stock level
+45 SET PRCPNNSL=AVERAGE*PRCPDNSL\1
if PRCPNNSL>999999
SET PRCPNNSL=999999
WRITE $JUSTIFY(PRCPNNSL,8)
+46 ; emergency stock level
+47 SET PRCPNESL=$JUSTIFY(PRCPNNSL*PRCPPESL/100,0,0)
if PRCPNESL>999999
SET PRCPNESL=999999
WRITE $JUSTIFY(PRCPNESL,8)
+48 ; standard reorder point
+49 SET PRCPNSRP=$JUSTIFY(PRCPNNSL*PRCPPSRP/100,0,0)
if PRCPNSRP>999999
SET PRCPPSRP=999999
WRITE $JUSTIFY(PRCPNSRP,8)
+50 ; optional reorder point
+51 SET PRCPNORP=$JUSTIFY(PRCPNNSL*PRCPPORP/100,0,0)
if PRCPNORP>999999
SET PRCPNORP=999999
WRITE $JUSTIFY(PRCPNORP,8)
+52 IF AVERAGE>.06
IF $GET(PRCPFSET)
IF '$GET(PRCPFNOT)
SET $PIECE(^PRCP(445,PRCP("I"),1,ITEMDA,0),"^",4)=PRCPNORP
SET $PIECE(^(0),"^",9,11)=PRCPNNSL_"^"_PRCPNSRP_"^"_PRCPNESL
LOCK -^PRCP(445,PRCP("I"),1,ITEMDA,0)
End DoDot:2
End DoDot:1
+53 IF '$GET(PRCPFLAG)
DO END^PRCPUREP
+54 QUIT
+55 ;
+56 ;
H SET %=NOW_" PAGE "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+1 WRITE $CHAR(13),"AUTOMATIC LEVEL SETTER FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
+2 IF PRCP("DPTYPE")'="W"
IF ('$DATA(^TMP($JOB,"PRCPURS4")))
WRITE !?5,$SELECT(ODIS=2:"ON-DEMAND ITEMS ONLY",ODIS=3:"ALL ITEMS (STANDARD AND ON-DEMAND)",1:"STANDARD ITEMS ONLY")
+3 WRITE !?5,"AVG USAGE START DATE: ",PRCPSTDD," (",PRCPTDAY," TOTAL DAYS)"
+4 WRITE !?5,"DAYS/PERCENTAGE USED FOR CALCULATION:",?48,$JUSTIFY(PRCPDNSL,8),$JUSTIFY(PRCPPESL_"%",8),$JUSTIFY(PRCPPSRP_"%",8),$JUSTIFY(PRCPPORP_"%",8)
+5 SET %=""
SET $PIECE(%,"-",81)=""
+6 WRITE !?48,$JUSTIFY("NORMAL",8),$JUSTIFY("EMERG",8),$JUSTIFY("STAND",8),$JUSTIFY("OPTION",8),!
+7 IF PRCP("DPTYPE")="W"
WRITE "NSN",?18,"DESCRIPTION"
+8 IF '$TEST
WRITE "DESCRIPTION",?25,"OD"
+9 WRITE ?38,"IM#",?48,$JUSTIFY("STKLVL",8),$JUSTIFY("STKLVL",8),$JUSTIFY("REO PT",8),$JUSTIFY("REO PT",8),!,%
+10 QUIT
