ONCOTNO ;Hines OIFO/GWB - TNM output formatting ;09/22/11
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
SGOUT(IEN) ;AJCC stage formatted for display
N G,SG,XX,XXX
S XX=$G(^ONCO(165.5,D0,2))
I STGIND="C" D
.S XXX=$G(^ONCO(165.5,D0,2))
.S SG=$P(XXX,U,20)
I STGIND="P" D
.S XXX=$G(^ONCO(165.5,D0,2.1))
.S SG=$P(XXX,U,4)
I STGIND="O" D
.S XXX=$G(^ONCO(165.5,D0,2.1))
.S SG=$P(XXX,U,9)
I STGIND="R" D
.S XXX=$G(^ONCO(165.5,D0,23,DA,0))
.S SG=$P(XXX,U,9)
N ONCOZ,XSG
S ONCOZ=$E(SG)
S XSG=$S(ONCOZ=1:"I",ONCOZ=2:"II",ONCOZ=3:"III",ONCOZ=4:"IV",ONCOZ=8:8,ONCOZ=9:9,1:ONCOZ)
S XSG=XSG_$E(SG,2,$L(SG))
S SG=XSG_" ("_$$TNMOUT(IEN)_")"
;
;Bone and Soft Tissue Sarcoma Histopathologic Grade "G" suffix
I ($G(SP)=67400)!($G(SP)=67490) D
.S G=$P(^ONCO(165.5,D0,2),U,5)
.S:($G(G)=9)!($G(G)="") G="X"
.S SG=XSG_" ("_$$TNMOUT(IEN)_" G"_G_")"
;
;Gastrointestinal Stromal Tumor MITOTIC RATE (165.5,239)
I ($E($$HIST^ONCFUNC(D0),1,4)=8935)!($E($$HIST^ONCFUNC(D0),1,4)=8936) N MR D
.S MR=$$GET1^DIQ(165.5,D0,239)
.S SG=XSG_" ("_$$TNMOUT(IEN)_")"_" "_MR
;
;Primary Cutaneous Lymphomas PERIPHERAL BLOOD INVOLVEMENT (165.5,30.5)
N PBI,PS,PS34
S PS=$$GET1^DIQ(165.5,D0,20,"I")
S PS34=$E(PS,3,4)
I ((PS34=44)!(PS34=51)!(PS34=60)!(PS=67632)),(($E($$HIST^ONCFUNC(D0),1,4)=9700)!($E($$HIST^ONCFUNC(D0),1,4)=9701)) D
.S PBI=$$GET1^DIQ(165.5,D0,30.5,"I")
.S SG=XSG_" ("_$$TNMOUT(IEN)_")"_" "_PBI
Q SG
;
TNMOUT(IEN) ;TNM coding formatted for display
N CM,COC,G,GS,II,ONCOM,ONCON,ONCOT,ONCOTNM,PSA,TOP,XXX
S ONCOTNM=""
S ONCOED=$$TNMED^ONCOU55(IEN)
S TOP=$P($G(^ONCO(165.5,IEN,2)),U,1)
I STGIND="C" D
.S XXX(2)=$G(^ONCO(165.5,IEN,2))
.S XXX(3)=$G(^ONCO(165.5,IEN,3))
.S ONCOT=$P(XXX(2),U,25)
.S ONCON=$P(XXX(2),U,26)
.S ONCOM=$P(XXX(2),U,27)
I STGIND="P" D
.S XXX(2)=$G(^ONCO(165.5,IEN,2.1))
.S XXX(3)=$G(^ONCO(165.5,IEN,3))
.S ONCOT=$P(XXX(2),U,1)
.S ONCON=$P(XXX(2),U,2)
.S ONCOM=$P(XXX(2),U,3)
.S CM=$P($G(^ONCO(165.5,IEN,2)),U,27)
.I $G(CMPFLG)'="COMPUTING TNM" K CMPFLG Q
.I (ONCOT'="X")!(ONCON'="X"),$E(ONCOM,1)'=1,CM'="X" S ONCOM=CM
I STGIND="O" D
.S XXX(2)=$G(^ONCO(165.5,IEN,2.1))
.S XXX(3)=$G(^ONCO(165.5,IEN,3))
.S ONCOT=$P(XXX(2),U,6)
.S ONCON=$P(XXX(2),U,7)
.S ONCOM=$P(XXX(2),U,8)
I STGIND="R" D
.S XXX(2)=$G(^ONCO(165.5,IEN,23,DA,0))
.S XXX(3)=$G(^ONCO(165.5,IEN,3))
.S ONCOT=$P(XXX(2),U,6)
.S ONCON=$P(XXX(2),U,7)
.S ONCOM=$P(XXX(2),U,8)
I ONCOT'="" D
.S ONCOTNM="T"_ONCOT
.N MC,MT,ONCOMULT,XXDTDX
.S MT=$P($G(^ONCO(165.5,D0,2)),U,31) ;MULTIPLE TUMORS (165.5,69)
.S MC=$P($G(^ONCO(165.5,D0,24)),U,16) ;MULTIPLICITY COUNTER (165.5,196)
.S XXDTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
.I XXDTDX<3070000 S ONCOMULT=MT
.I XXDTDX>3069999 S ONCOMULT=MC I (+ONCOMULT=0)!(+ONCOMULT=1)!(ONCOMULT>87) S ONCOMULT=""
.I ONCOMULT S ONCOTNM=ONCOTNM_"m" S:+ONCOMULT>1 ONCOTNM=ONCOTNM_+ONCOMULT
.N ONCOMT S ONCOMT=""
.I STGIND="C" D
..S:$P($G(^ONCO(165.5,D0,0)),U,16)<2980000 ONCOMT=$P($G(^ONCO(165.5,D0,7)),U,16)
.I STGIND="P" D
..S ONCOMT=$P($G(^ONCO(165.5,D0,7)),U,17)
.S COC=$E($$GET1^DIQ(165.5,D0,.04),1,2)
.I COC=38 S ONCOTNM="a"_ONCOTNM ;a Prefix
.I ONCOMT="Y" S ONCOTNM="y"_ONCOTNM ;Multimodality therapy
.I TOP=67692,$P(XXX(2),U,32) S ONCOTNM=ONCOTNM_"f" ;Family History
.I TOP=67692,$P(XXX(3),U,30) S ONCOTNM=ONCOTNM_"d" ;Diffuse Retinal Involvement
S:(ONCOTNM'="")&(ONCON'="") ONCOTNM=ONCOTNM_" "
S:ONCON'="" ONCOTNM=ONCOTNM_"N"_ONCON
S:(ONCOTNM'="")&(ONCOM'="") ONCOTNM=ONCOTNM_" "
S:ONCOM'="" ONCOTNM=ONCOTNM_"M"_ONCOM
I TOP=67619 D
.I ONCOED<7 S G=$P(^ONCO(165.5,D0,2),U,5),ONCOTNM=ONCOTNM_" G"_G Q
.S PSA=+$$GET1^DIQ(165.5,D0,684)
.I (PSA=999.7)!(PSA=999.8)!(PSA=999.9) S PSA=""
.I $G(STGIND)="C" S GS=+$$GET1^DIQ(165.5,D0,623,"I")
.I $G(STGIND)="P" S GS=+$$GET1^DIQ(165.5,D0,250,"I")
.I GS=99 S GS=""
.S ONCOTNM=ONCOTNM_" PSA"_PSA_" GS"_GS
I $$GTT^ONCOU55(D0) D K RF
.S:$G(STGIND)="C" RF=$$GET1^DIQ(165.5,D0,134,"I")
.S:$G(STGIND)="P" RF=$$GET1^DIQ(165.5,D0,135,"I")
.S:$G(STGIND)="O" RF=$$GET1^DIQ(165.5,D0,134,"I")
.S RF=$S(RF=0:"0RF",(RF=1)!(RF=2):"1RF",RF=3:"2RF",RF="U":"Unknown",RF="L":"Low risk",RF="H":"High risk",1:RF)
.S ONCOTNM=ONCOTNM_" "_RF
I $$T^ONCOU55(D0) D K STM
.S STM=$P($G(^ONCO(165.5,D0,24)),U,8)
.S ONCOTNM=ONCOTNM_" "_STM
Q ONCOTNM
;
CLEANUP ;Cleanup
K D0,DA,ONCOED,SP,STGIND
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOTNO 4412 printed Oct 16, 2024@18:26:41 Page 2
ONCOTNO ;Hines OIFO/GWB - TNM output formatting ;09/22/11
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
SGOUT(IEN) ;AJCC stage formatted for display
+1 NEW G,SG,XX,XXX
+2 SET XX=$GET(^ONCO(165.5,D0,2))
+3 IF STGIND="C"
Begin DoDot:1
+4 SET XXX=$GET(^ONCO(165.5,D0,2))
+5 SET SG=$PIECE(XXX,U,20)
End DoDot:1
+6 IF STGIND="P"
Begin DoDot:1
+7 SET XXX=$GET(^ONCO(165.5,D0,2.1))
+8 SET SG=$PIECE(XXX,U,4)
End DoDot:1
+9 IF STGIND="O"
Begin DoDot:1
+10 SET XXX=$GET(^ONCO(165.5,D0,2.1))
+11 SET SG=$PIECE(XXX,U,9)
End DoDot:1
+12 IF STGIND="R"
Begin DoDot:1
+13 SET XXX=$GET(^ONCO(165.5,D0,23,DA,0))
+14 SET SG=$PIECE(XXX,U,9)
End DoDot:1
+15 NEW ONCOZ,XSG
+16 SET ONCOZ=$EXTRACT(SG)
+17 SET XSG=$SELECT(ONCOZ=1:"I",ONCOZ=2:"II",ONCOZ=3:"III",ONCOZ=4:"IV",ONCOZ=8:8,ONCOZ=9:9,1:ONCOZ)
+18 SET XSG=XSG_$EXTRACT(SG,2,$LENGTH(SG))
+19 SET SG=XSG_" ("_$$TNMOUT(IEN)_")"
+20 ;
+21 ;Bone and Soft Tissue Sarcoma Histopathologic Grade "G" suffix
+22 IF ($GET(SP)=67400)!($GET(SP)=67490)
Begin DoDot:1
+23 SET G=$PIECE(^ONCO(165.5,D0,2),U,5)
+24 if ($GET(G)=9)!($GET(G)="")
SET G="X"
+25 SET SG=XSG_" ("_$$TNMOUT(IEN)_" G"_G_")"
End DoDot:1
+26 ;
+27 ;Gastrointestinal Stromal Tumor MITOTIC RATE (165.5,239)
+28 IF ($EXTRACT($$HIST^ONCFUNC(D0),1,4)=8935)!($EXTRACT($$HIST^ONCFUNC(D0),1,4)=8936)
NEW MR
Begin DoDot:1
+29 SET MR=$$GET1^DIQ(165.5,D0,239)
+30 SET SG=XSG_" ("_$$TNMOUT(IEN)_")"_" "_MR
End DoDot:1
+31 ;
+32 ;Primary Cutaneous Lymphomas PERIPHERAL BLOOD INVOLVEMENT (165.5,30.5)
+33 NEW PBI,PS,PS34
+34 SET PS=$$GET1^DIQ(165.5,D0,20,"I")
+35 SET PS34=$EXTRACT(PS,3,4)
+36 IF ((PS34=44)!(PS34=51)!(PS34=60)!(PS=67632))
IF (($EXTRACT($$HIST^ONCFUNC(D0),1,4)=9700)!($EXTRACT($$HIST^ONCFUNC(D0),1,4)=9701))
Begin DoDot:1
+37 SET PBI=$$GET1^DIQ(165.5,D0,30.5,"I")
+38 SET SG=XSG_" ("_$$TNMOUT(IEN)_")"_" "_PBI
End DoDot:1
+39 QUIT SG
+40 ;
TNMOUT(IEN) ;TNM coding formatted for display
+1 NEW CM,COC,G,GS,II,ONCOM,ONCON,ONCOT,ONCOTNM,PSA,TOP,XXX
+2 SET ONCOTNM=""
+3 SET ONCOED=$$TNMED^ONCOU55(IEN)
+4 SET TOP=$PIECE($GET(^ONCO(165.5,IEN,2)),U,1)
+5 IF STGIND="C"
Begin DoDot:1
+6 SET XXX(2)=$GET(^ONCO(165.5,IEN,2))
+7 SET XXX(3)=$GET(^ONCO(165.5,IEN,3))
+8 SET ONCOT=$PIECE(XXX(2),U,25)
+9 SET ONCON=$PIECE(XXX(2),U,26)
+10 SET ONCOM=$PIECE(XXX(2),U,27)
End DoDot:1
+11 IF STGIND="P"
Begin DoDot:1
+12 SET XXX(2)=$GET(^ONCO(165.5,IEN,2.1))
+13 SET XXX(3)=$GET(^ONCO(165.5,IEN,3))
+14 SET ONCOT=$PIECE(XXX(2),U,1)
+15 SET ONCON=$PIECE(XXX(2),U,2)
+16 SET ONCOM=$PIECE(XXX(2),U,3)
+17 SET CM=$PIECE($GET(^ONCO(165.5,IEN,2)),U,27)
+18 IF $GET(CMPFLG)'="COMPUTING TNM"
KILL CMPFLG
QUIT
+19 IF (ONCOT'="X")!(ONCON'="X")
IF $EXTRACT(ONCOM,1)'=1
IF CM'="X"
SET ONCOM=CM
End DoDot:1
+20 IF STGIND="O"
Begin DoDot:1
+21 SET XXX(2)=$GET(^ONCO(165.5,IEN,2.1))
+22 SET XXX(3)=$GET(^ONCO(165.5,IEN,3))
+23 SET ONCOT=$PIECE(XXX(2),U,6)
+24 SET ONCON=$PIECE(XXX(2),U,7)
+25 SET ONCOM=$PIECE(XXX(2),U,8)
End DoDot:1
+26 IF STGIND="R"
Begin DoDot:1
+27 SET XXX(2)=$GET(^ONCO(165.5,IEN,23,DA,0))
+28 SET XXX(3)=$GET(^ONCO(165.5,IEN,3))
+29 SET ONCOT=$PIECE(XXX(2),U,6)
+30 SET ONCON=$PIECE(XXX(2),U,7)
+31 SET ONCOM=$PIECE(XXX(2),U,8)
End DoDot:1
+32 IF ONCOT'=""
Begin DoDot:1
+33 SET ONCOTNM="T"_ONCOT
+34 NEW MC,MT,ONCOMULT,XXDTDX
+35 ;MULTIPLE TUMORS (165.5,69)
SET MT=$PIECE($GET(^ONCO(165.5,D0,2)),U,31)
+36 ;MULTIPLICITY COUNTER (165.5,196)
SET MC=$PIECE($GET(^ONCO(165.5,D0,24)),U,16)
+37 SET XXDTDX=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
+38 IF XXDTDX<3070000
SET ONCOMULT=MT
+39 IF XXDTDX>3069999
SET ONCOMULT=MC
IF (+ONCOMULT=0)!(+ONCOMULT=1)!(ONCOMULT>87)
SET ONCOMULT=""
+40 IF ONCOMULT
SET ONCOTNM=ONCOTNM_"m"
if +ONCOMULT>1
SET ONCOTNM=ONCOTNM_+ONCOMULT
+41 NEW ONCOMT
SET ONCOMT=""
+42 IF STGIND="C"
Begin DoDot:2
+43 if $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<2980000
SET ONCOMT=$PIECE($GET(^ONCO(165.5,D0,7)),U,16)
End DoDot:2
+44 IF STGIND="P"
Begin DoDot:2
+45 SET ONCOMT=$PIECE($GET(^ONCO(165.5,D0,7)),U,17)
End DoDot:2
+46 SET COC=$EXTRACT($$GET1^DIQ(165.5,D0,.04),1,2)
+47 ;a Prefix
IF COC=38
SET ONCOTNM="a"_ONCOTNM
+48 ;Multimodality therapy
IF ONCOMT="Y"
SET ONCOTNM="y"_ONCOTNM
+49 ;Family History
IF TOP=67692
IF $PIECE(XXX(2),U,32)
SET ONCOTNM=ONCOTNM_"f"
+50 ;Diffuse Retinal Involvement
IF TOP=67692
IF $PIECE(XXX(3),U,30)
SET ONCOTNM=ONCOTNM_"d"
End DoDot:1
+51 if (ONCOTNM'="")&(ONCON'="")
SET ONCOTNM=ONCOTNM_" "
+52 if ONCON'=""
SET ONCOTNM=ONCOTNM_"N"_ONCON
+53 if (ONCOTNM'="")&(ONCOM'="")
SET ONCOTNM=ONCOTNM_" "
+54 if ONCOM'=""
SET ONCOTNM=ONCOTNM_"M"_ONCOM
+55 IF TOP=67619
Begin DoDot:1
+56 IF ONCOED<7
SET G=$PIECE(^ONCO(165.5,D0,2),U,5)
SET ONCOTNM=ONCOTNM_" G"_G
QUIT
+57 SET PSA=+$$GET1^DIQ(165.5,D0,684)
+58 IF (PSA=999.7)!(PSA=999.8)!(PSA=999.9)
SET PSA=""
+59 IF $GET(STGIND)="C"
SET GS=+$$GET1^DIQ(165.5,D0,623,"I")
+60 IF $GET(STGIND)="P"
SET GS=+$$GET1^DIQ(165.5,D0,250,"I")
+61 IF GS=99
SET GS=""
+62 SET ONCOTNM=ONCOTNM_" PSA"_PSA_" GS"_GS
End DoDot:1
+63 IF $$GTT^ONCOU55(D0)
Begin DoDot:1
+64 if $GET(STGIND)="C"
SET RF=$$GET1^DIQ(165.5,D0,134,"I")
+65 if $GET(STGIND)="P"
SET RF=$$GET1^DIQ(165.5,D0,135,"I")
+66 if $GET(STGIND)="O"
SET RF=$$GET1^DIQ(165.5,D0,134,"I")
+67 SET RF=$SELECT(RF=0:"0RF",(RF=1)!(RF=2):"1RF",RF=3:"2RF",RF="U":"Unknown",RF="L":"Low risk",RF="H":"High risk",1:RF)
+68 SET ONCOTNM=ONCOTNM_" "_RF
End DoDot:1
KILL RF
+69 IF $$T^ONCOU55(D0)
Begin DoDot:1
+70 SET STM=$PIECE($GET(^ONCO(165.5,D0,24)),U,8)
+71 SET ONCOTNM=ONCOTNM_" "_STM
End DoDot:1
KILL STM
+72 QUIT ONCOTNM
+73 ;
CLEANUP ;Cleanup
+1 KILL D0,DA,ONCOED,SP,STGIND
