source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCBRP5.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: 6.2 KB
RevLine 
[613]1ONCBRP5 ;HINES CIOFO/GWB - 1998 Breast Cancer Study - Table V ;6/1/98
2 ;;2.11;ONCOLOGY;**18**;Mar 07, 1995
3 K TABLE,HTABLE
4 S TABLE("SURGERY")="S^ONCBRP5"
5 S TABLE("NON CANCER-DIRECTED SURGERY")="NCS^ONCBRP5"
6 S TABLE("CANCER-DIRECTED SURGERY")="CS^ONCBRP5"
7 S TABLE("RADIATION THERAPY")="RT^ONCBRP5A"
8 S TABLE("HORMONE THERAPY")="HOT^ONCBRP5A"
9 S TABLE("CHEMOTHERAPY")="CT^ONCBRP5A"
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^ONCBRP0
18 W !," TABLE V - 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;75;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 CHE=$P($G(^ONCO(165.5,ONCONUM,3)),U,13)
27 S HOR=$P($G(^ONCO(165.5,ONCONUM,3)),U,16)
28DFCT W !," 51. DATE OF FIRST COURSE TREATMENT: ",ONC(165.5,ONCONUM,49)
29S W !!," SURGERY",!
30 W " -------"
31NCS W !," NON CANCER-DIRECTED SURGERY",!
32DNCDS W !," 52. DATE OF NON CANCER-DIRECTED"
33 W !," 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<43 S NCDS1=NCDS G NCDS1
36 S NOP=$L($E(NCDS,1,43)," ")
37 S NCDS1=$P(NCDS," ",1,NOP-1),NCDS2=$P(NCDS," ",NOP,999)
38NCDS1 W !," 53. NON CANCER-DIRECTED SURGERY...: ",NCDS1 W:NCDS2'="" !,?37,NCDS2
39CS W !," CANCER-DIRECTED SURGERY",!
40DCDS W !," 54. DATE (FIRST) OF CANCER-"
41 W !," DIRECTED SURGERY..............: ",ONC(165.5,ONCONUM,50)
42 W ! K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT W @IOF D HEAD^ONCBRP0
43SA S SA=ONC(165.5,ONCONUM,74)
44 S (SA1,SA2)="",LOS=$L(SA) I LOS<43 S SA1=SA G SA1
45 S NOP=$L($E(SA,1,43)," "),SA1=$P(SA," ",1,NOP-1),SA2=$P(SA," ",NOP,999)
46SA1 W !," 55. SURGICAL APPROACH.............: ",SA1 W:SA2'="" !,?37,SA2
47SPS S (CDS1,CDS2)="",LOS=$L(CDS) I LOS<43 S CDS1=CDS G SPS1
48 S NOP=$L($E(CDS,1,43)," "),CDS1=$P(CDS," ",1,NOP-1),CDS2=$P(CDS," ",NOP,999)
49SPS1 W !," 56. SURGERY OF PRIMARY SITE.......: ",CDS1 W:CDS2'="" !,?37,CDS2
50SR I $E(CDS,1,2)="00" D G SM
51 .S $P(^ONCO(165.5,D0,"BRE1"),U,48)=8
52 .W !," 57. SPECIMEN RADIOGRAPH...........: NA"
53 I $E(CDS,1,2)=99 D G SM
54 .S $P(^ONCO(165.5,D0,"BRE1"),U,48)=9
55 .W !," 57. SPECIMEN RADIOGRAPH...........: Unknown"
56 S DR="947 57. SPECIMEN RADIOGRAPH..........." D ^DIE G:$D(Y) JUMP
57SM S SM=ONC(165.5,ONCONUM,59)
58 S (SM1,SM2)="",LOS=$L(SM) I LOS<43 S SM1=SM G SM1
59 S NOP=$L($E(SM,1,43)," "),SM1=$P(SM," ",1,NOP-1),SM2=$P(SM," ",NOP,999)
60SM1 W !," 58. SURGICAL MARGINS..............: ",SM1 W:SM2'="" !,?37,SM2
61WESSP I $E(CDS,1,2)="00" D G SLNS
62 .S $P(^ONCO(165.5,D0,"BRE1"),U,49)=8
63 .S $P(^ONCO(165.5,D0,"BRE1"),U,50)=8
64 .W !," 59. WAS ENTIRE SPECIMEN SUBMITTED"
65 .W !," TO PATHOLOGY..................: NA"
66 .W !," 60. IF MARGINS ARE FREE, WHAT IS"
67 .W !," THE DISTANCE..................: NA"
68 I $E(CDS,1,2)=99 D G SLNS
69 .S $P(^ONCO(165.5,D0,"BRE1"),U,49)=9
70 .S $P(^ONCO(165.5,D0,"BRE1"),U,50)=9
71 .W !," 59. WAS ENTIRE SPECIMEN SUBMITTED"
72 .W !," TO PATHOLOGY..................: Unknown"
73 .W !," 60. IF MARGINS ARE FREE, WHAT IS"
74 .W !," THE DISTANCE..................: Unknown"
75 S DR="948 59. WAS ENTIRE SPECIMEN SUBMITTED TO PATHOLOGY.................." D ^DIE G:$D(Y) JUMP
76 S DR="949 60. IF MARGINS ARE FREE, WHAT IS THE DISTANCE.................." D ^DIE G:$D(Y) JUMP
77SLNS S SLNS=ONC(165.5,ONCONUM,138)
78 S (SLNS1,SLNS2)="",LOS=$L(SLNS) I LOS<43 S SLNS1=SLNS G SLNS1
79 S NOP=$L($E(SLNS,1,43)," "),SLNS1=$P(SLNS," ",1,NOP-1),SLNS2=$P(SLNS," ",NOP,999)
80SLNS1 W !," 61. SCOPE OF REGIONAL LYMPH NODE"
81 W !," SURGERY.......................: ",SLNS1 W:SLNS2'="" !,?37,SLNS2
82NLNR W !," 62. NUMBER OF REGIONAL LYMPH NODES"
83 W !," REMOVED.......................: ",ONC(165.5,ONCONUM,140)
84SORS S SORS=ONC(165.5,ONCONUM,139)
85 S (SORS1,SORS2)="",LOS=$L(SORS) I LOS<43 S SORS1=SORS G SORS1
86 S NOP=$L($E(SORS,1,43)," ")
87 S SORS1=$P(SORS," ",1,NOP-1),SORS2=$P(SORS," ",NOP,999)
88SORS1 W !," 63. SURGERY OF OTHER REGIONAL"
89 W !," SITE(S), DISTANT SITE(S),"
90 W !," OR DISTANT LYMPH NODE(S)......: ",SORS1 W:SORS2'="" !,?37,SORS2
91RR S RR=ONC(165.5,ONCONUM,23)
92 S (RR1,RR2)="",LOS=$L(RR) I LOS<43 S RR1=RR G RR1
93 S NOP=$L($E(RR,1,43)," "),RR1=$P(RR," ",1,NOP-1),RR2=$P(RR," ",NOP,999)
94RR1 W !," 64. RECONSTRUCTION/RESTORATION....: ",RR1 W:RR2'="" !,?37,RR2
95R I $E(CDS,1,2)="00" D G PRTC
96 .S $P(^ONCO(165.5,D0,"BRE1"),U,51)=8
97 .S $P(^ONCO(165.5,D0,"BRE1"),U,52)=8
98 .W !," 65. RE-EXCISION...................: NA"
99 .W !," 66. MICROSCOPIC STATUS OF FINAL"
100 .W !," MARGIN AFTER RESECTION........: NA"
101 I $E(CDS,1,2)=99 D G PRTC
102 .S $P(^ONCO(165.5,D0,"BRE1"),U,51)=9
103 .S $P(^ONCO(165.5,D0,"BRE1"),U,52)=9
104 .W !," 65. RE-EXCISION...................: Unknown"
105 .W !," 66. MICROSCOPIC STATUS OF FINAL"
106 .W !," MARGIN AFTER RESECTION........: Unknown"
107 S DR="950 65. RE-EXCISION..................." D ^DIE G:$D(Y) JUMP
108 I X=0 D G PRTC
109 .S $P(^ONCO(165.5,ONCONUM,"BRE1"),U,52)=8
110 .W !," 66. MICROSCOPIC STATUS OF FINAL"
111 .W !," MARGIN AFTER RE-EXCISION......: NA"
112 I X=9 D G PRTC
113 .S $P(^ONCO(165.5,ONCONUM,"BRE1"),U,52)=9
114 .W !," 66. MICROSCOPIC STATUS OF FINAL"
115 .W !," MARGIN AFTER RE-EXCISION......: Unknown"
116 S DR="951 66. MICROSCOPIC STATUS OF FINAL MARGIN AFTER RE-EXCISION......" D ^DIE G:$D(Y) JUMP
117PRTC I ($E(CDS,1,2)'="00")&($E(CDS,1,2)'=99) W !
118 K DIR S DIR(0)="E" D ^DIR G:$D(DIRUT) EXIT
119 G RT^ONCBRP5A
120JUMP ;Jump to prompts
121 S XX="" R !!," GO TO ITEM: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
122 I X["?" D G JUMP
123 .W !," CHOOSE FROM:" F I=1:1:CHOICES W !," ",HTABLE(I)
124 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
125 .W !," CHOOSE FROM:" F I=1:1:CHOICES W !," ",HTABLE(I)
126 S X=TABLE(X)
127 G @X
128EXIT S:$D(DIRUT) OUT="Y"
129 K CHOICES,PIECE,HTABLE,TABLE
130 K CDS,CDSOT,LOS,NCDS,NCDSOT,NOP,SURG,SURG1,SURG2,SURGDT,SA,SA1,SA2
131 K SM,SM1,SM2,SOORS,SOORS1,SOORS2,SLNS,SLNS1,SLNS2,RAD,HOR,CHE
132 K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
133 Q
Note: See TracBrowser for help on using the repository browser.