Skip to content

Commit a2d8f9c

Browse files
SJLennonSJLennon
committed
Source on IFS & Local Development
1 parent 57c4efd commit a2d8f9c

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

83 files changed

+5918
-4122
lines changed

‎5250_Subfile/CRTDTAARA.clle

+9
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
/* Convenience pgm that creates CUSTNEXT data area in *CUURLIB */
2+
/* This is a really high number that I don't expect in test data */
3+
/* Strictly it should be set to CUSTMAST COUNT(*) + 1 */
4+
PGM
5+
DLTDTAARA DTAARA(CUSTNEXT)
6+
MONMSG MSGID(CPF0000)
7+
CRTDTAARA DTAARA(CUSTNEXT) TYPE(*CHAR) LEN(4) +
8+
VALUE('EEEE') TEXT('Next alpha-numeric customer number')
9+
ENDPGM

‎5250_Subfile/CRTMSGF.CLLE

+7-2
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,13 @@
11
PGM
2-
DLTMSGF MSGF(LENNONS1/CUSTMSGF)
2+
/* === Set your target library here ================ */
3+
DCL VAR(&TGT_LIB) TYPE(*CHAR) LEN(10) +
4+
VALUE('LENNONS1')
5+
/* ================================================= */
6+
7+
DLTMSGF MSGF(&TGT_LIB/CUSTMSGF)
38
MONMSG MSGID(CPF0000)
49

5-
CRTMSGF MSGF(LENNONS1/CUSTMSGF) TEXT('Customer +
10+
CRTMSGF MSGF(&TGT_LIB/CUSTMSGF) TEXT('Customer +
611
Related Messages')
712
ADDMSGD MSGID(DEM0000) MSGF(CUSTMSGF) MSG('Press Enter to +
813
update. F12 to Cancel.')

‎5250_Subfile/Custmast.sql

+330-316
Large diffs are not rendered by default.

‎5250_Subfile/Custmast2.sql

+31
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
-- Creates CUSTMAST and Indexes -------------------------------
2+
-- Can then "CALL LOADCUST2 nnn" to load nnn random records.
3+
4+
-- 02/2024 Change CustID to char to allow alpha/numeric keys
5+
6+
set schema lennons1; -- <<<<< Change to your library <<<<<<
7+
DROP TABLE custmast;
8+
9+
CREATE TABLE custmast (
10+
CustID CHAR(4) NOT NULL
11+
,Name CHAR(40) NOT NULL
12+
,Addr CHAR(40) NOT NULL
13+
,City CHAR(20) NOT NULL
14+
,State CHAR(2) NOT NULL
15+
,Zip CHAR(10) NOT NULL
16+
,CorpPhone CHAR(20) DEFAULT ' '
17+
,AcctMgr CHAR(40) DEFAULT ' '
18+
,AcctPhone CHAR(20) DEFAULT ' '
19+
,Active CHAR(1) DEFAULT 'Y'
20+
,ChgTime TIMESTAMP not null DEFAULT CURRENT_TIMESTAMP
21+
,ChgUser varchar(18) not null DEFAULT USER
22+
,PRIMARY KEY (Custid)
23+
)
24+
RCDFMT CUSTMASTF;
25+
-- Indexes --
26+
drop index if exists custmast_name;
27+
create index custmast_name on custmast(name);
28+
drop index if exists custmast_city;
29+
create index custmast_city on custmast(city);
30+
drop index if exists custmast_state;
31+
create index custmast_state on custmast(state);

‎5250_Subfile/LOADCUST.CLLE

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
/*=== Creates CUSTMAST & Indexes and 300 records ===*/
2+
PGM
3+
CHKOBJ OBJ(CUSTMAST) OBJTYPE(*FILE)
4+
MONMSG MSGID(CPF9801) EXEC(GOTO CMDLBL(SUBMIT))
5+
6+
ALCOBJ OBJ((CUSTMAST *FILE *EXCLRD)) WAIT(5) +
7+
CONFLICT(*RQSRLS)
8+
MONMSG MSGID(CPF1002) EXEC(DO)
9+
SNDMSG MSG('Cannot allocate CUSTMAST') +
10+
TOUSR(*REQUESTER)
11+
RETURN
12+
ENDDO
13+
14+
DLCOBJ OBJ((CUSTMAST *FILE *EXCLRD))
15+
SUBMIT: SBMJOB CMD(RUNSQLSTM +
16+
SRCSTMF('/home/LENNONS/IBMi_IFS_DEV/5250_Subfile/+
17+
custmast.sql') +
18+
COMMIT(*NONE) ERRLVL(40) DECMPT(*PERIOD)) +
19+
JOB(LOADCUST)
20+
ENDPGM

‎5250_Subfile/LOADCUST2.CLLE

+19
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
/* === Loads CUSTMAST with as many random records as specified === */
2+
/* Submits job to batch */
3+
4+
PGM PARM(&NUM)
5+
DCL VAR(&NUM) TYPE(*DEC) LEN(15 5)
6+
CHKOBJ OBJ(CUSTMAST) OBJTYPE(*FILE)
7+
MONMSG MSGID(CPF9801) EXEC(GOTO CMDLBL(SUBMIT))
8+
9+
ALCOBJ OBJ((CUSTMAST *FILE *EXCLRD)) WAIT(5) +
10+
CONFLICT(*RQSRLS)
11+
MONMSG MSGID(CPF1002) EXEC(DO)
12+
SNDMSG MSG('Cannot allocate CUSTMAST') +
13+
TOUSR(*REQUESTER)
14+
RETURN
15+
ENDDO
16+
17+
DLCOBJ OBJ((CUSTMAST *FILE *EXCLRD))
18+
SUBMIT: SBMJOB CMD(CALL PGM(LOADCUSTR) PARM((&NUM))) JOB(LOADCUST2)
19+
ENDPGM

‎5250_Subfile/LOADCUSTR.SQLRPGLE

+256
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,256 @@
1+
**free
2+
// === Program to create "n" records of test data in CUSTMAST =====
3+
// === Assumes CUSTMAST is exists and will clear it first.
4+
// === City name, state and zip are generated from USPS data,
5+
// file CSZ, created from upload from USPS.COM with iACS.
6+
// See https://www.unitedstateszipcodes.org/zip-code-database/
7+
// Rest of the data i randomly generated.
8+
// This was an experimental program to use randomn number and
9+
// variable sized arrays. But it was fun to write...
10+
11+
ctl-opt DftActGrp(*no) ActGrp('QILE') BndDir('UTIL_BND':'SQL_BND':'SRV_BASE36');
12+
ctl-opt Option(*nounref: *nodebugio: *srcstmt);
13+
ctl-opt ExprOpts(*ResDecPos) ExtBinInt( *Yes );
14+
ctl-opt Debug(*constants : *retval);
15+
ctl-opt Indent('| ');
16+
/COPY ../Copy_Mbrs/SRV_SQL_P.RPGLE
17+
/COPY ../Copy_Mbrs/SRV_RAND_P.RPGLE
18+
/COPY ../Copy_Mbrs/BASE36_P.RPGLE
19+
20+
// === Program Parameter =======================================
21+
dcl-pi *n;
22+
parm_recds packed(15 : 5); // Number of records to create
23+
end-pi;
24+
dcl-s p_recds int(10);
25+
26+
dcl-ds Fld ExtName('CUSTMAST') Qualified;
27+
end-ds;
28+
// === SQL State Constants =====================================
29+
dcl-c SQLSUCCESS '00000';
30+
dcl-c SQLNODATA '02000';
31+
dcl-c SQLNOMOREDATA '02000';
32+
dcl-c SQLNOTJOURNALED '01567';
33+
34+
dcl-s companyType varchar(10) dim(*auto : 30);
35+
dcl-s streetType varchar(10) dim(*auto : 30);
36+
dcl-s varCUSTID varchar(4);
37+
// === City/state/zip record ===
38+
dcl-ds csz qualified;
39+
zip int(10);
40+
ziptype char(10);
41+
city char(20);
42+
st char(2);
43+
end-ds;
44+
45+
// === Arrary of City, State and Zip records ===
46+
dcl-ds csz_a likeds(csz) dim(*auto : 50000) ;
47+
48+
dcl-s cszCount int(10);
49+
dcl-s MaxL int(10);
50+
dcl-s csz_I int(10);
51+
dcl-s j int(10);
52+
// dcl-s t int(10);
53+
DCL-S adrX int(10);
54+
dcl-s nRecds int(10);
55+
dcl-s wk10 char(10);
56+
dcl-s wkStr varchar(50);
57+
58+
// === Build array of Company types ===
59+
companyType(1) = 'INC';
60+
companyType(*next) = 'LLC';
61+
companyType(*next) = 'LLP';
62+
companyType(*next) = 'COMPANY';
63+
companyType(*next) = '& SONS';
64+
companyType(*next) = 'ET FILS';
65+
companyType(*next) = 'PLC';
66+
companyType(*next) = 'CORP';
67+
companyType(*next) = 'LTD';
68+
companyType(*next) = 'SOLE';
69+
companyType(*next) = 'PARTNERS';
70+
companyType(*next) = 'ASSOC';
71+
72+
// === Build array of street types ===
73+
streetType(1) = 'STREET';
74+
streetType(*next) = 'ST';
75+
streetType(*next) = 'ROAD';
76+
streetType(*next) = 'RD';
77+
streetType(*next) = 'AVENUE';
78+
streetType(*next) = 'AVE';
79+
streetType(*next) = 'PLACE';
80+
streetType(*next) = 'CIRCLE';
81+
streetType(*next) = 'SQUARE';
82+
streetType(*next) = 'HWY';
83+
streetType(*next) = 'VISTA';
84+
streetType(*next) = 'CALLE';
85+
streetType(*next) = 'RANCH';
86+
streetType(*next) = 'CRESCENT';
87+
streetType(*next) = 'COURT';
88+
streetType(*next) = 'WAY';
89+
90+
exec sql set option datfmt=*iso,
91+
commit=*none,
92+
closqlcsr=*endmod;
93+
94+
// === Clear Custmast file ===
95+
exec sql truncate lennons1.custmast;
96+
if (SQLSTT <> SQLSUCCESS and SQLSTT <> SQLNODATA);
97+
SQLProblem('truncate custmast');
98+
endif;
99+
100+
// === Size the City/State/Zip array ===
101+
exec sql select count(*) into :cszCount
102+
from lennons1.csz
103+
where length(trim(city)) <= 20;
104+
if (SQLSTT <> SQLSUCCESS);
105+
SQLProblem('select count(*)');
106+
endif;
107+
%elem(csz_a : *alloc) = cszCount + 1;
108+
109+
// === Populate csz_a ===
110+
exec sql declare csz_cur cursor for
111+
select zip, type, upper(city), trim(state)
112+
from lennons1.csz
113+
where length(trim(city)) <= 20;
114+
exec sql open csz_cur;
115+
if (SQLSTT <> SQLSUCCESS );
116+
SQLProblem('Open csz_cur');
117+
endif;
118+
j=1;
119+
dow (1=1);
120+
exec sql fetch from csz_cur into :csz;
121+
if SQLSTT = SQLNOMOREDATA;
122+
leave;
123+
endif;
124+
if SQLSTT <> SQLSUCCESS;
125+
SQLProblem('fetch fron csz_cur');
126+
endif;
127+
csz_a(j) = csz;
128+
j += 1;
129+
enddo;
130+
131+
// === Build CUSTMAST records =================================
132+
p_recds = parm_recds;
133+
varCUSTID = '1001';
134+
for nRecds = 1 to p_recds;
135+
clear Fld;
136+
Fld.CUSTID = varCUSTID;
137+
varCUSTID = BASE36ADD(varCUSTID); // Alpha-numeric key
138+
Fld.ACTIVE = 'Y';
139+
if (%rem(nRecds : 7) = 0);
140+
Fld.ACTIVE = 'N';
141+
endif;
142+
143+
// === City/State Zip ===
144+
csz_I = Rand_Int(1:%elem(csz_a));
145+
Fld.STATE = csz_a(csz_I).st;
146+
Fld.CITY = csz_a(csz_I).city;
147+
wk10 = %editc(csz_a(csz_I).zip:'X');
148+
Fld.ZIP = %subst(wk10 :6 :5);
149+
150+
// === Company Name ===
151+
clear wkStr;
152+
// Specify a random name length leaving space for
153+
// a company6y type suffix.
154+
MaxL = Rand_Int(5 : %len(Fld.Name) - 12);
155+
wkStr = wkStr + genWord(5:11) + ' ';
156+
dow %len(wkStr) <= MaxL;
157+
wkStr = wkStr + genWord(5:11) + ' ';
158+
enddo;
159+
160+
// Add company "types" to some records
161+
j = Rand_Int(1:(%elem(companyType) * 1.8));
162+
if j <= %elem(companyType);
163+
wkStr = %trim(wkStr) + ' ' + companyType(j);
164+
endif;
165+
Fld.NAME = wkStr;
166+
167+
// === Address ===
168+
clear wkStr;
169+
adrX = %rem(nRecds :4);
170+
MaxL = Rand_Int(5 : %len(Fld.ADDR) - 12);
171+
if adrX <> 0; //Add street number to most
172+
wkStr = %trim(%editc(Rand_Int(1:5000) : '3')) + ' ';
173+
endif;
174+
wkStr = wkStr + genWord(5:11) + ' ';
175+
dow %len(wkStr) <= MaxL;
176+
wkStr = wkStr + genWord(5:11) + ' ';
177+
enddo;
178+
// Add street "types" to some records
179+
j = Rand_Int(1:(%elem(streetType) * 1.75));
180+
if j <= %elem(streetType);
181+
wkStr = %trim(wkStr) + ' ' + streetType(j);
182+
endif;
183+
Fld.ADDR = wkStr;
184+
185+
// === Phone numbers ===
186+
Fld.CORPPHONE = genPhone();
187+
Fld.ACCTPHONE = genPhone();
188+
189+
// === Account Manager ===
190+
if %rem(nRecds :3) = 0;
191+
wkStr = genWord(1:1) + ' ';
192+
wkStr += genWord(1:1) + ' ';
193+
wkStr += genWord(4:10);
194+
else;
195+
wkStr = genWord(3:6) + ' ';
196+
wkStr += genWord(5:9);
197+
endif;
198+
Fld.ACCTMGR = wkStr;
199+
200+
Fld.CHGUSER = '*SYSTEM*';
201+
202+
// === Write out a record ======================================
203+
exec sql insert into lennons1.custmast values(:Fld);
204+
if (SQLSTT <> SQLSUCCESS);
205+
SQLProblem('Insert into custmast');
206+
endif;
207+
endfor;
208+
209+
// === All finished ============================================
210+
*inlr = *on;
211+
return;
212+
213+
// === Generate a word =========================================
214+
dcl-proc genWord;
215+
dcl-pi genWord varchar(30);
216+
MinL int(10) const;
217+
MaxL int(10) const;
218+
end-pi;
219+
// Straight alphabetic
220+
dcl-s Alpha varchar(50)
221+
inz('ABCDEFGHIIJKLMNOPQRSTUVWXYZZ');
222+
// Biased towards vowels
223+
dcl-s vAlpha varchar(50)
224+
inz('AAAAABCDEEEEEFGHIIIIIJKLMNOOOOOPQRSTUUUVWXYZZ');
225+
226+
dcl-s wk30 varchar(30) inz;
227+
dcl-s TgtL int(10);
228+
dcl-s j int(10);
229+
230+
wk30 = %subst(Alpha : Rand_Int(1 : %len(Alpha)) : 1);
231+
if (MinL<> 1 and MaxL <> 1);
232+
wk30 += %subst(vAlpha : Rand_Int(1 : %len(vAlpha)) : 1);
233+
endif;
234+
TgtL = Rand_Int(MinL:MaxL) - 2;
235+
for j=1 by 2 to TgtL;
236+
wk30 += %subst(Alpha : Rand_Int(1 : %len(Alpha)) : 1);
237+
wk30 += %subst(vAlpha : Rand_Int(1 : %len(vAlpha)) : 1);
238+
endfor;
239+
return wk30;
240+
end-proc;
241+
242+
// === Generate a phone like (800) 231-1876 ====================
243+
dcl-proc genPhone;
244+
dcl-pi genPhone varchar(20);
245+
end-pi;
246+
dcl-s wkret varchar(20);
247+
dcl-s wk3 char(3);
248+
dcl-s wk4 char(4);
249+
wk3 = %editc(%dec(Rand_Int(100:900):3 :0) : 'X');
250+
wkret = '(' + wk3 + ') ';
251+
wk3 = %editc(%dec(Rand_Int(1:998) :3 :0) : 'X');
252+
wkret += wk3 + '-';
253+
wk4 = (%editc(%dec(Rand_Int(1:9900) :4 :0) : 'X'));
254+
wkret += wk4;
255+
return wkret;
256+
end-proc;

0 commit comments

Comments
 (0)