| [896] | 1 | TMGTICKL ;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 |
|
|---|
| 32 | TICKLER(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 |
|
|---|
| 64 | TKDone quit result
|
|---|
| 65 |
|
|---|
| 66 |
|
|---|
| 67 | HANDLE
|
|---|
| 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 |
|
|---|
| 179 | HandlDone
|
|---|
| 180 | set ZTREQ="@" ;"delete completed task.
|
|---|
| 181 | quit
|
|---|
| 182 |
|
|---|
| 183 |
|
|---|
| 184 | HasTickler(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 |
|
|---|
| 221 | SendAddendum(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 |
|
|---|
| 298 | SendADone
|
|---|
| 299 | ;"quit result
|
|---|
| 300 | quit
|
|---|
| 301 |
|
|---|
| 302 |
|
|---|
| 303 | SendErrAddendum(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 |
|
|---|
| 319 | SendAlert(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 |
|
|---|
| 343 | ERRSHOW
|
|---|
| 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 |
|
|---|
| 391 | ErShDone
|
|---|
| 392 | quit
|
|---|
| 393 |
|
|---|
| 394 |
|
|---|
| 395 | RescheduleTask
|
|---|
| 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
|
|---|
| 419 | SchTDone
|
|---|
| 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 |
|
|---|
| 424 | CHECKRUN
|
|---|
| 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
|
|---|
| 432 | CR1 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 |
|
|---|
| 447 | CRDN quit
|
|---|
| 448 |
|
|---|
| 449 | TaskStatus(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 | .
|
|---|
| 503 | TSDone quit Result
|
|---|
| 504 |
|
|---|
| 505 |
|
|---|
| 506 | KillOldTasks
|
|---|
| 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 |
|
|---|
| 536 | PressToCont
|
|---|
| 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 |
|
|---|
| 545 | GetErrStr(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 |
|
|---|
