source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCP2P4.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1ONCP2P4 ;HINES CIOFO/GWB - 1998 Prostate Cancer Study - Table IV ;6/1/98
2 ;;2.11;ONCOLOGY;**18**;Mar 07, 1995
3 K TABLE,HTABLE
4 S TABLE("SURGERY")="S^ONCP2P4"
5 S TABLE("NON CANCER-DIRECTED SURGERY")="NCS^ONCP2P4"
6 S TABLE("CANCER-DIRECTED SURGERY")="CS^ONCP2P4"
7 S TABLE("RADIATION THERAPY")="RT^ONCP2P4A"
8 S TABLE("HORMONE THERAPY")="HOT^ONCP2P4A"
9 S TABLE("CHEMOTHERAPY")="CT^ONCP2P4A"
10 S HTABLE(1)="SURGERY"
11 S HTABLE(2)="NON CANCER-DIRECTED SURGERY"
12 S HTABLE(3)="CANCER-DIRECTED SURGERY"
13 S HTABLE(4)="RADIATION THERAPY"
14 S HTABLE(5)="HORMONE THERAPY"
15 S HTABLE(6)="CHEMOTHERAPY"
16 S CHOICES=6
17 W @IOF D HEAD^ONCP2P0
18 W !," TABLE IV - FIRST COURSE OF TREATMENT"
19 W !," ------------------------------------"
20 K DIQ,ONC S DIC="^ONCO(165.5,"
21 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"
22 S DA=ONCONUM,DIQ="ONC" D EN^DIQ1
23 S DIE="^ONCO(165.5,",DA=ONCONUM
24 S CDS=ONC(165.5,ONCONUM,58.2)
25 S RAD=$P($G(^ONCO(165.5,ONCONUM,3)),U,6)
26 S HOR=$P($G(^ONCO(165.5,ONCONUM,3)),U,16)
27DFCT W !," 33. DATE OF FIRST COURSE TREATMENT.: ",ONC(165.5,ONCONUM,49)
28EMWW S DR="685 34. EXPECTED MGT/WATCHFUL WAITING.." D ^DIE G:$D(Y) JUMP
29S W @IOF D HEAD^ONCP2P0
30 W !," SURGERY",!
31 W " -------"
32NCS W !," NON CANCER-DIRECTED SURGERY",!
33DNCDS W !," 35. DATE OF NON CA-DIRECTED SURGERY: ",ONC(165.5,ONCONUM,58.3)
34NCDS S NCDS=ONC(165.5,ONCONUM,58.1)
35 S (NCDS1,NCDS2)="",LOS=$L(NCDS) I LOS<42 S NCDS1=NCDS G NCDS1
36 S NOP=$L($E(NCDS,1,41)," ")
37 S NCDS1=$P(NCDS," ",1,NOP-1),NCDS2=$P(NCDS," ",NOP,999)
38NCDS1 W !," 36. NON CANCER-DIRECTED SURGERY....: ",NCDS1 W:NCDS2'="" !,?38,NCDS2
39CS W !," CANCER-DIRECTED SURGERY",!
40DCDS W !," 37. DATE OF CANCER-DIRECTED SURGERY: ",ONC(165.5,ONCONUM,50)
41LSAS I $E(CDS,1,2)="00" D G SA
42 .S $P(^ONCO(165.5,D0,"PRO2"),U,30)=88
43 .W !," 38. LENGTH OF STAY AFTER SURGERY...: 88 NA"
44 I $E(CDS,1,2)=99 D G SA
45 .S $P(^ONCO(165.5,D0,"PRO2"),U,30)=99
46 .W !," 38. LENGTH OF STAY AFTER SURGERY...: 99 Unknown"
47 S DR="686 38. LENGTH OF STAY AFTER SURGERY..." D ^DIE G:$D(Y) JUMP
48SA S SA=ONC(165.5,ONCONUM,74)
49 S (SA1,SA2)="",LOS=$L(SA) I LOS<42 S SA1=SA G SA1
50 S NOP=$L($E(SA,1,41)," "),SA1=$P(SA," ",1,NOP-1),SA2=$P(SA," ",NOP,999)
51SA1 W !," 39. SURGICAL APPROACH..............: ",SA1 W:SA2'="" !,?38,SA2
52TCDS S (CDS1,CDS2)="",LOS=$L(CDS) I LOS<42 S CDS1=CDS G TCDS1
53 S NOP=$L($E(CDS,1,41)," ")
54 S CDS1=$P(CDS," ",1,NOP-1),CDS2=$P(CDS," ",NOP,999)
55TCDS1 W !," 40. TYPE OF CANCER-DIRECTED SURGERY: ",CDS1 W:CDS2'="" !,?38,CDS2
56SM S SM=ONC(165.5,ONCONUM,59)
57 S (SM1,SM2)="",LOS=$L(SM) I LOS<42 S SM1=SM G SM1
58 S NOP=$L($E(SM,1,41)," "),SM1=$P(SM," ",1,NOP-1),SM2=$P(SM," ",NOP,999)
59SM1 W !," 41. SURGICAL MARGINS...............: ",SM1 W:SM2'="" !,?38,SM2
60SLNS W !," 42. SCOPE OF LYMPH NODE SURGERY....: ",ONC(165.5,ONCONUM,138)
61 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
62 W !
63TLNS W !," 43. TYPE OF LYMPH NODE SURGERY:",!
64 I $E(CDS,1,2)="00" D G:$D(DIRUT) EXIT G SORS
65 .S $P(^ONCO(165.5,D0,"PRO2"),U,31)=8
66 .S $P(^ONCO(165.5,D0,"PRO2"),U,32)=8
67 .W !," LAPAROSCOPIC...................: NA"
68 .W !," OPEN...........................: NA"
69 I $E(CDS,1,2)=99 D G:$D(DIRUT) EXIT G SORS
70 .S $P(^ONCO(165.5,D0,"PRO2"),U,31)=9
71 .S $P(^ONCO(165.5,D0,"PRO2"),U,32)=9
72 .W !," LAPAROSCOPIC...................: Unknown"
73 .W !," OPEN...........................: Unknown"
74 S DR="687 LAPAROSCOPIC..................." D ^DIE G:$D(Y) JUMP
75 S DR="688 OPEN..........................." D ^DIE G:$D(Y) JUMP
76SORS S SORS=ONC(165.5,ONCONUM,139)
77 S (SORS1,SORS2)="",LOS=$L(SORS) I LOS<42 S SORS1=SORS G SORS1
78 S NOP=$L($E(SORS,1,41)," ")
79 S SORS1=$P(SORS," ",1,NOP-1),SORS2=$P(SORS," ",NOP,999)
80SORS1 W !!," 44. SURGERY OF OTHER REGIONAL SITE(S), DISTANT SITE(S),"
81 W !," OR DISTANT LYMPH NODE(S).......: ",SORS1 W:SORS2'="" !,?38,SORS2
82NLNR W !," 45. NUMBER OF LYMPH NODES REMOVED..: ",ONC(165.5,ONCONUM,140)
83RR W !," 46. RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,ONCONUM,23)
84CFSFCT W !!," 47. COMPLICATIONS FOLLOWING SURGICAL FIRST COURSE OF TREATMENT:",!
85 I $E(CDS,1,2)="00" D G:$D(DIRUT) EXIT G PRTC
86 .S $P(^ONCO(165.5,D0,"PRO2"),U,33)=8
87 .S $P(^ONCO(165.5,D0,"PRO2"),U,34)=8
88 .S $P(^ONCO(165.5,D0,"PRO2"),U,35)=8
89 .S $P(^ONCO(165.5,D0,"THY1"),U,42)=8
90 .W !," PERMANENT RECTAL INJURY........: NA, no surgery"
91 .W !," THROMBOEMBOLISM................: NA, no surgery"
92 .W !," URETHRAL STRICTURE.............: NA, no surgery"
93 .W ! K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) W @IOF D HEAD^ONCP2P0
94 .W !!," 48. POSTOPERATIVE DEATH W/I 30 DAYS: NA, no surgery"
95 I $E(CDS,1,2)=99 D G:$D(DIRUT) EXIT G PRTC
96 .S $P(^ONCO(165.5,D0,"PRO2"),U,33)=9
97 .S $P(^ONCO(165.5,D0,"PRO2"),U,34)=9
98 .S $P(^ONCO(165.5,D0,"PRO2"),U,35)=9
99 .S $P(^ONCO(165.5,D0,"THY1"),U,42)=9
100 .W !," PERMANENT RECTAL INJURY........: Unknown"
101 .W !," THROMBOEMBOLISM................: Unknown"
102 .W !," URETHRAL STRICTURE.............: Unknown"
103 .W ! K DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT) W @IOF D HEAD^ONCP2P0
104 .W !!," 48. POSTOPERATIVE DEATH W/I 30 DAYS: Unknown"
105 S DR="689 PERMANENT RECTAL INJURY........" D ^DIE G:$D(Y) JUMP
106 S DR="690 THROMBOEMBOLISM................" D ^DIE G:$D(Y) JUMP
107 S DR="691 URETHRAL STRICTURE............." D ^DIE G:$D(Y) JUMP
108PDWTD S DR="441 48. POSTOPERATIVE DEATH W/I 3O DAYS" D ^DIE G:$D(Y) JUMP
109PRTC W ! K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT
110 G RT^ONCP2P4A
111JUMP ;Jump to prompts
112 S XX="" R !!," GO TO ITEM: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
113 I X["?" D G JUMP
114 .W !," CHOOSE FROM:" F I=1:1:CHOICES W !," ",HTABLE(I)
115 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
116 .W !," CHOOSE FROM:" F I=1:1:CHOICES W !," ",HTABLE(I)
117 S X=TABLE(X)
118 G @X
119EXIT S:$D(DIRUT) OUT="Y"
120 K CHOICES,PIECE,HTABLE,TABLE
121 K CDS,CDSOT,LOS,NCDS,NCDSOT,NOP,SURG,SURG1,SURG2,SURGDT,SA,SA1,SA2
122 K SM,SM1,SM2,SOORS,SOORS1,SOORS2
123 K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
124 Q
Note: See TracBrowser for help on using the repository browser.