Troubleshooting
Problem
This document contains an example of an Invited Display file with a Subfile.
Resolving The Problem
This document contains an example of an Invited Display file with a Subfile. The code is shown below; however, a save file that includes all of the code is attached.
Physical File named TESTADD:
*************** Beginning of data **************************
R FMT1
ZIP 5A
CUST 20A
NAME 20A
ADDR1 20A
ADDR2 20A
CITY 20A
STATE 2A
DATEOB 6 0
****************** End of data ******************************
Logical File named TESTLF:
*************** Beginning of data ***************************
R FMT1 PFILE(TESTADD)
K NAME
****************** End of data ******************************
Display File named EXPSFL3:
On the compile you must specify MAXDEV (greater than 1) and WAITRCD (number of seconds to wait for input)
*************** Beginning of data ***************************************
A DSPSIZ(24 80 *DS3)
A PRINT
A CF03(03)
A HELP
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 SFL
A LOGOUT
A LOGINP
A OPT 1A B 10 3
A ZIP 5A O 10 12
A CUST 20A O 10 27
A NAME 20A O 10 53
A****************************************************************
A* SUBFILE CONTROL RECORD
A****************************************************************
A R SCTL SFLCTL(SF)
A SFLSIZ(0007)
A SFLPAG(0007)
A OVERLAY
A 31 INVITE
A 31 SFLDSP
A 32 SFLDSPCTL
A 33 SFLEND
A 34 SFLCLR
A 5 2'TYPE OPTIONS, PRESS ENTER'
A COLOR(BLU)
A 6 2'2=CHANGE 5=DISPLAY'
A COLOR(BLU)
A 8 2'OPT'
A DSPATR(HI)
A 9 2'---'
A DSPATR(HI)
A 8 12'ZIP'
A DSPATR(HI)
A 9 12'-----'
A DSPATR(HI)
A 8 27'CUSTOMER'
A DSPATR(HI)
A 9 27'--------------------'
A DSPATR(HI)
A 8 53'CONTACT NAME'
A DSPATR(HI)
A 9 53'--------------------'
A DSPATR(HI)
A****************************************************************
A* WRITE IF SUBFILE IS EMPTY
A****************************************************************
A R EMPTY
A OVERLAY A 23 3'F3=EXIT'
A R CHANGE
A 1 23'CHANGE CUSTOMER RECORD'
A DSPATR(HI)
A 4 4'MAKE CHANGES AND PRESS ENTER, TO C-
A ANCEL CHANGES PRESS F3.'
A DSPATR(BL)
A COLOR(BLU)
A 7 4'CUSTOMER NAME . . .:'
A 8 4'CONTACT NAME . . .:'
A 9 4'ADDRESS LINE 1 . .:'
A 10 4'ADDRESS LINE 2 . .:'
A 11 4'CITY . . . . . . .:'
A 12 4'STATE . . . . . . .:'
A 13 4'DATE OF BIRTH . . .:'
A CUST R B 7 26REFFLD(FMT1/CUST *LIBL/TESTADD)
A CHECK(LC)
A NAME R B 8 26REFFLD(FMT1/NAME *LIBL/TESTADD)
A CHECK(LC)
A ADDR1 R B 9 26REFFLD(FMT1/ADDR1 *LIBL/TESTADD)
A CHECK(LC)
A ADDR2 R B 10 26REFFLD(FMT1/ADDR2 *LIBL/TESTADD)
A CHECK(LC)
A CITY R B 11 26REFFLD(FMT1/CITY *LIBL/TESTADD)
A CHECK(LC)
A STATE R B 12 26REFFLD(FMT1/STATE *LIBL/TESTADD)
A DATEOB R B 13 26REFFLD(FMT1/DATEOB *LIBL/TESTADD)
A EDTCDE(Y)
A 23 4'F3 = EXIT'
A COLOR(BLU)
A R DISPLAY
A*%%TS SD 19970421 104010 *LIBL REL-V2R3M0 5738-PW1
A 1 23'CHANGE CUSTOMER RECORD'
A DSPATR(HI)
A 4 4'MAKE CHANGES AND PRESS ENTER, TO C-
A ANCEL CHANGES PRESS F3.'
A DSPATR(BL)
A COLOR(BLU)
A 7 4'CUSTOMER NAME . . .:'
A 8 4'CONTACT NAME . . .:'
A 9 4'ADDRESS LINE 1 . .:'
A 10 4'ADDRESS LINE 2 . .:'
A 11 4'CITY . . . . . . .:'
A 12 4'STATE . . . . . . .:'
A 13 4'DATE OF BIRTH . . .:'
A 23 4'F3 = EXIT'
A COLOR(BLU)
A CUST R O 7 26REFFLD(FMT1/CUST *LIBL/TESTADD)
A NAME R O 8 26REFFLD(FMT1/NAME *LIBL/TESTADD)
A ADDR1 R O 9 26REFFLD(FMT1/ADDR1 *LIBL/TESTADD)
A ADDR2 R O 10 26REFFLD(FMT1/ADDR2 *LIBL/TESTADD)
A CITY R O 11 26REFFLD(FMT1/CITY *LIBL/TESTADD)
A STATE R O 12 26REFFLD(FMT1/STATE *LIBL/TESTADD)
A DATEOB R O 13 26REFFLD(FMT1/DATEOB *LIBL/TESTADD)
A EDTCDE(Y)
****************** End of data *****************************************************
RPGLE Program named TESTSFLR:
*************** Beginning of data **************************************
FTESTLF UF E K DISK
FEXPSFL3 CF E WORKSTN
F SFILE(SF:RRN)
F INFDS(FILEINFS)
F MAXDEV(*FILE)
DFILEINFS DS
DSTATUS *STATUS
*
**********************************************************************
*
* CLEAR SFL
*
**********************************************************************
C MOVEA '0001' *IN(31)
C WRITE SCTL
C MOVEA '0100' *IN(31)
*
***********************************************************************
*
* LOAD SUBFILE
* THIS PROGRAM LOADS THE ENTIRE SUBFILE. THIS IS NOT VERY
* EFFICIENT IF THERE ARE MORE THAN A COUPLE SUBFILE PAGES
C MOVEA '0100' *IN(31)
*
************************************************************************
*
* 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.
*
* NOTICE THE READ WITH NO LOCK SO THAT NO RECORDS HAVE A
* LOCK AFTER LOADING THE SUBFILE.
*
*************************************************************************
* INITIALIZE SFL RRN
C Z-ADD 0 RRN 4 0
*
C READ(N) FMT1 90
C *IN90 DOWEQ '0'
C RRN ANDLE 9998
C ADD 1 RRN
C SETON 25
C WRITE SF
C READ(N) FMT1 90
C ENDDO
C SETON 33
**********************************************************************
*
* CHECK TO SEE IF SUBFILE HAS ANY RECORDS.
* IF THERE ARE RECORDS THEN SET ON THE SFLDSP INDICATOR.
*
* IF THERE ARE NOT ANY RECORDS IN THE SUBFILE THEN WRITE
* THE EMPTY RECORD FORMAT.
*
**********************************************************************
C RRN IFGT 0
C SETON 31
C ELSE
C WRITE EMPTY
C END
**********************************************************************
*
* WRITE EVERYTHING TO THE DISPLAY.
*
**********************************************************************
C *IN03 DOWEQ '0'
c again tag
C WRITE HEADER
C WRITE FOOTER
* POSITION THE SUBFILE TO THE PAGE THAT CONTAINS RELATIVE
* RECORD NUMBER 1.
C write SCTL
c read expsfl3 9950
c STATUS IFEQ 1331
c GOTO again
c END
C *IN03 IFEQ '0'
C READC SF 80
C *IN80 DOWEQ '0'
C OPT IFEQ '2'
C EXSR CHNG
C ELSE
C OPT IFEQ '5'
C EXSR DISP
C ELSE
C* SEND OUT ERROR
C END
C END
C MOVE ' ' OPT
C SETON 30
C UPDATE SF
C READC SF 80
C ENDDO
C END
C ENDDO
c* ENDIT TAG
C MOVE '1' *INLR *************************************************************************
C CHNG BEGSR
C NAME CHAIN FMT1 60
C *IN60 IFEQ '0'
C EXFMT CHANGE
C *IN03 IFEQ '0'
C UPDATE FMT1
C ELSE
C SETOFF 03
C END
C END
C ENDSR
************************************************************************
C DISP BEGSR
C NAME CHAIN FMT1 60
C *IN60 IFEQ '0'
C EXFMT DISPLAY
C SETOFF 03
C END
C ENDSR
****************** End of data ******************************************
Historical Number
360339788
Was this topic helpful?
Document Information
Modified date:
18 December 2019
UID
nas8N1015793