HDISVM03 ;BPFO/JRP,HRN/ART - UUENCODE;5/31/2007
;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
;
ENCODE(IN,OUT,ZERO) ;UUEncode contents of array
; Input: IN = Array containing lines of text to encode
; (FULL GLOBAL REFERENCE)
; IN(0) = File name for encoded text
; (used when uudecoding)
; IN(1..n) = Lines of text
; IN(n,1..m) = Continuation of text when length of line
; is longer than 245 characters
; OUT = Array to put uuencoded text into
; (FULL GLOBAL REFERENCE)
; ZERO = Flag indicating if the main nodes in the input array
; store their text on a zero node. A value of 1
; denotes that the text is stored in IN(node,0). A
; value of 0 denotes that the text is not. This only
; applies to the main nodes; IN(0) and continuation
; nodes are assumed to not use a zero node (i.e.
; IN(0,0) and IN(node,cont,0) are not valid).
; (DEFAULTS TO 0)
;
;Output: None
; OUT will be set as follows:
; OUT(1) = "begin 644 FILENAME"
; OUT(2..n) = UUEncoded line of text
; OUT(n+1) = "`"
; OUT(n+2) = "end"
;
; Notes: It is assumed that all input is defined
; : The OUT array will be initialized (KILLed) on input.
; : It is assumed that IN is not an empty arrary (i.e. there's
; data to be uuencoded in it).
; : A carriage return & line feed will be inserted between each
; line of text [after all continuation nodes have been
; appended].
; : FILENAME in node OUT(1) will be replaced by the value from
; input node IN(0). TEXT.TXT will be used as the filename
; if IN(0) is not defined or empty.
;
NEW NODE,CONT,TEXT,WORKING,OUTNODE,CRLF
KILL @OUT
SET ZERO=+$GET(ZERO)
SET CRLF=$CHAR(13,10)
SET WORKING=""
;Append beginning uuencoding designation to output array
SET TEXT=@IN@(0)
SET:(TEXT="") TEXT="TEXT.TXT"
SET @OUT@(1)="begin 644 "_TEXT
SET OUTNODE=2
;Loop through input array
SET NODE=0
FOR SET NODE=+$ORDER(@IN@(NODE)) QUIT:('NODE) DO
.SET TEXT=$SELECT(ZERO:@IN@(NODE,0),1:@IN@(NODE))
.DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
.;Loop through continuation nodes
.SET CONT=0
.FOR SET CONT=+$ORDER(@IN@(NODE,CONT)) QUIT:('CONT) DO
..SET TEXT=@IN@(NODE,CONT)
..DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
..QUIT
.;Append CR-LF between main nodes
.DO UUEWORK(CRLF,.WORKING,OUT,.OUTNODE)
.QUIT
;Encode remaining text
IF $LENGTH(WORKING) DO
.SET @OUT@(OUTNODE)=$$UUE45(WORKING)
.SET OUTNODE=OUTNODE+1
.QUIT
;Append end uuencoding designation to output array
SET @OUT@(OUTNODE)="`"
SET @OUT@(OUTNODE+1)="end"
QUIT
;
ENCGRID(IN,OUT,DELIMITR) ;UUEncode contents of a grid
; Input: IN = Array containing grid cells of text to encode
; (FULL GLOBAL REFERENCE)
; IN(0) = File name for encoded text
; (used when uudecoding)
; IN(1..n,1..n) = Grid cells of text - IN(row,col)=value
; IN(n,n,1..m) = Continuation of text when length of line
; is longer than 245 characters
; OUT = Array to put uuencoded text into
; (FULL GLOBAL REFERENCE)
; DELIMITR = Delimiter character (DEFAULTS TO | (pipe))
;
;Output: None
; OUT will be set as follows:
; OUT(1) = "begin 644 FILENAME"
; OUT(2..n) = UUEncoded line of text
; OUT(n+1) = "`"
; OUT(n+2) = "end"
;
; Notes: It is assumed that all input is defined
; : The input grid array will be 1 based - no subscripts with value
; of zero (0), except IN(0) which contains the file name
; IN(0) and continuation nodes are assumed to not use a zero node
; (i.e. IN(0,0) and IN(row,col,cont,0) are not valid).
; : The input grid array must include empty cells - no missing nodes
; : If column headings are included, they must be in row 1 - IN(1,1..n)
; : The OUT array will be initialized (KILLed) on input.
; : It is assumed that IN is not an empty arrary (i.e. there's
; data to be uuencoded in it).
; : A carriage return & line feed will be inserted between each
; line of text [after all continuation nodes have been
; appended].
; : FILENAME in node OUT(1) will be replaced by the value from
; input node IN(0). TEXT.TXT will be used as the filename
; if IN(0) is not defined or empty.
;
NEW RNODE,CNODE,CONT,TEXT,WORKING,OUTNODE,CRLF
KILL @OUT
SET:($G(DELIMITR)="") DELIMITR="|"
SET CRLF=$CHAR(13,10)
SET WORKING=""
;Append beginning uuencoding designation to output array
SET TEXT=@IN@(0)
SET:(TEXT="") TEXT="TEXT.TXT"
SET @OUT@(1)="begin 644 "_TEXT
SET OUTNODE=2
;Loop through input array
SET RNODE=0
FOR SET RNODE=+$ORDER(@IN@(RNODE)) QUIT:('RNODE) DO
.SET CNODE=0
.FOR SET CNODE=+$ORDER(@IN@(RNODE,CNODE)) QUIT:('CNODE) DO
..SET TEXT=@IN@(RNODE,CNODE)
..DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
..;Loop through continuation nodes
..SET CONT=0
..FOR SET CONT=+$ORDER(@IN@(RNODE,CNODE,CONT)) QUIT:('CONT) DO
...SET TEXT=@IN@(RNODE,CNODE,CONT)
...DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
...QUIT
..;Append delimiter between cell nodes
..DO UUEWORK(DELIMITR,.WORKING,OUT,.OUTNODE)
..QUIT
.;Append CR-LF between main nodes
.DO UUEWORK(CRLF,.WORKING,OUT,.OUTNODE)
.QUIT
;Encode remaining text
IF $LENGTH(WORKING) DO
.SET @OUT@(OUTNODE)=$$UUE45(WORKING)
.SET OUTNODE=OUTNODE+1
.QUIT
;Append end uuencoding designation to output array
SET @OUT@(OUTNODE)="`"
SET @OUT@(OUTNODE+1)="end"
QUIT
;
UUEWORK(TEXT,WORKING,OUT,OUTNODE) ;UUEncode text & add to output
; Input: TEXT = Text to append to uuencoded output array
; WORKING = Text that hasn't been uuencoded yet as
; uuencoding is done against 45 characters
; at a time
; (PASS BY REFERENCE)
; OUT = Array to put uuencoded text into
; (FULL GLOBAL REFERENCE)
; OUTNODE = Node in OUT to store uuencoded text into
; (PASS BY REFERENCE)
;Output: None
; WORKING = Text that was not uuencoded
; OUTNODE = Next node in OUT to store uuencoded text into
; OUT will be set as follows:
; OUT(OUTNODE..n) = UUEncoded line of text
; Notes: It is assumed that all input is defined
;
NEW STOP,LENWORK
SET STOP=0
;UUEncode 45 characters at a time
FOR DO QUIT:(STOP)
.;Combine text with left over text to make 45 character string
.SET LENWORK=$LENGTH(WORKING)
.SET WORKING=WORKING_$EXTRACT(TEXT,1,(45-LENWORK))
.SET TEXT=$EXTRACT(TEXT,(45-LENWORK+1),$LENGTH(TEXT))
.IF $LENGTH(WORKING)<45 SET STOP=1 QUIT
.;UUEncode and store in output array
.SET @OUT@(OUTNODE)=$$UUE45(WORKING)
.;Increment subscript value and reset left over text
.SET OUTNODE=OUTNODE+1
.SET WORKING=""
.QUIT
QUIT
;
UUE45(TEXT) ;UUEncode a string of 45 characters
; Input: TEXT = String of text to uuencode (up to 45 characters)
;Output: UUEncoded text including length character
; Notes: It is assumed that all input is defined
; : It is assumed that TEXT will not be greater than 45
; characters in length.
;
NEW LOOP,LENGTH,UUENC
SET TEXT=$GET(TEXT)
SET LENGTH=$LENGTH(TEXT)
SET UUENC="" SET:(LENGTH=0) UUENC=$$UUE3("")
FOR LOOP=1:3:LENGTH SET UUENC=UUENC_$$UUE3($EXTRACT(TEXT,LOOP,LOOP+2))
QUIT $CHAR(32+LENGTH)_UUENC
;
UUE3(CHARS) ;UUEncode 3 characters
; Input: CHARS = Characters to uuencode (up to 3 characters)
;Output: UUEncoded text
; Notes: It is assumed that all input is defined
; : It is assumed that CHARS will not be greater than 3
; characters in length.
; : CHARS will be right padded with spaces to make it 3
; characters in length.
;
NEW DEC1,DEC2,DEC3,BIN1,BIN2,BIN3
NEW BIN1A,BIN2A,BIN3A,BIN4A,DEC1A,DEC2A,DEC3A,DEC4A
SET CHARS=$EXTRACT($GET(CHARS)_" ",1,3)
SET DEC1=$ASCII($EXTRACT(CHARS,1))
SET DEC2=$ASCII($EXTRACT(CHARS,2))
SET DEC3=$ASCII($EXTRACT(CHARS,3))
SET BIN1=$$RJ^XLFSTR($$CNV^XLFUTL(DEC1,2),8,"0")
SET BIN1=$EXTRACT(BIN1,($LENGTH(BIN1)-7),$LENGTH(BIN1))
SET BIN2=$$RJ^XLFSTR($$CNV^XLFUTL(DEC2,2),8,"0")
SET BIN2=$EXTRACT(BIN2,($LENGTH(BIN2)-7),$LENGTH(BIN2))
SET BIN3=$$RJ^XLFSTR($$CNV^XLFUTL(DEC3,2),8,"0")
SET BIN3=$EXTRACT(BIN3,($LENGTH(BIN3)-7),$LENGTH(BIN3))
SET BIN1A=$EXTRACT(BIN1,1,6)
SET BIN2A=$EXTRACT(BIN1,7,8)_$EXTRACT(BIN2,1,4)
SET BIN3A=$EXTRACT(BIN2,5,8)_$EXTRACT(BIN3,1,2)
SET BIN4A=$EXTRACT(BIN3,3,8)
SET DEC1A=$$DEC^XLFUTL(BIN1A,2)+32
SET DEC2A=$$DEC^XLFUTL(BIN2A,2)+32
SET DEC3A=$$DEC^XLFUTL(BIN3A,2)+32
SET DEC4A=$$DEC^XLFUTL(BIN4A,2)+32
QUIT $CHAR(DEC1A,DEC2A,DEC3A,DEC4A)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHDISVM03 9033 printed Oct 16, 2024@17:57:47 Page 2
HDISVM03 ;BPFO/JRP,HRN/ART - UUENCODE;5/31/2007
+1 ;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
+2 ;
ENCODE(IN,OUT,ZERO) ;UUEncode contents of array
+1 ; Input: IN = Array containing lines of text to encode
+2 ; (FULL GLOBAL REFERENCE)
+3 ; IN(0) = File name for encoded text
+4 ; (used when uudecoding)
+5 ; IN(1..n) = Lines of text
+6 ; IN(n,1..m) = Continuation of text when length of line
+7 ; is longer than 245 characters
+8 ; OUT = Array to put uuencoded text into
+9 ; (FULL GLOBAL REFERENCE)
+10 ; ZERO = Flag indicating if the main nodes in the input array
+11 ; store their text on a zero node. A value of 1
+12 ; denotes that the text is stored in IN(node,0). A
+13 ; value of 0 denotes that the text is not. This only
+14 ; applies to the main nodes; IN(0) and continuation
+15 ; nodes are assumed to not use a zero node (i.e.
+16 ; IN(0,0) and IN(node,cont,0) are not valid).
+17 ; (DEFAULTS TO 0)
+18 ;
+19 ;Output: None
+20 ; OUT will be set as follows:
+21 ; OUT(1) = "begin 644 FILENAME"
+22 ; OUT(2..n) = UUEncoded line of text
+23 ; OUT(n+1) = "`"
+24 ; OUT(n+2) = "end"
+25 ;
+26 ; Notes: It is assumed that all input is defined
+27 ; : The OUT array will be initialized (KILLed) on input.
+28 ; : It is assumed that IN is not an empty arrary (i.e. there's
+29 ; data to be uuencoded in it).
+30 ; : A carriage return & line feed will be inserted between each
+31 ; line of text [after all continuation nodes have been
+32 ; appended].
+33 ; : FILENAME in node OUT(1) will be replaced by the value from
+34 ; input node IN(0). TEXT.TXT will be used as the filename
+35 ; if IN(0) is not defined or empty.
+36 ;
+37 NEW NODE,CONT,TEXT,WORKING,OUTNODE,CRLF
+38 KILL @OUT
+39 SET ZERO=+$GET(ZERO)
+40 SET CRLF=$CHAR(13,10)
+41 SET WORKING=""
+42 ;Append beginning uuencoding designation to output array
+43 SET TEXT=@IN@(0)
+44 if (TEXT="")
SET TEXT="TEXT.TXT"
+45 SET @OUT@(1)="begin 644 "_TEXT
+46 SET OUTNODE=2
+47 ;Loop through input array
+48 SET NODE=0
+49 FOR
SET NODE=+$ORDER(@IN@(NODE))
if ('NODE)
QUIT
Begin DoDot:1
+50 SET TEXT=$SELECT(ZERO:@IN@(NODE,0),1:@IN@(NODE))
+51 DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
+52 ;Loop through continuation nodes
+53 SET CONT=0
+54 FOR
SET CONT=+$ORDER(@IN@(NODE,CONT))
if ('CONT)
QUIT
Begin DoDot:2
+55 SET TEXT=@IN@(NODE,CONT)
+56 DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
+57 QUIT
End DoDot:2
+58 ;Append CR-LF between main nodes
+59 DO UUEWORK(CRLF,.WORKING,OUT,.OUTNODE)
+60 QUIT
End DoDot:1
+61 ;Encode remaining text
+62 IF $LENGTH(WORKING)
Begin DoDot:1
+63 SET @OUT@(OUTNODE)=$$UUE45(WORKING)
+64 SET OUTNODE=OUTNODE+1
+65 QUIT
End DoDot:1
+66 ;Append end uuencoding designation to output array
+67 SET @OUT@(OUTNODE)="`"
+68 SET @OUT@(OUTNODE+1)="end"
+69 QUIT
+70 ;
ENCGRID(IN,OUT,DELIMITR) ;UUEncode contents of a grid
+1 ; Input: IN = Array containing grid cells of text to encode
+2 ; (FULL GLOBAL REFERENCE)
+3 ; IN(0) = File name for encoded text
+4 ; (used when uudecoding)
+5 ; IN(1..n,1..n) = Grid cells of text - IN(row,col)=value
+6 ; IN(n,n,1..m) = Continuation of text when length of line
+7 ; is longer than 245 characters
+8 ; OUT = Array to put uuencoded text into
+9 ; (FULL GLOBAL REFERENCE)
+10 ; DELIMITR = Delimiter character (DEFAULTS TO | (pipe))
+11 ;
+12 ;Output: None
+13 ; OUT will be set as follows:
+14 ; OUT(1) = "begin 644 FILENAME"
+15 ; OUT(2..n) = UUEncoded line of text
+16 ; OUT(n+1) = "`"
+17 ; OUT(n+2) = "end"
+18 ;
+19 ; Notes: It is assumed that all input is defined
+20 ; : The input grid array will be 1 based - no subscripts with value
+21 ; of zero (0), except IN(0) which contains the file name
+22 ; IN(0) and continuation nodes are assumed to not use a zero node
+23 ; (i.e. IN(0,0) and IN(row,col,cont,0) are not valid).
+24 ; : The input grid array must include empty cells - no missing nodes
+25 ; : If column headings are included, they must be in row 1 - IN(1,1..n)
+26 ; : The OUT array will be initialized (KILLed) on input.
+27 ; : It is assumed that IN is not an empty arrary (i.e. there's
+28 ; data to be uuencoded in it).
+29 ; : A carriage return & line feed will be inserted between each
+30 ; line of text [after all continuation nodes have been
+31 ; appended].
+32 ; : FILENAME in node OUT(1) will be replaced by the value from
+33 ; input node IN(0). TEXT.TXT will be used as the filename
+34 ; if IN(0) is not defined or empty.
+35 ;
+36 NEW RNODE,CNODE,CONT,TEXT,WORKING,OUTNODE,CRLF
+37 KILL @OUT
+38 if ($GET(DELIMITR)="")
SET DELIMITR="|"
+39 SET CRLF=$CHAR(13,10)
+40 SET WORKING=""
+41 ;Append beginning uuencoding designation to output array
+42 SET TEXT=@IN@(0)
+43 if (TEXT="")
SET TEXT="TEXT.TXT"
+44 SET @OUT@(1)="begin 644 "_TEXT
+45 SET OUTNODE=2
+46 ;Loop through input array
+47 SET RNODE=0
+48 FOR
SET RNODE=+$ORDER(@IN@(RNODE))
if ('RNODE)
QUIT
Begin DoDot:1
+49 SET CNODE=0
+50 FOR
SET CNODE=+$ORDER(@IN@(RNODE,CNODE))
if ('CNODE)
QUIT
Begin DoDot:2
+51 SET TEXT=@IN@(RNODE,CNODE)
+52 DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
+53 ;Loop through continuation nodes
+54 SET CONT=0
+55 FOR
SET CONT=+$ORDER(@IN@(RNODE,CNODE,CONT))
if ('CONT)
QUIT
Begin DoDot:3
+56 SET TEXT=@IN@(RNODE,CNODE,CONT)
+57 DO UUEWORK(TEXT,.WORKING,OUT,.OUTNODE)
+58 QUIT
End DoDot:3
+59 ;Append delimiter between cell nodes
+60 DO UUEWORK(DELIMITR,.WORKING,OUT,.OUTNODE)
+61 QUIT
End DoDot:2
+62 ;Append CR-LF between main nodes
+63 DO UUEWORK(CRLF,.WORKING,OUT,.OUTNODE)
+64 QUIT
End DoDot:1
+65 ;Encode remaining text
+66 IF $LENGTH(WORKING)
Begin DoDot:1
+67 SET @OUT@(OUTNODE)=$$UUE45(WORKING)
+68 SET OUTNODE=OUTNODE+1
+69 QUIT
End DoDot:1
+70 ;Append end uuencoding designation to output array
+71 SET @OUT@(OUTNODE)="`"
+72 SET @OUT@(OUTNODE+1)="end"
+73 QUIT
+74 ;
UUEWORK(TEXT,WORKING,OUT,OUTNODE) ;UUEncode text & add to output
+1 ; Input: TEXT = Text to append to uuencoded output array
+2 ; WORKING = Text that hasn't been uuencoded yet as
+3 ; uuencoding is done against 45 characters
+4 ; at a time
+5 ; (PASS BY REFERENCE)
+6 ; OUT = Array to put uuencoded text into
+7 ; (FULL GLOBAL REFERENCE)
+8 ; OUTNODE = Node in OUT to store uuencoded text into
+9 ; (PASS BY REFERENCE)
+10 ;Output: None
+11 ; WORKING = Text that was not uuencoded
+12 ; OUTNODE = Next node in OUT to store uuencoded text into
+13 ; OUT will be set as follows:
+14 ; OUT(OUTNODE..n) = UUEncoded line of text
+15 ; Notes: It is assumed that all input is defined
+16 ;
+17 NEW STOP,LENWORK
+18 SET STOP=0
+19 ;UUEncode 45 characters at a time
+20 FOR
Begin DoDot:1
+21 ;Combine text with left over text to make 45 character string
+22 SET LENWORK=$LENGTH(WORKING)
+23 SET WORKING=WORKING_$EXTRACT(TEXT,1,(45-LENWORK))
+24 SET TEXT=$EXTRACT(TEXT,(45-LENWORK+1),$LENGTH(TEXT))
+25 IF $LENGTH(WORKING)<45
SET STOP=1
QUIT
+26 ;UUEncode and store in output array
+27 SET @OUT@(OUTNODE)=$$UUE45(WORKING)
+28 ;Increment subscript value and reset left over text
+29 SET OUTNODE=OUTNODE+1
+30 SET WORKING=""
+31 QUIT
End DoDot:1
if (STOP)
QUIT
+32 QUIT
+33 ;
UUE45(TEXT) ;UUEncode a string of 45 characters
+1 ; Input: TEXT = String of text to uuencode (up to 45 characters)
+2 ;Output: UUEncoded text including length character
+3 ; Notes: It is assumed that all input is defined
+4 ; : It is assumed that TEXT will not be greater than 45
+5 ; characters in length.
+6 ;
+7 NEW LOOP,LENGTH,UUENC
+8 SET TEXT=$GET(TEXT)
+9 SET LENGTH=$LENGTH(TEXT)
+10 SET UUENC=""
if (LENGTH=0)
SET UUENC=$$UUE3("")
+11 FOR LOOP=1:3:LENGTH
SET UUENC=UUENC_$$UUE3($EXTRACT(TEXT,LOOP,LOOP+2))
+12 QUIT $CHAR(32+LENGTH)_UUENC
+13 ;
UUE3(CHARS) ;UUEncode 3 characters
+1 ; Input: CHARS = Characters to uuencode (up to 3 characters)
+2 ;Output: UUEncoded text
+3 ; Notes: It is assumed that all input is defined
+4 ; : It is assumed that CHARS will not be greater than 3
+5 ; characters in length.
+6 ; : CHARS will be right padded with spaces to make it 3
+7 ; characters in length.
+8 ;
+9 NEW DEC1,DEC2,DEC3,BIN1,BIN2,BIN3
+10 NEW BIN1A,BIN2A,BIN3A,BIN4A,DEC1A,DEC2A,DEC3A,DEC4A
+11 SET CHARS=$EXTRACT($GET(CHARS)_" ",1,3)
+12 SET DEC1=$ASCII($EXTRACT(CHARS,1))
+13 SET DEC2=$ASCII($EXTRACT(CHARS,2))
+14 SET DEC3=$ASCII($EXTRACT(CHARS,3))
+15 SET BIN1=$$RJ^XLFSTR($$CNV^XLFUTL(DEC1,2),8,"0")
+16 SET BIN1=$EXTRACT(BIN1,($LENGTH(BIN1)-7),$LENGTH(BIN1))
+17 SET BIN2=$$RJ^XLFSTR($$CNV^XLFUTL(DEC2,2),8,"0")
+18 SET BIN2=$EXTRACT(BIN2,($LENGTH(BIN2)-7),$LENGTH(BIN2))
+19 SET BIN3=$$RJ^XLFSTR($$CNV^XLFUTL(DEC3,2),8,"0")
+20 SET BIN3=$EXTRACT(BIN3,($LENGTH(BIN3)-7),$LENGTH(BIN3))
+21 SET BIN1A=$EXTRACT(BIN1,1,6)
+22 SET BIN2A=$EXTRACT(BIN1,7,8)_$EXTRACT(BIN2,1,4)
+23 SET BIN3A=$EXTRACT(BIN2,5,8)_$EXTRACT(BIN3,1,2)
+24 SET BIN4A=$EXTRACT(BIN3,3,8)
+25 SET DEC1A=$$DEC^XLFUTL(BIN1A,2)+32
+26 SET DEC2A=$$DEC^XLFUTL(BIN2A,2)+32
+27 SET DEC3A=$$DEC^XLFUTL(BIN3A,2)+32
+28 SET DEC4A=$$DEC^XLFUTL(BIN4A,2)+32
+29 QUIT $CHAR(DEC1A,DEC2A,DEC3A,DEC4A)
