1 | TMGTICKL ;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 |
|
---|
28 | FLMSG(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 |
|
---|
44 | GETMSG(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 |
|
---|
86 | BROWSE
|
---|
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.",!
|
---|
100 | BWDN quit
|
---|
101 |
|
---|
102 |
|
---|
103 | DELTICKL ;
|
---|
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
|
---|
129 | DTDN quit
|
---|
130 |
|
---|
131 |
|
---|
132 |
|
---|
133 | SELTICKLERS(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)
|
---|
181 | SELTDONE
|
---|
182 | quit abort
|
---|
183 |
|
---|
184 |
|
---|
185 | CLEANDON ;
|
---|
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.",!
|
---|
195 | DELDONE quit
|
---|
196 |
|
---|
197 | CLEANOPH ;
|
---|
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
|
---|
216 | ORPHDONE quit
|
---|
217 |
|
---|
218 | GetStatusSet(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 |
|
---|
230 | DELSET(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 |
|
---|
247 | DispTicklers(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 |
|
---|
276 | REUSER ;"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
|
---|
312 | REUDONE
|
---|
313 | write !,NumProcessed," tickler message file entries processed.",!
|
---|
314 | if NumProcessed>0 write numErrors," errors encountered.",!
|
---|
315 | write "Goodbye",!
|
---|
316 | quit
|
---|
317 |
|
---|
318 |
|
---|
319 | REDATE ;"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 |
|
---|
354 | REDDONE
|
---|
355 | write !,NumProcessed," tickler message file entries processed.",!
|
---|
356 | if NumProcessed>0 write numErrors," errors encountered.",!
|
---|
357 | write "Goodbye",!
|
---|
358 | quit |
---|