ONCNTX ;HINES OIFO/GWB - No treatment stuffing ;03/31/11
;;2.2;ONCOLOGY;**1,6,10,15,20**;Jul 31, 2013;Build 5
;
NTX ;No treatment stuffing
N COC,PAUSE
S COC=$E($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
;ROADS
N SITE
S SITE=$P(^ONCO(165.5,DA,0),U,1)
I DATEDX<3030000 D
.D HDR,SURR,SURATFR^ONCNTX1,NODER
.I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D NODATFR^ONCUTX1
.E D NODATFR^ONCNTX1
.D SOSNR,SOSATFR^ONCNTX1
.W ! D PAUSE
;
;FORDS
D HDR
S TP=$P($G(^ONCO(165.5,DA,2)),U,1)
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,38)_"S0"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3.1),U,38)="0000000"
S ^ONCO(165.5,"ATX",DA,"0000000S0")=""
;D SUR,SURATF^ONCNTX1,SA,SM,NODE
D SUR,SURATF^ONCNTX1,SA,SM
;Code 9 (FORDS 138-139)
N MO S MO=$$HIST^ONCFUNC(DA)
N TP14 S TP14=$E(TP,1,4)
I (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899)) D NODEATF^ONCUTX1
E W "" ;D NODEATF^ONCNTX1
D SOSN,SOSNATF^ONCNTX1,RR,DSD
D RFNS W ! S Y=138.4 Q
;
NTXCONT S $P(^ONCO(165.5,DA,3),U,6)=0
S $P(^ONCO(165.5,DA,3.1),U,12)=0
;S $P(^ONCO(165.5,DA,3),U,35)=""
D HDR,RAD1,RADATF^ONCNTX1,RAD2,RSSQ^ONCNTX1,RFNR W !
;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,25)=0
S $P(^ONCO(165.5,DA,3.1),U,20)=0
D HDR,CHE,CHEMATF^ONCNTX1,HOR^ONCNTX1,HTATF^ONCNTX1,IMM^ONCNTX1,IMMATF^ONCNTX1,HTEP^ONCNTX1,HTEPATF^ONCNTX1,SSS^ONCNTX1
D PAUSE
D HDR,OTH^ONCNTX1,OTHATF^ONCNTX1
W !
D PAUSE
;
W ! S Y="@425" G EXIT
;
SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
S $P(^ONCO(165.5,DA,3),U,38)=$S(DATEDX>2971231:1,1:"00")
S $P(^ONCO(165.5,DA,3),U,34)=1
S DR="58.2;74" D DIQ1
I $D(NTX) D
.;W !,"SURGICAL PROCEDURES (R)=ROADS"
.;W !,"-----------------------------"
.W !,"SURGERY OF PRIMARY..........(R): ",ONC(165.5,DA,58.2,"E")
W !,"SURGICAL APPROACH...........(R): ",ONC(165.5,DA,74,"E")
K ONC
Q
;
SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1)
N TOPSRCDZ S TOPSRCDZ=$P($G(^ONCO(164,TOPX,0)),U,16)
I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D G SUR1
.S $P(^ONCO(165.5,DA,3.1),U,29)=1
S $P(^ONCO(165.5,DA,3.1),U,29)=$S(DATEDX>2971231:1,1:"00")
I DATEDX>3221231 D
.S $P(^ONCO(165.5,DA,3.2),U,9)="A000"
.I TOPSRCDZ=67440 S $P(^ONCO(165.5,DA,3.2),U,9)="B000"
.I (TOPSRCDZ=67420)!(TOPSRCDZ=67760) S $P(^ONCO(165.5,DA,3.2),U,9)="A980"
.Q
SUR1 S TXDT=$P($G(^ONCO(165.5,DA,3)),U,1)_"S1"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,1)="0000000" D SPSDT^ONCATF
S ^ONCO(165.5,"ATX",DA,"0000000S1")=""
S $P(^ONCO(165.5,DA,3),U,28)=8
;S $P(^ONCO(165.5,DA,0),U,11)="00000000"
S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
S $P(^ONCO(165.5,DA,3.1),U,28)=0
S DR="58.6:58.9;50;74;59;435;14;170" D DIQ1
I $D(NTX) D
.;W !,"SURGICAL PROCEDURES (F)=FORDS"
.;W !,"-----------------------------"
.W !,"DATE FIRST SURGICAL PROCEDURE..: ",ONC(165.5,DA,170,"E")
.W:DATEDX<3230000 !,"RX SUMM--SURG PRIMSITE 03-2022.: ",ONC(165.5,DA,58.6,"E")
.W:DATEDX>3221231 !,"RX SUMM--SURG PRIM SITE 2023...: ",ONC(165.5,DA,58.9,"E")
W !,"MOST DEFINITIVE SURG DATE......: ",ONC(165.5,DA,50,"E")
K ONC,TXDT,TOPX
Q
;
SA ;APPROACH (165.5,234)
;Q:DATEDX<3100000
;S $P(^ONCO(165.5,DA,2.3),U,4)=0
;S DR=234 D DIQ1
;W !,"APPROACH.......................: ",ONC(165.5,DA,234,"E")
Q
;
SM ;SURGICAL MARGINS (165.5,59)
N HST14,MO,TPG
S TPG=$P($G(^ONCO(165.5,DA,2)),U,1)
S MO=$$HIST^ONCFUNC(DA)
S HST14=$E(MO,1,4)
S $P(^ONCO(165.5,DA,3),U,28)=8
I $$LYMPH^ONCFUNC(DA),($E(TPG,3,4)=77) S $P(^ONCO(165.5,DA,3),U,28)=9
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
I $$HEMATO^ONCFUNC(DA) S $P(^ONCO(165.5,DA,3),U,28)=9
S DR="59" D DIQ1
W !,"SURGICAL MARGINS...............: ",ONC(165.5,DA,59,"E")
K ONC
Q
;
NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
;For unknown primary, leukemia, lymphoma, & brain, code 9
N LAST,SC,SGRP,SITE
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 NUMND^ONCATF Q
.D SGRP^ONCUTX1
.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,1)
.D NODER^ONCUTX
S $P(^ONCO(165.5,DA,3),U,40)=1
S $P(^ONCO(165.5,DA,3),U,42)="00"
D NUMND^ONCATF
S DR="138;140" D DIQ1
W:$D(NTX) !,"SCOPE OF LN SURGERY.........(R): ",ONC(165.5,DA,138,"E")
W !,"NUMBER OF LN REMOVED........(R): ",ONC(165.5,DA,140,"E")
Q
;
NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
;Code 9 (FORDS 138-139)
S TP=$P($G(^ONCO(165.5,DA,2)),U,1)
N TP14 S TP14=$E(TP,1,4)
N MO S MO=$$HIST^ONCFUNC(DA)
I (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899)) D D SCPDT^ONCATF Q
.S $P(^ONCO(165.5,DA,3.1),U,31)=9
.W !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
.D NODE^ONCUTX
S $P(^ONCO(165.5,DA,3.1),U,31)=0
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,22)_"S2"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,D0,3.1),U,22)="0000000" D SCPDT^ONCATF
S ^ONCO(165.5,"ATX",DA,"0000000S2")=""
S DR="138.4;138.2" D DIQ1
W:$D(NTX) !,"SCOPE OF LN SURGERY.........(F): ",ONC(165.5,DA,138.4,"E")
W !,"SCOPE OF LN SURGERY DATE.......: ",ONC(165.5,DA,138.2,"E")
Q
;
SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
S $P(^ONCO(165.5,DA,3),U,41)=1
S DR=139 D DIQ1
W:$D(NTX) !,"SURG PROC/OTHER SITE........(R): ",ONC(165.5,DA,139,"E")
Q
;
SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
S $P(^ONCO(165.5,DA,3.1),U,33)=0
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,24)_"S3"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,D0,3.1),U,24)="0000000" D SOSNDT^ONCATF
S ^ONCO(165.5,"ATX",DA,"0000000S3")=""
S DR="139.4;139.2" D DIQ1
W:$D(NTX) !,"SURG PROC/OTHER SITE........(F): ",ONC(165.5,DA,139.4,"E")
W !,"SURG PROC/OTHER SITE DATE......: ",ONC(165.5,DA,139.2,"E")
Q
;
RR ;RECONSTRUCTION/RESTORATION (165.5,23)
I DATEDX>3021231 Q
I DATEDX>2951231 D
.S $P(^ONCO(165.5,DA,3),U,33)=$S(DATEDX>2971231:1,1:9)
.S DR=23 D DIQ1
.W !,"RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,DA,23,"E")
Q
;
DSD ;DATE OF SURGICAL DISCHARGE (165.5,435)
;READMISSION W/I 30 DAYS/SURG (165.5,14)
S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
S $P(^ONCO(165.5,DA,3.1),U,28)=0
S $P(^ONCO(165.5,DA,7),U,19)=9
S $P(^ONCO(165.5,DA,7),U,20)=""
S DR="435;14;46" D DIQ1
W !,"DATE OF SURGICAL DISCHARGE.....: ",ONC(165.5,DA,435,"E")
W !,"READMISSION W/I 30 DAYS/SURG...: ",ONC(165.5,DA,14,"E")
W !,"CAP PROTOCOL REVIEW............: ",ONC(165.5,DA,46,"E")
K ONC
Q
;
RFNS ;REASON NO SURGERY OF PRIMARY (165.5,58)
I $D(NTX) W ! D Q
.N DIE,DR,DP,DL,DQ
.S DIE="^ONCO(165.5,",DR=58 D ^DIE
N RFNS
S RFNS=$$GET1^DIQ(165.5,DA,1.2)
I (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only") D Q
.S $P(^ONCO(165.5,DA,3),U,26)=9
.W !,"REASON NO SURGERY OF PRIMARY...: Unknown"
S RFNSDD=$P(^DD(165.5,58,0),U,3)
W ! K DIR S DIR(0)="SA^"_RFNSDD
S DIR("A")="REASON NO SURGERY OF PRIMARY: "
;S DIR("B")="Not part of 1st course"
S DIR("??")="^D RFNSHLP^ONCNTX1"
D ^DIR
I Y[U Q
S $P(^ONCO(165.5,DA,3),U,26)=Y
K RFNSDD Q
;
RAD1 ;RADIATION (165.5,51.2)
N RFNR
S RFNR=$P($G(^ONCO(165.5,DA,3)),U,35)
D ^ONCRFNR
S DR="51.2;51" D DIQ1
W:$D(NTX) !,"RADIATION:.....................: ",ONC(165.5,DA,51.2,"E")
W !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
K ONC,TXDT Q
;
RAD2 ;RADIATION (cont)
I $P($G(^ONCO(165.5,DA,0)),"^",16)<3180000 D
.S $P(^ONCO(165.5,DA,3),U,21)=1
.S $P(^ONCO(165.5,DA,"BLA2"),U,18)=1
.S $P(^ONCO(165.5,DA,"THY1"),U,43)=0
.S $P(^ONCO(165.5,DA,24),U,9)=1
.S $P(^ONCO(165.5,DA,"THY1"),U,44)=0
.S $P(^ONCO(165.5,DA,3),U,20)=0
S $P(^ONCO(165.5,DA,3),U,22)=0
S $P(^ONCO(165.5,DA,"BLA2"),U,16)="0000000"
S DR="126;125;363;442;363.1;443;56;361" D DIQ1
W !,"LOCATION OF RADIATION..........: ",ONC(165.5,DA,126,"E")
I $P($G(^ONCO(165.5,DA,0)),"^",16)<3180000 D
.W !,"RADIATION TREATMENT VOLUME.....: ",ONC(165.5,DA,125,"E")
.W !,"REGIONAL TREATMENT MODALITY....: ",ONC(165.5,DA,363,"E")
.W !,"REGIONAL DOSE:cGy..............: ",ONC(165.5,DA,442,"E")
.W !,"BOOST TREATMENT MODALITY.......: ",ONC(165.5,DA,363.1,"E")
.W !,"BOOST DOSE:cGy.................: ",ONC(165.5,DA,443,"E")
.W !,"NUMBER OF TREATMENTS...........: ",ONC(165.5,DA,56,"E")
I $P($G(^ONCO(165.5,DA,0)),"^",16)>3171231 D
.S $P(^ONCO(165.5,D0,"RAD18"),"^",4)=1
.D RADSTF^ONCOAIP2
.S $P(^ONCO(165.5,DA,"NCR18B"),U,1)="00"
.S $P(^ONCO(165.5,DA,"NCR18B"),U,2)="00"
.S $P(^ONCO(165.5,DA,"NCR18B"),U,3)="000000"
.W !,"NUMBER OF PHASES RAD TX..............: 00"
.W !,"RADIATION TREATMENT DISC EARLY.......: 00"
.W !,"TOTAL DOSE...........................: 000000"
.S $P(^ONCO(165.5,D0,3),"^",7)=0 ; SET RAD/SURG SEQUENCE = 0
.;S $P(^ONCO(165.5,D0,3),"^",35)="" ; CLEAR REASON FOR NO RAD FIELD
W !,"DATE RADIATION ENDED...........: ",ONC(165.5,DA,361,"E")
I $P($G(^ONCO(165.5,DA,0)),"^",16)>3171231 W !
K ONC,TXDT Q
;
RFNR ;REASON FOR NO RADIATION (165.5,75)
I $D(NTX) W ! D Q
.N DIE,DL,DP,DQ,DR
.S DIE="^ONCO(165.5,",DR=75 D ^DIE
N RFNS
S RFNS=$$GET1^DIQ(165.5,DA,1.2)
I (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only") D Q
.S $P(^ONCO(165.5,DA,3),U,35)=9
.W !,"REASON NO SURGERY OF PRIMARY...: Unknown"
S RFNRDD=$P(^DD(165.5,75,0),U,3)
W ! K DIR S DIR(0)="SA^"_RFNRDD
S DIR("A")="REASON FOR NO RADIATION: "
S DIR("B")="Not part of 1st course"
S DIR("??")="^D RFNRHLP^ONCNTX1"
D ^DIR
I Y[U Q
S $P(^ONCO(165.5,DA,3),U,35)=Y
I X=8 S RFNR=8 D ^ONCRFNR D
.W !!,"DATE RADIATION STARTED changed to 88/88/8888"
K RFNRDD Q
;
CHE ;CHEMOTHERAPY (165.5,53.2)
I $D(NTX) D
.N DIE,DL,DP,DQ,DR
.S DIE="^ONCO(165.5,",DR=53.2 D ^DIE
S TXDT=$P(^ONCO(165.5,DA,3),U,11)_"C"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,11)="0000000" D CHEMDT^ONCATF1
S ^ONCO(165.5,"ATX",DA,"0000000C")=""
F CMX=28,29,30,44,45 S $P(^ONCO(165.5,DA,"LUN2"),U,CMX)="" K CMX
S DR=53 D DIQ1
W !,"CHEMOTHERAPY DATE.............: ",ONC(165.5,DA,53,"E")
K ONC Q
;
NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
S $P(^ONCO(165.5,D0,3),U,31)="0000000" D NCDSDT^ONCATF
S DR=58.3 D DIQ1
W !,"SURGICAL DX/STAGING PROC DATE: ",ONC(165.5,DA,58.3,"E")
Q
;
HDR K DASH S $P(DASH,"-",80)="-"
W @IOF,DASH,!,?1,PATNAM,?TAB,"First Course of Treatment",?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASH
K DASH
Q
;
DIQ1 N DIC,DIQ K ONC
S DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E" D EN^DIQ1
Q
;
PAUSE ;"Enter RETURN to continue" prompt
W ! R "Enter RETURN to continue: ",PAUSE:30
I PAUSE="" Q
I PAUSE=U Q
G PAUSE
;
EXIT ;Exit
W !
K TP,TPG
Q
;
CLEANUP ;Cleanup
K D0,DA,DATEDX,NTX,PATNAM,SITEGP,SITTAB,SSN,TAB,TOPCOD,TOPNAM,TOPTAB,X
K Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCNTX 11541 printed Dec 13, 2024@02:24:06 Page 2
ONCNTX ;HINES OIFO/GWB - No treatment stuffing ;03/31/11
+1 ;;2.2;ONCOLOGY;**1,6,10,15,20**;Jul 31, 2013;Build 5
+2 ;
NTX ;No treatment stuffing
+1 NEW COC,PAUSE
+2 SET COC=$EXTRACT($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
+3 ;ROADS
+4 NEW SITE
+5 SET SITE=$PIECE(^ONCO(165.5,DA,0),U,1)
+6 IF DATEDX<3030000
Begin DoDot:1
+7 DO HDR
DO SURR
DO SURATFR^ONCNTX1
DO NODER
+8 IF (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1)
DO NODATFR^ONCUTX1
+9 IF '$TEST
DO NODATFR^ONCNTX1
+10 DO SOSNR
DO SOSATFR^ONCNTX1
+11 WRITE !
DO PAUSE
End DoDot:1
+12 ;
+13 ;FORDS
+14 DO HDR
+15 SET TP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
+16 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,38)_"S0"
+17 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+18 SET $PIECE(^ONCO(165.5,DA,3.1),U,38)="0000000"
+19 SET ^ONCO(165.5,"ATX",DA,"0000000S0")=""
+20 ;D SUR,SURATF^ONCNTX1,SA,SM,NODE
+21 DO SUR
DO SURATF^ONCNTX1
DO SA
DO SM
+22 ;Code 9 (FORDS 138-139)
+23 NEW MO
SET MO=$$HIST^ONCFUNC(DA)
+24 NEW TP14
SET TP14=$EXTRACT(TP,1,4)
+25 IF (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899))
DO NODEATF^ONCUTX1
+26 ;D NODEATF^ONCNTX1
IF '$TEST
WRITE ""
+27 DO SOSN
DO SOSNATF^ONCNTX1
DO RR
DO DSD
+28 DO RFNS
WRITE !
SET Y=138.4
QUIT
+29 ;
NTXCONT SET $PIECE(^ONCO(165.5,DA,3),U,6)=0
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,12)=0
+2 ;S $P(^ONCO(165.5,DA,3),U,35)=""
+3 DO HDR
DO RAD1
DO RADATF^ONCNTX1
DO RAD2
DO RSSQ^ONCNTX1
DO RFNR
WRITE !
+4 ;S $P(^ONCO(165.5,DA,3),U,13)="00"
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,14)="00"
+6 ;S $P(^ONCO(165.5,DA,3),U,16)="00"
+7 SET $PIECE(^ONCO(165.5,DA,3.1),U,16)="00"
+8 ;S $P(^ONCO(165.5,DA,3),U,19)="00"
+9 SET $PIECE(^ONCO(165.5,DA,3.1),U,18)="00"
+10 ;S $P(^ONCO(165.5,DA,3.1),U,36)=1
+11 ;S $P(^ONCO(165.5,DA,3),U,25)=0
+12 SET $PIECE(^ONCO(165.5,DA,3.1),U,20)=0
+13 DO HDR
DO CHE
DO CHEMATF^ONCNTX1
DO HOR^ONCNTX1
DO HTATF^ONCNTX1
DO IMM^ONCNTX1
DO IMMATF^ONCNTX1
DO HTEP^ONCNTX1
DO HTEPATF^ONCNTX1
DO SSS^ONCNTX1
+14 DO PAUSE
+15 DO HDR
DO OTH^ONCNTX1
DO OTHATF^ONCNTX1
+16 WRITE !
+17 DO PAUSE
+18 ;
+19 WRITE !
SET Y="@425"
GOTO EXIT
+20 ;
SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
+1 SET $PIECE(^ONCO(165.5,DA,3),U,38)=$SELECT(DATEDX>2971231:1,1:"00")
+2 SET $PIECE(^ONCO(165.5,DA,3),U,34)=1
+3 SET DR="58.2;74"
DO DIQ1
+4 IF $DATA(NTX)
Begin DoDot:1
+5 ;W !,"SURGICAL PROCEDURES (R)=ROADS"
+6 ;W !,"-----------------------------"
+7 WRITE !,"SURGERY OF PRIMARY..........(R): ",ONC(165.5,DA,58.2,"E")
End DoDot:1
+8 WRITE !,"SURGICAL APPROACH...........(R): ",ONC(165.5,DA,74,"E")
+9 KILL ONC
+10 QUIT
+11 ;
SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
+1 SET TOPX=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
+2 NEW TOPSRCDZ
SET TOPSRCDZ=$PIECE($GET(^ONCO(164,TOPX,0)),U,16)
+3 IF (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($EXTRACT(TOPX,3,4)=76)!(TOPX=67809)
Begin DoDot:1
+4 SET $PIECE(^ONCO(165.5,DA,3.1),U,29)=1
End DoDot:1
GOTO SUR1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,29)=$SELECT(DATEDX>2971231:1,1:"00")
+6 IF DATEDX>3221231
Begin DoDot:1
+7 SET $PIECE(^ONCO(165.5,DA,3.2),U,9)="A000"
+8 IF TOPSRCDZ=67440
SET $PIECE(^ONCO(165.5,DA,3.2),U,9)="B000"
+9 IF (TOPSRCDZ=67420)!(TOPSRCDZ=67760)
SET $PIECE(^ONCO(165.5,DA,3.2),U,9)="A980"
+10 QUIT
End DoDot:1
SUR1 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3)),U,1)_"S1"
+1 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+2 SET $PIECE(^ONCO(165.5,DA,3),U,1)="0000000"
DO SPSDT^ONCATF
+3 SET ^ONCO(165.5,"ATX",DA,"0000000S1")=""
+4 SET $PIECE(^ONCO(165.5,DA,3),U,28)=8
+5 ;S $P(^ONCO(165.5,DA,0),U,11)="00000000"
+6 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
+7 SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=0
+8 SET DR="58.6:58.9;50;74;59;435;14;170"
DO DIQ1
+9 IF $DATA(NTX)
Begin DoDot:1
+10 ;W !,"SURGICAL PROCEDURES (F)=FORDS"
+11 ;W !,"-----------------------------"
+12 WRITE !,"DATE FIRST SURGICAL PROCEDURE..: ",ONC(165.5,DA,170,"E")
+13 if DATEDX<3230000
WRITE !,"RX SUMM--SURG PRIMSITE 03-2022.: ",ONC(165.5,DA,58.6,"E")
+14 if DATEDX>3221231
WRITE !,"RX SUMM--SURG PRIM SITE 2023...: ",ONC(165.5,DA,58.9,"E")
End DoDot:1
+15 WRITE !,"MOST DEFINITIVE SURG DATE......: ",ONC(165.5,DA,50,"E")
+16 KILL ONC,TXDT,TOPX
+17 QUIT
+18 ;
SA ;APPROACH (165.5,234)
+1 ;Q:DATEDX<3100000
+2 ;S $P(^ONCO(165.5,DA,2.3),U,4)=0
+3 ;S DR=234 D DIQ1
+4 ;W !,"APPROACH.......................: ",ONC(165.5,DA,234,"E")
+5 QUIT
+6 ;
SM ;SURGICAL MARGINS (165.5,59)
+1 NEW HST14,MO,TPG
+2 SET TPG=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
+3 SET MO=$$HIST^ONCFUNC(DA)
+4 SET HST14=$EXTRACT(MO,1,4)
+5 SET $PIECE(^ONCO(165.5,DA,3),U,28)=8
+6 IF $$LYMPH^ONCFUNC(DA)
IF ($EXTRACT(TPG,3,4)=77)
SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
+7 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
+8 IF $$HEMATO^ONCFUNC(DA)
SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
+9 SET DR="59"
DO DIQ1
+10 WRITE !,"SURGICAL MARGINS...............: ",ONC(165.5,DA,59,"E")
+11 KILL ONC
+12 QUIT
+13 ;
NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
+1 ;For unknown primary, leukemia, lymphoma, & brain, code 9
+2 NEW LAST,SC,SGRP,SITE
+3 SET SITE=$PIECE(^ONCO(165.5,DA,0),U,1)
+4 IF (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1)
Begin DoDot:1
+5 DO SGRP^ONCUTX1
+6 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
SET SGRP=67141
+7 FOR SC=0:0
SET SC=$ORDER(^ONCO(164,SGRP,"SC5",SC))
if SC="B"
QUIT
SET LAST=SC
+8 SET $PIECE(^ONCO(165.5,DA,3),U,40)=LAST
+9 WRITE !,"SCOPE OF LN SURGERY.........(R): ",$PIECE(^ONCO(164,SGRP,"SC5",LAST,0),U,1)
+10 DO NODER^ONCUTX
End DoDot:1
DO NUMND^ONCATF
QUIT
+11 SET $PIECE(^ONCO(165.5,DA,3),U,40)=1
+12 SET $PIECE(^ONCO(165.5,DA,3),U,42)="00"
+13 DO NUMND^ONCATF
+14 SET DR="138;140"
DO DIQ1
+15 if $DATA(NTX)
WRITE !,"SCOPE OF LN SURGERY.........(R): ",ONC(165.5,DA,138,"E")
+16 WRITE !,"NUMBER OF LN REMOVED........(R): ",ONC(165.5,DA,140,"E")
+17 QUIT
+18 ;
NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
+1 ;Code 9 (FORDS 138-139)
+2 SET TP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
+3 NEW TP14
SET TP14=$EXTRACT(TP,1,4)
+4 NEW MO
SET MO=$$HIST^ONCFUNC(DA)
+5 IF (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899))
Begin DoDot:1
+6 SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=9
+7 WRITE !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
+8 DO NODE^ONCUTX
End DoDot:1
DO SCPDT^ONCATF
QUIT
+9 SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=0
+10 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,22)_"S2"
+11 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+12 SET $PIECE(^ONCO(165.5,D0,3.1),U,22)="0000000"
DO SCPDT^ONCATF
+13 SET ^ONCO(165.5,"ATX",DA,"0000000S2")=""
+14 SET DR="138.4;138.2"
DO DIQ1
+15 if $DATA(NTX)
WRITE !,"SCOPE OF LN SURGERY.........(F): ",ONC(165.5,DA,138.4,"E")
+16 WRITE !,"SCOPE OF LN SURGERY DATE.......: ",ONC(165.5,DA,138.2,"E")
+17 QUIT
+18 ;
SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
+1 SET $PIECE(^ONCO(165.5,DA,3),U,41)=1
+2 SET DR=139
DO DIQ1
+3 if $DATA(NTX)
WRITE !,"SURG PROC/OTHER SITE........(R): ",ONC(165.5,DA,139,"E")
+4 QUIT
+5 ;
SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,33)=0
+2 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,24)_"S3"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 SET $PIECE(^ONCO(165.5,D0,3.1),U,24)="0000000"
DO SOSNDT^ONCATF
+5 SET ^ONCO(165.5,"ATX",DA,"0000000S3")=""
+6 SET DR="139.4;139.2"
DO DIQ1
+7 if $DATA(NTX)
WRITE !,"SURG PROC/OTHER SITE........(F): ",ONC(165.5,DA,139.4,"E")
+8 WRITE !,"SURG PROC/OTHER SITE DATE......: ",ONC(165.5,DA,139.2,"E")
+9 QUIT
+10 ;
RR ;RECONSTRUCTION/RESTORATION (165.5,23)
+1 IF DATEDX>3021231
QUIT
+2 IF DATEDX>2951231
Begin DoDot:1
+3 SET $PIECE(^ONCO(165.5,DA,3),U,33)=$SELECT(DATEDX>2971231:1,1:9)
+4 SET DR=23
DO DIQ1
+5 WRITE !,"RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,DA,23,"E")
End DoDot:1
+6 QUIT
+7 ;
DSD ;DATE OF SURGICAL DISCHARGE (165.5,435)
+1 ;READMISSION W/I 30 DAYS/SURG (165.5,14)
+2 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=0
+4 SET $PIECE(^ONCO(165.5,DA,7),U,19)=9
+5 SET $PIECE(^ONCO(165.5,DA,7),U,20)=""
+6 SET DR="435;14;46"
DO DIQ1
+7 WRITE !,"DATE OF SURGICAL DISCHARGE.....: ",ONC(165.5,DA,435,"E")
+8 WRITE !,"READMISSION W/I 30 DAYS/SURG...: ",ONC(165.5,DA,14,"E")
+9 WRITE !,"CAP PROTOCOL REVIEW............: ",ONC(165.5,DA,46,"E")
+10 KILL ONC
+11 QUIT
+12 ;
RFNS ;REASON NO SURGERY OF PRIMARY (165.5,58)
+1 IF $DATA(NTX)
WRITE !
Begin DoDot:1
+2 NEW DIE,DR,DP,DL,DQ
+3 SET DIE="^ONCO(165.5,"
SET DR=58
DO ^DIE
End DoDot:1
QUIT
+4 NEW RFNS
+5 SET RFNS=$$GET1^DIQ(165.5,DA,1.2)
+6 IF (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only")
Begin DoDot:1
+7 SET $PIECE(^ONCO(165.5,DA,3),U,26)=9
+8 WRITE !,"REASON NO SURGERY OF PRIMARY...: Unknown"
End DoDot:1
QUIT
+9 SET RFNSDD=$PIECE(^DD(165.5,58,0),U,3)
+10 WRITE !
KILL DIR
SET DIR(0)="SA^"_RFNSDD
+11 SET DIR("A")="REASON NO SURGERY OF PRIMARY: "
+12 ;S DIR("B")="Not part of 1st course"
+13 SET DIR("??")="^D RFNSHLP^ONCNTX1"
+14 DO ^DIR
+15 IF Y[U
QUIT
+16 SET $PIECE(^ONCO(165.5,DA,3),U,26)=Y
+17 KILL RFNSDD
QUIT
+18 ;
RAD1 ;RADIATION (165.5,51.2)
+1 NEW RFNR
+2 SET RFNR=$PIECE($GET(^ONCO(165.5,DA,3)),U,35)
+3 DO ^ONCRFNR
+4 SET DR="51.2;51"
DO DIQ1
+5 if $DATA(NTX)
WRITE !,"RADIATION:.....................: ",ONC(165.5,DA,51.2,"E")
+6 WRITE !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
+7 KILL ONC,TXDT
QUIT
+8 ;
RAD2 ;RADIATION (cont)
+1 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)<3180000
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,DA,3),U,21)=1
+3 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,18)=1
+4 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,43)=0
+5 SET $PIECE(^ONCO(165.5,DA,24),U,9)=1
+6 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,44)=0
+7 SET $PIECE(^ONCO(165.5,DA,3),U,20)=0
End DoDot:1
+8 SET $PIECE(^ONCO(165.5,DA,3),U,22)=0
+9 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,16)="0000000"
+10 SET DR="126;125;363;442;363.1;443;56;361"
DO DIQ1
+11 WRITE !,"LOCATION OF RADIATION..........: ",ONC(165.5,DA,126,"E")
+12 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)<3180000
Begin DoDot:1
+13 WRITE !,"RADIATION TREATMENT VOLUME.....: ",ONC(165.5,DA,125,"E")
+14 WRITE !,"REGIONAL TREATMENT MODALITY....: ",ONC(165.5,DA,363,"E")
+15 WRITE !,"REGIONAL DOSE:cGy..............: ",ONC(165.5,DA,442,"E")
+16 WRITE !,"BOOST TREATMENT MODALITY.......: ",ONC(165.5,DA,363.1,"E")
+17 WRITE !,"BOOST DOSE:cGy.................: ",ONC(165.5,DA,443,"E")
+18 WRITE !,"NUMBER OF TREATMENTS...........: ",ONC(165.5,DA,56,"E")
End DoDot:1
+19 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)>3171231
Begin DoDot:1
+20 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",4)=1
+21 DO RADSTF^ONCOAIP2
+22 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,1)="00"
+23 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,2)="00"
+24 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,3)="000000"
+25 WRITE !,"NUMBER OF PHASES RAD TX..............: 00"
+26 WRITE !,"RADIATION TREATMENT DISC EARLY.......: 00"
+27 WRITE !,"TOTAL DOSE...........................: 000000"
+28 ; SET RAD/SURG SEQUENCE = 0
SET $PIECE(^ONCO(165.5,D0,3),"^",7)=0
+29 ;S $P(^ONCO(165.5,D0,3),"^",35)="" ; CLEAR REASON FOR NO RAD FIELD
End DoDot:1
+30 WRITE !,"DATE RADIATION ENDED...........: ",ONC(165.5,DA,361,"E")
+31 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)>3171231
WRITE !
+32 KILL ONC,TXDT
QUIT
+33 ;
RFNR ;REASON FOR NO RADIATION (165.5,75)
+1 IF $DATA(NTX)
WRITE !
Begin DoDot:1
+2 NEW DIE,DL,DP,DQ,DR
+3 SET DIE="^ONCO(165.5,"
SET DR=75
DO ^DIE
End DoDot:1
QUIT
+4 NEW RFNS
+5 SET RFNS=$$GET1^DIQ(165.5,DA,1.2)
+6 IF (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only")
Begin DoDot:1
+7 SET $PIECE(^ONCO(165.5,DA,3),U,35)=9
+8 WRITE !,"REASON NO SURGERY OF PRIMARY...: Unknown"
End DoDot:1
QUIT
+9 SET RFNRDD=$PIECE(^DD(165.5,75,0),U,3)
+10 WRITE !
KILL DIR
SET DIR(0)="SA^"_RFNRDD
+11 SET DIR("A")="REASON FOR NO RADIATION: "
+12 SET DIR("B")="Not part of 1st course"
+13 SET DIR("??")="^D RFNRHLP^ONCNTX1"
+14 DO ^DIR
+15 IF Y[U
QUIT
+16 SET $PIECE(^ONCO(165.5,DA,3),U,35)=Y
+17 IF X=8
SET RFNR=8
DO ^ONCRFNR
Begin DoDot:1
+18 WRITE !!,"DATE RADIATION STARTED changed to 88/88/8888"
End DoDot:1
+19 KILL RFNRDD
QUIT
+20 ;
CHE ;CHEMOTHERAPY (165.5,53.2)
+1 IF $DATA(NTX)
Begin DoDot:1
+2 NEW DIE,DL,DP,DQ,DR
+3 SET DIE="^ONCO(165.5,"
SET DR=53.2
DO ^DIE
End DoDot:1
+4 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,11)_"C"
+5 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+6 SET $PIECE(^ONCO(165.5,DA,3),U,11)="0000000"
DO CHEMDT^ONCATF1
+7 SET ^ONCO(165.5,"ATX",DA,"0000000C")=""
+8 FOR CMX=28,29,30,44,45
SET $PIECE(^ONCO(165.5,DA,"LUN2"),U,CMX)=""
KILL CMX
+9 SET DR=53
DO DIQ1
+10 WRITE !,"CHEMOTHERAPY DATE.............: ",ONC(165.5,DA,53,"E")
+11 KILL ONC
QUIT
+12 ;
NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
+1 SET $PIECE(^ONCO(165.5,D0,3),U,31)="0000000"
DO NCDSDT^ONCATF
+2 SET DR=58.3
DO DIQ1
+3 WRITE !,"SURGICAL DX/STAGING PROC DATE: ",ONC(165.5,DA,58.3,"E")
+4 QUIT
+5 ;
HDR KILL DASH
SET $PIECE(DASH,"-",80)="-"
+1 WRITE @IOF,DASH,!,?1,PATNAM,?TAB,"First Course of Treatment",?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASH
+2 KILL DASH
+3 QUIT
+4 ;
DIQ1 NEW DIC,DIQ
KILL ONC
+1 SET DIC="^ONCO(165.5,"
SET DIQ="ONC("
SET DIQ(0)="E"
DO EN^DIQ1
+2 QUIT
+3 ;
PAUSE ;"Enter RETURN to continue" prompt
+1 WRITE !
READ "Enter RETURN to continue: ",PAUSE:30
+2 IF PAUSE=""
QUIT
+3 IF PAUSE=U
QUIT
+4 GOTO PAUSE
+5 ;
EXIT ;Exit
+1 WRITE !
+2 KILL TP,TPG
+3 QUIT
+4 ;
CLEANUP ;Cleanup
+1 KILL D0,DA,DATEDX,NTX,PATNAM,SITEGP,SITTAB,SSN,TAB,TOPCOD,TOPNAM,TOPTAB,X
+2 KILL Y
