Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCOSUR

ONCOSUR.m

Go to the documentation of this file.
  1. ONCOSUR ;HINES OIFO/GWB - Surgery INPUT/OUTPUT TRANSFORMS/HELP ;06/23/10
  1. ;;2.2;ONCOLOGY;**1,13,15**;Jul 31, 2013;Build 5
  1. ;
  1. ;SURGICAL APPROACH (165.5,74)
  1. SAIT ;INPUT
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
  1. I SCDXDT<2980000 D I $D(X) S V=1 D NT^ONCODSR
  1. .K DIC S DIC="^ONCO(160.6," D ^DIC
  1. .I Y=-1 K X Q
  1. .S X=$P(Y,U,1) W " ",$P(^ONCO(160.6,X,0),U,2)
  1. I SCDXDT>2971231 D
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
  1. .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
  1. .;ROADS D-cxliii
  1. .I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
  1. .S FOUND=0
  1. .F XSA=0:0 S XSA=$O(^ONCO(164,ICD,"SUA",XSA)) Q:XSA'>0!(FOUND=1) D
  1. ..I $P(^ONCO(164,ICD,"SUA",XSA,0),U,2)=X S X=XSA,FOUND=1 Q
  1. .I FOUND=0 K X Q
  1. .W " ",$P(^ONCO(164,ICD,"SUA",X,0),U,1)
  1. I $D(X) S V=1 D NT^ONCODSR
  1. K SCDXDT,FOUND,ICD,TOP,XSA Q
  1. ;
  1. SAOT ;OUTPUT
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
  1. I SCDXDT<2980000 D
  1. .S:Y'="" Y=$P($G(^ONCO(160.6,Y,0)),U,2)
  1. I SCDXDT>2971231 D
  1. .Q:Y=""
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
  1. .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
  1. .;ROADS D-cxliii
  1. .I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
  1. .S Y=$P($G(^ONCO(164,ICD,"SUA",Y,0)),U,1)
  1. K SCDXDT,ICD,TOP Q
  1. ;
  1. SAHP ;HELP
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
  1. I SCDXDT<2980000 D
  1. .W !?3,"Select from the following list:"
  1. .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)
  1. I SCDXDT>2971231 D
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
  1. .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
  1. .;ROADS D-cxliii
  1. .I ($E(TOP,3,4)=76)!($E(TOP,3,4)=77)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424) S ICD=67141
  1. .W !?3,"Select from the following list:",!
  1. .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)
  1. K SCDXDT,ICD,TOP,XSA Q
  1. ;
  1. ;SURGERY OF PRIMARY (R) (165.5,58.2)
  1. ;SURGERY OF PRIMARY (F) (165.5,58.6)
  1. ;
  1. SPSIT ;INPUT TRANSFORM
  1. S NTXDD=$G(NTXDD) I NTXDD="" Q
  1. S TOP=$P($G(^ONCO(165.5,D0,2)),U,1)
  1. I TOP="" W " No PRIMARY SITE" K X Q
  1. S ICD=""
  1. S SR=+X
  1. I $L(X)>2!(X'?1.N) K X Q
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
  1. 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
  1. 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
  1. FORDS1 D
  1. .I X="00" S X=0
  1. .S HST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
  1. .I $$HEMATO^ONCFUNC(D0) S ICD=67420
  1. .I ICD'=67420 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
  1. .;ROADS D-cxliii
  1. .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
  1. .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
  1. .S FOUND=0
  1. .F XSP=0:0 S XSP=$O(^ONCO(164,ICD,"SPS",XSP)) Q:XSP'>0!(FOUND=1) D
  1. ..I ($G(FIELD)=58.6)!($G(FIELD)=58.7),$P(^ONCO(164,ICD,"SPS",XSP,0),U,1)["ROADS" Q
  1. ..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
  1. ..I $P(^ONCO(164,ICD,"SPS",XSP,0),U,2)=X S X=XSP,FOUND=1 Q
  1. .I FOUND=0 K X Q
  1. .W " ",$P(^ONCO(164,ICD,"SPS",X,0),U,1)
  1. Q:$G(FIELD)=.04
  1. I $D(X),NTXDD=1 S V=1 D NT^ONCODSR Q
  1. K FOUND,HST14,ICD,SCDXDT,TOP,XSP
  1. Q
  1. ;
  1. SPSOT ;OUTPUT TRANSFORM
  1. S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
  1. S ICD=""
  1. 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
  1. 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
  1. FORDS2 D
  1. .Q:Y=""
  1. .S HST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
  1. .I $$HEMATO^ONCFUNC(D0) S ICD=67420
  1. .I ICD'=67420 S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
  1. .;ROADS D-cxliii
  1. .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
  1. .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
  1. .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)
  1. K HST14,ICD,SCDXDT,TOP
  1. Q
  1. ;
  1. SPSHP ;HELP
  1. N SYSDIS
  1. S SYSDIS=""
  1. S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No PRIMARY SITE" Q
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
  1. 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
  1. 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
  1. FORDS3 D
  1. .S (EX,CTR)=0
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
  1. .S HST14=$E($$GET1^DIQ(165.5,D0,22.1),1,4)
  1. .I $$HEMATO^ONCFUNC(D0) S ICD=67420,SYSDIS=1
  1. .I SYSDIS="" S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
  1. .;ROADS D-cxliii
  1. .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
  1. .I ($G(FIELD)=58.2)!($G(FIELD)=50.2),TOP=67422 S ICD=67770
  1. .I $G(SYSDIS)=1 W !?3,"SURGICAL PROCEDURE codes for systemic disease: ",!
  1. .E W !?3,"SURGICAL PROCEDURE codes for site ",$P($G(^ONCO(164,TOP,0)),U,2)," ",$P($G(^ONCO(164,TOP,0)),U,1),": ",!
  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
  1. ..S CTR=CTR+1 I CTR#20=0 D P Q:EX=U
  1. ..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
  1. ..I ($G(FIELD)=58.6)!($G(FIELD)=58.7),$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS" Q
  1. ..I SCDXDT>3171231,($G(FIELD)=.04),$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)["ROADS" Q
  1. ..D
  1. ...S ONCRKCD=$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2)
  1. ...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
  1. ...W !?6,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,2),?12,$P($G(^ONCO(164,ICD,"SPS",SPSIEN,0)),U,1)
  1. ...K ONCRKCD Q
  1. W !
  1. K CTR,EX,HST14,ICD,SCDXDT,SPSIEN,TOP,XSP
  1. Q
  1. ;
  1. P D Q:EX=U W !
  1. .W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
  1. Q
  1. ;
  1. SMIT ;SURGICAL MARGINS (165.5,59) INPUT
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" K X Q
  1. I SCDXDT<2980000 D I $D(X) S V=8 D NT^ONCODSR Q
  1. .I X>2,X<8 K X Q
  1. .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:"")
  1. I SCDXDT>2971231 D
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W " No TOPOGRAPHY!" K X Q
  1. .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" K X Q
  1. .S FOUND=0
  1. .F XSM=0:0 S XSM=$O(^ONCO(164,ICD,"SM5",XSM)) Q:XSM'>0!(FOUND=1) D
  1. ..I $P(^ONCO(164,ICD,"SM5",XSM,0),U,2)=X S X=XSM,FOUND=1 Q
  1. .I FOUND=0 K X Q
  1. .W " ",$P(^ONCO(164,ICD,"SM5",X,0),U,1)
  1. I $D(X) S V=6 D NT^ONCODSR
  1. K SCDXDT,FOUND,ICD,TOP,XSM Q
  1. ;
  1. SMOT ;OUTPUT
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
  1. I SCDXDT<2980000 D
  1. .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:"")
  1. I SCDXDT>2971231 D
  1. .Q:Y=""
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" S Y="" Q
  1. .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" S Y="" Q
  1. .S Y=$P($G(^ONCO(164,ICD,"SM5",Y,0)),U,2)_" "_$P($G(^ONCO(164,ICD,"SM5",Y,0)),U,1)
  1. K SCDXDT,ICD,TOP Q
  1. ;
  1. SMHP ;HELP
  1. S SCDXDT=$P($G(^ONCO(165.5,D0,0)),U,16) I SCDXDT="" Q
  1. I SCDXDT<2980000 D
  1. .W !?3,"Select from the following list:"
  1. .W !?6,"0",?12,"No residual tumor"
  1. .W !?6,"1",?12,"Microscopic residual tumor"
  1. .W !?6,"2",?12,"Macroscopic residual tumor"
  1. .W !?6,"8",?12,"Not applicable"
  1. .W !?6,"9",?12,"Unknown"
  1. I SCDXDT>2971231 D
  1. .S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" W !,"No TOPOGRAPHY!" Q
  1. .S ICD=$P($G(^ONCO(164,TOP,0)),U,16) I ICD="" W !,"No ICD Codes!" Q
  1. .W !?3,"Select from the following list:",!
  1. .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)
  1. K SCDXDT,ICD,TOP,XSM Q
  1. ;
  1. CLEANUP ;Cleanup
  1. K D0,FIELD,NTXDD,SR,V,Y