This sample program passes keys to CASSPOOL and writes the returned data to an output file.
identification division.
program-id. Program1.
environment division.
configuration section.
input-output section.
file-control.
SELECT ASCII-FILE
ASSIGN TO ASCII-DSN
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS ASCII-FILE-STATUS.
data division.
FILE SECTION.
FD ASCII-FILE
LABEL RECORDS STANDARD.
01 ASCII-DATA PIC X(80).
working-storage section.
01 ascii-file-status pic xx.
01 ascii-dsn pic x(250).
01 disp-rc pic 9999.
01 disp-rsn pic 9999.
01 disp-type pic 9.
01 disp-job-nbr pic 9(6).
01 directory-name pic x(260).
01 flags pic x(4) comp-5.
01 name-length pic x(4) comp-5.
01 status-code pic x(2) comp-5.
01 save-job-name pic x(8).
01 save-job-nbr pic x(4) comp-x.
01 pubcas-area.
copy "mfpubcas.cpy" replacing ==()== by ==pubcas==.
procedure division.
move '$outdir/output.txt' to ASCII-DSN
open output ascii-file
if ascii-file-status <> '00'
display 'open output failed ' ascii-file-status
goback
end-if
move 0 to flags
call "CBL_GET_CURRENT_DIR" using by value flags
by value name-length
by reference directory-name
returning status-code
perform get-messages *> type 6
perform get-o-hold *> type 7
perform get-ds-hold *> type 8
perform get-o-hold-type-jobname *> type 7 by job name
perform get-o-hold-type-create-date *> type 7 by date
perform o-spool-files-jobname *> type 8 and associated
*> type 10s
perform o-held-spool-files-jobname *> type 7 and associated
*> type 9s
display 'test prog ended '
goback.
o-held-spool-files-jobname section.
move spaces to ascii-data
perform write-outfile
move 'By Jobs with held output spool files ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type-job-name
to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-o-hold-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
*> loop through the type output records to find jobs with
*> output spool files
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-o-hold-78
*> for each o-hold record
*> print details
*> save key
*> get associated output spool records (ds-hold)
*> reposition for next o-hold record
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-job-name
delimited by size
',' delimited by size
pubcas-dat-time
delimited by size
into ascii-data
perform write-outfile
move pubcas-job-name to save-job-name
move pubcas-job-nbr to save-job-nbr
move low-values to pubcas-area
move 78-KEY-IS-job-NUMBER
to pubcas-key-id
move save-job-nbr to pubcas-job-nbr
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-job-nbr <> save-job-nbr
*> all the output spool files for this job
if pubcas-type = pubcas-ds-hold-78
move spaces to ascii-data
string
' ' delimited by size
pubcas-SYSOT-STEP-NAME delimited by size
',' delimited by size
pubcas-SYSOT-PSTP-NAME delimited by size
',' delimited by size
pubcas-SYSOT-DD-NAME delimited by size
into ascii-data
perform write-outfile
end-if
perform call-pubcas
end-perform
*> reposition on the next job name that has a type 8 record
move low-values to pubcas-area
move 78-KEY-IS-type-job-name
to pubcas-key-id
move pubcas-o-hold-78 to pubcas-type
move save-job-name to pubcas-job-name
move save-job-nbr to pubcas-job-nbr
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
*> get next next job
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
if pubcas-job-name = save-job-name
and
pubcas-job-nbr = save-job-nbr
*> STGT and GN gets the same type 8
*> record ( duplicate keys allowed )
*> so need a second GN to get the next record
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-if
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
o-spool-files-jobname section.
move spaces to ascii-data
perform write-outfile
move 'By Jobs with output spool files ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type-job-name
to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-out-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
*> loop through the type output records to find jobs with
*> output spool files
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-out-78
*> for each o-hold record
*> print details
*> save key
*> get associated output spool records (ds-hold)
*> reposition for next o-hold record
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-job-name
delimited by size
',' delimited by size
pubcas-dat-time
delimited by size
into ascii-data
perform write-outfile
move pubcas-job-name to save-job-name
move pubcas-job-nbr to save-job-nbr
move low-values to pubcas-area
move 78-KEY-IS-job-NUMBER
to pubcas-key-id
move save-job-nbr to pubcas-job-nbr
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-job-nbr <> save-job-nbr
*> all the output spool files for this job
if pubcas-type = pubcas-ds-out-78
move spaces to ascii-data
string
' ' delimited by size
pubcas-SYSOT-STEP-NAME delimited by size
',' delimited by size
pubcas-SYSOT-PSTP-NAME delimited by size
',' delimited by size
pubcas-SYSOT-DD-NAME delimited by size
into ascii-data
perform write-outfile
end-if
perform call-pubcas
end-perform
*> reposition on the next job name that has a type 8 record
move low-values to pubcas-area
move 78-KEY-IS-type-job-name
to pubcas-key-id
move pubcas-out-78 to pubcas-type
move save-job-name to pubcas-job-name
move save-job-nbr to pubcas-job-nbr
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
*> get next next job
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
if pubcas-job-name = save-job-name
and
pubcas-job-nbr = save-job-nbr
*> STGT and GN gets the same type 8
*> record ( duplicate keys allowed )
*> so need a second GN to get the next record
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-if
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
get-o-hold-type-create-date section.
move spaces to ascii-data
perform write-outfile
move 'By Type and Date - hold ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type-date
to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-o-hold-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-o-hold-78
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-job-name
delimited by size
',' delimited by size
pubcas-dat-time
delimited by size
into ascii-data
perform write-outfile
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
get-o-hold-type-jobname section.
move spaces to ascii-data
perform write-outfile
move 'By Type and Job Name - o-hold ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type-job-name
to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-o-hold-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-o-hold-78
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-job-name
delimited by size
',' delimited by size
pubcas-dat-time
delimited by size
into ascii-data
perform write-outfile
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
get-ds-out section.
move spaces to ascii-data
perform write-outfile
move 'By Type - ds-out ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-ds-out-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-o-hold-78
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-job-name delimited by size
into ascii-data
perform write-outfile
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
get-o-hold section.
move spaces to ascii-data
perform write-outfile
move 'By Type - o-hold ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-o-hold-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-o-hold-78
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-job-name delimited by size
',' delimited by size
pubcas-sysot-create-date
delimited by size
into ascii-data
perform write-outfile
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
get-ds-hold section.
move spaces to ascii-data
perform write-outfile
move 'By Type - ds-hold ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-ds-hold-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode > 8
or pubcas-type <> pubcas-ds-hold-78
move pubcas-type to disp-type
move pubcas-job-nbr to disp-job-nbr
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
disp-job-nbr delimited by size
',' delimited by size
pubcas-sysot-job-name
delimited by size
',' delimited by size
pubcas-sysot-step-name
delimited by size
',' delimited by size
pubcas-sysot-pstp-name
delimited by size
',' delimited by size
pubcas-sysot-dd-name
delimited by size
',' delimited by size
pubcas-sysot-create-date
delimited by size
into ascii-data
perform write-outfile
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
get-messages section.
move 'Messages ' to ascii-data
perform write-outfile
move low-values to pubcas-area
move 78-KEY-IS-type to pubcas-key-id
move 78-CAS-FUNC-OPEN to pubcas-func
perform call-pubcas
move pubcas-mesg-78 to pubcas-type
move 78-CAS-FUNC-STGT to pubcas-func
perform call-pubcas
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
perform until pubcas-retcode <> 0
or pubcas-type > pubcas-mesg-78
move pubcas-type to disp-type
if pubcas-msglg-mesg-length > 256
move 256 to pubcas-msglg-mesg-length
end-if
move spaces to ascii-data
string disp-type delimited by size
',' delimited by size
pubcas-msglg-mesg(1:pubcas-msglg-mesg-length)
delimited by size
into ascii-data
perform write-outfile
move 78-CAS-FUNC-GN to pubcas-func
perform call-pubcas
end-perform
move 78-CAS-FUNC-CLOS to pubcas-func
perform call-pubcas
exit section.
call-pubcas section.
call "mvscaspb" using pubcas-area
if pubcas-retcode > 8
move pubcas-RETCODE to disp-rc
move pubcas-RSNCODE to disp-rsn
display 'call failed func ' pubcas-func ','
disp-rc ',' disp-rsn
',' pubcas-file-status
goback
end-if
exit section.
write-outfile section.
write ASCII-DATA
if ascii-file-status <> '00'
display 'write output failed ' ascii-file-status
goback
end-if
exit section
end program Program1.