-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathdb2-tp34.cbl
220 lines (179 loc) · 15.9 KB
/
db2-tp34.cbl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
IDENTIFICATION DIVISION.
PROGRAM-ID PGMDB215.
**********************************************************
* *
* PROGRAMA PARA SQL EMBEBIDO *
* CHECK-POINT 28 BATCH ACT DB2 - TP 34 *
* 7-11-22 *
* *
**********************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
**************************************
WORKING-STORAGE SECTION.
**************************************
77 FILLER PIC X(26) VALUE '* INICIO WORKING-STORAGE *'.
77 FS-ENT PIC XX VALUE SPACES.
01 WS-FLAG-FIN PIC X.
88 WS-SI-PROCESO VALUE ' '.
88 WS-FIN-PROCESO VALUE 'F'.
77 FILLER PIC X(26) VALUE '* VARIABLES SQL *'.
77 WS-SQLCODE PIC +++999 USAGE DISPLAY VALUE ZEROS.
01 WS-STATUS PIC X.
88 WS-SI VALUE ' '.
88 WS-NO VALUE 'F'.
01 WS-TIPDOC PIC X(2) VALUE SPACES.
01 WS-NRODOC PIC S9(11)V USAGE COMP-3 VALUE ZEROS.
EXEC SQL
INCLUDE SQLCA
END-EXEC.
EXEC SQL
INCLUDE TB99CUEN
END-EXEC.
EXEC SQL
INCLUDE TB99CLIE
END-EXEC.
EXEC SQL
DECLARE CURSOR1 CURSOR FOR
SELECT A.TIPCUEN, A.NROCUEN, A.SUCUEN,
B.NOMAPE, B.TIPDOC, B.NRODOC
FROM ITPLZRY.TB99CUEN AS A
RIGHT JOIN
ITPLZRY.TB99CLIE AS B
ON A.NROCLI = B.NROCLI
WHERE A.NROCLI = 151
AND A.SUCUEN = 1
END-EXEC.
77 FILLER PIC X(26) VALUE '* FINAL WORKING-STORAGE *'.
***************************************************************.
PROCEDURE DIVISION.
**************************************
* *
* CUERPO PRINCIPAL DEL PROGRAMA *
* *
**************************************
MAIN-PROGRAM.
PERFORM 1000-I-INICIO THRU
1000-F-INICIO.
PERFORM 2000-I-PROCESO THRU
2000-F-PROCESO UNTIL WS-FIN-PROCESO.
PERFORM 9999-I-FINAL THRU
9999-F-FINAL.
F-MAIN-PROGRAM. GOBACK.
**************************************
* *
* CUERPO INICIO APERTURA ARCHIVOS *
* *
**************************************
1000-I-INICIO.
SET WS-SI-PROCESO TO TRUE.
SET WS-SI TO TRUE.
EXEC SQL
OPEN CURSOR1
END-EXEC.
IF SQLCODE NOT EQUAL ZEROS
MOVE SQLCODE TO WS-SQLCODE
DISPLAY 'ERROR EN OPEN DE CURSOR: ' WS-SQLCODE
MOVE 9999 TO RETURN-CODE
SET WS-FIN-PROCESO TO TRUE
END-IF.
1000-F-INICIO. EXIT.
**************************************
* *
* CUERPO PRINCIPAL DEL PROGRAMA *
* *
**************************************
2000-I-PROCESO.
EXEC SQL
FETCH CURSOR1 INTO
:DB-CU-TIPCUEN,
:DB-CU-NROCUEN,
:DB-CU-SUCUEN,
:DB-CL-NOMAPE,
:DB-CL-TIPDOC,
:DB-CL-NRODOC
END-EXEC.
EVALUATE TRUE
WHEN SQLCODE EQUAL ZEROS
MOVE DB-CL-TIPDOC TO WS-TIPDOC
MOVE DB-CL-NRODOC TO WS-NRODOC
PERFORM 3000-UPDATE-CUEN THRU 3000-F-UPDATE-CUEN
WHEN SQLCODE EQUAL +100
PERFORM 4000-UPDATE-CLI THRU 4000-F-UPDATE-CLI
SET WS-FIN-PROCESO TO TRUE
WHEN OTHER
MOVE SQLCODE TO WS-SQLCODE
DISPLAY 'ERROR FETCH CURSOR: ' WS-SQLCODE
SET WS-NO TO TRUE
END-EVALUATE.
2000-F-PROCESO. EXIT.
3000-UPDATE-CUEN.
EXEC SQL
UPDATE ITPLZRY.TB99CUEN
SET NROCLI = 99
WHERE TIPCUEN = :DB-CU-TIPCUEN
AND NROCUEN = :DB-CU-NROCUEN
END-EXEC.
IF SQLCODE NOT EQUAL ZEROS
MOVE SQLCODE TO WS-SQLCODE
DISPLAY 'ERROR EN UPDATE CUENTA = ' WS-SQLCODE
SET WS-FIN-PROCESO TO TRUE
SET WS-NO TO TRUE
MOVE 9999 TO RETURN-CODE
END-IF.
3000-F-UPDATE-CUEN. EXIT.
4000-UPDATE-CLI.
EXEC SQL
UPDATE ITPLZRY.TB99CLIE
SET NROCLI = 99
WHERE TIPDOC = :WS-TIPDOC AND
NRODOC = :WS-NRODOC
END-EXEC.
IF SQLCODE NOT EQUAL ZEROS
MOVE SQLCODE TO WS-SQLCODE
DISPLAY 'ERROR EN UPDATE CLIENTE = ' WS-SQLCODE
SET WS-FIN-PROCESO TO TRUE
SET WS-NO TO TRUE
MOVE 9999 TO RETURN-CODE
ELSE
SET WS-FIN-PROCESO TO TRUE
END-IF.
4000-F-UPDATE-CLI. EXIT.
**************************************
* *
* CUERPO FINAL CIERRE DE FILES *
* *
**************************************
9999-I-FINAL.
EXEC SQL
CLOSE CURSOR1
END-EXEC.
IF SQLCODE NOT EQUAL ZEROS
MOVE SQLCODE TO WS-SQLCODE
DISPLAY '* ERROR CLOSE CURSOR = ' WS-SQLCODE
MOVE 9999 TO RETURN-CODE
END-IF.
IF WS-NO
DISPLAY 'ROLLBACK REALIZADO'
EXEC SQL
ROLLBACK
END-EXEC
ELSE
DISPLAY 'ACTUALIZACIONES CORRECTAS'
DISPLAY 'COMMIT REALIZADO'
EXEC SQL
COMMIT
END-EXEC
END-IF.
* EXEC SQL
* ROLLBACK
* END-EXEC.
9999-F-FINAL.
EXIT.
*