source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCUTX1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.8 KB
Line 
1ONCUTX1 ;Hines OIFO/RTK; UNKNOWN TREATMENT STUFFING; 08/11/98
2 ;;2.11;ONCOLOGY;**19,22,27,29,33,36,37,38,39,41,42,44,46**;Mar 07, 1995;Build 39
3 ;
4NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
5 S $P(^ONCO(165.5,D0,3.1),U,5)="09"
6 S $P(^ONCO(165.5,D0,3.1),U,6)=9999999
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 D SGRP
14 I $E(SGRP,3,4)=77 S SGRP=67422
15 F SPS=0:0 S SPS=$O(^ONCO(164,SGRP,"SPS",SPS)) Q:$P(^ONCO(164,SGRP,"SPS",SPS,0),U,1)["Unknown;"
16 S $P(^ONCO(165.5,DA,3.1),U,7)=$S(DATEDX>2971231:SPS,1:"00")
17 N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
18 S DR=50.2 D EN^DIQ1
19 W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(R): "_ONC(165.5,DA,50.2,"E")
20 Q
21 ;
22SURATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
23 D SGRP
24 F SPS=0:0 S SPS=$O(^ONCO(164,SGRP,"SPS",SPS)) Q:$P(^ONCO(164,SGRP,"SPS",SPS,0),U,1)["Unknown;"
25 S $P(^ONCO(165.5,DA,3.1),U,30)=SPS
26 S $P(^ONCO(165.5,DA,3.1),U,8)=9999999
27 N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
28 S DR="58.7;50.3" D EN^DIQ1
29 W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(F): "_ONC(165.5,DA,58.7,"E")
30 W !,"MOST DEFINITIVE SURG @FAC DATE.: "_ONC(165.5,DA,50.3,"E")
31 Q
32 ;
33NODATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
34 D SGRP
35 I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S SGRP=67141
36 F SC=0:0 S SC=$O(^ONCO(164,SGRP,"SC5",SC)) Q:SC="B" S LAST=SC
37 S $P(^ONCO(165.5,DA,3.1),U,9)=LAST
38 S $P(^ONCO(165.5,D0,3.1),U,11)=99
39 N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
40 S DR="138.1;140.1" D DIQ1^ONCNTX
41 W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(R): "_ONC(165.5,DA,138.1,"E")
42 W !,"NUMBER OF LN REMOVED @FAC...(R): "_ONC(165.5,DA,140.1,"E")
43 Q
44 ;
45NODEATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
46 D SGRP
47 S $P(^ONCO(165.5,DA,3.1),U,32)=9
48 S $P(^ONCO(165.5,DA,3.1),U,23)="0000000"
49 N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
50 S DR="138.5;138.3" D DIQ1^ONCNTX
51 W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(F): "_ONC(165.5,DA,138.5,"E")
52 W !,"SCOPE OF LN SURGERY @FAC DATE..: "_ONC(165.5,DA,138.3,"E")
53 Q
54 ;
55SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
56 D SGRP
57 F SO=0:0 S SO=$O(^ONCO(164,SGRP,"SO5",SO)) Q:SO="B" S LAST=SO
58 S $P(^ONCO(165.5,DA,3.1),U,10)=$S(DATEDX>2971231:LAST,1:"")
59 S DR=139.1 D DIQ1^ONCNTX
60 W:$D(NTX) !,"SURG PROC/OTHER SIT @FAC...(R): "_ONC(165.5,DA,139.1,"E")
61 Q
62 ;
63SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
64 S $P(^ONCO(165.5,DA,3.1),U,34)=9
65 S $P(^ONCO(165.5,D0,3.1),U,25)=9999999
66 S DR="139.5;139.3" D DIQ1^ONCNTX
67 W:$D(NTX) !,"SURGICAL PROC/OTHER SITE @FAC..: "_ONC(165.5,DA,139.5,"E")
68 W !,"SURG PROC/OTHER SITE @FAC DATE.: "_ONC(165.5,DA,139.3,"E")
69 Q
70 ;
71RADATF ;RADIATION @FAC (165.5,51.4)
72 S $P(^ONCO(165.5,DA,3.1),U,12)=9
73 S $P(^ONCO(165.5,DA,3.1),U,13)=9999999
74 S DR="51.4;51.5" D DIQ1^ONCNTX
75 W:$D(NTX) !,"RADIATION @FAC.................: "_ONC(165.5,DA,51.4,"E")
76 W !,"RADIATION @FAC DATE............: ",ONC(165.5,DA,51.5,"E")
77 Q
78 ;
79CHEMATF ;CHEMOTHERAPY @FAC (165.5,53.3)
80 I $G(XX)=88 D
81 .S $P(^ONCO(165.5,DA,3.1),U,14)=88
82 .S $P(^ONCO(165.5,DA,3.1),U,15)=8888888
83 I $G(XX)=99 D
84 .S $P(^ONCO(165.5,DA,3.1),U,14)=99
85 .S $P(^ONCO(165.5,DA,3.1),U,15)=9999999
86 S DR="53.3;53.4" D DIQ1^ONCNTX
87 W:$D(NTX) !,"CHEMOTHERAPY @FAC..............: "_ONC(165.5,DA,53.3,"E")
88 W !,"CHEMOTHERAPY @FAC DATE.........: ",ONC(165.5,DA,53.4,"E")
89 Q
90 ;
91HTATF ;HORMONE THERAPY @FAC (165.5,54.3)
92 I $G(XX)=88 D
93 .S $P(^ONCO(165.5,DA,3.1),U,16)=88
94 .S $P(^ONCO(165.5,DA,3.1),U,17)=8888888
95 I $G(XX)=99 D
96 .S $P(^ONCO(165.5,DA,3.1),U,16)=99
97 .S $P(^ONCO(165.5,DA,3.1),U,17)=9999999
98 S DR="54.3;54.4" D DIQ1^ONCNTX
99 W:$D(NTX) !,"HORMONE THERAPY @FAC...........: "_ONC(165.5,DA,54.3,"E")
100 W !,"HORMONE THERAPY @FAC DATE......: ",ONC(165.5,DA,54.4,"E")
101 Q
102 ;
103IMMATF ;IMMUNOTHERAPY @FAC (165.5,55.3)
104 I $G(XX)=88 D
105 .S $P(^ONCO(165.5,DA,3.1),U,18)=88
106 .S $P(^ONCO(165.5,DA,3.1),U,19)=8888888
107 I $G(XX)=99 D
108 .S $P(^ONCO(165.5,DA,3.1),U,18)=99
109 .S $P(^ONCO(165.5,DA,3.1),U,19)=9999999
110 S DR="55.3;55.4" D DIQ1^ONCNTX
111 W:$D(NTX) !,"IMMUNOTHERAPY @FAC.............: "_ONC(165.5,DA,55.3,"E")
112 W !,"IMMUNOTHERAPY @FAC DATE........: ",ONC(165.5,DA,55.4,"E")
113 Q
114 ;
115OTHATF ;OTHE TREATMENT @FAC (165.5,57.3)
116 I $G(X)'=8 S $P(^ONCO(165.5,DA,3.1),U,20)=9
117 S $P(^ONCO(165.5,DA,3.1),U,21)=9999999
118 S DR="57.3;57.4" D DIQ1^ONCNTX
119 W:$D(NTX) !,"OTHER TREATMENT @FAC...........: "_ONC(165.5,DA,57.3,"E")
120 W !,"OTHER TREATMENT @FAC DATE......: ",ONC(165.5,DA,57.4,"E")
121 Q
122 ;
123CHKPRIM ;If Primary Site UNKNOWN, BRAIN, HEMATOPOIETIC or LEUKEMIA,
124 ;stuff SCOPE OF LN SURGERY (R) (165.5,138) and
125 ; SCOPE OF LN SURGERY (F) (165.5,138.4) with 9s
126CHKPRMR ;ROADS
127 S SITE=$P(^ONCO(165.5,DA,0),U,1)
128 I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D
129 .D SGRP
130 .I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S SGRP=67141
131 .F SC=0:0 S SC=$O(^ONCO(164,SGRP,"SC5",SC)) Q:SC="B" S LAST=SC
132 .S $P(^ONCO(165.5,DA,3),U,40)=LAST
133 .W !,"SCOPE OF LN SURGERY.........(R): ",$P(^ONCO(164,SGRP,"SC5",LAST,0),U)
134 .D NODER^ONCUTX W !
135 .S NTX=1 D NODATFR K NTX
136 .S Y="@139"
137 Q
138 ;
139CHKPRMF ;SCOPE OF LN SURGERY (F) (165.5,138.4) Code 9 stuffing
140 ;FORDS pages 138-139
141 S TOP=$P($G(^ONCO(165.5,DA,2)),U,1)
142 S MO=$$HIST^ONCFUNC(DA)
143 I ($E(TOP,1,4)=6770)!($E(TOP,1,4)=6771)!($E(TOP,1,4)=6772)!($E(TOP,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&($E(TOP,1,4)=6777))!($E(TOP,1,4)=6776)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!((MO'<97310)&(MO'>99899)) D
144 .S $P(^ONCO(165.5,DA,3.1),U,31)=9
145 .W !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
146 .D NODE^ONCUTX W !
147 .S NTX=1 D NODEATF K NTX
148 .S Y="@46"
149 Q
150 ;
151SGRP S TPG=$P($G(^ONCO(165.5,D0,2)),U,1)
152 S SGRP=$P($G(^ONCO(164,TPG,0)),U,16)
153 ;pre-2003 C76.0-C76.8, C80.9 cases
154 ;see ROADS page D-cxliii
155 I DATEDX<3030000,($E(TPG,3,4)=76)!(TPG=67809) S SGRP=67141
156 Q
Note: See TracBrowser for help on using the repository browser.