-
Notifications
You must be signed in to change notification settings - Fork 1
/
CEP001.COB
272 lines (270 loc) · 10.4 KB
/
CEP001.COB
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
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
IDENTIFICATION DIVISION.
PROGRAM-ID. CEP001.
AUTHOR. JULIO CESAR DA SILVA BARCELLOS.
**************************************
* MANUTENCAO DO CADASTRO DE PRODUTO *
**************************************
*----------------------------------------------------------------
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PRODUTO ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS CODPRO
FILE STATUS IS ST-ERRO
ALTERNATE RECORD KEY IS DESCR
WITH DUPLICATES.
*
*-----------------------------------------------------------------
DATA DIVISION.
FILE SECTION.
FD PRODUTO
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "PRODUTO.DAT".
01 REGPRO.
03 CODPRO PIC 9(06).
03 DESCR PIC X(30).
03 UNID PIC X(02).
03 QUANT PIC 9(05).
03 PRECMD PIC 9(06)V99.
03 VRESTOQ PIC 9(10)v99.
03 FUNCIONARIO PIC X(30).
03 ALMOXARIFADO PIC 9(01).
*
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
01 MASC1 PIC ZZZ.ZZ9,99.
01 MASC2 PIC ZZZZ.ZZZ.ZZ9,99.
77 W-SEL PIC 9(01) VALUE ZEROS.
77 W-CONT PIC 9(06) VALUE ZEROS.
77 W-OPCAO PIC X(01) VALUE SPACES.
77 ST-ERRO PIC X(02) VALUE "00".
77 W-ACT PIC 9(02) VALUE ZEROS.
77 MENS PIC X(50) VALUE SPACES.
77 LIMPA PIC X(50) VALUE SPACES.
*-----------------------------------------------------------------
PROCEDURE DIVISION.
INICIO.
*
INC-OP0.
OPEN I-O PRODUTO
IF ST-ERRO NOT = "00"
IF ST-ERRO = "30"
OPEN OUTPUT PRODUTO
CLOSE PRODUTO
MOVE "*** ARQUIVO PRODUTO SENDO CRIADO **" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-OP0
ELSE
MOVE "ERRO NA ABERTURA DO ARQUIVO PRODUTO" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM
ELSE
NEXT SENTENCE.
INC-001.
MOVE ZEROS TO CODPRO QUANT PRECMD VRESTOQ
ALMOXARIFADO
MOVE SPACES TO DESCR UNID.
DISPLAY (01, 01) ERASE.
DISPLAY (01, 20) "CADASTRO DE PRODUTO"
DISPLAY (04, 01) "CODIGO : "
DISPLAY (05, 01) "DESCRICAO : "
DISPLAY (06, 01) "UNIDADE (ESTADO) : "
DISPLAY (07, 01) "QUANTIDADE : "
DISPLAY (08, 01) "PRECO MEDIA : "
DISPLAY (09, 01) "VALOR ESTOQUE : "
DISPLAY (10, 01) "NOME DO FUNCIONARIO: "
DISPLAY (11, 01) "N DE ALMOXARIFADO : ".
INC-002.
ACCEPT (04, 31) CODPRO
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02
CLOSE PRODUTO
GO TO ROT-FIM.
IF CODPRO = 0
MOVE "*** PRODUTO INVALIDO ***" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-002.
LER-PRODUTO01.
MOVE 0 TO W-SEL
READ PRODUTO
IF ST-ERRO NOT = "23"
IF ST-ERRO = "00"
DISPLAY (05, 22) DESCR
DISPLAY (06, 22) UNID
DISPLAY (07, 32) QUANT
MOVE PRECMD TO MASC1
DISPLAY (08, 27) MASC1
MOVE VRESTOQ TO MASC2
DISPLAY (09, 22) MASC2
DISPLAY (10, 22) FUNCIONARIO
DISPLAY (11, 22) ALMOXARIFADO
MOVE "*** PRODUTO JA CADASTRAD0 ***" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
MOVE 1 TO W-SEL
GO TO ACE-001
ELSE
MOVE "ERRO NA LEITURA ARQ. PRODUTO" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM
ELSE
NEXT SENTENCE.
INC-003.
ACCEPT (05, 22) DESCR
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-002.
INC-004.
ACCEPT (06, 22) UNID
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-003.
INC-005.
ACCEPT (07, 32) QUANT
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-004.
INC-006.
ACCEPT (08, 28) PRECMD
MOVE PRECMD TO MASC1
DISPLAY (08, 27)MASC1
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-005.
INC-007.
COMPUTE VRESTOQ = QUANT * PRECMD
MOVE VRESTOQ TO MASC2
DISPLAY (09, 22)MASC2.
INC-008.
ACCEPT (10, 22) FUNCIONARIO
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT= 02 GO TO INC-006.
INC-009.
ACCEPT (11, 22) ALMOXARIFADO
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-008.
*
IF W-SEL = 1
GO TO ALT-OPC.
INC-OPC.
MOVE "S" TO W-OPCAO
DISPLAY (23, 40) "DADOS OK (S/N) : ".
ACCEPT (23, 57) W-OPCAO WITH UPDATE
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-005.
IF W-OPCAO = "N" OR "n"
MOVE "* DADOS RECUSADOS PELO OPERADOR *" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001.
IF W-OPCAO NOT = "S" AND "s"
MOVE "*** DIGITE APENAS S=SIM e N=NAO ***" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-OPC.
INC-WR1.
WRITE REGPRO
IF ST-ERRO = "00" OR "02"
MOVE "*** DADOS GRAVADOS *** " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001.
IF ST-ERRO = "22"
MOVE "*** PRODUTO JA EXISTE *** " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001
ELSE
MOVE "ERRO NA GRAVACAO DO ARQUIVO DE PRODUTO"
TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM.
*
*****************************************
* ROTINA DE CONSULTA/ALTERACAO/EXCLUSAO *
*****************************************
*
ACE-001.
DISPLAY (23, 12)
"F1=NOVO REGISTRO F2=ALTERAR F3=EXCLUIR"
ACCEPT (23, 55) W-OPCAO
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT NOT = 02 AND W-ACT NOT = 03 AND W-ACT NOT = 04
GO TO ACE-001.
MOVE SPACES TO MENS
DISPLAY (23, 12) MENS
IF W-ACT = 02
MOVE 02 TO W-SEL
GO TO INC-001.
IF W-ACT = 03
GO TO INC-003.
*
EXC-OPC.
DISPLAY (23, 40) "EXCLUIR (S/N) : ".
ACCEPT (23, 57) W-OPCAO
IF W-OPCAO = "N" OR "n"
MOVE "*** REGISTRO NAO EXCLUIDO ***" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001.
IF W-OPCAO NOT = "S" AND "s"
MOVE "* DIGITE APENAS S=SIM e N=NAO *" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO EXC-OPC.
EXC-DL1.
DELETE PRODUTO RECORD
IF ST-ERRO = "00"
MOVE "*** REGISTRO EXCLUIDO *** " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001.
MOVE "ERRO NA EXCLUSAO DO REGISTRO " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM.
*
ALT-OPC.
DISPLAY (23, 40) "ALTERAR (S/N) : ".
ACCEPT (23, 57) W-OPCAO
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-005.
IF W-OPCAO = "N" OR "n"
MOVE "*** INFORMACOES NAO ALTERADAS *** " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001.
IF W-OPCAO NOT = "S" AND "s"
MOVE "* DIGITE APENAS S=SIM e N=NAO *" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ALT-OPC.
ALT-RW1.
REWRITE REGPRO
IF ST-ERRO = "00" OR "02"
MOVE "*** REGISTRO ALTERADO *** " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001.
MOVE "ERRO NA EXCLUSAO DO REGISTRO PRODUTO" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM.
*
**********************
* ROTINA DE FIM *
**********************
*
ROT-FIM.
DISPLAY (01, 01) ERASE
EXIT PROGRAM.
ROT-FIMP.
EXIT PROGRAM.
ROT-FIMS.
STOP RUN.
*
**********************
* ROTINA DE MENSAGEM *
**********************
*
ROT-MENS.
MOVE ZEROS TO W-CONT.
ROT-MENS1.
DISPLAY (23, 12) MENS.
ROT-MENS2.
ADD 1 TO W-CONT
IF W-CONT < 300
GO TO ROT-MENS2
ELSE
DISPLAY (23, 12) LIMPA.
ROT-MENS-FIM.
EXIT.
FIM-ROT-TEMPO.