ONCOAIT ;HINES OIFO/GWB - Topography functions, Comorbidity List, SEER; 8/05/10
;;2.2;ONCOLOGY;**1,4,6,12,18**;Jul 31, 2013;Build 5
TOP() ;Called by ONCO ABSTRACT-I input template
N ONCOFLD
N ONCOED S ONCOED=$$TNMED^ONCOU55(D0)
N TOP3 S TOP3=$E(TOP,3,5)
I ONCOED<5,(TOP3=700)!($E(TOP3,1,2)=71) S ONCOFLD=21.5 ;INFRA/SUPRA for 4th edition brain cases
E I TOP3=694 S ONCOFLD=21.51 ;IRIS/CILIARY BODY for Malignant Melanoma of the Uvea
E I ONCOED<5,TOP3=529 S ONCOFLD=21.52 ;UPPER/LOWER for vagina cases
E S ONCOFLD=100 ;proceed to TEXT-PRIMARY SITE
Q ONCOFLD
;
SEER(ONCDD5) ;SEER State layout v16 P2.2*6
;ONCDD5 = dd data field of 165.5
S DATEDX=$$GET1^DIQ(165.5,IEN,3,"I")
S ACDANS=$$GET1^DIQ(165.5,IEN,ONCDD5,"I")
S:($G(ONCRCL)=2)&((DATEDX<3040000)!(DATEDX>3151231)) ACDANS=""
S:($G(ONCRCL)=3)&(DATEDX<3040000) ACDANS=""
K DATEDX
Q ACDANS
;
SEERFLG(ONCDD5) ;SEER derived flag
S ACDANS=""
S DATEDX=$$GET1^DIQ(165.5,IEN,3,"I")
S ONCSX=$$GET1^DIQ(165.5,IEN,ONCDD5,"I")
S:ONCSX'="" ACDANS=1
S:($G(ONCRCL)=2)&((DATEDX<3040000)!(DATEDX>3151231)) ACDANS=""
S:($G(ONCRCL)=3)&(DATEDX<3040000) ACDANS=""
K ONCSX,DATEDX
Q ACDANS
;
NCST(ACDANS,ONCPHI) ;Comorbidity extract, p2.2*4
;ACDANS -- input/output variable
;ONCPHI -- input- 1 if excluded; 0 if NOT excluded
;old logic
;S ACDANS=$$GET1~DIQ(160,ACD160,25,""I"")
;S:ACDANS'="""" ACDANS=$$GET1~DIQ(80,ACDANS,.01,""I"") S ACDANS=$P(ACDANS,""."",1)_$P(ACDANS,""."",2)"
;
I $G(EXTRACT)'=3 S ONCPHI=1
I $G(ONCPHI)'=1 S:ACDANS'="" ACDANS=$$GET1^DIQ(80,ACDANS,.01,"I") S ACDANS=$P(ACDANS,".",1)_$P(ACDANS,".",2) Q ACDANS
N ONCMO1,ONCMO2,ONCI1,ONCJ1,ONCD9
K ^TMP($J,"ONCOMO")
F ONCI1=1:1 S ONCMO1=$P($T(COMO+ONCI1),";",3) Q:ONCMO1="" F ONCJ1=1:1 S ONCMO2=$P(ONCMO1,"^",ONCJ1) Q:ONCMO2="" D
.S ^TMP($J,"ONCOMO",ONCMO2)=""
S ONCD9=$$GET1^DIQ(80,ACDANS,.01,"I")
I $G(ONCPHI),(ONCD9'=""),'($D(^TMP($J,"ONCOMO",ONCD9))) S ACDANS=$P(ONCD9,".",1)_$P(ONCD9,".",2)
I $G(ONCPHI),(ONCD9'=""),($D(^TMP($J,"ONCOMO",ONCD9))) S ACDANS=""
K ^TMP($J,"ONCOMO")
Q ACDANS
;
COMO ;list of comorbidity codes, p2.2*4, Updated in p#18
;;291.1^291.2^291.3^291.4^291.5^291.9^292.0^292.2^303.91^303.92^303.93^305.01^305.02^305.03^760.71^760.72^790.3^977.3^980.1^980.2
;;980.9^291.0^303.90^305.00^980.0^E860.2^E860.3^E860.9^E947.3^291.89^291.81^291.82^291.8^303.00^303.01^303.02^303.03^303.90
;;303.01^303.02^303.03^357.5^357.6^425.5^535.3^571.1^571.2^571.3^303.00^571.0^E860.0^E860.1^E860.8^535.30^535.31^V11.3^272.4
;;292.20^980.8^042.0^042.1^042.2^042.9^043.0^043.1^043.2^043.3^043.9^044.0^044.9^079.53^042.^795.71^V08.^V65.44^V61.41
;;282.60^282.61^282.62^282.63^282.64^282.68^282.69^282.41^282.42^292.81^292.82^292.83^292.84^292.385^292.89^292.9^760.73
;;304.00^304.01^304.02^304.03^304.09^304.10^304.11^304.12^304.13^304.14^304.15^304.16^304.17^304.18^304.19^304.20^304.21
;;304.22^304.23^304.30^304.31^304.32^304.33^304.39^304.40^304.41^304.42^304.43^304.49^304.50^304.51^304.52^304.53^304.59
;;304.60^304.61^304.62^304.63^304.70^304.71^304.72^304.73^304.80^304.81^304.82^304.83^304.90^304.91^304.92^304.92^304.93
;;304.99^305.00^305.01^305.02^305.03^305.29^305.30^305.31^305.32^305.33^305.39^305.40^760.74^760.75^V79.1
;;305.41^305.42^305.43^305.44^305.45^305.46^305.47^305.48^305.49^305.50^305.51^305.52^305.53^305.59^305.6^305.60^305.61
;;305.62^305.63^305.70^305.71^305.72^305.73^305.79^305.80^305.81^305.82^305.83^305.90^305.91^305.92^305.93^305.99
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAIT 3491 printed Apr 09, 2024@21:30:19 Page 2
ONCOAIT ;HINES OIFO/GWB - Topography functions, Comorbidity List, SEER; 8/05/10
+1 ;;2.2;ONCOLOGY;**1,4,6,12,18**;Jul 31, 2013;Build 5
TOP() ;Called by ONCO ABSTRACT-I input template
+1 NEW ONCOFLD
+2 NEW ONCOED
SET ONCOED=$$TNMED^ONCOU55(D0)
+3 NEW TOP3
SET TOP3=$EXTRACT(TOP,3,5)
+4 ;INFRA/SUPRA for 4th edition brain cases
IF ONCOED<5
IF (TOP3=700)!($EXTRACT(TOP3,1,2)=71)
SET ONCOFLD=21.5
+5 ;IRIS/CILIARY BODY for Malignant Melanoma of the Uvea
IF '$TEST
IF TOP3=694
SET ONCOFLD=21.51
+6 ;UPPER/LOWER for vagina cases
IF '$TEST
IF ONCOED<5
IF TOP3=529
SET ONCOFLD=21.52
+7 ;proceed to TEXT-PRIMARY SITE
IF '$TEST
SET ONCOFLD=100
+8 QUIT ONCOFLD
+9 ;
SEER(ONCDD5) ;SEER State layout v16 P2.2*6
+1 ;ONCDD5 = dd data field of 165.5
+2 SET DATEDX=$$GET1^DIQ(165.5,IEN,3,"I")
+3 SET ACDANS=$$GET1^DIQ(165.5,IEN,ONCDD5,"I")
+4 if ($GET(ONCRCL)=2)&((DATEDX<3040000)!(DATEDX>3151231))
SET ACDANS=""
+5 if ($GET(ONCRCL)=3)&(DATEDX<3040000)
SET ACDANS=""
+6 KILL DATEDX
+7 QUIT ACDANS
+8 ;
SEERFLG(ONCDD5) ;SEER derived flag
+1 SET ACDANS=""
+2 SET DATEDX=$$GET1^DIQ(165.5,IEN,3,"I")
+3 SET ONCSX=$$GET1^DIQ(165.5,IEN,ONCDD5,"I")
+4 if ONCSX'=""
SET ACDANS=1
+5 if ($GET(ONCRCL)=2)&((DATEDX<3040000)!(DATEDX>3151231))
SET ACDANS=""
+6 if ($GET(ONCRCL)=3)&(DATEDX<3040000)
SET ACDANS=""
+7 KILL ONCSX,DATEDX
+8 QUIT ACDANS
+9 ;
NCST(ACDANS,ONCPHI) ;Comorbidity extract, p2.2*4
+1 ;ACDANS -- input/output variable
+2 ;ONCPHI -- input- 1 if excluded; 0 if NOT excluded
+3 ;old logic
+4 ;S ACDANS=$$GET1~DIQ(160,ACD160,25,""I"")
+5 ;S:ACDANS'="""" ACDANS=$$GET1~DIQ(80,ACDANS,.01,""I"") S ACDANS=$P(ACDANS,""."",1)_$P(ACDANS,""."",2)"
+6 ;
+7 IF $GET(EXTRACT)'=3
SET ONCPHI=1
+8 IF $GET(ONCPHI)'=1
if ACDANS'=""
SET ACDANS=$$GET1^DIQ(80,ACDANS,.01,"I")
SET ACDANS=$PIECE(ACDANS,".",1)_$PIECE(ACDANS,".",2)
QUIT ACDANS
+9 NEW ONCMO1,ONCMO2,ONCI1,ONCJ1,ONCD9
+10 KILL ^TMP($JOB,"ONCOMO")
+11 FOR ONCI1=1:1
SET ONCMO1=$PIECE($TEXT(COMO+ONCI1),";",3)
if ONCMO1=""
QUIT
FOR ONCJ1=1:1
SET ONCMO2=$PIECE(ONCMO1,"^",ONCJ1)
if ONCMO2=""
QUIT
Begin DoDot:1
+12 SET ^TMP($JOB,"ONCOMO",ONCMO2)=""
End DoDot:1
+13 SET ONCD9=$$GET1^DIQ(80,ACDANS,.01,"I")
+14 IF $GET(ONCPHI)
IF (ONCD9'="")
IF '($DATA(^TMP($JOB,"ONCOMO",ONCD9)))
SET ACDANS=$PIECE(ONCD9,".",1)_$PIECE(ONCD9,".",2)
+15 IF $GET(ONCPHI)
IF (ONCD9'="")
IF ($DATA(^TMP($JOB,"ONCOMO",ONCD9)))
SET ACDANS=""
+16 KILL ^TMP($JOB,"ONCOMO")
+17 QUIT ACDANS
+18 ;
COMO ;list of comorbidity codes, p2.2*4, Updated in p#18
+1 ;;291.1^291.2^291.3^291.4^291.5^291.9^292.0^292.2^303.91^303.92^303.93^305.01^305.02^305.03^760.71^760.72^790.3^977.3^980.1^980.2
+2 ;;980.9^291.0^303.90^305.00^980.0^E860.2^E860.3^E860.9^E947.3^291.89^291.81^291.82^291.8^303.00^303.01^303.02^303.03^303.90
+3 ;;303.01^303.02^303.03^357.5^357.6^425.5^535.3^571.1^571.2^571.3^303.00^571.0^E860.0^E860.1^E860.8^535.30^535.31^V11.3^272.4
+4 ;;292.20^980.8^042.0^042.1^042.2^042.9^043.0^043.1^043.2^043.3^043.9^044.0^044.9^079.53^042.^795.71^V08.^V65.44^V61.41
+5 ;;282.60^282.61^282.62^282.63^282.64^282.68^282.69^282.41^282.42^292.81^292.82^292.83^292.84^292.385^292.89^292.9^760.73
+6 ;;304.00^304.01^304.02^304.03^304.09^304.10^304.11^304.12^304.13^304.14^304.15^304.16^304.17^304.18^304.19^304.20^304.21
+7 ;;304.22^304.23^304.30^304.31^304.32^304.33^304.39^304.40^304.41^304.42^304.43^304.49^304.50^304.51^304.52^304.53^304.59
+8 ;;304.60^304.61^304.62^304.63^304.70^304.71^304.72^304.73^304.80^304.81^304.82^304.83^304.90^304.91^304.92^304.92^304.93
+9 ;;304.99^305.00^305.01^305.02^305.03^305.29^305.30^305.31^305.32^305.33^305.39^305.40^760.74^760.75^V79.1
+10 ;;305.41^305.42^305.43^305.44^305.45^305.46^305.47^305.48^305.49^305.50^305.51^305.52^305.53^305.59^305.6^305.60^305.61
+11 ;;305.62^305.63^305.70^305.71^305.72^305.73^305.79^305.80^305.81^305.82^305.83^305.90^305.91^305.92^305.93^305.99
