PRCPRSS0 ;WISC/RFJ/DL/DAP-stock status report print for warehouse;1/28/98
V ;;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 DAYS,MONTH,NOW,PAGE,PRCPFLAG,SCREEN,TOTCLOS,TOTISS,TOTN,TOTOPEN,TOTVAL
S Y=DATESTRT D DD^%DT S MONTH=Y
S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(DATESTRT,4,5))
I DAYS=28 S %=(17+$E(DATESTRT))_$E(DATESTRT,2,3),DAYS=$S(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28)
S SCREEN=$$SCRPAUSE^PRCPUREP,PAGE=1 D NOW^%DTC S Y=% D DD^%DT S NOW=Y U IO D H
W !!,"OPEN BALANCE",?14 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(OPEN(ACCT)),"^",2),OPEN(ACCT)=%,TOTOPEN=TOTOPEN+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTOPEN)
W !!,"RECEIPTS",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(REC(ACCT)),TOTAL=TOTAL+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTAL)
;
;*98 Changed previous displays of "issues" to "usage"
;
W !,"USAGE",?14 S TOTISS=0 F ACCT=1,2,3,6,8 S %=$G(ISS(ACCT)),TOTISS=TOTISS+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTISS)
W !,"ADJUSTMENTS",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(ADJ(ACCT)),TOTAL=TOTAL+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTAL)
S %="",$P(%,"=",80)=""
W !,%,!,"CLOSE BALANCE",?14 S TOTCLOS=0 F ACCT=1,2,3,6,8 S %=$G(OPEN(ACCT)),TOTCLOS=TOTCLOS+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTCLOS)
W !!!,"# RECEIPTS",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(RECN(ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=% W $J(%,11,0)
W $J(TOTAL,11,0)
;
;*98 Changed previous displays of "issues" to "usage"
;
W !,"# USAGE",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(ISSN(ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=$G(TOTN(ACCT))+% W $J(%,11,0)
W $J(TOTAL,11,0)
W !,"# ADJUSTMENTS",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(ADJN(ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=$G(TOTN(ACCT))+% W $J(%,11,0)
W $J(TOTAL,11,0)
S %="",$P(%,"=",80)=""
W !,%,!,"# TOTAL",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(TOTN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
W $J(TOTAL,11,0)
W !!,"TURNOVER",?13 F ACCT=1,2,3,6,8 S %=($G(ISS(ACCT))*365)/DAYS,%=$S('$G(OPEN(ACCT)):"X",1:-%/OPEN(ACCT)) W $J(%,11,2)
S %=(TOTISS*365)/DAYS,%=$S('TOTCLOS:"X",1:-%/TOTCLOS) W $J(%,11,2)
I $Y>(IOSL-10) W ! D:SCREEN P^PRCPUREP G:$G(PRCPFLAG) Q D H
W !!?28,"*** CURRENT DATA ***",!,"$ ONHAND VALUE",?14 S TOTVAL=0 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),TOTVAL=TOTVAL+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTVAL)
W !,"$ DUEINS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(DUEIN(ACCT)),X=X+% W $$SHOWVALU(%)
W $$SHOWVALU(X)
W !,"$ DUEOUTS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(DUEOUT(ACCT)),X=X+% W $$SHOWVALU(%)
W $$SHOWVALU(X)
S Y=$E(DATEINAC,1,5)_"01" D DD^%DT
W !!?2,"INACTIVE ITEMS FROM ",Y," TO ",$P(NOW,"@"),!,"# INACTIVE",?13
S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(INACTN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
W $J(TOTAL,11,0)
W !,"$ INACTIVE",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(INACT(ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTAL)
W !,"% INACTIVE",?13 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),%=$S('%:0,1:$G(INACT(ACCT))/%) W $J(%,11,2)
S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
S Y=$E(DATELONG,1,5)_"01" D DD^%DT
;
;*98 Showed correct range of 90 days for long supply on report section
;
W !!?2,"LONG SUPPLY ITEMS AVERAGE FROM ",Y," TO ",$P(NOW,"@")," (>90 DAYS)",!,"# LONG SUPPLY",?13
S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(LONGN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
W $J(TOTAL,11,0)
W !,"$ LONG SUPPLY",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(LONG(ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTAL)
W !,"% LONG SUPPLY",?13 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),%=$S('%:0,1:$G(LONG(ACCT))/%) W $J(%,11,2)
S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
I $Y>(IOSL-7) W ! D:SCREEN P^PRCPUREP G:$G(PRCPFLAG) Q D H
W !!?2,"NONISSUABLE ITEMS ON ",$P(NOW,"@"),!,"# NONISSUABLE",?13
S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(NONISSN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
W $J(TOTAL,11,0)
W !,"$ NONISSUABLE",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(NONISS(ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
W $$SHOWVALU(TOTAL)
W !,"% NONISSUABLE",?13 F ACCT=1,2,3,6,8 S %=$G(VALUE(ACCT)),%=$S('%:0,1:$G(NONISS(ACCT))/%) W $J(%,11,2)
S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
D END^PRCPUREP
Q D ^%ZISC Q
;
;
SHOWVALU(V1) ;show value
N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
Q $J(V1,10,2)_%
;
;
H ;heading
S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
W $C(13),"STOCK STATUS REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
W !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH
W !,"SUMMARY",?14,$J("ACCT 1",11),$J("ACCT 2",11),$J("ACCT 3",11),$J("ACCT 6",11),$J("ACCT 8",11),$J("TOTAL",11)
S %="",$P(%,"-",81)="" W !,%
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCPRSS0 4728 printed Dec 13, 2024@02:15:31 Page 2
V ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
+1 ;Per VHA Directive 2004-038, this routine should not be modified.
+2 QUIT
+3 ;
+4 ;
PRINT ; print report
+1 NEW DAYS,MONTH,NOW,PAGE,PRCPFLAG,SCREEN,TOTCLOS,TOTISS,TOTN,TOTOPEN,TOTVAL
+2 SET Y=DATESTRT
DO DD^%DT
SET MONTH=Y
+3 SET DAYS=$PIECE("31^28^31^30^31^30^31^31^30^31^30^31","^",+$EXTRACT(DATESTRT,4,5))
+4 IF DAYS=28
SET %=(17+$EXTRACT(DATESTRT))_$EXTRACT(DATESTRT,2,3)
SET DAYS=$SELECT(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28)
+5 SET SCREEN=$$SCRPAUSE^PRCPUREP
SET PAGE=1
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET NOW=Y
USE IO
DO H
+6 WRITE !!,"OPEN BALANCE",?14
SET TOTOPEN=0
FOR ACCT=1,2,3,6,8
SET %=$PIECE($GET(OPEN(ACCT)),"^",2)
SET OPEN(ACCT)=%
SET TOTOPEN=TOTOPEN+%
WRITE $$SHOWVALU(%)
+7 WRITE $$SHOWVALU(TOTOPEN)
+8 WRITE !!,"RECEIPTS",?14
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(REC(ACCT))
SET TOTAL=TOTAL+%
SET OPEN(ACCT)=$GET(OPEN(ACCT))+%
WRITE $$SHOWVALU(%)
+9 WRITE $$SHOWVALU(TOTAL)
+10 ;
+11 ;*98 Changed previous displays of "issues" to "usage"
+12 ;
+13 WRITE !,"USAGE",?14
SET TOTISS=0
FOR ACCT=1,2,3,6,8
SET %=$GET(ISS(ACCT))
SET TOTISS=TOTISS+%
SET OPEN(ACCT)=$GET(OPEN(ACCT))+%
WRITE $$SHOWVALU(%)
+14 WRITE $$SHOWVALU(TOTISS)
+15 WRITE !,"ADJUSTMENTS",?14
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(ADJ(ACCT))
SET TOTAL=TOTAL+%
SET OPEN(ACCT)=$GET(OPEN(ACCT))+%
WRITE $$SHOWVALU(%)
+16 WRITE $$SHOWVALU(TOTAL)
+17 SET %=""
SET $PIECE(%,"=",80)=""
+18 WRITE !,%,!,"CLOSE BALANCE",?14
SET TOTCLOS=0
FOR ACCT=1,2,3,6,8
SET %=$GET(OPEN(ACCT))
SET TOTCLOS=TOTCLOS+%
WRITE $$SHOWVALU(%)
+19 WRITE $$SHOWVALU(TOTCLOS)
+20 WRITE !!!,"# RECEIPTS",?13
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(RECN(ACCT))
SET TOTAL=TOTAL+%
SET TOTN(ACCT)=%
WRITE $JUSTIFY(%,11,0)
+21 WRITE $JUSTIFY(TOTAL,11,0)
+22 ;
+23 ;*98 Changed previous displays of "issues" to "usage"
+24 ;
+25 WRITE !,"# USAGE",?13
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(ISSN(ACCT))
SET TOTAL=TOTAL+%
SET TOTN(ACCT)=$GET(TOTN(ACCT))+%
WRITE $JUSTIFY(%,11,0)
+26 WRITE $JUSTIFY(TOTAL,11,0)
+27 WRITE !,"# ADJUSTMENTS",?13
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(ADJN(ACCT))
SET TOTAL=TOTAL+%
SET TOTN(ACCT)=$GET(TOTN(ACCT))+%
WRITE $JUSTIFY(%,11,0)
+28 WRITE $JUSTIFY(TOTAL,11,0)
+29 SET %=""
SET $PIECE(%,"=",80)=""
+30 WRITE !,%,!,"# TOTAL",?13
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(TOTN(ACCT))
SET TOTAL=TOTAL+%
WRITE $JUSTIFY(%,11,0)
+31 WRITE $JUSTIFY(TOTAL,11,0)
+32 WRITE !!,"TURNOVER",?13
FOR ACCT=1,2,3,6,8
SET %=($GET(ISS(ACCT))*365)/DAYS
SET %=$SELECT('$GET(OPEN(ACCT)):"X",1:-%/OPEN(ACCT))
WRITE $JUSTIFY(%,11,2)
+33 SET %=(TOTISS*365)/DAYS
SET %=$SELECT('TOTCLOS:"X",1:-%/TOTCLOS)
WRITE $JUSTIFY(%,11,2)
+34 IF $Y>(IOSL-10)
WRITE !
if SCREEN
DO P^PRCPUREP
if $GET(PRCPFLAG)
GOTO Q
DO H
+35 WRITE !!?28,"*** CURRENT DATA ***",!,"$ ONHAND VALUE",?14
SET TOTVAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(VALUE(ACCT))
SET TOTVAL=TOTVAL+%
WRITE $$SHOWVALU(%)
+36 WRITE $$SHOWVALU(TOTVAL)
+37 WRITE !,"$ DUEINS",?14
SET X=0
FOR ACCT=1,2,3,6,8
SET %=$GET(DUEIN(ACCT))
SET X=X+%
WRITE $$SHOWVALU(%)
+38 WRITE $$SHOWVALU(X)
+39 WRITE !,"$ DUEOUTS",?14
SET X=0
FOR ACCT=1,2,3,6,8
SET %=$GET(DUEOUT(ACCT))
SET X=X+%
WRITE $$SHOWVALU(%)
+40 WRITE $$SHOWVALU(X)
+41 SET Y=$EXTRACT(DATEINAC,1,5)_"01"
DO DD^%DT
+42 WRITE !!?2,"INACTIVE ITEMS FROM ",Y," TO ",$PIECE(NOW,"@"),!,"# INACTIVE",?13
+43 SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(INACTN(ACCT))
SET TOTAL=TOTAL+%
WRITE $JUSTIFY(%,11,0)
+44 WRITE $JUSTIFY(TOTAL,11,0)
+45 WRITE !,"$ INACTIVE",?14
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(INACT(ACCT))
SET TOTAL=TOTAL+%
WRITE $$SHOWVALU(%)
+46 WRITE $$SHOWVALU(TOTAL)
+47 WRITE !,"% INACTIVE",?13
FOR ACCT=1,2,3,6,8
SET %=$GET(VALUE(ACCT))
SET %=$SELECT('%:0,1:$GET(INACT(ACCT))/%)
WRITE $JUSTIFY(%,11,2)
+48 SET %=$SELECT('TOTVAL:0,1:TOTAL/TOTVAL)
WRITE $JUSTIFY(%,11,2)
+49 SET Y=$EXTRACT(DATELONG,1,5)_"01"
DO DD^%DT
+50 ;
+51 ;*98 Showed correct range of 90 days for long supply on report section
+52 ;
+53 WRITE !!?2,"LONG SUPPLY ITEMS AVERAGE FROM ",Y," TO ",$PIECE(NOW,"@")," (>90 DAYS)",!,"# LONG SUPPLY",?13
+54 SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(LONGN(ACCT))
SET TOTAL=TOTAL+%
WRITE $JUSTIFY(%,11,0)
+55 WRITE $JUSTIFY(TOTAL,11,0)
+56 WRITE !,"$ LONG SUPPLY",?14
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(LONG(ACCT))
SET TOTAL=TOTAL+%
WRITE $$SHOWVALU(%)
+57 WRITE $$SHOWVALU(TOTAL)
+58 WRITE !,"% LONG SUPPLY",?13
FOR ACCT=1,2,3,6,8
SET %=$GET(VALUE(ACCT))
SET %=$SELECT('%:0,1:$GET(LONG(ACCT))/%)
WRITE $JUSTIFY(%,11,2)
+59 SET %=$SELECT('TOTVAL:0,1:TOTAL/TOTVAL)
WRITE $JUSTIFY(%,11,2)
+60 IF $Y>(IOSL-7)
WRITE !
if SCREEN
DO P^PRCPUREP
if $GET(PRCPFLAG)
GOTO Q
DO H
+61 WRITE !!?2,"NONISSUABLE ITEMS ON ",$PIECE(NOW,"@"),!,"# NONISSUABLE",?13
+62 SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(NONISSN(ACCT))
SET TOTAL=TOTAL+%
WRITE $JUSTIFY(%,11,0)
+63 WRITE $JUSTIFY(TOTAL,11,0)
+64 WRITE !,"$ NONISSUABLE",?14
SET TOTAL=0
FOR ACCT=1,2,3,6,8
SET %=$GET(NONISS(ACCT))
SET TOTAL=TOTAL+%
WRITE $$SHOWVALU(%)
+65 WRITE $$SHOWVALU(TOTAL)
+66 WRITE !,"% NONISSUABLE",?13
FOR ACCT=1,2,3,6,8
SET %=$GET(VALUE(ACCT))
SET %=$SELECT('%:0,1:$GET(NONISS(ACCT))/%)
WRITE $JUSTIFY(%,11,2)
+67 SET %=$SELECT('TOTVAL:0,1:TOTAL/TOTVAL)
WRITE $JUSTIFY(%,11,2)
+68 DO END^PRCPUREP
Q DO ^%ZISC
QUIT
+1 ;
+2 ;
SHOWVALU(V1) ;show value
+1 NEW %
SET %="+"
if +V1=0
SET %=" "
IF V1<0
SET V1=-V1
SET %="-"
+2 QUIT $JUSTIFY(V1,10,2)_%
+3 ;
+4 ;
H ;heading
+1 SET %=NOW_" PAGE: "_PAGE
SET PAGE=PAGE+1
IF PAGE'=2!(SCREEN)
WRITE @IOF
+2 WRITE $CHAR(13),"STOCK STATUS REPORT FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
+3 WRITE !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH
+4 WRITE !,"SUMMARY",?14,$JUSTIFY("ACCT 1",11),$JUSTIFY("ACCT 2",11),$JUSTIFY("ACCT 3",11),$JUSTIFY("ACCT 6",11),$JUSTIFY("ACCT 8",11),$JUSTIFY("TOTAL",11)
+5 SET %=""
SET $PIECE(%,"-",81)=""
WRITE !,%
+6 QUIT
