source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOSUR1.m@ 1416

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1ONCOSUR1 ;Hines OIFO/RTK - ONCOSUR CONTINUED ;1/13/98
2 ;;2.11;ONCOLOGY;**15,18,19,22,36,38,40,41**;Mar 07, 1995
3 ;
4SCIT ;SCOPE OF LN SURGERY (R) (165.5,138) INPUT TRANSFORM
5 S NTXDD=$G(NTXDD) I NTXDD="" Q
6 S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
7 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No topography" K X Q
8 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
9 ;pre-2003 C76.0-C76.8, C80.9 cases
10 ;see ROADS page D-cxliii
11 I ($G(FIELD)=138)!($G(FIELD)=138.1),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141 K FIELD
12 S FOUND=0
13 F XSC=0:0 S XSC=$O(^ONCO(164,ICD,"SC5",XSC)) Q:XSC'>0!(FOUND=1) D
14 .I $P(^ONCO(164,ICD,"SC5",XSC,0),U,2)=X S X=XSC,FOUND=1 Q
15 I FOUND=0 K X Q
16 W " ",$P(^ONCO(164,ICD,"SC5",X,0),U,1)
17 I $D(X),NTXDD=1 S V=0 D NT^ONCODSR
18 K FOUND,ICD,SCDXDT,TOP,XSC Q
19 ;
20SCOT ;SCOPE OF LN SURGERY (R) (165.5,138) OUTPUT TRANSFORM
21 Q:Y=""
22 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
23 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
24 ;pre-2003 C76.0-C76.8, C80.9 cases
25 ;see ROADS page D-cxliii
26 I ($G(FIELD)=138)!($G(FIELD)=138.1),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141 K FIELD
27 S Y=$P($G(^ONCO(164,ICD,"SC5",Y,0)),U,1)
28 K ICD,TOP Q
29 ;
30SCHP ;SCOPE OF LN SURGERY (R) (165.5,138) HELP
31 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No topography" Q
32 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes" Q
33 ;pre-2003 C76.0-C76.8, C80.9 cases
34 ;see ROADS page D-cxliii
35 I ($G(FIELD)=138)!($G(FIELD)=138.1),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141 K FIELD
36 W !?3,"Select from the following list:",!
37 F XSC=0:0 S XSC=$O(^ONCO(164,ICD,"SC5",XSC)) Q:XSC'>0 W !?6,$P($G(^ONCO(164,ICD,"SC5",XSC,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SC5",XSC,0)),U,1)
38 K ICD,TOP,XSC Q
39 ;
40SOIT ;SURG OF OTHER SITES/NODES (165.5,139) INPUT TRANSFORM
41 S NTXDD=$G(NTXDD) I NTXDD="" Q
42 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No topography" K X Q
43 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
44 ;pre-2003 C76.0-C76.8, C80.9 cases
45 ;see ROADS page D-cxliii
46 I ($G(FIELD)=139)!($G(FIELD)=139.1),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141 K FIELD
47 S FOUND=0
48 F XSO=0:0 S XSO=$O(^ONCO(164,ICD,"SO5",XSO)) Q:XSO'>0!(FOUND=1) D
49 .I $P(^ONCO(164,ICD,"SO5",XSO,0),U,2)=X S X=XSO,FOUND=1 Q
50 I FOUND=0 K X Q
51 W " ",$P(^ONCO(164,ICD,"SO5",X,0),U,1)
52 I $D(X),NTXDD=1 S V=0 D NT^ONCODSR
53 K FOUND,ICD,TOP,XSO Q
54 ;
55SOOT ;SURG OF OTHER SITES/NODES (165.5,139) OUTPUT TRANSFORM
56 Q:Y=""
57 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
58 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
59 ;pre-2003 C76.0-C76.8, C80.9 cases
60 ;see ROADS page D-cxliii
61 I ($G(FIELD)=139)!($G(FIELD)=139.1),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141 K FIELD
62 S Y=$P($G(^ONCO(164,ICD,"SO5",Y,0)),U,1)
63 K ICD,TOP Q
64 ;
65SOHP ;SURG OF OTHER SITES/NODES (165.5,139) HELP
66 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No topography" Q
67 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes" Q
68 ;pre-2003 C76.0-C76.8, C80.9 cases
69 ;see ROADS page D-cxliii
70 I ($G(FIELD)=139)!($G(FIELD)=139.1),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141 K FIELD
71 W !?3,"Select from the following list:",!
72 F XSO=0:0 S XSO=$O(^ONCO(164,ICD,"SO5",XSO)) Q:XSO'>0 W !?6,$P($G(^ONCO(164,ICD,"SO5",XSO,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SO5",XSO,0)),U,1)
73 K ICD,TOP,XSO Q
74 Q
75 ;
76NRIT ;NUMBER OF NODES REMOVED (165.5,140) INPUT TRANSFORM
77 S NTXDD=$G(NTXDD) I NTXDD="" Q
78 S X=+X
79 I $L(X)=1 S X="0"_X
80 I X="00" W " No nodes removed"
81 I X=90 W " 90 or more nodes removed"
82 I X=95 W " No nodes removed, aspiration performed"
83 I X=96 W " Node removal as a sampling, number unknown"
84 I X=97 W " Node removal as dissection, number unknown"
85 I X=98 W " Nodes surgically removed, number unknown"
86 I X=99 W " Unknown, not stated, death cert ONLY"
87 I $D(X),NTXDD=1 S V=0 D NT^ONCODSR
88 Q
89 ;
90NROT ;NUMBER OF NODES REMOVED (165.5,140) OUTPUT TRANSFORM
91 Q:Y=""
92 S Y=+Y
93 I Y=0 S Y="No nodes removed"
94 I ((Y>0)&(Y<90))!((Y>90)&(Y<95)) S:$L(Y)=1 Y=0_Y
95 I Y=90 S Y="90 or more nodes removed"
96 I Y=95 S Y="No nodes removed, aspiration performed"
97 I Y=96 S Y="Node removal as a sampling, number unknown"
98 I Y=97 S Y="Node removal as dissection, number unknown"
99 I Y=98 S Y="Nodes surgically removed, number unknown"
100 I Y=99 S Y="Unknown, not stated, death cert ONLY"
101 Q
102 ;
103TOPIT ;PRIMARY SITE (165.5,20) INPUT TRANSFORM
104 ;If PRIMARY SITE is changed, delete site-specific fields
105 I X=67999 K X D Q
106 .W !!," UNKNOWN C99.9 is not allowed. It is for"
107 .W !," 1997 Non-Hodgkin's Lymphoma PCE use only."
108 .W !," (Item 12. Personal History of Any Cancer)"
109 .W !," Use UNKNOWN PRIMARY C80.9",!
110 I X=67888 K X D Q
111 .W !!," NA C88.8 is not allowed. It is for"
112 .W !," 1997 Non-Hodgkin's Lymphoma PCE use only."
113 .W !," (Item 12. Personal History of Any Cancer)",!
114 S OLDTOP=$P($G(^ONCO(165.5,D0,2)),U,1) I OLDTOP="" D KILL Q
115 S MSSG=0
116 I X=OLDTOP Q
117 S $P(^ONCO(165.5,D0,8),U,1)=""
118 D ^ONCOSUR2
119 S TOP=X,TOPCOD="",TOPNAM=""
120 I TOP'="" S TOPNAM=$P(^ONCO(164,TOP,0),U,1),TOPCOD=$P(^ONCO(164,TOP,0),U,2)
121 S SITTAB=79-$L($G(SITEGP)),TOPTAB=79-$L(TOPNAM_" "_TOPCOD)
122 S NOS=TOPTAB-$L($G(PATNAM)),NOS=NOS-1 K SPACES S $P(SPACES," ",NOS)=" "
123 D KILL Q
124 ;
125COCIT ;CLASS OF CASE (165.5,.04) INPUT TRANSFORM
126 ;If Class of Case is changed, delete the existing @FAC fields
127 S OLDCOC=$P($G(^ONCO(165.5,D0,0)),U,4) I OLDCOC="" K OLDCOC Q
128 I OLDCOC=X Q
129 I ((OLDCOC=1)!(OLDCOC=2))&((X=1)!(X=2)) Q
130 I ((OLDCOC=0)!(OLDCOC=3)!(OLDCOC=6))&((X=0)!(X=3)!(X=6)) Q
131 F PIECE=5:1:21 S $P(^ONCO(165.5,D0,3.1),U,PIECE)=""
132 S $P(^ONCO(165.5,D0,3.1),U,23)=""
133 S $P(^ONCO(165.5,D0,3.1),U,25)=""
134 S $P(^ONCO(165.5,D0,3.1),U,30)=""
135 S $P(^ONCO(165.5,D0,3.1),U,32)=""
136 S $P(^ONCO(165.5,D0,3.1),U,34)=""
137 K ATX,OLDCOC,PIECE Q
138KILL ;
139 K ICD,NEWSCG,NEWTNM,OLDCOC,OLDTNM,OLDTOP,OLDSCG,PIECE
140 K SUBSITE,SITE,TXDT
141 Q
Note: See TracBrowser for help on using the repository browser.