Disregard... after 3 days, I figured it out.
The logic did no allow for an EXISTING duplicate (likely inserted by another application)
Changed the following code.
base36 = CurrSfx;
CurrNum = strtol(%trim(base36):*null:36); // Alpha to Num
// if CurrNum - LastNum = 1;
if CurrNum - LastNum <= 1;
LastNum = CurrNum;
iter;
else;
leave;
endif;
-----Original Message-----
From: RPG400-L <rpg400-l-bounces@xxxxxxxxxxxxxxxxxx> On Behalf Of Greg Wilburn
Sent: Tuesday, January 4, 2022 4:24 PM
To: RPG programming on IBM i <rpg400-l@xxxxxxxxxxxxxxxxxx>
Subject: Weird Issue with Duplicate Rows
I've experienced something very weird... a program that we've used quite bit has (on 3 occasions) created rows with duplicate keys.
First off, the files/LFs did not (they do now) have the UNIQUE keyword - I've since created a LF with UNIQUE.
I have an RPG Program that creates new shipping addresses for a Customer Number. Each Customer can have multiple ship-to address "suffixes" (key is customer + suffix).
This program is called hundreds of times by another program as it's retrieving batches of web orders (i.e. each order in the batch likely has a different shipping address).
It flows as follows:
1. Chains by address to locate existing "suffix"... if not found
2. Calls a bound procedure NextSfx() which uses an (SQL Cursor) to read through the rows (ordered by field "suffix")
* It finds a suffix "number" that is "inbetween", OR
* The last one used
3. It returns the NextSfx() value to the RPG program, which writes 2 different files that use the "suffix" as part of the key
Things to note about NextSfx()
* The suffixes are 3-character, base36 values
* It uses SrtSeq=*LangIdUnq to begin at "000"
* It uses STRTOL() "String to Integer" and __LTOA() "Integer to String" to interpret the character values and increment to the next possible value
In my mind, one of two things must have occurred.
1. The logic used for incrementing failed, OR
2. The RPG program was called so quickly that the previous record was not written
I am not sure how to resolve this... Ideas??
TIA
This is the NextSfx() function:
// String to Integer - C Routine
dcl-pr strtol int(10) extproc('strtol');
nptr pointer value options(*string);
entptr pointer value;
base int(10) value;
end-pr;
// Integet to String - C Routine
dcl-pr ltoa int(10) extproc('__ltoa');
nuInt int(10) value;
szRtnBuffer pointer value;
nRadix int(10) value;
end-pr;
dcl-s number int(10);
dcl-s base36 char(32);
dcl-s i int(10);
dcl-s LastSfx char(3);
dcl-s CurrSfx char(3);
dcl-s NextSfx char(3);
dcl-s LastNum int(10) inz;
dcl-s CurrNum int(10) inz;
dcl-s NextNum int(10) inz;
NextSfx = '000';
LastSfx = '000';
// Find the last suffix used or any suffix between
// Starts at 000 (see SQL SrtSeq @ top of module)
Exec Sql
Declare adcsr Cursor For
Select adsfx#
From ADRESSAD
Where adent#=:inEnt#
Order by adsfx#
For Read Only;
Exec Sql
Open adcsr;
Dou SqlStt = sqlNoRow;
Exec Sql
Fetch Next From adcsr
Into :CurrSfx;
if CurrSfx='000';
iter;
endif;
if SqlStt = SqlNoRow;
LastNum = CurrNum;
leave;
endif;
base36 = CurrSfx;
CurrNum = strtol(%trim(base36):*null:36); // Alpha to Num
if CurrNum - LastNum = 1;
LastNum = CurrNum;
iter;
else;
leave;
endif;
enddo;
Exec Sql close adcsr;
NextNum = LastNum + 1;
base36 = *blanks;
ltoa(NextNum:%addr(base36):36); // Num to Alpha
// Uppercase & Removes trailing spaces in base36 string
for i = 1 to %len(%trim(base36));
%subst(base36:i:1) = %bitor(%subst(base36:i:1):X'40');
endfor;
i = 1 + %len(NextSfx) - %len(%trim(base36));
monitor;
%subst(NextSfx:i) = %trim(base36);
on-error;
NextSfx = '###';
endmon;
return NextSfx;
[Logo]<
https://www.totalbizfulfillment.com/> Greg Wilburn
Director of IT
301.895.3792 ext. 1231
301.895.3895 direct
gwilburn@xxxxxxxxxxxxxxxxxxxxxxx<mailto:gwilburn@xxxxxxxxxxxxxxxxxxxxxxx>
1 Corporate Dr
Grantsville, MD 21536
www.totalbizfulfillment.com<
http://www.totalbizfulfillment.com>
--
This is the RPG programming on IBM i (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit:
https://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxxxxxxxx
Before posting, please take a moment to review the archives
at
https://archive.midrange.com/rpg400-l.
Please contact support@xxxxxxxxxxxxxxxxxxxx for any subscription related questions.
Help support midrange.com by shopping at amazon.com with our affiliate link:
https://amazon.midrange.com
midrange.com
