Changeset 894 for cprs


Ignore:
Timestamp:
Jul 25, 2010, 2:51:23 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

interval update

Location:
cprs/branches/tmg-cprs/m_files
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • cprs/branches/tmg-cprs/m_files/TMGDEBUG.m

    r796 r894  
    1 TMGDEBUG ;TMG/kst/Debug utilities: logging, record dump ;03/25/06
     1TMGDEBUG ;TMG/kst/Debug utilities: logging, record dump ;03/25/06, 7/11/10
    22         ;;1.0;TMG-LIB;**1**;07/12/05
    33
     
    2222 ;"DebugExit^TMGDEBUG(DBIndent,ProcName)
    2323 ;"ShowError^TMGDEBUG(PriorErrorFound,Error)
     24 ;"$$FMERRSTR(ERRARRAY) -- same as $$GetErrStr()
    2425 ;"$$GetErrStr^TMGDEBUG(ErrArray)
    2526 ;"ShowIfDIERR^TMGDEBUG(ErrMsg,PriorErrorFound)  ;really same as below
     
    410411
    411412
     413FMERRSTR(ERRARRAY)
     414        QUIT $$GetErrStr(.ERRARRAY)
     415        ;
    412416GetErrStr(ErrArray)
    413417        ;"Purpose: convert a standard DIERR array into a string for output
  • cprs/branches/tmg-cprs/m_files/TMGRPC1B.m

    r796 r894  
    1 TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10
     1TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10, 7/11/10
    22         ;;1.0;TMG-LIB;**1**;3/28/10
    33 ;
     
    1010 ;" RPC -- Public Functions.
    1111 ;"=======================================================================
    12  ;"EVALTIUO
    13  ;"INSTALL -- Add the RPC's to the OPTION record OR CPRS GUI CHART
     12 ;"ENSUREALL -- Ensure all needed TMG RPC entries have been added
     13 ;
    1414 ;"=======================================================================
    1515 ;"PRIVATE API FUNCTIONS
    1616 ;"=======================================================================
    17  ;"INSTALL1(RPCNAME) -- Add 1 RPC to the OPTION record OR CPRS GUI CHART
     17 ;"ENSURE1(RPCNAME) -- ensure 1 RPC is in OPTION record OR CPRS GUI CHART
    1818 ;
    1919 ;"=======================================================================
    2020 ;"=======================================================================
    2121 ;"Dependencies:
    22  ;" DIC, TMGDEBUG
     22 ;" DIC
    2323 ;"=======================================================================
    2424 ;"=======================================================================
    2525 ;
    26  ;"OK TO DELETE THIS FUNCTION LATER IF WANTED....
    27 EVALTIUO(TMGY,TMGOBJNM) ;"--- DEPRECIATED.  Will use 'TIU TEMPLATE GETTEXT' RPC instead
    28         ;"Purpose: To return the resolved text of a TIU Text Object.
    29         ;"Input: TIUY -- This is output result for RPC caller
    30         ;"       TMGOBJNM -- This is the name of the TIU TEXT OBJECT to obtain.
    31         ;"Note: lines wrapped at 200 chars length
    32         ;"Results : none
     26ENSUREAL
     27        ;"Ensure all needed TMG RPC entries have been added
     28L1      ;;TMG ADD PATIENT
     29        ;;TMG AUTOSIGN TIU DOCUMENT
     30        ;;TMG BARCODE DECODE
     31        ;;TMG BARCODE ENCODE
     32        ;;TMG CHANNEL
     33        ;;TMG CPRS GET URL LIST
     34        ;;TMG DOWNLOAD FILE
     35        ;;TMG DOWNLOAD FILE DROPBOX
     36        ;;TMG GET BLANK TIU DOCUMENT
     37        ;;TMG GET DFN
     38        ;;TMG GET IMAGE LONG DESCRIPTION
     39        ;;TMG GET PATIENT DEMOGRAPHICS
     40        ;;TMG INIFILE GET
     41        ;;TMG INIFILE SET
     42        ;;TMG MSGLINK CHANNEL
     43        ;;TMG SEARCH CHANNEL
     44        ;;TMG SET PATIENT DEMOGRAPHICS
     45        ;;TMG UPLOAD FILE
     46        ;;TMG UPLOAD FILE DROPBOX
     47        ;;TMG IMAGE DELETE
     48        ;;MAGGADDIMAGE
     49        ;;MAG3 TIU IMAGE
     50        ;;MAG3 CPRS TIU NOTE
     51        ;;<END>
    3352        ;
    34         KILL ^TMG("TMP","TABLE")
    35         zshow "*":^TMG("TMP","TABLE")
    36         NEW TMGSTR
    37         SET TMGOBJNM=$GET(TMGOBJNM)
    38         IF TMGOBJNM["|" DO  GOTO STOR
    39         . SET TMGSTR="Passed TEXT OBJECT name should not contain '|' character"
    40         SET TMGSTR="|"_TMGOBJNM_"|"
    41         SET TMGSTR=$$BOIL^TIUSRVD(TMGSTR) ;" Execute Boilerplates
     53        NEW TMGI
     54        NEW DONE SET DONE=0
     55        FOR TMGI=0:1 DO  QUIT:DONE
     56        . NEW RPC SET RPC=$PIECE($TEXT(L1+TMGI^TMGRPC1B),";;",2)
     57        . IF (RPC="")!(RPC="<END>") SET DONE=1 QUIT
     58        . DO ENSURE1(RPC)
     59        QUIT
    4260        ;
    43 STOR    NEW REF SET REF=$NAME(^TMP("TMG OBJ EVAL",$J))
    44         NEW IDX SET IDX=0
    45         KILL @REF
    46         SET TMGY=REF
    47         FOR  DO  QUIT:(TMGSTR="")
    48         . NEW SA,SB
    49         . SET (SA,SB)=""
    50         . IF $LENGTH(TMGSTR)>200 DO
    51         . . SET SB=$EXTRACT(TMGSTR,201,999)
    52         . . SET TMGSTR=$EXTRACT(TMGSTR,1,200)
    53         . SET IDX=IDX+1
    54         . SET @REF@(IDX)=TMGSTR
    55         . SET TMGSTR=SB
    56         QUIT
    57  ;
    58  ;
    59 INSTALL ;
    60         ;"Purpose: to add the RPC's to the OPTION record OR CPRS GUI CHART
    61         DO INSTALL1("TMG EVAL TIU TEXT OBJECT")
    62         QUIT
    63  ;
    64 INSTALL1(RPCNAME) ;
    65         ;"Purpose: to add 1 RPC to the OPTION record OR CPRS GUI CHART
     61ENSURE1(RPCNAME) ;
     62        ;"Purpose: to ensure 1 RPC is in OPTION record OR CPRS GUI CHART
     63        ;"         (add if needed)
    6664        NEW DIC,X,Y,DA
    6765        SET DIC="^DIC(19,",DIC(0)="M"
     
    8381        . WRITE !
    8482        QUIT
     83       
     84       
  • cprs/branches/tmg-cprs/m_files/TMGRPC1C.m

    r796 r894  
    1 QUIT
     1TMGRPC1C ;TMG/kst-RPC Functions ;07/09/10
     2         ;;1.0;TMG-LIB;**1**;07/09/10
     3
     4 ;"TMG RPC FUNCTIONS especially related to imaging.
     5
     6 ;"Kevin Toppenberg MD
     7 ;"GNU General Public License (GPL) applies
     8 ;"7/09/10
     9
     10 ;"=======================================================================
     11 ;" RPC -- Public Functions.
     12 ;"=======================================================================
     13 ;"GETDEFNL() -- return the default Network Location (file 2005.2) entry
     14 ;"GETLOCFPATH(FPATH,LOCIEN) -- get local (absolute) path for storing on host file system
     15 ;"GETDROPPATH(LOCIEN,DropBox) -- return path to local dropbox.
     16 ;"DOWNLOAD(GREF,FPATH,FNAMEW $$,LOCIEN)
     17 ;"UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
     18 ;"DOWNDROP(RESULT,FPATH,FNAME,LOCIEN)  -- Download drop box file
     19 ;"UPLDDROP(RESULT,FPATH,FNAME,LOCIEN)  -- Upload Dropbox File
     20 ;"DELIMAGE(RESULT,IMGIEN,MODE,REASON) -- Delete or Retract Image
     21 ;"UNRETRACT(RESULT,TMGIEN) -- reverse retraction process from DELIMAGE above.
     22 ;"=======================================================================
     23 ;"PRIVATE API FUNCTIONS
     24 ;"=======================================================================
     25 ;"ENCODE(GRef,incSubscr,encodeFn)
     26 ;"DECODE(GRef,incSubscr,decodeFn)
     27 ;"$$HEXCODER(INPUT)    ;encode the input string.  Currently using simple hex encoding/
     28 ;"$$B64CODER(INPUT)    ;encode the input string via UUENCODE (actually Base64)
     29 ;"$$B64DECODER(INPUT)  ;encode the input string via UUDECODE (actually Base64)
     30 ;"ENSUREDIV(FPATH,LOCIEN) ;Ensure that the path ends with an appropriate node divider.
     31
     32 ;"=======================================================================
     33 ;"Dependancies:
     34 ;" DIK, TMGDEBUG
     35 ;"=======================================================================
     36 ;
     37GETDEFNL()
     38        ;"Purpose: to return the default Network Location (file 2005.2) entry
     39        ;"Input: None
     40        ;"Results: Returns IEN in file 2005.2,  or 1 if some problem.
     41        ;     
     42        NEW RESULT SET RESULT=1  ;"Default
     43        ;
     44        ;"First get default INSTITUTION, stored in KERNEL SYSTEM PARAMETERS file.
     45        NEW INSTPTR  SET INSTPTR=+$PIECE($GET(^XTV(8989.3,1,"XUS")),"^",17)  ;"Ptr to file $4 (Institution)
     46        IF INSTPTR'>0 GOTO GDFNDN
     47        ;
     48        ;"Now get IMAGING SITE PARAMETERS for Institution Name
     49        NEW IMGSPPTR SET IMGSPPTR=+$ORDER(^MAG(2006.1,"B",INSTPTR,0))
     50        IF IMGSPPTR'>0 GOTO GDFNDN
     51        ;
     52        ;"Now get NETWORK LOCATION stored in IMAGING SITE PARAMETERS record
     53        NEW LOCPTR SET LOCPTR=+$PIECE($GET(^MAG(2006.1,IMGSPPTR,0)),"^",3)
     54        IF LOCPTR>0 SET RESULT=LOCPTR
     55        ;       
     56GDFNDN  QUIT RESULT
     57        ;
     58        ;
     59ENSUREDIV(FPATH,LOCIEN) ;
     60        ;"Purpose: Ensure that the path ends with an appropriate node divider.
     61        set FPATH=$GET(FPATH,"/")       
     62        set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
     63
     64        ;"default is "/"    NOTE: CUSTOM FIELD
     65        new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1) 
     66
     67        new EndChar set EndChar=$extract(FPATH,$length(FPATH))
     68        if EndChar'=NodeDiv set FPATH=FPATH_NodeDiv
     69        quit FPATH
     70        ;       
     71GETLOCFPATH(FPATH,LOCIEN) ;
     72        ;"Purpose: to get local (absolute) path for storing on host file system
     73        ;"Input: FPATH --      the file path up to, but not including, the filename
     74        ;"                     Use '/' to NOT specify any subdirectory
     75        ;"                     [optional] default is '/'
     76        ;"       LOCIEN--      [optional] -- the IEN from file 2005.2 (network location) to download from
     77        ;"                      NOTE: DEPRECIATED.  Should pass "" to allow code to lookup default
     78        ;"                      values stored in KERNEL SYSTEM PARAMETERS etc.
     79        ;"                      Note: For security reasons, all path requests will be considered relative to a root path.
     80        ;"                            e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
     81        ;"                                        /var/local/Dir1/Dir2/download/SomeFile.jpg
     82        ;"                            This root path is found in custom field 22701 in file 2005.2
     83        ;"Returns: A path, that can be passed to KERNEL calls for HFS calls.
     84        ;"         NOTE: Result WILL end with a node divider
     85        ;
     86        set FPATH=$GET(FPATH,"/")       
     87        set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
     88
     89        ;"NOTE: CUSTOM FIELD
     90        new PathRoot set PathRoot=$piece($get(^MAG(2005.2,LOCIEN,22700)),"^",1)
     91
     92        ;"default is "/"    NOTE: CUSTOM FIELD
     93        new NodeDiv set NodeDiv=$piece($get(^MAG(2005.2,LOCIEN,22701),"/"),"^",1)
     94
     95        new EndRoot set EndRoot=$extract(PathRoot,$length(PathRoot))
     96        new StartPath set StartPath=$extract(FPATH,1)
     97
     98        if (EndRoot=NodeDiv)&(StartPath=NodeDiv) do
     99        . set FPATH=$extract(FPATH,2,1024)
     100        else  if (EndRoot'=NodeDiv)&(StartPath'=NodeDiv) do
     101        . set PathRoot=PathRoot_NodeDiv
     102
     103        set FPATH=$$ENSUREDIV(PathRoot_FPATH,LOCIEN)
     104        quit FPATH
     105        ;
     106        ;
     107GETDROPPATH(LOCIEN,DropBox) ;
     108        ;"Purpose: return path to local dropbox.
     109        ;"Input: LOCIEN  -- the IEN from file 2005.2 (network location)
     110        ;"       DropBox -- PASS BY REFERENCE.  AN OUT PARAMETER.
     111        ;"Results: 1 if OK, -1 if error
     112        set LOCIEN=+$GET(LOCIEN)
     113        if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
     114        new Result set Result=1       
     115        set DropBox=$piece($get(^MAG(2005.2,LOCIEN,22702)),"^",1)
     116        if DropBox="" do  goto GDPDN
     117        . set Result=-1       
     118        set DropBox=$$ENSUREDIV(DropBox,LOCIEN)
     119GDPDN   quit Result
     120
     121       
     122DOWNLOAD(GREF,FPATH,FNAME,LOCIEN)
     123        ;"SCOPE: Public
     124        ;"Purpose: To provide an entry point for a RPC call from a client.  The client
     125        ;"              will ask for a given file, and it will be passed back in the form
     126        ;"              of an array (in BASE64 ascii encoding)
     127        ;"Input: GREF --        OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
     128        ;"       FPATH --      the file path up to, but not including, the filename
     129        ;"                     Use '/' to NOT specify any subdirectory
     130        ;"                     [optional] default is '/'
     131        ;"       FNAME --     the name of the file to pass back
     132        ;"       LOCIEN--      [optional] -- the IEN from file 2005.2 (network location) to download from
     133        ;"                            NOTE: DEPRECIATED.  Should pass "" to allow code to lookup default
     134        ;"                            values stored in KERNEL SYSTEM PARAMETERS etc.
     135        ;"                            Note: For security reasons, all path requests will be considered relative to a root path.
     136        ;"                                    e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
     137        ;"                                        /var/local/Dir1/Dir2/download/SomeFile.jpg
     138        ;"                                    This root path is found in custom field 22701 in file 2005.2
     139        ;"Output: results are passed out in @GREF
     140        ;"              @GREF@(0)=success;    1=success, 0=failure
     141        ;"              @GREF@(1..xxx) = actual data
     142
     143        set FNAME=$get(FNAME)
     144        set LOCIEN=+$GET(LOCIEN)
     145        if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
     146        set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ;
     147
     148        set GREF="^TMP(""DOWNLOAD^TMGRPC1"","_$J_")"
     149        kill @GREF
     150        set @GREF@(0)=$$BFTG^TMGBINF(.FPATH,.FNAME,$name(@GREF@(1)),3)
     151
     152        do ENCODE($name(@GREF@(1)),3)
     153
     154        quit
     155
     156
     157UPLOAD(RESULT,FPATH,FNAME,LOCIEN,ARRAY)
     158        ;"SCOPE: Public
     159        ;"RPC That calls this: TMG UPLOAD FILE
     160        ;"Purpose: To provide an entry point for a RPC call from a client.  The client
     161        ;"              will provide a file for upload (in BASE64 ascii encoding)
     162        ;"Input: GREF --    OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
     163        ;"       FPATH --   the file path up to, but not including, the filename
     164        ;"                  Use '/' to NOT specify any subdirectory
     165        ;"                     [optional] default is '/'
     166        ;"       FNAME --   the name of the file to pass back
     167        ;"       LOCIEN--   [optional] -- the IEN from file 2005.2 (network location) to upload to
     168        ;"                     NOTE: DEPRECIATED.  Should pass "" to allow code to lookup default
     169        ;"                     Note: For security reasons, all path requests will be considered relative to a root path.
     170        ;"                           e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
     171        ;"                               /var/local/Dir1/Dir2/download/SomeFile.jpg
     172        ;"                           This root path is found in custom field 22701 in file 2005.2
     173        ;"       ARRAY --   the array that will hold the file, in BASE64 ascii encoding
     174        ;"Output: results are passed out in RESULT:  1^SuccessMessage   or 0^FailureMessage
     175
     176        new result
     177        new resultMsg set resultMsg="1^Successful Upload"
     178
     179        set ^TMP("UPLOAD^TMGRPC1",$J,"FPATH")=$GET(FPATH)
     180        set ^TMP("UPLOAD^TMGRPC1",$J,"FNAME")=$GET(FNAME)
     181        set ^TMP("UPLOAD^TMGRPC1",$J,"LOCIEN")=$GET(LOCIEN)
     182
     183        if $data(ARRAY)=0 set resultMsg="0^No data received to upload" goto UpDone
     184        set FNAME=$get(FNAME)
     185        if FNAME="" do  goto UpDone
     186        . set resultMsg="0^No file name received"
     187       
     188        set LOCIEN=+$GET(LOCIEN) if LOCIEN'>0 set LOCIEN=$$GETDEFNL()
     189       
     190        set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ;
     191
     192        do DECODE("ARRAY(0)",1)
     193
     194        if $$GTBF^TMGBINF("ARRAY(0)",1,FPATH,FNAME)=0 do
     195        . set resultMsg="0^Error while saving file"
     196
     197UpDone  set RESULT=resultMsg
     198        quit
     199
     200
     201DOWNDROP(RESULT,FPATH,FNAME,LOCIEN)  ;"i.e. Download drop box file
     202        ;"SCOPE: Public
     203        ;"RPC That calls this: TMG DOWNLOAD FILE DROPBOX
     204        ;"Purpose: To provide an entry point for a RPC call from a client.  The client
     205        ;"         will request for the file to be placed into in a 'dropbox' file
     206        ;"         location that both the client and server can access.  File may be
     207        ;"         moved from there to its final destination by the client.
     208        ;"         This method alloows file-hiding ability on the server side.
     209        ;"Input: RESULT --    OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
     210        ;"       FPATH --   the file path up to, but not including, the filename.  This
     211        ;"                  is the path that the file is stored at (relative to a root path,
     212        ;"                  see comments below).  It is NOT the path of the dropbox.
     213        ;"                  Use '/' to NOT specify any subdirectory
     214        ;"                  [optional] default is '/'
     215        ;"       FNAME --   the name of the file to be uploaded.  Note: This is also the
     216        ;"                  name of the file to be put into the dropbox.  It is the
     217        ;"                  responsibility of the client to ensure that there is not already
     218        ;"                  a similarly named file in the dropbox before requesting a file
     219        ;"                  be put there.  It is the responsibility of the client to delete
     220        ;"                  the file from the drop box.
     221        ;"       LOCIEN--     [optional] -- the IEN from file 2005.2 (network location) to download from
     222        ;"                            NOTE: DEPRECIATED.  Should pass "" to allow code to lookup default
     223        ;"                            Note: For security reasons, all path requests will be considered relative to a root path.
     224        ;"                                    e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
     225        ;"                                        /var/local/Dir1/Dir2/download/SomeFile.jpg
     226        ;"                                    This root path is found in custom field 22701 in file 2005.2
     227        ;"                       Also: dropbox location is obtained from custom field 22702 in file 2005.2
     228        ;"NOTE RE DROPBOX:
     229        ;"   This system is designed for a system where by the server and the client have a
     230        ;"   shared filesystem, but the directory paths will be different.  For example:
     231        ;"      Linux server has dropbox at: /mnt/WinServer/dropbox/
     232        ;"      Windows Client has access to dropbox at: V:\Dropbox\
     233
     234        ;"Output: results are 1^Success^FileSize (in bytes), or 0^Error Message
     235
     236        new DropBox,moveResult,SrcNamePath
     237       
     238        new resultMsg set resultMsg="1^Successful Download"
     239
     240        set FNAME=$get(FNAME) if FNAME="" do  goto DnDBxDone   
     241        . set resultMsg="0^No file name received"
     242
     243        set FPATH=$$GETLOCFPATH(.FPATH,.LOCIEN) ;
     244       
     245        if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do  goto DnDBxDone 
     246        . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702"       
     247
     248        set SrcNamePath=FPATH_FNAME
     249
     250        set moveResult=$$Copy^TMGKERNL(SrcNamePath,DropBox)
     251        if moveResult>0 do
     252        . set resultMsg="0^Move failed, returning OS error code: "_moveResult
     253        else  do
     254        . set resultMsg=resultMsg_"^"_$$FileSize^TMGKERNL(SrcNamePath)
     255
     256DnDBxDone
     257        set RESULT=resultMsg
     258        quit
     259
     260
     261UPLDDROP(RESULT,FPATH,FNAME,LOCIEN)  ;"i.e. Upload Dropbox File
     262        ;"SCOPE: Public
     263        ;"RPC That calls this: TMG UPLOAD FILE DROPBOX
     264        ;"Purpose: To provide an entry point for a RPC call from a client.  The client
     265        ;"         will put the file in a 'dropbox' file location that both the client
     266        ;"         and server can access.  File will be moved from there to its final
     267        ;"         destination.  This will provide file-hiding ability on the server side.
     268        ;"Input: RESULT --  OUT PARAM -- the array to pass the result back in (PASSED BY REFERENCE)
     269        ;"       FPATH --   the file path up to, but not including, the filename.  This
     270        ;"                  is the path to store the file at.  (relative to a root path,
     271        ;"                  see comments below).  It is NOT the path of the dropbox.
     272        ;"                  Use '/' to NOT specify any subdirectory
     273        ;"                  [optional] default is '/'
     274        ;"       FNAME --   the name of the file to be uploaded.  Note: This is also the
     275        ;"                  name of the file to be pulled from the dropbox.  It is the
     276        ;"                  responsibility of the client to ensure that there is not already
     277        ;"                  a similarly named file in the dropbox before depositing a file there.
     278        ;"                  The server will remove the file from the dropbox, unless there is
     279        ;"                  an error with the host OS (which will be returned as an error message)
     280        ;"       LOCIEN--   [optional] -- the IEN from file 2005.2 (network location) to upload to
     281        ;"                     NOTE: DEPRECIATED.  Should pass "" to allow code to lookup default
     282        ;"                     Note: For security reasons, all path requests will be considered relative to a root path.
     283        ;"                           e.g. if user asks for /download/SomeFile.jpg, this function will retrieve:
     284        ;"                               /var/local/Dir1/Dir2/download/SomeFile.jpg
     285        ;"                           This root path is found in custom field 22700 in file 2005.2
     286        ;"                     Also: dropbox location is obtained from custom field 22702 in file 2005.2
     287        ;"NOTE RE DROPBOX:
     288        ;"   This system is designed for a system where by the server and the client have a
     289        ;"   shared filesystem, but the directory paths will be different.  For example:
     290        ;"      Linux server has dropbox at: /mnt/WinServer/dropbox/
     291        ;"      Windows Client has access to dropbox at: V:\Dropbox\
     292
     293        ;"Output: results are passed out in RESULT:
     294        ;"      1^SuccessMessage   or 0^FailureMessage
     295
     296        new SrcNamePath,DestNamePath,moveResult
     297        new resultMsg set resultMsg="1^Successful Upload"
     298
     299        set FNAME=$get(FNAME)
     300        if FNAME="" set resultMsg="0^No file name received" goto UpDBxDone
     301
     302        new DropBox
     303        if $$GETDROPPATH(.LOCIEN,.DropBox)=-1 do  goto UpDBxDone 
     304        . set resultMsg="0^Dropbox location not configured in file 2005.2, IEN "_LOCIEN_", field 22702"       
     305       
     306        set FPATH=$$GETLOCFPATH($GET(FPATH),LOCIEN) ;       
     307
     308        set SrcNamePath=DropBox_FNAME
     309        set DestNamePath=FPATH_FNAME
     310
     311        set moveResult=$$Move^TMGKERNL(SrcNamePath,DestNamePath)
     312        if moveResult>0 do
     313        . set resultMsg="0^Move failed, returning OS error code: "_moveResult
     314
     315UpDBxDone
     316        set RESULT=resultMsg
     317        quit
     318
     319
     320ENCODE(GRef,incSubscr,encodeFn)
     321        ;"Purpose: ENCODE a  BINARY GLOBAL.
     322        ;"Input:
     323        ;"          GRef--      Global reference of the SOURCE binary global array, in fully resolved
     324        ;"                              (closed root) format.
     325        ;"                           Note:
     326        ;"                           At least one subscript must be numeric.  This will be the incrementing
     327        ;"                           subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
     328        ;"                           to store each new global node).  This subscript need not be the final
     329        ;"                           subscript.  For example, to load into a WORD PROCESSING field, the
     330        ;"                           incrementing node is the second-to-last subscript; the final subscript
     331        ;"                           is always zero.
     332        ;"                           REQUIRED
     333        ;"         incSubscr-- (required) Identifies the incrementing subscript level, for the source global
     334        ;"                           For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
     335        ;"                           pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
     336        ;"                           subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
     337        ;"                           reference, such as ^TMP(115,1,x,0).
     338        ;"                           REQUIRED
     339        ;"         encodeFn-   (OPTIONAL) the name of a function that will encode a line of data.
     340        ;"                            e.g. "CODER^ZZZCODER"  or "LOCALCODER".  The function should
     341        ;"                            take one input variable (the line of raw binary data), and return a converted
     342        ;"                            line.  e.g.
     343        ;"                                CODER(INPUT)
     344        ;"                                 ... ;"convert INPUT to RESULT
     345        ;"                                QUIT RESULT
     346        ;"                            default value is B64CODER^TMGRPC1
     347        ;"
     348        ;"Output: @GRef is converted to encoded data
     349        ;"Result: None
     350
     351        if $get(GRef)="" goto EncodeDone
     352        if $get(incSubscr)="" goto EncodeDone
     353
     354        set encodeFn=$get(encodeFn,"B64CODER")
     355
     356        new encoder
     357        set encoder="set temp=$$"_encodeFn_"(.temp)"
     358
     359        for  do  quit:(GRef="")
     360        . new temp
     361        . set temp=$get(@GRef)
     362        . if temp="" set GRef="" quit
     363        . xecute encoder  ;"i.e.  set temp=$$encoderFn(.temp)
     364        . set @GRef=temp
     365        . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1)
     366
     367EncodeDone
     368        quit
     369
     370
     371HEXCODER(INPUT)
     372        ;"Purpose: to encode the input string.  Currently using simple hex encoding/
     373        quit $$STRB2H^TMGSTUTL(.INPUT,0,1)
     374
     375
     376B64CODER(INPUT)
     377        ;"Purpose: to encode the input string via UUENCODE (actually Base64)
     378        quit $$ENCODE^RGUTUU(.INPUT)
     379
     380B64DECODER(INPUT)
     381        ;"Purpose: to encode the input string via UUENCODE (actually Base64)
     382        quit $$DECODE^RGUTUU(.INPUT)
     383
     384
     385DECODE(GRef,incSubscr,decodeFn)
     386        ;"Purpose: ENCODE a  BINARY GLOBAL.
     387        ;"Input:
     388        ;"          GRef--      Global reference of the SOURCE binary global array, in fully resolved
     389        ;"                              (closed root) format.
     390        ;"                           Note:
     391        ;"                           At least one subscript must be numeric.  This will be the incrementing
     392        ;"                           subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
     393        ;"                           to store each new global node).  This subscript need not be the final
     394        ;"                           subscript.  For example, to load into a WORD PROCESSING field, the
     395        ;"                           incrementing node is the second-to-last subscript; the final subscript
     396        ;"                           is always zero.
     397        ;"                           REQUIRED
     398        ;"         incSubscr-- (required) Identifies the incrementing subscript level, for the source global
     399        ;"                           For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
     400        ;"                           pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
     401        ;"                           subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
     402        ;"                           reference, such as ^TMP(115,1,x,0).
     403        ;"                           REQUIRED
     404        ;"         decodeFn-   (OPTIONAL)  the name of a function that will decode a line of data.
     405        ;"                              e.g. "DECODER^ZZZCODER"  or "DECODER".  The function should take
     406        ;"                            one input variable (the line of encoded data), and return a decoded line.  e.g.
     407        ;"                                DECODER(INPUT)
     408        ;"                                 ... ;"convert INPUT to RESULT
     409        ;"                                QUIT RESULT
     410        ;"                            default value is B64DECODER^TMGRPC1
     411        ;"
     412        ;"Output: @GRef is converted to decoded data
     413        ;"Result: None
     414
     415        if $get(GRef)="" goto DecodeDone
     416        if $get(incSubscr)="" goto DecodeDone
     417        set decodeFn=$get(decodeFn,"B64DECODER")
     418
     419        new decoder
     420        set decoder="set temp=$$"_decodeFn_"(.temp)"
     421
     422        for  do  quit:(GRef="")
     423        . new temp
     424        . set temp=$get(@GRef)
     425        . if temp="" set GRef="" quit
     426        . xecute decoder  ;"i.e.  set temp=$$decoderFn(.temp)
     427        . set @GRef=temp
     428        . set GRef=$$NEXTNODE^TMGBINF(GRef,incSubscr,1,1)
     429
     430DecodeDone
     431        quit
     432 ;
     433 ;
     434DELIMAGE(RESULT,TMGIEN,TMGMODE,TMGREASON) ;
     435        ;"Purpose: Provide functionality for deleting or retacting an image from CPRS
     436        ;"NOTE: MAGG IMAGE DELETE is not used because it does things like archive
     437        ;"      the images before deletion.  I don't have this system fully integrated
     438        ;"      In the future, that could possibly be used.
     439        ;"NOTE: This function DOES NOT CHECK PERMISSIONS for deleting the images.
     440        ;"      It is assumed that that has been doine PRIOR to calling this function.
     441        ;"NOTE: It mode is to retract (see below), then the image will not be
     442        ;"      actually be deleted.  It will just be marked as retracted and
     443        ;"      set so that it doesn't appear in CPRS.
     444        ;"      --But if mode is to delete, then the record in the IMAGE file
     445        ;"      will be deleted AND ALSO the actual image (with no backup.) This
     446        ;"      mode is for deletion before signing, and the image has not been
     447        ;"      formally entered into the record.
     448        ;"Input: RESULT -- an OUT Parameter. (See results below)
     449        ;"       TMGIEN -- the IEN in the IMAGE file (2005) to remove
     450        ;"       TMGMODE -- 0 for NONE <-- just exit and do nothing
     451        ;"               1 for DELETE <-- delete record and image file
     452        ;"               2 for RETRACT <-- mark record as retracted, don't delete iamge file.
     453        ;"       TMGREASON -- String (10-60 chars) giving reason for deletion.
     454        ;"                 This is only used for mode RETRACT.
     455        ;"Output: RESULT="1^Success"   or "-1^Some Failure Message"  <-- set up as SINGLE VALUE type in RPC BROKER
     456        ;
     457        SET RESULT="1^Success"  ;"Default to success
     458        SET TMGIEN=$GET(TMGIEN,0)
     459        IF +TMGIEN'>0 DO  GOTO DIDN
     460        . SET RESULT="-1^Invalid IEN: "_TMGIEN
     461        SET TMGIEN=+TMGIEN
     462        SET TMGMODE=+$GET(TMGMODE)
     463        IF TMGMODE=0 DO  GOTO DIDN
     464        . SET RESULT="1^Delete not done because mode=0"
     465        SET TMGREASON=$GET(TMGREASON,"(Not Specified)")
     466        NEW TMGPTR SET TMGPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",8) ;"2;8 ==> Field 18 = PARENT DATA FILE IMAGE POINTER
     467        IF TMGPTR'>0 DO  GOTO DIDN
     468        . SET RESULT="-1^FILE 2005, IEN "_TMGIEN_", Field 18 does not point to valid record in file 8925.91"
     469        NEW TMGTIUPTR SET TMGTIUPTR=+$PIECE($GET(^TIU(8925.91,TMGPTR,0)),"^",1) ;"0;1 ==> Field .01 = DOCUMENT (ptr to 8925)
     470        IF TMGMODE=1 DO  GOTO:(+RESULT'>0) DIDN   ;"Delete mode
     471        . NEW FNAME SET FNAME=$PIECE($GET(^MAG(2005,TMGIEN,0)),"^",2)
     472        . NEW TMGPATH SET TMGPATH=$$GETLOCFPATH()
     473        . NEW TMGARRAY,DELRSLT
     474        . SET TMGARRAY(FNAME)=""
     475        . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY")
     476        . IF DELRSLT=0 DO  QUIT
     477        . . SET RESULT="-1^Unable to delete file: "_TMGPATH_FNAME
     478        . KILL TMGARRAY
     479        . NEW FNAME2 SET FNAME2=FNAME
     480        . SET $PIECE(FNAME2,",",$LENGTH(FNAME2,"."))="ABS"
     481        . SET TMGARRAY(FNAME2)=""
     482        . SET DELRSLT=$$DEL^%ZISH(TMGPATH,"TMGARRAY") ;"Ingnore results.  Thumbnail not always present       
     483        . NEW DIK SET DIK="^MAG(2005,"
     484        . NEW DA SET DA=TMGIEN
     485        . DO ^DIK  ;"Kill Record in 2005
     486        ELSE  IF TMGMODE=2 DO  GOTO:(+RESULT'>0) DIDN  ;"Retract mode
     487        . NEW TMGFDA,TMGMSG,TMGIENS
     488        . SET TMGIENS=TMGIEN_","
     489        . SET TMGFDA(2005,TMGIENS,30)="`"_+DUZ
     490        . SET TMGFDA(2005,TMGIENS,30.1)="NOW"
     491        . SET TMGFDA(2005,TMGIENS,30.2)=TMGREASON
     492        . SET TMGFDA(2005,TMGIENS,18)="@"
     493        . ;"NOTE: Fld 17 already holds IEN of linked 8925 document
     494        . DO FILE^DIE("EKT","TMGFDA","TMGMSG")
     495        . IF $DATA(TMGMSG("DIERR")) DO
     496        . . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
     497        DO  ;"Do this for both DELETE and RETRACT modes.
     498        . NEW DIK SET DIK="^TIU(8925.91,"
     499        . NEW DA SET DA=TMGPTR
     500        . DO ^DIK  ;"Kill record in 8925.91
     501        ;
     502DIDN    QUIT       
     503        ;
     504UNRETRACT(RESULT,TMGIEN) ;
     505        ;"Purpose: to reverse retraction process from DELIMAGE above.
     506        ;"Input: RESULT -- an OUT Parameter. (See results below)
     507        ;"       TMGIEN -- the IEN in the IMAGE file (2005) to remove
     508        ;"Output: RESULT="1^Success"   or "-1^Some Failure Message"  <-- set up as SINGLE VALUE type in RPC BROKER
     509        SET TMGIEN=$GET(TMGIEN)
     510        IF +TMGIEN'>0 DO  GOTO URDN
     511        . SET RESULT="-1^Invalid IEN supplied: "_TMGIEN
     512        SET TMGIEN=+TMGIEN
     513        NEW TIUPTR SET TIUPTR=+$PIECE($GET(^MAG(2005,TMGIEN,2)),"^",7)
     514        IF TIUPTR'>0 DO  GOTO URDN
     515        . SET RESULT="-1^Record 2005 doesn't hold link to TIU DOCUMENT in field 17"
     516        NEW TMGFDA,TMGFDA,TMGIENS
     517        ;"-- Recreate TIU EXTERNAL DATA LINK record
     518        KILL TMGFDA
     519        SET TMGIENS="+1,"
     520        SET TMGFDA(8925.91,TMGIENS,.01)=TIUPTR       
     521        SET TMGFDA(8925.91,TMGIENS,.02)=TMGIEN
     522        DO UPDATE^DIE("","TMGFDA","TMGIEN","TMGMSG")
     523        IF $DATA(TMGMSG("DIERR")) DO  GOTO URDN
     524        . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
     525        NEW TIUIMGPTR SET TIUIMGPTR=+$GET(TMGIEN(1))
     526        IF TIUIMGPTR'>0 DO  GOTO URDN
     527        . SET RESULT="-1^Unable to locate recreated TIU EXTERNAL DATA LINK record"
     528        ;"-- remove DELETED info from IMAGE record --
     529        NEW TMGFDA,TMGFDA,TMGIENS
     530        SET TMGIENS=TMGIEN_","
     531        SET TMGFDA(2005,TMGIENS,30)="@"
     532        SET TMGFDA(2005,TMGIENS,30.1)="@"
     533        SET TMGFDA(2005,TMGIENS,30.2)="@"
     534        SET TMGFDA(2005,TMGIENS,18)=TIUIMGPTR
     535        DO FILE^DIE("EKT","TMGFDA","TMGMSG")
     536        IF $DATA(TMGMSG("DIERR")) DO  GOTO URDN
     537        . SET RESULT="-1^"_$$GetErrStr^TMGDEBUG(.TMGMSG)
     538       
     539URDN    QUIT               
  • cprs/branches/tmg-cprs/m_files/TMGRPC3.m

    r796 r894  
    1 TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08
     1TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08, 7/7/10
    22         ;;1.0;TMG-LIB;**1**;08/31/08
    33 ;
     
    6161        ;"                   params: FileNum^SourceIENS^New.01Value
    6262        ;"              "GET HELP MSG"
    63         ;"                   params     : FileNum^FieldNum^HelpType
     63        ;"                   params     : FileNum^FieldNum^HelpType^IENS
    6464        ;"              "IS WP FIELD"
    6565        ;"                   params: FileNum^FieldNum
  • cprs/branches/tmg-cprs/m_files/TMGRPC3E.m

    r796 r894  
    1 TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08
     1TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08, 7/7/10
    22         ;;1.0;TMG-LIB;**1**;08/31/08
    33 ;
     
    5757        ;"Purpose: to retrieve the help message for a given field.
    5858        ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE.
    59         ;"       TMGPARAMS -- file^field^HelpType
     59        ;"       TMGPARAMS -- file^field^HelpType^IENS
    6060        ;"Output: TMGOUT is filled as follows:
    6161        ;"          TMGOUT(0)="1^Success" or "-1^Message"
     
    6767        NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2)
    6868        NEW TMGHELPTYPE SET TMGHELPTYPE=$PIECE(TMGPARAMS,"^",3)
     69        NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",4)
    6970        IF TMGFILE'>0 DO  GOTO GHMDONE
    7071        . SET TMGOUT(0)="-1^No file number supplied"
    7172        IF TMGFIELD'>0 DO  GOTO GHMDONE
    7273        . SET TMGOUT(0)="-1^No Field Number supplied"
    73         DO HELP^DIE(TMGFILE,,TMGFIELD,TMGHELPTYPE,"TMGMSG")
     74        DO HELP^DIE(TMGFILE,TMGIENS,TMGFIELD,TMGHELPTYPE,"TMGMSG")
    7475        NEW TMGI SET TMGI=""
    7576        FOR  SET TMGI=$ORDER(TMGMSG("DIHELP",TMGI)) QUIT:(TMGI="")  DO
  • cprs/branches/tmg-cprs/m_files/TMGRPCSR.m

    r796 r894  
    2828 ;
    2929CHANNEL(TMGRESULT,INPUT) ;
    30         ;"Purpose: This will be a general purpose channel RPC from a GUI config program
     30        ;"Purpose: This will be a general purpose channel RPC from CPRS
    3131        ;"Input: TMGRESULT -- this is an OUT parameter, and it is always passed by reference
    3232        ;"       INPUT -- this will be array of data sent from the GUI client.  Defined below:
     
    5656        ;"              "RESULTS LIST SUBSET"  -- get sublist of search results
    5757        ;"                   params: JobNum^ListStartValue^direction^MaxCount(optional, def=44)
     58        ;"              =================================================================================
     59        ;"              == Calls for searching TIU DOCUMENTS                                           ==
     60        ;"              =================================================================================
     61        ;"              "PT DOCS SEARCH" -- launch a background search in documents for 1 patient
     62        ;"                   params: PatientEIN^SearchString
     63        ;"              "PT DOCS STATUS" -- Get status of background search
     64        ;"                   params : none
     65        ;"              "PT DOCS GET RESULTS" -- get result from background search
     66        ;"                   params : none
     67        ;"              "PT DOCS CLEAR" -- Tell background task to stop, and clear data array
     68        ;"                   params : none
     69        ;"              "PT DOCS STOP" -- Tell background task to stop searching
     70        ;"                   params : none
     71        ;"              "PT DOCS CHANGE SEARCH" -- tell background task to change search parameters
     72        ;"                   Note: this can be used to allow the search to begin while the
     73        ;"                         user is still entering the search terms.  If the new search is just an
     74        ;"                         extension to the prior search, then the prior search will be added on
     75        ;"                         rather than starting over.
     76        ;"                   params: PatientEIN^SearchString
     77        ;"              "PT DOCS PREP FOR SUBSET" -- Prep for Subset of List for TORCombobox
     78        ;"                   params : none
     79        ;"              "PT DOCS SUBSET OF RESULTS" -- Get a subset of list for TORCombobox
     80        ;"                   params : StartFrom^Direction^MaxCount 
     81        ;"                      Direction and Maxcount are optional, def=1, 44 respectively
     82        ;"              =================================================================================
    5883        ;"Output: results of this function should be put into TMGRESULTS array.
    5984        ;"        For cmd:
     
    86111        ;"            TMGRESULT(2)=IENNum^RequestedFieldNames
    87112        ;"            etc ...       
     113        ;"          =================================================================================
     114        ;"          == Calls for searching TIU DOCUMENTS                                           ==
     115        ;"          =================================================================================
     116        ;"          "PT DOCS SEARCH"
     117        ;"              TMGRESULT(0)="1^Success", OR -1^ErrorMsg
     118        ;"          "PT DOCS STATUS"
     119        ;"              TMGRESULT(0)="1^Status" or -1^ErrorMessage
     120        ;"                 NOTe: will return 1^DONE when done with search.
     121        ;"          "PT DOCS GET RESULTS"
     122        ;"              TMGRESULT(0)=FoundCount^Success, or -1^Message
     123        ;"              TMGRESULT(1)=IEN1
     124        ;"              TMGRESULT(2)=IEN2 ... etc.
     125        ;"          "PT DOCS CLEAR"
     126        ;"              TMGRESULT(0)="1^Success
     127        ;"          "PT DOCS STOP"
     128        ;"              TMGRESULT(0)="1^Success
     129        ;"          "PT DOCS PREP FOR SUBSET"
     130        ;"              TMGRESULT(0)="1^Success", OR -1^ErrorMsg
     131        ;"          "PT DOCS SUBSET OF RESULTS"
     132        ;"              TMGRESULT(0)="1^Success" or "-1^Message"
     133        ;"              TMGRESULT(1)=IEN^ANoteIdentifier
     134        ;"              TMGRESULT(2)=IEN^ANoteIdentifier
     135        ;"          =================================================================================
    88136        ;"Result: none
    89137        ;
     
    112160        ELSE  IF TMGCOMMAND="RESULTS LIST SUBSET" DO
    113161        . DO GETRSLTSB^TMGRPCS0(.TMGRESULT,TMGPARAMS)
    114         ;       
     162        ELSE  IF TMGCOMMAND="PT DOCS SEARCH" DO
     163        . DO PDSRCH^TMGRPCS1(.TMGRESULT,TMGPARAMS)               
     164        ELSE  IF TMGCOMMAND="PT DOCS STATUS" DO
     165        . DO PDSTATUS^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     166        ELSE  IF TMGCOMMAND="PT DOCS GET RESULTS" DO
     167        . DO PDRESULT^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     168        ELSE  IF TMGCOMMAND="PT DOCS CLEAR" DO
     169        . DO PDCLEAR^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     170        ELSE  IF TMGCOMMAND="PT DOCS STOP" DO
     171        . DO PDSTOP^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     172        ELSE  IF TMGCOMMAND="PT DOCS CLEAR" DO
     173        . DO PDCLEAR^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     174        ELSE  IF TMGCOMMAND="PT DOCS PREP FOR SUBSET" DO
     175        . DO PDPREPSS^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     176        ELSE  IF TMGCOMMAND="PT DOCS SUBSET OF RESULTS" DO
     177        . DO PDGETSS^TMGRPCS1(.TMGRESULT,TMGPARAMS)
     178        ;
    115179        QUIT
    116180        ;
  • cprs/branches/tmg-cprs/m_files/TMGSRCH1.m

    r796 r894  
    22        ;;1.0;TMG-LIB;**1**;05/19/10
    33        ;
    4  ;"TMG FILEMAN SEARCH API
     4 ;"UTILITIES FOR TMG FILEMAN SEARCH API
    55 ;
    66 ;"Copyright Kevin Toppenberg MD 5/19/10
Note: See TracChangeset for help on using the changeset viewer.