Cpadmin
<syntaxhighlight lang="asm">
- *
- 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