- 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 Feb 18, 2025@23:41:53 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