|
Hello everybody!
I need help with CHAIN operation in service pgm.
My srvpgm contains subprocedure that returns some data from file and here
is code:
H NOMAIN
FFILE1 IF E K DISK USROPN
FFILE2 IF E K DISK USROPN
/COPY LIB/SRCFILE,SPPROTOS
................
................
PgetValue B EXPORT
DgetValue...
D PI 15P 2
D P1 3A VALUE
D P2 6S 0 VALUE
D P3 3A VALUE
D P4 4S 0 VALUE
D P5 2S 0 VALUE
D
D tmpStruct DS
D FIELD1 3A
D FIELD2 15A
D KEYdata DS
D K1 3A
D K2 6S 0
D K3 3A
D K4 4S 0
D K5 2S 0
*----------------------------------------------------------
* FILE1 key list
C KEY_F1 KLIST
C Kfld K1
C Kfld K2
C Kfld K3
C Kfld K4
C Kfld K5
* FILE2 key list
C KEY_F2 KLIST
C Kfld K2
C Kfld K3
C Kfld K4
C Kfld K5
C Kfld K1
* Eval key fields
C Eval K1 = P1
C Eval K2 = P2
C Eval K3 = P3
C Eval K4 = P4
C Eval K5 = P5
* Open files
C OPEN REIAC
C OPEN ACCBR
* PROBLEM LINE1 This chain makes data from tmpStruct avaiable
C KEY_F2 CHAIN F2RF2
C if %FOUND
* Define new key values
C move tmpStruct KEYdata
* PROBLEM LINE2 This chain will retrieve value in VALUE field
C KEY_F1 CHAIN F1RF1
C if %FOUND
C Close *ALL
C RETURN VALUE
C EndIf
C EndIf
C Close *ALL
C RETURN 0
PgetValue E
I create srvpgm with crtsrvpgm with EXPORT(*all) and in aditional options
DFTACTGP(*caller).
I found problem while running program in debug mode and problem is first
CHAIN operation that does nothing. It doesn't retrieve values of record
with defined key and %FOUND function returns *ON. Next thing, evaluation
of KEY_F1 is wrong and then happens error while CHAIN on FILE1. In that
statement srvpgm throws exception (Decimal data error).
I checked %STATUS after chain on file2 but it's 00000. Everything is
normal. I even put indicator in psition 71 and it is set to *OFF. There is
no any evidence of error but error is clearly evident.
Please help.
Igor Bešlić, dipl. ing. rač.
VOLKSBANK d.d.
OJ Informatika
Zelinska 2, 10000 Zagreb
tel: +385 1 6326422
e-mail: Igor.Beslic@xxxxxxxxxxxx
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.