- 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 Feb 18, 2025@23:52:19 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