Subfile Example
Language(s):I-Series - RPG
Category(s):Subfiles

Simple Name List program, demonstrates: 1) Dynamic subfile creation. 2) Iterative subfile processing. 3) Adding/changing/deleting records. 4) Reading the cursor positiong from the INFDS. 5) Positioning the cursor on a subfile line. 6) Positioning in the subfile via lookup.

     F***************************************************************
     F**
     F** - Note, this example is made up of 4 source members: 
     F**
     F**   NMELSTR - RPG
     F**   NMELSTS - DSPF
     F**   NMELSTP - PF
     F**   NMELST1 - LF
     F**
     F** - If you are copying this off or the web, be sure to 
     F** - break the text up into the appropriate sections.  
     F** - You will find 6 blank lines between each source member.
     F**
     F***************************************************************
     F** - Source Member: NMELSTR
     F***************************************************************
     F** - Simple Name List Program
     F** - RPG III Supfield Example
     F** - Jon Vote 09/2002
     F** - www.idioma-software.com
     F***************************************************************
     F** - This program demonstrates the following:
     F**
     F**   1) Dynamic subfile creation.
     F**   2) Iterative subfile processing.
     F**   3) Adding/changing/deleting records.
     F**   4) Reading the cursor positiong from the INFDS.
     F**   5) Positioning the cursor on a subfile line.
     F**   6) Positioning in the subfile via lookup.
     F**
     F** - Related source members:
     F** -   NMELSTR: Simple Name List Program
     F**     NMELSTP: Pysical file used with NMELSTR
     F**     NMELST1: Logical over NMELSTP
     F**     NMELSTS: Display File used with NMELSTR
     F**
     F** - Name list pysical - keyed on NMELST (Last Name)
     F**
     FNMELSTP IF  E           K        DISK                      A
     F**
     F** - By PRIKEY
     F**
     FNMELST1 UF  E           K        DISK
     F            NMELSTF                           KRENAMEBYPRIKEY
     F**
     F** - Subfile - lists names in alpha order, allows selection
     F**
     FNMELSTS CF  E                    WORKSTN
     F                                        RDCTR KSFILE NMELSSF
     F                                              KINFDS FILEDS
     E**
     E** - Used to parse the name
     E**
     E                    @NM        15  1
     E                    SNM        25  1
     E**
     E** - User messages
     E**
     E                    MSG     1  10 78
     IFILEDS      DS
     I                                    B 370 3710ROWCOL
     I                                    B 376 3770SFRR#
     I                                    B 378 3790TOPSF#
     I                                    B 380 3810TOTSF#
     I**
     I** - Subfile records per page
     I**
     I              15                    C         SFPAG
     I**
     I** - Max length of the parsed name field
     I**
     I              25                    C         PNMLEN
     I**
     I** - Length of name field in the database
     I**
     I              15                    C         NMELEN
     I**
     I** - Used for parsing the name fields
     I**
     ISNAME       DS
     I                                        1  25 SNM
     I@NAME       DS
     I                                        1  15 @NM
     C           *LIKE     DEFN RDCTR     COUNT            BOT OF PGE
     C           *LIKE     DEFN RDCTR     TOPCTR           TOP OF PGE
     C           *LIKE     DEFN RDCTR     BOTCTR           BOT OF PGE
     C**
     C**
     C** - Initialize - Load the screen
     C**
     C                     EXSR INIT
     C**
     C** - Dispaly the screen, loop until F3 keyed.
     C**
     C                     EXSR PAINT
     C**
     C** - Loop until F3
     C**
     C           *INKC     DOWEQ'0'                        F3
     C**
     C** - React to user input
     C**
     C                     SELEC
     C           *INKC     WHEQ '1'                        F3
     C                     LEAVE
     C           *INKE     WHEQ '1'                        F6
     C                     EXSR REFRSH
     C           *INKF     WHEQ '1'                        F6
     C                     EXSR ADDREC
     C           *IN81     WHEQ '1'
     C                     EXSR ROLLUP
     C           *IN82     WHEQ '1'
     C                     EXSR ROLLDN
     C                     OTHER
     C                     EXSR ENTER
     C                     ENDSL
     C**
     C                     EXSR PAINT
     C**
     C                     ENDDO
     C**
     C                     SETON                     LR
     C***************************************************************
     C** - INIT : Initialize
     C***************************************************************
     C           INIT      BEGSR
     C**
     C** - Clear the subfile
     C**
     C                     SETON                     20
     C                     WRITENMELSCTL
     C                     SETOF                     20
     C**
     C** - Load the first screen
     C**
     C           *LOVAL    SETLLNMELSTF
     C                     Z-ADD1         RDCTR
     C                     Z-ADD0         TOPCTR           TOP OF PGE
     C                     Z-ADD0         BOTCTR           BOT OF PGE
     C                     MOVEL'N'       @EOF    1
     C                     EXSR LOADSF
     C**
     C                     ENDSR
     C***************************************************************
     C** - PAINT: Paint the screen
     C***************************************************************
     C           PAINT     BEGSR
     C**
     C                     Z-ADDTOPCTR    RDCTR
     C                     WRITEFOOTER
     C                     EXFMTNMELSCTL
     C                     Z-ADDTOPSF#    TOPCTR
     C**
     C                     ENDSR
     C***************************************************************
     C** - ROLLUP: Rollup routine
     C***************************************************************
     C           ROLLUP    BEGSR
     C**
     C** - WE GET HERE IF ROLLING PAST LAST SUBFILE RECORD WRITTEN
     C**
     C           BOTCTR    ADD  1         RDCTR
     C                     EXSR LOADSF
     C**
     C                     ENDSR
     C***************************************************************
     C** - ROLLDN: Rolldown Routine
     C***************************************************************
     C           ROLLDN    BEGSR
     C**
     C** - We get here at BOF
     C**
     C                     ENDSR
     C***************************************************************
     C** - REFRESH: Refresh
     C***************************************************************
     C           REFRSH    BEGSR
     C**
     C                     EXSR INIT
     C**
     C                     ENDSR
     C***************************************************************
     C** - ENTER: Enter keyed
     C***************************************************************
     C           ENTER     BEGSR
     C**
     C** - Here's how to get the row and column of the cursor position
     C** - You can use this to figure out which subfile line
     C** - or whatever
     C**
     C           ROWCOL    DIV  256       CRSROW  20
     C                     MVR            CRSCOL  20
     C**
     C** - Ignore the subfile if the user is positioning
     C** - otherwise iterate through the subfile
     C**
     C           POSTO     IFNE *BLANKS
     C                     EXSR DOPOS
     C                     ELSE
     C                     EXSR PROCSF
     C                     ENDIF                           POSTO<>" "
     C**
     C                     ENDSR
     C***************************************************************
     C** - DOPOS : Position us in the subfile
     C***************************************************************
     C           DOPOS     BEGSR
     C**
     C** - Refresh the screen
     C**
     C                     EXSR REFRSH
     C**
     C** - Loop until we find the string or EOF
     C**
     C           POSTO     DOWGT@SNAME
     C           @EOF      ANDEQ'N'
     C                     EXSR ROLLUP
     C                     ENDDO                           @POS>@SNAME
     C**
     C** - Position the cursor...
     C** - ...unless the last entry is less than POSTO
     C** - @SNAME will give us the last SNAME put to the SF
     C**
     C           @SNAME    IFGT POSTO
     C                     Z-ADDTOPCTR    RDCTR
     C           RDCTR     CHAINNMELSSF              91
     C           POSTO     DOWGTSNAME
     C                     ADD  1         RDCTR
     C           RDCTR     CHAINNMELSSF              91
     C                     ENDDO                           POSTO>SNAME
     C**
     C                     Z-ADDRDCTR     TOPCTR
     C                     ENDIF                           @SNAME>POST
     C**
     C                     MOVEL*BLANKS   POSTO
     C**
     C                     ENDSR
     C***************************************************************
     C** - PROCSF: Process the subfile
     C***************************************************************
     C           PROCSF    BEGSR
     C**
     C                     MOVEL'N'       CANCEL  1
     C**
     C           1         DO   TOTSF#    IROW
     C                     Z-ADDIROW      RDCTR
     C           RDCTR     CHAINNMELSSF              91
     C**
     C                     SELEC
     C** - Delete?
     C           SELECT    WHEQ 'D'
     C                     EXSR DLTREC
     C** - Edit?
     C           SELECT    WHEQ 'E'
     C                     EXSR EDTREC
     C** - ???
     C           SELECT    WHNE *BLANKS
     C                     EXSR IVDOPT
     C**
     C** - No selection here - clear the subfile error indicator
     C** - if it was set.
     C**
     C                     OTHER
     C                     EXSR CLRSFI
     C           @SFI      IFEQ 'Y'
     C                     UPDATNMELSSF
     C                     ENDIF
     C**
     C                     ENDSL
     C**
     C** - Vamouse outta here if Cancel
     C**
     C           CANCEL    IFEQ 'Y'
     C                     MOVELMSG,2     DSPMSG
     C                     SETON                     13
     C                     LEAVE
     C                     ENDIF                           CANCEL=Y
     C**
     C                     ENDDO                           1 TO IROW
     C**
     C                     ENDSR
     C***************************************************************
     C** - LOADSF: Load a page to the subfile.
     C** - Sets @EOF to 'Y' if EOF 'N' if not.
     C** - Updates TOPCTR: Pointing to top of screen
     C** -         BOTCTR: Pointing to bottom of screen
     C***************************************************************
     C           LOADSF    BEGSR
     C**
     C** - Do nothing if EOF
     C**
     C           @EOF      IFNE 'Y'
     C                     MOVEL'N'       @EOF    1
     C                     Z-ADD0         COUNT
     C**
     C** - Loop for number of rows in the subfile
     C**
     C           1         DO   SFPAG     IROW    30
     C**
     C** - Next record from the database
     C**
     C                     READ NMELSTF                  90
     C**
     C** - Check for EOF...if this is first time through
     C** - we never wrote anything to the subfile...so
     C** - we will write a 'nothing there' message.
     C**
     C**
     C           *IN90     IFEQ '1'                        EOF?
     C                     MOVEL'Y'       @EOF    1
     C           I         IFEQ 1                          1st Time?
     C                     EXSR PUTNR
     C                     Z-ADD1         TOPCTR
     C                     ELSE
     C                     EXSR PUTEOF
     C                     ENDIF                           I=1
     C                     LEAVE
     C                     ENDIF                           90=1
     C**
     C** - Put this record to the screen
     C**
     C                     EXSR PUTSF
     C                     ADD  1         COUNT
     C**
     C                     ENDDO                           1 to SFPAGE
     C**
     C           BOTCTR    ADD  1         TOPCTR           TOP REC
     C                     ADD  COUNT     BOTCTR           BOTTOM REC
     C                     ENDIF                           Not EOF
     C**
     C                     ENDSR
     C***************************************************************
     C** - PUTSF : Write a database record to the subfile
     C***************************************************************
     C           PUTSF     BEGSR
     C**
     C           *LIKE     DEFN SNAME     @SNAME
     C**
     C                     EXSR DB2SF
     C                     WRITENMELSSF
     C                     MOVELSNAME     @SNAME
     C                     ADD  1         RDCTR
     C**
     C                     ENDSR
     C***************************************************************
     C** - PUTNR : Put no records in the database message
     C***************************************************************
     C           PUTNR     BEGSR
     C**
     C                     SETON                     40    Prtct Select
     C                     MOVELMSG,1     SNAME            No Recs Msg
     C                     MOVEL*BLANKS   SPHONE
     C                     MOVEL*BLANKS   SEMAIL
     C                     WRITENMELSSF
     C                     ADD  1         RDCTR
     C**
     C                     ENDSR
     C***************************************************************
     C** - PUTEOF : Put end of file message
     C***************************************************************
     C           PUTEOF    BEGSR
     C**
     C                     SETON                     40
     C                     MOVEL*ZEROS    PRIKEY
     C                     MOVEL*BLANKS   SNAME
     C                     MOVELMSG,3     SPHONE
     C                     MOVEL*BLANKS   SEMAIL
     C                     MOVEL*BLANKS   SELECT
     C                     WRITENMELSSF
     C                     ADD  1         RDCTR
     C**
     C                     ENDSR
     C***************************************************************
     C** - DB2SF : Database fields to subfile fields
     C***************************************************************
     C           DB2SF     BEGSR
     C**
     C           *LIKE     DEFN @L        S
     C**
     C** - Clear the subfile error indicators
     C**
     C                     EXSR CLRSFI
     C**
     C**- We will parse the name into one field in the form:
     C**- LastName, FirstName M
     C**
     C                     MOVEL*BLANKS   SELECT
     C                     MOVEA*BLANKS   SNM
     C                     MOVEANMELST    SNM
     C**
     C** - GETLEN will set @L to the length of @NM
     C**
     C                     MOVELNMELST    @NAME
     C                     EXSR GETLEN
     C**
     C** - We want a comma just to the right of @L
     C**
     C           @L        ADD  1         S
     C                     MOVEL','       SNM,S
     C**
     C** - First name goes next with a leading blank
     C**
     C                     ADD  2         S
     C                     MOVEANMEFST    SNM,S
     C**
     C** - Let's see how long the first name is
     C**
     C                     MOVELNMEFST    @NAME
     C                     EXSR GETLEN
     C**
     C** - Update S to point past the first name to where the middle
     C** - initial would go.
     C**
     C                     ADD  @L        S
     C                     ADD  1         S
     C**
     C** - Put the middle initial here if enough roowm
     C**
     C           S         IFLE PNMLEN
     C                     MOVELNMEMID    SNM,S
     C                     ENDIF                           S<PNMLEN
     C**
     C** - The other two are easy - first 16 chars of phone number
     C** - and the first 20 or the email address
     C**
     C                     MOVELPHONE#    SPHONE
     C                     MOVELEMAIL@    SEMAIL
     C**
     C                     ENDSR
     C***************************************************************
     C** - DLT2SF : Deleted record to subfile
     C***************************************************************
     C           DLT2SF    BEGSR
     C**
     C** - Clear the subfile error indicators
     C**
     C                     EXSR CLRSFI
     C**
     C** - Deleted record message
     C**
     C                     MOVEL*BLANKS   SELECT
     C                     MOVEL*BLANKS   SNAME
     C                     MOVEL'(Deleted'TEMP9   9
     C                     MOVE ')'       TEMP9
     C                     MOVELTEMP9     SNAME
     C                     MOVEL*BLANKS   SPHONE
     C                     MOVEL*BLANKS   SEMAIL
     C**
     C                     ENDSR
     C***************************************************************
     C** - CLRSFI: Clear subfile error indicators
     C** - Sets @SFI = 'Y' if an error indicator had been set
     C** - Sets @SFI = 'N' if not.
     C***************************************************************
     C           CLRSFI    BEGSR
     C**
     C** - Add additional indicators as needed
     C** - !!! Besure to include new indicators both places
     C**
     C           *IN40     IFEQ '1'
     C           *IN42     OREQ '1'
     C                     MOVEL'Y'       @SFI    1
     C                     SETOF                     4042
     C                     ELSE
     C                     MOVEL'N'       @SFI
     C                     ENDIF                           40 | 42=1
     C**
     C                     ENDSR
     C***************************************************************
     C** - GETLEN: Returns length of name field.
     C** - Expects @NAME to be set to the name, set @L to the length
     C***************************************************************
     C           GETLEN    BEGSR
     C**
     C** @L will be zero if the string is all blanks.
     C**
     C                     Z-ADD0         @L      30
     C                     Z-ADDNMELEN    I       30
     C**
     C** - Loop through the string starting from the
     C** - end of the string to the beginning.
     C**
     C           I         DOWGT0
     C**
     C** - We're done when we find a non-blank
     C**
     C           @NM,I     IFNE *BLANKS
     C                     Z-ADDI         @L
     C                     LEAVE
     C                     ENDIF
     C**
     C** - Found a blank if here, decrement I
     C**
     C                     SUB  1         I
     C                     ENDDO                           -1 = Decrement
     C**
     C** - @L has the lengh of the string here.
     C**
     C                     ENDSR
     C***************************************************************
     C** - ADDREC: Add record
     C***************************************************************
     C           ADDREC    BEGSR
     C**
     C** - NEWKEY sets @PRIKY to a unique key
     C**
     C                     EXSR NEWKEY
     C                     Z-ADD@PRIKY    PRIKEY
     C                     MOVEL*BLANKS   NMEFST
     C                     MOVEL*BLANKS   NMELST
     C                     MOVEL*BLANKS   NMEMID
     C                     MOVEL*BLANKS   PHONE#
     C                     MOVEL*BLANKS   EMAIL@
     C                     EXFMTDETAIL
     C**
     C** - Add the record unless cancel.
     C**
     C           *INKC     IFEQ '0'                        F3
     C           *INKL     ANDEQ'0'                        F12
     C**
     C** - Get primary key again in case someone
     C** - grabbed the last one.
     C**
     C                     EXSR NEWKEY
     C                     Z-ADD@PRIKY    PRIKEY
     C                     WRITENMELSTF
     C**
     C                     ENDIF                           KL=0
     C**
     C                     ENDSR
     C***************************************************************
     C** - DLTREC: Delete routine
     C***************************************************************
     C**
     C           DLTREC    BEGSR
     C           PRIKEY    CHAINBYPRIKEY             99
     C           *IN99     IFEQ '0'
     C                     SETON                       41
     C                     MOVEL'N'       OK2DLT
     C                     EXFMTDETAIL
     C                     SELEC
     C**
     C** - F3 Keyed? No further action if Exit
     C**
     C           *INKC     WHEQ '1'                        F3 - Exit
     C**                   NOOP
     C**
     C** - F12 Keyed? Set cancel flag if Cancel
     C**
     C           *INKL     WHEQ '1'                        F12 - Cancel
     C                     MOVEL'Y'       CANCEL
     C**
     C** - Enter keyed here - delete if OK2DLT
     C**
     C                     OTHER
     C           OK2DLT    IFEQ 'Y'
     C                     DELETBYPRIKEY
     C                     EXSR CLRSFI
     C                     EXSR DLT2SF
     C                     UPDATNMELSSF
     C                     ENDIF
     C**
     C                     ENDSL
     C**
     C** - No record found.
     C** - Something went wrong here!
     C**
     C                     ENDIF                           99=0
     C**
     C                     ENDSR
     C***************************************************************
     C** - EDTREC: Edit routine
     C***************************************************************
     C           EDTREC    BEGSR
     C**
     C           PRIKEY    CHAINBYPRIKEY             99
     C           *IN99     IFEQ '0'
     C                     SETOF                       41
     C           *INKC     DOUEQ'1'                        F3
     C           *INKI     OREQ '1'                        F9
     C           *INKL     OREQ '1'                        F12
     C                     EXFMTDETAIL
     C                     SELEC
     C**
     C** - F3 Keyed? No further action if Exit
     C**
     C           *INKC     WHEQ '1'                        F3 - Exit
     C**                   NOOP
     C**
     C** - F12 Keyed? Set cancel flag if Cancel
     C**
     C           *INKL     WHEQ '1'                        F12 - Cancel
     C                     MOVEL'Y'       CANCEL
     C**
     C** - Enter keyed OR F9 here - update
     C**
     C                     OTHER
     C                     EXSR CLRSFI
     C                     UPDATBYPRIKEY
     C                     EXSR DB2SF
     C**
     C** - If that wasn't an F9, we're staying
     C** - so re-grab the record
     C**
     C                     UPDATNMELSSF
     C           *INKI     IFNE '1'                        F9
     C           PRIKEY    CHAINBYPRIKEY             99
     C           RDCTR     CHAINNMELSSF              91
     C                     ENDIF                           *INKI<>1
     C**
     C                     ENDSL
     C                     ENDDO                           KC,KI,KL
     C**
     C** - No record found.
     C** - Something went wrong here!
     C**
     C                     ENDIF                           99=0
     C**
     C                     ENDSR
     C***************************************************************
     C** - IVDOPT: Invalid Option
     C***************************************************************
     C           IVDOPT    BEGSR
     C**
     C                     EXSR CLRSFI
     C                     MOVEL*BLANKS   SELECT
     C                     SETON                     42
     C                     UPDATNMELSSF
     C**
     C                     ENDSR
     C**
     C***************************************************************
     C** - NEWKEY: Get a new PRIMARYKEY
     C***************************************************************
     C           NEWKEY    BEGSR
     C**
     C           *LIKE     DEFN PRIKEY    @PRIKY
     C           *LIKE     DEFN PRIKEY    SVEKEY
     C           *LIKE     DEFN NMEFST    SVEFST
     C           *LIKE     DEFN NMELST    SVELST
     C           *LIKE     DEFN NMEMID    SVEMID
     C           *LIKE     DEFN PHONE#    SVEPHO
     C           *LIKE     DEFN EMAIL@    SVEEMA
     C**
     C                     Z-ADDPRIKEY    SVEKEY
     C                     MOVELNMEFST    SVEFST
     C                     MOVELNMELST    SVELST
     C                     MOVELNMEMID    SVEMID
     C                     MOVELPHONE#    SVEPHO
     C                     MOVELEMAIL@    SVEEMA
     C**
     C           *HIVAL    SETLLBYPRIKEY
     C                     READPBYPRIKEY                 99
     C           *IN99     IFEQ '1'
     C                     Z-ADD1         @PRIKY
     C                     ELSE
     C           PRIKEY    ADD  1         @PRIKY
     C                     ENDIF                           99=1
     C**
     C** - Like your mother said - put everything back
     C** - the way you found it.
     C**
     C                     Z-ADDSVEKEY    PRIKEY
     C           PRIKEY    CHAINBYPRIKEY             99
     C                     MOVELSVEFST    NMEFST
     C                     MOVELSVELST    NMELST
     C                     MOVELSVEMID    NMEMID
     C                     MOVELSVEPHO    PHONE#
     C                     MOVELSVEEMA    EMAIL@
     C**
     C                     ENDSR
** - MSG - User messages
(no records on file)
Cancelled.
End of list.
...(additional messages go here)...
...(additional messages go here)...
...(additional messages go here)...
...(additional messages go here)...
...(additional messages go here)...
...(additional messages go here)...
...(additional messages go here)...






     A***************************************************************
     A** - Source Member: NMELSTS
     A***************************************************************
     A** - Simple Name List Program
     A** - RPG III Supfield Example
     A** - Jon Vote 09/2002
     A** - www.idioma-software.com
     A***************************************************************
     A**
     A** - Related source members:
     A** -   NMELSTR: Simple Name List Program
     A**     NMELSTP: Pysical file used with NMELSTR
     A**     NMELST1: Logical over NMELSTP
     A**     NMELSTS: Display File used with NMELSTR
     A**
     A*%%TS  SD  20020916  192219  VOTEJM      REL-V5R1M0  5722-WDS
     A*%%EC
     A                                      DSPSIZ(24 80 *DS3)
     A          R NMELSSF                   SFL
     A*%%TS  SD  20020915  212042  VOTEJM      REL-V5R1M0  5722-WDS
     A            PRIKEY         9S 0H
     A            SNAME         25A  O  7  9
     A            SPHONE        14A  O  7 37
     A            SEMAIL        25A  O  7 54
     A            SELECT         1A  B  7  6
     A  40                                  DSPATR(PR)
     A  42                                  DSPATR(RI)
     A  40                                  DSPATR(ND)
     A          R NMELSCTL                  SFLCTL(NMELSSF)
     A*%%TS  SD  20020916  192219  VOTEJM      REL-V5R1M0  5722-WDS
     A                                      SFLSIZ(0016)
     A                                      SFLPAG(0015)
     A                                      CF03
     A                                      CF05
     A                                      CF06
     A                                      ROLLUP(81)
     A                                      ROLLDOWN(82)
     A                                      OVERLAY
     A N20                                  SFLDSP
     A N20                                  SFLDSPCTL
     A  20                                  SFLCLR
     A            RDCTR          4S 0H      SFLRCDNBR(CURSOR)
     A                                  1 27'Simple Name List Program'
     A                                      COLOR(WHT)
     A                                  2 23'Subfile Example - Jon Vote - 2002'
     A                                      COLOR(WHT)
     A                                  5  9'Name'
     A                                  5 37'Phone'
     A                                  5 43'Number'
     A                                  5 54'Email Address'
     A                                  3 28'www.idioma-software.com'
     A                                      COLOR(TRQ)
     A                                      DSPATR(UL)
     A                                  6  9'-------------------------   -------
     A                                      --------   -------------------------
     A                                      -'
     A                                  3 62'Cursor'
     A                                      COLOR(YLW)
     A                                  3 69'Row:'
     A                                      COLOR(YLW)
     A                                  4 69'Col:'
     A                                      COLOR(YLW)
     A            CRSROW         2S 0O  3 76COLOR(YLW)
     A            CRSCOL         2S 0O  4 76COLOR(YLW)
     A                                  3  6'D=Delete E=Edit'
     A                                      COLOR(BLU)
     A                                  4  9'Position to:'
     A            POSTO         25A  B  4 22CHECK(LC)
     A            TOTSF#         4  0O  2 74COLOR(YLW)
     A                                  2 58'Number'
     A                                      COLOR(YLW)
     A                                  2 65'Records:'
     A                                      COLOR(YLW)
     A          R FOOTER
     A*%%TS  SD  20020915  194912  VOTEJM      REL-V5R1M0  5722-WDS
     A                                      OVERLAY
     A                                 23  2'F3=Exit'
     A                                      COLOR(BLU)
     A  13        DSPMSG        78A  O 24  2DSPATR(RI)
     A                                 23 23'F6=Add'
     A                                      COLOR(BLU)
     A                                 23 11'F5=Refresh'
     A                                      COLOR(BLU)
     A          R DETAIL
     A*%%TS  SD  20020916  164318  VOTEJM      REL-V5R1M0  5722-WDS
     A                                      CF03
     A N41                                  CF09
     A                                      CF12
     A                                  1 27'Simple Name List Program'
     A                                      COLOR(WHT)
     A                                  2 23'Subfile Example - Jon Vote - 2002'
     A                                      COLOR(WHT)
     A                                 23  2'F3=Exit'
     A                                      COLOR(BLU)
     A  13        DSPMSG        78A  O 24  2DSPATR(RI)
     A                                 23 33'F12=Cancel'
     A                                      COLOR(BLU)
     A                                  6 10'Record ID.....:'
     A            PRIKEY         9S 0O  6 26
     A                                  3 28'www.idioma-software.com'
     A                                      COLOR(TRQ)
     A                                      DSPATR(UL)
     A                                  7 10'First Name....:'
     A            NMEFST        15A  B  7 26
     A  41                                  DSPATR(PR)
     A                                      CHECK(LC)
     A                                  9 10'Last Name.....:'
     A            NMELST        15A  B  9 26
     A  41                                  DSPATR(PR)
     A                                      CHECK(LC)
     A                                  8 10'Middle Initial:'
     A            NMEMID         1A  B  8 26
     A  41                                  DSPATR(PR)
     A                                      CHECK(LC)
     A                                 10 10'Phone Number..:'
     A                                 11 10'Email Address.:'
     A            PHONE#        40A  B 10 26
     A  41                                  DSPATR(PR)
     A                                      CHECK(LC)
     A            EMAIL@        40A  B 11 26
     A  41                                  DSPATR(PR)
     A                                      CHECK(LC)
     A  41                             14 10'Delete record - are you sure?:'
     A                                      COLOR(RED)
     A  41        OK2DLT         1A  B 14 41
     A N41                             23 12'F9=Update and exit'
     A                                      COLOR(BLU)






     A**************************************************************
     A** - NMELSTP: Simple Name List File
     A**************************************************************
     A**
     A** - Jon Vote
     A** - 09/2002
     A**
     A** - Related source members:
     A** -   NMELSTR: Simple Name List Program
     A**     NMELSTP: Pysical file used with NMELSTR
     A**     NMELST1: Logical over NMELSTP
     A**     NMELSTS: Display File used with NMELSTR
     A**
     A** - This file is used for the Name List subfile example
     A** - only and is not meant to demonstrate a properly
     A** - normalized database.
     A**
     A                                      UNIQUE
     A          R NMELSTF                   TEXT('NAME LIST')
     A**
     A            PRIKEY         9S 0       TEXT('Primary Key')
     A            NMEFST        15          TEXT('First Name')
     A            NMEMID         1          TEXT('Middle Initial')
     A            NMELST        15          TEXT('Last Name')
     A            PHONE#        40          TEXT('Phone Number')
     A            EMAIL@        40          TEXT('Email Address')
     A**
     A** - This key is being defined here to simplify the example.
     A** - Normally you should not key a physical file.
     A**
     A          K NMELST
     A          K NMEFST
     A          K NMEMID
     A          K PHONE#
     A          K PRIKEY




     A**************************************************************
     A** - NMELST1: Simple Name List File - By PRIKEY
     A**************************************************************
     A**
     A** - Jon Vote
     A** - 09/2002
     A** - www.idioma-software.com
     A**
     A** - Related source members:
     A** -   NMELSTR: Simple Name List Program
     A**     NMELSTP: Pysical file used with NMELSTR
     A**     NMELST1: Logical over NMELSTP
     A**     NMELSTS: Display File used with NMELSTR
     A**
     A                                      UNIQUE
     A          R NMELSTF                   PFILE(NMELSTP)
     A          K PRIKEY



This article has been viewed 5747 times.
The examples on this page are presented "as is". They may be used in code as long as credit is given to the original author. Contents of this page may not be reproduced or published in any other manner what so ever without written permission from Idioma Software Inc.