source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCATF1.m@ 773

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

initial load of FOIAVistA 6/30/08 version
File size: 5.9 KB
Line 
1ONCATF1 ;Hines OIFO/RTK;TREATMENT AT THIS FACILITY STUFFING (CONT.); 08/12/98
2 ;;2.11;ONCOLOGY;**19,22,25,36,37,41,42**;Mar 07, 1995
3 ;
4RAD ;Radiation @fac
5 S RAUP=1 D RFNR^ONCATF1
6 D CHKCOC I COC'=4 Q
7 S $P(^ONCO(165.5,D0,3.1),U,12)=$P($G(^ONCO(165.5,D0,3)),U,6)
8 Q
9 ;
10RADDT ;Radiation @fac date
11 D CHKCOC I COC'=4 Q
12 S $P(^ONCO(165.5,D0,3.1),U,13)=$P($G(^ONCO(165.5,D0,3)),U,4)
13 Q
14 ;
15DSPRAD ;Display Radiation @fac fields
16 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@411" Q
17 .S NTX=1 W ! D RADATF^ONCNTX1 K NTX
18 .I $G(DRATF)=1 K DRATF,TXNUL Q
19 I $G(DRATF)=1 K DRATF,TXNUL S Y="@411" Q
20 I COC'=4 D Q
21 .I $G(TXNO)=1 S NTX=1 W ! D RADATF^ONCNTX1 K NTX,TXNO S Y="@411" Q
22 .I $G(TXUNK)=1 S NTX=1 W ! D RADATF^ONCUTX1 K NTX,TXUNK S Y="@411" Q
23 .I $G(TXNUL)=1 K TXNUL S Y="@411" Q
24 N DI,DIC,DA,DR,DIQ,ONC
25 S DIC="^ONCO(165.5,",DA=D0,DIQ="ONC(",DIQ(0)="E",DR="51.4;51.5"
26 D EN^DIQ1
27 W !!,$P(^DD(165.5,51.4,0),U,1),"............: "_$E(ONC(165.5,DA,51.4,"E"),1,47)
28 W !,$P(^DD(165.5,51.5,0),U,1),".......: "_ONC(165.5,DA,51.5,"E")
29 K TXNO,TXUNK,TXNUL S Y="@411" Q
30 ;
31CHEM ;Chemotherapy @fac
32 D CHKCOC I COC'=4 Q
33 S $P(^ONCO(165.5,D0,3.1),U,14)=$P($G(^ONCO(165.5,D0,3)),U,13)
34 Q
35 ;
36CHEMDT ;Chemotherapy @fac date
37 D CHKCOC I COC'=4 Q
38 S $P(^ONCO(165.5,D0,3.1),U,15)=$P($G(^ONCO(165.5,D0,3)),U,11)
39 Q
40 ;
41DSPCHEM ;Display Chemotherapy @fac fields
42 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@415" Q
43 .S NTX=1 W ! D CHEMATF^ONCNTX1 K NTX
44 .I $G(DCATF)=1 K DCATF,TXNUL Q
45 I $G(DCATF)=1 K DCATF,TXNUL S Y="@415" Q
46 I COC'=4 D Q
47 .I $G(TXNO)=1 S NTX=1 W ! D CHEMATF^ONCNTX1 K NTX,TXNO S Y="@415" Q
48 .I $G(TXUNK)=1 S NTX=1 W ! D CHEMATF^ONCUTX1 K NTX,TXUNK S Y="@415" Q
49 .I $G(TXNUL)=1 K TXNUL S Y="@415" Q
50 K DIQ,ONC
51 S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E",DR="53.3;53.4"
52 D EN^DIQ1
53 W !!,$P(^DD(165.5,53.3,0),U,1),"........: "_$E(ONC(165.5,DA,53.3,"E"),1,47)
54 W !,$P(^DD(165.5,53.4,0),U,1),"...: "_ONC(165.5,DA,53.4,"E")
55 K TXNO,TXUNK,TXNUL S Y="@415" Q
56 ;
57HT ;Hormone therapy @fac
58 D CHKCOC I COC'=4 Q
59 S $P(^ONCO(165.5,D0,3.1),U,16)=$P($G(^ONCO(165.5,D0,3)),U,16)
60 Q
61 ;
62HTDT ;Hormone therapy @fac date
63 D CHKCOC I COC'=4 Q
64 S $P(^ONCO(165.5,D0,3.1),U,17)=$P($G(^ONCO(165.5,D0,3)),U,14)
65 Q
66 ;
67DSPHT ;Display Hormone Therapy @fac fields
68 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@418" Q
69 .S NTX=1 W ! D HTATF^ONCNTX1 K NTX
70 .I $G(DHATF)=1 K DHATF,TXNUL Q
71 I $G(DHATF)=1 K DHATF,TXNUL S Y="@418" Q
72 I COC'=4 D Q
73 .I $G(TXNO)=1 S NTX=1 W ! D HTATF^ONCNTX1 K NTX,TXNO S Y="@418" Q
74 .I $G(TXUNK)=1 S NTX=1 W ! D HTATF^ONCUTX1 K NTX,TXUNK S Y="@418" Q
75 .I $G(TXNUL)=1 K TXNUL S Y="@418" Q
76 K DIQ,ONC
77 S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E",DR="54.3;54.4"
78 D EN^DIQ1
79 W !!,$P(^DD(165.5,54.3,0),U,1),".....: "_$E(ONC(165.5,DA,54.3,"E"),1,47)
80 W !,$P(^DD(165.5,54.4,0),U,1),": "_ONC(165.5,DA,54.4,"E")
81 K TXNO,TXUNK,TXNUL S Y="@418"
82 Q
83 ;
84IMM ;Immunotherapy @fac
85 D CHKCOC I COC'=4 Q
86 S $P(^ONCO(165.5,D0,3.1),U,18)=$P($G(^ONCO(165.5,D0,3)),U,19)
87 Q
88 ;
89IMMDT ;Immunotherapy @fac date
90 D CHKCOC I COC'=4 Q
91 S $P(^ONCO(165.5,D0,3.1),U,19)=$P($G(^ONCO(165.5,D0,3)),U,17)
92 Q
93 ;
94DSPIMM ;Display Immunotherapy @fac fields
95 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@421" Q
96 .S NTX=1 W ! D IMMATF^ONCNTX1 K NTX
97 .I $G(DIATF)=1 K DIATF,TXNUL Q
98 I $G(DIATF)=1 K DIATF,TXNUL S Y="@421" Q
99 I COC'=4 D Q
100 .I $G(TXNO)=1 S NTX=1 W ! D IMMATF^ONCNTX1 K NTX,TXNO S Y="@421" Q
101 .I $G(TXUNK)=1 S NTX=1 W ! D IMMATF^ONCUTX1 K NTX,TXUNK S Y="@421" Q
102 .I $G(TXNUL)=1 K TXNUL S Y="@421" Q
103 K DIQ,ONC
104 S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E",DR="55.3;55.4"
105 D EN^DIQ1
106 W !!,$P(^DD(165.5,55.3,0),U,1),".......: "_ONC(165.5,DA,55.3,"E")
107 W !,$P(^DD(165.5,55.4,0),U,1),"..: "_ONC(165.5,DA,55.4,"E")
108 K TXNO,TXUNK,TXNUL S Y="@421" Q
109 ;
110OTH ;Other therapy @fac
111 D CHKCOC I COC'=4 Q
112 S $P(^ONCO(165.5,D0,3.1),U,20)=$P($G(^ONCO(165.5,D0,3)),U,25)
113 Q
114 ;
115OTHDT ;Other therapy @fac date
116 D CHKCOC I COC'=4 Q
117 S $P(^ONCO(165.5,D0,3.1),U,21)=$P($G(^ONCO(165.5,D0,3)),U,23)
118 Q
119 ;
120DSPOTH ;Display Other Treatment @fac fields
121 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@424" Q
122 .S NTX=1 W ! D OTHATF^ONCNTX1 K NTX
123 .I $G(DOATF)=1 K DOATF,TXNUL Q
124 I $G(DOATF)=1 K DOATF,TXNUL S Y="@424" Q
125 I COC'=4 D Q
126 .I $G(TXNO)=1 S NTX=1 W ! D OTHATF^ONCNTX1 K NTX,TXNO S Y="@424" Q
127 .I $G(TXUNK)=1 S NTX=1 W ! D OTHATF^ONCUTX1 K NTX,TXUNK S Y="@424" Q
128 .I $G(TXNUL)=1 K TXNUL S Y="@424" Q
129 K DIQ,ONC
130 S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E",DR="57.3;57.4"
131 D EN^DIQ1
132 W !!,$P(^DD(165.5,57.3,0),U,1),".....: "_$E(ONC(165.5,DA,57.3,"E"),1,47)
133 W !,$P(^DD(165.5,57.4,0),U,1),": "_ONC(165.5,DA,57.4,"E")
134 K TXNO,TXUNK,TXNUL S Y="@424" Q
135 ;
136PP ;Palliative Procedure @fac
137 D CHKCOC I COC'=4 Q
138 S $P(^ONCO(165.5,D0,3.1),U,27)=$P($G(^ONCO(165.5,D0,3.1)),U,26)
139 Q
140 ;
141CHKCOC ;CLASS OF CASE
142 S COC=$P($G(^ONCO(165.5,D0,0)),U,4)
143 Q
144 ;
145RFNS ;If SURGERY OF PRIMARY (F) (165.5,58.6) and SURGERY OF PRIMARY @FAC
146 ;(F) (165.5,58.7) are anything but 00 or 99, set REASON NO SURGERY
147 ;OF PRIMARY (165.5,58) to 0 (Surgery performed)
148 S (FLAG1,FLAG2)=1
149 S SPS=$P($G(^ONCO(165.5,D0,3.1)),U,29) I SPS="" S FLAG1=0
150 S SPSATF=$P($G(^ONCO(165.5,D0,3.1)),U,30) I SPSATF="" S FLAG2=0
151 S TPX=$P($G(^ONCO(165.5,D0,2)),U,1) I TPX="" W !!,"PRIMARY SITE is not defined" H 3 S Y="@0" Q
152 S SGRP=$P($G(^ONCO(164,TPX,0)),U,16)
153 I SPS'="" I (SPS=1)!(SPS="00")!($G(^ONCO(164,SGRP,"SPS",SPS,0))[99) S FLAG1=0
154 I SPSATF'="" I (SPSATF=1)!(SPSATF="00")!($G(^ONCO(164,SGRP,"SPS",SPSATF,0))[99) S FLAG2=0
155 I FLAG1=0,FLAG2=0 Q
156 S $P(^ONCO(165.5,D0,3),U,26)=0
157 I $G(SUUP)=1 K SUUP Q
158 W !,$P($G(^DD(165.5,58,0)),U,1)_"...: Surgery performed"
159 S Y="@431" Q
160 ;
161RFNR ;If RADIATION, set REASON FOR NO RADIATION = 0 (Radiation administered)
162 S RDTX=$P($G(^ONCO(165.5,D0,3)),U,6)
163 S RDTXATF=$P($G(^ONCO(165.5,D0,3.1)),U,12)
164 I ((RDTX="")!(RDTX=0)!(RDTX=9))&((RDTXATF="")!(RDTXATF=0)!(RDTXATF=9)) Q
165 S $P(^ONCO(165.5,D0,3),U,35)=0
166 I $G(RAUP)=1 K RAUP Q
167 W !,$P($G(^DD(165.5,75,0)),U,1)_".........: Radiation administered"
168 S Y="@412" Q
169 Q
Note: See TracBrowser for help on using the repository browser.