| When
technology complements business |
Pass,
Parse & Convert using COBOL |
|
|
|
This suite of programs provides examples of how to parse, edit, modify,
format and display (standard or hexadecimal dump) various words within a data
string. The programs also include examples of how to pass parameters between
JCL and COBOL. The COBOL programs are written using the COBOL/2 dialect but
also work with COBOL for MVS and COBOL/370. A JCL member is provided to run the
job as an MVS batch job on an IBM mainframe or as a project with Micro Focus
Mainframe Express (MFE) running on a PC with Windows.
Functions included in this example are as follows.
| 1 |
Pass a parameter from mainframe JCL to COBOL |
| 2 |
Pass a parameter from COBOL to COBOL |
| 3 |
Determine the ASCII/EBCDIC condition of the program and the
parameter |
| 4 |
Parse the parameter data string by keywords |
| 5 |
Convert to upper case from mixed or lower case |
| 6 |
Convert between ASCII and EBCDIC using a conversion table |
| 7 |
Validate the content of a date field for CCYYMMDD and provide
Julian conversion and other information |
| 8 |
Do hexadecimal dumps of the data string in both ASCII and
EBCDIC |
Another of the challenges in today's world is the movement of programs
and data between the mainframe and the PC. This introduces the possibilities of
a program being compiled and executed on the mainframe in EBCDIC mode or the PC
in ASCII mode. Another possibility is the parameters may be created on one
platform and passed to a program executing on a different platform. This
introduces the problem of how to determine the ASCII or EBCDIC format of the
parameters.
There are a number of possible solutions and techniques for addressing
these problems. This program describes a few of the possible coding techniques.
This program may serve as a tutorial for programmers that are new to COBOL and
mainframe JCL and as a reference for experienced programmers.
Many of the routines in this example have been used in production
environments on the mainframe and on the PC. It is important to remember the
original intent of this program was to be a learning tool for seminars and
classes conducted by SimoTime. Therefore, any of the routines or techniques
that will be used in a production environment should be thoroughly tested
before deploying. It is the programmer's and user's responsibility to test
programs for each environment before making business decisions based on the
results produced by routine provided in this example.
Provide a program that will accept, edit and process an ASCII or EBCDIC
data string from mainframe JCL or other application programs. The format of the
data string is a group of keywords separated by spaces. The program should be
able to handle leading or multiple spaces. Since a space character is used as
the delimiter the space character is not allowed as part of a keyword.
STA debug-keyword identifier-keyword user-program date-keyword
amount-keyword close-keyword
| Keyword |
Description |
| STA |
The first keyword of the data string must be STA followed by a
space. If this is not provided the program will post a message and ABEND. |
| debug-keyword |
This keyword must be a value of DUMP, TRACE or DEBUG. If not then
post an error message and ABEND. The program should accept upper, lower or
mixed case for this keyword. |
| identifier-keyword |
This keyword must be a value of ID01 or ID02. If not then post an
error message and ABEND. The program should accept upper, lower or mixed case
for this keyword. |
| user-program |
This keyword must be the name of a program that will be called by
SIMOCAPE. For this example it must be a value of STAFMTC2 or STAFMTC3. The
program should accept upper, lower or mixed case for this keyword. |
| date-keyword |
This keyword must contain a valid gregorian date in the CCYYMMDD
format. Allowances should be made for separator characters such as CCYY-MM-DD.
In addition to editing the date for validity the following should be
provided.
1. Identify as leap-year or non-leap-year.
2. Identify number
of days in the month.
3. Provide text date such as September 5, 2001
4.
Provide Julian date. |
| amount-keyword |
This keyword should be right-adjusted and tested for digits only.
If a decimal point is included it should be removed. The program should accept
only two digits after the decimal point. If the keyword does not contain a
decimal point the program should assume the two rightmost digits are values
after an implied decimal point. |
| close-keyword |
This keyword may be a length of 1 through 8. This keyword may only
contain A-Z and 0-9. If special characters or non-printable characters are
included then post an error message and ABEND. Based on the constant of this
keyword the following action will be performed
CALL - Close with a call the
program specified in user-program.
TEST - Close with a display of the
edited parameters. |
The following flowchart provides a quick overview of processing logic
used with this example.
|
|
|
|
|
|
| The JCL member with two steps. The first step passes a
parameter from JCL to SIMOCAPE, the Callable Application Program Extension. The
second step executes a COBOL program that passes a number of parameters to
SIMOCAPE. |
|
|
|
|
|
|
|
| The program receives a parameter from JCL. The program calls
SIMOPARS to parse the parameter string and identify the keywords (delimited by
spaces) within the string. The keywords are validated and processed. The
results are displayed on the console and may also be viewed from the output
spool. The program calls SIMODUMP to display buffers in hexadecimal
format. |
|
|
|
|
|
|
|
| This program will scan a data string and identify the offset
and length of each keyword within the data string. A space delimiter is used as
a separator between keywords within the string. |
|
|
|
|
|
|
|
| This program will scan a data string and dump (i. e. display
the information on the console) in hexadecimal format. |
|
|
|
|
|
|
|
| If the last parameter is CALL then call the program
identified by user-function. |
|
|
|
|
|
|
|
| If the last parameter is TEST then display the edited
parameters. |
|
|
|
|
|
|
|
| This program will call SIMOCAPE multiple times using
different data strings of information. The purpose of this program is to
demonstrate techniques for parsing and identifying keywords within a data
string. |
|
|
|
|
|
|
|
| The program receives multiple calls with different data
strings from a calling COBOL program (i. e. STAFMTC1). The program performs the
same as described above. The difference is the parameters are received from a
calling COBOL program rather than JCL. |
|
|
|
|
|
|
|
| This program will scan a data string and identify the offset
and length of each keyword within the data string. A space delimiter is used as
a separator between keywords within the string. |
|
|
|
|
|
|
|
| This program will scan a data string and dump (i. e. display
the information on the console) in hexadecimal format. |
|
|
|
|
|
|
|
| If the last parameter is CALL then call the program
identified by user-program. |
|
|
|
|
|
|
|
| If the last parameter is TEST then display the edited
parameters. |
|
|
|
|
|
|
|
|
| |
|
|
|
|
|
This suite of programs uses some of the techniques described in other,
smaller examples. When unzipping a "duplicate" message may be posted. For more
information about members that may be duplicates refer to the
Similar Points of
Interest in the Summary section. SimoTime makes an effort to maintain
release compatibly across the sample programs and the common members.
This suite of programs will make calls to members that are provided in
other SimoTime examples. To successfully execute this example it will be
necessary to download the following.
|
This
suite of programs provides a demonstration program and a callable program to
parse a field or data string. The DISPLAY function of COBOL is used by the
demonstration program to display the results of the parsing routine. Both COBOL
programs are written using the COBOL/2 dialect but also work with COBOL for MVS
and COBOL/370. A JCL member is provided to run the job as an MVS (or OS/390)
batch job on an IBM mainframe or as a project with Micro Focus Mainframe
Express (MFE) running on a PC with Windows. |
|
This
suite of programs provides a demonstration program and a callable program to
display a data string in a hexadecimal format for both EBCDIC and ASCII. Both
COBOL programs are written using the COBOL/2 dialect but also work with COBOL
for MVS and COBOL/370. A JCL member is provided to run the job as an MVS batch
job on an IBM mainframe or as a project with Micro Focus Mainframe Express
(MFE) running on a PC with Windows. |
| |
The following is an example of the WORKING-STORAGE or LINKAGE Section
fields that are passed as parameters to the string parsing program
(SimoCAPE).
01 F01-PARM-BUFFER.
05 F01-PARM-LENGTH pic S9(4) comp.
05 F01-PARM-DATA pic X(256).
The following is an example of the call statement.
call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
The following is the mainframe JCL (STAFMTJ1.JCL) required to run the mainline
program. The coding technique is used with the expectation the JCL would be
used as a stand alone procedure.
//STAFMTJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* This program is provided by: *
//* SimoTime Enterprises, LLC *
//* (C) Copyright 1987-2003 All Rights Reserved *
//* *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Process a parameter passed from JCL or COBOL
//* Author - SimoTime Enterprises
//* Date - January 24, 1996
//*
//* This is a sample program that shows how to do a variety of tasks
//* relating to parameter passing and parsing.
//*
//* This set of programs will run on a mainframe under MVS or on a
//* Personal Computer with Windows and Micro Focus Mainframe Express.
//*
//* ************
//* * STAFMTJ1 *
//* ********jcl*
//* *
//* *
//* *
//* ************ ************
//* * SIMOCAPE *--*--* SIMOPARS *
//* ************ * ************
//* * *
//* * * ************
//* * *--* SIMODATE *
//* * * ************
//* * *
//* * * ************ ************
//* * *--* SIMODUMP *-----* CONSOLE *
//* * * ********opt* ******dsply*
//* * *
//* * * ************
//* * *--* userprog * (4th Keyword)
//* * * ********opt*
//* * *
//* * * ************
//* * *--* CONSOLE *
//* * ********opt*
//* *
//* *
//* ************ ************ ************
//* * STAFMTC1 *-----* SIMOCAPE *--*--* SIMOPARS *
//* ********cbl* ************ * ************
//* * *
//* * * ************
//* * *--* SIMODATE *
//* * * ************
//* * *
//* * * ************ ************
//* * *--* SIMODUMP *-----* CONSOLE *
//* * * ********cbl* ******dsply*
//* * *
//* * * ************
//* * *--* userprog * (4th Keyword)
//* * * ********opt*
//* * *
//* * * ************
//* * *--* CONSOLE *
//* * ********opt*
//* ************
//* * EOJ *
//* ************
//*
//*
//* *******************************************************************
//* Execute the COBOL parsing program with a parameter from JCL.
//* Set NODEBUG to prevent tracing or dumping unless error.
//*
//STAFMTS1 EXEC PGM=SIMOCAPE,
// PARM='STA NODebug id01 StaFmtC2 2001-1-1 17.50 call'
//STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR
//*
//* *******************************************************************
//* Execute the COBOL parsing program with a parameter from JCL.
//* Set TRACE mode to trace execution of functions.
//*
//STAFMTS2 EXEC PGM=SIMOCAPE,
// PARM='STA debug id01 StaFmtC2 20010202 18.75 test'
//STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR
//*
//* *******************************************************************
//* Execute the COBOL demonstration program without a parameter
//* from JCL. The demonstration program (STAFMT01) will create a
//* parameter string using the same callable interface that is
//* required when passing a string from JCL to COBOL.
//*
//STAFMTS3 EXEC PGM=STAFMTC1
//STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR
//*
This program (STAFMTC1.CBL) was
written to be used as a teaching, learning and debugging aid. The use of the
techniques or technology provided in this example should be thoroughly tested
in each unique environment.
IDENTIFICATION DIVISION.
PROGRAM-ID. STAFMTC1.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2003 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only does not imply publication or *
* disclosure. This software contains confidential information *
* and trade secrets of SimoTime Enterprises, LLC. No part of *
* this program or publication may be reproduced, transmitted, *
* transcribed, stored in a retrieval system, or translated into *
* any language or computer language, in any form or by any *
* means, electronic, mechanical, magnetic, optical, chemical, *
* manual or otherwise, without the prior written permission of: *
* *
* SimoTime Enterprises *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: STAFMTC1.CBL
* Calls to: SIMOCAPE
*****************************************************************
*
* STAFMTC1 - Demonstration of Passing, Parsing and Converting
* data string between JCL and COBOL.
*
* CALLING PROTOCOL
* ----------------
* Use standard procedure to RUN or ANIMATE.
*
* DESCRIPTION
* -----------
* This program calls the Callable Application Progam Extension
* (i.e. SimoCAPE) to edit a data string and then pass an edited
* and formatted data string to a user-defined program. SimoCAPE
* also calls the SimoDATE routine to edit and format date
* information.
*
* ************
* * STAFMTJ1 *
* ********jcl*
* *
* *
* *
* ************ ************ ************
* * SIMOCAPE *--*--* SIMOPARS *-----* Console *
* ************ * ************ ******dsply*
* * *
* * * ************
* * *--* SIMODUMP *
* * * ************
* * *
* * * ************
* * *--* userprog *
* * * ************
* * *
* * * ************
* * *--* Console *
* * ************
* *
* *
* ************ ************ ************ ************
* * STAFMTC1 *-----* SIMOCAPE *--*--* SIMOPARS *-----* Console *
* ********cbl* ************ * ************ ******dsply*
* * *
* * * ************
* * *--* SIMODUMP *
* * * ************
* * *
* * * ************
* * *--* userprog *
* * * ************
* * *
* * * ************
* * *--* Console *
* * ************
* ************
* * EOJ *
* ************
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 1997/02/27 Simmons, Created program.
* 1997/02/27 Simmons, No changes to date.
*
*****************************************************************
*
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Title and Copyright...
* ------------------------------------------------------------
01 SIM-TITLE.
05 T1 pic X(11) value '* STAFMTC1 '.
05 T2 pic X(34) value 'Parse & Process Parameter Strings '.
05 T3 pic X(10) value ' v1.1.00 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* STAFMTC1 '.
05 C2 pic X(20) value 'Copyright 1987-2003 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* STAFMTC1 '.
05 C2 pic X(32) value 'Thank you for using this sample '.
05 C3 pic X(32) value 'by SimoTime Enterprises, LLC '.
05 C4 pic X(04) value ' '.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* STAFMTC1 '.
05 C2 pic X(32) value 'Please send comments or suggesti'.
05 C3 pic X(32) value 'ons to helpdesk@simotime.com '.
05 C4 pic X(04) value ' '.
*****************************************************************
01 F01-PARM-BUFFER.
05 F01-PARM-LENGTH pic S9(4) comp.
05 F01-PARM-DATA pic X(256).
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* STAFMTC1 '.
05 MESSAGE-TEXT pic X(68) value is SPACES.
*****************************************************************
PROCEDURE DIVISION.
perform POST-COPYRIGHT
perform APPLICATION-TASK-01
perform APPLICATION-TASK-02
perform APPLICATION-TASK-03
perform APPLICATION-TASK-04
perform APPLICATION-TASK-05
move 'Program is complete...' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
perform THANK-YOU.
GOBACK.
*****************************************************************
APPLICATION-TASK-01.
move 'Task-01 is starting, NODEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
move 'STA NOdebug ID02 stafmtc3 2001/3/3 22.95 call'
to F01-PARM-DATA
move F01-PARM-DATA to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
add length of F01-PARM-DATA to ZERO giving F01-PARM-LENGTH
call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
move 'Task-01 is complete, NODEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
APPLICATION-TASK-02.
move 'Task-02 is starting, DUMP Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
move 'STA Dump ID02 stafmtc2 2000/07/4 9.49 stop-001'
to F01-PARM-DATA
move F01-PARM-DATA to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
add length of F01-PARM-DATA to ZERO giving F01-PARM-LENGTH
call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
move 'Task-02 is complete, DUMP Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
APPLICATION-TASK-03.
move 'Task-03 is starting, DEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
move 'STA debug ID02 stafmtc3 1996/07/4 10.00 //Finish'
to F01-PARM-DATA
move F01-PARM-DATA to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
add length of F01-PARM-DATA to ZERO giving F01-PARM-LENGTH
call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
move 'Task-03 is complete, DEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
APPLICATION-TASK-04.
move 'Task-04 is starting, NODEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
move 'STA NODEBUG ID02 stafmtc2 1943/05/22 10.00 c9a2x6m1'
to F01-PARM-DATA
move F01-PARM-DATA to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
add length of F01-PARM-DATA to ZERO giving F01-PARM-LENGTH
call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
move 'Task-04 is complete, NODEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
APPLICATION-TASK-05.
move 'Task-05 is starting, NODEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
move 'STA NODEBUG ID02 stafmtc2 1944/4/1 99.98 CALL'
to F01-PARM-DATA
move F01-PARM-DATA to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
add length of F01-PARM-DATA to ZERO giving F01-PARM-LENGTH
call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
move 'Task-05 is complete, NODEBUG Test' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
exit.
*****************************************************************
DISPLAY-CONSOLE-MESSAGE.
display MESSAGE-BUFFER upon console
move SPACES to MESSAGE-TEXT
exit.
*****************************************************************
ABEND-MESSAGE.
if MESSAGE-TEXT not = SPACES
perform DISPLAY-CONSOLE-MESSAGE
else
move '* STAFMTC1 is ABENDING...' to MESSAGE-TEXT
perform DISPLAY-CONSOLE-MESSAGE
end-if
exit.
*****************************************************************
POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
THANK-YOU.
display SIM-THANKS-01 upon console
display SIM-THANKS-02 upon console
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
This Callable Application Program Extension (SimoCAPE.CBL) will accept a data string in the
following format.
STA debug-keyword identifier-keyword user-keyword date-keyword
amount-keyword close-keyword
Based on the last parameter SimoCAPE will either call the specified user
program or display the information that would be passed. The format of the
information that will be passed to the called program is as follows.
*****************************************************************
* Data structure for calling a user-program from SimoCAPE *
*****************************************************************
* Copyright (C) 1987-2003 SimoTime Enterprises *
* All Rights Reserved *
*****************************************************************
* Provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
01 CAPE-XCTL-API.
05 CAPE-ID pic X(8).
05 CAPE-DEBUG pic X(8).
05 CAPE-GREGORIAN-DATE pic 9(8).
05 CAPE-DATE-EDITED pic X(10).
05 CAPE-DATE-VERBAGE pic X(16).
05 CAPE-JULIAN-DATE pic 9(7).
05 CAPE-DAYS-REMAINING pic 9(3).
05 CAPE-LEAP-YEAR-YN pic X.
05 CAPE-DAYS-IN-MONTH pic 99.
05 CAPE-MONTH-VERBAGE pic X(10).
05 CAPE-AMOUNT pic 9(11).
The following is a listing of the SimoCAPE source code.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOCAPE.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2003 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only does not imply publication or *
* disclosure. This software contains confidential information *
* and trade secrets of SimoTime Enterprises, LLC. No part of *
* this program or publication may be reproduced, transmitted, *
* transcribed, stored in a retrieval system, or translated into *
* any language or computer language, in any form or by any *
* means, electronic, mechanical, magnetic, optical, chemical, *
* manual or otherwise, without the prior written permission of: *
* *
* SimoTime Enterprises *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: SIMOCAPE.CBL
* Copy Files: PASSPARS.CPY
* PASSDUMP.CPY
* PASSDATE.CPY
* CAPEXCTL.CPY
* Calls to: SIMODATE
* SIMODUMP
* SIMOPARS
* User defined program... (optional)
*****************************************************************
*
* SIMOCAPE - is a Callable Application Program Extension that
* performs a variety of common, reusable functions.
*
* CALLING PROTOCOL
* ----------------
* call 'SIMOCAPE' using F01-PARM-LENGTH, F01-PARM-DATA
*
* The first four bytes of the F01-PARM-DATA must be 'STA ',
* if not then program will post a message and abend.
*
* DESCRIPTION
* -----------
* This program will process the JCL parameter from the EXEC
*
* // EXEC PGM=SIMOCAPE,PARM='STA ID01 additional parameters'
*
* This program may also be called by another program.
*
* ************ ************ ************
* * SIMOCAPE *--*--* SIMOPARS *-----* Console *
* ************ * ************ ******dsply*
* *
* * ************
* *--* SIMODUMP *
* * ************
* *
* * ************
* *--* userprog *
* * ************
* *
* * ************
* *--* Console *
* ************
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 1997/02/27 Simmons, Created program.
*
*****************************************************************
*
DATA DIVISION.
WORKING-STORAGE SECTION.
*
*****************************************************************
* Data-structure for Title and Copyright...
*****************************************************************
01 SIM-TITLE.
05 T1 pic X(11) value '* SIMOCAPE '.
05 T2 pic X(34) value 'Application Program Extensions '.
05 T3 pic X(10) value ' v1.1.00EV'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* SIMOCAPE '.
05 C2 pic X(20) value 'Copyright 1987-2003 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
*****************************************************************
01 FIRST-TIME pic X value 'Y'.
01 UPPER-CASE-A pic X value 'A'.
01 UPPER-EBCDIC-STA.
05 UPPER-EBCDIC-S pic X value X'E2'.
05 UPPER-EBCDIC-T pic X value X'E3'.
05 UPPER-EBCDIC-A pic X value X'C1'.
05 filler pic X value X'40'.
01 UPPER-ASCII-STA.
05 UPPER-ASCII-S pic X value X'53'.
05 UPPER-ASCII-T pic X value X'54'.
05 UPPER-ASCII-A pic X value X'41'.
05 filler pic X value X'20'.
01 IX-1 pic 999 value 0.
01 IX-2 pic 999 value 0.
01 IX-3 pic 999 value 0.
01 WORK-DATA pic X(256) value SPACES.
01 WORK-N-7 pic 9(7) value 0.
01 WORK-08 pic X(8) value SPACES.
01 F01-PARM-LENGTH-COPY pic 9(5) value 0.
01 FLAG-4-COMPILE pic X value 'X'.
01 FLAG-4-PARAMETER pic X value 'X'.
01 FLAG-4-ALPHANUMERIC pic X value 'N'.
01 MSG-AC pic X(32) value 'Compilation is ASCII '.
01 MSG-EC pic X(32) value 'Compilation is EBCDIC '.
01 MSG-XC pic X(32) value 'Compilation is not ASCII/EBCDIC '.
01 MSG-AP pic X(32) value 'Parameter is ASCII '.
01 MSG-EP pic X(32) value 'Parameter is EBCDIC '.
01 MSG-XP pic X(32) value 'Parameter is not ASCII/EBCDIC '.
01 MSG-EDIT.
05 filler pic X(17) value 'Parameter Number '.
05 MSG-EDIT-NUMBER pic 9 value 0.
05 filler pic X(3) value ' - '.
05 MSG-EDIT-CONTENT pic X(12) value is SPACES.
05 filler pic X value is SPACES.
05 MSG-EDIT-TEXT pic X(40) value is SPACES.
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMOCAPE '.
05 MESSAGE-TEXT pic X(68).
*****************************************************************
* The following is used by the INSPECT statement to do the
* conversion from/to UPPER and lower Case.
*****************************************************************
01 UPPER-CASE pic X(26) value 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
01 LOWER-CASE pic X(26) value 'abcdefghijklmnopqrstuvwxyz'.
01 ZERO-NINE pic X(10) value '0123456789'.
*****************************************************************
* The following is used by the INSPECT statement to do the
* conversion betweeen EBCDIC and ASCII.
*****************************************************************
01 EBCDIC-TABLE.
*> 01 A B C D E F G H I
*> 02 J K L M N O P Q R
*> 03 S T U V W X Y Z
*> 04 a b c d e f g h i
*> 05 j k l m n o p q r
*> 06 s t u v w x y z
*> 07 0 1 2 3 4 5 6 7 8 9
*> 08 space . < ( + | & ! $ * ) ; -
*> 09 7D/7F Single/Double quote / , % _ > ? ` : # @7D =7F
*> 10 [ ] { } \ ~ ^
05 filler pic X(9) value X'C1C2C3C4C5C6C7C8C9'.
05 filler pic X(9) value X'D1D2D3D4D5D6D7D8D9'.
05 filler pic X(8) value X'E2E3E4E5E6E7E8E9'.
05 filler pic X(9) value X'818283848586878889'.
05 filler pic X(9) value X'919293949596979899'.
05 filler pic X(8) value X'A2A3A4A5A6A7A8A9'.
05 filler pic X(10) value X'F0F1F2F3F4F5F6F7F8F9'.
05 filler pic X(13) value X'404B4C4D4E4F505A5B5C5D5E60'.
05 filler pic X(13) value X'616B6C6D6E6F797A7B7C7D7E7F'.
05 filler pic X(7) value X'ADBDC0D0E0A1B0'.
01 EBCDIC-INFO redefines EBCDIC-TABLE
pic X(95).
*> ------------------------------------------------------------
01 ASCII-TABLE.
*> 01 A B C D E F G H I
*> 02 J K L M N O P Q R
*> 03 S T U V W X Y Z
*> 04 a b c d e f g h i
*> 05 j k l m n o p q r
*> 06 s t u v w x y z
*> 07 0 1 2 3 4 5 6 7 8 9
*> 08 space . < ( + | & ! $ * ) ; -
*> 09 27/22 Single/Double quote / , % _ > ? ` : # @27 =22
*> 10 [ ] { } \ ~ ^
05 filler pic X(9) value X'414243444546474849'.
05 filler pic X(9) value X'4A4B4C4D4E4F505152'.
05 filler pic X(8) value X'535455565758595A'.
05 filler pic X(9) value X'616263646566676869'.
05 filler pic X(9) value X'6A6B6C6D6E6F707172'.
05 filler pic X(8) value X'737475767778797A'.
05 filler pic X(10) value X'30313233343536373839'.
05 filler pic X(13) value X'202E3C282B7C2621242A293B2D'.
05 filler pic X(13) value X'2F2C255F3E3F793A2340273D22'.
05 filler pic X(7) value X'5B5D7B7D5C7E5E'.
01 ASCII-INFO redefines ASCII-TABLE
pic X(95).
01 STD-DEBUG-FUNCTION pic X(8) value SPACES.
01 STD-IDENTIFIER pic X(4) value SPACES.
01 STD-USER-FUNCTION pic X(8) value SPACES.
01 FMTC2-DATE-FUNCTION pic X(10) value SPACES.
01 STD-AMOUNT pic X(11) value SPACES.
01 FMTC2-ALPHANUMERIC-FUNCTION pic X(8) value SPACES.
*****************************************************************
*> The copy file of the pass area for calling SIMOPARS, the
*> parameter parsing routine.
COPY PASSPARS.
*> -----------------------------------------------------------
*> The copy file of the pass area for calling SIMODUMP, the
*> hexadecimal dump routine.
COPY PASSDUMP.
*> -----------------------------------------------------------
*> The copy file of the pass area for calling SIMODATE, the
*> date editing routine.
COPY PASSDATE.
*> -----------------------------------------------------------
*> The copy file of the pass area for calling a user-program.
COPY CAPEXCTL.
*****************************************************************
LINKAGE SECTION.
01 F01-PARM-BUFFER.
05 F01-PARM-LENGTH pic S9(4) comp.
05 F01-PARM-DATA pic X(256).
*****************************************************************
* Mainline processing routine...
*****************************************************************
PROCEDURE DIVISION using F01-PARM-BUFFER.
if FIRST-TIME not = 'N'
if STD-DEBUG-INFO = 'DEBUG '
or STD-DEBUG-INFO = 'TRACE '
perform POST-COPYRIGHT
end-if
perform ASCII-OR-EBCDIC-COMPILATION
move 'N' to FIRST-TIME
end-if
perform ASCII-OR-EBCDIC-PARAMETER
move F01-PARM-DATA to WORK-DATA
if FLAG-4-PARAMETER not = FLAG-4-COMPILE
if FLAG-4-COMPILE = 'A'
inspect WORK-DATA
converting EBCDIC-INFO to ASCII-INFO
else
inspect WORK-DATA
converting ASCII-INFO to EBCDIC-INFO
end-if
end-if
perform MOVE-AND-CONVERT-TO-UPPER-CASE
perform DISPLAY-THE-PARAMETER-INFO
perform PARSE-THE-PARAMETER-DATA
perform DISPLAY-THE-PARAMETER-KEYWORDS
perform EDIT-AND-FORMAT-PARAMETERS
if STD-DEBUG-FUNCTION = 'DEBUG '
or STD-DEBUG-FUNCTION = 'DUMP '
perform HEX-DUMP-OF-PARSING-BUFFER
perform SIMODUMP-TO-ASCII-OR-EBCDIC
perform DUMP-SIMOTIME-BUFFER
end-if
evaluate FMTC2-ALPHANUMERIC-FUNCTION
when 'CALL ' perform CLOSE-WITH-CALL
when 'TEST ' perform CLOSE-WITH-DISPLAY
end-evaluate
GOBACK.
*****************************************************************
* The following routines are in alphabetical order... *
*****************************************************************
*****************************************************************
* Determine the compilation environment for this program by
* the working storage item. If the UPPER-CASE-A field is a
* x'41' then program is ASCI. If the field is x'C1' then the
* program is EBCDIC.
*****************************************************************
ASCII-OR-EBCDIC-COMPILATION.
evaluate UPPER-CASE-A
when UPPER-EBCDIC-A move MSG-EC to MESSAGE-TEXT
move 'E' to FLAG-4-COMPILE
when UPPER-ASCII-A move MSG-AC to MESSAGE-TEXT
move 'A' to FLAG-4-COMPILE
when OTHER move MSG-XC to MESSAGE-TEXT
end-evaluate
perform POST-CONDITIONAL-TRACE
*> If environment cannot be recognized as ASCII or EBCDIC
*> then stop the program.
if FLAG-4-COMPILE = 'X'
perform POST-ABEND
STOP RUN
end-if
exit.
*****************************************************************
* Determine if the Parameter is ASCII or EBCDIC by the format of
* the first keyword in the parameter string that should be "STA".
*****************************************************************
ASCII-OR-EBCDIC-PARAMETER.
evaluate F01-PARM-DATA(1:4)
when UPPER-EBCDIC-STA move 'E' to FLAG-4-PARAMETER
move MSG-EP to MESSAGE-TEXT
when UPPER-ASCII-STA move 'A' to FLAG-4-PARAMETER
move MSG-AP to MESSAGE-TEXT
when OTHER move 'X' to FLAG-4-PARAMETER
move MSG-XP to MESSAGE-TEXT
end-evaluate
perform POST-CONDITIONAL-TRACE
*> If parameter cannot be recognized as ASCII or EBCDIC
*> then stop the program.
if FLAG-4-PARAMETER = 'X'
perform POST-ABEND
STOP RUN
end-if
exit.
CLOSE-WITH-CALL.
move STD-GREGORIAN-DATE to CAPE-GREGORIAN-DATE
move STD-DATE-EDITED to CAPE-DATE-EDITED
move STD-DATE-VERBAGE to CAPE-DATE-VERBAGE
move STD-JULIAN-DATE to CAPE-JULIAN-DATE
move STD-DAYS-REMAINING to CAPE-DAYS-REMAINING
move STD-LEAP-YEAR-YN to CAPE-LEAP-YEAR-YN
move STD-MM-DAYS to CAPE-DAYS-IN-MONTH
move STD-MONTH-VERBAGE to CAPE-MONTH-VERBAGE
move STD-AMOUNT to CAPE-AMOUNT
call STD-USER-FUNCTION using CAPE-XCTL-API
exit.
CLOSE-WITH-DISPLAY.
move 'Processing the TEST request ' to MESSAGE-TEXT
perform POST-MESSAGE
move 'Gregorian Date .............. ' to MESSAGE-TEXT
move STD-GREGORIAN-DATE to MESSAGE-TEXT(31:10)
perform POST-MESSAGE
move 'Edited Gregorian Date ....... ' to MESSAGE-TEXT
move STD-DATE-EDITED to MESSAGE-TEXT(31:10)
perform POST-MESSAGE
move 'Text for the Date............ ' to MESSAGE-TEXT
move STD-DATE-VERBAGE to MESSAGE-TEXT(31:16)
perform POST-MESSAGE
move 'Julian Date ................. ' to MESSAGE-TEXT
move STD-JULIAN-DATE to MESSAGE-TEXT(31:7)
perform POST-MESSAGE
move 'Days Remaining in the Year... ' to MESSAGE-TEXT
move STD-DAYS-REMAINING to MESSAGE-TEXT(31:3)
perform POST-MESSAGE
move 'Leap Year Flag (Y or N) ..... ' to MESSAGE-TEXT
move STD-LEAP-YEAR-YN to MESSAGE-TEXT(31:1)
perform POST-MESSAGE
move 'Days in the Month ........... ' to MESSAGE-TEXT
move STD-MM-DAYS to MESSAGE-TEXT(31:2)
perform POST-MESSAGE
move 'Text for the Month .......... ' to MESSAGE-TEXT
move STD-MONTH-VERBAGE to MESSAGE-TEXT(31:10)
perform POST-MESSAGE
move 'Amount ...................... ' to MESSAGE-TEXT
move STD-AMOUNT to MESSAGE-TEXT(31:11)
perform POST-MESSAGE
exit.
*****************************************************************
* Display the length and the original parameter plus the copied
* parameter that has been converted to upper case...
*****************************************************************
DISPLAY-THE-PARAMETER-INFO.
if F01-PARM-LENGTH < 1
move 'Parameter length is 00000' to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
else
move 'Parameter length is ?????' to MESSAGE-TEXT
move F01-PARM-LENGTH-COPY to MESSAGE-TEXT(21:5)
perform POST-CONDITIONAL-TRACE
move WORK-DATA(1:F01-PARM-LENGTH) to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
move PRS-BUFFER(1:F01-PARM-LENGTH) to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
end-if
exit.
*****************************************************************
* Display the contents of the parsing tables.
*****************************************************************
DISPLAY-THE-PARAMETER-KEYWORDS.
add 1 to ZERO giving IX-1
perform
until PRS-LENGTH(IX-1) = 0
or PRS-OFFSET(IX-1) = 0
or IX-1 > PRS-TABLE-MAX
perform POST-TABLE-ITEM
add 1 to IX-1
end-perform
exit.
*****************************************************************
DUMP-BUFFER.
move 'SHOW' to SIMODUMP-REQUEST
add 128 to ZERO giving SIMODUMP-LENGTH
call 'SIMODUMP' using SIMODUMP-PASS-AREA
exit.
*****************************************************************
DUMP-SIMOTIME-BUFFER.
*> ------------------------------------------------------------
*> Display the contents of the parsing buffer in DUMP format.
move 'HEXDUMP2' to SIMODUMP-DUMP-ID
perform DUMP-BUFFER
exit.
*****************************************************************
EDIT-AND-FORMAT-PARAMETERS.
add 2 to ZERO giving IX-1
perform
until PRS-LENGTH(IX-1) = 0
or PRS-OFFSET(IX-1) = 0
or IX-1 > PRS-TABLE-MAX
evaluate IX-1
when 2 perform EDIT-DEBUG-FUNCTIONS
when 3 perform EDIT-IDENTIFIER
when 4 perform EDIT-USER-FUNCTION
when 5 perform EDIT-DATE-FUNCTION
when 6 perform EDIT-AMOUNT-FUNCTION
when 7 perform EDIT-ALPHANUMERIC-FUNCTION
end-evaluate
add 1 to IX-1
end-perform
exit.
EDIT-ALPHANUMERIC-FUNCTION.
move SPACES to FMTC2-ALPHANUMERIC-FUNCTION
if PRS-LENGTH(IX-1) < 9
and PRS-LENGTH(IX-1) > 0
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to FMTC2-ALPHANUMERIC-FUNCTION
end-if
*> Prepare information for display to console...
add IX-1 to ZERO giving MSG-EDIT-NUMBER
move SPACES to MSG-EDIT-CONTENT
move FMTC2-ALPHANUMERIC-FUNCTION to MSG-EDIT-CONTENT
*> Prepare a work field for determining allowable content...
move FMTC2-ALPHANUMERIC-FUNCTION to WORK-08
*> The following statement will not allow spaces as
*> valid characters...
inspect WORK-08(1:PRS-LENGTH(IX-1))
replacing all SPACE by '/'
perform EDIT-ALPHABET-OR-NUMBERS
if FLAG-4-ALPHANUMERIC = 'Y'
move 'Contains only ALPHA and NUMERIC.' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
else
move 'Contains non-ALPHANUMERIC.' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
end-if
exit.
EDIT-ALPHABET-OR-NUMBERS.
inspect WORK-08 converting UPPER-CASE to SPACES
inspect WORK-08 converting LOWER-CASE to SPACES
inspect WORK-08 converting ZERO-NINE to SPACES
if WORK-08 = SPACES
move 'Y' to FLAG-4-ALPHANUMERIC
else
move 'N' to FLAG-4-ALPHANUMERIC
end-if
exit.
*----------------------------------------------------------------
EDIT-IDENTIFIER.
move SPACES to STD-IDENTIFIER
if PRS-LENGTH(IX-1) = 4
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to STD-IDENTIFIER
end-if
add IX-1 to ZERO giving MSG-EDIT-NUMBER
move SPACES to MSG-EDIT-CONTENT
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to MSG-EDIT-CONTENT
if STD-IDENTIFIER = 'ID01'
or STD-IDENTIFIER = 'ID02'
move 'AOK for Identifier...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
else
move 'NOK for Identifier...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-ABEND
end-if
exit.
*----------------------------------------------------------------
EDIT-DEBUG-FUNCTIONS.
move SPACES to STD-DEBUG-FUNCTION
if PRS-LENGTH(IX-1) < 9
and PRS-LENGTH(IX-1) > 0
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to STD-DEBUG-FUNCTION
end-if
add IX-1 to ZERO giving MSG-EDIT-NUMBER
move SPACES to MSG-EDIT-CONTENT
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to MSG-EDIT-CONTENT
if STD-DEBUG-FUNCTION = 'DUMP '
or STD-DEBUG-FUNCTION = 'TRACE '
or STD-DEBUG-FUNCTION = 'DEBUG '
or STD-DEBUG-FUNCTION = 'NODEBUG '
move STD-DEBUG-FUNCTION to STD-DEBUG-INFO
move 'AOK for Debug Function...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
else
move 'NOK for Debug Function...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-ABEND
end-if
exit.
*----------------------------------------------------------------
EDIT-USER-FUNCTION.
move SPACES to STD-USER-FUNCTION
if PRS-LENGTH(IX-1) < 9
and PRS-LENGTH(IX-1) > 0
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to STD-USER-FUNCTION
end-if
add IX-1 to ZERO giving MSG-EDIT-NUMBER
move SPACES to MSG-EDIT-CONTENT
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to MSG-EDIT-CONTENT
if STD-USER-FUNCTION = 'STAFMTC2'
or STD-USER-FUNCTION = 'STAFMTC3'
move 'AOK for User Function...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
else
move 'NOK for User Function...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-ABEND
end-if
exit.
*----------------------------------------------------------------
*> This routine will accept dates in the following formats
*> ccyymmdd
*> ccyy/mm/dd
*> ccyy-mm-dd
*> ccyy.mm.dd
*----------------------------------------------------------------
EDIT-DATE-FUNCTION.
add IX-1 to ZERO giving MSG-EDIT-NUMBER
move SPACES to MSG-EDIT-CONTENT
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to MSG-EDIT-CONTENT
move 'WIP for Calling SIMODATE...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
move SPACES to STD-GREGORIAN-4-EDIT
if PRS-LENGTH(IX-1) < 11
or PRS-LENGTH(IX-1) > 7
move 'EDITDATE' to STD-REQUEST
move '-' to STD-DATE-EDIT-BYTE
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to STD-GREGORIAN-4-EDIT
call 'SIMODATE' using STD-SIMODATE
else
move 'NOK for Date Value, field length is incorrect...'
to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-ABEND
end-if
exit.
*----------------------------------------------------------------
EDIT-AMOUNT-FUNCTION.
move SPACES to STD-AMOUNT
add IX-1 to ZERO giving MSG-EDIT-NUMBER
if PRS-LENGTH(IX-1) < 9
and PRS-LENGTH(IX-1) > 0
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to STD-AMOUNT
end-if
*> Right Adjust...
perform until STD-AMOUNT(11:1) not = SPACE
add 10 to ZERO giving IX-2
perform 10 times
move STD-AMOUNT(IX-2:1)
to STD-AMOUNT(IX-2 + 1:1)
subtract 1 from IX-2
end-perform
move ZERO to STD-AMOUNT(1:1)
end-perform
*> Remove decimal...
if STD-AMOUNT(9:1) = '.'
add 8 to ZERO giving IX-2
perform 8 times
move STD-AMOUNT(IX-2:1)
to STD-AMOUNT(IX-2 + 1:1)
subtract 1 from IX-2
end-perform
end-if
if STD-AMOUNT is NUMERIC
move STD-AMOUNT to MSG-EDIT-CONTENT
move 'AOK for Amount Function...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
else
move STD-AMOUNT to MSG-EDIT-CONTENT
move 'NOK for Amount Function...' to MSG-EDIT-TEXT
move MSG-EDIT to MESSAGE-TEXT
perform POST-ABEND
end-if
exit.
*----------------------------------------------------------------
EDIT-CLOSE-FUNCTION.
exit.
*****************************************************************
HEX-DUMP-OF-PARSING-BUFFER.
*> ------------------------------------------------------------
*> Display the contents of the parsing buffer in DUMP format.
move PRS-BUFFER to SIMODUMP-BUFFER
move 'HEXDUMP1' to SIMODUMP-DUMP-ID
perform DUMP-BUFFER
exit.
*****************************************************************
MOVE-AND-CONVERT-TO-UPPER-CASE.
*> ------------------------------------------------------------
*> Move Parameter Length value to a move/display field...
add F01-PARM-LENGTH to ZERO giving F01-PARM-LENGTH-COPY
*> ------------------------------------------------------------
*> Move Parameter data to the parsing buffer
move SPACES to PRS-BUFFER
move WORK-DATA(1:F01-PARM-LENGTH)
to PRS-BUFFER(1:F01-PARM-LENGTH)
*> ------------------------------------------------------------
*> Convert parsing buffer to upper case...
inspect PRS-BUFFER converting LOWER-CASE to UPPER-CASE
exit.
*****************************************************************
PARSE-THE-PARAMETER-DATA.
*> ------------------------------------------------------------
*> Display the start of task message.
move 'Start Parse for Sample-Task...' to MESSAGE-TEXT
perform POST-CONDITIONAL-TRACE
*> ------------------------------------------------------------
*> 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
add 128 to ZERO giving PRS-BUFFER-SIZE
*> ------------------------------------------------------------
*> Move the data string to the parsing buffer and call
*> the parsing routine.
call 'SIMOPARS' using PRS-PARAMETERS
exit.
*****************************************************************
POST-TABLE-ITEM.
move 'Item-nnnn, Offset-nnnn, Length-nnnn, Parameter - '
to MESSAGE-TEXT(1:49)
move IX-1 to MESSAGE-TEXT(6:4)
move PRS-OFFSET(IX-1) to MESSAGE-TEXT(19:4)
move PRS-LENGTH(IX-1) to MESSAGE-TEXT(32:4)
if PRS-LENGTH(IX-1) < 20
move PRS-BUFFER(PRS-OFFSET(IX-1):PRS-LENGTH(IX-1))
to MESSAGE-TEXT(50:PRS-LENGTH(IX-1))
else
move PRS-BUFFER(PRS-OFFSET(IX-1):19)
to MESSAGE-TEXT(50:19)
end-if
perform POST-CONDITIONAL-TRACE
exit.
*****************************************************************
* Display Copyright or Program Message...
* ------------------------------------------------------------
POST-ABEND.
if MESSAGE-TEXT not = SPACES
perform POST-MESSAGE
end-if
move 'Program is ABENDING...' to MESSAGE-TEXT
perform POST-MESSAGE
STOP RUN
exit.
POST-CONDITIONAL-TRACE.
if STD-DEBUG-INFO = 'DEBUG '
or STD-DEBUG-INFO = 'TRACE '
display MESSAGE-BUFFER upon console
end-if
move SPACES to MESSAGE-TEXT
exit.
POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
POST-MESSAGE.
display MESSAGE-BUFFER upon console
move SPACES to MESSAGE-TEXT
exit.
*****************************************************************
SIMODUMP-TO-ASCII-OR-EBCDIC.
*> ------------------------------------------------------------
*> Convert between EBCDIC and ASCII based on the current
*> ASCII or EBCDIC environment.
*> Display the contents of the parsing tables.
if FLAG-4-COMPILE = 'E'
inspect SIMODUMP-BUFFER converting EBCDIC-INFO
to ASCII-INFO
else
inspect SIMODUMP-BUFFER converting ASCII-INFO
to EBCDIC-INFO
end-if
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
The callable date routine (SIMODATE.CBL) will accept a gregorian date and
provide a data structure in the following format that is defined in the copy
file (PASSDATE.CPY).
*****************************************************************
* Data structure for calling the SIMODATE Routine *
*****************************************************************
* Copyright (C) 1987-2003 SimoTime Enterprises *
* All Rights Reserved *
*****************************************************************
* Provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
01 STD-SIMODATE.
05 STD-REQUEST pic X(8).
05 STD-RESPONSE pic 9(4).
05 STD-MESSAGE-TEXT pic X(68).
05 STD-GREGORIAN-4-EDIT pic X(10).
05 STD-EDITED-INFO.
10 STD-DEBUG-INFO pic X(8).
10 STD-LEAP-YEAR-YN pic X.
10 STD-MONTH-VERBAGE pic X(10).
10 STD-MM-DAYS pic 99.
10 STD-GREGORIAN-DATE pic 9(8).
10 STD-JULIAN-DATE pic 9(7).
10 STD-JULIAN-VALUE redefines STD-JULIAN-DATE.
15 STD-JULIAN-CCYY pic 9(4).
15 STD-JULIAN-DAY pic 9(3).
10 STD-DAYS-REMAINING pic 9(3).
10 STD-DATE-VERBAGE pic X(18).
10 STD-DATE-EDIT-BYTE pic X.
10 STD-DATE-EDITED pic X(10).
If the gregorian date does not pass the editing process a message will
be posted and the program will abend. SimoDATE is somewhat flexible in
accepting and reformatting a gregorian date. For example, the following are
acceptable and will be reformatted proir to passing to the user program.
| |
ccyymmdd |
|
This is the preferred format. |
| |
ccyy-mm-dd |
|
Special characters may be used as separators. |
| |
ccyy-m-d |
|
Single digit month and day values are acceptable
when separators are used. |
| |
ccyy/m/dd |
|
A mixing of single digit usage is accepted. |
The following is a listing of the SimoDATE source code.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMODATE.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2003 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only does not imply publication or *
* disclosure. This software contains confidential information *
* and trade secrets of SimoTime Enterprises, LLC. No part of *
* this program or publication may be reproduced, transmitted, *
* transcribed, stored in a retrieval system, or translated into *
* any language or computer language, in any form or by any *
* means, electronic, mechanical, magnetic, optical, chemical, *
* manual or otherwise, without the prior written permission of: *
* *
* SimoTime Enterprises *
* 15 Carnoustie Drive *
* Novato, CA 94949-5849 *
* 415.883.6565 *
* *
* RESTRICTED RIGHTS LEGEND *
* Use, duplication, or disclosure by the Government is subject *
* to restrictions as set forth in subparagraph (c)(1)(ii) of *
* the Rights in Technical Data and Computer Software clause at *
* DFARS 52.227-7013 or subparagraphs (c)(1) and (2) of *
* Commercial Computer Software - Restricted Rights at 48 *
* CFR 52.227-19, as applicable. Contact SimoTime Enterprises, *
* 15 Carnoustie Drive, Novato, CA 94949-5849. *
* *
*****************************************************************
* This program is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
*****************************************************************
*
*****************************************************************
* Source Member: SIMODATE.CBL
* Copy Files: PASSDATE.CPY
*****************************************************************
*
* SIMODATE - edits and formats a gregorian date ccyymmdd. It also
* provides additional information such as:
*
* 1. Identify leap year
* 2. Provide a Julian Date
* 3. Provide a text date - for example, January 1, 2001
* 4. Provide days-in-month
* and more...
*
* CALLING PROTOCOL
* ----------------
* call 'SIMODATE' using STD-SIMODATE
*
* 01 STD-SIMODATE.
* 05 STD-REQUEST pic X(8).
* 05 STD-RESPONSE pic 9(4).
* 05 STD-MESSAGE-TEXT pic X(68).
* 05 STD-GREGORIAN-4-EDIT pic X(10).
* 05 STD-EDITED-INFO.
* 10 STD-DEBUG-INFO pic X(8).
* 10 STD-LEAP-YEAR-YN pic X.
* 10 STD-MONTH-VERBAGE pic X(10).
* 10 STD-MM-DAYS pic 99.
* 10 STD-GREGORIAN-DATE pic 9(8).
* 10 STD-JULIAN-DATE pic 9(7).
* 10 STD-JULIAN-VALUE redefines STD-JULIAN-DATE.
* 15 STD-JULIAN-CCYY pic 9(4).
* 15 STD-JULIAN-DAY pic 9(3).
* 10 STD-DAYS-REMAINING pic 9(3).
* 10 STD-DATE-VERBAGE pic X(18).
* 10 STD-DATE-EDIT-BYTE pic X.
* 10 STD-DATE-EDITED pic X(10).
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 1997/02/27 Simmons, Created program.
*
*****************************************************************
*
DATA DIVISION.
WORKING-STORAGE SECTION.
*
*****************************************************************
* Data-structure for Title and Copyright...
*****************************************************************
01 SIM-TITLE.
05 T1 pic X(11) value '* SIMODATE '.
05 T2 pic X(34) value 'Process a Date Request '.
05 T3 pic X(10) value ' v1.1.01 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* SIMODATE '.
05 C2 pic X(20) value 'Copyright 1987-2003 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
*****************************************************************
01 FIRST-TIME pic X value 'Y'.
01 IX-1 pic 999 value 0.
01 IX-2 pic 999 value 0.
01 WORK-N-7 pic 9(7) value 0.
01 DATE-WORK-ALPHA.
05 DATE-WORK-A-CCYY pic X(4) value SPACES.
05 DATE-WORK-A-MM pic X(2) value SPACES.
05 DATE-WORK-A-DD pic X(2) value SPACES.
01 DATE-WORK-NUMERIC.
05 DATE-WORK-N-CCYY pic 9(4) value 0.
05 DATE-WORK-N-MM pic 9(2) value 0.
05 DATE-WORK-N-DD pic 9(2) value 0.
01 MONTH-TABLE-DATA.
05 filler pic X(10) value 'January '.
05 filler pic X(10) value 'February '.
05 filler pic X(10) value 'March '.
05 filler pic X(10) value 'April '.
05 filler pic X(10) value 'May '.
05 filler pic X(10) value 'June '.
05 filler pic X(10) value 'July '.
05 filler pic X(10) value 'August '.
05 filler pic X(10) value 'September '.
05 filler pic X(10) value 'October '.
