- PRCPRSS1 ;WOIFO/DAP-stock status report for primaries and secondaries; 10/16/06 2:17pm
- 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,ITEMCTA,X,Y
- 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)
- ;
- ;*98 Added looping logic to go through print cycle for each type of
- ;item report (Standard/ODI/All)
- ;
- N P,PRCPTP,PRCPTP2,NODE1
- S PAGE=1
- F P=1:1:3 S NODE1=P D
- . I $G(PRCPFLAG) Q
- . I P=1 S PRCPTP="STANDARD",PRCPTP2="STD"
- . I P=2 S PRCPTP="ON-DEMAND",PRCPTP2="OD"
- . I P=3 S PRCPTP="ALL",PRCPTP2=PRCPTP
- . D REP^PRCPRSS1
- . Q
- ;
- D Q^PRCPRSS1
- Q
- ;
- REP ;*98 Added header to display type of reporting, moved header logic
- ;from earlier in routine to support looping structure
- ;
- I P>1 D LC
- I $G(PRCPFLAG) Q
- S SCREEN=$$SCRPAUSE^PRCPUREP D NOW^%DTC S Y=% D DD^%DT S NOW=Y U IO I P=1 D HEAD
- ;
- W !,"INVENTORY ("_PRCPTP_" ITEMS)"
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;
- W !,"OPEN BALANCE",?14 S TOTOPEN=0 F ACCT=1,2,3,6,8 S %=$P($G(^TMP($J,NODE1,"OPEN",ACCT)),"^",2) S OPEN(ACCT)=%,TOTOPEN=TOTOPEN+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTOPEN)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !!,"RECEIPTS",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"REC",ACCT)),TOTAL=TOTAL+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTAL)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;*98 Modified report to replace "ISSUES" with "USAGE"
- W !,"USAGE",?14 S TOTISS=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"ISS",ACCT)),TOTISS=TOTISS+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTISS)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"ADJUSTMENTS",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"ADJ",ACCT)),TOTAL=TOTAL+%,OPEN(ACCT)=$G(OPEN(ACCT))+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTAL)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- 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)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !!!,"# RECEIPTS",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"RECN",ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=% W $J(%,11,0)
- W $J(TOTAL,11,0)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;*98 Modified report to replace "ISSUES" with "USAGES"
- W !,"# USAGE",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"ISSN",ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=$G(TOTN(ACCT))+% W $J(%,11,0)
- W $J(TOTAL,11,0)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"# ADJUSTMENTS",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"ADJN",ACCT)),TOTAL=TOTAL+%,TOTN(ACCT)=$G(TOTN(ACCT))+% W $J(%,11,0)
- W $J(TOTAL,11,0)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- 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)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !!,"TURNOVER",?13 F ACCT=1,2,3,6,8 S %=($G(^TMP($J,NODE1,"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)
- ;*98 Added indicator of type of report (Standard/ODI/All)
- W !,"("_PRCPTP_" ITEMS)"
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;
- ;*98 Added indicator of type of report (Standard/ODI/All)
- W !!?28,"*** CURRENT DATA ("_PRCPTP_" ITEMS) ***"
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;
- ;*98 Rearranged report placement of sections and added indicator of
- ;type of report (Standard/ODI/All)
- ;
- S Y=$E(DATEINAC,1,5)_"01" D DD^%DT
- W !!?2,"INACTIVE ITEMS ("_PRCPTP_" ITEMS) FROM ",Y," TO ",$P(NOW,"@"),!,"# INACTIVE",?13
- S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"INACTN",ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
- W $J(TOTAL,11,0)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"$ INACTIVE",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"INACT",ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTAL)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"% INACTIVE",?13 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"VALUE",ACCT)),%=$S('%:0,1:$G(^TMP($J,NODE1,"INACT",ACCT))/%) W $J(%,11,2)
- ;
- ;*98 Moved TOTVAL logic to support reordered processing
- S TOTVAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"VALUE",ACCT)),TOTVAL=TOTVAL+%
- ;
- S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- S Y=$E(DATELONG,1,5)_"01" D DD^%DT
- W !!?2,"LONG SUPPLY ("_PRCPTP_" ITEMS) AVG. FROM ",Y," TO ",$P(NOW,"@"),!?2,"(>90 DAYS)",!,"# LONG SUPPLY",?13
- S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"LONGN",ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
- W $J(TOTAL,11,0)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"$ LONG SUPPLY",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"LONG",ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTAL)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"% LONG SUPPLY",?13 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"VALUE",ACCT)),%=$S('%:0,1:$G(^TMP($J,NODE1,"LONG",ACCT))/%) W $J(%,11,2)
- S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;
- ;*98 Modified section to display a new section header, item type count,
- ;and display "$ONHAND" by specific type (Standard/ODI/All)
- ;
- W !!,"# "_PRCPTP2_" ITEMS",?13 S ITEMCTA=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"CNT",ACCT)),ITEMCTA=ITEMCTA+% W $J(%,11,0)
- W $J(ITEMCTA,11,0)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;
- W !!,"INVENTORY VALUE"
- W !,"$ "_PRCPTP,?14 S TOTVAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"VALUE",ACCT)),TOTVAL=TOTVAL+% W $$SHOWVALU(%)
- W $$SHOWVALU(TOTVAL)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"$ DUEINS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"DUEIN",ACCT)),X=X+% W $$SHOWVALU(%)
- W $$SHOWVALU(X)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- W !,"$ DUEOUTS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"DUEOUT",ACCT)),X=X+% W $$SHOWVALU(%)
- W $$SHOWVALU(X)
- I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
- ;
- ;*98 Modified report to not show the section addressing nonissuable
- ;items for primary and secondary inventory points
- Q
- ;
- ;
- Q ;Tag ends printing and exits routine
- D END^PRCPUREP
- D ^%ZISC Q
- ;
- ;
- SHOWVALU(V1) ;show value
- N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
- Q $J(V1,10,2)_%
- ;
- LC ;*98 Moved line control logic into subroutines
- I SCREEN W ! D P^PRCPUREP I $D(PRCPFLAG) Q
- ;
- HEAD ;heading
- N PRCPT
- S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
- W !,"STOCK STATUS REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
- ;*98 Added type of reporting (Standard/ODI/All) to header
- S PRCPT=PRCPTP_" ITEMS"
- W !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH,?(80-$L(PRCPT)),PRCPT
- ;
- 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[HPRCPRSS1 6994 printed Feb 18, 2025@23:41:54 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,ITEMCTA,X,Y
- +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 ;
- +6 ;*98 Added looping logic to go through print cycle for each type of
- +7 ;item report (Standard/ODI/All)
- +8 ;
- +9 NEW P,PRCPTP,PRCPTP2,NODE1
- +10 SET PAGE=1
- +11 FOR P=1:1:3
- SET NODE1=P
- Begin DoDot:1
- +12 IF $GET(PRCPFLAG)
- QUIT
- +13 IF P=1
- SET PRCPTP="STANDARD"
- SET PRCPTP2="STD"
- +14 IF P=2
- SET PRCPTP="ON-DEMAND"
- SET PRCPTP2="OD"
- +15 IF P=3
- SET PRCPTP="ALL"
- SET PRCPTP2=PRCPTP
- +16 DO REP^PRCPRSS1
- +17 QUIT
- End DoDot:1
- +18 ;
- +19 DO Q^PRCPRSS1
- +20 QUIT
- +21 ;
- REP ;*98 Added header to display type of reporting, moved header logic
- +1 ;from earlier in routine to support looping structure
- +2 ;
- +3 IF P>1
- DO LC
- +4 IF $GET(PRCPFLAG)
- QUIT
- +5 SET SCREEN=$$SCRPAUSE^PRCPUREP
- DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- SET NOW=Y
- USE IO
- IF P=1
- DO HEAD
- +6 ;
- +7 WRITE !,"INVENTORY ("_PRCPTP_" ITEMS)"
- +8 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +9 ;
- +10 WRITE !,"OPEN BALANCE",?14
- SET TOTOPEN=0
- FOR ACCT=1,2,3,6,8
- SET %=$PIECE($GET(^TMP($JOB,NODE1,"OPEN",ACCT)),"^",2)
- SET OPEN(ACCT)=%
- SET TOTOPEN=TOTOPEN+%
- WRITE $$SHOWVALU(%)
- +11 WRITE $$SHOWVALU(TOTOPEN)
- +12 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +13 WRITE !!,"RECEIPTS",?14
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"REC",ACCT))
- SET TOTAL=TOTAL+%
- SET OPEN(ACCT)=$GET(OPEN(ACCT))+%
- WRITE $$SHOWVALU(%)
- +14 WRITE $$SHOWVALU(TOTAL)
- +15 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +16 ;*98 Modified report to replace "ISSUES" with "USAGE"
- +17 WRITE !,"USAGE",?14
- SET TOTISS=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"ISS",ACCT))
- SET TOTISS=TOTISS+%
- SET OPEN(ACCT)=$GET(OPEN(ACCT))+%
- WRITE $$SHOWVALU(%)
- +18 WRITE $$SHOWVALU(TOTISS)
- +19 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +20 WRITE !,"ADJUSTMENTS",?14
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"ADJ",ACCT))
- SET TOTAL=TOTAL+%
- SET OPEN(ACCT)=$GET(OPEN(ACCT))+%
- WRITE $$SHOWVALU(%)
- +21 WRITE $$SHOWVALU(TOTAL)
- +22 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +23 SET %=""
- SET $PIECE(%,"=",80)=""
- +24 WRITE !,%,!,"CLOSE BALANCE",?14
- SET TOTCLOS=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(OPEN(ACCT))
- SET TOTCLOS=TOTCLOS+%
- WRITE $$SHOWVALU(%)
- +25 WRITE $$SHOWVALU(TOTCLOS)
- +26 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +27 WRITE !!!,"# RECEIPTS",?13
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"RECN",ACCT))
- SET TOTAL=TOTAL+%
- SET TOTN(ACCT)=%
- WRITE $JUSTIFY(%,11,0)
- +28 WRITE $JUSTIFY(TOTAL,11,0)
- +29 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +30 ;*98 Modified report to replace "ISSUES" with "USAGES"
- +31 WRITE !,"# USAGE",?13
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"ISSN",ACCT))
- SET TOTAL=TOTAL+%
- SET TOTN(ACCT)=$GET(TOTN(ACCT))+%
- WRITE $JUSTIFY(%,11,0)
- +32 WRITE $JUSTIFY(TOTAL,11,0)
- +33 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +34 WRITE !,"# ADJUSTMENTS",?13
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"ADJN",ACCT))
- SET TOTAL=TOTAL+%
- SET TOTN(ACCT)=$GET(TOTN(ACCT))+%
- WRITE $JUSTIFY(%,11,0)
- +35 WRITE $JUSTIFY(TOTAL,11,0)
- +36 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +37 SET %=""
- SET $PIECE(%,"=",80)=""
- +38 WRITE !,%,!,"# TOTAL",?13
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(TOTN(ACCT))
- SET TOTAL=TOTAL+%
- WRITE $JUSTIFY(%,11,0)
- +39 WRITE $JUSTIFY(TOTAL,11,0)
- +40 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +41 WRITE !!,"TURNOVER",?13
- FOR ACCT=1,2,3,6,8
- SET %=($GET(^TMP($JOB,NODE1,"ISS",ACCT))*365)/DAYS
- SET %=$SELECT('$GET(OPEN(ACCT)):"X",1:-%/OPEN(ACCT))
- WRITE $JUSTIFY(%,11,2)
- +42 SET %=(TOTISS*365)/DAYS
- SET %=$SELECT('TOTCLOS:"X",1:-%/TOTCLOS)
- WRITE $JUSTIFY(%,11,2)
- +43 ;*98 Added indicator of type of report (Standard/ODI/All)
- +44 WRITE !,"("_PRCPTP_" ITEMS)"
- +45 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +46 ;
- +47 ;*98 Added indicator of type of report (Standard/ODI/All)
- +48 WRITE !!?28,"*** CURRENT DATA ("_PRCPTP_" ITEMS) ***"
- +49 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +50 ;
- +51 ;*98 Rearranged report placement of sections and added indicator of
- +52 ;type of report (Standard/ODI/All)
- +53 ;
- +54 SET Y=$EXTRACT(DATEINAC,1,5)_"01"
- DO DD^%DT
- +55 WRITE !!?2,"INACTIVE ITEMS ("_PRCPTP_" ITEMS) FROM ",Y," TO ",$PIECE(NOW,"@"),!,"# INACTIVE",?13
- +56 SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"INACTN",ACCT))
- SET TOTAL=TOTAL+%
- WRITE $JUSTIFY(%,11,0)
- +57 WRITE $JUSTIFY(TOTAL,11,0)
- +58 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +59 WRITE !,"$ INACTIVE",?14
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"INACT",ACCT))
- SET TOTAL=TOTAL+%
- WRITE $$SHOWVALU(%)
- +60 WRITE $$SHOWVALU(TOTAL)
- +61 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +62 WRITE !,"% INACTIVE",?13
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"VALUE",ACCT))
- SET %=$SELECT('%:0,1:$GET(^TMP($JOB,NODE1,"INACT",ACCT))/%)
- WRITE $JUSTIFY(%,11,2)
- +63 ;
- +64 ;*98 Moved TOTVAL logic to support reordered processing
- +65 SET TOTVAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"VALUE",ACCT))
- SET TOTVAL=TOTVAL+%
- +66 ;
- +67 SET %=$SELECT('TOTVAL:0,1:TOTAL/TOTVAL)
- WRITE $JUSTIFY(%,11,2)
- +68 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +69 SET Y=$EXTRACT(DATELONG,1,5)_"01"
- DO DD^%DT
- +70 WRITE !!?2,"LONG SUPPLY ("_PRCPTP_" ITEMS) AVG. FROM ",Y," TO ",$PIECE(NOW,"@"),!?2,"(>90 DAYS)",!,"# LONG SUPPLY",?13
- +71 SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"LONGN",ACCT))
- SET TOTAL=TOTAL+%
- WRITE $JUSTIFY(%,11,0)
- +72 WRITE $JUSTIFY(TOTAL,11,0)
- +73 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +74 WRITE !,"$ LONG SUPPLY",?14
- SET TOTAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"LONG",ACCT))
- SET TOTAL=TOTAL+%
- WRITE $$SHOWVALU(%)
- +75 WRITE $$SHOWVALU(TOTAL)
- +76 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +77 WRITE !,"% LONG SUPPLY",?13
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"VALUE",ACCT))
- SET %=$SELECT('%:0,1:$GET(^TMP($JOB,NODE1,"LONG",ACCT))/%)
- WRITE $JUSTIFY(%,11,2)
- +78 SET %=$SELECT('TOTVAL:0,1:TOTAL/TOTVAL)
- WRITE $JUSTIFY(%,11,2)
- +79 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +80 ;
- +81 ;*98 Modified section to display a new section header, item type count,
- +82 ;and display "$ONHAND" by specific type (Standard/ODI/All)
- +83 ;
- +84 WRITE !!,"# "_PRCPTP2_" ITEMS",?13
- SET ITEMCTA=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"CNT",ACCT))
- SET ITEMCTA=ITEMCTA+%
- WRITE $JUSTIFY(%,11,0)
- +85 WRITE $JUSTIFY(ITEMCTA,11,0)
- +86 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +87 ;
- +88 WRITE !!,"INVENTORY VALUE"
- +89 WRITE !,"$ "_PRCPTP,?14
- SET TOTVAL=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"VALUE",ACCT))
- SET TOTVAL=TOTVAL+%
- WRITE $$SHOWVALU(%)
- +90 WRITE $$SHOWVALU(TOTVAL)
- +91 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +92 WRITE !,"$ DUEINS",?14
- SET X=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"DUEIN",ACCT))
- SET X=X+%
- WRITE $$SHOWVALU(%)
- +93 WRITE $$SHOWVALU(X)
- +94 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +95 WRITE !,"$ DUEOUTS",?14
- SET X=0
- FOR ACCT=1,2,3,6,8
- SET %=$GET(^TMP($JOB,NODE1,"DUEOUT",ACCT))
- SET X=X+%
- WRITE $$SHOWVALU(%)
- +96 WRITE $$SHOWVALU(X)
- +97 IF $Y>(IOSL-7)
- DO LC
- if $GET(PRCPFLAG)
- GOTO Q
- +98 ;
- +99 ;*98 Modified report to not show the section addressing nonissuable
- +100 ;items for primary and secondary inventory points
- +101 QUIT
- +102 ;
- +103 ;
- Q ;Tag ends printing and exits routine
- +1 DO END^PRCPUREP
- +2 DO ^%ZISC
- QUIT
- +3 ;
- +4 ;
- 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 ;
- LC ;*98 Moved line control logic into subroutines
- +1 IF SCREEN
- WRITE !
- DO P^PRCPUREP
- IF $DATA(PRCPFLAG)
- QUIT
- +2 ;
- HEAD ;heading
- +1 NEW PRCPT
- +2 SET %=NOW_" PAGE: "_PAGE
- SET PAGE=PAGE+1
- IF PAGE'=2!(SCREEN)
- WRITE @IOF
- +3 WRITE !,"STOCK STATUS REPORT FOR: ",$EXTRACT(PRCP("IN"),1,20),?(80-$LENGTH(%)),%
- +4 ;*98 Added type of reporting (Standard/ODI/All) to header
- +5 SET PRCPT=PRCPTP_" ITEMS"
- +6 WRITE !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH,?(80-$LENGTH(PRCPT)),PRCPT
- +7 ;
- +8 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)
- +9 SET %=""
- SET $PIECE(%,"-",81)=""
- WRITE !,%
- +10 QUIT