Here is the code. I will also attach it incase wrapping ruins it here...
;"TMG BIN <-->GBL FUNCTION
;"Kevin Toppenberg MD
;"GNU General Public License (GPL) applies
;"8-20-2005
;"=======================================================================
;" API -- Public Functions.
;"=======================================================================
;"$$BIN2GBL^TMGBINF(path,filename,globalRef,incSubscr)
;"$$GBL2BIN^TMGBINF(globalRef,incSubscr,path,filename)
;"=======================================================================
;"PRIVATE API FUNCTIONS
;"=======================================================================
;"=======================================================================
BIN2GBL(path,filename,globalRef,incSubscr)
;"Purpose: To load a binary file from the host filesystem into
a WP field, storing
;" the composit bytes as ascii hex codes.
;"Input: path -- full path, up to but not including the
filename (required)
;" filename -- name of the file to open (required)
;" globalRef-- Global reference to WRITE the host
binary file to, in fully resolved
;" (closed root) format. This
function does not kill the global before
;" writing to it. (required)
;" Note:
;" At least one subscript must be
numeric. This will be the incrementing
;" subscript (i.e. the subscript
that $$BIN2WP^TMGBINWP will increment
;" to store each new global node).
This subscript need not be the final
;" subscript. For example, to load
into a WORD PROCESSING field, the
;" incrementing node is the
second-to-last subscript; the final subscript
;" is always zero.
;" incSubscr-- (required) Identifies the incrementing
subscript level. For example, if you
;" pass ^TMP(115,1,1,0) as the
global_ref parameter and pass 3 as the
;" inc_subscr parameter, $$BIN2GBL
will increment the third subscript, such
;" as ^TMP(115,1,x), but will WRITE
notes at the full global reference, such
;" as ^TMP(115,1,x,0).
;"Result: 1=success, 0=failure
;"
;"Note: Each line of the global will contain up to 128 bytes
(256 characters)
;" (2 ascii hex characters = 1 source byte)
;"Example:
;" ^TMP(115,1,1,0)="A12C4F12E2791D9723C3297D3C30B73C1532A1...(continues
to 256 characters)"
;" ^TMP(115,1,2,0)="91D9723C3297D314ADF31B85F41A12C4F12E27...(continues
to 256 characters)"
;" ^TMP(115,1,3,0)="3A12C4F12E271B85F4C2ED9723C3297D314ADF...(continues
to 256 characters)"
;" ^TMP(115,1,4,0)="85F73C1532AA12C4F12E2791D9723C3297D314...(continues
to 256 characters)"
;" ^TMP(115,1,5,0)="61A85C30B73C1532AA12C4F12E2791D972" <--
not padded with terminal zeros
new result set result=0 ;"default to failure
new handle set handle="TMGHANDLE"
new abort set abort=0
new byteIn
new $ETRAP
new oneLine set oneLine=""
new curRef set curRef=globalRef
set path=$$DEFDIR^%ZISH($get(path))
do OPEN^%ZISH(handle,path,filename,"R")
if POP goto B2GDone
set $ETRAP="set abort=1,$ECODE="""" quit"
use IO
for do quit:($ZEOF)!(abort=1)!(byteIn=-1)
. read *byteIn:2
. if (byteIn=-1) quit
. set oneLine=oneLine_$$HEXCHR(byteIn,2)
. if $length(oneLine)>255 do
. . set @curRef=oneLine
. . set curRef=$$NEXTNODE(curRef,incSubscr)
. . set oneLine=""
if (oneLine'="")&(abort=0) do
. set @curRef=oneLine
. set oneLine=""
if (abort'=1) set result=1 ;"SUCCESS
do CLOSE^%ZISH(handle)
B2GDone
quit result
NEXTNODE(curRef,incSubscr)
;"Purpose: to take a global reference, and increment the node
specified by incSubscr
;"Input: curRef -- The reference to alter, e.g. '^TMP(115,1,4,0)'
;" incSubscr--The node to alter, e.g.
;" 1-->^TMG(x,1,4,0) x would
be incremented
;" 2-->^TMG(115,x,4,0) x would be
incremented
;" 3-->^TMG(115,1,x,0) x would be
incremented
;" 4-->^TMG(115,1,4,x) x would be
incremented
;"Note: the node that incSubscr references should be numeric
(i.e. not a name)
;" otherwise the alpha node will be treated as a 0
;"result: returns the new reference
new i,result
set result=$qsubscript(curRef,0)_"("
for i=1:1:$qlength(curRef) do
. new node
. if i'=1 set result=result_","
. set node=$qsubscript(curRef,i)
. if i=incSubscr set node=node+1
. if (node'=+node) set node=""""_node_""""
. set result=result_node
set result=result_")"
quit result
HEXCHR(n,digits)
;"Purpose: convert n to hex characters
;"Input: n -- the number to convert
;" digits: (optional) number of digits in output.
Leading 0's padded to
;" front of answer to set number of digits.
;" e.g. if answer is "A", then
;" 2 -> mandates at least 2 digits ("0A")
;" 3->3 digits ("00A")
new lo
new result set result=""
new ch
set digits=$get(digits,1)
for do quit:(n=0)
. set lo=n#16
. if (lo<10) set ch=+lo
. else set ch=$char(55+lo)
. set result=ch_result
. set n=n\16
for quit:($length(result)>(digits-1)) do
. set digits=digits-1
. set result="0"_result
quit result
TMGBINF.m
Description: Binary data
