COBOL Numbers
  Commonly Used Numeric Formats
http://www.simotime.com
When technology complements business    Copyright © 1987-2010  SimoTime Enterprises  All Rights Reserved
  Table of Contents Version 10.03.20 
  Introduction
 
  Programming Objectives
  Programming Requirements
  Programming Overview
  Programming Output
  Quick Review of Bits, Bytes, Nibbles and Sizes
 
  Common Numeric Formats
  Numeric Field Sizes - Digits, Packed and Binary
  EBCDIC and ASCII
  Hexadecimal Dump Format
  Data Conversion, Considerations and Limitations
  CMD for Hex Dump Execution with Net Express
  JCL for Hex Dump Execution with OS/390 or Mainframe Express
  The COBOL Demonstration Program
  Summary
 
  Software Agreement and Disclaimer
  Downloads and Links to Similar Pages
  Comments or Suggestions
  About SimoTime

Introduction
(Next) (Previous) (Table-of-Contents)

This suite of example programs will describe the 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.

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 determining the actual content and length of a numeric field.

Programming Objectives
(Next) (Previous) (Table-of-Contents)

This example illustrates the following functions.

1. Describe the commonly used Numeric field formats available in COBOL.
2. Describe the internal structure of the Numeric fields.
3. Provide a quick overview of the EBCDIC and ASCII environments.
4. Describe the difference in specified number of digits and actual field size.
5. Show how to dump the actual hexadecimal value of a numeric field.
6. Provide an example of mainframe JCL to run the job on Windows using Micro Focus Mainframe Express (MFE) .
7. Provide an example of a Window's CMD file to run the job on Windows using Micro Focus Net Express.
8. Maintain a single set of COBOL source code that will run on OS/390, Widows and UNIX.

Programming Requirements
(Next) (Previous) (Table-of-Contents)

This suite of example programs will run on the following platforms.

1. Executes on an IBM Mainframe running MVS or OS/390. The COBOL programs comply with ANSI/85 and run with COBOL/2, COBOL for MVS and COBOL for OS/390.
2. Executes on Windows/2000, Windows/NT and Windows/XP using Micro Focus Mainframe Express (MFE).
3. Executes on Windows/2000, Windows/NT and Windows/XP using Micro Focus Net Express and the CMD file provided.
4. May be ported to run on the UNIX platforms supported by Micro Focus COBOL.

Programming Overview
(Next) (Previous) (Table-of-Contents)

The following is a flowchart of the job for executing the programs that show the usage of numeric field types. The NBRTYPJ1 and IEFBR14 members (identified by the blue boxes) are unique to the mainframe and Micro Focus Mainframe Express (MFE). The NBRTYPE1 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 Point
OS390 or MFE
     
Entry Point
Net Express
  Entry Points
 
     
 
   
NBRTYPJ1
jcl
     
NBRTYPE1
cmd
  JCL or CMD with an optional DD or SET statement to write to a log file.
 
     
 
   
IEFBR14
utl
     
SIMOEXEC
cobol
   
     
     
     
     
     
     
     
     
     
     
     
     
     
     
     
   
   
NBRTYPC1
cobol
      This member is a COBOL Demonstration program that calls the actual Hexadecimal Dump routine.
   
 
       
   
SIMODUMP
cobol
 
Console
  The SIMODUMP member is a COBOL Hexadecimal Dump routine that displays the dump information on the screen. The dump information is only displayed if the SIMODUMP-SYSOUT field contains SHOW or BOTH.
   
 
       
   
SIMOLOGS
cobol
 
SYSLOG
  The SIMOLOGS member is a COBOL Write-to-Log routine that writes the dump information to a log file. This routine is only called if the SIMODUMP-REQUEST field contains FILE or BOTH.
             

Programming Output
(Next) (Previous) (Table-of-Contents)

The following is a sample of the Dump information produced on an IBM Mainframe or Micro Focus Mainframe Express on the PC.

Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........&l;t;/
FONT>
 1-016 F0F0F1F2 F3xxxxxx xxxxxxxx xxxxxxxx 00123........... ................
     

The following is a sample of the Dump information produced on a PC with Micro Focus COBOL and Net Express, version 4.0.

Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........&l;t;/
FONT>
 1-016 30303132 33xxxxxx xxxxxxxx xxxxxxxx ................ 00123...........
     

For more information about the Hex-Dump format refer to the Hexadecimal Dump Format section of this document.

The following is a sample of the field sizes produced on an IBM mainframe or PC with Micro Focus Mainframe Express.

Dump0009 ********************************************************************
Dump0009 001-001-002 (Digits-Packed-Binary) NBR-01 Field Sizes for PIC 9
Dump0009 002-002-002 (Digits-Packed-Binary) NBR-02 Field Sizes for PIC 99
Dump0009 ... and more ...

The following is an example of the field sizes produced on the PC, Windows platform using Net Express.

2003/12/15 09:36:25:23 * Dump0009 ********************************************************************
2003/12/15 09:36:25:24 * Dump0009 001-001-001 (Digits-Packed-Binary) NBR-01 Field Sizes for PIC 9
2003/12/15 09:36:25:24 * Dump0009 002-002-001 (Digits-Packed-Binary) NBR-02 Field Sizes for PIC 99
2003/12/15 09:36:25:25 * Dump0009 ... and more ...

For more information about the field-size formats refer to the Numeric Field Sizes - Digits, Packed and Binary section of this document.

Quick Review of Bits, Bytes, Nibbles and Sizes
(Next) (Previous) (Table-of-Contents)

A bit is the smallest unit of information processed by a computer. A bit may be switched OFF (a ZERO value) or ON (a ONE value). When eight bits are grouped together it is called a byte. A byte may be used to represent letters of the alphabet, numbers and other special characters. For example, the bit arrangement within a byte for the letter "A" would be 11000001. The bit arrangement for the text string "AB12" would be 11000001110000101111000111110010. This is difficult for people to read. To make this a bit easier (sorry, no pun intended) to read the bits are usually arranged in groups of four bits (sometimes called nibbles) separated by a space or comma. For example, the bit arrangement (or binary notation) for "AB12" would be 1100,0001,1100,0010,1111,0001,1111,0010. Binary notation is still not that easy to understand and hexadecimal code became very popular. Since a nibble (four-bits) can only represent 16 different values a single number or letter is used to represent each hexadecimal value (bit arrangement within a nibble).

Binary Value Hexadecimal Value Decimal Value
0000 0 0
0001 1 1
0010 2 2
0011 3 3
0100 4 4
0101 5 5
0110 6 6
0111 7 7
1000 8 8
1001 9 9
1010 A 10
1011 B 11
1100 C 12
1101 D 13
1110 E 14
1111 F 15

Using the preceding table we can now represent the Binary value of 11000001110000101111000111110010 as C1C2F1F2. The following table may be easier to read.

1100 0001
C   1
1100 0010
C   2
1111 0001
F   1
1111 0010
F   2
A B 1 2

Note: A table of the full 256 character set including Binary, Hexadecimal, Decimal and the EBCDIC and ASCII displayable characters is available in the SimoTime Library.  

Common Numeric Formats
(Next) (Previous) (Table-of-Contents)

The three most common mainframe numeric encoding formats are Zoned-Decimal, Packed-Decimal and Binary. The following shows how the numeric fields would be defined in a COBOL WORKING-STORAGE SECTION.

Numeric Field Type Coding Syntax Normally Coded (Minimum)
Binary
(alternate coding technique)
USAGE IS COMPUTATIONAL
USAGE IS BINARY
COMP
BINARY
Packed Decimal USAGE IS COMPUTATIONAL-3 COMP-3
Zoned Decimal USAGE IS DISPLAY Left blank, this is the default

The following is an example of actual COBOL source code.

      *    The following two lines show the syntax for a binary field,
      *    1st line is full syntax, 2nd line is normally coded syntax.
       01  NUMERIC-BINARY-FULL  PIC S9(5)V99 USAGE IS COMPUTATIONAL.
       01  NUMERIC-BINARY-NORM  PIC S9(5)V99 COMP.
      *    The following two lines show the syntax for a packed field,
      *    1st line is full syntax, 2nd line is normally coded syntax.
       01  NUMERIC-PACKED-FULL  PIC S9(5)V99 USAGE IS COMPUTATIONAL-3.
       01  NUMERIC-PACKED-NORM  PIC S9(5)V99 COMP-3.
      *    The following two lines show the syntax for a zoned field,
      *    1st line is full syntax, 2nd line is normally coded syntax.
       01  NUMERIC-ZONED-FULL   PIC S9(5)V99 USAGE IS DISPLAY.
       01  NUMERIC-ZONED-NORM   PIC S9(5)V99.

Numeric Field Sizes - Digits, Packed and Binary
(Next) (Previous) (Table-of-Contents)

The following is an example of a mainframe, EBCDIC environment.

* Dump0009 ********************************************************************
* Dump0009 001-001-002 (Display-Packed-Binary) NBR-01 Field Sizes for PIC 9
* Dump0009 002-002-002 (Display-Packed-Binary) NBR-02 Field Sizes for PIC 99
* Dump0009 003-002-002 (Display-Packed-Binary) NBR-03 Field Sizes for PIC 999
* Dump0009 004-003-002 (Display-Packed-Binary) NBR-04 Field Sizes for PIC 9(4)
* Dump0009 005-003-004 (Display-Packed-Binary) NBR-05 Field Sizes for PIC 9(5)
* Dump0009 006-004-004 (Display-Packed-Binary) NBR-06 Field Sizes for PIC 9(6)
* Dump0009 007-004-004 (Display-Packed-Binary) NBR-07 Field Sizes for PIC 9(7)
* Dump0009 008-005-004 (Display-Packed-Binary) NBR-08 Field Sizes for PIC 9(8)
* Dump0009 009-005-004 (Display-Packed-Binary) NBR-09 Field Sizes for PIC 9(9)
* Dump0009 010-006-008 (Display-Packed-Binary) NBR-10 Field Sizes for PIC 9(10)
* Dump0009 011-006-008 (Display-Packed-Binary) NBR-11 Field Sizes for PIC 9(11)
* Dump0009 012-007-008 (Display-Packed-Binary) NBR-12 Field Sizes for PIC 9(12)
* Dump0009 013-007-008 (Display-Packed-Binary) NBR-13 Field Sizes for PIC 9(13)
* Dump0009 014-008-008 (Display-Packed-Binary) NBR-14 Field Sizes for PIC 9(14)
* Dump0009 015-008-008 (Display-Packed-Binary) NBR-15 Field Sizes for PIC 9(15)
* Dump0009 016-009-008 (Display-Packed-Binary) NBR-16 Field Sizes for PIC 9(16)
* Dump0009 017-009-008 (Display-Packed-Binary) NBR-17 Field Sizes for PIC 9(17)
* Dump0009 018-010-008 (Display-Packed-Binary) NBR-18 Field Sizes for PIC 9(18)
* Dump0009 ********************************************************************

In the preceding example (Dump0009) notice the lengths for the BINARY fields, They are 2, 4 or 8 bytes. This is the format for the IBM Mainframe and Micro Focus Mainframe Express. In the following example for the PC, Windows environment the lengths for the BINARY fields are sized based on the value of the number it needs to contain. Micro Focus COBOL has compiler directives (IBMCOMP and NOTRUNC) that provide for mainframe compatibility.

The following is an example of a PC, Windows, ASCII environment.

* Dump0009 ********************************************************************
* Dump0009 001-001-001 (Display-Packed-Binary) NBR-01 Field Sizes for PIC 9
* Dump0009 002-002-001 (Display-Packed-Binary) NBR-02 Field Sizes for PIC 99
* Dump0009 003-002-002 (Display-Packed-Binary) NBR-03 Field Sizes for PIC 999
* Dump0009 004-003-002 (Display-Packed-Binary) NBR-04 Field Sizes for PIC 9(4)
* Dump0009 005-003-003 (Display-Packed-Binary) NBR-05 Field Sizes for PIC 9(5)
* Dump0009 006-004-003 (Display-Packed-Binary) NBR-06 Field Sizes for PIC 9(6)
* Dump0009 007-004-003 (Display-Packed-Binary) NBR-07 Field Sizes for PIC 9(7)
* Dump0009 008-005-004 (Display-Packed-Binary) NBR-08 Field Sizes for PIC 9(8)
* Dump0009 009-005-004 (Display-Packed-Binary) NBR-09 Field Sizes for PIC 9(9)
* Dump0009 010-006-005 (Display-Packed-Binary) NBR-10 Field Sizes for PIC 9(10)
* Dump0009 011-006-005 (Display-Packed-Binary) NBR-11 Field Sizes for PIC 9(11)
* Dump0009 012-007-005 (Display-Packed-Binary) NBR-12 Field Sizes for PIC 9(12)
* Dump0009 013-007-006 (Display-Packed-Binary) NBR-13 Field Sizes for PIC 9(13)
* Dump0009 014-008-006 (Display-Packed-Binary) NBR-14 Field Sizes for PIC 9(14)
* Dump0009 015-008-007 (Display-Packed-Binary) NBR-15 Field Sizes for PIC 9(15)
* Dump0009 016-009-007 (Display-Packed-Binary) NBR-16 Field Sizes for PIC 9(16)
* Dump0009 017-009-008 (Display-Packed-Binary) NBR-17 Field Sizes for PIC 9(17)
* Dump0009 018-010-008 (Display-Packed-Binary) NBR-18 Field Sizes for PIC 9(18)
* Dump0009 ********************************************************************

EBCDIC and ASCII
(Next) (Previous) (Table-of-Contents)

The following shows the picture (PIC) clause, how the item is displayed using the DISPLAY verb, the field as it is stored in memory for an EBCDIC environment, the field as it would be stored in memory for an ASCII environment

Picture Clause DISPLAY Memory Content (EBCDIC) Memory Content (ASCII)
PIC 9(5) 00123 F0F0F1F2F3 3030313233
PIC S9(5) plus 00123 F0F0F1F2C3 3303013233
PIC S9(5) minus 00123- F0F0F1F2D3 3030313273
PIC S9(5) COMP-3 plus 00123 00123C 00123C
PIC S9(5) COMP-3 minus 00123- 00123D 00123D
PIC S9(5) COMP plus 00123 0000007B 00007B
PIC S9(5) COMP minus 00123- FFFFFF85 FFFF85

In addition to the ASCII and EBCDIC differences it is important to note the hardware differences. Most COBOL compilers hide this level of processing. However, it occasionally shows up as a problem.

Big Endian - within a multi-byte numeric representation the most significant byte has the lowest address. Processors such as the IBM 370 family, the PDP-10, the Motorola microprocessor family, and most of the various RISC architectures are big-endian.

Little Endian - within a sixteen or thirty-two bit word the bytes at lower addresses have lower significance. Processors such as the PDP-11 and VAX family of computers, the Intel microprocessors, and much of the communications and networking hardware are little-endian.

Hexadecimal Dump Format
(Next) (Previous) (Table-of-Contents)

The following is an example of the Dump information produced on an IBM Mainframe or Micro Focus Mainframe Express on the PC that works with EBCDIC. The hexadecimal information is (highlighted in green) The possible translated, displayable EBCDIC characters are (highlighted in blue). The possible translated, displayable ASCII characters are.(highlighted in red).

* Dump0001 *
* Dump0001 ********************************************************************
* Dump0001 Dump UNSIGNED-123 PIC 9(5)
* Dump0001 Starting... Length = 0005
*  Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........
*   1-016 F0F0F1F2 F3xxxxxx xxxxxxxx xxxxxxxx 00123........... ................
* Dump0001 Complete... Length = 0005

If the sample program is executed in the PC, ASCII environment the following would be displayed and written to the log file.

* Dump0001 *
* Dump0001 ********************************************************************
* Dump0001 Dump UNSIGNED-123 PIC 9(5)
* Dump0001 Starting... Length = 0005
*  Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........
*   1-016 30303132 33xxxxxx xxxxxxxx xxxxxxxx ................ 00123...........
* Dump0001 Complete... Length = 0005

The preceding dump information (Dump0001) is for a simple, unsigned numeric field that is defined with a PICTURE 9(5) VALUE 123. In the next example (Dump0002) we will take a look at a simple, signed numeric field that is defined with a PICTURE S9(5) VALUE 123. The first part of the following is for the mainframe, EBCDIC environment.

* Dump0002 *
* Dump0002 ********************************************************************
* Dump0002 PLUS-123 PIC S9(5)
* Dump0002 Starting... Length = 0005
*  Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........
*   1-016 F0F0F1F2 C3xxxxxx xxxxxxxx xxxxxxxx 0012C........... ................
* Dump0002 Complete... Length = 0005
* Dump0002 *
* Dump0002 MINUS-123 PIC S9(5)
* Dump0002 Starting... Length = 0005
*  Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........
*   1-016 F0F0F1F2 D3xxxxxx xxxxxxxx xxxxxxxx 0012L........... ................
* Dump0002 Complete... Length = 0005

If the sample program is executed in the PC, ASCII environment the following would be displayed and written to the log file.

* Dump0002 ********************************************************************
* Dump0002 PLUS-123 PIC S9(5)
* Dump0002 Starting... Length = 0005
*  Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........
*   1-016 30303132 33xxxxxx xxxxxxxx xxxxxxxx ................ 00123...........
* Dump0002 Complete... Length = 0005
* Dump0002 *
* Dump0002 MINUS-123 PIC S9(5)
* Dump0002 Starting... Length = 0005
*  Offset Hex..... ........ ........ ........ ebcdic.......... ascii...........
*   1-016 30303132 73xxxxxx xxxxxxxx xxxxxxxx ................ 0012s...........
* Dump0002 Complete... Length = 0005

In the preceding example for a signed numeric field (Dump0002) notice the high-order nibble in the units position is used for the sign and the low-order nibble is used for the digit value.

Data Conversion, Considerations and Limitations
(Next) (Previous) (Table-of-Contents)

The following links will provide additional information about Data File Conversion between ASCII and EBCDIC or Mainframe Numeric encoding and Windows or UNIX numeric Encoding.

http://www.simotime.com/cbldfc01.htm
http://www.simotime.com/simorec1.htm#ProgrammingConsiderationsLimitations

CMD for Hex Dump Execution with Net Express
(Next) (Previous) (Table-of-Contents)

The following (NBRTYPE1.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    - COBOL and Commonly User Numeric Formats
rem  * Author  - SimoTime Enterprises
rem  * Date    - November 11, 2003
rem  * Version - 03.12.15
rem  *
rem  * This set of programs illustrates the use of some of the commonly
rem  * used numeric formats. It will show actual hex-dump content of
rem  * the fields along with the field length for the display format
rem  * (actual digits), the packed format (COMP-3) and the binary (COMP)
rem  * formats.
rem  *
rem  * The COBOL programs are compiled with the ASSIGN(EXTERNAL)
rem  * directive. This provides for external file mapping of file names.
rem  *
rem  * When running with Net Express the IBMCOMP an NOTRUNC directives
rem  * will be required to maintain compatability with the mainframe
rem  * format and field sizes for binary fields.
rem  *
rem  * This technique provides for the use of a single COBOL source
rem  * program that will run on OS/390, Windows or Unix.
rem  *
rem  * This set of programs will run on a Personal Computer with Windows
rem  * and Micro Focus Net Express.
rem  *
rem  *   ************
rem  *   * NBRTYPE1 *
rem  *   ********cmd*
rem  *        *
rem  *        *
rem  *   ************     ************     ************
rem  *   *   RUN    ******* NBRTYPC1 ******* SIMODUMP *
rem  *   ************     ********gnt*  *  ********dll*
rem  *        *                                 *
rem  *        *                            ************     ************
rem  *        *                            * SIMOLOGS ******* CONSOLE  *
rem  *        *                            ********dll*  *  ************
rem  *        *                                          *
rem  *        *                                          *  ************
rem  *        *                                          ****  SYSLOG  *
rem  *        *                                             *******data*
rem  *        *
rem  *   ************
rem  *   *   EOJ    *
rem  *   ************
rem  *
rem  * *******************************************************************
rem  * Step   1 of 2  Set the global environment variables...
rem  *
     call Env1PROD
     set CmdName=NBRTYPE1
rem  *
     call SimoNOTE "*******************************************************%CmdName%.CMD"
     call SimoNOTE "Starting JobName %CmdName%.CMD"
rem  *
rem  * *******************************************************************
rem  * Step 1 of 1, Execute the Number Format Analysis Program...
rem  *
     run NbrTypC1
     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%"
     goto :End
:End
     call SimoNOTE "Conclude SysOut is %SYSOUT%"
     if not "%1" == "nopause" pause

The JCL Member
(Next) (Previous) (Table-of-Contents)

The following is the mainframe JCL (NBRTYPJ1.JCL) required to run the mainline program.

//NBRTYPJ1 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    - COBOL and Commonly User Numeric Formats
//* Author  - SimoTime Enterprises
//* Date    - November 11, 2003
//* Version - 03.12.15
//*
//* This set of programs illustrates the use of some of the commonly
//* used numeric formats. It will show actual hex-dump content of
//* the fields along with the field length for the display format
//* (actual digits), the packed format (COMP-3) and the binary (COMP)
//* formats.
//*
//* The COBOL programs are compiled with the ASSIGN(EXTERNAL)
//* directive. This provides for external file mapping of file names.
//*
//* When running with Net Express the IBMCOMP an NOTRUNC directives
//* will be required to maintain compatability with the mainframe
//* format and field sizes for binary fields.
//*
//* This technique provides for the use of a single COBOL source
//* program that will run on OS/390, Windows or Unix.
//*
//* This set of programs will run on a Personal Computer with Windows
//* and Micro Focus Mainframe Express or a Mainframe with OS/390.
//*
//* *******************************************************************
//* Step   1 of 2  This job step will delete a previously created
//*        hex-dump file.
//*
//DELTHEX1 EXEC PGM=IEFBR14
//SYSLOG   DD  DSN=SIMOTIME.DATA.SYSLOGT1,DISP=(MOD,DELETE,DELETE),
//             STORCLAS=MFI,
//             SPACE=(TRK,5),
//             DCB=(RECFM=V,LRECL=1055,DSORG=PS)
//*
//* *******************************************************************
//* Step   2 of 2  Execute the program.
//*
//NBRTYPX1 EXEC PGM=NBRTYPC1,PARM='SYSOUT(BOTH)'
//STEPLIB  DD  DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR
//*            The following DD statement is for the logging file.
//SYSLOG   DD  DSN=SIMOTIME.DATA.SYSLOGT1,DISP=(NEW,CATLG,CATLG),
//             STORCLAS=MFI,
//             SPACE=(TRK,5),
//             DCB=(RECFM=V,LRECL=1055,DSORG=PS)
//*            The following DD statement is SYSOUT and is used when
//*            the COBOL program does a Display.
//SYSOUT   DD  SYSOUT=*
//*

The COBOL Demonstration Program
(Next) (Previous) (Table-of-Contents)

This program (NBRTYPC1.CBL) was written to test and scan a numeric field for numeric values or digits.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    NBRTYPC1.
       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 and does not imply publication   *
      * or disclosure.                                                *
      *                                                               *
      * Permission to use, copy, modify and distribute this software  *
      * for any non-commercial purpose and without fee is hereby      *
      * granted, provided the SimoTime copyright notice appear on all *
      * copies of the software. The SimoTime name or Logo may not be  *
      * used in any advertising or publicity pertaining to the use    *
      * of the software without the written permission of SimoTime    *
      * Enterprises.                                                  *
      *                                                               *
      * 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.                                                  *
      *                                                               *
      * 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                                  *
      *                                                               *
      * 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: NBRTYPC1.CBL
      *****************************************************************
      *
      * NBRTYPC1 - Numeric formats for COBOL.
      *
      *
      * DESCRIPTION
      * -----------
      * This set of programs is used to show the various numeric
      * format used by the COBOL Program Language.
      *
      * This program illustrates the use of some of the commonly
      * used numeric formats. It will show actual hex-dump content of
      * the fields along with the field length for the display format
      * (actual digits), the packed format (COMP-3) and the binary
      * (COMP)
      * formats.
      *
      * The COBOL programs are compiled with the ASSIGN(EXTERNAL)
      * directive. This provides for external file mapping of file
      * names.
      *
      * When running with Net Express the IBMCOMP an NOTRUNC directives
      * will be required to maintain compatability with the mainframe
      * format and field sizes for binary fields.
      *
      * This technique provides for the use of a single COBOL source
      * program that will run on OS/390, Windows or Unix.
      *
      * This program will run on a Personal Computer with Windows
      * and Micro Focus Net Express or Mainframe Express.
      *
      * This program will also run on an IBM Mainframe.
      *
      *****************************************************************
      *
      * MAINTENANCE
      * -----------
      * 1996/03/15 Simmons, Created program.
      * 1996/03/15 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 '* NBRTYPC1 '.
           05  T2 pic X(34) value 'Numeric Formats for COBOL         '.
           05  T3 pic X(10) value ' v06.04.06'.
           05  T4 pic X(24) value ' http://www.simotime.com'.
       01  SIM-COPYRIGHT.
           05  C1 pic X(11) value '* NBRTYPC1 '.
           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 '* NBRTYPC1 '.
           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 '* NBRTYPC1 '.
           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 '    '.

      *****************************************************************
      *    Buffer used for posting messages to the console.
      *    ------------------------------------------------------------
       01  MESSAGE-BUFFER.
           05  MESSAGE-HEADER      pic X(11)   value '* NBRTYPC1 '.
           05  MESSAGE-TEXT        pic X(68).

      *****************************************************************
      *    Coding techniques for various numeric formats...
      *    ------------------------------------------------------------
      *    The following shows the full syntax for ZONED-DECIMAL
       01  ZONE-DECIMAL-UNSIGN     pic 9(5)  USAGE IS DISPLAY.
      *    However, it is usually coded as follows.
       01  ZONE-DECIMAL-UNSIGN-2   PIC 9(5).
      *    For Working Storage fields a value clause may be added to
      *    minimize or avoid the occurence of a "S0C7" or an error
      *    message of "Invalid value in numeric field" followed
      *    by a program ABEND. The value clause will cause the field
      *    to contain all ZEROES when the program is loaded. If the
      *    value clause is not used as follows the numeric field may
      *    contain spaces.
       01  ZONE-DECIMAL-UNSIGN-2   PIC 9(5) VALUE 0.

      *    ------------------------------------------------------------
      *    The following is the full syntax for PACKED-DECIMAL.
       01  PACK-DECIMAL-UNSIGN     pic 9(5)  USAGE IS COMPUTATIONAL-3.
      *    However, it is usually coded as follows. The VALUE clause
      *    is optional and will initialize the field to ZEROES when
      *    the program is started.
       01  PACK-DECIMAL-UNSIGN-2   pic 9(5)  COMP-3 VALUE 0.

      *    ------------------------------------------------------------
      *    The following is the full syntax for BINARY or COMP field.
       01  BINARY-UNSIGN           pic 9(5)  USAGE IS COMPUTATIONAL.
      *
      *    However, it is usually coded as follows. The VALUE clause
      *    is optional and will initialize the field to ZEROES when
      *    the program is started.
       01  BINARY-UNSIGN-2         pic 9(5)  COMP VALUE 0.

      *****************************************************************
      *    Various numeric formats used by COBOL...
      *    ------------------------------------------------------------
       01  UNSIGNED-123            pic 9(5)            value 123.
       01  UNSIGNED-123-X          REDEFINES   UNSIGNED-123
                                   pic X(5).

       01  PLUS-123                pic S9(5)           value +123.
       01  PLUS-123-X              REDEFINES   PLUS-123
                                   pic X(5).
       01  PLUS-123-PACKED         pic S9(5)   COMP-3  value +123.
       01  PLUS-123-PACKED-X       REDEFINES   PLUS-123-PACKED
                                   pic X(3).
       01  PLUS-123-BINARY         pic S9(5)   BINARY  value +123.
       01  PLUS-123-BINARY-X       REDEFINES   PLUS-123-BINARY
                                   pic X(4).

       01  PLUS-123-SL             pic S9(5)           value +123
                                   SIGN LEADING.
       01  PLUS-123-SL-X           REDEFINES   PLUS-123-SL
                                   pic X(5).
       01  PLUS-123-ST             pic S9(5)           value +123
                                   SIGN TRAILING.
       01  PLUS-123-ST-X           REDEFINES   PLUS-123-ST
                                   pic X(5).

       01  PLUS-123-SLS            pic S9(5)           value +123
                                   SIGN LEADING SEPARATE.
       01  PLUS-123-SLS-X          REDEFINES   PLUS-123-SLS
                                   pic X(6).
       01  PLUS-123-STS            pic S9(5)           value +123
                                   SIGN TRAILING SEPARATE.
       01  PLUS-123-STS-X          REDEFINES   PLUS-123-STS
                                   pic X(6).

       01  MINUS-123               pic S9(5)           value -123.
       01  MINUS-123-X             REDEFINES   MINUS-123
                                   pic X(5).
       01  MINUS-123-PACKED        pic S9(5)   COMP-3  value -123.
       01  MINUS-123-PACKED-X      REDEFINES   MINUS-123-PACKED
                                   pic X(3).
       01  MINUS-123-BINARY        pic S9(5)   BINARY  value -123.
       01  MINUS-123-BINARY-X      REDEFINES   MINUS-123-BINARY
                                   pic X(4).

       01  MINUS-123-SL            pic S9(5)           value -123
                                   SIGN LEADING.
       01  MINUS-123-SL-X          REDEFINES   MINUS-123-SL
                                   pic X(5).
       01  MINUS-123-ST            pic S9(5)           value -123
                                   SIGN TRAILING.
       01  MINUS-123-ST-X          REDEFINES   MINUS-123-ST
                                   pic X(5).

       01  MINUS-123-SLS           pic S9(5)           value -123
                                   SIGN LEADING SEPARATE.
       01  MINUS-123-SLS-X         REDEFINES   MINUS-123-SLS
                                   pic X(6).
       01  MINUS-123-STS           pic S9(5)           value -123
                                   SIGN TRAILING SEPARATE.
       01  MINUS-123-STS-X         REDEFINES   MINUS-123-STS
                                   pic X(6).

       01  FIELD-LENGTH            pic 9(3)    value 0.
       01  FIELD-LENGTH-X          REDEFINES   FIELD-LENGTH
                                   pic X(3).
       01  LENGTH-OF-FIELDS.
           05  DIGITS-LENGTH       pic 9(3)    value 0.
           05  FILLER              pic X       value '-'.
           05  PACKED-LENGTH       pic 9(3)    value 0.
           05  FILLER              pic X       value '-'.
           05  BINARY-LENGTH       pic 9(3)    value 0.
           05  FILLER              pic X       value SPACE.
           05  FILLER              pic X(23)
                                   value '(Display-Packed-Binary)'.
           05  FILLER              pic X       value SPACE.
           05  FIELD-NAME          pic X(32).

       01  NBR-01-DIGITS pic 9            value 1.
       01  NBR-01-PACKED pic 9     COMP-3 value 1.
       01  NBR-01-BINARY pic 9     COMP   value 1.

       01  NBR-02-DIGITS pic 9(02)        value 12.
       01  NBR-02-PACKED pic 9(02) COMP-3 value 12.
       01  NBR-02-BINARY pic 9(02) COMP   value 12.

       01  NBR-03-DIGITS pic 9(03)        value 123.
       01  NBR-03-PACKED pic 9(03) COMP-3 value 123.
       01  NBR-03-BINARY pic 9(03) COMP   value 123.

       01  NBR-04-DIGITS pic 9(04)        value 1234.
       01  NBR-04-PACKED pic 9(04) COMP-3 value 1234.
       01  NBR-04-BINARY pic 9(04) COMP   value 1234.

       01  NBR-05-DIGITS pic 9(05)        value 12345.
       01  NBR-05-PACKED pic 9(05) COMP-3 value 12345.
       01  NBR-05-BINARY pic 9(05) COMP   value 12345.

       01  NBR-06-DIGITS pic 9(06)        value 123456.
       01  NBR-06-PACKED pic 9(06) COMP-3 value 123456.
       01  NBR-06-BINARY pic 9(06) COMP   value 123456.

       01  NBR-07-DIGITS pic 9(07)        value 1234567.
       01  NBR-07-PACKED pic 9(07) COMP-3 value 1234567.
       01  NBR-07-BINARY pic 9(07) COMP   value 1234567.

       01  NBR-08-DIGITS pic 9(08)        value 12345678.
       01  NBR-08-PACKED pic 9(08) COMP-3 value 12345678.
       01  NBR-08-BINARY pic 9(08) COMP   value 12345678.

       01  NBR-09-DIGITS pic 9(09)        value 123456789.
       01  NBR-09-PACKED pic 9(09) COMP-3 value 123456789.
       01  NBR-09-BINARY pic 9(09) COMP   value 123456789.

       01  NBR-10-DIGITS pic 9(10)        value 1234567890.
       01  NBR-10-PACKED pic 9(10) COMP-3 value 1234567890.
       01  NBR-10-BINARY pic 9(10) COMP   value 1234567890.

       01  NBR-11-DIGITS pic 9(11)        value 12345678901.
       01  NBR-11-PACKED pic 9(11) COMP-3 value 12345678901.
       01  NBR-11-BINARY pic 9(11) COMP   value 12345678901.

       01  NBR-12-DIGITS pic 9(12)        value 123456789012.
       01  NBR-12-PACKED pic 9(12) COMP-3 value 123456789012.
       01  NBR-12-BINARY pic 9(12) COMP   value 123456789012.

       01  NBR-13-DIGITS pic 9(13)        value 1234567890123.
       01  NBR-13-PACKED pic 9(13) COMP-3 value 1234567890123.
       01  NBR-13-BINARY pic 9(13) COMP   value 1234567890123.

       01  NBR-14-DIGITS pic 9(14)        value 12345678901234.
       01  NBR-14-PACKED pic 9(14) COMP-3 value 12345678901234.
       01  NBR-14-BINARY pic 9(14) COMP   value 12345678901234.

       01  NBR-15-DIGITS pic 9(15)        value 123456789012345.
       01  NBR-15-PACKED pic 9(15) COMP-3 value 123456789012345.
       01  NBR-15-BINARY pic 9(15) COMP   value 123456789012345.

       01  NBR-16-DIGITS pic 9(16)        value 1234567890123456.
       01  NBR-16-PACKED pic 9(16) COMP-3 value 1234567890123456.
       01  NBR-16-BINARY pic 9(16) COMP   value 1234567890123456.

       01  NBR-17-DIGITS pic 9(17)        value 12345678901234567.
       01  NBR-17-PACKED pic 9(17) COMP-3 value 12345678901234567.
       01  NBR-17-BINARY pic 9(17) COMP   value 12345678901234567.

       01  NBR-18-DIGITS pic 9(18)        value 123456789012345678.
       01  NBR-18-PACKED pic 9(18) COMP-3 value 123456789012345678.
       01  NBR-18-BINARY pic 9(18) COMP   value 123456789012345678.

       COPY PASSDUMP.

      *****************************************************************
       PROCEDURE DIVISION.
           perform FIRST-TIME-LOGIC

      *    ------------------------------------------------------------
      *    Example-01, Show the Hex format for a SIMPLE, UNSIGNED
      *    NUMERIC field...
           perform EXAMPLE-01

      *    ------------------------------------------------------------
      *    Example-02, Show the Hex format for a SIMPLE, SIGNED
      *    NUMERIC field...
           perform EXAMPLE-02

      *    ------------------------------------------------------------
      *    Example-03, Show the Hex format for a SIGNED, PACKED,
      *    NUMERIC field...
           perform EXAMPLE-03

      *    ------------------------------------------------------------
      *    Example-04, Show the Hex format for a SIGNED, BINARY,
      *    NUMERIC field...
           perform EXAMPLE-04

      *    ------------------------------------------------------------
      *    Example-05, Show the Hex format for a SIGN, LEADING,
      *    NUMERIC field...
           perform EXAMPLE-05

      *    ------------------------------------------------------------
      *    Example-06, Show the Hex format for a SIGN, TRAILING,
      *    NUMERIC field...
           perform EXAMPLE-06

      *    ------------------------------------------------------------
      *    Example-07, Show the Hex format for a SIGN, LEADING,
      *    SEPARATE, NUMERIC field...
           perform EXAMPLE-07

      *    ------------------------------------------------------------
      *    Example-08, Show the Hex format for a SIGN, TRAILING,
      *    SEPARATE, NUMERIC field...
           perform EXAMPLE-08

      *    ------------------------------------------------------------
      *    Example-09, Show the Specfied size and actual field length.
           perform EXAMPLE-09

           GOBACK.

      *****************************************************************
       DUMP-ASTERISK-ROW.
           move 'NOTE' to SIMODUMP-REQUEST
           move all '*' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
       DUMP-ASTERISK-ROW-2X.
           perform DUMP-ASTERISK-SINGLE
           perform DUMP-ASTERISK-ROW
           exit.

      *****************************************************************
       DUMP-ASTERISK-SINGLE.
           move 'NOTE' to SIMODUMP-REQUEST
           move SPACES to SIMODUMP-BUFFER
           move '*'    to SIMODUMP-BUFFER(1:1)
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show the Hex format for a SIMPLE, UNSIGNED, NUMERIC field...
      *****************************************************************
       EXAMPLE-01.
      *    Prepare to show the Number...
           move 'Dump0001' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'UNSIGNED-123 PIC 9(5)' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the field...
           move 'DUMP'         to SIMODUMP-REQUEST
           add length of UNSIGNED-123 to ZERO giving SIMODUMP-LENGTH
           move SPACES         to SIMODUMP-BUFFER
           move UNSIGNED-123-X to SIMODUMP-BUFFER
           call 'SIMODUMP'  using SIMODUMP-PASS-AREA
           display 'UNSIGNED-123 is ' UNSIGNED-123
           exit.

      *****************************************************************
      * Show the Hex format for a SIGNED, NUMERIC field...
      *****************************************************************
       EXAMPLE-02.
      *    Prepare to show the Positive Number...
           move 'Dump0002'    to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123 PIC S9(5)' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP'        to SIMODUMP-REQUEST
           add  length of PLUS-123 to ZERO giving SIMODUMP-LENGTH
           move SPACES        to SIMODUMP-BUFFER
           move PLUS-123-X    to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123 PIC S9(5)' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP'        to SIMODUMP-REQUEST
           add  length of MINUS-123 to ZERO giving SIMODUMP-LENGTH
           move SPACES        to SIMODUMP-BUFFER
           move MINUS-123-X   to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show the Hex format for a SIGNED, PACKED, NUMERIC field...
      *****************************************************************
       EXAMPLE-03.
      *    Prepare to show the Positive Number...
           move 'Dump0003'    to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123-PACKED PIC S9(5) COMP-3' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP'        to SIMODUMP-REQUEST
           add  length of PLUS-123-PACKED to ZERO
                giving SIMODUMP-LENGTH
           move SPACES        to SIMODUMP-BUFFER
           move PLUS-123-PACKED-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123-PACKED PIC S9(5) COMP-3' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP'             to SIMODUMP-REQUEST
           add  length of MINUS-123-PACKED to ZERO
                giving SIMODUMP-LENGTH
           move SPACES             to SIMODUMP-BUFFER
           move MINUS-123-PACKED-X to SIMODUMP-BUFFER
           call 'SIMODUMP'      using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show the Hex format for a SIGNED, BINARY, NUMERIC field...
      *****************************************************************
       EXAMPLE-04.
      *    Prepare to show the Positive Number...
           move 'Dump0004' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123-BINARY PIC S9(5) BINARY' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add  length of PLUS-123-BINARY to ZERO
                giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move PLUS-123-BINARY-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123-BINARY PIC S9(5) BINARY' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add  length of MINUS-123-BINARY to ZERO
                giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move MINUS-123-BINARY-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show the Hex format for a SIGN, LEADING, NUMERIC field...
      *****************************************************************
       EXAMPLE-05.
      *    Prepare to show the Positive Number...
           move 'Dump0005' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123-SL PIC S9(5) SIGN LEADING' to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add  length of PLUS-123-SL to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move PLUS-123-SL-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123-SL PIC S9(5) SIGN LEADING'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add length of MINUS-123-SL to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move MINUS-123-SL-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show the Hex format for a SIGN, TRAILING, NUMERIC field...
      *****************************************************************
       EXAMPLE-06.
      *    Prepare to show the Positive Number...
           move 'Dump0005' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123-ST PIC S9(5) SIGN TRAILING'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add  length of PLUS-123-ST to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move PLUS-123-ST-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123-ST PIC S9(5) SIGN TRAILING'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add length of MINUS-123-ST to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move MINUS-123-ST-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show Hex format for a SIGN, LEADING, SEPARATE, NUMERIC field...
      *****************************************************************
       EXAMPLE-07.
      *    Prepare to show the Positive Number...
           move 'Dump0007' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123-SLS PIC S9(5) SIGN LEADING SEPARATE'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add  length of PLUS-123-SLS to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move PLUS-123-SLS-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123-SLS PIC S9(5) SIGN LEADING SEPARATE'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add  length of MINUS-123-SLS to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move MINUS-123-SLS-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show Hex format for a SIGN, TRAILING, SEPARATE, NUMERIC field.
      *****************************************************************
       EXAMPLE-08.
      *    Prepare to show the Positive Number...
           move 'Dump0008' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
           move 'PLUS-123-STS PIC S9(5) SIGN TRAILING SEPARATE'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Positive Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add length of PLUS-123-STS to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move PLUS-123-STS-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Prepare to show the Negative Number...
           perform DUMP-ASTERISK-SINGLE
           move 'MINUS-123-STS PIC S9(5) SIGN TRAILING SEPARATE'
             to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
      *    Show the hexadecimal content of the Negative Number...
           move 'DUMP' to SIMODUMP-REQUEST
           add length of MINUS-123-STS to ZERO giving SIMODUMP-LENGTH
           move SPACES to SIMODUMP-BUFFER
           move MINUS-123-STS-X to SIMODUMP-BUFFER
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           exit.

      *****************************************************************
      * Show the Specfied size and actual field length.
      *****************************************************************
       EXAMPLE-09.
           move 'Dump0009' to SIMODUMP-DUMP-ID
           perform DUMP-ASTERISK-ROW-2X
      *
           add length of NBR-01-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-01-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-01-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-01 Field Sizes for PIC 9' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-02-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-02-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-02-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-02 Field Sizes for PIC 99' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-03-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-03-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-03-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-03 Field Sizes for PIC 999' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-04-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-04-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-04-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-04 Field Sizes for PIC 9(4)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-05-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-05-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-05-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-05 Field Sizes for PIC 9(5)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-06-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-06-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-06-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-06 Field Sizes for PIC 9(6)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-07-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-07-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-07-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-07 Field Sizes for PIC 9(7)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-08-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-08-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-08-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-08 Field Sizes for PIC 9(8)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-09-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-09-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-09-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-09 Field Sizes for PIC 9(9)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-10-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-10-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-10-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-10 Field Sizes for PIC 9(10)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-11-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-11-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-11-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-11 Field Sizes for PIC 9(11)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-12-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-12-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-12-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-12 Field Sizes for PIC 9(12)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-13-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-13-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-13-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-13 Field Sizes for PIC 9(13)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-14-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-14-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-14-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-14 Field Sizes for PIC 9(14)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-15-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-15-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-15-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-15 Field Sizes for PIC 9(15)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-16-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-16-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-16-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-16 Field Sizes for PIC 9(16)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-17-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-17-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-17-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-17 Field Sizes for PIC 9(17)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           add length of NBR-18-DIGITS to ZERO giving DIGITS-LENGTH
           add length of NBR-18-PACKED to ZERO giving PACKED-LENGTH
           add length of NBR-18-BINARY to ZERO giving BINARY-LENGTH
           move 'NBR-18 Field Sizes for PIC 9(18)' to FIELD-NAME
           move LENGTH-OF-FIELDS to SIMODUMP-BUFFER
           perform Z-POST-NOTE-AND-CLEAR
      *
           perform DUMP-ASTERISK-ROW
      *
           exit.

      *****************************************************************
       FIRST-TIME-LOGIC.
           perform Z-POST-COPYRIGHT.
           move 'BOTH' to SIMODUMP-SYSOUT
           move 'HIDE' to SIMODUMP-COPYRIGHT
           exit.

      *****************************************************************
      * The following Z-Routines perform administrative tasks         *
      * for this program.                                             *
      *****************************************************************
       Z-POST-CONSOLE-MESSAGE.
           display MESSAGE-BUFFER upon console
           move SPACES to MESSAGE-TEXT
           exit.

      *****************************************************************
       Z-POST-COPYRIGHT.
           display SIM-TITLE     upon console
           display SIM-COPYRIGHT upon console
           exit.

      *****************************************************************
       Z-POST-NOTE-AND-CLEAR.
           move 'NOTE' to SIMODUMP-REQUEST
           call 'SIMODUMP' using SIMODUMP-PASS-AREA
           move SPACES to SIMODUMP-BUFFER
           exit.

      *****************************************************************
       Z-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       *
      *****************************************************************

Summary
(Next) (Previous) (Table-of-Contents)

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.

Software Agreement and Disclaimer
(Next) (Previous) (Table-of-Contents)

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

Downloads and Links to Similar Pages
(Next) (Previous) (Table-of-Contents)

You may download this example at http://www.simotime.com/sim4dzip.htm#COBOLNumericFields 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 list provides links to additional SimoTime documents about numeric data fields.

Link Name Description
number01 This is an introductory, self-study course about the commonly used numeric formats available on the mainframe. The course material may be purchased from SimoTime. The documentation may be viewed online.
databn01 This is a White Paper that describes the usage and format of BINARY fields (or "USAGE IS COMPUTATIONAL" in COBOL terminology).
datapk01 This is a White Paper that describes the usage and format of PACKED-DECIMAL fields (or "USAGE IS COMPUTATIONAL-3" in COBOL terminology).
datazd01 This is a White Paper that describes the usage and format of ZONED-DECIMAL fields (or "USAGE IS DISPLAY" in COBOL terminology).

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
nbrcvt01 This suite of example programs describes how to convert between the various numeric formats used with COBOL and on an IBM Mainframe System. This example also illustrates how to display the actual hexadecimal content of a numeric field using a callable dump routine.
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.

To review all the information available on this site start at  The SimoTime Home Page .

Comments or Suggestions
(Next) (Previous) (Table-of-Contents)

If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com

About SimoTime Enterprises
(Next) (Previous) (Table-of-Contents)

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