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

ONCSCHMD.m

Go to the documentation of this file.
ONCSCHMD ;Hines OIFO/RTK - Schema derivation, related code continued ;04/27/18
 ;;2.2;ONCOLOGY;**10,12**;Jul 31, 2013;Build 8
 ;
 ; go through until hit is found, else return ONCSCMA=0
 ;
 ;PLASMA CELL DISORDERS: https://staging.seer.cancer.gov/eod_public/schema/1.7/plasma_cell_disorders/?breadcrumbs=(~schema_list~)
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<441))!((ONCT3>441)&(ONCT3<690))!((ONCT3>690)&(ONCT3<695))!(ONCT3=698)!(ONCT3=699)!((ONCT3>738)&(ONCT3<751))!((ONCT3>753)&(ONCT3<810)) D  I ONCSCMA'=0 Q
 .I (HST14=9671)!(HST14=9734) S ONCSCMA="00822"
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<700))!((ONCT3>738)&(ONCT3<751))!((ONCT3>753)&(ONCT3<810)) D  I ONCSCMA'=0 Q
 .I (HST14=9731)!(HST14=9761) S ONCSCMA="00822"
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<730))!((ONCT3>750)&(ONCT3<754)) D  I ONCSCMA'=0 Q
 .I (ONCHIST=96713)!(ONCHIST=97313)!(ONCHIST=97343)!(ONCHIST=97613) S ONCSCMA="00822"
 ;
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<810)) D  I ONCSCMA'=0 Q
 .I (HST14=9731)!(HST14=9761) S ONCSCMA="00822"
 ;
 ;PLASMA CELL MYELOMA: C000-C809 H9732
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<810)) D  I ONCSCMA'=0 Q
 .I HST14=9732 S ONCSCMA="00821"
 ;
 ;PLEURAL MESOTHELIOMA: C340-C349,C384 H9050-9053
 I "C340^C341^C342^C343^C344^C345^C346^C347^C348^C349^C384"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>9049)&(HST14<9054)) S ONCSCMA="00370"
 ;
 ;PRIMARY CUTANEOUS LYMPHOMA (EXCLUDING MF & SS): C440,C442-C449,C510
 ;    C609,C632 H9597,9680,9708-9709,9712,9718-9719,9726
 I "C440^C442^C443^C444^C445^C446^C447^C448^C449^C510^C609^C632"[ONCTPCD D  I ONCSCMA'=0 Q
 .I (HST14=9597)!(HST14=9680)!(HST14=9708)!(HST14=9709)!(HST14=9712)!(HST14=9718)!(HST14=9719)!(HST14=9726) S ONCSCMA="00812"
 ;
 ;PRIMARY PERITONEAL CARCINOMA: C481,C482,C488 H8000-8700,8720-8790,8806
 ;    8822,8930-8931,8933,8950,8960,8980,9000,9050,9052,9060,9070-9071
 ;    9073,9080,9085,9090-9091,9100,9110,9700-9701
 I "C481^C482^C488"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8806)!(HST14=8822)!(HST14=8930)!(HST14=8931)!(HST14=8933)!(HST14=8950)!(HST14=8960)!(HST14=8980) D
 ..I (ONCSSEX=2)!(ONCSSEX=6) S ONCSCMA="00552"
 .I (HST14=9000)!(HST14=9050)!(HST14=9052)!(HST14=9060)!(HST14=9070)!(HST14=9071)!(HST14=9073)!(HST14=9080)!(HST14=9085) D
 ..I (ONCSSEX=2)!(ONCSSEX=6) S ONCSCMA="00552"
 .I (HST14=9090)!(HST14=9091)!(HST14=9100)!(HST14=9110)!(HST14=9700)!(HST14=9701) D
 ..I (ONCSSEX=2)!(ONCSSEX=6) S ONCSCMA="00552"
 ;
 ;PROSTATE: C619 H8000-8700,8720-8790,9700,9701
 I ONCTPCD="C619" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00580"
 ;
 ;RESPIRATORY OTHER: C390,C398-C399 H8000-8700,8720-8790,9700,9701
 I "C390^C398^C399"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00378"
 ;
 ;RETINOBLASTOMA: C690-C696,C698-C699 H9510-9514
 I "C690^C691^C692^C693^C694^C695^C696^C698^C699"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>9509)&(HST14<9515)) S ONCSCMA="00680"
 ;
 ;RETROPERITONEUM: C480 H8000-8803,8810-8921,8932-8934,8940-8990,9000-
 ;    9016,9030-9043,9045-9137,9141-9230,9240-9580,9582,9700-9701
 ;  or  C481,C482,C488 H8000-8700,8720-8790,8822,8933,8950,8960,8980,9000
 ;    9050,9052,9060,9070-9071,9073,9080,9085,9090-9091,9100,9110,9700-
 ;    9701 SEX=1,3,4,5,9
 ;  or  C481,C482,C488 H8710-8714,8800-8803,8810-8821,8823-8921,8932,8934
 ;    8940-8941,8951-8959,8963-8975,8981-8990,9010-9016,9030-9043,9045,
 ;    9051,9053-9055,9061-9065,9072,9081-9084,9086,9101-9105,9120-9137,
 ;    9141-9230,9240-9580,9582
 I ONCTPCD="C480" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8804))!((HST14>8809)&(HST14<8922))!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8991))!((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044)) S ONCSCMA="00440"
 .I ((HST14>9044)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582)!(HST14=9700)!(HST14=9701) S ONCSCMA="00440"
 I "C481^C482^C488"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8822)!(HST14=8933)!(HST14=8950)!(HST14=8960)!(HST14=8980)!(HST14=9000)!(HST14=9050)!(HST14=9052)!(HST14=9060) D
 ..I (ONCSSEX=1)!(ONCSSEX=3)!(ONCSSEX=4)!(ONCSSEX=5)!(ONCSSEX=9) S ONCSCMA="00440"
 .I (HST14=9070)!(HST14=9071)!(HST14=9073)!(HST14=9080)!(HST14=9085)!(HST14=9090)!(HST14=9091)!(HST14=9100)!(HST14=9110)!(HST14=9700)!(HST14=9701) D
 ..I (ONCSSEX=1)!(ONCSSEX=3)!(ONCSSEX=4)!(ONCSSEX=5)!(ONCSSEX=9) S ONCSCMA="00440"
 I "C481^C482^C488"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8822))!((HST14>8822)&(HST14<8922))!(HST14=8932)!(HST14=8934)!(HST14=8940)!(HST14=8941) S ONCSCMA="00440"
 .I ((HST14>8950)&(HST14<8960))!((HST14>8962)&(HST14<8976))!((HST14>8980)&(HST14<8991))!((HST14>9009)&(HST14<9017))!((HST14>9029)&(HST14<9044))!(HST14=9045)!(HST14=9051) S ONCSCMA="00440"
 .I ((HST14>9052)&(HST14<9056))!((HST14>9060)&(HST14<9066))!(HST14=9072)!((HST14>9080)&(HST14<9085))!(HST14=9086)!((HST14>9100)&(HST14<9106))!((HST14>9119)&(HST14<9138)) S ONCSCMA="00440"
 .I ((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582) S ONCSCMA="00440"
 ;
 ;SINUS OTHER: C312-C313,C318-C319 H8000-8700,9700,9701
 I "C312^C313^C318^C319"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701) S ONCSCMA="00128"
 ;
 ;SKIN EYELID: C441 H8000-8040,8042-8180,8191-8246,8248-8700,8940-8941,8980
 I ONCTPCD="C441" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8041))!((HST14>8041)&(HST14<8181))!((HST14>8190)&(HST14<8247))!((HST14>8247)&(HST14<8701))!((HST14>8939)&(HST14<8942))!(HST14=8980) S ONCSCMA="00640"
 ;
 ;SKIN OTHER: C445-449 H8000-8040,8042-8180,8191-8246,8248-8700,8940,8980
 I "C445^C446^C447^C448^C449"[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=8980) S ONCSCMA="00478"
 ;
 ;SMALL INTESTINE: C170-C173,C178-C179 H8000-8149,8154,8157,8160-8231
 ;   8243-8248,8250-8682,8690-8700,8720-8790,9700,9701
 I "C170^C171^C172^C173^C178^C179"[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="00180"
 ;
 ;SOFT TISSUE HEAD AND NECK: C000-C002,C006 H8710-8714,8800-8803,8810-
 ;    8905,8912,8921,8932-8934,8941-8981,8983-8990,9000-9016,9030-9043,
 ;    9045-9110,9121-9137,9141-9230,9240-9580,9582
 ;  or C003-C005,C008-C009,C020-C023,C028-C050,C058-C069 H8710-8714,8800-
 ;    8803,8810-8905,8912,8921,8932-8934,8940-8981,8983-8990,9000-9016,
 ;    9030-9043,9045-9110,9121-9137,9141-9230,9240-9580,9582
 ;  or C019,C024,C051-C052,C090-C148,C150,C153,C158,C301,C312-C329,C739,
 ;    C750,C754-C759 H8710-8714,8800-8803,8810-8905,8912,8921,8932-8934,
 ;    8940-8990,9000-9016,9030-9043,9045-9110,9121-9137,9141-9230,
 ;    9240-9580,9582
 ;  or C079-C089 H8710-8714,8800-8803,8810-8905,8912,8921,8932-8934,8940,
 ;    8950-8973,8975,8981,8983-8990,9000-9016,9030-9043,9045-9110,9121-
 ;    9137,9141-9230,9240-9580,9582
 ;  or C300,C310-C311 H8710-8714,8800-8803,8810-8905,8912,8921,8932-8934,
 ;    8940,8950-8981,8983-8990,9000-9016,9030-9043,9045-9110,9121-9137,
 ;    9141-9230,9240-9580,9582
 ;  or C470,C490 H8000-8803,8810-8905,8912,8921,8932-8934,8940-8990,9000-
 ;    9016,9030-9043,9045-9110,9121-9137,9141-9230,9240-9580,9582,
 ;    9700-9701
 ;  or C722,C724-C725,C751-C753 H8710-8714,8800-8803,8810-8898,8901-8905
 ;    8912,8921,8932-8934,8940-8990,9000-9016,9030-9043,9045-9063,9065,
 ;    9072-9073,9081-9083,9086-9091,9101-9110,9121-9137,9141-9210,9221-
 ;    9230,9240-9361,9363-9381,9383-9384,9410,9412-9423,9431-9432,9444,
 ;    9460,9472,9480,9491-9493,9502-9504,9506-9507,9509-9523,9531-9537,
 ;    9539-9580,9582
 ;  or C723 H9510-9514
 ;
 I "C000^C001^C002^C006"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!((HST14>8940)&(HST14<8982))!((HST14>8982)&(HST14<8991)) S ONCSCMA="00400"
 .I ((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9111))!((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582) S ONCSCMA="00400"
 I (ONCT3="003")!(ONCT3="004")!(ONCT3="005")!(ONCT3="008")!(ONCT3="009")!((ONCT3>19)&(ONCT3<24))!((ONCT3>27)&(ONCT3<51))!((ONCT3>57)&(ONCT3<70)) D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8982))!((HST14>8982)&(HST14<8991)) S ONCSCMA="00400"
 .I ((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9111))!((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582) S ONCSCMA="00400"
 I (ONCT3="019")!(ONCT3="024")!(ONCT3="051")!(ONCT3="052")!((ONCT3>89)&(ONCT3<149))!(ONCT3=150)!(ONCT3=153)!(ONCT3=158)!(ONCT3=301)!((ONCT3>311)&(ONCT3<330))!(ONCT3=739)!(ONCT3=750)!((ONCT3>753)&(ONCT3<760)) D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8991)) S ONCSCMA="00400"
 .I ((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9111))!((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582) S ONCSCMA="00400"
 I ((ONCT3>78)&(ONCT3<90)) D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!(HST14=8940)!((HST14>8949)&(HST14<8974))!(HST14=8975)!(HST14=8981) S ONCSCMA="00400"
 .I ((HST14>8982)&(HST14<8991))!((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9111))!((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582) S ONCSCMA="00400"
 I "C300^C310^C311"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!(HST14=8940)!((HST14>8949)&(HST14<8982))!((HST14>8982)&(HST14<8991)) S ONCSCMA="00400"
 .I ((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9111))!((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582) S ONCSCMA="00400"
 I "C470^C490"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8804))!((HST14>8809)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8991)) S ONCSCMA="00400"
 .I ((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9111))!((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582)!(HST14=9700)!(HST14=9701) S ONCSCMA="00400"
 I "C722^C724^C725^C751^C753^"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>8709)&(HST14<8715))!((HST14>8799)&(HST14<8804))!((HST14>8809)&(HST14<8899))!((HST14>8900)&(HST14<8906))!(HST14=8912)!(HST14=8921)!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8991)) S ONCSCMA="00400"
 .I ((HST14>8999)&(HST14<9017))!((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9064))!(HST14=9065)!(HST14=9072)!(HST14=9073)!((HST14>9080)&(HST14<9084))!((HST14>9085)&(HST14<9092))!((HST14>9100)&(HST14<9111)) S ONCSCMA="00400"
 .I ((HST14>9120)&(HST14<9138))!((HST14>9140)&(HST14<9211))!((HST14>9220)&(HST14<9231))!((HST14>9239)&(HST14<9362))!((HST14>9362)&(HST14<9382))!((HST14>9382)&(HST14<9385))!(HST14=9410) S ONCSCMA="00400"
 .I ((HST14>9411)&(HST14<9424))!((HST14>9430)&(HST14<9433))!(HST14=9444)!(HST14=9460)!(HST14=9472)!(HST14=9480)!((HST14>9490)&(HST14<9494))!((HST14>9501)&(HST14<9505))!(HST14=9506)!(HST14=9507) S ONCSCMA="00400"
 .I ((HST14>9508)&(HST14<9524))!((HST14>9530)&(HST14<9538))!((HST14>9538)&(HST14<9581))!(HST14=9582) S ONCSCMA="00400"
 I ONCTPCD="C723" D  I ONCSCMA'=0 Q
 .I ((HST14>9509)&(HST14<9515)) S ONCSCMA="00400"
 ;
 D ^ONCSCHME I ONCSCMA'=0 Q  ;SOFT TISSUE CONTINUED
 ;
 ;STOMACH: C160 H8000-8149,8154,8157,8160-8231,8243-8248,
 ;    8250-8682,8690-8700,8720-8790,9700-9701 DISCR1=0,3,9
 ;  or  C161-166,C168-169 H8000-8149,8154,8157,8160-8231,8243-8248,
 ;    8250-8682,8690-8700,8720-8790,9700-9701
 I ONCTPCD="C160" 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) D
 ..I (ONCSDIS1=0)!(ONCSDIS1=3)!(ONCSDIS1=9) S ONCSCMA="00170"
 I "C161^C162^C163^C164^C165^C166^C168^C169"[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="00170"
 ;
 ;TESTIS: C620-C621,C629 H8000-8700,8720-8790,9061,9064-9065,9070-9071,
 ;    9080-9081,9084-9085,9100-9101,9104-9105,9700-9701
 I "C620^C621^C629"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9061)!((HST14>9063)&(HST14<9066))!((HST14>9069)&(HST14<9072)) S ONCSCMA="00590"
 .I (HST14=9080)!(HST14=9081)!(HST14=9084)!(HST14=9085)!(HST14=9100)!(HST14=9101)!(HST14=9104)!(HST14=9105)!(HST14=9700)!(HST14=9701) S ONCSCMA="00590"
 ;
 ;THYMUS: C379 H8000-8700,8720-8790,9700,9701
 I ONCTPCD="C379" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00350"
 ;
 ;THYROID: C739 H8000-8344,8350-8420,8440-8509,8514-8700,8720-8790,
 ;    9700-9701
 I ONCTPCD="C739" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8345))!((HST14>8349)&(HST14<8421))!((HST14>8439)&(HST14<8510))!((HST14>8513)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00730"
 ;
 ;THYROID MEDULLARY: C739 H8345-8347,8430,8510,8512-8513
 I ONCTPCD="C739" D  I ONCSCMA'=0 Q
 .I ((HST14>8344)&(HST14<8348))!(HST14=8430)!(HST14=8510)!(HST14=8512)!(HST14=8513) S ONCSCMA="00740"
 ;
 ;TONGUE ANTERIOR: C020-C023,C028-C029 H8000-8700,8982,9700,9701
 I "C020^C021^C022^C023^C028^C029"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=8982)!(HST14=9700)!(HST14=9701) S ONCSCMA="00072"
 ;
 ;TRACHEA: C339 H8000-8700,8720-8790,9700,9701
 I ONCTPCD="C339" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00358"
 ;
 ;URETHRA: C680 H8000-8700,8720-8790,9700,9701 DISCR1=1
 I ONCTPCD="C680" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) D
 ..I ONCSDIS1=1 S ONCSCMA="00631"
 ;
 ;URETHRA-PROSTATIC: C680 H8000-8700,8720-8790,9700,9701 DISCR1=1
 I ONCTPCD="C680" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) D
 ..I ONCSDIS1=2 S ONCSCMA="00633"
 ;
 ;URINARY OTHER: C681,C688-C689 H8000-8700,8720-8790,9700,9701
 I "C681^C688^C689"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMA="00638"
 ;
 ;VAGINA: C529 H8000-8700,8720-8790,8933,8980,9071,9110,9700,9701
 I ONCTPCD="C529" D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=8933)!(HST14=8980)!(HST14=9071)!(HST14=9110)!(HST14=9700)!(HST14=9701) S ONCSCMA="00510"
 ;
 ;VULVA: C510,C511,C512,C518,C519 H8000-8040,8042-8180,8191-8246,
 ;    8248-8700,9020,9071
 I "C510^C511^C512^C518^C519"[ONCTPCD D  I ONCSCMA'=0 Q
 .I ((HST14>7999)&(HST14<8041))!((HST14>8041)&(HST14<8181))!((HST14>8190)&(HST14<8247))!((HST14>8247)&(HST14<8701))!(HST14=9020)!(HST14=9071) S ONCSCMA="00500"
 ;
 Q