       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      EW44.
       AUTHOR.          DOE.
      *****************************************************************
      *                        B03. FORM 5                            *
      *****************************************************************
      * DATE CREATED:  06/16/95                                       *
      *****************************************************************
      * CALL #  - MMDDYY - PURPOSE                                    *
      * 2003001 - 041803 - MODIFY EDIT ON PURCHASED SERVICES,         *
      *                    MATERIALS & SUPPLIES, AND CAPITAL OUTLAY TO*
      *                    LOOK AT STAFF UNITS RATHER THAN FTE.       *
      * 2006001 - 041206 - ADD FUNCTIONS 6500 & 8200.
      *****************************************************************

       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-MPEW44
                                       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    SPT-DISK          ASSIGN       DATABASE-EWSPTI
                                       ORGANIZATION INDEXED
                                       ACCESS       DYNAMIC
                                       RECORD KEY   SPTDK
                                       FILE STATUS  RETSPT.

           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-EW44-O        OF   MPEW44.
           05        R44   REDEFINES        EW44-O.
041206*      10      FILLER            PIC  X(190).
041206       10      FILLER            PIC  X(210).
             10      RLINES.
               15    RLINE OCCURS 007  TIMES INDEXED BY SCR1 SCR2 SCR3.
                 20  RPGM              PIC  X(03).
                 20  RSAL              PIC  ZZZZZZZZZ-.
                 20  RBEN              PIC  ZZZZZZZZZ-.
                 20  RPURSRV           PIC  ZZZZZZZZZ-.
                 20  RMTRL             PIC  ZZZZZZZZZ-.
                 20  ROTHR             PIC  ZZZZZZZZZ-.
                 20  RCAP              PIC  ZZZZZZZZZ-.

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

           COPY      EWCDF             OF   CPYSRC.
           COPY      EWSPT             OF   CPYSRC.
           COPY      EWTBL             OF   CPYSRC.
           COPY      EWSCL             OF   CPYSRC.
           COPY      EWCRF             OF   CPYSRC.

       01            NEWKEY.
           05        NEWTABLE.
             10      NEWTABLE9         PIC  9(05).
           05        NEWFUND           PIC  X(01).
           05        NEWSCHL           PIC  X(04).
       01            NEWBYTES   REDEFINES   NEWKEY.
           05        NEWBYTE    OCCURS 010  TIMES INDEXED BY NEW1
                                       PIC  X(01).

       01            OLDKEY            PIC  X(10).
       01            OLDSAL            PIC S9(09)       COMP-3.
       01            OLDBEN            PIC S9(09)       COMP-3.
       01            OLDPURSRV         PIC S9(09)       COMP-3.
       01            OLDMTRL           PIC S9(09)       COMP-3.
       01            OLDOTHR           PIC S9(09)       COMP-3.
       01            OLDCAP            PIC S9(09)       COMP-3.

       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(441).
           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      WRKTABLE          PIC  X(05).
             10      WRKFUND           PIC  X(01).
             10      WRKSCHL           PIC  X(04).
           05        WRKBYTES   REDEFINES   WRKKEY.
             10      WRKBYTE    OCCURS 010  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).

       01            EDTTBL.
           05        EDTSAL            PIC S9(11).
           05        EDTBEN            PIC S9(11).
           05        EDTPURSRV         PIC S9(11).
           05        EDTMTRL           PIC S9(11).
           05        EDTOTHR           PIC S9(11).
           05        EDTCAP            PIC S9(11).
           05        EDT1000PCT        PIC  X(01).
           05        EDTSTAFF          PIC  X(01).
           05        EDTSPACE          PIC  X(01).
           05        EDTFTE            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
                                                 SPT-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   'EW44'
                   INDICATORS          ARE  IND
           READ    SCR-DISPLAY              RECORD
                   INDICATORS          ARE  IND
           SET     INDOFF         (15) TO   TRUE
           MOVE    ZEROS               TO   LINNBR
                                            POSNBR
           MOVE    MTABLE              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           MOVE    NBR50               TO   NEWTABLE9
           MOVE    NEWTABLE            TO   MTABLE
           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            >    +11                     AND
                   LNKXFROW            <    +21
               COMPUTE LNKXFLOC9       =    LNKXFCOL + 399
             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 + 399.
           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) + 85
             IF    INDON                    (WRKIDX)
               MOVE  SPACES            TO   LNKXFPROM.
           IF        LNKXFPROM         >    SPACES                  AND
                     LNKXFPNL5         >    SPACES
             EVALUATE  LNKXFPNL5
               WHEN   'SCHL '
                 MOVE  LNKXFPROM       TO   MSCHL
               WHEN   'TABLE'
                 MOVE  LNKXFPROM       TO   MTABLE
               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    NEWTABLE            TO   CDFTABLE
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '5999'              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            =    NEWTABLE)               AND
                  (CDFSCHL             =    NEWSCHL)                AND
                  (CDFCNBR             =    '6'                  OR
                   CDFCNBR             =    '7')
             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
           INITIALIZE                       EDTTBL
           MOVE    LOW-VALUES          TO   OLDKEY
           IF      NEWTABLE            IS   NUMERIC                 AND
                   NEWTABLE            NOT  =  '00000'
             MOVE  NEWTABLE            TO   MTABLE.
           MOVE    NEWFUND             TO   MFUND
           MOVE    NEWSCHL             TO   MSCHL.
       100-EDIT-KEY.
           IF      NEWTABLE            =    SPACES                  OR
                   NEWTABLE            =    '00000'                 OR
                   NEWSCHL             =    SPACES
             SET   INDON          (97) TO   TRUE
             MOVE  MSG31               TO   MMSG
             GO                        TO   100-EXIT.
           MOVE    LNKDIST             TO   TBLKEY
           MOVE    LNKFY               TO   TBLFY
           MOVE    'TBL'               TO   TBLPREF
           MOVE    NEWTABLE            TO   TBLTBL
           MOVE    TBLKEY              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  SPACES              TO   TBLDATA
             MOVE  'Y'                 TO   WRKERR
             SET   INDON          (16) TO   TRUE
           ELSE
             MOVE  CRFD                TO   TBL.
           IF      NEWFUND             =    SPACES
             MOVE  TBLFTYPE            TO   NEWFUND   MFUND.
           IF      NEWFUND             NOT  =  TBLFTYPE
             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
           IF     (RETCRF              NOT  =   '00')               OR
                  (CRFFDATE            NOT  =   SPACES           AND
                   CRFFDATE            >    LNKSDATE)               OR
                  (CRFTDATE            NOT  =   SPACES           AND
                   CRFTDATE            <    LNKSDATE)
             MOVE  'Y'                 TO   WRKERR
             SET   INDON          (17) TO   TRUE.
           MOVE    LNKDIST             TO   SPT
           MOVE    LNKFY               TO   SPTFY
           MOVE    NEWFUND             TO   SPTFUND
           MOVE    NEWTABLE            TO   SPTTABLE
           MOVE    NEWSCHL             TO   SPTSCHL
           MOVE    LOW-VALUES          TO   SPTPGM
           MOVE    SPTKEY              TO   SPTDK
           START   SPT-DISK            KEY  >   SPTDK
           READ    SPT-DISK  NEXT
           MOVE    SPTD                TO   SPT
           IF     (RETSPT              NOT  =  '00')              OR
                  (SPTDIST             NOT  =  LNKDIST)           OR
                  (SPTFY               NOT  =  LNKFY)             OR
                  (SPTFUND             NOT  =  NEWFUND)           OR
                  (SPTTABLE            NOT  =  NEWTABLE)          OR
                  (SPTSCHL             NOT  =  NEWSCHL)
             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    NEWTABLE            TO   CDFTABLE
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '6000'              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   M66100
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   M66200
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   M66300
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   M66400.

           MOVE    '6001'              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   M67300
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   M67400
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   M67600
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   M67700.

           MOVE    '6002'              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   M67800
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   M67900
             MOVE  CDFAMT3             TO   NBRZ5
041206*      MOVE  NBRZ5               TO   M68100.
041206       MOVE  NBRZ5               TO   M68100
041206       MOVE  CDFAMT4             TO   NBRZ5
041206       MOVE  NBRZ5               TO   M68200.


041206     MOVE    '6003'              TO   CDFCONTROL
041206     MOVE    CDFKEY              TO   CDFDK
041206     READ    CDF-DISK            WITH NO LOCK
041206     IF      RETCDF              =    '00'
041206       MOVE  CDFD                TO   CDF
041206       MOVE  CDFAMT1             TO   NBRZ5
041206       MOVE  NBRZ5               TO   M66500.

           MOVE    '7000'              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   MSAL
             MOVE  CDFPCT              TO   MPCT
             MOVE  CDFAMT2             TO   NBRZ5
             MOVE  NBRZ5               TO   MBEN
             MOVE  CDFAMT3             TO   NBRZ5
             MOVE  NBRZ5               TO   MPURSRV
             MOVE  CDFAMT4             TO   NBRZ5
             MOVE  NBRZ5               TO   MMTRL
             MOVE  CDFAMT5             TO   NBRZ5
             MOVE  NBRZ5               TO   MOTHR
             MOVE  CDFAMT6             TO   NBRZ5
             MOVE  NBRZ5               TO   MCAP.

           SET     SCR1                TO   +1
           MOVE    NEWKEY              TO   OLDKEY
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWTABLE            TO   CDFTABLE
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '7000'              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
           PERFORM 105-BUILD-EDT       THRU 105-EXIT.
       100-EXIT.
           EXIT.

       105-BUILD-EDT.
      ***************************************************************
      ***  THIS PROCEDURE WILL SCAN THE SPT FILE AND DETERMINE    ***
      ***  IF IT CONTAINS STAFF, SPACE, AND FTE FOR THE CURRENT   ***
      ***  FUND/TABLE/SCHOOL. IT WILL SCAN THE CDF 7XXX RECORDS   ***
      ***  AND TOTAL THE DIRECT COSTS FOR THIS SCHOOL. AND READ   ***
      ***  THE CONTROL 1000 RECORD FOR THIS TABLE.                ***
      ***************************************************************
           MOVE    SPACES              TO   WRKFIRST
           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWTABLE            TO   CDFTABLE
           MOVE    '0000'              TO   CDFSCHL
           MOVE    '1000'              TO   CDFCONTROL
           MOVE    CDFKEY              TO   CDFDK
           READ    CDF-DISK            WITH NO LOCK
           IF      RETCDF              NOT  =   '00'
             MOVE  SPACES              TO   EDT1000PCT
           ELSE
             MOVE  CDFD                TO   CDF
             MOVE  CDFPCT              TO   EDT1000PCT.

           MOVE    LNKDIST             TO   SPT
           MOVE    LNKFY               TO   SPTFY
           MOVE    NEWFUND             TO   SPTFUND
           MOVE    NEWTABLE            TO   SPTTABLE
           MOVE    NEWSCHL             TO   SPTSCHL
           MOVE    LOW-VALUES          TO   SPTPGM
           MOVE    SPTKEY              TO   SPTDK
           START   SPT-DISK            KEY  >   SPTDK.
       105-LOOP.
           READ    SPT-DISK  NEXT
           MOVE    SPTD                TO   SPT
           IF     (RETSPT              =  '00')                   AND
                  (SPTDIST             =  LNKDIST)                AND
                  (SPTFY               =  LNKFY)                  AND
                  (SPTFUND             =  NEWFUND)                AND
                  (SPTTABLE            =  NEWTABLE)               AND
                  (SPTSCHL             =  NEWSCHL)                AND
                  (EDTSTAFF            =  SPACES               OR
                   EDTSPACE            =  SPACES               OR
                   EDTFTE              =  SPACES)
             IF      SPTPGMSTF         >    ZERO
               MOVE  'Y'               TO  EDTSTAFF
             END-IF
             IF      SPTPGMSPC         >    ZERO
               MOVE  'Y'               TO  EDTSPACE
             END-IF
             IF      SPTPGMFTE         >    ZERO
               MOVE  'Y'               TO  EDTFTE
             END-IF
             GO                        TO  105-LOOP.

           IF      WRKPF8              <    WRKLOW
             GO                        TO   105-EXIT.
           MOVE    WRKPF8              TO   CDFDK
           START   CDF-DISK            KEY  >    CDFDK.
       105-READ-LOOP.
           READ    CDF-DISK    NEXT    WITH NO LOCK
           IF      RETCDF              =    '00'                    AND
                   CDFDK               <    WRKHIGH
             MOVE  CDFD                TO   CDF
             PERFORM 130-SELECT        THRU 130-EXIT
             IF    WRKKEY              =    NEWKEY
               ADD CDFAMT1             TO   EDTSAL
               ADD CDFAMT2             TO   EDTBEN
               ADD CDFAMT3             TO   EDTPURSRV
               ADD CDFAMT4             TO   EDTMTRL
               ADD CDFAMT5             TO   EDTOTHR
               ADD CDFAMT6             TO   EDTCAP
             END-IF
             GO                        TO   105-READ-LOOP.
       105-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
041206*        SET   IND1              UP   BY  +84
041206         SET   IND1              UP   BY  +86
               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)
               IF    WRKFIRST          =    'Y'
                 ADD   CDFAMT1         TO   EDTSAL
                 ADD   CDFAMT2         TO   EDTBEN
                 ADD   CDFAMT3         TO   EDTPURSRV
                 ADD   CDFAMT4         TO   EDTMTRL
                 ADD   CDFAMT5         TO   EDTOTHR
                 ADD   CDFAMT6         TO   EDTCAP
               END-IF
               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
041206*        SET   IND1              UP   BY  +84
041206         SET   IND1              UP   BY  +86
               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)
               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    CDFTABLE            TO   WRKTABLE
           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    NEWTABLE            TO   CDFTABLE
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '6000'              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    M66100              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M66100
           MOVE    M66200              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   M66200
           MOVE    M66300              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   M66300
           MOVE    M66400              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   M66400.
       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    '6001'              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    M67300              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M67300
           MOVE    M67400              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   M67400
           MOVE    M67600              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   M67600
           MOVE    M67700              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   M67700.
       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    '6002'              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    M67800              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   M67800
           MOVE    M67900              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   M67900
           MOVE    M68100              TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   M68100.
041206     MOVE    M68200              TO   NBRIN
041206     PERFORM 600-CONVERT         THRU 600-EXIT
041206     IF      NBRSIGN             =    '-'
041206       COMPUTE  NBR90            =    0 - NBR90.
041206     MOVE    NBR90               TO   CDFAMT4    NBRZ5
041206     MOVE    NBRZ5               TO   M68200.
       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.
041206     IF      CDFAMT4             <    ZERO
041206       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.

041206     MOVE    '6003'              TO   CDFCONTROL
041206     MOVE    CDFKEY              TO   CDFDK
041206     READ    CDF-DISK            WITH NO LOCK
041206     MOVE    'N'                 TO   WRKERR2
041206     IF      RETCDF              NOT  =   '00'
041206       INITIALIZE                     CDFDATA
041206       MOVE  CDF                 TO   CDFD
041206     ELSE
041206       MOVE  CDFD                TO   CDF.
041206 300-MOVE3A.
041206     MOVE    M66500              TO   NBRIN
041206     PERFORM 600-CONVERT         THRU 600-EXIT.
041206     IF      NBRSIGN             =    '-'
041206       COMPUTE  NBR90            =    0 - NBR90.
041206     MOVE    NBR90               TO   CDFAMT1    NBRZ5.
041206     MOVE  NBRZ5                 TO   M66500.
041206 300-EDIT3A.
041206     IF      CDFAMT1             <    ZERO
041206       SET   INDON          (30) TO   TRUE.

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

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

           MOVE    LNKDIST             TO   CDFKEY
           MOVE    LNKFY               TO   CDFFY
           MOVE    NEWFUND             TO   CDFFUND
           MOVE    NEWTABLE            TO   CDFTABLE
           MOVE    NEWSCHL             TO   CDFSCHL
           MOVE    '7000'              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    MSAL                TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT1    NBRZ5
           MOVE    NBRZ5               TO   MSAL
           MOVE    MPCT                TO   CDFPCT
           MOVE    MBEN                TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT2    NBRZ5
           MOVE    NBRZ5               TO   MBEN
           MOVE    MPURSRV             TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT3    NBRZ5
           MOVE    NBRZ5               TO   MPURSRV
           MOVE    MMTRL               TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT4    NBRZ5
           MOVE    NBRZ5               TO   MMTRL
           MOVE    MOTHR               TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT5    NBRZ5
           MOVE    NBRZ5               TO   MOTHR
           MOVE    MCAP                TO   NBRIN
           PERFORM 600-CONVERT         THRU 600-EXIT
           IF      NBRSIGN             =    '-'
             COMPUTE  NBR90            =    0 - NBR90.
           MOVE    NBR90               TO   CDFAMT6    NBRZ5
           MOVE    NBRZ5               TO   MCAP.
       300-EDIT4.
           IF      CDFAMT1             <    ZERO
041206*      SET   INDON          (29) TO   TRUE.
041206       SET   INDON          (31) TO   TRUE.
           IF     (EDTSAL              >    CDFAMT1)              OR
                  (CDFAMT1             NOT  =  ZERO            AND
                   EDTSTAFF            NOT  =  'Y')
041206*      SET   INDON          (29) TO   TRUE
041206       SET   INDON          (31) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.
           IF    ((CDFPCT              NOT  =  'P')            AND
                  (CDFPCT              NOT  =  SPACES))           OR
                 ((CDFPCT              =    'P')               AND
                  (EDT1000PCT          =    SPACES))
041206*      SET   INDON          (30) TO   TRUE
041206       SET   INDON          (32) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.
           IF     (CDFAMT2             <    ZERO)                   OR
                  (EDT1000PCT          =    SPACES              AND
                   CDFPCT              =    SPACES              AND
                   CDFAMT2             =    ZEROS)
041206*      SET   INDON          (31) TO   TRUE.
041206       SET   INDON          (33) TO   TRUE.
           IF     (EDTBEN              >    CDFAMT2)              OR
                  (CDFPCT              =    'P'                AND
                   CDFAMT2             =    ZEROS)                OR
                  (CDFAMT2             NOT  =  ZERO            AND
                   EDTSTAFF            NOT  =  'Y')
041206*      SET   INDON          (31) TO   TRUE
041206       SET   INDON          (33) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.
           IF      CDFAMT3             <    ZERO
041206*      SET   INDON          (32) TO   TRUE.
041206       SET   INDON          (34) TO   TRUE.
           IF     (EDTPURSRV           >    CDFAMT3)              OR
                  (CDFAMT3             NOT  =  ZERO            AND
041803             EDTSTAFF            NOT  =  'Y')
041803*            EDTFTE              NOT  =  'Y')
041206*      SET   INDON          (32) TO   TRUE
041206       SET   INDON          (34) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.
           IF      CDFAMT4             <    ZERO
041206*      SET   INDON          (33) TO   TRUE.
041206       SET   INDON          (35) TO   TRUE.
           IF     (EDTMTRL             >    CDFAMT4)              OR
                  (CDFAMT4             NOT  =  ZERO            AND
041803             EDTSTAFF            NOT  =  'Y')
041803*            EDTFTE              NOT  =  'Y')
041206*      SET   INDON          (33) TO   TRUE
041206       SET   INDON          (35) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.
           IF      CDFAMT5             <    ZERO
041206*      SET   INDON          (34) TO   TRUE.
041206       SET   INDON          (36) TO   TRUE.
           IF     (EDTOTHR             >    CDFAMT5)              OR
                  (CDFAMT5             NOT  =  ZERO            AND
                   EDTSTAFF            NOT  =  'Y')
041206*      SET   INDON          (34) TO   TRUE
041206       SET   INDON          (36) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.
           IF      CDFAMT6             <    ZERO
041206*      SET   INDON          (35) TO   TRUE.
041206       SET   INDON          (37) TO   TRUE.
           IF     (EDTCAP              >    CDFAMT6)              OR
                  (CDFAMT6             NOT  =  ZERO            AND
041803             EDTSTAFF            NOT  =  'Y')
041803*            EDTFTE              NOT  =  'Y')
041206*      SET   INDON          (35) TO   TRUE
041206       SET   INDON          (37) TO   TRUE
             MOVE  'Y'                 TO   WRKERR2.

           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.

           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
041206*      SET   IND1                UP   BY  +84
041206       SET   IND1                UP   BY  +86
             SET   INDON        (IND1) TO   TRUE
           ELSE
             INITIALIZE                     CDFDATA
             MOVE  CDF                 TO   CDFD.
           MOVE    CDFAMT1             TO   OLDSAL
           MOVE    CDFAMT2             TO   OLDBEN
           MOVE    CDFAMT3             TO   OLDPURSRV
           MOVE    CDFAMT4             TO   OLDMTRL
           MOVE    CDFAMT5             TO   OLDOTHR
           MOVE    CDFAMT6             TO   OLDCAP.
       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).
       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
               MOVE  'C'               TO   WRKACT
             ELSE
               MOVE  'D'               TO   WRKACT
               GO                      TO   310-WRITE.
       310-EDIT-RECORD.
           MOVE    LNKDIST             TO   SPT
           MOVE    LNKFY               TO   SPTFY
           MOVE    CDFFUND             TO   SPTFUND
           MOVE    CDFTABLE            TO   SPTTABLE
           MOVE    CDFSCHL             TO   SPTSCHL
           MOVE    CDFPGM              TO   SPTPGM
           MOVE    SPTKEY              TO   SPTDK
           READ    SPT-DISK
           IF      RETSPT              NOT  =  '00'
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 36
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 38
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT1             <    ZERO
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 37
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 39
             SET   INDON      (WRKIDX) TO   TRUE.
           IF     (CDFAMT1             NOT  =  ZERO)               AND
                  (EDTSTAFF            NOT  =  'Y')
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 37
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 39
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT2             <    ZERO
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 38
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 40
             SET   INDON      (WRKIDX) TO   TRUE.
           IF     (CDFAMT2             NOT  =  ZERO)               AND
                  (EDTSTAFF            NOT  =  'Y')
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 38
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 40
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT3             <    ZERO
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 39
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 41
             SET   INDON      (WRKIDX) TO   TRUE.
           IF     (CDFAMT3             NOT  =  ZERO)               AND
041803            (EDTSTAFF            NOT  =  'Y')
041803*           (EDTFTE              NOT  =  'Y')
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 39
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 41
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT4             <    ZERO
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 40
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 42
             SET   INDON      (WRKIDX) TO   TRUE.
           IF     (CDFAMT4             NOT  =  ZERO)               AND
041803            (EDTSTAFF            NOT  =  'Y')
041803*           (EDTFTE              NOT  =  'Y')
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 40
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 42
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT5             <    ZERO
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 41
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 43
             SET   INDON      (WRKIDX) TO   TRUE.
           IF     (CDFAMT5             NOT  =  ZERO)               AND
                  (EDTSTAFF            NOT  =  'Y')
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 41
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 43
             SET   INDON      (WRKIDX) TO   TRUE.
           IF      CDFAMT6             <    ZERO
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 42
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 44
             SET   INDON      (WRKIDX) TO   TRUE.
           IF     (CDFAMT6             NOT  =  ZERO)               AND
041803            (EDTSTAFF            NOT  =  'Y')
041803*           (EDTFTE              NOT  =  'Y')
             MOVE     'Y'              TO   WRKERR2
041206*      COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 42
041206       COMPUTE  WRKIDX           =    ((WRKROW - 1) * 7) + 44
             SET   INDON      (WRKIDX) TO   TRUE.
       310-WRITE.
           IF      (WRKACT             =    'D')                   OR
                   (WRKERR2            =    'N')
             COMPUTE  EDTSAL           =    EDTSAL  - OLDSAL  + CDFAMT1
             COMPUTE  EDTBEN           =    EDTBEN  - OLDBEN  + CDFAMT2
             COMPUTE  EDTPURSRV        =    EDTPURSRV - OLDPURSRV +
                                                                CDFAMT3
             COMPUTE  EDTMTRL          =    EDTMTRL - OLDMTRL + CDFAMT4
             COMPUTE  EDTOTHR          =    EDTOTHR - OLDOTHR + CDFAMT5
             COMPUTE  EDTCAP           =    EDTCAP  - OLDCAP + CDFAMT6.
           IF      WRKACT              =    'D'
             MOVE  'U'                 TO   WRKERR2
             MOVE  SPACES              TO   RLINE           (SCR3)
             SET   IND1                TO   SCR3
041206*      SET   IND1                UP   BY  84
041206       SET   IND1                UP   BY  86
             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
041206*            SET    IND1         UP   BY  84
041206             SET    IND1         UP   BY  86
                   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                    SPT-DISK
                                            CRF-DISK
           IF      RETSCR              NOT  =   '00' AND '41'        OR
                   RETCRF              NOT  =   '00' AND '41'        OR
                   RETCDF              NOT  =   '00' AND '41'        OR
                   RETSPT              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    LNKDBTABLE      TO   NEWTABLE
               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    NEWTABLE            TO   LNKDBTABLE
           MOVE    NEWFUND             TO   LNKDBFUND
           MOVE    NEWSCHL             TO   LNKDBSCHL.
       990-EXIT.
           EXIT.

