SimoPL80 - Eighty-Column Card File
http://www.simotime.com
|
|
Write to Line Sequential SimoPL80 - Eighty-Column Card File http://www.simotime.com |
| When technology complements business | Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
This document provides a listing of the COBOL source code for a callable routine that provide write access to a Line Sequential file. This program is included in the SimoCARD suite of programs.
Additional information about this program may be obtained by sending an e-mail to: helpdesk@simotime.com
The SimoPL80 program provides an easy to use, callable routin for accessing or writing records to a line sequential file with a maximum record length of 80-bytes.
The following is an example of how to initialize the pass area and then sequentially read records from the file. The Gx80 notation would be replaced with GR80 for Record Sequential files and GL80 for Line Sequential files.
move 'OPEN ' to PL80-FILE-REQUEST
move ZERO to PL80-FILE-STATUS
move SPACES to PL80-PASS-80
call 'SIMOPL80' using PL80-PASS-AREA
The following is an example of a call statement for the callable routine.
call 'SIMOPL80' using PL80-PASS-AREA
It is not necessary to do an explicit open of the file. The first call to the routine will open the file and write the first record. Subsequent calls will write a logical record from the buffer. The file status code is returned as a four-byte numeric value based on the results of the write request.
*****************************************************************
* Data Structure or Pass Area used for calling SIMOGT80. *
*****************************************************************
* Copyright (C) 1987-2006 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 PL80-PASS-AREA.
05 PL80-PASS-REQUEST PIC X(8).
05 PL80-PASS-STATUS PIC 9(4).
05 PL80-FILE-REQUEST PIC X(8).
05 PL80-FILE-STATUS PIC 9(4).
05 PL80-PASS-80 PIC X(80).
*! PASSPL80 - End-of-Copy File...
The following is a list of the parameters required when using the PL80-PASS-AREA to call the SimoPL80 routine.
| Parameter | Description | ||||||||
| PL80-PASS-REQUEST | This parameter must be provided by the calling program.
|
||||||||
| PL80-PASS-STATUS | A zero (0) value indicates a successful completion of the request. A non-zero value indicates the request could not be completed successfully. | ||||||||
| PL80-PASS-80 | This parameter will contain the logical record for a WRITE request. |
The following is the copy statement used in the LINKAGE section of the SIMOPL80 callable routine.
COPY PASSGL80.
The following are environment variables used by the SimoPL80 Write routine for Line Sequential files with a maximum record length of 80-bytes.
| Variable | Description |
| PUT080LS | This is the drive:directory\filename.ext for the output file. This
will map the DD name to the fully qualified PC file name. For
example: SET PUT080LS=C:\MYDIRECTORY\MYFILE.DAT |
The following is the COBOL Source Code.
IDENTIFICATION DIVISION.
PROGRAM-ID. SIMOPL80.
AUTHOR. SIMOTIME ENTERPRISES.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PUT080LS-FILE ASSIGN TO PUT080LS
ORGANIZATION IS LINE SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS PUT080LS-STATUS.
*****************************************************************
DATA DIVISION.
FILE SECTION.
FD PUT080LS-FILE
DATA RECORD IS PUT080LS-REC.
01 PUT080LS-REC.
05 PUT080LS-DATA-01 PIC X(80).
*****************************************************************
WORKING-STORAGE SECTION.
01 SIM-TITLE.
05 T1 pic X(11) value '* SIMOPL80 '.
05 T2 pic X(34) value 'Sequential 80 File I/O for Writes '.
05 T3 pic X(10) value 'v06.10.06 '.
05 T4 pic X(24) value ' http://www.simotime.com'.
01 SIM-COPYRIGHT.
05 C1 pic X(11) value '* SIMOPL80 '.
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 PUT080LS-STATUS.
05 PUT080LS-STATUS-L pic X.
05 PUT080LS-STATUS-R pic X.
01 PUT080LS-EOF pic X value 'N'.
01 PUT080LS-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 '* SIMOPL80 '.
05 MESSAGE-TEXT.
10 MESSAGE-TEXT-1 pic X(68) value SPACES.
10 MESSAGE-TEXT-2 pic X(188) value SPACES.
*****************************************************************
01 APPL-RESULT pic S9(9) comp.
88 APPL-AOK value 0.
88 APPL-EOF value 16.
01 READ-FLAGS.
05 READ-1 pic X value 'Y'.
05 READ-2 pic X value 'Y'.
01 DUMP-FLAGS.
05 DUMP-ASC pic X value 'Y'.
05 DUMP-EBC pic X value 'Y'.
05 DUMP-HEX pic X value 'Y'.
01 WORK-08 pic X(8) value SPACES.
01 ASC-EBC-FLAG pic X value 'A'.
01 FIRST-TIME pic X value 'Y'.
COPY ASCEBCB1.
COPY ASCEBCB2.
*****************************************************************
LINKAGE SECTION.
COPY PASSPL80.
*****************************************************************
PROCEDURE DIVISION using PL80-PASS-AREA.
move PL80-FILE-REQUEST to WORK-08
move 'A' to ASC-EBC-FLAG
evaluate WORK-08
when 'WRITE ' move PL80-PASS-80 to PUT080LS-DATA-01
perform PUT080LS-WRITE
when 'WRITEE2A' move PL80-PASS-80 to PUT080LS-DATA-01
inspect PUT080LS-DATA-01
converting E-INFO to A-INFO
perform PUT080LS-WRITE
when 'OPEN ' perform PUT080LS-OPEN-OUTPUT
when 'CLOSE ' perform PUT080LS-CLOSE
when other perform TRY-EBCDIC
end-evaluate
if PUT080LS-STATUS = '00'
move 0 to PL80-FILE-STATUS
else
add 4 to ZERO giving PL80-PASS-STATUS
end-if
if ASC-EBC-FLAG = 'E'
inspect PL80-PASS-STATUS converting A-INFO to E-INFO
inspect PL80-FILE-STATUS converting A-INFO to E-INFO
end-if
if FIRST-TIME = 'Y'
perform Z-POST-COPYRIGHT
display '* SimoPL80 ASC-EBC-FLAG is '
ASC-EBC-FLAG upon console
move 'N' to FIRST-TIME
end-if
GOBACK.
*****************************************************************
TRY-EBCDIC.
inspect WORK-08 converting E-INFO to A-INFO
evaluate WORK-08
when 'WRITE ' move 'E' to ASC-EBC-FLAG
move PL80-PASS-80 to PUT080LS-DATA-01
perform PUT080LS-WRITE
when 'WRITEE2A' move 'E' to ASC-EBC-FLAG
move PL80-PASS-80 to PUT080LS-DATA-01
inspect PUT080LS-DATA-01
converting E-INFO to A-INFO
perform PUT080LS-WRITE
when 'OPEN ' move 'E' to ASC-EBC-FLAG
perform PUT080LS-OPEN-OUTPUT
when 'CLOSE ' move 'E' to ASC-EBC-FLAG
perform PUT080LS-CLOSE
when other add 16 to ZERO giving PL80-PASS-STATUS
end-evaluate
exit.
*****************************************************************
* I/O Routines for the Control File... *
*****************************************************************
PUT080LS-CLOSE.
add 8 to ZERO giving APPL-RESULT.
close PUT080LS-FILE
if PUT080LS-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 PUT080LS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUT080LS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
exit.
*---------------------------------------------------------------*
PUT080LS-WRITE.
write PUT080LS-REC
if PUT080LS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
else
if PUT080LS-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 PUT080LS-EOF
else
move 'READ Failure with PUT080LS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUT080LS-STATUS to IO-STATUS
perform Z-DISPLAY-IO-STATUS
perform Z-ABEND-PROGRAM
end-if
end-if
exit.
*---------------------------------------------------------------*
PUT080LS-OPEN-OUTPUT.
add 8 to ZERO giving APPL-RESULT.
open output PUT080LS-FILE
if PUT080LS-STATUS = '00'
subtract APPL-RESULT from APPL-RESULT
move 'O' to PUT080LS-OPEN-FLAG
else
add 12 to ZERO giving APPL-RESULT
end-if
if APPL-AOK
CONTINUE
else
move 'OPEN Failure with PUT080LS' to MESSAGE-TEXT
perform Z-DISPLAY-MESSAGE-TEXT
move PUT080LS-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
move IO-STATUS-04 to PL80-FILE-STATUS
add 12 to ZERO giving RETURN-CODE
add 12 to ZERO giving PL80-PASS-STATUS
* GOBACK.
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 upon console
display SIM-COPYRIGHT upon console
exit.
*****************************************************************
* A product of SimoTime Enterprises *
* Our e-mail address is: helpdesk@simotime.com *
* Also, visit our Web Site at http://www.simotime.com *
*****************************************************************
The purpose of this document is to provide a COBOL Source member for viewing.
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 view the list of eighty-column access programs at http://www.simotime.com/simocard.htm.
You may view the complete list of SimoTime callable Modules or Driver Programs at http://www.simotime.com/simomods.htm.
This item will provide a link to an ASCII or EBCDIC translation table. A column for decimal, hexadecimal and binary is also included.
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 .
This link provides information about The Training Sessions and Self-Study Courses available from SimoTime Enterprises.
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
We appreciate your comments and feedback.
Founded in 1987, SimoTime Enterprises is a privately owned company. We specialize in the creation and deployment of business applications using new or existing technologies and services. We have a team of individuals that understand the broad range of technologies being used in today's environments. This includes the smallest thin client using the Internet and the very large mainframe systems. There is more to making the Internet work for your company's business than just having a nice looking WEB site. It is about combining the latest technologies and existing technologies with practical business experience. It's about the business of doing business and looking good in the process. Quite often, to reach larger markets or provide a higher level of service to existing customers it requires the newer Internet technologies to work in a complementary manner with existing corporate mainframe systems. Whether you want to use the Internet to expand into new market segments or as a delivery vehicle for existing business functions simply give us a call or check the web site at http://www.simotime.com
| Return-to-Top |
| Copyright © 1987-2010 SimoTime Enterprises All Rights Reserved |
| When technology complements business |
| http://www.simotime.com |