       IDENTIFICATION DIVISION.
       PROGRAM-ID. DEMO006L.
      *
      * Copyright (C) 1991-2007 Micro Focus (IP) Limited.
      * All rights reserved.
      *
      * This edits passed table values against database
      * DEMO03DD (TABLES DATA BASE).
      *
       ENVIRONMENT DIVISION.
       DATA DIVISION.

       WORKING-STORAGE SECTION.
       77  EDIT-SWITCH    PIC X VALUE '0'.
       77  END-PROCESSING PIC X VALUE '0'.
       77  FIRST-TIME     PIC X VALUE '1'.
       77  GENERIC-S      PIC X(05) VALUE SPACES.
       77  GENERIC-R      PIC X(05) VALUE SPACES.
       77  ISUB           PIC S9(4) COMP VALUE ZERO.
       77  MAX-OCCURENCES PIC S9(4) COMP VALUE +200.
      ******************************************************************
      ****** IMS DATABASE SEGMENT DEFINITION AREA - PROGRAM DEMO006L.***
      ******************************************************************
      ******************************************************************
      ** IMS DATABASE PCB DEFINITION FOR TABLES DATA BASE             *
      ******************************************************************
      ****** INCLUDE FOR SEGMENT DEMOHDRS - TABLE HEADER SEGMENT
      ******************************************************************
      **********      TABLE DATA BASE HEADER       *********************
      **********           144 BYTES                                ****
      ******************************************************************
       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).
      ****** INCLUDE FOR SEGMENT DEMOELES - ELEMENTARY TABLE SEGMENT
      ******************************************************************
      **************  TABLE DATA BASE DETAIL       *********************
      *************        224 BYTES                                ****
      ******************************************************************
       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).
      ****** SSA FOR SEGMENT DEMOORDS - TABLE HEADER SEGMENT ***********
      ***    PLEASE NOTE PATH CALL FOR DEMOHDRS ************************
       01  SSA-HDRS.
           03  HDRS-SEGNAME        PIC X(08) VALUE 'DEMOHDRS'.
           03  HDRS-COM            PIC X     VALUE '*'.
           03  HDRS-COM1           PIC X     VALUE '-'.
           03  HDRS-COM2           PIC X     VALUE '-'.
           03  HDRS-QUALIFY        PIC X     VALUE '('.
           03  HDRS-KEYFLD         PIC X(8)  VALUE 'SEQFIELD'.
           03  HDRS-RLO1           PIC XX    VALUE ' ='.
           03  HDRS-FLDVALUE0.
               05  HDRS-FLDVALUE2  PIC X(08) VALUE LOW-VALUES.
               05  HDRS-FLDVALUE1  PIC X(32).
           03  HDRS-ENDQUALIFY PIC X     VALUE ')'.
      ****** SSA FOR SEGMENT DEMOELES - ELEMENTARY SEGMENT *************
       01  SSA-ELES.
           03  ELES-SEGNAME    PIC X(08) VALUE 'DEMOELES'.
           03  ELES-COM        PIC X     VALUE '*'.
           03  ELES-COM1       PIC X     VALUE '-'.
           03  ELES-COM2       PIC X     VALUE '-'.
           03  ELES-QUALIFY    PIC X     VALUE '('.
           03  ELES-KEYFLD     PIC X(8)  VALUE 'SEQFIELD'.
           03  ELES-RLO1       PIC XX    VALUE ' ='.
           03  ELES-FLDVALUE0.
               05  ELES-FLDVALUE2  PIC X(10) VALUE LOW-VALUES.
               05  ELES-FLDVALUE1  PIC X(20).
           03  ELES-ENDQUALIFY PIC X     VALUE ')'.
      *****PROGRAM WORK AREAS*************************************
       01  IMS-FUNCTIONS.
           03  GU                      PIC X(4)      VALUE 'GU'.
           03  GN                      PIC X(4)      VALUE 'GN'.
           03  GNP                     PIC X(4)      VALUE 'GNP'.
           03  ISRT                    PIC X(4)      VALUE 'ISRT'.
           03  GHNP                    PIC X(4)      VALUE 'GHNP'.
           03  REPL                    PIC X(4)      VALUE 'REPL'.
           03  DLET                    PIC X(4)      VALUE 'DLET'.
           03  GHN                     PIC X(4)      VALUE 'GHN'.
           03  CHNG                    PIC X(4)      VALUE 'CHNG'.
           03  PURG                    PIC X(4)      VALUE 'PURG'.
           03  GHU                     PIC X(4)      VALUE 'GHU '.
       01  IMS-DEMO006L-RETURN-CDS.
           03  BB                      PIC XX        VALUE '  '.
           03  GE                      PIC XX        VALUE 'GE'.
           03  GB                      PIC XX        VALUE 'GB'.
           03  II                      PIC XX        VALUE 'II'.
           03  AI                      PIC XX        VALUE 'AI'.
           03  QC                      PIC XX        VALUE 'QC'.
           03  QD                      PIC XX        VALUE 'QD'.
       01  XDC                     PIC X(255).

       LINKAGE SECTION.
       01  DEMO-PCB.
           03  DEMO-DBD-NAME   PIC X(08).
           03  DEMO-LEVEL-NO   PIC XX.
           03  DEMO-STATUS     PIC XX.
           03  DEMO-PROCOPTS   PIC XXXX.
           03  DEMO-RESVD-DLI  PIC XXXX.
           03  DEMO-SEGMENT    PIC X(08).
           03  DEMO-FILLER     PIC X(8).
           03  DEMO-KEYFEEDBCK PIC X(100).
      ******************************************************************
      **********      TABLE ACCESS SUBROUTINE PARM LIST  ***************
      **********           250 BYTES                                ****
      ******************************************************************
       01  DEMO006L-PARMS.
           02  DEMO006L-INPUT-PARMS.
               03  DEMO006L-TBL-KEY          PIC X(32).
               03  FILLER REDEFINES DEMO006L-TBL-KEY.
                   05  TBL-CUSTOMERS         PIC X(09).
                   05  FILLER                PIC X(23).
               03  DEMO006L-ELEM-KEY         PIC X(20).
               03  FILLER                    PIC X(20).
           02  DEMO006L-OUTPUT-PARMS.
               03  DEMO006L-RETURN-CD        PIC X(02).
                   88  DEMO006L-RETURN-CD-GOOD         VALUE  '00'.
                   88  DEMO006L-RETURN-CD-NOFIND       VALUES '05'
                                                              '10'.
                   88  DEMO006L-RETURN-CD-NOFIND-ELEM  VALUE  '05'.
                   88  DEMO006L-RETURN-CD-NOFIND-TBL   VALUE  '10'.
                   88  DEMO006L-RETURN-CD-CALL-ERROR   VALUE  '20'.
               03  DEMO006L-ELEM-DSC         PIC X(133).
               03  FILLER                    PIC X(20).
           02  FILLER                        PIC X(23).

       PROCEDURE DIVISION USING
                                DEMO-PCB
                                DEMO006L-PARMS.
           MOVE '0' TO END-PROCESSING.
           PERFORM A-010-MAINLINE THRU A-010-EXIT.
           GOBACK.

       A-010-MAINLINE.
           MOVE '00' TO DEMO006L-RETURN-CD.
           PERFORM A-045-GU-HDRS-ELES THRU A-045-EXIT.
           IF DEMO006L-RETURN-CD = '00'
               MOVE DEMOELES-ELE-DATA TO DEMO006L-ELEM-DSC
           ELSE
               MOVE SPACES TO DEMO006L-ELEM-DSC.
       A-010-EXIT.
           EXIT.

       A-045-GU-HDRS-ELES.
      ***  SET UP DEMOHDRS SSA
           MOVE DEMO006L-TBL-KEY TO HDRS-FLDVALUE1.
           MOVE DEMO006L-ELEM-KEY TO ELES-FLDVALUE1 GENERIC-S.
           IF TBL-CUSTOMERS = 'CUSTOMERS'
               MOVE '=>' TO ELES-RLO1
           ELSE
               MOVE ' =' TO ELES-RLO1.
      ***  DL/I CALL TO GU DEMOELES SEGMENT
           MOVE '-' TO HDRS-COM1.
           MOVE '-' TO ELES-COM1.
           CALL 'CBLTDLI' USING GU
                                DEMO-PCB
                                DEMOELES
                                SSA-HDRS
                                SSA-ELES.
           IF ELES-RLO1 = '=>'
               IF DEMO-STATUS = BB
                   MOVE DEMOELES-KEY TO GENERIC-R
                       IF GENERIC-R = GENERIC-S
                           GO TO A-045-EXIT.
           IF ELES-RLO1 = '=>'
               MOVE '10' TO DEMO006L-RETURN-CD
               GO TO A-045-EXIT.
           IF DEMO-STATUS = GE
               IF DEMO-LEVEL-NO = '00'
                   MOVE '10' TO DEMO006L-RETURN-CD
                   GO TO A-045-EXIT
               ELSE
                   MOVE '05' TO DEMO006L-RETURN-CD
                   GO TO A-045-EXIT.
           IF DEMO-STATUS NOT = BB
               MOVE '20' TO DEMO006L-RETURN-CD
               GO TO A-045-EXIT.
       A-045-EXIT.
           EXIT.
