- ONCP2P4 ;HINES CIOFO/GWB - 1998 Prostate Cancer Study - Table IV ;6/1/98
- ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- K TABLE,HTABLE
- S TABLE("SURGERY")="S^ONCP2P4"
- S TABLE("NON CANCER-DIRECTED SURGERY")="NCS^ONCP2P4"
- S TABLE("CANCER-DIRECTED SURGERY")="CS^ONCP2P4"
- S TABLE("RADIATION THERAPY")="RT^ONCP2P4A"
- S TABLE("HORMONE THERAPY")="HOT^ONCP2P4A"
- S TABLE("CHEMOTHERAPY")="CT^ONCP2P4A"
- 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^ONCP2P0
- W !," TABLE IV - 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;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 HOR=$P($G(^ONCO(165.5,ONCONUM,3)),U,16)
- DFCT W !," 33. DATE OF FIRST COURSE TREATMENT.: ",ONC(165.5,ONCONUM,49)
- EMWW S DR="685 34. EXPECTED MGT/WATCHFUL WAITING.." D ^DIE G:$D(Y) JUMP
- S W @IOF D HEAD^ONCP2P0
- W !," SURGERY",!
- W " -------"
- NCS W !," NON CANCER-DIRECTED SURGERY",!
- DNCDS W !," 35. DATE OF NON CA-DIRECTED SURGERY: ",ONC(165.5,ONCONUM,58.3)
- NCDS S NCDS=ONC(165.5,ONCONUM,58.1)
- S (NCDS1,NCDS2)="",LOS=$L(NCDS) I LOS<42 S NCDS1=NCDS G NCDS1
- S NOP=$L($E(NCDS,1,41)," ")
- S NCDS1=$P(NCDS," ",1,NOP-1),NCDS2=$P(NCDS," ",NOP,999)
- NCDS1 W !," 36. NON CANCER-DIRECTED SURGERY....: ",NCDS1 W:NCDS2'="" !,?38,NCDS2
- CS W !," CANCER-DIRECTED SURGERY",!
- DCDS W !," 37. DATE OF CANCER-DIRECTED SURGERY: ",ONC(165.5,ONCONUM,50)
- LSAS I $E(CDS,1,2)="00" D G SA
- .S $P(^ONCO(165.5,D0,"PRO2"),U,30)=88
- .W !," 38. LENGTH OF STAY AFTER SURGERY...: 88 NA"
- I $E(CDS,1,2)=99 D G SA
- .S $P(^ONCO(165.5,D0,"PRO2"),U,30)=99
- .W !," 38. LENGTH OF STAY AFTER SURGERY...: 99 Unknown"
- S DR="686 38. LENGTH OF STAY AFTER SURGERY..." D ^DIE G:$D(Y) JUMP
- SA S SA=ONC(165.5,ONCONUM,74)
- S (SA1,SA2)="",LOS=$L(SA) I LOS<42 S SA1=SA G SA1
- S NOP=$L($E(SA,1,41)," "),SA1=$P(SA," ",1,NOP-1),SA2=$P(SA," ",NOP,999)
- SA1 W !," 39. SURGICAL APPROACH..............: ",SA1 W:SA2'="" !,?38,SA2
- TCDS S (CDS1,CDS2)="",LOS=$L(CDS) I LOS<42 S CDS1=CDS G TCDS1
- S NOP=$L($E(CDS,1,41)," ")
- S CDS1=$P(CDS," ",1,NOP-1),CDS2=$P(CDS," ",NOP,999)
- TCDS1 W !," 40. TYPE OF CANCER-DIRECTED SURGERY: ",CDS1 W:CDS2'="" !,?38,CDS2
- SM S SM=ONC(165.5,ONCONUM,59)
- S (SM1,SM2)="",LOS=$L(SM) I LOS<42 S SM1=SM G SM1
- S NOP=$L($E(SM,1,41)," "),SM1=$P(SM," ",1,NOP-1),SM2=$P(SM," ",NOP,999)
- SM1 W !," 41. SURGICAL MARGINS...............: ",SM1 W:SM2'="" !,?38,SM2
- SLNS W !," 42. SCOPE OF LYMPH NODE SURGERY....: ",ONC(165.5,ONCONUM,138)
- I ($E(CDS,1,2)="00")!($E(CDS,1,2)=99) W ! K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT W @IOF D HEAD^ONCP2P0 G TLNS
- W !
- TLNS W !," 43. TYPE OF LYMPH NODE SURGERY:",!
- I $E(CDS,1,2)="00" D G:$D(DIRUT) EXIT G SORS
- .S $P(^ONCO(165.5,D0,"PRO2"),U,31)=8
- .S $P(^ONCO(165.5,D0,"PRO2"),U,32)=8
- .W !," LAPAROSCOPIC...................: NA"
- .W !," OPEN...........................: NA"
- I $E(CDS,1,2)=99 D G:$D(DIRUT) EXIT G SORS
- .S $P(^ONCO(165.5,D0,"PRO2"),U,31)=9
- .S $P(^ONCO(165.5,D0,"PRO2"),U,32)=9
- .W !," LAPAROSCOPIC...................: Unknown"
- .W !," OPEN...........................: Unknown"
- S DR="687 LAPAROSCOPIC..................." D ^DIE G:$D(Y) JUMP
- S DR="688 OPEN..........................." D ^DIE G:$D(Y) JUMP
- SORS S SORS=ONC(165.5,ONCONUM,139)
- S (SORS1,SORS2)="",LOS=$L(SORS) I LOS<42 S SORS1=SORS G SORS1
- S NOP=$L($E(SORS,1,41)," ")
- S SORS1=$P(SORS," ",1,NOP-1),SORS2=$P(SORS," ",NOP,999)
- SORS1 W !!," 44. SURGERY OF OTHER REGIONAL SITE(S), DISTANT SITE(S),"
- W !," OR DISTANT LYMPH NODE(S).......: ",SORS1 W:SORS2'="" !,?38,SORS2
- NLNR W !," 45. NUMBER OF LYMPH NODES REMOVED..: ",ONC(165.5,ONCONUM,140)
- RR W !," 46. RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,ONCONUM,23)
- CFSFCT W !!," 47. COMPLICATIONS FOLLOWING SURGICAL FIRST COURSE OF TREATMENT:",!
- I $E(CDS,1,2)="00" D G:$D(DIRUT) EXIT G PRTC
- .S $P(^ONCO(165.5,D0,"PRO2"),U,33)=8
- .S $P(^ONCO(165.5,D0,"PRO2"),U,34)=8
- .S $P(^ONCO(165.5,D0,"PRO2"),U,35)=8
- .S $P(^ONCO(165.5,D0,"THY1"),U,42)=8
- .W !," PERMANENT RECTAL INJURY........: NA, no surgery"
- .W !," THROMBOEMBOLISM................: NA, no surgery"
- .W !," URETHRAL STRICTURE.............: NA, no surgery"
- .W ! K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) W @IOF D HEAD^ONCP2P0
- .W !!," 48. POSTOPERATIVE DEATH W/I 30 DAYS: NA, no surgery"
- I $E(CDS,1,2)=99 D G:$D(DIRUT) EXIT G PRTC
- .S $P(^ONCO(165.5,D0,"PRO2"),U,33)=9
- .S $P(^ONCO(165.5,D0,"PRO2"),U,34)=9
- .S $P(^ONCO(165.5,D0,"PRO2"),U,35)=9
- .S $P(^ONCO(165.5,D0,"THY1"),U,42)=9
- .W !," PERMANENT RECTAL INJURY........: Unknown"
- .W !," THROMBOEMBOLISM................: Unknown"
- .W !," URETHRAL STRICTURE.............: Unknown"
- .W ! K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) W @IOF D HEAD^ONCP2P0
- .W !!," 48. POSTOPERATIVE DEATH W/I 30 DAYS: Unknown"
- S DR="689 PERMANENT RECTAL INJURY........" D ^DIE G:$D(Y) JUMP
- S DR="690 THROMBOEMBOLISM................" D ^DIE G:$D(Y) JUMP
- S DR="691 URETHRAL STRICTURE............." D ^DIE G:$D(Y) JUMP
- PDWTD S DR="441 48. POSTOPERATIVE DEATH W/I 3O DAYS" D ^DIE G:$D(Y) JUMP
- PRTC W ! K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT
- G RT^ONCP2P4A
- 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
- K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCP2P4 6079 printed Apr 23, 2025@18:41:24 Page 2
- ONCP2P4 ;HINES CIOFO/GWB - 1998 Prostate Cancer Study - Table IV ;6/1/98
- +1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
- +2 KILL TABLE,HTABLE
- +3 SET TABLE("SURGERY")="S^ONCP2P4"
- +4 SET TABLE("NON CANCER-DIRECTED SURGERY")="NCS^ONCP2P4"
- +5 SET TABLE("CANCER-DIRECTED SURGERY")="CS^ONCP2P4"
- +6 SET TABLE("RADIATION THERAPY")="RT^ONCP2P4A"
- +7 SET TABLE("HORMONE THERAPY")="HOT^ONCP2P4A"
- +8 SET TABLE("CHEMOTHERAPY")="CT^ONCP2P4A"
- +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^ONCP2P0
- +17 WRITE !," TABLE IV - 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;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 HOR=$PIECE($GET(^ONCO(165.5,ONCONUM,3)),U,16)
- DFCT WRITE !," 33. DATE OF FIRST COURSE TREATMENT.: ",ONC(165.5,ONCONUM,49)
- EMWW SET DR="685 34. EXPECTED MGT/WATCHFUL WAITING.."
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- S WRITE @IOF
- DO HEAD^ONCP2P0
- +1 WRITE !," SURGERY",!
- +2 WRITE " -------"
- NCS WRITE !," NON CANCER-DIRECTED SURGERY",!
- DNCDS WRITE !," 35. DATE OF NON CA-DIRECTED 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<42
- SET NCDS1=NCDS
- GOTO NCDS1
- +2 SET NOP=$LENGTH($EXTRACT(NCDS,1,41)," ")
- +3 SET NCDS1=$PIECE(NCDS," ",1,NOP-1)
- SET NCDS2=$PIECE(NCDS," ",NOP,999)
- NCDS1 WRITE !," 36. NON CANCER-DIRECTED SURGERY....: ",NCDS1
- if NCDS2'=""
- WRITE !,?38,NCDS2
- CS WRITE !," CANCER-DIRECTED SURGERY",!
- DCDS WRITE !," 37. DATE OF CANCER-DIRECTED SURGERY: ",ONC(165.5,ONCONUM,50)
- LSAS IF $EXTRACT(CDS,1,2)="00"
- Begin DoDot:1
- +1 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,30)=88
- +2 WRITE !," 38. LENGTH OF STAY AFTER SURGERY...: 88 NA"
- End DoDot:1
- GOTO SA
- +3 IF $EXTRACT(CDS,1,2)=99
- Begin DoDot:1
- +4 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,30)=99
- +5 WRITE !," 38. LENGTH OF STAY AFTER SURGERY...: 99 Unknown"
- End DoDot:1
- GOTO SA
- +6 SET DR="686 38. LENGTH OF STAY AFTER SURGERY..."
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- SA SET SA=ONC(165.5,ONCONUM,74)
- +1 SET (SA1,SA2)=""
- SET LOS=$LENGTH(SA)
- IF LOS<42
- SET SA1=SA
- GOTO SA1
- +2 SET NOP=$LENGTH($EXTRACT(SA,1,41)," ")
- SET SA1=$PIECE(SA," ",1,NOP-1)
- SET SA2=$PIECE(SA," ",NOP,999)
- SA1 WRITE !," 39. SURGICAL APPROACH..............: ",SA1
- if SA2'=""
- WRITE !,?38,SA2
- TCDS SET (CDS1,CDS2)=""
- SET LOS=$LENGTH(CDS)
- IF LOS<42
- SET CDS1=CDS
- GOTO TCDS1
- +1 SET NOP=$LENGTH($EXTRACT(CDS,1,41)," ")
- +2 SET CDS1=$PIECE(CDS," ",1,NOP-1)
- SET CDS2=$PIECE(CDS," ",NOP,999)
- TCDS1 WRITE !," 40. TYPE OF CANCER-DIRECTED SURGERY: ",CDS1
- if CDS2'=""
- WRITE !,?38,CDS2
- SM SET SM=ONC(165.5,ONCONUM,59)
- +1 SET (SM1,SM2)=""
- SET LOS=$LENGTH(SM)
- IF LOS<42
- SET SM1=SM
- GOTO SM1
- +2 SET NOP=$LENGTH($EXTRACT(SM,1,41)," ")
- SET SM1=$PIECE(SM," ",1,NOP-1)
- SET SM2=$PIECE(SM," ",NOP,999)
- SM1 WRITE !," 41. SURGICAL MARGINS...............: ",SM1
- if SM2'=""
- WRITE !,?38,SM2
- SLNS WRITE !," 42. SCOPE OF LYMPH NODE SURGERY....: ",ONC(165.5,ONCONUM,138)
- +1 IF ($EXTRACT(CDS,1,2)="00")!($EXTRACT(CDS,1,2)=99)
- WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- GOTO EXIT
- WRITE @IOF
- DO HEAD^ONCP2P0
- GOTO TLNS
- +2 WRITE !
- TLNS WRITE !," 43. TYPE OF LYMPH NODE SURGERY:",!
- +1 IF $EXTRACT(CDS,1,2)="00"
- Begin DoDot:1
- +2 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,31)=8
- +3 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,32)=8
- +4 WRITE !," LAPAROSCOPIC...................: NA"
- +5 WRITE !," OPEN...........................: NA"
- End DoDot:1
- if $DATA(DIRUT)
- GOTO EXIT
- GOTO SORS
- +6 IF $EXTRACT(CDS,1,2)=99
- Begin DoDot:1
- +7 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,31)=9
- +8 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,32)=9
- +9 WRITE !," LAPAROSCOPIC...................: Unknown"
- +10 WRITE !," OPEN...........................: Unknown"
- End DoDot:1
- if $DATA(DIRUT)
- GOTO EXIT
- GOTO SORS
- +11 SET DR="687 LAPAROSCOPIC..................."
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- +12 SET DR="688 OPEN..........................."
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- SORS SET SORS=ONC(165.5,ONCONUM,139)
- +1 SET (SORS1,SORS2)=""
- SET LOS=$LENGTH(SORS)
- IF LOS<42
- SET SORS1=SORS
- GOTO SORS1
- +2 SET NOP=$LENGTH($EXTRACT(SORS,1,41)," ")
- +3 SET SORS1=$PIECE(SORS," ",1,NOP-1)
- SET SORS2=$PIECE(SORS," ",NOP,999)
- SORS1 WRITE !!," 44. SURGERY OF OTHER REGIONAL SITE(S), DISTANT SITE(S),"
- +1 WRITE !," OR DISTANT LYMPH NODE(S).......: ",SORS1
- if SORS2'=""
- WRITE !,?38,SORS2
- NLNR WRITE !," 45. NUMBER OF LYMPH NODES REMOVED..: ",ONC(165.5,ONCONUM,140)
- RR WRITE !," 46. RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,ONCONUM,23)
- CFSFCT WRITE !!," 47. COMPLICATIONS FOLLOWING SURGICAL FIRST COURSE OF TREATMENT:",!
- +1 IF $EXTRACT(CDS,1,2)="00"
- Begin DoDot:1
- +2 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,33)=8
- +3 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,34)=8
- +4 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,35)=8
- +5 SET $PIECE(^ONCO(165.5,D0,"THY1"),U,42)=8
- +6 WRITE !," PERMANENT RECTAL INJURY........: NA, no surgery"
- +7 WRITE !," THROMBOEMBOLISM................: NA, no surgery"
- +8 WRITE !," URETHRAL STRICTURE.............: NA, no surgery"
- +9 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- WRITE @IOF
- DO HEAD^ONCP2P0
- +10 WRITE !!," 48. POSTOPERATIVE DEATH W/I 30 DAYS: NA, no surgery"
- End DoDot:1
- if $DATA(DIRUT)
- GOTO EXIT
- GOTO PRTC
- +11 IF $EXTRACT(CDS,1,2)=99
- Begin DoDot:1
- +12 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,33)=9
- +13 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,34)=9
- +14 SET $PIECE(^ONCO(165.5,D0,"PRO2"),U,35)=9
- +15 SET $PIECE(^ONCO(165.5,D0,"THY1"),U,42)=9
- +16 WRITE !," PERMANENT RECTAL INJURY........: Unknown"
- +17 WRITE !," THROMBOEMBOLISM................: Unknown"
- +18 WRITE !," URETHRAL STRICTURE.............: Unknown"
- +19 WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- WRITE @IOF
- DO HEAD^ONCP2P0
- +20 WRITE !!," 48. POSTOPERATIVE DEATH W/I 30 DAYS: Unknown"
- End DoDot:1
- if $DATA(DIRUT)
- GOTO EXIT
- GOTO PRTC
- +21 SET DR="689 PERMANENT RECTAL INJURY........"
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- +22 SET DR="690 THROMBOEMBOLISM................"
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- +23 SET DR="691 URETHRAL STRICTURE............."
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- PDWTD SET DR="441 48. POSTOPERATIVE DEATH W/I 3O DAYS"
- DO ^DIE
- if $DATA(Y)
- GOTO JUMP
- PRTC WRITE !
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- GOTO EXIT
- +1 GOTO RT^ONCP2P4A
- 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
- +4 KILL DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
- +5 QUIT
