Troubleshooting
Problem
The following is an example of an ILE COBOL program that loads a subfile one page at a time.
Resolving The Problem
The following is an example of a COBOL program that loads a subfile one page at a time:
Database File:
A R FMT1
A ZIP 5A
A CUST 20A
A NAME 20A
A K ZIP
Display File:
A PRINT
A CF03(03)
A HELP
A INDARA
A****************************************************************
A* HEADER RECORD TO BE AT TOP OF DISPLAY
A****************************************************************
A R HEADER
A OVERLAY
A 2 3'HEADER'
A 2 70DATE EDTWRD(' / / ')
A 3 70TIME EDTWRD(' : : ')
A****************************************************************
A* SUBFILE RECORD
A****************************************************************
A R SF
A SFL
A ZIP 5 O 8 12
A CUST 20 O 8 28
A NAME 20 O 8 53
A****************************************************************
A* SUBFILE CONTROL RECORD
A****************************************************************
A R SCTL SFLCTL(SF)
A OVERLAY
A SFLSIZ(08)
A SFLPAG(07)
A ROLLUP(90)
A 31 SFLDSP
A 32 SFLDSPCTL
A 33 SFLEND
A 34 SFLCLR
A 35 SFLINZ
A WDPOS 4S 0H SFLRCDNBR
A 4 12'SUBFILE CONTROL'
A 6 12'ZIP'
A 7 12'-----'
A 6 28'CUSTOMER'
A 7 28'--------------------'
A 6 53'NAME'
A 7 53'--------------------'
A****************************************************************
A* WRITE IF SUBFILE IS EMPTY
A****************************************************************
A R EMPTY
A OVERLAY
A 8 12'THE SUBFILE IS EMPTY'
A****************************************************************
A* FOOTER RECORD TO BE WRITTEN AT THE BOTTOM OF THE DISPLAY
A****************************************************************
A R FOOTER
A OVERLAY
A 23 3'FOOTER'
COBOL Source named ONEPGSFL:
IDENTIFICATION DIVISION.
PROGRAM-ID. ONEPGSFL.
DATE-WRITTEN. FEB. 11,1997.
DATE-COMPILED.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DISPLAY-FILE
ASSIGN TO WORKSTATION-ONEPGSFLCB-SI
ORGANIZATION IS TRANSACTION
ACCESS MODE IS DYNAMIC
RELATIVE KEY IS RECNUM
FILE STATUS IS DISPLAY-FILE-STATUS.
SELECT DBFILE ASSIGN TO DATABASE-TESTPF2
ORGANIZATION IS INDEXED
ACCESS IS DYNAMIC
RECORD KEY IS EXTERNALLY-DESCRIBED-KEY
WITH DUPLICATES
FILE STATUS IS DBFILE-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD DISPLAY-FILE
LABEL RECORDS ARE STANDARD.
01 DISPLAY-RECORD.
COPY DDS-ALL-FORMATS OF ONEPGSFLCB.
*
FD DBFILE
LABEL RECORDS ARE STANDARD
DATA RECORD IS FMT1.
01 DBREC.
COPY DDS-ALL-FORMATS OF TESTPF2.
*
WORKING-STORAGE SECTION.
01 FILE-STATUS.
05 DISPLAY-FILE-STATUS PIC 99.
05 DBFILE-FILE-STATUS PIC 99.
01 LOOP-COUNT PIC 99.
01 WS-INDICATORS.
05 IN03 PIC 1 INDIC 03.
88 END-PROGRAM VALUE B"1".
88 NOT-END-PROGRAM VALUE B"0".
05 IN31 PIC 1 INDIC 31.
88 SUBFILE-DISPLAY VALUE B"1".
88 NO-SUBFILE-DISPLAY VALUE B"0".
05 IN32 PIC 1 INDIC 32.
88 SUBFILE-CONTROL VALUE B"1".
88 NO-SUBFILE-CONTROL VALUE B"0".
05 IN33 PIC 1 INDIC 33.
88 SUBFILE-END VALUE B"1".
88 NOT-SUBFILE-END VALUE B"0".
05 IN34 PIC 1 INDIC 34.
88 SUBFILE-CLEAR VALUE B"1".
88 NOT-SUBFILE-CLEAR VALUE B"0".
05 IN90 PIC 1 INDIC 90.
88 PAGE-DOWN VALUE B"1".
88 NOT-PAGE-DOWN VALUE B"0".
01 RECNUM PIC 9(3) VALUE ZEROES.
*
01 IND-ON PIC 1 VALUE B"1".
01 IND-OFF PIC 1 VALUE B"0".
PROCEDURE DIVISION.
MAIN-PROCESS.
PERFORM INITIALIZE-001.
*
****************************************************************
*
* CLEAR SFL
*
****************************************************************
SET NO-SUBFILE-DISPLAY TO TRUE.
SET NO-SUBFILE-CONTROL TO TRUE.
SET NOT-SUBFILE-END TO TRUE.
SET SUBFILE-CLEAR TO TRUE.
WRITE DISPLAY-RECORD FROM SCTL-O FORMAT IS "SCTL"
INDICATORS ARE WS-INDICATORS.
SET NOT-SUBFILE-CLEAR TO TRUE.
SET SUBFILE-CONTROL TO TRUE.
****************************************************************
* LOAD FIRST PAGE OF DATA INTO SUBFILE.
****************************************************************
PERFORM LOAD-SUBFILE.
****************************************************************
*
* CHECK TO SEE IF SUBFILE HAS ANY RECORDS.
* IF THERE ARE RECORDS THEN SET ON THE SFLDSP INDICATOR.
*
* IF THERE ARE NOT ANY RECORD IN THE SUBFILE THEN WRITE
* THE EMPTY RECORD FORMAT.
*
****************************************************************
IF RECNUM IS GREATER THAN 0
SET SUBFILE-DISPLAY TO TRUE
ELSE
WRITE DISPLAY-RECORD FORMAT IS "EMPTY".
PERFORM DISPLAY-001 UNTIL END-PROGRAM.
CLOSE DISPLAY-FILE
DBFILE.
EXIT PROGRAM.
STOP RUN.
DISPLAY-001.
****************************************************************
*
* DISPLAY THE SCREEN.
*
****************************************************************
WRITE DISPLAY-RECORD FORMAT IS "HEADER".
WRITE DISPLAY-RECORD FORMAT IS "FOOTER".
MOVE RECNUM TO WDPOS OF SCTL-O.
WRITE DISPLAY-RECORD FROM SCTL-O
FORMAT IS "SCTL"
INDICATORS ARE WS-INDICATORS.
READ DISPLAY-FILE
INDICATORS ARE WS-INDICATORS.
****************************************************************
* CHECK FOR ROLL KEY AND END OF FILE
****************************************************************
IF PAGE-DOWN
AND NOT-END-PROGRAM
SET NOT-PAGE-DOWN TO TRUE.
IF NOT-SUBFILE-END
PERFORM LOAD-SUBFILE.
INITIALIZE-001.
OPEN I-O DISPLAY-FILE.
OPEN INPUT DBFILE.
MOVE ZERO TO RECNUM.
SET NOT-END-PROGRAM TO TRUE.
*
****************************************************************
*
* LOAD SUBFILE
* THIS PROGRAM LOADS THE ENTIRE SUBFILE. THIS IS NOT VERY
* EFFICIENT IF THERE ARE MORE THAN A COUPLE SUBFILE PAGES
* OF DATA IN THE DATABASE FILE. IF THERE IS TOO MUCH DATA
* YOU SHOULD CONSIDER LOADING THE SUBFILE ONE PAGE AT A TIME.
*
****************************************************************
LOAD-SUBFILE.
MOVE 0 TO LOOP-COUNT.
IF RECNUM EQUAL TO ZERO
READ DBFILE FIRST RECORD
IF DBFILE-FILE-STATUS = "00"
ADD 1 TO RECNUM
ADD 1 TO LOOP-COUNT
MOVE CORRESPONDING FMT1 TO SF-O
WRITE SUBFILE DISPLAY-RECORD FROM SF-O
FORMAT IS "SF"
INDIC IS WS-INDICATORS
READ DBFILE NEXT RECORD.
PERFORM UNTIL DBFILE-FILE-STATUS NOT = "00"
OR (LOOP-COUNT GREATER THAN OR EQUAL TO 7)
MOVE CORRESPONDING FMT1 TO SF-O
ADD 1 TO RECNUM
ADD 1 TO LOOP-COUNT
WRITE SUBFILE DISPLAY-RECORD FROM SF-O
FORMAT IS "SF"
INDIC IS WS-INDICATORS
READ DBFILE NEXT RECORD
END-PERFORM.
IF DBFILE-FILE-STATUS NOT EQUAL TO "00"
SET SUBFILE-END TO TRUE.
CRTBNDCBL PGM(<yourlib>/ONEPGSFL) SRCFILE(<yourlib>/QCBLLESRC) RCMBR(ONEPGSFL)
CALL <yourflib>/ONEPGSFL
Press Page Down for more records
Press Page Down for more records.
[{"Type":"MASTER","Line of Business":{"code":"LOB68","label":"Power HW"},"Business Unit":{"code":"BU070","label":"IBM Infrastructure"},"Product":{"code":"SWG60","label":"IBM i"},"ARM Category":[{"code":"a8m3p000000F98bAAC","label":"Programming ILE Languages-\u003ECOBOL"}],"ARM Case Number":"","Platform":[{"code":"PF012","label":"IBM i"}],"Version":"All Versions"}]
Historical Number
7950009
Was this topic helpful?
Document Information
Modified date:
14 November 2024
UID
nas8N1010265