source: cprs/branches/tmg-cprs/m_files/TMGPUTN0.m@ 1381

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

Initial upload
File size: 62.4 KB
RevLine 
[796]1TMGPUTN0 ;TMG/kst/TIU Document Upload look-up function ;03/25/06; 5/2/10
2 ;;1.0;TMG-LIB;**1**;04/25/04
3
4 ;"TIU Document Upload look-up function
5
6 ;"Kevin Toppenberg MD
7 ;"GNU General Public License (GPL) applies
8 ;"4-25-2004
9
10
11LOOKUP(DocTitle,Autosign) ;
12 ;"-----------------------------------------------------------------------------------
13 ;"Upload look-up function
14 ;"by Kevin Toppenberg
15 ;"4-25-2004
16 ;"
17 ;"PURPOSE:
18 ;"This code is used as look-up code by the TIU document upload routines.
19 ;"It has a very specific purpose. It was written for uploading documents
20 ;" from a Medic EMR system. Notes had been dumped out of that system, and
21 ;" were to be ported into VistA
22 ;"Each note has a header with patient name, dob, ssnum, chart#, provider
23 ;"Addendum -- this code will also work with less extensive patient data.
24 ;"
25 ;"INPUT
26 ;" The variable (with global scope) listed below are expected as input.
27 ;" Not all will be required every time, however.
28 ;" DocTitle -- this is the type of document type. i.e. 'OFFICE VISIT'
29 ;" This will be used so that this code can service multiple
30 ;" types, i.e. NOTE, PRESCRIPTION CALL IN, etc.
31 ;" Autosign -- [OPTIONAL] if value=1 then document will be created as SIGNED
32 ;"Results: Document number that uploaded code should be put into is returned in variable Y
33 ;"
34 ;"
35 ;"*How it works*:
36 ;"A remote computer connects to the server running VistA. This remote computer must be
37 ;" able to upload a file using kermit. The only way I know to do this is to be on a PC
38 ;" using a terminal emulator program that has kermit upload ability.
39 ;"From this remote session, get into the TIU menu system and navigate to the option to
40 ;" upload a document. Note, one's upload parameters must be set up for this to work.
41 ;"The remote user will see a #N3, and use this que to acutally upload the file.
42 ;"After the file is uploaded, it is then processed. Each document specifies what 'type' it is
43 ;" for example 'OFFICE VISIT'
44 ;"The server then loads up the parameters for OFFICE VISIT and processes each item in the header.
45 ;"Here is an example progress note that this file can process
46 ;"--------------------------------------
47 ;"[NewDict]: OFFICE VISIT
48 ;"Name: JONES,BASKETBALL
49 ;"Alias: JONES,BOB
50 ;"DOB: 4/13/71
51 ;"Sex: MALE
52 ;"SSNumber: 555 11 9999
53 ;"ChartNumber: 10034
54 ;"Date: 7/22/2002
55 ;"Location: Peds_Office
56 ;"Provider: KEVIN TOPPENBERG MD
57 ;"[TEXT]
58 ;"
59 ;" CHIEF COMPLAINT: Follow up blood clot.
60 ;"
61 ;" HPI:
62 ;" 1. BJ was in the emergency room 3 days ago. He was being
63 ;" evaluated for left lower extremity pain. He said that they did
64 ;" radiographic studies and told him that he had a blood clot in
65 ;" .... (snip)
66 ;"
67 ;"[END]
68 ;"--------------------------------------
69 ;"[NewDic] tells the system that a document header is starting
70 ;"'Name' is a CAPTION, and the value for this caption is 'JONES,BASKETBALL'
71 ;"The upload system will put this value into a variable. In this case, I specified
72 ;" that the variable name TMGNAME to be used.
73 ;"
74 ;"Here are each caption and its cooresponding Variable:
75 ;"Name <--> TMGNAME
76 ;"DOB <--> TMGDOB
77 ;"Sex <--> TMGSEX
78 ;"SSNumber <--> TMGSSNUM
79 ;"ChartNumber <--> TMGPTNUM
80 ;"Date <--> TIUVDT
81 ;"Provider <--> PERSON
82 ;"Alias <--> TMGALIAS
83 ;"Location: <--> TIULOC
84 ;"
85 ;"Document Title is passed to function as 'DocTitle'
86 ;"
87 ;"After the note has been processed and all the above variables have been set, the server
88 ;"calls a 'look-up' function. This function is supposed to return the document number where the
89 ;"text is supposed to be put (the number should be put in Y)
90 ;"
91 ;"This look-up function has an extra twist. I am using it to register patients on the fly
92 ;" if needed. I am doing this because I had about 30,000 patients in my database to transfer,
93 ;" and I had difficulty getting a separate file with just demographics etc. So, if a patient
94 ;" is not already in the database, they are registered here.
95 ;"
96 ;"Extra note:
97 ;"When this function is called, the TIU upload process has already set up some variables.
98 ;"DA = the IEN in 8925.2, i.e. ^TIU(8925.2,DA,"TEXT",0) that the uploaded text was temporarily store in.
99 ;" In other words, here DA = the serial index number of the document to be uploaded
100 ;" i.e. 1 for the first, 2 for the second etc.
101 ;"TIUI = the line index of the beginning of the report to be processed (i.e. the line
102 ;" that starts with [TEXT]
103 ;"DUZ = Current user number.
104 ;"TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params
105 ;"TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params.
106
107 write "+-------------------------------------+",!
108 write "| Starting upload code... |",!
109 write "+-------------------------------------+",!
110
111 set BuffNum=$get(DA) ;"Store which upload buffer we are working on.
112 set BuffIdx=$get(TIUI) ;"Store line number (in upload buffer) we are starting with.
113 new cMaxNoteWidth set cMaxNoteWidth=60
114
115 ;"Field (f) constants
116 new fPatient set fPatient=.02 ;"field .02 = PATIENT
117 new fVisit set fVisit=.03 ;"field .03 = VISIT
118 new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE
119 new fStatus set fStatus=.05 ;"field .05 = STATUS
120 new fParent set fParent=.06 ;"field .06 = PARENT
121 new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07)
122 new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08)
123 new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME
124 new fAuthor set fAuthor=1202 ;"field 1202 = PERSON/DICTATOR
125 new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer
126 new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION
127 new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner
128 new fAttending set fAttending=1209 ;"field 1209 = ATTENDING
129 new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION
130 new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE
131 new fEnteredBy set fEnteredBy=1302 ;"field 1302 = ENTERED BY (a pointer to file 200)
132 new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload'
133 new fService set fService=1404 ;"field 1404 = SERVICE
134 new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by
135 new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected.
136 new fCharTrans set fCharTrans=22711 ;"field 22711 = CHAR COUNT -- TRANSCRIPTIONIST
137 new fLineCount set fLineCout=.1 ;"field .1 = LINE COUNT
138
139 ;" Piece (p) constants
140 new pPatient set pPatient=2 ;"Node 0,piece 2 = PATIENT (field .02)
141 new pVisit set pVisit=3 ;"Node 0,piece 3 = VISIT (field .03)
142 new pStrtDate set pStrtDate=7 ;"Node 0,piece 7 = EPISODE BEGIN DATE/TIME (field .07)
143 new pEndDate set pEndDate=8 ;"Node 0,piece 8 = EPISODE END DATE/TIME (field .08)
144 new pExpSigner set pExpSigner=4 ;"Node 12,piece 4 = EXPECTED SIGNER (field 1204)
145 new pHospLoc set pHospLoc=5 ;"Node 12,piece 5 = HOSPITAL LOCATION (field 1205)
146 new pExpCosign set pExpCosign=8 ;"Node 12,piece 8 = EXPECTED COSIGNER (field 1210)
147 new pAttending set pAttending=9 ;"Node 12,piece 9 = ATTENDING PHYSICIAN (field 1209)
148 new pService set pService=4 ;"Node 14,piece 4 = SERVICE (field 1404)
149
150 if $data(cAbort)#10=0 new cAbort set cAbort=0
151
152 new DBIndent,PriorErrorFound
153 new Patient
154 new DocIEN set DocIEN=-1
155 new Document
156 new NewDoc set NewDoc=0
157 new result set result=1 ;"cOKToCont
158
159 do PtArrayCreate(.Patient) ;"Load upload info into Patient array
160 set result=$$DocArrayCreate(.Document) ;"Load upload document info into Document array
161 if result=cAbort goto LUDone
162 set Document("DFN")=$$GetDFN^TMGGDFN(.Patient) ;"Store DFN of patient.
163 if Document("DFN")'>0 set result=cAbort goto LUDone ;"Abort.
164 set Document("AUTO SIGN")=$get(Autosign,1) ;"default to YES auto-signing
165 ;"06-19-05 Changed to disable autosigning. If document is
166 ;" autosigned here, then no prompt for printing elsewhere.
167 ;"9-1-05 Resuming autosigning. Currently the outside transcriptionists are already
168 ;" printing the notes before giving them to us for upload.
169 ;" Changed default to be YES autosign
170 ;"set Document("AUTO SIGN")=0 ;"override setting passed in...
171
172 set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=$$BuffCharCount() ;"Count character prior to any wrapping/merging etc.
173 set result=$$PrepUploadBuf() ;"Do any word-wrapping etc needed in upload buffer
174 if result=cAbort goto LUDone
175 set DocIEN=$$PrepDoc(.Document,.NewDoc) ;"Prepair a document to put upload into. Credits transcription
176
177 set Y=DocIEN
178 merge TMGDOC=Document ;"Create a global -- will kill after followup code
179LUDone
180 ;"put result into Y. TIU filing system looks for results in Yi
181 if result=cAbort set Y=-1
182
183 quit
184
185
186
187 ;"-----------------------------------------------------------------------------------------------
188 ;"==============================================================================================-
189 ;" S U B R O U T I N E S
190 ;"==============================================================================================-
191 ;"-----------------------------------------------------------------------------------------------
192 ;"PtArrayCreate(Array)
193 ;"DocArrayCreate(Document)
194 ;"PrepDoc(Document,NewDoc);
195 ;"GetDocTIEN(Title)
196 ;"GetLocIEN(Location)
197 ;"GetService(IEN)
198 ;"GetProvIEN(Provider)
199 ;"GetRecord(Document,NewDoc,AskOK,Editable)
200 ;"DocExists(Document)
201 ;"BuffCharCount()
202 ;"PrepUploadBuf()
203
204 ;"NeedsReformat(MaxWidth)
205 ;"CutNote(Array)
206 ;"PasteNote(Array,NextNoteI)
207 ;"CompToBuff(ExistingIEN,UplTIEN,UplDate)
208 ;"CreateRec(Document) ;
209 ;"StuffRec(Document,PARENT)
210 ;"MakeVisit(Document)
211 ;"FOLLOWUP(DocIEN) ;Post-filing code for PROGRESS NOTES
212
213
214PtArrayCreate(Array)
215 ;"SCOPE: Private
216 ;"Purpose: To put global scope vars (i.e. TMGNAME,TMGSSNUM etc) into
217 ;" an array for easier portability
218 ;"Input: Array, must be passed by reference
219 ;" The global-scope variables setup by the upload system, and are used here:
220 ;" TMGPTNUM,TMGSSNUM,TMGSSNUM,TMGNAME,TMGDOB,TMGSEX
221 ;"Output: Array is loaded with info, like this:
222 ;" set Array("SSNUM")="123-45-6789"
223 ;" set Array("NAME")="DOE,JOHN"
224 ;" set Array("DOB")=TMGDOB
225 ;" set Array("PATIENTNUM")="12345677"
226 ;" set Array("SEX")="M"
227 ;" set Array("ALIAS")="DOE,JOHNNY"
228 ;"Results: none
229
230 if $data(TMGPTNUM)#10'=0 do
231 . set TMGPTNUM=$translate(TMGPTNUM,"PWCI*","") ;"Clean off alpha characters -- not needed.
232 . ;"set TMGPTNUM=$$Trim^TMGSTUTL(TMGPTNUM)
233 . set TMGPTNUM=$$FORMAT^DPTNAME(.TMGPTNUM,3,30) ;"Use same input transform as for .01 field of PATIENT file
234 . set Array("PATIENTNUM")=TMGPTNUM
235
236 if $data(TMGSSNUM)#10'=0 do
237 . set TMGSSNUM=$translate(TMGSSNUM," /-","") ;"Clean delimiters
238 . if +TMGSSNUM=0 set TMGSSNUM="" ;was ... "P"
239 . if (TMGSSNUM="P")!(+TMGSSNUM>0) set Array("SSNUM")=TMGSSNUM
240
241 set Array("NAME")=$$FormatName^TMGMISC(.TMGNAME)
242
243 if $data(TMGALIAS)#10'=0 do
244 . set TMGALIAS=$translate(TMGALIAS,"*","")
245 . set TMGALIAS=$$FORMAT^DPTNAME(TMGALIAS,3,30) ;"convert to 'internal' format (strip .'s etc)
246 . set Array("ALIAS")=TMGALIAS
247
248 if $data(TMGSEX)#10'=0 do
249 . set TMGSEX=$$UP^XLFSTR($get(TMGSEX))
250 . if TMGSEX="M" set TMGSEX="MALE"
251 . else if TMGSEX="F" set TMGSEX="FEMALE"
252 . set Array("SEX")=TMGSEX
253
254 if $data(TMGDOB)#10'=0 do
255 . if +TMGDOB>0 set Array("DOB")=TMGDOB
256 . else quit
257 . new CurDate,CurYr
258 . do DT^DILF("E","T",.CurDate)
259 . set CurDate=$get(CurDate(0))
260 . if CurDate="" quit
261 . set CurYr=$piece(CurDate,", ",2)
262 . new DOBYr
263 . set DOBYr=$piece(TMGDOB,"/",3)
264 . if DOBYr>CurYr do ;"we have a Y2K problem
265 . . set DOBYr=DOBYr-100
266 . . if DOBYr'>0 quit
267 . . set TMGDOB=$piece(TMGDOB,"/",1,2)_"/"_DOBYr
268 . . set Array("DOB")=TMGDOB
269
270 quit
271
272
273
274DocArrayCreate(Document)
275 ;"SCOPE: Private
276 ;"Purpose: To put TIUVDT etc. etc into an array for easier portibility
277 ;"Input: Document -- OUT parameter, must be passed by reference
278 ;" The global-scope variables setup by the upload system are used:
279 ;" TIUVDT,PERSON,TIULOC, (and also DocTitle)
280 ;"Output: Document is loaded with info.
281 ;"Results: 1=OKToCont, or cAbort
282
283 new result set result=1 ;"cOKToCont
284
285 set Document("PROVIDER")=$get(PERSON)
286 if Document("PROVIDER")="" do goto DACDone
287 . set result=cAbort
288 set Document("PROVIDER IEN")=$$GetProvIEN(Document("PROVIDER"))
289 set Document("LOCATION")=$get(TIULOC,"Main_Office")
290 set Document("DATE")=$get(TIUVDT)
291 set Document("TITLE")=$get(DocTitle,"NOTE")
292
293 ;"Decide which transcriptionist is. This will be used for crediting productivity.
294 ;"If transcriptionist not specified, current user (DUZ) is assumed.
295 if $data(TMGTRANS)#10=0 set TMGTRANS=$piece($get(^VA(200,DUZ,0)),"^",1)
296 set Document("TRANSCRIPTIONIST")=$$FormatName^TMGMISC(TMGTRANS)
297
298 if (Document("DATE")="")!(Document("DATE")="00/00/00") do goto DACDone
299 . set result=cAbort
300
301DACDone
302 quit result
303
304
305
306PrepDoc(Document,NewDoc);
307 ;"Scope: PRIVATE.
308 ;" Addendum 7/25/07. Will be called by RPC call BLANKTIU^TMGRPC1
309 ;" to return a blank document
310 ;"Purpose: Prepair a document to put upload into.
311 ;"Input: Document -- an array as follows:
312 ;" Document("DFN")=DFN, the record number of the patient.
313 ;" Document("PROVIDER IEN")= the IEN of the provider
314 ;" Document("LOCATION")= the location of the visit
315 ;" Document("DATE")= the date of the visit.
316 ;" Document("TITLE")= the title of the note
317 ;" Document(cVisitStr) an OUT PARAMETER
318 ;" Document("TRANSCRIPTIONIST") -- the name of the transcriptionist
319 ;" Document("CHARACTER COUNT - TRANSCRIPTIONIST'S") -- the char count creditable to transcriptionist
320 ;" NewDoc: OPTIONAL flag, passed back with
321 ;" NewDoc = 1 if returned docmt is new
322 ;" NewDoc = 0 if returned docmt already existed, timeout, etc
323 ;"Results: returns record number (IEN) ready to accept upload (or -1 if failure)
324 ;" Also Document("DOC IEN") will have this same IEN
325 ;" NOTE: if result is -1 then errors are passed back in
326 ;" Document("ERROR") node
327 ;" Document("ERROR",n)="ERROR.. Stuffing new document."
328 ;" Document("ERROR","NUM")=n
329 ;" Document("ERROR","FM INFO")=merge with DIERR array
330
331 ;" PIEN = patient internal entry number
332 ;" Global-Scope variables expected:
333 ;" PERSON, TMGSSNUM etc. defined above
334 ;" TIUVDT expected
335 ;" TIULOC is also expected (i.e. 'LAUGHLIN_OFFICE')
336 ;"
337 ;"Output: will return document number, or -1 if failure.
338 ;"NOTES: This originated from ^TIUPUTPN
339 ;"
340 ;" Look-up code used by router/filer
341 ;" Required variables: TMGSSNUM, TIUVDT
342 ;" i.e., TMGSSNUM (Pt SS-Number) and TIUVDT (visit date) must be set prior to call.
343 ;"
344
345 new cStartDate set cStartDate="EDT"
346 new cEndDate set cEndDate="LDT"
347 new cService set cService="SVC"
348 new cDocType set cDocType="TYPE"
349 new cDocTIEN set cDocTIEN="TYPE IEN"
350 new cHspLocIEN set cHspLocIEN="LOC"
351 new cVstLocIEN set cVstLocIEN="VLOC"
352 new cVisitStr set cVisitStr="VSTR"
353 new cVisitIEN set cVisitIEN="VISIT"
354 new cStopCode set cStopCode="STOP"
355
356 new TMG,DFN
357 new TIUDAD,TIUEDIT
358 new TIULDT,TIUXCRP,DocTIEN
359 new LocIEN
360 new result set result=-1
361 set NewDoc=0
362
363 set Document(cStartDate)=$$IDATE^TIULC(Document("DATE")) ;"Convert date into internal format
364 set Document(cEndDate)=Document(cStartDate) ;"For office notes, begin and end dates will be the same.
365
366 ;"Setup DocTIEN -- to be used below as [MAS Movement event type]
367 ;"Convert Document title into IEN, i.e. OFFICE VISIT --> 128
368 set DocTIEN=$$GetDocTIEN(Document("TITLE"))
369 if +DocTIEN'>0 do goto PrepDocX
370 . set Document("ERROR",1)="ERROR: Unable to determine note type from title: "_Document("TITLE")
371 . set Document("ERROR","NUM")=1
372
373 ;"Purpose: setup Document(cDocType) -- used below as: Title info variable of form:
374 ;" Setup string in form of: 1^title IEN^title Name
375 ;" e.g.: 1^128^OFFICE VISIT^OFFICE VISIT
376 set Document(cDocTIEN)=DocTIEN
377 set Document(cDocType)=1_"^"_DocTIEN_"^"_$$PNAME^TIULC1(DocTIEN)
378
379 ;"do MAIN^TIUVSIT(.TIU,.DFN,TMGSSNUM,Document(cStartDate),Document(cEndDate),"LAST",0,Document("LOCATION"))
380
381 ;" setup LocIEN from HOSPITAL LOCATION file (#44)
382 ;" This contains entries like 'Laughlin_Office'
383 set LocIEN=+$$GetLocIEN(Document("LOCATION"))
384 if '$data(^SC(LocIEN,0)) do goto PrepDocX ;"^SC(*) is file 44, Hospital Location
385 . set Document("ERROR",1)="ERROR: Unable to process location: "_Document("LOCATION")
386 . set Document("ERROR","NUM")=1
387
388 set Document(cService)=$$GetService(Document("PROVIDER IEN")) ;"i.e. FAMILY PRACTICE
389 set Document(cVisitStr)="x;x;"_DocTIEN ;"LOC;VDT;VTYP
390 set Document(cVisitIEN)=0 ;"Visit File IFN
391 set Document(cHspLocIEN)=LocIEN
392 set Document(cVstLocIEN)=LocIEN
393 set Document(cStopCode)=0 ;"0=FALSE, don't worry about stop codes.
394
395 set result=$$GetRecord(.Document,.NewDoc,0)
396 if result'>0 do goto PrepDocX
397 . new n set n=+$get(Document("ERROR","NUM"))+1
398 . set Document("ERROR",n)="ERROR.. after creating new document."
399 . set Document("ERROR","NUM")=n
400
401 ;"At this point, any merging has been done (once implemented)
402 ;"So a character count of now will be a total/combined character count
403 set Document("CHAR COUNT - TOTAL")=$$BuffCharCount ;"Count character after any wrapping/merging etc.
404 ;"Now, we need the standard CHARARACTERS/LINE value stored in field .03 of TIU PARAMETERS (in ^TIU(8925.99))
405 ;"For my setup, I have only have one record for in this file, so I'll use IEN=1.
406 new CharsPerLine set CharsPerLine=$piece($get(^TIU(8925.99,1,0)),"^",3)
407 if CharsPerLine'=0 do
408 . new IntLC,LC,Delta
409 . set LC=Document("CHAR COUNT - TOTAL")\CharsPerLine
410 . set IntLC=Document("CHAR COUNT - TOTAL")\CharsPerLine ;" \ is integer divide
411 . set Delta=(LC-IntLC)*10
412 . if Delta>4 set IntLC=IntLC+1 ;"Round to closest integer value.
413 . set Document("LINE COUNT")=IntLC
414
415 set result=$$StuffRec(.Document,0) ;"Will load Document("ERROR","FM INFO") with any FM errors
416 if +$get(result)'>0 do goto PrepDocX
417 . new n set n=+$get(Document("ERROR","NUM"))+1
418 . set Document("ERROR",n)="ERROR.. Stuffing new document."
419 . set Document("ERROR","NUM")=n
420
421PrepDocX
422 quit result ;"result is document #
423
424
425MakeVisit(Document)
426 ;"Purpose -- to create a new entery in the VISIT file, based on info in Document.
427 ;"Input -- Document -- array with following info:
428 ;" Document("DFN")=DFN, the record number of the patient.
429 ;" Document("PROVIDER")= the provider of care for the note
430 ;" Document("PROVIDER IEN")= the IEN of the provider
431 ;" Document("LOCATION")= the location of the visit
432 ;" Document("DATE")= the date of the visit.
433 ;"Result -- returns IEN of visit entry
434
435 ;"Note -- this function is not now being used...
436
437 new TMGFDA
438 ;set TMGFDA(9000010,"?+1,",.01)= ;".01=VISIT/ADMIT DATE&TIME
439 ;set TMGFDA(9000010,"?+1,",.02)= ;".02=DATE VISIT CREATED
440 ;set TMGFDA(9000010,"?+1,",.03)="O" ;".02=VISIT TYPE -- O=Other
441 ;set TMGFDA(9000010,"?+1,",.05)= ;".05=PATIENT NAME
442 ;set TMGFDA(9000010,"?+1,",15001)="10C1-TEST" ;"15001=VISIT ID
443 ;LOCATION NAME --> Medical Group of Greeneville
444 ;SERVICE CATEGORY: A --> AMBULATORY
445 ;DSS ID: PRIMARY CARE/MEDICINE
446 ;HOSPITAL LOCATION: Laughlin_Office
447 ;Created by user: DUZ
448 quit
449
450
451GetDocTIEN(Title)
452 ;"Purpose: To return IEN for document *type defination* / Identify document title
453 ;"Input Title -- the Text Title to look up
454 ;"Results: Returns the document definition IFN (i.e. Y)
455
456 new DIC,Y,X
457 new TIUFPRIV set TIUFPRIV=1
458
459 set DIC=8925.1
460 set DIC(0)="M"
461 set DIC("S")="IF $PIECE(^TIU(8925.1,+Y,0),""^"",4)=""DOC"""
462 set X=Title
463 do ^DIC
464 kill DIC("S")
465 if $find(Y,"^")>0 set Y=$piece(Y,"^",1)
466
467 quit Y
468
469
470GetLocIEN(Location)
471 ;"Scope: PRIVATE
472 ;"Purpose: To return IEN for location
473 ;"Input: Location -- the Location to look up.
474 ;"Results: returns LocationIEN (i.e. Y)
475
476 new DIC,X,Y
477 set DIC=44 ;"file 44 is HOSPITAL LOCATION
478 set DIC(0)="M"
479 set X=Location
480 do ^DIC ;" do a , value is returned in Y
481 if $find(Y,"^")>0 set Y=$piece(Y,"^",1)
482
483 quit Y
484
485
486GetService(IEN)
487 ;"Scope: PRIVATE
488 ;"Purpose: Get the Service for the Provider
489 ;"Input: IEN -- the IEN of the Provider to look up.
490 ;"Results: returns the Name of the Service for provider, or "" if not found
491
492 new result set result=""
493 new node,SvIEN
494
495 if IEN=-1 goto GtSvDone
496 set node=$get(^VA(200,IEN,5)) ;"^VA(200, is NEW PERSON file
497 set SvIEN=+$piece(node,"^",1)
498 if SvIEN=0 goto GtSvDone
499 set node=$get(^DIC(49,SvIEN,0)) ;"^DIC(49, is the SERVICE/SECTION file
500 set result=$piece(node,"^",1)
501
502GtSvDone
503 quit result
504
505
506GetProvIEN(Provider)
507 ;"Scope: PRIVATE
508 ;"Purpose: To return IEN for Provider
509 ;"Input: Provider -- the Provider to look up.
510 ;"Results: returns Provider's IEN (i.e. Y), or -1 if not found
511
512 new DIC,X,Y
513 set DIC=200 ;"file 200 is NEW PERSON
514 set DIC(0)="M"
515 set X=Provider
516 do ^DIC ;" do a , value is returned in Y
517 if $find(Y,"^")>0 set Y=$piece(Y,"^",1)
518
519 quit Y
520
521
522GetRecord(Document,NewDoc,AskOK,Editable)
523 ;"Scope: PRIVATE
524 ;"PURPOSE:
525 ;" To get a record--either via creating a new one, or returning an existing one
526 ;" Note: If an existing one is returned, it will be emptied first...
527 ;"
528 ;" Note: If I want to merge part of what the doctor creates with what the
529 ;" transcriptionist uploads, here what I should do
530 ;" 1. Look for an existing document with same date as document being uploaded.
531 ;" 2. If found, look in existing document for merge symbols (i.e. {{1}} }
532 ;" 3. If found, then take code from existing document and current part
533 ;" of upload buffer, and create a merged document.
534 ;" 4. Put this merged document back into the upload buffer.
535 ;" 5. Empty the existing document, and return its IEN from this function
536 ;"
537 ;"INPUT: Document -- array with Document("DFN"), Document(cDocType) are REQUIRED.
538 ;" [Document] --> Visit info array -- SHOULD PASS BE REFERENCE.
539 ;" Document("DFN") = patient DFN
540 ;" Document(cVisitStr) = LOC;VDT;VTYP e.g. 'x;x;OFFICE VISIT'
541 ;" Document(cVisitIEN) = VISIT file IFN e.g. 0, used for field .03 in file 8925. Pointer to file #9000010
542 ;" Document(cHspLocIEN) i.e. Hospital location IEN. Used for field 1205 in 8925. Pointer to file #44
543 ;" Document(cVstLocIEN) i.e. visit location IEN. Used for field 1211 in 8925. Pointer to file #44
544 ;" Document(cStopCode) = mark to defer workload e.g. 0/FALSE=don't worry about stop codes.
545 ;" USED FOR: Mark record for deferred crediting of stop code (fld #.11)
546 ;" This boolean field (.11) indicates whether the stop code associated with a new
547 ;" visit should be credited when the note is completed.
548 ;" Note: if Document('STOP')="", then not processed.
549 ;" Document(cDocType)=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT
550 ;" Document(cDocTIEN)=DocTIEN (a.k.a. title DA) e.g. 128
551 ;" Document(cService) e.g.FAMILY PRACTICE
552 ;" Document(cStartDate) i.e. event begin time
553 ;" Document(cEndDate) i.e. event end time
554 ;" [NewDoc] --> flag, passed back with
555 ;" NewDoc = 1 if returned docmt is new
556 ;" NewDoc = 0 if returned docmt already existed, timeout, etc
557 ;" [AskOK] --> Ask user flag, where
558 ;" AskOK = 1: ask re edit/addend existing docmt
559 ;" (Interactive List Manager options, TRY docmt def)
560 ;" AskOK = 0: don't ask (Upload & GUI options)
561 ;" [Editable]-->flag, passed back with Editable = 1 if returned
562 ;" PREEXISTING docmt can be edited by Provider. If
563 ;" preexisting docmt returned and 'Editable, then
564 ;" docmt cannot be edited by Provider.
565 ;"
566 ;"Results: Returns DocIEN -- IEN of document to use, or -1 if error etc.
567 ;" Also, Document("DOC IEN") is set to DocIEN
568 ;" Errors will be returned in Document("ERROR")
569 ;"
570 ;"Note: Code originally from GETRECNM^TIUEDI3 -- KT 5/25/04
571
572 new MultOK set MultOK=1
573 new DocIEN set DocIEN=-1
574 set NewDoc=0
575
576 if +$get(BuffNum)'=0 set DocIEN=$$DocExists(.Document) ;"avoid error with RPC calls
577 else set DocIEN=0
578 set Document("DOC IEN")=DocIEN
579 if DocIEN>0 do goto GRDone ;"DocIEN>0 means that the TEXT of the report is an exact match
580 . kill ^TIU(8925,DocIEN,"TEXT") ;"Kill the TEXT prior report, so we can overwrite it
581 else do
582 . set DocIEN=$$CreateRec(.Document)
583 . set NewDoc=1
584
585GRDone ;
586 if NewDoc,DocIEN'>0 set NewDoc=0
587 set Document("DOC IEN")=DocIEN
588 quit DocIEN ;"DocIEN is document number
589
590
591DocExists(Document)
592 ;"PURPOSE: To return document IEN, if it already EXISTS for the
593 ;" given patient, title, and visit.
594 ;"INPUT: Document -- see documentation of format in $$GetRecord
595 ;"Results: returns a value for document (i.e. DocIEN), or -1 if no prior doc is found.
596 ;"
597 ;"Note: The following documents are ignored:
598 ;" - docmts of status deleted or retracted
599 ;" - all docmts if run across a docmt w/ requesting pkg
600 ;" - If REQEDIT, then also ignore docmts PERSON cannot edit.
601 ;"Note: If there are more than one, get the smallest DA.
602
603 new DocIEN set DocIEN=-1
604 new index
605
606 if $data(^TIU(8925,"C",Document("DFN")))=0 goto DEDone
607 ;"Scan through all documents for patient (DFN)
608 set index=$order(^TIU(8925,"C",Document("DFN"),""))
609 if index="" goto DEDone
610 for do quit:(index="")
611 . new DocCompValue
612 . set DocCompValue=$$CompToBuff(index,Document(cDocTIEN),Document(cStartDate))
613 . if DocCompValue=2 do quit ;"i.e. documents are an exact match
614 . . ;"For below, the document is the same as the upload buffer.
615 . . ;"We have found our answer.
616 . . ;"
617 . . ;"Below is code I can use to check to see if I SHOULD be editing.
618 . . ;"------------------------------------------------------
619 . . ;"new CANEDIT,CANDel
620 . . ;"set CANEDIT=+$$CANDO^TIULP(index,"EDIT RECORD",Document("PROVIDER IEN"))
621 . . ;"set CANDel=+$$CANDO^TIULP(index,"DELETE RECORD",Document("PROVIDER IEN"))
622 . . ;"if +CANEDIT>0 set DocIEN=index
623 . . set DocIEN=index set index="" quit
624 . set index=$order(^TIU(8925,"C",Document("DFN"),index))
625
626DEDone
627 quit DocIEN
628
629
630BuffCharCount()
631 ;"Purpose: To count the number of characters in the current upload buffer, for the
632 ;" current document. The upload buffer puts all the documents being uploaded
633 ;" into one big WP array. This function will count down until the text
634 ;" signal is found to start the next documnent (e.g. '[NewDict]')
635 ;"Input: none. However, several global-scope variables are used.
636 ;" By tracing through the upload code I know that
637 ;" the following variables are set:
638 ;" (I saved DA as BuffNum, and TIUI as BuffIdx)
639 ;" TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params
640 ;" TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params.
641 ;" BuffIdx = the line index of the beginning of the report to be processed (i.e. the line
642 ;" that starts with [TEXT]
643 ;" BuffNum = the index in 8925.2, i.e. ^TIU(8925.2,BuffNum,"TEXT",0)
644 ;" In other words, here BuffNum = the serial index number of the document to
645 ;" be uploaded i.e. 1 for the first, 2 for the second etc.
646 ;"Notes
647 ;" 8925.2 is file: TIU UPLOAD BUFFER
648 ;" To detect the beginning of the next document, use
649 ;" if MyLine[TIUHSIG then abort
650 ;" I trim of leading and trailing white-space before counting.
651 ;" But, otherwise spaces will be counted
652 ;"
653 ;"Results: Returns character count, or 0 if none found.
654
655 new index
656 new result set result=0
657 if $get(TIUHSIG)="" goto BuffCDone
658
659 set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx))
660 for do quit:(index="")
661 . if index="" quit
662 . new s set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0))
663 . if s="" set index="" quit
664 . if s[TIUHSIG set index="" quit
665 . set s=$$Trim^TMGSTUTL(.s)
666 . set result=result+$length(s)
667 . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index))
668
669BuffCDone
670 quit result
671
672
673
674PrepUploadBuf()
675 ;"Purpose: Ensure upload buffer is ready for processing
676 ;"Background: Transcriptionist will upload a large document containing
677 ;" multiple notes for different patients etc. This entire large
678 ;" document is stored in the TIU UPLOAD BUFFER file (8925.2)
679 ;" When this filer code is called, the TIU upload process has already
680 ;" set up some variables.
681 ;" DA = the IEN in 8925.2, i.e. ^TIU(8925.2,DA,"TEXT",0) that
682 ;" the uploaded text was temporarily store in.
683 ;" (I save DA as BuffNum)
684 ;" TIUI = the line index of the beginning of the report to
685 ;" be processed (i.e. the line that starts with [TEXT])
686 ;" (I save TIUI as BuffIdx)
687 ;" TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params
688 ;" TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params.
689 ;"
690 ;" I found that transcriptionists were using word-processors that automatically
691 ;" wrapped the text to a next line. Thus paragraphs were being uploaded as
692 ;" one very long line. Rather than try to reeducate them to consistantly hit
693 ;" enter at the end of every line, I chose to automatically wrap the text to
694 ;" a set width.
695 ;"
696 ;" A global-scope var: cMaxNoteWidth is expected to be defined/
697 ;"
698 ;" So, to prepair the upload buffer, I use these steps:
699 ;" 1. Scan the part of the upload buffer pertaining to the
700 ;" current note being processed
701 ;" - This starts with line BuffIdx, and ends with...
702 ;" - the line containing TIUHSIG (or end of buffer)
703 ;" See if any line is longer than cMaxNoteWidth characters.
704 ;" If so, mark for wrapping.
705 ;" 2. If wrapping needed, extract note to a temporary array
706 ;" 3. Perform reformatting/wrapping on temp array.
707 ;" 4. Put temp array back into Upload buffer
708 ;"
709 ;"Input: None, but global-scope vars used (see above)
710 ;"Output: Upload buffer may be changed
711 ;"Result: 1=OKToCont or cAbort
712
713 new result set result=1
714 if $$NeedsReformat(cMaxNoteWidth) do
715 . new CurNote
716 . new NextNoteI
717 . new DoSpecialIndent set DoSpecialIndent=1 ;"I.e. use hanging indents.)
718 . set NextNoteI=$$CutNote(.CurNote)
719 . do WordWrapArray^TMGSTUTL(.CurNote,cMaxNoteWidth,DoSpecialIndent)
720 . set result=$$PasteNote(.CurNote,NextNoteI)
721PULBFDone
722 quit result
723
724
725NeedsReformat(MaxWidth)
726 ;"Purpose: To scan the single note being processed, to see if
727 ;" it is too wide (i.e. any line of length > MaxWidth
728 ;" I had to do this because transcriptionists were using
729 ;" a wordprocessor that wrapped lines. Then when uploaded
730 ;" each paragraph became one long line.
731 ;" Also, will fix extended ASCII characters
732 ;"Input: MaxWidth The max length of any line (i.e. 80 for 80 chars)
733 ;" Also depends on global-scope vars
734 ;"Result: 1= A line was found that is > MaxWidth
735 ;" 0= no long lines found
736
737 new index
738 new result set result=0
739 if $get(TIUHSIG)="" goto NRFMDone
740 if $get(MaxWidth)'>0 goto NRFMDone
741
742 set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx))
743 if index'="" for do quit:(index="")
744 . new s
745 . set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0))
746 . if s="" set index="" quit
747 . ;"9/19/06 Added to remove extended ASCII characters
748 . ;"set s=$translate(s,$c(146)_$c(246)_$c(150)_$c(147)_$c(148),"'--""""")
749 . if s[TIUHSIG set index="" quit
750 . if $length(s)>MaxWidth do quit
751 . . set result=1
752 . . set index=""
753 . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index))
754
755NRFMDone
756 quit result
757
758
759CutNote(Array)
760 ;"Purpose: To extract the current note out of the entire upload buffer
761 ;"Input: Array -- MUST BE PASSED BY REFERENCE. This is an OUT parameter
762 ;" Array will be loaded with the note, with the first line being
763 ;" put into Array(1)
764 ;" Depends on global-scope vars BuffIdx, BuffNum, TIUHSIG, set up elsewhere.
765 ;"Note: This function empties the lines in TIU UPLOAD BUFFER as it cuts out note.
766 ;"Result: Returns:
767 ;" #: index of line containing start of next note.
768 ;" -1: Error
769 ;" 0: Note is the last one in the upload buffer, so no next note found
770
771 new index
772 new LastI set LastI=0
773 new result set result=-1
774 kill Array
775 if $get(TIUHSIG)="" goto ExNDone
776 new ArrayI set ArrayI=0
777 new s
778 new Done set Done=0
779
780 set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx))
781
782 if index'="" for do quit:(index="")!(Done=1)
783 . set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0))
784 . if s[TIUHSIG set Done=1 quit
785 . set ArrayI=ArrayI+1
786 . set Array(ArrayI)=s
787 . kill ^TIU(8925.2,BuffNum,"TEXT",index)
788 . set LastI=index
789 . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index))
790
791 set result=+index
792 if result=0 set result=LastI
793ExNDone
794 quit result
795
796
797
798PasteNote(Array,NextNoteI)
799 ;"Purpose: To put Array back into the upload buffer, at the correct location,
800 ;"Input: Array -- Best if PASSED BY REFERENCE.
801 ;" Array is expected to be loaded with the note, with the first line Array(1)
802 ;" NextNoteI: This is the index, in upload buffer, of the start of the next note.
803 ;"Depends on global-scope vars BuffIdx, BuffNum, TIUHSIG, set up elsewhere.
804 ;"Result: 1=OKToCont if all OK, or cAbort if error
805
806 new EntireBuf
807 new IndexInc set IndexInc=0.01 ;"WP^DIE does not require integer indexes.
808 new ArrayI,PasteI
809 new s
810 new Done set Done=0
811 new result set result=cAbort
812 merge EntireBuf=^TIU(8925.2,BuffNum,"TEXT")
813 kill EntireBuf(0) ;"remove ^^<line count>^<line count>^<fm date>^^
814
815 set ArrayI=$order(Array(""))
816 set PasteI=BuffIdx+1
817 for do quit:((Done=1)!(ArrayI=""))
818 . if $data(Array(ArrayI))#10=0 set Done=1 quit
819 . set s=Array(ArrayI)
820 . set EntireBuff(PasteI,0)=s
821 . set PasteI=PasteI+IndexInc
822 . if PasteI>NextNoteI do quit
823 . . do ShowError^TMGDEBUG(PriorErrorFound,"Insufficient room to put note back into upload buffer.")
824 . . set Done=1
825 . set ArrayI=$order(Array(ArrayI))
826
827 Set result=$$WriteWP^TMGDBAPI(8925.2,BuffNum,1,.EntireBuff)
828
829 quit result
830
831
832CompToBuff(ExistingIEN,UplTIEN,UplDate)
833 ;"PURPOSE: To compare the document being uploaded (i.e. in the file 8925.2, TIU upload buffer)
834 ;" to documents already existing in database
835 ;"Input: ExistingIEN -- the document IEN of a pre-existing document in the database.
836 ;" i.e. ^TIU(8925,ExistingIEN,*)
837 ;" UplTIEN=The type number of document being uploaded
838 ;" UplDate -- the date of the document being uploaded.
839 ;" NOTE: See also global-scope variables below that are REQUIRED
840 ;"
841 ;"Output: returns 0 if TEXT or Date different
842 ;" 1 if TEXT only is the same (Title is different)
843 ;" 2 if TEXT & Title are same
844 ;"
845 ;"------------------------------------------------------------------------------------
846 ;"Programming Note: By tracing through the upload code I know that
847 ;" the following variables are set:
848 ;" (I saved DA as BuffNum, and TIUI as BuffIdx)
849 ;"TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params
850 ;"TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params.
851 ;"BuffIdx = the line index of the beginning of the report to be processed (i.e. the line
852 ;" that starts with [TEXT]
853 ;"BuffNum = the index in 8925.2, i.e. ^TIU(8925.2,BuffNum,"TEXT",0)
854 ;" In other words, here BuffNum = the serial index number of the document to be uploaded
855 ;" i.e. 1 for the first, 2 for the second etc.
856 ;" Note 8925.2 is file: TIU UPLOAD BUFFER
857 ;"Note
858 ;" To detect the beginning of the next document, use
859 ;" if MyLine[TIUHSIG then abort
860
861 new MaxUplLine
862 new DocLine,UplLine
863 new DocData,UplData
864 new result set result=0
865 new MaxDocLine,CompLine
866 new DocType,DocName
867 new Break set Break=0
868 new DocDate
869
870 ;"First, see if dates are the same. If not, bail out.
871 set DocDate=$piece(^TIU(8925,ExistingIEN,0),"^",7)
872 if DocDate'=UplDate goto CompExit ;"Quit with result=0
873
874 set MaxUplLine=$piece($get(^TIU(8925.2,BuffNum,"TEXT",0)),"^",3)
875 if MaxUplLine="" goto CompExit
876 set MaxDocLine=$piece($get(^TIU(8925,ExistingIEN,"TEXT",0)),"^",3)
877 if MaxDocLine="" goto CompExit
878
879 set UplLine=BuffIdx
880 set DocLine=0
881
882 ;"Compare the two documents line by line.
883 for i=1:1:(MaxUplLine-UplLine) do if Break goto CompExit
884 . set UplData=$get(^TIU(8925.2,BuffNum,"TEXT",UplLine+i,0))
885 . set DocData=$get(^TIU(8925,ExistingIEN,"TEXT",DocLine+i,0),"x")
886 . if UplData[TIUHSIG set i=MaxUplLine quit
887 . if UplData'=DocData set Break=1 quit
888 . quit
889
890 ;"If we have gotten this far, then the text is an identical match.
891 set result=1
892
893 ;"Now check to see if the dictation type is the same.
894 set DocType=$piece($get(^TIU(8925,ExistingIEN,0)),"^",1)
895 if DocType=UplTIEN set result=2
896
897CompExit
898 quit result
899
900
901 ;------------------------------------------------------------------------
902CreateRec(Document) ;
903 ;"Purpose: Create document record - Returns DA
904 ;"Input: Document -- an array with document info. See GetRecord for documentation
905 ;"Ouput: DocIEN (internal entry number) of entry created, or -1 if failure
906 ;" Errors (if any) returned in Document("ERROR")
907 ;"
908 ;"Note: This was originally taken from TIUEDI3
909
910 ;"new cOKToCont set cOKToCont=1
911 new cAbort set cAbort=0
912 new result set result=1; "cOKToCont
913
914 new DIC,DLAYGO,X,Y,DIE,DR
915
916 new DocIEN set DocIEN=-1
917 new TMGFDA,RecNum,TMGMSG,Flags
918 set TMGFDA(8925,"+1,",.01)="`"_Document(cDocTIEN)
919 set Flags="E"
920
921 ;"======================================================
922 ;"Call UPDATE^DIE -- add new entries in files or subfiles.
923 ;"======================================================
924 do
925 . new $etrap set $etrap="do ErrTrp^TMGDBAPI"
926 . set ^TMP("TMG",$J,"ErrorTrap")=result
927 . set ^TMP("TMG",$J,"Caller")="UPDATE^DIE"
928 . do UPDATE^DIE(Flags,"TMGFDA","RecNum","TMGMSG")
929 . set result=^TMP("TMG",$J,"ErrorTrap")
930 . kill ^TMP("TMG",$J,"ErrorTrap")
931 ;"======================================================
932 ;"======================================================
933
934 if result'=1 goto CRDone ;"1=cOKToCont
935 if $data(TMGMSG("DIERR")) do goto CRDone
936 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
937 . set DocIEN=-1
938 . merge Document("ERROR","DIERR")=TMGMSG
939 do
940 . new index set index=$order(RecNum(""))
941 . if index'="" set DocIEN=+$get(RecNum(index))
942 if DocIEN=0 set DocIEN=-1
943
944CRDone
945 ;"Now check for failure. DocIEN will equal record number, or -1 if failure
946 if DocIEN'>0 do goto CRDone
947 . new n set n=+$get(Document("ERROR","NUM"))+1
948 . set Document("ERROR",n)=$piece(Document(cDocType),"^",3)_" record could not be created."
949 set Document("DOC IEN")=DocIEN
950
951 quit DocIEN
952
953
954
955 ;------------------------------------------------------------------------
956StuffRec(Document,PARENT)
957 ;"Purpose: Stuff fixed field data
958 ;"INPUT:
959 ;" Document = An array containing information to put into document.
960 ;" The array should contain the following:
961 ;" Document("DOC IEN") -- the document IEN
962 ;" Document("PROVIDER IEN") -- the IEN of the provider
963 ;" Document("DFN") -- the patient IEN
964 ;" Document(cVisitIEN) -- a link to a visit entry
965 ;" Document(cStartDate) -- episode begin date/time
966 ;" Document(cEndDate) -- episode end date/time
967 ;" Document(cHspLocIEN) -- hospital location (Document(cVstLocIEN) used NULL)
968 ;" Document(cVstLocIEN) -- visit location.
969 ;" Document(cService) -- service (i.e. FAMILY PRACTICE)
970 ;" Document(cVisitStr)
971 ;" Document("TRANSCRIPTIONIST") -- the name of the transcriptionist
972 ;" Document("CHARACTER COUNT - TRANSCRIPTIONIST'S") -- the char count creditable to transcriptionist
973 ;" Document("LINE COUNT") -- Total line count
974 ;" PARENT: If we are working with an addendum to a document, then
975 ;" parent is the internal entry number of the original parent document
976 ;" Note:DocID can be null if not needed.
977 ;" Note: I don't ever pass a parent, currently
978 ;"
979 ;"NOTE: The following global-scope variables are also referenced
980 ;" TIUDDT
981 ;"Results: Passes back document IEN, or -1 if error.
982 ;" NOTE: if result is -1 then errors are passed back in
983 ;" Document("ERROR") node
984 ;" Document("ERROR",n)="ERROR.. Stuffing new document."
985 ;" Document("ERROR","NUM")=n
986 ;" Document("ERROR","FM INFO")=merge with DIERR array
987
988 new TMGFDA,TMGMSG
989 new RefDate
990 new DocIEN set DocIEN=$get(Document("DOC IEN"),-1)
991 if DocIEN=-1 goto SfRecDone
992 new result set result=DocIEN ;"default to success
993 new ParentDocType
994
995 ;"Field (f) constants
996 new fPatient set fPatient=.02 ;"field .02 = PATIENT
997 new fVisit set fVisit=.03 ;"field .03 = VISIT
998 new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE
999 new fStatus set fStatus=.05 ;"field .05 = STATUS
1000 new fParent set fParent=.06 ;"field .06 = PARENT
1001 new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07)
1002 new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08)
1003 new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME
1004 new fAuthor set fAuthor=1202 ;"field 1202 = PERSON/DICTATOR
1005 new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer
1006 new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION
1007 new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner
1008 new fAttending set fAttending=1209 ;"field 1209 = ATTENDING
1009 new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION
1010 new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE
1011 new fEnteredBy set fEnteredBy=1302 ;"field 1302 = ENTERED BY (a pointer to file 200)
1012 new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload'
1013 new fService set fService=1404 ;"field 1404 = SERVICE
1014 new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by
1015 new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected.
1016 new fCharTrans set fCharTrans=22711 ;"field 22711 = CHAR COUNT -- TRANSCRIPTIONIST
1017 new fLineCount set fLineCount=.1 ;"field .1 = LINE COUNT
1018
1019 ;"8925=TIU DOCUMENT, the file we will edit
1020 ;"do Set8925Value(.TMGFDA,Document("DFN"),fPatient,1) ;"Will file separatedly below.
1021 do Set8925Value(.TMGFDA,Document(cVisitIEN),fVisit,1)
1022 do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fAuthor,1)
1023 do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fExpSigner,1)
1024 do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fAttending,1)
1025 do Set8925Value(.TMGFDA,Document(cHspLocIEN),fHospLoc,1)
1026 do Set8925Value(.TMGFDA,Document(cVstLocIEN),fVisitLoc,1)
1027 do Set8925Value(.TMGFDA,Document("TRANSCRIPTIONIST"),fEnteredBy,0) ;"VA transcriptionist field
1028 do Set8925Value(.TMGFDA,Document("CHARACTER COUNT - TRANSCRIPTIONIST'S"),fCharTrans,0)
1029
1030 if $data(Document("LINE COUNT")) do
1031 . do Set8925Value(.TMGFDA,Document("LINE COUNT"),fLineCount,0)
1032
1033 set ParentDocType=$$DOCCLASS^TIULC1(+$piece(DocIEN,"^",2))
1034 if +ParentDocType>0 do Set8925Value(.TMGFDA,ParentDocType,fParentDoc,1)
1035
1036 if $get(Document("AUTO SIGN"))=1 do
1037 . do Set8925Value(.TMGFDA,"COMPLETED",fStatus,0)
1038 . do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fSignedBy,1)
1039 else do
1040 . do Set8925Value(.TMGFDA,"UNSIGNED",fStatus,0)
1041
1042 if +$get(PARENT)'>0 do
1043 . ;"do Set8925Value(.TMGFDA,Document("DFN"),fPatient,1)
1044 . do Set8925Value(.TMGFDA,Document(cVisitIEN),fVisit,1)
1045 . do Set8925Value(.TMGFDA,Document(cStartDate),fStartDate,0)
1046 . do Set8925Value(.TMGFDA,Document(cEndDate),fEndDate,0)
1047 . do Set8925Value(.TMGFDA,Document(cService),fService,0)
1048 if +$get(PARENT)>0 do
1049 . new NodeZero set NodeZero=$get(^TIU(8925,+PARENT,0))
1050 . new Node12 set Node12=$get(^TIU(8925,+PARENT,12))
1051 . new Node14 set Node14=$get(^TIU(8925,+PARENT,14))
1052 . ;"
1053 . do Set8925Value(.TMGFDA,PARENT,fParent,1)
1054 . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pPatient),fPatient,1)
1055 . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pVisit),fVisit,1)
1056 . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pStrtDate),fStartDate,0)
1057 . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pEndDate),fEndDate,0)
1058 . do Set8925Value(.TMGFDA,$piece(Node12,"^",pHospLoc),fHospLoc,1)
1059 . do Set8925Value(.TMGFDA,$piece(Node14,"^",pService),fService,0)
1060
1061 do Set8925Value(.TMGFDA,$$NOW^TIULC,fEntryDate,0)
1062 do Set8925Value(.TMGFDA,Document(cHspLocIEN),fHospLoc,1)
1063 do Set8925Value(.TMGFDA,Document(cVstLocIEN),fVisitLoc,1)
1064 do Set8925Value(.TMGFDA,Document(cStartDate),fRefDate,0)
1065 do Set8925Value(.TMGFDA,"U",fCapMethod,0) ;" U-->'upload'
1066 ;"do Set8925Value(.TMGFDA,3,fStatus,0)
1067
1068 kill ^TMG("TMP","EDDIE")
1069 ;"merge ^TMG("TMP","EDDIE","INSIDE DOCUMENT")=Document ;"TEMP!!
1070 merge ^TMG("TMP","EDDIE","FDA")=TMGFDA ;"TEMP!!
1071
1072 do FILE^DIE("EK","TMGFDA","TMGMSG")
1073 if $data(TMGMSG("DIERR")) do goto SfRecDone
1074 . set result=-1
1075 . merge Document("ERROR","FM INFO")=TMGMSG("DIERR")
1076
1077 ;" -- [Mark record for deferred crediting of stop code (fld #.11)]: --
1078 if +$get(Document("STOP")) do
1079 . do DEFER^TIUVSIT(DocIEN,+$get(Document("STOP")))
1080
1081 ;"Try storing .02 field separately to avoid weird filing error
1082 kill TMGFDA
1083 kill ^TMG("TMP","EDDIE")
1084 new PtDFN set PtDFN=Document("DFN")
1085 if (+PtDFN'=PtDFN),(PtDFN["`") set PtDFN=$piece(PtDFN,"`",2)
1086 if +PtDFN>0 do
1087 . set TMGFDA(8925,DocIEN_",",.02)=PtDFN
1088 . merge ^TMG("TMP","EDDIE","FDA")=TMGFDA ;"TEMP!!
1089 . do FILE^DIE("K","TMGFDA","TMGMSG")
1090 . if $data(TMGMSG("DIERR")) do
1091 . . set result=-1
1092 . . merge Document("ERROR","FM INFO")=TMGMSG("DIERR")
1093
1094SfRecDone
1095 quit result
1096
1097
1098Set8925Value(TMGFDA,Value,Field,IsIEN)
1099 ;"Purpose: To provide a clean means of loading values into fields, into TMGFDA(8925,DOCIEN)
1100 ;"Input: TMGFDA -- The array to fill
1101 ;" Value -- the value to load
1102 ;" Field -- the field
1103 ;" IsIEN = 1 if value is an IEN
1104 ;"Note: DEPENDS ON GLOBAL-SCOPE VARIABLES: DocIEN,Document
1105
1106 if ($get(Value)'="")&($data(Field)>0) do
1107 . if $get(IsIEN)>0,$extract(Value,1)'="`" set Value="`"_+Value
1108 . if Value'="`0" set TMGFDA(8925,DocIEN_",",Field)=Value
1109 quit
1110
1111
1112
1113 ;"-----------------------------------------------------------------------------------------------
1114 ;"==============================================================================================-
1115 ;" F O L L O W - U P C O D E
1116 ;"==============================================================================================-
1117 ;"-----------------------------------------------------------------------------------------------
1118
1119FOLLOWUP(DocIEN) ;" Post-filing code for PROGRESS NOTES
1120 ;"PURPOSE:
1121 ;" This function is called by the TIU upload document facilities.
1122 ;" it is called after the text has been put into the document
1123 ;"
1124 ;"INPUT:
1125 ;" DocIEN -- is passed a value held in TIUREC("#"), i.e.
1126 ;" do FOLLOWUP^TIUPUTN1(TIUREC("#")).
1127
1128 write !
1129 write "+-------------------------------------+",!
1130 write "| Starting Follow-up code... |",!
1131 write "+-------------------------------------+",!
1132
1133 if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1
1134 if $data(cAbort)#10=0 new cAbort set cAbort=0
1135
1136 new DBIndent,PriorErrorFound
1137 new result set result=1 ;" 1=cOKToCont
1138
1139 new Document merge Document=TMGDOC
1140
1141 new cStartDate set cStartDate="EDT"
1142 new cEndDate set cEndDate="LDT"
1143 new cService set cService="SVC"
1144 new cDocType set cDocType="TYPE"
1145 new cDocTIEN set cDocTIEN="TYPE IEN"
1146 ;"new cDocIEN set cDocIEN="DOC IEN"
1147 ;"new cPatIEN set cPatIEN="DFN" ;"DFN = Patient IEN
1148 new cHspLocIEN set cHspLocIEN="LOC"
1149 new cVstLocIEN set cVstLocIEN="VLOC"
1150 new cVisitStr set cVisitStr="VSTR"
1151 new cVisitIEN set cVisitIEN="VISIT"
1152 new cStopCode set cStopCode="STOP"
1153
1154 ;" 'p constants
1155 new pPatient set pPatient=2 ;"Node 0,piece 2 = PATIENT (field .02)
1156 new pVisit set pVisit=3 ;"Node 0,piece 3 = VISIT (field .03)
1157 new pStrtDate set pStrtDate=7 ;"Node 0,piece 7 = EPISODE BEGIN DATE/TIME (field .07)
1158 new pEndDate set pEndDate=8 ;"Node 0,piece 8 = EPISODE END DATE/TIME (field .08)
1159
1160 new pAuthor set pAuthor=2 ;"Node 12,piece 2 = AUTHOR/DICTATOR (field 1202)
1161 new pExpSigner set pExpSigner=4 ;"Node 12,piece 4 = EXPECTED SIGNER (field 1204)
1162 new pHospLoc set pHospLoc=5 ;"Node 12,piece 5 = field 1205 = HOSPITAL LOCATION
1163 new pAttending set pAttending=9 ;"Node 12,piece 9 = ATTENDING PHYSICIAN (field 1209)
1164 new pExpCosign set pExpCosign=8 ;"Node 12,piece 8 = EXPECTED COSIGNER (field 1210)
1165 new pVstLoc set pVstLoc=11 ;"Node 12,piece 11 = field 1211 = VISIT LOCATION
1166
1167 ;"Field (f) constants
1168 new fPatient set fPatient=.02 ;"field .02 = PATIENT
1169 new fVisit set fVisit=.03 ;"field .03 = VISIT
1170 new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE
1171 new fStatus set fStatus=.05 ;"field .05 = STATUS
1172 new fParent set fParent=.06 ;"field .06 = PARENT
1173 new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07)
1174 new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08)
1175 new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME
1176 new fAuthor set fAuthor=1202 ;"field 1202 = AUTHOR/DICTATOR
1177 new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer
1178 new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION
1179 new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner
1180 new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION
1181 new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE
1182 new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload'
1183 new fService set fService=1404 ;"field 1404 = SERVICE
1184 new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected.
1185 new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by
1186
1187 new TMGFDA,TMGMSG
1188 new DFN
1189 new Attending,ExpSigner,ExpCosign,Author
1190 new BailOut set BailOut=0
1191 new Node12 set Node12=$get(^TIU(8925,DocIEN,12))
1192 new NodeZero set NodeZero=$get(^TIU(8925,DocIEN,0))
1193 if $data(Document)=0 new Document
1194
1195 set Author=+$piece(Node12,"^",pAuthor)
1196 set Attending=+$piece(Node12,"^",pAttending)
1197 set ExpCosign=+$piece(Node12,"^",pExpCosign)
1198 set ExpSigner=+$piece(Node12,"^",pExpSigner)
1199
1200 do
1201 . new Signer set Signer=$$WHOSIGNS^TIULC1(DocIEN)
1202 . do Set8925Value(.TMGFDA,$$WHOSIGNS^TIULC1(DocIEN),fExpSigner,1)
1203
1204 if (Attending>0)&(ExpCosign=0) do
1205 . do Set8925Value(.TMGFDA,$$WHOCOSIG^TIULC1(DocIEN),fExpCosign,1)
1206
1207 if (ExpCosign>0)&(ExpSigner'=ExpCosign) do
1208 . do Set8925Value(.TMGFDA,1,fNeedCosign,0)
1209
1210 set result=$$dbWrite^TMGDBAPI(.TMGFDA,1)
1211 if result=-1 goto FUDone
1212
1213 do RELEASE^TIUT(DocIEN,1) ;"Call function to 'Release Document from transcription'
1214 do AUDIT^TIUEDI1(DocIEN,0,$$CHKSUM^TIULC("^TIU(8925,"_+DocIEN_",""TEXT"")")) ;"Update audit trail
1215
1216 if '$data(Document) do if (BailOut=1) goto FUDone
1217 . new VstLocIEN,HspLocIEN,StartDate,EndDate
1218 . if $data(NodeZero)#10=0 do quit
1219 . . set BailOut=1
1220 . set DFN=+$piece(NodeZero,"^",pPatient)
1221 . set StartDate=+$piece(NodeZero,"^",pStrtDate)
1222 . set EndDate=$$FMADD^XLFDT(StartDate,1)
1223 . set Document(cHspLocIEN)=+$piece(Node12,"^",pHospLoc)
1224 . set Document(cVstLocIEN)=+$piece(Node12,"^",pVstLoc)
1225 . set VstLocIEN=Document(cVstLocIEN)
1226 . if VstLocIEN'>0 set VstLocIEN=Document(cHspLocIEN)
1227 . if (DFN>0)&(StartDate>0)&(EndDate>0)&(VstLocIEN>0) do
1228 . . ;"This is an interactive visit ....
1229 . . do MAIN^TIUVSIT(.Document,DFN,"",StartDate,EndDate,"LAST",0,VstLocIEN)
1230
1231 if $data(Document)=0 goto FUDone
1232 if $data(Document(cVisitStr))#10=0 goto FUDone
1233 if $data(DFN)=0 set DFN=$get(Document("DFN")) if DFN="" goto FUDone
1234
1235 ;"Note: reviewing the code for ENQ^TIUPXAP1, it appears the following is expected:
1236 ;" .TIU array
1237 ;" DFN -- the patient IEN
1238 ;" DA -- the IEN of the document to work on.
1239 ;" TIUDA -- the doc IEN that was passed to this function.
1240 ;" Note, I'm not sure how DA and TIUDA are used differently.
1241 ;" In fact, if $data(TIUDA)=0, then function uses DA.
1242 ;" Unless I kill TIUDA (which might cause other problems), I don't
1243 ;" know if TIUDA will hold an abherent value. So I'll set to DA
1244 do
1245 . new TIUDA set TIUDA=DocIEN
1246 . new DA set DA=DocIEN
1247 . new TIU merge TIU=Document
1248 . do ENQ^TIUPXAP1 ;" Get/file VISIT
1249
1250FUDone ;
1251 kill TMGDOC
1252 quit
1253
1254
1255 ;"-----------------------------------------------------------------------------------------------
1256 ;"==============================================================================================-
1257 ;" R E - F I L I N G C O D E
1258 ;"==============================================================================================-
1259 ;"-----------------------------------------------------------------------------------------------
1260
1261REFILE
1262 ;"Purpose: Somtimes the upload process fails because of an error in the
1263 ;" upload filing code. Rather than require a re-upload of the file,
1264 ;" this function will trigger a retry of filing the TIU UPLOAD BUFFER
1265 ;" (file 8925.2)
1266 ;"This function is called by menu option TMG REFILE UPLOAD
1267
1268 new TIUDA set TIUDA=""
1269 new job
1270 new DoRetry set DoRetry=""
1271 new Abort set Abort=0
1272 new Found set Found=0
1273
1274 write !,!
1275 write "------------------------------------------------",!
1276 write " Refiler for failed uploads (i.e. a second try.)",!
1277 write "------------------------------------------------",!,!
1278
1279 write "Here are all the failed uploads:",!,!
1280 set job=$order(^TIU(8925.2,"B",""))
1281 for do quit:(job="")
1282 . new Buff,NextBuff
1283 . if job="" quit
1284 . set Buff=$order(^TIU(8925.2,"B",job,""))
1285 . for do quit:(Buff="")
1286 . . if Buff="" quit
1287 . . write "Buffer #"_Buff_" (created by process #"_job_")",!
1288 . . set Found=1
1289 . . set Buff=$order(^TIU(8925.2,"B",job,Buff))
1290 . set job=$order(^TIU(8925.2,"B",job))
1291
1292 if Found=0 write "(There are no failed uploads to process... Great!)",!
1293 else write "------------------------------------------------",!
1294
1295 set job=$order(^TIU(8925.2,"B",""))
1296 for do quit:(job="")!(Abort=1)
1297 . new Buff,NextBuff
1298 . if job="" quit
1299 . set Buff=$order(^TIU(8925.2,"B",job,""))
1300 . for do quit:(Buff="")!(Abort=1)
1301 . . if Buff="" quit
1302 . . if DoRetry'="all" do
1303 . . . write !,"Refile upload buffer #"_Buff_" (created by process #"_job_")? (y/n/all/^) "
1304 . . . read DoRetry:$get(DTIME,300),!
1305 . . else do
1306 . . . new GetKey
1307 . . . read *GetKey:0
1308 . . . if $get(GetKey)=27 set DoRetry="n"
1309 . . . else write !,!,"Processing upload buffer #",Buff,!
1310 . . if DoRetry="^" set Abort=1 quit
1311 . . if (DoRetry["y")!(DoRetry["Y")!(DoRetry="all") do
1312 . . . set TIUDA=Buff
1313 . . . ;"These is an edited form of MAIN^TIUUPLD
1314 . . . N EOM,TIUERR,TIUHDR,TIULN,TIUSRC,X
1315 . . . I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
1316 . . . S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11)
1317 . . . I EOM']"",($P(TIUPRM0,U,17)'="k") do quit
1318 . . . . W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",!
1319 . . . S:TIUSRC']"" TIUSRC="R"
1320 . . . S TIUHDR=$P(TIUPRM0,U,10)
1321 . . . I TIUHDR']"" do quit
1322 . . . . W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",!
1323 . . . new temp set temp=$order(^TIU(8925.2,TIUDA,"TEXT",0))
1324 . . . write "First line of TEXT=",temp,!
1325 . . . I +$O(^TIU(8925.2,TIUDA,"TEXT",0))>0 do
1326 . . . . write "Calling FILE^TIUUPLD("_TIUDA_")",!
1327 . . . . D FILE^TIUUPLD(TIUDA)
1328 . . . I +$O(^TIU(8925.2,TIUDA,"TEXT",0))'>0 D BUFPURGE^TIUPUTC(TIUDA)
1329 . . set Buff=$order(^TIU(8925.2,"B",job,Buff))
1330 . set job=$order(^TIU(8925.2,"B",job))
1331
1332 write !,"------------------------------------------------",!
1333 write " All done with Refiler",!
1334 write "------------------------------------------------",!,!
1335
1336RFDone
1337 Q
1338
1339
1340
1341
Note: See TracBrowser for help on using the repository browser.