       IDENTIFICATION DIVISION.                                         00001000
                                                                        00002000
       PROGRAM-ID.    EW45.                                             00003000
       AUTHOR.        DOE.                                              00004000
      ******************************************************************00005000
      *                               FORM 6                           *00006000
      *  COMPILE WITH SUBCOB CICS                                      *00006000
      ******************************************************************00007000
      * DATE CREATED:  06/28/95                                        *00008000
      ******************************************************************00009000
      * CALL #  - MMDDYY - PURPOSE                                     *00010000
      * FIX9908 - 040799 - ADD CHARTER SCHOOL FIELD                    *00011000
      * 2009001 - 050409 - EDIT VALID FUND AND ADDED ADDITIONAL        *
      *                    FOR AARA MONEY (STIMULUS DOLLARS)           *
      * 2011001 - 020411 - ADD ARRA FUNDS 8 & 9                        *
      ******************************************************************00012000
                                                                        00013000
       ENVIRONMENT DIVISION.                                            00014000
       CONFIGURATION SECTION.                                           00015000
       DATA DIVISION.                                                   00016000
                                                                        00017000
       WORKING-STORAGE SECTION.                                         00018000
                                                                        00019000
       01            WSC.                                               00020000
040799*    05        WSCMAPLEN         PIC S9(04) COMP SYNC VALUE +0168.00021000
040799     05        WSCMAPLEN         PIC S9(04) COMP SYNC VALUE +0181.00021000
           05        WSCDATE.                                           00022000
             10      WSCMM             PIC  X(02).                      00023000
             10      WSCDD             PIC  X(02).                      00024000
             10      WSCYY             PIC  X(02).                      00025000
                                                                        00026000
       01            WSK.                                               00027000
           05        NEWKEY.                                            00028000
             10      NEWFUND           PIC  X(01).                      00029000
           05        NEWPANEL.                                          00030000
             10      NEWPANEL1         PIC  X(01).                      00031000
             10      NEWPANEL2         PIC  X(02).                      00032000
           05        OLDKEY            PIC  X(01).                      00033000
       01            WSKR       REDEFINES   WSK.                        00034000
           05        WSKB       OCCURS 004  TIMES  INDEXED BY WSK1      00035000
                                       PIC  X(01).                      00036000
                                                                        00037000
       01            RET.                                               00038000
           05        RETQWR            PIC  X(02).                      00039000
           05        RETCDF            PIC  X(02).                      00040000
           05        RETERR            PIC S9(01).                      00041000
                                                                        00042000
       01            MSG.                                               00043000
           05        MSG01             PIC  X(35) VALUE                 00044000
                     'District is not authorized.  EXIT.'.              00045000
           05        MSG03             PIC  X(37) VALUE                 00046000
                     'Highlighted elements in error. Retry.'.           00047000
           05        MSG12             PIC  X(25) VALUE                 00048000
                     'Record displayed.  Next ?'.                       00049000
           05        MSG13             PIC  X(28) VALUE                 00050000
                     'No previous records.  Next ?'.                    00051000
           05        MSG14             PIC  X(30) VALUE                 00052000
                     'No additional records.  Next ?'.                  00053000
           05        MSG15             PIC  X(25) VALUE                 00054000
                     'Record unchanged.  Next ?'.                       00055000
           05        MSG16             PIC  X(21) VALUE                 00056000
                     'Record added.  Next ?'.                           00057000
           05        MSG17             PIC  X(23) VALUE                 00058000
                     'Record updated.  Next ?'.                         00059000
           05        MSG18             PIC  X(40) VALUE                 00060000
                     'Please type key element(s).  Then ENTER.'.        00061000
           05        MSG20             PIC  X(39) VALUE                 00062000
                     'Record deleted.  Press ENTER to re-add.'.         00063000
           05        MSG21             PIC  X(35) VALUE                 00064000
                     'Not on file. Not update authorized.'.             00065000
           05        MSG22             PIC  X(37) VALUE                 00066000
                     'Record displayed for inquiry.  Next ?'.           00067000
           05        MSG23             PIC  X(40) VALUE                 00068000
                     'Not on file.  Type data to add or retry.'.        00069000
           05        MSG29             PIC  X(28) VALUE                 00070000
                     'No record to delete.  Next ?'.                    00071000
           05        MSG90             PIC  X(35) VALUE                 00072000
                     'Not authorized for panel requested.'.             00073000
           05        MSG91             PIC  X(32) VALUE                 00074000
                     'Not authorized at this terminal.'.                00075000
           05        MSG92             PIC  X(35) VALUE                 00076000
                     'Panel unknown/not installed. Retry.'.             00077000
           05        MSG93             PIC  X(39) VALUE                 00078000
                     'Panel temporarily disabled.  Try later.'.         00079000
           05        MSG94             PIC  X(41) VALUE                 00080000
                     'Unknown system error. Request assistance.'.       00081000
           05        MSG95             PIC  X(35) VALUE                 00082000
                     'Database full.  Request assistance.'.             00083000
           05        MSG96             PIC  X(42) VALUE                 00084000
                     'Program error(INVREQ). Request assistance.'.      00085000
           05        MSG97             PIC  X(30) VALUE                 00086000
                     'Database closed.  Try later.'.                    00087000
                                                                        00088000
           COPY                             EWCDFC.                     00089000
           COPY                             EWQWRC.                     00090000
                                                                        00091000
           COPY                             EWCDF.                      00092000
                                                                        00093000
       01            ODF.                                               00094000
           05        ODFALT.                                            00095000
             10      FILLER                 PIC  X(014).                00096000
             10      ODFKEY                 PIC  X(018).                00097000
           05        ODFDATA                PIC  X(062).                00098000
                                                                        00099000
           COPY                             EWQWR.                      00100000
           COPY                             EWQWRI.                     00101000
                                                                        00102000
           COPY                             EWDATW.                     00103000
                                                                        00104000
           COPY                             EWWCM.                      00105000
                                                                        00106000
           COPY                             EWNUMBW.                    00107000
                                                                        00108000
           COPY                             DFHAID.                     00109000
                                                                        00110000
           COPY                             EWWAB.                      00111000
                                                                        00112000
           COPY                             MPEW45.                     00113000
       01            MPEW45R     REDEFINES  MPEW45I.                    00114000
040799*    05        MAPBYTE        OCCURS  0168  TIMES INDEXED BY MAP1.00115000
040799     05        MAPBYTE        OCCURS  0181  TIMES INDEXED BY MAP1.00115000
             10      FILLER            PIC  X(01).                      00116000
                                                                        00117000
       LINKAGE SECTION.                                                 00118000
                                                                        00119000
       01  DFHCOMMAREA                 PIC  X(220).                     00120000
                                                                        00121000
       PROCEDURE DIVISION.                                              00122000
      ******************************************************************00123000
                                                                        00124000
       000-CONTROL.                                                     00125000
           MOVE    SPACES              TO   WSK           WCM           00126000
           MOVE    LOW-VALUES          TO   MPEW45O                     00127000
           MOVE    '99'                TO   RETQWR                      00128000
           EXEC    CICS HANDLE CONDITION    MAPFAIL  (100-DISPLAY)      00129000
                   ERROR   (901-ERROR)      NOSPACE  (902-NOSPACE)      00130000
                   INVREQ  (903-INVREQ)     NOTOPEN  (904-NOTOPEN)      00131000
                   DSIDERR (905-DSIDERR)    END-EXEC                    00132000
                                                                        00133000
           MOVE    EIBTRMID            TO   QWRTRMID                    00134000
           MOVE    'EW45'              TO   QWRPGM                      00135000
           EXEC    CICS HANDLE CONDITION    NOTFND  (005-NEW)  END-EXEC 00136000
           EXEC    CICS READ                DATASET (QWRFIL)            00137000
                                            INTO    (QWR)               00138000
                                            RIDFLD  (QWRKEY)            00139000
                                            LENGTH  (QWRLENR)  END-EXEC 00140000
           MOVE    '00'                TO   RETQWR.                     00141000
       005-NEW.                                                         00142000
           IF      RETQWR              NOT  =   '00'                    00143000
             MOVE  QWRKEY              TO   QWRIKEY                     00144000
             MOVE  QWRI                TO   QWR                         00145000
             MOVE  DFHCOMMAREA         TO   WCM                         00146000
             MOVE  ZEROS               TO   WCMXFCRS9     WCMXFPOS9     00147000
             MOVE  HIGH-VALUES         TO   OLDKEY                      00148000
           ELSE                                                         00149000
             MOVE  QWRWCM              TO   WCM                         00150000
             MOVE  QWROLD              TO   OLDKEY.                     00151000
                                                                        00152000
           MOVE    WCMSODISTA          TO   CDFFILDS                    00153000
                                                                        00154000
           IF      EIBCALEN            >    ZEROS                       00155000
             GO                        TO   850-CALLED.                 00156000
           IF      EIBAID              NOT  =   DFHENTER                00157000
             GO                        TO   800-XCTL.                   00158000
                                                                        00159000
           MOVE    QWROLD              TO   OLDKEY                      00160000
           PERFORM 010-RECEIVE         THRU 010-EXIT                    00161000
           IF      NEWPANEL            NOT  =   SPACES                  00162000
             MOVE  NEWPANEL            TO   WCMXFTPNL                   00163000
             GO                        TO   805-XCTL.                   00164000
           IF      NEWKEY              NOT  =   OLDKEY                  00165000
             GO                        TO   100-DISPLAY                 00166000
           ELSE                                                         00167000
             GO                        TO   300-UPDATE.                 00168000
                                                                        00169000
      ******************************************************************00170000
       010-RECEIVE.                                                     00171000
           EXEC    CICS RECEIVE             MAP    ('MPEW45')  END-EXEC 00172000
           MOVE    EIBCPOSN            TO   WCMXFCRS9                   00173000
           SET     MAP1  QWR1          TO   +1.                         00174000
       010-LOOP1.                                                       00175000
           IF     (MAPBYTE      (MAP1) NOT  =   LOW-VALUES)          AND00176000
                  (MAPBYTE      (MAP1) NOT  =   HIGH-VALUES)            00177000
             MOVE  MAPBYTE      (MAP1) TO   QWRBYTE      (QWR1).        00178000
           IF      MAP1                <    WSCMAPLEN                   00179000
             SET   MAP1  QWR1          UP   BY  +1                      00180000
             GO                        TO   010-LOOP1.                  00181000
           MOVE    QWRMAP              TO   MPEW45I                     00182000
                                                                        00183000
           IF      MPANELA             =    WABEOF                      00184000
             MOVE  WABUM               TO   MPANELA                     00185000
             MOVE  ALL '_'             TO   MPANELO       NEWPANEL      00186000
           ELSE                                                         00187000
             IF      MPANELL           >    ZEROS                       00188000
               MOVE  MPANELI           TO   NEWPANEL                    00189000
               MOVE  WABUM             TO   MPANELA                     00190000
             ELSE                                                       00191000
               IF      MPANELI         >    LOW-VALUES                  00192000
                 MOVE  MPANELI         TO   NEWPANEL.                   00193000
                                                                        00194000
           IF      MFUNDA             =    WABEOF                       00195000
             MOVE  WABUM              TO   MFUNDA                       00196000
             MOVE  ALL '_'            TO   MFUNDO        NEWFUND        00197000
           ELSE                                                         00198000
             IF      MFUNDL           >    ZEROS                        00199000
               MOVE  ZEROS            TO   MFUNDL                       00200000
               MOVE  MFUNDI           TO   NEWFUND                      00201000
               MOVE  WABUM            TO   MFUNDA                       00202000
             ELSE                                                       00203000
               IF      MFUNDI         >    LOW-VALUES                   00204000
                 MOVE  MFUNDI         TO   NEWFUND.                     00205000
                                                                        00206000
           SET     WSK1                TO   +1.                         00207000
       010-LOOP2.                                                       00208000
           IF      WSKB         (WSK1) =    '_'                         00209000
             MOVE  ' '                 TO   WSKB         (WSK1).        00210000
           IF      WSK1                <    +4                          00211000
             SET   WSK1                UP   BY  +1                      00212000
             GO                        TO   010-LOOP2.                  00213000
       010-EXIT.                                                        00214000
           EXIT.                                                        00215000
                                                                        00216000
      ******************************************************************00217000
       015-SEND.                                                        00218000
           MOVE    EIBTRMID            TO   QWRTRMID                    00219000
           MOVE    'EW45'              TO   QWRPGM                      00220000
           MOVE    OLDKEY              TO   QWROLD                      00221000
           MOVE    WCM                 TO   QWRWCM                      00222000
           MOVE    MPEW45O             TO   QWRMAP                      00223000
           EXEC    CICS HANDLE CONDITION    DUPREC  (015-ERR)  END-EXEC 00224000
           IF      RETQWR              NOT  =   '00'                    00225000
             EXEC  CICS WRITE               DATASET (QWRFIL)            00226000
                                            FROM    (QWR)               00227000
                                            RIDFLD  (QWRKEY)            00228000
                                            LENGTH  (QWRLENR)  END-EXEC 00229000
           ELSE                                                         00230000
             EXEC  CICS READ UPDATE         DATASET (QWRFIL)            00231000
                                            INTO    (QWRI)              00232000
                                            RIDFLD  (QWRKEY)            00233000
                                            LENGTH  (QWRLENR)  END-EXEC 00234000
             EXEC  CICS REWRITE             DATASET (QWRFIL)            00235000
                                            FROM    (QWR)               00236000
                                            LENGTH  (QWRLENR)  END-EXEC.00237000
       015-ERR.                                                         00238000
           IF      EIBCALEN            =    ZEROS                       00239000
             EXEC  CICS SEND                MAP     ('MPEW45') DATAONLY 00240000
                                            CURSOR             END-EXEC 00241000
           ELSE                                                         00242000
             IF      EIBCALEN          NOT  =   1234                    00243000
               EXEC  CICS SEND              MAP     ('MPEW45') ERASE    00244000
                                            CURSOR             END-EXEC 00245000
             ELSE                                                       00246000
               EXEC  CICS SEND              MAP     ('MPEW45') ERASE    00247000
                                            CURSOR  (EIBCPOSN) END-EXEC.00248000
           EXEC    CICS RETURN              TRANSID ('EW45')   END-EXEC.00249000
                                                                        00250000
      ******************************************************************00251000
       100-DISPLAY.                                                     00252000
           MOVE    HIGH-VALUES         TO   OLDKEY                      00253000
           MOVE    LOW-VALUES          TO   MPEW45O       QWRMAP        00254000
           MOVE    +10                 TO   EIBCALEN                    00255000
           MOVE    ZEROS               TO   RETERR                      00256000
           SET     WSK1                TO   +1.                         00257000
       100-LOOP1.                                                       00258000
           IF      WSKB         (WSK1) =    ' '                         00259000
             MOVE  '_'                 TO   WSKB         (WSK1).        00260000
           IF      WSK1                <    +4                          00261000
             SET   WSK1                UP   BY  +1                      00262000
             GO                        TO   100-LOOP1.                  00263000
           MOVE    NEWPANEL            TO   MPANELO                     00264000
           MOVE    NEWFUND             TO   MFUNDO                      00265000
           SET     WSK1                TO   +1.                         00266000
       100-LOOP2.                                                       00267000
           IF      WSKB         (WSK1) =    '_'                         00268000
             MOVE  ' '                 TO   WSKB         (WSK1).        00269000
           IF      WSK1                <    +4                          00270000
             SET   WSK1                UP   BY  +1                      00271000
             GO                        TO   100-LOOP2.                  00272000
                                                                        00273000
           IF      NEWFUND             =    SPACES                      00274000
             MOVE  -1                  TO   MFUNDL                      00275000
             MOVE  MSG18               TO   MMSGO                       00276000
             GO                        TO   015-SEND.                   00277000

050409     IF     (NEWFUND             NOT  =   '1')                 AND
050409            (NEWFUND             NOT  =   '4')                 AND
050409            (NEWFUND             NOT  =   '5')                 AND
050409            (NEWFUND             NOT  =   '6')                 AND
020411            (NEWFUND             NOT  =   '8')                 AND
020411            (NEWFUND             NOT  =   '9')                 AND
050409            (NEWFUND             NOT  =   '7')
050409       MOVE  WABUMB              TO   MFUNDA
050409       MOVE  -1                  TO   MFUNDL
050409       MOVE  MSG03               TO   MMSGO
050409       GO                        TO   015-SEND.
                                                                        00278000
           MOVE    NEWKEY              TO   OLDKEY                      00279000
           MOVE    SPACES              TO   CDF                         00280000
           MOVE    WCMSODIST           TO   CDFDIST       CDFDIST2      00281000
           MOVE    WCMSOFY             TO   CDFFY         CDFFY2        00282000
           MOVE    NEWFUND             TO   CDFFUND       CDFFUND2      00283000
           MOVE    '99999'             TO   CDFTABLE      CDFTABLE2     00284000
           MOVE    '0000'              TO   CDFSCHL                     00285000
           MOVE    '8000'              TO   CDFCONTROL    CDFCONTROL2   00286000
           EXEC    CICS HANDLE CONDITION    NOTFND  (110-NEW)  END-EXEC 00287000
           EXEC    CICS READ                DATASET (CDFFIL)            00288000
                                            INTO    (CDF)               00289000
                                            RIDFLD  (CDFKEY)            00290000
                                            LENGTH  (CDFLENR)  END-EXEC 00291000
                                                                        00292000
           MOVE    CDFAMT1             TO   MRECRO.                     00293000
           MOVE    CDFAMT2             TO   MOTHRO.                     00294000
           MOVE    CDFAMT3             TO   MCAPO.                      00295000
           MOVE    CDFAMT4             TO   MCOMSRVO.                   00296000
           MOVE    CDFAMT5             TO   MDEBTO.                     00297000
           MOVE    CDFAMT6             TO   MFEDINDO.                   00298000
040799     MOVE    CDFAMT7             TO   MCHRTRO.                    00298000
           MOVE    CDFTOTAL            TO   MTOTALO.                    00299000
           IF      CDFAMT1             =  ZEROS                         00300000
             MOVE  ALL '_'             TO   MRECRI.                     00301000
           IF      CDFAMT2             =  ZEROS                         00302000
             MOVE  ALL '_'             TO   MOTHRI.                     00303000
           IF      CDFAMT3             =  ZEROS                         00304000
             MOVE  ALL '_'             TO   MCAPI.                      00305000
           IF      CDFAMT4             =  ZEROS                         00306000
             MOVE  ALL '_'             TO   MCOMSRVI.                   00307000
           IF      CDFAMT5             =  ZEROS                         00308000
             MOVE  ALL '_'             TO   MDEBTI.                     00309000
           IF      CDFAMT6             =  ZEROS                         00310000
             MOVE  ALL '_'             TO   MFEDINDI.                   00311000
040799     IF      CDFAMT7             =  ZEROS                         00310000
040799       MOVE  ALL '_'             TO   MCHRTRI.                    00311000
           IF      CDFTOTAL            =  ZEROS                         00312000
             MOVE  ALL '_'             TO   MTOTALI.                    00313000
                                                                        00314000
           MOVE    -1                  TO   MFUNDL                      00315000
           IF      WCMSOCURR           =    'U'                         00316000
             MOVE  MSG12               TO   MMSGO                       00317000
           ELSE                                                         00318000
             MOVE  MSG22               TO   MMSGO                       00319000
             MOVE  HIGH-VALUES         TO   OLDKEY.                     00320000
           GO                          TO   015-SEND.                   00321000
                                                                        00322000
       110-NEW.                                                         00323000
           IF      WCMSOCURR           =    'U'                         00324000
             MOVE  -1                  TO   MRECRL                      00325000
             MOVE  MSG23               TO   MMSGO                       00326000
           ELSE                                                         00327000
             MOVE  -1                  TO   MFUNDL                      00328000
             MOVE  MSG21               TO   MMSGO                       00329000
             MOVE  HIGH-VALUES         TO   OLDKEY.                     00330000
           GO                          TO   015-SEND.                   00331000
                                                                        00332000
      ******************************************************************00333000
       300-UPDATE.                                                      00334000
           IF      WCMSOCURR           NOT  =  'U'                      00335000
             GO                        TO   100-DISPLAY.                00336000
           MOVE    ZEROS               TO   MFUNDL                      00337000
           MOVE    SPACES              TO   CDF                         00338000
           MOVE    WCMSODIST           TO   CDFDIST       CDFDIST2      00339000
           MOVE    WCMSOFY             TO   CDFFY         CDFFY2        00340000
           MOVE    NEWFUND             TO   CDFFUND       CDFFUND2      00341000
           MOVE    '99999'             TO   CDFTABLE      CDFTABLE2     00342000
           MOVE    '0000'              TO   CDFSCHL                     00343000
           MOVE    '8000'              TO   CDFCONTROL    CDFCONTROL2   00344000
           MOVE    '99'                TO   RETCDF                      00345000
           EXEC    CICS HANDLE CONDITION    NOTFND  (305-NEW)  END-EXEC 00346000
           EXEC    CICS READ                DATASET (CDFFIL)            00347000
                                            INTO    (CDF)               00348000
                                            RIDFLD  (CDFKEY)            00349000
                                            LENGTH  (CDFLENR)  END-EXEC 00350000
           IF      EIBAID              =    DFHPF10                     00351000
             EXEC  CICS READ   UPDATE       DATASET (CDFFIL)            00352000
                                            INTO    (CDF)               00353000
                                            RIDFLD  (CDFKEY)            00354000
                                            LENGTH  (CDFLENR)  END-EXEC 00355000
             EXEC  CICS DELETE              DATASET (CDFFIL)   END-EXEC 00356000
             MOVE  -1                  TO   MFUNDL                      00357000
             MOVE  MSG20               TO   MMSGO                       00358000
             GO                        TO   015-SEND.                   00359000
           MOVE    '00'                TO   RETCDF.                     00360000
       305-NEW.                                                         00361000
           IF     (EIBAID              =    DFHPF10)                 AND00362000
                  (RETCDF              NOT  =   '00')                   00363000
             MOVE  -1                  TO   MFUNDL                      00364000
             MOVE  MSG29               TO   MMSGO                       00365000
             GO                        TO   015-SEND.                   00366000
                                                                        00367000
           MOVE    CDF                 TO   ODF                         00368000
           MOVE    ZEROS               TO   WNU90                       00369000
           IF      MRECRA              =    WABEOF                      00370000
             MOVE  ALL '_'             TO   MRECRI                      00371000
             MOVE  WABUNM              TO   MRECRA                      00372000
             MOVE  ZEROS               TO   CDFAMT1                     00373000
           ELSE                                                         00374000
             IF      MRECRL            >    ZEROS                       00375000
               MOVE  ZEROS             TO   MRECRL                      00376000
               MOVE  MRECRI            TO   WNUIN                       00377000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00378000
               IF    WNUSIGN           =    '-'                         00379000
                 COMPUTE WNU90         =    0 - WNU90                   00380000
                 MOVE  WNU90           TO   MRECRO      CDFAMT1         00381000
                 MOVE  WABUN           TO   MRECRA                      00382000
               ELSE                                                     00383000
                 MOVE  WNU90           TO   MRECRO      CDFAMT1         00384000
                 MOVE  WABUN           TO   MRECRA                      00385000
             ELSE                                                       00386000
               IF      MRECRI          >    LOW-VALUES                  00387000
                 MOVE  WABUN           TO   MRECRA                      00388000
                 MOVE  MRECRI          TO   WNUIN                       00389000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00390000
                 IF    WNUSIGN         =    '-'                         00391000
                   COMPUTE WNU90       =    0 - WNU90                   00392000
                   MOVE  WNU90         TO   MRECRO      CDFAMT1         00393000
                   MOVE  WABUN         TO   MRECRA                      00394000
                 ELSE                                                   00395000
                   MOVE  WNU90         TO   MRECRO      CDFAMT1.        00396000
           IF        WNU90             =    ZEROS                       00397000
             MOVE    ZEROS             TO   CDFAMT1                     00398000
             MOVE    ALL '_'           TO   MRECRI.                     00399000
                                                                        00400000
           MOVE    ZEROS               TO   WNU90                       00401000
           IF      MOTHRA              =    WABEOF                      00402000
             MOVE  ALL '_'             TO   MOTHRI                      00403000
             MOVE  WABUNM              TO   MOTHRA                      00404000
             MOVE  ZEROS               TO   CDFAMT2                     00405000
           ELSE                                                         00406000
             IF      MOTHRL            >    ZEROS                       00407000
               MOVE  ZEROS             TO   MOTHRL                      00408000
               MOVE  MOTHRI            TO   WNUIN                       00409000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00410000
               IF    WNUSIGN           =    '-'                         00411000
                 COMPUTE WNU90         =    0 - WNU90                   00412000
                 MOVE  WNU90           TO   MOTHRO      CDFAMT2         00413000
                 MOVE  WABUN           TO   MOTHRA                      00414000
               ELSE                                                     00415000
                 MOVE  WNU90           TO   MOTHRO      CDFAMT2         00416000
                 MOVE  WABUN           TO   MOTHRA                      00417000
             ELSE                                                       00418000
               IF      MOTHRI          >    LOW-VALUES                  00419000
                 MOVE  WABUN           TO   MOTHRA                      00420000
                 MOVE  MOTHRI          TO   WNUIN                       00421000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00422000
                 IF    WNUSIGN         =    '-'                         00423000
                   COMPUTE WNU90       =    0 - WNU90                   00424000
                   MOVE  WNU90         TO   MOTHRO      CDFAMT2         00425000
                   MOVE  WABUN         TO   MOTHRA                      00426000
                 ELSE                                                   00427000
                   MOVE  WNU90         TO   MOTHRO      CDFAMT2.        00428000
           IF        WNU90             =    ZEROS                       00429000
             MOVE    ZEROS             TO   CDFAMT2                     00430000
             MOVE    ALL '_'           TO   MOTHRI.                     00431000
                                                                        00432000
           MOVE    ZEROS               TO   WNU90                       00433000
           IF      MCAPA               =    WABEOF                      00434000
             MOVE  ALL '_'             TO   MCAPI                       00435000
             MOVE  WABUNM              TO   MCAPA                       00436000
             MOVE  ZEROS               TO   CDFAMT3                     00437000
           ELSE                                                         00438000
             IF      MCAPL             >    ZEROS                       00439000
               MOVE  ZEROS             TO   MCAPL                       00440000
               MOVE  MCAPI             TO   WNUIN                       00441000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00442000
               IF    WNUSIGN           =    '-'                         00443000
                 COMPUTE WNU90         =    0 - WNU90                   00444000
                 MOVE  WNU90           TO   MCAPO       CDFAMT3         00445000
                 MOVE  WABUN           TO   MCAPA                       00446000
               ELSE                                                     00447000
                 MOVE  WNU90           TO   MCAPO       CDFAMT3         00448000
                 MOVE  WABUN           TO   MCAPA                       00449000
             ELSE                                                       00450000
               IF      MCAPI           >    LOW-VALUES                  00451000
                 MOVE  WABUN           TO   MCAPA                       00452000
                 MOVE  MCAPI           TO   WNUIN                       00453000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00454000
                 IF    WNUSIGN         =    '-'                         00455000
                   COMPUTE WNU90       =    0 - WNU90                   00456000
                   MOVE  WNU90         TO   MCAPO      CDFAMT3          00457000
                   MOVE  WABUN         TO   MCAPA                       00458000
                 ELSE                                                   00459000
                   MOVE  WNU90         TO   MCAPO      CDFAMT3.         00460000
           IF        WNU90             =    ZEROS                       00461000
             MOVE    ZEROS             TO   CDFAMT3                     00462000
             MOVE    ALL '_'           TO   MCAPI.                      00463000
                                                                        00464000
           MOVE    ZEROS               TO   WNU90                       00465000
           IF      MCOMSRVA            =    WABEOF                      00466000
             MOVE  ALL '_'             TO   MCOMSRVI                    00467000
             MOVE  WABUNM              TO   MCOMSRVA                    00468000
             MOVE  ZEROS               TO   CDFAMT4                     00469000
           ELSE                                                         00470000
             IF      MCOMSRVL          >    ZEROS                       00471000
               MOVE  ZEROS             TO   MCOMSRVL                    00472000
               MOVE  MCOMSRVI          TO   WNUIN                       00473000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00474000
               IF    WNUSIGN           =    '-'                         00475000
                 COMPUTE WNU90         =    0 - WNU90                   00476000
                 MOVE  WNU90           TO   MCOMSRVO    CDFAMT4         00477000
                 MOVE  WABUN           TO   MCOMSRVA                    00478000
               ELSE                                                     00479000
                 MOVE  WNU90           TO   MCOMSRVO    CDFAMT4         00480000
                 MOVE  WABUN           TO   MCOMSRVA                    00481000
             ELSE                                                       00482000
               IF      MCOMSRVI        >    LOW-VALUES                  00483000
                 MOVE  WABUN           TO   MCOMSRVA                    00484000
                 MOVE  MCOMSRVI        TO   WNUIN                       00485000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00486000
                 IF    WNUSIGN         =    '-'                         00487000
                   COMPUTE WNU90       =    0 - WNU90                   00488000
                   MOVE  WNU90         TO   MCOMSRVO    CDFAMT4         00489000
                   MOVE  WABUN         TO   MCOMSRVA                    00490000
                 ELSE                                                   00491000
                   MOVE  WNU90         TO   MCOMSRVO    CDFAMT4.        00492000
           IF        WNU90             =    ZEROS                       00493000
             MOVE    ZEROS             TO   CDFAMT4                     00494000
             MOVE    ALL '_'           TO   MCOMSRVI.                   00495000
                                                                        00496000
           MOVE    ZEROS               TO   WNU90                       00497000
           IF      MDEBTA              =    WABEOF                      00498000
             MOVE  ALL '_'             TO   MDEBTI                      00499000
             MOVE  WABUNM              TO   MDEBTA                      00500000
             MOVE  ZEROS               TO   CDFAMT5                     00501000
           ELSE                                                         00502000
             IF      MDEBTL            >    ZEROS                       00503000
               MOVE  ZEROS             TO   MDEBTL                      00504000
               MOVE  MDEBTI            TO   WNUIN                       00505000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00506000
               IF    WNUSIGN           =    '-'                         00507000
                 COMPUTE WNU90         =    0 - WNU90                   00508000
                 MOVE  WNU90           TO   MDEBTO      CDFAMT5         00509000
                 MOVE  WABUN           TO   MDEBTA                      00510000
               ELSE                                                     00511000
                 MOVE  WNU90           TO   MDEBTO      CDFAMT5         00512000
                 MOVE  WABUN           TO   MDEBTA                      00513000
             ELSE                                                       00514000
               IF      MDEBTI          >    LOW-VALUES                  00515000
                 MOVE  WABUN           TO   MDEBTA                      00516000
                 MOVE  MDEBTI          TO   WNUIN                       00517000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00518000
                 IF    WNUSIGN         =    '-'                         00519000
                   COMPUTE WNU90       =    0 - WNU90                   00520000
                   MOVE  WNU90         TO   MDEBTO      CDFAMT5         00521000
                   MOVE  WABUN         TO   MDEBTA                      00522000
                 ELSE                                                   00523000
                   MOVE  WNU90         TO   MDEBTO      CDFAMT5.        00524000
           IF        WNU90             =    ZEROS                       00525000
             MOVE    ZEROS             TO   CDFAMT5                     00526000
             MOVE    ALL '_'           TO   MDEBTI.                     00527000
                                                                        00528000
           MOVE    ZEROS               TO   WNU90                       00529000
           IF      MFEDINDA            =    WABEOF                      00530000
             MOVE  ALL '_'             TO   MFEDINDI                    00531000
             MOVE  WABUNM              TO   MFEDINDA                    00532000
             MOVE  ZEROS               TO   CDFAMT6                     00533000
           ELSE                                                         00534000
             IF      MFEDINDL          >    ZEROS                       00535000
               MOVE  ZEROS             TO   MFEDINDL                    00536000
               MOVE  MFEDINDI          TO   WNUIN                       00537000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00538000
               IF    WNUSIGN           =    '-'                         00539000
                 COMPUTE WNU90         =    0 - WNU90                   00540000
                 MOVE  WNU90           TO   MFEDINDO    CDFAMT6         00541000
                 MOVE  WABUN           TO   MFEDINDA                    00542000
               ELSE                                                     00543000
                 MOVE  WNU90           TO   MFEDINDO    CDFAMT6         00544000
                 MOVE  WABUN           TO   MFEDINDA                    00545000
             ELSE                                                       00546000
               IF      MFEDINDI        >    LOW-VALUES                  00547000
                 MOVE  WABUN           TO   MFEDINDA                    00548000
                 MOVE  MFEDINDI        TO   WNUIN                       00549000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00550000
                 IF    WNUSIGN         =    '-'                         00551000
                   COMPUTE WNU90       =    0 - WNU90                   00552000
                   MOVE  WNU90         TO   MFEDINDO    CDFAMT6         00553000
                   MOVE  WABUN         TO   MFEDINDA                    00554000
                 ELSE                                                   00555000
                   MOVE  WNU90         TO   MFEDINDO    CDFAMT6.        00556000
           IF        WNU90             =    ZEROS                       00557000
             MOVE    ZEROS             TO   CDFAMT6                     00558000
             MOVE    ALL '_'           TO   MFEDINDI.                   00559000
                                                                        00560000
040799     MOVE    ZEROS               TO   WNU90                       00529000
040799     IF      MCHRTRA             =    WABEOF                      00530000
040799       MOVE  ALL '_'             TO   MCHRTRI                     00531000
040799       MOVE  WABUNM              TO   MCHRTRA                     00532000
040799       MOVE  ZEROS               TO   CDFAMT7                     00533000
040799     ELSE                                                         00534000
040799       IF      MCHRTRL           >    ZEROS                       00535000
040799         MOVE  ZEROS             TO   MCHRTRL                     00536000
040799         MOVE  MCHRTRI           TO   WNUIN                       00537000
040799         PERFORM 700-CONVERT     THRU 700-EXIT                    00538000
040799         IF    WNUSIGN           =    '-'                         00539000
040799           COMPUTE WNU90         =    0 - WNU90                   00540000
040799           MOVE  WNU90           TO   MCHRTRO    CDFAMT7          00541000
040799           MOVE  WABUN           TO   MCHRTRA                     00542000
040799         ELSE                                                     00543000
040799           MOVE  WNU90           TO   MCHRTRO    CDFAMT7          00544000
040799           MOVE  WABUN           TO   MCHRTRA                     00545000
040799       ELSE                                                       00546000
040799         IF      MCHRTRI         >    LOW-VALUES                  00547000
040799           MOVE  WABUN           TO   MCHRTRA                     00548000
040799           MOVE  MCHRTRI         TO   WNUIN                       00549000
040799           PERFORM 700-CONVERT   THRU 700-EXIT                    00550000
040799           IF    WNUSIGN         =    '-'                         00551000
040799             COMPUTE WNU90       =    0 - WNU90                   00552000
040799             MOVE  WNU90         TO   MCHRTRO    CDFAMT7          00553000
040799             MOVE  WABUN         TO   MCHRTRA                     00554000
040799           ELSE                                                   00555000
040799             MOVE  WNU90         TO   MCHRTRO    CDFAMT7.         00556000
040799     IF        WNU90             =    ZEROS                       00557000
040799       MOVE    ZEROS             TO   CDFAMT7                     00558000
040799       MOVE    ALL '_'           TO   MCHRTRI.                    00559000
                                                                        00560000
           MOVE    ZEROS               TO   WNU011                      00561000
           IF      MTOTALA             =    WABEOF                      00562000
             MOVE  ALL '_'             TO   MTOTALI                     00563000
             MOVE  WABUNM              TO   MTOTALA                     00564000
             MOVE  ZEROS               TO   CDFTOTAL                    00565000
           ELSE                                                         00566000
             IF      MTOTALL           >    ZEROS                       00567000
               MOVE  ZEROS             TO   MTOTALL                     00568000
               MOVE  MTOTALI           TO   WNUIN                       00569000
               PERFORM 700-CONVERT     THRU 700-EXIT                    00570000
               IF    WNUSIGN           =    '-'                         00571000
                 COMPUTE WNU011        =    0 - WNU011                  00572000
                 MOVE  WNU011          TO   MTOTALO     CDFTOTAL        00573000
                 MOVE  WABUN           TO   MTOTALA                     00574000
               ELSE                                                     00575000
                 MOVE  WNU011          TO   MTOTALO     CDFTOTAL        00576000
                 MOVE  WABUN           TO   MTOTALA                     00577000
             ELSE                                                       00578000
               IF      MTOTALI         >    LOW-VALUES                  00579000
                 MOVE  WABUN           TO   MTOTALA                     00580000
                 MOVE  MTOTALI         TO   WNUIN                       00581000
                 PERFORM 700-CONVERT   THRU 700-EXIT                    00582000
                 IF    WNUSIGN         =    '-'                         00583000
                   COMPUTE WNU011      =    0 - WNU011                  00584000
                   MOVE  WNU011        TO   MTOTALO     CDFTOTAL        00585000
                   MOVE  WABUN         TO   MTOTALA                     00586000
                 ELSE                                                   00587000
                   MOVE  WNU011        TO   MTOTALO     CDFTOTAL.       00588000
           IF        WNU011            =    ZEROS                       00589000
             MOVE    ZEROS             TO   CDFTOTAL                    00590000
             MOVE    ALL '_'           TO   MTOTALI.                    00591000
                                                                        00592000
           MOVE    ZEROS               TO   RETERR                      00593000
                                                                        00594000
           SET     CDF1                TO   +1.                         00595000
       310-LOOP.                                                        00596000
           IF      CDFB         (CDF1) =    '_'                         00597000
             MOVE  ' '                 TO   CDFB         (CDF1).        00598000
           IF      CDF1                <    +94                         00599000
             SET   CDF1                UP   BY  +1                      00600000
             GO                        TO   310-LOOP.                   00601000
                                                                        00602000
           IF      CDFAMT1             =    ZEROS                       00603000
             MOVE  ALL '_'             TO   MRECRI.                     00604000
           IF      CDFAMT2             =    ZEROS                       00605000
             MOVE  ALL '_'             TO   MOTHRI.                     00606000
           IF      CDFAMT3             =    ZEROS                       00607000
             MOVE  ALL '_'             TO   MCAPI.                      00608000
           IF      CDFAMT4             =    ZEROS                       00609000
             MOVE  ALL '_'             TO   MCOMSRVI.                   00610000
           IF      CDFAMT5             =    ZEROS                       00611000
             MOVE  ALL '_'             TO   MDEBTI.                     00612000
           IF      CDFAMT6             =    ZEROS                       00613000
             MOVE  ALL '_'             TO   MFEDINDI.                   00614000
040799     IF      CDFAMT7             =    ZEROS                       00613000
040799       MOVE  ALL '_'             TO   MCHRTRI.                    00614000
           IF      CDFTOTAL            =    ZEROS                       00615000
             MOVE  ALL '_'             TO   MTOTALI.                    00616000
                                                                        00617000
           IF      CDFAMT1             <    ZEROS                       00618000
             MOVE  WABUMB              TO   MRECRA                      00619000
             MOVE  -1                  TO   MRECRL.                     00620000
           IF      CDFAMT2             <    ZEROS                       00621000
             MOVE  WABUMB              TO   MOTHRA                      00622000
             MOVE  -1                  TO   MOTHRL.                     00623000
           IF      CDFAMT3             <    ZEROS                       00624000
             MOVE  WABUMB              TO   MCAPA                       00625000
             MOVE  -1                  TO   MCAPL.                      00626000
           IF      CDFAMT4             <    ZEROS                       00627000
             MOVE  WABUMB              TO   MCOMSRVA                    00628000
             MOVE  -1                  TO   MCOMSRVL.                   00629000
           IF      CDFAMT5             <    ZEROS                       00630000
             MOVE  WABUMB              TO   MDEBTA                      00631000
             MOVE  -1                  TO   MDEBTL.                     00632000
           IF      CDFAMT6             <    ZEROS                       00633000
             MOVE  WABUMB              TO   MFEDINDA                    00634000
             MOVE  -1                  TO   MFEDINDL.                   00635000
040799     IF      CDFAMT7             <    ZEROS                       00633000
040799       MOVE  WABUMB              TO   MCHRTRA                     00634000
040799       MOVE  -1                  TO   MCHRTRL.                    00635000
           IF      CDFTOTAL            <    ZEROS                       00636000
             MOVE  WABUMB              TO   MTOTALA                     00637000
             MOVE  -1                  TO   MTOTALL.                    00638000
           IF      RETERR              NOT  =   ZEROS                   00639000
             MOVE  MSG03               TO   MMSGO                       00640000
             GO                        TO   015-SEND.                   00641000
           MOVE    -1                  TO   MFUNDL                      00642000
           IF      CDF                 =    ODF                         00643000
             MOVE  MSG15               TO   MMSGO                       00644000
             GO                        TO   015-SEND.                   00645000
           IF      RETCDF              =    '00'                        00646000
             MOVE  MSG17               TO   MMSGO                       00647000
             EXEC  CICS READ UPDATE         DATASET (CDFFIL)            00648000
                                            INTO    (ODF)               00649000
                                            RIDFLD  (CDFKEY)            00650000
                                            LENGTH  (CDFLENR)  END-EXEC 00651000
             EXEC  CICS REWRITE             DATASET (CDFFIL)            00652000
                                            FROM    (CDF)               00653000
                                            LENGTH  (CDFLENR)  END-EXEC 00654000
           ELSE                                                         00655000
             MOVE  MSG16               TO   MMSGO                       00656000
             EXEC  CICS WRITE               DATASET (CDFFIL)            00657000
                                            FROM    (CDF)               00658000
                                            RIDFLD  (CDFKEY)            00659000
                                            LENGTH  (CDFLENR)  END-EXEC.00660000
           GO                          TO   015-SEND.                   00661000
                                                                        00662000
      ******************************************************************00663000
           COPY                             EWNUMBP.                    00664000
      ******************************************************************00665000
       800-XCTL.                                                        00666000
           IF     (EIBAID              =    DFHCLEAR)                OR 00667000
                  (EIBAID              =    DFHPA1)                  OR 00668000
                  (EIBAID              =    DFHPA2)                     00669000
             MOVE  QWRMAP              TO   MPEW45O                     00670000
             MOVE  -1                  TO   MPANELL                     00671000
             MOVE  +10                 TO   EIBCALEN                    00672000
             GO                        TO   015-SEND.                   00673000
           MOVE    QWRWCM              TO   WCM                         00674000
           PERFORM 010-RECEIVE         THRU 010-EXIT                    00675000
                                                                        00676000
           IF      EIBAID              =    DFHPF1                      00677000
             MOVE  WCMXFFR             TO   WCMXFHLD                    00678000
             MOVE  EIBCPOSN            TO   WCMXFCRS9     WCMXFPOS9     00679000
             MOVE  'CZ02'              TO   WCMXFTO                     00680000
             GO                        TO   805-XCTL.                   00681000
           IF     (EIBAID              =    DFHPF7)                  OR 00682000
                  (EIBAID              =    DFHPF8)                     00683000
             GO                        TO   815-PAGE.                   00684000
           IF      EIBAID              =    DFHPF10                     00685000
             GO                        TO   300-UPDATE.                 00686000
           IF      EIBAID              =    DFHPF12                     00687000
             MOVE  SPACES              TO   WCMXFHLD                    00688000
             MOVE  'C   '              TO   WCMXFTO                     00689000
           ELSE                                                         00690000
             IF      EIBAID            =    DFHPF3
      *00691000
               MOVE  SPACES            TO   WCMXFHLD                    00692000
               MOVE  'CB  '            TO   WCMXFTO                     00693000
             ELSE                                                       00694000
               MOVE  QWRMAP            TO   MPEW45O                     00695000
               MOVE  +10               TO   EIBCALEN                    00696000
               MOVE  -1                TO   MFUNDL                      00697000
               GO                      TO   015-SEND.                   00698000
       805-XCTL.                                                        00699000
           MOVE    'C'                 TO   WCMXFTS                     00700000
           MOVE    WCM                 TO   QWRWCM                      00701000
           EXEC    CICS HANDLE CONDITION    DUPREC  (810-END)  END-EXEC 00702000
           IF      RETQWR              NOT  =   '00'                    00703000
             EXEC  CICS WRITE               DATASET (QWRFIL)            00704000
                                            FROM    (QWR)               00705000
                                            RIDFLD  (QWRKEY)            00706000
                                            LENGTH  (QWRLENR)  END-EXEC 00707000
           ELSE                                                         00708000
             EXEC  CICS READ UPDATE         DATASET (QWRFIL)            00709000
                                            INTO    (QWRI)              00710000
                                            RIDFLD  (QWRKEY)            00711000
                                            LENGTH  (QWRLENR)  END-EXEC 00712000
             EXEC  CICS REWRITE             DATASET (QWRFIL)            00713000
                                            FROM    (QWR)               00714000
                                            LENGTH  (QWRLENR)  END-EXEC.00715000
       810-END.                                                         00716000
           MOVE    'CB05'              TO   WCMXFFR                     00717000
           EXEC    CICS XCTL                PROGRAM ('EW02')            00718000
                                            COMMAREA(WCM)               00719000
                                            LENGTH  (220)      END-EXEC.00720000
                                                                        00721000
      ******************************************************************00722000
       815-PAGE.                                                        00723000
           MOVE    WCMSODIST           TO   CDFKEY                      00724000
           MOVE    WCMSOFY             TO   CDFFY                       00725000
           MOVE    NEWFUND             TO   CDFFUND.                    00726000
       820-RETRY.                                                       00727000
           EXEC    CICS HANDLE CONDITION    NOTFND  (835-NONE)          00728000
                                            INVREQ  (835-NONE)          00729000
                                            ENDFILE (835-NONE) END-EXEC 00730000
           IF      EIBAID              =    DFHPF7                      00731000
             MOVE  LOW-VALUES          TO   CDFTABLE CDFSCHL CDFCONTROL 00732000
             MOVE  CDFKEY              TO   ODFKEY                      00733000
             EXEC  CICS STARTBR             DATASET (CDFFIL)            00734000
                                            RIDFLD  (CDFKEY)   GTEQ     00735000
                                            KEYLENGTH(CDFLENK) END-EXEC 00736000
             EXEC  CICS HANDLE CONDITION    NOTFND  (840-NONE) END-EXEC 00737000
             EXEC  CICS READPREV            DATASET (CDFFIL)            00738000
                                            INTO    (CDF)               00739000
                                            RIDFLD  (CDFKEY)            00740000
                                            LENGTH  (CDFLENR)  END-EXEC 00741000
           ELSE                                                         00742000
             MOVE  HIGH-VALUES         TO   CDFTABLE CDFSCHL CDFCONTROL 00743000
             MOVE  CDFKEY              TO   ODFKEY                      00744000
             EXEC  CICS STARTBR             DATASET (CDFFIL)            00745000
                                            RIDFLD  (CDFKEY)   GTEQ     00746000
                                            KEYLENGTH(CDFLENK) END-EXEC.00747000
             EXEC  CICS READNEXT            DATASET (CDFFIL)            00748000
                                            INTO    (CDF)               00749000
                                            RIDFLD  (CDFKEY)            00750000
                                            LENGTH  (CDFLENR)  END-EXEC.00751000
           EXEC    CICS HANDLE CONDITION    ENDFILE (835-NONE) END-EXEC 00752000
           IF      CDFKEY              =    ODFKEY                      00753000
             IF      EIBAID            =    DFHPF7                      00754000
               EXEC  CICS READPREV          DATASET (CDFFIL)            00755000
                                            INTO    (CDF)               00756000
                                            RIDFLD  (CDFKEY)            00757000
                                            LENGTH  (CDFLENR)  END-EXEC 00758000
             ELSE                                                       00759000
               EXEC  CICS READNEXT          DATASET (CDFFIL)            00760000
                                            INTO    (CDF)               00761000
                                            RIDFLD  (CDFKEY)            00762000
                                            LENGTH  (CDFLENR)  END-EXEC.00763000
       825-PF7M.                                                        00764000
           EXEC    CICS ENDBR               DATASET (CDFFIL)   END-EXEC 00765000
           IF     (CDFDIST             NOT  =   WCMSODIST)           OR 00766000
                  (CDFFY               NOT  =   WCMSOFY)                00767000
             GO                        TO   835-NONE.                   00768000
           MOVE    CDFFUND             TO   NEWFUND                     00769000
           GO                          TO   100-DISPLAY.                00770000
       835-NONE.                                                        00771000
           MOVE    -1                  TO   MFUNDL                      00772000
           IF      EIBAID              =    DFHPF7                      00773000
             MOVE  MSG13               TO   MMSGO                       00774000
           ELSE                                                         00775000
             MOVE  MSG14               TO   MMSGO.                      00776000
           GO                          TO   015-SEND.                   00777000
       840-NONE.                                                        00778000
           EXEC    CICS READNEXT            DATASET (CDFFIL)            00779000
                                            INTO    (CDF)               00780000
                                            RIDFLD  (CDFKEY)            00781000
                                            LENGTH  (CDFLENR)  END-EXEC 00782000
           EXEC    CICS READPREV            DATASET (CDFFIL)            00783000
                                            INTO    (CDF)               00784000
                                            RIDFLD  (CDFKEY)            00785000
                                            LENGTH  (CDFLENR)  END-EXEC 00786000
           EXEC    CICS READPREV            DATASET (CDFFIL)            00787000
                                            INTO    (CDF)               00788000
                                            RIDFLD  (CDFKEY)            00789000
                                            LENGTH  (CDFLENR)  END-EXEC 00790000
           GO                          TO   825-PF7M.                   00791000
                                                                        00792000
      ******************************************************************00793000
       850-CALLED.                                                      00794000
           MOVE    DFHCOMMAREA         TO   WCM                         00795000
           IF      WCMXFFR             =    'CZ02'                      00796000
             MOVE  WCMXFHLD            TO   WCMXFFR                     00797000
             MOVE  WCMXFCRS9           TO   EIBCPOSN                    00798000
             MOVE  1234                TO   EIBCALEN                    00799000
             MOVE  QWRMAP              TO   MPEW45O                     00800000
             GO                        TO   015-SEND.                   00801000
           IF      WCMRETCD            NOT  =   'G'                     00802000
             GO                        TO   900-SECURITY.               00803000
           MOVE    SPACES              TO   NEWKEY                      00804000
           GO                          TO   100-DISPLAY.                00805000
                                                                        00806000
      ******************************************************************00807000
       900-SECURITY.                                                    00808000
           MOVE    ZEROS               TO   EIBCALEN                    00809000
           MOVE    WCMXFHLD            TO   WCMXFFR                     00810000
           MOVE    1234                TO   EIBCALEN                    00811000
           MOVE    +14                 TO   EIBCPOSN                    00812000
           MOVE    QWRMAP              TO   MPEW45O                     00813000
           MOVE    WCMXFTPNL           TO   MPANELO                     00814000
           MOVE    WABUMB              TO   MPANELA                     00815000
           IF      WCMRETCD            =    'S'                         00816000
             MOVE  MSG90               TO   MMSGO                       00817000
           ELSE                                                         00818000
             IF      WCMRETCD          =    'T'                         00819000
               MOVE  MSG91             TO   MMSGO                       00820000
             ELSE                                                       00821000
               IF     (WCMRETCD        =    'U')                     OR 00822000
                      (WCMRETCD        =    'N')                        00823000
                 MOVE  MSG92           TO   MMSGO                       00824000
               ELSE                                                     00825000
                 IF      WCMRETCD      =    'D'                         00826000
                   MOVE  MSG93         TO   MMSGO.                      00827000
           GO                          TO   015-SEND.                   00828000
       901-ERROR.                                                       00829000
           MOVE    -1                  TO   MPANELL                     00830000
           MOVE    MSG94               TO   MMSGO                       00831000
           GO                          TO   015-SEND.                   00832000
       902-NOSPACE.                                                     00833000
           MOVE    MSG95               TO   MMSGO                       00834000
           MOVE    -1                  TO   MPANELL                     00835000
           GO                          TO   015-SEND.                   00836000
       903-INVREQ.                                                      00837000
           MOVE    MSG96               TO   MMSGO                       00838000
           MOVE    -1                  TO   MPANELL                     00839000
           GO                          TO   015-SEND.                   00840000
       904-NOTOPEN.                                                     00841000
           MOVE    MSG97               TO   MMSGO                       00842000
           MOVE    -1                  TO   MPANELL                     00843000
           GO                          TO   015-SEND.                   00844000
       905-DSIDERR.                                                     00845000
           MOVE    MSG97               TO   MMSGO                       00846000
           MOVE    -1                  TO   MPANELL                     00847000
           GO                          TO   015-SEND.                   00848000
           GOBACK.                                                      00849000
