       IDENTIFICATION DIVISION.
       PROGRAM-ID. TEST002T.
      *REMARKS.
      *
      *    Copyright (C) 1991-2007 Micro Focus International Ltd.
      *    All rights reserved.
      *
      *    INVOKED BY TRANCODE TESTMAIN.
      *    THIS IS THE PROCESSING MODULE FOR TESTING SERVICES REQUEST.
      *
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77  CURR-DATE        PIC X(08) VALUE SPACES.
       77  HOLD-DATE        PIC 9(06) COMP-3.
       77  HOLD-TIME        PIC 9(06) COMP-3.
       77  MFS-PRINTER      PIC X(08) VALUE 'MFS3270P'.
       77  TEST-DEPT        PIC X(08) VALUE 'MFS3270P'.
       77  PRINTERS         PIC X(20) VALUE 'PRINTER LOCATIONS'.
       77  ABEND            PIC X(08) VALUE 'ABEND'.
       77  OTTEST01         PIC X(08) VALUE 'OTTEST01'.
       77  OTDEMO90         PIC X(08) VALUE 'OTDEMO90'.
       77  OTMFSPRT         PIC X(08) VALUE 'OTMFSPRT'.
       77  DEBUGIMS         PIC X(08) VALUE 'XXXXXXXX'.
       77  ANCHOR-OK        PIC X VALUE '0'.
       77  RETURN-SWITCH    PIC X VALUE '0'.
       77  DEMO-ERROR       PIC X VALUE '0'.
       77  DETS-UPDATE      PIC X VALUE '0'.
       77  PROCESS-MSG      PIC X VALUE '0'.
       77  EDIT-SWITCH      PIC X VALUE '0'.
       77  EDIT-AGAIN       PIC X VALUE '0'.
       77  CRT-EOD          PIC X VALUE '0'.
       77  FIRST-TIME       PIC X VALUE '1'.
       77  CRT-LENGTH       PIC 9(4) COMP VALUE 1800.
       77  DEMO-LTERM-TABLE PIC X(32) VALUE 'TESTDEPT'.
       77  DEMO-TEST-TABLE  PIC X(32) VALUE 'TESTERS '.
       77  DETS-PTR         PIC 9(4) COMP VALUE ZERO.
       77  CRTD-PTR         PIC 9(4) COMP VALUE ZERO.
       77  I                PIC 9(4) COMP VALUE ZERO.
       77  J                PIC 9(4) COMP VALUE ZERO.
       77  K                PIC 9(4) COMP VALUE ZERO.
       77  L                PIC 9(4) COMP VALUE ZERO.
       77  SAVE-HDRS        PIC X(120).
       01  ACCEPTED-TIME.
           05  ACCEPTED-HMS PIC 9(06).
           05  ACCEPTED-HUN PIC 9(02).
       01  ACCEPTED-DATE.
           05  ACCEPTED-YY  PIC X(02).
           05  ACCEPTED-MM  PIC X(02).
           05  ACCEPTED-DD  PIC X(02).
      ******************************************************************
      * MFS BUFFER TERMINAL AREA DEFINITION - PROGRAM TEST002T.
      ******************************************************************
       01  MESSAGE-I-O-AREA.
           04  LL01-IN   PIC S9(4) COMP.
           04  Z001      PIC X(01) VALUE LOW-VALUES.
           04  Z0012     PIC X(01) VALUE LOW-VALUES.
           04  BUFFER-CONTENT PIC X(3000).
      ******************************************************************
      * MFS INTERFACE AREA FOR MOD DEFINITION(S) - PROGRAM TEST002T.
      ******************************************************************
       01  COMMON-END-SCREEN.
           03  ENDING-TRANCODEC    PIC X(01) VALUE SPACES.
           03  ENDING-TRANCODEA    PIC X(01) VALUE SPACES.
           03  ENDING-TRANCODE     PIC X(79) VALUE SPACES.
           03  END-LINE1           PIC X(60) VALUE
           '      * * * * MICRO FOCUS SUPPORT SYSTEMS * * * *'.
           03  END-LINE2           PIC X(60) VALUE ' '.
           03  END-LINE3           PIC X(60) VALUE
           '            TRANCODE - TESTMENU - ENDED   '.
           03  END-LINE4           PIC X(60) VALUE ' '.
           03  END-LINE5           PIC X(60) VALUE ' '.
           03  END-LINE6           PIC X(60) VALUE ' '.
      ******************************************************************
      ****** IMS MFS FORMAT DEMO01 - DATA ENTRY SCREEN DEMO SYSTEM   ***
      ******************************************************************
           COPY TEST01M.
      ******************************************************************
      ****** IMS DATABASE SEGMENT DEFINITION AREA - PROGRAM TEST002T ***
      ******************************************************************
      ****** INCLUDE FOR SEGMENT TESTHDRS - DEMO HEADER SEGMENT
           COPY TESTHDRS.
      ****** INCLUDE FOR SEGMENT TESTDETS - DEMO PROBLEM SEGMENT(S)
           COPY TESTDETS.
      ******************************************************************
      ** IMS DATABASE DEFINITION FOR TABLES DATA BASE PROGRAM TEST002T
      ******************************************************************
      ****** INCLUDE FOR SEGMENT DEMOHDRS - TABLE HEADER SEGMENT
           COPY DEMOHDRS.
      ****** INCLUDE FOR SEGMENT DEMOELES - ELEMENTARY TABLE SEGMENT
           COPY DEMOELES.
      ******************************************************************
      ****** IMS DATABASE SEGMENT SEARCH ARGUMENTS - PROGRAM TEST002T **
      ******************************************************************
      ****** SSA FOR SEGMENT TESTHDRS - TESTMAIN TESTMAIN SEGMENT ******
       01  SSA-HDRS.
           03  HDRS-SEGNAME        PIC X(08) VALUE 'TESTHDRS'.
           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-FLDVALUE1      PIC 9(08) COMP VALUE ZERO.
           03  HDRS-ENDQUALIFY PIC X     VALUE ')'.
      ****** SSA FOR SEGMENT TESTDETS - TESTMAIN REFERENCE SEGMENT *****
       01  SSA-DETS.
           03  DETS-SEGNAME        PIC X(08) VALUE 'TESTDETS'.
           03  DETS-COM            PIC X     VALUE '*'.
           03  DETS-COM1           PIC X     VALUE '-'.
           03  DETS-COM2           PIC X     VALUE '-'.
           03  DETS-QUALIFY        PIC X     VALUE '('.
           03  DETS-KEYFLD         PIC X(8)  VALUE 'SEQFIELD'.
           03  DETS-RLO1           PIC XX    VALUE ' ='.
           03  DETS-FLDVALUE1      PIC 9(04) COMP VALUE ZERO.
           03  DETS-ENDQUALIFY PIC X     VALUE ')'.
      ****** SSA FOR SEGMENT DEMOHDRS - TABLE HEADER SEGMENT ***********
       01  SSA-TBLS.
           03  TBLS-SEGNAME        PIC X(08) VALUE 'DEMOHDRS'.
           03  TBLS-COM            PIC X     VALUE '*'.
           03  TBLS-COM1           PIC X     VALUE '-'.
           03  TBLS-COM2           PIC X     VALUE '-'.
           03  TBLS-QUALIFY        PIC X     VALUE '('.
           03  TBLS-KEYFLD         PIC X(8)  VALUE 'SEQFIELD'.
           03  TBLS-RLO1           PIC XX    VALUE ' ='.
           03  TBLS-FLDVALUE0.
               05  TBLS-FLDVALUE2  PIC X(08) VALUE LOW-VALUES.
               05  TBLS-FLDVALUE1  PIC X(32).
           03  TBLS-ENDQUALIFY PIC X     VALUE ')'.
      ****** SSA FOR SEGMENT DEMOELES - TABLES 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 '.
           03  ROLB                    PIC X(4)      VALUE 'ROLB'.
       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'.
           03  QE                      PIC XX        VALUE 'QE'.
       01  IMS-ATTRIBUTES-PRINT.
           03  UMDAN                   PIC X VALUE 'A'.
           03  UMDAD                   PIC X VALUE 'E'.
           03  UMDNN                   PIC X VALUE 'J'.
           03  UMDAH                   PIC X VALUE 'I'.
           03  UMDNH                   PIC X VALUE 'R'.
           03  PNMDD                   PIC X VALUE 'U'.
           03  PMDDD                   PIC X VALUE 'V'.
           03  PMDAN                   PIC X VALUE '3'.
           03  PNMDH                   PIC X VALUE 'Y'.
           03  CURSORPOS               PIC X VALUE '{'.
       01  PROGRAM-FIELDS.
           03  HOLD-REF                PIC X(07).
           03  NUM-REF REDEFINES HOLD-REF PIC 9(07).
           03  DATE-WRK.
               05  DATE-YY         PIC XX.
               05  DATE-MM         PIC XX.
               05  DATE-DD         PIC XX.
           03  DATE-WORK  REDEFINES DATE-WRK PIC 9(6).
           03  GREGORIAN-DATE-WORK.
               05  GREG-MM         PIC XX.
               05  FILLER          PIC X VALUE '/'.
               05  GREG-DD         PIC XX.
               05  FILLER          PIC X VALUE '/'.
               05  GREG-YY         PIC XX.
           03  ABEND-CODE          PIC 9(6).
           03  ERROR-STATUS        PIC X(02).
           03  RGHT-WORK-AREA.
               05  RGHT-IN-LENGTH PIC S9(8) VALUE ZERO COMP.
               05  RGHT-RETURN        PIC X VALUE 'X'.
      ******************************************************************
      * DEMO006L *******************************************************
      ******************************************************************
       01  DEMO006L-PARMS.
           02  DEMO006L-INPUT-PARMS.
               03  DEMO006L-TBL-KEY          PIC X(32).
               03  DEMO006L-ELEM-KEY         PIC X(20).
               03  FILLER                    PIC X(20) VALUE SPACES.
           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 REDEFINES DEMO006L-ELEM-DSC.
                   05  DEMO006L-3286-LTERM   PIC X(08).
                   05  FILLER                PIC X(125).
               03  FILLER REDEFINES DEMO006L-ELEM-DSC.
                   05  DEMO006L-TEST-NAME    PIC X(20).
                   05  FILLER                PIC X(113).
               03  FILLER                    PIC X(256).
      ***************  DEMO TESTECTION SERVICES TICKET FORMAT ********
       01  DEMO-TICKET.
           03  TKT-MATRIX.
             05  TKT-LINE-DATA OCCURS 20 TIMES.
                 07  TKT-LINE                       PIC X(73).
       01  DEMO01-TICKET-PROBLEMS REDEFINES DEMO-TICKET.
           03  FILLER                              PIC X(365).
           03  PROBLEM-MATRIX.
             05  FILLER OCCURS 12 TIMES.
                 07  FILLER                         PIC X(03).
                 07  TKT-PROBLEM                    PIC X(70).
           03  FILLER                              PIC X(219).
       01  TICKET-FORMAT-LINES.
           03  TKT-FORMAT-LINE1.
               05  TKT-ERRORMSG                       PIC X(73) VALUE
               '              * * * *  TESTING SERVICES REQUEST * * *'.
           03  TKT-FORMAT-LINE2.
               05  TKT-REQUESTOR-TITLE                PIC X(08) VALUE
               '  NAME: '.
               05  TKT-REQUESTOR                      PIC X(20).
               05  TKT-PHONE-TITLE                    PIC X(09) VALUE
               '  PHONE: '.
               05  TKT-PHONE                          PIC X(04).
               05  TKT-ENTRY-DATE-TITLE               PIC X(08) VALUE
               '  DATE: '.
               05  TKT-ENTRY-DATE                     PIC X(09).
               05  TKT-KEY-TITLE                      PIC X(07) VALUE
               '  TEST#'.
               05  TKT-KEY                            PIC Z(06).
           03  TKT-FORMAT-LINE3.
               05  TKT-REQUEST-DEPT-TITLE             PIC X(14) VALUE
               '  DEPARTMENT: '.
               05  TKT-REQUEST-DEPT                   PIC X(05).
               05  TKT-LOCATION-TITLE                 PIC X(12) VALUE
               '  LOCATION: '.
               05  TKT-LOCATION                       PIC X(05).
               05  TKT-PRODUCT-TITLE                 PIC X(16) VALUE
               '  PRODUCT-LINE: '.
               05  TKT-PRODUCT                       PIC X(07).
           03  TKT-FORMAT-LINE4.
               05  TKT-PROBLEM-TITLE                  PIC X(11) VALUE
               '  PROBLEM:'.
           03  TKT-FORMAT-LINE5.
               05  TKT-APPROVED-MSG                   PIC X(73) VALUE
               '  ACTION APPROVED:____________________________________'.
           03  TKT-FORMAT-LINE6.
               05  TKT-PRIORITY-TITLE                 PIC X(12) VALUE
               '  PRIORITY: '.
               05  TKT-PRIORITY                       PIC X(01).
               05  TKT-TESTER-TITLE                   PIC X(15) VALUE
               '  ASSIGNED-TO: '.
               05  TKT-TESTER                         PIC X(20).
               05  TKT-STATUS-TITLE                   PIC X(10) VALUE
               '  STATUS: '.
               05  TKT-STATUS                         PIC X(15).
       COPY TESTSPA.
       LINKAGE SECTION.
       01  CRT-PCB.
           03  CRT-PCBNAME              PIC X(8).
           03  FILLER                   PIC XX.
           03  CRT-STATUS               PIC XX.
           03  CRT-DATE                 PIC S9(7) COMP-3.
           03  CRT-TIME                 PIC S9(7) COMP-3.
           03  CRT-SEQNO                PIC S9(3) COMP.
           03  FILLER                   PIC XX.
           03  CRT-MODNAME              PIC X(8).
           03  FILLER                   PIC X(224).
       01  ALT-PCB.
           03  ALT-PCBNAME              PIC X(8).
           03  FILLER                   PIC XX.
           03  ALT-STATUS               PIC XX.
           03  ALT-DATE                 PIC S9(7) COMP-3.
           03  ALT-TIME                 PIC S9(7) COMP-3.
           03  ALT-SEQNO                PIC S9(3) COMP.
           03  FILLER                   PIC XX.
           03  ALT-MODNAME              PIC X(8).
           03  FILLER                   PIC X(224).
       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(220).
       01  TEST-PCB.
           03  TEST-DBD-NAME PIC X(08).
           03  TEST-LEVEL-NO PIC XX.
           03  TEST-STATUS PIC XX.
           03  TEST-PROCOPTS PIC XXXX.
           03  TEST-RESVD-DLI PIC XXXX.
           03  TEST-SEGMENT PIC X(08).
           03  TEST-FILLER PIC X(8).
           03  TEST-KEYFEEDBCK PIC X(220).
       01  DEPT-PCB.
           03  DEPT-DBD-NAME PIC X(08).
           03  DEPT-LEVEL-NO PIC XX.
           03  DEPT-STATUS PIC XX.
           03  DEPT-PROCOPTS PIC XXXX.
           03  DEPT-RESVD-DLI PIC XXXX.
           03  DEPT-SEGMENT PIC X(08).
           03  DEPT-FILLER PIC X(8).
           03  DEPT-KEYFEEDBCK PIC X(220).
       01  TBLS-PCB.
           03  TBLS-DBD-NAME   PIC X(08).
           03  TBLS-LEVEL-NO   PIC XX.
           03  TBLS-STATUS     PIC XX.
           03  TBLS-PROCOPTS   PIC XXXX.
           03  TBLS-RESVD-DLI  PIC XXXX.
           03  TBLS-SEGMENT    PIC X(08).
           03  TBLS-FILLER     PIC X(8).
           03  TBLS-KEYFEEDBCK PIC X(220).
       PROCEDURE DIVISION.
           ENTRY 'DLITCBL' USING  CRT-PCB
                                  ALT-PCB
                                  DEMO-PCB
                                  TEST-PCB
                                  DEPT-PCB
                                  TBLS-PCB.
           PERFORM C-010-INITIALIZE THRU C-010-EXIT.
           PERFORM C-020-GET-MESSAGE THRU C-020-EXIT.
           PERFORM A-010-PROCESS-TRAN THRU A-010-EXIT.
           GOBACK.
       A-010-PROCESS-TRAN.
      *** CHECK TO SEE IF ADD
           IF SPA-ORIG-TRANCODE = 'TESTMENU'
               IF SPA-FUNCTION = '1'
                   MOVE '2' TO SPA-FUNCTION
                   MOVE '9' TO SPA-PHASE
                   PERFORM D-010-ADD-INITIAL THRU D-010-EXIT
                   MOVE SPA-TEST-NO TO S01-KEYZ
                   MOVE '1' TO FIRST-TIME
                   PERFORM A-020-ISRT-DEMO01 THRU A-020-EXIT
                   GO TO A-010-EXIT.
      *** CHECK TO SEE IF CHANGE
           IF SPA-FUNCTION = '2'
               PERFORM E-010-UPDATE-TRANS THRU E-010-EXIT
               PERFORM A-020-ISRT-DEMO01 THRU A-020-EXIT.
      *** CHECK TO SEE IF INQUIRY
           IF SPA-FUNCTION = '3'
               PERFORM F-010-INQUIRY-TRANS THRU F-010-EXIT
               PERFORM A-020-ISRT-DEMO01 THRU A-020-EXIT.
       A-010-EXIT.
           EXIT.
       A-020-ISRT-DEMO01.
      *** SEND BACK DEMO01 SCREEN
           MOVE 'TESTMAIN' TO SPA-DEST-TRANCODE.
           IF EDIT-SWITCH = '0'
               MOVE CURSORPOS TO S01-REQUESTORC
               MOVE SPACES TO S01-ERRORMSG.
           PERFORM C-030-ISRT-SPA THRU C-030-EXIT.
           MOVE DEMO01-SCREEN TO BUFFER-CONTENT.
           CALL 'CBLTDLI' USING
            ISRT
            CRT-PCB
            MESSAGE-I-O-AREA
            OTTEST01
            IF CRT-STATUS = BB
                 NEXT SENTENCE
            ELSE
                 MOVE 3505             TO ABEND-CODE
                 MOVE CRT-STATUS       TO ERROR-STATUS
                 PERFORM C-099-ABEND.
       A-020-EXIT.
           EXIT.
       A-040-EDIT.

      *** EDIT NAME FOR PRESENCE

           IF S01-REQUESTOR = SPACES
               MOVE ALL '~' TO S01-REQUESTOR
               MOVE UMDAH TO S01-REQUESTORA
               MOVE CURSORPOS TO S01-REQUESTORC
               IF EDIT-SWITCH = '0'
                   MOVE '1' TO EDIT-SWITCH
                   MOVE 'YOUR NAME IS REQUIRED'  TO S01-ERRORMSG.

      *** EDIT PHONE FOR PRESENCE

           IF S01-PHONE = SPACES
               MOVE ALL '~' TO S01-PHONE
               MOVE UMDAH TO S01-PHONEA
               MOVE CURSORPOS TO S01-PHONEC
               IF EDIT-SWITCH = '0'
                   MOVE '1' TO EDIT-SWITCH
                   MOVE 'YOUR PHONE# IS REQUIRED'  TO S01-ERRORMSG.

      *** EDIT REQUEST DEPARTMENT FOR VALIDITY

           IF S01-REQUEST-DEPT = SPACES
               MOVE ALL '~' TO S01-REQUEST-DEPT
               MOVE UMDAH TO S01-REQUEST-DEPTA
               MOVE CURSORPOS TO S01-REQUEST-DEPTC
               IF EDIT-SWITCH = '0'
                   MOVE '1' TO EDIT-SWITCH
                   MOVE 'YOUR DEPT# IS REQUIRED' TO S01-ERRORMSG
               ELSE
                   NEXT SENTENCE
           ELSE IF SPA-REQUEST-DEPT NOT = S01-REQUEST-DEPT
               MOVE DEMO-LTERM-TABLE TO DEMO006L-TBL-KEY
               MOVE S01-REQUEST-DEPT TO DEMO006L-ELEM-KEY
               CALL 'DEMO006L' USING TBLS-PCB
                                     DEMO006L-PARMS
               IF DEMO006L-RETURN-CD NOT = '00'
                  MOVE CURSORPOS TO S01-REQUEST-DEPTC
                  MOVE UMDAH TO S01-REQUEST-DEPTA
                  IF EDIT-SWITCH = '0'
                      MOVE '1' TO EDIT-SWITCH
                      MOVE 'REQUEST DEPARTMENT INVALID'
                      TO S01-ERRORMSG
                  ELSE
                      NEXT SENTENCE
               ELSE
                   MOVE S01-REQUEST-DEPT TO SPA-REQUEST-DEPT
                   MOVE DEMO006L-3286-LTERM TO SPA-PLTERM.

      *** EDIT LOCATION FOR PRESENCE

           IF S01-LOCATION = SPACES
               MOVE ALL '~' TO S01-LOCATION
               MOVE UMDAH TO S01-LOCATIONA
               MOVE CURSORPOS TO S01-LOCATIONC
               IF EDIT-SWITCH = '0'
                   MOVE '1' TO EDIT-SWITCH
                   MOVE 'A LOCATION IS REQUIRED' TO S01-ERRORMSG.

      *** EDIT PRODUCT FOR PRESENCE

           IF S01-PRODUCT = SPACES
               MOVE ALL '~' TO S01-PRODUCT
               MOVE UMDAH TO S01-PRODUCTA
               MOVE CURSORPOS TO S01-PRODUCTC
               IF EDIT-SWITCH = '0'
                   MOVE '1' TO EDIT-SWITCH
                   MOVE 'A PRODUCT# IS REQUIRED' TO S01-ERRORMSG.


      *** EDIT TESTER FOR VALIDITY

           IF S01-TESTER5 NUMERIC AND SPA-FUNCTION = '2'
               MOVE DEMO-TEST-TABLE TO DEMO006L-TBL-KEY
               MOVE S01-TESTER TO DEMO006L-ELEM-KEY
               CALL 'DEMO006L' USING TBLS-PCB
                                     DEMO006L-PARMS
               IF DEMO006L-RETURN-CD NOT = '00'
                  MOVE CURSORPOS TO S01-TESTERC
                  MOVE UMDAH TO S01-TESTERA
                  IF EDIT-SWITCH = '0'
                      MOVE '1' TO EDIT-SWITCH
                      MOVE 'TESTER AUTHORIZATION INVALID'
                      TO S01-ERRORMSG
                  ELSE
                      NEXT SENTENCE
               ELSE
                   MOVE DEMO006L-TEST-NAME TO S01-TESTER.

      *** EDIT PROBLEM FOR PRESENCE

           IF S01-PROBLEM (1) = SPACES
               MOVE ALL '~' TO S01-PROBLEM (1)
               MOVE UMDAH TO S01-PROBLEMA (1)
               MOVE CURSORPOS TO S01-PROBLEMC (1)
               IF EDIT-SWITCH = '0'
                   MOVE '1' TO EDIT-SWITCH
                   MOVE 'BUG DEFINITION REQUIRED' TO S01-ERRORMSG.

      *** EDIT STATUS FOR VALIDITY

           IF SPA-FUNCTION = '2' AND SPA-PRINT NOT = '1'
               IF S01-STATUS1 NOT = 'I' AND NOT = 'C' AND NOT = 'D'
                AND NOT = 'N'
                   MOVE UMDAH TO S01-STATUSA
                   MOVE CURSORPOS TO S01-STATUSC
                   IF EDIT-SWITCH = '0'
                       MOVE '1' TO EDIT-SWITCH
                       MOVE
                       'STATUS REQUIRED - <I>N-PROCESS <C>COMPLETE'
                       TO S01-ERRORMSG
                       IF S01-STATUS = SPACES
                           MOVE ALL '~' TO S01-STATUS.

       A-040-EXIT.
           EXIT.
       C-010-INITIALIZE.
      *** INITIALIZATION ROUTINE - INSURE RE-ENTRABILITY
           MOVE '0' TO RETURN-SWITCH.
           MOVE '0' TO FIRST-TIME.
           MOVE '0' TO EDIT-SWITCH.
           MOVE ZEROES TO I
                          J
                          K
                          L.
           ACCEPT ACCEPTED-DATE FROM DATE.
           MOVE ACCEPTED-YY TO GREG-YY.
           MOVE ACCEPTED-MM TO GREG-MM.
           MOVE ACCEPTED-DD TO GREG-DD.
           MOVE GREGORIAN-DATE-WORK TO CURR-DATE.
           MOVE GREG-MM TO DATE-MM.
           MOVE GREG-DD TO DATE-DD.
           MOVE GREG-YY TO DATE-YY.
           MOVE DATE-WORK           TO HOLD-DATE.
           ACCEPT ACCEPTED-TIME FROM TIME.
           MOVE ACCEPTED-HMS TO HOLD-TIME.
       C-010-EXIT.
           EXIT.
       C-020-GET-MESSAGE.
      *** GET SPA FOR CONVERSATION
           CALL 'CBLTDLI' USING GU
                                CRT-PCB
                                SPA-IO-AREA.
      *** IO-PCB MESSAGE PROCESSING - INPUT
           CALL 'CBLTDLI' USING
               GN
               CRT-PCB
               MESSAGE-I-O-AREA.
           IF CRT-STATUS = QC
               IF SPA-PHASE NOT = LOW-VALUES
                   MOVE '1' TO CRT-EOD
                   GO TO C-020-EXIT.
           IF CRT-STATUS NOT = BB AND NOT = QC AND NOT = QD
               MOVE 3514               TO ABEND-CODE
               MOVE CRT-STATUS         TO ERROR-STATUS
               PERFORM C-099-ABEND.
           MOVE '1' TO CRT-EOD.
           MOVE LOW-VALUES TO DEMO01-SCREEN.
           MOVE BUFFER-CONTENT TO DEMO01-SCREEN.
           IF SPA-PHASE NOT = LOW-VALUES
               INSPECT DEMO01-SCREEN REPLACING ALL '~' BY ' '.
      *** CHECK TO SEE IF EXIT HAS BEEN INPUT
           IF S01-STOP = 'STOP'
               PERFORM C-100-RETURN THRU C-100-EXIT
               GOBACK.
           PERFORM C-021-FORMAT-NULL-SCREEN THRU C-021-EXIT.
           MOVE CRT-LENGTH TO LL01-IN.
           PERFORM C-022-FORMAT-PROBLEM THRU C-022-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > 12.
       C-020-EXIT.
           EXIT.
       C-021-FORMAT-NULL-SCREEN.
      *** SCREEN HANDLING FOR DYNAMIC ATTRIBUTE MODIFICATION
           MOVE LOW-VALUES TO
                 S01-REQUESTORC
                 S01-PHONEC
                 S01-KEYC
                 S01-REQUEST-DEPTC
                 S01-LOCATIONC
                 S01-PRODUCTC
                 S01-PRIORITYC
                 S01-TESTERC
                 S01-STATUSC
                 S01-PRIMARYC
                 S01-REVIEWC
                 S01-EXITC.
           IF SPA-FUNCTION = '1' OR '2'
               MOVE UMDAN TO
                     S01-REQUESTORA
                     S01-PHONEA
                     S01-REQUEST-DEPTA
                     S01-LOCATIONA
                     S01-PRODUCTA
                     S01-PRIORITYA
                     S01-TESTERA
                     S01-PRIMARYA
                     S01-REVIEWA
                     S01-EXITA.
           MOVE UMDAN TO S01-STATUSA.
           IF SPA-FUNCTION NOT = '1' AND NOT = '2'
               MOVE PMDAN TO
                     S01-REQUESTORA
                     S01-PHONEA
                     S01-REQUEST-DEPTA
                     S01-LOCATIONA
                     S01-PRODUCTA
                     S01-PRIORITYA
                     S01-TESTERA
                     S01-STATUSA.
           MOVE PMDAN TO S01-KEYA.
           IF SPA-FUNCTION  = '1' OR SPA-PRINT = '1'
               MOVE PMDAN TO S01-PRIORITYA
                             S01-REVIEWA
                             S01-TESTERA
                             S01-STATUSA.

      *** INSERT ~ TO VALID INPUT FIELDS
           IF SPA-PHASE = LOW-VALUES AND SPA-FUNCTION = '1'
               MOVE ALL '~' TO
                 S01-REQUESTOR
                 S01-PHONE
                 S01-REQUEST-DEPT
                 S01-LOCATION
                 S01-PRODUCT
                 S01-PRIMARY
                 S01-REVIEW
                 S01-EXIT.
           IF SPA-FUNCTION  = '1' OR SPA-PRINT = '1'
               MOVE PMDAN TO S01-PRIORITYA
                             S01-TESTERA
                             S01-REVIEWA
                             S01-STATUSA.
       C-021-EXIT.
           EXIT.
       C-022-FORMAT-PROBLEM.
           IF SPA-FUNCTION = '1' OR '2'
               MOVE UMDAN TO S01-PROBLEMA (I)
               MOVE LOW-VALUES TO S01-PROBLEMC (I)
               IF SPA-PHASE = LOW-VALUES AND SPA-FUNCTION = '1'
                   MOVE ALL '~' TO S01-PROBLEM (I).
           IF SPA-FUNCTION NOT = '1' AND NOT = '2'
               MOVE PMDAN TO S01-PROBLEMA (I)
               MOVE LOW-VALUES TO S01-PROBLEMC (I).
       C-022-EXIT.
           EXIT.
       C-030-ISRT-SPA.
           CALL 'CBLTDLI' USING
                          ISRT
                          CRT-PCB
                          SPA-IO-AREA.
       C-030-EXIT.
           EXIT.
       C-090-MESSAGE-SWITCH.
      *** PROCESS MAIN MENU REQUESTS
      *** PRIME THE ALTERNATE PCB FOR MESSAGE SWITCH
           MOVE LOW-VALUES TO SPA-PHASE SPA-STATUS.
           MOVE SPACES TO SPA-MATRIX.
           MOVE 'TESTMENU' TO SPA-DEST-TRANCODE.
           CALL 'CBLTDLI' USING
            CHNG
            ALT-PCB
            SPA-DEST-TRANCODE
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
           IF ALT-STATUS = 'A4'
                MOVE 'TRANCODE SECURITY VIOLATION' TO END-LINE6
                PERFORM C-100-RETURN THRU C-100-EXIT
           ELSE
               MOVE 3936               TO ABEND-CODE
               MOVE ALT-STATUS         TO ERROR-STATUS
               PERFORM C-099-ABEND.
      *** ISSUE THE MESSAGE SWITCH
           CALL 'CBLTDLI' USING
                          ISRT
                          ALT-PCB
                          SPA-IO-AREA.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
           IF ALT-STATUS = 'A4'
                MOVE 'TRANCODE SECURITY VIOLATION' TO END-LINE6
                PERFORM C-100-RETURN THRU C-100-EXIT
           ELSE
               MOVE 3946               TO ABEND-CODE
               MOVE ALT-STATUS         TO ERROR-STATUS
               PERFORM C-099-ABEND.
           GOBACK.
       C-090-EXIT.
           EXIT.
       C-099-ABEND.
      * SETUP ENDING MESSAGES
           MOVE SPACES                 TO END-LINE3.
           STRING 'TRANCODE TESTMAIN ABENDED WITH USER CODE: '
                  ABEND-CODE
               DELIMITED BY SIZE     INTO END-LINE3.
           STRING 'PCB ERROR STATUS: '
                  ERROR-STATUS
               DELIMITED BY SIZE     INTO END-LINE4.
      * BACKOUT ANY PENDING UPDATES
           CALL 'CBLTDLI' USING ROLB
                                CRT-PCB.
      * ISRT THE NULL STATE SPA
           MOVE SPACES                 TO SPA-DEST-TRANCODE.
           CALL 'CBLTDLI' USING ISRT
                                CRT-PCB
                                SPA-IO-AREA.
      * SEND INFORMATIONAL ENDING SCREEN
           MOVE COMMON-END-SCREEN TO BUFFER-CONTENT.
           MOVE 1920              TO LL01-IN.
           CALL 'CBLTDLI' USING ISRT
                                CRT-PCB
                                MESSAGE-I-O-AREA
                                OTDEMO90.
      * IGNORE ANY FAILED STATUS CODE ON THESE INSERTS - JUST RETURN
           GOBACK.
       C-099-EXIT.
           EXIT.
       C-100-RETURN.
      *** PROCESS EXIT REQUEST
      *** ISRT THE NULL STATE SPA
           MOVE SPACES TO SPA-ORIG-TRANCODE.
           MOVE SPACES TO SPA-DEST-TRANCODE.
           CALL 'CBLTDLI' USING
                          ISRT
                          CRT-PCB
                          SPA-IO-AREA.
           IF CRT-STATUS = BB
               NEXT SENTENCE
           ELSE
               MOVE 3944               TO ABEND-CODE
               MOVE CRT-STATUS         TO ERROR-STATUS
               PERFORM C-099-ABEND.
      *** MAINLINE ROUTINE TO END PROCESSING
           MOVE COMMON-END-SCREEN TO BUFFER-CONTENT.
           CALL 'CBLTDLI' USING
            ISRT
            CRT-PCB
            MESSAGE-I-O-AREA
            OTDEMO90
            IF CRT-STATUS = BB
                NEXT SENTENCE
            ELSE
                MOVE 3505              TO ABEND-CODE
                MOVE CRT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
            GOBACK.
       C-100-EXIT.
           EXIT.
       C-200-ENQ-ANCHOR-RECORD.
      *** ADD NEW REQUEST TO FILE GET TEST# FROM RECORD 0 ISRT NEW HDRS
      *** SET SEARCH FIIELD TO KEY 0 (HOME ADDRESS OF ANCHOR RECORD)
           MOVE 0 TO HDRS-FLDVALUE1.
           MOVE '-' TO HDRS-COM1.
      *** ISSUE DL/I CALL TO RETRIEVE DEMO ANCHOR RECORD
           CALL 'CBLTDLI' USING
            GHU
            DEMO-PCB
            TESTHDRS
            SSA-HDRS.
      *** CREATE ANCHOR IF NEW DATABASE
           IF DEMO-STATUS = BB
               MOVE '1' TO ANCHOR-OK
           ELSE
                PERFORM C-205-MAKE-ANCHOR THRU C-205-EXIT
                GO TO C-200-EXIT.
      *** INCREMENT NEXT RECORD POINTER
           COMPUTE HDRS-LAST-TEST-KEY = HDRS-LAST-TEST-KEY + 1.
           MOVE HDRS-LAST-TEST-KEY TO SPA-TEST-NO.
           MOVE ' ' TO HDRS-COM1.
      *** ISSUE DL/I CALL TO REPLACE ANCHOR RECORD
           CALL 'CBLTDLI' USING
            REPL
            DEMO-PCB
            TESTHDRS.
      *** SET ERROR CODE IF BAD REPL
           IF DEMO-STATUS = BB
               NEXT SENTENCE
           ELSE
                MOVE 3901              TO ABEND-CODE
                MOVE DEMO-STATUS       TO ERROR-STATUS
                PERFORM C-099-ABEND.
      *** SET ERROR CODE IF NOT FOUND
           MOVE SPA-TEST-NO TO HDRS-FLDVALUE1.
       C-200-EXIT.
           EXIT.
       C-205-MAKE-ANCHOR.
           MOVE LOW-VALUES TO TESTHDRS.
           MOVE HOLD-DATE      TO  HDRS-ASSIGN-DATE.
           MOVE HOLD-TIME      TO  HDRS-ASSIGN-TIME.
           MOVE ZEROES         TO  HDRS-COMPLETE-DATE.
           MOVE ZEROES         TO  HDRS-COMPLETE-TIME.
           MOVE ZEROES         TO  HDRS-LAST-DETS.
           MOVE ' ' TO HDRS-COM1.
      *** ISSUE DL/I CALL TO INSERT TESTECTION RECORD
           CALL 'CBLTDLI' USING
            ISRT
            DEMO-PCB
            TESTHDRS
            SSA-HDRS.
      *** SET ERROR CODE IF NOT FOUND
           IF DEMO-STATUS = BB
               NEXT SENTENCE
           ELSE
                MOVE 3900              TO ABEND-CODE
                MOVE DEMO-STATUS       TO ERROR-STATUS
                PERFORM C-099-ABEND.
       C-205-EXIT.
           EXIT.
       C-210-ISRT-TESTHDRS.
           MOVE SPA-TEST-NO    TO  HDRS-KEY.
           MOVE SPACES         TO  HDRS-NAME.
           MOVE SPACES         TO  HDRS-PHONE.
           MOVE HOLD-DATE      TO  HDRS-ENTRY-DATE.
           MOVE HOLD-TIME      TO  HDRS-ENTRY-TIME.
           MOVE SPACES         TO  HDRS-REQUEST-DEPT.
           MOVE SPACES         TO  HDRS-LOCATION.
           MOVE SPACES         TO  HDRS-PRODUCT.
           MOVE SPACES         TO  HDRS-PRIORITY.
           MOVE 'UNASSIGNED'   TO  HDRS-TESTER.
           MOVE 'N'            TO  HDRS-STATUS.
           MOVE 'N'            TO  SPA-STATUS.
           MOVE HOLD-DATE      TO  HDRS-ASSIGN-DATE.
           MOVE HOLD-TIME      TO  HDRS-ASSIGN-TIME.
           MOVE ZEROES         TO  HDRS-COMPLETE-DATE.
           MOVE ZEROES         TO  HDRS-COMPLETE-TIME.
           COMPUTE HDRS-TWOS = 0 - HDRS-KEY.
           MOVE SPACES         TO  HDRS-FILLER
           MOVE ZEROES         TO  HDRS-LAST-DETS.
           MOVE ' ' TO HDRS-COM1.
           MOVE CURR-DATE TO S01-ENTRY-DATE.
      *** ISSUE DL/I CALL TO INSERT TESTECTION RECORD
           CALL 'CBLTDLI' USING
            ISRT
            DEMO-PCB
            TESTHDRS
            SSA-HDRS.
      *** SET ERROR CODE IF NOT FOUND
           IF DEMO-STATUS = BB
               NEXT SENTENCE
           ELSE
                MOVE 3903              TO ABEND-CODE
                MOVE DEMO-STATUS       TO ERROR-STATUS
                PERFORM C-099-ABEND.
           MOVE HDRS-FLDVALUE1 TO SPA-TEST-NO.
           MOVE '1' TO SPA-PRINT.
       C-210-EXIT.
           EXIT.
       C-220-GU-TESTHDRS.
      *** SET SEARCH FIELD TO INPUT TEST NO.
           MOVE SPA-TEST-NO TO HDRS-FLDVALUE1.
           MOVE '-' TO HDRS-COM1.
      *** ISSUE DL/I CALL TO RETRIEVE DEMO ANCHOR RECORD
           CALL 'CBLTDLI' USING
            GU
            DEMO-PCB
            TESTHDRS
            SSA-HDRS.
       C-220-EXIT.
           EXIT.
       C-230-GNP-TESTDETS.
      *** ISSUE DL/I CALL(S) TO RETRIEVE DEMO DETAIL PROBLEM SEGMENTS
           MOVE ' ' TO DETS-COM1.
           CALL 'CBLTDLI' USING
            GNP
            DEMO-PCB
            TESTDETS
            SSA-HDRS
            SSA-DETS
      *** SET ERROR CODE IF NOT FOUND
           IF DEMO-STATUS = BB
               MOVE DETS-PROBLEM TO S01-PROBLEM (I)
               MOVE DETS-PROBLEM TO SPA-PROBLEM (I)
               IF SPA-FUNCTION = '2'
                   MOVE UMDAN TO S01-PROBLEMA (I)
               ELSE
                   NEXT SENTENCE
           ELSE IF DEMO-STATUS = GE
                MOVE HDRS-LAST-DETS TO I
                GO TO C-230-EXIT
           ELSE
                MOVE 3905              TO ABEND-CODE
                MOVE DEMO-STATUS       TO ERROR-STATUS
                PERFORM C-099-ABEND.
       C-230-EXIT.
           EXIT.
       C-240-REPL-HDRS.
      *** PROCESS UPDATES TO DATA BASE
      *** SET SEARCH FIELD TO INPUT TEST NO.
           MOVE SPA-TEST-NO TO HDRS-FLDVALUE1.
           MOVE 0 TO CRTD-PTR.
           PERFORM C-255-COUNT-SCREEN-DETS THRU C-255-EXIT
            VARYING I FROM 12 BY -1 UNTIL I = 0 OR CRTD-PTR NOT = 0.
           MOVE '0' TO DETS-UPDATE.
           MOVE 0 TO DETS-PTR.
           PERFORM C-250-COMPARE-DETS THRU C-250-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > SPA-DETS-CNT.
           IF DETS-PTR NOT = CRTD-PTR
               MOVE '1' TO DETS-UPDATE.
           IF DETS-UPDATE = '1'
               PERFORM C-260-UPDATE-DETS THRU C-260-EXIT
                VARYING I FROM 1 BY 1 UNTIL I > 12.
           MOVE '-' TO HDRS-COM1.
      *** ISSUE HOLD DL/I CALL TO RETRIEVE DEMO ROOT RECORD
           CALL 'CBLTDLI' USING
            GHU
            DEMO-PCB
            TESTHDRS
            SSA-HDRS.
      *** SET ERROR CODE IF NOT FOUND
           IF DEMO-STATUS = BB
               NEXT SENTENCE
           ELSE
                MOVE 3906              TO ABEND-CODE
                MOVE DEMO-STATUS       TO ERROR-STATUS
                PERFORM C-099-ABEND.
           MOVE TESTHDRS TO SAVE-HDRS.
           MOVE CRTD-PTR TO HDRS-LAST-DETS.
           MOVE S01-REQUESTOR     TO HDRS-NAME.
           MOVE S01-PHONE         TO HDRS-PHONE.
           MOVE S01-REQUEST-DEPT TO HDRS-REQUEST-DEPT.
           MOVE S01-LOCATION      TO HDRS-LOCATION.
           MOVE S01-PRODUCT      TO HDRS-PRODUCT.
           MOVE S01-PRIORITY      TO HDRS-PRIORITY.
           IF HDRS-STATUS = 'N'
               IF S01-TESTER NOT = SPACES AND
                S01-TESTER NOT = 'UNASSIGNED          '
                    MOVE 'I' TO HDRS-STATUS
                    IF S01-STATUS1 = 'N'
                          MOVE 'IN PROCESS' TO S01-STATUS.
           IF SPA-STATUS NOT = 'C'
               IF S01-STATUS1 = 'C'
                   MOVE HOLD-DATE TO HDRS-COMPLETE-DATE
                   MOVE HOLD-TIME TO HDRS-COMPLETE-TIME.
           IF SPA-STATUS = 'N'
               IF S01-STATUS1 = 'I'
                   MOVE HOLD-DATE TO HDRS-ASSIGN-DATE
                   MOVE HOLD-TIME TO HDRS-ASSIGN-TIME.
           IF S01-STATUS NOT = 'N' AND NOT = SPACE
               MOVE S01-STATUS1 TO HDRS-STATUS SPA-STATUS
               IF S01-TESTER NOT = SPACES
                   MOVE S01-TESTER TO HDRS-TESTER.
           IF SAVE-HDRS NOT = TESTHDRS
               MOVE ' ' TO HDRS-COM1
      *** ISSUE DL/I CALL TO REPLACE ROOT RECORD
               CALL 'CBLTDLI' USING
                REPL
                DEMO-PCB
                TESTHDRS
      *** SET ERROR CODE IF NOT FOUND
               IF DEMO-STATUS = BB
                   NEXT SENTENCE
               ELSE
                    MOVE 3907              TO ABEND-CODE
                    MOVE DEMO-STATUS       TO ERROR-STATUS
                    PERFORM C-099-ABEND.
       C-240-EXIT.
           EXIT.
       C-250-COMPARE-DETS.
           IF SPA-PROBLEM (I) = S01-PROBLEM (I)
               GO TO C-250-EXIT.
           MOVE '1' TO DETS-UPDATE.
           MOVE I TO DETS-PTR.
       C-250-EXIT.
           EXIT.
       C-255-COUNT-SCREEN-DETS.
      *** COUNT FROM BOTTOM UP
           IF S01-PROBLEM (I) = SPACES
               GO TO C-255-EXIT.
           MOVE I TO CRTD-PTR.
       C-255-EXIT.
           EXIT.
       C-260-UPDATE-DETS.
      *** PROCESS UPDATES FOR SCREEN PROBLEM STORED IN TESTDETS SEGMENTS
           IF I > CRTD-PTR
               IF I > DETS-PTR
                   MOVE 13 TO I
                   GO TO C-260-EXIT.
           IF SPA-PROBLEM (I) = S01-PROBLEM (I)
               GO TO C-260-EXIT.
           MOVE '-' TO HDRS-COM1.
           MOVE '-' TO DETS-COM1.
           MOVE I TO DETS-FLDVALUE1.
           CALL 'CBLTDLI' USING
            GHU
            DEMO-PCB
            TESTDETS
            SSA-HDRS
            SSA-DETS
      *** REPL RECORD IF FOUND
           IF DEMO-STATUS = BB
               MOVE S01-PROBLEM (I) TO DETS-PROBLEM
               MOVE DETS-PROBLEM TO SPA-PROBLEM (I)
               CALL 'CBLTDLI' USING
                REPL
                DEMO-PCB
                TESTDETS
                IF DEMO-STATUS NOT = BB
                    MOVE 3908              TO ABEND-CODE
                    MOVE DEMO-STATUS       TO ERROR-STATUS
                    PERFORM C-099-ABEND
                ELSE
                    NEXT SENTENCE
            ELSE
      *** ISRT RECORD IF NOT FOUND
               MOVE LOW-VALUES TO TESTDETS
               MOVE I TO DETS-KEY
               MOVE '-' TO HDRS-COM1
               MOVE ' ' TO DETS-COM1
               MOVE S01-PROBLEM (I) TO DETS-PROBLEM
               MOVE DETS-PROBLEM TO SPA-PROBLEM (I)
               CALL 'CBLTDLI' USING
                ISRT
                DEMO-PCB
                TESTDETS
                SSA-HDRS
                SSA-DETS
                IF DEMO-STATUS NOT = BB
                    MOVE 3909              TO ABEND-CODE
                    MOVE DEMO-STATUS       TO ERROR-STATUS
                    PERFORM C-099-ABEND.
       C-260-EXIT.
           EXIT.
      *** FORMAT SCREEN I-O AREA FROM TESTHDRS SEGMENT
       C-300-BUILD-SCREEN.
           MOVE HDRS-KEY          TO S01-KEYZ.
           MOVE HDRS-NAME         TO S01-REQUESTOR.
           MOVE HDRS-PHONE        TO S01-PHONE
           MOVE HDRS-ENTRY-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 S01-ENTRY-DATE.
           MOVE HDRS-REQUEST-DEPT TO S01-REQUEST-DEPT.
           MOVE HDRS-LOCATION     TO S01-LOCATION.
           MOVE HDRS-PRODUCT     TO S01-PRODUCT.
           MOVE HDRS-PRIORITY     TO S01-PRIORITY.
           MOVE HDRS-TESTER    TO S01-TESTER.
           IF HDRS-STATUS  = 'N'
               MOVE 'NEW REQUEST' TO S01-STATUS.
           IF HDRS-STATUS  = 'I'
               MOVE 'IN PROCESS' TO S01-STATUS.
           IF HDRS-STATUS  = 'C'
               MOVE 'COMPLETED' TO S01-STATUS.
           IF HDRS-STATUS  = 'D'
               MOVE 'DELETED' TO S01-STATUS.
           IF HDRS-STATUS NOT = 'N' AND SPA-FUNCTION NOT = '3'
               MOVE CURSORPOS TO S01-STATUSC.
       C-300-EXIT.
           EXIT.
       D-010-ADD-INITIAL.
      *** PROCESS ADD REQUESTS FROM MANUFACTURING DEPARTMENTS
           MOVE '0' TO ANCHOR-OK.
           PERFORM C-200-ENQ-ANCHOR-RECORD THRU C-200-EXIT
            UNTIL ANCHOR-OK = '1'.
           PERFORM C-210-ISRT-TESTHDRS THRU C-210-EXIT.
           MOVE 'NEW REQUEST' TO S01-STATUS.
       D-010-EXIT.
           EXIT.
       E-010-UPDATE-TRANS.
      *** PROCESS UPDATE REQUESTS FROM DEPARTMENT BUG ONLY
      *** CHECK IF THIS IS FIRST TIME - IF SO GET DATA BASE BUILD SCREEN
           IF S01-EXIT > SPACE
               PERFORM C-100-RETURN THRU C-100-EXIT
               GOBACK.
           IF SPA-PHASE = LOW-VALUES
               PERFORM C-220-GU-TESTHDRS THRU C-220-EXIT
               MOVE HDRS-LAST-DETS TO SPA-DETS-CNT
               PERFORM C-230-GNP-TESTDETS THRU C-230-EXIT
                VARYING I FROM 1 BY 1 UNTIL I > HDRS-LAST-DETS
               MOVE HDRS-STATUS TO SPA-STATUS
               PERFORM C-300-BUILD-SCREEN THRU C-300-EXIT
               MOVE '8' TO SPA-PHASE
               GO TO E-010-EXIT.
      *** EDIT INPUT FOR ERRORS
           MOVE '0' TO EDIT-SWITCH.
           PERFORM A-040-EDIT THRU A-040-EXIT.
           IF EDIT-SWITCH = '1'
               GO TO E-010-EXIT.
           PERFORM C-240-REPL-HDRS THRU C-240-EXIT.
      *** CHECK IF SPA-SWITCH SET FROM ADD TO PRINT TICKETS
           IF SPA-PRINT = '1'
               MOVE LOW-VALUES TO SPA-PRINT
               PERFORM G-010-PRINT-TICKETS THRU G-010-EXIT.
           IF RETURN-SWITCH = '1'
               MOVE '0' TO RETURN-SWITCH
               MOVE LOW-VALUES TO SPA-PHASE SPA-STATUS
               PERFORM C-090-MESSAGE-SWITCH THRU C-090-EXIT.
           IF S01-PRIMARY > SPACE
               MOVE '0' TO RETURN-SWITCH
               MOVE LOW-VALUES TO SPA-PHASE SPA-STATUS
               PERFORM C-090-MESSAGE-SWITCH THRU C-090-EXIT.
      *** CHECK FOR NUMERIC NEXT UPDATE KEY
           IF S01-REVIEW = SPACES
               GO TO E-010-EXIT.
           MOVE S01-REVIEW TO HOLD-REF.
           MOVE SPACE TO RGHT-RETURN.
           MOVE 7 TO RGHT-IN-LENGTH.
           CALL 'RGHTJUST' USING
             RGHT-RETURN
             HOLD-REF
             RGHT-IN-LENGTH.
           IF RGHT-RETURN = SPACE
               MOVE NUM-REF TO SPA-TEST-NO
           ELSE
               MOVE 'TEST NUMBER MUST BE NUMERIC  - PLEASE RE-ENTER'
                TO S01-ERRORMSG
               MOVE '1' TO EDIT-SWITCH
               MOVE CURSORPOS TO S01-REVIEWC
               GO TO E-010-EXIT.
           PERFORM C-220-GU-TESTHDRS THRU C-220-EXIT.
           IF DEMO-STATUS = BB
               NEXT SENTENCE
           ELSE
               MOVE S01-KEY TO SPA-TEST-NO
               MOVE 'TEST NUMBER NOT ON FILE  - PLEASE RE-ENTER'
                TO S01-ERRORMSG
               MOVE '1' TO EDIT-SWITCH
               MOVE CURSORPOS TO S01-REVIEWC
               GO TO E-010-EXIT.
           MOVE SPACES TO SPA-MATRIX.
           MOVE LOW-VALUES TO S01-MATRIX.
           PERFORM C-022-FORMAT-PROBLEM THRU C-022-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > 12.
           MOVE HDRS-STATUS TO SPA-STATUS.
           MOVE HDRS-LAST-DETS TO SPA-DETS-CNT.
           PERFORM C-230-GNP-TESTDETS THRU C-230-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > HDRS-LAST-DETS.
           PERFORM C-300-BUILD-SCREEN THRU C-300-EXIT.
           MOVE '8' TO SPA-PHASE.
       E-010-EXIT.
           EXIT.
       F-010-INQUIRY-TRANS.
      *** PROCESS INQUIRY TRANSACTION REQUESTS
      *** CHECK IF THIS IS FIRST TIME - IF SO GET DATA BASE BUILD SCREEN
           IF SPA-PHASE = LOW-VALUES
               PERFORM C-220-GU-TESTHDRS THRU C-220-EXIT
               MOVE HDRS-STATUS TO SPA-STATUS
               MOVE HDRS-LAST-DETS TO SPA-DETS-CNT
               PERFORM C-230-GNP-TESTDETS THRU C-230-EXIT
                VARYING I FROM 1 BY 1 UNTIL I > HDRS-LAST-DETS
               PERFORM C-300-BUILD-SCREEN THRU C-300-EXIT
               MOVE '7' TO SPA-PHASE
               MOVE '2' TO EDIT-SWITCH
               MOVE SPACES TO S01-ERRORMSG
               MOVE CURSORPOS TO S01-REVIEWC
               GO TO F-010-EXIT.
           IF S01-EXIT > SPACE
                   PERFORM C-100-RETURN THRU C-100-EXIT
                   GOBACK.
           IF S01-PRIMARY > SPACE
               MOVE '0' TO RETURN-SWITCH
               MOVE LOW-VALUES TO SPA-PHASE SPA-STATUS
               PERFORM C-090-MESSAGE-SWITCH THRU C-090-EXIT.
      *** CHECK FOR NUMERIC NEXT DISPLAY ASSIGNMENT
           IF S01-REVIEW = SPACES
               GO TO F-010-EXIT.
           MOVE S01-REVIEW TO HOLD-REF.
           MOVE SPACE TO RGHT-RETURN.
           MOVE 7 TO RGHT-IN-LENGTH
           CALL 'RGHTJUST' USING
             RGHT-RETURN
             HOLD-REF
             RGHT-IN-LENGTH.
           IF RGHT-RETURN = SPACE
               MOVE NUM-REF TO SPA-TEST-NO
           ELSE
               MOVE S01-KEY TO SPA-TEST-NO
               MOVE 'TEST NUMBER INVALID - PLEASE RE-ENTER'
                TO S01-ERRORMSG
               MOVE '1' TO EDIT-SWITCH
               MOVE CURSORPOS TO S01-REVIEWC
               GO TO F-010-EXIT.
           PERFORM C-220-GU-TESTHDRS THRU C-220-EXIT.
           IF DEMO-STATUS = BB
               NEXT SENTENCE
           ELSE
               MOVE 'TEST NUMBER NOT ON FILE  - PLEASE RE-ENTER'
                TO S01-ERRORMSG
               MOVE S01-KEY TO SPA-TEST-NO
               MOVE '1' TO EDIT-SWITCH
               MOVE CURSORPOS TO S01-REVIEWC
               GO TO F-010-EXIT.
           MOVE SPACES TO SPA-MATRIX.
           MOVE LOW-VALUES TO S01-MATRIX.
           PERFORM C-022-FORMAT-PROBLEM THRU C-022-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > 12.
           MOVE HDRS-STATUS TO SPA-STATUS.
           MOVE HDRS-LAST-DETS TO SPA-DETS-CNT.
           PERFORM C-230-GNP-TESTDETS THRU C-230-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > HDRS-LAST-DETS.
           PERFORM C-300-BUILD-SCREEN THRU C-300-EXIT.
           MOVE '2' TO EDIT-SWITCH.
           MOVE '7' TO SPA-PHASE
           MOVE CURSORPOS TO S01-REVIEWC.
       F-010-EXIT.
           EXIT.
       G-010-PRINT-TICKETS.
           MOVE '1' TO RETURN-SWITCH.
      *    GO TO G-010-EXIT.
      *** PRINT TICKETS IN REQUESTING AND TESTING DEPARTMENTS
      *** SET RETURN SWITCH TO 1 TO CAUSE MAIN MENU AFTER ADD
           PERFORM G-020-FORMAT-TICKET THRU G-020-EXIT.
           MOVE DEMO-TICKET TO BUFFER-CONTENT.
           MOVE TEST-DEPT TO MFS-PRINTER.
           CALL 'CBLTDLI' USING
            CHNG
            ALT-PCB
            MFS-PRINTER.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
                MOVE 3915              TO ABEND-CODE
                MOVE ALT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
      *** PRINT TWO TICKETS IN DEPARTMENTS - TICKET 1
           CALL 'CBLTDLI' USING
                          ISRT
                          ALT-PCB
                          MESSAGE-I-O-AREA
                          OTMFSPRT.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
                MOVE 3916              TO ABEND-CODE
                MOVE ALT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
      *** TICKET TWO
           CALL 'CBLTDLI' USING
                          ISRT
                          ALT-PCB
                          MESSAGE-I-O-AREA.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
                MOVE 3917              TO ABEND-CODE
                MOVE ALT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
      *** ISSUE PURGE CALL TO PROTECT MESSAGE - SWITCH PRINTER LTERMS
           CALL 'CBLTDLI' USING
                          PURG
                          ALT-PCB.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
                MOVE 3918              TO ABEND-CODE
                MOVE ALT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
      *** PRINT ONE COPY OF THE REQUEST TICKET IN THE ORIGINATING DEPT
           MOVE SPA-PLTERM TO MFS-PRINTER.
           CALL 'CBLTDLI' USING
            CHNG
            ALT-PCB
            MFS-PRINTER.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
               MOVE TEST-DEPT TO MFS-PRINTER
               CALL 'CBLTDLI' USING
                CHNG
                ALT-PCB
                MFS-PRINTER.
               IF ALT-STATUS = BB
                    NEXT SENTENCE
               ELSE
                    MOVE 3919              TO ABEND-CODE
                    MOVE ALT-STATUS        TO ERROR-STATUS
                    PERFORM C-099-ABEND.
      *** PRINT THE TICKETS IN THE REQUESTING DEPARTMENT
           CALL 'CBLTDLI' USING
                          ISRT
                          ALT-PCB
                          MESSAGE-I-O-AREA
                          OTMFSPRT.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
                MOVE 3920              TO ABEND-CODE
                MOVE ALT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
      *** ISSUE PURGE CALL TO PROTECT MESSAGE
           CALL 'CBLTDLI' USING
                          PURG
                          ALT-PCB.
           IF ALT-STATUS = BB
                NEXT SENTENCE
           ELSE
                MOVE 3921              TO ABEND-CODE
                MOVE ALT-STATUS        TO ERROR-STATUS
                PERFORM C-099-ABEND.
       G-010-EXIT.
           EXIT.
       G-020-FORMAT-TICKET.
           MOVE SPACES TO DEMO-TICKET.
           MOVE HDRS-KEY TO TKT-KEY.
           MOVE HDRS-NAME         TO TKT-REQUESTOR.
           MOVE HDRS-PHONE        TO TKT-PHONE
           MOVE HDRS-ENTRY-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 TKT-ENTRY-DATE.
           MOVE HDRS-REQUEST-DEPT TO TKT-REQUEST-DEPT.
           MOVE HDRS-LOCATION     TO TKT-LOCATION.
           MOVE HDRS-PRODUCT     TO TKT-PRODUCT.
           MOVE HDRS-PRIORITY     TO TKT-PRIORITY.
           MOVE HDRS-TESTER    TO TKT-TESTER.
           IF HDRS-STATUS  = 'N'
               MOVE 'NEW REQUEST' TO TKT-STATUS.
           IF HDRS-STATUS  = 'I'
               MOVE 'IN PROCESS' TO TKT-STATUS.
           IF HDRS-STATUS  = 'C'
               MOVE 'COMPLETED' TO TKT-STATUS.
           IF HDRS-STATUS  = 'D'
               MOVE 'DELETED' TO TKT-STATUS.
           MOVE TKT-FORMAT-LINE1 TO TKT-LINE (2).
           MOVE TKT-FORMAT-LINE2 TO TKT-LINE (3).
           MOVE TKT-FORMAT-LINE3 TO TKT-LINE (4).
           MOVE TKT-FORMAT-LINE4 TO TKT-LINE (5).
           MOVE TKT-FORMAT-LINE5 TO TKT-LINE (18).
           MOVE TKT-FORMAT-LINE6 TO TKT-LINE (19).
           PERFORM G-030-LOAD-TICKET-PROBLEM THRU G-030-EXIT
            VARYING I FROM 1 BY 1 UNTIL I > 12.
       G-020-EXIT.
           EXIT.
       G-030-LOAD-TICKET-PROBLEM.
           MOVE SPA-PROBLEM (I) TO TKT-PROBLEM (I).
       G-030-EXIT.
           EXIT.
       PROGRAM-TERMINATOR.
