ONCBPC4 ;HIRMFO/GWB - PCE Study of Cancers of the Urinary Bladder Table IV;6/19/96
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
K ONC,TABLE,HTABLE
S TABLE("DATE OF INITIAL TREATMENT")="DOIT^ONCBPC4"
S TABLE("PROTOCOL ELIGIBILITY STATUS")="PES^ONCBPC4"
S TABLE("MANAGING PHYSICIANS")="MP^ONCBPC4"
S TABLE("SURGERY")="SUR^ONCBPC4"
S TABLE("RADIATION THERAPY")="RAD^ONCBPC4A"
S TABLE("CHEMOTHERAPY")="CHEMO^ONCBPC4A"
S TABLE("IMMUNOTHERAPY")="BRM^ONCBPC4A"
S HTABLE(1)="DATE OF INITIAL TREATMENT"
S HTABLE(2)="PROTOCOL ELIGIBILITY STATUS"
S HTABLE(3)="MANAGING PHYSICIANS"
S HTABLE(4)="SURGERY"
S HTABLE(5)="RADIATION THERAPY"
S HTABLE(6)="CHEMOTHERAPY"
S HTABLE(7)="IMMUNOTHERAPY"
S CHOICES=7
S D0=ONCONUM D DFC^ONCOCOM S DOIT=Y
S DIC="^ONCO(165.5,",DR="51.2;53.2;55.2;58.1;58.2",DA=ONCONUM,DIQ="ONC"
S DIQ(0)="IE" D EN^DIQ1
W @IOF D HEAD^ONCBPC0 W !?22,"TABLE IV - FIRST COURSE OF TREATMENT",!
DOIT W !,"DATE OF INITIAL TREATMENT...........: ",DOIT
S DIE="^ONCO(165.5,",DA=ONCONUM
PES S DR="346PROTOCOL ELIGIBILITY STATUS........." D ^DIE G:$D(Y) JUMP
MP W !!,"MANAGING PHYSICIANS:",!
S DR="347 PRIMARY PHYSICIAN................." D ^DIE G:$D(Y) JUMP
S DR="348 SECONDARY PHYSICIAN..............." D ^DIE G:$D(Y) JUMP
SUR W !!,"SURGERY:",!
S NCDS=ONC(165.5,ONCONUM,58.1,"I"),NCDSOT=ONC(165.5,ONCONUM,58.1,"E")
S CDS=ONC(165.5,ONCONUM,58.2,"I"),CDSOT=ONC(165.5,ONCONUM,58.2,"E")
I (CDS="")!(CDS="00") D
.S SURG=NCDSOT,SURGDT=$P($G(^ONCO(165.5,ONCONUM,3)),U,31)
I ((CDS'="")&(CDS'="00"))!(NCDS="") D
.S SURG=CDSOT,SURGDT=$P($G(^ONCO(165.5,ONCONUM,3)),U,1)
S (SURG1,SURG2)="",LOS=$L(SURG) I LOS<43 S SURG1=SURG G DOS
S NOP=$L($E(SURG,1,42)," ")
S SURG1=$P(SURG," ",1,NOP-1),SURG2=$P(SURG," ",NOP,999)
DOS S Y=SURGDT D DATEOT^ONCOPCE S SURGDT=Y
W !," DATE OF SURGERY...................: ",SURGDT
W !," TYPE OF SURGERY...................: ",SURG1
W:SURG2'="" !,?41,SURG2
TURB I (SURG="")!($E(SURG,1)=0)!($E(SURG,1,2)'=10)!(TOPCOD="C68.0") D G TOUD
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,4)=8
.W !," TUMOR RESECTION DURING TURB.......: Not applicable"
S DR="349 TUMOR RESECTION DURING TURB......." D ^DIE G:$D(Y) JUMP
TOUD I (SURG="")!($E(SURG,1)=0)!($E(SURG,1,2)<20)!($E(SURG,1,2)>70) D G PLND
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,5)=8
.W !," TYPE OF URINARY DIVERSION.........: Not applicable"
S DR="350 TYPE OF URINARY DIVERSION........." D ^DIE G:$D(Y) JUMP
PLND I (SURG="")!($E(SURG,1)=0)!($E(SURG,1,2)'=70) D G SC
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,6)=8
.W !," PELVIC LYMPH NODE DISSECTION......: Not applicable"
S DR="351 PELVIC LYMPH NODE DISSECTION......" D ^DIE G:$D(Y) JUMP
SC I (SURG="")!($E(SURG,1)=0) D G:(Y=0)!(Y="") EXIT W @IOF G RAD^ONCBPC4A
.W !!," SURGICAL COMPLICATIONS:",!
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,7)=0
.W !," BLEEDING REQUIRING TRANSFUSION..: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,8)=0
.W !," DEEP VENOUS THROMBOSIS..........: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,9)=0
.W !," MYOCARDIAL INFARCTION/ARRHYTHMIA: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,10)=0
.W !," PELVIC ABSCESS..................: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,11)=0
.W !," PNEUMONIA REQUIRING ANTIBIOTICS.: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,12)=0
.W !," POST-OPERATIVE DEATH (30 DAYS)..: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,13)=0
.W !," PULMONARY EMBOLISM/THROMBOSIS...: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,14)=0
.W !," REOPERATION.....................: No"
.S $P(^ONCO(165.5,ONCONUM,"BLA2"),U,15)=0
.W !," OTHER...........................: No"
.W ! K DIR S DIR(0)="E" D ^DIR
W !!," SURGICAL COMPLICATIONS:",!
S DR="352 BLEEDING REQUIRING TRANSFUSION.." D ^DIE G:$D(Y) JUMP
S DR="353 DEEP VENOUS THROMBOSIS.........." D ^DIE G:$D(Y) JUMP
S DR="354 MYOCARDIAL INFARCTION/ARRHYTHMIA" D ^DIE G:$D(Y) JUMP
S DR="355 PELVIC ABSCESS.................." D ^DIE G:$D(Y) JUMP
S DR="356 PNEUMONIA REQUIRING ANTIBIOTICS." D ^DIE G:$D(Y) JUMP
S DR="357 POST-OPERATIVE DEATH (30 DAYS).." D ^DIE G:$D(Y) JUMP
S DR="358 PULMONARY EMBOLISM/THROMBOSIS..." D ^DIE G:$D(Y) JUMP
S DR="359 REOPERATION....................." D ^DIE G:$D(Y) JUMP
S DR="360 OTHER..........................." D ^DIE G:$D(Y) JUMP
G ^ONCBPC4A
JUMP ;Jump to prompts
S XX="" R !!,"GO TO: ",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 !,?5,HTABLE(I)
I '$D(TABLE(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 !,?5,HTABLE(I)
S X=TABLE(X)
G @X
EXIT K CHOICES,HTABLE,TABLE
K CDS,CDSOT,CHEDT,CHEMO,DOIT,LOS,NCDS,NCDSOT,NOP,RAD,RADDT,SURG,SURG1
K SURG2,SURGDT
K DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCBPC4 4801 printed Nov 22, 2024@17:32:13 Page 2
ONCBPC4 ;HIRMFO/GWB - PCE Study of Cancers of the Urinary Bladder Table IV;6/19/96
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 KILL ONC,TABLE,HTABLE
+3 SET TABLE("DATE OF INITIAL TREATMENT")="DOIT^ONCBPC4"
+4 SET TABLE("PROTOCOL ELIGIBILITY STATUS")="PES^ONCBPC4"
+5 SET TABLE("MANAGING PHYSICIANS")="MP^ONCBPC4"
+6 SET TABLE("SURGERY")="SUR^ONCBPC4"
+7 SET TABLE("RADIATION THERAPY")="RAD^ONCBPC4A"
+8 SET TABLE("CHEMOTHERAPY")="CHEMO^ONCBPC4A"
+9 SET TABLE("IMMUNOTHERAPY")="BRM^ONCBPC4A"
+10 SET HTABLE(1)="DATE OF INITIAL TREATMENT"
+11 SET HTABLE(2)="PROTOCOL ELIGIBILITY STATUS"
+12 SET HTABLE(3)="MANAGING PHYSICIANS"
+13 SET HTABLE(4)="SURGERY"
+14 SET HTABLE(5)="RADIATION THERAPY"
+15 SET HTABLE(6)="CHEMOTHERAPY"
+16 SET HTABLE(7)="IMMUNOTHERAPY"
+17 SET CHOICES=7
+18 SET D0=ONCONUM
DO DFC^ONCOCOM
SET DOIT=Y
+19 SET DIC="^ONCO(165.5,"
SET DR="51.2;53.2;55.2;58.1;58.2"
SET DA=ONCONUM
SET DIQ="ONC"
+20 SET DIQ(0)="IE"
DO EN^DIQ1
+21 WRITE @IOF
DO HEAD^ONCBPC0
WRITE !?22,"TABLE IV - FIRST COURSE OF TREATMENT",!
DOIT WRITE !,"DATE OF INITIAL TREATMENT...........: ",DOIT
+1 SET DIE="^ONCO(165.5,"
SET DA=ONCONUM
PES SET DR="346PROTOCOL ELIGIBILITY STATUS........."
DO ^DIE
if $DATA(Y)
GOTO JUMP
MP WRITE !!,"MANAGING PHYSICIANS:",!
+1 SET DR="347 PRIMARY PHYSICIAN................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+2 SET DR="348 SECONDARY PHYSICIAN..............."
DO ^DIE
if $DATA(Y)
GOTO JUMP
SUR WRITE !!,"SURGERY:",!
+1 SET NCDS=ONC(165.5,ONCONUM,58.1,"I")
SET NCDSOT=ONC(165.5,ONCONUM,58.1,"E")
+2 SET CDS=ONC(165.5,ONCONUM,58.2,"I")
SET CDSOT=ONC(165.5,ONCONUM,58.2,"E")
+3 IF (CDS="")!(CDS="00")
Begin DoDot:1
+4 SET SURG=NCDSOT
SET SURGDT=$PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,31)
End DoDot:1
+5 IF ((CDS'="")&(CDS'="00"))!(NCDS="")
Begin DoDot:1
+6 SET SURG=CDSOT
SET SURGDT=$PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,1)
End DoDot:1
+7 SET (SURG1,SURG2)=""
SET LOS=$LENGTH(SURG)
IF LOS<43
SET SURG1=SURG
GOTO DOS
+8 SET NOP=$LENGTH($EXTRACT(SURG,1,42)," ")
+9 SET SURG1=$PIECE(SURG," ",1,NOP-1)
SET SURG2=$PIECE(SURG," ",NOP,999)
DOS SET Y=SURGDT
DO DATEOT^ONCOPCE
SET SURGDT=Y
+1 WRITE !," DATE OF SURGERY...................: ",SURGDT
+2 WRITE !," TYPE OF SURGERY...................: ",SURG1
+3 if SURG2'=""
WRITE !,?41,SURG2
TURB IF (SURG="")!($EXTRACT(SURG,1)=0)!($EXTRACT(SURG,1,2)'=10)!(TOPCOD="C68.0")
Begin DoDot:1
+1 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,4)=8
+2 WRITE !," TUMOR RESECTION DURING TURB.......: Not applicable"
End DoDot:1
GOTO TOUD
+3 SET DR="349 TUMOR RESECTION DURING TURB......."
DO ^DIE
if $DATA(Y)
GOTO JUMP
TOUD IF (SURG="")!($EXTRACT(SURG,1)=0)!($EXTRACT(SURG,1,2)<20)!($EXTRACT(SURG,1,2)>70)
Begin DoDot:1
+1 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,5)=8
+2 WRITE !," TYPE OF URINARY DIVERSION.........: Not applicable"
End DoDot:1
GOTO PLND
+3 SET DR="350 TYPE OF URINARY DIVERSION........."
DO ^DIE
if $DATA(Y)
GOTO JUMP
PLND IF (SURG="")!($EXTRACT(SURG,1)=0)!($EXTRACT(SURG,1,2)'=70)
Begin DoDot:1
+1 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,6)=8
+2 WRITE !," PELVIC LYMPH NODE DISSECTION......: Not applicable"
End DoDot:1
GOTO SC
+3 SET DR="351 PELVIC LYMPH NODE DISSECTION......"
DO ^DIE
if $DATA(Y)
GOTO JUMP
SC IF (SURG="")!($EXTRACT(SURG,1)=0)
Begin DoDot:1
+1 WRITE !!," SURGICAL COMPLICATIONS:",!
+2 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,7)=0
+3 WRITE !," BLEEDING REQUIRING TRANSFUSION..: No"
+4 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,8)=0
+5 WRITE !," DEEP VENOUS THROMBOSIS..........: No"
+6 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,9)=0
+7 WRITE !," MYOCARDIAL INFARCTION/ARRHYTHMIA: No"
+8 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,10)=0
+9 WRITE !," PELVIC ABSCESS..................: No"
+10 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,11)=0
+11 WRITE !," PNEUMONIA REQUIRING ANTIBIOTICS.: No"
+12 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,12)=0
+13 WRITE !," POST-OPERATIVE DEATH (30 DAYS)..: No"
+14 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,13)=0
+15 WRITE !," PULMONARY EMBOLISM/THROMBOSIS...: No"
+16 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,14)=0
+17 WRITE !," REOPERATION.....................: No"
+18 SET $PIECE(^ONCO(165.5,ONCONUM,"BLA2"),U,15)=0
+19 WRITE !," OTHER...........................: No"
+20 WRITE !
KILL DIR
SET DIR(0)="E"
DO ^DIR
End DoDot:1
if (Y=0)!(Y="")
GOTO EXIT
WRITE @IOF
GOTO RAD^ONCBPC4A
+21 WRITE !!," SURGICAL COMPLICATIONS:",!
+22 SET DR="352 BLEEDING REQUIRING TRANSFUSION.."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+23 SET DR="353 DEEP VENOUS THROMBOSIS.........."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+24 SET DR="354 MYOCARDIAL INFARCTION/ARRHYTHMIA"
DO ^DIE
if $DATA(Y)
GOTO JUMP
+25 SET DR="355 PELVIC ABSCESS.................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+26 SET DR="356 PNEUMONIA REQUIRING ANTIBIOTICS."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+27 SET DR="357 POST-OPERATIVE DEATH (30 DAYS).."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+28 SET DR="358 PULMONARY EMBOLISM/THROMBOSIS..."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+29 SET DR="359 REOPERATION....................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+30 SET DR="360 OTHER..........................."
DO ^DIE
if $DATA(Y)
GOTO JUMP
+31 GOTO ^ONCBPC4A
JUMP ;Jump to prompts
+1 SET XX=""
READ !!,"GO TO: ",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 !,?5,HTABLE(I)
End DoDot:1
GOTO JUMP
+4 IF '$DATA(TABLE(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 !,?5,HTABLE(I)
End DoDot:1
GOTO JUMP
+6 SET X=TABLE(X)
+7 GOTO @X
EXIT KILL CHOICES,HTABLE,TABLE
+1 KILL CDS,CDSOT,CHEDT,CHEMO,DOIT,LOS,NCDS,NCDSOT,NOP,RAD,RADDT,SURG,SURG1
+2 KILL SURG2,SURGDT
+3 KILL DIC
+4 QUIT
