ONCOSUR3 ;HINES OIFO/RTK - ONCOSUR continued ;08/03/23
;;2.2;ONCOLOGY;**18,20,21**;Jul 31, 2013;Build 6
;
Q
;
SPSIT23 ;Input transform for 2023+ surgery primary site fields (58.8,58.9)
S X=$TR(X,"ab","AB")
N TOP S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No PRIMARY SITE" K X Q
N ICD S ICD=""
S HST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
I $$HEMATO^ONCFUNC(D0) S ICD=67420
I ICD'=67420 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
S ONCEDVAL=""
S ONCUSEB=0,ONCXVAL="D" D CHK24BCD I ONCUSEB=1 S ONCXVAL="E" ;A-CODES ON "D" X-REF, B-CODES ON "E" X-REF
N COD S COD="" F S COD=$O(^ONCO(164,ICD,"SPS",ONCXVAL,COD)) Q:COD="" D
.S ONCEDVAL=ONCEDVAL_"^"_COD
I ONCEDVAL'[X K X Q
S ONCCDIEN=$O(^ONCO(164,ICD,"SPS",ONCXVAL,X,"")) I ONCCDIEN="" W "??" K X Q
W " ",$P($G(^ONCO(164,ICD,"SPS",ONCCDIEN,0)),U,1)
K ONCEDVAL,ONCCDIEN,ONCUSEB,ONCXVAL Q
;
SPSOT23 ;Output transform for 2023+ surgery primary site fields (58.8,58.9)
N TOP S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" Q
N INTSRVAL
I $G(FIELD)=58.8 S INTSRVAL=$P($G(^ONCO(165.5,D0,3.2)),U,8) I INTSRVAL="" Q
I $G(FIELD)=58.9 S INTSRVAL=$P($G(^ONCO(165.5,D0,3.2)),U,9) I INTSRVAL="" Q
N ICD S ICD=""
S HST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
I $$HEMATO^ONCFUNC(D0) S ICD=67420
I ICD'=67420 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" Q
S ONCUSEB=0,ONCXVAL="D" D CHK24BCD I ONCUSEB=1 S ONCXVAL="E" ;A-CODES ON "D" X-REF, B-CODES ON "E" X-REF
S SRVALIEN=$O(^ONCO(164,ICD,"SPS",ONCXVAL,INTSRVAL,"")) I SRVALIEN="" Q
I ONCUSEB=0 S Y=$P($G(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,3)_" "_$P($G(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,1)
I ONCUSEB=1 S Y=$P($G(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,4)_" "_$P($G(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,1)
K ONCUSEB,ONCXVAL Q
;
SPSHP23 ;Help for 2023+ surgery primary site fields (58.8,58.9)
; A and B codes used for surgery codes 2023+
N SYSDIS S SYSDIS=""
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No PRIMARY SITE" Q
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
D
.S (EX,CTR)=0
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
.S HST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
.I $$HEMATO^ONCFUNC(D0) S ICD=67420,SYSDIS=1
.I SYSDIS="" S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
.;I ($G(FIELD)=58.2)!($G(FIELD)=50.2),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.;I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
.I $G(SYSDIS)=1 W !?3,"SURGICAL PROCEDURE codes for systemic disease: ",!
.E W !?3,"SURGICAL PROCEDURE codes for site ",$P($G(^ONCO(164,TOP,0)),U,2)," ",$P($G(^ONCO(164,TOP,0)),U,1),": ",!
.S ONCUSEB=0,ONCXVAL="D" D CHK24BCD I ONCUSEB=1 S ONCXVAL="E" ;A-CODES ON "D" X-REF, B-CODES ON "E" X-REF
.S XSP="" F S XSP=$O(^ONCO(164,ICD,"SPS",ONCXVAL,XSP)) Q:XSP="" S SPSIEN=$O(^ONCO(164,ICD,"SPS",ONCXVAL,XSP,0)) D Q:EX=U
..S ONCDESC=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
..S ONCOLDCD=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)
..S ONC23ACD=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,3)
..S ONC23BCD=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,4)
..I ONCUSEB=0,ONC23ACD="" Q
..I ONCUSEB=1,ONC23BCD="" Q
..;I (ONC23ACD="")&(ONC23BCD="") Q
..S ONCDSPCD=$S(ONCUSEB=1:ONC23BCD,1:ONC23ACD)
..S CTR=CTR+1 I CTR#20=0 D P Q:EX=U
..I (ICD=67000)!(ICD=67090)!(ICD=67250)!(ICD=67569) D TRANSLT
..W !?5,ONCDSPCD,?12,ONCDESC
..K ONCOLDCD,ONC23ACD,ONC23BCD,ONCDSPCD,ONCDESC Q
W !
K CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP,ONCUSEB,ONCXVAL
Q
;
CHK24BCD ;Check for 2024+ cases with B-codes:
; 2024: Breast(67500),Colon(67180),Lung(67340),Pancreas(67250),Thyroid(67739)
S ONCUSEB=0
I ICD=67500,$P($G(^ONCO(165.5,D0,0)),U,16)>3231231 S ONCUSEB=1
I ICD=67180,$P($G(^ONCO(165.5,D0,0)),U,16)>3231231 S ONCUSEB=1
I ICD=67340,$P($G(^ONCO(165.5,D0,0)),U,16)>3231231 S ONCUSEB=1
I ICD=67250,$P($G(^ONCO(165.5,D0,0)),U,16)>3231231 S ONCUSEB=1
I ICD=67739,$P($G(^ONCO(165.5,D0,0)),U,16)>3231231 S ONCUSEB=1
Q
;
TRANSLT ; Convert some 2 digit codes in description to new 4 character codes
I ONCDESC["41" S ONCDESC=$P(ONCDESC,"41",1)_"A410"_$P(ONCDESC,"41",2)
I ONCDESC["42" S ONCDESC=$P(ONCDESC,"42",1)_"A420"_$P(ONCDESC,"42",2)
I ONCDESC["51" S ONCDESC=$P(ONCDESC,"51",1)_"A510"_$P(ONCDESC,"51",2)
I ONCDESC["52" S ONCDESC=$P(ONCDESC,"52",1)_"A520"_$P(ONCDESC,"52",2)
I ONCDESC["54" S ONCDESC=$P(ONCDESC,"54",1)_"A540"_$P(ONCDESC,"54",2)
I ONCDESC["61" S ONCDESC=$P(ONCDESC,"61",1)_"A610"_$P(ONCDESC,"61",2)
I ONCDESC["62" S ONCDESC=$P(ONCDESC,"62",1)_"A620"_$P(ONCDESC,"62",2)
Q
P D Q:EX=U W !
.W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSUR3 4690 printed Sep 23, 2025@20:01:58 Page 2
ONCOSUR3 ;HINES OIFO/RTK - ONCOSUR continued ;08/03/23
+1 ;;2.2;ONCOLOGY;**18,20,21**;Jul 31, 2013;Build 6
+2 ;
+3 QUIT
+4 ;
SPSIT23 ;Input transform for 2023+ surgery primary site fields (58.8,58.9)
+1 SET X=$TRANSLATE(X,"ab","AB")
+2 NEW TOP
SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE " No PRIMARY SITE"
KILL X
QUIT
+3 NEW ICD
SET ICD=""
+4 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+5 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
+6 IF ICD'=67420
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
SET Y=""
QUIT
+7 SET ONCEDVAL=""
+8 ;A-CODES ON "D" X-REF, B-CODES ON "E" X-REF
SET ONCUSEB=0
SET ONCXVAL="D"
DO CHK24BCD
IF ONCUSEB=1
SET ONCXVAL="E"
+9 NEW COD
SET COD=""
FOR
SET COD=$ORDER(^ONCO(164,ICD,"SPS",ONCXVAL,COD))
if COD=""
QUIT
Begin DoDot:1
+10 SET ONCEDVAL=ONCEDVAL_"^"_COD
End DoDot:1
+11 IF ONCEDVAL'[X
KILL X
QUIT
+12 SET ONCCDIEN=$ORDER(^ONCO(164,ICD,"SPS",ONCXVAL,X,""))
IF ONCCDIEN=""
WRITE "??"
KILL X
QUIT
+13 WRITE " ",$PIECE($GET(^ONCO(164,ICD,"SPS",ONCCDIEN,0)),U,1)
+14 KILL ONCEDVAL,ONCCDIEN,ONCUSEB,ONCXVAL
QUIT
+15 ;
SPSOT23 ;Output transform for 2023+ surgery primary site fields (58.8,58.9)
+1 NEW TOP
SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
QUIT
+2 NEW INTSRVAL
+3 IF $GET(FIELD)=58.8
SET INTSRVAL=$PIECE($GET(^ONCO(165.5,D0,3.2)),U,8)
IF INTSRVAL=""
QUIT
+4 IF $GET(FIELD)=58.9
SET INTSRVAL=$PIECE($GET(^ONCO(165.5,D0,3.2)),U,9)
IF INTSRVAL=""
QUIT
+5 NEW ICD
SET ICD=""
+6 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+7 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
+8 IF ICD'=67420
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
QUIT
+9 ;A-CODES ON "D" X-REF, B-CODES ON "E" X-REF
SET ONCUSEB=0
SET ONCXVAL="D"
DO CHK24BCD
IF ONCUSEB=1
SET ONCXVAL="E"
+10 SET SRVALIEN=$ORDER(^ONCO(164,ICD,"SPS",ONCXVAL,INTSRVAL,""))
IF SRVALIEN=""
QUIT
+11 IF ONCUSEB=0
SET Y=$PIECE($GET(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,3)_" "_$PIECE($GET(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,1)
+12 IF ONCUSEB=1
SET Y=$PIECE($GET(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,4)_" "_$PIECE($GET(^ONCO(164,ICD,"SPS",SRVALIEN,0)),U,1)
+13 KILL ONCUSEB,ONCXVAL
QUIT
+14 ;
SPSHP23 ;Help for 2023+ surgery primary site fields (58.8,58.9)
+1 ; A and B codes used for surgery codes 2023+
+2 NEW SYSDIS
SET SYSDIS=""
+3 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No PRIMARY SITE"
QUIT
+4 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+5 Begin DoDot:1
+6 SET (EX,CTR)=0
+7 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No TOPOGRAPHY!"
QUIT
+8 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+9 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
SET SYSDIS=1
+10 IF SYSDIS=""
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
WRITE !,"No ICD Codes!"
QUIT
+11 ;I ($G(FIELD)=58.2)!($G(FIELD)=50.2),($E(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
+12 ;I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
+13 IF $GET(SYSDIS)=1
WRITE !?3,"SURGICAL PROCEDURE codes for systemic disease: ",!
+14 IF '$TEST
WRITE !?3,"SURGICAL PROCEDURE codes for site ",$PIECE($GET(^ONCO(164,TOP,0)),U,2)," ",$PIECE($GET(^ONCO(164,TOP,0)),U,1),": ",!
+15 ;A-CODES ON "D" X-REF, B-CODES ON "E" X-REF
SET ONCUSEB=0
SET ONCXVAL="D"
DO CHK24BCD
IF ONCUSEB=1
SET ONCXVAL="E"
+16 SET XSP=""
FOR
SET XSP=$ORDER(^ONCO(164,ICD,"SPS",ONCXVAL,XSP))
if XSP=""
QUIT
SET SPSIEN=$ORDER(^ONCO(164,ICD,"SPS",ONCXVAL,XSP,0))
Begin DoDot:2
+17 SET ONCDESC=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
+18 SET ONCOLDCD=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)
+19 SET ONC23ACD=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,3)
+20 SET ONC23BCD=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,4)
+21 IF ONCUSEB=0
IF ONC23ACD=""
QUIT
+22 IF ONCUSEB=1
IF ONC23BCD=""
QUIT
+23 ;I (ONC23ACD="")&(ONC23BCD="") Q
+24 SET ONCDSPCD=$SELECT(ONCUSEB=1:ONC23BCD,1:ONC23ACD)
+25 SET CTR=CTR+1
IF CTR#20=0
DO P
if EX=U
QUIT
+26 IF (ICD=67000)!(ICD=67090)!(ICD=67250)!(ICD=67569)
DO TRANSLT
+27 WRITE !?5,ONCDSPCD,?12,ONCDESC
+28 KILL ONCOLDCD,ONC23ACD,ONC23BCD,ONCDSPCD,ONCDESC
QUIT
End DoDot:2
if EX=U
QUIT
End DoDot:1
+29 WRITE !
+30 KILL CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP,ONCUSEB,ONCXVAL
+31 QUIT
+32 ;
CHK24BCD ;Check for 2024+ cases with B-codes:
+1 ; 2024: Breast(67500),Colon(67180),Lung(67340),Pancreas(67250),Thyroid(67739)
+2 SET ONCUSEB=0
+3 IF ICD=67500
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3231231
SET ONCUSEB=1
+4 IF ICD=67180
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3231231
SET ONCUSEB=1
+5 IF ICD=67340
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3231231
SET ONCUSEB=1
+6 IF ICD=67250
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3231231
SET ONCUSEB=1
+7 IF ICD=67739
IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3231231
SET ONCUSEB=1
+8 QUIT
+9 ;
TRANSLT ; Convert some 2 digit codes in description to new 4 character codes
+1 IF ONCDESC["41"
SET ONCDESC=$PIECE(ONCDESC,"41",1)_"A410"_$PIECE(ONCDESC,"41",2)
+2 IF ONCDESC["42"
SET ONCDESC=$PIECE(ONCDESC,"42",1)_"A420"_$PIECE(ONCDESC,"42",2)
+3 IF ONCDESC["51"
SET ONCDESC=$PIECE(ONCDESC,"51",1)_"A510"_$PIECE(ONCDESC,"51",2)
+4 IF ONCDESC["52"
SET ONCDESC=$PIECE(ONCDESC,"52",1)_"A520"_$PIECE(ONCDESC,"52",2)
+5 IF ONCDESC["54"
SET ONCDESC=$PIECE(ONCDESC,"54",1)_"A540"_$PIECE(ONCDESC,"54",2)
+6 IF ONCDESC["61"
SET ONCDESC=$PIECE(ONCDESC,"61",1)_"A610"_$PIECE(ONCDESC,"61",2)
+7 IF ONCDESC["62"
SET ONCDESC=$PIECE(ONCDESC,"62",1)_"A620"_$PIECE(ONCDESC,"62",2)
+8 QUIT
P Begin DoDot:1
+1 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
IF 'Y
SET EX=U
QUIT
End DoDot:1
if EX=U
QUIT
WRITE !
+2 QUIT
