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

IDENTIFICATION DIVISION.
*=======================
 
/START
Program-Id.	{Modnm}.
 
Date-Written.	{%Date}.
 
Date-Compiled.
 
Installation.	Paper Free Systems, Inc
		320 Parnassus
		San Francisco, CA  94117
 
*--------------
*Program Title:
*--------------
*
*	System: ISACON DEC to VAX Conversion
*	Module: {Modnm}.CBL -- Convert {Filnm} from ISAM to SEQ format
*
/END
*
*--------------------
*Standard Procedures:
*--------------------
*
*	Program Skeleton:  UNLOAD.SKL	Version 1.0	Dated 25-Oct-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			{Modtl}
	ASSIGN TO	{Asign}
	ORGANIZATION IS	{Org}
	ACCESS MODE IS	{Acces}
	RECORD KEY IS	{Mkey} OF {Recnm}
	RECORDING MODE	{Mmode}.
 
SELECT			A-{Modtl}
	ASSIGN TO 	DSK
	ORGANIZATION IS	SEQUENTIAL
	RECORDING MODE	ASCII.
/END
/PAGE

DATA DIVISION.
*=============
 
FILE SECTION.
*------------
 
/START
FD	{Modtl}
	BLOCK CONTAINS {Mblck}	RECORDS
	VALUE OF ID IS WSS-IDX-FILE-ID.
 
/EACH-FIELD
/IF-NOT {Fdata} = NONE
{Fdata}
/END-IF
/END-FIELD
/END
 
/START
FD	A-{Modtl}
	BLOCK CONTAINS 0	RECORDS
	VALUE OF ID IS WSS-SEQ-FILE-ID.
 
/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

WORKING-STORAGE SECTION.
*-----------------------
 
01	WSS-END-OF-FILE-FLAG		PIC S9(01) COMP.
	88  WSS-END-OF-FILE		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-LEVEL-INDEXES.
	05  IDX1			PIC S9(03) COMP.
	05  IDX2			PIC S9(03) COMP.
	05  IDX3			PIC S9(03) COMP.
 
/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.
	PERFORM				0003-TERMINATE.
	STOP RUN.
 
/START
0001-INITIALIZE.
	OPEN	INPUT	{Modtl}
		OUTPUT	A-{Modtl}.
	MOVE LOW-VALUES			TO {Mkey} OF {Recnm}.
	START {Modtl}
	    KEY IS GREATER THAN {Mkey} OF {Recnm}
		INVALID KEY SET WSS-END-OF-FILE-FLAG	TO YES-VALUE.
 
0002-PROCESS-INPUT-FILE.
	PERFORM				0010-PROCESS-EACH-FIELD.
	PERFORM				9999-WRITE-OUTPUT-FILE.
	PERFORM				9995-READ-INPUT-FILE.
 
0003-TERMINATE.
	CLOSE	{Modtl}
		A-{Modtl}.
 
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 {Recnm}			{%40}TO A-{Recnm}.
/ELSE
	MOVE {Field} OF {Recnm}		{%40}TO {Field} OF A-{Recnm}.
/END-IF
/ELSE
	SET IDX1			TO 0.
	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.
	SET IDX1 UP			BY 1.
/IF {Olvl2} = NONE
	MOVE {Field} OF {Recnm} (IDX1)	{%50}TO {Field} OF A-{Recnm} (IDX1).
/ELSE
	SET IDX2			TO 0.
	PERFORM				{Fldix}2-LEVEL-2-OCCURS
	    {Olvl2} TIMES.
 
{Fldix}2-LEVEL-2-OCCURS.
	SET IDX2 UP			BY 1.
/IF {Olvl3} = NONE
	MOVE {Field} OF {Recnm} (IDX1,IDX2)	{%50}TO {Field} OF A-{Recnm} (IDX1,IDX2).
/ELSE
	SET IDX3			TO 0.
	PERFORM				{Fldix}3-LEVEL-3-OCCURS
	    {Olvl3} TIMES.
 
{Fldix}3-LEVEL-3-OCCURS.
	SET IDX3 UP			BY 1.
	MOVE {Field} OF {Recnm} (IDX1,IDX2,IDX3)	{%50}TO {Field} OF A-{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 {Modtl} NEXT RECORD
	    AT END
		SET WSS-END-OF-FILE-FLAG	TO YES-VALUE.
 
9999-WRITE-OUTPUT-FILE.
	WRITE A-{Recnm}			BEFORE ADVANCING 1.
	MOVE SPACES			TO A-{Recnm}.
/END