       IDENTIFICATION DIVISION.
       PROGRAM-ID.  DEMO001B.
      *
      * Copyright (C) 1991-2007 Micro Focus (IP) Limited.
      * All rights reserved.
      *
      * This program reads the DEMO03DD database and produces a report
      * of all the segments.  It is invoked via JCL IMSBATCH.JCL.
      *
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT REPORT-FILE  ASSIGN TO REPORT1.
       I-O-CONTROL.
       DATA DIVISION.
       FILE SECTION.
       FD  REPORT-FILE.
       01  REPORT-REC                  PIC X(132).

       WORKING-STORAGE SECTION.
       01  PAGE-NO                     PIC 9(04)   COMP.
       01  LINE-NO                     PIC 9(04)   COMP.
       01  ELES-CNT                    PIC 9(08)   COMP.
       01  TOTAL-ELES-CNT              PIC 9(08)   COMP.
       01  MAX-ELES-CNT                PIC 9(08)   COMP.
       01  AVE-ELES-CNT                PIC 9(08)V9(2) COMP.
       01  HDRS-CNT                    PIC 9(08)   COMP.
       01  IO-AREA                     PIC X(300).
       01  DEMOHDRS.
           03  DEMOHDRS-KEY-GROUP.
               05  DEMOHDRS-KEY-SEQ          PIC X(08) VALUE LOW-VALUES.
               05  DEMOHDRS-KEY              PIC X(32).
           03  DEMOHDRS-TABLE-DESCRIPTOR.
               05  FILLER                    PIC X(50).
           03  DEMOHDRS-EXPANSION            PIC X(29).
           03  DEMOHDRS-TABLE-DELETE-IND     PIC X(01) VALUE SPACE.
           03  DEMOHDRS-TABLE-CHARACTERISTICS.
               05  DEMOHDRS-KEY-CHAR-CNT     PIC S9(3) COMP-3.
               05  DEMOHDRS-ELE-CHAR-CNT     PIC S9(3) COMP-3.
               05  DEMOHDRS-MAX-ELE-CNT      PIC S9(3) COMP-3 VALUE +0.
               05  DEMOHDRS-PASSWORD-PROT    PIC X(01) VALUE 'N'.
               05  DEMOHDRS-PASSWORD         PIC X(08) VALUE SPACES.
               05  DEMOHDRS-NUMERIC-KEY      PIC X(01) VALUE '0'.
               05  DEMOHDRS-NUMERIC-ELE      PIC X(01) VALUE '0'.
           03  DEMOHDRS-LAST-ACT-DATE        PIC 9(6) COMP-3.
           03  FILLER                        PIC X(03).
       01  DEMOELES.
           03  DEMOELES-KEY-GROUP.
               05  DEMOELES-KEY-EXPANSION    PIC X(10) VALUE LOW-VALUES.
               05  DEMOELES-KEY              PIC X(20).
           03  DEMOELES-ELE-DATA.
               05  FILLER                    PIC X(133) VALUE SPACES.
           03  DEMOELES-TABLE-NUMERIC.
               05  FILLER                    PIC S9(15) COMP-3 VALUE +0.
           03  DEMOELES-EXPANSION.
               05  FILLER                    PIC X(53).
       01  SSA-HDRS.
           03  HDRS-SEGNAME        PIC X(08) VALUE 'DEMOHDRS'.
           03  HDRS-COM            PIC X(01) VALUE '*'.
           03  HDRS-COM1           PIC X(01) VALUE '-'.
           03  HDRS-COM2           PIC X(01) VALUE '-'.
           03  HDRS-QUALIFY        PIC X(01) VALUE '('.
           03  HDRS-KEYFLD         PIC X(08) VALUE 'SEQFIELD'.
           03  HDRS-RLO1           PIC X(02) VALUE ' ='.
           03  HDRS-FLDVALUE0.
               05  HDRS-FLDVALUE2  PIC X(08) VALUE LOW-VALUES.
               05  HDRS-FLDVALUE1  PIC X(32).
           03  HDRS-ENDQUALIFY PIC X(01) VALUE ')'.
       01  SSA-ELES.
           03  ELES-SEGNAME    PIC X(08) VALUE 'DEMOELES'.
           03  ELES-COM        PIC X(01) VALUE '*'.
           03  ELES-COM1       PIC X(01) VALUE '-'.
           03  ELES-COM2       PIC X(01) VALUE '-'.
           03  ELES-QUALIFY    PIC X(01) VALUE '('.
           03  ELES-KEYFLD     PIC X(08) VALUE 'SEQFIELD'.
           03  ELES-RLO1       PIC X(02) VALUE ' ='.
           03  ELES-FLDVALUE0.
               05  ELES-FLDVALUE2  PIC X(10) VALUE LOW-VALUES.
               05  ELES-FLDVALUE1  PIC X(20).
           03  ELES-ENDQUALIFY PIC X(01) VALUE ')'.
       01  IMS-FUNCTIONS.
           03  GU                      PIC X(04)   VALUE 'GU'.
           03  GN                      PIC X(04)   VALUE 'GN'.
           03  GNP                     PIC X(04)   VALUE 'GNP'.
           03  ISRT                    PIC X(04)   VALUE 'ISRT'.
           03  GHNP                    PIC X(04)   VALUE 'GHNP'.
           03  REPL                    PIC X(04)   VALUE 'REPL'.
           03  DLET                    PIC X(04)   VALUE 'DLET'.
           03  GHN                     PIC X(04)   VALUE 'GHN'.
           03  CHNG                    PIC X(04)   VALUE 'CHNG'.
           03  PURG                    PIC X(04)   VALUE 'PURG'.
           03  GHU                     PIC X(04)   VALUE 'GHU '.
       01  TABLE-DETAIL-LINE1.
           05  FILLER                  PIC X(10) VALUE 'TABLE ID:'.
           05  TABLE-ID                PIC X(32).
           05  FILLER                  PIC X(02) VALUE SPACES.
           05  TABLE-CONTINUED         PIC X(20).
           05  FILLER                  PIC X(06) VALUE 'PAGE:'.
           05  TABLE-PAGE-NO           PIC ZZZ9.
       01  TABLE-DETAIL-LINE2.
           05  FILLER                  PIC X(13) VALUE 'DESCRIPTION: '.
           05  TABLE-DESC              PIC X(50).
       01  TABLE-DETAIL-LINE3.
           05  FILLER                  PIC X(27) VALUE
               'CHARACTERS IN ELEMENT KEY:'.
           05  TABLE-KEY-SIZE          PIC Z9.
       01  TABLE-DETAIL-LINE4.
           05  FILLER                  PIC X(28) VALUE
               'CHARACTERS IN ELEMENT DATA:'.
           05  TABLE-DATA-SIZE         PIC Z9.
       01  TABLE-DETAIL-LINE5.
           05  FILLER                  PIC X(35) VALUE
            'ELEMENT KEY           ELEMENT DATA'.
       01  TABLE-DETAIL-LINE6.
           05  FILLER                  PIC X(35) VALUE
            '===========           ============'.

       01  ELES-DETAIL-LINE.
           05  ELES-KEY                PIC X(20).
           05  FILLER                  PIC X(02) VALUE SPACES.
           05  ELES-DATA               PIC X(50).

       01  ELES-SUMMARY-LINE.
           05  FILLER                  PIC X(07) VALUE 'TOTAL: '.
           05  ELES-SUMMARY-CNT        PIC ZZ9.
           05  FILLER                  PIC X(23) VALUE
           ' ELEMENTS FOR TABLE-ID '.
           05  ELES-TABLE-ID           PIC X(32).

       01  SUMMARY-LINE1.
           05  FILLER                  PIC X(64) VALUE
               'REPORT SUMMARY FOR DATABASE DEMO03DD'.
           05  FILLER                  PIC X(06) VALUE 'PAGE:'.
           05  SUMMARY-PAGE-NO         PIC ZZZ9.
       01  SUMMARY-LINE2.
           05  FILLER                  PIC X(38) VALUE
               'TOTAL NUMBER OF TABLES DEFINED......: '.
           05  SUMMARY-HDRS            PIC Z,ZZZ,ZZ9.
       01  SUMMARY-LINE3.
           05  FILLER                  PIC X(38) VALUE
               'TOTAL NUMBER OF ELEMENTS DEFINED....: '.
           05  SUMMARY-ELES            PIC Z,ZZZ,ZZ9.
       01  SUMMARY-LINE4.
           05  FILLER                  PIC X(38) VALUE
               'MAXIMUM NUMBER OF ELEMENTS PER TABLE: '.
           05  SUMMARY-MAX-ELES        PIC Z,ZZZ,ZZ9.
       01  SUMMARY-LINE5.
           05  FILLER                  PIC X(38) VALUE
               'AVERAGE NUMBER OF ELEMENTS PER TABLE: '.
           05  SUMMARY-AVE-ELES        PIC Z,ZZZ,ZZ9.99.

       LINKAGE SECTION.
       01  IO-PCB                  PIC X(40).
       01  TP-PCB                  PIC X(40).
       01  DEMO-PCB.
           03  DEMO-DBD-NAME       PIC X(08).
           03  DEMO-LEVEL-NO       PIC X(02).
           03  DEMO-STATUS         PIC X(02).
           03  DEMO-PROCOPTS       PIC X(04).
           03  DEMO-RESVD-DLI      PIC X(04).
           03  DEMO-SEGMENT        PIC X(08).
           03  DEMO-FILLER         PIC X(8).
           03  DEMO-KEYFEEDBCK     PIC X(100).

       PROCEDURE DIVISION.
           ENTRY 'DLITCBL'          USING IO-PCB
                                          TP-PCB
                                          DEMO-PCB.
           PERFORM 1000-INIT         THRU 1000-EXIT.
           PERFORM 2000-MAIN         THRU 2000-EXIT
               UNTIL (DEMO-STATUS NOT = SPACE AND 'GA').
           PERFORM 1500-EOJ          THRU 1500-EXIT.
           DISPLAY 'DEMO001B COMPLETE'.
           GOBACK.

       1000-INIT.
           OPEN OUTPUT REPORT-FILE.
           MOVE ZERO                   TO HDRS-CNT.
           MOVE ZERO                   TO ELES-CNT.
           MOVE ZERO                   TO PAGE-NO.
           MOVE ZERO                   TO LINE-NO.
           MOVE ZERO                   TO MAX-ELES-CNT.
           MOVE ZERO                   TO TOTAL-ELES-CNT.
       1000-EXIT.
           EXIT.

       1500-EOJ.
           IF  ELES-CNT > ZERO
               PERFORM 2300-TOT-ELES THRU 2300-EXIT.
           MOVE HDRS-CNT               TO SUMMARY-HDRS.
           MOVE TOTAL-ELES-CNT         TO SUMMARY-ELES.
           MOVE MAX-ELES-CNT           TO SUMMARY-MAX-ELES.
           MOVE TOTAL-ELES-CNT         TO AVE-ELES-CNT.
           DIVIDE HDRS-CNT           INTO AVE-ELES-CNT.
           MOVE AVE-ELES-CNT           TO SUMMARY-AVE-ELES.
           ADD  1                      TO PAGE-NO.
           MOVE PAGE-NO                TO SUMMARY-PAGE-NO.
           MOVE SUMMARY-LINE1          TO REPORT-REC.
           WRITE REPORT-REC AFTER 2.
           MOVE SUMMARY-LINE2          TO REPORT-REC.
           WRITE REPORT-REC         AFTER 2.
           MOVE SUMMARY-LINE3          TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE SUMMARY-LINE4          TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE SUMMARY-LINE5          TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           CLOSE REPORT-FILE.
       1500-EXIT.
           EXIT.

       2000-MAIN.
           CALL 'CBLTDLI'           USING GN
                                          DEMO-PCB
                                          IO-AREA.
           IF  DEMO-STATUS NOT = SPACES AND 'GA' AND 'GB'
               DISPLAY 'INVALID STATUS CODE --> ' DEMO-STATUS
               MOVE 8                  TO RETURN-CODE
               GOBACK.
           IF  DEMO-STATUS NOT = 'GB'
               IF  DEMO-SEGMENT = 'DEMOHDRS'
                   PERFORM 2100-DEMOHDRS THRU 2100-EXIT
               ELSE
                   IF  DEMO-SEGMENT = 'DEMOELES'
                       PERFORM 2200-DEMOELES THRU 2200-EXIT.
       2000-EXIT.
           EXIT.

       2100-DEMOHDRS.
           IF  ELES-CNT > ZERO
               PERFORM 2300-TOT-ELES THRU 2300-EXIT.
           MOVE IO-AREA                TO DEMOHDRS.
           ADD  1                      TO HDRS-CNT.
           MOVE ZERO                   TO ELES-CNT.
           ADD  1                      TO PAGE-NO.
           MOVE PAGE-NO                TO TABLE-PAGE-NO.
           MOVE DEMOHDRS-KEY           TO TABLE-ID.
           MOVE DEMOHDRS-TABLE-DESCRIPTOR  TO TABLE-DESC.
           MOVE DEMOHDRS-KEY-CHAR-CNT  TO TABLE-KEY-SIZE.
           MOVE DEMOHDRS-ELE-CHAR-CNT  TO TABLE-DATA-SIZE.
           MOVE SPACES                 TO TABLE-CONTINUED.
           MOVE TABLE-DETAIL-LINE1     TO REPORT-REC.
           WRITE REPORT-REC AFTER 1.
           MOVE TABLE-DETAIL-LINE2     TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE TABLE-DETAIL-LINE3     TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE TABLE-DETAIL-LINE4     TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE TABLE-DETAIL-LINE5     TO REPORT-REC.
           WRITE REPORT-REC         AFTER 2.
           MOVE TABLE-DETAIL-LINE6     TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE SPACES                 TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           MOVE 8                      TO LINE-NO.
       2100-EXIT.
           EXIT.

       2200-DEMOELES.
           MOVE IO-AREA                TO DEMOELES.
           ADD 1                       TO ELES-CNT.
           ADD 1                       TO TOTAL-ELES-CNT.
           IF  LINE-NO > 59
               ADD 1                       TO PAGE-NO
               MOVE PAGE-NO                TO TABLE-PAGE-NO
               MOVE '(CONTINUED)'          TO TABLE-CONTINUED
               MOVE TABLE-DETAIL-LINE1     TO REPORT-REC
               WRITE REPORT-REC AFTER 1
               MOVE TABLE-DETAIL-LINE5     TO REPORT-REC
               WRITE REPORT-REC         AFTER 2
               MOVE TABLE-DETAIL-LINE6     TO REPORT-REC
               WRITE REPORT-REC         AFTER 1
               MOVE SPACES                 TO REPORT-REC
               WRITE REPORT-REC         AFTER 1
               MOVE 5                      TO LINE-NO.
           MOVE DEMOELES-KEY           TO ELES-KEY.
           MOVE DEMOELES-ELE-DATA      TO ELES-DATA.
           MOVE ELES-DETAIL-LINE       TO REPORT-REC.
           WRITE REPORT-REC         AFTER 1.
           ADD  1                      TO LINE-NO.
       2200-EXIT.
           EXIT.

       2300-TOT-ELES.
           IF  ELES-CNT > MAX-ELES-CNT
               MOVE ELES-CNT               TO MAX-ELES-CNT.
           IF  LINE-NO > 58
               ADD 1                       TO PAGE-NO
               MOVE PAGE-NO                TO TABLE-PAGE-NO
               MOVE '(CONTINUED)'          TO TABLE-CONTINUED
               MOVE TABLE-DETAIL-LINE1     TO REPORT-REC
               WRITE REPORT-REC AFTER 1
               MOVE SPACES                 TO REPORT-REC
               WRITE REPORT-REC         AFTER 1
               MOVE 2                      TO LINE-NO.
           MOVE ELES-CNT               TO ELES-SUMMARY-CNT.
           MOVE DEMOHDRS-KEY           TO ELES-TABLE-ID.
           MOVE ELES-SUMMARY-LINE      TO REPORT-REC.
           WRITE REPORT-REC         AFTER 2.
           ADD 2                       TO LINE-NO.
       2300-EXIT.
           EXIT.
