ONCUTX1 ;HINES OIFO/RTK - UNKNOWN TREATMENT STUFFING; 09/09/10
;;2.2;ONCOLOGY;**1,5,15,20**;Jul 31, 2013;Build 5
;
NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
S $P(^ONCO(165.5,D0,3.1),U,5)="09"
S $P(^ONCO(165.5,D0,3.1),U,6)=9999999
S DR="58.4;58.5" D DIQ1^ONCNTX
W:$D(NTX) !,"SURG DX/STAGING PROC @FAC.....: "_ONC(165.5,DA,58.4,"E")
W !,"SURG DX/STAGING PROC @FAC DATE: "_ONC(165.5,DA,58.5,"E")
Q
;
SURATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
D SGRP
I $E(SGRP,3,4)=77 S SGRP=67422
F SPS=0:0 S SPS=$O(^ONCO(164,SGRP,"SPS",SPS)) Q:$P(^ONCO(164,SGRP,"SPS",SPS,0),U,1)["Unknown;"
S $P(^ONCO(165.5,DA,3.1),U,7)=$S(DATEDX>2971231:SPS,1:"00")
N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR=50.2 D EN^DIQ1
W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(R): "_ONC(165.5,DA,50.2,"E")
Q
;
SURATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
D SGRP
F SPS=0:0 S SPS=$O(^ONCO(164,SGRP,"SPS",SPS)) Q:$P(^ONCO(164,SGRP,"SPS",SPS,0),U,1)["Unknown;"
S $P(^ONCO(165.5,DA,3.1),U,30)=SPS
S $P(^ONCO(165.5,DA,3.1),U,8)=9999999
S $P(^ONCO(165.5,DA,2.3),U,4)=9
N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="58.7;50.3;234" D EN^DIQ1
W:$D(NTX) !,"RX HOSP--SURG PRIM SITE 03-2022..: "_ONC(165.5,DA,58.7,"E")
W !,"RX HOSP--SURG APP 2010.........: "_ONC(165.5,DA,234,"E")
W !,"MOST DEFINITIVE SURG @FAC DATE.: "_ONC(165.5,DA,50.3,"E")
Q
;
NODATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
D SGRP
I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S SGRP=67141
F SC=0:0 S SC=$O(^ONCO(164,SGRP,"SC5",SC)) Q:SC="B" S LAST=SC
S $P(^ONCO(165.5,DA,3.1),U,9)=LAST
S $P(^ONCO(165.5,D0,3.1),U,11)=99
N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="138.1;140.1" D DIQ1^ONCNTX
W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(R): "_ONC(165.5,DA,138.1,"E")
W !,"NUMBER OF LN REMOVED @FAC...(R): "_ONC(165.5,DA,140.1,"E")
Q
;
NODEATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
D SGRP
S $P(^ONCO(165.5,DA,3.1),U,32)=9
S $P(^ONCO(165.5,DA,3.1),U,23)="0000000"
N DI K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="138.5;138.3" D DIQ1^ONCNTX
W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(F): "_ONC(165.5,DA,138.5,"E")
W !,"SCOPE OF LN SURGERY @FAC DATE..: "_ONC(165.5,DA,138.3,"E")
Q
;
SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
D SGRP
F SO=0:0 S SO=$O(^ONCO(164,SGRP,"SO5",SO)) Q:SO="B" S LAST=SO
S $P(^ONCO(165.5,DA,3.1),U,10)=$S(DATEDX>2971231:LAST,1:"")
S DR=139.1 D DIQ1^ONCNTX
W:$D(NTX) !,"SURG PROC/OTHER SIT @FAC...(R): "_ONC(165.5,DA,139.1,"E")
Q
;
SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
S $P(^ONCO(165.5,DA,3.1),U,34)=9
S $P(^ONCO(165.5,D0,3.1),U,25)=9999999
S DR="139.5;139.3" D DIQ1^ONCNTX
W:$D(NTX) !,"SURGICAL PROC/OTHER SITE @FAC..: "_ONC(165.5,DA,139.5,"E")
W !,"SURG PROC/OTHER SITE @FAC DATE.: "_ONC(165.5,DA,139.3,"E")
Q
;
RADATF ;RADIATION @FAC (165.5,51.4)
S $P(^ONCO(165.5,DA,3.1),U,12)=9
S $P(^ONCO(165.5,DA,3.1),U,13)=9999999
S DR="51.4;51.5" D DIQ1^ONCNTX
W:$D(NTX) !,"RADIATION @FAC.................: "_ONC(165.5,DA,51.4,"E")
W !,"RADIATION @FAC DATE............: ",ONC(165.5,DA,51.5,"E")
Q
;
CHEMATF ;CHEMOTHERAPY @FAC (165.5,53.3)
I $G(XX)=88 D
.S $P(^ONCO(165.5,DA,3.1),U,14)=88
.S $P(^ONCO(165.5,DA,3.1),U,15)=8888888
I $G(XX)=99 D
.S $P(^ONCO(165.5,DA,3.1),U,14)=99
.S $P(^ONCO(165.5,DA,3.1),U,15)=9999999
S DR="53.3;53.4" D DIQ1^ONCNTX
W:$D(NTX) !,"CHEMOTHERAPY @FAC..............: "_ONC(165.5,DA,53.3,"E")
W !,"CHEMOTHERAPY @FAC DATE.........: ",ONC(165.5,DA,53.4,"E")
Q
;
HTATF ;HORMONE THERAPY @FAC (165.5,54.3)
I $G(XX)=88 D
.S $P(^ONCO(165.5,DA,3.1),U,16)=88
.S $P(^ONCO(165.5,DA,3.1),U,17)=8888888
I $G(XX)=99 D
.S $P(^ONCO(165.5,DA,3.1),U,16)=99
.S $P(^ONCO(165.5,DA,3.1),U,17)=9999999
S DR="54.3;54.4" D DIQ1^ONCNTX
W:$D(NTX) !,"HORMONE THERAPY @FAC...........: "_ONC(165.5,DA,54.3,"E")
W !,"HORMONE THERAPY @FAC DATE......: ",ONC(165.5,DA,54.4,"E")
Q
;
IMMATF ;IMMUNOTHERAPY @FAC (165.5,55.3)
I $G(XX)=88 D
.S $P(^ONCO(165.5,DA,3.1),U,18)=88
.S $P(^ONCO(165.5,DA,3.1),U,19)=8888888
I $G(XX)=99 D
.S $P(^ONCO(165.5,DA,3.1),U,18)=99
.S $P(^ONCO(165.5,DA,3.1),U,19)=9999999
S DR="55.3;55.4" D DIQ1^ONCNTX
W:$D(NTX) !,"IMMUNOTHERAPY @FAC.............: "_ONC(165.5,DA,55.3,"E")
W !,"IMMUNOTHERAPY @FAC DATE........: ",ONC(165.5,DA,55.4,"E")
Q
;
HTEPATF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2)
I $G(XX)=88 D
.S $P(^ONCO(165.5,DA,3.2),U,2)=88
.S $P(^ONCO(165.5,DA,3.2),U,3)=8888888
I $G(XX)=99 D
.S $P(^ONCO(165.5,DA,3.2),U,2)=99
.S $P(^ONCO(165.5,DA,3.2),U,3)=9999999
S DR="153.2;153.3" D DIQ1^ONCNTX
W:$D(NTX) !,"HEMA TRANS/ENDOCRINE PROC @FAC.............: "_ONC(165.5,DA,153.2,"E")
W !,"HEMA TRANS/ENDOCRINE @FAC DATE........: ",ONC(165.5,DA,153.3,"E")
Q
;
OTHATF ;OTHER TREATMENT @FAC (165.5,57.3)
I $G(X)'=8 S $P(^ONCO(165.5,DA,3.1),U,20)=9
S $P(^ONCO(165.5,DA,3.1),U,21)=9999999
S DR="57.3;57.4" D DIQ1^ONCNTX
W:$D(NTX) !,"OTHER TREATMENT @FAC...........: "_ONC(165.5,DA,57.3,"E")
W !,"OTHER TREATMENT @FAC DATE......: ",ONC(165.5,DA,57.4,"E")
Q
;
CHKPRIM ;If Primary Site UNKNOWN, BRAIN, HEMATOPOIETIC or LEUKEMIA,
;stuff SCOPE OF LN SURGERY (R) (165.5,138) and
; SCOPE OF LN SURGERY (F) (165.5,138.4) with 9s
CHKPRMR ;ROADS
S SITE=$P(^ONCO(165.5,DA,0),U,1)
I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D
.D SGRP
.I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S SGRP=67141
.F SC=0:0 S SC=$O(^ONCO(164,SGRP,"SC5",SC)) Q:SC="B" S LAST=SC
.S $P(^ONCO(165.5,DA,3),U,40)=LAST
.W !,"SCOPE OF LN SURGERY.........(R): ",$P(^ONCO(164,SGRP,"SC5",LAST,0),U)
.D NODER^ONCUTX W !
.S NTX=1 D NODATFR K NTX
.S Y="@139"
Q
;
CHKPRMF ;SCOPE OF LN SURGERY (F) (165.5,138.4) Code 9 stuffing
;FORDS pages 138-139
S TOP=$P($G(^ONCO(165.5,DA,2)),U,1)
S MO=$$HIST^ONCFUNC(DA)
I ($E(TOP,1,4)=6770)!($E(TOP,1,4)=6771)!($E(TOP,1,4)=6772)!($E(TOP,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&($E(TOP,1,4)=6777))!($E(TOP,1,4)=6776)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!((MO'<97310)&(MO'>99899)) D
.S $P(^ONCO(165.5,DA,3.1),U,31)=9
.W !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
.D NODE^ONCUTX W !
.S NTX=1 D NODEATF K NTX
.S Y="@46"
Q
;
SGRP S TPG=$P($G(^ONCO(165.5,D0,2)),U,1)
S SGRP=$P($G(^ONCO(164,TPG,0)),U,16)
;pre-2003 C76.0-C76.8, C80.9 cases
;see ROADS page D-cxliii
I DATEDX<3030000,($E(TPG,3,4)=76)!(TPG=67809) S SGRP=67141
Q
;
CLEANUP ;Cleanup
K D0,DA,DATEDX,DIC,DIQ,DR,LAST,MO,SC,SGRP,SITE,SO,SPS,TOP,TPG,X,XX,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCUTX1 6725 printed Dec 13, 2024@02:29:11 Page 2
ONCUTX1 ;HINES OIFO/RTK - UNKNOWN TREATMENT STUFFING; 09/09/10
+1 ;;2.2;ONCOLOGY;**1,5,15,20**;Jul 31, 2013;Build 5
+2 ;
NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
+1 SET $PIECE(^ONCO(165.5,D0,3.1),U,5)="09"
+2 SET $PIECE(^ONCO(165.5,D0,3.1),U,6)=9999999
+3 SET DR="58.4;58.5"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"SURG DX/STAGING PROC @FAC.....: "_ONC(165.5,DA,58.4,"E")
+5 WRITE !,"SURG DX/STAGING PROC @FAC DATE: "_ONC(165.5,DA,58.5,"E")
+6 QUIT
+7 ;
SURATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
+1 DO SGRP
+2 IF $EXTRACT(SGRP,3,4)=77
SET SGRP=67422
+3 FOR SPS=0:0
SET SPS=$ORDER(^ONCO(164,SGRP,"SPS",SPS))
if $PIECE(^ONCO(164,SGRP,"SPS",SPS,0),U,1)["Unknown;"
QUIT
+4 SET $PIECE(^ONCO(165.5,DA,3.1),U,7)=$SELECT(DATEDX>2971231:SPS,1:"00")
+5 NEW DI
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+6 SET DR=50.2
DO EN^DIQ1
+7 if $DATA(NTX)
WRITE !,"SURGERY OF PRIMARY @FAC.....(R): "_ONC(165.5,DA,50.2,"E")
+8 QUIT
+9 ;
SURATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
+1 DO SGRP
+2 FOR SPS=0:0
SET SPS=$ORDER(^ONCO(164,SGRP,"SPS",SPS))
if $PIECE(^ONCO(164,SGRP,"SPS",SPS,0),U,1)["Unknown;"
QUIT
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,30)=SPS
+4 SET $PIECE(^ONCO(165.5,DA,3.1),U,8)=9999999
+5 SET $PIECE(^ONCO(165.5,DA,2.3),U,4)=9
+6 NEW DI
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+7 SET DR="58.7;50.3;234"
DO EN^DIQ1
+8 if $DATA(NTX)
WRITE !,"RX HOSP--SURG PRIM SITE 03-2022..: "_ONC(165.5,DA,58.7,"E")
+9 WRITE !,"RX HOSP--SURG APP 2010.........: "_ONC(165.5,DA,234,"E")
+10 WRITE !,"MOST DEFINITIVE SURG @FAC DATE.: "_ONC(165.5,DA,50.3,"E")
+11 QUIT
+12 ;
NODATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
+1 DO SGRP
+2 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
SET SGRP=67141
+3 FOR SC=0:0
SET SC=$ORDER(^ONCO(164,SGRP,"SC5",SC))
if SC="B"
QUIT
SET LAST=SC
+4 SET $PIECE(^ONCO(165.5,DA,3.1),U,9)=LAST
+5 SET $PIECE(^ONCO(165.5,D0,3.1),U,11)=99
+6 NEW DI
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+7 SET DR="138.1;140.1"
DO DIQ1^ONCNTX
+8 if $DATA(NTX)
WRITE !,"SCOPE OF LN SURGERY @FAC....(R): "_ONC(165.5,DA,138.1,"E")
+9 WRITE !,"NUMBER OF LN REMOVED @FAC...(R): "_ONC(165.5,DA,140.1,"E")
+10 QUIT
+11 ;
NODEATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
+1 DO SGRP
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,32)=9
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,23)="0000000"
+4 NEW DI
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+5 SET DR="138.5;138.3"
DO DIQ1^ONCNTX
+6 if $DATA(NTX)
WRITE !,"SCOPE OF LN SURGERY @FAC....(F): "_ONC(165.5,DA,138.5,"E")
+7 WRITE !,"SCOPE OF LN SURGERY @FAC DATE..: "_ONC(165.5,DA,138.3,"E")
+8 QUIT
+9 ;
SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
+1 DO SGRP
+2 FOR SO=0:0
SET SO=$ORDER(^ONCO(164,SGRP,"SO5",SO))
if SO="B"
QUIT
SET LAST=SO
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,10)=$SELECT(DATEDX>2971231:LAST,1:"")
+4 SET DR=139.1
DO DIQ1^ONCNTX
+5 if $DATA(NTX)
WRITE !,"SURG PROC/OTHER SIT @FAC...(R): "_ONC(165.5,DA,139.1,"E")
+6 QUIT
+7 ;
SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,34)=9
+2 SET $PIECE(^ONCO(165.5,D0,3.1),U,25)=9999999
+3 SET DR="139.5;139.3"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"SURGICAL PROC/OTHER SITE @FAC..: "_ONC(165.5,DA,139.5,"E")
+5 WRITE !,"SURG PROC/OTHER SITE @FAC DATE.: "_ONC(165.5,DA,139.3,"E")
+6 QUIT
+7 ;
RADATF ;RADIATION @FAC (165.5,51.4)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,12)=9
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,13)=9999999
+3 SET DR="51.4;51.5"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"RADIATION @FAC.................: "_ONC(165.5,DA,51.4,"E")
+5 WRITE !,"RADIATION @FAC DATE............: ",ONC(165.5,DA,51.5,"E")
+6 QUIT
+7 ;
CHEMATF ;CHEMOTHERAPY @FAC (165.5,53.3)
+1 IF $GET(XX)=88
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,14)=88
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,15)=8888888
End DoDot:1
+4 IF $GET(XX)=99
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,14)=99
+6 SET $PIECE(^ONCO(165.5,DA,3.1),U,15)=9999999
End DoDot:1
+7 SET DR="53.3;53.4"
DO DIQ1^ONCNTX
+8 if $DATA(NTX)
WRITE !,"CHEMOTHERAPY @FAC..............: "_ONC(165.5,DA,53.3,"E")
+9 WRITE !,"CHEMOTHERAPY @FAC DATE.........: ",ONC(165.5,DA,53.4,"E")
+10 QUIT
+11 ;
HTATF ;HORMONE THERAPY @FAC (165.5,54.3)
+1 IF $GET(XX)=88
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,16)=88
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,17)=8888888
End DoDot:1
+4 IF $GET(XX)=99
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,16)=99
+6 SET $PIECE(^ONCO(165.5,DA,3.1),U,17)=9999999
End DoDot:1
+7 SET DR="54.3;54.4"
DO DIQ1^ONCNTX
+8 if $DATA(NTX)
WRITE !,"HORMONE THERAPY @FAC...........: "_ONC(165.5,DA,54.3,"E")
+9 WRITE !,"HORMONE THERAPY @FAC DATE......: ",ONC(165.5,DA,54.4,"E")
+10 QUIT
+11 ;
IMMATF ;IMMUNOTHERAPY @FAC (165.5,55.3)
+1 IF $GET(XX)=88
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,18)=88
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,19)=8888888
End DoDot:1
+4 IF $GET(XX)=99
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,18)=99
+6 SET $PIECE(^ONCO(165.5,DA,3.1),U,19)=9999999
End DoDot:1
+7 SET DR="55.3;55.4"
DO DIQ1^ONCNTX
+8 if $DATA(NTX)
WRITE !,"IMMUNOTHERAPY @FAC.............: "_ONC(165.5,DA,55.3,"E")
+9 WRITE !,"IMMUNOTHERAPY @FAC DATE........: ",ONC(165.5,DA,55.4,"E")
+10 QUIT
+11 ;
HTEPATF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2)
+1 IF $GET(XX)=88
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,DA,3.2),U,2)=88
+3 SET $PIECE(^ONCO(165.5,DA,3.2),U,3)=8888888
End DoDot:1
+4 IF $GET(XX)=99
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.2),U,2)=99
+6 SET $PIECE(^ONCO(165.5,DA,3.2),U,3)=9999999
End DoDot:1
+7 SET DR="153.2;153.3"
DO DIQ1^ONCNTX
+8 if $DATA(NTX)
WRITE !,"HEMA TRANS/ENDOCRINE PROC @FAC.............: "_ONC(165.5,DA,153.2,"E")
+9 WRITE !,"HEMA TRANS/ENDOCRINE @FAC DATE........: ",ONC(165.5,DA,153.3,"E")
+10 QUIT
+11 ;
OTHATF ;OTHER TREATMENT @FAC (165.5,57.3)
+1 IF $GET(X)'=8
SET $PIECE(^ONCO(165.5,DA,3.1),U,20)=9
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,21)=9999999
+3 SET DR="57.3;57.4"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"OTHER TREATMENT @FAC...........: "_ONC(165.5,DA,57.3,"E")
+5 WRITE !,"OTHER TREATMENT @FAC DATE......: ",ONC(165.5,DA,57.4,"E")
+6 QUIT
+7 ;
CHKPRIM ;If Primary Site UNKNOWN, BRAIN, HEMATOPOIETIC or LEUKEMIA,
+1 ;stuff SCOPE OF LN SURGERY (R) (165.5,138) and
+2 ; SCOPE OF LN SURGERY (F) (165.5,138.4) with 9s
CHKPRMR ;ROADS
+1 SET SITE=$PIECE(^ONCO(165.5,DA,0),U,1)
+2 IF (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1)
Begin DoDot:1
+3 DO SGRP
+4 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
SET SGRP=67141
+5 FOR SC=0:0
SET SC=$ORDER(^ONCO(164,SGRP,"SC5",SC))
if SC="B"
QUIT
SET LAST=SC
+6 SET $PIECE(^ONCO(165.5,DA,3),U,40)=LAST
+7 WRITE !,"SCOPE OF LN SURGERY.........(R): ",$PIECE(^ONCO(164,SGRP,"SC5",LAST,0),U)
+8 DO NODER^ONCUTX
WRITE !
+9 SET NTX=1
DO NODATFR
KILL NTX
+10 SET Y="@139"
End DoDot:1
+11 QUIT
+12 ;
CHKPRMF ;SCOPE OF LN SURGERY (F) (165.5,138.4) Code 9 stuffing
+1 ;FORDS pages 138-139
+2 SET TOP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
+3 SET MO=$$HIST^ONCFUNC(DA)
+4 IF ($EXTRACT(TOP,1,4)=6770)!($EXTRACT(TOP,1,4)=6771)!($EXTRACT(TOP,1,4)=6772)!(...
... $EXTRACT(TOP,1,4)=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&($EXTRACT(TOP,1,4)=6777))!($EXTRACT(TOP,1,4)=6776)!(TOP=67809)!(TOP=67420)!(TOP=67421)!(TOP=67423)!(TOP=67424)!((MO'<97310)&(MO'>99899))
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=9
+6 WRITE !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
+7 DO NODE^ONCUTX
WRITE !
+8 SET NTX=1
DO NODEATF
KILL NTX
+9 SET Y="@46"
End DoDot:1
+10 QUIT
+11 ;
SGRP SET TPG=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+1 SET SGRP=$PIECE($GET(^ONCO(164,TPG,0)),U,16)
+2 ;pre-2003 C76.0-C76.8, C80.9 cases
+3 ;see ROADS page D-cxliii
+4 IF DATEDX<3030000
IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)
SET SGRP=67141
+5 QUIT
+6 ;
CLEANUP ;Cleanup
+1 KILL D0,DA,DATEDX,DIC,DIQ,DR,LAST,MO,SC,SGRP,SITE,SO,SPS,TOP,TPG,X,XX,Y
