I found code below in Cobol. Comments are in german which I dont understand.
Can this used to parse this file and if yes, how to convert in to VFP ?

       IDENTIFICATION DIVISION.
       PROGRAM-ID. AIRCHE.
      *************
      * LIEST DATEI MIT 7A-AIR-DATENSATZ
      ********
      * 14.07.03 CHB "M-"-ELEM. REIN FAREBAS
      * 08.07.03 CHB CLASS OF SERVICE <--> CL OF BOOKING
      *              BIS HEUTE IMMER 1. WERT GENOMMEN!
      * 08.07.03 CHB NEUES DIR: FLAG-LAUF = 3  + TMG: bsp-tmg
      *              FLAG-LAUF = 3 FÜR LETZTEN LAUF (ALSO 1,2,2,..,2,3)
      * 07.07.03 CHB WG. TMG: BEKOMMEN NICHT NUR 7A-AIR BEIM TICKETDRUCK
      *              SONDERN ALLE (?) PNR-AENDERUNGEN, D.H. PROGRAMM
      *              SORTIERT NACH AIROPT IN BLK-HEADER SEGMENT AUS,
      *              WAS 7A-AIR RECORDS SIND UND WAS NICHT --> bsp-not7a.
      * 18.06.03 CHB TAGE-VERSCHIEBUNG '*' UND '+' VERTAUSCHT
      * 28.05.03 CHB NEUE 7A AIR-FELDER: AMD-OFFICEID UND AMD-IATANR
      *              BEI TMG-IATANR (23226000) KEIN 'PERFORM TOUR'
      * 24.04.03 CHB FUER AGB/ZWS/QDU/QKL SRM UMSETZUNG AUS FLDAT
      *              AIRINPUT --> X(9990)
      * 23.04.03 CHB BEI FF-FEHLER UND FLAG-LAUF = 2 --> BSP-CHECK
      *              DELIMITER FUER FARECALC:
      *              'IT END' DURCH 'END   ' ERSETZT
      * 22.04.03 CHB D-MWSTKZ MIT "D" VORBELEGEN!
      * 20.03.03 CHB WENN 'DATEI FEHLER'-ENDE AUCH MOVE NACH BSP-NOTOK
      *              FFF VERSCHOBEN UND FFF-D GELOESCHT
      * 12.03.03 CHB NEU: FH HAND TICKET NUMBER
      * 08.03.03 chb FALSCHES END-IF BEI "FM"
      * 07.03.03 CHB NEU: FQV FREQUENT FLYER
      * 04.03.03 CHB W-CDX --> HT-RECHDATNEUX! X(6) --> X(3)
      *              D-PROZ FUELLEN UND D-PROV AUSRECHNEN!
      *              D-FARE1/D-FARE2 NICHT EINDEUTIG
      * 03.03.03 CHB CPY FUER CRSACCESS
      * 01.03.03 CHB FLAG-LAUF = 1 / 2
      * 27.02.03 CHB T-HILF UND T-HILF-2
      * 26.02.03 CHB D-TIDAT IST MASSGEBEND FÜR L-JJ/WO
      * 18.02.03 CHB FARE/TAX FELDER
      * 13.01.03 CHB ANFANG
      ********
       AUTHOR.   STUDIOSUS CHB.
      *
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. LEVEL-6.
       OBJECT-COMPUTER. LEVEL-6.
       SPECIAL-NAMES.
           SWITCH-3   IS SW3
           ON STATUS  IS SW3-ON
           OFF STATUS IS SW3-OFF
           SWITCH-5   IS SW5
           ON STATUS  IS SW5-ON
           OFF STATUS IS SW5-OFF.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
      *
       copy "s-airli.cpy".
       copy "s-fltid.cpy".
       copy "s-fldat.cpy".
       copy "s-sttou.cpy".
       copy "s-steet.cpy".
      *
           SELECT DIRLIST ASSIGN TO FILENAME LOCK MANUAL
           ORGANIZATION IS LINE SEQUENTIAL
           FILE STATUS  IS FI-STAT.
      *
           SELECT AIRINPUT ASSIGN TO FILENAME LOCK MANUAL
           ORGANIZATION IS LINE SEQUENTIAL
           FILE STATUS  IS FI-STAT.
      *
           SELECT PCS-PROTDATEI ASSIGN TO "pcs-protdatei" LOCK MANUAL
           ORGANIZATION IS LINE SEQUENTIAL
           ACCESS MODE  IS SEQUENTIAL
           FILE STATUS  IS FI-STAT.
      *
      *
      *
      *
       DATA DIVISION.
       FILE SECTION.
      *
      * 17.11.99 CHB L-JJWOX.
      * 17.03.97   L-ANZAHL* RAUS, L-REISEDAT REIN.
      *
       FD  DIRLIST RECORD VARYING 1 TO 500 CHARACTERS
           DEPENDING ON T2 LABEL RECORD IS OMITTED.
       01  HE-DIRLIST.
         02  DL-ZEILE              PIC X(500).
      *
       FD  AIRINPUT EXTERNAL RECORD VARYING 1 TO 9900 CHARACTERS
           DEPENDING ON T1 LABEL RECORD IS OMITTED.
      *
       01  HE-AIRINPUT.
         02  AIR-BUFF              PIC X(9900).
      *
       FD  PCS-PROTDATEI LABEL RECORD IS OMITTED.
       01  PCS-SATZ.
         02  PCS-CDATE             PIC 9(06).
         02  PCS-FILEKEY           PIC X(06).
         02  PCS-RECH              PIC 9(06).
         02  PCS-TEXT              PIC X(50).
      *
       WORKING-STORAGE SECTION.
      * data structures for SQL-Bridge >>>
           COPY "sqlbridge.cpy".
      * AIRLIST
       01 AIRLIST-SATZ.
         02 AIRLIST-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--he-airlist--str" replacing ==:REDEF:==
                                          by ==AIRLIST-STRUCTURE==.
      *
      * FLDAT
       01 FLDAT-SATZ.
         02 FLDAT-STRUCTURE.
           05 FILLER PIC X(32767).
      ******
      * 19.11.03 CHB HE-NAECHSTTICK ALS LETZTE REDEFINITION
      ******
           copy "airche--he-aircode--str" replacing ==:REDEF:==
                                          by ==FLDAT-STRUCTURE==.
           copy "airche--he-l3code--str" replacing ==:REDEF:==
                                         by ==FLDAT-STRUCTURE==.
      ******
      * 12.03.96 CHB TIX-STOCK-ENDE: TICKNR-ENDE
      ******
      *  DIE TICKETNUMMERN STEHEN UNTER ""256 256 256"" FUER BSP,
      *  BZW. DER AIRLINNR IN TICKCODE UND ""256"" IN TICKCODEX.
      *  DADURCH WERDEN IATA-CODES UND 3L-CODES NICHT BERUEHRT.
      *
           copy "airche--he-naechsttick--str" replacing ==:REDEF:==
                                              by ==FLDAT-STRUCTURE==.
      *
      ********
      * 19.08.11 CHB D-NA-RECLOC
      * 08.04.09 CHB D-AILRF-NR2
      * 10.10.08 CHB D-AILRF-NR
      * 21.02.03 CHB NEUE GRUPPENBEZ. D-FLUGDATENOCC
      * 20.02.03 CHB NEUE GRUPPENBEZ. D-CALCOCC
      * 26.10.00 CHB D-USER-STOP: SATZSCHUTZ FUER FLUG4 UND FLTICK!
      * 04.05.99 CHB NEU: D-USERID
      * 20.01.98 FA  NEU: D-PROV
      * 01.07.92 CHB NEU: D-PLATZ
      * 23.12.92 CHB NEU: D-BEM-2
      * 22.07.93 RWB NEU: D-WV(=WIEDERVORLAGE) ZUR]CKSCHREIBEN WG.
      *                   TRANSFER
      * 11.02.94 CHB NEU: D-TEILN-NR
      * 02.05.94 FA  NEU: D-FPAC-COUPON.
      * 18.03.97 FA  D-BUERO, D-TYP.
      ********
      * FLTIDRU
       01 FLTIDRU-SATZ.
         02 FLTIDRU-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--he-fltidru--str" replacing ==:REDEF:==
                                          by ==FLTIDRU-STRUCTURE==.
      *
      * 28.08.90   T-KENZ IN T-VISAKENZ GEAENDERT.
      *
      * TEILNEHMER
       01 TEILNEHMER-SATZ.
         02 TEILNEHMER-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--he-teilnehmer--str" replacing ==:REDEF:==
                                             by ==TEILNEHMER-STRUCTURE==
             .
      ****
      **** REDEFINITION FUER EXPEDIENT U. SB-AENDERUNGEN
      ****
           copy "airche--he-expedient--str" replacing ==:REDEF:==
                                            by ==TEILNEHMER-STRUCTURE==.
      *
      * Žnderungen bitte auch in F-TOURW.IN.C vornehmen!
      *    13.12.01   CHB WVL-KEY
      *    15.11.95                HE-ANZAHLUNG
      *    14.08.95                HE-KUNDNR.
      *
      * TOURKUN
       01 TOURKUN-SATZ.
         02 TOURKUN-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--he-tourkun--str" replacing ==:REDEF:==
                                          by ==TOURKUN-STRUCTURE==.
      *
      * 08.12.01 CHB  ETL-DEMEUR
      * 08.03.90   FA ETL-GUTSCHRIFT NUR FUER "T", SONST ETL-MELD.
      * EETOURKUN
       01 EETOURKUN-SATZ.
         02 EETOURKUN-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--ee-tourkun--str" replacing ==:REDEF:==
                                          by ==EETOURKUN-STRUCTURE==.
      *
           copy "airche--etl-bseite--str" replacing ==:REDEF:==
                                          by ==EETOURKUN-STRUCTURE==.
      *
      *******
      * 03.03.03 CHB CA-FILLER
      * 03.03.03 CHB AUS FLCRS2
      *******
      * CRSACCESS
       01 CRSACCESS-SATZ.
         02 CRSACCESS-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--he-crsaccess--str" replacing ==:REDEF:==
                                            by ==CRSACCESS-STRUCTURE==.
      *
      * PARAMETER
       01 PARAMETER-SATZ.
         02 PARAMETER-STRUCTURE.
           05 FILLER PIC X(32767).
           copy "airche--he-parameter--str" replacing ==:REDEF:==
                                            by ==PARAMETER-STRUCTURE==.
      *
           copy "airche--he-par-saison--str" replacing ==:REDEF:==
                                             by ==PARAMETER-STRUCTURE==.
      *
      * <<< data structures for SQL-Bridge
       77  SYSTEM-STATUS PIC S999 COMP-4 VALUE ZERO.
       COPY "w-parueb.cpy".
       77  FI-STAT                 PIC X(02) VALUE SPACES.
       77  FI-ENDE                 PIC 9(01) VALUE ZEROES.
       77  SWNO5                   PIC X(01) VALUE "5".
       77  SWNO3                   PIC X(01) VALUE "3".
       77  T1                      PIC S9(4) COMP-4    VALUE ZEROES.
       77  T2                      PIC S9(4) COMP-4    VALUE ZEROES.
       77  IN-CHAR                 PIC X(01) VALUE SPACE.
       77  POINT1                  PIC S9(4) COMP-4 VALUE ZERO.
       77  POINT1-2                PIC S9(4) COMP-4 VALUE ZERO.
       77  POINT1-XT               PIC S9(4) COMP-4 VALUE ZERO.
       77  XT-FARECALC             PIC X(240) VALUE SPACES.
       77  POINT1-RR               PIC S9(4) COMP-4 VALUE ZERO.
       77  TEXT-RR                 PIC X(240) VALUE SPACES.
       77  D1                      PIC S9(4) COMP-4 VALUE ZERO.
       77  RES-LFD                 PIC S9(4) COMP-4 VALUE ZERO.
       77  W-INTEGER               PIC 9(04) VALUE ZEROES.
       77  W-SEQ                   PIC X(01) VALUE SPACES.
       77  W-ANZ                   PIC 9(06) VALUE ZEROES.
       77  W-ARR                   PIC X(03) VALUE SPACES.
       77  VGL-PERS                PIC 9(02) VALUE ZEROES.
       77  DUP-RECH                PIC 9(06) COMP-6 VALUE ZEROES.
       77  EG-DATN                 PIC 9(06) VALUE ZEROES.
       77  DUP-DFKEY                PIC X(11) VALUE SPACES.
       77  W-TVL-PAX               PIC 9(02) VALUE ZEROES.
       77  BEFEHL                  PIC X(80) VALUE SPACES.
       77  PFAD                    PIC X(80) VALUE SPACES.
       77  FFTEXT                  PIC X(45) VALUE SPACES.
       77  FFTEXT2                 PIC X(40) VALUE SPACES.
       77  FILENAME                PIC X(80) VALUE SPACES.
       77  MWST                    PIC 99V99 COMP-6 VALUE 16.
       77  DAT-STAT                PIC S9(4) COMP-4    VALUE ZEROES.
       77  DAT-STAT2               PIC S9(8) COMP-4    VALUE ZEROES.
       77  TAGE                    PIC S9(4) COMP-4    VALUE ZEROES.
       77  W-WOCHE                 pic 9(2)            VALUE ZEROES.
       77  MAX-CONNR               PIC S9(4) COMP-4    VALUE ZEROES.
       77  PNT1                    PIC S9(4) COMP-4 VALUE ZEROES.
       77  PNT2                    PIC S9(4) COMP-4 VALUE ZEROES.
       77  PNT3                    PIC S9(4) COMP-4 VALUE ZEROES.
       77  MAX-MSG                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  MAX-SEG                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  MAX-COM                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  MAX-ELE                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  S-CNT                   PIC S9(4) COMP-4 VALUE ZEROES.
       77  C-CNT                   PIC S9(4) COMP-4 VALUE ZEROES.
       77  T-CNT                   PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-H-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-I-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-T-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-A-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-D-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-G-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-K-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-KN-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-KS-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-KFT-CNT               PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-KNT-CNT               PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-KST-CNT               PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-Q-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-M-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-O-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FE-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FM-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FO-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FP-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FV-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FS-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  R-FT-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  AMD-CNT                 PIC S9(4) COMP-4 VALUE ZEROES.
       77  OVFL-CNT                PIC S9(4) COMP-4 VALUE ZEROES.
       77  DIS-PNT1                PIC +(04)9.
       77  DIS-PNT2                PIC +(04)9.
       77  DIS-PNT3                PIC +(04)9.
       77  DIS-PNTM                PIC +(04)9.
       77  DIS-PNTS                PIC +(04)9.
       77  DIS-OVFL                PIC +(04)9.
       01  W-CHAR6.
         02  W-NUM6                PIC 9(06) VALUE ZEROES.
       01  PNT-FELDER.
         02  PNT-EIN               PIC S9(4) COMP-4 VALUE ZEROES.
         02  PNT-AUS               PIC S9(4) COMP-4 VALUE ZEROES.
         02  PNT-MSG               PIC S9(4) COMP-4 VALUE ZEROES.
         02  PNT-SEG               PIC S9(4) COMP-4 VALUE ZEROES.
         02  PNT-COM               PIC S9(4) COMP-4 VALUE ZEROES.
         02  PNT-ELE               PIC S9(4) COMP-4 VALUE ZEROES.
       01  W-PRUEF.
         02  W-PR-STX              PIC X(01).
         02  W-PR-MUCGSX.
           03  W-PR-MUCGS          PIC X(05).
           03  W-PR-VORG.
             04  W-PR-RECHNRX.
               05  W-PR-RECHNR     PIC 9(06).
             04  W-PR-STR          PIC X(01).
             04  W-PR-REISE        PIC X(10).
       01  ACCLAE-FELDER.
         02  ACC-MAX               PIC S9(4) COMP-4 VALUE ZEROES.
         02  ACC-1                 PIC S9(4) COMP-4 VALUE ZEROES.
         02  ACC-2                 PIC S9(4) COMP-4 VALUE ZEROES.
         02  ACC-F3                PIC 9 COMP VALUE ZEROES.
         02  ACC-PROZ              PIC X(01) VALUE SPACES.
         02  ACC-MWST              PIC 9(01) VALUE ZEROES.
         02  ACC-MINUS             PIC S9 VALUE 1.
         02  ACC-ZEICHEN           PIC X(01).
         02  ACC-BRUTTO            PIC S9(10)V9(06) COMP-3 VALUE ZEROES.
         02  F5-PIZR               PIC S9(10)V9(06) COMP-3 VALUE ZEROES.
         02  F5-FELD               PIC X(40) VALUE SPACES.
         02  ACC-ZAHL              PIC S9(10)V9(06) COMP-3 VALUE ZEROES.
         02  ACC-TAGE              PIC S9(4) COMP-4 VALUE ZEROES.
         02  ACC-DATN              PIC 9(06) COMP-6 VALUE ZEROES.
         02  FILLER REDEFINES ACC-DATN.
           03  ACC-DATJ            PIC 9(02) COMP-6.
           03  ACC-DATM            PIC 9(02) COMP-6.
           03  ACC-DATT            PIC 9(02) COMP-6.
         02  ACC-SAISON            PIC X(02) VALUE SPACES.
         02  ZAHL-CHAR             PIC X(20).
         02  ZAHL-CH REDEFINES ZAHL-CHAR       PIC X(01) OCCURS 20.
         02  ZAHL-FILLER.
           03  VORKOMMAX           PIC X(10) JUST.
           03  VORKOMMAN REDEFINES VORKOMMAX   PIC 9(10).
           03  NACHKOMMAX          PIC X(06).
           03  NACHKOMMAN REDEFINES NACHKOMMAX PIC 9(06).
         02  ZAHL-X-OCC REDEFINES ZAHL-FILLER.
           03  ZAHL-X              PIC X(01) OCCURS 16.
         02  ACC-BI-6.
           04  ACC-BI-T            PIC 9(02).
           04  ACC-BI-M            PIC 9(02).
           04  ACC-BI-J            PIC 9(02).
           04  ACC-BI-JX REDEFINES ACC-BI-J PIC X(02).
         02  FILLER REDEFINES ACC-BI-6.
           03  ACC-BI-X            PIC X(01) OCCURS 6.
       01  PERSID                  PIC X(12).
       01  SAISON                  PIC X(02).
       01  N-SAISON REDEFINES SAISON PIC 9(02).
       01  FILLER1.
         02  FILLER                PIC X.
         02  DISY                  PIC X.
       01  DIS-UC1 REDEFINES FILLER1  PIC S9(4) COMP-4.
       01  FLAG-VARS.
         02  FLAG-SUPER            PIC 9(01) VALUE ZEROES.
         02  FLAG-LAUFX.
           03  FLAG-LAUF           PIC 9(01) VALUE ZEROES.
         02  FLAG-UPROG            PIC 9(01) VALUE ZEROES.
       01  HILFSFELD.
         02  CLS                   PIC X(04)  VALUE X"1B481B4A".
         02  X1                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  X2                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  X3                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  X4                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  X5                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  A1                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  XD                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  L                     PIC S9(4) COMP-4 VALUE ZEROES.
         02  Z                     PIC S9(4) COMP-4 VALUE ZERO.
         02  ZZ                    PIC S9(4) COMP-4 VALUE ZERO.
         02  DUP-Z                 PIC 9(02) COMP-6 VALUE ZEROES.
         02  MAX-Z                 PIC S9(4) COMP-4 VALUE ZERO.
         02  F1                    PIC X(02)  VALUE X"1B30".
         02  F2                    PIC X(02)  VALUE X"1B32".
         02  F3                    PIC X(02)  VALUE X"1B36".
         02  F4                    PIC X(02)  VALUE X"1B38".
         02  F5                    PIC X(02)  VALUE X"1B3A".
         02  F6                    PIC X(02)  VALUE X"1B3C".
         02  FTASTE                PIC 9(02)  COMP-6 VALUE 0.
         02  ESC-ESC               PIC X(02) VALUE X"1B1B".
         02  DISZ2                 PIC Z(02).
         02  DISZ4                 PIC Z(03)9.
         02  FILLER REDEFINES DISZ4.
           03  DIS-FLNR            PIC Z9(03).
         02  DISZ6                 PIC Z(05)9.
         02  DISM6                 PIC -(05)9.
         02  DISX1.
           03  DIS91               PIC 9.
       01  DATUM-VARIABLEN.
         02  TAGESDATUM            PIC 9(06)    COMP-6.
         02  HILF-DATUM            PIC 9(06)    COMP-6.
         02  W-CD                  PIC 9(06).
         02  W-CDX REDEFINES W-CD.
           03 W-CDJ                PIC 9(02).
           03 W-CDM                PIC 9(02).
           03 W-CDT                PIC 9(02).
         02  DAT.
           03  DATN                PIC 9(06) COMP-6 VALUE 0.
           03  DATX REDEFINES DATN.
             04  DATJ              PIC 9(02) COMP-6.
             04  DAT4.
               05  DATM            PIC 9(02) COMP-6.
               05  DATT            PIC 9(02) COMP-6.
             04  FILLER REDEFINES DAT4.
               05  DAT4N           PIC 9(04) COMP-6.
           03  B-DATN              PIC 9(06) COMP-6 VALUE 0.
         02  G-DAT.
           03  G-DATN              PIC 9(06) VALUE ZEROES.
           03  G-DATX REDEFINES G-DATN.
             04  G-DATT            PIC 9(02).
             04  G-DATM            PIC 9(02).
             04  G-DATJ            PIC 9(02).
         02  W-TIME                PIC 9(08) VALUE ZEROES.
         02  FILLER REDEFINES W-TIME.
           03  W-TI-HHMM           PIC 9(04).
           03  FILLER              PIC X(04).
         02  FILLER REDEFINES W-TIME.
           03  W-TI-HH             PIC 9(02).
           03  W-TI-MM             PIC 9(02).
           03  W-TI-SS             PIC 9(02).
           03  FILLER              PIC 9(02).
         02  W-TD-HHMM             PIC 9(04) VALUE ZEROES.
         02  FILLER REDEFINES W-TD-HHMM.
           03  W-TD-HH             PIC 9(02).
           03  W-TD-MM             PIC 9(02).
         02  BIDAT.
           03  BIDAT4.
             04  BIDATT            PIC 9(02).
             04  BIDAT1            PIC X(01).
             04  BIDATM            PIC 9(02).
           03  BIDAT2              PIC X(01).
           03  BIDATJ              PIC 9(02).
         02  W-FL-TTMMM.
           03  W-FL-TAG            PIC X(02).
           03  W-FL-MON            PIC X(03).
         02  W-FL-DATN             PIC 9(06).
         02  FILLER REDEFINES W-FL-DATN.
           03  W-FL-DATJ           PIC 9(02).
           03  W-FL-DATM           PIC 9(02).
           03  W-FL-DATT           PIC 9(02).
       01  MON-FILLER.
         02  M-FILLER.
           03  FILLER              PIC X(12) VALUE "312831303130".
           03  FILLER              PIC X(12) VALUE "313130313031".
         02  MONAT  REDEFINES M-FILLER PIC 9(02) OCCURS 12.
         02  MO-TEXT-FILLER.
           03  FILLER              PIC X(12) VALUE "JANFEBMARAPR".
           03  FILLER              PIC X(12) VALUE "MAYJUNJULAUG".
           03  FILLER              PIC X(12) VALUE "SEPOCTNOVDEC".
         02  MO-TEXT REDEFINES MO-TEXT-FILLER PIC X(03) OCCURS 12.
       01  WOCHENTAGE.
         02  WOTAG                 PIC X(2) OCCURS 7.
       01  DATUM.
         02  DATUM-19              PIC X(02) VALUE "19".
         02  DATUM-J               PIC 9(02).
         02  DATUM-STR1            PIC X(01) VALUE "/".
         02  DATUM-M               PIC 9(02).
         02  DATUM-STR2            PIC X(01) VALUE "/".
         02  DATUM-T               PIC 9(02).
       01  DATUMB.
         02  DATUMB-19             PIC X(02) VALUE "19".
         02  DATUMB-J              PIC 9(02).
         02  DATUMB-STR1           PIC X(01) VALUE "/".
         02  DATUMB-M              PIC 9(02).
         02  DATUMB-STR2           PIC X(01) VALUE "/".
         02  DATUMB-T              PIC 9(02).
       01  U-2000.
         02  DISDAT6               PIC 9(06) VALUE ZEROES.
         02  DISDAT8               PIC 9(08) VALUE ZEROES.
         02  U-DAT8N               PIC 9(08) COMP-6 VALUE ZEROES.
         02  FILLER REDEFINES   U-DAT8N.
           03  U-DATJ4             PIC 9(04) COMP-6.
           03  FILLER              PIC X(02).
         02  FILLER REDEFINES   U-DAT8N.
           03  U-DATJH             PIC 9(02) COMP-6.
           03  U-DAT6N             PIC 9(06) COMP-6.
           03  FILLER REDEFINES U-DAT6N.
             04  U-DATJ            PIC 9(02) COMP-6.
             04  U-DATM            PIC 9(02) COMP-6.
             04  U-DATT            PIC 9(02) COMP-6.
         02  UW-CD                 PIC 9(08) COMP-6 VALUE ZEROES.
         02  UX                    PIC S9(4) COMP-4 VALUE ZEROES.
         02  UW-HT-REISEDAT        PIC 9(08) COMP-6 VALUE ZEROES.
         02  UW-HT-BISDAT          PIC 9(08) COMP-6 VALUE ZEROES.
         02  UW-HILFDAT            PIC 9(08) COMP-6 VALUE ZEROES.
       01  DIR-ZEILE.
         02  DIR-PRUEF             PIC X(01).
         02  FILLER                PIC X(15).
         02  DIR-OWNER             PIC X(08).
         02  FILLER                PIC X(01).
         02  DIR-GROUP             PIC X(08).
         02  FILLER                PIC X(22).
         02  DIR-FILE              PIC X(20).
       01  H-FLUGDATENX.
         02  H-FLUGDATEN           OCCURS 20.
           03  H-X                 PIC X.
           03  H-FROM-3L           PIC X(3).
           03  H-FROM              PIC X(17).
           03  H-CIA               PIC X(03).
           03  H-FLY               PIC X(04).
           03  H-CL                PIC X(01).
           03  H-DATE              PIC X(05).
           03  H-TIME              PIC X(04).
           03  H-ST                PIC X(02).
           03  H-FAREBAS           PIC X(14).
           03  H-BEFORE            PIC X(05).
           03  H-AFTER             PIC X(05).
           03  H-FREE              PIC X(03).
           03  H-TIME2.
             04  FILLER            PIC X(04).
             04  H-TIME2-X         PIC X(01).
           03  H-PLATZ             PIC X(03).
           03  FILLER              PIC X(02).
           03  H-ARR-3L            PIC X(03).
           03  H-ARR               PIC X(17).
           03  H-ARR-DATE          pic X(03).
      *
       01  DUP-EETOURKUN.
           02 DUP-ET-KEYX          PIC X(4).
           02 DUP-ET-REST          PIC X(103).
      *
       01  ZWI-EETOURKUN.
           02 ZWI-ET-KEYX          PIC X(4).
           02 ZWI-ET-REST          PIC X(103).
      *
       01  DUP-FLTIDRU.
         02  DUP-KEY.
           03  DUP-RECHX           PIC X(3).
           03  DUP-NR              PIC 9(04)  COMP-6.
           03  DUP-CONNR           PIC 9(02)  COMP-6.
         02  DUP-DRUCK-KEY.
           03  DUP-DRUCK           PIC X(01).
           03  DUP-AIRL            PIC 9(03).
         02  DUP-REST.
           03  DUP-TINR.
             04  DUP-CODE          PIC 9(04)  COMP-6.
             04  DUP-CODEX         PIC X(01).
             04  DUP-TICK          PIC 9(10)  COMP-6.
           03  DUP-TIDAT           PIC 9(06)  COMP-6.
           03  DUP-FARE1X          PIC X(03).
0406       03  DUP-FARE1N          PIC 9(8)V99  COMP-6.
           03  DUP-FARE2X          PIC X(03).
           03  DUP-FARE2N          PIC S9(5)V99  COMP-3.
           03  DUP-TAX1X           PIC X(03).
           03  DUP-TAX1N           PIC S9(3)V99  COMP-3.
           03  DUP-TAX1LAND        PIC X(02).
           03  DUP-TAX2X           PIC X(03).
           03  DUP-TAX2N           PIC S9(3)V99  COMP-3.
           03  DUP-TAX2LAND        PIC X(02).
           03  DUP-TOTX            PIC X(03).
           03  DUP-TOTN            PIC S9(5)V99  COMP-3.
           03  DUP-MWSTKZ          PIC X(01).
           03  DUP-PROZ            PIC 99V99  COMP-6.
           03  DUP-AGNR            PIC 9(06)  COMP-6.
           03  DUP-BEARB           PIC X(04).
           03  DUP-FACTOR          PIC X(01).
           03  DUP-ORIG-3L         PIC X(03).
           03  DUP-ORIG            PIC X(17).
           03  DUP-DEST-3L         PIC X(03).
           03  DUP-DEST            PIC X(17).
           03  DUP-TOURCODE        PIC X(14).
           03  DUP-NAM             PIC X(26).
           03  DUP-EXCHANGE.
             04  DUP-EXCODE        PIC 9(3).
             04  DUP-EXTICK        PIC 9(10).
           03  DUP-ISSUE.
             04  DUP-ISSUECODE     PIC 9(3).
             04  DUP-ISSUETICK     PIC 9(10).
             04  FILLER            PIC X(19).
           03  DUP-FLUGDATEN                     OCCURS 4.
             04  DUP-X             PIC X.
             04  DUP-FROM-3L       PIC X(03).
             04  DUP-FROM          PIC X(17).
             04  DUP-CIA           PIC X(03).
             04  DUP-FLY           PIC X(04).
             04  DUP-CL            PIC X(01).
             04  DUP-DATE          PIC X(05).
             04  DUP-TIME          PIC X(04).
             04  DUP-ST            PIC X(02).
             04  DUP-FAREBAS       PIC X(14).
             04  DUP-BEFORE        PIC X(05).
             04  DUP-AFTER         PIC X(05).
             04  DUP-FREE          PIC X(03).
             04  DUP-TIME2         PIC X(05).
             04  DUP-PLATZ         PIC X(03).
             04  FILLER            PIC X(02).
           03  DUP-TOX             PIC X.
           03  DUP-TO-3L           PIC X(3).
           03  DUP-TO              PIC X(17).
           03  DUP-CALCOCC.
             04  DUP-CALC          PIC X(60)   OCCURS 4.
           03  DUP-PAYM            PIC X(30).
           03  DUP-BEM             PIC X(28).
           03  DUP-TAX3.
             04  DUP-TAX3X         PIC X(03).
             04  DUP-TAX3N         PIC S9(3)V99  COMP-3.
             04  DUP-TAX3LAND      PIC X(02).
           03  DUP-FILEKEY         PIC X(20).
           03  DUP-ISI             PIC X(04).
           03  DUP-DRU             PIC X.
           03  DUP-PREIS           PIC S9(7)V99  COMP-3.
           03  DUP-BEM-2           PIC X(28).
           03  DUP-WV              PIC X(02).
           03  DUP-TEILN-NRX.
             04  DUP-TEILN-NR      PIC 9(02).
           03  DUP-FPAC-COUPON     PIC X(04).
180397     03  DUP-BUERO           PIC X(04).
180397     03  DUP-TYP             PIC X.
           03  DUP-PROVX.
             04  DUP-PROV          PIC S9(7)V99  COMP-3.
           03  DUP-USER-ID         PIC X(08).
           03  DUP-USER-STOP       PIC X(08).
           03  FILLER              PIC X(58).
     *
       01  VGL-D-KEY.
         02  VGL-D-RECHX           PIC X(3).
         02  VGL-D-NR              PIC 9(04)  COMP-6.
         02  VGL-D-CONNR           PIC 9(02)  COMP-6.
       01  VGL-DD-KEY.
         02  VGL-DD-RECHX          PIC X(3).
         02  VGL-DD-NR             PIC 9(04)  COMP-6.
         02  VGL-DD-CONNR          PIC 9(02)  COMP-6.
      *
       01  ALLG-ELEMENTE.
         02  W-SEGTERM             PIC X(01) VALUE X"1C".
         02  W-COMTERM             PIC X(01) VALUE X"1D".
         02  W-CRLF.
           03  W-CR                PIC X(01) VALUE X"0D".
           03  W-LF                PIC X(01) VALUE X"0A".
         02  H-SEGTERM             PIC X(01) VALUE "m".
         02  H-COMTERM             PIC X(01) VALUE ";".
         02  H-CRLF.
           03  H-CR                PIC X(01) VALUE "m".
           03  H-LF                PIC X(01) VALUE "a".
      *
       01  UNST-FILLER.
         02  U-DELIM               PIC X(05).
         02  UNST-T1               PIC X(500).
         02  FILLER REDEFINES UNST-T1.
           03  UNST-T1-70          PIC X(70).
           03  FILLER              PIC X(0430).
         02  UNST-T2               PIC X(100).
         02  FILLER REDEFINES UNST-T2.
           03  UNST-T2-70          PIC X(070).
           03  FILLER              PIC X(030).
         02  UNST-T3               PIC X(100).
      *
       01  STRING-FILLER.
         02  STRING-TEXT           PIC X(90).
         02  FILLER REDEFINES STRING-TEXT.
           03  STRING-T1           PIC X(33).
           03  STRING-T2           PIC X(33).
           03  FILLER REDEFINES STRING-T2.
             04  STRING-T2-1       PIC X(01).
             04  FILLER            PIC X(32).
           03  STRING-TITEL        PIC X(20).
           03  STRING-VON          PIC X(04).
       01  T-HILF-FILLER.
         02  T-HILF                 PIC X(26).
         02  FILLER REDEFINES T-HILF.
           03  T-4                  PIC X(04).
           03  FILLER               PIC X(22).
         02  T-HILF-2               PIC X(26).
      *
      ********
      * EDIFACT-VARIABLE/IATAHH-UEBERGABEBEREICHE
      ********
       01  ED-EINGANG.
         02  ED-EIN-3840           PIC X(9990).
         02  FILLER REDEFINES ED-EIN-3840.
           03  ED-EIN-70.
             04  ED-EIN-10         PIC X(10).
             04  FILLER            PIC X(60).
           03  FILLER              PIC X(9920).
       01  ED-SEGMENT.
         02  SEG-DATA              PIC X(401) VALUE SPACES.
         02  FILLER REDEFINES SEG-DATA.
           03  SEG-ZEILE.
             04  SEG-TAG4.
               05  SEG-TAG3.
                 06  SEG-TAG       PIC X(02).
                 06  FILLER        PIC X(01).
               05  FILLER          PIC X(01).
             04  FILLER            PIC X(76).
           03  FILLER              PIC X(320).
           03  SEG-DATA-DELIM      PIC X(01).
       01  RESPONSE-ELEMENTE.
         02  R-ELEMENTE.
           03  AMD-ELEMENTE.
             04  AMD-RECLOC.
               05  AMD-PRUEF       PIC X(06).
               05  AMD-FILEKEY     PIC X(06).
             04  AMD-PERS.
               05  AMD-PNRPERN     PIC 9(02).
               05  AMD-AIRPERN     PIC 9(02).
             04  AMD-OFFICEID      PIC X(09).
             04  AMD-IATANR        PIC X(08).
           03  R-A-ELEMENTE.
             04  R-A-AIRLINE.
               05  R-A-AIRL        PIC X(03).
               05  R-A-CODE.
                 06  R-A-CODEN     PIC 9(03).
               05  R-A-CHECK       PIC X(01).
           03  R-D-ELEMENTE.
             04  R-D-TIDAT.
               05  R-D-TIDATN      PIC 9(06).
           03  R-G-ELEMENTE.
             04  R-G-ISI           PIC X(04).
             04  R-G-ORIGDEST.
               05  R-G-ORIG        PIC X(03).
               05  R-G-DEST        PIC X(03).
           03  R-H-ELEMENTE.
             04  R-H-ORIGX.
               05  FILLER          PIC X(03).
               05  R-H-X           PIC X(01).
               05  R-H-FROM-3L     PIC X(03).
             04  R-H-FROM          PIC X(17).
             04  R-H-ARR-3L        PIC X(03).
             04  R-H-ARR           PIC X(17).
             04  R-H-FLUG.
               05  R-H-CIA         PIC X(06).
               05  R-H-FLY         PIC X(05).
               05  R-H-CL-SER      PIC X(02).
               05  R-H-CL          PIC X(02).
               05  R-H-DATE.
                 06  R-H-TT        PIC 9(02).
                 06  R-H-MMM       PIC X(03).
               05  R-H-TIME.
                 06  R-H-HH        PIC 9(02).
                 06  R-H-MM        PIC 9(02).
                 06  R-H-AP        PIC X(01).
               05  R-H-ARR-TIME.
                 06  R-H-A-HH      PIC 9(02).
                 06  R-H-A-MM      PIC 9(02).
                 06  R-H-A-AP      PIC X(01).
               05  R-H-ARR-DATE.
                 06  R-H-A-TT      PIC 9(02).
                 06  R-H-A-MMM     PIC X(03).
             04  R-H-STATUS.
               05  R-H-ST          PIC X(02).
             04  R-H-PNRSTATUS.
               05  R-H-PNRST       PIC X(02).
             04  R-H-FREE          PIC X(03).
           03  R-M-ELEMENTE.
             04  R-M-DATAX         OCCURS 28.
               05  R-M-PCODE       PIC X(03).
               05  R-M-FAREBAS     PIC X(06).
               05  R-M-DESIGNATOR  PIC X(06).
           03  R-O-ELEMENTE.
             04  R-O-VALIDITY      OCCURS 28.
               05  R-O-BEFORE      PIC X(05).
               05  R-O-AFTER       PIC X(05).
           03  R-K-ELEMENTE.
             04  R-K-FARE1X.
               05  FILLER          PIC X(01).
               05  R-K-FARE1-WS    PIC X(03).
               05  R-K-FARE1       PIC X(11).
             04  R-K-FARE2X.
               05  R-K-FARE2-WS    PIC X(03).
               05  R-K-FARE2       PIC X(11).
             04  R-K-TOTAL.
               05  R-K-TTL-WS      PIC X(03).
               05  R-K-TTL         PIC X(11).
           03  R-KFT-ELEMENTE.
             04  R-KFT-TAXX        OCCURS 31.
               05  FILLER          PIC X(01).
               05  R-KFT-WS        PIC X(03).
               05  R-KFT-TAX       PIC X(09).
               05  R-KFT-TAXLAND   PIC X(03).
           03  R-Q-ELEMENTE.
             04  R-Q-CALC          PIC X(430).
           03  R-I-ELEMENTE.
             04  R-I-NAMEX.
               05  R-I-LFD.
                 06  R-I-LFDN      PIC 9(02).
               05  R-I-NAME        PIC X(64).
           03  R-T-ELEMENTE.
             04  R-T-TICKETNR.
               05  R-TIX-TYP       PIC X(01).
               05  R-T-CODEX.
                 06  R-T-CODEN     PIC 9(03).
               05  FILLER          PIC X(01).
               05  R-T-TIXX.
                 06  R-T-TIXN      PIC 9(10).
               05  FILLER REDEFINES R-T-TIXX.
                 06  FILLER        PIC X(08).
                 06  R-T-TIX-RN    PIC 9(02).
               05  R-T-STRICH      PIC X(01).
               05  R-T-CONJX.
                 06  R-T-CONJN     PIC 9(02).
           03  R-FF-ELEMENTE.
             04  R-FF-TEXT         PIC X(248).
      *****
      * COPY MEMBER
      *****
         COPY "f-whe.cpy".
         COPY "w-zahl.cpy".
         COPY "bizeil.cpy".
         02  FILLER  REDEFINES BIZEIL.
           03  SHIFT-ITEM.
             04  SHIFT-01-BYTE     PIC X(01).
             04  SHIFT-REST        PIC X(284).
       PROCEDURE DIVISION.
      *
       DECLARATIVES.
       DCL SECTION.
           USE AFTER ERROR PROCEDURE
                           DIRLIST
                           AIRINPUT.
       DCL-EX.  EXIT.
       END DECLARATIVES.
      *
       ANFANG SECTION.
       P00.
      ********
      *
           ACCEPT FLAG-LAUFX FROM COMMAND-LINE.
           IF FLAG-LAUFX = "2" OR "3" NEXT SENTENCE
           ELSE
             MOVE 1 TO FLAG-LAUF.
           IF FLAG-LAUF = 1
             MOVE "/transx1/bsp-ok/"                TO PFAD
             MOVE "/transx1/bsp-ok/ls.airche"       TO FILENAME
           ELSE
             MOVE "/transx1/bsp-notok/"          TO PFAD
             MOVE "/transx1/bsp-notok/ls.airche" TO FILENAME.
      ******
      * WENN AIRIMP ALS HINTERGRUNDPROGRAMM LAEUFT: FLAG-UPROG = 1
      ******
           MOVE 1        TO FLAG-UPROG.
           ACCEPT W-CD FROM DATE.                                       *HELP*
           MOVE W-CD     TO DATN.
           COMPUTE W-WOCHE = (DATM - 1) * 4 + 1.
           IF DATT > 7  ADD 1 TO W-WOCHE.
           IF DATT > 15 ADD 1 TO W-WOCHE.
           IF DATT > 23 ADD 1 TO W-WOCHE.
 ee-  *    OPEN INPUT CRSACCESS, TEILNEHMER.
 ee+       MOVE "crsacces" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "I" TO VIEW--OPNMOD
 ee+       MOVE "CRSACCES1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM
 ee+       MOVE VIEW--STATUS TO FI-STAT
 ee+       MOVE "teilnehm" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "I" TO VIEW--OPNMOD
 ee+       MOVE "TEILNEHM1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM.
           OPEN EXTEND PCS-PROTDATEI.
 ee-  *    OPEN I-O AIRLIST, FLTIDRU, FLDAT.
 ee+       MOVE "airlist" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "U" TO VIEW--OPNMOD
 ee+       MOVE "AIRLIST1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM
 ee+       MOVE VIEW--STATUS TO FI-STAT
 ee+       MOVE "fltidru" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "U" TO VIEW--OPNMOD
 ee+       MOVE "FLTIDRU1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM
 ee+       MOVE VIEW--STATUS TO FI-STAT
 ee+       MOVE "fldat" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "U" TO VIEW--OPNMOD
 ee+       MOVE "FLDAT1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM
 ee+       MOVE VIEW--STATUS TO FI-STAT.
 ee-  *    OPEN I-O TOURKUN, EETOURKUN.
 ee+       MOVE "fltourku" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "U" TO VIEW--OPNMOD
 ee+       MOVE "FLTOURKU1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM
 ee+       MOVE VIEW--STATUS TO FI-STAT
 ee+       MOVE "fleetour" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "U" TO VIEW--OPNMOD
 ee+       MOVE "FLEETOUR1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM
 ee+       MOVE VIEW--STATUS TO FI-STAT.
 ee-  *    OPEN I-O PARAMETER.
 ee+       MOVE "parametr" TO VIEW--PATH
 ee+       MOVE "OPN" TO VIEW--FUNC
 ee+       MOVE "U" TO VIEW--OPNMOD
 ee+       MOVE "PARAMETR1" TO VIEW--IONAME
 ee+       CALL "dbwrapper" USING VIEW--IONAME VIEW--PATH
             VIEW--KEY-EQUAL-FIX VIEW--PARAM.
      ********
      * PERSID ERMITTELN
      ********
           MOVE SPACES TO PERSID.
           MOVE ZEROES TO DAT-STAT2, DAT-STAT.
           CALL "PERID2" USING PERSID, DAT-STAT2, DAT-STAT.
           CALL "ZCMSWF" USING SWNO3.
      ******
      * DIRECTORY EINTRAEGE IN LS: FILENAME UEBER COMMAND-LINE
      ******
           OPEN INPUT DIRLIST.
           IF FI-STAT NOT = "00"       GO TO ENDE.
       P010.
           READ DIRLIST NEXT END       GO TO ENDE.
           IF FI-STAT NOT < "10"       GO TO ENDE.
           IF T2          < 56         GO TO P010.
           MOVE DL-ZEILE (1:T2) TO DIR-ZEILE.
           IF DIR-PRUEF NOT = "-"   GO TO P010.
      *     IF DIR-OWNER NOT = "nobody" GO TO P010.
      *     IF DIR-GROUP NOT = "nobody" GO TO P010.
           MOVE SPACES TO FILENAME.
           STRING PFAD        DELIMITED BY "  "
                  DIR-FILE    DELIMITED BY SIZE
           INTO FILENAME.
           OPEN INPUT AIRINPUT.
           IF FI-STAT > "10" GO TO P010.
           MOVE SPACES TO RESPONSE-ELEMENTE.
           MOVE ZEROES TO W-ANZ.
      *******
      * AUSLESEN DER 7A-TICKETING-AIR-SATZES
      *******
       P020.
           READ AIRINPUT NEXT END             GO TO P098.
           IF FI-STAT     = "10"              GO TO P098.
           IF FI-STAT     > "10"              GO TO P098.
           IF T1          < 10                GO TO P020.
           ADD 1 TO W-ANZ.
           MOVE HE-AIRINPUT (1:T1) TO ED-EIN-3840.
           IF ED-EIN-10 = "AIR-BLK204"        GO TO P060-204.
           IF ED-EIN-10 = "AIR-BLK206"        GO TO P060-206.
           GO TO P098.
      *******
      * DATEN AUS 7A-TICKETING-AIR DATENSATZ EXTRAHIEREN
      * 7A A.I.R VERSION 204 --> P200
      * 7A A.I.R VERSION 206 --> P300
      *******
       P060-204.
           MOVE SPACES TO RESPONSE-ELEMENTE, H-FLUGDATENX
                          PCS-SATZ.
           MOVE T1     TO MAX-MSG.
           PERFORM P200-SEC.
           GO TO P098.
       P060-206.
           MOVE SPACES TO RESPONSE-ELEMENTE, H-FLUGDATENX,
                          PCS-SATZ.
           MOVE T1     TO MAX-MSG.
           PERFORM P300-SEC.
           GO TO P098.
       P098.
           CLOSE AIRINPUT.
           GO TO P010.
       P099.  EXIT.
       P200-SEC  SECTION.
       P200.
           DISPLAY "AIR-BLK204" LINE 23 COL 01.
           IF FLAG-UPROG = ZEROES
             ACCEPT IN-CHAR WITH NO ADVANCING.
       P299-EX.  EXIT.
       P300-SEC  SECTION.
       P300.
      *     INSPECT HE-AIRINPUT REPLACING ALL H-LF BY W-LF.
           MOVE 1       TO PNT-EIN.
           MOVE ZEROES  TO PNT1, PNT2, OVFL-CNT.
           MOVE SPACES  TO UNST-FILLER.
      ********
      * 'AIR-BLK206'-SEG: ANZAHL SEGEMENTE INSGES.
      ********
           UNSTRING ED-EIN-3840 DELIMITED BY H-SEGTERM
           INTO UNST-T1         DELIMITER IN U-DELIM
                                COUNT     IN PNT1
                UNST-T2         COUNT     IN PNT2
                WITH            POINTER   PNT-EIN.
      *          ON OVERFLOW MOVE 1 TO OVFL-CNT.
           IF U-DELIM NOT = H-SEGTERM
             DISPLAY "U-DELIM:T>" LINE 23 COL 01
                     U-DELIM "<"
             GO TO FF-EDI.
           IF PNT1 > 500
             MOVE PNT1 TO DIS-PNT1
             DISPLAY "PNT1: " LINE 23 COL 01
                     DIS-PNT1
             GO TO FF-EDI.
      ******
      * 1. PORTION
      ******
           MOVE UNST-T1 TO SEG-DATA.
           IF SEG-DATA (1:14)     = "AIR-BLK206;7A;" NEXT SENTENCE
           ELSE
             IF SEG-DATA (1:14)   = "AIR-BLK206;BT;" NEXT SENTENCE
             ELSE
               IF SEG-DATA (1:13) = "AIR-BLK206;O;"  GO TO P397A
               ELSE
                 DISPLAY "AIROPT NOT = 7A " LINE 23 COL 01
                 GO TO FF-EDI.
           MOVE PNT1    TO MAX-SEG.
           MOVE 1       TO PNT-MSG.
           ADD 1, MAX-SEG TO PNT-MSG.
           MOVE ZEROES TO S-CNT, C-CNT, T-CNT.
           MOVE ZEROES TO AMD-CNT, R-A-CNT, R-D-CNT, R-G-CNT
                          R-H-CNT, R-I-CNT, R-T-CNT, R-K-CNT
                          R-KN-CNT, R-KS-CNT, R-KFT-CNT, R-KNT-CNT
                          R-KST-CNT, R-Q-CNT, R-FE-CNT, R-FM-CNT
                          R-FO-CNT, R-FP-CNT, R-FV-CNT, R-FS-CNT
                          R-FT-CNT, R-M-CNT, R-O-CNT.
           MOVE SPACES TO UNST-FILLER.
      *******
      * NAECHSTES SEGMENT
      *******
       P310.
           MOVE PNT-MSG TO PNT-EIN.
           MOVE ZEROES  TO PNT1, PNT2, OVFL-CNT.
           UNSTRING ED-EIN-3840 DELIMITED BY H-SEGTERM
           INTO UNST-T1         DELIMITER IN U-DELIM
                                COUNT     IN PNT1
                UNST-T2         COUNT     IN PNT2
                WITH            POINTER   PNT-EIN
                ON OVERFLOW MOVE 1 TO OVFL-CNT.
      ******
      * MAX-SEG = LAENGE DES ZU BEARBEITENDEN/GELESENEN SEGMENTES
      *           SEG-DELIMITER ANS ENDE DAMIT LETZTES COMPOSITE
      *           AUCH PER UNST-T1 ABGEARBEITET WERDEN KANN
      ******
           MOVE PNT1      TO MAX-SEG.
           MOVE UNST-T1   TO SEG-DATA.
           IF U-DELIM NOT = H-SEGTERM
             DISPLAY "U-DELIM NOT = H-SEGTERM" LINE 23 COL 01
                     U-DELIM "<"
             GO TO FF-EDI.
           MOVE H-COMTERM TO SEG-DATA-DELIM.
           MOVE 1         TO PNT-SEG.
           MOVE ZEROES    TO C-CNT.
      ******
      * 7A-A.I.R SEGMENTE: ACHTUNG: SEQUENZ DER ABFRAGEN WESENTLICH!
      ******
       P310-DATA-LINES.
      ******
      * SEGEMENTE DIE NUR EINMAL PRO 7A-A.I.R VORKOMMEN
      ******
           IF SEG-TAG3 = "AMD"  GO TO P315.
           IF AMD-CNT  < 3      GO TO P315.
           IF SEG-TAG  = "A-"   GO TO P320.
           IF SEG-TAG  = "B-"   GO TO P310-W.
           IF SEG-TAG  = "C-"   GO TO P310-W.
           IF SEG-TAG  = "D-"   GO TO P325.
           IF SEG-TAG  = "G-"   GO TO P330.
           IF SEG-TAG  = "H-"   GO TO P335.
           IF SEG-TAG  = "K-"   GO TO P340.
           IF SEG-TAG3 = "KN-"  GO TO P340.
           IF SEG-TAG3 = "KS-"  GO TO P340.
           IF SEG-TAG3 = "KFT"  GO TO P345.
           IF SEG-TAG3 = "KNT"  GO TO P345.
           IF SEG-TAG3 = "KST"  GO TO P345.
           IF SEG-TAG  = "X-"   GO TO P310-W.
           IF SEG-TAG  = "L-"   GO TO P310-W.
           IF SEG-TAG  = "M-"   GO TO P370.
           IF SEG-TAG  = "N-"   GO TO P310-W.
           IF SEG-TAG  = "O-"   GO TO P375.
           IF SEG-TAG  = "U-"   GO TO P310-W.
           IF SEG-TAG  = "Q-"   GO TO P350.
           IF SEG-TAG3 = "SIA"  GO TO P310-W.
           IF SEG-TAG4 = "ENDX" GO TO P392.
           IF SEG-TAG3 = "END"  GO TO P392.
      *****
      * SEGMENTE DIE MEHRMALS PRO 7A-A.I.R-DATENSATZ VORKOMMEN KOENNEN
      *  -PASSENGER DATA-LINES
      *  -PNR TICKETING DATA LINES
      *  -PNR INVOICE/ITINERARY REMARKS
      *  -PREPAID TICKET ADVICE ELEMENT LINES
      *****
           IF SEG-TAG  = "I-"   GO TO P355.
           IF SEG-TAG  = "S-"   GO TO P310-W.
           IF SEG-TAG  = "T-"   GO TO P360.
           IF SEG-TAG  = "FE"   GO TO P365.
           IF SEG-TAG  = "FM"   GO TO P365.
           IF SEG-TAG  = "FO"   GO TO P365.
           IF SEG-TAG  = "FP"   GO TO P365.
           IF SEG-TAG  = "FV"   GO TO P365.
           IF SEG-TAG  = "FS"   GO TO P365.
           IF SEG-TAG  = "FT"   GO TO P365.
           IF SEG-TAG  = "FH"   GO TO P310-W.
           IF SEG-TAG  = "TK"   GO TO P310-W.
           IF SEG-TAG  = "RM"   GO TO P310-W.
           IF SEG-TAG3 = "OPL"  GO TO P310-W.
           IF SEG-TAG3 = "SSR"  GO TO P310-W.
           IF SEG-TAG3 = "OSI"  GO TO P310-W.
           IF SEG-TAG3 = "FQV"  GO TO P310-W.
           MOVE SPACES TO FFTEXT.
           STRING "SEGMENT UNBEKANNT: " DELIMITED BY SIZE
                  SEG-TAG4              DELIMITED BY SIZE
           INTO FFTEXT.
           IF FLAG-UPROG NOT = ZEROES
             PERFORM FFF-F
           ELSE
             DISPLAY FFTEXT LINE 23 COL 1 ERASE END LINE
             ACCEPT IN-CHAR WITH NO ADVANCING
             IF IN-CHAR = "E" GO TO P392.
      *******
      * DATA-ELEMENTS: B- TICKETING INPUT
      * DATA-ELEMENTS: C- SERVICING CARRIER
      * DATA-ELEMENTS: X- OPERATIONAL FLIGHT AIR-SEGMENT
      * DATA-ELEMENTS: U- UNTICKETED SEGMENT DATA
      * DATA-ELEMENTS: L- PAYMENT RESTRICTION LINE
      * DATA-ELEMENTS: M- FARE BASIS CODE LINE
      * DATA-ELEMENTS: N- SEGMENT FARE LINES
      * DATA-ELEMENTS: O- VALIDITY DATES LINES
      * DATA-ELEMENTS: S- SEAT NUMBER DATA
      * DATA-ELEMENTS: TK TICKETING ARRANGEMENT
      * DATA-ELEMENTS: FH HAND TICKET NUMBER
      * DATA-ELEMENTS: RM REMARKS
      * DATA-ELEMENTS: SIA SUPPLEMENTRAY NEGO DATA LINE
      * DATA-ELEMENTS: SSR SPECIAL SERVICE REQUEST
      * DATA-ELEMENTS: OSI OTHER SERVIDE INFORMATION
      * DATA-ELEMENTS: FQV FREQUENT FLYER
      * DATA-ELEMENTS: OPL OP REMARKS
      *******
       P310-W.
           GO TO P390.
      *********
      * LABEL PERFORM
      *********
       UNST-SEG-DATA.
           MOVE ZEROES  TO PNT1, PNT2, OVFL-CNT.
           MOVE SPACES  TO UNST-FILLER.
           MOVE PNT-SEG TO PNT-EIN.
           UNSTRING SEG-DATA DELIMITED BY H-COMTERM
           INTO UNST-T1         DELIMITER IN U-DELIM
                                COUNT     IN PNT1
                UNST-T2         COUNT     IN PNT2
                WITH            POINTER   PNT-EIN
                ON OVERFLOW ADD 1 TO OVFL-CNT.
      ******
      * MAX-COM = LAENGE DES ZU BEARBEITENDEN/GELESENEN COMPONENTS
      ******
           MOVE PNT1      TO MAX-COM, DIS-PNT1.
      ******
      * 'AMD'-SEGMENT: BESONDERHEIT: TERMINATOR = 3. CR!
      * IM 3. TEILSEGMENT STEHT PNR-FILEKEY
      ******
       P315.
           ADD 1 TO AMD-CNT.
           IF AMD-CNT < 3 GO TO P319.
           IF AMD-CNT > 3
             MOVE "AMD: > 3 TEIL-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
       P316.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P319.
           ADD 1 TO C-CNT.
           IF C-CNT       > 6          GO TO P318.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P317.
      *******
      * DATA-ELEMENTS: DIE ERSTEN 4 IM DRITTEN TEIL-SEGMENT
      *******
      * 1,.
      * 2,.
      * 3,   1 'MUC1A ' + REC.LOC OF PNR
      *      2 TTL NUMBER OF PASSENGERS IN PNR
      *        TTL NUMBER OF PASSENGERS IN AIR
      *      3 AMADEUS OFFICE ID BOOKING AGENCY
      *      4 IATA-NR        OF BOOKING AGENCY
      *      5 AMADEUS OFFICE ID FIRST OWNER
      *      6 IATA-NR        OF FIRST OWNER
      *      7 AMADEUS OFFICE ID CURRENT OWNER
      *      8 IATA-NR        OF CURRENT OWNER
      *******
           IF C-CNT = 1
             MOVE UNST-T1 TO AMD-RECLOC
             IF AMD-PRUEF NOT = "MUC1A"
               MOVE "AMD-PRUEF NOT 'MUC1A'" TO FFTEXT
               PERFORM FFF-F
             ELSE
               DISPLAY AMD-FILEKEY LINE 23 COL 1 ERASE END LINE.
           IF C-CNT = 2
             MOVE UNST-T1 TO AMD-PERS
             IF AMD-PERS NOT NUMERIC
               MOVE "AMD-PERS NOT NUMERIC" TO FFTEXT
               PERFORM FFF-F.
           IF C-CNT = 5
             IF UNST-T1 NOT = SPACES
               MOVE UNST-T1 TO AMD-OFFICEID
               IF AMD-OFFICEID = SPACES
                 MOVE "AMD-OFFICEID = SPACES" TO FFTEXT
                 PERFORM FFF-F.
           IF C-CNT = 6
             IF UNST-T1 NOT = SPACES
               MOVE UNST-T1 TO AMD-IATANR
               IF AMD-IATANR NOT NUMERIC
                 MOVE "AMD-IATANR NOT NUMERIC" TO FFTEXT
                 PERFORM FFF-F.
       P317.
      ******
      * SCAN ABBRECHEN WENN EINE DER IATANR = TMG-IATANR!
      ******
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P318.
           GO TO P316.
      ******
      * REFERENZ FELDER FUELLEN
      ******
      * VERKNUEPFUNG PNR <--> VORGNR: CRSACCESS
      ******
       P318.
           MOVE AMD-FILEKEY TO PCS-FILEKEY.
           MOVE ZEROES      TO DUP-RECH.
           MOVE AMD-FILEKEY TO HE-CRSACCESS.
 ee-  *    START CRSACCESS KEY NOT < CA-FKEY INVALID GO TO P318B.
 ee+       MOVE "NL" TO VIEW--STRMOD
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM START-CRSACCES1
 ee+       IF STAT--INVALID
 ee+         GO TO P318B
 ee+       END-IF.
       P318A.
 ee-  *    READ CRSACCESS NEXT         END GO TO P318B.
 ee+       PERFORM READ-CRSACCES1-NEXT
 ee+       IF STAT--ATEND
 ee+         GO TO P318B
 ee+       END-IF.
           IF CA-FILEKEY NOT = AMD-FILEKEY GO TO P318B.
           IF CA-CRS     NOT = "A"         GO TO P318A.
           MOVE CA-RECH TO DUP-RECH.
       P318B.
           MOVE DUP-RECH   TO PCS-RECH.
           IF DUP-RECH     = ZEROES
             IF FLAG-UPROG = ZEROES
               MOVE 000009 TO DUP-RECH
             ELSE
               GO TO P397.
           MOVE DUP-RECH TO DISZ6.
           DISPLAY " -> " LINE 23 COL 10
                   DISZ6  LINE 23 COL 15.
           IF DUP-RECH = ZEROES
             MOVE SPACES TO EBI-6
             ACCEPT EBI-6 WITH NO ADVANCING
             IF EBI-6 NUMERIC MOVE EBI-6N TO DUP-RECH.
      ******
      * D-NR FESTLEGEN
      ******
           MOVE DUP-RECH    TO D-RECH.
           MOVE 1           TO D-NR.
           MOVE ZEROES      TO D-CONNR.
           MOVE D-KEY       TO VGL-D-KEY.
           MOVE VGL-D-KEY   TO HE-FLTIDRU.
           MOVE ZEROES      TO D-NR, D-CONNR, D-AIRL, D-CODE, D-TICK
                              D-FARE1N, D-FARE2N, D-TAX1N, D-TAX2N
                              D-TAX3N, D-TOTN, D-PROZ, D-AGNR.
      *     MOVE USER-ID     TO D-USER-ID.
           MOVE "PCSI"      TO D-BEARB.
           MOVE LOW-VALUES  TO D-TIDATX.
           MOVE "N"         TO D-DRUCK.
           MOVE AMD-FILEKEY TO D-FILEKEY.
       P319.
           GO TO P390.
      ******
      * 'A-'-SEGMENT:
      ******
       P320.
           ADD 1 TO R-A-CNT.
           IF R-A-CNT > 1
             MOVE "R-A-CNT: > 1 R-A-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3 TO PNT-SEG.
       P321.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P324.
           ADD 1 TO C-CNT.
           IF C-CNT       > 2          GO TO P323.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P322.
      *******
      * DATA-ELEMENTS: A- VALIDATING CARRIER
      *******
      *      1 TICKETING AIRLINE NAME
      *      2 AIRLINE CODE
      *        AIRLINE NUMERIC CODE
      *        AIRLINE CHECK DIGIT
      *******
           IF C-CNT = 2
             MOVE UNST-T1 TO R-A-AIRLINE
             IF R-A-CODE NOT NUMERIC
               MOVE "R-A-CODE NOT NUMERIC" TO FFTEXT
               PERFORM FFF-F.
       P322.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P323.
           GO TO P321.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P323.
           MOVE R-A-CODEN TO D-AIRL.
       P324.
           GO TO P390.
      ******
      * 'D-'-SEGMENT:
      ******
       P325.
           ADD 1 TO R-D-CNT.
           IF R-D-CNT > 1
             MOVE "R-D-CNT: > 1 R-D-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3 TO PNT-SEG.
       P326.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P329.
           ADD 1 TO C-CNT.
           IF C-CNT       > 3          GO TO P328.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P327.
      *******
      * DATA-ELEMENTS: D- PNR DATE
      *******
      *      1 PNR CREATION DATE
      *      2 PNR CHANGE DATE
      *      3 AIR CREATION DATE
      *******
           IF C-CNT = 3
             MOVE UNST-T1 TO R-D-TIDAT
             IF R-D-TIDAT NOT NUMERIC
               MOVE "R-D-TIDAT NOT NUMERIC" TO FFTEXT
               PERFORM FFF-F.
       P327.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P328.
           GO TO P326.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P328.
           MOVE R-D-TIDATN TO D-TIDAT.
       P329.
           GO TO P390.
      ******
      * 'G-'-SEGMENT:
      ******
       P330.
           ADD 1 TO R-G-CNT.
           IF R-G-CNT > 1
             MOVE "R-G-CNT: > 1 R-G-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3 TO PNT-SEG.
       P331.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P334.
           ADD 1 TO C-CNT.
           IF C-CNT       > 3          GO TO P333.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P332.
      *******
      * DATA-ELEMENTS: G- SALES INDICATOR, ORIG/DESTINATION
      *******
      *      1
      *      2 SALES INDICATOR
      *      3 ORIG/DESTINATION
      *******
           IF C-CNT = 2
             MOVE UNST-T1 TO R-G-ISI.
           IF C-CNT = 3
             MOVE UNST-T1 TO R-G-ORIGDEST.
       P332.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P333.
           GO TO P331.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P333.
           MOVE R-G-ISI  TO D-ISI.
           MOVE R-G-ORIG TO D-ORIG-3L, L3-KEY.
 ee-  *    READ FLDAT INVALID MOVE SPACES TO L3-ORT.
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM READ-FLDAT1
 ee+       IF STAT--INVALID
 ee+         MOVE SPACES TO L3-ORT
 ee+       END-IF.
           MOVE L3-ORT   TO D-ORIG.
           MOVE R-G-DEST TO D-DEST-3L, L3-KEY.
 ee-  *    READ FLDAT INVALID MOVE SPACES TO L3-ORT.
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM READ-FLDAT1
 ee+       IF STAT--INVALID
 ee+         MOVE SPACES TO L3-ORT
 ee+       END-IF.
           MOVE L3-ORT   TO D-DEST.
       P334.
           GO TO P390.
      ******
      * 'H-'-SEGMENT:
      ******
       P335.
           ADD 1 TO R-H-CNT.
           IF R-H-CNT > 20
             MOVE "R-H-CNT: > 20 R-H-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3      TO PNT-SEG.
           MOVE SPACES TO R-H-ELEMENTE.
       P336.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P339.
           ADD 1 TO C-CNT.
           IF C-CNT       > 14         GO TO P338.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P337.
      *******
      * DATA-ELEMENTS: H- TICKETED AIR SEGMENT
      *                H- TICKETED SURFACE SEGMENT (AIRLINE-CODE = VOID)
      *******
      *      1
      *      2 SEG-NR IN PNR
      *        STOPOVER INDICATOR
      *        ORIG. 3LTR-CODE
      *      3 ORIG. CITY NAME
      *      4 DEST. 3LTR CODE
      *      5 DEST. CITY NAME
      *      6 AIRLINE-CODE        EVTL. -VOID-
      *        FLIGHTNUMBER
      *        CLASS OF SERVICE
      *        CLASS OF BOOKING
      *        DEP. DATE
      *        DEP. TIME
      *        ARR. TIME
      *        ARR. DATE
      *      7 STATUS AND NUMBER IN PARTY
      *      8 PNR-STATUS AND NUMBER IN PARTY
      *      9 MEAL CODE
      *     10 STOPS
      *     11 EQUIPMENT CODE
      *     12 ENTERTAINMENT CODE
      *     13
      *     14 BAGGAGE-CODE
      *     15
      *     16 CHECK-IN TIME
      *     17 ELECTRONIC TICKET INDICATOR
      *     18 DURATION
      *     19 NON-SMOKING INDICATOR
      *******
      * DATA-ELEMENTS: H- TICKETED OPEN SEGMENT (FLIGHTNUMBER = OPEN)
      *******
      *    1-6 WIE OBEN
      *      7 DEPATURE DATE (R-H-DATE)
      *      8 STATUS        (R-H-ST)
      *      9 BAGGAGE-CODE  (R-H-FREE)
      ********
           IF C-CNT = 2
             MOVE UNST-T1 TO R-H-ORIGX.
           IF C-CNT = 3
             MOVE UNST-T1 TO R-H-FROM.
           IF C-CNT = 4
             MOVE UNST-T1 TO R-H-ARR-3L.
           IF C-CNT = 5
             MOVE UNST-T1 TO R-H-ARR.
      **********
      * TIME: HHMHx x = P --> PM
      *               = A --> AM
      *               = N --> NOON
      *               = M --> MIDNIGHT
      ********
           IF C-CNT = 6
             MOVE UNST-T1 TO R-H-FLUG
             IF R-H-AP = "P"
               ADD 12 TO R-H-HH
             END-IF
             IF R-H-AP = "M"
               ADD 12 TO R-H-HH
             END-IF
             IF R-H-A-AP = "P"
               ADD 12 TO R-H-A-HH
             END-IF
             IF R-H-A-AP = "M"
               ADD 12 TO R-H-A-HH
             END-IF.
      *******
      * UNTERSCHIEDLICHE STRUKTUREN IN DIESEM SEGMENT
      *******
           IF R-H-FLY = "OPEN" GO TO P336A.
           IF C-CNT = 7
             MOVE UNST-T1 TO R-H-STATUS.
           IF C-CNT = 8
             MOVE UNST-T1 TO R-H-PNRSTATUS.
           IF C-CNT = 14
             MOVE UNST-T1 TO R-H-FREE.
           GO TO P337.
       P336A.
           IF C-CNT = 7
             MOVE UNST-T1 TO R-H-DATE.
           IF C-CNT = 8
             MOVE UNST-T1 TO R-H-STATUS.
           IF C-CNT = 9
             MOVE UNST-T1 TO R-H-FREE.
       P337.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P338.
           GO TO P336.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P338.
           IF R-H-X = "X"
             MOVE R-H-X      TO H-X (R-H-CNT).
           MOVE R-H-FROM-3L  TO H-FROM-3L (R-H-CNT), L3-KEY.
           MOVE R-H-FROM     TO H-FROM (R-H-CNT).
           MOVE SPACES       TO L3-ORT.
           IF R-H-FROM-3L = "AGB" OR "QKL" OR "ZWS" OR "QDU"
 ee-  *      READ FLDAT INVALID MOVE SPACES TO L3-ORT.
 ee+         MOVE 01 TO VIEW--KEYNUM
 ee+         PERFORM READ-FLDAT1
 ee+         IF STAT--INVALID
 ee+           MOVE SPACES TO L3-ORT
 ee+         END-IF.
           IF L3-ORT NOT = SPACES
             MOVE L3-ORT     TO H-FROM (R-H-CNT).
           IF R-H-CIA = "VOID"
             MOVE "VOID"     TO H-FLY (R-H-CNT), H-BEFORE (R-H-CNT)
             GO TO P339.
           MOVE R-H-CIA      TO H-CIA (R-H-CNT).
           MOVE R-H-FLY      TO H-FLY (R-H-CNT).
           MOVE R-H-CL       TO H-CL (R-H-CNT).
           MOVE R-H-DATE     TO H-DATE (R-H-CNT).
           MOVE R-H-TIME     TO H-TIME (R-H-CNT).
           MOVE R-H-ARR-TIME TO H-TIME2 (R-H-CNT).
           MOVE R-H-ST       TO H-ST (R-H-CNT).
           MOVE R-H-FREE     TO H-FREE (R-H-CNT).
           MOVE R-H-ARR-3L   TO H-ARR-3L (R-H-CNT), L3-KEY.
           MOVE R-H-ARR      TO H-ARR (R-H-CNT).
           MOVE SPACES       TO L3-ORT.
           IF R-H-ARR-3L = "AGB" OR "QKL" OR "ZWS" OR "QDU"
 ee-  *      READ FLDAT INVALID MOVE SPACES TO L3-ORT.
 ee+         MOVE 01 TO VIEW--KEYNUM
 ee+         PERFORM READ-FLDAT1
 ee+         IF STAT--INVALID
 ee+           MOVE SPACES TO L3-ORT
 ee+         END-IF.
           IF L3-ORT NOT = SPACES
             MOVE L3-ORT     TO H-ARR (R-H-CNT).
           MOVE R-H-ARR-DATE TO H-ARR-DATE (R-H-CNT).
           IF R-H-ARR-DATE = R-H-DATE OR SPACES GO TO P339.
           MOVE D-TIDAT      TO DATN.
           MOVE R-H-DATE     TO W-FL-TTMMM.
           PERFORM FLUG-DATUM.
           MOVE W-FL-DATN    TO B-DATN.
           MOVE R-H-ARR-DATE TO W-FL-TTMMM.
           PERFORM FLUG-DATUM.
           MOVE W-FL-DATN    TO DATN.
      *******
      * DIFFERENZ AB-DAT BIS AN-DAT
      *******
           PERFORM DATSUB.
           IF TAGE =  2 MOVE "*" TO  H-TIME2-X (R-H-CNT).
           IF TAGE =  1 MOVE "+" TO  H-TIME2-X (R-H-CNT).
           IF TAGE = -1 MOVE "#" TO  H-TIME2-X (R-H-CNT).
       P339.
           GO TO P390.
      ******
      * 'K-' -SEGMENT:
      * 'KN-'-SEGMENT
      * 'KS-'-SEGMENT
      ******
       P340.
           MOVE 3 TO PNT-SEG.
           IF SEG-TAG  = "K-"
             ADD 1 TO R-K-CNT.
           IF SEG-TAG3  = "KN-"
             MOVE 4 TO PNT-SEG
             ADD 1 TO R-KN-CNT.
           IF SEG-TAG3  = "KS-"
             MOVE 4 TO PNT-SEG
             ADD 1 TO R-KS-CNT.
           IF R-K-CNT > 1
             MOVE "R-K-CNT: > 1 R-K-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-KN-CNT > 1
             MOVE "R-KN-CNT: > 1 R-KN-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-KS-CNT > 1
             MOVE "R-KS-CNT: > 1 R-KS-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
      ******
      * LT. S.ADLER: FARE SEGMENT-HIERARCHIE : KN- DANN KS- DANN K-
      ******
           IF SEG-TAG3     = "KN-"
             MOVE SPACES TO R-K-ELEMENTE
             GO TO P341.
           IF SEG-TAG3     = "KS-"
             IF R-KN-CNT   = ZEROES
               MOVE SPACES TO R-K-ELEMENTE
               GO TO P341.
           IF SEG-TAG      = "K-"
             IF R-KN-CNT   = ZEROES
               IF R-KS-CNT = ZEROES
                 MOVE SPACES TO R-K-ELEMENTE
                 GO TO P341.
           GO TO P344.
       P341.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P344.
           ADD 1 TO C-CNT.
           IF C-CNT       > 13         GO TO P343.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P342.
      *******
      * DATA-ELEMENTS: K- FARE LINE
      *                KN- NETT FARE LINE
      *                KS- SELLING FARE LINE
      *******
      *      1 X(01)
      *        CURRENCY-CODE
      *        FARE-BASE
      *      2 CURRENCY-CODE
      *        EQUIVAL AMOUNT
      *     13 CURRENCY-CODE
      *        TOTAL AMOUNT
      *******
           IF C-CNT = 1
             MOVE UNST-T1 TO R-K-FARE1X.
           IF C-CNT = 2
             MOVE UNST-T1 TO R-K-FARE2X.
           IF C-CNT = 13
             MOVE UNST-T1 TO R-K-TOTAL.
       P342.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P343.
           GO TO P341.
      ******
      * REFERENZ FELDER FUELLEN: IN FLTIDRU: FARE2 IST DIE WICHTIGERE
      ******
       P343.
           MOVE R-K-FARE1-WS   TO D-FARE1X, D-FARE2X.
           MOVE R-K-FARE1      TO BIZEIL.
           PERFORM ZAHL.
           MOVE WS-PIZR        TO D-FARE1N, D-FARE2N.
           IF R-K-FARE2X NOT = SPACES
             IF R-K-FARE2-WS = "EUR"
               MOVE R-K-FARE2-WS TO D-FARE2X
               MOVE R-K-FARE2    TO BIZEIL
               PERFORM ZAHL
               MOVE WS-PIZR      TO D-FARE2N.
           MOVE R-K-TTL-WS     TO D-TOTX.
           MOVE R-K-TTL        TO BIZEIL.
           PERFORM ZAHL.
           MOVE WS-PIZR        TO D-TOTN.
       P344.
           GO TO P390.
      ******
      * 'KFT'-SEGMENT:
      * 'KNT'-SEGMENT:
      * 'KST'-SEGMENT:
      ******
       P345.
           IF SEG-TAG3 = "KFT"
             ADD 1 TO R-KFT-CNT.
           IF SEG-TAG3 = "KNT"
             ADD 1 TO R-KNT-CNT.
           IF SEG-TAG3 = "KST"
             ADD 1 TO R-KST-CNT.
           IF R-KFT-CNT > 1
             MOVE "R-KFT-CNT: > 1 R-KFT-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-KNT-CNT > 1
             MOVE "R-KNT-CNT: > 1 R-KNT-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-KST-CNT > 1
             MOVE "R-KST-CNT: > 1 R-KST-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 4      TO PNT-SEG.
           MOVE ZEROES TO X1.
      ******
      * LT. S.ADLER: FARE SEGMENT-HIERARCHIE : KNT DANN KST DANN KFT
      ******
           IF SEG-TAG3      = "KNT"
             MOVE SPACES TO R-KFT-ELEMENTE
             GO TO P346.
           IF SEG-TAG3      = "KST"
             IF R-KNT-CNT   = ZEROES
               MOVE SPACES TO R-KFT-ELEMENTE
               GO TO P346.
           IF SEG-TAG3      = "KFT"
             IF R-KNT-CNT   = ZEROES
               IF R-KST-CNT = ZEROES
                 MOVE SPACES TO R-KFT-ELEMENTE
                 GO TO P346.
           GO TO P349.
       P346.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P349.
           ADD 1 TO C-CNT.
           IF C-CNT       > 31         GO TO P348.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P347.
      *******
      * DATA-ELEMENTS: KFT TAX DATA
      *                KNT NETT TAX DATA
      *                KST SELLING TAX DATA
      *******
      * 2,..31 X(01)
      *        TAX CURRENCY-CODE
      *        TAX AMOUNT
      *        TAX CODE
      *******
           IF C-CNT > 1 AND < 32
             IF UNST-T1 NOT = SPACES
               ADD 1 TO X1
               MOVE UNST-T1 TO R-KFT-TAXX (X1).
       P347.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P348.
           GO TO P346.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P348.
           IF R-KFT-TAXX (1) NOT = SPACES
             MOVE R-KFT-WS (1)      TO D-TAX1X
             MOVE R-KFT-TAX (1)     TO BIZEIL
             PERFORM ZAHL
             MOVE WS-PIZR           TO D-TAX1N
             MOVE R-KFT-TAXLAND (1) TO D-TAX1LAND.
           IF R-KFT-TAXX (2) NOT = SPACES
             MOVE R-KFT-WS (2)      TO D-TAX2X
             MOVE R-KFT-TAX (2)     TO BIZEIL
             PERFORM ZAHL
             MOVE WS-PIZR           TO D-TAX2N
             MOVE R-KFT-TAXLAND (2) TO D-TAX2LAND.
           MOVE 1      TO POINT1.
           MOVE SPACES TO XT-FARECALC.
           IF R-KFT-TAXX (3) NOT = SPACES
             STRING  "XT "             DELIMITED BY SIZE
                     R-KFT-WS (3)      DELIMITED BY " "
                     " "               DELIMITED BY SIZE
                     R-KFT-TAX (3)     DELIMITED BY "  "
                     R-KFT-TAXLAND (3) DELIMITED BY " "
             INTO XT-FARECALC POINTER POINT1
             MOVE R-KFT-WS (3)      TO D-TAX3X
             MOVE R-KFT-TAX (3)     TO BIZEIL
             PERFORM ZAHL
             MOVE WS-PIZR           TO D-TAX3N
             MOVE R-KFT-TAXLAND (3) TO D-TAX3LAND.
      *****
      * UNTER DER VORRAUSSETZUNG, DASS TAX3 = SPACES ODER EUR :
      *****
           MOVE POINT1 TO POINT1-XT.
           MOVE 4      TO X1.
       P348A.
           IF R-KFT-TAXX (X1) NOT = SPACES
             IF R-KFT-WS (X1)     = "EUR"
               IF POINT1 = 1
                 STRING  "XT"             DELIMITED BY SIZE
                 INTO XT-FARECALC POINTER POINT1
               END-IF
               STRING  " "                DELIMITED BY SIZE
                       R-KFT-WS (X1)      DELIMITED BY " "
                       " "                DELIMITED BY SIZE
                       R-KFT-TAX (X1)     DELIMITED BY "  "
                       R-KFT-TAXLAND (X1) DELIMITED BY " "
               INTO XT-FARECALC POINTER POINT1
               MOVE R-KFT-WS (X1)    TO D-TAX3X
               MOVE R-KFT-TAX (X1)   TO BIZEIL
               PERFORM ZAHL
               ADD WS-PIZR TO D-TAX3N
               MOVE "XT"             TO D-TAX3LAND
             ELSE
               MOVE "XT NOT = EUR " TO FFTEXT
               PERFORM FFF-F.
           IF X1 < 30 ADD 1 TO X1 GO TO P348A.
           IF POINT1 = POINT1-XT
             MOVE SPACES TO XT-FARECALC
           ELSE
             MOVE POINT1 TO POINT1-XT.
       P349.
           GO TO P390.
      ******
      * 'Q-'-SEGMENT:
      ******
       P350.
           ADD 1 TO R-Q-CNT.
           IF R-Q-CNT > 1
             MOVE "R-G-CNT: > 1 R-Q-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3 TO PNT-SEG.
       P351.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P354.
           ADD 1 TO C-CNT.
           IF C-CNT       > 1          GO TO P353.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P352.
      *******
      * DATA-ELEMENTS: Q- SALES INDICATOR, ORIG/DESTINATION
      *******
      *      1 FARE CALCULATION
      *******
           IF C-CNT = 1
             MOVE UNST-T1 TO R-Q-CALC
             IF R-Q-CALC (241:190) NOT = SPACES
               MOVE "FARE CALC ZU UMFANGREICH" TO FFTEXT
               PERFORM FFF-F.
       P352.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P353.
           GO TO P351.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P353.
           MOVE R-Q-CALC (001:060) TO D-CALC (1).
           MOVE R-Q-CALC (061:120) TO D-CALC (2).
           MOVE R-Q-CALC (121:180) TO D-CALC (3).
           MOVE R-Q-CALC (181:240) TO D-CALC (4).
       P354.
           GO TO P390.
      ******
      * 'I-'-SEGMENT:
      ******
       P355.
           IF R-I-CNT = 1
             PERFORM TIDRU.
           ADD 1 TO R-I-CNT.
           IF R-I-CNT > 1
             MOVE "R-I-CNT: > 1 R-I-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3 TO PNT-SEG.
       P356.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P359.
           ADD 1 TO C-CNT.
           IF C-CNT       > 2          GO TO P358.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P357.
      *******
      * DATA-ELEMENTS: I- NAME
      *******
      *      1
      *      2 TEILNEHMER NUMMER IN PNR
      *        TEILNEHMER NAME
      *******
           IF C-CNT = 2
             MOVE UNST-T1 TO R-I-NAMEX.
       P357.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P358.
           GO TO P356.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P358.
           MOVE R-I-NAME TO D-NAM.
           MOVE R-I-LFDN TO D-TEILN-NR.
      ******
      * GEGEN TEILNEMER PRUEFEN
      ******
           PERFORM TIX-NAME.
       P359.
           GO TO P390.
      ******
      * 'T-'-SEGMENT:
      ******
       P360.
           ADD 1 TO R-T-CNT, T-CNT.
           IF R-T-CNT > 1
             MOVE "R-T-CNT: > 1 R-T-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3 TO PNT-SEG.
       P361.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P364.
           ADD 1 TO C-CNT.
           IF C-CNT       > 1          GO TO P363.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P362.
      *******
      * DATA-ELEMENTS: T- TICKER NUMBER
      *******
      *      1 TIX-TYP (A=ATB, T=TAT)
      *        "-"
      *        TIX-CODE
      *        TIX-NR
      *        "-"
      *        TIX-CONJ. (DIE LETZTEN 2 STELLEN)
      *******
           IF C-CNT = 1
             MOVE UNST-T1 TO R-T-TICKETNR
             IF R-T-CODEX NOT NUMERIC
               MOVE "R-T-CODE NOT NUMERIC" TO FFTEXT
               PERFORM FFF-F
             END-IF
             IF R-T-TIXX NOT NUMERIC
               MOVE "R-T-TIXX NOT NUMERIC" TO FFTEXT
               PERFORM FFF-F
             END-IF
             IF R-T-STRICH = "-"
               IF R-T-CONJX NOT NUMERIC
                 MOVE "R-T-TIXX NOT NUMERIC" TO FFTEXT
                 PERFORM FFF-F.
       P362.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P363.
           GO TO P361.
      ******
      * REFERENZ FELDER FUELLEN
      * -> PASSIERT IN P390ff
      ******
       P363.
       P364.
           GO TO P390.
      ******
      * 'FE'-SEGMENT:
      * 'FM'-SEGMENT:
      * 'FO'-SEGMENT:
      * 'FP'-SEGMENT:
      * 'FV'-SEGMENT:
      * 'FS'-SEGMENT:
      * 'FT'-SEGMENT:
      ******
       P365.
           IF SEG-TAG  = "FE"
             ADD 1 TO R-FE-CNT.
           IF SEG-TAG  = "FM"
             ADD 1 TO R-FM-CNT.
           IF SEG-TAG  = "FO"
             ADD 1 TO R-FO-CNT.
           IF SEG-TAG  = "FP"
             ADD 1 TO R-FP-CNT.
           IF SEG-TAG  = "FV"
             ADD 1 TO R-FV-CNT.
           IF SEG-TAG  = "FS"
             ADD 1 TO R-FS-CNT.
           IF SEG-TAG  = "FT"
             ADD 1 TO R-FT-CNT.
           IF R-FE-CNT > 1
             MOVE "R-FE-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-FM-CNT > 1
             MOVE "R-FM-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-FO-CNT > 1
             MOVE "R-FO-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-FP-CNT > 1
             MOVE "R-FP-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-FV-CNT > 1
             MOVE "R-FV-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-FS-CNT > 1
             MOVE "R-FS-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           IF R-FT-CNT > 1
             MOVE "R-FT-CNT: > 1 SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3      TO PNT-SEG.
           MOVE SPACES TO R-FF-TEXT.
       P366.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P369.
           ADD 1 TO C-CNT.
           IF C-CNT       > 1          GO TO P368.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P367.
      *******
      * DATA-ELEMENTS: FE ENDORSEMENT
      * DATA-ELEMENTS: FM FARE COMMISSION
      * DATA-ELEMENTS: FO ORIGINAL ISSUE /IN EXCAHNGE FOR
      * DATA-ELEMENTS: FP FORM OF PAYMENT
      * DATA-ELEMENTS: FV TICKETING CARRIER
      * DATA-ELEMENTS: FS MISC. TIX REMARKS
      * DATA-ELEMENTS: FT TOUR CODE
      *******
      *  FE  1 ENDORSEMENT/RESTRICTIONS
      *  FM  1 FM FARE COMMISSION
      *  FO  1 ORIGINAL ISSUE /IN EXCAHNGE FOR
      *  FP  1 FORM OF PAYMENT
      *  FV  1 TICKETING CARRIER
      *  FS  1 MISC. TIX REMARKS
      *  FT  1 TOUR CODE
      *******
           IF C-CNT = 1
             MOVE UNST-T1 TO R-FF-TEXT.
       P367.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P368.
           GO TO P366.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P368.
           IF SEG-TAG  = "FE"
             MOVE R-FF-TEXT (01:28) TO D-BEM
             MOVE R-FF-TEXT (29:28) TO D-BEM-2.
           IF SEG-TAG  = "FM"
             MOVE R-FF-TEXT TO BIZEIL
             IF R-FF-TEXT (1:3) = "*M*" OR "*C*" OR "*F*"
               MOVE R-FF-TEXT (4:10) TO BIZEIL
             END-IF
             IF R-FF-TEXT (1:4) = "*CR*"
               MOVE R-FF-TEXT (5:10) TO BIZEIL
             END-IF
             PERFORM ZAHL
             MOVE WS-PIZR   TO D-PROZ.
           IF SEG-TAG  = "FO"
             MOVE R-FF-TEXT TO D-ISSUE.
           IF SEG-TAG  = "FP"
             MOVE R-FF-TEXT TO D-PAYM.
      *     IF SEG-TAG  = "FV"
      *       MOVE R-FF-TEXT TO
           IF SEG-TAG  = "FS"
             IF D-BEM = SPACES
               MOVE R-FF-TEXT TO D-BEM
             ELSE
             IF D-BEM-2 = SPACES
               MOVE R-FF-TEXT TO D-BEM-2.
           IF SEG-TAG  = "FT"
             MOVE R-FF-TEXT TO D-TOURCODE.
       P369.
           GO TO P390.
      ******
      * 'M-'-SEGMENT: FARE BASIS CODES
      ******
       P370.
           ADD 1 TO R-M-CNT.
           IF R-M-CNT > 1
             MOVE "R-M-CNT: > 1 R-M-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3      TO PNT-SEG.
           MOVE ZEROES TO X1.
           MOVE SPACES TO R-M-ELEMENTE.
       P371.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P374.
           ADD 1 TO C-CNT.
           IF C-CNT       > 20         GO TO P373.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P372.
      *******
      * DATA-ELEMENTS: H- TICKETED AIR SEGMENT
      *******
      * 1,..28 PRIM-CODE
      *        FARE-BASIS
      *        TICKETDESIGNATOR
      *******
           IF C-CNT > 0 AND < 20
             ADD 1 TO X1
             MOVE UNST-T1 TO R-M-DATAX (X1).
       P372.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P373.
           GO TO P371.
      ******
      * REFERENZ FELDER FUELLEN
      ******
       P373.
           MOVE 1 TO X2, X3.
       P373A.
           IF H-FLY (X3) =  "VOID"
             IF X3 < 20 ADD 1 TO X3  GO TO P373A
             ELSE
               MOVE "X3 = 20 " TO FFTEXT
               PERFORM FFF-F.
           MOVE R-M-DATAX (X2) TO H-FAREBAS (X3).
           IF X2 < X1 ADD 1 TO X2, X3 GO TO P373A.
       P374.
           GO TO P390.
      ******
      * 'O-'-SEGMENT: VALIDITY DATES
      ******
       P375.
           ADD 1 TO R-O-CNT.
           IF R-O-CNT > 1
             MOVE "R-O-CNT: > 1 R-O-SEGMENTE" TO FFTEXT
             PERFORM FFF-F.
           MOVE 3      TO PNT-SEG.
           MOVE ZEROES TO X1.
           MOVE SPACES TO R-O-ELEMENTE.
       P376.
           PERFORM UNST-SEG-DATA.
           IF U-DELIM NOT = H-COMTERM  GO TO P379.
           ADD 1 TO C-CNT.
           IF C-CNT       > 20         GO TO P379.
           IF MAX-COM     = ZEROES OR
              UNST-T1     = SPACES     GO TO P377.
      *******
      * DATA-ELEMENTS: H- TICKETED AIR SEGMENT
      *******
      * 1,..28 NV BEFOR
      *        NV AFTER
      *******
           IF C-CNT > 0 AND < 20
             ADD 1 TO X1
             MOVE UNST-T1 TO R-O-VALIDITY (X1).
       P377.
           ADD 1, MAX-COM TO PNT-SEG.
           IF PNT-SEG > MAX-SEG GO TO P378.
           GO TO P376.
      ******
      * REFERENZ FELDER FUELLEN:
      ******
       P378.
           MOVE 1 TO X2, X3.
       P378A.
           IF H-FLY (X3) =  "VOID"
             IF X3 < 20 ADD 1 TO X3  GO TO P378A
             ELSE
               MOVE "X3 = 20 " TO FFTEXT
               PERFORM FFF-F.
           MOVE R-O-VALIDITY (X2) TO BIZEIL.
           IF EBI-2 = "XX"
             MOVE SPACES       TO R-O-BEFORE (X2)
             MOVE BIZEIL (3:5) TO R-O-AFTER (X2).
           MOVE R-O-AFTER (X2) TO BIZEIL.
           IF EBI-2 = "XX"
             MOVE SPACES       TO R-O-AFTER (X2).
           MOVE R-O-BEFORE (X2) TO H-BEFORE (X3).
           MOVE R-O-AFTER (X2)  TO H-AFTER (X3).
           IF X2 < X1 ADD 1 TO X2, X3 GO TO P378A.
       P379.
           GO TO P390.
       P390.
           ADD MAX-SEG, 1 TO PNT-MSG.
           IF PNT-MSG < MAX-MSG GO TO P310.
       P392.
           IF R-I-CNT NOT = R-T-CNT
             MOVE "R-I-CNT NOT = R-T-CNT" TO FFTEXT
             PERFORM FFF-F
           ELSE
             IF R-I-CNT   = ZEROES GO TO P395
             ELSE
               PERFORM TIDRU.
      ******
      * NORMAL: --> MOVE NACH BSP-OK
      ******
       P395.
           IF T-CNT = ZEROES GO TO P397A.
           GO TO P399.
           MOVE SPACES TO BEFEHL.
           STRING "mv "               DELIMITED BY SIZE
                  FILENAME            DELIMITED BY "   "
                  " /transx1/bsp-ok/" DELIMITED SIZE
                  DIR-FILE            DELIMITED BY "   "
           INTO BEFEHL.
           CALL "SYSTEM" USING BEFEHL GIVING DAT-STAT.
           GO TO P399.
       P397.
      *****
      * PRUEFEN OB EVTL. TMG-PNR OHNE TIX-NR
      *****
           IF FLAG-LAUF  = 1
             MOVE SPACES TO BEFEHL
             STRING "mv "                  DELIMITED BY SIZE
                    FILENAME               DELIMITED BY "   "
                    " /transx1/bsp-notok/" DELIMITED SIZE
                    DIR-FILE               DELIMITED BY "   "
             INTO BEFEHL
             CALL "SYSTEM" USING BEFEHL GIVING DAT-STAT.
           IF FLAG-LAUF    = 3
             IF AMD-IATANR = "23226000" GO TO P397B.
           GO TO P399.
       P397A.
           MOVE SPACES TO BEFEHL.
           STRING "mv "                  DELIMITED BY SIZE
                  FILENAME               DELIMITED BY "   "
                  " /transx1/bsp-not7a/" DELIMITED SIZE
                  DIR-FILE               DELIMITED BY "   "
           INTO BEFEHL
           CALL "SYSTEM" USING BEFEHL GIVING DAT-STAT.
           GO TO P399.
       P397B.
           MOVE SPACES TO BEFEHL.
           STRING "mv "                  DELIMITED BY SIZE
                  FILENAME               DELIMITED BY "   "
                  " /transx1/bsp-tmg/" DELIMITED SIZE
                  DIR-FILE               DELIMITED BY "   "
           INTO BEFEHL
           CALL "SYSTEM" USING BEFEHL GIVING DAT-STAT.
           GO TO P399.
       P399.  EXIT.
       TIDRU SECTION.
      ******
      * FLTIDRU SCHREIBEN
      ******
       P160.
           IF R-H-CNT = 0
             MOVE "R-H-CNT = 0" TO FFTEXT
             PERFORM FFF-F
             GO TO P169.
           IF R-I-CNT = 0
             MOVE "R-I-CNT = 0" TO FFTEXT
             PERFORM FFF-F
             GO TO P169.
           IF R-T-CNT = 0
             MOVE "R-T-CNT = 0" TO FFTEXT
             PERFORM FFF-F
             GO TO P169.
      ******
      * XT-FARECALC IN FARE CALC UNTERBRINGEN
      ******
           IF XT-FARECALC NOT = SPACES
             MOVE SPACES TO BIZEIL
             STRING D-CALCOCC   DELIMITED BY "END   "
                    "END "      DELIMITED BY SIZE
                    XT-FARECALC DELIMITED BY "  "
             INTO BIZEIL
             MOVE BIZEIL TO D-CALCOCC
             MOVE SPACES TO XT-FARECALC.
      ******
      * D-NR FESTLEGEN
      ******
           MOVE VGL-D-NR   TO Z.
           MOVE HE-FLTIDRU TO DUP-FLTIDRU.
       P162.
           MOVE Z          TO D-NR.
           MOVE ZERO       TO D-CONNR.
           MOVE D-KEY      TO VGL-D-KEY.
           MOVE 99         TO VGL-D-CONNR.
 ee-  *    START FLTIDRU KEY NOT < D-KEY INVALID GO TO P162A.
 ee+       MOVE "NL" TO VIEW--STRMOD
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM START-FLTIDRU1
 ee+       IF STAT--INVALID
 ee+         GO TO P162A
 ee+       END-IF.
 ee-  *    READ FLTIDRU NEXT                 END GO TO P162A.
 ee+       PERFORM READ-FLTIDRU1-NEXT
 ee+       IF STAT--ATEND
 ee+         GO TO P162A
 ee+       END-IF.
           IF D-KEY > VGL-D-KEY
             MOVE VGL-D-KEY TO D-KEY GO TO P162A.
           IF Z < 999 ADD 1 TO Z     GO TO P162.
           GO TO FF-LFD.
       P162A.
           MOVE DUP-FLTIDRU TO HE-FLTIDRU.
           MOVE VGL-D-KEY   TO D-KEY.
      ******
      * PLAUSIB. CONJUNCTION
      ******
           MOVE ZEROES TO D-CONNR.
           IF R-T-CONJX NUMERIC
             MOVE 1    TO D-CONNR.
           IF R-H-CNT   < 5
             IF D-CONNR > ZEROES
               MOVE "CONNR > 0 UND R-H-CNT < 5" TO FFTEXT
               PERFORM FFF-F.
           IF R-H-CNT   > 4
             IF D-CONNR = ZEROES
               MOVE "CONNR = 0 UND R-H-CNT > 4" TO FFTEXT
               PERFORM FFF-F.
      *****
      * MAX-CONNR BELEGEN
      *****
           MOVE ZEROES     TO MAX-CONNR.
           IF D-CONNR   = ZEROES     GO TO P163.
           IF R-T-CONJN = R-T-TIX-RN GO TO P163.
           MOVE 1          TO MAX-CONNR.
           MOVE R-T-TIX-RN TO EBI-2N.
       P162B.
           IF EBI-2N = R-T-CONJN GO TO P163.
           ADD 1 TO MAX-CONNR, EBI-2N.
           GO TO P162B.
       P163.
           IF MAX-CONNR > 8
             MOVE "MAX-CONNR > 8   " TO FFTEXT
             PERFORM FFF-F.
      ******
      * D-MWSTKZ BELEGEN
      ******
           MOVE 1   TO X3.
           MOVE "D" TO D-MWSTKZ.
       P163A.
           IF H-FROM-3L (X3) = SPACES  GO TO P164.
           MOVE H-FROM-3L (X3) TO L3-KEY.
 ee-  *    READ FLDAT INVALID          GO TO P163B.
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM READ-FLDAT1
 ee+       IF STAT--INVALID
 ee+         GO TO P163B
 ee+       END-IF.
           IF L3-INLAND  NOT = "J"     GO TO P163B.
           IF H-ARR-3L (X3)  = SPACES  GO TO P164.
           MOVE H-ARR-3L (X3)  TO L3-KEY.
 ee-  *    READ FLDAT INVALID          GO TO P163B.
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM READ-FLDAT1
 ee+       IF STAT--INVALID
 ee+         GO TO P163B
 ee+       END-IF.
           IF L3-INLAND  NOT = "J"     GO TO P163B.
           IF X3 < R-H-CNT ADD 1 TO X3 GO TO P163A.
           GO TO P164.
       P163B.
           MOVE SPACE TO D-MWSTKZ.
       P164.
           IF D-MWSTKZ = "D"
             MOVE "D-MWSTKZ = D    " TO FFTEXT
             PERFORM FFF-F.
      *****
      * 3L-CODE DES GES. ITINERARY IN TEXT-RR
      *****
           MOVE SPACES       TO TEXT-RR.
           MOVE 1            TO POINT1-RR.
           STRING "REISE-ROUTE: "  DELIMITED BY SIZE
                  H-FROM-3L (1)    DELIMITED BY SIZE
                  "-"              DELIMITED BY SIZE
                  H-ARR-3L (1)     DELIMITED BY SIZE
           INTO TEXT-RR POINTER POINT1-RR.
           MOVE H-ARR-3L (1) TO W-ARR.
           MOVE 2            TO X1.
       P164A.
           IF H-FROM-3L (X1) NOT = W-ARR
             STRING " "            DELIMITED BY SIZE
                    H-FROM-3L (X1) DELIMITED BY SIZE
             INTO TEXT-RR POINTER POINT1-RR.
           IF H-ARR-3L (X1) NOT = SPACES
             STRING "-"            DELIMITED BY SIZE
                    H-ARR-3L (X1)  DELIMITED BY SIZE
             INTO TEXT-RR POINTER POINT1-RR.
           MOVE H-ARR-3L (X1) TO W-ARR.
           IF H-FLUGDATEN (X1) = SPACES GO TO P166.
           IF X1 < R-H-CNT ADD 1 TO X1  GO TO P164A.
       P166.
           MOVE R-T-CODEN TO D-CODE
           MOVE R-T-TIXN  TO D-TICK.
           MOVE SPACES    TO D-FLUGDATENOCC.
      *****
      * GES. ITINERARY IN 4ER PORTIONEN AUFTEILEN
      *****
           MOVE 1         TO X1, X2.
       P166A.
           IF H-FLUGDATEN (X1) NOT = SPACES
             MOVE H-FLUGDATEN (X1) TO D-FLUGDATEN (X2)
             IF X2 < 4
               ADD 1 TO X2 GIVING X3
               MOVE SPACES         TO D-X (X3)
               MOVE H-ARR-3L (X1)  TO D-FROM-3L (X3)
               MOVE H-ARR (X1)     TO D-FROM (X3).
           IF X2 < 4 ADD 1 TO X1, X2 GO TO P166A.
           MOVE SPACES             TO D-TOX.
           MOVE H-ARR-3L (X1)      TO D-TO-3L.
           MOVE H-ARR (X1)         TO D-TO.
      ********
      * EVTL. 'KLASSE' UPDATE PER REWRITE!
      ********
           MOVE HE-FLTIDRU         TO DUP-FLTIDRU.
           MOVE D-KEY              TO VGL-DD-KEY.
           MOVE ZEROES             TO D-NR, D-CONNR.
 ee-  *    START FLTIDRU KEY NOT < D-KEY INVALID GO TO P166Z.
 ee+       MOVE "NL" TO VIEW--STRMOD
 ee+       MOVE 01 TO VIEW--KEYNUM
 ee+       PERFORM START-FLTIDRU1
 ee+       IF STAT--INVALID
 ee+         GO TO P166Z
 ee+       END-IF.
       P166B.
 ee-  *    READ FLTIDRU NEXT                 END GO TO P166Z.
 ee+       PERFORM READ-FLTIDRU1-NEXT
 ee+       IF STAT--ATEND
 ee+         GO TO P166Z
 ee+       END-IF.
           IF D-RECHX NOT = VGL-D-RECHX          GO TO P166Z.
           IF D-TINR  NOT = DUP-TINR             GO TO P166B.
           MOVE D-USER-ID   TO DUP-USER-ID.
           MOVE D-USER-STOP TO DUP-USER-STOP.
           MOVE D-WV        TO DUP-WV.
           MOVE D-TEILN-NRX TO DUP-TEILN-NRX.