- ONCSCHMU ;HINES OIFO/RTK - Utilities for NAACCR 2018+ ;08/01/19
- ;;2.2;ONCOLOGY;**10,13,14,15,17,18,20**;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 ;
- I ONCSCMA="09724" D NONXX9724^ONCSCHMH Q
- 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 10863 printed Feb 18, 2025@23:54:36 Page 2
- ONCSCHMU ;HINES OIFO/RTK - Utilities for NAACCR 2018+ ;08/01/19
- +1 ;;2.2;ONCOLOGY;**10,13,14,15,17,18,20**;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 ;
- +1 IF ONCSCMA="09724"
- DO NONXX9724^ONCSCHMH
- QUIT
- +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 ;5004 AJCC TNM CLIN STAGE GROUP
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,5)=88
- +6 ;set "ASG" for field 38.5
- SET TMP=$GET(X)
- SET X=88
- DO CSSG^ONCOCRC
- SET X=TMP
- KILL TMP
- +7 ;5011 AJCC TNM PATH T
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,6)=88
- +8 ;5012 AJCC TNM PATH N
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,7)=88
- +9 ;5013 AJCC TNM PATH M
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,8)=88
- +10 ;5014 AJCC TNM PATH STAGE GROUP
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,9)=88
- +11 ;set "ASG" for field 38.5
- SET TMP=$GET(X)
- SET X=88
- DO PSSG^ONCOCRC
- SET X=TMP
- KILL TMP
- +12 ;5025 AJCC TNM POST THERAPY (yc) T
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,20)=""
- +13 ;5026 AJCC TNM POST THERAPY (yc) N
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,21)=""
- +14 ;5027 AJCC TNM POST THERAPY (yc) M
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,22)=""
- +15 ;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
- +16 ;5021 AJCC TNM POST THERAPY T
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,10)=""
- +17 ;5022 AJCC TNM POST THERAPY N
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,11)=""
- +18 ;5023 AJCC TNM POST THERAPY M
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,12)=""
- +19 ;5024 AJCC TNM PT STAGE GROUP
- SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,13)=""
- +20 WRITE !!,"AJCC TNM CLIN T: 88"
- +21 WRITE !,"AJCC TNM CLIN N: 88"
- +22 WRITE !,"AJCC TNM CLIN M: 88"
- +23 WRITE !,"AJCC TNM CLIN STAGE GROUP: 88"
- +24 WRITE !!,"AJCC TNM PATH T: 88"
- +25 WRITE !,"AJCC TNM PATH N: 88"
- +26 WRITE !,"AJCC TNM PATH M: 88"
- +27 WRITE !,"AJCC TNM PATH STAGE GROUP: 88"
- +28 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
- WRITE !!,"AJCC TNM POST THERAPY (yc) T="
- +29 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
- WRITE !,"AJCC TNM POST THERAPY (yc) N="
- +30 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3210000
- WRITE !,"AJCC TNM POST THERAPY (yc) M="
- +31 ;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP=",!
- +32 WRITE !!,"AJCC TNM POST THERAPY (yp) T="
- +33 WRITE !,"AJCC TNM POST THERAPY (yp) N="
- +34 WRITE !,"AJCC TNM POST THERAPY (yp) M="
- +35 WRITE !,"AJCC TNM POST THERAPY (yp) STAGE GROUP=",!
- +36 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