219 lines
8.1 KiB
Mathematica
219 lines
8.1 KiB
Mathematica
ONCOCC ;HINES OIFO/GWB - CLASS OF CASE 5 OR 8 ;06/03/96
|
|
;;2.11;ONCOLOGY;**5,13,16,19,20,22,24,26,30,33,36,37,39,47**;Mar 07, 1995;Build 19
|
|
;
|
|
S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16)
|
|
S TPG=$P($G(^ONCO(165.5,D0,2)),U,1)
|
|
S SGRP="" I TPG'="" S SGRP=$P($G(^ONCO(164,TPG,0)),U,16)
|
|
F P=5,9,12,15,18,24 S $P(^ONCO(165.5,D0,3),U,P)=""
|
|
K ^ONCO(165.5,DA,6) S $P(^ONCO(165.5,DA,3),U,7)=0
|
|
K ^ONCO(165.5,DA,14),^ONCO(165.5,DA,15),^ONCO(165.5,DA,16),^ONCO(165.5,DA,17),^ONCO(165.5,DA,18),^ONCO(165.5,DA,20),^ONCO(165.5,DA,21)
|
|
I COC=5 D COC5
|
|
I COC=8 D COC8
|
|
D SCT Q
|
|
;
|
|
COC5 S $P(^ONCO(165.5,D0,3),U,35)=9
|
|
S $P(^ONCO(165.5,D0,3),U,27)=$S(DTDX>2951231:"00",1:0)
|
|
S $P(^ONCO(165.5,D0,3.1),U,5)=$S(DTDX>2951231:"00",1:0)
|
|
S $P(^ONCO(165.5,D0,3.1),U,29)=1
|
|
S $P(^ONCO(165.5,D0,3.1),U,30)=1
|
|
S $P(^ONCO(165.5,D0,3),U,34)=1
|
|
S $P(^ONCO(165.5,D0,3.1),U,28)=0
|
|
S $P(^ONCO(165.5,D0,3.1),U,39)=0
|
|
S $P(^ONCO(165.5,D0,0),U,10)=6
|
|
S $P(^ONCO(165.5,D0,3),U,26)=9
|
|
S $P(^ONCO(165.5,D0,3),U,28)=8
|
|
S TPG=$P($G(^ONCO(165.5,DA,2)),U,1)
|
|
I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S $P(^ONCO(165.5,DA,3),U,28)=9
|
|
S MO=$$HIST^ONCFUNC(DA)
|
|
S HIST14=$E(MO,1,4)
|
|
I (HIST14=9750)!((HIST14>9759)&(HIST14<9765))!((HIST14>9799)&(HIST14<9821))!(HIST14=9826)!((HIST14>9830)&(HIST14<9921))!((HIST14>9930)&(HIST14<9965))!((HIST14>9979)&(HIST14<9990)) S $P(^ONCO(165.5,DA,3),U,28)=9
|
|
I $$LYMPHOMA^ONCFUNC(DA),($E(TPG,3,4)=77) S $P(^ONCO(165.5,DA,3),U,28)=9
|
|
S $P(^ONCO(165.5,D0,3.1),U,31)=0
|
|
S $P(^ONCO(165.5,D0,3.1),U,32)=0
|
|
S $P(^ONCO(165.5,D0,3.1),U,33)=0
|
|
S $P(^ONCO(165.5,D0,3.1),U,34)=0
|
|
S $P(^ONCO(165.5,D0,3),U,33)=$S(DTDX>2971231:1,1:9)
|
|
F P=6,10,25 S $P(^ONCO(165.5,D0,3),U,P)=0
|
|
F P=12,20 S $P(^ONCO(165.5,D0,3.1),U,P)=0
|
|
S $P(^ONCO(165.5,DA,"THY1"),U,43)=$S(DTDX>2971231:0,1:"")
|
|
S $P(^ONCO(165.5,DA,3),U,13)="00"
|
|
S $P(^ONCO(165.5,DA,3.1),U,14)="00"
|
|
S $P(^ONCO(165.5,DA,3),U,16)="00"
|
|
S $P(^ONCO(165.5,DA,3.1),U,16)="00"
|
|
S $P(^ONCO(165.5,DA,3),U,19)="00"
|
|
S $P(^ONCO(165.5,DA,3.1),U,18)="00"
|
|
S $P(^ONCO(165.5,DA,3.1),U,36)=1
|
|
S $P(^ONCO(165.5,DA,3),U,20)=$S(DTDX>2971231:0,1:"")
|
|
S $P(^ONCO(165.5,DA,3),U,21)=$S(DTDX>2971231:1,1:"")
|
|
S $P(^ONCO(165.5,DA,3),U,22)=$S(DTDX>2971231:0,1:"")
|
|
S $P(^ONCO(165.5,DA,3),U,29)=$S(DTDX>2971231:0,1:"")
|
|
S $P(^ONCO(165.5,DA,3),U,39)=$S(DTDX>2971231:1,1:"")
|
|
S $P(^ONCO(165.5,DA,3.1),U,3)=$S(DTDX>2971231:0,1:"")
|
|
S $P(^ONCO(165.5,DA,3.1),U,1)=$S(DTDX>2971231:1,1:"")
|
|
S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
|
|
S $P(^ONCO(165.5,DA,"BLA2"),U,16)="0000000"
|
|
S $P(^ONCO(165.5,DA,"BLA2"),U,18)=1
|
|
S $P(^ONCO(165.5,DA,3),U,5)=""
|
|
F PP=1,4,11,14,17,23,31 S $P(^ONCO(165.5,DA,3),U,PP)="0000000"
|
|
F PP=6,8,13:2:19,21:1:25,35,38 S $P(^ONCO(165.5,DA,3.1),U,PP)="0000000"
|
|
K ^ONCO(165.5,"ATX",DA)
|
|
S ^ONCO(165.5,"ATX",DA,"0000000S1")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000S2")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000S3")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000R")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000C")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000H")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000B")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000E")=""
|
|
S ^ONCO(165.5,"ATX",DA,"0000000O")=""
|
|
Q
|
|
;
|
|
COC8 ;CLASS OF CASE (165.5,.04) value 8 (Death cert) used by central
|
|
;registries only
|
|
Q
|
|
;
|
|
SCT I $D(^ONCO(165.5,D0,4)) S SCTIEN=0 F S SCTIEN=$O(^ONCO(165.5,D0,4,SCTIEN)) Q:SCTIEN'>0 D
|
|
.S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,4)="00"
|
|
.I COC=5 D
|
|
..F P=11,12,13,14,15,16,17 S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,P)="0000000"
|
|
..S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,5)=0
|
|
..S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,6)="00"
|
|
..S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,7)="00"
|
|
..S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,9)=0
|
|
..S $P(^ONCO(165.5,D0,4,SCTIEN,0),U,10)=0
|
|
..S $P(^ONCO(165.5,D0,4,SCTIEN,3),U,19)=0
|
|
K BRM,FLD,P,REC,RFNR,RFNC,RFNHT,RR
|
|
K SA,SC,SM,SO,SPS,SCTIEN,SGRP,TPG
|
|
Q
|
|
;
|
|
SATFDFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2) default
|
|
N SPS S SPS=$P($G(^ONCO(165.5,D0,3)),U,38)
|
|
D SGROUP I TPG="" Q
|
|
I (SPS="00")!(SPS=1)!($G(^ONCO(164,SGRP,"SPS",SPS,0))["Unknown") S Y="@427" Q
|
|
S SPSDF="" I (COC=1)!(COC=2) D Q
|
|
.S SPSDF=$P($G(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
|
|
.S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16) S:DTDX<2980000 SPSDF=""
|
|
Q
|
|
;
|
|
SATFDEF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7) default
|
|
N SPS S SPS=$P($G(^ONCO(165.5,D0,3.1)),U,29)
|
|
I SPS="" Q
|
|
D SGROUP I TPG="" Q
|
|
I (SPS="00")!(SPS=1)!($G(^ONCO(164,SGRP,"SPS",SPS,0))["Unknown") S Y="@43" Q
|
|
S (SPSDF,SPSDTDF)="" I (COC=1)!(COC=2) D Q
|
|
.S SPSDF=$P($G(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
|
|
.S SPSDTDF=$$GET1^DIQ(165.5,D0,50,"E")
|
|
.S DTDX=$P($G(^ONCO(165.5,D0,0)),U,16) S:DTDX<2980000 (SPSDF,SPSDTDF)=""
|
|
Q
|
|
;
|
|
RATFDEF ;RADIATION @FACILITY (165.5,51.4) default
|
|
S RD=$P($G(^ONCO(165.5,D0,3)),U,6)
|
|
S RADDF="",RADDTDF="" I (COC=1)!(COC=2) D Q
|
|
.I RD'="" D
|
|
..S XX=$F(^DD(165.5,51.2,0),RD_":")
|
|
..S YY=$F(^DD(165.5,51.2,0),";",XX)
|
|
..S RADDF=$E(^DD(165.5,51.2,0),XX,YY-2)
|
|
.S RADDTDF=$P($G(^ONCO(165.5,D0,3)),U,4)
|
|
Q
|
|
;
|
|
CATFDEF ;CHEMOTHERAPY @FAC (165.5,53.3) default
|
|
S CH=$P($G(^ONCO(165.5,D0,3)),U,13)
|
|
S CHEMDF="",CHMDTDF="" I (COC=1)!(COC=2) D Q
|
|
.I CH'="" D
|
|
..S XX=$F(^DD(165.5,53.2,0),CH_":")
|
|
..S YY=$F(^DD(165.5,53.2,0),";",XX)
|
|
..S CHEMDF=$E(^DD(165.5,53.2,0),XX,YY-2)
|
|
.S CHMDTDF=$P($G(^ONCO(165.5,D0,3)),U,11)
|
|
Q
|
|
;
|
|
HATFDEF ;HORMONE THERAPY @FAC (165.5,54.3) default
|
|
S HT=$P($G(^ONCO(165.5,D0,3)),U,16)
|
|
S HTDF="",HTDTDF="" I (COC=1)!(COC=2) D Q
|
|
.I HT'="" D
|
|
..S XX=$F(^DD(165.5,54.2,0),HT_":")
|
|
..S YY=$F(^DD(165.5,54.2,0),";",XX)
|
|
..S HTDF=$E(^DD(165.5,54.2,0),XX,YY-2)
|
|
.S HTDTDF=$P($G(^ONCO(165.5,D0,3)),U,14)
|
|
Q
|
|
;
|
|
IATFDEF ;IMMUNOTHERAPY @FAC (165.5,55.3) default
|
|
S IMM=$P($G(^ONCO(165.5,D0,3)),U,19)
|
|
S IMMDF="",IMMDTDF="" I (COC=1)!(COC=2) D Q
|
|
.I IMM'="" D
|
|
..S XX=$F(^DD(165.5,55.2,0),IMM_":")
|
|
..S YY=$F(^DD(165.5,55.2,0),";",XX)
|
|
..S IMMDF=$E(^DD(165.5,55.2,0),XX,YY-2)
|
|
.S IMMDTDF=$P($G(^ONCO(165.5,D0,3)),U,17)
|
|
Q
|
|
;
|
|
OATFDEF ;OTHER TREATMENT @FAC (165.5,57.3) default
|
|
S OTH=$P($G(^ONCO(165.5,D0,3)),U,25)
|
|
S OTHDF="",OTHDTDF="" I (COC=1)!(COC=2) D Q
|
|
.I OTH'="" D
|
|
..S XX=$F(^DD(165.5,57.2,0),OTH_":")
|
|
..S YY=$F(^DD(165.5,57.2,0),";",XX)
|
|
..S OTHDF=$E(^DD(165.5,57.2,0),XX,YY-2)
|
|
.S OTHDTDF=$P($G(^ONCO(165.5,D0,3)),U,23)
|
|
Q
|
|
;
|
|
PATFDEF ;PALLIATIVE PROCEDURE @FAC (165.5,13) default
|
|
S PP=$P($G(^ONCO(165.5,D0,3.1)),U,26)
|
|
S PPDF="" I (COC=1)!(COC=2) D Q
|
|
.I PP'="" D
|
|
..S XX=$F(^DD(165.5,12,0),PP_":")
|
|
..S YY=$F(^DD(165.5,12,0),";",XX)
|
|
..S PPDF=$E(^DD(165.5,12,0),XX,YY-2)
|
|
Q
|
|
;
|
|
SCOPER ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1) default
|
|
N SCOPE S SCOPE=$P($G(^ONCO(165.5,D0,3)),U,40) I SCOPE="" Q
|
|
D SGROUP I TPG="" Q
|
|
S SCPDF="" I (COC=1)!(COC=2) D Q
|
|
.S SCPDF=$P($G(^ONCO(164,SGRP,"SC5",SCOPE,0)),U,1)
|
|
Q
|
|
;
|
|
SCOPE ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5) default
|
|
;SCOPE OF LN SURGERY @FAC DATE (165.5,138.3) default
|
|
N SCOPE S SCOPE=$P($G(^ONCO(165.5,D0,3.1)),U,31) I SCOPE="" Q
|
|
S (SCPDF,SCPDTDF)="" I (COC=1)!(COC=2) D Q
|
|
.I SCOPE'="" D
|
|
..S XX=$F(^DD(165.5,138.5,0),SCOPE_":")
|
|
..S YY=$F(^DD(165.5,138.5,0),";",XX)
|
|
..S SCPDF=$E(^DD(165.5,138.5,0),XX,YY-2)
|
|
.S SCPDTDF=$P($G(^ONCO(165.5,D0,3.1)),U,22)
|
|
Q
|
|
;
|
|
NUMN ;NUMBER OF LN REMOVED @FAC (R) (165.5,140.1) default
|
|
N NODES S NODES=$P($G(^ONCO(165.5,D0,3)),U,42)
|
|
S NUMDF="" I (COC=1)!(COC=2) D Q
|
|
.S NUMDF=NODES
|
|
.I NUMDF="00" S NUMDF=NUMDF_" No nodes removed"
|
|
.I NUMDF="90" S NUMDF=NUMDF_" 90 or more nodes removed"
|
|
.I NUMDF="95" S NUMDF=NUMDF_" No nodes removed, aspiration performed"
|
|
.I NUMDF="96" S NUMDF=NUMDF_" Node removal as a sampling, number unknown"
|
|
.I NUMDF="97" S NUMDF=NUMDF_" Node removal as dissection, number unknown"
|
|
.I NUMDF="98" S NUMDF=NUMDF_" Nodes surgically removed, number unknown"
|
|
.I NUMDF="99" S NUMDF=NUMDF_" Unknown, not stated, death cert ONLY"
|
|
Q
|
|
;
|
|
SOSNR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1) default
|
|
N SOSN S SOSN=$P($G(^ONCO(165.5,D0,3)),U,41) I SOSN="" Q
|
|
D SGROUP I TPG="" Q
|
|
S SOSNDF="" I (COC=1)!(COC=2) D Q
|
|
.S SOSNDF=$P($G(^ONCO(164,SGRP,"SO5",SOSN,0)),U,1)
|
|
Q
|
|
;
|
|
SOSN ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5) default
|
|
N SOSN S SOSN=$P($G(^ONCO(165.5,D0,3.1)),U,33) I SOSN="" Q
|
|
S (SOSNDF,SOSNDTDF)="" I (COC=1)!(COC=2) D Q
|
|
.I SOSN'="" D
|
|
..S XX=$F(^DD(165.5,139.5,0),SOSN_":")
|
|
..S YY=$F(^DD(165.5,139.5,0),";",XX)
|
|
..S SOSNDF=$E(^DD(165.5,139.5,0),XX,YY-2)
|
|
.S SOSNDTDF=$P($G(^ONCO(165.5,D0,3.1)),U,24)
|
|
Q
|
|
;
|
|
SGROUP S TPG=$P($G(^ONCO(165.5,D0,2)),U,1) I TPG="" Q
|
|
S SGRP=$P($G(^ONCO(164,TPG,0)),U,16)
|
|
Q
|