For IBMi (AS400) source files : removes color attributes inserted, for use with RDi

QRPGLESRC.DECOLORE.rpgle

**free
  //**************************************************************************
  //* PGM       : DECOLORE           Date Création : 28/08/2018              *
  //* AUTEUR    : D.LANDRAGIN                                                *
  //*------------------------------------------------------------------------*
  //*  APPLICATION :                                                         *
  //*  Services                                                              *
  //*------------------------------------------------------------------------*
  //*  DESCRIPTION :                                                         *
  //*  Retire les attributs d'affichage dans les membres source              *
  //*                                                                        *
  //*------------------------------------------------------------------------*
  //* MAINTENANCE :                                                          *
  //*  N°    AUTEUR                       OBJET                       DATE   *
  //* ...  ...........  .........................................  ../../....*
  //* ...  ...........  .........................................  ../../....*
  //* ...  ...........  .........................................  ../../....*
  // *****************************************************************/
  // >>PRE-COMPILER<<                                                */
  //   >>CRTCMD<<  CRTSQLRPGI SRCFILE(&SL/&SF) SRCMBR(&SM);          */
  //   >>IMPORTANT<<                                                 */
  //     >>PARM<<  OBJ(&LI/&OB);                                     */
  //     >>PARM<<  COMMIT(*NONE);                                    */
  //     >>PARM<<  OBJTYPE(*PGM);                                    */
  //     >>PARM<<  USER(*CURRENT);                                   */
  //     >>PARM<<  OPTION(*EVENTF);                                  */
  //     >>PARM<<  RPGPPOPT(*LVL2);                                  */
  //     >>PARM<<  CLOSQLCSR(*ENDACTGRP);                            */
  //     >>PARM<<  DATFMT(*ISO);                                     */
  //     >>PARM<<  TIMFMT(*ISO);                                     */
  //     >>PARM<<  DBGVIEW(*SOURCE);                                 */
  //     >>PARM<<  USRPRF(*OWNER);                                   */
  //     >>PARM<<  DYNUSRPRF(*OWNER);                                */
  //     >>PARM<<  SRTSEQ(*JOB);                                     */
  //   >>END-IMPORTANT<<                                             */
  //   >>CMD<<  CRTSRCPF FILE(QTEMP/QSOURCE) RCDLEN(268) MBR(*FILE); */
  //   >>EXECUTE<<                                                   */
  //   >>CMD<<  DLTF FILE(QTEMP/QSOURCE);                            */
  // >>END-PRE-COMPILER<<                                            */
  // *****************************************************************/

   ctl-opt option(*srcstmt:*nodebugio:*nounref);
   ctl-opt main(DECOLORE);
   ctl-opt dftactgrp(*no);
   ctl-opt actgrp(*new);
   ctl-opt bnddir('SERVICE');

   dcl-ds qsrcds_t ext extname('QSOURCE') template qualified end-ds;

   /copy QCPYSRC,UTIPROC

   dcl-c C_OVRDBF 'OVRDBF FILE(QSOURCE) TOFILE(${F}) MBR(${M}) +
                OVRSCOPE(*ACTGRPDFN)' ;

   // --------------------------------------------------
   // Main Procedure : DECOLORE
   // Purpose:         Retire les attributs d affichage dans un membre source
   //
   // Returns:         n/a
   //
   // Parameter:       p_membre --> Le membre source à traiter (obligatoire)
   // Parameter:       p_fic --> Le fichier du membre à traiter (QRPGLESRC par défaut)
   // Parameter:       p_lib --> La bibliothèque du fichier source (*LIBL par défaut)
   // --------------------------------------------------
   dcl-proc DECOLORE;

     dcl-pi *n;
       p_membre char(10) const;
       p_fic char(10) const options(*nopass);
       p_lib char(10) const options(*nopass);
     end-pi;

     dcl-ds ligne qualified;
       srcdta like(qsrcds_t.srcdta);
       col char(1) dim(%len(qsrcds_t.srcdta)) pos(1);
     end-ds;

     dcl-s idx uns(3); //index colonne
     dcl-s modif ind;  //modif apportée à la ligne à enregistrer

     dcl-s w_fichier char(21); //fichier qualifié
     dcl-s w_fic char(10) inz('QRPGLESRC');
     dcl-s w_lib char(10) inz('*LIBL');
     dcl-s cmd varchar(100);

     //si le fichier n'est pas passé en paramètre (ou à blanc) on prend QRPGLESRC
     if %parms >= %parmnum(p_fic) or p_fic = *blanks;
       w_fic = p_fic;
     endif;

     //si la bibliothèque n'est pas passée en paramètre on cherche le fichier
     // dans la liste de bibliothèques
     if %parms >= %parmnum(p_lib);
       w_lib = p_lib;
     endif;

     //si on a passé une bibliothèque à blanc en paramètre on prend la liste
     if w_lib <> *blanks;
       w_fichier = %trim(w_lib) + '/' + w_fic;
     else;
       w_fichier = '*libl/' + w_fic;
     endif;

     cmd = %scanrpl('${F}':%trim(w_fichier):C_OVRDBF);
     cmd = %scanrpl('${M}':%trim(p_membre):cmd);
     cmd_exec(cmd);

     exec sql
       declare c1 cursor for
         select q1.srcdta
           from qsource as q1
           for update;

     exec sql
       open c1;

     exec sql
       fetch c1 into :ligne.srcdta;

     dow sqlcode = 0;

       for idx = 1 to %len(%trimr(ligne.srcdta));
         if ligne.col(idx) < x'40';
           ligne.col(idx) = x'40';
           modif = *on;
         endif;
       endfor;
       if modif;
         modif = *off;
         exec sql
           update qsource as q
             set q.srcdta = :ligne.srcdta
             where current of c1;
       endif;

       exec sql
         fetch c1 into :ligne.srcdta;
     enddo;

     exec sql
       close c1;

     cmd_exec('DLTOVR FILE(QSOURCE)');

     *inlr = *on;


   end-proc; 

Remove offsettings into source members opened with RDi/LPEX