source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCPTX.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.3 KB
Line 
1ONCPTX ;Hines OIFO/GWB - FIRST COURSE OF TREATMENT ;9/24/97
2 ;;2.11;ONCOLOGY;**13,15,17,19,27,32,34,36,37,39,41,42,45,46**;Mar 07, 1995;Build 39
3 ;
4NCDS D FST^ONCOAIP
5 S CC=$P($G(^ONCO(165.5,D0,0)),U,4)
6 I CC=4 D
7 .W !," **NOTE** CLASS OF CASE = 4 (Dx/1st tx before ref date)"
8 .W !," The @FAC (at this facility) fields will be stuffed to"
9 .W !," match the primary treatment fields."
10 .W !,DASHES
11 I (CC=0)!(CC=3)!(CC=6) D
12 .S CCTXT=$S(CC=0:"0 (Dx here, 1st tx ew)",CC=3:"3 (Dx ew, 1st tx ew)",CC=6:"6 (Dx/1st tx in MD office)",1:CC)
13 .W !," **NOTE** CLASS OF CASE = ",CCTXT
14 .W !," The @FAC (at this facility) fields will be stuffed with the"
15 .W !," appropriate value indicating that no treatment was given"
16 .W !," at this facility."
17 .W !,DASHES
18 K CC,CCTXT
19 N DI,DIC,DR,DA,DIQ K ONC
20 S DIC="^ONCO(165.5,"
21 S DR="58.1;58.3;58.4;58.5"
22 S DA=D0,DIQ="ONC(" D EN^DIQ1
23 F I=58.1,58.4 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
24 W !," SURGICAL DIAGNOSTIC AND STAGING PROCEDURES"
25 W !," ------------------------------------------"
26 S TXT=ONC(165.5,D0,58.1),LEN=38 D TXT
27 W !," Surgical Dx/Staging Proc.....: ",ONC(165.5,D0,58.3),?43,TXT1
28 W:TXT2'="" !,?43,TXT2
29 S TXT=ONC(165.5,D0,58.4),LEN=38 D TXT
30 W !," Surg Dx/Staging Proc @fac....: ",ONC(165.5,D0,58.5),?43,TXT1 W:TXT2'="" !,?43,TXT2
31 W !,DASHES
32 Q
33 ;
34ROADS ;SURGICAL PROCEDURES (ROADS)
35 N DI,DIC,DR,DA,DIQ K ONC
36 S DIC="^ONCO(165.5,"
37 S DR="50;58.6;50.3;58.7;59;138:138.5;139:139.5;435;14;58;23;74;58.2;50.2;140;140.1"
38 S DA=D0,DIQ="ONC(" D EN^DIQ1
39 F I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,435,14,58,23,74,58.2,50.2,140,140.1 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
40 D FST^ONCOAIP
41 W !," SURGICAL PROCEDURES (ROADS)"
42 W !," Pre-2003 cases require the following ROADS surgery items to be coded:"
43 W !," ---------------------------------------------------------------------"
44 S TXT=ONC(165.5,D0,58.2),LEN=46 D TXT
45 W !," Surgery of primary.........(R): ",TXT1 W:TXT2'="" !,?33,TXT2
46 W !," Surgical Approach..........(R): ",ONC(165.5,DA,74)
47 S TXT=ONC(165.5,D0,50.2),LEN=46 D TXT
48 W !," Surgery of primary @fac....(R): ",TXT1 W:TXT2'="" !,?33,TXT2
49 S TXT=ONC(165.5,D0,138),LEN=46 D TXT
50 W !," Scope of ln surgery........(R): ",TXT1 W:TXT2'="" !,?33,TXT2
51 W !," Number of LN removed...... (R): ",ONC(165.5,D0,140)
52 S TXT=ONC(165.5,D0,138.1),LEN=46 D TXT
53 W !," Scope of ln surgery @fac...(R): ",TXT1 W:TXT2'="" !,?33,TXT2
54 W !," Number of LN removed @fac..(R): ",ONC(165.5,D0,140.1)
55 S TXT=ONC(165.5,D0,139),LEN=46 D TXT
56 W !," Surg proc/other site.......(R): ",TXT1 W:TXT2'="" !,?33,TXT2
57 S TXT=ONC(165.5,D0,139.1),LEN=46 D TXT
58 W !," Surg proc/other site @fac..(R): ",TXT1 W:TXT2'="" !,?33,TXT2
59 W !,DASHES
60 Q
61 ;
62FORDS ;SURGICAL PROCEDURES (FORDS)
63 S TOPX=$P($G(^ONCO(165.5,D0,2)),U,1)
64 I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D
65 .S $P(^ONCO(165.5,D0,3.1),U,29)=1
66 N DI,DIC,DR,DA,DIQ K ONC
67 S DIC="^ONCO(165.5,"
68 S DR="50;58.6;50.3;58.7;59;138:138.5;139:139.5;435;14;58;23;74;58.2;50.2;140;140.1;170;46;47"
69 S DA=D0,DIQ="ONC(" D EN^DIQ1
70 F I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,435,14,58,23,74,58.2,50.2,140,140.1 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
71 D FST^ONCOAIP
72 W !," SURGICAL PROCEDURES (FORDS)"
73 W !," ---------------------------"
74 W !," Date First Surgical Procedure.: ",$E(ONC(165.5,D0,170),1,6)_$E(ONC(165.5,D0,170),9,10)
75 S TXT=ONC(165.5,D0,58.6),LEN=38 D TXT
76 W !," Surgery of primary.........(F): ",$E(ONC(165.5,D0,50),1,6)_$E(ONC(165.5,D0,50),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
77 S TXT=ONC(165.5,D0,58.7),LEN=38 D TXT
78 W !," Surgery of primary @fac....(F): ",$E(ONC(165.5,D0,50.3),1,6)_$E(ONC(165.5,D0,50.3),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
79 W !," Surgical margins..............: ",ONC(165.5,DA,59)
80 S TXT=ONC(165.5,D0,138.4),LEN=38 D TXT
81 W !," Scope of ln surgery........(F): ",$E(ONC(165.5,D0,138.2),1,6)_$E(ONC(165.5,D0,138.2),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
82 S TXT=ONC(165.5,D0,138.5),LEN=38 D TXT
83 W !," Scope of ln surgery @fac...(F): ",$E(ONC(165.5,D0,138.3),1,6)_$E(ONC(165.5,D0,138.3),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
84 S TXT=ONC(165.5,D0,139.4),LEN=38 D TXT
85 W !," Surg proc/other site.......(F): ",$E(ONC(165.5,D0,139.2),1,6)_$E(ONC(165.5,D0,139.2),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
86 S TXT=ONC(165.5,D0,139.5),LEN=38 D TXT
87 W !," Surg proc/other site @fac..(F): ",$E(ONC(165.5,D0,139.3),1,6)_$E(ONC(165.5,D0,139.3),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
88 S TXT=ONC(165.5,D0,23),LEN=38 D TXT
89 W:DATEDX<3030000 !," Reconstruction/restoration....: ",?33,TXT1 W:TXT2'="" !,?33,TXT2
90 W !," Date of surgical discharge....: ",$E(ONC(165.5,D0,435),1,6)_$E(ONC(165.5,D0,435),9,10)
91 W !," Readmission w/i 30 days/surg..: ",ONC(165.5,D0,14)
92 W !," Reason no surgery of primary..: ",ONC(165.5,D0,58)
93 W !," CAP Protocol Review...........: ",ONC(165.5,D0,46)
94 W:ONC(165.5,D0,46)="Failed" !," CAP Text......................: ",ONC(165.5,D0,47)
95 W !,DASHES
96 Q
97 ;
98RAD D FST^ONCOAIP
99 W !," RADIATION"
100 W !," ---------"
101 N DI,DIC,DR,DA,DIQ K ONC
102 S DIC="^ONCO(165.5,"
103 S DR="51;51.2;51.3;51.4;51.5;56;75;125;126;363;442;363.1;443;361"
104 S DA=D0,DIQ="ONC(" D EN^DIQ1
105 F I=51.2,126,125,363,363.1,56,51.3,51.4,75,442,443 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
106 W !," Radiation.....................: ",ONC(165.5,DA,51.2)
107 W !," Date radiation started........: ",ONC(165.5,DA,51)
108 W !," Radiation @fac................: ",ONC(165.5,DA,51.5)," ",ONC(165.5,DA,51.4)
109 W !," Location of radiation tx......: ",ONC(165.5,DA,126)
110 W !," Radiation treatment volume....: ",ONC(165.5,DA,125)
111 W !," Regional treatment modality...: ",ONC(165.5,DA,363)
112 W !," Regional dose:cGy.............: ",ONC(165.5,DA,442)
113 W !," Boost treatment modality......: ",ONC(165.5,DA,363.1)
114 W !," Boost dose:cGy................: ",ONC(165.5,DA,443)
115 W !," Number of txs to this volume..: ",ONC(165.5,DA,56)
116 W !," Radiation/surgery sequence....: ",ONC(165.5,DA,51.3)
117 W !," Date radiation ended..........: ",ONC(165.5,DA,361)
118 W !," Reason for no radiation.......: ",ONC(165.5,DA,75)
119 W !,DASHES
120 Q
121 ;
122ST D FST^ONCOAIP
123 W !," SYSTEMIC THERAPY"
124 W !," ----------------"
125 N DI,DIC,DR,DA,DIQ K ONC
126 S DIC="^ONCO(165.5,"
127 S DR="152;53;53.2;53.3;53.4;54;54.2;54.3;54.4;55;55.2;55.3;55.4;153;153.1;15"
128 S DA=D0,DIQ="ONC(" D EN^DIQ1
129 F I=53.2,53.3,54.2,54.3,55.2,55.3,153,15 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
130 W !," Date systemic therapy started.: ",ONC(165.5,DA,152)
131 W !," Chemotherapy..................: ",ONC(165.5,DA,53),?44,$E(ONC(165.5,DA,53.2),1,34)
132 W !," Chemotherapy @fac.............: ",ONC(165.5,DA,53.4),?44,$E(ONC(165.5,DA,53.3),1,34)
133 W !," Hormone therapy...............: ",ONC(165.5,DA,54),?44,$E(ONC(165.5,DA,54.2),1,34)
134 W !," Hormone therapy @fac..........: ",ONC(165.5,DA,54.4),?44,$E(ONC(165.5,DA,54.3),1,34)
135 W !," Immunotherapy.................: ",ONC(165.5,DA,55),?44,$E(ONC(165.5,DA,55.2),1,34)
136 W !," Immunotherapy @fac............: ",ONC(165.5,DA,55.4),?44,$E(ONC(165.5,DA,55.3),1,34)
137 W !," Hema Trans/Endocrine Proc.....: ",ONC(165.5,DA,153.1),?44,$E(ONC(165.5,DA,153),1,34)
138 W:DATEDX>3051231 !," Systemic/Surgery Sequence.....: ",ONC(165.5,DA,15)
139 W !,DASHES
140 Q
141OTH D FST^ONCOAIP
142 W !," OTHER TREATMENT"
143 W !," ---------------"
144 N DI,DIC,DR,DA,DIQ K ONC
145 S DIC="^ONCO(165.5,"
146 S DR="57;57.2;57.3;57.4"
147 S DA=D0,DIQ="ONC(" D EN^DIQ1
148 F I=57,57.2,57.3,57.4 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
149 W !," Other treatment...............: ",ONC(165.5,DA,57)," ",ONC(165.5,DA,57.2)
150 W !," Other treatment @fac..........: ",ONC(165.5,DA,57.4)," ",ONC(165.5,DA,57.3)
151 W !,DASHES
152 Q
153PRO D FST^ONCOAIP
154 W !," PALLIATIVE CARE/PROTOCOL PARTICIPATION"
155 W !," -------------------------------------------"
156 N DI,DIC,DR,DA,DIQ K ONC
157 S DIC="^ONCO(165.5,"
158 S DR="133;560;154;12;13;346"
159 S DA=D0,DIQ="ONC(" D EN^DIQ1
160 F I=560,154,12,13,346 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
161 ;W !," Pain assessment...............: ",ONC(165.5,DA,154)
162 W !," Palliative care...............: ",ONC(165.5,DA,12)
163 W !," Palliative care @fac..........: ",ONC(165.5,DA,13)
164 W !
165 W !," Protocol eligibility status...: "_ONC(165.5,DA,346)
166 W !," Protocol participation........: "_ONC(165.5,DA,560)
167 W !," Year put on protocol..........: "_ONC(165.5,DA,133)
168 W !,DASHES
169 Q
170 ;
171TXT S (TXT1,TXT2)="",LOS=$L(TXT) I LOS<LEN S TXT1=TXT Q
172 S NOP=$L($E(TXT,1,LEN)," ")
173 S TXT1=$P(TXT," ",1,NOP-1),TXT2=$P(TXT," ",NOP,999)
174 Q
175 ;
176UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
177 Q
Note: See TracBrowser for help on using the repository browser.