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