source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOSUR.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.2 KB
RevLine 
[613]1ONCOSUR ;Hines OIFO/GWB - SURGERY INPUT/OUTPUT TRANSFORMS/HELP ;12/17/97
2 ;;2.11;ONCOLOGY;**15,18,19,22,36,37,38,39,41,46**;Mar 07, 1995;Build 39
3 ;
4 ;SURGICAL APPROACH (165.5,74)
5SAIT ;INPUT
6 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
7 I SCDXDT<2980000 D I $D(X) S V=1 D NT^ONCODSR
8 .K DIC S DIC="^ONCO(160.6," D ^DIC
9 .I Y=-1 K X Q
10 .S X=$P(Y,U,1) W " ",$P(^ONCO(160.6,X,0),U,2)
11 I SCDXDT>2971231 D
12 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
13 .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
14 .;ROADS D-cxliii
15 .I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
16 .S FOUND=0
17 .F XSA=0:0 S XSA=$O(^ONCO(164,ICD,"SUA",XSA)) Q:XSA'>0!(FOUND=1) D
18 ..I $P(^ONCO(164,ICD,"SUA",XSA,0),U,2)=X S X=XSA,FOUND=1 Q
19 .I FOUND=0 K X Q
20 .W " ",$P(^ONCO(164,ICD,"SUA",X,0),U,1)
21 I $D(X) S V=1 D NT^ONCODSR
22 K SCDXDT,FOUND,ICD,TOP,XSA Q
23 ;
24SAOT ;OUTPUT
25 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
26 I SCDXDT<2980000 D
27 .S:Y'="" Y=$P($G(^ONCO(160.6,Y,0)),U,2)
28 I SCDXDT>2971231 D
29 .Q:Y=""
30 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
31 .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
32 .;ROADS D-cxliii
33 .I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
34 .S Y=$P($G(^ONCO(164,ICD,"SUA",Y,0)),U,2)_" "_$P($G(^ONCO(164,ICD,"SUA",Y,0)),U,1)
35 K SCDXDT,ICD,TOP Q
36 ;
37SAHP ;HELP
38 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
39 I SCDXDT<2980000 D
40 .W !?3,"Select from the following list:"
41 .F XSA=0:0 S XSA=$O(^ONCO(160.6,XSA)) Q:XSA'>0 W !?6,$P($G(^ONCO(160.6,XSA,0)),U,1),?12,$P($G(^ONCO(160.6,XSA,0)),U,2)
42 I SCDXDT>2971231 D
43 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
44 .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
45 .;ROADS D-cxliii
46 .I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
47 .W !?3,"Select from the following list:",!
48 .F XSA=0:0 S XSA=$O(^ONCO(164,ICD,"SUA",XSA)) Q:XSA'>0 W !?6,$P($G(^ONCO(164,ICD,"SUA",XSA,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SUA",XSA,0)),U,1)
49 K SCDXDT,ICD,TOP,XSA Q
50 ;
51 ;SURGERY OF PRIMARY (R) (165.5,58.2)
52 ;SURGERY OF PRIMARY (F) (165.5,58.6)
53SPSIT ;INPUT TRANSFORM
54 S NTXDD=$G(NTXDD) I NTXDD="" Q
55 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1)
56 I TOP="" W " No PRIMARY SITE" K X Q
57 S SR=+X
58 I $L(X)>2!(X'?1.N) K X Q
59 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
60 I (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($E(TOP,3,4)=76)!(TOP=67809),($G(FIELD)=58.6)!($G(FIELD)=58.7) G FORDS1
61 I SCDXDT<2980000,($G(FIELD)=58.2)!($G(FIELD)=50.2)!($G(FIELD)=58.6)!($G(FIELD)=58.7)!($G(FIELD)=.04) D CDSIT^ONCODSR Q:('$D(X))!($G(FIELD)=.04) I NTXDD=1 S V="00" D NT^ONCODSR K SCDXDT Q
62FORDS1 D
63 .I X="00" S X=0
64 .S HIST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
65 .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 ICD=67420
66 .E S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
67 .;ROADS D-cxliii
68 .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
69 .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
70 .S FOUND=0
71 .F XSP=0:0 S XSP=$O(^ONCO(164,ICD,"SPS",XSP)) Q:XSP'>0!(FOUND=1) D
72 ..I ($G(FIELD)=58.6)!($G(FIELD)=58.7),$P(^ONCO(164,ICD,"SPS",XSP,0),U,1)["ROADS" Q
73 ..I $P(^ONCO(164,ICD,"SPS",XSP,0),U,2)=X S X=XSP,FOUND=1 Q
74 .I FOUND=0 K X Q
75 .W " ",$P(^ONCO(164,ICD,"SPS",X,0),U,1)
76 Q:$G(FIELD)=.04
77 I $D(X),NTXDD=1 S V=1 D NT^ONCODSR Q
78 K SCDXDT,FOUND,ICD,TOP,XSP Q
79 ;
80SPSOT ;OUTPUT TRANSFORM
81 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
82 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
83 I (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($E(TOP,3,4)=76)!(TOP=67809),($G(FIELD)=58.6)!($G(FIELD)=58.7) G FORDS2
84 I SCDXDT<2980000,($G(FIELD)=58.2)!($G(FIELD)=50.2)!($G(FIELD)=58.6)!($G(FIELD)=58.7)!($G(FIELD)=.04) D CDSOT^ONCODSR Q
85FORDS2 D
86 .Q:Y=""
87 .S HIST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
88 .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 ICD=67420
89 .E S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
90 .;ROADS D-cxliii
91 .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
92 .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
93 .S Y=$S($P($G(^ONCO(164,ICD,"SPS",Y,0)),U,2)=0:"0",1:"")_$P($G(^ONCO(164,ICD,"SPS",Y,0)),U,2)_" "_$P($G(^ONCO(164,ICD,"SPS",Y,0)),U,1)
94 K SCDXDT,ICD,TOP
95 Q
96 ;
97SPSHP ;HELP
98 S SYSDIS=""
99 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No PRIMARY SITE" Q
100 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
101 I (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($E(TOP,3,4)=76)!(TOP=67809),($G(FIELD)=58.6)!($G(FIELD)=58.7) G FORDS3
102 I SCDXDT<2980000,($G(FIELD)=58.2)!($G(FIELD)=50.2)!($G(FIELD)=58.6)!($G(FIELD)=58.7)!($G(FIELD)=.04) D HP1^ONCODSR Q
103FORDS3 D
104 .S (EX,CTR)=0
105 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
106 .S HIST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
107 .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 ICD=67420,SYSDIS=1
108 .E S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
109 .;ROADS D-cxliii
110 .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
111 .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
112 .I $G(SYSDIS)=1 W !?3,"SURGICAL PROCEDURE codes for systemic disease: ",!
113 .E W !?3,"SURGICAL PROCEDURE codes for site ",$P($G(^ONCO(164,TOP,0)),U,2)," ",$P($G(^ONCO(164,TOP,0)),U,1),": ",!
114 .S XSP="" F S XSP=$O(^ONCO(164,ICD,"SPS","C",XSP)) Q:XSP="" S SPSIEN=$O(^ONCO(164,ICD,"SPS","C",XSP,0)) D Q:EX=U
115 ..S CTR=CTR+1 I CTR#20=0 D P Q:EX=U
116 ..I $P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)=0 W !?6,"00",?12,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1) Q
117 ..I ($G(FIELD)=58.6)!($G(FIELD)=58.7),$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS" Q
118 ..W !?6,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
119 W ! K CTR,SCDXDT,EX,ICD,TOP,XSP,SPSIEN Q
120 ;
121P D Q:EX=U W !
122 .W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
123 Q
124 ;
125SMIT ;SURGICAL MARGINS (165.5,59)
126 ;INPUT
127 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
128 I SCDXDT<2980000 D I $D(X) S V=8 D NT^ONCODSR Q
129 .I X>2,X<8 K X Q
130 .W " ",$S(X=0:"No residual tumor",X=1:"Microscopic residual tumor",X=2:"Macroscopic residual tumor",X=8:"Not applicable",X=9:"Unknown",1:"")
131 I SCDXDT>2971231 D
132 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
133 .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
134 .S FOUND=0
135 .F XSM=0:0 S XSM=$O(^ONCO(164,ICD,"SM5",XSM)) Q:XSM'>0!(FOUND=1) D
136 ..I $P(^ONCO(164,ICD,"SM5",XSM,0),U,2)=X S X=XSM,FOUND=1 Q
137 .I FOUND=0 K X Q
138 .W " ",$P(^ONCO(164,ICD,"SM5",X,0),U,1)
139 I $D(X) S V=6 D NT^ONCODSR
140 K SCDXDT,FOUND,ICD,TOP,XSM Q
141 ;
142SMOT ;OUTPUT
143 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
144 I SCDXDT<2980000 D
145 .S Y=$S(Y=0:"0 No residual tumor",Y=1:"1 Microscopic residual tumor",Y=2:"2 Macroscopic residual tumor",Y=8:"8 Not applicable",Y=9:"9 Unknown",1:"")
146 I SCDXDT>2971231 D
147 .Q:Y=""
148 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
149 .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
150 .S Y=$P($G(^ONCO(164,ICD,"SM5",Y,0)),U,2)_" "_$P($G(^ONCO(164,ICD,"SM5",Y,0)),U,1)
151 K SCDXDT,ICD,TOP Q
152 ;
153SMHP ;HELP
154 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
155 I SCDXDT<2980000 D
156 .W !?3,"Select from the following list:"
157 .W !?6,"0",?12,"No residual tumor"
158 .W !?6,"1",?12,"Microscopic residual tumor"
159 .W !?6,"2",?12,"Macroscopic residual tumor"
160 .W !?6,"8",?12,"Not applicable"
161 .W !?6,"9",?12,"Unknown"
162 I SCDXDT>2971231 D
163 .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
164 .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
165 .W !?3,"Select from the following list:",!
166 .F XSM=0:0 S XSM=$O(^ONCO(164,ICD,"SM5",XSM)) Q:XSM'>0 W !?6,$P($G(^ONCO(164,ICD,"SM5",XSM,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SM5",XSM,0)),U,1)
167 K SCDXDT,ICD,TOP,XSM Q
Note: See TracBrowser for help on using the repository browser.