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

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

replacing soft links with actual files
File size: 26.1 KB
Line 
1TMGTICKL ;TMG/kst-Tickler Text objects for use in CPRS ;08/27/08
2 ;;1.0;TMG-LIB;**1**;08/27/08
3
4 ;"TMG Tickler text object and surrounding support code.
5 ;"
6 ;"These are bits of code that return text to be included in progress notes etc.
7 ;"They are called when the user puts text like this in a note:
8 ;" ... Mrs. Jone's vitals today are |VITALS|, measured in the office...
9 ;" 'VITALS' would be a TIU TEXT OBJECT, managed through menu option TIUFJ CREATE OBJECTS MGR
10
11 ;"---------------------------------------------------------------------------
12 ;"PUBLIC FUNCTIONS
13 ;"---------------------------------------------------------------------------
14 ;"$$TICKLER^TMGTICKL(DFN,.TIU) -- Entry point for TIU Text object caller
15 ;"HANDLE^TMGTICKL -- entry point for Task to handle tickler messages, called at scheduled intervals
16 ;"ERRSHOW^TMGTICKL -- Handle Alerts, showing details about error.
17
18 ;"---------------------------------------------------------------------------
19 ;"PRIVATE FUNCTIONS
20 ;"---------------------------------------------------------------------------
21 ;"$$HasTickler(DocIEN,DateStr) -- return if TIU DOCUMENT contains the signals for a TICKLER message.
22 ;"SendAddendum(DocIEN,AuthorIEN,TklIEN,TMGWP) -- place an addendum to the specified note with message
23 ;"SendErrAddendum(DocIEN,TklIEN,TMGMSG) -- send an addendum to note showing database error.
24 ;"SendAlert(UserIEN,TklIEN,Msg,TMGMSG) -- send a message alert to the user (for error reporting)
25 ;"RescheduleTask -- reschedule task for handling the next cycle of tickler messages.
26 ;"PressToCont -- provide a 'press key to continue' action
27 ;"GetErrStr(ErrArray) -- convert a standard DIERR array into a string for output
28
29 ;"---------------------------------------------------------------------------
30 ;"---------------------------------------------------------------------------
31
32TICKLER(DFN)
33 ;"Purpose: A call point for TIU objects, to launch a tickler for the given note.
34 ;"Input: DFN -- the patient's unique ID (record#)
35 ;"Result: returns text that will be put into the note in CPRS
36
37 new result
38
39 set DFN=+$get(DFN)
40 if DFN=0 do goto TKDone
41 . set result="ERROR: DFN not defined. Contact IT support (Source: TMGTICKL.m)"
42
43 set result=""
44 set result=result_" ======= [TICKLER MESSGE] ======="_$CHAR(13)_$CHAR(10)
45 set result=result_" #DUE#: Put-DUE-DATE-here "_$CHAR(13)_$CHAR(10)
46 set result=result_" ================================"_$CHAR(13)_$CHAR(10)
47 set result=result_" Message: ... "_$CHAR(13)_$CHAR(10)
48 set result=result_" "_$CHAR(13)_$CHAR(10)
49 set result=result_" ================================"_$CHAR(13)_$CHAR(10)
50 set result=result_$CHAR(13)_$CHAR(10)
51
52 ;"Create an entry in TMG TICKLER file, for later processing.
53 ;"Processing will need to wait until after document is signed, so that due date is fixed.
54 new TMGFDA,TMGMSG,TMGIEN
55 set TMGFDA(22705.5,"+1,",.01)=DFN ;"IEN in PATIENT file
56 set TMGFDA(22705.5,"+1,",2)="U" ;"U=Unsigned
57 set TMGFDA(22705.5,"+1,",3)=DUZ ;"Current user
58
59 do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
60 if $data(TMGMSG("DIERR")) do goto TKDone
61 . set result="ERROR: Fileman error creating Tickler Message. Contact IT support (Source: TMGTICKL.m)"
62 . set result=result_$$GetErrStr(.TMGMSG)
63
64TKDone quit result
65
66
67HANDLE
68 ;"Purpose: An entry point for Taskman Task to handle tickler messages
69 ;" This will be called at scheduled intervals
70
71 do RescheduleTask
72
73 new X,%,TMGFDA,TMGMSG
74 do NOW^%DTC ;"get current time into %
75 set TMGFDA(22705.4,"1,",3)=%
76 do FILE^DIE("","TMGFDA","TMGMSG") ;"set time of last scan in 22705.4
77
78 new DIC,Y
79 set DIC=8925.6 ;"TIU STATUS file
80 set X="COMPLETED"
81 DO ^DIC
82 new StatusIEN set StatusIEN=+Y
83 if StatusIEN'>0 do goto HandlDone
84 . do SendAlert(DUZ,0,"Tickler Error: Can't find IEN for 'COMPLETED' status")
85
86 ;"For each TMG TICKLER entry that is UNSIGNED, and missing a DOCUMENT
87 ;"pointer, a scan of all a patient's documents is carried out, looking
88 ;"for one with a Tickler Message that has not already been noted. When
89 ;"found, the DOCUMENT pointer is stored. Search is by date, in
90 ;"reverse chronological order (most recent first).
91 new TklIEN set TklIEN=0
92 for set TklIEN=$order(^TMG(22705.5,"S","U",TklIEN)) quit:(+TklIEN'>0) do
93 . new found set found=0
94 . new DocIEN set DocIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",4)
95 . if DocIEN>0 quit ;"Document for this Tickler already found, so don't search again. SHOULDN'T EVER HAPPEN
96 . new PtIEN set PtIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",1)
97 . new UserIEN set UserIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",5)
98 . new DateStr set DateStr=""
99 . new DocClIEN set DocClIEN=0
100 . ;"Note: ADCPT xref --> Patient,Doc CLASS,Status,InverseRefDate,DocIEN
101 . for set DocClIEN=$order(^TIU(8925,"ADCPT",PtIEN,DocClIEN)) quit:(+DocClIEN'>0)!found do
102 . . new RefDate set RefDate=""
103 . . for set RefDate=$order(^TIU(8925,"ADCPT",PtIEN,DocClIEN,StatusIEN,RefDate)) quit:(RefDate="")!found do
104 . . . set DocIEN=""
105 . . . for set DocIEN=$order(^TIU(8925,"ADCPT",PtIEN,DocClIEN,StatusIEN,RefDate,DocIEN)) quit:(+DocIEN'>0)!found do
106 . . . . ;"DocIEN should be a COMPLETED document for patient
107 . . . . if $data(^TMG(22705.5,"C",DocIEN)) quit ;"document already linked by another tickler
108 . . . . if $$HasTickler(DocIEN,.DateStr)=0 quit
109 . . . . set found=1
110 . . . . new TMGFDA,TMGMSG
111 . . . . set TMGFDA(22705.5,TklIEN_",",.05)="`"_DocIEN
112 . . . . set TMGFDA(22705.5,TklIEN_",",2)="S" ;"S=SIGNED
113 . . . . set TMGFDA(22705.5,TklIEN_",",1)=DateStr
114 . . . . do FILE^DIE("E","TMGFDA","TMGMSG")
115 . . . . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here...
116 . . . . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG)
117 . if found=0 do ;"no match COMPLETED document found for TICKLER entry
118 . . ;"Check if patient has any non-COMPLETED documents, if so, wait longer
119 . . set DocIEN=""
120 . . for set DocIEN=$order(^TIU(8925,"C",PtIEN,DocIEN)) quit:(+DocIEN'>0)!found do
121 . . . set found=(+$piece($get(^TIU(8925,DocIEN,0)),"^",5)=StatusIEN)
122 . . if found=0 do ;"TICKLER entry doesn't refer to any real message (must have been deleted in CPRS)
123 . . . new TMGFDA,TMGMSG
124 . . . set TMGFDA(22705.5,TklIEN_",",2)="O" ;"O=ORPHANED
125 . . . do FILE^DIE("E","TMGFDA","TMGMSG")
126 . . . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here...
127 . . . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG)
128
129 ;"Scan all TMG TICKLER entries that have a status of SIGNED,
130 ;"and if the due date has arrived,then process. Change status to COMPLETED, and
131 ;"create an new document that is an ADDENDUM to the document.
132 ;"Send message 'Your message is now due' etc...
133 ;"ADDENDUM: I changed the external text of status (S)/SIGNED to be 'PENDING' for user clarity
134 set TklIEN=0
135 for set TklIEN=$order(^TMG(22705.5,"S","S",TklIEN)) quit:(+TklIEN'>0) do
136 . new DocIEN set DocIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",4)
137 . new AuthorIEN set AuthorIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",5) ;"0;5 = USER
138 . new X,X1,X2,%,%Y,DueDateT,NowDateT
139 . set (X1,DueDateT)=$piece(^TMG(22705.5,TklIEN,0),"^",2) ;" 0;2 = DUE DATE, Field 1
140 . do NOW^%DTC set (X2,NowDateT)=%
141 . do ^%DTC ;"returns X=X1-X2 (ie X=DUE-NOW); If %Y=, dates were imprecise and unworkable.
142 . if %Y=0 do quit
143 . . if DocIEN'>0 set X=0 quit ;"Bigger problem exists, will be reported below.
144 . . set s(1)="**Error Processing Dates for Tickler Message**"
145 . . set s(2)="(This note may be edited or deleted--until signed.)"
146 . . set s(3)="Date found was imprecise and unworkable, or '#DUE#:' text was not found."
147 . . set s(4)="TO FIX: Please create an addendum to the original note and add a NEW TICKLER message."
148 . . do SendAddendum(DocIEN,AuthorIEN,TklIEN,.s)
149 . . ;"If we don't specified the tickler to be Completed, the error will be sent repeatedly
150 . . new TMGFDA,TMGMSG
151 . . set TMGFDA(22705.5,TklIEN_",",2)="C" ;"C=COMPLETED
152 . . do FILE^DIE("","TMGFDA","TMGMSG")
153 . . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here...
154 . . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG)
155 . if X'<1 quit ;"Tickler not yet due, so wait longer.
156 . new waitMore set waitMore=0
157 . if X=0 do quit:waitMore=1
158 . . new dueTime set dueTime=$$LJ^XLFSTR($piece(DueDateT,".",2),6,"0")
159 . . new nowTime set nowTime=$$LJ^XLFSTR($piece(NowDateT,".",2),6,"0")
160 . . if dueTime>nowTime set waitMore=1
161 . ;"Success! Tickler is due. Send addendum
162 . if DocIEN=0 do quit
163 . . do SendAlert(AuthorIEN,TklIEN,"Can't find Document for Tickler record. (Shouldn't happen). Check TMGTICKL.m")
164 . new s
165 . set s(1)=" "
166 . set s(2)=" * * Tickler message due date has arrived * * "
167 . set s(3)="================================================"
168 . set s(4)=" This note may be edited if needed until signed"
169 . set s(5)=" "
170 . set s(6)=" Please note original tickler message."
171 . set s(7)=" "
172 . do SendAddendum(DocIEN,AuthorIEN,TklIEN,.s)
173 . new TMGFDA,TMGMSG
174 . set TMGFDA(22705.5,TklIEN_",",2)="C" ;"C=COMPLETED
175 . do FILE^DIE("","TMGFDA","TMGMSG")
176 . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here...
177 . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG)
178
179HandlDone
180 set ZTREQ="@" ;"delete completed task.
181 quit
182
183
184HasTickler(DocIEN,DateStr)
185 ;"Purpose: To determine if the REPORT TEXT for the TIU DOCUMENT (DocIEN) WP field
186 ;" contains the string that signals a TICKLER message.
187 ;" Notice: The string matched here *same* string as is found in TICKLER()
188 ;"Input: DocIEN -- IEN in 8925
189 ;" DateStr -- PASS BY REFERENCE, an OUT PARAMETER
190 ;" Returns Due Date *String* from '#DUE#: <Place-Due-Date-Here>
191 ;" on line AFTER [TICKLER MESSAGE]
192 ;"Result: 1 if found, 0 if not.
193
194 set DateStr=""
195 new isHTML set isHTML=$$IsHTML^TMGSTUTL(DocIEN)
196 new found,line set (found,line)=0
197 for set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!found do
198 . set found=($get(^TIU(8925,DocIEN,"TEXT",line,0))["[TICKLER MESSGE]")
199 . new done set done=0
200 . if found for set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!done do
201 . . if $get(^TIU(8925,DocIEN,"TEXT",line,0))'["#DUE#:" quit
202 . . set done=1
203 . . set DateStr=$piece(^TIU(8925,DocIEN,"TEXT",line,0),"#DUE#:",2)
204 . . if isHTML set DateStr=$$TrimTags^TMGSTUTL(DateStr)
205 . . set DateStr=$$TRIM^XLFSTR(DateStr)
206 . . ;"new ch for set ch=$extract(DateStr,1) quit:(ch'=" ") do ;"trim off leading spaces
207 . . ;". set DateStr=$extract(DateStr,2,200)
208 . . ;"for quit:(DateStr'["@ ") do ;"handle 'mm/dd/yy @ time' format (i.e. spaces after @)
209 . . ;". new spec set spec("@ ")="@"
210 . . ;". set DateStr=$$REPLACE^XLFSTR(DateStr,.spec)
211 . . new %DT,X,Y
212 . . set X=DateStr,%DT="TF" ;"assume future dates, and time is allowed.
213 . . do ^%DT ;"returns Y=-1, or Y=fileman date format.
214 . . if Y>-1 do
215 . . . do DD^%DT
216 . . . set DateStr=Y ;"This should be a standardized date.
217
218 quit found
219
220
221SendAddendum(DocIEN,AuthorIEN,TklIEN,TMGWP)
222 ;"Purpose: To place an addendum to the specified note (or the note's parent if
223 ;" the note is itself already an addendum.
224 ;"Input: DocIEN -- IEN in 8925
225 ;" AuthorIEN -- IEN in 200 of author
226 ;" TklIEN -- Tickler IEN 22705.5
227 ;" TMGWP --PASS BY REFERENCE. message to put in addendum.
228 ;" e.g. TMGWP(1)="First line of text."
229 ;" TMGWP(2)="Second line of text."
230 ;"Result: 1 if successful, 0 if error. <--- NO. No result returned.
231
232 new result set result=1 ;"default to success.
233
234 new parentIEN set parentIEN=+$piece($get(^TIU(8925,DocIEN,0)),"^",6) ;"0;6= FIELD .06, PARENT
235 if parentIEN>0 set DocIEN=parentIEN
236 new PtIEN set PtIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",1)
237 new visitIEN set visitIEN=+$piece($get(^TIU(8925,DocIEN,0)),"^",3)
238 new locIEN set locIEN=+$piece($get(^TIU(8925,DocIEN,12)),"^",11)
239 new HlocIEN set HlocIEN=+$piece($get(^TIU(8925,DocIEN,12)),"^",5)
240 new divIEN set divIEN=+$piece($get(^TIU(8925,DocIEN,12)),"^",12)
241 new serviceIEN set serviceIEN=+$piece($get(^TIU(8925,DocIEN,14)),"^",4)
242
243 new DIC,X,Y
244 set DIC=8925.1
245 set DIC("S")="I $P(^(0),U,4)=""DOC""" ;"screen for Type=Title
246 set X="ADDENDUM"
247 do ^DIC
248 if +Y'>0 do goto SendADone
249 . set result=0
250 . do SendAlert(AuthorIEN,TklIEN,"Unable to find ADDENDUM Title for Tickler Note")
251 new docTypeIEN set docTypeIEN=+Y
252
253 set DIC("S")="I $P(^(0),U,4)=""DC""" ;"screen for Type=Class
254 set X="ADDENDUM"
255 do ^DIC
256 if +Y'>0 do goto SendADone
257 . set result=0
258 . do SendAlert(AuthorIEN,TklIEN,"Unable to find ADDENDUM class for Tickler Note")
259 new DocClassIEN set DocClassIEN=+Y
260
261 new TMGFDA,TMGMSG,TMGIEN
262 set TMGFDA(8925,"+1,",.01)="`"_docTypeIEN ;".01 = DOCUMENT TYPE
263 set TMGFDA(8925,"+1,",.02)="`"_PtIEN ;".02 = PATIENT
264 set TMGFDA(8925,"+1,",.03)="`"_visitIEN ;".03 = VISIT
265 set TMGFDA(8925,"+1,",.04)="`"_DocClassIEN;".04 = PARENT DOCUMENT TYPE
266 set TMGFDA(8925,"+1,",.05)="UNSIGNED" ;".05 = STATUS
267 set TMGFDA(8925,"+1,",.06)="`"_DocIEN ;".06 = PARENT
268 set TMGFDA(8925,"+1,",.07)="NOW" ;".07 = EPISODE BEGIN DATE/TIME
269 set TMGFDA(8925,"+1,",.13)="A" ;".13 = VISIT TYPE
270 set TMGFDA(8925,"+1,",1201)="NOW" ;"1201 = ENTRY DATE/TIME
271 set TMGFDA(8925,"+1,",1202)="`"_AuthorIEN ;"1202 = AUTHOR/DICTATOR
272 set TMGFDA(8925,"+1,",1204)="`"_AuthorIEN ;"1204 = EXPECTED SIGNER
273 set TMGFDA(8925,"+1,",1205)="`"_HlocIEN ;"1205 = HOSPITAL LOCATION
274 set TMGFDA(8925,"+1,",1211)="`"_locIEN ;"1211 = VISIT LOCATION
275 set TMGFDA(8925,"+1,",1212)="`"_divIEN ;"1212 = DIVISION
276 set TMGFDA(8925,"+1,",1301)="NOW" ;"1301 = REFERENCE DATE
277 set TMGFDA(8925,"+1,",1302)="`"_AuthorIEN ;"1302 = ENTERED BY
278 set TMGFDA(8925,"+1,",1303)="direct" ;"1303 = CAPTURE METHOD
279 set TMGFDA(8925,"+1,",1404)="`"_serviceIEN;"1404 = SERVICE
280 set TMGFDA(8925,"+1,",1506)="NO" ;"1506 = COSIGNATURE NEEDED
281
282 do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG")
283
284 if $data(TMGMSG("DIERR")) do goto SendADone
285 . set result=0
286 . do SendAlert(AuthorIEN,TklIEN,"Error creating Tickler addendum.",.TMGMSG)
287
288 new newDocIEN set newDocIEN=TMGIEN(1)
289 Do SEND^TIUALRT(newDocIEN) ;"create alert regarding note needing to be signed.
290
291 kill TMGMSG
292 do WP^DIE(8925,newDocIEN_",",2,"","TMGWP","TMGMSG")
293
294 if $data(TMGMSG("DIERR")) do goto SendADone
295 . set result=0
296 . do SendAlert(AuthorIEN,TklIEN,"Error filing message into Tickler addendum.",.TMGMSG)
297
298SendADone
299 ;"quit result
300 quit
301
302
303SendErrAddendum(DocIEN,TklIEN,TMGMSG)
304 ;"Purpose: to send an addendum to note showing database error.
305 ;"Input: DocIEN: the document that should have the addendum added.
306 ;" TklIEN: the IEN of the tickler record
307 ;" TMGMSG: PASS BY REFERENCE. The error array, as returned by fileman.
308 ;"result: none.
309
310 new ErrStr
311 set ErrStr(1)="Database error encountered handling tickler message."
312 set ErrStr(2)="Note: This may be deleted..."
313 set ErrStr(3)=$$GetErrStr(.TMGMSG)
314 new AuthorIEN set AuthorIEN=$piece($get(^TMG(22705.5,TklIEN,0)),"^",5)
315 do SendAddendum(DocIEN,AuthorIEN,TklIEN,.ErrStr)
316 quit
317
318
319SendAlert(UserIEN,TklIEN,Msg,TMGMSG)
320 ;"Purpose: to send a message alert to the user (for error reporting)
321 ;"Input: UserIEN -- IEN in 200, the target of the message
322 ;" TklIEN -- the IEN of the tickler message
323 ;" Msg -- the message to send. **ONLY UP TO 80 characters**
324 ;" No ^ allowed in the message!
325 ;" TMGMSG -- OPTIONAL, PASS BY REFERENCE.
326 ;" An error array as created by Fileman.
327 ;"results: none
328
329 ;"initialize vars for alert code
330 new XQA,XQAARCH,XQADATA,XQAFLG,XQAGUID,XQAID,XQAMSG
331 new XQAOPT,XQAROU,XQASUPV,XQASURO,XQATEXT
332
333 set XQADATA=TklIEN_"^"_Msg
334 if $data(TMGMSG) set XQADATA=XQADATA_"^"_$$GetErrStr(.TMGMSG)
335 set XQA(UserIEN)=""
336 set XQAMSG=Msg
337 set XQAROU="ERRSHOW^TMGTICKL"
338
339 do SETUP^XQALERT ;"send the alert
340
341 quit
342
343ERRSHOW
344 ;"Purpose: To show details about error.
345 ;"Input: Global-scoped variable XQADATA will hold TklIEN^Msg^FMErrStr
346 ;" Note: TklIEN could be 0
347 ;"Results: none
348
349 write !,!
350 write "Notice: There was an error processing a tickler message.",!
351 write "This notice is to provide as much detail as is possible,",!
352 write "so that the tickler message does not get lost.",!,!
353
354 new TklIEN,Msg,FMErrStr
355
356 if $data(XQADATA)=0 do goto ErShDone
357 . write "But XQADATA doesn't hold info(??). Aborting.",!
358 . do PressToCont
359
360 set TklIEN=+$piece(XQADATA,"^",1)
361 set Msg=$piece(XQADATA,"^",2)
362 set FMErrStr=$piece(XQADATA,"^",3)
363
364 write "The error message was:",!
365 write Msg,!
366 do PressToCont
367
368 if TklIEN>0 do
369 . write !
370 . write "PATIENT:",$$GET1^DIQ(22705.5,TklIEN,.01),!
371 . write "DOCUMENT:",$$GET1^DIQ(22705.5,TklIEN,.05)," (#",$$GET1^DIQ(22705.5,TklIEN,.05,"I"),")",!
372 . write "DUE DATE:",$$GET1^DIQ(22705.5,TklIEN,1),!
373 . write "AUTHOR:",$$GET1^DIQ(22705.5,TklIEN,3),!
374 . write "AUTHOR:",$$GET1^DIQ(22705.5,TklIEN,3),!
375 . write "TICKLER STATUS:",$$GET1^DIQ(22705.5,TklIEN,2),!
376 . write "1st LINE OF MESSAGE:",$$GET1^DIQ(22705.5,TklIEN,5),!
377 . do PressToCont
378
379 if FMErrStr'="" do
380 . write !,"The Fileman (database) error message was:",!
381 . write FMErrStr,!
382 . do PressToCont
383
384 write !,!
385 write "Hopefully this will be enough information for you",!
386 write "to fix the tickler message.",!
387 write "Please follow up on this NOW....",!
388 write "This will be the *only* reminder!",!!
389 do PressToCont
390
391ErShDone
392 quit
393
394
395RescheduleTask
396 ;"Purpose: to set up task to periodically handle tickler messages.
397 ;"Result: None
398
399 new temp set temp=1
400 if temp=0 quit ;"a debugging measure so that launching a duplicate task can be avoided
401
402 new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU
403 new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
404
405 set ZTRTN="HANDLE^TMGTICKL"
406 set ZTDESC="TMG TICKLER MESSAGES HANDLER"
407 set ZTIO=""
408
409 new hrInterval set hrInterval=+$piece($get(^TMG(22705.4,1,0)),"^",2) ;"0;2=Interval
410 if hrInterval<1 do goto SchTDone
411 . do SendAlert(DUZ,0,"Tickler Error: Interval (field #1) in file 22705.4 < 1 hr")
412 . set ZTSK=0
413
414 new X,Y,%,%DT
415 set %DT="XR" set X="NOW+"_hrInterval_"H" do ^%DT
416 set ZTDTH=Y ;"schedule time.
417
418 do ^%ZTLOAD
419SchTDone
420 set $piece(^TMG(22705.4,1,0),"^",3)=ZTSK ;"there are no XRefs on this field, and I own it...
421 quit
422
423
424CHECKRUN
425 ;"Purpose: To check that the background processor for the Tickler is running.
426 ;" If not running, give user a chance to start it.
427 ;"Input: None
428 ;"Results: None.
429
430 do KillOldTasks
431 new Status
432CR1 set Status=$$TaskStatus(0)
433 if +Status=1 do goto CRDN
434 . write !,"SUCCESS! The TICKLER MESSAGES task is running.",!
435 . write "Details:",!
436 . write " Task#: ",$piece(Status,"^",3),!
437 . write " Scheduled to run next: ",$$HTE^XLFDT($piece(Status,"^",4)),!
438 . do PressToCont^TMGUSRIF
439 write "There is a problem. Task is NOT running.",!
440 new prob set prob=$piece(Status,"^",2)
441 if prob'="" write "Problem: ",prob,!
442 new % set %=1
443 write "Try to launch task now" DO YN^DICN write !
444 if %=1 do goto CR1
445 . do RescheduleTask
446
447CRDN quit
448
449TaskStatus(Verbose)
450 ;"Purpose: To determine the status of the Tickler background task.
451 ;"Input: Verbose : OPTIONAL. If 1 then output shown. 0 (default) is quiet.
452 ;"Output: 1^Active^TaskNumber^NextRun($H), or -1^Message
453
454 new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU
455 new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
456
457 set ZTDESC="TMG TICKLER MESSAGES HANDLER"
458 set ZTIO=""
459
460 set Verbose=+$get(Verbose)
461 new Result set Result="-1^No Task Found" ;"default to error
462 new NextRun set NextRun=""
463
464 if $$TM^%ZTLOAD=0 do goto TSDone
465 . set Result="-1^Taskman not running on current volume set"
466
467 new TMGLIST,TSK
468 do DESC^%ZTLOAD(ZTDESC,"TMGLIST")
469 new done set done=0
470 set TSK=0
471 for set TSK=$ORDER(TMGLIST(TSK)) quit:(TSK="")!done do
472 . new ZTSK set ZTSK=TSK
473 . do ISQED^%ZTLOAD
474 . if Verbose write "Task ",ZTSK,": "
475 . set ZTSK(0)=$GET(ZTSK(0))
476 . if ZTSK(0)=1 if Verbose write "Pending/Waiting",!
477 . else if ZTSK(0)=0 do
478 . . if Verbose write "Done",! ;"Not Pending/Waiting",!
479 . else if ZTSK(0)="" do
480 . . if Verbose write "Lookup error.",!
481 . if $data(ZTSK("E")) do
482 . . if 'Verbose quit
483 . . if $GET(ZTSK("E"))="IT" write " The task number was not valid (0, negative, or non numeric).",! quit
484 . . if $GET(ZTSK("E"))="I" write " The task does not exist on the specified volume set.",! quit
485 . . if $GET(ZTSK("E"))="IS" write " The task set is not listed in the VOLUME SET file (#14.5).",! quit
486 . . if $GET(ZTSK("E"))="LS" write " The link to that volume set is not available.",! quit
487 . . if $GET(ZTSK("E"))="U" write " An unexpected error arose (e.g., disk full, protection, etc.).",!
488 . if $data(ZTSK("D")) do
489 . . set NextRun=$get(ZTSK("D"))
490 . . if 'Verbose quit
491 . . write " Task scheduled to start: ",$$HTE^XLFDT($GET(ZTSK("D"))),!
492 . kill ZTSK set ZTSK=TSK
493 . do STAT^%ZTLOAD
494 . if ZTSK(0)=0 do quit
495 . . if 'Verbose quit
496 . . write "?? task undefined??"
497 . set ZTSK(1)=$get(ZTSK(1))
498 . if Verbose write " Status: ",ZTSK(1)," ",ZTSK(2),!
499 . if (ZTSK(1)=1)&(ZTSK(2)="Active: Pending") do quit
500 . . set done=1
501 . . set Result="1^Active^"_TSK_"^"_NextRun
502 .
503TSDone quit Result
504
505
506KillOldTasks
507 ;"Purpose: To clear out old, completed tasks
508 ;"Input: none
509 ;"Output:
510
511 new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU
512 new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
513 new TMGLIST,TSK
514 set ZTDESC="TMG TICKLER MESSAGES HANDLER"
515 do DESC^%ZTLOAD(ZTDESC,"TMGLIST")
516 set TSK=0
517 for set TSK=$ORDER(TMGLIST(TSK)) quit:(TSK="") do
518 . new ZTSK set ZTSK=TSK
519 . do ISQED^%ZTLOAD
520 . set ZTSK(0)=$GET(ZTSK(0))
521 . if $data(ZTSK("E")) do quit
522 . . write "Task ",ZTSK,": ",$GET(ZTSK("E")),!
523 . if ZTSK(0)="" write "Lookup error for task: ",TSK,! quit
524 . if ZTSK(0)'=0 quit
525 . kill ZTSK set ZTSK=TSK
526 . do STAT^%ZTLOAD
527 . if ZTSK(0)=0 write "Task ",ZTSK,": ?? task undefined??" quit
528 . if ($GET(ZTSK(1))=3)&($GET(ZTSK(2))="Inactive: Finished") do
529 . . do KILL^%ZTLOAD
530 quit
531
532;"===========================================================================
533;"Below are copies of functions from TMG Libarary, put here to avoid dependancies
534;"===========================================================================
535
536PressToCont
537 ;"Purpose: to provide a 'press key to continue' action
538
539 write "----- Press Key To Continue -----"
540 new ch read ch:$get(DTIME,3600)
541 write !
542 quit
543
544
545GetErrStr(ErrArray)
546 ;"Purpose: convert a standard DIERR array into a string for output
547 ;"Input: ErrArray -- PASS BY REFERENCE. example:
548 ;" array("DIERR")="1^1"
549 ;" array("DIERR",1)=311
550 ;" array("DIERR",1,"PARAM",0)=3
551 ;" array("DIERR",1,"PARAM","FIELD")=.02
552 ;" array("DIERR",1,"PARAM","FILE")=2
553 ;" array("DIERR",1,"PARAM","IENS")="+1,"
554 ;" array("DIERR",1,"TEXT",1)="The new record '+1,' lacks some required identifiers."
555 ;" array("DIERR","E",311,1)=""
556 ;"Results: returns one long equivalent string from above array.
557 ;"Note: This is a copy of the function GetErrStr^TMGDEBUG
558 ;" I copied it here so that this file has no TMG* dependencies.
559
560 new ErrStr
561 new TMGIDX
562 new ErrNum
563
564 set ErrStr=""
565 for ErrNum=1:1:+$get(ErrArray("DIERR")) do
566 . set ErrStr=ErrStr_"Fileman says: '"
567 . if ErrNum'=1 set ErrStr=ErrStr_"(Error# "_ErrNum_") "
568 . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT",""))
569 . if TMGIDX'="" for do quit:(TMGIDX="")
570 . . set ErrStr=ErrStr_$get(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX))_" "
571 . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX))
572 . if $get(ErrArray("DIERR",ErrNum,"PARAM",0))>0 do
573 . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",0))
574 . . set ErrStr=ErrStr_"Details: "
575 . . for do quit:(TMGIDX="")
576 . . . if TMGIDX="" quit
577 . . . set ErrStr=ErrStr_"["_TMGIDX_"]="_$get(ErrArray("DIERR",1,"PARAM",TMGIDX))_" "
578 . . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",TMGIDX))
579
580 quit ErrStr
581
Note: See TracBrowser for help on using the repository browser.