       IDENTIFICATION DIVISION.
       PROGRAM-ID.  SOFCREXV.
       AUTHOR.      LIMES DATENTECHNIK GMBH.
      *
      *           EXAMPLE FOR USING FLUC ELEMENT INTERFACE WITH
      *           ELEMENT CONVERTER INTERPRETING A XML-FILE.
      *
      *  SOFCREXV OPENS WITH THE FLUC-RECORD-INTERFACE A XML FILE,
      *           OPENS INDIVIDUAL ELEMENT CONVERTER FOR DATA
      *           ELEMENTS, READS THE ELEMENT AND DOES SOME ACTIONS ON
      *           THEM (CALCULATE AND DISPLAY).
      *
      *  DD-NAMES USED IN THIS EXAMPLE:
      *
      *    INDAT  the XML file FLUC has to read
      *    SYSOUT for DISPLAY commands
      *
      *  Returncodes:
      *    0      ok
      *    8      Error found here in program
      *   12      Error in FCR...  (FLUC)
      *   16      Error in FCR...V (element converter)
      *--------------------------------------------------------------
      *  Following input is used (each row is one record in the file):
      *
      *  <FOO>
      *
      *     <decimal> 45 56</decimal>
      *     <Decimal>  -462
      *                3
      *      </Decimal>
      *    <DECIMAL> + 3 4 5  </DECIMAL>
      *  <string>
      *            all    blanks
      *          are    gone   when    collapsed.
      *  </string>
      *  <FLOAT> -.567 </FLOAT>
      *  <float>  .456   </float>
      *    <Float>  00000000003.456 </Float> <float>  -56.34 </float>
      * <FLOAT>  67 </FLOAT>
      *  <string>    This is       the last     text
      *            for   this    sample       </string>
      *
      *
      *
      *      </FOO>
      *--------------------------------------------------------------
       ENVIRONMENT DIVISION.
      *
       INPUT-OUTPUT SECTION.
      *
       DATA DIVISION.
      *
       WORKING-STORAGE SECTION.
      *
       77  PROG-RC     PIC  9(8)   COMP VALUE 0.
       77  PRGERR      PIC  9(8)   COMP VALUE 8.
       77  FCRERR      PIC  9(8)   COMP VALUE 12.
       77  FCRVERR     PIC  9(8)   COMP VALUE 16.
      *
       77  MAXLEN      PIC  S9(8)  COMP VALUE 1024.
       77  OPERATION   PIC  X(6).
       77  SEARCHING   PIC  X(6).
       77  MSG-LEN     PIC  9(8)   COMP VALUE ZERO.
       77  MSG-AREA    PIC  X(256).
       77  MSG-DLM     PIC  X.
       77  MSG-PTR     PIC  9(8)   COMP VALUE 1.
       77  DEC-NUM-CNT PIC  S9(8)  VALUE ZERO.
       77  FLT-NUM-CNT PIC  S9(8)V99 VALUE ZERO.
       77  DISP-NUM    PIC  ZZZZZZZ9+.
       77  DISP-FLT    PIC  ZZZZZZZ9.99+.
       77  DEC-NUM     PIC  S9(8).
       77  FLT-NUM     PIC  S9(8)V99.
       77  CHAR-TEXT   PIC  X(10).
       77  TEXT-ELEM   PIC  X(45).
      *
       77  FLMELM_NOSKIP       PIC 9(8) COMP VALUE 255.
       77  FLMELM_TYPXML_DATA  PIC 9(8) COMP VALUE   0.
      *
       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   VALUE ZERO.
              88 FLUCOK            VALUE  0.
              88 END-OF-FILE       VALUE  43.
           02  FCROPN      PIC  X(08)
                           VALUE 'fcropn'.
           02  FCROPNV     PIC  X(08)
                           VALUE 'fcropnv'.
           02  FCRGET      PIC  X(08)
                           VALUE 'fcrget'.
           02  FCRGETV     PIC  X(08)
                           VALUE 'fcrgetv'.
           02  FCRCLS      PIC  X(08)
                           VALUE 'fcrcls'.
           02  FCRCLSV     PIC  X(08)
                           VALUE 'fcrclsv'.
           02  FCRMSG      PIC  X(08)
                           VALUE 'fcrmsg'.
           02  FCRTRC      PIC  X(08)
                           VALUE 'fcrtrc'.
      *
      *  USED FOR FLUC OPEN: FCROPN
      *
           02  F-FILELEN  PIC S9(9)  COMP VALUE 64.
           02  F-FILE     PIC X(64)  VALUE
               'READ.XML(FILE=''DD:INDAT'' NODFLT NOCMNT NODTD CCSID=114
      -        '1)'.
           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 MSG OR TRACE: FCRMSG/FCRTRC
      *
           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: FCRCLS
      *
           02  CLS-DELETE  PIC S9(9) COMP VALUE 0.
           02  CLS-STATFMT PIC S9(9) COMP VALUE 1.
           02  CLS-STATLEN PIC S9(9) COMP VALUE 1024.
           02  CLS-STATBUF PIC X(1024)    VALUE SPACES.
      *
      *  PARAMETER FOR ELEMENT CONVERTER
      *
       01  FLUCV-PARAMETER.
      *
      *  USED FOR ALL ELEMENT CONVERTER CALLS
      *
           02 FV-RETCO  PIC S9(9)  COMP   VALUE ZERO.
              88 FLUCVOK           VALUE  0.
      *
      *  USED FOR FCROPNV: TRANSLATE TO UPPER
      *
           02 FVT-ID      PIC S9(9)  COMP.
           02 FVT-DATLEN  PIC S9(9)  COMP VALUE 50.
           02 FVT-DATA    PIC X(50)  VALUE
              'WRITE.STRING(CHRSET(CCSID=DEFAULT CASE=UPPER))'.
      *
      *  USED FOR FCROPNV: COLLAPSE ELEMENT
      *
           02 FVC-ID      PIC S9(9)  COMP.
           02 FVC-DATLEN  PIC S9(9)  COMP VALUE 55.
           02 FVC-DATA    PIC X(55)  VALUE
              'write.string(chrset(ccsid=default whitespace=collapse))'.
      *
      *  USED FOR FCROPNV: MAKE DECIMAL NUMBER 8 CHARS INCL SIGN
      *
           02 FVD-ID      PIC S9(9)  COMP.
           02 FVD-DATLEN  PIC S9(9)  COMP VALUE 80.
           02 FVD-DATA    PIC X(80)  VALUE
              'write.string(chrset(ccsid=local whitespace=remove) number
      -       '(format=''%+08d''))'.
      *
      *  USED FOR FCROPNV: MAKE FLOATING POINT 10 CHARS INCL SIGN
      *
           02 FVF-ID      PIC S9(9)  COMP.
           02 FVF-DATLEN  PIC S9(9)  COMP VALUE 80.
           02 FVF-DATA    PIC X(80)  VALUE
              'write.string(chrset(ccsid=local whitespace=number) number
      -       '(format=''%+010.2f''))'.
      *
      *  USED FOR FCRGET/FCRGETV: GET RECORD/GET ELEMENT DATA
      *
           02 FV-SKIP       PIC 9(8) COMP.
           02 FV-LEN        PIC S9(9) COMP.
           02 FV-RECORD     PIC X(1024).
           02 F-ELEM-STRUCT REDEFINES FV-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(992).
      *  ELEMENT IS A TEXT IN UPPERCASE IN 32 CHARACTERS
              05 FE-TEXT-ELEMENT  REDEFINES FE-DATA.
                 07 FE-TEXT-ELEM  PIC X(45).
                 07 FILLER        PIC X(947).
      *  ELEMENT IS A DECIMAL SIGNED NUMBER WITH 8 DIGITS (incl sign)
              05 FE-DECIMAL-ELEM  REDEFINES FE-DATA.
                 07 FE-DEC-DISP.
                    09 FE-DEC-NUM PIC S9(7) SIGN LEADING SEPARATE.
                 07 FILLER        PIC X(984).
      *  ELEMENT IS A FLOATING POINT NUMBER WITH 10 CHARACTERS
              05 FE-FLOAT-ELEMENT REDEFINES FE-DATA.
                 07 FE-FLOAT-DISP.
                    09 FE-FLOAT-SIGN PIC X.
                    09 FE-FLOAT-PNUM PIC 9(6).
                    09 FE-FLOAT_DPT  PIC X.
                    09 FE-FLOAT-SNUM PIC 9(2).
                 07 FE-FLOAT-NUM  REDEFINES FE-FLOAT-DISP
                                  PIC +9(6).99 DISPLAY.
                 07 FILLER        PIC X(982).
      *  ELEMENT IS A COLLAPSED TEXT IN 32 CHARACTERS
              05 FE-CTEXT-ELEMENT  REDEFINES FE-DATA.
                 07 FE-CTEXT-ELEM PIC X(80).
                 07 FILLER        PIC X(912).
      /
       PROCEDURE DIVISION.
      *
       MAIN SECTION.
      *
       START-MESSAGE.
      *
           DISPLAY 'Program SOFCREXV started' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
       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
                    MOVE F-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRERR  TO PROG-RC
                    GO TO PROG-END
           END-IF.
           DISPLAY 'FCROPN called without errors' UPON CONSOLE.
      *
      *  If you like to show the statusarea
      *
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Status area. Start' UPON CONSOLE.
      *
           DISPLAY F-STAT(1:F-STATLEN) UPON CONSOLE.
      *
           DISPLAY 'Status area. End.' UPON CONSOLE
           DISPLAY ' ' UPON CONSOLE.
      *
       OPEN-CONVERTER.
      *
      *  Opens several element converter
      *
      *  Translate to upper
      *
           CALL  FCROPNV USING F-ID, FVT-ID, FV-RETCO,
                                 FVT-DATLEN, FVT-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OpenVT' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *  Collapse
           CALL  FCROPNV USING F-ID, FVC-ID, FV-RETCO,
                                 FVC-DATLEN, FVC-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OpenVC' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *  Decimal number
           CALL  FCROPNV USING F-ID, FVD-ID, FV-RETCO,
                                 FVD-DATLEN, FVD-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OpenVD' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *  Floating point number
           CALL  FCROPNV USING F-ID, FVF-ID, FV-RETCO,
                                 FVF-DATLEN, FVF-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OpenVF'  TO OPERATION
                    MOVE FV-RETCO  TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *
           DISPLAY 'All element converter started' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      * -----------------------------------------------------------
       FIRST-ELEMENT.
      *  READ FIRST RECORD AND CHECK DATA FOR OUR SAMPLE
      *
      * '<FOO' expected
      *
           MOVE MAXLEN         TO  FV-LEN.
           MOVE FLMELM_NOSKIP  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                                FV-LEN, FV-RECORD,
                                FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  CHECK ELEMENT
           PERFORM PROOF-START-ELEMENT.
           IF  FE-DATA(1:3) = 'FOO'
            THEN  NEXT SENTENCE
            ELSE  DISPLAY 'ERROR: FOO not found, not our sample?' UPON
                  CONSOLE
                  DISPLAY FE-DATA(1:40) UPON CONSOLE
                  MOVE  PRGERR TO PROG-RC
                  GO TO CLOSE-FLUC
           END-IF.
      *
      * read  '>'
      *
           MOVE MAXLEN     TO  FV-LEN.
           CALL FCRGET USING F-ID, FV-RETCO,
                               FV-LEN, FV-RECORD.
           PERFORM PROOF-GET-OK
      *  Check element
           PERFORM PROOF-ENDSTART-ELEMENT.
      *
           DISPLAY 'First element completed' UPON CONSOLE.
      * ------------------------------------------------------------
      *
      *  Find decimal values
      *
       NEXT-ELEMENT-DECIMAL.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Look for 3 decimal values' UPON CONSOLE.
      *
           PERFORM FIND-DECIMAL-VALUE.
           DISPLAY '1ST: ' CHAR-TEXT UPON CONSOLE.
           ADD     DEC-NUM   TO  DEC-NUM-CNT.
      *
           PERFORM FIND-DECIMAL-VALUE.
           DISPLAY '2ND: ' CHAR-TEXT UPON CONSOLE.
           ADD     DEC-NUM   TO  DEC-NUM-CNT.
      *
           PERFORM FIND-DECIMAL-VALUE.
           DISPLAY '3RD: ' CHAR-TEXT UPON CONSOLE.
           ADD     DEC-NUM   TO  DEC-NUM-CNT.
           MOVE DEC-NUM-CNT  TO  DISP-NUM.
      *
           DISPLAY 'Calculated sum: ' DISP-NUM UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Decimal elements completed' UPON CONSOLE.
      * ------------------------------------------------------------
      *
      *  Find string
      *
       NEXT-ELEMENT-STRING.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Look for a Text (string) value' UPON CONSOLE.
           PERFORM FIND-STRING-VALUE.
           DISPLAY 'Found:' UPON CONSOLE
           DISPLAY TEXT-ELEM UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'String element completed' UPON CONSOLE.
      * ------------------------------------------------------------
      *
      *  Find floating point values
      *
       NEXT-ELEMENT-FP.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Look for 5 floating point values' UPON CONSOLE.
           PERFORM FIND-FP-VALUE.
           DISPLAY '1ST: ' CHAR-TEXT UPON CONSOLE.
           ADD  FLT-NUM      TO  FLT-NUM-CNT.
           PERFORM FIND-FP-VALUE.
           DISPLAY '2nd: ' CHAR-TEXT UPON CONSOLE.
           ADD  FLT-NUM      TO  FLT-NUM-CNT.
           PERFORM FIND-FP-VALUE.
           DISPLAY '3rd: ' CHAR-TEXT UPON CONSOLE.
           ADD  FLT-NUM      TO  FLT-NUM-CNT.
           PERFORM FIND-FP-VALUE.
           DISPLAY '4th: ' CHAR-TEXT UPON CONSOLE.
           ADD  FLT-NUM      TO  FLT-NUM-CNT.
           PERFORM FIND-FP-VALUE.
           DISPLAY '5th: ' CHAR-TEXT UPON CONSOLE.
           ADD  FLT-NUM      TO  FLT-NUM-CNT.
           MOVE FLT-NUM-CNT  TO  DISP-FLT.
           DISPLAY 'Calculated sum: ' DISP-FLT UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Floating point element completed' UPON CONSOLE.
      * ------------------------------------------------------------
      *
      *  Find string
      *
       NEXT-ELEMENT-STRING2.
           PERFORM FIND-STRING-VALUE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Look for next string' UPON CONSOLE
           DISPLAY TEXT-ELEM UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'String element completed' UPON CONSOLE.
      * ------------------------------------------------------------
      *
      *  Last element '</FOO>'
      *
       LAST-ELEMENT.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-END-ELEMENT.
      *
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Sample file will be closed' UPON CONSOLE.
      * ------------------------------------------------------------
      *
      *  CLOSE FLUC
      *
       CLOSE-FLUC.
           CALL FCRCLSV USING FVT-ID, FV-RETCO.
           CALL FCRCLSV USING FVC-ID, FV-RETCO.
           CALL FCRCLSV USING FVD-ID, FV-RETCO.
           CALL FCRCLSV USING FVF-ID, FV-RETCO.

           CALL FCRCLS USING F-ID, F-RETCO, CLS-DELETE,
                               CLS-STATFMT, CLS-STATLEN, CLS-STATBUF.
           IF  NOT FLUCOK
             THEN MOVE 'CLOSE' TO OPERATION
                  MOVE FCRERR  TO PROG-RC
                  PERFORM FLUC-ERROR
           END-IF.
      *
      *  PRINT STATISTIC
      *
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'FLUC-statistic. Start.' UPON CONSOLE.
           MOVE 1        TO MSG-PTR.
       DISP-STATBUF.
           MOVE ZERO  TO MSG-LEN
           UNSTRING CLS-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  DISPLAY MSG-AREA(1:MSG-LEN) UPON CONSOLE
                    GO TO DISP-STATBUF
           END-IF.
           DISPLAY 'FLUC-statistic. End.' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
      *  PROGRAM END
      *
       PROG-END.
           MOVE PROG-RC  TO RETURN-CODE
           DISPLAY 'Program SOFCREXV ended.' UPON CONSOLE.
           STOP RUN.
      /
      *
      *  Check for correct FCRGETV
      *
       PROOF-GETV-OK.
           IF  FLUCVOK
           THEN  NEXT SENTENCE
           ELSE  IF  END-OF-FILE
                 THEN GO TO CLOSE-FLUC
                 ELSE MOVE 'GETV'   TO OPERATION
                      MOVE FV-RETCO TO MSGRC
                      PERFORM FLUC-ERROR
                      MOVE FCRVERR  TO PROG-RC
                      GO TO CLOSE-FLUC
                 END-IF
           END-IF.
      *
      *  Check for correct FCRGET
      *
       PROOF-GET-OK.
           IF  FLUCVOK
           THEN  NEXT SENTENCE
           ELSE  IF  END-OF-FILE
                 THEN GO TO CLOSE-FLUC
                 ELSE MOVE 'GET'   TO OPERATION
                      MOVE F-RETCO TO MSGRC
                      PERFORM FLUC-ERROR
                      MOVE FCRERR  TO PROG-RC
                      GO TO CLOSE-FLUC
                 END-IF
           END-IF.
      *
      *  CHECK FOR START-ELEMENT
      *
       PROOF-START-ELEMENT.
           IF  OUR-VERSION
           THEN IF  FE-MT-XMLELM
                THEN IF  FE-ET-TYPXML-STARTELM
                     THEN NEXT SENTENCE
                     ELSE DISPLAY 'ERROR: no StartElement found' UPON
                          CONSOLE
                          MOVE PRGERR TO PROG-RC
                          GO TO CLOSE-FLUC
                     END-IF
                ELSE DISPLAY 'ERROR: no XML-Data in record' UPON CONSOLE
                     MOVE PRGERR TO PROG-RC
                     GO TO CLOSE-FLUC
                END-IF
           ELSE
              DISPLAY 'ERROR: Record has an unknown structure' UPON
              CONSOLE
              MOVE PRGERR TO PROG-RC
              GO TO CLOSE-FLUC
           END-IF.
      *
      *  CHECK FOR ENDSTART-ELEMENT
      *
       PROOF-ENDSTART-ELEMENT.
           IF  OUR-VERSION
           THEN IF  FE-MT-XMLELM
                THEN IF  FE-ET-TYPXML-ENDSTRTELM
                     THEN NEXT SENTENCE
                     ELSE DISPLAY 'ERROR: no EndStartElement found' UPON
                          CONSOLE
                          MOVE PRGERR TO PROG-RC
                          GO TO CLOSE-FLUC
                     END-IF
                ELSE DISPLAY 'ERROR: no XML-Data in record' UPON CONSOLE
                     MOVE PRGERR TO PROG-RC
                     GO TO CLOSE-FLUC
                END-IF
           ELSE
              DISPLAY 'ERROR: Record has an unknown structure' UPON
              CONSOLE
              MOVE PRGERR TO PROG-RC
              GO TO CLOSE-FLUC
           END-IF.
      *
      *  CHECK FOR END-ELEMENT
      *
       PROOF-END-ELEMENT.
           IF  OUR-VERSION
           THEN IF  FE-MT-XMLELM
                THEN IF  FE-ET-TYPXML-ENDELM
                     THEN NEXT SENTENCE
                     ELSE DISPLAY 'ERROR: no EndElement found' UPON
                          CONSOLE
                          MOVE PRGERR TO PROG-RC
                          GO TO CLOSE-FLUC
                     END-IF
                ELSE DISPLAY 'ERROR: no XML-Data in record' UPON CONSOLE
                     MOVE PRGERR TO PROG-RC
                     GO TO CLOSE-FLUC
                END-IF
           ELSE
              DISPLAY 'ERROR: Record has an unknown structure' UPON
              CONSOLE
              MOVE PRGERR TO PROG-RC
              GO TO CLOSE-FLUC
           END-IF.
      *
      *  CHECK FOR XML-DATA-ELEMENT
      *
       PROOF-XML-DATA-ELEMENT.
           IF  OUR-VERSION
           THEN IF  FE-MT-XMLELM
                THEN IF  FE-ET-TYPXML-DATA
                     THEN NEXT SENTENCE
                     ELSE DISPLAY 'ERROR: no XMLDataElement found' UPON
                          CONSOLE
                          MOVE PRGERR TO PROG-RC
                          GO TO CLOSE-FLUC
                     END-IF
                ELSE DISPLAY 'ERROR: no XML-Data in record' UPON CONSOLE
                     MOVE PRGERR TO PROG-RC
                     GO TO CLOSE-FLUC
                END-IF
           ELSE
              DISPLAY 'ERROR: Record has an unknown structure' UPON
              CONSOLE
              MOVE PRGERR TO PROG-RC
              GO TO CLOSE-FLUC
           END-IF.
      /
      *************************************************************
      *
      * PRINT THE ERROR SITUATION
      *
       FLUC-ERROR SECTION.
       FLUC-ERROR-1.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'SOFCREXV: Error in operation ' OPERATION UPON
           CONSOLE.
           DISPLAY 'Trace from FLUC: Start' UPON CONSOLE.
      *  GET THE ERROR TRACE
           MOVE  MAXLEN   TO MSGLEN.
           CALL FCRTRC USING F-RETCO, MSGRC, MSGLEN, MSGBUFF.
           MOVE 1     TO MSG-PTR.
       FLUC-ERROR-2.
           MOVE ZERO  TO MSG-LEN.
           UNSTRING MSGBUFF  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  DISPLAY MSG-AREA(1:MSG-LEN) UPON CONSOLE
                   GO TO FLUC-ERROR-2
           END-IF.
           DISPLAY 'Trace from FLUC. End.' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
       FLUC-ERROR-99.
           EXIT.
      *************************************************************
      /
      *************************************************************
      *  Find for DECIMAL and add value to DEC-NUM-CNT
      *
       FIND-DECIMAL-VALUE SECTION.
      *
      *  '<DECIMAL' expected
      *
       FIND-DECIMAL-1.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-START-ELEMENT.
           IF  FE-DATA(1:7) = 'DECIMAL'
            THEN  NEXT SENTENCE
            ELSE  DISPLAY 'ERROR: DECIMAL not found, not our sample?'
                  UPON CONSOLE
                  DISPLAY FE-DATA(1:40) UPON CONSOLE
                  MOVE  PRGERR TO PROG-RC
                  GO TO CLOSE-FLUC
           END-IF.
      * read  '>'
       FIND-DECIMAL-2.
           MOVE MAXLEN     TO  FV-LEN.
           CALL FCRGET USING F-ID, FV-RETCO,
                               FV-LEN, FV-RECORD.
           PERFORM PROOF-GET-OK
      *  Check element
           PERFORM PROOF-ENDSTART-ELEMENT.
      *
      *  Get the decimal value
      *
       FIND-DECIMAL-3.
           MOVE MAXLEN        TO  FV-LEN.
           MOVE FLMELM_NOSKIP TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVD-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK.
      *  Check element
           PERFORM PROOF-XML-DATA-ELEMENT.
      * *********************************************
      *  store value for calculation
           MOVE  FE-DEC-NUM   TO DEC-NUM.
      *  for Display
           MOVE  FE-DEC-DISP  TO CHAR-TEXT.
      * *********************************************
      *
      *  READ '</DECIMAL>'
      *
       FIND-DECIMAL-4.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-END-ELEMENT.
      *
      * EXIT
      *
       FIND-DECIMAL-9.
           EXIT.
      * ***********************************************************
      /
      * ***********************************************************
      *  Find a STRING (collapsed)
      *
       FIND-STRING-VALUE SECTION.
      *
      *  '<STRING' expected
      *
       FIND-STRING-1.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-START-ELEMENT.
           IF  FE-DATA(1:6) = 'STRING'
            THEN  NEXT SENTENCE
            ELSE  DISPLAY 'ERROR: STRING not found, not our sample?'
                  UPON CONSOLE
                  DISPLAY FE-DATA(1:40) UPON CONSOLE
                  MOVE  PRGERR TO PROG-RC
                  GO TO CLOSE-FLUC
           END-IF.
      * read  '>'
       FIND-STRING-2.
           MOVE MAXLEN     TO  FV-LEN.
           CALL FCRGET USING F-ID, FV-RETCO,
                               FV-LEN, FV-RECORD.
           PERFORM PROOF-GET-OK
      *  Check element
           PERFORM PROOF-ENDSTART-ELEMENT.
      *
      *  Get the string
      *
       FIND-STRING-3.
           MOVE MAXLEN        TO  FV-LEN.
           MOVE FLMELM_NOSKIP TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVC-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK.
      *  Check element
           PERFORM PROOF-XML-DATA-ELEMENT.
      * *********************************************
      *  store value
           MOVE  FE-CTEXT-ELEM TO TEXT-ELEM.
      * *********************************************
      *
      *  READ '</STRING>'
      *
       FIND-STRING-4.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-END-ELEMENT.
      *
      * EXIT
      *
       FIND-STRING-9.
           EXIT.
      *************************************************************
      /
      * ***********************************************************
      *  Find a floating point value
      *
       FIND-FP-VALUE SECTION.
      *
      *  '<FLOAT' expected
      *
       FIND-FP-1.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-START-ELEMENT.
           IF  FE-DATA(1:5) = 'FLOAT'
            THEN  NEXT SENTENCE
            ELSE  DISPLAY 'ERROR: STRING not found, not our sample?'
                  UPON CONSOLE
                  DISPLAY FE-DATA(1:40) UPON CONSOLE
                  MOVE  PRGERR TO PROG-RC
                  GO TO CLOSE-FLUC
           END-IF.
      * read  '>'
       FIND-FP-2.
           MOVE MAXLEN     TO  FV-LEN.
           CALL FCRGET USING F-ID, FV-RETCO,
                               FV-LEN, FV-RECORD.
           PERFORM PROOF-GET-OK
      *  Check element
           PERFORM PROOF-ENDSTART-ELEMENT.
      *
      *  Get the value
      *
       FIND-FP-3.
           MOVE MAXLEN        TO  FV-LEN.
           MOVE FLMELM_NOSKIP TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVF-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK.
      *  Check element
           PERFORM PROOF-XML-DATA-ELEMENT.
      * *********************************************
           MOVE FE-FLOAT-NUM        TO  FLT-NUM.
      *
           MOVE FE-FLOAT-DISP       TO  CHAR-TEXT.
      * *********************************************
      *
      *  READ '</FLOAT>'
      *
       FIND-FP4-4.
           MOVE MAXLEN              TO  FV-LEN.
           MOVE FLMELM_TYPXML_DATA  TO  FV-SKIP.
      *
           CALL FCRGETV USING F-ID, FV-RETCO,
                              FV-LEN, FV-RECORD,
                              FVT-ID, FV-SKIP.
           PERFORM PROOF-GETV-OK
      *  Check element
           PERFORM PROOF-END-ELEMENT.
      *
      * EXIT
      *
       FIND-FP-9.
           EXIT.
      *************************************************************
