× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



What you got was what the sql statement that the embedded built.

Here is the code entire code.

h/title REL001 - Customer Relationship File Maintenance
h DFTACTGRP(*NO) ACTGRP('QILE') BNDDIR('AAABIND')
h Option(*NoDebugIO : *SrcStmt : *ShowCpy)
h*Option(*SrcStmt : *ShowCpy)
f*
frel001fm cf e workstn sfile(rel001s1:rrn1)
f sfile(rel001s2:rrn2)
f infds(infds1)
f indds(CommandKey)
frel001u uf a e k disk
frel002u if e k disk usropn
frap001 if e k disk
ffrp028 if e k disk usropn
ffrp015 if e k disk usropn
d rrn1 s 4s 0 inz(0)
d xxrrn1 s 4s 0 inz(0)
d*
d rrn2 s 4s 0 inz(0)
d xxrrn2 s 4s 0 inz(0)
d*
d x s 5s 0
d y s 5s 0
d crw### s 2s 0
d ccl### s 2s 0
d*
d length s 3s 0
d blanks s 30a
d*
d updok s 1a
d xxupd s 1a
d pass1 s 1a
d xxtype s 1a inz('D')
d*
d Lawson c 'Lawson '
d Discount c 'Discount '
d*
d CommandKey ds
d Help 1 1
d F2 2 2
d Exit 3 3
d Prompt 4 4
d F5 5 5
d Add 6 6
d F7 7 7
d Uptree 8 8
d F9 9 9
d Update 10 10
d F11 11 11
d Previous 12 12
d SaveDefault 13 13
d F14 14 14
d Fold 15 15
d F16 16 16
d F17 17 17
d F18 18 18
d F19 19 19
d F20 20 20
d F21 21 21
d F22 22 22
d F23 23 23
d F24 24 24
d*
d Access 29 29
d*
d Display1 30 30
d DisplayCtl1 31 31
d SflClear1 32 32
d*
d Display2 33 33
d DisplayCtl2 34 34
d SflClear2 35 35
d*
d Active 54 54
d Inactive 55 55
d Ancestor 56 56
d LawsonFlg 57 57
d*
d InvCust 61 61
d InvPare 62 62
d OnFile 63 63
d Recursive 64 64
d ParEqChild 65 65
d*
d FoldCtl 80 80
d Protect 81 81
d More 90 90
d*
d Infds1 ds
d RcdFmt 261 270
d Aib 369 369
d scrfmt 38 45a
d cra### 370 371b 0
d*
d ds
d iwposi 1 30a
d iwposn 1 7a
d iwposa 1 30a
d*
d hostvar s 30a
d*
d ds
d xxcust# 1 7s 0
d xxcusta 1 7a
d*
d ds
d xxpare# 1 7s 0
d xxparea 1 7a
d*
d ds
d iwcustnum 1 7s 0
d xwcustnum 1 7a
d*
d z s 3s 0
d*
d ds
d s2cust# 1 9s 0
d s2cust 1 9a
d*
d*SqlResult ds
d* recust# 1 9s 0
d* reparent 10 18s 0
d* reina 19 19a
d* relchdt 20 45z
d* relchby 46 55a
d* readddt 56 81z
d* readdby 82 91a
d* reorig 92 92a
d* retype 93 93a
d* rehlevel 94 95s 0
d* reancest 96 104s 0
d* cmcust 105 111a
d* cmname 112 141a
d*
d SqlResult ds
d recust# 9s 0
d reparent 9s 0
d reina 1a
d relchdt z
d relchby 10a
d readddt z
d readdby 10a
d reorig 1a
d retype 1a
d rehlevel 2s 0
d reancest 9s 0
d cmcust 7a
d cmname 30a
d*
d Sql s 1000a
d*
d Select c const('Select -
d recust#, -
d reparent, -
d reina, -
d relchdt, -
d relchby, -
d readddt, -
d readdby, -
d reorig, -
d retype, -
d rehlevel, -
d reancest, -
d cmcust, -
d cmname ')
d*
d From c const('From abfiles.rel001p -
d inner join abfiles.rap001 ')
d*
d Where1 c const('on recust# = cmcust
')
d Where2 c const('on reparent = cmcust
')
d*
d Where3 c const('Where cmname like ')
d*
d Where4 c const('Where cmname >= ')
d*
d OrderBy c const('Order by cmname ')
d*
d rQuote c const(X'7D')
d comma c const(',')
d pcent c const('%')
d Enter c const(X'F1')
d Spacer c const(X'40')
d*
d ds
d rtcus 1 900s 0 dim(100)
d rtcus001 1 9s 0
d rtcus002 10 18s 0
d rtcus003 19 27s 0
d rtcus004 28 36s 0
d rtcus005 37 45s 0
d rtcus006 46 54s 0
d rtcus007 55 63s 0
d rtcus008 64 72s 0
d rtcus009 73 81s 0
d rtcus010 82 90s 0
d rtcus011 91 99s 0
d rtcus012 100 108s 0
d rtcus013 109 117s 0
d rtcus014 118 126s 0
d rtcus015 127 135s 0
d rtcus016 136 144s 0
d rtcus017 145 153s 0
d rtcus018 154 162s 0
d rtcus019 163 171s 0
d rtcus020 172 180s 0
d rtcus021 181 189s 0
d rtcus022 190 198s 0
d rtcus023 199 207s 0
d rtcus024 208 216s 0
d rtcus025 217 225s 0
d rtcus026 226 234s 0
d rtcus027 235 243s 0
d rtcus028 244 252s 0
d rtcus029 253 261s 0
d rtcus030 262 270s 0
d rtcus031 271 279s 0
d rtcus032 280 288s 0
d rtcus033 289 297s 0
d rtcus034 298 306s 0
d rtcus035 307 315s 0
d rtcus036 316 324s 0
d rtcus037 325 333s 0
d rtcus038 334 342s 0
d rtcus039 343 351s 0
d rtcus040 352 360s 0
d rtcus041 361 369s 0
d rtcus042 370 378s 0
d rtcus043 379 387s 0
d rtcus044 388 396s 0
d rtcus045 397 405s 0
d rtcus046 406 414s 0
d rtcus047 415 423s 0
d rtcus048 424 432s 0
d rtcus049 433 441s 0
d rtcus050 442 450s 0
d rtcus051 451 459s 0
d rtcus052 460 468s 0
d rtcus053 469 477s 0
d rtcus054 478 486s 0
d rtcus055 487 495s 0
d rtcus056 496 504s 0
d rtcus057 505 513s 0
d rtcus058 514 522s 0
d rtcus059 523 531s 0
d rtcus060 532 540s 0
d rtcus061 541 549s 0
d rtcus062 550 558s 0
d rtcus063 559 567s 0
d rtcus064 568 576s 0
d rtcus065 577 585s 0
d rtcus066 586 594s 0
d rtcus067 595 603s 0
d rtcus068 604 612s 0
d rtcus069 613 621s 0
d rtcus070 622 630s 0
d rtcus071 631 639s 0
d rtcus072 640 648s 0
d rtcus073 649 657s 0
d rtcus074 658 666s 0
d rtcus075 667 675s 0
d rtcus076 676 684s 0
d rtcus077 685 693s 0
d rtcus078 694 702s 0
d rtcus079 703 711s 0
d rtcus080 712 720s 0
d rtcus081 721 729s 0
d rtcus082 730 738s 0
d rtcus083 739 747s 0
d rtcus084 748 756s 0
d rtcus085 757 765s 0
d rtcus086 766 774s 0
d rtcus087 775 783s 0
d rtcus088 784 792s 0
d rtcus089 793 801s 0
d rtcus090 802 810s 0
d rtcus091 811 819s 0
d rtcus092 820 828s 0
d rtcus093 829 837s 0
d rtcus094 838 846s 0
d rtcus095 847 855s 0
d rtcus096 856 864s 0
d rtcus097 865 873s 0
d rtcus098 874 882s 0
d rtcus099 883 891s 0
d rtcus100 892 900s 0
d*
d hhmmss s t
d mmddyyyy s d datfmt(*usa)
d timestamp s z
d nulltime s t inz(t'00.00.00')
d nulltimestamp s z
d nulldate s d datfmt(*usa)
d*
d sds
d Program 1 10a
d SourceStmt 21 28a
d pRoutine 29 36a
d pParms 37 39s 0
d pExcpType 40 42a
d pExcpNbr 43 46a
d pReserv1 47 50a
d pCompiler 51 80a
d PgmLib 81 90a
d ExcptData 91 170a
d ExcptID 171 174a
d FileID 175 184a
d pReserv2 185 190a
d pJESDate 191 198a
d pJESYear 199 200s 0
d pFileInErr 201 208a
d StatusInfo 209 243a
d RJobName 244 253a
d RJobUser 254 263a
d RJobNbr 264 269s 0
d pUdate 270 275s 0
d pUdate1 276 281s 0
d phhmmss 282 287s 0
d pCompileD 288 293a
d pCompileT 294 299a
d pCompileL 300 303a
d pSrcFile 304 313a
d pSrclib 314 323a
d pSrcMbr 324 333a
d pPgmProc 334 343a
d pModProc 344 353a
d SrcID21 354 355b 0
d SrcID228 356 357b 0
d CUsrPrf 358 367a
d pReserv3 368 429a
d SDS_PROC *proc
d sds_status *status
d*************************************
d* Message File Parameters
d*************************************
d xsgid s 7a
d xsgloc s 20a inz('FRX001A *LIBL ')
d xsgRplDta s 10a inz(' ')
d xsgRplDtaLen s 10i 0 inz(0)
d xsgType s 10a inz('*DIAG')
d xsgQueue s 276a inz('*')
d xsgCallStack s 4b 0 inz(0)
d xsgKey s 4a inz(' ')
d xsgErr s 4b 0 inz(0)
d xsgRmv s 10a inz('*ALL')
d*************************************
d* Send Messages to Message Queue
d*************************************
d SendMsg pr ExtPgm('QMHSNDPM')
d xsgid 7a
d xsgloc 20a
d xsgRplDta 10a
d xsgRplDtaLen 10i 0
d xsgType 10a
d xsgQueue 276a
d xsgCallStack 4b 0
d xsgKey 4a
d xsgErr 4b 0
d*************************************
d* Remove Messages
d*************************************
d ReceiveMsg pr ExtPgm('QMHRMVPM')
d xsgQueue 276a
d xsgCallStack 4b 0
d xsgKey 4a
d xsgRmv 10a
d xsgErr 4b 0
d*
d PromptPgm1 pr ExtPgm('FBR931NEW')
d #term 3s 0
d #custnam 30a
d #custnum 7a
d #scnctl 1a
d*
d #term s 3s 0
d #custnam s 30a
d #custnum s 7a
d #scnctl s 1a
d MyCount s 4s 0
d*
d ds
d cust# 1 9s 0
d cust 1 9a
d ance# 10 18s 0
d ance 10 18a
d hlvl# 19 20s 0
d hlvl 19 20a
d*
d GetAnc pr extpgm('REL003')
d cust 9a
d ance 9a
d hlvl 2a
d*
d*EntryParm pr extpgm('REL001')
d* 3 0
d*EntryParm pi
d* @@term 3 0
d*
d UpdAnc pr extpgm('REL002')
d*
d UpdTree pr extpgm('REL004CL')
d*
d CloseIt pr extpgm('REL001C1')
d*
d InzSr pr
d SqlBld pr
d FetchNxt pr
d CloseCur pr
d*

/free

hhmmss = %time();
mmddyyyy = %date();
timestamp = %timestamp();
xxupd = *blank;
iwwsid = RJobName;

iwposi = *blank;
iwptyp = 'C';

//
// Retrieve User Profile Record
//
open frp028;
chain RJobUser ct9rec;
if not %found(frp028);
ct9dll = *zero;
endif;
close frp028;

//
// Retrieve Terminal Name
//
open frp015;
chain ct9dll ct1rec;
if %found(frp015);
length = (%size(ct1nam) - %len(%trim(ct1nam))) / 2;
iwtname = %subst(blanks:1:length) + %trim(ct1nam);
else;
iwtname = *blank;
endif;
close frp015;

//
// Begin of Main body
//
dow 1 = 1;

linnbr = *zero;
posnbr = *zero;

//
// Build Sql Command
//
SqlBld();

//
// Clear Subfile # 1
//
exsr sflclr1;

//
// Build Subfile # 1
//
exsr sflbld1;

//
// Display Subfile # 1
//
Display1 = *on;
DisplayCtl1 = *on;
write MsgCtl;
write cmdkey1;

write rel001c1;
read rel001c1;

// if iwposi = *blank;
// iwposi = 'A';
// endif;

//
// Clear Message Subfile
//
xsgkey = *blank;
xsgid = *blank;
exsr rcvmsg;

//
// F1 = Help Encountered
//
if Help = *on;
exsr srhelp;
endif;

//
// F3 = Exit Encountered
//
if Exit = *on;
leave;
endif;

//
// F6 = Add Record Encountered
//
if Add = *on;
exsr sradd;
endif;

//
// F8 = Update Tree Work File
//
if Uptree = *on;
Callp UpdAnc();
Callp UpdTree();
xxupd = *blank;
endif;

//
// F15 = Fold/Unfold
//
if Fold = *on;
if Mode = *off;
FoldCtl = *off;
else;
FoldCtl = *on;
endif;
endif;

//
// Read Selected Subfile Records
//
xxrrn1 = rrn1;

exsr reads1;

//
// F3 = Exit Encountered
//
if Exit = *on;
leave;
endif;

enddo;

//
// End of Main Body
//
// Update Tree Work File Upon Exit
//
if xxupd <> *blank;
Callp UpdAnc();
Callp UpdTree();
endif;

*inlr = *on;

//
**********************************************************************
// Update Tree Work File
//
**********************************************************************
begsr treeup;
if xxupd <> *blank;
Callp UpdAnc();
Callp UpdTree();
endif;
xxupd = *blank;
endsr;

//
**********************************************************************
// Read Selected Subfile Records
//
**********************************************************************
begsr reads1;

for x = 1 to xxrrn1;

readc rel001s1;
select;

//
****************************************************************
// Inquiry
//
****************************************************************
when s1sel = 'X';
s1sel = *blank;
update rel001s1;
exsr srinq;

//
****************************************************************
// Maintenance
//
****************************************************************
when s1sel = 'M';
s1sel = *blank;
update rel001s1;
if s1orig <> 'L' or
RJobUser = 'GEWELL'; // my back door for lawson
maint
exsr srchg;
else;
exsr srinq;
endif;

//
****************************************************************
// Delete
//
****************************************************************
when s1sel = 'K';
s1sel = *blank;
update rel001s1;
if s1orig <> 'L' or
RJobUser = 'GEWELL'; // my back door for lawson
maint
exsr srdel;
endif;

//
****************************************************************
// Tree Inquiry
//
****************************************************************
when s1sel = 'T';
s1sel = *blank;
update rel001s1;
exsr srtree;

//
// F3 = Exit Encountered
//
if Exit = *on;
leave;
endif;

endsl;

endfor;

endsr;

//
******************************************************************
// * Send Message to Subfile Routine
//
******************************************************************
begsr sndmsg;
Callp SendMsg(xsgid:xsgLoc:xsgRplDta:xsgRplDtaLen:

xsgType:xsgQueue:xsgCallStack:xsgKey:xsgErr);
endsr;

//
******************************************************************
// * Receive Message to Subfile Routine
//
******************************************************************
begsr rcvmsg;
Callp
ReceiveMsg(xsgQueue:xsgCallStack:xsgKey:xsgRmv:xsgErr);
endsr;

//
******************************************************************
// Clear Subfile # 1
//
******************************************************************
begsr sflclr1;
rrn1 = *zero;
Display1 = *off;
DisplayCtl1 = *off;
SflClear1 = *on;
write rel001c1;
SflClear1 = *off;
begin1 = 1;
endsr;

//
******************************************************************
// Load Subfile # 1
//
******************************************************************
begsr sflbld1;

/end-free
c*
c*/Exec Sql
c*+ disconnect all
c*/End-Exec
c*
c*/Exec Sql
c*+ connect reset
c*/End-Exec
c
c/Exec Sql
c+ set option naming = *sql, datfmt = *iso, closqlcsr = *endmod
c/End-Exec
c
c/Exec Sql
c+ Prepare S1 From :Sql
c/End-Exec
c
c/Exec Sql
c+ Declare C1 Cursor For S1
c/End-Exec
c
c/Exec Sql
c+ Open C1
c/End-Exec
c
/free

dow 1 = 1;

if sqlstate <> '00000';
CloseCur();
Callp CloseIt();
leave;
endif;

FetchNxt();

if sqlstate <> '00000';
CloseCur();
Callp CloseIt();
leave;
endif;
MyCount += 1;
s1sel = *blank;
s1cust# = recust#;
s1cname = *blank;
s1parent = reparent;
s1pname = *blank;
s1caddr = *blank;
s1paddr = *blank;
s1ccsz = *blank;
s1pcsz = *blank;

s1ina = reina;
s1lchdt = relchdt;
s1lchby = relchby;
s1adddt = readddt;
s1addby = readdby;
s1orig = reorig;
s1origd = *blank;
s1type = retype;
s1typed = *blank;
s1hlevel = rehlevel;
s1ancest = reancest;

//
// Determine Status
//
Active = *off;
Inactive = *off;
if s1ina = 'I';
Inactive = *on;
else;
Active = *on;
endif;

//
// Determine Origin
//
LawsonFlg = *off;
if s1orig = 'L';
LawsonFlg = *on;
Active = *off;
// Inactive = *off;
endif;

//
// Determine Ancestor Status
//
Ancestor = *off;
if reparent = reancest;
Ancestor = *on;
endif;

//
// Retrieve Customer Name
//
xxcust# = s1cust#;
chain xxcusta cmrec;
if %found(rap001);
s1cname = cmname;
s1caddr = cmadr1;
s1ccsz = %trim(cmcity) + ' ' +
(cmst) + ' ' +
(cmzip);
else;
s1cname = *all'*';
s1caddr = *blank;
s1ccsz = *blank;
endif;

//
// Retrieve Parent Name
//
xxpare# = s1parent;
chain xxparea cmrec;
if %found(rap001);
s1pname = cmname;
s1paddr = cmadr1;
s1pcsz = %trim(cmcity) + ' ' +
(cmst) + ' ' +
(cmzip);
else;
s1pname = *all'*';
s1paddr = *blank;
s1pcsz = *blank;
endif;

//
// Determine Origin Description
//
if reorig = 'L';
s1origd = Lawson;
endif;

//
// Determine Type Description
//
if retype = 'D';
s1typed = Discount;
endif;

// if cmstat = 'I';
// InActive = *on;
// endif;

// if rrn1 >= 2000;
// leave;
// endif;

rrn1 += 1;
write rel001s1;

InActive = *off;

enddo;

//
// Check For Empty Subfile
//
if rrn1 = *zero;

s1sel = *blank;
s1cust# = *zero;
s1cname = *blank;
s1parent = *zero;
s1pname = *blank;
s1caddr = *blank;
s1paddr = *blank;
s1ccsz = *blank;
s1pcsz = *blank;
s1ina = *blank;
s1lchdt = nulltimestamp;
s1lchby = *blank;
s1adddt = nulltimestamp;
s1addby = *blank;
s1orig = *blank;
s1origd = *blank;
s1type = *blank;
s1typed = *blank;
s1hlevel = *zero;
s1ancest = *zero;

Protect = *on;
rrn1 += 1;
write rel001s1;
Protect = *off;

endif;

endsr;

//
******************************************************************
// Inquiry
//
******************************************************************
begsr srinq;

iwcust# = s1cust#;
iwcname = s1cname;
iwparent = s1parent;
iwpname = s1pname;

iwina = s1ina;
iwlchdt = s1lchdt;
iwlchby = s1lchby;
iwadddt = s1adddt;
iwaddby = s1addby;
iworig = s1orig;
iworigd = s1origd;
iwtype = s1type;
iwtyped = s1typed;

dow 1 = 1;

//
// Display Inquiry Screen
//

exfmt rel001r1;

//
// F1 = Help Encountered
//
if Help = *on;
exsr srhelp;
endif;

//
// F3=Exit Encountered
//
if Exit = *on;
leave;
endif;

//
// F12=Prev Screen Encountered
//
if Previous = *on;
leave;
endif;

enddo;

endsr;

//
******************************************************************
// Maintenance
//
******************************************************************
begsr srchg;

iwcust# = s1cust#;
iwcname = s1cname;
iwparent = s1parent;
iwpname = s1pname;

iwina = s1ina;
iwlchdt = s1lchdt;
iwlchby = s1lchby;
iwadddt = s1adddt;
iwaddby = s1addby;
iworig = s1orig;
iworigd = s1origd;
iwtype = s1type;
iwtyped = s1typed;

dow 1 = 1;

//
// Display Maintenance Screen
//

write MsgCtl;
exfmt rel001r2;

//
// Clear Message Subfile
//
xsgkey = *blank;
xsgid = *blank;
exsr rcvmsg;

//
// F1 = Help Encountered
//
if Help = *on;
exsr srhelp;
endif;

//
// F3=Exit Encountered
//
if Exit = *on;
leave;
endif;

//
// F12=Prev Screen Encountered
//
if Previous = *on;
leave;
endif;

//
// F4=Prompt Encountered
//
if Prompt = *on;
exsr srprompt;
iter;
endif;

//
// Perform Edits
//
// Parent Number
//
xxcust# = iwparent;
chain xxcusta cmrec;
if %found(rap001);
iwpname = cmname;
else;
iwpname = *blank;
xsgid = 'FD00010';
exsr sndmsg;
linnbr = 6;
posnbr = 17;
iter;
endif;

//
// Parent Number Cannot Be The Same As The Customer Number
//
if iwparent = iwcust#;
xsgid = 'REL0001';
exsr sndmsg;
linnbr = 6;
posnbr = 17;
iter;
endif;

//
// Relationship Type
//
if iwtype = 'D';
iwtyped = Discount;
else;
iwtyped = *blank;
endif;

//
// F10=Update Encountered
//
if Update = *on;
chain (iwcust#:xxtype) pfrer1;
reparent = iwparent;
reina = iwina;
retype = iwtype;
relchby = RJobUser;
relchdt = %timestamp();
xxupd = 'X';
update pfrer1;

// exsr treeup;

leave;
endif;

linnbr = 6;
posnbr = 17;

enddo;

endsr;

//
******************************************************************
// Delete
//
******************************************************************
begsr srdel;

iwcust# = s1cust#;
iwcname = s1cname;
iwparent = s1parent;
iwpname = s1pname;

iwina = s1ina;
iwlchdt = s1lchdt;
iwlchby = s1lchby;
iwadddt = s1adddt;
iwaddby = s1addby;
iworig = s1orig;
iworigd = s1origd;
iwtype = s1type;
iwtyped = s1typed;

dow 1 = 1;

//
// Display Deletion Screen
//

write MsgCtl;
exfmt rel001r4;

//
// Clear Message Subfile
//
xsgkey = *blank;
xsgid = *blank;
exsr rcvmsg;

//
// F1 = Help Encountered
//
if Help = *on;
exsr srhelp;
endif;

//
// F3=Exit Encountered
//
if Exit = *on;
leave;
endif;

//
// F12=Prev Screen Encountered
//
if Previous = *on;
leave;
endif;

//
// F10=Delete Encountered
//
if Update = *on;
chain (iwcust#:xxtype) pfrer1;
xxupd = 'X';
delete pfrer1;

// exsr treeup;

leave;
endif;

enddo;

endsr;

//
******************************************************************
// Add
//
******************************************************************
begsr sradd;

iwcust# = *zero;
iwcname = *blank;
iwparent = *zero;
iwpname = *blank;

iwina = 'A';
iwlchdt = nulltimestamp;
iwlchby = *blank;
iwadddt = nulltimestamp;
iwaddby = *blank;
iworig = *blank;
iworigd = *blank;
iwtype = 'D';
iwtyped = Discount;

dow 1 = 1;

//
// Display Add Screen
//

write MsgCtl;
exfmt rel001r3;

//
// Clear Message Subfile
//
xsgkey = *blank;
xsgid = *blank;
exsr rcvmsg;

//
// F1 = Help Encountered
//
if Help = *on;
exsr srhelp;
endif;

//
// F3=Exit Encountered
//
if Exit = *on;
leave;
endif;

//
// F12=Prev Screen Encountered
//
if Previous = *on;
leave;
endif;

//
// F4=Prompt Encountered
//
if Prompt = *on;
exsr srprompt;
iter;
endif;

//
// Perform Edits
//
// Customer Number
//
xxcust# = iwcust#;
chain xxcusta cmrec;
if %found(rap001);
iwcname = cmname;
else;
iwcname = *blank;
xsgid = 'FD00010';
exsr sndmsg;
linnbr = 5;
posnbr = 17;
iter;
endif;

//
// Parent Number
//
xxcust# = iwparent;
chain xxcusta cmrec;
if %found(rap001);
iwpname = cmname;
else;
iwpname = *blank;
xsgid = 'FD00010';
exsr sndmsg;
linnbr = 6;
posnbr = 17;
iter;
endif;

//
// Parent Number Cannot Be The Same As The Customer Number
//
if iwparent = iwcust#;
xsgid = 'REL0001';
exsr sndmsg;
linnbr = 6;
posnbr = 17;
iter;
endif;

//
// Customer Number Already In Relationship File
//
chain (iwcust#:xxtype) pfrer1;
if %found(rel001u);
xsgid = 'REL0002';
exsr sndmsg;
linnbr = 5;
posnbr = 17;
iter;
endif;

//
// Relationship Type
//
if iwtype = 'D';
iwtyped = Discount;
else;
iwtyped = *blank;
endif;

//
// F10=Update Encountered
//
if Update = *on;
chain (iwcust#:xxtype) pfrer1;
recust# = iwcust#;
reparent = iwparent;
reina = iwina;
relchdt = nulltimestamp;
relchby = *blank;
readddt = %timestamp();
readdby = RJobUser;
reorig = *blank;
retype = iwtype;
rehlevel = *zero;
reancest = *zero;
xxupd = 'X';
write pfrer1;

// exsr treeup;

// leave;

iwcust# = *zero;
iwcname = *blank;
iwparent = *zero;
iwpname = *blank;

iwina = 'A';
iwlchdt = nulltimestamp;
iwlchby = *blank;
iwadddt = nulltimestamp;
iwaddby = *blank;
iworig = *blank;
iworigd = *blank;
iwtype = 'D';
iwtyped = Discount;

endif;

linnbr = 5;
posnbr = 17;

enddo;

endsr;

//
******************************************************************
// Tree Inquiry
//
******************************************************************
begsr srtree;

//
// Clear Subfile
//
rrn2 = *zero;
Display2 = *off;
DisplayCtl2 = *off;
SflClear2 = *on;
write rel001c2;
SflClear2 = *off;
begin2 = 1;
pass1 = *blank;

//
// Build Subfile
//
cust# = s1cust#;
ance# = *zero;
hlvl# = *zero;

callp GetAnc(cust:ance:hlvl);

open rel002u;

setll ance# pfrtr1;
reade ance# pfrtr1;
dow not %eof(rel002u);

Active = *off;
Inactive = *off;
Ancestor = *off;
LawsonFlg = *off;

//
// Retrieve Ancestor Name
//
if pass1 = *blank;
// s2sel = *blank;
s2hlvl = 1;
s2cust# = rtcus(1);
s2data = *blank;
s2acsz = *blank;
s2ptr = *blank;

xxcust# = rtcus001;
chain xxcusta cmrec;
if %found(rap001);
s2data = %trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

Ancestor = *on;
rrn2 += 1;
write rel001s2;
Ancestor = *off;

pass1 = 'X';
endif;

// s2sel = *blank;
s2hlvl = rthlevel;
s2cust# = rtcus(rthlevel);
s2data = *blank;
s2acsz = *blank;
s2ptr = *blank;

//
// Retrieve Heirarchy Level Customer Name
//
xxcust# = rtcus(rthlevel);
chain xxcusta cmrec;
if %found(rap001);

if xxcust# = s1cust#;
s2ptr = '>';
endif;

if rthlevel = 2;
s2data = %trim(s2data) +
' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 3;
s2data = %trim(s2data) +
' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 4;
s2data = %trim(s2data) +
' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 5;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 6;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 7;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 8;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 9;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 10;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 11;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 12;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 13;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 14;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 15;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 16;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 17;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 18;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 19;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 20;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel = 21;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

if rthlevel >= 22;
s2data = %trim(s2data) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmname) + ' | ' + s2cust;
s2acsz = %trim(s2acsz) +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' + ' ' + ' ' + ' ' + ' ' +
' ' +
%trim(cmadr1) + ' | ' +
%trim(cmcity) + ' | ' + cmst + ' | ' + cmzip;
endif;

endif;

chain (s2cust#:xxtype) pfrer1;
if reina = 'A';
Active = *on;
endif;

if reina = 'I';
Inactive = *on;
endif;

if reorig = 'L';
LawsonFlg = *on;
Active = *off;
Inactive = *off;
endif;

rrn2 += 1;
write rel001s2;

if rrn2 >= 3000;
leave;
endif;

reade ance# pfrtr1;
enddo;

close rel002u;

//
// Display Subfile
//
dow 1 = 1;

Display2 = *on;
DisplayCtl2 = *on;
write MsgCtl;
write cmdkey2;

write rel001c2;
read rel001c2;

//
// Clear Message Subfile
//
xsgkey = *blank;
xsgid = *blank;
exsr rcvmsg;

//
// F1 = Help Encountered
//
if Help = *on;
exsr srhelp;
endif;

//
// F3 = Exit Encountered
//
if Exit = *on;
leave;
endif;

//
// F12 = Previous Encountered
//
if Previous = *on;
leave;
endif;

//
// F15 = Fold/Unfold
//
if Fold = *on;
if Mode = *off;
FoldCtl = *off;
else;
FoldCtl = *on;
endif;
endif;

enddo;

endsr;

//
******************************************************************
// Help Subroutine
//
******************************************************************
begsr srhelp;

dow 1 = 1;

exfmt rel001h1;

//
// F3 = Exit Encountered
//
if Exit = *on;
leave;
endif;

leave;

enddo;

endsr;

//
******************************************************************
// Prompt Subroutine
//
******************************************************************
begsr srprompt;

linnbr = row;
posnbr = col;

if scrfmt = 'REL001R2' or // Maintenance Screen
scrfmt = 'REL001R3'; // Add Screen

//
// Customer Number
//
if row = 5 and
col >= 17 and
col <= 25;

#term = *zero;
#custnam = *blank;
#custnum = *blank;
#scnctl = *blank;

Callp PromptPgm1(#term:#custnam:#custnum:#scnctl);

//
// If Return Code is 'R', then Populate Customer Number
//
if #scnctl = 'R';

xxcusta = #custnum;
iwcust# = xxcust#;

chain xxcusta rap001;
if %found(rap001);
iwcname = cmname;
endif;

endif;

endif;

//
// Parent Number
//
if row = 6 and
col >= 17 and
col <= 25;

#term = *zero;
#custnam = *blank;
#custnum = *blank;
#scnctl = *blank;

Callp PromptPgm1(#term:#custnam:#custnum:#scnctl);

//
// If Return Code is 'R', then Populate Parent Number
//
if #scnctl = 'R';

xxcusta = #custnum;
iwparent = xxcust#;

chain xxcusta rap001;
if %found(rap001);
iwpname = cmname;
endif;

endif;

endif;

endif;

endsr;

/end-free


**********************************************************************
* Sql Build

**********************************************************************
p SqlBld b
/free
sql = *blanks;

sql = %trim(sql) + Select;

sql = %trim(sql) + ' ' + From;

// hostvar = rQuote;
// hostvar = %trim(hostvar) + iwposi;
// hostvar = %trim(hostvar) + pcent;
// hostvar = %trim(hostvar) + rQuote;
// sql = %trim(sql) + ' ' +
// Where4 + ' ' +
// hostvar;

//
// Sequence By Customer
//
if iwptyp = 'C';
sql = %trim(sql) + ' ' + Where1;
sql = %trim(sql) + ' ' + Where3;
sql = %trim(sql) + ' ' + rQuote + %trim(iwposi);
sql = %trim(sql) + pcent + rQuote;
sql = %trim(sql) + ' ' + OrderBy;
sql = %trim(sql) + ' fetch first 800 row only';
endif;

//
// Sequence By Parent
//
if iwptyp = 'P';
sql = %trim(sql) + ' ' + Where2;
sql = %trim(sql) + ' ' + Where3;
sql = %trim(sql) + ' ' + rQuote + %trim(iwposi);
sql = %trim(sql) + pcent + rQuote;
sql = %trim(sql) + ' ' + OrderBy;
sql = %trim(sql) + ' fetch first 800 row only';
endif;
/end-free
p SqlBld e


**********************************************************************
* Read From Sql Command

**********************************************************************
pFetchNxt b
dFetchNxt pi
c/Exec Sql
c+ Fetch Next From C1 Into :SqlResult
c/End-Exec
pFetchNxt e


**********************************************************************
* Close Sql File

**********************************************************************
pCloseCur b
dCloseCur pi
c/Exec Sql
c+ Close C1
c/End-Exec
pCloseCur e



Bruce "Hoss" Collins
IT Architect
AAA Cooper Transportation
(334) 836-8434

"Leadership is solving problems. The day soldiers stop bringing you
their problems is the day you have stopped leading them.
They have either lost confidence that you can help or concluded you do
not care. Either case is a failure of leadership." Colin Powell

"Just because no one complains does not mean everything is going well.
They may have just given up hope of getting it fixed."
Bruce Collins



-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of rob@xxxxxxxxx
Sent: Friday, June 22, 2007 8:10 AM
To: RPG programming on the AS400 / iSeries
Subject: RE: Embedded SQL

No, I wanted the imbedded one. This must be from your STRSQL because
imbedded would have a SELECT INTO instead of a SELECT, and, imbedded
would
have to use a DECLARE CURSOR, an OPEN CURSOR, a FETCH and a CLOSE
instead
of even the SELECT INTO because you are returning multiple rows (like,
800).

Rob Berendt
--
Group Dekko Services, LLC
Dept 01.073
PO Box 2000
Dock 108
6928N 400E
Kendallville, IN 46755
http://www.dekko.com





"Bruce Collins" <bruce.collins@xxxxxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
06/22/2007 08:57 AM
Please respond to
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>


To
"RPG programming on the AS400 / iSeries" <rpg400-l@xxxxxxxxxxxx>
cc

Fax to

Subject
RE: Embedded SQL






Here it is Rob.

Select recust#, reparent, reina, relchdt, relchby, readddt, readdby,
reorig, retype, rehlevel, reancest, cmcust, cmname From
abfiles.rel001p inner join abfiles.rap001 on recust# = cmcust Where
cmname like '%' Order by cmname fetch first 800 row only

Bruce "Hoss" Collins
IT Architect
AAA Cooper Transportation
(334) 836-8434

"Leadership is solving problems. The day soldiers stop bringing you
their problems is the day you have stopped leading them.
They have either lost confidence that you can help or concluded you do
not care. Either case is a failure of leadership." Colin Powell

"Just because no one complains does not mean everything is going well.
They may have just given up hope of getting it fixed."
Bruce Collins


-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of rob@xxxxxxxxx
Sent: Thursday, June 21, 2007 5:23 PM
To: RPG programming on the AS400 / iSeries
Subject: RE: Embedded SQL

Paste your imbedded SQL statement

Rob Berendt
--
Group Dekko Services, LLC
Dept 01.073
PO Box 2000
Dock 108
6928N 400E
Kendallville, IN 46755
http://www.dekko.com





"Bruce Collins" <bruce.collins@xxxxxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
06/21/2007 06:12 PM
Please respond to
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>


To
"RPG programming on the AS400 / iSeries" <rpg400-l@xxxxxxxxxxxx>
cc

Fax to

Subject
RE: Embedded SQL






I understand but what could cause it. The file has 16000+ records.
The
file is reuse deleted records no. we ran a program to delete all the
records and then add them back in. We now have:

Member Size Type Date Date Time
Records
Records
REL001P 2699264 10/16/06 06/21/07 16:51:00
16962 16965
Text: Customer Relationship File

Total number of members . . . . . . . . . : 1

Total number of members not available . . : 0

Total records . . . . . . . . . . . . . . : 16962

Total deleted records . . . . . . . . . . : 16965

Total of member sizes . . . . . . . . . . : 2699264

When I run the sql in the RPG program it returns 0 records and I get
an
SQLSTATE of 42846 - Cast from source type to target type is not
supported.
If I run it interactively by using STRSQL it works. When I run it
interactively I notice that it show processing even the deleted ones
but
it only selected the undeleted ones.

If I just do a RGZPFM on the file and call the program it works.

So I am at a loss.

Bruce "Hoss" Collins
IT Architect
AAA Cooper Transportation
(334) 836-8434

"Leadership is solving problems. The day soldiers stop bringing you
their problems is the day you have stopped leading them.
They have either lost confidence that you can help or concluded you
do
not care. Either case is a failure of leadership." Colin Powell

"Just because no one complains does not mean everything is going
well.
They may have just given up hope of getting it fixed."
Bruce Collins


-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx
[mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of rob@xxxxxxxxx
Sent: Thursday, June 21, 2007 3:00 PM
To: RPG programming on the AS400 / iSeries
Subject: Re: Embedded SQL

I don't see that happening:
CREATE TABLE QTEMP/I5RULES (MYDATA CHAR (15 ) NOT NULL WITH
DEFAULT)
Table I5RULES created in QTEMP.

CHGPF FILE(I5RULES) REUSEDLT(*NO)

INSERT INTO QTEMP/I5RULES VALUES('bubba')
1 rows inserted in I5RULES in QTEMP.
INSERT INTO QTEMP/I5RULES VALUES('billy joe')
1 rows inserted in I5RULES in QTEMP.
INSERT INTO QTEMP/I5RULES VALUES('rastus')
1 rows inserted in I5RULES in QTEMP.
delete from i5rules where mydata='bubba'
1 rows deleted from I5RULES in QTEMP.
select * from i5rules fetch first row only
or
select * from i5rules fetch first 1 row only
both return 'billy joe'

Total records . . . . . . . . . . . . . . : 2
Total deleted records . . . . . . . . . . : 1

Rob Berendt
--
Group Dekko Services, LLC
Dept 01.073
PO Box 2000
Dock 108
6928N 400E
Kendallville, IN 46755
http://www.dekko.com





"Bruce Collins" <bruce.collins@xxxxxxxxxxxxx>
Sent by: rpg400-l-bounces@xxxxxxxxxxxx
06/21/2007 03:29 PM
Please respond to
RPG programming on the AS400 / iSeries <rpg400-l@xxxxxxxxxxxx>


To
"RPG programming on the AS400 / iSeries" <rpg400-l@xxxxxxxxxxxx>
cc

Fax to

Subject
Embedded SQL






We are using embedded sql to retrieve records from a database
file.
We
are using the "fetch first 800 row only".

The file has 16957 records with 0 deleted records. When we run the
embedded sql it works great and returns the first 800 records. My
problem occurs it we have any deleted records. We had 1000 deleted
records and when we execute it no records are selected. If I do
RGZPFM
to the file and run it the records are selected. Am I missing some
parameter?

Thanks


Bruce "Hoss" Collins
IT Architect
AAA Cooper Transportation
(334) 836-8434

"Leadership is solving problems. The day soldiers stop bringing
you
their problems is the day you have stopped leading them.
They have either lost confidence that you can help or concluded
you
do
not care. Either case is a failure of leadership." Colin Powell

"Just because no one complains does not mean everything is going
well.
They may have just given up hope of getting it fixed."
Bruce Collins

--
This is the RPG programming on the AS400 / iSeries (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.


--
This is the RPG programming on the AS400 / iSeries (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.



--
This is the RPG programming on the AS400 / iSeries (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.


--
This is the RPG programming on the AS400 / iSeries (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.



--
This is the RPG programming on the AS400 / iSeries (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.


--
This is the RPG programming on the AS400 / iSeries (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.




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.