 |
|
| When technology complements business | Price List for the Item Master File |
| Copyright © 1987-2008 SimoTime Enterprises, LLC All Rights Reserved | http://www.simotime.com |
|
|||||
|
Printing numeric fields, especially packed-decimal or binary (i.e. COMP-3 or COMP) requires special consideration. Also, signed, zoned-decimal fields will require special consideration. Most numeric fields will require some sort of editing before printing. This suite of programs provides examples of how a COBOL program may be used to properly print (or display) numeric fields.
The COBOL program is written using the IBM COBOL for OS/390 dialect and will also work with IBM Enterprise COBOL. A JCL member is provided to run the job as an MVS batch job on an IBM mainframe or as a project with Micro Focus Mainframe Express (MFE) running on a PC with Windows. A batch or command file is provided to run the job as a Windows batch job on a Wintel platform using Micro Focus Net Express (refer to http://www.microfocus.com).
This example illustrates the following functions.
| 1. | Demonstrate how to print (or display) a packed-decimal (i.e. COMP-3) field. |
| 2. | Demonstrate how to perform arithmetic using binary (i.e. COMP) fields and produce a result field that is easily printed (or displayed). |
The input to the sample program is the Item Master file. On the Mainframe this is a VSAM, Key-Sequenced-Data-Set (or KSDS) and with Micro Focus it is a Key-Sequenced or Indexed file. The output will be a printed report showing the item prices and quantity available. The item price is stored in the item master file in a packed-decimal format (i.e. COMP-3). The quantity available is calculated from two fields that are stored in the item master file in a binary (i.e. COMP) format. The quantity-available equals the quantity-on-hand minus the quantity-allocated.
This suite of samples programs will run on the following platforms.
| 1. | Executes on Windows/XP using Micro Focus Net Express and the CMD file provided. |
| 2. | May be ported to run on the UNIX platforms supported by Micro Focus COBOL. |
| 3. | Executes on a mainframe with OS/390 or Windows/XP using Micro Focus Mainframe Express and the JCL file provided. |
This program will sequentially read the item master file and build a print line of text from the text fields and numeric fields that are packed and binary formats. Once the print line has been created it will be printed. It is actually written to a sequential file (spooling) that contains print control characters and data.
The following is a block diagram of the table processing demonstration. The BLUE boxes are unique to the mainframe and Micro Focus Mainframe Express. The RED boxes are unique to the PC with Windows and Micro Focus Net Express. The GREEN boxes are platform independent and will execute on the mainframe or a PC with Windows. Also, the GREEN boxes may be ported to a UNIX platform that is supported by Micro Focus COBOL.
|
|
The JCL or CMD member for running the application. | |||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
Delete any previously created SYSMEMO1 file. | |||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|
|
|
Read the Item Master file and create a price list report. | ||||||||||||||||||||||||||||||||||||||||||||||||
|
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||
|
Three command files are used to execute this example in the non-mainframe environment on a Windows platform with Micro Focus Net Express or Application Server. The first command file (Env1PROD.CMD) is used as a common, single point to set environment variables that are used across various applications or sample programs. The second command file (SimoNOTE.CMD) is used to display message to the screen and write to a log file. The third command file (NUMPRTE1.CMD) is used to map file names and execute the sample program.
The following Windows command file (Env1PROD.CMD) is used as a common, single point to set environment variables that are used across various applications or sample programs.
@echo off
rem * *******************************************************************
rem * This program is provided by: *
rem * SimoTime Enterprises, LLC *
rem * (C) Copyright 1987-2006 All Rights Reserved *
rem * Web Site URL: http://www.simotime.com *
rem * e-mail: helpdesk@simotime.com *
rem * *******************************************************************
rem *
rem * Text - Provide a single point to set commonly used environment variables.
rem * Author - SimoTime Enterprises
rem * Date - January 24, 1996
rem *
rem * Set the commonly used environment variables. This is used to provide
rem * a single point for managing the commonly used environment variables.
rem *
set BaseLib1=c:\Assist01\STX1
set syslog=%BaseLib1%\LOGS\SysLog01.TXT
set SimoNOTE=%BaseLib1%\LOGS\SysLog01.TXT
call SimoNOTE "Starting JobName Env1PROD.CMD"
set sysout=%BaseLib1%\LOGS\SYSOUTT1.TXT
rem *
set JobStatus=0000
call SimoNOTE "Finished JobName Env1PROD.CMD"
The following Windows command file (SimoNOTE.CMD) is used as display a message to the screen and write to a log file. The log file has a date and time stamp and may be used to track the success or failure of the execution of a command file.
@echo OFF rem * ******************************************************************* rem * This program is provided by: * rem * SimoTime Enterprises, LLC * rem * (C) Copyright 1987-2006 All Rights Reserved * rem * Web Site URL: http://www.simotime.com * rem * e-mail: helpdesk@simotime.com * rem * ******************************************************************* rem * rem * Text - Display message on screen and write to a log file. rem * Author - SimoTime Enterprises rem * rem * Display the message and write to the log file using ECHO. rem * The ~ causes the leading/trailing double-quotes to be removed. rem * if "%SimoNote%" == "" set SimoNote=c:\SimoLIBR\LOGS\SimoTime.LOG echo %date% %time% %~1>> %SimoNote% echo %~1
The following is the Windows CMD (NUMPRTE1.CMD) required to run the sample COBOL program. This is a two step job. The first step (identified by the :DeleteQSAM statement) will delete the file that was created from a previous run of this job. The second step (identified by the :CreateQSAM statement) will execute the sample program.
@echo OFF
REM * *******************************************************************
REM * This program is provided by: *
REM * SimoTime Enterprises, LLC *
REM * (C) Copyright 1987-2006 All Rights Reserved *
REM * Web Site URL: http://www.simotime.com *
REM * e-mail: helpdesk@simotime.com *
REM * *******************************************************************
REM *
REM * Text - Create a Sequential Data Set on disk using ECHO function.
REM * Author - SimoTime Enterprises
REM * Date - January 24, 1996
REM *
REM * The first job step (DeleteQSAM) will delete any previously created
REM * file.
REM *
REM * The second job step (CreateQSAM) will create a new file that shows
REM * the numbers converted to text strings. For this program to work
REM * the COBOL program must be compiled with the ASSIGN(EXTERNAL) and
REM * SEQUENTIAL(LINE) directives under Net Express.
REM *
REM * This set of programs will run on a Personal Computer with
REM * Windows and Micro Focus Net Express.
REM *
rem * ********************************************************************
rem * Step 1 of 2 Set the global environment variables,
rem * Delete any previously created file...
rem *
call Env1PROD
set JobStatus=0000
if "%SYSLOG%" == "" set syslog=%BaseLib1%\LOGS\SimoTime.LOG
rem *
SimoEXEC NOTE *******************************************************NumPrtE1
SimoEXEC NOTE Starting JobName NumPrtE1, User is %USERNAME%
SimoEXEC NOTE Identify JobStep DeleteQSAM
:DeleteQSAM
set ITEMMAST=%BaseLib1%\DataAsc1\ITEMASC1.DAT
set ITMPRINT=%BaseLib1%\DataWRK1\ITMPRINT.TXT
if exist %ITMPRINT% del %ITMPRINT%
REM *
REM * *******************************************************************
REM * Step 2 of 2 Print the Price List Report...
REM *
:CreateQSAM
SimoEXEC NOTE Identify JobStep CreateQSAM
SimoEXEC EXEC NumPrtC1
if ERRORLEVEL 1 echo Error level is equal-to or Greater-then 1 . . .
if ERRORLEVEL 1 set JobStatus=0020
if not "%JobStatus%" == "0000" goto :EojNOK
echo Error Level is 0 . . .
rem *
if exist %ITMPRINT% goto :EojAok
set JobStatus=0002
goto :EojNok
:EojAok
SimoEXEC NOTE Produced %ITMPRINT%
SimoEXEC NOTE Finished JobName NumPrtE1, Job Status is %JobStatus%
goto :End
:EojNok
SimoEXEC NOTE ABENDING JobName NumPrtE1, Job Status is %JobStatus%
:End
SimoEXEC NOTE Conclude SysLog is %SYSLOG%
if not "%1" == "nopause" pause
The following is the mainframe JCL (NUMPRTJ1.JCL) required to run the sample COBOL program. This is a two step job. The first step (identified by the //NUMPRTS1 statement) will delete the file that was created from a previous run of this job. The second step (identified by the //NUMPRTS2 statement) will execute the sample program.
The JOB and DD statements will need to be modified for different mainframe environments.
//NUMPRTJ1 JOB SIMOTIME,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2006 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Build print lines of text from packed and binary data. //* Author - SimoTime Enterprises //* Date - January 24, 1996 //* //* The job will show how to convert PACKED and BINARY fields to //* printable text fields. //* //* This set of programs will run on a mainframe under MVS or on a //* Personal Computer with Windows and Micro Focus Mainframe Express. //* or ES/MTO with the Batch Facility. //* //* ************ //* * NUMPRTJ1 * //* ********jcl* //* * //* ************ //* * IEFBR14 * //* ********utl* //* * //* ************ ************ ************ //* * ITEMMAST *-----* NUMPRTC1 *-----* ITMPRINT * //* ********dat* ********cbl* ********dat* //* * //* * //* ************ //* * EOJ * //* ************ //* //* ******************************************************************* //* Step 1 Delete any previously created file... //* //NUMPRTS1 EXEC PGM=IEFBR14 //DD1 DD DSN=SIMOTIME.DATA.ITMPRINT,DISP=(MOD,DELETE,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=133,DSORG=PS) //* //* ******************************************************************* //* Step 2 Read item master and write to price list file. //* //NUMPRTS2 EXEC PGM=NUMPRTC1 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //ITEMMAST DD DSN=SIMOTIME.DATA.ITEMEBC1,DISP=SHR //ITMPRINT DD DSN=SIMOTIME.DATA.ITMPRINT, // DISP=(NEW,CATLG,DELETE), // STORCLAS=MFI, // SPACE=(TRK,5), // DCB=(RECFM=FB,LRECL=133,DSORG=PS) //SYSOUT DD SYSOUT=* //
The following is the source code (NUMPRTC1.CBL) for the sample COBOL program.
IDENTIFICATION DIVISION.
PROGRAM-ID. NUMPRTC1.
AUTHOR. SIMOTIME ENTERPRISES.
*****************************************************************
* Copyright (C) 1987-2006 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 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: NUMPRTC1.CBL
*****************************************************************
*
* NUMPRTC1 - Print text and various numeric field formats.
*
* DESCRIPTION
* -----------
* This set of programs is used to show the various numeric
* formats and how to edit for printing.
*
* This program illustrates the use of some of the commonly
* used numeric formats such as 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. The filetype(11) and
* ADV directive will be required to maintain the mainframe print
* format for the output file.
*
* 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.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT ITEMMAST-FILE ASSIGN TO ITEMMAST
ORGANIZATION IS INDEXED
ACCESS MODE IS SEQUENTIAL
RECORD KEY IS ITEM-NUMBER
FILE STATUS IS ITEMMAST-STATUS.
SELECT ITMPRINT-FILE ASSIGN TO ITMPRINT
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS ITMPRINT-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD ITEMMAST-FILE
DATA RECORD IS ITEMMAST-REC.
COPY ITEMCB01.
FD ITMPRINT-FILE
DATA RECORD IS ITMPRINT-REC
.
01 ITMPRINT-REC.
05 ITMPRINT-DATA-01 PIC X(00132).
*****************************************************************
* This program was created using the SYSMASK1.TXT file as input.*
* The SYSMASK1 provides for the sequential reading of the input *
* file and the sequential writing of the output file. *
* *
* If the output file is indexed then the input file must be in *
* sequence by the field that will be used to provide the key *
* for the output file. *
* *
* If the key field is not in sequence then refer to SYSMASK2 *
* to provide for a random add or update of the indexed file. *
* *
* This program mask will have the ASCII/EBCDIC table inserted *
* for use by the /TRANSLATE function of SimoZAPS. *
* *
* For additional information contact SimoTime Enterprises. *
* *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* NUMPRTC1 '.
05 T2 pic X(34) value 'Sample Printing of Item File '.
05 T3 pic X(10) value 'v06.01.07 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* NUMPRTC1 '.
05 C2 pic X(20) value 'Created by SimoZAPS,'.
05 C3 pic X(20) value ' a utility package '.
05 C4 pic X(28) value 'of SimoTime Enterprises, LLC'.
01 ITEMMAST-STATUS.
05 ITEMMAST-STATUS-L pic X.
05 ITEMMAST-STATUS-R pic X.
01 ITEMMAST-EOF pic X value 'N'.
01 ITEMMAST-OPEN-FLAG pic X value 'C'.
01 ITMPRINT-STATUS.
05 ITMPRINT-STATUS-L pic X.
05 ITMPRINT-STATUS-R pic X.
01 ITMPRINT-EOF pic X value 'N'.
01 ITMPRINT-OPEN-FLAG pic X value 'C'.
*****************************************************************
* The following buffers are used to create a four-byte status *
* code that may be displayed. *
*****************************************************************
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 IO-STATUS-04.
05 IO-STATUS-0401 pic 9 value 0.
05 IO-STATUS-0403 pic 999 value 0.
01 TWO-BYTES-BINARY pic 9(4) BINARY.
01 TWO-BYTES-ALPHA redefines TWO-BYTES-BINARY.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
*****************************************************************
* Message Buffer used by the Z-DISPLAY-MESSAGE-TEXT routine. *
*****************************************************************
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* NUMPRTC1 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 PROGRAM-NAME pic X(8) value 'NUMPRTC1'.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 LINE-COUNT pic 9(5) value 66.
01 PRINT-HDR-1-LINE.
05 FILLER pic X(57) value SPACES.
05 FILLER pic X(17) value 'Item Master File'.
01 PRINT-HDR-2-LINE.
05 FILLER pic X(60) value SPACES.
05 FILLER pic X(10) value 'Price List'.
01 PRINT-HDR-3-LINE.
05 FILLER pic X(12) value ' Number'.
05 FILLER PIC X value SPACE.
05 FILLER pic X(11) value 'Description'.
05 FILLER PIC X(45) value SPACES.
05 FILLER pic X(11) value 'Price'.
05 FILLER PIC X value SPACE.
05 FILLER pic X(11) value 'Available'.
01 PRINT-DTL-1-LINE.
05 P-ITEM-NUMBER PIC X(12).
05 FILLER PIC X value SPACE.
05 P-ITEM-DESCRIPTION PIC X(48).
05 FILLER PIC X value SPACE.
05 P-ITEM-PRICE PIC Z,ZZZ,ZZZ.99-.
05 FILLER PIC X(6) value SPACE.
05 P-QTY-AVAILABLE PIC Z,ZZZ,ZZ9+.
01 ITEMMAST-TOTAL.
05 ITEMMAST-RDR pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for ITEMMAST'.
01 ITMPRINT-TOTAL.
05 ITMPRINT-ADD pic 9(9) value 0.
05 filler pic X(3) value ' - '.
05 filler pic X(23) value 'Line count for ITMPRINT'.
*****************************************************************
PROCEDURE DIVISION.
perform Z-POST-COPYRIGHT
perform ITEMMAST-OPEN
perform ITMPRINT-OPEN
perform until ITEMMAST-STATUS not = '00'
perform ITEMMAST-READ
if ITEMMAST-STATUS = '00'
if LINE-COUNT > 60
move SPACES to ITMPRINT-REC
move PRINT-HDR-1-LINE to ITMPRINT-REC
perform ITMPRINT-WRITE-HDR-1
move PRINT-HDR-2-LINE to ITMPRINT-REC
perform ITMPRINT-WRITE
move PRINT-HDR-3-LINE to ITMPRINT-REC
perform ITMPRINT-WRITE
add 3 to ZERO giving LINE-COUNT
end-if
add 1 to ITEMMAST-RDR
perform BUILD-PRINT-LINE
perform ITMPRINT-WRITE
if ITMPRINT-STATUS = '00'
add 1 to ITMPRINT-ADD
add 1 to LINE-COUNT
end-if
end-if
end-perform
move ITEMMAST-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITMPRINT-TOTAL to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
if APPL-EOF
move 'is Complete...' to MESSAGE-TEXT
else
move 'is ABENDING...' to MESSAGE-TEXT
end-if
perform Z-DISPLAY-MESSAGE-TEXT
perform ITMPRINT-CLOSE
perform ITEMMAST-CLOSE
GOBACK.
*****************************************************************
BUILD-PRINT-LINE.
*> TransCOPY...
move ITEM-NUMBER to P-ITEM-NUMBER
inspect P-ITEM-NUMBER replacing leading ZEROES by SPACE
move ITEM-DESCRIPTION to P-ITEM-DESCRIPTION
move ITEM-PRICE to P-ITEM-PRICE
subtract ITEM-QTY-ALLOCATED from ITEM-QTY-ONHAND
giving P-QTY-AVAILABLE
move SPACES to ITMPRINT-REC
move PRINT-DTL-1-LINE to ITMPRINT-REC
exit.
*****************************************************************
* I/O Routines for the INPUT File... *
*****************************************************************
ITEMMAST-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close ITEMMAST-FILE
if ITEMMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with ITEMMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITEMMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
ITEMMAST-READ.
read ITEMMAST-FILE
if ITEMMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if ITEMMAST-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if
if APPL-AOK
CONTINUE
else
if APPL-EOF
move 'Y' to ITEMMAST-EOF
else
move 'READ Failure with ITEMMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITEMMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
ITEMMAST-OPEN.
add 8 to ZERO giving APPL-RESULT.
open input ITEMMAST-FILE
if ITEMMAST-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to ITEMMAST-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with ITEMMAST' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITEMMAST-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* I/O Routines for the OUTPUT File... *
*****************************************************************
ITMPRINT-WRITE.
if ITMPRINT-OPEN-FLAG = 'C'
perform ITMPRINT-OPEN
end-if
write ITMPRINT-REC after advancing 1
if ITMPRINT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if ITMPRINT-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'WRITE Failure with ITMPRINT' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITMPRINT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
ITMPRINT-WRITE-HDR-1.
if ITMPRINT-OPEN-FLAG = 'C'
perform ITMPRINT-OPEN
end-if
write ITMPRINT-REC after advancing page
if ITMPRINT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if ITMPRINT-STATUS = '10'
add 16 to ZERO giving APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
end-if.
if APPL-AOK
CONTINUE
else
move 'WRITE Failure with ITMPRINT' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITMPRINT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
ITMPRINT-OPEN.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT ITMPRINT-FILE
if ITMPRINT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to ITMPRINT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with ITMPRINT' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITMPRINT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
ITMPRINT-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close ITMPRINT-FILE
if ITMPRINT-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'C' to ITMPRINT-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'CLOSE Failure with ITMPRINT' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move ITMPRINT-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-ROUTINES provide administrative functions *
* for this program. *
*****************************************************************
* ABEND the program, post a message to the console and issue *
* a STOP RUN. *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-MESSAGE-TEXT
end-if
move 'PROGRAM-IS-ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
add 12 to ZERO giving RETURN-CODE
STOP RUN.
* 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.
*****************************************************************
* Display the file status bytes. This routine will display as *
* four digits. If the full two byte file status is numeric it *
* will display as 00nn. If the 1st byte is a numeric nine (9) *
* the second byte will be treated as a binary number and will *
* display as 9nnn. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS not NUMERIC
or IO-STAT1 = '9'
move IO-STAT1 to IO-STATUS-04(1:1)
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-0403
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
else
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
move 'File Status is: nnnn' to MESSAGE-TEXT
move IO-STATUS-04 to MESSAGE-TEXT(17:4)
perform Z-DISPLAY-MESSAGE-TEXT
end-if
exit.
*****************************************************************
Z-POST-COPYRIGHT.
display SIM-TITLE
display SIM-COPYRIGHT
exit.
*****************************************************************
* This program was generated by SimoZAPS *
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
* *
* Generation Date: 2006-03-30 Generation Time: 13:39:08:07 *
*****************************************************************
This section provides a listing of the source code for the COBOL copy file used to define the record layout for the item master file.
*****************************************************************
* Copy File for Item Master File used by the Demo programs. *
* This is a VSAM Keyed=Sequential-Data-Set or Key-Indexed File. *
*****************************************************************
* Copyright (C) 1987-2005 SimoTime Enterprises *
* All Rights Reserved *
*****************************************************************
* Provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
01 ITEM-RECORD.
05 ITEM-NUMBER PIC X(12).
05 ITEM-DATA.
10 ITEM-DESCRIPTION PIC X(48).
10 ITEM-QTY-ONHAND PIC 9(7) COMP.
10 ITEM-QTY-ALLOCATED PIC 9(7) COMP.
10 ITEM-UNIT-OF-MEASURE PIC X(16).
10 ITEM-COST PIC S9(7)V9(2) COMP-3.
10 ITEM-PRICE PIC S9(7)V9(2) COMP-3.
10 ITEM-LADATE PIC X(8).
10 ITEM-LATIME PIC X(8).
10 ITEM-TOKEN PIC X(3).
10 ITEM-D-CODE-1 PIC A.
10 ITEM-D-PERCENT-1 PIC S9(3)V9(4).
10 ITEM-D-CODE-2 PIC A.
10 ITEM-D-PERCENT-2 PIC S9(3)V9(4).
10 ITEM-D-CODE-3 PIC A.
10 ITEM-D-PERCENT-3 PIC S9(3)V9(4).
10 ITEM-CATEGORY-CODE PIC 99.
10 ITEM-CATEGORY-DESC PIC X(32).
10 FILLER PIC X(341).
*! ITEMCB01 - End-of-Copy File...
The purpose of this document is to assist as a tutorial for new programmers or as a quick reference for experienced programmers. As always, it is the programmer's responsibility to thoroughly test all programs.
Permission to use, copy, modify and distribute this software for any commercial purpose requires a fee to be paid to SimoTime Enterprises. Once the fee is received by SimoTime the latest version of the software will be delivered and a license will be granted for use within an enterprise, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
Permission to use, copy, modify and distribute this software for a non-commercial purpose and without fee is hereby granted, provided the SimoTime copyright notice appear on all copies of the software. The SimoTime name or Logo may not be used in any advertising or publicity pertaining to the use of the software without the written permission of SimoTime Enterprises.
SimoTime Enterprises makes no warranty or representations about the suitability of the software for any purpose. It is provided "AS IS" without any express or implied warranty, including the implied warranties of merchantability, fitness for a particular purpose and non-infringement. SimoTime Enterprises shall not be liable for any direct, indirect, special or consequential damages resulting from the loss of use, data or projects, whether in an action of contract or tort, arising out of or in connection with the use or performance of this software.
You may download this example at http://www.simotime.com/sim4dzip.htm#COBOLNumericFieldPrint 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.
Check out The JCL Connection for more mainframe JCL examples.
Check out The SQL Connection for more examples of mainframe Relational Data Base management and accessing techniques with sample code.
Check out The VSAM - QSAM Connection for more examples of mainframe VSAM and QSAM accessing techniques and sample code.
This document provides a quick summary of the File Status Key for VSAM data sets and QSAM files.
The following chart provides a list of the sample COBOL programs that focus on processing numeric fields.
| HTML Tag | Description |
| cblnum01 | This is an example of how COBOL can test that a data field contains a valid numeric value. It also illustrates how to redefine a numeric field and then scan the field from left to right testing for a digit in each position. |
| cblraz01 | This suite of programs provides an example of a routine that will Right Adjust (or Right Justify) a text string within a numeric field and fill the left-most or high-order bytes with zeroes. |
| cbltxn01 | This suite of programs provides an example of how a COBOL program calls a COBOL routine to create a 150-character, English-oriented text data string from a 12-digit numeric field. For example, if the numeric field contains 000000001234 then a text string is created with the following information, One-Thousand-Two-Hundred-Thirty-Four |
| nbrtyp01 | This suite of example programs will describe the use, format and size of some of the commonly used numeric fields of the COBOL programming language. This example also illustrates how to redefine a numeric field and how to display the actual hexadecimal content of a numeric field. |
| number01 | This document is an introduction to the various numeric formats used by COBOL and the IBM mainframe systems The session will describe three of the popular numeric formats used with COBOL and IBM Mainframe systems. The discussions include further detail about the issues and concerns of unsigned (or implied positive) numbers, signed (positive or negative) numbers and decimal or whole numbers. A sample of how to convert non-print formats to display or print formats is included along with a sample COBOL program. |
| numbug01 | The challenge with this program is that it is expected to process the various numeric items in the same manner as the mainframe. For example, a zoned-decimal field that contains leading spaces should not cause an ABEND (i.e. 163 error on Micro Focus) but should treat the leading spaces as zeroes and complete the arithmetic calculation. However, a packed-decimal field that contains non-numeric values would issue a S0C7 (referred to as a sock-seven) on the mainframe and should issue a 163 error in the Micro Focus environment. |
| numprt01 | Printing numeric fields, especially packed-decimal or binary (i.e. COMP-3 or COMP) requires special consideration. Also, signed, zoned-decimal fields will require special consideration. Most numeric fields will require some sort of editing before printing. This suite of programs provides examples of how a COBOL program may be used to properly print (or display) numeric fields. |
To review all the information available on this site start at The SimoTime Home Page .
Check out The SimoTime Glossary for a list of terms and definitions used in the documents provided by SimoTime.
If you have any questions, suggestions or comments please call or send an e-mail to: helpdesk@simotime.com
Founded in 1987, SimoTime Enterprises is a privately owned, Limited Liability Corporation located in Novato, California. 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-2008 SimoTime Enterprises, LLC All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |