       IDENTIFICATION DIVISION.
       PROGRAM-ID.  CDLIDEMO.
      *
      * Copyright (C) 1991-2007 Micro Focus (IP) Limited.
      * All rights reserved.
      *
      * A CICS version of the IMS/TM demo program DEMO001T.
      * Tran code "CDEMO" invokes this program.
      *
       ENVIRONMENT DIVISION.
       DATA DIVISION.

       WORKING-STORAGE SECTION.
       01  WORK-AREA.
           05  DEMO001P-PSB            PIC X(08) VALUE 'DEMO001T'.
           05  SAVE-DATE               PIC X(08) VALUE SPACES.
           05  TBL-PRINTER             PIC X(08) VALUE ' '.
           05  ABEND                   PIC X(08) VALUE 'ABEND'.
           05  KEEP-STATUS1            PIC X(01).
           05  LOOK-STATUS1            PIC X(01).
           05  EDIT-SWITCH             PIC X(01).
           05  DATE-SW                 PIC X(01).
           05  REPL-SW                 PIC X(01).
           05  CHANGE-ADD-SW           PIC X(01).
           05  EOP-SW                  PIC X(01).
           05  LENGTH-ERROR            PIC X(01).
           05  FIRST-TIME              PIC X(01).
           05  FIRST-INSERT            PIC X(01).
           05  DATA-PRESENT            PIC X(01).
           05  SCREEN2-AGAIN           PIC X(01).
           05  SCREEN2-FULL            PIC X(01).
           05  DUMVAL                  PIC X(01).
           05  CRT-LENGTH              PIC S9(4) VALUE +1800     COMP.
           05  LINE-CNT                PIC S9(4) VALUE 0         COMP.
           05  SCREEN-CNT              PIC S9(4) VALUE 0         COMP.
           05  J                       PIC S9(4) VALUE 0         COMP.
           05  ISUB                    PIC S9(4) VALUE 0         COMP.
           05  OSUB                    PIC S9(4) VALUE 0         COMP.
           05  PSUB                    PIC S9(4) VALUE 0         COMP.
           05  WSUB                    PIC S9(4) VALUE 0         COMP.
           05  HSUB                    PIC S9(4) VALUE 0         COMP.

       01  WORK-ABST-DATE              PIC S9(15)                COMP-3.

       01  SCHEDULE-ERROR              PIC X(35)
               VALUE 'CSSF SCHEDULE ERROR - CHECK PSB GEN'.

      ******************************************************************
      *                                                                *
      *                DLIDEMO SCREEN LAYOUTS                          *
      *                                                                *
      ******************************************************************

           COPY DLIDEMO.

       01  BUBBLE-UP-AREA.
           03  S-DEMO92-MATRIX.
               05  S-CRT-LINE          OCCURS 14.
                   07  S-M2-FUNCL      PIC 9(04)                 COMP.
                   07  S-M2-FUNCA      PIC X(01).
                   07  S-M2-FUNC       PIC X(01).
                   07  S-M2-ELE-KEYL   PIC 9(04)                 COMP.
                   07  S-M2-ELE-KEYA   PIC X(01).
                   07  S-M2-ELE-KEY    PIC X(20).
                   07  S-M2-ELE-DATAL  PIC 9(04)                 COMP.
                   07  S-M2-ELE-DATAA  PIC X(01).
                   07  S-M2-ELE-DATA   PIC X(50).

      ******************************************************************
      *      IMS DATABASE SEGMENT DEFINITION AREA - PROGRAM CDLIDEMO.  *
      *                                                                *
      *               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) VALUE +0     COMP-3.
               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(06)              COMP-3.
           03  FILLER                     PIC X(03).

      ******************************************************************
      * DEMOELES                                                       *
      *               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-INV-MATRIX REDEFINES DEMOELES-ELE-DATA.
               05  ELES-INV-DATA          OCCURS 13.
                   10  ELES-DATE          PIC 9(04).
                   10  ELES-DATEX REDEFINES ELES-DATE.
                       15  ELES-YY.
                           20  ELES-YY9   PIC 9(02).
                       15  ELES-MM.
                           20  ELES-MM9   PIC 9(02).
                   10  ELES-HDRS          PIC 9(06).
               05  FILLER                 PIC X(03).
           03  DEMOELES-TABLE-NUMERIC.
               05  FILLER                 PIC S9(15) VALUE +0    COMP-3.
           03  DEMOELES-EXPANSION.
               05  FILLER                 PIC X(53).

      ****** SSA FOR SEGMENT DEMOORDS - TABLE HEADER SEGMENT ***********

       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 ')'.

      ****** SSA FOR SEGMENT DEMOELES - ELEMENTARY SEGMENT *************
      *
       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  COMM-AREA.
           05  COMMAREA-PROGRAM        PIC X(08).
           05  FILLER                  PIC X(02).

      *****PROGRAM WORK AREAS*************************************
      *
       01  IMS-FUNCTIONS.
           03  SCHD                    PIC X(4)      VALUE 'PCB'.
           03  TERM                    PIC X(4)      VALUE 'TERM'.
           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-RETURN-CODES.
           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'.

           COPY CICSATTR.

           COPY DFHAID.

       01  PROGRAM-FIELDS.
           03  MSS-RECEIVE-FLD         PIC S9(9) VALUE 0         COMP-3.
           03  MSS-WORK-AREA.
      *    COMP-5 TO COMP
               05  MSS-COMP-FIELDS                               COMP.
                   07  MSS-IN-LENGTH   PIC S9(8) VALUE ZERO.
                   07  MSS-OUT-LENGTH  PIC S9(8) VALUE +5.
                   07  MSS-DECIMALS    PIC S9(8) VALUE ZERO.
               05  MSS-RETURN          PIC X(01) VALUE 'X'.
           03  SRE-INTERFACE.
               05  GD00                PIC X(04) VALUE 'GD00'.
               05  INCR-DAYS           PIC S9(7)                 COMP-3.
               05  BASE-DATE           PIC X(08).
               05  RETURN-DATE         PIC X(08).
               05  FILLER              PIC X(11).
               05  RETURNED-CODE       PIC X(01).
           03  DATE-WRK.
               05  DATE-YY             PIC X(02).
               05  DATE-MM             PIC X(02).
               05  DATE-DD             PIC X(02).
           03  DATE-WORK REDEFINES DATE-WRK PIC 9(06).
           03  CURR-DATE               PIC 9(06).
           03  GREGORIAN-DATE-WORK.
               05  GREG-MM             PIC X(02).
               05  FILLER              PIC X(01) VALUE '/'.
               05  GREG-DD             PIC X(02).
               05  FILLER              PIC X(01) VALUE '/'.
               05  GREG-YY             PIC X(02).
           03  9000-ABEND-CODE         PIC 9(04).
           03  GROUP-KEY-AREA          PIC X(50).
           03  FILLER REDEFINES GROUP-KEY-AREA.
               05  KEY-MATRIX          OCCURS 50
                                       PIC X(01).
           03  ERROR-MESSAGES.
               05  FILLER              PIC X(35) VALUE
                       'NOT NUMERIC'.
               05  FILLER              PIC X(35) VALUE
                       'INVALID VALUE'.
               05  FILLER              PIC X(35) VALUE
                       'FIELD IS TOO LONG'.
               05  FILLER              PIC X(35) VALUE
                       'FIELD REQUIRES INPUT OF DATA'.
               05  FILLER              PIC X(35) VALUE
                       'RECORD NOT FOUND ON FILE'.
               05  FILLER              PIC X(35) VALUE
                       'RECORD ALREADY EXISTS ON FILE'.
               05  FILLER              PIC X(35) VALUE
                       'TOO SMALL MUST BE > THAN PREVIOUS'.
               05  FILLER              PIC X(35) VALUE
                       'PUT "D" IN RETURN TO CONFIRM DELETE'.
               05  FILLER              PIC X(35) VALUE
                       'PASSWORD IS INVALID'.
               05  FILLER              PIC X(35) VALUE
                       'PRINTER ID INVALID'.
               05  FILLER              PIC X(35) VALUE
                       'IMS LTERM ID ERROR'.
           03  FILLER REDEFINES ERROR-MESSAGES.
               05  ERROR-MESSAGE       OCCURS 11
                                       PIC X(35).

       LINKAGE SECTION.

       01  DFHCOMMAREA                 PIC X(10).

       01  BLL-CELLS                   COMP.
           05  SELF-POINTER            PIC S9(08).
           05  DLIUIB-BLL              PIC S9(08).
           05  PCBLIST-BLL             PIC S9(08).
           05  PCB1-BLL                PIC S9(08).

           COPY DLIUIB.

       01  PCB-LIST                    COMP.
           05  PCB-LIST-BLL1           PIC S9(08).
           SKIP1
       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(08).
           03  DEMO-KEYFEEDBCK         PIC X(100).

       PROCEDURE DIVISION.

       A-010-MAINLINE.

           SERVICE RELOAD BLL-CELLS.

           IF EIBAID EQUAL DFHCLEAR
               EXEC CICS RETURN
                   END-EXEC.

           PERFORM C-010-INITIALIZE THRU C-010-EXIT.

           IF EIBCALEN EQUAL +0
               MOVE LOW-VALUES         TO DEMO91O
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
           ELSE
               MOVE DFHCOMMAREA        TO COMM-AREA
               PERFORM A-030-PROCESS-TRAN THRU A-030-EXIT.

       A-010-EXIT.
           EXEC CICS RETURN            COMMAREA (COMM-AREA)
                                       LENGTH   (8)
                                       TRANSID  ('CDLI')
               END-EXEC.

       A-020-FIRST-TIME.

           IF HSUB NOT = 0
               MOVE ERROR-MESSAGE (HSUB) TO DEMO91-ERR-MSGO
           ELSE
               MOVE SPACES               TO DEMO91-ERR-MSGO.
           MOVE 'OTDEMO91'               TO COMMAREA-PROGRAM.
           EXEC CICS SEND              MAP    ('DEMO91')
                                       MAPSET ('DLIDEMO')
                                       FROM   (DEMO91O)
                                       ERASE
                                       FREEKB
               END-EXEC.

       A-020-EXIT.
           EXIT.

       A-022-FIRST-TIME.

      *** SEND BACK INITIAL DEMO92 SCREEN (UPDATE)
      *
           IF HSUB NOT = 0
               MOVE ERROR-MESSAGE (HSUB) TO DEMO92-ERR-MSGO
           ELSE
               MOVE SPACES               TO DEMO92-ERR-MSGO.

           MOVE 'OTDEMO92'               TO COMMAREA-PROGRAM.
           EXEC CICS SEND              MAP    ('DEMO92')
                                       MAPSET ('DLIDEMO')
                                       FROM   (DEMO92O)
                                       CURSOR
                                       ERASE
                                       FREEKB
               END-EXEC.

       A-022-EXIT.
           EXIT.

       A-030-PROCESS-TRAN.

      *** IF MENU SCREEN - DETERMINE WHICH FUNTION TO PROCESS
      *
           IF COMMAREA-PROGRAM = 'OTDEMO91'
               PERFORM A-035-EDIT-MENU THRU A-035-EXIT
           ELSE
               PERFORM B-010-PROCESS-SCREEN2 THRU B-010-EXIT.

      *** OTHERWISE PROCESS UPDATE SCREEN
      *
       A-030-EXIT.
           EXIT.

       A-035-EDIT-MENU.

      ***  PRESET EDIT FAILURE SWITCH TO OFF
      *
           MOVE '0'                    TO EDIT-SWITCH.

           EXEC CICS RECEIVE           MAP    ('DEMO91')
                                       MAPSET ('DLIDEMO')
                                       INTO   (DEMO91I)
               END-EXEC.

      ***  EDIT MENU INPUT
      *
           IF DEMO91-FUNCTIONI NOT = 'A' AND NOT = 'C' AND NOT = 'D'
                           AND NOT = 'I' AND NOT = 'M' AND NOT = 'E'
                           AND NOT = 'P'
               MOVE '1'                TO EDIT-SWITCH
               MOVE ATTR-UXMBL         TO DEMO91-FUNCTIONA
               MOVE -1                 TO DEMO91-FUNCTIONL
               IF HSUB = 0
                   MOVE 2              TO HSUB.
           IF DEMO91-FUNCTIONI NOT = 'M' AND NOT = 'E' AND NOT = 'P'
               IF DEMO91-TABLE-IDI NOT > SPACES
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE ATTR-UXMBL     TO DEMO91-TABLE-IDA
                   MOVE -1             TO DEMO91-TABLE-IDL
                   IF HSUB = 0
                       MOVE 4          TO HSUB.

      ***  IF EDITS FLOPPED RETURN MENU SCREEN
      *
           IF EDIT-SWITCH = '1'
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO A-035-EXIT.

      ***  IF END FUNCTION INDICATED RETURN COMMON END SCREEN - END TASK
      *
           IF DEMO91-FUNCTIONI = 'E'
               PERFORM C-100-RETURN THRU C-100-EXIT
               GO TO A-035-EXIT.

      ***  RETRIEVE TABLE HEADER RECORD
      *
           PERFORM A-036-GET-HEADER THRU A-036-EXIT.

      ***  DEMO TO SEE IF HEADER RECORD IS REQUIRED - TRUE IF ADD ONLY
      *
           IF DEMO91-FUNCTIONI NOT = 'A'
               IF DEMO-STATUS NOT = BB
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE -1             TO DEMO91-TABLE-IDL
                   MOVE ATTR-UXMBL     TO DEMO91-TABLE-IDA
                   IF HSUB = 0
                       MOVE 5          TO HSUB.

      ***  IF DEMO FAILS RETURN MENU
      *
           IF EDIT-SWITCH = '1'
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO A-035-EXIT.

      ***  RESET IO AREA - START BUILDING UPDATE SCREEN (DEMO92)
      *
           MOVE '1'                    TO FIRST-TIME.
           MOVE '1'                    TO DEMO92-STATUSO.
           MOVE DEMO91-TABLE-IDI       TO DEMO92-TABLE-IDO.
           MOVE DEMO91-FUNCTIONI       TO DEMO92-PROCESS-INDO.
           IF DEMO91-FUNCTIONI = 'A'
               MOVE 'ADD'              TO DEMO92-TYPEO.
           IF DEMO91-FUNCTIONI = 'C'
               MOVE 'CHANGE'           TO DEMO92-TYPEO.
           IF DEMO91-FUNCTIONI = 'D'
               MOVE 'DELETE'           TO DEMO92-TYPEO.
           IF DEMO91-FUNCTIONI = 'I'
               MOVE 'INQUIRY'          TO DEMO92-TYPEO.

      ***  IF ADD FUNCTION UNPROTECT DEMO92 HEADER FIELDS
      *
           IF DEMO91-FUNCTIONI = 'A'
               PERFORM C-027-UNPROT-ELES THRU C-027-EXIT
                   VARYING OSUB FROM 1 BY 1
                       UNTIL OSUB > 14
               IF DEMO-STATUS = BB
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE 6 TO HSUB
                   MOVE -1             TO DEMO91-TABLE-IDL
                   MOVE ATTR-UXMBL     TO DEMO91-TABLE-IDA
                   PERFORM A-020-FIRST-TIME THRU A-020-EXIT
                   GO TO A-035-EXIT
               ELSE
                   MOVE '1'            TO DEMO92-ISRT-ROOTO
                   MOVE -1             TO DEMO92-DESCL
           ELSE
               MOVE '0'                TO DEMO92-ISRT-ROOTO
               MOVE -1                 TO DEMO92-FUNCL (1)
               PERFORM A-060-LOAD-DEMO92 THRU A-060-EXIT
               IF SCREEN2-FULL = '0'
                   COMPUTE ISUB = ISUB - 1
                   PERFORM C-024-UNPROT-ELES THRU C-024-EXIT
                       VARYING OSUB FROM ISUB BY 1
                           UNTIL OSUB > 14.

      ***  SEND UPDATE SCREEN LOADED WITH TABLE HEADER DATA
      *
           IF DEMO91-FUNCTIONI = 'I'
               PERFORM C-025-PROT-INQ THRU C-025-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               MOVE 0                  TO DEMO92-FUNCL (1)
               MOVE -1                 TO DEMO92-RETURNL
               MOVE ATTR-PSMN          TO DEMO92-DESCA
                                          DEMO92-ELE-KEY-CNTA
                                          DEMO92-ELE-CHRA
                                          DEMO92-ACT-DATEA
                                          DEMO92-TBL-PROTA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA
               MOVE ATTR-PSMD          TO DEMO92-TBL-PSWA.

           IF DEMO91-FUNCTIONI = 'A'
               PERFORM C-026-PROT-ISRT THRU C-026-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14.

           IF DEMO91-FUNCTIONI = 'D' OR 'C'
               IF DEMOHDRS-PASSWORD-PROT = 'Y'
                   IF DEMO91-PASSWORDI NOT = DEMOHDRS-PASSWORD
                       MOVE -1         TO DEMO91-PASSWORDL
                       MOVE 9          TO HSUB
                       MOVE '0'        TO FIRST-TIME
                       PERFORM A-020-FIRST-TIME THRU A-020-EXIT
                       GO TO A-035-EXIT.

           IF DEMO91-FUNCTIONI = 'D'
               PERFORM C-025-PROT-INQ THRU C-025-EXIT
                VARYING ISUB FROM 1 BY 1 UNTIL ISUB > 14
               MOVE -1                 TO DEMO92-RETURNL
               MOVE ATTR-PSMN          TO DEMO92-DESCA
                                          DEMO92-ELE-KEY-CNTA
                                          DEMO92-ELE-CHRA
                                          DEMO92-ACT-DATEA
                                          DEMO92-TBL-PROTA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA
               MOVE ATTR-PSMD          TO DEMO92-TBL-PSWA
               MOVE 0                  TO DEMO92-FUNCL (1)
               MOVE 8                  TO HSUB.

           PERFORM A-022-FIRST-TIME THRU A-022-EXIT.

       A-035-EXIT.
           EXIT.

       A-036-GET-HEADER.

      ***  SET UP DEMOHDRS SSA
      *
           MOVE DEMO91-TABLE-IDI       TO HDRS-FLDVALUE1.
           PERFORM A-045-GHU-HDRS THRU A-045-EXIT.

       A-036-EXIT.
           EXIT.

       A-045-GHU-HDRS.

      ***  DL/I CALL TO GHU DEMOHDRS SEGMENT
      *
           MOVE '-'                    TO HDRS-COM1.
           CALL 'CBLTDLI'           USING GHU
                                          DEMO-PCB
                                          DEMOHDRS
                                          SSA-HDRS.
           IF DEMOHDRS-LAST-ACT-DATE NOT NUMERIC
               MOVE ZEROES             TO DEMOHDRS-LAST-ACT-DATE.
           MOVE DEMOHDRS-LAST-ACT-DATE TO DATE-WORK.
           IF DEMO-STATUS NOT = BB AND NOT = GE
               MOVE 3701               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.

       A-045-EXIT.
           EXIT.

       A-060-LOAD-DEMO92.

      ***  ROUTINE TO PRE-LOAD DEMO92 WITH DEMOHDRS DATA
      *
           MOVE DEMOHDRS-TABLE-DESCRIPTOR TO DEMO92-DESCO.
           MOVE DEMOHDRS-KEY-CHAR-CNT     TO DEMO92-ELE-KEY-CNTO.
           MOVE DEMOHDRS-ELE-CHAR-CNT     TO DEMO92-ELE-CHRO.
           MOVE DEMOHDRS-LAST-ACT-DATE    TO DATE-WORK.
           MOVE DATE-YY                   TO GREG-YY.
           MOVE DATE-MM                   TO GREG-MM.
           MOVE DATE-DD                   TO GREG-DD.
           MOVE GREGORIAN-DATE-WORK       TO DEMO92-ACT-DATEO.
           MOVE DEMOHDRS-PASSWORD-PROT    TO DEMO92-TBL-PROTO.
           MOVE DEMOHDRS-PASSWORD         TO DEMO92-TBL-PSWO.
           MOVE DEMOHDRS-NUMERIC-KEY      TO DEMO92-ELE-NUM-KEYO.
           MOVE DEMOHDRS-NUMERIC-ELE      TO DEMO92-ELE-NUM-VALO.
           MOVE '0'                       TO FIRST-TIME.

      ***  EXIT SCREEN BUILD IF ADD OR DELETE PROCESSING
      *
           IF DEMO91-FUNCTIONI = 'A' OR 'D'
               GO TO A-060-EXIT.
           MOVE '1'                       TO SCREEN2-FULL.

      ***  DEMO IF ELEMENT KEY HAS BEEN INPUT - IF SO POSITION DATA BASE
      *
           IF DEMO91-ELESI NOT > SPACES
               MOVE ' ='                  TO ELES-RLO1
               MOVE ' '                   TO ELES-COM1
               MOVE '1'                   TO FIRST-TIME
               PERFORM A-070-GNP-ELES THRU A-070-EXIT
                   VARYING ISUB FROM 1 BY 1
                        UNTIL ISUB > 14
                           OR DEMO-STATUS NOT = BB
               PERFORM A-070-GNP-ELES THRU A-070-EXIT
           ELSE
               MOVE '-'                TO ELES-COM1
               MOVE '=>'               TO ELES-RLO1
               MOVE DEMO91-ELESI       TO ELES-FLDVALUE1
               MOVE '1'                TO FIRST-TIME
               PERFORM A-075-GNP-ELES THRU A-075-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
                          OR DEMO-STATUS NOT = BB.

       A-060-EXIT.
           EXIT.

       A-065-UNPROT-DEMO92.

      ***  UNPROTECT DEMOHDRS DATA FIELDS ON DEMO92 SCREEN - ADD
      *
           MOVE ATTR-PSMN              TO DEMO92-TABLE-IDA.
           MOVE ATTR-UXMN              TO DEMO92-DESCA
                                          DEMO92-ELE-KEY-CNTA
                                          DEMO92-ELE-CHRA
                                          DEMO92-ACT-DATEA
                                          DEMO92-TBL-PROTA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA.
           MOVE ATTR-UXMD              TO DEMO92-TBL-PSWA.

       A-065-EXIT.
           EXIT.

       A-070-GNP-ELES.

      *** RETRIEVE DEMOELES SEGMENTS WITH UNQUALIFIED SSA
      *
           MOVE ' '                    TO ELES-COM1.
           CALL 'CBLTDLI'           USING GNP
                                          DEMO-PCB
                                          DEMOELES
                                          SSA-HDRS
                                          SSA-ELES.
           IF ISUB = 15
               IF DEMO-STATUS  = GE
                   MOVE SPACES         TO DEMO92-NEXT-KEYO
                   GO TO A-070-EXIT
               ELSE
                   MOVE DEMOELES-KEY   TO DEMO92-NEXT-KEYO
                   GO TO A-070-EXIT.
           IF DEMO-STATUS  = GE
               MOVE '0'                TO SCREEN2-FULL
               GO TO A-070-EXIT.
           IF DEMO-STATUS NOT = BB AND NOT = GE
               MOVE 3702               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.
           PERFORM A-080-BUILD-ELES-DEMO92 THRU A-080-EXIT.

       A-070-EXIT.
           EXIT.

       A-075-GNP-ELES.

      *** RETRIEVE DEMOELES SEGMENTS WITH QUALIFIED SSA ON FIRST CALL
      *
           CALL 'CBLTDLI'           USING GNP
                                          DEMO-PCB
                                          DEMOELES
                                          SSA-HDRS
                                          SSA-ELES.
           IF FIRST-TIME = '1'
               MOVE '0'                TO FIRST-TIME
               MOVE ' ='               TO ELES-RLO1
               MOVE SPACE              TO ELES-COM1.
           IF ISUB = 15
               IF DEMO-STATUS = GE
                   MOVE SPACES         TO DEMO92-NEXT-KEYO
                   GO TO A-075-EXIT
               ELSE
                   MOVE DEMOELES-KEY   TO DEMO92-NEXT-KEYO
                   GO TO A-075-EXIT.
           IF DEMO-STATUS NOT = BB AND NOT = GE
               MOVE 3702               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.
           IF DEMO-STATUS  = GE
               MOVE '0'                TO SCREEN2-FULL
               MOVE SPACES             TO DEMO92-NEXT-KEYO
               GO TO A-075-EXIT.
           MOVE DEMOELES-KEY           TO DEMO92-NEXT-KEYO.
           PERFORM A-080-BUILD-ELES-DEMO92 THRU A-080-EXIT.

       A-075-EXIT.
           EXIT.

       A-080-BUILD-ELES-DEMO92.

      *** ROUTINE TO LOAD DEMO92 SCREEN WITH DEMOELES DATA
      *
           MOVE DEMOELES-KEY           TO DEMO92-LAST-KEYO.
           MOVE DEMOELES-KEY           TO DEMO92-ELE-KEYO (ISUB).
           MOVE DEMOELES-ELE-DATA      TO DEMO92-ELE-DATAO (ISUB).

       A-080-EXIT.
           EXIT.

       B-010-PROCESS-SCREEN2.

           EXEC CICS RECEIVE           MAP    ('DEMO92')
                                       MAPSET ('DLIDEMO')
                                       INTO   (DEMO92I)
               END-EXEC.

      *** MAINLINE DRIVER FOR PROCESSING DEMO92 SCREEN - ADD,CHANGE,DEL
      *
           MOVE LOW-VALUES             TO DEMO91O.

      *** DEMO FOR LINE INPUT OF ADD FUNCTION - IF SO GO ADD
      *
           IF DEMO92-PROCESS-INDI = 'A'
               PERFORM B-020-ADD-DEMO92 THRU B-020-EXIT.

      *** DEMO FOR LINE INPUT OF CHANGE
      *
           IF DEMO92-PROCESS-INDI = 'C'
               PERFORM B-050-CHG THRU B-050-EXIT.

      *** DEMO FOR LINE INPUT OF DELETE - IF SO GO DELETE
      *
           IF DEMO92-PROCESS-INDI = 'D'
               PERFORM B-060-DEL THRU B-060-EXIT.

      *** DEMO FOR LINE INPUT OF INQUIRY
      *
           IF DEMO92-PROCESS-INDI = 'I'
               PERFORM B-080-DISPLAY THRU B-080-EXIT.

       B-010-EXIT.
           EXIT.

       B-020-ADD-DEMO92.

      *** ELEMENT LEVEL ADD MAINLINE
      *
      *** MAKE SURE A CONTINUATION INDICATOR HAS BEEN INPUT BY USER
      *
           IF    DEMO92-CONTI   < 'A'
             AND DEMO92-RETURNI < 'A'
             AND DEMO92-ABORTI  < 'A'
               MOVE 'X'                TO DEMO92-CONTO.

      *** GO DUPLICATE A SCREEN
      *
           IF DEMO92-CONTI = 'D'
               MOVE ' '                TO DEMO92-CONTO
               PERFORM B-022-DUPLICATE THRU B-022-EXIT
                   VARYING J FROM 2 BY 1
                       UNTIL J > 14
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               GO TO B-020-EXIT.

      *** IF CONTINUATION INDICATOR  = ABORT - RETURN TO MAIN MENU
      *
           IF  DEMO92-ABORTI > SPACE AND NOT = '?'
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-020-EXIT.

      *** IF DEMOHDRS IS TO BE INSERTED - EDIT INPUT DATA
      *
      *** IF ROOT EDIT FLOPS - RETURN SCREEN - EXIT
      *
           IF DEMO92-ISRT-ROOTI = '1'
               PERFORM B-029-EDIT-ROOT-DATA THRU B-029-EXIT
               IF EDIT-SWITCH = '1'
                   MOVE 1              TO ISUB
                   PERFORM C-027-UNPROT-ELES THRU C-027-EXIT
                       VARYING OSUB FROM ISUB BY 1
                           UNTIL OSUB > 14
                   PERFORM A-022-FIRST-TIME THRU A-022-EXIT
                   GO TO B-020-EXIT.

      *** ISRT DEMOHDRS SEGMENT
      *
           IF DEMO92-ISRT-ROOTI = '1'
               MOVE '0'                TO DEMO92-ISRT-ROOTO
               MOVE '1'                TO DATE-SW
               PERFORM B-055-REPL-ACT-DATE THRU B-055-EXIT
               PERFORM B-025-ISRT-ROOT THRU B-025-EXIT
           ELSE
               MOVE DEMO92-TABLE-IDI   TO HDRS-FLDVALUE1
               PERFORM A-045-GHU-HDRS THRU A-045-EXIT.

           IF DEMO92-ISRT-ROOTI = '0'
               PERFORM B-029-EDIT-ROOT-DATA THRU B-029-EXIT
               IF EDIT-SWITCH = '1'
                   PERFORM A-022-FIRST-TIME THRU A-022-EXIT
                   GO TO B-020-EXIT
               ELSE
                   PERFORM B-026-REPL-ROOT THRU B-026-EXIT.

      *** EDIT & INST ELEMENT DATA INPUT (DEMOELES)
      *
           PERFORM B-040-ADD THRU B-040-EXIT
               VARYING ISUB FROM 1 BY 1
                   UNTIL ISUB > 14.

      *** IF EDITS FLOPPED - RETURN SCREEN - EXIT
      *
           IF SCREEN2-AGAIN = '1'
               MOVE 1                  TO ISUB
               COMPUTE PSUB = PSUB + 1
               PERFORM C-027-UNPROT-ELES THRU C-027-EXIT
                   VARYING OSUB FROM PSUB BY 1
                       UNTIL OSUB > 14
               PERFORM C-026-PROT-ISRT THRU C-026-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               PERFORM D-001-BUBBLE-TO-MATRIX THRU D-001-EXIT
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               GO TO B-020-EXIT.

      *** DETERMINE CONTINUATION CRITERION
      *
           IF DEMO92-RETURNI > SPACE OR DEMO92-ABORTI > SPACE
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-020-EXIT.

      *** CLEAN OUT DEMOELES MATRIX AREA ON SCREEN
      *
           IF DEMO92-CONTI > SPACE
               PERFORM D-002-CLEAR-MATRIX THRU D-002-EXIT
               MOVE 1                  TO ISUB
               PERFORM C-027-UNPROT-ELES THRU C-027-EXIT
                   VARYING OSUB FROM ISUB BY 1
                       UNTIL OSUB > 14
               PERFORM C-026-PROT-ISRT THRU C-026-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14.
           MOVE -1                     TO DEMO92-ELE-KEYL (1).

      *** RETURN THE DEMO92 SCREEN
      *
           PERFORM A-022-FIRST-TIME THRU A-022-EXIT.

       B-020-EXIT.
           EXIT.

       B-022-DUPLICATE.

           MOVE ATTR-UXMN              TO DEMO92-ELE-KEYA (J).
           MOVE 0                      TO DEMO92-ELE-KEYL(J).
           MOVE ATTR-UXMN              TO DEMO92-ELE-DATAA (J).
           MOVE 0                      TO DEMO92-ELE-DATAL(J).
           MOVE ATTR-UXMN              TO DEMO92-FUNCA (J).
           MOVE 0                      TO DEMO92-FUNCL(J).
           MOVE DEMO92-ELE-KEYI (1)    TO DEMO92-ELE-KEYO (J).
           MOVE DEMO92-ELE-DATAI (1)   TO DEMO92-ELE-DATAO (J).
           MOVE 'A'                    TO DEMO92-FUNCO (J).

       B-022-EXIT.
           EXIT.

       B-025-ISRT-ROOT.

      *** ROUTINE TO INSERT DEMOHDRS SEGMENT
      *
           MOVE DEMO92-TABLE-IDI       TO DEMOHDRS-KEY
                                          HDRS-FLDVALUE1.
           MOVE DEMO92-DESCI           TO DEMOHDRS-TABLE-DESCRIPTOR.
           MOVE DEMO92-ELE-KEY-CNTI    TO DEMOHDRS-KEY-CHAR-CNT.
           MOVE DEMO92-ELE-CHRI        TO DEMOHDRS-ELE-CHAR-CNT.
           MOVE DEMO92-TBL-PROTI       TO DEMOHDRS-PASSWORD-PROT.
           MOVE DEMO92-TBL-PSWI        TO DEMOHDRS-PASSWORD.
           MOVE DEMO92-ELE-NUM-KEYI    TO DEMOHDRS-NUMERIC-KEY.
           MOVE DEMO92-ELE-NUM-VALI    TO DEMOHDRS-NUMERIC-ELE.
           MOVE SPACE                  TO HDRS-COM1.

           CALL 'CBLTDLI'           USING ISRT
                                          DEMO-PCB
                                          DEMOHDRS
                                          SSA-HDRS.

           IF DEMO-STATUS NOT = BB
               MOVE 3702               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.

       B-025-EXIT.
           EXIT.

       B-026-REPL-ROOT.

           IF DATE-SW = '1'
               MOVE DATE-WORK          TO DEMOHDRS-LAST-ACT-DATE.

      *** ROUTINE TO REPLACE DEMOHDRS SEGMENT
      *
           MOVE DEMO92-TABLE-IDI       TO HDRS-FLDVALUE1.
           PERFORM A-045-GHU-HDRS THRU A-045-EXIT.
           IF   (DEMO92-DESCI        = DEMOHDRS-TABLE-DESCRIPTOR
             AND DEMO92-ELE-KEY-CNTI = DEMOHDRS-KEY-CHAR-CNT
             AND DEMO92-ELE-CHRI     = DEMOHDRS-ELE-CHAR-CNT
             AND DEMO92-TBL-PROTI    = DEMOHDRS-PASSWORD-PROT
             AND DEMO92-TBL-PSWI     = DEMOHDRS-PASSWORD
             AND DEMO92-ELE-NUM-KEYI = DEMOHDRS-NUMERIC-KEY
             AND DEMO92-ELE-NUM-VALI = DEMOHDRS-NUMERIC-ELE)
             AND DATE-SW = '0'
               NEXT SENTENCE
           ELSE
               MOVE DEMO92-DESCI        TO DEMOHDRS-TABLE-DESCRIPTOR
               MOVE DEMO92-ELE-KEY-CNTI TO DEMOHDRS-KEY-CHAR-CNT
               MOVE DEMO92-ELE-CHRI     TO DEMOHDRS-ELE-CHAR-CNT
               MOVE CURRENT-DATE        TO GREGORIAN-DATE-WORK
               MOVE GREG-YY             TO DATE-YY
               MOVE GREG-MM             TO DATE-MM
               MOVE GREG-DD             TO DATE-DD
               MOVE DATE-WORK           TO DEMOHDRS-LAST-ACT-DATE
               MOVE GREGORIAN-DATE-WORK TO DEMO92-ACT-DATEO
               MOVE DEMO92-TBL-PROTI    TO DEMOHDRS-PASSWORD-PROT
               MOVE DEMO92-TBL-PSWI     TO DEMOHDRS-PASSWORD
               MOVE DEMO92-ELE-NUM-KEYI TO DEMOHDRS-NUMERIC-KEY
               MOVE DEMO92-ELE-NUM-VALI TO DEMOHDRS-NUMERIC-ELE
               MOVE SPACE               TO HDRS-COM1
               CALL 'CBLTDLI'        USING REPL
                                           DEMO-PCB
                                           DEMOHDRS
                                           SSA-HDRS
               IF DEMO-STATUS NOT = BB
                   MOVE 3703            TO 9000-ABEND-CODE
                   PERFORM C-099-ABEND THRU C-099-EXIT.

       B-026-EXIT.
           EXIT.

       B-028-ISRT-ELES.

      *** ROUTINE TO INSERT DEMOELES SEGMENT
      *
           IF DEMO92-ELE-KEYI (ISUB) NOT > SPACES
               GO TO B-028-EXIT.
           MOVE '-'                     TO HDRS-COM1.
           MOVE ' '                     TO ELES-COM1.
           MOVE DEMO92-TABLE-IDI        TO HDRS-FLDVALUE1.
           MOVE DEMO92-ELE-KEYI (ISUB)  TO DEMOELES-KEY.
           MOVE DEMO92-ELE-DATAI (ISUB) TO DEMOELES-ELE-DATA.
           MOVE ' '                     TO ELES-COM1.
           CALL 'CBLTDLI'            USING ISRT
                                           DEMO-PCB
                                           DEMOELES
                                           SSA-HDRS
                                           SSA-ELES.
           IF DEMO-STATUS NOT = BB AND NOT = II
               MOVE 3704               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.

       B-028-EXIT.
           EXIT.

       B-029-EDIT-ROOT-DATA.

      *** ROUTINE TO EDIT CRT INPUT OF DEMOHDRS DATA
      *
           IF   DEMO92-DESCI NOT > SPACES
             OR DEMO92-DESCI = '?????'
               MOVE ALL '?'            TO DEMO92-DESCO
               MOVE '1'                TO EDIT-SWITCH
               MOVE ATTR-UXMBL         TO DEMO92-DESCA
               MOVE -1                 TO DEMO92-DESCL
               IF HSUB = 0
                   MOVE 4              TO HSUB.

           IF    DEMO92-ELE-KEY-CNTI NOT NUMERIC
             OR (DEMO92-ELE-KEY-CNTI < 1 OR > 20)
               MOVE ATTR-UXMBL         TO DEMO92-ELE-KEY-CNTA
               MOVE -1                 TO DEMO92-ELE-KEY-CNTL
               MOVE '1'                TO EDIT-SWITCH
               IF HSUB = 0
                   MOVE 2              TO HSUB.
               IF   DEMO92-ELE-CHRI NOT NUMERIC
                 OR DEMO92-ELE-CHRI > 50
                   MOVE ATTR-UXMBL     TO DEMO92-ELE-CHRA
                   MOVE -1             TO DEMO92-ELE-CHRL
                   MOVE '1'            TO EDIT-SWITCH
                   IF HSUB = 0
                       MOVE 2          TO HSUB.

           IF DEMO92-TBL-PROTI NOT = 'Y' AND NOT = 'N' AND NOT = ' '
               MOVE '1'                TO EDIT-SWITCH
               MOVE ATTR-UXMBL         TO DEMO92-TBL-PROTA
               MOVE -1                 TO DEMO92-TBL-PROTL
               IF HSUB = 0
                   MOVE 2              TO HSUB.

           IF DEMO92-TBL-PROTI NOT > SPACES
               MOVE 'N'                TO DEMO92-TBL-PROTO.

           IF DEMO92-TBL-PROTI = 'Y'
               IF DEMO92-TBL-PSWI NOT > SPACES
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE ATTR-UXMD      TO DEMO92-TBL-PSWA
                   MOVE -1             TO DEMO92-TBL-PSWL
                   IF HSUB = 0
                       MOVE 4          TO HSUB.

           IF DEMO92-ELE-NUM-KEYI NOT = 'Y' AND NOT = 'N' AND NOT = ' '
               MOVE '1'                TO EDIT-SWITCH
               MOVE ATTR-UXMBL         TO DEMO92-ELE-NUM-KEYA
               MOVE -1                 TO DEMO92-ELE-NUM-KEYL
               IF HSUB = 0
                   MOVE 2              TO HSUB.

           IF DEMO92-ELE-NUM-VALI NOT = 'Y' AND NOT = 'N' AND NOT = ' '
               MOVE '1'                TO EDIT-SWITCH
               MOVE ATTR-UXMBL         TO DEMO92-ELE-NUM-VALA
               MOVE -1                 TO DEMO92-ELE-NUM-VALL
               IF HSUB = 0
                   MOVE 2              TO HSUB.

           IF DEMO92-ISRT-ROOTI = '1'
               GO TO B-029-EXIT.

           IF EDIT-SWITCH = '1'
               GO TO B-029-EXIT.

           IF DEMO92-ELE-KEY-CNTI < DEMOHDRS-KEY-CHAR-CNT
               MOVE ATTR-UXMBL         TO DEMO92-ELE-KEY-CNTA
               MOVE -1                 TO DEMO92-ELE-KEY-CNTL
               MOVE '1'                TO EDIT-SWITCH
               IF HSUB = 0
                   MOVE 7 TO HSUB.

           IF DEMO92-ELE-CHRI < DEMOHDRS-ELE-CHAR-CNT
               MOVE ATTR-UXMBL         TO DEMO92-ELE-CHRA
               MOVE -1                 TO DEMO92-ELE-CHRL
               MOVE '1'                TO EDIT-SWITCH
               IF HSUB = 0
                   MOVE 7              TO HSUB.

       B-029-EXIT.
           EXIT.

       B-040-ADD.

      *** ROUTINE TO EDIT CRT INPUT OF DEMOELES DATA
      *
      *** SKIP THOSE LINE WHERE NO INPUT WAS KEYED
      *
           MOVE ATTR-UXMN              TO DEMO92-ELE-KEYA (ISUB).
           MOVE 'A'                    TO DEMO92-FUNCO (ISUB).
           MOVE ATTR-PSMN              TO DEMO92-FUNCA (ISUB).
           IF DEMO92-ELE-KEYI (ISUB) NOT > SPACES
               GO TO B-040-EXIT.

      *** EDIT INPUT KEY LENGTH AGAINST HEADER PARAMETER
      *
           PERFORM B-056-CHECK-KEY-CNT THRU B-056-EXIT.
           IF LENGTH-ERROR = '1'
               MOVE '1'                TO EDIT-SWITCH
               MOVE -1                 TO DEMO92-ELE-KEYL (ISUB)
               MOVE ATTR-UXMBL         TO DEMO92-ELE-KEYA (ISUB)
               IF HSUB = 0
                   MOVE 3              TO HSUB.

      *** EDIT INPUT DATA LENGTH AGAINST HEADER PARAMETER
      *
           PERFORM B-058-CHECK-CHR-CNT THRU B-058-EXIT.
           IF LENGTH-ERROR = '1'
               MOVE '1'                TO EDIT-SWITCH
               MOVE -1                 TO DEMO92-ELE-DATAL (ISUB)
               MOVE ATTR-UXMBL         TO DEMO92-ELE-DATAA (ISUB)
               IF HSUB = 0
                   MOVE 3              TO HSUB.

      *** IF NO EDIT FLOP WAS DETECTED - ISRT THE DEMOELES SEGMENT
      *
           IF EDIT-SWITCH = '0'
               PERFORM B-028-ISRT-ELES THRU B-028-EXIT
               IF DEMO-STATUS = II
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE -1             TO DEMO92-FUNCL (ISUB)
                   MOVE ATTR-UXMBL     TO DEMO92-FUNCA (ISUB)
                   COMPUTE PSUB = PSUB + 1
                   MOVE CRT-LINEI (ISUB) TO S-CRT-LINE (PSUB)
                   MOVE '1'            TO SCREEN2-AGAIN
                   IF HSUB = 0
                       MOVE 6          TO HSUB
                   ELSE
                       NEXT SENTENCE
              ELSE
                   MOVE '0'            TO EDIT-SWITCH
           ELSE
              COMPUTE PSUB = PSUB + 1
              MOVE CRT-LINEI (ISUB)    TO S-CRT-LINE (PSUB)
              MOVE '1'                 TO SCREEN2-AGAIN
              MOVE '0'                 TO EDIT-SWITCH.

       B-040-EXIT.
           EXIT.

       B-050-CHG.

      *** MAINLINE DRIVER FOR UPDATE FUNCTION
      *
      *** GO DUPLICATE A SCREEN
      *
           IF DEMO92-CONTI = 'D'
               MOVE ' ' TO DEMO92-CONTO
               PERFORM B-022-DUPLICATE THRU B-022-EXIT
                   VARYING J FROM 2 BY 1
                       UNTIL J > 14
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               GO TO B-050-EXIT.

      *** DEMO CONTINUATION CRITERION
      *
           MOVE '0'                    TO EDIT-SWITCH.
           MOVE '0'                    TO CHANGE-ADD-SW.
           MOVE DEMO92-TABLE-IDI       TO HDRS-FLDVALUE1.
           PERFORM A-045-GHU-HDRS THRU A-045-EXIT.
           IF    DEMO92-CONTI   < 'A'
             AND DEMO92-RETURNI < 'A'
             AND DEMO92-ABORTI  < 'A'
               MOVE 'X'                TO DEMO92-CONTO.
           IF DEMO92-ABORTI > SPACE AND NOT = '?'
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-050-EXIT.
           PERFORM B-029-EDIT-ROOT-DATA THRU B-029-EXIT.
           IF EDIT-SWITCH = '1'
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               GO TO B-050-EXIT
           ELSE
               MOVE '0'                TO DATE-SW
               PERFORM B-052-UPDATE THRU B-052-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               PERFORM B-055-REPL-ACT-DATE THRU B-055-EXIT
               PERFORM B-026-REPL-ROOT THRU B-026-EXIT.

      *** RETURN SCREEN IF AN ERROR WAS DETECTED
      *
      *** YOU WILL HAVE PROBLEMS HERE
      *
           IF SCREEN2-AGAIN = '1'
               MOVE 1                  TO ISUB
               COMPUTE PSUB = PSUB + 1
               PERFORM C-024-UNPROT-ELES THRU C-024-EXIT
                   VARYING OSUB FROM PSUB BY 1
                       UNTIL OSUB > 14
               PERFORM D-001-BUBBLE-TO-MATRIX THRU D-001-EXIT
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               GO TO B-050-EXIT.

      *** ASCERTAIN CONTINUATION REQUEST
      *
           IF   DEMO92-RETURNI > SPACE
             OR DEMO92-ABORTI  > SPACE
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-050-EXIT.

      *** CHANGE FUNCTION DETECTED LINE ADD(S) RETURN NULL SCREEN
      *
           IF DEMO92-CONTI > SPACE
               IF CHANGE-ADD-SW = '1'
                   PERFORM D-002-CLEAR-MATRIX THRU D-002-EXIT
                   MOVE 1              TO ISUB
                   PERFORM C-027-UNPROT-ELES THRU C-027-EXIT
                       VARYING OSUB FROM ISUB BY 1
                           UNTIL OSUB > 14
                   PERFORM C-024-UNPROT-ELES THRU C-024-EXIT
                       VARYING OSUB FROM 1 BY 1
                           UNTIL OSUB > 14
                   MOVE -1             TO DEMO92-ELE-KEYL (1)
                   PERFORM A-022-FIRST-TIME THRU A-022-EXIT
                   GO TO B-050-EXIT.

      *** CONTINUE WAS SELECTED - UPDATE DATA BASE POSITION REQUEST
      *
           IF DEMO92-CONTI > SPACE
               IF DEMO92-NEXT-KEYI > SPACES
                   MOVE DEMO92-NEXT-KEYI TO DEMO92-LAST-KEYO.

      *** CONTINUE WAS SELECTED - RETURN MORE DEMOELES SEGMENTS
      *
           IF DEMO92-CONTI > SPACE
               PERFORM D-002-CLEAR-MATRIX THRU D-002-EXIT
               PERFORM C-023-PROT-ELES THRU C-023-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               MOVE '1'                TO FIRST-TIME
               MOVE DEMO92-TABLE-IDI   TO HDRS-FLDVALUE1
               PERFORM A-045-GHU-HDRS THRU A-045-EXIT
               MOVE DEMO92-NEXT-KEYI   TO ELES-FLDVALUE1
               MOVE '=>'               TO ELES-RLO1
               MOVE '-'                TO ELES-COM1
               MOVE '1'                TO FIRST-TIME
                                          SCREEN2-FULL
               PERFORM A-075-GNP-ELES THRU A-075-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
                          OR DEMO-STATUS NOT = BB
               PERFORM A-075-GNP-ELES THRU A-075-EXIT
               PERFORM B-051-DASH-CHANGE THRU B-051-EXIT
           ELSE
               PERFORM D-002-CLEAR-MATRIX THRU D-002-EXIT
               MOVE SPACES             TO DEMO92-NEXT-KEYO
               PERFORM C-023-PROT-ELES THRU C-023-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               MOVE '1'                TO FIRST-TIME
               MOVE -1                 TO DEMO92-FUNCL (1)
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT.

      *** SEND BACK DEMO92 SCREEN
      *
       B-050-EXIT.
           EXIT.

       B-051-DASH-CHANGE.
           IF DEMO-STATUS = GE OR GB
               MOVE SPACES             TO DEMO92-NEXT-KEYO
               MOVE -1                 TO DEMO92-FUNCL (1)
           ELSE
               MOVE DEMOELES-KEY       TO DEMO92-NEXT-KEYO
               MOVE -1                 TO DEMO92-FUNCL (1).
           IF SCREEN2-FULL = '0'
               COMPUTE ISUB = ISUB - 1
               PERFORM C-024-UNPROT-ELES THRU C-024-EXIT
                   VARYING OSUB FROM ISUB BY 1
                       UNTIL OSUB > 14.
           PERFORM A-022-FIRST-TIME THRU A-022-EXIT.

       B-051-EXIT.
           EXIT.

       B-052-UPDATE.

      *** DETERMINE WHAT LINE INPUT FUNCTION TO INVOKE - ADD,CHG,DELETE
      *
      *** SKIP THIS OCCURENCE IF INQUIRE FUNCTION INDICATOR PRESENT
      *
           IF DEMO92-FUNCI (ISUB) = 'I'
               GO TO B-052-EXIT.

      *** SKIP THIS OCCURENCE IF NO FUNCTION INDICATOR PRESENT
      *
           IF DEMO92-FUNCI (ISUB) NOT > SPACES
               GO TO B-052-EXIT.

      *** SKIP THIS OCCURENCE IF NO KEY DATA PRESENT
      *
           IF DEMO92-ELE-KEYI (ISUB) NOT > SPACES
               GO TO B-052-EXIT.

           IF DEMO92-FUNCI (ISUB) = 'C' OR 'A'
               PERFORM B-056-CHECK-KEY-CNT THRU B-056-EXIT
               IF LENGTH-ERROR = '1'
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE -1             TO DEMO92-ELE-KEYL (ISUB)
                   MOVE ATTR-UXMBL     TO DEMO92-ELE-KEYA (ISUB)
                   IF HSUB = 0
                       MOVE 3          TO HSUB.

           IF DEMO92-FUNCI (ISUB) = 'C' OR 'A'
               PERFORM B-058-CHECK-CHR-CNT THRU B-058-EXIT
               IF LENGTH-ERROR = '1'
                   MOVE '1'            TO EDIT-SWITCH
                   MOVE -1             TO DEMO92-ELE-DATAL (ISUB)
                   MOVE ATTR-UXMBL     TO DEMO92-ELE-DATAA (ISUB)
                   IF HSUB = 0
                       MOVE 3          TO HSUB.

           IF DEMO92-FUNCI (ISUB) NOT = 'A' AND NOT = 'C' AND NOT = 'D'
               MOVE '1'                TO EDIT-SWITCH
               MOVE -1                 TO DEMO92-FUNCL (ISUB)
               MOVE ATTR-UXMBL         TO DEMO92-FUNCA (ISUB)
               IF HSUB = 0
                   MOVE 2              TO HSUB.

      *** DEMO TO SEE IF CRT INPUT DATA ERRORS - REJECT LINE
      *
           IF EDIT-SWITCH = '1'
               COMPUTE PSUB = PSUB + 1
               MOVE CRT-LINEI (ISUB)   TO S-CRT-LINE (PSUB)
               MOVE '1'                TO SCREEN2-AGAIN
               MOVE '0'                TO EDIT-SWITCH
               GO TO B-052-EXIT.

      *** IF FUNCTION = 'C' -  PROCESS REPLACE/CHANGE
      *
           IF DEMO92-FUNCI (ISUB) = 'C'
               PERFORM B-054-REPL-DLET THRU B-054-EXIT.

      *** IF FUNCTION = 'D' - PROCESS DELETE REQUEST
      *
           IF DEMO92-FUNCI (ISUB) = 'D'
               PERFORM B-054-REPL-DLET THRU B-054-EXIT.

      *** IF FUNCTION = 'A' - PROCESS ISRT REQUEST
      *
           IF DEMO92-FUNCI (ISUB) = 'A'
               PERFORM B-053-ISRT THRU B-053-EXIT.

      *** REJECT THIS LINE INPUT - NO VALID FUNCTION INDICATOR
      *
           IF EDIT-SWITCH = '1'
               COMPUTE PSUB = PSUB + 1
               MOVE CRT-LINEI (ISUB)   TO S-CRT-LINE (PSUB)
               MOVE '1'                TO SCREEN2-AGAIN
               MOVE '0'                TO EDIT-SWITCH
               GO TO B-052-EXIT.

       B-052-EXIT.
           EXIT.

       B-053-ISRT.

      *** BUILD SSA PARAMETERS
      *
           MOVE '-'                    TO HDRS-COM1.
           MOVE DEMO92-TABLE-IDI       TO HDRS-FLDVALUE1.
           MOVE DEMO92-ELE-KEYI (ISUB) TO ELES-FLDVALUE1.

      *** ISSUE THE DEMOELES ISRT CALL
      *
           PERFORM B-028-ISRT-ELES THRU B-028-EXIT.
           MOVE '1'                    TO CHANGE-ADD-SW.
           IF DEMO-STATUS NOT = II
               MOVE '1'                TO DATE-SW.
           IF DEMO-STATUS = II
               MOVE '1'                TO EDIT-SWITCH
               MOVE -1                 TO DEMO92-FUNCL (ISUB)
               MOVE ATTR-UXMBL         TO DEMO92-FUNCA (ISUB)
               IF HSUB = 0
                   MOVE 6              TO HSUB.

       B-053-EXIT.
           EXIT.

       B-054-REPL-DLET.

      *** EDIT REPLACE/DELETE LINE INPUT
      *
      *** ISSUE GHU FOR REPL/DLET
      *
           MOVE '-'                    TO HDRS-COM1
           MOVE DEMO92-TABLE-IDI       TO HDRS-FLDVALUE1
           MOVE DEMO92-ELE-KEYI (ISUB) TO ELES-FLDVALUE1
           PERFORM B-070-GHU-ELES THRU B-070-EXIT
           IF DEMO-STATUS NOT = BB
               MOVE '1'                TO EDIT-SWITCH
               MOVE -1                 TO DEMO92-FUNCL (ISUB)
               MOVE ATTR-UXMBL         TO DEMO92-FUNCA (ISUB)
               IF HSUB = 0
                   MOVE 5              TO HSUB
                   GO TO B-054-EXIT
               ELSE
                   GO TO B-054-EXIT.

      *** ISSUE REPL FOR DEMOELES SEGMENT
      *
           IF DEMO92-FUNCI (ISUB) = 'C'
               MOVE '-'                     TO HDRS-COM1
               MOVE DEMO92-TABLE-IDI        TO HDRS-FLDVALUE1
               MOVE DEMO92-ELE-KEYI (ISUB)  TO ELES-FLDVALUE1
               MOVE ' '                     TO ELES-COM1
               MOVE DEMO92-ELE-DATAI (ISUB) TO DEMOELES-ELE-DATA
               CALL 'CBLTDLI'            USING REPL
                                               DEMO-PCB
                                               DEMOELES
               IF DEMO-STATUS = BB
                   MOVE '1'            TO DATE-SW
               ELSE
                   IF DEMO-STATUS NOT = GE
                       MOVE 3801       TO 9000-ABEND-CODE
                       PERFORM C-099-ABEND THRU C-099-EXIT.

      *** ISSUE DLET FOR DEMOELES SEGMENT
      *
           IF DEMO92-FUNCI (ISUB) = 'D'
               MOVE '-'                    TO HDRS-COM1
               MOVE DEMO92-TABLE-IDI       TO HDRS-FLDVALUE1
               MOVE DEMO92-ELE-KEYI (ISUB) TO ELES-FLDVALUE1
               PERFORM B-070-GHU-ELES THRU B-070-EXIT
               MOVE ' '                TO ELES-COM1
               CALL 'CBLTDLI'       USING DLET
                                          DEMO-PCB
                                          DEMOELES
               IF DEMO-STATUS = BB
                   MOVE '1'            TO DATE-SW
               ELSE
                   MOVE 3751           TO 9000-ABEND-CODE
                   PERFORM C-099-ABEND THRU C-099-EXIT.

       B-054-EXIT.
           EXIT.

       B-055-REPL-ACT-DATE.

           IF DATE-SW = '0'
               GO TO B-055-EXIT.

           EXEC CICS ASKTIME           ABSTIME(WORK-ABST-DATE)
               END-EXEC.

           EXEC CICS FORMATTIME        ABSTIME(WORK-ABST-DATE)
                                       DATESEP('/')
                                       MMDDYY (GREGORIAN-DATE-WORK)
               END-EXEC.

           MOVE GREG-YY                TO DATE-YY.
           MOVE GREG-MM                TO DATE-MM.
           MOVE GREG-DD                TO DATE-DD.
           MOVE DATE-WORK              TO DEMOHDRS-LAST-ACT-DATE.

       B-055-EXIT.
           EXIT.

       B-056-CHECK-KEY-CNT.

           MOVE '0'                    TO LENGTH-ERROR.
           IF DEMOHDRS-KEY-CHAR-CNT = 0
               GO TO B-056-EXIT.
           MOVE DEMO92-ELE-KEYI (ISUB)  TO GROUP-KEY-AREA.
           MOVE DEMOHDRS-KEY-CHAR-CNT   TO OSUB.
           COMPUTE OSUB = OSUB + 1.
           PERFORM B-057-VALIDATE-KEY-LENGTH THRU B-057-EXIT
               VARYING WSUB FROM OSUB BY 1
                   UNTIL WSUB > 20.

       B-056-EXIT.
           EXIT.

       B-057-VALIDATE-KEY-LENGTH.
           IF KEY-MATRIX (WSUB) > SPACE
               MOVE '1' TO LENGTH-ERROR.

       B-057-EXIT.
           EXIT.

       B-058-CHECK-CHR-CNT.
           MOVE '0'                     TO LENGTH-ERROR.
           MOVE DEMO92-ELE-DATAI (ISUB) TO GROUP-KEY-AREA.
           MOVE DEMOHDRS-ELE-CHAR-CNT   TO OSUB.
           COMPUTE OSUB = OSUB + 1.
           PERFORM B-059-VALIDATE-ELE-LENGTH THRU B-059-EXIT
               VARYING WSUB FROM OSUB BY 1
                   UNTIL WSUB > 50.

       B-058-EXIT.
           EXIT.

       B-059-VALIDATE-ELE-LENGTH.
           IF KEY-MATRIX (WSUB) > SPACE
               MOVE '1' TO LENGTH-ERROR.

       B-059-EXIT.
           EXIT.

       B-060-DEL.

      *** MAINLINE DRIVER FOR DELETE OF ENTIRE DEMOHDRS SEGMENT
      *
      *** CHECK CONTINUATION CRITERIA
      *
           IF    DEMO92-CONTI   < 'A'
             AND DEMO92-RETURNI < 'A'
             AND DEMO92-ABORTI  < 'A'
               MOVE 'X'                TO DEMO92-CONTO.

      *** IF USER INPUT ABORT COMMAND - REJECT TRANS RETURN TO MAIN MENU
      *
           IF DEMO92-ABORTI > SPACE AND NOT = '?'
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-060-EXIT.
           IF DEMO92-RETURNI NOT = 'D'
               MOVE -1                 TO DEMO92-RETURNL
               MOVE 8                  TO HSUB
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               GO TO B-060-EXIT.
           MOVE DEMO92-TABLE-IDI       TO HDRS-FLDVALUE1.

      *** SATISFY DL/I HOLD CALL REQUIREMENT
      *
           PERFORM A-045-GHU-HDRS THRU A-045-EXIT.
           MOVE ' '                    TO HDRS-COM1.

      *** DELETE DEMOHDRS SEGMENT AND ALL CHILDREN
      *
           CALL 'CBLTDLI'           USING DLET
                                          DEMO-PCB
                                          DEMOHDRS.
           IF DEMO-STATUS NOT = BB AND NOT = GE
               MOVE 3901               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.
           MOVE 'X'                    TO DEMO92-RETURNI.
           IF   DEMO92-RETURNI > SPACE
             OR DEMO92-ABORTI > SPACE
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-060-EXIT.

       B-060-EXIT.
           EXIT.

       B-070-GHU-ELES.

      *** DL/I ROUTINE TO RETRIVE WITH HOLD DEMOELES SEGMENTS
      *
           MOVE '-'                    TO ELES-COM1.
           CALL 'CBLTDLI'           USING GHU
                                          DEMO-PCB
                                          DEMOELES
                                          SSA-HDRS
                                          SSA-ELES.
           IF DEMO-STATUS NOT = BB AND NOT = GE
               MOVE 3702               TO 9000-ABEND-CODE
               PERFORM C-099-ABEND THRU C-099-EXIT.

       B-070-EXIT.
           EXIT.

       B-080-DISPLAY.

      *** MAINLINE DRIVER FOR DISPLAY FUNCTION
      *
      *** DEMO CONTINUATION CRITERION
      *
           IF    DEMO92-CONTI   < 'A'
             AND DEMO92-RETURNI < 'A'
             AND DEMO92-ABORTI  < 'A'
               MOVE 'X'                TO DEMO92-CONTO.
           IF DEMO92-ABORTI > SPACE AND NOT = '?'
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-080-EXIT.
           MOVE ATTR-PSMN              TO DEMO92-DESCA
                                          DEMO92-ELE-KEY-CNTA
                                          DEMO92-ELE-CHRA
                                          DEMO92-TBL-PROTA
                                          DEMO92-ACT-DATEA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA.
           MOVE ATTR-PSMD              TO DEMO92-TBL-PSWA.

      *** ASCERTAIN CONTINUATION REQUEST
      *
           IF DEMO92-RETURNI > SPACE OR DEMO92-ABORTI > SPACE
               MOVE '1'                TO FIRST-TIME
               PERFORM A-020-FIRST-TIME THRU A-020-EXIT
               GO TO B-080-EXIT.

      *** CONTINUE WAS SELECTED - UPDATE DATA BASE POSITION REQUEST
      *
           IF DEMO92-CONTI > SPACE
               IF DEMO92-NEXT-KEYI > SPACES
                   MOVE DEMO92-NEXT-KEYI TO DEMO92-LAST-KEYO.

      *** CONTINUE WAS SELECTED - RETURN MORE DEMOELES SEGMENTS
      *
           IF DEMO92-CONTI > SPACE
               MOVE ATTR-PSMN          TO DEMO92-TABLE-IDA
                                          DEMO92-DESCA
                                          DEMO92-ELE-KEY-CNTA
                                          DEMO92-ELE-CHRA
                                          DEMO92-ACT-DATEA
                                          DEMO92-TBL-PROTA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA
               MOVE ATTR-PSMD          TO DEMO92-TBL-PSWA
               PERFORM D-002-CLEAR-MATRIX THRU D-002-EXIT
               PERFORM C-025-PROT-INQ THRU C-025-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               MOVE '1'                TO FIRST-TIME
               MOVE DEMO92-TABLE-IDI   TO HDRS-FLDVALUE1
               PERFORM A-045-GHU-HDRS THRU A-045-EXIT
               MOVE DEMO92-NEXT-KEYI   TO ELES-FLDVALUE1
               MOVE '=>'               TO ELES-RLO1
               MOVE '1'                TO FIRST-TIME
               MOVE '-'                TO ELES-COM1
               PERFORM A-075-GNP-ELES THRU A-075-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14 OR
               DEMO-STATUS NOT = BB
               PERFORM A-075-GNP-ELES THRU A-075-EXIT
               MOVE -1                 TO DEMO92-RETURNL
               IF DEMO-STATUS = GE OR GB
                   MOVE SPACES         TO DEMO92-NEXT-KEYO
                   PERFORM A-022-FIRST-TIME THRU A-022-EXIT
               ELSE
                   MOVE DEMOELES-KEY   TO DEMO92-NEXT-KEYO
                   PERFORM A-022-FIRST-TIME THRU A-022-EXIT
           ELSE
               PERFORM D-002-CLEAR-MATRIX THRU D-002-EXIT
               MOVE SPACES             TO DEMO92-LAST-KEYO
                                          DEMO92-NEXT-KEYO
               PERFORM C-023-PROT-ELES THRU C-023-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               PERFORM C-025-PROT-INQ THRU C-025-EXIT
                   VARYING ISUB FROM 1 BY 1
                       UNTIL ISUB > 14
               MOVE '1'                TO FIRST-TIME
               MOVE 0                  TO DEMO92-FUNCL (1)
               MOVE -1                 TO DEMO92-RETURNL
               PERFORM A-022-FIRST-TIME THRU A-022-EXIT.

       B-080-EXIT.
           EXIT.

       C-010-INITIALIZE.

      *** INITIALIZATION ROUTINE - INSURE RE-ENTRABILITY
      *
           CALL 'CBLTDLI'           USING SCHD
                                          DEMO001P-PSB
                                          DLIUIB-BLL.

           SERVICE RELOAD DLIUIB.

           IF UIBRCODE NOT EQUAL LOW-VALUES
               EXEC CICS SEND          TEXT
                                       FROM   (SCHEDULE-ERROR)
                                       LENGTH (35)
                                       ERASE
                   END-EXEC.

           MOVE UIBPCBAL               TO PCBLIST-BLL.
           SERVICE RELOAD PCB-LIST.

           MOVE PCB-LIST-BLL1          TO PCB1-BLL.
           SERVICE RELOAD DEMO-PCB.

           EXEC CICS ASKTIME           ABSTIME(WORK-ABST-DATE)
               END-EXEC.

           EXEC CICS FORMATTIME        ABSTIME(WORK-ABST-DATE)
                                       DATESEP('/')
                                       MMDDYY (SAVE-DATE)
               END-EXEC.

           MOVE '1'                    TO FIRST-TIME.
           MOVE '1'                    TO FIRST-INSERT.
           MOVE '1'                    TO DATA-PRESENT.
           MOVE '0'                    TO DATE-SW.
           MOVE LOW-VALUES             TO DEMO91O.
           MOVE LOW-VALUES             TO DEMO92O
                                          BUBBLE-UP-AREA.
           MOVE SPACES                 TO DEMO92-TRANSCODEO
                                          DEMO92-LAST-KEYO
                                          DEMO92-ACT-DATEO
                                          DEMO92-ELE-NUM-KEYO
                                          DEMO92-ELE-NUM-VALO.
           MOVE '0'                    TO EDIT-SWITCH
                                          DATE-SW
                                          REPL-SW
                                          CHANGE-ADD-SW
                                          EOP-SW
                                          LENGTH-ERROR
                                          SCREEN2-AGAIN
                                          EOP-SW.
           MOVE '1'                    TO SCREEN2-FULL.
           MOVE ' '                    TO DEMO92-STATUSO.
           MOVE SAVE-DATE              TO GREGORIAN-DATE-WORK.
           MOVE ZERO                   TO HSUB
                                          PSUB
                                          ISUB
                                          OSUB
                                          WSUB.

       C-010-EXIT.
           EXIT.

       C-020-GET-MESSAGE.
           MOVE LOW-VALUES             TO DEMO91O
                                          DEMO92O.
           PERFORM C-021-FORMAT-NULL-SCREEN THRU C-021-EXIT.
           PERFORM C-022-FORMAT-NULL-SCREEN THRU C-022-EXIT.

       C-020-EXIT.
           EXIT.

       C-021-FORMAT-NULL-SCREEN.

      *** SCREEN HANDLING FOR DYNAMIC ATTRIBUTE MODIFICATION
      *
           MOVE 0                      TO DEMO91-FUNCTIONL
                                          DEMO91-PASSWORDL
                                          DEMO91-TABLE-IDL
                                          DEMO91-ELESL.
           MOVE ATTR-UXMN              TO DEMO91-FUNCTIONA
                                          DEMO91-TABLE-IDA
                                          DEMO91-ELESA.
           MOVE ATTR-UXMD              TO DEMO91-PASSWORDA.

       C-021-EXIT.
           EXIT.

       C-022-FORMAT-NULL-SCREEN.

      *** SCREEN HANDLING FOR DYNAMIC ATTRIBUTE MODIFICATION
      *
           MOVE ATTR-PSMD              TO DEMO92-LAST-KEY-GRPA.
           MOVE ATTR-UXMN              TO DEMO92-NEXT-KEYA.
           MOVE 0                      TO DEMO92-TYPEL
                                          DEMO92-TABLE-IDL
                                          DEMO92-DESCL
                                          DEMO92-LAST-KEY-GRPL
                                          DEMO92-ELE-KEY-CNTL
                                          DEMO92-ELE-CHRL
                                          DEMO92-ACT-DATEL
                                          DEMO92-TBL-PROTL
                                          DEMO92-TBL-PSWL
                                          DEMO92-ELE-NUM-KEYL
                                          DEMO92-ELE-NUM-VALL
                                          DEMO92-RETURNL
                                          DEMO92-CONTL
                                          DEMO92-NEXT-KEYL
                                          DEMO92-ABORTL.
           MOVE ATTR-UXMN              TO DEMO92-DESCA
                                          DEMO92-ELE-KEY-CNTA
                                          DEMO92-ELE-CHRA
                                          DEMO92-ACT-DATEA
                                          DEMO92-TBL-PROTA
                                          DEMO92-TBL-PSWA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA
                                          DEMO92-RETURNA
                                          DEMO92-CONTA
                                          DEMO92-ABORTA.
           MOVE ATTR-PSMN              TO DEMO92-TYPEA
                                          DEMO92-ACT-DATEA
                                          DEMO92-TABLE-IDA
                                          DEMO92-ELE-NUM-KEYA
                                          DEMO92-ELE-NUM-VALA.
           MOVE ATTR-PSMD              TO DEMO92-LAST-KEY-GRPA.
           MOVE ATTR-UXMD              TO DEMO92-TBL-PSWA.
           PERFORM C-023-PROT-ELES THRU C-023-EXIT
               VARYING ISUB FROM 1 BY 1
                   UNTIL ISUB > 14.

       C-022-EXIT.
           EXIT.

       C-023-PROT-ELES.

      *** SCREEN HANDLING FOR DYNAMIC ATTRIBUTE MODIFICATION - ARRAY
      *
           MOVE 0                      TO DEMO92-FUNCL     (ISUB)
                                          DEMO92-ELE-KEYL  (ISUB)
                                          DEMO92-ELE-DATAL (ISUB)
                                          S-M2-FUNCL       (ISUB)
                                          S-M2-ELE-KEYL    (ISUB)
                                          S-M2-ELE-DATAL   (ISUB).
           MOVE ATTR-PSMN              TO DEMO92-ELE-KEYA  (ISUB)
                                          S-M2-ELE-KEYA    (ISUB).
           MOVE ATTR-UXMN              TO DEMO92-ELE-DATAA (ISUB)
                                          S-M2-ELE-DATAA   (ISUB)
                                          DEMO92-FUNCA     (ISUB)
                                          S-M2-FUNCA       (ISUB).
       C-023-EXIT.
           EXIT.

       C-024-UNPROT-ELES.

      *** SCREEN HANDLING FOR DYNAMIC ATTRIBUTE MODIFICATION - ARRAY
      *
           MOVE ATTR-UXMN              TO DEMO92-FUNCA     (OSUB)
                                          DEMO92-ELE-KEYA  (OSUB)
                                          DEMO92-ELE-DATAA (OSUB)
                                          S-M2-FUNCA       (OSUB)
                                          S-M2-ELE-KEYA    (OSUB)
                                          S-M2-ELE-DATAA   (OSUB).
           MOVE '-'                    TO DEMO92-FUNCO     (OSUB)
                                          S-M2-FUNC        (OSUB).

       C-024-EXIT.
           EXIT.

       C-025-PROT-INQ.
           MOVE ATTR-PSMN              TO DEMO92-FUNCA     (ISUB)
                                          DEMO92-ELE-KEYA  (ISUB)
                                          DEMO92-ELE-DATAA (ISUB)
                                          S-M2-FUNCA       (ISUB)
                                          S-M2-ELE-KEYA    (ISUB)
                                          S-M2-ELE-DATAA   (ISUB).
           MOVE SPACES                 TO DEMO92-FUNCO     (ISUB).

       C-025-EXIT.
           EXIT.

       C-026-PROT-ISRT.
           MOVE ATTR-PSMN              TO DEMO92-FUNCA (ISUB)
                                          S-M2-FUNCA (ISUB).

       C-026-EXIT.
           EXIT.

       C-027-UNPROT-ELES.

      *** SCREEN HANDLING FOR DYNAMIC ATTRIBUTE MODIFICATION - ARRAY
      *
           MOVE ATTR-UXMN               TO DEMO92-ELE-KEYA  (OSUB)
                                           DEMO92-ELE-DATAA (OSUB)
                                           S-M2-ELE-KEYA    (OSUB)
                                           S-M2-ELE-DATAA   (OSUB).
           MOVE 'A'                     TO DEMO92-FUNCO     (OSUB)
                                           S-M2-FUNC        (OSUB).
           MOVE ATTR-PSMN               TO S-M2-FUNCA       (OSUB)
                                           DEMO92-FUNCA     (OSUB).

       C-027-EXIT.
           EXIT.

       C-099-ABEND.

      *** TERMINATE THE PROGRAM WITH ABNORMAL DLI/DC STATUS
      *
           EXEC CICS ABEND             ABCODE (9000-ABEND-CODE)
               END-EXEC.

           EXEC CICS RETURN
               END-EXEC.

           GOBACK.

       C-099-EXIT.
           EXIT.

       C-100-RETURN.

           MOVE '         * * * MICRO FOCUS SUPPORT SYSTEMS * * *     '
                                       TO END-LINE1O.
           MOVE '                   TRANSID "CDLI" ENDED              '
                                       TO END-LINE3O.

           EXEC CICS SEND              MAP    ('DEMO90')
                                       MAPSET ('DLIDEMO')
                                       FROM   (DEMO90O)
                                       FREEKB
                                       ERASE
               END-EXEC.

           EXEC CICS RETURN
               END-EXEC.

           GOBACK.

       C-100-EXIT.
           EXIT.

       D-001-BUBBLE-TO-MATRIX.
           PERFORM VARYING J FROM 1 BY 1 UNTIL J > 14
               MOVE S-CRT-LINE(J)          TO CRT-LINEO(J)
           END-PERFORM.
       D-001-EXIT.
           EXIT.

       D-002-CLEAR-MATRIX.
           PERFORM VARYING J FROM 1 BY 1 UNTIL J > 14
               MOVE LOW-VALUES             TO CRT-LINEO(J)
           END-PERFORM.
       D-002-EXIT.
           EXIT.
