Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCSCHMU

ONCSCHMU.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. Q
  1. ;
  1. CTNM ;
  1. D NOCTNM Q
  1. PTNM ;
  1. D NOPTNM^ONCSCHMU Q
  1. YTNM ;
  1. D NOYTNM^ONCSCHMU Q
  1. Q
  1. NOCTNM ;
  1. W !,"==== No TNM classification is available for this AJCC Chapter ===="
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,2)=88 ;5001 AJCC TNM CLIN T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,3)=88 ;5002 AJCC TNM CLIN N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,4)=88 ;5003 AJCC TNM CLIN M
  1. W !!,"AJCC TNM CLIN T: 88"
  1. W !,"AJCC TNM CLIN N: 88"
  1. W !,"AJCC TNM CLIN M: 88"
  1. I $P($G(^ONCO(165.5,D0,"SSD1")),U,1)="00821",HST14="9732" S $P(^ONCO(165.5,D0,"AJCC8"),U,5)=99
  1. Q
  1. ;
  1. NOPTNM ;
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,6)=88 ;5011 AJCC TNM PATH T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,7)=88 ;5012 AJCC TNM PATH N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,8)=88 ;5013 AJCC TNM PATH M
  1. I ($E(ONCAJID,1,2)=81) S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88 ;5014 PSG
  1. I $P($G(^ONCO(165.5,D0,"SSD1")),U,1)="00821",HST14="9732" S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88
  1. W !!,"AJCC TNM PATH T: 88"
  1. W !,"AJCC TNM PATH N: 88"
  1. W !,"AJCC TNM PATH M: 88"
  1. I ($E(ONCAJID,1,2)=81) W !,"AJCC TNM PATH STAGE GROUP: 88",!
  1. Q
  1. ;
  1. NOYTNM ;
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,20)="" ;5025 AJCC TNM POST THERAPY (yc) T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,21)="" ;5026 AJCC TNM POST THERAPY (yc) N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,22)="" ;5027 AJCC TNM POST THERAPY (yc) M
  1. ;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
  1. I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !!,"AJCC TNM POST THERAPY (yc) T:"
  1. I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) N:"
  1. I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) M:"
  1. ;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP:",!
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,10)="" ;5021 AJCC TNM POST THERAPY T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,11)="" ;5022 AJCC TNM POST THERAPY N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,12)="" ;5023 AJCC TNM POST THERAPY M
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,13)="" ;5024 AJCC TNM PT STAGE GROUP
  1. W !!,"AJCC TNM POST THERAPY (yp) T:"
  1. W !,"AJCC TNM POST THERAPY (yp) N:"
  1. W !,"AJCC TNM POST THERAPY (yp) M:"
  1. W !,"AJCC TNM POST THERAPY (yp) STAGE GROUP:",!
  1. Q
  1. ;
  1. NOTNMSG ;AJCC ID ="XX" NO TNM CHAPTER
  1. ;Schemas 00118,00119,00128,00278,00288,00358,00378,00478
  1. ; 00558,00559,00598,00638,00698,00718,00778,99999
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,1)="XX" ;5000 AJCC ID
  1. W !,"==== AJCC ID='XX' -- No TNM Coding or Staging for this AJCC Chapter ===="
  1. ;
  1. NONXX ;
  1. I ONCSCMA="09724" D NONXX9724^ONCSCHMH Q
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,2)=88 ;5001 AJCC TNM CLIN T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,3)=88 ;5002 AJCC TNM CLIN N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,4)=88 ;5003 AJCC TNM CLIN M
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,5)=88 ;5004 AJCC TNM CLIN STAGE GROUP
  1. S TMP=$G(X),X=88 D CSSG^ONCOCRC S X=TMP K TMP ;set "ASG" for field 38.5
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,6)=88 ;5011 AJCC TNM PATH T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,7)=88 ;5012 AJCC TNM PATH N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,8)=88 ;5013 AJCC TNM PATH M
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,9)=88 ;5014 AJCC TNM PATH STAGE GROUP
  1. S TMP=$G(X),X=88 D PSSG^ONCOCRC S X=TMP K TMP ;set "ASG" for field 38.5
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,20)="" ;5025 AJCC TNM POST THERAPY (yc) T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,21)="" ;5026 AJCC TNM POST THERAPY (yc) N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,22)="" ;5027 AJCC TNM POST THERAPY (yc) M
  1. ;S $P(^ONCO(165.5,D0,"AJCC8"),U,23)="" ;5028 AJCC TNM PT STAGE GROUP (yc) NOT APPLICABLE YET IN 2021
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,10)="" ;5021 AJCC TNM POST THERAPY T
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,11)="" ;5022 AJCC TNM POST THERAPY N
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,12)="" ;5023 AJCC TNM POST THERAPY M
  1. S $P(^ONCO(165.5,D0,"AJCC8"),U,13)="" ;5024 AJCC TNM PT STAGE GROUP
  1. W !!,"AJCC TNM CLIN T: 88"
  1. W !,"AJCC TNM CLIN N: 88"
  1. W !,"AJCC TNM CLIN M: 88"
  1. W !,"AJCC TNM CLIN STAGE GROUP: 88"
  1. W !!,"AJCC TNM PATH T: 88"
  1. W !,"AJCC TNM PATH N: 88"
  1. W !,"AJCC TNM PATH M: 88"
  1. W !,"AJCC TNM PATH STAGE GROUP: 88"
  1. I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !!,"AJCC TNM POST THERAPY (yc) T="
  1. I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) N="
  1. I $P($G(^ONCO(165.5,D0,0)),U,16)>3210000 W !,"AJCC TNM POST THERAPY (yc) M="
  1. ;W !,"AJCC TNM POST THERAPY (yc) STAGE GROUP=",!
  1. W !!,"AJCC TNM POST THERAPY (yp) T="
  1. W !,"AJCC TNM POST THERAPY (yp) N="
  1. W !,"AJCC TNM POST THERAPY (yp) M="
  1. W !,"AJCC TNM POST THERAPY (yp) STAGE GROUP=",!
  1. Q
  1. FRSG385 ; Force setting "ASG" for field 38.5 (Stage Group AJCC)
  1. ; called from [ONCO ABSTRACT-I] input template
  1. N IEN,SG
  1. S IEN=D0
  1. S PSG=$P($G(^ONCO(165.5,IEN,"AJCC8")),"^",9) I PSG'="" S PSG=$E(PSG)
  1. 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:"")
  1. S CSG=$P($G(^ONCO(165.5,IEN,"AJCC8")),"^",5) I CSG'="" S CSG=$E(CSG)
  1. 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:"")
  1. S SG=$S(PSG="":CSGDS,CSG="":PSGDS,PSG<7:PSGDS,PSG>7&(CSG<7):CSGDS,1:PSGDS) D KXR,SXR
  1. K CSG,CSGDS,PSG,PSGDS Q
  1. KXR ; KILL OFF THE OLD "ASG" X-REF
  1. N XSG
  1. S XSG=$S($D(^ONCO(165.5,IEN,2)):$P(^ONCO(165.5,IEN,2),"^",28),1:"") Q:XSG=""
  1. I $D(^ONCO(165.5,"ASG",XSG,IEN)) K ^ONCO(165.5,"ASG",XSG,IEN)
  1. Q
  1. SXR ; STUFF STAGE FIELD (#38.5), SET NEW "ASG" X-REF
  1. N XSG
  1. Q:SG="" S $P(^ONCO(165.5,IEN,2),"^",28)=SG,^ONCO(165.5,"ASG",SG,IEN)=""
  1. Q
  1. ;
  1. EODCHK1 ;
  1. D ^ONCSCHMA
  1. I ONCSCMA="99999" D EODPR88,EODRN88,EODMT88 S Y="@1776" Q
  1. Q
  1. EODCHK2 ;
  1. D ^ONCSCHMA
  1. I "00790^00795^00821^00830"[ONCSCMA D EODRN88,EODMT88 S Y="@1776" Q
  1. I "00721^00722^00723^09721^09722^09723^09724"[ONCSCMA D EODRN88 S Y="@1774" Q
  1. Q
  1. EODCHK3 ;
  1. D ^ONCSCHMA
  1. I (ONCSCMA="00458")!(ONCSCMA="00822") D EODMT88 S Y="@1776" Q
  1. Q
  1. EODPR88 ;
  1. S $P(^ONCO(165.5,D0,"EOD"),U,1)=888 ;1772 EOD PRIMARY TUMOR
  1. W !,"EOD PRIMARY TUMOR: 888"
  1. Q
  1. EODRN88 ;
  1. S $P(^ONCO(165.5,D0,"EOD"),U,2)=888 ;1774 EOD REGIONAL NODES
  1. W !,"EOD REGIONAL NODES: 888"
  1. Q
  1. EODMT88 ;
  1. S $P(^ONCO(165.5,D0,"EOD"),U,3)=88 ;1776 EOD METS
  1. W !,"EOD METS: 88"
  1. Q
  1. METSCHK ;Check for stuffing 88s for METS fields for 2018+ cases
  1. I $G(TOPCOD)="" Q
  1. I $G(ONCSCMA)="" Q
  1. 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"
  1. Q
  1. METS8 ;
  1. S $P(^ONCO(165.5,D0,"CS1"),U,20)=8 ;METS AT DX-BONE (34.31)
  1. S $P(^ONCO(165.5,D0,"CS1"),U,21)=8 ;METS AT DX-BRAIN (34.32)
  1. S $P(^ONCO(165.5,D0,"CS1"),U,24)=8 ;METS AT DX-DISTANT LN (34.35)
  1. S $P(^ONCO(165.5,D0,"CS1"),U,22)=8 ;METS AT DX-LIVER (34.33)
  1. S $P(^ONCO(165.5,D0,"CS1"),U,23)=8 ;METS AT DX-LUNG (34.34)
  1. S $P(^ONCO(165.5,D0,"CS1"),U,25)=8 ;METS AT DX-OTHER (34.36)
  1. Q
  1. METSPR ;
  1. W !!,"METS AT DX-BONE: 8 NA"
  1. W !,"METS AT DX-BRAIN: 8 NA"
  1. W !,"METS AT DX-DISTANT LN: 8 NA"
  1. W !,"METS AT DX-LIVER: 8 NA"
  1. W !,"METS AT DX-LUNG: 8 NA"
  1. W !,"METS AT DX-OTHER: 8 NA"
  1. Q
  1. ACCRED ;Code to calculate/automatically set COC ACCREDITED FLAG (#7033) field
  1. ; this code will also automatically set the DERIVED SS2018 (#7012) fld
  1. S $P(^ONCO(165.5,DA,"NCR18"),"^",13)=9 ;set=9 until were able to calc
  1. I $P($G(^ONCO(165.5,DA,0)),U,16)<3180000 Q
  1. I $$COCACC^ONCACDU2'="01" S $P(^ONCO(165.5,DA,"NCR18B"),"^",10)=0
  1. I $$COCACC^ONCACDU2="01" D
  1. .N ONCCOC S ONCCOC=$P($G(^ONCO(165.5,DA,0)),U,4)
  1. .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)
  1. .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)
  1. Q
  1. ;
  1. SET38001 ;code to set SCHEMA ID DESCRIPTION (#3800.1) field and display schema
  1. S ONCGRIEN=$O(^ONCO(164.44,"C",ONCSCMA,"")) I ONCGRIEN="" Q
  1. S ONCSKNM=$O(^ONCO(164.44,ONCGRIEN,1,"B",ONCSCMA,""))
  1. 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),!!," - - - - - - - - - - - - - - - - - - - - - - - - - - - - -",!!
  1. 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)
  1. Q
  1. ;
  1. DERRAI ;code to set and display DERIVED RAI [3955] SSDi field
  1. S ONC3885=$P($G(^ONCO(165.5,D0,"SSD3")),"^",15),V1=ONC3885
  1. S ONC3804=$P($G(^ONCO(165.5,D0,"SSD1")),"^",5),V2=ONC3804
  1. S ONC3907=$P($G(^ONCO(165.5,D0,"SSD4")),"^",3),V3=ONC3907
  1. S ONC3811=$P($G(^ONCO(165.5,D0,"SSD1")),"^",12),V4=ONC3811
  1. S ONC3933=$P($G(^ONCO(165.5,D0,"SSD4")),"^",28),V5=ONC3933
  1. S ONC3955="ERR"
  1. ;
  1. I (ONC3885=5)&(ONC3804=5)&(ONC3907=5)&(ONC3811=5)&(ONC3933=5) S ONC3955=8
  1. I ((ONC3885=9)!(ONC3885=""))&((ONC3804=9)!(ONC3804=""))&((ONC3907=9)!(ONC3907=""))&((ONC3811=9)!(ONC3811=""))&((ONC3933=9)!(ONC3933="")) S ONC3955=9
  1. I (ONC3885="")&(ONC3804="")&(ONC3907="")&(ONC3811="")&(ONC3933="") S ONC3955=""
  1. I ((V1=0)!(V1=7)) D
  1. .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
  1. I ((V1=9)!(V1="")) D
  1. .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
  1. .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
  1. .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
  1. .I ((V2=9)!(V2=""))&((V3=9)!(V3=""))&((V4=9)!(V4=""))&((V5=0)!(V5=1)!(V5=6)!(V5=7)) S ONC3955=9
  1. I ((V1=1)!(V1=6)) D
  1. .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
  1. .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
  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
  1. .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
  1. .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
  1. ;
  1. I ONC3955="ERR" D Q
  1. .S $P(^ONCO(165.5,D0,"SSD5"),"^",8)=""
  1. .W !!?4,"** Could not calculate DERIVED RAI STAGE! **",!!
  1. .S Y="@98765" K ONC3885,ONC3804,ONC3907,ONC3811,ONC3933,ONC3955 Q
  1. D Q
  1. .S $P(^ONCO(165.5,D0,"SSD5"),"^",8)=ONC3955
  1. .W !!?4,"** Derived RAI Stage = ",ONC3955," **",!!
  1. .S Y="@98765" K ONC3885,ONC3804,ONC3907,ONC3811,ONC3933,ONC3955 Q
  1. Q