source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOTNE.m@ 1635

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1ONCOTNE ;Hines OIFO/GWB,RTK - TNM STAGING ERROR & BYPASS MESSAGES ;9/27/93
2 ;;2.11;ONCOLOGY;**1,6,15,18,19,25,27,29,32,33,36**;Mar 07, 1995
3 ;
4BRST ;Screening or Biopsy Procedures (Breast)
5 S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S Y="@395" Q
6 I TOPSITE>67499,TOPSITE<67510 D Q
7 .W !!,"------------------------------"
8 .W !,"SCREENING OR BIOPSY PROCEDURES"
9 .W !,"------------------------------"
10 S $P(^ONCO(165.5,D0,2.1),U,14)=0
11BRSTF0 S $P(^ONCO(165.5,D0,2.1),U,15)=0
12 S $P(^ONCO(165.5,D0,2.1),U,16)=0
13 S $P(^ONCO(165.5,D0,2.1),U,17)=0
14 S Y="@1445"
15 Q
16BRSTF9 ;
17 S $P(^ONCO(165.5,D0,2.1),U,15)=9
18 S $P(^ONCO(165.5,D0,2.1),U,16)=9
19 S $P(^ONCO(165.5,D0,2.1),U,17)=9
20 S Y="@1445"
21 Q
22BRWRIT ;
23 K ONCBR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCBR(",DIQ(0)="E"
24 S DR="142;143;144" D EN^DIQ1
25 F I=142,143,144 S X=ONCBR(165.5,D0,I) D UCASE S ONCBR(165.5,D0,I)=X
26 W !,"GUIDANCE..............: "_ONCBR(165.5,DA,142,"E")
27 W !,"PALPABILITY OF PRIMARY: "_ONCBR(165.5,DA,143,"E")
28 W !,"FIRST DETECTED BY.....: "_ONCBR(165.5,DA,144,"E")
29 K ONCBR
30 W ! K DIR S DIR(0)="E" D ^DIR
31 S Y="@1445"
32 Q
33PRST ;Screening or Biopsy Procedures (Prostate)
34 S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S Y="@395" Q
35 I TOPSITE=67619 D Q
36 .W !,"------------------------------"
37 .W !,"SCREENING OR BIOPSY PROCEDURES"
38 .W !,"------------------------------"
39 S $P(^ONCO(165.5,D0,2.1),U,18)=0
40PRSTF0 S $P(^ONCO(165.5,D0,2.1),U,19)=0
41 S $P(^ONCO(165.5,D0,2.1),U,20)=0
42 S $P(^ONCO(165.5,D0,2.1),U,21)=0
43 S Y="@395"
44 Q
45PRSTF9 ;
46 S $P(^ONCO(165.5,D0,2.1),U,19)=9
47 S $P(^ONCO(165.5,D0,2.1),U,20)=9
48 S $P(^ONCO(165.5,D0,2.1),U,21)=9
49 S Y="@395"
50 Q
51PRWRIT ;
52 K ONCPR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCPR(",DIQ(0)="E"
53 S DR="146;147;148" D EN^DIQ1
54 F I=146,147,148 S X=ONCPR(165.5,D0,I) D UCASE S ONCPR(165.5,D0,I)=X
55 W !,"GUIDANCE......................: "_ONCPR(165.5,DA,146,"E")
56 W !,"APPROACH FOR BIOPSY OF PRIMARY: "_ONCPR(165.5,DA,147,"E")
57 W !,"BIOPSY OF OTHER THAN PRIMARY..: "_$E(ONCPR(165.5,DA,148,"E"),1,35)
58 K ONCPR
59 W ! K DIR S DIR(0)="E" D ^DIR
60 S Y="@395"
61 Q
62 ;
63BPGUCHK ; CALLED FROM INPUT TRANFORM OF #141/142 TO CHECK TOPOG
64 S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S BPSITE="" Q
65 S BPSITE=$P($G(^ONCO(164,TOPSITE,0)),U,16)
66 Q
67 ;
68BPCHECK ;SCREENING OR BIOPSY PROCEDURES
69 S TOPSITE=$P($G(^ONCO(165.5,D0,2)),U,1) I TOPSITE="" S Y="@395" Q
70 I TOPSITE>67499,TOPSITE<67510 S BPSITE=67500 D DSP Q
71 I TOPSITE=67619 S BPSITE=67619 D DSP Q
72 D STUFF0 S Y="@395"
73 Q
74 ;
75DSP ;Display SCREENING OR BIOPSY PROCEDURES
76 I (COC=5)!(COC=8) D S Y="@395" Q
77 .S $P(^ONCO(165.5,D0,2.1),U,14)=6
78 .S:BPSITE=67500 $P(^ONCO(165.5,D0,2.1),U,15)=9
79 .S:BPSITE=67619 $P(^ONCO(165.5,D0,2.1),U,15)=5
80 .F PIECE=16:1:19 S $P(^ONCO(165.5,D0,2.1),U,PIECE)=9
81 I BPSITE=67500 S $P(^ONCO(165.5,D0,2.1),U,18)="",$P(^ONCO(165.5,D0,2.1),U,19)=""
82 I BPSITE=67619 S $P(^ONCO(165.5,D0,2.1),U,16)="",$P(^ONCO(165.5,D0,2.1),U,17)=""
83 S HDL=$L("Stage of Disease at Diagnosis"),TAB=(80-HDL)\2,TAB=TAB-1
84 W @IOF,DASHES
85 W !,?1,PATNAM,?TAB,"Stage of Disease at Diagnosis",?SITTAB,SITEGP
86 W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
87 W !,DASHES
88 W !," SCREENING OR BIOPSY PROCEDURES"
89 W !," ------------------------------"
90 N DI,DIC,DR,DA,DIQ,ONC
91 S DIC="^ONCO(165.5,"
92 S DR="141:146"
93 S DA=D0,DIQ="ONC" D EN^DIQ1
94 F I=141,142,143,144,145,146 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
95 W !," Biopsy procedure..............: ",ONC(165.5,D0,141)
96 W !," Guidance......................: ",ONC(165.5,D0,142)
97 W:BPSITE=67500 !," Palpability of primary........: ",ONC(165.5,D0,143)
98 W:BPSITE=67500 !," First detected by.............: ",ONC(165.5,D0,144)
99 W:BPSITE=67619 !," Approach for biopsy of primary: ",ONC(165.5,D0,145)
100 W:BPSITE=67619 !," Biopsy of other than primary..: ",ONC(165.5,D0,146)
101 W !,DASHES
102 Q
103STUFF0 ; IF SITE DOESN'T HAVE BIOPSY PROCEDURE, STUFF ALL 0'S
104 S $P(^ONCO(165.5,D0,2.1),U,14)=1
105 S $P(^ONCO(165.5,D0,2.1),U,15)=1
106 F PIECE=16:1:19 S $P(^ONCO(165.5,D0,2.1),U,PIECE)=0
107 Q
108NOBP ; IF NO BIOPSY PROCEDURE, STUFF 0'S
109 ; D STUFF0,STFMSG
110 I BPSITE=67500 D D STFMSG S Y="@1423" Q
111 .S $P(^ONCO(165.5,D0,2.1),U,15)=1
112 .S $P(^ONCO(165.5,D0,2.1),U,18)=0
113 .S $P(^ONCO(165.5,D0,2.1),U,19)=0
114 .Q
115 I BPSITE=67619 D D STFMSG S Y="@1456" Q
116 .S $P(^ONCO(165.5,D0,2.1),U,15)=1
117 .S $P(^ONCO(165.5,D0,2.1),U,16)=0
118 .S $P(^ONCO(165.5,D0,2.1),U,17)=0
119 .S $P(^ONCO(165.5,D0,2.1),U,18)=0
120 .Q
121 Q
122UNKBP ; IF UNK BIOPSY PROCEDURE, STUFF 9'S
123 F BP=0:0 S BP=$O(^ONCO(164,BPSITE,"BP5",BP)) Q:BP="B" S LAST=BP
124 S $P(^ONCO(165.5,D0,2.1),U,14)=LAST
125 F GU=0:0 S GU=$O(^ONCO(164,BPSITE,"GU5",GU)) Q:GU="B" S LAST=GU
126 S $P(^ONCO(165.5,D0,2.1),U,15)=LAST
127 I BPSITE=67500 D D STFMSG S Y="@1423" Q
128 .S $P(^ONCO(165.5,D0,2.1),U,18)=0
129 .S $P(^ONCO(165.5,D0,2.1),U,19)=0
130 .Q
131 I BPSITE=67619 D D STFMSG S Y="@1456" Q
132 .S $P(^ONCO(165.5,D0,2.1),U,16)=0
133 .S $P(^ONCO(165.5,D0,2.1),U,17)=0
134 .S $P(^ONCO(165.5,D0,2.1),U,18)=9
135 .Q
136 Q
137STFMSG ;
138 I BPSITE=67500 D
139 .K ONCBR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCBR(",DIQ(0)="E"
140 .S DR="142" D EN^DIQ1
141 .F I=142 S X=ONCBR(165.5,D0,I) D UCASE S ONCBR(165.5,D0,I)=X
142 .W !,"GUIDANCE........: "_ONCBR(165.5,DA,142,"E")
143 .S Y="@1423"
144 .K ONCBR Q
145 I BPSITE=67619 D
146 .K ONCPR S DIC="^ONCO(165.5,",DA=DA,DIQ="ONCPR(",DIQ(0)="E"
147 .S DR="142;145" D EN^DIQ1
148 .F I=142,145 S X=ONCPR(165.5,D0,I) D UCASE S ONCPR(165.5,D0,I)=X
149 .W !,"GUIDANCE......................: "_ONCPR(165.5,DA,142,"E")
150 .W !,"APPROACH FOR BIOPSY OF PRIMARY: "_ONCPR(165.5,DA,145,"E")
151 .S Y="@1456"
152 .K ONCPR Q
153 Q
154 ;
155UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
156 Q
Note: See TracBrowser for help on using the repository browser.