source: cprs/branches/tmg-cprs/m_files/TMGTICK2.m~@ 796

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

Initial upload

  • Property svn:executable set to *
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 new % set %=1
95 write "Review tickler messages for selected entries?" do YN^DICN write !
96 if %=-1 set abort=1 goto SELTDONE
97 if %=1 do DispTicklers(.SelArray)
98 write "Goodbye.",!
99BWDN quit
100
101
102DELTICKL ;
103 ;"Purpose: allow user to pick tickler message to delete.
104 new SelArray
105 write !
106 new % set %=2
107 write "Select tickler messages to DELETE" do YN^DICN write !
108 if %'=1 goto DTDN
109 set abort=$$SELTICKLERS(.SelArray)
110 if abort goto DTDN
111 if $data(SelArray)=0 goto DTDN
112
113 set %=1
114 write "Review tickler messages for selected entries?" do YN^DICN write !
115 if %=-1 goto DTDN
116 if %=1 do DispTicklers(.SelArray)
117
118 set %=2
119 write "Delete selected tickler messages" do YN^DICN write !
120 if %=-1 goto DTDN
121 new DelCt set DelCt=0
122 if %=1 do
123 . set DelCt=$$DELSET(.SelArray)
124 . write DelCt," tickler messages deleted.",!
125
126 write "Goodbye.",!
127 do PressToCont^TMGUSRIF
128DTDN quit
129
130
131
132SELTICKLERS(SelArray)
133 ;"Browse tickler messages and return array of IEN's selected.
134 ;"Input: SelArray -- PASS BY REFERENCE. An OUT ARRAY.
135 ;"Output: SelArray is filled as follows:
136 ;" SelArray(IEN)=DispLineNumber
137 ;" SelArray(IEN)=DispLineNumber
138 ;"Results: 1 if aborted, otherwise 0
139
140 new abort set abort=0
141 kill SelArray
142 write !,"== TICKER MESSAGES BROWSER ==",!!
143 new % set %=2
144 write "View COMPLETED ticker messages " DO YN^DICN write !
145 if %=-1 goto SELTDONE
146 new HideCompl set HideCompl=(%=2)
147
148 new Menu,usrChoice
149 new LineCt set LineCt=1
150 set Menu(0)="Pick Display Order for Selector"
151 if HideCompl do
152 . set Menu(LineCt)="User Name; Due Date; Patient Name"_$C(9)_"3;1;.01;2^20;15;20;10",LineCt=LineCt+1
153 . set Menu(LineCt)="Patient Name; User Name; Due Date"_$C(9)_".01;3;1;2^20;20;15;10",LineCt=LineCt+1
154 . set Menu(LineCt)="Due Date; Patient Name; User Name"_$C(9)_"1;.01;3;2^15;20;20;10",LineCt=LineCt+1
155 . set Menu(LineCt)="Note Date; Patient Name; User Name"_$C(9)_"4;.01;3;2^15;20;10;15",LineCt=LineCt+1
156 else do
157 . set Menu(LineCt)="User Name; Status; Due Date; Patient Name"_$C(9)_"3;2;1;.01^20;10;15;20",LineCt=LineCt+1
158 . set Menu(LineCt)="Patient Name; Status; User Name; Due Date"_$C(9)_".01;2;3;1^20;10;20;15",LineCt=LineCt+1
159 . set Menu(LineCt)="Due Date; Patient Name; Status; User Name"_$C(9)_"1;.01;2;3^15;20;10;20",LineCt=LineCt+1
160 . set Menu(LineCt)="Note Date; Patient Name; Status; User Name"_$C(9)_"4;.01;2;3^15;20;10;15",LineCt=LineCt+1
161 . set Menu(LineCt)="Status; Due Date; Patient Name; User Name"_$C(9)_"2;1;.01;3^10;15;20;20",LineCt=LineCt+1
162
163 set usrChoice=$$Menu^TMGUSRIF(.Menu,3)
164 if usrChoice="^" goto SELTDONE
165
166 new fields,widths
167 set fields=$piece(usrChoice,"^",1)
168 set widths=$piece(usrChoice,"^",2)
169
170 new IENArray
171 new IEN set IEN=0
172 for set IEN=$order(^TMG(22705.5,IEN)) quit:(+IEN'>0) do
173 . new status
174 . set status=$piece($get(^TMG(22705.5,IEN,0)),"^",3)
175 . if (status="C"),(HideCompl=1) quit
176 . set IENArray(IEN)=""
177 .
178 new Header set Header="Pick Tickler Messages. Press <ESC><ESC> when done."
179 do IENSelector^TMGUSRIF("IENArray","SelArray",22705.5,fields,widths,Header,fields)
180SELTDONE
181 quit abort
182
183
184CLEANDON ;
185 ;"Purpose: to remove tickler messages that have been completed, thus no longer needed.
186 ;"Results: None
187 write !,"== CLEAN UP COMPLETED TICKER MESSAGES ==",!!
188 new % set %=2
189 write "DELETE all COMPLETED ticker messages " DO YN^DICN write !
190 if %'=1 goto DELDONE
191 do GetStatusSet("C",.IENArray) ;
192 new DelCt set DelCt=$$DELSET(.IENArray)
193 write DelCt," completed tickler messages deleted.",!
194DELDONE quit
195
196CLEANOPH ;
197 ;"Purpose: to remove tickler messages that have been orphaned, thus no longer needed.
198 ;"NOTE: An orphan note is created when a user launches a tickler object in a note, but
199 ;" then removes the text, so that the note does not actually have a tickler in it.
200 ;"Results: None
201 new abort set abort=0
202 New IENArray
203 write !,"== CLEAN UP ORPHANED TICKER MESSAGES ==",!!
204 write "Note: An ORPHAN ticker message occurs when a user launches",!
205 write " the tickler text object from in CPRS, but then deletes",!
206 write " it, so that the note does not actually have a tickler",!
207 write " message in it. There should be no harm in doing this.",!,!
208 new % set %=2
209 write "DELETE all ORPHANED ticker messages " DO YN^DICN write !
210 if %'=1 goto ORPHDONE
211 do GetStatusSet("O",.IENArray) ;
212 new DelCt set DelCt=$$DELSET(.IENArray)
213 write DelCt," orphaned tickler messages deleted.",!
214 do PressToCont^TMGUSRIF
215ORPHDONE quit
216
217GetStatusSet(Status,IENArray) ;
218 ;"Purpose: return a set of entries with given status.
219 ;"Input: Status -- the internal form of desired status.
220 ;" IENArray. PASS BY REFERENCE. format as below.
221 ;" IENArray(IEN)=""
222 ;" IENArray(IEN)=""
223 new IEN set IEN=0
224 for set IEN=$order(^TMG(22705.5,IEN)) quit:(+IEN'>0) do
225 . new ThisStat set ThisStat=$piece($get(^TMG(22705.5,IEN,0)),"^",3)
226 . if (ThisStat=Status) set IENArray(IEN)=""
227 quit
228
229DELSET(IENArray) ;
230 ;"Purpose: To delete the specified Tickler Entries.
231 ;"Input: IENArray. PASS BY REFERENCE. format as below.
232 ;" IENArray(IEN)=""
233 ;" IENArray(IEN)=""
234 ;" NOTe: All included entries will be deleted with NO confirmation.
235 ;"Results: returns number of deleted entries.
236 ;
237 new DIK set DIK="^TMG(22705.5,"
238 new DA
239 new DelCt set DelCt=0
240 new IEN set IEN=0
241 for set IEN=$order(IENArray(IEN)) quit:(+IEN'>0) do
242 . set DA=IEN do ^DIK
243 . set DelCt=DelCt+1
244 quit DelCt
245
246DispTicklers(IENArray)
247 ;"Purpose: Display a list of tickler messages
248 ;"Input: IENArray. PASS BY REFERENCE. format:
249 ;" IENArray(IEN)=""
250 ;" IENArray(IEN)=""
251 ;"Results: None
252
253 new count set count=0
254 new abort set abort=0
255 new TklIEN set TklIEN=""
256 for set TklIEN=$order(SelArray(TklIEN)) quit:(TklIEN="")!abort do
257 . set count=count+1
258 . write "----------------------------------",!
259 . write "STATUS: ",$$GET1^DIQ(22705.5,TklIEN,2),!
260 . write "DUE DATE: ",$$GET1^DIQ(22705.5,TklIEN,1),!
261 . write "PATIENT: ",$$GET1^DIQ(22705.5,TklIEN,.01),!
262 . write "DOCUMENT: ",$$GET1^DIQ(22705.5,TklIEN,.05)," (#",$$GET1^DIQ(22705.5,TklIEN,.05,"I"),")",!
263 . write "DOC DATE: ",$$GET1^DIQ(22705.5,TklIEN,4),!
264 . write "USER: ",$$GET1^DIQ(22705.5,TklIEN,3),!
265 . write "MESSAGE (1st line):",!," ",$$GET1^DIQ(22705.5,TklIEN,5),!
266 . if count#3=0 do
267 . . new temp read "Press Enter to Continue",temp:$get(DTIME,3600),!
268 . . set abort=(temp="^")
269
270 if count=0 write "(No items to display.)",!
271 write !
272 quit
273
274
275REUSER ;"Reassign Tickler File Recipient User
276 ;"Purpose: to allow browsing for a set of Tickler files, and reassigning the target user
277 ;"Result: none
278
279 new numErrors set numErrors=0
280 new NumProcessed set NumProcessed=0
281
282 write !," -= REASSIGN RECIPIENT USER FOR TICKLER MESSAGES =-",!,!
283 write "You will next be able to select tickler messages to reassign.",!
284 write "Note: Only change tickler messages with a PENDING status.",!
285 write " Changing others will have no effect.",!,!
286 do PressToCont^TMGUSRIF
287
288 if $$SELTICKLERS(.SelArray)=1 goto REUDONE
289
290 if $data(SelArray)=0 goto REUDONE
291 new % set %=2
292 write "Pick new recipient user for the selected tickler messages?"
293 do YN^DICN write !
294 if %'=1 goto REUDONE
295
296 new DIC set DIC=200
297 set DIC(0)="MAEQ"
298 set DIC("A")="Select new RECIPIENT USER: "
299 do ^DIC write !
300 if +Y'>0 goto REUDONE
301
302 new IEN set IEN=""
303 for set IEN=$order(SelArray(IEN)) quit:(IEN="") do
304 . set NumProcessed=NumProcessed+1
305 . new TMGFDA,TMGMSG
306 . set TMGFDA(22705.5,IEN_",",3)=+Y
307 . do FILE^DIE("","TMGFDA","TMGMSG")
308 . if $data(TMGMSG("DIERR"))>0 do
309 . . do ShowDIERR^TMGDEBUG(.TMGMSG)
310 . . set numErrors=numErrors+1
311REUDONE
312 write !,NumProcessed," tickler message file entries processed.",!
313 if NumProcessed>0 write numErrors," errors encountered.",!
314 write "Goodbye",!
315 quit
316
317
318REDATE ;"Reassign Due Dates for Tickler File
319 ;"Purpose: to allow browsing for a set of Tickler files, and reassigning due date
320 ;"Result: none
321
322 write !," -= REASSIGN DUE DATE FOR TICKLER MESSAGES =-",!,!
323 write "You will next be able to select tickler messages to change.",!
324 write "Note: Only change tickler messages with a PENDING status.",!
325 write " Changing others will have no effect.",!,!
326 do PressToCont^TMGUSRIF
327
328 if $$SELTICKLERS(.SelArray)=1 goto REDDONE
329
330 new numErrors set numErrors=0
331 new NumProcessed set NumProcessed=0
332 if $data(SelArray)=0 goto REUDONE
333 new % set %=2
334 write "Pick new DUE DATE for the selected tickler messages?"
335 do YN^DICN write !
336 if %'=1 goto REDDONE
337
338 new DIR,X,Y
339 set DIR(0)="DO",DIR("A")="Enter new DUE DATE (^ to abort)"
340 do ^DIR write !
341 if +Y'>0 goto REDDONE
342
343 new IEN set IEN=""
344 for set IEN=$order(SelArray(IEN)) quit:(IEN="") do
345 . set NumProcessed=NumProcessed+1
346 . new TMGFDA,TMGMSG
347 . set TMGFDA(22705.5,IEN_",",1)=+Y
348 . do FILE^DIE("","TMGFDA","TMGMSG")
349 . if $data(TMGMSG("DIERR"))>0 do
350 . . do ShowDIERR^TMGDEBUG(.TMGMSG)
351 . . set numErrors=numErrors+1
352
353REDDONE
354 write !,NumProcessed," tickler message file entries processed.",!
355 if NumProcessed>0 write numErrors," errors encountered.",!
356 write "Goodbye",!
357 quit
Note: See TracBrowser for help on using the repository browser.