source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPMRL.m@ 1604

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

initial load of WorldVistAEHR

File size: 7.1 KB
Line 
1LRAPMRL ;DALOI/WTY/KLL- AP MODIFY RELEASED REPORT;12/04/01
2 ;;5.2;LAB SERVICE;**259,295,317,368**;Sep 27, 1994;Build 1
3 ;
4MAIN ;
5 N LRQUIT,LRMSG,LREND,LRDATA,LRREL,LRAU,LREFPD,LRWM,LRCT,LRTMP,LRGMDF
6 N LRFLD,LRDSC,LRCHG,LRXTMP,LRYTMP,LRIENS1,LRFILE,LRFLDA,LRAD1,LRIENS
7 N LRORIEN,LRWPROOT,LRFDA,LRDA,LRFIELD,LRFILE1,LRIENS2,LRDT0,LRESCPT
8 N LRQUIT1,LREDIAG,LRLOCK,LRNOTXT,LRORIEN
9 S LRESCPT=0
10 D TITLE
11 I LRQUIT D END Q
12 D NOTICE
13 I LRQUIT D END Q
14 D SECTION
15 I LRQUIT D END Q
16 D WHAT
17 I LRQUIT D END Q
18 D CPTCHK
19 ;D SECTION
20 I LRQUIT D END Q
21 D ASK
22 I LRQUIT D END Q
23 D SETDR^LRAPMRL1
24 D ACCYR
25 I LRQUIT D END Q
26 D ACCPN
27 D END
28 Q
29ACCPN ;Prompt for accesion number or patient name
30 F D Q:LREND
31 .S (LRQUIT,LREND)=0
32 .D CPTCHK
33 .D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
34 .I (LRDATA<1)!('$G(LRAN))!($G(LRAN)=-1) S LREND=1 Q
35 .S LRDFN=LRDATA,LRI=LRDATA(1)
36 .S LRLOCK="^LR(LRDFN"_$S(LRAU:")",1:",LRSS,LRI)")
37 .L +@(LRLOCK):5 I '$T D Q
38 ..S LRMSG="This record is locked by another user. "
39 ..S LRMSG=LRMSG_"Please try again later."
40 ..D EN^DDIOL(LRMSG,"","!!") K LRMSG
41 .S LRIENS=$S('LRAU:LRI_",",1:"")_LRDFN_","
42 .D RELCHK^LRAPMRL1
43 .I LRQUIT D UNLOCK Q
44 .D RELEASE^LRAPMRL1
45 .D QUEUPD^LRAPMRL1
46 .D:LRCAPA&'LRAU C^LRAPSWK
47 .D:'LREDIAG SETDR^LRAPMRL1,EDIT^LRAPMRL1
48 .I LRQUIT D UNLOCK Q
49 .I 'LRAU D
50 ..F LRFLD=1,1.1,1.4,1.3 D Q:LRQUIT
51 ...Q:LREDIAG&(LRFLD'=1.4)
52 ...Q:'LREDIAG&(LRFLD=1.4)
53 ...Q:LRFLD=1.3&(LRSS'="SP")
54 ...D ASK2 Q:LRQUIT!('LRGMDF)
55 ...D SAVTXT
56 ...K DR S DR=LRFLD
57 ...D EDIT^LRAPMRL1
58 ...D COMPARE Q:LRQUIT
59 ...D AUDIT Q:LRQUIT
60 ...D STORE
61 .I LRAU,LREDIAG D
62 ..S LRDSC="PATHOLOGICAL DIAGNOSIS"
63 ..S LRFLD=32.3
64 ..D SAVTXT
65 ..K DR S DR=LRFLD
66 ..D EDIT^LRAPMRL1
67 ..D COMPARE
68 .I $G(SEX)["F","SPCY"[LRSS D DEL^LRWOMEN
69 .I LRQUIT D UNLOCK Q
70 .I LREDIAG D UNLOCK Q
71 .D:LRESCPT CPTCODE^LRAPMRL1
72 .D UNLOCK
73 Q
74TITLE ;Title
75 S (LRQUIT,LRQUIT1)=0
76 D CK^LRAP
77 I Y=-1 S LRQUIT=1 Q
78 W @IOF
79 S LRMSG="Modify Released Pathology Reports"
80 S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM)
81 S LRMSG(1,"F")="!!"
82 S LRMSG(2)="",LRMSG(2,"F")="!"
83 D EN^DDIOL(.LRMSG) K LRMSG
84 Q
85NOTICE ;Warn the user and allow an exit
86 K LRMSG
87 S LRMSG="NOTICE"
88 S LRMSG(1)=$$CJ^XLFSTR(LRMSG,IOM),LRMSG(1,"F")="!!"
89 S LRMSG(2)="",LRMSG(2,"F")="!"
90 S LRMSG(3)=$C(7)_"This option allows modification of a verified/"
91 S LRMSG(3)=LRMSG(3)_"released pathology report."
92 S LRMSG(3,"F")="!?3"
93 S LRMSG(4)="Continuing with this option will unrelease the report "
94 S LRMSG(4)=LRMSG(4)_"and flag the report",LRMSG(4,"F")="!?3"
95 S LRMSG(5)="as modified even if the data is unchanged. It will "
96 S LRMSG(5)=LRMSG(5)_"also be queued to the",LRMSG(5,"F")="!?3"
97 S LRMSG(6)="final report queue so that it may be verified/released "
98 S LRMSG(6)=LRMSG(6)_"again.",LRMSG(6,"F")="!?3"
99 D EN^DDIOL(.LRMSG) K LRMSG
100 W !!
101 S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO"
102 D ^DIR
103 S:Y<1 LRQUIT=1
104 Q
105WHAT ;What is to be edited
106 W !
107 K DIR
108 ;Don't ask to Edit Diagnosis if initial entry of diagnosis is turned
109 ; off at data entry for SP, CY, EM's
110 S LRASK=1,XASK=""
111 I 'LRAU D
112 .S XASK=$S(LRSS="SP":11.2,LRSS="CY":11.3,1:"")
113 .S:XASK="" XASK=$S(LRSS="EM":11.4,1:"")
114 .S LRASK=$$GET1^DIQ(69.9,"1,",XASK,"I")
115 S:LRASK DIR(0)="S^1:Edit Report;2:Edit Diagnosis"
116 S:LRASK DIR("A")="Enter selection",DIR("B")=1
117 S:'LRASK DIR(0)="Y",DIR("B")="YES",DIR("A")="Edit Report?"
118 D ^DIR
119 I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S LRQUIT=1 Q
120 S:Y=0 LRQUIT=1
121 Q:LRQUIT=1
122 S LREDIAG=Y
123 S LREDIAG=$S(LREDIAG=2:1,1:0)
124 Q
125CPTCHK ;Determine if CPT is activated
126 Q:$T(ES^LRCAPES)=""
127 S LRESCPT=$$ES^LRCAPES()
128 Q
129SECTION ;Choose Anatomic Pathology section (AU,SP,CY,EM)
130 W !
131 D ^LRAP
132 I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
133 S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
134 S LRAU=0 ; LRAU = 0 - Not Autopsy
135 S:LRSS="AU" LRAU=1 ; = 1 - Autosy
136 I LRCAPA D @(LRSS_"^LRAPSWK")
137 S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
138 S LRMSG(2)="",LRMSG(2,"F")="!"
139 D EN^DDIOL(.LRMSG) K LRMSG
140 Q
141ASK ;Ask etiology,function,procedure,disease,weights,measures
142 I LREDIAG D Q
143 .S:'LRAU LREFPD=0
144 .S:LRAU LRWM=0
145 W !
146 S DIR(0)="Y",DIR("B")="NO"
147 S DIR("A")="Edit etiology, function, procedure & disease"
148 D ^DIR
149 I Y="^" S LRQUIT=1 Q
150 S LREFPD=$S(+Y:1,1:0)
151 I LRAU D
152 .W !
153 .S DIR(0)="Y",DIR("B")="NO"
154 .S DIR("A")="Edit weights and measures"
155 .D ^DIR
156 .I Y="^" S LRQUIT=1 Q
157 .S LRWM=$S(+Y:1,1:0)
158 Q
159ACCYR ;Determine Accession Year
160 D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
161 I LRAD1=-1 S LRQUIT=1 Q
162 I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
163 Q
164ASK2 ;Ask about other fields
165 S LRGMDF=0
166 K LRDSC
167 I LRFLD=1!(LRFLD=1.1) D
168 .S:LRFLD=1 LRFLDA=7
169 .S:LRFLD=1.1 LRFLDA=4
170 .S LRDSC=$S(LRFLD=1:"GROSS",LRFLD=1.1:"MICROSCOPIC",1:"")
171 .S LRDSC=LRDSC_" DESCRIPTION"
172 S:LRFLD=1.4 LRDSC="DIAGNOSIS",LRFLDA=5
173 S:LRFLD=1.3 LRDSC="FROZEN SECTION",LRFLDA=6
174 I 'LREDIAG D
175 .S DIR(0)="Y",DIR("B")="NO"
176 .S DIR("A")="Edit "_LRDSC
177 .D ^DIR
178 .I Y="^" S LRQUIT=1 Q
179 .S LRGMDF=$S(+Y:1,1:0)
180 S:LREDIAG LRGMDF=1
181 Q
182SAVTXT ;Save word processing field text.
183 S LRNOTXT=0
184 K ^TMP("DIQ1",$J)
185 S:'LRAU LRIENS=LRI_","_LRDFN_",",LRFILE=LRSF
186 S:LRAU LRIENS=LRDFN_",",LRFILE=63
187 Q:LRFLD=""
188 S LRTMP=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","^TMP(""DIQ1"",$J)")
189 I LRTMP="" D
190 .K LRMSG
191 .S LRMSG(1)="There is no "_LRDSC_" text to modify."
192 .S LRMSG(1,"F")="!!"
193 .S LRMSG(2)="Report was released before entering text."
194 .S LRMSG(2,"F")="!"
195 .D EN^DDIOL(.LRMSG)
196 .S LRNOTXT=1
197 Q
198COMPARE ;Compare report text
199 S (LRCHG,LRQUIT,LRCT)=0
200 S:'LRAU LRFILE="^LR(LRDFN,LRSS,LRI,LRFLD,"
201 S:LRAU LRFILE="^LR(LRDFN,82,"
202 I '$D(@(LRFILE_"0)")) D Q
203 .Q:LRNOTXT
204 .S LRQUIT=1
205 F S LRCT=$O(@(LRFILE_"LRCT)")) Q:'LRCT D
206 .S LRXTMP=@(LRFILE_"LRCT,0)")
207 .I '$D(^TMP("DIQ1",$J,LRCT)) S LRCHG=1 Q
208 .S LRYTMP=^TMP("DIQ1",$J,LRCT)
209 .I LRXTMP'=LRYTMP S LRCHG=1
210 I 'LRCHG D
211 .S LRCT=0 F S LRCT=$O(^TMP("DIQ1",$J,LRCT)) Q:'LRCT D
212 ..I '$D(@(LRFILE_"LRCT,0)")) S LRCHG=1
213 I 'LRCHG D Q
214 .D EN^DDIOL("No changes made to "_LRDSC_".","","!!")
215 .W !
216 .K ^TMP("DIQ1",$J)
217 I LRCHG&(LRFLD=1.4!(LRFLD=32.3)) D ;Indicate that the diagnosis
218 .K LRFDA ;has been modified.
219 .S:'LRAU LRFDA(LRSF,LRIENS,.172)=1
220 .;KLL-CORRECT BUG WHERE LRSF IS NULL, REPLACE LRSF WITH 63
221 .S:LRAU LRFDA(63,LRIENS,102.2)=1
222 .;S:LRAU LRFDA(LRSF,LRIENS,102.2)=1
223 .D FILE^DIE("","LRFDA")
224 Q
225AUDIT ;
226 N LRNTIME
227 K LRFDA
228 D NOW^%DTC S LRNTIME=%
229 S LRIENS1="+1,"_LRIENS
230 S LRFILE=+$$GET1^DID(LRSF,LRFLDA,"","SPECIFIER")
231 I LRFILE="" S LRQUIT=1 Q
232 S LRFDA(1,LRFILE,LRIENS1,.01)=LRNTIME
233 S LRFDA(1,LRFILE,LRIENS1,.02)=DUZ
234 D UPDATE^DIE("","LRFDA(1)","LRORIEN")
235 Q
236STORE ;
237 K LRIENS1
238 S LRIENS1=LRORIEN(1)_","_LRIENS
239 S LRWPROOT="^TMP(""DIQ1"",$J)"
240 D WP^DIE(LRFILE,LRIENS1,1,"",LRWPROOT)
241 K ^TMP("DIQ1",$J)
242 Q
243SUPRPT ;Supplementary Report
244 K DIR
245 S DIR(0)="Y",DIR("B")="NO"
246 S DIR("A")="Edit SUPPLEMENTARY REPORTS"
247 D ^DIR
248 I Y="^" S LRQUIT1=1 Q
249 Q:Y<1
250 N LRX,LRRLS,LRA,LRFLG,LRNOW
251 D GETRPT^LRAPDSR Q:LRQUIT
252 S LRRLS=1,LRRLS1=0
253 D COPY^LRAPDSR Q:LRQUIT
254 D RPT^LRAPDSR Q:LRQUIT
255 S Y=LRDA
256 D RELEAS2^LRAPDSR
257 D COMPARE^LRAPDSR Q:LRQUIT
258 D UNRELEAS^LRAPDSR
259 D UPDATE^LRAPDSR Q:LRQUIT
260 D STORE^LRAPDSR
261 Q
262UNLOCK ;Unlock the record
263 D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))
264 L -@(LRLOCK)
265 Q
266END ;Clean-up variables and quit
267 K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
268 D CLEAN^DILF
269 D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
270 D V^LRU
271 Q
Note: See TracBrowser for help on using the repository browser.