ONCOTNS ;HINES OIFO/GWB - AJCC TNM STAGING ;07/29/05
;;2.2;ONCOLOGY;**1,9,13,18**;Jul 31, 2013;Build 5
;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":"OC",X="0a":"0A",X="0is":"0IS",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,99) Q
I $E(X,1,3)="III" S X=3_$E(X,4,99) Q
I $E(X,1,2)="II" S X=2_$E(X,3,99) Q
I $E(X,1)="I" S X=1_$E(X,2,99) 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
..Q ;due to p6 update to Clin/Path Stg Grp don't need LN suffix anymore
..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)
;Updated in P13 to check DATE DX and use new AJCC staging fields for 2018+
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 D
.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)
I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 D
.S PATHSG=$P($G(^ONCO(165.5,D0,"AJCC8")),U,9)
.S PATHT=$P($G(^ONCO(165.5,D0,"AJCC8")),U,6)
.S PATHN=$P($G(^ONCO(165.5,D0,"AJCC8")),U,7)
.S PATHM=$P($G(^ONCO(165.5,D0,"AJCC8")),U,8)
.S CLINSG=$P($G(^ONCO(165.5,D0,"AJCC8")),U,5)
.S CLINT=$P($G(^ONCO(165.5,D0,"AJCC8")),U,2)
.S CLINN=$P($G(^ONCO(165.5,D0,"AJCC8")),U,3)
.S CLINM=$P($G(^ONCO(165.5,D0,"AJCC8")),U,4)
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
.I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 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 $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 N IEN S IEN=D0,STGIND="P" D TNMSET^ONCSGA8U
I HIERFLG="C" D
.I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 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 $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 N IEN S IEN=D0,STGIND="C" D TNMSET^ONCSGA8U
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 I AJSG'="" S Y=AJSG D OT S X=Y
I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 I AJSG'="" D ROMAN S X=AJSG
K AJSG,CLINM,CLINN,CLINT,CLINSG,PATHM,PATHN,PATHT,PATHSG Q
;
ROMAN ;change field STAGE GROUP BEST (165.5,40) to Roman numerals
I AJSG=88 S AJSG="NA" Q
I AJSG=99 S AJSG="Unknown" Q
S ONCRN=$E(AJSG)
S ONCRN=$S(ONCRN=1:"I",ONCRN=2:"II",ONCRN=3:"III",ONCRN=4:"IV",1:ONCRN)
S AJSG=ONCRN_$E(AJSG,2,9)
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOTNS 5432 printed Dec 13, 2024@02:26:02 Page 2
ONCOTNS ;HINES OIFO/GWB - AJCC TNM STAGING ;07/29/05
+1 ;;2.2;ONCOLOGY;**1,9,13,18**;Jul 31, 2013;Build 5
+2 ;CLINICAL STAGE GROUP (165.5,38)
+3 ;PATHOLOGIC STAGE GROUP (165.5,88)
+4 ;OTHER STAGE GROUP (165.5,117)
+5 ;
IN ;Input transform
+1 NEW ONCOS
SET ONCOS=$PIECE($GET(^ONCO(165.5,D0,0)),U,1)
+2 NEW ONCOH
SET ONCOH=$$HIST^ONCFUNC(D0)
+3 IF STGIND="X"
GOTO IN1
+4 IF $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63)
Begin DoDot:1
+5 SET STGIND="L"
End DoDot:1
+6 ;
IN1 SET DIC="^ONCO(164.45,"
SET DIC(0)="EMQ"
SET DIC("S")="I $P(^(0),U,3)[STGIND"
+1 DO ^DIC
+2 IF (X["(A)")!(X["(B)")
Begin DoDot:1
+3 WRITE !!,"Enter systemic symptom suffixes at the LYMPH NODES prompt."
End DoDot:1
+4 IF Y=-1
KILL X
QUIT
+5 SET X=$PIECE(^ONCO(164.45,+Y,0),U,2)
+6 QUIT
+7 ;
INNUM SET X=$SELECT(X["NA":88,X["Unk":99,X["Occ":"OC",X="0a":"0A",X="0is":"0IS",1:X)
+1 IF X="IIIE+S"
SET X="3ES"
QUIT
+2 IF X="V"
SET X=5
QUIT
+3 IF $EXTRACT(X,1,2)="IV"
SET X=4_$EXTRACT(X,3,99)
QUIT
+4 IF $EXTRACT(X,1,3)="III"
SET X=3_$EXTRACT(X,4,99)
QUIT
+5 IF $EXTRACT(X,1,2)="II"
SET X=2_$EXTRACT(X,3,99)
QUIT
+6 IF $EXTRACT(X,1)="I"
SET X=1_$EXTRACT(X,2,99)
QUIT
+7 QUIT
+8 ;
HP ;HELP
+1 NEW ONCOI,ONCOX,ONCOXS,ONCOH,ONCOS,SG1,SG2,SGT
+2 SET ONCOI=0
SET ONCOXS=""
+3 IF STGIND="X"
GOTO HP1
+4 NEW ONCOS
SET ONCOS=$PIECE($GET(^ONCO(165.5,D0,0)),U,1)
+5 NEW ONCOH
SET ONCOH=$$HIST^ONCFUNC(D0)
+6 IF $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63)
Begin DoDot:1
+7 SET STGIND="L"
End DoDot:1
HP1 WRITE !,"Select one of the following:",!
+1 FOR
SET ONCOXS=$ORDER(^ONCO(164.45,"B",ONCOXS))
if ONCOXS=""
QUIT
Begin DoDot:1
+2 SET ONCOI=$ORDER(^ONCO(164.45,"B",ONCOXS,0))
SET ONCOX=^ONCO(164.45,ONCOI,0)
+3 SET SG1=$PIECE(ONCOX,U,1)
SET SG2=$PIECE(ONCOX,U,2)
SET SGT=$PIECE(ONCOX,U,3)
+4 if SGT[STGIND
WRITE !?5,SG1,?10,SG2
End DoDot:1
+5 QUIT
OT ;Output transform
+1 IF Y'=""
Begin DoDot:1
+2 SET STG=$ORDER(^ONCO(164.45,"B",Y,""))
+3 IF STG'=""
SET Y=$PIECE($GET(^ONCO(164.45,STG,0)),U,2)
+4 SET ONCS=$PIECE($GET(^ONCO(165.5,D0,0)),U,1)
+5 SET ONCH=$$HIST^ONCFUNC(D0)
+6 IF $$LYMPHOMA^ONCFUNC(D0)!(ONCS=62)!(ONCS=63)
Begin DoDot:2
+7 ;due to p6 update to Clin/Path Stg Grp don't need LN suffix anymore
QUIT
+8 SET SSIN=$PIECE($GET(^ONCO(165.5,D0,2)),U,11)
SET SSOT=""
+9 IF SSIN=0
SET SSOT="(A)"
+10 IF (SSIN=1)!(SSIN=2)!(SSIN=3)
SET SSOT="(B)"
+11 IF SSIN'=9
SET Y=Y_" "_SSOT
End DoDot:2
End DoDot:1
+12 KILL STG,ONCS,ONCH,SSIN,SSOT
QUIT
RS SET XX=$GET(^ONCO(165.5,D0,2))
SET TX=$PIECE(XX,U)
if TX=""
GOTO EX
if $PIECE(^ONCO(164,+TX,0),U,11)=""
GOTO EX
SET N=$EXTRACT(Y)
SET N=$SELECT(N=1:"I",N=2:"II",N=3:"III",N=4:"IV",1:N)
SET Y=N_$EXTRACT(Y,2,4)
SET Y=Y_" (T"_$PIECE(XX,U,25)_" N"_$PIECE(XX,U,26)_" M"_$PIECE(XX,U,27)_")"
GOTO EX
+1 ;
OT1 ;'COMPUTED EXPRESSION' for AJJC STAGE (165.5,40) and BEST STAGE (165.5,40.1)
+1 ;Updated in P13 to check DATE DX and use new AJCC staging fields for 2018+
+2 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
Begin DoDot:1
+3 SET PATHSG=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,4)
+4 SET PATHT=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,1)
+5 SET PATHN=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,2)
+6 SET PATHM=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,3)
+7 SET CLINSG=$PIECE($GET(^ONCO(165.5,D0,2)),U,20)
+8 SET CLINT=$PIECE($GET(^ONCO(165.5,D0,2)),U,25)
+9 SET CLINN=$PIECE($GET(^ONCO(165.5,D0,2)),U,26)
+10 SET CLINM=$PIECE($GET(^ONCO(165.5,D0,2)),U,27)
End DoDot:1
+11 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
Begin DoDot:1
+12 SET PATHSG=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,9)
+13 SET PATHT=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,6)
+14 SET PATHN=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,7)
+15 SET PATHM=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,8)
+16 SET CLINSG=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,5)
+17 SET CLINT=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,2)
+18 SET CLINN=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,3)
+19 SET CLINM=$PIECE($GET(^ONCO(165.5,D0,"AJCC8")),U,4)
End DoDot:1
+20 SET (AJSG,HIERT,HIERN,HIERM,HIERFLG)=""
+21 SET AJSG=PATHSG
SET HIERFLG="P"
+22 IF "88^99"[PATHSG
IF CLINSG<6
IF CLINSG'=""
SET AJSG=CLINSG
SET HIERFLG="C"
+23 IF PATHSG=""
IF CLINSG'=""
SET AJSG=CLINSG
SET HIERFLG="C"
+24 IF "88^99"[PATHSG!(PATHSG="")
Begin DoDot:1
+25 IF CLINSG<6
IF CLINSG'=""
QUIT
+26 IF PATHT'="X"
IF PATHT'=88
IF PATHT'=""
QUIT
+27 IF PATHN'="X"
IF PATHN'=88
IF PATHN'=""
QUIT
+28 IF PATHM'="X"
IF PATHM'=88
IF PATHM'=""
QUIT
+29 IF CLINT'="X"
IF CLINT'=88
IF CLINT'=""
SET HIERFLG="C"
QUIT
+30 IF CLINN'="X"
IF CLINN'=88
IF CLINN'=""
SET HIERFLG="C"
QUIT
+31 IF CLINM'="X"
IF CLINM'=88
IF CLINM'=""
SET HIERFLG="C"
QUIT
End DoDot:1
+32 IF HIERFLG="P"
Begin DoDot:1
+33 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
Begin DoDot:2
+34 SET HIERT=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,1)
+35 SET HIERN=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,2)
+36 SET HIERM=$PIECE($GET(^ONCO(165.5,D0,2.1)),U,3)
+37 SET HIERTNM=$$GET1^DIQ(165.5,D0,89.1)
End DoDot:2
+38 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
NEW IEN
SET IEN=D0
SET STGIND="P"
DO TNMSET^ONCSGA8U
End DoDot:1
+39 IF HIERFLG="C"
Begin DoDot:1
+40 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
Begin DoDot:2
+41 SET HIERT=$PIECE($GET(^ONCO(165.5,D0,2)),U,25)
+42 SET HIERN=$PIECE($GET(^ONCO(165.5,D0,2)),U,26)
+43 SET HIERM=$PIECE($GET(^ONCO(165.5,D0,2)),U,27)
+44 SET HIERTNM=$$GET1^DIQ(165.5,D0,37)
End DoDot:2
+45 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
NEW IEN
SET IEN=D0
SET STGIND="C"
DO TNMSET^ONCSGA8U
End DoDot:1
+46 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
IF AJSG'=""
SET Y=AJSG
DO OT
SET X=Y
+47 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
IF AJSG'=""
DO ROMAN
SET X=AJSG
+48 KILL AJSG,CLINM,CLINN,CLINT,CLINSG,PATHM,PATHN,PATHT,PATHSG
QUIT
+49 ;
ROMAN ;change field STAGE GROUP BEST (165.5,40) to Roman numerals
+1 IF AJSG=88
SET AJSG="NA"
QUIT
+2 IF AJSG=99
SET AJSG="Unknown"
QUIT
+3 SET ONCRN=$EXTRACT(AJSG)
+4 SET ONCRN=$SELECT(ONCRN=1:"I",ONCRN=2:"II",ONCRN=3:"III",ONCRN=4:"IV",1:ONCRN)
+5 SET AJSG=ONCRN_$EXTRACT(AJSG,2,9)
+6 QUIT
STGBY ;STAGED BY (165.5,40.2)
+1 DO OT1
+2 IF HIERFLG'=""
SET Y=$SELECT(HIERFLG="C":$PIECE($GET(^ONCO(165.5,D0,3)),U,32),1:$PIECE($GET(^ONCO(165.5,D0,2.1)),U,5))
+3 DO STGBOT
SET X=Y
+4 QUIT
+5 ;
STGBOT ;STAGED BY (165.5,40.2) OUTPUT TRANSFORM
+1 IF Y'=""
Begin DoDot:1
+2 IF Y=0
SET Y="Not staged"
QUIT
+3 IF Y=1
SET Y="Managing MD"
QUIT
+4 IF Y=2
SET Y="Pathologist"
QUIT
+5 IF Y=3
SET Y="Pathologist & managing MD"
QUIT
+6 IF Y=4
SET Y="Committee chair, liaison MD, registry advisor"
QUIT
+7 IF Y=5
SET Y="Registrar"
QUIT
+8 IF Y=6
SET Y="Registrar & MD"
QUIT
+9 IF Y=7
SET Y="Another facility"
QUIT
+10 IF Y=8
SET Y="NA"
QUIT
+11 IF Y=9
SET Y="Unknown"
QUIT
End DoDot:1
+12 QUIT
+13 ;
TR ;Translate code
+1 SET XS=$PIECE(XX,U,20)
SET XG=$PIECE(XX,U,28)
SET X=XG_$EXTRACT(XS,2,5)
EX ;EXIT
+1 KILL ST,SC,XD0,ONCOX,XX,ONCOYR
