Index: cprs/branches/tmg-cprs/m_files/TMGDEBUG.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGDEBUG.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGDEBUG.m (revision 894) @@ -1,3 +1,3 @@ -TMGDEBUG ;TMG/kst/Debug utilities: logging, record dump ;03/25/06 +TMGDEBUG ;TMG/kst/Debug utilities: logging, record dump ;03/25/06, 7/11/10 ;;1.0;TMG-LIB;**1**;07/12/05 @@ -22,4 +22,5 @@ ;"DebugExit^TMGDEBUG(DBIndent,ProcName) ;"ShowError^TMGDEBUG(PriorErrorFound,Error) + ;"$$FMERRSTR(ERRARRAY) -- same as $$GetErrStr() ;"$$GetErrStr^TMGDEBUG(ErrArray) ;"ShowIfDIERR^TMGDEBUG(ErrMsg,PriorErrorFound) ;really same as below @@ -410,4 +411,7 @@ +FMERRSTR(ERRARRAY) + QUIT $$GetErrStr(.ERRARRAY) + ; GetErrStr(ErrArray) ;"Purpose: convert a standard DIERR array into a string for output Index: cprs/branches/tmg-cprs/m_files/TMGRPC1B.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC1B.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGRPC1B.m (revision 894) @@ -1,3 +1,3 @@ -TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10 +TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10, 7/11/10 ;;1.0;TMG-LIB;**1**;3/28/10 ; @@ -10,58 +10,56 @@ ;" RPC -- Public Functions. ;"======================================================================= - ;"EVALTIUO - ;"INSTALL -- Add the RPC's to the OPTION record OR CPRS GUI CHART + ;"ENSUREALL -- Ensure all needed TMG RPC entries have been added + ; ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= - ;"INSTALL1(RPCNAME) -- Add 1 RPC to the OPTION record OR CPRS GUI CHART + ;"ENSURE1(RPCNAME) -- ensure 1 RPC is in OPTION record OR CPRS GUI CHART ; ;"======================================================================= ;"======================================================================= ;"Dependencies: - ;" DIC, TMGDEBUG + ;" DIC ;"======================================================================= ;"======================================================================= ; - ;"OK TO DELETE THIS FUNCTION LATER IF WANTED.... -EVALTIUO(TMGY,TMGOBJNM) ;"--- DEPRECIATED. Will use 'TIU TEMPLATE GETTEXT' RPC instead - ;"Purpose: To return the resolved text of a TIU Text Object. - ;"Input: TIUY -- This is output result for RPC caller - ;" TMGOBJNM -- This is the name of the TIU TEXT OBJECT to obtain. - ;"Note: lines wrapped at 200 chars length - ;"Results : none +ENSUREAL + ;"Ensure all needed TMG RPC entries have been added +L1 ;;TMG ADD PATIENT + ;;TMG AUTOSIGN TIU DOCUMENT + ;;TMG BARCODE DECODE + ;;TMG BARCODE ENCODE + ;;TMG CHANNEL + ;;TMG CPRS GET URL LIST + ;;TMG DOWNLOAD FILE + ;;TMG DOWNLOAD FILE DROPBOX + ;;TMG GET BLANK TIU DOCUMENT + ;;TMG GET DFN + ;;TMG GET IMAGE LONG DESCRIPTION + ;;TMG GET PATIENT DEMOGRAPHICS + ;;TMG INIFILE GET + ;;TMG INIFILE SET + ;;TMG MSGLINK CHANNEL + ;;TMG SEARCH CHANNEL + ;;TMG SET PATIENT DEMOGRAPHICS + ;;TMG UPLOAD FILE + ;;TMG UPLOAD FILE DROPBOX + ;;TMG IMAGE DELETE + ;;MAGGADDIMAGE + ;;MAG3 TIU IMAGE + ;;MAG3 CPRS TIU NOTE + ;; ; - KILL ^TMG("TMP","TABLE") - zshow "*":^TMG("TMP","TABLE") - NEW TMGSTR - SET TMGOBJNM=$GET(TMGOBJNM) - IF TMGOBJNM["|" DO GOTO STOR - . SET TMGSTR="Passed TEXT OBJECT name should not contain '|' character" - SET TMGSTR="|"_TMGOBJNM_"|" - SET TMGSTR=$$BOIL^TIUSRVD(TMGSTR) ;" Execute Boilerplates + NEW TMGI + NEW DONE SET DONE=0 + FOR TMGI=0:1 DO QUIT:DONE + . NEW RPC SET RPC=$PIECE($TEXT(L1+TMGI^TMGRPC1B),";;",2) + . IF (RPC="")!(RPC="") SET DONE=1 QUIT + . DO ENSURE1(RPC) + QUIT ; -STOR NEW REF SET REF=$NAME(^TMP("TMG OBJ EVAL",$J)) - NEW IDX SET IDX=0 - KILL @REF - SET TMGY=REF - FOR DO QUIT:(TMGSTR="") - . NEW SA,SB - . SET (SA,SB)="" - . IF $LENGTH(TMGSTR)>200 DO - . . SET SB=$EXTRACT(TMGSTR,201,999) - . . SET TMGSTR=$EXTRACT(TMGSTR,1,200) - . SET IDX=IDX+1 - . SET @REF@(IDX)=TMGSTR - . SET TMGSTR=SB - QUIT - ; - ; -INSTALL ; - ;"Purpose: to add the RPC's to the OPTION record OR CPRS GUI CHART - DO INSTALL1("TMG EVAL TIU TEXT OBJECT") - QUIT - ; -INSTALL1(RPCNAME) ; - ;"Purpose: to add 1 RPC to the OPTION record OR CPRS GUI CHART +ENSURE1(RPCNAME) ; + ;"Purpose: to ensure 1 RPC is in OPTION record OR CPRS GUI CHART + ;" (add if needed) NEW DIC,X,Y,DA SET DIC="^DIC(19,",DIC(0)="M" @@ -83,2 +81,4 @@ . WRITE ! QUIT + + Index: cprs/branches/tmg-cprs/m_files/TMGRPC1C.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC1C.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGRPC1C.m (revision 894) @@ -1,1 +1,539 @@ -QUIT +TMGRPC1C ;TMG/kst-RPC Functions ;07/09/10 + ;;1.0;TMG-LIB;**1**;07/09/10 + + ;"TMG RPC FUNCTIONS especially related to imaging. + + ;"Kevin Toppenberg MD + ;"GNU General Public License (GPL) applies + ;"7/09/10 + + ;"======================================================================= + ;" RPC -- Public Functions. + ;"======================================================================= + ;"GETDEFNL() -- return the default Network Location (file 2005.2) entry + ;"GETLOCFPATH(FPATH,LOCIEN) -- get local (absolute) path for storing on host file system + ;"GETDROPPATH(LOCIEN,DropBox) -- return path to local dropbox. + ;"DOWNLOAD(GREF,FPATH,FNAMEW $$,LOCIEN) + ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) + ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) -- Download drop box file + ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) -- Upload Dropbox File + ;"DELIMAGE(RESULT,IMGIEN,MODE,REASON) -- Delete or Retract Image + ;"UNRETRACT(RESULT,TMGIEN) -- reverse retraction process from DELIMAGE above. + ;"======================================================================= + ;"PRIVATE API FUNCTIONS + ;"======================================================================= + ;"ENCODE(GRef,incSubscr,encodeFn) + ;"DECODE(GRef,incSubscr,decodeFn) + ;"$$HEXCODER(INPUT) ;encode the input string. Currently using simple hex encoding/ + ;"$$B64CODER(INPUT) ;encode the input string via UUENCODE (actually Base64) + ;"$$B64DECODER(INPUT) ;encode the input string via UUDECODE (actually Base64) + ;"ENSUREDIV(FPATH,LOCIEN) ;Ensure that the path ends with an appropriate node divider. + + ;"======================================================================= + ;"Dependancies: + ;" DIK, TMGDEBUG + ;"======================================================================= + ; +GETDEFNL() + ;"Purpose: to return the default Network Location (file 2005.2) entry + ;"Input: None + ;"Results: Returns IEN in file 2005.2, or 1 if some problem. + ; + NEW RESULT SET RESULT=1 ;"Default + ; + ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file. + NEW INSTPTR SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17) ;"Ptr to file $4 (Institution) + IF INSTPTR'>0 GOTO GDFNDN + ; + ;"Now get IMAGING SITE PARAMETERS for Institution Name + NEW IMGSPPTR SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0)) + IF IMGSPPTR'>0 GOTO GDFNDN + ; + ;"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 SET RESULT=LOCPTR + ; +GDFNDN QUIT RESULT + ; + ; +ENSUREDIV(FPATH,LOCIEN) ; + ;"Purpose: Ensure that the path ends with an appropriate node divider. + set FPATH=$GET(FPATH,"/") + set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() + + ;"default is "/" NOTE: CUSTOM FIELD + new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) + + new EndChar set EndChar=$extract(FPATH,$length(FPATH)) + if EndChar'=NodeDiv set FPATH=FPATH_NodeDiv + quit FPATH + ; +GETLOCFPATH(FPATH,LOCIEN) ; + ;"Purpose: to get local (absolute) path for storing on host file system + ;"Input: FPATH -- the file path up to, but not including, the filename + ;" Use '/' to NOT specify any subdirectory + ;" [optional] default is '/' + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from + ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default + ;" values stored in KERNEL SYSTEM PARAMETERS etc. + ;" Note: For security reasons, all path requests will be considered relative to a root path. + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg + ;" This root path is found in custom field 22701 in file 2005.2 + ;"Returns: A path, that can be passed to KERNEL calls for HFS calls. + ;" NOTE: Result WILL end with a node divider + ; + set FPATH=$GET(FPATH,"/") + set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() + + ;"NOTE: CUSTOM FIELD + new PathRoot set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1) + + ;"default is "/" NOTE: CUSTOM FIELD + new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) + + new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot)) + new StartPath set StartPath=$extract(FPATH,1) + + if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do + . set FPATH=$extract(FPATH,2,1024) + else if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do + . set PathRoot=PathRoot_NodeDiv + + set FPATH=$$ENSUREDIV(PathRoot_FPATH,LOCIEN) + quit FPATH + ; + ; +GETDROPPATH(LOCIEN,DropBox) ; + ;"Purpose: return path to local dropbox. + ;"Input: LOCIEN -- the IEN from file 2005.2 (network location) + ;" DropBox -- PASS BY REFERENCE. AN OUT PARAMETER. + ;"Results: 1 if OK, -1 if error + set LOCIEN=+$GET(LOCIEN) + if LOCIEN'>0 set LOCIEN=$$GETDEFNL() + new Result set Result=1 + set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1) + if DropBox="" do goto GDPDN + . set Result=-1 + set DropBox=$$ENSUREDIV(DropBox,LOCIEN) +GDPDN quit Result + + +DOWNLOAD(GREF,FPATH,FNAME,LOCIEN) + ;"SCOPE: Public + ;"Purpose: To provide an entry point for a RPC call from a client. The client + ;" will ask for a given file, and it will be passed back in the form + ;" of an array (in BASE64 ascii encoding) + ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) + ;" FPATH -- the file path up to, but not including, the filename + ;" Use '/' to NOT specify any subdirectory + ;" [optional] default is '/' + ;" FNAME -- the name of the file to pass back + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from + ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default + ;" values stored in KERNEL SYSTEM PARAMETERS etc. + ;" Note: For security reasons, all path requests will be considered relative to a root path. + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg + ;" This root path is found in custom field 22701 in file 2005.2 + ;"Output: results are passed out in @GREF + ;" @GREF@(0)=success; 1=success, 0=failure + ;" @GREF@(1..xxx) = actual data + + set FNAME=$get(FNAME) + set LOCIEN=+$GET(LOCIEN) + if LOCIEN'>0 set LOCIEN=$$GETDEFNL() + set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ; + + set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")" + kill @GREF + set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3) + + do ENCODE($name(@GREF@(1)),3) + + quit + + +UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY) + ;"SCOPE: Public + ;"RPC That calls this: TMG UPLOAD FILE + ;"Purpose: To provide an entry point for a RPC call from a client. The client + ;" will provide a file for upload (in BASE64 ascii encoding) + ;"Input: GREF -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) + ;" FPATH -- the file path up to, but not including, the filename + ;" Use '/' to NOT specify any subdirectory + ;" [optional] default is '/' + ;" FNAME -- the name of the file to pass back + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to + ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default + ;" Note: For security reasons, all path requests will be considered relative to a root path. + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg + ;" This root path is found in custom field 22701 in file 2005.2 + ;" ARRAY -- the array that will hold the file, in BASE64 ascii encoding + ;"Output: results are passed out in RESULT: 1^SuccessMessage or 0^FailureMessage + + new result + new resultMsg set resultMsg="1^Successful Upload" + + set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH) + set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME) + set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN) + + if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone + set FNAME=$get(FNAME) + if FNAME="" do goto UpDone + . set resultMsg="0^No file name received" + + set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL() + + set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ; + + do DECODE("ARRAY(0)",1) + + if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do + . set resultMsg="0^Error while saving file" + +UpDone set RESULT=resultMsg + quit + + +DOWNDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Download drop box file + ;"SCOPE: Public + ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX + ;"Purpose: To provide an entry point for a RPC call from a client. The client + ;" will request for the file to be placed into in a 'dropbox' file + ;" location that both the client and server can access. File may be + ;" moved from there to its final destination by the client. + ;" This method alloows file-hiding ability on the server side. + ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) + ;" FPATH -- the file path up to, but not including, the filename. This + ;" is the path that the file is stored at (relative to a root path, + ;" see comments below). It is NOT the path of the dropbox. + ;" Use '/' to NOT specify any subdirectory + ;" [optional] default is '/' + ;" FNAME -- the name of the file to be uploaded. Note: This is also the + ;" name of the file to be put into the dropbox. It is the + ;" responsibility of the client to ensure that there is not already + ;" a similarly named file in the dropbox before requesting a file + ;" be put there. It is the responsibility of the client to delete + ;" the file from the drop box. + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to download from + ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default + ;" Note: For security reasons, all path requests will be considered relative to a root path. + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg + ;" This root path is found in custom field 22701 in file 2005.2 + ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 + ;"NOTE RE DROPBOX: + ;" This system is designed for a system where by the server and the client have a + ;" shared filesystem, but the directory paths will be different. For example: + ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ + ;" Windows Client has access to dropbox at: V:\Dropbox\ + + ;"Output: results are 1^Success^FileSize (in bytes), or 0^Error Message + + new DropBox,moveResult,SrcNamePath + + new resultMsg set resultMsg="1^Successful Download" + + set FNAME=$get(FNAME) if FNAME="" do goto DnDBxDone + . set resultMsg="0^No file name received" + + set FPATH=$$GETLOCFPATH(.FPATH,.LOCIEN) ; + + if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do goto DnDBxDone + . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" + + set SrcNamePath=FPATH_FNAME + + set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox) + if moveResult>0 do + . set resultMsg="0^Move failed, returning OS error code: "_moveResult + else do + . set resultMsg=resultMsg_"^"_$$FileSize^TMGKERNL(SrcNamePath) + +DnDBxDone + set RESULT=resultMsg + quit + + +UPLDDROP(RESULT,FPATH,FNAME,LOCIEN) ;"i.e. Upload Dropbox File + ;"SCOPE: Public + ;"RPC That calls this: TMG UPLOAD FILE DROPBOX + ;"Purpose: To provide an entry point for a RPC call from a client. The client + ;" will put the file in a 'dropbox' file location that both the client + ;" and server can access. File will be moved from there to its final + ;" destination. This will provide file-hiding ability on the server side. + ;"Input: RESULT -- OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE) + ;" FPATH -- the file path up to, but not including, the filename. This + ;" is the path to store the file at. (relative to a root path, + ;" see comments below). It is NOT the path of the dropbox. + ;" Use '/' to NOT specify any subdirectory + ;" [optional] default is '/' + ;" FNAME -- the name of the file to be uploaded. Note: This is also the + ;" name of the file to be pulled from the dropbox. It is the + ;" responsibility of the client to ensure that there is not already + ;" a similarly named file in the dropbox before depositing a file there. + ;" The server will remove the file from the dropbox, unless there is + ;" an error with the host OS (which will be returned as an error message) + ;" LOCIEN-- [optional] -- the IEN from file 2005.2 (network location) to upload to + ;" NOTE: DEPRECIATED. Should pass "" to allow code to lookup default + ;" Note: For security reasons, all path requests will be considered relative to a root path. + ;" e.g. if user asks for /download/SomeFile.jpg, this function will retrieve: + ;" /var/local/Dir1/Dir2/download/SomeFile.jpg + ;" This root path is found in custom field 22700 in file 2005.2 + ;" Also: dropbox location is obtained from custom field 22702 in file 2005.2 + ;"NOTE RE DROPBOX: + ;" This system is designed for a system where by the server and the client have a + ;" shared filesystem, but the directory paths will be different. For example: + ;" Linux server has dropbox at: /mnt/WinServer/dropbox/ + ;" Windows Client has access to dropbox at: V:\Dropbox\ + + ;"Output: results are passed out in RESULT: + ;" 1^SuccessMessage or 0^FailureMessage + + new SrcNamePath,DestNamePath,moveResult + new resultMsg set resultMsg="1^Successful Upload" + + set FNAME=$get(FNAME) + if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone + + new DropBox + if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do goto UpDBxDone + . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702" + + set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ; + + set SrcNamePath=DropBox_FNAME + set DestNamePath=FPATH_FNAME + + set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath) + if moveResult>0 do + . set resultMsg="0^Move failed, returning OS error code: "_moveResult + +UpDBxDone + set RESULT=resultMsg + quit + + +ENCODE(GRef,incSubscr,encodeFn) + ;"Purpose: ENCODE a BINARY GLOBAL. + ;"Input: + ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved + ;" (closed root) format. + ;" Note: + ;" At least one subscript must be numeric. This will be the incrementing + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment + ;" to store each new global node). This subscript need not be the final + ;" subscript. For example, to load into a WORD PROCESSING field, the + ;" incrementing node is the second-to-last subscript; the final subscript + ;" is always zero. + ;" REQUIRED + ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global + ;" reference, such as ^TMP(115,1,x,0). + ;" REQUIRED + ;" encodeFn- (OPTIONAL) the name of a function that will encode a line of data. + ;" e.g. "CODER^ZZZCODER" or "LOCALCODER". The function should + ;" take one input variable (the line of raw binary data), and return a converted + ;" line. e.g. + ;" CODER(INPUT) + ;" ... ;"convert INPUT to RESULT + ;" QUIT RESULT + ;" default value is B64CODER^TMGRPC1 + ;" + ;"Output: @GRef is converted to encoded data + ;"Result: None + + if $get(GRef)="" goto EncodeDone + if $get(incSubscr)="" goto EncodeDone + + set encodeFn=$get(encodeFn,"B64CODER") + + new encoder + set encoder="set temp=$$"_encodeFn_"(.temp)" + + for do quit:(GRef="") + . new temp + . set temp=$get(@GRef) + . if temp="" set GRef="" quit + . xecute encoder ;"i.e. set temp=$$encoderFn(.temp) + . set @GRef=temp + . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) + +EncodeDone + quit + + +HEXCODER(INPUT) + ;"Purpose: to encode the input string. Currently using simple hex encoding/ + quit $$STRB2H^TMGSTUTL(.INPUT,0,1) + + +B64CODER(INPUT) + ;"Purpose: to encode the input string via UUENCODE (actually Base64) + quit $$ENCODE^RGUTUU(.INPUT) + +B64DECODER(INPUT) + ;"Purpose: to encode the input string via UUENCODE (actually Base64) + quit $$DECODE^RGUTUU(.INPUT) + + +DECODE(GRef,incSubscr,decodeFn) + ;"Purpose: ENCODE a BINARY GLOBAL. + ;"Input: + ;" GRef-- Global reference of the SOURCE binary global array, in fully resolved + ;" (closed root) format. + ;" Note: + ;" At least one subscript must be numeric. This will be the incrementing + ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment + ;" to store each new global node). This subscript need not be the final + ;" subscript. For example, to load into a WORD PROCESSING field, the + ;" incrementing node is the second-to-last subscript; the final subscript + ;" is always zero. + ;" REQUIRED + ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global + ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and + ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third + ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global + ;" reference, such as ^TMP(115,1,x,0). + ;" REQUIRED + ;" decodeFn- (OPTIONAL) the name of a function that will decode a line of data. + ;" e.g. "DECODER^ZZZCODER" or "DECODER". The function should take + ;" one input variable (the line of encoded data), and return a decoded line. e.g. + ;" DECODER(INPUT) + ;" ... ;"convert INPUT to RESULT + ;" QUIT RESULT + ;" default value is B64DECODER^TMGRPC1 + ;" + ;"Output: @GRef is converted to decoded data + ;"Result: None + + if $get(GRef)="" goto DecodeDone + if $get(incSubscr)="" goto DecodeDone + set decodeFn=$get(decodeFn,"B64DECODER") + + new decoder + set decoder="set temp=$$"_decodeFn_"(.temp)" + + for do quit:(GRef="") + . new temp + . set temp=$get(@GRef) + . if temp="" set GRef="" quit + . xecute decoder ;"i.e. set temp=$$decoderFn(.temp) + . set @GRef=temp + . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1) + +DecodeDone + quit + ; + ; +DELIMAGE(RESULT,TMGIEN,TMGMODE,TMGREASON) ; + ;"Purpose: Provide functionality for deleting or retacting an image from CPRS + ;"NOTE: MAGG IMAGE DELETE is not used because it does things like archive + ;" the images before deletion. I don't have this system fully integrated + ;" In the future, that could possibly be used. + ;"NOTE: This function DOES NOT CHECK PERMISSIONS for deleting the images. + ;" It is assumed that that has been doine PRIOR to calling this function. + ;"NOTE: It mode is to retract (see below), then the image will not be + ;" actually be deleted. It will just be marked as retracted and + ;" set so that it doesn't appear in CPRS. + ;" --But if mode is to delete, then the record in the IMAGE file + ;" will be deleted AND ALSO the actual image (with no backup.) This + ;" mode is for deletion before signing, and the image has not been + ;" formally entered into the record. + ;"Input: RESULT -- an OUT Parameter. (See results below) + ;" TMGIEN -- the IEN in the IMAGE file (2005) to remove + ;" TMGMODE -- 0 for NONE <-- just exit and do nothing + ;" 1 for DELETE <-- delete record and image file + ;" 2 for RETRACT <-- mark record as retracted, don't delete iamge file. + ;" TMGREASON -- String (10-60 chars) giving reason for deletion. + ;" This is only used for mode RETRACT. + ;"Output: RESULT="1^Success" or "-1^Some Failure Message" <-- set up as SINGLE VALUE type in RPC BROKER + ; + SET RESULT="1^Success" ;"Default to success + SET TMGIEN=$GET(TMGIEN,0) + IF +TMGIEN'>0 DO GOTO DIDN + . SET RESULT="-1^Invalid IEN: "_TMGIEN + SET TMGIEN=+TMGIEN + SET TMGMODE=+$GET(TMGMODE) + IF TMGMODE=0 DO GOTO DIDN + . SET RESULT="1^Delete not done because mode=0" + SET TMGREASON=$GET(TMGREASON,"(Not Specified)") + NEW TMGPTR SET TMGPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",8) ;"2;8 ==> Field 18 = PARENT DATA FILE IMAGE POINTER + IF TMGPTR'>0 DO GOTO DIDN + . SET RESULT="-1^FILE 2005, IEN "_TMGIEN_", Field 18 does not point to valid record in file 8925.91" + NEW TMGTIUPTR SET TMGTIUPTR=+$PIECE($GET(^TIU(8925.91,TMGPTR,0)),"^",1) ;"0;1 ==> Field .01 = DOCUMENT (ptr to 8925) + IF TMGMODE=1 DO GOTO:(+RESULT'>0) DIDN ;"Delete mode + . NEW FNAME SET FNAME=$PIECE($GET(^MAG(2005,TMGIEN,0)),"^",2) + . NEW TMGPATH SET TMGPATH=$$GETLOCFPATH() + . NEW TMGARRAY,DELRSLT + . SET TMGARRAY(FNAME)="" + . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY") + . IF DELRSLT=0 DO QUIT + . . SET RESULT="-1^Unable to delete file: "_TMGPATH_FNAME + . KILL TMGARRAY + . NEW FNAME2 SET FNAME2=FNAME + . SET $PIECE(FNAME2,",",$LENGTH(FNAME2,"."))="ABS" + . SET TMGARRAY(FNAME2)="" + . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY") ;"Ingnore results. Thumbnail not always present + . NEW DIK SET DIK="^MAG(2005," + . NEW DA SET DA=TMGIEN + . DO ^DIK ;"Kill Record in 2005 + ELSE IF TMGMODE=2 DO GOTO:(+RESULT'>0) DIDN ;"Retract mode + . NEW TMGFDA,TMGMSG,TMGIENS + . SET TMGIENS=TMGIEN_"," + . SET TMGFDA(2005,TMGIENS,30)="`"_+DUZ + . SET TMGFDA(2005,TMGIENS,30.1)="NOW" + . SET TMGFDA(2005,TMGIENS,30.2)=TMGREASON + . SET TMGFDA(2005,TMGIENS,18)="@" + . ;"NOTE: Fld 17 already holds IEN of linked 8925 document + . DO FILE^DIE("EKT","TMGFDA","TMGMSG") + . IF $DATA(TMGMSG("DIERR")) DO + . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) + DO ;"Do this for both DELETE and RETRACT modes. + . NEW DIK SET DIK="^TIU(8925.91," + . NEW DA SET DA=TMGPTR + . DO ^DIK ;"Kill record in 8925.91 + ; +DIDN QUIT + ; +UNRETRACT(RESULT,TMGIEN) ; + ;"Purpose: to reverse retraction process from DELIMAGE above. + ;"Input: RESULT -- an OUT Parameter. (See results below) + ;" TMGIEN -- the IEN in the IMAGE file (2005) to remove + ;"Output: RESULT="1^Success" or "-1^Some Failure Message" <-- set up as SINGLE VALUE type in RPC BROKER + SET TMGIEN=$GET(TMGIEN) + IF +TMGIEN'>0 DO GOTO URDN + . SET RESULT="-1^Invalid IEN supplied: "_TMGIEN + SET TMGIEN=+TMGIEN + NEW TIUPTR SET TIUPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",7) + IF TIUPTR'>0 DO GOTO URDN + . SET RESULT="-1^Record 2005 doesn't hold link to TIU DOCUMENT in field 17" + NEW TMGFDA,TMGFDA,TMGIENS + ;"-- Recreate TIU EXTERNAL DATA LINK record + KILL TMGFDA + SET TMGIENS="+1," + SET TMGFDA(8925.91,TMGIENS,.01)=TIUPTR + SET TMGFDA(8925.91,TMGIENS,.02)=TMGIEN + DO UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG") + IF $DATA(TMGMSG("DIERR")) DO GOTO URDN + . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) + NEW TIUIMGPTR SET TIUIMGPTR=+$GET(TMGIEN(1)) + IF TIUIMGPTR'>0 DO GOTO URDN + . SET RESULT="-1^Unable to locate recreated TIU EXTERNAL DATA LINK record" + ;"-- remove DELETED info from IMAGE record -- + NEW TMGFDA,TMGFDA,TMGIENS + SET TMGIENS=TMGIEN_"," + SET TMGFDA(2005,TMGIENS,30)="@" + SET TMGFDA(2005,TMGIENS,30.1)="@" + SET TMGFDA(2005,TMGIENS,30.2)="@" + SET TMGFDA(2005,TMGIENS,18)=TIUIMGPTR + DO FILE^DIE("EKT","TMGFDA","TMGMSG") + IF $DATA(TMGMSG("DIERR")) DO GOTO URDN + . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG) + +URDN QUIT Index: cprs/branches/tmg-cprs/m_files/TMGRPC3.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC3.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGRPC3.m (revision 894) @@ -1,3 +1,3 @@ -TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08 +TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08, 7/7/10 ;;1.0;TMG-LIB;**1**;08/31/08 ; @@ -61,5 +61,5 @@ ;" params: FileNum^SourceIENS^New.01Value ;" "GET HELP MSG" - ;" params : FileNum^FieldNum^HelpType + ;" params : FileNum^FieldNum^HelpType^IENS ;" "IS WP FIELD" ;" params: FileNum^FieldNum Index: cprs/branches/tmg-cprs/m_files/TMGRPC3E.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPC3E.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGRPC3E.m (revision 894) @@ -1,3 +1,3 @@ -TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08 +TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08, 7/7/10 ;;1.0;TMG-LIB;**1**;08/31/08 ; @@ -57,5 +57,5 @@ ;"Purpose: to retrieve the help message for a given field. ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE. - ;" TMGPARAMS -- file^field^HelpType + ;" TMGPARAMS -- file^field^HelpType^IENS ;"Output: TMGOUT is filled as follows: ;" TMGOUT(0)="1^Success" or "-1^Message" @@ -67,9 +67,10 @@ NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2) NEW TMGHELPTYPE SET TMGHELPTYPE=$PIECE(TMGPARAMS,"^",3) + NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",4) IF TMGFILE'>0 DO GOTO GHMDONE . SET TMGOUT(0)="-1^No file number supplied" IF TMGFIELD'>0 DO GOTO GHMDONE . SET TMGOUT(0)="-1^No Field Number supplied" - DO HELP^DIE(TMGFILE,,TMGFIELD,TMGHELPTYPE,"TMGMSG") + DO HELP^DIE(TMGFILE,TMGIENS,TMGFIELD,TMGHELPTYPE,"TMGMSG") NEW TMGI SET TMGI="" FOR SET TMGI=$ORDER(TMGMSG("DIHELP",TMGI)) QUIT:(TMGI="") DO Index: cprs/branches/tmg-cprs/m_files/TMGRPCSR.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGRPCSR.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGRPCSR.m (revision 894) @@ -28,5 +28,5 @@ ; CHANNEL(TMGRESULT,INPUT) ; - ;"Purpose: This will be a general purpose channel RPC from a GUI config program + ;"Purpose: This will be a general purpose channel RPC from CPRS ;"Input: TMGRESULT -- this is an OUT parameter, and it is always passed by reference ;" INPUT -- this will be array of data sent from the GUI client. Defined below: @@ -56,4 +56,29 @@ ;" "RESULTS LIST SUBSET" -- get sublist of search results ;" params: JobNum^ListStartValue^direction^MaxCount(optional, def=44) + ;" ================================================================================= + ;" == Calls for searching TIU DOCUMENTS == + ;" ================================================================================= + ;" "PT DOCS SEARCH" -- launch a background search in documents for 1 patient + ;" params: PatientEIN^SearchString + ;" "PT DOCS STATUS" -- Get status of background search + ;" params : none + ;" "PT DOCS GET RESULTS" -- get result from background search + ;" params : none + ;" "PT DOCS CLEAR" -- Tell background task to stop, and clear data array + ;" params : none + ;" "PT DOCS STOP" -- Tell background task to stop searching + ;" params : none + ;" "PT DOCS CHANGE SEARCH" -- tell background task to change search parameters + ;" Note: this can be used to 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. + ;" params: PatientEIN^SearchString + ;" "PT DOCS PREP FOR SUBSET" -- Prep for Subset of List for TORCombobox + ;" params : none + ;" "PT DOCS SUBSET OF RESULTS" -- Get a subset of list for TORCombobox + ;" params : StartFrom^Direction^MaxCount + ;" Direction and Maxcount are optional, def=1, 44 respectively + ;" ================================================================================= ;"Output: results of this function should be put into TMGRESULTS array. ;" For cmd: @@ -86,4 +111,27 @@ ;" TMGRESULT(2)=IENNum^RequestedFieldNames ;" etc ... + ;" ================================================================================= + ;" == Calls for searching TIU DOCUMENTS == + ;" ================================================================================= + ;" "PT DOCS SEARCH" + ;" TMGRESULT(0)="1^Success", OR -1^ErrorMsg + ;" "PT DOCS STATUS" + ;" TMGRESULT(0)="1^Status" or -1^ErrorMessage + ;" NOTe: will return 1^DONE when done with search. + ;" "PT DOCS GET RESULTS" + ;" TMGRESULT(0)=FoundCount^Success, or -1^Message + ;" TMGRESULT(1)=IEN1 + ;" TMGRESULT(2)=IEN2 ... etc. + ;" "PT DOCS CLEAR" + ;" TMGRESULT(0)="1^Success + ;" "PT DOCS STOP" + ;" TMGRESULT(0)="1^Success + ;" "PT DOCS PREP FOR SUBSET" + ;" TMGRESULT(0)="1^Success", OR -1^ErrorMsg + ;" "PT DOCS SUBSET OF RESULTS" + ;" TMGRESULT(0)="1^Success" or "-1^Message" + ;" TMGRESULT(1)=IEN^ANoteIdentifier + ;" TMGRESULT(2)=IEN^ANoteIdentifier + ;" ================================================================================= ;"Result: none ; @@ -112,5 +160,21 @@ ELSE IF TMGCOMMAND="RESULTS LIST SUBSET" DO . DO GETRSLTSB^TMGRPCS0(.TMGRESULT,TMGPARAMS) - ; + ELSE IF TMGCOMMAND="PT DOCS SEARCH" DO + . DO PDSRCH^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS STATUS" DO + . DO PDSTATUS^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS GET RESULTS" DO + . DO PDRESULT^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS CLEAR" DO + . DO PDCLEAR^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS STOP" DO + . DO PDSTOP^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS CLEAR" DO + . DO PDCLEAR^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS PREP FOR SUBSET" DO + . DO PDPREPSS^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ELSE IF TMGCOMMAND="PT DOCS SUBSET OF RESULTS" DO + . DO PDGETSS^TMGRPCS1(.TMGRESULT,TMGPARAMS) + ; QUIT ; Index: cprs/branches/tmg-cprs/m_files/TMGSRCH1.m =================================================================== --- cprs/branches/tmg-cprs/m_files/TMGSRCH1.m (revision 893) +++ cprs/branches/tmg-cprs/m_files/TMGSRCH1.m (revision 894) @@ -2,5 +2,5 @@ ;;1.0;TMG-LIB;**1**;05/19/10 ; - ;"TMG FILEMAN SEARCH API + ;"UTILITIES FOR TMG FILEMAN SEARCH API ; ;"Copyright Kevin Toppenberg MD 5/19/10