Simple Examples
| |
Special Printing Simple Examples |
| When technology complements business | Copyright © 1987-2012 SimoTime Enterprises All Rights Reserved |
| The SimoTime Home Page |
This suite of programs will describe a starting point for handling special print requirements that are sometimes used by mainframe applications that are being moved to a Windows System with Micro Focus Net Experss and Enterprise Server.
The source code, data sets and documentation are provided in a single zipped file called LRSPRT01.ZIP. This zipped file may be downloaded from the SimoTime Web site.
The following mainframe JCL (LRSPRTJ1.JCL) is used to
The following mainframe JCL (LRSPRTJ1.JCL) is used to execute a test program that calls the LRSPRTR1.CBL routine to write print information to a file.
//LRSPRTJ1 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2010 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Driver for testing the LRSPRTR1 Print Routine //* Author - SimoTime Enterprises //* Date - January 01, 1989 //* //* This set of programs illustrate the use a COBOL program to do //* emulation of print information to a SYSOUT spool file. //* //* ******************************************************************* //* Step 1 of 1 This is a single step job. //* //LRSPRTS1 EXEC PGM=LRSPRTC1 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //SYSOUT DD SYSOUT=* //*
The following mainframe JCL (LRSPRTJ2.JCL) is used to execute a test program that calls the LRSPRTR1.CBL routine to write print information to a file. When the program is finished it will use a special Micro Focus call to evoke a WIndows Command Script.
//LRSPRTJ2 JOB SIMOTIME,ACCOUNT,CLASS=1,MSGCLASS=0,NOTIFY=CSIP1 //* ******************************************************************* //* This program is provided by: * //* SimoTime Enterprises, LLC * //* (C) Copyright 1987-2010 All Rights Reserved * //* Web Site URL: http://www.simotime.com * //* e-mail: helpdesk@simotime.com * //* ******************************************************************* //* //* Text - Driver for testing the LRSPRTR1 Print Routine //* Author - SimoTime Enterprises //* Date - January 01, 1989 //* //* This set of programs illustrate the use a COBOL program to do //* emulation of print information to a SYSOUT spool file. The Test //* Driver program (LRSPRTC2.CBL) contains a special Micro Focus call //* to evoke a Windows Command script before going to End-of-Job. //* //* This special call could easily be moved to the "TERM" function in //* the callable routine (LRSPRTR1.CBL). //* //* ******************************************************************* //* Step 1 of 1 This is a single step job. //* //LRSPRTS1 EXEC PGM=LRSPRTC2 //STEPLIB DD DSN=SIMOTIME.DEMO.LOADLIB1,DISP=SHR //SYSOUT DD SYSOUT=* //*
WIP...
The following COBOL program (LRSPRTR1.JCL) is a callable routine that will write a text string to an emulated SYSOUT spool file. The name of the SYSOUT spool file is created dynamically from information in a configuration file (LRSTOKEN). This callable routine performs three functions.
| Function | Description |
| INIT | The initialization (INIT) function will read the LRSTOKEN file, build a PC file name for the emulated spool file and then open the emulated spool file. |
| PUT | The put (PUT) function will write a defined text string to the emulated spool file. |
| TERM | The terminate (TERM) function will close the emulated spool file. |
The following is a source listing for the callable routine.
$SET COPYEXT(CPY)
IDENTIFICATION DIVISION.
PROGRAM-ID. LRSPRTR1.
AUTHOR. LARRY SIMMONS.
*****************************************************************
* Source Member: LRSPRTR1.CBL
*****************************************************************
*
* LRSPRTR1 - Write record to an emulated SYSOUT file.
*
* CALLING PROTOCOL
* ----------------
* Use standard procedure to EXECUTE, RUN or ANIMATE.
*
* DESCRIPTION
* -----------
* This program will write a message to the LRSSPOOL file. The
* file name is dynamically created based on information in the
* LRSTOKEN file.
*
* REQUIREMENTS
* ------------
* The following directives are required to Compile (Micro Focus).
* ASSIGN(EXTERNAL) Map COBOL file name to externally defined name
* SEQUENTIAL(LINE) Treat COBOL SEQUENTIAL as a LINE SEQUENTIAL
* NOOPTIONAL-FILE The OPEN EXTEND file must exist or post error
*
* EXECUTION ENVIRONMENT
* ---------------------
* LRSTOKEN - An environment variable must be used to point to the
* token file.
* SET LRSTOKEN=d:\mydir\LRSTOKEN.TXT
* LRSSPOOL - The LRSSPOOL file name is dynamically created based
* on information in the LRSTOKEN file.
*
*****************************************************************
*
* MAINTENANCE
* -----------
* 1997/12/18 Simmons, Created program.
* 1997/12/18 Simmons, No changes to date.
*
*****************************************************************
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*****************************************************************
SELECT LRSTOKEN-FILE
ASSIGN to LRSTOKEN
ORGANIZATION is LINE SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is LRSTOKEN-STATUS.
SELECT LRSSPOOL-FILE
ASSIGN to LRSSPOOL
ORGANIZATION is LINE SEQUENTIAL
ACCESS MODE is SEQUENTIAL
FILE STATUS is LRSSPOOL-STATUS.
*****************************************************************
*
DATA DIVISION.
FILE SECTION.
*
*****************************************************************
FD LRSSPOOL-FILE
DATA RECORD IS LRSSPOOL-RECORD
RECORDING MODE is V
RECORD is VARYING in SIZE from 64 to 1024
DEPENDING ON MESSAGE-LENGTH.
01 LRSSPOOL-RECORD.
05 LRSSPOOL-DATA pic X(1024).
FD LRSTOKEN-FILE
DATA RECORD IS LRSTOKEN-RECORD.
01 LRSTOKEN-RECORD.
05 LRSTOKEN-REC-ID pic X(3).
05 LRSTOKEN-DATA pic X(1024).
*****************************************************************
WORKING-STORAGE SECTION.
01 LRSSPOOL-STATUS.
05 LRSSPOOL-STAT1 pic X.
05 LRSSPOOL-STAT2 pic X.
01 LRSTOKEN-STATUS.
05 LRSTOKEN-STAT1 pic X.
05 LRSTOKEN-STAT2 pic X.
01 IO-STATUS.
05 IO-STAT1 pic X.
05 IO-STAT2 pic X.
01 TWO-BYTES.
05 TWO-BYTES-LEFT pic X.
05 TWO-BYTES-RIGHT pic X.
01 TWO-BYTES-BINARY redefines TWO-BYTES pic 9(4) comp.
01 IO-STATUS-04.
05 IO-STATUS-04-B1 pic 9.
05 IO-STATUS-04-B3 pic 9(3).
01 LRSSPOOL-OPEN-FLAG pic X value 'N'.
01 LRSTOKEN-OPEN-FLAG pic X value 'N'.
01 LRSTOKEN-EOF pic X value 'N'.
01 WRKTOKEN-01R-RECORD.
05 WRKTOKEN-REC-ID-01 pic X(3).
05 WRKTOKEN-FILE-NAME.
10 WRK-TOKEN-PREFIX pic X.
10 WRKTOKEN-NUMBER pic 9(7).
05 FILLER pic X(1016).
01 WRKTOKEN-02R-RECORD.
05 WRKTOKEN-REC-ID-02 pic X(3).
05 WRKTOKEN-DIR-NAME pic X(1021).
01 FIRST-TIME pic X value 'Y'.
01 MESSAGE-BUFFER.
05 MESSAGE-HEADER pic X(11) value '* LRSPRTR1 '.
05 MESSAGE-TEXT pic X(68).
01 MESSAGE-LENGTH pic 9(4) value 1024.
01 ENV-VAR-NAME pic X(16) value SPACES.
01 ENV-VAR-VALUE pic X(256) value SPACES.
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
*****************************************************************
LINKAGE SECTION.
COPY LRS256B1.
*****************************************************************
PROCEDURE DIVISION using LRS256-BUFFER.
move '0008' to LRS256-RESPOND
move '0000' to IO-STATUS-04
evaluate LRS256-REQUEST
when 'INIT' perform ACTION-INIT
when 'PUT ' perform ACTION-PUT
when 'TERM' perform ACTION-TERM
when OTHER perform ACTION-ABEND
end-evaluate
if APPL-AOK
move RETURN-CODE to LRS256-RESPOND
else
move '0000' to LRS256-RESPOND
end-if
GOBACK.
*****************************************************************
ACTION-INIT.
perform LRSTOKEN-OPEN-UPDATE
perform LRSTOKEN-READ
if LRSTOKEN-REC-ID = '01R'
move LRSTOKEN-RECORD to WRKTOKEN-01R-RECORD
add 1 to WRKTOKEN-NUMBER
move WRKTOKEN-FILE-NAME to LRS256-DD-NAME
move WRKTOKEN-01R-RECORD to LRSTOKEN-RECORD
perform LRSTOKEN-REWRITE
end-if
perform LRSTOKEN-READ
if LRSTOKEN-REC-ID = '02R'
move LRSTOKEN-RECORD to WRKTOKEN-02R-RECORD
inspect WRKTOKEN-DIR-NAME replacing first '\ ' by ' '
inspect WRKTOKEN-DIR-NAME replacing first ' ' by '\ '
end-if
perform LRSTOKEN-CLOSE
move 'LRSSPOOL' to ENV-VAR-NAME
move WRKTOKEN-DIR-NAME to ENV-VAR-VALUE
inspect ENV-VAR-VALUE replacing first ' '
by WRKTOKEN-FILE-NAME
inspect ENV-VAR-VALUE replacing first ' ' by '.TXT'
perform ENVIRONMENT-VARIABLE-SET
perform LRSSPOOL-OPEN-OUTPUT
exit.
*****************************************************************
ACTION-PUT.
move LRS256-DATA(1:133) to LRSSPOOL-DATA
perform LRSSPOOL-WRITE
exit.
*****************************************************************
ACTION-TERM.
perform LRSSPOOL-CLOSE
exit.
*****************************************************************
ACTION-ABEND.
exit.
*****************************************************************
* Set an environment variable.
*****************************************************************
ENVIRONMENT-VARIABLE-SET.
display ENV-VAR-NAME upon ENVIRONMENT-NAME
on exception add 4 to ZERO giving RETURN-CODE
end-display
display ENV-VAR-VALUE upon ENVIRONMENT-VALUE
on exception add 4 to ZERO giving RETURN-CODE
end-display
exit.
*****************************************************************
* I/O ROUTINES
*****************************************************************
LRSSPOOL-WRITE.
if MESSAGE-LENGTH > 1051
add 1024 to MESSAGE-LENGTH giving MESSAGE-LENGTH
end-if
if MESSAGE-LENGTH < 64
add 64 to MESSAGE-LENGTH giving MESSAGE-LENGTH
end-if
write LRSSPOOL-RECORD.
if LRSSPOOL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if LRSSPOOL-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 'FAILED-WRITE, Log file, LRSSPOOL' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSSPOOL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
LRSSPOOL-OPEN-OUTPUT.
add 8 to ZERO giving APPL-RESULT.
open OUTPUT LRSSPOOL-FILE
if LRSSPOOL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'Y' to LRSSPOOL-OPEN-FLAG
else
add 16 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'FAILED-OPEN, Log file, LRSSPOOL' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSSPOOL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
LRSSPOOL-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close LRSSPOOL-FILE
if LRSSPOOL-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'FAILED-CLOSE, Log file, LRSSPOOL' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSSPOOL-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
LRSTOKEN-READ.
read LRSTOKEN-FILE
if LRSTOKEN-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if LRSTOKEN-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 LRSTOKEN-EOF
else
move 'READ Failure with LRSTOKEN' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSTOKEN-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
LRSTOKEN-REWRITE.
if MESSAGE-LENGTH > 1024
add 1024 to MESSAGE-LENGTH giving MESSAGE-LENGTH
end-if
if MESSAGE-LENGTH < 64
add 64 to MESSAGE-LENGTH giving MESSAGE-LENGTH
end-if
rewrite LRSTOKEN-RECORD.
if LRSTOKEN-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if LRSTOKEN-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 'FAILED-WRITE, Log file, LRSTOKEN' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSTOKEN-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
LRSTOKEN-OPEN-UPDATE.
add 8 to ZERO giving APPL-RESULT.
open I-O LRSTOKEN-FILE
if LRSTOKEN-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'Y' to LRSTOKEN-OPEN-FLAG
else
move 'LRSTOKEN, Open as output file' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
open output LRSTOKEN-FILE
if LRSTOKEN-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'Y' to LRSTOKEN-OPEN-FLAG
end-if
end-if
if APPL-AOK
CONTINUE
else
move 'FAILED-OPEN, Log file, LRSTOKEN' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSTOKEN-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
LRSTOKEN-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close LRSTOKEN-FILE
if LRSTOKEN-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'FAILED-CLOSE, Log file, LRSTOKEN' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
move LRSTOKEN-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
* perform Z-ABEND-PROGRAM
end-if
exit.
*****************************************************************
* The following Z-Routines perform administrative functions *
* for this program. *
*****************************************************************
*****************************************************************
* ABEND the program and return to caller... *
*****************************************************************
Z-ABEND-PROGRAM.
if MESSAGE-TEXT not = SPACES
perform Z-DISPLAY-CONSOLE-MESSAGE
end-if
move 'Writing to log file is ABENDING...' to MESSAGE-TEXT
perform Z-DISPLAY-CONSOLE-MESSAGE
add 12 to ZERO giving RETURN-CODE
GOBACK.
*****************************************************************
* Display the file status bytes. This routine will display as *
* two digits if the full two byte file status is numeric. If *
* second byte is non-numeric then it will be treated as a *
* binary number. *
*****************************************************************
Z-DISPLAY-IO-STATUS.
if IO-STATUS NUMERIC
move '0000' to IO-STATUS-04
move IO-STATUS to IO-STATUS-04(3:2)
else
subtract TWO-BYTES-BINARY from TWO-BYTES-BINARY
move IO-STAT2 to TWO-BYTES-RIGHT
move IO-STAT1 to IO-STATUS-04-B1
add TWO-BYTES-BINARY to ZERO giving IO-STATUS-04-B3
end-if
display '* FILE-STATUS-' IO-STATUS-04 upon console
exit.
*****************************************************************
* Display a message generated by this program. *
*****************************************************************
Z-DISPLAY-CONSOLE-MESSAGE.
display MESSAGE-BUFFER upon console
move SPACES to MESSAGE-TEXT
exit.
*****************************************************************
* This example is provided by SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
WIP...
WIP...
The following COBOL Copy File (LRS256B1.CPY) is used to define the pass area when calling the SYSOUT spool emulation routine.
*****************************************************************
* Copy File for a Data Buffer of 256 Bytes. *
*****************************************************************
* This copy file is used as a model or starting point to call a
* program that will interface with the VPSX Printing Software
* that may be used in a complementary manner with Micro Focus
* Enterprise Server and the Mainframe Transaction Option or
* ES/MTO.
*
01 LRS256-BUFFER.
05 LRS256-REQUEST PIC X(4).
05 LRS256-RESPOND PIC X(4).
05 LRS256-DATA PIC X(256).
05 LRS256-DD-NAME pic X(8).
*! LRS256B1 - End-of-Copy File...
The following mainframe JCL (LRSPRTJ1.JCL) is used to
The following shows the contents of the configuration file (LRSTOKEN.TXT). This is an ASCII/Text (or Line Sequential) file.
01RS0000000 02RC:\SimoSam1\DataLibA\Lrs1
To map the eight (8) byte DD name used in the callable routine (LRSPRTR1.CBL) to a fully qualified Windows File Name requires an environment variable The followng is a sample set statement.
SET LRSTOKEN=d:\mydirname\lrstoken.txt
The following shows the Micro Focus Compiler directives used when compiling the sample COBOL programs.
DIALECT"MF" CHARSET"ASCII" ASSIGN"EXTERNAL" IBMCOMP NOTRUNC NOOPTIONAL-FILE OUTDD"SYSOUT,121,R" SHARE-OUTDD RTNCODE-SIZE"2"
The purpose of this suite of programs is to provide a starting point for handling special print requirements that are sometimes used by mainframe applications that are being moved to a Windos System with Micro Focus Net Experss with Enterprise Server.
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.
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 at http://www.simotime.com/sim4dzip.htm#zpacklrsprt01 or view the complete list of SimoTime Examples at http://www.simotime.com/sim4dzip.htm .
This document provides a quick summary of the File Status Key for VSAM data sets and QSAM files.
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 company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Copyright © 1987-2012 SimoTime Enterprises All Rights Reserved |
| When technology complements business |