source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCP36C.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 8.9 KB
Line 
1ONCP36C ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
2 ;;2.11;ONCOLOGY;**36**;Mar 07, 1995
3 ;
4 D S $P(^ONCO(165.5,IEN,27),U,4)="Y"
5 .I $P($G(^ONCO(165.5,IEN,27)),U,4)="Y" Q
6 .S (FORDS,FORDSAF)=""
7 .I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SPO Q
8 ..I ((SPP>9)&(SPP<91))!((SLN>0)&(SLN<9)) S FORDS=1
9 ..I ((SPPAF>9)&(SPPAF<91))!((SLNAF>0)&(SLNAF<9)) S FORDSAF=1
10 ..I SPO=0 S FORDS=0
11 ..I SPOAF=0 S FORDSAF=0
12 ..I SPO=1 S FORDS=1
13 ..I SPOAF=1 S FORDSAF=1
14 ..I SPO=9 S FORDS=9
15 ..I SPOAF=9 S FORDSAF=9
16 ..I (SPO=2)!(SPO=3)!(SPO=4)!(SPO=5) S FORDS=1
17 ..I (SPOAF=2)!(SPOAF=3)!(SPOAF=4)!(SPOAF=5) S FORDSAF=1
18 ..I SPO>0,FORDS="" S FORDS=9
19 ..I SPOAF>0,FORDSAF="" S FORDSAF=9
20 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
21 ...S FORDSUB=""
22 ...I (($P(SUBTX(SUB),U,1)>9)&($P(SUBTX(SUB),U,1)<91))!(($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<9)) S FORDSUB=1 Q
23 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
24 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
25 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
26 ...I ($P(SUBTX(SUB),U,5)=2)!($P(SUBTX(SUB),U,5)=3)!($P(SUBTX(SUB),U,5)=4)!($P(SUBTX(SUB),U,5)=5) S FORDSUB=1 Q
27 ...I $P(SUBTX(SUB),U,5)>0,FORDSUB="" S FORDSUB=9 Q
28 .
29 .I ((TOP>67419)&(TOP<67422))!((TOP>67422)&(TOP<67425))!((TOP>67759)&(TOP<67769))!(TOP=67809) D D SPO Q
30 ..I ((SPP>9)&(SPP<91))!((SLN>0)&(SLN<9)) S FORDS=1
31 ..I ((SPPAF>9)&(SPPAF<91))!((SLNAF>0)&(SLNAF<9)) S FORDSAF=1
32 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
33 ...S FORDSUB=""
34 ...I (($P(SUBTX(SUB),U,1)>9)&($P(SUBTX(SUB),U,1)<91))!(($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<9)) S FORDSUB=1 Q
35 .
36 .I ((TOP>66999)&(TOP<67070)) D D SPO Q
37 ..I SPO=0 S FORDS=0
38 ..I SPOAF=0 S FORDSAF=0
39 ..I SPO=1 S FORDS=1
40 ..I SPOAF=1 S FORDSAF=1
41 ..I SPO=9 S FORDS=9
42 ..I SPOAF=9 S FORDSAF=9
43 ..I ((SPO=2)!(SPO=3)!(SPO=4)) S FORDS=2
44 ..I ((SPOAF=2)!(SPOAF=3)!(SPOAF=4)) S FORDSAF=2
45 ..I SPO=5 S FORDS=3
46 ..I SPOAF=5 S FORDSAF=3
47 ..I SPO=6 S FORDS=4
48 ..I SPOAF=6 S FORDSAF=4
49 ..I SPO=7 S FORDS=5
50 ..I SPOAF=7 S FORDSAF=5
51 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
52 ...S FORDSUB=""
53 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
54 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
55 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
56 ...I (($P(SUBTX(SUB),U,5)=2)!($P(SUBTX(SUB),U,5)=3)!($P(SUBTX(SUB),U,5)=4)) S FORDSUB=2 Q
57 ...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=3 Q
58 ...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=4 Q
59 ...I $P(SUBTX(SUB),U,5)=7 S FORDSUB=5 Q
60 .
61 .I TOP>67089,TOP<67139 D D SPO Q
62 ..I SPO=0 S FORDS=0
63 ..I SPOAF=0 S FORDSAF=0
64 ..I SPO=1 S FORDS=1
65 ..I SPOAF=1 S FORDSAF=1
66 ..I SPO=9 S FORDS=9
67 ..I SPOAF=9 S FORDSAF=9
68 ..I SPO>1,SPO<7 S FORDS=2
69 ..I SPOAF>1,SPOAF<7 S FORDSAF=2
70 ..I SPO=7 S FORDS=1
71 ..I SPOAF=7 S FORDSAF=1
72 ..I SPO=8 S FORDS=5
73 ..I SPOAF=8 S FORDSAF=5
74 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
75 ...S FORDSUB=""
76 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
77 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
78 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
79 ...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<7 S FORDSUB=2 Q
80 ...I $P(SUBTX(SUB),U,5)=7 S FORDSUB=1 Q
81 ...I $P(SUBTX(SUB),U,5)=8 S FORDSUB=5 Q
82 .
83 .I TOP>67179,TOP<67210 D D SPO Q
84 ..I SPO=0 S FORDS=0
85 ..I SPOAF=0 S FORDSAF=0
86 ..I SPO=1 S FORDS=1
87 ..I SPOAF=1 S FORDSAF=1
88 ..I SPO=9 S FORDS=9
89 ..I SPOAF=9 S FORDSAF=9
90 ..I SPO>1,SPO<6 S FORDS=2
91 ..I SPOAF>1,SPOAF<6 S FORDSAF=2
92 ..I SPO=6 S FORDS=1
93 ..I SPOAF=6 S FORDSAF=1
94 ..I (SPO=7)!(SPO=8) S FORDS=5
95 ..I (SPOAF=7)!(SPOAF=8) S FORDSAF=5
96 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
97 ...S FORDSUB=""
98 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
99 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
100 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
101 ...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<6 S FORDSUB=2 Q
102 ...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=1 Q
103 ...I ($P(SUBTX(SUB),U,5)=7)!($P(SUBTX(SUB),U,5)=8) S FORDSUB=5 Q
104 .
105 .I TOP>67339,TOP<67350 D D SPO Q
106 ..I SPO=0 S FORDS=0
107 ..I SPOAF=0 S FORDSAF=0
108 ..I SPO=1 S FORDS=1
109 ..I SPOAF=1 S FORDSAF=1
110 ..I SPO=2 S FORDS=2
111 ..I SPOAF=2 S FORDSAF=2
112 ..I SPO=9 S FORDS=9
113 ..I SPOAF=9 S FORDSAF=9
114 ..I SPO=3 S FORDS=2
115 ..I SPOAF=3 S FORDSAF=2
116 ..I (SPO=4)!(SPO=6) S FORDS=1
117 ..I (SPOAF=4)!(SPOAF=6) S FORDSAF=1
118 ..I (SPO=5)!(SPO=7) S FORDS=4
119 ..I (SPOAF=5)!(SPOAF=7) S FORDSAF=4
120 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
121 ...S FORDSUB=""
122 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
123 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
124 ...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
125 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
126 ...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=2 Q
127 ...I ($P(SUBTX(SUB),U,5)=4)!($P(SUBTX(SUB),U,5)=6) S FORDSUB=1 Q
128 ...I ($P(SUBTX(SUB),U,5)=5)!($P(SUBTX(SUB),U,5)=7) S FORDSUB=4 Q
129 .
130 .I ((TOP>67419)&(TOP<67422))!((TOP>67422)&(TOP<67425)) D D SPO Q
131 ..I SPO=0 S FORDS=0
132 ..I SPOAF=0 S FORDSAF=0
133 ..I SPO=1 S FORDS=1
134 ..I SPOAF=1 S FORDSAF=1
135 ..I SPO=9 S FORDS=9
136 ..I SPOAF=9 S FORDSAF=9
137 ..I SPO>1,SPO<6 S FORDS=1
138 ..I SPOAF>1,SPOAF<6 S FORDSAF=1
139 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
140 ...S FORDSUB=""
141 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
142 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
143 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
144 ...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<6 S FORDSUB=1 Q
145 .
146 .I (TOP=67422)!((TOP>67699)&(TOP<67730))!((TOP>67769)&(TOP<67780)) D D SPO Q
147 ..I SPO=0 S FORDS=0
148 ..I SPOAF=0 S FORDSAF=0
149 ..I SPO=1 S FORDS=1
150 ..I SPOAF=1 S FORDSAF=1
151 ..I SPO=2 S FORDS=2
152 ..I SPOAF=2 S FORDSAF=2
153 ..I SPO=9 S FORDS=9
154 ..I SPOAF=9 S FORDSAF=9
155 ..I SPO=5 S FORDS=3
156 ..I SPOAF=5 S FORDSAF=3
157 ..I SPO=6 S FORDS=4
158 ..I SPOAF=6 S FORDSAF=4
159 ..I SPO=7 S FORDS=5
160 ..I SPOAF=7 S FORDSAF=5
161 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
162 ...S FORDSUB=""
163 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
164 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
165 ...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
166 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
167 ...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=3 Q
168 ...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=4 Q
169 ...I $P(SUBTX(SUB),U,5)=7 S FORDSUB=5 Q
170 .
171 .I TOP>67499,TOP<67510 D D SPO Q
172 ..I SPO=0 S FORDS=0
173 ..I SPOAF=0 S FORDSAF=0
174 ..I SPO=1 S FORDS=1
175 ..I SPOAF=1 S FORDSAF=1
176 ..I SPO=2 S FORDS=2
177 ..I SPOAF=2 S FORDSAF=2
178 ..I SPO=3 S FORDS=3
179 ..I SPOAF=3 S FORDSAF=3
180 ..I SPO=4 S FORDS=4
181 ..I SPOAF=4 S FORDSAF=4
182 ..I SPO=9 S FORDS=9
183 ..I SPOAF=9 S FORDSAF=9
184 ..I SPO=5 S FORDS=4
185 ..I SPOAF=5 S FORDSAF=4
186 ..I SPO=6 S FORDS=5
187 ..I SPOAF=6 S FORDSAF=5
188 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
189 ...S FORDSUB=""
190 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
191 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
192 ...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
193 ...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=3 Q
194 ...I $P(SUBTX(SUB),U,5)=4 S FORDSUB=4 Q
195 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
196 ...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=4 Q
197 ...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=5 Q
198 .
199 .I TOP>67529,TOP<67540 D D SPO Q
200 ..I SPO=0 S FORDS=0
201 ..I SPOAF=0 S FORDSAF=0
202 ..I SPO=1 S FORDS=1
203 ..I SPOAF=1 S FORDSAF=1
204 ..I SPO=2 S FORDS=2
205 ..I SPOAF=2 S FORDSAF=2
206 ..I SPO=3 S FORDS=3
207 ..I SPOAF=3 S FORDSAF=3
208 ..I SPO=9 S FORDS=9
209 ..I SPOAF=9 S FORDSAF=9
210 ..I SPO=4 S FORDS=3
211 ..I SPOAF=4 S FORDSAF=3
212 ..I SPO=5 S FORDS=4
213 ..I SPOAF=5 S FORDSAF=4
214 ..I (SPO=6)!(SPO=7) S FORDS=5
215 ..I (SPOAF=6)!(SPOAF=7) S FORDSAF=5
216 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
217 ...S FORDSUB=""
218 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
219 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
220 ...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
221 ...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=3 Q
222 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
223 ...I $P(SUBTX(SUB),U,5)=4 S FORDSUB=3 Q
224 ...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=4 Q
225 ...I ($P(SUBTX(SUB),U,5)=6)!($P(SUBTX(SUB),U,5)=7) S FORDSUB=5 Q
226 .
227 .I ((TOP>67759)&(TOP<67769))!(TOP=67809) D D SPO Q
228 ..I SPO=0 S FORDS=0
229 ..I SPOAF=0 S FORDSAF=0
230 ..I SPO=1 S FORDS=1
231 ..I SPOAF=1 S FORDSAF=1
232 ..I SPO=9 S FORDS=9
233 ..I SPOAF=9 S FORDSAF=9
234 ..I SPO>1,SPO<6 S FORDS=1
235 ..I SPOAF>1,SPOAF<6 S FORDSAF=1
236 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
237 ...S FORDSUB=""
238 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
239 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
240 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
241 ...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<6 S FORDSUB=1 Q
242 .
243 .D D SPO Q
244 ..I SPO=0 S FORDS=0
245 ..I SPOAF=0 S FORDSAF=0
246 ..I SPO=1 S FORDS=1
247 ..I SPOAF=1 S FORDSAF=1
248 ..I SPO=2 S FORDS=2
249 ..I SPOAF=2 S FORDSAF=2
250 ..I SPO=3 S FORDS=3
251 ..I SPOAF=3 S FORDSAF=3
252 ..I SPO=4 S FORDS=4
253 ..I SPOAF=4 S FORDSAF=4
254 ..I SPO=5 S FORDS=5
255 ..I SPOAF=5 S FORDSAF=5
256 ..I SPO=9 S FORDS=9
257 ..I SPOAF=9 S FORDSAF=9
258 ..I SPO>0,FORDS="" S FORDS=9
259 ..I SPOAF>0,FORDSAF="" S FORDSAF=9
260 ..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
261 ...S FORDSUB=""
262 ...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
263 ...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
264 ...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
265 ...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=3 Q
266 ...I $P(SUBTX(SUB),U,5)=4 S FORDSUB=4 Q
267 ...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=5 Q
268 ...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
269 ...I $P(SUBTX(SUB),U,5)>0,FORDSUB="" S FORDSUB=9 Q
270 Q
271 ;
272SPO S:FORDS'="" $P(^ONCO(165.5,IEN,3.1),U,33)=FORDS
273 S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,34)=FORDSAF
274 Q
275 ;
276SUBSPO S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,2),U,33)=FORDSUB
277 Q
Note: See TracBrowser for help on using the repository browser.