source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTE6.m

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

initial load of WorldVistAEHR
File size: 11.1 KB
Line 
1RARTE6 ;HISC/SM Restore deleted report ;01/10/08 13:44
2 ;;5.0;Radiology/Nuclear Medicine;**56**;Mar 16, 1998;Build 3
3 ;Supported IA #10060 ^VA(200
4 ;Supported IA #2053 FILE^DIE, UPDATE^DIE
5 ;Supported IA #2052 GET1^DID
6 ;Supported IA #2056 GET1^DIQ
7 ;Supported IA #10103 NOW^XLFDT
8 ;Supported IA #2055 ROOT^DILFD
9 ;Supported IA #10060 GETS^DIQ
10 Q
11RSTR ;restore deleted report
12 F I=1:1:5 W !?4,$P($T(INTRO+I),";;",2)
13 W !
14 S RAXIT=0 ; =0 exit normally, =1 exit early
15 I '$D(^XUSEC("RA MGR",DUZ)) W !!,"Supervisory key RA MGR is needed for this option." Q
16 S DIC("S")="I $P(^(0),""^"",5)=""X""" ;only select deleted reports
17 S DIC("A")="Select Deleted Report to restore: "
18 S DIC="^RARPT(",DIC(0)="AEMQZ"
19 D DICW^RARTST1,^DIC K DIC I Y<0 G FINISH
20 S RARPT=+Y
21 W !
22 D CHECK G:RAXIT NOTDONE ;check if case has rpt & DX codes
23 D ASK1 G:RAXIT NOTDONE ;ask if want restore deleted report
24 D ASSOC G:RAXIT NOTDONE ;display associated case(s) & ask user again if want continue
25 D RESTORE ;restore rpt status, link rpt to case(s)
26 D FINISH
27 Q
28CHECK ; check if associated case(s) has rpt and DX codes
29 S RA74=^RARPT(RARPT,0)
30 S RADFN=+$P(RA74,U,2),RADTI=9999999.9999-$P(RA74,U,3),RACN=+$P($P(RA74,U,1),"-",2)
31 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RACN,0))
32 S RA70=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
33 I 'RADFN!('RADTI)!('RACNI)!(RA70="") D ERR0 Q
34 S RANME=$$GET1^DIQ(2,RADFN,.01),RAST=+$P(RA70,U,3)
35 S RAPRC=$S($D(^RAMIS(71,+$P(RA70,U,2),0)):$P(^(0),U),1:"Unknown")
36 S RASSN=$$SSN^RAUTL,RASUBY0=RA70
37 S RANODE=$G(^RADPT(RADFN,"DT",RADTI,0))
38 ; check if case(s) already have a report
39 D EN2^RAUTL20(.RAMEMARR)
40 I RAPRTSET D
41 .S RA1=0
42 .F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
43 ..I $P(^RADPT(RADFN,"DT",RADTI,"P",RA1,0),U,17)'="" D ERR3(+RAMEMARR(RA1))
44 ..Q
45 .Q
46 E I $P(RA70,U,17) D ERR3(RACN) Q
47 ; check if case(s) already have DX codes, staff, resident
48 ; don't use IF ELSE here due to outside calls
49 ;
50 ; Printset cases
51 I RAPRTSET D Q
52 .S RA1=0
53 .F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
54 ..; check primary
55 ..F RA2=13,15,12 I $P(^RADPT(RADFN,"DT",RADTI,"P",RA1,0),U,RA2)'="" D ERR2(+RAMEMARR(RA1),70.03,RA2)
56 ..; check secondary
57 ..S RAIENS=1_","_RA1_","_RADTI_","_RADFN_","
58 ..F RA2=70.14,70.11,70.09 S RAROOT=$$ROOT^DILFD(RA2,RAIENS) I $O(@(RAROOT_"0)")) D ERR2(+RAMEMARR(RA1),RA2,.01)
59 ..Q
60 .Q
61 ; single case
62 F RA2=13,15,12 I $P(RA70,U,RA2) D ERR2(RACN,70.03,RA2)
63 S RAIENS=1_","_RACNI_","_RADTI_","_RADFN_","
64 F RA2=70.14,70.11,70.09 S RAROOT=$$ROOT^DILFD(RA2,RAIENS) I $O(@(RAROOT_"0)")) D ERR2(RACN,RA2,.01)
65 Q
66ASK1 ; ask if want to restore report
67 ; RAPRVIEN last Activity Log rec in subfile 74.01
68 ; RAPRVST previous report status logged in latest activity log rec
69 ; RALAST last activity log record
70 S RAPRVIEN=$O(^RARPT(RARPT,"L",""),-1)
71 I 'RAPRVIEN D ERR1 Q
72 S RALAST=$G(^RARPT(RARPT,"L",+RAPRVIEN,0))
73 I RALAST="" D ERR1 Q
74 S RAPRVST=$P(RALAST,U,4) ;previous rpt status
75 K DIR
76 S DIR(0)="Y",DIR("B")="NO"
77 S DIR("A")="Do you want to restore this deleted report"
78 S DIR("?")="Answer ""Y"" to assign the previous report status, "_$$GET1^DIQ(74.01,RAPRVIEN_","_RARPT_",",4)_", to this report."
79 D ^DIR K DIR
80 S:$D(DIRUT) RAXIT=1
81 S:'Y RAXIT=1
82 Q
83ASSOC ;
84 ; list case(s) for this report
85 S (Y,RADTE)=+$P(RANODE,U)
86 D D^RAUTL S RADATE=Y
87 D DISPLAY
88 W !
89 K DIR
90 S DIR(0)="Y",DIR("B")="NO"
91 S DIR("A")="Are you sure you want to link this report back to the case"_$S(RAPRTSET:"s",1:"")
92 S DIR("?")="Answer ""Y"" to link this report back to the case(s) shown above."
93 D ^DIR K DIR
94 S:$D(DIRUT) RAXIT=1
95 S:'Y RAXIT=1
96 Q
97RESTORE ; set Report Status to before delete value, link to case(s)
98 D SETFF(74,5,RARPT,RAPRVST)
99 W !!?3,"... Restored ",$P(RA74,U,1),"'s report status to: ",$$GET1^DIQ(74,+RARPT,5),"."
100 ;
101 ; set activity log record
102 S RAIENL="+1,"_RARPT_","
103 D SETALOG(RAIENL,"R",RAPRVST)
104 ;
105 ; link report to single case or all cases of a printset
106 I RAPRTSET D
107 . S RA1=""
108 . F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" S $P(^RADPT(RADFN,"DT",RADTI,"P",RA1,0),U,17)=RARPT D MSG1(+RAMEMARR(RA1))
109 .Q
110 E S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,17)=RARPT D MSG1(RACN)
111 ;
112 ;Restore Primary and Secondary DX codes, Staff and Residents
113 ;
114 ;RAFLD is defined in SET70
115 F RAFLD=5,7,9 S RAPREV=$P(RALAST,U,RAFLD) D:RAPREV SET70(RAFLD)
116 ; restore report status
117 W !!!?3,"** You need to edit the case"_$S(RAPRTSET:"s",1:"")_" to update the exam status. **"
118 Q
119SET70(X) ; put back previous DX codes, Staff, Residents into case record
120 ; assumes if no primary then no secondaries
121 K RAFDA,RAA
122 N RA1
123 S RAIENS=1_","_RAPRVIEN_","_RARPT_","
124 ;
125 ; X is the field number from subfile 74.01:
126 ; 5 = BEFORE DELETION PRIM. DX CODE
127 ; 7 = BEFORE DELETION PRIM. STAFF
128 ; 9 = BEFORE DELETION PRIM. RESIDENT
129 ;
130 ; RAF1 = subfile number from file 74's activity log
131 ; RAF2 = subfile number from file 70's secondaries
132 ; RAF3 = subfile number pointed to from file 70's secondaries
133 ; RAPIECE = piece in 70.03's 0 node
134 S RAF1=$S(X=5:74.16,X=7:74.18,X=9:74.19,1:"") Q:RAF1=""
135 S RAF2=$S(X=5:70.14,X=7:70.11,X=9:70.09,1:"") Q:RAF2=""
136 S RAF3=$$GET1^DID(RAF2,.01,"","POINTER")
137 ; extract file number from RAF3
138 S RAF3=$TR(RAF3,$TR(RAF3,"0123456789."))
139 ;piece number for Primary DX/Staff/Resident in 70.03
140 S RAPIECE=$S(X=5:13,X=7:15,X=9:12,1:"") Q:RAPIECE=""
141 S RAROOT=$$ROOT^DILFD(RAF1,RAIENS,1) ;closed root under file 74's Activity Log
142 ;copy secondaries into RAA()
143 M RAA=@RAROOT
144 ;
145 G:RAPRTSET PSET
146 ;
147 ; single case
148 ;
149 ; copy Primary into single case
150 S RAFDA(70.03,RACNI_","_RADTI_","_RADFN_",",RAPIECE)=RAPREV
151 D FILE^DIE("","RAFDA","RAMSG")
152 I $D(RAMSG("DIERR")) D ERR4(RACN,$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
153 E D MSG2(RACN,$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
154 K RAFDA,RAMSG
155 ;
156 Q:$O(RAA(0))'>0 ; no secondaries
157 ;
158 ;copy secondary items into single case
159 S RA1=0
160 F S RA1=$O(RAA(RA1)) Q:'RA1 S RAX=$G(RAA(RA1,0)) D:RAX
161 .S RAFDA(RAF2,"+2,"_RACNI_","_RADTI_","_RADFN_",",.01)=RAX
162 .D UPDATE^DIE(,"RAFDA",,"RAMSG")
163 .I $D(RAMSG("DIERR")) D ERR4(RACN,$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
164 .E D MSG2(RACN,$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
165 .K RAFDA,RAMSG
166 .Q
167 Q
168 ;
169 ; cases from printset
170 ;
171PSET ; copy Primary into cases of a printset
172 S RA1=0
173 F S RA1=$O(RAMEMARR(RA1)) Q:RA1="" D
174 .S RAFDA(70.03,RA1_","_RADTI_","_RADFN_",",RAPIECE)=RAPREV
175 .D FILE^DIE("","RAFDA","RAMSG")
176 .I $D(RAMSG("DIERR")) D ERR4(+RAMEMARR(RA1),$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
177 .E D MSG2(+RAMEMARR(RA1),$$GET1^DID(70.03,RAPIECE,"","LABEL"),$$GET1^DIQ(RAF3,RAPREV,.01))
178 .K RAFDA,RAMSG
179 .Q:$O(RAA(0))'>0 ; no secondary DXs
180 .; copy secondaries into cases of a printset
181 .S RA2=0
182 .F S RA2=$O(RAA(RA2)) Q:'RA2 S RAX=$G(RAA(RA2,0)) D:RAX
183 ..S RAFDA(RAF2,"+2,"_RA1_","_RADTI_","_RADFN_",",.01)=RAX
184 ..D UPDATE^DIE(,"RAFDA",,"RAMSG")
185 ..I $D(RAMSG("DIERR")) D ERR4(+RAMEMARR(RA1),$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
186 ..E D MSG2(+RAMEMARR(RA1),$$GET1^DID(RAF2,.01,"","LABEL"),$$GET1^DIQ(RAF3,RAX,.01))
187 ..K RAFDA,RAMSG
188 ..Q
189 .Q
190 Q
191SETFF(RA1,RA2,RA3,RA4,RA5) ;reset file's field value
192 ;RA1 file number
193 ;RA2 field number
194 ;RA3 IEN in file
195 ;RA4 field value to set in record IEN
196 ;RA5 (optional), set to "E" for external
197 N RAFDA
198 S RAFDA(RA1,RA3_",",RA2)=RA4
199 I $G(RA5)="E" D FILE^DIE("E","RAFDA")
200 E D FILE^DIE("","RAFDA")
201 Q
202SETALOG(RA1,RA2,RA3) ;set new record in Activity log 74.01
203 ;RA1 ien string, eg., "+1,"_RARPT_","
204 ;RA2 type of action
205 ;RA3 current report status code
206 ;
207 N RAFDA
208 S RAFDA(74.01,RA1,.01)=+$E($$NOW^XLFDT(),1,12)
209 S RAFDA(74.01,RA1,2)=RA2
210 S RAFDA(74.01,RA1,3)=$G(DUZ)
211 S:RA3 RAFDA(74.01,RA1,4)=RA3 ;only del rpt would have data here
212 D UPDATE^DIE(,"RAFDA")
213 Q
214MSG1(X) ;
215 W !?3,"... Linked restored report to case no. ",X
216 Q
217MSG2(X,Y,Z) ;
218 W !?3,"... Restored case ",X,"'s ",Y," to: ",Z
219 Q
220ERR0 ;
221 W !,"Unable to determine case previously associated with this report."
222 S RAXIT=1
223 Q
224ERR1 W !!,"Cannot determine previous report status.",!
225 S RAXIT=1
226 Q
227ERR2(X,Y,Z) ;X=External short case No, Y=File no., Z=Field no.
228 W !,"Case #",X," already has ",$$GET1^DID(Y,Z,"","LABEL")
229 S RAXIT=1
230 Q
231ERR3(X) ;
232 W !,"Case #",X," is already associated with a report!"
233 S RAXIT=1
234 Q
235ERR4(X,Y,Z) ;
236 W !!?3,"Cannot restore case ",X,"'s ",Y," to: ",Z
237 Q
238NOTDONE ;
239 W !!?3,"Restoration was not done."
240 ; continue to clean up
241FINISH ; clean up and exit
242 R !!!,"Press RETURN to exit. ",X:DTIME
243 K DIRUT,I
244 K RA1,RA2,RA3,RA4,RA5,RA18EX,RA70,RA74,RAA,RACMDATA
245 K RACN,RACNI,RADATE,RADFN,RADTE,RADTI,RADUZ,RAFDA,RAF1,RAF2,RAF3
246 K RAI,RAIENL,RAIENS,RAIENSUB,RALAST,RALCKFLG,RAMEMARR,RANME,RANODE
247 K RAOUT,RAPIECE,RAPRC,RAPRTSET,RAPRVIEN,RAPREV,RAPRVST,RAROOT,RARPT
248 K RASSN,RAST,RASUB70,RASUBY0,RAX,RAXIT,X,XY,Y,Z
249 Q
250DISPLAY ; Display exam specific info, edit/enter the report
251 ; adapted from routine RARTE
252 S RA18EX=0 ;P18 for quit if uparrow inside PUTTCOM
253 I '($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))#2) D D Q1^RARTE5 QUIT
254 . W !!?2,"Case #: ",RACN," for ",RANME S RAXIT=1
255 . W !?2,"Procedure: '",$E(RAPRC,1,45),"' has been deleted"
256 . W !?2,"by another user!",$C(7)
257 . Q
258 ;
259 S RAI="",$P(RAI,"-",80)="" W !,RAI
260 W !?1,"Name : ",$E(RANME,1,25),?40,"Pt ID : ",RASSN
261 W !?1,"Case No. : ",RACN,?18,"Exm. St: ",$E($P($G(^RA(72,+RAST,0)),"^"),1,12),?40,"Procedure : ",$E(RAPRC,1,25)
262 ;check for contrast media; display if CM data exists (patch 45)
263 S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RACNI)
264 D:$L(RACMDATA) CMEDIA^RARTE(RACMDATA)
265 K RACMDATA
266 S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,RACN," Tech.Comment: ",15,70,-1,0) ;P18
267 I RA18EX=-1 Q ;P18
268 ;
269 D:'$D(RAPRTSET) EN2^RAUTL20(.RAMEMARR)
270 ; if printset, display cases and continue on to display Exam Date
271 I RAPRTSET D
272 . S RA1=""
273 . F S RA1=$O(RAMEMARR(RA1)) Q:RA1=""!(RA18EX=-1) I RA1'=RACNI D
274 .. W !,?1,"Case No. : ",+RAMEMARR(RA1)
275 .. W:$P(RAMEMARR(RA1),"^",4)]"" ?18,"Exm. St: ",$E($P($G(^RA(72,$P(RAMEMARR(RA1),"^",4),0)),"^"),1,12)
276 .. W ?40,"Procedure : ",$E($P($G(^RAMIS(71,+$P(RAMEMARR(RA1),"^",2),0)),"^"),1,26)
277 ..;check printset for contrast media; display if CM data exists
278 ..S RACMDATA=$$CMEDIA^RAUTL8(RADFN,RADTI,RA1)
279 ..D:$L(RACMDATA) CMEDIA^RARTE(RACMDATA)
280 ..K RACMDATA
281 .. S RA18EX=$$PUTTCOM2^RAUTL11(RADFN,RADTI,+RAMEMARR(RA1)," Tech.Comment: ",15,70,-1,0) Q:RA18EX=-1 ;P18
282 .. Q
283 . Q
284 ;continue display
285 I RA18EX=-1 Q ;P18
286 S Y(0)=RASUBY0
287 S RAIENS=RACNI_","_RADTI_","_RADFN_","
288 D GETS^DIQ(70.03,RAIENS,"14;175*","E","RAOUT")
289 W !?1,"Exam Date: ",RADATE,?40,"Technologist: "
290 S RAIENSUB=$O(RAOUT(70.12,0))
291 W:RAIENSUB]"" $E($G(RAOUT(70.12,RAIENSUB,.01,"E")),1,25)
292 W !?40,"Req Phys : "
293 W $E($G(RAOUT(70.03,RAIENS,14,"E")),1,25)
294 W !,RAI
295 Q
296LOCK(X,Y) ; Lock the data global
297 ; uses var DILOCKTM, code taken from rtn RAUTL12
298 ; 'X' is the global root
299 ; 'Y' is the record number
300 N RALCKFLG,XY
301 S RADUZ=+$G(DUZ),RALCKFLG=0,XY=X_Y
302 L +@(XY_")"):DILOCKTM
303 I '$T S RALCKFLG=1 D
304 . W !?5,"This record is being edited by another user."
305 . W !?5,"Try again later!",$C(7)
306 . Q
307 E D
308 . S ^TMP("RAD LOCKS",$J,RADUZ,X,Y)=""
309 . Q
310 Q RALCKFLG
311INTRO ;
312 ;; +--------------------------------------------------------+
313 ;; | |
314 ;; | This option is for restoring a deleted report. |
315 ;; | |
316 ;; +--------------------------------------------------------+
Note: See TracBrowser for help on using the repository browser.