Cpadmin

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Wechseln zu: Navigation, Suche
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS AG  1988                                   *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
*
CPADMIN  CSECT
*---------------------------------------------------------------------*
* RELM AUF GUELTIGKEIT UEBERPRUEFEN.
** V3.0AK4
* REQM AUF GUELTIGKEIT UEBERPRUEFEN.
** V3.0AK3
* NAMENAENDERUNG CP.SYSOUT -> SYSLOG.CP.030
* NAME DER SEQ-DATEI (Z.TEIL) AUF 54 ERHOEHT.
** V3.0A00
* USTATVT, NEU BEI SH-VT, SH-RT : VT:VTNAME
** V2.0A05
* KOMMANDOS: CH-SEQ / CH-LOG / SH-VT / SH-RT / MESS
** V1.4A00
*
*---------------------------------------------------------------------*
         PRINT NOGEN
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
*---------------------------------------------------------------------*
         GPARMOD 31
CPADMIN  AMODE ANY
CPADMIN  RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
* > REGISTERUEBERGABE <
* R3  STATEIN
* R4  USEREIN
* R6  PARAMLIST
* R14 RET. ADRES   (BASR R14,R15)
* > BENUTZTE REGISTER <
* R1  DIV.
* R5  SEND AREA
* R7  SEND CID
* R8  V(KONST)/ ARBEIT
* R9  BASIS REG
* R10 BASIS REG
* R11 BASIS REG
* R12 SEND AREALN
* R13 SPRUNG REG / SEND RPB
* R15 DIV.
         USING *,R15
         STM   R8,R12,SAVTAB
         ST    R14,SAV14
         USING CPADMA,R9,R10
         USING STATEIN,R3
         USING USEREIN,R4
CPADMA   BASR  R9,0
         BCTR  R9,R0
         BCTR  R9,R0
         LA    R1,4095
         LA    R10,1(R9,R1)
         DROP  R15
         B     ADBEG
SAV14    DS    F
SAVTAB   DS    5F
*---------------------------------------------------------------------*
*        E X T R N ' S   /  E N T R I E S
*---------------------------------------------------------------------*
* DUMMY  EXTRN SYSLOGD   KOORD. MIT CPCOPY-MODUL, UEBER V(KONST)
*---------------------------------------------------------------------*
ADBEG    EQU   *
         REQM  1          FUER AUSGABEPUFFER
         LTR   R15,R15
         BE    ADBEGRQ
         MVC   ERRTEXT,=CL20'ADM/BEG/REQM'  
         BAS   R13,AFEHLER
         B     ADMRETRQ
ADBEGRQ  EQU   *
         ST    R1,ADMPUFF
         XR    R12,R12
         XR    R5,R5
         LR    R5,R1
         MVC   0(22,R5),SENDNK      NACHR.KOPF
         LA    R12,22(R12)
         LA    R5,22(R5)
*
         CLC   0(6,R6),=CL6'CH-SEQ'
         BE    ADSEQ
         CLC   0(6,R6),=CL6'CH-LOG'
         BE    ADLOG
         CLC   0(5,R6),=CL5'MESS '
         BE    ADMESS
         CLC   0(5,R6),=CL5'SH-VT'
         BE    AVTBEG
         CLC   0(5,R6),=CL5'SH-RT'
         BE    ARTBEG
*        CLC   0(6,R6),=CL6'TRC-ON'
*        BE    ADTRCON
*        CLC   0(7,R6),=CL7'TRC-OFF'
*        BE    ADTRCOFF
******** AAAAAA
         MVC   0(AD0009Q,R5),AD0009
         LA    R12,AD0009Q(R12)      LEN
         LA    R5,AD0009Q(R5)        DIST
******** AAAAAA
         B     ADMRET
*-----------------------------------------  CH-SEQ  ------------------*
ADSEQ    EQU   *
         L     R8,=V(SEQ)
         MVC   AFSTAT+40(54),0(R8)     FILENAM AUS MCP002
         MVC   FDBCFN2L(54),0(R8)
         CNOP  0,4
AFSTAT   FSTAT (X,54),CMIST,160,VERSION=800,FCBTYPE=ISAM,SIZE=(1,)
         LTR   R15,R15
         BNZ   AFSERR
ACATAL   CATAL CP.START.SEQ.SRC,STATE=U,SHARE=NO
         LTR   R15,R15
         BNZ   AFSERR
         L     R1,=V(FCBSEQ)
         CLOSE (R1)
         MVC   AD0013F(25),0(R8)
******** AAAAAA
         MVC   0(AD0013Q,R5),AD0013
         LA    R12,AD0013Q(R12)      LEN
         LA    R5,AD0013Q(R5)        DIST
******** AAAAAA
COPY     OPSYN
         CNOP  0,4
ADCOPY   COPY  CP.START.SEQ.SRC,X,SAME
         LTR   R15,R15
         BZ    ADFSOK
         BAS   R13,DFEHLER
         MVC   AD0020ER(4),DMSERR
         MVC   AD0020F(25),0(R8)
******** AAAAAA
         MVC   0(AD0020Q,R5),AD0020
         LA    R12,AD0020Q(R12)      LEN
         LA    R5,AD0020Q(R5)        DIST
******** AAAAAA
         B     ADOPS
ADFSOK   EQU   *
******** AAAAAA
         MVC   0(AD0015Q,R5),AD0015
         LA    R12,AD0015Q(R12)      LEN
         LA    R5,AD0015Q(R5)        DIST
******** AAAAAA
         BAS   R13,ADMSEND      (SUCCESSFULLY WRITTEN)
ADOPS    L     R1,=V(FCBSEQ)
         OPEN  (R1),INPUT
         MVC   AD0014F(25),0(R8)
******** AAAAAA
         MVC   0(AD0014Q,R5),AD0014
         LA    R12,AD0014Q(R12)      LEN
         LA    R5,AD0014Q(R5)        DIST
******** AAAAAA
         B     ADMRET
AFSERR   EQU   *
         BAS   R13,DFEHLER
         MVC   AD0020ER(4),DMSERR
         MVC   AD0020F(25),0(R8)
******** AAAAAA
         MVC   0(AD0020Q,R5),AD0020
         LA    R12,AD0020Q(R12)      LEN
         LA    R5,AD0020Q(R5)        DIST
******** AAAAAA
ADMRET   EQU   *
         MVC   0(8,R5),SENDEND     ENDE
         LA    R12,8(R12)
         L     R5,ADMPUFF
         BAS   R13,ADMSEND
         L     R5,ADMPUFF
         SRA   R5,12
         LTR   R5,R5
         BNZ   ARELM1
         MVC   ERRTEXT,=CL20'ADM/RELM/0'     
         BAS   R13,AFEHLER
         B     ADMRETRQ
ARELM1   EQU   *
         RELM  1,(R5)        PUFFER WIEDER FREI
ADMRETRQ L     R14,SAV14
         LM    R8,R12,SAVTAB
         BR    R14
*----------------------------------------------------------------------*
DFEHLER  EQU   *
         ST    R15,ERR15
         UNPK  UERR15,ERR15(5)
         TR    UERR15,HX-240
         BR    R13
*------------------  YSEND --> R5 AREA / R12 --> AREALN  --------------*
*                    ANSPRING IMMER MIT R13                            *
         DS    F
ADMSEND  ST    R13,ADMSEND-4
         L     R13,STATRPBA
         L     R7,STATCID
         LA    R2,STATEI
ADSEND1  L     R14,STAIDCP
         YSEND RPB=(R13),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R12),    -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    ADSENDE
         MVC   ERRTEXT,=CL20'ADM/SEND/YSEND'
         CLM   R15,B'1110',=X'10040C'
         BNE   AD777
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BE    ADSEND1
         MVC   ERRTEXT,=CL20'ADM/SEND/SOLSIG'
AD777    BAS   R13,AFEHLER
ADSENDE  L     R13,ADMSEND-4
         BR    R13
*----------------------------------------------------------------------*
         DS    F
AFEHLER  EQU   *
         ST    R13,AFEHLER-4
         ST    R15,ERR15
         UNPK  ERRR15,ERR15(5)
         TR    ERRR15,HX-240
         WROUT ERRMSG,ATERME
ATERME   L     R13,AFEHLER-4
         BR    R13
*----------------------------------------------------------------------*
ADMPUFF  DS    F                 AUSGABEPUFFER
ERRMSG   DC    Y(ERRMSGE-ERRMSG)
         DC    C'   %  ZCP0006 CP-ERROR AT:'
ERRTEXT  DS    CL20
         DC    C'  RC:'
ERRR15   DS    L9
ERRMSGE  EQU   *-1
         ORG
         DS    0F
CMIST    DS    CL160
         DS    CL120
HX       DC    C'0123456789ABCDEF'
ERR15    DS    F
UERR15   DS    0L9
         DS    L4
DMSERR   DS    L4
         DS    L1
*****************
AD0013   DS    0H
         DC    C'% ZCP0013 FILE '
AD0013F  DS    CL25
         DC    C'CLOSED.'
         DC    X'2798'
AD0013E  EQU   *
*****************
AD0020   DS    0H
         DC    C'% ZCP0020 DVS-ERROR: '''
AD0020ER DS    CL4      ERRORCODE
         DC    C''' ON FILE '
AD0020F  DS    CL25
         DC    X'2798'
AD0020E  EQU   *
*****************
AD0015   DS    0H
         DC    C'% ZCP0015 SEQ-FILE SUCCESSFULLY WRITTEN.'
         DC    X'2798'
AD0015E  EQU   *
*****************
AD0014   DS    0H
         DC    C'% ZCP0014 FILE '
AD0014F  DS    CL25
         DC    C'OPENED.'
         DC    X'2798'
AD0014E  EQU   *
*****************
AD0009   DS    0H
         DC    C'% ZCP0009 NO ADMIN-COMMAND. PROCESSING TERMINATED.'
         DC    X'2798'
AD0009E  EQU   *
*****************
SENDNK   DS    0CL22
         DC    X'10401B2061404045625400400000412127822784' LSP
         DC    X'2798'
*****************
SENDEND  DS    0CL8      ABSCHLUSS
         DC    CL4'CMD:'
         DC    X'27841ED7'
*****************
*
         DS    0F
AD0013Q  EQU   AD0013E-AD0013
AD0020Q  EQU   AD0020E-AD0020
AD0015Q  EQU   AD0015E-AD0015
AD0014Q  EQU   AD0014E-AD0014
AD0009Q  EQU   AD0009E-AD0009
*****************
         ORG   AFSTAT
         IDFST ,F
         ORG
*
         ORG   ADCOPY+4   +4 WEIL DER IDCOP-MACRO FALSCH IST
         IDCOP ,F
         ORG
*---------------------------------------------------------------------*
*
         LTORG              <<<<<<<<<<<<<<<<<
*---------------------------------------------------------------------*
*------------------  CH-LOG   WECHSEL LOGGING  -----------------------*
*---------------------------------------------------------------------*
         DS    0F
ADLOG    EQU   *
         L     R8,=V(SYSLOGD)        AUS CPCOPY
         MVC   AYSLOGD(20),0(R8)
*
         CLI   AYSLOGD,C'X'
         BE    AYSLOG1
         SYSFL 'SYSOUT=(PRIMARY)'
         MVC   AYSLT1+63(20),AYSLOGD
         MVC   AD0017F(20),AYSLOGD
******** AAAAAA
         MVC   0(AD0017Q,R5),AD0017
         LA    R12,AD0017Q(R12)      LEN
         LA    R5,AD0017Q(R5)        DIST
******** AAAAAA
         CNOP  0,4
AYSLT1   CMD   'TYPE',' %  ZCP0017 SYSLOG.CP.030.XX.XX.XX.XXXXXX.XXXX C-
               LOSED.'
AYSLOG1  GDATE LOGDAT,FORMAT=ISO,TOD=LOGTIM
         TMODE PARLIST=TMODPL       (MAKRO DTMODE)
         MVC   AYSLOGD(2),LOGDAT
         MVC   AYSLOGD+3(2),LOGDAT+3
         MVC   AYSLOGD+6(2),LOGDAT+6
         MVC   AYSLOGD+9(2),LOGTIM
         MVC   AYSLOGD+11(2),LOGTIM+3
         MVC   AYSLOGD+13(2),LOGTIM+6
         MVC   AYSLOGD+16(4),TMODTSN
         MVC   AYSLOGO+61(20),AYSLOGD
         CNOP  0,4
AYSLOGO  SYSFL 'SYSOUT=SYSLOG.CP.030.XX.XX.XX.XXXXXX.XXXX'
         LTR   R15,R15
         BNZ   AYSLERR
         MVC   AYSLT2+63(20),AYSLOGD
         MVC   AD0018F(20),AYSLOGD
******** AAAAAA
         MVC   0(AD0018Q,R5),AD0018
         LA    R12,AD0018Q(R12)      LEN
         LA    R5,AD0018Q(R5)        DIST
******** AAAAAA
         CNOP  0,4
AYSLT2   CMD   'TYPE',' %  ZCP0018 SYSLOG.CP.030.XX.XX.XX.XXXXXX.XXXX O-
               PENED.'
         B     AYSLOGE
AYSLERR  EQU   *
******** AAAAAA
         MVC   0(AD0019Q,R5),AD0019
         LA    R12,AD0019Q(R12)      LEN
         LA    R5,AD0019Q(R5)        DIST
******** AAAAAA
         CMD   'TYPE',' %  ZCP0019 ERROR ON ''SYSFILE SYSOUT'' COMMAND'
AYSLOGE  EQU   *
         L     R8,=V(SYSLOGD)        AUS CPCOPY
         MVC   0(20,R8),AYSLOGD    NACH CPCOPY SCHREIBEN
*
         B     ADMRET          RUECKSPRUNG U. AUSGABE
         DS    0F
LOGDAT   DS    CL12
LOGTIM   DS    CL8
AYSLOGD  DC    C'XX.XX.XX.XXXXXX.XXXX'
*
*****************
AD0017   DS    0H
         DC    C'% ZCP0017 SYSLOG.CP.030.'
AD0017F  DC    C'XX.XX.XX.XXXXXX.XXXX'
         DC    C' CLOSED.'
         DC    X'2798'
AD0017E  EQU   *
*****************
AD0018   DS    0H
         DC    C'% ZCP0018 SYSLOG.CP.030.'
AD0018F  DC    C'XX.XX.XX.XXXXXX.XXXX'
         DC    C' OPENED.'
         DC    X'2798'
AD0018E  EQU   *
*****************
AD0019   DS    0H
         DC    C'% ZCP0019 ERROR ON ''SYSFILE SYSOUT'' COMMAND'
         DC    X'2798'
AD0019E  EQU   *
*****************
         DS    0F
AD0017Q  EQU   AD0017E-AD0017
AD0018Q  EQU   AD0018E-AD0018
AD0019Q  EQU   AD0019E-AD0019
         DTMODE DSECT=NO
*
         LTORG
*---------------------------------------------------------------------*
*------------------  MESS   SENDEN MESSAGE  --------------------------*
*---------------------------------------------------------------------*
         DS    0F
ADMESS   EQU   *
         STM   R3,R4,ASAVR3R4    STATEIN/USEREIN  SICHERN
         GDATE TOD=ATRTIM
         MVC   AMESSTIM(8),ATRTIM
         MVC   AMESSTXT(69),=CL69' '
         LR    R13,R6
         XR    R14,R14
         LA    R4,69
         CLC   5(2,R13),=CL2'T='
         BE    ADMESS01
ADMESSLO EQU   *
         CLI   5(R13),X'00'
         BE    ADMESSLE
         LA    R14,1(R14)  LEN
         LA    R13,1(R13)
         BCT   R4,ADMESSLO
ADMESSLE EQU   *            LEN IN R14
         CH    R14,=H'1'      FALLS INPUT <1 GEHT MVC IN DIE HOSEN
         BNL   ADMESSL1
         LA    R14,1
ADMESSL1 BCTR  R14,0         -1
         EX    R14,MVCTXT       LAENGE EINTRAGEN
         L     R13,=V(STATANFA)
         L     R14,=V(STATENDA)
         L     R3,0(R13)
         L     R4,0(R14)
ADLOOPM  EQU   *
         A     R3,=A(X'100')
         CLI   STATPNA,X'00'
         BE    ANOFM
ADSENDM  EQU   *
         L     R13,STATRPBA
         LA    R5,AMESS
         LH    R12,AMESSL
         L     R7,STATCID
         LA    R2,STATEI
ADSENDM1 L     R14,STAIDCP
         YSEND RPB=(R13),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R12),    -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    ANOFM
         MVC   ERRTEXT,=CL20'ADM/MESS/YSEND'
         CLM   R15,B'1110',=X'10040C'
         BNE   ADSM1
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=5
         CLM   R15,B'0001',=X'00'
         BE    ADSENDM1
         MVC   ERRTEXT,=CL20'ADM/MESS/SOLSIG'
ADSM1    BAS   R13,AFEHLER
***
ANOFM    CR    R3,R4
         BNL   ADMESSQT      ENDE
         B     ADLOOPM
ADMESSQT EQU   *
         LM    R3,R4,ASAVR3R4
         LA    R5,AMESSQ
         XR    R12,R12
         LA    R12,AMESSQL(R12)
         BAS   R13,ADMSEND
*
         L     R14,SAV14
         LM    R8,R12,SAVTAB
         BR    R14
*--------  MESS SENDEN AN SPEZ. TERMINAL --------
ADMESS01 EQU   *
         LA    R4,8         8 BYTE TERMNAM
ADMESS03 CLI   7(R13),C','
         BE    ADMESS10
         LA    R14,1(R14)   LEN
         LA    R13,1(R13)   POINTER
         BCT   R4,ADMESS03
ADMESS10 EQU   *
         ST    R14,AMTNAML    LEN TERMNAM
         MVC   AMTNAM(8),=CL8' '
         CH    R14,=H'1'      FALLS INPUT <1 GEHT MVC IN DIE HOSEN
         BNL   ADMESS09
         LA    R14,1
ADMESS09 BCTR  R14,0
         EX    R14,MVCTNAM
         LA    R13,3(R13)     +1 KOMMA, +2 T=
         LA    R4,69
         XR    R14,R14
         ST    R13,AMR13SAV
ADMESS11 EQU   *
         CLI   5(R13),X'00'
         BE    ADMESS14
         LA    R14,1(R14)  LEN
         LA    R13,1(R13)
         BCT   R4,ADMESS11
ADMESS14 EQU   *            LEN IN R14
         L     R6,AMR13SAV
         CH    R14,=H'1'      FALLS INPUT <1 GEHT MVC IN DIE HOSEN
         BNL   ADMESS15
         LA    R14,1
ADMESS15 BCTR  R14,0         -1
         EX    R14,MVCTXT       LAENGE EINTRAGEN
         L     R13,=V(STATANFA)
         L     R14,=V(STATENDA)
         L     R3,0(R13)
         L     R4,0(R14)
ADLOOP10 EQU   *
         A     R3,=A(X'100')
         CLC   STATPNA(8),AMTNAM
         BE    ADSEND10
         CR    R3,R4
         BNL   ADMESSQQ    END
         B     ADLOOP10
ADSEND10 EQU   *
         L     R13,STATRPBA
         LA    R5,AMESS
         LH    R12,AMESSL
         L     R7,STATCID
         LA    R2,STATEI
         L     R14,STAIDCP
         YSEND RPB=(R13),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R12),    -
               EID=(R2)
         B     ADMESSQT      ENDE
ADMESSQQ EQU   *
         LM    R3,R4,ASAVR3R4
         LA    R5,AMESSQQ
         XR    R12,R12
         LA    R12,AMESSQQL(R12)
         BAS   R13,ADMSEND
*
         L     R14,SAV14
         LM    R8,R12,SAVTAB
         BR    R14
*------------------------------------------------
         DS    0H
MVCTXT   MVC   AMESSTXT(0),5(R6)
MVCTNAM  MVC   AMTNAM(0),7(R6)
**
AMR13SAV DS    F
ASAVR3R4 DS   2F
AMTNAM   DS   CL8
AMTNAML  DS    F
ATRTIM   DS    CL8
AMESS    DS    0H
*        DC    X'2740817CD7'
         DC    X'10401B20614840000040404100000021'
*        DC    X'46401B20614050'
*        DC    X'1B20614840000000404100000021'  PAR00D   SYS-ZEILE
         DC    X'2740817CD7'
         DC    X'1D7C'         HELL
AMESSTIM DC    C'        '  TIME
         DC    C'  '
AMESSTXT DC    CL69' '
         DC    X'1DC8'
         DC    X'19'
*        DC    X'278227821ED81DC8'
*        DC    X'1ED81DC8'
AMESSE   EQU   *
AMESSL   DC    Y(AMESSE-AMESS)
         DS    0F
*****************
AMESSQ   DS    0H
         DC    X'10401B2061404045625400400000412127822784' LSP
         DC    X'2798'
         DC    C'% ZCP0050 MESSAGE COMMAND SUCCESSFULLY TERMINATED.'
         DC    X'2798'
         DC    CL4'CMD:'
         DC    X'27841ED7'
AMESSQL  EQU   *-AMESSQ     LEN
AMESSQQ  DS    0H
         DC    X'10401B2061404045625400400000412127822784' LSP
         DC    X'2798'
         DC    C'% ZCP0050 SPECIFIED TERMINAL NOT FOUND. COMMAND '
         DC    C'TERMINATED.'
         DC    X'2798'
         DC    CL4'CMD:'
         DC    X'27841ED7'
AMESSQQL EQU   *-AMESSQQ    LEN
*----------------------------------------------------------------------*
***      INFO - VIRTUELLE TERMINALS 'V'                              ***
*----------------------------------------------------------------------*
AVTBEG   XR    R14,R14
         ST    R3,AIR3SAV            SICHERN WEGEN YSEND(AKT TRERM)
         LA    R4,8       8BYTE LEN
         LR    R13,R6     INPUT
         MVC   AINFNAM(8),=CL8' '  LOESCH
AVT001   EQU   *
         CLI   6(R13),X'00'    SH-VT XXXXXXXX
         BE    AVT010
         LA    R14,1(R14)  LEN
         LA    R13,1(R13)  VTERMNAME
         BCT   R4,AVT001
AVT010   EQU   *
         LTR   R14,R14     INPUT 0 ???
         BZ    ACINOF3
         BCTR  R14,0    -1
         EX    R14,MVCVTT         R6 IST JETZT FREI
         L     R15,=V(STATANFA)
         L     R3,0(R15)
         L     R15,=V(STATENDA)
         L     R4,0(R15)
         L     R15,=V(USPGTBA)    USER-PAGE-TABLE
         L     R6,0(R15)          USPGTAB IN R6
         L     R7,=A(X'00001F40')    8000 EINTRAEGE A 9 BYTE
AVT011   EQU   *
         XC    0(1,R6),=X'00'
         BNZ   ACI2
         LA    R6,9(R6)
         BCT   R7,AVT011
ACINOF1  EQU   *
         B     ACINOF2
ACI2     ICM   R4,B'1111',1(R6)
         CLC   AINFNAM,USCPNAME
         BE    ACI3
         LA    R6,9(R6)
         BCT   R7,AVT011
ACINOF2  EQU   *
*        CH    R5,=H'30'       IF > 30 THEN IS WAS DRIN
*        BH    ADMRET
ACINOF3  MVC   AD0061F(8),AINFNAM
         MVC   0(AD0061L,R5),AD0061
         LA    R12,AD0061L(R12)
         LA    R5,AD0061L(R5)
         L     R3,AIR3SAV    RICHTIGES TERM WIEDER ZUWEISEN
         B     ADMRET        UND JETZT WIRD AUSGEGEBEN
*
ACI3     EQU   *
         ICM   R4,B'1111',1(R6)
         PRINT GEN,BASE
         CNOP  0,4
         MVC   AD00601F(8),USCPNAME
         MVC   AD00602F(8),USPNA
         MVC   AD00603F(8),USPRO
         MVC   AD00604F(8),USTATPNA
         MVC   AD00605F(8),USTATPRO
         MVC   AD00606F(4),USTYP                                59
         MVC   AD00607F(8),USTATVT
         MVC   0(AD0060L,R5),AD0060
         LA    R12,AD0060L(R12)
         LA    R5,AD0060L(R5)
         L     R3,AIR3SAV    RICHTIGES TERM WIEDER ZUWEISEN
         B     ADMRET        UND JETZT WIRD AUSGEGEBEN
*----------------------------------------------------------------------*
AIR3SAV  DS    F
AD0061   DS    0H
         DC    C'% ZCP0061 ELEMENT '
AD0061F  DS    CL8                  ELEM NAM
         DC    C' NOT FOUND.'
         DC    X'2798'
AD0061L  EQU   *-AD0061
AD0060   DS    0H
         DC    C'% ZCP0060 VT '''
AD00601F DS    CL8       VT-NAM
         DC    C''' CONNECTED WITH APPL='
AD00602F DS    CL8       APPL-NAM
         DC    C'/'
AD00603F DS    CL8       PROC-NAM DER APPL
         DC    C'; TERM='
AD00604F DS    CL8
         DC    C','
         DC    X'2798'   LZE
         DC    C'          PROC='
AD00605F DS    CL8
         DC    C'; VT:'
AD00607F DS    CL8
         DC    C', TYPE='
AD00606F DS    CL4
         DC    C'.'
         DC    X'2798'    LZE
AD0060L  EQU   *-AD0060
*
         DS    0F
MVCVTT   MVC   AINFNAM(0),6(R6)
AINFNAM  DS    CL8     ZWISCHENSPEICHER
         DS    0F
*----------------------------------------------------------------------*
***      INFO - REELLE    TERMINALS 'R'                              ***
*----------------------------------------------------------------------*
ARTBEG   XR    R14,R14
         ST    R3,AIR3SAV            SICHERN WEGEN YSEND(AKT TRERM)
         LA    R4,8       8BYTE LEN
         LR    R13,R6     INPUT
         MVC   AINFNAM(8),=CL8' '  LOESCH
ART001   EQU   *
         CLI   6(R13),X'00'    SH-RT XXXXXXXX
         BE    ART010
         LA    R14,1(R14)  LEN
         LA    R13,1(R13)  VTERMNAME
         BCT   R4,ART001
ART010   EQU   *
         LTR   R14,R14   EINGABE 0 ??
         BZ    ARINOF3   JA
         BCTR  R14,0    -1
         EX    R14,MVCVTT         R6 IST JETZT FREI
         L     R15,=V(STATANFA)
         L     R3,0(R15)
         L     R15,=V(STATENDA)
         L     R4,0(R15)
         L     R15,=V(USPGTBA)    USER-PAGE-TABLE
         L     R6,0(R15)          USPGTAB IN R6
         L     R7,=A(X'00001F40')    8000 EINTRAEGE A 9 BYTE
ART011   EQU   *
         XC    0(1,R6),=X'00'
         BNZ   ARI2
         LA    R6,9(R6)
         BCT   R7,ART011
ARINOF1  EQU   *
         B     ARINOF2
ARI2     ICM   R4,B'1111',1(R6)
         CLC   AINFNAM(4),=C'*ALL'
         BE    ARI3
         EX    R14,ARI2CLC    CLC LEN-MODIFY WEGEN TEILQALIFIZIERT
         BE    ARI3
         LA    R6,9(R6)
         BCT   R7,ART011
ARINOF2  EQU   *
         CH    R12,=H'30'       IF > 30 THEN IS WAS DRIN
         BH    ARTIE
ARINOF3  MVC   AD0061F(8),AINFNAM
         MVC   0(AD0061L,R5),AD0061
         LA    R12,AD0061L(R12)
         LA    R5,AD0061L(R5)
         L     R3,AIR3SAV    RICHTIGES TERM WIEDER ZUWEISEN
         B     ADMRET        UND JETZT WIRD AUSGEGEBEN
*
ARI3     EQU   *
         ICM   R4,B'1111',1(R6)
         LA    R6,9(R6)
         CNOP  0,4
         MVC   AD00621F(8),USTATPNA
         MVC   AD00622F(8),USTATPRO
         MVC   AD00623F(8),USCPNAME
         MVC   AD00624F(8),USPNA
         MVC   AD00625F(8),USTATVT
         MVC   0(AD0062L,R5),AD0062
         LA    R12,AD0062L(R12)
         LA    R5,AD0062L(R5)
         BCT   R7,ART011
ARTIE    L     R3,AIR3SAV    RICHTIGES TERM WIEDER ZUWEISEN
         B     ADMRET        UND JETZT WIRD AUSGEGEBEN
*----------------------------------------------------------------------*
ARI2CLC  CLC   AINFNAM(0),USTATPNA
AD0062   DS    0H
         DC    C'% ZCP0062 '''
AD00621F DS    CL8       RT-NAM
         DC    C'/'
AD00622F DS    CL8       RT-PROC
         DC    C''' VTERM='
AD00623F DS    CL8       VT-NAM
         DC    C'; APPL='
AD00624F DS    CL8       APPL
         DC    C';'
         DC    C' VT:'
AD00625F DS    CL8
         DC    C'.'
         DC    X'2798'   LZE
AD0062L  EQU   *-AD0062
*
*----------------------------------------------------------------------*
         LTORG
*---------------------------------------------------------------------*
*        D S E C T ' S
*---------------------------------------------------------------------*
         STATEIN
         EJECT
         USEREIN
*---------------------------------------------------------------------*
         END