ONCOCC ;HINES OIFO/GWB - CLASS OF CASE stuffing and @FAC defaults ;06/23/10
;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
;
;CLASS OF CASE (165.5,.04) = 38 (Dx by autopsy at reporting facility)
N COC,NTX,PAUSE
S COC=$E($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
I COC=38 D S Y=$S(PAUSE[U:"",ONCOANS="A":"@7",1:"@0")
.W !?5,"CLASS OF CASE = 38 (Dx by autopsy at reporting facility)"
.W !!?5,"All treatment fields will be stuffed with the appropriate"
.W !?5,"value indicating no treatment.",!
.D PAUSE I PAUSE[U Q
.S NTX="" D NTX^ONCNTX
.D HDR^ONCNTX
.S $P(^ONCO(165.5,DA,3.1),U,26)=0
.S $P(^ONCO(165.5,DA,3.1),U,27)=0
.S $P(^ONCO(165.5,DA,"BLA2"),U,1)=0
.S $P(^ONCO(165.5,DA,"STS"),U,31)="00"
.S $P(^ONCO(165.5,DA,3.1),U,4)="0000"
.W !,"PALLIATIVE CARE................: No palliative care"
.W !,"PALLIATIVE CARE @FAC...........: No palliative care"
.W !
.W !,"PROTOCOL ELIGIBILITY STATUS....: Not available"
.W !,"PROTOCOL PARTICIPATION.........: Not on/NA"
.W !,"YEAR PUT ON PROTOCOL...........: 0000"
.W !
.D PAUSE
Q
;
PAUSE ;Enter RETURN to coninue" prompt
W ! R "Enter RETURN to continue or '^' to exit: ",PAUSE:30
I PAUSE="" Q
I PAUSE=U Q
G PAUSE
;
DNTDEL ;Delete DATE OF NO TREATMENT (165.5,124)
N TXDT
I $P($G(^ONCO(165.5,DA,2.1)),U,11)'="" D
.S TXDT=$P(^ONCO(165.5,DA,2.1),U,11)_"N"
.S $P(^ONCO(165.5,DA,2.1),U,11)=""
.K ^ONCO(165.5,"ATX",DA,TXDT)
Q
;
SATFDFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2) default
N SGRP,SPS,TPG
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=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D Q
.S SPSDF=$P($G(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
.S:$P($G(^ONCO(165.5,D0,0)),U,16)<2980000 SPSDF=""
Q
;
SATFDEF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7) default
N SGRP,SPS,TPG
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=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D Q
.S SPSDF=$P($G(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
.S SPSDTDF=$$GET1^DIQ(165.5,D0,50,"E")
.S:$P($G(^ONCO(165.5,D0,0)),U,16)<2980000 (SPSDF,SPSDTDF)=""
Q
;
RATFDEF ;RADIATION @FACILITY (165.5,51.4) default
N RD,XX,YY
S RD=$P($G(^ONCO(165.5,D0,3)),U,6)
S RADDF="",RADDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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
N CH
S CH=$P($G(^ONCO(165.5,D0,3)),U,13)
S CHEMDF="",CHMDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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
N HT
S HT=$P($G(^ONCO(165.5,D0,3)),U,16)
S HTDF="",HTDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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
N IMM
S IMM=$P($G(^ONCO(165.5,D0,3)),U,19)
S IMMDF="",IMMDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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
;
HEATFDEF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2) default
N HTEP
S HTEP=$P($G(^ONCO(165.5,D0,3.1)),U,36)
S HTEPDF="",HTEPDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D Q
.I HTEP'="" D
..S HTEPDF=$S(HTEP=1:"00",HTEP=2:10,HTEP=3:11,HTEP=4:12,HTEP=5:20,HTEP=6:30,HTEP=7:40,HTEP=8:82,HTEP=9:85,HTEP=10:86,HTEP=11:87,HTEP=12:88,HTEP=13:99,1:"")
..S HTEPDTDF=$P($G(^ONCO(165.5,D0,3.1)),U,35)
Q
;
OATFDEF ;OTHER TREATMENT @FAC (165.5,57.3) default
N OTH
S OTH=$P($G(^ONCO(165.5,D0,3)),U,25)
S OTHDF="",OTHDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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
N COC,PP
S COC=$E($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
S PP=$P($G(^ONCO(165.5,D0,3.1)),U,26)
S PPDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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 SGRP,SCOPE,TPG
S SCOPE=$P($G(^ONCO(165.5,D0,3)),U,40) I SCOPE="" Q
D SGROUP I TPG="" Q
S SCPDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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 SGRP,SOSN,TPG
S SOSN=$P($G(^ONCO(165.5,D0,3)),U,41) I SOSN="" Q
D SGROUP I TPG="" Q
S SOSNDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) 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
;
CLEANUP ;Cleanup
K CHEMDF,CHMDTDF,D0,DA,HTDF,HTDTDF,IMMDF,IMMDTDF,NUMDF,OTHDF,OTHDTDF
K PPDF,RADDF,RADDTDF,SCPDF,SCPDTDF,SOSNDF,SOSNDTDF,SPSDF,SPSDTDF,Y
K HTEPDF,HTEPDTDF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCC 7599 printed Apr 09, 2024@21:29:11 Page 2
ONCOCC ;HINES OIFO/GWB - CLASS OF CASE stuffing and @FAC defaults ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
+2 ;
+3 ;CLASS OF CASE (165.5,.04) = 38 (Dx by autopsy at reporting facility)
+4 NEW COC,NTX,PAUSE
+5 SET COC=$EXTRACT($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
+6 IF COC=38
Begin DoDot:1
+7 WRITE !?5,"CLASS OF CASE = 38 (Dx by autopsy at reporting facility)"
+8 WRITE !!?5,"All treatment fields will be stuffed with the appropriate"
+9 WRITE !?5,"value indicating no treatment.",!
+10 DO PAUSE
IF PAUSE[U
QUIT
+11 SET NTX=""
DO NTX^ONCNTX
+12 DO HDR^ONCNTX
+13 SET $PIECE(^ONCO(165.5,DA,3.1),U,26)=0
+14 SET $PIECE(^ONCO(165.5,DA,3.1),U,27)=0
+15 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,1)=0
+16 SET $PIECE(^ONCO(165.5,DA,"STS"),U,31)="00"
+17 SET $PIECE(^ONCO(165.5,DA,3.1),U,4)="0000"
+18 WRITE !,"PALLIATIVE CARE................: No palliative care"
+19 WRITE !,"PALLIATIVE CARE @FAC...........: No palliative care"
+20 WRITE !
+21 WRITE !,"PROTOCOL ELIGIBILITY STATUS....: Not available"
+22 WRITE !,"PROTOCOL PARTICIPATION.........: Not on/NA"
+23 WRITE !,"YEAR PUT ON PROTOCOL...........: 0000"
+24 WRITE !
+25 DO PAUSE
End DoDot:1
SET Y=$SELECT(PAUSE[U:"",ONCOANS="A":"@7",1:"@0")
+26 QUIT
+27 ;
PAUSE ;Enter RETURN to coninue" prompt
+1 WRITE !
READ "Enter RETURN to continue or '^' to exit: ",PAUSE:30
+2 IF PAUSE=""
QUIT
+3 IF PAUSE=U
QUIT
+4 GOTO PAUSE
+5 ;
DNTDEL ;Delete DATE OF NO TREATMENT (165.5,124)
+1 NEW TXDT
+2 IF $PIECE($GET(^ONCO(165.5,DA,2.1)),U,11)'=""
Begin DoDot:1
+3 SET TXDT=$PIECE(^ONCO(165.5,DA,2.1),U,11)_"N"
+4 SET $PIECE(^ONCO(165.5,DA,2.1),U,11)=""
+5 KILL ^ONCO(165.5,"ATX",DA,TXDT)
End DoDot:1
+6 QUIT
+7 ;
SATFDFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2) default
+1 NEW SGRP,SPS,TPG
+2 SET SPS=$PIECE($GET(^ONCO(165.5,D0,3)),U,38)
+3 DO SGROUP
IF TPG=""
QUIT
+4 IF (SPS="00")!(SPS=1)!($GET(^ONCO(164,SGRP,"SPS",SPS,0))["Unknown")
SET Y="@427"
QUIT
+5 SET SPSDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+6 SET SPSDF=$PIECE($GET(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
+7 if $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<2980000
SET SPSDF=""
End DoDot:1
QUIT
+8 QUIT
+9 ;
SATFDEF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7) default
+1 NEW SGRP,SPS,TPG
+2 SET SPS=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,29)
+3 IF SPS=""
QUIT
+4 DO SGROUP
IF TPG=""
QUIT
+5 IF (SPS="00")!(SPS=1)!($GET(^ONCO(164,SGRP,"SPS",SPS,0))["Unknown")
SET Y="@43"
QUIT
+6 SET (SPSDF,SPSDTDF)=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+7 SET SPSDF=$PIECE($GET(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
+8 SET SPSDTDF=$$GET1^DIQ(165.5,D0,50,"E")
+9 if $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<2980000
SET (SPSDF,SPSDTDF)=""
End DoDot:1
QUIT
+10 QUIT
+11 ;
RATFDEF ;RADIATION @FACILITY (165.5,51.4) default
+1 NEW RD,XX,YY
+2 SET RD=$PIECE($GET(^ONCO(165.5,D0,3)),U,6)
+3 SET RADDF=""
SET RADDTDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF RD'=""
Begin DoDot:2
+5 SET XX=$FIND(^DD(165.5,51.2,0),RD_":")
+6 SET YY=$FIND(^DD(165.5,51.2,0),";",XX)
+7 SET RADDF=$EXTRACT(^DD(165.5,51.2,0),XX,YY-2)
End DoDot:2
+8 SET RADDTDF=$PIECE($GET(^ONCO(165.5,D0,3)),U,4)
End DoDot:1
QUIT
+9 QUIT
+10 ;
CATFDEF ;CHEMOTHERAPY @FAC (165.5,53.3) default
+1 NEW CH
+2 SET CH=$PIECE($GET(^ONCO(165.5,D0,3)),U,13)
+3 SET CHEMDF=""
SET CHMDTDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF CH'=""
Begin DoDot:2
+5 SET XX=$FIND(^DD(165.5,53.2,0),CH_":")
+6 SET YY=$FIND(^DD(165.5,53.2,0),";",XX)
+7 SET CHEMDF=$EXTRACT(^DD(165.5,53.2,0),XX,YY-2)
End DoDot:2
+8 SET CHMDTDF=$PIECE($GET(^ONCO(165.5,D0,3)),U,11)
End DoDot:1
QUIT
+9 QUIT
+10 ;
HATFDEF ;HORMONE THERAPY @FAC (165.5,54.3) default
+1 NEW HT
+2 SET HT=$PIECE($GET(^ONCO(165.5,D0,3)),U,16)
+3 SET HTDF=""
SET HTDTDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF HT'=""
Begin DoDot:2
+5 SET XX=$FIND(^DD(165.5,54.2,0),HT_":")
+6 SET YY=$FIND(^DD(165.5,54.2,0),";",XX)
+7 SET HTDF=$EXTRACT(^DD(165.5,54.2,0),XX,YY-2)
End DoDot:2
+8 SET HTDTDF=$PIECE($GET(^ONCO(165.5,D0,3)),U,14)
End DoDot:1
QUIT
+9 QUIT
+10 ;
IATFDEF ;IMMUNOTHERAPY @FAC (165.5,55.3) default
+1 NEW IMM
+2 SET IMM=$PIECE($GET(^ONCO(165.5,D0,3)),U,19)
+3 SET IMMDF=""
SET IMMDTDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF IMM'=""
Begin DoDot:2
+5 SET XX=$FIND(^DD(165.5,55.2,0),IMM_":")
+6 SET YY=$FIND(^DD(165.5,55.2,0),";",XX)
+7 SET IMMDF=$EXTRACT(^DD(165.5,55.2,0),XX,YY-2)
End DoDot:2
+8 SET IMMDTDF=$PIECE($GET(^ONCO(165.5,D0,3)),U,17)
End DoDot:1
QUIT
+9 QUIT
+10 ;
HEATFDEF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2) default
+1 NEW HTEP
+2 SET HTEP=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,36)
+3 SET HTEPDF=""
SET HTEPDTDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF HTEP'=""
Begin DoDot:2
+5 SET HTEPDF=$SELECT(HTEP=1:"00",HTEP=2:10,HTEP=3:11,HTEP=4:12,HTEP=5:20,HTEP=6:30,HTEP=7:40,HTEP=8:82,HTEP=9:85,HTEP=10:86,HTEP=11:87,HTEP=12:88,HTEP=13:99,1:"")
+6 SET HTEPDTDF=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,35)
End DoDot:2
End DoDot:1
QUIT
+7 QUIT
+8 ;
OATFDEF ;OTHER TREATMENT @FAC (165.5,57.3) default
+1 NEW OTH
+2 SET OTH=$PIECE($GET(^ONCO(165.5,D0,3)),U,25)
+3 SET OTHDF=""
SET OTHDTDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF OTH'=""
Begin DoDot:2
+5 SET XX=$FIND(^DD(165.5,57.2,0),OTH_":")
+6 SET YY=$FIND(^DD(165.5,57.2,0),";",XX)
+7 SET OTHDF=$EXTRACT(^DD(165.5,57.2,0),XX,YY-2)
End DoDot:2
+8 SET OTHDTDF=$PIECE($GET(^ONCO(165.5,D0,3)),U,23)
End DoDot:1
QUIT
+9 QUIT
+10 ;
PATFDEF ;PALLIATIVE PROCEDURE @FAC (165.5,13) default
+1 NEW COC,PP
+2 SET COC=$EXTRACT($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
+3 SET PP=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,26)
+4 SET PPDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+5 IF PP'=""
Begin DoDot:2
+6 SET XX=$FIND(^DD(165.5,12,0),PP_":")
+7 SET YY=$FIND(^DD(165.5,12,0),";",XX)
+8 SET PPDF=$EXTRACT(^DD(165.5,12,0),XX,YY-2)
End DoDot:2
End DoDot:1
QUIT
+9 QUIT
+10 ;
SCOPER ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1) default
+1 NEW SGRP,SCOPE,TPG
+2 SET SCOPE=$PIECE($GET(^ONCO(165.5,D0,3)),U,40)
IF SCOPE=""
QUIT
+3 DO SGROUP
IF TPG=""
QUIT
+4 SET SCPDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+5 SET SCPDF=$PIECE($GET(^ONCO(164,SGRP,"SC5",SCOPE,0)),U,1)
End DoDot:1
QUIT
+6 QUIT
+7 ;
SCOPE ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5) default
+1 ;SCOPE OF LN SURGERY @FAC DATE (165.5,138.3) default
+2 NEW SCOPE
+3 SET SCOPE=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,31)
IF SCOPE=""
QUIT
+4 SET (SCPDF,SCPDTDF)=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+5 IF SCOPE'=""
Begin DoDot:2
+6 SET XX=$FIND(^DD(165.5,138.5,0),SCOPE_":")
+7 SET YY=$FIND(^DD(165.5,138.5,0),";",XX)
+8 SET SCPDF=$EXTRACT(^DD(165.5,138.5,0),XX,YY-2)
End DoDot:2
+9 SET SCPDTDF=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,22)
End DoDot:1
QUIT
+10 QUIT
+11 ;
NUMN ;NUMBER OF LN REMOVED @FAC (R) (165.5,140.1) default
+1 NEW NODES
+2 SET NODES=$PIECE($GET(^ONCO(165.5,D0,3)),U,42)
+3 SET NUMDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 SET NUMDF=NODES
+5 IF NUMDF="00"
SET NUMDF=NUMDF_" No nodes removed"
+6 IF NUMDF="90"
SET NUMDF=NUMDF_" 90 or more nodes removed"
+7 IF NUMDF="95"
SET NUMDF=NUMDF_" No nodes removed, aspiration performed"
+8 IF NUMDF="96"
SET NUMDF=NUMDF_" Node removal as a sampling, number unknown"
+9 IF NUMDF="97"
SET NUMDF=NUMDF_" Node removal as dissection, number unknown"
+10 IF NUMDF="98"
SET NUMDF=NUMDF_" Nodes surgically removed, number unknown"
+11 IF NUMDF="99"
SET NUMDF=NUMDF_" Unknown, not stated, death cert ONLY"
End DoDot:1
QUIT
+12 QUIT
+13 ;
SOSNR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1) default
+1 NEW SGRP,SOSN,TPG
+2 SET SOSN=$PIECE($GET(^ONCO(165.5,D0,3)),U,41)
IF SOSN=""
QUIT
+3 DO SGROUP
IF TPG=""
QUIT
+4 SET SOSNDF=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+5 SET SOSNDF=$PIECE($GET(^ONCO(164,SGRP,"SO5",SOSN,0)),U,1)
End DoDot:1
QUIT
+6 QUIT
+7 ;
SOSN ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5) default
+1 NEW SOSN
+2 SET SOSN=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,33)
IF SOSN=""
QUIT
+3 SET (SOSNDF,SOSNDTDF)=""
IF (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22)
Begin DoDot:1
+4 IF SOSN'=""
Begin DoDot:2
+5 SET XX=$FIND(^DD(165.5,139.5,0),SOSN_":")
+6 SET YY=$FIND(^DD(165.5,139.5,0),";",XX)
+7 SET SOSNDF=$EXTRACT(^DD(165.5,139.5,0),XX,YY-2)
End DoDot:2
+8 SET SOSNDTDF=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,24)
End DoDot:1
QUIT
+9 QUIT
+10 ;
SGROUP SET TPG=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TPG=""
QUIT
+1 SET SGRP=$PIECE($GET(^ONCO(164,TPG,0)),U,16)
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL CHEMDF,CHMDTDF,D0,DA,HTDF,HTDTDF,IMMDF,IMMDTDF,NUMDF,OTHDF,OTHDTDF
+2 KILL PPDF,RADDF,RADDTDF,SCPDF,SCPDTDF,SOSNDF,SOSNDTDF,SPSDF,SPSDTDF,Y
+3 KILL HTEPDF,HTEPDTDF
