source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOTNS.m@ 736

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

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1ONCOTNS ;Hines OIFO/GWB - AJCC TNM STAGING ;07/29/05
2 ;;2.11;ONCOLOGY;**6,7,11,13,28,36,37,44**;Mar 07, 1995
3 ;CLINICAL STAGE GROUP (165.5,38)
4 ;PATHOLOGIC STAGE GROUP (165.5,88)
5 ;OTHER STAGE GROUP (165.5,117)
6 ;
7IN ;Input transform
8 N ONCOS S ONCOS=$P($G(^ONCO(165.5,D0,0)),U,1)
9 N ONCOH S ONCOH=$$HIST^ONCFUNC(D0)
10 I STGIND="X" G IN1
11 I $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63) D
12 .S STGIND="L"
13 ;
14IN1 S DIC="^ONCO(164.45,",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)[STGIND"
15 D ^DIC
16 I (X["(A)")!(X["(B)") D
17 .W !!,"Enter systemic symptom suffixes at the LYMPH NODES prompt."
18 I Y=-1 K X Q
19 S X=$P(^ONCO(164.45,+Y,0),U,2)
20 Q
21 ;
22INNUM S X=$S(X["NA":88,X["Unk":99,X["Occ":"0C",X="0a":"0A",X="0is":"0S",1:X)
23 I X="IIIE+S" S X="3ES" Q
24 I X="V" S X=5 Q
25 I $E(X,1,2)="IV" S X=4_$E(X,3) Q
26 I $E(X,1,3)="III" S X=3_$E(X,4) Q
27 I $E(X,1,2)="II" S X=2_$E(X,3) Q
28 I $E(X,1)="I" S X=1_$E(X,2) Q
29 Q
30 ;
31HP ;HELP
32 N ONCOI,ONCOX,ONCOXS,ONCOH,ONCOS,SG1,SG2,SGT
33 S ONCOI=0,ONCOXS=""
34 I STGIND="X" G HP1
35 N ONCOS S ONCOS=$P($G(^ONCO(165.5,D0,0)),U,1)
36 N ONCOH S ONCOH=$$HIST^ONCFUNC(D0)
37 I $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63) D
38 .S STGIND="L"
39HP1 W !,"Select one of the following:",!
40 F S ONCOXS=$O(^ONCO(164.45,"B",ONCOXS)) Q:ONCOXS="" D
41 .S ONCOI=$O(^ONCO(164.45,"B",ONCOXS,0)),ONCOX=^ONCO(164.45,ONCOI,0)
42 .S SG1=$P(ONCOX,U,1),SG2=$P(ONCOX,U,2),SGT=$P(ONCOX,U,3)
43 .W:SGT[STGIND !?5,SG1,?10,SG2
44 Q
45OT ;Output transform
46 I Y'="" D
47 .S STG=$O(^ONCO(164.45,"B",Y,""))
48 .I STG'="" S Y=$P($G(^ONCO(164.45,STG,0)),U,2)
49 .S ONCS=$P($G(^ONCO(165.5,D0,0)),U,1)
50 .S ONCH=$$HIST^ONCFUNC(D0)
51 .I $$LYMPHOMA^ONCFUNC(D0)!(ONCS=62)!(ONCS=63) D
52 ..S SSIN=$P($G(^ONCO(165.5,D0,2)),U,11),SSOT=""
53 ..I SSIN=0 S SSOT="(A)"
54 ..I (SSIN=1)!(SSIN=2)!(SSIN=3) S SSOT="(B)"
55 ..I SSIN'=9 S Y=Y_" "_SSOT
56 K STG,ONCS,ONCH,SSIN,SSOT Q
57RS S XX=$G(^ONCO(165.5,D0,2)),TX=$P(XX,U) G EX:TX="",EX:$P(^ONCO(164,+TX,0),U,11)="" S N=$E(Y),N=$S(N=1:"I",N=2:"II",N=3:"III",N=4:"IV",1:N),Y=N_$E(Y,2,4),Y=Y_" (T"_$P(XX,U,25)_" N"_$P(XX,U,26)_" M"_$P(XX,U,27)_")" G EX
58 ;
59OT1 ;'COMPUTED EXPRESSION' for AJJC STAGE (165.5,40) and BEST STAGE (165.5,40.1)
60 S PATHSG=$P($G(^ONCO(165.5,D0,2.1)),U,4)
61 S PATHT=$P($G(^ONCO(165.5,D0,2.1)),U,1)
62 S PATHN=$P($G(^ONCO(165.5,D0,2.1)),U,2)
63 S PATHM=$P($G(^ONCO(165.5,D0,2.1)),U,3)
64 S CLINSG=$P($G(^ONCO(165.5,D0,2)),U,20)
65 S CLINT=$P($G(^ONCO(165.5,D0,2)),U,25)
66 S CLINN=$P($G(^ONCO(165.5,D0,2)),U,26)
67 S CLINM=$P($G(^ONCO(165.5,D0,2)),U,27)
68 S (AJSG,HIERT,HIERN,HIERM,HIERFLG)=""
69 S AJSG=PATHSG,HIERFLG="P"
70 I "88^99"[PATHSG,CLINSG<6,CLINSG'="" S AJSG=CLINSG,HIERFLG="C"
71 I PATHSG="",CLINSG'="" S AJSG=CLINSG,HIERFLG="C"
72 I "88^99"[PATHSG!(PATHSG="") D
73 .I CLINSG<6,CLINSG'="" Q
74 .I PATHT'="X",PATHT'=88,PATHT'="" Q
75 .I PATHN'="X",PATHN'=88,PATHN'="" Q
76 .I PATHM'="X",PATHM'=88,PATHM'="" Q
77 .I CLINT'="X",CLINT'=88,CLINT'="" S HIERFLG="C" Q
78 .I CLINN'="X",CLINN'=88,CLINN'="" S HIERFLG="C" Q
79 .I CLINM'="X",CLINM'=88,CLINM'="" S HIERFLG="C" Q
80 I HIERFLG="P" D
81 .S HIERT=$P($G(^ONCO(165.5,D0,2.1)),U,1)
82 .S HIERN=$P($G(^ONCO(165.5,D0,2.1)),U,2)
83 .S HIERM=$P($G(^ONCO(165.5,D0,2.1)),U,3)
84 .S HIERTNM=$$GET1^DIQ(165.5,D0,89.1)
85 I HIERFLG="C" D
86 .S HIERT=$P($G(^ONCO(165.5,D0,2)),U,25)
87 .S HIERN=$P($G(^ONCO(165.5,D0,2)),U,26)
88 .S HIERM=$P($G(^ONCO(165.5,D0,2)),U,27)
89 .S HIERTNM=$$GET1^DIQ(165.5,D0,37)
90 I AJSG'="" S Y=AJSG D OT S X=Y
91 K AJSG,CLINM,CLINN,CLINT,CLINSG,PATHM,PATHN,PATHT,PATHSG Q
92 ;
93STGBY ;STAGED BY (165.5,40.2)
94 D OT1
95 I HIERFLG'="" S Y=$S(HIERFLG="C":$P($G(^ONCO(165.5,D0,3)),U,32),1:$P($G(^ONCO(165.5,D0,2.1)),U,5))
96 D STGBOT S X=Y
97 Q
98 ;
99STGBOT ;STAGED BY (165.5,40.2) OUTPUT TRANSFORM
100 I Y'="" D
101 .I Y=0 S Y="Not staged" Q
102 .I Y=1 S Y="Managing MD" Q
103 .I Y=2 S Y="Pathologist" Q
104 .I Y=3 S Y="Pathologist & managing MD" Q
105 .I Y=4 S Y="Committee chair, liaison MD, registry advisor" Q
106 .I Y=5 S Y="Registrar" Q
107 .I Y=6 S Y="Registrar & MD" Q
108 .I Y=7 S Y="Another facility" Q
109 .I Y=8 S Y="NA" Q
110 .I Y=9 S Y="Unknown" Q
111 Q
112 ;
113TR ;Translate code
114 S XS=$P(XX,U,20),XG=$P(XX,U,28),X=XG_$E(XS,2,5)
115EX ;EXIT
116 K ST,SC,XD0,ONCOX,XX,ONCOYR
Note: See TracBrowser for help on using the repository browser.