| |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Execute a Job Script. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
The JCL or CMD member for running the application. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Prepare test data and call CIEDMKA1. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
End of Job Processing. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Perform the EDMK Function. |
|
|
|
|
|
|
|
|
|
| |
|
|
|
|
|
|
|
|
EDMK, Prepare Packed-Decimal Value for Human Observation using COBOL
|
Color Associations: The light-green boxes are unique to SIMOTIME Technologies using an IBM Mainframe System or Micro Focus Enterprise Developer.
The light-red boxes are unique to the SIMOTIME Technologies using a Linux, UNIX or Windows System and COBOL Technologies such as Micro Focus.
The light-yellow boxes are SIMOTIME Technologies, Third-party Technologies, decision points or program transitions in the processing logic or program generations.
The light-blue boxes identify the input/output data structures such as Documents, Spreadsheets, Data Files, VSAM Data Sets, Partitioned Data Set Members (PDSM's) or Relational Tables.
The light-gray boxes identify a system function or an informational item.
Job Scripts
The following describes the Job Scripts for this test case.
JCL Member
The following is the JCL Member (CIEDMKJ1.jcl) required to run this test case. The JOB may need to be modified for specific user environments.
//CIEDMKJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1
//* *******************************************************************
//* CIEDMKJ1.JCL - a JCL Member for Batch Job Processing *
//* This JCL Member is provided by SimoTime Technologies *
//* (C) Copyright 1987-2019 All Rights Reserved *
//* Web Site URL: http://www.simotime.com *
//* e-mail: helpdesk@simotime.com *
//* *******************************************************************
//*
//* Text - Regression Test, COBOL, EDMK Function
//* Author - SimoTime Technologies
//* Date - January 01, 1989
//*
//* A COBOL Program that does the EDMK Function using various masks.
//*
//* This set of programs will run on an IBM Mainframe System or on
//* a Windows System with Micro Focus Enterprise Developer and the
//* Mainframe Sub-System option.
//*
//* ************
//* * CIEDMKJ1 * Note 01
//* ********jcl*
//* *
//* *------------------------*
//* * *
//* * ************ ************ ************
//* * * InStream *-----* CIEDMKC0 *-----* SYSOUT * Note 02
//* * *******data* ********cbl* *******lseq*
//* * *
//* * ************ ************
//* * * If CALL? *-No--* EOJ * Note 03
//* * ************ ************
//* * *
//* * Yes
//* * *
//* * ************ ************ ************
//* * * PassArea *-----* CIEDMKC1 *-----* SYSOUT * Note 04
//* * *******data* ********cbl* *******lseq*
//* * *
//* *------loop--------------*
//*
//*
//* Note 01: Execute a Job Script.
//* Note 02: Prepare the test data and call CIEDMKC1
//* Note 03: End of Job Processing
//* Note 04: Perform the EDMK Instruction
//*
//* *******************************************************************
//* Step 1 of 1, This is a single step job.
//*
//AIEDMKS1 EXEC PGM=CIEDMKC0
//STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR
//SYSOUT DD SYSOUT=*
//*
CMD Member
The following is the Windows Command File (CIEDMKW1.cmd) required to run this test case. The JOB may need to be modified for specific user environments.
@echo OFF
set CmdName=CIEDMKW1
rem * *******************************************************************
rem * CIEDMKW1.cmd - a Windows Command File *
rem * This program is provided by SimoTime Technologies *
rem * (C) Copyright 1987-2019 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem * Text - Regression Test, COBOL, EDMK Function
rem * Author - SimoTime Technologies
rem * Date - January 01, 1989
rem *
rem * A COBOL program that does the EDMK Functions using various masks.
rem *
rem * This job will run on a Windows System with Micro Focus Enterprise
rem * Developer.
rem *
rem * ************
rem * * CIEDMKW1 * Note 01
rem * ********cmd*
rem * *
rem * *------------------------*
rem * * *
rem * * ************ ************ ************
rem * * * InStream *-----* CIEDMKC0 *-----* SYSOUT * Note 02
rem * * *******data* ********cbl* *******lseq*
rem * * *
rem * * ************ ************
rem * * * If CALL? *-No--* EOJ * Note 03
rem * * ************ ************
rem * * *
rem * * Yes
rem * * *
rem * * ************ ************ ************
rem * * * PassArea *-----* CIEDMKC1 *-----* SYSOUT * Note 04
rem * * *******data* ********cbl* *******lseq*
rem * * *
rem * *------loop--------------*
rem *
rem *
rem * Note 01: Execute a Job Script.
rem * Note 02: Prepare thetest data and call CIEDMKC1
rem * Note 03: End of Job Processing
rem * Note 04: Perform the EDMK Instruction
rem *
rem *******************************************************************
rem * Step 1 of 2 Set the global environment variables...
rem *
call ..\ENV1BASE %CmdName%
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting CmdName %CmdName%, V08.06.05, User is %USERNAME%"
rem * ********************************************************************
rem * Step 2 of 2 Execute the EDMK programs...
rem *
set SYSOUT=%BASELIB1%\LOGS\SYSOUT_%CmdName%.txt
run CIEDMKC0
if not "%ERRORLEVEL%" == "0" set JobStatus=0010
if not "%JobStatus%" == "0000" goto :EojNOK
:EojAOK
call SimoNOTE "Finished CmdName %CmdName%, Job Status is %JobStatus% "
goto :End
:EojNOK
call SimoNOTE "ABENDING CmdName %CmdName%, Job Status is %JobStatus% "
set SYSNOTE=%BASEAPP%\LOGS\SYSNOTE_%CmdName%.TXT
echo %DATE% - %TIME% Starting User ABEND Processing for %CmdName%>>%SYSNOTE%
set >>%SYSNOTE%
echo %DATE% - %TIME% Complete User ABEND Processing for %CmdName%>>%SYSNOTE%
goto :End
:End
call SimoNOTE "Conclude SysOut is %SYSOUT%"
if not "%SIMOMODE%" == "BATCH" pause
exit /B %JobStatus%
The COBOL Programs
This Test Case includes two COBOL members. The 1st member is a driver program that prepares the test data and calls the 2nd member. The 2nd member uses an edit mask to prepare a numeric, packed-decimal number for a review process that requires human observation.
Note: Originally, the 2nd member was an Assembler Program that compiled and executed on an IBM Mainframe System. It provided the numeric preparation function by using the Edit and Mark (EDMK) Instruction.
Main Driver Program
This program (CIEDMKC0.cbl) will prepare the test data and make the call to CIEDMKC1.
*
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CIEDMKC0
*AUTHOR. SIMOTIME TECHNOLOGIES
*Generation Date: 2018-12-04
*Generation Time: 20:34:57:86
*
*****************************************************************
DATA DIVISION.
*
*****************************************************************
WORKING-STORAGE SECTION.
*****************************************************************
* Data-structure for Title, Copyright and Thank you...
* ------------------------------------------------------------
01 SIM-TITLE.
05 ST1 pic X(34) value 'Test Program to call EDMK Function'.
05 ST2 pic X(34) value ' v00.00.00 http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 ST3 pic X(34) value 'Copyright - 1987-2019 by SimoTime '.
05 ST4 pic X(34) value 'Technologies - All Rights Reserved'.
01 SIM-THANKS-01.
05 TU1 pic X(34) value 'Thank you for using this program p'.
05 TU2 pic X(34) value 'rovided from SimoTime Technologies'.
01 SIM-THANKS-02.
05 TU3 pic X(34) value 'Please send all inquires or sugges'.
05 TU4 pic X(34) value 'tions to the helpdesk@simotime.com'.
*****************************************************************
* Message Buffer used for display to SYSOUT or CONSOLE.
* MSG-CTR, Counter of trailing spaces in the Message Buffer
* MSG-LOB, Allocated Length of Message Buffer
* MSG-LSB, Last Significant Byte in Message Buffer
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(011) value '* CIEDMKC0 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(068) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MSG-CTR pic 9(3) value 0.
01 MSG-LOB pic 9(3) value 267.
01 MSG-LSB pic 9(3) value 267.
*
01 PACKED-NBR-GROUP.
05 PACKED-NBR-S19-00-X.
10 PACKED-NBR-S19-00 pic S9(19) comp-3.
10 FILLER pic X(3) value 'END'.
05 PACKED-NBR-S18-00-X.
10 PACKED-NBR-S18-00 pic S9(18) comp-3.
10 FILLER pic X(3) value 'END'.
05 PACKED-NBR-S17-00-X.
10 PACKED-NBR-S17-00 pic S9(17) comp-3.
10 FILLER pic X(3) value 'END'.
10 FILLER pic X.
05 PACKED-NBR-S16-00-X.
10 PACKED-NBR-S16-00 pic S9(16) comp-3.
10 FILLER pic X(3) value 'END'.
10 FILLER pic X.
05 PACKED-NBR-S13-00-X.
10 PACKED-NBR-S13-00 pic S9(13) comp-3.
10 FILLER pic X(3).
10 FILLER pic X(3) value 'END'.
05 PACKED-NBR-S12-00-X.
10 PACKED-NBR-S12-00 pic S9(12) comp-3.
10 FILLER pic X(3).
10 FILLER pic X(3) value 'END'.
05 PACKED-NBR-S11-00-X.
10 PACKED-NBR-S11-00 pic S9(11) comp-3.
10 FILLER pic X(4).
10 FILLER pic X(3) value 'END'.
05 PACKED-NBR-S10-00-X.
10 PACKED-NBR-S10-00 pic S9(10) comp-3.
10 FILLER pic X(4).
10 FILLER pic X(3) value 'END'.
05 PACKED-NBR-S09-00-X.
10 PACKED-NBR-S09-00 pic S9(09) comp-3.
10 FILLER pic X(5).
10 FILLER pic X(3) value 'END'.
*
01 ID-PACKED-DECIMAL.
05 FILLER pic X(27) value '* Packed-Decimal...........'.
05 FILLER pic X(21) value '(Hex-Notation)...... '.
01 ID-EDITMASK.
05 FILLER pic X(27) value '* Edit-Mask................'.
05 FILLER pic X(21) value '(Hex-Notation)...... '.
01 ID-EDITED-RESULTS.
05 FILLER pic X(27) value '* Edited-Results...........'.
05 FILLER pic X(21) value '(CBL_Display)....... '.
*
COPY CIEDMKB1.
COPY STPEEKB1.
*
*****************************************************************
PROCEDURE DIVISION.
move '* Enter, PROCEDURE DIVISION' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
perform STARTING-PROGRAM
perform FUNCTION-TEST-01
perform FUNCTION-TEST-02
perform FUNCTION-TEST-S12
perform FUNCTION-TEST-S13
perform FUNCTION-TEST-S16
perform FUNCTION-TEST-S17
perform FUNCTION-TEST-S18
perform FUNCTION-TEST-S19
perform STOPPING-PROGRAM
move '* Leave, PROCEDURE DIVISION' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
GOBACK.
*****************************************************************
FUNCTION-TEST-01.
move '* Enter, FUNCTION-TEST-01' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Prepare test data for EDMK Function Testing
add 12345 to ZERO giving PACKED-NBR-S11-00
add 12 to ZERO giving EDITMKSZ
move x'402020202020202020202020' to EDITWK30
*
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S11-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S11-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
call 'CIEDMKC1' using PACKED-NBR-S11-00,
EDITMKSZ,
EDITWK30
move ID-EDITED-RESULTS to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-01' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-02.
move '* Enter, FUNCTION-TEST-02' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 2468075 to ZERO giving PACKED-NBR-S11-00
add 15 to ZERO giving EDITMKSZ
move x'402020206B2020206B2020204B2020' to EDITWK30
*
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S11-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S11-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S11-00,
EDITMKSZ,
EDITWK30
move '* Edited-Results...........(CBL_Display)....... '
to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-02' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-S12.
move '* Enter, FUNCTION-TEST-S12' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 123456789098 to ZERO giving PACKED-NBR-S12-00
add 18 to ZERO giving EDITMKSZ
move x'4020206B2020206B2020206B2020204B2020'
to EDITWK30
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S12-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S12-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S12-00,
EDITMKSZ,
EDITWK30
move '* Edited-Results...........(CBL_Display)....... '
to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-S12' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-S13.
move '* Enter, FUNCTION-TEST-S13' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 123456789098 to ZERO giving PACKED-NBR-S13-00
add 18 to ZERO giving EDITMKSZ
move x'4020206B2020206B2020206B2020204B2020'
to EDITWK30
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S13-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S13-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S13-00,
EDITMKSZ,
EDITWK30
move ID-EDITED-RESULTS to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-S13' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-S16.
move '* Enter, FUNCTION-TEST-S16' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 1234567890123456 to ZERO giving PACKED-NBR-S16-00
add 17 to ZERO giving EDITMKSZ
* ....:....1....:....2....:....3....:....4....:....5....:
move
x'2020202020202020202020202020202020'
to EDITWK30
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S16-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S16-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S16-00-X,
EDITMKSZ,
EDITWK30
move ID-EDITED-RESULTS to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-16' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-S17.
move '* Enter, FUNCTION-TEST-S17' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 12345678901234567 to ZERO giving PACKED-NBR-S17-00
add 23 to ZERO giving EDITMKSZ
* ....:....1....:....2....:....3....:....4....:....5....:
move
x'4020206B2020206B2020206B2020206B2020206B202020'
to EDITWK30
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S17-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S17-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S17-00,
EDITMKSZ,
EDITWK30
move ID-EDITED-RESULTS to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-S17' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-S18.
move '* Enter, FUNCTION-TEST-S18' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 123456789012345678 to ZERO giving PACKED-NBR-S18-00
add 20 to ZERO giving EDITMKSZ
* ....:....1....:....2....:....3....:....4....:....5....:
move
x'4020202020202020202020202020202020202020'
to EDITWK30
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S18-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S18-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S18-00,
EDITMKSZ,
EDITWK30
move ID-EDITED-RESULTS to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-18' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
FUNCTION-TEST-S19.
move '* Enter, FUNCTION-TEST-S19' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
* Prepare numeric values for processing by EDMK Instruction
add 1234567890123456789 to ZERO giving PACKED-NBR-S19-00
add 26 to ZERO giving EDITMKSZ
* ....:....1....:....2....:....3....:....4....:....5....:
move
x'40206B2020206B2020206B2020206B2020206B2020206B202020'
to EDITWK30
* -----------------------------------------------------------*
* Hex-Dump of Packed-Decimal and Edit Mask
add length of PACKED-NBR-S19-00 to ZERO
giving STPEEK-USR-SIZE
call 'STPEEKC1' using PACKED-NBR-S19-00,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
* Post Hex-Dump of Packed-Decimal Field
move ID-PACKED-DECIMAL to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
* Post Hex-Dump of Edit Mask
add EDITMKSZ to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDITWK30,
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move ID-EDITMASK to MESSAGE-TEXT
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(49:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
* Do the Numeric Edit and display results
* Present numeric values for Human Observation...
call 'CIEDMKC1' using PACKED-NBR-S19-00,
EDITMKSZ,
EDITWK30
move ID-EDITED-RESULTS to MESSAGE-TEXT
move EDITWK30(1:EDITMKSZ) to MESSAGE-TEXT(49:EDITMKSZ)
perform Z-POST-MESSAGE-TO-USER
*
* -----------------------------------------------------------*
move '* Leave, FUNCTION-TEST-S19' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
STARTING-PROGRAM.
move SIM-TITLE to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
move SIM-COPYRIGHT to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
STOPPING-PROGRAM.
move SIM-THANKS-01 to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
move SIM-THANKS-02 to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
exit.
*****************************************************************
* The following routines are used to access data files.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-POST-MESSAGE-TO-SYSOUT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-SYSOUT
add 12 to ZERO giving RETURN-CODE
STOP RUN.
* exit.
*****************************************************************
Z-CALCULATE-MESSAGE-LSB.
add 267 to ZERO giving MSG-LSB
perform until MSG-LSB < 80
or MESSAGE-BUFFER(MSG-LSB:1) not = SPACE
if MESSAGE-BUFFER(MSG-LSB:1) = SPACE
subtract 1 from MSG-LSB
end-if
end-perform
exit.
*****************************************************************
* Display message to SYSOUT device... *
*****************************************************************
Z-POST-MESSAGE-TO-SYSOUT.
perform Z-CALCULATE-MESSAGE-LSB
display MESSAGE-BUFFER(1:MSG-LSB)
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display message to CONSOLE device... *
*****************************************************************
Z-POST-MESSAGE-TO-CONSOLE.
perform Z-CALCULATE-MESSAGE-LSB
display MESSAGE-BUFFER(1:MSG-LSB) upon console
exit.
*****************************************************************
Z-POST-MESSAGE-TO-USER.
perform Z-POST-MESSAGE-TO-CONSOLE
perform Z-POST-MESSAGE-TO-SYSOUT
exit.
Called Program, the EDMK Function
This program (CIEDMKC1.cbl) accepts the caller's parameters, does the EDMK function and returns to the caller.
*
*****************************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. CIEDMKC1
*AUTHOR. SIMOTIME TECHNOLOGIES
*Generation Date: 2018-12-20
*Generation Time: 17:19:24:89
*
*****************************************************************
* A Test Case for a Base Template to assist with a manual
* conversion from IBM HLASM to COBOL.
*****************************************************************
*
*****************************************************************
DATA DIVISION.
*
*****************************************************************
WORKING-STORAGE SECTION.
*
*****************************************************************
* Message Buffer used for display to SYSOUT or CONSOLE.
* MSG-CTR, Counter of trailing spaces in the Message Buffer
* MSG-LOB, Allocated Length of Message Buffer
* MSG-LSB, Last Significant Byte in Message Buffer
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(011) value '* CIEDMKC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(068) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 MSG-CTR pic 9(3) value 0.
01 MSG-LOB pic 9(3) value 267.
01 MSG-LSB pic 9(3) value 267.
*
01 EDIT-PACK-LENGTH pic 9(3) value 0.
01 EDIT-DIGIT-COUNT pic 9(3) value 0.
01 EDT4-01.
05 FILLER pic X(21) value '* CIEDMKC1 Pack-Size '.
05 EDT4-PACK-SIZE pic 9(3) value 0.
05 FILLER pic X(12) value ', Mask-Size '.
05 EDT4-MASK-SIZE pic 9(3) value 0.
05 FILLER pic X(12) value ', Mask-2021 '.
05 EDT4-MASK-2021 pic 9(3) value 0.
*
COPY STBASEB1.
COPY BFLAGSB1.
COPY GPREGSB1.
COPY CIEDMKB1.
COPY STPEEKB1.
COPY HEXTABLE.
*
*****************************************************************
LINKAGE SECTION.
01 EDIT-PACK-NUMBER.
05 EDIT-PACK-19-00 pic 9(19) comp-3.
05 FILLER pic X(3).
01 EDIT-MASK-LENGTH pic 9(9) comp.
01 EDIT-WORK-BUFFER pic X(30).
*
*****************************************************************
PROCEDURE DIVISION using EDIT-PACK-NUMBER,
EDIT-MASK-LENGTH,
EDIT-WORK-BUFFER .
move 'NNNNNNNN/NNNNNNNN' to BF-GROUP
initialize R32-BIT-REGISTERS
if BF-T3 = 'Y'
move all '*' to MESSAGE-TEXT(1:71)
perform Z-POST-MESSAGE-TO-USER
move '* Enter, PROCEDURE DIVISION' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
add EDIT-PACK-LENGTH to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1'
using EDIT-PACK-NUMBER(1:EDIT-PACK-LENGTH)
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move STPEEK-HEX-DUMP(1:EDIT-PACK-LENGTH * 2)
to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
end-if
*
perform CALCULATE-EDIT-PACK-LENGTH
perform DO-EDMK-INSTRUCTION
*
if BF-T3 = 'Y'
move '* Leave, PROCEDURE DIVISION' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
end-if
GOBACK.
*
*****************************************************************
CALCULATE-EDIT-PACK-LENGTH.
move ZERO to EDIT-PACK-LENGTH
move ZERO to EDIT-DIGIT-COUNT
add 1 to ZERO giving ED-X1
perform until ED-X1 > EDIT-MASK-LENGTH
if EDIT-WORK-BUFFER(ED-X1:1) = x'20'
or EDIT-WORK-BUFFER(ED-X1:1) = x'21'
add 1 to EDIT-DIGIT-COUNT
end-if
add 1 to ED-X1
end-perform
if EDIT-DIGIT-COUNT / 2 * 2 = EDIT-DIGIT-COUNT
compute EDIT-PACK-LENGTH ROUNDED = EDIT-DIGIT-COUNT / 2
add 1 to EDIT-PACK-LENGTH
else
compute EDIT-PACK-LENGTH ROUNDED = EDIT-DIGIT-COUNT / 2
end-if
exit.
*
*****************************************************************
EDMK-TRACE.
move '* Enter, EDMK-TRACE...' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
add EDIT-PACK-LENGTH to ZERO giving EDT4-PACK-SIZE
add EDIT-MASK-LENGTH to ZERO giving EDT4-MASK-SIZE
add EDIT-DIGIT-COUNT to ZERO giving EDT4-MASK-2021
move EDT4-01 to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
add EDIT-PACK-LENGTH to ZERO giving STPEEK-USR-SIZE
call 'STPEEKC1' using EDIT-PACK-NUMBER(1:EDIT-PACK-LENGTH)
STPEEK-USR-SIZE,
STPEEK-HEX-DUMP
move STPEEK-HEX-DUMP(1:EDIT-PACK-LENGTH * 2) to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-USER
move STPEEK-HEX-DUMP(1:STPEEK-USR-SIZE * 2)
to MESSAGE-TEXT(29:STPEEK-USR-SIZE * 2)
perform Z-POST-MESSAGE-TO-USER
move '* EDIT-WORK-BUFFER ........ ' to MESSAGE-TEXT
move EDIT-WORK-BUFFER(29:EDIT-MASK-LENGTH)
to MESSAGE-TEXT(21:EDIT-MASK-LENGTH)
perform Z-POST-MESSAGE-TO-USER
exit.
COPY EDMKPDB1.
COPY STABNDB1.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-POST-MESSAGE-TO-SYSOUT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-POST-MESSAGE-TO-SYSOUT
add 12 to ZERO giving RETURN-CODE
STOP RUN.
* exit.
*****************************************************************
Z-CALCULATE-MESSAGE-LSB.
add 267 to ZERO giving MSG-LSB
perform until MSG-LSB < 80
or MESSAGE-BUFFER(MSG-LSB:1) not = SPACE
if MESSAGE-BUFFER(MSG-LSB:1) = SPACE
subtract 1 from MSG-LSB
end-if
end-perform
exit.
*****************************************************************
* Display message to SYSOUT device... *
*****************************************************************
Z-POST-MESSAGE-TO-SYSOUT.
perform Z-CALCULATE-MESSAGE-LSB
display MESSAGE-BUFFER(1:MSG-LSB)
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* Display message to CONSOLE device... *
*****************************************************************
Z-POST-MESSAGE-TO-CONSOLE.
perform Z-CALCULATE-MESSAGE-LSB
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:MSG-LSB) upon console
exit.
*****************************************************************
Z-POST-MESSAGE-TO-USER.
perform Z-POST-MESSAGE-TO-CONSOLE
perform Z-POST-MESSAGE-TO-SYSOUT
exit.
Summary
This test case executes a callable COBOL program that performs the same function as an EDMK 370 Assembler Instruction. A Hex-Dump routine is used to display the memory used by the program. This document may be used to assist as a tutorial for new COBOL programmers or as a quick reference for experienced programmers. The samples focus on the coding techniques of the individual instructions. As always, it is the programmer's responsibility to thoroughly test all programs.
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
Software Agreement and Disclaimer
Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.
SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.
Downloads and Links
This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.
Note: A SimoTime License is required for the items to be made available on a local system or server.
Current Server or Internet Access
The following links may be to the current server or to the Internet.
Explore the Assembler Connection for more examples of mainframe Assembler programming techniques and sample code.
Explore the COBOL Connection for more examples of COBOL programming techniques and sample code.
Explore The ASCII and EBCDIC Translation Tables. These tables are provided for individuals that need to better understand the bit structures and differences of the encoding formats.
Explore the SS Format of the Edit and Mark Instruction. The assembler program is written to comply with an Assembler/H or HLASM Mainframe Assembler dialect. A JCL member is provided as a job script to run as a batch job on an IBM Mainframe System with ZOS or a Windows System with Micro Focus Enterprise Developer.
Internet Access Required
The following links will require an internet connect.
A good place to start is
The SimoTime Home Page
for access to white papers, program examples and product information. This link requires an Internet Connection
Explore
The Micro Focus Web Site
for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.
Glossary of Terms
Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.
Contact or Feedback
This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.
|
1.
|
Send an e-mail to our helpdesk.
|
|
2.
|
Our telephone numbers are as follows.
|
|
2.1.
|
1 415 763-9430 office-helpdesk
|
|
2.2.
|
1 415 827-7045 mobile
|
We appreciate hearing from you.
Company Overview
SimoTime Technologies was founded in 1987 and is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.
Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.
Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.
Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
Copyright © 1987-2025
SimoTime Technologies and Services
All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |
|
