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 Apr 09, 2024@21:28:42 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
