TMGPUTN0 ;TMG/kst/TIU Document Upload look-up function ;03/25/06; 5/2/10 ;;1.0;TMG-LIB;**1**;04/25/04 ;"TIU Document Upload look-up function ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"4-25-2004 LOOKUP(DocTitle,Autosign) ; ;"----------------------------------------------------------------------------------- ;"Upload look-up function ;"by Kevin Toppenberg ;"4-25-2004 ;" ;"PURPOSE: ;"This code is used as look-up code by the TIU document upload routines. ;"It has a very specific purpose. It was written for uploading documents ;" from a Medic EMR system. Notes had been dumped out of that system, and ;" were to be ported into VistA ;"Each note has a header with patient name, dob, ssnum, chart#, provider ;"Addendum -- this code will also work with less extensive patient data. ;" ;"INPUT ;" The variable (with global scope) listed below are expected as input. ;" Not all will be required every time, however. ;" DocTitle -- this is the type of document type. i.e. 'OFFICE VISIT' ;" This will be used so that this code can service multiple ;" types, i.e. NOTE, PRESCRIPTION CALL IN, etc. ;" Autosign -- [OPTIONAL] if value=1 then document will be created as SIGNED ;"Results: Document number that uploaded code should be put into is returned in variable Y ;" ;" ;"*How it works*: ;"A remote computer connects to the server running VistA. This remote computer must be ;" able to upload a file using kermit. The only way I know to do this is to be on a PC ;" using a terminal emulator program that has kermit upload ability. ;"From this remote session, get into the TIU menu system and navigate to the option to ;" upload a document. Note, one's upload parameters must be set up for this to work. ;"The remote user will see a #N3, and use this que to acutally upload the file. ;"After the file is uploaded, it is then processed. Each document specifies what 'type' it is ;" for example 'OFFICE VISIT' ;"The server then loads up the parameters for OFFICE VISIT and processes each item in the header. ;"Here is an example progress note that this file can process ;"-------------------------------------- ;"[NewDict]: OFFICE VISIT ;"Name: JONES,BASKETBALL ;"Alias: JONES,BOB ;"DOB: 4/13/71 ;"Sex: MALE ;"SSNumber: 555 11 9999 ;"ChartNumber: 10034 ;"Date: 7/22/2002 ;"Location: Peds_Office ;"Provider: KEVIN TOPPENBERG MD ;"[TEXT] ;" ;" CHIEF COMPLAINT: Follow up blood clot. ;" ;" HPI: ;" 1. BJ was in the emergency room 3 days ago. He was being ;" evaluated for left lower extremity pain. He said that they did ;" radiographic studies and told him that he had a blood clot in ;" .... (snip) ;" ;"[END] ;"-------------------------------------- ;"[NewDic] tells the system that a document header is starting ;"'Name' is a CAPTION, and the value for this caption is 'JONES,BASKETBALL' ;"The upload system will put this value into a variable. In this case, I specified ;" that the variable name TMGNAME to be used. ;" ;"Here are each caption and its cooresponding Variable: ;"Name <--> TMGNAME ;"DOB <--> TMGDOB ;"Sex <--> TMGSEX ;"SSNumber <--> TMGSSNUM ;"ChartNumber <--> TMGPTNUM ;"Date <--> TIUVDT ;"Provider <--> PERSON ;"Alias <--> TMGALIAS ;"Location: <--> TIULOC ;" ;"Document Title is passed to function as 'DocTitle' ;" ;"After the note has been processed and all the above variables have been set, the server ;"calls a 'look-up' function. This function is supposed to return the document number where the ;"text is supposed to be put (the number should be put in Y) ;" ;"This look-up function has an extra twist. I am using it to register patients on the fly ;" if needed. I am doing this because I had about 30,000 patients in my database to transfer, ;" and I had difficulty getting a separate file with just demographics etc. So, if a patient ;" is not already in the database, they are registered here. ;" ;"Extra note: ;"When this function is called, the TIU upload process has already set up some variables. ;"DA = the IEN in 8925.2, i.e. ^TIU(8925.2,DA,"TEXT",0) that the uploaded text was temporarily store in. ;" In other words, here DA = the serial index number of the document to be uploaded ;" i.e. 1 for the first, 2 for the second etc. ;"TIUI = the line index of the beginning of the report to be processed (i.e. the line ;" that starts with [TEXT] ;"DUZ = Current user number. ;"TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params ;"TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. write "+-------------------------------------+",! write "| Starting upload code... |",! write "+-------------------------------------+",! set BuffNum=$get(DA) ;"Store which upload buffer we are working on. set BuffIdx=$get(TIUI) ;"Store line number (in upload buffer) we are starting with. new cMaxNoteWidth set cMaxNoteWidth=60 ;"Field (f) constants new fPatient set fPatient=.02 ;"field .02 = PATIENT new fVisit set fVisit=.03 ;"field .03 = VISIT new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE new fStatus set fStatus=.05 ;"field .05 = STATUS new fParent set fParent=.06 ;"field .06 = PARENT new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07) new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08) new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME new fAuthor set fAuthor=1202 ;"field 1202 = PERSON/DICTATOR new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner new fAttending set fAttending=1209 ;"field 1209 = ATTENDING new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE new fEnteredBy set fEnteredBy=1302 ;"field 1302 = ENTERED BY (a pointer to file 200) new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload' new fService set fService=1404 ;"field 1404 = SERVICE new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected. new fCharTrans set fCharTrans=22711 ;"field 22711 = CHAR COUNT -- TRANSCRIPTIONIST new fLineCount set fLineCout=.1 ;"field .1 = LINE COUNT ;" Piece (p) constants new pPatient set pPatient=2 ;"Node 0,piece 2 = PATIENT (field .02) new pVisit set pVisit=3 ;"Node 0,piece 3 = VISIT (field .03) new pStrtDate set pStrtDate=7 ;"Node 0,piece 7 = EPISODE BEGIN DATE/TIME (field .07) new pEndDate set pEndDate=8 ;"Node 0,piece 8 = EPISODE END DATE/TIME (field .08) new pExpSigner set pExpSigner=4 ;"Node 12,piece 4 = EXPECTED SIGNER (field 1204) new pHospLoc set pHospLoc=5 ;"Node 12,piece 5 = HOSPITAL LOCATION (field 1205) new pExpCosign set pExpCosign=8 ;"Node 12,piece 8 = EXPECTED COSIGNER (field 1210) new pAttending set pAttending=9 ;"Node 12,piece 9 = ATTENDING PHYSICIAN (field 1209) new pService set pService=4 ;"Node 14,piece 4 = SERVICE (field 1404) if $data(cAbort)#10=0 new cAbort set cAbort=0 new DBIndent,PriorErrorFound new Patient new DocIEN set DocIEN=-1 new Document new NewDoc set NewDoc=0 new result set result=1 ;"cOKToCont do PtArrayCreate(.Patient) ;"Load upload info into Patient array set result=$$DocArrayCreate(.Document) ;"Load upload document info into Document array if result=cAbort goto LUDone set Document("DFN")=$$GetDFN^TMGGDFN(.Patient) ;"Store DFN of patient. if Document("DFN")'>0 set result=cAbort goto LUDone ;"Abort. set Document("AUTO SIGN")=$get(Autosign,1) ;"default to YES auto-signing ;"06-19-05 Changed to disable autosigning. If document is ;" autosigned here, then no prompt for printing elsewhere. ;"9-1-05 Resuming autosigning. Currently the outside transcriptionists are already ;" printing the notes before giving them to us for upload. ;" Changed default to be YES autosign ;"set Document("AUTO SIGN")=0 ;"override setting passed in... set Document("CHARACTER COUNT - TRANSCRIPTIONIST'S")=$$BuffCharCount() ;"Count character prior to any wrapping/merging etc. set result=$$PrepUploadBuf() ;"Do any word-wrapping etc needed in upload buffer if result=cAbort goto LUDone set DocIEN=$$PrepDoc(.Document,.NewDoc) ;"Prepair a document to put upload into. Credits transcription set Y=DocIEN merge TMGDOC=Document ;"Create a global -- will kill after followup code LUDone ;"put result into Y. TIU filing system looks for results in Yi if result=cAbort set Y=-1 quit ;"----------------------------------------------------------------------------------------------- ;"==============================================================================================- ;" S U B R O U T I N E S ;"==============================================================================================- ;"----------------------------------------------------------------------------------------------- ;"PtArrayCreate(Array) ;"DocArrayCreate(Document) ;"PrepDoc(Document,NewDoc); ;"GetDocTIEN(Title) ;"GetLocIEN(Location) ;"GetService(IEN) ;"GetProvIEN(Provider) ;"GetRecord(Document,NewDoc,AskOK,Editable) ;"DocExists(Document) ;"BuffCharCount() ;"PrepUploadBuf() ;"NeedsReformat(MaxWidth) ;"CutNote(Array) ;"PasteNote(Array,NextNoteI) ;"CompToBuff(ExistingIEN,UplTIEN,UplDate) ;"CreateRec(Document) ; ;"StuffRec(Document,PARENT) ;"MakeVisit(Document) ;"FOLLOWUP(DocIEN) ;Post-filing code for PROGRESS NOTES PtArrayCreate(Array) ;"SCOPE: Private ;"Purpose: To put global scope vars (i.e. TMGNAME,TMGSSNUM etc) into ;" an array for easier portability ;"Input: Array, must be passed by reference ;" The global-scope variables setup by the upload system, and are used here: ;" TMGPTNUM,TMGSSNUM,TMGSSNUM,TMGNAME,TMGDOB,TMGSEX ;"Output: Array is loaded with info, like this: ;" set Array("SSNUM")="123-45-6789" ;" set Array("NAME")="DOE,JOHN" ;" set Array("DOB")=TMGDOB ;" set Array("PATIENTNUM")="12345677" ;" set Array("SEX")="M" ;" set Array("ALIAS")="DOE,JOHNNY" ;"Results: none if $data(TMGPTNUM)#10'=0 do . set TMGPTNUM=$translate(TMGPTNUM,"PWCI*","") ;"Clean off alpha characters -- not needed. . ;"set TMGPTNUM=$$Trim^TMGSTUTL(TMGPTNUM) . set TMGPTNUM=$$FORMAT^DPTNAME(.TMGPTNUM,3,30) ;"Use same input transform as for .01 field of PATIENT file . set Array("PATIENTNUM")=TMGPTNUM if $data(TMGSSNUM)#10'=0 do . set TMGSSNUM=$translate(TMGSSNUM," /-","") ;"Clean delimiters . if +TMGSSNUM=0 set TMGSSNUM="" ;was ... "P" . if (TMGSSNUM="P")!(+TMGSSNUM>0) set Array("SSNUM")=TMGSSNUM set Array("NAME")=$$FormatName^TMGMISC(.TMGNAME) if $data(TMGALIAS)#10'=0 do . set TMGALIAS=$translate(TMGALIAS,"*","") . set TMGALIAS=$$FORMAT^DPTNAME(TMGALIAS,3,30) ;"convert to 'internal' format (strip .'s etc) . set Array("ALIAS")=TMGALIAS if $data(TMGSEX)#10'=0 do . set TMGSEX=$$UP^XLFSTR($get(TMGSEX)) . if TMGSEX="M" set TMGSEX="MALE" . else if TMGSEX="F" set TMGSEX="FEMALE" . set Array("SEX")=TMGSEX if $data(TMGDOB)#10'=0 do . if +TMGDOB>0 set Array("DOB")=TMGDOB . else quit . new CurDate,CurYr . do DT^DILF("E","T",.CurDate) . set CurDate=$get(CurDate(0)) . if CurDate="" quit . set CurYr=$piece(CurDate,", ",2) . new DOBYr . set DOBYr=$piece(TMGDOB,"/",3) . if DOBYr>CurYr do ;"we have a Y2K problem . . set DOBYr=DOBYr-100 . . if DOBYr'>0 quit . . set TMGDOB=$piece(TMGDOB,"/",1,2)_"/"_DOBYr . . set Array("DOB")=TMGDOB quit DocArrayCreate(Document) ;"SCOPE: Private ;"Purpose: To put TIUVDT etc. etc into an array for easier portibility ;"Input: Document -- OUT parameter, must be passed by reference ;" The global-scope variables setup by the upload system are used: ;" TIUVDT,PERSON,TIULOC, (and also DocTitle) ;"Output: Document is loaded with info. ;"Results: 1=OKToCont, or cAbort new result set result=1 ;"cOKToCont set Document("PROVIDER")=$get(PERSON) if Document("PROVIDER")="" do goto DACDone . set result=cAbort set Document("PROVIDER IEN")=$$GetProvIEN(Document("PROVIDER")) set Document("LOCATION")=$get(TIULOC,"Main_Office") set Document("DATE")=$get(TIUVDT) set Document("TITLE")=$get(DocTitle,"NOTE") ;"Decide which transcriptionist is. This will be used for crediting productivity. ;"If transcriptionist not specified, current user (DUZ) is assumed. if $data(TMGTRANS)#10=0 set TMGTRANS=$piece($get(^VA(200,DUZ,0)),"^",1) set Document("TRANSCRIPTIONIST")=$$FormatName^TMGMISC(TMGTRANS) if (Document("DATE")="")!(Document("DATE")="00/00/00") do goto DACDone . set result=cAbort DACDone quit result PrepDoc(Document,NewDoc); ;"Scope: PRIVATE. ;" Addendum 7/25/07. Will be called by RPC call BLANKTIU^TMGRPC1 ;" to return a blank document ;"Purpose: Prepair a document to put upload into. ;"Input: Document -- an array as follows: ;" Document("DFN")=DFN, the record number of the patient. ;" Document("PROVIDER IEN")= the IEN of the provider ;" Document("LOCATION")= the location of the visit ;" Document("DATE")= the date of the visit. ;" Document("TITLE")= the title of the note ;" Document(cVisitStr) an OUT PARAMETER ;" Document("TRANSCRIPTIONIST") -- the name of the transcriptionist ;" Document("CHARACTER COUNT - TRANSCRIPTIONIST'S") -- the char count creditable to transcriptionist ;" NewDoc: OPTIONAL flag, passed back with ;" NewDoc = 1 if returned docmt is new ;" NewDoc = 0 if returned docmt already existed, timeout, etc ;"Results: returns record number (IEN) ready to accept upload (or -1 if failure) ;" Also Document("DOC IEN") will have this same IEN ;" NOTE: if result is -1 then errors are passed back in ;" Document("ERROR") node ;" Document("ERROR",n)="ERROR.. Stuffing new document." ;" Document("ERROR","NUM")=n ;" Document("ERROR","FM INFO")=merge with DIERR array ;" PIEN = patient internal entry number ;" Global-Scope variables expected: ;" PERSON, TMGSSNUM etc. defined above ;" TIUVDT expected ;" TIULOC is also expected (i.e. 'LAUGHLIN_OFFICE') ;" ;"Output: will return document number, or -1 if failure. ;"NOTES: This originated from ^TIUPUTPN ;" ;" Look-up code used by router/filer ;" Required variables: TMGSSNUM, TIUVDT ;" i.e., TMGSSNUM (Pt SS-Number) and TIUVDT (visit date) must be set prior to call. ;" new cStartDate set cStartDate="EDT" new cEndDate set cEndDate="LDT" new cService set cService="SVC" new cDocType set cDocType="TYPE" new cDocTIEN set cDocTIEN="TYPE IEN" new cHspLocIEN set cHspLocIEN="LOC" new cVstLocIEN set cVstLocIEN="VLOC" new cVisitStr set cVisitStr="VSTR" new cVisitIEN set cVisitIEN="VISIT" new cStopCode set cStopCode="STOP" new TMG,DFN new TIUDAD,TIUEDIT new TIULDT,TIUXCRP,DocTIEN new LocIEN new result set result=-1 set NewDoc=0 set Document(cStartDate)=$$IDATE^TIULC(Document("DATE")) ;"Convert date into internal format set Document(cEndDate)=Document(cStartDate) ;"For office notes, begin and end dates will be the same. ;"Setup DocTIEN -- to be used below as [MAS Movement event type] ;"Convert Document title into IEN, i.e. OFFICE VISIT --> 128 set DocTIEN=$$GetDocTIEN(Document("TITLE")) if +DocTIEN'>0 do goto PrepDocX . set Document("ERROR",1)="ERROR: Unable to determine note type from title: "_Document("TITLE") . set Document("ERROR","NUM")=1 ;"Purpose: setup Document(cDocType) -- used below as: Title info variable of form: ;" Setup string in form of: 1^title IEN^title Name ;" e.g.: 1^128^OFFICE VISIT^OFFICE VISIT set Document(cDocTIEN)=DocTIEN set Document(cDocType)=1_"^"_DocTIEN_"^"_$$PNAME^TIULC1(DocTIEN) ;"do MAIN^TIUVSIT(.TIU,.DFN,TMGSSNUM,Document(cStartDate),Document(cEndDate),"LAST",0,Document("LOCATION")) ;" setup LocIEN from HOSPITAL LOCATION file (#44) ;" This contains entries like 'Laughlin_Office' set LocIEN=+$$GetLocIEN(Document("LOCATION")) if '$data(^SC(LocIEN,0)) do goto PrepDocX ;"^SC(*) is file 44, Hospital Location . set Document("ERROR",1)="ERROR: Unable to process location: "_Document("LOCATION") . set Document("ERROR","NUM")=1 set Document(cService)=$$GetService(Document("PROVIDER IEN")) ;"i.e. FAMILY PRACTICE set Document(cVisitStr)="x;x;"_DocTIEN ;"LOC;VDT;VTYP set Document(cVisitIEN)=0 ;"Visit File IFN set Document(cHspLocIEN)=LocIEN set Document(cVstLocIEN)=LocIEN set Document(cStopCode)=0 ;"0=FALSE, don't worry about stop codes. set result=$$GetRecord(.Document,.NewDoc,0) if result'>0 do goto PrepDocX . new n set n=+$get(Document("ERROR","NUM"))+1 . set Document("ERROR",n)="ERROR.. after creating new document." . set Document("ERROR","NUM")=n ;"At this point, any merging has been done (once implemented) ;"So a character count of now will be a total/combined character count set Document("CHAR COUNT - TOTAL")=$$BuffCharCount ;"Count character after any wrapping/merging etc. ;"Now, we need the standard CHARARACTERS/LINE value stored in field .03 of TIU PARAMETERS (in ^TIU(8925.99)) ;"For my setup, I have only have one record for in this file, so I'll use IEN=1. new CharsPerLine set CharsPerLine=$piece($get(^TIU(8925.99,1,0)),"^",3) if CharsPerLine'=0 do . new IntLC,LC,Delta . set LC=Document("CHAR COUNT - TOTAL")\CharsPerLine . set IntLC=Document("CHAR COUNT - TOTAL")\CharsPerLine ;" \ is integer divide . set Delta=(LC-IntLC)*10 . if Delta>4 set IntLC=IntLC+1 ;"Round to closest integer value. . set Document("LINE COUNT")=IntLC set result=$$StuffRec(.Document,0) ;"Will load Document("ERROR","FM INFO") with any FM errors if +$get(result)'>0 do goto PrepDocX . new n set n=+$get(Document("ERROR","NUM"))+1 . set Document("ERROR",n)="ERROR.. Stuffing new document." . set Document("ERROR","NUM")=n PrepDocX quit result ;"result is document # MakeVisit(Document) ;"Purpose -- to create a new entery in the VISIT file, based on info in Document. ;"Input -- Document -- array with following info: ;" Document("DFN")=DFN, the record number of the patient. ;" Document("PROVIDER")= the provider of care for the note ;" Document("PROVIDER IEN")= the IEN of the provider ;" Document("LOCATION")= the location of the visit ;" Document("DATE")= the date of the visit. ;"Result -- returns IEN of visit entry ;"Note -- this function is not now being used... new TMGFDA ;set TMGFDA(9000010,"?+1,",.01)= ;".01=VISIT/ADMIT DATE&TIME ;set TMGFDA(9000010,"?+1,",.02)= ;".02=DATE VISIT CREATED ;set TMGFDA(9000010,"?+1,",.03)="O" ;".02=VISIT TYPE -- O=Other ;set TMGFDA(9000010,"?+1,",.05)= ;".05=PATIENT NAME ;set TMGFDA(9000010,"?+1,",15001)="10C1-TEST" ;"15001=VISIT ID ;LOCATION NAME --> Medical Group of Greeneville ;SERVICE CATEGORY: A --> AMBULATORY ;DSS ID: PRIMARY CARE/MEDICINE ;HOSPITAL LOCATION: Laughlin_Office ;Created by user: DUZ quit GetDocTIEN(Title) ;"Purpose: To return IEN for document *type defination* / Identify document title ;"Input Title -- the Text Title to look up ;"Results: Returns the document definition IFN (i.e. Y) new DIC,Y,X new TIUFPRIV set TIUFPRIV=1 set DIC=8925.1 set DIC(0)="M" set DIC("S")="IF $PIECE(^TIU(8925.1,+Y,0),""^"",4)=""DOC""" set X=Title do ^DIC kill DIC("S") if $find(Y,"^")>0 set Y=$piece(Y,"^",1) quit Y GetLocIEN(Location) ;"Scope: PRIVATE ;"Purpose: To return IEN for location ;"Input: Location -- the Location to look up. ;"Results: returns LocationIEN (i.e. Y) new DIC,X,Y set DIC=44 ;"file 44 is HOSPITAL LOCATION set DIC(0)="M" set X=Location do ^DIC ;" do a , value is returned in Y if $find(Y,"^")>0 set Y=$piece(Y,"^",1) quit Y GetService(IEN) ;"Scope: PRIVATE ;"Purpose: Get the Service for the Provider ;"Input: IEN -- the IEN of the Provider to look up. ;"Results: returns the Name of the Service for provider, or "" if not found new result set result="" new node,SvIEN if IEN=-1 goto GtSvDone set node=$get(^VA(200,IEN,5)) ;"^VA(200, is NEW PERSON file set SvIEN=+$piece(node,"^",1) if SvIEN=0 goto GtSvDone set node=$get(^DIC(49,SvIEN,0)) ;"^DIC(49, is the SERVICE/SECTION file set result=$piece(node,"^",1) GtSvDone quit result GetProvIEN(Provider) ;"Scope: PRIVATE ;"Purpose: To return IEN for Provider ;"Input: Provider -- the Provider to look up. ;"Results: returns Provider's IEN (i.e. Y), or -1 if not found new DIC,X,Y set DIC=200 ;"file 200 is NEW PERSON set DIC(0)="M" set X=Provider do ^DIC ;" do a , value is returned in Y if $find(Y,"^")>0 set Y=$piece(Y,"^",1) quit Y GetRecord(Document,NewDoc,AskOK,Editable) ;"Scope: PRIVATE ;"PURPOSE: ;" To get a record--either via creating a new one, or returning an existing one ;" Note: If an existing one is returned, it will be emptied first... ;" ;" Note: If I want to merge part of what the doctor creates with what the ;" transcriptionist uploads, here what I should do ;" 1. Look for an existing document with same date as document being uploaded. ;" 2. If found, look in existing document for merge symbols (i.e. {{1}} } ;" 3. If found, then take code from existing document and current part ;" of upload buffer, and create a merged document. ;" 4. Put this merged document back into the upload buffer. ;" 5. Empty the existing document, and return its IEN from this function ;" ;"INPUT: Document -- array with Document("DFN"), Document(cDocType) are REQUIRED. ;" [Document] --> Visit info array -- SHOULD PASS BE REFERENCE. ;" Document("DFN") = patient DFN ;" Document(cVisitStr) = LOC;VDT;VTYP e.g. 'x;x;OFFICE VISIT' ;" Document(cVisitIEN) = VISIT file IFN e.g. 0, used for field .03 in file 8925. Pointer to file #9000010 ;" Document(cHspLocIEN) i.e. Hospital location IEN. Used for field 1205 in 8925. Pointer to file #44 ;" Document(cVstLocIEN) i.e. visit location IEN. Used for field 1211 in 8925. Pointer to file #44 ;" Document(cStopCode) = mark to defer workload e.g. 0/FALSE=don't worry about stop codes. ;" USED FOR: Mark record for deferred crediting of stop code (fld #.11) ;" This boolean field (.11) indicates whether the stop code associated with a new ;" visit should be credited when the note is completed. ;" Note: if Document('STOP')="", then not processed. ;" Document(cDocType)=1^title DA^title Name i.e.: 1^128^OFFICE VISIT^OFFICE VISIT ;" Document(cDocTIEN)=DocTIEN (a.k.a. title DA) e.g. 128 ;" Document(cService) e.g.FAMILY PRACTICE ;" Document(cStartDate) i.e. event begin time ;" Document(cEndDate) i.e. event end time ;" [NewDoc] --> flag, passed back with ;" NewDoc = 1 if returned docmt is new ;" NewDoc = 0 if returned docmt already existed, timeout, etc ;" [AskOK] --> Ask user flag, where ;" AskOK = 1: ask re edit/addend existing docmt ;" (Interactive List Manager options, TRY docmt def) ;" AskOK = 0: don't ask (Upload & GUI options) ;" [Editable]-->flag, passed back with Editable = 1 if returned ;" PREEXISTING docmt can be edited by Provider. If ;" preexisting docmt returned and 'Editable, then ;" docmt cannot be edited by Provider. ;" ;"Results: Returns DocIEN -- IEN of document to use, or -1 if error etc. ;" Also, Document("DOC IEN") is set to DocIEN ;" Errors will be returned in Document("ERROR") ;" ;"Note: Code originally from GETRECNM^TIUEDI3 -- KT 5/25/04 new MultOK set MultOK=1 new DocIEN set DocIEN=-1 set NewDoc=0 if +$get(BuffNum)'=0 set DocIEN=$$DocExists(.Document) ;"avoid error with RPC calls else set DocIEN=0 set Document("DOC IEN")=DocIEN if DocIEN>0 do goto GRDone ;"DocIEN>0 means that the TEXT of the report is an exact match . kill ^TIU(8925,DocIEN,"TEXT") ;"Kill the TEXT prior report, so we can overwrite it else do . set DocIEN=$$CreateRec(.Document) . set NewDoc=1 GRDone ; if NewDoc,DocIEN'>0 set NewDoc=0 set Document("DOC IEN")=DocIEN quit DocIEN ;"DocIEN is document number DocExists(Document) ;"PURPOSE: To return document IEN, if it already EXISTS for the ;" given patient, title, and visit. ;"INPUT: Document -- see documentation of format in $$GetRecord ;"Results: returns a value for document (i.e. DocIEN), or -1 if no prior doc is found. ;" ;"Note: The following documents are ignored: ;" - docmts of status deleted or retracted ;" - all docmts if run across a docmt w/ requesting pkg ;" - If REQEDIT, then also ignore docmts PERSON cannot edit. ;"Note: If there are more than one, get the smallest DA. new DocIEN set DocIEN=-1 new index if $data(^TIU(8925,"C",Document("DFN")))=0 goto DEDone ;"Scan through all documents for patient (DFN) set index=$order(^TIU(8925,"C",Document("DFN"),"")) if index="" goto DEDone for do quit:(index="") . new DocCompValue . set DocCompValue=$$CompToBuff(index,Document(cDocTIEN),Document(cStartDate)) . if DocCompValue=2 do quit ;"i.e. documents are an exact match . . ;"For below, the document is the same as the upload buffer. . . ;"We have found our answer. . . ;" . . ;"Below is code I can use to check to see if I SHOULD be editing. . . ;"------------------------------------------------------ . . ;"new CANEDIT,CANDel . . ;"set CANEDIT=+$$CANDO^TIULP(index,"EDIT RECORD",Document("PROVIDER IEN")) . . ;"set CANDel=+$$CANDO^TIULP(index,"DELETE RECORD",Document("PROVIDER IEN")) . . ;"if +CANEDIT>0 set DocIEN=index . . set DocIEN=index set index="" quit . set index=$order(^TIU(8925,"C",Document("DFN"),index)) DEDone quit DocIEN BuffCharCount() ;"Purpose: To count the number of characters in the current upload buffer, for the ;" current document. The upload buffer puts all the documents being uploaded ;" into one big WP array. This function will count down until the text ;" signal is found to start the next documnent (e.g. '[NewDict]') ;"Input: none. However, several global-scope variables are used. ;" By tracing through the upload code I know that ;" the following variables are set: ;" (I saved DA as BuffNum, and TIUI as BuffIdx) ;" TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params ;" TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. ;" BuffIdx = the line index of the beginning of the report to be processed (i.e. the line ;" that starts with [TEXT] ;" BuffNum = the index in 8925.2, i.e. ^TIU(8925.2,BuffNum,"TEXT",0) ;" In other words, here BuffNum = the serial index number of the document to ;" be uploaded i.e. 1 for the first, 2 for the second etc. ;"Notes ;" 8925.2 is file: TIU UPLOAD BUFFER ;" To detect the beginning of the next document, use ;" if MyLine[TIUHSIG then abort ;" I trim of leading and trailing white-space before counting. ;" But, otherwise spaces will be counted ;" ;"Results: Returns character count, or 0 if none found. new index new result set result=0 if $get(TIUHSIG)="" goto BuffCDone set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx)) for do quit:(index="") . if index="" quit . new s set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0)) . if s="" set index="" quit . if s[TIUHSIG set index="" quit . set s=$$Trim^TMGSTUTL(.s) . set result=result+$length(s) . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index)) BuffCDone quit result PrepUploadBuf() ;"Purpose: Ensure upload buffer is ready for processing ;"Background: Transcriptionist will upload a large document containing ;" multiple notes for different patients etc. This entire large ;" document is stored in the TIU UPLOAD BUFFER file (8925.2) ;" When this filer code is called, the TIU upload process has already ;" set up some variables. ;" DA = the IEN in 8925.2, i.e. ^TIU(8925.2,DA,"TEXT",0) that ;" the uploaded text was temporarily store in. ;" (I save DA as BuffNum) ;" TIUI = the line index of the beginning of the report to ;" be processed (i.e. the line that starts with [TEXT]) ;" (I save TIUI as BuffIdx) ;" TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params ;" TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. ;" ;" I found that transcriptionists were using word-processors that automatically ;" wrapped the text to a next line. Thus paragraphs were being uploaded as ;" one very long line. Rather than try to reeducate them to consistantly hit ;" enter at the end of every line, I chose to automatically wrap the text to ;" a set width. ;" ;" A global-scope var: cMaxNoteWidth is expected to be defined/ ;" ;" So, to prepair the upload buffer, I use these steps: ;" 1. Scan the part of the upload buffer pertaining to the ;" current note being processed ;" - This starts with line BuffIdx, and ends with... ;" - the line containing TIUHSIG (or end of buffer) ;" See if any line is longer than cMaxNoteWidth characters. ;" If so, mark for wrapping. ;" 2. If wrapping needed, extract note to a temporary array ;" 3. Perform reformatting/wrapping on temp array. ;" 4. Put temp array back into Upload buffer ;" ;"Input: None, but global-scope vars used (see above) ;"Output: Upload buffer may be changed ;"Result: 1=OKToCont or cAbort new result set result=1 if $$NeedsReformat(cMaxNoteWidth) do . new CurNote . new NextNoteI . new DoSpecialIndent set DoSpecialIndent=1 ;"I.e. use hanging indents.) . set NextNoteI=$$CutNote(.CurNote) . do WordWrapArray^TMGSTUTL(.CurNote,cMaxNoteWidth,DoSpecialIndent) . set result=$$PasteNote(.CurNote,NextNoteI) PULBFDone quit result NeedsReformat(MaxWidth) ;"Purpose: To scan the single note being processed, to see if ;" it is too wide (i.e. any line of length > MaxWidth ;" I had to do this because transcriptionists were using ;" a wordprocessor that wrapped lines. Then when uploaded ;" each paragraph became one long line. ;" Also, will fix extended ASCII characters ;"Input: MaxWidth The max length of any line (i.e. 80 for 80 chars) ;" Also depends on global-scope vars ;"Result: 1= A line was found that is > MaxWidth ;" 0= no long lines found new index new result set result=0 if $get(TIUHSIG)="" goto NRFMDone if $get(MaxWidth)'>0 goto NRFMDone set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx)) if index'="" for do quit:(index="") . new s . set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0)) . if s="" set index="" quit . ;"9/19/06 Added to remove extended ASCII characters . ;"set s=$translate(s,$c(146)_$c(246)_$c(150)_$c(147)_$c(148),"'--""""") . if s[TIUHSIG set index="" quit . if $length(s)>MaxWidth do quit . . set result=1 . . set index="" . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index)) NRFMDone quit result CutNote(Array) ;"Purpose: To extract the current note out of the entire upload buffer ;"Input: Array -- MUST BE PASSED BY REFERENCE. This is an OUT parameter ;" Array will be loaded with the note, with the first line being ;" put into Array(1) ;" Depends on global-scope vars BuffIdx, BuffNum, TIUHSIG, set up elsewhere. ;"Note: This function empties the lines in TIU UPLOAD BUFFER as it cuts out note. ;"Result: Returns: ;" #: index of line containing start of next note. ;" -1: Error ;" 0: Note is the last one in the upload buffer, so no next note found new index new LastI set LastI=0 new result set result=-1 kill Array if $get(TIUHSIG)="" goto ExNDone new ArrayI set ArrayI=0 new s new Done set Done=0 set index=$order(^TIU(8925.2,BuffNum,"TEXT",BuffIdx)) if index'="" for do quit:(index="")!(Done=1) . set s=$get(^TIU(8925.2,BuffNum,"TEXT",index,0)) . if s[TIUHSIG set Done=1 quit . set ArrayI=ArrayI+1 . set Array(ArrayI)=s . kill ^TIU(8925.2,BuffNum,"TEXT",index) . set LastI=index . set index=$order(^TIU(8925.2,BuffNum,"TEXT",index)) set result=+index if result=0 set result=LastI ExNDone quit result PasteNote(Array,NextNoteI) ;"Purpose: To put Array back into the upload buffer, at the correct location, ;"Input: Array -- Best if PASSED BY REFERENCE. ;" Array is expected to be loaded with the note, with the first line Array(1) ;" NextNoteI: This is the index, in upload buffer, of the start of the next note. ;"Depends on global-scope vars BuffIdx, BuffNum, TIUHSIG, set up elsewhere. ;"Result: 1=OKToCont if all OK, or cAbort if error new EntireBuf new IndexInc set IndexInc=0.01 ;"WP^DIE does not require integer indexes. new ArrayI,PasteI new s new Done set Done=0 new result set result=cAbort merge EntireBuf=^TIU(8925.2,BuffNum,"TEXT") kill EntireBuf(0) ;"remove ^^^^^^ set ArrayI=$order(Array("")) set PasteI=BuffIdx+1 for do quit:((Done=1)!(ArrayI="")) . if $data(Array(ArrayI))#10=0 set Done=1 quit . set s=Array(ArrayI) . set EntireBuff(PasteI,0)=s . set PasteI=PasteI+IndexInc . if PasteI>NextNoteI do quit . . do ShowError^TMGDEBUG(PriorErrorFound,"Insufficient room to put note back into upload buffer.") . . set Done=1 . set ArrayI=$order(Array(ArrayI)) Set result=$$WriteWP^TMGDBAPI(8925.2,BuffNum,1,.EntireBuff) quit result CompToBuff(ExistingIEN,UplTIEN,UplDate) ;"PURPOSE: To compare the document being uploaded (i.e. in the file 8925.2, TIU upload buffer) ;" to documents already existing in database ;"Input: ExistingIEN -- the document IEN of a pre-existing document in the database. ;" i.e. ^TIU(8925,ExistingIEN,*) ;" UplTIEN=The type number of document being uploaded ;" UplDate -- the date of the document being uploaded. ;" NOTE: See also global-scope variables below that are REQUIRED ;" ;"Output: returns 0 if TEXT or Date different ;" 1 if TEXT only is the same (Title is different) ;" 2 if TEXT & Title are same ;" ;"------------------------------------------------------------------------------------ ;"Programming Note: By tracing through the upload code I know that ;" the following variables are set: ;" (I saved DA as BuffNum, and TIUI as BuffIdx) ;"TIUHSIG = [NewDict] .. or whatever it has been set to by user in upload params ;"TIUBGN = [TEXT] ... or whatever is has be set to by user in upload params. ;"BuffIdx = the line index of the beginning of the report to be processed (i.e. the line ;" that starts with [TEXT] ;"BuffNum = the index in 8925.2, i.e. ^TIU(8925.2,BuffNum,"TEXT",0) ;" In other words, here BuffNum = the serial index number of the document to be uploaded ;" i.e. 1 for the first, 2 for the second etc. ;" Note 8925.2 is file: TIU UPLOAD BUFFER ;"Note ;" To detect the beginning of the next document, use ;" if MyLine[TIUHSIG then abort new MaxUplLine new DocLine,UplLine new DocData,UplData new result set result=0 new MaxDocLine,CompLine new DocType,DocName new Break set Break=0 new DocDate ;"First, see if dates are the same. If not, bail out. set DocDate=$piece(^TIU(8925,ExistingIEN,0),"^",7) if DocDate'=UplDate goto CompExit ;"Quit with result=0 set MaxUplLine=$piece($get(^TIU(8925.2,BuffNum,"TEXT",0)),"^",3) if MaxUplLine="" goto CompExit set MaxDocLine=$piece($get(^TIU(8925,ExistingIEN,"TEXT",0)),"^",3) if MaxDocLine="" goto CompExit set UplLine=BuffIdx set DocLine=0 ;"Compare the two documents line by line. for i=1:1:(MaxUplLine-UplLine) do if Break goto CompExit . set UplData=$get(^TIU(8925.2,BuffNum,"TEXT",UplLine+i,0)) . set DocData=$get(^TIU(8925,ExistingIEN,"TEXT",DocLine+i,0),"x") . if UplData[TIUHSIG set i=MaxUplLine quit . if UplData'=DocData set Break=1 quit . quit ;"If we have gotten this far, then the text is an identical match. set result=1 ;"Now check to see if the dictation type is the same. set DocType=$piece($get(^TIU(8925,ExistingIEN,0)),"^",1) if DocType=UplTIEN set result=2 CompExit quit result ;------------------------------------------------------------------------ CreateRec(Document) ; ;"Purpose: Create document record - Returns DA ;"Input: Document -- an array with document info. See GetRecord for documentation ;"Ouput: DocIEN (internal entry number) of entry created, or -1 if failure ;" Errors (if any) returned in Document("ERROR") ;" ;"Note: This was originally taken from TIUEDI3 ;"new cOKToCont set cOKToCont=1 new cAbort set cAbort=0 new result set result=1; "cOKToCont new DIC,DLAYGO,X,Y,DIE,DR new DocIEN set DocIEN=-1 new TMGFDA,RecNum,TMGMSG,Flags set TMGFDA(8925,"+1,",.01)="`"_Document(cDocTIEN) set Flags="E" ;"====================================================== ;"Call UPDATE^DIE -- add new entries in files or subfiles. ;"====================================================== do . new $etrap set $etrap="do ErrTrp^TMGDBAPI" . set ^TMP("TMG",$J,"ErrorTrap")=result . set ^TMP("TMG",$J,"Caller")="UPDATE^DIE" . do UPDATE^DIE(Flags,"TMGFDA","RecNum","TMGMSG") . set result=^TMP("TMG",$J,"ErrorTrap") . kill ^TMP("TMG",$J,"ErrorTrap") ;"====================================================== ;"====================================================== if result'=1 goto CRDone ;"1=cOKToCont if $data(TMGMSG("DIERR")) do goto CRDone . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound) . set DocIEN=-1 . merge Document("ERROR","DIERR")=TMGMSG do . new index set index=$order(RecNum("")) . if index'="" set DocIEN=+$get(RecNum(index)) if DocIEN=0 set DocIEN=-1 CRDone ;"Now check for failure. DocIEN will equal record number, or -1 if failure if DocIEN'>0 do goto CRDone . new n set n=+$get(Document("ERROR","NUM"))+1 . set Document("ERROR",n)=$piece(Document(cDocType),"^",3)_" record could not be created." set Document("DOC IEN")=DocIEN quit DocIEN ;------------------------------------------------------------------------ StuffRec(Document,PARENT) ;"Purpose: Stuff fixed field data ;"INPUT: ;" Document = An array containing information to put into document. ;" The array should contain the following: ;" Document("DOC IEN") -- the document IEN ;" Document("PROVIDER IEN") -- the IEN of the provider ;" Document("DFN") -- the patient IEN ;" Document(cVisitIEN) -- a link to a visit entry ;" Document(cStartDate) -- episode begin date/time ;" Document(cEndDate) -- episode end date/time ;" Document(cHspLocIEN) -- hospital location (Document(cVstLocIEN) used NULL) ;" Document(cVstLocIEN) -- visit location. ;" Document(cService) -- service (i.e. FAMILY PRACTICE) ;" Document(cVisitStr) ;" Document("TRANSCRIPTIONIST") -- the name of the transcriptionist ;" Document("CHARACTER COUNT - TRANSCRIPTIONIST'S") -- the char count creditable to transcriptionist ;" Document("LINE COUNT") -- Total line count ;" PARENT: If we are working with an addendum to a document, then ;" parent is the internal entry number of the original parent document ;" Note:DocID can be null if not needed. ;" Note: I don't ever pass a parent, currently ;" ;"NOTE: The following global-scope variables are also referenced ;" TIUDDT ;"Results: Passes back document IEN, or -1 if error. ;" NOTE: if result is -1 then errors are passed back in ;" Document("ERROR") node ;" Document("ERROR",n)="ERROR.. Stuffing new document." ;" Document("ERROR","NUM")=n ;" Document("ERROR","FM INFO")=merge with DIERR array new TMGFDA,TMGMSG new RefDate new DocIEN set DocIEN=$get(Document("DOC IEN"),-1) if DocIEN=-1 goto SfRecDone new result set result=DocIEN ;"default to success new ParentDocType ;"Field (f) constants new fPatient set fPatient=.02 ;"field .02 = PATIENT new fVisit set fVisit=.03 ;"field .03 = VISIT new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE new fStatus set fStatus=.05 ;"field .05 = STATUS new fParent set fParent=.06 ;"field .06 = PARENT new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07) new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08) new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME new fAuthor set fAuthor=1202 ;"field 1202 = PERSON/DICTATOR new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner new fAttending set fAttending=1209 ;"field 1209 = ATTENDING new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE new fEnteredBy set fEnteredBy=1302 ;"field 1302 = ENTERED BY (a pointer to file 200) new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload' new fService set fService=1404 ;"field 1404 = SERVICE new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected. new fCharTrans set fCharTrans=22711 ;"field 22711 = CHAR COUNT -- TRANSCRIPTIONIST new fLineCount set fLineCount=.1 ;"field .1 = LINE COUNT ;"8925=TIU DOCUMENT, the file we will edit ;"do Set8925Value(.TMGFDA,Document("DFN"),fPatient,1) ;"Will file separatedly below. do Set8925Value(.TMGFDA,Document(cVisitIEN),fVisit,1) do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fAuthor,1) do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fExpSigner,1) do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fAttending,1) do Set8925Value(.TMGFDA,Document(cHspLocIEN),fHospLoc,1) do Set8925Value(.TMGFDA,Document(cVstLocIEN),fVisitLoc,1) do Set8925Value(.TMGFDA,Document("TRANSCRIPTIONIST"),fEnteredBy,0) ;"VA transcriptionist field do Set8925Value(.TMGFDA,Document("CHARACTER COUNT - TRANSCRIPTIONIST'S"),fCharTrans,0) if $data(Document("LINE COUNT")) do . do Set8925Value(.TMGFDA,Document("LINE COUNT"),fLineCount,0) set ParentDocType=$$DOCCLASS^TIULC1(+$piece(DocIEN,"^",2)) if +ParentDocType>0 do Set8925Value(.TMGFDA,ParentDocType,fParentDoc,1) if $get(Document("AUTO SIGN"))=1 do . do Set8925Value(.TMGFDA,"COMPLETED",fStatus,0) . do Set8925Value(.TMGFDA,Document("PROVIDER IEN"),fSignedBy,1) else do . do Set8925Value(.TMGFDA,"UNSIGNED",fStatus,0) if +$get(PARENT)'>0 do . ;"do Set8925Value(.TMGFDA,Document("DFN"),fPatient,1) . do Set8925Value(.TMGFDA,Document(cVisitIEN),fVisit,1) . do Set8925Value(.TMGFDA,Document(cStartDate),fStartDate,0) . do Set8925Value(.TMGFDA,Document(cEndDate),fEndDate,0) . do Set8925Value(.TMGFDA,Document(cService),fService,0) if +$get(PARENT)>0 do . new NodeZero set NodeZero=$get(^TIU(8925,+PARENT,0)) . new Node12 set Node12=$get(^TIU(8925,+PARENT,12)) . new Node14 set Node14=$get(^TIU(8925,+PARENT,14)) . ;" . do Set8925Value(.TMGFDA,PARENT,fParent,1) . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pPatient),fPatient,1) . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pVisit),fVisit,1) . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pStrtDate),fStartDate,0) . do Set8925Value(.TMGFDA,$piece(NodeZero,"^",pEndDate),fEndDate,0) . do Set8925Value(.TMGFDA,$piece(Node12,"^",pHospLoc),fHospLoc,1) . do Set8925Value(.TMGFDA,$piece(Node14,"^",pService),fService,0) do Set8925Value(.TMGFDA,$$NOW^TIULC,fEntryDate,0) do Set8925Value(.TMGFDA,Document(cHspLocIEN),fHospLoc,1) do Set8925Value(.TMGFDA,Document(cVstLocIEN),fVisitLoc,1) do Set8925Value(.TMGFDA,Document(cStartDate),fRefDate,0) do Set8925Value(.TMGFDA,"U",fCapMethod,0) ;" U-->'upload' ;"do Set8925Value(.TMGFDA,3,fStatus,0) kill ^TMG("TMP","EDDIE") ;"merge ^TMG("TMP","EDDIE","INSIDE DOCUMENT")=Document ;"TEMP!! merge ^TMG("TMP","EDDIE","FDA")=TMGFDA ;"TEMP!! do FILE^DIE("EK","TMGFDA","TMGMSG") if $data(TMGMSG("DIERR")) do goto SfRecDone . set result=-1 . merge Document("ERROR","FM INFO")=TMGMSG("DIERR") ;" -- [Mark record for deferred crediting of stop code (fld #.11)]: -- if +$get(Document("STOP")) do . do DEFER^TIUVSIT(DocIEN,+$get(Document("STOP"))) ;"Try storing .02 field separately to avoid weird filing error kill TMGFDA kill ^TMG("TMP","EDDIE") new PtDFN set PtDFN=Document("DFN") if (+PtDFN'=PtDFN),(PtDFN["`") set PtDFN=$piece(PtDFN,"`",2) if +PtDFN>0 do . set TMGFDA(8925,DocIEN_",",.02)=PtDFN . merge ^TMG("TMP","EDDIE","FDA")=TMGFDA ;"TEMP!! . do FILE^DIE("K","TMGFDA","TMGMSG") . if $data(TMGMSG("DIERR")) do . . set result=-1 . . merge Document("ERROR","FM INFO")=TMGMSG("DIERR") SfRecDone quit result Set8925Value(TMGFDA,Value,Field,IsIEN) ;"Purpose: To provide a clean means of loading values into fields, into TMGFDA(8925,DOCIEN) ;"Input: TMGFDA -- The array to fill ;" Value -- the value to load ;" Field -- the field ;" IsIEN = 1 if value is an IEN ;"Note: DEPENDS ON GLOBAL-SCOPE VARIABLES: DocIEN,Document if ($get(Value)'="")&($data(Field)>0) do . if $get(IsIEN)>0,$extract(Value,1)'="`" set Value="`"_+Value . if Value'="`0" set TMGFDA(8925,DocIEN_",",Field)=Value quit ;"----------------------------------------------------------------------------------------------- ;"==============================================================================================- ;" F O L L O W - U P C O D E ;"==============================================================================================- ;"----------------------------------------------------------------------------------------------- FOLLOWUP(DocIEN) ;" Post-filing code for PROGRESS NOTES ;"PURPOSE: ;" This function is called by the TIU upload document facilities. ;" it is called after the text has been put into the document ;" ;"INPUT: ;" DocIEN -- is passed a value held in TIUREC("#"), i.e. ;" do FOLLOWUP^TIUPUTN1(TIUREC("#")). write ! write "+-------------------------------------+",! write "| Starting Follow-up code... |",! write "+-------------------------------------+",! if $data(cOKToCont)#10=0 new cOKToCont set cOKToCont=1 if $data(cAbort)#10=0 new cAbort set cAbort=0 new DBIndent,PriorErrorFound new result set result=1 ;" 1=cOKToCont new Document merge Document=TMGDOC new cStartDate set cStartDate="EDT" new cEndDate set cEndDate="LDT" new cService set cService="SVC" new cDocType set cDocType="TYPE" new cDocTIEN set cDocTIEN="TYPE IEN" ;"new cDocIEN set cDocIEN="DOC IEN" ;"new cPatIEN set cPatIEN="DFN" ;"DFN = Patient IEN new cHspLocIEN set cHspLocIEN="LOC" new cVstLocIEN set cVstLocIEN="VLOC" new cVisitStr set cVisitStr="VSTR" new cVisitIEN set cVisitIEN="VISIT" new cStopCode set cStopCode="STOP" ;" 'p constants new pPatient set pPatient=2 ;"Node 0,piece 2 = PATIENT (field .02) new pVisit set pVisit=3 ;"Node 0,piece 3 = VISIT (field .03) new pStrtDate set pStrtDate=7 ;"Node 0,piece 7 = EPISODE BEGIN DATE/TIME (field .07) new pEndDate set pEndDate=8 ;"Node 0,piece 8 = EPISODE END DATE/TIME (field .08) new pAuthor set pAuthor=2 ;"Node 12,piece 2 = AUTHOR/DICTATOR (field 1202) new pExpSigner set pExpSigner=4 ;"Node 12,piece 4 = EXPECTED SIGNER (field 1204) new pHospLoc set pHospLoc=5 ;"Node 12,piece 5 = field 1205 = HOSPITAL LOCATION new pAttending set pAttending=9 ;"Node 12,piece 9 = ATTENDING PHYSICIAN (field 1209) new pExpCosign set pExpCosign=8 ;"Node 12,piece 8 = EXPECTED COSIGNER (field 1210) new pVstLoc set pVstLoc=11 ;"Node 12,piece 11 = field 1211 = VISIT LOCATION ;"Field (f) constants new fPatient set fPatient=.02 ;"field .02 = PATIENT new fVisit set fVisit=.03 ;"field .03 = VISIT new fParentDoc set fParentDoc=.04 ;"field .04 = PARENT DOCUMENT TYPE new fStatus set fStatus=.05 ;"field .05 = STATUS new fParent set fParent=.06 ;"field .06 = PARENT new fStartDate set fStartDate=.07 ;"EPISODE BEGIN DATE/TIME (field .07) new fEndDate set fEndDate=.08 ;"EPISODE END DATE/TIME (field .08) new fEntryDate set fEntryDate=1201 ;"field 1201 = ENTRY DATE/TIME new fAuthor set fAuthor=1202 ;"field 1202 = AUTHOR/DICTATOR new fExpSigner set fExpSigner=1204 ;"field 1204 = expected Signer new fHospLoc set fHospLoc=1205 ;"field 1205 = HOSPITAL LOCATION new fExpCosign set fExpCosign=1208 ;"field 1208 = expected cosigner new fVisitLoc set fVisitLoc=1211 ;"field 1211 = VISIT LOCATION new fRefDate set fRefDate=1301 ;"field 1301 = REFERENCE DATE new fCapMethod set fCapMethod=1303 ;"field 1303 = CAPTURE METHOD; U-->'upload' new fService set fService=1404 ;"field 1404 = SERVICE new fNeedCosign set fNeedCosign=1506 ;"field 1506 = cosigniture expected. new fSignedBy set fSignedBy=1502 ;"field 1502 = signed by new TMGFDA,TMGMSG new DFN new Attending,ExpSigner,ExpCosign,Author new BailOut set BailOut=0 new Node12 set Node12=$get(^TIU(8925,DocIEN,12)) new NodeZero set NodeZero=$get(^TIU(8925,DocIEN,0)) if $data(Document)=0 new Document set Author=+$piece(Node12,"^",pAuthor) set Attending=+$piece(Node12,"^",pAttending) set ExpCosign=+$piece(Node12,"^",pExpCosign) set ExpSigner=+$piece(Node12,"^",pExpSigner) do . new Signer set Signer=$$WHOSIGNS^TIULC1(DocIEN) . do Set8925Value(.TMGFDA,$$WHOSIGNS^TIULC1(DocIEN),fExpSigner,1) if (Attending>0)&(ExpCosign=0) do . do Set8925Value(.TMGFDA,$$WHOCOSIG^TIULC1(DocIEN),fExpCosign,1) if (ExpCosign>0)&(ExpSigner'=ExpCosign) do . do Set8925Value(.TMGFDA,1,fNeedCosign,0) set result=$$dbWrite^TMGDBAPI(.TMGFDA,1) if result=-1 goto FUDone do RELEASE^TIUT(DocIEN,1) ;"Call function to 'Release Document from transcription' do AUDIT^TIUEDI1(DocIEN,0,$$CHKSUM^TIULC("^TIU(8925,"_+DocIEN_",""TEXT"")")) ;"Update audit trail if '$data(Document) do if (BailOut=1) goto FUDone . new VstLocIEN,HspLocIEN,StartDate,EndDate . if $data(NodeZero)#10=0 do quit . . set BailOut=1 . set DFN=+$piece(NodeZero,"^",pPatient) . set StartDate=+$piece(NodeZero,"^",pStrtDate) . set EndDate=$$FMADD^XLFDT(StartDate,1) . set Document(cHspLocIEN)=+$piece(Node12,"^",pHospLoc) . set Document(cVstLocIEN)=+$piece(Node12,"^",pVstLoc) . set VstLocIEN=Document(cVstLocIEN) . if VstLocIEN'>0 set VstLocIEN=Document(cHspLocIEN) . if (DFN>0)&(StartDate>0)&(EndDate>0)&(VstLocIEN>0) do . . ;"This is an interactive visit .... . . do MAIN^TIUVSIT(.Document,DFN,"",StartDate,EndDate,"LAST",0,VstLocIEN) if $data(Document)=0 goto FUDone if $data(Document(cVisitStr))#10=0 goto FUDone if $data(DFN)=0 set DFN=$get(Document("DFN")) if DFN="" goto FUDone ;"Note: reviewing the code for ENQ^TIUPXAP1, it appears the following is expected: ;" .TIU array ;" DFN -- the patient IEN ;" DA -- the IEN of the document to work on. ;" TIUDA -- the doc IEN that was passed to this function. ;" Note, I'm not sure how DA and TIUDA are used differently. ;" In fact, if $data(TIUDA)=0, then function uses DA. ;" Unless I kill TIUDA (which might cause other problems), I don't ;" know if TIUDA will hold an abherent value. So I'll set to DA do . new TIUDA set TIUDA=DocIEN . new DA set DA=DocIEN . new TIU merge TIU=Document . do ENQ^TIUPXAP1 ;" Get/file VISIT FUDone ; kill TMGDOC quit ;"----------------------------------------------------------------------------------------------- ;"==============================================================================================- ;" R E - F I L I N G C O D E ;"==============================================================================================- ;"----------------------------------------------------------------------------------------------- REFILE ;"Purpose: Somtimes the upload process fails because of an error in the ;" upload filing code. Rather than require a re-upload of the file, ;" this function will trigger a retry of filing the TIU UPLOAD BUFFER ;" (file 8925.2) ;"This function is called by menu option TMG REFILE UPLOAD new TIUDA set TIUDA="" new job new DoRetry set DoRetry="" new Abort set Abort=0 new Found set Found=0 write !,! write "------------------------------------------------",! write " Refiler for failed uploads (i.e. a second try.)",! write "------------------------------------------------",!,! write "Here are all the failed uploads:",!,! set job=$order(^TIU(8925.2,"B","")) for do quit:(job="") . new Buff,NextBuff . if job="" quit . set Buff=$order(^TIU(8925.2,"B",job,"")) . for do quit:(Buff="") . . if Buff="" quit . . write "Buffer #"_Buff_" (created by process #"_job_")",! . . set Found=1 . . set Buff=$order(^TIU(8925.2,"B",job,Buff)) . set job=$order(^TIU(8925.2,"B",job)) if Found=0 write "(There are no failed uploads to process... Great!)",! else write "------------------------------------------------",! set job=$order(^TIU(8925.2,"B","")) for do quit:(job="")!(Abort=1) . new Buff,NextBuff . if job="" quit . set Buff=$order(^TIU(8925.2,"B",job,"")) . for do quit:(Buff="")!(Abort=1) . . if Buff="" quit . . if DoRetry'="all" do . . . write !,"Refile upload buffer #"_Buff_" (created by process #"_job_")? (y/n/all/^) " . . . read DoRetry:$get(DTIME,300),! . . else do . . . new GetKey . . . read *GetKey:0 . . . if $get(GetKey)=27 set DoRetry="n" . . . else write !,!,"Processing upload buffer #",Buff,! . . if DoRetry="^" set Abort=1 quit . . if (DoRetry["y")!(DoRetry["Y")!(DoRetry="all") do . . . set TIUDA=Buff . . . ;"These is an edited form of MAIN^TIUUPLD . . . N EOM,TIUERR,TIUHDR,TIULN,TIUSRC,X . . . I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE . . . S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11) . . . I EOM']"",($P(TIUPRM0,U,17)'="k") do quit . . . . W !,$C(7),$C(7),$C(7),"No End of Message Signal Defined - Contact IRM.",! . . . S:TIUSRC']"" TIUSRC="R" . . . S TIUHDR=$P(TIUPRM0,U,10) . . . I TIUHDR']"" do quit . . . . W $C(7),$C(7),$C(7),"No Record Header Signal Defined - Contact IRM.",! . . . new temp set temp=$order(^TIU(8925.2,TIUDA,"TEXT",0)) . . . write "First line of TEXT=",temp,! . . . I +$O(^TIU(8925.2,TIUDA,"TEXT",0))>0 do . . . . write "Calling FILE^TIUUPLD("_TIUDA_")",! . . . . D FILE^TIUUPLD(TIUDA) . . . I +$O(^TIU(8925.2,TIUDA,"TEXT",0))'>0 D BUFPURGE^TIUPUTC(TIUDA) . . set Buff=$order(^TIU(8925.2,"B",job,Buff)) . set job=$order(^TIU(8925.2,"B",job)) write !,"------------------------------------------------",! write " All done with Refiler",! write "------------------------------------------------",!,! RFDone Q