Re: Subfile Failing on no read before update

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.