       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW45.
       AUTHOR.          DOE.
      *****************************************************************
      *                       B04. FORM 6
      *****************************************************************
      * DATE CREATED:  06/21/95
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE
      * FIX9908 - 041299 - ADD CHARTER SCHOOL FIELD
      * 2009001 - 050409 - EDIT VALID FUND AND ADDED ADDITIONAL
      *                    FOR AARA MONEY (STIMULUS DOLLARS)
      *****************************************************************

       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-MPEW45
                                       ORGANIZATION TRANSACTION
                                       CONTROL-AREA SCRCTL
                                       FILE STATUS  RETSCR.

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

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

       FD            SCR-DISPLAY.
       01            SCR.
           COPY      DDS-EW45-O        OF   MPEW45.

           COPY      EWCDFD            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        RETALL            PIC  X(02).

           COPY      EWCDF             OF   CPYSRC.
           COPY      EWTBL             OF   CPYSRC.

       01            NEWKEY.
           05        NEWFUND           PIC  X(01).

       01            OLD.
           05        OLDKEY            PIC  X(01).

       01            WRK.
           05        WRKERR            PIC  X(01).
           05        WRKDEL            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   'EW45'
                   INDICATORS          ARE  IND
           READ    SCR-DISPLAY              RECORD
                   INDICATORS          ARE  IND
           MOVE    ZEROS               TO   LINNBR
                                            POSNBR

           MOVE    MFUND               TO   NEWFUND
           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    EWFUNC1P            OF   CPYSRC.
           IF      INDON                    (CF03)                  AND
                   LNKXFPNL            =    'B04'
             MOVE  'B04'               TO   LNKTOPNL.
       010-EXIT.
           EXIT.

       020-BACKWARD.
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    LOW-VALUES          TO   CDFTABLE CDFSCHL CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           START   CDF-DISK            KEY  >   CDFDK.
           READ    CDF-DISK  PRIOR     WITH NO LOCK
           MOVE    CDFD                TO   CDF
           IF      RETCDF              =    '00'
             MOVE  CDFFUND             TO   NEWFUND
             PERFORM 100-DISPLAY       THRU 100-EXIT
           ELSE
             MOVE  MSG13               TO   MMSG.
       020-EXIT.
           EXIT.


       030-FORWARD.
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    HIGH-VALUES         TO   CDFTABLE CDFSCHL CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           START   CDF-DISK            KEY  >   CDFDK.
           READ    CDF-DISK  NEXT      WITH NO LOCK
           MOVE    CDFD                TO   CDF
           IF     (RETCDF              =    '00')
             MOVE  CDFFUND             TO   NEWFUND
             PERFORM 100-DISPLAY       THRU 100-EXIT
           ELSE
             MOVE  MSG14               TO   MMSG.
       030-EXIT.
           EXIT.

       040-DELETE.
           MOVE    SPACES              TO   WRKDEL
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    '99999'             TO   CDFTABLE
           MOVE    '0000'              TO   CDFSCHL
           MOVE    '8000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           MOVE    CDFD                TO   CDF
           IF     (RETCDF              =    '00')                   AND
                  (CDFDIST             =    LNKDIST)                AND
                  (CDFFY               =    LNKFY)                  AND
                  (CDFFUND             =    NEWFUND)                AND
                  (CDFTABLE            =    '99999')                AND
                  (CDFSCHL             =    '0000')                 AND
                  (CDFCONTROL          =    '8000')
             DELETE  CDF-DISK
             MOVE    'Y'               TO   WRKDEL.
           IF      WRKDEL              =    'Y'
             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
           MOVE    NEWFUND             TO   MFUND.
       100-EDIT-KEY.
           IF      NEWFUND             =    SPACES
             SET   INDON          (97) TO   TRUE
             MOVE  MSG31               TO   MMSG
             GO                        TO   100-EXIT.
050409     IF      NEWFUND             NOT  =  '1'                  AND
050409             NEWFUND             NOT  =  '4'                  AND
050409             NEWFUND             NOT  =  '5'                  AND
050409             NEWFUND             NOT  =  '6'                  AND
050409             NEWFUND             NOT  =  '7'
050409       MOVE  'Y'                 TO   WRKERR
050409       SET   INDON          (16) TO   TRUE.
           IF      WRKERR              =    'Y'
             MOVE  MSG17               TO   MMSG
             GO                        TO   100-EXIT.
       100-READ.
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    '99999'             TO   CDFTABLE
           MOVE    '0000'              TO   CDFSCHL
           MOVE    '8000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           IF      LNKFAYZ      (2 04) =    'U'
             MOVE  NEWKEY              TO   OLDKEY.
           IF      RETCDF              NOT  =   '00'
             IF    LNKFAYZ      (2 04) =    '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  CDFD                TO   CDF
             MOVE  CDFCONTROL          TO   MCTRL
             MOVE  CDFAMT1             TO   NBRZ5
             MOVE  NBRZ5               TO   MRECR
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   MOTHR
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   MCAP
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   MCOMSRV
             MOVE  CDFAMT5             TO   NBRZ5
             MOVE  NBRZ5               TO   MDEBT
             MOVE  CDFAMT6             TO   NBRZ5
             MOVE  NBRZ5               TO   MFEDIND
041299       MOVE  CDFAMT7             TO   NBRZ5
041299       MOVE  NBRZ5               TO   MCHRTR
             MOVE  CDFTOTAL            TO   NBRZ7
             MOVE  NBRZ7               TO   MTOT
             IF      LNKFAYZ    (2 04) =    'I'
               MOVE  MSG36             TO   MMSG.

       100-EXIT.
           EXIT.

      *****************************************************************
       300-UPDATE.

           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    '99999'             TO   CDFTABLE
           MOVE    '0000'              TO   CDFSCHL
           MOVE    '8000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           MOVE    'N'                 TO   WRKERR
           MOVE    ZEROS               TO   IND
           IF      RETCDF              NOT  =   '00'
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD
           ELSE
             MOVE  CDFD                TO   CDF.
       300-MOVE.
           MOVE    MCTRL               TO   CDFCONTROL
           MOVE    MRECR               TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   MRECR
           MOVE    MOTHR               TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   MOTHR
           MOVE    MCAP                TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   MCAP
           MOVE    MCOMSRV             TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   MCOMSRV
           MOVE    MDEBT               TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT5    NBRZ5
           MOVE    NBRZ5               TO   MDEBT
           MOVE    MFEDIND             TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT6    NBRZ5
           MOVE    NBRZ5               TO   MFEDIND.
041299     MOVE    MCHRTR              TO   NBRIN
041299     PERFORM 600-CONVERT         THRU 600-EXIT
041299     IF      NBRSIGN             =    '-'
041299       COMPUTE  NBR90            =    0 - NBR90.
041299     MOVE    NBR90               TO   CDFAMT7    NBRZ5
041299     MOVE    NBRZ5               TO   MCHRTR.
           MOVE    MTOT                TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR11            =    0 - NBR11.
           MOVE    NBR11               TO   CDFTOTAL   NBRZ7
           MOVE    NBRZ7               TO   MTOT.
       300-EDIT.
           IF      CDFAMT1             <    ZERO
             SET   INDON          (17) TO   TRUE.
           IF      CDFAMT2             <    ZERO
             SET   INDON          (18) TO   TRUE.
           IF      CDFAMT3             <    ZERO
             SET   INDON          (19) TO   TRUE.
           IF      CDFAMT4             <    ZERO
             SET   INDON          (20) TO   TRUE.
           IF      CDFAMT5             <    ZERO
             SET   INDON          (21) TO   TRUE.
           IF      CDFAMT6             <    ZERO
             SET   INDON          (22) TO   TRUE.
041299     IF      CDFAMT7             <    ZERO
041299       SET   INDON          (24) TO   TRUE.
           IF      CDFTOTAL            <    ZERO
             SET   INDON          (23) TO   TRUE.
           IF      CDFCONTROL          NOT  =  '8000'
             MOVE  '8000'              TO   CDFCONTROL  MCTRL.

           IF      WRKERR              NOT  =   'N'
             MOVE    MSG21             TO   MMSG
           ELSE
             SET     INDON        (97) TO   TRUE
             IF      CDF               =    CDFD
               MOVE    MSG22           TO   MMSG
             ELSE
               MOVE  CDF               TO   CDFD
               IF      RETCDF          NOT  =   '00'
                 MOVE  MSG23           TO   MMSG
                 WRITE CDFD
               ELSE
                 MOVE  MSG24           TO   MMSG
                 REWRITE CDFD.
       300-EXIT.
           EXIT.

      *****************************************************************
       490-HOUSEKEEPING.
           OPEN    I-O                      SCR-DISPLAY
                                            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
             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.
           MOVE    NEWFUND             TO   LNKDBFUND.
       990-EXIT.
           EXIT.

