ISREDIT MACRO     /* CATM0402 EDIT TEMP6 */
 
/* 06/17/2004 JL.NELSON added EXIT CODE
/* 07/08/2004 JL.NELSON added code to display ACID name
/* 07/28/2004 JL.NELSON added error code for TSS LIST(acid)
/* 11/30/2004 JL.NELSON Fixed code for ITER = GE
/* 11/30/2004 JL.NELSON Added rule to Profile expansion
/* 11/30/2004 JL.NELSON Changed to use CACM042T for table
/* 12/17/2004 JL.NELSON Limit profile expands by name and access
/* 01/26/2005 JL.NELSON Changed sort to put users before profiles.
/* 01/28/2005 JL.NELSON Added error messages PROFILE has invalid user
/* 01/31/2005 JL.NELSON Added error messages PROFILE has no users
/* 02/01/2005 JL.NELSON Modified select/exclude of ds rules.
/* 02/07/2005 JL.NELSON Correct FIND/CHANGE to avoid problems
/* 02/09/2005 JL.NELSON Changed constants to variables before rename
/* 03/10/2005 JL.NELSON Changed LMMREP to LMMADD/LMMREP to avoid errors
/* 04/27/2005 JL.NELSON Added TYPERUN to expand PROFILEs for FSO audit
/* 05/25/2005 JL.NELSON Added default TYPE when not in table
/* 06/08/2005 JL.NELSON Pass MAXCC in ZISPFRC variable
/* 06/09/2005 JL.NELSON Fixed 804 error CUR_ACID = *ALL*
/* 06/15/2005 JL.NELSON Set return code to end job step
/* 07/19/2005 JL.NELSON Bypass TYPERUN to expand PROFILEs for FSO audit
/* 08/18/2005 JL.NELSON Added several new ACID types
/* 08/19/2005 JL.NELSON Moved PROFILE code to resolve storage problem.
/* 08/22/2005 JL.NELSON Fixed error 932 SET AUDDSNS = &SUBSTR(1:50,    )
/* 08/23/2005 JL.NELSON Fixed error 900 & in Name field
/* 11/29/2005 JL.NELSON Modified to drop dups by access per Charles
/* 03/15/2006 JL.NELSON Made changes to avoid SUBSTR abend 920/932.
/* 03/21/2006 JL.NELSON Use NRSTR avoid abend 900 if ampersand in data.
/* 03/30/2006 JL.NELSON Test for empty member LINENUM Rcode = 4.
/* 04/19/2006 JL.NELSON Add rule period count to XAUTH output.
/* 05/11/2006 JL.NELSON Added WRITE &LASTCC for debugging.
/* 05/31/2006 JL.NELSON Moved list(audit) to TM0528 for global prefixes.
/* 06/01/2006 JL.NELSON Added Dataset name to detail line for TSSSIM
/* 06/12/2006 JL.NELSON Drop trailing blanks from audit list. Max 32756.
/* 10/20/2006 CL.FENTON Changed global audit process.
/* 03/31/2008 CL.FENTON Changes made for new record format information
/*            and new report format.
/* 04/08/2008 CL.Fenton Corrected INSUFFICIENT STORAGE by collecting
/*            250 ACIDs in ACIDLIST variable.
/* 07/07/2008 CL FENTON Corrected issue with dsn not having any
/*            permissions specified.
/* 06/02/2009 CL.FENTON Changes on how TBLMBR is processed.
/* 10/29/2010 CL.FENTON Corrected error caused by member containing
/*            only one record, which returns an 8 on sorts.
/* 04/19/2011 CL.FENTON Changed comparison of DSN and ADSN to evaluate
/*            masking characters in both fields, CSD-AR002692245.
/* 04/19/2011 CL.FENTON Corrected issue with the use of single and
/*            double quotes in NAME field, CSD-AR003073274.
/* 08/29/2016 CL.FENTON Correct issue with TBLMBR.
 
SET PGMNAME = &STR(CATM0002 08/29/16)
 
NGLOBAL PAGE_NUM SENSITVE ITER MEMBER OMBR SP80 LINE_CNT
NGLOBAL PGMNAME RETURN_CODE PROF_LIST NOUSR TYPERUN TBLMBR
NGLOBAL CUR_ACT CUR_ADSN CUR_ACID CUR_DATA TSSLISTP CATM0405 CURDSN
 
SET SYSPROMPT = OFF                 /* CONTROL NOPROMPT          */
SET SYSFLUSH  = OFF                 /* CONTROL NOFLUSH           */
SET SYSASIS   = ON                  /* CONTROL ASIS - caps off   */
 
/* ***************************************    */
/* VARIABLES ARE PASSED TO THIS MACRO         */
/* CONSLIST                                   */
/* COMLIST                                    */
/* TERMMSGS                                   */
/* ***************************************    */
 
ISPEXEC CONTROL NONDISPL ENTER
ISPEXEC CONTROL ERRORS RETURN
 
ERROR DO
  SET RETURN_CODE = &LASTCC
  IF &LASTCC GE 16 THEN +
    WRITE &PGMNAME LASTCC = &LASTCC &ZERRLM
  RETURN
  END
 
ISREDIT NULLS OFF
ISREDIT CAPS  OFF
 
SET RETURN_CODE = 0
 
ISPEXEC VGET ( -
  CONSLIST  -
  COMLIST   -
  SYMLIST   -
  NOUSR     -
  TERMMSGS  -
  CATM0405  -
  SENSITVE  -
  TSSLISTP  -
  TBLMBR    -
  TYPERUN   -
  AUDDSNS   -
  ) ASIS
 
SET TM02VGET = &RETURN_CODE
IF &RETURN_CODE NE 0 THEN DO
  WRITE &PGMNAME VGET RC = &RETURN_CODE  &ZERRSM
  WRITE &PGMNAME CONSLIST/&CONSLIST COMLIST/&COMLIST SYMLIST/&SYMLIST +
    TERMMSGS/&TERMMSGS
  WRITE &PGMNAME CATM0405/&CATM0405 TYPERUN/&TYPERUN +
    SENSITVE/&SENSITVE TSSLISTP/&TSSLISTP
  WRITE &PGMNAME AUDDSNS/&AUDDSNS
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
SET TBLMBR = &NRSTR(&TBLMBR)
/*SET TBLMBR = &NRSTR(&TBLMBR.#)
SET RETURN_CODE = 0
 
SET SYSSYMLIST = &SYMLIST           /* CONTROL SYMLIST/NOSYMLIST */
SET SYSCONLIST = &CONSLIST          /* CONTROL CONLIST/NOCONLIST */
SET SYSLIST    = &COMLIST           /* CONTROL LIST/NOLIST       */
SET SYSMSG     = &TERMMSGS          /* CONTROL MSG/NOMSG         */
 
/* *************************************** */
/* MAIN PROCESS                            */
/* *************************************** */
 
ISREDIT (MEMBER) = MEMBER
ISREDIT (DSNAME) = DATASET
SET RETURN_CODE = 0
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
IF &RETURN_CODE GT 0 THEN DO    /* Empty RC = 4
  IF &LASTLINE EQ 0 THEN +
    WRITE &PGMNAME Empty file RC = &RETURN_CODE +
          DSN=&DSNAME  MEMBER=&MEMBER  &ZERRSM
  ELSE +
    WRITE &PGMNAME LINENUM Error RC = &RETURN_CODE +
          DSN=&DSNAME  MEMBER=&MEMBER  &ZERRSM
  SET RETURN_CODE = 0
  GOTO ERR_EXIT
  END
 
SET T2INOUT = 12
SET T2INTBL = 12
SET T2LMCL  = 12
SET T2LMFR  = 12
SET T2LMMR  = 12
SET T2LMPUT = 12
SET T2OPOUT = 12
SET T2SAVE  = 12
 
SET PAGE_NUM = 0
SET PROF_TEST = OFF
SET SP10 = &STR(          )
SET SP80 = &STR(&SP10&SP10&SP10&SP10&SP10&SP10&SP10&SP10)
 
SET LP = &STR((
SET RP = )
 
 
CLEAN_UP: +
SET RETURN_CODE = 0
 
/* SORT BY   PDI   ACID    DSNAME   XAUTH  ACC LVL */
ISREDIT SORT 1 2 A 47 54 A 74 117 A 3 46 D 72 72 D
 
SET T2SORT1 = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO    /* SORT_RC = 8 No records to sort
  WRITE &PGMNAME SORT1_TEMP6_RC &RETURN_CODE  &ZERRSM
  IF &LASTLINE NE 1 AND +
    &RETURN_CODE NE 8 THEN +
    GOTO ERR_EXIT
  END
 
ISREDIT RESET
 
/*WRITE &PGMNAME Number of records after SORT1 = &LASTLINE
 
ISREDIT CURSOR = 1 0
SET OITER =
SET OACID =
SET ODSN  =
SET OAUTH =
SET ODATA =
 
SET LINE = 0
 
CLEAN_UP_LOOP: +
SET RETURN_CODE = 0
 
SET LINE = &LINE + 1
IF &LINE GT &LASTLINE THEN GOTO DELETE_EXCLUDE
 
ISREDIT (DATA) = LINE &LINE
 
SET ITER  = &SUBSTR(1:2,&NRSTR(&DATA))
SET ACID  = &SUBSTR(47:54,&NRSTR(&DATA))
SET DSN   = &SUBSTR(74:117,&NRSTR(&DATA))
SET XAUTH = &SUBSTR(4:46,&NRSTR(&DATA))
SET ACTION = &SUBSTR(73,&NRSTR(&DATA))
 
IF &NRSTR(&ITER) NE &NRSTR(&OITER) THEN DO
  SET OITER = &NRSTR(&ITER)
  SET OACID = &NRSTR(&ACID)
  SET ODSN  = &NRSTR(&DSN)
  SET OAUTH = &NRSTR(&XAUTH)
  SET ODATA = &NRSTR(&DATA)
  GOTO CLEAN_UP_LOOP
  END
 
IF &NRSTR(&ACID) NE &NRSTR(&OACID) THEN DO
  SET OACID = &NRSTR(&ACID)
  SET ODSN  = &NRSTR(&DSN)
  SET OAUTH = &NRSTR(&XAUTH)
  SET ODATA = &NRSTR(&DATA)
  GOTO CLEAN_UP_LOOP
  END
 
IF &NRSTR(&DSN) NE &NRSTR(&ODSN) THEN DO
  SET ODSN  = &NRSTR(&DSN)
  SET OAUTH = &NRSTR(&XAUTH)
  SET ODATA = &NRSTR(&DATA)
  GOTO CLEAN_UP_LOOP
  END
 
IF &NRSTR(&OAUTH) EQ &NRSTR(&XAUTH) AND +
   &SUBSTR(72,&NRSTR(&ODATA)) LT &SUBSTR(72,&NRSTR(&DATA)) THEN +
  GOTO SWAP_DATA
 
IF &NRSTR(&OAUTH) EQ &NRSTR(&ODSN) THEN +
  GOTO EXCLUDE_DATA
 
IF &NRSTR(&XAUTH) EQ &NRSTR(&ODSN) THEN +
  GOTO SWAP_DATA
 
IF &NRSTR(&OAUTH) NE &NRSTR(&XAUTH) AND +
   &NRSTR(&DSN) EQ &NRSTR(&ODSN) AND +
   &LENGTH(&NRSTR(&DSN)) LE &LENGTH(&NRSTR(&XAUTH)) AND +
   &SYSINDEX(&STR(. ),&NRSTR(&DSN )) GT 0 THEN +
  GOTO CLEAN_UP_LOOP
 
 
EXCLUDE_DATA: +
SET RETURN_CODE = 0
 
ISREDIT CURSOR = &LINE 0
ISREDIT EXCLUDE '&NRSTR(&DATA)' NEXT
 
GOTO CLEAN_UP_LOOP
 
 
SWAP_DATA: +
SET RETURN_CODE = 0
 
ISREDIT CURSOR = &LINE 0
ISREDIT EXCLUDE '&NRSTR(&ODATA)' PREV
 
SET OACID = &NRSTR(&ACID)
SET ODSN  = &NRSTR(&DSN)
SET OAUTH = &NRSTR(&XAUTH)
SET ODATA = &NRSTR(&DATA)
 
GOTO CLEAN_UP_LOOP
 
 
DELETE_EXCLUDE: +
SET RETURN_CODE = 0
 
ISREDIT DELETE ALL X
 
SET RETURN_CODE = 0
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
IF &RETURN_CODE GT 0 THEN DO    /* Empty RC = 4
  IF &LASTLINE EQ 0 THEN +
    WRITE &PGMNAME Empty file RCode = &RETURN_CODE +
          DSN=&DSNAME  MEMBER=&MEMBER  &ZERRSM
  ELSE +
    WRITE &PGMNAME LINENUM Error RCode = &RETURN_CODE +
          DSN=&DSNAME  MEMBER=&MEMBER  &ZERRSM
  SET RETURN_CODE = &RETURN_CODE +16
  GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
/* Start list ----------------------------------------- */
 
ISREDIT (LASTLINE) = LINENUM .ZLAST
ISREDIT CURSOR = 1 0
SET LINE = 0
SET SYSOUTTRAP = 999999
 
 
LIST_LOOP: +
SET RETURN_CODE = 0
 
SET LINE = &LINE + 1
IF &LINE GT &LASTLINE THEN +
  GOTO SORT2
 
ISREDIT (DATA) = LINE &LINE
 
SET CUR_ACID = &SUBSTR(47:54,&NRSTR(&DATA))
SET CUR_TYPE = &SUBSTR(55:63,&NRSTR(&DATA))
 
IF &NRSTR(&CUR_TYPE) NE &STR( ) THEN +
  GOTO LIST_LOOP
 
IF &NRSTR(&CUR_ACID) EQ &STR(*ALL*) THEN DO
  SET TYPE = &STR(GENERIC )
  SET NAME = &NRSTR(&CUR_ACID &SP80)
  GOTO CHANGE_ACID
  END
 
SET RETURN_CODE = 0
 
TSS LIST(&CUR_ACID)
 
SET TSSLIST_RC = &RETURN_CODE
IF &TSSLIST_RC EQ 0 THEN DO
  IF &SUBSTR(1:8,&NRSTR(&SYSOUTLINE1 &SP10)) EQ &STR(TSS LIST) THEN DO
    SET ACID=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE2 &SP80))
    SET NAME=&SUBSTR(37:66,&NRSTR(&SYSOUTLINE2 &SP80))
    SET TYPE=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE3 &SP80))
    END
  ELSE DO
    SET ACID=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE1 &SP80))
    SET NAME=&SUBSTR(37:66,&NRSTR(&SYSOUTLINE1 &SP80))
    SET TYPE=&SUBSTR(14:21,&NRSTR(&SYSOUTLINE2 &SP80))
    END
 
  IF &NRSTR(&CUR_ACID) EQ &NRSTR(&ACID) THEN +
    GOTO CHANGE_ACID
  ELSE -
    DO
    SET TYPE = &STR(NOT_DEF )
    SET NAME = &NRSTR(1 RC=&TSSLIST_RC &SYSOUTLINE1 &SP80)
    END
  END
ELSE DO
  SET TYPE = &STR(NOT_DEF )
  SET NAME = &NRSTR(2 RC=&TSSLIST_RC &SYSOUTLINE1 &SP80)
  END
 
CHANGE_ACID: +
SET RETURN_CODE = 0
 
SELECT &NRSTR(&TYPE)
  WHEN (USER    ) SET TYPE = &STR(3&TYPE)
  WHEN (CENTRAL ) SET TYPE = &STR(3USER )
  WHEN (MASTER  ) SET TYPE = &STR(3USER )
  WHEN (LIMITED ) SET TYPE = &STR(3USER )
  WHEN (PROFILE ) SET TYPE = &STR(5&TYPE)
  WHEN (GENERIC ) SET TYPE = &STR(1&TYPE)
  WHEN (NOT_DEF ) SET TYPE = &STR(0&TYPE)
  WHEN (DEPT    ) SET TYPE = &STR(3USER )
  WHEN (&STR(DEPT C/A)) SET TYPE = &STR(3USER )
  WHEN (DIV     )       SET TYPE = &STR(3USER )
  WHEN (&STR(DIV  C/A)) SET TYPE = &STR(3USER )
  WHEN (ZONE    )       SET TYPE = &STR(3USER )
  WHEN (&STR(ZONE C/A)) SET TYPE = &STR(3USER )
  OTHERWISE DO
    WRITE &PGMNAME Invalid TYPE &TYPE was found for report
    SET TYPE = &STR(0&TYPE)
    END
  END
 
NEXT_AMPERSAND: +
SET XA = &SYSINDEX(&SYSNSUB(0,&),&NRSTR(&NAME))
 
IF &XA GT 0 THEN DO
  SET NL = &LENGTH(&NRSTR(&NAME))
  IF &XA EQ 1 THEN DO
    SET NAME = &SUBSTR(2:&NL,&NRSTR(&NAME))
    GOTO NEXT_AMPERSAND
    END
 
  IF &XA EQ &NL THEN DO
    SET NAME = &SUBSTR(1:&NL-1,&NRSTR(&NAME))
    GOTO NEXT_AMPERSAND
    END
 
  SET NAME = &SUBSTR(1:&XA-1,&NRSTR(&NAME))+
             &SUBSTR(&XA+1:&NL,&NRSTR(&NAME))
  GOTO NEXT_AMPERSAND
  END
 
SET TYPE = &SUBSTR(1:9,&NRSTR(&TYPE &SP10))
SET NAME = &SUBSTR(1:30,&NRSTR(&NAME &SP80))
 
ISREDIT X ALL
ISREDIT FIND ALL '&CUR_ACID' 47
 
SET CF = &STR('&CUR_ACID         ')
SET CT = &STR('&CUR_ACID&TYPE')
ISREDIT CHANGE &CF &CT ALL NX 47
 
SET CF = &STR('                              ')
SET SQ = &SYSINDEX(&STR('),&NRSTR(&NAME))
SET DQ = &SYSINDEX(&STR("),&NRSTR(&NAME))
IF &SQ = 0 THEN +
  SET CT = &STR('&NAME')
ELSE +
  IF &DQ = 0 THEN +
    SET CT = &STR("&NAME")
  ELSE +
    SET CT = &STR(&NAME)
ISREDIT CHANGE &CF &CT ALL NX 119
ISREDIT RESET
 
GOTO LIST_LOOP
 
/* END LIST ----------------------------------------- */
 
SORT2: +
SET RETURN_CODE = 0
 
/* SORT BY   PDI   XAUTH   TYPE    ACID    DSNAME   */
ISREDIT SORT 1 2 A 4 46 A  55 63 A 47 54 A 74 117 A
 
SET T2SORT2 = &RETURN_CODE
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME SORT2_TEMP6_RC &RETURN_CODE  &ZERRSM
  IF &LASTLINE NE 1 AND +
    &RETURN_CODE NE 8 THEN +
    GOTO ERR_EXIT
  END
 
SET RETURN_CODE = 0
 
ISREDIT SAVE
 
SET T2SAVE = &RETURN_CODE
SET RETURN_CODE = 0
 
ISREDIT RESET
ISREDIT (LASTLINE) = LINENUM .ZLAST
 
/*WRITE &PGMNAME Number of records after SORT2 = &LASTLINE
 
SET MEMBER =
 
SET ITER =
SET CUR_ADSN =
SET CUR_ACID =
SET CUR_DATA =
SET DSNLIST =
SET PROF_LIST = &STR(#)
SET LINE = 0
 
 
WRITE_LOOP: +
SET RETURN_CODE = 0
 
SET LINE = &LINE + 1
IF &LINE GT &LASTLINE THEN DO
  IF &NRSTR(&MEMBER) NE &STR( ) THEN DO
    SYSCALL WRITE_ACID
    SYSCALL ADD_MEMBER
    SET T2LMMR = &RETURN_CODE
    END
  GOTO END_EDIT
  END
 
ISREDIT (DATA) = LINE &LINE
 
IF &SUBSTR(1:2,&NRSTR(&DATA  )) NE &NRSTR(&ITER) THEN DO
  IF &NRSTR(&MEMBER) NE &STR( ) THEN DO
    SET RETURN_CODE = 0
    SYSCALL WRITE_ACID
    SYSCALL ADD_MEMBER
    SET T2LMPUT = &RETURN_CODE
    SET LINE_CNT = &LINE_CNT + 1
    END
 
  SET ITER = &SUBSTR(1:2,&NRSTR(&DATA))
  SET CUR_ADSN =
  SET CUR_ACID =
  SET CUR_DATA =
  SET DSNLIST =
  SET PROF_LIST = &STR(#)
 
  SYSCALL PAGE_BREAK
  SET RETURN_CODE = 0
  END
 
SET ADSN   = &SUBSTR(4:46,&NRSTR(&DATA))
SET ACID   = &SUBSTR(47:54,&NRSTR(&DATA))
SET DSN    = &SUBSTR(74:117,&NRSTR(&DATA))
SET ACTION = &SUBSTR(73,&NRSTR(&DATA))
 
IF &NRSTR(&ADSN) NE &NRSTR(&CUR_ADSN) THEN DO
  IF &NRSTR(&CUR_ADSN) NE &STR() THEN DO
    SYSCALL WRITE_ACID
 
    SET AC = &STR( )
    ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
      DATALEN(&LENGTH(&NRSTR(&AC)))
    END
  SET CUR_ADSN = &NRSTR(&ADSN)
  SET CUR_ACID =
  SET DSNLIST  =
  END
 
IF &NRSTR(&ACID) NE &NRSTR(&CUR_ACID) THEN DO
  IF &NRSTR(&CUR_ACID) NE &STR( ) THEN +
    SYSCALL WRITE_ACID
  SET CUR_ACID = &NRSTR(&ACID)
  SET CUR_DATA = &NRSTR(&DATA)
  END
 
IF &NRSTR(&DSNLIST) EQ &STR() THEN DO
  SET RETURN_CODE = 0
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(ADSN) +
    DATALEN(&LENGTH(&NRSTR(&ADSN)))
 
  SET T2LMPUT = &RETURN_CODE
  SET X = 0
  END
ELSE +
  SET X = &SYSINDEX(&NRSTR(&DSN),&NRSTR(&DSNLIST))
 
SET CURDSN = &NRSTR(&DSN)
 
IF &X EQ 0  THEN DO
  SET DSNLIST = &NRSTR(&DSNLIST.&CURDSN.#)
  SET DSNAUD  = &STR(ACTION&LP.NONE&RP)
 
  SET BI = &SYSINDEX( ,&NRSTR(&CURDSN ))
  SET XDSN = &SUBSTR(1:&BI-1,&NRSTR(&CURDSN ))
 
  IF &ACTION EQ &STR(X) OR +
     &ACTION EQ &STR(Z) THEN +
    SET DSNAUD = &STR(ACTION&LP.AUDIT&RP)
 
  SET DDSN=&NRSTR(     &CURDSN &DSNAUD)
  SET RETURN_CODE = 0
 
  ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(DDSN) +
    DATALEN(&LENGTH(&NRSTR(&DDSN)))
 
  SET T2LMPUT = &RETURN_CODE
 
  SET LINE_CNT = &LINE_CNT + 1
  END
 
 
BYPASS: +
SET RETURN_CODE = 0
 
SET LINE_CNT = &LINE_CNT + 1
 
GOTO WRITE_LOOP
 
 
END_EDIT: +
SET RETURN_CODE = 0
 
 
ERR_EXIT: +
IF &MAXCC GE 16 OR +
   &RETURN_CODE GT 0 THEN DO
  ISPEXEC VGET (ZISPFRC) SHARED
  IF &MAXCC GT &ZISPFRC THEN +
    SET ZISPFRC = &MAXCC
  ELSE +
    SET ZISPFRC = &RETURN_CODE
  ISPEXEC VPUT (ZISPFRC) SHARED
  WRITE &PGMNAME ZISPFRC = &ZISPFRC
  END
 
SET TM002RC = &RETURN_CODE
 
ISPEXEC VPUT ( -
  T2LMMR   -
  T2LMPUT  -
  T2SORT1  -
  T2SORT2  -
  T2SAVE   -
  TM02VGET -
  TM002RC  -
  ) ASIS
 
ISREDIT END
 
EXIT CODE(0)
ISREDIT MEND
 
 
/* *************************************** */
/*  SYSCALL SUBROUTINES                    */
/* *************************************** */
 
PAGE_BREAK: PROC 0
 
SET MEMBER = &STR(Dummy)
SET TITLE  = &STR(None )
SET TSSPDI = &STR(None )
 
SET X = &SYSINDEX(&STR(#&ITER),&NRSTR(&TBLMBR))
SET XL = &LENGTH(&NRSTR(&TBLMBR))
IF &X GT 0 AND &X+22 LE &XL THEN DO
  SET MEMBER = &SUBSTR(&X+4:&X+12,&NRSTR(&TBLMBR))
  SET TSSPDI = &SUBSTR(&X+13:&X+20,&NRSTR(&TBLMBR))
  SET Y = &SYSINDEX(&NRSTR(@),&NRSTR(&TBLMBR),&X)
  IF &Y GT 0 THEN +
    SET TITLE  = &SUBSTR(&X+22:&Y,&NRSTR(&TBLMBR))
  ELSE +
    SET TITLE  =
  END
 
SET MEMBER = &MEMBER
SET PDIMBR = &TSSPDI
 
SET X = &SYSINDEX(&STR(@),&NRSTR(&TITLE))
IF &X GT 2 THEN +
  SET TITLE  = &SUBSTR(1:&X-1,&NRSTR(&TITLE))
 
IF &NRSTR(&MEMBER) NE &NRSTR(&OMBR) THEN DO
  SET OMBR = &NRSTR(&MEMBER)
  SET PAGE_NUM = 0
  END
 
SET PAGE_NUM = &PAGE_NUM + 1
SET LINE_CNT = 0
 
SET CMD = &NRSTR(&SYSDATE                      &TITLE)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR( )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR(XAUTH             )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR(     DATA SET NAME)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR(          ACID     ACCESS           TYPE  )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET DASH =&STR(==========)
SET DASH =&NRSTR(&DASH&DASH&DASH&DASH)
 
SET CMD = &SUBSTR(1:93,&NRSTR(&DASH&DASH=====================))
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
SET CMD = &STR( )
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(CMD) +
  DATALEN(&LENGTH(&NRSTR(&CMD)))
 
RETURN CODE(&RETURN_CODE)
END
 
 
WRITE_ACID: PROC 0
 
SET LP = &STR((
SET RP = )
IF &NRSTR(&CUR_ACID) EQ &STR( ) THEN +
  GOTO WRITE_END
 
SET CUR_TYPE = &SUBSTR(56:63,&NRSTR(&CUR_DATA))
SET CUR_ACC  = &SUBSTR(64:71,&NRSTR(&CUR_DATA))
SET ACTION   = &SUBSTR(73,&NRSTR(&CUR_DATA &SP80))
SET CUR_NAME = &SUBSTR(119:148,&NRSTR(&CUR_DATA &SP80))
 
SET AC = &STR(                                              )
SET AC = &SUBSTR(1:10,&AC)&NRSTR(&CUR_ACID &CUR_TYPE NAME=+
  &CUR_NAME ACCESS(&CUR_ACC))
 
IF &ACTION EQ &STR(N) OR +
   &ACTION EQ &STR(X) THEN +
  SET CUR_ACT = &NRSTR(ACTION&LP.NONE&RP)
ELSE +
  SET CUR_ACT = &NRSTR(ACTION&LP.AUDIT&RP)
SET AC = &NRSTR(&AC &CUR_ACT &CUR_ADSN &CURDSN)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC)))
 
IF &NRSTR(&CUR_TYPE) NE &STR(PROFILE) THEN +
  GOTO WRITE_END
 
IF &SYSINDEX(&NRSTR(&CUR_ACID.&CUR_ACC),&NRSTR(&PROF_LIST)) NE 0 THEN +
  GOTO WRITE_END
 
SET PROF_LIST = &NRSTR(&PROF_LIST.&CUR_ACID.&CUR_ACC.#)
 
/* *************************************** */
/* Expand PROFILE                          */
/* *************************************** */
SET CURACID = &NRSTR(&CUR_ACID)
SET CURACC  = &NRSTR(&CUR_ACC)
SET CURACT  = &NRSTR(&CUR_ACT)
SET CURADSN = &NRSTR(&CUR_ADSN)
 
ISPEXEC VPUT ( +
  SENSITVE +
  CURACID  +
  CURACC   +
  CURACT   +
  CURADSN  +
  CURDSN   +
  ) ASIS
 
GET_NEXT_ACIDS: +
SET RETURN_CODE = 0
 
ISPEXEC EDIT DATAID(&TSSLISTP) MACRO(&CATM0405)
 
SET VIEW_TSSLISTP_RC = &RETURN_CODE
 
IF &RETURN_CODE GT 4 THEN DO
  WRITE &PGMNAME Error on VIEW of &CATM0405 RC = &RETURN_CODE &ZERRSM
  SET RETURN_CODE = &RETURN_CODE + 16
  GOTO ERR_EXIT
  END
 
ISPEXEC VGET ( +
  ACIDLIST +
  ACIDNUM +
  ) ASIS
 
DO X = 1 TO &LENGTH(&NRSTR(&ACIDLIST)) BY 38
SET ACID = &SUBSTR(&X:&X+7,&NRSTR(&ACIDLIST))
SET NAME = &SUBSTR(&X+8:&X+37,&NRSTR(&ACIDLIST))
 
SET AC = &SUBSTR(1:15,&NRSTR(&SP80))&NRSTR(USER=&ACID NAME=&NAME)
 
ISPEXEC LMPUT DATAID(&SENSITVE) MODE(INVAR) DATALOC(AC) +
  DATALEN(&LENGTH(&NRSTR(&AC)))
 
END
 
IF &DATATYPE(&ACIDNUM) EQ &STR(NUM) THEN +
  GOTO GET_NEXT_ACIDS
 
WRITE_END: +
SET RETURN_CODE = 0
 
RETURN CODE(&RETURN_CODE)
END
 
 
ADD_MEMBER: PROC 0
 
SET M8 = &SUBSTR(1:8,&MEMBER        )
SET RETURN_CODE = 0
 
ISPEXEC LMMADD DATAID(&SENSITVE) MEMBER(&MEMBER)
 
IF &RETURN_CODE EQ 4 THEN DO          /* MEMBER ALREADY EXISTS
  SET RETURN_CODE = 0
 
  ISPEXEC LMMREP DATAID(&SENSITVE) MEMBER(&MEMBER)
 
  IF &RETURN_CODE NE 0 THEN DO
    WRITE &PGMNAME LMMREP_SENS_RCODE = &RETURN_CODE &MEMBER  &ZERRSM
    END
  ELSE DO
    WRITE &PGMNAME SENSITVE member &M8 complete  LMMREP &RETURN_CODE
    END
  END
ELSE DO
  IF &RETURN_CODE NE 0 THEN +
    WRITE &PGMNAME LMMADD_SENS_RCODE = &RETURN_CODE &MEMBER  &ZERRSM
  ELSE +
    WRITE &PGMNAME SENSITVE member &M8 complete  LMMADD &RETURN_CODE
  END
 
RETURN CODE(&RETURN_CODE)
END