ONCDTX ;HINES OIFO/GWB - Delete treatment data ;06/23/10
;;2.2;ONCOLOGY;**1,5,15,20**;Jul 31, 2013;Build 5
;
DEL ;Delete all First Course of Treatment data
I '$D(DATEDX) Q
;
;DATE FIRST SURGICAL PROCEDURE (165.5,170)
N TXDT
S TXDT=$P(^ONCO(165.5,DA,3.1),U,38)_"S0"
S $P(^ONCO(165.5,DA,3.1),U,38)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
;
S $P(^ONCO(165.5,DA,3),U,38)="" D SURR
S $P(^ONCO(165.5,DA,3.1),U,29)="" D SUR
S $P(^ONCO(165.5,DA,3.2),U,9)="" D SUR
S $P(^ONCO(165.5,DA,3),U,40)="" D SCOPER
S $P(^ONCO(165.5,DA,3.1),U,31)="" D SCOPE
S $P(^ONCO(165.5,DA,3),U,41)="" D SOSNR
S $P(^ONCO(165.5,DA,3.1),U,33)="" D SOSN
S $P(^ONCO(165.5,DA,3),U,33)=""
S $P(^ONCO(165.5,DA,3),U,6)="" D RAD
S $P(^ONCO(165.5,DA,3),U,35)=""
S $P(^ONCO(165.5,DA,3),U,13)="" D CHE
S $P(^ONCO(165.5,DA,3),U,16)="" D HOR
S $P(^ONCO(165.5,DA,3),U,19)="" D IMM
S $P(^ONCO(165.5,DA,3.1),U,36)="" D HTEP
S $P(^ONCO(165.5,DA,3.1),U,39)=""
S $P(^ONCO(165.5,DA,3),U,25)="" D OTH
S $P(^ONCO(165.5,DA,7),U,19)=""
D DELATF^ONCDTX1
K NTDEL
Q
;
SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
Q:$P(^ONCO(165.5,DA,3),U,38)'=""
S $P(^ONCO(165.5,DA,3),U,34)=""
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," SURGERY OF PRIMARY (R)"
W !," SURGICAL APPROACH (R)"
N COC,DSATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DSATF=1,$P(^ONCO(165.5,D0,3.1),U,7)=""
D SPSATFR^ONCDTX1
Q
;
SUR ;RX SUMM--SURG PRIMSITE 03-2022 (165.5,58.6)
Q ;patch ONC*2.2*18 -- remove deletions when deleting SPS (165.5,58.6)
; eventually can remove the trigger x-ref -- for now just QUIT
Q:$P(^ONCO(165.5,DA,3.1),U,29)'=""
S TXDT=$P(^ONCO(165.5,DA,3),U,1)_"S1"
S $P(^ONCO(165.5,DA,3),U,1)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
S $P(^ONCO(165.5,DA,2.3),U,4)=""
S $P(^ONCO(165.5,DA,3),U,28)=""
S $P(^ONCO(165.5,DA,"THY1"),U,36)=""
S $P(^ONCO(165.5,DA,3.1),U,28)=""
S $P(^ONCO(165.5,DA,3),U,26)=""
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," "
W !," MOST DEFINITIVE SURG DATE"
W !," RX HOSP--SURG APP 2010"
W !," SURGICAL MARGINS"
W !," DATE OF SURGICAL DISCHARGE"
W !," READMISSION W/I 30 DAYS/SURG"
W !," REASON NO SURGERY OF PRIMARY"
N COC,DSATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DSATF=1,$P(^ONCO(165.5,D0,3.1),U,30)=""
D SPSATF^ONCDTX1
Q
;
SCOPER ;SCOPE OF LN SURGERY (R) (165.5,138)
Q:$P(^ONCO(165.5,DA,3),U,40)'=""
S $P(^ONCO(165.5,DA,3),U,42)=""
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," SCOPE OF LN SURGERY (R)"
W !," NUMBER OF LN REMOVED (R)"
N COC,DSCATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DSCATF=1,$P(^ONCO(165.5,D0,3.1),U,9)=""
D SCPATFR^ONCDTX1
Q
;
SCOPE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
Q:$P(^ONCO(165.5,DA,3.1),U,31)'=""
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,22)_"S2"
S $P(^ONCO(165.5,DA,3.1),U,22)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," SCOPE OF LN SURGERY (F)"
W !," SCOPE OF LN SURGERY DATE"
N COC,DSCATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DSCATF=1,$P(^ONCO(165.5,D0,3.1),U,32)=""
D SCPATF^ONCDTX1
Q
;
SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
Q:$P(^ONCO(165.5,DA,3),U,41)'=""
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," SURG PROC/OTHER SITE (R)"
N COC,DSOATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DSOATF=1,$P(^ONCO(165.5,D0,3.1),U,10)=""
D SOSATFR^ONCDTX1
Q
;
SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
Q:$P(^ONCO(165.5,DA,3.1),U,33)'=""
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,24)_"S3"
S $P(^ONCO(165.5,DA,3.1),U,24)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," SURG PROC/OTHER SITE (F)"
W !," SURG PROC/OTHER SITE DATE"
N COC,DSOATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DSOATF=1,$P(^ONCO(165.5,D0,3.1),U,34)=""
D SOSNATF^ONCDTX1
Q
;
RAD ;RADIATON (165.5,51.2)
Q:$P(^ONCO(165.5,DA,3),U,6)'=""
S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
S $P(^ONCO(165.5,DA,3),U,4)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
S $P(^ONCO(165.5,DA,3),U,22)=""
S $P(^ONCO(165.5,DA,3),U,21)=""
S $P(^ONCO(165.5,DA,"BLA2"),U,18)=""
S $P(^ONCO(165.5,DA,"THY1"),U,43)=""
S $P(^ONCO(165.5,DA,24),U,9)=""
S $P(^ONCO(165.5,DA,"THY1"),U,44)=""
S $P(^ONCO(165.5,DA,3),U,20)=""
S $P(^ONCO(165.5,DA,3),U,7)=""
S $P(^ONCO(165.5,DA,"BLA2"),U,16)=""
S $P(^ONCO(165.5,DA,3),U,35)=""
K ^ONCO(165.5,DA,15)
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," RADIATION"
W !," DATE RADIATION STARTED"
W !," LOCATION OF RADIATION TX"
W !," RADIATION TREATMENT VOLUME"
W !," REGIONAL TREATMENT MODALITY"
W !," REGIONAL DOSE:cGy"
W !," BOOST TREATMENT MODALITY"
W !," BOOST DOSE:cGy"
W !," NUMBER OF TXS TO THIS VOLUME"
W !," RADIATION/SURGERY SEQUENCE"
W !," DATE RADIATION ENDED"
W !," REASON FOR NO RADIATION"
W !," RX TEXT-RADIATION"
N COC,DRATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DRATF=1,$P(^ONCO(165.5,D0,3.1),U,12)=""
D RADATF^ONCDTX1
Q
;
CHE ;CHEMOTHERAPY (165.5,53.2)
Q:$P(^ONCO(165.5,DA,3),U,13)'=""
S TXDT=$P(^ONCO(165.5,DA,3),U,11)_"C"
S $P(^ONCO(165.5,DA,3),U,11)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
K ^ONCO(165.5,DA,17)
S $P(^ONCO(165.5,DA,3),U,36)=""
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," CHEMOTHERAPY"
W !," CHEMOTHERAPY DATE"
W !," RX TEXT-CHEMO"
N COC,DCATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DCATF=1,$P(^ONCO(165.5,D0,3.1),U,14)=""
D CHEMATF^ONCDTX1
Q
;
HOR ;HORMONE THERAPY (165.5,54.2)
Q:$P(^ONCO(165.5,DA,3),U,16)'=""
S TXDT=$P(^ONCO(165.5,DA,3),U,14)_"H"
S $P(^ONCO(165.5,DA,3),U,14)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
K ^ONCO(165.5,DA,18)
S $P(^ONCO(165.5,DA,3),U,37)=""
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," HORMONE THERAPY"
W !," HORMONE THERAPY DATE"
W !," RX TEXT-HORMONE"
N COC,DHATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DHATF=1,$P(^ONCO(165.5,D0,3.1),U,16)=""
D HORATF^ONCDTX1
Q
;
IMM ;IMMUNOTHERAPY (165.5,55.2)
Q:$P(^ONCO(165.5,DA,3),U,19)'=""
S TXDT=$P(^ONCO(165.5,DA,3),U,17)_"B"
S $P(^ONCO(165.5,DA,3),U,17)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
K ^ONCO(165.5,DA,20)
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," IMMUNOTHERAPY"
W !," IMMUNOTHERAPY DATE"
W !," RX TEXT-BRM"
N COC,DIATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DIATF=1,$P(^ONCO(165.5,D0,3.1),U,18)=""
D IMMATF^ONCDTX1
Q
;
HTEP ;HEMA TRANS/ENDOCRINE PROC (165.5,53)
Q:$P(^ONCO(165.5,DA,3.1),U,36)'=""
S TXDT=$P(^ONCO(165.5,DA,3.1),U,35)_"E"
S $P(^ONCO(165.5,DA,3.1),U,35)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," HEMA TRANS/ENDOCRINE PROC"
W !," HEMA TRANS/ENDOCRINE PROC DATE"
N COC,DEATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DEATF=1,$P(^ONCO(165.5,D0,3.2),U,2)=""
D HTEATF^ONCDTX1
Q
;
OTH ;OTHER TREATMENT (165.5,57.2)
Q:$P(^ONCO(165.5,DA,3),U,25)'=""
S TXDT=$P(^ONCO(165.5,DA,3),U,23)_"O"
S $P(^ONCO(165.5,DA,3),U,23)=""
K ^ONCO(165.5,"ATX",DA,TXDT)
K TXDT
K ^ONCO(165.5,DA,21)
I $D(NTDEL) Q
W !!,"Deleting data from the following fields...",!
W !," OTHER TREATMENT"
W !," OTHER TREATMENT START DATE"
W !," RX TEXT-OTHER"
N COC,DOATF
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
S DOATF=1,$P(^ONCO(165.5,D0,3.1),U,20)=""
D OTHATF^ONCDTX1
Q
;
PP ;PALLIATIVE CARE (165.5,12)
Q:$P(^ONCO(165.5,DA,3.1),U,26)'=""
N COC
D CHKCOC^ONCATF
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) Q
W !!,"Deleting data from the following fields...",!
S $P(^ONCO(165.5,DA,3.1),U,27)=""
W !," PALLIATIVE CARE @FAC",!
Q
;
NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
Q:$P(^ONCO(165.5,DA,3),U,27)'=""
S $P(^ONCO(165.5,DA,3),U,31)=""
W !!,"Deleting data from the following fields...",!
W !," SURGICAL DX/STAGING PROC"
W !," SURGICAL DX/STAGING PROC DATE"
N COC,DNCATF
D CHKCOC^ONCATF
I (COC=20)!(COC=21)!(COC=22)!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=36)!(COC=37) Q
S DNCATF=1,$P(^ONCO(165.5,D0,3.1),U,5)=""
D NCDSATF^ONCDTX1
Q
;
SCT ;SUBSEQUENT COURSE OF TREATMENT (165.5,60)
Q:$P(^ONCO(165.5,DA(1),4,DA,0),U,4)'=""
S $P(^ONCO(165.5,DA(1),4,DA,0),U,11)=""
W !!,"Deleting data from the following fields...",!
W !," SURGERY OF PRIMARY SITE"
W !," SURGERY OF PRIMARY SITE DATE",!
Q
;
CLEANUP ;Cleanup
K D0,DA,DATEDX
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCDTX 9266 printed Dec 13, 2024@02:22:49 Page 2
ONCDTX ;HINES OIFO/GWB - Delete treatment data ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,5,15,20**;Jul 31, 2013;Build 5
+2 ;
DEL ;Delete all First Course of Treatment data
+1 IF '$DATA(DATEDX)
QUIT
+2 ;
+3 ;DATE FIRST SURGICAL PROCEDURE (165.5,170)
+4 NEW TXDT
+5 SET TXDT=$PIECE(^ONCO(165.5,DA,3.1),U,38)_"S0"
+6 SET $PIECE(^ONCO(165.5,DA,3.1),U,38)=""
+7 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+8 ;
+9 SET $PIECE(^ONCO(165.5,DA,3),U,38)=""
DO SURR
+10 SET $PIECE(^ONCO(165.5,DA,3.1),U,29)=""
DO SUR
+11 SET $PIECE(^ONCO(165.5,DA,3.2),U,9)=""
DO SUR
+12 SET $PIECE(^ONCO(165.5,DA,3),U,40)=""
DO SCOPER
+13 SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=""
DO SCOPE
+14 SET $PIECE(^ONCO(165.5,DA,3),U,41)=""
DO SOSNR
+15 SET $PIECE(^ONCO(165.5,DA,3.1),U,33)=""
DO SOSN
+16 SET $PIECE(^ONCO(165.5,DA,3),U,33)=""
+17 SET $PIECE(^ONCO(165.5,DA,3),U,6)=""
DO RAD
+18 SET $PIECE(^ONCO(165.5,DA,3),U,35)=""
+19 SET $PIECE(^ONCO(165.5,DA,3),U,13)=""
DO CHE
+20 SET $PIECE(^ONCO(165.5,DA,3),U,16)=""
DO HOR
+21 SET $PIECE(^ONCO(165.5,DA,3),U,19)=""
DO IMM
+22 SET $PIECE(^ONCO(165.5,DA,3.1),U,36)=""
DO HTEP
+23 SET $PIECE(^ONCO(165.5,DA,3.1),U,39)=""
+24 SET $PIECE(^ONCO(165.5,DA,3),U,25)=""
DO OTH
+25 SET $PIECE(^ONCO(165.5,DA,7),U,19)=""
+26 DO DELATF^ONCDTX1
+27 KILL NTDEL
+28 QUIT
+29 ;
SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
+1 if $PIECE(^ONCO(165.5,DA,3),U,38)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3),U,34)=""
+3 IF $DATA(NTDEL)
QUIT
+4 WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," SURGERY OF PRIMARY (R)"
+6 WRITE !," SURGICAL APPROACH (R)"
+7 NEW COC,DSATF
+8 DO CHKCOC^ONCATF
+9 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+10 SET DSATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,7)=""
+11 DO SPSATFR^ONCDTX1
+12 QUIT
+13 ;
SUR ;RX SUMM--SURG PRIMSITE 03-2022 (165.5,58.6)
+1 ;patch ONC*2.2*18 -- remove deletions when deleting SPS (165.5,58.6)
QUIT
+2 ; eventually can remove the trigger x-ref -- for now just QUIT
+3 if $PIECE(^ONCO(165.5,DA,3.1),U,29)'=""
QUIT
+4 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,1)_"S1"
+5 SET $PIECE(^ONCO(165.5,DA,3),U,1)=""
+6 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+7 KILL TXDT
+8 SET $PIECE(^ONCO(165.5,DA,2.3),U,4)=""
+9 SET $PIECE(^ONCO(165.5,DA,3),U,28)=""
+10 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)=""
+11 SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=""
+12 SET $PIECE(^ONCO(165.5,DA,3),U,26)=""
+13 IF $DATA(NTDEL)
QUIT
+14 WRITE !!,"Deleting data from the following fields...",!
+15 WRITE !," "
+16 WRITE !," MOST DEFINITIVE SURG DATE"
+17 WRITE !," RX HOSP--SURG APP 2010"
+18 WRITE !," SURGICAL MARGINS"
+19 WRITE !," DATE OF SURGICAL DISCHARGE"
+20 WRITE !," READMISSION W/I 30 DAYS/SURG"
+21 WRITE !," REASON NO SURGERY OF PRIMARY"
+22 NEW COC,DSATF
+23 DO CHKCOC^ONCATF
+24 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+25 SET DSATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,30)=""
+26 DO SPSATF^ONCDTX1
+27 QUIT
+28 ;
SCOPER ;SCOPE OF LN SURGERY (R) (165.5,138)
+1 if $PIECE(^ONCO(165.5,DA,3),U,40)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3),U,42)=""
+3 IF $DATA(NTDEL)
QUIT
+4 WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," SCOPE OF LN SURGERY (R)"
+6 WRITE !," NUMBER OF LN REMOVED (R)"
+7 NEW COC,DSCATF
+8 DO CHKCOC^ONCATF
+9 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+10 SET DSCATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,9)=""
+11 DO SCPATFR^ONCDTX1
+12 QUIT
+13 ;
SCOPE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,31)'=""
QUIT
+2 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,22)_"S2"
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,22)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 IF $DATA(NTDEL)
QUIT
+7 WRITE !!,"Deleting data from the following fields...",!
+8 WRITE !," SCOPE OF LN SURGERY (F)"
+9 WRITE !," SCOPE OF LN SURGERY DATE"
+10 NEW COC,DSCATF
+11 DO CHKCOC^ONCATF
+12 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+13 SET DSCATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,32)=""
+14 DO SCPATF^ONCDTX1
+15 QUIT
+16 ;
SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
+1 if $PIECE(^ONCO(165.5,DA,3),U,41)'=""
QUIT
+2 IF $DATA(NTDEL)
QUIT
+3 WRITE !!,"Deleting data from the following fields...",!
+4 WRITE !," SURG PROC/OTHER SITE (R)"
+5 NEW COC,DSOATF
+6 DO CHKCOC^ONCATF
+7 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+8 SET DSOATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,10)=""
+9 DO SOSATFR^ONCDTX1
+10 QUIT
+11 ;
SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,33)'=""
QUIT
+2 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,24)_"S3"
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,24)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 IF $DATA(NTDEL)
QUIT
+7 WRITE !!,"Deleting data from the following fields...",!
+8 WRITE !," SURG PROC/OTHER SITE (F)"
+9 WRITE !," SURG PROC/OTHER SITE DATE"
+10 NEW COC,DSOATF
+11 DO CHKCOC^ONCATF
+12 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+13 SET DSOATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,34)=""
+14 DO SOSNATF^ONCDTX1
+15 QUIT
+16 ;
RAD ;RADIATON (165.5,51.2)
+1 if $PIECE(^ONCO(165.5,DA,3),U,6)'=""
QUIT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,4)_"R"
+3 SET $PIECE(^ONCO(165.5,DA,3),U,4)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 SET $PIECE(^ONCO(165.5,DA,3),U,22)=""
+7 SET $PIECE(^ONCO(165.5,DA,3),U,21)=""
+8 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,18)=""
+9 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,43)=""
+10 SET $PIECE(^ONCO(165.5,DA,24),U,9)=""
+11 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,44)=""
+12 SET $PIECE(^ONCO(165.5,DA,3),U,20)=""
+13 SET $PIECE(^ONCO(165.5,DA,3),U,7)=""
+14 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,16)=""
+15 SET $PIECE(^ONCO(165.5,DA,3),U,35)=""
+16 KILL ^ONCO(165.5,DA,15)
+17 IF $DATA(NTDEL)
QUIT
+18 WRITE !!,"Deleting data from the following fields...",!
+19 WRITE !," RADIATION"
+20 WRITE !," DATE RADIATION STARTED"
+21 WRITE !," LOCATION OF RADIATION TX"
+22 WRITE !," RADIATION TREATMENT VOLUME"
+23 WRITE !," REGIONAL TREATMENT MODALITY"
+24 WRITE !," REGIONAL DOSE:cGy"
+25 WRITE !," BOOST TREATMENT MODALITY"
+26 WRITE !," BOOST DOSE:cGy"
+27 WRITE !," NUMBER OF TXS TO THIS VOLUME"
+28 WRITE !," RADIATION/SURGERY SEQUENCE"
+29 WRITE !," DATE RADIATION ENDED"
+30 WRITE !," REASON FOR NO RADIATION"
+31 WRITE !," RX TEXT-RADIATION"
+32 NEW COC,DRATF
+33 DO CHKCOC^ONCATF
+34 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+35 SET DRATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,12)=""
+36 DO RADATF^ONCDTX1
+37 QUIT
+38 ;
CHE ;CHEMOTHERAPY (165.5,53.2)
+1 if $PIECE(^ONCO(165.5,DA,3),U,13)'=""
QUIT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,11)_"C"
+3 SET $PIECE(^ONCO(165.5,DA,3),U,11)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 KILL ^ONCO(165.5,DA,17)
+7 SET $PIECE(^ONCO(165.5,DA,3),U,36)=""
+8 IF $DATA(NTDEL)
QUIT
+9 WRITE !!,"Deleting data from the following fields...",!
+10 WRITE !," CHEMOTHERAPY"
+11 WRITE !," CHEMOTHERAPY DATE"
+12 WRITE !," RX TEXT-CHEMO"
+13 NEW COC,DCATF
+14 DO CHKCOC^ONCATF
+15 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+16 SET DCATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,14)=""
+17 DO CHEMATF^ONCDTX1
+18 QUIT
+19 ;
HOR ;HORMONE THERAPY (165.5,54.2)
+1 if $PIECE(^ONCO(165.5,DA,3),U,16)'=""
QUIT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,14)_"H"
+3 SET $PIECE(^ONCO(165.5,DA,3),U,14)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 KILL ^ONCO(165.5,DA,18)
+7 SET $PIECE(^ONCO(165.5,DA,3),U,37)=""
+8 IF $DATA(NTDEL)
QUIT
+9 WRITE !!,"Deleting data from the following fields...",!
+10 WRITE !," HORMONE THERAPY"
+11 WRITE !," HORMONE THERAPY DATE"
+12 WRITE !," RX TEXT-HORMONE"
+13 NEW COC,DHATF
+14 DO CHKCOC^ONCATF
+15 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+16 SET DHATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,16)=""
+17 DO HORATF^ONCDTX1
+18 QUIT
+19 ;
IMM ;IMMUNOTHERAPY (165.5,55.2)
+1 if $PIECE(^ONCO(165.5,DA,3),U,19)'=""
QUIT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,17)_"B"
+3 SET $PIECE(^ONCO(165.5,DA,3),U,17)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 KILL ^ONCO(165.5,DA,20)
+7 IF $DATA(NTDEL)
QUIT
+8 WRITE !!,"Deleting data from the following fields...",!
+9 WRITE !," IMMUNOTHERAPY"
+10 WRITE !," IMMUNOTHERAPY DATE"
+11 WRITE !," RX TEXT-BRM"
+12 NEW COC,DIATF
+13 DO CHKCOC^ONCATF
+14 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+15 SET DIATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,18)=""
+16 DO IMMATF^ONCDTX1
+17 QUIT
+18 ;
HTEP ;HEMA TRANS/ENDOCRINE PROC (165.5,53)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,36)'=""
QUIT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3.1),U,35)_"E"
+3 SET $PIECE(^ONCO(165.5,DA,3.1),U,35)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 IF $DATA(NTDEL)
QUIT
+7 WRITE !!,"Deleting data from the following fields...",!
+8 WRITE !," HEMA TRANS/ENDOCRINE PROC"
+9 WRITE !," HEMA TRANS/ENDOCRINE PROC DATE"
+10 NEW COC,DEATF
+11 DO CHKCOC^ONCATF
+12 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+13 SET DEATF=1
SET $PIECE(^ONCO(165.5,D0,3.2),U,2)=""
+14 DO HTEATF^ONCDTX1
+15 QUIT
+16 ;
OTH ;OTHER TREATMENT (165.5,57.2)
+1 if $PIECE(^ONCO(165.5,DA,3),U,25)'=""
QUIT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,23)_"O"
+3 SET $PIECE(^ONCO(165.5,DA,3),U,23)=""
+4 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+5 KILL TXDT
+6 KILL ^ONCO(165.5,DA,21)
+7 IF $DATA(NTDEL)
QUIT
+8 WRITE !!,"Deleting data from the following fields...",!
+9 WRITE !," OTHER TREATMENT"
+10 WRITE !," OTHER TREATMENT START DATE"
+11 WRITE !," RX TEXT-OTHER"
+12 NEW COC,DOATF
+13 DO CHKCOC^ONCATF
+14 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+15 SET DOATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,20)=""
+16 DO OTHATF^ONCDTX1
+17 QUIT
+18 ;
PP ;PALLIATIVE CARE (165.5,12)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,26)'=""
QUIT
+2 NEW COC
+3 DO CHKCOC^ONCATF
+4 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
QUIT
+5 WRITE !!,"Deleting data from the following fields...",!
+6 SET $PIECE(^ONCO(165.5,DA,3.1),U,27)=""
+7 WRITE !," PALLIATIVE CARE @FAC",!
+8 QUIT
+9 ;
NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
+1 if $PIECE(^ONCO(165.5,DA,3),U,27)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3),U,31)=""
+3 WRITE !!,"Deleting data from the following fields...",!
+4 WRITE !," SURGICAL DX/STAGING PROC"
+5 WRITE !," SURGICAL DX/STAGING PROC DATE"
+6 NEW COC,DNCATF
+7 DO CHKCOC^ONCATF
+8 IF (COC=20)!(COC=21)!(COC=22)!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=36)!(COC=37)
QUIT
+9 SET DNCATF=1
SET $PIECE(^ONCO(165.5,D0,3.1),U,5)=""
+10 DO NCDSATF^ONCDTX1
+11 QUIT
+12 ;
SCT ;SUBSEQUENT COURSE OF TREATMENT (165.5,60)
+1 if $PIECE(^ONCO(165.5,DA(1),4,DA,0),U,4)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA(1),4,DA,0),U,11)=""
+3 WRITE !!,"Deleting data from the following fields...",!
+4 WRITE !," SURGERY OF PRIMARY SITE"
+5 WRITE !," SURGERY OF PRIMARY SITE DATE",!
+6 QUIT
+7 ;
CLEANUP ;Cleanup
+1 KILL D0,DA,DATEDX
