VistA-WorldVistAEHR/r/ONCOLOGY-ONC/ONCOTNS.m

117 lines
3.9 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
ONCOTNS ;Hines OIFO/GWB - AJCC TNM STAGING ;07/29/05
;;2.11;ONCOLOGY;**6,7,11,13,28,36,37,44**;Mar 07, 1995
;CLINICAL STAGE GROUP (165.5,38)
;PATHOLOGIC STAGE GROUP (165.5,88)
;OTHER STAGE GROUP (165.5,117)
;
IN ;Input transform
N ONCOS S ONCOS=$P($G(^ONCO(165.5,D0,0)),U,1)
N ONCOH S ONCOH=$$HIST^ONCFUNC(D0)
I STGIND="X" G IN1
I $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63) D
.S STGIND="L"
;
IN1 S DIC="^ONCO(164.45,",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)[STGIND"
D ^DIC
I (X["(A)")!(X["(B)") D
.W !!,"Enter systemic symptom suffixes at the LYMPH NODES prompt."
I Y=-1 K X Q
S X=$P(^ONCO(164.45,+Y,0),U,2)
Q
;
INNUM S X=$S(X["NA":88,X["Unk":99,X["Occ":"0C",X="0a":"0A",X="0is":"0S",1:X)
I X="IIIE+S" S X="3ES" Q
I X="V" S X=5 Q
I $E(X,1,2)="IV" S X=4_$E(X,3) Q
I $E(X,1,3)="III" S X=3_$E(X,4) Q
I $E(X,1,2)="II" S X=2_$E(X,3) Q
I $E(X,1)="I" S X=1_$E(X,2) Q
Q
;
HP ;HELP
N ONCOI,ONCOX,ONCOXS,ONCOH,ONCOS,SG1,SG2,SGT
S ONCOI=0,ONCOXS=""
I STGIND="X" G HP1
N ONCOS S ONCOS=$P($G(^ONCO(165.5,D0,0)),U,1)
N ONCOH S ONCOH=$$HIST^ONCFUNC(D0)
I $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63) D
.S STGIND="L"
HP1 W !,"Select one of the following:",!
F S ONCOXS=$O(^ONCO(164.45,"B",ONCOXS)) Q:ONCOXS="" D
.S ONCOI=$O(^ONCO(164.45,"B",ONCOXS,0)),ONCOX=^ONCO(164.45,ONCOI,0)
.S SG1=$P(ONCOX,U,1),SG2=$P(ONCOX,U,2),SGT=$P(ONCOX,U,3)
.W:SGT[STGIND !?5,SG1,?10,SG2
Q
OT ;Output transform
I Y'="" D
.S STG=$O(^ONCO(164.45,"B",Y,""))
.I STG'="" S Y=$P($G(^ONCO(164.45,STG,0)),U,2)
.S ONCS=$P($G(^ONCO(165.5,D0,0)),U,1)
.S ONCH=$$HIST^ONCFUNC(D0)
.I $$LYMPHOMA^ONCFUNC(D0)!(ONCS=62)!(ONCS=63) D
..S SSIN=$P($G(^ONCO(165.5,D0,2)),U,11),SSOT=""
..I SSIN=0 S SSOT="(A)"
..I (SSIN=1)!(SSIN=2)!(SSIN=3) S SSOT="(B)"
..I SSIN'=9 S Y=Y_" "_SSOT
K STG,ONCS,ONCH,SSIN,SSOT Q
RS 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
;
OT1 ;'COMPUTED EXPRESSION' for AJJC STAGE (165.5,40) and BEST STAGE (165.5,40.1)
S PATHSG=$P($G(^ONCO(165.5,D0,2.1)),U,4)
S PATHT=$P($G(^ONCO(165.5,D0,2.1)),U,1)
S PATHN=$P($G(^ONCO(165.5,D0,2.1)),U,2)
S PATHM=$P($G(^ONCO(165.5,D0,2.1)),U,3)
S CLINSG=$P($G(^ONCO(165.5,D0,2)),U,20)
S CLINT=$P($G(^ONCO(165.5,D0,2)),U,25)
S CLINN=$P($G(^ONCO(165.5,D0,2)),U,26)
S CLINM=$P($G(^ONCO(165.5,D0,2)),U,27)
S (AJSG,HIERT,HIERN,HIERM,HIERFLG)=""
S AJSG=PATHSG,HIERFLG="P"
I "88^99"[PATHSG,CLINSG<6,CLINSG'="" S AJSG=CLINSG,HIERFLG="C"
I PATHSG="",CLINSG'="" S AJSG=CLINSG,HIERFLG="C"
I "88^99"[PATHSG!(PATHSG="") D
.I CLINSG<6,CLINSG'="" Q
.I PATHT'="X",PATHT'=88,PATHT'="" Q
.I PATHN'="X",PATHN'=88,PATHN'="" Q
.I PATHM'="X",PATHM'=88,PATHM'="" Q
.I CLINT'="X",CLINT'=88,CLINT'="" S HIERFLG="C" Q
.I CLINN'="X",CLINN'=88,CLINN'="" S HIERFLG="C" Q
.I CLINM'="X",CLINM'=88,CLINM'="" S HIERFLG="C" Q
I HIERFLG="P" D
.S HIERT=$P($G(^ONCO(165.5,D0,2.1)),U,1)
.S HIERN=$P($G(^ONCO(165.5,D0,2.1)),U,2)
.S HIERM=$P($G(^ONCO(165.5,D0,2.1)),U,3)
.S HIERTNM=$$GET1^DIQ(165.5,D0,89.1)
I HIERFLG="C" D
.S HIERT=$P($G(^ONCO(165.5,D0,2)),U,25)
.S HIERN=$P($G(^ONCO(165.5,D0,2)),U,26)
.S HIERM=$P($G(^ONCO(165.5,D0,2)),U,27)
.S HIERTNM=$$GET1^DIQ(165.5,D0,37)
I AJSG'="" S Y=AJSG D OT S X=Y
K AJSG,CLINM,CLINN,CLINT,CLINSG,PATHM,PATHN,PATHT,PATHSG Q
;
STGBY ;STAGED BY (165.5,40.2)
D OT1
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))
D STGBOT S X=Y
Q
;
STGBOT ;STAGED BY (165.5,40.2) OUTPUT TRANSFORM
I Y'="" D
.I Y=0 S Y="Not staged" Q
.I Y=1 S Y="Managing MD" Q
.I Y=2 S Y="Pathologist" Q
.I Y=3 S Y="Pathologist & managing MD" Q
.I Y=4 S Y="Committee chair, liaison MD, registry advisor" Q
.I Y=5 S Y="Registrar" Q
.I Y=6 S Y="Registrar & MD" Q
.I Y=7 S Y="Another facility" Q
.I Y=8 S Y="NA" Q
.I Y=9 S Y="Unknown" Q
Q
;
TR ;Translate code
S XS=$P(XX,U,20),XG=$P(XX,U,28),X=XG_$E(XS,2,5)
EX ;EXIT
K ST,SC,XD0,ONCOX,XX,ONCOYR