mainframe

       IDENTIFICATION DIVISION.                                       
       PROGRAM-ID. PROGN.                                             
       DATA DIVISION.                                                 
       WORKING-STORAGE SECTION.                                       
       01 WS-USUID PIC S9(9) COMP.                                    
       01 WS-INVALID PIC X(13) VALUE 'INVALID ENTRY'.                 
       01 WS-INTNAM PIC X(20).                                        
       01 WS-INTACN PIC S9(9) COMP.                                   
       01 WS-ACCNO PIC S9(9) COMP.                                    
       01 WS-NAME PIC X(20).                                          
       01 WS-INTROBALAMNT PIC S9(9) COMP.                             
       01 WS-ACTYP1 PIC X(10).                                        
       01 WS-ACTYP PIC X(10).                                         
       01 WS-ACC PIC 9(1) VALUE 0.                                    
       01 WS-NEWID PIC S9(9) COMP.                                    
       01 WS-NEWPWD PIC X(20).                                        
       01 WS-NEWNAM PIC X(20).                                        
       01 WS-NEWDOB PIC X(10).                                        
       01 WS-NEWADR1 PIC X(10).                                       
       01 WS-NEWADR2 PIC X(10).                                       
       01 WS-NEWCITY PIC X(20).                                       
       01 WS-NEWSTATE PIC X(20).                                      
       01 WS-NEWPIN PIC S9(9) COMP.                                   
      01 WS-NEWACTYP PIC X(10).                                     
      01 WS-ACT1F PIC X(10).                                        
      01 WS-ACT2F PIC X(10).                                        
      01 WS-MBL1F PIC S9(9) COMP.                                   
      01 WS-MBL2F PIC S9(9) COMP.                                   
      01 WS-INT1F PIC S9(9) COMP.                                   
      01 WS-INT2F PIC S9(9) COMP.                                   
      01 WS-PINO PIC S9(9) COMP.                                    
      01 WS-SAVINGS PIC X(7) VALUE 'SAVINGS'.                       
      01 WS-CURRENT PIC X(7) VALUE 'CURRENT'.                       
      01 WS-MINBAL PIC S9(9) COMP.                                  
      01 WS-INTEREST PIC S9(9) COMP.                                
      01 WS-NPWD PIC X(20).                                         
      01 WS-STATUS PIC S9(9) COMP VALUE 0.                          
      01 WS-TRANSTAT PIC S9(9) COMP  VALUE 0.                       
      01 WS-EXPWD PIC X(25) VALUE 'USER NAME ALREADY EXISTED'.      
      01 WS-STATUS1 PIC S9(9) COMP.                                 
      01 WS-REMAINSAV PIC S9(9) COMP.                               
      01 WS-PWDCHECK1 PIC X(20).                                    
      01 WS-NEWBALAMNT PIC S9(9) COMP.                              
      01 WS-PWD PIC X(20).                                          
      01 WS-ACCN PIC S9(9) COMP.                                    
      01 WS-PWDCHECK PIC X(20).                                     
      01 WS-ACCNOATM PIC S9(9) COMP.                                
      01 WS-NAMEATM  PIC X(20).                                     
      01 WS-ACCTYPEATM PIC X(10).                                   
      01 WS-BALAMNTATM PIC S9(9) COMP.                             
      01 WS-SBMT PIC X(9) VALUE 'SUBMITTED'.                       
          COPY LOGN.                                               
          COPY LOGINFO.                                            
          COPY NEWUSER.                                            
     *    COPY EIBAID.                                             
          COPY DFHAID.                                             
          EXEC SQL                                                 
           INCLUDE SQLCA                                           
          END-EXEC.                                                
          EXEC SQL                                                 
           DECLARE CURS CURSOR  FOR                                
            SELECT ACCTYPE FROM ACCTAB                             
          END-EXEC.                                                
          EXEC SQL                                                 
           DECLARE INTRO CURSOR FOR                                
            SELECT ACCNO, NAME FROM MASTAB                         
          END-EXEC.                                                
     *    EXEC SQL                                                 
     *     DECLARE USPWACN CURSOR FOR                              
     *      SELECT USERID, PWORD, ACCN FROM TABA                   
     *    END-EXEC.                                                
      PROCEDURE DIVISION.                                          
          MOVE LOW-VALUES TO INFOMO.                               
          MOVE LOW-VALUES TO LOGNMO.                               
          MOVE LOW-VALUES TO NUSRMO.                               
          PERFORM NEWUSERPARA.                                    
          EXEC CICS RETURN END-EXEC.                              
      NEWUSERPARA.                                                
          EXEC CICS SEND CONTROL ERASE END-EXEC.                  
          EXEC CICS SEND MAP('NUSRM') MAPSET('NEWUSER')           
          END-EXEC.                                               
          EXEC CICS RECEIVE MAP('NUSRM') MAPSET('NEWUSER')        
          END-EXEC.                                               
     *    IF EIBAID = DFHPF5                                      
          IF ( NPWDL = 0 ) MOVE -1 TO NPWDL                       
          END-IF.                                                 
          MOVE NPWDI TO WS-PWDCHECK1                              
     *    PERFORM OPENUSPWACN                                     
     *    END-IF.                                                 
     *    IF EIBAID = DFHPF5                                      
           IF ( NNAML = 0 ) MOVE -1 TO NNAML                      
     *     END-IF                                                 
          END-IF.                                                 
     *    IF EIBAID = DFHPF5                                      
           IF ( NDOBL = 0 ) OR ( NDOBL < 10 ) MOVE -1 TO NDOBL    
     *      END-IF                                                
          END-IF.                                                 
     *    IF EIBAID = DFHPF5                                      
           IF ( NADR1L = 0 ) MOVE -1 TO NADR1L                    
           END-IF.                                                
     *    END-IF.                                                 
     *    IF EIBAID = DFHPF5                                        
           IF ( NADR2L = 0 ) MOVE -1 TO NADR2L                      
     *    END-IF                                                    
          END-IF.                                                   
     *    IF EIBAID = DFHPF5                                        
           IF ( NCTYL = 0 ) MOVE -1 TO NCTYL                        
     *    END-IF                                                    
          END-IF.                                                   
     *    IF EIBAID = DFHPF5                                        
           IF ( NSTATL = 0 ) MOVE -1 TO NSTATL                      
     *    END-IF                                                    
          END-IF.                                                   
     *    IF EIBAID = DFHPF5                                        
           IF ( NPINL = 0 ) MOVE -1 TO NPINL                        
     *     END-IF                                                   
          END-IF.                                                   
     *    IF EIBAID = DFHPF5                                        
           IF ( NACTYPL = 0 ) MOVE -1 TO NACTYPL                    
           ELSE MOVE NACTYPI TO WS-ACTYP1                           
            PERFORM OPENCURS                                        
     *     END-IF                                                   
          END-IF.                                                   
     *    IF EIBAID = DFHPF5                                        
          PERFORM INTNAMACCHECK.                                    
          IF ( WS-INTROBALAMNT < 2000 ) MOVE -1 TO NINTNAML         
          PERFORM INTNAMACCHECK                                     
          ELSE IF ( WS-ACTYP1 = 'SAVINGS' ) MOVE 500 TO WS-NEWBALAMNT 
           COMPUTE WS-INTROBALAMNT = WS-INTROBALAMNT - 500            
           PERFORM INTROSAV                                           
     *     PERFORM F1PARA                                             
          ELSE IF ( WS-ACTYP1 = 'CURRENT' ) MOVE 1000 TO WS-NEWBALAMNT
           COMPUTE WS-INTROBALAMNT = WS-INTROBALAMNT - 1000           
           PERFORM INTROCURR                                          
     *     PERFORM F1PARA                                             
          ELSE CONTINUE                                               
          END-IF.                                                     
     *    IF EIBAID = DFHPF1                                          
          PERFORM F1PARA.                                             
          IF EIBAID = DFHPF3                                          
           EXEC CICS LINK PROGRAM ('MAINP')                           
           END-EXEC.                                                  
      INTNAMACCHECK.                                                  
           IF ( NINTNAML = 0 ) MOVE -1 TO NINTNAML                    
           ELSE MOVE NINTNAMI TO WS-INTNAM                            
           END-IF.                                                    
     *     IF EIBAID = DFHPF5                                         
           IF ( NINTACNL = 0 ) MOVE -1 TO NINTACNL                    
           ELSE MOVE NINTACNI TO WS-INTACN                            
     *     END-IF                                                     
           END-IF.                                                    
           EXEC SQL                                                   
            SELECT ACCNO, NAME INTO :WS-ACCNO, :WS-NAME               
             FROM MASTAB WHERE ACCNO = :WS-INTACN                     
           END-EXEC.                                                  
           IF ( WS-INTACN NOT = WS-ACCNO ) OR                         
            ( WS-INTNAM NOT = WS-NAME )                               
           MOVE -1 TO NINTNAML                                        
           PERFORM INTNAMACCHECK                                      
           ELSE CONTINUE                                              
           END-IF.                                                    
           IF ( WS-INTACN = WS-ACCNO ) AND ( WS-INTNAM = WS-NAME )    
           EXEC SQL                                                   
            SELECT BALAMOUNT INTO :WS-INTROBALAMNT FROM MASTAB WHERE  
             ACCNO = :WS-INTACN                                       
           END-EXEC.                                                  
     *     IF EIBAID = DFHPF1 PERFORM F1PARA.                         
      F1PARA.                                                         
     *     IF EIBAID = DFHPF1                                         
            MOVE NPWDI TO WS-NEWPWD                                   
            MOVE NNAMI TO WS-NEWNAM                                   
            MOVE NDOBI TO WS-NEWDOB                                   
            MOVE NADR1I TO WS-NEWADR1                                 
            MOVE NADR2I TO WS-NEWADR2                                 
            MOVE NCTYI TO WS-NEWCITY                                  
            MOVE NSTATI TO WS-NEWSTATE                                
            MOVE NPINI TO WS-NEWPIN                                   
            MOVE NACTYPI TO WS-NEWACTYP                               
           EXEC CICS SEND CONTROL ERASE END-EXEC.                     
           EXEC CICS SEND TEXT                                       
            FROM(WS-SBMT)                                            
            LENGTH(LENGTH OF WS-SBMT)                                
            FREEKB                                                   
           END-EXEC.                                                 
           EXEC SQL                                                  
           INSERT INTO MASTAB ( ACCTYPE, NAME,DOB,BALAMOUNT,         
               ADRSLINE1,ADRSLINE2, CITY,STATE,PINCODE, STATUS,      
            TRANSTAT ) VALUES ( :WS-NEWACTYP, :WS-NEWNAM,            
              :WS-NEWDOB, :WS-NEWBALAMNT, :WS-NEWADR1, :WS-NEWADR2,  
             :WS-NEWCITY, :WS-NEWSTATE, :WS-NEWPIN , :WS-STATUS,     
             :WS-TRANSTAT)                                           
           END-EXEC.                                                 
           EXEC CICS SYNCPOINT END-EXEC.                             
           EXEC SQL                                                  
            SELECT ACCNO INTO :WS-ACCN FROM MASTAB WHERE             
             ADRSLINE1 = :WS-NEWADR1 AND                             
             PINCODE = :WS-NEWPIN                                    
           END-EXEC.                                                 
           EXEC SQL                                                  
            UPDATE TABA SET PWORD = :WS-NEWPWD                       
            WHERE ACCN = :WS-ACCN                                    
           END-EXEC.                                                 
           EXEC CICS SYNCPOINT END-EXEC.                             
           EXEC SQL                                                  
            SELECT USERID, PWORD, ACCN INTO :WS-USUID, :WS-PWD,      
             :WS-ACCN FROM TABA WHERE PWORD = :WS-NEWPWD              
           END-EXEC.                                                  
           MOVE WS-USUID TO USIDFO.                                   
           MOVE WS-ACCN TO ACNOFO.                                    
           MOVE WS-PWD TO PWDFO.                                      
           EXEC CICS SEND MAP('INFOM') MAPSET('LOGINFO')              
           END-EXEC.                                                  
      INTROCURR.                                                      
          EXEC SQL                                                    
           UPDATE MASTAB SET BALAMOUNT = :WS-INTROBALAMNT             
            WHERE ACCNO = :WS-INTACN                                  
          END-EXEC.                                                   
           EXEC CICS SYNCPOINT END-EXEC.                              
      INTROSAV.                                                       
          EXEC SQL                                                    
           UPDATE MASTAB SET BALAMOUNT = :WS-INTROBALAMNT             
            WHERE ACCNO = :WS-INTACN                                  
          END-EXEC.                                                   
           EXEC CICS SYNCPOINT END-EXEC.                              
      OPENCURS.                                                       
          EXEC SQL                                                    
           OPEN CURS                                                  
          END-EXEC.                                                   
          PERFORM CURSPARA UNTIL SQLCODE = 100.                       
          IF ( WS-ACC = 0 ) MOVE -1 TO NACTYPL.                       
          EXEC SQL                                                    
           CLOSE CURS                                                
          END-EXEC.                                                  
      CURSPARA.                                                      
          EXEC SQL                                                   
           FETCH CURS INTO :WS-ACTYP                                 
          END-EXEC.                                                  
          IF ( WS-ACTYP = WS-ACTYP1 ) MOVE 1 TO WS-ACC.              
     *OPENUSPWACN.                                                   
     *    EXEC SQL                                                   
     *     OPEN USPWACN                                              
     *    END-EXEC.                                                  
     *    PERFORM USPWACNPARA UNTIL SQLCODE = 100.                   
     *    EXEC SQL                                                   
     *     CLOSE USPWACN                                             
     *    END-EXEC.                                                  
     *    PERFORM NEWUSERPARA.                                       
     *USPWACNPARA.                                                   
     *    EXEC SQL                                                   
     *     FETCH USPWACN INTO :WS-PWDCHECK                           
     *    END-EXEC.                                                  
     *    IF ( WS-PWDCHECK = WS-PWDCHECK1 )                          
     *    EXEC CICS SEND TEXT                                        
     *     FROM(WS-EXPWD)                                            
     *     LENGTH(LENGTH OF WS-EXPWD)                                
     *     FREEKB                                                    
     *    END-EXEC.                                                  
      INVALIDPARA.                                                    
          EXEC CICS SEND CONTROL ERASE END-EXEC.                      
          EXEC CICS SEND TEXT                                         
           FROM(WS-INVALID)                                           
           LENGTH(LENGTH OF WS-INVALID)                               
           FREEKB                                                     
          END-EXEC.                                                   
          EXEC CICS SEND CONTROL ERASE END-EXEC.                      
          PERFORM NEWUSERPARA.                                        
      PROGAPARA.                                                      
           EXEC CICS LINK PROGRAM ('PROGA')                           
           END-EXEC.                                                  
      PROGUPARA.                                                      
           EXEC CICS LINK PROGRAM ('PROGU')                           
           END-EXEC.