Index: cprs/branches/tmg-cprs/m_files/TMGFMUT2.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGFMUT2.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGFMUT2.m Index: cprs/branches/tmg-cprs/m_files/TMGIDE.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGIDE.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGIDE.m Index: cprs/branches/tmg-cprs/m_files/TMGIDE2.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGIDE2.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGIDE2.m Index: cprs/branches/tmg-cprs/m_files/TMGIDE3.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGIDE3.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGIDE3.m Index: cprs/branches/tmg-cprs/m_files/TMGIDE4.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGIDE4.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGIDE4.m Index: cprs/branches/tmg-cprs/m_files/TMGIDE5.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGIDE5.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGIDE5.m Index: cprs/branches/tmg-cprs/m_files/TMGIDE6.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGIDE6.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGIDE6.m Index: cprs/branches/tmg-cprs/m_files/TMGKERN2.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGKERN2.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGKERN2.m Index: cprs/branches/tmg-cprs/m_files/TMGKERNL.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGKERNL.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGKERNL.m Index: cprs/branches/tmg-cprs/m_files/TMGRPC1.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC1.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGRPC1.m Index: cprs/branches/tmg-cprs/m_files/TMGRPC1A.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC1A.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGRPC1A.m Index: cprs/branches/tmg-cprs/m_files/TMGRPC1D.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC1D.m (revision 895) +++ cprs/branches/tmg-cprs/m_files/TMGRPC1D.m (revision 895) @@ -0,0 +1,195 @@ +TMGRPC1D ;TMG/kst-RPC Functions ;07/21/10 + ;;1.0;TMG-LIB;**1**;07/21/10 + + ;"TMG RPC FUNCTIONS especially related to imaging. + + ;"Kevin Toppenberg MD + ;"GNU General Public License (GPL) applies + ;"7/21/10 + + ;"======================================================================= + ;" RPC -- Public Functions. + ;"======================================================================= + ;"CONFIG -- Set up imaging site parameters, so that TMG-CPRS works. + ;"TESTCFG -- Test configuration + ;"======================================================================= + ;"PRIVATE API FUNCTIONS + ;"======================================================================= + ;"PINST1 - entry point for POST-INSTALL routine for patch TMG-CPRS-IMAGING*1.0*1 + ; + ;"======================================================================= + ;"Dependancies: TMGKERNL,TMGUSRIF + ;"======================================================================= + ; +CONFIG ; + ;"Purpose: Set up imaging site parameters, so that TMG-CPRS works. + ;"Input: None + ;"Results: none + ; + WRITE " ------------------------------------------",! + WRITE " - Configuration of TMG Imaging -",! + WRITE " ------------------------------------------",!,! + ; + ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file. + NEW %,DA,DR,DIE,DIC,X,Y,DIK + NEW TMGFDA,TMGMSG,TMGDIV,TMGDROP,TMGSTORE,TMGNODIV + NEW INSTPTR,IMGSPPTR +CF1 SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;"Ptr to file $4 (Institution) + IF INSTPTR>0 DO GOTO CF2 + . WRITE "Using DEFAULT INSTITUTION: ",$$GET1^DIQ(4,INSTPTR,.01),! + WRITE "No value for DEFAULT INSTITUTION found in field 217 in file KERNEL SYSTEM PARAMETERS",! + WRITE "Edit settings now to correct this" + SET %=1 DO YN^DICN WRITE ! + IF %'=1 GOTO CFDN + SET DA=1,DR="[XUSITEPARM]",DIE=8989.3 + DO XUDIE^XUS5 ;"Launch screenman form to edit KERNEL SYSTEM PARAMETERS. + GOTO CF1 + ; +CF2 ;"Now get IMAGING SITE PARAMETERS for Institution Name + SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0)) + IF IMGSPPTR>0 DO GOTO CF3 + . WRITE "Using IMAGING SITE PARAMETERS IEN #",IMGSPPTR,", " + . WRITE $$GET1^DIQ(2006.1,IMGSPPTR,.01),! + WRITE "Next, a entry in IMAGING SITE PARAMENTERS file must be linked in.",! + WRITE "Please select entry to use, or add a new one if needed.",! + DO PRESSTOCONT^TMGUSRIF + SET DIC=2006.1,DIC(0)="MAEQL" + DO ^DIC WRITE ! + IF Y>-1 SET IMGSPPTR=+Y GOTO CF2B + WRITE "Valid entry in IMAGING SITE PARAMETERS file not selected.",! + SET %=1 + WRITE "Start over" DO YN^DICN WRITE ! + IF %=1 GOTO CF1 + GOTO ABORT +CF2B KILL TMGFDA,TMGMSG + SET TMGFDA(2006.1,IMGSPPTR_",",.01)=INSTPTR + DO FILE^DIE("K","TMGFDA","TMGMSG") + IF $DATA(TMGMSG("DIERR")) DO GOTO ABORT + . DO ShowDIERR^TMGDEBUG(.TMGMSG) + GOTO CF2 ;"loop back just be sure the B index is setup. + ; +CF3 ;"Now get NETWORK LOCATION stored in IMAGING SITE PARAMETERS record + NEW LOCPTR SET LOCPTR=+$PIECE($GET(^MAG(2006.1,IMGSPPTR,0)),"^",3) + IF LOCPTR>0 DO GOTO CF4 + . WRITE "Using NETWORK LOCATION IEN #",LOCPTR,", " + . WRITE $$GET1^DIQ(2005.2,LOCPTR,.01),! + WRITE "Next, a entry in NETWORK LOCATION file must be linked in.",! + WRITE "Please select entry to use, or add a new one if needed.",! + DO PRESSTOCONT^TMGUSRIF + SET DIC=2005.1,DIC(0)="MAEQL" + IF Y>-1 SET LOCPTR=+Y GOTO CF4 + WRITE "Valid entry in NETWORK LOCATION file not selected.",! + SET %=1 + WRITE "Start over" DO YN^DICN WRITE ! + IF %=1 GOTO CF1 + GOTO ABORT + ; +CF4 ;"Now set up NETWORK LOCATION file. + WRITE !,"A NODE DIVIDER is the symbol used to separt folders in a path",! + WRITE "E.g. for UNIX, with a sample path of '/opt/var/me', uses '/'",! + WRITE "For Windows, with sample path of 'c:\temp\me', uses '\'",! + SET %=1,TMGNODIV=0 + SET TMGDIV=$$GET1^DIQ(2005.2,LOCPTR,22701) + IF TMGDIV'="" DO + . WRITE "Current Node divider= '",TMGDIV,"'" + . SET %=2 + . IF TMGDIV="/" WRITE " (UNIX filesystem)",! + . ELSE IF TMGDIV="\" WRITE " (WINDOWS filesystem)",! + . ELSE WRITE " (?? filesystem)",! SET %=1 + WRITE "Do you want to specify a NODE DIVIDER" DO YN^DICN WRITE ! + IF %=-1 GOTO ABORT + IF %=2 SET TMGNODIV=1 GOTO CF4A + ; + WRITE "Is the server running on a Linux/Unix box" DO YN^DICN WRITE ! + IF %=-1 GOTO ABORT + IF %=1 SET TMGDIV="/" + ELSE SET TMGDIV="\" + ; +CF4A WRITE !,"A DROPBOX is a file folder where the server may place files for",! + WRITE "pick up by a client (i.e. CPRS). This folder could be on a ",! + WRITE "separate file system (e.g. a windows file system mounted into",! + WRITE "the server file system.) This is a security measure that negates",! + WRITE "a need for the client to have read access to the entire images",! + WRITE "folder. A dropbox path is only required if client is configured",! + WRITE "to use it.",! + SET %=1 + SET TMGDROP=$$GET1^DIQ(2005.2,LOCPTR,22702) + IF TMGDROP'="" DO + . WRITE "Current DROPBOX: ",TMGDROP,!,! + . SET %=2 + WRITE "Do you want to specify a DROPBOX FOLDER" DO YN^DICN WRITE ! + IF %=-1 GOTO ABORT + IF %=2 SET TMGDROP="" GOTO CF4C + ; +CF4B WRITE "Enter full path of the DROPBOX is it would be accessed on the ",! + WRITE "server (**NOT the path that the client would use**)",! + READ "Enter full DROPBOX path (^ to abort): ",TMGDROP:DTIME,! + IF TMGDROP="^" GOTO ABORT + IF TMGDROP="" WRITE ! GOTO CF4A + IF $$IsDir^TMGKERNL(TMGDROP,TMGDIV)=1 GOTO CF4B + WRITE "ERROR: Path specified is not valid. Does folder exist?",!,! + GOTO CF4B + ; +CF4C WRITE !,"A STORE PATH is the file folder that the server will use to",! + WRITE "store images. This should be a complete and valid path.",! + SET %=1 + SET TMGSTORE=$$GET1^DIQ(2005.2,LOCPTR,22700) + IF TMGSTORE'="" DO + . WRITE "Current image file storage path: ",TMGSTORE,! + . SET %=2 + WRITE "Do you want to specify a STORE FOLDER" DO YN^DICN WRITE ! + IF %=-1 GOTO ABORT + IF %=2 SET TMGSTORE="" GOTO CF4D + ; + READ "Enter store path (^ to abort): ",TMGSTORE:DTIME,! + IF TMGDROP="^" GOTO ABORT + IF TMGSTORE="" WRITE ! GOTO CF4C + IF $$IsDir^TMGKERNL(TMGSTORE,TMGDIV)=1 GOTO CF4D + WRITE "ERROR: Path specified is not valid. Does folder exist?",!,! + GOTO CF4C + ; +CF4D ;"Next force field 1 (PHYSICAL REFERENCE) to be same as TMGDIV + IF $PIECE($GET(^MAG(2005.2,LOCPTR,0)),"^",2)=TMGDIV GOTO CF4E + SET DIK="^MAG(2005.2," + SET DA=LOCPTR + DO ^DIK ;"Kill prior entry. Leaves DIK and DA unchanged + ;"Note: Input transform doesn't allow the value I put in here. + SET $PIECE(^MAG(2005.2,LOCPTR,0),"^",2)=TMGDIV ;"NOTE!! Low-level write + SET DIK(1)=1 ;"Field 1 = PHYSICAL REFERENCE + DO EN^DIK ;"Reindex field, to populate crossrefences with new value. + ; +CF4E KILL TMGFDA,TMGMSG + IF TMGSTORE'="" SET TMGFDA(2005.2,LOCPTR_",",22700)=TMGSTORE + IF TMGNODIV=0 SET TMGFDA(2005.2,LOCPTR_",",22701)=TMGDIV + IF TMGDROP'="" SET TMGFDA(2005.2,LOCPTR_",",22702)=TMGDROP + IF $DATA(TMGFDA) DO FILE^DIE("K","TMGFDA","TMGMSG") + IF $DATA(TMGMSG("DIERR")) DO GOTO ABORT + . DO ShowDIERR^TMGDEBUG(.TMGMSG) + WRITE !,"Done with configuration.",!,! + DO TESTCFG + GOTO CFDN + ; +ABORT WRITE "Aborting configuration process.",! + WRITE "Try again later, using 'DO CONFIG^TMGRPC1D'",! +CFDN QUIT + ; + ; +TESTCFG ; + ;"Purpose: Test configuration + NEW LOCPTR SET LOCPTR=$$GETDEFNL^TMGRPC1C() + IF LOCPTR'>0 DO QUIT + . WRITE "ERROR: Can't find NETWORK LOCATION to use",! + WRITE "Storage path: ",$$GETLOCFPATH^TMGRPC1C("/"),! + NEW DROPPATH + IF $$GETDROPPATH^TMGRPC1C(LOCPTR,.DROPPATH)=-1 DO QUIT + . WRITE "ERROR: Unable to get Dropbox path",! + WRITE "Dropbox path: ",DROPPATH,! + QUIT + ; +PINST1 ; + ;"Purpose: This is an entry point for POST-INSTALL routine for patch + ;" TMG-CPRS-IMAGING*1.0*1 + DO ENSUREAL^TMGRPC1B + DO CONFIG + QUIT + ; Index: cprs/branches/tmg-cprs/m_files/TMGRPCS1.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPCS1.m (revision 895) +++ cprs/branches/tmg-cprs/m_files/TMGRPCS1.m (revision 895) @@ -0,0 +1,171 @@ +TMGRPCS1 ;TMG/kst/RPC entry points for Search PT DOCS API ; 6/20/10 + ;;1.0;TMG-LIB;**1**;05/20/10 + ; + ;"RPC ENTRY POINTS FOR TMG PATIENT DOCUMENTS SEARCH + ; + ;"Copyright Kevin Toppenberg MD 6/20/10 + ;"Released under GNU General Public License (GPL) + ;" + ;"======================================================================= + ;" RPC -- Public Functions. + ;"======================================================================= + ;"PDSRCH(TMGRESULT,TMGPARAMS) -- launch a background search in documents for 1 patient + ;"PDSTATUS(TMGRESULT,TMGPARAMS) -- Get status of background search + ;"PDRESULT(TMGRESULT,TMGPARAMS) -- Get result from background search + ;"PDCLEAR(TMGRESULT,TMGPARAMS) -- Tell background task to stop, and clear data array + ;"PDSTOP(TMGRESULT,TMGPARAMS) -- Tell background task to stop searching + ;"PDPREPSS^TMGRPCS1(TMGRESULT,TMGPARAMS) -- Prep for Subset of List for TORCombobox + ;"PDGETSS^TMGRPCS1(TMGRESULT,TMGPARAMS) -- Get a subset of list for TORCombobox + + ;"======================================================================= + ;"PRIVATE API FUNCTIONS + ;"======================================================================= + ;" + ;"======================================================================= + ;"======================================================================= + ;"Dependencies: TMGSRCH2 + ;"======================================================================= + ;"======================================================================= + ; +PDSRCH(TMGRESULT,TMGPARAMS) ; + ;"Purpose: Handle PT DOCS SEARCH -- launch a background search in documents for 1 patient + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: PatientEIN^SearchString + ;" Search string notes: + ;" Each word (or partial word) to look up is separated by spaces + ;" All words are combined in AND fashion + ;" Search is NOT case sensitive. + ;" Exact pharases can be specified by quotes. + ;" Example: 'dog cat monkey "in a barrel" + ;"Note: this function can ALSO be used to allow the CHANGE the search. + ;" This will allow the search to begin while the user is still + ;" entering the search terms. If the new search is just an + ;" extension to the prior search, then the prior search will be + ;" added on rather than starting over. + ; + ;"Results: TMGRESULT(0)="1^Success", OR -1^ErrorMsg + NEW DFN SET DFN=+$PIECE(TMGPARAMS,"^",1) + IF DFN'>0 DO GOTO PDSDN + . SET TMGRESULT(0)="-1^Invalid Patient IEN" + NEW TMGSRCH SET TMGSRCH=$PIECE(TMGPARAMS,"^",2) + IF TMGSRCH="" DO GOTO PDSDN + . SET TMGRESULT(0)="-1^No search terms provided." + DO LAUNCHSR^TMGSRCH2(DFN,TMGSRCH) ; + SET TMGRESULT(0)="1^SUCCESS" +PDSDN QUIT + ; +PDSTATUS(TMGRESULT,TMGPARAMS) ; + ;"Purpose: Handle PT DOCS STATUS -- Get status of background search + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: NOT USED + ;"Results: TMGRESULT(0)=1^Status or -1^ErrorMessage + SET TMGRESULT(0)=$$STATUS^TMGSRCH2() ; + QUIT + ; +PDRESULT(TMGRESULT,TMGPARAMS) ; + ;"Purpose: Handle PT DOCS GET RESULTS -- get result from background search + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: NOT USED + ;"Results: TMGRESULT(0)=FoundCount^Success, or -1^Message + ;" TMGRESULT(1)=IEN1 + ;" TMGRESULT(2)=IEN2 ... etc. + DO RESULTS^TMGSRCH2(.TMGRESULT) + QUIT + ; +PDCLEAR(TMGRESULT,TMGPARAMS) ; + ;"Purpose: PT DOCS CLEAR -- Tell background task to stop, and clear data array + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: NOT USED + ;"Results: TMGRESULT(0)="1^Success + DO CLEAR^TMGSRCH2 + SET TMGRESULT(0)="1^Success" + QUIT + ; +PDSTOP(TMGRESULT,TMGPARAMS) ; + ;"Purpose: Handle PT DOCS STOP -- Tell background task to stop searching + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: NOT USED + ;"Results: TMGRESULT(0)= + ;"Results: TMGRESULT(0)="1^Success + DO STOP^TMGSRCH2 + SET TMGRESULT(0)="1^Success" + QUIT + ; +PDPREPSS(TMGRESULT,TMGPARAMS) ; + ;"Purpose -- Prep for Subset of List for TORCombobox + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: NOT USED + ;"Results: TMGRESULT(0)="1^Success", OR -1^ErrorMsg + NEW LIST + NEW ABORT SET ABORT=0 + DO PDRESULT(.LIST) ; + NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",$J,"OR LIST")) + KILL @REF + IF +$GET(LIST(0))'>0 SET TMGRESULT(0)=LIST(0) GOTO PSSDN + NEW I SET I=0 + FOR SET I=$ORDER(LIST(I)) QUIT:(+I'>0)!ABORT DO + . NEW IEN SET IEN=+$GET(LIST(I)) QUIT:IEN'>0 + . NEW NAME SET NAME=$$FORMAT(IEN) + . IF +NAME=-1 SET ABORT=1,TMGRESULT(0)=NAME QUIT + . SET @REF@(NAME,IEN)="" +PSSDN QUIT + ; + ; +FORMAT(IEN) ; + ;"Purpose: Return a string describing note title + ;"Input: IEN -- The IEN in file 8925 + ;"Result: July 15, 2010 -- NOTE TITLE -- AUTHOR + SET IEN=+$GET(IEN) + NEW RESULT + IF (IEN'>0)!($DATA(^TIU(8925,IEN))=0) DO GOTO FMTDN + . SET RESULT="-1^" + NEW TMGOUT,TMGMSG,TMGIENS + SET TMGIENS=IEN_"," + DO GETS^DIQ(8925,TMGIENS,".01;1202","","TMGOUT","TMGMSG") + IF $DATA(TMGMSG("DIERR")) DO GOTO FMTDN + . SET RESULT="-1^" + NEW TITLE SET TITLE=$GET(TMGOUT(8925,TMGIENS,.01),"? TITLE") + NEW AUTHOR SET AUTHOR=$GET(TMGOUT(8925,TMGIENS,1202),"? AUTHOR") + NEW DATE SET DATE=$PIECE($GET(^TIU(8925,IEN,0)),"^",7) ;"Custom formatting + SET DATE=$$FMTE^XLFDT(DATE,7) ;"7 --> YYYY/MM/DD@time + SET DATE=$PIECE(DATE,"@",1) ;"remove time + NEW MONTH SET MONTH=$PIECE(DATE,"/",2) + IF $LENGTH(MONTH)=1 SET MONTH="0"_MONTH SET $PIECE(DATE,"/",2)=MONTH + NEW DAY SET DAY=$PIECE(DATE,"/",3) + IF $LENGTH(DAY)=1 SET DAY="0"_DAY SET $PIECE(DATE,"/",3)=DAY + SET RESULT=DATE_"; "_TITLE_" - "_AUTHOR +FMTDN QUIT RESULT + ; +PDGETSS(TMGRESULT,TMGPARAMS) ; + ;"Purpose -- Get a subset of list for TORCombobox + ;" NOTE: This should only be called after a successful call to + ;" PDPREPSS^TMGRPCS1 which will prepair the list. + ;"Input: TMGRESULT -- PASS BY REFERENCE. AN OUT PARAMETER + ;" TMGPARAMS -- Input: StartFrom^Direction^MaxCount + ;" StartFrom -- OPTIONAL -- text to $ORDER() from + ;" Direction -- $ORDER(xx,Direction) direction (should be 1 or -1) -- OPTIONAL + ;" MaxCount -- OPTIONAL. Default is 44 values returned. + ;"Results: TMGRESULT(0)="1^Success" or "-1^Message" + ;" TMGRESULT(1)=IEN^2010/6/10; OFFICE NOTE - TOPPENBERG,KEVIN <-- Example + ;" TMGRESULT(2)=IEN^A_Note_Identifier + ; + NEW TMGFROM SET TMGFROM=$PIECE(TMGPARAMS,"^",1) + NEW TMGDIR SET TMGDIR=$PIECE(TMGPARAMS,"^",2) + IF TMGDIR'=-1 SET TMGDIR=1 + NEW TMGMAXCT SET TMGMAXCT=+$PIECE(TMGPARAMS,"^",3) + IF TMGMAXCT=0 SET TMGMAXCT=44 + ; + NEW TMGREF SET TMGREF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",$J,"OR LIST")) + NEW TMGI SET TMGI=0 + FOR SET TMGFROM=$ORDER(@TMGREF@(TMGFROM),TMGDIR) QUIT:(TMGFROM="")!(TMGI'0)!(TMGI'0) DO + . SET CT=CT+1 + . SET OUT(CT)=IEN + IF $DATA(OUT)=0 SET OUT(0)="-1^No results found" + ELSE SET OUT(0)=(CT-1)_"^Success" +RSLTDN QUIT + ; + ; +CLEAR ;"Purpose: Tell background task to stop, and clear data array + DO STOP + KILL ^TMG("TMP","SEARCH","SRCHTIU",$J) + QUIT + ; + ; +STOP ;"Purpose: Tell background task to stop searching + DO MSG("STOP") + QUIT + ; + ; +CHANGESRCH(DFN,TMGSRCH) ; + ;"Purpose: to tell background task to change search parameters + DO MSG("RESTART^"_DFN_"^"_TMGSRCH) + QUIT + ; + ; +MSG(MSG) ; + ;"Purpose to message background task + SET ^TMG("TMP","SEARCH","SRCHTIU",$J,"MSG")=MSG + QUIT + ; + ; + ;"========================================================================== +SRCHTIU(DFN,TMGSRCH,PARENTJOB) ; + ;"Purpose: To search all of one patient's documents for requested words + ;"Input: DFN -- The patient IEN to look up. + ;" TMGSRCH -- Search string. Notes: + ;" Each word (or partial word) to look up is separated by spaces + ;" All words are combined in AND fashion + ;" Search is NOT case sensitive. + ;" Exact pharases can be specified by quotes. + ;" Example: 'dog cat monkey "in a barrel" + ;" PARENTJOB -- the job of the RPCBroker task that called this. + ;"NOTE: this routine will monitor global for messages: + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"MSG")=message + ;" If message of "STOP" is found, then search will be stopped. + ;"Output: Matching documents will be stored at: + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"IEN LIST",IEN)="" + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"IEN LIST",IEN)="" + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"DFN")=DFN + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"FILTER",FilterValue)="" + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"FILTER",FilterValue)="" + ;" When search is done, then message will be stored as + ;" ^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB,"MSG")="DONE" + ;"Results: none + ;"NOTE: This function is designed so that it can do searching on the fly, + ;" as the user is typing in additional terms. Thus, if a prior + ;" search is found, and the prior search doesn't contain any terms + ;" that are not in the current search, then this search cycle will + ;" start with the results of the prior search. + ;" --A consequence of this is that a search of all the documents + ;" will be done first for search term #1, and then term #2, RATHER + ;" THAN searching 1 document for all the search terms. This should + ;" not cause too much of a performace hit because searches for other + ;" terms will be limited to matches for earlier terms + ; + NEW ABORT,IEN,IENLIST + NEW DEBUGI SET DEBUGI=0 + SET DFN=+$GET(DFN) + SET TMGSRCH=$GET(TMGSRCH) + NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB)) +L1 SET @REF@("MSG")="BKGND RUNNING" + DO PREPSRCH(PARENTJOB,DFN,TMGSRCH,.WORDS,.IENLIST) + SET ABORT=0 + NEW TERMCT,TERM + FOR TERMCT=1:1 SET TERM=$GET(WORDS(TERMCT)) QUIT:(TERM="")!ABORT DO + . ;"SET @REF@("DEBUG",DEBUGI)="TERM="_TERM,DEBUGI=DEBUGI+1 + . KILL @REF@("IEN LIST") ;"List will get progressively smaller. So kill and reset each cycle. + . ;"SET @REF@("DEBUG",DEBUGI)="@REF@('IENLIST') killed",DEBUGI=DEBUGI+1 + . SET IEN=0 + . FOR SET IEN=$ORDER(IENLIST(IEN)) QUIT:(+IEN'>0)!(ABORT) DO + . . ;"SET @REF@("DEBUG",DEBUGI)="IEN="_IEN,DEBUGI=DEBUGI+1 + . . NEW MSG SET MSG=@REF@("MSG") + . . IF MSG="STOP" SET ABORT=1 QUIT + . . IF MSG="RESTART" SET ABORT=2 QUIT + . . NEW SRCHRSLT SET SRCHRSLT=$$SRCH1TIU(PARENTJOB,IEN,TERM) + . . ;"SET @REF@("DEBUG",DEBUGI)="Search 1 result="_SRCHRSLT,DEBUGI=DEBUGI+1 + . . IF SRCHRSLT=0 KILL IENLIST(IEN) + . . ELSE IF (SRCHRSLT<0) SET ABORT=-SRCHRSLT + . . ;"SET @REF@("DEBUG",DEBUGI)="IENList count="_$$ListCt^TMGMISC("IENLIST"),DEBUGI=DEBUGI+1 + . IF ABORT=0 DO + . . ;"SET @REF@("DEBUG",DEBUGI)="ABOUT TO MERGE00IENList count="_$$ListCt^TMGMISC("IENLIST"),DEBUGI=DEBUGI+1 + . . ;"SET @REF@("DEBUG",DEBUGI)="merging",DEBUGI=DEBUGI+1 + . . MERGE @REF@("IEN LIST")=IENLIST + . . ;"SET @REF@("DEBUG",DEBUGI)="@REF@(IENList count="_$$ListCt^TMGMISC($name(@REF@("IEN LIST"))),DEBUGI=DEBUGI+1 + . . ;"SET @REF@("DEBUG",DEBUGI)="REF="_REF,DEBUGI=DEBUGI+1 + . . SET @REF@("FILTER",TERM)="" + ;"SET @REF@("DEBUG",DEBUGI)="ABORT="_ABORT,DEBUGI=DEBUGI+1 + IF ABORT=2 GOTO L1 ;"Restart + ;"SET @REF@("DEBUG",DEBUGI)="@REF@(IENList count="_$$ListCt^TMGMISC($name(@REF@("IEN LIST"))),DEBUGI=DEBUGI+1 + SET @REF@("MSG")="DONE" + KILL @REF@("BACKGROUND") + ;"SET @REF@("DEBUG",DEBUGI)="@REF@(IENList count="_$$ListCt^TMGMISC($name(@REF@("IEN LIST"))),DEBUGI=DEBUGI+1 + QUIT ;"This will cause thie JOB'd task to exit and stop execution + ; + ; +PREPSRCH(PARENTJOB,DFN,TMGSRCH,WORDS,IENLIST) ; + ;"Purpose: To Parse the search phrase, and look for prior runs, and use + ;" that work if possible. + ;"Input: PARENTJOB -- the job of the RPCBroker task that called this. + ;" DFN -- The patient IEN to look up. + ;" TMGSRCH -- The Search Phrase. See docs in SRCHTIU + ;" e.g: 'dog cat monkey "in a barrel" + ;" WORDS -- PASS BY REFERENCE. An OUT PARAMETER. Format: + ;" WORDS(WordOrPhrase)="" + ;" e.g. WORDS(1)="DOG" + ;" WORDS(2)="CAT" + ;" WORDS(3)="MONKEY" + ;" WORDS(4)="IN A BARREL" + ;" Note: If prior run is being built upon, then entries that + ;" have already been searched for will be removed. + ;"Results: none + DO PARSSRCH(TMGSRCH,.WORDS) + NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB)) + KILL IENLIST + NEW NEWSRCH SET NEWSRCH=0 ;"Boolean for need to start over a new search + IF $GET(@REF@("DFN"))'=DFN SET NEWSRCH=1 GOTO NS + ;"Look through all prior filters and see if any filters applied that + ;" are not in current search + NEW FILTERS,CT + FOR CT=1:1 QUIT:$DATA(WORDS(CT))=0 SET FILTERS($GET(WORDS(CT)))=1 + NEW OLDFILTER MERGE OLDFILTER=@REF@("FILTER") + NEW OFLTR SET OFLTR="" + FOR SET OFLTR=$ORDER(OLDFILTER(OFLTR)) QUIT:(OFLTR="")!NEWSRCH DO + . IF $GET(FILTERS(OFLTR))=1 KILL FILTERS(OFLTR) QUIT ;"filter term used before, so delete from use again + . ;"Now check if new filters contain a longer verson of old term. I.e. prior + . ;" filter term was 'kitt' and now it is 'kitten' + . NEW FOUND SET FOUND=0 + . NEW F SET F="" + . FOR SET F=$ORDER(FILTERS(F)) QUIT:(F="")!FOUND DO + . . IF $EXTRACT(F,1,$LENGTH(OFLTR))'=OFLTR QUIT + . . SET FOUND=1 + . . KILL @REF@("FILTER",OFLTR) ;"Remove old partial term from history + . IF FOUND=0 SET NEWSRCH=1 ;"A filter was put on old set that is not in new set, so start over +NS IF NEWSRCH=1 DO + . MERGE IENLIST=^TIU(8925,"C",DFN) + . KILL @REF@("IEN LIST") + . KILL @REF@("FILTER") + ELSE DO + . MERGE IENLIST=^TMG("TMP","SEARCH","SRCHTIU",$J,"IEN LIST") + . ;"Recreate WORDS array as numbered list with just desired entries + . SET CT=0 FOR SET CT=$ORDER(WORDS(CT)) QUIT:(CT="") DO + . . IF $DATA(FILTERS(WORDS(CT)))=0 KILL WORDS(CT) ;"Kill all entries in WORDS not in FILTERS + . NEW I SET I=1 + . NEW TEMP + . SET CT=0 FOR SET CT=$ORDER(WORDS(CT)) QUIT:(CT="") DO + . . SET TEMP(I)=$GET(WORDS(CT)),I=I+1 + . KILL WORDS MERGE WORDS=TEMP + SET @REF@("DFN")=DFN + QUIT + ; + ; +PARSSRCH(TMGSRCH,WORDS) ; + ;"Purpose: Separate search phrase out into array of words + ;"Input: TMGSRCH -- The Search Phrase. See docs in SRCHTIU + ;" e.g: 'dog cat monkey "in a barrel" + ;" WORDS -- PASS BY REFERENCE. An OUT PARAMETER. Format: + ;" WORDS(WordOrPhrase)="" + ;" e.g. WORDS(1)="DOG" + ;" WORDS(2)="CAT" + ;" WORDS(3)="MONKEY" + ;" WORDS(4)="IN A BARREL" + ;"Results: none + KILL WORDS + SET TMGSRCH=$GET(TMGSRCH) + NEW CT SET CT=0 + NEW ENTRY,POS + FOR QUIT:(TMGSRCH="") DO + . SET TMGSRCH=$$TRIM^XLFSTR(TMGSRCH) + . IF $EXTRACT(TMGSRCH,1)="""" DO + . . SET ENTRY=$$GetWord^TMGSTUTL(TMGSRCH,2,"""","""") + . . IF ENTRY'="" DO + . . . SET CT=CT+1 + . . . SET WORDS(CT)=$$UP^XLFSTR(ENTRY) + . . SET ENTRY=""""_ENTRY + . . IF $FIND(TMGSRCH,ENTRY_"""")>0 SET ENTRY=ENTRY_"""" + . . NEW SPEC + . . SET SPEC(ENTRY)="" + . . SET SPEC(" ")=" " + . . SET TMGSRCH=$$REPLACE^XLFSTR(TMGSRCH,.SPEC) + . SET ENTRY=$PIECE(TMGSRCH," ",1) + . SET $PIECE(TMGSRCH," ",1)="" + . IF ENTRY'="" DO + . . SET CT=CT+1 + . . SET WORDS(CT)=$$UP^XLFSTR(ENTRY) + QUIT + ; + ; +SRCH1TIU(PARENTJOB,IEN,TERM) ; + ;"Purpose: Search TIU DOCUMENT report text for TERM + ;"Input: IEN -- IEN in 8925 + ;" TERM -- a word, or phrase, to search for in report text + ;"NOTE: Not case sensitive + ;"Result: 1 if found, 0 if not found, -1 if Abort signal found, -2 if RESTART signal + NEW REF SET REF=$NAME(^TMG("TMP","SEARCH","SRCHTIU",PARENTJOB)) + NEW FOUND SET FOUND=0 ;"default to not found + NEW LINE SET LINE=0 + NEW CT SET CT=0 + NEW ABORT SET ABORT=0 + FOR SET LINE=$ORDER(^TIU(8925,IEN,"TEXT",LINE)) QUIT:(+LINE'>0)!FOUND!ABORT DO + . SET CT=CT+1 + . IF CT#5=0 DO QUIT:ABORT ;"Check messages every 5 lines or so + . . SET CT=0 + . . NEW MSG SET MSG=@REF@("MSG") + . . IF MSG="STOP" SET ABORT=1 QUIT + . . IF MSG="RESTART" SET ABORT=2 QUIT + . NEW ONELINE SET ONELINE=$$UP^XLFSTR($GET(^TIU(8925,IEN,"TEXT",LINE,0))) + . IF ONELINE[TERM SET FOUND=1 + IF ABORT SET FOUND=-ABORT + QUIT FOUND + ; Index: cprs/branches/tmg-cprs/m_files/TMGSTUTL.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGSTUTL.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGSTUTL.m Index: cprs/branches/tmg-cprs/m_files/TMGTICK2.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGTICK2.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGTICK2.m Index: cprs/branches/tmg-cprs/m_files/TMGTICKL.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGTICKL.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGTICKL.m Index: cprs/branches/tmg-cprs/m_files/TMGUSRIF.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGUSRIF.m (revision 894) +++ (revision ) @@ -1,1 +1,0 @@ -link /opt/var/FPGVista/p/TMGUSRIF.m