       IDENTIFICATION DIVISION.                                         00001000
       PROGRAM-ID.    EW50.                                             00002000
       AUTHOR.        DOE.                                              00003000
      ******************************************************************00004000
      *                           FORM QUERY                           *00005000
      * COMPILE WITH SUBCOB CICS                                       *00005000
      ******************************************************************00006000
      * DATE CREATED:  06/17/95                                        *00007000
      ******************************************************************00008000
      * CALL #  - MMDDYY - PURPOSE                                     *00009000
      * FIX9904 - 041599 - ADD PROCESSING FOR FORM 7 SELECTION         *00010000
      * 2009001 - 051009 - ALLOW FUNDS 5,6,7 FOR AARA MONEY            *00010000
      * 2011001 - 020411 - ADD ARRA FUNDS 8 & 9                        *00010000
      ******************************************************************00011000
                                                                        00012000
       ENVIRONMENT DIVISION.                                            00013000
       CONFIGURATION SECTION.                                           00014000
       DATA DIVISION.                                                   00015000
                                                                        00016000
       WORKING-STORAGE SECTION.                                         00017000
                                                                        00018000
       01            WSC.                                               00019000
           05        WSCMAPLEN         PIC S9(04) COMP SYNC VALUE +391. 00020000
           05        WSCMAXRD          PIC S9(04) COMP SYNC VALUE +300. 00021000
           05        WSCRDCNT          PIC S9(04) COMP SYNC VALUE +0.   00022000
           05        WSCLNCNT          PIC S9(02) COMP SYNC.            00023000
           05        WSCLNINC          PIC S9(02) COMP SYNC.            00024000
           05        WSCLNMAX          PIC S9(02) COMP SYNC.            00025000
           05        WSCKEY.                                            00026000
             10      WSCTABLE          PIC  X(05).                      00027000
             10      WSCFUND           PIC  X(01).                      00028000
             10      WSCSCHL           PIC  X(04).                      00029000
                                                                        00030000
       01            HGH.                                               00031000
           05        HGHKEY.                                            00032000
             10      HGHDIST           PIC  X(02).                      00033000
             10      HGHFY             PIC  X(02).                      00034000
             10      HGHFUND           PIC  X(01).                      00035000
             10      HGHTABLE          PIC  X(05).                      00036000
             10      HGHSCHL           PIC  X(04).                      00037000
             10      HGHCONTROL        PIC  X(04).                      00038000
       01            HGHR       REDEFINES   HGH.                        00039000
           05        HGHB       OCCURS 018  TIMES  INDEXED BY HGH1      00040000
                                       PIC  X(01).                      00041000
                                                                        00042000
       01            WSK.                                               00043000
           05        NEWKEY.                                            00044000
             10      NEWFUND           PIC  X(01).                      00045000
             10      NEWTABLE          PIC  X(05).                      00046000
             10      NEWSCHL           PIC  X(04).                      00047000
             10      NEWCONTROL        PIC  X(04).                      00048000
           05        NEWPANEL.                                          00049000
             10      NEWPANEL1         PIC  X(01).                      00050000
             10      NEWPANEL2         PIC  X(02).                      00051000
           05        OLDKEY            PIC  X(17).                      00052000
       01            NEWR       REDEFINES   WSK.                        00053000
           05        NEWB       OCCURS 014  TIMES  INDEXED BY NEW1      00054000
                                       PIC  X(01).                      00055000
       01            WRK.                                               00056000
           05        WRKKEY.                                            00057000
             10      WRKFUND           PIC  X(01).                      00058000
             10      WRKTABLE          PIC  X(05).                      00059000
             10      WRKSCHL           PIC  X(04).                      00060000
             10      WRKCONTROL        PIC  X(04).                      00061000
       01            WRKR       REDEFINES   WRK.                        00062000
               15    WRKB       OCCURS  14  TIMES  INDEXED BY WRK1      00063000
                                       PIC  X(01).                      00064000
                                                                        00065000
       01            RET.                                               00066000
           05        RETQWR            PIC  X(02).                      00067000
           05        RETCDF            PIC  X(02).                      00068000
           05        RETERR            PIC  X(02).                      00069000
                                                                        00070000
       01            MSG.                                               00071000
           05        MSG01             PIC  X(35) VALUE                 00072000
                     'District is not authorized.  EXIT.'.              00073000
           05        MSG03             PIC  X(37) VALUE                 00074000
                     'Highlighted elements in error. Retry.'.           00075000
           05        MSG13             PIC  X(28) VALUE                 00076000
                     'No previous records.  Next ?'.                    00077000
           05        MSG14             PIC  X(30) VALUE                 00078000
                     'No additional records.  Next ?'.                  00079000
           05        MSG18             PIC  X(40) VALUE                 00080000
                     'Please type key element(s).  Then ENTER.'.        00081000
           05        MSG25             PIC  X(22) VALUE                 00082000
                     'Page full.  Continue ?'.                          00083000
           05        MSG26             PIC  X(25) VALUE                 00084000
                     'No records found.  Next ?'.                       00085000
           05        MSG27             PIC  X(29) VALUE                 00086000
                     'Record limit met.  Continue ?'.                   00087000
           05        MSG28             PIC  X(35) VALUE                 00088000
                     'No record on line selected.  Next ?'.             00089000
           05        MSG90             PIC  X(35) VALUE                 00090000
                     'Not authorized for panel requested.'.             00091000
           05        MSG91             PIC  X(32) VALUE                 00092000
                     'Not authorized at this terminal.'.                00093000
           05        MSG92             PIC  X(35) VALUE                 00094000
                     'Panel unknown/not installed. Retry.'.             00095000
           05        MSG93             PIC  X(39) VALUE                 00096000
                     'Panel temporarily disabled.  Try later.'.         00097000
           05        MSG94             PIC  X(41) VALUE                 00098000
                     'Unknown system error. Request assistance.'.       00099000
           05        MSG95             PIC  X(35) VALUE                 00100000
                     'Database error. Request assistance.'.             00101000
           05        MSG96             PIC  X(42) VALUE                 00102000
                     'Program error(INVREQ). Request assistance.'.
      *00103000
           05        MSG97             PIC  X(30) VALUE                 00104000
                     'Database closed.  Retry later.'.                  00105000
                                                                        00106000
           COPY                             EWQWRC.                     00107000
           COPY                             EWCDFC.                     00108000
           COPY                             EWQWR.                      00109000
           05        QWRMAPR     REDEFINES  QWRMAP.                     00110000
             10      FILLER            PIC  X(0044).                    00111000
             10      QWRLINES          PIC  X(1501).                    00112000
                                                                        00113000
           COPY                             EWQWRI.                     00114000
                                                                        00115000
           COPY                             EWCDF.                      00116000
                                                                        00117000
           COPY                             EWWCM.                      00118000
                                                                        00119000
           COPY                             DFHAID.                     00120000
                                                                        00121000
           COPY                             EWWAB.                      00122000
                                                                        00123000
           COPY                             MPEW50.                     00124000
       01            MPEW50R     REDEFINES  MPEW50I.                    00125000
           05        MAPBYTE        OCCURS  391   TIMES INDEXED BY MAP1.00126000
             10      FILLER            PIC  X(01).                      00127000
       01            MPEW50L     REDEFINES  MPEW50I.                    00128000
           05        FILLER            PIC  X(44).                      00129000
           05        MPSLINES.                                          00130000
             10      MPSLINE        OCCURS  014   TIMES INDEXED BY MPS2.00131000
               15    MPSLINEL          PIC S9(04)      COMP.            00132000
               15    MPSLINEA          PIC  X(01).                      00133000
               15    MPSDATA.                                           00134000
                 20  MPSFUND           PIC  X(03).                      00135000
                 20  MPSTABLE          PIC  X(06).                      00136000
                 20  MPSSCHL           PIC  X(05).                      00137000
                 20  MPSCONTROL.                                        00138000
                   25  MPSCNBR         PIC  X(01).                      00139000
                   25  MPSPGM          PIC  X(03).                      00140000
           05        FILLER            PIC  X(53).                      00141000
                                                                        00142000
       LINKAGE SECTION.                                                 00143000
                                                                        00144000
       01  DFHCOMMAREA                 PIC  X(220).                     00145000
                                                                        00146000
       PROCEDURE DIVISION.                                              00147000
      ******************************************************************00148000
                                                                        00149000
       000-CONTROL.                                                     00150000
           MOVE    SPACES              TO   WSK           WCM           00151000
           MOVE    LOW-VALUES          TO   MPEW50O                     00152000
           MOVE    '99'                TO   RETQWR                      00153000
           EXEC    CICS HANDLE CONDITION    MAPFAIL  (100-DISPLAY)      00154000
                   ERROR   (901-ERROR)      NOSPACE  (902-NOSPACE)      00155000
                   INVREQ  (903-INVREQ)     NOTOPEN  (904-NOTOPEN)      00156000
                   DSIDERR (905-DSIDERR)    END-EXEC                    00157000
                                                                        00158000
           MOVE    EIBTRMID            TO   QWRTRMID                    00159000
           MOVE    'EW50'              TO   QWRPGM                      00160000
           EXEC    CICS HANDLE CONDITION    NOTFND  (005-NEW)  END-EXEC 00161000
           EXEC    CICS READ                DATASET (QWRFIL)            00162000
                                            INTO    (QWR)               00163000
                                            RIDFLD  (QWRKEY)            00164000
                                            LENGTH  (QWRLENR)  END-EXEC 00165000
           MOVE    '00'                TO   RETQWR.                     00166000
       005-NEW.                                                         00167000
           IF      RETQWR              NOT  =   '00'                    00168000
             MOVE  QWRKEY              TO   QWRIKEY                     00169000
             MOVE  QWRI                TO   QWR                         00170000
             MOVE  DFHCOMMAREA         TO   WCM                         00171000
             MOVE  ZEROS               TO   WCMXFCRS9     WCMXFPOS9     00172000
             MOVE  HIGH-VALUES         TO   OLDKEY                      00173000
           ELSE                                                         00174000
             MOVE  QWRWCM              TO   WCM                         00175000
             MOVE  QWROLD              TO   OLDKEY.                     00176000
                                                                        00177000
           MOVE    WCMSODISTA          TO   CDFFILDS                    00178000
           MOVE    QWROLD              TO   NEWKEY                      00179000
                                                                        00180000
           IF      EIBCALEN            >    ZEROS                       00181000
             GO                        TO   850-CALLED.                 00182000
           IF      EIBAID              NOT  =   DFHENTER                00183000
             GO                        TO   800-XCTL.                   00184000
                                                                        00185000
           PERFORM 010-RECEIVE         THRU 010-EXIT                    00186000
           IF      EIBCPOSN            >    +559                        00187000
             GO                        TO   825-DETAIL.                 00188000
           IF      NEWPANEL            NOT  =   SPACES                  00189000
             MOVE  NEWPANEL            TO   WCMXFTPNL                   00190000
             GO                        TO   805-XCTL.                   00191000
           IF      NEWKEY              NOT  =   OLDKEY                  00192000
             GO                        TO   100-DISPLAY.                00193000
           MOVE    -1                  TO   MFUNDL                      00194000
           MOVE    QWRMAP              TO   MPEW50I                     00195000
           MOVE    +10                 TO   EIBCALEN                    00196000
           GO                          TO   015-SEND.                   00197000
                                                                        00198000
      ******************************************************************00199000
       010-RECEIVE.                                                     00200000
           EXEC    CICS RECEIVE             MAP    ('MPEW50')  END-EXEC 00201000
           MOVE    EIBCPOSN            TO   WCMXFCRS9                   00202000
           SET     MAP1  QWR1          TO   +1.                         00203000
       010-LOOP1.                                                       00204000
           IF     (MAPBYTE      (MAP1) NOT  =   LOW-VALUES)          AND00205000
                  (MAPBYTE      (MAP1) NOT  =   HIGH-VALUES)            00206000
             MOVE  MAPBYTE      (MAP1) TO   QWRBYTE      (QWR1).        00207000
           IF      MAP1                <    WSCMAPLEN                   00208000
             SET   MAP1  QWR1          UP   BY  +1                      00209000
             GO                        TO   010-LOOP1.                  00210000
           MOVE    QWRMAP              TO   MPEW50O                     00211000
                                                                        00212000
           MOVE    SPACES              TO   NEWKEY                      00213000
           IF      MPANELA             =    WABEOF                      00214000
             MOVE  WABUM               TO   MPANELA                     00215000
             MOVE  ALL '_'             TO   MPANELO       NEWPANEL      00216000
           ELSE                                                         00217000
             IF      MPANELL           >    ZEROS                       00218000
               MOVE  MPANELI           TO   NEWPANEL                    00219000
               MOVE  WABUM             TO   MPANELA                     00220000
             ELSE                                                       00221000
               IF      MPANELI         >    LOW-VALUES                  00222000
                 MOVE  MPANELI         TO   NEWPANEL.                   00223000
           IF      MFUNDA              =    WABEOF                      00224000
             MOVE  WABUM               TO   MFUNDA                      00225000
             MOVE  ALL '_'             TO   MFUNDO                      00226000
           ELSE                                                         00227000
             IF      MFUNDL            >    ZEROS                       00228000
               MOVE  ZEROS             TO   MFUNDL                      00229000
               MOVE  MFUNDI            TO   NEWFUND                     00230000
               MOVE  WABUM             TO   MFUNDA                      00231000
             ELSE                                                       00232000
               IF      MFUNDI          >    LOW-VALUES                  00233000
                 MOVE  WABUM           TO   MFUNDA                      00234000
                 MOVE  MFUNDI          TO   NEWFUND.                    00235000
           IF      MTABLEA             =    WABEOF                      00236000
             MOVE  WABUM               TO   MTABLEA                     00237000
             MOVE  ALL '_'             TO   MTABLEO                     00238000
           ELSE                                                         00239000
             IF      MTABLEL           >    ZEROS                       00240000
               MOVE  ZEROS             TO   MTABLEL                     00241000
               MOVE  MTABLEI           TO   NEWTABLE                    00242000
               MOVE  WABUM             TO   MTABLEA                     00243000
             ELSE                                                       00244000
               IF      MTABLEI         >    LOW-VALUES                  00245000
                 MOVE  WABUM           TO   MTABLEA                     00246000
                 MOVE  MTABLEI         TO   NEWTABLE.                   00247000
           IF      MSCHLA              =    WABEOF                      00248000
             MOVE  WABUM               TO   MSCHLA                      00249000
             MOVE  ALL '_'             TO   MSCHLO                      00250000
           ELSE                                                         00251000
             IF      MSCHLL            >    ZEROS                       00252000
               MOVE  ZEROS             TO   MSCHLL                      00253000
               MOVE  MSCHLI            TO   NEWSCHL                     00254000
               MOVE  WABUM             TO   MSCHLA                      00255000
             ELSE                                                       00256000
               IF      MSCHLI          >    LOW-VALUES                  00257000
                 MOVE  WABUM           TO   MSCHLA                      00258000
                 MOVE  MSCHLI          TO   NEWSCHL.                    00259000
           IF      MCTRLA              =    WABEOF                      00260000
             MOVE  WABUM               TO   MCTRLA                      00261000
             MOVE  ALL '_'             TO   MCTRLO                      00262000
           ELSE                                                         00263000
             IF      MCTRLL            >    ZEROS                       00264000
               MOVE  ZEROS             TO   MCTRLL                      00265000
               MOVE  MCTRLI            TO   NEWCONTROL                  00266000
               MOVE  WABUM             TO   MCTRLA                      00267000
             ELSE                                                       00268000
               IF      MCTRLI          >    LOW-VALUES                  00269000
                 MOVE  WABUM           TO   MCTRLA                      00270000
                 MOVE  MCTRLI          TO   NEWCONTROL.                 00271000
                                                                        00272000
           SET     NEW1                TO   +1.                         00273000
       010-LOOP2.                                                       00274000
           IF      NEWB         (NEW1) =    '_'                         00275000
             MOVE  ' '                 TO   NEWB         (NEW1).        00276000
           IF      NEW1                <    +17                         00277000
             SET   NEW1                UP   BY  +1                      00278000
             GO                        TO   010-LOOP2.                  00279000
       010-EXIT.                                                        00280000
           EXIT.                                                        00281000
                                                                        00282000
      ******************************************************************00283000
       015-SEND.                                                        00284000
           MOVE    EIBTRMID            TO   QWRTRMID                    00285000
           MOVE    'EW50'              TO   QWRPGM                      00286000
           MOVE    OLDKEY              TO   QWROLD                      00287000
           MOVE    WCM                 TO   QWRWCM                      00288000
           MOVE    MPEW50O             TO   QWRMAP                      00289000
           EXEC    CICS HANDLE CONDITION    DUPREC  (015-ERR)  END-EXEC 00290000
           IF      RETQWR              NOT  =   '00'                    00291000
             EXEC  CICS WRITE               DATASET (QWRFIL)            00292000
                                            FROM    (QWR)               00293000
                                            RIDFLD  (QWRKEY)            00294000
                                            LENGTH  (QWRLENR)  END-EXEC 00295000
           ELSE                                                         00296000
             EXEC  CICS READ UPDATE         DATASET (QWRFIL)            00297000
                                            INTO    (QWRI)              00298000
                                            RIDFLD  (QWRKEY)            00299000
                                            LENGTH  (QWRLENR)  END-EXEC 00300000
             EXEC  CICS REWRITE             DATASET (QWRFIL)            00301000
                                            FROM    (QWR)               00302000
                                            LENGTH  (QWRLENR)  END-EXEC.00303000
       015-ERR.                                                         00304000
           IF      EIBCALEN            =    ZEROS                       00305000
             EXEC  CICS SEND                MAP     ('MPEW50') DATAONLY 00306000
                                            CURSOR             END-EXEC 00307000
           ELSE                                                         00308000
             IF      EIBCALEN          NOT  =   1234                    00309000
               EXEC  CICS SEND              MAP     ('MPEW50') ERASE    00310000
                                            CURSOR             END-EXEC 00311000
             ELSE                                                       00312000
               EXEC  CICS SEND              MAP     ('MPEW50') ERASE    00313000
                                            CURSOR  (EIBCPOSN) END-EXEC.00314000
           EXEC CICS RETURN                 TRANSID ('EW50')   END-EXEC.00315000
                                                                        00316000
      ******************************************************************00317000
       100-DISPLAY.                                                     00318000
           MOVE    HIGH-VALUES         TO   OLDKEY                      00319000
           MOVE    LOW-VALUES          TO   MPEW50O       QWRMAP        00320000
           MOVE    +10                 TO   EIBCALEN                    00321000
           MOVE    ZEROS               TO   RETERR                      00322000
           SET     NEW1                TO   +1.                         00323000
       100-LOOP1.                                                       00324000
           IF      NEWB         (NEW1) =    ' '                         00325000
             MOVE  '_'                 TO   NEWB         (NEW1).        00326000
           IF      NEW1                <    +17                         00327000
             SET   NEW1                UP   BY  +1                      00328000
             GO                        TO   100-LOOP1.                  00329000
           MOVE    NEWPANEL            TO   MPANELO                     00330000
           MOVE    NEWFUND             TO   MFUNDO                      00331000
           MOVE    NEWTABLE            TO   MTABLEO                     00332000
           MOVE    NEWSCHL             TO   MSCHLO                      00333000
           MOVE    NEWCONTROL          TO   MCTRLO                      00334000
           SET     NEW1                TO   +1.                         00335000
       100-LOOP2.                                                       00336000
           IF      NEWB         (NEW1) =    '_'                         00337000
             MOVE  ' '                 TO   NEWB         (NEW1).        00338000
           IF      NEW1                <    +17                         00339000
             SET   NEW1                UP   BY  +1                      00340000
             GO                        TO   100-LOOP2.                  00341000
                                                                        00342000
           IF     (NEWFUND             NOT  =   '1')                 AND00343000
                  (NEWFUND             NOT  =   '4')                 AND00344000
051009            (NEWFUND             NOT  =   '5')                 AND00344000
051009            (NEWFUND             NOT  =   '6')                 AND00344000
051009            (NEWFUND             NOT  =   '7')                 AND00344000
020411            (NEWFUND             NOT  =   '8')                 AND00344000
020411            (NEWFUND             NOT  =   '9')                 AND00344000
                  (NEWFUND             NOT  =   ' ')                    00345000
             MOVE  WABUMB              TO   MFUNDA                      00346000
             MOVE  -1                  TO   MFUNDL                      00347000
             MOVE  MSG03               TO   MMSGO                       00348000
             GO                        TO   015-SEND.                   00349000
                                                                        00350000
           MOVE    MSG26               TO   MMSGO                       00351000
           MOVE    -1                  TO   MFUNDL                      00352000
           MOVE    WCMSODIST           TO   CDFDIST                     00353000
           MOVE    WCMSOFY             TO   CDFFY                       00354000
           MOVE    NEWFUND             TO   CDFFUND                     00355000
           MOVE    NEWTABLE            TO   CDFTABLE                    00356000
           MOVE    NEWSCHL             TO   CDFSCHL                     00357000
           MOVE    NEWCONTROL          TO   CDFCONTROL                  00358000
           EXEC    CICS HANDLE CONDITION    NOTFND  (015-SEND) END-EXEC 00359000
           EXEC    CICS STARTBR             DATASET (CDFFIL)            00360000
                                            RIDFLD  (CDFKEY)   GTEQ     00361000
                                            KEYLENGTH (CDFLENK)         00362000
                                            END-EXEC                    00363000
           MOVE    SPACES              TO   QWRPF7        QWRPF8        00364000
           MOVE    SPACES              TO   QWRFRST                     00365000
           MOVE    +0                  TO   WSCLNCNT                    00366000
           MOVE    +1                  TO   WSCLNINC                    00367000
           MOVE    +15                 TO   WSCLNMAX                    00368000
           MOVE    NEWKEY              TO   OLDKEY.                     00369000
       105-OLD.                                                         00370000
           MOVE    LOW-VALUES          TO   MPSLINES                    00371000
           MOVE    WCMSODIST           TO   HGHDIST                     00372000
           MOVE    WCMSOFY             TO   HGHFY                       00373000
           MOVE    NEWFUND             TO   HGHFUND                     00374000
           MOVE    NEWTABLE            TO   HGHTABLE                    00375000
           MOVE    NEWSCHL             TO   HGHSCHL                     00376000
           MOVE    NEWCONTROL          TO   HGHCONTROL                  00377000
           SET     HGH1                TO   +1.                         00378000
       105-LOOP.                                                        00379000
           IF      HGHB         (HGH1) =    SPACES                      00380000
             MOVE  HIGH-VALUES         TO   HGHB         (HGH1).        00381000
           IF      HGH1                <    +18                         00382000
             SET   HGH1                UP   BY  +1                      00383000
             GO                        TO   105-LOOP.                   00384000
           MOVE    +0                  TO   WSCRDCNT                    00385000
           MOVE    WSCLNINC            TO   QWRLNINC                    00386000
           SET     MPS2                TO   WSCLNCNT                    00387000
           SET     MPS2                UP   BY   WSCLNINC               00388000
           EXEC    CICS HANDLE CONDITION    INVREQ  (115-MISS)          00389000
                                            NOTFND  (115-MISS)          00390000
                                            ENDFILE (115-MISS) END-EXEC.00391000
       110-LOOP.                                                        00392000
           IF      MPS2                =    WSCLNMAX                    00393000
             GO                        TO   125-FULL.                   00394000
           IF      WSCRDCNT            >    WSCMAXRD                    00395000
             GO                        TO   135-MAXRCD.                 00396000
           MOVE    '99'                TO   RETCDF                      00397000
           IF      WSCLNINC            =    -1                          00398000
             EXEC  CICS READPREV            DATASET (CDFFIL)            00399000
                                            INTO    (CDF)               00400000
                                            RIDFLD  (CDFKEY)            00401000
                                            LENGTH  (CDFLENR)  END-EXEC 00402000
           ELSE                                                         00403000
             EXEC  CICS READNEXT            DATASET (CDFFIL)            00404000
                                            INTO    (CDF)               00405000
                                            RIDFLD  (CDFKEY)            00406000
                                            LENGTH  (CDFLENR)  END-EXEC.00407000
           MOVE    '00'                TO   RETCDF.                     00408000
       115-MISS.                                                        00409000
           IF      RETCDF              NOT  =   '00'                    00410000
             GO                        TO   130-LAST.                   00411000
           ADD     +1                  TO   WSCRDCNT                    00412000
           IF     (WSCLNINC            =    +1)                     AND 00413000
                  (CDFKEY              >    HGH)                        00414000
             GO                        TO   130-LAST.                   00415000
           MOVE    CDFFUND             TO   WRKFUND                     00416000
           MOVE    CDFTABLE            TO   WRKTABLE                    00417000
           MOVE    CDFSCHL             TO   WRKSCHL                     00418000
           MOVE    CDFCONTROL          TO   WRKCONTROL                  00419000
           SET     NEW1  WRK1          TO   +1.                         00420000
       120-LOOP.                                                        00421000
           IF      NEWB         (NEW1) =    SPACES                      00422000
             MOVE  SPACES              TO   WRKB         (WRK1).        00423000
           IF      NEW1                <    +14                         00424000
             SET   NEW1  WRK1          UP   BY  +1                      00425000
             GO                        TO   120-LOOP.                   00426000
           IF     (WCMSODIST           NOT  =   CDFDIST)             OR 00427000
                  (WCMSOFY             NOT  =   CDFFY)               OR 00428000
                  (NEWKEY              NOT  =   WRKKEY)                 00429000
             GO                        TO   110-LOOP.                   00430000
                                                                        00431000
           MOVE    SPACES              TO   MPSDATA      (MPS2)         00432000
           MOVE    CDFFUND             TO   MPSFUND      (MPS2)         00433000
           MOVE    CDFTABLE            TO   MPSTABLE     (MPS2)         00434000
           MOVE    CDFSCHL             TO   MPSSCHL      (MPS2)         00435000
           MOVE    CDFCONTROL          TO   MPSCONTROL   (MPS2)         00436000
                                                                        00437000
           IF     (WSCLNINC            =    -1)                      AND00438000
                  (MPS2                =    +14)                        00439000
             MOVE  CDFKEY              TO   QWRPF8                      00440000
           ELSE                                                         00441000
             IF      MPS2              =    +1                          00442000
               MOVE  CDFKEY            TO   QWRPF7                      00443000
               IF      QWRFRST         =    SPACES                      00444000
                 MOVE  CDFKEY          TO   QWRFRST.                    00445000
           SET     MPS2                UP   BY  WSCLNINC                00446000
           ADD     WSCLNINC            TO   WSCLNCNT                    00447000
           GO                          TO   110-LOOP.                   00448000
                                                                        00449000
       125-FULL.                                                        00450000
           IF      WSCLNINC            =    +1                          00451000
             PERFORM 210-CDF-RDNXT     THRU 210-EXIT                    00452000
             IF     (CDFKEY            >    HGH)                     OR 00453000
                    (RETCDF            NOT  =   '00')                   00454000
               GO                      TO   130-LAST                    00455000
             ELSE                                                       00456000
               PERFORM 205-CDF-RDPRV   THRU 205-EXIT                    00457000
               PERFORM 205-CDF-RDPRV   THRU 205-EXIT.                   00458000
           MOVE    MSG25               TO   MMSGO                       00459000
           IF      WSCLNINC            =    +1                          00460000
             MOVE  +0                  TO   QWRLNXT                     00461000
             MOVE  +15                 TO   QWRLNMAX                    00462000
             MOVE  CDFKEY              TO   QWRPF8                      00463000
           ELSE                                                         00464000
             MOVE  +15                 TO   QWRLNXT                     00465000
             MOVE  +0                  TO   QWRLNMAX.                   00466000
           GO                          TO   140-END.                    00467000
                                                                        00468000
       130-LAST.                                                        00469000
           MOVE    +0                  TO   QWRLNMAX      QWRLNXT       00470000
           IF      QWRFRST             =    SPACES                      00471000
             MOVE  MSG26               TO   MMSGO                       00472000
           ELSE                                                         00473000
             IF      WSCLNINC          =    -1                          00474000
               MOVE  MSG13             TO   MMSGO                       00475000
               MOVE  SPACES            TO   QWRPF7                      00476000
             ELSE                                                       00477000
               MOVE  MSG14             TO   MMSGO                       00478000
               MOVE  SPACES            TO   QWRPF8.                     00479000
           GO                          TO   140-END.                    00480000
                                                                        00481000
       135-MAXRCD.                                                      00482000
           MOVE    WSCLNCNT            TO   QWRLNXT                     00483000
           MOVE    WSCLNMAX            TO   QWRLNMAX                    00484000
           IF      WSCLNINC            =    +1                          00485000
             MOVE  CDFKEY              TO   QWRPF8                      00486000
           ELSE                                                         00487000
             MOVE  CDFKEY              TO   QWRPF7.                     00488000
           MOVE    MSG27               TO   MMSGO                       00489000
           GO                          TO   140-END.                    00490000
                                                                        00491000
       140-END.                                                         00492000
           EXEC    CICS HANDLE CONDITION    INVREQ  (015-SEND) END-EXEC 00493000
           EXEC    CICS ENDBR               DATASET (CDFFIL)   END-EXEC 00494000
           GO                          TO   015-SEND.                   00495000
                                                                        00496000
      ******************************************************************00497000
       205-CDF-RDPRV.                                                   00498000
           MOVE    '99'                TO   RETCDF                      00499000
           EXEC    CICS HANDLE CONDITION    INVREQ  (205-EXIT)          00500000
                                            NOTFND  (205-EXIT)          00501000
                                            ENDFILE (205-EXIT) END-EXEC 00502000
           EXEC    CICS READPREV            DATASET (CDFFIL)            00503000
                                            INTO    (CDF)               00504000
                                            RIDFLD  (CDFKEY)            00505000
                                            LENGTH  (CDFLENR)  END-EXEC 00506000
           MOVE    '00'                TO   RETCDF.                     00507000
       205-EXIT.                                                        00508000
           EXIT.                                                        00509000
                                                                        00510000
      ******************************************************************00511000
       210-CDF-RDNXT.                                                   00512000
           MOVE    '99'                TO   RETCDF                      00513000
           EXEC    CICS HANDLE CONDITION    INVREQ  (210-EXIT)          00514000
                                            NOTFND  (210-EXIT)          00515000
                                            ENDFILE (210-EXIT) END-EXEC 00516000
           EXEC    CICS READNEXT            DATASET (CDFFIL)            00517000
                                            INTO    (CDF)               00518000
                                            RIDFLD  (CDFKEY)            00519000
                                            LENGTH  (CDFLENR)  END-EXEC 00520000
           MOVE    '00'                TO   RETCDF.                     00521000
       210-EXIT.                                                        00522000
           EXIT.                                                        00523000
                                                                        00524000
      ******************************************************************00525000
       800-XCTL.                                                        00526000
           IF     (EIBAID              =    DFHCLEAR)                OR 00527000
                  (EIBAID              =    DFHPA1)                  OR 00528000
                  (EIBAID              =    DFHPA2)                     00529000
             MOVE  QWRMAP              TO   MPEW50O                     00530000
             MOVE  -1                  TO   MPANELL                     00531000
             MOVE  +10                 TO   EIBCALEN                    00532000
             GO                        TO   015-SEND.                   00533000
           PERFORM 010-RECEIVE         THRU 010-EXIT                    00534000
           IF      EIBAID              =    DFHPF1                      00535000
             MOVE  WCMXFFR             TO   WCMXFHLD                    00536000
             MOVE  EIBCPOSN            TO   WCMXFCRS9     WCMXFPOS9     00537000
             MOVE  'CZ02'              TO   WCMXFTO                     00538000
             GO                        TO   805-XCTL.                   00539000
           IF      EIBAID              =    DFHPF4                      00540000
             MOVE  WCMXFFR             TO   WCMXFHLD                    00541000
             MOVE  EIBCPOSN            TO   WCMXFCRS9     WCMXFPOS9     00542000
             MOVE  'CZ03'              TO   WCMXFTO                     00543000
             GO                        TO   805-XCTL.                   00544000
           IF      EIBAID              =    DFHPF5                      00545000
             GO                        TO   100-DISPLAY.                00546000
           IF      EIBAID              =    DFHPF7                      00547000
             GO                        TO   815-PF7.                    00548000
           IF      EIBAID              =    DFHPF8                      00549000
             GO                        TO   820-PF8.                    00550000
                                                                        00551000
           MOVE    QWRWCM              TO   WCM                         00552000
           IF      EIBAID              =    DFHPF12                     00553000
             MOVE  SPACES              TO   WCMXFHLD                    00554000
             MOVE  'C   '              TO   WCMXFTO                     00555000
           ELSE                                                         00556000
             IF      EIBAID            =    DFHPF3                      00557000
               MOVE  SPACES            TO   WCMXFHLD                    00558000
               MOVE  'CB  '            TO   WCMXFTO                     00559000
             ELSE                                                       00560000
               MOVE  QWRMAP            TO   MPEW50O                     00561000
               MOVE  +10               TO   EIBCALEN                    00562000
               MOVE  -1                TO   MFUNDL                      00563000
               GO                      TO   015-SEND.                   00564000
                                                                        00565000
       805-XCTL.                                                        00566000
           MOVE    'C'                 TO   WCMXFTS                     00567000
           MOVE    WCM                 TO   QWRWCM                      00568000
           IF     (EIBCPOSN            >    +399)                    AND00569000
                  (EIBCPOSN            <    +1680)                      00570000
             COMPUTE WCMXFPOS9         =    EIBCPOSN -                  00571000
                                         (((EIBCPOSN / 80) - 5) * 80)   00572000
           ELSE                                                         00573000
             COMPUTE WCMXFPOS9         =    EIBCPOSN.                   00574000
           EXEC    CICS HANDLE CONDITION    DUPREC  (810-END)  END-EXEC 00575000
           IF      RETQWR              NOT  =   '00'                    00576000
             EXEC  CICS WRITE               DATASET (QWRFIL)            00577000
                                            FROM    (QWR)               00578000
                                            RIDFLD  (QWRKEY)            00579000
                                            LENGTH  (QWRLENR)  END-EXEC 00580000
           ELSE                                                         00581000
             EXEC  CICS READ UPDATE         DATASET (QWRFIL)            00582000
                                            INTO    (QWRI)              00583000
                                            RIDFLD  (QWRKEY)            00584000
                                            LENGTH  (QWRLENR)  END-EXEC 00585000
             EXEC  CICS REWRITE             DATASET (QWRFIL)            00586000
                                            FROM    (QWR)               00587000
                                            LENGTH  (QWRLENR)  END-EXEC.00588000
       810-END.                                                         00589000
           MOVE    'CB02'              TO   WCMXFFR                     00590000
           EXEC    CICS XCTL                PROGRAM ('EW02')            00591000
                                            COMMAREA(WCM)               00592000
                                            LENGTH  (220)      END-EXEC.00593000
                                                                        00594000
      ******************************************************************00595000
       815-PF7.                                                         00596000
           MOVE    QWRLNMAX            TO   WSCLNMAX                    00597000
           MOVE    QWRLNXT             TO   WSCLNCNT                    00598000
           IF     (QWRLNXT             >    +14)                     OR 00599000
                  (QWRLNINC            =    +1)                         00600000
             MOVE  LOW-VALUES          TO   QWRLINES                    00601000
             MOVE  +10                 TO   EIBCALEN.                   00602000
           MOVE    -1                  TO   WSCLNINC      MFUNDL        00603000
           MOVE    MSG13               TO   MMSGO                       00604000
           IF     (QWRPF7              =    SPACES)                  OR 00605000
                  (QWRPF7              NOT  >   QWRFRST)                00606000
             GO                        TO   015-SEND.                   00607000
           MOVE    QWRPF7              TO   CDFKEY                      00608000
           EXEC    CICS HANDLE CONDITION    NOTFND  (015-SEND)          00609000
                                            ENDFILE (015-SEND) END-EXEC 00610000
           EXEC    CICS STARTBR             DATASET (CDFFIL)            00611000
                                            RIDFLD  (CDFKEY)    GTEQ    00612000
                                            KEYLENGTH (CDFLENK)         00613000
                                            END-EXEC                    00614000
           EXEC    CICS READPREV            DATASET (CDFFIL)            00615000
                                            INTO    (CDF)               00616000
                                            RIDFLD  (CDFKEY)            00617000
                                            LENGTH  (CDFLENR)  END-EXEC 00618000
           IF      QWRLNINC            =    +1                          00619000
             MOVE  +15                 TO   WSCLNCNT                    00620000
             MOVE  ZEROS               TO   WSCLNMAX.                   00621000
           GO                          TO   105-OLD.                    00622000
                                                                        00623000
      ******************************************************************00624000
       820-PF8.                                                         00625000
           MOVE    QWRLNXT             TO   WSCLNCNT                    00626000
           MOVE    QWRLNMAX            TO   WSCLNMAX                    00627000
           IF     (QWRLNXT             =    ZEROS)                   OR 00628000
                  (QWRLNINC            =    -1)                         00629000
             MOVE  LOW-VALUES          TO   QWRLINES                    00630000
             MOVE  +10                 TO   EIBCALEN.                   00631000
           MOVE    +1                  TO   WSCLNINC                    00632000
           MOVE    -1                  TO   MFUNDL                      00633000
           MOVE    MSG14               TO   MMSGO                       00634000
           IF      QWRPF8              =    SPACES                      00635000
             GO                        TO   015-SEND.                   00636000
           MOVE    QWRPF8              TO   CDFKEY                      00637000
           EXEC    CICS HANDLE CONDITION    NOTFND  (015-SEND)          00638000
                                            ENDFILE (015-SEND) END-EXEC 00639000
           EXEC    CICS STARTBR             DATASET (CDFFIL)            00640000
                                            RIDFLD  (CDFKEY)    GTEQ    00641000
                                            KEYLENGTH (CDFLENK)         00642000
                                            END-EXEC                    00643000
           EXEC    CICS READNEXT            DATASET (CDFFIL)            00644000
                                            INTO    (CDF)               00645000
                                            RIDFLD  (CDFKEY)            00646000
                                            LENGTH  (CDFLENR)  END-EXEC 00647000
           IF      QWRLNINC            =    -1                          00648000
             MOVE  ZEROS               TO   WSCLNCNT                    00649000
             MOVE  +15                 TO   WSCLNMAX.                   00650000
           GO                          TO   105-OLD.                    00651000
                                                                        00652000
      ******************************************************************00653000
       825-DETAIL.                                                      00654000
           COMPUTE WSCLNCNT            =   (EIBCPOSN / 80) - 6          00655000
           SET     MPS2                TO   WSCLNCNT                    00656000
           IF     (MPSTABLE     (MPS2) NOT  >   LOW-VALUES)          OR 00657000
                  (MPS2                >    +14)                        00658000
             MOVE  QWRMAP              TO   MPEW50O                     00659000
             MOVE  MSG28               TO   MMSGO                       00660000
             MOVE  1234                TO   EIBCALEN                    00661000
             GO                        TO   015-SEND.                   00662000
           IF     (MPSCNBR      (MPS2) =    '1')                     OR 00663000
                  (MPSCNBR      (MPS2) =    '2')                     OR 00664000
                  (MPSCNBR      (MPS2) =    '3')                        00665000
             MOVE  'CB03'              TO   WCMXFTO                     00666000
           ELSE                                                         00667000
041599       IF   (MPSCNBR      (MPS2) =    '4')                     OR 00663000
041599            (MPSCNBR      (MPS2) =    '5')                        00665000
041599         MOVE  'CB11'            TO   WCMXFTO                     00666000
041599     ELSE                                                         00667000
             IF   (MPSCNBR      (MPS2) =    '6')                     OR 00668000
                  (MPSCNBR      (MPS2) =    '7')                        00669000
               MOVE  'CB04'            TO   WCMXFTO                     00670000
             ELSE                                                       00671000
               MOVE  'CB05'            TO   WCMXFTO.                    00672000
           MOVE    MPSFUND      (MPS2) TO   WSCFUND                     00673000
           MOVE    MPSTABLE     (MPS2) TO   WSCTABLE                    00674000
           MOVE    MPSSCHL      (MPS2) TO   WSCSCHL                     00675000
           MOVE    WSCKEY              TO   WCMXFPROM                   00676000
           GO                          TO   805-XCTL.                   00677000
                                                                        00678000
      ******************************************************************00679000
       850-CALLED.                                                      00680000
           MOVE    WCMXFCRS9           TO   EIBCPOSN                    00681000
           MOVE    DFHCOMMAREA         TO   WCM                         00682000
           IF      WCMRETCD            NOT  =   'G'                     00683000
             GO                        TO   900-SECURITY.               00684000
           IF      WCMXFFR             =    'CZ02'                      00685000
             MOVE  WCMXFHLD            TO   WCMXFFR                     00686000
             MOVE  WCMXFCRS9           TO   EIBCPOSN                    00687000
             MOVE  1234                TO   EIBCALEN                    00688000
             MOVE  QWRMAP              TO   MPEW50O                     00689000
             GO                        TO   015-SEND.                   00690000
           IF     (WCMXFFR             =    'CZ04')                  OR 00691000
                  (WCMXFFR             =    'CZ03')                     00692000
             MOVE  WCMXFHLD            TO   WCMXFFR                     00693000
             MOVE  WCMXFCRS9           TO   EIBCPOSN                    00694000
             MOVE  1234                TO   EIBCALEN                    00695000
             MOVE  QWRMAP              TO   MPEW50O                     00696000
             IF      WCMXFPROM         NOT  =   SPACES                  00697000
               IF      WCMXFPNL5       =    'SCHL '                     00698000
                 MOVE  WCMXFPROM       TO   MSCHLO                      00699000
                 GO                    TO   015-SEND                    00700000
               ELSE                                                     00701000
                 IF      WCMXFPNL5     =    'TBLE '                     00702000
                   MOVE  WCMXFPROM     TO   MTABLEO                     00703000
                   GO                  TO   015-SEND                    00704000
                 ELSE                                                   00705000
                   GO                  TO   015-SEND                    00706000
             ELSE                                                       00707000
               GO                      TO   015-SEND.                   00708000
           IF     (WCMXFFR             =    'CB03')                  OR 00709000
                  (WCMXFFR             =    'CB04')                  OR 00710000
                  (WCMXFFR             =    'CB05')                     00711000
             MOVE  1234                TO   EIBCALEN                    00712000
             MOVE  QWRMAP              TO   MPEW50O                     00713000
             MOVE  ALL '_'             TO   MPANELO                     00714000
             IF      EIBCPOSN          <    +399                        00715000
               MOVE  +185              TO   EIBCPOSN                    00716000
               GO                      TO   015-SEND                    00717000
             ELSE                                                       00718000
               GO                      TO   015-SEND.                   00719000
           MOVE    LOW-VALUES          TO   MPEW50O    QWRMAP           00720000
           MOVE    HIGH-VALUES         TO   QWRPF7     OLDKEY           00721000
           MOVE    SPACES              TO   NEWKEY                      00722000
           MOVE    -1                  TO   MFUNDL                      00723000
           MOVE    MSG18               TO   MMSGO                       00724000
           GO                          TO   015-SEND.                   00725000
                                                                        00726000
      ******************************************************************00727000
       900-SECURITY.                                                    00728000
           MOVE    ZEROS               TO   EIBCALEN                    00729000
           MOVE    WCMXFHLD            TO   WCMXFFR                     00730000
           MOVE    1234                TO   EIBCALEN                    00731000
           MOVE    +14                 TO   EIBCPOSN                    00732000
           MOVE    QWRMAP              TO   MPEW50O                     00733000
           MOVE    WCMXFTPNL           TO   MPANELO                     00734000
           MOVE    WABUMB              TO   MPANELA                     00735000
           IF      WCMRETCD            =    'S'                         00736000
             MOVE  MSG90               TO   MMSGO                       00737000
           ELSE                                                         00738000
             IF      WCMRETCD          =    'T'                         00739000
               MOVE  MSG91             TO   MMSGO                       00740000
             ELSE                                                       00741000
               IF     (WCMRETCD        =    'U')                     OR 00742000
                      (WCMRETCD        =    'N')                        00743000
                 MOVE  MSG92           TO   MMSGO                       00744000
               ELSE                                                     00745000
                 IF      WCMRETCD      =    'D'                         00746000
                   MOVE  MSG93         TO   MMSGO.                      00747000
           GO                          TO   015-SEND.                   00748000
       901-ERROR.                                                       00749000
           MOVE    -1                  TO   MPANELL                     00750000
           MOVE    MSG94               TO   MMSGO                       00751000
           GO                          TO   015-SEND.                   00752000
       902-NOSPACE.                                                     00753000
           MOVE    MSG95               TO   MMSGO                       00754000
           MOVE    -1                  TO   MPANELL                     00755000
           GO                          TO   015-SEND.                   00756000
       903-INVREQ.                                                      00757000
           MOVE    MSG96               TO   MMSGO                       00758000
           MOVE    -1                  TO   MPANELL                     00759000
           GO                          TO   015-SEND.                   00760000
       904-NOTOPEN.                                                     00761000
           MOVE    MSG97               TO   MMSGO                       00762000
           MOVE    -1                  TO   MPANELL                     00763000
           GO                          TO   015-SEND.                   00764000
       905-DSIDERR.                                                     00765000
           MOVE    MSG97               TO   MMSGO                       00766000
           MOVE    -1                  TO   MPANELL                     00767000
           GO                          TO   015-SEND.                   00768000
           GOBACK.                                                      00769000
