PROCESS varchar
               apost
               nomonoprc
               nosync
               nostdtrunc

       IDENTIFICATION DIVISION.
       PROGRAM-ID.     ENVVAR.
       AUTHOR.       Scott Klement.
       

      *  Compile with:
      *
      *>  CRTCBLMOD MODULE(ENVVAR) SRCFILE(QCBLSRC) DBGVIEW(*ALL) -
      *>            OPTION(*SOURCE *EVENTF *IMBEDERR)
      *>  CRTPGM PGM(ENVVAR) BNDDIR(QC2LE) ACTGRP(*NEW)
      *  

       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM-I.
       OBJECT-COMPUTER. IBM-I.

      *****************************************************************
       DATA DIVISION.

      *****************************************************************
       WORKING-STORAGE SECTION.

       01  WS-VARNAME        PIC X(256).
       01  WS-VARVAL         PIC X(5000).

       01  WS-VARNAMEZ       PIC X(256).
       01  WS-VARVALZ        PIC X(5000).
       77  WS-VARVAL-PTR     USAGE IS POINTER VALUE NULL.
       77  WS-VARVALZ-PTR    USAGE IS POINTER VALUE NULL.
       01  WS-VARVALZ-LEN    PIC S9(8) USAGE BINARY VALUE 0.

       01  SETENV-STATUS     PIC S9(8) USAGE BINARY VALUE 0.
           88 SETENV-SUCCESS VALUE 0.
           88 SETENV-FAILURE VALUE -1.

      * ===============================================================
       LINKAGE SECTION.

       PROCEDURE DIVISION.

       000-MAIN-CONTROL SECTION.
       000.

           MOVE 'TAXRATE' TO WS-VARNAME.
           PERFORM GET-ENVIRONMENT-VARIABLE.
           IF WS-VARVAL = SPACES
             DISPLAY 'TAXRATE NOT SET'             
           ELSE
             DISPLAY WS-VARVAL
           END-IF.

           MOVE 'QIBM_QSH_CMD_ESCAPE_MSG' TO WS-VARNAME.
           MOVE 'Y' TO WS-VARVAL.
           PERFORM SET-ENVIRONMENT-VARIABLE.
           IF SETENV-FAILURE
             DISPLAY 'SETENV FAILED'
           END-IF.

           GOBACK.


      *****************************************************************
      *  ROUTINE TO GET AN ENVIRONMENT VARIABLE
      *
      *  INPUT:
      *     -WS-VARNAME = name of variable to retrieve
      *
      *  OUTPUT:
      *     -WS-VARVAL  = value of variable returned
      *****************************************************************

       GET-ENVIRONMENT-VARIABLE SECTION.
       BEG.

           MOVE SPACES TO WS-VARVAL

      * the getenv system API requires that strings end with a
      * x'00' value (because they are designed for C programs)           
      * This creates a WS-VARNAMEZ that contains the zeros at
      * the end.

           string function trimr(WS-VARNAME)
                  x'00' delimited by size
                  into WS-VARNAMEZ

      * Retrieve the environment variable. Get back a pointer.

           CALL PROCEDURE 'getenv'
                      USING WS-VARNAMEZ
                  RETURNING WS-VARVALZ-PTR
           END-CALL

           IF WS-VARVALZ-PTR = NULL
             GO TO XIT
           END-IF

      * Get the length of the environment variable
      * If it is larger than 5000 (the length of the WS-VARVAL 
      * variable) then set it to 5000. This way, we will not
      * copy more than can fit

           CALL PROCEDURE 'strlen'
                    USING BY VALUE WS-VARVALZ-PTR
               RETURNING WS-VARVALZ-LEN
           END-CALL               

           IF WS-VARVALZ-LEN > 5000
             MOVE 5000 TO WS-VARVALZ-LEN
           END-IF

      * Copy variable value into WS-VARVAL

           CALL PROCEDURE 'memcpy'
                    USING WS-VARVAL
                          BY VALUE WS-VARVALZ-PTR
                          BY VALUE WS-VARVALZ-LEN
               RETURNING  WS-VARVAL-PTR
           END-CALL
           .
       XIT.
           EXIT.           



      *****************************************************************
      *  ROUTINE TO SET AN ENVIRONMENT VARIABLE
      *
      *  INPUT:
      *     -WS-VARNAME = name of variable to set
      *     -WS-VARVAL  = value to set variable to
      *
      *  OUTPUT:
      *     -SETENV-STATUS will be 0 for success -1 for failure
      *****************************************************************

       SET-ENVIRONMENT-VARIABLE SECTION.
       BEG.
           initialize WS-VARVALZ

      * putenv() needs a variable in the format of
      *   MYVAR=MYVAL
 
      * and must be terminated with X'00'.

           string function trimr(WS-VARNAME)
                  '='
                  function trimr(WS-VARVAL)
                  x'00'
                  delimited by size
                  into WS-VARVALZ

           CALL PROCEDURE 'putenv'
                      USING WS-VARVALZ
                  RETURNING SETENV-STATUS
           END-CALL                  
           .

       XIT.
           EXIT.