ONCSCHMU ;HINES OIFO/RTK - Utilities for NAACCR 2018+ ;08/01/19
;;2.2;ONCOLOGY;**10,13,14,15,17,18**;Jul 31, 2013;Build 5
;
Q
;
CTNM ;
D NOCTNM Q
PTNM ;
D NOPTNM^ONCSCHMU Q
YTNM ;
D NOYTNM^ONCSCHMU Q
Q
NOCTNM ;
W !,"==== No TNM classification is available for this AJCC Chapter ===="
S $P(^ONCO(165.5,D0,"AJCC8"),U,2)=88 ;5001 AJCC TNM CLIN T
S $P(^ONCO(165.5,D0,"AJCC8"),U,3)=88 ;5002 AJCC TNM CLIN N
S $P(^ONCO(165.5,D0,"AJCC8"),U,4)=88 ;5003 AJCC TNM CLIN M
W !!,"AJCC TNM CLIN T: 88"
W !,"AJCC TNM CLIN N: 88"
W !,"AJCC TNM CLIN M: 88"
I $P($G(^ONCO(165.5,D0,"SSD1")),U,1)="00821",HST14="9732" S $P(^ONCO(165.5,D0,"AJCC8"),U,5)=99
Q
;
NOPTNM ;
S $P(^ONCO(165.5,D0,"AJCC8"),U,6)=88 ;5011 AJCC TNM PATH T
S $P(^ONCO(165.5,D0,"AJCC8"),U,7)=88 ;5012 AJCC TNM PATH N
S $P(^ONCO(165.5,D0,"AJCC8"),U,8)=88 ;5013 AJCC TNM PATH M
I ($E(ONCAJID,1,2)=81) S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88 ;5014 PSG
I $P($G(^ONCO(165.5,D0,"SSD1")),U,1)="00821",HST14="9732" S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88
W !!,"AJCC TNM PATH T: 88"
W !,"AJCC TNM PATH N: 88"
W !,"AJCC TNM PATH M: 88"
I ($E(ONCAJID,1,2)=81) W !,"AJCC TNM PATH STAGE GROUP: 88",!
Q
;
NOYTNM ;
S $P(^ONCO(165.5,D0,"AJCC8"),U,20)="" ;5025 AJCC TNM POST THERAPY (yc) T
S $P(^ONCO(165.5,D0,"AJCC8"),U,21)="" ;5026 AJCC TNM POST THERAPY (yc) N
S $P(^ONCO(165.5,D0,"AJCC8"),U,22)="" ;5027 AJCC TNM POST THERAPY (yc) M
;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !!,"AJCC TNM POST THERAPY (yc) T:"
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) N:"
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) M:"
;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP:",!
S $P(^ONCO(165.5,D0,"AJCC8"),U,10)="" ;5021 AJCC TNM POST THERAPY T
S $P(^ONCO(165.5,D0,"AJCC8"),U,11)="" ;5022 AJCC TNM POST THERAPY N
S $P(^ONCO(165.5,D0,"AJCC8"),U,12)="" ;5023 AJCC TNM POST THERAPY M
S $P(^ONCO(165.5,D0,"AJCC8"),U,13)="" ;5024 AJCC TNM PT STAGE GROUP
W !!,"AJCC TNM POST THERAPY (yp) T:"
W !,"AJCC TNM POST THERAPY (yp) N:"
W !,"AJCC TNM POST THERAPY (yp) M:"
W !,"AJCC TNM POST THERAPY (yp) STAGE GROUP:",!
Q
;
NOTNMSG ;AJCC ID ="XX" NO TNM CHAPTER
;Schemas 00118,00119,00128,00278,00288,00358,00378,00478
; 00558,00559,00598,00638,00698,00718,00778,99999
S $P(^ONCO(165.5,D0,"AJCC8"),U,1)="XX" ;5000 AJCC ID
W !,"==== AJCC ID='XX' -- No TNM Coding or Staging for this AJCC Chapter ===="
;
NONXX S $P(^ONCO(165.5,D0,"AJCC8"),U,2)=88 ;5001 AJCC TNM CLIN T
S $P(^ONCO(165.5,D0,"AJCC8"),U,3)=88 ;5002 AJCC TNM CLIN N
S $P(^ONCO(165.5,D0,"AJCC8"),U,4)=88 ;5003 AJCC TNM CLIN M
S $P(^ONCO(165.5,D0,"AJCC8"),U,5)=88 ;5004 AJCC TNM CLIN STAGE GROUP
S TMP=$G(X),X=88 D CSSG^ONCOCRC S X=TMP K TMP ;set "ASG" for field 38.5
S $P(^ONCO(165.5,D0,"AJCC8"),U,6)=88 ;5011 AJCC TNM PATH T
S $P(^ONCO(165.5,D0,"AJCC8"),U,7)=88 ;5012 AJCC TNM PATH N
S $P(^ONCO(165.5,D0,"AJCC8"),U,8)=88 ;5013 AJCC TNM PATH M
S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88 ;5014 AJCC TNM PATH STAGE GROUP
S TMP=$G(X),X=88 D PSSG^ONCOCRC S X=TMP K TMP ;set "ASG" for field 38.5
S $P(^ONCO(165.5,D0,"AJCC8"),U,20)="" ;5025 AJCC TNM POST THERAPY (yc) T
S $P(^ONCO(165.5,D0,"AJCC8"),U,21)="" ;5026 AJCC TNM POST THERAPY (yc) N
S $P(^ONCO(165.5,D0,"AJCC8"),U,22)="" ;5027 AJCC TNM POST THERAPY (yc) M
;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
S $P(^ONCO(165.5,D0,"AJCC8"),U,10)="" ;5021 AJCC TNM POST THERAPY T
S $P(^ONCO(165.5,D0,"AJCC8"),U,11)="" ;5022 AJCC TNM POST THERAPY N
S $P(^ONCO(165.5,D0,"AJCC8"),U,12)="" ;5023 AJCC TNM POST THERAPY M
S $P(^ONCO(165.5,D0,"AJCC8"),U,13)="" ;5024 AJCC TNM PT STAGE GROUP
W !!,"AJCC TNM CLIN T: 88"
W !,"AJCC TNM CLIN N: 88"
W !,"AJCC TNM CLIN M: 88"
W !,"AJCC TNM CLIN STAGE GROUP: 88"
W !!,"AJCC TNM PATH T: 88"
W !,"AJCC TNM PATH N: 88"
W !,"AJCC TNM PATH M: 88"
W !,"AJCC TNM PATH STAGE GROUP: 88"
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !!,"AJCC TNM POST THERAPY (yc) T="
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) N="
I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) M="
;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP=",!
W !!,"AJCC TNM POST THERAPY (yp) T="
W !,"AJCC TNM POST THERAPY (yp) N="
W !,"AJCC TNM POST THERAPY (yp) M="
W !,"AJCC TNM POST THERAPY (yp) STAGE GROUP=",!
Q
FRSG385 ; Force setting "ASG" for field 38.5 (Stage Group AJCC)
; called from [ONCO ABSTRACT-I] input template
N IEN,SG
S IEN=D0
S PSG=$P($G(^ONCO(165.5,IEN,"AJCC8")),"^",9) I PSG'="" S PSG=$E(PSG)
S PSGDS="" I PSG'="" S PSGDS=$S(PSG=0:0,PSG=1:"I",PSG=2:"II",PSG=3:"III",PSG=4:"IV",PSG=9:"U",PSG=8:"NA",1:"")
S CSG=$P($G(^ONCO(165.5,IEN,"AJCC8")),"^",5) I CSG'="" S CSG=$E(CSG)
S CSGDS="" I CSG'="" S CSGDS=$S(CSG=0:0,CSG=1:"I",CSG=2:"II",CSG=3:"III",CSG=4:"IV",CSG=9:"U",CSG=8:"NA",1:"")
S SG=$S(PSG="":CSGDS,CSG="":PSGDS,PSG<7:PSGDS,PSG>7&(CSG<7):CSGDS,1:PSGDS) D KXR,SXR
K CSG,CSGDS,PSG,PSGDS Q
KXR ; KILL OFF THE OLD "ASG" X-REF
N XSG
S XSG=$S($D(^ONCO(165.5,IEN,2)):$P(^ONCO(165.5,IEN,2),"^",28),1:"") Q:XSG=""
I $D(^ONCO(165.5,"ASG",XSG,IEN)) K ^ONCO(165.5,"ASG",XSG,IEN)
Q
SXR ; STUFF STAGE FIELD (#38.5), SET NEW "ASG" X-REF
N XSG
Q:SG="" S $P(^ONCO(165.5,IEN,2),"^",28)=SG,^ONCO(165.5,"ASG",SG,IEN)=""
Q
;
EODCHK1 ;
D ^ONCSCHMA
I ONCSCMA="99999" D EODPR88,EODRN88,EODMT88 S Y="@1776" Q
Q
EODCHK2 ;
D ^ONCSCHMA
I "00790^00795^00821^00830"[ONCSCMA D EODRN88,EODMT88 S Y="@1776" Q
I "00721^00722^00723^09721^09722^09723^09724"[ONCSCMA D EODRN88 S Y="@1774" Q
Q
EODCHK3 ;
D ^ONCSCHMA
I (ONCSCMA="00458")!(ONCSCMA="00822") D EODMT88 S Y="@1776" Q
Q
EODPR88 ;
S $P(^ONCO(165.5,D0,"EOD"),U,1)=888 ;1772 EOD PRIMARY TUMOR
W !,"EOD PRIMARY TUMOR: 888"
Q
EODRN88 ;
S $P(^ONCO(165.5,D0,"EOD"),U,2)=888 ;1774 EOD REGIONAL NODES
W !,"EOD REGIONAL NODES: 888"
Q
EODMT88 ;
S $P(^ONCO(165.5,D0,"EOD"),U,3)=88 ;1776 EOD METS
W !,"EOD METS: 88"
Q
METSCHK ;Check for stuffing 88s for METS fields for 2018+ cases
I $G(TOPCOD)="" Q
I $G(ONCSCMA)="" Q
I (TOPCOD="C42.0")!(TOPCOD="C42.1")!(TOPCOD="C42.3")!(TOPCOD="C42.4")!(ONCSCMA="00821")!(ONCSCMA="00822")!(ONCSCMA="00830") D METS8,METSPR S Y="@3436"
Q
METS8 ;
S $P(^ONCO(165.5,D0,"CS1"),U,20)=8 ;METS AT DX-BONE (34.31)
S $P(^ONCO(165.5,D0,"CS1"),U,21)=8 ;METS AT DX-BRAIN (34.32)
S $P(^ONCO(165.5,D0,"CS1"),U,24)=8 ;METS AT DX-DISTANT LN (34.35)
S $P(^ONCO(165.5,D0,"CS1"),U,22)=8 ;METS AT DX-LIVER (34.33)
S $P(^ONCO(165.5,D0,"CS1"),U,23)=8 ;METS AT DX-LUNG (34.34)
S $P(^ONCO(165.5,D0,"CS1"),U,25)=8 ;METS AT DX-OTHER (34.36)
Q
METSPR ;
W !!,"METS AT DX-BONE: 8 NA"
W !,"METS AT DX-BRAIN: 8 NA"
W !,"METS AT DX-DISTANT LN: 8 NA"
W !,"METS AT DX-LIVER: 8 NA"
W !,"METS AT DX-LUNG: 8 NA"
W !,"METS AT DX-OTHER: 8 NA"
Q
ACCRED ;Code to calculate/automatically set COC ACCREDITED FLAG (#7033) field
; this code will also automatically set the DERIVED SS2018 (#7012) fld
S $P(^ONCO(165.5,DA,"NCR18"),"^",13)=9 ;set=9 until were able to calc
I $P($G(^ONCO(165.5,DA,0)),U,16)<3180000 Q
I $$COCACC^ONCACDU2'="01" S $P(^ONCO(165.5,DA,"NCR18B"),"^",10)=0
I $$COCACC^ONCACDU2="01" D
.N ONCCOC S ONCCOC=$P($G(^ONCO(165.5,DA,0)),U,4)
.I ((ONCCOC>1)&(ONCCOC<10)) S $P(^ONCO(165.5,DA,"NCR18B"),"^",10)=1 ;ANALYTIC, class of case 10-22 (iens in 165.3 of 2-9)
.I (ONCCOC=1)!(ONCCOC=24)!((ONCCOC>9)&(ONCCOC<23)) S $P(^ONCO(165.5,DA,"NCR18B"),"^",10)=2 ;NON-ANALYTIC, class of case 30-43,99,00 (iens 10-22,1,24)
Q
;
SET38001 ;code to set SCHEMA ID DESCRIPTION (#3800.1) field and display schema
S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
S ONCSKNM=$O(^ONCO(164.44,ONCGRIEN,1,"B",ONCSCMA,""))
W !!?4,"Schema: ",$P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,1),"-",$E($P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,2),1,40),!!," - - - - - - - - - - - - - - - - - - - - - - - - - - - - -",!!
S $P(^ONCO(165.5,DA,"SSD5"),"^",6)=$P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,1)_": "_$E($P($G(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,2),1,60)
Q
;
DERRAI ;code to set and display DERIVED RAI [3955] SSDi field
S ONC3885=$P($G(^ONCO(165.5,D0,"SSD3")),"^",15),V1=ONC3885
S ONC3804=$P($G(^ONCO(165.5,D0,"SSD1")),"^",5),V2=ONC3804
S ONC3907=$P($G(^ONCO(165.5,D0,"SSD4")),"^",3),V3=ONC3907
S ONC3811=$P($G(^ONCO(165.5,D0,"SSD1")),"^",12),V4=ONC3811
S ONC3933=$P($G(^ONCO(165.5,D0,"SSD4")),"^",28),V5=ONC3933
S ONC3955="ERR"
;
I (ONC3885=5)&(ONC3804=5)&(ONC3907=5)&(ONC3811=5)&(ONC3933=5) S ONC3955=8
I ((ONC3885=9)!(ONC3885=""))&((ONC3804=9)!(ONC3804=""))&((ONC3907=9)!(ONC3907=""))&((ONC3811=9)!(ONC3811=""))&((ONC3933=9)!(ONC3933="")) S ONC3955=9
I (ONC3885="")&(ONC3804="")&(ONC3907="")&(ONC3811="")&(ONC3933="") S ONC3955=""
I ((V1=0)!(V1=7)) D
.I ((V2=0)!(V2=1)!(V2=9)!(V2=""))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5="")) S ONC3955=9
I ((V1=9)!(V1="")) D
.I ((V2=0)!(V2=1))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5="")) S ONC3955=9
.I ((V2=9)!(V2=""))&((V3=0)!(V3=1))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5="")) S ONC3955=9
.I ((V2=9)!(V2=""))&((V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5="")) S ONC3955=9
.I ((V2=9)!(V2=""))&((V3=9)!(V3=""))&((V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)) S ONC3955=9
I ((V1=1)!(V1=6)) D
.I ((V2=0)!(V2=9)!(V2=""))&((V3=0)!(V3=9)!(V3=""))&((V4=0)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=7)!(V5=9)!(V5="")) S ONC3955=0
.I (V2=1)&((V3=0)!(V3=9)!(V3=""))&((V4=0)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=7)!(V5=9)!(V5="")) S ONC3955=1
.I ((V2=0)!(V2=1)!(V2=9)!(V2=""))&(V3=1)&((V4=0)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=7)!(V5=9)!(V5="")) S ONC3955=2
.I ((V2=0)!(V2=1)!(V2=9)!(V2=""))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=1)!(V4=6))&((V5=0)!(V5=7)!(V5=9)!(V5="")) S ONC3955=3
.I ((V2=0)!(V2=1)!(V2=9)!(V2=""))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=1)!(V5=6)) S ONC3955=4
;
I ONC3955="ERR" D Q
.S $P(^ONCO(165.5,D0,"SSD5"),"^",8)=""
.W !!?4,"** Could not calculate DERIVED RAI STAGE! **",!!
.S Y="@98765" K ONC3885,ONC3804,ONC3907,ONC3811,ONC3933,ONC3955 Q
D Q
.S $P(^ONCO(165.5,D0,"SSD5"),"^",8)=ONC3955
.W !!?4,"** Derived RAI Stage = ",ONC3955," **",!!
.S Y="@98765" K ONC3885,ONC3804,ONC3907,ONC3811,ONC3933,ONC3955 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMU 10813 printed Oct 16, 2024@18:28:47 Page 2
ONCSCHMU ;HINES OIFO/RTK - Utilities for NAACCR 2018+ ;08/01/19
+1 ;;2.2;ONCOLOGY;**10,13,14,15,17,18**;Jul 31, 2013;Build 5
+2 ;
+3 QUIT
+4 ;
CTNM ;
+1 DO NOCTNM
QUIT
PTNM ;
+1 DO NOPTNM^ONCSCHMU
QUIT
YTNM ;
+1 DO NOYTNM^ONCSCHMU
QUIT
+2 QUIT
NOCTNM ;
+1 WRITE !,"==== No TNM classification is available for this AJCC Chapter ===="
+2 ;5001 AJCC TNM CLIN T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,2)=88
+3 ;5002 AJCC TNM CLIN N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,3)=88
+4 ;5003 AJCC TNM CLIN M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,4)=88
+5 WRITE !!,"AJCC TNM CLIN T: 88"
+6 WRITE !,"AJCC TNM CLIN N: 88"
+7 WRITE !,"AJCC TNM CLIN M: 88"
+8 IF $PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,1)="00821"
IF HST14="9732"
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=99
+9 QUIT
+10 ;
NOPTNM ;
+1 ;5011 AJCC TNM PATH T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,6)=88
+2 ;5012 AJCC TNM PATH N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,7)=88
+3 ;5013 AJCC TNM PATH M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,8)=88
+4 ;5014 PSG
IF ($EXTRACT(ONCAJID,1,2)=81)
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=88
+5 IF $PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,1)="00821"
IF HST14="9732"
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=88
+6 WRITE !!,"AJCC TNM PATH T: 88"
+7 WRITE !,"AJCC TNM PATH N: 88"
+8 WRITE !,"AJCC TNM PATH M: 88"
+9 IF ($EXTRACT(ONCAJID,1,2)=81)
WRITE !,"AJCC TNM PATH STAGE GROUP: 88",!
+10 QUIT
+11 ;
NOYTNM ;
+1 ;5025 AJCC TNM POST THERAPY (yc) T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,20)=""
+2 ;5026 AJCC TNM POST THERAPY (yc) N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,21)=""
+3 ;5027 AJCC TNM POST THERAPY (yc) M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,22)=""
+4 ;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
+5 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !!,"AJCC TNM POST THERAPY (yc) T:"
+6 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !,"AJCC TNM POST THERAPY (yc) N:"
+7 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !,"AJCC TNM POST THERAPY (yc) M:"
+8 ;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP:",!
+9 ;5021 AJCC TNM POST THERAPY T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,10)=""
+10 ;5022 AJCC TNM POST THERAPY N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,11)=""
+11 ;5023 AJCC TNM POST THERAPY M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,12)=""
+12 ;5024 AJCC TNM PT STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,13)=""
+13 WRITE !!,"AJCC TNM POST THERAPY (yp) T:"
+14 WRITE !,"AJCC TNM POST THERAPY (yp) N:"
+15 WRITE !,"AJCC TNM POST THERAPY (yp) M:"
+16 WRITE !,"AJCC TNM POST THERAPY (yp) STAGE GROUP:",!
+17 QUIT
+18 ;
NOTNMSG ;AJCC ID ="XX" NO TNM CHAPTER
+1 ;Schemas 00118,00119,00128,00278,00288,00358,00378,00478
+2 ; 00558,00559,00598,00638,00698,00718,00778,99999
+3 ;5000 AJCC ID
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,1)="XX"
+4 WRITE !,"==== AJCC ID='XX' -- No TNM Coding or Staging for this AJCC Chapter ===="
+5 ;
NONXX ;5001 AJCC TNM CLIN T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,2)=88
+1 ;5002 AJCC TNM CLIN N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,3)=88
+2 ;5003 AJCC TNM CLIN M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,4)=88
+3 ;5004 AJCC TNM CLIN STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=88
+4 ;set "ASG" for field 38.5
SET TMP=$GET(X)
SET X=88
DO CSSG^ONCOCRC
SET X=TMP
KILL TMP
+5 ;5011 AJCC TNM PATH T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,6)=88
+6 ;5012 AJCC TNM PATH N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,7)=88
+7 ;5013 AJCC TNM PATH M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,8)=88
+8 ;5014 AJCC TNM PATH STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=88
+9 ;set "ASG" for field 38.5
SET TMP=$GET(X)
SET X=88
DO PSSG^ONCOCRC
SET X=TMP
KILL TMP
+10 ;5025 AJCC TNM POST THERAPY (yc) T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,20)=""
+11 ;5026 AJCC TNM POST THERAPY (yc) N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,21)=""
+12 ;5027 AJCC TNM POST THERAPY (yc) M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,22)=""
+13 ;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
+14 ;5021 AJCC TNM POST THERAPY T
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,10)=""
+15 ;5022 AJCC TNM POST THERAPY N
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,11)=""
+16 ;5023 AJCC TNM POST THERAPY M
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,12)=""
+17 ;5024 AJCC TNM PT STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,13)=""
+18 WRITE !!,"AJCC TNM CLIN T: 88"
+19 WRITE !,"AJCC TNM CLIN N: 88"
+20 WRITE !,"AJCC TNM CLIN M: 88"
+21 WRITE !,"AJCC TNM CLIN STAGE GROUP: 88"
+22 WRITE !!,"AJCC TNM PATH T: 88"
+23 WRITE !,"AJCC TNM PATH N: 88"
+24 WRITE !,"AJCC TNM PATH M: 88"
+25 WRITE !,"AJCC TNM PATH STAGE GROUP: 88"
+26 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !!,"AJCC TNM POST THERAPY (yc) T="
+27 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !,"AJCC TNM POST THERAPY (yc) N="
+28 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
WRITE !,"AJCC TNM POST THERAPY (yc) M="
+29 ;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP=",!
+30 WRITE !!,"AJCC TNM POST THERAPY (yp) T="
+31 WRITE !,"AJCC TNM POST THERAPY (yp) N="
+32 WRITE !,"AJCC TNM POST THERAPY (yp) M="
+33 WRITE !,"AJCC TNM POST THERAPY (yp) STAGE GROUP=",!
+34 QUIT
FRSG385 ; Force setting "ASG" for field 38.5 (Stage Group AJCC)
+1 ; called from [ONCO ABSTRACT-I] input template
+2 NEW IEN,SG
+3 SET IEN=D0
+4 SET PSG=$PIECE($GET(^ONCO(165.5,IEN,"AJCC8")),"^",9)
IF PSG'=""
SET PSG=$EXTRACT(PSG)
+5 SET PSGDS=""
IF PSG'=""
SET PSGDS=$SELECT(PSG=0:0,PSG=1:"I",PSG=2:"II",PSG=3:"III",PSG=4:"IV",PSG=9:"U",PSG=8:"NA",1:"")
+6 SET CSG=$PIECE($GET(^ONCO(165.5,IEN,"AJCC8")),"^",5)
IF CSG'=""
SET CSG=$EXTRACT(CSG)
+7 SET CSGDS=""
IF CSG'=""
SET CSGDS=$SELECT(CSG=0:0,CSG=1:"I",CSG=2:"II",CSG=3:"III",CSG=4:"IV",CSG=9:"U",CSG=8:"NA",1:"")
+8 SET SG=$SELECT(PSG="":CSGDS,CSG="":PSGDS,PSG<7:PSGDS,PSG>7&(CSG<7):CSGDS,1:PSGDS)
DO KXR
DO SXR
+9 KILL CSG,CSGDS,PSG,PSGDS
QUIT
KXR ; KILL OFF THE OLD "ASG" X-REF
+1 NEW XSG
+2 SET XSG=$SELECT($DATA(^ONCO(165.5,IEN,2)):$PIECE(^ONCO(165.5,IEN,2),"^",28),1:"")
if XSG=""
QUIT
+3 IF $DATA(^ONCO(165.5,"ASG",XSG,IEN))
KILL ^ONCO(165.5,"ASG",XSG,IEN)
+4 QUIT
SXR ; STUFF STAGE FIELD (#38.5), SET NEW "ASG" X-REF
+1 NEW XSG
+2 if SG=""
QUIT
SET $PIECE(^ONCO(165.5,IEN,2),"^",28)=SG
SET ^ONCO(165.5,"ASG",SG,IEN)=""
+3 QUIT
+4 ;
EODCHK1 ;
+1 DO ^ONCSCHMA
+2 IF ONCSCMA="99999"
DO EODPR88
DO EODRN88
DO EODMT88
SET Y="@1776"
QUIT
+3 QUIT
EODCHK2 ;
+1 DO ^ONCSCHMA
+2 IF "00790^00795^00821^00830"[ONCSCMA
DO EODRN88
DO EODMT88
SET Y="@1776"
QUIT
+3 IF "00721^00722^00723^09721^09722^09723^09724"[ONCSCMA
DO EODRN88
SET Y="@1774"
QUIT
+4 QUIT
EODCHK3 ;
+1 DO ^ONCSCHMA
+2 IF (ONCSCMA="00458")!(ONCSCMA="00822")
DO EODMT88
SET Y="@1776"
QUIT
+3 QUIT
EODPR88 ;
+1 ;1772 EOD PRIMARY TUMOR
SET $PIECE(^ONCO(165.5,D0,"EOD"),U,1)=888
+2 WRITE !,"EOD PRIMARY TUMOR: 888"
+3 QUIT
EODRN88 ;
+1 ;1774 EOD REGIONAL NODES
SET $PIECE(^ONCO(165.5,D0,"EOD"),U,2)=888
+2 WRITE !,"EOD REGIONAL NODES: 888"
+3 QUIT
EODMT88 ;
+1 ;1776 EOD METS
SET $PIECE(^ONCO(165.5,D0,"EOD"),U,3)=88
+2 WRITE !,"EOD METS: 88"
+3 QUIT
METSCHK ;Check for stuffing 88s for METS fields for 2018+ cases
+1 IF $GET(TOPCOD)=""
QUIT
+2 IF $GET(ONCSCMA)=""
QUIT
+3 IF (TOPCOD="C42.0")!(TOPCOD="C42.1")!(TOPCOD="C42.3")!(TOPCOD="C42.4")!(ONCSCMA="00821")!(ONCSCMA="00822")!(ONCSCMA="00830")
DO METS8
DO METSPR
SET Y="@3436"
+4 QUIT
METS8 ;
+1 ;METS AT DX-BONE (34.31)
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,20)=8
+2 ;METS AT DX-BRAIN (34.32)
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,21)=8
+3 ;METS AT DX-DISTANT LN (34.35)
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,24)=8
+4 ;METS AT DX-LIVER (34.33)
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,22)=8
+5 ;METS AT DX-LUNG (34.34)
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,23)=8
+6 ;METS AT DX-OTHER (34.36)
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,25)=8
+7 QUIT
METSPR ;
+1 WRITE !!,"METS AT DX-BONE: 8 NA"
+2 WRITE !,"METS AT DX-BRAIN: 8 NA"
+3 WRITE !,"METS AT DX-DISTANT LN: 8 NA"
+4 WRITE !,"METS AT DX-LIVER: 8 NA"
+5 WRITE !,"METS AT DX-LUNG: 8 NA"
+6 WRITE !,"METS AT DX-OTHER: 8 NA"
+7 QUIT
ACCRED ;Code to calculate/automatically set COC ACCREDITED FLAG (#7033) field
+1 ; this code will also automatically set the DERIVED SS2018 (#7012) fld
+2 ;set=9 until were able to calc
SET $PIECE(^ONCO(165.5,DA,"NCR18"),"^",13)=9
+3 IF $PIECE($GET(^ONCO(165.5,DA,0)),U,16)<3180000
QUIT
+4 IF $$COCACC^ONCACDU2'="01"
SET $PIECE(^ONCO(165.5,DA,"NCR18B"),"^",10)=0
+5 IF $$COCACC^ONCACDU2="01"
Begin DoDot:1
+6 NEW ONCCOC
SET ONCCOC=$PIECE($GET(^ONCO(165.5,DA,0)),U,4)
+7 ;ANALYTIC, class of case 10-22 (iens in 165.3 of 2-9)
IF ((ONCCOC>1)&(ONCCOC<10))
SET $PIECE(^ONCO(165.5,DA,"NCR18B"),"^",10)=1
+8 ;NON-ANALYTIC, class of case 30-43,99,00 (iens 10-22,1,24)
IF (ONCCOC=1)!(ONCCOC=24)!((ONCCOC>9)&(ONCCOC<23))
SET $PIECE(^ONCO(165.5,DA,"NCR18B"),"^",10)=2
End DoDot:1
+9 QUIT
+10 ;
SET38001 ;code to set SCHEMA ID DESCRIPTION (#3800.1) field and display schema
+1 SET ONCGRIEN=$ORDER(^ONCO(164.44,"C",ONCSCMA,""))
IF ONCGRIEN=""
QUIT
+2 SET ONCSKNM=$ORDER(^ONCO(164.44,ONCGRIEN,1,"B",ONCSCMA,""))
+3 WRITE !!?4,"Schema: ",$PIECE($GET(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,1),"-",$EXTRACT($PIECE($GET(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,2),1,40),!!," - - - - - - - - - - - - - - - - - - - - - - - - - - - - -",!!
+4 SET $PIECE(^ONCO(165.5,DA,"SSD5"),"^",6)=$PIECE($GET(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,1)_": "_$EXTRACT($PIECE($GET(^ONCO(164.44,ONCGRIEN,1,ONCSKNM,0)),U,2),1,60)
+5 QUIT
+6 ;
DERRAI ;code to set and display DERIVED RAI [3955] SSDi field
+1 SET ONC3885=$PIECE($GET(^ONCO(165.5,D0,"SSD3")),"^",15)
SET V1=ONC3885
+2 SET ONC3804=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),"^",5)
SET V2=ONC3804
+3 SET ONC3907=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),"^",3)
SET V3=ONC3907
+4 SET ONC3811=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),"^",12)
SET V4=ONC3811
+5 SET ONC3933=$PIECE($GET(^ONCO(165.5,D0,"SSD4")),"^",28)
SET V5=ONC3933
+6 SET ONC3955="ERR"
+7 ;
+8 IF (ONC3885=5)&(ONC3804=5)&(ONC3907=5)&(ONC3811=5)&(ONC3933=5)
SET ONC3955=8
+9 IF ((ONC3885=9)!(ONC3885=""))&((ONC3804=9)!(ONC3804=""))&((ONC3907=9)!(ONC3907=""))&((ONC3811=9)!(ONC3811=""))&((ONC3933=9)!(ONC3933=""))
SET ONC3955=9
+10 IF (ONC3885="")&(ONC3804="")&(ONC3907="")&(ONC3811="")&(ONC3933="")
SET ONC3955=""
+11 IF ((V1=0)!(V1=7))
Begin DoDot:1
+12 IF ((V2=0)!(V2=1)!(V2=9)!(V2=""))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=9
End DoDot:1
+13 IF ((V1=9)!(V1=""))
Begin DoDot:1
+14 IF ((V2=0)!(V2=1))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=9
+15 IF ((V2=9)!(V2=""))&((V3=0)!(V3=1))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=9
+16 IF ((V2=9)!(V2=""))&((V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7))&((V5=0)!(V5=1)!(V5=6)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=9
+17 IF ((V2=9)!(V2=""))&((V3=9)!(V3=""))&((V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7))
SET ONC3955=9
End DoDot:1
+18 IF ((V1=1)!(V1=6))
Begin DoDot:1
+19 IF ((V2=0)!(V2=9)!(V2=""))&((V3=0)!(V3=9)!(V3=""))&((V4=0)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=0
+20 IF (V2=1)&((V3=0)!(V3=9)!(V3=""))&((V4=0)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=1
+21 IF ((V2=0)!(V2=1)!(V2=9)!(V2=""))&(V3=1)&((V4=0)!(V4=7)!(V4=9)!(V4=""))&((V5=0)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=2
+22 IF ((V2=0)!(V2=1)!(V2=9)!(V2=""))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=1)!(V4=6))&((V5=0)!(V5=7)!(V5=9)!(V5=""))
SET ONC3955=3
+23 IF ((V2=0)!(V2=1)!(V2=9)!(V2=""))&((V3=0)!(V3=1)!(V3=9)!(V3=""))&((V4=0)!(V4=1)!(V4=6)!(V4=7)!(V4=9)!(V4=""))&((V5=1)!(V5=6))
SET ONC3955=4
End DoDot:1
+24 ;
+25 IF ONC3955="ERR"
Begin DoDot:1
+26 SET $PIECE(^ONCO(165.5,D0,"SSD5"),"^",8)=""
+27 WRITE !!?4,"** Could not calculate DERIVED RAI STAGE! **",!!
+28 SET Y="@98765"
KILL ONC3885,ONC3804,ONC3907,ONC3811,ONC3933,ONC3955
QUIT
End DoDot:1
QUIT
+29 Begin DoDot:1
+30 SET $PIECE(^ONCO(165.5,D0,"SSD5"),"^",8)=ONC3955
+31 WRITE !!?4,"** Derived RAI Stage = ",ONC3955," **",!!
+32 SET Y="@98765"
KILL ONC3885,ONC3804,ONC3907,ONC3811,ONC3933,ONC3955
QUIT
End DoDot:1
QUIT
+33 QUIT
