Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HDISVM04

HDISVM04.m

Go to the documentation of this file. 
  1. HDISVM04 ;BPFO/JRP - UUDECODE;5/31/2007
  1.  ;;1.0;HEALTH DATA & INFORMATICS;**7**;Feb 22, 2005;Build 33
  1.  ;
  1. DECODE(IN,OUT,FIND,ZERO) ;UUDecode contents of text
  1.  ; Input: IN = Array containing lines of text to encode
  1.  ;             (FULL GLOBAL REFERENCE)
  1.  ;          IN(1) = "begin 644 FILENAME"
  1.  ;          IN(2..n) = UUEncoded line of text
  1.  ;          IN(n+1) = "`"
  1.  ;          IN(n+2) = "end"
  1.  ;        OUT = Array to put uudecoded text into
  1.  ;              (FULL GLOBAL REFERENCE)
  1.  ;        FIND = Flag indicating if the "begin 644 FILENAME" line
  1.  ;               must be found.  A value of 1 will cause this utility
  1.  ;               to order through the nodes of the array until the
  1.  ;               beginning line is found.  A value of 0 will cause
  1.  ;               this utility to assume that node IN(1) is the
  1.  ;               beginning node.
  1.  ;               (DEFAULTS TO 0)
  1.  ;        ZERO = Flag indicating if the input array stores it's data
  1.  ;               on a zero node.  A value of 1 denotes that the
  1.  ;               uuencoded data is stored in IN(node,0).  A value of
  1.  ;               0 denotes that the uuencoded data is not.
  1.  ;               (DEFAULTS TO 0)
  1.  ;Output: None
  1.  ;        OUT will be set as follows:
  1.  ;          OUT(0) = File name from encoded text
  1.  ;          OUT(1..n) = Lines of text
  1.  ;          OUT(n,1..m) = Continuation of text when length of line
  1.  ;                        is longer than 245 characters
  1.  ;
  1.  ; Notes: It is assumed that all input is defined
  1.  ;      : The OUT array will be initialized (KILLed) on input.
  1.  ;      : It is assumed that IN is not an empty arrary (i.e. there's
  1.  ;        data to be uudecoded in it).
  1.  ;      : A carriage return, line feed, or carriage return plus line
  1.  ;        feed will move storing of the decoded text to the next node
  1.  ;        of the output array
  1.  ;
  1.  NEW NODE,CR,LF,UUENC,LOOP,LENGTH,OUTNODE,WORKING,TEXT
  1.  NEW CRSPOT,LFSPOT,TMPTXT,TMPLEN,CREND
  1.  KILL @OUT
  1.  SET FIND=+$GET(FIND)
  1.  SET ZERO=+$GET(ZERO)
  1.  SET CR=$CHAR(13)
  1.  SET LF=$CHAR(10)
  1.  SET CREND=0
  1.  ;Move to beginning of encoded text
  1.  SET NODE=1
  1.  IF (FIND) DO  QUIT:('NODE)
  1.  .NEW STOP
  1.  .SET STOP=0
  1.  .SET NODE=0
  1.  .FOR  SET NODE=+$ORDER(@IN@(NODE)) QUIT:('NODE)  DO  QUIT:(STOP)
  1.  ..SET TEXT=$SELECT(ZERO:@IN@(NODE,0),1:@IN@(NODE))
  1.  ..IF ($TRANSLATE(TEXT,0)["begin 644") SET STOP=1
  1.  ..QUIT
  1.  .IF ('STOP) SET NODE=0
  1.  .QUIT
  1.  ;Put file name into output array
  1.  SET TEXT=$SELECT(ZERO:@IN@(NODE,0),1:@IN@(NODE))
  1.  SET @OUT@(0)=$PIECE(TEXT,"644 ",2)
  1.  ;Loop through input array
  1.  SET OUTNODE=1
  1.  SET WORKING=""
  1.  FOR  SET NODE=+$ORDER(@IN@(NODE)) QUIT:('NODE)  DO
  1.  .SET UUENC=$SELECT(ZERO:@IN@(NODE,0),1:@IN@(NODE))
  1.  .;End of encoded input - force outer loop to quit
  1.  .IF ((UUENC="`")!(UUENC=" ")) SET NODE=+$ORDER(@IN@(""),-1) QUIT
  1.  .;Get length of encoded text
  1.  .SET LENGTH=$ASCII($EXTRACT(UUENC,1))-32
  1.  .;UUDecode 4 characters at a time
  1.  .SET TEXT=""
  1.  .FOR LOOP=2:4:$LENGTH(UUENC) DO
  1.  ..SET TEXT=TEXT_$$UUD4($EXTRACT(UUENC,LOOP,LOOP+3))
  1.  ..QUIT
  1.  .;Remove extra characters from end of text
  1.  .SET TEXT=$EXTRACT(TEXT,1,LENGTH)
  1.  .;First character is LF and last character of previous line was CR
  1.  .;Drop the LF since the CR/LF was done on previous line
  1.  .IF ($EXTRACT(TEXT,1)=LF) IF (CREND) SET TEXT=$EXTRACT(TEXT,2,$LENGTH(TEXT))
  1.  .;Remember if last character is CR
  1.  .SET CREND=0
  1.  .IF ($EXTRACT(TEXT,$LENGTH(TEXT))=CR) SET CREND=1
  1.  .;Check for CR/LF in text
  1.  .IF ((TEXT[CR)!(TEXT[LF)) FOR  DO  QUIT:((TEXT'[CR)&(TEXT'[LF))
  1.  ..SET CRSPOT=$FIND(TEXT,CR)-1
  1.  ..SET:(CRSPOT<0) CRSPOT=0
  1.  ..SET LFSPOT=$FIND(TEXT,LF)-1
  1.  ..SET:(LFSPOT<0) LFSPOT=0
  1.  ..IF (LFSPOT=(CRSPOT+1)) DO  QUIT
  1.  ...;CR/LF pair
  1.  ...SET TMPTXT=$EXTRACT(TEXT,1,CRSPOT-1)
  1.  ...SET TEXT=$EXTRACT(TEXT,LFSPOT+1,$LENGTH(TEXT))
  1.  ...;Add to output array & increment subscript
  1.  ...DO APPEND(TMPTXT,.WORKING,OUT,.OUTNODE,1)
  1.  ...QUIT
  1.  ..ELSE  IF ((('CRSPOT)&(LFSPOT))!((LFSPOT)&(LFSPOT<CRSPOT))) DO  QUIT
  1.  ...;LF before CR
  1.  ...SET TMPTXT=$EXTRACT(TEXT,1,LFSPOT-1)
  1.  ...SET TEXT=$EXTRACT(TEXT,LFSPOT+1,$LENGTH(TEXT))
  1.  ...;Add to output array & increment subscript
  1.  ...DO APPEND(TMPTXT,.WORKING,OUT,.OUTNODE,1)
  1.  ...QUIT
  1.  ..ELSE  IF ((('LFSPOT)&(CRSPOT))!((CRSPOT)&(CRSPOT<LFSPOT))) DO  QUIT
  1.  ...;LF after CR (but not CR/LF pair)
  1.  ...SET TMPTXT=$EXTRACT(TEXT,1,CRSPOT-1)
  1.  ...SET TEXT=$EXTRACT(TEXT,CRSPOT+1,$LENGTH(TEXT))
  1.  ...;Add to output array & increment subscript
  1.  ...DO APPEND(TMPTXT,.WORKING,OUT,.OUTNODE,1)
  1.  ...QUIT
  1.  ..QUIT
  1.  .;Add text to output
  1.  .DO APPEND(TEXT,.WORKING,OUT,.OUTNODE,0)
  1.  .QUIT
  1.  ;Add remaining text to output
  1.  IF $LENGTH(WORKING) DO
  1.  .DO STORE(WORKING,OUT,OUTNODE)
  1.  QUIT
  1.  ;
  1. UUD4(CHARS) ;UUDecode 4 characters
  1.  ; Input: CHARS = Characters to uudecode
  1.  ;Output: UUDecoded text
  1.  ; Notes: It is assumed that all input is defined
  1.  ;      : It is assumed that CHARS is exactly 4 characters in length
  1.  ;
  1.  NEW DEC1,DEC2,DEC3,BIN1,BIN2,BIN3
  1.  NEW BIN1A,BIN2A,BIN3A,BIN4A,DEC1A,DEC2A,DEC3A,DEC4A
  1.  SET DEC1A=$ASCII($EXTRACT(CHARS,1))-32
  1.  SET DEC2A=$ASCII($EXTRACT(CHARS,2))-32
  1.  SET DEC3A=$ASCII($EXTRACT(CHARS,3))-32
  1.  SET DEC4A=$ASCII($EXTRACT(CHARS,4))-32
  1.  SET BIN1A=$$RJ^XLFSTR($$CNV^XLFUTL(DEC1A,2),6,"0")
  1.  SET BIN1A=$EXTRACT(BIN1A,($LENGTH(BIN1A)-5),$LENGTH(BIN1A))
  1.  SET BIN2A=$$RJ^XLFSTR($$CNV^XLFUTL(DEC2A,2),6,"0")
  1.  SET BIN2A=$EXTRACT(BIN2A,($LENGTH(BIN2A)-5),$LENGTH(BIN2A))
  1.  SET BIN3A=$$RJ^XLFSTR($$CNV^XLFUTL(DEC3A,2),6,"0")
  1.  SET BIN3A=$EXTRACT(BIN3A,($LENGTH(BIN3A)-5),$LENGTH(BIN3A))
  1.  SET BIN4A=$$RJ^XLFSTR($$CNV^XLFUTL(DEC4A,2),6,"0")
  1.  SET BIN4A=$EXTRACT(BIN4A,($LENGTH(BIN4A)-5),$LENGTH(BIN4A))
  1.  SET BIN1=BIN1A_$EXTRACT(BIN2A,1,2)
  1.  SET BIN2=$EXTRACT(BIN2A,3,6)_$EXTRACT(BIN3A,1,4)
  1.  SET BIN3=$EXTRACT(BIN3A,5,6)_BIN4A
  1.  SET DEC1=$$DEC^XLFUTL(BIN1,2)
  1.  SET DEC2=$$DEC^XLFUTL(BIN2,2)
  1.  SET DEC3=$$DEC^XLFUTL(BIN3,2)
  1.  QUIT $CHAR(DEC1,DEC2,DEC3)
  1.  ;
  1. APPEND(TEXT,WORKING,OUT,OUTNODE,FORCE) ;Append text to running text
  1.  ; Input: TEXT = Text to append to uudecoded output array
  1.  ;        WORKING = Text that hasn't been added to output array yet
  1.  ;                  but is uudencoded.  Text is added to the output
  1.  ;                  array 245 characters at a time.
  1.  ;                  (PASS BY REFERENCE)
  1.  ;        OUT = Array to put uudecoded text into
  1.  ;              (FULL GLOBAL REFERENCE)
  1.  ;        OUTNODE = Node in OUT to store uudecoded text into
  1.  ;                  (PASS BY REFERENCE)
  1.  ;        FORCE = Flag indicating that a carriage return / line feed
  1.  ;               was encountered and all of the uudecoded text passed
  1.  ;               in should be stored in the output array.  Passing a
  1.  ;               value of 1 will force storage and incrementing of
  1.  ;               OUTNODE.  Passing a value of 0 will only store data
  1.  ;               in the output array if the running text exceeds 245
  1.  ;               characters.
  1.  ;               (DEFAULTS TO 0)
  1.  ;Output: None
  1.  ;        WORKING = Text that was not added to output array
  1.  ;        OUTNODE = Next node in OUT to store uudecoded text into
  1.  ;                  (this is incremented if FORCE = 1)
  1.  ;        OUT will be set as follows (if applicable):
  1.  ;          OUT(1..n) = Lines of text
  1.  ;          OUT(n,1..m) = Continuation of text when length of line
  1.  ;                        is longer than 245 characters
  1.  ; Notes: It is assumed that all input (except CRLF) is defined
  1.  ;
  1.  NEW LENWORK,LENTEXT
  1.  SET FORCE=+$GET(FORCE)
  1.  SET LENWORK=$LENGTH(WORKING)
  1.  SET LENTEXT=$LENGTH(TEXT)
  1.  ;Length of running text and new text won't exceed 245
  1.  IF ((LENWORK+LENTEXT)<245) DO
  1.  .SET WORKING=WORKING_TEXT
  1.  .QUIT
  1.  ;Length of running text and new text exceeds or equals 245
  1.  IF ((LENWORK+LENTEXT)>244) DO
  1.  .;Store combined text in output array
  1.  .SET WORKING=WORKING_$EXTRACT(TEXT,1,(245-LENWORK))
  1.  .DO STORE(WORKING,OUT,OUTNODE)
  1.  .;Set new working text
  1.  .SET WORKING=$EXTRACT(TEXT,(245-LENWORK+1),LENTEXT)
  1.  ;Carriage return / line feed request
  1.  IF (FORCE) DO
  1.  .;Store working text
  1.  .DO STORE(WORKING,OUT,OUTNODE)
  1.  .;Increment subscript value & clear working text
  1.  .SET OUTNODE=OUTNODE+1
  1.  .SET WORKING=""
  1.  .QUIT
  1.  QUIT
  1.  ;
  1. STORE(TEXT,OUT,NODE) ;Store text in uudecoded array
  1.  ; Input: TEXT = Text to append to uudecoded output array
  1.  ;        OUT = Array to put uudecoded text into
  1.  ;              (FULL GLOBAL REFERENCE)
  1.  ;        NODE = Node in OUT to store uudecoded text into
  1.  ;Output: None
  1.  ;        OUT will be set as follows:
  1.  ;          OUT(1..n) = Lines of text
  1.  ;          OUT(n,1..m) = Continuation of text when length of line
  1.  ;                        is longer than 245 characters
  1.  ; Notes: It is assumed that all input is defined
  1.  ;
  1.  ;Store text on main node
  1.  IF ('$DATA(@OUT@(NODE))) DO  QUIT
  1.  .SET @OUT@(NODE)=TEXT
  1.  .QUIT
  1.  ;Store combined text on continuation node
  1.  SET @OUT@(NODE,(1+$ORDER(@OUT@(NODE,""),-1)))=TEXT
  1.  QUIT