Read Indexed, Sort, Write Sequential
http://www.simotime.com
|
|
Print
Mailing Labels Read Indexed, Sort, Write Sequential http://www.simotime.com |
| When technology complements business | Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
This suite of programs provides an example of how a mainline application processes a VSAM, KSDS or Indexed File containing Name, Address information and creates a sorted (by postal code sequence) file containing mailing labels that are formatted with four labels across of six lines for each label. The program has the ability to print 1,2, 3 or 4 across labels. This example uses a two-dimensional array to build the label-printing output. The COBOL programs are written using the COBOL/2 dialect but also work with COBOL for MVS and COBOL/370. JCL members are provided to run the jobs as MVS batch jobs on an IBM mainframe or within a project with Micro Focus Mainframe Express (MFE) running on a PC with Windows. CMD members are provided to run on a PC in the Net Express environment. SimoTime also provides pre-defined project files for Mainframe Express and/or Net Express. For more information contact the helpdesk@simotime.com.
The following is a list of the coding and processing techniques used in this example.
| 1. | Sort a Sequential file into Postal Code sequence using the SORT Utility. |
| 2. | Sort a Sequential file into Postal Code sequence using a COBOL Program. |
| 3. | Parsing a Data Field and identifying keywords within a field. |
| 4. | How to use the Reference Modification capability of COBOL. |
| 5. | Analyzing a Street Address for a possible PO Box Address. |
| 6. | Passing a parameter from JCL to a COBOL program. |
| 7. | Using IEFBR14 and DD statements to delete files. |
| 8. | Creating and accessing a two-dimensional table in COBOL. |
| 9. | Use a single program to print 1, 2, 3 or 4 across mailing labels. |
The input for this example is a VSAM, Keyed-Sequential-Data-Set (KSDS) or Indexed file. The output is a sequential (or line sequential) file with the records formatted to print 1, 2, 3 or 4 across mailing labels.
This suite of samples programs will run on the following platforms.
| 1. | Executes on Windows/XP using Micro Focus Mainframe Express and the JCL members provided. |
| 2. | Executes on Windows/XP using Micro Focus Net Express and the CMD files provided. |
| 3. | Executes on Windows Server using Micro Focus Migration Server and the JCL members provided. |
| 4. | May be ported to run on the UNIX platforms supported by Micro Focus COBOL. |
This suite of programs uses a Customer Master File as input. The Customer Master file contains variable length records with the minimum and average record length being the same length of 512 bytes. The key starts in the first position of the record and is 12 bytes in length. The record layout is defined in a COBOL copy file and contains text strings and various numeric formats including zoned-decimal, packed and binary. Simply click on one of the following items to learn more or download this sample set of programs that will create a customer master file.
The following is a block diagram of the application for creating mailing labels. The BLUE boxes are unique to the mainframe and Micro Focus Mainframe Express. The RED boxes are unique to the PC with Windows and Micro Focus Net Express. The GREEN boxes are platform independent and will execute on the mainframe or a PC with Windows. Also, the GREEN boxes may be ported to a UNIX platform that is supported by Micro Focus COBOL.
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
Installation Verification Program | |||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
Delete previously created files. | ||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
Read KSDS, write Sequential omitting PO Box address. | ||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
Identify possible PO Box address. | ||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
Parse the Street-Address field. | |||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
Sort by Postal Code | ||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
Create four-across mailing labels. | ||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||
This example may serve as a tutorial for programmers that are new to mainframe JCL, COBOL programming or file sorting and processing techniques. This example may also be used as a reference for experienced programmers.
This section contains two examples. Each example is a four-step job. The first step is housekeeping to clean up files left from a previous execution of this job. The second step will read the customer master file and create a sequential file of mailing label information. The third step will sort the sequential file and create a new sequential file in postal code sequence. The fourth and final step will print mailing labels.
The following (STAMLRE1.CMD) is a sample of the Windows CMD needed to run this job on a PC in a non-Mainframe environment using Micro Focus Net Express. This command file will produce a file formatted for 4-across mailing labels. The sorting is by postal code and uses a SORT Utility program to do the sort.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create four-across mailing label file
rem * Author - SimoTime Enterprises
rem * Date - January 01, 1989
rem *
rem * The first step uses the IF EXIST function of Windows to delete
rem * files created in a previous execution of this script.
rem *
rem * The second step illustrates the use of a COBOL program to read
rem * a VSAM, Keyed Sequential Data Set (KSDS) and creates a sequential
rem * file of 244 byte, fixed length records.
rem * The program will omit records with a PO Box as the street address.
rem * This process also illustates the technique for passing a parameter
rem * from JCL to COBOL.
rem *
rem * The third step illustrates the use the SORT program to
rem * sort a Sequential file by zip code. Both the SORTIN and SORTOUT
rem * files are sequential files of 244 byte, fixed length records.
rem *
rem * The fourth step illustrates the use of a COBOL program that reads
rem * the sorted,sequential file and creates a Sequential File formatted
rem * for four-across mailing labels. The print file is a sequential
rem * file with 192 byte, fixed length records.
rem *
rem * The COBOL program also provides an example of using a two
rem * dimensional array.
rem *
rem * This set of programs will run on a mainframe under MVS or on
rem * a Personal Computer running Windows and Mainframe Express or
rem * Net Express by Micro Focus.
rem *
rem * ************
rem * * STAMLRE1 *
rem * ********cmd*
rem * *
rem * ************
rem * * If EXIST *
rem * *******stmt*
rem * *
rem * ************ ************ ************
rem * * CUSTMAST *-----* STAMLRC1 *-----* MAILTEMP *
rem * ********dat* ********cbl* *****dat244*
rem * * *
rem * * * ************
rem * * ***call*** SIMOROAD *
rem * * ********cbl*
rem * * *
rem * * ************
rem * * * SIMOPARS *
rem * * ********cbl*
rem * *
rem * ************ ************ ************
rem * * MAILTEMP *-----* SORT *-----* MAILSORT *
rem * *****dat244* ********utl* *****dat244*
rem * *
rem * *
rem * ************ ************ ************
rem * * MAILSORT *-----* STAMLRC2 *-----* MAILTEXT *
rem * *****dat244* ********cbl* *****dat192*
rem * *
rem * *
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * *******************************************************************
rem * Step 1 of 4 Set the global environment variables...
rem * Delete any previously created file...
rem * *******************************************************************
:StaMlrS1
call Env1PROD
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************StaMlrE1"
call SimoNOTE "Starting JobName StaMlrE1, User is %USERNAME%"
call SimoNOTE "Identify JobStep StaMlrS1, Set Globals, Delete Previous Files"
set MAILTEMP=%BaseLib1%\DataLibA\wrk1\MAILTEMP.DAT
set MAILSORT=%BaseLib1%\DataLibA\wrk1\MAILSORT.DAT
set MAILTEXT=%BaseLib1%\DataLibA\wrk1\MAILTEXT.DAT
if exist %MAILTEMP% del %MAILTEMP%
if exist %MAILSORT% del %MAILSORT%
if exist %MAILTEXT% del %MAILTEXT%
rem *
rem * *******************************************************************
rem * Step 2 of 4 Read KSDS and create Sequential File without PO Boxes
rem * *******************************************************************
:StaMlrS2
call SimoNOTE "Identify JobStep StaMlrS2, Extract non-PO Boxes"
set CUSTMAST=%BaseLib1%\DataLibA\Asc1\CUSTMAST.DAT
SimoEXEC EXEC STAMLRC1 PARM='NOPOBOX'
if NOT ERRORLEVEL 0 set JobStatus=0010
if not "%JobStatus%" == "0000" goto :EojNOK
if exist %MAILTEMP% call SimoNOTE "Produced DataSet %MAILTEMP%"
rem *
rem * *******************************************************************
rem * Step 3 of 4 Sort by Zip Code...
rem * *******************************************************************
rem *
:StaMlrS3
call SimoNOTE "Identify JobStep StaMlrS3, Sort by Postal Code"
set SYSOUTSAVE=%SYSOUT%
set SYSOUT=%BaseLIb1%\LOGS\SYSOUTStaMlrSort.TXT
set SYSIN=%BaseLib1%\ParmLib1\STAMLRT1.CTL
set SORTIN=%MAILTEMP%
set SORTOUT=%MAILSORT%
MFSORT take %SYSIN% use %SORTIN% RECORD F,244 ORG SQ GIVE %SORTOUT% RECORD F,244 ORG SQ
if ERRORLEVEL = 1 set JobStatus=0020
set SYSOUT=%SYSOUTSAVE%
if not "%JobStatus%" == "0000" goto :EojNOK
if exist %MAILSORT% SimoEXEC NOTE Produced DataSet %MAILSORT%
if exist %MAILSORT% goto :StaMlrS4
call SimoNOTE "ABENDING JobStep StaMlrS3, Sort Failure..."
goto :EojNOK
rem *
rem * *******************************************************************
rem * Step 4 of 4 Read Sorted file, create 4-across mailing label file
rem * *******************************************************************
rem *
:StaMlrS4
call SimoNOTE "Identify JobStep StaMlrS4, Create four across labels"
SimoEXEC EXEC STAMLRC2
if ERRORLEVEL = 1 set JobStatus=0030
if not "%JobStatus%" == "0000" goto :EojNOK
goto :StaMlrNormalEOJ
rem *
:EojNOK
call SimoNOTE "ABENDING JobName StaMlrE1, JobStatus %JobStatus%"
call SimoNOTE "ABENDING Message JobStatus %JobStatus%"
goto :StaMlrPause
:StaMlrNormalEOJ
if exist %MAILTEXT% call SimoNOTE "Produced DataSet %MAILTEXT%"
call SimoNOTE "Finished JobName StaMlrE1"
:StaMlrPause
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
The following (STAMLRE2.CMD) is a sample of the Windows CMD needed to run this job on a PC in a non-Mainframe environment using Micro Focus Net Express. This command file will produce two files. The first file (MAILTEXT.TXT) will be formatted for 4-across mailing labels. The second file (MAILTXT1.TXT) will be formatted for 1-across mailing labels. The sorting is by postal code and uses a COBOL program to do the callable sort.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create 4-across and 1-across mailing label files
rem * Author - SimoTime Enterprises
rem * Date - January 01, 1989
rem *
rem * The first step uses the IF EXIST function of Windows to delete
rem * files created in a previous execution of this script.
rem *
rem * The second step illustrates the use of a COBOL program to read
rem * a VSAM, Keyed Sequential Data Set (KSDS) and creates a sequential
rem * file of 244 byte, fixed length records.
rem * The program will omit records with a PO Box as the street address.
rem * This process also illustates the technique for passing a parameter
rem * from JCL to COBOL.
rem *
rem * The third step illustrates the uses a COBOL program that uses the
rem * callable SORT to sort a Sequential file by postal code.
rem * The SORTIN and SORTOUT files are sequential files of 244 byte,
rem * fixed length records.
rem *
rem * The fourth step illustrates the use of a COBOL program that reads
rem * the sorted,sequential file and creates a Sequential File formatted
rem * for four-across mailing labels. The print file is a sequential
rem * file with 192 byte, fixed length records.
rem *
rem * The fifth step will create one-across mailing labels.
rem *
rem * The COBOL program also provides an example of using a two
rem * dimensional array.
rem *
rem * This set of programs will run on a mainframe under MVS or on
rem * a Personal Computer running Windows and Mainframe Express or
rem * Net Express by Micro Focus.
rem *
rem * ************
rem * * StaMlrE2 *
rem * ********cmd*
rem * *
rem * ************
rem * * If EXIST *
rem * *******stmt*
rem * *
rem * ************ ************ ************
rem * * CUSTMAST *-----* STAMLRC1 *-----* MAILTEMP *
rem * ********dat* ********cbl* ********dat*
rem * * *
rem * * * ************
rem * * ***call*** SIMOROAD *
rem * * ********cbl*
rem * * *
rem * * ************
rem * * * SIMOPARS *
rem * * ********cbl*
rem * *
rem * ************ ************ ************
rem * * MAILTEMP *-----* CblSrtC1 *-----* MAILSORT *
rem * ********dat* ********cbl* ********dat*
rem * *
rem * *
rem * ************ ************ ************
rem * * MAILSORT *-----* STAMLRC2 *-----* MAILTXT4 *
rem * ********dat* ********cbl* ********dat*
rem * *
rem * *
rem * ************ ************ ************
rem * * MAILSORT *-----* STAMLRC2 *-----* MAILTXT1 *
rem * ********dat* ********cbl* ********dat*
rem * *
rem * *
rem * ************
rem * * EOJ *
rem * ************
rem *
rem * *******************************************************************
rem * Step 1 of 5 Set the global environment variables...
rem * Delete any previously created file...
rem * *******************************************************************
:StaMlrS1
call Env1PROD
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************StaMlrE2"
call SimoNOTE "Starting JobName StaMlrE2, User is %USERNAME%"
call SimoNOTE "Identify JobStep StaMlrS1, Set Globals, Delete Previous Files"
set MAILTEMP=%BaseLib1%\DataLibA\Wrk1\MAILTEMP.DAT
set MAILSORT=%BaseLib1%\DataLibA\Wrk1\MAILSORT.DAT
set MAILTEXT=%BaseLib1%\DataLibA\Wrk1\MAILTXT4.DAT
if exist %MAILTEMP% del %MAILTEMP%
if exist %MAILSORT% del %MAILSORT%
if exist %MAILTEXT% del %MAILTEXT%
rem *
rem * *******************************************************************
rem * Step 2 of 5 Read KSDS, create Sequential File without PO Boxes
rem * The PARM=NOPOBOX tells the program not to include
rem * records that have PO Box addresses.
rem * *******************************************************************
:StaMlrS2
call SimoNOTE "Identify JobStep StaMlrS2, Extract non-PO Boxes"
set CUSTMAST=%BaseLib1%\DataLibA\Asc1\CUSTMAST.DAT
SimoEXEC EXEC STAMLRC1 PARM='NOPOBOX'
if not ERRORLEVEL = 0 set JobStatus=0002
if not "%JobStatus%" == "0000" goto :StaMlrABEND
if exist %MAILTEMP% call SimoNOTE "Produced DataSet %MAILTEMP%"
rem *
rem * *******************************************************************
rem * Step 3 of 5 Sort by Postal Code using COBOL Sort...
rem * *******************************************************************
rem *
:StaMlrS3
call SimoNOTE "Identify JobStep StaMlrS3, Sort by Postal Code"
run CblSrtC1
if not ERRORLEVEL = 0 set JobStatus=0003
if not "%JobStatus%" == "0000" goto :StaMlrABEND
if exist %MAILSORT% call SimoNOTE "Produced DataSet %MAILSORT%"
if exist %MAILSORT% goto :StaMlrS4
set JobnStatus=0003
call SimoNOTE "ABENDING JobStep StaMlrS3, Sort Failure..."
goto :StaMlrABEND
rem *
rem * *******************************************************************
rem * Step 4 of 5 Read Sorted file, create 4-across mailing label file
rem * The program looks for a PARM=n where n is a number
rem * from 1-4 specifying the number of labels across a
rem * row. If this parameter is missing the default is 4.
rem * *******************************************************************
rem *
:StaMlrS4
call SimoNOTE "Identify JobStep StaMlrS4, Create four across labels"
SimoEXEC EXEC STAMLRC2
if not ERRORLEVEL = 0 set JobStatus=0004
if not "%JobStatus%" == "0000" goto :StaMlrABEND
if exist %MAILTEXT% call SimoNOTE "Produced DataSet %MAILTEXT%"
rem *
rem * *******************************************************************
rem * Step 5 of 5 Read Sorted file, create 1-across mailing label file
rem * The program looks for a PARM=n where n is a number
rem * from 1-4 specifying the number of labels across a
rem * row. If this parameter is missing the default is 4.
rem * *******************************************************************
rem *
:StaMlrS5
call SimoNOTE "Identify JobStep StaMlrS5, Create one across labels"
set MAILTEXT=%BaseLib1%\DataLibA\Wrk1\MAILTXT1.DAT
if exist %MAILTEXT% del %MAILTEXT%
SimoEXEC EXEC STAMLRC2 PARM=1
if not ERRORLEVEL = 0 set JobStatus=0005
if not "%JobStatus%" == "0000" goto :StaMlrABEND
if exist %MAILTEXT% call SimoNOTE "Produced DataSet %MAILTEXT%"
goto :StaMlrNormalEOJ
rem *
:StaMlrABEND
call SimoNOTE "ABENDING JobName StaMlrE2"
call SimoNOTE "ABENDING Message Job Status is %JobStatus%"
goto :StaMlrPause
:StaMlrNormalEOJ
call SimoNOTE "Finished JobName StaMlrE2"
:StaMlrPause
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
:EOJ
This section contains two examples. Each example is a four-step job. The first step is housekeeping to clean up files left from a previous execution of this job. The second step will read the customer master file and create a sequential file of mailing label information. The third step will sort the sequential file and create a new sequential file in postal code sequence. The fourth and final step will print mailing labels.
The following is the mainframe JCL (STAMLRJ1.JCL) required to run as an MVS batch job on the mainframe. This will also run on the PC with Micro Focus Mainframe Express. This JCL member will produce a file formatted for 4-across mailing labels. The sorting is by postal code and uses a SORT Utility program to do the sort.
//STAMLRJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2010 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Create four-across mailing label file //* Author - SimoTime Enterprises //* Date - January 01, 1989 //* //* The first step illustrates the use of IEFBR14 and DD statements //* with the DISP=(MOD,DELETE,DELETE) to delete files. //* //* The second step illustrates the use of a COBOL program to read //* a VSAM, Keyed Sequential Data Set (KSDS) and creates a sequential //* file the omits the records with a PO Box as the street address. //* This program also illustates the technique for passing a parameter //* from JCL to COBOL. //* //* The third step illustrates the use the SORT program to //* sort a Sequential file by zip code. //* //* The fourth step illustrates the use of a COBOL program that reads //* the sorted,sequential file and creates a Sequential File formatted //* for four-across mailing labels. //* //* The COBOL program also provides an example of using a two //* dimensional array. //* //* This set of programs will run on a mainframe under MVS or on //* a Personal Computer running Windows and Mainframe Express or //* Net Express by Micro Focus. //* //* ************ //* * STAMLRJ1 * //* ********jcl* //* * //* ************ //* * IEFBR14 * //* ********utl* //* * //* ************ ************ ************ //* * CUSTMAST *-----* STAMLRC1 *-----* MAILTEMP * //* ********dat* ********cbl* ********dat* //* * * //* * * ************ //* * ***call*** SIMOROAD * //* * ********cbl* //* * * //* * ************ //* * * SIMOPARS * //* * ********cbl* //* * //* ************ ************ ************ //* * MAILTEMP *-----* SORT *-----* MAILSORT * //* ********dat* ********utl* ********dat* //* * //* * //* ************ ************ ************ //* * MAILSORT *-----* STAMLRC2 *-----* MAILTEXT * //* ********dat* ********cbl* ********dat* //* * //* * //* ************ //* * EOJ * //* ************ //* //* ******************************************************************* //* Step 1 of 4 Delete any previously created file... //* ******************************************************************* //* //QSAMDELT EXEC PGM=IEFBR14 //MAILTEMP DD DSN=SIMOTIME.MLR1.MAILTEMP,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //MAILSORT DD DSN=SIMOTIME.MLR1.MAILSORT,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //MAILTEXT DD DSN=SIMOTIME.MLR1.MAILTEXT,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=192,BLKSIZE=1920,DSORG=PS) //* //* ******************************************************************* //* Step 2 of 4 Read KSDS and create Sequential File without PO Boxes //* The PARM=NOPOBOX tells the program not to include //* records that have PO Box addresses. //* ******************************************************************* //* //ADDRST02 EXEC PGM=STAMLRC1,PARM='NOPOBOX' //STEPLIB DD DSN=MFI01.SIMOPROD.LOADLIB1,DISP=SHR //CUSTMAST DD DSN=SIMOTIME.DATA.CUSTMAST,DISP=SHR //MAILTEMP DD DSN=SIMOTIME.MLR1.MAILTEMP,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //SYSOUT DD SYSOUT=* //* //* ******************************************************************* //* Step 3 of 4 Sort by Zip Code... //* ******************************************************************* //* //SORTST03 EXEC PGM=SORT,COND=(0,LT), // REGION=1024K //SYSIN DD DSN=MFI01.SIMOPROD.PARMLIB1(STAMLRT1),DISP=SHR //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,55) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,55) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,55) //SORTIN DD DSN=SIMOTIME.MLR1.MAILTEMP,DISP=SHR //SORTOUT DD DSN=SIMOTIME.MLR1.MAILSORT,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //SYSOUT DD SYSOUT=* //* //* ******************************************************************* //* Step 4 of 4 Read Sorted file, create 4-across mailing label file //* The program looks for a PARM=n where n is a number //* from 1-4 specifying the number of labels across a //* row. If this parameter is missing the default is 4. //* ******************************************************************* //* //MAILST04 EXEC PGM=STAMLRC2,COND=(0,LT) //STEPLIB DD DSN=MFI01.SIMOPROD.LOADLIB1,DISP=SHR //MAILSORT DD DSN=SIMOTIME.MLR1.MAILSORT,DISP=SHR //MAILTEXT DD DSN=SIMOTIME.MLR1.MAILTEXT,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=192,BLKSIZE=1920,DSORG=PS) //SYSOUT DD SYSOUT=* //*
The following is the mainframe JCL (STAMLRJ2JCL) required to run as an MVS batch job on the mainframe. This will also run on the PC with Micro Focus Mainframe Express. This JCL member will produce two files. The first file (MAILTEXT.DAT) will be formatted for 4-across mailing labels. The second file (MAILTXT1.DAT) will be formatted for 1-across mailing labels.The sorting is by postal code and uses a COBOL program to do the callable sort.
//STAMLRJ2 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2010 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Create four-across and one-across mailing label files //* Author - SimoTime Enterprises //* Date - January 01, 1989 //* //* The first step illustrates the use of IEFBR14 and DD statements //* with the DISP=(MOD,DELETE,DELETE) to delete files. //* //* The second step illustrates the use of a COBOL program to read //* a VSAM, Keyed Sequential Data Set (KSDS) and creates a sequential //* file the omits the records with a PO Box as the street address. //* This program also illustates the technique for passing a parameter //* from JCL to COBOL. //* //* The third step illustrates the uses a COBOL program that uses the //* callable SORT to sort a Sequential file by postal code. //* //* The fourth step illustrates the use of a COBOL program that reads //* the sorted,sequential file and creates a Sequential File formatted //* for four-across mailing labels. //* //* The fifth step illustrates the use of a COBOL program that reads //* the sorted,sequential file and creates a sequential file formatted //* for one-across mailing labels. //* //* The COBOL program that creates labels also provides an example //* of using a two dimensional array. //* //* This set of programs will run on a mainframe under MVS or on //* a Personal Computer running Windows and Mainframe Express or //* Net Express by Micro Focus. //* //* ************ //* * STAMLRJ2 * //* ********jcl* //* * //* ************ //* * IEFBR14 * //* ********utl* //* * //* ************ ************ ************ //* * CUSTMAST *-----* STAMLRC1 *-----* MAILTEMP * //* ********dat* ********cbl* ********dat* //* * * //* * * ************ //* * ***call*** SIMOROAD * //* * ********cbl* //* * * //* * ************ //* * * SIMOPARS * //* * ********cbl* //* * //* ************ ************ ************ //* * MAILTEMP *-----* CBLSRTC1 *-----* MAILSORT * //* ********dat* ********cbl* ********dat* //* * //* * //* ************ ************ ************ //* * MAILSORT *-----* STAMLRC2 *-----* MAILTEXT * //* ********dat* ********cbl* ********dat* //* * //* * //* ************ ************ ************ //* * MAILSORT *-----* STAMLRC2 *-----* MAILTXT1 * //* ********DAT* ********CBL* ********DAT* //* * //* * //* ************ //* * EOJ * //* ************ //* //* ******************************************************************* //* Step 1 of 5 Delete any previously created file... //* ******************************************************************* //* //QSAMDELT EXEC PGM=IEFBR14 //MAILTEMP DD DSN=SIMOTIME.DATA.MAILTEMP,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //MAILTEXT DD DSN=SIMOTIME.DATA.MAILTEXT,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=192,BLKSIZE=1920,DSORG=PS) //* //* ******************************************************************* //* Step 2 of 5 Read KSDS and create Sequential File without PO Boxes. //* The PARM=NOPOBOX tells the program not to include //* records that have PO Box addresses. //* ******************************************************************* //* //ADDRST02 EXEC PGM=STAMLRC1,PARM='NOPOBOX' //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //CUSTMAST DD DSN=SIMOTIME.DATA.CUSTMAST,DISP=SHR //MAILTEMP DD DSN=SIMOTIME.DATA.MAILTEMP,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //SYSOUT DD SYSOUT=* //* //* ******************************************************************* //* Step 3 of 5 Sort by Zip Code using COBOL Program... //* ******************************************************************* //* //SORTST03 EXEC PGM=CBLSRTC1,COND=(0,LT) //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //MAILTEMP DD DSN=SIMOTIME.DATA.MAILTEMP,DISP=SHR //MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=244,BLKSIZE=2440,DSORG=PS) //SYSOUT DD SYSOUT=* //* //* ******************************************************************* //* Step 4 of 5 Read Sorted file, create 4-across mailing label file. //* The program looks for a PARM=n where n is a number //* from 1-4 specifying the number of labels across a //* row. If this parameter is missing the default is 4. //* ******************************************************************* //* //MAILST04 EXEC PGM=STAMLRC2,COND=(0,LT) //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=SHR //MAILTEXT DD DSN=SIMOTIME.DATA.MAILTEXT,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=192,BLKSIZE=1920,DSORG=PS) //SYSOUT DD SYSOUT=* //* //* ******************************************************************* //* STEP 5 OF 5 Read sorted file, create 1-across mailing label file. //* The program looks for a PARM=n where n is a number //* from 1-4 specifying the number of labels across a //* row. If this parameter is missing the default is 4. //* ******************************************************************* //* //MAILST05 EXEC PGM=STAMLRC2,COND=(0,LT),PARM=1 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=SHR //MAILTEXT DD DSN=SIMOTIME.DATA.MAILTXT1,DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=192,BLKSIZE=1920,DSORG=PS) //SYSOUT DD SYSOUT=* //*
This section describes the two application COBOL programs and the two callable COBOL routines used for omitting records with PO Box addresses, sorting by Postal Code and printing the four-across mailing labels.
This program (STAMLRC1.CBL) is a simple program that reads a VSAM, Keyed-Sequential-Data-Set (KSDS) and writes a sequential file. This program calls a routine to analyze the Street-Address field for a possible PO Box address. If the street address is a PO Box then the record is not written to the output file. Notice the "Z-DISPLAY-IO-STATUS" routine to display the file status code.
IDENTIFICATION DIVISION.
PROGRAM-ID. STAMLRC1.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC. *
* *
* 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 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 *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. 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 *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises 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 Enterprises *
* 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 Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
*
*****************************************************************
* Source Member: STAMLRC1.CBL
* Copy Files: CUSTCB01.CPY
* MAILCB01.CPY
* PASSROAD.CPY
* PASSPARS.CPY
* Calls to: SIMOROAD.CBL
* SIMOPARS.CBL
*****************************************************************
*
* ************
* * STAMLRJ1 *
* ********jcl*
* *
* ************
* * IEFBR14 *
* ********utl*
* *
* ************ ************ ************
* * CUSTMAST *-----* STAMLRC1 *-----* MAILTEMP *
* ********dat* ********cbl* ********dat*
* * *
* * * ************
* * ***call*** SIMOROAD *
* * ********cbl*
* * *
* * ************
* * * SIMOPARS *
* * ********cbl*
* *
* ************ ************ ************
* * MAILTEMP *-----* SORT *-----* MAILSORT *
* ********dat* ********cbl* ********dat*
* *
* *
* ************ ************ ************
* * MAILSORT *-----* STAMLRC2 *-----* MAILTEXT *
* ********dat* ********cbl* ********dat*
* *
* *
* ************
* * EOJ *
* ************
*
*****************************************************************
* This program will read the input file and create a sequential
* output file with the records formatted to print mailing labels
* four across a page of six lines each.
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CUSTMAST-FILE ASSIGN TO CUSTMAST
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS CUST-NUMBER
FILE STATUS IS CUSTMAST-STATUS.
SELECT MAILTEMP-FILE ASSIGN TO MAILTEMP
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS MAILTEMP-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD CUSTMAST-FILE
DATA RECORD IS CUST-RECORD.
COPY CUSTCB01.
FD MAILTEMP-FILE
DATA RECORD IS MAIL-RECORD.
COPY MAILCB01.
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* STAMLRC1 '.
05 T2 pic X(34) value 'Create Name-Address Labels File '.
05 T3 pic X(10) value ' v08.01.03'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* STAMLRC1 '.
05 C2 pic X(20) value 'Copyright 1987-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* STAMLRC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 CUSTMAST-STATUS.
05 CUSTMAST-STATUS-L pic X.
05 CUSTMAST-STATUS-R pic X.
01 CUSTMAST-EOF pic X value 'N'.
01 CUSTMAST-OPEN-FLAG pic X value 'C'.
01 MAILTEMP-STATUS.
05 MAILTEMP-STATUS-L pic X.
05 MAILTEMP-STATUS-R pic X.
01 MAILTEMP-EOF pic X value 'N'.
01 MAILTEMP-OPEN-FLAG pic X value 'C'.
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 IO-STATUS-4 pic 9(4) value 0.
01 IO-STATUS-4A redefines IO-STATUS-4
pic X(4).
01 PROGRAM-NAME pic X(8) value 'STAMLRC1'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 OMIT-POB pic X value 'N'.
01 ADDRESS-IS-POB pic X value 'N'.
01 CUSTMAST-TOTAL.
05 filler pic X(23) value 'CUSTMAST line count is '.
05 CUSTMAST-RDR pic 9(9) value 0.
01 MAILTEMP-TOTAL.
05 filler pic X(23) value 'MAILTEMP line count is '.
05 MAILTEMP-ADD pic 9(9) value 0.
*****************************************************************
* The following copy file of the pass area for calling SIMODATE,
* the date editing routine.
*****************************************************************
COPY PASSROAD.
*****************************************************************
LINKAGE SECTION.
01 PARM-BUFFER.
05 PARM-LENGTH pic S9(4) comp.
05 PARM-DATA pic X(256).
*****************************************************************
PROCEDURE DIVISION using PARM-BUFFER.
perform Z-POST-COPYRIGHT
if PARM-LENGTH > 0
move PARM-DATA(1:PARM-LENGTH) to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if PARM-DATA(1:7) = 'NOPOBOX'
move 'Y' to OMIT-POB
end-if
end-if
perform CUSTMAST-OPEN
perform MAILTEMP-OPEN
perform until CUSTMAST-STATUS not = '00'
perform CUSTMAST-READ
if CUSTMAST-STATUS = '00'
add 1 to CUSTMAST-RDR
if OMIT-POB = 'Y'
perform TEST-FOR-POB
end-if
if ADDRESS-IS-POB = 'N'
perform BUILD-OUTPUT-RECORD
perform MAILTEMP-WRITE
if MAILTEMP-STATUS = '00'
add 1 to MAILTEMP-ADD
end-if
end-if
end-if
end-perform
move CUSTMAST-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEMP-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if APPL-EOF
move 'is Complete...' to MESSAGE-TEXT
move ZERO to RETURN-CODE
else
move 'is ABENDING...' to MESSAGE-TEXT
add 16 to ZERO giving RETURN-CODE
end-if
perform Z-DISPLAY-MESSAGE-TEXT
perform MAILTEMP-CLOSE
perform CUSTMAST-CLOSE
GOBACK.
*****************************************************************
* The following routines are in alphabetical sequence.. *
*****************************************************************
*
*****************************************************************
BUILD-OUTPUT-RECORD.
move SPACES to MAIL-RECORD
move CUST-NUMBER to MAIL-KEY
move CUST-NAME to MAIL-NAME.
move CUST-ADDRESS-1 to MAIL-ADDRESS-1
move CUST-ADDRESS-2 to MAIL-ADDRESS-2
move CUST-CITY to MAIL-CITY
move CUST-STATE to MAIL-STATE
move CUST-POSTAL-CODE to MAIL-POSTAL-CODE
exit.
*
*****************************************************************
* I/O ROUTINES FOR CUSTMAST... *
*****************************************************************
CUSTMAST-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CUSTMAST-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-READ.
read CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if CUSTMAST-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 CUSTMAST-EOF
else
move 'CUSTMAST-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
CUSTMAST-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input CUSTMAST-FILE
if CUSTMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to CUSTMAST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CUSTMAST-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move CUSTMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O ROUTINES FOR MAILTEMP... *
*****************************************************************
MAILTEMP-WRITE.
if MAILTEMP-OPEN-FLAG = 'C'
perform MAILTEMP-OPEN
end-if
write MAIL-RECORD
if MAILTEMP-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if MAILTEMP-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 'MAILTEMP-Failure-WRITE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEMP-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
MAILTEMP-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT MAILTEMP-FILE
if MAILTEMP-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to MAILTEMP-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MAILTEMP-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEMP-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
MAILTEMP-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close MAILTEMP-FILE
if MAILTEMP-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to MAILTEMP-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MAILTEMP-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEMP-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
TEST-FOR-POB.
move 'N' to ADDRESS-IS-POB
move 'SIMOROAD' to RDPA-REQUEST
move 'INP ' to RDPA-ADR1-CNTL
move CUST-ADDRESS-1 to RDPA-ADR1-DATA
call 'SIMOROAD' using ROAD-PASS-AREA
if RDPA-RESULT = 0
and RDPA-ADR2-CNTL = 'POB '
move 'Y' to ADDRESS-IS-POB
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* 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-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
GOBACK.
* exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79) upon console
else
display MESSAGE-BUFFER upon console
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
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
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-4
move IO-STAT1 to IO-STATUS-4A(1:1)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-4A
move IO-STATUS to IO-STATUS-4A(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-4A to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
This routine (SIMOPARS.CBL) is a simple, callable routine that reads scans a data buffer and provides the offset and length of keywords within the data buffer. The routine uses a space character as the delimiter. Leading spaces are ignored and embedded multiple spaces are treated as a single space. The routine uses Reference Modification to do the parsing.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOPARS.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC. *
* *
* 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 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 *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. 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 *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises 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 Enterprises *
* 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 Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: SIMOPARS.CBL
* Copy Files PASSPARS.CPY
*****************************************************************
*
* SIMOPARS - Parse Buffer defined in pass area.
*
* CALLING PROTOCOL
* ----------------
* call 'SIMOPARS' using PRS-PARAMETERS
*
* 01 PRS-PARAMETERS.
* 05 PRS-REQUEST PIC X VALUE '0'.
* 05 PRS-STATUS PIC 9(4).
* 05 PRS-DELIMITER PIC X VALUE SPACE.
* 05 PRS-KEEP-NULL-FIELDS PIC X VALUE 'N'.
* 05 PRS-SUSPEND PIC X VALUE 'N'.
* 05 PRS-SUSPEND-BYTE PIC X VALUE SPACE.
* 05 PRS-TERMINATOR PIC X VALUE 'N'.
* 05 PRS-TERMINATOR-BYTE PIC X VALUE SPACE.
* 05 PRS-BUFFER-SIZE PIC 9(4) VALUE 2048.
* 05 PRS-BUFFER PIC X(2048).
* 05 PRS-TABLE-MAX PIC 9(4) VALUE 128.
* 05 PRS-NUMBER-OF-ITEMS PIC 9(4) VALUE 0.
* 05 PRS-LAST-SIG-BYTE PIC 9(4) VALUE 0.
* 05 PRS-POSITION OCCURS 128 TIMES
* PIC 9(4) VALUE 0.
* 05 PRS-SIZE OCCURS 128 TIMES
*
* This routine uses reference modification to identify the
* position of the first significant character after the
* delimiter character. This approach compensates for multiple
* leading or embedded delimiter characters. The string function
* of COBOL does not handle leading spaces.
*
* For example, if the delimiter character is a space then
* leading spaces will be ignored and multiple, embedded spaces
* will be treated as a single space.
*
* MAINTENANCE
* -----------
* 1998/01/02 Simmons, CREATED PROGRAM.
* 1998/01/02 Simmons, No changes to date...
*
*****************************************************************
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Program use... *
*****************************************************************
01 I-PTR pic 9(4) value 0.
01 O-PTR pic 9(4) value 0.
01 B-COUNT pic 9(4) value 0.
*01 SUSPEND-SWITCH pic X value 'N'.
*****************************************************************
LINKAGE SECTION.
COPY PASSPARS.
*****************************************************************
PROCEDURE DIVISION using PRS-PARAMETERS.
perform EDIT-LINKAGE-ITEMS
add 8 to ZERO giving RETURN-CODE
add 9 to ZERO giving PRS-STATUS
subtract 1 from 1 giving PRS-NUMBER-OF-ITEMS
evaluate PRS-REQUEST
when '0' perform PARSE-BUFFER
when '1' perform INITIALIZE-TABLE-ELEMENTS
when OTHER add 12 to ZERO giving PRS-STATUS
end-evaluate
if PRS-STATUS = 9
subtract PRS-STATUS from PRS-STATUS
end-if
GOBACK.
*****************************************************************
EDIT-LINKAGE-ITEMS.
if PRS-TABLE-MAX not numeric
add 128 to ZERO giving PRS-TABLE-MAX
end-if
if PRS-TABLE-MAX > 128
add 128 to ZERO giving PRS-TABLE-MAX
end-if
if PRS-BUFFER-SIZE not numeric
add 2048 to ZERO giving PRS-TABLE-MAX
end-if
if PRS-BUFFER-SIZE > 2048
add 2048 to ZERO giving PRS-TABLE-MAX
end-if
exit.
*****************************************************************
INITIALIZE-TABLE-ELEMENTS.
move 1 to I-PTR
move 1 to O-PTR
perform until O-PTR > PRS-TABLE-MAX
move 0 to PRS-POSITION(O-PTR)
move 0 to PRS-SIZE(O-PTR)
add 1 to O-PTR
end-perform
subtract RETURN-CODE from RETURN-CODE
exit.
*****************************************************************
PARSE-BUFFER.
*! Initialize Offset/Length tables to zero (0).
perform INITIALIZE-TABLE-ELEMENTS
add 1 to ZERO giving PRS-LAST-SIG-BYTE
subtract PRS-LAST-SIG-BYTE from PRS-LAST-SIG-BYTE
*! Parse the Buffer.
add 1 to ZERO giving O-PTR
if PRS-SUSPEND = 'Y'
or PRS-SUSPEND = '0'
or PRS-SUSPEND = '1'
move '0' to PRS-SUSPEND
else
move 'N' to PRS-SUSPEND
end-if
perform until I-PTR > PRS-BUFFER-SIZE
if PRS-BUFFER(I-PTR:1) not = SPACE
add I-PTR to ZERO giving PRS-LAST-SIG-BYTE
end-if
if PRS-SUSPEND not = 'N'
and PRS-BUFFER(I-PTR:1) = PRS-SUSPEND-BYTE
if PRS-SUSPEND = '0'
or PRS-SUSPEND = '1'
if PRS-SUSPEND = '0'
move '1' to PRS-SUSPEND
else
move '0' to PRS-SUSPEND
end-if
end-if
end-if
if PRS-SUSPEND = 'N'
or PRS-SUSPEND = '0'
if PRS-BUFFER(I-PTR:1) = PRS-DELIMITER
add 1 to B-COUNT
if PRS-KEEP-NULL-FIELDS = 'Y'
or B-COUNT = 1
and PRS-SIZE(O-PTR) > 0
if O-PTR < PRS-TABLE-MAX
add 1 to O-PTR
add 1 to PRS-NUMBER-OF-ITEMS
else
move PRS-BUFFER-SIZE to I-PTR
end-if
end-if
else
subtract B-COUNT from B-COUNT
add 1 to PRS-SIZE(O-PTR)
if PRS-SIZE(O-PTR) = 1
move I-PTR to PRS-POSITION(O-PTR)
end-if
end-if
else
* PRS-SUSPEND should be a 1 indicating we should
* suspend processing for a delimiter
subtract B-COUNT from B-COUNT
add 1 to PRS-SIZE(O-PTR)
if PRS-SIZE(O-PTR) = 1
move I-PTR to PRS-POSITION(O-PTR)
end-if
end-if
add 1 to I-PTR
if PRS-TERMINATOR = 'Y'
and I-PTR not > PRS-BUFFER-SIZE
and PRS-BUFFER(I-PTR:1) = PRS-TERMINATOR-BYTE
if PRS-SIZE(O-PTR) > 0
add 1 to PRS-NUMBER-OF-ITEMS
end-if
add PRS-BUFFER-SIZE to 1 giving I-PTR
end-if
end-perform
if PRS-POSITION(O-PTR) = 0
subtract 1 from O-PTR
end-if
subtract RETURN-CODE from RETURN-CODE
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
This routine (SIMOROAD.CBL) is a simple routine that analyzes the keywords within the street address to determine if the street address is a PO Box.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOROAD.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC. *
* *
* 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 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 *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. 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 *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises 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 Enterprises *
* 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 Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
* Source Member: SIMOROAD.CBL
* Copy Files: PASSPARS.CPY
* Calls to: SIMOPARS
*****************************************************************
* MAINTENANCE
* -----------
* 1994/02/27 Simmons, Created program.
* 1994/03/17 Simmons, Fixed bug to correct recalculation of the
* size of the edited street address.
*
*****************************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* SIMOROAD '.
05 T2 pic X(32) value 'Processing a Street Address '.
05 T3 pic X(10) value ' v06.03.03'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* SIMOROAD '.
05 C2 pic X(20) value 'Copyright 1987-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMOROAD '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 WORD-14 pic X(14) value SPACES.
01 WORD-12 pic X(12) value SPACES.
01 WORD-SIZE pic 9(5) value 0.
01 X1 pic 9(5) value 0.
01 X2 pic 9(5) value 0.
01 X3 pic 9(5) value 0.
01 LOWER-CASE pic X(26) value 'abcdefghijklmnopqrstuvwxyz'.
01 UPPER-CASE pic X(26) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
*****************************************************************
* The following copy file is the pass area for calling SIMOPARS,
* the field parsing routine.
*****************************************************************
COPY PASSPARS.
*****************************************************************
LINKAGE SECTION.
COPY PASSROAD.
*****************************************************************
PROCEDURE DIVISION using ROAD-PASS-AREA.
* perform Z-POST-COPYRIGHT
move 'UNK ' to RDPA-ADR2-CNTL
move SPACES to RDPA-ADR2-DATA
add 16 to ZERO giving RDPA-RESULT
evaluate RDPA-ADR1-CNTL
when 'INP ' perform PROCESS-STREET-ADDRESS
when OTHER perform Z-ABEND-INVALID-REQUEST
end-evaluate
GOBACK.
*****************************************************************
* The following routines are in alphabetical sequence.. *
*****************************************************************
*
*****************************************************************
* This routine is used for debugging purposes,
*****************************************************************
ADDR-FUNCTION-DISPLAY-WORDS.
* Display the contents of the parsing tables.
add 1 to ZERO giving X1
perform until PRS-SIZE(X1) = 0
or PRS-POSITION(X1) = 0
or X1 > PRS-TABLE-MAX
or X1 > PRS-NUMBER-OF-ITEMS
move X1 to MESSAGE-TEXT(6:5)
move PRS-POSITION(X1) to MESSAGE-TEXT(19:4)
move PRS-SIZE(X1) to MESSAGE-TEXT(32:4)
if PRS-SIZE(X1) < 20
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to MESSAGE-TEXT(50:PRS-SIZE(X1))
else
move PRS-BUFFER(PRS-POSITION(X1):19)
to MESSAGE-TEXT(50:19)
end-if
perform Z-DISPLAY-CONSOLE-MESSAGE
add 1 to X1
end-perform
exit.
*****************************************************************
* Call the SIMOPARS routine to parse the Street Addres
*****************************************************************
ADDR-FUNCTION-PARSE.
*> Prepare control items for parsing.
move '0' to PRS-REQUEST
add 9 to ZERO giving PRS-STATUS
move ' ' to PRS-DELIMITER
* move 'N' to PRS-TERMINATOR-FLAG
move ' ' to PRS-TERMINATOR-BYTE
add 32 to ZERO giving PRS-TABLE-MAX
add 128 to ZERO giving PRS-BUFFER-SIZE
*> Move the data string to the parsing buffer and call
*> the parsing routine.
move RDPA-ADR1-DATA to PRS-BUFFER
call 'SIMOPARS' using PRS-PARAMETERS
exit.
*****************************************************************
BUILD-NEW-STREET-ADDRESS.
move SPACES to RDPA-ADR2-DATA
inspect PRS-BUFFER(1:PRS-BUFFER-SIZE)
converting UPPER-CASE to LOWER-CASE
add 1 to ZERO giving X1
add 1 to ZERO giving X2
perform until PRS-SIZE(X1) = 0
or PRS-POSITION(X1) = 0
or X1 > PRS-TABLE-MAX
or X1 > PRS-NUMBER-OF-ITEMS
if PRS-BUFFER(PRS-POSITION(X1):1) is NUMERIC
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to RDPA-ADR2-DATA(X2:PRS-SIZE(X1))
inspect
RDPA-ADR2-DATA(X2:PRS-SIZE(X1))
converting LOWER-CASE to UPPER-CASE
add PRS-SIZE(X1) to X2
add 1 to X2
else
perform BUILD-NEW-STREET-ADDRESS-100
end-if
add 1 to X1
end-perform
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-ADDRESS-100.
if PRS-BUFFER(PRS-POSITION(X1):1) = 'p'
and PRS-SIZE(X1) < 5
move SPACES to WORD-14
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to WORD-14
perform BUILD-NEW-STREET-POSSIBLE-POB
else
perform BUILD-NEW-STREET-NORMAL-WORD
end-if
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-POSSIBLE-POB.
evaluate WORD-14
when 'pob ' perform BUILD-NEW-STREET-POSSIBLE-PO-1
when 'pobox ' perform BUILD-NEW-STREET-POSSIBLE-PO-1
when 'p.o.box ' perform BUILD-NEW-STREET-POSSIBLE-PO-1
when 'pob. ' perform BUILD-NEW-STREET-POSSIBLE-PO-1
when 'po ' perform BUILD-NEW-STREET-POSSIBLE-PO-2
when 'p.o. ' perform BUILD-NEW-STREET-POSSIBLE-PO-2
when 'p. ' perform BUILD-NEW-STREET-POSSIBLE-PO-3
when 'p ' perform BUILD-NEW-STREET-POSSIBLE-PO-3
when 'post ' perform BUILD-NEW-STREET-POSSIBLE-PO-3
when OTHER perform BUILD-NEW-STREET-NORMAL-WORD
end-evaluate
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-POSSIBLE-PO-1.
move 'POB ' to RDPA-ADR2-CNTL
move 'P.O. Box ' to RDPA-ADR2-DATA(X2:9)
add 9 to X2
subtract RDPA-RESULT from RDPA-RESULT
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-POSSIBLE-PO-2.
add X1 to 1 giving X3
if PRS-POSITION(X3) > 0
and PRS-SIZE(X3) > 0
if PRS-BUFFER(PRS-POSITION(X3):4) = 'box '
move 'POB ' to RDPA-ADR2-CNTL
move 'P.O. Box ' to RDPA-ADR2-DATA(X2:9)
add 1 to X1
add 9 to X2
subtract RDPA-RESULT from RDPA-RESULT
else
if PRS-BUFFER(PRS-POSITION(X3):1) is NUMERIC
move 'POB ' to RDPA-ADR2-CNTL
move 'P.O. Box ' to RDPA-ADR2-DATA(X2:9)
add 9 to X2
subtract RDPA-RESULT from RDPA-RESULT
else
move 'PO? ' to RDPA-ADR2-CNTL
perform BUILD-NEW-STREET-NORMAL-WORD
subtract RDPA-RESULT from RDPA-RESULT
end-if
end-if
end-if
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-POSSIBLE-PO-3.
add X1 to 1 giving X3
if PRS-POSITION(X3) > 0
and PRS-SIZE(X3) > 0
if PRS-BUFFER(PRS-POSITION(X3):2) = 'o '
or PRS-BUFFER(PRS-POSITION(X3):3) = 'o. '
or PRS-BUFFER(PRS-POSITION(X3):7) = 'office '
add 1 to X3
if PRS-BUFFER(PRS-POSITION(X3):4) = 'box '
and PRS-POSITION(X3) > 0
and PRS-SIZE(X3) > 0
move 'POB ' to RDPA-ADR2-CNTL
move 'P.O. Box ' to RDPA-ADR2-DATA(X2:9)
add 2 to X1
add 9 to X2
subtract RDPA-RESULT from RDPA-RESULT
else
if PRS-BUFFER(PRS-POSITION(X3):1) is NUMERIC
move 'POB ' to RDPA-ADR2-CNTL
move 'P.O. Box ' to RDPA-ADR2-DATA(X2:9)
add 9 to X2
subtract RDPA-RESULT from RDPA-RESULT
else
move 'PO? ' to RDPA-ADR2-CNTL
perform BUILD-NEW-STREET-NORMAL-WORD
subtract RDPA-RESULT from RDPA-RESULT
end-if
end-if
else
perform BUILD-NEW-STREET-NORMAL-WORD
end-if
end-if
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-NORMAL-WORD.
*> Test for possible word substitution...
move SPACES to WORD-12
if PRS-SIZE(X1) < 13
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to WORD-12
perform BUILD-NEW-STREET-SUB-WORD-ALL
end-if
if WORD-12 = SPACES
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to RDPA-ADR2-DATA(X2:PRS-SIZE(X1))
inspect RDPA-ADR2-DATA(X2:1)
converting LOWER-CASE to UPPER-CASE
add PRS-SIZE(X1) to X2
add 1 to X2
subtract RDPA-RESULT from RDPA-RESULT
else
move WORD-12(1:WORD-SIZE)
to RDPA-ADR2-DATA(X2:WORD-SIZE)
if PRS-POSITION(X1) = 1
inspect RDPA-ADR2-DATA(X2:1)
converting LOWER-CASE to UPPER-CASE
end-if
add WORD-SIZE to X2
add 1 to X2
subtract RDPA-RESULT from RDPA-RESULT
end-if
exit.
*---------------------------------------------------------------*
BUILD-NEW-STREET-SUB-WORD-ALL.
evaluate WORD-12
when 'ave ' move 'Avenue ' to WORD-12
add 6 to ZERO giving WORD-SIZE
when 'ave. ' move 'Avenue ' to WORD-12
add 6 to ZERO giving WORD-SIZE
when 'bl ' move 'Blvd ' to WORD-12
add 4 to ZERO giving WORD-SIZE
when 'bl. ' move 'Blvd ' to WORD-12
add 4 to ZERO giving WORD-SIZE
when 'de ' move 'de ' to WORD-12
add 2 to ZERO giving WORD-SIZE
when 'la ' move 'la ' to WORD-12
add 2 to ZERO giving WORD-SIZE
when 'of ' move 'of ' to WORD-12
add 2 to ZERO giving WORD-SIZE
when 'and ' move 'and ' to WORD-12
add 3 to ZERO giving WORD-SIZE
when 'the ' move 'the ' to WORD-12
add 3 to ZERO giving WORD-SIZE
when 'macdougal ' move 'MacDougal' to WORD-12
add 9 to ZERO giving WORD-SIZE
when OTHER move SPACES to WORD-12
end-evaluate
exit.
*****************************************************************
CALCULATE-BUFFER-SIZE-01.
add PRS-NUMBER-OF-ITEMS to ZERO giving X1
add PRS-POSITION(X1) to PRS-SIZE(X1) giving RDPA-ADR1-SIZE
subtract 1 from RDPA-ADR1-SIZE
exit.
*****************************************************************
CALCULATE-BUFFER-SIZE-02.
if RDPA-ADR2-DATA = SPACES
move ZERO to RDPA-ADR2-SIZE
else
add length of RDPA-ADR2-DATA to ZERO giving X1
add length of RDPA-ADR2-DATA to ZERO giving X3
perform until X1 not = X3
or X1 < 4
divide X3 by 2 giving X1
if X1 > 0
if RDPA-ADR2-DATA(X1 + 1:X3 - X1) = SPACES
add X1 to ZERO giving X3
end-if
end-if
end-perform
add 1 to ZERO giving RDPA-ADR2-SIZE
move ZERO to X2
perform until X2 = X3
add 1 to X2
if RDPA-ADR2-DATA(X2:1) not = SPACE
add X2 to ZERO giving RDPA-ADR2-SIZE
end-if
end-perform
end-if
exit.
*****************************************************************
COMPRESS-MULTIPLE-SPACES.
move SPACES to RDPA-ADR2-DATA
add 1 to ZERO giving X1
add 1 to ZERO giving X2
perform until PRS-SIZE(X1) = 0
or PRS-POSITION(X1) = 0
or X1 > PRS-TABLE-MAX
or X1 > PRS-NUMBER-OF-ITEMS
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to RDPA-ADR2-DATA(X2:PRS-SIZE(X1))
add X2 to ZERO giving PRS-POSITION(X1)
add PRS-SIZE(X1) to X2
add 1 to X2
add 1 to X1
end-perform
move SPACES to PRS-BUFFER
move RDPA-ADR2-DATA to PRS-BUFFER
move SPACES to RDPA-ADR2-DATA
exit.
*---------------------------------------------------------------*
POST-TABLE-ITEM.
move 'Item-nnnn, Offset-nnnn, Length-nnnn, Parameter - '
to MESSAGE-TEXT(1:49)
move X1 to MESSAGE-TEXT(6:4)
move PRS-POSITION(X1) to MESSAGE-TEXT(19:4)
move PRS-SIZE(X1) to MESSAGE-TEXT(32:4)
if PRS-SIZE(X1) < 20
move PRS-BUFFER(PRS-POSITION(X1):PRS-SIZE(X1))
to MESSAGE-TEXT(50:PRS-SIZE(X1))
else
move PRS-BUFFER(PRS-POSITION(X1):19)
to MESSAGE-TEXT(50:19)
end-if
perform Z-DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
PROCESS-STREET-ADDRESS.
if RDPA-ADR1-DATA = SPACES
or RDPA-ADR1-DATA = LOW-VALUES
perform Z-ABEND-INVALID-INPUT
else
perform ADDR-FUNCTION-PARSE
perform CALCULATE-BUFFER-SIZE-01
if PRS-STATUS = 0
* perform ADDR-FUNCTION-DISPLAY-WORDS
perform COMPRESS-MULTIPLE-SPACES
perform PROCESS-STREET-ADDRESS-100
perform CALCULATE-BUFFER-SIZE-02
else
move 'Parsing Error' to RDPA-ADR2-DATA
move RDPA-ADR2-DATA to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
end-if.
exit.
*---------------------------------------------------------------*
PROCESS-STREET-ADDRESS-100.
perform BUILD-NEW-STREET-ADDRESS
if RDPA-ADR2-CNTL = 'UNK '
and RDPA-ADR2-DATA not = SPACES
if RDPA-ADR1-DATA = RDPA-ADR2-DATA
move 'AOK ' to RDPA-ADR2-CNTL
subtract RDPA-RESULT from RDPA-RESULT
else
move 'MOD ' to RDPA-ADR2-CNTL
subtract RDPA-RESULT from RDPA-RESULT
end-if
subtract RDPA-RESULT from RDPA-RESULT
end-if
exit.
*****************************************************************
* The following Z-Routines perform administrative functions *
* 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.
*---------------------------------------------------------------*
Z-ABEND-INVALID-REQUEST.
add 18 to ZERO giving RDPA-RESULT
move 'ERR ' to RDPA-ADR2-CNTL
move 'Call to SimoROAD with invalid request'
to RDPA-ADR2-DATA
exit.
*---------------------------------------------------------------*
Z-ABEND-INVALID-INPUT.
add 20 to ZERO giving RDPA-RESULT
move 'ERR ' to RDPA-ADR2-CNTL
move 'Call to SimoROAD with blank input address'
to RDPA-ADR2-DATA
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-CONSOLE-MESSAGE.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79) upon console
else
display MESSAGE-BUFFER upon console
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
This program (CBLSRTC1.CBL) is a simple program that reads a sequential file and creates a new sequential file with the records sorted into ascending sequence by postal code. This example includes two JCL members and two .CMD members that will sort using the sort utility program or the following COBOL program.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLSRTC1.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC. *
* *
* 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 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 *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. 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 *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises 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 Enterprises *
* 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 Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: CBLSRTC1.CBL
*****************************************************************
* CBLSRTC1 - Sort a File.
*
* CALLING PROTOCOL
* ----------------
* Use standard procedure to RUN or ANIMATE.
*
* DESCRIPTION
* -----------
* This program will sort a file by Postal Code sequence.
*
* ************ ************ ************
* * MAILTEMP *-----* CBLSRTC1 *-----* MAILSORT *
* ************ ********cbl* ******dsply*
* *
* *
* ************
* * EOJ *
* ************
*
*****************************************************************
* MAINTENANCE
* -----------
* 1989/02/27 Simmons, Created program.
* 1997/03/17 Simmons, Updated for OPEN to test existance of
* the input file.
*
*****************************************************************
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SORT-WORK ASSIGN TO SORTWORK.
SELECT SORT-INPUT ASSIGN TO MAILTEMP
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS SORT-INPUT-STATUS.
SELECT SORT-OUTPUT ASSIGN TO MAILSORT
ORGANIZATION IS SEQUENTIAL.
*****************************************************************
DATA DIVISION.
FILE SECTION.
SD SORT-WORK.
01 SORT-WORK-RECORD.
05 FILLER pic X(232).
05 POSTAL-CODE pic X(12).
FD SORT-INPUT.
01 SORT-INPUT-RECORD.
05 FILLER pic X(232).
05 POSTAL-CODE pic X(12).
FD SORT-OUTPUT.
01 SORT-OUTPUT-RECORD.
05 FILLER pic X(232).
05 POSTAL-CODE pic X(12).
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLSRTC1 '.
05 T2 pic X(34) value 'Sort Items, Postal Code Sequence '.
05 T3 pic X(10) value ' v08.01.03'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* CBLSRTC1 '.
05 C2 pic X(20) value 'Copyright 1987-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SORT-INPUT-STATUS.
05 SORT-INPUT-STATUS-L pic X.
05 SORT-INPUT-STATUS-R pic X.
*****************************************************************
* The following buffers are used to create a four-byte numeric *
* file status code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
*****************************************************************
* Buffer used for posting messages to the console.
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* CBLSRTC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 END-OF-FILE pic X(3) value 'NO '.
*****************************************************************
PROCEDURE DIVISION.
MAINLINE.
perform Z-POST-COPYRIGHT
perform CHECK-SORTIN-FILE-EXIST
perform SORT-THE-FILE
GOBACK.
*****************************************************************
CHECK-SORTIN-FILE-EXIST.
open input SORT-INPUT.
if SORT-INPUT-STATUS = '00'
close SORT-INPUT
move 'Sort-Input-File-Exist...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'SORT-INPUT-FAILURE-OPEN-!!!' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SORT-INPUT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
SORT-THE-FILE.
sort SORT-WORK
on ascending POSTAL-CODE in SORT-WORK-RECORD
using SORT-INPUT
giving SORT-OUTPUT
exit.
*****************************************************************
* The following Z-Routines perform administrative functions
* for this program.
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM IS ABENDING !!!' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 16 to ZERO giving RETURN-CODE
GOBACK.
* exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79) upon console
else
display MESSAGE-BUFFER upon console
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
This program (STAMLRC2.CBL) is a simple program that reads a sequential file that has been sorted into Postal code sequence and creates an output file that is formatted for printing four-across mailing labels.
IDENTIFICATION DIVISION.
PROGRAM-ID. STAMLRC2.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC. *
* *
* 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 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 *
* Enterprises. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Enterprises. 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 *
* Enterprises. *
* *
* SimoTime Enterprises makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any express or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Enterprises 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 Enterprises *
* 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 Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
*
*****************************************************************
* Source Member: STAMLRC2.CBL
* Copy Files: MAILCB01.CPY
*****************************************************************
*
* ************
* * STAMLRJ1 *
* ********jcl*
* *
* ************
* * IEFBR14 *
* ********utl*
* *
* ************ ************ ************
* * CUSTMAST *-----* STAMLRC1 *-----* MAILTEMP *
* ********dat* ********cbl* ********dat*
* * *
* * * ************
* * ***call*** SIMOROAD *
* * ********cbl*
* * *
* * ************
* * * SIMOPARS *
* * ********cbl*
* *
* ************ ************ ************
* * MAILTEMP *-----* SORT *-----* MAILSORT *
* ********dat* ********cbl* ********dat*
* *
* *
* ************ ************ ************
* * MAILSORT *-----* STAMLRC2 *-----* MAILTEXT *
* ********dat* ********cbl* ********dat*
* *
* *
* ************
* * EOJ *
* ************
*
*****************************************************************
* This program will read the input file and create a sequential
* output file with the records formatted to print mailing labels
* four across a page of six lines each.
*****************************************************************
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT MAILSORT-FILE ASSIGN to MAILSORT
ORGANIZATION is SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is MAILSORT-STATUS.
SELECT MAILTEXT-FILE ASSIGN to MAILTEXT
ORGANIZATION is SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is MAILTEXT-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD MAILSORT-FILE
DATA RECORD IS MAIL-RECORD.
COPY MAILCB01.
FD MAILTEXT-FILE
DATA RECORD is MAILTEXT-RECORD.
01 MAILTEXT-RECORD.
05 MAILTEXT-DATA pic X(192).
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* STAMLRC2 '.
05 T2 pic X(34) value 'Print Mail Labels, 1-4 Across '.
05 T3 pic X(10) value ' v08.01.03'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* STAMLRC2 '.
05 C2 pic X(20) value 'Copyright 1987-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* STAMLRC2 '.
05 C2 pic X(32) value 'Thank you for using this sample '.
05 C3 pic X(32) value 'by SimoTime Enterprises, LLC '.
05 C4 pic X(04) value ' '.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* STAMLRC2 '.
05 C2 pic X(32) value 'Please send comments or suggesti'.
05 C3 pic X(32) value 'ons to helpdesk@simotime.com '.
05 C4 pic X(04) value ' '.
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* STAMLRC2 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MAILSORT-STATUS.
05 MAILSORT-STATUS-L pic X.
05 MAILSORT-STATUS-R pic X.
01 MAILSORT-EOF pic X value 'N'.
01 MAILSORT-OPEN-FLAG pic X value 'C'.
01 MAILTEXT-STATUS.
05 MAILTEXT-STATUS-L pic X.
05 MAILTEXT-STATUS-R pic X.
01 MAILTEXT-EOF pic X value 'N'.
01 MAILTEXT-OPEN-FLAG pic X value 'C'.
01 WORK-80 pic X(80) value SPACES.
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 THREE-BYTE-VALUE pic 9(3) value 0.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 P-LABELS.
05 P-LABELS-ARRAY occurs 6 TIMES.
10 P-LABELS-CELL pic X(48) occurs 4 TIMES
value SPACES.
01 P-IX1 pic 9(2) value 0.
01 P-IX2 pic 9(2) value 0.
01 P-IX3 pic 9(2) value 0.
01 ACROSS-NUMBER-TEXT.
05 filler pic X(27) value 'Number of labels across is '.
05 ACROSS-NUMBER-X.
10 ACROSS-NUMBER pic 9 value 4.
01 MAILSORT-TOTAL.
05 filler pic X(23) value 'MAILSORT line count is '.
05 MAILSORT-RDR pic 9(9) value 0.
01 MAILTEXT-TOTAL.
05 filler pic X(23) value 'MAILTEXT line count is '.
05 MAILTEXT-ADD pic 9(9) value 0.
*****************************************************************
LINKAGE SECTION.
01 PARM-BUFFER.
05 PARM-LENGTH pic S9(4) comp.
05 PARM-DATA pic X(256).
*****************************************************************
PROCEDURE DIVISION using PARM-BUFFER.
perform Z-POST-COPYRIGHT
if PARM-LENGTH = 1
and PARM-DATA(1:1) is NUMERIC
move PARM-DATA(1:1) to ACROSS-NUMBER-X
end-if
move ACROSS-NUMBER-TEXT to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform MAILSORT-OPEN
perform MAILTEXT-OPEN
perform until MAILSORT-STATUS not = '00'
perform MAILSORT-READ
if MAILSORT-STATUS = '00'
add 1 to MAILSORT-RDR
add 1 to P-IX1
add 2 to ZERO giving P-IX2
move SPACES to WORK-80
string MAIL-FIRST-NAME delimited by ' '
SPACE delimited by SIZE
MAIL-MID-NAME delimited by ' '
SPACE delimited by SIZE
MAIL-LAST-NAME delimited by ' '
into WORK-80
end-string
move WORK-80 to P-LABELS-CELL(P-IX2, P-IX1)
add 1 to P-IX2
if MAIL-ADDRESS-1 not = SPACES
move MAIL-ADDRESS-1
to P-LABELS-CELL(P-IX2, P-IX1)
add 1 to P-IX2
end-if
if MAIL-ADDRESS-2 not = SPACES
move MAIL-ADDRESS-2
to P-LABELS-CELL(P-IX2, P-IX1)
add 1 to P-IX2
end-if
string MAIL-CITY delimited by ' '
', ' delimited by SIZE
MAIL-STATE delimited by ' '
' ' delimited by SIZE
MAIL-POSTAL-CODE delimited by ' '
into P-LABELS-CELL(P-IX2, P-IX1)
end-string
end-if
if P-IX1 = ACROSS-NUMBER
add P-IX1 to MAILTEXT-ADD
perform PRINT-LABEL-SET-AND-CLEAR
subtract P-IX1 from P-IX1
end-if
end-perform
if P-IX1 > 0
add P-IX1 to MAILTEXT-ADD
perform PRINT-LABEL-SET-AND-CLEAR
subtract P-IX1 from P-IX1
end-if
move MAILSORT-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEXT-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform Z-THANK-YOU
GOBACK.
*****************************************************************
PRINT-LABEL-SET-AND-CLEAR.
add 1 to ZERO giving P-IX3
perform 6 TIMES
move P-LABELS-ARRAY(P-IX3) to MAILTEXT-DATA
perform MAILTEXT-WRITE
move SPACES to P-LABELS-ARRAY(P-IX3)
add 1 to P-IX3
end-perform
exit.
*****************************************************************
* I/O ROUTINES FOR MAILSORT... *
*****************************************************************
MAILSORT-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close MAILSORT-FILE
if MAILSORT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MAILSORT-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILSORT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
MAILSORT-READ.
read MAILSORT-FILE
if MAILSORT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if MAILSORT-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 MAILSORT-EOF
else
move 'MAILSORT-Failure-GET...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILSORT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
MAILSORT-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input MAILSORT-FILE
if MAILSORT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to MAILSORT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MAILSORT-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILSORT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O ROUTINES FO RMAILTEXT... *
*****************************************************************
MAILTEXT-WRITE.
if MAILTEXT-OPEN-FLAG = 'C'
perform MAILTEXT-OPEN
end-if
write MAILTEXT-RECORD
if MAILTEXT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if MAILTEXT-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 'MAILTEXT-Failure-WRITE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEXT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
MAILTEXT-OPEN.
add 8 to ZERO giving APPL-RESULT.
open output MAILTEXT-FILE
if MAILTEXT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to MAILTEXT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MAILTEXT-Failure-OPEN...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEXT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
MAILTEXT-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close MAILTEXT-FILE
if MAILTEXT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to MAILTEXT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'MAILTEXT-Failure-CLOSE...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEXT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-Routines perform administrative tasks *
*****************************************************************
* 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-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
GOBACK.
* exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79) upon console
else
display MESSAGE-BUFFER upon console
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
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
add TWO-BYTES-BINARY to ZERO giving THREE-BYTE-VALUE
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STAT1 to MESSAGE-TEXT(17:1)
move THREE-BYTE-VALUE to MESSAGE-TEXT(18:3)
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'File Status is: 00nn' to MESSAGE-TEXT
move IO-STATUS to MESSAGE-TEXT(19:2)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
Z-THANK-YOU.
display SIM-THANKS-01 upon console
display SIM-THANKS-02 upon console
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
This program source member (CUSTCB01.CPY) is the copy file for the record layout of the Indexed file. The file name is CUSTMAST.DAT.
*****************************************************************
* Copy File for Customer Master File used by the Demo programs. *
* This is a VSAM Keyed=Sequential-Data-Set or Key-Indexed File. *
*****************************************************************
* Copyright (C) 1987-2010 SimoTime Enterprises *
* All Rights Reserved *
*****************************************************************
* Provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
01 CUST-RECORD.
05 CUST-NUMBER PIC X(12).
05 CUST-DATA.
10 CUST-STATUS PIC X.
10 CUST-NAME.
15 CUST-LAST-NAME PIC X(28).
15 CUST-FIRST-NAME PIC X(20).
15 CUST-MID-NAME PIC X(20).
10 CUST-ADDRESS-1 PIC X(48).
10 CUST-ADDRESS-2 PIC X(48).
10 CUST-CITY PIC X(28).
10 CUST-STATE PIC X(28).
10 CUST-POSTAL-CODE PIC X(12).
10 CUST-PHONE-HOME PIC X(18).
10 CUST-PHONE-WORK PIC X(18).
10 CUST-PHONE-CELL PIC X(18).
10 CUST-CREDIT-LIMIT PIC 9(7) COMP-3.
10 CUST-DISCOUNT OCCURS 3 TIMES.
15 CUST-DISCOUNT-CODE PIC S9(3) COMP.
15 CUST-DISCOUNT-RATE PIC S9(2)V999.
15 CUST-DISCOUNT-DATE PIC X(8).
10 CUST-LADATE PIC X(8).
10 CUST-LATIME PIC X(8).
10 CUST-TOKEN PIC 9(3).
10 FILLER PIC X(145).
*! CUSTCB01 - End-of-Copy File...
This following is the contents of the control file (STAMLRT1.CTL) that contains the sorting specifications.
* ASCENDING SORT ON POSTAL CODE, LAST, FIRST AND MIDDLE NAME
* ..:....1....:....2....:....3....:....4....:....5....:....6....:....7.
SORT FIELDS=(233,12,CH,A,
13,28,CH,A,
41,20,CH,A,
61,20,CH,A)
* ELIMINATE DUPLICATES
SUM FIELDS=NONE
END
The purpose of this document is to assist as a tutorial for new programmers or as a quick reference for experienced programmers. These sample programs are made available on an "as-is" basis and may be downloaded, copied and modified for specific situations as long as the copyright information is not removed or changed. As always, it is the programmer's responsibility to thoroughly test all programs.
Permission to use, copy, modify and distribute this software for any commercial purpose requires a fee to be paid to SimoTime Enterprises. 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 Enterprises.
Permission to use, copy, modify and distribute this software for a 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 Enterprises.
SimoTime Enterprises makes no warranty or representations about the suitability of the software for any purpose. It is provided "AS IS" without any express or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises 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.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
You may download this example at http://www.simotime.com/sim4dzip.htm#COBOLZipMailingLabels as a Z-Pack. The Z-Packs provide individual programming examples, documentation and test data files in a single package. The Z-Packs are usually in zip format to reduce the amount of time to download.
Please view the complete list of SimoTime Z-Pack Examples at http://www.simotime.com/sim4dzip.htm.
Note: You must be attached to the Internet to download a Z-Pack or view the list.
This suite of programs uses a Customer Master File as input. The Customer Master file contains variable length records with the minimum and average record length being the same length of 512 bytes. The key starts in the first position of the record and is 12 bytes in length. The record layout is defined in a COBOL copy file and contains text strings and various numeric formats including zoned-decimal, packed and binary. Simply click on one of the following items to learn more or download this sample set of programs that will create a customer master file.
This document provides a quick summary of the VSAM-QSAM File Status Key.
The following chart provides a list of the sample COBOL programs that do table processing.
| HTML Tag | Description |
| binbit01 | This suite of sample programs describes how to use COBOL to create a table or text string of binary values from X'00' through X'FF'. |
| cblbin01 | 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. |
| cbltbl01 | This suite of sample programs describes 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. |
| stamlr01 | The program has the ability to print 1, 2, 3 or 4 across labels. This example uses a two-dimensional array to build the label-printing output. |
Check out The COBOL Connection in the SimoTime Library for more examples of mainframe COBOL techniques and sample code.
Check out The VSAM-QSAM Connection in the SimoTime Library for more examples of mainframe COBOL techniques and sample code.
This document provides a quick summary of the File Status Key for VSAM data sets and QSAM files. The File Status Key is a two character data item. The first character of the status key is known as status key 1; the second character is known as status key 2.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
Founded in 1987, SimoTime Enterprises 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. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. 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. 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 |
| Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |