Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/isacon/vag001.cbl
There are 5 other files named vag001.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
*=======================
 
Program-Id.	VAG001.
 
Author.	KATHY MCKENDRY
 
Date-Written.	16-Oct-84.
 
Date-Compiled.
 
Installation.	PAPER FREE SYSTEMS, INC.
*-------------
*Program Title:
*-------------
*
*	System: ISACON	DEC to VAX Conversion System
*	Module: VAG001	File Language File Generator
*
*
*-------------------
*Program Description:
*-------------------
*
*	VAG001 creates a file based on the SELECT, FILE DESCRIPTION and
*	DATA DESCRIPTION portions of a user-designated file in a COBOL
*	listing.  The created file will be used by the source code
*	generator program, VAG002, to create programs which will
*	convert the original file from DEC-10 format to VAX-11 format
*	(VMS), as well as create a Common Data Dictionary for the
*	converted file.
*
*----------------------------
*Program Modification History:
*----------------------------
*	--Date--   Who	What
*
*----------------------------------------------------------------------
ENVIRONMENT DIVISION.
*====================

CONFIGURATION SECTION.
*---------------------

SOURCE-COMPUTER.	DECSYSTEM-10.

OBJECT-COMPUTER.	DECSYSTEM-10.


INPUT-OUTPUT SECTION.
*--------------------

FILE-CONTROL.

select			COBOL-LISTING-FILE
	assign to	DSK
	file status is	CL-FS-STATUS
			CL-FS-ERROR-NO
			CL-FS-ACTION-CODE
			CL-FS-FILE-SPEC
			CL-FS-BLOCK-NO
			CL-FS-RECORD-NO
			CL-FS-FILE-NAME
			CL-FS-TABLE-POINTER
	recording mode	ASCII.

select			FILE-LANGUAGE-FILE
	assign to	DSK
	recording mode	ASCII.
DATA DIVISION.
*=============

FILE SECTION.
*------------

fd			COBOL-LISTING-FILE
	value of id	COBOL-LISTING-FILE-ID.

01	COBOL-LISTING-RECORD		display-7.
	02  CLR-NUM-TEST		pic  X(04).
	02  FILLER			REDEFINES
	    CLR-NUM-TEST.
	    04	CLR-COMM-CHECK		PIC  X(01).
		88  CLR-COMMENT-LINE		VALUE '*'.
	    04	FILLER			PIC  X(03).
	02  FILLER			PIC  X(02).
	02  CLR-BODY			PIC  X(99).

01	COBOL-LISTING-WORK-REC	display-7.
	02  COBOL-LISTING-WORK	pic  X(001)	occurs 105.

fd			FILE-LANGUAGE-FILE
	value of id	FILE-LANGUAGE-FILE-ID.

01	FILE-LANGUAGE-RECORD		PIC X(375)	display-7.
01	FILE-LANGUAGE-2					DISPLAY-7.
	05  FILE-LANGUAGE-VAR		PIC X(001)
					OCCURS 1 TO 375
					DEPENDING ON VAR-IDX.
*
WORKING-STORAGE SECTION.
*=======================

01	VAR-IDX				USAGE INDEX.
01	CL-POINTERS.
	02  COBOL-LISTING-PTR		pic S9(03) comp.

01	CL-STATE-SWITCHES.
	02  COBOL-LISTING-END-SW	pic  S9(01) comp.
	    88 COBOL-LISTING-END value 1.
	02  COBOL-LISTING-STAT		PIC  S9(01) COMP VALUE 0.
	    88 COBOL-LISTING-OPEN	VALUE 1.

01	COBOL-LISTING-FILE-CONTROL	DISPLAY-6.
	02  COBOL-LISTING-FILE-ID.
	    04  COBOL-LISTING-FILE-NAME	pic  X(06).
	    04  COBOL-LISTING-FILE-EXT	pic  X(03).
	02  CL-FILE-STATUS.
	    04  CL-FS-STATUS			pic  9(02).
		88  CL-FS-STATUS-NORMAL			value 00.
		88  CL-FS-STATUS-EOF			value 10.
		88  CL-FS-STATUS-DUPLICATE-KEY		value 22.
		88  CL-FS-STATUS-NOT-FOUND		value 23.
		88  CL-FS-STATUS-OUT-OF-BOUNDS		value 24.
		88  CL-FS-STATUS-INVALID-KEY		value 22, 23, 24.
		88  CL-FS-STATUS-FATAL			value 30, 34.
	    04  CL-FS-ERROR-NO			pic  9(10).
	    04  filler redefines CL-FS-ERROR-NO.
		06  CL-FS-VERB-ERROR		pic  9(02).
		    88  CL-FS-OPEN-ERROR		value 01.
		    88  CL-FS-READ-ERROR		value 06.
		06  CL-FS-MONITOR-ERROR		pic  9(02).
		    88  CL-FS-LOOKUP-ERROR		value 03.
		06  filler			pic  9(06).
	    04  CL-FS-ACTION-CODE		usage index.
	    04  CL-FS-FILE-SPEC			pic  X(09).
	    04  CL-FS-BLOCK-NO			usage index.
	    04  CL-FS-RECORD-NO			usage index.
	    04  CL-FS-FILE-NAME			pic  X(30).
	    04  CL-FS-TABLE-POINTER		usage index.

01	CL-FILE-NAME-PROMPT		display-7
					pic  X(27)
	value 'Listing file             > '.

01	WSS-COPY-INDS			DISPLAY-7.
*NOTE THAT THE FOLLOWING VALUES ARE MEANT TO INCLUDE ALL POSSIBLE
*COMBINATIONS OF TABS AND SPACES PRECEDING AND TRAILING THE 'COPY'
*COMMAND IN A LISTING.  IND1 HAS LEADING AND TRAILING SPACE, IND2 HAS
*LEADING AND TRAILING TAB, IND3 HAS LEADING TAB AND TRAILING SPACE AND
*IND4 HAS LEADING SPACE AND TRAILING TAB.
	02  WSS-COPY-IND1		PIC X(06) VALUE ' COPY '.
	02  WSS-COPY-IND2		PIC X(06) VALUE '	COPY	'.
	02  WSS-COPY-IND3		PIC X(06) VALUE '	COPY '.
	02  WSS-COPY-IND4		PIC X(06) VALUE ' COPY	'.

01	FILE-LANGUAGE-FILE-CONTROL	DISPLAY-6.
	02  FILE-LANG-STAT		PIC  S9(01) COMP VALUE 0.
	    88	FILE-LANG-OPEN		VALUE 1.
	02  FILE-LANGUAGE-SEL-NAME	PIC  X(30).
	02  FILE-LANGUAGE-FILE-ID.
	    04  FILE-LANGUAGE-FILE-NAME	pic  X(06).
	    04  FILE-LANGUAGE-FILE-EXT	pic  X(03).
	02  FL-FILE-STATUS.
	    04  FL-FS-STATUS			pic  9(02).
		88  FL-FS-STATUS-NORMAL			value 00.
		88  FL-FS-STATUS-EOF			value 10.
		88  FL-FS-STATUS-DUPLICATE-KEY		value 22.
		88  FL-FS-STATUS-NOT-FOUND		value 23.
		88  FL-FS-STATUS-OUT-OF-BOUNDS		value 24.
		88  FL-FS-STATUS-INVALID-KEY		value 22, 23, 24.
		88  FL-FS-STATUS-FATAL			value 30, 34.
	    04  FL-FS-ERROR-NO			pic  9(10).
	    04  filler redefines FL-FS-ERROR-NO.
		06  FL-FS-VERB-ERROR		pic  9(02).
		    88  FL-FS-OPEN-ERROR		value 01.
		    88  FL-FS-READ-ERROR		value 06.
		06  FL-FS-MONITOR-ERROR		pic  9(02).
		    88  FL-FS-LOOKUP-ERROR		value 03.
		06  filler			pic  9(06).
	    04  FL-FS-ACTION-CODE		usage index.
	    04  FL-FS-FILE-SPEC			pic  X(09).
	    04  FL-FS-BLOCK-NO			usage index.
	    04  FL-FS-RECORD-NO			usage index.
	    04  FL-FS-FILE-NAME			pic  X(30).
	    04  FL-FS-TABLE-POINTER		usage index.

01	WS-FILE-NAME			PIC  X(12).
 
01	FL-FILE-ID-PROMPT		DISPLAY-7
					PIC X(27)
	VALUE 'File language (.FL) name > '.
*
01	FL-SELECT-NAME-PROMPT		DISPLAY-7
					PIC X(27)
	VALUE 'Select name              > '.
*
01	PROG-HEADING			display-7
					pic  X(55)
	value 'VAG001:  File Language File Generator - Version 1'.

01	PROG-PROCESSING-FLAG		pic S9(01) comp value 0.
	88  CONTINUE-PROCESSING	value 0.
	88  PROG-PROCESSING-END		value 9.

01	TERMINAL-INPUT-SW		pic S9(01) comp.
	88  TERMINAL-INPUT	value 1.

01	TERMINAL-REPLY			pic  X(30).

01	ERROR-MESSAGE	DISPLAY-7	PIC  X(80).
 
01	VAR-VALUES.
	02  YES-VALUE			pic S9(01) comp value 1.
	02  MID-VALUE			PIC S9(01) COMP VALUE 1.
	02  NO-VALUE			pic S9(01) comp value 0.
	02  BEG-VALUE			PIC S9(01) COMP VALUE 0.
	02  END-LN-VALUE		PIC S9(01) COMP VALUE 2.
	02  END-VALUE			PIC S9(01) COMP VALUE 9.
*
01	SEARCH-STATUS-FLAG		PIC 9(01) VALUE 0.
	88  SS-SEARCH-SELECT-FILE	VALUE 0.
	88  SS-FOUND-SELECT-FILE	VALUE 1.
	88  SS-NO-SELECT-FILE		VALUE 2.
	88  SS-SEARCH-FILE-DESC		VALUE 3.
	88  SS-FOUND-FILE-DESC		VALUE 4.
	88  SS-FOUND-DATA-DESC		VALUE 5.
	88  SS-END-OF-DATA-DESC		VALUE 6.
*
01	SEARCH-STATUS-VALUES.
	05  SEARCH-SELECT-FILE		PIC S9(01) COMP VALUE 0.
	05  FOUND-SELECT-FILE		PIC S9(01) COMP VALUE 1.
	05  NO-SELECT-FILE		PIC S9(01) COMP VALUE 2.
	05  SEARCH-FILE-DESC		PIC S9(01) COMP VALUE 3.
	05  FOUND-FILE-DESC		PIC S9(01) COMP VALUE 4.
	05  FOUND-DATA-DESC		PIC S9(01) COMP VALUE 5.
	05  END-OF-DATA-DESC		PIC S9(01) COMP VALUE 6.
*
01	TBL-IDX				USAGE INDEX.
*
01	SELECT-TABLE.
*
*NOTE:	'FILE ID' IS LEVEL #1
*
	05  FILLER  PIC X(24)	VALUE 'ACCESS        005DYNAMIC'.
	05  FILLER  PIC X(24)	VALUE 'AREA          000'.
	05  FILLER  PIC X(24)	VALUE 'AREAS         000'.
	05  FILLER  PIC X(24)	VALUE 'ASSIGN        103'.
	05  FILLER  PIC X(24)	VALUE 'CHECKPOINT    000'.
	05  FILLER  PIC X(24)	VALUE 'DEFERRED      000'.
	05  FILLER  PIC X(24)	VALUE 'DYNAMIC       000'.
	05  FILLER  PIC X(24)	VALUE 'EVERY         000'.
	05  FILLER  PIC X(24)	VALUE 'FILE-STATUS   000'.
	05  FILLER  PIC X(24)	VALUE 'INDEXED       000'.
	05  FILLER  PIC X(24)	VALUE 'IS            000'.
	05  FILLER  PIC X(24)	VALUE 'KEY           000'.
	05  FILLER  PIC X(24)	VALUE 'MODE          000'.
	05  FILLER  PIC X(24)	VALUE 'ORGANIZATION  004INDEXED'.
	05  FILLER  PIC X(24)	VALUE 'RANDOM        000'.
	05  FILLER  PIC X(24)	VALUE 'RECORD        106'.
	05  FILLER  PIC X(24)	VALUE 'RECORDING     107SIXBIT'.
	05  FILLER  PIC X(24)	VALUE 'RECORDS       000'.
	05  FILLER  PIC X(24)	VALUE 'RESERVE       000'.
	05  FILLER  PIC X(24)	VALUE 'SELECT        102'.
	05  FILLER  PIC X(24)   VALUE 'SEQUENTIAL    000'.
	05  FILLER  PIC X(24)	VALUE 'TO            000'.
	05  FILLER  PIC X(24)	VALUE 'WITH          000'.
*
01	SELECT-ARRAY		REDEFINES
	SELECT-TABLE.
	05  SELECT-ENTRIES	OCCURS 23 TIMES
				INDEXED BY SEL-IDX
				ASCENDING KEY	SEL-WORD.
	    10	SEL-WORD			PIC X(14).
	    10	SEL-TYPE			PIC 9(01).
		88  SEL-OPTIONAL	VALUE 0.
		88  SEL-KEY-WORD	VALUE 1.
	    10	SEL-INDEX			PIC 9(02).
	    10	SEL-DEFAULT			PIC X(07).
*
01	FILE-TABLE.
	05  FILLER  PIC X(17)	VALUE 'ARE           000'.
	05  FILLER  PIC X(17)	VALUE 'BLOCK         108'.
	05  FILLER  PIC X(17)	VALUE 'CHARACTERS    000'.
	05  FILLER  PIC X(17)	VALUE 'CONTAINS      000'.
	05  FILLER  PIC X(17)	VALUE 'DATA          000'.
	05  FILLER  PIC X(17)	VALUE 'DATE-WRITTEN  000'.
	05  FILLER  PIC X(17)	VALUE 'FD            000'.
	05  FILLER  PIC X(17)	VALUE 'ID            000'.
	05  FILLER  PIC X(17)	VALUE 'IDENTIFICATION000'.
	05  FILLER  PIC X(17)	VALUE 'IS            000'.
	05  FILLER  PIC X(17)	VALUE 'LABEL         000'.
	05  FILLER  PIC X(17)	VALUE 'MODE          000'.
	05  FILLER  PIC X(17)	VALUE 'OF            000'.
	05  FILLER  PIC X(17)	VALUE 'RECORD        000'.
	05  FILLER  PIC X(17)	VALUE 'RECORDING     107'.
	05  FILLER  PIC X(17)	VALUE 'RECORDS       000'.
	05  FILLER  PIC X(17)	VALUE 'TO            000'.
	05  FILLER  PIC X(17)	VALUE 'USER-NUMBER   000'.
	05  FILLER  PIC X(17)	VALUE 'VALUE         000'.
*
01	FILE-ARRAY		REDEFINES
	FILE-TABLE.
	05  FILE-ENTRIES	OCCURS 19 TIMES
				INDEXED BY FIL-IDX
				ASCENDING KEY	FIL-WORD.
	    10	FIL-WORD			PIC X(14).
	    10	FIL-TYPE			PIC 9(01).
		88  FIL-OPTIONAL	VALUE 0.
		88  FIL-KEY-WORD	VALUE 1.
	    10	FIL-INDEX			PIC 9(02).
*
01	DATA-TABLE.
*
*NOTE:  'LEVEL NUMBER' IS INDEX #1 -- IT'S NOT MISSING...
*       'FIELD ID    ' IS INDEX #2
*
	05  FILLER  PIC X(26)	VALUE 'ASCENDING      111'.
	05  FILLER  PIC X(26)	VALUE 'BLANK          016ZERO'.
	05  FILLER  PIC X(26)	VALUE 'BY             000'.
	05  FILLER  PIC	X(26)	VALUE 'COMP           005COMP'.
	05  FILLER  PIC X(26)	VALUE 'COMP-1         005COMP-1'.
	05  FILLER  PIC X(26)	VALUE 'COMP-3         005COMP-3'.
	05  FILLER  PIC X(26)	VALUE 'COMPUTATIONAL  005COMP'.
	05  FILLER  PIC X(26)	VALUE 'COMPUTATIONAL-1005COMP-1'.
	05  FILLER  PIC X(26)	VALUE 'COMPUTATIONAL-3005COMP-3'.
	05  FILLER  PIC X(26)	VALUE 'DEPENDING      110'.
	05  FILLER  PIC X(26)	VALUE 'DESCENDING     112'.
	05  FILLER  PIC X(26)	VALUE 'DISPLAY        005DISPLAY'.
	05  FILLER  PIC X(26)	VALUE 'DISPLAY-6      005DISPLAY'.
	05  FILLER  PIC X(26)	VALUE 'DISPLAY-7      005DISPLAY'.
	05  FILLER  PIC X(26)	VALUE 'INDEX          005INDEX'.
	05  FILLER  PIC X(26)	VALUE 'INDEXED        113'.
	05  FILLER  PIC X(26)	VALUE 'IS             000'.
	05  FILLER  PIC X(26)	VALUE 'JUST           115'.
	05  FILLER  PIC X(26)	VALUE 'JUSTIFIED      115'.
	05  FILLER  PIC X(26)	VALUE 'KEY            000'.
	05  FILLER  PIC X(26)	VALUE 'OCCURS         108'.
	05  FILLER  PIC X(26)	VALUE 'ON             000'.
	05  FILLER  PIC X(26)	VALUE 'PIC            104'.
	05  FILLER  PIC X(26)	VALUE 'PICTURE        104'.
	05  FILLER  PIC X(26)	VALUE 'REDEFINES      103'.
	05  FILLER  PIC X(26)	VALUE 'SEPARATE       007SEPARATE'.
	05  FILLER  PIC X(26)	VALUE 'SIGN           106'.
	05  FILLER  PIC X(26)	VALUE 'SYNC           114'.
	05  FILLER  PIC X(26)	VALUE 'SYNCHRONIZED   114'.
	05  FILLER  PIC X(26)	VALUE 'TIMES          000'.
	05  FILLER  PIC X(26)	VALUE 'TO             109'.
	05  FILLER  PIC X(26)	VALUE 'USAGE          105'.
	05  FILLER  PIC X(26)	VALUE 'VALUE          117'.
	05  FILLER  PIC	X(26)	VALUE 'VALUES         117'.
	05  FILLER  PIC X(26)	VALUE 'WHEN           000'.
*
01	DATA-ARRAY		REDEFINES
	DATA-TABLE.
	05  DATA-ENTRIES	OCCURS 35 TIMES
				INDEXED BY DTA-IDX
				ASCENDING KEY	DTA-WORD.
	    10	DTA-WORD			PIC X(15).
	    10	DTA-TYPE			PIC 9(01).
		88  DTA-OPTIONAL	VALUE 0.
		88  DTA-KEY-WORD	VALUE 1.
	    10	DTA-INDEX			PIC 9(02).
	    10	DTA-DEFAULT			PIC X(08).
*
01	CL-KEY-WORD			PIC X(30).
	88  SELECT-KEY-WORD		VALUE 'SELECT'.
	88  DATA-KEY-WORD		VALUE 'DATA'.
	88  FILE-KEY-WORD		VALUE 'FD'.
01	CL-KEY-TEST			REDEFINES
	CL-KEY-WORD.
	05  CL-KEY-NUM-TEST			PIC X(02).
	05  FILLER				PIC X(28).
*
01	LINE-POINTERS.
	02  SOURCE-CODE-PTR		pic S9(03) comp.
	02  FILE-LANG-PTR		pic S9(03) comp.
	02  MAX-SOURCE-CODE-PTR		pic S9(03) comp value 105.

01	WS-SPECIAL-CHARACTERS		pic S9(10) comp value 3090.
01	filler	redefines	WS-SPECIAL-CHARACTERS	display-7.
	02  filler			pic  X(03).
	02  WS-PAGE-EJECT		pic  X(01).
	02  WS-TAB			pic  X(01).
*
01	TABLE-FOUND-SW			PIC S9(01)	COMP.
	88  TABLE-NOT-FOUND		VALUE 0.
	88  TABLE-FOUND			VALUE 1.

01 TALLY				pic  9(10) COMP.
*
01	WSS-FIELD-COUNT			USAGE INDEX.
*
01	WSS-FILE-INFO.
	05  WSS-FILE-DATA		PIC X(30)
					OCCURS 17
			INDEXED BY	FL-INDEX.
 
01	WSS-FILE-ARR.
	05  WSS-FILE-ARRAY		PIC X(01)
					OCCURS 30
					INDEXED BY ARR-IDX.
*
01	WSS-SENTENCE-STAT-FL		PIC S9(01)	COMP.
	88  WSS-BEG-SENTENCE	VALUE 0.
	88  WSS-MID-SENTENCE	VALUE 1.
	88  WSS-END-SEN-LINE	VALUE 2, 9.
	88  WSS-END-SENTENCE	VALUE 9.
*
01	WSS-END-OF-LINE-SW		PIC S9(01)	COMP.
	88  WSS-END-OF-LINE	VALUE 1.
*
01	WSS-FILLER-TRANS.
	05  FILLER			PIC  X(03)	VALUE 'FIL'.
	05  WSS-FILLER-IDX		PIC  9(03)	VALUE 0.

01	WSS-HELP-CHECK			PIC  X(30).
	88  WSS-HELP		VALUE 'HELP', 'Help', 'help', 'H', 'h', '?'.
 
01	COBOL-LISTING-SIXBIT		PIC X(105).
PROCEDURE DIVISION.
*==================

DECLARATIVES.
*------------

D100-INPUT-ERROR SECTION.	use after standard error procedure on COBOL-LISTING-FILE.

D110-INPUT-ERROR.
	If  CL-FS-OPEN-ERROR
	    SET COBOL-LISTING-STAT	TO NO-VALUE
	    If  CL-FS-LOOKUP-ERROR
		display space
		display '% File ['
		COBOL-LISTING-FILE-NAME '.' COBOL-LISTING-FILE-EXT
			'] not found.'
		display space
		set TERMINAL-INPUT-SW	TO YES-VALUE
		set CL-FS-ACTION-CODE	TO 1
	    else
		display space
		display '? Fatal error on file ['
			COBOL-LISTING-FILE-NAME '.' COBOL-LISTING-FILE-EXT
			'].'
		display '	(File Status / Error Number = '
			CL-FS-STATUS ' / ' CL-FS-ERROR-NO ')'.



END DECLARATIVES.
*----------------

THE-PROGRAM SECTION.

0000-PROG-MAIN-LOGIC.
	perform				0100-INITIALIZE.
	PERFORM				0200-WHOLE-PROCESS
	    UNTIL NOT CONTINUE-PROCESSING.
	PERFORM				0300-TERMINATE.
	STOP RUN.
 
0100-INITIALIZE.
	set COBOL-LISTING-END-SW,
	    PROG-PROCESSING-FLAG	to 0.
	display SPACE.
	display PROG-HEADING.
	DISPLAY SPACE.

0200-WHOLE-PROCESS.
	SET TERMINAL-INPUT-SW		TO YES-VALUE.
	PERFORM				9300-COLLECT-TERMINAL
	    UNTIL NOT TERMINAL-INPUT.
	IF CONTINUE-PROCESSING
	    SET TERMINAL-INPUT-SW	TO YES-VALUE
	    SET SEARCH-STATUS-FLAG
		COBOL-LISTING-END-SW	TO 0
	    PERFORM			0210-FILE-LANG-PROCESS
		UNTIL	NOT CONTINUE-PROCESSING
		SET PROG-PROCESSING-FLAG	TO 0.
 
0210-FILE-LANG-PROCESS.
	PERFORM				9000-OBTAIN-FILE-LANG-NAMES
	    UNTIL	NOT TERMINAL-INPUT.
	IF  CONTINUE-PROCESSING
	    PERFORM			9315-OPEN-CL
	    SET WSS-SENTENCE-STAT-FL	TO END-VALUE
	    perform			8000-READ-LISTING
	    perform			0800-PROCESS-LISTING
		UNTIL NOT CONTINUE-PROCESSING
	    SET TERMINAL-INPUT-SW	TO 1.

0300-TERMINATE.
	IF  COBOL-LISTING-OPEN
	    close	COBOL-LISTING-FILE.
	IF  FILE-LANG-OPEN
	    CLOSE FILE-LANGUAGE-FILE.
*
0800-PROCESS-LISTING.
	IF  (NOT CLR-COMMENT-LINE)
	AND COBOL-LISTING-RECORD NOT = SPACES
	    PERFORM			9100-UNSTRING-COBOL-LISTING
	    IF	SS-SEARCH-SELECT-FILE
		PERFORM			1000-SEARCH-SELECT
	    ELSE
	    IF SS-FOUND-SELECT-FILE
		PERFORM			1100-FOUND-SELECT
	    ELSE
	    IF	SS-SEARCH-FILE-DESC
		PERFORM			1200-SEARCH-FILE
	    ELSE
	    IF	SS-FOUND-FILE-DESC
		PERFORM			1300-FOUND-FILE
	    ELSE
	    IF	SS-FOUND-DATA-DESC
		PERFORM			1400-FOUND-DATA
	    ELSE
		NEXT SENTENCE
	ELSE
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE.
	IF SS-NO-SELECT-FILE
	OR SS-END-OF-DATA-DESC
	OR COBOL-LISTING-END
	    SET TERMINAL-INPUT-SW	TO YES-VALUE
	    PERFORM			9000-OBTAIN-FILE-LANG-NAMES
		UNTIL	NOT TERMINAL-INPUT
	    IF CONTINUE-PROCESSING
		SET COBOL-LISTING-END-SW
		    SEARCH-STATUS-FLAG	TO 0
		PERFORM			9315-OPEN-CL
		PERFORM			8000-READ-LISTING
	    ELSE
		SET COBOL-LISTING-END-SW TO YES-VALUE
	ELSE
	IF  WSS-END-OF-LINE
	    SET WSS-END-OF-LINE-SW	TO NO-VALUE
	    PERFORM			8000-READ-LISTING.
*
1000-SEARCH-SELECT.
	IF  DATA-KEY-WORD
	    SET SEARCH-STATUS-FLAG	TO NO-SELECT-FILE
	    DISPLAY SPACE
	    MOVE SPACES			TO ERROR-MESSAGE
	    STRING 'Select name '	DELIMITED BY SIZE
		FILE-LANGUAGE-SEL-NAME	DELIMITED BY SPACE
		' not found.'		DELIMITED BY SIZE
		INTO			ERROR-MESSAGE
	    DISPLAY ERROR-MESSAGE
	    DISPLAY SPACE
	ELSE
	IF  NOT SELECT-KEY-WORD
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	ELSE
	    PERFORM			9100-UNSTRING-COBOL-LISTING
	    IF  CL-KEY-WORD NOT = FILE-LANGUAGE-SEL-NAME
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    ELSE
		SET SEARCH-STATUS-FLAG	TO FOUND-SELECT-FILE
		DISPLAY SPACE
		DISPLAY 'Creating ' WS-FILE-NAME
		DISPLAY SPACE
		IF  FILE-LANG-OPEN
		    CLOSE FILE-LANGUAGE-FILE
		    SET FILE-LANG-STAT	TO NO-VALUE
		    OPEN OUTPUT		FILE-LANGUAGE-FILE
		    SET FILE-LANG-STAT	TO YES-VALUE
		    IF  WSS-END-OF-LINE
			STRING 'IMAGE,SELECT,'	DELIMITED BY SIZE
			    COBOL-LISTING-RECORD	DELIMITED BY SIZE
					INTO FILE-LANGUAGE-RECORD
			PERFORM		8100-WRITE-FILE-LANGUAGE-FILE
		    ELSE
			NEXT SENTENCE
		ELSE
		    OPEN OUTPUT		FILE-LANGUAGE-FILE
		    SET FILE-LANG-STAT	TO YES-VALUE
		    IF  WSS-END-OF-LINE
			STRING 'IMAGE,SELECT,'	DELIMITED BY SIZE
			    COBOL-LISTING-RECORD	DELIMITED BY SIZE
					INTO FILE-LANGUAGE-RECORD
			PERFORM		8100-WRITE-FILE-LANGUAGE-FILE.
	IF  SS-FOUND-SELECT-FILE
	    IF	TALLY > 0
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
		MOVE 2			TO FL-INDEX
		MOVE FILE-LANGUAGE-SEL-NAME	TO WSS-FILE-DATA(FL-INDEX)
		PERFORM			9900-DELIMIT
		MOVE 0			TO FL-INDEX
		SET SEARCH-STATUS-FLAG	TO SEARCH-FILE-DESC.
*
1100-FOUND-SELECT.
	SET TABLE-FOUND-SW		TO NO-VALUE.
	SEARCH ALL SELECT-ENTRIES
	    WHEN CL-KEY-WORD = SEL-WORD(SEL-IDX)
		SET TABLE-FOUND-SW	TO YES-VALUE.
	IF TABLE-FOUND
	    IF SEL-OPTIONAL(SEL-IDX)
		IF  SEL-INDEX(SEL-IDX) > 0
		    MOVE SEL-INDEX(SEL-IDX)	TO FL-INDEX
		    MOVE SEL-DEFAULT(SEL-IDX)	TO WSS-FILE-DATA(FL-INDEX)
		    PERFORM			9900-DELIMIT
		    MOVE 0		TO FL-INDEX
		ELSE
		    NEXT SENTENCE
	    ELSE
	    IF  SEL-KEY-WORD(SEL-IDX)
		MOVE SEL-INDEX(SEL-IDX)	TO FL-INDEX
	    ELSE
		NEXT SENTENCE
	ELSE
	IF FL-INDEX > 0
	    MOVE CL-KEY-WORD	TO WSS-FILE-DATA(FL-INDEX)
	    PERFORM		9900-DELIMIT
	    MOVE 0		TO FL-INDEX.
	IF TALLY > 0
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    MOVE 2			TO FL-INDEX
	    MOVE FILE-LANGUAGE-SEL-NAME TO WSS-FILE-DATA(FL-INDEX)
	    PERFORM			9900-DELIMIT
	    MOVE 0			TO FL-INDEX
	    SET SEARCH-STATUS-FLAG	TO SEARCH-FILE-DESC.
	IF WSS-END-OF-LINE
	    STRING 'IMAGE,SELECT,'	DELIMITED BY SIZE
	    COBOL-LISTING-RECORD	DELIMITED BY SIZE
					INTO FILE-LANGUAGE-RECORD
	    PERFORM			8100-WRITE-FILE-LANGUAGE-FILE.
*
1200-SEARCH-FILE.
	IF  NOT FILE-KEY-WORD
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	ELSE
	    PERFORM			9100-UNSTRING-COBOL-LISTING
	    IF	CL-KEY-WORD NOT = FILE-LANGUAGE-SEL-NAME
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    ELSE
		SET SEARCH-STATUS-FLAG	TO FOUND-FILE-DESC
		IF  WSS-END-OF-LINE
		    STRING 'IMAGE,FD,'	DELIMITED BY SIZE
			COBOL-LISTING-RECORD	DELIMITED BY SIZE
					INTO FILE-LANGUAGE-RECORD
		    PERFORM		8100-WRITE-FILE-LANGUAGE-FILE.
	IF  SS-FOUND-FILE-DESC
	AND TALLY > 0
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    SET FILE-LANG-PTR		TO 1
	    STRING 'MODULE,'		DELIMITED BY SIZE
	    FILE-LANGUAGE-FILE-NAME	DELIMITED BY SPACE
		INTO			FILE-LANGUAGE-RECORD
		WITH POINTER		FILE-LANG-PTR
	    SET FL-INDEX		TO 1
	    IF	WSS-FILE-DATA(7) = SPACES
		MOVE 'SIXBIT@'		TO WSS-FILE-DATA(7)
		PERFORM			9200-FINAL-OUTPUT-FORMAT
		    7 TIMES
		MOVE 0			TO FL-INDEX
		PERFORM			8100-WRITE-FILE-LANGUAGE-FILE
		MOVE SPACES		TO WSS-FILE-INFO
		SET SEARCH-STATUS-FLAG	TO FOUND-DATA-DESC
	    ELSE
		PERFORM			9200-FINAL-OUTPUT-FORMAT
		    7 TIMES
		MOVE 0			TO FL-INDEX
		PERFORM			8100-WRITE-FILE-LANGUAGE-FILE
		MOVE SPACES		TO WSS-FILE-INFO
		SET SEARCH-STATUS-FLAG	TO FOUND-DATA-DESC.
*
1300-FOUND-FILE.
	SET TABLE-FOUND-SW		TO NO-VALUE.
	SEARCH ALL FILE-ENTRIES
	    WHEN CL-KEY-WORD = FIL-WORD(FIL-IDX)
		SET TABLE-FOUND-SW	TO YES-VALUE.
	IF TABLE-FOUND
	    IF FIL-OPTIONAL(FIL-IDX)
		NEXT SENTENCE
	    ELSE
	    IF  FIL-KEY-WORD(FIL-IDX)
		MOVE FIL-INDEX(FIL-IDX)	TO FL-INDEX
	    ELSE
		NEXT SENTENCE
	ELSE
	IF FL-INDEX > 0
	    MOVE CL-KEY-WORD	TO WSS-FILE-DATA(FL-INDEX)
	    PERFORM		9900-DELIMIT
	    MOVE 0		TO FL-INDEX.
	IF TALLY > 0
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    SET FILE-LANG-PTR		TO 1
	    STRING 'MODULE,'		DELIMITED BY SIZE
	    FILE-LANGUAGE-FILE-NAME	DELIMITED BY SPACE
		INTO			FILE-LANGUAGE-RECORD
		WITH POINTER		FILE-LANG-PTR
	    SET FL-INDEX		TO 1
	    IF	WSS-FILE-DATA(7) = SPACES
		MOVE 'SIXBIT@'		TO WSS-FILE-DATA(7)
		PERFORM			9200-FINAL-OUTPUT-FORMAT
		    7 TIMES
		MOVE 0			TO FL-INDEX
		PERFORM			8100-WRITE-FILE-LANGUAGE-FILE
		MOVE SPACES		TO WSS-FILE-INFO
		SET SEARCH-STATUS-FLAG	TO FOUND-DATA-DESC
	    ELSE
		PERFORM			9200-FINAL-OUTPUT-FORMAT
		    7 TIMES
		MOVE 0			TO FL-INDEX
		PERFORM			8100-WRITE-FILE-LANGUAGE-FILE
		MOVE SPACES		TO WSS-FILE-INFO
		SET SEARCH-STATUS-FLAG	TO FOUND-DATA-DESC.
	IF WSS-END-OF-LINE
	    STRING 'IMAGE,FD,'		DELIMITED BY SIZE
	    COBOL-LISTING-RECORD	DELIMITED BY SIZE
					INTO FILE-LANGUAGE-RECORD
	    PERFORM			8100-WRITE-FILE-LANGUAGE-FILE.
*
1400-FOUND-DATA.
	SET WSS-END-OF-LINE-SW		TO NO-VALUE.
*&	IF  TALLY > 0
	IF  WSS-END-SENTENCE
	    SET WSS-SENTENCE-STAT-FL	TO BEG-VALUE
	ELSE
	    SET WSS-SENTENCE-STAT-FL	TO MID-VALUE.
	IF CL-KEY-WORD = 'FD' OR 'WORKING-STORAGE' OR 'PROCEDURE'
	    SET SEARCH-STATUS-FLAG	TO END-OF-DATA-DESC
	ELSE
	    PERFORM			1410-REST-OF-DATA-LINE
		UNTIL			WSS-END-SEN-LINE.
*
1410-REST-OF-DATA-LINE.
	SET TABLE-FOUND-SW		TO NO-VALUE.
	IF CL-KEY-NUM-TEST NUMERIC AND WSS-BEG-SENTENCE
	    MOVE 1			TO FL-INDEX
	    SET WSS-SENTENCE-STAT-FL	TO MID-VALUE
	    MOVE CL-KEY-WORD		TO WSS-FILE-DATA(FL-INDEX)
	    PERFORM			9900-DELIMIT
	    SET FL-INDEX		TO 2
	ELSE
	IF FL-INDEX = 2
	    PERFORM			1415-FILLER-TEST
	    MOVE CL-KEY-WORD		TO WSS-FILE-DATA(FL-INDEX)
	    PERFORM			9900-DELIMIT
	    MOVE 0			TO FL-INDEX
	ELSE
	    SEARCH ALL DATA-ENTRIES
		WHEN CL-KEY-WORD = DTA-WORD(DTA-IDX)
		    SET TABLE-FOUND-SW	TO YES-VALUE.
	IF WSS-END-OF-LINE
	    SET WSS-SENTENCE-STAT-FL	TO END-LN-VALUE.
	IF TABLE-FOUND
	    IF DTA-OPTIONAL(DTA-IDX)
		IF  DTA-INDEX(DTA-IDX) > 0
		    MOVE DTA-INDEX(DTA-IDX)	TO FL-INDEX
		    MOVE DTA-DEFAULT(DTA-IDX)	TO WSS-FILE-DATA(FL-INDEX)
		    PERFORM		9900-DELIMIT
		    MOVE 0		TO FL-INDEX
		ELSE
		    NEXT SENTENCE
	    ELSE
	    IF  DTA-KEY-WORD(DTA-IDX)
		MOVE DTA-INDEX(DTA-IDX)	TO FL-INDEX
	    ELSE
		NEXT SENTENCE
	ELSE
	IF FL-INDEX > 0 AND NOT = 2
	    MOVE CL-KEY-WORD	TO WSS-FILE-DATA(FL-INDEX)
	    PERFORM		9900-DELIMIT
	    MOVE 0		TO FL-INDEX.
	IF TALLY > 0
	    SET WSS-SENTENCE-STAT-FL	TO END-VALUE
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    SET FILE-LANG-PTR		TO 1
	    STRING 'FIELD'		DELIMITED BY SIZE
		INTO			FILE-LANGUAGE-RECORD
		WITH POINTER		FILE-LANG-PTR
	    SET FL-INDEX		TO 0
	    PERFORM			9200-FINAL-OUTPUT-FORMAT
		17 TIMES
	    MOVE 0			TO FL-INDEX
	    STRING ','			DELIMITED BY SIZE
		COBOL-LISTING-RECORD	DELIMITED BY SIZE
		INTO			FILE-LANGUAGE-RECORD
		WITH POINTER		FILE-LANG-PTR
	    PERFORM			8100-WRITE-FILE-LANGUAGE-FILE
	    MOVE SPACES			TO WSS-FILE-INFO
	ELSE
	IF  WSS-END-OF-LINE
	    SET WSS-SENTENCE-STAT-FL	TO END-LN-VALUE
	    STRING 'FIELD,00,NONE,NONE,NONE,NONE,NONE,NONE,'
		DELIMITED		BY SIZE
		'NONE,NONE,NONE,NONE,NONE,NONE,NONE,NONE,NONE,NONE,'
		DELIMITED		BY SIZE
		COBOL-LISTING-RECORD	DELIMITED BY SIZE
		INTO			FILE-LANGUAGE-RECORD
	    PERFORM			8100-WRITE-FILE-LANGUAGE-FILE
	ELSE
	IF NOT WSS-END-OF-LINE
	    PERFORM			9100-UNSTRING-COBOL-LISTING.
 
1415-FILLER-TEST.
	IF CL-KEY-WORD = 'FILLER'
	    SET WSS-FILLER-IDX UP	BY 1
	    MOVE WSS-FILLER-TRANS	TO CL-KEY-WORD
	    MOVE COBOL-LISTING-RECORD	TO COBOL-LISTING-SIXBIT
	    INSPECT COBOL-LISTING-SIXBIT
		REPLACING 'FILLER'	BY WSS-FILLER-TRANS
	    MOVE COBOL-LISTING-SIXBIT	TO COBOL-LISTING-RECORD.
8000-READ-LISTING.
	PERFORM				8010-DO-READ.
	IF CLR-NUM-TEST NOT NUMERIC
	    PERFORM			8010-DO-READ
		2 TIMES.
	IF NOT COBOL-LISTING-END
	    MOVE CLR-BODY		TO COBOL-LISTING-RECORD
	    PERFORM			8020-REMOVE-ANY-COPY-STMT.
	PERFORM				8030-SPACE-TAB-CHECK.
*
8010-DO-READ.
	SET COBOL-LISTING-PTR		TO 1.
	IF NOT COBOL-LISTING-END
	    READ	COBOL-LISTING-FILE
		AT END
		    SET COBOL-LISTING-END-SW TO YES-VALUE.
	IF  COBOL-LISTING-END
	    SET PROG-PROCESSING-FLAG	TO 9.
*
8020-REMOVE-ANY-COPY-STMT.
	INSPECT COBOL-LISTING-RECORD REPLACING
	    ALL			','	      BY SPACES
	    ALL			WSS-COPY-IND1 BY SPACES
	    ALL			WSS-COPY-IND2 BY SPACES
	    ALL			WSS-COPY-IND3 BY SPACES
	    ALL			WSS-COPY-IND4 BY SPACES
	    CHARACTERS BY SPACES AFTER INITIAL WSS-COPY-IND1
	    CHARACTERS BY SPACES AFTER INITIAL WSS-COPY-IND2
	    CHARACTERS BY SPACES AFTER INITIAL WSS-COPY-IND3
	    CHARACTERS BY SPACES AFTER INITIAL WSS-COPY-IND3.
*
8030-SPACE-TAB-CHECK.
	PERFORM				9110-EAT-SPACES
	    UNTIL	COBOL-LISTING-PTR > MAX-SOURCE-CODE-PTR
	    OR	(COBOL-LISTING-WORK(COBOL-LISTING-PTR) NOT = SPACE
	    AND COBOL-LISTING-WORK(COBOL-LISTING-PTR) NOT = WS-TAB).
	IF COBOL-LISTING-PTR > MAX-SOURCE-CODE-PTR
	    MOVE SPACES			TO COBOL-LISTING-RECORD.
*
8100-WRITE-FILE-LANGUAGE-FILE.
	PERFORM				9999-DO-NOTHING
	    VARYING VAR-IDX FROM 375 BY -1
	    UNTIL FILE-LANGUAGE-VAR(VAR-IDX) NOT = SPACE
	       OR VAR-IDX = 1.
	WRITE	FILE-LANGUAGE-2		BEFORE ADVANCING 1.
	MOVE SPACES			TO FILE-LANGUAGE-RECORD.
*
9000-OBTAIN-FILE-LANG-NAMES.
	PERFORM				9010-OBTAIN-SHORT-NAME
		UNTIL	NOT TERMINAL-INPUT.
	IF CONTINUE-PROCESSING
	    SET TERMINAL-INPUT-SW	TO YES-VALUE
	    PERFORM			9020-OBTAIN-SEL-NAME
		UNTIL	NOT TERMINAL-INPUT
		IF  NOT CONTINUE-PROCESSING
		    SET PROG-PROCESSING-FLAG	TO 0
		    SET TERMINAL-INPUT-SW	TO YES-VALUE.
 
9010-OBTAIN-SHORT-NAME.
	DISPLAY	FL-FILE-ID-PROMPT	WITH NO ADVANCING.
	ACCEPT	TERMINAL-REPLY.
	IF  TERMINAL-REPLY = SPACE
	    SET TERMINAL-INPUT-SW	TO NO-VALUE
	    SET PROG-PROCESSING-FLAG	TO 9
	ELSE
	    MOVE TERMINAL-REPLY		TO WSS-HELP-CHECK
	    IF	WSS-HELP
		DISPLAY '  Enter the short name of the file to be converted'
		DISPLAY '  Default extension is .FL'
	    ELSE
		SET TERMINAL-INPUT-SW	TO NO-VALUE
		UNSTRING TERMINAL-REPLY
		    DELIMITED BY	'.'
		    INTO		FILE-LANGUAGE-FILE-NAME,
					FILE-LANGUAGE-FILE-EXT
		IF  FILE-LANGUAGE-FILE-EXT = SPACE
		    MOVE 'FL'		TO FILE-LANGUAGE-FILE-EXT.
 
9020-OBTAIN-SEL-NAME.
	    DISPLAY	FL-SELECT-NAME-PROMPT
		WITH NO ADVANCING
	    ACCEPT	TERMINAL-REPLY
	    IF  TERMINAL-REPLY = SPACE
		SET TERMINAL-INPUT-SW	TO NO-VALUE
		SET PROG-PROCESSING-FLAG	TO 9
	    ELSE
		MOVE TERMINAL-REPLY	TO WSS-HELP-CHECK
		IF  WSS-HELP
		    DISPLAY '  Enter the name of the file to be converted exactly as it appears in the'
		    DISPLAY '  SELECT statement of the .LST file'
		ELSE
		    SET TERMINAL-INPUT-SW	TO NO-VALUE
		    UNSTRING TERMINAL-REPLY
			DELIMITED BY	ALL SPACES
			INTO		FILE-LANGUAGE-SEL-NAME
		    MOVE SPACE			TO WS-FILE-NAME
		    STRING FILE-LANGUAGE-FILE-NAME	DELIMITED BY SPACE
			   '.'			DELIMITED BY SIZE
			   FILE-LANGUAGE-FILE-EXT	DELIMITED BY SPACE
			   INTO		WS-FILE-NAME.
*
9100-UNSTRING-COBOL-LISTING.
	MOVE SPACES			TO CL-KEY-WORD.
	PERFORM				9110-EAT-SPACES
	    UNTIL	COBOL-LISTING-PTR > MAX-SOURCE-CODE-PTR
	    OR	(COBOL-LISTING-WORK(COBOL-LISTING-PTR) NOT = SPACE
	    AND COBOL-LISTING-WORK(COBOL-LISTING-PTR) NOT = WS-TAB).
	IF COBOL-LISTING-PTR > MAX-SOURCE-CODE-PTR
	    NEXT SENTENCE
	ELSE
	IF FL-INDEX NOT = 17
	    UNSTRING COBOL-LISTING-RECORD
		DELIMITED BY		ALL WS-TAB OR ALL SPACE
					OR ';' OR ','
		INTO			CL-KEY-WORD
		WITH POINTER		COBOL-LISTING-PTR
	ELSE
	    UNSTRING COBOL-LISTING-RECORD
		INTO			CL-KEY-WORD
		WITH POINTER		COBOL-LISTING-PTR.
	SET TALLY			TO 0.
	INSPECT CL-KEY-WORD	TALLYING TALLY FOR ALL '.'
	    REPLACING ALL '.'	BY SPACES.
	IF  COBOL-LISTING-PTR > MAX-SOURCE-CODE-PTR
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE.

9110-EAT-SPACES.
	SET	COBOL-LISTING-PTR	UP BY 1.
*
9200-FINAL-OUTPUT-FORMAT.
	STRING ','			DELIMITED BY SIZE
	    INTO			FILE-LANGUAGE-RECORD
	    WITH POINTER		FILE-LANG-PTR.
	SET FL-INDEX UP			BY 1.
	IF WSS-FILE-DATA(FL-INDEX) = SPACES
	    IF FL-INDEX = 1
		MOVE '00@'		TO WSS-FILE-DATA(FL-INDEX)
	    ELSE
		MOVE 'NONE@'		TO WSS-FILE-DATA(FL-INDEX).
	STRING WSS-FILE-DATA(FL-INDEX)	DELIMITED BY '@'
	    INTO			FILE-LANGUAGE-RECORD
	    WITH POINTER		FILE-LANG-PTR.

9300-COLLECT-TERMINAL.
	display CL-FILE-NAME-PROMPT
		WITH NO ADVANCING.
	accept	TERMINAL-REPLY.
	If  TERMINAL-REPLY = SPACE
	    set PROG-PROCESSING-FLAG	to 9
	    set COBOL-LISTING-END-SW	to YES-VALUE
	    set TERMINAL-INPUT-SW	to NO-VALUE
	else
	    MOVE TERMINAL-REPLY		TO WSS-HELP-CHECK
	    IF	WSS-HELP
		DISPLAY '  Enter the name of the COBOL listing to be read - default extension .LST'
	    ELSE
		perform			9310-OBTAIN-CL.

9310-OBTAIN-CL.
	unstring TERMINAL-REPLY
		delimited by		'.'
		into			COBOL-LISTING-FILE-ID,
					COBOL-LISTING-FILE-EXT.
	If  COBOL-LISTING-FILE-EXT = SPACE
	    move 'LST'			to COBOL-LISTING-FILE-EXT.
	set TERMINAL-INPUT-SW		to NO-VALUE.
	PERFORM				9315-OPEN-CL.
 
9315-OPEN-CL.
	IF  COBOL-LISTING-OPEN
	    CLOSE COBOL-LISTING-FILE
	    SET COBOL-LISTING-STAT	TO NO-VALUE.
	SET COBOL-LISTING-STAT		TO YES-VALUE.
	open	INPUT			COBOL-LISTING-FILE.

*
9900-DELIMIT.
	MOVE WSS-FILE-DATA(FL-INDEX)	TO WSS-FILE-ARR.
	PERFORM				9999-DO-NOTHING
	    VARYING ARR-IDX FROM 30	BY -1
	    UNTIL WSS-FILE-ARRAY(ARR-IDX) NOT = SPACE
	       OR ARR-IDX = 1.
	IF  ARR-IDX < 30
	    SET ARR-IDX			UP BY 1
	    MOVE '@'			TO WSS-FILE-ARRAY(ARR-IDX).
	MOVE WSS-FILE-ARR		TO WSS-FILE-DATA(FL-INDEX).
 
9999-DO-NOTHING.