- Timestamp:
- Jul 25, 2010, 2:51:23 PM (14 years ago)
- Location:
- cprs/branches/tmg-cprs/m_files
- Files:
-
- 7 edited
-
TMGDEBUG.m (modified) (3 diffs)
-
TMGRPC1B.m (modified) (3 diffs)
-
TMGRPC1C.m (modified) (1 diff)
-
TMGRPC3.m (modified) (2 diffs)
-
TMGRPC3E.m (modified) (3 diffs)
-
TMGRPCSR.m (modified) (4 diffs)
-
TMGSRCH1.m (modified) (1 diff)
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 1 TMGDEBUG ;TMG/kst/Debug utilities: logging, record dump ;03/25/06, 7/11/10 2 2 ;;1.0;TMG-LIB;**1**;07/12/05 3 3 … … 22 22 ;"DebugExit^TMGDEBUG(DBIndent,ProcName) 23 23 ;"ShowError^TMGDEBUG(PriorErrorFound,Error) 24 ;"$$FMERRSTR(ERRARRAY) -- same as $$GetErrStr() 24 25 ;"$$GetErrStr^TMGDEBUG(ErrArray) 25 26 ;"ShowIfDIERR^TMGDEBUG(ErrMsg,PriorErrorFound) ;really same as below … … 410 411 411 412 413 FMERRSTR(ERRARRAY) 414 QUIT $$GetErrStr(.ERRARRAY) 415 ; 412 416 GetErrStr(ErrArray) 413 417 ;"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 1 TMGRPC1B ;TMG/kst-RPC Functions ;3/28/10, 7/11/10 2 2 ;;1.0;TMG-LIB;**1**;3/28/10 3 3 ; … … 10 10 ;" RPC -- Public Functions. 11 11 ;"======================================================================= 12 ;"E VALTIUO13 ; "INSTALL -- Add the RPC's to the OPTION record OR CPRS GUI CHART12 ;"ENSUREALL -- Ensure all needed TMG RPC entries have been added 13 ; 14 14 ;"======================================================================= 15 15 ;"PRIVATE API FUNCTIONS 16 16 ;"======================================================================= 17 ;" INSTALL1(RPCNAME) -- Add 1 RPC to theOPTION record OR CPRS GUI CHART17 ;"ENSURE1(RPCNAME) -- ensure 1 RPC is in OPTION record OR CPRS GUI CHART 18 18 ; 19 19 ;"======================================================================= 20 20 ;"======================================================================= 21 21 ;"Dependencies: 22 ;" DIC , TMGDEBUG22 ;" DIC 23 23 ;"======================================================================= 24 24 ;"======================================================================= 25 25 ; 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 26 ENSUREAL 27 ;"Ensure all needed TMG RPC entries have been added 28 L1 ;;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> 33 52 ; 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 42 60 ; 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 61 ENSURE1(RPCNAME) ; 62 ;"Purpose: to ensure 1 RPC is in OPTION record OR CPRS GUI CHART 63 ;" (add if needed) 66 64 NEW DIC,X,Y,DA 67 65 SET DIC="^DIC(19,",DIC(0)="M" … … 83 81 . WRITE ! 84 82 QUIT 83 84 -
cprs/branches/tmg-cprs/m_files/TMGRPC1C.m
r796 r894 1 QUIT 1 TMGRPC1C ;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 ; 37 GETDEFNL() 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 ; 56 GDFNDN QUIT RESULT 57 ; 58 ; 59 ENSUREDIV(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 ; 71 GETLOCFPATH(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 ; 107 GETDROPPATH(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) 119 GDPDN quit Result 120 121 122 DOWNLOAD(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 157 UPLOAD(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 197 UpDone set RESULT=resultMsg 198 quit 199 200 201 DOWNDROP(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 256 DnDBxDone 257 set RESULT=resultMsg 258 quit 259 260 261 UPLDDROP(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 315 UpDBxDone 316 set RESULT=resultMsg 317 quit 318 319 320 ENCODE(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 367 EncodeDone 368 quit 369 370 371 HEXCODER(INPUT) 372 ;"Purpose: to encode the input string. Currently using simple hex encoding/ 373 quit $$STRB2H^TMGSTUTL(.INPUT,0,1) 374 375 376 B64CODER(INPUT) 377 ;"Purpose: to encode the input string via UUENCODE (actually Base64) 378 quit $$ENCODE^RGUTUU(.INPUT) 379 380 B64DECODER(INPUT) 381 ;"Purpose: to encode the input string via UUENCODE (actually Base64) 382 quit $$DECODE^RGUTUU(.INPUT) 383 384 385 DECODE(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 430 DecodeDone 431 quit 432 ; 433 ; 434 DELIMAGE(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 ; 502 DIDN QUIT 503 ; 504 UNRETRACT(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 539 URDN QUIT -
cprs/branches/tmg-cprs/m_files/TMGRPC3.m
r796 r894 1 TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08 1 TMGRPC3 ;TMG/kst/RPC Functions for GUI_Config ;07/20/08, 7/7/10 2 2 ;;1.0;TMG-LIB;**1**;08/31/08 3 3 ; … … 61 61 ;" params: FileNum^SourceIENS^New.01Value 62 62 ;" "GET HELP MSG" 63 ;" params : FileNum^FieldNum^HelpType 63 ;" params : FileNum^FieldNum^HelpType^IENS 64 64 ;" "IS WP FIELD" 65 65 ;" 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 1 TMGRPC3E ;TMG/kst/Support Functions for GUI_Config ;08/31/08, 7/7/10 2 2 ;;1.0;TMG-LIB;**1**;08/31/08 3 3 ; … … 57 57 ;"Purpose: to retrieve the help message for a given field. 58 58 ;"Input: TMGOUT -- an OUT PARAMETER, PASS BY REFERENCE. 59 ;" TMGPARAMS -- file^field^HelpType 59 ;" TMGPARAMS -- file^field^HelpType^IENS 60 60 ;"Output: TMGOUT is filled as follows: 61 61 ;" TMGOUT(0)="1^Success" or "-1^Message" … … 67 67 NEW TMGFIELD SET TMGFIELD=+$PIECE(TMGPARAMS,"^",2) 68 68 NEW TMGHELPTYPE SET TMGHELPTYPE=$PIECE(TMGPARAMS,"^",3) 69 NEW TMGIENS SET TMGIENS=$PIECE(TMGPARAMS,"^",4) 69 70 IF TMGFILE'>0 DO GOTO GHMDONE 70 71 . SET TMGOUT(0)="-1^No file number supplied" 71 72 IF TMGFIELD'>0 DO GOTO GHMDONE 72 73 . 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") 74 75 NEW TMGI SET TMGI="" 75 76 FOR SET TMGI=$ORDER(TMGMSG("DIHELP",TMGI)) QUIT:(TMGI="") DO -
cprs/branches/tmg-cprs/m_files/TMGRPCSR.m
r796 r894 28 28 ; 29 29 CHANNEL(TMGRESULT,INPUT) ; 30 ;"Purpose: This will be a general purpose channel RPC from a GUI config program30 ;"Purpose: This will be a general purpose channel RPC from CPRS 31 31 ;"Input: TMGRESULT -- this is an OUT parameter, and it is always passed by reference 32 32 ;" INPUT -- this will be array of data sent from the GUI client. Defined below: … … 56 56 ;" "RESULTS LIST SUBSET" -- get sublist of search results 57 57 ;" 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 ;" ================================================================================= 58 83 ;"Output: results of this function should be put into TMGRESULTS array. 59 84 ;" For cmd: … … 86 111 ;" TMGRESULT(2)=IENNum^RequestedFieldNames 87 112 ;" 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 ;" ================================================================================= 88 136 ;"Result: none 89 137 ; … … 112 160 ELSE IF TMGCOMMAND="RESULTS LIST SUBSET" DO 113 161 . 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 ; 115 179 QUIT 116 180 ; -
cprs/branches/tmg-cprs/m_files/TMGSRCH1.m
r796 r894 2 2 ;;1.0;TMG-LIB;**1**;05/19/10 3 3 ; 4 ;" TMG FILEMAN SEARCH API4 ;"UTILITIES FOR TMG FILEMAN SEARCH API 5 5 ; 6 6 ;"Copyright Kevin Toppenberg MD 5/19/10
Note:
See TracChangeset
for help on using the changeset viewer.
