       IDENTIFICATION DIVISION.
       PROGRAM-ID.  SOFCRIPS.
       AUTHOR.      LIMES DATENTECHNIK GMBH.

      *           EXAMPLE FOR SEPA MASS AND INSTANT PAYMENT
      *                   USING FLUC RECORD INTERFACE
      *
      *  SOFCRIPS READS VIA THE FLUC-RECORD-INTERFACE A XML-SEPA-FILE
      *  INTO SEVERAL FIX RECORDS (OVERLAY). IT CONVERTS THESE FIX
      *  RECORDS OVER THE MEMORY-TO-MEMORY INTERFACE INTO AN XML-SEPA-
      *  TRANSACTION. IN A SECOND CONVERSION STEP THIS SEPA-INSTANT-
      *  PAYMENT-TRANSACTION IS CONVERTED BACK INTO THE CORRESBONDING
      *  FIX RECORD FORMAT USING AUTO DETECTION. AT THE END THE FIX
      *  RECORD IS WRITTEN OVER THE MEMORY-TO-FILE INTERFACE BACK INTO
      *  THE ORIGINAL SEPA-XML-FORMAT.
      *
      *  THE EXAMPLE SHOWS THE END OF TABLE (EOT) HANDLING WITH THE
      *  CORRESPONDING CHANGE OF THE TRANSACTION TYPES AND USING THE
      *  LOGGING FACILITY TO SHOW WARNINGS IF SOMETHING IS WRONG IN
      *  THE XML DATA.
      *
      *  THE SAMPLE CONTAINS MF-EDZ WORKAROUNDS (IN COMMENTS). THE
      *  POINTER TO LOCATE THE RECORDS, AVOIDING A COPY, ARE CURRENTLY
      *  NOT USABLE IN MF-EDZ ENVIRONMENTS. ADDITIONALLY YOU CAN NOT
      *  PROVIDE A POINTER TO OUR DATA WITH THE BY VALUE CLAUSE AS INPUT
      *  IN A MF-EDZ ENVIRONMENT.
      *
      *  THE USE OF THE PROGRAM IS DOCUMENTED IN THE CORRESPONDING
      *  JOBLIB MEMBER.
      *
      *  DD-NAMES USED IN THIS EXAMPLE:
      *
      *    INPUT  THE FILE FLUC HAS TO READ
      *    OUTPUT THE FILE FLUC HAS TO WRITE
      *    XMLTAB XML TABLE SPECIFICATION
      *    FIXTAB FIX TABLE SPECIFICATION

       ENVIRONMENT DIVISION.

       INPUT-OUTPUT SECTION.

       DATA DIVISION.

       WORKING-STORAGE SECTION.

       77  REC-COUNT                     PIC 9(8)  COMP VALUE 0.
       77  MAXTRCLEN                     PIC 9(8)  COMP VALUE 4096.
       77  MAXTABLEN                     PIC 9(8)  COMP VALUE 128.
       77  MAXSTATLEN                    PIC 9(8)  COMP VALUE 0.
       77  MAXCLSBUFFLEN                 PIC 9(8)  COMP VALUE 4096.
       77  MAXFILELEN                    PIC 9(8)  COMP VALUE 256.

       77  OPERATION                     PIC X(30).
           88 OPERATION-OPEN-LOG         VALUE 'OPEN-LOG'.
           88 OPERATION-CLEAR-LOG        VALUE 'CLEAR-LOG'.
           88 OPERATION-CLOSE-LOG        VALUE 'CLOSE-LOG'.
           88 OPERATION-OPEN-INPUT       VALUE 'OPEN-INPUT'.
           88 OPERATION-OPEN-OUTPUT      VALUE 'OPEN-OUTPUT'.
           88 OPERATION-OPEN-CONV-F2X    VALUE 'OPEN-CONV-F2X'.
           88 OPERATION-OPEN-CONV-X2F    VALUE 'OPEN-CONV-X2F'.
           88 OPERATION-GET-TABNAME-R    VALUE 'GET-TABNAME-READ'.
           88 OPERATION-GET-TABNAME-C    VALUE 'GET-TABNAME-CONVERT'.
           88 OPERATION-SET-TABNAME-W    VALUE 'SET-TABNAME-WRITE'.
           88 OPERATION-SET-TABNAME-C    VALUE 'SET-TABNAME-CONVERT'.
           88 OPERATION-GET-FILENAME     VALUE 'GET-FILENAME'.
           88 OPERATION-READ-INPUT       VALUE 'READ-INPUT'.
           88 OPERATION-CONVERT-INPUT    VALUE 'CONVERT-INPUT'.
           88 OPERATION-CONVERT-OUTPUT   VALUE 'CONVERT-OUTPUT'.
           88 OPERATION-CHECK-LOG        VALUE 'CHECK-LOG'.
           88 OPERATION-XML-WRITE        VALUE 'XML-WRITE'.
           88 OPERATION-CLOSE-CONV-F2X   VALUE 'CLOSE-CONV-F2X'.
           88 OPERATION-CLOSE-CONV-X2F   VALUE 'CLOSE-CONV-X2F'.
           88 OPERATION-CLOSE-INPUT      VALUE 'CLOSE-INPUT'.
           88 OPERATION-CLOSE-OUTPUT     VALUE 'CLOSE-OUTPUT'.
           88 OPERATION-FLUSH-OUTPUT     VALUE 'FLUSH-OUTPUT'.

       77  DISP-LEN                      PIC 9(8)  COMP VALUE ZERO.
       77  DISP-AREA                     PIC X(4096).
       77  DISP-DLM                      PIC X.
       77  DISP-PTR                      PIC 9(8)  COMP VALUE 1.
       77  DISP-NUM                      PIC ZZZZZZZ9.

      *    ALL CALLS
       01  F-STATLEN                  PIC S9(8) COMP  SYNC VALUE 512.
       01  F-STAT                     PIC X(512)      VALUE SPACES.
       01  F-RETCO                    PIC S9(8) COMP  VALUE 0.
           88 F-RETCO-OK              VALUE  0.
           88 F-RETCO-END-OF-FILE     VALUE  43.
           88 F-RETCO-END-OF-TABLE    VALUE  138.

      *    ALL INPUT CALLS
       01  F-ID-IN                    PIC S9(8) COMP.

      *    ALL OUTPUT CALLS
       01  F-ID-OUT                   PIC S9(8) COMP.

      *    FCROPN TO READ
       01  F-FILEL-IN                 PIC S9(8) COMP VALUE 60.
       01  F-FILE-IN                  PIC X(60)
              VALUE 'READ.CHAR(FILE=''DD:INPUT'' TABLE=''DD:XMLTAB'')'.
       01  F-FORML-IN                 PIC S9(8) COMP SYNC VALUE 40.
       01  F-FORM-IN                  PIC X(40)
              VALUE 'FORMAT.RECORD(TABLE=''DD:FIXTAB'')'.

      *    FCROPN TO WRITE
       01  F-FILEL-OUT                PIC S9(8) COMP VALUE 80.
       01  F-FILE-OUT                 PIC X(80) VALUE
             'WRITE.RECORD(FILE=DD:OUTPUT TABLE=DD:XMLTAB CCSID=1141)'.
       01  F-FORML-OUT                PIC S9(8) COMP SYNC VALUE 40.
       01  F-FORM-OUT                 PIC X(40)
              VALUE 'FORMAT.RECORD(TABLE=DD:FIXTAB)'.

      *    FCROPNV CONVERTER 1
       01  C1-ID                      PIC S9(8) COMP.
       01  C1-DATLEN                  PIC S9(8) COMP VALUE 100.
       01  C1-DATA                    PIC X(100)
              VALUE 'CONV.MEMORY(READ.RECORD(TABLE=DD:FIXTAB)
      -             'WRITE.CHAR(TABLE=DD:XMLTAB CCSID=UTF-8))'.

      *    FCROPNV CONVERTER 2
       01  C2-ID                      PIC S9(8) COMP.
       01  C2-DATLEN                  PIC S9(8) COMP VALUE 100.
       01  C2-DATA                    PIC X(100)
              VALUE 'CONV.MEMORY(READ.CHAR(TABLE=DD:XMLTAB)
      -             'WRITE.RECORD(TABLE=DD:FIXTAB))'.

      *    FCROPNL LOGGING
       01  LOG-RETCO                  PIC S9(8) COMP VALUE ZERO.
           88 LOG-RETCO-OK            VALUE  0.

       01  LOG-DATLEN                 PIC S9(8) COMP VALUE 80.
       01  LOG-DATA                   PIC X(80)
           VALUE 'LOG(IDENT=IPS,FORMAT=DIALOG MESSAGE(WARNING))'.

      *    FCRTRC
       01  TRCRC                      PIC S9(8) COMP.
       01  TRCLEN                     PIC S9(8) COMP VALUE 4096.
       01  TRCBUFF                    PIC X(4096) VALUE SPACES.

      *    FCRCLS
       01  CLS-DELETE                 PIC S9(8) COMP VALUE 0.
       01  CLS-STATFMT                PIC S9(8) COMP VALUE 1.
       01  CLS-STATLB                 PIC S9(8) COMP VALUE 4096.
       01  CLS-STATBUF                PIC X(4096) VALUE LOW-VALUES.

      *    FCRGTN / FCRSTN
       01  GTN-TABNLEN-READ           PIC 9(8)  COMP VALUE 128.
       01  GTN-TABNAME-READ           PIC X(128) VALUE SPACES.
       01  GTN-TABNLEN-CONVERT        PIC 9(8)  COMP VALUE 128.
       01  GTN-TABNAME-CONVERT        PIC X(128) VALUE SPACES.
       01  STN-TABNLEN-CONVERT        PIC 9(8)  COMP VALUE 128.
       01  STN-TABNAME-CONVERT        PIC X(128) VALUE SPACES.
       01  STN-TABNLEN-WRITE          PIC 9(8)  COMP VALUE 128.
       01  STN-TABNAME-WRITE          PIC X(128) VALUE SPACES.

      *    FCRGFN
       01  GFN-FILENLEN               PIC 9(8) COMP VALUE 128.
       01  GFN-FILENAME               PIC X(256) VALUE SPACES.
       01  GFN-INDEX                  PIC 9(8) COMP VALUE 0.

      *    FCRLOC
       01  LOC-DATLEN                 PIC 9(8)  COMP.
       01  LOC-DATPTR                 USAGE IS POINTER.

      *    FCRONP
       01  ONP-DATLEN                 PIC 9(8)  COMP.
       01  ONP-DATPTR                 USAGE IS POINTER.

      *    FCRPUT
       01  PUT-DATLEN                 PIC 9(8)  COMP.
       01  PUT-DATPTR                 USAGE IS POINTER.

      *    FCRGETL
       01  LOG-DATPTR                 USAGE IS POINTER.

      *    FCRSYM
       01  SYM-RETCO                  PIC S9(8) COMP VALUE ZERO.
           88 SYM-RETCO-OK            VALUE  0.
       01  SYM-SYSNAME-SIZE           PIC 9(8)  COMP VALUE 16.
       01  SYM-SYSNAME-LENGTH         PIC 9(8)  COMP VALUE 7.
       01  SYM-SYSNAME-STRING         PIC X(128) VALUE "SYSNAME".

      *    FIELDS REQUIERED FOR EDZ WORKAROUND
       01  LOCAL-LOC-DAT-DATA         PIC X(65536).
       01  LOCAL-ONP-DAT-DATA         PIC X(65536).
       01  LOCAL-PUT-DAT-DATA         PIC X(65536).
       01  LOCAL-LOG-DAT-DATA         PIC X(65536).

       LINKAGE SECTION.

       01  DISP-BUFFER                PIC X(65536).

       01  LINK-LOC-DAT-DATA          PIC X(65536).
       01  LINK-ONP-DAT-DATA          PIC X(65536).
       01  LINK-PUT-DAT-DATA          PIC X(65536).

       PROCEDURE DIVISION.

      *----------------------------------------------------------------
      *    Main
      *----------------------------------------------------------------

       MAIN SECTION.

      * Open all the required handles
           PERFORM S-FLUC-GET-SYSTEM-NAME
           PERFORM S-FLUC-OPEN-INPUT-X2F
           PERFORM S-FLUC-OPEN-CONVERTER-F2X
           PERFORM S-FLUC-OPEN-CONVERTER-X2F
           PERFORM S-FLUC-OPEN-OUTPUT-F2X

      * Open log and determine initial table names
           PERFORM S-FLUC-OPEN-LOG
           PERFORM S-FLUC-GET-TABNAME-READ
           PERFORM S-FLUC-GET-TABNAME-CONVERT

      * Read record per record over the file (main loop)
           PERFORM R-FLUC-READ-X2F
           PERFORM UNTIL NOT F-RETCO-OK
              ADD 1 TO REC-COUNT
              PERFORM R-FLUC-CONVERT-F2X
              PERFORM R-FLUC-CONVERT-X2F
              PERFORM R-FLUC-WRITE-F2X
              PERFORM R-FLUC-READ-X2F
           END-PERFORM
      * Flush and get filename
           PERFORM S-FLUC-FLUSH-OUTPUT
           PERFORM R-FLUC-GET-FILENAME

      * Close all the handles and the log
           PERFORM S-FLUC-CLOSE-OUTPUT-F2X
           PERFORM S-FLUC-CLOSE-CONVERTER-X2F
           PERFORM S-FLUC-CLOSE-CONVERTER-F2X
           PERFORM S-FLUC-CLOSE-INPUT-X2F
           PERFORM S-FLUC-CLOSE-LOG

      * Print protocol as last step
           PERFORM S-FLUC-PROTOCOL

           MOVE F-RETCO TO RETURN-CODE

           STOP RUN.

      *----------------------------------------------------------------
      *    Routinen
      *----------------------------------------------------------------

       R-FLUC-READ-X2F SECTION.

      * Read a FIX record from XML file with locate function
      *    PERFORM S-FLUC-READ-INPUT-LOC
      * Corresponding copy function only as workaraound for MF-EDZ
           PERFORM S-FLUC-READ-INPUT-GET

      * Handle EOT and read the record after table change again
           IF F-RETCO-END-OF-TABLE THEN
              PERFORM S-FLUC-CLEAR-LOG
              PERFORM S-FLUC-GET-TABNAME-READ
      *       PERFORM S-FLUC-READ-INPUT-LOC
              PERFORM S-FLUC-READ-INPUT-GET
           END-IF

           EXIT.

       R-FLUC-CONVERT-F2X SECTION.

      * If table change then set new table name for write conversion
           IF GTN-TABNAME-READ NOT = STN-TABNAME-CONVERT THEN
              MOVE GTN-TABNLEN-READ TO STN-TABNLEN-CONVERT
              MOVE GTN-TABNAME-READ TO STN-TABNAME-CONVERT
              PERFORM S-FLUC-SET-TABNAME-CONVERT
           END-IF

      * Convert record from FIX to XML in memory with locate function
      *    PERFORM S-FLUC-CONVERT-F2X-CONP
      * Corresponding copy function only as workaraound for MF-EDZ
           PERFORM S-FLUC-CONVERT-F2X-CONV

           EXIT.

       R-FLUC-CONVERT-X2F SECTION.

      * Convert record from XML to FIX in memory with locate function
      *    PERFORM S-FLUC-CONVERT-X2F-CONP
      * Corresponding copy function only as workaraound for MF-EDZ
           PERFORM S-FLUC-CONVERT-X2F-CONV

      * Handle EOT and convert the record after table change again
           IF F-RETCO-END-OF-TABLE THEN
              PERFORM S-FLUC-CLEAR-LOG
              PERFORM S-FLUC-GET-TABNAME-CONVERT
      *       PERFORM S-FLUC-CONVERT-X2F-CONP
              PERFORM S-FLUC-CONVERT-X2F-CONV
           END-IF

      * Check the log for warnings
           PERFORM S-FLUC-CHECK-LOG

           EXIT.

       R-FLUC-WRITE-F2X SECTION.

      * If table change then set new table name for write to file
           IF GTN-TABNAME-CONVERT NOT = STN-TABNAME-WRITE THEN
              MOVE GTN-TABNLEN-CONVERT TO STN-TABNLEN-WRITE
              MOVE GTN-TABNAME-CONVERT TO STN-TABNAME-WRITE
              PERFORM S-FLUC-SET-TABNAME-WRITE
           END-IF

      * Write FIX record to XML file based on pointer
      *    PERFORM S-FLUC-WRITE-OUTPUT-PUT-P
      * Corresponding copy function only as workaraound for MF-EDZ
           PERFORM S-FLUC-WRITE-OUTPUT-PUT-D

           EXIT.


      *----------------------------------------------------------------
      *    Sub-Routinen
      *----------------------------------------------------------------

      * Call FLUC record interface to determine the system name
       S-FLUC-GET-SYSTEM-NAME SECTION.

           SET OPERATION-OPEN-LOG TO TRUE

           CALL 'FCRSYM' USING SYM-RETCO,
                               SYM-SYSNAME-LENGTH,
                               SYM-SYSNAME-STRING,
                               SYM-SYSNAME-SIZE,
                               SYM-SYSNAME-STRING
           MOVE SYM-SYSNAME-SIZE TO SYM-SYSNAME-LENGTH

           DISPLAY 'FCRSYM RETCO : ' SYM-RETCO UPON CONSOLE
           DISPLAY 'SYSTEM LENGTH: ' SYM-SYSNAME-LENGTH UPON CONSOLE
           DISPLAY 'SYSTEM NAME  : ' SYM-SYSNAME-STRING UPON CONSOLE

           EXIT.

      * Call FLUC record interface to open for logging facility
       S-FLUC-OPEN-LOG SECTION.

           SET OPERATION-OPEN-LOG TO TRUE

           CALL 'FCROPNL' USING LOG-RETCO, LOG-DATLEN, LOG-DATA

           PERFORM T-FLUC-LOG-RC

           EXIT.

      * Call FLUC record interface to open the input file (XML->FIX)
       S-FLUC-OPEN-INPUT-X2F SECTION.

           SET OPERATION-OPEN-INPUT TO TRUE

           MOVE MAXSTATLEN TO F-STATLEN

           CALL 'FCROPN'  USING F-ID-IN, F-RETCO,
                                F-FILEL-IN, F-FILE-IN,
                                F-FORML-IN, F-FORM-IN,
                                F-STATLEN, F-STAT

           PERFORM T-FLUC-RC

           EXIT.

      * Call FLUC record interface to open the output file (FIX->XML)
       S-FLUC-OPEN-OUTPUT-F2X SECTION.

           SET OPERATION-OPEN-OUTPUT TO TRUE

           CALL 'FCROPN' USING F-ID-OUT, F-RETCO,
                               F-FILEL-OUT, F-FILE-OUT,
                               F-FORML-OUT, F-FORM-OUT,
                               F-STATLEN, F-STAT

           PERFORM T-FLUC-RC

           EXIT.

      * Call FLUC record interface to open 1 converter (FIX->XML)
       S-FLUC-OPEN-CONVERTER-F2X SECTION.

           SET OPERATION-OPEN-CONV-F2X TO TRUE

           CALL 'FCROPNV' USING F-ID-IN, C1-ID, F-RETCO,
                                C1-DATLEN, C1-DATA

           PERFORM T-FLUC-RC

           EXIT.

      * Call FLUC record interface to open 2 converter (XML->FIX)
       S-FLUC-OPEN-CONVERTER-X2F SECTION.

           SET OPERATION-OPEN-CONV-X2F TO TRUE

           CALL 'FCROPNV' USING C1-ID, C2-ID, F-RETCO,
                                C2-DATLEN, C2-DATA

           PERFORM T-FLUC-RC

           EXIT.

      * Clear log after EOT handling to remove EOT log entries
       S-FLUC-CLEAR-LOG SECTION.

           SET OPERATION-CLEAR-LOG TO TRUE

           CALL 'FCRCLRL' USING OMITTED

           EXIT.

      * Determine table name and activate auto detection for read
       S-FLUC-GET-TABNAME-READ SECTION.

           SET OPERATION-GET-TABNAME-R TO TRUE

           MOVE MAXTABLEN TO GTN-TABNLEN-READ
           MOVE SPACES TO GTN-TABNAME-READ

           CALL 'FCRGTN' USING F-ID-IN, F-RETCO,
                               GTN-TABNLEN-READ, GTN-TABNAME-READ

           PERFORM T-FLUC-RC

           DISPLAY 'TABLE NAME READ: ' GTN-TABNAME-READ UPON CONSOLE

           EXIT.

      * Determine the table name and activate auto detection for convert
       S-FLUC-GET-TABNAME-CONVERT SECTION.

           SET OPERATION-GET-TABNAME-C TO TRUE

           MOVE MAXTABLEN TO GTN-TABNLEN-CONVERT
           MOVE SPACES TO GTN-TABNAME-CONVERT

           CALL 'FCRGTN' USING C2-ID, F-RETCO,
                               GTN-TABNLEN-CONVERT, GTN-TABNAME-CONVERT

           PERFORM T-FLUC-RC

           DISPLAY 'TABLE NAME CONVERT: ' GTN-TABNAME-CONVERT
                   UPON CONSOLE

           EXIT.

      * Set the table name and deactivate auto detection for write
       S-FLUC-SET-TABNAME-WRITE SECTION.

           SET OPERATION-SET-TABNAME-W TO TRUE

           CALL 'FCRSTN' USING F-ID-OUT, F-RETCO,
                               STN-TABNLEN-WRITE, STN-TABNAME-WRITE

           PERFORM T-FLUC-RC

           EXIT.

      * Set the table name and deactivate auto detection for conver
       S-FLUC-SET-TABNAME-CONVERT SECTION.

           SET OPERATION-SET-TABNAME-C TO TRUE

           CALL 'FCRSTN' USING C1-ID, F-RETCO,
                               STN-TABNLEN-CONVERT, STN-TABNAME-CONVERT

           PERFORM T-FLUC-RC

           EXIT.

      * Read a FIX input record from XML file and provides a pointer to
       S-FLUC-READ-INPUT-LOC SECTION.

           SET OPERATION-READ-INPUT TO TRUE

           CALL 'FCRLOC' USING F-ID-IN, F-RETCO,
                               LOC-DATLEN, LOC-DATPTR

           SET ADDRESS OF LINK-LOC-DAT-DATA TO LOC-DATPTR

           PERFORM T-FLUC-RC

           EXIT.

      * Read an FIX input record from XML file and copies the data
      * MF-EDZ workaround
       S-FLUC-READ-INPUT-GET SECTION.

           SET OPERATION-READ-INPUT TO TRUE

           COMPUTE LOC-DATLEN = LENGTH OF LOCAL-LOC-DAT-DATA

           CALL 'FCRGET' USING F-ID-IN, F-RETCO,
                               LOC-DATLEN, LOCAL-LOC-DAT-DATA

           SET ADDRESS OF LINK-LOC-DAT-DATA
            TO ADDRESS OF LOCAL-LOC-DAT-DATA

           SET LOC-DATPTR
            TO ADDRESS OF LOCAL-LOC-DAT-DATA

           PERFORM T-FLUC-RC

           EXIT.

      * Convert a FIX record to XML format and provides a pointer to
       S-FLUC-CONVERT-F2X-CONP SECTION.

           SET OPERATION-CONVERT-INPUT TO TRUE

           CALL 'FCRCONP'  USING C1-ID,       F-RETCO,
                                 BY REFERENCE LOC-DATLEN,
                                 BY VALUE     LOC-DATPTR,
                                 BY REFERENCE ONP-DATLEN,
                                 BY REFERENCE ONP-DATPTR

           SET ADDRESS OF LINK-ONP-DAT-DATA TO ONP-DATPTR

           PERFORM T-FLUC-RC

           EXIT.

      * Convert a FIX record to XML format and copy the data
      * MF-EDZ workaround
       S-FLUC-CONVERT-F2X-CONV SECTION.

           SET OPERATION-CONVERT-INPUT TO TRUE

           COMPUTE ONP-DATLEN = LENGTH OF LOCAL-ONP-DAT-DATA

           CALL 'FCRCONV'  USING C1-ID,      F-RETCO,
                                 LOC-DATLEN, LOCAL-LOC-DAT-DATA,
                                 ONP-DATLEN, LOCAL-ONP-DAT-DATA

           SET ADDRESS OF LINK-ONP-DAT-DATA
            TO ADDRESS OF LOCAL-ONP-DAT-DATA

           SET ONP-DATPTR
            TO ADDRESS OF LOCAL-ONP-DAT-DATA

           PERFORM T-FLUC-RC

           EXIT.

      * Convert a XML record to FIX format and provides a pointer to
       S-FLUC-CONVERT-X2F-CONP SECTION.

           SET OPERATION-CONVERT-OUTPUT TO TRUE

           CALL 'FCRCONP'  USING C2-ID,       F-RETCO,
                                 BY REFERENCE ONP-DATLEN,
                                 BY VALUE     ONP-DATPTR,
                                 BY REFERENCE PUT-DATLEN,
                                 BY REFERENCE PUT-DATPTR

           SET ADDRESS OF LINK-PUT-DAT-DATA TO PUT-DATPTR

           PERFORM T-FLUC-RC

           EXIT.

      * Convert a XML record to FIX format and copy the data
      * MF-EDZ workaround
       S-FLUC-CONVERT-X2F-CONV SECTION.

           SET OPERATION-CONVERT-OUTPUT TO TRUE

           COMPUTE PUT-DATLEN = LENGTH OF LOCAL-PUT-DAT-DATA

           CALL 'FCRCONV'  USING C2-ID,      F-RETCO,
                                 ONP-DATLEN, LOCAL-ONP-DAT-DATA,
                                 PUT-DATLEN, LOCAL-PUT-DAT-DATA

           SET ADDRESS OF LINK-PUT-DAT-DATA
            TO ADDRESS OF LOCAL-PUT-DAT-DATA

           SET PUT-DATPTR
            TO ADDRESS OF LOCAL-PUT-DAT-DATA

           PERFORM T-FLUC-RC

           EXIT.

      * Writes a FIX output record to the XML file using the pointer
       S-FLUC-WRITE-OUTPUT-PUT-P SECTION.

           SET OPERATION-XML-WRITE TO TRUE

           CALL 'FCRPUT'  USING F-ID-OUT,    F-RETCO,
                                BY REFERENCE PUT-DATLEN,
                                BY VALUE     PUT-DATPTR

           PERFORM T-FLUC-RC

           EXIT.

      * Get file name wich was written to XML
       R-FLUC-GET-FILENAME SECTION.

           SET OPERATION-GET-FILENAME TO TRUE

           MOVE MAXFILELEN TO GFN-FILENLEN
           MOVE SPACES TO GFN-FILENAME

           CALL 'FCRGFN'  USING  F-ID-OUT, F-RETCO, BY VALUE GFN-INDEX,
                                 BY REFERENCE GFN-FILENLEN,
                                 BY REFERENCE GFN-FILENAME

           PERFORM T-FLUC-RC

           DISPLAY 'GFN-FILENAME: ' GFN-FILENAME UPON CONSOLE

           EXIT.

      * Writes a FIX output record to the XML file using the data field
      * MF-EDZ workaround
       S-FLUC-WRITE-OUTPUT-PUT-D SECTION.

           SET OPERATION-XML-WRITE TO TRUE

           CALL 'FCRPUT'  USING F-ID-OUT,    F-RETCO,
                                BY REFERENCE PUT-DATLEN,
                                BY REFERENCE LOCAL-PUT-DAT-DATA

           PERFORM T-FLUC-RC

           EXIT.

      * Check the log for warnings
       S-FLUC-CHECK-LOG SECTION.

           SET OPERATION-CHECK-LOG TO TRUE

      *    PERFORM S-FLUC-GETLOG
           PERFORM S-FLUC-CPYLOG

           PERFORM T-FLUC-LOG-RC

           EXIT.

      * Get the log buffer from FLUC record interface
       S-FLUC-GETLOG SECTION.

           CALL 'FCRGETL' USING LOG-RETCO, LOG-DATLEN, LOG-DATPTR

           EXIT.

      * Copy the log buffer from FLUC record interface
      * MF-EDZ workaround
       S-FLUC-CPYLOG SECTION.

           COMPUTE LOG-DATLEN = LENGTH OF LOCAL-LOG-DAT-DATA
           CALL 'FCRCPYL' USING LOG-RETCO, LOG-DATLEN,
                                LOCAL-LOG-DAT-DATA

           SET LOG-DATPTR
            TO ADDRESS OF LOCAL-LOG-DAT-DATA

           EXIT.

      * Flush output file
       S-FLUC-FLUSH-OUTPUT SECTION.

           SET OPERATION-FLUSH-OUTPUT TO TRUE

           CALL 'FCRFLU' USING F-ID-OUT, F-RETCO

           PERFORM T-FLUC-RC

           EXIT.

      * Close fluc converter 1 (XML->FIX)
       S-FLUC-CLOSE-CONVERTER-F2X SECTION.

           SET OPERATION-CLOSE-CONV-F2X TO TRUE

           CALL  'FCRCLSV' USING C1-ID, F-RETCO

           PERFORM T-FLUC-RC

           EXIT.

      * Close fluc converter 2 (XML->FIX)
       S-FLUC-CLOSE-CONVERTER-X2F SECTION.

           SET OPERATION-CLOSE-CONV-X2F TO TRUE

           CALL  'FCRCLSV' USING C2-ID, F-RETCO

           PERFORM T-FLUC-RC

           EXIT.


      * Close FLUC for input file (XML->FIX) and print statistic
       S-FLUC-CLOSE-INPUT-X2F SECTION.

           SET OPERATION-CLOSE-INPUT TO TRUE

           MOVE  MAXCLSBUFFLEN TO CLS-STATLB

           CALL 'FCRCLS' USING F-ID-IN,    F-RETCO,
                               CLS-DELETE, CLS-STATFMT,
                               CLS-STATLB, CLS-STATBUF

           PERFORM T-FLUC-RC

           PERFORM T-FLUC-STATISTIC

           EXIT.

      * Close FLUC for output file (FIX->XML) and print statistic
       S-FLUC-CLOSE-OUTPUT-F2X SECTION.

           SET OPERATION-CLOSE-OUTPUT TO TRUE

           MOVE  MAXCLSBUFFLEN TO CLS-STATLB

           CALL 'FCRCLS' USING F-ID-OUT,   F-RETCO,
                               CLS-DELETE, CLS-STATFMT,
                               CLS-STATLB, CLS-STATBUF

           PERFORM T-FLUC-RC

           PERFORM T-FLUC-STATISTIC

           EXIT.

      * Close logging facility
       S-FLUC-CLOSE-LOG SECTION.

           SET OPERATION-CLOSE-LOG TO TRUE

           CALL 'FCRCLSL' USING LOG-RETCO

           PERFORM T-FLUC-LOG-RC

           EXIT.

      * Write protocol summary
       S-FLUC-PROTOCOL SECTION.

           MOVE REC-COUNT TO DISP-NUM
           DISPLAY 'RECORDS PROCESSED : ' DISP-NUM UPON CONSOLE
           DISPLAY SPACE UPON CONSOLE

           MOVE F-RETCO  TO DISP-NUM
           DISPLAY 'PROGRAM SOFCRIPS ENDS WITH RC ' DISP-NUM
                   UPON CONSOLE

           EXIT.

      *----------------------------------------------------------------
      *    Sub-Routinen
      *----------------------------------------------------------------

       T-FLUC-LOG-RC SECTION.

           EVALUATE TRUE
           WHEN LOG-RETCO-OK
              CONTINUE
           WHEN OTHER
              PERFORM U-FLUC-RC-ERROR
           END-EVALUATE

           EXIT.

       T-FLUC-RC SECTION.

           EVALUATE TRUE
           WHEN F-RETCO-OK
              CONTINUE
           WHEN F-RETCO-END-OF-TABLE
           WHEN F-RETCO-END-OF-FILE
              CONTINUE
           WHEN OTHER
              PERFORM U-FLUC-RC-ERROR
           END-EVALUATE

           EXIT.

       T-FLUC-STATISTIC SECTION.

           DISPLAY 'STATUS BUFFER FROM CLOSE:' UPON CONSOLE

           PERFORM U-FLUC-STATISTIC

           EXIT.

      *----------------------------------------------------------------
      *    Sub-Routinen
      *----------------------------------------------------------------

       U-FLUC-RC-ERROR SECTION.

           PERFORM V-FLUC-RC-ERROR-RETCO

           PERFORM V-FLUC-RC-ERROR-TRACE

           SET ADDRESS OF DISP-BUFFER TO ADDRESS OF TRCBUFF
           PERFORM V-FLUC-DISP-BUFFER

           PERFORM V-FLUC-RC-ERROR-LOG

      *    next tow lines currently not possible with MF-EDZ
           SET ADDRESS OF DISP-BUFFER TO LOG-DATPTR
           PERFORM V-FLUC-DISP-BUFFER

           MOVE F-RETCO TO RETURN-CODE

           STOP RUN.

       U-FLUC-STATISTIC SECTION.

           SET ADDRESS OF DISP-BUFFER TO ADDRESS OF CLS-STATBUF
           PERFORM V-FLUC-DISP-BUFFER

           EXIT.

      *----------------------------------------------------------------
      *    Sub-Routinen
      *----------------------------------------------------------------

       V-FLUC-RC-ERROR-RETCO SECTION.

           DISPLAY 'SOFCRIPS: ERROR IN OPERATION ' OPERATION
                    UPON CONSOLE

           COMPUTE DISP-NUM = F-RETCO

           DISPLAY 'RETURNCODE: ' DISP-NUM UPON CONSOLE

           EXIT.

       V-FLUC-RC-ERROR-TRACE SECTION.

           COMPUTE TRCLEN = MAXTRCLEN

      *    Get the error trace from FLUC record interface
           CALL 'FCRTRC' USING TRCRC, F-RETCO,
                               TRCLEN, TRCBUFF

           DISPLAY 'ERROR MESSAGE FROM FLUC:' UPON CONSOLE

           COMPUTE DISP-NUM = TRCRC
           DISPLAY 'TRCRC : ' DISP-NUM UPON CONSOLE

           COMPUTE DISP-NUM = TRCLEN
           DISPLAY 'TRCLEN: ' DISP-NUM UPON CONSOLE

           EXIT.

       V-FLUC-RC-ERROR-LOG SECTION.

      *    PERFORM S-FLUC-GETLOG
           PERFORM S-FLUC-CPYLOG

           DISPLAY 'LOG MESSAGES' UPON CONSOLE

           COMPUTE DISP-NUM = LOG-RETCO
           DISPLAY 'MAX. RETURNCODE: ' DISP-NUM UPON CONSOLE

           COMPUTE DISP-NUM = LOG-DATLEN
           DISPLAY 'LOGLEN: ' DISP-NUM UPON CONSOLE

           EXIT.

       V-FLUC-DISP-BUFFER SECTION.

           COMPUTE DISP-PTR = 1
           COMPUTE DISP-LEN = ZERO

           PERFORM W-FLUC-DISP-BUFFER

           PERFORM UNTIL DISP-DLM NOT = X'15'
              PERFORM W-FLUC-DISP-BUFFER
           END-PERFORM

           DISPLAY SPACE UPON CONSOLE

           EXIT.

      *----------------------------------------------------------------
      *    Sub-Routinen
      *----------------------------------------------------------------

       W-FLUC-DISP-BUFFER SECTION.

           UNSTRING DISP-BUFFER DELIMITED BY X'15' OR X'00'
               INTO DISP-AREA DELIMITER DISP-DLM COUNT DISP-LEN
               WITH POINTER DISP-PTR

           IF DISP-LEN NOT = 0 THEN
               DISPLAY DISP-AREA(1:DISP-LEN) UPON CONSOLE
           END-IF

           EXIT.
