      * FmtRPGSrcR                                                              
      * format RPG/free source                                                  
      *                                                                         
     Fqrpglesrc uf   e             disk    rename(qrpglesrc:srcfmt)             
                                                                                
     D IndentPos       s              3  0                                      
     D Offset          s              3  0                                      
     D Srclen          s              3  0                                      
     D Pos             s              3  0                                      
     D ValidCalc       s               n   inz(*off)                            
     D NewSrc          s             80                                         
     D WrkSrc          s             80                                         
     D LineArr         s              6    dim(300)                             
     D LineNumber      s              3  0                                      
     D SequenceEnd     s               n                                        
     D LineNoDec       s              1  0                                      
                                                                                
     D                 ds                                                       
     D Wrkline1                1      6s 0                                      
     D Wrkline2                1      6                                         
                                                                                
     D srcwork         ds                                                       
     D  src1to1                1      1                                         
     D  src1to3                1      3                                         
     D  src1to4                1      4                                         
     D  src1to5                1      5                                         
     D  src1to6                1      6                                         
     D  src1to7                1      7                                         
     D  src1to8                1      8                                         
     D  src1to9                1      9                                         
                                                                                
     D lower           c                   const('abcdefghijklmnopqrstuvwxyz')  
     D upper           c                   const('ABCDEFGHIJKLMNOPQRSTUVWXYZ')  
                                                                                
     D FmtRPGSrcR      pr                  extpgm('FMTRPGSRCR')                 
     D  StartCol                      2  0                                      
     D  increment                     2  0                                      
     D  ShowLineNo                    4                                         
                                                                                
     D FmtRPGSrcR      pi                                                       
     D  StartCol                      2  0                                      
     D  increment                     2  0                                      
     D  ShowLineNo                    4                                         
                                                                                
      /free                                                                     
                                                                                
       dow not %eof(qrpglesrc);                                                 
          read qrpglesrc;                                                       
          if %eof;                                                              
             leave;                                                             
          endif;                                                //->004900      
          if srcdta = *blanks;                                                  
             iter;                                                              
          endif;                                                //->005200      
          srcwork = %xlate(lower:UPPER:%triml(srcdta));                         
                                                                                
          if src1to6 = '/FREE ';                                                
             ValidCalc = *on;                                                   
             iter;                                                              
          endif;                                                //->005700      
                                                                                
          if srcwork = '/END-FREE ';                                            
             ValidCalc = *off;                                                  
             iter;                                                              
          endif;                                                //->006200      
                                                                                
          if not validcalc;                                                     
             iter;                                                              
          endif;                                                //->006700      
                                                                                
          if src1to1 = '/';                                                     
             iter;                                                              
          endif;                                                //->007100      
                                                                                
          SequenceEnd = *off;                                                   
          LineNoDec = 0;                                                        
                                                                                
          if src1to6 = 'ENDIF;'                                                 
          or src1to6 = 'ENDIF '                                                 
          or src1to6 = 'ENDDO;'                                                 
          or src1to6 = 'ENDDO '                                                 
          or src1to6 = 'ENDSL;'                                                 
          or src1to6 = 'ENDSL '                                                 
          or src1to7 = 'ENDMON;'                                                
          or src1to7 = 'ENDMON '                                                
          or src1to7 = 'ENDFOR;'                                                
          or src1to7 = 'ENDFOR ';                                               
             IndentPos = IndentPos - Increment;                                 
             SequenceEnd = *on;                                                 
             LineNoDec = 1;                                                     
          endif ;                                               //->007800      
                                                                                
          if src1to6 = 'ENDSL;'                                                 
          or src1to6 = 'ENDSL ';                                                
             IndentPos = IndentPos - Increment;                                 
          endif ;                                               //->009300      
                                                                                
          if src1to5 = 'WHEN ';                                                 
             IndentPos = IndentPos - Increment;                                 
             SequenceEnd = *on;                                                 
          endif ;                                               //->009800      
                                                                                
          if src1to6 = 'BEGSR '                                                 
          or src1to6 = 'ENDSR '                                                 
          or src1to6 = 'ENDSR;';                                                
             IndentPos = StartCol;                                              
             LineNumber = 0;                                                    
          endif ;                                               //->010300      
                                                                                
          if src1to3 = 'OR '                                                    
          or src1to4 = 'AND ';                                                  
             offset = Increment;                                                
          endif;                                                //->011000      
                                                                                
          if src1to5 = 'ELSE;'                                                  
          or src1to5 = 'ELSE '                                                  
          or src1to9 = 'ON-ERROR '                                              
          or src1to9 = 'ON-ERROR;';                                             
             offset = Increment;                                                
             SequenceEnd = *on;                                                 
          endif;                                                //->011500      
                                                                                
          if IndentPos < StartCol;                                              
             IndentPos = StartCol;                                              
          endif;                                                //->012300      
          if IndentPos > 72;                                                    
             IndentPos = 72;                                                    
          endif;                                                //->012600      
                                                                                
          if %subst(srcdta:65:4) = '//->';                                      
             %subst(srcdta:65:16) = *blanks;                                    
          endif;                                                //->013000      
                                                                                
          Newsrc = *blanks;                                                     
          wrksrc = %triml(srcdta);                                              
          srclen = %len(%trimr(wrksrc));                                        
          pos = IndentPos-offset;                                               
          if pos + srclen > 80;                                                 
             pos = 81 - srclen;                                                 
          endif;                                                //->013800      
          %subst(NewSrc:pos) = wrksrc;                                          
                                                                                
          if SequenceEnd                                                        
          and ShowLineNo = '*YES'                                               
          and LineNumber > 0                                                    
          and %subst(NewSrc:65:16) = *blanks;                                   
             %subst(NewSrc:65) = '//->' + LineArr(Linenumber);                  
          endif;                                                //->014300      
                                                                                
          offset = 0;                                                           
          srcdta = NewSrc;                                                      
          update srcfmt;                                                        
                                                                                
          if src1to3 = 'IF '                                                    
          or src1to4 = 'DOW '                                                   
          or src1to4 = 'DOU '                                                   
          or src1to4 = 'FOR '                                                   
          or src1to7 = 'SELECT '                                                
          or src1to7 = 'SELECT;'                                                
          or src1to8 = 'MONITOR '                                               
          or src1to8 = 'MONITOR;'                                               
          or src1to6 = 'BEGSR ';                                                
             LineNumber = LineNumber + 1;                                       
             wrkline1 = srcseq * 100;                                           
             LineArr(Linenumber) = wrkline2;                                    
             IndentPos = IndentPos + Increment;                                 
          endif;                                                //->015400      
                                                                                
          if src1to7 = 'SELECT '                                                
          or src1to7 = 'SELECT;';                                               
             IndentPos = IndentPos + Increment;                                 
          endif;                                                //->016900      
                                                                                
          if src1to5 = 'WHEN ';                                                 
             IndentPos = IndentPos + Increment;                                 
          endif;                                                //->017400      
                                                                                
          LineNumber = Linenumber - LineNoDec;                                  
                                                                                
       enddo;                                                   //->004700      
                                                                                
       *inlr = *on;                                                             
       return;                                                                  
