       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW50.
       AUTHOR.          DOE.
      *****************************************************************
      *                         FORM QUERY                            *
      *****************************************************************
      * DATE CREATED:  06/17/95                                       *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * FIX9904 - 041599 - ADD PROCESSING FOR FORM 7 SELECTION        *
      * 2009001 - 051009 - ALLOW FUNDS 5,6,7 FOR AARA MONEY           *
      * 2011001 - 020411 - ADD ARRA FUNDS 8 & 9                       *
      *****************************************************************

       ENVIRONMENT      DIVISION.
       CONFIGURATION    SECTION.
       SOURCE-COMPUTER. AS-400.
       OBJECT-COMPUTER. AS-400.
       SPECIAL-NAMES.
           I-O-FEEDBACK                IS           DSP-FEEDBACK.

       INPUT-OUTPUT     SECTION.
       FILE-CONTROL.

           SELECT    SCR-DISPLAY       ASSIGN       WORKSTATION-MPEW50
                                       ORGANIZATION TRANSACTION
                                       CONTROL-AREA SCRCTL
                                       FILE STATUS  RETSCR.

           SELECT    CDF-DISK          ASSIGN       DATABASE-EWCDFI
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   CDFDK
                                       FILE STATUS  RETCDF.

      *****************************************************************
       DATA          DIVISION.
       FILE          SECTION.

       FD            SCR-DISPLAY.
       01            SCR.
           COPY      DDS-EW50-O        OF   MPEW50.
           05        R50   REDEFINES        EW50-O.
             10      FILLER            PIC  X(23).
             10      RLINES.
               15    RLINE OCCURS 014  TIMES INDEXED BY SCR1 SCR2 SCR3.
                 20  RFUND             PIC  X(03).
                 20  RTABLE            PIC  X(06).
                 20  RSCHL             PIC  X(05).
                 20  RCTRL.
                   25  RCNBR           PIC  X(01).
                   25  RPGM            PIC  X(03).

           COPY      EWCDFD            OF   CPYSRC.

      *****************************************************************
       WORKING-STORAGE SECTION.

           COPY      EWSCRCTL          OF   CPYSRC.
           COPY      EWIND             OF   CPYSRC.
           COPY      EWMSG             OF   CPYSRC.

       01            RET.
           05        RETSCR            PIC  X(02).
           05        RETCDF            PIC  X(02).

           COPY      EWCDF             OF   CPYSRC.

       01            NEWKEY.
           05        NEWFUND           PIC  X(01).
           05        NEWTABLE          PIC  X(05).
           05        NEWSCHL           PIC  X(04).
           05        NEWCTRL           PIC  X(04).
       01            NEWBYTES   REDEFINES   NEWKEY.
           05        NEWBYTE    OCCURS 014  TIMES INDEXED BY NEW1
                                       PIC  X(01).
       01            OLDKEY            PIC  X(14).

       01            WRK.
           05        WRKSTAT           PIC  X(01)   VALUE '*'.
           05        WRKERR            PIC  X(01).
           05        WRKPF7            PIC  X(256).
           05        WRKPF8            PIC  X(256).
           05        WRKLINES          PIC  X(252).
           05        WRKREAD           PIC S9(5)    COMP-3 VALUE +0.
           05        WRKMAX            PIC S9(5)    COMP-3 VALUE +2500.
           05        WRKNBR            PIC S9(3)    COMP-3 VALUE +014.
           05        WRKLOW.
             10      FILLER            PIC  X(04).
             10      WRKLOWX.
               15    FILLER            PIC  X(13).
               15    WRKLOWBYTE        PIC  X(01).
           05        WRKHIGH.
             10      FILLER            PIC  X(04).
             10      WRKHIGHX.
               15    FILLER            PIC  X(13).
               15    WRKHIGHBYTE       PIC  X(01).
           05        WRKKEY.
             10      WRKFUND           PIC  X(01).
             10      WRKTABLE          PIC  X(05).
             10      WRKSCHL           PIC  X(04).
             10      WRKCONTROL        PIC  X(04).
           05        WRKBYTES   REDEFINES   WRKKEY.
             10      WRKBYTE    OCCURS 014  TIMES INDEXED BY WRK1
                                       PIC  X(01).

       LINKAGE       SECTION.

           COPY      EWLNK               OF   CPYSRC.

       PROCEDURE     DIVISION           USING LNK.

      *****************************************************************

       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON SCR-DISPLAY
                                                 CDF-DISK.
       000-ENCOUNTERED.
           CONTINUE.
       END DECLARATIVES.

      *****************************************************************
       000-MAINLINE  SECTION.

       000-CONTROL.
           PERFORM 490-HOUSEKEEPING    THRU 490-EXIT
           PERFORM 005-MAIN            THRU 005-EXIT
             UNTIL LNKTO               NOT  =   LNKFR
           PERFORM 990-HOUSEKEEPING    THRU 990-EXIT
           GOBACK.
       000-EXIT.
           EXIT.

       005-MAIN.
           WRITE   SCR          FORMAT IS   'EW50'
                   INDICATORS          ARE  IND
           READ    SCR-DISPLAY              RECORD
                   INDICATORS          ARE  IND
           SET     INDOFF         (15) TO   TRUE
           MOVE    ZEROS               TO   LINNBR
                                            POSNBR
           MOVE    MFUND               TO   NEWFUND
           MOVE    MTABLE              TO   NEWTABLE
           MOVE    MSCHL               TO   NEWSCHL
           MOVE    MCTRL               TO   NEWCTRL
           IF      INDOFF                  (VLDCMDKEY)              AND
                   MPNL                =    SPACES                  AND
                   NEWKEY              NOT  =   OLDKEY
             PERFORM 100-DISPLAY       THRU 100-EXIT
           ELSE
             PERFORM 010-FUNCTION      THRU 010-EXIT.
       005-EXIT.
           EXIT.

       010-FUNCTION.
           COPY    EWFUNC5P             OF   CPYSRC.
           IF      INDOFF                   (VLDCMDKEY)             OR
                   INDON                    (CF03)
             ACCEPT  FDB               FROM DSP-FEEDBACK
                                       FOR  SCR-DISPLAY
             DIVIDE  FDBCPOSN          BY   256
                     GIVING                 LINNBR
                     REMAINDER              POSNBR
             IF      LINNBR            >    +7                      AND
                     LINNBR            <    +22
               SET   SCR3              TO   LINNBR
               SET   SCR3              DOWN BY  +7
               IF    RTABLE     (SCR3) >    SPACES
                 MOVE  RFUND    (SCR3) TO   LNKDBFUND
                 MOVE  RTABLE   (SCR3) TO   LNKDBTABLE
                 MOVE  RSCHL    (SCR3) TO   LNKDBSCHL
                 IF    LNKTO           =    LNKFR
                   IF  (RCNBR   (SCR3) =    '1')                    OR
                       (RCNBR   (SCR3) =    '2')                    OR
                       (RCNBR   (SCR3) =    '3')
                     MOVE 'B03'        TO   LNKTOPNL
041599             ELSE
041599               IF  (RCNBR (SCR3) =    '4')                    OR
041599                   (RCNBR (SCR3) =    '5')
041599                 MOVE  'B11'     TO   LNKTOPNL
                   ELSE
                     IF  (RCNBR (SCR3) =    '6')                    OR
                         (RCNBR (SCR3) =    '7')
                       MOVE  'B04'     TO   LNKTOPNL
                     ELSE
                       MOVE  'B05'     TO   LNKTOPNL
                     END-IF
                   END-IF
                 END-IF
               ELSE
                 MOVE  MSG25           TO   MMSG.
       010-EXIT.
           EXIT.

       015-F4.
           ACCEPT  FDB                 FROM DSP-FEEDBACK
                                       FOR  SCR-DISPLAY
           DIVIDE  FDBCPOSN            BY   256
                   GIVING              LNKXFROW
                   REMAINDER           LNKXFCOL
           COMPUTE LNKXFLOC9           =   ((LNKXFROW - 1) * 80)
                                       +    (LNKXFCOL - 1)
           MOVE    LNKFRSER            TO   LNKXFSER
           MOVE    LNKFRMENU           TO   LNKXFMENU
           MOVE    LNKFRNBR            TO   LNKXFNBR
           MOVE    LNKXFROW            TO   LINNBR
           MOVE    LNKXFCOL            TO   POSNBR
           CALL    'EW85'              USING LNK
             ON OVERFLOW
               GO                      TO   015-EXIT.
           CANCEL    'EW85'
           IF        LNKXFPROM         >    SPACES                  AND
                     LNKXFPNL5         >    SPACES
             EVALUATE  LNKXFPNL5
               WHEN   'TBLE'
                 MOVE  LNKXFPROM       TO   MTABLE
               WHEN   'SCHL'
                 MOVE  LNKXFPROM       TO   MSCHL
               WHEN    OTHER
                 MOVE  MSG33           TO   MMSG
           ELSE
             IF      LNKXFPNL5         =    SPACES
               MOVE  MSG33             TO   MMSG.
       015-EXIT.
           EXIT.

       020-BACKWARD.
           MOVE    RLINES              TO   WRKLINES
           IF      RLINE          (01) >    SPACES
             SET     SCR2              TO   +14
             MOVE    SPACES            TO   RLINES.
           MOVE    WRKPF7              TO   CDFDK
           PERFORM 120-BACKWARD        THRU 120-EXIT
           IF      RLINES              =    SPACES                  OR
                   RLINES              =    WRKLINES
             MOVE  WRKLINES            TO   RLINES.
       020-EXIT.
           EXIT.

       030-FORWARD.
           MOVE    RLINES              TO   WRKLINES
           IF      RLINE          (14) >    SPACES
             SET   SCR1                TO   +1
             MOVE  SPACES              TO   RLINES.
           MOVE    WRKPF8              TO   CDFDK
           PERFORM 110-FORWARD         THRU 110-EXIT
           IF      RLINES              =    SPACES                  OR
                   RLINES              =    WRKLINES
             MOVE  WRKLINES            TO   RLINES.
       030-EXIT.
           EXIT.

      *****************************************************************
       100-DISPLAY.
           MOVE    ZEROS               TO   IND
           MOVE    'N'                 TO   WRKERR
           MOVE    SPACES              TO   SCR
           MOVE    LOW-VALUES          TO   OLDKEY
           MOVE    NEWFUND             TO   MFUND
           MOVE    NEWTABLE            TO   MTABLE
           MOVE    NEWSCHL             TO   MSCHL
           MOVE    NEWCTRL             TO   MCTRL.
       100-EDIT-KEY.
           IF     (NEWFUND             NOT  =   '1')                AND
                  (NEWFUND             NOT  =   '4')                AND
051009            (NEWFUND             NOT  =   '5')                AND
051009            (NEWFUND             NOT  =   '6')                AND
051009            (NEWFUND             NOT  =   '7')                AND
020411            (NEWFUND             NOT  =   '8')                AND
020411            (NEWFUND             NOT  =   '9')                AND
                  (NEWFUND             NOT  =   ' ')
             MOVE  'Y'                 TO   WRKERR
051009*      SET   INDON          (18) TO   TRUE.
051009       SET   INDON          (16) TO   TRUE.
           IF    WRKERR              =    'Y'
             MOVE  MSG27             TO   MMSG
           ELSE
             SET   INDON        (98) TO   TRUE
             SET   SCR1              TO   +1
             MOVE  NEWKEY            TO   OLDKEY
             MOVE  LNKDIST           TO   CDFKEY
             MOVE  LNKFY             TO   CDFFY
             MOVE  NEWFUND           TO   CDFFUND
             MOVE  NEWTABLE          TO   CDFTABLE
             MOVE  NEWSCHL           TO   CDFSCHL
             MOVE  NEWCTRL           TO   CDFCONTROL
             MOVE  CDFKEY            TO   WRKHIGH
                                          WRKLOW
             MOVE  SPACES            TO   WRKLOWBYTE    WRKHIGHBYTE
             INSPECT WRKLOWX    REPLACING ALL ' ' BY LOW-VALUES
             INSPECT WRKHIGHX   REPLACING ALL ' ' BY HIGH-VALUES
             MOVE  WRKLOW            TO   CDFDK
             PERFORM 110-FORWARD     THRU 110-EXIT.
       100-EXIT.
           EXIT.

       110-FORWARD.
           MOVE    ZEROS               TO   WRKREAD
           START   CDF-DISK            KEY  >    CDFDK.
       110-READ-LOOP.
           READ    CDF-DISK                 NEXT
           IF      RETCDF              =    '00'                    AND
                   CDFDK               <    WRKHIGH
             MOVE  CDFD                TO   CDF
             MOVE  CDF                 TO   WRKPF8
             ADD   +1                  TO   WRKREAD
             PERFORM 130-SELECT        THRU 130-EXIT
             IF    WRKKEY              =    NEWKEY
               MOVE  CDFFUND           TO   RFUND          (SCR1)
               MOVE  CDFTABLE          TO   RTABLE         (SCR1)
               MOVE  CDFSCHL           TO   RSCHL          (SCR1)
               MOVE  CDFCONTROL        TO   RCTRL          (SCR1)
               IF    SCR1              =    +1
                 MOVE  CDFKEY          TO   WRKPF7
               END-IF
               SET   SCR1              UP   BY  +1
             END-IF
             IF    SCR1                <    +15                     AND
                   WRKREAD             <    WRKMAX
               GO                      TO   110-READ-LOOP.
           IF      SCR1                =    +1                      AND
                   WRKREAD             <    WRKMAX
             MOVE  MSG30               TO   MMSG
           ELSE
             IF      SCR1              =    15
               MOVE  MSG28             TO   MMSG
             ELSE
               IF    WRKREAD           <    WRKMAX
                 MOVE  MSG14           TO   MMSG
               ELSE
                 MOVE  MSG29           TO   MMSG.
           SET     INDON          (97) TO   TRUE.
       110-EXIT.
           EXIT.

       120-BACKWARD.
           MOVE    ZEROS               TO   WRKREAD
           START   CDF-DISK            KEY  >=   CDFDK.
       120-READ-LOOP.
           READ    CDF-DISK                 PRIOR
           ADD     +1                  TO   WRKREAD
           IF      RETCDF              =    '00'                    AND
                   CDFDK               >    WRKLOW
             MOVE  CDFD                TO   CDF
             MOVE  CDF                 TO   WRKPF7
             PERFORM 130-SELECT        THRU 130-EXIT
             IF    WRKKEY              =    NEWKEY
               MOVE  CDFFUND           TO   RFUND          (SCR2)
               MOVE  CDFTABLE          TO   RTABLE         (SCR2)
               MOVE  CDFSCHL           TO   RSCHL          (SCR2)
               MOVE  CDFCONTROL        TO   RCTRL          (SCR2)
               IF    SCR2              =    +14
                 MOVE  CDFKEY          TO   WRKPF8
               END-IF
               SET   SCR2              DOWN BY  +1
             END-IF
             IF    SCR2                >    +0                      AND
                   WRKREAD             <    WRKMAX
               GO                      TO   120-READ-LOOP.
           IF      SCR2                =    +0                      AND
                   WRKREAD             <    WRKMAX
             MOVE  MSG28               TO   MMSG
           ELSE
             IF    WRKREAD             <    WRKMAX
               MOVE  MSG13             TO   MMSG
             ELSE
               MOVE  MSG29             TO   MMSG.
           SET     INDON          (97) TO   TRUE.
       120-EXIT.
           EXIT.

       130-SELECT.
           MOVE    CDFFUND             TO   WRKFUND
           MOVE    CDFTABLE            TO   WRKTABLE
           MOVE    CDFSCHL             TO   WRKSCHL
           MOVE    CDFCONTROL          TO   WRKCONTROL
           SET     WRK1                TO   +1
           SET     NEW1                TO   +1
           PERFORM 140-COMPARE         THRU 140-EXIT
             VARYING NEW1              FROM +1 BY +1
               UNTIL NEW1              >    WRKNBR.
       130-EXIT.
           EXIT.

       140-COMPARE.
           SET     WRK1                TO   NEW1
           IF      NEWBYTE (NEW1)      =    ' '
             MOVE  ' '                 TO   WRKBYTE (WRK1).
       140-EXIT.
           EXIT.

      *****************************************************************
       490-HOUSEKEEPING.
           OPEN    I-O                      SCR-DISPLAY
                   INPUT                    CDF-DISK
           IF      RETSCR              NOT  =   '00' AND '41'        OR
                   RETCDF              NOT  =   '00' AND '41'
             CALL   'EWCLP03'
               ON OVERFLOW
                 CONTINUE
             END-CALL
             MOVE  LNKFR               TO   LNKTO
             MOVE  SPACES              TO   LNKFR
           ELSE
             MOVE  LNKTO               TO   LNKFR
             EVALUATE LNKSTAT ALSO WRKSTAT = '*'
             WHEN '0' ALSO TRUE
               MOVE  SPACES            TO   SCR
               SET   INDON        (97) TO   TRUE
               MOVE  LOW-VALUES        TO   OLDKEY
               MOVE  MSG26             TO   MMSG
             WHEN '0' ALSO ANY
               SET    INDOFF      (15) TO   TRUE
               MOVE   SPACES           TO   MPNL
             WHEN '1' ALSO ANY
               MOVE  MSG04             TO   MMSG
             WHEN '2' ALSO ANY
               MOVE  MSG05             TO   MMSG
             WHEN '3' ALSO ANY
               MOVE  MSG06             TO   MMSG
             WHEN '4' THRU '5' ALSO ANY
               MOVE  MSG07             TO   MMSG.
           IF      LNKSTAT             NOT  =   '0'
             SET   INDON          (15) TO   TRUE
             MOVE  ZEROS               TO   LINNBR
                                            POSNBR.
             SET   INDON          (98) TO   TRUE.
       490-EXIT.
           EXIT.

      *****************************************************************
       990-HOUSEKEEPING.
           COPY    EWXFERP             OF   CPYSRC.
           MOVE    LNKXFROW            TO   LINNBR
           MOVE    LNKXFCOL            TO   POSNBR
           MOVE    'K'                 TO   LNKSTAT          WRKSTAT.
       990-EXIT.
           EXIT.
