source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCNTX1.m@ 789

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

initial load of WorldVistAEHR
File size: 7.2 KB
Line 
1ONCNTX1 ;Hines OIFO/GWB; No treatment stuffing; 02/5/98
2 ;;2.11;ONCOLOGY;**15,16,19,22,25,26,27,32,36,37,38,39,41,42,45,46**;Mar 07, 1995;Build 39
3 ;
4NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
5 S $P(^ONCO(165.5,DA,3.1),U,5)="00"
6 S $P(^ONCO(165.5,D0,3.1),U,6)="0000000"
7 S DR="58.4;58.5" D DIQ1^ONCNTX
8 W:$D(NTX) !,"SURG DX/STAGING PROC @FAC.....: "_ONC(165.5,DA,58.4,"E")
9 W !,"SURG DX/STAGING PROC @FAC DATE: ",ONC(165.5,DA,58.5,"E")
10 Q
11 ;
12SURATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
13 S $P(^ONCO(165.5,DA,3.1),U,7)=$S(DATEDX>2971231:1,1:"00")
14 S DR=50.2 D DIQ1^ONCNTX
15 W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(R): ",ONC(165.5,DA,50.2,"E")
16 K ONC
17 Q
18 ;
19SURATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
20 S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1)
21 I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D G SUR1
22 .S $P(^ONCO(165.5,DA,3.1),U,30)=1
23 S $P(^ONCO(165.5,DA,3.1),U,30)=$S(DATEDX>2971231:1,1:"00")
24SUR1 S $P(^ONCO(165.5,DA,3.1),U,8)="0000000"
25 S DR="58.7;50.3" D DIQ1^ONCNTX
26 W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(F): ",ONC(165.5,DA,58.7,"E")
27 W !,"MOST DEFINITIVE SURG @FAC DATE.: ",ONC(165.5,DA,50.3,"E")
28 K ONC,TXDT Q
29 ;
30NODATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
31 S $P(^ONCO(165.5,DA,3.1),U,9)=1
32 S $P(^ONCO(165.5,DA,3.1),U,11)="00"
33 S DR="138.1;140.1" D DIQ1^ONCNTX
34 W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(R): ",ONC(165.5,DA,138.1,"E")
35 W !,"NUMBER OF LN REMOVED @FAC...(R): ",ONC(165.5,DA,140.1,"E")
36 Q
37 ;
38NODEATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
39 S $P(^ONCO(165.5,DA,3.1),U,32)=0
40 S $P(^ONCO(165.5,D0,3.1),U,23)="0000000"
41 S DR="138.5;138.3" D DIQ1^ONCNTX
42 W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(F): ",ONC(165.5,DA,138.5,"E")
43 W !,"SCOPE OF LN SURGERY @FAC DATE..: ",ONC(165.5,DA,138.3,"E")
44 Q
45 ;
46SPOATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
47 S $P(^ONCO(165.5,DA,3.1),U,10)=1
48 S DR=139.1 D DIQ1^ONCNTX
49 W:$D(NTX) !,"SURG PROC/OTHER SITE @FAC...(R): ",ONC(165.5,DA,139.1,"E")
50 Q
51 ;
52SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
53 S $P(^ONCO(165.5,DA,3.1),U,10)=1
54 S DR=139.1 D DIQ1^ONCNTX
55 W:$D(NTX) !,"SURG PROC/OTHER SITE @FAC...(R): ",ONC(165.5,DA,139.1,"E")
56 Q
57 ;
58SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
59 S $P(^ONCO(165.5,DA,3.1),U,34)=0
60 S $P(^ONCO(165.5,D0,3.1),U,25)="0000000"
61 S DR="139.5;139.3" D DIQ1^ONCNTX
62 W:$D(NTX) !,"SURG PROC/OTHER SITE @FAC...(F): ",ONC(165.5,DA,139.5,"E")
63 W !,"SURG PROC/OTHER SITE @FAC DATE.: ",ONC(165.5,DA,139.3,"E")
64 Q
65 ;
66RADATF ;RADIATION @FAC (165.5,51.4)
67 S $P(^ONCO(165.5,DA,3.1),U,12)=0
68 S RFNR=$P($G(^ONCO(165.5,DA,3)),U,35)
69 I RFNR'=8 D
70 .S $P(^ONCO(165.5,DA,3.1),U,13)="0000000"
71 I RFNR=8 D
72 .S $P(^ONCO(165.5,DA,3.1),U,13)=8888888
73 S DR="51.4;51.5" D DIQ1^ONCNTX
74 W:$D(NTX) !,"RADIATION @FAC.................: "_ONC(165.5,DA,51.4,"E")
75 W !,"RADIATION @FAC DATE............: ",ONC(165.5,DA,51.5,"E")
76 Q
77 ;
78RSSQ ;RADIATION/SURGERY SEQUENCE (165.5,51.3)
79 S $P(^ONCO(165.5,DA,3),U,7)=0
80 W !,"RADIATION/SURGERY SEQUENCE.....: No rad and/or surg"
81 Q
82 ;
83CHEMATF ;CHEMOTHERAPY @FAC (165.5,53.3)
84 S $P(^ONCO(165.5,DA,3.1),U,14)="00"
85 I $D(NTX) D
86 .N DR,DP,DL
87 .S DIE="^ONCO(165.5,",DR=53.3 D ^DIE
88CMATFDT S $P(^ONCO(165.5,DA,3.1),U,15)="0000000"
89 S DR="53.3;53.4" D DIQ1^ONCNTX
90 W !,"CHEMOTHERAPY @FAC DATE........: ",ONC(165.5,DA,53.4,"E")
91 W !
92 Q
93 ;
94HTATF ;HORMONE THERAPY @FAC (165.5,54.3)
95 S $P(^ONCO(165.5,DA,3.1),U,16)="00"
96 I $D(NTX) D
97 .N DR,DP,DL
98 .S DIE="^ONCO(165.5,",DR=54.3 D ^DIE
99HTATFDT S $P(^ONCO(165.5,DA,3.1),U,17)="0000000"
100 S DR="54.3;54.4" D DIQ1^ONCNTX
101 W !,"HORMONE THERAPY @FAC DATE.....: ",ONC(165.5,DA,54.4,"E")
102 W !
103 Q
104 ;
105IMMATF ;IMMUNOTHERAPY @FAC (165.5,55.3)
106 S $P(^ONCO(165.5,DA,3.1),U,18)="00"
107 I $D(NTX) D
108 .N DR,DP,DL
109 .S DIE="^ONCO(165.5,",DR=55.3 D ^DIE
110IMATFDT S $P(^ONCO(165.5,DA,3.1),U,19)="0000000"
111 S DR="55.3;55.4" D DIQ1^ONCNTX
112 W !,"IMMUNOTHERAPY @FAC DATE.......: ",ONC(165.5,DA,55.4,"E")
113 W !
114 Q
115 ;
116OTHATF ;OTHER TREATMENT @FAC (165.5,57.3)
117 I $G(X)'=7 S $P(^ONCO(165.5,DA,3.1),U,20)=0
118 S $P(^ONCO(165.5,DA,3.1),U,21)="0000000"
119 S DR="57.3;57.4" D DIQ1^ONCNTX
120 W:$D(NTX) !,"OTHER TREATMENT @FAC..........: "_ONC(165.5,DA,57.3,"E")
121 W !,"OTHER TREATMENT @FAC DATE.....: ",ONC(165.5,DA,57.4,"E")
122 Q
123 ;
124HOR ;HORMONE THERAPY (165.5,54.2)
125 I $D(NTX) D
126 .N DR,DP,DL
127 .S DIE="^ONCO(165.5,",DR=54.2 D ^DIE
128 S TXDT=$P(^ONCO(165.5,DA,3),U,14)_"H"
129 K ^ONCO(165.5,"ATX",DA,TXDT)
130 S $P(^ONCO(165.5,DA,3),U,14)="0000000" D HTDT^ONCATF1
131 S ^ONCO(165.5,"ATX",DA,"0000000H")=""
132 K ^ONCO(165.5,DA,18)
133 N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
134 S DR="54.2;54" D EN^DIQ1
135 W !,"HORMONE THERAPY DATE..........: ",ONC(165.5,DA,54,"E")
136 K ONC Q
137 ;
138IMM ;IMMUNOTHERAPY (165.5,55.2)
139 I $D(NTX) D
140 .N DR,DP,DL
141 .S DIE="^ONCO(165.5,",DR=55.2 D ^DIE
142 S TXDT=$P(^ONCO(165.5,DA,3),U,17)_"B"
143 K ^ONCO(165.5,"ATX",DA,TXDT)
144 S $P(^ONCO(165.5,DA,3),U,17)="0000000" D IMMDT^ONCATF1
145 S ^ONCO(165.5,"ATX",DA,"0000000B")=""
146 K ^ONCO(165.5,DA,20)
147 N DI,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
148 S DR="55.2;55" D EN^DIQ1
149 W !,"IMMUNOTHERAPY DATE:...........: ",ONC(165.5,DA,55,"E")
150 K ONC Q
151 ;
152HTEP ;HEMA TRANS/ENDOCRINE PROC (165.5,153)
153 I $D(NTX) D
154 .N DR,DP,DL
155 .S DIE="^ONCO(165.5,",DR=153 D ^DIE
156 S TXDT=$P(^ONCO(165.5,DA,3.1),U,35)_"E"
157 K ^ONCO(165.5,"ATX",DA,TXDT)
158 S $P(^ONCO(165.5,DA,3.1),U,35)="0000000"
159 S ^ONCO(165.5,"ATX",DA,"0000000E")=""
160 N DI,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
161 S DR="153;153.1" D EN^DIQ1
162 W !,"HEMA TRANS/ENDOCRINE PROC DATE: ",ONC(165.5,DA,153.1,"E")
163 K ONC W ! Q
164 ;
165SSS ;SYSTEMIC/SURGERY SEQUENCE (165.5,15)
166 S $P(^ONCO(165.5,DA,3.1),U,39)=0
167 W !,"SYSTEMIC/SURGERY SEQUENCE.....: No systemic and/or surgery"
168 W !
169 Q
170 ;
171OTH ;OTHER TREATMENT (165.5,57.2)
172 S TXDT=$P(^ONCO(165.5,DA,3),U,23)_"O"
173 K ^ONCO(165.5,"ATX",DA,TXDT)
174 S $P(^ONCO(165.5,DA,3),U,23)="0000000" D OTHDT^ONCATF1
175 S ^ONCO(165.5,"ATX",DA,"0000000O")=""
176 K ^ONCO(165.5,DA,21)
177 N DI,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
178 S DR="57.2;57" D EN^DIQ1
179 W:$D(NTX) !,"OTHER TREATMENT...............: ",ONC(165.5,DA,57.2,"E")
180 W !,"OTHER TREATMENT DATE:.........: ",ONC(165.5,DA,57,"E")
181 K ONC Q
182 ;
183PRO ;PROTOCOL PARTICIPATION (165.5,560)
184 S $P(^ONCO(165.5,DA,"STS2"),U,31)="00"
185 S $P(^ONCO(165.5,DA,3.1),U,4)="0000"
186 N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
187 S DR="133;560" D EN^DIQ1
188 W !,"PROTOCOL PARTICIPATION........: ",ONC(165.5,DA,560,"E")
189 W !,"YEAR PUT ON PROTOCOL..........: ",ONC(165.5,DA,133,"E")
190 K ONC Q
191 ;
192RR ;RECONSTRUCTION/RESTORATION (165.5,23)
193 F RTK=0:0 S RTK=$O(^ONCO(164,RTK)) Q:RTK'>0 D
194 .I '$D(^ONCO(164,RTK,"RR5",0)) Q
195 .W !,RTK
196 .S NUM=$O(^ONCO(164,RTK,"RR5",0))
197 .W !?3,"FIRST:",?11,NUM,?14,$G(^ONCO(164,RTK,"RR5",NUM,0))
198 .F RR=0:0 S RR=$O(^ONCO(164,RTK,"RR5",RR)) Q:RR="B" S LAST=RR
199 .W !?3,"LAST :",?11,LAST,?14,$G(^ONCO(164,RTK,"RR5",LAST,0))
200 Q
201 ;
202RRDEFIT ;RECONSTRUCTION/RESTORATION default (165.5,23)
203 I X="No reconstruction/restoration" S X=0 Q
204 I X="NA"!(X["Unknown; not stated") S X=9 Q
205 Q
206 ;
207RFNSHLP ;REASON NO SURGERY OF PRIMARY (165.5,58) help
208 W !," Record the reason that no surgery was perforned on the primary site."
209 Q
210 ;
211RFNRHLP ;REASON FOR NO RADIATION (165.5,75) help
212 W !," Records the reason that no regional radiation"
213 W !," therapy was administered to the primary site."
214 W !
215 W !," For further information see FORDS page 168."
216 Q
217 ;
218EXIT W ! S Y="@424"
219 Q
Note: See TracBrowser for help on using the repository browser.