167 lines
7.1 KiB
COBOL
167 lines
7.1 KiB
COBOL
Identification Division.
|
|
PROGRAM-ID. ANLSTE.
|
|
AUTHOR. U. KRECKEL.
|
|
|
|
Environment Division.
|
|
CONFIGURATION SECTION.
|
|
* SOURCE-COMPUTER. IBM-PC.
|
|
* OBJECT-COMPUTER. IBM-PC.
|
|
SPECIAL-NAMES.
|
|
DECIMAL-POINT IS COMMA.
|
|
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
* next statement has two probs:
|
|
* PARM-PARAMETER
|
|
* and the "," which causes the loop
|
|
* SELECT STEUER ASSIGN TO PARM-PARAMETER,
|
|
* ORGANIZATION IS INDEXED,
|
|
* ACCESS MODE IS DYNAMIC,
|
|
* RECORD KEY IS STEUER-INDEX,
|
|
* FILE STATUS IS FILE-STATUS.
|
|
SELECT STEUER ASSIGN TO "PARM.dat"
|
|
ORGANIZATION IS INDEXED
|
|
ACCESS MODE IS DYNAMIC
|
|
RECORD KEY IS STEUER-INDEX
|
|
FILE STATUS IS FILE-STATUS.
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD STEUER
|
|
LABEL RECORD IS OMITTED
|
|
.
|
|
* DATA RECORD IS STEUER-SATZ.
|
|
01 STEUER-SATZ.
|
|
02 STEUER-INDEX PIC X(11).
|
|
02 STEUER-DATEN PIC X(89).
|
|
WORKING-STORAGE SECTION.
|
|
01 DATUM-JJMMTT.
|
|
03 DATUM-JJ PIC 99.
|
|
03 DATUM-MM PIC 99.
|
|
03 DATUM-TT PIC 99.
|
|
01 XXXXX-TTMMJJ.
|
|
03 XXXXX-TT PIC 99.
|
|
03 XXXXX-MM PIC 99.
|
|
03 XXXXX-JJ PIC 99.
|
|
01 PARM-PARAMETER PIC X(20) VALUE "STEUER.DAT".
|
|
01 LIB-NAME PIC X(63) VALUE SPACES.
|
|
01 FILE-STATUS PIC XX.
|
|
01 RETURN-LIB PIC 9.
|
|
* 77 RETURN-LIB PIC 9.
|
|
01 AKT-ZEIT PIC 9(8).
|
|
* 77 AKT-ZEIT PIC 9(8).
|
|
01 MM-OPEN PIC 9 VALUE 0.
|
|
* 77 MM-OPEN PIC 9 VALUE 0.
|
|
01 C-MASKEN.
|
|
05 C-010 PIC X(3) VALUE "010".
|
|
05 C-MASKEN-LIB PIC X(8) VALUE "MASKEN".
|
|
05 ST-DATEI-NAME PIC X(63) VALUE "MASKEN".
|
|
05 ST-DATEI-KZ-AUKT PIC X VALUE "N".
|
|
05 ST-DATEI-KZ-DELETE PIC X VALUE "N".
|
|
05 ST-DATEI-ANZ-SAETZE PIC 9(7) VALUE 9999999.
|
|
05 ST-DATEI-FILLER PIC X(17) VALUE " ".
|
|
01 C-AUKTION.
|
|
05 C-010A PIC X(3) VALUE "010".
|
|
05 C-MASKEN-LIB1 PIC X(8) VALUE "AUKTION".
|
|
05 ST-DATEI-NAME1 PIC X(63) VALUE "AUKTION.DAT".
|
|
05 ST-DATEI-KZ-AUKT1 PIC X VALUE "N".
|
|
05 ST-DATEI-KZ-DELETE1 PIC X VALUE "N".
|
|
05 ST-DATEI-ANZ-SAETZE1 PIC 9(7) VALUE 9999999.
|
|
05 ST-DATEI-FILLER1 PIC X(17) VALUE " ".
|
|
01 C-AUSWAHL-0000.
|
|
05 FILLER PIC X(3) VALUE "020".
|
|
05 FILLER PIC X(8) VALUE "AUSW0000".
|
|
05 ST-AUSWAHL-INTERN PIC 9(4) VALUE 0.
|
|
05 ST-AUSWAHL-BEZ PIC X(40) VALUE "HAUPTMENUE".
|
|
05 ST-AUSWAHL-MODUL PIC X(8) VALUE " ".
|
|
05 ST-AUSWAHL-FOLGE PIC 9(4) VALUE 0.
|
|
05 ST-AUSWAHL-KZ PIC X(3) VALUE "MEN".
|
|
05 ST-AUSWAHL-HELP PIC X(8) VALUE " ".
|
|
05 ST-AUSWAHL-MASKE PIC X(8) VALUE "MENUE00".
|
|
05 ST-AUSWAHL-FILLER PIC X(14) VALUE " ".
|
|
01 C-AUSWAHL-9001.
|
|
05 FILLER PIC X(3) VALUE "020".
|
|
05 FILLER PIC X(4) VALUE "AUSW".
|
|
05 C-A-9XXX-NR-1 PIC 9(4) VALUE 9001.
|
|
05 C-A-9XXX-NR-2 PIC 9(4) VALUE 9001.
|
|
05 ST-AUSWAHL-BEZ1 PIC X(40) VALUE "UPDATE STE".
|
|
05 ST-AUSWAHL-MODUL1 PIC X(8) VALUE "AUSW9001".
|
|
05 ST-AUSWAHL-FOLGE1 PIC 9(4) VALUE 0.
|
|
05 ST-AUSWAHL-KZ1 PIC X(3) VALUE "PRG".
|
|
05 ST-AUSWAHL-HELP1 PIC X(8) VALUE " ".
|
|
05 ST-AUSWAHL-MASKE1 PIC X(8) VALUE "MENUE00".
|
|
05 ST-AUSWAHL-FILLER1 PIC X(14) VALUE " ".
|
|
01 C-ANWENDER.
|
|
05 C-040 PIC X(3) VALUE "040".
|
|
05 FILLER PIC X(8) VALUE "ANWENDER".
|
|
05 ST-ANWENDER-BEZ PIC X(40) VALUE " ".
|
|
05 ST-ANWENDER-ST-LW PIC X(2) VALUE "C:".
|
|
05 ST-ANWENDER-AUSWAHL PIC 9(4) VALUE 0.
|
|
05 ST-ANWENDER-L-AUKT PIC 9(3) VALUE 0.
|
|
05 ST-ANWENDER-DATEIEN PIC 9(1) VALUE 2.
|
|
05 ST-ANWENDER-FILLER PIC X(39) VALUE " ".
|
|
PROCEDURE DIVISION.
|
|
ANFANG SECTION.
|
|
S-SECTION.
|
|
ACCEPT DATUM-JJMMTT FROM DATE.
|
|
ACCEPT AKT-ZEIT FROM TIME.
|
|
OPEN OUTPUT STEUER.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
WRITE STEUER-SATZ FROM C-MASKEN
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
WRITE STEUER-SATZ FROM C-AUKTION
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
WRITE STEUER-SATZ FROM C-ANWENDER
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-0000
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-9001
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
ADD 1 TO C-A-9XXX-NR-1.
|
|
ADD 1 TO C-A-9XXX-NR-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-9001
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
ADD 1 TO C-A-9XXX-NR-1
|
|
ADD 1 TO C-A-9XXX-NR-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-9001
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
ADD 1 TO C-A-9XXX-NR-1
|
|
ADD 1 TO C-A-9XXX-NR-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-9001
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
ADD 1 TO C-A-9XXX-NR-1
|
|
ADD 1 TO C-A-9XXX-NR-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-9001
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
ADD 1 TO C-A-9XXX-NR-1
|
|
ADD 1 TO C-A-9XXX-NR-2.
|
|
WRITE STEUER-SATZ FROM C-AUSWAHL-9001
|
|
* INVALID GO TO FEHLER-2.
|
|
IF FILE-STATUS NOT = "00" GO TO FEHLER-2.
|
|
CLOSE STEUER.
|
|
STOP RUN.
|
|
FEHLER-1.
|
|
DISPLAY "PARAMETER ANGABEN FEHLEN, ABBRUCH".
|
|
STOP RUN.
|
|
FEHLER-2.
|
|
DISPLAY "STEUERDATEI NICHT EROEFFNET, ABBRUCH.".
|
|
DISPLAY "NAME= " PARM-PARAMETER.
|
|
DISPLAY "STATUS=" FILE-STATUS.
|
|
STOP RUN.
|
|
FEHLER-3.
|
|
DISPLAY "MASKEN-DATEI NICHT EROEFFNET".
|
|
DISPLAY "NAME= " LIB-NAME.
|
|
DISPLAY "STATUS=" RETURN-LIB.
|
|
DISPLAY "ABBRUCH".
|
|
STOP RUN.
|
|
|
|
|