%macro formchar(fileref,fcstring);
%local __lsold __number __fflag __pgno;
/******************************************************************/
/* COPYRIGHT 1993 by Kernon M. Gibes */
/* */
/* FILESPEC: SAS$ROOT:[CUSTOM.AUTO]FORMCHAR.TPU;1 */
/* SYSTEM: VAX/VMS */
/* LANGUAGE: SAS 6.07 Macro */
/* ABSTRACT: SAS macro to replace the ASCII codes of a SAS */
/* PROC TABULATE FORMCHAR string with the DEC */
/* Special Graphic (DSG) characters and escape */
/* sequences in order to produce solid-lined */
/* tables on DEC VTxxx/LN0x equipment. */
/* VERSION: 2.0 */
/* DATE: January 1993 */
/* AUTHOR: Kernon M. Gibes */
/* */
/* INPUT: File reference (logical name) and, optionally, */
/* a FORMCHAR hex string */
/* */
/* OUTPUT: Edited file sent to procedure output destination */
/* */
/* USAGE: %FORMCHAR(fileref[,fcstring]) */
/* */
/* fileref = file reference used with PRINTTO */
/* fcstring = optional FORMCHAR string used, in */
/* format 'xxxxxxxxxxxxxxxxxxxxxx'X, */
/* if not given, defaults to global */
/* value */
/* */
/* NOTES: This macro currently only supports CC=CR */
/* carriage control, and line sizes up to 200. */
/******************************************************************/
%if &fileref=%then %do;
%put ;
%put ERROR: FORMCHAR macro requires a fileref (logical name);
%put %str( ) No fileref was specified at invocation.;
%put %str( ) Macro FORMCHAR aborted.;
%end;
%else %do;
/* Get the current values of the LINESIZE and NUMBER */
/* global options, and the fileref that should have */
/* been specified at invocation: */
proc sql;
reset noprint;
select setting into :__lsold
from dictionary.options
where optname in ('LINESIZE');
select setting into :__number
from dictionary.options
where optname in ('NUMBER');
select fileref into :__fflag
from dictionary.extfiles
where fileref="%upcase(&fileref)"
;
/* If necessary, get the FORMCHAR global option */
%if &fcstring=%then %do;
select setting into :globalfc
from dictionary.options
where optname in ('FORMCHAR');
quit;
%end;
%else %do;
quit;
%end;
%if &__fflag=%then %do;
%put ;
%put ERROR: FORMCHAR macro requires a fileref (logical name);
%put %str( ) The given fileref, "&fileref", does not exist;
%put %str( ) Macro FORMCHAR aborted.;
%end;
%else %do;
%if &__lsold gt 200 %then %do;
%put ;
%put WARNING: FORMCHAR macro can only process line sizes to 200.;
%put %str( ) Since the linesize is greater than 200, note;
%put %str( ) that unpredictable results may occur.;
%end;
/* Set linesize to maximum in order to accommodate the */
/* many-to-one mapping of FORMCHAR characters to DEC escape */
/* escape sequences. */
options ls=256;
/* Use a "null" data step to read in the TABULATE output, */
/* and do all FORMCHAR mappings for solid-lines: */
data _null_;
length buffer $ 200 fc $ 11
char escape SI formfeed $ 1
fc1 - fc11 $ 6
firstff numflag chknum 2
;
retain firstff 1 chknum 0
%if &fcstring=%then
fc "&globalfc";
%else
fc &fcstring;
%if &__number=NUMBER %then
numflag 1;
%else
numflag 0;
formfeed '0C'X escape '1B'X SI '0F'X
;
/* Initialize the array of DEC escape sequences that each */
/* FORMCHAR character must be mapped into. */
array _fcmap {11} fc1 - fc11
('8F78'X, 'q', '1B2B301B6F6C'X, 'w', '6B0F'X, '1B6F74'X,
'n', '750F'X, '1B6F6D'X, 'v', '6A0F'X );
file print print notitles;
infile &fileref noprint length=len;
input buffer $varying200. len;
/* Check for new page (formfeed). Only the very first */
/* one can be ignored, otherwise start a new page, and set */
/* a flag for parsing the page number (if necessary). */
if buffer=formfeed then do;
if numflag then chknum=1;
if firstff then firstff=0;
else put _page_;
end;
else do;
/* If this is the first line and page numbering is */
/* on, parse out the current value so that it can be */
/* used to reset the page number later on. */
if chknum then do;
do i=length(buffer) to 1 by -1
while(substr(buffer,i,1) ne ' ');
end;
call symput('__pgno',substr(buffer,i));
chknum=0;
put buffer $varying200. len;
end;
else do;
/* For each character in the input file, check to */
/* see if it is a FORMCHAR character. If not, just */
/* output it. If it is, output the appropriate */
/* DEC escape sequence. */
do i=1 to length(buffer);
char=substr(buffer,i,1);
j=index(fc,char);
if j>0 then do;
l=length(_fcmap[j]);
put _fcmap[j] $varying6. l @;
end;
else
put char $1. @;
end;
put;
end;
end;
run;
/* Reset the linesize */
options linesize=&__lsold;
%if &syserr=0 %then %do;
%put NOTE: FORMCHAR re-processing of TABULATE output completed.;
%if &__number=NUMBER %then %do;
options pageno=%eval(1+&__pgno);
%put %str( ) Page numbering reset to start at %eval(1+&__pgno);
%end;
%else %do;
%put %str( ) Page numbering not reset.;
%end;
%put ;
%end;
%else %do;
%put ;
%put ERROR: FORMCHAR re-processing of TABULATE output failed.;
%put %str( ) Unknown error occurred during processing.;
%end;
%end;
%end;
%mend formchar;