source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCPRSS1.m@ 1742

Last change on this file since 1742 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1PRCPRSS1 ;WOIFO/DAP-stock status report for primaries and secondaries; 10/16/06 2:17pm
2V ;;5.1;IFCAP;**98**;Oct 20, 2000;Build 37
3 ;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6 ;
7PRINT ; print report
8 N DAYS,MONTH,NOW,PAGE,PRCPFLAG,SCREEN,TOTCLOS,TOTISS,TOTN,TOTOPEN,TOTVAL,ITEMCTA,X,Y
9 S Y=DATESTRT D DD^%DT S MONTH=Y
10 S DAYS=$P("31^28^31^30^31^30^31^31^30^31^30^31","^",+$E(DATESTRT,4,5))
11 I DAYS=28 S %=(17+$E(DATESTRT))_$E(DATESTRT,2,3),DAYS=$S(%#400=0:29,(%#4=0&(%#100'=0)):29,1:28)
12 ;
13 ;*98 Added looping logic to go through print cycle for each type of
14 ;item report (Standard/ODI/All)
15 ;
16 N P,PRCPTP,PRCPTP2,NODE1
17 S PAGE=1
18 F P=1:1:3 S NODE1=P D
19 . I $G(PRCPFLAG) Q
20 . I P=1 S PRCPTP="STANDARD",PRCPTP2="STD"
21 . I P=2 S PRCPTP="ON-DEMAND",PRCPTP2="OD"
22 . I P=3 S PRCPTP="ALL",PRCPTP2=PRCPTP
23 . D REP^PRCPRSS1
24 . Q
25 ;
26 D Q^PRCPRSS1
27 Q
28 ;
29REP ;*98 Added header to display type of reporting, moved header logic
30 ;from earlier in routine to support looping structure
31 ;
32 I P>1 D LC
33 I $G(PRCPFLAG) Q
34 S SCREEN=$$SCRPAUSE^PRCPUREP D NOW^%DTC S Y=% D DD^%DT S NOW=Y U IO I P=1 D HEAD
35 ;
36 W !,"INVENTORY ("_PRCPTP_" ITEMS)"
37 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
38 ;
39 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(%)
40 W $$SHOWVALU(TOTOPEN)
41 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
42 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(%)
43 W $$SHOWVALU(TOTAL)
44 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
45 ;*98 Modified report to replace "ISSUES" with "USAGE"
46 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(%)
47 W $$SHOWVALU(TOTISS)
48 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
49 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(%)
50 W $$SHOWVALU(TOTAL)
51 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
52 S %="",$P(%,"=",80)=""
53 W !,%,!,"CLOSE BALANCE",?14 S TOTCLOS=0 F ACCT=1,2,3,6,8 S %=$G(OPEN(ACCT)),TOTCLOS=TOTCLOS+% W $$SHOWVALU(%)
54 W $$SHOWVALU(TOTCLOS)
55 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
56 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)
57 W $J(TOTAL,11,0)
58 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
59 ;*98 Modified report to replace "ISSUES" with "USAGES"
60 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)
61 W $J(TOTAL,11,0)
62 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
63 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)
64 W $J(TOTAL,11,0)
65 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
66 S %="",$P(%,"=",80)=""
67 W !,%,!,"# TOTAL",?13 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(TOTN(ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
68 W $J(TOTAL,11,0)
69 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
70 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)
71 S %=(TOTISS*365)/DAYS,%=$S('TOTCLOS:"X",1:-%/TOTCLOS) W $J(%,11,2)
72 ;*98 Added indicator of type of report (Standard/ODI/All)
73 W !,"("_PRCPTP_" ITEMS)"
74 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
75 ;
76 ;*98 Added indicator of type of report (Standard/ODI/All)
77 W !!?28,"*** CURRENT DATA ("_PRCPTP_" ITEMS) ***"
78 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
79 ;
80 ;*98 Rearranged report placement of sections and added indicator of
81 ;type of report (Standard/ODI/All)
82 ;
83 S Y=$E(DATEINAC,1,5)_"01" D DD^%DT
84 W !!?2,"INACTIVE ITEMS ("_PRCPTP_" ITEMS) FROM ",Y," TO ",$P(NOW,"@"),!,"# INACTIVE",?13
85 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"INACTN",ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
86 W $J(TOTAL,11,0)
87 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
88 W !,"$ INACTIVE",?14 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"INACT",ACCT)),TOTAL=TOTAL+% W $$SHOWVALU(%)
89 W $$SHOWVALU(TOTAL)
90 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
91 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)
92 ;
93 ;*98 Moved TOTVAL logic to support reordered processing
94 S TOTVAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"VALUE",ACCT)),TOTVAL=TOTVAL+%
95 ;
96 S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
97 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
98 S Y=$E(DATELONG,1,5)_"01" D DD^%DT
99 W !!?2,"LONG SUPPLY ("_PRCPTP_" ITEMS) AVG. FROM ",Y," TO ",$P(NOW,"@"),!?2,"(>90 DAYS)",!,"# LONG SUPPLY",?13
100 S TOTAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"LONGN",ACCT)),TOTAL=TOTAL+% W $J(%,11,0)
101 W $J(TOTAL,11,0)
102 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
103 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(%)
104 W $$SHOWVALU(TOTAL)
105 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
106 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)
107 S %=$S('TOTVAL:0,1:TOTAL/TOTVAL) W $J(%,11,2)
108 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
109 ;
110 ;*98 Modified section to display a new section header, item type count,
111 ;and display "$ONHAND" by specific type (Standard/ODI/All)
112 ;
113 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)
114 W $J(ITEMCTA,11,0)
115 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
116 ;
117 W !!,"INVENTORY VALUE"
118 W !,"$ "_PRCPTP,?14 S TOTVAL=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"VALUE",ACCT)),TOTVAL=TOTVAL+% W $$SHOWVALU(%)
119 W $$SHOWVALU(TOTVAL)
120 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
121 W !,"$ DUEINS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"DUEIN",ACCT)),X=X+% W $$SHOWVALU(%)
122 W $$SHOWVALU(X)
123 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
124 W !,"$ DUEOUTS",?14 S X=0 F ACCT=1,2,3,6,8 S %=$G(^TMP($J,NODE1,"DUEOUT",ACCT)),X=X+% W $$SHOWVALU(%)
125 W $$SHOWVALU(X)
126 I $Y>(IOSL-7) D LC G:$G(PRCPFLAG) Q
127 ;
128 ;*98 Modified report to not show the section addressing nonissuable
129 ;items for primary and secondary inventory points
130 Q
131 ;
132 ;
133Q ;Tag ends printing and exits routine
134 D END^PRCPUREP
135 D ^%ZISC Q
136 ;
137 ;
138SHOWVALU(V1) ;show value
139 N % S %="+" S:+V1=0 %=" " I V1<0 S V1=-V1,%="-"
140 Q $J(V1,10,2)_%
141 ;
142LC ;*98 Moved line control logic into subroutines
143 I SCREEN W ! D P^PRCPUREP I $D(PRCPFLAG) Q
144 ;
145HEAD ;heading
146 N PRCPT
147 S %=NOW_" PAGE: "_PAGE,PAGE=PAGE+1 I PAGE'=2!(SCREEN) W @IOF
148 W !,"STOCK STATUS REPORT FOR: ",$E(PRCP("IN"),1,20),?(80-$L(%)),%
149 ;*98 Added type of reporting (Standard/ODI/All) to header
150 S PRCPT=PRCPTP_" ITEMS"
151 W !?5,"TRANSACTIONS FOR THE MONTH-YEAR: ",MONTH,?(80-$L(PRCPT)),PRCPT
152 ;
153 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)
154 S %="",$P(%,"-",81)="" W !,%
155 Q
Note: See TracBrowser for help on using the repository browser.