Re: Data Entry Subfile

Were you actually looking for someone to clean up your code? Anyway...


c exsr init
* get the kitno from user.
c exfmt hdr
c DoW '1' -- New
c exsr setsfl
c *inkc ifeq *on
c *inkl oreq *on
c Leave -- New
c endif
c*
c *in99 ifeq *on
c Iter
c else
c Leave -- New
c endif
c EndDo -- New
c eval *inlr = *on


Michael Schutte
Admin Professional
Bob Evans Farms, Inc.
3776 South High Street, Columbus, OH 43207
Phone: 614/492-7419 Fax: 614/409-2017
Visit us on the web! www.bobevans.com

(Embedded image moved to file: pic25547.gif)

What's the secret? Find out at your Bob Evans Restaurant on May 17!


rpg400-l-bounces@xxxxxxxxxxxx wrote on 06/21/2007 09:27:10 AM:

Thanks to all who responded yesterday. I put together something that
works but I need to improve the code, specifically the GOTO's. I
hate them also but I had to get it to work. But clearly, this has to
be improved on. It is not modular ILE but for now I want to get it
right in this way.

What I do is I need to check that the record being entered is not
already in the file. If it is, I turn on *99 and then I am not sure
what is the best approach. I basically want to keep the subfile
where it is so the user can correct.

What this code does do, is that it will write good records to the
PF even tho there are also some bad records on the subfile. Not sure
if this is the best approach or the all or nothing is better. also
currenty if there is a good record, the user can keep hitting enter
and nothing happens, no adds but it stays there. But maybe this
allows them to continue to enter new records. F3 or 12 does exit
them tho. Again, not sure what is the best approach.

Any help in this would be greatly appreciated. code below.

Fobdpnp cf e workstn

F sfile(sfl1:rrn1)

Fobppnp uf a e k disk

Foblpnp1 if a e k disk rename(obfpnp:lf01)

F

*

*****************************************************************

* Main Routine

*****************************************************************

*

c exsr init

* get the kitno from user.

c exfmt hdr

c subfil tag
c exsr setsfl
c *inkc ifeq *on
c *inkl oreq *on
c goto lastr
c endif
c*
c *in99 ifeq *on
c goto subfil
c else
c eval *inlr = *on
c endif
c lastr tag
c eval *inlr = *on
c
C prcsfl begsr
c eval *in99 = *off
C readc sfl1
*
* Do loop to process until all changed records are read
*
C dow not %eof
*
C select
*
C when (kmodk > ' ')
c eval kitno = kitnum
c kitkey chain lf01
c if %found
c eval *in99 = *on
c leave
c endif

c add 1 rrn1
C write obfpnp
*
C endsl
*
c readc sfl1
c enddo
C endsr
*

c setsfl begsr
C eval *in31 = *on
c eval rrn1 = 1
c eval kitno = kitnum
c write sf1ctl
C eval *in31 = *off
C eval *in90 = *on
c dou *inkc or *inkl
c write fkey1
c exfmt sf1ctl
c if (not *inkc) and (not *inkl)
c exsr prcsfl
c endif
c enddo
c endsr
*
c init begsr
c kitkey klist
c kfld co
c kfld div
c kfld acct
c kfld kitnum
c kfld kmodk



---------------------------------
Got a little couch potato?
Check out fun summer activities for kids.
--
This is the RPG programming on the AS400 / iSeries (RPG400-L) mailing

list

To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.