source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCNTX.m@ 808

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

initial load of WorldVistAEHR
File size: 9.5 KB
Line 
1ONCNTX ;Hines OIFO/GWB; No treatment stuffing; 08/27/97
2 ;;2.11;ONCOLOGY;**13,15,16,19,22,25,26,27,32,33,34,36,37,38,39,41,42,43,44,45,46,47**;Mar 07, 1995;Build 19
3 ;
4NTX ;No treatment stuffing
5 ;(ROADS)
6 S SITE=$P(^ONCO(165.5,DA,0),U,1)
7 I DATEDX<3030000 D
8 .D HDR,SURR,SURATFR^ONCNTX1,NODER
9 .I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D NODATFR^ONCUTX1
10 .E D NODATFR^ONCNTX1
11 .D SOSNR,SOSATFR^ONCNTX1
12 .W ! D PAUSE^ONCOPA2A
13 ;
14 ;(FORDS)
15 D HDR
16 S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,38)_"S0"
17 K ^ONCO(165.5,"ATX",DA,TXDT)
18 S $P(^ONCO(165.5,DA,3.1),U,38)="0000000"
19 S ^ONCO(165.5,"ATX",DA,"0000000S0")=""
20 D SUR,SURATF^ONCNTX1,SM,NODE
21 ;Code 9 (FORDS pages 138-139)
22 I ($E(TP,1,4)=6770)!($E(TP,1,4)=6771)!($E(TP,1,4)=6772)!($E(TP,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&($E(TP,1,4)=6777))!($E(TP,1,4)=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899)) D NODEATF^ONCUTX1
23 E D NODEATF^ONCNTX1
24 D SOSN,SOSNATF^ONCNTX1,RR,DSD
25 D RFNS W !
26 K ^ONCO(165.5,DA,14)
27 K DIR S DIR(0)="E" D ^DIR
28 S $P(^ONCO(165.5,DA,3),U,6)=0
29 S $P(^ONCO(165.5,DA,3.1),U,12)=0
30 S $P(^ONCO(165.5,DA,3),U,35)=""
31 D HDR,RAD1,RADATF^ONCNTX1,RAD2,RSSQ^ONCNTX1,RFNR W !
32 K DIR S DIR(0)="E" D ^DIR
33 S $P(^ONCO(165.5,DA,3),U,13)="00"
34 S $P(^ONCO(165.5,DA,3.1),U,14)="00"
35 S $P(^ONCO(165.5,DA,3),U,16)="00"
36 S $P(^ONCO(165.5,DA,3.1),U,16)="00"
37 S $P(^ONCO(165.5,DA,3),U,19)="00"
38 S $P(^ONCO(165.5,DA,3.1),U,18)="00"
39 S $P(^ONCO(165.5,DA,3.1),U,36)=1
40 S $P(^ONCO(165.5,DA,3),U,25)=0
41 S $P(^ONCO(165.5,DA,3.1),U,20)=0
42 D HDR,CHE,CHEMATF^ONCNTX1,HOR^ONCNTX1,HTATF^ONCNTX1,IMM^ONCNTX1,IMMATF^ONCNTX1,HTEP^ONCNTX1,SSS^ONCNTX1,OTH^ONCNTX1,OTHATF^ONCNTX1
43 K DIR S DIR(0)="E" D ^DIR I Y=0 S Y="@0" G EXIT
44 W ! S Y="@425" G EXIT
45 ;
46SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
47 S $P(^ONCO(165.5,DA,3),U,38)=$S(DATEDX>2971231:1,1:"00")
48 S $P(^ONCO(165.5,DA,3),U,34)=1
49 S DR="58.2;74" D DIQ1
50 I $D(NTX) D
51 .W !,"SURGICAL PROCEDURES (R)=ROADS"
52 .W !,"-----------------------------"
53 .W !,"SURGERY OF PRIMARY..........(R): ",ONC(165.5,DA,58.2,"E")
54 W !,"SURGICAL APPROACH...........(R): ",ONC(165.5,DA,74,"E")
55 K ONC
56 Q
57 ;
58SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
59 S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1)
60 I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D G SUR1
61 .S $P(^ONCO(165.5,DA,3.1),U,29)=1
62 S $P(^ONCO(165.5,DA,3.1),U,29)=$S(DATEDX>2971231:1,1:"00")
63SUR1 S TXDT=$P($G(^ONCO(165.5,DA,3)),U,1)_"S1"
64 K ^ONCO(165.5,"ATX",DA,TXDT)
65 S $P(^ONCO(165.5,DA,3),U,1)="0000000" D SPSDT^ONCATF
66 S ^ONCO(165.5,"ATX",DA,"0000000S1")=""
67 S $P(^ONCO(165.5,DA,3),U,28)=8
68 S $P(^ONCO(165.5,DA,0),U,11)="00000000"
69 S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
70 S $P(^ONCO(165.5,DA,3.1),U,28)=0
71 S DR="58.6;50;74;59;435;14;170" D DIQ1
72 I $D(NTX) D
73 .W !,"SURGICAL PROCEDURES (F)=FORDS"
74 .W !,"-----------------------------"
75 .W !,"DATE FIRST SURGICAL PROCEDURE..: ",ONC(165.5,DA,170,"E")
76 .W !,"SURGERY OF PRIMARY..........(F): ",ONC(165.5,DA,58.6,"E")
77 W !,"MOST DEFINITIVE SURG DATE......: ",ONC(165.5,DA,50,"E")
78 K ONC,TXDT
79 Q
80 ;
81SM ;SURGICAL MARGINS (165.5,59)
82 S $P(^ONCO(165.5,DA,3),U,28)=8
83 S TPG=$P($G(^ONCO(165.5,DA,2)),U,1)
84 I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S $P(^ONCO(165.5,DA,3),U,28)=9
85 S MO=$$HIST^ONCFUNC(DA)
86 S HIST14=$E(MO,1,4)
87 I (HIST14=9750)!((HIST14>9759)&(HIST14<9765))!((HIST14>9799)&(HIST14<9821))!(HIST14=9826)!((HIST14>9830)&(HIST14<9921))!((HIST14>9930)&(HIST14<9965))!((HIST14>9979)&(HIST14<9990)) S $P(^ONCO(165.5,DA,3),U,28)=9
88 I $$LYMPHOMA^ONCFUNC(DA),($E(TPG,3,4)=77) S $P(^ONCO(165.5,DA,3),U,28)=9
89 S DR="59" D DIQ1
90 W !,"SURGICAL MARGINS...............: ",ONC(165.5,DA,59,"E")
91 K ONC
92 Q
93 ;
94NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
95 ;For unknown primary, leukemia, lymphoma, and brain primaries, code 9
96 S SITE=$P(^ONCO(165.5,DA,0),U,1)
97 I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D D NUMND^ONCATF Q
98 .D SGRP^ONCUTX1
99 .I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S SGRP=67141
100 .F SC=0:0 S SC=$O(^ONCO(164,SGRP,"SC5",SC)) Q:SC="B" S LAST=SC
101 .S $P(^ONCO(165.5,DA,3),U,40)=LAST
102 .W !,"SCOPE OF LN SURGERY.........(R): ",$P(^ONCO(164,SGRP,"SC5",LAST,0),U,1)
103 .D NODER^ONCUTX
104 S $P(^ONCO(165.5,DA,3),U,40)=1
105 S $P(^ONCO(165.5,DA,3),U,42)="00"
106 D NUMND^ONCATF
107 S DR="138;140" D DIQ1
108 W:$D(NTX) !,"SCOPE OF LN SURGERY.........(R): ",ONC(165.5,DA,138,"E")
109 W !,"NUMBER OF LN REMOVED........(R): ",ONC(165.5,DA,140,"E")
110 Q
111 ;
112NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
113 ;Code 9 (FORDS pages 138-139)
114 S TP=$P($G(^ONCO(165.5,DA,2)),U,1)
115 S MO=$$HIST^ONCFUNC(DA)
116 I ($E(TP,1,4)=6770)!($E(TP,1,4)=6771)!($E(TP,1,4)=6772)!($E(TP,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&($E(TP,1,4)=6777))!($E(TP,1,4)=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899)) D D SCPDT^ONCATF Q
117 .S $P(^ONCO(165.5,DA,3.1),U,31)=9
118 .W !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
119 .D NODE^ONCUTX
120 S $P(^ONCO(165.5,DA,3.1),U,31)=0
121 S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,22)_"S2"
122 K ^ONCO(165.5,"ATX",DA,TXDT)
123 S $P(^ONCO(165.5,D0,3.1),U,22)="0000000" D SCPDT^ONCATF
124 S ^ONCO(165.5,"ATX",DA,"0000000S2")=""
125 S DR="138.4;138.2" D DIQ1
126 W:$D(NTX) !,"SCOPE OF LN SURGERY.........(F): ",ONC(165.5,DA,138.4,"E")
127 W !,"SCOPE OF LN SURGERY DATE.......: ",ONC(165.5,DA,138.2,"E")
128 Q
129 ;
130SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
131 S $P(^ONCO(165.5,DA,3),U,41)=1
132 S DR=139 D DIQ1
133 W:$D(NTX) !,"SURG PROC/OTHER SITE........(R): ",ONC(165.5,DA,139,"E")
134 Q
135 ;
136SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
137 S $P(^ONCO(165.5,DA,3.1),U,33)=0
138 S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,24)_"S3"
139 K ^ONCO(165.5,"ATX",DA,TXDT)
140 S $P(^ONCO(165.5,D0,3.1),U,24)="0000000" D SOSNDT^ONCATF
141 S ^ONCO(165.5,"ATX",DA,"0000000S3")=""
142 S DR="139.4;139.2" D DIQ1
143 W:$D(NTX) !,"SURG PROC/OTHER SITE........(F): ",ONC(165.5,DA,139.4,"E")
144 W !,"SURG PROC/OTHER SITE DATE......: ",ONC(165.5,DA,139.2,"E")
145 Q
146 ;
147RR ;RECONSTRUCTION/RESTORATION (165.5,23)
148 I DATEDX>3021231 Q
149 I DATEDX>2951231 D
150 .S $P(^ONCO(165.5,DA,3),U,33)=$S(DATEDX>2971231:1,1:9)
151 .S DR=23 D DIQ1
152 .W !,"RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,DA,23,"E")
153 Q
154 ;
155DSD ;DATE OF SURGICAL DISCHARGE (165.5,435)
156 ;READMISSION W/I 30 DAYS/SURG (165.5,14)
157 S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
158 S $P(^ONCO(165.5,DA,3.1),U,28)=0
159 S $P(^ONCO(165.5,DA,7),U,19)=9
160 S $P(^ONCO(165.5,DA,7),U,20)=""
161 S DR="435;14;46" D DIQ1
162 W !,"DATE OF SURGICAL DISCHARGE.....: ",ONC(165.5,DA,435,"E")
163 W !,"READMISSION W/I 30 DAYS/SURG...: ",ONC(165.5,DA,14,"E")
164 W !,"CAP PROTOCOL REVIEW............: ",ONC(165.5,DA,46,"E")
165 K ONC
166 Q
167 ;
168RFNS ;REASON NO SURGERY OF PRIMARY (165.5,58)
169 S RFNS=$$GET1^DIQ(165.5,DA,1.2)
170 I (RFNS="Autopsy only")!(RFNS="Death certificate only") D Q
171 .S $P(^ONCO(165.5,DA,3),U,26)=9
172 .W !,"REASON NO SURGERY OF PRIMARY...: Unknown"
173 W ! K DIR S DIR(0)="SA^0:Surgery performed;1:Not part of 1st course;2:Contraindicated/risk factors;5:Patient died prior to surgery;6:No reason in record;7:Refused by patient;8:Unknown if performed;9:Unknown/dx at autopsy/death cert"
174 S DIR("A")="REASON NO SURGERY OF PRIMARY: "
175 S DIR("B")="Not part of 1st course"
176 S DIR("??")="^D RFNSHLP^ONCNTX1"
177 D ^DIR
178 I Y[U Q
179 S $P(^ONCO(165.5,DA,3),U,26)=Y
180 Q
181 ;
182RAD1 ;RADIATION (165.5,51.2)
183 S RFNR=$P($G(^ONCO(165.5,DA,3)),U,35)
184 D ^ONCRFNR
185 S DR="51.2;51" D DIQ1
186 W:$D(NTX) !,"RADIATION:.....................: ",ONC(165.5,DA,51.2,"E")
187 W !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
188 K ONC,TXDT Q
189 ;
190RAD2 ;RADIATION (cont)
191 S $P(^ONCO(165.5,DA,3),U,22)=0
192 S $P(^ONCO(165.5,DA,3),U,21)=1
193 S $P(^ONCO(165.5,DA,"BLA2"),U,18)=1
194 S $P(^ONCO(165.5,DA,"THY1"),U,43)=0
195 S $P(^ONCO(165.5,DA,24),U,9)=1
196 S $P(^ONCO(165.5,DA,"THY1"),U,44)=0
197 S $P(^ONCO(165.5,DA,3),U,20)=0
198 S $P(^ONCO(165.5,DA,"BLA2"),U,16)="0000000"
199 K ^ONCO(165.5,DA,15)
200 K ^ONCO(165.5,DA,16)
201 S DR="126;125;363;442;363.1;443;56;361" D DIQ1
202 W !,"LOCATION OF RADIATION..........: ",ONC(165.5,DA,126,"E")
203 W !,"RADIATION TREATMENT VOLUME.....: ",ONC(165.5,DA,125,"E")
204 W !,"REGIONAL TREATMENT MODALITY....: ",ONC(165.5,DA,363,"E")
205 W !,"REGIONAL DOSE:cGy..............: ",ONC(165.5,DA,442,"E")
206 W !,"BOOST TREATMENT MODALITY.......: ",ONC(165.5,DA,363.1,"E")
207 W !,"BOOST DOSE:cGy.................: ",ONC(165.5,DA,443,"E")
208 W !,"NUMBER OF TREATMENTS...........: ",ONC(165.5,DA,56,"E")
209 W !,"DATE RADIATION ENDED...........: ",ONC(165.5,DA,361,"E")
210 K ONC,TXDT Q
211 ;
212RFNR ;REASON FOR NO RADIATION (165.5,75)
213 W ! K DIR
214 S DIR(0)="SA^0:Radiation administered;1:Not part of 1st course;2:Contraindicated;5:Pt died prior to tx;6:Recommended, not admin, no reason given;7:Refusal;8:Recommended, unknown if admin;9:Unknown"
215 S DIR("A")="REASON FOR NO RADIATION: "
216 S DIR("B")="Not part of 1st course"
217 S DIR("??")="^D RFNRHLP^ONCNTX1"
218 D ^DIR
219 I Y[U Q
220 S $P(^ONCO(165.5,DA,3),U,35)=Y
221 I X=8 S RFNR=8 D ^ONCRFNR D
222 .W !!,"DATE RADIATION STARTED changed to 88/88/8888"
223 Q
224 ;
225CHE ;CHEMOTHERAPY (165.5,53.2)
226 I $D(NTX) D
227 .N DR,DP,DL
228 .S DIE="^ONCO(165.5,",DR=53.2 D ^DIE
229 S TXDT=$P(^ONCO(165.5,DA,3),U,11)_"C"
230 K ^ONCO(165.5,"ATX",DA,TXDT)
231 S $P(^ONCO(165.5,DA,3),U,11)="0000000" D CHEMDT^ONCATF1
232 S ^ONCO(165.5,"ATX",DA,"0000000C")=""
233 K ^ONCO(165.5,DA,17)
234 S DR="53.2;53" D DIQ1
235 W !,"CHEMOTHERAPY DATE.............: ",ONC(165.5,DA,53,"E")
236 K ONC Q
237 ;
238NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
239 S $P(^ONCO(165.5,D0,3),U,31)="0000000" D NCDSDT^ONCATF
240 S DR=58.3 D DIQ1
241 W !,"SURGICAL DX/STAGING PROC DATE: ",ONC(165.5,DA,58.3,"E")
242 Q
243 ;
244HDR W @IOF,DASHES,!,?1,PATNAM,?TAB,"First Course of Treatment",?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
245 Q
246 ;
247DIQ1 N DI K ONC
248 S DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E" D EN^DIQ1
249 Q
250 ;
251EXIT W !
252 Q
Note: See TracBrowser for help on using the repository browser.