       IDENTIFICATION DIVISION.                                                 
       PROGRAM-ID.    EW26.                                                     
       AUTHOR.        DOE.                                                      
      ******************************************************************        
      *                         ATTRIBUTION FACTORS                    *        
      ******************************************************************        
      * DATE CREATED:  06/30/95                                        *    0011
      ******************************************************************        
      * CALL #  - MMDDYY - PURPOSE                                     *        
      * 001 - 05/15/96 - CORRECT MAP ALIGNMENT PROBLEM.            MBA *        
      * 2004001 - 053105 - PREVENT UPDATES TO CHARTER SCHOOLS          *        
      ******************************************************************        
                                                                                
       ENVIRONMENT DIVISION.                                                    
       CONFIGURATION SECTION.                                                   
       DATA DIVISION.                                                           
                                                                                
       WORKING-STORAGE SECTION.                                                 
                                                                                
       01            WSC.                                                       
           05        WSCMAPLEN         PIC S9(04) COMP SYNC VALUE +0946.        
           05        WSCMAXRD          PIC S9(04) COMP SYNC VALUE +300.         
           05        WSCRDCNT          PIC S9(04) COMP SYNC VALUE +0.           
           05        WSCLNCNT          PIC S9(02) COMP.                         
           05        WSCLNINC          PIC S9(02) COMP.                         
           05        WSCLNMAX          PIC S9(02) COMP.                         
           05        WSCRAT            PIC S9(03)V9(01)   COMP.                 
           05        WSCACT            PIC  X(01)  VALUE  SPACES.               
           05        HGH.                                                       
             10      HGHDIST           PIC  X(02).                              
             10      HGHFY             PIC  X(02).                              
             10      HGHSCHL           PIC  X(04).                              
             10      HGHPGM            PIC  X(03).                              
                                                                                
       01            WSK.                                                       
           05        NEWKEY.                                                    
             10      NEWSCHL           PIC  X(04).                              
           05        NEWPANEL.                                                  
             10      NEWPANEL1         PIC  X(01).                              
             10      NEWPANEL2         PIC  X(02).                              
           05        OLDKEY            PIC  X(04).                              
       01            NEWR       REDEFINES   WSK.                                
           05        NEWB       OCCURS 007  TIMES  INDEXED BY NEW1              
                                       PIC  X(01).                              
                                                                                
       01            RET.                                                       
           05        RETALL            PIC  X(02).                              
           05        RETQWR            PIC  X(02).                              
           05        RETCRF            PIC  X(02).                              
           05        RETABF            PIC  X(02).                              
           05        RETERR            PIC S9(01).                              
           05        RETERR2           PIC S9(01).                              
                                                                                
       01            MSG.                                                       
           05        MSG01             PIC  X(35) VALUE                         
                     'District is not authorized.  EXIT.'.                      
           05        MSG03             PIC  X(37) VALUE                         
                     'Highlighted elements in error. Retry.'.                   
           05        MSG13             PIC  X(28) VALUE                         
                     'No previous records.  Next ?'.                            
           05        MSG14             PIC  X(30) VALUE                         
                     'No additional records.  Next ?'.                          
           05        MSG15             PIC  X(28) VALUE                         
                     'Record(s) unchanged.  Next ?'.                            
           05        MSG17             PIC  X(26) VALUE                         
                     'Record(s) updated.  Next ?'.                              
           05        MSG18             PIC  X(40) VALUE                         
                     'Please type key element(s).  Then ENTER.'.                
           05        MSG20             PIC  X(17) VALUE                         
                     'Records deleted. '.                                       
           05        MSG21             PIC  X(35) VALUE                         
                     'Not on file. Not update authorized.'.                     
           05        MSG22             PIC  X(38) VALUE                         
                     'Records displayed for inquiry.  Next ?'.                  
           05        MSG23             PIC  X(40) VALUE                         
                     'Not on file.  Type data to add or retry.'.                
           05        MSG25             PIC  X(22) VALUE                         
                     'Page full.  Continue ?'.                                  
           05        MSG26             PIC  X(25) VALUE                         
                     'No records found.  Next ?'.                               
           05        MSG27             PIC  X(29) VALUE                         
                     'Record limit met.  Continue ?'.                           
           05        MSG28             PIC  X(35) VALUE                         
                     'No record on line selected.  Next ?'.                     
           05        MSG29             PIC  X(28) VALUE                         
                     'No record to delete.  Next ?'.                            
           05        MSG33             PIC  X(37) VALUE                         
                     'Panel cleared.  Enter new records.'.                      
           05        MSG90             PIC  X(35) VALUE                         
                     'Not authorized for panel requested.'.                     
           05        MSG91             PIC  X(32) VALUE                         
                     'Not authorized at this terminal.'.                        
           05        MSG92             PIC  X(35) VALUE                         
                     'Panel unknown/not installed. Retry.'.                     
           05        MSG93             PIC  X(39) VALUE                         
                     'Panel temporarily disabled.  Try later.'.                 
           05        MSG94             PIC  X(41) VALUE                         
                     'Unknown system error. Request assistance.'.               
           05        MSG95             PIC  X(35) VALUE                         
                     'Database error. Request assistance.'.                     
           05        MSG96             PIC  X(42) VALUE                         
                     'Program error(INVREQ). Request assistance.'.              
           05        MSG97             PIC  X(30) VALUE                         
                     'Database closed.  Retry later.'.                          
                                                                                
           COPY                             EWQWRC.                             
           COPY                             EWCRFC.                             
           COPY                             EWABFC.                             
                                                                                
           COPY                             EWQWR.                              
           05        QWRMAPR     REDEFINES  QWRMAP.                             
             10      FILLER            PIC  X(0025).                            
             10      QWRLINES          PIC  X(1520).                            
                                                                                
           COPY                             EWQWRI.                             
           COPY                             EWNUMBW.                            
           COPY                             EWSCL.                              
           COPY                             EWFPG.                              
           COPY                             EWABF.                              
                                                                                
       01            OBF.                                                       
           05        OBFKEY                 PIC  X(11).                         
           05        OBFDATA                PIC  X(49).                         
                                                                                
           COPY                             EWWCM.                              
           COPY                             DFHAID.                             
           COPY                             EWWAB.                              
                                                                                
           COPY                             MPEW26.                             
       01            MPEW26R     REDEFINES  MPEW26I.                            
           05        MAPBYTE        OCCURS  0946  TIMES INDEXED BY MAP1.        
             10      FILLER            PIC  X(01).                              
       01            MPEW26L     REDEFINES  MPEW26I.                            
051596*    05        FILLER            PIC  X(25).                              
051596     05        FILLER            PIC  X(26).                              
           05        MPSLINES.                                                  
             10      MPSLINE        OCCURS  014   TIMES INDEXED BY MPS2.        
               15    MPSPGML           PIC S9(04)       COMP.                   
               15    MPSPGMA           PIC  X(01).                              
               15    MPSPGM            PIC  X(03).                              
               15    MPSSTDTL          PIC S9(04)       COMP.                   
               15    MPSSTDTA          PIC  X(01).                              
               15    MPSSTDT.                                                   
                 20  MPSSTDT9          PIC  ZZ,ZZZ.ZZ.                          
               15    MPSSTAFFL         PIC S9(04)       COMP.                   
               15    MPSSTAFFA         PIC  X(01).                              
               15    MPSSTAFF.                                                  
                 20  MPSSTAFF9         PIC  Z,ZZZ.ZZZ.                          
               15    MPSSPACEL         PIC S9(04)       COMP.                   
               15    MPSSPACEA         PIC  X(01).                              
               15    MPSSPACE.                                                  
                 20  MPSSPACE9         PIC  ZZZ,ZZZ.                            
               15    MPSRATL           PIC S9(04)       COMP.                   
               15    MPSRATA           PIC  X(01).                              
               15    MPSRAT.                                                    
                 20  MPSRAT9           PIC  ZZ9.9.                              
               15    MPSRANGEL         PIC S9(04)       COMP.                   
               15    MPSRANGEA         PIC  X(01).                              
               15    MPSFROM.                                                   
                 20  MPSFROM9          PIC  Z9.9.                               
               15    MPSMSG            PIC  X(03).                              
               15    MPSTO.                                                     
                 20  MPSTO9            PIC  Z9.9.                               
           05        FILLER            PIC  X(53).                              
                                                                                
       LINKAGE SECTION.                                                         
                                                                                
       01  DFHCOMMAREA                 PIC  X(220).                             
                                                                                
       PROCEDURE DIVISION.                                                      
      ******************************************************************        
                                                                                
       000-CONTROL.                                                             
           MOVE    SPACES              TO   WSK           WCM                   
           MOVE    LOW-VALUES          TO   MPEW26O                             
           EXEC    CICS HANDLE CONDITION    MAPFAIL  (100-DISPLAY)              
                   ERROR   (901-ERROR)      NOSPACE  (902-NOSPACE)              
                   INVREQ  (903-INVREQ)     NOTOPEN  (904-NOTOPEN)              
                   DSIDERR (905-DSIDERR)    END-EXEC                            
           MOVE    EIBTRMID            TO   QWRTRMID                            
           MOVE    'EW26'              TO   QWRPGM                              
           MOVE    '99'                TO   RETQWR                              
           EXEC    CICS HANDLE CONDITION    NOTFND  (005-NEW) END-EXEC          
           EXEC    CICS READ                DATASET (QWRFIL)                    
                                            INTO    (QWR)                       
                                            RIDFLD  (QWRKEY)                    
                                            LENGTH  (QWRLENR)  END-EXEC         
           MOVE    '00'                TO   RETQWR.                             
       005-NEW.                                                                 
           IF      RETQWR              NOT  =   '00'                            
             MOVE  QWRKEY              TO   QWRIKEY                             
             MOVE  QWRI                TO   QWR                                 
             MOVE  DFHCOMMAREA         TO   WCM                                 
             MOVE  ZEROS               TO   WCMXFCRS9     WCMXFPOS9             
             MOVE  HIGH-VALUES         TO   OLDKEY                              
           ELSE                                                                 
             MOVE  QWRWCM              TO   WCM                                 
             MOVE  QWROLD              TO   OLDKEY.                             
                                                                                
           MOVE    WCMSODISTA          TO   CRFFILDS      ABFFILDS              
           MOVE    QWROLD              TO   NEWKEY                              
                                                                                
           IF      EIBCALEN            >    ZEROS                               
             GO                        TO   850-CALLED.                         
           IF      EIBAID              NOT  =   DFHENTER                        
             GO                        TO   800-XCTL.                           
                                                                                
           PERFORM 010-RECEIVE         THRU 010-EXIT                            
           IF      NEWPANEL            NOT  =   SPACES                          
             MOVE  NEWPANEL            TO   WCMXFTPNL                           
             GO                        TO   805-XCTL.                           
           IF      NEWKEY              NOT  =   OLDKEY                          
             GO                        TO   100-DISPLAY                         
           ELSE                                                                 
             GO                        TO   300-UPDATE.                         
                                                                                
      ******************************************************************        
       010-RECEIVE.                                                             
           EXEC    CICS RECEIVE             MAP    ('MPEW26')  END-EXEC         
           MOVE    EIBCPOSN            TO   WCMXFCRS9                           
           SET     MAP1  QWR1          TO   +1.                                 
       010-LOOP1.                                                               
           IF     (MAPBYTE      (MAP1) NOT  =   LOW-VALUES)          AND        
                  (MAPBYTE      (MAP1) NOT  =   HIGH-VALUES)                    
             MOVE  MAPBYTE      (MAP1) TO   QWRBYTE      (QWR1).                
           IF      MAP1                <    WSCMAPLEN                           
             SET   MAP1  QWR1          UP   BY  +1                              
             GO                        TO   010-LOOP1.                          
           MOVE    QWRMAP              TO   MPEW26O                             
                                                                                
           MOVE    SPACES              TO   NEWKEY                              
           IF      MPANELA             =    WABEOF                              
             MOVE  WABUM               TO   MPANELA                             
             MOVE  ALL '_'             TO   MPANELO       NEWPANEL              
           ELSE                                                                 
             IF      MPANELL           >    ZEROS                               
               MOVE  MPANELI           TO   NEWPANEL                            
               MOVE  WABUM             TO   MPANELA                             
             ELSE                                                               
               IF      MPANELI         >    LOW-VALUES                          
                 MOVE  MPANELI         TO   NEWPANEL.                           
           IF      MSCHLA              =    WABEOF                              
             MOVE  WABUM               TO   MSCHLA                              
             MOVE  ALL '_'             TO   MSCHLO                              
           ELSE                                                                 
             IF      MSCHLL            >    ZEROS                               
               MOVE  ZEROS             TO   MSCHLL                              
               MOVE  MSCHLI            TO   NEWSCHL                             
               MOVE  WABUM             TO   MSCHLA                              
             ELSE                                                               
               IF      MSCHLI          >    LOW-VALUES                          
                 MOVE  WABUM           TO   MSCHLA                              
                 MOVE  MSCHLI          TO   NEWSCHL.                            
                                                                                
           SET     NEW1                TO   +1.                                 
       010-LOOP2.                                                               
           IF      NEWB         (NEW1) =    '_'                                 
             MOVE  ' '                 TO   NEWB         (NEW1).                
           IF      NEW1                <    +7                                  
             SET   NEW1                UP   BY  +1                              
             GO                        TO   010-LOOP2.                          
       010-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       015-SEND.                                                                
           MOVE    EIBTRMID            TO   QWRTRMID                            
           MOVE    'EW26'              TO   QWRPGM                              
           MOVE    OLDKEY              TO   QWROLD                              
           MOVE    WCM                 TO   QWRWCM                              
           MOVE    MPEW26O             TO   QWRMAP                              
           EXEC    CICS HANDLE CONDITION    DUPREC  (015-ERR) END-EXEC          
           IF      RETQWR              NOT  =   '00'                            
             EXEC  CICS WRITE               DATASET (QWRFIL)                    
                                            FROM    (QWR)                       
                                            RIDFLD  (QWRKEY)                    
                                            LENGTH  (QWRLENR)  END-EXEC         
           ELSE                                                                 
             EXEC  CICS READ UPDATE         DATASET (QWRFIL)                    
                                            INTO    (QWRI)                      
                                            RIDFLD  (QWRKEY)                    
                                            LENGTH  (QWRLENR)  END-EXEC         
             EXEC  CICS REWRITE             DATASET (QWRFIL)                    
                                            FROM    (QWR)                       
                                            LENGTH  (QWRLENR)  END-EXEC.        
       015-ERR.                                                                 
           IF      EIBCALEN            =    ZEROS                               
             EXEC  CICS SEND                MAP     ('MPEW26') DATAONLY         
                                            CURSOR             END-EXEC         
           ELSE                                                                 
             IF      EIBCALEN          NOT  =   1234                            
               EXEC  CICS SEND              MAP     ('MPEW26') ERASE            
                                            CURSOR             END-EXEC         
             ELSE                                                               
               EXEC  CICS SEND              MAP     ('MPEW26') ERASE            
                                            CURSOR  (EIBCPOSN) END-EXEC.        
           EXEC CICS RETURN                 TRANSID ('EW26')   END-EXEC.        
                                                                                
      ******************************************************************        
       100-DISPLAY.                                                             
           MOVE    SPACES              TO   RETALL                              
           MOVE    HIGH-VALUES         TO   OLDKEY                              
           MOVE    LOW-VALUES          TO   MPEW26O       QWRMAP                
           MOVE    +10                 TO   EIBCALEN                            
           MOVE    +1                  TO   RETERR2                             
           MOVE    ZEROS               TO   RETERR                              
           SET     NEW1                TO   +1.                                 
       100-LOOP1.                                                               
           IF      NEWB         (NEW1) =    ' '                                 
             MOVE  '_'                 TO   NEWB         (NEW1).                
           IF      NEW1                <    +7                                  
             SET   NEW1                UP   BY  +1                              
             GO                        TO   100-LOOP1.                          
           MOVE    NEWPANEL            TO   MPANELO                             
           MOVE    NEWSCHL             TO   MSCHLO                              
           SET     NEW1                TO   +1.                                 
       100-LOOP2.                                                               
           IF      NEWB         (NEW1) =    '_'                                 
             MOVE  ' '                 TO   NEWB         (NEW1).                
           IF      NEW1                <    +7                                  
             SET   NEW1                UP   BY  +1                              
             GO                        TO   100-LOOP2.                          
                                                                                
           IF      NEWSCHL             =    SPACES                              
             MOVE  -1                  TO   MSCHLL                              
             MOVE  MSG18               TO   MMSGO                               
             GO                        TO   015-SEND.                           
                                                                                
           MOVE    WCMSODIST           TO   SCLKEY                              
           MOVE    WCMSOFY             TO   SCLFY                               
           MOVE    'SCL'               TO   SCLPREF                             
           MOVE    NEWSCHL             TO   SCLSCL                              
           MOVE    '99'                TO   RETCRF                              
           EXEC    CICS HANDLE CONDITION    NOTFND  (105-ERR) END-EXEC          
           EXEC    CICS READ                DATASET (CRFFIL)                    
                                            INTO    (SCL)                       
                                            RIDFLD  (SCLKEY)                    
                                            LENGTH  (CRFLENR)  END-EXEC         
           MOVE    '00'                TO   RETCRF.                             
       105-ERR.                                                                 
053105*    IF      RETCRF              NOT  =   '00'                            
053105     IF      RETCRF              NOT  =   '00'              OR            
053105             SCLCHRTR            =    'Y'                                 
             MOVE  WABUMB              TO   MSCHLA                              
             MOVE  -1                  TO   MSCHLL        RETERR.               
                                                                                
           IF      RETERR              NOT  =   ZEROS                           
             MOVE  MSG03               TO   MMSGO                               
             GO                        TO   015-SEND.                           
                                                                                
           MOVE    NEWKEY              TO   OLDKEY                              
                                                                                
           MOVE    SPACES              TO   QWRPF7        QWRPF8                
           MOVE    SPACES              TO   QWRFRST                             
           MOVE    +0                  TO   WSCLNCNT                            
           MOVE    +1                  TO   WSCLNINC                            
           MOVE    +15                 TO   WSCLNMAX                            
           MOVE    WCMSODIST           TO   ABFKEY                              
           MOVE    WCMSOFY             TO   ABFFY                               
           MOVE    NEWSCHL             TO   ABFSCHL                             
           EXEC    CICS HANDLE CONDITION    NOTFND  (015-SEND)                  
                                            END-EXEC                            
           EXEC    CICS STARTBR             DATASET (ABFFIL)                    
                                            RIDFLD  (ABFKEY)   GTEQ             
                                            KEYLENGTH (ABFLENK)                 
                                            END-EXEC.                           
       110-OLD.                                                                 
           MOVE    -1                  TO   MSCHLL                              
           MOVE    LOW-VALUES          TO   MPSLINES                            
           MOVE    WCMSODIST           TO   HGHDIST                             
           MOVE    WCMSOFY             TO   HGHFY                               
           MOVE    NEWSCHL             TO   HGHSCHL                             
           MOVE    HIGH-VALUES         TO   HGHPGM                              
           MOVE    +0                  TO   WSCRDCNT                            
           MOVE    WSCLNINC            TO   QWRLNINC                            
           SET     MPS2                TO   WSCLNCNT                            
           SET     MPS2                UP   BY   WSCLNINC.                      
           EXEC    CICS HANDLE CONDITION    INVREQ  (120-MISS)                  
                                            NOTFND  (120-MISS)                  
                                            ENDFILE (120-MISS) END-EXEC.        
       115-LOOP.                                                                
           IF      MPS2                =    WSCLNMAX                            
             GO                        TO   130-FULL.                           
           IF      WSCRDCNT            >    WSCMAXRD                            
             GO                        TO   135-MAXRCD.                         
           MOVE    '99'                TO   RETABF                              
           IF      WSCLNINC            =    -1                                  
             EXEC  CICS READPREV            DATASET (ABFFIL)                    
                                            INTO    (ABF)                       
                                            RIDFLD  (ABFKEY)                    
                                            LENGTH  (ABFLENR)  END-EXEC         
           ELSE                                                                 
             EXEC  CICS READNEXT            DATASET (ABFFIL)                    
                                            INTO    (ABF)                       
                                            RIDFLD  (ABFKEY)                    
                                            LENGTH  (ABFLENR)  END-EXEC.        
           MOVE    '00'                TO   RETABF.                             
       120-MISS.                                                                
           IF      RETABF              NOT  =   '00'                            
             GO                        TO   130-LAST.                           
           ADD     +1                  TO   WSCRDCNT                            
           IF     (WSCLNINC            =    +1)                     AND         
                  (ABFKEY              >    HGH)                                
             GO                        TO   130-LAST.                           
           IF     (WSCLNINC            =    -1)                      AND        
                  (MPS2                =    +14)                                
             MOVE  ABFKEY              TO   QWRPF8                              
           ELSE                                                                 
             IF      MPS2              =    +1                                  
               MOVE  ABFKEY            TO   QWRPF7                              
               IF      QWRFRST         =    SPACES                              
                 MOVE  ABFKEY          TO   QWRFRST.                            
           IF      RETABF              =    '00'                                
             MOVE  RETABF              TO   RETALL.                             
                                                                                
           MOVE    WABPS               TO   MPSPGMA      (MPS2)                 
           MOVE    ABFPGM              TO   MPSPGM       (MPS2)                 
           MOVE    ABFSTDT             TO   MPSSTDT9     (MPS2)                 
           MOVE    ABFSTAFF            TO   MPSSTAFF9    (MPS2)                 
           MOVE    ABFSPACE            TO   MPSSPACE9    (MPS2)                 
           IF      ABFSTDT             =    ZEROS                               
             MOVE  '__,___.__'         TO   MPSSTDT      (MPS2).                
           IF      ABFSTAFF            =    ZEROS                               
             MOVE  '_,___.___'         TO   MPSSTAFF     (MPS2).                
           IF      ABFSPACE            =    ZEROS                               
             MOVE  '___,___'           TO   MPSSPACE     (MPS2).                
                                                                                
           MOVE    WCMSODIST           TO   FPGKEY                              
           MOVE    WCMSOFY             TO   FPGFY                               
           MOVE    'FPG'               TO   FPGPREF                             
           MOVE    ABFPGM              TO   FPGFPG                              
           MOVE    '99'                TO   RETCRF                      06810000
           EXEC    CICS HANDLE CONDITION    NOTFND  (120-ERR) END-EXEC  06830000
           EXEC    CICS READ                DATASET (CRFFIL)            06840000
                                            INTO    (FPG)               06850000
                                            RIDFLD  (FPGKEY)            06860000
                                            LENGTH  (CRFLENR)  END-EXEC 06870000
           MOVE    '00'                TO   RETCRF.                     07350000
       120-ERR.                                                         07360000
           IF      RETCRF              NOT  =  '00'                             
             MOVE  ZEROS               TO   FPGSTDTFR   FPGSTDTTO.              
           IF     (ABFSTDT             NOT  =  ZERO)                AND         
                  (ABFSTAFF            NOT  =  ZERO)                            
             COMPUTE WSCRAT  ROUNDED   =    ABFSTDT  /  ABFSTAFF                
           ELSE                                                                 
             MOVE    ZERO              TO   WSCRAT.                             
           MOVE    WSCRAT              TO   MPSRAT9   (MPS2)                    
           MOVE    FPGSTDTFR           TO   MPSFROM9  (MPS2)                    
           MOVE    ' -'                TO   MPSMSG    (MPS2)                    
           MOVE    FPGSTDTTO           TO   MPSTO9    (MPS2)                    
                                                                                
           SET     MPS2                UP   BY  WSCLNINC                        
           ADD     WSCLNINC            TO   WSCLNCNT                            
           GO                          TO   115-LOOP.                           
                                                                                
       130-FULL.                                                                
           IF      WSCLNINC            =    +1                                  
             PERFORM 210-ABF-RDNXT     THRU 210-EXIT                            
             IF     (ABFKEY            >    HGH)                     OR         
                    (RETABF            NOT  =   '00')                           
               GO                      TO   130-LAST                            
             ELSE                                                               
               PERFORM 205-ABF-RDPRV   THRU 205-EXIT                            
               PERFORM 205-ABF-RDPRV   THRU 205-EXIT.                           
           MOVE    MSG25               TO   MMSGO                               
           IF      WSCLNINC            =    +1                                  
             MOVE  +0                  TO   QWRLNXT                             
             MOVE  +15                 TO   QWRLNMAX                            
             MOVE  ABFKEY              TO   QWRPF8                              
           ELSE                                                                 
             MOVE  +15                 TO   QWRLNXT                             
             MOVE  +0                  TO   QWRLNMAX.                           
           GO                          TO   140-END.                            
                                                                                
       130-LAST.                                                                
           MOVE    +0                  TO   QWRLNMAX      QWRLNXT               
           MOVE    -1                  TO   MSCHLL                              
           IF      QWRFRST             =    SPACES                              
             IF    RETALL              =    '00'                                
               MOVE  ZEROS             TO   M1PGML                              
               MOVE  MSG14             TO   MMSGO                               
             ELSE                                                               
               MOVE  ZEROS             TO   MSCHLL                              
               MOVE  -1                TO   M1PGML                              
               MOVE  MSG23             TO   MMSGO                               
           ELSE                                                                 
             IF      WSCLNINC          =    -1                                  
               MOVE  MSG13             TO   MMSGO                               
               MOVE  SPACES            TO   QWRPF7                              
             ELSE                                                               
               MOVE  MSG14             TO   MMSGO                               
               MOVE  SPACES            TO   QWRPF8.                             
           GO                          TO   140-END.                            
                                                                                
       135-MAXRCD.                                                              
           MOVE    WSCLNCNT            TO   QWRLNXT                             
           MOVE    WSCLNMAX            TO   QWRLNMAX                            
           IF      WSCLNINC            =    +1                                  
             MOVE  ABFKEY              TO   QWRPF8                              
           ELSE                                                                 
             MOVE  ABFKEY              TO   QWRPF7.                             
           MOVE    MSG27               TO   MMSGO.                              
                                                                                
       140-END.                                                                 
           EXEC    CICS HANDLE CONDITION    INVREQ  (015-SEND) END-EXEC         
           EXEC    CICS ENDBR               DATASET (ABFFIL)   END-EXEC         
           GO                          TO   015-SEND.                           
                                                                                
      ******************************************************************        
       205-ABF-RDPRV.                                                           
           MOVE    '99'                TO   RETABF                              
           EXEC    CICS HANDLE CONDITION    INVREQ  (205-EXIT)                  
                                            NOTFND  (205-EXIT)                  
                                            ENDFILE (205-EXIT) END-EXEC         
           EXEC    CICS READPREV            DATASET (ABFFIL)                    
                                            INTO    (ABF)                       
                                            RIDFLD  (ABFKEY)                    
                                            LENGTH  (ABFLENR)  END-EXEC         
           MOVE    '00'                TO   RETABF.                             
       205-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       210-ABF-RDNXT.                                                           
           MOVE    '99'                TO   RETABF                              
           EXEC    CICS HANDLE CONDITION    INVREQ  (210-EXIT)                  
                                            NOTFND  (210-EXIT)                  
                                            ENDFILE (210-EXIT) END-EXEC         
           EXEC    CICS READNEXT            DATASET (ABFFIL)                    
                                            INTO    (ABF)                       
                                            RIDFLD  (ABFKEY)                    
                                            LENGTH  (ABFLENR)  END-EXEC         
           MOVE    '00'                TO   RETABF.                             
       210-EXIT.                                                                
           EXIT.                                                                
                                                                                
      ******************************************************************        
       300-UPDATE.                                                              
           IF      WCMSOCURR           NOT  =  'U'                              
             GO                        TO   100-DISPLAY.                        
                                                                                
           MOVE    ZEROS               TO   MSCHLL                              
           MOVE    +1                  TO   RETERR2                     06040001
           SET     MPS2                TO   +1.                         06050000
       305-LOOP.                                                        06060000
           IF      MPS2                >    +14                         06070000
             IF      RETERR2           <    ZEROS                       06080000
               MOVE  MSG03             TO   MMSGO                       06090000
               GO                      TO   015-SEND                    06100000
             ELSE                                                       06110000
               MOVE    -1              TO   MSCHLL                      06120000
               IF      RETERR2         =    +1                          06130000
                 MOVE  MSG15           TO   MMSGO                       06140000
                 GO                    TO   015-SEND                    06150000
               ELSE                                                     06160000
                 MOVE  MSG17           TO   MMSGO                       06170000
                 GO                    TO   015-SEND.                   06180000
                                                                                
           IF     (MPSPGML    (MPS2)   =    ZEROS)                   AND06190000
                  (MPSPGMA    (MPS2)   NOT  =  WABEOF)               AND06190000
                  (MPSSTDTL   (MPS2)   =    ZEROS)                   AND06210000
                  (MPSSTDTA   (MPS2)   NOT  =  WABEOF)               AND06210000
                  (MPSSTAFFL  (MPS2)   =    ZEROS)                   AND06210000
                  (MPSSTAFFA  (MPS2)   NOT  =  WABEOF)               AND06210000
                  (MPSSPACEL  (MPS2)   =    ZEROS)                   AND06210000
                  (MPSSPACEA  (MPS2)   NOT  =  WABEOF)                  06210000
             SET   MPS2                UP   BY  +1                      06360000
             GO                        TO   305-LOOP.                   06370000
           MOVE    ZEROS               TO   RETERR                              
           MOVE    WCMSODIST           TO   ABFKEY                              
           MOVE    WCMSOFY             TO   ABFFY                               
           MOVE    NEWSCHL             TO   ABFSCHL                             
           MOVE    MPSPGM       (MPS2) TO   ABFPGM                              
                                                                                
           SET     ABF1                TO   +1.                                 
       305-LOOP2.                                                               
           IF      ABFB         (ABF1) =    '_'                                 
             MOVE  ' '                 TO   ABFB         (ABF1).                
           IF      ABF1                <    +11                                 
             SET   ABF1                UP   BY  +1                              
             GO                        TO   305-LOOP2.                          
                                                                                
           IF      ABFPGM              NOT  >   SPACES                  06430000
             MOVE  ALL '_'             TO   MPSPGM       (MPS2)         06450000
             MOVE  '__,___.__'         TO   MPSSTDT      (MPS2)         06450000
             MOVE  '_,___.___'         TO   MPSSTAFF     (MPS2)         06450000
             MOVE  '___,___'           TO   MPSSPACE     (MPS2)         06450000
             MOVE  SPACES              TO   MPSRAT       (MPS2)                 
                                            MPSFROM      (MPS2)                 
                                            MPSMSG       (MPS2)                 
                                            MPSTO        (MPS2)                 
             MOVE  WABU                TO   MPSPGMA      (MPS2)         06450000
             MOVE  WABU                TO   MPSSTDTA     (MPS2)         06450000
             MOVE  WABU                TO   MPSSTAFFA    (MPS2)         06450000
             MOVE  WABU                TO   MPSSPACEA    (MPS2)         06450000
             MOVE  ZEROS               TO   MPSPGML      (MPS2)         06450000
             MOVE  ZEROS               TO   MPSSTDTL     (MPS2)         06450000
             MOVE  ZEROS               TO   MPSSTAFFL    (MPS2)         06450000
             MOVE  ZEROS               TO   MPSSPACEL    (MPS2)         06450000
             SET   MPS2                UP   BY  +1                      06360000
             GO                        TO   305-LOOP.                   06370000
                                                                                
           MOVE    '99'                TO   RETABF                      06810000
           MOVE    WABU                TO   MPSPGMA      (MPS2)         06820000
           EXEC    CICS HANDLE CONDITION    NOTFND  (310-NEW)  END-EXEC 06830000
           EXEC    CICS READ                DATASET (ABFFIL)            06840000
                                            INTO    (ABF)               06850000
                                            RIDFLD  (ABFKEY)            06860000
                                            LENGTH  (ABFLENR)  END-EXEC 06870000
           MOVE    WABPS               TO   MPSPGMA      (MPS2)         07340000
           MOVE    '00'                TO   RETABF.                     07350000
       310-NEW.                                                         07360000
           IF      RETABF              NOT  =  '00'                             
             MOVE  SPACES              TO   ABFDATA                             
             MOVE  ZEROS               TO   ABFSTAFF       ABFSPACE             
                                            ABFSTDT.                            
           MOVE    ABF                 TO   OBF                         07450000
           IF      MPSSTDTA    (MPS2)  =    WABEOF                              
             MOVE  '__,___.__'         TO   MPSSTDT        (MPS2)               
             MOVE  WABU                TO   MPSSTDTA       (MPS2)               
             MOVE  ZEROS               TO   ABFSTDT                             
           ELSE                                                                 
             IF      MPSSTDTL  (MPS2)  >    ZEROS                               
               MOVE  ZEROS             TO   MPSSTDTL       (MPS2)               
               MOVE  MPSSTDT   (MPS2)  TO   WNUIN                               
               PERFORM 700-CONVERT     THRU 700-EXIT                            
               MOVE  WNU52             TO   MPSSTDT9       (MPS2)               
                                            ABFSTDT                             
               MOVE  WABU              TO   MPSSTDTA       (MPS2)               
             ELSE                                                               
               IF      MPSSTDT (MPS2)  >    LOW-VALUES                          
                 MOVE  WABUN           TO   MPSSTDTA       (MPS2)               
                 MOVE  MPSSTDT (MPS2)  TO   WNUIN                               
                 PERFORM 700-CONVERT   THRU 700-EXIT                            
                 MOVE  WNU52           TO   MPSSTDT9       (MPS2)               
                                            ABFSTDT.                            
           IF      MPSSTAFFA   (MPS2)  =    WABEOF                              
             MOVE  '_,___.___'         TO   MPSSTAFF       (MPS2)               
             MOVE  WABU                TO   MPSSTAFFA      (MPS2)               
             MOVE  ZEROS               TO   ABFSTAFF                            
           ELSE                                                                 
             IF      MPSSTAFFL (MPS2)  >    ZEROS                               
               MOVE  ZEROS             TO   MPSSTAFFL      (MPS2)               
               MOVE  MPSSTAFF  (MPS2)  TO   WNUIN                               
               PERFORM 700-CONVERT     THRU 700-EXIT                            
               MOVE  WNU43             TO   MPSSTAFF9      (MPS2)               
                                            ABFSTAFF                            
               MOVE  WABU              TO   MPSSTAFFA      (MPS2)               
             ELSE                                                               
               IF      MPSSTAFF(MPS2)  >    LOW-VALUES                          
                 MOVE  WABUN           TO   MPSSTAFFA      (MPS2)               
                 MOVE  MPSSTAFF(MPS2)  TO   WNUIN                               
                 PERFORM 700-CONVERT   THRU 700-EXIT                            
                 MOVE  WNU43           TO   MPSSTAFF9      (MPS2)               
                                            ABFSTAFF.                           
           IF      MPSSPACEA   (MPS2)  =    WABEOF                              
             MOVE  '___,___'           TO   MPSSPACE       (MPS2)               
             MOVE  WABU                TO   MPSSPACEA      (MPS2)               
             MOVE  ZEROS               TO   ABFSPACE                            
           ELSE                                                                 
             IF      MPSSPACEL (MPS2)  >    ZEROS                               
               MOVE  ZEROS             TO   MPSSPACEL      (MPS2)               
               MOVE  MPSSPACE  (MPS2)  TO   WNUIN                               
               PERFORM 700-CONVERT     THRU 700-EXIT                            
               MOVE  WNU60             TO   MPSSPACE9      (MPS2)               
                                            ABFSPACE                            
               MOVE  WABU              TO   MPSSPACEA      (MPS2)               
             ELSE                                                               
               IF      MPSSPACE(MPS2)  >    LOW-VALUES                          
                 MOVE  WABUN           TO   MPSSPACEA      (MPS2)               
                 MOVE  MPSSPACE(MPS2)  TO   WNUIN                               
                 PERFORM 700-CONVERT   THRU 700-EXIT                            
                 MOVE  WNU60           TO   MPSSPACE9      (MPS2)               
                                            ABFSPACE.                           
                                                                                
           IF      ABFSTDT             =    ZEROS                               
             MOVE  '__,___.__'         TO   MPSSTDT        (MPS2).              
           IF      ABFSTAFF            =    ZEROS                               
             MOVE  '_,___.___'         TO   MPSSTAFF       (MPS2).              
           IF      ABFSPACE            =    ZEROS                               
             MOVE  '___,___'           TO   MPSSPACE       (MPS2).              
                                                                                
           IF      RETABF              NOT  =  '00'                     09500000
             MOVE  'A'                 TO   WSCACT                      09510000
           ELSE                                                         09580000
             IF    ABFSTDT             >    ZEROS                   OR  09590000
                   ABFSTAFF            >    ZEROS                   OR  09590000
                   ABFSPACE            >    ZEROS                       09590000
               MOVE  'C'               TO   WSCACT                      09610000
             ELSE                                                       09620000
               MOVE  'D'               TO   WSCACT                      09630000
               GO                      TO   310-UPDATE.                         
                                                                                
           MOVE    WCMSODIST           TO   FPGKEY                              
           MOVE    WCMSOFY             TO   FPGFY                               
           MOVE    'FPG'               TO   FPGPREF                             
           MOVE    ABFPGM              TO   FPGFPG                              
           MOVE    '99'                TO   RETCRF                      06810000
           EXEC    CICS HANDLE CONDITION    NOTFND  (310-ERR) END-EXEC  06830000
           EXEC    CICS READ                DATASET (CRFFIL)            06840000
                                            INTO    (FPG)               06850000
                                            RIDFLD  (FPGKEY)            06860000
                                            LENGTH  (CRFLENR)  END-EXEC 06870000
           MOVE    '00'                TO   RETCRF.                     07350000
       310-ERR.                                                         07360000
           IF      RETCRF              NOT  =  '00'                             
             MOVE  ZEROS               TO   FPGSTDTFR   FPGSTDTTO               
             IF    RETABF              =    '00'                                
               MOVE  WABPSB            TO   MPSPGMA        (MPS2)               
             ELSE                                                               
               MOVE  WABUMB            TO   MPSPGMA        (MPS2)               
               MOVE  -1                TO   MPSPGML        (MPS2)               
                                            RETERR.                             
                                                                                
           IF     (ABFSTDT             NOT  =  ZERO)                AND         
                  (ABFSTAFF            NOT  =  ZERO)                            
             COMPUTE WSCRAT  ROUNDED   =    ABFSTDT  /  ABFSTAFF                
           ELSE                                                                 
             MOVE    ZERO              TO   WSCRAT.                             
           MOVE    WSCRAT              TO   MPSRAT9   (MPS2)                    
           MOVE    FPGSTDTFR           TO   MPSFROM9  (MPS2)                    
           MOVE    ' -'                TO   MPSMSG    (MPS2)                    
           MOVE    FPGSTDTTO           TO   MPSTO9    (MPS2)                    
                                                                                
           IF      RETERR              NOT  =  ZEROS                            
             MOVE  RETERR              TO   RETERR2                             
             SET   MPS2                UP   BY  +1                              
             GO                        TO   305-LOOP.                           
                                                                                
       310-UPDATE.                                                              
           IF      WSCACT              =    'D'                                 
             EXEC  CICS READ UPDATE         DATASET (ABFFIL)            10960101
                                            INTO    (ABF)               10960201
                                            RIDFLD  (ABFKEY)            10960301
                                            LENGTH  (ABFLENR)  END-EXEC 10960401
             EXEC  CICS DELETE              DATASET (ABFFIL)   END-EXEC 11010000
             MOVE  ALL '_'             TO   MPSPGM       (MPS2)         06450000
             MOVE  '__,___.__'         TO   MPSSTDT      (MPS2)         06450000
             MOVE  '_,___.___'         TO   MPSSTAFF     (MPS2)         06450000
             MOVE  '___,___'           TO   MPSSPACE     (MPS2)         06450000
             MOVE  SPACES              TO   MPSRAT       (MPS2)                 
                                            MPSFROM      (MPS2)                 
                                            MPSMSG       (MPS2)                 
                                            MPSTO        (MPS2)                 
             MOVE  WABU                TO   MPSPGMA      (MPS2)         06450000
             MOVE  WABU                TO   MPSSTDTA     (MPS2)         06450000
             MOVE  WABU                TO   MPSSTAFFA    (MPS2)         06450000
             MOVE  WABU                TO   MPSSPACEA    (MPS2)         06450000
             MOVE  ZEROS               TO   MPSPGML      (MPS2)         06450000
             MOVE  ZEROS               TO   MPSSTDTL     (MPS2)         06450000
             MOVE  ZEROS               TO   MPSSTAFFL    (MPS2)         06450000
             MOVE  ZEROS               TO   MPSSPACEL    (MPS2)         06450000
             SET   MPS2                UP   BY  +1                      06360000
             IF    RETERR2             NOT  =  -1                               
               MOVE  ZEROS             TO   RETERR2                             
               GO                      TO   305-LOOP                    06370000
             ELSE                                                               
               GO                      TO   305-LOOP.                   06370000
                                                                                
           IF      ABF                 =    OBF                         10790000
             SET   MPS2                UP   BY  +1                      06360000
             GO                        TO   305-LOOP.                           
           IF      RETERR2             NOT  =   -1                      10910000
             MOVE  ZEROS               TO   RETERR2.                    10920000
           IF      RETCRF              =    '00'                                
             MOVE  WABPS               TO   MPSPGMA      (MPS2)         10930000
             MOVE  ZEROS               TO   MPSPGML      (MPS2).        10950000
                                                                                
           IF      RETABF              =    '00'                        10960000
             EXEC  CICS READ UPDATE         DATASET (ABFFIL)            10960101
                                            INTO    (OBF)               10960201
                                            RIDFLD  (ABFKEY)            10960301
                                            LENGTH  (ABFLENR)  END-EXEC 10960401
             EXEC  CICS REWRITE             DATASET (ABFFIL)            11010000
                                            FROM    (ABF)               11020000
                                            LENGTH  (ABFLENR)  END-EXEC 11030000
           ELSE                                                                 
             EXEC  CICS WRITE               DATASET (ABFFIL)            11051000
                                            FROM    (ABF)               11060000
                                            RIDFLD  (ABFKEY)            11070000
                                            LENGTH  (ABFLENR)  END-EXEC.11080000
           SET     MPS2                UP   BY  +1                              
           GO                          TO   305-LOOP.                   11100000
                                                                                
      ******************************************************************        
                                                                                
           COPY                             EWNUMBP.                            
                                                                                
      ******************************************************************        
       800-XCTL.                                                                
           IF     (EIBAID              =    DFHCLEAR)                OR         
                  (EIBAID              =    DFHPA1)                  OR         
                  (EIBAID              =    DFHPA2)                             
             MOVE  QWRMAP              TO   MPEW26O                             
             MOVE  -1                  TO   MPANELL                             
             MOVE  +10                 TO   EIBCALEN                            
             GO                        TO   015-SEND.                           
           MOVE    QWRWCM              TO   WCM                                 
           PERFORM 010-RECEIVE         THRU 010-EXIT                            
                                                                                
           IF      EIBAID              =    DFHPF1                              
             MOVE  WCMXFFR             TO   WCMXFHLD                            
             MOVE  EIBCPOSN            TO   WCMXFCRS9     WCMXFPOS9             
             MOVE  'CZ02'              TO   WCMXFTO                             
             GO                        TO   805-XCTL.                           
           IF      EIBAID              =    DFHPF4                              
             MOVE  WCMXFFR             TO   WCMXFHLD                            
             MOVE  EIBCPOSN            TO   WCMXFCRS9     WCMXFPOS9             
             MOVE  'CZ03'              TO   WCMXFTO                             
             GO                        TO   805-XCTL.                           
                                                                                
           IF      EIBAID              =    DFHPF5                              
             IF      MPSLINE      (14) =    LOW-VALUES                  11320000
               GO                      TO   100-DISPLAY                 11330000
             ELSE                                                       11340000
               IF      WCMSOCURR       NOT  =  'U'                      11350000
                 GO                    TO   300-UPDATE                  11360000
               ELSE                                                     11370000
                 MOVE  LOW-VALUES      TO   MPSLINES      QWRLINES      11380000
                 MOVE  +10             TO   EIBCALEN                    11390000
                 MOVE  ZEROS           TO   MSCHLL        M1PGML                
                 MOVE  -1              TO   M1PGML                      11400000
                 MOVE  MSG33           TO   MMSGO                       11410000
                 GO                    TO   015-SEND.                   11420000
           IF      EIBAID              =    DFHPF7                              
             GO                        TO   815-PF7.                            
           IF      EIBAID              =    DFHPF8                              
             GO                        TO   820-PF8.                            
                                                                                
           MOVE    QWRWCM              TO   WCM                                 
           IF      EIBAID              =    DFHPF12                             
             MOVE  SPACES              TO   WCMXFHLD                            
             MOVE  'C   '              TO   WCMXFTO                             
           ELSE                                                                 
             IF      EIBAID            =    DFHPF3                              
               MOVE  'CA  '            TO   WCMXFTO                             
             ELSE                                                               
               MOVE  QWRMAP            TO   MPEW26O                             
               MOVE  +10               TO   EIBCALEN                            
               MOVE  -1                TO   MSCHLL                              
               GO                      TO   015-SEND.                           
                                                                                
       805-XCTL.                                                                
           MOVE    'C'                 TO   WCMXFTS                             
           MOVE    WCM                 TO   QWRWCM                              
           IF     (EIBCPOSN            >    +559)                    AND        
                  (EIBCPOSN            <    +1760)                              
             COMPUTE WCMXFPOS9         =    EIBCPOSN -                          
                                         (((EIBCPOSN / 80) - 5) * 80)           
           ELSE                                                                 
             COMPUTE WCMXFPOS9         =    EIBCPOSN.                           
           EXEC    CICS HANDLE CONDITION    DUPREC  (810-END)  END-EXEC         
           IF      RETQWR              NOT  =   '00'                            
             EXEC  CICS WRITE               DATASET (QWRFIL)                    
                                            FROM    (QWR)                       
                                            RIDFLD  (QWRKEY)                    
                                            LENGTH  (QWRLENR)  END-EXEC         
           ELSE                                                                 
             EXEC  CICS READ UPDATE         DATASET (QWRFIL)                    
                                            INTO    (QWRI)                      
                                            RIDFLD  (QWRKEY)                    
                                            LENGTH  (QWRLENR)  END-EXEC         
             EXEC  CICS REWRITE             DATASET (QWRFIL)                    
                                            FROM    (QWR)                       
                                            LENGTH  (QWRLENR)  END-EXEC.        
       810-END.                                                                 
           MOVE    'CA04'              TO   WCMXFFR                             
           EXEC    CICS XCTL                PROGRAM ('EW02')                    
                                            COMMAREA(WCM)                       
                                            LENGTH  (220)      END-EXEC.        
                                                                                
      ******************************************************************        
       815-PF7.                                                                 
           MOVE    QWRLNMAX            TO   WSCLNMAX                            
           MOVE    QWRLNXT             TO   WSCLNCNT                            
           IF     (QWRLNXT             >    +14)                     OR         
                  (QWRLNINC            =    +1)                                 
             MOVE  LOW-VALUES          TO   QWRLINES                            
             MOVE  +10                 TO   EIBCALEN.                           
           MOVE    -1                  TO   WSCLNINC      MSCHLL                
           MOVE    MSG13               TO   MMSGO                               
           IF     (QWRPF7              =    SPACES)                  OR         
                  (QWRPF7              NOT  >   QWRFRST)                        
             GO                        TO   015-SEND.                           
           MOVE    QWRPF7              TO   ABFKEY                              
           EXEC    CICS HANDLE CONDITION    NOTFND  (015-SEND)                  
                                            ENDFILE (015-SEND) END-EXEC         
           EXEC    CICS STARTBR             DATASET (ABFFIL)                    
                                            RIDFLD  (ABFKEY)   GTEQ             
                                            KEYLENGTH (ABFLENK)                 
                                            END-EXEC                            
           EXEC    CICS READPREV            DATASET (ABFFIL)                    
                                            INTO    (ABF)                       
                                            RIDFLD  (ABFKEY)                    
                                            LENGTH  (ABFLENR)  END-EXEC         
           IF      QWRLNINC            =    +1                                  
             MOVE  +15                 TO   WSCLNCNT                            
             MOVE  ZEROS               TO   WSCLNMAX.                           
           GO                          TO   110-OLD.                            
                                                                                
      ******************************************************************        
       820-PF8.                                                                 
           MOVE    QWRLNXT             TO   WSCLNCNT                            
           MOVE    QWRLNMAX            TO   WSCLNMAX                            
           IF     (QWRLNXT             =    ZEROS)                   OR         
                  (QWRLNINC            =    -1)                                 
             MOVE  LOW-VALUES          TO   QWRLINES                            
             MOVE  +10                 TO   EIBCALEN.                           
           MOVE    +1                  TO   WSCLNINC                            
           MOVE    -1                  TO   MSCHLL                              
           MOVE    MSG14               TO   MMSGO                               
           IF      QWRPF8              =    SPACES                              
             GO                        TO   015-SEND.                           
           MOVE    QWRPF8              TO   ABFKEY                              
           EXEC    CICS HANDLE CONDITION    NOTFND  (015-SEND)                  
                                            ENDFILE (015-SEND) END-EXEC         
           EXEC    CICS STARTBR             DATASET (ABFFIL)                    
                                            RIDFLD  (ABFKEY)   GTEQ             
                                            KEYLENGTH (ABFLENK)                 
                                            END-EXEC                            
           EXEC    CICS READNEXT            DATASET (ABFFIL)                    
                                            INTO    (ABF)                       
                                            RIDFLD  (ABFKEY)                    
                                            LENGTH  (ABFLENR)  END-EXEC         
           IF      QWRLNINC            =    -1                                  
             MOVE  ZEROS               TO   WSCLNCNT                            
             MOVE  +15                 TO   WSCLNMAX.                           
           GO                          TO   110-OLD.                            
                                                                                
      ******************************************************************        
       850-CALLED.                                                              
           MOVE    WCMXFCRS9           TO   EIBCPOSN                            
           MOVE    DFHCOMMAREA         TO   WCM                                 
           IF      WCMRETCD            NOT  =   'G'                             
             GO                        TO   900-SECURITY.                       
           IF      WCMXFFR             =    'CZ02'                              
             MOVE  WCMXFHLD            TO   WCMXFFR                             
             MOVE  WCMXFCRS9           TO   EIBCPOSN                            
             MOVE  1234                TO   EIBCALEN                            
             MOVE  QWRMAP              TO   MPEW26O                             
             GO                        TO   015-SEND.                           
           IF     (WCMXFFR             =    'CZ04')                  OR         
                  (WCMXFFR             =    'CZ03')                             
             MOVE  WCMXFHLD            TO   WCMXFFR                             
             MOVE  WCMXFCRS9           TO   EIBCPOSN                            
             MOVE  1234                TO   EIBCALEN                            
             MOVE  QWRMAP              TO   MPEW26O                             
             IF      WCMXFPROM         NOT  =   SPACES                          
               IF      WCMXFPNL5       =    'SCHL '                             
                 MOVE  WCMXFPROM       TO   MSCHLO                              
                 GO                    TO   015-SEND                            
               ELSE                                                             
                 COMPUTE WSCLNCNT      =   (EIBCPOSN / 80) - 6                  
                 IF     (WSCLNCNT      >    +0)                      AND        
                        (WSCLNCNT      <    +15)                                
                   SET   MPS2          TO   WSCLNCNT                            
                   IF   (WCMXFPNL5     =    'PGM ')                  AND        
                        (MPSPGMA (MPS2)     NOT  =  WABPS)           AND        
                        (MPSPGMA (MPS2)     NOT  =  WABPSB)                     
                     MOVE  WCMXFPROM   TO   MPSPGM       (MPS2)                 
                     GO                TO   015-SEND                            
                   ELSE                                                         
                     GO                TO   015-SEND                            
                 ELSE                                                           
                   GO                  TO   015-SEND                            
             ELSE                                                               
               GO                      TO   015-SEND.                           
           MOVE    LOW-VALUES          TO   MPEW26O       QWRMAP                
           MOVE    HIGH-VALUES         TO   QWRPF7        OLDKEY                
           MOVE    SPACES              TO   NEWKEY                              
           MOVE    -1                  TO   MSCHLL                              
           MOVE    MSG18               TO   MMSGO                               
           GO                          TO   015-SEND.                           
                                                                                
      ******************************************************************        
       900-SECURITY.                                                            
           MOVE    ZEROS               TO   EIBCALEN                            
           MOVE    WCMXFHLD            TO   WCMXFFR                             
           MOVE    1234                TO   EIBCALEN                            
           MOVE    +14                 TO   EIBCPOSN                            
           MOVE    QWRMAP              TO   MPEW26O                             
           MOVE    WCMXFTPNL           TO   MPANELO                             
           MOVE    WABUMB              TO   MPANELA                             
           IF      WCMRETCD            =    'S'                                 
             MOVE  MSG90               TO   MMSGO                               
           ELSE                                                                 
             IF      WCMRETCD          =    'T'                                 
               MOVE  MSG91             TO   MMSGO                               
             ELSE                                                               
               IF     (WCMRETCD        =    'U')                     OR         
                      (WCMRETCD        =    'N')                                
                 MOVE  MSG92           TO   MMSGO                               
               ELSE                                                             
                 IF      WCMRETCD      =    'D'                                 
                   MOVE  MSG93         TO   MMSGO.                              
           GO                          TO   015-SEND.                           
       901-ERROR.                                                               
           MOVE    -1                  TO   MPANELL                             
           MOVE    MSG94               TO   MMSGO                               
           GO                          TO   015-SEND.                           
       902-NOSPACE.                                                             
           MOVE    MSG95               TO   MMSGO                               
           MOVE    -1                  TO   MPANELL                             
           GO                          TO   015-SEND.                           
       903-INVREQ.                                                              
           MOVE    MSG96               TO   MMSGO                               
           MOVE    -1                  TO   MPANELL                             
           GO                          TO   015-SEND.                           
       904-NOTOPEN.                                                             
           MOVE    MSG97               TO   MMSGO                               
           MOVE    -1                  TO   MPANELL                             
           GO                          TO   015-SEND.                           
       905-DSIDERR.                                                             
           MOVE    MSG97               TO   MMSGO                               
           MOVE    -1                  TO   MPANELL                             
           GO                          TO   015-SEND.                           
           GOBACK.                                                              
