source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCP36B.m@ 1766

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

initial load of WorldVistAEHR
File size: 6.9 KB
RevLine 
[613]1ONCP36B ;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,2)="Y"
5 .I $P($G(^ONCO(165.5,IEN,27)),U,2)="Y" Q
6 .S FORDS="" D
7 ..I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SM Q
8 ...I SM'="" S FORDS=9
9 ..I TOP>67419,TOP<67422 D D SM Q
10 ...I SM'="" S FORDS=9
11 ..I TOP>67422,TOP<67425 D D SM Q
12 ...I SM'="" S FORDS=9
13 ..I TOP>67759,TOP<67769 D D SM Q
14 ...I SM'="" S FORDS=9
15 ..I TOP=67809 D D SM Q
16 ...I SM'="" S FORDS=9
17 ..I TOP>67769,TOP<67780,((HIST3>9589)&(HIST3<9597))!((HIST3>9649)&(HIST3<9720))!((HIST3>9726)&(HIST3<9730)) D D SM Q
18 ...I SM'="" S FORDS=9
19 ..I TOP>67769,TOP<67780,((HIST2>9589)&(HIST2<9597))!((HIST2>9649)&(HIST2<9720))!((HIST2>9726)&(HIST2<9730)) D D SM Q
20 ...I SM'="" S FORDS=9
21 ..I SPP'="",+SPP=0 D D SM Q
22 ...I SM'="" S FORDS=8
23 ..I ((TOP>67499)&(TOP<67510))!(TOP=67619) D D SM Q
24 ...I SM=0 S FORDS=0
25 ...I SM=1 S FORDS=1
26 ...I SM=2 S FORDS=2
27 ...I SM=7 S FORDS=7
28 ...I SM=8 S FORDS=8
29 ...I SM=9 S FORDS=9
30 ...I (SM=3)!(SM=4) S FORDS=2
31 ...I SM=5 S FORDS=3
32 ..I TOP=67569 D D SM Q
33 ...I SM=0 S FORDS=9
34 ...I (SM=1)!(SM=2)!(SM=3)!(SM=4) S FORDS=3
35 ...I SM=8 S FORDS=8
36 ...I SM=9 S FORDS=9
37 ..I SM=0 S FORDS=0 D SM Q
38 ..I SM=1 S FORDS=1 D SM Q
39 ..I SM=2 S FORDS=2 D SM Q
40 ..I SM=5 S FORDS=3 D SM Q
41 ..I SM=7 S FORDS=7 D SM Q
42 ..I SM=8 S FORDS=8 D SM Q
43 ..I SM=9 S FORDS=9 D SM Q
44 ..S FORDS=9 D SM Q
45 ..
46 D S $P(^ONCO(165.5,IEN,27),U,3)="Y"
47 .I $P($G(^ONCO(165.5,IEN,27)),U,3)="Y" Q
48 .S (FORDS,FORDSAF)="" D
49 ..I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SLN Q
50 ...I SLN'="" S FORDS=9
51 ...I SLNAF'="" S FORDSAF=9
52 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
53 ....S FORDSUB=""
54 ....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9
55 ..
56 ..I ((TOP>66999)&(TOP<67139))!((TOP>67319)&(TOP<67330))!(TOP=67739) D D SLN Q
57 ...I SLN=0 S FORDS=0
58 ...I SLNAF=0 S FORDSAF=0
59 ...I SLN=1 S FORDS=1
60 ...I SLNAF=1 S FORDSAF=1
61 ...I SLN=9 S FORDS=9
62 ...I SLNAF=9 S FORDSAF=9
63 ...I ((SLN=2)!(SLN=4)!(SLN=5)),NNE>95,NNE<99 S FORDS=3
64 ...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),NNEAF>95,NNEAF<99 S FORDSAF=3
65 ...I ((SLN=2)!(SLN=4)!(SLN=5)),((NNE=99)!(NNE="")) S FORDS=9
66 ...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),((NNEAF=99)!(NNEAF="")) S FORDSAF=9
67 ...I SLN=3,((NNE>95)!(NNE="")) S FORDS=3
68 ...I SLNAF=3,((NNEAF>95)!(NNEAF="")) S FORDSAF=3
69 ...I ((SLN>1)&(SLN<6)),+NNE>0,+NNE<4 S FORDS=4
70 ...I ((SLNAF>1)&(SLNAF<6)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
71 ...I ((SLN>1)&(SLN<6)),+NNE>3,+NNE<91 S FORDS=5
72 ...I ((SLNAF>1)&(SLNAF<6)),+NNEAF>3,+NNEAF<91 S FORDSAF=5
73 ...I ((SLN>1)&(SLN<6)),NNE=95 S FORDS=1
74 ...I ((SLNAF>1)&(SLNAF<6)),NNEAF=95 S FORDSAF=1
75 ...I SLN>0,FORDS="" S FORDS=9
76 ...I SLNAF>0,FORDSAF="" S FORDSAF=9
77 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
78 ....S FORDSUB=""
79 ....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
80 ....I $P(SUBTX(SUB),U,3)=1 S FORDSUB=1 Q
81 ....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
82 ....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)>95,+$P(SUBTX(SUB),U,4)<99 S FORDSUB=3 Q
83 ....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),((+$P(SUBTX(SUB),U,4)=99)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=9 Q
84 ....I $P(SUBTX(SUB),U,3)=3,((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
85 ....I (($P(SUBTX(SUB),U,3)>1)&($P(SUBTX(SUB),U,3)<6)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
86 ....I (($P(SUBTX(SUB),U,3)>1)&($P(SUBTX(SUB),U,3)<6)),+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
87 ....I (($P(SUBTX(SUB),U,3)>1)&($P(SUBTX(SUB),U,3)<6)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
88 ....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
89 ..
90 ..I TOP>67419,TOP<67422 D D SLN Q
91 ...I SLN'="" S FORDS=9
92 ...I SLNAF'="" S FORDSAF=9
93 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
94 ....S FORDSUB=""
95 ....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
96 ..
97 ..I TOP>67422,TOP<67425 D D SLN Q
98 ...I SLN'="" S FORDS=9
99 ...I SLNAF'="" S FORDSAF=9
100 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
101 ....S FORDSUB=""
102 ....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
103 ..
104 ..I TOP>67439,TOP<67450 D D SLN Q
105 ...I SLN=0 S FORDS=0
106 ...I SLNAF=0 S FORDSAF=0
107 ...I SLN=9 S FORDS=9
108 ...I SLNAF=9 S FORDSAF=9
109 ...I SLN=1 S FORDS=2
110 ...I SLNAF=1 S FORDSAF=2
111 ...I SLN=2,+NNE>0,+NNE<4 S FORDS=4
112 ...I SLNAF=2,+NNEAF>0,+NNEAF<4 S FORDSAF=4
113 ...I SLN=2,+NNE>3,+NNE<91 S FORDS=5
114 ...I SLNAF=2,+NNEAF>3,+NNEAF<91 S FORDSAF=5
115 ...I SLN=2,NNE=95 S FORDS=1
116 ...I SLNAF=2,NNEAF=95 S FORDSAF=1
117 ...I SLN=2,((NNE>95)!(NNE="")) S FORDS=3
118 ...I SLNAF=2,((NNEAF>95)!(NNEAF="")) S FORDSAF=3
119 ...I SLN>0,FORDS="" S FORDS=9
120 ...I SLNAF>0,FORDSAF="" S FORDSAF=9
121 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
122 ....S FORDSUB=""
123 ....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
124 ....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
125 ....I $P(SUBTX(SUB),U,3)=1 S FORDSUB=2 Q
126 ....I $P(SUBTX(SUB),U,3)=2,+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
127 ....I $P(SUBTX(SUB),U,3)=2,+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
128 ....I $P(SUBTX(SUB),U,3)=2,+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
129 ....I $P(SUBTX(SUB),U,3)=2,((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
130 ....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
131 ..
132 ..I TOP>67499,TOP<67510 D D SLN Q
133 ...I SLN=0 S FORDS=0
134 ...I SLNAF=0 S FORDSAF=0
135 ...I SLN=9 S FORDS=9
136 ...I SLNAF=9 S FORDSAF=9
137 ...I SLN=1 S FORDS=2
138 ...I SLNAF=1 S FORDSAF=2
139 ...I ((SLN=2)!(SLN=4)!(SLN=5)),+NNE>0,+NNE<4 S FORDS=4
140 ...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
141 ...I ((SLN=2)!(SLN=4)!(SLN=5)),+NNE>3,+NNE<89 S FORDS=5
142 ...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),+NNEAF>3,+NNEAF<89 S FORDSAF=5
143 ...I ((SLN=2)!(SLN=4)!(SLN=5)),NNE=95 S FORDS=1
144 ...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),NNEAF=95 S FORDSAF=1
145 ...I ((SLN=2)!(SLN=4)!(SLN=5)),((NNE>95)!(NNE="")) S FORDS=3
146 ...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),((NNEAF>95)!(NNEAF="")) S FORDSAF=3
147 ...I SLN=3 S FORDS=6
148 ...I SLNAF=3 S FORDSAF=6
149 ...I SLN>0,FORDS="" S FORDS=9
150 ...I SLNAF>0,FORDSAF="" S FORDSAF=9
151 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
152 ....S FORDSUB=""
153 ....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
154 ....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
155 ....I $P(SUBTX(SUB),U,3)=1 S FORDSUB=2 Q
156 ....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
157 ....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
158 ....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
159 ....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
160 ....I $P(SUBTX(SUB),U,3)=3 S FORDSUB=6 Q
161 ....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
162 ..
163 ..D ^ONCP36B1 Q
164 Q
165 ;
166SM S:FORDS'="" $P(^ONCO(165.5,IEN,3),U,28)=FORDS
167 Q
168 ;
169SLN S:FORDS'="" $P(^ONCO(165.5,IEN,3.1),U,31)=FORDS
170 S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,32)=FORDSAF
171 Q
172 ;
173SUBSLN S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,2),U,32)=FORDSUB
174 Q
Note: See TracBrowser for help on using the repository browser.