       IDENTIFICATION DIVISION.
       PROGRAM-ID.  SOFCRXML.
       AUTHOR.      LIMES DATENTECHNIK GMBH.
      *
      *           EXAMPLE FOR USING FLUC ELEMENT INTERFACE
      *
      *  SOFCRXML READS WITH THE FLUC-RECORD-INTERFACE A XML FILE. THE
      *           XML FILE CAN BE ENCODED, ENCRYPTED AND OR COMPRESSED
      *           OR CLEAR. AT WRITE EACH ELEMENT EXCEPT THE DEFAULT
      *           ELEMENT (WHITESPACE TO FORMAT) WILL BE PRINTED WITH
      *           TYPE AND DATA IN EBCDIC TO A FILE. THIS FILE IS A
      *           KIND OF READABLE DUMP OF THE XML ELEMENT LIST PROVIDED
      *           BY FLAM.
      *
      *  DD-NAMES USED IN THIS EXAMPLE:
      *
      *    INPUT  THE XML FILE FLUC HAS TO READ
      *    OUTPUT OUR OUTPUT DATA SET (VB2044)
      *
      *  OUTPUT-FORMAT:
      *    ELEMENT-TYPE   ELEMENT-LENGHT(ELEMENT-DATA)
      *
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT      OUTDAT
           ASSIGN TO   S-OUTPUT
           ACCESS MODE IS SEQUENTIAL.
      *
       DATA DIVISION.
      *
       FILE SECTION.
       FD  OUTDAT  BLOCK CONTAINS 0 CHARACTERS
                   RECORDING MODE V
                   RECORD IS VARYING FROM 1 TO 2040 CHARACTERS
                          DEPENDING ON OUTLEN
                    LABEL  RECORD IS STANDARD.
      * Output record
      *   Layout:
      *   Element-type datalength (data)
       01  OUTDAT-RECORD.
           02 O-FE-ET-NAME  PIC X(12).
           02 O-TEXT1       PIC X(1).
           02 O-DDISP-LEN   PIC X(4).
           02 O-TEXT2       PIC X(2).
           02 O-FE-DATA     PIC X(2021).
      *
       WORKING-STORAGE SECTION.
      *
       77  OUTLEN      PIC  9(5).
       77  OPERATION   PIC  X(6).
       77  MAXLEN      PIC  S9(9)  COMP VALUE 2048.
       77  MSG-LEN     PIC  9(8)   BINARY VALUE ZERO.
       77  MSG-AREA    PIC  X(256).
       77  MSG-DLM     PIC  X.
       77  MSG-PTR     PIC  9(8)   COMP VALUE 1.
       77  DISP-LEN    PIC  ZZZ9.
      *
       01 XML-ELEMENT-TYPE-NAMES.
           05 FILLER   PIC X(12)   VALUE 'Data'.
           05 FILLER   PIC X(12)   VALUE 'StartElm'.
           05 FILLER   PIC X(12)   VALUE 'EndStrtElm'.
           05 FILLER   PIC X(12)   VALUE 'EndElm'.
           05 FILLER   PIC X(12)   VALUE 'AttName'.
           05 FILLER   PIC X(12)   VALUE 'AttrVal'.
           05 FILLER   PIC X(12)   VALUE 'XML'.
           05 FILLER   PIC X(12)   VALUE 'SkipEnt'.
           05 FILLER   PIC X(12)   VALUE 'SkipParMent'.
           05 FILLER   PIC X(12)   VALUE 'StartDTD'.
           05 FILLER   PIC X(12)   VALUE 'EndDTD'.
           05 FILLER   PIC X(12)   VALUE 'ElmDecl'.
           05 FILLER   PIC X(12)   VALUE 'AttlDecl'.
           05 FILLER   PIC X(12)   VALUE 'IntendDecl'.
           05 FILLER   PIC X(12)   VALUE 'SysEntDecl'.
           05 FILLER   PIC X(12)   VALUE 'PubEntDecl'.
           05 FILLER   PIC X(12)   VALUE 'NotDeclS'.
           05 FILLER   PIC X(12)   VALUE 'NotDeclP'.
           05 FILLER   PIC X(12)   VALUE 'NotDeclPS'.
           05 FILLER   PIC X(12)   VALUE 'ProcInst'.
           05 FILLER   PIC X(12)   VALUE 'StartCD'.
           05 FILLER   PIC X(12)   VALUE 'EndCD'.
           05 FILLER   PIC X(12)   VALUE 'Comment'.
           05 FILLER   PIC X(12)   VALUE 'Default'.
       01 XML-ET-NAMES REDEFINES XML-ELEMENT-TYPE-NAMES.
           05  XML-ET-NAME   PIC X(12)  OCCURS 24 TIMES.
      *
       01  FLUC-PARAMETER.
      *
      *  USED FOR ALL FLUC-CALLS
      *
           02 F-ID     PIC S9(9)  COMP.
           02 F-RETCO  PIC S9(9)  COMP.
              88 FLUCOK            VALUE  0.
              88 END-OF-FILE       VALUE  43.
           02  FCROPN      PIC  X(08)
                              VALUE 'fcropn'.
           02  FCRGET      PIC  X(08)
                           VALUE 'fcrget'.
           02  FCRCLS      PIC  X(08)
                           VALUE 'fcrcls'.
           02  FCRMSG      PIC  X(08)
                           VALUE 'fcrmsg'.
           02  FCRTRC      PIC  X(08)
                           VALUE 'fcrtrc'.
      *
      *  USED FOR FLUC OPEN
      *
           02  F-FILELEN  PIC S9(9)  COMP VALUE 64.
           02  F-FILE     PIC X(64)  VALUE
               'READ.XML(FILE=''DD:INPUT'')'.
           02  F-FORMLEN  PIC S9(9)  COMP SYNC VALUE 64.
           02  F-FORM     PIC X(64)  VALUE
               'FORMAT.ELEMENT(CCSID=DEFAULT)'.
           02  F-STATLEN  PIC S9(9)  COMP SYNC VALUE 1024.
           02  F-STAT     PIC X(1024) VALUE ' '.
      *
      *  USED FOR FLUC GET
      *
           02 F-LEN      PIC S9(9) COMP.
           02 F-RECORD   PIC X(2048) VALUE SPACE.
           02 F-ELEM-STRUCT REDEFINES F-RECORD.
              05 FE-VERSION PIC 9(8) COMP.
                 88 OUR-VERSION             VALUE   0.
              05 FE-MATTYP  PIC 9(8) COMP.
                 88 FE-MT-DATBLK            VALUE 128.
                 88 FE-MT-STDREC            VALUE 129.
                 88 FE-MT-STSASAREC         VALUE 130.
                 88 FE-MT-STDMCCREC         VALUE 131.
                 88 FE-MT-RELREC            VALUE 132.
                 88 FE-MT-RELASAREC         VALUE 133.
                 88 FE-MT-RELMCCREC         VALUE 134.
                 88 FE-MT-TXTREC            VALUE 135.
                 88 FE-MT-TXTDLM            VALUE 136.
                 88 FE-MT-TXTRST            VALUE 144.
                 88 FE-MT-XMLELM            VALUE 145.
              05 FE-ELMTYP  PIC 9(8) COMP.
                 88 FE-ET-TYPBLK-STANDARD   VALUE   0.
                 88 FE-ET-TYPREC-STANDARD   VALUE   0.
                 88 FE-ET-TYPTXT-RECORD     VALUE   0.
                 88 FE-ET-TYPTXT-REST       VALUE   1.
      *
                 88 FE-ET-TYPXML-DATA       VALUE   0.
                 88 FE-ET-TYPXML-STARTELM   VALUE   1.
                 88 FE-ET-TYPXML-ENDSTRTELM VALUE   2.
                 88 FE-ET-TYPXML-ENDELM     VALUE   3.
                 88 FE-ET-TYPXLM-ATTNAME    VALUE   4.
                 88 FE-ET-TYPXML-ATTRVAL    VALUE   5.
                 88 FE-ET-TYPXML-XML        VALUE   6.
                 88 FE-ET-TYPXML-SKIPENT    VALUE   7.
                 88 FE-ET-TYPXML-SKIPPARMENT VALUE  8.
                 88 FE-ET-TYPXML-STARTDTD   VALUE   9.
                 88 FE-ET-TYPXML-ENDDTD     VALUE  10.
                 88 FE-ET-TYPXML-ELMDECL    VALUE  11.
                 88 FE-ET-TYPXML-ATTLDECL   VALUE  12.
                 88 FE-ET-TYPXML-INTENTDECL VALUE  13.
                 88 FE-ET-TYPXML-SYSENTDECL VALUE  14.
                 88 FE-ET-TYPXML-PUBENTDECL VALUE  15.
                 88 FE-ET-TYPXML-NOTDECLS   VALUE  16.
                 88 FE-ET-TYPXML-NOTDECLP   VALUE  17.
                 88 FE-ET-TYPXML-NOTDECLPS  VALUE  18.
                 88 FE-ET-TYPXML-PROCINST   VALUE  19.
                 88 FE-ET-TYPXML-STARTCD    VALUE  20.
                 88 FE-ET-TYPXML-ENDCD      VALUE  21.
                 88 FE-ET-TYPXML-COMMENT    VALUE  22.
                 88 FE-ET-TYPXML-DEFAULT    VALUE  23.
              05 FE-ATTRLEN PIC 9(8) COMP.
              05 FE-DATLEN  PIC 9(8) COMP.
              05 FE-HSHLEN  PIC 9(8) COMP.
              05 FILLER     PIC 9(8) COMP.
              05 FILLER     PIC 9(8) COMP.
              05 FE-DATA    PIC X(2016).
      *
      *  USED FOR FLUC MSG
      *
           02  MSGRC     PIC S9(9) COMP.
           02  MSGLEN    PIC S9(9) COMP VALUE 1024.
           02  MSGBUFF   PIC X(1024) VALUE SPACES.
      *
      *  USED FOR FLUC CLS
      *
           02  C-DELETE  PIC S9(9) COMP VALUE 0.
           02  C-STATFMT PIC S9(9) COMP VALUE 1.
           02  C-STATLEN PIC S9(9) COMP VALUE 4096.
           02  C-STATBUF PIC X(4096) VALUE SPACES.
      /
       PROCEDURE DIVISION.
      *
       MAIN SECTION.
      *
       OPEN-OUTPUT-DATA.
      *
      *  OPEN DATA SET TO WRITE RECORDS
      *
           OPEN OUTPUT OUTDAT.
      *
       OPEN-FLUC.
      *
      *  CALL THE FLAM UNIVERSAL CONVERTER MODULE FOR OPEN
      *
           CALL  FCROPN USING F-ID, F-RETCO,
                                F-FILELEN, F-FILE,
                                F-FORMLEN, F-FORM,
                                F-STATLEN, F-STAT.
           IF  NOT FLUCOK
              THEN  MOVE 'OPEN' TO OPERATION
                    PERFORM FLUC-ERROR
                    GO TO CLOSE-DATA.
           DISPLAY 'Program SOFCRXML started' UPON CONSOLE
           DISPLAY F-STAT(1:F-STATLEN) UPON CONSOLE.
      *
       FIRST-RECORD.
      *
      *  READ FIRST RECORD AND CHECK DATA
      *
           MOVE MAXLEN   TO F-LEN
      *
           DISPLAY 'READ FIRST RECORD ...' UPON CONSOLE
           CALL FCRGET USING F-ID, F-RETCO,
                             F-LEN, F-RECORD.
      *
           IF  FLUCOK
             THEN  NEXT SENTENCE
             ELSE  IF  END-OF-FILE
                      THEN GO TO CLOSE-FLUC
                      ELSE MOVE 'GET' TO OPERATION
                           PERFORM FLUC-ERROR
                           GO TO CLOSE-FLUC
                   END-IF
           END-IF
      *
      *  CHECK FOR VERSION, TYPE
      *
           IF  OUR-VERSION
            THEN IF  FE-MT-XMLELM
                   THEN NEXT SENTENCE
                   ELSE DISPLAY 'ERROR: no XML-Data in record' UPON 
                   CONSOLE
                        GO TO CLOSE-FLUC
                 END-IF
            ELSE
                DISPLAY 'ERROR: Record has an unknown structure' UPON 
                CONSOLE
                GO TO CLOSE-FLUC
           END-IF.
      *
       WRITE-RECORD.
      *
      *  WRITE THE CONVERTED RECORD TO FILE
      *
      *     DISPLAY 'F-RECORD: ' F-RECORD UPON CONSOLE
      *     DISPLAY 'WRITE RECORD ... DL= ' FE-DATLEN UPON CONSOLE
           MOVE FE-DATLEN            TO  DISP-LEN
           IF  FE-ELMTYP < 24
             ADD  1  TO  FE-ELMTYP
             MOVE XML-ET-NAME(FE-ELMTYP) TO O-FE-ET-NAME
           ELSE
             MOVE 'UNKNOWN'          TO O-FE-ET-NAME
           END-IF
      *     DISPLAY 'ELMTYP ' O-FE-ET-NAME UPON CONSOLE
           MOVE SPACE                TO O-TEXT1
           MOVE DISP-LEN             TO O-DDISP-LEN
           MOVE ' ('                 TO O-TEXT2
      *  FE-DATLEN < L'O-FE-DATA
           IF FE-DATLEN > 0
              MOVE FE-DATA(1:FE-DATLEN) TO O-FE-DATA
           END-IF
           MOVE ')'                  TO O-FE-DATA(FE-DATLEN + 1:1)
      *
           COMPUTE OUTLEN = FE-DATLEN + 20
      *     DISPLAY 'do the deed now' UPON CONSOLE
           WRITE OUTDAT-RECORD.
      *
       NEXT-RECORD.
      *
      *  READ A RECORD WITH FLUC
      *
           MOVE MAXLEN   TO F-LEN
      *     DISPLAY 'READ NEXT RECORD ...' UPON CONSOLE
           CALL FCRGET USING F-ID, F-RETCO,
                             F-LEN, F-RECORD
      *
           IF  FLUCOK
             THEN  GO  TO WRITE-RECORD
             ELSE  IF  END-OF-FILE
                      THEN GO TO CLOSE-FLUC
                      ELSE MOVE 'GET' TO OPERATION
                           PERFORM FLUC-ERROR
                           GO TO CLOSE-FLUC
                   END-IF
           END-IF.
      *
       CLOSE-FLUC.
      *
      *  CLOSE TO FLUC
           DISPLAY 'CALL FCRCLS ...' UPON CONSOLE
           CALL FCRCLS USING F-ID, F-RETCO, C-DELETE
                             C-STATFMT, C-STATLEN, C-STATBUF
           IF  NOT FLUCOK
             THEN MOVE 'CLOSE' TO OPERATION
                  PERFORM FLUC-ERROR
           END-IF.
       CLOSE-DATA.
      *
      *  CLOSE OUTPUT DATA
      *
           CLOSE  OUTDAT.
       MAIN-END.
           MOVE F-RETCO  TO RETURN-CODE
      *
      *  PRINT STATISTIC
      *
           DISPLAY 'READ-STATISTIC FROM FLUC' UPON CONSOLE.
       DISP-STATBUF.
           MOVE ZERO  TO MSG-LEN
           UNSTRING C-STATBUF DELIMITED BY X'15' OR X'00'
                             INTO MSG-AREA
                             DELIMITER MSG-DLM COUNT MSG-LEN
                             WITH POINTER MSG-PTR
           IF  MSG-DLM = X'15'
             THEN  IF  MSG-LEN < 257
                      THEN  DISPLAY MSG-AREA(1:MSG-LEN) UPON CONSOLE
                      ELSE  DISPLAY MSG-AREA(1:256) UPON CONSOLE
                   END-IF
                   GO TO DISP-STATBUF
           END-IF.
      *
      *  PROGRAM END
      *
       PROG-END.
           DISPLAY 'Program SOFCRXML ended.' UPON CONSOLE
           STOP RUN.
      *
      * PRINT THE ERROR SITUATION
      *
       FLUC-ERROR SECTION.
       FLUC-ERROR-1.
           DISPLAY 'SOFCRXML: ERROR IN OPERATION ' OPERATION UPON 
           CONSOLE
           DISPLAY 'ERROR MESSAGE FROM FLUC:' UPON CONSOLE
           MOVE F-RETCO  TO MSGRC
      *  GET THE ERROR MESSAGE
           CALL FCRMSG USING MSGRC, F-RETCO, MSGLEN, MSGBUFF
           DISPLAY MSGBUFF UPON CONSOLE.
       FLUC-ERROR-99.
           EXIT.