*
      *  To compile:
      *
      *             CRTRPGPGM PGM(XXX/DTAUPDRG) SRCFILE(XXX/QRPGLESRC)
      *
      *=======================================================================
     Fdtaupddf  cf   e             workstn
     F                                     sfile(sfl1:rrn1)
     Fsfl001lf  if   e           k disk    prefix(in_)
     Fsfl001pf  uf a e           k disk    prefix(up_)
     F                                     rename(pfr:up_pfr)
      *
      *****************************************************************
      *  Main Routine
      *****************************************************************
      *
      * Build the subfile
      *
     C                   exsr      sflbld
      *
      * Do loop to process the subfile until F3 or F12 is pressed
      *
     C                   dou       *inkc or *inkl
      *
     C                   write     fkey1
     C                   exfmt     sf1ctl
      *
      * Process changes if enter key pressed
      *
     C                   if        (not *inkc) and (not *inkl)
     C                   exsr      prcsfl
     C                   endif
      *
     C                   enddo
      *
     C                   eval      *inlr = *on
      *
      *****************************************************************
      *  SFLBLD - Build the List
      *****************************************************************
      *
     C     sflbld        begsr
      *
      *  Clear subfile - RRN1 has to > 0 to initialize records
      *
     C                   eval      *in31 = *on
     C                   eval      rrn1 = 1
     C                   write     sf1ctl
     C                   eval      rrn1 = 0
     C                   eval      *in31 = *off
      *
      * Load data to subfile
      *
     C     *loval        setll     sfl001lf
     C                   read      sfl001lf

     C                   dow       (not %eof) and (rrn1 <= 50)
     C                   eval      rrn1 = rrn1 + 1
     C                   eval      dbidnm = in_dbidnm
     C                   eval      dblnam = in_dblnam
     C                   eval      dbfnam = in_dbfnam
     C                   eval      dbmini = in_dbmini
     C                   eval      dbnnam = in_dbnnam
     C                   write     sfl1
     C                   read      sfl001lf
     C                   enddo
      *
      * If no records were loaded, do not display the subfile - else
      * increment the relative record by one to place the cursor on
      * the first empty subfile record - SFLRCDNBR(CURSOR)
      *
     C                   if        rrn1 = *zero
     C                   eval      *in32 = *on
     C                   else
     C                   eval      rrn1 = rrn1 + 1
     C                   endif
      *
      * set on indicator 90 to display more and bottom
      *
     C                   eval      *in90 = *on
      *
     C                   endsr
      *
      *****************************************************************
      *  PRCSFL - Process the subfile
      *****************************************************************
      *
     C     prcsfl        begsr
      *
     C                   readc     sfl1
      *
      * Do loop to process until all changed records are read
      *
     C                   dow       not %eof
      *
     C                   select
      *
      * Add when hidden field is empty but something's in the subfile
      *
     C                   when      (dbidnm = 0) and (dblnam > *blanks)
     C     *hival        setgt     sfl001pf
     C                   readp     sfl001pf
     C                   eval      up_dblnam = dblnam
     C                   eval      up_dbfnam = dbfnam
     C                   eval      up_dbmini = dbmini
     C                   eval      up_dbnnam = dbnnam
     C                   eval      up_dbidnm = up_dbidnm + 1
     C                   write     up_pfr
      *
      * Update when hidden field is not empty and neither is last name
      *
     C                   when      (dbidnm <> 0) and (dblnam > *blanks)
     C     dbidnm        chain     sfl001pf
     C                   eval      up_dblnam = dblnam
     C                   eval      up_dbfnam = dbfnam
     C                   eval      up_dbmini = dbmini
     C                   eval      up_dbnnam = dbnnam
     C                   if        %found
     C                   update    up_pfr
     C                   endif
      *
      * Delete when hidden field is not empty but last name is empty
      *
     C                   when      (dbidnm <> 0) and (dblnam = *blanks)
     C     dbidnm        chain     sfl001pf
     C                   if        %found
     C                   delete    up_pfr
     C                   endif
      *
     C                   endsl
     C                   readc     sfl1
     C                   enddo
      *
     C                   exsr      sflbld
      *
     C                   endsr
      *