|
midrange.com
You can have them in the SFLCTL format.
As I don't have a whole load of time to type something new out, here's one
that does pretty close to same thing. It's a subfile records with a
position to field:
A R CPSTRPYW
A OVERLAY
A WINDOW(4 5 19 70)
A 28 WDWTITLE((*TEXT ' F2=Previous
F6=B-
A y Description Enter=Continue
') (*-
A COLOR WHT) *BOTTOM)
A N28 WDWTITLE((*TEXT ' F2=Previous
F6=B-
A y Type Enter=Continue ')
(*COLOR -
A WHT) *BOTTOM)
A R CPSTRPY1 SFL
A SF2TYP 2S 0H
A SF2DSC 36A H
A SF3MSG 1A H
A SF3BG# 10Y 0H
A SF2OPT 1A B 6 2VALUES(' ' 'X')
A CHKMSGID(OUR0035
*LIBL/OURMSGF)
A 66 DSPATR(RI)
A SF2LIN 40A O 6 5
A SF2BG# 12A O 6 46
A SF3CST 9Y 2O 6 59EDTCDE(3)
A R CPSTRPYH SFLCTL(CPSTRPY1)
A*%%TS SD 20031110 091016 RPOWER REL-V5R2M0 5722-WDS
A SFLSIZ(9999)
A SFLPAG(0012)
A WINDOW(CPSTRPYW)
A CF02
A CF06
A OVERLAY
A 40 SFLDSP
A SFLDSPCTL
A 41 SFLCLR
A 42 SFLEND(*SCRBAR *MORE)
A RCD#2 4S 0H SFLRCDNBR(CURSOR)
A SYSNAM 8A O 1 1
A 1 25'Select Transaction Type'
A DSPATR(HI)
A DATYMD 10A O 1 61
A PRGSYS 21A O 2 1
A CURTIM 8A O 2 63
A 3 4'Position To:'
A DSPATR(HI)
A POSDSC 20A B 3 17CHECK(LC)
A DSPATR(PC)
A 3 38'Description'
A 4 4'X=Select'
A 5 1'Opt'
A DSPATR(HI)
A 5 5'Description'
A DSPATR(HI)
A 5 46'Budget #'
A DSPATR(HI)
A 5 63'Charge'
A DSPATR(HI)
And the RPG code.
c exsr clearsub2
?* load subfile 2
c exsr loadsub2
?* if saved record number not 0, then we selected at least one record
c if savrcd#2 <> 0 and not(*in29)
c eval rcd#2 = savrcd#2
c endif
?* define window headings
c eval prgsys = %trim(pgmlib)+'/CPSTRPYH'
c exsr refresh_time
?* display window and subfile
c eval posdsc = *blanks
c seton 4042
c exfmt cpstrpyh
c setoff 4066
c Exsr Clear_Error
?* F2 pressed, leave this screen
c if *inkb
c setoff kb
c leave
c endif
?* position to was entered, reposition subfile
c if posdsc <> *blanks
c iter
c endif
?* process selected records
c readc cpstrpy1
99
c dow not(*in99)
c eval savrcd#2 = sflrrn2
c if sf2opt = 'X'
c evalr paytyp = %char(sf2typ)
c exsr proc_paytype
c if *in66
c eval savrcd#2 = sflrrn2
c update cpstrpy1
c eval sf2opt = *blanks
c leave
c endif
c eval sf2opt = *blanks
c update cpstrpy1
c endif
c readc cpstrpy1
99
c enddo
?
*-----------------------------------------------------------------------
?* CLEARSUB2 - clear subfile#2 - cpstrpy1
?
*-----------------------------------------------------------------------
c clearsub2 begsr
c eval sflrrn2 = 0
c write cpstrpyw
c seton 41
c write cpstrpyh
c setoff 41
c endsr
?
*-----------------------------------------------------------------------
?* LOADSUB2 - load subfile #2 - cpstrcpy1
?
*-----------------------------------------------------------------------
c loadsub2 begsr
?* initialize rcd#2 so that we can test for position to field.
c eval rcd#2 = 0
?* sorted by description
c if posdsc = *blanks
c setoff 29
c else
c seton 29
c endif
?* convert position to field to upper case
c lo:up xlate posdsc upper_posdsc
c eval w = 1
c *blanks lookup sf2sdscb(w) 99
c dow w <= 200
?* populate subfile fields
c eval sf2typ = sf2stypb(w)
c eval sf2dsc = sf2sdscb(w)
c eval sf2typa = sf2stypb(w)
c eval sf2dsca = sf2sdscb(w)
c eval sf2lin = sf2lina
c eval sf2bg# = %trim(%editw(sf2sbg#b(w):
c ' - - '))
c eval sf3bg# = sf2sbg#b(w)
c eval sf3cst = sf3scstb(w)
c eval sf3msg = sf3smsgb(w)
?* increase rrn
c eval sflrrn2 = sflrrn2 + 1
?* write the subfile record
c write cpstrpy1
?* is the position to field here?
c lo:up xlate sf2dsc upper_sf2dsc
c if upper_sf2dsc >= upper_posdsc and rcd#2
= 0
c eval rcd#2 = sflrrn2
c endif
c eval w = w + 1
c enddo
c if sflrrn2 = 0
c eval sflrrn2 = 1
c eval rcd#2 = 1
c eval sf2typ = 0
c eval sf2dsc = 'None Found!'
c eval sf2bg# = *blanks
c write cpstrpy1
c endif
c if *in29
c if rcd#2 = 0
c eval rcd#2 = sflrrn2
c endif
c else
c eval rcd#2 = 1
c endif
c endsr
Hope this helps.
Ron Power
Programmer
Information Services
City Of St. John's, NL
P.O. Box 908
St. John's, NL
A1C 5M2
Tel: 709-576-8132
Email: rpower@xxxxxxxxxx
Website: http://www.stjohns.ca/
___________________________________________________________________________
Success is going from failure to failure without a loss of enthusiasm. -
Sir Winston Churchill
Tony Carolla <carolla@xxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
21/12/2004 03:39 PM
Please respond to
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>
To
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>
cc
Subject
The best approach...
I have a lookup inquiry module I am building, and I am not sure what
the best approach is. I usually build this type of application with a
parameter format, which allows them to put in their search criteria,
then a sfl/sflctl format pair that shows them the results. To choose
different parms, they simply press F12, and are taken back to the parm
format, yadda yadda yadda, until they press F3
But I would like this one to be different. I want to have a top
section of the screen that allows them to enter search criteria, and a
bottom section of the screen that allows selection of items in a
sub-file of the entries that are found. Entry of either a character
on a subfile line takes them to a detail screen format, and entry of
new parameters in the top section rebuilds the subfile in the bottom
section.
I started thinking of using window-bordering, and making a top format
window for entry, a middle format window for the subfile control
record, a lower middle format window for the subfile, and a bottom
format window for F-key and instruction line. But I am not sure, if I
use the selection parms and exfmt the subfile, and the user changes
the top format window selection parameters, will I receive these in
the DSPF field buffers? Or will only the subfile records change?
Is there a better way to do this? Can you have input fields in the
SFLCTL format?
--
"Enter any 11-digit prime number to continue..."
--
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.
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2025 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.
