Re: Value in field does not match database????

Maybe I've really missed something here, but you state that PSQ is defined
as a 3000 byte array of single characters. If this is try the value of
3409 should trigger a subscript out of range error (iirc MCH0603). There
would definitely be problems with that.

Michael Quigley
Computer Services
The Way International

"RPG400-L" <rpg400-l-bounces@xxxxxxxxxxxxxxxxxx> wrote on 09/05/2019
05:30:24 PM:

----- Message from Greg Wilburn <gwilburn@xxxxxxxxxxxxxxxxxxxxxxx>
on Thu, 5 Sep 2019 20:58:14 +0000 -----

To:

RPG programming on IBM i <rpg400-l@xxxxxxxxxxxxxxxxxx>

Subject:

RE: Value in field does not match database????

Not to create too many threads here...

Alan - the file (and logical files) exist in ONE library only.
WRKOBJ OBJ(*ALL/OEORD2) yields one result.

ODSEQ# is the field in the program AND the file. They used a DDS
"field definition file" for nearly all of their fields. In the DDS
ODSEQ# is defined by reference to WWSEQ5.

PSQ is char(3000) and is the parameter of an program (in our ERP
software) I'm calling. I have the source code... the program I'm
calling has this parameter defined as CHAR(1) DIM(3000).
I can't imagine that would be a problem.

I don't have the CONST keyword on the procedure interface of my old
progam... but I can't imagine that being a problem either.\\

This is the simple little program (minus the reporting subroutines)
- don't be hating on the old, old style here :) - its 15+ years old.

* PARAMETER LIST
*
D hh531 pr extpgm('HH531')
D pcom# 3a
D pprt# 15a
D prsnc 3a
D pent# 8a
*
D hh531 pi
D pcom# 3a
D pprt# 15a
D prsnc 3a
D pent# 8a
*

*-------------------------------------------------------------------------

*
D PORD# S 8A
D PSQ S 3000A
D PTRNC S 3A
D*
/COPY ASTHHSRC92/QCPYSRC,ASTUTIL_PR

*-------------------------------------------------------------------------

C IF PCOM# = *BLANKS OR
C PPRT# = *BLANKS
C GOTO ENDC
C ENDIF
C*
C IF Ast_GetRf('5198':PRSNC) = *BLANKS
C EVAL CLMN1 = PRSNC
C EVAL CLMN2 = 'INVALID REASON CODE ENTERED'
C WRITE RPTHDR
C WRITE RPTDTL
C GOTO ENDC
C ENDIF
C*
C EVAL ODCOM# = PCOM#
C EVAL ODPRT# = PPRT#
C ODKEY SETLL OEORDLRR
C DOU %EOF(OEORD2)
C ODKEY READE OEORDLRR
C IF NOT %EOF(OEORD2)
C*
C IF ODLSTC <> 'CL' AND
C ODLSTC <> 'CN' AND
C ODALC# = *ZERO AND
C ODCTT# = *ZERO
C*
C CLEAR PSQ
C EVAL %SUBST(PSQ:ODSEQ#:1) = 'X'
C*
C if pent# = *blanks or
C pent# = odent#
C CALL 'OE030'
C PARM ODCOM# PCOM#
C PARM ODORD# PORD#
C PARM PSQ
C PARM '531' PTRNC
C*
C EXSR RPTSR
C EXSR WRTDM
SHADOW DEMAND
C*
C endif
C ENDIF
C ENDIF
C ENDDO
C*
C ENDC TAG
C SETON LR