-831
files/cbl.cbl
-831
files/cbl.cbl
···
1
-
* TC9C1000: ACCESS TO THE GENERAL DATA TABLE TO OBTAIN *009465C7
2
-
* INFORMATION FROM THE APPROPRIATE CORPORATE TABLE *5370A6E8
3
-
******************************************************************A4837AC3
4
-
* IDENTIFICATION DIVISION *F59041EC
5
-
******************************************************************A4837AC3
6
-
IDENTIFICATION DIVISION. 9B1B9453
7
-
* 1A300880
8
-
PROGRAM-ID. TC9C1000. 98B2637E
9
-
* 1A300880
10
-
AUTHOR. ACCENTURE FSSG. 55F421DF
11
-
* 1A300880
12
-
DATE-WRITTEN. 2007-12-27. B4AE1D28
13
-
* 1A300880
14
-
******************************************************************A4837AC3
15
-
* MODIFICATIONS LOG *87F9F714
16
-
******************************************************************A4837AC3
17
-
* CODE AUTHOR DATE DESCRIPTION *C2E27FE6
18
-
* ---------- ------- -------- ------------------------------ *3564FD66
19
-
******************************************************************A4837AC3
20
-
******************************************************************A4837AC3
21
-
* ENVIRONMENT DIVISION *7FE34444
22
-
******************************************************************A4837AC3
23
-
ENVIRONMENT DIVISION. F62AE0A4
24
-
* 1A300880
25
-
CONFIGURATION SECTION. F96B1F12
26
-
SOURCE-COMPUTER. IBM-4381. 61ACDF2A
27
-
* 1A300880
28
-
OBJECT-COMPUTER. IBM-4381. 07434EB1
29
-
* 1A300880
30
-
SPECIAL-NAMES. 255723DF
31
-
* 1A300880
32
-
DECIMAL-POINT IS COMMA. EF1F75B6
33
-
INPUT-OUTPUT SECTION. 3E0D589A
34
-
FILE-CONTROL. 47F6A63E
35
-
* 1A300880
36
-
******************************************************************A4837AC3
37
-
* DATA DIVISION *D158BA31
38
-
******************************************************************A4837AC3
39
-
DATA DIVISION. 8A97209E
40
-
* 1A300880
41
-
******************************************************************A4837AC3
42
-
* FILE SECTION *1AAAD3B5
43
-
******************************************************************A4837AC3
44
-
FILE SECTION. D10C4568
45
-
* 1A300880
46
-
******************************************************************A4837AC3
47
-
* WORKING-STORAGE SECTION *3DA46E64
48
-
******************************************************************A4837AC3
49
-
WORKING-STORAGE SECTION. A4DC93D4
50
-
* 1A300880
51
-
COPY QAWCSQL. 54F5D2F7
52
-
* 1A300880
53
-
COPY TCTC1681. 10C323C1
54
-
* 1A300880
55
-
COPY TCWC0110. 542FAFF4
56
-
* 1A300880
57
-
COPY TCEC9999. A2CCB95A
58
-
* 1A300880
59
-
COPY QCWCL20. D2A1D6F4
60
-
* 1A300880
61
-
EXEC SQL E6588CB0
62
-
INCLUDE TCGV0010 BD049EFD
63
-
END-EXEC. 187FFBE7
64
-
* 1A300880
65
-
EXEC SQL E6588CB0
66
-
INCLUDE TCGV0100 8C9D2844
67
-
END-EXEC. 187FFBE7
68
-
* 1A300880
69
-
EXEC SQL E6588CB0
70
-
INCLUDE TCGV0990 CC93159C
71
-
END-EXEC. 187FFBE7
72
-
* 1A300880
73
-
01 VN-NUM-ENDACS PIC 99. 393F718E
74
-
01 TB-TABLE. E2A6D149
75
-
03 TB-TABLE-INTERNAL-RE OCCURS 21 TIMES. DF226A59
76
-
05 TB-TABLE-KEY-INT PIC X(20). E09D63CA
77
-
05 TB-TABLE-DAT-INTERNOCCURS PIC X(250). F1E79800
78
-
01 VA-ENT-AUXST PIC X(4). E079BDE7
79
-
* 1A300880
80
-
01 VA-FLG-LNG1 PIC X(1). E843F7C5
81
-
01 VA-FLG-LNG2 PIC X(1). 818F0BC8
82
-
01 VA-FLG-LNG3 PIC X(1). 3BDA0FDF
83
-
01 VA-COD-TABLE PIC X(4). 729468EA
84
-
* 1A300880
85
-
01 VA-KEY-T010. 47E3BCD1
86
-
03 VA-KEY-CODTBL PIC X(4). 9CCF8ACA
87
-
03 VA-KEY-CODENT PIC X(4). F907DFCA
88
-
03 VA-KEY-LNGFLG PIC X. 140C004C
89
-
03 VA-KEY-TGTBL PIC X(20). 3BDFB6E3
90
-
* 1A300880
91
-
01 VA-KEY-DB2-1. 114DB702
92
-
03 VA-DB2LNG PIC X. 0B77D67B
93
-
03 VA-KEY-DB2 PIC X(20). 3A33034F
94
-
* 1A300880
95
-
01 CA-NO PIC X VALUE 'N'. 3FC38BD5
96
-
01 CA-YES PIC X VALUE 'Y'. 6A3B1859
97
-
01 CA-S PIC X VALUE 'S'. 8D0D7B19
98
-
01 CN-NUM-1 PIC 99 VALUE 1. 017020A1
99
-
01 CN-NUM-20 PIC 99 VALUE 20. ADA49303
100
-
01 CN-NUM-21 PIC 99 VALUE 21. CC1165C1
101
-
01 CN-NUM-00 PIC 99 VALUE 00. 4357ED91
102
-
01 CA-1 PIC X VALUE '1'. A6498F4A
103
-
01 CA-2 PIC X VALUE '2'. 520A6BCD
104
-
01 CA-3 PIC X VALUE '3'. 95BF4005
105
-
01 CA-4 PIC X VALUE '4'. 61FCA482
106
-
01 CA-5 PIC X VALUE '5'. 0E7F2CE8
107
-
01 CA-6 PIC X VALUE '6'. FA3CC86F
108
-
01 CA-9 PIC X VALUE '9'. 6992B276
109
-
01 CA-0 PIC X VALUE '0'. 06113A1C
110
-
01 CA-00 PIC XX VALUE '00'. 028AD686
111
-
01 CA-10 PIC XX VALUE '10'. A2D263D0
112
-
01 CA-20 PIC XX VALUE '20'. 56918757
113
-
01 CA-30 PIC XX VALUE '30'. 9124AC9F
114
-
01 CA-40 PIC XX VALUE '40'. 65674818
115
-
01 CA-50 PIC XX VALUE '50'. 0AE4C072
116
-
01 CA-60 PIC XX VALUE '60'. FEA724F5
117
-
01 CA-70 PIC XX VALUE '70'. 39120F3D
118
-
01 CA-80 PIC XX VALUE '80'. CD51EBBA
119
-
01 CA-99 PIC XX VALUE '99'. 5EF6D53A
120
-
01 CA-TCDT001 PIC X(7) 3A01E07F
121
-
VALUE 'TCDT001'. 154B76A2
122
-
01 CA-TCDT010 PIC X(7) 9D03ABFB
123
-
VALUE 'TCDT010'. 52EAD97B
124
-
01 CA-TCDT099 PIC X(7) VALUE 'TCDT099'. 392226BD
125
-
01 CA-NOPROCEED PIC X(1) VALUE 'N'. B517CE6C
126
-
* 1A300880
127
-
01 SW-ENDCURSOR PIC X VALUE 'N'. 993B878A
128
-
88 SW-ECUR-YES VALUE 'Y'. B8E45BF5
129
-
88 SW-ECUR-NO VALUE 'N'. B959B448
130
-
* 1A300880
131
-
01 SW-OPENCURSOR2 PIC X VALUE 'N'. 5B7510B4
132
-
88 SW-OCUR-YES VALUE 'Y'. 70BD2FF5
133
-
88 SW-OCUR-YES-6 VALUE 'Y'. D0E6BF7D
134
-
88 SW-OCUR-NO VALUE 'N'. C555ADA2
135
-
88 SW-OCUR-NO-6 VALUE 'N'. 2696FD20
136
-
* 1A300880
137
-
01 SW-LNG-INFORMED PIC X. A8ED857C
138
-
88 SW-LNGI-INFORMEDYES VALUE 'Y'. A4725920
139
-
88 SW-LNGI-INFORMEDNO VALUE 'N'. 34F1F324
140
-
* 1A300880
141
-
01 VA-EXECUTION PIC X(18) VALUE SPACES. E89B9F4D
142
-
01 CA-EXECUTION-2 PIC X(18) VALUE 92A8394C
143
-
'NO FIRST EXECUTION'. D02AC1A6
144
-
01 VA-LNG-FND PIC X(1) VALUE SPACES. 302A18AD
145
-
01 VA-TC9C9990 PIC X(8) VALUE 'TC9C9990'. 078BF9B1
146
-
*@PERFORMANCE
147
-
01 CA-PERFORMANCE. 52EB82E7
148
-
05 PERF-COUNTER2 PIC 9(5) VALUE ZEROES.
149
-
05 PERF-DISPLAY.
150
-
10 PERF-TC9C1000 PIC X(9) VALUE 'TC9C1000-'.
151
-
10 PERF-COUNTER PIC 9(5) VALUE ZEROES.
152
-
10 PERF-DASH PIC X(1) VALUE '-'.
153
-
10 PERF-ANTERIOR PIC X(24) VALUE SPACES.
154
-
155
-
01 SW-PRIMERA-VEZ PIC X VALUE 'Y'.
156
-
88 SW-PRIMERA-VEZ-Y VALUE 'Y'.
157
-
88 SW-PRIMERA-VEZ-N VALUE 'N'.
158
-
*@PERFORMANCE
159
-
01 SW-TABLE PIC X(4). 4EE5F57B
160
-
88 SW-TABLE-FIXED VALUE '0007', '0008', '0009' 446989E0
161
-
, '0026', '0029', '0101' 49C5F9DB
162
-
, '0111', '0112', '0113' 66DB0CBA
163
-
, '0114', '0182' 784BAA6F
164
-
, '0225', '0301', '0302' 006C16F6
165
-
, '0303', '0304', '0306' AF8DF834
166
-
, '0315', '0325' FDF972C7
167
-
, '0341'. 99F35A4C
168
-
* 1A300880
169
-
EXEC SQL 7CE05DE5
170
-
DECLARE TCDC0100 CURSOR FOR 7CE5DFB2
171
-
SELECT COD_TABLE, 25E8C34C
172
-
LNG_DATA, E06D6832
173
-
ENTITY, B9F97005
174
-
KEY_TABLE, F494A4B2
175
-
DTA_TBLKEY BC5A4463
176
-
FROM TCDV0100 7DA3B204
177
-
WHERE COD_TABLE = :VA-KEY-CODTBL AND FC3628EC
178
-
LNG_DATA = :VA-KEY-LNGFLG AND C0BF6FA6
179
-
ENTITY = :VA-KEY-CODENT AND A9254206
180
-
KEY_TABLE >= :VA-KEY-TGTBL 7970F088
181
-
ORDER BY COD_TABLE,LNG_DATA,ENTITY,KEY_TABLE 85299365
182
-
FOR FETCH ONLY 9C08B414
183
-
END-EXEC. 8F8C7C7D
184
-
* 1A300880
185
-
EXEC SQL 7CE05DE5
186
-
DECLARE TCDC0101 CURSOR FOR 89102616
187
-
SELECT COD_TABLE, 25E8C34C
188
-
LNG_DATA, E06D6832
189
-
ENTITY, B9F97005
190
-
KEY_TABLE, F494A4B2
191
-
DTA_TBLKEY BC5A4463
192
-
FROM TCDV0100 7DA3B204
193
-
WHERE COD_TABLE = :VA-KEY-CODTBL AND FC3628EC
194
-
LNG_DATA = :VA-KEY-LNGFLG AND C0BF6FA6
195
-
ENTITY = :VA-KEY-CODENT AND A9254206
196
-
KEY_TABLE < :VA-KEY-TGTBL 4AC3B32F
197
-
ORDER BY COD_TABLE,LNG_DATA,ENTITY,KEY_TABLE DESC 35122D28
198
-
FOR FETCH ONLY 9C08B414
199
-
END-EXEC. 8F8C7C7D
200
-
* 1A300880
201
-
******************************************************************A4837AC3
202
-
* LINKAGE SECTION *38B5FBB2
203
-
******************************************************************A4837AC3
204
-
LINKAGE SECTION. E91201B8
205
-
* 1A300880
206
-
COPY TCEC1000. 810A28ED
207
-
* 1A300880
208
-
******************************************************************A4837AC3
209
-
* PROCEDURE DIVISION *BA9FC1FB
210
-
******************************************************************A4837AC3
211
-
PROCEDURE DIVISION USING TCEC1000. 79A3B061
212
-
* 1A300880
213
-
******************************************************************A4837AC3
214
-
*.PN 1000-MAINLINE. *A660B451
215
-
******************************************************************A4837AC3
216
-
1000-MAINLINE. CD10B029
217
-
* 1A300880
218
-
*@PERFORMANCE
219
-
IF SW-PRIMERA-VEZ EQUAL 'Y'
220
-
INITIALIZE PERF-COUNTER2
221
-
MOVE TCEC1000-COD-TABLE TO PERF-ANTERIOR(1:4)
222
-
MOVE '-' TO PERF-ANTERIOR(5:1)
223
-
MOVE TCEC1000-KEY-CARD TO PERF-ANTERIOR(6:19)
224
-
SET SW-PRIMERA-VEZ-N TO TRUE
225
-
END-IF.
226
-
227
-
IF PERF-COUNTER2 LESS THAN 1000
228
-
ADD 1 TO PERF-COUNTER2
229
-
IF TCEC1000-COD-TABLE EQUAL PERF-ANTERIOR(1:4) AND
230
-
TCEC1000-KEY-CARD EQUAL PERF-ANTERIOR(6:19)
231
-
ADD 1 TO PERF-COUNTER
232
-
ELSE
233
-
DISPLAY PERF-DISPLAY
234
-
MOVE SPACES TO PERF-ANTERIOR
235
-
MOVE TCEC1000-COD-TABLE TO PERF-ANTERIOR(1:4)
236
-
MOVE '-' TO PERF-ANTERIOR(5:1)
237
-
MOVE TCEC1000-KEY-CARD TO PERF-ANTERIOR(6:19)
238
-
INITIALIZE PERF-COUNTER
239
-
ADD 1 TO PERF-COUNTER
240
-
END-IF
241
-
END-IF.
242
-
*@PERFORMANCE
243
-
MOVE TCEC1000-COD-TABLE TO SW-TABLE A9222B8B
244
-
* 1A300880
245
-
IF VA-EXECUTION NOT = CA-EXECUTION-2 D9109904
246
-
MOVE SPACES TO VA-LNG-FND 2DBCD550
247
-
MOVE CA-EXECUTION-2 TO VA-EXECUTION 54AE3092
248
-
END-IF 6B08CD03
249
-
* 1A300880
250
-
IF SW-TABLE-FIXED AND TCEC1000-COD-REQOPTION = CA-1 8556B29A
251
-
MOVE TCEC1000-COD-TABLE TO TCEC9999-COD-TABLE 631AB3A3
252
-
MOVE TCEC1000-COD-ENTITY TO TCEC9999-COD-ENTITY 084C94A9
253
-
MOVE TCEC1000-KEY-SEARCH TO TCEC9999-KEY-SEARCH 7D220037
254
-
MOVE ZEROS TO TCEC9999-NUM-KEY 6C78AC1C
255
-
IF TCEC1000-COD-BRNLNG = SPACES FB89C220
256
-
IF VA-LNG-FND EQUAL SPACES OR LOW-VALUES 2573157C
257
-
PERFORM OBTAIN-LANGUAGE 76057C5D
258
-
MOVE V099-LNG-OFDATA TO TCEC9999-COD-BRNLNG B427C898
259
-
ELSE 1C255E19
260
-
MOVE VA-LNG-FND TO TCEC9999-COD-BRNLNG B092FB25
261
-
END-IF 2B1408AE
262
-
END-IF CA08BD93
263
-
CALL VA-TC9C9990 USING TCEC9999 A4786751
264
-
MOVE TCEC9999-COD-RETURN TO TCEC1000-COD-RETURN 13BAD5A2
265
-
MOVE TCEC9999-ERR-DB2 TO TCEC1000-ERR-DB2 96ACBAE3
266
-
MOVE TCEC1000-KEY-SEARCH TO TCEC1000-TB-TAB-KEY(1) 095C6499
267
-
MOVE TCEC9999-RECCN TO TCEC1000-TB-TAB-REC(1) 816EDE45
268
-
ELSE B227B874
269
-
PERFORM 2000-START E8C6DCFF
270
-
PERFORM 3000-PROCESS 66C85A84
271
-
END-IF 6B08CD03
272
-
PERFORM 8000-END. 0F0FF54E
273
-
* 1A300880
274
-
******************************************************************A4837AC3
275
-
*.PN 2000-START. *4D728197
276
-
******************************************************************A4837AC3
277
-
2000-START. F3BA6DAB
278
-
* 1A300880
279
-
INITIALIZE QAWCSQL. 0999A035
280
-
INITIALIZE TCEC1000-OUTPUT 75D42F79
281
-
TB-TABLE FC464A73
282
-
TCEC1000-NUM-RREC 40D4AC07
283
-
TCGV0990. 06A7B877
284
-
* 1A300880
285
-
MOVE CA-00 TO TCEC1000-COD-RETURN. 3A9579D6
286
-
* 1A300880
287
-
MOVE CA-YES TO SW-LNG-INFORMED. D0241817
288
-
* 1A300880
289
-
IF TCEC1000-COD-REQOPTION = CA-1 OR 5D2FF654
290
-
TCEC1000-COD-REQOPTION = CA-2 OR 7C6B22F9
291
-
TCEC1000-COD-REQOPTION = CA-3 OR 38CA07E1
292
-
TCEC1000-COD-REQOPTION = CA-4 OR 04AAE4E9
293
-
TCEC1000-COD-REQOPTION = CA-5 OR 89FE53D0
294
-
TCEC1000-COD-REQOPTION = CA-6 BCC97954
295
-
PERFORM 2100-STARTING-VALIDATIONS 6CD832FE
296
-
ELSE B227B874
297
-
MOVE CA-40 TO TCEC1000-COD-RETURN 2C1E57A6
298
-
PERFORM 8000-END 42566844
299
-
END-IF. 2F0FAB23
300
-
* 1A300880
301
-
******************************************************************A4837AC3
302
-
*.PN 2100-STARTING-VALIDATIONS. *A8383F5A
303
-
*B.PR.S *DFE1C20F
304
-
* SE VALIDA QUE ESTE INFORMADO EL CODIGO DE LA TABLA Y EN EL *B9304C90
305
-
* CASO DE 'OPCION 1' QUE TAMBIEN ESTE INFORMADA LA CLAVE A *28AC3CD7
306
-
* RECUPERAR. *AB88DCC9
307
-
*B.PR.E *9E0AF2AE
308
-
******************************************************************A4837AC3
309
-
2100-STARTING-VALIDATIONS. 62AB3912
310
-
* 1A300880
311
-
IF TCEC1000-COD-TABLE = SPACES EF1DDABB
312
-
MOVE CA-20 TO TCEC1000-COD-RETURN A0F5EA87
313
-
PERFORM 8000-END 3BF41BC8
314
-
END-IF. 2F0FAB23
315
-
* 1A300880
316
-
IF TCEC1000-COD-BRNLNG = SPACES 9E085BF4
317
-
* 1A300880
318
-
IF VA-LNG-FND EQUAL SPACES OR LOW-VALUES 68BFC424
319
-
PERFORM OBTAIN-LANGUAGE 5C69EC47
320
-
MOVE V099-LNG-OFDATA TO TCEC1000-COD-BRNLNG D0E276B0
321
-
ELSE B726AFD9
322
-
MOVE VA-LNG-FND TO TCEC1000-COD-BRNLNG 520439C4
323
-
VA-KEY-LNGFLG 07A78030
324
-
END-IF CA08BD93
325
-
MOVE CA-NO TO SW-LNG-INFORMED D01FAF54
326
-
ELSE B227B874
327
-
* 1A300880
328
-
MOVE TCEC1000-COD-BRNLNG TO VA-KEY-LNGFLG F63C68E3
329
-
END-IF. 2F0FAB23
330
-
* 1A300880
331
-
IF TCEC1000-COD-REQOPTION = CA-1 AND 3D3FA83B
332
-
TCEC1000-KEY-CARD = SPACES 01B898EA
333
-
MOVE CA-30 TO TCEC1000-COD-RETURN A82F4E57
334
-
PERFORM 8000-END 42566844
335
-
END-IF. 2F0FAB23
336
-
* 1A300880
337
-
IF TCEC1000-COD-REQOPTION = CA-2 OR EDD995C1
338
-
TCEC1000-COD-REQOPTION = CA-5 OR 6A48DC33
339
-
TCEC1000-COD-REQOPTION = CA-6 E8CAA21B
340
-
MOVE CN-NUM-21 TO VN-NUM-ENDACS F8185F12
341
-
ELSE B227B874
342
-
MOVE CN-NUM-1 TO VN-NUM-ENDACS 9CB61D59
343
-
END-IF. 2F0FAB23
344
-
* 1A300880
345
-
IF TCEC1000-COD-ENTITY EQUAL SPACES OR LOW-VALUES OR ZEROS 713171ED
346
-
MOVE CA-30 TO TCEC1000-COD-RETURN 0FA1EE07
347
-
* 1A300880
348
-
PERFORM 8000-END A3C0C483
349
-
ELSE DD83B013
350
-
MOVE TCEC1000-COD-ENTITY TO VA-ENT-AUXST 520B3E06
351
-
END-IF. 2F0FAB23
352
-
* 1A300880
353
-
MOVE TCEC1000-KEY TO VA-KEY-T010 E8307356
354
-
MOVE VA-ENT-AUXST TO VA-KEY-CODENT. 499090DF
355
-
* 1A300880
356
-
PERFORM VALIDATE-LANGUAGE-CODE. 9F2E9F3C
357
-
* 1A300880
358
-
******************************************************************A4837AC3
359
-
*.PN OBTAIN-LANGUAGE. *F0744CA8
360
-
******************************************************************A4837AC3
361
-
OBTAIN-LANGUAGE. 210FE8F8
362
-
* 1A300880
363
-
MOVE TCEC1000-COD-ENTITY TO V099-COD-ENTITY 0001F607
364
-
* 1A300880
365
-
EXEC SQL E6588CB0
366
-
SELECT LNG_OFDATA 028292EF
367
-
INTO :V099-LNG-OFDATA 47314E8F
368
-
FROM TCDV0990 15AD38CC
369
-
WHERE COD_ENTITY = :V099-COD-ENTITY 1E763A50
370
-
END-EXEC. 187FFBE7
371
-
* 1A300880
372
-
MOVE SQLCODE TO SQL-VALUES 216E7152
373
-
EVALUATE TRUE CDF79885
374
-
WHEN SQL-88-OK 10FFEA59
375
-
WHEN SQL-88-SEVERAL 8AABC254
376
-
MOVE V099-LNG-OFDATA TO VA-KEY-LNGFLG 240E84C8
377
-
* 1A300880
378
-
VA-LNG-FND 6C86FAD4
379
-
* 1A300880
380
-
WHEN SQL-88-NOT-FOUND BB13573E
381
-
MOVE SQLCODE TO TCEC1000-SQLCODE 2A5BFD98
382
-
MOVE CA-TCDT099 TO TCEC1000-DES-ABLE 00D8627A
383
-
MOVE CA-70 TO TCEC1000-COD-RETURN 79952339
384
-
* 1A300880
385
-
PERFORM 8000-END E3E54901
386
-
WHEN OTHER 48D45F3B
387
-
MOVE SQLCODE TO TCEC1000-SQLCODE 2A5BFD98
388
-
MOVE SQLERRM TO TCEC1000-SQLERRM 5B5F6922
389
-
MOVE CA-TCDT099 TO TCEC1000-DES-ABLE 00D8627A
390
-
MOVE CA-80 TO TCEC1000-COD-RETURN DA030B75
391
-
* 1A300880
392
-
PERFORM 8000-END E3E54901
393
-
END-EVALUATE. EBCA57AE
394
-
* 1A300880
395
-
******************************************************************A4837AC3
396
-
*.PN VALIDATE-LANGUAGE-CODE. *29251F49
397
-
******************************************************************A4837AC3
398
-
VALIDATE-LANGUAGE-CODE. 7D995829
399
-
* 1A300880
400
-
MOVE TCEC1000-COD-TABLE TO VA-COD-TABLE. 03A54CAA
401
-
* 1A300880
402
-
EXEC SQL E6588CB0
403
-
SELECT DES_TABLE, 5F0D5680
404
-
FLG_MULTIENT, 9F354229
405
-
FLG_ACTIVE, 1124942C
406
-
FLG_LNG1, 5A508245
407
-
FLG_LNG2, 7078BA27
408
-
NUM_RECORD, F9CBC26F
409
-
VALRUTT, 0401080A
410
-
ENT_MNT, 7464D637
411
-
BRN_MNT, 581031C7
412
-
DAT_LASTMOD, 41F08673
413
-
FLG_LNGF B5891DAB
414
-
INTO :V001-DES-TABLE, 16122BAA
415
-
:V001-FLG-MULTIENT, 0D3D71C9
416
-
:V001-FLG-ACTIVE, 59A45A75
417
-
:V001-FLG-LNGC, 33F4BCF4
418
-
:V001-FLG-LNGE, AEE6ABA6
419
-
:V001-NUM-RECORD, 6110B0AC
420
-
:V001-VALRUTT, 439349BA
421
-
:V001-ENT-MNT, D48FEAD2
422
-
:V001-BRN-MNT, 0BE04100
423
-
:V001-DAT-LASTMOD, 07463424
424
-
:V001-FLG-LNGF 299A6CD5
425
-
FROM TCDV0010 34DBF7AC
426
-
WHERE COD_TABLE = :VA-COD-TABLE AF82360A
427
-
END-EXEC. 187FFBE7
428
-
* 1A300880
429
-
PERFORM DB2CHECK. F4689D69
430
-
* 1A300880
431
-
IF SQL-88-OK AND SQLWARN0 = SPACES 1F33A255
432
-
MOVE V001-FLG-LNGC TO VA-FLG-LNG1 B7B4E3B0
433
-
MOVE V001-FLG-LNGE TO VA-FLG-LNG2 5BF76224
434
-
MOVE V001-FLG-LNGF TO VA-FLG-LNG3 5C557678
435
-
ELSE B227B874
436
-
IF SQL-88-NOT-FOUND AND SQLWARN0 = SPACES 230BC583
437
-
MOVE CA-70 TO TCEC1000-COD-RETURN 3E148D09
438
-
MOVE SQLCODE TO TCEC1000-SQLCODE A49EAF17
439
-
MOVE CA-TCDT001 TO TCEC1000-DES-ABLE 3155ACD6
440
-
PERFORM 8000-END DD0BEC8A
441
-
ELSE B726AFD9
442
-
MOVE SQLCODE TO TCEC1000-SQLCODE A49EAF17
443
-
MOVE SQLERRM TO TCEC1000-SQLERRM FB9970BD
444
-
MOVE CA-TCDT001 TO TCEC1000-DES-ABLE 3155ACD6
445
-
MOVE CA-80 TO TCEC1000-COD-RETURN 576D866C
446
-
PERFORM 8000-END DD0BEC8A
447
-
END-IF CA08BD93
448
-
END-IF. 2F0FAB23
449
-
* 1A300880
450
-
IF SW-LNGI-INFORMEDNO EEDE525E
451
-
IF VA-FLG-LNG1 = CA-NO AND VA-FLG-LNG2 = CA-NO AND F8061927
452
-
VA-FLG-LNG3 = CA-NO 38D762C4
453
-
MOVE CA-NOPROCEED TO TCEC1000-COD-BRNLNG FBFDCA58
454
-
* 1A300880
455
-
MOVE CA-NOPROCEED TO VA-KEY-LNGFLG C15750E6
456
-
END-IF CA08BD93
457
-
ELSE B227B874
458
-
* 1A300880
459
-
IF TCEC1000-COD-BRNLNG = CA-NOPROCEED B0F372F1
460
-
IF VA-FLG-LNG1 = CA-S OR D98FCAEE
461
-
VA-FLG-LNG2 = CA-S OR 8DDAD99A
462
-
VA-FLG-LNG3 = CA-S 72832D8A
463
-
MOVE CA-60 TO TCEC1000-COD-RETURN 465E5DAC
464
-
PERFORM 8000-END E3E54901
465
-
* 1A300880
466
-
END-IF 2B1408AE
467
-
ELSE B726AFD9
468
-
* 1A300880
469
-
IF VA-FLG-LNG1 = CA-NO AND C6E8FF68
470
-
VA-FLG-LNG2 = CA-NO AND 92BDEC1C
471
-
VA-FLG-LNG3 = CA-NO 1D4627F2
472
-
MOVE CA-60 TO TCEC1000-COD-RETURN 70D33905
473
-
PERFORM 8000-END C172FF22
474
-
END-IF 2B1408AE
475
-
END-IF F54FF55B
476
-
END-IF. 2F0FAB23
477
-
* 1A300880
478
-
******************************************************************A4837AC3
479
-
*.PN 3000-PROCESS. *7FD4D81C
480
-
******************************************************************A4837AC3
481
-
3000-PROCESS. 9A050341
482
-
* 1A300880
483
-
IF TCEC1000-COD-REQOPTION = '1' BE51B35C
484
-
PERFORM 3100-PROCESS-1 2EA69C76
485
-
ELSE B227B874
486
-
IF TCEC1000-COD-REQOPTION = '2' OR '3' OR '4' OR '5' 83A16405
487
-
PERFORM 3200-PROCESS-2 B846DEB8
488
-
ELSE B227B874
489
-
PERFORM 3300-PROCESS-3 559A8157
490
-
END-IF 5F88B059
491
-
END-IF. 2F0FAB23
492
-
* 1A300880
493
-
MOVE CA-00 TO TCEC1000-COD-RETURN. 3A9579D6
494
-
MOVE TB-TABLE TO TCEC1000-TB-TABLE. 5F693635
495
-
IF TB-TABLE-KEY-INT(21) NOT = SPACES F95B9581
496
-
MOVE CA-1 TO TCEC1000-FLG-DATA A47F8EE5
497
-
MOVE CN-NUM-20 TO TCEC1000-NUM-RREC 9352D714
498
-
MOVE TB-TABLE-KEY-INT(20) TO TCEC1000-KEY-SEARCH 8721BEDE
499
-
ELSE B227B874
500
-
MOVE CA-0 TO TCEC1000-FLG-DATA 49A65F41
501
-
END-IF. 2F0FAB23
502
-
* 1A300880
503
-
******************************************************************A4837AC3
504
-
*.PN 3100-PROCESS-1. *8F932B8E
505
-
******************************************************************A4837AC3
506
-
3100-PROCESS-1. 384BCC39
507
-
* 1A300880
508
-
EXEC SQL E6588CB0
509
-
SELECT COD_TABLE, E1B5C3FD
510
-
LNG_DATA, 1282FCE2
511
-
ENTITY, 6AD1687C
512
-
KEY_TABLE, B8CAAB74
513
-
DTA_TBLKEY A2BE964A
514
-
INTO :T010-COD-TABLE, E6BEFE65
515
-
:T010-LNG-DATA, E9E743E1
516
-
:T010-ENTITY, F6E9791D
517
-
:T010-KEY-TABLE, 11778CFD
518
-
:T010-DTA-TBLKEY 6DA1165A
519
-
FROM TCDV0100 CF4BED90
520
-
WHERE COD_TABLE = :VA-KEY-CODTBL AND 5C2F99C0
521
-
LNG_DATA = :VA-KEY-LNGFLG AND 4757A9F9
522
-
ENTITY = :VA-KEY-CODENT AND 6858EF85
523
-
KEY_TABLE = :VA-KEY-TGTBL 0142B85F
524
-
END-EXEC. 187FFBE7
525
-
* 1A300880
526
-
PERFORM DB2CHECK. F4689D69
527
-
* 1A300880
528
-
IF SQL-88-OK B33157C8
529
-
PERFORM 3400-OK-DB2-ACCESS 5BED4C51
530
-
ELSE B227B874
531
-
MOVE CA-10 TO TCEC1000-COD-RETURN 7B3C7BF4
532
-
PERFORM 8000-END 42566844
533
-
END-IF. 2F0FAB23
534
-
* 1A300880
535
-
******************************************************************A4837AC3
536
-
*.PN 3200-PROCESS-2. *78F149DD
537
-
******************************************************************A4837AC3
538
-
3200-PROCESS-2. DEB21DA1
539
-
* 1A300880
540
-
PERFORM 3210-OPEN-CURSOR. 30A6FE8A
541
-
* 1A300880
542
-
PERFORM 3220-FETCH. 605A51A8
543
-
* 1A300880
544
-
PERFORM 3230-DB2-ACCESS. FBA53FD7
545
-
* 1A300880
546
-
PERFORM 3240-CLOSE-CURSOR. 59570E20
547
-
* 1A300880
548
-
******************************************************************A4837AC3
549
-
*.PN 3210-OPEN-CURSOR. *14E919CA
550
-
******************************************************************A4837AC3
551
-
3210-OPEN-CURSOR. B9DFE91D
552
-
* 1A300880
553
-
EXEC SQL E6588CB0
554
-
OPEN TCDC0100 522217AF
555
-
END-EXEC. 187FFBE7
556
-
* 1A300880
557
-
PERFORM DB2CHECK. F4689D69
558
-
* 1A300880
559
-
IF NOT SQL-88-OK 7F20B152
560
-
PERFORM 3300-ERROR-DB2-ACCESS 6C3BAA15
561
-
ELSE B227B874
562
-
SET SW-OCUR-YES TO TRUE F966B55B
563
-
END-IF. 2F0FAB23
564
-
* 1A300880
565
-
******************************************************************A4837AC3
566
-
*.PN 3220-FETCH. *441AC9CF
567
-
******************************************************************A4837AC3
568
-
3220-FETCH. 5772CF95
569
-
* 1A300880
570
-
EXEC SQL E6588CB0
571
-
FETCH TCDC0100 A27DFDA8
572
-
INTO :T010-COD-TABLE, A82F0F6D
573
-
:T010-LNG-DATA, E9E743E1
574
-
:T010-ENTITY, F6E9791D
575
-
:T010-KEY-TABLE, 11778CFD
576
-
:T010-DTA-TBLKEY 6DA1165A
577
-
END-EXEC. 187FFBE7
578
-
* 1A300880
579
-
PERFORM DB2CHECK. F4689D69
580
-
* 1A300880
581
-
IF SQL-88-OK B33157C8
582
-
SET SW-ECUR-NO TO TRUE 5AF776DB
583
-
ELSE B227B874
584
-
IF SQL-88-NOT-FOUND D7FCB497
585
-
SET SW-ECUR-YES TO TRUE 12CCE21E
586
-
ELSE B726AFD9
587
-
PERFORM 3300-ERROR-DB2-ACCESS 3B9C741C
588
-
END-IF CA08BD93
589
-
END-IF. 2F0FAB23
590
-
* 1A300880
591
-
******************************************************************A4837AC3
592
-
*.PN 3230-DB2-ACCESS. *A8F1C086
593
-
******************************************************************A4837AC3
594
-
3230-DB2-ACCESS. AA8967D9
595
-
* 1A300880
596
-
EVALUATE TCEC1000-COD-REQOPTION 89586155
597
-
WHEN '1' 98BE3361
598
-
IF T010-KEY-TABLE EQUAL TCEC1000-KEY-CARD AND 461CA410
599
-
SW-ECUR-NO 6725DF59
600
-
PERFORM 3400-OK-DB2-ACCESS 9B22671B
601
-
ELSE 5233F784
602
-
MOVE CA-10 TO TCEC1000-COD-RETURN B5F0FE5A
603
-
PERFORM 8000-END E3E54901
604
-
END-IF 0701E0FD
605
-
WHEN '2' E6668320
606
-
PERFORM UNTIL SW-ECUR-YES OR FF311324
607
-
T010-KEY-TABLE > TCEC1000-KEY-CARD B733BF58
608
-
PERFORM 3220-FETCH 803321B9
609
-
END-PERFORM AB7A48D6
610
-
IF T010-KEY-TABLE > TCEC1000-KEY-CARD AND SW-ECUR-NO 3FC6F153
611
-
CONTINUE A95739E9
612
-
ELSE 5233F784
613
-
MOVE CA-0 TO TCEC1000-FLG-DATA 3F483863
614
-
MOVE CA-00 TO TCEC1000-COD-RETURN 69F02B3C
615
-
PERFORM 8000-END E3E54901
616
-
END-IF 0701E0FD
617
-
PERFORM UNTIL SW-ECUR-YES OR TCEC1000-NUM-RREC >= 21 F2B69982
618
-
PERFORM 3400-OK-DB2-ACCESS 0195476A
619
-
PERFORM 3220-FETCH 803321B9
620
-
END-PERFORM AB7A48D6
621
-
WHEN '3' 650F53E3
622
-
PERFORM UNTIL SW-ECUR-YES OR FF311324
623
-
T010-KEY-TABLE > TCEC1000-KEY-CARD B733BF58
624
-
PERFORM 3220-FETCH 803321B9
625
-
END-PERFORM AB7A48D6
626
-
IF T010-KEY-TABLE > TCEC1000-KEY-CARD AND SW-ECUR-NO 3FC6F153
627
-
PERFORM 3400-OK-DB2-ACCESS 9B22671B
628
-
ELSE 5233F784
629
-
MOVE CA-00 TO TCEC1000-COD-RETURN 69F02B3C
630
-
PERFORM 8000-END E3E54901
631
-
END-IF 0701E0FD
632
-
WHEN '4' 1BD7E3A2
633
-
IF T010-KEY-TABLE >= TCEC1000-KEY-CARD AND SW-ECUR-NO 404D686B
634
-
PERFORM 3400-OK-DB2-ACCESS 9B22671B
635
-
ELSE 5233F784
636
-
MOVE CA-00 TO TCEC1000-COD-RETURN 69F02B3C
637
-
PERFORM 8000-END E3E54901
638
-
END-IF 0701E0FD
639
-
* 1A300880
640
-
WHEN '5' F88A7AAE
641
-
PERFORM UNTIL SW-ECUR-YES OR TCEC1000-NUM-RREC >= 21 F2B69982
642
-
PERFORM 3400-OK-DB2-ACCESS 9B22671B
643
-
PERFORM 3220-FETCH 84794213
644
-
END-PERFORM AB7A48D6
645
-
END-EVALUATE. EBCA57AE
646
-
* 1A300880
647
-
******************************************************************A4837AC3
648
-
*.PN 3240-CLOSE-CURSOR. *01F607D7
649
-
******************************************************************A4837AC3
650
-
3240-CLOSE-CURSOR. AD930250
651
-
* 1A300880
652
-
EXEC SQL E6588CB0
653
-
CLOSE TCDC0100 E3BA0121
654
-
END-EXEC. 187FFBE7
655
-
* 1A300880
656
-
PERFORM DB2CHECK. F4689D69
657
-
* 1A300880
658
-
SET SW-OCUR-NO TO TRUE. C004654F
659
-
* 1A300880
660
-
IF NOT SQL-88-OK 7F20B152
661
-
PERFORM 3300-ERROR-DB2-ACCESS 6C3BAA15
662
-
END-IF. 2F0FAB23
663
-
* 1A300880
664
-
******************************************************************A4837AC3
665
-
*.PN 3300-PROCESS-3. *BA26E969
666
-
******************************************************************A4837AC3
667
-
3300-PROCESS-3. 2EC96948
668
-
* 1A300880
669
-
PERFORM 3310-OPEN-CURSOR-6. DE4D7E0D
670
-
PERFORM 3320-FETCH-6. 1517EA6B
671
-
PERFORM 3330-DB2-ACCESS-6. B1AB1600
672
-
PERFORM 3340-CLOSE-CURSOR-6. 83D1B3C1
673
-
* 1A300880
674
-
******************************************************************A4837AC3
675
-
*.PN 3310-OPEN-CURSOR-6. *2E66ED04
676
-
******************************************************************A4837AC3
677
-
3310-OPEN-CURSOR-6. E797F612
678
-
* 1A300880
679
-
EXEC SQL E6588CB0
680
-
OPEN TCDC0101 DB1DDC37
681
-
END-EXEC. 187FFBE7
682
-
PERFORM DB2CHECK. F4689D69
683
-
IF NOT SQL-88-OK 7F20B152
684
-
PERFORM 3300-ERROR-DB2-ACCESS 6C3BAA15
685
-
ELSE B227B874
686
-
SET SW-OCUR-YES-6 TO TRUE D7BE82D1
687
-
END-IF. 2F0FAB23
688
-
* 1A300880
689
-
******************************************************************A4837AC3
690
-
*.PN 3320-FETCH-6. *10B5E44C
691
-
******************************************************************A4837AC3
692
-
3320-FETCH-6. DD923638
693
-
* 1A300880
694
-
EXEC SQL E6588CB0
695
-
FETCH TCDC0101 06703910
696
-
INTO :T010-COD-TABLE, A82F0F6D
697
-
:T010-LNG-DATA, E9E743E1
698
-
:T010-ENTITY, F6E9791D
699
-
:T010-KEY-TABLE, 11778CFD
700
-
:T010-DTA-TBLKEY 6DA1165A
701
-
END-EXEC. 187FFBE7
702
-
* 1A300880
703
-
PERFORM DB2CHECK. F4689D69
704
-
* 1A300880
705
-
IF SQL-88-OK B33157C8
706
-
SET SW-ECUR-NO TO TRUE 5AF776DB
707
-
ELSE B227B874
708
-
IF SQL-88-NOT-FOUND D7FCB497
709
-
SET SW-ECUR-YES TO TRUE 12CCE21E
710
-
ELSE B726AFD9
711
-
PERFORM 3300-ERROR-DB2-ACCESS 3B9C741C
712
-
END-IF CA08BD93
713
-
END-IF. 2F0FAB23
714
-
* 1A300880
715
-
******************************************************************A4837AC3
716
-
*.PN 3330-DB2-ACCESS-6. *D645E254
717
-
******************************************************************A4837AC3
718
-
3330-DB2-ACCESS-6. 2A09B3C2
719
-
* 1A300880
720
-
PERFORM UNTIL SW-ECUR-YES OR TCEC1000-NUM-RREC >= 21 AF67A866
721
-
PERFORM 3400-OK-DB2-ACCESS 74D2A015
722
-
PERFORM 3320-FETCH-6 C162164F
723
-
END-PERFORM. DCC3A30B
724
-
* 1A300880
725
-
******************************************************************A4837AC3
726
-
*.PN 3340-CLOSE-CURSOR-6. *04829C75
727
-
******************************************************************A4837AC3
728
-
3340-CLOSE-CURSOR-6. 808ECCB2
729
-
* 1A300880
730
-
EXEC SQL E6588CB0
731
-
CLOSE TCDC0101 3FBAD447
732
-
END-EXEC. 187FFBE7
733
-
* 1A300880
734
-
PERFORM DB2CHECK. F4689D69
735
-
* 1A300880
736
-
SET SW-OCUR-NO-6 TO TRUE 6BE1958F
737
-
* 1A300880
738
-
IF NOT SQL-88-OK 7F20B152
739
-
PERFORM 3300-ERROR-DB2-ACCESS 6C3BAA15
740
-
END-IF. 2F0FAB23
741
-
* 1A300880
742
-
******************************************************************A4837AC3
743
-
*.PN 3300-ERROR-DB2-ACCESS. *0983E32E
744
-
******************************************************************A4837AC3
745
-
3300-ERROR-DB2-ACCESS. A4852680
746
-
* 1A300880
747
-
IF SQL-88-NOT-FOUND AND SQLWARN0 = SPACES 09C1CCDE
748
-
MOVE CA-10 TO TCEC1000-COD-RETURN 7B3C7BF4
749
-
ELSE B227B874
750
-
MOVE SQLCODE TO TCEC1000-SQLCODE 1BC3E079
751
-
MOVE SQLERRM TO TCEC1000-SQLERRM 0697CC91
752
-
MOVE CA-80 TO TCEC1000-COD-RETURN ABE7E0AF
753
-
END-IF. 2F0FAB23
754
-
* 1A300880
755
-
PERFORM 8000-END. 0F0FF54E
756
-
* 1A300880
757
-
******************************************************************A4837AC3
758
-
*.PN 3400-OK-DB2-ACCESS. *B624599B
759
-
******************************************************************A4837AC3
760
-
3400-OK-DB2-ACCESS. FC7867DD
761
-
* 1A300880
762
-
ADD 1 TO TCEC1000-NUM-RREC. E882DFAD
763
-
* 1A300880
764
-
MOVE T010-LNG-DATA TO VA-DB2LNG. 32FADC58
765
-
MOVE T010-KEY-TABLE TO VA-KEY-DB2. 9022399E
766
-
MOVE VA-KEY-DB2-1 TO 59E37554
767
-
TB-TABLE-KEY-INT(TCEC1000-NUM-RREC). 308B123E
768
-
MOVE T010-DTA-TBLKEY TO 553518FA
769
-
TB-TABLE-DAT-INTERNOCCURS(TCEC1000-NUM-RREC). 1D6F1F9E
770
-
* 1A300880
771
-
******************************************************************A4837AC3
772
-
*.PN 8000-END. *F5606B8C
773
-
*B.PR.S *DFE1C20F
774
-
* THIS PARAGRAPH RETURNS THE CONTROL TO THE CALLING PROGRAM. *729A2D79
775
-
*B.PR.E *9E0AF2AE
776
-
******************************************************************A4837AC3
777
-
8000-END. 6D99A32E
778
-
* 1A300880
779
-
IF SW-OCUR-YES 5FC457CE
780
-
PERFORM 3240-CLOSE-CURSOR A3356C91
781
-
END-IF. 2F0FAB23
782
-
* 1A300880
783
-
IF SW-OCUR-YES-6 FF9FC746
784
-
PERFORM 3340-CLOSE-CURSOR-6 B84E190F
785
-
END-IF. 2F0FAB23
786
-
* 1A300880
787
-
GOBACK. F0D464D6
788
-
* 1A300880
789
-
******************************************************************A4837AC3
790
-
*.PN DB2CHECK. *949F5CEF
791
-
******************************************************************A4837AC3
792
-
DB2CHECK. CCBFA46A
793
-
* 1A300880
794
-
IF SQLWARN0 NOT EQUAL SPACES 73742752
795
-
MOVE SQLWARN TO TCEC1000-SQLCODE B9933FF2
796
-
MOVE CA-80 TO TCEC1000-COD-RETURN 71ED1A85
797
-
IF SQLWARN1 NOT = SPACES 8B9868EB
798
-
MOVE 'WARNING1' TO TCEC1000-DTA-SQLERRM A96A4370
799
-
ELSE DCC30ED4
800
-
IF SQLWARN2 NOT = SPACES 8EECFAC2
801
-
MOVE 'WARNING2' TO TCEC1000-DTA-SQLERRM C43E0A3F
802
-
ELSE 932F25A2
803
-
IF SQLWARN3 NOT = SPACES 264084BE
804
-
MOVE 'WARNING3' TO TCEC1000-DTA-SQLERRM 7F0200F2
805
-
ELSE DEAF59DE
806
-
IF SQLWARN4 NOT = SPACES 18DD43F8
807
-
MOVE 'WARNING4' TO TCEC1000-DTA-SQLERRM 67647C34
808
-
ELSE 043DAF8D
809
-
IF SQLWARN5 NOT = SPACES 6E2D9F71
810
-
MOVE 'WARNING5' TO 231F6B55
811
-
TCEC1000-DTA-SQLERRM AF5C190C
812
-
ELSE BA3A0A73
813
-
IF SQLWARN6 NOT = SPACES 6A61F398
814
-
MOVE 'WARNING6' TO 58070C83
815
-
TCEC1000-DTA-SQLERRM 7DC81674
816
-
ELSE 7B14E21B
817
-
MOVE 'WARNING7' TO F7AE4149
818
-
TCEC1000-DTA-SQLERRM 7DC81674
819
-
END-IF 9A46CE29
820
-
END-IF 8ECF68E5
821
-
END-IF 9F3AEFF6
822
-
END-IF 3A972F88
823
-
END-IF 9DCDFBA4
824
-
END-IF F54FF55B
825
-
END-IF. 2F0FAB23
826
-
* 1A300880
827
-
MOVE SQLCODE TO DB2-RETURN-CDE. DE5867DC
828
-
MOVE SQLCODE TO SQL-VALUES. 65235883
829
-
* 1A300880
830
-
* ALNOVA SERIAL NUMBER: 90C643C3 ********* DO NOT REMOVE *********90C643C3
831
-
-8
files/java.java
-8
files/java.java
-6
files/java.scm
-6
files/java.scm