source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOAIP.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: 9.2 KB
RevLine 
[613]1ONCOAIP ;Hines OIFO/GWB [EE Abstract Edit Primary]; 08/29/01
2 ;;2.11;ONCOLOGY;**1,5,6,7,11,13,15,16,18,19,22,24,27,28,32,33,34,35,36,37,38,39,40,42,43,44,45,46,47**;Mar 07, 1995;Build 19
3 ;
4ED ;[EE Abstract Edit Primary]
5 W @IOF,!
6 S DIC="^ONCO(165.5,",DIC(0)="AEQZM"
7 S DIC("A")=" Select primary or patient name: "
8 D ^DIC K DIC G EX:Y<0
9 S ONCOD0P=+Y
10 S ONCOD0=$P(^ONCO(165.5,+Y,0),U,2)
11 S ONCONM=$$GET1^DIQ(160,ONCOD0,.01,"E")
12 S ONCOEDIT=1
13 ;
14EN S ONCOYR=($$TNMED^ONCOU55(ONCOD0P)>3)
15 S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
16 S CHECKSUM=$P($G(^ONCO(165.5,ONCOD0P,"EDITS")),U,1)
17 I ABSTAT=3,CHECKSUM="" D
18 .S EDITS="NO" S D0=ONCOD0P D NAACCR^ONCGENED K EDITS
19 .S CHECKSUM=$$CRC32^ONCSNACR(.ONCDST)
20 .S $P(^ONCO(165.5,ONCOD0P,"EDITS"),U,1)=CHECKSUM
21 S DIE="^ONCO(165.5,",DA=ONCOD0P,DR="[ONCO ABSTRACT-I]",ONCOL1=0
22 L +^ONCO(165.5,DA):0 I $T D ^DIE L -^ONCO(165.5,DA) S ONCOL1=1
23 I 'ONCOL1 W !!,"This primary is being edited by another user" H 3 Q:'$D(ONCOEDIT) K ONCOL1 G ED
24 S ABSTAT=$P($G(^ONCO(165.5,ONCOD0P,7)),U,2)
25 I ABSTAT'=3 D
26 .S DIE="^ONCO(165.5,"
27 .S DA=ONCOD0P
28 .S DR="197///@"
29 .D ^DIE
30 I ABSTAT=3 D CHANGE^ONCGENED I $G(Y)="@0" G EN
31 D FOL^ONCOAI
32 K ONCOL1,LYMPHOMA,RFDEF,TFDEF,DFDEF
33 I $D(ONCOOUT) Q
34 I $D(Y) Q:'$D(ONCOEDIT) G ED
35 Q
36 ;
37PAIR ;LATERALITY (165.5,28)
38 D TOPNAM
39 S DATEDX=$P($G(^ONCO(165.5,D0,0)),U,16)
40 Q:TOP=""
41 I TOP=67342,$P(^ONCO(165.5,D0,2),U,8)="" S $P(^ONCO(165.5,D0,2),U,8)=1 Q
42 S PO=$P($G(^ONCO(164,TOP,0)),U,7)
43 I PO="",$P(^ONCO(165.5,D0,2),U,8)="" S $P(^ONCO(165.5,D0,2),U,8)=0
44 I DATEDX<3040000,(TOP=67700)!(TOP=67710)!(TOP=67711)!(TOP=67712)!(TOP=67713)!(TOP=67714)!(TOP=67722)!(TOP=67723)!(TOP=67724)!(TOP=67725),$P(^ONCO(165.5,D0,2),U,8)="" S $P(^ONCO(165.5,D0,2),U,8)=0
45 K PO
46 ;
47 ;Stuff TEXT-PRIMARY SITE TITLE (165.5,100)
48 S TEXT=$P($G(^ONCO(164,TOP,0)),U,1)
49 S:$P($G(^ONCO(165.5,D0,8)),U,1)="" $P(^ONCO(165.5,D0,8),U,1)=TEXT
50 K TEXT
51 Q
52 ;
53HISTXT ;Stuff TEXT-HISTOLOGY TITLE (165.5,101)
54 S HSTI=$$HIST^ONCFUNC(D0)
55 S TEXT=HISTNAM
56 S:$P($G(^ONCO(165.5,D0,8)),U,2)="" $P(^ONCO(165.5,D0,8),U,2)=$E(TEXT,1,40)
57 K HSTI,TEXT
58 D:$P($G(^ONCO(165.5,D0,0)),U,16)>3031231 ^ONCCSSTF
59 Q
60 ;
61MEN ;Primary Menu Options
62 K DXS,ONCOOUT,DASHES
63 S $P(DASHES,"-",80)="-"
64 S NODE0=^ONCO(165.5,D0,0)
65 S S=$P(NODE0,U,1),SITEGP=$P(^ONCO(164.2,S,0),U,1)
66 S Y=$P(NODE0,U,2),C=$P(^DD(165.5,.02,0),U,2) D Y^DIQ S PATNAM=Y
67 S SAVED0=D0 S D0=$P(NODE0,U,2) D SSN^ONCOES S SSN=X,D0=SAVED0
68 S DATEDX=$P(NODE0,U,16)
69 D ^ONCPHC
70 S COC=$P(NODE0,U,4)
71 S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
72 I OSP="" S OSP=$O(^ONCO(160.1,0))
73 S EVADS=$P($G(^ONCO(160.1,OSP,2)),U,2)
74 S IIN=$P($G(^ONCO(160.1,OSP,1)),U,4)
75 S RH=$P($G(^ONCO(160.19,IIN,0)),U,2)
76 K OSP
77 D TOPNAM
78 W @IOF
79 W !,?1,PATNAM,?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASHES
80 W !,?25,"Primary Menu Options",!,DASHES
81 W !?22,"1. Patient Identification"
82 W !?22,"2. Cancer Identification"
83 W !?22,"3. Stage of Disease at Diagnosis"
84 W !?22," Collaborative Staging (2004+ cases)"
85 W !?22,"4. First Course of Treatment"
86 W !?22,"5. Patient Care Evaluation"
87 W !?22,"6. Over-ride Flags"
88 W !?22,"7. Case Administration"
89 W !!?22,"A All - Complete Abstract"
90 ;
91A K AN,ONCOANS,X,Y
92 R !!?25,"Enter option: All//",X:DTIME
93 S:X="" (ONCOANS,X)="A"
94 G:X["?" HP
95 I X=U!'$T S Y="",ONCOOUT=U Q
96 I (X="A")!(X="ALL")!(X="all")!(X="All") S ONCOANS="A",Y=1 G Y
97 S (ONCOANS,Y)=X I X<1!(X>7) W *7,"??" G A
98 ;
99Y S Y="@"_Y
100 Q
101 ;
102HP W !!,?10,"Select 'A' for the complete abstract"
103 W !?10,"Select 1-7 for the desired subsection",!
104 G A
105 ;
106PAT ;Patient Identification
107 S SECTION="Patient Identification" D SECTION
108 K DXS,DIOT D PI^ONCPCI
109 Q
110 ;
111CAN S SECTION="Cancer Identification" D SECTION
112 D PAIR
113 K DXS,DIOT S D0=ONCOD0P D CI^ONCPCI
114 Q
115 ;
116EXT S SECTION="Stage of Disease at Diagnosis" D SECTION
117 S SY="@31"
118 S S=$P(^ONCO(165.5,D0,0),U,1)
119 S T=$P($G(^ONCO(165.5,D0,2)),U,1)
120 S H=$$HIST^ONCFUNC(D0)
121 I (S=35)!($$LEUKEMIA^ONCOAIP2(D0))!((S>64)&(S<71)) D G PSD
122 .S N=$S($E(H,1,4)=9731:"999^10^9",1:"999^80^9") ;Plasmacytoma, NOS
123 .S N=$S(S=65:"999^99^9^99^99^9^9^9^9",1:N_"^99^99^9^9^9^7") ;Unk primary
124 .I (T=67422)&(L'=1)&(H'=91403) S $P(N,U,2)=99,$P(N,U,9)=9 ;Spleen
125 .S $P(^ONCO(165.5,D0,2),U,9,17)=N
126 .D NOSTAGE
127 .S SY="@313" ;Other Staging System (165.5,39)
128 .I S=65 W !?18,"====> UNKNOWN PRIMARY - No EOD/TNM coding <====" Q
129 .W !?18,"====> SYSTEMIC DISEASE - No EOD/TMN coding <===="
130 ;
131PSD K DXS,DIOT S D0=ONCOD0P D ^ONCPSD K DXS
132 S Y=SY
133 Q
134 ;
135NOSTAGE ;No staging
136 S $P(^ONCO(165.5,D0,2),U,25)=88 ;37.1 CT
137 S $P(^ONCO(165.5,D0,2),U,26)=88 ;37.2 CN
138 S $P(^ONCO(165.5,D0,2),U,27)=88 ;37.3 CM
139 S $P(^ONCO(165.5,D0,2),U,20)=88 ;38 C Stage Group
140 S $P(^ONCO(165.5,D0,3),U,32)=8 ;19 Staged By (C)
141 S $P(^ONCO(165.5,D0,7),U,17)="N" ;69.4 Multimodality Therapy (P)
142 S $P(^ONCO(165.5,D0,2.1),U,1)=88 ;85 PT
143 S $P(^ONCO(165.5,D0,2.1),U,2)=88 ;86 PN
144 S $P(^ONCO(165.5,D0,2.1),U,3)=88 ;87 PM
145 S $P(^ONCO(165.5,D0,2.1),U,4)=88 ;88 P Stage Group
146 S $P(^ONCO(165.5,D0,2.1),U,5)=8 ;89 Staged By (P)
147 S $P(^ONCO(165.5,D0,2),U,28)="NA" ;38.5 Stage Grouping-AJCC
148 S:$P($G(^ONCO(165.5,D0,7)),U,7)="" $P(^ONCO(165.5,D0,7),U,7)="0000000"
149 S:$P($G(^ONCO(165.5,D0,7)),U,14)="" $P(^ONCO(165.5,D0,7),U,14)="0000000"
150 Q
151 ;
152FST S SECTION="First Course of Treatment" D SECTION
153 Q
154 ;
155ORF S SECTION="Over-ride Flags" D SECTION
156 K DXS,DIOT D ^ONCORF
157 Q
158 ;
159NTX ;DATE OF NO TREATMENT (165.5,124)
160 I '$D(NTDD) S Y="@425" Q
161 K NTDD
162 W !!?5,"You have entered a DATE OF NO TREATMENT. All treatment fields"
163 W !?5,"will be stuffed with the appropriate value indicating no"
164 W !?5,"treatment.",!
165 K DIR S DIR("A")="Are you sure you want to do this",DIR("B")="No"
166 S DIR(0)="Y" D ^DIR
167 I (Y=0)!(Y="") D S Y=124 W ! Q
168 .S TXDT=$P(^ONCO(165.5,D0,2.1),U,11)_"N"
169 .K ^ONCO(165.5,"ATX",D0,TXDT)
170 .S $P(^ONCO(165.5,D0,2.1),U,11)=""
171 I Y[U S $P(^ONCO(165.5,D0,2.1),U,11)="",Y="@0" Q
172 S NTX="" D NTX^ONCNTX K NTX
173 Q
174 ;
175RS ;RADIATION/SURGERY SEQUENCE (165.5,51.3)
176 Q:$P(^ONCO(165.5,D0,3),U,7)'=""
177 S S=$E($$GET1^DIQ(165.5,D0,58.6,"E"),1,2)
178 S SATF=$E($$GET1^DIQ(165.5,D0,58.7,"E"),1,2)
179 S SCP=$P($G(^ONCO(165.5,D0,3.1)),U,31)
180 S SCPATF=$P($G(^ONCO(165.5,D0,3.1)),U,32)
181 S SOTH=$P($G(^ONCO(165.5,D0,3.1)),U,33)
182 S SOTHATF=$P($G(^ONCO(165.5,D0,3.1)),U,34)
183 S R=$$GET1^DIQ(165.5,D0,51.2,"I")
184 S RATF=$$GET1^DIQ(165.5,D0,51.4,"I")
185 I ((S="00")!(S=99)!(S=98)!(S=""))&((SATF="00")!(SATF=99)!(SATF=98)!(SATF=""))&((SCP=0)!(SCP="")!(SCP=9))&((SCPATF=0)!(SCPATF="")!(SCPATF=9))&((SOTH=0)!(SOTH=""))&((SOTHATF=0)!(SOTHATF="")) S SR=0
186 E S SR=1
187 I ((R=0)!(R=7)!(R=8)!(R=9)!(R=""))&((RATF=0)!(RATF=7)!(RATF=8)!(RATF=9)!(RATF="")) S R=0
188 E S R=1
189 I ($G(SR)&$G(R)) D K S,SATF,SCP,SCPATF,SOTH,SOTHATF,R,RATF,SR,SDT,SATFDT,SCPDT,SCPATFDT,SOTDT,SOTATFDT,RDT,RATFDT,RSSEQ,FSDT,FRDT
190 .S SDT=$P($G(^ONCO(165.5,D0,3)),U,1)
191 .S:SDT'="" RSSEQ("S",SDT)="S",RSSEQ(SDT)="S"
192 .S SATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,8)
193 .S:SATFDT'="" RSSEQ("S",SATFDT)="S",RSSEQ(SATFDT)="S"
194 .S SCPDT=$P($G(^ONCO(165.5,D0,3.1)),U,22)
195 .S:SCPDT'="" RSSEQ("S",SCPDT)="S",RSSEQ(SCPDT)="S"
196 .S SCPATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,23)
197 .S:SCPATFDT'="" RSSEQ("S",SCPATFDT)="S",RSSEQ(SCPATFDT)="S"
198 .S SOTDT=$P($G(^ONCO(165.5,D0,3.1)),U,24)
199 .S:SOTDT'="" RSSEQ("S",SOTDT)="S",RSSEQ(SOTDT)="S"
200 .S SOTATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,25)
201 .S:SOTATFDT'="" RSSEQ("S",SOTATFDT)="S",RSSEQ(SOTATFDT)="S"
202 .S RDT=$P($G(^ONCO(165.5,D0,3)),U,4)
203 .S:RDT'="" RSSEQ("R",RDT)="R",RSSEQ(RDT)="R"
204 .S RATFDT=$P($G(^ONCO(165.5,D0,3.1)),U,13)
205 .S:RATFDT'="" RSSEQ("R",RATFDT)="R",RSSEQ(RATFDT)="R"
206 .S FSDT=$O(RSSEQ("S",0)),FRDT=$O(RSSEQ("R",0))
207 .I FSDT=FRDT Q
208 .S RSSEQ=$O(RSSEQ(0))
209 .I RSSEQ(RSSEQ)="R" S $P(^ONCO(165.5,D0,3),U,7)=2
210 .I RSSEQ(RSSEQ)="S" S $P(^ONCO(165.5,D0,3),U,7)=3
211 E D
212 .S $P(^ONCO(165.5,D0,3),U,7)=0
213 Q
214 ;
215AB ;Abstract Status
216 S SECTION="Case Administration" D SECTION
217 N DI,DIC,DR,DA,DIQ,ONC
218 S DIC="^ONCO(165.5,"
219 S DR="90:92;198;199;155;157"
220 S DA=D0,DIQ="ONC" D EN^DIQ1
221 S X=ONC(165.5,D0,91) D UCASE^ONCPCI S ONC(165.5,D0,91)=X
222 W !," Abstract Status...........: ",ONC(165.5,D0,91)
223 W !," Date of First Contact.....: ",ONC(165.5,D0,155)
224 W !," Date Case Completed.......: ",ONC(165.5,D0,90)
225 W !," Elapsed Days to Completion: ",ONC(165.5,D0,157)
226 W !," Abstracted by.............: ",ONC(165.5,D0,92)
227 W !," Date Case Last Changed....: ",ONC(165.5,D0,198)
228 W !," Case Last Changed by......: ",ONC(165.5,D0,199)
229 W !,DASHES
230 Q
231 ;
232NAN ;NEW ACC #
233 K DIR S DIR(0)="N^:"_($E(DT,1,3)+1700),DIR("A")="YEAR of Accession Number: ",DIR("B")=($E(DT,1,3)+1700) W !! D ^DIR Q:(Y=U)!(Y="")
234NA S YR=Y,MR=YR_"0001",XR=999999-((YR+1)_"0000"),NR=$O(^ONCO(165.5,"AF",XR))
235 I NR<(990002-MR) W *7,!!?5,"SYSTEM appears out of numbers-looking for unassigned ones" G FND
236 I NR>(999999-MR) S NR=""
237 S AC=$S(NR="":YR_"0001",1:(1000000-NR)),SEQ="00"
238 Q
239FND ;SEARCH for unused #s
240 S NR=YR_"0000",MR=(YR+1)_"0000"
241NR S NR=NR+1 I NR<MR G:$D(^ONCO(165.5,"AA",NR)) NR S AC=NR,SEQ="00" Q
242 W *7,!!?10,"OUT of ACCESSION Numbers for 19"_YR S Y=U
243 Q
244 ;
245TOPNAM ;PRIMARY SITE and PRIMARY SITE CODE for header
246 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1),TOPCOD="",TOPNAM=""
247 I TOP'="" S TOPNAM=$P(^ONCO(164,TOP,0),U,1),TOPCOD=$P(^ONCO(164,TOP,0),U,2)
248 S SITTAB=79-$L(SITEGP),TOPTAB=79-$L(TOPNAM_" "_TOPCOD)
249 S NOS=TOPTAB-$L(PATNAM),NOS=NOS-1 K SPACES S $P(SPACES," ",NOS)=" "
250 Q
251 ;
252SECTION S HDL=$L(SECTION),TAB=(80-HDL)\2,TAB=TAB-1
253 W @IOF,DASHES
254 W !,?1,PATNAM,?TAB,SECTION,?SITTAB,SITEGP
255 W !,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD
256 W !,DASHES
257 Q
258 ;
259EX ;Exit
260 D KILL^ONCOAI
261 K ONCOEDIT
262 Q
Note: See TracBrowser for help on using the repository browser.