       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW52.
       AUTHOR.          DOE.
      *****************************************************************
      *                        B11. FORM 7                            *
      *****************************************************************
      * DATE CREATED:  04/28/99                                       *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 2006001 - 041306 - ADD FUNCTIONS 6500 & 8200.                 *
      * 2009001 - 050409 - EDIT VALID FUND AND ADDED ADDITIONAL FUNDS *
      *                    FOR AARA MONEY (STIMULUS DOLLARS)          *
      * 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-MPEW52
                                       ORGANIZATION TRANSACTION
                                       CONTROL-AREA SCRCTL
                                       FILE STATUS  RETSCR.

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

           SELECT    CRF-DISK          ASSIGN       DATABASE-EWCRFI
                                       ORGANIZATION INDEXED
                                       ACCESS       RANDOM
                                       RECORD KEY   CRFDK
                                       FILE STATUS  RETCRF.

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

       FD            SCR-DISPLAY.
       01            SCR.
           COPY      DDS-EW52-O        OF   MPEW52.
           05        R44   REDEFINES        EW52-O.
041306*      10      FILLER            PIC  X(154).
041306       10      FILLER            PIC  X(174).
             10      RLINES.
               15    RLINE OCCURS 007  TIMES INDEXED BY SCR1 SCR2 SCR3.
                 20  RPGM              PIC  X(03).
                 20  RSAL              PIC  ZZZZZZZZ-.
                 20  RBEN              PIC  ZZZZZZZZ-.
                 20  RPURSRV           PIC  ZZZZZZZZ-.
                 20  RMTRL             PIC  ZZZZZZZZ-.
                 20  ROTHR             PIC  ZZZZZZZZ-.
                 20  RCAP              PIC  ZZZZZZZZ-.
                 20  RSIND             PIC  ZZZZZZZZ-.

           COPY      EWCDFD            OF   CPYSRC.
           COPY      EWCRFD            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        RETCDF            PIC  X(02).
           05        RETCRF            PIC  X(02).

           COPY      EWCDF             OF   CPYSRC.
           COPY      EWSCL             OF   CPYSRC.
           COPY      EWCRF             OF   CPYSRC.
           COPY      EWFPG             OF   CPYSRC.

       01            NEWKEY.
           05        NEWFUND           PIC  X(01).
           05        NEWSCHL           PIC  X(04).
       01            NEWBYTES   REDEFINES   NEWKEY.
           05        NEWBYTE    OCCURS 005  TIMES INDEXED BY NEW1
                                       PIC  X(01).

       01            OLDKEY            PIC  X(05).

       01            WRK.
           05        WRKERR            PIC  X(01).
           05        WRKERR2           PIC  X(01).
           05        WRKPF7            PIC  X(256).
           05        WRKPF8            PIC  X(256).
           05        WRKLINES          PIC  X(462).
           05        WRKIND            PIC  X(99).
           05        WRKNBR            PIC S9(3)    COMP-3 VALUE +010.
           05        WRKIDX            PIC S9(3)    COMP-3.
           05        WRKROW            PIC S9(3)    COMP-3.
           05        WRKLOW.
             10      FILLER            PIC  X(18).
           05        WRKHIGH.
             10      FILLER            PIC  X(18).
           05        WRKKEY.
             10      WRKFUND           PIC  X(01).
             10      WRKSCHL           PIC  X(04).
           05        WRKBYTES   REDEFINES   WRKKEY.
             10      WRKBYTE    OCCURS 005  TIMES INDEXED BY WRK1
                                       PIC  X(01).
           05        WRKDEL            PIC  X(01).
           05        WRKACT            PIC  X(01).
           05        WRKBLNK           PIC  X(01).
           05        WRKFIRST          PIC  X(01).
           05        WRKADDLN          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
                                                 CRF-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   'EW52'
                   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    MSCHL               TO   NEWSCHL
           IF      INDOFF                  (VLDCMDKEY)              AND
                   MPNL                =    SPACES                  AND
                   NEWKEY              NOT  =   OLDKEY
             PERFORM 100-DISPLAY       THRU 100-EXIT
           ELSE
             IF      INDOFF                (VLDCMDKEY)              AND
                     MPNL              =    SPACES                  AND
                     NEWKEY            =    OLDKEY
               PERFORM 300-UPDATE      THRU 300-EXIT
             ELSE
               PERFORM 010-FUNCTION    THRU 010-EXIT.
       005-EXIT.
           EXIT.

       010-FUNCTION.
           IF      INDON                   (CF01)
             ACCEPT  FDB               FROM DSP-FEEDBACK
                                       FOR  SCR-DISPLAY
             DIVIDE  FDBCPOSN          BY   256
                     GIVING                 LNKXFROW
                     REMAINDER              LNKXFCOL
             MOVE    LNKXFROW          TO   LINNBR
             MOVE    LNKXFCOL          TO   POSNBR
             COMPUTE LNKXFLOC9         =   ((LNKXFROW - 1) * 80)
                                       +    (LNKXFCOL - 1)
             IF    LNKXFROW            >    +13                     AND
                   LNKXFROW            <    +21
               COMPUTE LNKXFLOC9       =    LNKXFCOL + 1039
             END-IF
             MOVE    LNKFRSER          TO   LNKXFSER
             MOVE    LNKFRMENU         TO   LNKXFMENU
             MOVE    LNKFRNBR          TO   LNKXFNBR
             CALL   'EW84'          USING   LNK
             CANCEL 'EW84'
             GO                        TO   010-EXIT.
           IF      INDON                    (CF05)
             IF    RPGM           (07) NOT  =   SPACES
               MOVE  SPACES            TO   RLINES
               MOVE  ZEROS             TO   IND
               SET   INDON        (99) TO   TRUE
               MOVE  MSG34             TO   MMSG
             ELSE
               PERFORM  100-DISPLAY    THRU 100-EXIT
               SET      INDON     (14) TO   TRUE.
           COPY    EWFUNC2P            OF   CPYSRC.
           IF      INDON                    (CF03)                  AND
                   LNKXFPNL            =    'B02'
             MOVE  'B02'               TO   LNKTOPNL.
       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)
           IF      LNKXFROW            >    +13                     AND
                   LNKXFROW            <    +21
             COMPUTE LNKXFLOC9         =    LNKXFCOL + 1039.
           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      LINNBR              >=   +14                     AND
                   LINNBR              <=   +20
             SET   SCR3                TO   LINNBR
             SET   SCR3                DOWN BY  +13.
           IF      LNKXFPNL5           =    'PGM  '
             SET   WRKIDX              TO   SCR3
             COMPUTE  WRKIDX           =   (WRKIDX - 1) + 90
             IF    INDON                    (WRKIDX)
               MOVE  SPACES            TO   LNKXFPROM.
           IF        LNKXFPROM         >    SPACES                  AND
                     LNKXFPNL5         >    SPACES
             EVALUATE  LNKXFPNL5
               WHEN   'SCHL '
                 MOVE  LNKXFPROM       TO   MSCHL
               WHEN    'PGM  '
                 MOVE  LNKXFPROM       TO   RPGM       (SCR3)
               WHEN    OTHER
                 MOVE  MSG33           TO   MMSG
           ELSE
             IF      LNKXFPNL5         =    SPACES
               MOVE  MSG33             TO   MMSG.
       015-EXIT.
           EXIT.


       020-BACKWARD.
           MOVE    RLINES              TO   WRKLINES
           MOVE    IND                 TO   WRKIND
           SET     SCR2                TO   +07
           MOVE    SPACES              TO   RLINES
           MOVE    ZEROS               TO   IND
           MOVE    WRKPF7              TO   CDFDK
           PERFORM 120-BACKWARD        THRU 120-EXIT
           IF      RLINES              =    SPACES                  OR
                   RLINES              =    WRKLINES
             MOVE  WRKIND              TO   IND
             MOVE  WRKLINES            TO   RLINES.
       020-EXIT.
           EXIT.


       030-FORWARD.
           MOVE    RLINES              TO   WRKLINES
           MOVE    IND                 TO   WRKIND
           SET     SCR1                TO   +1
           MOVE    SPACES              TO   RLINES
           MOVE    ZEROS               TO   IND
           MOVE    WRKPF8              TO   CDFDK
           MOVE    SPACES              TO   WRKFIRST
           PERFORM 110-FORWARD         THRU 110-EXIT
           IF      RLINES              =    SPACES                  OR
                   RLINES              =    WRKLINES
             MOVE  WRKIND              TO   IND
             MOVE  WRKLINES            TO   RLINES.
       030-EXIT.
           EXIT.

       040-DELETE.
           IF      LNKFAYZ      (2 04) NOT  =   'U'
             PERFORM 100-DISPLAY       THRU 100-EXIT
             MOVE    MSG32             TO   MMSG
             GO                        TO   040-EXIT.
           MOVE    SPACES              TO   WRKDEL
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    '99998'             TO   CDFTABLE
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '3999'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           START   CDF-DISK            KEY  >   CDFDK.
       040-LOOP1.
           READ    CDF-DISK    NEXT    WITH NO LOCK
           MOVE    CDFD                TO   CDF
           IF     (RETCDF              =    '00')                   AND
                  (CDFDIST             =    LNKDIST)                AND
                  (CDFFY               =    LNKFY)                  AND
                  (CDFFUND             =    NEWFUND)                AND
                  (CDFTABLE            =    '99998')                AND
                  (CDFSCHL             =    NEWSCHL)                AND
                  (CDFCNBR             =    '4'                  OR
                   CDFCNBR             =    '5')
             DELETE  CDF-DISK
             MOVE    'Y'               TO   WRKDEL
             GO                        TO   040-LOOP1.
           IF      WRKDEL              =    'Y'
             MOVE  ZEROS               TO   IND
             MOVE  SPACES              TO   SCR
             SET   INDON          (97) TO   TRUE
             MOVE  MSG37               TO   MMSG
           ELSE
             SET   INDON          (97) TO   TRUE
             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
           MOVE    NEWFUND             TO   MFUND
           MOVE    NEWSCHL             TO   MSCHL.
       100-EDIT-KEY.
           IF      NEWFUND             =    SPACES                  OR
                   NEWSCHL             =    SPACES
             SET   INDON          (97) TO   TRUE
             MOVE  MSG31               TO   MMSG
             GO                        TO   100-EXIT.
           IF      NEWFUND             NOT  =  '1'                  AND
050409*            NEWFUND             NOT  =  '4'
050409             NEWFUND             NOT  =  '4'                  AND
050409             NEWFUND             NOT  =  '5'                  AND
050409             NEWFUND             NOT  =  '6'                  AND
020411             NEWFUND             NOT  =  '8'                  AND
020411             NEWFUND             NOT  =  '9'                  AND
050409             NEWFUND             NOT  =  '7'
             MOVE  'Y'                 TO   WRKERR
             SET   INDON          (16) TO   TRUE.
           MOVE    LNKDIST             TO   SCLKEY
           MOVE    LNKFY               TO   SCLFY
           MOVE    'SCL'               TO   SCLPREF
           MOVE    NEWSCHL             TO   SCLSCL
           MOVE    SCLKEY              TO   CRFDK
           READ    CRF-DISK
           MOVE    CRFD                TO   CRF            SCL
           IF     (RETCRF              NOT  =   '00')               OR
                  (CRFFDATE            NOT  =   SPACES           AND
                   CRFFDATE            >    LNKSDATE)               OR
                  (CRFTDATE            NOT  =   SPACES           AND
                   CRFTDATE            <    LNKSDATE)               OR
                  (SCLCHRTR            NOT  =   'Y')
             MOVE  'Y'                 TO   WRKERR
             SET   INDON          (17) TO   TRUE.

           IF      WRKERR              =    'Y'
             MOVE  MSG17               TO   MMSG
             GO                        TO   100-EXIT.
       100-READ.
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    '99998'             TO   CDFTABLE
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '4000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           IF      RETCDF              =    '00'
             MOVE  CDFD                TO   CDF
             MOVE  CDFAMT1             TO   NBRZ5
             MOVE  NBRZ5               TO   M46100
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   M46200
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   M46300
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   M46400.

           MOVE    '4001'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           IF      RETCDF              =    '00'
             MOVE  CDFD                TO   CDF
             MOVE  CDFAMT1             TO   NBRZ5
             MOVE  NBRZ5               TO   M47100
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   M47200
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   M47300
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   M47400.

           MOVE    '4002'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           IF      RETCDF              =    '00'
             MOVE  CDFD                TO   CDF
             MOVE  CDFAMT1             TO   NBRZ5
             MOVE  NBRZ5               TO   M47500
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   M47600
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   M47700
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   M47800.

           MOVE    '4003'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           IF      RETCDF              =    '00'
             MOVE  CDFD                TO   CDF
             MOVE  CDFAMT1             TO   NBRZ5
             MOVE  NBRZ5               TO   M47900
             MOVE  CDFAMT2             TO   NBRZ5
041306*      MOVE  NBRZ5               TO   M48100.
041306       MOVE  NBRZ5               TO   M48100
041306       MOVE  CDFAMT3             TO   NBRZ5
041306       MOVE  NBRZ5               TO   M48200
041306       MOVE  CDFAMT4             TO   NBRZ5
041306       MOVE  NBRZ5               TO   M46500.

           SET     SCR1                TO   +1
           MOVE    NEWKEY              TO   OLDKEY
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    '99998'             TO   CDFTABLE
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '5000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   WRKLOW
           MOVE    '9999'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   WRKHIGH
           MOVE    WRKLOW              TO   CDFDK
           MOVE    'Y'                 TO   WRKFIRST
           PERFORM 110-FORWARD         THRU 110-EXIT.
       100-EXIT.
           EXIT.

       110-FORWARD.
           START   CDF-DISK            KEY  >    CDFDK.
       110-READ-LOOP.
           READ    CDF-DISK     NEXT   WITH NO LOCK
           IF      RETCDF              =    '00'                    AND
                   CDFDK               <    WRKHIGH
             MOVE  CDFD                TO   CDF
             MOVE  CDF                 TO   WRKPF8
             PERFORM 130-SELECT        THRU 130-EXIT
             IF    WRKKEY              =    NEWKEY
               SET   IND1              TO   SCR1
               SET   IND1              UP   BY  +89
               SET   INDON      (IND1) TO   TRUE
               MOVE  CDFPGM            TO   RPGM          (SCR1)
               MOVE  CDFAMT1           TO   RSAL          (SCR1)
               MOVE  CDFAMT2           TO   RBEN          (SCR1)
               MOVE  CDFAMT3           TO   RPURSRV       (SCR1)
               MOVE  CDFAMT4           TO   RMTRL         (SCR1)
               MOVE  CDFAMT5           TO   ROTHR         (SCR1)
               MOVE  CDFAMT6           TO   RCAP          (SCR1)
               MOVE  CDFAMT7           TO   RSIND         (SCR1)
               IF    SCR1              =    +1
                 MOVE  CDFKEY          TO   WRKPF7
               END-IF
               SET   SCR1              UP   BY  +1
             END-IF
             IF    SCR1                <    +08
               GO                      TO   110-READ-LOOP.
           SET     INDON          (97) TO   TRUE
           IF      LNKFAYZ      (2 04) =    'U'                     AND
                   SCR1                =    +1
             MOVE  MSG14               TO   MMSG
             SET   INDOFF         (97) TO   TRUE
             SET   INDON          (98) TO   TRUE
           ELSE
             IF      SCR1              =    +08
               MOVE  MSG28             TO   MMSG
             ELSE
               MOVE  MSG14             TO   MMSG.
       110-EXIT.
           EXIT.

       120-BACKWARD.
           START   CDF-DISK            KEY  >=   CDFDK.
       120-READ-LOOP.
           READ    CDF-DISK     PRIOR  WITH NO LOCK
           IF      RETCDF              =    '00'                    AND
                   CDFDK               >    WRKLOW
             MOVE  CDFD                TO   CDF
             MOVE  CDF                 TO   WRKPF7
             PERFORM 130-SELECT        THRU 130-EXIT
             IF    WRKKEY              =    NEWKEY
               SET   IND1              TO   SCR2
               SET   IND1              UP   BY  +89
               SET   INDON      (IND1) TO   TRUE
               MOVE  CDFPGM            TO   RPGM          (SCR2)
               MOVE  CDFAMT1           TO   RSAL          (SCR2)
               MOVE  CDFAMT2           TO   RBEN          (SCR2)
               MOVE  CDFAMT3           TO   RPURSRV       (SCR2)
               MOVE  CDFAMT4           TO   RMTRL         (SCR2)
               MOVE  CDFAMT5           TO   ROTHR         (SCR2)
               MOVE  CDFAMT6           TO   RCAP          (SCR2)
               MOVE  CDFAMT7           TO   RSIND         (SCR2)
               IF    SCR2              =    +07
                 MOVE  CDFKEY          TO   WRKPF8
               END-IF
               SET   SCR2              DOWN  BY  +1
             END-IF
             IF    SCR2                >    +0
               GO                      TO   120-READ-LOOP.
           IF      SCR2                =    +0
             MOVE  MSG28               TO   MMSG
           ELSE
             MOVE  MSG13               TO   MMSG.
           SET     INDON          (97) TO   TRUE.
       120-EXIT.
           EXIT.

       130-SELECT.
           MOVE    CDFFUND             TO   WRKFUND
           MOVE    CDFSCHL             TO   WRKSCHL.
       130-EXIT.
           EXIT.

      *****************************************************************
       300-UPDATE.
           IF      LNKFAYZ      (2 04) NOT  =   'U'
             PERFORM 100-DISPLAY       THRU 100-EXIT
             MOVE    MSG32             TO   MMSG
             GO                        TO   300-EXIT.
           MOVE    ZEROS               TO   IND              WRKROW
           MOVE    'N'                 TO   WRKERR

           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    '99998'             TO   CDFTABLE
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '4000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           MOVE    'N'                 TO   WRKERR2
           IF      RETCDF              NOT  =   '00'
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD
           ELSE
             MOVE  CDFD                TO   CDF.
       300-MOVE1.
           MOVE    M46100              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M46100
           MOVE    M46200              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   M46200
           MOVE    M46300              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   M46300
           MOVE    M46400              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   M46400.
       300-EDIT1.
           IF      CDFAMT1             <    ZERO
             SET   INDON          (18) TO   TRUE.
           IF      CDFAMT2             <    ZERO
             SET   INDON          (19) TO   TRUE.
           IF      CDFAMT3             <    ZERO
             SET   INDON          (20) TO   TRUE.
           IF      CDFAMT4             <    ZERO
             SET   INDON          (21) TO   TRUE.

           IF     (WRKERR2             =    'N')                AND
                  (CDF                 NOT  =  CDFD)
             MOVE  CDF                 TO   CDFD
             IF      RETCDF            NOT  =   '00'
               MOVE  'U'               TO   WRKERR2
               WRITE CDFD
             ELSE
               MOVE  'U'               TO   WRKERR2
               REWRITE CDFD.
           IF      WRKERR2             =    'Y'
             MOVE  WRKERR2             TO   WRKERR
           ELSE
             IF   (WRKERR2             =    'U')                AND
                  (WRKERR              =    'N')
               MOVE  WRKERR2           TO   WRKERR.

           MOVE    '4001'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           MOVE    'N'                 TO   WRKERR2
           IF      RETCDF              NOT  =   '00'
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD
           ELSE
             MOVE  CDFD                TO   CDF.
       300-MOVE2.
           MOVE    M47100              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M47100
           MOVE    M47200              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   M47200
           MOVE    M47300              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   M47300
           MOVE    M47400              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   M47400.
       300-EDIT2.
           IF      CDFAMT1             <    ZERO
             SET   INDON          (22) TO   TRUE.
           IF      CDFAMT2             <    ZERO
             SET   INDON          (23) TO   TRUE.
           IF      CDFAMT3             <    ZERO
             SET   INDON          (24) TO   TRUE.
           IF      CDFAMT4             <    ZERO
             SET   INDON          (25) TO   TRUE.

           IF     (WRKERR2             =    'N')                AND
                  (CDF                 NOT  =  CDFD)
             MOVE  CDF                 TO   CDFD
             IF      RETCDF            NOT  =   '00'
               MOVE  'U'               TO   WRKERR2
               WRITE CDFD
             ELSE
               MOVE  'U'               TO   WRKERR2
               REWRITE CDFD.
           IF      WRKERR2             =    'Y'
             MOVE  WRKERR2             TO   WRKERR
           ELSE
             IF   (WRKERR2             =    'U')                AND
                  (WRKERR              =    'N')
               MOVE  WRKERR2           TO   WRKERR.

           MOVE    '4002'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           MOVE    'N'                 TO   WRKERR2
           IF      RETCDF              NOT  =   '00'
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD
           ELSE
             MOVE  CDFD                TO   CDF.
       300-MOVE3.
           MOVE    M47500              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M47500
           MOVE    M47600              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   M47600
           MOVE    M47700              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   M47700
           MOVE    M47800              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   M47800.
       300-EDIT3.
           IF      CDFAMT1             <    ZERO
             SET   INDON          (26) TO   TRUE.
           IF      CDFAMT2             <    ZERO
             SET   INDON          (27) TO   TRUE.
           IF      CDFAMT3             <    ZERO
             SET   INDON          (28) TO   TRUE.
           IF      CDFAMT4             <    ZERO
             SET   INDON          (29) TO   TRUE.

           IF     (WRKERR2             =    'N')                AND
                  (CDF                 NOT  =  CDFD)
             MOVE  CDF                 TO   CDFD
             IF      RETCDF            NOT  =   '00'
               MOVE  'U'               TO   WRKERR2
               WRITE CDFD
             ELSE
               MOVE  'U'               TO   WRKERR2
               REWRITE CDFD.
           IF      WRKERR2             =    'Y'
             MOVE  WRKERR2             TO   WRKERR
           ELSE
             IF   (WRKERR2             =    'U')                AND
                  (WRKERR              =    'N')
               MOVE  WRKERR2           TO   WRKERR.

           MOVE    '4003'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           MOVE    'N'                 TO   WRKERR2
           IF      RETCDF              NOT  =   '00'
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD
           ELSE
             MOVE  CDFD                TO   CDF.
       300-MOVE4.
           MOVE    M47900              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M47900
           MOVE    M48100              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
041306*    MOVE    NBRZ5               TO   M48100.
041306     MOVE    NBRZ5               TO   M48100
041306     MOVE    M48200              TO   NBRIN
041306     PERFORM 600-CONVERT         THRU 600-EXIT
041306     IF      NBRSIGN             =    '-'
041306       COMPUTE  NBR90            =    0 - NBR90.
041306     MOVE    NBR90               TO   CDFAMT3    NBRZ5
041306     MOVE    NBRZ5               TO   M48200
041306     MOVE    M46500              TO   NBRIN
041306     PERFORM 600-CONVERT         THRU 600-EXIT
041306     IF      NBRSIGN             =    '-'
041306       COMPUTE  NBR90            =    0 - NBR90.
041306     MOVE    NBR90               TO   CDFAMT4    NBRZ5
041306     MOVE    NBRZ5               TO   M46500.
       300-EDIT4.
           IF      CDFAMT1             <    ZERO
             SET   INDON          (30) TO   TRUE.
           IF      CDFAMT2             <    ZERO
             SET   INDON          (31) TO   TRUE.
041306     IF      CDFAMT3             <    ZERO
041306       SET   INDON          (32) TO   TRUE.
041306     IF      CDFAMT4             <    ZERO
041306       SET   INDON          (33) TO   TRUE.

           IF     (WRKERR2             =    'N')                AND
                  (CDF                 NOT  =  CDFD)
             MOVE  CDF                 TO   CDFD
             IF      RETCDF            NOT  =   '00'
               MOVE  'U'               TO   WRKERR2
               WRITE CDFD
             ELSE
               MOVE  'U'               TO   WRKERR2
               REWRITE CDFD.
           IF      WRKERR2             =    'Y'
             MOVE  WRKERR2             TO   WRKERR
           ELSE
             IF   (WRKERR2             =    'U')                AND
                  (WRKERR              =    'N')
               MOVE  WRKERR2           TO   WRKERR.

           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    '99998'             TO   CDFTABLE
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '5'                 TO   CDFCNBR
           PERFORM 310-LINE            THRU 310-EXIT
             VARYING SCR3              FROM +1 BY +1
               UNTIL                   SCR3 >  +07

           IF        WRKERR            =    'Y'
             MOVE    MSG21             TO   MMSG
           ELSE
             SET     INDON       (97)  TO   TRUE
             IF      WRKERR            =    'U'
               MOVE  MSG24             TO   MMSG
             ELSE
               MOVE  MSG22             TO   MMSG.
       300-EXIT.
           EXIT.

       310-LINE.
           ADD     +1                  TO   WRKROW
           IF      RLINE        (SCR3) =    SPACES
             GO                        TO   310-EXIT.
           MOVE    'N'                 TO   WRKERR2
           MOVE    RPGM         (SCR3) TO   CDFPGM
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            NO   LOCK
           IF      RETCDF              =    '00'
             MOVE  CDFD                TO   CDF
             SET   IND1                TO   SCR3
             SET   IND1                UP   BY  +89
             SET   INDON        (IND1) TO   TRUE
           ELSE
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD.
       310-MOVE.
           MOVE    RSAL         (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1
                                            RSAL            (SCR3)
           MOVE    RBEN         (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2
                                            RBEN            (SCR3)
           MOVE    RPURSRV      (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3
                                            RPURSRV         (SCR3)
           MOVE    RMTRL        (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4
                                            RMTRL           (SCR3)
           MOVE    ROTHR        (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT5
                                            ROTHR           (SCR3)
           MOVE    RCAP         (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT6
                                            RCAP            (SCR3)
           MOVE    RSIND        (SCR3) TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT7
                                            RSIND           (SCR3).
       310-EDIT-ACTION.
           IF      RETCDF              NOT  =  '00'
             MOVE  'A'                 TO   WRKACT
           ELSE
             IF    CDFAMT1             NOT  =  ZERO               OR
                   CDFAMT2             NOT  =  ZERO               OR
                   CDFAMT3             NOT  =  ZERO               OR
                   CDFAMT4             NOT  =  ZERO               OR
                   CDFAMT5             NOT  =  ZERO               OR
                   CDFAMT6             NOT  =  ZERO               OR
                   CDFAMT7             NOT  =  ZERO
               MOVE  'C'               TO   WRKACT
             ELSE
               MOVE  'D'               TO   WRKACT
               GO                      TO   310-WRITE.
       310-EDIT-RECORD.
           MOVE    LNKDIST             TO   FPGKEY
           MOVE    LNKFY               TO   FPGFY
           MOVE    'FPG'               TO   FPGPREF
           MOVE    CDFPGM              TO   FPGFPG
           MOVE    FPGKEY              TO   CRFDK
           READ    CRF-DISK
           MOVE    CRFD                TO   CRF
           IF     (RETCRF              NOT  =   '00')               OR
                  (CRFFDATE            NOT  =   SPACES           AND
                   CRFFDATE            >    LNKSDATE)               OR
                  (CRFTDATE            NOT  =   SPACES           AND
                   CRFTDATE            <    LNKSDATE)
             MOVE     'Y'              TO   WRKERR2
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 32
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 34
             SET   INDON      (WRKIDX) TO   TRUE.

           IF      CDFAMT1             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 33
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 35
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT2             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 34
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 36
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT3             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 35
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 37
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT4             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 36
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 38
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT5             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 37
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 39
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT6             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 38
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 40
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT7             <    ZERO
041306*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 39
041306       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 8) + 41
             SET   INDON      (WRKIDX) TO   TRUE.
       310-WRITE.
           IF      WRKACT              =    'D'
             MOVE  'U'                 TO   WRKERR2
             MOVE  SPACES              TO   RLINE           (SCR3)
             SET   IND1                TO   SCR3
             SET   IND1                UP   BY  89
             SET   INDOFF       (IND1) TO   TRUE
             DELETE CDF-DISK
           ELSE
             IF      WRKERR2           =    'N'
               IF    CDF               NOT  =   CDFD
                 MOVE  'U'             TO   WRKERR2
                 MOVE  CDF             TO   CDFD
                 IF    RETCDF          =    '00'
                   REWRITE CDFD
                 ELSE
                   SET    IND1         TO   SCR3
                   SET    IND1         UP   BY  89
                   SET    INDON (IND1) TO   TRUE
                   WRITE  CDFD.
           IF      WRKERR2             =    'Y'
             MOVE  WRKERR2             TO   WRKERR
           ELSE
             IF      WRKERR2           =    'U'                     AND
                     WRKERR            =    'N'
               MOVE  WRKERR2           TO   WRKERR.
       310-EXIT.
           EXIT.

      *****************************************************************
       490-HOUSEKEEPING.
           OPEN    I-O                      SCR-DISPLAY
                                            CDF-DISK
                   INPUT                    CRF-DISK
           IF      RETSCR              NOT  =   '00' AND '41'        OR
                   RETCRF              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
             WHEN '0'
               MOVE    LNKDBFUND       TO   NEWFUND
               MOVE    LNKDBSCHL       TO   NEWSCHL
               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.
           MOVE    NEWFUND             TO   LNKDBFUND
           MOVE    NEWSCHL             TO   LNKDBSCHL.
       990-EXIT.
           EXIT.

