source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCP36E.m@ 1354

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1ONCP36E ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
2 ;;2.11;ONCOLOGY;**36**;Mar 07, 1995
3 ;
4 ;HORMONE THERAPY
5 D D HT
6 .S (FORDS,FORDSAF)=""
7 .S HT=$$GET1^DIQ(165.5,IEN,54.2,"I")
8 .S HTDT=$$GET1^DIQ(165.5,IEN,54,"I")
9 .S HTAF=$$GET1^DIQ(165.5,IEN,54.3,"I")
10 .S HTAFDT=$$GET1^DIQ(165.5,IEN,54.4,"I")
11 .S RFNHT=$$GET1^DIQ(165.5,IEN,77,"I")
12 .I HT=0 S FORDS="00"
13 .I HTAF=0 S FORDSAF="00"
14 .I HT=1 S FORDS="01"
15 .I HTAF=1 S FORDSAF="01"
16 .I HT=2 S FORDS="00"
17 .I HTAF=2 S FORDSAF="00"
18 .I HT=3 S FORDS="01"
19 .I HTAF=3 S FORDSAF="01"
20 .I HT>3,RFNHT=1 S FORDS="00"
21 .I HTAF>3,RFNHT=1 S FORDSAF="00"
22 .I HT>3,RFNHT=2 S FORDS=82
23 .I HTAF>3,RFNHT=2 S FORDSAF=82
24 .I HT>3,RFNHT=6 S FORDS=86
25 .I HTAF>3,RFNHT=6 S FORDSAF=86
26 .I HT>3,RFNHT=7 S FORDS=87
27 .I HTAF>3,RFNHT=7 S FORDSAF=87
28 .I HT>3,RFNHT=8 S FORDS=88
29 .I HTAF>3,RFNHT=8 S FORDSAF=88
30 .I HT=7 S FORDS=87
31 .I HTAF=7 S FORDSAF=87
32 .I HT=8 S FORDS=88
33 .I HTAF=8 S FORDSAF=88
34 .I HT=9 S FORDS=99
35 .I HTAF=9 S FORDSAF=99
36 .I FORDS="",HT'="",RFNHT'="" S FORDS="00"
37 .I FORDSAF="",HTAF'="",RFNHT'="" S FORDSAF="00"
38 .S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBHT
39 ..S FORDSUB=""
40 ..I $P(SUBTX(SUB),U,7)=0 S FORDSUB="00" Q
41 ..I $P(SUBTX(SUB),U,7)=1 S FORDSUB="01" Q
42 ..I $P(SUBTX(SUB),U,7)=2 S FORDSUB="00" Q
43 ..I $P(SUBTX(SUB),U,7)=3 S FORDSUB="01" Q
44 ..I $P(SUBTX(SUB),U,7)=7 S FORDSUB=87 Q
45 ..I $P(SUBTX(SUB),U,7)=8 S FORDSUB=88 Q
46 ..I $P(SUBTX(SUB),U,7)=9 S FORDSUB=99 Q
47 ;
48 ;IMMUNOTHERAPY
49 D D IT
50 .S (FORDS,FORDSAF)=""
51 .S IT=$$GET1^DIQ(165.5,IEN,55.2,"I")
52 .S ITDT=$$GET1^DIQ(165.5,IEN,55,"I")
53 .S ITAF=$$GET1^DIQ(165.5,IEN,55.3,"I")
54 .S ITAFDT=$$GET1^DIQ(165.5,IEN,55.4,"I")
55 .I IT=0 S FORDS="00"
56 .I ITAF=0 S FORDSAF="00"
57 .I IT=1 S FORDS="01"
58 .I ITAF=1 S FORDSAF="01"
59 .I IT>1,IT<6 S FORDS="00"
60 .I ITAF>1,ITAF<6 S FORDSAF="00"
61 .I IT=6 S FORDS="01"
62 .I ITAF=6 S FORDSAF="01"
63 .I IT=7 S FORDS=87
64 .I ITAF=7 S FORDSAF=87
65 .I IT=8 S FORDS=88
66 .I ITAF=8 S FORDSAF=88
67 .I IT=9 S FORDS="00"
68 .I ITAF=9 S FORDSAF="00"
69 .S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBIT
70 ..S FORDSUB=""
71 ..I $P(SUBTX(SUB),U,8)=0 S FORDSUB="00" Q
72 ..I $P(SUBTX(SUB),U,8)=1 S FORDSUB="01" Q
73 ..I $P(SUBTX(SUB),U,8)>1,$P(SUBTX(SUB),U,8)<6 S FORDSUB="00"
74 ..I $P(SUBTX(SUB),U,8)=6 S FORDSUB="01" Q
75 ..I $P(SUBTX(SUB),U,8)=7 S FORDSUB=87 Q
76 ..I $P(SUBTX(SUB),U,8)=8 S FORDSUB=88 Q
77 ..I $P(SUBTX(SUB),U,8)=9 S FORDSUB="00" Q
78 ;
79 ;HEMA TRANS/ENDOCRINE PROC
80 D D HTEP
81 .S (FORDS,FORDSAF)=""
82 .I $P(^ONCO(165.5,IEN,3.1),U,36)'="" Q
83 .I (HT<1)!(HT>3),HTAF=7,IT=7,(ITAF<2)!(ITAF>6) S FORDS=11 Q
84 .I HT=7,(HTAF<2)!(HTAF>3),IT=7,(ITAF<2)!(ITAF>6) S FORDS=11 Q
85 .I (HT<2)!(HT>3),HTAF=7,(IT<2)!(IT>6),ITAF=7 S FORDS=11 Q
86 .I HT=7,(HTAF<2)!(HTAF>3),(IT<2)!(IT>6),ITAF=7 S FORDS=11 Q
87 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),RFNHT=7,IT=7,(ITAF<2)!(ITAF>6) S FORDS=11 Q
88 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),RFNHT=7,(IT<2)!(IT>6),ITAF=7 S FORDS=11 Q
89 .I (HT=0)!(HT=1),(HTAF<2)!(HTAF>3),(IT=0)!(IT=1),(ITAF<2)!(ITAF>6) S FORDS=1 Q
90 .I (HT<2)!(HT>3),(HTAF=0)!(HTAF=1),(IT=0)!(IT=1),(ITAF<2)!(ITAF>6) S FORDS=1 Q
91 .I (HT=0)!(HT=1),(HTAF<2)!(HTAF>3),(IT<2)!(IT>6),(ITAF=0)!(ITAF=1) S FORDS=1 Q
92 .I (HT<2)!(HT>3),(HTAF=0)!(HTAF=1),(IT<2)!(IT>6),(ITAF=0)!(ITAF=1) S FORDS=1 Q
93 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),IT=2,ITAF=3 S FORDS=2 Q
94 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),IT=3,ITAF=2 S FORDS=2 Q
95 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),(IT=4)!(IT=6),ITAF'=5 S FORDS=2 Q
96 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),IT'=5,(ITAF=4)!(ITAF=6) S FORDS=2 Q
97 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),IT=2,(ITAF<3)!(ITAF>5) S FORDS=3 Q
98 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),(IT<3)!(IT>5),ITAF=2 S FORDS=3 Q
99 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),IT=3,(ITAF<2)!(ITAF>5) S FORDS=4 Q
100 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),(IT<2)!(IT>5),ITAF=3 S FORDS=4 Q
101 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),IT=5,(ITAF<2)!(ITAF>4) S FORDS=5 Q
102 .I (HT<2)!(HT>3),(HTAF<2)!(HTAF>3),(IT<2)!(IT>4),ITAF=5 S FORDS=5 Q
103 .I (HT=2)!(HT=3),(IT<2)!(IT>6),(ITAF<2)!(ITAF>6) S FORDS=6 Q
104 .I (HTAF=2)!(HTAF=3),(IT<2)!(IT>6),(ITAF<2)!(ITAF>6) S FORDS=6 Q
105 .I (HT=2)!(HT=3),(ITAF>1)&(ITAF<7) S FORDS=7 Q
106 .I (HTAF=2)!(HTAF=3),(ITAF>1)&(ITAF<7) S FORDS=7 Q
107 .I (HT=2)!(HT=3),(IT>1)&(IT<7) S FORDS=7 Q
108 .I (HTAF=2)!(HTAF=3),(IT>1)&(IT<7) S FORDS=7 Q
109 .I IT=5,(ITAF=2)!(ITAF=3)!(ITAF=4)!(ITAF=6) S FORDS=13 Q
110 .I (IT=2)!(IT=3)!(IT=4)!(IT=6),ITAF=5 S FORDS=13 Q
111 Q
112 ;
113HT S:FORDS'="" $P(^ONCO(165.5,IEN,3),U,16)=FORDS
114 S:(FORDS="00")!(FORDS=82)!(FORDS=86)!(FORDS=87) $P(^ONCO(165.5,IEN,3),U,14)="0000000"
115 S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,16)=FORDSAF
116 S:(FORDSAF="00")!(FORDSAF=82)!(FORDSAF=86)!(FORDSAF=87) $P(^ONCO(165.5,IEN,3.1),U,17)="0000000"
117 Q
118 ;
119SUBHT S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,0),U,7)=FORDSUB
120 S:(FORDSUB="00")!(FORDSUB=87) $P(^ONCO(165.5,IEN,4,SUB,0),U,14)="0000000"
121 Q
122 ;
123IT S:FORDS'="" $P(^ONCO(165.5,IEN,3),U,19)=FORDS
124 S:(FORDS="00")!(FORDS=87) $P(^ONCO(165.5,IEN,3),U,17)="0000000"
125 S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,18)=FORDSAF
126 S:(FORDSAF="00")!(FORDSAF=87) $P(^ONCO(165.5,IEN,3.1),U,19)="0000000"
127 Q
128 ;
129SUBIT S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,0),U,8)=FORDSUB
130 S:(FORDSUB="00")!(FORDSUB=87) $P(^ONCO(165.5,IEN,4,SUB,0),U,15)="0000000"
131 Q
132 ;
133HTEP S:FORDS'="" $P(^ONCO(165.5,IEN,3.1),U,36)=FORDS
134 S:(FORDS=1)!(FORDS=11) $P(^ONCO(165.5,IEN,3.1),U,35)="0000000"
135 S:(FORDS=2)!(FORDS=3)!(FORDS=4)!(FORDS=5) $P(^ONCO(165.5,IEN,3.1),U,35)=$S(+$G(ITDT)>0:$G(ITDT),1:$G(ITAFDT))
136 S:(FORDS=6)!(FORDS=7) $P(^ONCO(165.5,IEN,3.1),U,35)=$S(+$G(HTDT)>0:$G(HTDT),1:$G(HTAFDT))
137 S:FORDS=13 $P(^ONCO(165.5,IEN,3.1),U,35)=9999999
138 Q
Note: See TracBrowser for help on using the repository browser.