source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCP36A2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 4.1 KB
Line 
1ONCP36A2 ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
2 ;;2.11;ONCOLOGY;**36**;Mar 07, 1995
3 ;
4 D Q
5 .D Q
6 ..I TOP=67619 D D SPP Q
7 ...I SPP>9,SPP<18 S FORDS=18
8 ...I SPPAF>9,SPP<18 S FORDSAF=18
9 ...I SPP=40 S FORDS=10
10 ...I SPPAF=40 S FORDSAF=10
11 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
12 ....S FORDSUB=""
13 ....I $P(SUBTX(SUB),U,1)>9,$P(SUBTX(SUB),U,1)<18 S FORDSUB=18 Q
14 ....I $P(SUBTX(SUB),U,1)=40 S FORDSUB=10 Q
15 ..
16 ..I TOP>67619,TOP<67630 D D SPP Q
17 ...I SPP=10 S FORDS=9
18 ...I SPPAF=10 S FORDSAF=9
19 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
20 ....S FORDSUB=""
21 ....I $P(SUBTX(SUB),U,1)=10 S FORDSUB=9 Q
22 ..
23 ..I TOP>67669,TOP<67680 D D SPP Q
24 ...I SPP=60,RR=1 S FORDS=28
25 ...I SPPAF=60,RR=1 S FORDSAF=28
26 ...I SPP=60,RR=2 S FORDS=29
27 ...I SPPAF=60,RR=2 S FORDSAF=29
28 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
29 ....S FORDSUB=""
30 ....I $P(SUBTX(SUB),U,1)=60,$P(SUBTX(SUB),U,2)=1 S FORDSUB=28 Q
31 ....I $P(SUBTX(SUB),U,1)=60,$P(SUBTX(SUB),U,2)=2 S FORDSUB=29 Q
32 ..
33 ..I TOP>67699,TOP<67730 D D SPP Q
34 ...I SPP>20,SPP<33 S FORDS=3
35 ...I SPPAF>20,SPPAF<33 S FORDSAF=3
36 ...I SPP>40,SPP<44 S FORDS=10
37 ...I SPPAF>40,SPPAF<44 S FORDSAF=10
38 ...I (SPP=50)!(SPP=60) S FORDS=18
39 ...I (SPPAF=50)!(SPPAF=60) S FORDSAF=18
40 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
41 ....S FORDSUB=""
42 ....I $P(SUBTX(SUB),U,1)>20,$P(SUBTX(SUB),U,1)<33 S FORDSUB=3 Q
43 ....I $P(SUBTX(SUB),U,1)>40,$P(SUBTX(SUB),U,1)<44 S FORDSUB=10 Q
44 ....I $P(SUBTX(SUB),U,1)=50 S FORDSUB=18 Q
45 ....I $P(SUBTX(SUB),U,1)=60 S FORDSUB=18 Q
46 ..
47 ..I TOP=67739 D D SPP Q
48 ...I SPP=10 S FORDS=16
49 ...I SPPAF=10 S FORDSAF=16
50 ...I SPP=11 S FORDS=17
51 ...I SPPAF=11 S FORDSAF=17
52 ...I SPP=12 S FORDS=18
53 ...I SPPAF=12 S FORDSAF=18
54 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
55 ....S FORDSUB=""
56 ....I $P(SUBTX(SUB),U,1)=10 S FORDSUB=16 Q
57 ....I $P(SUBTX(SUB),U,1)=11 S FORDSUB=17 Q
58 ....I $P(SUBTX(SUB),U,1)=12 S FORDSUB=18 Q
59 ..
60 ..I TOP>67769,TOP<67780 D D SPP Q
61 ...I SPP=10 S FORDS=2
62 ...I SPPAF=10 S FORDSAF=2
63 ...I SPP=30 S FORDS=5
64 ...I SPPAF=30 S FORDSAF=5
65 ...I SPP=31 S FORDS=6
66 ...I SPPAF=31 S FORDSAF=6
67 ...I SPP=32 S FORDS=7
68 ...I SPPAF=32 S FORDSAF=7
69 ...I SPP=40 S FORDS=8
70 ...I SPPAF=40 S FORDSAF=8
71 ...I SPP=41 S FORDS=9
72 ...I SPPAF=41 S FORDSAF=9
73 ...I SPP=42 S FORDS=10
74 ...I SPPAF=42 S FORDSAF=10
75 ...I SPP=50 S FORDS=11
76 ...I SPPAF=50 S FORDSAF=11
77 ...I SPP=51 S FORDS=12
78 ...I SPPAF=51 S FORDSAF=12
79 ...I SPP=52 S FORDS=13
80 ...I SPPAF=52 S FORDSAF=13
81 ...I SPP=60 S FORDS=14
82 ...I SPPAF=60 S FORDSAF=14
83 ...I SPP=61 S FORDS=15
84 ...I SPPAF=61 S FORDSAF=15
85 ...I SPP=62 S FORDS=16
86 ...I SPPAF=62 S FORDSAF=16
87 ...I SPP=90 S FORDS=17
88 ...I SPPAF=90 S FORDSAF=17
89 ...I SPP=99 S FORDS=18
90 ...I SPPAF=99 S FORDSAF=18
91 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
92 ....S FORDSUB=""
93 ....I $P(SUBTX(SUB),U,1)=10 S FORDSUB=2 Q
94 ....I $P(SUBTX(SUB),U,1)=30 S FORDSUB=5 Q
95 ....I $P(SUBTX(SUB),U,1)=31 S FORDSUB=6 Q
96 ....I $P(SUBTX(SUB),U,1)=32 S FORDSUB=7 Q
97 ....I $P(SUBTX(SUB),U,1)=40 S FORDSUB=8 Q
98 ....I $P(SUBTX(SUB),U,1)=41 S FORDSUB=9 Q
99 ....I $P(SUBTX(SUB),U,1)=42 S FORDSUB=10 Q
100 ....I $P(SUBTX(SUB),U,1)=50 S FORDSUB=11 Q
101 ....I $P(SUBTX(SUB),U,1)=51 S FORDSUB=12 Q
102 ....I $P(SUBTX(SUB),U,1)=52 S FORDSUB=13 Q
103 ....I $P(SUBTX(SUB),U,1)=60 S FORDSUB=14 Q
104 ....I $P(SUBTX(SUB),U,1)=61 S FORDSUB=15 Q
105 ....I $P(SUBTX(SUB),U,1)=62 S FORDSUB=16 Q
106 ....I $P(SUBTX(SUB),U,1)=90 S FORDSUB=17 Q
107 ....I $P(SUBTX(SUB),U,1)=99 S FORDSUB=18 Q
108 ..
109 ..I TOP>67759,TOP<67769 D D SPP Q
110 ...I SPP'="" S FORDS=1
111 ...I SPPAF'="" S FORDSAF=1
112 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
113 ....I $P(SUBTX(SUB),U,1)'="" S FORDSUB=1
114 ..
115 ..I TOP=67809 D D SPP Q
116 ...I SPP'="" S FORDS=1
117 ...I SPPAF'="" S FORDSAF=1
118 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
119 ....I $P(SUBTX(SUB),U,1)'="" S FORDSUB=1
120 ..D SPP Q
121 ;
122SPP I FORDS'="" S $P(^ONCO(165.5,IEN,3.1),U,29)=FORDS
123 E S $P(^ONCO(165.5,IEN,3.1),U,29)=SPPPNT
124 I FORDSAF'="" S $P(^ONCO(165.5,IEN,3.1),U,30)=FORDSAF
125 E S $P(^ONCO(165.5,IEN,3.1),U,30)=SPPAFPNT
126 Q
127 ;
128SUBTX S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,0),U,4)=FORDSUB
129 Q
Note: See TracBrowser for help on using the repository browser.