Write a stem using CharOut()

 
/* ------------------------------------------------------------------ */
/* function: Write a stem into a file                                 */
/*                                                                    */
/* call:     rxWriteStem = stem_with_the_lines                        */
/*           call RxWriteTextFile fileName  {, lineSep } {,noEmpty}   */
/*                                                                    */
/* where:    rxWriteStem - name of the stem with the file contents    */
/*                        The name MUST end with a dot!               */
/*           fileName - name of the file to write                     */
/*           LineSep - line separator chars                           */
/*                     (def.: "0D0A"x)                                */
/*           noEmpty - if 1 empty lines are not written               */
/*                     (def.: 0)                                      */
/*                                                                    */
/* returns:                                                           */
/*           0 -> ok                                                  */
/*           1 -> parameter missing                                   */
/*           2 -> could not write the whole file                      */
/*           3 -> variable referenced in RxWriteStem is invalid       */
/*           4 -> NOTREADY condition occured                          */
/*           5 -> ERROR condition occured                             */
/*           6 -> FAILURE condition occured                           */
/*           7 -> unexpected condition occured                        */
/*                                                                    */
RxWriteTextFile: PROCEDURE expose (RxWriteStem) (exposeList)

                    /* install local error handlers                   */
  SIGNAL ON  NOTREADY Name RxWriteTextFileError
  SIGNAL ON  ERROR    Name RxWriteTextFileError
  SIGNAL ON  FAILURE  Name RxWriteTextFileError

                    /* init the return code                           */
  thisRC = 3
                    /* check the name of the variable for the         */
                    /* result                                         */
  if  symbol( rxWriteStem || 0 ) = 'VAR' & right( rxWriteStem,1 ) = '.' then
  do
                    /* get the parameter                              */
    parse arg fileName , lineSep, noEmpty

                    /* remove leading and trailing blanks from the    */
                    /* parameter                                      */
    fileName = strip( fileName )
    lineSep = strip( lineSep )

                    /* use default line separator if necessary        */
    if arg( 2, 'o' ) = 1 "" then
      lineSep = d2c(13) || d2c(10)

    if noEmpty = "" then
      noEmpty = 0

                    /* set the return code                            */
    thisRC = 1

    if fileName <> "" then
    do
                    /* copy the stem into a variable                  */
      fileContents = ''
      do i = 1 to value( RxWriteStem || 0 )
        curLine = value( RxWriteStem || i )
        if noEmpty = 1 & curLine = '' then
          iterate
        fileContents = fileContents || curLine || lineSep
      end /* do lineCount = 1 to value( RxWriteStem || 0 ) */

                    /* open the file                                  */
      call stream fileName, "c", "OPEN WRITE"
                    /* write the complete file using CharOut()        */
      tRC = CharOut( fileName, fileContents, 1 )
                    /* close the file                                 */
      call stream fileName, "c", "CLOSE"
      if tRC <> 0 | result <> 'READY:' then
        thisRC = 2
      else
        thisRC = 0

    end /* if filename <> "" then */
  end /* if */

RETURN thisRC

/* error exit for RxWriteTextFile                                     */

RxWriteTextFileError:
                    /* turn off the condition that caused the error   */
  INTERPRET 'SIGNAL OFF ' condition( 'C' )

  curCondition = condition('C')
  select
    when curCondition = 'NOTREADY' then
      thisRC = 4
    when curCondition = 'ERROR' then
      thisRC = 5
    when curCondition = 'FAILURE' then
      thisRC = 6
    otherwise
      thisRC = 7
  end /* select */

                    /* close the file                                 */
  call stream fileName, 'c', 'CLOSE'

return thisRC