ONCOSUR3 ;HINES OIFO/RTK - ONCOSUR continued ;08/03/23
;;2.2;ONCOLOGY;**18**;Jul 31, 2013;Build 5
;
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=""
N COD S COD="" F S COD=$O(^ONCO(164,ICD,"SPS","D",COD)) Q:COD="" D
.S ONCEDVAL=ONCEDVAL_"^"_COD
I ONCEDVAL'[X K X Q
S ONCCDIEN=$O(^ONCO(164,ICD,"SPS","D",X,"")) I ONCCDIEN="" W "??" K X Q
W " ",$P($G(^ONCO(164,ICD,"SPS",ONCCDIEN,0)),U,1)
K ONCEDVAL,ONCCDIEN Q
;
SPSHP23 ;Help for 2023+ surgery primary site fields (58.8,58.9)
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 XSP="" F S XSP=$O(^ONCO(164,ICD,"SPS","D",XSP)) Q:XSP="" S SPSIEN=$O(^ONCO(164,ICD,"SPS","D",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 ONC23CD=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,3)
..I ONC23CD="" Q
..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,ONC23CD,?12,ONCDESC
..K ONCOLDCD,ONC23CD,ONCDESC Q
W !
K CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP
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 2799 printed Apr 09, 2024@21:24:14 Page 2
ONCOSUR3 ;HINES OIFO/RTK - ONCOSUR continued ;08/03/23
+1 ;;2.2;ONCOLOGY;**18**;Jul 31, 2013;Build 5
+2 ;
+3 QUIT
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 NEW COD
SET COD=""
FOR
SET COD=$ORDER(^ONCO(164,ICD,"SPS","D",COD))
if COD=""
QUIT
Begin DoDot:1
+9 SET ONCEDVAL=ONCEDVAL_"^"_COD
End DoDot:1
+10 IF ONCEDVAL'[X
KILL X
QUIT
+11 SET ONCCDIEN=$ORDER(^ONCO(164,ICD,"SPS","D",X,""))
IF ONCCDIEN=""
WRITE "??"
KILL X
QUIT
+12 WRITE " ",$PIECE($GET(^ONCO(164,ICD,"SPS",ONCCDIEN,0)),U,1)
+13 KILL ONCEDVAL,ONCCDIEN
QUIT
+14 ;
SPSHP23 ;Help for 2023+ surgery primary site fields (58.8,58.9)
+1 NEW SYSDIS
SET SYSDIS=""
+2 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No PRIMARY SITE"
QUIT
+3 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+4 Begin DoDot:1
+5 SET (EX,CTR)=0
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No TOPOGRAPHY!"
QUIT
+7 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+8 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
SET SYSDIS=1
+9 IF SYSDIS=""
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
WRITE !,"No ICD Codes!"
QUIT
+10 ;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
+11 ;I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
+12 IF $GET(SYSDIS)=1
WRITE !?3,"SURGICAL PROCEDURE codes for systemic disease: ",!
+13 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),": ",!
+14 SET XSP=""
FOR
SET XSP=$ORDER(^ONCO(164,ICD,"SPS","D",XSP))
if XSP=""
QUIT
SET SPSIEN=$ORDER(^ONCO(164,ICD,"SPS","D",XSP,0))
Begin DoDot:2
+15 SET ONCDESC=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
+16 SET ONCOLDCD=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)
+17 SET ONC23CD=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,3)
+18 IF ONC23CD=""
QUIT
+19 SET CTR=CTR+1
IF CTR#20=0
DO P
if EX=U
QUIT
+20 IF (ICD=67000)!(ICD=67090)!(ICD=67250)!(ICD=67569)
DO TRANSLT
+21 WRITE !?5,ONC23CD,?12,ONCDESC
+22 KILL ONCOLDCD,ONC23CD,ONCDESC
QUIT
End DoDot:2
if EX=U
QUIT
End DoDot:1
+23 WRITE !
+24 KILL CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP
+25 QUIT
+26 ;
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
