This sample program uses an input file to identify the catalog and to pass functions, dataset names, and member names. It also writes an output file containing the information retrieved from the catalog.
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTCNTL.
AUTHOR. MICRO FOCUS LTD.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*-----------------------------------------------------------
SELECT INFILE
ASSIGN TO IN-DSN
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS IN-STATUS.
SELECT OUTFILE
ASSIGN TO OUT-DSN
ORGANIZATION IS LINE SEQUENTIAL
FILE STATUS OUT-STATUS.
*-----------------------------------------------------------
DATA DIVISION.
FILE SECTION.
FD INFILE
LABEL RECORDS STANDARD.
01 IN-REC.
03 IN-COL1 PIC x.
03 IN-FUNC PIC x(4).
03 FILLER PIC x(4).
03 IN-DSNAME PIC x(44).
03 FILLER PIC x.
03 IN-MEMBER PIC x(8).
03 FILLER PIC x(18).
FD OUTFILE
LABEL RECORDS STANDARD.
01 OUT-REC PIC X(500).
working-storage section.
01 IN-status pic X(2).
01 IN-dsn pic x(260).
01 OUT-status pic X(2).
01 OUT-dsn pic x(260).
01 IN-REC-LEN pic x(4) comp-x.
01 ws-mfsyscat pic x(255) value spaces.
*---------------------------------------------------------------
01 rec-type pic x(8).
01 field-name pic x(15).
01 field-value pic x(50).
01 field-value-len pic xx comp-x.
01 input-record-len pic xx comp-x.
01 string-start pic xx comp-x.
01 string-len pic xx comp-x.
01 ix pic xx comp-x.
*----------------------------------------------------------------
01 disp-retcode pic 9(6).
01 disp-rsncode pic 9(6).
01 disp-lrecl pic 9(6).
01 mvscatpb-pp procedure-pointer.
01 mvscatio-pp procedure-pointer.
*----------------------------------------------------------------
* parse catalog api fields
*---------------------------------------------------------------
01 CMD-PROCESSOR-PARM.
10 CP-PARM-LEN PIC 9(04) COMP.
10 CP-PARM-STR PIC X(4096).
*----------------------------------------------------------------
* public catalog api fields
*---------------------------------------------------------------
01 PUBCAT-AREA.
copy 'mfpubcat.cpy' replacing ==()== by ==WS==.
linkage section.
procedure division.
perform init-rtn
perform main-process
perform end-rtn
goback.
init-rtn section.
set mvscatpb-pp to entry 'MVSCATPB'
set mvscatio-pp to entry 'MVSCATIO'
move length of in-rec to in-rec-len
move 'd:\visualstudio2010\projects\testcat\infile.dat'
to in-dsn
move 'd:\visualstudio2010\projects\testcat\outfile.dat'
to out-dsn
perform open-infile
perform open-outfile
exit section.
main-process section.
perform read-infile
perform until in-status <> '00'
evaluate in-rec (1:1)
when '*'
continue *> comment
when space
move low-values to pubcat-area
move in-func to ws-func
move in-dsname to ws-dsname
move in-member to ws-member
perform call-pub-api
perform build-string
perform write-outfile
when 'C'
perform set-mfsyscat
end-evaluate
perform read-infile
end-perform
exit section.
set-mfsyscat section.
move in-rec (2:79) to ws-mfsyscat
DISPLAY 'MFSYSCAT' UPON ENVIRONMENT-NAME
DISPLAY ws-mfsyscat UPON ENVIRONMENT-VALUE
exit section.
call-pub-api section.
call 'mvscatpb' using pubcat-area
exit section.
build-string section.
move spaces to out-rec
move ws-rsncode to disp-rsncode
move ws-retcode to disp-retcode
move ws-lrecl to disp-lrecl
string
' return code ' delimited by size
disp-retcode delimited by size
' reason code ' delimited by size
disp-rsncode delimited by size
' dsname ' delimited by size
ws-dsname delimited by spaces
' member ' delimited by size
ws-member delimited by spaces
' dsorg ' delimited by size
ws-dsorg delimited by size
' recfm ' delimited by size
ws-recfm delimited by size
' lrecl ' delimited by size
disp-lrecl delimited by size
into out-rec
exit section.
end-rtn section.
close infile
close outfile
exit section.
*----------------------------------------------------------------
* routines for accessing the files
*----------------------------------------------------------------
open-infile section.
open input infile
evaluate in-status
when '00'
continue
when other
DISPLAY 'OPEN infile FAILED '
in-status
goback
end-evaluate
exit section.
open-outfile section.
open output outfile
evaluate out-status
when '00'
continue
when other
DISPLAY 'OPEN outfile FAILED '
out-status
goback
end-evaluate
exit section.
read-infile section.
read infile
evaluate in-status
when '00'
when '10'
continue
when other
DISPLAY 'read infile FAILED '
out-status
goback
end-evaluate
exit section.
write-outfile section.
write out-rec
evaluate out-status
when '00'
continue
when other
DISPLAY 'write outfile FAILED '
out-status
goback
end-evaluate
exit section.
error-rtn section.
continue
exit section.