| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
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 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Sort specifications from a PDS Member |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Create four-across mailing labels. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
End-Of-Job |
| |
|
|
|
|
|
|
|
|
Overview of Application for Printing Mailing Labels
|
Color Associations: The light-green boxes are unique to SIMOTIME Technologies using an IBM Mainframe System or Micro Focus Enterprise Developer.
The light-red boxes are unique to the SIMOTIME Technologies using a Linux, UNIX or Windows System and COBOL Technologies such as Micro Focus.
The light-yellow boxes are SIMOTIME Technologies, Third-party Technologies, decision points or program transitions in the processing logic or program generations.
The light-blue boxes identify the input/output data structures such as Documents, Spreadsheets, Data Files, VSAM Data Sets, Partitioned Data Set Members (PDSM's) or Relational Tables.
The light-gray boxes identify a system function or an informational item.
CMD Files, Execute a Job
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.
Extract, SORT and Print
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 * STAMLRE1.cmd - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create four-across mailing label file
rem * Author - SimoTime Technologies
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
set CmdName=StaMlrE1
call ..\Env1BASE %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%, User is %USERNAME%"
call SimoNOTE "Identify JobStep StaMlrS1, Set Globals, Delete Previous Files"
set MAILTEMP=%BaseLib1%\DATA\wrk1\MAILTEMP.DAT
set MAILSORT=%BaseLib1%\DATA\wrk1\MAILSORT.DAT
set MAILTEXT=%BaseLib1%\DATA\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 * The NOPOBOX parameter 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%\DATA\APPL\SIMOTIME.DATA.CUSTMAST.DAT
run SimoEXEC EXEC STAMLRC1 '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%\PARMLIB\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% call SimoNOTE "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 * 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"
run SimoEXEC EXEC STAMLRC2
if ERRORLEVEL = 1 set JobStatus=0030
if not "%JobStatus%" == "0000" goto :EojNOK
goto :StaMlrNormalEOJ
rem *
:EojNOK
call SimoNOTE "ABENDING JobName %CmdName%, JobStatus %JobStatus%"
call SimoNOTE "ABENDING Message JobStatus %JobStatus%"
goto :StaMlrPause
:StaMlrNormalEOJ
if exist %MAILTEXT% call SimoNOTE "Produced DataSet %MAILTEXT%"
call SimoNOTE "Finished JobName %CmdName%"
:StaMlrPause
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
Extract, COBOL Callable SORT & Print
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 * STAMLRE2.cmd - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Create 4-across and 1-across mailing label files
rem * Author - SimoTime Technologies
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 *-----* STASRTC1 *-----* 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 ..\Env1BASE
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%\DATA\Wrk1\MAILTEMP.DAT
set MAILSORT=%BaseLib1%\DATA\Wrk1\MAILSORT.DAT
set MAILTEXT=%BaseLib1%\DATA\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 NOPOBOX parameter 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%\DATA\APPL\SIMOTIME.DATA.CUSTMAST.DAT
run SimoEXEC EXEC STAMLRC1 '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 SimoEXEC EXEC STASRTC1
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"
run 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%\DATA\Wrk1\MAILTXT1.DAT
if exist %MAILTEXT% del %MAILTEXT%
run SimoEXEC EXEC STAMLRC2 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
JCL Members, Execute a Job
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.
Extract, SORT and Print
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=&SYSUID
//* *******************************************************************
//* This JCL Member is provided by SimoTime Technologies *
//* (C) Copyright 1987-2019 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Create four-across mailing label file
//* Author - SimoTime Technologies
//* 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*
//* * *
//* ************ * *
//* * STAMLRT1 **** *
//* *******pdsm* *
//* *
//* ************ ************ ************
//* * MAILSORT *-----* STAMLRC2 *-----* MAILTEXT *
//* ********dat* ********cbl* ********dat*
//* *
//* *
//* ************
//* * EOJ *
//* ************
//*
//* *******************************************************************
//* Step 1 of 4, Delete any previously created file...
//* *******************************************************************
//*
//JOBSETUP EXEC PGM=IEFBR14
//MAILTEMP DD DSN=SIMOTIME.DATA.MAILTEMP,DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=244,DSORG=PS)
//MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=244,DSORG=PS)
//MAILTEXT DD DSN=SIMOTIME.DATA.MAILTEXT,DISP=(MOD,DELETE,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=192,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'
//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,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=SIMOTIME.PDS.PARMLIB(STAMLRT1),DISP=SHR
//SORTIN DD DSN=SIMOTIME.DATA.MAILTEMP,DISP=OLD
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,55)
//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,55)
//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,55)
//SORTOUT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=244,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)
//MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=OLD
//MAILTEXT DD DSN=SIMOTIME.DATA.MAILTEXT,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=192,DSORG=PS)
//SYSOUT DD SYSOUT=*
//*
Extract, COBOL Callable SORT & Print
The following is the mainframe JCL (STAMLRJ2.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 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.
//STAMLRJ2 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=&SYSUID
//* *******************************************************************
//* This JCL Member is provided by SimoTime Technologies *
//* (C) Copyright 1987-2019 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Create four-across and one-across mailing label files
//* Author - SimoTime Technologies
//* 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 *-----* STASRTC1 *-----* 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...
//* *******************************************************************
//*
//JOBSETUP 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)
//MAILTXT1 DD DSN=SIMOTIME.DATA.MAILTXT1,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'
//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,DSORG=PS)
//SYSOUT DD SYSOUT=*
//*
//* *******************************************************************
//* Step 3 of 5, Sort by Zip Code using COBOL Program...
//* *******************************************************************
//*
//SORTST03 EXEC PGM=STASRTC1,COND=(0,LT)
//MAILTEMP DD DSN=SIMOTIME.DATA.MAILTEMP,DISP=OLD
//MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=244,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)
//MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=OLD
//MAILTEXT DD DSN=SIMOTIME.DATA.MAILTEXT,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=192,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
//MAILSORT DD DSN=SIMOTIME.DATA.MAILSORT,DISP=OLD
//MAILTEXT DD DSN=SIMOTIME.DATA.MAILTXT1,DISP=(NEW,CATLG,DELETE),
// STORCLAS=MFI,SPACE=(TRK,5),
// DCB=(RECFM=FB,LRECL=192,DSORG=PS)
//SYSOUT DD SYSOUT=*
//*
COBOL Program Members
This section describes the executable COBOL programs, callable routines and the COBOL copy file used by the jobs that extract customer records, sort and print mailing labels.
Omit PO Box Addresses
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 TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
*
*****************************************************************
* Source Member: 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 ' v11.02.07'.
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-2019 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
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-RDR pic 9(9) value 0.
01 MAILTEMP-ADD pic 9(9) value 0.
01 CUSTMAST-TOTAL.
05 filler pic X(23) value 'CUSTMAST line count is '.
05 CUSTMAST-TOT pic ZZZ,ZZZ,ZZ9.
01 MAILTEMP-TOTAL.
05 filler pic X(23) value 'MAILTEMP line count is '.
05 MAILTEMP-TOT pic ZZZ,ZZZ,ZZ9.
*****************************************************************
* 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-RDR to CUSTMAST-TOT
move CUSTMAST-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEMP-ADD to MAILTEMP-TOT
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
add length of CUST-ADDRESS-1 to ZERO giving RDPA-ADR1-SIZE
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 Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Routine for Parsing a Data Buffer
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 TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: 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.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMOPARS '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
LINKAGE SECTION.
COPY PASSPARS.
*****************************************************************
PROCEDURE DIVISION using PRS-PARAMETERS.
if PRS-REQUEST not = '2'
perform EDIT-LINKAGE-ITEMS
end-if
add 8 to ZERO giving RETURN-CODE
add 9 to ZERO giving PRS-STATUS
move ZERO to PRS-NUMBER-OF-ITEMS
evaluate PRS-REQUEST
when '0' perform PARSE-BUFFER
when '1' perform INITIALIZE-TABLE-ELEMENTS
when '2' perform INITIALIZE-DEFAULT-VALUES
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
move 'PRS-TABLE-MAX set to 128' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-TABLE-MAX > 128
add 128 to ZERO giving PRS-TABLE-MAX
move 'PRS-TABLE-MAX set to 128' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-BUFFER-SIZE not numeric
add 2048 to ZERO giving PRS-BUFFER-SIZE
move 'PRS-BUFFER-SIZE set to 2048' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
if PRS-BUFFER-SIZE > 2048
add 2048 to ZERO giving PRS-BUFFER-SIZE
move 'PRS-BUFFER-SIZE set to 2048' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
INITIALIZE-DEFAULT-VALUES.
move ',' to PRS-DELIMITER
move 'Y' to PRS-SPACE-TRUNCATION
move 'Y' to PRS-KEEP-NULL-FIELDS
add 128 to ZERO giving PRS-TABLE-MAX
add 2048 to ZERO giving PRS-BUFFER-SIZE
perform INITIALIZE-TABLE-ELEMENTS
move '0' to PRS-REQUEST
move ZERO to PRS-STATUS
move ZERO to PRS-NUMBER-OF-ITEMS
move ZERO to PRS-LAST-SIG-BYTE
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 Position/Length tables to zero (0).
perform INITIALIZE-TABLE-ELEMENTS
move ZERO to PRS-LAST-SIG-BYTE
*! Parse the Buffer.
add 1 to ZERO giving O-PTR
perform until I-PTR > PRS-BUFFER-SIZE
perform PARSE-BUFFER-10
end-perform
* Wrap-up the parse of this buffer...
if PRS-LAST-SIG-BYTE > 0
and PRS-BUFFER(PRS-LAST-SIG-BYTE:1) not = PRS-DELIMITER
add 1 to PRS-NUMBER-OF-ITEMS
end-if
if PRS-POSITION(O-PTR) = 0
subtract 1 from O-PTR
end-if
subtract RETURN-CODE from RETURN-CODE
exit.
*---------------------------------------------------------------*
PARSE-BUFFER-10.
if PRS-BUFFER(I-PTR:1) not = SPACE
add I-PTR to ZERO giving PRS-LAST-SIG-BYTE
end-if
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
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
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* This example is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Routine to Analyze Street Address
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 TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
* Source Member: 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 ' v08.03.28'.
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-2019 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
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
move ' ' to PRS-TERMINATOR-BYTE
add 32 to ZERO giving PRS-TABLE-MAX
if RDPA-ADR1-SIZE > 0
add RDPA-ADR1-SIZE to ZERO giving PRS-BUFFER-SIZE
else
add 48 to ZERO giving PRS-BUFFER-SIZE
end-if
move ZERO to PRS-NUMBER-OF-ITEMS
*> 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
if PRS-STATUS not = 0
move 'Parsing Failure of Address Field' to MESSAGE-TEXT
perform Z-ABEND-PROGRAM
end-if
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 Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Sort by Postal Code
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 TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: 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.
*
* ************ ************ ************
* * CBLSRTD1 *-----* CBLSRTC1 *-----* CBLSRTD2 *
* ************ ********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 CBLSRTD1
ORGANIZATION IS SEQUENTIAL
FILE STATUS IS SORT-INPUT-STATUS.
SELECT SORT-OUTPUT ASSIGN TO CBLSRTD2
ORGANIZATION IS SEQUENTIAL.
*****************************************************************
DATA DIVISION.
FILE SECTION.
SD SORT-WORK.
01 SORT-WORK-RECORD.
05 CBLSRT-RS-KEY pic X(12).
05 FILLER pic X(68).
FD SORT-INPUT.
COPY CBLSRTB1.
FD SORT-OUTPUT.
01 SORT-OUTPUT-RECORD.
05 CBLSRT-RS-KEY pic X(12).
05 FILLER pic X(68).
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* CBLSRTC1 '.
05 T2 pic X(34) value 'Sort a File, RSEQ-80 using 1-12 '.
05 T3 pic X(10) value ' v13.05.28'.
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-2019 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
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 CBLSRT-RS-KEY in SORT-WORK-RECORD
with DUPLICATES in ORDER
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 Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Print 1, 2, 3 or 4 Across Mailing Labels
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 TECHNOLOGIES.
*****************************************************************
* Copyright (C) 1987-2019 SimoTime Technologies. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only and does not imply publication *
* or disclosure. *
* *
* Permission to use, copy, modify and distribute this software *
* for any non-commercial purpose and without fee is hereby *
* granted, provided the SimoTime copyright notice appear on all *
* copies of the software. The SimoTime name or Logo may not be *
* used in any advertising or publicity pertaining to the use *
* of the software without the written permission of SimoTime *
* Technologies. *
* *
* Permission to use, copy, modify and distribute this software *
* for any commercial purpose requires a fee to be paid to *
* SimoTime Technologies. Once the fee is received by SimoTime *
* the latest version of the software will be delivered and a *
* license will be granted for use within an enterprise, *
* provided the SimoTime copyright notice appear on all copies *
* of the software. The SimoTime name or Logo may not be used *
* in any advertising or publicity pertaining to the use of the *
* software without the written permission of SimoTime *
* Technologies. *
* *
* SimoTime Technologies makes no warranty or representations *
* about the suitability of the software for any purpose. It is *
* provided "AS IS" without any expressed or implied warranty, *
* including the implied warranties of merchantability, fitness *
* for a particular purpose and non-infringement. SimoTime *
* Technologies shall not be liable for any direct, indirect, *
* special or consequential damages resulting from the loss of *
* use, data or projects, whether in an action of contract or *
* tort, arising out of or in connection with the use or *
* performance of this software *
* *
* SimoTime Technologies *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Technologies, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
*
*****************************************************************
* Source Member: 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 ' v09.11.25'.
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-2019 '.
05 C3 pic X(28) value ' SimoTime Technologies '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* STAMLRC2 '.
05 C2 pic X(32) value 'Thank you for using this program'.
05 C3 pic X(32) value ' provided from SimoTime Technolo'.
05 C4 pic X(04) value 'gies'.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* STAMLRC2 '.
05 C2 pic X(32) value 'Please send all inquires or sugg'.
05 C3 pic X(32) value 'estions to the helpdesk@simotime'.
05 C4 pic X(04) value '.com'.
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* 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-30-GROUP.
05 filler pic X value SPACE.
05 WORK-30 pic X(30) value SPACES.
01 WORK-30-LS redefines WORK-30-GROUP
pic X(31).
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-RDR pic 9(9) value 0.
01 MAILTEXT-ADD pic 9(9) value 0.
01 MAILSORT-TOTAL.
05 filler pic X(23) value 'MAILSORT line count is '.
05 MAILSORT-TOT pic ZZZ,ZZZ,ZZ9.
01 MAILTEXT-TOTAL.
05 filler pic X(23) value 'MAILTEXT line count is '.
05 MAILTEXT-TOT pic ZZZ,ZZZ,ZZ9.
*****************************************************************
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
move MAIL-FIRST-NAME to WORK-80
move MAIL-MID-NAME to WORK-30
inspect WORK-80 replacing
first ' '
by WORK-30-LS
move MAIL-LAST-NAME to WORK-30
inspect WORK-80 replacing
first ' '
by WORK-30-LS
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-RDR to MAILSORT-TOT
move MAILSORT-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move MAILTEXT-ADD to MAILTEXT-TOT
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 Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
Customer File, Record Structure
This program source member (CUSTCB01.cpy) is the copy file for the record layout of the Indexed file. The file name is CUSTMAST.DAT.
*****************************************************************
* CUSTCB01.cpy - a COBOL Copy Member *
* Customer Master File used for Quality Assurance Testing *
* This is a VSAM Keyed-Sequential-Data-Set or KSDS *
* Copyright (C) 1987-2020 SimoTime Technologies *
* All Rights Reserved *
* Provided by SimoTime Technologies *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
* CUST-RECORD size is 512 bytes.
* RMIN is 512 RMAX is 512
* KPOS is 1 KLEN is 012
*
....:.*..1....:....2....:....3....:....4....:....5....:....6....:....7....:....8
01 CUST-RECORD.
05 CUST-NUMBER PIC X(12). col A
05 CUST-DATA.
10 CUST-STATUS PIC X. col B
10 CUST-NAME.
15 CUST-LAST-NAME PIC X(28). col C
15 CUST-FIRST-NAME PIC X(20). col D
15 CUST-MID-NAME PIC X(20). col E
10 CUST-ADDRESS-1 PIC X(48). col F
10 CUST-ADDRESS-2 PIC X(48). col G
10 CUST-CITY PIC X(28). col H
10 CUST-STATE PIC X(28). col I
10 CUST-POSTAL-CODE PIC X(12). col J
10 CUST-PHONE-HOME PIC X(18). col K
10 CUST-PHONE-WORK PIC X(18). col L
10 CUST-PHONE-CELL PIC X(18). col M
10 CUST-CREDIT-LIMIT PIC 9(7) COMP-3. col N
10 CUST-DISCOUNT OCCURS 3 TIMES.
15 CUST-DISCOUNT-CODE PIC S9(3) COMP. col ORU
15 CUST-DISCOUNT-RATE PIC S9(2)V999. col PSV
15 CUST-DISCOUNT-DATE PIC X(8). col QTW
10 CUST-LADATE PIC X(8). col X
10 CUST-LATIME PIC X(8). col Y
10 CUST-TOKEN PIC 9(3). col Z
10 FILLER PIC X(145).
*
*** CUSTCB01 - End-of-Copy File - - - - - - - - - - - CUSTCB01 *
*****************************************************************
*
The Sort Specifications
This following is the contents of the control file (STAMLRT1.ctl) that contains the sort 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)
SUM FIELDS=NONE
END
Summary
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. This document may be used to assist as a tutorial for new programmers or as a quick reference for experienced programmers.
In the world of programming there are many ways to solve a problem. This documentation and software were developed and tested on systems that are configured for a SIMOTIME environment based on the hardware, operating systems, user requirements and security requirements. Therefore, adjustments may be needed to execute the jobs and programs when transferred to a system of a different architecture or configuration.
SIMOTIME Services has experience in moving or sharing data or application processing across a variety of systems. For additional information about SIMOTIME Services or Technologies please contact us using the information in the Contact or Feedback section of this document.
Software Agreement and Disclaimer
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
Downloads and Links
This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.
Note: A SimoTime License is required for the items to be made available on a local system or server.
Current Server or Internet Access
The following links may be to the current server or to the Internet.
Note: The latest versions of the SimoTime Documents and Program Suites are available on the Internet and may be accessed using the  icon. If a user has a SimoTime Enterprise License the Documents and Program Suites may be available on a local server and accessed using the  icon.
Explore How to Create and Populate a Customer Master File with generic test data. This document describes a simple process for creating test data for a customer master file. 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.
Explore the COBOL Connection for more examples of COBOL programming techniques and sample code.
Explore An Enterprise System Model that describes and demonstrates how Applications that were running on a Mainframe System and non-relational data that was located on the Mainframe System were copied and deployed in a Microsoft Windows environment with Micro Focus Enterprise Server.
Explore The ASCII and EBCDIC Translation Tables. These tables are provided for individuals that need to better understand the bit structures and differences of the encoding formats.
Explore The File Status Return Codes that are used to interpret the results of accessing VSAM data sets and/or QSAM files.
Internet Access Required
The following links will require an internet connect.
This suite of programs and documentation is available to download for review and evaluation purposes. Other uses will require a SimoTime Software License.
Link to an Evaluation zPAK Option that includes the program members, documentation and control files.
A good place to start is
The SimoTime Home Page
for access to white papers, program examples and product information. This link requires an Internet Connection
Explore
The Micro Focus Web Site
for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Comments or Feedback
This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.
|
1.
|
Send an e-mail to our helpdesk.
|
|
2.
|
Our telephone numbers are as follows.
|
|
2.1.
|
1 415 763-9430 office-helpdesk
|
|
2.2.
|
1 415 827-7045 mobile
|
We appreciate hearing from you.
Company Overview
SimoTime Technologies was founded in 1987 and is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.
Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.
Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.
Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
|
Mailing Labels, Sort by Zip Code and Print to File, Four-Across with Six-Lines
|
Copyright © 1987-2025
SimoTime Technologies and Services
All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |
|
