000010 IDENTIFICATION DIVISION. 000020 PROGRAM-ID. RANDOM. 000030 AUTHOR. UPDATE KURT PIEPER. 000040 ENVIRONMENT DIVISION. 000050 CONFIGURATION SECTION. 000060 SOURCE-COMPUTER. 24A-RC2014. 000070 OBJECT-COMPUTER. 24A-RC2014. 000080 INPUT-OUTPUT SECTION. 000100 FILE-CONTROL. SELECT FILE1 ASSIGN DISK ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RELATIVE KEY IS NUM. SELECT FILE2 ASSIGN DISK ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RELATIVE KEY IS NUM. 000140 DATA DIVISION. 000150 FILE SECTION. 000160 FD FILE1 LABEL RECORD ARE STANDARD VALUE OF FILE-ID IS FILNAM. 000200 01 BUF. 02 NUM PIC XXXX. 02 BEZ PIC X(15). 02 MWST PIC X. 02 SOLL PIC 9(6)V99. 02 HABEN PIC 9(6)V99. 02 SALDO PIC 9(6)V99. 02 BIGUV PIC X. 02 APSH PIC X. 02 SV PIC 9(6)V99. 02 PLAN PIC 9(6)V99. 02 BWA PIC XX. 000210 WORKING-STORAGE SECTION. * LINKAGE SECTION. 000230 01 AUSGABE. 02 A-NUM PIC XXXX. 02 FILLER PIC XXX. 02 A-BEZ PIC X(15). 02 FILLER PIC XXX. 02 A-MWST PIC X. 02 FILLER PIC XXX. 02 A-SOLL PIC ZZZZ9.99. 02 FILLER PIC XXX. 02 A-HABEN PIC ZZZZ9.99. 02 FILLER PIC XXX. 02 A-SALDO PIC ZZZZ9.99. 02 FILLER PIC XXX. 02 A-BIGUV PIC X. 02 FILLER PIC XXX. 02 A-APSH PIC X. 02 FILLER PIC XXX. 02 A-SV PIC ZZZZ9.99. 02 FILLER PIC XXX. * 02 A-PLAN PIC ZZZZ9.99. * 02 FILLER PIC XXX. * 02 A-BWA PIC XX. * 02 FILLER PIC XXX. 000250 01 FILNAM PIC X(14) VALUE "SACHKTO.DBA". 01 VERSNAM PIC X(14) VALUE SPACES. 01 VERGLEICHS-NAME PIC X(14) VALUE SPACES. 01 KOPFZEILE PIC X(79) VALUE ALL "-". 01 DATUM PIC XXXXXXXX VALUE "26.01.22". 01 TASTE PIC X. 01 LEER PIC X(25) VALUE SPACES. 01 LEERKP PIC X(20) VALUE SPACES. 01 ZEILEN-ZAHL PIC 999 VALUE 000. 01 LFDNR PIC 9999 VALUE 0000. 01 PTR PIC 99. 01 ZEILE PIC X(75). 01 SUMSOLL PIC 9(6)V99. 01 SUMHABEN PIC 9(6)V99. 01 SUMSALDO PIC 9(6)V99. 01 BUCH REDEFINES TASTE. 02 BUCHSTABE PIC 9 USAGE COMP. 01 ADRESSE. 02 ADR-ZEILE PIC X(20) OCCURS 12 TIMES. 000270 SCREEN SECTION. 01 ADR-ERFASSEN. 02 BLANK SCREEN. 02 LINE 3 COLUMN 8 VALUE "Sachkonten-Nr:". 02 LINE 6 COLUMN 8 VALUE "Bezeichnung :". 02 LINE 8 COLUMN 8 VALUE "Steuer-Nr. :". 02 LINE 10 COLUMN 8 VALUE "Soll :". 02 LINE 11 COLUMN 8 VALUE "Haben :". 02 LINE 13 COLUMN 8 VALUE "Saldo :". 02 LINE 15 COLUMN 8 VALUE "Bilanz/GuV :". 02 LINE 16 COLUMN 8 VALUE "A/P S/H :". 02 LINE 18 COLUMN 8 VALUE "SV Akt./Pas. :". 02 LINE 19 COLUMN 8 VALUE "Planung :". 02 LINE 20 COLUMN 8 VALUE "BWG Gruppe :". 02 LINE 22 COLUMN 8 VALUE "J/N/E)XIT :". 000300 PROCEDURE DIVISION. 000310 DIALOG SECTION. 000320 MASKE. DISPLAY (1, 1) ERASE. DISPLAY KOPFZEILE. DISPLAY LEERKP "F i b u Stammdaten ISAM - DAT " DATUM. DISPLAY KOPFZEILE. DISPLAY SPACES. DISPLAY LEER "Bearbeitet ---> " FILNAM. DISPLAY SPACES. * DISPLAY LEER "D : Datum eingeben ". DISPLAY LEER "1 Sachkonto erfassen ". DISPLAY SPACES. DISPLAY LEER "2 Sachkonto Korrektur ". DISPLAY SPACES. DISPLAY LEER "3 Sachkonto entfernen ". DISPLAY SPACES. DISPLAY LEER "4 Sachkonto Liste ". DISPLAY SPACES. * DISPLAY LEER "5 Sachkonto Salden ". DISPLAY LEER "6 Sachkonto Rebuild ". * DISPLAY LEER "7 Informationsystem ". DISPLAY SPACES. DISPLAY LEER "@ Neue Datei anlegen ". DISPLAY SPACES. DISPLAY LEER "0 oder # : Ende ". 000330 NO-ENTRY. DISPLAY (22, 25) "---> Bitte Funktion waehlen ". ACCEPT TASTE. * IF TASTE = "D" OR = "d" PERFORM DATUM-EIN GO TO MASKE. IF TASTE = "1" OR = "e" PERFORM SCHREIBEN GO TO MASKE. IF TASTE = "2" OR = "k" PERFORM AENDERN GO TO MASKE. IF TASTE = "3" OR = "z" PERFORM LOESCHEN GO TO MASKE. IF TASTE = "4" OR = "l" PERFORM LESEN GO TO MASKE. IF TASTE = "5" OR = "k" PERFORM AENDERN GO TO MASKE. IF TASTE = "6" OR = "r" PERFORM LADEN GO TO MASKE. IF TASTE = "7" OR = "n" PERFORM DNAM-HOL GO TO MASKE. IF TASTE = "@" PERFORM NEUANLAGE GO TO MASKE. IF TASTE = "0" OR = "#" GO TO ENDE. GO TO NO-ENTRY. ENDE. 000400 DISPLAY (1, 1) ERASE. * DISPLAY "--> Lade MENU.COM". CHAIN "KPSTART.COM". STOP RUN. 000450 LADEN. DISPLAY (1, 1) ERASE. CHAIN "REBUILD.COM". STOP RUN. 000500 DATUM-EIN. MOVE SPACES TO DATUM. DISPLAY (1, 1) ERASE. DISPLAY "Bitte Datum eingeben (TT.MM.JJ) ". DISPLAY (1, 33) ERASE. ACCEPT DATUM. 000550 SCHIEBEN. * hier wird auch die lfd. Satz-Nummer angezeigt MOVE SPACES TO AUSGABE. MOVE NUM TO A-NUM. MOVE BEZ TO A-BEZ. MOVE MWST TO A-MWST. MOVE SOLL TO A-SOLL. MOVE HABEN TO A-HABEN. * COMPUTE SALDO = SOLL - HABEN. MOVE SALDO TO A-SALDO. MOVE BIGUV TO A-BIGUV. MOVE APSH TO A-APSH. MOVE SV TO A-SV. * MOVE PLAN TO A-PLAN. * MOVE BWA TO A-BWA. NEUANLAGE SECTION. N1. DISPLAY (2, 20) "******* NEUANLAGE EINER DATEI *******". PERFORM DNAM-HOL. DISPLAY (15, 1) ERASE. DISPLAY "Wenn" LEER FILNAM. DISPLAY "neu eroeffnet wird, gehen evtl. vorhanden". DISPLAY "Daten verloren !!!". DISPLAY SPACES. DISPLAY "SOLL DIES GESCHEHEN (J / N) ". MOVE SPACES TO VERSNAM. ACCEPT VERSNAM. * Achtung - keine Anlage IF VERSNAM = "J" OR = "j" GO TO N9. * OPEN OUTPUT FILE1 * CLOSE FILE1. N9. DNAM-HOL SECTION. DNH1. DISPLAY (7, 1) ERASE. DISPLAY "NEUEN NAMEN OHNE LAUFWERK IN DER FORM ". DISPLAY (10, 9) "< NAME >.TYP". DISPLAY SPACES. DISPLAY "EINGEBEN. = OHNE AENDERUNG". MOVE SPACES TO VERSNAM. ACCEPT (10, 10) VERSNAM. IF VERSNAM NOT = SPACES MOVE VERSNAM TO FILNAM. DNAM-HOL-ENDE. 000600 SCHREIBEN SECTION. SCHR1. DISPLAY (2, 22) " S C H R E I B E N ". IF FILNAM = SPACES PERFORM DNAM-HOL. OPEN I-O FILE1. SCHR2. * DISPLAY (7, 1) ERASE. ADRESSE-HOLEN. DISPLAY ADR-ERFASSEN. * ACCEPT ( 3, 35) ADR-ZEILE (1). * MOVE ADR-ZEILE(1) TO NUM. * GEHT NICHT, DIREKT AUS BUF ANWENDEN! ACCEPT (3, 35) NUM. ACCEPT (6, 35) BEZ. ACCEPT (8, 35) MWST. ACCEPT (10, 35) SOLL. ACCEPT (11, 35) HABEN. ACCEPT (13, 35) SALDO. ACCEPT (15, 35) BIGUV. ACCEPT (16, 35) APSH. ACCEPT (18, 35) SV. ACCEPT (19, 35) PLAN. ACCEPT (20, 35) BWA. ACCEPT (22, 35) ADR-ZEILE (12). PERFORM KLEIN-TEST. IF TASTE ="N" GO TO SCHR9. WRITE BUF INVALID KEY DISPLAY "F E H L E R ?????" ACCEPT VERSNAM. GO TO SCHR9. SCHR9. CLOSE FILE1. SCHR-ENDE. KLEIN-TEST. IF BUCHSTABE > 90 SUBTRACT 32 FROM BUCHSTABE. * muss noch wie SCHREIBEN SECTION geaendert werden !! 000600 ALTSCHREIBEN SECTION. ASCHR1. DISPLAY (2, 22) " S C H R E I B E N ". IF FILNAM = SPACES PERFORM DNAM-HOL. OPEN I-O FILE1. ASCHR2. DISPLAY "Sachkonto Nr. eingeben (4-stellig) 0000=ENDE". ACCEPT NUM. IF NUM = 0000 GO TO ASCHR9. ASCHR3. DISPLAY "Bezeichnung ". ACCEPT BEZ. DISPLAY "Steuer Kz ". ACCEPT MWST. DISPLAY "Soll ". ACCEPT SOLL. DISPLAY "Haben ". ACCEPT HABEN. DISPLAY "Saldo ?". ACCEPT SALDO. DISPLAY "B/G ". ACCEPT BIGUV. DISPLAY "A/P S/H " ACCEPT APSH. COMPUTE SALDO = SOLL - HABEN. DISPLAY "SV ? ". ACCEPT SV. DISPLAY "Planung " ACCEPT PLAN DISPLAY "BWA Kz " ACCEPT BWA. DISPLAY "Alle Eingaben richtig ?? J/N". ACCEPT VERSNAM. ASCHR4. IF VERSNAM NOT = "J" AND NOT = "j" GO TO ASCHR2. WRITE BUF INVALID KEY DISPLAY "F E H L E R ?????" ACCEPT VERSNAM. GO TO ASCHR2. ASCHR9. CLOSE FILE1. ASCHR-ENDE. * IN ARBEIT 000700 LOESCHEN. * CLOSE FILE1. ZU8. ZUGANG-ENDE. * IN ARBEIT 000750 SUCHEN SECTION. SU1. DISPLAY (7, 1) ERASE. DISPLAY "WER WIRD GESUCHT ? ". * ACCEPT VERGLEICHS-NAME. DISPLAY (9, 1) ERASE. * DISPLAY " FOLGENDE GEFUNDEN SIND GESPEICHRT UNTER: " * VERGLEICHS-NAME. DISPLAY SPACES. MOVE "0001" TO NUM. MOVE ZEROES TO PTR. OPEN INPUT FILE1. SU2. * IF NAME=VERGLEICHS-NAME * ACCEPT VERSNAM * GO TO SU8. GO TO SU3. GO TO SU8. 000780 SU3. START FILE1 KEY IS EQUAL NUM INVALID KEY DISPLAY "NUMMERN-FEHLER " ACCEPT VERSNAM GO TO SU8. SU5. ADD 1 TO PTR. READ FILE1 NEXT RECORD AT END DISPLAY "DAS WARS -----> CR " ACCEPT VERSNAM GO TO SU8. PERFORM SCHIEBEN. DISPLAY AUSGABE. GO TO SU2. * DISPLAY "WEITER " * ACCEPT VERSNAM. SU8. CLOSE FILE1. SU-EX. 000800 LESEN SECTION. LS. IF FILNAM = SPACES PERFORM DNAM-HOL. DISPLAY (2, 1) ERASE. DISPLAY "Konto Bezeichnung MWST SOLL HABEN". DISPLAY (2, 55) "SALDO B/G S/H SV". DISPLAY SPACES. DISPLAY KOPFZEILE. OPEN INPUT FILE1. MOVE "0001" TO NUM. MOVE ZEROES TO PTR. START FILE1 KEY IS EQUAL NUM INVALID KEY DISPLAY "NUMERN-FEHLER " ACCEPT VERSNAM GO TO L8. * MOVE ZEROES TO NUM. L2. DISPLAY (4, 1) ERASE. L3. ADD 1 TO PTR. * FUNKTIONIERT NICHT !!!! * ADD SOLL TO SUMSOLL. * ADD HABEN TO SUMHABEN. * MOVE SUMSOLL TO SUMSALDO. * SUBTRACT SUMHABEN FROM SUMSALDO. READ FILE1 NEXT RECORD AT END GO TO L8. * READ FILE1 NEXT RECORD * AT END DISPLAY " ENDE ----> CR" * ACCEPT VERSNAM * GO TO L8. * DISPLAY BUF. PERFORM SCHIEBEN. DISPLAY AUSGABE. L7. IF PTR < 018 GO TO L3. MOVE 0000 TO PTR. * IN ARBEIT Summen * DISPLAY (20, 30) A-SOLL * DISPLAY (20, 38) A-HABEN. * DISPLAY (20, 46) A-SALDO. DISPLAY " fuer weitere Zeilen ". ACCEPT VERSNAM. GO TO L2. L8. CLOSE FILE1. * IN ARBEIT Summen , letzte Zeile der Anzeige DISPLAY (20, 30) A-SOLL. DISPLAY (20, 38) A-HABEN. DISPLAY (20, 46) A-SALDO. DISPLAY " ENDE ----> CR " ACCEPT VERSNAM. LESEN-ENDE. 000900 AENDERN SECTION. AE0. OPEN I-O FILE1. * GO TO AE8. * hier Sprung ans Ende, wenn neues Prg vorhanden ist AE1. DISPLAY (2, 20) " A E N D E R N DER EINTRAEGE ". AE2. DISPLAY (4, 1) ERASE. DISPLAY "Welches Konto soll geaendert werden ! (0001-9999)". DISPLAY "0000 = ENDE". ACCEPT NUM. IF NUM = ZEROES GO TO AE8. AE3. READ FILE1 INVALID KEY DISPLAY "FEHLER (evtl nicht vorhanden?)" ACCEPT VERSNAM GO TO AE2. PERFORM SCHIEBEN. DISPLAY AUSGABE. DISPLAY "Diesen Satz aendern ? (J / N)". DISPLAY " = LESEN". ACCEPT VERSNAM. IF VERSNAM = "J" OR = "j" NEXT SENTENCE ELSE IF VERSNAM = "?" CLOSE FILE1 PERFORM LESEN GO TO AE0 ELSE GO TO AE2. AE4. DISPLAY "Neuen Satz eingeben". PERFORM ASCHR3. * hier ADRESSE-HOLEN IF VERSNAM NOT = "J" AND NOT = "j" GO TO AE2. REWRITE BUF INVALID KEY DISPLAY "SCHREIBFEHLER" ACCEPT VERSNAM. GO TO AE2. AE8. CLOSE FILE1. AE-EX.