Program CBCTAS;
{$nomain}
{$norangecheck} { allow illegal BCD digits to be detected internally }

{ 
  Version
  File:[22,310]CBCTAS.PAS
  Author: Jim Bostwick 18-OCt-83

  Last Edit: 23-JUN-1988 22:09:42 

  History: JMB 8-Nov-83  -- general bug fixes - asterisk fill on bad BCD
	 23-JUN-1988 21:55:47  - JMB PA3UTL upgrade.
  	 16-Nov-83 - JMB - correct output digit order
  			    eliminate zero-suppression : now only alters
  				actual digits, plus blank fill if string
  				extended

}
{$Nolist}
{[a+,b+,l-,k+,r+] Pasmat }
 %INCLUDE 'PAS$EXT:General.typ';
 %INCLUDE 'PAS$EXT:BCD.TYP';
{$List }


{--------------- Convert BCD array to ASCII ---------------------}

Procedure CBCTAS( B: packed array [LOBC..NBCD:integer] of BCD_Digit;
  		 Var asc: Packed array [lo..hi:integer] of char;
  		  pos: Integer
  	);External;

{*USER*
 Convert bcd array to ascii string. Pos > 0 => pos = start position.
Pos < 0 => Pos = end position (right justify). Pos = 0 => right
justify in entire Str. 
 Illegal BCD digits are detected by this routine, resulting in 
asterisk ("*") fill of entire field. Also, over- or under-flow
of field will result in asterisk fill of legal portion.
}

Procedure CBCTAS;

Var
  start, endpos: integer;
  in_len, i: integer;
  foo:boolean;

BEGIN
  foo := false;
  if lo = 1 then in_len := 1 else in_len := ord(asc[0]);

  { establish start position, endposition }	

  if pos > 0 then start := pos
    else if pos = 0 then start := hi-nbcd+1
    else 
    BEGIN 
    pos := -pos;
    start := pos-nbcd+1
    END;

  endpos := start + nbcd - 1;

{ check field limits within output string }

  if Start < lo then 
    BEGIN 
    foo := true;
    start := lo
    END;
  IF endpos > hi then 
    BEGIN 
    foo := true;
    endpos := hi
    END;

  { check legal BCD }
  if not(foo) then for i := lobc to nbcd do 
    if not(b[i] in [0..9]) then foo := true;

  if foo then for i := start to endpos do asc[i] := '*'
    else
    BEGIN 
    if in_len < start then { blank pad }
      for i := in_len to start do asc[i] := ' ';
    for i := 1 to nbcd do
         asc[endpos - i + 1] := chr(ord('0') + b[i]);
    END;

  { reset string length }
  if (lo = 0) then
     if (in_len < endpos) then asc[0] := chr(endpos)
END;