H NOMAIN DEBUG(*YES)
      *T: ReadSource()
      *O: CRTRPGMOD DBGVIEW(*ALL) OPTION(*NODEBUGIO)
      *C: CRTSRVPGM SRVPGM(&L/&N) MODULE(&N) EXPORT(*ALL)
      *C: ADDBNDDIRE BNDDIR(QGPL/UTILITY)  OBJ((&L/&N *SRVPGM))
      *
      *‚This module contains a single procedure called ReadSource().
      *‚ReadSource() simply opens a specified member in a specified source
      *‚file (typically QCLSRC) and reads every record in the member. It
      *‚assumes standard CL statement continuation rules (so statements can
      *‚span more than one line in the source member). Each statement is
      *‚passed to a user-defined procedure specified by the procedure
      *‚pointer passed as the third parameter to ReadSource().
      *
      *‚If ReadSource() encounters an error, it will immediately return a
      *‚value of -1. If it successfully processes all the statements in the
      *‚source file, it returns a 0.
      *
      *‚A typical call to ReadSource is as follows:
      *
      *‚  rc = ReadSource( qSrcFile : SrcMbr : %paddr( MyProc ) );
      *
      *‚The user-defined procedure should have the same procedure interface
      *‚as the ReadProc() procedure (although it does not need to based on
      *‚a procedure pointer). The user-defined procedure should return 0 or
      *‚-1 for each statement it processes.
      *
      *=====================================================================
     FQCLSRC    IF A F   92        DISK    UsrOpn
     F                                     Extfile(sSrcFile) ExtMbr(SrcMbr)
      *---------------------------------------------------------------------
      *‚Copybooks
      *---------------------------------------------------------------------
     D/COPY QRPGLECPY,PRCSRC_P                   ‚ReadSource() procedure prototype
      *---------------------------------------------------------------------
      *‚Global variables
      *---------------------------------------------------------------------
      *
     D sSrcFile        S             21A   Inz
     D qSrcFile        DS                  Inz
     D   SrcFile                     10A   Overlay(qSrcFile)
     D   SrcLib                      10A   Overlay(qSrcFile:*Next)
     D SrcMbr          S             10A   Inz
     D SrcRcd          DS                  Inz Qualified
     D   SrcSeq                       6S 2
     D   SrcDat                       6S 0
     D   SrcDta                      80A
      *
      *=====================================================================
      *‚ReadSource(): Read through a source file and call a specified
      *‚              procedure for each record read.
      *=====================================================================
     P ReadSource      B                   Export
     D                 PI            10I 0
     D   P_qSrcFile                  20A   Const
     D   P_SrcMbr                    10A   Const
     D   P_ReadProc@@                  *   Const ProcPtr
      *---------------------------------------------------------------------
     D outdata         S          32702A   Inz Varying
     D contchar        S              1A
      *---------------------------------------------------------------------
      /free

        //‚Open the specified file.

        qSrcFile = P_qSrcFile;
        if SrcLib = *blanks;
          SrcLib = '*LIBL';
        endif;
        sSrcFile = %trim( SrcLib ) + '/' + SrcFile;
        SrcMbr = P_SrcMbr;
        open(e) QCLSRC;
        if %error;
          exsr *pssr;
        endif;

        //‚Read every record in the file. Use standard CL continuation
        //‚rules to concatenate lines to form CL-type statements and pass
        //‚them to the procedure pointed to by the passed procedure pointer.

        ReadProc@@ = P_ReadProc@@;
        clear outdata;
        clear contchar;
        read(e) QCLSRC srcrcd;
        dow not %error and not %eof;
          select;
            when contchar = '+'; //‚'+': Remove leading/trailing blanks
              outdata = outdata + %trim( srcrcd.srcdta );
            when contchar = '-'; //‚'-': Remove trailing blanks only
              outdata = outdata + %trimr( srcrcd.srcdta );
            other;
              outdata = %trim( srcrcd.srcdta );
          endsl;
          if outdata <> *blanks;
            contchar = %subst( outdata : %len( outdata ) );
            if contchar = '+' or contchar = '-';       //‚Continued
              %len( outdata ) = %len( outdata ) - 1;   //‚command
            else;
              if ReadProc( outdata ) <> 0;
                exsr *pssr;
              endif;
              clear contchar;
              clear outdata;
            endif;
          endif;
          read(e) QCLSRC srcrcd;
        enddo;

        //‚Close the file.

        close(e) QCLSRC;
        if %error;
          exsr *pssr;
        endif;

        //‚Return

        return 0;

        //‚*PSSR error-handler.

        begsr *pssr;
          close(e) QCLSRC;
          dump(a);
          return -1;
        endsr;

      /end-free
     P                 E