Index: cprs/branches/tmg-cprs/m_files/TMGRPC1C.m
===================================================================
--- cprs/branches/tmg-cprs/m_files/TMGRPC1C.m	(revision 796)
+++ 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                
