ONCBRP5 ;HINES CIOFO/GWB - 1998 Breast Cancer Study - Table V ;6/1/98
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
K TABLE,HTABLE
S TABLE("SURGERY")="S^ONCBRP5"
S TABLE("NON CANCER-DIRECTED SURGERY")="NCS^ONCBRP5"
S TABLE("CANCER-DIRECTED SURGERY")="CS^ONCBRP5"
S TABLE("RADIATION THERAPY")="RT^ONCBRP5A"
S TABLE("HORMONE THERAPY")="HOT^ONCBRP5A"
S TABLE("CHEMOTHERAPY")="CT^ONCBRP5A"
S HTABLE(1)="SURGERY"
S HTABLE(2)="NON CANCER-DIRECTED SURGERY"
S HTABLE(3)="CANCER-DIRECTED SURGERY"
S HTABLE(4)="RADIATION THERAPY"
S HTABLE(5)="HORMONE THERAPY"
S HTABLE(6)="CHEMOTHERAPY"
S CHOICES=6
W @IOF D HEAD^ONCBRP0
W !," TABLE V - FIRST COURSE OF TREATMENT"
W !," -----------------------------------"
K DIQ,ONC S DIC="^ONCO(165.5,"
S DR="23;49;50;51;51.2;53;53.2;54;54.2;58.1;58.2;58.3;58;59;74;75;138;139;140"
S DA=ONCONUM,DIQ="ONC" D EN^DIQ1
S DIE="^ONCO(165.5,",DA=ONCONUM
S CDS=ONC(165.5,ONCONUM,58.2)
S RAD=$P($G(^ONCO(165.5,ONCONUM,3)),U,6)
S CHE=$P($G(^ONCO(165.5,ONCONUM,3)),U,13)
S HOR=$P($G(^ONCO(165.5,ONCONUM,3)),U,16)
DFCT W !," 51. DATE OF FIRST COURSE TREATMENT: ",ONC(165.5,ONCONUM,49)
S W !!," SURGERY",!
W " -------"
NCS W !," NON CANCER-DIRECTED SURGERY",!
DNCDS W !," 52. DATE OF NON CANCER-DIRECTED"
W !," SURGERY.......................: ",ONC(165.5,ONCONUM,58.3)
NCDS S NCDS=ONC(165.5,ONCONUM,58.1)
S (NCDS1,NCDS2)="",LOS=$L(NCDS) I LOS<43 S NCDS1=NCDS G NCDS1
S NOP=$L($E(NCDS,1,43)," ")
S NCDS1=$P(NCDS," ",1,NOP-1),NCDS2=$P(NCDS," ",NOP,999)
NCDS1 W !," 53. NON CANCER-DIRECTED SURGERY...: ",NCDS1 W:NCDS2'="" !,?37,NCDS2
CS W !," CANCER-DIRECTED SURGERY",!
DCDS W !," 54. DATE (FIRST) OF CANCER-"
W !," DIRECTED SURGERY..............: ",ONC(165.5,ONCONUM,50)
W ! K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT W @IOF D HEAD^ONCBRP0
SA S SA=ONC(165.5,ONCONUM,74)
S (SA1,SA2)="",LOS=$L(SA) I LOS<43 S SA1=SA G SA1
S NOP=$L($E(SA,1,43)," "),SA1=$P(SA," ",1,NOP-1),SA2=$P(SA," ",NOP,999)
SA1 W !," 55. SURGICAL APPROACH.............: ",SA1 W:SA2'="" !,?37,SA2
SPS S (CDS1,CDS2)="",LOS=$L(CDS) I LOS<43 S CDS1=CDS G SPS1
S NOP=$L($E(CDS,1,43)," "),CDS1=$P(CDS," ",1,NOP-1),CDS2=$P(CDS," ",NOP,999)
SPS1 W !," 56. SURGERY OF PRIMARY SITE.......: ",CDS1 W:CDS2'="" !,?37,CDS2
SR I $E(CDS,1,2)="00" D G SM
.S $P(^ONCO(165.5,D0,"BRE1"),U,48)=8
.W !," 57. SPECIMEN RADIOGRAPH...........: NA"
I $E(CDS,1,2)=99 D G SM
.S $P(^ONCO(165.5,D0,"BRE1"),U,48)=9
.W !," 57. SPECIMEN RADIOGRAPH...........: Unknown"
S DR="947 57. SPECIMEN RADIOGRAPH..........." D ^DIE G:$D(Y) JUMP
SM S SM=ONC(165.5,ONCONUM,59)
S (SM1,SM2)="",LOS=$L(SM) I LOS<43 S SM1=SM G SM1
S NOP=$L($E(SM,1,43)," "),SM1=$P(SM," ",1,NOP-1),SM2=$P(SM," ",NOP,999)
SM1 W !," 58. SURGICAL MARGINS..............: ",SM1 W:SM2'="" !,?37,SM2
WESSP I $E(CDS,1,2)="00" D G SLNS
.S $P(^ONCO(165.5,D0,"BRE1"),U,49)=8
.S $P(^ONCO(165.5,D0,"BRE1"),U,50)=8
.W !," 59. WAS ENTIRE SPECIMEN SUBMITTED"
.W !," TO PATHOLOGY..................: NA"
.W !," 60. IF MARGINS ARE FREE, WHAT IS"
.W !," THE DISTANCE..................: NA"
I $E(CDS,1,2)=99 D G SLNS
.S $P(^ONCO(165.5,D0,"BRE1"),U,49)=9
.S $P(^ONCO(165.5,D0,"BRE1"),U,50)=9
.W !," 59. WAS ENTIRE SPECIMEN SUBMITTED"
.W !," TO PATHOLOGY..................: Unknown"
.W !," 60. IF MARGINS ARE FREE, WHAT IS"
.W !," THE DISTANCE..................: Unknown"
S DR="948 59. WAS ENTIRE SPECIMEN SUBMITTED TO PATHOLOGY.................." D ^DIE G:$D(Y) JUMP
S DR="949 60. IF MARGINS ARE FREE, WHAT IS THE DISTANCE.................." D ^DIE G:$D(Y) JUMP
SLNS S SLNS=ONC(165.5,ONCONUM,138)
S (SLNS1,SLNS2)="",LOS=$L(SLNS) I LOS<43 S SLNS1=SLNS G SLNS1
S NOP=$L($E(SLNS,1,43)," "),SLNS1=$P(SLNS," ",1,NOP-1),SLNS2=$P(SLNS," ",NOP,999)
SLNS1 W !," 61. SCOPE OF REGIONAL LYMPH NODE"
W !," SURGERY.......................: ",SLNS1 W:SLNS2'="" !,?37,SLNS2
NLNR W !," 62. NUMBER OF REGIONAL LYMPH NODES"
W !," REMOVED.......................: ",ONC(165.5,ONCONUM,140)
SORS S SORS=ONC(165.5,ONCONUM,139)
S (SORS1,SORS2)="",LOS=$L(SORS) I LOS<43 S SORS1=SORS G SORS1
S NOP=$L($E(SORS,1,43)," ")
S SORS1=$P(SORS," ",1,NOP-1),SORS2=$P(SORS," ",NOP,999)
SORS1 W !," 63. SURGERY OF OTHER REGIONAL"
W !," SITE(S), DISTANT SITE(S),"
W !," OR DISTANT LYMPH NODE(S)......: ",SORS1 W:SORS2'="" !,?37,SORS2
RR S RR=ONC(165.5,ONCONUM,23)
S (RR1,RR2)="",LOS=$L(RR) I LOS<43 S RR1=RR G RR1
S NOP=$L($E(RR,1,43)," "),RR1=$P(RR," ",1,NOP-1),RR2=$P(RR," ",NOP,999)
RR1 W !," 64. RECONSTRUCTION/RESTORATION....: ",RR1 W:RR2'="" !,?37,RR2
R I $E(CDS,1,2)="00" D G PRTC
.S $P(^ONCO(165.5,D0,"BRE1"),U,51)=8
.S $P(^ONCO(165.5,D0,"BRE1"),U,52)=8
.W !," 65. RE-EXCISION...................: NA"
.W !," 66. MICROSCOPIC STATUS OF FINAL"
.W !," MARGIN AFTER RESECTION........: NA"
I $E(CDS,1,2)=99 D G PRTC
.S $P(^ONCO(165.5,D0,"BRE1"),U,51)=9
.S $P(^ONCO(165.5,D0,"BRE1"),U,52)=9
.W !," 65. RE-EXCISION...................: Unknown"
.W !," 66. MICROSCOPIC STATUS OF FINAL"
.W !," MARGIN AFTER RESECTION........: Unknown"
S DR="950 65. RE-EXCISION..................." D ^DIE G:$D(Y) JUMP
I X=0 D G PRTC
.S $P(^ONCO(165.5,ONCONUM,"BRE1"),U,52)=8
.W !," 66. MICROSCOPIC STATUS OF FINAL"
.W !," MARGIN AFTER RE-EXCISION......: NA"
I X=9 D G PRTC
.S $P(^ONCO(165.5,ONCONUM,"BRE1"),U,52)=9
.W !," 66. MICROSCOPIC STATUS OF FINAL"
.W !," MARGIN AFTER RE-EXCISION......: Unknown"
S DR="951 66. MICROSCOPIC STATUS OF FINAL MARGIN AFTER RE-EXCISION......" D ^DIE G:$D(Y) JUMP
PRTC I ($E(CDS,1,2)'="00")&($E(CDS,1,2)'=99) W !
K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT
G RT^ONCBRP5A
JUMP ;Jump to prompts
S XX="" R !!," GO TO ITEM: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
I X["?" D G JUMP
.W !," CHOOSE FROM:" F I=1:1:CHOICES W !," ",HTABLE(I)
I '$D(TABLE(X)) S:X?1.2N X=X_"." S XX=X,X=$O(TABLE(X)) I ($P(X,XX,1)'="")!(X="") W *7,"??" D G JUMP
.W !," CHOOSE FROM:" F I=1:1:CHOICES W !," ",HTABLE(I)
S X=TABLE(X)
G @X
EXIT S:$D(DIRUT) OUT="Y"
K CHOICES,PIECE,HTABLE,TABLE
K CDS,CDSOT,LOS,NCDS,NCDSOT,NOP,SURG,SURG1,SURG2,SURGDT,SA,SA1,SA2
K SM,SM1,SM2,SOORS,SOORS1,SOORS2,SLNS,SLNS1,SLNS2,RAD,HOR,CHE
K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCBRP5 6453 printed Oct 16, 2024@18:23:02 Page 2
ONCBRP5 ;HINES CIOFO/GWB - 1998 Breast Cancer Study - Table V ;6/1/98
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 KILL TABLE,HTABLE
+3 SET TABLE("SURGERY")="S^ONCBRP5"
+4 SET TABLE("NON CANCER-DIRECTED SURGERY")="NCS^ONCBRP5"
+5 SET TABLE("CANCER-DIRECTED SURGERY")="CS^ONCBRP5"
+6 SET TABLE("RADIATION THERAPY")="RT^ONCBRP5A"
+7 SET TABLE("HORMONE THERAPY")="HOT^ONCBRP5A"
+8 SET TABLE("CHEMOTHERAPY")="CT^ONCBRP5A"
+9 SET HTABLE(1)="SURGERY"
+10 SET HTABLE(2)="NON CANCER-DIRECTED SURGERY"
+11 SET HTABLE(3)="CANCER-DIRECTED SURGERY"
+12 SET HTABLE(4)="RADIATION THERAPY"
+13 SET HTABLE(5)="HORMONE THERAPY"
+14 SET HTABLE(6)="CHEMOTHERAPY"
+15 SET CHOICES=6
+16 WRITE @IOF
DO HEAD^ONCBRP0
+17 WRITE !," TABLE V - FIRST COURSE OF TREATMENT"
+18 WRITE !," -----------------------------------"
+19 KILL DIQ,ONC
SET DIC="^ONCO(165.5,"
+20 SET DR="23;49;50;51;51.2;53;53.2;54;54.2;58.1;58.2;58.3;58;59;74;75;138;139;140"
+21 SET DA=ONCONUM
SET DIQ="ONC"
DO EN^DIQ1
+22 SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
+23 SET CDS=ONC(165.5,ONCONUM,58.2)
+24 SET RAD=$PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,6)
+25 SET CHE=$PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,13)
+26 SET HOR=$PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,16)
DFCT WRITE !," 51. DATE OF FIRST COURSE TREATMENT: ",ONC(165.5,ONCONUM,49)
S WRITE !!," SURGERY",!
+1 WRITE " -------"
NCS WRITE !," NON CANCER-DIRECTED SURGERY",!
DNCDS WRITE !," 52. DATE OF NON CANCER-DIRECTED"
+1 WRITE !," SURGERY.......................: ",ONC(165.5,ONCONUM,58.3)
NCDS SET NCDS=ONC(165.5,ONCONUM,58.1)
+1 SET (NCDS1,NCDS2)=""
SET LOS=$LENGTH(NCDS)
IF LOS<43
SET NCDS1=NCDS
GOTO NCDS1
+2 SET NOP=$LENGTH($EXTRACT(NCDS,1,43)," ")
+3 SET NCDS1=$PIECE(NCDS," ",1,NOP-1)
SET NCDS2=$PIECE(NCDS," ",NOP,999)
NCDS1 WRITE !," 53. NON CANCER-DIRECTED SURGERY...: ",NCDS1
if NCDS2'=""
WRITE !,?37,NCDS2
CS WRITE !," CANCER-DIRECTED SURGERY",!
DCDS WRITE !," 54. DATE (FIRST) OF CANCER-"
+1 WRITE !," DIRECTED SURGERY..............: ",ONC(165.5,ONCONUM,50)
+2 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
WRITE @IOF
DO HEAD^ONCBRP0
SA SET SA=ONC(165.5,ONCONUM,74)
+1 SET (SA1,SA2)=""
SET LOS=$LENGTH(SA)
IF LOS<43
SET SA1=SA
GOTO SA1
+2 SET NOP=$LENGTH($EXTRACT(SA,1,43)," ")
SET SA1=$PIECE(SA," ",1,NOP-1)
SET SA2=$PIECE(SA," ",NOP,999)
SA1 WRITE !," 55. SURGICAL APPROACH.............: ",SA1
if SA2'=""
WRITE !,?37,SA2
SPS SET (CDS1,CDS2)=""
SET LOS=$LENGTH(CDS)
IF LOS<43
SET CDS1=CDS
GOTO SPS1
+1 SET NOP=$LENGTH($EXTRACT(CDS,1,43)," ")
SET CDS1=$PIECE(CDS," ",1,NOP-1)
SET CDS2=$PIECE(CDS," ",NOP,999)
SPS1 WRITE !," 56. SURGERY OF PRIMARY SITE.......: ",CDS1
if CDS2'=""
WRITE !,?37,CDS2
SR IF $EXTRACT(CDS,1,2)="00"
Begin DoDot:1
+1 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,48)=8
+2 WRITE !," 57. SPECIMEN RADIOGRAPH...........: NA"
End DoDot:1
GOTO SM
+3 IF $EXTRACT(CDS,1,2)=99
Begin DoDot:1
+4 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,48)=9
+5 WRITE !," 57. SPECIMEN RADIOGRAPH...........: Unknown"
End DoDot:1
GOTO SM
+6 SET DR="947 57. SPECIMEN RADIOGRAPH..........."
DO ^DIE
if $DATA(Y)
GOTO JUMP
SM SET SM=ONC(165.5,ONCONUM,59)
+1 SET (SM1,SM2)=""
SET LOS=$LENGTH(SM)
IF LOS<43
SET SM1=SM
GOTO SM1
+2 SET NOP=$LENGTH($EXTRACT(SM,1,43)," ")
SET SM1=$PIECE(SM," ",1,NOP-1)
SET SM2=$PIECE(SM," ",NOP,999)
SM1 WRITE !," 58. SURGICAL MARGINS..............: ",SM1
if SM2'=""
WRITE !,?37,SM2
WESSP IF $EXTRACT(CDS,1,2)="00"
Begin DoDot:1
+1 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,49)=8
+2 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,50)=8
+3 WRITE !," 59. WAS ENTIRE SPECIMEN SUBMITTED"
+4 WRITE !," TO PATHOLOGY..................: NA"
+5 WRITE !," 60. IF MARGINS ARE FREE, WHAT IS"
+6 WRITE !," THE DISTANCE..................: NA"
End DoDot:1
GOTO SLNS
+7 IF $EXTRACT(CDS,1,2)=99
Begin DoDot:1
+8 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,49)=9
+9 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,50)=9
+10 WRITE !," 59. WAS ENTIRE SPECIMEN SUBMITTED"
+11 WRITE !," TO PATHOLOGY..................: Unknown"
+12 WRITE !," 60. IF MARGINS ARE FREE, WHAT IS"
+13 WRITE !," THE DISTANCE..................: Unknown"
End DoDot:1
GOTO SLNS
+14 SET DR="948 59. WAS ENTIRE SPECIMEN SUBMITTED TO PATHOLOGY.................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+15 SET DR="949 60. IF MARGINS ARE FREE, WHAT IS THE DISTANCE.................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
SLNS SET SLNS=ONC(165.5,ONCONUM,138)
+1 SET (SLNS1,SLNS2)=""
SET LOS=$LENGTH(SLNS)
IF LOS<43
SET SLNS1=SLNS
GOTO SLNS1
+2 SET NOP=$LENGTH($EXTRACT(SLNS,1,43)," ")
SET SLNS1=$PIECE(SLNS," ",1,NOP-1)
SET SLNS2=$PIECE(SLNS," ",NOP,999)
SLNS1 WRITE !," 61. SCOPE OF REGIONAL LYMPH NODE"
+1 WRITE !," SURGERY.......................: ",SLNS1
if SLNS2'=""
WRITE !,?37,SLNS2
NLNR WRITE !," 62. NUMBER OF REGIONAL LYMPH NODES"
+1 WRITE !," REMOVED.......................: ",ONC(165.5,ONCONUM,140)
SORS SET SORS=ONC(165.5,ONCONUM,139)
+1 SET (SORS1,SORS2)=""
SET LOS=$LENGTH(SORS)
IF LOS<43
SET SORS1=SORS
GOTO SORS1
+2 SET NOP=$LENGTH($EXTRACT(SORS,1,43)," ")
+3 SET SORS1=$PIECE(SORS," ",1,NOP-1)
SET SORS2=$PIECE(SORS," ",NOP,999)
SORS1 WRITE !," 63. SURGERY OF OTHER REGIONAL"
+1 WRITE !," SITE(S), DISTANT SITE(S),"
+2 WRITE !," OR DISTANT LYMPH NODE(S)......: ",SORS1
if SORS2'=""
WRITE !,?37,SORS2
RR SET RR=ONC(165.5,ONCONUM,23)
+1 SET (RR1,RR2)=""
SET LOS=$LENGTH(RR)
IF LOS<43
SET RR1=RR
GOTO RR1
+2 SET NOP=$LENGTH($EXTRACT(RR,1,43)," ")
SET RR1=$PIECE(RR," ",1,NOP-1)
SET RR2=$PIECE(RR," ",NOP,999)
RR1 WRITE !," 64. RECONSTRUCTION/RESTORATION....: ",RR1
if RR2'=""
WRITE !,?37,RR2
R IF $EXTRACT(CDS,1,2)="00"
Begin DoDot:1
+1 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,51)=8
+2 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,52)=8
+3 WRITE !," 65. RE-EXCISION...................: NA"
+4 WRITE !," 66. MICROSCOPIC STATUS OF FINAL"
+5 WRITE !," MARGIN AFTER RESECTION........: NA"
End DoDot:1
GOTO PRTC
+6 IF $EXTRACT(CDS,1,2)=99
Begin DoDot:1
+7 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,51)=9
+8 SET $PIECE(^ONCO(165.5,D0,"BRE1"),U,52)=9
+9 WRITE !," 65. RE-EXCISION...................: Unknown"
+10 WRITE !," 66. MICROSCOPIC STATUS OF FINAL"
+11 WRITE !," MARGIN AFTER RESECTION........: Unknown"
End DoDot:1
GOTO PRTC
+12 SET DR="950 65. RE-EXCISION..................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+13 IF X=0
Begin DoDot:1
+14 SET $PIECE(^ONCO(165.5,ONCONUM,"BRE1"),U,52)=8
+15 WRITE !," 66. MICROSCOPIC STATUS OF FINAL"
+16 WRITE !," MARGIN AFTER RE-EXCISION......: NA"
End DoDot:1
GOTO PRTC
+17 IF X=9
Begin DoDot:1
+18 SET $PIECE(^ONCO(165.5,ONCONUM,"BRE1"),U,52)=9
+19 WRITE !," 66. MICROSCOPIC STATUS OF FINAL"
+20 WRITE !," MARGIN AFTER RE-EXCISION......: Unknown"
End DoDot:1
GOTO PRTC
+21 SET DR="951 66. MICROSCOPIC STATUS OF FINAL MARGIN AFTER RE-EXCISION......"
DO ^DIE
if $DATA(Y)
GOTO JUMP
PRTC IF ($EXTRACT(CDS,1,2)'="00")&($EXTRACT(CDS,1,2)'=99)
WRITE !
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
+2 GOTO RT^ONCBRP5A
JUMP ;Jump to prompts
+1 SET XX=""
READ !!," GO TO ITEM: ",X:DTIME
IF (X="")!(X[U)
SET OUT="Y"
GOTO EXIT
+2 IF X["?"
Begin DoDot:1
+3 WRITE !," CHOOSE FROM:"
FOR I=1:1:CHOICES
WRITE !," ",HTABLE(I)
End DoDot:1
GOTO JUMP
+4 IF '$DATA(TABLE(X))
if X?1.2N
SET X=X_"."
SET XX=X
SET X=$ORDER(TABLE(X))
IF ($PIECE(X,XX,1)'="")!(X="")
WRITE *7,"??"
Begin DoDot:1
+5 WRITE !," CHOOSE FROM:"
FOR I=1:1:CHOICES
WRITE !," ",HTABLE(I)
End DoDot:1
GOTO JUMP
+6 SET X=TABLE(X)
+7 GOTO @X
EXIT if $DATA(DIRUT)
SET OUT="Y"
+1 KILL CHOICES,PIECE,HTABLE,TABLE
+2 KILL CDS,CDSOT,LOS,NCDS,NCDSOT,NOP,SURG,SURG1,SURG2,SURGDT,SA,SA1,SA2
+3 KILL SM,SM1,SM2,SOORS,SOORS1,SOORS2,SLNS,SLNS1,SLNS2,RAD,HOR,CHE
+4 KILL DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
+5 QUIT
