Mit Hilfe des Folgenden Codings werden Datensätze aus einer kommaseparierten Datei erstellt. Zur Erzeugung dieser Datei siehe hier
|
IDENTIFICATION DIVISION. PROGRAM-ID. U039. AUTHOR. RAINER NEHLS. DATE-WRITTEN. 24.11.1998. ****************************************************************** * * KURZBESCHREIBUNG: DAS PROGRAMM HAT DIE AUFGABE, EINEN * KOMMASEPARIERTEN DATENSATZ AUFZU- * BEREITEN. * * EINGABEN: SCHALTER NEUBEGINN (J) X(01) * NUMERISCHES FELD PIC -Z(10)9.9999 * TEXTFELD X(256) * * AUSGABEN: KOMMASEP. TEXTFELD X(4096) * * HINWEIS: EIN KOMMA IN EINEM DEZIMALWERT WIRD * AUF PUNKT UMGESETZT. * ****************************************************************** * * ÄNDERUNGEN: VERSION 002 / 00.00.00 NEHLS * XXXXXXXXXXXXXXXXXXXXXXXXXXXXX * ****************************************************************** ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. 01 WS-FELDER. 05 Z-FELDER. 10 Z-PGRNM PIC X(05) VALUE "U039". 10 Z-VERS PIC S9(03) COMP-3 VALUE 001. 01 Z-FELDER. 05 Z-LAE PIC X(04) COMP-5. 05 Z-LAEO PIC X(04) COMP-5. 05 Z-TRENN PIC X(01) VALUE ",". LINKAGE SECTION. 01 COM-U039. 05 COM-SW-NEU PIC X(01). * SCHALTER FÜR NEUE AUSG. 05 COM-ANZST PIC 9(01) COMP-X. * ANZAHL STELLEN IN EIN-N 05 COM-EIN-N. 10 COM-N PIC X(01) OCCURS 17 INDEXED BY IX-N. * ALPHANUM. EINGABE 05 COM-EIN-T. 10 COM-T PIC X(01) OCCURS 256 INDEXED BY IX-T. * AUSGABEBEREICH 05 COM-AUS. 10 COM-A PIC X(01) OCCURS 4096 INDEXED BY IX-A. PROCEDURE DIVISION USING COM-U039. * A-00 : HAUPTSTEUERLEISTE A-00 SECTION. A-00-10. IF COM-SW-NEU = "J" MOVE SPACE TO COM-AUS SET IX-A TO 1. IF COM-EIN-N = SPACE PERFORM T-00 ELSE PERFORM N-00. MOVE SPACE TO COM-SW-NEU COM-EIN-N COM-EIN-T. A-00-99. EXIT PROGRAM. * N-00 : NUMERISCHES FELD AUFBEREITEN N-00 SECTION. N-00-10. * KOMMA ÜBERTRAGEN PERFORM V-00. * ANFÜHRUNGSZEICHEN PERFORM W-00. * LÄNGE ERMITTELN MOVE COM-ANZST TO Z-LAE. * ZEICHEN ÜBERTRAGEN PERFORM N-20 VARYING IX-N FROM 1 BY 1 UNTIL IX-N > Z-LAE. * ANFÜHRUNGSZEICHEN PERFORM W-00. N-00-99. EXIT. * N-20 : NUMERISCHE ZEICHEN ÜBERTRAGEN N-20 SECTION. N-20-10. IF COM-N (IX-N) NOT = SPACE MOVE COM-N (IX-N) TO COM-A (IX-A) * AUSGABEINDEX ERHÖHEN PERFORM X-00. N-20-99. EXIT. * T-00 : ALPHANUM. FELD AUFBEREITEN T-00 SECTION. T-00-10. * KOMMA ÜBERTRAGEN PERFORM V-00 * ANFÜHRUNGSZEICHEN PERFORM W-00 IF COM-EIN-T NOT = SPACE * LETZTES ZEICHEN ERMIT. PERFORM VARYING IX-T FROM 256 BY -1 UNTIL IX-T < 1 IF COM-T (IX-T) NOT = SPACE SET Z-LAE TO IX-T SET Z-LAEO TO IX-T SET IX-T TO 1 END-IF END-PERFORM * ASCII TO ANSI CALL "PC_WIN_OEM_TO_CHAR" USING COM-EIN-T COM-EIN-T BY VALUE Z-LAE Z-LAEO RETURNING Z-CALL-STATUS END-CALL * ZEICHEN ÜBERTRAGEN PERFORM VARYING IX-T FROM 1 BY 1 UNTIL IX-T > Z-LAE MOVE COM-T (IX-T) TO COM-A (IX-A) * AUSGABEINDEX ERHÖHEN PERFORM X-00 IF COM-T (IX-T) = QUOTE PERFORM W-00 END-IF END-PERFORM END-IF * ANFÜHRUNGSZEICHEN PERFORM W-00. T-00-99. EXIT. * V-00 : KOMMA ÜBERTRAGEN V-00 SECTION. V-00-10. IF IX-A > 1 MOVE Z-TRENN TO COM-A (IX-A) PERFORM X-00. V-00-99. EXIT. * W-00 : ANFÜHRUNGSZEICHEN ÜBERTRAGEN W-00 SECTION. W-00-10. MOVE QUOTE TO COM-A (IX-A) PERFORM X-00. W-00-99. EXIT. * X-00 : AUSGABEINDEX ERHÖHEN X-00 SECTION. X-00-10. IF IX-A < 4095 SET IX-A UP BY 1. X-00-99. EXIT. |
