Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

IDENTIFICATION DIVISION.
*=======================
 
/START
Program-Id.	{Modnm}.
 
Installation.	Paper Free Systems, Inc.
		320 Parnassus
		San Francisco, CA  94117
 
Date-Written.	{%Date}.
 
Date-Compiled.
 
*--------------
*Program Title:
*--------------
*
*	System: ISACON DEC to VAX Conversion
*	Module: {Modnm}.CBL -- Convert {Filnm} from SEQ to VMS indexed
*	format
*
/END
*
*--------------------
*Standard Procedures:
*--------------------
*
*	Program Skeleton:  LOADIT.SKL	Version 1.0	Dated 08-Nov-84
*

*-----------------------------
*Program Modification History:
*-----------------------------
*	--Date--   Who	What
*
*--------------------------------------------------------
 
*	The following steps are necessary to get a clean compile:
*
*	1.  Check the file description of the indexed file for REDEFINED
*	    COMP fields or redefinitions which contain COMP items.  The
*	    alignments in the sequential file may need to be revised to
*	    ensure valid data.
*
*??	TO BE CONTINUED		??
 
/NOTE
	**** Constraints or Requirements of this Skeleton ****
	1.  You may NOT use the relational operator "{" (less than)
	    within /START thru /END code generation sections.  This
	    is due to our arbitrary selection of "{" as the left
	    delimiter for substitution variables.
 
	2.  In order for blank lines to be included in the generated
	    code, the "blank" line should actually consist of a single
	    space.  This is only necessary if the skeleton file is
	    "un-line-numbered" (by EDIT's "EU" command).
 
	3.  If you wish to have REDEFINITIONS moved from the input to
	    the output file, you must comment out the code in the SKL
	    which prevents this.  See the comments in the PROCEDURE
	    DIVISION which indicate the lines to be removed.
/END-NOTE
/PAGE

ENVIRONMENT DIVISION.
*====================
 
CONFIGURATION SECTION.
*---------------------
 
SOURCE-COMPUTER. DECSYSTEM-10.
 
OBJECT-COMPUTER. DECSYSTEM-10.
 
 
INPUT-OUTPUT SECTION.
*--------------------
 
FILE-CONTROL.
 
/START
SELECT			A-{Modtl}
	ASSIGN TO 	DSK
	ORGANIZATION IS	SEQUENTIAL.
 
SELECT			{Modtl}
	ASSIGN TO	DSK
	ORGANIZATION IS	{Org}
	ACCESS MODE IS	{Acces}
	RECORD KEY IS	{Mkey} OF {Recnm}.
/END
/PAGE

DATA DIVISION.
*=============
 
FILE SECTION.
*------------
 
/START
FD	A-{Modtl}
	VALUE OF ID	WSS-SEQ-FILE-ID
	RECORDING MODE	ASCII
	BLOCK CONTAINS	0 RECORDS.
 
/EACH-FIELD
/IF {Fldno} = 01
01	A-{Field}.
/ELSE
/IF-NOT {Fdta2} = NONE
{Fdta2}
/ELSE
/IF-NOT {Fdata} = NONE
{Fdata}
/END-IF
/END-IF
/END-IF
/END-FIELD
/END
/PAGE

/START
FD	{Modtl}
	VALUE OF ID	WSS-IDX-FILE-ID
	BLOCK CONTAINS	{Mblck} RECORDS.
 
/EACH-FIELD
/IF {Usige} = DISPLAY
/IF-NOT {Fdta2} = NONE
{Fdta2}
/ELSE
/IF-NOT {Fdata} = NONE
{Fdata}
/END-IF
/END-IF
/ELSE
/IF-NOT {Fdata} = NONE
{Fdata}
/END-IF
/END-IF
/END-FIELD
/END
/PAGE

WORKING-STORAGE SECTION.
*-----------------------
 
01	WSS-END-OF-FILE-FLAG		PIC S9(01) COMP.
	88  WSS-END-OF-FILE		VALUE 1.
 
01	WSS-ERROR-FLAG			PIC S9(01) COMP.
	88  WSS-ERROR			VALUE 1.
 
01	YES-NO-VALUES.
	05  YES-VALUE			PIC S9(01) COMP VALUE 1.
	05  NO-VALUE			PIC S9(01) COMP VALUE 0.
 
01	WSS-INDEXES.
	05  IDX1			PIC  9(03).
	05  IDX2			PIC  9(03).
	05  IDX3			PIC  9(03).
 
/START
01	WSS-IDX-FILE-ID.
	05  WSS-IDX-FILE-NAME		PIC X(06)	VALUE "{Filnm}".
	05  WSS-IDX-FILE-EXT		PIC X(03)	VALUE "IDX".
 
01	WSS-SEQ-FILE-ID.
	05  WSS-SEQ-FILE-NAME		PIC X(06)	VALUE "{Filnm}".
	05  WSS-SEQ-FILE-EXT		PIC X(03)	VALUE "SEQ".
/END
/PAGE

PROCEDURE DIVISION.
 
0000-MAIN.
	PERFORM				0001-INITIALIZE.
	IF NOT WSS-END-OF-FILE
	    PERFORM			9995-READ-INPUT-FILE
	    PERFORM			0002-PROCESS-INPUT-FILE
		UNTIL WSS-END-OF-FILE
		OR    WSS-ERROR.
	PERFORM				0003-TERMINATE.
	STOP RUN.
 
/START
0001-INITIALIZE.
	OPEN	INPUT	A-{Modtl}
		OUTPUT	{Modtl}.
	MOVE SPACES			TO {Recnm}.
 
0002-PROCESS-INPUT-FILE.
	PERFORM				0010-PROCESS-EACH-FIELD.
	IF {Recnm} NOT = SPACES
	    PERFORM			9999-WRITE-OUTPUT-FILE.
	PERFORM				9995-READ-INPUT-FILE.
 
0003-TERMINATE.
	CLOSE	A-{Modtl}
		{Modtl}.
	IF WSS-ERROR
	    DISPLAY '{Modnm} terminating in error.'
	ELSE
	    DISPLAY '{Modnm} successfully completed.'.
 
0010-PROCESS-EACH-FIELD.
/EACH-FIELD
/NOTE
Comment out the following IF statement to force move of REDEF fields.
Be sure to comment out all other statements so indicated in the SKL.
/END-NOTE
/IF {Redef} = NONE
/IF-NOT {Fldno} = 00
/IF-NOT {Fldno} = 66
/IF-NOT {Fldno} = 88
/IF-NOT {Pict} = NONE
/IF {Olvl1} = NONE
/IF {Fldno} = 01
	MOVE A-{Recnm}			{%40}TO {Recnm}.
/ELSE
	MOVE {Field} OF A-{Recnm}	{%40}TO {Field} OF {Recnm}.
/END-IF
/ELSE
	MOVE 0				TO IDX1.
	PERFORM				{Fldix}1-LEVEL-1-OCCURS
	    {Olvl1} TIMES.
/END-IF
/END-IF
/END-IF
/END-IF
/END-IF
/NOTE
Comment out the following END-IF statement to force move of REDEF fields.
Be sure to comment out all other statements so indicated in the SKL.
/END-NOTE
/END-IF
/END-FIELD
/EACH-FIELD
/NOTE
Comment out the following IF statement to force move of REDEF fields.
Be sure to comment out all other statements so indicated in the SKL.
/END-NOTE
/IF {Redef} = NONE
/IF-NOT {Olvl1} = NONE
 
{Fldix}1-LEVEL-1-OCCURS.
	ADD 1				TO IDX1.
/IF {Olvl2} = NONE
	MOVE {Field} OF A-{Recnm} (IDX1)	{%50}TO {Field} OF {Recnm} (IDX1).
/ELSE
	MOVE 0				TO IDX2.
	PERFORM				{Fldix}2-LEVEL-2-OCCURS
	    {Olvl2} TIMES.
 
{Fldix}2-LEVEL-2-OCCURS.
	ADD 1				TO IDX2.
/IF {Olvl3} = NONE
	MOVE {Field} OF A-{Recnm} (IDX1,IDX2)	{%50}TO {Field} OF {Recnm} (IDX1,IDX2).
/ELSE
	MOVE 0				TO IDX3.
	PERFORM				{Fldix}3-LEVEL-3-OCCURS
	    {Olvl3} TIMES.
 
{Fldix}3-LEVEL-3-OCCURS.
	ADD 1				TO IDX3.
	MOVE {Field} OF A-{Recnm} (IDX1,IDX2,IDX3)	{%50}TO {Field} OF {Recnm} (IDX1,IDX2,IDX3).
/END-IF
/END-IF
/END-IF
/NOTE
Comment out the following END-IF statement to force move of REDEF fields.
Be sure to comment out all other statements so indicated in the SKL.
/END-NOTE
/END-IF
/END-FIELD
 
9995-READ-INPUT-FILE.
	READ A-{Modtl}
	    AT END
		MOVE YES-VALUE			TO WSS-END-OF-FILE-FLAG.
 
9999-WRITE-OUTPUT-FILE.
	WRITE {Recnm}
	    INVALID KEY
		MOVE YES-VALUE		TO WSS-ERROR-FLAG.
	MOVE SPACES			TO {Recnm}.
/END

3Q#3;C3o3CsGc444Mc4U5/5SC5o