- 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 Jan 18, 2025@03:30:21 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