/macros/ebcdic-t.vdm

// EBCDIC-T.VDM -- EBCDIC Level-2 Trial version - Limited to 5000 fields.

//		   Convert EBCDIC with packed fields into ASCII.

// 		   Supports EBCDIC text, packed-decimal, packed-binary, zoned,

//		   packed-no-zone, floating point, hexadecimal, ignored and

//		   custom fields. (Floating point data whose magnitudes are

//		   greater than 10E18 are blanked.)

//

//		   Converts COBOL picture specifications into commands

//		   recognized by the rest of this macro. The picture

//		   specifications may be edited to include new Greenview codes

//		   for more flexibility in the translation. See COBOL2V.VDM.

//

//		   Note: comments out "REDEFINES" statements which are

//			 otherwise unsupported.

//

//

//  Output Options:

//		   Append newline char(s) at the end of each record.

//		   Emit an explicit decimal point for packed and zoned fields.

//		   Quote and comma delimit each field.

// 		   Optionally emit specified delimiter(s) after each field.

//		   Write error messages to ebcdic.err (default).

//

//		   Now, optionally outputs records into DBASE .dbf files,

//		   including creating and updating the DBASE header record.

//		   Also, optionally includes a field-names record at the start

//		   of each output file. The initial field names can be generated

//		   from a COBOL copy-book. See COBOL2V.VDM.

//

//		Originally by: Theodore Green, Greenview Data, Inc.

//		Generalized by: Thomas C. Burt, Greenview Data, Inc.

//		Last change:   09/26/2003

//

// Requires:	VEDIT PLUS 6.10 dated 03-05-2003 or later.

//		EBCDIC.LAY or alias (see below).

//		REGPREP.VDM

//

// Optional:	COBOL2V.VDM (for preprocessing COBOL copybooks).

//		RELAY.VDM for generating output column #'s.

//		EBCDIC-2.VCM (customization submacro library).

//		EBCDIC.CUS (q.v.)

//

// From OS:	VPW [-N[mask]] [-Y] -X EBCDIC-2 fname [-A oname] [lname] [-u options]

//

//		When done, saves the output file as fname.X, where 'X' is

//		"ASC", normally, or "DBF" for DBASE output, or as specified

//	        by "-A oname" and displays it on the screen.

//

//		Use {FILE, Exit} to exit.

//

//		Unless an explicit data layout filename is specified via

//		optional parameter 'lname', the data layout file EBCDIC.LAY

//		(or "fname.LAY when option "-N" is specified) must exist

//		in the current directory or in Vedit's "Home" directory.

//		EBCDIC.LAY is described below.

//

//		-Y exits Vedit automatically after saving the translated file.

//

//		-A specifies the name of the output file, including optional

//		   drive and path.

//

//		-N[mask] with no parameter or when (mask&1) is true, uses

//		   "fname.LAY" as its record description file.

//		   Alternatively, to always use "fname.LAY", edit this macro

//		   setting numeric variable #64 = 1 as described, below.

//

//		   When (mask&2) is true, this macro terminates after

//		   COBOL preprocessing.

//

//		   When (mask&256) is true, this macro terminates after

//		   all preprocessing has finished.  (However, any "v="

//		   commands are not executed).

//

//		-U leadin to options for this macro. If used, must occur after

//		   all filenames have been specified.

//

//		   Unique ID options (auto-generated record# [run_no] run_date)

//		       run_no	   0 <= n < 9; default == 1.

//		       UID=val     val={off,auto,on or all}={0,1,2};

//				       default == 1.

//		       d=run_date  mm/dd/yyyy

//

//		   To include .nam at start of each output file:

//		       i[nclude][=val] val={off,on}={0,1}; default == 0.

//

//		   NOD 		to prevent decimal points from being output

//

//		   E.g., -u 2	specifies that "2" is to be inserted into the

//				run_no bytes of any unique ID.

//

//	#####	   NOTE: WIN95 batch processing strips "="; so, in .BAT files

//			 using the "-u" options, substitute "-" for the equals

//			 signs in the above-mentioned options.

//

// Note: blank-fills, by default, invalid zoned/packed decimal fields (see

//       bc=, below). Also, writes error message to EBCDIC.ERR (see "e=" below).

//

//////////////////////////////////////////////////////////////////////////////

//

// EBCDIC-2.LAY - Describes the file being translated.

//		  Lines specify optional header size, record size,

//		  comment lines, Vedit command lines and data descriptions.

//		  Columns must be specified in ascending order. Undescribed

//		  columns may be optionally ignored (copied from input to

//		  output as is); else are converted from EBCDIC to ASCII.

//		  Cobol copybook statements may also be used.

//

//	Data description (layout) lines:

//

//		[code col_siz [sop] [#r] [: cusops]] [// comment]

//

//		code is a string of letters followed by a space describing the

//		     field to be translated. E.g., "e " describes EBCDIC text.

//		     The codes are listed, below.

//

//		col_siz specifies the columns to be decoded; this may be done in

//		     two ways:

//

//		     a) begin_col<sep>end_col

//

//			The separator is typically a comma or a hyphen.

//			Columns begin counting from one.

//		        The end column is inclusive.

//

//		        The begin_col need not immediately follow any

//			preceding end_col since any unspecified columns are

//			processed according to the default type which is 'e'

//			unless changed with the "u=type" command (see below).

//

//			E.g., e 1-4 // specifies that columns one through

//				    // four are simple EBCDIC text.

//

//		     b) +size

//

//			Specifies the length of the field; assumes this item

//			is adjacent to the preceding item, although a column

//			number can be specified by preceding this item with

//			a "c=col" line.

//

//			Note the '+' prefix.

//

//			E.g., e +4 // the next four colums are EBCDIC text

//

//		sop (standard options):

//

//			[,[-|=]padlen;] [numops] [[pc=]'padch'] [[bc=]'badch']

//

//

//			padlen = # padchars to insert behind the output field;

//				 default "padch" is a blank space; changeable

//				 by the "pc=" specification.

//

//		       -padlen = # padchars to insert before the output field.

//

//		       =padlen = # digits to be output for 'b', 'd', 'l',

//			         'n' & 'u' commands.

//

//			       = # bytes for 'pb', 'pd', 'pn' and 'pz' commands.

//

//		       Note: the leading comma is required; the semicolon

//			     should be used to prevent misinterpretations.

//			     (Memento Murphi)!

//

//		numops: [+][b][z][u] [r[aw]] [v[n]]

//			[-][e][p][s]

//

//			+ to force plus sign for positive numbers, including

//			  unsigned packed decimal data that are not specified

//			  as unsigned; else, a blank is output. (Does not

//			  affect negative numbers for which a minus sign is

//			  always output).

//			- to override '+' specified on 'o=' (options) command.

//

//			b to display sign at the beginning of the number.

//			e to override 'b' specified on 'o=' (options) command.

//

//			s for signed numeric output. This is the default.

//			u for unsigned numeric output. No sign is expressed.

//

//			z to display leading zeros.

//			p to override 'z' specified on 'o=' (options) command.

//

//			r or raw to force non-compliant binaries to be evaluated.

//			  I.e., those whose magnitude is > normal maximum value.

//			  e.g., 0xc757 = 51031 which is larger than 4 digits which

//			  is the normal maximum for a 2-byte binary described

//			  as PIC 9(4) COMP. The previous example requires the ",=5;"

//			  parameter as well.

//

//			v[n] to output a decimal point 'n' digits from the

//			  right for numeric fields. If 'n' is zero or omitted,

//			  no fractional digits are output.

//

//		[pc=]'padch': specify the padding character for the current

//			    field; default is space; used with "[-]padlen";

//			    when "pc=" is not specified, sets "badchar" as

//			    well as "padchar". Also, used for the 'f' (fill

//			    or replace) specification.

//

//		[bc=]'badch': specify the "erase" character for the current

//			    field when invalid zoned/packed fields are

//			    encountered. Default is space. When "bc=" is not

//			    specified, sets padchar" as well as "badchar".

//

//		The specified padchar or badchar may be an ASCII char in the

//		range 0x20 to 0x7e ('a', e.g.) or null ('') or it may be

//		specified as a hex number 0xhh. (This is probably necessary

//		when translating from ASCII to EBCDIC).

//

//		Note: the apostrophes are still required: '0x99', e.g.

//

//		#r      Specify the register that contains the custom macro

//			to execute for the current custom field (code='c').

//

//		: cusops - The ":" indicates the presence of custom parameters

//			   for the custom macro (code='c').

//

//		//	starts a comment field.

//

//	Note: as indicated by the syntax above, blank lines and comment lines

//	      are valid. All comments and blank lines are stripped during

//	      preprocessing.

//

//	Note: Not described above is the "code=arg" form. Such lines are

//	      acted upon during preprocessing and then stripped from the

//	      working layout file. These codes are listed below.

//

//	Current codes are:

//		h= (header size)

//		r= (input record size/type[,output record type])

//		e= (max error report count, error filename)

//              i= (1 to include field-names header files *.nam)

//		o= (Set default output options: '+buz[,b2z]'; '-esp' is standard)

//

//		c= (Set field beginning column; COBOL cut & paste)

//		p= (Start of COBOL record description)

//		q= (End of COBOL record description)

//

//		u= (e[bcdic] (default) or i[gnore]) for unspecified cols

//		v= (Vedit commands - executed immediately)

//		x= (Vedit post-processing commands)

//

//		a= (Additional offset for unique ID calculation)

//		b= (Base_date for unique ID calculation)

//		d= (Run_date for unique ID calculation)

//		n= (# digits displayed for unique ID's)

//

//		bc=(badchar)

//		pc=(padchar)

//		xrf= (use DBASE cross reference file)

//

//		b  (binary)

//		c  (customized processing)

//		d  (packed decimal)

//		e  (EBCDIC)

//		f  (fill) i.e., replace with pad char, default = Space

//		h  (hex)

//		i  (ignore) i.e., copy to output

//		l  (float/double) Upto 10E18.

//		n  (packed_no_zone)

//		out [fname]

//		q  or qcd: quote and comma delimit each output field (no parms)

//		s  (signed ASCII decimal)

//		u  (unsigned EBCDIC numeric)

//		x  (delete)

//		z  (zoned decimal)

//

// Details for some of the above commands:

//

//	c	Customized processing:

//		    Initialization:

//			v=Reg_Set(r,'macro commands') or

//			v=Reg_Load(r,'macfile.vdm')

//

//		    Field specification:

//			c col_siz [sop] [#r] [: custom parameters] [// comment]

//

//			  col_siz, and [sop] are described above.

//			  'r' is the number of the T-Reg containing the

//			      customized translation commands (default=12) aka

//			      EBC_Settings(CustomMacro).

//			  'custom parameters' must be parsed by the

//			      customizing macro. E.g.,

//			          Buf_Switch(XLayBufNum)

//				  processing code

//				  Buf_Switch(XDataBufNum)

//			  '//' starts a comment field. This field is stripped

//			      during preprocessing, so any custom parameter

//			      cracking need not be concerned about it.

//

//			The custom macro must entirely process its source data

//			from CurPos upto but not including CurPos+XInpFieldSize;

//			i.e., replace, delete or skip over (ignore). On exit,

//			CurPos must be at the byte that was located, on entry,

//			at CurPos + XInpFieldSize.

//

//			Note: on entry, the current buffer is the source input

//			      data buffer XDataBufNum; i.e., (bn==xdata).

//

//	f	Fill (overwrite) with "padchar" (default=space) or specified char. E.g.,

//		    f cb-ce '*'    // Fill columns cb through ce with asterisks.

//

//		Useful for cleaning "filler" areas containing garbage.

//		Especially needed if this garbage gets translated into

//		weird control characters.

//

//	h	Hex - Output each byte as two hex digits '0' - '9', 'A' - 'F'.

//

//	l	Floating point (IBM 360 style).

//		    l bc,ec[,=ndigs;] [sop] [v[n]] [// comment]

//

//		Fixed format only, right justified; short floats (single precision)

//		can express seven significant digits; long floats (double precision)

//		can express sixteen. Values upto 10E18 can be processed; least

//		significant digits beyond the seventh or sixteenth are always 0.

//		Floating point values > 10E18 are BAD-CHAR erased. Fractions smaller

//		than 10E-18 are output as zeros.

//

//		Optional 'ndigs' specifies total # digit-output columns. The

//		decimal point, if any, is not counted nor is the sign.

//

//		"sop" are standard options "+bz-esp".

//

//		'n' specifies the number of fractional digits to display.

//

//		"v0" or "v" outputs a decimal point with no fractional digits

//		displayed.

//

//		If "v[n]" is omitted, no decimal point is output.

//

//	q[cd]	Quote and comma delimit each output field (no parms).

//		Each field must be specified. Since only the first letter

//		is examined, this may be specified as "qcd" or "quote and

//		comma delimit".

//

//	s	Signed ASCII field being converted to ASCII. Analagous to

//		signed (zoned) EBCDIC field. Presumes the final signed

//		byte of the field is one of (ASCII) '{', 'A' - 'R', '}'.

//

//	u	Unsigned numeric field. Needed only if an explicit decimal

//		point is to be output or if leading zeros are desired or

//		if an entirely blank/null field is to be expressed as text

//		zero(s).

//

//	x	Delete the field. When quoting and comma delimiting or

//		outputting a user defined delimiter after each field,

//		nothing is output, including the delimiters.

//

//	a=n	Additional offset for calculating unique ID's.

//		Use when processing more than one file with extracted

//		fields on a given day. Set greater than or equal to last

//		record # processed by the previous run. Not very useful.

//		Use the "-u n" invocation option with the "n=,,1"

//		layout specification as described below.

//

//	b=date	Base date for calculating unique ID's. Default is 1-1-2000.

//		Date must be expressed in mm/dd/yyyy format.  The separator

//		can be one of "/\._:-". The year must be completely expressed.

//

//	d=date	Run date for calculating unique ID's. Default is current date.

//

//	n=l,m,n	Control # digits displayed for each part of the unique ID.

//		'l' is the number of digits for the days-elapsed count;

//		'm' is the number of digits for the record count;

//		'n' is the number of digits for "run_number".

//		Default is "n=5,6,1". Use "n=,,0" to remove the position

//		reserved for the run #, if so desired. Setting the run #

//		requires the use of the "-u run_number" invocation option.

//

//	c=col	Set field beginning column (actually, preceding field's

//		ending column) for use with 'code +len' style specs

//		that are not contiguous with the last specified field.

//		Particularly useful for cut-&-pasting COBOL specs.

//

//	e=n[,f] Control writing of error messages to error file.

//		Default is to write all errors to EBCDIC.ERR, including

//		upto 1000 occurrences of invalid compressed data items.

//		This command allows changing the limit for reporting invalid

//		compressed data items; changing the default error filename;

//		and disabling error writing completely.

//

//		    'n' is the maximum # of invalid data messages.

//		    'f' is the name of the error file, including optional

//			drive and path.

//		    Disable error messages by including "e=" by itself.

//			e.g., "e=	// Disable writing errors to file"

//

//		The form "e=n" reports upto 'n' errors in "ebcdic.err".

//		The form "e=,errfname" reports upto 1000 errors in errfname.

//		Alternatively, use "e=errfname".

//

//		Note: The file ebcdic.err is always deleted at startup.

//		      Any explicitly named error file is emptied when the

//		      "e=" line is processed.

//

//		Note: Errors that occur during preprocessing generally

//		      cause processing to stop immediately.

//

//		N.B., Errors that occur before this command is processed

//		      are written to EBCDIC.ERR.

//

//	i=val   Flag to include header files "*.nam" at the start of each

//		output file that contains data. These files are expected to

//		consist of quoted and comma delimited field-names. "val"

//		is one of {0,1,off,on}, default == "off". The filename

//		proper of each ".nam" file must be the same as that of the

//              output file into which it is to be included. This option

//              may also be turned on with the "-u include=1" invocation

//              option.

//

//	h=	Size of header. Used to pass over (copy to output)

//		header information. Ordinarily not used.

//

//	o=nops[,b2z]

//

//		Examples: o=+bz // explicit '+'; leading sign; leading zeros

//			  o=uz	// Unsigned numeric values; leading zeros

//		Default:  o=-eps// blanked positive sign; trailing sign;

//				// blank padding; numbers are signed values

//

//		Options are:

//		    + for explicit plus sign for positive/unsigned numbers.

//		    - to output a space instead of '+' (default).

//

//		    b to output the sign at the beginning of the number.

//		    e to output the sign at the end of the number (default).

//

//		    s (signed) to express the sign at all. (Default).

//		    u (unsigned) to suppress the sign.

//

//		    z to output leading zeros.

//		    p for blank padding (default).

//

//		    ,b2z specifies that packed decimals, binaries and unsigned

//		      numeric fields that are entirely blank or null will be

//		      output as zero(s) formatted according to the other

//		      options.

//

//		This sets default output actions for 'b', 'd', 'l', 'n',

//		'u' & 'z' fields. The defaults may be overriden by the

//		individual field specifications. E.g., d 5,12 +bz

//

//		At most only one 'o=' line is needed. If more are used, the

//		effect is cumulative. Since these lines are preprocessed and

//		then stripped, there is little reason to use more than one

//		line.

//

//	p=[x]	Specifies start of COBOL picture specifications block;

//		'x' to output explicit decimal point for 9...v99... formats.

//		Otherwise, no decimal point is output. (If initial field is

//		not contiguous with last specified field, follow with

//		"c=colm1" where colm1 is the starting column less one).

//

//	q=	Specifies end of COBOL specifications block. Multiple

//		blocks may be specified within the data description file.

//

//	r=	Record size 'r= input_size_or_type[,output_type]', where

//		type may be 0, 1, 2 or "f" (output only). If no output

//		record type is specified, the input type is used.

//

//		When input/output records are/will be terminated by Carriage-

//		Return and/or Line-Feed, use record type:

//			   0 for <cr><lf>	(DOS)

//			   1 for <lf>		(UNIX)

//			   2 for <cr>		(MAC)

//

//		Record terminators are stripped from the input record.

//		They will then be appended to the output if output_type

//		(explicit or default) is one of the above three types.

//

//		Record terminators are not normally used with EBCDIC data

//		files.  They cannot be used when the data file contains

//		binary fields.

//

//		When records are unterminated, specify the input record

//		length upto but not including the variable portion of

//		variable length records; i.e., fields occurring after a 'rf'

//		specification (OCCURS .... DEPENDING ON ... clause in COBOL).

//

//		When unterminated multiple record types differing in length

//		are being processed, setting input_record_size_or_type to the

//		size of the largest record is probably appropriate.

//

//		The input record size must be specified for unterminated

//		records; it may also be specified for fixed length records

//		even when they have terminating character(s). Be sure to

//		include the terminators in the record length and process

//		them in the .LAY file.

//

//		Normally, no length is specified for the output record since

//		it is determined dynamically. Thus, for fixed length input

//		and output records, just specify the input record size:

//		"r=100", e.g.

//

//		If the output is to be unterminated but the input is

//		terminated, use 'f' for the output_type. Thus, "r=0,f"

//		inputs records terminated by Carriage-Return and Line-Feed

//		but strips them from the output ("f" stands for "fixed").

//

//		Examples: r=100,0	//Input record size = 100

//					//append <cr><lf> on output

//

//			  r=100		//Input record size = 100

//					//Output records are unterminated

//

//			  r=0		//Both input and output records

//					//terminated by <cr><lf>

//

//			  r=0,1		//Input records terminated by <cr><lf>

//					//Output records terminated by <lf>

//

//	u=arg	Specify action for non-specified fields.

//		arg=ebcdic to translate from EBCDIC to ASCII;

//		arg=ignore to simply copy the input columns to output.

//		Only the initial letter need be specified.

//		E.g, u=i // Copy unspecified columns to output.

//

//	v=	Vedit commands are executed as soon as they are encountered

//		and are then stripped from the layout file. The commands must

//		fit on one line but as many "v=" lines may be used as needed.

//		One line is sufficient for executing a macro file via a text

//		register.

//

//		May be used to put a user-defined output field delimiter

//		(string) into T-Reg[XDREG]: e.g., v=Reg_Set(XDREG,"|"); or

//		v=rs(XDREG,' ^ '). Unlike quoted and comma delimited fields,

//		not all fields need be specified; a group of unspecified

//		fields will have just one instance of the delimiter string

//		appended to the end of the group.

//

//	x=	Vedit commands are stored into T-Reg[14]. They are then

//		executed in a post processing pass after all other commands

//		have been applied to the entire file. These commands must

//		fit on one line. Use Call_File() if more lines are needed.

//

//	xrf=arg	Use DBASE cross reference file fname.XRF for generating the DBASE

//		header record. "arg" = "1" or "on" to use; "0" or "off" may be

//		used to generate the names automatically or the "xrf" line may

//		be omitted to achieve the same result. If the file fname.XRF is

//		empty, the field names will be automatically generated.

//

//	example EBCDIC-2.LAY file:

//

//		  // Each input record is 256 bytes long.

//		  // Output records have <cr><lf> appended.

//		  // The first 3 fields are packed decimal.

//		  // Columns 42-45 and 50-53 are binary.

//		  // Columns 54-57 are zoned decimal.

//		  //

//		  r=256,0	//Size of input records

//				//<cr><lf> appended to output

//		  d 7-10	//Packed decimal

//		  d 20-24	//Also packed decimal, (default = previous)

//		  d 32-38

//		  b 42-45	//Binary

//		  b 50-53

//		  z 54-57	//Zoned decimal

//		  //

//		  // The final fields contain leading zeros that are

//		  // to be converted to blanks with 1 leading blank inserted.

//		  //

//		  v=RegLoad(EBC_Settings(CustomMacro),"nolzero.cus")

//		  c 60-69 #12      // Field size remains contstant

//		  c 70-75	   // Uses T-Reg 12 for custom processing

//

//////////////////////////////////////////////////////////////////////////////

//

// Numeric register usage:

//

//	#0 - #5		Temp

//	     #3		Preprocessing: field counter

//	     #4		Preprocessing: max # fields in any record

//	#8		Reserved for levels 3 & 4

//	#10-#13		Temp; used as such by customizing macros

//			Note: #10 - #74 are used implicitly by UNPAKDEC.VDM.

//	#14-#19		Reserved for customizing macros

//	    #15		Preprocessing: temp

//	    #16		Preprocessing: buffer ID of extraction file

//	    #17		Preprocessing: 'out' counter

//	    #18		Preprocessing: flag that .VCM customization submacros have been loaded

//	#26		DBASE field counter

//	#27		Preprocessing: DBASE output record counter

//	#28		DBASE flag

//	#31-#39		Statistics

//	#40		Run # size in unique ID

//	#41		Data "segment" count. Normally set by "-u count".

//	#42		Unique ID control: {0,1,2} for {off,auto,all}; set by UID=on,off,auto

//			or "-u uid=n"

//	#43		Flag to include ".nam" header file at start of each output file

//	#44		Explicit decimal point flag (default = 1)

//	#50		Run date for unique ID's (preprocessing); # digits to display (processing)

//	#51		Preprocessing: statistics

//	#52		Reserved for level 4

//	#54		Flag that extraction file(s) present.

//	#55		Julian base date for unique ID generation (default = 1-1-2000)

//	#56		Reserved for level 4

//	#57		Default input record type or length ("r={type|length}");

//			Config(F_F_TYPE) when no "r="

//	#58		Preprocessing: statistics

//	#59		Preprocessing: record-types counter (= 1, always)

//	#61		Additional offset for unique ID calculation

//	#62		# digits displayed for unique ID (3 parts)

//	#63		Buffer ID of .xrf file for obtaining DBASE field names or zero

//	#64		Flag variable (hex values)

//			  01 to use "fname.LAY" instead of EBCDIC.LAY

//			  02 to stop after COBOL preprocessing

//			  04 to force explicit decimal point when translating

//			        COBOL picture lines of type 9...v9...

//			  08 to call T-Reg[14] for post processing ('x=').

//			  40 when explicit data layout file "lname"

//			 100 stops after preprocessing (doesn't execute v=)

//			 200 Flag to COBOL2V.VDM to run as submacro.

//			 800 to prevent generating unique ID's; archaic; use uid=off

//	#65		T-Reg offset for running under WILDFILE.VDM

//	#66		Save WILDFILE's Locked-in-Macro ID.

//	#67		Input record type (r=type): 0,1,2,3,6=fixed (see #87)

//			Determined from Config(F_F_TYPE) if no "r="

//	#68		Output record type: 0,1,2,6=fixed,7=DBASE (see #88)

//	#69		Zero 1st time; else 1

//	#73		Reserved for levels 3 & 4

//	#74		Reserved for level 4

//	#75		Main output buffer #

//	#76		Approx record size

//	#77		Current output buffer # for 'out' extractions

//	    		Temporary for initial statistics

//	#78		Temporary for stacking/popping XLASTCOLPROC with #77

//	#79		Reserved for level 4

//	#81		Preprocessing: temporary

//	#82		Reserved for levels 3 & 4

//	#85		Current data type (b,c,d,e,f,i,l,n,s,u,x,z)

//	#86		File header size (h=size) or -1

//	#87		Current input record size (r=size) or zero (see #67)

//	#88		Output record size or zero (see #68)

//	#90		Preprocessing: source data buffer

//	#91		Wildfile running flag

//	#92		Preprocessing: data layout buffer

//	#93 		1st line number to convert

//	#99		ID flag, possibly set by WILDFILE macro

//

//////////////////////////////////////////////////////////////////////////////

//

// Text register usage:

// Registers 10 - 19 are offset by Num_Reg(65) for running under WILDFILE.

//

// Note: cannot push COBOL preprocessing text register.

//	 This register is loaded at startup before text registers are pushed.

//	 This is partly due to the comment stripping processor and partly

//	 due to WILDFILE interaction.

//

//	 2		table of "raw" binary sizes

//	 3		DBASE preprocessing: record name

//	 4              table of "cooked" binary sizes

//	 5		Temporary layout output pathname for editing purposes

//	 6		Temporary data output pathame for editing purposes

//	 7		Full path to output subdirectory

//	 8		Full pathname of .xrf file (DBASE only)

//	 9		.lay input pathname.

//	10		Data output pathname.

//	11		Used to execute Vedit commands ('v=') from EBCDIC.LAY

//			Used initially in constructing output filenames

//	12		Default T-Reg for custom decoding ('c').

//	13		Default T-Reg for custom record determination ('tc').

//	14		Optional post-processing macro ('x=')

//	15		Source data file's full pathname.

//			"NEXT_PEER_CLAUSE" sub-macro (COBOL preprocessing).

//	16		Explicit decimal point handling.

//			OCCURS clause sub-macro (COBOL preprocessing).

//	17		Optional delimiter string output after each field.

//			REDEFINES clause commenting-out (COBOL preprocessing).

//	18		Holds (path)name of error file.  None when empty.

//	19		Main COBOL preprocessing macro. Must not be pushed!

//	46 - 54		Submacros

//	55 - 56		Reserved for COBOL preprocessing.

//	57 - 63		Submacros

//	'A' - 'Z'	Code to process each data type (T-Regs 65 - 90).

//	101		Data error processing. Comment stripping, initially.

//	102		Unexpected error breakout trapping macro.

//

//////////////////////////////////////////////////////////////////////////////

//									    //

//			Execution starts here.				    //

//									    //

//////////////////////////////////////////////////////////////////////////////

//

//	Speed optimize the EBCDIC-2 macro itself.

//

if (File_Exist(VEDIT_TEMP)==0) {	//Create vedit/temp dir if needed

    File_Mkdir(VEDIT_TEMP)

}

if (#99==0x57495C44&&#91){goto noprep}	// No prep for 2nd and later WILDFILE pass

Reg_Prep()				// Can't be nested when self-prepping

:NOPREP:

//

//	Initialize optional delimiter(s) to be output after each field.

//	Overriden by any "v=rs(XDREG,'delimiter string')" in the layout file.

//

#103 = Macro_Num			// #103 = T-Reg # this macro is in

if (#99==0x57495C44) {			// When WILDFILE is running...

    if (!#91){				// Set == 0 by Wildfile

	#65 = Reg_Free			// #65 = 1st available T-Reg

	#69 = 0				// 1st time in

    }

} else {

    #65 = #69 = 0			// For backwards compatibility

}

#91++					// Update Wildfile pass counter



if (!#69){				// 1st time in

    //

    // Check version #.

    //

    #0 = 520

    if (Version_Num<#0) {

	Reg_Set(1,"EBCDIC translation package requires VEDIT PLUS version ")

	#1 = #0/100

	#2 = Remainder

	ITOA(#1,1,LEFT+NOCR+APPEND)

	Reg_Set(1,".",APPEND)

	ITOA(#2,1,LEFT+NOCR+APPEND)

	Reg_Set(1," or later.",APPEND)

	Alert()

	Dialog_Input_1(0,`"Error","|@(1)"`)

	if (Is_Quiet) {

	    XALL(1)

	} else {

	    Reg_Empty(0)

	    Reg_Empty(1)

	    Break_Out(EXTRA)

	}

    }

    //

    //	Load T-Reg[19] with COBOL preprocessor and speed optimize the code.

    //

    Reg_Empty(#65+19)			// In case COBOL2V can't be found

    Reg_Load(#65+19,"COBOL2V.VDM",EXTRA+NOERR)

    Reg_Prep(#65+19)



    //

    //	Use T-Reg[1] to load and speed optimize submacros.

    //	Then distribute the code to their proper T-Regs.

    //

    Reg_Set(1,$

//////////////////////////////////////////////////////////////////////////

//									//

//	Submacros for EBCDIC-2.VDM					//

//	Last change: 07/24/2003						//

//									//

//	Note: most named submacros are now contained in EBCDIC-2.VCM	//

//	      for use by custom macros. They are reserved for this	//

//	      purpose. These are: a-f, h, i, s, u, x & z.		//

//									//

//	Note: Named submacros 'a' - 'z' are actually stored into	//

//	      T-Reg['A'] - T-Reg['Z']. To invoke a given named macro,   //

//	      convert its name to upper case; e.g., call('r'-32).	//

//									//

//////////////////////////////////////////////////////////////////////////



//

//		T-Reg[l] - Floating Point.

//

Reg_Set(l,`

//

//	"NULL" for undefined?

//	Go figure!

//

if ((match("|{|HD5|HE4|HD3|HD3,|H80|H00|H00|H00}")==0)||CC==0){

    #7 = 0

    #9 = EBC_Settings(Field_Size)

    if (XFSIZ>4){	// DOUBLE

       if (#9==0){

	    #7 = 16

	}

    } else {		// FLOAT

	if (#9==0){

	    #7 = 7

	}

    }

    if (#9==0){

	#9=#7

    }

    if (EBC_Settings(Out_Point) & 0xff){

	#9++

    }

    if (!EBC_Settings(Unsigned)){

	#9++

    }

    DC(XFSIZ)

    IC(' ',COUNT,#9)

}else{

    #1=upf('l',XFSIZ)

    if (#1) {if (#38){call(101,"DATERR")}}

}

`) // [l]



//

//		T-Reg[48] - Unique ID Processing.

//

Reg_Set(48,`

//

// UID - Generate unique ID at end of fixed portion of variable length record.

//	 Similar to 'rb' & 're' processing, above.

//	 Enter: #40 = # digits to display segment count of unique ID.

//		#50 = # digits to display elapsed days count of unique ID.

//	        #62 = # digits to display record count of unique ID.

//		#41 = data segment/section/run #.

//		#55 = days elapsed since base date.

//		XRecNum = record #.

//		#61 = additional offset when more than 1 run per day.

//

:UID:

if (XQCD){			// If Quoting & comma delimiting...

    IT(',"')			// Output comma and quote mark

    NI(#55,SIMPLE+FILL+COUNT,#50)	// Output JDate

    if (#40>0){

	NI(#41,SIMPLE+FILL+COUNT,#40)	// Output the segment #

    }

    NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #

    IC('"')			// Output quote mark

} else {			// Else...

    IC(' ')			// Space for separation

    NI(#55,SIMPLE+FILL+COUNT,#50)	// Output JDate

    if (#40>0){

	NI(#41,SIMPLE+FILL+COUNT,#40)	// Output the segment #

    }

    NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #

}



`) // [48]



//

//		T-Reg[49] - DBASE preprocessing.

//

Reg_Set(49,`

//

// DBINIT0 - Zero-out DBASE header's 1st 32-byte structure; insert '3' for

//	     signature and current date in YMD (binary) format where

//	     'y' = year -1900.

//	     Initialize record length (pos 10,11) = 1 for the initial blank

//	     column, the deleted-record field.

//	     Set 0x0d byte at end of header.

//

//	Enter:  #16 = ID of extraction buffer

//		#28 > 0 (DBASE flag)

//

:DBINIT0:

    Num_Push(0,5)

    Buf_Switch(#16)		// DBASE output file

    Del_Block(0,FileSize)

    //

    // Zero-out initial header structure.

    // Set 0x0d byte at end.

    //

    Ins_Char(0,COUNT,32)

    Ins_Char(0x0d)		// End of header byte

    Config(F_REC_HEAD,FSize,LOCAL)

    //

    // Set record-length to 1 to account for initial "deleted-record" field.

    //

    GP(10)

    Ins_Char(1,OVERWRITE)

    //

    // Set #1,#2,#3 = current date = MDY.

    //

    Buf_Switch(Buf_Free(EXTRA))

    OI() DATE(NOMSG) OI(CLEAR)

    BOF()

    #1=NumEval(ADVANCE+SUPPRESS)

    c(1)

    #2=NumEval(ADVANCE+SUPPRESS)

    c(1)

    #3=NumEval()

    Buf_Quit(OK)

    //

    // Enter DBASE signature and current date as YMD (binary).

    //

    Buf_Switch(#16)

    BOF()

    Ins_Char(3,OVERWRITE)

    Ins_Char(#3-1900,OVERWRITE)

    Ins_Char(#1,OVERWRITE)

    Ins_Char(#2,OVERWRITE)

    //

    Buf_Switch(XLay)

    Num_Pop(0,5)

    return

    

`) // [49]



//

//		T-Reg[50] - Output diversion.

//

Reg_Set(50,`

//

// POST - Diversion termination.

//	  Enter: Buf_Num = XLayBufNum.

//	  Retrn: Buf_Num = XLayBufNum.

//

:POST:

    BS(XData)

    if (#42){				// If Unique ID wanted...

    if (XQCD){				// If Quoting & comma delimiting...

	IT(',"')			// Output comma and opening quote

	NI(#55,SIMPLE+FILL+COUNT,#50)	// Output JDate

	if (#40>0){

	    NI(#41,SIMPLE+FILL+COUNT,#40)	// Output the segment #

	}

	NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62)	// Output the record #

	IT('"')			// Output closing quote

    } else {			// Else...

	IC(' ')			// Space for separation

	NI(#55,SIMPLE+FILL+COUNT,#50)	// Output JDate

	if (#40>0){

	    NI(#41,SIMPLE+FILL+COUNT,#40)	// Output the segment #

	}

	NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62)	// Output the record #

    }

    }

    //

    // Move translated input fields into output file.

    //

    RCB(0,0,CP,DELETE)

    BS(#77)

    EOF()

    if (RSIZE(0)>0){

	if (#28&&AtBOL){

	    ic(' ')

//	    XLCP(XLCP+1)	May need to update when appending allowed...

	}

        RI(0)

    }

    //

    // Append newline char(s), if specified.

    //

    if ((0<=#68)&&(#68<6)){

	if ((#68&1)==0){IC(0x0d)}	// DOS and MAC

	if (#68<2){IC(0x0a)}		// DOS and UNIX

    }

    //

    BS(XLay)

    return



//

// PRE - Diversion initialization.

//	 Any passed over bytes translated.

//	 All processed bytes moved into the output buffer.

//	 Enter: Buf_Num = layout buffer XLayBufNum.

//	 Retrn: Buf_Num = layout buffer XLayBufNum.

//

:PRE:

    //

    // Set XNextCol = XAdjBeg = column # of 1st field adjusted for inflation

    // (The 1st column must be specified by next layout line).

    // Do default processing on any passed-over fields.

    //

    SPOS()

    s("|<|Y|w",advance)		//Pick up start of first field from next layout line

    XAB(NE()+XSO+XI)		//XAdjBeg = beginning column # (inflation adjusted)

    RPOS()			//Back to "rb" line

    call(57)			//Translate any passed-over fields

				//XNextCol = 1st column #, inflation adjusted

    //

    // Move translated bytes into output buffer via T-Reg[0].

    //

    RCB(0,0,CP,DELETE)		//Move bytes into T-Reg[0]

    BS(#77)			//Switch to output buffer

    EOF()

    //

    // Include any .nam header file, if so specified.

    //

    if (#43&&AtBOF){

	Ins_File("|(FILE_ONLY).nam")

    }

    if (RSIZE(0)>0){

	if (#28&&AtBOL){

	    ic(' ')

	    XLCP(XLCP+1)	// Note: XLCP already reflects the processed output length

	}

	RI(0)			//Insert the bytes

    }

    //

    BS(XLay)			//Reenter layout buffer

    return



`) // [50]



//

//		T-Reg[53] - Name Pre-Processor (error checking).

//			    Name may be quoted or not; quotes stripped.

//			    Return: T-Reg[0] = name

//				    Cur_Pos past name["].

//

Reg_Set(53,`

    if (cc!='''&&cc!='"'){

	Set_Marker(8,Cur_Pos)

	sb("|{|b,//,|>}",cp,eolpos+1)

	Set_Marker(9,Cur_Pos)

    } else {

	rcb(0,cp,cp+1,norestore)

	Set_Marker(8,Cur_Pos)

	if(!sb(@0,cp,eolpos,advance+noerr)){

	    goto BADLAY

	}

	Set_Marker(9,Cur_Pos-1)

    }

    rcb(0,Marker(8),Marker(9))

    return

//

:BADLAY:

chain(#103,"BAD_LAY")

`) // [53]



//

//		T-Reg[54] - Name Processor.

//			    Name may be quoted or not; quotes stripped.

//			    Return: T-Reg[0] = name

//				    Cur_Pos past name["].

//				

//

Reg_Set(54,`

    if (cc!='''&&cc!='"'){

	SM(8,CP)

	sb("|{|b,//,|>}",cp,eolpos+1)

	SM(9,CP)

    }else{

	rcb(0,cp,cp+1,norestore)

	SM(8,Cur_Pos)

	sb(@0,cp,eolpos,advance)

	SM(9,CP-1)

    }

    RCB(0,Marker(8),Marker(9))

`) // [54]



//////////////////////////////////////////////////////////

//							//

//		T-Reg[55] & T-Reg[56]			//

//		Reserved for COBOL2V.VDM		//

//							//

//////////////////////////////////////////////////////////



//

//		T-Reg[57] - Perform default translation on passed-over fields.

//

Reg_Set(57,`

    BS(XData)

    if ((#0=XAB-XNC)>0){

	XDC(XDC+#0)			// Update total-bytes-processed counter

	XLCP(XLCP+#0)

	if (XDefType=='e'){

	    TRB(CP,CP+#0,REVERSE+NORESTORE)

	}else{if (XDefType=='a'){

	    TRB(CP,CP+#0,NORESTORE)

	}else{

	    C(#0)

	}}

    XNC(XAB)

    }

`) // [57]



//

//		T-Reg[58] - Extraction Filename Processor.

//

// Enter: Buf_Num = XLayBufNum.

// Retrn: #77 = output buffer ID.

//	  #54 |= 1 (flag to output unique # at end of main output record).

//	  Buf_Num = XLayBufNum.

//

// Note: to force UID's on main records that have no extracted subsections,

//	 use uid=on option in the .lay file or as a "-u" invocation parameter.

//

Reg_Set(58,`

    call(54)			// T-Reg[0] = name

    bs(#75)			// Switch to main buffer so that we can

				// use e.g. tx "|(FILEONLY).as1"

    FO("|@(0)",NOMSG+NOEVENT)

    #77=BN			// #77 = output buffer

    #54 = #54 | 1

    XLCP(0)

    BS(XLay)

`) // [58]



//

//		T-Reg[59] - Extraction Filename Preprocessor.

//

// Processes 'code "filename"[,R]' where 'R' is a one or two letter

//				   record name for DBASE output.

//	Deletes any existing file.

//	Opens an empty file.

//

//	For DBASE, generates 1st header row and sets T-Reg[3] <== 'R', if

//	specified.

//

//      Enter: #28 = DBASE flag.

//	Retrn: #16 = buffer ID of extraction file.

//	       #27++ DBASE output record counter.

//	       [3] = #28 && 'R' present ? upto 1st 2 letters of "R" : [3]

//

// Called when preprocessing 'out'.

//

Reg_Set(59,`

    call(53)			// T-Reg[0] = filename

    //

    //

    //

    if (#28) {			// If DBASE...

	if ( match("|[|w],|[|w]",ADVANCE)==0) {

	    if (match("|a|[|a]")==0){

		RegCopyBlock(3,cp,cp+cmat,norestore)

	    }

	}

    }

    //

    #27++

    if (Buf_Free()>0){

	bs(#75)					// Switch to main buffer so that we can

						// use e.g. tx "|(FILEONLY).as1"

	File_Delete(@0,OK+NOERR)

	FO("|@(0)",OVERWRITE+NOMSG+NOERR+NOEVENT)

	#16 = Buf_Num

	if (#68<6) {

	    Config(F_F_TYPE,#68,LOCAL)

	} else {

	    if (#28) {	// If DBASE...

		Config(F_F_TYPE,32,LOCAL)	// Header consists of 32-byte structures

	    } else {	// else...

		Config(F_F_TYPE,64,LOCAL)	// For now...

	    }

	}

    } else {

	goto TOOMANY

    }

    //

    //	For DBASE, initialize 1st 32-byte header structure; append terminating <cr>.

    //

    if (#28) { call(49) }	// DBINIT0()

    //

    Buf_Switch(XLay)

    return



:TOOMANY:

chain(#103,"TOO_MANY")



:BADLAY:

chain(#103,"BAD_LAY")



`) // [59]



//

//		T-Reg[62] - Progress Display.

//

// First time, display estimated processing time.

// Also display persistent "Converted records: "

// Every time, display count and percentage of records processed.

//

Reg_Set(62,`

if (XRecNum==#31){call(63)}

WH(#33)

NT(XRecNum,NOCR)			// count

#37=FSize-CP

if (#37>1000000){#34=100-(#37/(#36/100))}

else{if (#36==0){#34=100}

else{#34=100-((100*#37)/#36)}

}

Message(" (")

NT(#34,LEFT+NOCR)			// percentage

Message("%)")

`) // [62] Progress Display



//

//		T-Reg[63] - Progress Display (Initial Message).

//

// Display estimated processing time.

// Also display persistent "Converted records: "

// Empties itself on exit.

//

Reg_Set(63,`

#35=TT

WH(1)

Message("Estimated processing time is ")

#34=((#35-#32)*((#36/(#36-FSize+CP)))+500)/1000

NT(#34,LEFT+NOCR)

Message(" seconds\n")

Message("Converted records: ")

#33=WH

RE(MN,EXTRA)

`) // [63] Progress Display (Initial Message)



/////////////  [65] - [90] correspond to [A] - [Z], so DO NOT USE  ////////////



//

//		T-Reg[101] - Process invalid data error messages.

//

//

// DATERR - Report errors decompressing packed data, if enabled.

//	    On first error, report name of file being translated,

//	    the name of the edited layout file and a short description

//	    of a report line:

//		XRecNum (data record #)

//		.TMP layout line #

//		the layout line itself

//		position in the input file at which the data field began

//		the source bytes themselves (in hex format).

//	    Upto #38 errors (default 1000) will be reported.

//

//	    Enter: T-Reg[103] = source bytes.

//

Reg_Set(101,`

:DATERR:

if (RSize(#65+18) && #38){	// If error reporting enabled...

    num_push(1,10)

    #1 = bn			// Store current edit buffer id

    //

    // Set T-Reg[0] = offended layout line.

    //

    bs(XLay)			// Switch to the edited layout file

    char(-newline_chars)

    rc(0,0)			// Copy the line into T-Reg[0]

    #2 = Cur_Line		// Get its line #

    line(1)

    //

    //	Set T-Reg[1] = pathname of edited layout file layout.tmp

    //

    or(1)			// Begin diversion into T-Reg[1]

    nw(EXTRA+NOMSG)		// Get full pathname of the edited layout file

    or(CLEAR)			// Turn diversion off

    //

    // On first error, report general information.

    //

    File_Open("|@(#65+18)",OVERWRITE+NOERR+NOMSG) // Switch to the error file

    if ( File_Size == 0 ) {

	//

	// Output name of source data file.

	//

	Ins_Text("***** Invalid compressed data item(s) in ")

	Reg_Ins(#65+15)

	Ins_Newline(2)

	//

	// Describe error report line.

	//

	Ins_Text("line     = layout line number from edited file ")

	ri(1); re(1)

	Ins_Text("record   = source record number");in

	Ins_Text("location = source file position of start of invalid data item (from 0)");in

	in(2)

	Ins_Text("    line    data descriptor    record    location    data item (hex)");in

	Ins_Text("    ====    ===============    ======    ========    ===============");in

    }

    //

    // Report the edited layout line #.

    //

    Ins_Text("   ")

    ni(#2,NOCR)			// edited layout line #

    //

    // Include the edited layout line.

    //

    Ins_Text("    ")

    ri(0)			// The edited layout line

    //

    // Report the data record #.

    //

    Ins_Char(' ', COUNT, BOL_Pos + 27 - Cur_Pos )

    Del_Block(BOL_Pos+27,cp)

    ni(XRecNum,FORCE+NOCR)		// data record #

    //

    // Report the field's starting location in the source file (from 0).

    //

    bs(XData)			// Switch to the data source file

    #3 = #36 - (File_Size - Cur_Pos) - XFSIZ

    File_Open("|@(#65+18)",NOMSG)	// Switch back to the error file

    Ins_Text("  ")

    ni(#3,FORCE+NOCR)		// The field's starting position

    //

    // Display the source field in hex.

    //

    Ins_Text("    ")

    Out_Ins()

    Reg_Type(103,0x800)		// Display in hex format

    Out_Ins(CLEAR)

    Ins_Newline(1)

    //

    // Finish up and return.

    //

    #38--

    bs(#1)

    num_pop(1,10)

}

return

`) // [101,DATERR]



//

//		T-Reg[102] - Unexpected error breakout trap.

//			     Writes message into error file.

//			     Restores some original config values.

//			     Terminates.

//

Reg_Set(102,`

Reg_Lock_Macro(CLEAR)				// Disable further error trapping

Reg_Empty(0)

File_Open("|@(#65+18)",OVERWRITE+NOERR+NOMSG)	// Access error file

EOF

#0 = Cur_Pos

Ins_Newline()

Ins_Text("***** Unexpected breakout occurred.")

Ins_Newline()

#1 = Cur_Pos

Reg_Ins(120)

Reg_Copy_Block(0,#0,#1)

Reg_Push(0,0)

Call(#103,"CleanUp")

Call(#103,"CloseErr")

Reg_Pop(0,0)

Num_Pop(70,99)				//Restore numeric regs

Num_Pop(0,59)

Config(U_AUTO_CFG,#0)			//Restore user's config values

Config(F_AUTO_SAVE,#1)

Config(F_OVER_MODE,#2)

// no Config(F_F_TYPE,#3)

// no Config(F_REC_HEAD,#4)

Config(E_EXP_TAB,#5)

Config(E_RETAB_BK,#6)

Config(E_RETAB_FILL,#7&0xff)

Config(S_E_MORE,#8)

Config(D_DSP_WRAP,#9)

Num_Pop(0,10)				//Restore remaining user numregs

Reg_Lock_Macro(#66)

#69 = 1					//WILDFILE flag for next time in

if (Is_Quiet  || Is_Option(y)){

    XALL(1)

} else {

    if (Reg_Size(0)){

	Reg_Type(0)

    }

    if (#105){

	vm(SET)

    }

}

`) // [102]  Unexpected Error Breakout

$) // [1] - Submacros

    Reg_Prep(1)

    Call(1)

    Reg_Empty(1)



} // 1st time in



:START:

Num_Push(0,10)

#0 = Config(U_AUTO_CFG,0)	// Turn off auto-save-config

#1 = Config(F_AUTO_SAVE,0)	// Turn off auto-save-changes every x minutes

#2 = Config(F_OVER_MODE,0)	// Allow insert/delete even for fixed-records

#3 = Config(F_F_TYPE)

#4 = Config(F_REC_HEAD)

#5 = Config(E_EXP_TAB)		// Tabs complicate COBOL processing

#6 = Config(E_RETAB_BK)

#7 = Config(E_RETAB_FILL)

#8 = Config(S_E_MORE,0)

#9 = Config(D_DSP_WRAP,0)

#66 = Reg_Lock_Macro		// Save WILDFILE's locked-in-macro ID

Num_Push(0,59)			// Save numeric regs used herein

Num_Push(70,99)			// Except for #60-#69



//

//	Default delimiter between output fields (none, normally)

//

XDREG(#65+17)			// Register to hold user defined output field delimiter

Reg_Set(XDREG,'')		// To define, use "v=Reg_Set(XDREG,'delimiter_string')"

//Reg_Set(XDREG," | ")		// Or uncomment one of these lines

//Reg_Set(XDREG,'^')		// Any string is permissible



//

#8 = 0				//No customizing record determining submacro

#26 = #27 = #28 = 0		//Reset DBASE field & record counters & flag

#76 = 0				//For calculating approx. line size



#105 = vm; vm(CLEAR)

Reg_Lock_Macro(102)



/////////////////////////////////////////////////////////////////////////////

//

// Sign-on and File Handling.

//

//	Set #90 = source data file's buffer ID unless "-N2" was present on the

//		  command line; in which case, the current buffer is assumed to

//		  be the layout file (no other file is processed). Normally, the

//		  current edit buffer is considered to be the source data file.

//		  It will be closed and reopened for reading in another buffer

//		  and the initial buffer will be used as the standard output

//		  buffer.

//

//	Set #92 = buffer ID of/for the data layout file.

//		  Presume any file in buffer[2] is the data layout file if

//		  this macro is being run from the command line: e.g.,

//			    vpw -x ebcdic-2 dname.ebc lname.lay

//

//	Set #75 = buffer number for translated output; referred to herein as

//		  the standard output buffer.

//

//	     #1   used herein as a flag to prevent final renaming of the data

//		  output file to ".dbf" as determined by the layout file

//	          "r=n,DBASE-III". This flag is set below when processing "-a".

//

//	To initiate data conversion manually, the layout file must be named

//	EBCDIC.LAY and exist in the current or VEDIT HOME directory.

//	In which case, after loading the data file, the user can initiate

//	processing via {Misc,Load/Execute macro,EBCDIC-2.VDM}.

//

//	Likewise, the layout file must be named EBCDIC.LAY to run under

//	WILDFILE.VDM.

//

//	To initiate just COBOL preprocessing manually, VEDIT must be started

//	with the "-N2" option. Then, after loading the layout file, processing

//	can be initiated as in the above paragraph. Or, run COBOL2V.VDM.

//

//	E.g., vpw -n2 lname.lay

//	      {Misc,Load/Execute macro,EBCDIC-2.VDM}

//

//

#90 = #75 = Buf_Num		//#90 = current buffer #

#92 = 0				//#92 = layout buffer ID; not yet set

#64 = 0				//Set = 1 to always use fname.LAY

				//instead of EBCDIC.LAY when no explicit

				//filename parameter "lname"

//

// For autoexecution (-x), presume anything in buffer #2 is the layout file.

//

// if (      -x        &&    !Wildfile    &&   2nd buffer       )

if ( Is_Auto_Execution && #99!=0x57495C44 && Buf_Status(2) >= 0 ) {

    #92 = 2			// #92 = data layout buffer

    #64 = #64 | 0x40		// Flag data description file already loaded

//

// Else, if "-N2", presume the current buffer has/will have the layout file.

//

} else { if (Is_Option(n) && (N_Option&2)) {

    #92 = Buf_Num		// #92 = data layout buffer

    if ( Is_Open_Write ) {

	#64 = #64 | 0x40	// Flag data description file already loaded

    }

}}

if (Is_Option(n)) {

    #0 = #64 & 0x40		//Save "explicit data layout file" bit

    if (N_Option == 0) { #64 = 1 } // Handle "-N" with no parameter

    #64 = #64 | (N_Option & 0xfffff) | #0

}



//

//	Sign on.

//

if (#69==0) { if (!Is_Quiet) {

    if ( OS_Type == 1 && ( Screen_Lines < 15  || Screen_Cols < 57 )) {

	Screen_Size(15,57)

	Screen_Init()

    } else {

	Win_Clear()

    }

    Type_Newline()

    #0 = ( Screen_Cols - 57 ) >> 1

    Type_Space(#0)

Message('*********************************************************\n');TS(#0)

Message('*                EBCDIC-2.VDM   09/26/2003              *\n');TS(#0)

Message('*    Convert EBCDIC file with encoded fields to ASCII   *\n');TS(#0)

Message('*********************************************************\n');TN()

    //

    // If no file open, prompt for filename and open it.

    //

    if (#64&2) {		// If just COBOL preprocessing...

	Reg_Set(0,"data layout file")

    } else {			// Normally...

	Reg_Set(0,"file to convert")

    }

    if (!Is_Open_Write) {

	repeat(ALL) {

	    Reg_Set(0,"Enter name of ",INSERT)

	    Reg_Set(0,": ",APPEND)

	    Type_Newline()

	    Reg_Type(0)

	    Get_Input(#65+10,"",NOCR)

	    if (File_Exist(@(#65+10))) { Break }

	    Alert()

	    Message("\nFile not found; please try again or <Ctrl-C> to cancel.\n")

	}

	File_Open("|@(#65+10)",NOEVENT)

	#90 = Buf_Num

	if (#64&2) {

	    #92 = Buf_Num

	    #64 = #64 | 0x40

	}

    }

}}



// if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?



if ( File_Size == 0 ){

    goto DONE

}

//

//	Set Current Directory to source data file.

//

Reg_Push(0,0)

Reg_Set(0,INPUT_FILE)

Buf_Switch(Buf_Free(EXTRA))

Reg_Ins(0)

EOF()

Replace("|{\,:}","",REVERSE)

if(Match_Item==2){

    Ins_Text(":\")

}

Del_Line()

Reg_Copy(1,0)

ChDir(@(1))

Buf_Quit(OK)

Buf_Switch(#90)



//

// Set T-Reg[10] = data output pathname.

//		 = path\fname.asc (normally)

//		 = user specified (-a)

//

// Set #1 if "-a" input parameter.

//

#1 = 0			// Allow renaming output file to *.dbf

if ( Is_SaveAs ) {

    #1 = 1		// Disallow changing output file's extension

    Reg_Set(#65+10,PATH_NAME)		//T-Reg[10] = user-specified output pathname

} else {

    Reg_Set(#65+10,PATH_ONLY)		//	    = path

    Reg_Set(#65+10,"\",APPEND)

    Reg_Set(#65+10,FILE_ONLY,APPEND)	//	    = path\fname

    Reg_Set(#65+10,".ASC",APPEND)	//	    = path\fname.ASC

}



//

// Set T-Reg[7] = output_path\.

//

#0 = Buf_Num

Buf_Switch(Buf_Free(EXTRA))

Reg_Ins(#65+10)				//buf[] = full_path_name (output)

Search("\",BEGIN+ALL+ADVANCE+NOERR)	//Skip over pathname

Reg_Copy(7,0)				//T-Reg[7] = output_path\

Buf_Quit(OK)

Buf_Switch(#0)



//

// Delete default error file from the output directory.

// Set T-Reg[18] with its full pathname.

//

Reg_Set(#65+18,@(7))

Reg_Set(#65+18,`ebcdic.err`,APPEND)

File_Delete( @(#65+18), OK + NOERR )



//

// Check for missing/empty data file.

//

if (! Is_Open_Write || FSize == 0 ) {

    Reg_Empty(1)

    Out_Reg(1,APPEND)

    Message("\n***** Misssing or empty data file ")

    Reg_Type(0)

    Message("\n")

    Out_Reg(CLEAR)

    Call("ERRMSG")

    if (Is_Quiet) {

	XALL(1)

    } else { if (#99==0x57495C44) {

	break_out

    } else {

	break_out(EXTRA)

    }}

}



//

// Set T-Reg[15] = source_data_pathname.

//

Out_Reg(#65+15)

Name_Read(EXTRA+NOMSG+NOCR)

Out_Reg(CLEAR)



//

// Close the source data file.

// Open an empty output buffer with the specified data output filename.

// Set #75 = main output buffer ID.

//

Buf_Empty(OK)

File_Open_Write(@(#65+10),OVERWRITE+OK+NOMSG)

#75 = Buf_Num

//

// Set T-Reg[6] = temporary output pathname to allow editing the

//		  source data file = outputpath\EBCDAT.TMP.

//

Reg_Set(0,@7)				//T-Reg[0] = outputpath\

Reg_Set(0,"EBCDAT",APPEND)		//T-Reg[0] = outputpath\EBCDAT

Reg_Set(6,@0)				//T-Reg[6] =

for ( #0=0; FileExist("|@(6).TMP",NOERR); #0++ ) {

    Reg_Set(6,@0)			// T-Reg[6] = outputpath\EBCDAT

    Out_Reg(6,APPEND)			// Divert output to end of T-Reg[6]

    Type_Char((#0/10)+'0')

    Type_Char(remainder+'0')

    Out_Reg(CLEAR)			// Stop diverting output

}

Reg_Set(6,".TMP",APPEND)		// T-Reg[6] = outputpath\EBCDAT[nn].TMP

//

// Reopen the source data file with temporary output pathname T-Reg[6].

// Set #90 = buffer ID.

//

File_Open('"|@(#65+15)" -a "|@(6)"',OVERWRITE+OK+NOMSG)

#90 = Buf_Num

Config(F_OVER_MODE,0,ALL)

//

// Set T-Reg[9] = "source_data_path\fname.LAY".

// Set T-Reg[11] = "fname.LAY".

//

Buf_Switch(Buf_Free(EXTRA))		//Switch to temp buffer

Reg_Ins(#65+15)				//buf[] = source_data_full_pathname

Replace(".|M|>","",REVERSE+NOERR)	//Delete any existing extent

Ins_Text(".LAY",BEGIN)			//Append ".LAY"

Reg_Copy_Block(9,0,File_Size)		//T-Reg[9] = "path\fname.LAY"

//

Search("\",BEGIN+ALL+ADVANCE+NOERR)	//Skip over pathname

Reg_Copy_Block(#65+11,CP,EOL_Pos)	//T-Reg[11] = "fname.LAY"

//

Buf_Quit(OK)				//Discard temporary buffer

//

// Open data layout file with temporary name for editing.

//	Unless already loaded, determine name: EBCDIC.LAY or fname.LAY;

//	then load it from the current directory if possible;

//	else from the VEDIT Home Directory;

//	quit if no such file.

//	Enter: T-Reg[9]  = "source_data_path\fname.LAY".

//	       T-Reg[11] = "fname.LAY".

//

if (#92>0) {

    Buf_Switch(#92)			//Switch to data layout buffer

}

if (#64&0x40) {				// If explicit data layout file

    Reg_Set(9,INPUT_FILE)		// Full pathname for error handling

    Out_Reg(#65+11)

    Name_Read(NOMSG)			// Filename only (for consistency)

    Out_Reg(CLEAR)

} else {				// No explicit layout file

    if (!(#64&1)) {			// If !( -N 1 ) i.e., not fname.lay

	Reg_Set(9,"ebcdic.lay")		// full pathname (current directory)

	Reg_Set(#65+11,"ebcdic.lay")	// for VEDIT home directory

    }

    Reg_Set(0,"UNPAKEBC.DAT")		// Archaic name

    if (File_Exist(@(9))) {		//If local layout file, load it

	File_Open("|@(9)",OVERWRITE+OK+NOMSG) // but do not create backup file

    } else { if (File_Exist(@(0))) {	//If local UNPAKEBC.DAT, load it

	File_Open("|@(0)",OVERWRITE+OK+NOMSG)

    } else { if (File_Exist("|(HOME)\|@(#65+11)")) {

	File_Open("|(HOME)\|@(#65+11)",OVERWRITE+OK+NOMSG)

    } else { if (File_Exist("|(HOME)\|@(0)")) {

	File_Open("|(HOME)\|@(0)",OVERWRITE+OK+NOMSG)

    } else {

	Reg_Empty(1)

	Out_Reg(1,APPEND)

	if (Is_Quiet) {

	    Message("\n***** No data layout file.")

	}

	Message(`\nCannot find `); Reg_Type(9)

	Message(` in current nor VEDIT's "home" directory.`)

	Message(`\nRefer to EBCDIC-2.TXT for details.\n`)

	Out_Reg(CLEAR)

	Call("ERRMSG")

	if (Is_Quiet) {

	    XALL(1)

	} else {

	    Type_Newline(1)

	    Buf_Quit(OK)

	    Buf_Switch(#90)

	    GetKey("Press any key to view data file...")

	    Call("CloseErr")

	    Break_Out(EXTRA)

	}

    }}}}

}



//

// Close and reopen the layout file for editing as LAYOUTnn.TMP

// Where nn is a number that, if present, creates a unique name.

// Set T-Reg[5] = temporary layout pathname.

//

Reg_Set(9,INPUT_FILE)			// For BADLAY

Reg_Set(0,@7)				//T-Reg[0] = outputpath\

Reg_Set(0,"LAYOUT",APPEND)		//T-Reg[0] = outputpath\EBCDAT

Reg_Set(5,@0)				//T-Reg[5] =

for ( #0=0; FileExist("|@(5).TMP",NOERR); #0++ ) {

    Reg_Set(5,@0)			// T-Reg[5] = outputpath\LAYOUT

    Out_Reg(5,APPEND)			// Divert output to end of T-Reg[5]

    Type_Char((#0/10)+'0')

    Type_Char(remainder+'0')

    Out_Reg(CLEAR)			// Stop diverting output

}

Reg_Set(5,".TMP",APPEND)		// T-Reg[5] = outputpath\LAYOUT[nn].TMP

Buf_Empty(OK)

File_Open('"|@(9)" -a "|@(5)"',OVERWRITE+OK+NOMSG)

#92 = Buf_Num



//

// Set T-Reg[8] = Cross Reference filename, in case DBASE.

// Open the cross reference file in read only mode.

//

Reg_Set(0,INPUT_FILE)

Buf_Switch(Buf_Free(EXTRA))

Reg_Ins(0)

if (Search(".",BEGIN+ALL+NOERR+ADVANCE)){

    Del_Block(CurPos-1,EOB_Pos)

}

EOF()

Ins_Text(".xrf")

BOL()

rc(8,1)

Buf_Quit(OK)

Buf_Switch(#92)

if (File_Exist(@(8))) {

    File_Open("|@(8)",BROWSE|OK|NOMSG)

    Buf_Switch(#92)

}

//

//	Remove junk (0x1a, e.g.) at end of layout file.

//

End_Of_File(); bol; if ( match("|[|w]|k") == 0 ) { db(cp,eolpos) }

//

//	Ensure layout file is newline-terminated.

//

End_Of_File()

Ins_Newline(1)			//Ensure final newline

line(-10,NOERR)			//Back up a bit

r("|<|L","",ALL+NOERR)		//Strip empty lines

//

Config(E_EXP_TAB,1,LOCAL)	// Tabs complicate COBOL processing

Config(E_RETAB_BK,0,LOCAL)

Config(E_RETAB_FILL,0,LOCAL)

Detab_Block(0,File_Size)

BOF()

//

//	Rename data output file when not invoked with "-a"

//	to .dbf if DBASE.

//

if (#1==0) {			// When not "-a"

    //

    //	r=len,DBASE-III

    //

    if (s("^[\s\t]*r[\s\t]*=.*,[\s\t]*DB",REGEXP+NOERR)){

	Reg_Set(1,"dbf")

	Buf_Switch(#75)

	Reg_Set(0,FILE_ONLY)

	Buf_Quit(OK)

	Buf_Switch(#75)

	File_Open_Write('"|@(7)|@(0).|@(1)"',OVERWRITE+OK+NOMSG)

	#75 = Buf_Num		// Belts and suspenders

	Reg_Set(#65+10,PATH_NAME)

	Buf_Switch(#92)

    }

    BOF()

}



//////////////////////////////////////////////////////////////////////////

//									//

//		Preprocessing COBOL copybook statements			//

//									//

//////////////////////////////////////////////////////////////////////////



if (!Is_Quiet) {

    Message("Processing data description file... ")

}

#64 = #64 | 0x200	// Tell COBOL2V.VDM that it is a submacro

call(#65+19)		// COBOL preprocessing

if (#99!=0x57495C44) {	// When not running under WILDFILE...

    Reg_Empty(#65+19)	//    COBOL processor no longer needed

}

if ( #64 & 2 ) {	// Quit when just preprocessing COBOL

    goto DONE

}



//

//	Check for and process invocation "-u option_list" parameter.

//	Need to do it now, for COBOL2V and RELAY and initial pre-processing

//	settings. Need to do it again after preprocessing in case the .lay

//	file set some values, since the "-u" parameters should prevail.

//

#41 = 0				//Unique ID run_no

#42 = -1			//Unique ID flag

#43 = 0				//Flags that .nam files to be included at start of each output file

#44 = 1				//Output decimal points as specified by "vn" field options

#50 = JDate()			//#50 Run date; combined into #55 at end of preprocessing

#55 = JDate("1-1-2000")		//#55 is base date for unique extraction ID's

call("OPTIONZ")



//////////////////////////////////////////////////////////////////////////

//									//

//		Preprocessing our own data descriptions			//

//									//

//////////////////////////////////////////////////////////////////////////

//

//	Strip comments, leading whitespace and blank lines.

//

// if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?

Replace("|<|w","",BEGIN+ALL+NOERR)		//Remove leading whitespace

Replace("|<|[|W]//|Y|L","",BEGIN+ALL+NOERR)	//Strip comment lines

Replace("|[|W]//|Y|>","",BEGIN+ALL+NOERR)	//Strip inline comments

Replace("|<|L","",BEGIN+ALL+NOERR)		//Remove blank lines

Replace("^{[a-z]+[\s\t]+.*,[\s\t]*[0-9]+}[\s\t]+{[^\s\t].*}$","\1 \2",REGEXP+BEGIN+ALL+NOERR)

//

//	Prevent explicit decimal points from being generated, as directed.

//

call("DOPOINT")

//

//	Setup T-Regs[2,4] with binary output field sizes.

//

call("SETBREGS")

//

//	Strip any "i=inflation" parameter; this is for relay.vdm only.

//

bof

while (search("|<|[|w]|?|*|{:,|s|[|w]i|[nflation]|[|w]=}",noerr)){

    if (Match_Item!=1){

	Search("|[|w]i|[nflation]|[|w]=|[|w]")

	Del_Char(Chars_Matched)

	Num_Eval()

	Del_Char(Chars_Matched)

	if (Match("|[|w];|[|w]")==0){

	    Del_Char(Chars_Matched)

	}

	if (!AtEOL){

	    Ins_Char(' ')

	}

    } else {

	l(1,noerr)

    }

}

//

//	Set DBASE flag #23 if "r=len,DBASE".

//

if (s("^[\s\t]*r[\s\t]*=.*,[\s\t]*dbase",BEGIN+REGEXP+NOERR)){

    #28 = 1		// DBASE flag

}

//

//	Ascertain header & record size and optional output filetype code.

//	Set type explicitly for blank type fields.

//	Ensure codes are lower case.

//	Execute any Vedit ('v=') command lines.

//	Delete lines of type 'code letter=' after processing.

//

//	Delete lines specifying the default type (XDefType) (e,i) when possible.

//

//	Perform error checking; break out if bad input.

//	Convert to "cb,ce" format.

//	If the 'q' record has been specified (quote & comma delimit), it

//		must have been specified before any field specification;

//		and each field must be specified; (the start of each field_j

//		must = end of field_i + 1).

//

XNextCol(0)			//XNextCol = last column #

#3 = 0				//#3 = # fields current record

#4 = 0				//#4 = max fields/record

#17 = 0				//#17 counts 'out's

#18 = 0				//#18 flags that .VCM customization submacros have been loaded

#63 = 0				//#63 is DBASE .xrf Buffer ID or zero

#67 = #68 = #86 = -1		//Record types & header size not yet specified

#85 = 'd'			//#85 = last code encountered, initially BCD

#87 = #51 = #57 = #58 = #59 = #88 = 0 //Record sizes not yet specified

XDefType('e')			//Consider unspecified cols to be EBCDIC

#38 = 1000			//Max # data errors to report

//

//	Repeated Fields variables

//

#56 = #61 = #79 = 0		//#79 keeps from stripping default types ('rb')

				//#56 is record offset for multiple runs in one day

				//#61 is additional offset for unique ID calculation

#62 = (5<<16) | (1<<8) | 6	//#62 is # digits displayed for unique ID (3 parts)

XQCD(0)				//Not Quoting and comma delimiting, yet

XData(#90)			//Define data input buffer

XLay(#92)			//Define .LAY buffer

// if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?

Begin_Of_File()

while(!At_EOF) {

    //

    //	#

    //

    if (match("#")==0){			// Level-4, repeat count adjuster

	goto ENDR

    }



    //////////////////////////////////////////////////////

    //							//

    //			code= processing		//

    //							//

    //////////////////////////////////////////////////////

    if (cc(1)=='='||cc(2)=='=') {

    //

    //	p=

    //

    if (match("p=")==0) {goto MISSING}	// COBOL2V.VDM wasn't found

    //

    //	q=

    //

    if (match("q=")==0) {goto BAD_LAY}	// Unmatched bracket

    //

    //	h=

    //

    if (match("h=",advance)==0){	//If "h=" header specified

	#86=Num_Eval()			//#86 = header length

	goto DELLN			//Now delete this line

    }

    //

    //	r=n

    //

    if (match("r=",advance)==0) {	// If "r=" record types specified

	#57=#67=#68=Num_Eval(ADVANCE)	// #57 = default input record type or length

					// #67 = input record type {0,1,2,3,6}

	    				// #68 = default output record type

	if (#67>4) {

	    #87 = #67			// #87 = input record size

	    #68 = #67 = 6		// #67 = fixed length input records

					//	 assume fixed output records

	}

    //

    // r=n,x	where x={v,f=len,dbase}

    //

	if (match("|[|W],",advance)==0){

	    if (Match("|{f,v}",advance)==0) {

		#68 = 6			// #68 = 6 = fixed output records

		Match("|[|w]=",advance)

		#88 = Num_Eval()	// #88 = output record size

	    } else { if (Match("DBASE")==0) {

		#68 = 7			// #68 = 7 = DBASE file

		#88 = 512		// Actual size determined dynamically

		#16 = #75

		Buf_Switch(#16)

		Del_Block(0,File_Size)

		Config(F_F_TYPE,32,LOCAL) // Header consists of 32-byte structures

		#27 = #59 = 1		// # records and record types

		Reg_Set(3,'F')		// Short field name = "Fn", where n = field ordinal

		call(49)		// DBINIT0()

	    } else {

		#68 = Num_Eval()	// #68 = {0,1,2,3} = output record type

		if (#68 > 4) {

		    #88 = #68

		    #68 = 6

		}

	    }}

	}

	goto DELLN

    }

    //

    //	c=			// Column #

    //

    if ( match("c=",advance) == 0 ) {	//If "c=" column #

	XNextCol(Num_Eval() - 1)	//XNextCol = preceding field's ending col #

	goto DELLN			//Now delete this line

    }

    //

    //	a=			// Additional offset for unique ID calculation

    //

    if ( match("a=",advance) == 0 ) {	// if "a=" additional offset

	#61 = Num_Eval()

	goto DELLN

    }

    //

    //  b=			// base_date for unique Repeated Group extraction ID's

    //

    if ( match("b=",advance) == 0 ) {	// if "b=" base_date

	#55 = Num_Eval_Date()

	goto DELLN

    }

    //

    //  d=			// current_date for unique Repeated Group extraction ID's

    //

    if ( match("d=",advance) == 0 ) {	// if "d=" (run) date

	#50 = Num_Eval_Date()

	goto DELLN

    }

    //

    //  n=			// # digits displayed for each part of unique ID

    //

    if ( match("n=|[|w]",advance) == 0 ) {	// if "n=" l,m,n

	#0 = 5			// Days elapsed

	#1 = 6			// Record count

	#2 = 1			// Run # count

	//

	//	Days elapsed (default 5)

	//

	#5 = Num_Eval(ADVANCE)

	if (cmat>0){#0=#5}

	//

	//	Record count (default 6)

	//

	Match("|w",ADVANCE)

	if (!At_EOL){

	    Match("|s|[|w]",ADVANCE)

	    #5 = Num_Eval(ADVANCE)

	    if (cmat>0){#1=#5}

	    //

	    //	Run # (default 1)

	    //

	    Match("|w",ADVANCE)

	    if (!At_EOL){

		Match("|s|[|w]",ADVANCE)

		#5 = Num_Eval(ADVANCE)

		if (cmat>0&&#5>=0){#2=#5}

	    }

	}

	//

	#62 = (#0 << 16) | (#2 << 8) | #1

	goto DELLN

    }

    //

    //	e=			// Error file

    //

    if ( match("e=|[|w]",advance) == 0 ) { // "e="

	//

	//	Just "e=".

	//

	if ( At_EOL || (Match("//") == 0 )) { // Just "e=" turns feature off

	    FO("|@(#65+18)",OVERWRITE+NOEVENT)   // In case ever any early messages

	    if ( fsize ) {

		db(0,fsize)		// User doesn't want to know

		File_Close(NOMSG+NOEVENT)

	    }

	    Buf_Quit(OK)

	    Reg_Empty(#65+18)

	    #38 = 0			// Speed optimization

	    Buf_Switch(XLAY)

	//

	//	e=n,filename

	//

	} else {

	    //

	    // Process limit on # invalid compressed data item messages.

	    //

	    #5 = Num_Eval(advance+suppress)

	    if (Chars_Matched>0) {

		if (#5>=0) {		// e=n

		    #38 = #5		// #38 = limit

		}

	    }

	    //

	    //	Advance past ",[whitespace]"

	    //

	    match("|[|w],|[|w]",advance) // Advance past ","

	    //

	    // Process explicit error filename.

	    // Set path to the main output directory unless an

	    // explicit path is specified (at least one "\").

	    //

	    if (match("|{//,|>}")) {		// When not at comment or eol

		call(53)			// T-Reg[0] = filename

		Buf_Switch(Buf_Free(EXTRA))

		Reg_Ins(0)

		if (search("\",BEGIN+NOERR)==0) {

		    Reg_Set(0,@(7),INSERT)

		}

		Buf_Quit(OK)

		Buf_Switch(XLAY)

		if (File_Check(@(#65+18))>0) {	// If early processing errors...

		    FO("|@(#65+18)",NOEVENT)	// Switch to the error buffer

		    File_Save_As(@0,OK+NOMSG)	// Change filename

		    File_Delete(@(#65+18),OK+NOERR)

		    Reg_Set(#65+18,PATHNAME)	// Copy error pathname into T-Reg[18]

		} else {			// else if file not yet open ...

		    if (Reg_Size(0)>0){ Reg_Set(#65+18,@0) }

		    File_Open("|@(#65+18)",OVERWRITE+NOMSG+NOEVENT) // Open any pre-existing file

		    Del_Char(ALL)		 // Empty it

		}

		Buf_Switch(XLAY)		// Switch back to layout file

	    }

	    Reg_Lock_Macro(102,EXTRA)		// Trap unexpected breakouts

	}

	goto DELLN

    }

    //

    //  i=

    //

    if ( match("i=",advance) == 0 ) {	//If "i=" include .nam header files

	if (match("|A")==0){

	    if (match("on")==0){

		#43 = 1

	    }

	} else {

	    #43 = Num_Eval()

	}

	if (#43!=1) {

	    #43 = 0

	}

	goto DELLN

    }

    //

    //	o=

    //

    if ( match("o=",advance) == 0 ) {	//If "o=" default options

	while( match("|[|w]|{b2z,+,b,u,z,-,e,s,p}",ADVANCE) == 0 ) {

	    #1 = mi - 1

	   if ( #1 == 0 ) {

		EBC_Settings( SP_2_ZERO, 1 )

	   } else {

		#0 = 1

		if ( #1 > 4 ) {

		    #0 = 0

		    #1 -= 4

		}

		if ( #1 == 1 ) {

		    EBC_Settings( Force_Plus,#0)

		} else { if ( #1 == 2 ) {

		    EBC_Settings( Begin_Sign,#0)

		} else { if ( #1 == 3 ) {

		    EBC_Settings( Unsigned,#0)

		} else { if ( #1 == 4 ) {

		    EBC_Settings( Leading_Zeros,#0)

		}}}}

	    }

	    match(",",advance)

	}

	goto DELLN			// Now delete this line

    }

    //

    //  bc=badchar

    //

    if (match("bc=",advance)==0){

	if (match("|{'',',0x}")!=0){goto BAD_LAY}

	#0=0

	if (mi>1){

	    #0=Num_Eval()

	}

	EBC_Settings(badchar,#0&0xFF)

	goto DELLN			//Now delete this line

    }

    //

    //  pc=padchar

    //

    if (match("pc=",advance)==0){

	if (match("|{'',',0x}")!=0){goto BAD_LAY}

	#0=0

	if (mi>1){

	    #0=Num_Eval()

	}

	EBC_Settings(padchar,#0&0xFF)

	goto DELLN			//Now delete this line

    }

    //

    //	u=				// Ignore,Ascii,Ebcdic

    //

    if (match("u=|[|W]",advance)==0){	// If "u=" unspecified columns

	XDefType(CurChar | 0x20)	// ebcdic or ignore

	goto DELLN

    }

    //

    //	v=

    //

    if (match("v=",advance)==0){	// if "v=" Vedit command

	if (#64&256) { goto ENDR }

	rcb(#65+11,cp,eolpos)		// Copy command(s) into T-Reg[11]

	Buf_Switch(XData)		// Switch to the source data buffer

	call(#65+11)			// Perform them

	Buf_Switch(XLAY)		// Reenter the data layout buffer

	goto DELLN			// Delete this line!

    }

    //

    //	x=

    //

    if (match("x=",advance)==0){	// if "x=" post processing commands

	rcb(#65+14,cp,eolpos)		// Copy command(s) into T-Reg[14]

	#64 = #64 | 8			// Set flag

	goto DELLN			// Delete this line!

    }

    } // (cc(1)=='='||cc(2)=='=')



    //

    //  uid={off,auto,all}

    //

    if (match("uid|[|w]=|[|w]",advance)==0) {	// If Unique ID is (not) wanted...

	if (match("|d")==0){

	    #42 = Num_Eval()

	} else { if (match("|{off,auto,all}")==0) {

	    #42 = Match_Item - 1

	} else { if (match("|{on,force}")==0) {

	    #42 = 2

	} else {

	    #42 = 0

	}}}

	if ( #42 < 0 || #42 > 2 ) {

	    #42 = 1

	}

	goto DELLN

    }

    //

    //		xrf=arg		where arg = 1 or "on" to enable.

    //

    if (match("xrf|[|w]=|[|w]",advance)==0){

	#63 = 0

	if (match("|{1,on}")==0){

	    File_Open("|@(8)",NOMSG)	// Switch to the cross reference file

	    if (File_Size > 0) {

		#63 = Buf_Num

	    }

	    Buf_Switch(XLAY)		// Switch back to the .LAY file

	} else {

	    #63 = 0			// Auto-generate the field names

	}

	goto DELLN

    }



    //////////////////////////////////////////////////////

    //							//

    //		  Output diversion filename.		//

    //							//

    //////////////////////////////////////////////////////



    if (match("out|{|w,//,|>}",ADVANCE)==0) {

	#17 += 0x10000		// Count this "out"

	if(Match("|{//,|>}")) {

	    NumPush(16,16)

	    RegSet(0,@3)

	    RegPush(0,0)

	    or(3,APPEND); TypeChar('A' + ((#17>>8) & 0xff)); or(CLEAR)

	    #17 += 0x100	// Update # "out" autogenerated short names

	    call(59)

	} else {

	    call("DBEOR")

	    RegPop(3,3)

	    NumPop(16,16)

	}

	goto ENDR

    }



    //////////////////////////////////////////////////////

    //							//

    //		   Other Code Processing		//

    //							//

    //////////////////////////////////////////////////////



    #5 = 0

    //

    //  Set #2 = lower case code letter.

    //

    if (match("|A")==0) {

	#2 = Cur_Char | 0x20		// make lower case

	//

	//	q - quote and comma delimit

	//

	if (#2=='q') {

	    XQCD(1)			// Set Quote-and-Comma-Delimit flag

	    if (#3!=0) {		// Cannot have processed any fields yet

		goto BAD_LAY

	    }

	    if (#28) {			// Cannot mix QCD and DBASE

		goto BAD_LAY

	    }

	    goto DELLN			// Delete this line from the layout file

	}

	//

	// Set #85 = initial valid code letter and advance past it.

	//

	if (match("|{b,c,d,e,f,h,i,l,n,s,u,x,y,z}",advance)==0) {

	    #85 = #2

	} else {

	    goto BAD_LAY

	}

    } else {

	goto BAD_LAY

    }

    //

    //		c - custom field.

    //

    if (#85 == 'c' && #18 == 0 ){

	//

	//	Use T-Reg[1] to load and speed optimize submacros.

	//	Then distribute the code to their proper T-Regs.

	//

	Reg_Load(1,"EBCDIC-2.VCM",EXTRA)

	Reg_Prep(1)

	Call(1)

	Reg_Empty(1)

	#18 = 1

    }

    //

    //	Convert "+size" to "bc,ec".

    //

    Match("|W",ADVANCE)

    if (Cur_Char=='+'){			//Process code +size

	Del_Char(1)

	#10 = Num_Eval(SUPPRESS)

	XAdjBeg(XNextCol + 1)		// cb

	XAdjEnd(XNextCol + #10)		// ce

	Del_Char(Chars_Matched)

	Num_Ins(XAdjBeg,LEFT+NOCR)

	Ins_Char(',')

	Num_Ins(XAdjEnd,LEFT+NOCR)

    } else {				//Process code bc,ec

	//

	//	Check for invalid beginning column number.

	//

	XAdjBeg(Num_Eval(SUPPRESS+ADVANCE))	//Set field starting column

	if (XAdjBeg < 1 ) { goto BAD_LAY }	//Check for valid number

	if (XQCD>0 && XAdjBeg!=XNextCol+1){goto BAD_LAY} //Contiguous quoted fields

	if (XAdjBeg < XNextCol) { goto BAD_LAY } //Fields must be in ascending order

	//

	//	Convert "m<sep>n" to "m,n".

	//

	if (!Replace_Block("|[|W]|S|[|W]",",",Cur_Pos,EOL_Pos,NOERR)) {

	    goto BAD_LAY }

	//

	//	Check for invalid ending column number.

	//

	XAdjEnd(Num_Eval(SUPPRESS+ADVANCE))	//Set field ending column

	if (XAdjEnd < 1 ) { goto BAD_LAY }	//Check for valid number

	if (XAdjEnd < XAdjBeg) { goto BAD_LAY }	//Fields must be in ascending order

    }

    //

    //	Valid field; count it.

    //

    #3++

    //

    // Set XNextCol to last specified column.

    //

    XNextCol(XAdjEnd)

    //

    // Process options.

    //

    EBC_Get_Opt()

    //

    // Add field to DBASE header, perhaps.

    //

    if (#28) {call("DBFIELD")}

    //

    // Optimize by stripping default field (ebcdic) specifications if able.

    //

    call("OPTIMIZE")

    if (Return_Value) {Goto DELLN}

//

// ENDR - Advance to next description line and loop, if possible;

//	  terminate loop, otherwise.

//

:ENDR:

    line(1,errbreak)

    continue

//

// DELLN - Delete "code=" line from buffer.

//	   Continue at top of loop.

//

:DELLN:

    if ( #64 & 256 ) { goto ENDR } // When just preprocessing

    BOL()

    Del_Line(1)

    continue



///////////////////////////////////////////////////////////////////////////////

//

// OPTIMIZE - Delete unnecessary specifications ('e', 'i' or 'u').

//	      Cannot strip when QCD nor user delimited fields.

//	      Cannot strip if FieldSize or PadCount.

//	      Cannot strip 'u' if LeadingZeros, OutPoint or SP2Zero.

//	      Cannot strip 1st nor last specification in an "out...out"

//	             extraction block.

//

//	      Enter: #2 = current specification code's 1st letter.

//		     #17 = 00 oo nn rr, where

//			   rr = # out's

//			   oo = # out-auto-generated short names

//		     XDefType = default code {a,e,i}.

//		     CurPos should be at EOL unless custom field.

//	      Retrn: (RET_VAL == 1) if line is to be deleted.

//		     CurPos on same line; may be at BOL.

//

:OPTIMIZE:

    //

    // 	Return NOSTRIP when not default item nor 'u';

    //  also when quoting and comma delimiting or

    //  using explicitly specified item separators.

    //

    if (( #2 != XDefType && #2 != 'u') || XQCD + RSize(XDREG) > 0 ) {

	 return(0)

    }

    //

    // Give BADPARM error if !AtEOL/EOF.

    //

    if (!AtEOL){goto BAD_PARM}

    //

    // Return NOSTRIP if either FieldSize or PadCount.

    //

    if ( EBC_Settings( FieldSize ) || EBC_Settings( PadCount )) {

	return(0)

    }

    //

    // For 'u', return NOSTRIP if LeadingZeros, OutPoint or SP2Zero.

    //

    if ( #2 == 'u' ) {

	if ( EBC_Settings( LeadingZeros ) || EBC_Settings( OutPoint ) || EBC_Settings( SP2Zero )) {

	    return(0)

	}

    }

    //

    // Backup to previous description.

    // If none, it's OK to STRIP.

    //

    BOL()

    SavePos()

    if (Search("|<|a",REVERSE+NOERR)==0){

	RestorePos()

	return(1)

    }

    //

    // If previous description is beginning 'out',

    // return NOSTRIP.

    //

    #0 = 0

    if (match("out|s")==0 && ((#17>>16)&1)) {

	#0 = 1

    }

    RestorePos()

    if (#0) {return(0)}

    //

    // Return NOSTRIP if the next description, if any, is

    // the ending 'out', else STRIP.

    //

    SavePos()

    Char(1)

    #0 = 1	// STRIP

    if (Search("|<|a",NOERR)){

	if (match("out|s")==0 && ((#17>>16)&1)) {

	    #0 = 0

	}

    }

    RestorePos()

    return(#0)



// OPTIMIZE ends



///////////////////////////////////////////////////////////////////////////////

//

// DOPOINT - Strip "vn" from field options as specified.

//	     Enter: #44 = Allow-decimal-point flag.

//	     Retrn: Lines beginning with "NOD" or "DOD" have been deleted.

//		    Fields within purview of "NOD" have "vn" stripped out.

//		    #44 undefined (not needed anymore).

//

:DOPOINT:

bof

Set_Marker(0,Cur_Pos)

while (search("|<|[|w]|{n,d}od",NOERR)) {

    if (match("|[|w]n")==0){

	if (#44){

	    Set_Marker(0,Cur_Pos)

	}

	#44 = 0;

	Del_Line(1)

    } else {

	if (#44==0){

	    call("XPOINT")

	}

	#44 = 1

	Del_Line(1)

    }

}

if (#44==0){

    eof

}

:XPOINT:

    #0 = Cur_Pos

    Goto_Marker(0)

    Set_Marker(0,#0)

    while (search_block("|bv|[|d|[|d]]|s",Cur_Pos,Marker(0),NOERR)){

	replace("|bv|[|d|[|d]]","")

    }

    Goto_Marker(0)

    return



///////////////////////////////////////////////////////////////////////////////

//

// DBFIELD - Add current field to DBASE header; update header size; update record size.

//	     Enter:  #3 = Field Counter.

//		    #28 > 0 (DBASE flag).

//		    #63 = .xrf BufID

//		    [3] = RecName

// DBF     -	    #16 = BufID of .dbf file.

//		    #85 = field specifier {a,b,c,d,e,f,h,i,l,n,s,u,x,z}

//		    XAdjBeg = begin column (input).

//		    XAdjEnd = end column (input).

//

:DBFIELD:

    if (#85=='x'){return}	// Do nothing when field is being deleted

    //

    // Set T-Reg[1] = field name.

    //

    if (#63>0){			// When .xrf file has been specified

	//

	// Use first name on .xrf file's current line and advance to next line.

	//

	Buf_Switch(#63)

	Match("|W",ADVANCE)

	#0 = Cur_Pos

	s("|b")

	rcb(1,#0,Cur_Pos)	// T-Reg[1] = first name on current line

	Line(1,NOERR)		// Advance to next line

    } else {

	//

	// Else auto-generate the field name.

	//

	RegSet(1,@3)		// Record name

	ITOA(#3,1,LEFT+NOCR+APPEND) // Field number

    }

    //

    // DBF -

    // Enter: #16 = .dbf BufID

    //	      #85 = Field Type (.lay code)

    //	      XAdjBeg = Field Beginning Col

    //	      XAdjEnd = Field Ending Col (only need XAdjEnd - XAdjBeg to be valid)

    //	      [1] = Field Name

    //

:DBF:

    BufSwitch(#16)		// Switch to .dbf file

    NumPush(0,5)

    #0 = File_Size - 1		// Position just ahead of <cr> terminator

    GP(#0)

    Ins_Char(0,COUNT,32)		// Zero-out current 32-byte structure

    //

    // Insert field name (Pos 0-10)

    //

    GP(#0)

    RegIns(1,OVERWRITE)

    //

    // Insert field type (Pos 11) {C,D,L,N}

    //

    GP(#0+11)

    Ins_Char('C',OVERWRITE)	// Character type

    //

    // Compute and insert field length (Pos 16)

    //

    call("FIELD_SIZE")		// #2 = size

    GP(#0+16)

    Ins_Char(Return_Value,OVERWRITE)

    //

    // Update # bytes in the header (pos 8-9).

    //

    GP(8)

    Ins_Char(FSIZE&0xFF,OVERWRITE)

    Ins_Char((FSIZE>>8)&0xFF,OVERWRITE)

    Config(F_REC_HEAD,FSIZE,LOCAL)

    //

    // Update # bytes in the record (pos 10-11).

    //

    #1 = cc + (cc(1)<<8) + #2

    Ins_Char(#1&0xFF,OVERWRITE)

    Ins_Char((#1>>8)&0xFF,OVERWRITE)

    Config(F_F_TYPE,#1,LOCAL)

    //

    Num_Pop(0,5)

    Buf_Switch(XLAY)

    return



// DBFIELD ends



//

// SETBREGS - Set T-Reg[4] with table of default (cooked) binary sizes;

// 	      Set T-Reg[2] with table of max binary sizes when "raw";

// 		  (must agree with BMAX[] and RMAX[] in Veditc2.asm)

//

// BMAX	  DB    1,4,6, 8,11,13,16,18	;Standard (cooked) binary sizes

// RMAX	  DB    3,5,8,10,13,15,17,20	;Raw binary sizes

//

:SETBREGS:

    #0 = Buf_Num

    Buf_Switch(Buf_Free(EXTRA))

    Ins_Char('.')

    Replace(".","|H01|H04|H06|H08|H0B|H0D|H10|H12",BEGIN)

    Reg_Copy_Block(4,0,Cur_Pos,DELETE)

    Ins_Char('.')

    Replace(".","|H03|H05|H08|H0A|H0D|H0F|H11|H14",BEGIN)

    Reg_Copy_Block(2,0,Cur_Pos,DELETE)

    Buf_Quit(OK)

    Buf_Switch(#0)

    Return



// SETBREGS() ends



///////////////////////////////////////////////////////////////////////////////

//

// FIELD_SIZE - return # bytes in output field.

//              Enter: #85 = field specifier {a,b,c,d,e,f,h,i,l,n,s,u,x,z}.

//                     XAdjBeg = begin column (input).

//                     XAdjEnd = end column (input).

//		Retrn: Return_Value = field size.

//

// BMAX	  DB    1,4,6, 8,11,13,16,18	;Standard binary sizes

// RMAX	  DB    3,5,8,10,13,15,17,20	;Raw binary sizes

//

:FIELD_SIZE:

    Num_Push(0,1)

    #0 = EBC_Settings( UNSIGNED )

    #2 = XAdjEnd - XAdjBeg + 1

    //

    if (#85=='b') {

	if (EBC_Settings(raw)){

	    #5 = BtoI( 2, #2 - 1, 1 )	// #5 = max # decimal digits

					//      packed into #2 binary bytes

	} else {

	    #5 = BtoI( 4, #2 - 1, 1 )	// #5 = standard max # decimal digits

					//      packed into #2 binary bytes

	}

	#2 = #5

    //

    // Other codes

    //

    } else { if (#85=='d'||#85=='n'||#85=='h'){

	#2 += #2

	if (#85=='d'){

	    #2--			// Further adjustments yet to come

	}

    }}

    //

    // Adjust/recompute for ",[{-,=}]padlen;" option.

    //

    if (#1 = EBC_Settings( FIELD_SIZE )) {

	#2 = #1

    } else {

	#2 += abs( EBC_Settings( PAD_COUNT ) )

    }

    //

    //	Adjust for any sign.

    //

    if ((#85=='b'||#85=='d'||#85=='z'||#85=='l'||#85=='s')&&!#0){

	#2++

    }

    //

    //	Adjust for any explicit decimal point.

    //

    if ( EBC_Settings( Out_Point ) !=0 ) { #2++ }

    //

    Num_Pop(0,1)

    return(#2)



// FIELD_SIZE ends



///////////////////////////////////////////////////////////////////////////////

//

// DQEOR - Proceed to DBEOR if current record type has extracted portions.

//	   Note: CurPos is at start of next record type.

//	   Enter: #28 = DBASE flag.

//		  #59 = record types counter

//		  #73 = segment level

//

:DQEOR:

    //

    // Just return if not DBASE or no items.

    //

    if (#28==0||#59==0){return}

    //

    if (#73){goto DBEOR}

    Set_Marker(9,CurPos)

    BOL()

    Search("|<|{l=,st,so,t}",REVERSE+NORESTORE+NOERR)

    l

    #0 = 0

    while(SearchBlock("|<|{out,rb|[|w#|d|[|d]]}|[|w]",CurPos,Marker(9),ADVANCE+NOERR)){

	if (!AtEOL){

	    #0 = 1

	    break

	}

    }

    GM(9)

    if (#0==0){return}

//

// DBEOR - For DBASE, enter unique field into header & set F_F_TYPE.

//	   Enter: #59 = # record types (do nothing when 0).

//		  #28 = DBASE flag.

//		  #62 = sizes of reccnt, segcnt, jdate : { 0000 jjjj ssss rrrr }

//		  [3] = DBASE record name.

:DBEOR:

    if (#59==0){return}

    if (#28) {

	RegSet(1,@3)

	RegSet(1,"UID",APPEND)

	#85 = XDefType		// #85 = default code ('e' for EBCDIC, e.g.)

	XAdjEnd((#62&0xFF) + ((#62>>8)&0xFF) + ((#62>>16)&0xFF) + 1) // XAdjEnd = length of unique ID

	XAdjBeg(1)		// Only interested in XAdjEnd - XAdjBeg

	#85 = XDefType		// Set field type to default

	EBC_Reset(LOCAL)	// Reset all current options

	call("DBF")

    }

    return



// DBEOR ends



} // Preprocessing loop ends



call("DQEOR")



//////////////////////////////////////////////////////////////////////////

//									//

//               End of .LAY Preprocessing Loop				//

//									//

//////////////////////////////////////////////////////////////////////////

//

//

//	Check for and reprocess invocation "-u option_list" parameter.

//	Any settings in the invocation list should prevail.

//

Num_Push(14,14)

call("OPTIONZ")

if (#42<0){#42=1}	// Auto option for UID's if not otherwise specified

Num_Pop(14,14)



//

//	Compute #55 = date portion of unique ID for Repeated Group extractions

//

#55 = #50 - #55

//

//	Set #50 = # digits to display elapsed days count of unique ID

//	Set #62 = # digits to display record count of unique ID

//

#50 = (#62 >> 16) & 0xff

#40 = (#62 >>  8) & 0xff

#62 = #62 & 0xff



if (#64 & 256) { goto DONE }	// Quit when just preprocessing



//////////////////////////////////////////////////////////////////////////////

//

// Final initialization.

//

BOF()

Buf_Switch(XData)		//Switch to source data file

//

//	Deal with record size/type, allowing user to set record type

//	from {Config} menu.

//

if (#67>=0) {				//For defined record types

    Config(F_F_TYPE,#57,LOCAL)		//Set input record type/default-size

//

// Allow user to configure the record size/type by hand.

//

} else {

    #57 = #67 = #87 = Config(F_F_TYPE)	//#87 = input record size/type

    if (#67<6) {

	#87 = 0

    } else {

	#67 = 6

    }

}

//

//	Move any header into output buffer via T-Reg[0].

//

if (#86>0) {

    RCB(0,0,#86,DELETE)

    EOF()

    BS(#75)			//Standard output buffer

    RI(0)

    BS(XData)

    Config(F_REC_HEAD,#86,LOCAL)

}



//

//	For DBASE, output initial blank column.

//

if (#28){

    bs(#75)

    EOF()

    if (XDefType=='a'){

	Ins_Char(0x40)

    }else{

	Ins_Char(0x20)

    }

}

//

#93 = 1

Goto_Line(#93)			//Start at 1st record

#0 = CurPos+1			//Flag/value for record size adjustments

//

//	Compute intermediate statistic values.

//	    Enter: #67 = input record type {0,1,2,3,6} or = -1.

//		   #58 = sum of record sizes.

//		   #59 = # record-types.

//	    Exit:  #76 = (approx) record size.

//		   #77 = (approx) # records in the file.

//

if (#67>3){			//If fixed-length records...

    if (#59>0) {

	#76 = (#58 + (#59>>1) + 1) / #59

    } else {

	#76 = #57		//Default record size

    }

} else {			//Else file should have newlines...

    Line(100,NOERR)		//Advance a few lines

    #76 = (Cur_Pos - #0 + 1)/100 //Approx line size

    Goto_Line(#93)		//Restore pos

}

#77 = (File_Size-#0+1) / #76	//#77 = # of records in file

//

//	Set #31 = # records per reporting period {100 or 10 or 2}.

//

#31 = 100

if (#77 < 500){ #31 = 10 }

if (#77 <  50){ #31 =  2 }

//

// Show life by displaying "Processing first xxx data records..." message.

//

//

if (!Is_Quiet) {

    Win_Hor(1)

    Message("Input file:  ")		// Display input drive:\path\name

    Reg_Type(#65+15,0)

    Win_EOL()

    Type_Newline()

    Buf_Switch(#75)

    Name_Write(EXTRA)			// Ditto for output file

    Buf_Switch(XData)

    if (Reg_Size(#65+18)){

	Message("Error file:  ")	// Ditto for error error file

	Reg_Type(#65+18,0)

	Win_EOL()

	Type_Newline()

    }

    Message("Processing first ")

    Num_Type(#31,LEFT+NOCR)

    Message(" data records... ")

}

//

//	More statistics.

//

#36 = File_Size

#39 = Reg_Free			// Do nothing for record #0



// if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?



//////////////////////////////////////////////////////////////////////////////

//

// Main Processing loop.

//

#77 = #75			//Initially, output buffer = standard output buffer

#32 = Time_Tick

XAdjEnd(-1)			//1st time flag for empty record type (all default data)

XRecNum(0)			//Init record counter

XDataByteCount(0)		//No bytes processed yet

XSegOfs(0)			//Segment column offset

while(!AtEOF){			//For each record

    //

    // Switch to source data buffer.

    //

    BS(XData)

    //

    // Show progress message every 100 or 10 or 2 iterations.

    //

    if (!IsQuiet&&!(XRecNum%#31)){

	call(#39)		// T-Reg(#39) is empty, initially

	#39=62			// Next time it'll have the right stuff

    }

    //

    // Initialization for each record:

    //    Increment record #

    //    Reset XRecByteCount - # bytes processed in current record

    //		XInflation

    //		XLastColProc

    //		#54           - Extraction-file-present flag

    //    Set XNextCol = 1

    //    Set XAdjEnd = -1    - for u=ignore for extraction process

    //

    #54=0			// Extraction-file-present flag

    X_Init_Record()



    //////////////////////////////////////////////////////////////////////////

    //

    // Field processing loop

    //

    BS(XLAY)			//Switch to ebcdic.lay file

    BOF

    while(!AtEOF){		//For each field

	//

	// Process Vedit Macro expression.

	// Allows adjusting pseudo repeat count (actually, variable record

	// length counter) that counts the counter itself.

	//

	if (CC=='#'){

	    NE(ADVANCE)		// Actually evaluates #x++ or #x+=2, e.g.

    				// ADVANCE helps tracing

	    l(1,errbreak)

	    continue

	}

	//

	//	out [filename]

	//

	if (match("out|[|W]",ADVANCE)==0){

	    if(Match("|{//,|>}")) {

		#78=XLCP

		Num_Push(77,78)		// Save current output stream

		call(50,"PRE")

		call(58)		// #77 = extraction buffer ID

	    } else {

		call(50)		// "POST"

		Num_Pop(77,78)		// Restore original output stream

		XLCP(#78)

	    }

	    l(1,noerr)			// Advance to next field description

	    continue

	}



	//////////////////////////////////////////////////////////////////////

	//								    //

	//		   Translate current field.			    //

	//								    //

	// Each independent subsection must entirely process its field,     //

	// leaving the edit position just past it and past any extra	    //

	// characters that may have been added.				    //

	//								    //

	//////////////////////////////////////////////////////////////////////



	X_Doit()



	//

	// Switch back to data description file.

	//

	BS(XLAY)			//Switch to ebcdic.lay file



    } // (!At_EOF)



    //////////////////////////////////////////////////////////////////////

    //									//

    //			End of record processing.			//

    //									//

    //////////////////////////////////////////////////////////////////////

    //

    //		 Convert any final unspecified columns.

    //

    BS(XData)

    //

    //

    //

	if (#67<6){			// If terminated input records...

	    #0=eolpos-CP

	}else{				// But for fixed length records...

	    #0=#87+XI-XNC+1

	}				// Anyway, #0 = # chars to eol

	if (#0>0){

	    if (XDefType=='e'){

		TRB(CP,CP+#0,REVERSE+NORESTORE)

	    }else{

		C(#0)

	    }

	}

    //

    // Delete any newline char(s).

    //

    if (#67<6) {

	R("|L","")

    }

    //

    // Move translated bytes into output buffer via T-Reg[0].

    //

    RCB(0,0,CP,DELETE)

    BS(#77)

    EOF()

    //

    // Include any .nam header file, if so specified.

    //

    if (#43&&AtBOF){

	Ins_File("|(FILE_ONLY).nam")

    }

    if (RSIZE(0)>0){

	if (#28&&AtBOL){

	    ic(' ')

	    XLCP(XLCP+1)

	}

	RI(0)

    }

    if (!AtBOL()){

	//

	// If any detail extraction file(s) specified, output unique ID

	// plus comma and quote marks, if so specified.

	//

	if((#42&2)||(#54&&#42)){call(48)}	// UID()



	//

	// Insert newline char(s), if so specified.

	//

	if ((0<=#68)&&(#68<6)){

	    if (#68!=1){IC(0x0d)}		// DOS and MAC

	    if (#68!=2){IC(0x0a)}		// DOS and UNIX

	}

    }

    //

    // Switch back to the source data buffer.

    //

    BS(XData)



} // Main processing loop



/////////////////////////////////////////////////////////////////////////////

//

// Set true to view final statistics.

//

if ( 0 ) { if (!Is_Quiet) {

    Win_Hor(1)

    Message("Converted records: ")

    Num_Type(XRecNum-1,NOCR)

    Message(" (")

    Num_Type(100,LEFT+NOCR)

    Message("%)")

    Win_EOL()

    Message("\nActual elapsed time: ")

    if ( 0 ) {

	Num_Type((Time_Tick - #32 + 500)/1000,LEFT+NOCR)

	GetKey(" seconds.")		// Pause at end of message

    } else {

	Num_Type(Time_Tick - #32,LEFT+NOCR)

	GetKey(" milliseconds.")	// Pause at end of message

    }

}}



//////////////////////////////////////////////////////////////////////////////

//

call("CleanUp")

File_Save(BEGIN+NOMSG)			// Save output file; goto BOF (quickly)

//

//	Do any specified post-processing.

//

if (#64&8){call(#65+14)}

//

//	Discard data description buffer.

//	Delete the temporary file.

//

Buf_Switch(XLAY)

Buf_Quit(OK)

File_Delete(@(5),OK+NOERR)

//

//	Release temporary source data file & delete it.

//

Buf_Switch(XData)

Buf_Quit(OK)

File_Delete(@(6),OK+NOERR)		// Delete temporary data file

//

//	Restore text and numerical registers and then terminate.

//

//{

:DONE:

Buf_Switch(#75)				//Switch to main output buffer

Reg_Empty(101)				//Empty error reporting submacro

Reg_Empty(102)				//Empty unexpected breakout trapper

Call("CloseErr")

Num_Pop(70,99)				//Restore numeric regs

Num_Pop(0,59)

Config(U_AUTO_CFG,#0)			//Restore user's config values

Config(F_AUTO_SAVE,#1)

Config(F_OVER_MODE,#2)

Config(E_EXP_TAB,#5)

Config(E_RETAB_BK,#6)

Config(E_RETAB_FILL,#7 & 0xff )

Config(S_E_MORE,#8)

Config(D_DSP_WRAP,#9)

if (#99==0x57495C44) {			//If WILDFILE macro running

    Config(F_F_TYPE,#4)

    Config(F_REC_HEAD,#5)

}

Num_Pop(0,10)				//Restore remaining user numregs

Reg_Lock_Macro(#66)

#69 = 1					//WILDFILE flag for next time in

if (Is_Option(y)) { Xall(NOMSG) }	//If "-Y" invocation, exit now

if (#99==0x57495C44) {			//If WILDFILE macro running

    if (!Is_Quiet) {

	Type_Newline()

    }

}

if (#105) {

    vm(NOMSG)

}

return



//} DONE()



//////////////////////////////////////////////////////////////////////////////

//

// Clean up:

//	Release source data file.

//	Set appropriate viewing display modes for the output files.

//	For DBASE, append <ctrl-z>'s and fixup header info.

//

//

// {

:CleanUp:

//

// Release source file.

//

BS(XData)

Buf_Quit(OK)

//

// Release .xrf file, unless DBASE

//

if (#28==0||#63==0){

    File_Open("|@(8)",OK+NOMSG)

    Buf_Quit(OK)

}

//

// Configure, save, goto 1st line of each output file.

//

Buf_Switch(#75)

call("SETDISP")

if ( #68 >= 0 ) {			// (Any "r=" sets #68 > -1)

    //

    // Primary output file.

    //

    if (#68 <= 4 ) {			// #68 = output record type?

	Config(F_F_TYPE,#68,LOCAL)	// Set record type for clean viewing

    } else { if (#28==0){		// But when fixed output but not DBASE

	if (#88<=0){

	    Config(F_F_TYPE,64,LOCAL)	// Set arbitrary record size

	} else {

	    Config(F_F_TYPE,#88,LOCAL)

	}

    } else {				// For DBASE...

	call("FIXDB")

    }}

    //

    //	Also for extracted files

    //

    BS(XLAY)

    bof

    repeat(all){

	s("|<|{tx,rb|[|w]|[#|d|[|d]],out|!|L}|[|w]",advance+errbreak)

	if (At_EOL){continue}

	sm(8,cp)

	rcb(0,cp,cp+1,norestore)	// Copy delimiter into T-Reg[0]

	s(@0)				// Find terminating delimiter

	rcb(0,marker(8),cp)		// Copy filename into T-Reg[0]

	bs(#75)				// Switch to main buffer so that we can

					// use e.g. tx "|(FILEONLY).as1"

	fo("|@(0)",NOEVENT+NOMSG)	// Switch to the buffer

	call("SETDISP")

	if (Is_Altered) {

	    if (#28==0){		// When not debased...

		if (#68 <= 4 ) {

		    Config(F_F_TYPE,#68,LOCAL)	// Set record type for clean viewing

		} else {

		    Config(F_F_TYPE,64,LOCAL)	// Set arbitrary record size

		}

	    } else {			// DBASE ...

		call("FIXDB")

	    }

	}

	bs(XLAY)			// Switch back to the data description file

    }

    bs(#75)				// Switch back to the standard output file

}

return

// } // CleanUp()



//

// SETDISP -

//

// {

:SETDISP:

    if (XDefType=='e') {

	Config(D_DSP_MODE,4,LOCAL)

    }

    return



// } // SETDISP()



//

// FIXDB -

//

// {

:FIXDB:

    EOF()

    if ( Cur_Pos - BOL_Pos == 1 ){

	Del_Char(-1)		// Remove any orphaned "deleted-item" column

    }

    #0 = File_Size - Config( F_REC_HEAD )

    if ( #0 > 0 ) {

	Ins_Char( 0x1a )	// Append <EOF>

	File_Save(BEGIN+NOMSG)	// Set edit position to file beginning

	Char(4)			// Advance Cur_Pos to record counter field

	#0 = #0 / Config( F_F_TYPE ) // #0 = # records

	repeat(4){

	    Ins_Char(#0&0xFF,OVERWRITE)

	    #0 = #0 >> 8

	}

	Goto_Line(1)		// Skip over any DBASE header

    }

    return



// } // FIXDB()



//////////////////////////////////////////////////////////////////////////////

//									    //

//			Error Processing				    //

//									    //

//////////////////////////////////////////////////////////////////////////////

:MISSING:

    Reg_Empty(1)

    Out_Reg(1,APPEND)

    Message("\n***** COBOL2V.VDM could not be found.")

    Message("\n      Invalid data description line:\n")

    goto ALLBAD



:BAD_PARM:

    Reg_Empty(1)

    Out_Reg(1,APPEND)

    Message("\n***** Unrecognized option: ")

    type(1)

    Message("      Occurred in line:\n")

    goto ALLBAD



:BAD_LAY:

    Reg_Empty(1)

    Out_Reg(1,APPEND)

    Message("\n***** Invalid data description line:\n")



//

// ALLBAD - Main Fatal Error handling routine.

//	    T-Reg[1] contains the error message; output has not yet been

//	    displayed but appended to the end of this register. This is done

//	    for quietness' sake.

//	    Enter: T-Reg[1] contains main error message.

//		   E-Buf[XLay] is the current edit buffer.

//	    Exit:  Additional info put into T-Reg[1], which is then copied

//		   to the end of the .err file. Unless "-q" option, T-Reg[1]

//		   is also copied to the screen.

//		   Processing is terminated either with "xall" for ("-q") or

//		   Break-Out(Extra), otherwise.

//

// Note: See "DATERR" in T-Reg[101] for non-fatal data error reporting.

//

:ALLBAD:

    BOL()

    type(1)			// Copy current .lay line to the end of T-Reg[1]

    Out_Reg(CLEAR)		// Turn output diversion off

    //

    // Find location of invalid specification in source .LAY file.

    //

    Search("|s")

    if (At_EOL) {

	#0 = Cur_Pos

    } else {

	#0 = Cur_Pos + 1

    }

    Reg_Copy_Block(0,BOL_Pos,Cur_Pos)

    BOF

    #1 = Search_Block("|<|@(0)",0,#0,ALL)

    #0 = 0

    if (!Is_Quiet) {		// Want to keep edited layout file for "-q"

	Buf_Quit(OK)

	Buf_Switch(XLAY)

    }

    File_Open("|@(9)",OVERWRITE+NOMSG+NOERR)	// Open source .lay file

    Search("|<|@(0)",COUNT+NOERR,#1) // Won't be there for manufactured codes

    //

    // Write source line # and filename into .err file for "-q".

    //

    if (Is_Quiet) {

	Out_Reg(1,APPEND)

	Message("Line # ")

	Num_Type(Cur_Line,LEFT)

	Message("File: ")

	Name_Write(EXTRA+NOMSG)

	Out_Reg(CLEAR)

    }

    Call("ERRMSG")

    if (Is_Quiet) {

	XALL(1)

    } else {

	GetKey("\nPress any key to edit data layout file...")

	Call("CloseErr")

	Break_Out(EXTRA)

    }

//

// ERRMSG - Output message in T-Reg[1] to screen and/or error file.

//

:ERRMSG:

    if ( Reg_Size(#65+18) ) {

	#0 = Buf_Num

	File_Open("|@(#65+18)",NOMSG)	// Really just a buffer switch

	EOF

	Reg_Ins(1)

	Buf_Switch(#0)

    }

    if (!Is_Quiet) {

	Reg_Type(1)

	Reg_Empty(1)

	Alert()

    }

    return

//

// CloseErr -

//

:CloseErr:

    if (Reg_Size(#65+18)) {		// If .err file exists

	#0 = Buf_Num

	File_Open("|@(#65+18)",NOMSG)	// Buffer switch

	if (#0==Buf_Num) {

	    #0 = XData			// Don't want empty buffer/window

	}

	if (File_Size) {		// If any errors

	    Buf_Close(NOMSG+DELETE)	// Save the message(s)

	} else {

	    Buf_Quit(OK)		// Else discard the empty file

	}

	Buf_Switch(#0)

    }

    return



//////////////////////////////////////////////////////////////////////////////

//									    //

//	Processing Macro specific parameters from DOS command via "-u"	    //

//									    //

//////////////////////////////////////////////////////////////////////////////

//

// OPTIONZ - Process user definable options from invocation line's "-u option_list".

//

// Note:  WIN95 batch-file processing strips '=' from the parameter line.

//	  So, use '-' instead.

//

//	     Option_List:

//		run_no			// where 0 <= run_no < 10

//		UID=val			// (Default = auto = 1)

//		d=run_date		// For setting run date in Unique ID

//		i[nclude][=val]		// To include .nam at start of each output file

//					// val={off,on} or {0,1}

//		NOD			// No explicit decimal points

//

//	     Enter:

//	     Retrn: #41 = run_no, 0 <= n < 9; run # for unique ID; default == 1.

//		    #42 = {0,1,2} for UID={off,auto,on or all}; default == 1.

//		    #43 = {0,1}   for Include={off,on}; default == 0.

//		    #44 = {0,1}	  for preventing/allowing decimal points; default=1

//		    #50 = Run Date (# days since 1-1-1, more or less).

//

// Note: this routine is called both before and after preprocessing.

//

:OPTIONZ:

    #3 = Buf_Num

    #4 = 0

    if (#64&0x800){		// Old style, from "-n 0x800"

	#42 = 0

    }

    //

    // Process "-u options" for version 5.30 and later

    //

    if (vn>=530){

	Buf_Switch(Buf_Free(EXTRA))

	Ins_Text(CMD_LINE)

	EOF()

	Ins_Char(' ')

	if (Replace("|<|M-u"," ",BEGIN+NOERR)) {

	    #4 = Buf_Num

	    //

	    // Set Unique ID option to {off,auto,all}

	    //

	    if (Replace("|buid|[|w]|{=,-}"," ",BEGIN+NOERR)) {

		#14 = Cur_Pos

		if (match("|d")==0){

		    #42 = Num_Eval(ADVANCE)

		} else { if (match("|{off,auto,all}",advance)==0) {

		    #42 = Match_Item - 1

		} else { if (match("|{on,force}",advance)==0) {

		    #42 = 2

		} else {

		    #42 = 0

		}}}

		if ( #42 < 0 || #42 > 2 ) {

		    #42 = 0

		}

		Del_Block(#14,CurPos)

	    }

	    //

	    // Include .nam header file at start of each output file, perhaps.

	    //

	    if (Search("|bi|[nclude]|s",BEGIN+NOERR)){

		Del_Char(CMAT-1)

		match("|W",ADVANCE)

		#43 = 1

		if (Match("|{=,-}|[|w]")==0){

		    Del_Char(Chars_Matched)

		    if (Match("|d")==0){

			#43=Num_Eval()

		    } else { if (Match("|{off,on}")==0){

			#43 = Match_Item - 1

		    }}

		    #43 = max(#43,0)

		    Del_Char(Chars_Matched)

		}

	    }

	    //

	    // Set run_date for Unique ID: d=mm/dd/yyyy.

	    //

	    if (Replace("|bd|[|w]|{=,-}|[|w]","",BEGIN+NOERR)){

		#50 = Num_Eval_Date()

		Del_Char(Chars_Matched)

	    }

	    //

	    // Prohibit generation of explicit decimal points, perhaps.

	    //

	    if (Search("|bnod|s",BEGIN+NOERR)){

		Del_Char(CMAT-1)

		#44 = 0

	    }

	    //

	    // Process run-# for unique ID.

	    // Note: Keep this code at the end of the <IF "-u"> clause.

	    //

	    BOF()

	    if (match("|w|d|[|d]|b")==0){

		#14 = Cur_Pos + 1

		if ((#0 = Num_Eval(ADVANCE)) > 0 ) {

		    #41 = #0

		    Del_Block(#14,Cur_Pos)

		}

	    }

	} // <IF "-u">

    }

    //

    // Clean up.

    //

    if (#4>0){

	Buf_Switch(#4)

	Buf_Quit(OK)

    }

    //

    //

    //

    Buf_Switch(#3)

    return



// OPTIONZ ends