Pass, Parse & Convert using COBOL
http://www.simotime.com
|
|
Data String
Manipulation Pass, Parse & Convert using COBOL http://www.simotime.com |
| When technology complements business | Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
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.
|
|
||||||||||||||||||
|
|
|
|||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|
|
|
|
||||||||||||||||
|
|||||||||||||||||||
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.
|
|||
|
|||
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-2010 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-2010 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only 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-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
01 SIM-THANKS-01.
05 C1 pic X(11) value '* 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-2010 SimoTime Enterprises *
* All Rights Reserved *
*****************************************************************
* Provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
01 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-2010 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only 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-2010 '.
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-2010 SimoTime Enterprises *
* All Rights Reserved *
*****************************************************************
* Provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
01 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-2010 SimoTime Enterprises, LLC. *
* *
* All rights reserved. Unpublished, all rights reserved under *
* copyright law and international treaty. Use of a copyright *
* notice is precautionary only 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-2010 '.
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 '.
05 filler pic X(10) value 'November '.
05 filler pic X(10) value 'December '.
05 filler pic 99 value 31.
05 filler pic 99 value 28.
05 filler pic 99 value 31.
05 filler pic 99 value 30.
05 filler pic 99 value 31.
05 filler pic 99 value 30.
05 filler pic 99 value 31.
05 filler pic 99 value 31.
05 filler pic 99 value 30.
05 filler pic 99 value 31.
05 filler pic 99 value 30.
05 filler pic 99 value 31.
01 MONTH-TABLE redefines MONTH-TABLE-DATA.
05 MONTH-VERBAGE pic X(10) occurs 12 times.
05 MONTH-COUNT-OF-DAYS pic 99 occurs 12 times.
01 JULIAN-DATE.
05 JULIAN-CCYY pic 9(4) value 0.
05 JULIAN-DDD pic 9(3) value 0.
01 DATE-VERBAGE pic X(18) value SPACES.
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* SIMODATE '.
05 MESSAGE-TEXT pic X(68).
*****************************************************************
LINKAGE SECTION.
COPY PASSDATE.
*****************************************************************
* Mainline processing routine...
*****************************************************************
PROCEDURE DIVISION using STD-SIMODATE.
add 20 to ZERO giving STD-RESPONSE
move SPACES to STD-MESSAGE-TEXT
if FIRST-TIME not = 'N'
if STD-DEBUG-INFO = 'DEBUG '
or STD-DEBUG-INFO = 'TRACE '
perform Z-POST-COPYRIGHT
end-if
move 'N' to FIRST-TIME
end-if
evaluate STD-REQUEST
when 'EDITDATE' perform EDIT-DATE-FUNCTION
when OTHER add 16 to ZERO giving RETURN-CODE
move '0016' to STD-RESPONSE
end-evaluate
if STD-RESPONSE = 20
and STD-MESSAGE-TEXT = SPACES
subtract STD-RESPONSE from STD-RESPONSE
end-if
GOBACK.
*****************************************************************
* The following routines are in alphabetical order... *
*****************************************************************
*
*****************************************************************
*> This routine will accept dates in the following formats
*> ccyymmdd
*> ccyy/mm/dd
*> ccyy-mm-dd
*> ccyy.mm.dd
*****************************************************************
EDIT-DATE-FUNCTION.
move SPACES to DATE-WORK-ALPHA
add 1 to ZERO giving IX-2
move STD-GREGORIAN-4-EDIT to DATE-WORK-A-CCYY
if DATE-WORK-A-CCYY not NUMERIC
move 'NOK for Date Value, CCYY not numeric value...'
to MESSAGE-TEXT
perform Z-POST-ABEND
else
add 4 to IX-2
end-if
*> --------------------------------------------------------
*> Possible non-numeric separator between CCYY and MM
if STD-GREGORIAN-4-EDIT(IX-2:1) not NUMERIC
add 1 to IX-2
end-if
move STD-GREGORIAN-4-EDIT(IX-2:2) to DATE-WORK-A-MM
if DATE-WORK-A-MM not NUMERIC
move DATE-WORK-A-MM(1:1) to DATE-WORK-A-MM(2:1)
move ZERO to DATE-WORK-A-MM(1:1)
add 1 to IX-2
else
add 2 to IX-2
end-if
*> --------------------------------------------------------
*> Possible non-numeric separator between MM and DD
if STD-GREGORIAN-4-EDIT(IX-2:1) not NUMERIC
add 1 to IX-2
end-if
move STD-GREGORIAN-4-EDIT(IX-2:2) to DATE-WORK-A-DD
if DATE-WORK-A-DD not NUMERIC
move DATE-WORK-A-DD(1:1) to DATE-WORK-A-DD(2:1)
move ZERO to DATE-WORK-A-DD(1:1)
end-if
if DATE-WORK-A-MM not NUMERIC
move 'NOK for Date Value, MM not numeric value...'
to MESSAGE-TEXT
perform Z-POST-ABEND
end-if
if DATE-WORK-A-DD not NUMERIC
move 'NOK for Date Value, DD not numeric value...'
to MESSAGE-TEXT
perform Z-POST-ABEND
end-if
move 'WIP for Date Function...' to MESSAGE-TEXT
perform Z-POST-CONDITIONAL-TRACE
move DATE-WORK-ALPHA to DATE-WORK-NUMERIC
*> ------------------------------------------------------------
*> Determine if a leap year, it is not true that every fourth
*> year is a leap year.
*>
*> if YYYY is divisible by 4 it is a possible leap year and
*> additional checking is required.
*>
*> if YYYY is divisible by 100 and not divisible by 400
*> then it is not a leap year.
*>
*> In other words the 100th year increments are not leap
*> years with the exception that every 400th year increment
*> is a leap year.
*>
move 'N' to STD-LEAP-YEAR-YN
add 28 to ZERO giving MONTH-COUNT-OF-DAYS(2)
move 'WIP for Date, not a Leap Year...' to MESSAGE-TEXT
divide DATE-WORK-N-CCYY by 4 giving WORK-N-7
multiply 4 by WORK-N-7
if WORK-N-7 = DATE-WORK-N-CCYY
divide DATE-WORK-N-CCYY by 100 giving WORK-N-7
multiply 100 by WORK-N-7
if WORK-N-7 = DATE-WORK-N-CCYY
divide DATE-WORK-N-CCYY by 400 giving WORK-N-7
multiply 400 by WORK-N-7
if WORK-N-7 = DATE-WORK-N-CCYY
move 'Y' to STD-LEAP-YEAR-YN
end-if
else
move 'Y' to STD-LEAP-YEAR-YN
end-if
if STD-LEAP-YEAR-YN = 'Y'
move 'Y' to STD-LEAP-YEAR-YN
add 29 to ZERO giving MONTH-COUNT-OF-DAYS(2)
move 'WIP for Date, it is a Leap Year...'
to MESSAGE-TEXT
end-if
end-if
perform Z-POST-CONDITIONAL-TRACE
*> ------------------------------------------------------------
*> Test for a valid month...
if DATE-WORK-N-MM > 0
and DATE-WORK-N-MM < 13
move 'WIP for Date, month is ?????????' to MESSAGE-TEXT
move MONTH-VERBAGE(DATE-WORK-N-MM)
to MESSAGE-TEXT(24:10)
perform Z-POST-CONDITIONAL-TRACE
move MONTH-VERBAGE(DATE-WORK-N-MM)
to MESSAGE-TEXT(24:10)
move MONTH-VERBAGE(DATE-WORK-N-MM) to STD-MONTH-VERBAGE
else
move 'NOK for Date Value, MM not 1 through 12...'
to MESSAGE-TEXT
perform Z-POST-ABEND
end-if
*> ------------------------------------------------------------
*> Test for a valid day...
if DATE-WORK-N-DD > 0
and DATE-WORK-N-DD < MONTH-COUNT-OF-DAYS(DATE-WORK-N-MM) + 1
move 'WIP for Date, month has ?? days' to MESSAGE-TEXT
move MONTH-COUNT-OF-DAYS(DATE-WORK-N-MM)
to MESSAGE-TEXT(25:2)
perform Z-POST-CONDITIONAL-TRACE
else
move 'NOK for Day Value, DD not within month range...'
to MESSAGE-TEXT
perform Z-POST-ABEND
end-if
move MONTH-COUNT-OF-DAYS(DATE-WORK-N-MM)
to STD-MM-DAYS
*> ------------------------------------------------------------
*> Create text version of the date. This is a sixteen character
*> field (DATE-VERBAGE) that is left-justified in the following
*> format... month dd, ccyy
move 'WIP for Date, ' to MESSAGE-TEXT
move MONTH-VERBAGE(DATE-WORK-N-MM) to DATE-VERBAGE
subtract IX-2 from IX-2
inspect DATE-VERBAGE tallying IX-2
for CHARACTERS before SPACE
add 2 to IX-2
if DATE-WORK-A-DD(1:1) = '0'
move DATE-WORK-A-DD(2:1) to DATE-VERBAGE(IX-2:1)
add 1 to IX-2
else
move DATE-WORK-A-DD to DATE-VERBAGE(IX-2:2)
add 2 to IX-2
end-if
move ', ' to DATE-VERBAGE(IX-2:2)
add 2 to IX-2
move DATE-WORK-N-CCYY to DATE-VERBAGE(IX-2:4)
move DATE-VERBAGE to MESSAGE-TEXT(15:18)
perform Z-POST-CONDITIONAL-TRACE
move DATE-VERBAGE to STD-DATE-VERBAGE
*> ------------------------------------------------------------
*> Create numeric date for display or print...
move DATE-WORK-A-CCYY to STD-DATE-EDITED
move STD-DATE-EDIT-BYTE to STD-DATE-EDITED(5:1)
move DATE-WORK-A-MM to STD-DATE-EDITED(6:2)
move STD-DATE-EDIT-BYTE to STD-DATE-EDITED(8:1)
move DATE-WORK-A-DD to STD-DATE-EDITED(9:2)
move DATE-WORK-NUMERIC to STD-GREGORIAN-DATE
*> ------------------------------------------------------------
*> Determine Julian Date...
move 'WIP for Date, Julian is CCYYDDD' to MESSAGE-TEXT
move DATE-WORK-N-CCYY to JULIAN-CCYY
add DATE-WORK-N-DD to ZERO giving JULIAN-DDD
add 1 to ZERO giving IX-2
perform until IX-2 = DATE-WORK-N-MM
or IX-2 > 12
add MONTH-COUNT-OF-DAYS(IX-2) to JULIAN-DDD
add 1 to IX-2
end-perform
move JULIAN-DATE to MESSAGE-TEXT(25:7)
perform Z-POST-CONDITIONAL-TRACE
move JULIAN-DATE to STD-JULIAN-DATE
*> ------------------------------------------------------------
*> Calculate remaining days in the year...
if STD-LEAP-YEAR-YN = 'Y'
subtract STD-JULIAN-DAY from 366
giving STD-DAYS-REMAINING
else
subtract STD-JULIAN-DAY from 365
giving STD-DAYS-REMAINING
end-if
*> ------------------------------------------------------------
*> Determine AOK for Date Message...
move 'AOK for Date Function...' to MESSAGE-TEXT
perform Z-POST-CONDITIONAL-TRACE
exit.
*****************************************************************
* Display Copyright or Program Message...
* ------------------------------------------------------------
Z-POST-ABEND.
if MESSAGE-TEXT not = SPACES
move MESSAGE-TEXT to STD-MESSAGE-TEXT
perform Z-POST-MESSAGE
end-if
move 'Program is ABENDING...' to MESSAGE-TEXT
perform Z-POST-MESSAGE
add 16 to ZERO giving STD-RESPONSE
GOBACK
exit.
Z-POST-COPYRIGHT.
display SIM-TITLE upon console
display SIM-COPYRIGHT upon console
exit.
Z-POST-MESSAGE.
display MESSAGE-BUFFER upon console
move SPACES to MESSAGE-TEXT
exit.
Z-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.
*****************************************************************
* 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 is an example of a user program (STAFMTC2.CBL) that will accept and process the edited and formatted data string from the Callable Application Program Extension (SimoCAPE) program.
IDENTIFICATION DIVISION.
PROGRAM-ID. STAFMTC2.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
*
* Copyright (C) 1987-2010 SimoTime Enterprises, LLC.
*
* All rights reserved. Unpublished, all rights reserved under
* copyright law and international treaty. Use of a copyright
* notice is precautionary only 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.
*
* SimoTime may be contacted via e-mail and also take a look at
* our Web Site.
*
* Our e-mail address is: helpdesk@simotime.com
* The URL for Web Site is: http://www.simotime.com
*
*****************************************************************
* SOURCE MODULE STAFMTC2.CBL
*****************************************************************
*
* STAFMTC2 - This program receives and processes the edited and
* formatted data string from the Callable Application Program
* Extension member (SimoCAPE).
*
* CALLING PROTOCOL
* ----------------
* call 'STAFMTC2' using CAPE-XCTL-API.
*
* The format of the LINKAGE SECTION paramter is as follows:
*
* 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-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).
*
*****************************************************************
*
* 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 '* STAFMTC2 '.
05 T2 pic X(34) value 'Receive Edited Date Parameters '.
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 '* STAFMTC2 '.
05 C2 pic X(20) value 'Copyright 1987-2010 '.
05 C3 pic X(28) value ' SimoTime Enterprises, LLC '.
05 C4 pic X(20) value ' All Rights Reserved'.
*****************************************************************
01 FIRST-TIME pic X value 'Y'.
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* STAFMTC2 '.
05 MESSAGE-TEXT pic X(68).
*****************************************************************
LINKAGE SECTION.
COPY CAPEXCTL.
*****************************************************************
* Mainline processing routine...
*****************************************************************
PROCEDURE DIVISION using CAPE-XCTL-API.
if FIRST-TIME not = 'N'
perform POST-COPYRIGHT
move 'N' to FIRST-TIME
end-if
move 'Gregorian Date .............. ' to MESSAGE-TEXT
move CAPE-GREGORIAN-DATE to MESSAGE-TEXT(31:10)
perform POST-MESSAGE
move 'Edited Gregorian Date ....... ' to MESSAGE-TEXT
move CAPE-DATE-EDITED to MESSAGE-TEXT(31:10)
perform POST-MESSAGE
move 'Text Date ................... ' to MESSAGE-TEXT
move CAPE-DATE-VERBAGE to MESSAGE-TEXT(31:16)
perform POST-MESSAGE
move 'Julian Date ................. ' to MESSAGE-TEXT
move CAPE-JULIAN-DATE to MESSAGE-TEXT(31:7)
perform POST-MESSAGE
move 'Days Remaining in the Year .. ' to MESSAGE-TEXT
move CAPE-DAYS-REMAINING to MESSAGE-TEXT(31:3)
perform POST-MESSAGE
move 'Leap Year Flag (Y or N) ..... ' to MESSAGE-TEXT
move CAPE-LEAP-YEAR-YN to MESSAGE-TEXT(31:1)
perform POST-MESSAGE
move 'Days in the Month ........... ' to MESSAGE-TEXT
move CAPE-DAYS-IN-MONTH to MESSAGE-TEXT(31:2)
perform POST-MESSAGE
move 'Text for the Month .......... ' to MESSAGE-TEXT
move CAPE-MONTH-VERBAGE to MESSAGE-TEXT(31:10)
perform POST-MESSAGE
move 'Amount ...................... ' to MESSAGE-TEXT
move CAPE-AMOUNT to MESSAGE-TEXT(31:11)
perform POST-MESSAGE
GOBACK.
*****************************************************************
* The following routines are in alphabetical order... *
*****************************************************************
*
*****************************************************************
* 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-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.
*****************************************************************
* 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 purpose of this document is to assist as a tutorial for new programmers or as a quick reference for experienced programmers. These sample programs are made available on an "as-is" basis and may be downloaded, copied and modified for specific situations as long as the copyright information is not removed or changed. As always, it is the programmer's responsibility to thoroughly test all programs.
Permission to use, copy, modify and distribute this software for any 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.
SimoTime Enterprises makes no warranty or representations about the suitability of the software for any purpose. It is provided "AS IS" without any express or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software.
Check out The Date Processing for editing, validating, formatting and converting dates.
Check out The Date Difference for calculating the difference between two gregorian dates.
The Callable Application Programming Extension (SimoCAPE) processes a parameter passed from JCL. This link provides access to a suite of programs that describe how a COBOL program processes a parameter passed from JCL .
The parsing of the parameter uses the same technique as describe in another SimoTime example that describes the parsing of a data string using COBOL. The name of the member that does the actual parsing is called SimoPARS. A copy file (PASSPARS.CPY) is provided for defining the pass area.
The hexadecimal dump of the parameter-buffer uses the same technique as describe in another SimoTime example that describes the dumping of a data string using COBOL. The name of the member that does the actual hexadecimal dump is called SimoDUMP. A copy file (PASSDUMP.CPY) is provided for defining the pass area.
The SimoZAPS Utility Program has the capability of generating a COBOL program that will do the conversion of sequential and VSAM (KSDS) files between EBCDIC and ASCII. SimoZAPS can also read a sequential file in EBCDIC format and create an ASCII/CRLF file or VSAM KSDS file in ASCII format. The conversion tables may be viewed or modified to meet unique requirements. The HEXCESS function provides the capability of viewing, finding or patching the contents of a file in hexadecimal.
Check out The SimoTime Library for a wide range of topics for Programmers, Project Managers and Software Developers.
To review all the information available on this site start at The SimoTime Home Page .
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
| When technology complements business |