- 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 Mar 13, 2025@21:29:05 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
