source: cprs/branches/tmg-cprs/m_files/TMGBINF.m@ 1117

Last change on this file since 1117 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 17.2 KB
Line 
1TMGBINF ;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
30BFTG(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
106BFTGDone
107 quit result
108
109
110GTBF(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
172GTBFDone
173 quit result
174
175
176NEXTNODE(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
210CPYBG(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
268CPYBGDone
269 quit
270
271
272
273READBG(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
326ReadBGDone
327 set actualCount=$length(result)
328 quit result
329
330
Note: See TracBrowser for help on using the repository browser.