*>----------------------------------------------------+ *> COPYRIGHT(2017,2018) BY VEIT HEISE, PQM-CONSULTING | *> ALL RIGHTS RESERVED BY THE AUTHOR | *> THIS IS RECOMMENDED FOR THE USAGE OF THIS SOFTWARE | *> INSIDE COMMERCIAL PRODUCT. USING FOR COMMERCIAL | *> PRODUCTS WITHOUT PERMISSION BY THE AUTHOR IS | *> LEGALLY PROHIBITTED. | *>----------------------------------------------------+ >>SOURCE FORMAT FIXED IDENTIFICATION DIVISION. PROGRAM-ID. ADRESSE01 INITIAL. *>---------------------------------------------------------------+ *> P R O G R A M - N A M E | *>---------------------------------------------------------------+ *> B101 - INITIALIZE MAIN PROGRAM | *>---------------------------------------------------------------+ *> B102 - INITIALIZE MAIN SUB-PROGRAMS | *>---------------------------------------------------------------+ *> B301 - INITIALIZE LIST WORK-SPACE | *> B302 - INITIALIZE DATA LIST WORK-SPACE | *> B303 - INITIALIZE DATA-LINE LIST WORK-SPACE | *> B304 - INITIALIZE SCREEN-01 HEADER | *> B401 - INITIALIZE DB0001 AND DB0003 | *> B601 - EXCEPTION: SCREEN-01 | *> B801 - EIN-/AUSGABE SCREEN-01 | *>---------------------------------------------------------------+ *> I101 - INITIALIZE HEADER TEMPLATE | *>---------------------------------------------------------------+ ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. HP-PRO-BOOK-650G. OBJECT-COMPUTER. UBUNTU-64-BIT. SPECIAL-NAMES. CURSOR IS COB-CURSOR, CRT STATUS IS COB-CRT-STATUS, DECIMAL-POINT IS COMMA. REPOSITORY. FUNCTION ALL INTRINSIC. INPUT-OUTPUT SECTION. FILE-CONTROL. COPY "sd-files". I-O-CONTROL. DATA DIVISION. FILE SECTION. COPY "fd-files". *>---------------------------------------------------------------+ WORKING-STORAGE SECTION. 01 WS-RECORD. 03 WS-KEY. 05 WS-F003-ID PIC 9(12). *> PRIMARY KEY 03 WS-ALTERNATE-1. 05 WS-F003-SOUNDEX PIC X(20). *> SOUNDEX-SCHLUESSEL 03 WS-F003-STATUS PIC X. *> K=KUNDE,L=LIEFERANT,M=MITARBEITER *> E=EIGENTUEMER,V=VERMIETER 03 WS-F003-FIRMA PIC X(40). *> FIRMEN-NAME (OPTIONAL) 03 WS-F003-TITEL PIC X(40). *> TITEL (OPTIONAL) 03 WS-F003-ANREDE PIC X(40). *> ANREDE (PFLICHT) 03 WS-F003-NACHNAME PIC X(40). *> NACHNAME (PFLICHT) 03 WS-F003-VORNAME PIC X(40). *> VORNAME (PFLICHT) 03 WS-F003-STRASSE PIC X(40). *> STRASSE (PFLICHT) 03 WS-F003-HAUSNR PIC X(6). *> HAUSNUMMER (PFLICHT) 03 WS-F003-LANDKZ PIC X(3). *> LANDES-KENNZEICHEN (PFLICHT) 03 WS-F003-PLZ PIC X(10). *> POSTLEITZAHL (PFLICHT) 03 WS-F003-STADT PIC X(40). *> STADT (PFLICHT) 03 WS-F003-KONTAKT-1 PIC X(40). *> KONTAKT #1 (PFLICHT) 03 WS-F003-KONTAKT-2 PIC X(40). *> KONTAKT #2 (OPTIONAL) 03 WS-F003-TELEFON-1 PIC X(30). *> TELEFON #1 (PFLICHT) 03 WS-F003-TELEFON-2 PIC X(30). *> KONTAKT #2 (OPTIONAL) 03 WS-F003-TELEFAX PIC X(30). *> TELEFAX (OPTIONAL) 03 WS-F003-EMAIL PIC X(60). *> EMAIL (PFLICHT) 03 WS-F003-KUNDE USAGE UNSIGNED-INT. 03 WS-F003-VERMIETER USAGE UNSIGNED-INT. 03 WS-F003-LIEFERANT USAGE UNSIGNED-INT. 03 WS-F003-MITARBEITER USAGE UNSIGNED-INT. *>---------------------------------------------------------------+ 01 WS01. 03 WS01-LINE OCCURS 30 TIMES. 05 WS01-CMD PIC XX. 05 WS01-STATUS PIC X. 05 WS01-ID PIC 9(12). 05 WS01-SOUNDEX PIC X(20). 05 WS01-NAME PIC X(80). *>---------------------------------------------------------------+ 01 WS-SET-READY CONSTANT AS 1. 01 WS-SET-NOT-READY CONSTANT AS 0. 01 WS-SET-OK CONSTANT AS 2. 01 WS-SET-NOT-OK CONSTANT AS 3. 01 WS-SET-BACK-THREAD CONSTANT AS 4. 01 WS-SET-ADD CONSTANT AS 5. 01 WS-SET-DELETE CONSTANT AS 6. 01 WS-SET-EDIT CONSTANT AS 7. 01 WS-SET-BACK CONSTANT AS 8. 01 WS-SET-FORWARD CONSTANT AS 9. 01 WS-SET-EXIT CONSTANT AS 10. *> 77 WS-STATUS PIC 99. 88 WS-IS-READY VALUE 1. 88 WS-IS-NOT-READY VALUE 0. 88 WS-IS-OK VALUE 2. 88 WS-IS-NOT-OK VALUE 3. 88 WS-IS-BACK-THREAD VALUE 4. 88 WS-IS-ADD VALUE 5. 88 WS-IS-DELETE VALUE 6. 88 WS-IS-EDIT VALUE 7. 88 WS-IS-BACK VALUE 8. 88 WS-IS-FORWARD VALUE 9. 88 WS-IS-EXIT VALUE 10. *>---------------------------------------------------------------+ 01 FILE001-STATUS PIC 99. 01 FILE002-STATUS PIC 99. 01 FILE003-STATUS PIC 99. 01 FILE004-STATUS PIC 99. *>---------------------------------------------------------------+ *>---------------------------------------------------------------+ COPY "dat-global". SCREEN SECTION. *>---------------------------------------------------------------+ 01 SCREEN-01 COPY "screen-01". *>---------------------------------------------------------------+ 01 SCREEN-02 COPY "screen-02". *>---------------------------------------------------------------+ *> SCREEN HEADER | *>---------------------------------------------------------------+ 01 SCREEN-HEADER. COPY "scr-standard-header". *>---------------------------------------------------------------+ *> SCREEN STANDARD-ERROR | *>---------------------------------------------------------------+ COPY "xerror". *> PROCEDURE DIVISION. DECLARATIVES. *>---------------------------------------------------------------+ F001-HANDLER SECTION. USE AFTER STANDARD ERROR PROCEDURE ON FILE001. F001-ERROR. IF FILE001-STATUS = 35 THEN OPEN OUTPUT FILE001 MOVE "B0002" TO F001-NAME MOVE 18090003001 TO F001-RECORD-NUMBER WRITE FILE001-RECORD MOVE "B0003" TO F001-NAME MOVE 18080003001 TO F001-RECORD-NUMBER WRITE FILE001-RECORD MOVE "B0004" TO F001-NAME MOVE 18070003001 TO F001-RECORD-NUMBER WRITE FILE001-RECORD CLOSE FILE001 OPEN I-O FILE001 END-IF. *>---------------------------------------------------------------+ F003-HANDLER SECTION. USE AFTER STANDARD ERROR PROCEDURE ON FILE003. F003-ERROR. IF FILE003-STATUS = 35 THEN OPEN OUTPUT FILE003 CLOSE FILE003 OPEN I-O FILE003 END-IF. *>---------------------------------------------------------------+ END DECLARATIVES. *>---------------------------------------------------------------+ *> P R O G R A M M S T A R T E T H I E R | *>---------------------------------------------------------------+ PROGRAM-START. *> B101 - INITIALIZE MAIN PROGRAM PERFORM B101 THRU B101-XXX. *> B801 - EIN-/AUSGABE SCREEN-01 PERFORM B801 THRU B801-XXX. *> B102 - INITIALIZE MAIN SUB-PROGRAMS PROGRAM-EXIT. GOBACK. *>---------------------------------------------------------------+ *> B101 - INITIALIZE MAIN PROGRAM | *>---------------------------------------------------------------+ B101. *> B401 - INITIALIZE DB0001 AND DB0003 PERFORM B401 THRU B401-XXX. *> B301 - INITIALIZE LIST WORK-SPACE PERFORM B301 THRU B301-XXX. *> B302 - INITIALIZE DATA LIST WORK-SPACE PERFORM B302 THRU B302-XXX. *> B304 - INITIALIZE SCREEN-01 HEADER PERFORM B304 THRU B304-XXX. B101-XXX. *>---------------------------------------------------------------+ *> B102 - INITIALIZE MAIN SUB-PROGRAMS | *>---------------------------------------------------------------+ B102. PERFORM WITH TEST BEFORE VARYING ZEILE FROM 1 BY 1 UNTIL ZEILE > 30 MOVE UPPER-CASE(WS01-CMD(ZEILE)) TO WS01-CMD(ZEILE) EVALUATE WS01-CMD(ZEILE) WHEN 'A ' CALL "ADRESSE02" USING DAT-STATUS WHEN OTHER MOVE SPACES TO WS01-CMD(ZEILE) END-EVALUATE END-PERFORM. B102-XXX. *>---------------------------------------------------------------+ *> B301 - INITIALIZE LIST WORK-SPACE | *>---------------------------------------------------------------+ B301. PERFORM WITH TEST BEFORE VARYING ZEILE FROM 1 BY 1 UNTIL ZEILE > 0 MOVE SPACES TO WS01-CMD(ZEILE) MOVE SPACE TO WS01-STATUS(ZEILE) MOVE ZERO TO WS01-ID(ZEILE) MOVE SPACES TO WS01-SOUNDEX(ZEILE) MOVE SPACES TO WS01-NAME(ZEILE) END-PERFORM. B301-XXX. *>---------------------------------------------------------------+ *> B302 - INITIALIZE DATA LIST WORK-SPACE | *>---------------------------------------------------------------+ B302. OPEN INPUT FILE003. MOVE SPACES TO F003-SOUNDEX. START FILE003 KEY >= FILE003-ALTERNATE-1 INVALID KEY GO TO B302-90 END-START. MOVE 1 TO ZEILE. B302-10. READ FILE003 NEXT RECORD AT END GO TO B302-90 END-READ. *> B303 - INITIALIZE DATA-LINE LIST WORK-SPACE PERFORM B303 THRU B303-XXX. B302-90. CLOSE FILE003. B302-XXX. *>---------------------------------------------------------------+ *> B303 - INITIALIZE DATA-LINE LIST WORK-SPACE | *>---------------------------------------------------------------+ B303. MOVE F003-STATUS TO WS01-STATUS(ZEILE). MOVE F003-ID TO WS01-ID(ZEILE). MOVE F003-SOUNDEX TO WS01-SOUNDEX(ZEILE). *> ADRESSDATEN AUFBEREITEN IF F003-FIRMA NOT = SPACES THEN MOVE F003-FIRMA TO BUFFER COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 1 MOVE "," TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 2 ELSE IF F003-TITEL NOT = SPACES THEN MOVE F003-TITEL TO BUFFER COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 2 ELSE MOVE SPACES TO BUFFER MOVE 1 TO SPOS END-IF MOVE F003-VORNAME TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 2 MOVE F003-NACHNAME TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 1 MOVE "," TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 2 IF F003-LANDKZ = "GER" THEN MOVE F003-PLZ TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 2 ELSE MOVE F003-LANDKZ TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 1 MOVE "-" TO BUFFER(SPOS:) ADD 1 TO SPOS MOVE F003-PLZ TO BUFFER(SPOS:) COMPUTE SPOS = STORED-CHAR-LENGTH(BUFFER) + 2 END-IF MOVE F003-STADT TO BUFFER(SPOS:) MOVE BUFFER TO WS01-NAME(ZEILE) END-IF. B303-XXX. *>---------------------------------------------------------------+ *> B304 - INITIALIZE SCREEN-01 HEADER | *>---------------------------------------------------------------+ B304. MOVE "ADRESSE01" TO ZZ-PROGRAM. MOVE "A D R E S S E N - L I S T E" TO ZZ-HEADER. PERFORM I101 THRU I101-XXX. DISPLAY SCREEN-HEADER. B304-XXX. *>---------------------------------------------------------------+ *> B401 - INITIALIZE DB0001 AND DB0003 | *>---------------------------------------------------------------+ B401. OPEN INPUT FILE001. OPEN INPUT FILE003. CLOSE FILE001. CLOSE FILE003. B401-XXX. *>---------------------------------------------------------------+ *> B601 - EXCEPTION: SCREEN-01 | *>---------------------------------------------------------------+ B601. IF COB-CRT-STATUS = COB-SCR-F9 THEN GOBACK. B601-XXX. *>---------------------------------------------------------------+ *> B801 - EIN-/AUSGABE SCREEN-01 | *>---------------------------------------------------------------+ B801. DISPLAY SCREEN-01. ACCEPT SCREEN-01 *> B601 - EXCEPTION: SCREEN-01 ON EXCEPTION PERFORM B601 THRU B601-XXX END-ACCEPT. B801-XXX. *> *>---------------------------------------------------------------+ *> DO-NOTHING. DO-NOTHIN-XXX. *>---------------------------------------------------------------+ *> I101 - INITIALIZE HEADER TEMPLATE | *>---------------------------------------------------------------+ I101. ACCEPT ZZ-LINES FROM LINES. ACCEPT ZZ-COLUMNS FROM COLUMNS. MOVE CURRENT-DATE TO DATUM-AKTUELL. SUBTRACT 18 FROM ZZ-COLUMNS GIVING ZZ-START-DATE. COMPUTE ZZ-REFE2 = STORED-CHAR-LENGTH(ZZ-HEADER) / 2. COMPUTE ZZ-REFE1 = (ZZ-COLUMNS / 2) - ZZ-REFE2 + 1. MOVE ZZ-REFE1 TO ZZ-START-HEADER. I101-XXX.