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

ONCSCHMA.m

Go to the documentation of this file.
ONCSCHMA ;Hines OIFO/RTK - Schema derivation and related code ;04/27/18
 ;;2.2;ONCOLOGY;**10,12**;Jul 31, 2013;Build 8
 ;
DER ;Derive the correct SCHEMA ID for the abstract based on Primary Site,
 ;  Histology and possibly Schema Discriminators and Sex
 ;  AND Store the SCHEMA ID in field #165.5,#3800
 ;    TOPCOD should be set in Abstract
 N ONCHIST,ONCTPCD,ONCSDIS1,ONCSDIS2,ONCSSEX,ONCT3,HST14
 S ONCSCMA=0  ;initialize the schema first
 S ONCHIST=$$HIST^ONCFUNC(D0)
 I '$D(TOPCOD)!('$D(ONCHIST)) W !!,"  ** MISSING PRIMARY SITE AND/OR HISTOLOGY -- CANNOT DERIVE SCHEMA **",! Q
 S ONCTPCD=$P(TOPCOD,".",1)_$P(TOPCOD,".",2) ;remove the "."
 S HST14=$E(ONCHIST,1,4),HST5=$E(ONCHIST,5),ONCT3=$E(ONCTPCD,2,5)
 S ONCSDIS1=$P($G(^ONCO(165.5,D0,"SSD4")),U,21)  ; Schema Discriminator 1
 S ONCSDIS2=$P($G(^ONCO(165.5,D0,"SSD4")),U,22)  ; Schema Discriminator 2
 S ONCSDIS3=$P($G(^ONCO(165.5,D0,"SSD4")),U,23)  ; Schema Discriminator 3
 S ONCPTPR=$P($G(^ONCO(165.5,D0,0)),U,2),ONCSSEX=$P($G(^ONCO(160,ONCPTPR,0)),U,8) I $G(ONCSSEX)="" W "CHECK PATIENT'S SEX FIELD IN PATIENT FILE" H 2
 ;
 D SCMA
 I ONCSCMA=0 D ^ONCSCHMB
 I ONCSCMA=0 D ^ONCSCHMC
 I ONCSCMA=0 D ^ONCSCHMD
 I ONCSCMA=0 D ^ONCSCHME
 ;
 I ONCSCMA=0 W !!,"  ** UNABLE TO DERIVE SCHEMA **",!!
 I ONCSCMA'=0 S $P(^ONCO(165.5,D0,"SSD1"),U,1)=ONCSCMA
 ;
 K ONCPTPR Q
 ;
 ;
SCMA ; go through until hit is found, else return ONCSCMA=0
 ;
 ;ADNEXA UTERINE OTHER: C571-C574 HIST 8000-8700,8720-8790,9700,9701
 I "C571^C572^C573^C574"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00558"
 ;
 ;ADRENAL GLAND: C740,C741,C749 H8000-8671,8681-8683,8691,8720-8790,
 ;  9700,9701
 I "C740^C741^C749"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8672))!((HST14>8680)&(HST14<8684))!((HST14>8719)&(HST14<8791))!(HST14=8691)!(HST14=9700)!(HST14=9701) S ONCSCMA="00760"
 ;
 ;AMPULLA OF VATER: C241 H8000-8149,8154,8157,8160-8231,8243-8248,8250-
 ;  8682,8690-8700,8720-8790,9700,9701
 I ONCTPCD="C241" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8150))!(HST14=8154)!(HST14=8157)!((HST14>8159)&(HST14<8232))!((HST14>8242)&(HST14<8249))!((HST14>8249)&(HST14<8683))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00270"
 ;
 ;ANUS: C210-C212,C218 H8000-8700,9700,9701
 ;  or  C211-C212,C218 H8720-8790
 I "C210^C211^C212^C218"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701) S ONCSCMA="00210"
 I "C211^C212^C218"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8719)&(HST14<8791)) S ONCSCMA="00210"
 ;
 ;APPENDIX: C181 H8000-8149,8154,8157,8160-8231,8243-8248,8250-
 ;  8682,8690-8700,8720-8790,9700,9701
 I ONCTPCD="C181" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8150))!(HST14=8154)!(HST14=8157)!((HST14>8159)&(HST14<8232))!((HST14>8242)&(HST14<8249))!((HST14>8249)&(HST14<8683))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00190"
 ;
 ;BILE DUCTS DISTAL: C240 H8000-8700,8720-8790,9700,9701 DISCR1=4,7
 I ONCTPCD="C240" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) D
 ..I ((ONCSDIS1=4)!(ONCSDIS1=7)) S ONCSCMA="00260"
 ;
 ;BILE DUCTS INTRAHEPATIC: C221 H8000-8700,8720-8790,9700,9701
 I ONCTPCD="C221" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00230"
 ;
 ;BILE DUCTS PERIHILAR: C240 H8000-8700,8720-8790,9700-01 DISCR1=1,5,6,9
 I ONCTPCD="C240" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) D
 ..I ((ONCSDIS1=1)!(ONCSDIS1=5)!(ONCSDIS1=6)!(ONCSDIS1=9)) S ONCSCMA="00250"
 ;
 ;BILARY OTHER: C248-249 H8000-8700,8720-8790,9700,9701
 I "C248^C249"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00278"
 ;
 ;BLADDER: C670-679 H8000-8700,8720-8790,9700,9701
 I "C670^C671^C672^C673^C674^C675^C676^C677^C678^C679"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00620"
 ;
 ;BONE APPENDICULAR SKELETON: C400-403,408-411,413,418,419 H8000-8934,8940-9137,9141-9582,9700,9701
 I "C400^C401^C402^C403^C408^C409^C410^C411^C413^C418^C419"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8935))!((HST14>8939)&(HST14<9138))!((HST14>9140)&(HST14<9583))!(HST14=9700)!(HST14=9701) S ONCSCMA="00381"
 ;
 ;BONE PELVIS: C414 H8000-8934,8940-9137,9141-9582,9700,9701
 I ONCTPCD="C414" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8935))!((HST14>8939)&(HST14<9138))!((HST14>9140)&(HST14<9583))!(HST14=9700)!(HST14=9701) S ONCSCMA="00383"
 ;
 ;BONE SPINE: C412 H8000-8934,8940-9137,9141-9582,9700,9701
 I ONCTPCD="C412" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8935))!((HST14>8939)&(HST14<9138))!((HST14>9140)&(HST14<9583))!(HST14=9700)!(HST14=9701) S ONCSCMA="00382"
 ;
 ;BRAIN: https://staging.seer.cancer.gov/eod_public/schema/1.7/brain/?breadcrumbs=(~schema_list~)
 I "C700^C710^C711^C712^C713^C714^C715^C716^C717^C718^C719"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8802)!(HST14=8810)!(HST14=8815)!(HST14=8850)!(HST14=8890)!(HST14=8900)!(HST14=9064) S ONCSCMA="00721"
 .I (HST14=9070)!(HST14=9071)!(HST14=9080)!(HST14=9084)!(HST14=9085) S ONCSCMA="00721"
 .I ((HST14>9099)&(HST14<9106))!(HST14=9120)!(HST14=9133)!(HST14=9140)!(HST14=9180)!(HST14=9220)!(HST14=9362)!(HST14=9364) S ONCSCMA="00721"
 .I ((HST14>9379)!(HST14<9541))!(HST14=9680)!(HST14=9699)!((HST14>9699)&(HST14<9715))!((HST14>9750)&(HST14<9760)) S ONCSCMA="00721"
 .I (HST5=0)!(HST5=1) D  I ONCSCMA'=0 Q
 ..I ((HST14>8709)&(HST14<8715))!(HST14=8800)!(HST14=8801)!((HST14>8802)&(HST14<8807))!((HST14>8810)&(HST14<8815))!((HST14>8819)&(HST14<8843))!((HST14>8850)&(HST14<8882)) S ONCSCMA="00721"
 ..I ((HST14>8890)&(HST14<8899))!((HST14>8900)&(HST14<9064))!(HST14=9065)!(HST14=9072)!(HST14=9073)!((HST14>9080)&(HST14<9084))!((HST14>9085)&(HST14<9092))!(HST14=9110) S ONCSCMA="00721"
 ..I ((HST14>9120)&(HST14<9133))!((HST14>9134)&(HST14<9138))!((HST14>9140)&(HST14<9176))!((HST14>9180)&(HST14<9211))!((HST14>9220)&(HST14<9362))!(HST14=9363) S ONCSCMA="00721"
 ..I ((HST14>9364)&(HST14<9374))!((HST14>9540)&(HST14<9583))!((HST14>9589)&(HST14<9680))!((HST14>9686)&(HST14<9699))!((HST14>9715)&(HST14<9743))!((HST14>9760)&(HST14<9993)) S ONCSCMA="00721"
 ;
 ;BREAST: C500-506,508,509 H8000-8700,8982,8983,9700,9701
 ;    or  C501-506,508,509 H8720-8790
 I "C500^C501^C502^C503^C504^C505^C506^C508^C509"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=8982)!(HST14=8983)!(HST14=9700)!(HST14=9701) S ONCSCMA="00480"
 I "C501^C502^C503^C504^C505^C506^C508^C509"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8719)&(HST14<8791)) S ONCSCMA="00480"
 ;
 ;BUCCAL MUCOSA: C060,C061 H8000-8700,8982,9700,9701
 I "C060^C061"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=8982)!(HST14=9700)!(HST14=9701) S ONCSCMA="00076"
 ;
 ;CERVICAL LYMPH NODES AND UNKNOWN PRIMARY: C760 H8000-8700,8720-8790
 ;  8941,9700,9701
 I ONCTPCD="C760" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8941)!(HST14=9700)!(HST14=9701) S ONCSCMA="00060"
 ;
 ;CERVIX: C530,C531,C538,C539 H8000-8700,8720-8790,8805,8933,8980,9110
 ;  9581,9700,9701
 I "C530^C531^C538^C539"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8805)!(HST14=8933)!(HST14=8980)!(HST14=9110)!(HST14=9581)!(HST14=9700)!(HST14=9701) S ONCSCMA="00520"
 ;
 ;CNS OTHER: https://staging.seer.cancer.gov/eod_public/schema/1.7/cns_other/?breadcrumbs=(~schema_list~)
 I "C701^C709^C720^C721^C728^C729"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8802)!(HST14=8810)!(HST14=8815)!(HST14=8850)!(HST14=8890)!(HST14=8900)!(HST14=9064) S ONCSCMA="00722"
 .I (HST14=9070)!(HST14=9071)!(HST14=9080)!(HST14=9084)!(HST14=9085)!((HST14>9099)&(HST14<9106))!(HST14=9120)!(HST14=9133)!(HST14=9140)!(HST14=9180)!(HST14=9220)!(HST14=9362)!(HST14=9364)!((HST14>9379)&(HST14<9541)) S ONCSCMA="00722"
 .I (HST14=9680)!(HST14=9699)!((HST14>9699)&(HST14<9715))!((HST14>9750)&(HST14<9760)) S ONCSCMA="00722"
 .I (HST5=0)!(HST5=1) D  I ONCSCMA'=0 Q
 ..I ((HST14>8709)&(HST14<8716))!(HST14=8800)!(HST14=8801)!((HST14>8802)&(HST14<8807))!((HST14>8810)&(HST14<8815))!((HST14>8819)&(HST14<8843))!((HST14>8709)&(HST14<8716))!((HST14>8850)&(HST14<8882))!((HST14>8890)&(HST14<8899)) S ONCSCMA="00722"
 ..I ((HST14>8900)&(HST14<9064))!(HST14=9065)!(HST14=9072)!(HST14=9073)!((HST14>9080)&(HST14<9084))!((HST14>9085)&(HST14<9092))!(HST14=9110)!((HST14>9120)&(HST14<9133))!((HST14>9134)&(HST14<9138)) S ONCSCMA="00722"
 ..I ((HST14>9140)&(HST14<9176))!((HST14>9180)&(HST14<9211))!((HST14>9220)&(HST14<9362))!(HST14=9363)!((HST14>9364)&(HST14<9374))!((HST14>9540)&(HST14<9583)) S ONCSCMA="00722"
 I "C722^C724^C725"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8900)!(HST14=9064) S ONCSCMA="00722"
 .I (HST14=9070)!(HST14=9071)!(HST14=9080)!(HST14=9084)!(HST14=9085)!(HST14=9100)!(HST14=9120)!(HST14=9140)!(HST14=9220)!(HST14=9362)!((HST14>9379)&(HST14<9540)) S ONCSCMA="00722"
 .I (HST14=9680)!((HST14>9698)&(HST14<9715))!((HST14>9750)&(HST14<9760)) S ONCSCMA="00722"
 .I (HST5=0)!(HST5=1) D  I ONCSCMA'=0 Q
 ..I ((HST14>8709)&(HST14<8716))!((HST14>8799)&(HST14<8899))!((HST14>8900)&(HST14<9064))!(HST14=9065)!(HST14=9072)!(HST14=9073)!(HST14=9081)!(HST14=9082)!(HST14=9083)!((HST14>9085)&(HST14<9092))!((HST14>9100)&(HST14<9111)) S ONCSCMA="00722"
 ..I ((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9211))!((HST14>9220)&(HST14<9362))!((HST14>9362)&(HST14<9374))!((HST14>9539)&(HST14<9583)) S ONCSCMA="00722"
 I ONCTPCD="C723" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9064)!(HST14=9070)!(HST14=9080)!(HST14=9084)!(HST14=9085)!(HST14=9100)!(HST14=9140)!(HST14=9180)!(HST14=9362)!((HST14>9379)&(HST14<9421)) S ONCSCMA="00722"
 .I ((HST14>9422)&(HST14<9473))!((HST14>9473)&(HST14<9494))!((HST14>9499)&(HST14<9522))!(HST14=9523)!((HST14>9530)&(HST14<9540))!(HST14=9680)!((HST14>9698)&(HST14<9715))!((HST14>9750)&(HST14<9760)) S ONCSCMA="00722"
 .I (HST5=0)!(HST5=1) D  I ONCSCMA'=0 Q
 ..I ((HST14>8709)&(HST14<8716))!((HST14>8799)&(HST14<9064))!(HST14=9065)!(HST14=9071)!(HST14=9072)!(HST14=9073)!(HST14=9081)!(HST14=9082)!(HST14=9083)!((HST14>9085)&(HST14<9092))!((HST14>9100)&(HST14<9138)) S ONCSCMA="00722"
 ..I ((HST14>9140)&(HST14<9176))!((HST14>9180)&(HST14<9362))!((HST14>9362)&(HST14<9374))!(HST14=9421)!(HST14=9473)!(HST14=9500)!(HST14=9522)!(HST14=9530)!((HST14>9539)&(HST14<9583)) S ONCSCMA="00722"
 I "C701^C709^C720^C721^C722^C723^C724^C725^C726^C727^C728^C729"[ONCTPCD D  I ONCSCMA'=0 Q
 .I (HST5=0)!(HST5=1) D  I ONCSCMA'=0 Q
 ..I ((HST14>9589)&(HST14<9680))!((HST14>9686)&(HST14<9699))!((HST14>9715)&(HST14<9743))!((HST14>9760)&(HST14<9993)) S ONCSCMA="00722"
 ;
 ;COLON AND RECTUM: C180,C182-189,C199,C209 H8000-8149,8154,8157,8160-
 ;  8231,8243-8248,8250-8682,8690-8700,8720-8790,9700,9701
 I "C180^C182^C183^C184^C185^C186^C187^C188^C189^C199^C209"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8150))!(HST14=8154)!(HST14=8157)!((HST14>8159)&(HST14<8232))!((HST14>8242)&(HST14<8249))!((HST14>8249)&(HST14<8683))!((HST14>8689)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00200"
 ;
 ;CONJUNCTIVA: C690 H8000-8700,9700,9701
 I ONCTPCD="C690" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701) S ONCSCMA="00650"
 ;
 ;CORPUS ADENOSARCOMA: C540-543,C548-549,C559 H8933
 I "C540^C541^C542^C543^C548^C549^C559"[ONCTPCD D  I ONCSCMA'=0 Q
 .I HST14=8933 S ONCSCMA="00542"
 ;
 ;CORPUS CARCINOMA & CARCINOSARCOMA: C540-543,C548-549,C559 H8000-8700,
 ;  8720-8790,8950,8980,9700,9701
 I "C540^C541^C542^C543^C548^C549^C559"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8950)!(HST14=8980)!(HST14=9700)!(HST14=9701) S ONCSCMA="00530"
 ;
 ;CORPUS SARCOMA: C540-543,C548-549,C559 H8710-8714,8800-8932,8934-8941,8951-8975,8981-9137,9141-9582
 I "C540^C541^C542^C543^C548^C549^C559"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8933))!((HST14>8933)&(HST14<8942))!((HST14>8950)&(HST14<8976))!((HST14>8980)&(HST14<9138))!((HST14>9140)&(HST14<9583)) S ONCSCMA="00541"
 ;
 ;CUTANEOUS SQUAMOUS CELL CARCINOMA OF HEAD & NECK: C000-002,C006,
 ;  C440,C442-444 H8000-8040,8042-8180,8191-8246,8248-8700,8940,8982
 I "C000^C001^C002^C006^C440^C442^C443^C444"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8041))!((HST14>8041)&(HST14<8181))!((HST14>8190)&(HST14<8247))!((HST14>8247)&(HST14<8701))!(HST14=8940)!(HST14=8982) S ONCSCMA="00150"
 ;
 ;CYSTIC DUCT: C240 H8000-8700,8720-8790,9700,9701 DISCR=3
 I ONCTPCD="C240" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) D
 ..I ONCSDIS1=3 S ONCSCMA="00242"
 ;
 ;DIGESTIVE OTHER: C260,C268-269 H8000-8700,8720-8790,9700,9701
 I "C260^C268^C269^"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00288"
 ;
 ;ENDOCRINE OTHER: C754,C758-759 H8000-8700,8720-8790,9700,9701
 ;    or  C755 H8000-8671,8681-8683,8691,8720-8790,9700,9701
 I "C754^C758^C759"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00778"
 I ONCTPCD="C755" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8672))!((HST14>8680)&(HST14<8684))!(HST14=8691)!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00778"
 ;
 ;ESOPHAGUS (INCLUDING GE JUNCTION)(EXCLUDING SQUAMOUS)(ADENOCARCINOMA):
 ;     C150-155,C158-159 H8000-8015,8021-8046,8060,8071-8073,8075-8076,
 ;        8078-8082,8084-8552,8561-8700,8720-8790,9700,9701
 ; or  C160 H8000-8015,8021-8046,8060,8071-8073,8075-8076,
 ;        8078-8082,8084-8149,8154,8157,8160-8231,8243-8248,8250-8552,
 ;        8561-8682,8690-8700,8720-8790,9700,9701 DISCR1=2
 ; or  C150-155,C158-159 H8020 DISCR2=2
 ; or  C160 H8020 DISCR1=2 AND DISCR2=2
 I "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8016))!((HST14>8020)&(HST14<8047))!(HST14=8060)!((HST14>8070)&(HST14<8074))!((HST14>8074)&(HST14<8077)) S ONCSCMA="00169"
 .I ((HST14>8077)&(HST14<8083))!((HST14>8083)&(HST14<8553))!((HST14>8560)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00169"
 I ONCTPCD="C160" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8016))!((HST14>8020)&(HST14<8047))!(HST14=8060)!((HST14>8070)&(HST14<8074))!((HST14>8074)&(HST14<8077)) D
 ..I ONCSDIS1=2 S ONCSCMA="00169"
 .I ((HST14>8077)&(HST14<8083))!((HST14>8083)&(HST14<8150))!(HST14=8154)!(HST14=8157)!((HST14>8159)&(HST14<8232))!((HST14>8242)&(HST14<8249)) D
 ..I ONCSDIS1=2 S ONCSCMA="00169"
 .I ((HST14>8249)&(HST14<8553))!((HST14>8560)&(HST14<8683))!((HST14>8689)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) D
 ..I ONCSDIS1=2 S ONCSCMA="00169"
 I "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD D  I ONCSCMA'=0 Q
 .I (HST14=8020)&(ONCSDIS2=2) S ONCSCMA="00169"
 I ONCTPCD="C160" D  I ONCSCMA'=0 Q
 .I (HST14=8020)&((ONCSDIS1=2)&(ONCSDIS2=2)) S ONCSCMA="00169"
 ;
 ;ESOPHAGUS (INCLUDING GE JUNCTION)(SQUAMOUS):
 ;     C150-155,C158-159 H8050-8054,8070,8074,8077,8083,8560
 ; or  C160 H8050-8054,8070,8074,8077,8083,8560 DISCR1=2
 ; or  C150-155,C158-159 H8020 DISCR2=1,9
 ; or  C160 H8020 DISCR1=2 AND DISCR2=1,9
 I "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8049)&(HST14<8055))!(HST14=8070)!(HST14=8074)!(HST14=8077)!(HST14=8083)!(HST14=8560) S ONCSCMA="00161"
 I ONCTPCD="C160" D  I ONCSCMA'=0 Q
 .I ((HST14>8049)&(HST14<8055))!(HST14=8070)!(HST14=8074)!(HST14=8077)!(HST14=8083)!(HST14=8560) D
 ..I ONCSDIS1=2 S ONCSCMA="00161"
 I "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD D  I ONCSCMA'=0 Q
 .I (HST14=8020)&((ONCSDIS2=1)!(ONCSDIS2=9)) S ONCSCMA="00161"
 I ONCTPCD="C160" D  I ONCSCMA'=0 Q
 .I (HST14=8020)&(ONCSDIS1=2)&((ONCSDIS2=1)!(ONCSDIS2=9)) S ONCSCMA="00161"
 Q