- 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 Mar 13, 2025@21:26:57 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
