COBOL Numbers
Leading Spaces and Zeroes
  Table of Contents  v-24.01.01 - numbug01.htm 
  Introduction
  Programming Objectives
  Programming Requirements
  Programming Overview
  Programming Output
  The CMD File
  The JCL Member
  COBOL Demonstration Program
  COBOL Compiler Directives
  Summary
  Software Agreement and Disclaimer
  Downloads and Links
  Current Server or Internet Access
  Internet Access Required
  Glossary of Terms
  Contact or Feedback
  Company Overview
The SimoTime Home Page 

Table of Contents Previous Section Next Section Introduction

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.


We have made a significant effort to ensure the documents and software technologies are correct and accurate. We reserve the right to make changes without notice at any time. The function delivered in this version is based upon the enhancement requests from a specific group of users. The intent is to provide changes as the need arises and in a timeframe that is dependent upon the availability of resources.

Copyright © 1987-2024
SimoTime Technologies and Services
All Rights Reserved

Table of Contents Previous Section Next Section Programming Objectives

This example illustrates the following functions.

1 Mainframe type truncation of Packed Fields
2 Zoned Decimal 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 and initializing the index
6 Explain why allowing SPACES in a Packed Numeric Field is not a good idea.
  Functions that are Described and Demonstrated in this set of Programs

Table of Contents Previous Section Next Section Programming Requirements

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 Linux and UNIX platforms supported by Micro Focus COBOL.
  Operating Systems and Supporting Software Requirements

Table of Contents Previous Section Next Section Programming Overview

The following is a flowchart of the job for executing the programs that show the usage of numeric field types.

             
Entry Point
ZOS
Entry Point
Windows
   
   
NUMBUGJ1
jcl
NUMBUGE1
cmd
Submit the Job
   
   
IEFBR14
Utility
IF Exist
statement
Delete previously created output files
   
   
 
 
   
   
 
 
   
   
NUMBUGC1
cbl
 
 
SYSOUT
spool
Use in-memory data, post results to SYSOUT
   
EOJ
End-Of-Job
 
Job Logic Flow for Numeric Compatibility Testing

Color Associations: The  light-green  boxes are unique to SIMOTIME Technologies using an IBM Mainframe System or Micro Focus Enterprise Developer. The  light-red  boxes are unique to the SIMOTIME Technologies using a Linux, UNIX or Windows System and COBOL Technologies such as Micro Focus. The  light-yellow  boxes are SIMOTIME Technologies, Third-party Technologies, decision points or program transitions in the processing logic or program generations. The  light-blue  boxes identify the input/output data structures such as Documents, Spreadsheets, Data Files, VSAM Data Sets, Partitioned Data Set Members (PDSM's) or Relational Tables. The  light-gray  boxes identify a system function or an informational item.

Table of Contents Previous Section Next Section Programming Output

The following is a sample of the Dump information that is written to SYSOUT by this sample program.

* NUMBUGC1 Numeric Fields, Spaces and Zeroes  v12.01.17 http://www.simotime.com
* NUMBUGC1 Copyright 1987-2012 --- SimoTime Enterprises --- 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 for using this software provided from SimoTime Enterprises
* NUMBUGC1 Please send all inquires or suggestions to the helpdesk@simotime.com

Table of Contents Previous Section Next Section The CMD File

The following (NUMBUGE1.cmd) is a sample of the Windows CMD needed to run this job.

@echo OFF
rem  * *******************************************************************
rem  *               NUMBUGE1.CMD - a Windows Command File               *
rem  *         This program is provided by SimoTime Technologies         *
rem  *           (C) Copyright 1987-2019 All Rights Reserved             *
rem  *             Web Site URL:   http://www.simotime.com               *
rem  *                   e-mail:   helpdesk@simotime.com                 *
rem  * *******************************************************************
rem  *
rem  * Text   - Processing Numeric Fields
rem  * Author - SimoTime Technologies
rem  * Date   - January 24, 1996
rem  *
rem  * *******************************************************************
rem  * Step 1, Delete any previously created file...
rem  *
     set CmdName=numbuge1
     call ..\Env1BASE
     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

Table of Contents Previous Section Next Section The JCL Member

The following is the JCL member (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 Technologies          *
//*           (C) Copyright 1987-2019 All Rights Reserved             *
//*             Web Site URL:   http://www.simotime.com               *
//*                   e-mail:   helpdesk@simotime.com                 *
//* *******************************************************************
//*
//* Text   -   COBOL processing of numeric fields...
//* Author -   SimoTime Technologies
//* 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=*
//*

Table of Contents Previous Section Next Section COBOL Demonstration Program

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 TECHNOLOGIES.
      *****************************************************************
      * Copyright (C) 1987-2019 SimoTime Technologies.                *
      *                                                               *
      * 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    *
      * Technologies.                                                 *
      *                                                               *
      * Permission to use, copy, modify and distribute this software  *
      * for any commercial purpose requires a fee to be paid to       *
      * SimoTime Technologies. 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           *
      * Technologies.                                                 *
      *                                                               *
      * SimoTime Technologies makes no warranty or representations    *
      * about the suitability of the software for any purpose. It is  *
      * provided "AS IS" without any expressed or implied warranty,   *
      * including the implied warranties of merchantability, fitness  *
      * for a particular purpose and non-infringement. SimoTime       *
      * Technologies shall not be liable for any direct, indirect,    *
      * special or consequential damages resulting from the loss of   *
      * use, data or projects, whether in an action of contract or    *
      * tort, arising out of or in connection with the use or         *
      * performance of this software                                  *
      *                                                               *
      * SimoTime Technologies                                         *
      * 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 Technologies, *
      * 15 Carnoustie Drive, Novato, CA 94949-5849.                   *
      *                                                               *
      *****************************************************************
      *      This program is provided by SimoTime Technologies        *
      *        Our e-mail address is: helpdesk@simotime.com           *
      *     Also, visit our Web Site at http://www.simotime.com       *
      *                                                               *
      *****************************************************************
      *
      *****************************************************************
      * Source Member: NUMBUGC1.CBL
      *
      * 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
      * -----------
      * 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 '* NUMBUGC1 '.
           05  T2 pic X(34) value 'Numeric Fields, Spaces and Zeroes '.
           05  T3 pic X(10) value ' v12.01.17'.
           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-2019 '.
           05  C3 pic X(28) value '   SimoTime Technologies    '.
           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 for using this program'.
           05  C3 pic X(32) value ' provided from SimoTime Technolo'.
           05  C4 pic X(04) value 'gies'.

       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 Technologies        *
      *        Our e-mail address is: helpdesk@simotime.com           *
      *     Also, visit our Web Site at http://www.simotime.com       *
      *****************************************************************


Table of Contents Previous Section Next Section COBOL Compiler Directives

This COBOL Compiler Directives (NUMBUGC1.dir) file is used to compile the program to be executed using a mainframe dialect with ASCII encoding and options to allow leading spaces in Zoned-Decimal, Numeric Fields. The following is a listing of the directives file that is used with Micro Focus Enterprise Developer.

DIALECT"ENTCOBOL"
CHARSET"ASCII"
ASSIGN"EXTERNAL"
IBMCOMP
NOTRUNC
HOST-NUMMOVE
HOST-NUMCOMPARE
SIGN-FIXUP
HOST-ARITHMETIC
NOCHECKNUM
defaultbyte"00"
ANIM
NOOPTIONAL-FILE
outdd"SYSOUT 121 L"
SHARE-OUTDD
DATAMAP
settings
list()
noform

Table of Contents Previous Section Next Section Summary

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. This document may be used to assist as a tutorial for new programmers or as a quick reference for experienced programmers.

In the world of programming there are many ways to solve a problem. This documentation and software were developed and tested on systems that are configured for a SIMOTIME environment based on the hardware, operating systems, user requirements and security requirements. Therefore, adjustments may be needed to execute the jobs and programs when transferred to a system of a different architecture or configuration.

SIMOTIME Services has experience in moving or sharing data or application processing across a variety of systems. For additional information about SIMOTIME Services or Technologies please contact us using the information in the  Contact or Feedback  section of this document.

Table of Contents Previous Section Next Section Software Agreement and Disclaimer

Permission to use, copy, modify and distribute this software, documentation or training material for any purpose requires a fee to be paid to SimoTime Technologies. Once the fee is received by SimoTime the latest version of the software, documentation or training material will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Technologies.

SimoTime Technologies makes no warranty or representations about the suitability of the software, documentation or learning material for any purpose. It is provided "AS IS" without any expressed or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Technologies shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software, documentation or training material.

Table of Contents Previous Section Next Section Downloads and Links

This section includes links to documents with additional information that are beyond the scope and purpose of this document. The first group of documents may be available from a local system or via an internet connection, the second group of documents will require an internet connection.

Note: A SimoTime License is required for the items to be made available on a local system or server.

Table of Contents Previous Section Next Section Current Server or Internet Access

The following links may be to the current server or to the Internet.

Note: The latest versions of the SimoTime Documents and Program Suites are available on the Internet and may be accessed using the Link to Internet icon. If a user has a SimoTime Enterprise License the Documents and Program Suites may be available on a local server and accessed using the Link to Server icon.

Link to Internet   Link to Server   Explore the Numbers Connection for additional information about the structure and processing of numeric data items (or numeric fields).

Link to Internet   Link to Server   Explore The Binary or COMP format for numeric data strings. This numeric structure is supported by COBOL and may be explicitly defined with the "USAGE IS COMP" or "USAGE IS BINARY" clause.

Link to Internet   Link to Server   Explore The Edited for Display format for numeric data strings. This numeric structure is supported by COBOL and may be used with an edit-mask to prepare the presentation for readability by human beings.

Link to Internet   Link to Server   Explore The Packed-Decimal or COMP-3 format for numeric data strings. This numeric structure is supported by COBOL and may be explicitly defined with the "USAGE IS COMP-3" clause.

Link to Internet   Link to Server   Explore The Zoned-Decimal format for numeric data strings. This numeric structure is the default numeric for COBOL and may be explicitly defined with the "USAGE IS DISPLAY" clause.

Link to Internet   Link to Server   Explore the JCL Connection for more examples of JCL functionality with programming techniques and sample code.

Link to Internet   Link to Server   Explore the COBOL Connection for more examples of COBOL programming techniques and sample code.

Link to Internet   Link to Server   Explore An Enterprise System Model that describes and demonstrates how Applications that were running on a Mainframe System and non-relational data that was located on the Mainframe System were copied and deployed in a Microsoft Windows environment with Micro Focus Enterprise Server.

Link to Internet   Link to Server   Explore The ASCII and EBCDIC Translation Tables. These tables are provided for individuals that need to better understand the bit structures and differences of the encoding formats.

Link to Internet   Link to Server   Explore The File Status Return Codes that are used to interpret the results of accessing VSAM data sets and/or QSAM files.

Table of Contents Previous Section Next Section Internet Access Required

The following links will require an internet connect.

This suite of programs and documentation is available to download for review and evaluation purposes. Other uses will require a SimoTime Software License. Link to an Evaluation zPAK Option that includes the program members, documentation and control files.

A good place to start is The SimoTime Home Page for access to white papers, program examples and product information. This link requires an Internet Connection

Explore The Micro Focus Web Site for more information about products (including Micro Focus COBOL) and services available from Micro Focus. This link requires an Internet Connection.

Table of Contents Previous Section Next Section Glossary of Terms

Link to Internet   Link to Server   Explore the Glossary of Terms for a list of terms and definitions used in this suite of documents and white papers.

Table of Contents Previous Section Next Section Contact or Feedback

This document was created and is maintained by SimoTime Technologies. If you have any questions, suggestions, comments or feedback please use the following contact information.

1. Send an e-mail to our helpdesk.
1.1. helpdesk@simotime.com.
2. Our telephone numbers are as follows.
2.1. 1 415 763-9430 office-helpdesk
2.2. 1 415 827-7045 mobile

 

We appreciate hearing from you.

Table of Contents Previous Section Next Section Company Overview

SimoTime Technologies was founded in 1987 and is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. Our customers include small businesses using Internet technologies to corporations using very large mainframe systems.

Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. We specialize in preparing applications and the associated data that are currently residing on a single platform to be distributed across a variety of platforms.

Preparing the application programs will require the transfer of source members that will be compiled and deployed on the target platform. The data will need to be transferred between the systems and may need to be converted and validated at various stages within the process. SimoTime has the technology, services and experience to assist in the application and data management tasks involved with doing business in a multi-system environment.

Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com


Return-to-Top
Possible Problems with Numeric Fields and Leading SPACES or ZEROES
Copyright © 1987-2024
SimoTime Technologies and Services
All Rights Reserved
When technology complements business
http://www.simotime.com