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