       IDENTIFICATION DIVISION.
       PROGRAM-ID.  SOFCRFLT.
       AUTHOR.      LIMES DATENTECHNIK GMBH.
      *
      *           EXAMPLE FOR USING FLUC RECORD INTERFACE WITH
      *           EXPLIZIT CONVERSION OF NUMBERS READ AS RECORD
      *           FROM THE INPUT FILE.
      *
      *  SOFCRFLT OPENS WITH THE FLUC-RECORD-INTERFACE A FILE,
      *           OPENS INDIVIDUAL ELEMENT CONVERTER FOR DATA
      *           ELEMENTS, READS THE RECORD, CONVERT THE RECORD TO AN
      *           FLOAT AND CALCULATE THE SUM BASED ON DIFFERENT COBOL
      *           DATA TYPES (BCD, BIN).
      *
      *  DD-NAMES USED IN THIS EXAMPLE:
      *
      *    INDAT  the file with an decimal number per record
      *    SYSOUT for DISPLAY the results
      *
      *  Returncodes:
      *    0      ok
      *    8      Error found here in program
      *   12      Error in FCR...  (FLUC)
      *   16      Error in FCR...V (element converter)
      * TODO: Rewrite for float
      *--------------------------------------------------------------
       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(10).
       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  DISP-NUM    PIC  ZZZZZZZ9+.
       77  DISP-FLT    PIC  ZZZZZZZ9.99+.
      *
      *
       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  FCRCONV     PIC  X(08)
                           VALUE 'fcrconv'.
           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 100.
           02  F-FILE     PIC X(100) VALUE
               'READ.RECORD(FILE=''DD:INDAT'')'.
           02  F-FORMLEN  PIC S9(9)  COMP SYNC VALUE 100.
           02  F-FORM     PIC X(100) VALUE
               'FORMAT.RECORD(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 FLOAT
      *
           02 F32-RESULT  USAGE COMP-1.
           02 F32-ID      PIC S9(9)  COMP.
           02 F32-VALLEN  PIC S9(9)  COMP VALUE 4.
           02 F32-VALUE   USAGE COMP-1.
           02 F32-DATLEN  PIC S9(9)  COMP VALUE 100.
           02 F32-DATA    PIC X(100) VALUE
              'conv.float(from(format.str(CHRSET=LOCAL SEPARATOR=PERIOD)
      -       ') to(format.bin(width=32)))'.
      *
      *  USED FOR FCROPNV: TRANSLATE TO DOUBLE
      *
           02 F64-RESULT  USAGE COMP-2.
           02 F64-ID      PIC S9(9)  COMP.
           02 F64-VALLEN  PIC S9(9)  COMP VALUE 8.
           02 F64-VALUE   USAGE COMP-2.
           02 F64-DATLEN  PIC S9(9)  COMP VALUE 100.
           02 F64-DATA    PIC X(100) VALUE
              'conv.float(from(format.str(CHRSET=LOCAL SEPARATOR=PERIOD)
      -       ') to(format.bin(width=64)))'.
      *
      *  USED FOR FCROPNV: TRANSLATE TO BCD-PAC
      *
           02 BCDP-RESULT  PIC S999999V99 COMP-3.
           02 BCDP-ID      PIC S9(9)  COMP.
           02 BCDP-VALLEN  PIC S9(9)  COMP VALUE 5.
           02 BCDP-VALUE   PIC S999999V99 COMP-3.
           02 BCDP-DATLEN  PIC S9(9)  COMP VALUE 100.
           02 BCDP-DATA    PIC X(100) VALUE
              'conv.float(from(format.str(CHRSET=LOCAL SEPARATOR=PERIOD)
      -       ') to(format.BCD(type=PAC frac=2 signed)))'.
      *
      *  USED FOR FCROPNV: TRANSLATE TO BCD-ZONED
      *
           02 BCDZ-RESULT  PIC S99999V99.
           02 BCDZ-ID      PIC S9(9)  COMP.
           02 BCDZ-VALLEN  PIC S9(9)  COMP VALUE 7.
           02 BCDZ-VALUE   PIC S99999V99.
           02 BCDZ-DATLEN  PIC S9(9)  COMP VALUE 100.
           02 BCDZ-DATA    PIC X(100) VALUE
              'conv.float(from(format.str(CHRSET=local SEPARATOR=PERIOD)
      -       ') to(format.BCD(type=ZON frac=2 signed)))'.
      *
      *  USED FOR FCRGET/FCRGETV: GET RECORD
      *
           02 FV-SKIP       PIC 9(8) COMP VALUE 255.
           02 FV-LEN        PIC S9(9) COMP.
           02 FV-RECORD     PIC X(1024).
      /
       PROCEDURE DIVISION.
      *
       MAIN SECTION.
      *
       START-MESSAGE.
      *
           DISPLAY 'Program SOFCRFLT 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 'FCROPN' 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 record converter
      *
      *  F32 converter
      *
           CALL  FCROPNV USING F-ID, F32-ID, FV-RETCO,
                                 F32-DATLEN, F32-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OPENF32' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *
      *  F64 converter
      *
           CALL  FCROPNV USING F-ID, F64-ID, FV-RETCO,
                                 F64-DATLEN, F64-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OPENF64' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *
      *  BCD unpacked converter
      *
           CALL  FCROPNV USING F-ID, BCDP-ID, FV-RETCO,
                                 BCDP-DATLEN, BCDP-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OPENBCDP' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *
      *  BCD zones converter
      *
           CALL  FCROPNV USING F-ID, BCDZ-ID, FV-RETCO,
                                 BCDZ-DATLEN, BCDZ-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OPENBCDZ' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *
           DISPLAY 'All record converter started' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      * -----------------------------------------------------------
           MOVE 0          TO  F32-RESULT.
           MOVE 0          TO  F64-RESULT.
           MOVE 0          TO  BCDP-RESULT.
           MOVE 0          TO  BCDZ-RESULT.
       READ-RECORD.
      *
           MOVE MAXLEN         TO  FV-LEN.
           CALL FCRGET USING F-ID, F-RETCO, FV-LEN, FV-RECORD.
           PERFORM PROOF-GET-OK
           DISPLAY 'Get record' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
      *    F32 converter
      *
           CALL FCRCONV USING F32-ID, FV-RETCO,
                                FV-LEN, FV-RECORD,
                                F32-VALLEN, F32-VALUE.
           PERFORM PROOF-CONV-OK
           DISPLAY 'RUN F32 conv '  FV-RETCO UPON CONSOLE.
           ADD     F32-VALUE   TO  F32-RESULT.
           DISPLAY 'F32 add ' F32-RESULT UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
      *    F64 converter
      *
           CALL FCRCONV USING F64-ID, FV-RETCO,
                                FV-LEN, FV-RECORD,
                                F64-VALLEN, F64-VALUE.
           PERFORM PROOF-CONV-OK
           DISPLAY 'RUN F64 conv '  FV-RETCO UPON CONSOLE.
           ADD     F64-VALUE   TO  F64-RESULT.
           DISPLAY 'F64 add ' F64-RESULT UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
      *    BCD packed converter
      *
           CALL FCRCONV USING BCDP-ID, FV-RETCO,
                                FV-LEN, FV-RECORD,
                                BCDP-VALLEN, BCDP-VALUE.
           PERFORM PROOF-CONV-OK
           DISPLAY 'RUN BCDP conv '  FV-RETCO UPON CONSOLE.
           ADD     BCDP-VALUE   TO  BCDP-RESULT.
           DISPLAY 'BCDP add ' BCDP-RESULT UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
      *    BCD zoned converter
      *
           CALL FCRCONV USING BCDZ-ID, FV-RETCO,
                                FV-LEN, FV-RECORD,
                                BCDZ-VALLEN, BCDZ-VALUE.
           PERFORM PROOF-CONV-OK
           DISPLAY 'RUN BCDZ conv '  FV-RETCO UPON CONSOLE.
           ADD     BCDZ-VALUE   TO  BCDZ-RESULT.
           DISPLAY 'BCDZ add ' BCDZ-RESULT UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
      *
      *
           GO TO READ-RECORD.
      *
      * ------------------------------------------------------------
      *
      *  CLOSE FLUC
      *
       CLOSE-FLUC.
           MOVE F32-RESULT  TO  DISP-FLT.
           DISPLAY 'Calculated F32  sum: ' F32-RESULT ' ' DISP-FLT UPON
           CONSOLE.
           MOVE F64-RESULT  TO  DISP-FLT.
           DISPLAY 'Calculated F64  sum: ' F64-RESULT ' ' DISP-FLT UPON
           CONSOLE.
           MOVE BCDP-RESULT  TO  DISP-FLT.
           DISPLAY 'Calculated BCDP sum: ' BCDP-RESULT ' ' DISP-FLT UPON
           CONSOLE.
           MOVE BCDZ-RESULT  TO  DISP-FLT.
           DISPLAY 'Calculated BCDZ sum: ' BCDZ-RESULT ' ' DISP-FLT UPON
           CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Sample file will be closed' UPON CONSOLE.

           CALL FCRCLSV USING F32-ID,  FV-RETCO.
           CALL FCRCLSV USING F64-ID,  FV-RETCO.
           CALL FCRCLSV USING BCDP-ID, FV-RETCO.
           CALL FCRCLSV USING BCDZ-ID, FV-RETCO.
           CALL FCRCLS  USING F-ID, F-RETCO, CLS-DELETE,
                              CLS-STATFMT, CLS-STATLEN, CLS-STATBUF.
      *
      *  PRINT STATISTICS
      *
           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 SOFCRFLT ended.' UPON CONSOLE.
           STOP RUN.
      /
      *
      *  Check for correct FCRGETV
      *
       PROOF-CONV-OK.
           IF  FLUCVOK
           THEN  NEXT SENTENCE
              ELSE MOVE 'FCRCONV' TO OPERATION
              MOVE FV-RETCO TO MSGRC
              PERFORM FLUC-ERROR
              MOVE FCRVERR  TO PROG-RC
              GO TO CLOSE-FLUC
           END-IF.
      *
      *  Check for correct FCRGET
      *
       PROOF-GET-OK.
           IF  FLUCOK
           THEN  NEXT SENTENCE
           ELSE  IF  END-OF-FILE
                 THEN GO TO CLOSE-FLUC
                 ELSE MOVE 'FCRGET' TO OPERATION
                      MOVE F-RETCO TO MSGRC
                      PERFORM FLUC-ERROR
                      MOVE FCRERR  TO PROG-RC
                      GO TO CLOSE-FLUC
                 END-IF
           END-IF.
      ************************************************************
      *
      * PRINT THE ERROR SITUATION
      *
       FLUC-ERROR SECTION.
       FLUC-ERROR-1.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'SOFCRFLT: 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.
      *************************************************************
