source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOSUR2.m@ 852

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

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1ONCOSUR2 ;Hines OIFO/RTK - ONCOSUR continued ;12/19/00
2 ;;2.11;ONCOLOGY;**15,19,22,27,33,34,36,40,42**;Mar 07, 1995
3 ;
4 D TMK,EXT,LYM,TNM,CS,SUR,SCT W !
5 Q
6 ;
7TMK ;TUMOR MARKER 1 (165.5,25.1)
8 ;TUMOR MARKER 2 (165.5,25.2)
9 ;TUMOR MARKER 3 (165.5,25.3)
10 F SITESUB=67500:1:67509 S SITE(SITESUB)="BREAST"
11 F SITESUB=67180:1:67189 S SITE(SITESUB)="COLORECTAL"
12 S SITE(67199)="COLORECTAL"
13 S SITE(67220)="LIVER"
14 S SITE(67221)="LIVER"
15 S SITE(67569)="OVARY"
16 S SITE(67619)="PROSTATE"
17 S SITE(67620)="TESTIS"
18 S SITE(67621)="TESTIS"
19 S SITE(67629)="TESTIS"
20 I $G(SITE(OLDTOP))=$G(SITE(X)) Q
21 D MESSAGE
22 W !?5,"TUMOR MARKERS"
23 S $P(^ONCO(165.5,D0,24),U,2)=""
24 S $P(^ONCO(165.5,D0,24),U,3)=""
25 S $P(^ONCO(165.5,D0,24),U,7)=""
26 Q
27 ;
28EXT ;EXTENSION (165.5,30)
29 S ONCOX="E",ONCOT=OLDTOP S OLDEXT=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
30 S ONCOX="E",ONCOT=X S NEWEXT=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
31 I OLDEXT=NEWEXT Q
32 D MESSAGE
33 W !?5,"EXTENSION"
34 S $P(^ONCO(165.5,D0,2),U,10)=""
35 Q
36 ;
37LYM ;LYMPH NODES (165.5,31)
38 S ONCOX="L",ONCOT=OLDTOP S OLDLYM=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
39 S ONCOX="L",ONCOT=X S NEWLYM=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
40 I OLDLYM=NEWLYM Q
41 D MESSAGE
42 W !?5,"LYMPH NODES"
43 S $P(^ONCO(165.5,D0,2),U,11)=""
44 Q
45 ;
46TNM ;CLINICAL STAGING
47 ;PATHOLOGIC STAGING
48 S OLDTNM=$P($G(^ONCO(164,OLDTOP,0)),U,11) I OLDTNM="" Q
49 S NEWTNM=$P($G(^ONCO(164,X,0)),U,11) I NEWTNM="" Q
50 I OLDTNM=NEWTNM Q
51 D MESSAGE
52 W !?5,"CLINICAL STAGING",?36,"(all fields)"
53 W !?5,"PATHOLOGIC STAGING",?36,"(all fields)"
54 S $P(^ONCO(165.5,D0,2),U,25)="" ;37.1 ;CLINICAL T
55 S $P(^ONCO(165.5,D0,2),U,26)="" ;37.2 ;CLINICAL N
56 S $P(^ONCO(165.5,D0,2),U,27)="" ;37.3 ;CLINICAL M
57 S $P(^ONCO(165.5,D0,2),U,20)="" ;38 ;CLINICAL STAGE GROUP
58 S $P(^ONCO(165.5,D0,3),U,32)="" ;19 ;STAGED BY (CLINICAL STAGE)
59 S $P(^ONCO(165.5,D0,2.1),U,12)="" ;134 ;CLINICAL RISK FACTORS
60 S $P(^ONCO(165.5,D0,24),U,8)="" ;136 ;SERUM TUMOR MARKERS
61 S $P(^ONCO(165.5,D0,2.1),U,1)="" ;85 ;PATHOLOGIC T
62 S $P(^ONCO(165.5,D0,2.1),U,2)="" ;86 ;PATHOLOGIC N
63 S $P(^ONCO(165.5,D0,2.1),U,3)="" ;87 ;PATHOLOGIC M
64 S $P(^ONCO(165.5,D0,2.1),U,4)="" ;88 ;PATHOLOGIC STAGE GROUP
65 S $P(^ONCO(165.5,D0,2.1),U,5)="" ;89 ;STAGED BY (PATHOLOGIC STAGE)
66 S $P(^ONCO(165.5,D0,2.1),U,13)="" ;135 ;PATHOLOGIC RISK FACTORS
67 Q
68 ;
69SUR ;SURGICAL PROCEDURES
70 S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
71 S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
72 I OLDSCG=NEWSCG Q
73 D MESSAGE
74 W !?5,"SURGICAL PROCEDURES",?36,"(all fields)"
75 ;
76 S $P(^ONCO(165.5,D0,3),U,34)="" ;74 ;SURGICAL APPROACH (R)
77 S $P(^ONCO(165.5,D0,3),U,38)="" ;58.2 ;SURGERY OF PRIMARY (R)
78 S $P(^ONCO(165.5,D0,3.1),U,7)="" ;50.2 ;SURGERY OF PRIMARY @FAC (R)
79 S $P(^ONCO(165.5,DA,3),U,40)="" ;138 ;SCOPE OF LN SURGERY (R)
80 S $P(^ONCO(165.5,DA,3.1),U,9)="" ;138.1;SCOPE OF LN SURGERY @FAC (R)
81 S $P(^ONCO(165.5,DA,3),U,42)="" ;140 ;NUMBER OF LN REMOVED (R)
82 S $P(^ONCO(165.5,DA,3.1),U,11)="" ;140.1;NUMBER OF LN REMOVED @FAC(R)
83 S $P(^ONCO(165.5,DA,3),U,41)="" ;139 ;SURG PROC/OTHER SITE (R)
84 S $P(^ONCO(165.5,DA,3.1),U,10)="" ;139.1;SURG PROC/OTHER SITE @FAC(R)
85 ;
86 S $P(^ONCO(165.5,D0,3.1),U,29)="" ;58.6 ;SURGERY OF PRIMARY (F)
87 S TXDT=$P(^ONCO(165.5,DA,3),U,1)_"S1"
88 S $P(^ONCO(165.5,DA,3),U,1)="" ;50 ;MOST DEFINITIVE SURG DATE
89 K ^ONCO(165.5,"ATX",DA,TXDT)
90 S $P(^ONCO(165.5,DA,3),U,28)="" ;59 ;SURGICAL MARGINS
91 S $P(^ONCO(165.5,D0,3.1),U,30)="" ;58.7 ;SURGERY OF PRIMARY @FAC (F)
92 S $P(^ONCO(165.5,DA,3.1),U,8)="" ;50.3 ;MOST DEFINITIVE SURG @FAC DATE
93 ;
94 S $P(^ONCO(165.5,DA,3.1),U,31)="" ;138.4;SCOPE OF LN SURGERY (F)
95 S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,22)_"S2"
96 S $P(^ONCO(165.5,DA,3.1),U,22)="" ;138.2;SCOPE OF LN SURGERY DATE
97 K ^ONCO(165.5,"ATX",DA,TXDT)
98 S $P(^ONCO(165.5,DA,3.1),U,32)="" ;138.5;SCOPE OF LN SURGERY @FAC (F)
99 S $P(^ONCO(165.5,DA,3.1),U,23)="" ;138.2;SCOPE OF LN SURGERY @FAC DT
100 ;
101 S $P(^ONCO(165.5,DA,3.1),U,33)="" ;139.4;SURG PROC/OTHER SITE (F)
102 S TXDT=$P(^ONCO(165.5,DA,3.1),U,24)_"S3"
103 S $P(^ONCO(165.5,DA,3.1),U,24)="" ;139.2;SURG PROC/OTHER SITE DATE
104 K ^ONCO(165.5,"ATX",DA,TXDT)
105 S $P(^ONCO(165.5,DA,3.1),U,34)="" ;139.5;SURG PROC/OTHER SITE @FAC(F)
106 S $P(^ONCO(165.5,DA,3.1),U,25)="" ;139.3;SURG PROC/OTHER SITE @FAC DT
107 S $P(^ONCO(165.5,DA,3),U,33)="" ;23 ;RECONSTRUCTION/RESTORATION
108 S $P(^ONCO(165.5,DA,"THY1"),U,36)="" ;435 ;DATE OF SURGICAL DISCHARGE
109 S $P(^ONCO(165.5,DA,3.1),U,28)="" ;14 ;READMISSION W/I 30 DAYS/SURG
110 K ^ONCO(165.5,DA,14) ;108 ;TEXT-RX-SURGERY
111 S $P(^ONCO(165.5,DA,3),U,26)="" ;58 ;REASON NO SURGERY OF PRIMARY
112 Q
113SCT ;
114 S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
115 S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
116 I OLDSCG=NEWSCG Q
117 D MESSAGE
118 W !?5,"SUBSEQUENT COURSE OF TREATMENT",?36,"(all surgery fields)"
119 F SCT=0:0 S SCT=$O(^ONCO(165.5,DA,4,SCT)) Q:SCT'>0 D
120 .S $P(^ONCO(165.5,DA,4,SCT,0),U,4)="" ;.04 ;SURGERY OF PRIMARY
121 .S $P(^ONCO(165.5,DA,4,SCT,0),U,11)="" ;.041;SURGERY OF PRIMARY DATE
122 .S $P(^ONCO(165.5,DA,4,SCT,2),U,32)="" ;35 ;SCOPE OF LN SURGERY
123 .S $P(^ONCO(165.5,DA,4,SCT,2),U,34)="" ;37 ;NUMBER OF LN REMOVED
124 .S $P(^ONCO(165.5,DA,4,SCT,2),U,33)="" ;36 ;SURG PROC/OTHER SITE
125 .S $P(^ONCO(165.5,DA,4,SCT,2),U,30)="" ;33 ;RECON/RESTORE DELAYED
126 .S $P(^ONCO(165.5,DA,4,SCT,2),U,31)="" ;34 ;RECON/RESTORE DELAY DATE
127 W !
128 Q
129 ;
130CS ;COLLOBORATIVE STAGING
131 S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
132 S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
133 I OLDSCG=NEWSCG Q
134 D MESSAGE
135 W !?5,"COLLABORATIVE STAGING",?36,"(all fields)"
136 F PIECE=1:1:12 S $P(^ONCO(165.5,D0,"CS"),U,PIECE)=""
137 F PIECE=1:1:11 S $P(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
138 Q
139 ;
140MESSAGE ;
141 I MSSG=1 Q
142 W !!?3,"You have changed the PRIMARY SITE. The new topography is"
143 W !?3,"outside of the old topography's site group. This change"
144 W !?3,"may affect the validity of all site-specific fields. Therefore,"
145 W !?3,"these fields have been initialized and need to be re-entered:"
146 W ! S MSSG=1 Q
147 Q
Note: See TracBrowser for help on using the repository browser.