source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOTNM.m@ 1681

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1ONCOTNM ;Hines OIFO/GWB - TNM CODING ;8/17/93
2 ;;2.11;ONCOLOGY;**1,6,15,22,25,28,30,33,35,36,41,42,43**;Mar 07, 1995
3 ;INPUT TRANSFORM, OUTPUT TRANSFORM and HELP for:
4 ;CLINICAL T (165.5,37.1)
5 ;CLINICAL N (165.5,37.2)
6 ;CLINICAL M (165.5,37.3)
7 ;PATHOLOGIC T (165.5,85)
8 ;PATHOLOGIC N (165.5,86)
9 ;PATHOLOGIC M (165.5,87)
10 ;OTHER T (165.5,93)
11 ;OTHER N (165.5,98)
12 ;OTHER M (165.5,99)
13IN ;INPUT TRANSFORM
14 D SETVAR
15 G EX:(ST="")!(TX="")
16 S X=$TR(X,"abcdilmopsuvx","ABCDILMOPSUVX")
17 I (X="X")!(X="IS")!(X="A") G IN1
18 S XX=$E(X)
19 S X=$S(XX?1.A:$E(X,2,$L(X)),1:X) I X="" K X G EX
20IN1 S TRANSFRM="INPUT" D FILSC
21 I ($P($G(^ONCO(164,TX,0)),U,14)="N")!(ST=35)!(ST>65&(ST<71)) W !?3,"No TNM coding or staging available for this site.",! G EX
22 I $D(^ONCO(FIL,SC,ONCOX_ONCOED)) S ONCOX=ONCOX_ONCOED G CKIN
23 I $D(^ONCO(FIL,SC,ONCOX_(ONCOED-1))) S ONCOX=ONCOX_(ONCOED-1)
24CKIN D CK I 'XD0 S X=$TR(X,"abcd","ABCD") D CK
25 I 'XD0 K X
26 E D
27 .S TD=$P(^ONCO(FIL,SC,ONCOX,XD0,0),U,1)
28 .I ONCOX["T" S T=$S(TD="CBA":"Primary tumor cannot be assessed",TD="NET":"No evidence of primary tumor",TD="CIS":"Carcinoma 'in situ'",TD="TIAS":"Tumor invades adjacent structures",TD="TIAO":"Tumor invades adjacent organs",1:TD)
29 .I ONCOX["N" S T=$S(TD="NCA":"Regional lymph nodes cannot be assessed",TD="NRN":"No regional lymph node metastasis",TD="MET":"Metastasis in regional lymph node(s)",1:TD)
30 .I ONCOX["M" S T=TD
31 .W " ",T
32 D EX
33 Q
34 ;
35CK ;Check for existence of code
36 I '$D(^ONCO(FIL,SC,ONCOX,"X")) W !!?5,"Code not valid for this site"
37 S XD0=$G(^ONCO(FIL,SC,ONCOX,"X",X))
38 Q
39 ;
40OT ;OUTPUT TRANSFORM
41 D SETVAR
42 G EX:(ST="")!(TX="")
43 D @$S(ONCOED<3:"OT12",1:"OT3456")
44 Q
45 ;
46OT12 ;1st and 2nd editions
47 S:Y'="" Y=$E(ONCOX)_Y
48 Q
49 ;
50OT3456 ;3rd, 4th, 5th and 6th editions
51 S TRANSFRM="OUTPUT" D FILSC
52 I Y="" G EX
53 I $D(^ONCO(FIL,SC,ONCOX_ONCOED)) S ONCOX=ONCOX_ONCOED G CKOT
54 I $D(^ONCO(FIL,SC,ONCOX_(ONCOED-1))) S ONCOX=ONCOX_(ONCOED-1)
55CKOT S XD0=$G(^ONCO(FIL,SC,ONCOX,"X",Y)) G EX:XD0=""
56 S TC=^ONCO(FIL,SC,ONCOX,XD0,0),MM=""
57 D TC
58 S Y=$E(ONCOX)_$P(TC,U,2)_MM_" "_TT
59 G EX
60 ;
61TC I $E(ONCOX)="T" D
62 .S TT=$S(Y="X":"Primary tumor cannot be assessed",Y=0:"No evidence of primary tumor",1:$P(TC,U))
63 .S TT=$S(TT="TIAS":"Tumor invades adjacent structures",1:TT)
64 .N MM S MM=$P($G(^ONCO(165.5,D0,2)),U,31) ;69;MULTIPLE TUMORS
65 .I MM'="" S MM=$S(MM>1:"m"_MM,1:"m")
66 E I $E(ONCOX)="N" S TT=$S($P(TC,U,1)="NCA":"Regional lymph nodes cannot be assessed",$P(TC,U,1)="NRN":"No regional lymph node metastasis",ST=58:"NA",1:$P(TC,U)),TT=$S(TT="MET":"Metastasis in regional lymph node(s)",1:TT)
67 E I $E(ONCOX)="M" S TT=$P(TC,U) Q
68 Q
69 ;
70HP ;HELP
71 D SETVAR
72 G EX:(ST="")!(TX="")
73 D @$S(ONCOED<3:"P12",1:"P3456")
74 Q
75 ;
76P12 ;1st and 2nd edition
77 W !!,"Enter the appropriate TNM code."
78 Q
79 ;
80P3456 ;3rd, 4th, 5th and 6th editions
81 S TRANSFRM="HELP" D FILSC
82 I $D(^ONCO(FIL,SC,ONCOX_ONCOED)) S ONCOX=ONCOX_ONCOED
83 I ONCOED>5,FIL=164.33,(SC=22)!(SC=23)!(SC=25)!(SC=29)!(SC=30)!(SC=35)!(SC=39)!(SC=41)!(SC=50)!(SC=51)!(SC=55) S SUB=$S($E(ONCOX,1)="T":4,$E(ONCOX,1)="N":5,1:6) I $D(^ONCO(164.33,SC,SUB)) D W ! K SUB Q ;Full text help from 164.33
84 .S HIEN=0 F S HIEN=$O(^ONCO(164.33,SC,SUB,HIEN)) Q:HIEN'>0 W !?1,^ONCO(164.33,SC,SUB,HIEN,0)
85 I ONCOED>4,FIL=164.33,(SC=22)!(SC=23)!(SC=25)!(SC=29)!(SC=30)!(SC=35)!(SC=39)!(SC=41)!(SC=50)!(SC=51) S SUB=$S($E(ONCOX,1)="T":1,$E(ONCOX,1)="N":2,1:3) I $D(^ONCO(164.33,SC,SUB)) D W ! K SUB Q ;Full text help from 164.33
86 .S HIEN=0 F S HIEN=$O(^ONCO(164.33,SC,SUB,HIEN)) Q:HIEN'>0 W !?1,^ONCO(164.33,SC,SUB,HIEN,0)
87 I ONCOED>5 S SUB=$S($E(ONCOX,1)="T":8,$E(ONCOX,1)="N":9,1:10) I $D(^ONCO(164,SC,SUB)) D W ! K SUB Q ;Full text help from 6th edition
88 .S HIEN=0 F S HIEN=$O(^ONCO(164,SC,SUB,HIEN)) Q:HIEN'>0 W !?1,^ONCO(164,SC,SUB,HIEN,0)
89 I ONCOED>4 S SUB=$S($E(ONCOX,1)="T":5,$E(ONCOX,1)="N":6,1:7) I $D(^ONCO(164,SC,SUB)) D W ! K SUB Q ;Full text help from 5th edition
90 .S HIEN=0 F S HIEN=$O(^ONCO(164,SC,SUB,HIEN)) Q:HIEN'>0 W !?1,^ONCO(164,SC,SUB,HIEN,0)
91 S XD0=0
92 W !,$S(ONCOX["T":" Primary Tumor (T)",ONCOX["N":" Regional Lymph Nodes (N)",ONCOX["M":" Distant Metastasis (M)",1:""),!
93 F S XD0=$O(^ONCO(FIL,SC,ONCOX,XD0)) Q:XD0'>0 D
94 .N Y,T
95 .S Y=^(XD0,0),T=$P(Y,U)
96 .I ONCOX["T" D
97 ..W:$P(Y,U,2)'=88 !?1,"T"_$P(Y,U,2),?12
98 ..W $S(T="CBA":"Primary tumor cannot be assessed",T="NET":"No evidence of primary tumor",T="CIS":"Carcinoma 'in situ'",T="TIAS":"Tumor invades adjacent structures",T="TIAO":"Tumor invades adjacent organs",1:T)
99 .E I ONCOX["N" W:$P(Y,U,2)'=88 !?1,"N"_$P(Y,U,2),?13,$S(T="NCA":"Regional lymph nodes cannot be assessed",T="NRN":"No regional lymph node metastasis",T="MET":"Metastasis in regional lymph node(s)",1:T)
100 .E I ONCOX["M" W:$P(Y,U,2)'=88 !?1,"M"_$P(Y,U,2),?6,T
101 W ! Q
102 ;
103SETVAR ;Set variables
104 N T,N,M
105 S ST=$P(^ONCO(165.5,D0,0),U) ;SITE/GP
106 S TX=$P($G(^ONCO(165.5,D0,2)),U,1) ;ICDO-TOPOGRAPHY
107 Q:(ST="")!(TX="")
108 S HT=$$HIST^ONCFUNC(D0) ;HISTOLOGY
109 S SC=$P(^ONCO(164,TX,0),U,11) ;T & N CODES
110 S DATEDX=$P(^ONCO(165.5,D0,0),U,16) ;DATE DX
111 N YR S YR=$E($P($G(^ONCO(165.5,D0,0)),U,16),1,3)
112 S ONCOED=$S(YR<283:1,YR<288:2,YR<292:3,YR<298:4,YR<303:5,1:6)
113 ;S ONCOED=$$TNMED^ONCOU55(D0) ;STAGING EDITION
114 S FIL=164
115 Q
116 ;
117FILSC ;Get file (FIL) and IEN (SC) for appropriate TNM list
118 ;
119 ;PART III: DIGESTIVE SYSTEM
120 ;Esophagus - Upper 3rd, Middle 3rd, Lower 3rd
121 I ONCOED>4,TX=67151,ONCOX="M" S FIL=164,SC=67154 Q
122 I ONCOED>4,TX=67152,ONCOX="M" S FIL=164,SC=67155 Q
123 I ONCOED>4,TX=67153,ONCOX="M" S FIL=164,SC=67153 Q
124 I ONCOED>4,TX=67154,ONCOX="M" S FIL=164,SC=67154 Q
125 I ONCOED>4,TX=67155,ONCOX="M" S FIL=164,SC=67155 Q
126 ;
127 ;Extraheptic Bile Ducts
128 I ((TX=67240)!(TX=67248)!(67249)),ONCOED=3,ONCOX="N" S FIL=164.33,SC=15 Q
129 ;
130 ;PART VI: SKIN
131 ;Melanoma of the Skin
132 I $$MELANOMA^ONCOU55(D0),(($E(TX,3,4)=44)!($E(TX,3,4)=51)!($E(TX,3,4)=60)!(TX=67632)) S FIL=164.33,SC=22 Q
133 ;
134 ;PART VII: BREAST
135 ;Breast
136 I $E(TX,1,4)=6750,ONCOX="N" D Q
137 .I STGIND="C" Q
138 .I STGIND="P" S FIL=164.33,SC=23
139 ;
140 ;PART VIII: GYNECOLOGIC SITES
141 ;Vulva
142 I ONCOED>4,$E(TX,3,4)=51,ONCOX="M" S FIL=164,SC=67518 Q
143 ;
144 ;Vagina - 3rd and 4th editions
145 I TX=67529,ONCOX="N",ONCOED<5 D Q
146 .S ONCUL=$P($G(^ONCO(165.5,D0,24)),U,4)
147 .I ONCUL="U" Q
148 .I ONCUL="L" S FIL=164.33,SC=52 Q
149 ;
150 ;Gestational Trophoblastic Tumors - 5th and 6th editions
151 ;I ONCOED>4,TX=67589,ONCOX="M" S FIL=164,SC=67540 Q
152 ;I $$GTT^ONCOU55(D0),ONCOED>4,ONCOX="M" S FIL=164,SC=67540 Q
153 ;I ONCOED=5,(($E(TX,3,4)=54)!($E(TX,3,4)=55)) S ONCOED=4
154 ;
155 ;PART IX: GENITOURINARY SITES
156 ;Prostate
157 I TX=67619,ONCOED>4,ONCOX="T",STGIND="P" S FIL=164.33,SC=29 Q
158 I TX=67619,ONCOED=6,ONCOX="N",STGIND="P" S FIL=164.33,SC=29 Q
159 I TX=67619,ONCOX="M" S FIL=164.33,SC=$S(ONCOED>3:29,1:3) Q
160 ;
161 ;Testis - 5th and 6th editions
162 I $E(TX,3,4)=62,ONCOED>4,ONCOX="N",STGIND="P" S FIL=164.33,SC=30 Q
163 I $E(TX,3,4)=62,ONCOED>4,ONCOX="M" S FIL=164,SC=67620 Q
164 ;
165 ;Urethra - Urothelial (Transitional Cell) Carcinoma of the Prostate
166 I ONCOED>4,TX=67619,(HT=81203)!(HT=81303)!(HT=81223)!(HT=81202) D Q
167 .I ONCOX="T" S FIL=164.33,SC=35
168 .I ONCOX="N" S FIL=164,SC=67680
169 .I ONCOX="M" S FIL=164.33,SC=3
170 ;
171 ;PART X: OPHTHALMIC SITES
172 ;Malignant Melanoma of the Eyelid -3rd and 4th editions
173 I TX=67441,ONCOED<5,$$MELANOMA^ONCOU55(D0) S FIL=164.33,SC=37 Q
174 ;
175 ;Malignant Melanoma of the Conjunctiva
176 I $$MELANOMA^ONCOU55(D0),TX=67690 S FIL=164.33,SC=$S(STGIND="P":50,1:39) Q
177 ;
178 ;Malignant Melanoma of the Uvea
179 I TX=67694,$$IRISCIL^ONCOU55(D0)="C" S FIL=164.33,SC=51 Q
180 ;
181 ;Retinoblastoma
182 I TX=67692,STGIND="P" S FIL=164.33,SC=41 Q
183 ;
184 ;PART XI: CENTRAL NERVOUS SYSTEM
185 ;Brain - 3rd and 4th editions
186 I ((TX=67700)!($E(TX,3,4)=71)),ONCOED<5 D
187 .I ONCOX="T" S SC=$S($P($G(^ONCO(165.5,D0,2)),U,7)="I":67710,1:67700) Q
188 .I TRANSFRM'="OUTPUT",ONCOX="N" W ?12," This category does not apply to this site."
189 ;
190 ;PART XII: LYMPHOID NEOPLASMS
191 ;Mycosis fungoides and Sezary Disease of Skin, Vulva, Penis, Scrotum
192 ;9700/3 and 9701/3
193 ;C44.0-C44.9, C51.0-C51.2, C51.8-C51.9, C60.0-C60.2, C60.8-C60.9, C63.2
194 I (HT=97003)!(HT=97013),($E(TX,3,4)=44)!($E(TX,3,4)=51)!($E(TX,3,4)=60)!(TX=67632),ONCOED>5 S FIL=164.33,SC=55 Q
195 ;
196 I ONCOX="M",'$D(^ONCO(FIL,SC,"M"_ONCOED)) S FIL=164.33,SC=3
197 ;
198 Q
199 ;
200EX ;Exit
201 K MM,XX,TC,SC,TT,OG,OS,OT,OP,ONCOX,YY,CC,ER,WFLG,TRANSFRM
202 Q
Note: See TracBrowser for help on using the repository browser.