RE: Subfile Failing on no read before update -- RPG400-L

Chain to the subfile using the relative record number from 1 incrementing
by 1 until not %found

Alan Shore
Programmer/Analyst, Direct Response
E:AShore@xxxxxxxx
P:(631) 200-5019
C:(631) 880-8640
"If you're going through Hell, keep going" - Winston Churchill

"Dennis Lovelady"
<iseries@lovelady
.com> To
Sent by: "'RPG programming on the IBM i /
rpg400-l-bounces@ System i'" <rpg400-l@xxxxxxxxxxxx>
midrange.com cc

Subject
07/09/2010 03:05 RE: Subfile Failing on no read
PM before update

Please respond to
RPG programming
on the IBM i /
System i
<rpg400-l@midrang
e.com>

Well, FOR/ENDFOR is not an alternative for READC. What do you suggest to
replace the READC statement?

Dennis Lovelady
http://www.linkedin.com/in/dennislovelady
--
"I would give my right arm to be ambidextrous."
-- Yogi Berra

Best piece of advice I ever received on READC was "Forget about using
READC. Use a for/endfor loop. Just a whole lot of silly problems go
away."

On Fri, Jul 9, 2010 at 9:33 AM, Dave

Petrosky<Dave.Petrosky@xxxxxxxxxx>wrote:

I am testing a subfile and it is blowing up. I am putting in an

invalid

option (on purpose), expecting to see the error message displayed by

the

message subfile.
Here is the entry in the job log:

I have checked over and over and am completely stuck. My co-workers
looked at the code and can't find anything either. The READC is
successful, since the error message does get to the job log and

since

the code gets to the update statement. So why after the READC does

the

UPDATE fail? I have removed the chain to the PF to check if that was

a

problem, and it was not.

call mcstmst2

Invalid option entered

Do change to subfile by GET for file MCSTMST2FM in library

HSDEVELOP.

? C

Do change to subfile by GET for file MCSTMST2FM in library

HSDEVELOP.

? C

Update or delete in file MCSTMST2FM without prior input operation.

Function check. RNX1221 unmonitored by MCSTMST2 at statement
0000000656,
instruction X'0000'.

The call to KEYPRESS ended in error (C G D F).

The call to KEYPRESS ended in error (C G D F).

Here is the releveant part of the RPG:

fmcstmst2fmcf e workstn sfile(MCSTS1:xhrrn)
f infds(@devds)
f indds(Indicators)

PcheckInput b
DcheckInput pi
D iStack s 10i 0 inz(1)
/free

// Set off the subfile error indicator and keep track if any
records
// were selected.
w@ferr = *off;
//
// Read Changed through the subfile. For every record that

the

user
// selected verify that the subfile record selected is

correct

for
// the desired action.
readc MCSTS1;
dow %eof = *off and Cancel = *off;
//
// Check all non-blank entries.
if zzopt<> *blanks;
//
// Set all needed indicators.
SflNxtChg = *on;
ErrorOption = *off;
ErrorMain = *off;
w@msid = *blanks;
//
//Verify this record against the MCSTMST2P file
chain (mpcmpn:mpcusn:mpdate:mptime) MCSTMST2P;

select;
// NOT Found
When NOT %found;
w@msid = 'MAI0007';
ErrorMain = *on;
// Invalid option.
when zzopt<> '1' and
zzopt<> '4' and
zzopt<> '5' and
zzopt<> '7';
w@msid = 'MAI0005';
ErrorMain = *on;
endsl;
//
// If there was an error, process it.
if ErrorMain = *on or w@ferr = *on;
//
// If this is the first error, remember the relative number
// for positioning.
if w@ferr = *off;
s@rrn = w@err;
w@ferr = *on;
endif;
//
// Highlight and position the cursor to the error.
if ErrorMain = *on;
ErrorOption = *on;
endif;
//
// Place the error message into the message subfile.
// If needed.
msgfd(w@msid : w@msgf : w@msda : w@mstp :
iStack: ErrorDs);
//
// Update the record in the subfile.
update MCSTS1;<------------Blows up here

And here is the relevant part of the DDS.

A R MCSTS1 SFL
A 35 SFLNXTCHG
A**
A ZZOPT 1A B 9 3
A 36 DSPATR(RI)
A 36 DSPATR(PC)
A N37 DSPATR(UL)
A 37 DSPATR(PR)
A ZZCMPN R O 9 7REFFLD(FCCMPN FCCSTAP)
A ZZCUSN R O 9 13REFFLD(FCCUSN FCCSTAP)
A ZZCNMB R O 9 25REFFLD(FCCNMB FCCSTAP)
A ZZCA1B R O 9 52REFFLD(FCCA1B FCCSTAP)
A ZZCA2B R O 10 7REFFLD(FCCA2B FCCSTAP)
A ZZCTYB R O 10 34REFFLD(FCCTYB FCCSTAP)
A ZZSTEB R O 10 51REFFLD(FCSTEB FCCSTAP)
A ZZZPCB R O 10 55REFFLD(FCZPCB FCCSTAP)
A ZZDATE 10A H
A ZZTIME 10A H

A*------------------------------------------------------------------

----

--*
A* Subfile Control for MCSTS1
*

A*------------------------------------------------------------------

----

--*
A R MCSTMSTC1 SFLCTL(MCSTS1)
A TEXT('Subfile Control')
A SFLSIZ(12)
A SFLPAG(6)
A RTNCSRLOC(&S@RCD&S@FLD)
A OVERLAY
A 30 SFLDSP
A 31 SFLDSPCTL
A 32 SFLEND(*MORE)
A N32 ROLLUP(29)
A 33 SFLINZ
A 34 SFLCLR
A**
A 18 SFLFOLD(CF18)
A N18 SFLDROP(CF18)
A**
A CF03(03 'Exit')
A CF05(05 'Refresh')
A CF12(03)
A CF18(18 'Fold/Unfold')
A S@RCD 10A H
A S@FLD 10A H
A XHRRN 4S 0H SFLRCDNBR
A 4 2'Type options, press

Enter.'

A COLOR(BLU)
A 5 4'1=Add to Customer

Master

4=Delete-
A 5=Display 7=Update
Addresses'
A COLOR(BLU)
A*****
A 8 2'Opt'
A DSPATR(HI)
A 7 7'Co'
A DSPATR(HI)
A 8 7'Code'
A DSPATR(HI)
A 7 13'Customer'
A DSPATR(HI)
A 8 13'Number'
A DSPATR(HI)
A 8 25'Customer Name'
A DSPATR(HI)
A 8 52'Address Line 1'
A DSPATR(HI)

David M. Petrosky
Programmer/Analyst
Maines Paper& Food Service, Inc.
101 Broome Corporate Parkway
Conklin, NY 13748
(office) 607-251-7378
dave.petrosky@xxxxxxxxxx
www.maines.net

--
This is the RPG programming on the IBM i / System i (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.