Routine: ONCDTX1

ONCDTX1 ;HINES OIFO/RTK - DELETE @FAC TREATMENT FIELDS; 09/25/98

 ;;2.2;ONCOLOGY;**1,5,20**;Jul 31, 2013;Build 5

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"

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)"

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 !,"  RX HOSP--SURG PRIMSITE 03-2022"

 W !,"  MOST DEFINITIVE SURG @FAC DATE"

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)"

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"

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)"

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"

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"

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"

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"

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"

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"

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"

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCDTX1   4409     printed  Feb 18, 2025@23:49:12                                                                                                                                                                                                     Page 2

ONCDTX1   ;HINES OIFO/RTK - DELETE @FAC TREATMENT FIELDS; 09/25/98

 +1       ;;2.2;ONCOLOGY;**1,5,20**;Jul 31, 2013;Build 5

 +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 !,"  RX HOSP--SURG PRIMSITE 03-2022"

 +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

ONCDTX1.m