Leading Spaces and Zeroes
http://www.simotime.com
|
|
COBOL
Numbers Leading Spaces and Zeroes http://www.simotime.com |
| When technology complements business | Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
This suite of example programs (COBOL, JCL and CMD files) will describe the process to compile and execute a COBOL program that is downloaded from a mainframe. The challenge with this program is that it is expected to process the various numeric items in the same manner as the mainframe. For example, a zoned-decimal field that contains leading spaces should not cause an ABEND (i.e. 163 error on Micro Focus) but should treat the leading spaces as zeroes and complete the arithmetic calculation. However, a packed-decimal field that contains non-numeric values would issue a S0C7 (referred to as a sock-seven) on the mainframe and should issue a 163 error in the Micro Focus environment.
The mainframe does a significant amount of editing to help ensure numeric integrity but also offers a certain amount of flexibility in providing functionality for arithmetic calculations and printing or displaying numeric information for human readability. Numeric editing (or punctuation) such as suppressing leading zeroes with spaces and inserting commas and decimal points provide ease of use for human reading but can present a challenge for arithmetic calculations. The mainframe and COBOL offer various numeric field types to provide the best of both worlds. Replicating this on a Windows or UNIX platform can be a challenge. Micro Focus provides this level of flexibility through the use of compiler directives.
In the wonderful world of programming there are many ways to solve a problem. This suite of programs is provided as a COBOL example of one of the possible solutions to the problem of avoiding S0C7 program checks (IBM Mainframe) or 163 errors (Micro Focus) and determining the actual content and length of a numeric field.
This example illustrates the following functions.
| 1. | Mainframe stype truncation of Packed Fields |
| 2. | Zoned Deciaml Fields with Leading Space characters |
| 3. | Moving a numeric field without rounding and adding a numeric field to zero with rounding. |
| 4. | Editing a numeric field for printing or displaying. |
| 5. | Table processing withing initializing the index |
| 6. | Explain why allowing SPACES in a Packed Numeric Field is not a good idea. |
This suite of example programs will run on the following platforms.
| 1. | Executes on an IBM Mainframe running MVS, OS/390 or z/OS. The COBOL programs comply with ANSI/85 and run with COBOL/2, COBOL for MVS and COBOL for OS/390. |
| 2. | Executes on Windows/XP using Micro Focus Mainframe Express (MFE) and a JCL member is provided. |
| 3. | Executes on Windows/XP using Micro Focus Net Express and a CMD file provided. |
| 4. | May be ported to run on the UNIX platforms supported by Micro Focus COBOL. |
The following is a flowchart of the job for executing the programs that show the usage of numeric field types. The NBRBUGJ1 and IEFBR14 members (identified by the blue boxes) are unique to the mainframe and Micro Focus Mainframe Express (MFE). The NBRBUGE1 and SIMOEXEC members (identified by the red boxes) are unique to the Windows platform using Micro Focus Net Express. The COBOL members (identified by the green boxes) are coded to the ANSI/85 standard and run on an IBM Mainframe (with OS/390) or Windows (with Micro Focus COBOL).
|
|
Entry Points | |||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
JCL or CMD with an optional DD or SET statement to write to a log file. | |||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
|
|||||||||||||||||||||||||||||||||||||||||||||||
|
This member is a COBOL Demonstration program that calls the actual Hexadecimal Dump routine. | ||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||
|
The following is a sample of the Dump information that is written to SYSOUT by this sample program.
* NUMBUGC1 Numeric Fields, Spaces and Zeroes v08.03.10 http://www.simotime.com * NUMBUGC1 Copyright 1987-2010 SimoTime Enterprises, LLC All Rights Reserved * NUMBUGC1 is starting... * NUMBUGC1 All this works with z/OS COBOL on the mainframe. * NUMBUGC1 * * NUMBUGC1 The Micro Focus compile directives are as follows: * NUMBUGC1 defaultbyte"00" hostnummove hostarithmetic hostnumcompare nochecknum * NUMBUGC1 signfixup ibmcomp notrunc * NUMBUGC1 * * NUMBUGC1 TEST-001 through TEST-003 will test the truncation of * NUMBUGC1 a PACKED field (WRK-S9X4-COMP-3) with a PIC S9(4) * NUMBUGC1 during various arithemetic processes. Since the field * NUMBUGC1 is specified with four digits it should not overflow * NUMBUGC1 to 10,000 even though the packed field may be able * NUMBUGC1 to hold five digits. * NUMBUGC1 * * NUMBUGC1 TEST-001 is starting, * NUMBUGC1 Numeric Check, Test truncation, * NUMBUGC1 Packed field, add literal to variable * NUMBUGC1 TEST-001 5001 + 5001 = 2, * NUMBUGC1 WRK-S9X4-COMP-3 is numeric, * NUMBUGC1 The length is 3 bytes. * NUMBUGC1 Hex=00002C * NUMBUGC1 WRK-S9X9-COMP-3 is numeric, * NUMBUGC1 The length is 5 bytes. * NUMBUGC1 Hex=000000002C * NUMBUGC1 TEST-001 is finished * NUMBUGC1 * * NUMBUGC1 TEST-002 is starting * NUMBUGC1 PIC S9(4) COMP-3 Numeric Check... * NUMBUGC1 Packed field, add variable to variable * NUMBUGC1 TEST-002 5001 + 5001 = 2, * NUMBUGC1 WRK-S9X4-COMP-3 is numeric, * NUMBUGC1 The length is 3 bytes. * NUMBUGC1 Hex=00002C * NUMBUGC1 WRK-S9X9-COMP-3 is numeric, * NUMBUGC1 The length is 5 bytes. * NUMBUGC1 Hex=000000002C * NUMBUGC1 TEST-002 is finished * NUMBUGC1 * * NUMBUGC1 Packed field, add big literal to smaller variable * NUMBUGC1 TEST-003 5001 + 5001 = 2, * NUMBUGC1 WRK-S9X4-COMP-3 is numeric, * NUMBUGC1 The length is 3 bytes. * NUMBUGC1 Hex=00002C * NUMBUGC1 WRK-S9X9-COMP-3 is numeric, * NUMBUGC1 The length is 5 bytes. * NUMBUGC1 Hex=000000002C * NUMBUGC1 TEST-003 is finished * NUMBUGC1 * * NUMBUGC1 TEST-004 is starting * NUMBUGC1 Do arithmetic on numeric fields with leading spaces * NUMBUGC1 Before COMPUTE, Field 1, Field 2 and Result * NUMBUGC1 Hex=202031 * NUMBUGC1 Hex=202032 * NUMBUGC1 Hex=202030 * NUMBUGC1 After COMPUTE, Field 1 + Field 2 = Result * NUMBUGC1 TEST-004 RESULT is numeric * NUMBUGC1 Hex=202031 * NUMBUGC1 Hex=202032 * NUMBUGC1 Hex=303033 * NUMBUGC1 NUMBUGC1 TEST-004 is finished * NUMBUGC1 * * NUMBUGC1 TEST-005 is starting * NUMBUGC1 MOVE nnnnnnnn.nn to nnnnn, rounding is lost * NUMBUGC1 Move 1234.56 to 5-byte field with zero decimal * NUMBUGC1 Edt= 1,234.56 * NUMBUGC1 Hex=30303030313233343536 * NUMBUGC1 Edt= 1,234 * NUMBUGC1 Hex=3031323334 * NUMBUGC1 MOVE-A-NUMBER is finished * NUMBUGC1 ADD nnnnnnnn.nn to Zero giving nnnnn, with rounding * NUMBUGC1 Edt= 1,234.56 * NUMBUGC1 Hex=30303030313233343536 * NUMBUGC1 Edt= 1,235 * NUMBUGC1 Hex=3031323335 * NUMBUGC1 ADD-TO-ZERO is finished * NUMBUGC1 TEST-005 is finished * NUMBUGC1 * * NUMBUGC1 TEST-006 is starting * NUMBUGC1 Zoned Decimal Fields, Zero digits left of decimal. * NUMBUGC1 Show Edited & Hex for Unsigned * NUMBUGC1 Edt= .49 * NUMBUGC1 Hex=3439 * NUMBUGC1 Dec= .51- * NUMBUGC1 Hex=3571 * NUMBUGC1 Show Edited & Hex for Signed (Minus) * NUMBUGC1 The field is 5 digits plus 2 decimal positions * NUMBUGC1 Edt= .51- * NUMBUGC1 Hex=30303030303571 * NUMBUGC1 Show Edited & Hex for Signed Value of 1.23 * NUMBUGC1 The field is 5 digits plus 2 decimal positions * NUMBUGC1 Edt= 1.23 * NUMBUGC1 Hex=30303030313233 * NUMBUGC1 TEST-006 is finished * NUMBUGC1 * * NUMBUGC1 TEST-007 is starting * NUMBUGC1 Leading spaces in a numeric field * NUMBUGC1 The Number 123 with Leading Spaces * NUMBUGC1 Dec= 123 * NUMBUGC1 Hex=2020313233 * NUMBUGC1 Correct to Zeroes as result of an ADD * NUMBUGC1 Dec=00124 * NUMBUGC1 Hex=3030313234 * NUMBUGC1 All spaces in a numeric field * NUMBUGC1 Dec= * NUMBUGC1 Hex=2020202020 * NUMBUGC1 Correct to Zeroes as result of an ADD * NUMBUGC1 Dec=00001 * NUMBUGC1 Hex=3030303031 * NUMBUGC1 TEST-007 is finished * NUMBUGC1 * * NUMBUGC1 TEST-008 is starting * NUMBUGC1 Table index not initialized * NUMBUGC1 The defaultbyte(00) directive makes this work * NUMBUGC1 Indianapolis is the capitol of Indiana * NUMBUGC1 TEST-008 is finished * NUMBUGC1 * * NUMBUGC1 TEST-009 is starting * NUMBUGC1 TEST-009 Spaces in a PACKED Field * NUMBUGC1 PACKED-FIELD is NOT NUMERIC... * NUMBUGC1 !!! Warning * NUMBUGC1 Having SPACES in a packed Field and using the * NUMBUGC1 NOCHECKNUM and SIGN-FIXUP directives will result * NUMBUGC1 in an incorrect result!!! The following is the result * NUMBUGC1 of a packed field of spaces being added to a packed * NUMBUGC1 field containing a value of 123. * NUMBUGC1 Edt= 20,325.00 * NUMBUGC1 Packed Spaces + Packed 123 = Packed Result * NUMBUGC1 Hex=202020 * NUMBUGC1 Hex=00123C * NUMBUGC1 Hex=20325C * NUMBUGC1 * * NUMBUGC1 The Micro Focus compile directives are as follows: * NUMBUGC1 defaultbyte"00" hostnummove hostarithmetic hostnumcompare nochecknum * NUMBUGC1 signfixup ibmcomp notrunc * NUMBUGC1 is finished... * NUMBUGC1 * * NUMBUGC1 Thank you, this technology was produced at SimoTime Enterprises, LLC * NUMBUGC1 Please send all inquires or suggestions to the helpdesk@simotime.com
The following (NUMBUGE1.CMD) is a sample of the Windows CMD needed to run this job.
@echo OFF
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2010 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Processing Numeric Fields
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * *******************************************************************
rem * Step 1, Delete any previously created file...
rem *
set CmdName=numbuge1
call Env1PROD
if "%SYSLOG%" == "" set syslog=c:\SimoLIBR\LOGS\SimoTime.LOG
rem *
call SimoNOTE "*******************************************************%CmdName%"
call SimoNOTE "Starting JobName %CmdName%"
run NUMBUGC1
if not ERRORLEVEL = 0 set JobStatus=0010
if not %JobStatus% == 0000 goto :EojNok
:EojAok
call SimoNOTE "Finished JobName %CmdName%, Job Status is %JobStatus%"
goto :End
:EojNok
call SimoNOTE "ABENDING JobName %CmdName%, Job Status is %JobStatus%"
:End
call SimoNOTE "Conclude SysLog is %SYSLOG%"
if not "%1" == "nopause" pause
The following is the mainframe JCL (NUMBUGJ1.JCL) required to run the mainline program.
//NUMBUGJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1, // COND=(0,LT) //* ******************************************************************* //* 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 - COBOL processing of numeric fields... //* Author - SimoTime Enterprises //* Date - January 01, 1989 //* //* This set of programs illustrate the use of COBOL for editing //* and processing numeric fields. //* //* This set of programs will run on a mainframe under MVS or on a //* Personal Computer with Windows and Micro Focus Mainframe Express. //* //* ******************************************************************* //* Step 1 of 1 This is a single step job. //* //NUMBUGX1 EXEC PGM=NUMBUGC1 //STEPLIB DD DSN=MFI01.SIMOPROD.LOADLIB1,DISP=SHR //SYSOUT DD SYSOUT=* //*
This program (NUMBUGC1.CBL) was written to test and scan a numeric field for numeric values or digits.
*set defaultbyte"00" hostnummove hostarithmetic hostnumcompare
*set nochecknum sign-fixup ibmcomp notrunc settings list();
* The preceding sets must be used for proper execution.
IDENTIFICATION DIVISION.
PROGRAM-ID. NUMBUGC1.
AUTHOR. SimoTime Enterprises.
*****************************************************************
* Source Member: NUMBUGC1.CBL
*****************************************************************
*
* NUMBUGC1 - Mainframe compatibility.
*
* DESCRIPTION
* -----------
* This program will execute without error on the mainframe and
* fail in the Micro Focus environment if the proper directives
* are not used.
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 2005/07/14 Simmons, Created program.
* 2005/07/14 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 '* NUMBUGC1 '.
05 T2 pic X(34) value 'Numeric Fields, Spaces and Zeroes '.
05 T3 pic X(10) value ' v08.03.10'.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* NUMBUGC1 '.
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 '* NUMBUGC1 '.
05 C2 pic X(32) value 'Thank you, this technology was p'.
05 C3 pic X(32) value 'roduced at SimoTime Enterprises,'.
05 C4 pic X(04) value ' LLC'.
01 SIM-THANKS-02.
05 C1 pic X(11) value '* NUMBUGC1 '.
05 C2 pic X(32) value 'Please send all inquires or sugg'.
05 C3 pic X(32) value 'estions to the helpdesk@simotime'.
05 C4 pic X(04) value '.com'.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* NUMBUGC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
01 T-STATEDB1-BUFFER.
05 T-STATEDB1-DATA.
10 filler pic x(33)
value 'California CASacramento '.
10 filler pic x(33)
value 'Indiana INIndianapolis '.
10 filler pic x(33)
value 'Oregon ORPortland '.
10 filler pic x(33)
value 'Washington WAOlympia '.
05 T-STATEDB1-TABLE redefines
T-STATEDB1-DATA
occurs 4 times
ascending key T-STATE-NAME
indexed by IX-1.
10 T-STATE-NAME pic X(15).
10 T-STATE-SHORT pic X(2).
10 T-STATE-CAPITOL pic X(16).
01 S-ARG pic X(15).
01 PACKED-FIELD-123 pic S9(5) COMP-3 value 123.
01 PACKED-FIELD-123-R redefines PACKED-FIELD-123
pic X(5).
01 PACKED-FIELD pic S9(5) COMP-3.
01 PACKED-FIELD-R redefines PACKED-FIELD
pic X(5).
01 PACKED-RESULT pic S9(5) COMP-3.
01 PACKED-RESULT-R redefines PACKED-RESULT
pic X(5).
01 DUMP-GROUP.
05 FILLER pic X(4) value 'Hex='.
05 DUMP-80 pic X(80) value SPACES.
01 DUMP-SIZE pic 9(3) value 0.
01 DUMP-INPUT pic X(80) value SPACES.
01 PT-1 pic 9(3) value 0.
01 PT-2 pic 9(3) value 0.
01 BIN-WORK-02A.
05 BIN-WORK-02B pic 9(3) comp value 0.
01 DIRECTIVES-LIST-1.
05 filler pic X(28) value 'defaultbyte"00" hostnummove '.
05 filler pic X(30) value 'hostarithmetic hostnumcompare '.
05 filler pic X(10) value 'nochecknum'.
01 DIRECTIVES-LIST-2.
05 filler pic X(25) value 'signfixup ibmcomp notrunc'.
COPY NUMBUGB1.
COPY HEXDECB1.
COPY HEXDSPB1.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
move 'is starting...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'All this works with z/OS COBOL on the mainframe.'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform POST-DIRECTIVES-SETTINGS
perform MESSAGE-TEST-001-003
perform TEST-001
perform TEST-002
perform TEST-003
* Test COMPUTE statement for numerics with leading spaces...
perform TEST-004
* Test different type numerics with decimal positions...
perform TEST-005
* Test numerics with decimal positions...
perform TEST-006
* Test for numerics with leading or all spaces...
perform TEST-007
perform TEST-008
perform TEST-009
perform POST-DIRECTIVES-SETTINGS
move 'is finished...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move '*' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform Z-THANK-YOU
GOBACK.
*****************************************************************
MESSAGE-TEST-001-003.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-001 through TEST-003 will test the truncation of'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'a PACKED field (WRK-S9X4-COMP-3) with a PIC S9(4)'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'during various arithemetic processes. Since the field'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'is specified with four digits it should not overflow'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'to 10,000 even though the packed field may be able'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'to hold five digits.'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
POST-DIRECTIVES-SETTINGS.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'The Micro Focus compile directives are as follows:'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DIRECTIVES-LIST-1 to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move DIRECTIVES-LIST-2 to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
TEST-001.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-001 is starting,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Numeric Check, Test truncation,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Packed field, add literal to variable'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-001 5001 + 5001 = 2,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ZERO to WRK-S9X4-COMP-3
add 5001 to WRK-S9X4-COMP-3
add 5001 to WRK-S9X4-COMP-3
* At this point the PACKED field (WRK-S9X4-COMP-3) with a
* PIC S9(4) should contain +0002 and not +10002.
* Even though the capabilites of the physical field could
* contain 5 digits it should conform to the picture
* clause values.
if WRK-S9X4-COMP-3 is NUMERIC
move SPACES to DUMP-INPUT
* Process the Packed Field of three bytes
move 'WRK-S9X4-COMP-3 is numeric,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The length is 3 bytes.' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 3 to ZERO giving DUMP-SIZE
move WRK-S9X4-COMP-3G to DUMP-INPUT
perform Z-DUMP-WORK-80
* Process the Packed Field of five bytes
add WRK-S9X4-COMP-3 to ZERO giving WRK-S9X9-COMP-3
move 'WRK-S9X9-COMP-3 is numeric,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The length is 5 bytes.' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 5 to ZERO giving DUMP-SIZE
move WRK-S9X9-COMP-3G to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'TEST-001 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'Warning ! TEST-001 NOT numeric' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Warning ! TEST-001 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
TEST-002.
* The following should get the same results as TEST-001
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-002 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'PIC S9(4) COMP-3 Numeric Check...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Packed field, add variable to variable'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-002 5001 + 5001 = 2,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ZERO to WRK-S9X4-COMP-3
move ZERO to WRK-S9X9-COMP-3
add PIC-S9X4-COMP-3 to WRK-S9X4-COMP-3
add PIC-S9X4-COMP-3 to WRK-S9X4-COMP-3
if WRK-S9X4-COMP-3 is NUMERIC
move SPACES to DUMP-INPUT
* Process the Packed Field of three bytes
move 'WRK-S9X4-COMP-3 is numeric,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The length is 3 bytes.' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 3 to ZERO giving DUMP-SIZE
move WRK-S9X4-COMP-3G to DUMP-INPUT
perform Z-DUMP-WORK-80
* Process the Packed Field of five bytes
add WRK-S9X4-COMP-3 to ZERO giving WRK-S9X9-COMP-3
move 'WRK-S9X9-COMP-3 is numeric,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The length is 5 bytes.' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 5 to ZERO giving DUMP-SIZE
move WRK-S9X9-COMP-3G to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'TEST-002 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'Warning ! TEST-002 NOT numeric' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Warning ! TEST-002 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
TEST-003.
* The following should get the same results as TEST-001
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-003 is starting' to MESSAGE-TEXT
move 'Packed field, add big literal to smaller variable'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-003 5001 + 5001 = 2,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ZERO to WRK-S9X4-COMP-3
move ZERO to WRK-S9X9-COMP-3
add PIC-S9X9-COMP-3 to WRK-S9X4-COMP-3
add PIC-S9X9-COMP-3 to WRK-S9X4-COMP-3
if WRK-S9X4-COMP-3 is NUMERIC
move SPACES to DUMP-INPUT
* Process the Packed Field of three bytes
move 'WRK-S9X4-COMP-3 is numeric,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The length is 3 bytes.' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 3 to ZERO giving DUMP-SIZE
move WRK-S9X4-COMP-3G to DUMP-INPUT
perform Z-DUMP-WORK-80
* Process the Packed Field of five bytes
add WRK-S9X4-COMP-3 to ZERO giving WRK-S9X9-COMP-3
move 'WRK-S9X9-COMP-3 is numeric,' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The length is 5 bytes.' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 5 to ZERO giving DUMP-SIZE
move WRK-S9X9-COMP-3G to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'TEST-003 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'Warning ! TEST-003 NOT numeric' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Warning ! TEST-003 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
TEST-004.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-004 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Do arithmetic on numeric fields with leading spaces'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ' 2' to PIC-9-3-3RD-A
add PIC-9-3-1ST-N to PIC-9-3-2ND-N giving PIC-9-3-3RD-N
move ' 1' to PIC-9-3-1ST-A
move ' 2' to PIC-9-3-2ND-A
move ' 0' to PIC-9-3-3RD-A
move 'Before COMPUTE, Field 1, Field 2 and Result'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 3 to ZERO giving DUMP-SIZE
move PIC-9-3-1ST-A to DUMP-INPUT
perform Z-DUMP-WORK-80
move PIC-9-3-2ND-A to DUMP-INPUT
perform Z-DUMP-WORK-80
move PIC-9-3-3RD-A to DUMP-INPUT
perform Z-DUMP-WORK-80
add PIC-9-3-1ST-N to PIC-9-3-2ND-N giving PIC-9-3-3RD-N
compute PIC-9-3-3RD-N = PIC-9-3-1ST-N + PIC-9-3-2ND-N
move 'After COMPUTE, Field 1 + Field 2 = Result'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if PIC-9-3-3RD-N is NUMERIC
move 'TEST-004 RESULT is numeric' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PIC-9-3-1ST-A to DUMP-INPUT
perform Z-DUMP-WORK-80
move PIC-9-3-2ND-A to DUMP-INPUT
perform Z-DUMP-WORK-80
move PIC-9-3-3RD-A to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'NUMBUGC1 TEST-004 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'Warning ! TEST-004 Result is NOT numeric'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Warning ! TEST-004 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
TEST-005.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-005 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'MOVE nnnnnnnn.nn to nnnnn, rounding is lost'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PIC-S-8-2-1ST to PIC-5-0-1ST
if PIC-5-0-1ST is NUMERIC
move 'Move 1234.56 to 5-byte field with zero decimal'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add PIC-S-8-2-1ST to ZERO giving PIC-Z-9-2
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 10 to ZERO giving DUMP-SIZE
move PIC-S-8-2-ALPHA(1:10) to DUMP-INPUT
perform Z-DUMP-WORK-80
add PIC-5-0-1ST to ZERO giving PIC-Z-5
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-5 to MESSAGE-TEXT(5:7)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 5 to ZERO giving DUMP-SIZE
move PIC-5-0-ALPHA(1:5) to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'MOVE-A-NUMBER is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'Warning ! TEST-005 NOT numeric' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Warning ! TEST-005 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'ADD nnnnnnnn.nn to Zero giving nnnnn, with rounding'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add PIC-S-8-2-2ND to ZERO giving PIC-5-0-2ND ROUNDED
if PIC-5-0-2ND is NUMERIC
add PIC-S-8-2-2ND to ZERO giving PIC-Z-9-2
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 10 to ZERO giving DUMP-SIZE
move PIC-S-8-2-ALPHA(11:10) to DUMP-INPUT
perform Z-DUMP-WORK-80
add PIC-5-0-2ND to ZERO giving PIC-Z-5
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-5 to MESSAGE-TEXT(5:7)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 5 to ZERO giving DUMP-SIZE
move PIC-5-0-ALPHA(6:5) to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'ADD-TO-ZERO is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-005 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'Warning ! TEST-005 NOT numeric' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Warning ! TEST-005 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move SPACES to PIC-S-8-2-ALPHA
move PIC-5-0-1ST to PIC-S-8-2-1ST
add PIC-5-0-2ND to ZERO giving PIC-S-8-2-2ND
exit.
*****************************************************************
TEST-006.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-006 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Zoned Decimal Fields, Zero digits left of decimal.'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add .49 to ZERO giving DECIMAL-2-U
subtract .51 from ZERO giving DECIMAL-2-S
*
move 'Show Edited & Hex for Unsigned'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add DECIMAL-2-U to ZERO giving PIC-Z-9-2
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
move DECIMAL-2-U-G to DUMP-INPUT
add 2 to ZERO giving DUMP-SIZE
perform Z-DUMP-WORK-80
add DECIMAL-2-S to ZERO giving PIC-Z-9-2
move 'Dec=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 2 to ZERO giving DUMP-SIZE
move DECIMAL-2-S-G to DUMP-INPUT
perform Z-DUMP-WORK-80
*
move 'Show Edited & Hex for Signed (Minus)'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The field is 5 digits plus 2 decimal positions'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add DECIMAL-2-S to ZERO giving DECIMAL-WORK-5-2
add DECIMAL-WORK-5-2 to ZERO giving PIC-Z-9-2
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 7 to ZERO giving DUMP-SIZE
move DECIMAL-WORK-5-2-G to DUMP-INPUT
perform Z-DUMP-WORK-80
*
move 'Show Edited & Hex for Signed Value of 1.23'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The field is 5 digits plus 2 decimal positions'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 1.23 to ZERO giving DECIMAL-WORK-5-2
add DECIMAL-WORK-5-2 to ZERO giving PIC-Z-9-2
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 7 to ZERO giving DUMP-SIZE
move DECIMAL-WORK-5-2-G to DUMP-INPUT
perform Z-DUMP-WORK-80
*
move 'TEST-006 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
TEST-007.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-007 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Leading spaces in a numeric field' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
* The following move will create a right-justified number with
* leading spaces. To do this the field must be referenced by
* its group or redefined definition as a text field.
move ' 123' to SPACE-IN-NUMBER-X
move 'The Number 123 with Leading Spaces ' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Dec=' to MESSAGE-TEXT
move SPACE-IN-NUMBER-X to MESSAGE-TEXT(5:5)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 5 to ZERO giving DUMP-SIZE
move SPACE-IN-NUMBER-X to DUMP-INPUT
perform Z-DUMP-WORK-80
* The following ADD will result in a number with leading
* zeroes instead of leading spaces.
add 1 to SPACE-IN-NUMBER
move 'Correct to Zeroes as result of an ADD' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Dec=' to MESSAGE-TEXT
move SPACE-IN-NUMBER-X to MESSAGE-TEXT(5:5)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 5 to ZERO giving DUMP-SIZE
move SPACE-IN-NUMBER-X to DUMP-INPUT
perform Z-DUMP-WORK-80
* The following move will create a numeric field containing
* all spaces. To do this the field must be referenced by its
* group or redefined definition as a text field.
move SPACES to SPACE-IN-NUMBER-X
move 'All spaces in a numeric field' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Dec=' to MESSAGE-TEXT
move SPACE-IN-NUMBER-X to MESSAGE-TEXT(5:5)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 5 to ZERO giving DUMP-SIZE
move SPACE-IN-NUMBER-X to DUMP-INPUT
perform Z-DUMP-WORK-80
* The following ADD will result in a number with leading
* zeroes instead of leading spaces.
add 1 to SPACE-IN-NUMBER
move 'Correct to Zeroes as result of an ADD' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Dec=' to MESSAGE-TEXT
move SPACE-IN-NUMBER-X to MESSAGE-TEXT(5:5)
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 5 to ZERO giving DUMP-SIZE
move SPACE-IN-NUMBER-X to DUMP-INPUT
perform Z-DUMP-WORK-80
move 'TEST-007 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
TEST-008.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-008 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Table index not initialized' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'The defaultbyte(00) directive makes this work'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Indiana ' to S-ARG
search T-STATEDB1-TABLE
at end
move 'Invalid state requested' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-008 is ABENDING' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
when T-STATE-NAME(IX-1) = S-ARG
move T-STATE-CAPITOL(IX-1) to MESSAGE-TEXT(1:16)
move ' is the capitol of ' to MESSAGE-TEXT(17:19)
move S-ARG to MESSAGE-TEXT(36:15)
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-008 is finished' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
continue
end-search.
exit.
*****************************************************************
TEST-009.
perform Z-DISPLAY-SINGLE-ASTERISK
move 'TEST-009 is starting' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'TEST-009 Spaces in a PACKED Field' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
* The following move will create a numeric field containing
* all spaces. To do this the field must be referenced by its
* group or redefined definition as a text field.
move SPACES to PACKED-FIELD-R
if PACKED-FIELD is NUMERIC
move 'PACKED-FIELD is NUMERIC...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
else
move 'PACKED-FIELD is NOT NUMERIC...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
perform TEST-009-BAD
end-if
exit.
*---------------------------------------------------------------*
TEST-009-BAD.
move '!!! Warning' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'Having SPACES in a packed Field and using the'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'NOCHECKNUM and SIGN-FIXUP directives will result'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'in an incorrect result!!! The following is the result'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'of a packed field of spaces being added to a packed'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move 'field containing a value of 123.'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add PACKED-FIELD to PACKED-FIELD-123 giving PACKED-RESULT
add PACKED-RESULT to ZERO giving PIC-Z-9-2
move 'Edt=' to MESSAGE-TEXT
move PIC-Z-9-2 to MESSAGE-TEXT(5:13)
perform Z-DISPLAY-MESSAGE-TEXT
move 'Packed Spaces + Packed 123 = Packed Result'
to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move SPACES to DUMP-INPUT
add 3 to ZERO giving DUMP-SIZE
move PACKED-FIELD-R to DUMP-INPUT
perform Z-DUMP-WORK-80
move PACKED-FIELD-123-R to DUMP-INPUT
perform Z-DUMP-WORK-80
move PACKED-RESULT-R to DUMP-INPUT
perform Z-DUMP-WORK-80
exit.
*****************************************************************
Z-DUMP-WORK-80.
add 1 to ZERO giving PT-1
add 1 to ZERO giving PT-2
move SPACES to DUMP-80
perform until PT-1 > DUMP-SIZE
move LOW-VALUE to BIN-WORK-02A(1:1)
move DUMP-INPUT(PT-1:1) to BIN-WORK-02A(2:1)
compute BIN-WORK-02B = (BIN-WORK-02B * 2) + 1
move HEX-DISPLAY-GROUP(BIN-WORK-02B:2)
to DUMP-80(PT-2:2)
add 1 to PT-1
add 2 to PT-2
end-perform
move DUMP-GROUP to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
Z-DISPLAY-SINGLE-ASTERISK.
move '*' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
* Display CONSOLE messages... *
*****************************************************************
Z-DISPLAY-MESSAGE-TEXT.
if MESSAGE-TEXT-2 = SPACES
display MESSAGE-BUFFER(1:79)
else
display MESSAGE-BUFFER
end-if
move all SPACES to MESSAGE-TEXT
exit.
*****************************************************************
Z-POST-COPYRIGHT.
move SIM-TITLE to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
move SIM-COPYRIGHT to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
exit.
*****************************************************************
Z-THANK-YOU.
move SIM-THANKS-01 to MESSAGE-BUFFER
perform Z-DISPLAY-MESSAGE-TEXT
move SIM-THANKS-02 to MESSAGE-BUFFER
perform Z-DISPLAY-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 COBOL Compiler Directives (NUMBUGC1.DIR) file is used to compile the program to be executed in a mainframe dislect with ASCII encoding and options to allow leading spaces in Zoned-Decimal, Numeric Fields. The following is a listing of the directives file.
DIALECT"ENTCOBOL" CHARSET"ASCII" ASSIGN"EXTERNAL" IBMCOMP NOTRUNC HOST-NUMMOVE HOST-NUMCOMPARE SIGN-FIXUP HOST-ARITHMETIC NOCHECKNUM defaultbyte"00" ANIM NOOPTIONAL-FILE outdd"SYSOUT 120 R" SHARE-OUTDD DATAMAP settings list() noform
The purpose of this document is to assist as a tutorial for new programmers or as a quick reference for experienced programmers. These sample programs are made available on an "as-is" basis and may be downloaded, copied and modified for specific situations as long as the copyright information is not removed or changed. As always, it is the programmer's responsibility to thoroughly test all programs.
Permission to use, copy, modify and distribute this software for any commercial purpose requires a fee to be paid to SimoTime Enterprises. Once the fee is received by SimoTime the latest version of the software will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
Permission to use, copy, modify and distribute this software for a non-commercial purpose and without fee is hereby granted, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
SimoTime Enterprises makes no warranty or representations about the suitability of the software for any purpose. It is provided "AS IS" without any express or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
You may download this example at http://www.simotime.com/sim4dzip.htm#zPacknumbug01 as a Z-Pack. The Z-Packs provide individual programming examples, documentation and test data files in a single package. The Z-Packs are usually in zip format to reduce the amount of time to download. Please view the complete list of SimoTime Z-Pack Examples at http://www.simotime.com/sim4dzip.htm.
Note: You must be attached to the Internet to download a Z-Pack or view the list.
Check out The COBOL Connection for more examples of mainframe COBOL coding techniques and sample code.
The following chart provides a list of the sample COBOL programs that focus on processing numeric fields.
| HTML Tag | Description |
| cblnum01 | This is an example of how COBOL can test that a data field contains a valid numeric value. It also illustrates how to redefine a numeric field and then scan the field from left to right testing for a digit in each position. |
| cblraz01 | This suite of programs provides an example of a routine that will Right Adjust (or Right Justify) a text string within a numeric field and fill the left-most or high-order bytes with zeroes. |
| cbltxn01 | This suite of programs provides an example of how a COBOL program calls a COBOL routine to create a 150-character, English-oriented text data string from a 12-digit numeric field. For example, if the numeric field contains 000000001234 then a text string is created with the following information, One-Thousand-Two-Hundred-Thirty-Four |
| nbrtyp01 | This suite of example programs will describe the use, format and size of some of the commonly used numeric fields of the COBOL programming language. This example also illustrates how to redefine a numeric field and how to display the actual hexadecimal content of a numeric field. |
| number01 | This document is an introduction to the various numeric formats used by COBOL and the IBM mainframe systems The session will describe three of the popular numeric formats used with COBOL and IBM Mainframe systems. The discussions include further detail about the issues and concerns of unsigned (or implied positive) numbers, signed (positive or negative) numbers and decimal or whole numbers. A sample of how to convert non-print formats to display or print formats is included along with a sample COBOL program. |
| numbug01 | The challenge with this program is that it is expected to process the various numeric items in the same manner as the mainframe. For example, a zoned-decimal field that contains leading spaces should not cause an ABEND (i.e. 163 error on Micro Focus) but should treat the leading spaces as zeroes and complete the arithmetic calculation. However, a packed-decimal field that contains non-numeric values would issue a S0C7 (referred to as a sock-seven) on the mainframe and should issue a 163 error in the Micro Focus environment. |
| numprt01 | Printing numeric fields, especially packed-decimal or binary (i.e. COMP-3 or COMP) requires special consideration. Also, signed, zoned-decimal fields will require special consideration. Most numeric fields will require some sort of editing before printing. This suite of programs provides examples of how a COBOL program may be used to properly print (or display) numeric fields. |
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 |
| http://www.simotime.com |