/*---------Language: REXX-------------------------------------$$PROLOG*/
/*     Program Name: LOGONRCS.CMD                                     */
/*      Description: Common logon script for ALL RC/MVS sessions.     */
/*    Customization: See sections marked <CUSTOMIZE>, below.          */
/*                   1. Update applid/userid/password table.          */
/*                   2. Update screen search table for your USS screen*/
/* Input Parameters: SESSION(session name) DEBUG                      */
/*    Statvars Used: None                                             */
/*       Invocation: Invoked by rule watching for LOGONRCS.SCR to run.*/
/*          Invokes: None                                             */
/*     Return Codes: 0  - Successful Completion                       */
/* Related Routines: LOGONRCS.SCR, LOGONRCS.RUL                       */
/*     Base Release: CA-Automation Point 3.2                          */
/*     Restrictions: None                                             */
/*     Dependencies: None                                             */
/*       Change log: Add new entries to the top                       */
/*-----------------Changed 09-JUL-1999 by: Bob Stark -------------1.0-*/
/* 1. Cleanup for distribution.                                       */
/*-----------------Changed 12-NOV-1998 by: Bob Stark -----------------*/
/* 1. Initial coding                                                  */
/*--------------------------------------------------------------------*/
/* Copyright (C) 1999 ProTech Professional Technical Services. No war-*/
/* ranty expressed or implied. Permission to use, copy, and distribute*/
/* this document without fee is hereby granted, provided that this    */
/* copyright notice appear in all copies.  Permission to modify the   */
/* code is granted, but not the right to distribute the modified code,*/
/* which should be returned to the maintainer for inclusion into the  */
/* distributed version.  Contacts: 412-373-8855  www.protechpts.com   */
/*--------------------------------------------------------------------*/

CALL   ON ERROR   NAME RXERROR
SIGNAL ON SYNTAX  NAME RXERROR
SIGNAL ON NOVALUE NAME RXERROR
TRACE N

/* <CUSTOMIZE> - Add entries for all AutoPnt systems & RC/MVS systems.*/
/* USERTBL.hostname.sessname = 'applid userid password'               */
USERTBL.MINIMAN.MVSA = "'LOGON APPLID(RCSA)'    AUTOMAN1 SECRET"
USERTBL.MINIMAN.MVSB = "'LOGON APPLID(RCSB)'    AUTOMAN1 SECRET"
USERTBL.MINIMAN.TSOA = "'LOGON APPLID(ASYSTSO)' AUTOMAN1 SECRET"
USERTBL.MINIMAN.TSOB = "'LOGON APPLID(BSYSTSO)' AUTOMAN1 SECRET"
USERTBL.MVSMAN.MVSA  = "'LOGON APPLID(RCSA)'    AUTOMAN2 SECRET"
USERTBL.MVSMAN.MVSB  = "'LOGON APPLID(RCSB)'    AUTOMAN2 SECRET"
USERTBL.MVSMAN.TSOA  = "'LOGON APPLID(ASYSTSO)' AUTOMAN2 SECRET"
USERTBL.MVSMAN.TSOB  = "'LOGON APPLID(BSYSTSO)' AUTOMAN2 SECRET"

debug   = ''
session = ''

rc = KWPARSE(TRANSLATE(ARG(1)))
IF rc <> 0
THEN CALL ERRMSGX 'KWPARSE Failed, rc='rc

rc = KWVALID('SESSION','NONBLANK')
IF rc <> 0
THEN CALL ERRMSGX rc

IF debug <> '' THEN TRACE I

/*--------------------------------------------------------------------*/
/* Determine our TCP/IP hostname                                      */
/*--------------------------------------------------------------------*/

rc = CMDRESP('HOSTNAME')
PULL hostname

IF SYMBOL('USERTBL.'hostname'.'session) = 'LIT'
THEN CALL ERRMSGX 'No userid defined for HOSTNAME('hostname')',
                  'SESSION('session')'
/*--------------------------------------------------------------------*/
/* See if the applid is embedded in quotes, or just one word.         */
/*--------------------------------------------------------------------*/
IF POS("'",USERTBL.hostname.session) > 0
THEN PARSE VAR USERTBL.hostname.session "'" applid "'" userid password
ELSE PARSE VAR USERTBL.hostname.session applid userid password

/*--------------------------------------------------------------------*/
/* Look for one of the following screens.  If found, interact with    */
/* that screen to get us onto the next one.                           */
/*======================================================================

 ACME DYNAMITE MANUFACTURING COMPANY, INC.

 "ALL OF OUR PRODUCTS BLOW UP!"

          YOU SHOULD SEARCH FOR A SIMILAR USS VTAM LOGON SCREEN IN
          USE AT YOUR SITE, AND ENTER IT INTO THE SEARCH ALGORITHM
          BELOW.


ENTER LOGON:












========================================================================
        CA REMOTE CONSOLE A PRODUCT OF COMPUTER ASSOCIATES INTERNATIONAL
                                   RRRR     CCCC
                                   R   R   C
                                   RRRR    C          //
          /³TTTTTTTTTTTTTTTTT³     R  R    C        //
        /' ³³³¿¿¿¿¿¿¿¿¿¿¿¿¿³³³     R   R    CCCC  //
   ___/'   ³³³  REMOTE     ³³³                  //
  ³³³³     ³³³   CONSOLE   ³³³   ACME         //   M   M  V   V   SSSS
  ³³³³     ³³³     2.2     ³³³    DYNAMITE  //     MM MM  V   V  S
  ³³³³     ³³³             ³³³     MANUFACTURING   M M M  V   V   SSS
  ³³³³     ³³³    MVSA     ³³³      COMPANY        M   M   V V       S
  'LLL__   ³³³_____________³³³                     M   M    J    SSSS
      ¿¿`\__LLLLLLLLLLLL³¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿¿\
 ______L¿¿`=============³\`#\##########\###\`\_______________________
 \      `================\>___________________>                      \
  \___________________________________________________________________\



 TERMINAL:CM341      USERID: automan1 PASSWORD:          NEW:
 CMDLIB MEMBER:



========================================================================
  *13.40.36 SP J6228 *MIM1040 LPTA220M WAITING FOR RESOURCES
  *13.40.49 SP J6236 *MIM1040 VPTA220M WAITING FOR RESOURCES
  -13.40.50 SP S3439  IST891I  USCESNET.WMDP              GENERATED FAILURE
  - NOTIFICATION
  -13.40.50 SP S3439  IST889I  SID = C18732B177B87937
  -13.40.50 SP S3439  IST894I  ADJSSCPS TRIED  FAILURE SENSE   ADJSSCPS TRIED
  - FAILURE SENSE
  -13.40.50 SP S3439  IST895I     CMDP            08260000        CMDT
  -   087D0001
  -13.40.50 SP S3439  IST895I     FDMSS           087D0001        FDMSR
  -   087D0001
  -13.40.50 SP S3439  IST895I     WMDP            087D0001        TMDM
  -   087D0001
  -13.40.50 SP S3439  IST895I     SGSYSI          08420000        CMDQ
  -   087D0001
  -13.40.50 SP S3439  IST895I     FDMSX           08420000        CMDG
  -   087D0001
  -13.40.50 SP S3439  IST895I     FDMSK           087D0001
  -13.40.50 STS21444  IST889I  SID = C18732B177B87937
  -13.40.50 STS21444  IST889I  SID = C18732B177B87938
  *13.41.01 SP J5823 *IOS003A 0102,INTERVENTION REQUIRED, RELOAD TAPE
 RCS5663  CA-RCS    2.2 SP(SYSP) 13:41:04 MODE=RD   SP ST


======================================================================*/

power_reset = 0           /* We have NOT power reset terminal this run*/

/*--------------------------------------------------------------------*/
/* Check for a lightning bolt on the screen, indicating that the      */
/* controller has lost touch with the host.  If this is a dual host   */
/* controller, we could be talking to the inactive side.  Try         */
/* switching to the other side.  The 3270_1 and 3270_2 keystrokes     */
/* must be custom mapped to ALT-A and ALT-B in a 3270xxx.COD file for */
/* this to work.                                                      */
/*--------------------------------------------------------------------*/

ADDRESS AXC "GETSCRN SESSION("session") PREFIX(NO)"
oia = TRANSLATE(oia)
/* SAY 'OIA='oia */

IF POS('Z_50',oia) > 0 THEN
  DO
  PARSE VAR oia 5 host 6
  IF host = 'A'
  THEN keystroke = '@"3270_2"'   /* Switch it to B                    */
  ELSE keystroke = '@"3270_1"'   /* Any others, switch it back to A   */
  ADDRESS AXC "SESSCMD '"keystroke"' SESSION("session") PREFIX(NO)"
  END

/*--------------------------------------------------------------------*/
/* If the keyboard is locked, press RESET.                            */
/*--------------------------------------------------------------------*/
PARSE VAR oia 8 xstate 10
IF POS('X', xstate) > 0 THEN
  DO
  keystroke = '@"RESET"@"SEND"'  /* RESET key                         */
  ADDRESS AXC "SESSCMD '"keystroke"' SESSION("session") PREFIX(NO)"
  END

/*--------------------------------------------------------------------*/
/* Loop here for awhile, look for known screen states, and deal with  */
/* them, to get to the desired screen state.  If we can't get there   */
/* many tries, we give up (we'll retry later).                        */
/* <CUSTOMIZE> - Customize this search for your site's VTAM screens!  */
/*--------------------------------------------------------------------*/
  DO i = 1 TO 20
  rc = LOOKFOR("0,",
                 "' RCS5663  ',",
                 "'ENTER LOGON:',",
                 "'//   M   M  V   V   SSSS',",
                 "'PREVAIL/XP-REMOTE CONSOLE',",
                 "'USSMSG00',",
                 "'USSMSG',",
                 "'THE USERID ENTERED IS INVALID'",
              )
    SELECT
/*--------------------------------------------------------------------*/
/*  - RCS5635 - HELP FOR:                    DATA LINE     1 OF   263 */
/*  -   HELP IS AVAILABLE FOR THE FOLLOWING INFORMATION               */
/*  - ACCOUNT   AUTHCHK   CLIST     COMMANDS  CP        CPCMD     D   */
/*  - DEFALIAS  DISC      DOM       DPFK      END       FIND      HELP*/
/* RCS5663  CA-RCS    2.2 SW(SYSW)  9:44:08 MODE=N    SP ST           */
/*--------------------------------------------------------------------*/
    WHEN rc = 1 THEN               /* Did we find string # 1?         */
      DO
      /*--------------------------------------------------------------*/
      /* Remote Console can get stuck in the Automation Point console */
      /* driver if there is a display area on the screen.  Look for   */
      /* one, and if you find it, get rid of it.                      */
      /*--------------------------------------------------------------*/
      PARSE VAR screen ' DATA LINE ' curline ' OF ' totlines . ,
                       ' RCS5663 ' +0 tagline .
      IF DATATYPE(totlines,'W') = 1 & tagline = ' RCS5663 ' THEN
        DO
        ADDRESS AXC "SESSCMD '@0@Bk e,d@E'",
          "SESSION("session") PREFIX(NO)"
        ADDRESS AXC "SESSCMD '@0@Bk a,none@E'",
          "SESSION("session") PREFIX(NO)"
        END
      LEAVE i                      /* Yes, we're already in RC/MVS    */
      END
    WHEN rc = 2 THEN               /* Did we find string # 2?         */
      DO                           /* We're at the USS logon screen   */
      ADDRESS AXC "SESSCMD '@C'",
        "SESSION("session") PREFIX(NO)"
      ADDRESS AXC "SESSCMD '"applid"@E'",
        "SESSION("session") PREFIX(NO)"
      END
    WHEN rc = 3 | rc = 4 THEN      /* Did we find string # 3 or 4?    */
      DO                           /* We're at the RC/MVS logon screen*/
      ADDRESS AXC "SESSCMD '@0"userid"@T"password"@E'",
        "SESSION("session") PREFIX(NO)"
      END
    WHEN rc = 5 THEN               /* Did we find string # 5?         */
      DO                           /* This is a transient situation   */
      /* USSMSG00 - CM331    LOGON TO APPLID IS IN PROGRESS           */
      ADDRESS AXC "WAIT 1"
      END
    WHEN rc = 6 THEN               /* Did we find string # 6?         */
      DO
      /*--------------------------------------------------------------*/
      /* See if we've already tried doing a Power-on reset of the     */
      /* Terminal session.  If not, do it.  This seems to be the only */
      /* way to get a fresh menu screen, uncluttered by error         */
      /* messages from previous failed logon attempts.                */
      /*--------------------------------------------------------------*/
      IF power_reset = 0 THEN
        DO
        power_reset = 1
        ADDRESS AXC "SESSCMD '"'@"POWER_RESET"'"'",
          "SESSION("session") PREFIX(NO)"
        END
      ELSE
        DO
        /* USSMSG07 - CM331    SESSION INITIALIZATION FAILED - INIT SE*/
        PARSE VAR screen 'USSMSG' +0 errmsg
        CALL ERRMSGX 'Unable to logon to 'applid': ' errmsg
        END
      END
    WHEN rc = 7 THEN               /* Did we find string # 7?         */
      DO
      /*--------------------------------------------------------------*/
      /* Our RC/MVS Userid is no good.                                */
      /*--------------------------------------------------------------*/
      CALL ERRMSGX 'Unable to logon to 'applid': USERID 'userid,
                   'is invalid'
      END
    OTHERWISE
      /* CALL ERRMSGX 'Screen is in unrecognized state' */
    END /* SELECT */
  END i

/*--------------------------------------------------------------------*/
/* If we've made it, issue some commands to configure RC/MVS to       */
/* receive the messages that we want.                                 */
/*--------------------------------------------------------------------*/
IF LOOKFOR("0,' RCS5663  '") = 1 THEN
  DO
  ADDRESS AXC "SESSCMD 'RCOL ADD,SYSID=ALL,MSGID=ALRT*@E'",
    "SESSION("session") PREFIX(NO)"
  ADDRESS AXC "SESSCMD 'RCOL ADD,SYSID=ALL,MSGID=ATMC*@E'",
    "SESSION("session") PREFIX(NO)"
  END

/*--------------------------------------------------------------------*/
/* If a script is running concurrently with us, and watching the      */
/* screen, let him know that he can clean up and exit                 */
/*--------------------------------------------------------------------*/
ADDRESS AXC 'GETVAR SCRIPTSTATUS_'session 'SCRIPTSTATUS'
IF TRANSLATE(scriptstatus) = 'ACTIVE' THEN
  DO
  ADDRESS AXC "SESSCMD '"'script can end now@B@"SEND"'"'",
    "SESSION("session") PREFIX(NO)"
  END

EXIT:
IF SYMBOL('max_rc') = 'LIT'
THEN max_rc = 0
EXIT max_rc

/*--------------------------------------------------------------------*/
/* RXCOPY routines follow (in alphabetical order)                     */
/*--------------------------------------------------------------------*/

/*RXCOPY ERRMSGX **** 22 LINES COPIED ON 11-11-98 AT 15:18*************/
/*-Start of ERRMSGX function----------------------------Version-01.02-*/
/*:ERRMSGX SUBROUTINE: Issues a formatted error message and exits.    */
/* Parameters: Message text                                           */
/* DOES NOT RETURN!                                                   */
/* For example:                                                       */
/* IF missing <> ''                                                   */
/* then call ERRMSGX('Missing required parameter(s):'missing)         */
/* Copyright (C) 1996 Washington Systems. All rights reserved.        */
/*--------------------------------------------------------------------*/
ERRMSGX:
TRACE N
PARSE ARG _errmsgx_text
PARSE SOURCE . . _errmsgx_filename .
_errmsgx_errtext = 'REXX Error: '_errmsgx_filename' '_errmsgx_text
SAY _errmsgx_errtext
IF ADDRESS() = 'AXC' THEN
  DO
  ADDRESS AXC "WTXC '"_errmsgx_errtext"'"
  ADDRESS AXC "WTO '"_errmsgx_errtext"'"
  END
SIGNAL EXIT
/*-End of ERRMSGX  function-------------------------------------------*/

/*RXCOPY KWPARSE **** 128 LINES COPIED ON 11-11-98 AT 15:18************/
/*Start of KWPARSE Function-----------------------------Version-01.03-*/
/*:KWPARSE Subroutine: Extracts keyword parameters from the data      */
/* passed to it, and sets the value of the keyword into REXX          */
/* variables that match the keyword name.  KWPARSE supports two       */
/* methods of defining allowable keywords:                            */
/* 1. Define keywords as rexx variables before calling KWPARSE, and   */
/*    leave off the 2nd positional parm.                              */
/* 2. List the keywords by name in the 2nd positional parm.  This     */
/*    method is preferable if you have other active rexx variables    */
/*    might get mistaken for parms and reset, or if you want to       */
/*    support abbreviated keywords.                                   */
/* Returns: 0:    Data parsed successfully.                           */
/*          text: Error occured, text gives the details.              */
/* For example:                                                       */
/*   PARSE ARG parms           <* Copy callers arguments to rexx var  */
/*   parms    = "MSG('Hello world') DEBUG SELFTEST"                   */
/*   msg      = 'Test message' <* Define 'MSG' keyword default        */
/*   selftest = ''             <* Define 'SELFTEST' keycode           */
/*   debug    = ''             <* Define 'DEBUG' keycode              */
/*   CALL kwparse(parms)       <* Call KWPARSE w/ imlicit kw defn.    */
/*     <or>                                                           */
/*   CALL kwparse(parms,'MSG SELFTEST DEBUG'  <*w/ exlicit kw defn.   */
/*                                                                    */
/* Usage Notes:                                                       */
/* o Keycode variables that have been parsed will be set to their     */
/*   own names. To test for their presence, check for non-null, ie:   */
/*     IF DEBUG <> '' THEN TRACE R                                    */
/* o Invalid keywords are warned with a msg, ignored, and retcode = 4 */
/* o Some invalid input isn't detectible, e.g. a keyword w/o parens   */
/*   is treated as a keycode, and visa versa.                         */
/* o If you specify a keyword list (2nd positional parm), then        */
/*   keywords may be abbreviated, if the abbreviation is unique.      */
/* Copyright (C) 1998 Washington Systems. All rights reserved.        */
/*--------------------------------------------------------------------*/
KWPARSE:
TRACE Normal                       /* Turn off rexx tracing           */
PARSE arg _parm                    /* Copy calling arguments          */
PARSE version _rxlang _rxversion .
IF _rxlang='REXX370' & _rxversion<3.52  /* Is diadic VALUE() avail?   */
THEN _dvalue = 0                        /* No, have to interpret      */
ELSE _dvalue = 1                        /* Yes, remember to use it.   */
_kwparse_maxrc = ''                /* Initialize return code          */
  DO _i = 1 TO 2                   /* 2 passes, most specific to      */
                                   /*  least, starting w/ quoted data */
  /*------------------------------------------------------------------*/
  /* Keyword extraction logic: Extract all keyword parameters,        */
  /* eliminating them and their data from _PARM as each one is        */
  /* found.  REVERSE is used to make the last word of _PARML (the     */
  /* keyword) into the first word, because parse can be used to       */
  /* extract the first word from a string, but there is no REXX       */
  /* function to extract the last word from a string.                 */
  /*------------------------------------------------------------------*/
    DO WHILE _parm <> ''           /* Done if we run out of input     */
      SELECT
      WHEN _i = 1 THEN PARSE VAR _parm,
        _parml "('" +0 _delim +2 _value "')" _parmr
      WHEN _i = 2 THEN PARSE VAR _parm,
        _parml "(" +0 _delim +1 _value ")" _parmr
      END /* SELECT */
    IF _delim = '' THEN LEAVE      /* No keywords left, we're done    */
    PARSE VALUE REVERSE(_parml) WITH _kw _parml       /* get keyword  */
    _kw = TRANSLATE(REVERSE(_kw))  /* Un-reverse & upcase the keyword */
    _parm = REVERSE(_parml)_parmr  /* Glue remaining parms together   */
    IF KWPARSE_KWVALID(ARG(2)) <> '' THEN /* Keyword valid?           */
      IF _dvalue                        /* Diadic VALUE() available?  */
      THEN _value = VALUE(_kw,_value)   /* Yes, use it.               */
      ELSE INTERPRET _kw" = VALUE('_value')" /* No, use interpret.    */
    END /* DO WHILE _parm <> '' */
  END /* DO _i = 1 to 2 */

/* Final pass extracts one-word  "Keycodes", like DEBUG               */
DROP _value
  DO WHILE _parm <> ''
  PARSE UPPER VAR _parm _kw _parm  /* Extract one "keycode"           */
  IF KWPARSE_KWVALID(ARG(2)) <> '' THEN /* Keyword valid?             */
    IF _dvalue                     /* Diadic VALUE() available?       */
    THEN CALL VALUE _kw,_kw        /* Yes, use enhanced value         */
    ELSE INTERPRET _kw" = VALUE('_kw')" /* No, use interpret.         */
  END /* DO WHILE _parm <> '' */
DROP _parm _parml _parmr _delim _i _j _kw _value _rxlang,
  _rxversion _dvalue _kwfull
IF _kwparse_maxrc = '' THEN _kwparse_maxrc = 0
return _kwparse_maxrc

KWPARSE_KWVALID:
IF ARG(1) <> '' THEN               /* Keyword list passed by caller?  */
  DO                               /* Yes, use it to determine kw name*/
  IF WORDPOS(_kw,TRANSLATE(ARG(1)))=0 THEN /* KW not in list?         */
    DO                             /* No. Look for abbrev.            */
    _kwfull=''      /* See if keywd is a unique abbreviation in list  */
      DO _j = 1 to WORDS(ARG(1))   /* Look at each keyword in list    */
      IF ABBREV(TRANSLATE(WORD(ARG(1),_j)),_kw)             /* Abbrev?*/
      THEN _kwfull=_kwfull TRANSLATE(WORD(ARG(1),_j))       /* Yes.   */
      END _j
    IF WORDS(_kwfull) = 1          /* Unique keyword found, Replace   */
    THEN _kw = STRIP(_kwfull)      /* abbrev w/ full, and fall thru.  */
    ELSE
      DO
      IF WORDS(_kwfull) > 1 THEN   /* Found, but not unique. Sorry.   */
        IF SYMBOL('_value') = 'VAR'
        THEN _kwparse_maxrc = _kwparse_maxrc,
             'Ignoring ambiguous keyword:'_kw'('_value'),',
             'could be any one of '_kwfull';'
        ELSE _kwparse_maxrc = _kwparse_maxrc,
             'Ignoring ambiguous keycode:'_kw',',
             'could be any one of '_kwfull';'
      ELSE
        IF SYMBOL('_value') = 'VAR'
        THEN _kwparse_maxrc = _kwparse_maxrc,
             'Ignoring unrecognized keyword:'_kw'('_value');'
        ELSE _kwparse_maxrc = _kwparse_maxrc,
             'Ignoring unrecognized keycode:'_kw';'
      RETURN ''                    /* Get next parm                   */
      END
    END
  END
ELSE                               /* No explicit keyword list,       */
  IF symbol(_kw) <> 'VAR' THEN     /*  see if keyword is a rexx var.  */
    DO
    IF SYMBOL('_value') = 'VAR'
    THEN _kwparse_maxrc = _kwparse_maxrc,
         'Ignoring unrecognized keyword:'_kw'('_value');'
    ELSE _kwparse_maxrc = _kwparse_maxrc,
         'Ignoring unrecognized keycode:'_kw';'
    RETURN ''                      /* Get next parm                   */
    END
RETURN _kw
/*End of KWPARSE function---------------------------------------------*/

/*RXCOPY KWVALID **** 239 LINES COPIED ON 11-11-98 AT 15:18************/
/*-Start of KWVALID function----------------------------Version-01.02-*/
/*:KWVALID Function: Validates that a keyword is set validly. Useful  */
/*                   in subroutines that support a lot of keywords.   */
/*   Parms: name, validtypes, exitlabel                               */
/*   where: name       is the name of a REXX variable.                */
/*         validtypes List of one or more parm types, as follows:     */
/*                    DATE(mm/dd/yyyy) DSNAME MEMBER LIST(a,b)        */
/*                    NONBLANK RANGE(min,max) TIME(hh:mm)             */
/*                    TIME(hh:mm:ss) REXXVAR                          */
/*         exitlabel  is optional - if provided, KWVALID will         */
/*                    SIGNAL to that label if parm is invalid.        */
/*                    If not provided, KWVALID returns 0 or error text*/
/* Returns:      0 if valid, error message if not.                    */
/* Example:      rc = KWVALID('OPTION','LIST(CREATE,UPDATE)','EXIT'); */
/* Copyright (C) 1997 Washington Systems. All rights reserved.        */
/*--------------------------------------------------------------------*/
KWVALID:
TRACE Normal
_kwname = ARG(1)
IF ARG() < 2 THEN
  DO
  _kwerrmsg = 'Must pass 2 or more arguments to KWVALID'
  SIGNAL KWNVALID
  END
IF SYMBOL(ARG(1)) <> 'VAR' THEN
  DO
  _kwerrmsg = ARG(1)' parm not initialized'
  SIGNAL KWNVALID
  END
ELSE _kwvalue = VALUE(_kwname)

_kwtypes = TRANSLATE(ARG(2))

  DO WHILE _kwtypes <> ''
  PARSE VAR _kwtypes _kwtype _kwtypes
  PARSE VAR _kwtype _kwdatatype '(' _kwdataval ')' .

    SELECT

    WHEN _kwdatatype = 'TIME' THEN
      DO
      IF TRANSLATE(_kwdataval) = 'HH:MM:SS' THEN
        DO
        PARSE VAR _kwvalue _kwhh ':' _kwmm ':' _kwss
        IF _kwhh < 0 | _kwhh > 23 | _kwmm < 0 | _kwmm > 59 | ,
           _kwss < 0 | _kwss > 59 THEN
          DO
          _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                      'invalid TIME(hh:mm:ss)'
          SIGNAL KWNVALID
          END
        END
      IF TRANSLATE(_kwdataval) = 'HH:MM' THEN
        DO
        PARSE VAR _kwvalue _kwhh ':' _kwmm
        IF _kwhh < 0 | _kwhh > 23 | _kwmm < 0 | _kwmm > 59 THEN
          DO
          _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                      'invalid TIME(hh:mm)'
          SIGNAL KWNVALID
          END
        END
      END

    WHEN _kwdatatype = 'DATE' THEN
      DO
      IF TRANSLATE(_kwdataval) = 'MM/DD/YYYY' THEN
        DO
        PARSE VAR _kwvalue _kwmm '/' _kwdd '/' _kwyy
        IF _kwmm < 1 | _kwmm > 12 | _kwdd < 1 | _kwmm > 31 | ,
           _kwyy < 0 | _kwyy > 9999 THEN
          DO
          _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                      'invalid DATE(mm/dd/yyyy)'
          SIGNAL KWNVALID
          END
        END
      END

    WHEN _kwdatatype = 'DSNAME' THEN
      DO
      _kwvalue = TRANSLATE(STRIP(_kwvalue))
      IF _kwvalue = '' THEN
        DO
        _kwerrmsg = _kwname'() parm invalid -',
                    'value must be a non-blank dataset name'
        SIGNAL KWNVALID
        END
      IF LENGTH(_kwvalue) > 44 THEN
        DO
        _kwerrmsg = 'Error, '_kwname'() parm invalid -',
                    'value is too long to be a valid dataset name'
        SIGNAL KWNVALID
        END
      _kwvrng1 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$' /*Valid for 1st char */
      _kwvrng2 = VALUE('_KWVRNG1')'0123456789.'  /*Valid for rest of  */
      _kwvtemp = _kwvalue
        DO WHILE _kwvtemp <> ''
        PARSE VAR _kwvtemp _kwvnode '.' _kwvtemp
        IF LENGTH(_kwvnode) > 8 | LENGTH(_kwvnode) < 1 THEN
          DO
          _kwerrmsg = _kwname'() parm invalid -',
                      'invalid characters in dataset name'
          SIGNAL KWNVALID
          END
        IF POS(LEFT(_kwvnode,1),_kwvrng1) = 0 THEN
          DO
          _kwerrmsg = _kwname'() parm invalid -',
                      'invalid character to start dataset name'
          SIGNAL KWNVALID
          END
        /* Translate all valid characters into dots, and if result is */
        /* all dots, then it is valid.                                */
        IF TRANSLATE(SUBSTR(_kwvnode, 2, LENGTH(_kwvnode)-1), '',,
                     _kwvrng2,'.')<>COPIES('.',LENGTH(_kwvnode)-1) THEN
          DO
          _kwerrmsg = _kwname'('_kwvalue') parm invalid',
                      ' - invalid character in dataset name'
          SIGNAL KWNVALID
          END
        END /* DO WHILE _kwvtemp <> '' */
      END  /* WHEN _kwdatatype = 'DSNAME' THEN */

    WHEN _kwdatatype = 'LIST' THEN
      DO
      _kwdataval = TRANSLATE(_kwdataval,'',',',' ')
      IF WORDPOS(_kwvalue,_kwdataval) = 0 THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'must be one of: '_kwdataval
        SIGNAL KWNVALID
        END
      END

    WHEN _kwdatatype = 'MEMBER' THEN
      DO
      IF WORDS(_kwvalue) <> 1 | LENGTH(_kwvalue) > 8 THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'must be a valid PDS member name'
        SIGNAL KWNVALID
        END
      _kwvrng1 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ@#$' /*Valid for 1st char */
      _kwvrng2 = VALUE('_KWVRNG1')'0123456789.'  /*Valid for rest of  */
      IF POS(TRANSLATE(LEFT(_kwvalue,1)),_kwvrng1) = 0 THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'invalid characters in member name'
        SIGNAL KWNVALID
        END
      /* Tricky... Translate all the valid characters into dots, and  */
      /* if result is all dots, then it is valid.                     */
      IF TRANSLATE(SUBSTR(_kwvalue,2,LENGTH(_kwvalue)-1),,
                   '',_kwvrng2,'.'),
         <> COPIES('.',LENGTH(_kwvalue)-1) THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'invalid characters in member name'
        SIGNAL KWNVALID
        END
      END

    WHEN _kwdatatype = 'NONBLANK' THEN
      DO

      IF WORDS(_kwvalue) = 0 THEN
        DO
        _kwerrmsg = _kwname'() parm invalid -',
                    'value must be non-blank'
        SIGNAL KWNVALID
        END
      END

    WHEN _kwdatatype = 'RANGE' THEN
      DO
      PARSE VAR _kwdataval _kwlower ',' _kwupper .
      IF _kwvalue < _kwlower | _kwvalue > _kwupper THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'range must be: '_kwlower' <= '_kwname' <= '_kwupper
        SIGNAL KWNVALID
        END
      END

    WHEN _kwdatatype = 'REXXVAR' THEN
      DO
      IF WORDS(_kwvalue) <> 1 THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'must be a valid REXX variable name without blanks'
        SIGNAL KWNVALID
        END
      _kwvrng1 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ?!_' /*Valid for 1st char */
      _kwvrng2 = VALUE('_KWVRNG1')'0123456789.'  /*Valid for rest of  */
      IF POS(TRANSLATE(LEFT(_kwvalue,1)),_kwvrng1) = 0 THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'invalid characters in variable name'
        SIGNAL KWNVALID
        END
      /* Tricky... Translate all the valid characters into dots, and  */
      /* if result is all dots, then it is valid.                     */
      IF TRANSLATE(SUBSTR(_kwvalue,2,LENGTH(_kwvalue)-1),,
                   '',_kwvrng2,'.'),
         <> COPIES('.',LENGTH(_kwvalue)-1) THEN
        DO
        _kwerrmsg = _kwname'('_kwvalue') parm invalid -',
                    'invalid characters in variable name'
        SIGNAL KWNVALID
        END
      END /* WHEN _kwdatatype = 'REXXVAR' THEN */

    OTHERWISE
      _kwerrmsg = _kwdatatype' is an invalid KWVALID()',
                  'datatype'
      SIGNAL KWNVALID
    END /* SELECT */


  END /* DO WHILE */

/* Cleanup our variables before we exit...                            */
DROP _kwdatatype _kwdataval _kwlower _kwname _kwtype _kwtypes _kwtypes,
     _kwupper _kwvalue _kwvnode _kwvrng1 _kwvrng2 _kwvtemp _kwvtemp
RETURN 0                           /* All tests passed, keyword valid */

KWNVALID:
PARSE SOURCE . . _kwnfilename .
PARSE VALUE REVERSE(_kwnfilename) WITH _kwnfilename '\'
_kwnfilename = REVERSE(_kwnfilename)
IF ARG() >= 3 THEN
  DO
  SAY 'Error calling '_kwnfilename': '_kwerrmsg
  rc = _kwerrmsg
  SIGNAL VALUE ARG(3)
  INTERPRET "SIGNAL "ARG(3)        /* For platforms w/o SIGNAL VALUE  */
  END
RETURN _kwerrmsg
/*-End of KWVALID  function-------------------------------------------*/

/*RXCOPY LOOKFOR **** 50 LINES COPIED ON 11-11-98 AT 15:18*************/
/*-Start of LOOKFOR  function---------------------------Version-01.02-*/
/*:LOOKFOR SUBROUTINE: Searches the screen repeatedly for one of a    */
/* series of character strings, until one of the search strings is    */
/* found or the timeout value expires.  Search is case INsensitive.   */
/* Parameters: Timeout value (in seconds), variable list of strings   */
/* Returns:    string number, -1 if timeout, -2 if an error occurs    */
/* For example: T2=LOOKFOR("10,'PAGER ID:','INVALID PAGER:'")         */
/* If multiple strings are on the screen, the longest one closest to  */
/* the BOTTOM of the screen is returned.                              */
/* Copyright (C) 1996 Washington Systems. All rights reserved.        */
/*--------------------------------------------------------------------*/
LOOKFOR: PROCEDURE EXPOSE session screen gbl.
TRACE N
PARSE UPPER ARG timeout ',' strings/* Uppercase all search strings    */
  DO i=1 to 255 while strings <> ''/* Extract strings into an array   */
  parse var strings "'" string "'" . "," strings
  string.i = REVERSE(string)       /* reverse each search string      */
  END
string.0 = i-1                     /* save number of search strings   */
timeout = timeout+TIME('E')        /* Calculate timeout value         */
  DO UNTIL TIME('E') > timeout     /* Search until found or timeout   */
  ADDRESS AXC 'GETSCRN SESSION('session') PREFIX(NO)'
  if RC <> 0
  then DO; say 'GETSCRN SESSION('session') RC='RC; RETURN -2; END
  bscreen = REVERSE(TRANSLATE(screen))/* Search screen from bottom-up */
  foundpos = 9999                  /* Init found position             */
  foundnum = 0                     /* Init found string number        */
    do i=1 to string.0             /* Loop through each search string */
    strpos = POS(string.i,bscreen)
    if strpos = 0 then iterate     /* String not found                */

    /*----------------------------------------------------------------*/
    /* String is on the screen. Save its position & number if it is   */
    /* it is further down the screen than any strings found           */
    /* previously, of if it is at the same position as a previous     */
    /* string but is a longer string                                  */
    /*----------------------------------------------------------------*/
    if strpos > foundpos then iterate
    if strpos = foundpos then
      if length(string.i) < length(string.foundnum)
      then iterate
    foundpos = strpos              /*  Save strings position          */
    foundnum = i                   /*   and string number.            */
    end
  if foundnum <> 0                 /* Return string number, if found  */
  then return foundnum
  ADDRESS AXC 'wait 1'
  END
RETURN -1 /* LOOKFOR SUBROUTINE: */
/*-End of LOOKFOR  function-------------------------------------------*/

/*RXCOPY RXERROR **** 120 LINES COPIED ON 11-11-98 AT 15:18************/
/*START OF RXERROR--------------------------------------Version-01.04-*/
/*:RXERROR SUBROUTINE: Generic REXX error condition handler. This     */
/* routine gets control when a condition is raised, and:              */
/* a. Validates that the condition is ok, and returns quietly, or     */
/* b. Issues diagnostic messages about the error & where it occured.  */
/*                                                                    */
/* To use this routine, code the following near the top of your exec: */
/* CALL   ON ERROR   NAME RXERROR                                     */
/* SIGNAL ON SYNTAX  NAME RXERROR                                     */
/* SIGNAL ON NOVALUE NAME RXERROR                                     */
/*                                                                    */
/* In addition, set the variable 'ok' to any return code values       */
/* that are acceptable for host commands.  For example:               */
/*                                                                    */
/* ok=4; ADDRESS TSO 'GETVARL GLOBAL_*'; DROP ok                      */
/* ok='4 8';"host cmd"; DROP ok <-- return codes 4 or 8 are ok        */
/* ok='all';"host cmd"; DROP ok <-- all return codes are acceptable   */
/*                                                                    */
/* The first example permits GETVARL to get rc 4 and not fail or      */
/* issue any error messages.  Note that "ok=0" is always implied      */
/* because the REXX ERROR condition is not raised if rc=0.            */
/*------------------------------------------------------------------- */
/*NOTES: This subroutine does not use the PROCEDURE instruction, so   */
/*       variable names used within it must be _hidden.               */
/*                                                                    */
/*       If an error occurs that's not one of the 'OK' values,        */
/*       execution will fall thru this subroutine and any statements  */
/*       following it will be executed.  This is a good place to put  */
/*       cleanup logic, or a signal to your "cleanup-and-exit" label. */
/*                                                                    */
/*       As a side effect, RXERROR sets ISPF "CONTROL ERRORS RETURN". */
/*       If your routine doesn't run this way, you'll need to restore */
/*       your ISPF CONTROL ERRORS setting.                            */
/* Copyright (C) 1996,1998 Washington Systems. All rights reserved.   */
/*--------------------------------------------------------------------*/

RXERROR:
TRACE N                           /* Turn off tracing for this func.  */
_sigl = sigl
CALL   OFF ERROR
SIGNAL OFF SYNTAX
IF SYMBOL('rc') = 'VAR' THEN _rc = rc
ELSE _rc = 'n/a'
PARSE SOURCE _EX_ENV . _EX_NAME . . . . _EX_ADDRSPC .
IF POS(CONDITION('C'),'ERROR FAILURE') > 0 THEN  /* Error or Failure? */
                                       /* Yes. Were we CALLed?        */
  IF CONDITION('I') = 'CALL' | _EX_ENV = 'OPS/REXX' THEN
    IF SYMBOL('OK') = 'VAR' THEN       /* Yes.  Is OK a variable?     */
      IF WORDPOS(_rc,ok)>0 | TRANSLATE(ok)='ALL' THEN /* Is error ok? */
        DO                                            /* Yes, return  */
        CALL   ON ERROR   NAME RXERROR /*  Restore the                */
        SIGNAL ON SYNTAX  NAME RXERROR /*   Error handler             */
        DROP ZERRLM                    /* Toss any ISPF error msg     */
        rc = _rc                       /* Restore orig RC for caller  */
        RETURN                         /* Return to point of error    */
        END
_errtext = '';                     /* Initialize error text           */
IF CONDITION('C') = 'SYNTAX' THEN  /* If a REXX syntax error,         */
  IF _rc >= 0 & _rc < 100          /*  and rc is within valid range,  */
  THEN _errtext = ' ('ERRORTEXT(_rc)')';/* then get REXX error text.  */
  ELSE NOP;
ELSE
  IF CONDITION('C') = 'NOVALUE' THEN /* See if undefined variable     */
    DO;
    _errtext = ' (No value for variable 'CONDITION('D')')';
    _rc = 'n/a';                   /* RC not set for NOVALUE          */
    END
  ELSE
    IF POS(CONDITION('C'),'ERROR FAILURE') > 0 THEN /*Hostcmd problem?*/
      DO   /* Extract host cmd name... */
      _cmd = STRIP(STRIP(WORD(CONDITION('D'),1),'B','"'),'B',"'")
      _errtext = ' (Host command '_cmd')'
      _addr = ADDRESS()            /* Find environment of failing cmd */
      IF _sigl <= SOURCELINE() THEN/* Is source code avail?           */
        IF TRANSLATE(WORD(SOURCELINE(_sigl),1)) = 'ADDRESS'
        THEN _addr = TRANSLATE(WORD(SOURCELINE(_sigl),2))
      _addr = STRIP(TRANSLATE(_addr,,'!@#$%&*()_-+=;:,./?"'"'",' '))
      IF _addr = 'PPQ' & SYMBOL('PPQ.ERROR') = 'VAR'
      THEN _errtext = ' (Host command PPQ, 'ppq.error')'
      IF _addr = 'ASODDE' | SYMBOL('ASODDE.ERROR') = 'VAR'
      THEN _errtext = ' (Host command ASODDE, 'asodde.error')'
      IF SYMBOL('SQLCODE') = 'VAR'
      THEN _errtext = ' ( SQLCODE=' sqlcode')'
      END
    ELSE
      _errtext = ' (Condition='CONDITION('C')', Description=',
        CONDITION('D')')'

IF _ex_addrspc = 'ISPF' THEN       /* Running under ISPF?             */
  DO                               /* Yes, issue short & long msgs... */
  ADDRESS ISPEXEC "CONTROL ERRORS RETURN" /* Capture all ISPF RCs     */
  zedsmsg = ''                     /* Format ISPF short message       */
  zedlmsg = "Error RC "_rc""_errtext" at line "_sigl" in EXEC" _EX_NAME
  IF _sigl <= SOURCELINE()         /* Is source code avail?           */
  THEN zedlmsg = LEFT(zedlmsg': ',78)STRIP(SOURCELINE(_sigl))
  IF SYMBOL('ZERRLM') = 'VAR'
  THEN zedlmsg = LEFT(zedlmsg,156) 'ISPF Error: 'STRIP(ZERRLM)
  ADDRESS ISPEXEC "SETMSG MSG(ISRZ001)"
  IF rc = 12 THEN                  /* ISPMLIB MESSAGE found?          */
    DO                             /* No, use SAY instead.            */
    SAY 'RXERROR ISPMLIB Message ISRZ001 Not Found'
    SIGNAL _SAY_ERRMSG;
    END
  SIGNAL _SAY_SQLMSG;
  END

_SAY_ERRMSG:
SAY "RXERROR Error RC "_rc""_errtext" at line "_sigl,
    "in EXEC "_ex_name
IF _sigl <= SOURCELINE()          /* Is source code avail?           */
THEN SAY "RXERROR Source Line "_sigl": "STRIP(SOURCELINE(_sigl))
SAY ''
_SAY_SQLMSG:
IF SYMBOL('SQLCODE') = 'VAR' & QUEUED() > 0 THEN
  IF WORDPOS(sqlcode,'0 100') = 0 THEN
    DO _i = 1 BY 1 WHILE QUEUED() > 0
    PULL _stack
    SAY 'SQL STACK:'RIGHT(_i,2)':'_stack
    END
/*END OF RXERROR------------------------------------------------------*/
max_rc = 12
SIGNAL EXIT