[796] | 1 | TMGBINF ;TMG/kst/Binary <--> Global Functions ;03/25/06
|
---|
| 2 | ;;1.0;TMG-LIB;**1**;08/20/05
|
---|
| 3 |
|
---|
| 4 | ;"TMG BIN <-->GBL FUNCTIONS
|
---|
| 5 | ;"Kevin Toppenberg MD
|
---|
| 6 | ;"GNU General Public License (GPL) applies
|
---|
| 7 | ;"8-20-2005
|
---|
| 8 |
|
---|
| 9 | ;"=======================================================================
|
---|
| 10 | ;" API -- Public Functions.
|
---|
| 11 | ;"=======================================================================
|
---|
| 12 | ;"$$BFTG(path,filename,globalRef,incSubscr,width) -- BINARY FILE TO GLOBAL
|
---|
| 13 | ;"$$GTBF(globalRef,incSubscr,path,filename) -- GLOBAL TO BINARY FILE
|
---|
| 14 | ;"CPYBG(srcGRef,srcIncSubscr,dstGRef,dstIncSubscr,width) -- COPY/RESIZE BINARY GLOBAL.
|
---|
| 15 |
|
---|
| 16 |
|
---|
| 17 | ;"=======================================================================
|
---|
| 18 | ;"PRIVATE API FUNCTIONS
|
---|
| 19 | ;"=======================================================================
|
---|
| 20 | ;"$$NEXTNODE(curRef,incSubscr)
|
---|
| 21 | ;"$$READBG(GRef,incSubscr,pos,count,actualCount) -- STREAM READ FROM BINARY GLOBAL
|
---|
| 22 |
|
---|
| 23 | ;"=======================================================================
|
---|
| 24 | ;"DEPENDENCIES
|
---|
| 25 | ;"=======================================================================
|
---|
| 26 | ;"Uses: (No other units)
|
---|
| 27 |
|
---|
| 28 | ;"=======================================================================
|
---|
| 29 |
|
---|
| 30 | BFTG(path,filename,globalRef,incSubscr,width)
|
---|
| 31 | ;"SCOPE: PUBLIC
|
---|
| 32 | ;"Purpose: To load a binary file from the host filesystem into a global, storing
|
---|
| 33 | ;" the composit bytes as raw binary data.
|
---|
| 34 | ;" You do not need to open the host file before making this call; it is opened
|
---|
| 35 | ;" and closed automatically
|
---|
| 36 | ;"Input: path -- (required) full path, up to but not including the filename
|
---|
| 37 | ;" filename -- (required) name of the file to open
|
---|
| 38 | ;" globalRef-- (required) Global reference to WRITE the host binary file to, in fully
|
---|
| 39 | ;" resolved (closed root) format. This function does NOT kill the global
|
---|
| 40 | ;" before writing to it.
|
---|
| 41 | ;" Note:
|
---|
| 42 | ;" At least one subscript must be numeric. This will be the incrementing
|
---|
| 43 | ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
|
---|
| 44 | ;" to store each new global node). This subscript need not be the final
|
---|
| 45 | ;" subscript. For example, to load into a WORD PROCESSING field, the
|
---|
| 46 | ;" incrementing node is the second-to-last subscript; the final subscript
|
---|
| 47 | ;" is always zero.
|
---|
| 48 | ;" incSubscr-- (required) Identifies the incrementing subscript level. For example, if you
|
---|
| 49 | ;" pass ^TMP(115,1,1,0) as the global_ref parameter and pass 3 as the
|
---|
| 50 | ;" inc_subscr parameter, $$BIN2GBL will increment the third subscript, such
|
---|
| 51 | ;" as ^TMP(115,1,x), but will WRITE notes at the full global reference, such
|
---|
| 52 | ;" as ^TMP(115,1,x,0).
|
---|
| 53 | ;" width -- OPTIONAL -- the number of bytes to store per line. Default=512
|
---|
| 54 | ;"*** NOTICE: width is not working properly. For now, just don't supply a number.
|
---|
| 55 |
|
---|
| 56 | ;"Result: 1=success, 0=failure
|
---|
| 57 | ;"
|
---|
| 58 | ;"Example:
|
---|
| 59 | ;" write $$BFTG(path,file,"^TMP(115,1,1,0)",3)
|
---|
| 60 | ;" ^TMP(115,1,1,0)="04016785439093479334987689724398732490782..."
|
---|
| 61 | ;" ^TMP(115,1,2,0)="09834573467345092647823450982345858792346..."
|
---|
| 62 | ;" ^TMP(115,1,3,0)="90783492734987234098243908723459590823494..."
|
---|
| 63 | ;" ^TMP(115,1,4,0)="23489723450234097234980732402349955987284..."
|
---|
| 64 | ;" ^TMP(115,1,5,0)="0983457823450982734572349874234874" <-- not padded with terminal zeros
|
---|
| 65 | ;"In this example, only digits 0-9 are shown. In reality each digit can be a byte with a value 0-255
|
---|
| 66 |
|
---|
| 67 | new result set result=0 ;"default to failure
|
---|
| 68 | new handle set handle="TMGHANDLE"
|
---|
| 69 | new abort set abort=0
|
---|
| 70 | new blockIn
|
---|
| 71 | new $ETRAP
|
---|
| 72 | if $get(globalRef)="" goto BFTGDone
|
---|
| 73 |
|
---|
| 74 | new curRef
|
---|
| 75 | new tempRef set tempRef="^TMP(""BFTG^TMGBINF"","_$J_",1)"
|
---|
| 76 | ;"if user wants a width other than 512, will have to load into a temporary location,
|
---|
| 77 | ;"and then copy over to final destination at requested with
|
---|
| 78 | if +$get(width)>0 set curRef=tempRef
|
---|
| 79 | else set curRef=globalRef
|
---|
| 80 |
|
---|
| 81 | set filename=$get(filename)
|
---|
| 82 | if filename="" goto BFTGDone
|
---|
| 83 |
|
---|
| 84 | set path=$$DEFDIR^%ZISH($get(path))
|
---|
| 85 |
|
---|
| 86 | ;"Note: Each line will 512 bytes long (512 is hard coded into OPEN^%ZISH)
|
---|
| 87 | do OPEN^%ZISH(handle,path,filename,"RB") ;"B is a 512 block/binary mode
|
---|
| 88 | if POP write "Error opening file...",! goto BFTGDone
|
---|
| 89 | set $ETRAP="set abort=1,$ECODE="""" quit"
|
---|
| 90 | use IO
|
---|
| 91 | for do quit:($ZEOF)!(abort=1)!(blockIn="")
|
---|
| 92 | . read blockIn
|
---|
| 93 | . if (blockIn="") quit
|
---|
| 94 | . set @curRef=blockIn
|
---|
| 95 | . set curRef=$$NEXTNODE(curRef,incSubscr)
|
---|
| 96 |
|
---|
| 97 | if abort=1 write "Aborted...",!
|
---|
| 98 | if (abort'=1) set result=1 ;"SUCCESS
|
---|
| 99 | do CLOSE^%ZISH(handle)
|
---|
| 100 |
|
---|
| 101 | if +$get(width)>0 do
|
---|
| 102 | . do CPYBG(tempRef,3,globalRef,incSubscr,width)
|
---|
| 103 | . kill @tempRef
|
---|
| 104 |
|
---|
| 105 |
|
---|
| 106 | BFTGDone
|
---|
| 107 | quit result
|
---|
| 108 |
|
---|
| 109 |
|
---|
| 110 | GTBF(globalRef,incSubscr,path,filename)
|
---|
| 111 | ;"SCOPE: PUBLIC
|
---|
| 112 | ;"Purpose: This function will WRITE the values of nodes of a global (at the subscript
|
---|
| 113 | ;" level you specify) to a host file, in a binary fashion. If the host file already
|
---|
| 114 | ;" exists, it is truncated to length zero (0) before the copy.
|
---|
| 115 | ;" Each line of the global is written out, in a serial fashion based on the ordering
|
---|
| 116 | ;" of the subscripts, with no line terminators written between lines.
|
---|
| 117 | ;" You do not need to open the host file before making this call; it is opened
|
---|
| 118 | ;" and closed $$GTBF^TMGBINF
|
---|
| 119 | ;"Input:
|
---|
| 120 | ;" globalRef-- Global reference to WRITE the host binary file to, in fully resolved
|
---|
| 121 | ;" (closed root) format. This function does not kill the global before
|
---|
| 122 | ;" writing to it. (required)
|
---|
| 123 | ;" Note:
|
---|
| 124 | ;" At least one subscript must be numeric. This will be the incrementing
|
---|
| 125 | ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
|
---|
| 126 | ;" to store each new global node). This subscript need not be the final
|
---|
| 127 | ;" subscript. For example, to load into a WORD PROCESSING field, the
|
---|
| 128 | ;" incrementing node is the second-to-last subscript; the final subscript
|
---|
| 129 | ;" is always zero.
|
---|
| 130 | ;" incSubscr-- (required) Identifies the incrementing subscript level. For example, if you
|
---|
| 131 | ;" pass ^TMP(115,1,1,0) as the global_ref parameter and pass 3 as the
|
---|
| 132 | ;" inc_subscr parameter, $$BIN2GBL will increment the third subscript, such
|
---|
| 133 | ;" as ^TMP(115,1,x), but will WRITE notes at the full global reference, such
|
---|
| 134 | ;" as ^TMP(115,1,x,0).
|
---|
| 135 | ;" path -- full path, up to but not including the filename (required)
|
---|
| 136 | ;" filename -- name of the file to open (required)
|
---|
| 137 | ;"Result: 1=success, 0=failure
|
---|
| 138 | ;"
|
---|
| 139 | ;"Example:
|
---|
| 140 | ;" write $$GTBF(path,file,"^TMP(115,1,1,0)",3)
|
---|
| 141 | ;" ^TMP(115,1,1,0)="04016785439093479334987689724398732490782..."
|
---|
| 142 | ;" ^TMP(115,1,2,0)="09834573467345092647823450982345858792346..."
|
---|
| 143 | ;" ^TMP(115,1,3,0)="90783492734987234098243908723459590823494..."
|
---|
| 144 | ;" ^TMP(115,1,4,0)="23489723450234097234980732402349955987284..."
|
---|
| 145 | ;" ^TMP(115,1,5,0)="0983457823450982734572349874234874"
|
---|
| 146 | ;"Each line would be sent to the output file in turn as a continuous data sequence.
|
---|
| 147 | ;"In this example, only digits 0-9 are shown. In reality each digit can be a byte with a value 0-255
|
---|
| 148 | ;"
|
---|
| 149 |
|
---|
| 150 | new result set result=0 ;"default to failure
|
---|
| 151 | new handle set handle="TMGHANDLE"
|
---|
| 152 | new abort set abort=0
|
---|
| 153 | new blockOut
|
---|
| 154 | new mustExist set mustExist=1
|
---|
| 155 | new $ETRAP
|
---|
| 156 | new curRef set curRef=globalRef
|
---|
| 157 |
|
---|
| 158 | set path=$$DEFDIR^%ZISH($get(path))
|
---|
| 159 | do OPEN^%ZISH(handle,path,filename,"W")
|
---|
| 160 | if POP goto GTBFDone
|
---|
| 161 | set $ETRAP="set abort=1,$ECODE="""" quit"
|
---|
| 162 | use IO
|
---|
| 163 | for do quit:(curRef="")!(abort=1)
|
---|
| 164 | . set blockOut=$get(@curRef)
|
---|
| 165 | . if (blockOut'="") write blockOut
|
---|
| 166 | . set $X=0 ;"prevent IO system from 'wrapping' (adding a linefeed)
|
---|
| 167 | . set curRef=$$NEXTNODE(curRef,incSubscr,mustExist)
|
---|
| 168 |
|
---|
| 169 | if (abort'=1) set result=1 ;"SUCCESS
|
---|
| 170 | do CLOSE^%ZISH(handle)
|
---|
| 171 |
|
---|
| 172 | GTBFDone
|
---|
| 173 | quit result
|
---|
| 174 |
|
---|
| 175 |
|
---|
| 176 | NEXTNODE(curRef,incSubscr,mustExist,incAmount)
|
---|
| 177 | ;"SCOPE: PUBLIC
|
---|
| 178 | ;"Purpose: to take a global reference, and increment the node specified by incSubscr
|
---|
| 179 | ;"Input: curRef -- The reference to alter, e.g. '^TMP(115,1,4,0)'
|
---|
| 180 | ;" incSubscr--The node to alter, e.g.
|
---|
| 181 | ;" 1-->^TMG(x,1,4,0) x would be incremented
|
---|
| 182 | ;" 2-->^TMG(115,x,4,0) x would be incremented
|
---|
| 183 | ;" 3-->^TMG(115,1,x,0) x would be incremented
|
---|
| 184 | ;" 4-->^TMG(115,1,4,x) x would be incremented
|
---|
| 185 | ;" mustExist-- (Option) if >0, then after incrementing, If resulting
|
---|
| 186 | ;" reference doesn't exist then "" is returned.
|
---|
| 187 | ;" incAmount -- (Optional) the amount to increment by (default=1)
|
---|
| 188 | ;"Note: The node that incSubscr references should be numeric (i.e. not a name)
|
---|
| 189 | ;" otherwise the alpha node will be treated as a 0
|
---|
| 190 | ;"result: returns the new reference (or "" if doesn't exist and mustExist>0)
|
---|
| 191 |
|
---|
| 192 | new i,result
|
---|
| 193 | set incAmount=$get(incAmount,1)
|
---|
| 194 | set result=$qsubscript(curRef,0)_"("
|
---|
| 195 | for i=1:1:$qlength(curRef) do
|
---|
| 196 | . new node
|
---|
| 197 | . if i'=1 set result=result_","
|
---|
| 198 | . set node=$qsubscript(curRef,i)
|
---|
| 199 | . if i=incSubscr set node=node+incAmount
|
---|
| 200 | . if (node'=+node) set node=""""_node_""""
|
---|
| 201 | . set result=result_node
|
---|
| 202 | set result=result_")"
|
---|
| 203 |
|
---|
| 204 | if $get(mustExist,0)>0 do
|
---|
| 205 | . if $data(@result)#10=0 set result=""
|
---|
| 206 |
|
---|
| 207 | quit result
|
---|
| 208 |
|
---|
| 209 |
|
---|
| 210 | CPYBG(srcGRef,srcIncSubscr,dstGRef,dstIncSubscr,width)
|
---|
| 211 |
|
---|
| 212 | ;"*** NOTICE: THIS FUNCTION IS NOT WORKING PROPERLY, IT REPEATS THE DATA IN BLOCKS...***
|
---|
| 213 |
|
---|
| 214 | ;"Purpose: COPY/RESIZE BINARY GLOBAL. This can be used to change the number of bytes
|
---|
| 215 | ;" stored on each line of a binary global array
|
---|
| 216 | ;"Input:
|
---|
| 217 | ;" srcGRef-- Global reference of the SOURCE binary global array, in fully resolved
|
---|
| 218 | ;" (closed root) format.
|
---|
| 219 | ;" Note:
|
---|
| 220 | ;" At least one subscript must be numeric. This will be the incrementing
|
---|
| 221 | ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
|
---|
| 222 | ;" to store each new global node). This subscript need not be the final
|
---|
| 223 | ;" subscript. For example, to load into a WORD PROCESSING field, the
|
---|
| 224 | ;" incrementing node is the second-to-last subscript; the final subscript
|
---|
| 225 | ;" is always zero.
|
---|
| 226 | ;" REQUIRED
|
---|
| 227 | ;" srcIncSubscr-- (required) Identifies the incrementing subscript level, for the source global
|
---|
| 228 | ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
|
---|
| 229 | ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
|
---|
| 230 | ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
|
---|
| 231 | ;" reference, such as ^TMP(115,1,x,0).
|
---|
| 232 | ;" REQUIRED
|
---|
| 233 | ;" dstGRef-- Global reference of the DESTINATION binary global array, in fully resolved
|
---|
| 234 | ;" (closed root) format. The destination IS NOT KILLED prior to filling with
|
---|
| 235 | ;" new data
|
---|
| 236 | ;" Note:
|
---|
| 237 | ;" At least one subscript must be numeric. (same as note above)
|
---|
| 238 | ;" REQUIRED
|
---|
| 239 | ;" dstIncSubscr-- (required) Identifies the incrementing subscript level, for the source global
|
---|
| 240 | ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
|
---|
| 241 | ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
|
---|
| 242 | ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
|
---|
| 243 | ;" reference, such as ^TMP(115,1,x,0).
|
---|
| 244 | ;" REQUIRED
|
---|
| 245 | ;" width-- The number of bytes to store per line in the DESTINATION array.
|
---|
| 246 | ;" REQUIRED
|
---|
| 247 | ;"
|
---|
| 248 | ;"Output: @dstGRef is filled with data
|
---|
| 249 | ;"Result: None
|
---|
| 250 |
|
---|
| 251 |
|
---|
| 252 | ;"*** NOTICE: THIS FUNCTION IS NOT WORKING PROPERLY, IT REPEATS THE DATA IN BLOCKS...***
|
---|
| 253 |
|
---|
| 254 | new readPos set readPos=1
|
---|
| 255 | new bytesRead
|
---|
| 256 | if $get(srcGRef)="" goto CPYBGDone
|
---|
| 257 | if $get(dstGRef)="" goto CPYBGDone
|
---|
| 258 | if $get(srcIncSubscr)="" goto CPYBGDone
|
---|
| 259 | if $get(dstIncSubscr)="" goto CPYBGDone
|
---|
| 260 | if $get(width)="" goto CPYBGDone
|
---|
| 261 |
|
---|
| 262 | for do quit:(bytesRead=0)
|
---|
| 263 | . set @dstGRef=$$READBG(srcGRef,srcIncSubscr,readPos,width,.bytesRead)
|
---|
| 264 | . if (bytesRead=0) kill @dstGRef
|
---|
| 265 | . set readPos=readPos+bytesRead
|
---|
| 266 | . set dstGRef=$$NEXTNODE(dstGRef,dstIncSubscr,0,1)
|
---|
| 267 |
|
---|
| 268 | CPYBGDone
|
---|
| 269 | quit
|
---|
| 270 |
|
---|
| 271 |
|
---|
| 272 |
|
---|
| 273 | READBG(GRef,incSubscr,pos,count,actualCount)
|
---|
| 274 | ;"SCOPE: PUBLIC
|
---|
| 275 | ;"Purpose: To read 'count' bytes from binary global '@srcGRef', starting at 'pos'
|
---|
| 276 | ;"Input:
|
---|
| 277 | ;" GRef-- Global reference of the binary global array, in fully resolved
|
---|
| 278 | ;" (closed root) format.
|
---|
| 279 | ;" Note:
|
---|
| 280 | ;" At least one subscript must be numeric. This will be the incrementing
|
---|
| 281 | ;" subscript (i.e. the subscript that $$BIN2WP^TMGBINWP will increment
|
---|
| 282 | ;" to store each new global node). This subscript need not be the final
|
---|
| 283 | ;" subscript. For example, to load into a WORD PROCESSING field, the
|
---|
| 284 | ;" incrementing node is the second-to-last subscript; the final subscript
|
---|
| 285 | ;" is always zero.
|
---|
| 286 | ;" REQUIRED
|
---|
| 287 | ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global
|
---|
| 288 | ;" For example, if you pass ^TMP(115,1,1,0) as the global_ref parameter and
|
---|
| 289 | ;" pass 3 as the inc_subscr parameter, $$BIN2GBL will increment the third
|
---|
| 290 | ;" subscript, such as ^TMP(115,1,x), but will WRITE notes at the full global
|
---|
| 291 | ;" reference, such as ^TMP(115,1,x,0).
|
---|
| 292 | ;" REQUIRED
|
---|
| 293 | ;" Pos-- The position in the binary global to start reading from (0 is first byte), as if
|
---|
| 294 | ;" entire global array is one long binary stream. E.g. the 913th byte might be
|
---|
| 295 | ;" actually the 17th byte on the 14th line (if 64 bytes are stored per line). But
|
---|
| 296 | ;" this is handled transparently and the user need only specify byte #913 etc.
|
---|
| 297 | ;" . The reading will start at the appropriate point.
|
---|
| 298 | ;" count-- The number of bytes/characters to read.
|
---|
| 299 | ;" actualCount-- OPTIONAL. An OUT PARAMETER -- PASS BY REFERENCE
|
---|
| 300 | ;" This is filled with the actual number of bytes/characters successfully read.
|
---|
| 301 | ;"Result: a string filled with requested number of bytes/characters
|
---|
| 302 |
|
---|
| 303 | new result set result=""
|
---|
| 304 | new countPerLine
|
---|
| 305 | new goalLen set goalLen=count
|
---|
| 306 | new Line,p1
|
---|
| 307 | new done
|
---|
| 308 | if $get(GRef)="" goto ReadBGDone
|
---|
| 309 | set countPerLine=$length(@GRef)
|
---|
| 310 | if (countPerLine=0) goto ReadBGDone
|
---|
| 311 |
|
---|
| 312 | set Line=pos\countPerLine
|
---|
| 313 | set p1=pos#countPerLine
|
---|
| 314 |
|
---|
| 315 | for do quit:(done=1)!(count<1)
|
---|
| 316 | . new curRef
|
---|
| 317 | . set done=0
|
---|
| 318 | . set curRef=$$NEXTNODE(GRef,incSubscr,1,Line)
|
---|
| 319 | . if curRef="" set done=1 quit
|
---|
| 320 | . set result=result_$extract(@GRef,p1,p1+count-1)
|
---|
| 321 | . set count=goalLen-$length(result)
|
---|
| 322 | . if count<1 set done=1 quit
|
---|
| 323 | . set Line=Line+1
|
---|
| 324 | . set p1=1
|
---|
| 325 |
|
---|
| 326 | ReadBGDone
|
---|
| 327 | set actualCount=$length(result)
|
---|
| 328 | quit result
|
---|
| 329 |
|
---|
| 330 |
|
---|