/**************************    REXX    *****************************/
/*  Bruce Albert Woodworth    SETINIT                June 3,2002   */
/*                                                                 */
/*      This REXX EXEC returns a users initials which are          */
/*  associated with a particular logon id.  This EXEC is meant     */
/*  to be called from within another EXEC.                         */
/*      Sample:                                                    */
/*            init = setinit()                                     */
/*                                                                 */
/*******************************************************************/
/*  Bruce A. Woodworth    Improved immensely.        July 9,2002   */
/*  Bruce A. Woodworth    And even more            April 27,2003   */
/*******************************************************************/
    trace off
    parse upper arg a_question

    user_info = "@WCS001.BAW.USERINFO"
    id = userid()
    abort_sw = "N"
    user_eof = "N"

    if a_question = ?
    then
      do
        say "/**************************    REXX    *********************/"
        say "/*  Bruce Albert Woodworth    SETINIT          June 3,2002 */"
        say "/*                                                         */"
        say "/*      This REXX EXEC returns a users initials which are  */"
        say "/*  associated with a particular logon id.  This EXEC is   */"
        say "/*  meant to be called from within another EXEC.           */"
        say "/*      Sample:                                            */"
        say "/*            init = setinit()                             */"
        say "/*                                                         */"
        say "/***********************************************************/"
        exit
      end
    else
      do
        dsni = "'" ³³ user_info ³³ "'"
        ds_dsni = "dataset(" ³³ dsni ³³ ")"

        goodlib = listdsi(dsni)
        if goodlib = 0
        then
            call check_table
        else
            do
                tot_table_cnt = 0
                call create_new_init_tab
            end

        return(init)
      end

check_table:

    "allocate ddname(userfile)" ds_dsni "shr"

    call read_user_table
    do while chk_com = "/*" & user_eof = "N" & abort_sw = "N"
        call read_user_table
    end

    call read_user_table                    /* Skip REXX Library Name    */
    do while table_id <> id & user_eof = "N" & abort_sw = "N"
        call read_user_table
    end

    "execio 0 diskr userfile (finis"
    "free ddname(userfile)"

    if table_id = id
    then
        init = table_init
    else
        call add_user_initials_to_table

    return

add_user_initials_to_table:

    "allocate ddname(userfile)" ds_dsni "mod"

    call get_user_initials
    queue id init
    "execio 1 diskw userfile"

    "execio 0 diskw userfile (finis"
    "free ddname(userfile)"

    return

create_new_init_tab:

  call get_user_initials

  dcb_parms = "lrecl(80) blksize(800) recfm(f b) dsorg(ps)"
  space = "tracks space(2,2)"
  "allocate ddname(inittab)" ds_dsni "catalog" space dcb_parms

  queue "/****************************************************************/"
  queue "/*                                                              */"
  queue "/* User information file including:                             */"
  queue "/*                                                              */"
  queue "/*   REXX library file (for help comments). Dataset name should */"
  queue "/*   begin in column 1 and should be the first line after this  */"
  queue "/*   comment box.                                               */"
  queue "/*                                                              */"
  queue "/*   UserID and Initials Table.  Userid begins in column 1      */"
  queue "/*   followed by a space then 3 character initials.  The IDs    */"
  queue "/*   should start on the line following the REXX dataset name.  */"
  queue "/*                                                              */"
  queue "/****************************************************************/"
  queue " "
  queue id init

  cnt = 1
  do while queued() > 0
      "execio 1 diskw inittab"
      cnt = cnt + 1
  end

  "execio 0 diskw inittab (finis"
  "free ddname(inittab)"

  return

get_user_initials:

    say "Your initials are not in the ID file" dsni ³³ "."
    call get_init_from_user
    do while fld_size <> 3
        call get_init_from_user
    end

    return

get_init_from_user:

    say "Please enter your 3 character initials."
    parse upper pull init
    fld_size = length(init)
    fld_chk = substr(init,1,1)
    if datatype(fld_chk) = "NUM"
    then
        fld_size = 0

    return

read_user_table:

    "execio 1 diskr userfile"

    if rc = 2
    then
        user_eof = "Y"
    else
    if rc > 0
    then
        do
            say "Bad rc on" dsni "aborting job."
            abort_sw = "Y"
        end
    else
        do
            parse pull user_record
            chk_com = substr(user_record,1,2)
            parse var user_record table_id table_init the_rest
        end

    return