TMGTICKL ;TMG/kst-Tickler Text objects for use in CPRS ;08/27/08 ;;1.0;TMG-LIB;**1**;08/27/08 ;"TMG Tickler text object and surrounding support code. ;" ;"These are bits of code that return text to be included in progress notes etc. ;"They are called when the user puts text like this in a note: ;" ... Mrs. Jone's vitals today are |VITALS|, measured in the office... ;" 'VITALS' would be a TIU TEXT OBJECT, managed through menu option TIUFJ CREATE OBJECTS MGR ;"--------------------------------------------------------------------------- ;"PUBLIC FUNCTIONS ;"--------------------------------------------------------------------------- ;"$$TICKLER^TMGTICKL(DFN,.TIU) -- Entry point for TIU Text object caller ;"HANDLE^TMGTICKL -- entry point for Task to handle tickler messages, called at scheduled intervals ;"ERRSHOW^TMGTICKL -- Handle Alerts, showing details about error. ;"--------------------------------------------------------------------------- ;"PRIVATE FUNCTIONS ;"--------------------------------------------------------------------------- ;"$$HasTickler(DocIEN,DateStr) -- return if TIU DOCUMENT contains the signals for a TICKLER message. ;"SendAddendum(DocIEN,AuthorIEN,TklIEN,TMGWP) -- place an addendum to the specified note with message ;"SendErrAddendum(DocIEN,TklIEN,TMGMSG) -- send an addendum to note showing database error. ;"SendAlert(UserIEN,TklIEN,Msg,TMGMSG) -- send a message alert to the user (for error reporting) ;"RescheduleTask -- reschedule task for handling the next cycle of tickler messages. ;"PressToCont -- provide a 'press key to continue' action ;"GetErrStr(ErrArray) -- convert a standard DIERR array into a string for output ;"--------------------------------------------------------------------------- ;"--------------------------------------------------------------------------- TICKLER(DFN) ;"Purpose: A call point for TIU objects, to launch a tickler for the given note. ;"Input: DFN -- the patient's unique ID (record#) ;"Result: returns text that will be put into the note in CPRS new result set DFN=+$get(DFN) if DFN=0 do goto TKDone . set result="ERROR: DFN not defined. Contact IT support (Source: TMGTICKL.m)" set result="" set result=result_" ======= [TICKLER MESSGE] ======="_$CHAR(13)_$CHAR(10) set result=result_" #DUE#: Put-DUE-DATE-here "_$CHAR(13)_$CHAR(10) set result=result_" ================================"_$CHAR(13)_$CHAR(10) set result=result_" Message: ... "_$CHAR(13)_$CHAR(10) set result=result_" "_$CHAR(13)_$CHAR(10) set result=result_" ================================"_$CHAR(13)_$CHAR(10) set result=result_$CHAR(13)_$CHAR(10) ;"Create an entry in TMG TICKLER file, for later processing. ;"Processing will need to wait until after document is signed, so that due date is fixed. new TMGFDA,TMGMSG,TMGIEN set TMGFDA(22705.5,"+1,",.01)=DFN ;"IEN in PATIENT file set TMGFDA(22705.5,"+1,",2)="U" ;"U=Unsigned set TMGFDA(22705.5,"+1,",3)=DUZ ;"Current user do UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") if $data(TMGMSG("DIERR")) do goto TKDone . set result="ERROR: Fileman error creating Tickler Message. Contact IT support (Source: TMGTICKL.m)" . set result=result_$$GetErrStr(.TMGMSG) TKDone quit result HANDLE ;"Purpose: An entry point for Taskman Task to handle tickler messages ;" This will be called at scheduled intervals do RescheduleTask new X,%,TMGFDA,TMGMSG do NOW^%DTC ;"get current time into % set TMGFDA(22705.4,"1,",3)=% do FILE^DIE("","TMGFDA","TMGMSG") ;"set time of last scan in 22705.4 new DIC,Y set DIC=8925.6 ;"TIU STATUS file set X="COMPLETED" DO ^DIC new StatusIEN set StatusIEN=+Y if StatusIEN'>0 do goto HandlDone . do SendAlert(DUZ,0,"Tickler Error: Can't find IEN for 'COMPLETED' status") ;"For each TMG TICKLER entry that is UNSIGNED, and missing a DOCUMENT ;"pointer, a scan of all a patient's documents is carried out, looking ;"for one with a Tickler Message that has not already been noted. When ;"found, the DOCUMENT pointer is stored. Search is by date, in ;"reverse chronological order (most recent first). new TklIEN set TklIEN=0 for set TklIEN=$order(^TMG(22705.5,"S","U",TklIEN)) quit:(+TklIEN'>0) do . new found set found=0 . new DocIEN set DocIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",4) . if DocIEN>0 quit ;"Document for this Tickler already found, so don't search again. SHOULDN'T EVER HAPPEN . new PtIEN set PtIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",1) . new UserIEN set UserIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",5) . new DateStr set DateStr="" . new DocClIEN set DocClIEN=0 . ;"Note: ADCPT xref --> Patient,Doc CLASS,Status,InverseRefDate,DocIEN . for set DocClIEN=$order(^TIU(8925,"ADCPT",PtIEN,DocClIEN)) quit:(+DocClIEN'>0)!found do . . new RefDate set RefDate="" . . for set RefDate=$order(^TIU(8925,"ADCPT",PtIEN,DocClIEN,StatusIEN,RefDate)) quit:(RefDate="")!found do . . . set DocIEN="" . . . for set DocIEN=$order(^TIU(8925,"ADCPT",PtIEN,DocClIEN,StatusIEN,RefDate,DocIEN)) quit:(+DocIEN'>0)!found do . . . . ;"DocIEN should be a COMPLETED document for patient . . . . if $data(^TMG(22705.5,"C",DocIEN)) quit ;"document already linked by another tickler . . . . if $$HasTickler(DocIEN,.DateStr)=0 quit . . . . set found=1 . . . . new TMGFDA,TMGMSG . . . . set TMGFDA(22705.5,TklIEN_",",.05)="`"_DocIEN . . . . set TMGFDA(22705.5,TklIEN_",",2)="S" ;"S=SIGNED . . . . set TMGFDA(22705.5,TklIEN_",",1)=DateStr . . . . do FILE^DIE("E","TMGFDA","TMGMSG") . . . . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here... . . . . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG) . if found=0 do ;"no match COMPLETED document found for TICKLER entry . . ;"Check if patient has any non-COMPLETED documents, if so, wait longer . . set DocIEN="" . . for set DocIEN=$order(^TIU(8925,"C",PtIEN,DocIEN)) quit:(+DocIEN'>0)!found do . . . set found=(+$piece($get(^TIU(8925,DocIEN,0)),"^",5)=StatusIEN) . . if found=0 do ;"TICKLER entry doesn't refer to any real message (must have been deleted in CPRS) . . . new TMGFDA,TMGMSG . . . set TMGFDA(22705.5,TklIEN_",",2)="O" ;"O=ORPHANED . . . do FILE^DIE("E","TMGFDA","TMGMSG") . . . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here... . . . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG) ;"Scan all TMG TICKLER entries that have a status of SIGNED, ;"and if the due date has arrived,then process. Change status to COMPLETED, and ;"create an new document that is an ADDENDUM to the document. ;"Send message 'Your message is now due' etc... ;"ADDENDUM: I changed the external text of status (S)/SIGNED to be 'PENDING' for user clarity set TklIEN=0 for set TklIEN=$order(^TMG(22705.5,"S","S",TklIEN)) quit:(+TklIEN'>0) do . new DocIEN set DocIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",4) . new AuthorIEN set AuthorIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",5) ;"0;5 = USER . new X,X1,X2,%,%Y,DueDateT,NowDateT . set (X1,DueDateT)=$piece(^TMG(22705.5,TklIEN,0),"^",2) ;" 0;2 = DUE DATE, Field 1 . do NOW^%DTC set (X2,NowDateT)=% . do ^%DTC ;"returns X=X1-X2 (ie X=DUE-NOW); If %Y=, dates were imprecise and unworkable. . if %Y=0 do quit . . if DocIEN'>0 set X=0 quit ;"Bigger problem exists, will be reported below. . . set s(1)="**Error Processing Dates for Tickler Message**" . . set s(2)="(This note may be edited or deleted--until signed.)" . . set s(3)="Date found was imprecise and unworkable, or '#DUE#:' text was not found." . . set s(4)="TO FIX: Please create an addendum to the original note and add a NEW TICKLER message." . . do SendAddendum(DocIEN,AuthorIEN,TklIEN,.s) . . ;"If we don't specified the tickler to be Completed, the error will be sent repeatedly . . new TMGFDA,TMGMSG . . set TMGFDA(22705.5,TklIEN_",",2)="C" ;"C=COMPLETED . . do FILE^DIE("","TMGFDA","TMGMSG") . . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here... . . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG) . if X'<1 quit ;"Tickler not yet due, so wait longer. . new waitMore set waitMore=0 . if X=0 do quit:waitMore=1 . . new dueTime set dueTime=$$LJ^XLFSTR($piece(DueDateT,".",2),6,"0") . . new nowTime set nowTime=$$LJ^XLFSTR($piece(NowDateT,".",2),6,"0") . . if dueTime>nowTime set waitMore=1 . ;"Success! Tickler is due. Send addendum . if DocIEN=0 do quit . . do SendAlert(AuthorIEN,TklIEN,"Can't find Document for Tickler record. (Shouldn't happen). Check TMGTICKL.m") . new s . set s(1)=" " . set s(2)=" * * Tickler message due date has arrived * * " . set s(3)="================================================" . set s(4)=" This note may be edited if needed until signed" . set s(5)=" " . set s(6)=" Please note original tickler message." . set s(7)=" " . do SendAddendum(DocIEN,AuthorIEN,TklIEN,.s) . new TMGFDA,TMGMSG . set TMGFDA(22705.5,TklIEN_",",2)="C" ;"C=COMPLETED . do FILE^DIE("","TMGFDA","TMGMSG") . if $data(TMGMSG("DIERR"))=0 quit ;"no errors, so we are done here... . do SendErrAddendum(DocIEN,TklIEN,.TMGMSG) HandlDone set ZTREQ="@" ;"delete completed task. quit HasTickler(DocIEN,DateStr) ;"Purpose: To determine if the REPORT TEXT for the TIU DOCUMENT (DocIEN) WP field ;" contains the string that signals a TICKLER message. ;" Notice: The string matched here *same* string as is found in TICKLER() ;"Input: DocIEN -- IEN in 8925 ;" DateStr -- PASS BY REFERENCE, an OUT PARAMETER ;" Returns Due Date *String* from '#DUE#: ;" on line AFTER [TICKLER MESSAGE] ;"Result: 1 if found, 0 if not. set DateStr="" new isHTML set isHTML=$$IsHTML^TMGSTUTL(DocIEN) new found,line set (found,line)=0 for set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!found do . set found=($get(^TIU(8925,DocIEN,"TEXT",line,0))["[TICKLER MESSGE]") . new done set done=0 . if found for set line=$order(^TIU(8925,DocIEN,"TEXT",line)) quit:(+line'>0)!done do . . if $get(^TIU(8925,DocIEN,"TEXT",line,0))'["#DUE#:" quit . . set done=1 . . set DateStr=$piece(^TIU(8925,DocIEN,"TEXT",line,0),"#DUE#:",2) . . if isHTML set DateStr=$$TrimTags^TMGSTUTL(DateStr) . . set DateStr=$$TRIM^XLFSTR(DateStr) . . ;"new ch for set ch=$extract(DateStr,1) quit:(ch'=" ") do ;"trim off leading spaces . . ;". set DateStr=$extract(DateStr,2,200) . . ;"for quit:(DateStr'["@ ") do ;"handle 'mm/dd/yy @ time' format (i.e. spaces after @) . . ;". new spec set spec("@ ")="@" . . ;". set DateStr=$$REPLACE^XLFSTR(DateStr,.spec) . . new %DT,X,Y . . set X=DateStr,%DT="TF" ;"assume future dates, and time is allowed. . . do ^%DT ;"returns Y=-1, or Y=fileman date format. . . if Y>-1 do . . . do DD^%DT . . . set DateStr=Y ;"This should be a standardized date. quit found SendAddendum(DocIEN,AuthorIEN,TklIEN,TMGWP) ;"Purpose: To place an addendum to the specified note (or the note's parent if ;" the note is itself already an addendum. ;"Input: DocIEN -- IEN in 8925 ;" AuthorIEN -- IEN in 200 of author ;" TklIEN -- Tickler IEN 22705.5 ;" TMGWP --PASS BY REFERENCE. message to put in addendum. ;" e.g. TMGWP(1)="First line of text." ;" TMGWP(2)="Second line of text." ;"Result: 1 if successful, 0 if error. <--- NO. No result returned. new result set result=1 ;"default to success. new parentIEN set parentIEN=+$piece($get(^TIU(8925,DocIEN,0)),"^",6) ;"0;6= FIELD .06, PARENT if parentIEN>0 set DocIEN=parentIEN new PtIEN set PtIEN=+$piece($get(^TMG(22705.5,TklIEN,0)),"^",1) new visitIEN set visitIEN=+$piece($get(^TIU(8925,DocIEN,0)),"^",3) new locIEN set locIEN=+$piece($get(^TIU(8925,DocIEN,12)),"^",11) new HlocIEN set HlocIEN=+$piece($get(^TIU(8925,DocIEN,12)),"^",5) new divIEN set divIEN=+$piece($get(^TIU(8925,DocIEN,12)),"^",12) new serviceIEN set serviceIEN=+$piece($get(^TIU(8925,DocIEN,14)),"^",4) new DIC,X,Y set DIC=8925.1 set DIC("S")="I $P(^(0),U,4)=""DOC""" ;"screen for Type=Title set X="ADDENDUM" do ^DIC if +Y'>0 do goto SendADone . set result=0 . do SendAlert(AuthorIEN,TklIEN,"Unable to find ADDENDUM Title for Tickler Note") new docTypeIEN set docTypeIEN=+Y set DIC("S")="I $P(^(0),U,4)=""DC""" ;"screen for Type=Class set X="ADDENDUM" do ^DIC if +Y'>0 do goto SendADone . set result=0 . do SendAlert(AuthorIEN,TklIEN,"Unable to find ADDENDUM class for Tickler Note") new DocClassIEN set DocClassIEN=+Y new TMGFDA,TMGMSG,TMGIEN set TMGFDA(8925,"+1,",.01)="`"_docTypeIEN ;".01 = DOCUMENT TYPE set TMGFDA(8925,"+1,",.02)="`"_PtIEN ;".02 = PATIENT set TMGFDA(8925,"+1,",.03)="`"_visitIEN ;".03 = VISIT set TMGFDA(8925,"+1,",.04)="`"_DocClassIEN;".04 = PARENT DOCUMENT TYPE set TMGFDA(8925,"+1,",.05)="UNSIGNED" ;".05 = STATUS set TMGFDA(8925,"+1,",.06)="`"_DocIEN ;".06 = PARENT set TMGFDA(8925,"+1,",.07)="NOW" ;".07 = EPISODE BEGIN DATE/TIME set TMGFDA(8925,"+1,",.13)="A" ;".13 = VISIT TYPE set TMGFDA(8925,"+1,",1201)="NOW" ;"1201 = ENTRY DATE/TIME set TMGFDA(8925,"+1,",1202)="`"_AuthorIEN ;"1202 = AUTHOR/DICTATOR set TMGFDA(8925,"+1,",1204)="`"_AuthorIEN ;"1204 = EXPECTED SIGNER set TMGFDA(8925,"+1,",1205)="`"_HlocIEN ;"1205 = HOSPITAL LOCATION set TMGFDA(8925,"+1,",1211)="`"_locIEN ;"1211 = VISIT LOCATION set TMGFDA(8925,"+1,",1212)="`"_divIEN ;"1212 = DIVISION set TMGFDA(8925,"+1,",1301)="NOW" ;"1301 = REFERENCE DATE set TMGFDA(8925,"+1,",1302)="`"_AuthorIEN ;"1302 = ENTERED BY set TMGFDA(8925,"+1,",1303)="direct" ;"1303 = CAPTURE METHOD set TMGFDA(8925,"+1,",1404)="`"_serviceIEN;"1404 = SERVICE set TMGFDA(8925,"+1,",1506)="NO" ;"1506 = COSIGNATURE NEEDED do UPDATE^DIE("E","TMGFDA","TMGIEN","TMGMSG") if $data(TMGMSG("DIERR")) do goto SendADone . set result=0 . do SendAlert(AuthorIEN,TklIEN,"Error creating Tickler addendum.",.TMGMSG) new newDocIEN set newDocIEN=TMGIEN(1) Do SEND^TIUALRT(newDocIEN) ;"create alert regarding note needing to be signed. kill TMGMSG do WP^DIE(8925,newDocIEN_",",2,"","TMGWP","TMGMSG") if $data(TMGMSG("DIERR")) do goto SendADone . set result=0 . do SendAlert(AuthorIEN,TklIEN,"Error filing message into Tickler addendum.",.TMGMSG) SendADone ;"quit result quit SendErrAddendum(DocIEN,TklIEN,TMGMSG) ;"Purpose: to send an addendum to note showing database error. ;"Input: DocIEN: the document that should have the addendum added. ;" TklIEN: the IEN of the tickler record ;" TMGMSG: PASS BY REFERENCE. The error array, as returned by fileman. ;"result: none. new ErrStr set ErrStr(1)="Database error encountered handling tickler message." set ErrStr(2)="Note: This may be deleted..." set ErrStr(3)=$$GetErrStr(.TMGMSG) new AuthorIEN set AuthorIEN=$piece($get(^TMG(22705.5,TklIEN,0)),"^",5) do SendAddendum(DocIEN,AuthorIEN,TklIEN,.ErrStr) quit SendAlert(UserIEN,TklIEN,Msg,TMGMSG) ;"Purpose: to send a message alert to the user (for error reporting) ;"Input: UserIEN -- IEN in 200, the target of the message ;" TklIEN -- the IEN of the tickler message ;" Msg -- the message to send. **ONLY UP TO 80 characters** ;" No ^ allowed in the message! ;" TMGMSG -- OPTIONAL, PASS BY REFERENCE. ;" An error array as created by Fileman. ;"results: none ;"initialize vars for alert code new XQA,XQAARCH,XQADATA,XQAFLG,XQAGUID,XQAID,XQAMSG new XQAOPT,XQAROU,XQASUPV,XQASURO,XQATEXT set XQADATA=TklIEN_"^"_Msg if $data(TMGMSG) set XQADATA=XQADATA_"^"_$$GetErrStr(.TMGMSG) set XQA(UserIEN)="" set XQAMSG=Msg set XQAROU="ERRSHOW^TMGTICKL" do SETUP^XQALERT ;"send the alert quit ERRSHOW ;"Purpose: To show details about error. ;"Input: Global-scoped variable XQADATA will hold TklIEN^Msg^FMErrStr ;" Note: TklIEN could be 0 ;"Results: none write !,! write "Notice: There was an error processing a tickler message.",! write "This notice is to provide as much detail as is possible,",! write "so that the tickler message does not get lost.",!,! new TklIEN,Msg,FMErrStr if $data(XQADATA)=0 do goto ErShDone . write "But XQADATA doesn't hold info(??). Aborting.",! . do PressToCont set TklIEN=+$piece(XQADATA,"^",1) set Msg=$piece(XQADATA,"^",2) set FMErrStr=$piece(XQADATA,"^",3) write "The error message was:",! write Msg,! do PressToCont if TklIEN>0 do . write ! . write "PATIENT:",$$GET1^DIQ(22705.5,TklIEN,.01),! . write "DOCUMENT:",$$GET1^DIQ(22705.5,TklIEN,.05)," (#",$$GET1^DIQ(22705.5,TklIEN,.05,"I"),")",! . write "DUE DATE:",$$GET1^DIQ(22705.5,TklIEN,1),! . write "AUTHOR:",$$GET1^DIQ(22705.5,TklIEN,3),! . write "AUTHOR:",$$GET1^DIQ(22705.5,TklIEN,3),! . write "TICKLER STATUS:",$$GET1^DIQ(22705.5,TklIEN,2),! . write "1st LINE OF MESSAGE:",$$GET1^DIQ(22705.5,TklIEN,5),! . do PressToCont if FMErrStr'="" do . write !,"The Fileman (database) error message was:",! . write FMErrStr,! . do PressToCont write !,! write "Hopefully this will be enough information for you",! write "to fix the tickler message.",! write "Please follow up on this NOW....",! write "This will be the *only* reminder!",!! do PressToCont ErShDone quit RescheduleTask ;"Purpose: to set up task to periodically handle tickler messages. ;"Result: None new temp set temp=1 if temp=0 quit ;"a debugging measure so that launching a duplicate task can be avoided new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK set ZTRTN="HANDLE^TMGTICKL" set ZTDESC="TMG TICKLER MESSAGES HANDLER" set ZTIO="" new hrInterval set hrInterval=+$piece($get(^TMG(22705.4,1,0)),"^",2) ;"0;2=Interval if hrInterval<1 do goto SchTDone . do SendAlert(DUZ,0,"Tickler Error: Interval (field #1) in file 22705.4 < 1 hr") . set ZTSK=0 new X,Y,%,%DT set %DT="XR" set X="NOW+"_hrInterval_"H" do ^%DT set ZTDTH=Y ;"schedule time. do ^%ZTLOAD SchTDone set $piece(^TMG(22705.4,1,0),"^",3)=ZTSK ;"there are no XRefs on this field, and I own it... quit CHECKRUN ;"Purpose: To check that the background processor for the Tickler is running. ;" If not running, give user a chance to start it. ;"Input: None ;"Results: None. do KillOldTasks new Status CR1 set Status=$$TaskStatus(0) if +Status=1 do goto CRDN . write !,"SUCCESS! The TICKLER MESSAGES task is running.",! . write "Details:",! . write " Task#: ",$piece(Status,"^",3),! . write " Scheduled to run next: ",$$HTE^XLFDT($piece(Status,"^",4)),! . do PressToCont^TMGUSRIF write "There is a problem. Task is NOT running.",! new prob set prob=$piece(Status,"^",2) if prob'="" write "Problem: ",prob,! new % set %=1 write "Try to launch task now" DO YN^DICN write ! if %=1 do goto CR1 . do RescheduleTask CRDN quit TaskStatus(Verbose) ;"Purpose: To determine the status of the Tickler background task. ;"Input: Verbose : OPTIONAL. If 1 then output shown. 0 (default) is quiet. ;"Output: 1^Active^TaskNumber^NextRun($H), or -1^Message new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK set ZTDESC="TMG TICKLER MESSAGES HANDLER" set ZTIO="" set Verbose=+$get(Verbose) new Result set Result="-1^No Task Found" ;"default to error new NextRun set NextRun="" if $$TM^%ZTLOAD=0 do goto TSDone . set Result="-1^Taskman not running on current volume set" new TMGLIST,TSK do DESC^%ZTLOAD(ZTDESC,"TMGLIST") new done set done=0 set TSK=0 for set TSK=$ORDER(TMGLIST(TSK)) quit:(TSK="")!done do . new ZTSK set ZTSK=TSK . do ISQED^%ZTLOAD . if Verbose write "Task ",ZTSK,": " . set ZTSK(0)=$GET(ZTSK(0)) . if ZTSK(0)=1 if Verbose write "Pending/Waiting",! . else if ZTSK(0)=0 do . . if Verbose write "Done",! ;"Not Pending/Waiting",! . else if ZTSK(0)="" do . . if Verbose write "Lookup error.",! . if $data(ZTSK("E")) do . . if 'Verbose quit . . if $GET(ZTSK("E"))="IT" write " The task number was not valid (0, negative, or non numeric).",! quit . . if $GET(ZTSK("E"))="I" write " The task does not exist on the specified volume set.",! quit . . if $GET(ZTSK("E"))="IS" write " The task set is not listed in the VOLUME SET file (#14.5).",! quit . . if $GET(ZTSK("E"))="LS" write " The link to that volume set is not available.",! quit . . if $GET(ZTSK("E"))="U" write " An unexpected error arose (e.g., disk full, protection, etc.).",! . if $data(ZTSK("D")) do . . set NextRun=$get(ZTSK("D")) . . if 'Verbose quit . . write " Task scheduled to start: ",$$HTE^XLFDT($GET(ZTSK("D"))),! . kill ZTSK set ZTSK=TSK . do STAT^%ZTLOAD . if ZTSK(0)=0 do quit . . if 'Verbose quit . . write "?? task undefined??" . set ZTSK(1)=$get(ZTSK(1)) . if Verbose write " Status: ",ZTSK(1)," ",ZTSK(2),! . if (ZTSK(1)=1)&(ZTSK(2)="Active: Pending") do quit . . set done=1 . . set Result="1^Active^"_TSK_"^"_NextRun . TSDone quit Result KillOldTasks ;"Purpose: To clear out old, completed tasks ;"Input: none ;"Output: new ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU new ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK new TMGLIST,TSK set ZTDESC="TMG TICKLER MESSAGES HANDLER" do DESC^%ZTLOAD(ZTDESC,"TMGLIST") set TSK=0 for set TSK=$ORDER(TMGLIST(TSK)) quit:(TSK="") do . new ZTSK set ZTSK=TSK . do ISQED^%ZTLOAD . set ZTSK(0)=$GET(ZTSK(0)) . if $data(ZTSK("E")) do quit . . write "Task ",ZTSK,": ",$GET(ZTSK("E")),! . if ZTSK(0)="" write "Lookup error for task: ",TSK,! quit . if ZTSK(0)'=0 quit . kill ZTSK set ZTSK=TSK . do STAT^%ZTLOAD . if ZTSK(0)=0 write "Task ",ZTSK,": ?? task undefined??" quit . if ($GET(ZTSK(1))=3)&($GET(ZTSK(2))="Inactive: Finished") do . . do KILL^%ZTLOAD quit ;"=========================================================================== ;"Below are copies of functions from TMG Libarary, put here to avoid dependancies ;"=========================================================================== PressToCont ;"Purpose: to provide a 'press key to continue' action write "----- Press Key To Continue -----" new ch read ch:$get(DTIME,3600) write ! quit GetErrStr(ErrArray) ;"Purpose: convert a standard DIERR array into a string for output ;"Input: ErrArray -- PASS BY REFERENCE. example: ;" array("DIERR")="1^1" ;" array("DIERR",1)=311 ;" array("DIERR",1,"PARAM",0)=3 ;" array("DIERR",1,"PARAM","FIELD")=.02 ;" array("DIERR",1,"PARAM","FILE")=2 ;" array("DIERR",1,"PARAM","IENS")="+1," ;" array("DIERR",1,"TEXT",1)="The new record '+1,' lacks some required identifiers." ;" array("DIERR","E",311,1)="" ;"Results: returns one long equivalent string from above array. ;"Note: This is a copy of the function GetErrStr^TMGDEBUG ;" I copied it here so that this file has no TMG* dependencies. new ErrStr new TMGIDX new ErrNum set ErrStr="" for ErrNum=1:1:+$get(ErrArray("DIERR")) do . set ErrStr=ErrStr_"Fileman says: '" . if ErrNum'=1 set ErrStr=ErrStr_"(Error# "_ErrNum_") " . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT","")) . if TMGIDX'="" for do quit:(TMGIDX="") . . set ErrStr=ErrStr_$get(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX))_" " . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"TEXT",TMGIDX)) . if $get(ErrArray("DIERR",ErrNum,"PARAM",0))>0 do . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",0)) . . set ErrStr=ErrStr_"Details: " . . for do quit:(TMGIDX="") . . . if TMGIDX="" quit . . . set ErrStr=ErrStr_"["_TMGIDX_"]="_$get(ErrArray("DIERR",1,"PARAM",TMGIDX))_" " . . . set TMGIDX=$order(ErrArray("DIERR",ErrNum,"PARAM",TMGIDX)) quit ErrStr