| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
The JCL or CMD member for running the application. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Delete any previously created STATEPUT file. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Load the table from the STATEDB1 file. Read the input file (STATECTL) containing the search type and argument. Create a new file (STATEPUT) containing the results of the searches. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
End-Of-Job |
| |
|
|
|
|
|
|
|
|
Flowchart of the Table Processing using Various Search Techniques
|
Color Associations: The light-green boxes are unique to SIMOTIME Technologies using an IBM Mainframe System or Micro Focus Enterprise Developer.
The light-red boxes are unique to the SIMOTIME Technologies using a Linux, UNIX or Windows System and COBOL Technologies such as Micro Focus.
The light-yellow boxes are SIMOTIME Technologies, Third-party Technologies, decision points or program transitions in the processing logic or program generations.
The light-blue boxes identify the input/output data structures such as Documents, Spreadsheets, Data Files, VSAM Data Sets, Partitioned Data Set Members (PDSM's) or Relational Tables.
The light-gray boxes identify a system function or an informational item.
CMD Members
The following three (3) programs (or command files) are used to execute the sample application and to create the input data files needed by the application.
Run the Sample Application
The following is the Windows CMD File (CBLBINE1.cmd) required to run the sample COBOL program. This is a two step job. The first step (identified by the :DeleteQSAM statement) will delete the file that was created from a previous run of this job. The second step (identified by the :CreateQSAM statement) will execute the sample program.
@echo OFF
rem * *******************************************************************
rem * CBLBINE1.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Sample Table Functions using COBOL...
rem * Author - SimoTime Technologies
rem * Date - January 24, 1996
rem *
rem * The first job step (DeleteQSAM) will delete any previously created
rem * file.
rem *
rem * The second job step (CreateQSAM) will create a new file that shows
rem * the table searches.
rem * For this program to work the COBOL program must be compiled with
rem * the ASSIGN(EXTERNAL) and SEQUENTIAL(LINE) directives under
rem * Net Express.
rem *
rem * This set of programs will run on a Personal Computer with
rem * Windows and Micro Focus Net Express.
rem *
rem * ********************************************************************
rem * Step 1 of 3 Set the global environment variables,
rem * Delete any previously created file...
rem *
call ..\Env1BASE
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
set JobName=CBLBINE1
rem *
call SimoNOTE "*******************************************************%JobName%"
call SimoNOTE "Starting JobName %JobName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep DeleteQSAM"
set SYSOUT=%BaseLib1%\LOGS\SYSOUT_%JobName%.TXT
:DeleteQSAM
set STATEDB1=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.STATEDB1.DAT
set STATECTL=%BaseLib1%\DATA\ASC1\SIMOTIME.TEST.STATECTL.DAT
set STATEPUT=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.STATEPUT.DAT
if exist %STATEPUT% del %STATEPUT%
echo %STATEDB1%
echo %SYSOUT%
rem *
rem * *******************************************************************
rem * Step 2 of 3 Create and populate a new QSAM file...
rem *
:CreateQSAM
call SimoNOTE "Identify JobStep CreateQSAM"
run CblBinC1
if not "%ERRORLEVEL%" == "0" set JobStatus=0010
if not "%JobStatus%" == "0000" goto :EojNOK
:EojAok
call SimoNOTE "Produced %STATEPUT%"
call SimoNOTE "Produced %SYSOUT%"
call SimoNOTE "Finished JobName %JobName%, Job Status is %JobStatus%"
goto :End
:EojNok
type %SYSOUT%
call SimoNOTE "ABENDING JobName %JobName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
Create the Control File
The following is the Windows CMD File (CBLBINE2.cmd) that creates a control file. The control file is a PDA Member.
@echo OFF
rem * *******************************************************************
rem * CBLBINE2.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create a Sequential Data Set on disk using IEBGENER.
rem * Author - SimoTime Technologies
rem * Date = January 24, 1996
rem *
rem * The first job step (DeleteTEXT) will delete any previously created
rem * files.
rem * The second job step (CreateTEXT) will create a new ASCII/Text file.
rem * The third step will convert the Line Sequential file to a Record
rem * Sequential file.
rem *
rem * This set of programs will run on a Personal Computer with Windows
rem * and Micro Focus Net Express.
rem *
set CmdName=CBLBINE2
call ..\Env1BASE %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting CmdName %CmdName%, User is %USERNAME%"
call SimoNOTE "StepInfo Delete previously created files"
set STATECTL=%BaseLib1%\PARMLIB\STATECTL.CTL
rem *
rem * *******************************************************************
rem * Step 1 of 3 Create and populate a new ASCII/TEXT file...
rem *
call SimoNOTE "StepInfo Create an ASCII/Text File"
if exist %STATECTL% del %STATECTL%
rem * ..1....:....2....:....3....:....4....:....5....:....6....:....7.
echo /LINEAR Texas * A custom LINEAR search with expected hit >%STATECTL%
echo /BINARY Texas * A custom BINARY search with expected hit >>%STATECTL%
echo /LINEAR Illinois * Custom LINEAR search from first to last >>%STATECTL%
echo /BINARY Illinois * A custom BINARY search with expected hit >>%STATECTL%
echo /SEARCH Indiana * Use standard COBOL dialect >>%STATECTL%
echo /BINARY Alabama * First entry in table, custom BINARY search >>%STATECTL%
echo /BINARY Wyoming * Last entry in table, custome BINARY search >>%STATECTL%
echo /SEARCHALL Vermont * Binary search using standard COBOL dialect >>%STATECTL%
echo /SEARCHALL Delaware * Binary search using standard COBOL dialect >>%STATECTL%
if exist %STATECTL% call SimoNOTE "DataMake %STATECTL%"
if not exist %STATECTL% set JobStatus=9001
if not %JobStatus% == 0000 goto :EojNok
rem *
rem * *******************************************************************
rem * Step 2 of 3 Convert ASCII/TEXT file to ASCII RSEQ File...
rem *
call SimoNOTE "StepInfo Convert Line Sequential to Record Sequential"
set GETLS080=%STATECTL%
set PUTRS080=%BaseLib1%\DATA\Asc1\SIMOTIME.TEST.STATECTL.DAT
if exist %PUTRS080% del %PUTRS080%
run CV80ALAR
if not ERRORLEVEL = 0 set JobStatus=0030
if not %JobStatus% == 0000 goto :EojNok
call SimoNOTE "DataTake %GETLS080%"
call SimoNOTE "DataMake %PUTRS080%"
rem *
rem * *******************************************************************
rem * Step 3 of 3 Convert ASCII/TEXT file to ASCII RSEQ File...
rem *
call SimoNOTE "StepInfo Convert Line Sequential to Record Sequential"
set GETLS080=%STATECTL%
set PUTRS080=%BaseLib1%\DATA\ASC1\SIMOTIME.TEST.STATECTL.DAT
if exist %PUTRS080% del %PUTRS080%
run CV80ALAR
if not ERRORLEVEL = 0 set JobStatus=0030
if not %JobStatus% == 0000 goto :EojNok
call SimoNOTE "DataTake %GETLS080%"
call SimoNOTE "DataMake %PUTRS080%"
rem *
:EojAok
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus% "
goto :End
:EojNok
call SimoNOTE "NOTE ABENDING CmdName %CmdName%, Job Status is %JobStatus% "
:End
if not "%1" == "nopause" pause
Create a Table of the Fifty States
The following is the Windows CMD File (CBLBINE3.cmd) that creates a data table with information about the fifty states.
@echo OFF
rem * *******************************************************************
rem * CBLBINE3.CMD - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create a Sequential Data Set on disk using IEBGENER.
rem * Author - SimoTime Technologies
rem * Date = January 24, 1996
rem *
rem * The first job step (DeleteTEXT) will delete any previously created
rem * files.
rem * The second job step (CreateTEXT) will create a new ASCII/Text file.
rem * The third step will convert the Line Sequential file to a Record
rem * Sequential file.
rem *
rem * This set of programs will run on a Personal Computer with Windows
rem * and Micro Focus Net Express.
rem *
set CmdName=CBLBINE3
call ..\Env1BASE %CmdName%
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting CmdName %CmdName%, User is %USERNAME%"
call SimoNOTE "StepInfo Delete previously created files"
set STATEDB1=%BaseLib1%\DATA\Txt1\SIMOTIME.DATA.STATEDB1.TXT
rem *
rem * *******************************************************************
rem * Step 1 of 2 Create and populate a new ASCII/TEXT file...
rem *
call SimoNOTE "StepInfo Create an ASCII/Text File"
if exist %STATEDB1% del %STATEDB1%
rem * ..1....:....2....:....3....:....4....:....5....:....6....:....7.
echo Alabama AL Montgomery Yellowhammer Camellia 00004447100 00000050750>%STATEDB1%
echo Alaska AK Juneau Willow Ptarmigan Forget-me-not 00000626932 00000570373>>%STATEDB1%
echo Arizona AZ Phoenix Cactus Wren Saguaro Cactus Flower 00005130632 00000113642>>%STATEDB1%
echo Arkansas AR LittleRock Mockingbird Apple Blossom 00002673400 00000052075>>%STATEDB1%
echo California CA Sacramento Valley Quail Golden Poppy 00033871648 00000155973>>%STATEDB1%
echo Colorado CO Denver Lark Bunting Columbine 00004301261 00000103730>>%STATEDB1%
echo Connecticut CT Hartford Robin Mountain Laurel 00003405565 00000004845>>%STATEDB1%
echo Delaware DE Dover Blue Hen Chicken Peach Blossom 00000783600 00000001955>>%STATEDB1%
echo Florida FL Tallahassee Mockingbird Orange Blossom 00015982378 00000053997>>%STATEDB1%
echo Georgia GA Atlanta Brown Thrasher Cherokee Rose 00008186453 00000057919>>%STATEDB1%
echo Hawaii HI Honolulu Hawaiian Goose Hibiscus 00001211537 00000006423>>%STATEDB1%
echo Idaho ID Boise Mountain Bluebird Syringa 00001293953 00000082751>>%STATEDB1%
echo Illinois IL Springfield Cardinal Violet 00012419293 00000055593>>%STATEDB1%
echo Indiana IN Indianapolis Cardinal Peony 00006080485 00000035870>>%STATEDB1%
echo Iowa IA Des Moines Eastern Goldfinch Wild Rose 00002926324 00000055875>>%STATEDB1%
echo Kansas KS Topeka Western Meadowlark Sunflower 00002688418 00000081823>>%STATEDB1%
echo Kentucky KY Frankfort Cardinal Goldenrod 00004041769 00000039732>>%STATEDB1%
echo Louisiana LA Baton Rouge Pelican Magnolia 00004468976 00000043566>>%STATEDB1%
echo Maine ME Augusta Chickadee White Pine Cone 00001274923 00000030865>>%STATEDB1%
echo Maryland MD Annapolis Baltimore Oriole Black-eyed Susan 00005296486 00000009775>>%STATEDB1%
echo Massachusetts MA Boston Chickadee Mayflower 00006349097 00000007838>>%STATEDB1%
echo Michigan MI Lansing Robin Apple Blossom 00009938444 00000056809>>%STATEDB1%
echo Minnesota MN SaintPaul Loon Lady's Slipper 00004919479 00000079617>>%STATEDB1%
echo Mississippi MS Jackson Mockingbird Magnolia 00002844658 00000046914>>%STATEDB1%
echo Missouri MO Jefferson City Bluebird Hawthorn 00005595211 00000068898>>%STATEDB1%
echo Montana MT Helena Western Meadowlark Bitterroot 00000902195 00000145556>>%STATEDB1%
echo Nebraska NE Lincoln Western Meadowlark Goldenrod 00001711263 00000076878>>%STATEDB1%
echo Nevada NV Carson City Mountain Bluebird Sagebrush 00001998257 00000109806>>%STATEDB1%
echo New Hampshire NH Concord Purple Finch Purple Lilac 00001235786 00000008969>>%STATEDB1%
echo New Jersey NJ Trenton Eastern Goldfinch Purple Violet 00008414350 00000007419>>%STATEDB1%
echo New Mexico NM Santa Fe Roadrunner Yucca 00001819046 00000121364>>%STATEDB1%
echo New York NY Albany Bluebird Rose 00018976457 00000047224>>%STATEDB1%
echo North Carolina NC Raleigh Cardinal Dogwood 00008049313 00000048718>>%STATEDB1%
echo North Dakota ND Bismarck Western Meadowlark Wild Prairie Rose 00000642200 00000068994>>%STATEDB1%
echo Ohio OH Columbus Cardinal Scarlet Carnation 00011353140 00000040953>>%STATEDB1%
echo Oklahoma OK Oklahoma City Scissor-tailed Flycatcher Mistletoe 00003450654 00000068679>>%STATEDB1%
echo Oregon OR Salem Western Meadowlark Oregon Grape 00003421399 00000096003>>%STATEDB1%
echo Pennsylvania PA Harrisburg Ruffed Grouse Mountain Laurel 00012281054 00000044820>>%STATEDB1%
echo Rhode Island RI Providence Rhode Island Red Violet 00001048319 00000001045>>%STATEDB1%
echo South Carolina SC Columbia Carolina Wren Jessamine 00004012012 00000030111>>%STATEDB1%
echo South Dakota SD Pierre Ring-necked Pheasant Pasque 00000754844 00000075898>>%STATEDB1%
echo Tennessee TN Nashville Mockingbird Iris 00005689283 00000041220>>%STATEDB1%
echo Texas TX Austin Mockingbird Bluebonnet 00020851820 00000261914>>%STATEDB1%
echo Utah UT Salt Lake City Seagull Sego Lily 00002233169 00000082168>>%STATEDB1%
echo Vermont VT Montpelier Hermit Thrush Red Clover 00000608827 00000009249>>%STATEDB1%
echo Virginia VA Richmond Cardinal Dogwood 00007078515 00000039598>>%STATEDB1%
echo Washington WA Olympia Willow Goldfinch Rhododendron 00005894121 00000066582>>%STATEDB1%
echo West Virginia WV Charleston Cardinal Rhododendron 00001808344 00000024087>>%STATEDB1%
echo Wisconsin WI Madison Robin Wood Violet 00005363675 00000054314>>%STATEDB1%
echo Wyoming WY Cheyenne Meadowlark Indian Paintbrush 00000493782 00000097105>>%STATEDB1%
if exist %STATEDB1% call SimoNOTE "DataMake %STATEDB1%"
if not exist %STATEDB1% set JobStatus=9001
if not %JobStatus% == 0000 goto :EojNok
rem *
rem * *******************************************************************
rem * Step 2 of 2 Convert ASCII/TEXT file to ASCII RSEQ File...
rem *
call SimoNOTE "StepInfo Convert Line Sequential to Record Sequential"
set GETLS128=%STATEDB1%
set PUTRS128=%BaseLib1%\DATA\APPL\SIMOTIME.DATA.STATEDB1.DAT
if exist %PUTRS128% del %PUTRS128%
run C128ALAR
if not ERRORLEVEL = 0 set JobStatus=0030
if not %JobStatus% == 0000 goto :EojNok
call SimoNOTE "DataTake %GETLS128%"
call SimoNOTE "DataMake %PUTRS128%"
rem *
:EojAok
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus% "
goto :End
:EojNok
call SimoNOTE "NOTE ABENDING CmdName %CmdName%, Job Status is %JobStatus% "
:End
if not "%1" == "nopause" pause
JCL Member
The following (CBLBINJ1.jcl) is the mainframe JCL Member (CBLBINJ1.jcl) required to run the sample COBOL program. This is a two step job. The first step (identified by the //JOBSETUP statement) will delete the file that was created from a previous run of this job. The second step (identified by the //CBLBINS1 statement) will execute the sample program.
The JOB and DD statements will need to be modified for different mainframe environments.
//CBLBINJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* CBLBINJ1.JCL - a JCL Member for Batch Job Processing *
//* This JCL Member is provided by SimoTime Technologies *
//* (C) Copyright 1987-2019 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Using COBOL to do a binary search
//* Author - SimoTime Technologies
//* Date - January 01, 1989
//*
//* This set of programs illustrate the use a COBOL program to do
//* a binary search of a table.
//*
//* This set of programs may be compiled and executed on a Mainframe
//* System with ZOS or a Linux, UNIX or Windows System with Micro Focus
//* Enterprise Server.
//*
//* ************
//* * CBLBINJ1 *
//* ********JCL*
//* *
//* *
//* ************ ************ ************
//* * STATECTL *--*--* CBLBINC1 *--*--* STATEPUT *
//* ************ * ********CBL* * ************
//* * * *
//* ************ * * * ************
//* * STATEDB1 *--* * *--* DISPLAY *
//* ************ * ************
//* *
//* ************
//* * EOJ *
//* ************
//*
//* *******************************************************************
//* Step 1 of 2, Delete previously created file.
//*
//JOBSETUP EXEC PGM=IEFBR14
//STATEPUT DD DSN=SIMOTIME.DATA.STATEPUT,
// DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=VB,LRECL=132,DSORG=PS)
//*
//* *******************************************************************
//* Step 2 of 2, Execute the sample table processing program.
//*
//CBLBINS1 EXEC PGM=CBLBINC1
//STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR
//STATEDB1 DD DSN=SIMOTIME.DATA.STATEDB1,DISP=SHR
//STATECTL DD DSN=SIMOTIME.PDS.PARMLIB(STATECTL),DISP=SHR
//STATEPUT DD DSN=SIMOTIME.DATA.STATEPUT,
// DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,
// SPACE=(TRK,5),
// DCB=(RECFM=VB,LRECL=132,DSORG=PS)
//SYSOUT DD SYSOUT=*
//*
Partitioned Data Set Member
The following (STATECTL.ctl) is a Partitioned Data Set Member (or PDSM) that is used to control behavior within the COBOL Program. This member may be referred to as a PARM or CONTROL file.
/LINEAR Texas * A custom LINEAR search with expected hit
/BINARY Texas * A custom BINARY search with expected hit
/LINEAR Illinois * Custom LINEAR search from first to last
/BINARY Illinois * A custom BINARY search with expected hit
/SEARCH Indiana * Use standard COBOL dialect
/BINARY Alabama * First entry in table, custom BINARY search
/BINARY Wyoming * Last entry in table, custome BINARY search
/SEARCHALL Vermont * Binary search using standard COBOL dialect
/SEARCHALL Delaware * Binary search using standard COBOL dialect
COBOL Source Member
The following (CBLBINC1.cbl) is the source code for the sample COBOL program. This program will read the STAT1999.TXT file as a sequential file and load a table with information about the states in the United States.
Once the table is loaded the control file is read. Each record in the control file contains a keyword and the name of a state. The keyword identifies the type of table search. This program includes four examples of accessing a table using COBOL.
The "/SEARCH" keyword will do a linear scan of the table starting at the first element. This search uses standard COBOL functionality to do a table search.
The "/SEARCHALL" keyword will do a binary search of the table. This search uses standard COBOL functionality to do a table search. For this function to work the table must be in sequence.
The "/LINEAR" keyword will do a linear scan of the table starting at the first element. This search uses a customer written routine to do a table search.
The "/BINARY" keyword will do a binary search of the table. This search uses written routine to do the table search. For this function to work the table must be in sequence.
Once the control file is processed through end-of-file the table is then moved to a working table in memory. This working table is then sorted by descending sequence according to size by population. The working table information is then displayed to the screen and written to the STATEPUT file.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLBINC1.
AUTHOR. SIMOTIME TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy and modify this software for any *
* non-commercial purpose and without fee is hereby granted, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used in *
* any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
* Source Member: CBLBINC1.CBL
* Copy Files: STINFOB1.CPY
*
* This program provides an example of how a COBOL program does
* various table functions such as a table load, a standard
* COBOL search, a standard COBOL "search all", a user written
* binary search and a user written linear search.
*
* The COBOL program is written using the IBM COBOL for OS/390
* dialect and will also work with IBM Enterprise COBOL.
*
* A JCL member is provided to run the job as an MVS batch job on
* an IBM mainframe or as a project with Micro Focus Mainframe
* Express (MFE) running on a PC with Windows.
*
* A batch or command file is provided to run the job as a
* Windows batch job on a Wintel platform using Micro Focus Net
* Express.
*
*****************************************************************
*
* ************
* * CBLBINJ1 *
* ********jcl*
* *
* ************
* * IEFBR14 *
* ********utl*
* *
* ************ ************ ************
* * STATECTL *--*--* CBLBINC1 *--*--* STATEPUT *
* *******pdsm* * ********cbl* * ********dat*
* * * *
* * * *
* ************ * * * ************
* * STATEDB1 *--* * *--* CONSOLE *
* ********dat* * ******dsply*
* *
* ************
* * EOJ *
* ************
*
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT STATEDB1-FILE ASSIGN to STATEDB1
ORGANIZATION is SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is STATEDB1-STATUS.
SELECT STATECTL-FILE ASSIGN to STATECTL
ORGANIZATION is SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is STATECTL-STATUS.
SELECT STATEPUT-FILE ASSIGN to STATEPUT
ORGANIZATION is SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is STATEPUT-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD STATEDB1-FILE
DATA RECORD is STATEDB1-RECORD.
COPY STINFOB1.
FD STATECTL-FILE
DATA RECORD is STATECTL-RECORD.
01 STATECTL-RECORD.
05 STATECTL-DATA-01.
10 STATECTL-CONTROL.
15 STATECTL-SLASH pic X.
15 STATECTL-CONTROL pic X(14).
10 FILLER pic X.
10 STATECTL-SEARCH pic X(15).
10 STATECTL-COMMENT pic X(40).
10 FILLER pic X(9).
FD STATEPUT-FILE
DATA RECORD is STATEPUT-RECORD
RECORDING MODE is V
RECORD is VARYING in SIZE from 4 to 128
DEPENDING ON STATEPUT-LRECL.
01 STATEPUT-RECORD.
05 STATEPUT-DATA-01 pic X(128).
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLBINC1 '.
05 T2 pic X(34) value 'Table Processing, A COBOL Example '.
05 T3 pic X(10) value ' v06.05.04'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLBINC1 '.
05 C2 pic X(20) value 'Copyright 1987-2019 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* CBLBINC1 '.
05 C2 pic X(32) value 'Thank you for using this program'.
05 C3 pic X(32) value ' provided from SimoTime Technolo'.
05 C4 pic X(04) value 'gies'.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* CBLBINC1 '.
05 C2 pic X(32) value 'Please send all inquires or sugg'.
05 C3 pic X(32) value 'estions to the helpdesk@simotime'.
05 C4 pic X(04) value '.com'.
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CBLBINC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 STATEDB1-STATUS.
05 STATEDB1-STATUS-L pic X.
05 STATEDB1-STATUS-R pic X.
01 STATEDB1-EOF pic X value 'N'.
01 STATEDB1-OPEN-FLAG pic X value 'C'.
01 STATECTL-STATUS.
05 STATECTL-STATUS-L pic X.
05 STATECTL-STATUS-R pic X.
01 STATECTL-EOF pic X value 'N'.
01 STATECTL-OPEN-FLAG pic X value 'C'.
01 STATEPUT-STATUS.
05 STATEPUT-STATUS-L pic X.
05 STATEPUT-STATUS-R pic X.
01 STATEPUT-EOF pic X value 'N'.
01 STATEPUT-OPEN-FLAG pic X value 'C'.
01 STATEPUT-LRECL pic 9(5) value 128.
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 TWO-BYTES-BINARY redefines TWO-BYTES pic 9(4) comp.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
* The "ASSCENDING KEY" and "INDEXED BY" clauses are used and
* required by the "SEARCH ALL" and "SEARCH" functions.
01 T-STATEDB1-BUFFER.
05 T-STATEDB1-TABLE occurs 50 times
ascending key T-STATE-NAME
indexed by IX-1.
10 T-STATE-NAME pic X(15).
10 T-STATE-SHORT pic X(2).
10 T-STATE-CAPITOL pic X(16).
10 T-STATE-BIRD pic X(28).
10 T-STATE-FLOWER pic X(26).
10 T-STATE-POPULATION pic 9(11).
10 T-STATE-SQ-MILES pic 9(11).
10 T-STATE-DATE-POP pic 9(8).
01 W-STATEDB1-BUFFER.
05 W-STATEDB1-TABLE occurs 50 times.
10 W-STATE-NAME pic X(15).
10 W-STATE-SHORT pic X(2).
10 W-STATE-CAPITOL pic X(16).
10 W-STATE-BIRD pic X(28).
10 W-STATE-FLOWER pic X(26).
10 W-STATE-POPULATION pic 9(11).
10 W-STATE-SQ-MILES pic 9(11).
10 W-STATE-DATE-POP pic 9(8).
01 WORK-109 pic X(109).
01 LO-1 pic 9(3) value 0.
01 HI-1 pic 9(3) value 0.
01 PT-1 pic 9(3) value 0.
01 SWAP-COUNT pic 9(3) value 0.
01 HIT-FLAG pic X value 'N'.
01 WORK-15 pic X(15) value SPACES.
01 POPULATION-DISPLAY.
05 POP-SEQ pic 9(2) value 0.
05 filler pic X(2) value SPACES.
05 POP-NAME pic X(15).
05 filler pic X(2) value SPACES.
05 POP-COUNT pic ZZ,ZZZ,ZZZ,ZZZ.
01 DISPLAY-LINE.
05 DISPLAY-DESCRIPTION pic X(20).
05 DISPLAY-CONTENT pic X(32).
01 ACCESS-TOTAL.
05 filler pic X(23) value 'The indexed attempt is '.
05 ACCESS-COUNT pic 9(3) value 0.
01 SEARCH-NAME pic X(15).
01 STATEDB1-TOTAL.
05 filler pic X(23) value 'STATEDB1 line count is '.
05 STATEDB1-LOC pic 9(7) value 0.
01 STATECTL-TOTAL.
05 filler pic X(23) value 'STATECTL line count is '.
05 STATECTL-LOC pic 9(7) value 0.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform STATEPUT-OPEN
*
* Load and display the table for State information...
perform TABLE-LOAD
perform TABLE-DISPLAY
*
* Perform various table search examples using input from
* the STATECTL file.
perform STATECTL-OPEN
perform until STATECTL-STATUS not = '00'
perform STATECTL-READ
if STATECTL-STATUS = '00'
* Display Start-Up banner...
move all '*' to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATECTL-RECORD to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATECTL-RECORD(1:15) to WORK-15
move STATECTL-RECORD(16:15) to SEARCH-NAME
add 1 to STATECTL-LOC
* Determine the type of search and execute...
evaluate WORK-15
when '/BINARY ' perform TABLE-BINARY-SEARCH
when '/LINEAR ' perform TABLE-LINEAR-SEARCH
when '/SEARCH ' perform TABLE-SEARCH
when '/SEARCHALL ' perform TABLE-SEARCH-ALL
when other display WORK-15 ' - Invalid request'
end-evaluate
end-if
end-perform
if STATECTL-EOF = 'Y'
move 'is Finished...' to MESSAGE-TEXT
else
move 'is ABENDING...' to MESSAGE-TEXT
end-if
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATECTL-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
perform STATECTL-CLOSE
*
* Move the existing table to a work table then sort the work
* table. Display the results showing the states in sequence
* by descending order according to population.
perform TABLE-SORT-BY-POPULATION
*
* End-of-Job Processing
perform STATEPUT-CLOSE
perform Z-THANK-YOU.
GOBACK.
*****************************************************************
* Process a /BINARY contol record with custom written code... *
*****************************************************************
TABLE-BINARY-SEARCH.
move '* TABLE-BINARY-SEARCH is starting'
to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
* Prepare for the binary search...
add 1 to ZERO giving LO-1
add 50 to ZERO giving HI-1
move ZERO to ACCESS-COUNT
* Do the binary search...
perform until HI-1 - LO-1 < 1
if HI-1 - LO-1 - 1 > 1
compute PT-1 = LO-1 + (HI-1 - LO-1) / 2
else
* The following will ensure access to the first and last
* entries in the table. When the search argument does
* not find a match in the table this will ensure the
* search proceeds down to the last of two elements.
if PT-1 - 1 = LO-1
add LO-1 to ZERO giving PT-1
add LO-1 to ZERO giving HI-1
else
add HI-1 to ZERO giving PT-1
add HI-1 to ZERO giving LO-1
end-if
end-if
if SEARCH-NAME > T-STATE-NAME(PT-1)
add PT-1 to ZERO giving LO-1
else
if SEARCH-NAME = T-STATE-NAME(PT-1)
if PT-1 > 1
and SEARCH-NAME not = T-STATE-NAME(PT-1 - 1)
add PT-1 to ZERO giving HI-1
add PT-1 to ZERO giving LO-1
end-if
else
add PT-1 to ZERO giving HI-1
end-if
end-if
add 1 to ACCESS-COUNT
end-perform
* Display closing information...
move ACCESS-TOTAL to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
if PT-1 > 0
and PT-1 < 51
and T-STATE-NAME(PT-1) = SEARCH-NAME
perform TABLE-DISPLAY-SINGLE-ELEMENT
else
display SEARCH-NAME ' not found...' upon console
end-if
exit.
*****************************************************************
TABLE-DISPLAY.
perform varying PT-1 from 1 by 1 until PT-1 > 50
perform TABLE-DISPLAY-SINGLE-ELEMENT
end-perform
exit.
*****************************************************************
TABLE-DISPLAY-SINGLE-ELEMENT.
move 'State Name......... ' to DISPLAY-DESCRIPTION
move SPACES to DISPLAY-CONTENT
move T-STATE-Name(PT-1) to DISPLAY-CONTENT(1:15)
move T-STATE-SHORT(PT-1) to DISPLAY-CONTENT(16:2)
move DISPLAY-LINE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'State Capitol...... ' to DISPLAY-DESCRIPTION
move T-STATE-CAPITOL(PT-1) to DISPLAY-CONTENT
move DISPLAY-LINE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'State Bird......... ' to DISPLAY-DESCRIPTION
move T-STATE-BIRD(PT-1) to DISPLAY-CONTENT
move DISPLAY-LINE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'State Flower....... ' to DISPLAY-DESCRIPTION
move T-STATE-FLOWER(PT-1) to DISPLAY-CONTENT
move DISPLAY-LINE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'Population......... ' to DISPLAY-DESCRIPTION
move T-STATE-POPULATION(PT-1) to DISPLAY-CONTENT
move T-STATE-DATE-POP(PT-1) to DISPLAY-CONTENT(16:8)
move DISPLAY-LINE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move 'Size (Sq Miles).... ' to DISPLAY-DESCRIPTION
move T-STATE-SQ-MILES(PT-1) to DISPLAY-CONTENT
move DISPLAY-LINE to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move ' ' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
* Process a /LINEAR contol record with custom written code... *
*****************************************************************
TABLE-LINEAR-SEARCH.
move '* TABLE-LINEAR-SEARCH is starting'
to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
* Do the Linear search...
perform varying PT-1 from 1 by 1
until PT-1 > 50
or T-STATE-NAME(PT-1) = SEARCH-NAME
end-perform
* Prepare and display closing information...
add PT-1 to ZERO giving ACCESS-COUNT
set IX-1 to PT-1
move ACCESS-TOTAL to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
if PT-1 > 0
and PT-1 < 51
and T-STATE-NAME(PT-1) = SEARCH-NAME
perform TABLE-DISPLAY-SINGLE-ELEMENT
else
display SEARCH-NAME ' not found...' upon console
end-if
exit.
*****************************************************************
TABLE-LOAD.
* Display Start-Up banner...
move all '*' to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
move '* TABLE-LOAD is starting'
to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
* Prepare to load the table
perform STATEDB1-OPEN
add 1 to ZERO giving PT-1
* Read the file and load the table...
perform until STATEDB1-STATUS not = '00'
perform STATEDB1-READ
if STATEDB1-STATUS = '00'
add 1 to STATEDB1-LOC
move STATE-NAME to T-STATE-NAME(PT-1)
move STATE-SHORT to T-STATE-SHORT(PT-1)
move STATE-CAPITOL to T-STATE-CAPITOL(PT-1)
move STATE-BIRD to T-STATE-BIRD(PT-1)
move STATE-FLOWER to T-STATE-FLOWER(PT-1)
move STATE-POPULATION to T-STATE-POPULATION(PT-1)
move STATE-SQ-MILES to T-STATE-SQ-MILES(PT-1)
move STATE-DATE-POP to T-STATE-DATE-POP(PT-1)
add 1 to PT-1
end-if
end-perform
* Prepare and display closing information...
perform STATEDB1-CLOSE
move STATEDB1-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
* Process a /SEARCH contol record using standard COBOL dialect *
*****************************************************************
TABLE-SEARCH.
move '* TABLE-SEARCH is starting using COBOL SEARCH...'
to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
* Do the search...
add 1 to ZERO giving PT-1
move 'N' to HIT-FLAG
search T-STATEDB1-TABLE varying PT-1
at end
move 'N' to HIT-FLAG
when T-STATE-NAME(IX-1) = SEARCH-NAME
move 'Y' to HIT-FLAG
end-search.
* Prepare and display closing information...
* Set pointer for use by the TABLE DISPLAY function....
add PT-1 to ZERO giving ACCESS-COUNT
move ACCESS-TOTAL to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
if HIT-FLAG = 'Y'
perform TABLE-DISPLAY-SINGLE-ELEMENT
end-if
exit.
*****************************************************************
* Process a /SEARCHALL contol record use standard COBOL dialect *
*****************************************************************
TABLE-SEARCH-ALL.
move '* TABLE-SEARCH-ALL is starting using COBOL SEARCH...'
to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
* Do the SEARCH ALL, this will do a binary search. The table
* must be in sequence for the SEARCH ALL to work properly...
add 1 to ZERO giving PT-1
move 'N' to HIT-FLAG
search all T-STATEDB1-TABLE
at end
move 'N' to HIT-FLAG
when T-STATE-NAME(IX-1) = SEARCH-NAME
move 'Y' to HIT-FLAG
end-search.
* Prepare and display closing information...
* Set pointer for use by the TABLE DISPLAY function....
set PT-1 to IX-1
move 'SEARCH ALL does a binary search' to MESSAGE-TEXT-1
perform Z-DISPLAY-CONSOLE-MESSAGE
* If a table hit then display table element.
if HIT-FLAG = 'Y'
perform TABLE-DISPLAY-SINGLE-ELEMENT
end-if
exit.
*****************************************************************
* Sort the table by the population value *
*****************************************************************
TABLE-SORT-BY-POPULATION.
move T-STATEDB1-BUFFER to W-STATEDB1-BUFFER
add 1 to ZERO giving PT-1
add 1 to ZERO giving LO-1
add 50 to ZERO giving HI-1
move 'Y' to HIT-FLAG
*
* Do a descending bubble sort of the work table by population
perform until HIT-FLAG = 'N'
move 'N' to HIT-FLAG
add 1 to ZERO giving PT-1
perform until PT-1 > HI-1
or PT-1 = HI-1
if W-STATE-POPULATION(PT-1)
< W-STATE-POPULATION(PT-1 + 1)
move 'Y' to HIT-FLAG
move W-STATEDB1-TABLE(PT-1) to WORK-109
move W-STATEDB1-TABLE(PT-1 + 1)
to W-STATEDB1-TABLE(PT-1)
move WORK-109 to W-STATEDB1-TABLE(PT-1 + 1)
end-if
add 1 to PT-1
end-perform
end-perform
*
* Display the list of states with largest to smallest in
* size by population using the sorted work table.
perform varying PT-1 from 1 by 1 until PT-1 > 50
add PT-1 to ZERO giving POP-SEQ
move W-STATE-NAME(PT-1) to POP-NAME
move W-STATE-POPULATION(PT-1) to POP-COUNT
* Display information to screen.
move POPULATION-DISPLAY to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
* Write to the file.
move POPULATION-DISPLAY to STATEPUT-DATA-01
perform STATEPUT-WRITE
end-perform
exit.
*****************************************************************
* I/O ROUTINES FOR STATEDB1... *
*****************************************************************
STATEDB1-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close STATEDB1-FILE
if STATEDB1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'STATEDB1-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATEDB1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
STATEDB1-READ.
read STATEDB1-FILE
if STATEDB1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if STATEDB1-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to STATEDB1-EOF
else
move 'STATEDB1-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATEDB1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
STATEDB1-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input STATEDB1-FILE
if STATEDB1-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to STATEDB1-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'STATEDB1-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATEDB1-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O ROUTINES FOR STATECTL... *
*****************************************************************
STATECTL-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close STATECTL-FILE
if STATECTL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'STATECTL-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATECTL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
STATECTL-READ.
read STATECTL-FILE
if STATECTL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if STATECTL-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to STATECTL-EOF
else
move 'STATECTL-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATECTL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
STATECTL-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input STATECTL-FILE
if STATECTL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to STATECTL-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'STATECTL-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATECTL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O ROUTINES FOR STATEPUT... *
*****************************************************************
STATEPUT-WRITE.
if STATEPUT-OPEN-FLAG = 'C'
perform STATEPUT-OPEN
end-if
write STATEPUT-RECORD
if STATEPUT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if STATEPUT-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'STATEPUT-Failure-WRITE...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATEPUT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
STATEPUT-OPEN.
add 8 to ZERO giving APPL-RESULT.
open output STATEPUT-FILE
if STATEPUT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to STATEPUT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'STATEPUT-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATEPUT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
STATEPUT-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close STATEPUT-FILE
if STATEPUT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to STATEPUT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'STATEPUT-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move STATEPUT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-Routines perform administrative tasks *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
add 12 to ZERO giving RETURN-CODE
STOP RUN.
* exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-CONSOLE-MESSAGE.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* two digits if the full two byte file status is numeric. If *
* second byte is non-numeric then it will be treated as a *
* binary number. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
display '* CBLBINC1 File-Status-' IO-STAT1 '/'
TWO-BYTES-BINARY
else
display '* CBLBINC1 File-Status-' IO-STATUS
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
Z-THANK-YOU.
display SIM-THANKS-01
display SIM-THANKS-02
exit.
*****************************************************************
* This example is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
COBOL Copy File
The following (STINFOB1.cpy) is the source code for the COBOL copy file that defines the record layout for the Table File.
*****************************************************************
* STINFOB1.CPY - a COBOL Copy File *
* The record layout for the STATEDB1 Master Table File *
* Copyright (C) 1987-2019 SimoTime Technologies *
* All Rights Reserved *
* Provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
*
01 STATEDB1-RECORD.
05 STATE-NAME-SHORT.
10 STATE-NAME pic X(15).
10 STATE-SHORT pic X(2).
05 FILLER pic X.
05 STATE-CAPITOL pic X(16).
05 STATE-BIRD pic X(28).
05 STATE-FLOWER pic X(26).
05 STATE-POPULATION pic 9(11).
05 FILLER pic X.
05 STATE-SQ-MILES pic 9(11).
05 FILLER pic X(1).
05 STATE-DATE-POP pic 9(8).
05 FILLER pic X(8).
*
*** STINFOB1 - End-of-Copy File - - - - - - - - - - - STINFOB1 *
*****************************************************************
*
Summary
This suite of programs provides an example of how a COBOL program does various table functions such as a table load, a standard COBOL "SEARCH", a standard COBOL "SEARCH ALL", a user written binary search and a user written linear search. This document may be used to assist as a tutorial for new programmers or as a quick reference for experienced programmers.
In the world of programming there are many ways to solve a problem. This documentation and software were developed and tested on systems that are configured for a SIMOTIME environment based on the hardware, operating systems, user requirements and security requirements. Therefore, adjustments may be needed to execute the jobs and programs when transferred to a system of a different architecture or configuration.
SIMOTIME Services has experience in moving or sharing data or application processing across a variety of systems. For additional information about SIMOTIME Services or Technologies please contact us using the information in the Contact or Feedback section of this document.
Software Agreement and Disclaimer
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
Downloads and Links
This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.
Note: A SimoTime License is required for the items to be made available on a local system or server.
Current Server or Internet Access
The following links may be to the current server or to the Internet.
Note: The latest versions of the SimoTime Documents and Program Suites are available on the Internet and may be accessed using the  icon. If a user has a SimoTime Enterprise License the Documents and Program Suites may be available on a local server and accessed using the  icon.
Explore the JCL Connection for more examples of JCL functionality with programming techniques and sample code.
Explore the COBOL Connection for more examples of COBOL programming techniques and sample code.
Explore how to Create a Binary Table of binary values from X'00' through X'FF'. This example will use a Windows CMD File or JCL Member to execute a COBOL program.
Explore various Table Processing Techniques using COBOL to perform functions such as a table load, a standard COBOL "SEARCH", a standard COBOL "SEARCH ALL", a user written binary search and a user written linear search.
Explore how to use COBOL to Load a Table with customer information and then sort the table using a bubble sort routine. The elements in the table will be sorted in postal code sequence.
Explore how to Produce 1, 2, 3 or 4 across Mailing Labels. This example uses a two-dimensional array to build the label-printing output.
Explore The ASCII and EBCDIC Translation Tables. These tables are provided for individuals that need to better understand the bit structures and differences of the encoding formats.
Explore The File Status Return Codes that are used to interpret the results of accessing VSAM data sets and/or QSAM files.
Internet Access Required
The following links will require an internet connect.
This suite of programs and documentation is available to download for review and evaluation purposes. Other uses will require a SimoTime Software License.
Link to an Evaluation zPAK Option that includes the program members, documentation and control files.
A good place to start is
The SimoTime Home Page
for access to white papers, program examples and product information. This link requires an Internet Connection
Explore
The Micro Focus Web Site
for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Contact or Feedback
This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.
|
1.
|
Send an e-mail to our helpdesk.
|
|
2.
|
Our telephone numbers are as follows.
|
|
2.1.
|
1 415 763-9430 office-helpdesk
|
|
2.2.
|
1 415 827-7045 mobile
|
We appreciate hearing from you.
Company Overview
SimoTime Technologies was founded in 1987 and is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.
Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.
Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.
Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
|
Binary & Linear Table Search - Define, Load, Search and Sort
|
Copyright © 1987-2025
SimoTime Technologies and Services
All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |
| 