APIs, user spaces, etc.
From MidrangeWiki
Summary
Here's a sample of using an API which outputs to a user space in COBOL. This example lists and processes members in a file. Error handling would need to be coded.
You can either use your own definition for the APIs or the definition in the QSYSINC library. I generally use my own because I can tailor defaults for our environment. YMMV (Your Mileage May Vary). In our shop, we keep our definitions of the API interfaces in copy members. In the example below, I have included the actual code for the complete picture.
Working-storage section.
*
* API error code parameter
*
01 API-errors.
05 API-error-length pic 9(8) binary
value 16.
88 Return-error-code-only value 16.
88 Return-exception-data-132 value 148.
05 Error-length pic 9(8) binary.
88 API-processed-okay value 0.
05 Error-ID pic x(7).
05 filler pic x(1).
05 Exception-data pic x(132).
*
* User space APIs
01 User-space-api.
05 User-space-name.
10 Space-name pic x(10) value spaces.
10 Space-library pic x(10) value 'QTEMP'.
05 User-space-attribute pic x(10) value spaces.
05 Initial-size pic 9(8) binary
value 11100.
05 Initial-value pic x value X'00'.
05 Public-authority pic x(10) value '*ALL'.
05 Space-text pic x(50) value spaces.
05 Replace-space pic x(10) value '*YES'.
77 User-space-pointer pointer.
*
* Member list
01 Member-list-api.
05 User-space-name.
10 Space-name pic x(10) value spaces.
10 Space-library pic x(10) value 'QTEMP'.
05 Member-list-format pic x(8) value 'MBRL0200'.
05 Member-list-file.
10 Member-list-file-name
pic x(10) value spaces.
10 Member-list-library pic x(10) value '*LIBL'.
05 Members-to-list pic x(10) value '*ALL'.
05 Member-list-overrides pic x value '0'.
88 Member-list-ignore-ovrdbf value '0'.
88 Member-list-use-ovrdbf value '1'.
05 Member-list-return-header.
10 File-name-used pic x(10).
10 File-library-used pic x(10).
10 File-attribute pic x(10).
10 Text-description pic x(10).
10 Number-of-members pic s9(8) binary.
10 File-type pic x.
88 Data-file value '0'.
88 Source-file value '1'.
01 List-entry-address pointer.
*
* Member Description API
*
01 Member-desc-api.
05 QUSRMBRD pic x(10) value 'QUSRMBRD'.
05 Member-data.
10 Returned-bytes pic 9(8) binary. Rtn B
10 Available-bytes pic 9(8) binary. Avail B
10 Return-file pic x(10). DBF Name
10 Return-library pic x(10). DBF Lib
10 Return-member pic x(10). Member
10 File-attributes pic x(10). File Atr
10 Source-type pic x(10). Src Type
10 Date-added pic x(13). Crt DS
10 Date-changed pic x(13). SrcChgDS
10 Member-text pic x(50). Descript
10 Source-file pic x. Src File
10 Remote-file pic x. Rmt File
10 File-type pic x. LF / PF
10 ODP-sharing pic x. ODP Shr
10 filler pic xx. *Rsrvd*
10 Number-of-records pic 9(8) binary.
10 Deleted-records pic 9(8) binary.
10 Data-space-size pic 9(8) binary.
10 Access-path-size pic 9(8) binary.
10 Based-on-members pic 9(8) binary.
10 Change-timestamp pic x(13).
10 Save-timestamp pic x(13).
10 Restore-timestamp pic x(13).
10 Expiration-date pic x(7).
10 filler pic x(6).
10 Number-days-used pic 9(8) binary.
10 Date-last-used pic x(7).
10 Use-reset-date pic x(7).
10 filler pic xx.
10 DS-size-multiplier pic 9(8) binary.
10 AP-size-multiplier pic 9(8) binary.
10 Description-CCSID pic 9(8) binary.
10 Offset-to-MBRD0200 pic 9(8) binary.
10 Length-of-MBRD0200 pic 9(8) binary.
10 Nbr-rcds-all-mbrs pic 9(8) binary.
10 Nbr-deleted-recds pic 9(8) binary.
10 filler pic x(6).
05 Return-length pic 9(8) binary value 144.
88 Number-of-records-length value 144.
88 MBRD0100-length value 134.
88 MBRD0200-length value 265.
05 Format-name pic x(8) value 'MBRD0200'.
88 MBRD0100-format value 'MBRD0100'.
88 MBRD0200-format value 'MBRD0200'.
05 Qual-file-name.
10 Work-file pic x(10).
10 Work-library pic x(10).
05 Member-name pic x(10) value '*FIRST'.
05 Override-processing pic x.
88 Ignore-overrides value '0'.
88 Process-overrides value '1'.
Linkage section.
01 File-parm.
05 File-name-parm pic x(10).
05 Library-name-parm pic x(10).
* Record lock handling
copy UTBLSRLCK.
* Generic list API header structure
01 List-header-info.
05 f pic x(124).
05 Offset-to-list-data pic 9(8) binary.
05 Size-of-list-data pic 9(8) binary.
05 Number-of-entries pic 9(8) binary.
05 Size-of-list-entry pic 9(8) binary.
* Member list API entry format
01 MBR0200-data-format.
05 Member-name pic x(10).
05 Source-type pic x(10).
05 Member-date-and-time.
10 Member-date pic 9(6) display.
10 Member-time pic 9(7) display.
05 Source-change-date-and-time.
10 Change-date pic 9(6) display.
10 Change-time pic 9(7) display.
05 Member-text pic x(50).
05 Member-text-ccsid pic 9(8) binary.
Procedure Division
using File-parm
.
0000-Begin-here.
perform 0010-Initialization
if Number-of-entries > 0
perform 1000-Build-member-list
end-if
perform 0500-Wrap-up
goback
.
0010-Initialization.
move 'MBRLIST' to Space-name of User-space-api
move 'List of inventory sheet sequence members'
to Space-text of User-space-api
call 'QUSCRTUS'
using User-space-name of User-space-api
User-space-attribute of User-space-api
Initial-size
Initial-value
Public-authority
Space-text
Replace-space
API-errors
end-call
move File-parm to Member-list-file
call 'QUSLMBR'
using User-space-name of User-space-api
Member-list-format
Member-list-file
Members-to-list
Member-list-overrides
Api-errors
end-call
call 'QUSPTRUS'
using User-space-name of User-space-api
User-space-pointer
Api-errors
end-call
set address of List-header-info to User-space-pointer
.
0500-Wrap-up.
* Do any clean-up processing needed here
* In this example the user space is created in QTEMP so it will go away at the
* end of the job. Perhaps files could be closed, etc.
.
1000-Build-member-list.
set List-entry-address to User-space-pointer
set List-entry-address up by Offset-to-list-data
move zero to Subfile-rrn
perform Number-of-entries times
set address of MBR0200-data-format to List-entry-address
move File-name to Qual-file-name of Member-desc-api
move Member-name of MBR0200-data-format
to Member-name of Member-desc-api
*********************************************************
* More processing would be done here
*********************************************************
set List-entry-address up by Size-of-list-entry
end-perform
.
