TMGBINF ;TMG/kst/Binary <--> Global Functions ;03/25/06 ;;1.0;TMG-LIB;**1**;08/20/05 ;"TMG BIN <-->GBL FUNCTIONS ;"Kevin Toppenberg MD ;"GNU General Public License (GPL) applies ;"8-20-2005 ;"======================================================================= ;" API -- Public Functions. ;"======================================================================= ;"$$BFTG(path,filename,globalRef,incSubscr,width) -- BINARY FILE TO GLOBAL ;"$$GTBF(globalRef,incSubscr,path,filename) -- GLOBAL TO BINARY FILE ;"CPYBG(srcGRef,srcIncSubscr,dstGRef,dstIncSubscr,width) -- COPY/RESIZE BINARY GLOBAL. ;"======================================================================= ;"PRIVATE API FUNCTIONS ;"======================================================================= ;"$$NEXTNODE(curRef,incSubscr) ;"$$READBG(GRef,incSubscr,pos,count,actualCount) -- STREAM READ FROM BINARY GLOBAL ;"======================================================================= ;"DEPENDENCIES ;"======================================================================= ;"Uses: (No other units) ;"======================================================================= BFTG(path,filename,globalRef,incSubscr,width) ;"SCOPE: PUBLIC ;"Purpose: To load a binary file from the host filesystem into a global, storing ;" the composit bytes as raw binary data. ;" You do not need to open the host file before making this call; it is opened ;" and closed automatically ;"Input: path -- (required) full path, up to but not including the filename ;" filename -- (required) name of the file to open ;" globalRef-- (required) 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. ;" 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). ;" width -- OPTIONAL -- the number of bytes to store per line. Default=512 ;"*** NOTICE: width is not working properly. For now, just don't supply a number. ;"Result: 1=success, 0=failure ;" ;"Example: ;" write $$BFTG(path,file,"^TMP(115,1,1,0)",3) ;" ^TMP(115,1,1,0)="04016785439093479334987689724398732490782..." ;" ^TMP(115,1,2,0)="09834573467345092647823450982345858792346..." ;" ^TMP(115,1,3,0)="90783492734987234098243908723459590823494..." ;" ^TMP(115,1,4,0)="23489723450234097234980732402349955987284..." ;" ^TMP(115,1,5,0)="0983457823450982734572349874234874" <-- not padded with terminal zeros ;"In this example, only digits 0-9 are shown. In reality each digit can be a byte with a value 0-255 new result set result=0 ;"default to failure new handle set handle="TMGHANDLE" new abort set abort=0 new blockIn new $ETRAP if $get(globalRef)="" goto BFTGDone new curRef new tempRef set tempRef="^TMP(""BFTG^TMGBINF"","_$J_",1)" ;"if user wants a width other than 512, will have to load into a temporary location, ;"and then copy over to final destination at requested with if +$get(width)>0 set curRef=tempRef else set curRef=globalRef set filename=$get(filename) if filename="" goto BFTGDone set path=$$DEFDIR^%ZISH($get(path)) ;"Note: Each line will 512 bytes long (512 is hard coded into OPEN^%ZISH) do OPEN^%ZISH(handle,path,filename,"RB") ;"B is a 512 block/binary mode if POP write "Error opening file...",! goto BFTGDone set $ETRAP="set abort=1,$ECODE="""" quit" use IO for do quit:($ZEOF)!(abort=1)!(blockIn="") . read blockIn . if (blockIn="") quit . set @curRef=blockIn . set curRef=$$NEXTNODE(curRef,incSubscr) if abort=1 write "Aborted...",! if (abort'=1) set result=1 ;"SUCCESS do CLOSE^%ZISH(handle) if +$get(width)>0 do . do CPYBG(tempRef,3,globalRef,incSubscr,width) . kill @tempRef BFTGDone quit result GTBF(globalRef,incSubscr,path,filename) ;"SCOPE: PUBLIC ;"Purpose: This function will WRITE the values of nodes of a global (at the subscript ;" level you specify) to a host file, in a binary fashion. If the host file already ;" exists, it is truncated to length zero (0) before the copy. ;" Each line of the global is written out, in a serial fashion based on the ordering ;" of the subscripts, with no line terminators written between lines. ;" You do not need to open the host file before making this call; it is opened ;" and closed $$GTBF^TMGBINF ;"Input: ;" 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). ;" path -- full path, up to but not including the filename (required) ;" filename -- name of the file to open (required) ;"Result: 1=success, 0=failure ;" ;"Example: ;" write $$GTBF(path,file,"^TMP(115,1,1,0)",3) ;" ^TMP(115,1,1,0)="04016785439093479334987689724398732490782..." ;" ^TMP(115,1,2,0)="09834573467345092647823450982345858792346..." ;" ^TMP(115,1,3,0)="90783492734987234098243908723459590823494..." ;" ^TMP(115,1,4,0)="23489723450234097234980732402349955987284..." ;" ^TMP(115,1,5,0)="0983457823450982734572349874234874" ;"Each line would be sent to the output file in turn as a continuous data sequence. ;"In this example, only digits 0-9 are shown. In reality each digit can be a byte with a value 0-255 ;" new result set result=0 ;"default to failure new handle set handle="TMGHANDLE" new abort set abort=0 new blockOut new mustExist set mustExist=1 new $ETRAP new curRef set curRef=globalRef set path=$$DEFDIR^%ZISH($get(path)) do OPEN^%ZISH(handle,path,filename,"W") if POP goto GTBFDone set $ETRAP="set abort=1,$ECODE="""" quit" use IO for do quit:(curRef="")!(abort=1) . set blockOut=$get(@curRef) . if (blockOut'="") write blockOut . set $X=0 ;"prevent IO system from 'wrapping' (adding a linefeed) . set curRef=$$NEXTNODE(curRef,incSubscr,mustExist) if (abort'=1) set result=1 ;"SUCCESS do CLOSE^%ZISH(handle) GTBFDone quit result NEXTNODE(curRef,incSubscr,mustExist,incAmount) ;"SCOPE: PUBLIC ;"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 ;" mustExist-- (Option) if >0, then after incrementing, If resulting ;" reference doesn't exist then "" is returned. ;" incAmount -- (Optional) the amount to increment by (default=1) ;"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 (or "" if doesn't exist and mustExist>0) new i,result set incAmount=$get(incAmount,1) 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+incAmount . if (node'=+node) set node=""""_node_"""" . set result=result_node set result=result_")" if $get(mustExist,0)>0 do . if $data(@result)#10=0 set result="" quit result CPYBG(srcGRef,srcIncSubscr,dstGRef,dstIncSubscr,width) ;"*** NOTICE: THIS FUNCTION IS NOT WORKING PROPERLY, IT REPEATS THE DATA IN BLOCKS...*** ;"Purpose: COPY/RESIZE BINARY GLOBAL. This can be used to change the number of bytes ;" stored on each line of a binary global array ;"Input: ;" srcGRef-- Global reference of the SOURCE binary global array, in fully resolved ;" (closed root) format. ;" 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. ;" REQUIRED ;" srcIncSubscr-- (required) Identifies the incrementing subscript level, for the source global ;" 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). ;" REQUIRED ;" dstGRef-- Global reference of the DESTINATION binary global array, in fully resolved ;" (closed root) format. The destination IS NOT KILLED prior to filling with ;" new data ;" Note: ;" At least one subscript must be numeric. (same as note above) ;" REQUIRED ;" dstIncSubscr-- (required) Identifies the incrementing subscript level, for the source global ;" 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). ;" REQUIRED ;" width-- The number of bytes to store per line in the DESTINATION array. ;" REQUIRED ;" ;"Output: @dstGRef is filled with data ;"Result: None ;"*** NOTICE: THIS FUNCTION IS NOT WORKING PROPERLY, IT REPEATS THE DATA IN BLOCKS...*** new readPos set readPos=1 new bytesRead if $get(srcGRef)="" goto CPYBGDone if $get(dstGRef)="" goto CPYBGDone if $get(srcIncSubscr)="" goto CPYBGDone if $get(dstIncSubscr)="" goto CPYBGDone if $get(width)="" goto CPYBGDone for do quit:(bytesRead=0) . set @dstGRef=$$READBG(srcGRef,srcIncSubscr,readPos,width,.bytesRead) . if (bytesRead=0) kill @dstGRef . set readPos=readPos+bytesRead . set dstGRef=$$NEXTNODE(dstGRef,dstIncSubscr,0,1) CPYBGDone quit READBG(GRef,incSubscr,pos,count,actualCount) ;"SCOPE: PUBLIC ;"Purpose: To read 'count' bytes from binary global '@srcGRef', starting at 'pos' ;"Input: ;" GRef-- Global reference of the binary global array, in fully resolved ;" (closed root) format. ;" 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. ;" REQUIRED ;" incSubscr-- (required) Identifies the incrementing subscript level, for the source global ;" 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). ;" REQUIRED ;" Pos-- The position in the binary global to start reading from (0 is first byte), as if ;" entire global array is one long binary stream. E.g. the 913th byte might be ;" actually the 17th byte on the 14th line (if 64 bytes are stored per line). But ;" this is handled transparently and the user need only specify byte #913 etc. ;" . The reading will start at the appropriate point. ;" count-- The number of bytes/characters to read. ;" actualCount-- OPTIONAL. An OUT PARAMETER -- PASS BY REFERENCE ;" This is filled with the actual number of bytes/characters successfully read. ;"Result: a string filled with requested number of bytes/characters new result set result="" new countPerLine new goalLen set goalLen=count new Line,p1 new done if $get(GRef)="" goto ReadBGDone set countPerLine=$length(@GRef) if (countPerLine=0) goto ReadBGDone set Line=pos\countPerLine set p1=pos#countPerLine for do quit:(done=1)!(count<1) . new curRef . set done=0 . set curRef=$$NEXTNODE(GRef,incSubscr,1,Line) . if curRef="" set done=1 quit . set result=result_$extract(@GRef,p1,p1+count-1) . set count=goalLen-$length(result) . if count<1 set done=1 quit . set Line=Line+1 . set p1=1 ReadBGDone set actualCount=$length(result) quit result