RPG Subfile Example with Record Selection

Resolving The Problem

The following is an RPG subfile example with a selection option. This example loads the entire subfile at one time. Depending on your file, this may not be appropriate for your situation. If the file loads more than a couple of subfile pages, review the example to load one page at a time. Refer to RPG Subfile That Loads Subfile One Page at a Time.

Database Physical File:

                R FMT1
                 ZIP            5A
                 CUST          20A
                 NAME          20A
                 ADDR1         20A
                 ADDR2         20A
                 CITY          20A
                 STATE          2A
                 DATEOB         6  0

Database Logical File:

                R FMT1                      PFILE(TESTADD)
               K NAME

Display File:

     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            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(0008)
    A                                      SFLPAG(0007)
    A                                      OVERLAY
    A  31                                  SFLDSP
    A  32                                  SFLDSPCTL
    A  33                                  SFLEND
    A  34                                  SFLCLR
    A  35                                  SFLINZ
    A            WDPOS          4S 0H      SFLRCDNBR
    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                                  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'
    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)

RPG Program:

     FTESTLF  UF  E           K        DISK
    FEXPSFL2 CF  E                    WORKSTN
    F                                        RRN   KSFILE SF
     *
     ****************************************************************
     *
     * CLEAR SFL
     *
     ****************************************************************
    C                     MOVEA'0001'    *IN,31
    C                     WRITESCTL
    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-ADD0         RRN     40
     *
    C                     READ FMT1                N    90
    C           *IN90     DOWEQ'0'
    C           RRN       ANDLE9998
    C                     ADD  1         RRN
    C                     WRITESF
    C                     READ FMT1                N    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                     WRITEEMPTY
    C                     END
     ****************************************************************
      *
     * WRITE EVERYTHING TO THE DISPLAY.
     *
     ****************************************************************
    C           *IN03     DOWEQ'0'
    C                     WRITEHEADER
    C                     WRITEFOOTER
     * POSITION THE SUBFILE TO THE PAGE THAT CONTAINS RELATIVE
     * RECORD NUMBER 1.
    C                     Z-ADD1         WDPOS
    C                     EXFMTSCTL
    C           *IN03     IFEQ '0'
    C                     READCSF                       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                     UPDATSF
    C                     READCSF                       80
     C                     ENDDO
    C                     END
    C                     ENDDO
    C                     MOVE '1'       *INLR
     *****************************************************************
    C           CHNG      BEGSR
    C           NAME      CHAINFMT1                 60
    C           *IN60     IFEQ '0'
    C                     EXFMTCHANGE
    C           *IN03     IFEQ '0'
    C                     UPDATFMT1
    C                     ELSE
    C                     SETOF                     03
    C                     END
    C                     END
    C                     ENDSR
     *****************************************************************
    C           DISP      BEGSR
    C           NAME      CHAINFMT1                 60
    C           *IN60     IFEQ '0'
    C                     EXFMTDISPLAY
    C                     SETOF                     03
    C                     END
    C                     ENDSR