Troubleshooting
Problem
This document contains an example of having two subfiles on the same display.
Resolving The Problem
This is an example of having two subfiles on the same display. This example loads all of the records from the database file into the subfile. If the database is large and you would be loading more than a couple of pages of data into the subfile, consider loading the subfile one page at a time.
Database File Source:
R SUBREC
FNAME 10
FADD 20
FCODE 5
FSEX 1
K FNAME
Display File Source:
A DSPSIZ(24 80 *DS3)
A CF03(03 'F3=Exit')
A CF04(04 'F4=Prompt')
A INDARA
*
A R SUBSFL1 SFL
A FNAME R O 5 12REFFLD(SUBREC/FNAME *LIBL/SUBPF)
A FADD R O 5 47REFFLD(SUBREC/FADD *LIBL/SUBPF)
A FCODE R O 5 3REFFLD(SUBREC/FCODE *LIBL/SUBPF)
*
A R SUBCTL1 SFLCTL(SUBSFL1)
A OVERLAY
A 30 SFLDSP
A 31 SFLDSPCTL
A 32 SFLCLR
A 33 SFLEND
A SFLSIZ(0009)
A SFLPAG(0008)
A SFLCSRRRN(&RRCD1)
A 2 30'Subfile Of Males'
A DSPATR(HI)
A 2 69DATE
A EDTCDE(Y)
A DSPATR(HI)
A 4 12'Customer Name'
A COLOR(BLU)
A 4 47'Customer Address'
A COLOR(BLU)
A 4 3'Number'
A COLOR(BLU)
A RECNO1 3S 0H SFLRCDNBR
A RRCD1 5S 0H
*
A R SUBSFL2 SFL
A FNAME R O 17 12REFFLD(SUBREC/FNAME *LIBL/SUBPF)
A FADD R O 17 47REFFLD(SUBREC/FADD *LIBL/SUBPF)
A FCODE R O 17 3REFFLD(SUBREC/FCODE *LIBL/SUBPF)
*
A R SUBCTL2 SFLCTL(SUBSFL2)
A OVERLAY
A 40 SFLDSP
A 41 SFLDSPCTL
A 42 SFLCLR
A 43 SFLEND
A SFLSIZ(0007)
A SFLPAG(0006)
A SFLCSRRRN(&RRCD2)
A 14 30'Subfile Of Females'
A DSPATR(HI)
A 16 12'Customer Name'
A COLOR(BLU)
A 16 47'Customer Address'
A COLOR(BLU)
A 16 3'Number'
A COLOR(BLU)
A RECNO2 3S 0H SFLRCDNBR
A RRCD2 5S 0H
OPM COBOL Source:
IDENTIFICATION DIVISION.
PROGRAM-ID. SUBFCBLT.
INSTALLATION.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SCRFILE ASSIGN TO WORKSTATION-SUBFTWO-SI
ORGANIZATION IS TRANSACTION
ACCESS IS DYNAMIC
RELATIVE KEY IS RECNUM
FILE STATUS IS W3-FILE-STAT.
*
SELECT DBFILE ASSIGN TO DATABASE-SUBPF
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
FILE STATUS IS W3-FILE-STAT.
*
DATA DIVISION.
FILE SECTION.
FD SCRFILE
LABEL RECORDS ARE OMITTED
DATA RECORD IS SCRREC.
01 SCRREC PIC X(86).
*
FD DBFILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS DBREC.
01 DBREC.
COPY DDS-ALL-FORMATS OF SUBPF.
*
WORKING-STORAGE SECTION.
01 W2-INDARA.
03 IN03 PIC 1 INDIC 03.
* EXIT PROGRAM
03 IN30 PIC 1 INDIC 30.
* SUBFILE1 DISPLAY
03 IN31 PIC 1 INDIC 31.
* SUBFILE1 CONTROL
03 IN32 PIC 1 INDIC 32.
* SUBFILE1 CLEAR
03 IN33 PIC 1 INDIC 33.
* SUBFILE1 END
03 IN40 PIC 1 INDIC 40.
* SUBFILE2 DISPLAY
03 IN41 PIC 1 INDIC 41.
* SUBFILE2 CONTROL
03 IN42 PIC 1 INDIC 42.
* SUBFILE2 CLEAR
03 IN43 PIC 1 INDIC 43.
* SUBFILE2 END
*
01 W3-GENERAL.
03 W3-FILE-STAT PIC XX.
03 RECNUM PIC 9(3) VALUE ZEROES.
*
01 W5-SWITCHES.
03 W5-TURN-ON PIC 1 VALUE B"1".
03 W5-TURN-OFF PIC 1 VALUE B"0".
*
01 W9-SCREEN-DATA.
COPY DDS-SUBSFL1-I OF SUBFTWO.
COPY DDS-SUBSFL1-O OF SUBFTWO.
COPY DDS-SUBCTL1-O OF SUBFTWO.
COPY DDS-SUBSFL2-I OF SUBFTWO.
COPY DDS-SUBSFL2-O OF SUBFTWO.
COPY DDS-SUBCTL2-O OF SUBFTWO.
*
PROCEDURE DIVISION.
DECLARATIVES.
FILE-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON SCRFILE
DBFILE.
END DECLARATIVES.
*
MAIN-LINE SECTION.
0000.
PERFORM A-INIT.
PERFORM B-MAIN.
PERFORM X-CLOSE.
9999.
STOP RUN.
*
A-INIT SECTION.
A-100.
OPEN I-O SCRFILE
DBFILE.
INITIALIZE SCRREC.
*
A-999.
EXIT.
*
B-MAIN SECTION.
B-100.
PERFORM BA-CLEAR-SUBFILE.
PERFORM BB-FILL-SUBFILE.
MOVE W5-TURN-ON TO IN31
IN41.
MOVE ZEROES TO RECNUM
RECNO1
RECNO2.
ADD 1 TO RECNUM OF W3-GENERAL
RECNO1
RECNO2.
WRITE SUBFILE SCRREC FROM SUBCTL1-O
FORMAT IS "SUBCTL1"
INDIC IS W2-INDARA.
WRITE SUBFILE SCRREC FROM SUBCTL2-O
FORMAT IS "SUBCTL2"
INDIC IS W2-INDARA.
READ SUBFILE SCRFILE
INDIC IS W2-INDARA.
B-999.
EXIT.
*
BA-CLEAR-SUBFILE SECTION.
BA-100.
MOVE W5-TURN-ON TO IN32
IN42.
MOVE W5-TURN-OFF TO IN30
IN31
IN33
IN40
IN41
IN43.
MOVE ZEROES TO RECNUM
WRITE SUBFILE SCRREC FROM SUBSFL1-O
FORMAT IS "SUBCTL1"
INDIC IS W2-INDARA.
WRITE SUBFILE SCRREC FROM SUBSFL2-O
FORMAT IS "SUBCTL2"
INDIC IS W2-INDARA.
MOVE W5-TURN-OFF TO IN32
IN42.
MOVE W5-TURN-ON TO IN31
IN41.
BA-999.
EXIT.
*
BB-FILL-SUBFILE SECTION.
BA-100.
MOVE ZEROES TO RECNUM.
READ DBFILE FIRST RECORD.
PERFORM UNTIL W3-FILE-STAT = "10"
IF FSEX OF SUBREC = "M"
MOVE FCODE OF SUBREC TO FCODE OF SUBSFL1-O
MOVE FNAME OF SUBREC TO FNAME OF SUBSFL1-O
MOVE FADD OF SUBREC TO FADD OF SUBSFL1-O
ADD 1 TO RECNUM
WRITE SUBFILE SCRREC FROM SUBSFL1-O
FORMAT IS "SUBSFL1"
INDIC IS W2-INDARA
END-IF
READ DBFILE NEXT RECORD
END-PERFORM.
IF RECNUM GREATER THAN 0
MOVE W5-TURN-ON TO IN30
IN33.
*
MOVE ZEROES TO RECNUM.
READ DBFILE FIRST RECORD.
PERFORM UNTIL W3-FILE-STAT = "10"
IF FSEX OF SUBREC = "F"
MOVE FCODE OF SUBREC TO FCODE OF SUBSFL2-O
MOVE FNAME OF SUBREC TO FNAME OF SUBSFL2-O
MOVE FADD OF SUBREC TO FADD OF SUBSFL2-O
ADD 1 TO RECNUM
WRITE SUBFILE SCRREC FROM SUBSFL2-O
FORMAT IS "SUBSFL2"
INDIC IS W2-INDARA
END-IF
READ DBFILE NEXT RECORD
END-PERFORM.
IF RECNUM GREATER THAN 0
MOVE W5-TURN-ON TO IN40
IN43.
BA-999.
EXIT.
*
X-CLOSE SECTION.
X-100.
CLOSE SCRFILE
DBFILE.
X-999.
EXIT.
[{"Type":"MASTER","Line of Business":{"code":"LOB57","label":"Power"},"Business Unit":{"code":"BU058","label":"IBM Infrastructure w\/TPS"},"Product":{"code":"SWG60","label":"IBM i"},"Platform":[{"code":"PF012","label":"IBM i"}],"Version":"7.1.0"}]
Historical Number
7722732
Was this topic helpful?
Document Information
Modified date:
18 December 2019
UID
nas8N1010284