source: cprs/branches/tmg-cprs/m_files/TMGTICK2.m

Last change on this file was 896, checked in by Kevin Toppenberg, 14 years ago

replacing soft links with actual files
File size: 14.2 KB
Line 
1TMGTICKL ;TMG/kst-Tickler Text Object Support Files;09/04/08
2 ;;1.0;TMG-LIB;**1**;09/05/08
3
4 ;"---------------------------------------------------------------------------
5 ;"PUBLIC FUNCTIONS
6 ;"---------------------------------------------------------------------------
7 ;"GETMSG(DocIEN,WPArray) -- retrieve tickler message in document.
8 ;"FLMSG(IEN) -- return the first line of the tickler message
9 ;"SELTCKLS(SelArray) -- Browse tickler messages and return array of IEN's selected.
10 ;"REUSER -- Allow browsing for a set of Tickler files, and reassigning the target user
11 ;"REDATE -- Allow browsing for a set of Tickler files, and reassigning the due date
12 ;"BROWSE -- Browse tickler messages.
13 ;"$$SELTICKLERS(SelArray) -- Browse tickler messages and return array of IEN's selected.
14 ;"CLEANDON -- remove tickler messages that have been completed, thus no longer needed.
15 ;"CLEANOPH -- remove tickler messages that have been orphaned, thus no longer needed.
16 ;"DispTicklers(IENArray) -- Display a list of tickler messages
17
18 ;"---------------------------------------------------------------------------
19 ;"PRIVATE FUNCTIONS
20 ;"---------------------------------------------------------------------------
21 ;"Dependencies:
22 ;" IENSelector^TMGUSRIF
23 ;" --> SELECT^%ZVEMKT
24 ;" --> ItrAInit^TMGITR
25 ;" Menu^TMGUSRIF
26 ;" ShowDIERR^TMGDEBUG
27
28FLMSG(IEN)
29 ;"Purpose: To return the first line of the tickler message
30 ;"NOTE: !!! DON'T REMOVE THIS FUNCTION. It is called by the computed field,
31 ;" FIRST LINE OF MESSAGE (field #5) in file 22705.5 (TICKLER FILE MESSAGES)
32 ;"Input: IEN: IEN in file 22705.5
33 ;"Output: Returns first line, or "" if null
34
35 new result set result=""
36 new DocIEN set DocIEN=+$piece($get(^TMG(22705.5,IEN,0)),"^",4)
37 if DocIEN>0 do
38 . new WPArray
39 . new temp set temp=$$GETMSG(DocIEN,.WPArray)
40 . set result=$get(WPArray(1))
41 quit result
42
43
44GETMSG(DocIEN,WPArray)
45 ;"Purpose: To retrieve the message for a tickler message in document.
46 ;"Note: It is expected that the Tickler text structure will be:
47 ;"
48 ;" ======= [TICKLER MESSGE] =======
49 ;" #DUE#: Put-DUE-DATE-here
50 ;" ================================
51 ;" Message: ...
52 ;"
53 ;" ================================
54 ;"
55 ;" And specifically, the key elements are:
56 ;" 1. Entire Tickler starts with [TICKLER MESSGE]
57 ;" 2. Message starts on line after ===========
58 ;" 3. Messge ends with line with ===========
59 ;" If no closing =========== found, message extends to end of document
60 ;"
61 ;"Input: DocIEN -- IEN in 8925
62 ;" WPArray -- PASS BY REFERENCE, an OUT PARAMETER. Returns message. Format:
63 ;" WPArray(1)='1st list'
64 ;" WPArray(2)='2nd line' etc...
65 ;"Result: 1 if found, 0 if not.
66
67 new found,line set (found,line)=0
68 for set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!found do
69 . set found=($get(^TIU(8925,DocIEN,"TEXT",line,0))["[TICKLER MESSGE]")
70 . if found do
71 . . new done set done=0
72 . . new lineText set lineText=""
73 . . for quit:done set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!done do
74 . . . set done=$get(^TIU(8925,DocIEN,"TEXT",line,0))["====="
75 . . set done=0
76 . . new wpIndex set wpIndex=1
77 . . for set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!done do
78 . . . set done=$get(^TIU(8925,DocIEN,"TEXT",line,0))["====="
79 . . . if done quit
80 . . . set WPArray(wpIndex)=$get(^TIU(8925,DocIEN,"TEXT",line,0))
81 . . . set wpIndex=wpIndex+1
82
83 quit found
84
85
86BROWSE
87 ;"Purpose: To browse tickler messages
88 ;"Results: none
89
90 new SelArray,abort
91 write !
92 set abort=$$SELTICKLERS(.SelArray)
93 if abort goto BWDN
94 if $data(SelArray)=0 goto BWDN
95 new % set %=1
96 write "Review tickler messages for selected entries?" do YN^DICN write !
97 if %=-1 set abort=1 goto SELTDONE
98 if %=1 do DispTicklers(.SelArray)
99 write "Goodbye.",!
100BWDN quit
101
102
103DELTICKL ;
104 ;"Purpose: allow user to pick tickler message to delete.
105 new SelArray
106 write !
107 new % set %=2
108 write "Select tickler messages to DELETE" do YN^DICN write !
109 if %'=1 goto DTDN
110 set abort=$$SELTICKLERS(.SelArray)
111 if abort goto DTDN
112 if $data(SelArray)=0 goto DTDN
113
114 set %=1
115 write "Review tickler messages for selected entries?" do YN^DICN write !
116 if %=-1 goto DTDN
117 if %=1 do DispTicklers(.SelArray)
118
119 set %=2
120 write "Delete selected tickler messages" do YN^DICN write !
121 if %=-1 goto DTDN
122 new DelCt set DelCt=0
123 if %=1 do
124 . set DelCt=$$DELSET(.SelArray)
125 . write DelCt," tickler messages deleted.",!
126
127 write "Goodbye.",!
128 do PressToCont^TMGUSRIF
129DTDN quit
130
131
132
133SELTICKLERS(SelArray)
134 ;"Browse tickler messages and return array of IEN's selected.
135 ;"Input: SelArray -- PASS BY REFERENCE. An OUT ARRAY.
136 ;"Output: SelArray is filled as follows:
137 ;" SelArray(IEN)=DispLineNumber
138 ;" SelArray(IEN)=DispLineNumber
139 ;"Results: 1 if aborted, otherwise 0
140
141 new abort set abort=0
142 kill SelArray
143 write !,"== TICKER MESSAGES BROWSER ==",!!
144 new % set %=2
145 write "View COMPLETED ticker messages " DO YN^DICN write !
146 if %=-1 goto SELTDONE
147 new HideCompl set HideCompl=(%=2)
148
149 new Menu,usrChoice
150 new LineCt set LineCt=1
151 set Menu(0)="Pick Display Order for Selector"
152 if HideCompl do
153 . set Menu(LineCt)="User Name; Due Date; Patient Name"_$C(9)_"3;1;.01;2^20;15;20;10",LineCt=LineCt+1
154 . set Menu(LineCt)="Patient Name; User Name; Due Date"_$C(9)_".01;3;1;2^20;20;15;10",LineCt=LineCt+1
155 . set Menu(LineCt)="Due Date; Patient Name; User Name"_$C(9)_"1;.01;3;2^15;20;20;10",LineCt=LineCt+1
156 . set Menu(LineCt)="Note Date; Patient Name; User Name"_$C(9)_"4;.01;3;2^15;20;10;15",LineCt=LineCt+1
157 else do
158 . set Menu(LineCt)="User Name; Status; Due Date; Patient Name"_$C(9)_"3;2;1;.01^20;10;15;20",LineCt=LineCt+1
159 . set Menu(LineCt)="Patient Name; Status; User Name; Due Date"_$C(9)_".01;2;3;1^20;10;20;15",LineCt=LineCt+1
160 . set Menu(LineCt)="Due Date; Patient Name; Status; User Name"_$C(9)_"1;.01;2;3^15;20;10;20",LineCt=LineCt+1
161 . set Menu(LineCt)="Note Date; Patient Name; Status; User Name"_$C(9)_"4;.01;2;3^15;20;10;15",LineCt=LineCt+1
162 . set Menu(LineCt)="Status; Due Date; Patient Name; User Name"_$C(9)_"2;1;.01;3^10;15;20;20",LineCt=LineCt+1
163
164 set usrChoice=$$Menu^TMGUSRIF(.Menu,3)
165 if usrChoice="^" goto SELTDONE
166
167 new fields,widths
168 set fields=$piece(usrChoice,"^",1)
169 set widths=$piece(usrChoice,"^",2)
170
171 new IENArray
172 new IEN set IEN=0
173 for set IEN=$order(^TMG(22705.5,IEN)) quit:(+IEN'>0) do
174 . new status
175 . set status=$piece($get(^TMG(22705.5,IEN,0)),"^",3)
176 . if (status="C"),(HideCompl=1) quit
177 . set IENArray(IEN)=""
178 .
179 new Header set Header="Pick Tickler Messages. Press <ESC><ESC> when done."
180 do IENSelector^TMGUSRIF("IENArray","SelArray",22705.5,fields,widths,Header,fields)
181SELTDONE
182 quit abort
183
184
185CLEANDON ;
186 ;"Purpose: to remove tickler messages that have been completed, thus no longer needed.
187 ;"Results: None
188 write !,"== CLEAN UP COMPLETED TICKER MESSAGES ==",!!
189 new % set %=2
190 write "DELETE all COMPLETED ticker messages " DO YN^DICN write !
191 if %'=1 goto DELDONE
192 do GetStatusSet("C",.IENArray) ;
193 new DelCt set DelCt=$$DELSET(.IENArray)
194 write DelCt," completed tickler messages deleted.",!
195DELDONE quit
196
197CLEANOPH ;
198 ;"Purpose: to remove tickler messages that have been orphaned, thus no longer needed.
199 ;"NOTE: An orphan note is created when a user launches a tickler object in a note, but
200 ;" then removes the text, so that the note does not actually have a tickler in it.
201 ;"Results: None
202 new abort set abort=0
203 New IENArray
204 write !,"== CLEAN UP ORPHANED TICKER MESSAGES ==",!!
205 write "Note: An ORPHAN ticker message occurs when a user launches",!
206 write " the tickler text object from in CPRS, but then deletes",!
207 write " it, so that the note does not actually have a tickler",!
208 write " message in it. There should be no harm in doing this.",!,!
209 new % set %=2
210 write "DELETE all ORPHANED ticker messages " DO YN^DICN write !
211 if %'=1 goto ORPHDONE
212 do GetStatusSet("O",.IENArray) ;
213 new DelCt set DelCt=$$DELSET(.IENArray)
214 write DelCt," orphaned tickler messages deleted.",!
215 do PressToCont^TMGUSRIF
216ORPHDONE quit
217
218GetStatusSet(Status,IENArray) ;
219 ;"Purpose: return a set of entries with given status.
220 ;"Input: Status -- the internal form of desired status.
221 ;" IENArray. PASS BY REFERENCE. format as below.
222 ;" IENArray(IEN)=""
223 ;" IENArray(IEN)=""
224 new IEN set IEN=0
225 for set IEN=$order(^TMG(22705.5,IEN)) quit:(+IEN'>0) do
226 . new ThisStat set ThisStat=$piece($get(^TMG(22705.5,IEN,0)),"^",3)
227 . if (ThisStat=Status) set IENArray(IEN)=""
228 quit
229
230DELSET(IENArray) ;
231 ;"Purpose: To delete the specified Tickler Entries.
232 ;"Input: IENArray. PASS BY REFERENCE. format as below.
233 ;" IENArray(IEN)=""
234 ;" IENArray(IEN)=""
235 ;" NOTe: All included entries will be deleted with NO confirmation.
236 ;"Results: returns number of deleted entries.
237 ;
238 new DIK set DIK="^TMG(22705.5,"
239 new DA
240 new DelCt set DelCt=0
241 new IEN set IEN=0
242 for set IEN=$order(IENArray(IEN)) quit:(+IEN'>0) do
243 . set DA=IEN do ^DIK
244 . set DelCt=DelCt+1
245 quit DelCt
246
247DispTicklers(IENArray)
248 ;"Purpose: Display a list of tickler messages
249 ;"Input: IENArray. PASS BY REFERENCE. format:
250 ;" IENArray(IEN)=""
251 ;" IENArray(IEN)=""
252 ;"Results: None
253
254 new count set count=0
255 new abort set abort=0
256 new TklIEN set TklIEN=""
257 for set TklIEN=$order(SelArray(TklIEN)) quit:(TklIEN="")!abort do
258 . set count=count+1
259 . write "----------------------------------",!
260 . write "STATUS: ",$$GET1^DIQ(22705.5,TklIEN,2),!
261 . write "DUE DATE: ",$$GET1^DIQ(22705.5,TklIEN,1),!
262 . write "PATIENT: ",$$GET1^DIQ(22705.5,TklIEN,.01),!
263 . write "DOCUMENT: ",$$GET1^DIQ(22705.5,TklIEN,.05)," (#",$$GET1^DIQ(22705.5,TklIEN,.05,"I"),")",!
264 . write "DOC DATE: ",$$GET1^DIQ(22705.5,TklIEN,4),!
265 . write "USER: ",$$GET1^DIQ(22705.5,TklIEN,3),!
266 . write "MESSAGE (1st line):",!," ",$$GET1^DIQ(22705.5,TklIEN,5),!
267 . if count#3=0 do
268 . . new temp read "Press Enter to Continue",temp:$get(DTIME,3600),!
269 . . set abort=(temp="^")
270
271 if count=0 write "(No items to display.)",!
272 write !
273 quit
274
275
276REUSER ;"Reassign Tickler File Recipient User
277 ;"Purpose: to allow browsing for a set of Tickler files, and reassigning the target user
278 ;"Result: none
279
280 new numErrors set numErrors=0
281 new NumProcessed set NumProcessed=0
282
283 write !," -= REASSIGN RECIPIENT USER FOR TICKLER MESSAGES =-",!,!
284 write "You will next be able to select tickler messages to reassign.",!
285 write "Note: Only change tickler messages with a PENDING status.",!
286 write " Changing others will have no effect.",!,!
287 do PressToCont^TMGUSRIF
288
289 if $$SELTICKLERS(.SelArray)=1 goto REUDONE
290
291 if $data(SelArray)=0 goto REUDONE
292 new % set %=2
293 write "Pick new recipient user for the selected tickler messages?"
294 do YN^DICN write !
295 if %'=1 goto REUDONE
296
297 new DIC set DIC=200
298 set DIC(0)="MAEQ"
299 set DIC("A")="Select new RECIPIENT USER: "
300 do ^DIC write !
301 if +Y'>0 goto REUDONE
302
303 new IEN set IEN=""
304 for set IEN=$order(SelArray(IEN)) quit:(IEN="") do
305 . set NumProcessed=NumProcessed+1
306 . new TMGFDA,TMGMSG
307 . set TMGFDA(22705.5,IEN_",",3)=+Y
308 . do FILE^DIE("","TMGFDA","TMGMSG")
309 . if $data(TMGMSG("DIERR"))>0 do
310 . . do ShowDIERR^TMGDEBUG(.TMGMSG)
311 . . set numErrors=numErrors+1
312REUDONE
313 write !,NumProcessed," tickler message file entries processed.",!
314 if NumProcessed>0 write numErrors," errors encountered.",!
315 write "Goodbye",!
316 quit
317
318
319REDATE ;"Reassign Due Dates for Tickler File
320 ;"Purpose: to allow browsing for a set of Tickler files, and reassigning due date
321 ;"Result: none
322
323 write !," -= REASSIGN DUE DATE FOR TICKLER MESSAGES =-",!,!
324 write "You will next be able to select tickler messages to change.",!
325 write "Note: Only change tickler messages with a PENDING status.",!
326 write " Changing others will have no effect.",!,!
327 do PressToCont^TMGUSRIF
328
329 if $$SELTICKLERS(.SelArray)=1 goto REDDONE
330
331 new numErrors set numErrors=0
332 new NumProcessed set NumProcessed=0
333 if $data(SelArray)=0 goto REUDONE
334 new % set %=2
335 write "Pick new DUE DATE for the selected tickler messages?"
336 do YN^DICN write !
337 if %'=1 goto REDDONE
338
339 new DIR,X,Y
340 set DIR(0)="DO",DIR("A")="Enter new DUE DATE (^ to abort)"
341 do ^DIR write !
342 if +Y'>0 goto REDDONE
343
344 new IEN set IEN=""
345 for set IEN=$order(SelArray(IEN)) quit:(IEN="") do
346 . set NumProcessed=NumProcessed+1
347 . new TMGFDA,TMGMSG
348 . set TMGFDA(22705.5,IEN_",",1)=+Y
349 . do FILE^DIE("","TMGFDA","TMGMSG")
350 . if $data(TMGMSG("DIERR"))>0 do
351 . . do ShowDIERR^TMGDEBUG(.TMGMSG)
352 . . set numErrors=numErrors+1
353
354REDDONE
355 write !,NumProcessed," tickler message file entries processed.",!
356 if NumProcessed>0 write numErrors," errors encountered.",!
357 write "Goodbye",!
358 quit
Note: See TracBrowser for help on using the repository browser.