ONCDTX1 ;Hines OIFO/RTK;DELETE @FAC TREATMENT FIELDS; 09/25/98
;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
;
DELATF ;Delete all treatment @fac
S $P(^ONCO(165.5,DA,3.1),U,7)="" D SPSATFR ;50.2
S $P(^ONCO(165.5,DA,3.1),U,30)="" D SPSATF ;58.7
S $P(^ONCO(165.5,DA,3.1),U,9)="" D SCPATFR ;138.1
S $P(^ONCO(165.5,DA,3.1),U,32)="" D SCPATF ;138.5
S $P(^ONCO(165.5,DA,3.1),U,10)="" D SOSATFR ;139.1
S $P(^ONCO(165.5,DA,3.1),U,34)="" D SOSNATF ;139.5
S $P(^ONCO(165.5,DA,3.1),U,12)="" D RADATF ;51.2
S $P(^ONCO(165.5,DA,3.1),U,14)="" D CHEMATF ;53.2
S $P(^ONCO(165.5,DA,3.1),U,16)="" D HORATF ;54.2
S $P(^ONCO(165.5,DA,3.1),U,18)="" D IMMATF ;55.2
S $P(^ONCO(165.5,DA,3.2),U,2)="" D HTEATF ;153.2
S $P(^ONCO(165.5,DA,3.1),U,20)="" D OTHATF ;57.2
K NTDEL Q
;
NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
Q:$P(^ONCO(165.5,DA,3.1),U,5)'=""
S $P(^ONCO(165.5,DA,3.1),U,6)=""
W:$G(DNCATF)'=1 !!,"Deleting data from the following fields...",!
W !," SURG DX/STAGING PROC @FAC"
W !," SURG DX/STAGING PROC @FAC DATE"
Q
;
SPSATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
Q:$P(^ONCO(165.5,DA,3.1),U,7)'=""
I $D(NTDEL) Q
W:$G(DSATF)'=1 !!,"Deleting data from the following fields...",!
W !," SURGERY OF PRIMARY @FAC (R)"
Q
;
SPSATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
Q:$P(^ONCO(165.5,DA,3.1),U,30)'=""
S $P(^ONCO(165.5,DA,3.1),U,8)=""
I $D(NTDEL) Q
W:$G(DSATF)'=1 !!,"Deleting data from the following fields...",!
W !," SURGERY OF PRIMARY @FAC (F)"
W !," MOST DEFINITIVE SURG @FAC DATE"
Q
;
SCPATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
Q:$P(^ONCO(165.5,DA,3.1),U,9)'=""
S $P(^ONCO(165.5,DA,3.1),U,11)=""
I $D(NTDEL) Q
W:$G(DSCATF)'=1 !!,"Deleting data from the following fields...",!
W !," SCOPE OF LN SURGERY @FAC (R)"
W !," NUMBER OF LN REMOVED @FAC (R)"
Q
;
SCPATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
Q:$P(^ONCO(165.5,DA,3.1),U,32)'=""
S $P(^ONCO(165.5,DA,3.1),U,23)=""
I $D(NTDEL) Q
W:$G(DSCATF)'=1 !!,"Deleting data from the following fields...",!
W !," SCOPE OF LN SURGERY @FAC (F)"
W !," SCOPE OF LN SURGERY @FAC DATE"
Q
;
SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
Q:$P(^ONCO(165.5,DA,3.1),U,10)'=""
I $D(NTDEL) Q
W:$G(DSOATF)'=1 !!,"Deleting data from the following fields...",!
W !," SURG PROC/OTHER SITE @FAC (R)"
Q
;
SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
Q:$P(^ONCO(165.5,DA,3.1),U,34)'=""
S $P(^ONCO(165.5,DA,3.1),U,25)=""
I $D(NTDEL) Q
W:$G(DSOATF)'=1 !!,"Deleting data from the following fields...",!
W !," SURG PROC/OTHER SITE @FAC (F)"
W !," SURG PROC/OTHER SITE @FAC DATE"
Q
;
RADATF ;Radiation @fac
Q:$P(^ONCO(165.5,DA,3.1),U,12)'=""
S $P(^ONCO(165.5,DA,3.1),U,13)=""
I $D(NTDEL) Q
W:$G(DRATF)'=1 !!,"Deleting data from the following fields...",!
W !," RADIATION @FAC"
I $G(DRATF)=1 W ?40
I $G(DRATF)'=1 W !," "
W "RADIATION @FAC DATE"
Q
;
CHEMATF ;Chemotherapy @fac
Q:$P(^ONCO(165.5,DA,3.1),U,14)'="" ;53.3
S $P(^ONCO(165.5,DA,3.1),U,15)="" ;53.4
I $D(NTDEL) Q
W:$G(DCATF)'=1 !!,"Deleting data from the following fields...",!
W !," CHEMOTHERAPY @FAC"
W !," CHEMOTHERAPY @FAC DATE"
Q
;
HORATF ;Hormone therapy @fac
Q:$P(^ONCO(165.5,DA,3.1),U,16)'="" ;54.3
S $P(^ONCO(165.5,DA,3.1),U,17)="" ;54.4
I $D(NTDEL) Q
W:$G(DHATF)'=1 !!,"Deleting data from the following fields...",!
W !," HORMONE THERAPY @FAC"
W !," HORMONE THERAPY @FAC DATE"
Q
;
IMMATF ;Immunotherapy @fac
Q:$P(^ONCO(165.5,DA,3.1),U,18)'="" ;55.3
S $P(^ONCO(165.5,DA,3.1),U,19)="" ;55.4
I $D(NTDEL) Q
W:$G(DIATF)'=1 !!,"Deleting data from the following fields...",!
W !," IMMUNOTHERAPY @FAC"
W !," IMMUNOTHERAPY @FAC DATE"
Q
;
HTEATF ;Hema Trans/Endocrine Procedure @fac
Q:$P(^ONCO(165.5,DA,3.2),U,2)'="" ;153.2
S $P(^ONCO(165.5,DA,3.2),U,3)="" ;153.3
I $D(NTDEL) Q
W:$G(DEATF)'=1 !!,"Deleting data from the following fields...",!
W !," HEMA TRANS/ENDOCRINE PROC @FAC"
W !," HEMA TRANS/ENDOCRINE PR@FAC DT"
Q
;
OTHATF ;Other treatment @fac
Q:$P(^ONCO(165.5,DA,3.1),U,20)'="" ;57.3
S $P(^ONCO(165.5,DA,3.1),U,21)="" ;57.4
I $D(NTDEL) Q
W:$G(DOATF)'=1 !!,"Deleting data from the following fields...",!
W !," OTHER TREATMENT @FAC"
W !," OTHER TREATMENT @FAC DATE"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCDTX1 4401 printed Apr 09, 2024@21:25:18 Page 2
ONCDTX1 ;Hines OIFO/RTK;DELETE @FAC TREATMENT FIELDS; 09/25/98
+1 ;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
+2 ;
DELATF ;Delete all treatment @fac
+1 ;50.2
SET $PIECE(^ONCO(165.5,DA,3.1),U,7)=""
DO SPSATFR
+2 ;58.7
SET $PIECE(^ONCO(165.5,DA,3.1),U,30)=""
DO SPSATF
+3 ;138.1
SET $PIECE(^ONCO(165.5,DA,3.1),U,9)=""
DO SCPATFR
+4 ;138.5
SET $PIECE(^ONCO(165.5,DA,3.1),U,32)=""
DO SCPATF
+5 ;139.1
SET $PIECE(^ONCO(165.5,DA,3.1),U,10)=""
DO SOSATFR
+6 ;139.5
SET $PIECE(^ONCO(165.5,DA,3.1),U,34)=""
DO SOSNATF
+7 ;51.2
SET $PIECE(^ONCO(165.5,DA,3.1),U,12)=""
DO RADATF
+8 ;53.2
SET $PIECE(^ONCO(165.5,DA,3.1),U,14)=""
DO CHEMATF
+9 ;54.2
SET $PIECE(^ONCO(165.5,DA,3.1),U,16)=""
DO HORATF
+10 ;55.2
SET $PIECE(^ONCO(165.5,DA,3.1),U,18)=""
DO IMMATF
+11 ;153.2
SET $PIECE(^ONCO(165.5,DA,3.2),U,2)=""
DO HTEATF
+12 ;57.2
SET $PIECE(^ONCO(165.5,DA,3.1),U,20)=""
DO OTHATF
+13 KILL NTDEL
QUIT
+14 ;
NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,5)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,6)=""
+3 if $GET(DNCATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+4 WRITE !," SURG DX/STAGING PROC @FAC"
+5 WRITE !," SURG DX/STAGING PROC @FAC DATE"
+6 QUIT
+7 ;
SPSATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,7)'=""
QUIT
+2 IF $DATA(NTDEL)
QUIT
+3 if $GET(DSATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+4 WRITE !," SURGERY OF PRIMARY @FAC (R)"
+5 QUIT
+6 ;
SPSATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,30)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,8)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DSATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," SURGERY OF PRIMARY @FAC (F)"
+6 WRITE !," MOST DEFINITIVE SURG @FAC DATE"
+7 QUIT
+8 ;
SCPATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,9)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,11)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DSCATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," SCOPE OF LN SURGERY @FAC (R)"
+6 WRITE !," NUMBER OF LN REMOVED @FAC (R)"
+7 QUIT
+8 ;
SCPATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,32)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,23)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DSCATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," SCOPE OF LN SURGERY @FAC (F)"
+6 WRITE !," SCOPE OF LN SURGERY @FAC DATE"
+7 QUIT
+8 ;
SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,10)'=""
QUIT
+2 IF $DATA(NTDEL)
QUIT
+3 if $GET(DSOATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+4 WRITE !," SURG PROC/OTHER SITE @FAC (R)"
+5 QUIT
+6 ;
SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,34)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,25)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DSOATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," SURG PROC/OTHER SITE @FAC (F)"
+6 WRITE !," SURG PROC/OTHER SITE @FAC DATE"
+7 QUIT
+8 ;
RADATF ;Radiation @fac
+1 if $PIECE(^ONCO(165.5,DA,3.1),U,12)'=""
QUIT
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,13)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DRATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," RADIATION @FAC"
+6 IF $GET(DRATF)=1
WRITE ?40
+7 IF $GET(DRATF)'=1
WRITE !," "
+8 WRITE "RADIATION @FAC DATE"
+9 QUIT
+10 ;
CHEMATF ;Chemotherapy @fac
+1 ;53.3
if $PIECE(^ONCO(165.5,DA,3.1),U,14)'=""
QUIT
+2 ;53.4
SET $PIECE(^ONCO(165.5,DA,3.1),U,15)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DCATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," CHEMOTHERAPY @FAC"
+6 WRITE !," CHEMOTHERAPY @FAC DATE"
+7 QUIT
+8 ;
HORATF ;Hormone therapy @fac
+1 ;54.3
if $PIECE(^ONCO(165.5,DA,3.1),U,16)'=""
QUIT
+2 ;54.4
SET $PIECE(^ONCO(165.5,DA,3.1),U,17)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DHATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," HORMONE THERAPY @FAC"
+6 WRITE !," HORMONE THERAPY @FAC DATE"
+7 QUIT
+8 ;
IMMATF ;Immunotherapy @fac
+1 ;55.3
if $PIECE(^ONCO(165.5,DA,3.1),U,18)'=""
QUIT
+2 ;55.4
SET $PIECE(^ONCO(165.5,DA,3.1),U,19)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DIATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," IMMUNOTHERAPY @FAC"
+6 WRITE !," IMMUNOTHERAPY @FAC DATE"
+7 QUIT
+8 ;
HTEATF ;Hema Trans/Endocrine Procedure @fac
+1 ;153.2
if $PIECE(^ONCO(165.5,DA,3.2),U,2)'=""
QUIT
+2 ;153.3
SET $PIECE(^ONCO(165.5,DA,3.2),U,3)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DEATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," HEMA TRANS/ENDOCRINE PROC @FAC"
+6 WRITE !," HEMA TRANS/ENDOCRINE PR@FAC DT"
+7 QUIT
+8 ;
OTHATF ;Other treatment @fac
+1 ;57.3
if $PIECE(^ONCO(165.5,DA,3.1),U,20)'=""
QUIT
+2 ;57.4
SET $PIECE(^ONCO(165.5,DA,3.1),U,21)=""
+3 IF $DATA(NTDEL)
QUIT
+4 if $GET(DOATF)'=1
WRITE !!,"Deleting data from the following fields...",!
+5 WRITE !," OTHER TREATMENT @FAC"
+6 WRITE !," OTHER TREATMENT @FAC DATE"
+7 QUIT
