-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathPNOTA1.COB
276 lines (274 loc) · 10.5 KB
/
PNOTA1.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
273
274
275
276
IDENTIFICATION DIVISION.
PROGRAM-ID. PNOTA1.
AUTHOR. JULIO CESAR DA SILVA BARCELLOS.
**************************************
* MANUTENCAO DO CADASTRO DE NOTAS *
**************************************
*----------------------------------------------------------------
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT CADNOTA1 ASSIGN TO DISK
ORGANIZATION IS INDEXED
ACCESS MODE IS DYNAMIC
RECORD KEY IS MATRICULA
FILE STATUS IS ST-ERRO
ALTERNATE RECORD KEY IS NOME WITH DUPLICATES.
*
*-----------------------------------------------------------------
DATA DIVISION.
FILE SECTION.
FD CADNOTA1
LABEL RECORD IS STANDARD
VALUE OF FILE-ID IS "CADNOTA1.DAT".
01 REGNOTA.
03 MATRICULA PIC 9(06).
03 NOME PIC X(30).
03 NOTA1 PIC 9(02)V9.
03 NOTA2 PIC 9(02)V9.
03 FALTA1 PIC 9(02).
03 FALTA2 PIC 9(02).
*
*-----------------------------------------------------------------
WORKING-STORAGE SECTION.
01 MASC1 PIC Z9,9.
01 MASC2 PIC Z9,9.
01 MASC3 PIC Z9,9.
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.
01 MEDIA PIC 9(02)V9 VALUE ZEROS.
01 SOMA PIC 9(02) VALUE ZEROS.
*-----------------------------------------------------------------
PROCEDURE DIVISION.
INICIO.
*
INC-OP0.
OPEN I-O CADNOTA1
IF ST-ERRO NOT = "00"
IF ST-ERRO = "30"
OPEN OUTPUT CADNOTA1
CLOSE CADNOTA1
MOVE "* ARQUIVO CADNOTA1 SENDO CRIADO *"
TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-OP0
ELSE
MOVE "ERRO NA ABERTURA DO ARQUIVO CADNOTA1"
TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM
ELSE
NEXT SENTENCE.
INC-001.
MOVE ZEROS TO MATRICULA NOTA1 NOTA2 FALTA1
FALTA2
MOVE SPACES TO NOME.
DISPLAY (01, 01) ERASE.
DISPLAY (01, 20) "CADASTRO DE NOTAS"
DISPLAY (04, 01) "MATRICULA : "
DISPLAY (05, 01) "NOME : "
DISPLAY (06, 01) "NOTA1 : "
DISPLAY (07, 01) "NOTA2 : "
DISPLAY (08, 01) "MEDIA : "
DISPLAY (09, 01) "FALTA1 : "
DISPLAY (10, 01) "FALTA2 : "
DISPLAY (11, 01) "TOTAL FALTAS : ".
INC-002.
ACCEPT (04, 16) MATRICULA
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02
CLOSE CADNOTA1
GO TO ROT-FIM.
IF MATRICULA = 0
MOVE "*** MATRICULA INVALIDA ***" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-002.
LER-CADNOTA01.
MOVE 0 TO W-SEL
READ CADNOTA1
IF ST-ERRO NOT = "23"
IF ST-ERRO = "00"
DISPLAY (05, 16) NOME
MOVE NOTA1 TO MASC1
DISPLAY (06, 16) MASC1
MOVE NOTA2 TO MASC2
DISPLAY (07, 16) MASC2
COMPUTE MEDIA = ( NOTA1 + NOTA2 ) / 2
MOVE MEDIA TO MASC3
DISPLAY (08, 16) MASC3
DISPLAY (09, 16) FALTA1
DISPLAY (10, 16) FALTA2
COMPUTE SOMA = FALTA1 + FALTA2
DISPLAY (11, 16) SOMA
MOVE "*** NOTAS JA CADASTRADAS ***" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
MOVE 1 TO W-SEL
GO TO ACE-001
ELSE
MOVE "ERRO NA LEITURA DO ARQUIVO CADNOTA1" TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO ROT-FIM
ELSE
NEXT SENTENCE.
INC-003.
ACCEPT (05, 16) NOME
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-002.
INC-004.
ACCEPT (06, 16) NOTA1
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-003.
MOVE NOTA1 TO MASC1
DISPLAY (06, 16) MASC1.
INC-005.
ACCEPT (07, 16) NOTA2
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-004.
MOVE NOTA2 TO MASC2
DISPLAY (07, 16) MASC2
COMPUTE MEDIA = (NOTA1 + NOTA2) /2
MOVE MEDIA TO MASC3
DISPLAY (08, 16) MASC3.
INC-006.
ACCEPT (09, 16) FALTA1
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-005.
INC-007.
ACCEPT (10, 16) FALTA2
ACCEPT W-ACT FROM ESCAPE KEY
IF W-ACT = 02 GO TO INC-006.
COMPUTE SOMA = FALTA1 + FALTA2
DISPLAY (11, 16) SOMA
*
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-007.
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 REGNOTA
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 "*** NOTAS JA EXISTEM *** " TO MENS
PERFORM ROT-MENS THRU ROT-MENS-FIM
GO TO INC-001
ELSE
MOVE "ERRO NA GRAVACAO DO ARQUIVO DE NOTAS"
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 CADNOTA1 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 REGNOTA
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.