ONCSCHMS ;HINES OIFO/RTK - Derive schema discriminator ;08/27/18
 ;;2.2;ONCOLOGY;**10,13**;Jul 31, 2013;Build 7
 ;
 ;
DER ;Derive the correct schema discriminator codes for the abstract based
 ; on Primary Site and Histology
 ; NOTE: need the schema discriminators (if any) before call to ONCSCHMA
 ;       to calculate the schema ID (field 3800)
 ;   TOPCOD should be set in Abstract
 N ONCHIST,ONCTPCD,ONCSDIS1,ONCSDIS2,ONCT3,HST14
 N ONCPTPR 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 FILE" H 2
 K ONC3927,ONCONLY2  ;used to prompt for or skip field #3926,3927
 S ONCSCMDS=0  ;initialize the schema first
 ;
 S ONCHIST=$$HIST^ONCFUNC(D0)
 I '$D(TOPCOD)!('$D(ONCHIST)) W !!,"  ** MISSING PRIMARY SITE AND/OR HISTOLOGY -- CANNOT DERIVE DISCRIMINATORS **",! Q
 S ONCTPCD=$P(TOPCOD,".",1)_$P(TOPCOD,".",2) ;remove the "."
 S HST14=$E(ONCHIST,1,4),ONCT3=$E(ONCTPCD,2,5)
 ;
 ;Nasopharynx/Oropharynx
 I "C019^C024^C051^C052^C090^C091^C098^C099^C100^C102^C103^C104^C108^C109"[ONCTPCD D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701) S ONCSCMDS="00100",ONC3927=1
 I ONCTPCD="C111" D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701) S ONCSCMDS="00100",ONC3927=1
 ;
 ;Esophagus
 I ONCTPCD="C160" D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8016))!((HST14>8020)&(HST14<8047))!(HST14=8060)!((HST14>8070)&(HST14<8074))!((HST14>8074)&(HST14<8077)) S ONCSCMDS="00161"  ;,ONC3927=1
 .I ((HST14>8077)&(HST14<8083))!((HST14>8083)&(HST14<8150))!(HST14=8154)!(HST14=8157)!((HST14>8159)&(HST14<8232))!((HST14>8242)&(HST14<8249)) S ONCSCMDS="00161"  ;,ONC3927=1
 .I ((HST14>8249)&(HST14<8553))!((HST14>8560)&(HST14<8683))!((HST14>8689)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMDS="00161"  ;,ONC3927=1
 I "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD D  I ONCSCMDS'=0 Q
 .I (HST14=8020) S ONCSCMDS="00161",ONC3927=1
 I ONCTPCD="C160" D  I ONCSCMDS'=0 Q
 .I (HST14=8020) S ONCSCMDS="00161",ONC3927=1
 I ONCTPCD="C160" D  I ONCSCMDS'=0 Q
 .I ((HST14>8049)&(HST14<8055))!(HST14=8070)!(HST14=8074)!(HST14=8077)!(HST14=8083)!(HST14=8560) S ONCSCMDS="00161"  ;,ONC3927=1
 I "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD D  I ONCSCMDS'=0 Q
 .I (HST14=8020) S ONCSCMDS="00161",ONC3927=1
 I ONCTPCD="C160" D  I ONCSCMDS'=0 Q
 .I (HST14=8020) S ONCSCMDS="00161",ONC3927=1
 ;
 I ONCTPCD="C160" D  I ONCSCMDS'=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 ONCSCMDS="00170"
 ;
 ;Bile Ducts Distal/Bile Ducts Perihilar/Cystic Duct
 I ONCTPCD="C240" D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMDS="00250"
 ;
 ;GIST (Primary Peritoneum)
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<540))!((ONCT3>570)&(ONCT3<810)) D  I ONCSCMDS'=0 Q
 .I (HST14=8935)!(HST14=8936) S ONCSCMDS="00430"
 ;
 ;Cervical LN and Unknown Primary (Occult Head & Neck)
 I ONCTPCD="C760" D  I ONCSCMDS'=0 Q
 .I (HST14=8941) S ONCSCMDS="00450"
 I "C473^C475^C493^C494^C495"[ONCTPCD D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8804))!((HST14>8809)&(HST14<8922))!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8991))!((HST14>8999)&(HST14<9017)) S ONCSCMDS="00450",ONCONLY2=1,ONC3927=1 Q
 .I ((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9139))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582)!(HST14=9700)!(HST14=9701) S ONCSCMDS="00450",ONCONLY2=1,ONC3927=1 Q
 ;
 ;Urethra
 I ONCTPCD="C680" D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMDS="00631"
 ;
 ;Melanoma Ciliary Body/Iris
 I ONCTPCD="C694" D  I ONCSCMDS'=0 Q
 .I ((HST14>8719)&(HST14<8791)) S ONCSCMDS="00672"
 ;
 ;Lacrimal Gland/Sac
 I ONCTPCD="C695" D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8701))!(HST14=8941)!(HST14=8980)!(HST14=8982)!(HST14=9700)!(HST14=9701) S ONCSCMDS="00690"
 ;
 ;Thyroid (including Medullary)
 I ONCTPCD="C739" D  I ONCSCMDS'=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 ONCSCMDS="00730"
 ;
 I ONCTPCD="C739" D  I ONCSCMDS'=0 Q
 .I ((HST14>8344)&(HST14<8348))!(HST14=8430)!(HST14=8510)!(HST14=8512)!(HST14=8513) S ONCSCMDS="00730"
 ;
 ;Lymphoma
 I (ONCTPCD="C000")!((ONCT3>0)&(ONCT3<441))!((ONCT3>441)&(ONCT3<690))!((ONCT3>690)&(ONCT3<695))!(ONCT3=689)!(ONCT3=699)!((ONCT3>738)&(ONCT3<751))!((ONCT3>753)&(ONCT3<810)) D  I ONCSCMDS'=0
 .I (HST14=9591) S ONCSCMDS="00790"
 I ((ONCT3>699)&(ONCT3<730))!((ONCT3>750)&(ONCT3<754)) D  I ONCSCMDS'=0
 .I (ONCHIST=95913) S ONCSCMDS="00790"
 ;
 ;Plasma Cell Myeloma
 I (ONCT3="000")!((ONCT3>0)&(ONCT3<810)) D  I ONCSCMDS'=0 Q
 .I HST14=9732 S ONCSCMDS="00821"
 ;
 ;Ill-Defined/Other (Occult)
 I ONCTPCD="C760" D  I ONCSCMDS'=0 Q
 .I ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701) S ONCSCMDS="99999"
 ;
 I ONCSCMDS=0 S Y="@006"
 ;
 I ONCSCMDS'=0 Q  ;S $P(^ONCO(165.5,D0,"SSD1"),U,1)=ONCSCMDS
 ;
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCSCHMS   5322     printed  Sep 23, 2025@20:04:12                                                                                                                                                                                                    Page 2
ONCSCHMS  ;HINES OIFO/RTK - Derive schema discriminator ;08/27/18
 +1       ;;2.2;ONCOLOGY;**10,13**;Jul 31, 2013;Build 7
 +2       ;
 +3       ;
DER       ;Derive the correct schema discriminator codes for the abstract based
 +1       ; on Primary Site and Histology
 +2       ; NOTE: need the schema discriminators (if any) before call to ONCSCHMA
 +3       ;       to calculate the schema ID (field 3800)
 +4       ;   TOPCOD should be set in Abstract
 +5        NEW ONCHIST,ONCTPCD,ONCSDIS1,ONCSDIS2,ONCT3,HST14
 +6        NEW ONCPTPR
           SET ONCPTPR=$PIECE($GET(^ONCO(165.5,D0,0)),U,2)
           SET ONCSSEX=$PIECE($GET(^ONCO(160,ONCPTPR,0)),U,8)
           IF $GET(ONCSSEX)=""
               WRITE "CHECK PATIENT FILE"
               HANG 2
 +7       ;used to prompt for or skip field #3926,3927
           KILL ONC3927,ONCONLY2
 +8       ;initialize the schema first
           SET ONCSCMDS=0
 +9       ;
 +10       SET ONCHIST=$$HIST^ONCFUNC(D0)
 +11       IF '$DATA(TOPCOD)!('$DATA(ONCHIST))
               WRITE !!,"  ** MISSING PRIMARY SITE AND/OR HISTOLOGY -- CANNOT DERIVE DISCRIMINATORS **",!
               QUIT 
 +12      ;remove the "."
           SET ONCTPCD=$PIECE(TOPCOD,".",1)_$PIECE(TOPCOD,".",2)
 +13       SET HST14=$EXTRACT(ONCHIST,1,4)
           SET ONCT3=$EXTRACT(ONCTPCD,2,5)
 +14      ;
 +15      ;Nasopharynx/Oropharynx
 +16       IF "C019^C024^C051^C052^C090^C091^C098^C099^C100^C102^C103^C104^C108^C109"[ONCTPCD
               Begin DoDot:1
 +17               IF ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00100"
                       SET ONC3927=1
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +18       IF ONCTPCD="C111"
               Begin DoDot:1
 +19               IF ((HST14>7999)&(HST14<8701))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00100"
                       SET ONC3927=1
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +20      ;
 +21      ;Esophagus
 +22       IF ONCTPCD="C160"
               Begin DoDot:1
 +23      ;,ONC3927=1
                   IF ((HST14>7999)&(HST14<8016))!((HST14>8020)&(HST14<8047))!(HST14=8060)!((HST14>8070)&(HST14<8074))!((HST14>8074)&(HST14<8077))
                       SET ONCSCMDS="00161"
 +24      ;,ONC3927=1
                   IF ((HST14>8077)&(HST14<8083))!((HST14>8083)&(HST14<8150))!(HST14=8154)!(HST14=8157)!((HST14>8159)&(HST14<8232))!((HST14>8242)&(HST14<8249))
                       SET ONCSCMDS="00161"
 +25      ;,ONC3927=1
                   IF ((HST14>8249)&(HST14<8553))!((HST14>8560)&(HST14<8683))!((HST14>8689)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00161"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +26       IF "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD
               Begin DoDot:1
 +27               IF (HST14=8020)
                       SET ONCSCMDS="00161"
                       SET ONC3927=1
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +28       IF ONCTPCD="C160"
               Begin DoDot:1
 +29               IF (HST14=8020)
                       SET ONCSCMDS="00161"
                       SET ONC3927=1
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +30       IF ONCTPCD="C160"
               Begin DoDot:1
 +31      ;,ONC3927=1
                   IF ((HST14>8049)&(HST14<8055))!(HST14=8070)!(HST14=8074)!(HST14=8077)!(HST14=8083)!(HST14=8560)
                       SET ONCSCMDS="00161"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +32       IF "C150^C151^C152^C153^C154^C155^C158^C159"[ONCTPCD
               Begin DoDot:1
 +33               IF (HST14=8020)
                       SET ONCSCMDS="00161"
                       SET ONC3927=1
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +34       IF ONCTPCD="C160"
               Begin DoDot:1
 +35               IF (HST14=8020)
                       SET ONCSCMDS="00161"
                       SET ONC3927=1
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +36      ;
 +37       IF ONCTPCD="C160"
               Begin DoDot:1
 +38               IF ((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)
                       SET ONCSCMDS="00170"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +39      ;
 +40      ;Bile Ducts Distal/Bile Ducts Perihilar/Cystic Duct
 +41       IF ONCTPCD="C240"
               Begin DoDot:1
 +42               IF ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00250"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +43      ;
 +44      ;GIST (Primary Peritoneum)
 +45       IF (ONCT3="000")!((ONCT3>0)&(ONCT3<540))!((ONCT3>570)&(ONCT3<810))
               Begin DoDot:1
 +46               IF (HST14=8935)!(HST14=8936)
                       SET ONCSCMDS="00430"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +47      ;
 +48      ;Cervical LN and Unknown Primary (Occult Head & Neck)
 +49       IF ONCTPCD="C760"
               Begin DoDot:1
 +50               IF (HST14=8941)
                       SET ONCSCMDS="00450"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +51       IF "C473^C475^C493^C494^C495"[ONCTPCD
               Begin DoDot:1
 +52               IF ((HST14>7999)&(HST14<8804))!((HST14>8809)&(HST14<8922))!((HST14>8931)&(HST14<8935))!((HST14>8939)&(HST14<8991))!((HST14>8999)&(HST14<9017))
                       SET ONCSCMDS="00450"
                       SET ONCONLY2=1
                       SET ONC3927=1
                       QUIT 
 +53               IF ((HST14>9029)&(HST14<9044))!((HST14>9044)&(HST14<9139))!((HST14>9140)&(HST14<9231))!((HST14>9239)&(HST14<9581))!(HST14=9582)!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00450"
                       SET ONCONLY2=1
                       SET ONC3927=1
                       QUIT 
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +54      ;
 +55      ;Urethra
 +56       IF ONCTPCD="C680"
               Begin DoDot:1
 +57               IF ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00631"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +58      ;
 +59      ;Melanoma Ciliary Body/Iris
 +60       IF ONCTPCD="C694"
               Begin DoDot:1
 +61               IF ((HST14>8719)&(HST14<8791))
                       SET ONCSCMDS="00672"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +62      ;
 +63      ;Lacrimal Gland/Sac
 +64       IF ONCTPCD="C695"
               Begin DoDot:1
 +65               IF ((HST14>7999)&(HST14<8701))!(HST14=8941)!(HST14=8980)!(HST14=8982)!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00690"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +66      ;
 +67      ;Thyroid (including Medullary)
 +68       IF ONCTPCD="C739"
               Begin DoDot:1
 +69               IF ((HST14>7999)&(HST14<8345))!((HST14>8349)&(HST14<8421))!((HST14>8439)&(HST14<8510))!((HST14>8513)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="00730"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +70      ;
 +71       IF ONCTPCD="C739"
               Begin DoDot:1
 +72               IF ((HST14>8344)&(HST14<8348))!(HST14=8430)!(HST14=8510)!(HST14=8512)!(HST14=8513)
                       SET ONCSCMDS="00730"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +73      ;
 +74      ;Lymphoma
 +75       IF (ONCTPCD="C000")!((ONCT3>0)&(ONCT3<441))!((ONCT3>441)&(ONCT3<690))!((ONCT3>690)&(ONCT3<695))!(ONCT3=689)!(ONCT3=699)!((ONCT3>738)&(ONCT3<751))!((ONCT3>753)&(ONCT3<810))
               Begin DoDot:1
 +76               IF (HST14=9591)
                       SET ONCSCMDS="00790"
               End DoDot:1
               IF ONCSCMDS'=0
 +77       IF ((ONCT3>699)&(ONCT3<730))!((ONCT3>750)&(ONCT3<754))
               Begin DoDot:1
 +78               IF (ONCHIST=95913)
                       SET ONCSCMDS="00790"
               End DoDot:1
               IF ONCSCMDS'=0
 +79      ;
 +80      ;Plasma Cell Myeloma
 +81       IF (ONCT3="000")!((ONCT3>0)&(ONCT3<810))
               Begin DoDot:1
 +82               IF HST14=9732
                       SET ONCSCMDS="00821"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +83      ;
 +84      ;Ill-Defined/Other (Occult)
 +85       IF ONCTPCD="C760"
               Begin DoDot:1
 +86               IF ((HST14>7999)&(HST14<8701))!((HST14>8719)&(HST14<8791))!(HST14=9700)!(HST14=9701)
                       SET ONCSCMDS="99999"
               End DoDot:1
               IF ONCSCMDS'=0
                   QUIT 
 +87      ;
 +88       IF ONCSCMDS=0
               SET Y="@006"
 +89      ;
 +90      ;S $P(^ONCO(165.5,D0,"SSD1"),U,1)=ONCSCMDS
           IF ONCSCMDS'=0
               QUIT 
 +91      ;
 +92       QUIT