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.
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