source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCATF.m@ 1042

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

initial load of WorldVistAEHR
File size: 6.8 KB
Line 
1ONCATF ;Hines OIFO/RTK;TREATMENT @FAC STUFFING; 08/12/98
2 ;;2.11;ONCOLOGY;**19,25,27,36,40,42,46**;Mar 07, 1995;Build 39
3 ;
4NCDS ;SURG DX/STAGING PROC @FAC (165.5,58.4)
5 D CHKCOC I (COC'=0)&(COC'=1)&(COC'=4) Q
6 S $P(^ONCO(165.5,D0,3.1),U,5)=$P($G(^ONCO(165.5,D0,3)),U,27)
7 Q
8 ;
9NCDSDT ;SURG DX/STAGING PROC @FAC DATE (165.5,58.5)
10 D CHKCOC I (COC'=0)&(COC'=1)&(COC'=4) Q
11 S $P(^ONCO(165.5,D0,3.1),U,6)=$P($G(^ONCO(165.5,D0,3)),U,31)
12 Q
13 ;
14DSPNCDS ;Display SURG DX/STAGING PROC @FAC (165.5,58.4)
15 D CHKCOC I (COC=2)!(COC=3) D K TXNO,TXUNK,TXNUL S Y="@36" Q
16 .S NTX=1 W ! D NCDSATF^ONCNTX1 K NTX
17 .I $G(DNCATF)=1 K DNCATF,TXNUL Q
18 I $G(DNCATF)=1 K DNCATF,TXNUL S Y="@36" Q
19 I (COC'=0)&(COC'=1)&(COC'=4) D Q
20 .I $G(TXNO)=1 S NTX=1 W ! D NCDSATF^ONCNTX1 K NTX,TXNO S Y="@36" Q
21 .I $G(TXUNK)=1 S NTX=1 W ! D NCDSATF^ONCUTX1 K NTX,TXUNK S Y="@36" Q
22 .I $G(TXNUL)=1 K TXNUL S Y="@36" Q
23 N DI,DIC,DA,DR,DIQ,ONC
24 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E",DR="58.4;58.5"
25 D EN^DIQ1
26 W !!,$P(^DD(165.5,58.4,0),U,1),".....: "_$E(ONC(165.5,DA,58.4,"E"),1,47)
27 W !,$P(^DD(165.5,58.5,0),U,1),": "_ONC(165.5,DA,58.5,"E")
28 K TXNO,TXUNK,TXNUL S Y="@36"
29 Q
30 ;
31SPSR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
32 D CHKCOC I COC'=4 Q
33 S $P(^ONCO(165.5,D0,3.1),U,7)=$P($G(^ONCO(165.5,D0,3)),U,38)
34 Q
35 ;
36DSPSPSR ;Display SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
37 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@427" Q
38 .S NTX=1 W ! D SURATFR^ONCNTX1 K NTX
39 .I $G(DSATF)=1 K DSATF,TXNUL Q
40 I $G(DSATF)=1 K DSATF,TXNUL S Y="@427" Q
41 I COC'=4 D Q
42 .I $G(TXNO)=1 S NTX=1 W ! D SURATFR^ONCNTX1 K NTX,TXNO S Y="@427" Q
43 .I $G(TXUNK)=1 S NTX=1 W ! D SURATFR^ONCUTX1 K NTX,TXUNK S Y="@427" Q
44 .I $G(TXNUL)=1 K TXNUL S Y="@427" Q
45 N DI,DIC,DA,DR,DIQ,ONC
46 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
47 S DR=50.2
48 D EN^DIQ1
49 I $G(DSATF)'=1 D
50 .W !!,$P(^DD(165.5,50.2,0),U,1),"....: "_$E(ONC(165.5,DA,50.2,"E"),1,48)
51 K DSATF,TXNO,TXUNK,TXNUL S Y="@427"
52 Q
53 ;
54SPS ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
55 S SUUP=1 D RFNS^ONCATF1
56 D CHKCOC I COC'=4 Q
57 S $P(^ONCO(165.5,D0,3.1),U,30)=$P($G(^ONCO(165.5,D0,3.1)),U,29)
58 Q
59 ;
60SPSDT ;MOST DEFINITIVE SURG @FAC DATE (165.5,50.3)
61 D CHKCOC I COC'=4 Q
62 S $P(^ONCO(165.5,D0,3.1),U,8)=$P($G(^ONCO(165.5,D0,3)),U,1)
63 Q
64 ;
65DSPSPS ;Display SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
66 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@43" Q
67 .S NTX=1 W ! D SURATF^ONCNTX1 K NTX
68 .I $G(DSATF)=1 K DSATF,TXNUL Q
69 I $G(DSATF)=1 K DSATF,TXNUL S Y="@43" Q
70 I COC'=4 D Q
71 .I $G(TXNO)=1 S NTX=1 W ! D SURATF^ONCNTX1 K NTX,TXNO S Y="@43" Q
72 .I $G(TXUNK)=1 S NTX=1 W ! D SURATF^ONCUTX1 K NTX,TXUNK S Y="@43" Q
73 .I $G(TXNUL)=1 K TXNUL S Y="@43" Q
74 N DI,DIC,DA,DR,DIQ,ONC
75 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
76 S DR="58.7;50.3"
77 D EN^DIQ1
78 I $G(DSATF)'=1 D
79 .W !!,"SURGERY OF PRIMARY @FAC.....(F): "_$E(ONC(165.5,DA,58.7,"E"),1,48)
80 .W !,"MOST DEFINITIVE SURG @FAC DATE.: "_ONC(165.5,DA,50.3,"E") Q
81 K DSATF,TXNO,TXUNK,TXNUL S Y="@43"
82 Q
83 ;
84SCPR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
85 D CHKCOC I COC'=4 Q
86 S $P(^ONCO(165.5,D0,3.1),U,9)=$P($G(^ONCO(165.5,D0,3)),U,40)
87 Q
88 ;
89SCP ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
90 D CHKCOC I COC'=4 Q
91 S $P(^ONCO(165.5,D0,3.1),U,32)=$P($G(^ONCO(165.5,D0,3.1)),U,31)
92 Q
93 ;
94SCPDT ;SCOPE OF LN SURGERY @FAC DATE (165.5,138.3)
95 D CHKCOC I COC'=4 Q
96 S $P(^ONCO(165.5,D0,3.1),U,23)=$P($G(^ONCO(165.5,D0,3.1)),U,22)
97 Q
98 ;
99NUMND ;NUMBER OF LN REMOVED @FAC (R) (165.5,140.1)
100 D CHKCOC I COC'=4 Q
101 S $P(^ONCO(165.5,D0,3.1),U,11)=$P($G(^ONCO(165.5,D0,3)),U,42)
102 Q
103 ;
104DSPSCPR ;Display SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
105 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@139" Q
106 .S NTX=1 W ! D NODATFR^ONCNTX1 K NTX
107 .I $G(DSCATF)=1 K DSCATF,TXNUL Q
108 I $G(DSCATF)=1 K DSCATF,TXNUL S Y="@139" Q
109 I COC'=4 D Q
110 .I $G(TXNO)=1 S NTX=1 W ! D NODATFR^ONCNTX1 K NTX,TXNO S Y="@139" Q
111 .I $G(TXUNK)=1 S NTX=1 W ! D NODATFR^ONCUTX1 K NTX,TXUNK S Y="@139" Q
112 .I $G(TXNUL)=1 K TXNUL S Y="@139" Q
113 N DI,DIC,DA,DR,DIQ,ONC
114 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
115 S DR="138.1;140.1"
116 D EN^DIQ1
117 I $G(DSCATF)'=1 D
118 .W !!,$P(^DD(165.5,138.1,0),U,1),"...: "_$E(ONC(165.5,DA,138.1,"E"),1,48)
119 .W !,$P(^DD(165.5,140.1,0),U,1),"..: "_ONC(165.5,DA,140.1,"E")
120 K DSCATF,TXNO,TXUNK,TXNUL S Y="@139" Q
121 ;
122DSPSCP ;Display SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
123 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@46" Q
124 .S NTX=1 W ! D NODEATF^ONCNTX1 K NTX
125 .I $G(DSCATF)=1 K DSCATF,TXNUL Q
126 I $G(DSCATF)=1 K DSCATF,TXNUL S Y="@46" Q
127 I COC'=4 D Q
128 .I $G(TXNO)=1 S NTX=1 W ! D NODEATF^ONCNTX1 K NTX,TXNO S Y="@46" Q
129 .I $G(TXUNK)=1 S NTX=1 W ! D NODEATF^ONCUTX1 K NTX,TXUNK S Y="@46" Q
130 .I $G(TXNUL)=1 K TXNUL S Y="@46" Q
131 N DI,DIC,DA,DR,DIQ,ONC
132 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
133 S DR="138.5;138.3"
134 D EN^DIQ1
135 I $G(DSCATF)'=1 D
136 .W !!,$P(^DD(165.5,138.5,0),U,1),"....: "_$E(ONC(165.5,DA,138.5,"E"),1,48)
137 .W !,$P(^DD(165.5,138.3,0),U,1),".: "_ONC(165.5,DA,138.3,"E")
138 K DSCATF,TXNO,TXUNK,TXNUL S Y="@46" Q
139 ;
140SOSNR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139)
141 D CHKCOC I COC'=4 Q
142 S $P(^ONCO(165.5,D0,3.1),U,10)=$P($G(^ONCO(165.5,D0,3)),U,41)
143 Q
144 ;
145SOSN ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
146 D CHKCOC I COC'=4 Q
147 S $P(^ONCO(165.5,D0,3.1),U,34)=$P($G(^ONCO(165.5,D0,3.1)),U,33)
148 Q
149 ;
150SOSNDT ;SURG PROC/OTHER SITE @FAC DATE (165.5,139.3)
151 D CHKCOC I COC'=4 Q
152 S $P(^ONCO(165.5,D0,3.1),U,25)=$P($G(^ONCO(165.5,D0,3.1)),U,24)
153 Q
154 ;
155DSPSOSR ;Display SURG PPROC/OTHER SITE @FAC (R) (165.5,139.1)
156 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@428" Q
157 .S NTX=1 W ! D SOSATFR^ONCNTX1 K NTX
158 .I $G(DSOATF)=1 K DSOATF,TXNUL Q
159 I $G(DSOATF)=1 K DSOATF,TXNUL S Y="@428" Q
160 I COC'=4 D Q
161 .I $G(TXNO)=1 S NTX=1 W ! D SOSATFR^ONCNTX1 K NTX,TXNO S Y="@428" Q
162 .I $G(TXUNK)=1 S NTX=1 W ! D SOSATFR^ONCUTX1 K NTX,TXUNK S Y="@428" Q
163 .I $G(TXNUL)=1 K TXNUL S Y="@428" Q
164 N DI,DIC,DA,DR,DIQ,ONC
165 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
166 S DR=139.1
167 D EN^DIQ1
168 I $G(DSOATF)'=1 D
169 .W !,$P(^DD(165.5,139.1,0),U,1),": "_ONC(165.5,DA,139.1,"E") Q
170 K DSOATF,TXNO,TXUNK,TXNUL S Y="@428" Q
171 ;
172DSPSOSN ;Display SURG PPROC/OTHER SITE @FAC (F) (165.5,139.5)
173 D CHKCOC I (COC=0)!(COC=3)!(COC=6) D K TXNO,TXUNK,TXNUL S Y="@48" Q
174 .S NTX=1 W ! D SOSNATF^ONCNTX1 K NTX
175 .I $G(DSOATF)=1 K DSOATF,TXNUL Q
176 I $G(DSOATF)=1 K DSOATF,TXNUL S Y="@48" Q
177 I COC'=4 D Q
178 .I $G(TXNO)=1 S NTX=1 W ! D SOSNATF^ONCNTX1 K NTX,TXNO S Y="@48" Q
179 .I $G(TXUNK)=1 S NTX=1 W ! D SOSNATF^ONCUTX1 K NTX,TXUNK S Y="@48" Q
180 .I $G(TXNUL)=1 K TXNUL S Y="@48" Q
181 N DI,DIC,DA,DR,DIQ,ONC
182 S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
183 S DR="139.5;139.3"
184 D EN^DIQ1
185 I $G(DSOATF)'=1 D
186 .W !!,$P(^DD(165.5,139.5,0),U,1),": "_$E(ONC(165.5,DA,139.5,"E"),1,48)
187 .W !,$P(^DD(165.5,139.3,0),U,1),": "_ONC(165.5,DA,139.3,"E") Q
188 K DSOATF,TXNO,TXUNK,TXNUL S Y="@48" Q
189 ;
190CHKCOC ;CLASS OF CASE
191 S COC=$P($G(^ONCO(165.5,D0,0)),U,4)
192 Q
Note: See TracBrowser for help on using the repository browser.