× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Booth, thanks, what will adding to the subfile give me?
currently it works fine. If it is a good record, it gets added. if not, it
redisplays.

Booth Martin <booth@xxxxxxxxxxxx> wrote:
Here's my untested shot at the homework. I do not see any place where
you actually ever added any records to the subfile though?
(Use fixed font.)
Fobdpnp cf e
workstn
F
sfile(sfl1:rrn1)
Fobppnp uf a e k
disk
Foblpnp1 if e k disk
rename(obfpnp:lf01)


*****************************************************************
* Main
Routine
*****************************************************************
* get the kitno from
user.
c exfmt
hdr
c exsr setsfl
c dou *inkc or *inkl
c exsr setsfl
c enddo
c eval *inlr = *on
*****************************************************************
* End of Main
Routine

*****************************************************************
C prcsfl begsr
* Loop to process all changed records
C for RRN1 = 1 to %eof(sfl1)
C RRN1 chain sfl1
C if (kmodk > ' ')
c eval kitno = kitnum
c kitkey chain lf01
c if %found
c update lf01
c else
C write lf01
C endif
C endif
c endfor
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 write fkey1
*
c dou *inkc or *inkl
c exfmt sf1ctl
c if (not *inkc) and (not *inkl)
c exsr prcsfl
c endif
c enddo
c endsr

*****************************************************************
c *inzsr begsr
c kitkey klist
c kfld co
c kfld div
c kfld acct
c kfld kitnum
c kfld kmodk
c endsr
*****************************************************************

Mike Berman wrote:
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.



As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.