source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCH191.m@ 1581

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PRCH191 ;WISC/DJM Display MIN/MAX report ; 11/4/99 2:35pm
2 ;;5.0;IFCAP;**191**;4/21/95
3 ; This report will list all records that have a limit set to
4 ; zero (0). In file 441, Sub-File VENDOR, for fields 8 and 8.5.
5 ;
6 ; The second part of the report will list all records that have a
7 ; limit set to zero (0). In file 442, Sub-File ITEM, for field 9.6.
8 ;
9START N PRCX,PRCY,PTR,MIN,MAX,TEST,AA,BB,CC,EE,MSG,DATA,STA0,STA1
10 ;
11 ; Clean up and set up.
12 ;
13 S PRCX=0
14 K ^TMP("DJM",$J)
15 F S PRCX=$O(^PRC(441,PRCX)) Q:PRCX'>0 D
16 . S PRCY=0
17 . F S PRCY=$O(^PRC(441,PRCX,2,PRCY)) Q:PRCY'>0 D
18 . . S PTR=$G(^PRC(441,PRCX,2,PRCY,0))
19 . . Q:PTR=""
20 . . S (MIN,MAX)=""
21 . . S:$P(PTR,"^",12)=0 MIN="X"
22 . . S:$P(PTR,"^",9)=0 MAX="X"
23 . . I (MIN="")&(MAX="") Q
24 . . S ^TMP("DJM",$J,PRCX,PRCY)=MIN_"^"_MAX
25 . . Q
26 . Q
27 S (TEST,DATA)=$D(^TMP("DJM",$J))
28 G:TEST=0 NEXT
29 ;
30 ; Now display the records in file 441 that need to be changed.
31 ;
32441 ; Display entries that need correcting in file 441.
33 ;
34 K MSG
35 S MSG(1)=" FILE 441"
36 S MSG(2)=" "
37 S MSG(3)="An X will show records with a value of 0 in the MINIMUM"
38 S MSG(4)="ORDER QTY (MIN) column or the MAXIMUM ORDER QTY (MAX)"
39 S MSG(5)="column. This patch changes both fields to accept "
40 S MSG(6)=".01--999999 as input."
41 S MSG(7)=" "
42 S MSG(8)="Use the 'Item File Edit' option to change records with"
43 S MSG(9)="field values out of range. Or set them to null/blank."
44 S MSG(10)="Enter the IMF IEN column value (110) to select"
45 S MSG(11)="the record to change. At the 'Select VENDOR:'"
46 S MSG(12)="prompt enter the VENDOR IEN"
47 S MSG(13)="column value (36300) to select the proper vendor"
48 S MSG(14)="containing the fields to edit."
49 S MSG(15)=" "
50 D MES^XPDUTL(.MSG)
51 K MSG
52 S MSG(1)="IMF VENDOR"
53 S MSG(2)="IEN IEN MIN MAX"
54 S MSG(3)="--- ------ --- ---"
55 D MES^XPDUTL(.MSG)
56 S PRCX=0
57 F S PRCX=$O(^TMP("DJM",$J,PRCX)) Q:PRCX'>0 D
58 . S PRCY=0
59 . F S PRCY=$O(^TMP("DJM",$J,PRCX,PRCY)) Q:PRCY'>0 D
60 . . S PTR=$G(^TMP("DJM",$J,PRCX,PRCY))
61 . . S AA=PRCX_" "
62 . . S AA=$E(AA,1,9)
63 . . S BB=PRCY_" "
64 . . S BB=$E(BB,1,10)
65 . . S CC=$P(PTR,"^")_" "
66 . . S CC=$E(CC,1,10)
67 . . S EE=$P(PTR,"^",2)
68 . . K MSG
69 . . S MSG(1)=" "
70 . . S MSG(2)=AA_BB_CC_EE
71 . . D MES^XPDUTL(.MSG)
72 . . Q
73 . Q
74 K MSG
75 S MSG(1)=" "
76 S MSG(2)=" "
77 D MES^XPDUTL(.MSG)
78 K MSG
79 ;
80NEXT ; Now to see if there are any records in file 442 that need to be
81 ; corrected.
82 ;
83 S PRCX=0
84 K ^TMP("DJM",$J)
85 F S PRCX=$O(^PRC(442,PRCX)) Q:PRCX'>0 D
86 . S PRCY=0,(STA0,STA1)=""
87 . F S PRCY=$O(^PRC(442,PRCX,2,PRCY)) Q:PRCY'>0 D
88 . . S PTR=$G(^PRC(442,PRCX,2,PRCY,0))
89 . . Q:PTR=""
90 . . S MAX=""
91 . . S:$P(PTR,"^",14)=0 MAX="X"
92 . . Q:MAX=""
93 . . S STA0=$P($G(^PRC(442,PRCX,7)),"^",1)
94 . . S STA1=$P($G(^PRCD(442.3,STA0,0)),"^",1)
95 . . S MAX=MAX_" "_STA1
96 . . S ^TMP("DJM",$J,PRCX,PRCY)=MAX
97 . . Q
98 . Q
99 S (TEST,DATA)=$D(^TMP("DJM",$J))
100 ;
101 ; See if there is any data from file 441 or file 442.
102 ;
103 G:(TEST=0)&(DATA=0) EXIT
104 ;
105 ; There must be some data from file 441. DATA is not 0.
106 ;
107 G:TEST=0 FINAL
108 ;
109442 ; Now display the records in file 442 that need to be changed.
110 ;
111 K MSG
112 S MSG(1)=" FILE 442"
113 S MSG(2)=" "
114 S MSG(3)="An X will show records with a value of 0 in the MAXIMUM"
115 S MSG(4)="ORDER QTY (MAX) column. This patch changes the field"
116 S MSG(5)="to accept only .01--999999 as input."
117 S MSG(6)=" "
118 S MSG(7)="Use the 'Edit an Incomplete Purchase Order' option"
119 S MSG(8)="to change records with the field value out of range."
120 S MSG(9)="Or set them to null/blank. Please note, only P.O.s"
121 S MSG(10)="that have not been signed can be edited with this"
122 S MSG(11)="option."
123 S MSG(12)=" "
124 S MSG(13)="Enter the P.O. NAME column value (688-A90002) to"
125 S MSG(14)="select the record to change. At the 'Select LINE ITEM"
126 S MSG(15)="NUMBER:' prompt enter ` plus the ITEM IEN column value"
127 S MSG(16)="(`1) to select the proper line item containing the"
128 S MSG(17)="field to edit."
129 S MSG(18)=" "
130 D MES^XPDUTL(.MSG)
131 K MSG
132 S MSG(1)="P.O. P.O. ITEM SUPPLY"
133 S MSG(2)="IEN NAME IEN MAX STATUS"
134 S MSG(3)="---- ---- ---- --- ------"
135 D MES^XPDUTL(.MSG)
136 S PRCX=0
137 F S PRCX=$O(^TMP("DJM",$J,PRCX)) Q:PRCX'>0 D
138 . S PRCY=0
139 . F S PRCY=$O(^TMP("DJM",$J,PRCX,PRCY)) Q:PRCY'>0 D
140 . . S PTR=$G(^TMP("DJM",$J,PRCX,PRCY))
141 . . S AA=PRCX_" "
142 . . S AA=$E(AA,1,9)
143 . . S BB=$P($G(^PRC(442,PRCX,0)),U,1)_" "
144 . . S BB=$E(BB,1,15)
145 . . S CC=PRCY_" "
146 . . S CC=$E(CC,1,10)
147 . . K MSG
148 . . S MSG(1)=" "
149 . . S MSG(2)=AA_BB_CC_PTR
150 . . D MES^XPDUTL(.MSG)
151 . . Q
152 . Q
153 ;
154FINAL ; Now display the final message. What to do with this report.
155 ;
156 K MSG
157 S MSG(1)=" "
158 S MSG(2)=" "
159 S MSG(3)="This report identified records that have a field(s) that"
160 S MSG(4)="are no longer within the input transform range of"
161 S MSG(5)=".01--999999."
162 S MSG(6)="Please contact appropriate personnel for any corrections."
163 S MSG(7)=" "
164 D MES^XPDUTL(.MSG)
165 ;
166EXIT K ^TMP("DJM",$J),STA0,STA1
167 Q
Note: See TracBrowser for help on using the repository browser.