       IDENTIFICATION DIVISION.
       PROGRAM-ID.  SOFCRINT.
       AUTHOR.      LIMES DATENTECHNIK GMBH.
      *
      *           EXAMPLE FOR USING FLUC RECORD INTERFACE WITH
      *           EXPLIZIT CONVERSION OF NUMBERS READ AS RECORD
      *           FROM THE INPUT FILE.
      *
      *  SOFCRINT OPENS WITH THE FLUC-RECORD-INTERFACE A FILE,
      *           OPENS INDIVIDUAL ELEMENT CONVERTER FOR DATA
      *           ELEMENTS, READS THE RECORD, CONVERT THE RECORD TO AN
      *           INTEGER 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)
      *--------------------------------------------------------------
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER.                IBM-370.
       OBJECT-COMPUTER.                IBM-370.
       SPECIAL-NAMES.
           CLASS CLASS-DSN                                              PG
           'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.#'                     PG000018
      *    *************************************************************
      *    ORG: ORIGINAL FILE
      *    *************************************************************
      * *** SECTION GENERATED BY $APS-SPECIAL-NAMES ***
           CURRENCY SIGN IS '$'
           DECIMAL-POINT IS COMMA
           .
      *
       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.
      *
      *  USED FOR FLUC OPEN: FCROPN
      *
           02  F-FILELEN  PIC S9(9)  COMP VALUE 28.
           02  F-FILE     PIC X(28)  VALUE
               'READ.RECORD(FILE=''DD:INDAT'')'.
           02  F-FORMLEN  PIC S9(9)  COMP SYNC VALUE 15.
           02  F-FORM     PIC X(15)  VALUE
               'FORMAT.RECORD()'.
           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.
           02  FCROPN      PIC  X(08)
                           VALUE 'fcropn'.
           02  FCROPNV     PIC  X(08)
                           VALUE 'fcropnv'.
           02  FCRGET      PIC  X(08)
                           VALUE 'fcrget'.
           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'.
           02  FCRCONV     PIC  X(08)
                           VALUE 'fcrconv'.

      *
      *  USED FOR ALL ELEMENT CONVERTER CALLS
      *
           02 FV-RETCO  PIC S9(9)  COMP   VALUE ZERO.
              88 FLUCVOK           VALUE  0.
      *
      *  USED FOR FCROPNV: TRANSLATE TO I32
      *
           02 I32-RESULT  PIC S9(9)  COMP.
           02 I32-ID      PIC S9(9)  COMP.
           02 I32-VALLEN  PIC S9(9)  COMP VALUE 4.
           02 I32-VALUE   PIC S9(9)  COMP.
           02 I32-DATLEN  PIC S9(9)  COMP VALUE 81.
           02 I32-DATA    PIC X(81)  VALUE
              'conv.integer(from(format.str(CHRSET=LOCAL)) to(format.bin
      -       '(signed width=32)))'.
      *
      *  USED FOR FCROPNV: TRANSLATE TO BCD-PAC
      *
           02 BCDP-RESULT  PIC S9(9)  COMP-3.
           02 BCDP-ID      PIC S9(9)  COMP.
           02 BCDP-VALLEN  PIC S9(9)  COMP VALUE 5.
           02 BCDP-VALUE   PIC S9(9)  COMP-3.
           02 BCDP-DATLEN  PIC S9(9)  COMP VALUE 84.
           02 BCDP-DATA    PIC X(84)  VALUE
              'conv.integer(from(format.str(CHRSET=LOCAL)) to(format.BCD
      -       '(SIGNED type=PACKED)))'.
      *
      *  USED FOR FCROPNV: TRANSLATE TO BCD-ZONED
      *
           02 BCDZ-RESULT  PIC S9(9).
           02 BCDZ-ID      PIC S9(9)  COMP.
           02 BCDZ-VALLEN  PIC S9(9)  COMP VALUE 9.
           02 BCDZ-VALUE   PIC S9(9).
           02 BCDZ-DATLEN  PIC S9(9)  COMP VALUE 83.
           02 BCDZ-DATA    PIC X(83)  VALUE
              'conv.integer(from(format.str(chrset=local)) to(format.BCD
      -       '(SIGNED type=ZONED)))'.
      *
      *  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 SOFCRINT 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
      *
      *  I32 converter
      *
           CALL  FCROPNV USING F-ID, I32-ID, FV-RETCO,
                                 I32-DATLEN, I32-DATA.
           IF  NOT FLUCVOK
              THEN  MOVE 'OPENI32' TO OPERATION
                    MOVE FV-RETCO TO MSGRC
                    PERFORM FLUC-ERROR
                    MOVE FCRVERR  TO PROG-RC
                    GO TO CLOSE-FLUC.
      *
      *  BCD packed 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  I32-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 FV-RECORD UPON CONSOLE.
      *
      *    I32 converter
      *
           CALL FCRCONV USING I32-ID, FV-RETCO,
                                FV-LEN, FV-RECORD,
                                I32-VALLEN, I32-VALUE.
           PERFORM PROOF-CONV-OK
           DISPLAY 'RUN I32 conv '  FV-RETCO UPON CONSOLE.
           ADD     I32-VALUE   TO  I32-RESULT.
           DISPLAY 'I32 add ' I32-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 I32-RESULT  TO  DISP-NUM.
           DISPLAY 'Calculated I32  sum: ' I32-RESULT ' ' DISP-NUM
           UPON CONSOLE.
           MOVE BCDP-RESULT  TO  DISP-NUM.
           DISPLAY 'Calculated BCDP sum: ' BCDP-RESULT ' ' DISP-NUM
           UPON CONSOLE.
           MOVE BCDZ-RESULT  TO  DISP-NUM.
           DISPLAY 'Calculated BCDZ sum: ' BCDZ-RESULT ' ' DISP-NUM
           UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
           DISPLAY 'Sample file will be closed' UPON CONSOLE.

           CALL FCRCLSV USING I32-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 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)
                    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 SOFCRINT 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 'SOFCRINT: 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)
                   GO TO FLUC-ERROR-2
           END-IF.
           DISPLAY 'Trace from FLUC. End.' UPON CONSOLE.
           DISPLAY ' ' UPON CONSOLE.
       FLUC-ERROR-99.
           EXIT.
      *************************************************************
