       IDENTIFICATION   DIVISION.

       PROGRAM-ID.      EW48.
       AUTHOR.          DOE.
      *****************************************************************
      *                      COST BY TABLE                            *
      *****************************************************************
      * DATE CREATED:  06/17/95                                       *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 2009001 - 050409 - 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-MPEW48
                                       ORGANIZATION TRANSACTION
                                       CONTROL-AREA SCRCTL
                                       FILE STATUS  RETSCR.

           SELECT    BJR-DISK          ASSIGN       DATABASE-EWBJRB
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   BJRDK
                                       FILE STATUS  RETBJR.

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

       FD            SCR-DISPLAY.
       01            SCR.
           COPY      DDS-EW48-O        OF   MPEW48.

           COPY      EWBJRD            OF   CPYSRC.

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

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

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

           COPY      EWBJR              OF   CPYSRC.

       01            NEWKEY.
           05        NEWREQ.
             10      NEWREQ9           PIC  9(03).

       01            OLDKEY            PIC  X(03).

       01            WRK.
           05        WRKERR            PIC  X(01).

       01            CRD.
001        05        CRDREQ            PIC  X(03).
004        05        FILLER            PIC  X(01).
005        05        CRDID             PIC  X(02).
007        05        FILLER            PIC  X(01).
008        05        CRDPRT            PIC  X(01).
009        05        FILLER            PIC  X(03).
012        05        CRDDIST           PIC  X(02).
014        05        FILLER            PIC  X(01).
015        05        CRDFY             PIC  X(02).
017        05        FILLER            PIC  X(01).
018        05        CRDFUND           PIC  X(01).
022        05        FILLER            PIC  X(01).
023        05        CRDTBLE           PIC  X(05).
033        05        FILLER            PIC  X(01).
034        05        CRDSCHL           PIC  X(04).
035        05        FILLER            PIC  X(01).
034        05        CRDSUM            PIC  X(01).
035        05        FILLER            PIC  X(01).
036        05        CRDRPT            PIC  X(01).
037        05        CRDPGM            PIC  X(05).

       LINKAGE       SECTION.

           COPY      EWLNK               OF   CPYSRC.

       PROCEDURE     DIVISION           USING LNK.

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

       DECLARATIVES.
       000-ERROR     SECTION.
           USE AFTER STANDARD ERROR PROCEDURE ON SCR-DISPLAY
                                                 BJR-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   'EW48'
                   INDICATORS          ARE  IND
           READ    SCR-DISPLAY              RECORD
                   INDICATORS          ARE  IND
           MOVE    ZEROS               TO   LINNBR
                                            POSNBR
           MOVE    MREQ                TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           MOVE    NBR30               TO   NEWREQ9
           MOVE    NBR30               TO   MREQ
           IF      MREQ                =    '000'
             MOVE  SPACES              TO   MREQ.
           IF      INDOFF                  (VLDCMDKEY)              AND
                   MPNL                =    SPACES
             IF    NEWKEY              NOT  =   OLDKEY
               PERFORM 100-DISPLAY     THRU 100-EXIT
             ELSE
               PERFORM 300-UPDATE      THRU 300-EXIT
             END-IF
           ELSE
             PERFORM 010-FUNCTION      THRU 010-EXIT.
       005-EXIT.
           EXIT.

       010-FUNCTION.
           COPY    EWFUNC2P            OF   CPYSRC.
           IF      INDON                    (CF11)                  AND
                   NEWKEY              =    OLDKEY
             PERFORM 300-UPDATE        THRU 300-EXIT
             MOVE  LNKDIST             TO   BJRKEY
             MOVE  LNKTOSER            TO   BJRSER
             MOVE  LNKUSER             TO   BJRUSER
             MOVE  LNKTOPNL            TO   BJRPANEL
             MOVE  NEWREQ              TO   BJRREQ
             MOVE  BJRKEY              TO   BJRDK
             READ  BJR-DISK            WITH NO LOCK
             IF    RETBJR              =    '00'                    AND
                   WRKERR              =    'N'
               MOVE BJRD               TO   BJR
               MOVE BJRCARD1           TO   CRD
               CALL 'EWCLP04'       USING   CRDPGM BJR
               MOVE 'Request Submitted.  Next?'
                                       TO   MMSG
             ELSE
               MOVE 'Submission Error.  Retry.'
                                       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   'REQ  '
                 MOVE  LNKXFPROM       TO   NEWREQ
                 PERFORM 100-DISPLAY   THRU 100-EXIT
               WHEN   'SCHL '
                 MOVE  LNKXFPROM       TO   MSCHL
               WHEN   'TBLE '
                 MOVE  LNKXFPROM       TO   MTBLE
           ELSE
             IF      LNKXFPNL5         =    SPACES
               MOVE  MSG33             TO   MMSG.
       015-EXIT.
           EXIT.


       020-BACKWARD.
           MOVE    LNKDIST             TO   BJRKEY
           MOVE    LNKTOSER            TO   BJRSER
           MOVE    LNKUSER             TO   BJRUSER
           MOVE    LNKTOPNL            TO   BJRPANEL
           MOVE    NEWREQ              TO   BJRREQ
           MOVE    BJRKEY              TO   BJRDK
           READ    BJR-DISK            WITH NO LOCK
           IF      RETBJR              NOT  =   '00'
             START BJR-DISK            KEY  >   BJRDK.
           READ    BJR-DISK  PRIOR     WITH NO LOCK
           MOVE    BJRD                TO   BJR
           IF      RETBJR              =    '00'                    AND
                   BJRDIST             =    LNKDIST                 AND
                   BJRSER              =    LNKTOSER                AND
                   BJRPANEL            =    LNKTOPNL                AND
                   BJRUSER             =    LNKUSER
             MOVE  BJRREQ              TO   NEWREQ
             PERFORM 100-DISPLAY       THRU 100-EXIT
           ELSE
             MOVE  MSG13               TO   MMSG.
       020-EXIT.
           EXIT.

       030-FORWARD.
           MOVE    LNKDIST             TO   BJRKEY
           MOVE    LNKTOSER            TO   BJRSER
           MOVE    LNKUSER             TO   BJRUSER
           MOVE    LNKTOPNL            TO   BJRPANEL
           MOVE    NEWREQ              TO   BJRREQ
           MOVE    BJRKEY              TO   BJRDK
           READ    BJR-DISK            WITH NO LOCK
           IF      RETBJR              NOT  =   '00'
             START BJR-DISK            KEY  >   BJRDK.
           READ    BJR-DISK  NEXT      WITH NO LOCK
           MOVE    BJRD                TO   BJR
           IF      RETBJR              =    '00'                    AND
                   BJRDIST             =    LNKDIST                 AND
                   BJRSER              =    LNKTOSER                AND
                   BJRPANEL            =    LNKTOPNL                AND
                   BJRUSER             =    LNKUSER
             MOVE  BJRREQ              TO   NEWREQ
             PERFORM 100-DISPLAY       THRU 100-EXIT
           ELSE
             MOVE  MSG14               TO   MMSG.
       030-EXIT.
           EXIT.

       040-DELETE.
           MOVE    LNKDIST             TO   BJRKEY
           MOVE    LNKTOSER            TO   BJRSER
           MOVE    LNKUSER             TO   BJRUSER
           MOVE    LNKTOPNL            TO   BJRPANEL
           MOVE    NEWREQ              TO   BJRREQ
           MOVE    BJRKEY              TO   BJRDK
           READ    BJR-DISK
           IF      RETBJR              =    '00'
             DELETE BJR-DISK
             MOVE  MSG15               TO   MMSG
           ELSE
             MOVE  MSG16               TO   MMSG.
       040-EXIT.
           EXIT.

      *****************************************************************
       100-DISPLAY.
           MOVE    ZEROS               TO   IND
           MOVE    'N'                 TO   WRKERR
           MOVE    SPACES              TO   SCR
           MOVE    LOW-VALUES          TO   OLDKEY
           IF      NEWREQ              IS   NUMERIC                 AND
                   NEWREQ              NOT  =   '000'
             MOVE  NEWREQ              TO   MREQ.
       100-EDIT-KEY.
           IF      NEWREQ              =    '000'                   OR
                   NEWREQ              =    '   '
             SET   INDON          (97) TO   TRUE
             MOVE  MSG31               TO   MMSG
             GO                        TO   100-EXIT.
           IF      WRKERR              =    'Y'
             MOVE  MSG17               TO   MMSG
             GO                        TO   100-EXIT.
       100-READ.
           MOVE    LNKDIST             TO   BJRKEY
           MOVE    LNKTOSER            TO   BJRSER
           MOVE    LNKUSER             TO   BJRUSER
           MOVE    LNKTOPNL            TO   BJRPANEL
           MOVE    NEWREQ              TO   BJRREQ
           MOVE    BJRKEY              TO   BJRDK
           READ    BJR-DISK            WITH NO LOCK
           IF      LNKFAYZ      (2 09) =    'U'
             MOVE  NEWKEY              TO   OLDKEY.
           IF      RETBJR              NOT  =   '00'
             IF    LNKFAYZ      (2 09) =    'U'
               SET   INDON        (98) TO   TRUE
               MOVE  MSG18             TO   MMSG
             ELSE
               SET   INDON        (97) TO   TRUE
               MOVE  LOW-VALUES        TO   OLDKEY
               MOVE  MSG19             TO   MMSG
           ELSE
             SET     INDON        (97) TO   TRUE
             MOVE    MSG20             TO   MMSG
             MOVE    BJRD              TO   BJR
             MOVE    BJRHEAD1          TO   MHEAD1
             MOVE    BJRHEAD2          TO   MHEAD2
             MOVE    BJRCARD1          TO   CRD
             MOVE    CRDFUND           TO   MFUND
             MOVE    CRDTBLE           TO   MTBLE
             MOVE    CRDSCHL           TO   MSCHL
             MOVE    CRDSUM            TO   MSUM
             MOVE    CRDRPT            TO   MRPT
             MOVE    CRDPRT            TO   MPRT
             IF      LNKFAYZ    (2 09) =    'I'
               MOVE  MSG36              TO   MMSG.
       100-EXIT.
           EXIT.

      *****************************************************************
       300-UPDATE.
           MOVE    LNKDIST             TO   BJRKEY
           MOVE    LNKTOSER            TO   BJRSER
           MOVE    LNKUSER             TO   BJRUSER
           MOVE    LNKTOPNL            TO   BJRPANEL
           MOVE    NEWREQ              TO   BJRREQ
           MOVE    BJRKEY              TO   BJRDK
           READ    BJR-DISK            WITH NO LOCK
           MOVE    ZEROS               TO   IND
           MOVE    'N'                 TO   WRKERR
           IF      RETBJR              NOT  =   '00'
             INITIALIZE                     BJRDATA
             MOVE  BJR                 TO   BJRD
           ELSE
             MOVE  BJRD                TO   BJR.
       300-DEFAULT.
           IF      MPRT                NOT  >   SPACES
             MOVE  'N'                 TO   MPRT.
       300-MOVE.
           MOVE    NEWREQ              TO   BJRREQ1
           MOVE    'H1'                TO   BJRID1
           MOVE    LNKUSER             TO   BJRUSER1
           MOVE    NEWREQ              TO   BJRREQ1
           MOVE    MHEAD1              TO   BJRHEAD1
           MOVE    NEWREQ              TO   BJRREQ2
           MOVE    'H2'                TO   BJRID2
           MOVE    LNKUSER             TO   BJRUSER2
           MOVE    MHEAD2              TO   BJRHEAD2
           INITIALIZE                       CRD
           MOVE    NEWREQ              TO   CRDREQ
           MOVE    'SL'                TO   CRDID
           MOVE    LNKDIST             TO   CRDDIST
           MOVE    LNKFY               TO   CRDFY
           MOVE    MSCHL               TO   CRDSCHL
           MOVE    MSUM                TO   CRDSUM
           MOVE    MTBLE               TO   CRDTBLE
           MOVE    MFUND               TO   CRDFUND
           MOVE    MRPT                TO   CRDRPT
           MOVE    MPRT                TO   CRDPRT
           EVALUATE CRDRPT
             WHEN   'A'
               MOVE 'EW028'            TO   CRDPGM
             WHEN   'B'
               MOVE 'EW028'            TO   CRDPGM
             WHEN   'C'
               MOVE 'EW029'            TO   CRDPGM
           END-EVALUATE
           MOVE    CRD                 TO   BJRCARD1.
       300-EDIT.
           IF      BJRHEAD1            =    SPACES
             SET   INDON          (17) TO   TRUE
             MOVE  'Y'                 TO   WRKERR.
           IF      CRDFUND             NOT  =   '1'                 AND
                   CRDFUND             NOT  =   '4'                 AND
050409             CRDFUND             NOT  =   '5'                 AND
050409             CRDFUND             NOT  =   '6'                 AND
050409             CRDFUND             NOT  =   '7'                 AND
020411             CRDFUND             NOT  =   '8'                 AND
020411             CRDFUND             NOT  =   '9'                 AND
                   CRDFUND             NOT  =   ' '
             SET   INDON          (19) TO   TRUE
             MOVE  'Y'                 TO   WRKERR.
           IF      CRDRPT              NOT  =   'A'                 AND
                   CRDRPT              NOT  =   'B'                 AND
                   CRDRPT              NOT  =   'C'
             SET   INDON          (40) TO   TRUE
             MOVE  'Y'                 TO   WRKERR.
           IF     (CRDSUM              =    'Y'              AND
                   CRDRPT              NOT  =   'C')                OR
                  (CRDSUM              NOT  =   ' '          AND
                   CRDSUM              NOT  =   'Y')
             SET   INDON          (22) TO   TRUE
             MOVE  'Y'                 TO   WRKERR.
           IF      CRDPRT              NOT  =   'U'                 AND
                   CRDPRT              NOT  =   'T'                 AND
                   CRDPRT              NOT  =   'B'                 AND
                   CRDPRT              NOT  =   'N'
             SET   INDON          (41) TO   TRUE
             MOVE  'Y'                 TO   WRKERR.
           IF      WRKERR              NOT  =   'N'
             MOVE    MSG21             TO   MMSG
           ELSE
             SET     INDON        (97) TO   TRUE
             IF      BJR               =    BJRD
               MOVE    MSG22           TO   MMSG
             ELSE
               MOVE  BJR               TO   BJRD
               IF      RETBJR          NOT  =   '00'
                 MOVE  MSG23           TO   MMSG
                 WRITE BJRD
               ELSE
                 MOVE  MSG24           TO   MMSG
                 REWRITE BJRD.
       300-EXIT.
           EXIT.

      *****************************************************************
       490-HOUSEKEEPING.
           OPEN    I-O                      SCR-DISPLAY
                                            BJR-DISK
           IF      RETSCR              NOT  =   '00' AND '41'        OR
                   RETBJR              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
             WHEN    '0'
               PERFORM 100-DISPLAY     THRU 100-EXIT
             WHEN '1'
               MOVE  MSG04             TO   MMSG
             WHEN '2'
               MOVE  MSG05             TO   MMSG
             WHEN '3'
               MOVE  MSG06             TO   MMSG
             WHEN '4' THRU '5'
               MOVE  MSG07             TO   MMSG.
           IF      LNKSTAT             NOT  =   '0'
             SET   INDON          (15) TO   TRUE
             MOVE  ZEROS               TO   LINNBR
                                            POSNBR.
       490-EXIT.
           EXIT.

      *****************************************************************
           COPY      EWNUMBP           OF   CPYSRC.
      *****************************************************************
       990-HOUSEKEEPING.
           COPY    EWXFERP             OF   CPYSRC.
       990-EXIT.
           EXIT.

