000010*$CALL
000020 IDENTIFICATION DIVISION.
000030* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
000040* ³COPYRIGHT (C) ADVIESBUREAU WOUTERSON ³
000050* ³GEGENEREERD OP 28-09-01 09:13:09 ³
000060* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
000070 PROGRAM-ID. work .
000080 ENVIRONMENT DIVISION.
000090 CONFIGURATION SECTION.
000100 SOURCE-COMPUTER. IBM-PC.
000110 OBJECT-COMPUTER. IBM-PC.
000120 SPECIAL-NAMES.
000130 DECIMAL-POINT IS COMMA.
000140 INPUT-OUTPUT SECTION.
000150 FILE-CONTROL.
000160 SELECT FI01
000170 ASSIGN '@FI01.#'
000180 ORGANIZATION INDEXED
000190 RECORD FI01-KEY-AREA
000200 ALTERNATE RECORD FI01-ALTKEY-AREA DUPLICATES
000210 ACCESS DYNAMIC
000220 STATUS FI01-STATUS.
000230 DATA DIVISION.
000240 FILE SECTION.
000250 FD FI01
000260 LABEL RECORD IS STANDARD.
000270 01 FI01-RECORD.
000280 02 FI01-KEY-AREA.
000290 03 FI01-RU001 PIC X(05).
000300 02 FI01-ALTKEY-AREA.
000310 03 FI01-RU002 PIC X(04).
000320 02 FI01-NOKEY-AREA.
000330 03 FI01-RU003 PIC X(19).
000340 WORKING-STORAGE SECTION.
000350 01 FI01-STATUS.
000360 03 FI01-STATUS-X1 PIC X.
000370 03 FI01-STATUS-X2 PIC X.
000380 01 WS01-RECORD.
000390 02 WS01-KEY-AREA.
000400 03 WS01-RU001 PIC X(05).
000410 02 WS01-ALTKEY-AREA.
000420 03 WS01-RU002 PIC X(04).
000430 02 WS01-NOKEY-AREA.
000440 03 WS01-RU003 PIC X(19).
000450 01 WS01-RECORD-OUD.
000460 02 WS01-KEY-AREA-OUD.
000470 03 WS01-RU001-OUD PIC X(05).
000480 02 WS01-ALTKEY-AREA-OUD.
000490 03 WS01-RU002-OUD PIC X(04).
000500 02 WS01-NOKEY-AREA-OUD.
000510 03 WS01-RU003-OUD PIC X(19).
000520 01 SC01-SCHERMNAAM.
000530 02 SC01-01 VALUE
000540 '@@@@@ @@@@ @@@@@@@@@@@@@@@@@@@
000550- ' '.
000560 03 SC01-RU001 PIC X(05).
000570 03 FILLER PIC X(01).
000580 03 SC01-RU002 PIC X(04).
000590 03 FILLER PIC X(01).
000600 03 SC01-RU003 PIC X(19).
000610 03 FILLER PIC X(50).
000620 01 TAB01-VAN-RUBRIEKEN.
000630 02 SUB01-RUBRIEK PIC S9(4) COMP-5 VALUE +1.
000640 02 EXIT01-TERMINATOR PIC S9(4) COMP-5 VALUE ZERO.
000650 02 FILLER.
000660* R=REGELNR, K=KOLOM, L=LENGTE, T=TYPE RRKKLLT
000670 03 INFO01-RUBRIEK-001 PIC X(7) VALUE '010105X'.
000680 03 INFO01-RUBRIEK-002 PIC X(7) VALUE '010704X'.
000690 03 INFO01-RUBRIEK-003 PIC X(7) VALUE '011219X'.
000700* R=REGELNR, K=KOLOM, L=LENGTE, T=TYPE RRKKLLT
000710 03 INFO01-RUBRIEK-999 PIC X(7) VALUE '000000*'.
000720*01 FILLER REDEFINES TAB01-VAN-RUBRIEKEN.
000730* 03 FILLER PIC X(4).
000740* 03 INFORUB01 OCCURS 003.
000750* 05 RUB01-REGEL PIC 99.
000760* 05 RUB01-KOLOM PIC 99.
000770* 05 RUB01-LENGTE PIC 99.
000780* 05 RUB01-TYPE PIC X.
000790 PROCEDURE DIVISION.
000800 DECLARATIVES.
000810 DECL01-SECTION SECTION.
000820 USE AFTER STANDARD ERROR PROCEDURE ON FI01.
000830 DECL01.
000840 IF FI01-STATUS-X1 = '9' AND
000850 FI01-STATUS-X2 NOT = '2'
000860 PERFORM DISPLAY-ERROR-FI01
000870 STOP RUN
000880 END-IF.
000890 END DECLARATIVES.
000900 MAIN SECTION.
000910 MAI-00.
000920* CALL 'USR_PUSH_SCREEN'.
000930 CALL 'USR_HIGH' USING SC01-SCHERMNAAM
000940 TAB01-VAN-RUBRIEKEN.
000950 PERFORM DISPLAY-SCREEN-01.
000960* CALL 'USR_POP_SCREEN'.
000970 MAI-99.
000980 GOBACK.
000990 DISPLAY-SCREEN-01 SECTION.
001000 DIS01-01.
001010 PERFORM OPEN-FI01.
001020 MOVE SPACE TO WS01-RECORD.
001030 MOVE SPACE TO WS01-RECORD-OUD.
001040 PERFORM VUL-SC01-VANUIT-WS01.
001050 MOVE +1 TO SUB01-RUBRIEK.
001060 MOVE ZERO TO EXIT01-TERMINATOR.
001070* ESCAPE, PAGE-UP, PAGE-DOWN, CTRL-BACKSPACE OR ENTER
001080 PERFORM UNTIL EXIT01-TERMINATOR = 27 OR 73 OR 81 OR 127 OR 13
001090 CALL 'USR_SCHERMIO' USING SC01-SCHERMNAAM
001100 TAB01-VAN-RUBRIEKEN
001110 END-PERFORM.
001120 PERFORM UNTIL EXIT01-TERMINATOR = 27
001130 AND WS01-RECORD = SPACE
001140 AND WS01-RECORD-OUD = SPACE
001150 PERFORM VUL-WS01-VANUIT-SC01
001160 PERFORM VUL-FI01-VANUIT-WS01
001170 IF WS01-RECORD NOT = WS01-RECORD-OUD
001180 IF WS01-KEY-AREA NOT = SPACE
001190 IF WS01-KEY-AREA NOT = WS01-KEY-AREA-OUD
001200 IF WS01-NOKEY-AREA = SPACE OR
001210 WS01-NOKEY-AREA = WS01-NOKEY-AREA-OUD
001220 PERFORM GU01
001230 ELSE
001240 PERFORM ISRT01
001250 END-IF
001260 ELSE
001270 PERFORM REPL01
001280 END-IF
001290 END-IF
001300 END-IF
001310* *** PG UP ***
001320 IF EXIT01-TERMINATOR = 73
001330 PERFORM PRIOR01
001340 ELSE
001350* *** PG DOWN ***
001360 IF EXIT01-TERMINATOR = 81
001370 PERFORM GN01
001380 ELSE
001390* *** CTRL BACKSPACE ***
001400 IF EXIT01-TERMINATOR = 127
001410 PERFORM DLET01
001420 ELSE
001430* *** ENTER ***
001440 IF EXIT01-TERMINATOR = 13
001450 PERFORM VERWERK01
001460 ELSE
001470* *** ESCAPE LEVEL 1 ***
001480 IF EXIT01-TERMINATOR = 27
001490 MOVE SPACE TO WS01-RECORD
001500 END-IF
001510 END-IF
001520 END-IF
001530 END-IF
001540 END-IF
001550 PERFORM VUL-SC01-VANUIT-WS01
001560 MOVE WS01-RECORD TO WS01-RECORD-OUD
001570 MOVE ZERO TO EXIT01-TERMINATOR
001580 PERFORM UNTIL EXIT01-TERMINATOR = 27 OR 73 OR
001590 81 OR 13 OR 127
001600 CALL 'USR_SCHERMIO' USING SC01-SCHERMNAAM
001610 TAB01-VAN-RUBRIEKEN
001620 END-PERFORM
001630 END-PERFORM.
001640 CALL 'USR_CLS'.
001650 DIS01-99.
001660 EXIT.
001670 OPEN-FI01 SECTION.
001680 OPEN I-O FI01.
001690 IF FI01-STATUS IS NOT EQUAL TO ZERO
001700 OPEN OUTPUT FI01
001710 PERFORM CHECK-STATUS-FI01
001720 CLOSE FI01
001730 PERFORM CHECK-STATUS-FI01
001740 OPEN I-O FI01
001750 PERFORM CHECK-STATUS-FI01
001760 END-IF.
001770 CHECK-STATUS-FI01 SECTION.
001780 IF FI01-STATUS NOT = ZERO
001790 PERFORM DISPLAY-ERROR-FI01
001800 STOP RUN.
001810 DLET01 SECTION.
001820 DELETE FI01 RECORD.
001830 IF FI01-STATUS = ZERO
001840 MOVE SPACE TO WS01-RECORD.
001850 GN01 SECTION.
001860 IF FI01-STATUS = ZERO
001870 READ FI01 NEXT
001880 ELSE
001890 START FI01 KEY NOT < FI01-KEY-AREA
001900 IF FI01-STATUS = ZERO
001910 READ FI01 NEXT.
001920 IF FI01-STATUS = ZERO
001930 PERFORM VUL-WS01-VANUIT-FI01
001940 ELSE
001950 MOVE SPACE TO WS01-RECORD.
001960 GU01 SECTION.
001970 READ FI01 KEY FI01-KEY-AREA.
001980 IF FI01-STATUS NOT = ZERO
001990 MOVE SPACE TO WS01-ALTKEY-AREA
002000 WS01-NOKEY-AREA
002010 PERFORM GN01
002020 ELSE
002030 PERFORM VUL-WS01-VANUIT-FI01.
002040 ISRT01 SECTION.
002050 WRITE FI01-RECORD.
002060 IF FI01-STATUS = 22
002070 PERFORM REPL01
002080 END-IF.
002090 PRIOR01 SECTION.
002100 IF FI01-STATUS = ZERO
002110 READ FI01 PRIOR
002120 ELSE
002130 START FI01 KEY NOT < FI01-KEY-AREA
002140 IF FI01-STATUS = ZERO
002150 PERFORM UNTIL FI01-STATUS NOT = ZERO OR
002160 FI01-KEY-AREA < WS01-KEY-AREA
002170 READ FI01 PRIOR
002180 END-PERFORM.
002190 IF FI01-STATUS = ZERO
002200 PERFORM VUL-WS01-VANUIT-FI01
002210 ELSE
002220 MOVE SPACE TO WS01-RECORD.
002230 REPL01 SECTION. REWRITE FI01-RECORD.
002240 VERWERK01 SECTION.
002250 VUL-SC01-VANUIT-FI01 SECTION.
002260 MOVE FI01-RU001 TO SC01-RU001.
002270 MOVE FI01-RU002 TO SC01-RU002.
002280 MOVE FI01-RU003 TO SC01-RU003.
002290 VUL-SC01-VANUIT-WS01 SECTION.
002300 MOVE WS01-RU001 TO SC01-RU001.
002310 MOVE WS01-RU002 TO SC01-RU002.
002320 MOVE WS01-RU003 TO SC01-RU003.
002330 VUL-WS01-VANUIT-SC01 SECTION.
002340 MOVE SC01-RU001 TO WS01-RU001.
002350 MOVE SC01-RU002 TO WS01-RU002.
002360 MOVE SC01-RU003 TO WS01-RU003.
002370 VUL-WS01-VANUIT-FI01 SECTION.
002380 MOVE FI01-RECORD TO WS01-RECORD.
002390 VUL-FI01-VANUIT-SC01 SECTION.
002400 MOVE SC01-RU001 TO FI01-RU001.
002410 MOVE SC01-RU002 TO FI01-RU002.
002420 MOVE SC01-RU003 TO FI01-RU003.
002430 VUL-FI01-VANUIT-WS01 SECTION.
002440 MOVE WS01-RECORD TO FI01-RECORD.
002450 DISPLAY-ERROR-FI01 SECTION.
002460 DISPLAY 'FILE ERROR ON @FI01.# '.
002470 EXHIBIT NAMED FI01-STATUS.
[\CODE]