ONCOSUR ;HINES OIFO/GWB - Surgery INPUT/OUTPUT TRANSFORMS/HELP ;06/23/10
;;2.2;ONCOLOGY;**1,13,15**;Jul 31, 2013;Build 5
;
;SURGICAL APPROACH (165.5,74)
SAIT ;INPUT
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
I SCDXDT<2980000 D I $D(X) S V=1 D NT^ONCODSR
.K DIC S DIC="^ONCO(160.6," D ^DIC
.I Y=-1 K X Q
.S X=$P(Y,U,1) W " ",$P(^ONCO(160.6,X,0),U,2)
I SCDXDT>2971231 D
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
.;ROADS D-cxliii
.I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.S FOUND=0
.F XSA=0:0 S XSA=$O(^ONCO(164,ICD,"SUA",XSA)) Q:XSA'>0!(FOUND=1) D
..I $P(^ONCO(164,ICD,"SUA",XSA,0),U,2)=X S X=XSA,FOUND=1 Q
.I FOUND=0 K X Q
.W " ",$P(^ONCO(164,ICD,"SUA",X,0),U,1)
I $D(X) S V=1 D NT^ONCODSR
K SCDXDT,FOUND,ICD,TOP,XSA Q
;
SAOT ;OUTPUT
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
I SCDXDT<2980000 D
.S:Y'="" Y=$P($G(^ONCO(160.6,Y,0)),U,2)
I SCDXDT>2971231 D
.Q:Y=""
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
.;ROADS D-cxliii
.I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.S Y=$P($G(^ONCO(164,ICD,"SUA",Y,0)),U,1)
K SCDXDT,ICD,TOP Q
;
SAHP ;HELP
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
I SCDXDT<2980000 D
.W !?3,"Select from the following list:"
.F XSA=0:0 S XSA=$O(^ONCO(160.6,XSA)) Q:XSA'>0 W !?6,$P($G(^ONCO(160.6,XSA,0)),U,1),?12,$P($G(^ONCO(160.6,XSA,0)),U,2)
I SCDXDT>2971231 D
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
.;ROADS D-cxliii
.I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
.W !?3,"Select from the following list:",!
.F XSA=0:0 S XSA=$O(^ONCO(164,ICD,"SUA",XSA)) Q:XSA'>0 W !?6,$P($G(^ONCO(164,ICD,"SUA",XSA,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SUA",XSA,0)),U,1)
K SCDXDT,ICD,TOP,XSA Q
;
;SURGERY OF PRIMARY (R) (165.5,58.2)
;SURGERY OF PRIMARY (F) (165.5,58.6)
;
SPSIT ;INPUT TRANSFORM
S NTXDD=$G(NTXDD) I NTXDD="" Q
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1)
I TOP="" W " No PRIMARY SITE" K X Q
S ICD=""
S SR=+X
I $L(X)>2!(X'?1.N) K X Q
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
I (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($E(TOP,3,4)=76)!(TOP=67809),($G(FIELD)=58.6)!($G(FIELD)=58.7) G FORDS1
I SCDXDT<2980000,($G(FIELD)=58.2)!($G(FIELD)=50.2)!($G(FIELD)=58.6)!($G(FIELD)=58.7)!($G(FIELD)=.04) D CDSIT^ONCODSR Q:('$D(X))!($G(FIELD)=.04) I NTXDD=1 S V="00" D NT^ONCODSR K SCDXDT Q
FORDS1 D
.I X="00" S X=0
.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
.;ROADS D-cxliii
.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
.S FOUND=0
.F XSP=0:0 S XSP=$O(^ONCO(164,ICD,"SPS",XSP)) Q:XSP'>0!(FOUND=1) D
..I ($G(FIELD)=58.6)!($G(FIELD)=58.7),$P(^ONCO(164,ICD,"SPS",XSP,0),U,1)["ROADS" Q
..I ($E($G(SCDXDT),1,3)>321)&((ICD=67180)!(ICD=67199)!(ICD=67209)!(ICD=67210))&((X=11)!(X=13)!(X=14)!(X=21)!(X=23)!(X=24)!(X=25)) Q
..I $P(^ONCO(164,ICD,"SPS",XSP,0),U,2)=X S X=XSP,FOUND=1 Q
.I FOUND=0 K X Q
.W " ",$P(^ONCO(164,ICD,"SPS",X,0),U,1)
Q:$G(FIELD)=.04
I $D(X),NTXDD=1 S V=1 D NT^ONCODSR Q
K FOUND,HST14,ICD,SCDXDT,TOP,XSP
Q
;
SPSOT ;OUTPUT TRANSFORM
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
S ICD=""
I (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($E(TOP,3,4)=76)!(TOP=67809),($G(FIELD)=58.6)!($G(FIELD)=58.7) G FORDS2
I SCDXDT<2980000,($G(FIELD)=58.2)!($G(FIELD)=50.2)!($G(FIELD)=58.6)!($G(FIELD)=58.7)!($G(FIELD)=.04) D CDSOT^ONCODSR Q
FORDS2 D
.Q:Y=""
.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
.;ROADS D-cxliii
.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
.S Y=$S($P($G(^ONCO(164,ICD,"SPS",Y,0)),U,2)=0:"0",1:"")_$P($G(^ONCO(164,ICD,"SPS",Y,0)),U,2)_" "_$P($G(^ONCO(164,ICD,"SPS",Y,0)),U,1)
K HST14,ICD,SCDXDT,TOP
Q
;
SPSHP ;HELP
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
I (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($E(TOP,3,4)=76)!(TOP=67809),($G(FIELD)=58.6)!($G(FIELD)=58.7) G FORDS3
I SCDXDT<2980000,($G(FIELD)=58.2)!($G(FIELD)=50.2)!($G(FIELD)=58.6)!($G(FIELD)=58.7)!($G(FIELD)=.04) D HP1^ONCODSR Q
FORDS3 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
.;ROADS D-cxliii
.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","C",XSP)) Q:XSP="" S SPSIEN=$O(^ONCO(164,ICD,"SPS","C",XSP,0)) D Q:EX=U
..S CTR=CTR+1 I CTR#20=0 D P Q:EX=U
..I $P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)=0 W !?6,"00",?12,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1) Q
..I ($G(FIELD)=58.6)!($G(FIELD)=58.7),$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS" Q
..I SCDXDT>3171231,($G(FIELD)=.04),$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS" Q
..D
...S ONCRKCD=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)
...I ($E($G(SCDXDT),1,3)>321)&((ICD=67180)!(ICD=67199)!(ICD=67209)!(ICD=67210))&((ONCRKCD=11)!(ONCRKCD=13)!(ONCRKCD=14)!(ONCRKCD=21)!(ONCRKCD=23)!(ONCRKCD=24)!(ONCRKCD=25)) Q
...W !?6,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
...K ONCRKCD Q
W !
K CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP
Q
;
P D Q:EX=U W !
.W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
Q
;
SMIT ;SURGICAL MARGINS (165.5,59) INPUT
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
I SCDXDT<2980000 D I $D(X) S V=8 D NT^ONCODSR Q
.I X>2,X<8 K X Q
.W " ",$S(X=0:"No residual tumor",X=1:"Microscopic residual tumor",X=2:"Macroscopic residual tumor",X=8:"Not applicable",X=9:"Unknown",1:"")
I SCDXDT>2971231 D
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
.S FOUND=0
.F XSM=0:0 S XSM=$O(^ONCO(164,ICD,"SM5",XSM)) Q:XSM'>0!(FOUND=1) D
..I $P(^ONCO(164,ICD,"SM5",XSM,0),U,2)=X S X=XSM,FOUND=1 Q
.I FOUND=0 K X Q
.W " ",$P(^ONCO(164,ICD,"SM5",X,0),U,1)
I $D(X) S V=6 D NT^ONCODSR
K SCDXDT,FOUND,ICD,TOP,XSM Q
;
SMOT ;OUTPUT
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
I SCDXDT<2980000 D
.S Y=$S(Y=0:"0 No residual tumor",Y=1:"1 Microscopic residual tumor",Y=2:"2 Macroscopic residual tumor",Y=8:"8 Not applicable",Y=9:"9 Unknown",1:"")
I SCDXDT>2971231 D
.Q:Y=""
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
.S Y=$P($G(^ONCO(164,ICD,"SM5",Y,0)),U,2)_" "_$P($G(^ONCO(164,ICD,"SM5",Y,0)),U,1)
K SCDXDT,ICD,TOP Q
;
SMHP ;HELP
S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
I SCDXDT<2980000 D
.W !?3,"Select from the following list:"
.W !?6,"0",?12,"No residual tumor"
.W !?6,"1",?12,"Microscopic residual tumor"
.W !?6,"2",?12,"Macroscopic residual tumor"
.W !?6,"8",?12,"Not applicable"
.W !?6,"9",?12,"Unknown"
I SCDXDT>2971231 D
.S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
.S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
.W !?3,"Select from the following list:",!
.F XSM=0:0 S XSM=$O(^ONCO(164,ICD,"SM5",XSM)) Q:XSM'>0 W !?6,$P($G(^ONCO(164,ICD,"SM5",XSM,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SM5",XSM,0)),U,1)
K SCDXDT,ICD,TOP,XSM Q
;
CLEANUP ;Cleanup
K D0,FIELD,NTXDD,SR,V,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSUR 8666 printed Oct 16, 2024@18:26:29 Page 2
ONCOSUR ;HINES OIFO/GWB - Surgery INPUT/OUTPUT TRANSFORMS/HELP ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,13,15**;Jul 31, 2013;Build 5
+2 ;
+3 ;SURGICAL APPROACH (165.5,74)
SAIT ;INPUT
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
KILL X
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 KILL DIC
SET DIC="^ONCO(160.6,"
DO ^DIC
+4 IF Y=-1
KILL X
QUIT
+5 SET X=$PIECE(Y,U,1)
WRITE " ",$PIECE(^ONCO(160.6,X,0),U,2)
End DoDot:1
IF $DATA(X)
SET V=1
DO NT^ONCODSR
+6 IF SCDXDT>2971231
Begin DoDot:1
+7 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE " No TOPOGRAPHY!"
KILL X
QUIT
+8 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
KILL X
QUIT
+9 ;ROADS D-cxliii
+10 IF ($EXTRACT(TOP,3,4)=76)!($EXTRACT(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+11 SET FOUND=0
+12 FOR XSA=0:0
SET XSA=$ORDER(^ONCO(164,ICD,"SUA",XSA))
if XSA'>0!(FOUND=1)
QUIT
Begin DoDot:2
+13 IF $PIECE(^ONCO(164,ICD,"SUA",XSA,0),U,2)=X
SET X=XSA
SET FOUND=1
QUIT
End DoDot:2
+14 IF FOUND=0
KILL X
QUIT
+15 WRITE " ",$PIECE(^ONCO(164,ICD,"SUA",X,0),U,1)
End DoDot:1
+16 IF $DATA(X)
SET V=1
DO NT^ONCODSR
+17 KILL SCDXDT,FOUND,ICD,TOP,XSA
QUIT
+18 ;
SAOT ;OUTPUT
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 if Y'=""
SET Y=$PIECE($GET(^ONCO(160.6,Y,0)),U,2)
End DoDot:1
+4 IF SCDXDT>2971231
Begin DoDot:1
+5 if Y=""
QUIT
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
SET Y=""
QUIT
+7 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
SET Y=""
QUIT
+8 ;ROADS D-cxliii
+9 IF ($EXTRACT(TOP,3,4)=76)!($EXTRACT(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+10 SET Y=$PIECE($GET(^ONCO(164,ICD,"SUA",Y,0)),U,1)
End DoDot:1
+11 KILL SCDXDT,ICD,TOP
QUIT
+12 ;
SAHP ;HELP
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 WRITE !?3,"Select from the following list:"
+4 FOR XSA=0:0
SET XSA=$ORDER(^ONCO(160.6,XSA))
if XSA'>0
QUIT
WRITE !?6,$PIECE($GET(^ONCO(160.6,XSA,0)),U,1),?12,$PIECE($GET(^ONCO(160.6,XSA,0)),U,2)
End DoDot:1
+5 IF SCDXDT>2971231
Begin DoDot:1
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No TOPOGRAPHY!"
QUIT
+7 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
WRITE !,"No ICD Codes!"
QUIT
+8 ;ROADS D-cxliii
+9 IF ($EXTRACT(TOP,3,4)=76)!($EXTRACT(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+10 WRITE !?3,"Select from the following list:",!
+11 FOR XSA=0:0
SET XSA=$ORDER(^ONCO(164,ICD,"SUA",XSA))
if XSA'>0
QUIT
WRITE !?6,$PIECE($GET(^ONCO(164,ICD,"SUA",XSA,0)),U,2),?12,$PIECE($GET(^ONCO(164,ICD,"SUA",XSA,0)),U,1)
End DoDot:1
+12 KILL SCDXDT,ICD,TOP,XSA
QUIT
+13 ;
+14 ;SURGERY OF PRIMARY (R) (165.5,58.2)
+15 ;SURGERY OF PRIMARY (F) (165.5,58.6)
+16 ;
SPSIT ;INPUT TRANSFORM
+1 SET NTXDD=$GET(NTXDD)
IF NTXDD=""
QUIT
+2 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+3 IF TOP=""
WRITE " No PRIMARY SITE"
KILL X
QUIT
+4 SET ICD=""
+5 SET SR=+X
+6 IF $LENGTH(X)>2!(X'?1.N)
KILL X
QUIT
+7 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
KILL X
QUIT
+8 IF (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($EXTRACT(TOP,3,4)=76)!(TOP=67809)
IF ($GET(FIELD)=58.6)!($GET(FIELD)=58.7)
GOTO FORDS1
+9 IF SCDXDT<2980000
IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)!($GET(FIELD)=58.6)!($GET(FIELD)=58.7)!($GET(FIELD)=.04)
DO CDSIT^ONCODSR
if ('$DATA(X))!($GET(FIELD)=.04)
QUIT
IF NTXDD=1
SET V="00"
DO NT^ONCODSR
KILL SCDXDT
QUIT
FORDS1 Begin DoDot:1
+1 IF X="00"
SET X=0
+2 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+3 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
+4 IF ICD'=67420
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
SET Y=""
QUIT
+5 ;ROADS D-cxliii
+6 IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)
IF ($EXTRACT(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+7 IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)
IF TOP=67422
SET ICD=67770
+8 SET FOUND=0
+9 FOR XSP=0:0
SET XSP=$ORDER(^ONCO(164,ICD,"SPS",XSP))
if XSP'>0!(FOUND=1)
QUIT
Begin DoDot:2
+10 IF ($GET(FIELD)=58.6)!($GET(FIELD)=58.7)
IF $PIECE(^ONCO(164,ICD,"SPS",XSP,0),U,1)["ROADS"
QUIT
+11 IF ($EXTRACT($GET(SCDXDT),1,3)>321)&((ICD=67180)!(ICD=67199)!(ICD=67209)!(ICD=67210))&((X=11)!(X=13)!(X=14)!(X=21)!(X=23)!(X=24)!(X=25))
QUIT
+12 IF $PIECE(^ONCO(164,ICD,"SPS",XSP,0),U,2)=X
SET X=XSP
SET FOUND=1
QUIT
End DoDot:2
+13 IF FOUND=0
KILL X
QUIT
+14 WRITE " ",$PIECE(^ONCO(164,ICD,"SPS",X,0),U,1)
End DoDot:1
+15 if $GET(FIELD)=.04
QUIT
+16 IF $DATA(X)
IF NTXDD=1
SET V=1
DO NT^ONCODSR
QUIT
+17 KILL FOUND,HST14,ICD,SCDXDT,TOP,XSP
+18 QUIT
+19 ;
SPSOT ;OUTPUT TRANSFORM
+1 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
SET Y=""
QUIT
+2 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+3 SET ICD=""
+4 IF (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($EXTRACT(TOP,3,4)=76)!(TOP=67809)
IF ($GET(FIELD)=58.6)!($GET(FIELD)=58.7)
GOTO FORDS2
+5 IF SCDXDT<2980000
IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)!($GET(FIELD)=58.6)!($GET(FIELD)=58.7)!($GET(FIELD)=.04)
DO CDSOT^ONCODSR
QUIT
FORDS2 Begin DoDot:1
+1 if Y=""
QUIT
+2 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+3 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
+4 IF ICD'=67420
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
SET Y=""
QUIT
+5 ;ROADS D-cxliii
+6 IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)
IF ($EXTRACT(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+7 IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)
IF TOP=67422
SET ICD=67770
+8 SET Y=$SELECT($PIECE($GET(^ONCO(164,ICD,"SPS",Y,0)),U,2)=0:"0",1:"")_$PIECE($GET(^ONCO(164,ICD,"SPS",Y,0)),U,2)_" "_$PIECE($GET(^ONCO(164,ICD,"SPS",Y,0)),U,1)
End DoDot:1
+9 KILL HST14,ICD,SCDXDT,TOP
+10 QUIT
+11 ;
SPSHP ;HELP
+1 NEW SYSDIS
+2 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 IF (TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!($EXTRACT(TOP,3,4)=76)!(TOP=67809)
IF ($GET(FIELD)=58.6)!($GET(FIELD)=58.7)
GOTO FORDS3
+6 IF SCDXDT<2980000
IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)!($GET(FIELD)=58.6)!($GET(FIELD)=58.7)!($GET(FIELD)=.04)
DO HP1^ONCODSR
QUIT
FORDS3 Begin DoDot:1
+1 SET (EX,CTR)=0
+2 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No TOPOGRAPHY!"
QUIT
+3 SET HST14=$EXTRACT($$GET1^DIQ(165.5,D0,22.1),1,4)
+4 IF $$HEMATO^ONCFUNC(D0)
SET ICD=67420
SET SYSDIS=1
+5 IF SYSDIS=""
SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
WRITE !,"No ICD Codes!"
QUIT
+6 ;ROADS D-cxliii
+7 IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)
IF ($EXTRACT(TOP,3,4)=76)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)
SET ICD=67141
+8 IF ($GET(FIELD)=58.2)!($GET(FIELD)=50.2)
IF TOP=67422
SET ICD=67770
+9 IF $GET(SYSDIS)=1
WRITE !?3,"SURGICAL PROCEDURE codes for systemic disease: ",!
+10 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),": ",!
+11 SET XSP=""
FOR
SET XSP=$ORDER(^ONCO(164,ICD,"SPS","C",XSP))
if XSP=""
QUIT
SET SPSIEN=$ORDER(^ONCO(164,ICD,"SPS","C",XSP,0))
Begin DoDot:2
+12 SET CTR=CTR+1
IF CTR#20=0
DO P
if EX=U
QUIT
+13 IF $PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)=0
WRITE !?6,"00",?12,$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
QUIT
+14 IF ($GET(FIELD)=58.6)!($GET(FIELD)=58.7)
IF $PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS"
QUIT
+15 IF SCDXDT>3171231
IF ($GET(FIELD)=.04)
IF $PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS"
QUIT
+16 Begin DoDot:3
+17 SET ONCRKCD=$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)
+18 IF ($EXTRACT($GET(SCDXDT),1,3)>321)&((ICD=67180)!(ICD=67199)!(ICD=67209)!(ICD=67210))&((ONCRKCD=11)!(ONCRKCD=13)!(ONCRKCD=14)!(ONCRKCD=21)!(ONCRKCD=23)!(ONCRKCD=24)!(ONCRKCD=25))
QUIT
+19 WRITE !?6,$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2),?12,$PIECE($GET(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
+20 KILL ONCRKCD
QUIT
End DoDot:3
End DoDot:2
if EX=U
QUIT
End DoDot:1
+21 WRITE !
+22 KILL CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP
+23 QUIT
+24 ;
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
+3 ;
SMIT ;SURGICAL MARGINS (165.5,59) INPUT
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
KILL X
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 IF X>2
IF X<8
KILL X
QUIT
+4 WRITE " ",$SELECT(X=0:"No residual tumor",X=1:"Microscopic residual tumor",X=2:"Macroscopic residual tumor",X=8:"Not applicable",X=9:"Unknown",1:"")
End DoDot:1
IF $DATA(X)
SET V=8
DO NT^ONCODSR
QUIT
+5 IF SCDXDT>2971231
Begin DoDot:1
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE " No TOPOGRAPHY!"
KILL X
QUIT
+7 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
KILL X
QUIT
+8 SET FOUND=0
+9 FOR XSM=0:0
SET XSM=$ORDER(^ONCO(164,ICD,"SM5",XSM))
if XSM'>0!(FOUND=1)
QUIT
Begin DoDot:2
+10 IF $PIECE(^ONCO(164,ICD,"SM5",XSM,0),U,2)=X
SET X=XSM
SET FOUND=1
QUIT
End DoDot:2
+11 IF FOUND=0
KILL X
QUIT
+12 WRITE " ",$PIECE(^ONCO(164,ICD,"SM5",X,0),U,1)
End DoDot:1
+13 IF $DATA(X)
SET V=6
DO NT^ONCODSR
+14 KILL SCDXDT,FOUND,ICD,TOP,XSM
QUIT
+15 ;
SMOT ;OUTPUT
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 SET Y=$SELECT(Y=0:"0 No residual tumor",Y=1:"1 Microscopic residual tumor",Y=2:"2 Macroscopic residual tumor",Y=8:"8 Not applicable",Y=9:"9 Unknown",1:"")
End DoDot:1
+4 IF SCDXDT>2971231
Begin DoDot:1
+5 if Y=""
QUIT
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
SET Y=""
QUIT
+7 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
SET Y=""
QUIT
+8 SET Y=$PIECE($GET(^ONCO(164,ICD,"SM5",Y,0)),U,2)_" "_$PIECE($GET(^ONCO(164,ICD,"SM5",Y,0)),U,1)
End DoDot:1
+9 KILL SCDXDT,ICD,TOP
QUIT
+10 ;
SMHP ;HELP
+1 SET SCDXDT=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
IF SCDXDT=""
QUIT
+2 IF SCDXDT<2980000
Begin DoDot:1
+3 WRITE !?3,"Select from the following list:"
+4 WRITE !?6,"0",?12,"No residual tumor"
+5 WRITE !?6,"1",?12,"Microscopic residual tumor"
+6 WRITE !?6,"2",?12,"Macroscopic residual tumor"
+7 WRITE !?6,"8",?12,"Not applicable"
+8 WRITE !?6,"9",?12,"Unknown"
End DoDot:1
+9 IF SCDXDT>2971231
Begin DoDot:1
+10 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
WRITE !,"No TOPOGRAPHY!"
QUIT
+11 SET ICD=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF ICD=""
WRITE !,"No ICD Codes!"
QUIT
+12 WRITE !?3,"Select from the following list:",!
+13 FOR XSM=0:0
SET XSM=$ORDER(^ONCO(164,ICD,"SM5",XSM))
if XSM'>0
QUIT
WRITE !?6,$PIECE($GET(^ONCO(164,ICD,"SM5",XSM,0)),U,2),?12,$PIECE($GET(^ONCO(164,ICD,"SM5",XSM,0)),U,1)
End DoDot:1
+14 KILL SCDXDT,ICD,TOP,XSM
QUIT
+15 ;
CLEANUP ;Cleanup
+1 KILL D0,FIELD,NTXDD,SR,V,Y
