* $$ JOB JNM=VSEUXRF,CLASS=A
* $$ LST CLASS=A
// JOB VSEUXREF
// LIBDEF PHASE,CATALOG=PRD2.CONFIG
// OPTION CATAL
   PHASE VSEUXREF,*
// EXEC ASMA90,SIZE=(ASMA90,64K),PARM='EXIT(LIBEXIT(EDECKXIT)),SIZE(MAXC
               -512K,ABOVE)'
*---------------------------------------------------------------------*
*        VSE 2.7 USER CROSS REFERENCE LISTING                         *
*---------------------------------------------------------------------*
*        PHASE:       VSEUXREF                                        *
*        AUTHOR:      HEINZ PETER MAASSEN                             *
*        COMPANY:     LATTWEIN GMBH                                   *
*        ADDRESS:     OTTO-BRENNER-STR. 25                            *
*                     D - 52353 DUEREN                                *
*        PHONE:       +49 (0) 2421 81051                              *
*        FAX:         +49 (0) 2421 82127                              *
*        EMAIL:       SERVICE@LATTWEIN.DE                             *
*---------------------------------------------------------------------*
*        THE USE OF THIS PROGRAM IS FREE OF CHARGE. USE IT AS IT IS.  *
*                                                                     *
*        MAXIMUM: 1000 USERS - 4000 TRANSACTION IDS                   *
*                                                                     *
*        ACTUAL VERSION CAN BE FOUND AT: WWW.LATTWEIN.DE              *
*                                                                     *
*---------------------------------------------------------------------*
*        PLEASE USE THE FOLLOWING JOB FOR EXECUTION:                  *
*                                                                     *
*    * $$ JOB JNM=VSEULST,CLASS=A                                     *
*    * $$ LST CLASS=A,DEST=(*,MAINT)                                  *
*    // JOB VSEULST                                                   *
*    // LIBDEF PHASE,SEARCH=PRD2.CONFIG                               *
*    // EXEC VSEUXREF                                                 *
*    USERS=PRD2.CONFIG.IESXSUSP.LST SECTAB=PRD2.CONFIG.DTSECTXS.A     *
*    /*                                                               *
*    /&                                                               *
*    * $$ EOJ                                                         *
*                                                                     *
*    PARAMETERS: USERS=LIB.SUBLIB.MEMBER.MEMBTYP                      *
*                SECTAB=LIB.SUBLIB.MEMBER.MEMBTYP                     *
*                                                                     *
*    DEFAULT:    USERS=PRD2.CONFIG.IESXUSP.LST                        *
*                SECTAB=PRD2.CONFIG.DTSECTXS.A                        *
*                                                                     *
*    NOTE: MOVE THE ACTUAL USER LIST TO A LIBRARY WITH FOLLOWING FTP: *
*                                                                     *
*    * $$ JOB JNM=FTPTRANS,DISP=D,CLASS=0                             *
*    // JOB FTPTRANS       FTP FROM POWER TO LIBRARY                  *
*    // EXEC FTP,PARM='IP=xx.xxx.xxx.xxx'                             *
*    KRUS                                                             *
*    password                                                         *
*    KRUS                                                             *
*    passwordI                                                        *
*    CD PRIMARY.KRUS      (eine VSE-Library)                          *
*    PUT POWER.LST.A. IESXSUSP IESXSUSP.LST                           *
*    QUIT                                                             *
*    /*                                                               *
*    /&                                                               *
*    * $$ EOJ                                                         *
*                                                                     *
*---------------------------------------------------------------------*
         PRINT NOGEN                                                  *
VSEUXREF CSECT                         , NAME OF PROGRAM              *
*---------------------------------------------------------------------*
R0       EQU   0                       REGISTER EQUATES               *
R1       EQU   1                       R1 WORKREG                     *
R2       EQU   2                       R2                             *
R3       EQU   3                       R3                             *
R4       EQU   4                       R4                             *
R5       EQU   5                       R5                             *
R6       EQU   6                       R6                             *
R7       EQU   7                       R7                             *
R8       EQU   8                       R8 SUBREG                      *
R9       EQU   9                       R9 GETREG                      *
R10      EQU   10                      R10                            *
R11      EQU   11                      R11                            *
R12      EQU   12                      R12                            *
R13      EQU   13                      R13                            *
R14      EQU   14                      R14                            *
R15      EQU   15                      R15 COUNTREG                   *
WORKREG  EQU   1                       WORKREG                        *
SUBREG   EQU   8                       SUBREG                         *
GETREG   EQU   9                       GETREG                         *
COUNTREG EQU   15                      COUNTREG                       *
*---------------------------------------------------------------------*
         BALR  R10,0                   ADRESSING                      *
         USING *,R10,R11,R12           USING                          *
         LA    R11,2048(R10)           ADRESSING                      *
         LA    R11,2048(R11)           ADRESSING                      *
         LA    R12,2048(R11)           ADRESSING                      *
         LA    R12,2048(R12)           ADRESSING                      *
         LA    R13,APIMONS1            SAVE AREA FOR THIS TASK        *
         COMRG                         ,                              *
         MVC   UPSI(1),23(1)           MOVE UPSI BYTE                 *
         MVC   DATUM,0(1)                                             *
         MVI   DATUM+5,C'.'                                           *
         MVI   DATUM+2,C'.'                                           *
         GETIME STANDARD               ,                              *
         STCM  1,15,CURTIME                                           *
         UNPK  ZEIT(7),CURTIME       MAKE IT DECIMAL   121325         *
         MVC   ZEIT(2),ZEIT+1                                         *
         MVI   ZEIT+2,C'.'                                            *
         MVC   ZEIT+5(4),=C' UHR'                                     *
         ZAP   LCOUNT,=P'0'                                           *
         ZAP   LPAGE,=P'0'                                            *
         B     START                                                  *
*---------------------------------------------------------------------*
         DC    CL14'*VSEUXREF 1.0*'    VERSION                        * CPG00074
         DC    CL10'(&SYSDATE)'        COMPILE DATE                   *
         DC    CL8'(&SYSTIME)'         COMPILE TIME                   *
*---------------------------------------------------------------------*
START    DS    0D                                                     *
         BAL   SUBREG,OPENLIB          CALL FOR LIBRARY OPEN          *
         OPEN  CPGRDR,CPGLST                                          *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         AP    LPAGE,=P'1'                                            *
         MVI   LISTE,C'1'                                             *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(32),=CL32'CROSS REFERENCE LISTING USERIDS'     *
         MVC   LISTE+50(8),DATUM                                      *
         MVC   LISTE+60(10),ZEIT                                      *
         MVC   LISTE+70(5),=C'SEITE'                                  *
         MVC   LISTE+75(6),=X'402020202020'                           *
         ED    LISTE+75(6),LPAGE                                      *
         MVC   HLINE(120),LISTE+1      SAVE HEADLINE 01               *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE+1,C'-'                                           *
         MVC   LISTE+2(118),LISTE+1                                   *
         BAL   GETREG,PUTLST                                          *
         BAL   SUBREG,GETSRCE          CHECK FOR COPY BOOK NAMES      *
READALL  EQU   *                                                      *
         GET   CPGRDR,QPKARTE                                         *
         B     READALL                                                *
EOFR     DS    0H                      ALL INPUT READ                 *
         MVC   LISTE+1(14),=CL14'SOURCE INPUT= '                      *
         MVC   LISTE+15(7),ULIB                                       *
         MVC   LISTE+23(8),USLIB                                      *
         MVC   LISTE+32(8),UMEMB                                      *
         MVC   LISTE+41(8),UMTYP                                      *
         MVI   LISTE+50,C'/'                                          *
         MVC   LISTE+55(7),SLIB                                       *
         MVC   LISTE+63(8),SSLIB                                      *
         MVC   LISTE+72(8),SMEMB                                      *
         MVC   LISTE+81(8),SMTYP                                      *
         BAL   GETREG,PUTLST                                          *
         MVC   LISTE+1(8),=C'USERID  '                                *
         MVC   LISTE+11(64),SCALE                                     *
         MVC   HLINE2(80),LISTE+1      SAVE HEADER LINE2              *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         MVC   USERID,=CL8' '          SET BLANK TO USERID            *
         MVI   TK01I,C' '              SET INDICATOR TRANKEY 1-32     *
         MVI   TK02I,C' '              SET INDICATOR 33-64            *
         L     R3,APISTADA                                            *
         LIBRDCB FUNC=MOD,                                             *
               AREA=(3),               DCBLIBR                         *
               LIB=ULIB,               GETLIB                          *
               SUBLIB=USLIB,           GETSUBLB                        *
               MEMBER=UMEMB,           GETMEMBN                        *
               TYPE=UMTYP,             GETMEMTY                        *
               DIRINF=GETDIRNF,                                        *
               DIRINFL=GETDIRNL,                                       *
               BUFFER=GETBUFER,                                        *
               BUFSIZE=GETBUFLN,                                       *
               RECNO=0,                                                *
               UNITS=0,                                                *
               EROPT=RET,                                              *
               ERRAD=APIERR00
* --------------------------------------------------------------------*
         L     R3,APISTADA                                            *
         LIBRM OPEN,                                                   *
               TYPEFLE=INPUT,                                          *
               NOTFND=GETCARD0,        APIOPN20,                       *
               LDCB=(3)                DCBLIBR
         LA    R2,1                    SET UNITS TO 1 BYTE/RECORD     *
         SLR   R4,R4                   SET STARTING BYTE/RECORD       *
         XC    RECNO,RECNO                                            *
READNEXT EQU   *                       TOP LOOP                       *
         L     R3,APISTADA                                            *
         L     R4,RECNO                                               *
         LIBRM GET,                                                    *
               LDCB=(3),    DCBLIBR,                                   *
               RECNO=(4),                                              *
               UNITS=(2),                                              *
               EODAD=GETCARD0,         APIGET10                        *
               MOVELEN=GETMOVEL
         LA    R4,1(R4)                                               *
         ST    R4,RECNO                                               *
         MVC   QPKARTE(80),GETBUFER    MOVE THE RECORD                *
*        GET   CPGRDR,QPKARTE          GET A CARD FOR ANALYZE         *
*---------------------------------------------------------------------*
*              SCAN FOR USER                                          *
*---------------------------------------------------------------------*
*        CLC   QPKARTE(2),=C'++'       CHECK CHANGE TO DTSECTXN       *
*        BE    GETCARD0                                               *
         MVC   CTYPE,=CL8' '           SET CARDTYPE TO BLANK          *
         BAL   SUBREG,CARDTYPE         GET CARD TYPE                  *
         CLC   CTYPE,=CL8'BLANK'       CHECK FOR BLANK LINE           *
         BE    READNEXT                                               *
         CLC   CTYPE,=CL8'HEADER1'     CHECK FOR HEADLINE 1           *
         BE    READNEXT                                               *
         CLC   CTYPE,=CL8'HEADER2'     CHECK FOR HEADLINE 2           *
         BE    READNEXT                                               *
         CLC   CTYPE,=CL8'UNKNOWN'     CHECK FOR UNKNOWN              *
         BE    READNEXT                                               *
         CLC   CTYPE,=CL8'OPCLASS'     CHECK FOR OPCLASS              *
         BE    READNEXT                                               *
         CLC   CTYPE,=CL8'VSAM   '     CHECK FOR VSAM                 *
         BE    READNEXT                                               *
         CLC   CTYPE,=CL8'USERID '     CHECK FOR USERID               *
         BE    USERSCAN                                               *
         CLC   CTYPE,=CL8'TRANKEY'     CHECK FOR USERID               *
         BE    TRKYSCAN                                               *
         CLC   CTYPE,=CL8'OPERID '     CHECK FOR OPERID /SET INTO TAB *
         BE    SETTABB                                                *
         B     READNEXT                RETRY                          *
*---------------------------------------------------------------------*
SETTABB  EQU   *                                                      *
         L     GETREG,=V(USERLST)                                     *
SET0010  EQU   *                                                      *
         CLC   0(4,GETREG),=F'-1'                                     *
         BE    SET0020                                                *
         LA    GETREG,72(GETREG)                                      *
         B     SET0010                                                *
SET0020  EQU   *                                                      *
         MVC   0(8,GETREG),USERID                                     *
         MVC   8(64,GETREG),TK01                                      *
         MVC   72(4,GETREG),=F'-1'                                    *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(8),USERID                                      *
         MVC   LISTE+11(64),TK01                                      *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         MVC   USERID,=CL8' '                                         *
         MVI   TK01,C' '                                              *
         MVC   TK01+1(63),TK01                                        *
         B     READNEXT                                               *
*---------------------------------------------------------------------*
TRKYSCAN EQU   *                       CHECK FOR TRANKEY ENTRY        *
         LA    WORKREG,QPKARTE         POINT TO QPKARTE               *
         LA    COUNTREG,60             COUNTER OF 60 BYTES            *
TR0010   EQU   *                       LOOP-1 ENTRY                   *
         CLC   0(8,WORKREG),=C'TRANKEY('      LOOK FOR KEYWORD        *
         BE    TR0050                  FOUND                          *
         LA    WORKREG,1(WORKREG)      NEXT                           *
         BCT   COUNTREG,TR0010         DO IT IN A LOOP                *
         B     TR0090                  EXIT                           *
TR0050   EQU   *                       TRANKEY( FOUND ----------------*
         LA    WORKREG,8(WORKREG)      SKIP TRANKEY( 1)               *
TR0051   EQU   *                       SCAN FOR TRANKEY               *
         CLI   0(WORKREG),C' '         END OF SCAN ?                  *
         BE    TR0090                  YES, THEN EXIT                 *
         CLI   1(WORKREG),C')'                                        *
         BE    TR0060                  1 STELLIG                      *
         CLI   2(WORKREG),C')'         2 STELLIG                      *
         BE    TR0062                                                 *
         CLI   1(WORKREG),C','         END OF 1 KEY                   *
         BE    TR0060                  1 STELLIG                      *
         CLI   2(WORKREG),C','         2 STELLIG                      *
         BE    TR0062                                                 *
         CLI   1(WORKREG),C'-'                                        *
         BE    TR0070                  1-XX)                          *
         CLI   2(WORKREG),C'-'                                        *
         BE    TR0072                  11-XX)                         *
TR0060   EQU   *                                                      *
         MVC   BIS(2),=C'00'                                          *
         MVC   FROM(2),=C'00'                                         *
         MVC   FROM+1(1),0(WORKREG)                                   *
         MVC   BISP+1(1),0(WORKREG)                                   *
         LA    WORKREG,2(WORKREG)      SKIP X, ODER X)                *
         ST    WORKREG,TRKYWS1                                        *
         B     TR0064                                                 *
TR0062   EQU   *                                                      *
         MVC   FROM(2),0(WORKREG)                                     *
         MVC   BIS(2),0(WORKREG)                                      *
         LA    WORKREG,3(WORKREG)      SKIP XX, ODER XX)              *
         ST    WORKREG,TRKYWS1                                        *
TR0064   EQU   *                                                      *
         PACK  FROMP(2),FROM(2)                                       *
         MVN   FROMP+1(1),=X'CC'                                      *
         ZAP   BINWORT,FROMP                                          *
         CVB   GETREG,BINWORT                                         *
         LA    WORKREG,TK01                                           *
         AR    WORKREG,GETREG                                         *
         BCTR  WORKREG,0                                              *
         MVI   0(WORKREG),C'X'      SET X FOR FOUND                   *
         L     WORKREG,TRKYWS1                                        *
         MVC   FROM,=C'  '                                            *
         MVC   BIS,=C'  '                                             *
         B     TR0051                                                 *
*---------------------------------------------------------------------*
TR0070   EQU   *                                                      *
         MVC   FROM(2),=C'00'                                         *
         MVC   FROM+1(1),0(WORKREG)                                   *
         LA    WORKREG,2(WORKREG)                                     *
         B     TR0074                                                 *
TR0072   EQU   *                                                      *
         MVC   FROM(2),0(WORKREG)                                     *
         LA    WORKREG,3(WORKREG)                                     *
TR0074   EQU   *                                                      *
         PACK  FROMP(2),FROM(2)                                       *
         MVN   FROMP+1(1),=X'CC'                                      *
         MVC   BIS(2),=C'00'         11-X)                            *
         CLI   1(WORKREG),C')'       1-XX)                            *
         BE    TR0076                                                 *
         CLI   2(WORKREG),C')'                                        *
         BE    TR0078                                                 *
         CLI   1(WORKREG),C','       1-XX)                            *
         BE    TR0076                                                 *
         CLI   2(WORKREG),C','                                        *
         BE    TR0078                                                 *
TR0076   EQU   *                                                      *
         MVC   BIS+1(1),0(WORKREG)                                    *
         LA    WORKREG,2(WORKREG)                                     *
         B     TR0079                                                 *
TR0078   EQU   *                                                      *
         MVC   BIS(2),0(WORKREG)                                      *
         LA    WORKREG,3(WORKREG)                                     *
TR0079   EQU   *                                                      *
         ST    WORKREG,TRKYWS1                                        *
         PACK  BISP(2),BIS(2)                                         *
         MVN   BISP+1(1),=X'CC'                                       *
         ZAP   BINWORT,FROMP                                          *
         CVB   GETREG,BINWORT                                         *
         LA    WORKREG,TK01                                           *
         AR    WORKREG,GETREG                                         *
         BCTR  WORKREG,0                                              *
         ZAP   ANZP,BISP                                              *
         SP    ANZP,FROMP                                             *
         AP    ANZP,=P'1'                                             *
         ZAP   BINWORT,ANZP                                           *
         CVB   COUNTREG,BINWORT                                       *
TR0080   EQU   *                                                      *
         MVI   0(WORKREG),C'X'                                        *
         LA    WORKREG,1(WORKREG)                                     *
         BCT   COUNTREG,TR0080                                        *
         L     WORKREG,TRKYWS1                                        *
         B     TR0051                                                 *
TR0090   EQU   *                                                      *
         B     READNEXT                                               *
*---------------------------------------------------------------------*
USERSCAN EQU   *                       SCAN FOR USERID                *
         LA    WORKREG,QPKARTE+8       POINT TO CARD                  *
         LA    COUNTREG,52             COUNT OF 52                    *
US0010   EQU   *                       *------------------------------*
         CLC   0(7,WORKREG),=C'USERID('      LOOK FOR EYECATCHER      *
         BE    US0050                  FOUND                          *
         LA    WORKREG,1(WORKREG)      ADD 1 TO WORKREG               *
         BCT   COUNTREG,US0010         DO IT IN A LOOP                *
         MVC   USERID(8),=CL8' '       CLEAR USERID SOMETHING IS WRONG*
         B     US0090                  EXIT                           *
US0050   EQU   *                       ENTRY FOUND                    *
         LA    WORKREG,7(WORKREG)      POINT TO NAME                  *
         MVC   USERID(8),0(WORKREG)    MOVE USERID                    *
         B     US0090                  EXIT                           *
US0090   EQU   *                       *------------------------------*
         B     READNEXT                GET NEXT LINE                  *
*---------------------------------------------------------------------*
CARDTYPE EQU   *                                                      *
         LA    WORKREG,QPKARTE         POINT TO INPUT                 *
         LA    COUNTREG,64             MAX COUNT                      *
         MVC   CTYPE(8),=CL8' '        SET INITIAL                    *
         CLC   QPKARTE+8(7),=C'USERID('    CHECK FOR USERID           *
         BE    CT0020US                SKIP TO USERID                 *
CT0010   EQU   *                       FIRST LOOP ENTRY               *
         CLI   0(WORKREG),C' '         FIND FIRST PARAMETER           *
         BH    CT0020                  SKIP TO FOUND                  *
         LA    WORKREG,1(WORKREG)      INCREASE WORKREG               *
         BCT   COUNTREG,CT0010         DO IT IN A LOOP                *
         MVC   CTYPE(8),=CL8'BLANK'    SET BLANK TYPE                 *
         B     CT0090                  EXIT                           *
CT0020   EQU   *                       CHECK FOR KNOWN VALUES         *
         CLC   0(22,WORKREG),=C'VSE USER PROFILE PRINT'               *
         BE    CT0020H1                                               *
         CLC   0(22,WORKREG),=C'VSE USER CONTROL FILE'                *
         BE    CT0020H2                                               *
         CLC   0(7,WORKREG),=C'OPCLASS'                               *
         BE    CT0020OC                                               *
         CLC   0(7,WORKREG),=C'TRANKEY'                               *
         BE    CT0020TK                                               *
         CLC   0(7,WORKREG),=C'OPERID '                               *
         BE    CT0020OI                                               *
         CLC   0(5,WORKREG),=C'VSAM '                                 *
         BE    CT0020VS                                               *
         B     CT0020UN                                               *
CT0020H1 MVC   CTYPE,=CL8'HEADER1'                                    *
         B     CT0090                                                 *
CT0020H2 MVC   CTYPE,=CL8'HEADER2'                                    *
         B     CT0090                                                 *
CT0020OC MVC   CTYPE,=CL8'OPCLASS'                                    *
         B     CT0090                                                 *
CT0020TK MVC   CTYPE,=CL8'TRANKEY'                                    *
         B     CT0090                                                 *
CT0020OI MVC   CTYPE,=CL8'OPERID '                                    *
         B     CT0090                                                 *
CT0020VS MVC   CTYPE,=CL8'VSAM'                                       *
         B     CT0090                                                 *
CT0020US MVC   CTYPE,=CL8'USERID'      SET USERID                     *
         B     CT0090                  EXIT                           *
CT0020UN MVC   CTYPE,=CL8'UNKNOWN'                                    *
         B     CT0090                                                 *
CT0090   EQU   *                       EXIT                           *
         BR    SUBREG                  RETURN                         *
* -------------------------------------------------------------------*
*        GET LDCB MAP
*------------------------------------------------------------------*
OPENLIB  EQU   *
*------------------------------------------------------------------*  *
*        ALLOCATE GETVIS FOR LDCB USED IN THIS TASK                   *
*------------------------------------------------------------------*  *
         LIBRM SHOWCB,CB=LDCB,CBLEN=LEN1         LENGTH OF LDCB       *
         L     R0,LEN1                                                *
         ST    R0,APISTADL            SAVE GETVIS AREA LENGTH         *
         GETVIS ADDRESS=(1),LENGTH=(0)                                *
         LTR   R15,R15                                                *
         BNZ   APIERR10                                               *
         ST    R1,APISTADA            SAVE LDCB ADDRESS               *
         L     R3,APISTADA                                            *
         LIBRDCB FUNC=GEN,                                             *
               AREA=(3),     DCBLIBR                                   *
               CONT=YES,                                               *
               ERRAD=APIERR00
* --------------------------------------------------------------------*
         BR    SUBREG                  RETURN                         *
*------------------------------------------------------------------*  *
*        GET CARD INPUT AND CHECK FOR LIB.SUBLIB.MEMBER.MEMTYPE       *
*------------------------------------------------------------------*  *
GETSRCE  EQU   *                       GET SOURCE FOR USERS/SECTAB    *
         GET   CPGRDR,QPKARTE                                         *
         LA    COUNTREG,64                                            *
         LA    WORKREG,QPKARTE+72                                     *
         ST    WORKREG,ENDAD                                          *
         LA    WORKREG,QPKARTE                                        *
         MVC   ULIB,=CL8' '                                           *
         MVC   USLIB,=CL8' '                                          *
         MVC   UMEMB,=CL8' '                                          *
         MVC   UMTYP,=CL8' '                                          *
         MVC   SLIB,=CL8' '                                           *
         MVC   SSLIB,=CL8' '                                          *
         MVC   SMEMB,=CL8' '                                          *
         MVC   SMTYP,=CL8' '                                          *
GETS000  EQU   *                                                      *
         CLC   0(6,WORKREG),=C'USERS='                                *
         BE    GETS040                                                *
         CLC   0(7,WORKREG),=C'SECTAB='                               *
         BE    GETS060                                                *
         LA    WORKREG,1(WORKREG)                                     *
         C     WORKREG,ENDAD                                          *
         BH    GETS090                                                *
         BCT   COUNTREG,GETS000                                       *
         B     GETS090                                                *
GETS040  EQU   *                                                      *
         LA    GETREG,ULIB                                            *
         LA    WORKREG,6(WORKREG)                                     *
         SH    COUNTREG,=H'6'                                         *
         ST    WORKREG,GETSW01                                        *
         ST    COUNTREG,GETSW02                                       *
GETS041  CLI   0(WORKREG),C' '                                        *
         BE    GETS049                                                *
         CLI   0(WORKREG),C'.'                                        *
         BE    GETS042                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS041                                                *
GETS042  EQU   *                                                      *
         LA    GETREG,USLIB                                           *
         LA    WORKREG,1(WORKREG)                                     *
GETS043  CLI   0(WORKREG),C' '                                        *
         BE    GETS049                                                *
         CLI   0(WORKREG),C'.'                                        *
         BE    GETS044                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS043                                                *
GETS044  EQU   *                                                      *
         LA    GETREG,UMEMB                                           *
         LA    WORKREG,1(WORKREG)                                     *
GETS045  CLI   0(WORKREG),C' '                                        *
         BE    GETS049                                                *
         CLI   0(WORKREG),C'.'                                        *
         BE    GETS046                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS045                                                *
GETS046  EQU   *                                                      *
         LA    GETREG,UMTYP                                           *
         LA    WORKREG,1(WORKREG)                                     *
GETS047  CLI   0(WORKREG),C' '                                        *
         BE    GETS049                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS047                                                *
GETS049  EQU   *                                                      *
         L     WORKREG,GETSW01                                        *
         L     COUNTREG,GETSW02                                       *
         B     GETS000                                                *
GETS060  EQU   *                                                      *
         LA    WORKREG,7(WORKREG)                                     *
         SH    COUNTREG,=H'7'                                         *
         ST    WORKREG,GETSW01                                        *
         ST    COUNTREG,GETSW02                                       *
         LA    GETREG,SLIB                                            *
GETS061  CLI   0(WORKREG),C' '                                        *
         BE    GETS069                                                *
         CLI   0(WORKREG),C'.'                                        *
         BE    GETS062                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS061                                                *
GETS062  EQU   *                                                      *
         LA    GETREG,SSLIB                                           *
         LA    WORKREG,1(WORKREG)                                     *
GETS063  CLI   0(WORKREG),C' '                                        *
         BE    GETS069                                                *
         CLI   0(WORKREG),C'.'                                        *
         BE    GETS064                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS063                                                *
GETS064  EQU   *                                                      *
         LA    GETREG,SMEMB                                           *
         LA    WORKREG,1(WORKREG)                                     *
GETS065  CLI   0(WORKREG),C' '                                        *
         BE    GETS069                                                *
         CLI   0(WORKREG),C'.'                                        *
         BE    GETS066                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS065                                                *
GETS066  EQU   *                                                      *
         LA    GETREG,SMTYP                                           *
         LA    WORKREG,1(WORKREG)                                     *
GETS067  CLI   0(WORKREG),C' '                                        *
         BE    GETS069                                                *
         MVC   0(1,GETREG),0(WORKREG)                                 *
         LA    GETREG,1(GETREG)                                       *
         LA    WORKREG,1(WORKREG)                                     *
         B     GETS067                                                *
GETS069  EQU   *                                                      *
         L     WORKREG,GETSW01                                        *
         L     COUNTREG,GETSW02                                       *
         B     GETS090                                                *
GETS090  EQU   *                                                      *
* --------------------------------------------------------------------*
         CLI   ULIB,C' '               ULIB SET ?                     *
         BH    GETS091                                                *
         MVC   ULIB(7),DEFUSR                                         *
GETS091  EQU   *                                                      *
         CLI   USLIB,C' '              ULIB SET ?                     *
         BH    GETS092                                                *
         MVC   USLIB(8),DEFUSR+7                                      *
GETS092  EQU   *                                                      *
         CLI   UMEMB,C' '              ULIB SET ?                     *
         BH    GETS093                                                *
         MVC   UMEMB(8),DEFUSR+15                                     *
GETS093  EQU   *                                                      *
         CLI   UMTYP,C' '              ULIB SET ?                     *
         BH    GETS094                                                *
         MVC   UMTYP(8),DEFUSR+23                                     *
GETS094  EQU   *                                                      *
         CLI   SLIB,C' '               ULIB SET ?                     *
         BH    GETS095                                                *
         MVC   SLIB(7),DEFSEC                                         *
GETS095  EQU   *                                                      *
         CLI   SSLIB,C' '              ULIB SET ?                     *
         BH    GETS096                                                *
         MVC   SSLIB(8),DEFSEC+7                                      *
GETS096  EQU   *                                                      *
         CLI   SMEMB,C' '              ULIB SET ?                     *
         BH    GETS097                                                *
         MVC   SMEMB(8),DEFSEC+15                                     *
GETS097  EQU   *                                                      *
         CLI   SMTYP,C' '              ULIB SET ?                     *
         BH    GETS098                                                *
         MVC   SMTYP(8),DEFSEC+23                                     *
GETS098  EQU   *                                                      *
         BR    SUBREG                  RETURN                         *
*---------------------------------------------------------------------*
GETCARD0 EQU   *                                                      *
         L     R3,APISTADA                                            *
         LIBRM CLOSE,                                                  *
               LDCB=(3),               DCBLIBR,                        *
               COMMIT=NO               , YES ONLY FOR TYPE OUTPUT
*---------------------------------------------------------------------*
         LIBRDCB FUNC=MOD,             CHANGE TO SEC. MEMBER           *
               AREA=(3),       DCBLIBR,                                *
               LIB=SLIB,               GETLIB                          *
               SUBLIB=SSLIB,           GETSUBLB                        *
               MEMBER=SMEMB,           GETMEMBN                        *
               TYPE=SMTYP,             GETMEMTY                        *
               DIRINF=GETDIRNF,                                        *
               DIRINFL=GETDIRNL,                                       *
               BUFFER=GETBUFER,                                        *
               BUFSIZE=GETBUFLN,                                       *
               RECNO=0,                                                *
               UNITS=0,                                                *
               EROPT=RET,                                              *
               ERRAD=APIERR00
* --------------------------------------------------------------------*
         L     R3,APISTADA
         LIBRM OPEN,                                                   *
               TYPEFLE=INPUT,                                          *
               NOTFND=PRL02,           APIOPN20,                       *
               LDCB=(3)                DCBLIBR
         LA    R2,1                    SET UNITS TO 1 BYTE/RECORD     *
         SLR   R4,R4                   SET STARTING BYTE/RECORD       *
         XC    RECNO,RECNO                                            *
*---------------------------------------------------------------------*
         MVI   HLINE2,C' '                                            *
         MVC   HLINE2+1(L'HLINE2-1),HLINE2                            *
         ZAP   UCOUNT,=P'0'                                           *
GETCARD  EQU   *                                                      *
         MVC   TRANID,=CL4' '          SET CURRENT TRANID TO BLANK    *
*        MVC   TRANIDS,=CL4' '         SET SAVE TRANID TO BLANK       *
*---------------------------------------------------------------------*
         L     R3,APISTADA                                            *
         L     R4,RECNO                                               *
         LIBRM GET,                                                    *
               LDCB=(3),    DCBLIBR,                                   *
               RECNO=(4),                                              *
               UNITS=(2),                                              *
               EODAD=PRL02,            APIGET10                        *
               MOVELEN=GETMOVEL
         LA    R4,1(R4)                                               *
         ST    R4,RECNO                                               *
         MVC   QPKARTE(80),GETBUFER    MOVE THE RECORD                *
*---------------------------------------------------------------------*
*        GET   CPGRDR,QPKARTE          GET THE DTSECTXN CARD          *
*---------------------------------------------------------------------*
         LA    WORKREG,QPKARTE         POINT TO START                 *
         LA    COUNTREG,69             MAX COUNT                      *
GC0010   CLC   0(9,WORKREG),=CL9'TRANSEC=('     SEARCH                *
         BE    GC0020                  SKIP IF FOUND                  *
         CLC   0(5,WORKREG),=CL5'NAME='         SEARCH                *
         BE    GC0015                  SKIP IF FOUND                  *
         LA    WORKREG,1(WORKREG)      NEXT                           *
         BCT   COUNTREG,GC0010         LOOP ENTRY                     *
         B     GETCARD                 NOT FOUND -NEXT CARD           *
GC0015   EQU   *                       *---TRANID FOUND --------------*
         LA    WORKREG,5(WORKREG)      SKIP NAME=                     *
         SH    COUNTREG,=H'5'          SUBTRACT 5                     *
         MVC   TRANID(4),0(WORKREG)    MOVE TRANID                    *
         CLI   TRANID+1,C','           CHECK NAME FOR 1 BYTE          *
         BE    GC0015A                                                *
         CLI   TRANID+2,C','           CHECK NAME FOR 2 BYTES         *
         BE    GC0015B                                                *
         CLI   TRANID+3,C','           CHECK NAME FOR 3 BYTES         *
         BE    GC0015C                                                *
         B     GC0010                  GOTO CHECK NEXT NXTE           *
GC0015A  MVC   TRANID+1(3),=CL3' '                                    *
         B     GC0010                                                 *
GC0015B  MVC   TRANID+2(2),=CL2' '                                    *
         B     GC0010                                                 *
GC0015C  MVI   TRANID+3,C' '                                          *
         B     GC0010                  GOTO CHECK NEXT BYTE           *
*---------------------------------------------------------------------*
GC0020   EQU   *                       TRANKEY FOUND                  *
         LA    WORKREG,9(WORKREG)      SKIP TRANKEY=                  *
         CLI   1(WORKREG),C')'         CHECK FOR ) = 1 BYTE TRANKEY   *
         BE    GC0030                                                 *
         MVC   TRSEC(2),0(WORKREG)     MOVE TRANKEY                   *
         B     GC0040                  SKIP                           *
GC0030   MVI   TRSEC,C'0'              1 BYTE TRANKEY                 *
         MVC   TRSEC+1(1),0(WORKREG)                                  *
GC0040   PACK  TRSECP,TRSEC(2)         MAKE THE VALUE PACKED          *
         MVN   TRSECP+1(1),=X'CC'      SIGN                           *
         ZAP   BINWORT,TRSECP          ZAP FOR BINARY CONVERT         *
         CVB   COUNTREG,BINWORT        MAKE IT BINARY                 *
         BCTR  COUNTREG,0              SUBTRACT 1                     *
         STH   COUNTREG,OFSET          SAVE IT TO OFSET               *
         LA    GETREG,TRANKLST         POINT TO TRAN_KEY_LIST         *
         AR    GETREG,COUNTREG         ADD COUNTREG                   *
         MVI   0(GETREG),C'X'          INDICATE SET                   *
         L     GETREG,=V(TRANLST)      POINT TO TRANSACTION LIST      *
GC0100   EQU   *                       LOOK FOR END OF TABLE          *
         CLC   0(4,GETREG),=F'-1'      CHECK FOR FFFF                 *
         BE    GC0110                  IF FOUND SKIP                  *
         LA    GETREG,6(GETREG)        GET NEXT ENTRY                 *
         B     GC0100                  DO IT IN A LOOP                *
GC0110   EQU   *                       END OF TABLE FOUND             *
         MVC   0(4,GETREG),TRANID      MOVE TRANID                    *
         MVC   4(2,GETREG),TRSECP      MOVE TRANSEC                   *
         MVC   6(4,GETREG),=F'-1'      SET END OF TABLE               *
         B     GETCARD                 NEXT CARD                      *
*---------------------------------------------------------------------*
         B     GETCARD                                                *
*---------------------------------------------------------------------*
PRL02    EQU   *                                                      *
         L     R3,APISTADA
         LIBRM CLOSE,                                                  *
               LDCB=(3),               DCBLIBR,                        *
               COMMIT=NO               , YES ONLY FOR TYPE OUTPUT
*---------------------------------------------------------------------*
         L     R0,APISTADL            RELOAD GETVIS AREA LENGTH       *
         L     R1,APISTADA            RELOAD GETVIS AREA ADDRESS      *
         FREEVIS ADDRESS=(1),LENGTH=(0)                               *
         AP    LPAGE,=P'1'                                            *
         MVI   LISTE,C'1'                                             *
         BAL   GETREG,PUTLST                                          *
         MVC   LISTE+1(32),=CL32'CROSS REFERENCE LISTING TRANKEYS'    *
         MVC   LISTE+50(8),DATUM                                      *
         MVC   LISTE+60(10),ZEIT                                      *
         MVC   LISTE+70(5),=C'SEITE'                                  *
         MVC   LISTE+75(6),=X'402020202020'                           *
         ED    LISTE+75(6),LPAGE                                      *
         MVC   HLINE(120),LISTE+1      SAVE HEADLINE 01               *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE,C' '                                             *
         MVI   LISTE+1,C'-'                                           *
         MVC   LISTE+2(118),LISTE+1                                   *
         BAL   GETREG,PUTLST                                          *
         ZAP   UCOUNT,=P'0'                                           *
         ZAP   TRSECP,=P'0'  1         START WITH TRANSACTION CLASS 2 *
PRL0200  EQU   *                                                      *
         MVI   ULINE,C' '              CLEAR LINE                     *
         MVC   ULINE+1(L'ULINE-1),ULINE  CLEAR LINE                   *
         ZAP   TCOUNT,=P'0'            SET TRANSACTION COUNT TO 0     *
         AP    TRSECP,=P'1'            START WITH TRANSACTION CLASS 2 *
         CP    TRSECP,=P'64'           CHECK FOR TRANKEY GT 64        *
         BH    PRL0240                 END IT                         *
         LA    WORKREG,TRANKLST        POINT TO LIST OF USED TRANKEYS *
         ZAP   BINWORT,TRSECP          GET SECURITY KEY PACKED        *
         CVB   COUNTREG,BINWORT        MAKE IT BINARY                 *
         BCTR  COUNTREG,0              SUBTRACT 1                     *
         AR    WORKREG,COUNTREG        ADD OFSET                      *
         CLI   0(WORKREG),C'X'         CHECK FOR ANY TRANSACTION FOUND*
         BNE   PRL0200                 IF NOT GO TO LOOP ENTRY        *
         UNPK  TRSECW(3),TRSECP                                       *
         MVZ   TRSECW+2(1),=C'0'       SIGN                           *
         MVC   TRSEC(2),TRSECW+1                                      *
         L     GETREG,=V(TRANLST)      POINT TO TRANSACTION LIST      *
PRL0300  EQU   *                                                      *
         CLC   0(4,GETREG),=F'-1'      END OF LIST                    *
         BE    PRL0305                 GET NEXT TRANKEY               *
         CP    4(2,GETREG),TRSECP      CHECK FOR GROUP                *
         BE    PRL0310                 MEMBER FOUND  -->>  BUILD LIST *
         LA    GETREG,6(GETREG)        CHECK NEXT ENTRY               *
         B     PRL0300                                                *
PRL0305  EQU   *                       *------------------------------*
         ST    GETREG,SAVGETR          SAVE GETREG                    *
         CP    TCOUNT,=P'0'                                           *
         BE    PRL0309                                                *
         CLC   TRSECS,TRSEC            CHECK FOR SAME TRANKEY         *
         BE    PRL0306                 IF SO SKIP TO NEXT SECTION     *
         ZAP   TCOUNT,=P'0'                                           *
         BAL   GETREG,PUTLST                                          *
         MVC   LISTE+1(8),=C'TRANKEY('                                *
         MVC   LISTE+9(2),TRSEC                                       *
         MVI   LISTE+11,C')'                                          *
         MVC   LISTE+13(20),=CL20'TRANSACTION LIST'                   *
         MVC   TRSECS(2),TRSEC                                        *
         MVC   HLINE2(80),LISTE+1      SAVE HEADER LINE2              *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE+1,C'='                                           *
         MVC   LISTE+2(33),LISTE+1                                    *
         MVC   HLINE3(80),LISTE+1      SAVE HEADER LINE3              *
         BAL   GETREG,PUTLST                                          *
PRL0306  EQU   *                                                      *
         MVC   LISTE+1(100),ULINE                                     *
         BAL   GETREG,PUTLST                                          *
PRL0309  MVI   ULINE,C' '                                             *
         MVC   ULINE+1(119),ULINE                                     *
         L     GETREG,SAVGETR          LOAD GETREG                    *
         B     PRL0200                 GET NEXT TRANKEY               *
PRL0310  EQU   *                       *------------------------------*
         ZAP   BINWORT,TCOUNT                                         *
         CVB   COUNTREG,BINWORT                                       *
         MH    COUNTREG,=H'6'          MULT BY 6                      *
         AP    TCOUNT,=P'1'            ADD 1 TO TCOUNT                *
         LA    WORKREG,ULINE                                          *
         AR    WORKREG,COUNTREG                                       *
         MVC   0(4,WORKREG),0(GETREG)                                 *
         MVC   4(2,WORKREG),=C'  '                                    *
         LA    GETREG,6(GETREG)                                       *
         CP    TCOUNT,=P'12'                                          *
         BH    PRL0320                                                *
         B     PRL0300                                                *
PRL0320  EQU   *                                                      *
         ST    GETREG,SAVGETR          SAVE GETREG                    *
         ZAP   TCOUNT,=P'0'                                           *
         CLC   TRSECS,TRSEC            CHECK FOR SAME TRANKEY         *
         BE    PRL0330                 IF SO SKIP TO NEXT SECTION     *
         MVI   LISTE,C' '              NEW PAGE                       *
         BAL   GETREG,PUTLST                                          *
         MVC   LISTE+1(8),=C'TRANKEY('                                *
         MVC   LISTE+9(2),TRSEC                                       *
         MVI   LISTE+11,C')'                                          *
         MVC   LISTE+13(20),=CL20'TRANSACTION LIST'                   *
         MVC   TRSECS(2),TRSEC                                        *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE+1,C'='                                           *
         MVC   LISTE+2(33),LISTE+1                                    *
         BAL   GETREG,PUTLST                                          *
PRL0330  EQU   *                                                      *
         MVC   LISTE+1(100),ULINE                                     *
         BAL   GETREG,PUTLST                                          *
         MVI   ULINE,C' '                                             *
         MVC   ULINE+1(119),ULINE                                     *
         L     GETREG,SAVGETR          LOAD GETREG                    *
         B     PRL0300                                                *
*---------------------------------------------------------------------*
PRL0240  EQU   *                                                      *
         AP    LPAGE,=P'1'                                            *
         MVI   LISTE,C'1'                                             *
         BAL   GETREG,PUTLST                                          *
         MVC   LISTE+1(32),=CL32'CROSS REFERENCE LISTING USERIDS '    *
         MVC   LISTE+50(8),DATUM                                      *
         MVC   LISTE+60(10),ZEIT                                      *
         MVC   LISTE+70(5),=C'SEITE'                                  *
         MVC   LISTE+75(6),=X'402020202020'                           *
         ED    LISTE+75(6),LPAGE                                      *
         MVC   HLINE(120),LISTE+1      SAVE HEADLINE 01               *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE,C' '                                             *
         MVI   LISTE+1,C'-'                                           *
         MVC   LISTE+2(118),LISTE+1                                   *
         BAL   GETREG,PUTLST                                          *
         ZAP   UCOUNT,=P'0'                                           *
         ZAP   TRSECP,=P'1'            START WITH TRANSACTION CLASS 2 *
         MVC   TRSECS,=C'  '                                          *
PRL0245  EQU   *                                                      *
         AP    TRSECP,=P'1'            START WITH TRANSACTION CLASS 2 *
         CP    TRSECP,=P'64'           CHECK FOR TRANKEY GT 64        *
         BH    RETURN                  END IT                         *
         UNPK  TRSECW(3),TRSECP                                       *
         MVZ   TRSECW+2(1),=C'0'       SIGN                           *
         MVC   TRSEC(2),TRSECW+1                                      *
         ZAP   BINWORT,TRSECP                                         *
         CVB   COUNTREG,BINWORT                                       *
         BCTR  COUNTREG,0                                             *
         STH   COUNTREG,OFSET                                         *
         LA    WORKREG,TRANKLST                                       *
         AR    WORKREG,COUNTREG                                       *
         L     GETREG,=V(USERLST)                                     *
         CLI   0(WORKREG),C'X'                                        *
         BE    PRL0250                                                *
         B     PRL0245                                                *
PRL0250  EQU   *                                                      *
         CLC   0(4,GETREG),=F'-1'     END IF USER LIST                *
         BE    PRL0270                                                *
         MVC   USERID1,0(GETREG)      MOVE USERID                     *
         LA    WORKREG,8(GETREG)      POINT TO USER                   *
         AH    WORKREG,OFSET          ADD OFSET                       *
         CLI   0(WORKREG),C'X'                                        *
         BNE   PRL0260                                                *
         AP    UCOUNT,=P'1'                                           *
         ZAP   BINWORT,UCOUNT                                         *
         CVB   WORKREG,BINWORT                                        *
         BCTR  WORKREG,0                                              *
         LA    COUNTREG,ULINE                                         *
         MH    WORKREG,=H'10'                                         *
         AR    COUNTREG,WORKREG                                       *
         MVC   0(8,COUNTREG),USERID1                                  *
         CP    UCOUNT,=P'8'                                           *
         BL    PRL0260                                                *
         ST    GETREG,SAVGETR                                         *
         CLC   TRSECS,TRSEC                                           *
         BE    PRL0259                                                *
         BAL   GETREG,PUTLST                                          *
         MVC   LISTE+1(8),=C'TRANKEY('                                *
         MVC   LISTE+9(2),TRSEC                                       *
         MVI   LISTE+11,C')'                                          *
         MVC   LISTE+13(20),=CL20'USERID LIST     '                   *
         MVC   HLINE2(80),LISTE+1      SAVE HEADER LINE2              *
         MVC   TRSECS(2),TRSEC                                        *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE+1,C'='                                           *
         MVC   LISTE+2(33),LISTE+1                                    *
         MVC   HLINE3(80),LISTE+1      SAVE HEADER LINE3              *
         BAL   GETREG,PUTLST                                          *
PRL0259  EQU   *                                                      *
         MVC   LISTE+1(100),ULINE                                     *
         BAL   GETREG,PUTLST                                          *
         ZAP   UCOUNT,=P'0'                                           *
         MVI   ULINE,C' '                                             *
         MVC   ULINE+1(L'ULINE-1),ULINE                               *
         L     GETREG,SAVGETR                                         *
PRL0260  EQU   *                                                      *
         LA    GETREG,72(GETREG)                                      *
         B     PRL0250                                                *
PRL0270  EQU   *                                                      *
         CP    UCOUNT,=P'0'                                           *
         BE    PRL0245                                                *
         ST    GETREG,SAVGETR                                         *
         CLC   TRSECS,TRSEC                                           *
         BE    PRL0272                                                *
         MVC   LISTE+1(8),=C'TRANKEY('                                *
         MVC   LISTE+9(2),TRSEC                                       *
         MVI   LISTE+11,C')'                                          *
         MVC   LISTE+13(20),=CL20'USERID LIST     '                   *
         MVC   TRSECS,TRSEC                                           *
         BAL   GETREG,PUTLST                                          *
         MVI   LISTE+1,C'='                                           *
         MVC   LISTE+2(33),LISTE+1                                    *
         BAL   GETREG,PUTLST                                          *
PRL0272  EQU   *                                                      *
         MVC   LISTE+1(100),ULINE                                     *
         BAL   GETREG,PUTLST                                          *
         ZAP   UCOUNT,=P'0'                                           *
         MVI   ULINE,C' '                                             *
         MVC   ULINE+1(L'ULINE-1),ULINE                               *
         L     GETREG,SAVGETR                                         *
         B     PRL0245                                                *
PRL0290  EQU   *                                                      *
         B     RETURN                                                 *
*---------------------------------------------------------------------*
PUTLST   EQU   *                                                      *
         CLI   LISTE,C'1'                                             *
         BNE   PUTLST2                                                *
         ZAP   LCOUNT,=P'0'                                           *
PUTLST2  EQU   *                                                      *
         PUT   CPGLST,LISTE                                           *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         AP    LCOUNT,=P'1'                                           *
         CP    LCOUNT,=P'66'                                          *
         BL    PUTLST9                                                *
         AP    LPAGE,=P'1'                                            *
         MVI   LISTE,C'1'                                             *
         MVC   LISTE+1(120),HLINE                                     *
         MVC   LISTE+70(5),=C'SEITE'                                  *
         MVC   LISTE+75(6),=X'402020202020'                           *
         ED    LISTE+75(6),LPAGE                                      *
         PUT   CPGLST,LISTE                                           *
         MVI   LISTE,C'-'                                             *
         MVC   LISTE+1(120),LISTE                                     *
         MVI   LISTE,C' '                                             *
         PUT   CPGLST,LISTE                                           *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         CLC   HLINE2(4),=CL4' '       IS IT BLANK ?                  *
         BE    PUTLST3                                                *
         MVC   LISTE+1(80),HLINE2                                     *
         PUT   CPGLST,LISTE                                           *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         ZAP   LCOUNT,=P'5'                                           *
         CLC   HLINE3(4),=CL4' '       IS IT BLANK ?                  *
         BE    PUTLST9                                                *
         MVC   LISTE+1(80),HLINE3                                     *
         PUT   CPGLST,LISTE                                           *
         MVI   LISTE,C' '                                             *
         MVC   LISTE+1(120),LISTE                                     *
         ZAP   LCOUNT,=P'6'                                           *
         B     PUTLST9                                                *
PUTLST3  EQU   *                                                      *
         ZAP   LCOUNT,=P'4'                                           *
PUTLST9  BR    GETREG                                                 *
*---------------------------------------------------------------------*
RETURN   EQU   *                       EXIT                           *
         CLOSE CPGRDR,CPGLST                                          *
         EOJ                                                          *
*---------------------------------------------------------------------*
RETURN8  EQU   *                       EXIT                           *
         CLOSE CPGRDR,CPGLST                                          *
         LA    15,8                                                   *
         EOJ   RC=15                                                  *
*---------------------------------------------------------------------*
APIERR00 EQU   *                                                      *
         ST    R15,APISAVSC            SAVE SEVERITY CODE             *
         LR    R15,R0                  GET REASON CODE                *
         LA    R1,APIMSG03             MESSAGE TEXT ADDRESS           *
         CLI   APISAVSC+3,RC16         IS THIS RC 16                  *
         BE    APIERR90                YES                            *
         LA    R1,APIMSG04             MESSAGE TEXT ADDRESS           *
         CLI   APISAVSC+3,RC20         IS THIS RC 20                  *
         BE    APIERR90                YES                            *
         LA    R1,APIMSG05             MESSAGE TEXT ADDRESS           *
         CLI   APISAVSC+3,RC32         IS THIS RC 32                  *
         BE    APIERR92                YES                            *
         LA    R1,APIMSG06             MESSAGE TEXT ADDRESS           *
         L     R15,APISAVSC            RELOAD RETURN CODE             *
         B     APIERR90                UNEXPECTED RETURN CODE         *
* -------------------------------------------------------------------**
*        GETVIS AND OTHER ERROR EXITS                                **
* -------------------------------------------------------------------**
APIERR10 EQU   *                       NOT ENOUGH GETVIS FOR EXECUTION*
         LA    R1,APIMSG01             MESSAGE TEXT ADDRESS           *
         B     APIERR90                                               *
APIERR20 EQU   *                       FREEVIS RETURN CODE NOT ZERO   *
         LA    R1,APIMSG02             MESSAGE TEXT ADDRESS           *
         B     APIERR92                                               *
APIERR30 EQU   *                       NUMBER OF DIRECTORY ENTRIES    *
         LA    R1,APIMSG07             MESSAGE TEXT ADDRESS           *
         B     APIERR92                                               *
APIERR89 EQU   *                       NUMBER OF DIRECTORY ENTRIES    *
         LA    R1,APIMSG09             MESSAGE TEXT ADDRESS           *
         B     APIERR92                                               *
* -------------------------------------------------------------------**
*        WRITE MESSAGE ON SYSLOG                                     **
* -------------------------------------------------------------------**
APIERR90 EQU   *                                                      *
         CVD   R15,APIRCPAK            TRANSLATE RETURN CODE          *
         UNPK  35(3,R1),APIRCPAK+5(3)  UNPACK                         *
         OI    37(R1),C'0'             CORRECT SIGN BYTE              *
APIERR92 EQU   *                                                      *
         LA    R8,RETURN8              SET CONTINUATION               *
APIERR94 EQU   *                                                      *
         STCM  R1,7,APIERCCW+1         TO ERROR CCW                   *
         LA    R1,APIERCCB             LOAD CORRESPONDING CCB         *
         EXCP  (1)                     WRITE MESSAGE                  *
         WAIT  (1)                     WAIT FOR I/O COMPLETE          *
         BR    R8                      CONTINUE AS INDICATED          *
*---------------------------------------------------------------------*
BINWORT  DS    D                                                      *
TRKYWS1  DS    F                                                      *
SAVGETR  DS    F                                                      *
CURTIME  DS    F                                                      *
CTYPE    DC    CL8' '                                                 *
USERID   DC    CL8' '                                                 *
USERID1  DC    CL8' '                                                 *
DATUM    DC    CL8'DD.MM.YY'                                          *
ZEIT     DC    CL10'         '         HH.MM UHR                      *
NEXT     DC    CL1' '                                                 *
         DC    CL4'UPSI'                                              *
UPSI     DC    CL1' '                                                 *
TK01     DC    32CL1' '                                               *
TK02     DC    32CL1' '                                               *
FROM     DC    CL2'00'                                                *
FROMP    DC    PL2'0'                                                 *
BIS      DC    CL2'00'                                                *
BISP     DC    PL2'0'                                                 *
TRSEC    DC    CL2'00'                                                *
TRSECS   DC    CL2'00'                                                *
TRSECP   DC    PL2'0'                                                 *
TRSECW   DC    CL3' '                                                 *
OFSET    DC    H'0'                                                   *
ANZP     DC    PL2'0'                                                 *
LCOUNT   DC    PL2'0'                                                 *
LPAGE    DC    PL3'0'                                                 *
TK01I    DC    C' '                                                   *
TK02I    DC    C' '                                                   *
QPKARTE  DS    0CL80                                                  *
QPKART1  DS    CL80                                                   *
UMWLST   DS    0CL121                                                 *
LISTE    DS    0CL121                                                 *
VS       DC    C' '                                                   *
UMWLSTE  DS    CL120                                                  *
HLINE    DC    CL120' '                                               *
HLINE2   DC    CL120' '                                               *
HLINE3   DC    CL120' '                                               *
SCALE    DC    C'....+....1....+....2....+....3....+....4....+....5'  *
         DC    C'....+....6....'                                      *
TRANKLST DC    CL64' '                                                *
UCOUNT   DC    PL2'0'                                                 *
TCOUNT   DC    PL2'0'                                                 *
TRANID   DC    CL4' '                                                 *
TRANIDS  DC    CL4' '                                                 *
ULINE    DC    CL100' '                                               *
*---------------------------------------------------------------------*
GETSW01  DS    F                                                      *
GETSW02  DS    F                                                      *
ULIB     DS    CL7                                                    *
USLIB    DS    CL8                                                    *
UMEMB    DS    CL8                                                    *
UMTYP    DS    CL8                                                    *
SLIB     DS    CL7                                                    *
SSLIB    DS    CL8                                                    *
SMEMB    DS    CL8                                                    *
SMTYP    DS    CL8                                                    *
*----------------....+....1....+....2....+....3.----------------------*
DEFUSR   DC    C'PRD2   CONFIG  IESXSUSPLST     '                     *
DEFSEC   DC    C'PRD2   CONFIG  DTSECTXSA       '                     *
*---------------------------------------------------------------------*
* -------------------------------------------------------------------**
*        SAVE AREA DECLARATIONS                                      **
* -------------------------------------------------------------------**
RECNO    DC    F'0'                                                   *
ENDAD    DC    F'0'                                                   *
LIBRDCBA DC    F'0'                                                   *
APISAVSC DC    F'0'                     SEVERITY CODE FROM REG. 15    *
APISAVRC DC    F'0'                     REASON CODE FROM REG. 0       *
RC16     EQU   X'10'                    SEVERITY CODE 16              *
RC20     EQU   X'14'                    SEVERITY CODE 20              *
RC32     EQU   X'20'                    SEVERITY CODE 32              *
APISTADA DC    F'0'                     GETVIS LDCB ADDRESS           *
APISTADL DC    F'0'                     GETVIS LDCB LENGTH            *
APISAVIL DC    F'0'                     SAVE DIRINF LENGTH            *
LEN1     DC    F'0'                     TEMP FIELD                    *
* -------------------------------------------------------------------**
*        WORKFIELDS                                                  **
* -------------------------------------------------------------------**
         DS    0D                                                     *
APIRCPAK DC    D'00'                    CVD AREA                      *
* -------------------------------------------------------------------**
*        PARAMETER FIELD DEFINITIONS FOR GET MEMBER                  **
* -------------------------------------------------------------------**
         DS    0F                                                     *
APIMONS1 DC    XL72'00'                MONITOR TASK SAVE AREA         *
* -------------------------------------------------------------------**
GETLIB   DC    CL7'PRD2   '           REQUESTED LIBRARY               *
GETSUBLB DC    CL8'CONFIG  '          REQUESTED SUBLIBRARY            *
* -------------------------------------------------------------------**
GETMEMBN DC    CL8'DTSECTXS'          REQUESTED MEMBER NAME           *
GETMEMTY DC    CL8'A       '          REQUESTED MEMBER TYPE           *
* -------------------------------------------------------------------**
GETDIRNF DC    256X'00'               DIRECTORY INFORMATION           *
GETDIRNL EQU   *-GETDIRNF             LENGTH OF DIRINF AREA           *
GETMOVEL DS    F                      RECORDS/BYTES TRANSFERRED       *
GETBUFER DC    10XL80'00'             BUFFER TO CONTAIN DATA          *
GETBUFLN EQU   *-GETBUFER             BUFFER LENGTH                   *
* -------------------------------------------------------------------**
*        MESSAGE TABLES                                              **
* -------------------------------------------------------------------**
         DS    0F                       ALIGNEMENT                    *
APISTMMT EQU   *                        STATE MEMBER MESSAGE TABLE    *
         DC    XL4'00000C08'            MAX SEVERITY/REASON CODE      *
         DC    A(APISTMST)              STATE MEMBER CHARACTER        *
         DC    AL1(X'00'),AL3(APISTMM1) SC 00 RC 00                   *
         DC    AL1(X'44'),AL3(APISTMM2) SC 00 RC 04                   *
         DC    AL1(X'08'),AL3(APISTMM3) SC 04 RC 00                   *
         DC    AL1(X'48'),AL3(APISTMM4) SC 04 RC 04                   *
         DC    AL1(X'40'),AL3(APISTMM5) SC 08 RC 00                   *
         DC    AL1(X'40'),AL3(APISTMM6) SC 12 RC 00                   *
         DC    AL1(X'40'),AL3(APISTMM7) SC 12 RC 04                   *
         DC    AL1(X'40'),AL3(APISTMM8) SC 12 RC 08                   *
*--------------------------------------------------------------------**
APISTMST DC    CL11'STATE MEMB '        CHARACTER STRING FOR MESSAGE  *
APICRFL1 DC    X'00'                    WORKFIELD FOR MESSAGE FLAG    *
RCINV    EQU   X'80'                    INVALID SEVERITY/REASON CODE  *
RCCON    EQU   X'40'                    CAN'T CONTINUE WITH THIS RC   *
* -------------------------------------------------------------------**
*        ERROR MESSAGE DEFINITIONS                                   **
* -------------------------------------------------------------------**
APIERCCB CCB   SYSLOG,APIERCCW                                        *
APIERCCW CCW   X'09',APIMSG01,X'20',L'APIMSG01                        *
APIMSG01 DC    C'API MON :     GETVIS FAILED   RC = XXX              '
APIMSG02 DC    C'API MON :    FREEVIS FAILED   RC = XXX              '
APIMSG03 DC    C'API  EXT.SYS ERROR  RC = 16   FB = XXX              '
APIMSG04 DC    C'API  INT.SYS ERROR  RC = 20   FB = XXX              '
APIMSG05 DC    C'API  ACCESS CONTROL RC = 32   (PREECEDING MSGL163I) '
APIMSG06 DC    C'API  UNDEFINED  RETURN CODE   RC = XXX              '
APIMSG07 DC    C'API STATE MEMBER : NO DIRECTORY INFORMATION RETURNED'
APIMSG08 DC    C'API             : SC=XX RC=XX  UNEXPECTED OR INVALID'
APIMSG09 DC    C'API GETVIS ERROR                                    '
APISTMM1 DC    C'API STATE MEMB SC=00 RC=00 INFORM.STORED IN DIRINF  '
APISTMM2 DC    C'API STATE MEMB SC=00 RC=04 DIRINF NOT SPECIFIED     '
APISTMM3 DC    C'API STATE MEMB SC=04 RC=00 DIRINF TOO SMALL CONT=YES'
APISTMM4 DC    C'API STATE MEMB SC=04 RC=04 DIRINF TOO SMALL CONT=NO '
APISTMM5 DC    C'API STATE MEMB SC=08 RC=00 MEMBER NOT FOUND         '
APISTMM6 DC    C'API STATE MEMB SC=12 RC=00 SUBLIBRARY DOES NOT EXIST'
APISTMM7 DC    C'API STATE MEMB SC=12 RC=04 LIBRARY DOES NOT EXIST   '
APISTMM8 DC    C'API STATE MEMB SC=12 RC=08 CHAIN DOES NOT EXIST     '
* -------------------------------------------------------------------*
*        LIBR MEMBER STATUS INFORMATION BLOCK (DSECT)                *
* -------------------------------------------------------------------*
CPGRDR   DTFDI DEVADDR=SYSIPT,EOFADDR=EOFR,IOAREA1=QPKART1,RECSIZE=80
CPGLST   DTFDI DEVADDR=SYSLST,IOAREA1=UMWLST,RECSIZE=121
         LTORG
* -------------------------------------------------------------------*
USERLST  CSECT                                                        *
         DC    F'-1'                                                  *
         DC    1000CL72' '                                            *
* -------------------------------------------------------------------*
TRANLST  CSECT
         DC    F'-1'
         DC    4000CL6' '
* -------------------------------------------------------------------*
         INLCMBST
         END                           ,
/*
// EXEC LNKEDT
/*
/&
* $$ EOJ