Mcp002

Aus SiWiki
Wechseln zu: Navigation, Suche
MCP002   START 0,PAGE,RESIDENT
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS-ALBIS AG  1988                             *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
*/
* RELM AUF ADDR0 USEBERPRUEFEN.
** V3.0AK4
* FALLE FUER ADDR0-FEHLER ->> SIEHE DSECT STATEIN.
** V3.0AK3 
* AENDERUNG IM MODUL HCPRCO
* ABFRAGE ALLTERM=YES UND VERZWEIGEN IN LEERES CP-MENU
** V3.0AK2
* NEUE VERSION 3.0
* ANMELDEN OHNE MSG
* DATEINAMENSAENDERUNGEN NACH BS2000 KONVENTION 500.22
* LAENGE DER SEQ-DATEI VON 25 AUF 54 
* DYNAMISCHER DUMP ENTFERNT
** V3.0A00
* BEI LANVERBINDUNGEN WURDE KEINE EVENT-ID MEHR BEKOMMEN, WEIL DER NAME 
* DER EREIGNISKENNUNG DER STATIONSNAME WAR UND DIESER MIT $$$. BEGINNT.
* DAS FUEHRTE BEIM WAIT-FOR-GO SOLSIG ZUM ABSTURZ DES CP ?#$?!!.
* JETZT WIRD HALT EIN NAME GENERIERT MIT PRAEFIX 'EI' UND EINER         
* 6-STELLIGEN FORTLAUFENDEN NUMMER (MAX. 1*10^6-1 EVENT-ID'S).
** V2.1C13
* SAW IN 'HCINIT' MODIFIZIERT. S. DORT.
** V2.1C12
* LOGGING-ERWEITERUNG 
** V2.1C11
* PATCH ENTFERNT, LOESCHEN USIN,USEI,USCO,USAID IN YOPNCON BEI TIMEOUT
** V2.1C10
* CHANGE-REQUEST 'BULLETIN'-FUNKTION. NACH PASSWORTEINGABE WIRD
* EIN BULLETIN AUS DER DATEI 'CP.BULLETIN' AUSGEGEBEN.              
* BEI DD33 WERDEN DIREKT DIE PAC'S AUSGEGEBEN.
* EINLESEN UND AUSGEBEN BULLETIN IN CPBLTIN.
** V2.1C02                                            
* (VERGLEICH OB ASY REC MEHRFACH AUFGEZOGEN WIRD. (CRECCNT))
* (TEMPORAERE KORREKTUR )
* (TEMPORAERE KORR B51, RELM AUF ADR 0 ENTFERNT)
** (V2.1B52)
* KORREKTUR BEG0042X BEI AUSWERTUNG PTAST-PARAM. BEI NEUEN 975X
* TERMINALS WIRD ESC-SP-N AUFS TERMINAL GEGEBEN UND VERSCHIEBT DEN
* BILDSCHIRM.
** V2.1B50
* CSTAT-MAKROS AUSGELAGERT IN MODUL CPCSTAT.
** V2.1B40
* BIBLIOTHEK(ELEMENT) FUER LIB-PARAMETER WEGEN V10, 4STELLIGE CAT-ID
* AUF 55 STELLEN ERWEITERT. BIBLIOTHEK(ELEMENT) OHNE USER-ID DARF NICHT
* LAENGER ALS 39 ZEICHEN SEIN. BIBLIOTHEK MAX.45, ELEMENT MAX.25 BYTE.
** V2.1B30
* UNTERSCHEIDEN ZWISCHEN SAW=4F UND SAW=50 BEI CATS FUER H120-SVP BEI
* ASCII - EBCDIC UMSETZUNG.
** V2.1B20
* KORREKTUR FUER SAP ANWENDUNGEN DIE 8-K NACHRICHTEN UMHERSCHICKEN:
* USIN NEU 8704B; USTERMS NEU 8704B; USTEXTA NEU 18944B; REST NEU 494B.
* DIE NEUEN LAENGEN WERDEN AUCH DEMENTSPRECHEND AN CPBUFH GELEITET.
* DA JETZT 9 SEITEN ANGEFORDERT WERDEN MUSS AUCH DAS DUMMY MODUL AUF
* 9 SEITEN ERHOEHT WERDEN.
** V2.1B10
* EINBRINGEN NEUER TYP 'PDN' FUER CATS. ES WIRD EINE NACHRICHTENKOPF
* UMSETZUNG GEMACHT UND FELDER FUER MULTIKOS-SIMULATION EINGEFUEGT
* WUERG AECHZ !! SIEHE AUCH -> CPBUFH MODUL.
** V2.1B00
* DA SICH DAS CP AB UND ZU, SINNLOSERWEISE, SELBER FREIGIBT, RELM AUF
* PAGE 0, WERDEN AM ANFANG HALT 6 SEITEN NULLEN EINGEFUEGT.
** V2.0A05
*-BEI CODIERUNG DER PTASTEN KANN JETZT N(GROSS) ANGEGEBEN WERDEN FUER
* KEINE AKTION, D.H DIESE TASTE WIRD NICHT GELADEN.
*-MENU MASKE KORRIGIERT ( MODUL CPKMASK).
** V2.0A04 (PILOT)
* KORREKTUR IN CPKMASK, SIHE DORT..
** V2.0A03
* SIEHE MODUL CPKMASKE (REGISTER UEBERSCHREIBER)
** V2.0A02 (PILOT)
*-LINELEN FUER HARDCOPY KANN UBER CPAUSER ODER TERMINALDATEI EINGE-
* STELLT WERDEN (STATHCTY).
*-KORR. FALSCHER RUECKSPRUNG VON STXIT-ROUTINE(REGISTER FALSCH VERS.).
** V2.0A01 (PILOT)
*-HARDCOPY-FUNKTION REAL. BEI 'K9'=ESC-? WIRD DER BILDSCHIRM MIT
* PAR00L GELESEN (MODUL = HCINIT) UND EINE CONTI FUER MODUL 'HCPRCO'
* ANGEKICKT. DOERT WIRD IN IDLE-ZEIT (PRIO 8) DER HARDCOPY AUFBEREITET
* D.H. STEUERZEICHEN ANALYSIERT UND ELIMINIERT. DRUCK OHNE VORSCHUB-
* STEUERZ. UEBER RSO.
*-MODUL CPAUSER NEU. HIER WIRD DYNAMISCH DEVICE-NAME GES HC GEAENDERT.
* EINGABE IN CP-MASKE /HC XXXXXXXX.
*-AUT. LOCK BETR. CHANGE-REQUEST ETAT DU VALAIS. JEDE MINUTE WIRD
* UEBER STXIT TIMER MODUL 'CPCLOCK' GESTARTET UND NACH 'LOCKTIME=XX'
* XX=MINUTEN DAS TERMINAL MIT STAPWSAV GELOCKT.
* A C H T U N G !!! BEI ANSPRUNG VON CPKMASK MUSS R15  I M M E R   MIT
* TERMOUTA VERSORGT SEIN.
** V2.0A00
*-ABLAUFFAEHIG IN BCAM V10/ BS2 V10.
*-FUER PAGING-ERROR GIBTS JETZT EINE STXIT --> MODUL STXERR.
*-ADMIN-SS AM TERMINAL WIRD EINGEFUEHRT -> MODUL 'CPADMIN'. AM
* ADMINISTRATORTRERMINAL KOENNEN MIT '//KDO' KOMMANDOS EINGEGEBEN
* WERDEN. DIE /INTR -SS WIRD SPAETER ABGELOEST.
** V1.4A00
* IN CPBUFH WIRD DER LEVEL NUN NICHT MEHR AUF 5 GESENKT SONDRN
* ES WIRD GEWARTET BIS GO-SIGNAL  KOMMMT.
** V1.3D61
* NEUER START-PARAMETER 'SEQ=' FUER DIE ORIGINAL SEQ-DATEI DAMIT
* DAS CP MEHFACH GELADEN WERDEN KANN. DER DATEINAME(25 CHAR.) WIRD
* VOM MODUL CPCOPY UEBER V(KONST) GELESEN.
* WEITER WIRD IN CPBUFH BEI STATSTOP=FF PAGE ABGEFRAGT ->> CPBUFH
** V1.3D60    >>>>> ACHTUNG LADBAR NUR AB BS2 V8.0  <<<<
* WENN NUR DER STRING 'LOCK' EINGEGEBEN WIRD DAS PASSWORT AUS DER LIB
* GEHOLT.
** V1.3D52
* UP KMASKE AUSGELAGERT ALS MODUL CPKMASK.
** V1.3D51
* DIAGNOSE TABELLE 'DIAG-TAB' TRACED DIV. REG.INHALTE MIT. TRACEPUNKTE
* '** DIAG-TAB'. CXXX=CONTI-REGISTER/ UXXX=UP-AUFRUFE/ EEEE=ENDE
** V1.3D50
* DA DER TYPIO IN MOD. CPINF NACH CA. 10 WIEDERHOLNGEN IN PASS GEHT
* UND SO DAS CP WEGEN PRIO 127 (STXIT) STEHT WIRD IN STXIT ROUTIENE
* EINE CONTI MIT GLEICHER PRIO WIE ALLE ANGEKIKT. IN MOD. CPINF WIRD
* DANN VOR TYPIO DER LEVEL VON 10 AUF 5 GESENKT, DAMIT DIE RECEIVE
* CONTI ANLAUFEN KANN. CONTI=INFCO.
** V1.3D40
* KORREKTUR IN MOD. CPINF (CMD -> TYPIO)
** V1.3D30
* KORREKTUR IN CPBUFH. CPBUFH-ERROR MIT DUMP.
** V1.3D20
* ANPASSUNGEN AN 31-BIT ADRESSIERUNGSMODUS (ALLE MODULE)
** V1.3D10
* PAR00E BEI SEQ-ABARBEITUNG GEAENDERT.SAW00->SAW40. WEGEN SIS USW.
* NEU: INFO-MODUL FUER ABFRAGEN /INTR..,SH-VT CP0000XX;/INTR..,SH-RT
* H15025B0; /INTR..,SH-AP APPLIKATION
* (MOD: CPINF)
** V1.3C00
* NEU: CP NACHRICHTENTRACE. 4 TRACE-PUNKTE.EINSCHALTEN MIT
* /INTR ..,TRC.ON  AUS MIT /INTR ..,TRC.OFF . LISTE: CP.TRACELISTE
* NEU: CP.SYSOUT. WIRD NUN IM PROGRAMM ZUGWIESEN. DURCH /INTR CH-LOG
* WIRD EINE NEUE LOG-DATEI EROEFFNET(MOD: CPSYSFL)
* AEND: /INTR CHANGE --> /INTR CH-SEQ.
** V1.3B00
* WEGEN VERSPAETET EINTREFFENDEN NACHRICHTEN NACH YCLOSE/RELM (CP-DUMP)
* ABFRAGEERWEIT. UEBER VERBINDUNGSZUST. ANFANG CONTIES YRECASY + TERMA
** V1.3A11
* NEUER PARAMETER PTAST. P-TASTEN VARIABEL VON P7-P20
** V1.3A10
* DA DURCH EINIGE FORMATE DIE SYSTEMZEILE DUNKELGEST. WIRD MUSS
* 1D7C (HELL) EINGEFUEGT WERDEN.
** V1.3A01
* AEND: CONTXT MAKRO WEGEN DUMP BEI SHUTDOWN AUS ENDE-CONTI ENTFERNT.
* NEU: DER AKTUELLE PAC WIRD JETZT IN DIE SYSTEMZEILE GESCHRIEBEN
* (NACHBILDUNG ANZEIGEZEILE (LTG/TAST)).
* PAR00D MIT AZL=41 IN KMASKANS, PAR00D MIT AZL=40 (RESET)
* IN KMASKANF EIGEFUEGT.
*** V1.3A00
* AENDERUNG IN CPBUFH WEGEN K3 UND KDCLAST
** V1.2D03
* AENDERUNG DER NEABT HANDLING
* NEU:
* ES WERDEN NUR DIE SSH 00 01 (K2 BEI TIAM) 11 13 15 17
* AN DIE PARTNER GESCHICKT, ALLES ANDERE WIRD AUF 41
*                                        ASYN EINGABENACHRICHT GEANDERT
*** V1.2D02
* EINFUEHEREN DES PAR ALLTERM FUER UIT
* WENN ALLTERM = N DUERFEN NUR TERMNIAL MIT TS
* MIT CP ARBEITEN
**
* NEABT PROTOKOLL WIRD AUCH NACH YSEND AUF PARTNER BEI START
* SEQUENC AUF 36 GESETZT UM BEI EINER TERMINALL EINGABE
* ASYN EINGABENACHRICHT ZU ERREICHEN
** V1.2D01
* TERMINAL STARTDATEI WERDEN NEU UEBER SYSDTA GELESEN 
* STARTPARAMETER LAN/PRE/VT/LIB (ANGABE EINER PLAM BIB)
* FUER TERMINAL STARTDATEIEN WERDEN VON SYSDTA GELESEN
** V1.2D00
* OPNMES UND LMSG WERDEN AUF WORDGRENZE AUSGERICHTET
** V1.2C11
* FEHLER:BEI PROGRAMM DIE STICKT FUER ESCBRKP DEFINIERT HABEN,
* LAEUF STICK NUR EINMAL AB.
* LOESUNG:NACH YSEND AUF PARTNER WIRD NEABT PROTOKOLL AUF '36'
* GEAENDERT UM NAECHSTE TERMINALEINGABE ALS
* ASYN. NACHRICHT AN PARTNER WEITERZUREICHEN
** V1.2C10 
* WENN PARTNERTYP EINE APPL GIBS STAT REJLOG EIN YMOD
** V1.2C09 
* HELPTEXT AUSGELAGERT IN CPHELP / CPHELPD
** V1.2C08
* CHANGE-REQUEST BETR. ENGLISCHE HELP-FUNKTION REALISIERT
** V1.2C07
** V1.2C06 (CPBUFH)
* BEI DCAM FEHLER WURDE CMD 'D %MR' ENTFERNT WEGEN SYSTEMDUMP
* DURCH UEBERLAUFEN CL-5 SPEICHER (SYSLST)
* 1.2C05
* IN LOGCP WIRD PARTNERTYPE ABGEFRAGT BEI APPL
* GIBT ES REJLOG 
* MVC MIT CONSTANTET VERKUERZT UM PLATZ ZU SPAREN
** 1.2V04
* AUF VIELFACHEN WUNSCH WIRD DAS "ENDCP" KOMMANDO EINGEFUEHRT    
** 1.2V03
* DA LA TASTEN NUR BEI EDITIN/EDITOUT=LINE VOM SYSTEM GELADEN 
* WERDEN, ERFOLGT ZUERST VOM TERMINAL DER VERBINDUNGSAUFBAU 
* MIT EDIT = LINE / NACHER GIBTS YSEND MIT EDIT LINE
* UND DANN ENDLICH  GIBTS YCHANGE AUF EDITIN/OUT=PHYS
** 1.2C02
* PAG ANGABEN (WAR-ZEICHEN IN 1.2C00 OFFENSICHTLICH IMMER NOCH
* FALSCH) GEAENDERT (KMASNANF / U . A)
* DIREKT NACH VERBINDUNGSAUFBAU WIRD AUCH EIN PAR01L
* ZUSAETZLICH MITGESCHICKT UM LA/P - TASTEN FREI ZU GEBEN
** 1.2C01
* EINFUEHRUNG DES VIRTUELLEN TERMINAL
* AUFRUF VON CP --> O CP01,MSG=C'VT:(MAX 8 STELLEN)'
* CP VERSUCHT DIE STARTSEQUENZEN AUS DER DATEI 
* CP.V.T.(MAX 8 STELLEN) ZU LESEN
* SCHALTER VTERM WIRD EINGEFUEHRT
* WENN 'Y' SIND WIRD MSG OPERAND AUGEWERTET, SONST NICHT
** 1.2C00
* AENDERUNG IN CPBUFH
* IN ZUISAMMENHANG MIT NEWLV UND SOLSIG
** 1.2B03
* CP SENDET AB SOFORT EIN BLANK ALS VERBINDUNGSNACHRICHT        
* SEQEUNEZ ZUM PTASTEN LADEN WIRD IN DER ERSTEN MELDUNG MITGESCHICKT
* OUTPUT1
** 1.2B02
* TYPE NACH COPY CMD IN INTR ROUTINE VERLAENGERT
** 1.2B01
* INTR KOMMANDO CHANGE ZUM WECHSELN DER START-SEQUENCE AUFGENOMMEN
** 1.2B00
* GEN AENDERUNG: REIHENFOLGE MUSS IMMER FTZ/ASZ (1E/1D)
* WEGEN ALTEN GERAETEN SEIN 
** A42
* EINFUEHREN EINER ZENTRALEN VERSIONNUMMER
* CPVER
** A41
* NEUFBAU NUR MOEGLICH SOFERN PARTNER AUF RECEIVE
* STEHT, D.H. DIE ERSTEND VIER (!) ZEICHEN WERDEN AUF "SEND"
* ABGEPRUEFT
** A40
* IM ENACO BEI ASY YOPNCON FEHLTE DAS KOMMA,
* SO DASS LEVEL=1 EINGESTELLT WORDEN IST
* D.H. ASY YOPNCON KONNTE VON ALLEN UNTERBROCHEN WERDEN
** A39
* BEI UNKONTROLIIERTEN EINGABE VON DER TASTATUR, D.H
* O AAAAAAAAAAAAAAAAA WURDE DIE LEANEG DES GENERIERTEN MVC
* NICHT GEPRUEFT--> FUEHERTE UNTER ANDERM ZU UEBERSCHREIBSER
* BEIM HOSTNAME
*** A38
* EINFUEHEREN DER VARIABLE "CPNAME" --> ENTAHELT
* DEN PREFIX FUER DIE CP-TERMINALS (BEIM OPNCON CMD)
*** A37
* CP LOESCHT BEI EINER CP-AUSGABE DIE LA-TASTEN
* UMSTELLUNG AUF PAG , DADURCH VERGROESSERUNG VON "KMASKANF"
* UND "UCONFREE"
**
* NACH GROESSER AENDERUNG IN CPBUFH WIRD VERSION NUMMER GEAENDERT
***
* SEND AUF PARTNER NUR MOEGLICH SOFERN (USFREE UNGL 'D'/'F'/'O')
***
* SOFERN VOR EINEM ASY KEINE ORDENTLICH MELDUNG (USFREE ':'ODER 'Y')
* WIRD YRECASY VERWORFEN
***
* STATION TABLE FUER CIRKA 250 EINTRAGE
* PARTNER TABLE FUER GENAU 44  EINTRAEGE
***
* PID WIRD IN KMASKE NICHT MEHR GEBRACHT
* HELPTEXT STAT BLANK MIT LZE AUFGEFUELLT
**
* LIFTIME AUF 10 SEC HOCHGESETZT
****
* EINFUEHREN VON MEDLUNG ZCP0011
****
* SOFERN NUR DER STRING "LOCK " EINGEGEBEN WIRD
* DARF NICHT IN DIE LOCK ROUTINE VERZZWEIGT WERDEN
****
* SOFER DIE  MELDUNG CP IS LOCKED (ZCP0010)
* DARF AUCH BEIM LOSCON KEINE CPMASKE AUSGEGEBEN WERDEN
****
* PROBLEM BEI LANGSAM YOPNCON:
* - O KOMMANDO ABGESETZT
* - DUE GEDRUECKT
* - CPMASKE ERSCHEINT (DA NOCH KEINE VERBINDUNG BESTEHT)
* - OPNCON TRIFFT EIN (CONTI YOPNCON) UND WIRD AKTUELLER PARTNER
* - NECHSTE EINGABE WIRD ALS CPCMD INTERPRETIERT
* DA DAS FELD STATK IN DER CONTI NICHT GELOEACHT WURDE
***
* DCAM APPLIKATIONEN DIE NACH DEM YOPNCON ERF
* KEINE NACHRICHT SCHICKEN , BEKAMMEN DAS NEABT PROTOKOLL
* X'000000..' BEIM ERSTEN SEND GESCHICKT, DA DAS FELD USNEA
* MIT LOW-VALUE VORBELEGT WIRD. 
* LOESUNG: USNEA WIRD MIT MIN-NEABT PROT VORBELEGT (X'365035..)
* WEGEN SIDIAS UND UDS-DCAM
******
* EINFUEHRUNG VON CMD LOCK
******
* LINK IN ACB VON CP EINGEFUEHRT
******
* PROBLEM BEI WRTRD:
* - PROGRAM SCHAFT MIT WRTRD
* - WECHSEL AUF MASKE
* - WECHSEL AUF PROGRAM 
* - K3 WIRD VON CPBUFH GESCHICKT
* --> FOLGE BIS ZUR NAECHSTEN AUSGABE VOM PROGRAMM
*           IST KEINE EINGABE MOEGLICH (K2 ODER SO)
*           LOESUNG: NEUAFBAU VON CPBUFH WIRD NUR ANGESPRUNGEN
*                    WENN OPNCON IO, ODER PARTNER AUF YRECEIVE STEHT
******
* VERSIONSZUSAMMENFUEHRUNG 75 BIS 92
* TYPE'S WERDEN ENTFERNT
******
* EIN YSEND AN EINEN PARTNER WID NUR WEITERGELEITET
* WENN PARTER READY (USFREE = : ODER D) IST
******
* VERBINDUNGSNACHRICHT LAENGER
* FDBK ABFRGAE BEI YRECASY FALSCH
* TOVAL WURDE NICHT NEU AUFGEZOGEN
* O.K 88.09.02
******
* DECLARIERTE PARTNER WRDEN NICH GELOESCHT
* EINFUEHREN VON STATSTOP (WIRD DURCH CPBUFH (FF) GESETZT WENN R
* WARTEN AUF GO-SIGNAL RC:10040C 
******
* NACH HELPMASKE WIRD  NUR DER STRING "CMD:"
* AUSGEGEBEN
******
* SOFERN BEIM ASY YRECEIVE VOM TERMNIAL EIN FEHLER AUFTTRITT
* WIRD SOFORT AUF RETCO VERZWEIGT (AUSNAHME TOVAL ABGELAUFEN)
******
*
* WENN NULLNACHRICHT VBON TERMINAL EMPFANGEN WIRD (D.H. 
* USERFIELD = ZERO) WIRD EINE ENTSPRECHENDE MELDUNG
* AUSGEGEBEN
******
* FEHLER CODE WIRD WIEDER MIT WROUT AUSGEGEBEN
* (AUCH TOVAL ABGELAUFEN) 
* 29.08.88 O.K.
******
* EINFUEGEN VON #     !!! NICHT VOLSTAENDIG REALISIERT !!!
* FUER EDIT=USER BEIM VERBINDUNGSAUFBAU
*****   
* AENDERN VON EDIT=SYSTEM AUF EDIT=USER FUER $CONSOLE
* 25.08.88 O.K.
* STATAKTP WIRD ERST NACH ! ERFOLGREICHEN YOPNCON VERSORGT
* (FUEHRTE ZU DCAM RC 0C04)
******
* STATIONTAB WIRD GELOESCHT (190X00)
* USERTAB WIRD GELOESCHR (190X00)
* 23.08.88 O.K.
* WENN AN $CONSOLE EINE KTASTE GESCHIVKT WIRD STOPT
* MELDUNGSAUGABE UND NEW-LINE WIRD ANS TERMINAL GESCHIVKT
* MELDUNG ZCP0003/7/8
******
* EINFUEHREN CONT COMEND FUE  BCLOSE
* SYN YOPNCON WARTET 10 SEC
* BEI AUFBAUF VON OMNIS ZU CP HAENGT CP
******
*
* HELPMASKE WIRD AUCH MIT EID ABGESETZT
*
* CONTI YRECASY (ASY YREC VOM PARTNER $DIALOG)  LEVEL 10
*       BEI YSEND AUF TERMINAL LEVEL 5
* CONTI YOPNCON (ASY YOPNCON ERFOLGREICH) LEVEL 10
* CONTI LOSCO   (VERBINDUNGSABAU DURCH PARTNER /LOGOFF) LEVEL 10
* CONTI LOGCP   (VERBINDUNGSAUFBAU VOM TERMINAL ZUM CP) LEVEL 10
* CONTI LOSCP   (VERBINDUNGSABAU VOM TERMINAL ZUM CP) LEVEL 10
* CONTI TERMA   (ASY REC VON ALLEN TERMINALS) LEVEL 10
* CONTI ENDE    (COMMEND)
* CONTI INFCO   (FUER SH-.. AUSGABEN IN CPINF AUF CONSOLE) LEVEL 10
*               BEI TYPIO LEVEL 5
* CONTI STXERR  (STXIT ROUTINE FUER PAGING-ERROR (IW48)) LEVEL 127
*               LIFO-PRINZIP
* CONTI CPCLOCK (STXIT MODUL FUER REALZEITGEBER ALLE 2 MIN.) LEVEL 127
*               FIFO-PRINZIP
         PRINT NOGEN,BASE
*----------------------------------------------------------------------*
****     INIT REGISTERS                                             ****
*----------------------------------------------------------------------*
         SPACE
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
MCP002   AMODE ANY
MCP002   RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
         TITLE 'V O R L A U F '
ANF      BASR  R8,0
         BCTR  R8,0
         BCTR  R8,0
         USING ANF,R8,R9,R10,R11,R12
         LA    R1,4095
         LA    R9,1(R8,R1)
         LA    R10,1(R9,R1)
         LA    R11,1(R10,R1)
         LA    R12,1(R11,R1)
         USING STATEIN,R3
         USING USEREIN,R4
*--- 8  SEITEN RESIDENT -----*
         L     R15,CPCSTATA
         BASR  R14,R15
*------------------------------------- OPEN LOGGING DATEI
         L     R15,CPSYSFLA
         BASR  R14,R15
*--------------------------------------
         REQM  18                     | FUER USER-PAG-TAB
         CLM   R15,B'0001',=X'00'     |
         BE    REQUPGOK               |
         TERMD                        |
REQUPGOK EQU   *                      |
         MVC   0(12,R1),=CL12'USER-PAG-TAB'
         LA    R1,12(R1)              |
         ST    R1,USPGTBA             |
* ------ DIAGNOSE-TABELLE -------------------------------
         REQM  4                      | FUER DIAG-TAB
         CLM   R15,B'0001',=X'00'     |
         BE    REQDTBOK               |
         TERMD                        |
REQDTBOK EQU   *                      |
         MVC   0(16,R1),=CL16'DIAG-TAB-DIAG-T*'
         LA    R1,16(R1)              |
         ST    R1,UDIATBA             |
         ST    R1,DIATABA    LAUFEND  |
         A     R1,=A(X'2F00')     LAENGE 12032 BYTE (CA. 150 EINTR.)
         ST    R1,DIATABE    TAB ENDE
*-----------------------------------------------------
         L     R4,=V(STXERR)
         STXIT ERROR=((R4),127)
*-----------------------------------------------------
         B     BEG
FREE0    DC    C'REP BEREICH '
         DS    CL50
         DC    C'REP BEREICH ENDE'
         DS    0F
         DS    0F
         SPACE
         TITLE 'L O S C O  / ABBAU/LOGOFF'
LOSCO    EQU   *
         BASR  R15,0
         USING *,R15
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CLOS ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CLOS'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
**      **
         LR    R7,R6         LOSCON INFO
         LR    R6,R5         USERFIELD
         L     R3,STATANFA
         L     R4,STATENDA
LOSCOOP  EQU   *
*        A     R3,=A(X'100')
         LA    R3,256(R3)       + X'100'
         CLM   R6,B'0011',STATTID
         BE    LOSCOT
         CR    R3,R4
         BL    LOSCOOP
         RETCO
LOSCOT   EQU   *
         L     R4,USERPAGA
         L     R5,USERPAGE
LOSCOP   EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)      + X'100'
         CLM   R6,B'1100',USPID
         BE    LOSCPX
         CR    R4,R5
         BL    LOSCOP
         RETCO
LOSCPX   EQU   *
*******              AUSTRAG AUS USER-PAG-TAB
         BAS   R14,ERUSPGTB
******
         MVC   USERROR,=CL15'CONNECTION LOST'
         MVI   USFREE,C'F'
         ST    R7,USRC
         ST    R7,SAVRC
         L     R7,USAID
         YCLOSE AID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W167
         MVC   ERRTEXT,=CL20'A/YLOSCO/YCLOSE'
         BAS   R14,FEHLER
W167     EQU   *
         LA    R7,USEI
         DISEI EIID=(R7)
         LA    R7,USCO
         DISCO COID=(R7)
*        CLI   STATSTOP,X'FF'     WARTEN AUF GO-SIGNAL IN CPBUFH ??
*        BNE   LOSNGO
*        CLC   STASTPID(2),USPID  MIT DIESEM PID ???
*        BE    A00                DANN DARF NICHT FREIGEGEBEN WERDEN
*LOSNGO   EQU   *
         L     R6,USIN
* TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R6,12
         LTR   R6,R6
         BNZ   MCRELM1
         MVC   ERRTEXT,=CL20'A/LOSCON/RELM1/0'
         BAS   R14,FEHLER
         B     A00      
MCRELM1  EQU   *
         RELM  9,(R6)
         CLM   R15,B'0001',=X'00'
         BE    A00
         MVC   ERRTEXT,=CL20'A/LOSCON/RELM'
         BAS   R14,FEHLER
A00      EQU   *
         XC    USIN(4),USIN
         XC    USAID(4),USAID
         XC    USEI(4),USEI
         XC    USCO(4),USCO
         L     R15,TERMOUTA
         L     R14,=F'38'
         MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         LA    R15,38(R15)       + 38
         MVI   Z2,X'FF'
         MVI   Z3,X'FF'
         MVI   Z4,X'FF'
         MVI   Z5,X'FF'
         CLC   STATPW,=XL8'00'
         BE    P99
         CLC   STATPW,=CL8' '
         BE    P99
*        CLI   STATK,X'10'    KMASKE AUF SCHIRM??
*        BE    P99            JA
         RETCO
P99      CLI   SAVRC+3,X'00'       LOSCON EREIGNIS 00 ?? YDDFDB
         BNE   P99RET
         BAS   R13,KMASKE
P99RET   RETCO
SAVRC    DS    F
         SPACE
         TITLE 'L O G C P   / VERB AUFBAU VON TERMINAL ZU CP'
LOGCP    BASR  R15,0
         USING *,R15
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CLOG ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CLOG'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
**      **
         MVC   OPNMES(11),=CL80' '
         YGENCB BLK=RPB,OPTCD=(Q,ANY,SYN,NTACK),AAREA=OPNMES,          -
               AAREALN=11
         LR    R6,R1
         YGENCB BLK=CCB,PTNNAME=PNAMLOG,PRONAME=PROLOG,EDIT=SYSTEM,    -
               EDITIN=(LINE,LCASE),EDITOUT=LINE,PROC=SIGNAL,MAXLN=12288
         LR    R7,R1
         YINQUIRE RPB=(R6),AID=(R3),LID=(R4),CCB=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W8
         MVC   ERRTEXT,=CL20'A/YOPN/LOGIN'
         BAS   R14,FEHLER
W8       EQU   *
**V3        CLI   VTERM,C'Y'
**V3        BE    Q3
**V3        MVC   OPNMES(11),=CL80' '
Q3       XR    R0,R0
         YTESTCB BLK=CCB,BLKADDR=(R7),ERET=Q10,PTNTYPE=TERM
Q10      CL    R0,=F'0'
         BE    Q11
         YMODCB BLK=CCB,BLKADDR=(R7),EDIT=USER
         CLM   R15,B'1000',=X'00'
         BE    Q11
         MVC   ERRTEXT,=CL20'A/YOPN/YMODX/USER'
         BAS   R14,FEHLER
         RETCO
*        YREJLOG AID=(R3),RPB=(R6),AAREA=PNAMLOG,AREA=PROLOG
*        RETCO
Q11      L     R3,STATANFA
         L     R4,STATENDA
         XR    R5,R5
LOOP     EQU   *
         AH    R5,=H'1'
*        A     R3,=A(X'100')
         LA    R3,256(R3)             + X'100'
         CLI   STATPNA,X'00'
         BE    GOTONE
         CR    R3,R4
         BL    LOOP
STATF    MVC   OUTPUT,=CL26'ZCP0001 STATION TABLE FULL'
         B     LOGSENDB
GOTONE   REQM  3
         CLM   R15,B'0001',=X'00'
         BE    LOGREQ
         MVI   STATPNA,X'00'
         MVC   OUTPUT,=CL26'ZCP0002 REQM MEMORY ERROR'
         B     LOGSENDB
LOGREQ   ST    R1,USERPAGA
         A     R1,=A(X'2C00')
         ST    R1,USERPAGE
         YMODCB BLK=CCB,BLKADDR=(R7),USERFLD=(R5)
         CLM   R15,B'1000',=X'00'
         BE    W9
         MVC   ERRTEXT,=CL20'A/YOPN/YMOD0/USER'
         BAS   R14,FEHLER
W9       EQU   *
         YOPNCON RPB=(R6),CCB=(R7),AREALN=1,AREA=BL,TOVAL=30
         CLM   R15,B'1001',=X'0000'
         BE    W10    
         MVC   ERRTEXT,=CL20'A/YOPN/YOPN'
         BAS   R14,FEHLER
         MVI   STATPNA,X'00'
         L     R5,USERPAGA
         SRA   R5,12
         LTR   R5,R5
         BNZ   MCRELM2
         MVC   ERRTEXT,=CL20'A/RELM/RELM2/0'
         BAS   R14,FEHLER
         B     MCRELM2N
MCRELM2  EQU   *
         RELM  3,(R5)
MCRELM2N EQU   *
         RETCO
W10      EQU   *
         LA    R2,STATEI
*** ENAEI NAME GENERIEREN
GENENAM  EQU   *
         L     R1,ENANUM
         LA    R1,1(R1) 
         ST    R1,ENANUM
         CVD   R1,DOWO1
         UNPK  RES1,DOWO1
         MVZ   RES1+8(1),=X'F0'
         MVC   EINAMOP(2),=C'EI'
         MVC   EINAMOP+2(6),RES1+3
***
         ENAEI EINAMAD=EINAMOP,EIIDRET=(R2)
Y01      YSEND RPB=(R6),CCB=(R7),AREALN=1,AREA=BL,EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    Y03
         MVC   ERRTEXT,=CL20'A/YOPN/1SEND'
         CLM   R15,B'1110',=X'10040C'
         BNE   Y02
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BE    Y01
         MVC   ERRTEXT,=CL20'A/YOPN/1SEND/SOL'
Y02      BAS   R14,FEHLER
Y03      EQU   *
         YMODCB BLK=CCB,BLKADDR=(R7),                                  -
               EDITIN=(PHYS,LCASE),EDITOUT=PHYS
         CLM   R15,B'1000',=X'00'
         BE    X1
         MVC   ERRTEXT,=CL20'A/YOPN/YMOD0/EDIT'
         BAS   R14,FEHLER
X1       EQU   *
         YCHANGE RPB=(R6),CCB=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    X2
         MVC   ERRTEXT,=CL20'A/YOPN/YCHANGE'
         BAS   R14,FEHLER
X2       EQU   *
         L     R15,TERMOUTA
         MVC   0(46,R15),KMASKAN1
*        A     R15,=F'46'                F'32'
         LA    R15,46(R15)       + 46
         MVC   0(80,R15),OUTPUT11
         YSHOWCB BLK=RPB,BLKADDR=(R6),WAREA=CIDLOG,LENGTH=4,           -
               FIELDS=(CID)
         CLM   R15,B'1001',=X'0000'
         BE    W11
         MVC   ERRTEXT,=CL20'A/YOPN/YSHO/CID'
         BAS   R14,FEHLER
W11      EQU   *
** OPNMES TRANSLATEN FALLS ALTE FORM
         TR    OPNMES(11),TRANST
** STATIONSTABBEL VERSORGEN
         MVC   STAIDCP,AIDCP
         MVC   STATPNA,PNAMLOG
         MVC   STATPRO,PROLOG
         MVC   STATCID,CIDLOG
         YGENCB BLK=RPB,OPTCD=(Q,ANY,SYN,NTACK)
         ST    R1,STATRPB1
         ST    R6,STATRPBA
         ST    R7,STATCCBA
         STH   R5,STATTID
         MVI   STATK,X'10'
         MVI   STATZZ,X'00'
         MVC   STATAKTP,=H'0'
         MVC   TERMTYP,=F'0'
         MVC   STATSTOP,=F'0'
         MVC   STATPW,=XL8'00'
         MVI   STATFREE,X'00'
         MVI   STATADM,X'00'
         MVC   Z1(80),=CL80' '
         MVC   Z1(20),=CL20'ZCP0004 TERMINAL: '
         MVC   Z1+20(8),PNAMLOG
         MVI   Z1+28,C'/'
         MVC   Z1+29(8),PROLOG
         MVC   Z1+37(4),='TID:'
         CVD   R5,DOWO
         UNPK  RES,DOWO
         MVZ   RES+8(1),=X'F0'
         MVC   Z1+41(3),RES+6
         L     R4,USERPAGA
         L     R5,USERPAGE
         XR    R6,R6
         MVC   LD1FILE(25),=CL80' '
         MVC   LD1FILE(3),=C'CP.'
         MVC   LD1FILE+3(8),PROLOG
         LA    R14,LD1FILE
C000     AH    R14,=H'1'
         CLI   0(R14),C' '
         BNE   C000
         MVI   0(R14),C'.'
         MVC   1(8,R14),PNAMLOG
** TROZTDEM MSG ??
         CLC   OPNMES(3),=C'VT:'
         BNE   C001
** JA. DANN WIE BISHER
         MVC   LD1FILE(25),=CL25'CP.V.T.'
         MVC   LD1FILE+7(8),OPNMES+3
         MVC   STATVT(8),OPNMES+3
C001     EQU   *
         MVC   Z2(80),=CL80' '
         MVC   Z2(25),LD1FILE
* SOFER KEIN LIB PARAMETER WIRD NACH DER DATEI ALEINE GESUCHT
         CLI   LIB,C' '
         BE    Q0
         MVC   Z2(45),LIB         VON 30 AUF 45  V2.1B30
         LA    R14,Z2
C002     AH    R14,=H'1'
         CLI   0(R14),C' '
         BNE   C002
         MVI   0(R14),C'('
         MVC   1(25,R14),LD1FILE
         LA    R14,Z2
C0       AH    R14,=H'1'
         CLI   0(R14),C' '
         BNE   C0
         MVI   0(R14),C')'
         PRINT GEN,BASE
Q0       MVC   SYSF+47(55),Z2    LEN VON 40 AUF 55   V2.1B30
* VERSORGEN IN VORBELEGUNG
SYSF     SYSFL 'SYSDTA=123456789012345678901234567890123456789012345678-
               9012345'
         PRINT NOGEN,BASE
** MSG ODER PRONAM.STATNAM ???
         CLM   R15,B'0001',=X'00'
         BNE   C20
** JA
C1       MVC   LOPAC(20),=CL80' '
         RDATA LODAT,C10,80
*         GET   FCBLOG,LODAT
         CLC   LOPAC(12),=CL12'*CP01-PARAM:'
         BNE   P30DEV
         MVC   STATPW,LOTERM
         MVC   STATFREE,LOFREE
         MVC   STATADM,LOADM     ADMINSTR ?? Y/N
P30DEV   EQU   *
         CLC   LOPAC(12),=CL12'*CP01-HCDEV:'
         BNE   P30
         MVC   STATDEV(8),LOTERM     HC-DEVICE NAME
         MVC   STATFORM(8),=C'STD     '  FORMULAR NAME
         MVC   STATHCTY(1),LOTERM+16
         CLC   LOPAC+20(8),=CL8' '
         BE    P30
         MVC   STATFORM(8),LOTERM+8   FORMULAR NAME
P30      CLI   LOPAC,C'*'
         BE    C1
C2       EQU   *
         AH    R6,=H'1'
*        A     R4,=A(X'100')
         LA    R4,256(R4)         + X'100'
         CLI   USPID+1,X'00'
         BE    C3
         CR    R4,R5
         BL    C2     
         B     C10
C3       EQU   *
         CLC   LOTERM,=CL8' '
         BNE   C4
         L     R15,OPENUM
         LA    R15,1(R15)          + 1
         ST    R15,OPENUM
         CVD   R15,DOWO
         UNPK  RES,DOWO
         MVZ   RES+8(1),=X'F0'
         MVC   LOTERM(2),CPNAME
         MVC   LOTERM+2(6),RES+3
C4       EQU   *
         MVC   USCPNAME,LOTERM
         MVC   USPRO,LOPRO
         MVC   USAID,=F'0'
         MVC   USCID,=F'0'
         MVC   USREF,LOREF
         MVC   USPNA,LOPAR
         MVC   USTYP,LOTYP
         STH   R6,USPID
         MVI   USOKZ,X'00'
         MVC   USLEN,=F'0'
         MVC   USADR1,=F'0'
         MVC   USADR2,=F'0'
         MVC   USADR3,=F'0'
         MVC   USADR4,=F'0'
         MVC   USLOE1,LOMSG
         MVC   USLOE1SA,LOMSG
         MVC   USRC,=F'0'
         CVD   R6,DOWO
         UNPK  RES,DOWO
         MVZ   RES+8(1),=X'F0'
         MVC   USPAC,RES+5
         CLC   LOPAC,=CL4' '
         BE    C11
         MVC   USPAC,LOPAC
C11      MVC   USNEA,=XL8'3650350000000000'
         MVC   USERROR,=CL15'DECL SEQ:'
         MVC   USERROR+10(4),LOSEQ
         MVC   USSEQ,LOSEQ
         MVC   USSEQSA,LOSEQ
         MVC   USKEY1,=C'0000'
         MVI   USFREE,C'D'
         MVI   USDEC,C'D'
         MVC   USLOE2,LOPASS
         MVC   USLOE2SA,LOPASS
         XC    USLOE3(25),USLOE3
         MVC   USTEXTA,=F'0'
         MVC   USTEXTE,=F'0'
         MVC   USTERMS,=F'0'
         MVC   USIN,=F'0'
         MVC   USLEN,=F'0'
         MVC   USRES,=F'0'
         MVC   USCO,=F'0'
         MVC   USEI,=F'0'
         MVC   USRPBA,=F'0'
         MVC   USCCBA,=F'0'
         B     C1
*C10      CLOSE FCBLOG
C10      SYSFL 'SYSDTA=(PRIMARY)'
         MVC   Z1+44(16),=CL16'/START-SEQ PERF.'
         CLC   OPNMES(3),=C'VT:'
         BNE   Q1
         MVC   Z1+65(11),OPNMES
Q1       B     LOGSEND
C20      EQU   *
** BISHER KEIN TERM-ELEMENT GEFUNDEN. AUSGABE V3 MASKE
LOGINPRC EQU   *
         L     R15,TERMOUTA  * NICHT FUER LOGIN
         XR    R14,R14       * NICHT FUER LOGIN
         MVI   Z2,X'FF'      * NO TEXT
         MVI   Z3,X'00'      * KEIN CMD
         MVI   Z4,X'00'      * KEINE KMASK
         MVI   Z5,X'00'      * DUNKEL
         MVI   STATANM,X'FF' * LOGIN-MENU
         BAS   R13,KMASKE
*
         RETCO
*
**KEEP ---------------------------------------------------**KEEP
*        
**KEEPC20      MVC   Z1+44(16),=CL16'/NO START-SEQ'
**KEEP         CLI   ALLTERM,C'N'
**KEEP         BNE   LOGSEND
         L     R15,TERMOUTA
         L     R14,=F'126'
*        A     R15,=F'126'              F'112'
         LA    R15,126(R15)        + 126
         MVC   0(10,R15),=X'2798279827981ED81DC8'
*        A     R15,=F'10'
         LA    R15,10(R15)         + 10
*        A     R14,=F'10'
         LA    R14,10(R14)         + 10
         MVC   0(40,R15),=CL40'ZCP0041 REJECT: TERMINAL NOT DECLARED'
*        A     R15,=F'40'
         LA    R15,40(R15)         + 40
*        A     R14,=F'40'
         LA    R14,40(R14)         + 40
         MVI   Z2,X'FF'    * KEIN TEXT*
         MVI   Z3,X'00'    * KEIN CMD *
         MVI   Z4,X'00'    * KEINE KMASK *
         MVI   Z5,X'FF'    * NICHT DUNKEL
         BAS   R13,KMASKE
         L     R5,USERPAGA
         SRA   R5,12
         LTR   R5,R5
         BNZ   MCRELM3
         MVC   ERRTEXT,=CL20'A/RELM/RELM3/0'
         BAS   R14,FEHLER
         B     MCRELM3N
MCRELM3  EQU   *
         RELM  3,(R5)
MCRELM3N PASS
         L     R6,STATRPBA
         YCLSCON RPB=(R6)
         XC    STATPNA(250),STATPNA
         RETCO
*------------------------------------ **KEEP BIS HIER
LOGSEND  EQU   *
*        TYPIO MSG=ZCP8MSG
         L     R15,TERMOUTA
         L     R14,=F'206'          F'192'
*        A     R15,=F'126'          F'112'
         LA    R15,126(R15)       + 126
         MVC   0(80,R15),Z1
*        A     R15,=F'80'
         LA    R15,80(R15)      + 80
* P-TASTEN WERDEN GELADEN
         MVC   0(27,R15),OUTPUT1
*        A     R15,=F'27'
         LA    R15,27(R15)
*        A     R14,=F'27'
         LA    R14,27(R14)
         MVI   Z2,X'FF'
         MVI   Z3,X'FF'
         MVI   Z4,X'FF'
         MVI   Z5,X'FF'
         CLC   STATPW,=XL8'00'
         BE    P6
         CLC   STATPW,=CL8' '
         BE    P6
         LA    R1,STATPW
         LA    R2,STATPW+8
P10      CLI   0(R1),C' '
         BE    P11
         AH    R1,=H'1'
         CR    R1,R2
         BL    P10
         B     P12
P11      MVI   0(R1),X'00'
         B     P10
P12      EQU   *
*12      MVC   Z2(4),=X'1ED81DC2'
*        MVC   Z2+4(76),=CL76'ZCP0010 CP IS LOCKED. ENTER PW TO UNLOCK'
*        MVC   Z2+45(4),=X'1ED71DC4'
         MVI   Z3,X'00'    * KEIN CMD *
         MVI   Z4,X'00'    * KEINE KMASK *
         MVI   Z5,X'00'    * DUNKEL GEST *
         MVC   STAPWSAV,STATPW
P6       BAS   R13,KMASKE
*-------------3 PAGES FUER HCPRINT ------------------
REQMHCP  REQM  3                        PAGE 1-2  INPUT
         LTR   R15,R15
         BE    HCPRROK
         MVC   ERRTEXT,=CL20'A/YOPN/HC/REQM' 
         BAS   R14,FEHLER
         B     REQMHCP
HCPRROK  EQU   *
         ST    R1,STATHCPG              PAGE 3    OUTPUT
*-------------3 PAGES FUER HCPRINT ------------------
         RETCO
LOGSENDB EQU   *
         YOPNCON RPB=(R6),CCB=(R7),AREALN=26,AREA=OUTPUT,TOVAL=3
         CLM   R15,B'1001',=X'0000'
         BE    W12
         BAS   R14,FEHLER
W12      PASS
         YCLSCON RPB=(R6)
         CLM   R15,B'1001',=X'0000'
         BE    W131
         BAS   R14,FEHLER
W131     RETCO
*
*
         SPACE
         TITLE 'Y O P N C O N   / ASY OPNCON COMPLETED'
YOPNCON  BASR  R15,0
         USING *,R15
         LR    R5,R1
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CYOP ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CYOP'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
**      **
         ST    R5,RPBAOP
         YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=FDBKOP,LENGTH=4,           -
               FIELDS=(FDBK)
         CLM   R15,B'1000',=X'00'
         BE    W900
         MVC   ERRTEXT,=CL20'A/YOPNT/YSHO/FDBK'
         BAS   R14,FEHLER
         RETCO
W900     YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=MVCFOP,LENGTH=4,           -
               FIELDS=(USER)
         CLM   R15,B'1001',=X'0000'
         BE    W13
         MVC   ERRTEXT,=CL20'A/YOPNT/YSHO/USER'
         BAS   R14,FEHLER
W13      YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=CCBOP,LENGTH=4,            -
               FIELDS=(CCB)
         CLM   R15,B'1001',=X'0000'
         BE    W14
         MVC   ERRTEXT,=CL20'A/YOPNT/YSHO/USER'
         BAS   R14,FEHLER
W14      XR    R5,R5
         XR    R6,R6
         LH    R5,MVCFOP+2        (STATTID)
         LH    R6,MVCFOP          (USPID)
         L     R3,STATANFA
         L     R4,STATENDA
YOPLOOP  EQU   *
*        A     R3,=A(X'100')
         LA    R3,256(R3)           + X'100'
         CLM   R5,B'0011',STATTID
         BE    YOPGOT
         CR    R3,R4
         BL    YOPLOOP
         RETCO
YOPGOT   EQU   *
         L     R4,USERPAGA
         L     R5,USERPAGE
YOPPOP   EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)         + X'100'
         CLM   R6,B'0011',USPID
         BE    YOTOP
         CR    R4,R5
         BL    YOPPOP
         RETCO
YOTOP    EQU   *
         L     R15,FDBKOP
         CLM   R15,B'1000',=X'00'
         BE    YOTOP1
         ST    R15,USRC
         MVC   USERROR,=CL15'OPNCON ERROR'
         MVI   USFREE,C'F'
         L     R7,USAID
         YCLOSE AID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W200
         MVC   ERRTEXT,=CL20'A/YOPNPN/YCLOSE'
         BAS   R14,FEHLER
W200     EQU   *
         LA    R7,USEI
         DISEI EIID=(R7)
         LA    R7,USCO
         DISCO COID=(R7)
         L     R7,USIN
* TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R7,12
         LTR   R7,R7
         BNZ   MCRELM4
         MVC   ERRTEXT,=CL20'A/RELM/RELM4/0'
         BAS   R14,FEHLER
         B     A02      
MCRELM4  EQU   *
         RELM  9,(R7)
         CLM   R15,B'0001',=X'00'
*        CMD   '/D %7'            REQM TRACE
         BE    A02
         MVC   ERRTEXT,=CL20'A/YOPNPN/RELM'
         BAS   R14,FEHLER
A02      EQU   *
         XC    USIN(4),USIN    |
         XC    USAID(4),USAID  >  LOESCHEN WENN TIMEOUT VON PART
         XC    USEI(4),USEI    |
         XC    USCO(4),USCO    |
         RETCO
YOTOP1   L     R5,RPBAOP
         YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=OPCID,LENGTH=4,            -
               FIELDS=(CID)
         CLM   R15,B'1001',=X'0000'
         BE    W16
         MVC   ERRTEXT,=CL20'A/YOPNT/YSHO/CID'
         BAS   R14,FEHLER
W16      MVC   USCID,OPCID
         MVC   STATAKTP,USPID
* BEI ERFOLGREICHEM YOPNCON WIRD CPMASKE ZURUECKGESTETZT
         MVI   STATK,X'00'
         MVC   USERROR,=CL15'OPNCON ACCEPTED'
         MVI   USFREE,C'Y'
         MVC   YOPEI,USEI
         MVC   YOPCO,USCO
         DISEI EIID=YOPEI
         CLM   R15,B'1001',=X'0400'
         BE    W17
         MVC   ERRTEXT,=CL20'A/YOPNT/DISEI'
         BAS   R14,FEHLER
W17      DISCO COID=YOPCO
         CLM   R15,B'1001',=X'0400'
         BE    W18
         MVC   ERRTEXT,=CL20'A/YOPNT/DISCO'
         BAS   R14,FEHLER
* 1 ASY YREC
W18      MVC   REECON+2(8),USCPNAME
         MVC   REEEI+2(8),USCPNAME
         ENAEI EINAMAD=REEEI,EIIDRET=REEI
         CLM   R15,B'1001',=X'0400'
         BE    W19
         MVC   ERRTEXT,=CL20'A/YOPNT/ENAEI'
         BAS   R14,FEHLER
W19      LA    R5,RPBAOP
         ENACO CONAMAD=REECON,COADAD=RECA,COMAD=(R5),COIDRET=RECO,     -
               LEVEL=10
         CLM   R15,B'1001',=X'0400'
         BE    W20
         MVC   ERRTEXT,=CL20'A/YOPNT/ENACO'
         BAS   R14,FEHLER
W20      EQU   *
         MVC   USEI,REEI
         MVC   USCO,RECO
W21      EQU   *
         L     R5,USRPBA
         L     R6,MVCFOP
         YMODCB BLK=RPB,BLKADDR=(R5),EIDREF=(R6)
         CLM   R15,B'1000',=X'00'
         BE    W165   
         MVC   ERRTEXT,=CL20'A/YOPNT/YMOD/EIDREF'
         BAS   R14,FEHLER
W165     EQU   *
         L     R2,USIN
         L     R5,USRPBA
         L     R6,USAID
         L     R7,USCID
         YRECEIVE RPB=(R5),AAREA=(R2),EID=REEI,AID=(R6),CID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W22
         MVC   ERRTEXT,=CL20'A/YOPNT/YREC'
         BAS   R14,FEHLER
W22      EQU   *
***                     EINTRAG IN USER-PAG-TAB
         L     R5,USPGTBA
         L     R2,=A(X'1F40')    8000 X 9B
W22X1    EQU   *
         XC    0(1,R5),=X'00'
         BZ    W22X2
         LA    R5,9(R5)
         BCT   R2,W22X1
W22X2    EQU   *
         MVI   0(R5),X'FF'
         STCM  R4,B'1111',1(R5)
         MVC   USTATPNA(8),STATPNA
         MVC   USTATPRO(8),STATPRO
         MVC   USTATVT(8),STATVT
****
         LA    R5,USEI
         LA    R6,USCO
         SOLSIG EIID=(R5),COID=(R6),LIFETIM=43200
         CLM   R15,B'1001',=X'0000'
         BE    W23
         MVC   ERRTEXT,=CL20'A/YOPNT/SOLSIG'
         BAS   R14,FEHLER
W23      RETCO
*
         SPACE
         TITLE 'L O S C P   / VERB ABBAU VON TERMINAL ZU CP'
LOSCP    BASR  R15,0
         USING *,R15
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CLCP ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CLCP'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
**      **
         L     R3,STATANFA
         L     R4,STATENDA
LOSLOOP  EQU   *
*        A     R3,=A(X'100')
         LA    R3,256(R3)         + X'100'
         CLM   R5,B'0011',STATTID
         BE    LOSGOT
         CR    R3,R4
         BL    LOSLOOP
* USERFIELD NICHT GEFUNDEN
         RETCO
LOSGOT   EQU   *
         BAS   R13,FREEALL
         RETCO
FREEALL  MVC   STATTID,=X'0000'
         MVI   STATPNA,X'00'
         L     R4,USERPAGA
         L     R5,USERPAGE
LOSCOK   EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)         + X'100'
         CLI   USPID+1,X'00'
         BE    LOSCOKN
         ICM   R6,B'1111',USAID
         BZ    LOSCOKN
         L     R7,USCID
         YCLSCON RPB=RPBCLOS,AID=(R6),CID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W170
         MVC   ERRTEXT,=CL20'A/YLOSCP/YCLSCON'
         BAS   R14,FEHLER
W170     EQU   *
         YCLOSE AID=(R6)
         CLM   R15,B'1001',=X'0000'
         BE    W110
         MVC   ERRTEXT,=CL20'A/YLOSCP/YCLOSE'
         BAS   R14,FEHLER
W110     EQU   *
*******              AUSTRAG AUS USER-PAG-TAB
         BAS   R14,ERUSPGTB
*******
         LA    6,USEI 
         DISEI EIID=(R6)
         LA    6,USCO 
         DISCO COID=(R6)
         LA    R6,STATEI
         DISEI EIID=(R6)
*        CLI   STATSTOP,X'FF'     WARTEN AUF GO-SIGNAL IN CPBUFH ??
*        BNE   LOSCNGO
*        CLC   STASTPID(2),USPID  MIT DIESEM PID ???
*        BE    A03                DANN DARF NICHT FREIGEGEBEN WERDEN
*LOSCNGO  EQU   *
         L     R6,USIN
         SRA   R6,12
         LTR   R6,R6
         BNZ   MCRELM5
         MVC   ERRTEXT,=CL20'A/RELM/RELM5/0'
         BAS   R14,FEHLER
         B     A03      
MCRELM5  EQU   *
         RELM  9,(R6)
         CLM   R15,B'0001',=X'00'
         BE    A03
         MVC   ERRTEXT,=CL20'A/LOSCP/RELM'
         BAS   R14,FEHLER
A03      EQU   *
LOSCOKN  CR    R4,R5
         BL    LOSCOK
         L     R5,STATHCPG
         SRA   R5,12
         LTR   R5,R5
         BNZ   MCRELM6
         MVC   ERRTEXT,=CL20'A/RELM/RELM6/0'
         BAS   R14,FEHLER
         B     A05HCPG  
MCRELM6  EQU   *
         RELM  3,(R5)           HCPAGE WIRD FREIGEGEBEN
         CLM   R15,B'0001',=X'00'
         BE    A05HCPG
         MVC   ERRTEXT,=CL20'A/LOSCON/RELM/HC'
         BAS   R14,FEHLER
A05HCPG  L     R5,USERPAGA
* USERPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R5,12
         LTR   R5,R5
         BNZ   MCRELM7
         MVC   ERRTEXT,=CL20'A/RELM/RELM7/0'
         BAS   R14,FEHLER
         B     A05      
MCRELM7  EQU   *
         RELM  3,(R5)
         CLM   R15,B'0001',=X'00'
         BE    A05
         MVC   ERRTEXT,=CL20'A/LOSCON/RELM/US'
         BAS   R14,FEHLER
A05      EQU   *
         XC    STATPNA(250),STATPNA
         BR    R13
*
***********************************************************
         DS    3F
KMASKE   EQU   *
         ST    R13,KMASKE-4    SAVEN
         ST    R7,KMASKE-8
         ST    R2,KMASKE-12
         L     R13,CPKMASKA
         BASR  R7,R13
         LTR   R15,R15   <> 0       FEHLER GES. IN MODUL CPKMASK??
         BZ    KMASKEE
         BAS   R14,FEHLER
KMASKEE  L     R13,KMASKE-4
         L     R7,KMASKE-8
         L     R2,KMASKE-12
         BR    R13
         DS    0F
*---------------------------------------------------------------------*
*        E N T R I E S
*---------------------------------------------------------------------*
         ENTRY ERRTEXT
         ENTRY Z2
         ENTRY Z3
         ENTRY Z4
         ENTRY Z5
         ENTRY Z6
         ENTRY TEXT1
         ENTRY OUTPUT2
         ENTRY ERR15
         ENTRY TERMOUTA
         ENTRY KMASKE
         ENTRY LOCKTIM
*---------------------------------------------------------------------*
***********************************************************
         DS    0F
BEG      EQU   *
         MVC   Z1(80),=CL80' '
         RDATA Z1,BEG090,49
         CLI   Z1+4,C' '
         BE    BEG090
         CLI   Z1+4,C'/'
         BE    BEG090
         CLC   Z1+4(3),=C'END'
         BE    BEG090
         CLC   Z1+4(4),=C'LAN='
         BNE   BEG001
         MVC   LANGUE,Z1+8
BEG001   CLC   Z1+4(4),=C'PRE='
         BNE   BEG002
         MVC   CPNAME,Z1+8
BEG002   CLC   Z1+4(3),=C'VT='
         BNE   BEG003
         MVC   VTERM,Z1+7
BEG003   CLC   Z1+4(8),=C'ALLTERM='
         BNE   BEG004
         MVC   ALLTERM,Z1+12
BEG004   CLC   Z1+4(6),=C'PTAST='
         BNE   BEG005
         CLI   Z1+10,X'D5'   P20<     D4 = P20, D5 = KEINE AKTION (N)
         BH    BEG005
         CLI   Z1+10,X'D1'
         BNL   BEG0041
         CLI   Z1+10,X'C9'
         BH    BEG005
         CLI   Z1+10,X'C1'
         BNL   BEG0041
         CLI   Z1+10,X'7C'
         BNE   BEG005
BEG0041  CLI   Z1+12,X'D5'   P20<
         BH    BEG005
         CLI   Z1+12,X'D1'
         BNL   BEG0042
         CLI   Z1+12,X'C9'
         BH    BEG005
         CLI   Z1+12,X'C1'
         BNL   BEG0042
         CLI   Z1+12,X'7C'
         BNE   BEG005
BEG0042  EQU   *
         MVC   ESCN(1),Z1+10         MENU
         MVC   ESCO(1),Z1+12         BLAETTER
         MVC   ESCW(1),Z1+14         HARDCOPY
         CLI   Z1+10,X'D5'     (N) NO ACTION
         BE    BEG00421         BEI (N) WIRD DAFUER EINE ANDERE
         MVC   ESCSAV(3),ESCN   BELEGTE PTASTE 2 MAL GELADEN
BEG00421 CLI   Z1+12,X'D5'
         BE    BEG00422
         MVC   ESCSAV(3),ESCO
BEG00422 CLI   Z1+14,X'D5'
         BE    BEG00423
         MVC   ESCSAV(3),ESCW
BEG00423 CLI   Z1+10,X'D5'
         BNE   BEG00425
         MVC   ESCN(3),ESCSAV
BEG00425 CLI   Z1+12,X'D5'
         BNE   BEG00426
         MVC   ESCO(3),ESCSAV
BEG00426 CLI   Z1+14,X'D5'
         BNE   BEG005
         MVC   ESCW(3),ESCSAV
         B     BEG005
BEG005   CLC   Z1+4(4),=C'LIB='
         BNE   BEG006
         MVC   LIB,Z1+8
BEG006   CLC   Z1+4(8),=C'LOCKTIM='
         BNE   BEG007
         CLC   Z1+12(2),=C'01'
         BL    BEG007
         CLC   Z1+12(2),=C'99'
         BH    BEG007
         PACK  LOCKTIM1(8),Z1+12(2)
         CVB   R14,LOCKTIM1
         MH    R14,=H'60'
         ST    R14,LOCKTIM           LOCKTIME BINAER
         L     R14,=V(CPCLOCK)
         STXIT RTIMER=((R14),0)
         SETIC REALTIM=CPUTIM
BEG007   CLC   Z1+4(4),=C'SEQ='
         BNE   BEG   
         MVC   SEQ,Z1+8
         MVC   FD1FILE(54),SEQ
         B     BEG   
BEG090   STXIT INTR=INTRC,INTRBUF=INTRTXT
         ENAEI EINAME=INFENACP,EIIDRET=EIRETI
         ENACO CONAME=INFCONCP,COADAD=INFCOA,COIDRET=IDINFCP,LEVEL=10
         SOLSIG EIID=EIRETI,COID=IDINFCP
*------- HC-CONTI
         ENAEI EINAME=HCENACP,EIIDRET=EIIDHC
         ENACO CONAME=HCCONCP,COADAD=HCPRCOA,COIDRET=IDHCOCP,LEVEL=8
         SOLSIG EIID=EIIDHC,COID=IDHCOCP,LIFETIM=43000
         MVC   CPHELPA,CPHELPAD
         CLI   LANGUE,C'D'
         BE    BEG0
         MVC   CPHELPA,CPHELPAE
BEG0     MVC   CPVER2,CPVER
         MVC   CPVER3,CPVER
         MVC   CPVER4,CPVER
         MVC   CPNAMED,CPNAME
         MVC   CPLAN,LANGUE
         MVC   CPVT,VTERM
         MVC   CPALL,ALLTERM
         MVC   CPSEQ(54),SEQ
         WROUT ZCP3MSG,W31
W31      ENACO CONAME=COMCP,COADAD=ENDEA,COIDRET=IDENDECP,LEVEL=20
         CLM   R15,B'1001',=X'0400'
         BE    A100
         MVC   ERRTEXT,=CL20'S/BEG/ENACO0'
         BAS   R14,FEHLER
A100     ENACO CONAME=LOGCP,COADAD=ALOGCP,COIDRET=IDLOGCP,LEVEL=10
         CLM   R15,B'1001',=X'0400'
         BE    W32
         MVC   ERRTEXT,=CL20'S/BEG/ENACO1' 
         BAS   R14,FEHLER
W32      ENACO CONAME=LOSCP,COADAD=ALOSCP,COIDRET=IDLOSCP,LEVEL=10
         CLM   R15,B'1001',=X'0400'
         BE    W33
         MVC   ERRTEXT,=CL20'S/BEG/ENACO1' 
         BAS   R14,FEHLER
W33      ENACO CONAME=LOSCO,COADAD=ALOSCO,COIDRET=IDLOSCO,LEVEL=10
         CLM   R15,B'1001',=X'0400'
         BE    W132
         MVC   ERRTEXT,=CL20'S/BEG/ENACO1' 
         BAS   R14,FEHLER
W132     REQM  40
         CLM   R15,B'0001',=X'00'
         BE    W34
         MVC   ERRTEXT,=CL20'S/BEG/REQM'  
         BAS   R14,FEHLER
         TERMD
W34      ST    R1,STATANFA
         A     R1,=A(X'01FE00')
         ST    R1,STATENDA
         ST    R1,SAVTABA
*        A     R1,=A(X'200')
         LA    R1,512(R1)         + X'200'
         ST    R1,DCAMTESA
         LR    R15,R1
         A     R15,=A(X'2500')       >SAP
         ST    R15,TERMOUTA
*        A     R1,=A(X'8')
         LA    R1,8(R1)         + X'8'
         ST    R1,DCAMTEA
         YOPEN ACB=ACBCP
         CLM   R15,B'1001',=X'0000'
         BE    W35
         MVC   ERRTEXT,=CL20'S/BEG/YOPEN'  
         BAS   R14,FEHLER
W35      YSHOWCB BLK=ACB,BLKADDR=ACBCP,WAREA=AIDCP,LENGTH=4,           -
               FIELDS=(AID)
         CLM   R15,B'1001',=X'0000'
         BE    START
         MVC   ERRTEXT,=CL20'S/BEG/YSHOW/AID'
         BAS   R14,FEHLER
* 1 ASY REC FUER TERMINAL EINGABEN
START    EQU   *
*        TYPIO MSG=ZCP3MSG
         OPEN  FCBSEQ,INPUT
* 1 ASY YREC
         ENAEI EINAME=TERMEI,EIIDRET=TEREI
         CLM   R15,B'1001',=X'0400'
         BE    W500
         MVC   ERRTEXT,=CL20'S/START/ENAEI'
         BAS   R14,FEHLER
W500     EQU   *
         ENACO CONAME=TERMCON,COADAD=TERMA,COIDRET=TERCO,LEVEL=10
         CLM   R15,B'1001',=X'0400'
         BE    W501
         MVC   ERRTEXT,=CL20'A/START/ENACO'
         BAS   R14,FEHLER
W501     EQU   *
         L     R14,DCAMTEA
         YRECEIVE RPB=RPBSYN,AAREA=(R14),AAREALN=4100,                 -
               CCB=CCBSYN,EID=TEREI,ACB=ACBCP
         CLM   R15,B'1000',=X'00'
         BE    W502
         MVC   ERRTEXT,=CL20'S/START/YREC'  
         BAS   R14,FEHLER
W502     SOLSIG EIID=TEREI,COID=TERCO,LIFETIM=43200
         CLM   R15,B'1001',=X'0000'
         BE    W504
         MVC   ERRTEXT,=CL20'A/START/SOLSIG'
         BAS   R14,FEHLER
* HAUPTPROGAMM
W504     SUSPEND
         B     W504
         SPACE
         TITLE 'T E R M   / ASY REC VON ALLEN TERMINALS '
TERM     EQU   *
         BASR  R15,0
         USING *,R15
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CTER ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CTER'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
*
*        L     R14,CRECCNT        |
*        SH    R14,=H'1'          >   ASYN REC ZAEHLER  (-1)
*        ST    R14,CRECCNT        |
**      **
         YSHOWCB BLK=RPB,BLKADDR=RPBSYN,WAREA=FDBKSY,LENGTH=4,         -
               FIELDS=(FDBK)
         L     R15,FDBKSY
*        CLM   R15,B'1010',=X'0410'     * SOFERN TOVAL ABGE
*        BE    SCHLEIFE                  SETZE NEUEN YREC AB
*        CLM   R15,B'1000',=X'08'  VERBIND.ZUST. FALSCH? ZB YCLOSE
*        BNE   TFDBKN08
*        CLM   R15,B'0100',=X'40'  ANW EXISTIERT NICHT
*        BL    SCHLEIFE
TFDBKN08 CLM   R15,B'1000',=X'00'
         BE    W38
         MVC   ERRTEXT,=CL20'A/TERM/FDBK'
         BAS   R14,FEHLER
         B     SCHLEIFE
W38      YSHOWCB BLK=RPB,BLKADDR=RPBSYN,WAREA=USERFLD,LENGTH=4,        -
               FIELDS=(USER)
         CLM   R15,B'1001',=X'0000'
         BE    W39
         MVC   ERRTEXT,=CL20'S/SCH/YSHO/USER'
         BAS   R14,FEHLER
W39      EQU   *
         L     R5,USERFLD
         CLM   R5,B'0011',=X'0000'
         BNE   CX
         XR    R15,R15
         MVC   ERRTEXT,=CL20'A/TERM/USER=0'
         BAS   R14,FEHLER
         B     SCHLEIFE
CX       YSHOWCB BLK=RPB,BLKADDR=RPBSYN,WAREA=NRTLEN,LENGTH=4,         -
               FIELDS=(ARECLN)
         CLM   R15,B'1001',=X'0000'
         BE    W40
         MVC   ERRTEXT,=CL20'S/SCH/YSHO/LEN'
         BAS   R14,FEHLER
W40      L     R3,STATANFA
         L     R4,STATENDA
         L     R5,USERFLD
SYNLOOP  EQU   *
*        A     R3,=A(X'100')
         LA    R3,256(R3)            + X'100'
         CLM   R5,B'0011',STATTID
         BE    SYNGOT
         CR    R3,R4
         BL    SYNLOOP
* USERFIELD NICHT GEFUNDEN
         B     SCHLEIFE
SYNGOT   EQU   *
**  LOGIN PROCEDERE ??           
         CLI   STATANM,X'00' 
         BNE   LOGIPR 
** NEIN
         STCK  CREQTIM         LOCK TIMER AKT
         L     R14,CREQTIM
         ST    R14,STATCLK
* WENN VERBINDUNG GESTOERT (WARTEN AUF GO SIGNAL)
* WIRD EINGABENACHRICHT VORTGEWORFEN
         CLI   STATSTOP,X'FF'
         BE    SCHLEIFE
* HABE ICH KMASKE AUF SCHIRM 
         CLI   STATK,X'10'
         BE    CPCMD
SENDPID  EQU   *
         MVI   Z2,X'FF'
         CLC   STATAKTP,=H'0'        
         BE    PUTMASKE         
* SOFERN NACH OPN GE"DUE" WIRD
* GEBEN WIR HALT DIE MASKE AUS
         L     R4,USERPAGA
         L     R5,USERPAGE
SENDOP   EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)            + X'100'
         CLC   STATAKTP,USPID
         BE    SENDP
         CR    R4,R5
         BL    SENDOP
         B     SCHLEIFE
SENDP    EQU   *
W90      L     R14,DCAMTEA
         MVI   Z2,X'FF'
         CLI   9(R14),X'4E'        "K7"
         BE    PUTMASKE
         CLI   9(R14),X'4F'        "K8"
         BE    GETNEXT 
         CLI   9(R14),X'3F'        "K9"  HC HARDCOPY
         BE    HCROUT
         CLI   9(R14),X'54'        "K2"
         BNE   W91      
*
         CLC   USTYP,=C'TIAM'
         BNE   W91
         MVI   USNEA,X'21'
W91      EQU   *
         L     R7,NRTLEN
         L     R5,USAID
         L     R6,USCID
         MVI   Z2,X'FF'
         CLI   USFREE,C'D'     * SOFERN AKT PARTNER DECLARED
         BE    PUTMASKE        * (MOEGLICH SOFERN GERADE LOSCO ROUTINE
* DURCHLAUFEN WIRD KMASKE AUSGEGEBEN
         CLI   USFREE,C'F'     * SOFERN AKT PARTNER DISCON
         BE    PUTMASKE         * WIRD KMASKE AUSGEGEBEN
         CLI   USFREE,C'O'     * SOFERN AKT PARTNER NOCH NICHT 
* VERBUNDEN 
         BE    PUTMASKE         * WIRD KMASKE AUSGEGEBEN
         MVC   USERROR,=CL15'SEND'
         MVI   USFREE,C':'
         CLC   USTYP,=C'UCON'
         BE    SENDUC
*        CLC   USTYP,=C'U/D*'
*        BE    W140    
         AH    R7,=H'8'
         L     R14,DCAMTESA
         MVC   0(8,R14),USNEA
         XI    0(R14),X'20'
         CLI   0(R14),X'00'
         BE    W140
         CLI   0(R14),X'01'
         BE    W140
         CLI   0(R14),X'11'
         BE    W140
         CLI   0(R14),X'13'
         BE    W140
         CLI   0(R14),X'15'
         BE    W140
         CLI   0(R14),X'17'
         BE    W140
*        CLI   0(R14),X'16'
* AUF USER WRITE X'36' WIRD MIT X'41' GEANTWORT (GEN BEI DCAM)
*        BNE   W140
         MVI   0(R14),X'41'
W140     EQU   *
         CLC   USTYP,=C'PDN '            ** CATS
         BNE   W140NPDN
         LA    R14,8(R14)        +8 FUER MULTIKOS (CATS)
         SH    R7,=H'8'          LEN -8
         MVC   0(2,R14),=X'6400' FUER MULTIKOS (CATS)
         CLI   2(R14),X'50'      PAR00E + PAR01E ????
         BE    W140TR50          JA !! ZB BEI  H120-SVP
         TR    2(9,R14),TRASCII  9 BYTE PROTOKOLL ASCII --> EBCDIC
*                                UMWANDELN FUER MULTIKOS  (CATS)
         B     W140NPDN          NUR MIT PAR00E,  SAW=4F
W140TR50 EQU   *
         TR    2(17,R14),TRASCII  17 BYTE PROTOKOLL  MIT PAR01E  (CATS)
*
W140NPDN YSEND RPB=RPBSYN,AID=(R5),CID=(R6),AREALN=(R7),AREA=(R14)
* USNEA WIRD MIT ASYN NACHRICHT VORBELEGT
         MVI   USNEA,X'36'
*
         CLM   R15,B'1001',=X'0000'
         BE    TRACE2
         ST    R15,USRC
         MVC   USERROR,=CL15'SEND ERROR'
         MVI   USFREE,C':'
         MVC   ERRTEXT,=CL20'S/SCH/YSEND/PAR'
         BAS   R14,FEHLER
*  TRACE *********************
TRACE2   B     TRACE2E           B / NOP
         MVC   TRBOUT(4),=C'OUT:'
         L     R2,DCAMTESA
         BAS   R14,TRACROUT
TRACE2E  EQU   *
*  TRACE *********************
         B     W41 
SENDUC   EQU   *
         L     R15,DCAMTEA 
         L     R14,DCAMTEA 
         MVI   USREF,C'N'
         CLI   9(R14),X'66'        "DUE AN $CONSOLE"
         BE    A101
         MVI   USREF,C'*'
A102     L     R6,STATRPBA
         L     R7,STATCID
         L     R14,STAIDCP  
         LA    R2,STATEI
         YSEND RPB=(R6),CID=(R7),AREA=OUTPUTUC,AREALN=22,AID=(R14),    -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    TRACE3
         MVC   ERRTEXT,=CL20'S/SCH/SEND/NEW'
         CLM   R15,B'1110',=X'10040C'
         BNE   A103
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BE    A102
         MVC   ERRTEXT,=CL20'S/SCH/SEND/NEW/SOL'
A103     BAS   R14,FEHLER
*  TRACE *********************
TRACE3   B     TRACE3E           B / NOP
         MVC   TRBOUT(4),=C'OUT:'
         L     R2,DCAMTEA
         BAS   R14,TRACROUT
TRACE3E  EQU   *
*  TRACE *********************
A104     B     SCHLEIFE
A101     EQU   *
         AH    R14,=H'11'
         SH    R7,=H'11'
         CLI   3(R15),X'00'
         BE    W400
         AH    R14,=H'4'
         SH    R7,=H'4'
W400     EQU   *
         TR    0(250,R14),TRANST
         YSEND RPB=RPBSYN,AID=(R5),CID=(R6),AREALN=(R7),AREA=(R14)
         CLM   R15,B'1001',=X'0000'
         BE    TRACE4
         ST    R15,USRC
         MVC   USERROR,=CL15'SEND ERROR'
         MVI   USFREE,C':'
         MVC   ERRTEXT,=CL20'S/SCH/YSEND/PAR'
         BAS   R14,FEHLER
*  TRACE *********************
TRACE4   B     TRACE4E           B / NOP
         MVC   TRBOUT(4),=C'OUT:'
         L     R2,DCAMTEA
         BAS   R14,TRACROUT
TRACE4E  EQU   *
*  TRACE *********************
W41      B     SCHLEIFE
PUTMASKE EQU   *
         MVI   Z5,X'FF'
         MVI   Z3,X'FF'
         MVI   Z4,X'FF'
         CLI   Z2,X'FF'
         BNE   PUTMASK1
         L     R15,TERMOUTA
         L     R14,=F'38'
         MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         LA    R15,38(R15)
PUTMASK1 BAS   R13,KMASKE
         B     SCHLEIFE
CPCMD    EQU   *
         L     R15,DCAMTEA
         L     R5,DCAMTEA
         TR    0(200,R5),TRANST
         A     R5,NRTLEN
         XC    0(30,R5),0(R5)
         L     R6,DCAMTEA
         AH    R6,=H'15'
         CLI   3(R15),X'00'
         BNE   W310
         L     R6,DCAMTEA
         AH    R6,=H'11'
W310     EQU   *
         CLC   STATPW,=XL8'00'
         BE    P0
         CLC   STATPW,=CL8' '
         BE    P0
         LR    R1,R6
         LR    R2,R6
         AH    R2,=H'9'
P50      CLI   0(R1),C' '
         BE    P51
         AH    R1,=H'1'
         CR    R1,R2
         BL    P50
         B     P52
P51      MVI   0(R1),X'00'
         B     P50
P52      EQU   *
         CLC   0(8,R6),STATPW
         BE    P4
*        MVC   Z2(4),=X'1ED81DC2'
*        MVC   Z2+4(76),=CL76'ZCP0010 CP IS LOCKED. ENTER PW TO UNLOCK'
*        MVC   Z2+45(4),=X'1ED71DC4'
         L     R15,TERMOUTA   <=== MUSS IMMER VERSORGT SEIN (CPKMASK)
*        L     R14,=F'38'
*        MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         MVI   Z3,X'00'    * KEIN CMD *
         MVI   Z4,X'00'    * KEINE KMASK *
         MVI   Z5,X'00'    * DUNKEL GEST *
         BAS   R13,KMASKE
         B     SCHLEIFE
P4       MVC   STATPW,=XL8'00'
         MVI   Z3,X'FF'   * CMD:*
         MVI   Z4,X'FF'   * KMASK * 
         MVI   Z2,X'FF'   * NO TEXT *
         MVI   STATANM,STATANMP
*                            *  NACH UNLOCK WIRD BULLETIN AUSGEGEBEN
         L     R15,CPBLTINA             BULLETIN  V2.1C
         BASR  R14,R15                  BULLETIN  V2.1C
         B     SCHLEIFE
******** B     PUTMASKE      *  NACH UNLOCK WIRD MASKE AUSGEGEBEN
P0       EQU   *
         CLC   0(4,R6),=C'LOCK'
         BNE   P1
* SOFERN NUR DER STRING "LOCK " EINGEGEBEN WIRD
* DARF  IN DIE LOCK ROUTINE VERZZWEIGT WERDEN
         CLI   5(R6),X'00'
         BNE   P01
         MVC   5(8,R6),STAPWSAV    PW AUS DATEI
P01      EQU   *                   PW IN LOCK-CMD
         CLI   5(R6),C' '     FALLS BLANK DARF NICHT GELOCKT WERDEN
         BE    P1
         MVC   STATPW,5(R6) 
         LA    R14,STATPW
         LA    R15,STATPW+8
P60      CLI   0(R14),C' '
         BE    P65
         AH    R14,=H'1'
         CR    R14,R15
         BL    P60
         B     P70
P65      MVI   0(R14),X'00'
         AH    R14,=H'1'
         CR    R14,R15
         BL    P65
P70      EQU   *
*70      MVC   Z2(4),=X'1ED81DC2'
*        MVC   Z2+4(76),=CL76'ZCP0010 CP IS LOCKED. ENTER PW TO UNLOCK'
*        MVC   Z2+45(4),=X'1ED71DC4'
         L     R15,TERMOUTA
*        L     R14,=F'38'
*        MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         MVI   Z3,X'00'    * KEIN CMD *
         MVI   Z4,X'00'    * KEINE KMASK *
         MVI   Z5,X'00'    * DUNKEL GEST *
         BAS   R13,KMASKE
         B     SCHLEIFE
P1       EQU   *
         CLC   0(5,R6),=C'ENDCP'
         BNE   X100
* NACH EINGABE DER STRING "ENDCP" WIRD DIE VRBINDUNG ZUM TERMIAL
* ABGEBAUT
         L     R6,STATRPBA
         L     R7,STATCID
         L     R14,STAIDCP  
         XR    R13,R13
         LH    R13,ENDTLE
X101     LA    R2,STATEI
         L     R14,STAIDCP  
         YSEND RPB=(R6),CID=(R7),AID=(R14),AREA=ENDT1,AREALN=(R13),    -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    X102
         MVC   ERRTEXT,=CL20'S/ENDCP/YSEND'
         CLM   R15,B'1110',=X'10040C'
         BNE   X103
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BE    X101
         MVC   ERRTEXT,=CL20'S/ENDCP/YSEND/SOLS'
X103     BAS   R14,FEHLER
X102     EQU   *
         L     R14,STAIDCP  
         YCLSCON RPB=(R6),CID=(R7),AID=(R14)
         CLM   R15,B'1001',=X'0000'
         BE    X110
         MVC   ERRTEXT,=CL20'S/ENDCP/YCLSCON'
         BAS   R14,FEHLER
X110     EQU   *
* SPRUNG ZUMFREIGEBEN
         BAS   R13,FREEALL
         B     SCHLEIFE
X100     CLC   0(2,R6),=C'O '
         BE    OPENPID
         CLC   0(2,R6),=C'O,'
         BE    OPENPID
         CLC   0(2,R6),=X'D600'
         BE    OPENPID
         CLI   0(R6),C'?'
         BE    HELPTEXT
*        CLC   0(8,R6),=C'//CH-BUL'  ADMIN   CH BULLETIN IN CPGETBL
*        BE    CPCHBL 
         CLC   0(2,R6),=C'//'        ADMIN
         BE    CPADMRT
         CLI   0(R6),C'/'         ADMIN-USER Z. PRINTER DEV.
         BE    CPADMRTU
X100NADM LR    R13,R6
         CLC   0(2,R6),=C'C '
         BNE   GOTOPID
         MVI   KILL,C' '
         AH    R6,=H'2'
         LR    R1,R6
         AH    R1,=H'1'      * TEST AUF STRING ,KILL
         CLC   0(2,R1),=C',K' 
         BE    Z90
         AH    R1,=H'1'
         CLC   0(2,R1),=C',K' 
         BE    Z90
         AH    R1,=H'1'
         CLC   0(2,R1),=C',K' 
         BE    Z90
         AH    R1,=H'1'
         CLC   0(2,R1),=C',K' 
         BNE   GOTOPID
Z90      XC    0(12,R1),0(R1)
         MVI   KILL,C'Y'
GOTOPID  EQU   *
         MVI   Z3,X'FF'   * CMD:*
         MVI   Z4,X'FF'   * KMASK * 
         MVI   Z2,X'FF'   * NO TEXT *
         LA    R2,EINPAC
         MVC   EINPAC,=C'0000'
         L     R4,USERPAGA
         L     R15,DCAMTEA
         CLI   9(R15),X'4F'        "K8"
         BE    GETNEXT 
         CLI   9(R15),X'3F'        "K9"  HC HARDCOPY
         BE    HCROUT
         CLI   0(R6),X'00' 
         BE    PUTMASKE      *  BEI LEERE EINGABE WIRD MASKE AUSGEGEBEN
         CLI   0(R6),C'0'
         BE    W160
         CLI   0(R6),C'1'
         BE    W160
         CLI   0(R6),C'2'
         BE    W160
         CLI   0(R6),C'3'
         BE    W160
         CLI   0(R6),C'4'
         BE    W160
         CLI   0(R6),C'5'
         BE    W160
         CLI   0(R6),C'6'
         BE    W160
         CLI   0(R6),C'7'
         BE    W160
         CLI   0(R6),C'8'
         BE    W160
         CLI   0(R6),C'9'
         BE    W160
         MVC   EINPAC,0(R6)
LP09     CLI   EINPAC+1,X'00'
         BNE   LP10
         MVC   EINPAC+1(3),=C'   '
         B     LP19
LP10     CLI   EINPAC+2,X'00'
         BNE   LP13
         MVC   EINPAC+2(2),=C'  '
         B     LP19
LP13     CLI   EINPAC+3,X'00'
         BNE   LP19
LP14     MVI   EINPAC+3,C' '
LP19     EQU   *
         B     W161
W160     CLI   1(R6),X'00' 
         BNE   GOTOW1
         LH    R5,=H'0'  
         LA    R2,EINPAC+3
         B     GOTOW5
GOTOW1   CLI   2(R6),X'00'
         BNE   GOTOW2
         LH    R5,=H'1'  
         LA    R2,EINPAC+2
         B     GOTOW5
GOTOW2   CLI   3(R6),X'00' 
         BNE   GOTOW3
         LH    R5,=H'2'  
         LA    R2,EINPAC+1
         B     GOTOW5
GOTOW3   CLI   4(R6),X'00' 
         LA    R2,EINPAC
         LH    R5,=H'3'  
GOTOW5   EQU   *
GOTOPIDM STCM  R5,B'0001',GOTOMVC+1
GOTOMVC  MVC   0(0,R2),0(R6)
W161     EQU   *
GOTOPID1 L     R4,USERPAGA
         L     R5,USERPAGE
GOTOOP   EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)          + X'100'
         CLC   EINPAC,USPAC
         BE    GOTOP00
         CR    R4,R5
         BL    GOTOOP
GOTOPXN  EQU   *
         MVC   Z2(80),=CL80' '
         MVC   Z2(22),=CL22'CHANGE/CLOSCON TO PAC:'
         MVC   Z2+22(4),EINPAC
         MVC   Z2+26(15),=CL15' NOT POSSIBLE'
BACKXY   EQU   *
* EINSPRUNG FUR FEHLER UND KMASKE
         L     R15,TERMOUTA
         L     R14,=F'38'
         MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         LA    R15,38(R15)
W42      B     PUTMASKE
********* ADMIN ADMIN ADMIN ******************************
CPADMRT  EQU   *        ADMIN. FUNKTIONEN --> MOD. CPADMIN
         CLI   STATADM,C'Y'
         BNE   X100NADM      KEINE BERECHTIGUNG
         LA    R6,2(R6)  +2 '//'
         L     R15,CPADMINA
         BASR  R14,R15    (R4=USEREIN, R3=STATEIN,R6=PARAM,R14=RET)
         B     SCHLEIFE
***********************************************************
********* HC HC HC HC HC HC ******************************
HCROUT   EQU   *        HARDCOPY              MOD. HCPRINT
         L     R15,HCINITA
         BASR  R14,R15
         CLI   STATK,X'10'
         BE    PUTMASKE
         B     SCHLEIFE
***********************************************************
********* ADMIN USER -ADMIN USER *************************
CPADMRTU EQU   *       (ADMIN)-FUNKTIONEN FUER USER--> MOD. CPAUSER
         LA    R6,1(R6)  +1 '/'
         L     R15,CPAUSERA
         BASR  R14,R15    (R4=USEREIN, R3=STATEIN,R6=PARAM,R14=RET)
         B     SCHLEIFE
***********************************************************
********* LOGIN PROCEDERE        *************************
LOGIPR   EQU   *
         L     R5,DCAMTEA
         A     R5,NRTLEN
         XC    0(40,R5),0(R5)
         L     R5,DCAMTEA
         TR    0(36,R5),TRANST
         L     R15,CPLOGINA
         BASR  R14,R15    (R5=PARAM, R4=USEREIN, R3=STATEIN)
** RC AUSWERTEN         
         LTR   R15,R15
         BNZ   LOGINOK  
** LOGINPROCEDERE OK
** STATUS USERTAB UPDATED    
** PW VERARBEITUNG
PWL0     EQU   *
         CLC   STATPW,=XL8'00'
         BE    PWP4
         CLC   STATPW,=CL8' '
         BE    PWP4
         L     R6,DCAMTEA   
** VT-NAME AUSBLENDEN
         LA    R6,27(R6)       
         LR    R1,R6
         LR    R2,R6
         AH    R2,=H'8'
PWL50    CLI   0(R1),C' '
         BE    PWL51
         AH    R1,=H'1'
         CR    R1,R2
         BL    PWL50
         B     PWL52
PWL51    MVI   0(R1),X'00'
         B     PWL50
PWL52    EQU   *
         CLC   0(8,R6),STATPW
         BE    PWP4
LOGINOK  EQU   *
** PW FALSCH                     
** ABFRAGE FALLS ALLTERM=YES -> LEERES MENUE
         CLI   ALLTERM,C'N'
         BE    LOGINOK1
** KEINE PASSWORTEINGABE (ALLTERM)
         CLI   27(R5),X'40'
         BH    LOGINOK1
** KEIN VT-NAME (ALLTERM)
         CLI   15(R5),X'40'
         BNH   PWP4    
LOGINOK1 EQU   * 
** OPENUM WIRD NICHT ZURUECKGESETZT !!!!!!
** USERPAGE LOESCHEN   44 * 256
         LA    R5,44        
         L     R2,USERPAGA
UPGLOE   XC    0(255,R2),0(R2)
         LA    R2,255(R2)
         BCT   R5,UPGLOE
** STATTAB RUECKSETZEN
         XC    STAPWSAV(8),STAPWSAV
         XC    STATFREE(1),STATFREE
         XC    STATADM(1),STATADM
         XC    STATDEV(8),STATDEV
         XC    STATFORM(8),STATFORM
         XC    STATHCTY(1),STATHCTY
         XC    STATPW(8),STATPW
         XC    STATVT(8),STATVT
** LOGIN-MASKE NEU AUSGEBEN
         L     R15,TERMOUTA
         MVI   STATANM,STATANMA   LOGIN MENU
         MVI   Z2,X'FF'
         MVI   Z3,X'00'
         MVI   Z4,X'00'
         MVI   Z5,X'00'
         BAS   R13,KMASKE  
         B     SCHLEIFE
** UNLOCK , HCPAGE UND AB GEHTS
PWP4     EQU   *
*-------------3 PAGES FUER HCPRINT ------------------
REQMHCPL REQM  3                        PAGE 1-2  INPUT
         LTR   R15,R15
         BE    HCPRROKL
         MVC   ERRTEXT,=CL20'A/YOPN/HCL/REQM' 
         BAS   R14,FEHLER
         B     REQMHCPL
HCPRROKL EQU   *
         ST    R1,STATHCPG              PAGE 3    OUTPUT
*-------------3 PAGES FUER HCPRINT ------------------
         B     P4
***********************************************************
HELPTEXT EQU   *
         L     R13,SAVTABA
         AH    R6,=H'2'
         ST    R6,PAR1A
         LA    R1,PARA
         L     R15,CPHELPA
         BASR  R14,R15
         B     HELPW
CPHELPA  DS    F
HELPW    L     R6,STATRPBA
         L     R7,STATCID
         L     R14,STAIDCP  
W699     XR    R13,R13
         L     R5,PAR1A
         LH    R13,0(R5)
         AH    R5,=H'2'
         LA    R2,STATEI
         L     R14,STAIDCP  
         YSEND RPB=(R6),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R13),     -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    W700
         MVC   ERRTEXT,=CL20'S/HELP/YSEND/SOL'
         CLM   R15,B'1110',=X'10040C'
         BNE   W777
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10
         CLM   R15,B'0001',=X'00'
         BE    W699
         MVC   ERRTEXT,=CL20'S/HELP/YSEND/SOLS'
W777     BAS   R14,FEHLER
W700     EQU   *
         B     SCHLEIFE
GOTOP00  EQU   *
         CLI   USFREE,C':'         * SOFERN PARTNER AKTIV
         BE    B5                    ODER
         CLI   USFREE,C'Y'         * OPNCON ERFOGLREICH
         BE    B5                  * WIRD 
         CLI   USFREE,C'D'         * ODER DEKL. IST  
         BE    B5                  * WECHSEL ODER CLOSCON MOEGLIC
         B     GOTOPXN          
B5       CLC   0(2,R13),=C'C '  * CHECK OB CLOSCON AUF PARTNER
         BNE   GOTOPX           * GEGEBEN WURDE
         CLI   KILL,C'Y'        * WENN KILL GEGEBEN WURDE
         BE    KILLPID          * IST ALLES MOEGLICH
         CLI   USFREE,C'D'      * SONST WIRD CLOSCON AUF EIN
         BE    GOTOPXN          * IM STATUS DECLARED AB GELEHNT
         B     CLOSPID         
GOTOPX   CLI   USFREE,C':'
         BE    Z1X
         CLI   USFREE,C'Y'
         BE    Z1X
         CLI   USFREE,C'D'
         BE    C500
         B     GOTOPXN
* DECALARIERTEN PARTNER WIRD EROEFFNET
C500     MVC   OPEPN,USPNA
         MVC   OPETYP,USTYP
         MVC   OPEPRO,USPRO
         MVC   OPEAPPL,USCPNAME
         MVC   PAC,USPAC
         XR    R6,R6
         LH    R6,USPID
         MVC   LMSG,USLOE1
         MVC   PW,USLOE2
         MVC   PW1,PW+2
         MVC   ST,USREF
         B     GOTOP
Z1X      EQU   *
         MVC   Z2(80),=CL80' '
         MVC   Z2(14),=CL14'CHANGE TO PAC:'
         MVC   Z2+15(4),EINPAC
         L     R15,TERMOUTA
         L     R14,=F'126'
         MVC   0(126,R15),KMASKANS      FRUEHER 0(24,R15)...
*        A     R15,=F'126'
         LA    R15,126(R15)
         ST    R4,SAV4
         ST    R3,SAV3
         MVI   Z3,X'00'    * KEIN CMD *
         MVI   Z4,X'00'    * KEINE KMASK *
         MVI   Z5,X'FF'
         MVI   Z6,X'FF'    * PAC -> SYSZ
         BAS   R13,KMASKE
         L     R4,SAV4
         L     R3,SAV3
WECHEND  EQU   *
         CLC   USTYP,=C'UCON'       "SOFERN LETZTE UCON NACHRICHT K2"
         BNE   A120                "WIRD SIE ZURUEGSETZTZ"
         MVI   USREF,C'N'
A120     MVC   STATAKTP,USPID
         MVI   STATK,X'00'
         MVC   USRES,=F'3' 
         CLC   USERROR(4),=CL4'SEND' * SOFERN DEM PARTNER BEREITS EINE
         BE    BACK          * NACHRICHT GESCHICKT WURD MUSS AUF DEN 
* YRECEIVE GEWARTET WERDEN
         CLI   USFREE,C'Y'   * SOFERN NUR DER YOPN EINGETROFFEN IST
         BE    BACK
         ST    R15,R15SAV
         L     R15,CPBUFHA
         BASR  R14,R15
         L     R15,R15SAV
W44      B     BACK
GETNEXT  EQU   *
         LR    R7,R4
         L     R5,USERPAGE
GETNEXT1 EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)             + X'100'
         CLI   USPID+1,X'00'
         BNE   GETNEXT6
         CR    R4,R5
         BL    GETNEXT1
GETNEXT2 EQU   *
         L     R4,USERPAGA
GETNEXT3 EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)          + X'100'
         CLI   USPID+1,X'00'
         BNE   GETNEXT6
         CR    R4,R7
         BL    GETNEXT3
         MVI   Z2,X'FF'
         B     PUTMASKE
GETNEXT6 EQU   *
         MVC   EINPAC,USPAC
W112     B     GOTOPX
OPENPID  EQU   *
         CLI   STATFREE,C'N'
         BNE   P100
         MVI   Z3,X'FF'   * CMD:*
         MVI   Z4,X'FF'   * KMASK * 
         MVC   Z2(80),=CL80' '
         MVC   Z2(30),=CL30'ZCP0011 OPEN CMD NOT ALLOWED'
         L     R15,TERMOUTA
         L     R14,=F'38'
         MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         LA    R15,38(R15)
         B     PUTMASKE
P100     EQU   *
         MVC   OPEPAC,=CL4' '
         MVC   OPEPRO,=CL8' '
         MVI   EDIT,C'S'
         MVC   T,=CL8' '
         MVI   ST,'N'
         MVC   LMSG(16),=CL80' '
         MVC   PW,=CL7' '
         MVC   PAC,=CL4' '
         MVC   OPETYP,=C'TIAM'
         MVC   OPEPN,=CL8' '
         LR    R1,R6
OLOOPOP  AH    R1,=H'1'
         CLI   0(R1),X'00' 
         BE    OLOOPE      "OP" ALLEINE
         CLI   0(R1),C','  "OP," (PARTNER=$DIALOG)
         BE    TESTKEY
         CLI   0(R1),C' '  "OP   " (SUCHE ERSTEN BUSTABEN VOM PARTNER
         BNE   OLOOPOP
Z0       AH    R1,=H'1'
         CLI   0(R1),X'00' 
         BE    OLOOPE      "OP " ALLEINE
         CLI   0(R1),C','  "OP ," (PARTNER=$DIALOG)
         BE    TESTKEY
         CLI   0(R1),C' '  "OP  " SUCHE ERSTEN BUCHSTABEN 
         BE    Z0
         CLI   0(R1),C'.'  "OP  " SUCHE ERESTEN BUCHSTABEN
         BE    Z0
OLOOPW0  EQU   *
         LR    R5,R1
         XR    R2,R2
OLOOPON  CLI   0(R1),X'00'  "OP NAME"  ALLEINE
         BE    OLOOPONE
         CLI   0(R1),C','   "OP NAME," PROZ FOLGT
         BE    OLOOPONE
         CLI   0(R1),C' '   "OP NAME " PROZ FOLGT
         BE    OLOOPONE
         CLI   0(R1),C'.'   "OP NAME." PROZ FOLGT
         BE    OLOOPONE
         AH    R1,=H'1'
         AH    R2,=H'1'
         B     OLOOPON
OLOOPONE EQU   *
         BCTR  R2,R0
         CLM   R2,B'0011',=H'8'
         BL    I10
         LH    R2,=H'7'
I10      STCM  R2,B'0001',OMVC1+1
OMVC1    MVC   OPEPN(0),0(R5)
TESTKEY  CLC   1(3,R1),=C'PW='      SOFERN HINTER "OP NAME,"
         BE    OLOOPE              DIREKT EIN KEYWORD FOLGT 
         CLC   1(2,R1),=C'T='    "T=,PW=,MSG=,PAC="
         BE    OLOOPE
         CLI   1(R1),C'*'
         BE    OLOOPE  
*        CLC   1(1,R1),=C'#'
*        BE    OLOOPE  
         CLC   1(4,R1),=C'MSG='
         BE    OLOOPE  
         CLC   1(4,R1),=C'PAC='
         BE    OLOOPE  
OLOOPPR1 AH    R1,=H'1'
         CLI   0(R1),X'00'   "OP NAME," ALLEINE
         BE    OLOOPE
         CLI   0(R1),C' '    "OP NAME "SUCHE ERSTEN BUCSTABEN VON PROZ
         BE    OLOOPPR1
         LR    R5,R1
         XR    R2,R2
         CLI   0(R1),C','    "OP NAME,," PROZ--> HOST
         BE    OLOOPE
OLOOPPR3 AH    R1,=H'1'
         AH    R2,=H'1'
         CLI   0(R1),X'00'    "OP NAME,PROZ" ALLEINE
         BE    OLOOPPR4
         CLI   0(R1),C','     "OP NAME,PROZ,"
         BE    OLOOPPR4
         CLI   0(R1),C' '     "OP NAME,PROZ "
         BE    OLOOPPR4
         CLI   0(R1),C'.'
         BE    OLOOPPR4       "OP NAME,PROZ."
         B     OLOOPPR3
OLOOPPR4 EQU   *
         BCTR  R2,R0
         CLM   R2,B'0011',=H'8'
         BL    I11
         LH    R2,=H'7'
I11      STCM  R2,B'0001',OMVC2+1
OMVC2    MVC   OPEPRO(0),0(R5)
         SH    R1,=H'1'
OLOOPE   EQU   *
         CLC   0(3,R1),=C'PW='
         BE    OLOOPPW
         CLC   0(2,R1),=C'T='
         BE    OLOOPT
         CLI   0(R1),C'*'
         BE    OLOOPST
*        CLC   0(1,R1),=C'#'
*        BE    OLOOPU 
         CLC   0(4,R1),=C'MSG='
         BE    OLOOPMSG
         CLC   0(4,R1),=C'PAC='
         BE    OLOOPPAC
         AH    R1,=H'1'
         CLI   0(R1),X'00'   ENDE
         BE    OLOOPEE 
         B     OLOOPE
OLOOPMSG MVC   LMSG(16),4(R1)   
         AH    R1,=H'4'
         B     OLOOPE
*          "PBNB,C'PBNB1234'"
OLOOPPAC MVC   PAC(4),4(R1)   
         AH    R1,=H'4'
         B     OLOOPE
*         PAC
OLOOPPW  MVC   PW(7),3(R1)   
         AH    R1,=H'3'
         B     OLOOPE
*         PW 
OLOOPT   MVC   T(8),2(R1)   
         AH    R1,=H'2'
         B     OLOOPE
*         TERMINAL
OLOOPST  MVI   ST,'Y'
         AH    R1,=H'1'
         B     OLOOPE
*         TERMINAL
OLOOPU   MVI   EDIT,'U'
         AH    R1,=H'1'
         B     OLOOPE
*         TERMINAL
OLOOPEE  EQU   *
         CLC   PW,=CL7' '
         BE    LX9
         LA    R1,PW
         LA    R2,PW+7
LX1      CLI   0(R1),X'7D'
         BE    LX3
         AH    R1,=H'1'
         CR    R1,R2
         BL    LX1
         B     LX9
LX3      AH    R1,=H'1'
         CR    R1,R2
         BL    LX4
         B     LX9
LX4      CLI   0(R1),X'7D'
         BNE   LX3
LX5      AH    R1,=H'1'
         CR    R1,R2
         BL    LX6
         B     LX9
LX6      MVI   0(R1),C' '
         B     LX5
LX9      EQU   *
         MVC   PW1,PW+2
*
         CLC   LMSG(16),=CL80' '
         BE    LE9
         LA    R1,LMSG
         LA    R2,LMSG+16
LE1      CLI   0(R1),X'7D'
         BE    LE3
         AH    R1,=H'1'
         CR    R1,R2
         BL    LE1
         B     LE9
LE3      AH    R1,=H'1'
         CR    R1,R2
         BL    LE4
         B     LE9
LE4      CLI   0(R1),X'7D'
         BNE   LE3
LE5      AH    R1,=H'1'
         CR    R1,R2
         BL    LE6
         B     LE9
LE6      MVI   0(R1),C' '
         B     LE5
LE9      EQU   *
         CLC   PAC,=CL4' '
         BE    LE19
         CLI   PAC+1,X'00'
         BE    LE10
         CLI   PAC+1,C','
         BNE   LE11
LE10     MVC   PAC+1(3),=C'   '
         B     LE19
LE11     CLI   PAC+2,X'00'
         BE    LE12
         CLI   PAC+2,C','
         BNE   LE13
LE12     MVC   PAC+2(2),=C'  '
         B     LE19
LE13     CLI   PAC+3,X'00'
         BE    LE14
         CLI   PAC+3,C','
         BNE   LE19
LE14     MVI   PAC+3,C' '
LE19     EQU   *
         CLC   T,=CL8' '
         BE    LT9
         LA    R1,T
         LA    R2,T+8
LT1      CLI   0(R1),C','
         BE    LT3
         CLI   0(R1),X'00'
         BE    LT3
         AH    R1,=H'1'
         CR    R1,R2
         BL    LT1
         B     LT9
LT3      EQU   *
LT4      MVI   0(R1),C' '
         AH    R1,=H'1'
         CR    R1,R2
         BL    LT4
LT9      EQU   *
         CLC   T,=CL8' '
         BE    LW10
         MVC   OPEAPPL,T
         B     LW11
LW10     L     R1,OPENUM
*        A     R1,=F'1'
         LA    R1,1(R1)
         ST    R1,OPENUM
         CVD   R1,DOWO
         UNPK  RES,DOWO
         MVZ   RES+8(1),=X'F0'
         MVC   OPEAPPL(2),CPNAME
         MVC   OPEAPPL+2(6),RES+3
LW11     CLC   OPEPRO,=CL8' '
         BNE   OPW1
         MVC   OPEPRO,PRONAM
OPW1     CLC   OPEPN,=CL8' '
         BNE   OPW2
         MVC   OPEPN,=CL8'$DIALOG'
OPW2     EQU   *
         CLC   OPEPN,=CL8'$DIALOG'
         BNE   OPW3
         MVC   OPETYP,=CL4'TIAM'
         B     OPW4
OPW3     EQU   *
         CLC   OPEPN,=CL8'$CONSOLE'
         BNE   OPW31
         MVC   OPETYP,=CL4'UCON'
         B     OPW4
OPW301   EQU   *
*        CLC   OPEPN,=CL8'CATS'           ** CATS
*        BNE   OPW31
*        MVC   OPETYP,=CL4'PDN '
*        B     OPW4
OPW31    EQU   *
         MVC   OPETYP,=CL4'U/D '
         CLI   EDIT,C'S'
         BE    OPW4
         MVC   OPETYP,=CL4'U/D*'
OPW4     EQU   *
         L     R4,USERPAGA
         L     R5,USERPAGE
         XR    R6,R6
LOOPOP   EQU   *
         AH    R6,=H'1'
*        A     R4,=A(X'100')
         LA    R4,256(R4)          + X'100'
         CLI   USPID+1,X'00'
         BE    GOTOPX0
         CR    R4,R5
         BL    LOOPOP
         MVC   Z2(80),=CL80' '
         MVC   Z2(37),=CL37'ZCP0005 PARTNER TABLE FULL'
         B     BACKXY
GOTOPX0  EQU   *
         MVI   USDEC,C' '
         XC    USLOE1SA(12),USLOE1SA
         XC    USLOE2SA(7),USLOE2SA
         MVC   USSEQ,=C'0000'
         MVC   USSEQSA,=C'0000'
         MVC   USKEY1,=C'0000'
GOTOP    MVC   APPNAMX,OPEAPPL
         MVI   Z3,X'00'   * KEINE CMD:*
         MVI   Z4,X'00'   * KEINE KMASK * 
         MVC   OUTPUT2(80),=CL80' '
         MVC   OUTPUT2(23),=CL23'CONNECTION REQUEST TO '
         MVC   OUTPUT2+23(8),OPEPN
         MVI   OUTPUT2+31,C'/'
         MVC   OUTPUT2+32(8),OPEPRO 
         MVC   OUTPUT2+40(5),=C',TYP='
         MVC   OUTPUT2+45(4),OPETYP
         MVC   OUTPUT2+49(9),=CL9' ACCEPTED'
         REQM  9
         CLM   R15,B'0001',=X'00'
         BE    OPREQ
         MVI   Z3,X'FF'   * CMD:*
         MVI   Z4,X'FF'   * KMASK * 
         MVC   Z2(80),=CL80' '
         MVC   Z2(26),=CL26'ZCP0002 REQM MEMORY ERROR'
         B     BACKXY
*        DS    F
*REQDUMP1 EQU   *
*         TERM  DUMP=Y,MODE=ABNORMAL
OPREQ    EQU   *  ST    R1,OPREQ-4        |
*         LTR   R1,R1
*         BZ    REQDUMP1
*        LR    R14,R1            |
*        CMD   '/D %14'           >  REQM TRACE
*        L     R1,OPREQ-4        |
*        A     R1,=A(X'16')      DCAMINPUT + 22 (FUER UCONHEAD)
         LA    R1,22(R1)         + X'16'
         ST    R1,USIN
         A     R1,=A(X'2200')    DCAMINPUT = 8704 BYTES
         ST    R1,USTERMS
         A     R1,=A(X'2200')    PARTNERSEITE = 8704 BYTES (WORKAREA)
         ST    R1,USTEXTA
         A     R1,=A(X'4A00')    BUFFER = 18944 BYTES
         ST    R1,USTEXTE        494 BYTES FREE FUER UEBERSCHREIBER
         MVC   USKEY1,=C'0000'
         YOPEN ACB=ACBCPX 
         CLM   R15,B'1001',=X'0000'
         BE    W133
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN'
         ST    R15,USRC
         MVC   USCPNAME,OPEAPPL
         MVC   USPNA,OPEPN
         MVC   USTYP,OPETYP
         STH   R6,USPID
         MVC   USPRO,OPEPRO
         MVC   USERROR,=CL15'OPEN ERROR'
         MVI   USFREE,C'F'
         MVI   Z3,X'FF'   * CMD:*
         MVI   Z4,X'FF'   * KMASK * 
         MVC   Z2(80),=CL80' '
         MVC   Z2(40),=CL40'OPEN ERROR: VIRT. STATION ALREADY USED'
         L     R6,USIN
* TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R6,12
         LTR   R6,R6
         BNZ   MCRELM8
         MVC   ERRTEXT,=CL20'A/RELM/RELM8/0'
         BAS   R14,FEHLER
         B     A07      
MCRELM8  EQU   *
         RELM  9,(R6)
         CLM   R15,B'0001',=X'00'
*        CMD   '/D %6'              REQM TRACE
         BE    A07
         MVC   ERRTEXT,=CL20'S/SCH/RELM'
         BAS   R14,FEHLER
A07      EQU   *
         B     BACKXY
W133     YSHOWCB BLK=ACB,BLKADDR=ACBCPX,WAREA=AIDCPX,LENGTH=4,         -
               FIELDS=(AID)
         CLM   R15,B'1001',=X'0000'
         BE    W45
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/YSH/CID'
         BAS   R14,FEHLER
W45      MVC   USCPNAME,OPEAPPL
         MVC   OPECON+2(8),OPEAPPL
         MVC   OPEEI+2(8),OPEAPPL
         MVC   USPRO,OPEPRO
         MVC   USAID,AIDCPX
         MVC   USCID,=F'0'
         MVC   USREF,ST
         MVC   USPNA,OPEPN
         MVC   USTYP,OPETYP
         STH   R6,USPID
         MVI   USOKZ,X'00'
         MVC   USLEN,=F'0'
         MVC   USADR1,=F'0'
         MVC   USADR2,=F'0'
         MVC   USADR3,=F'0'
         MVC   USADR4,=F'0'
         XC    USLOE1(12),USLOE1
         XC    USLOE2(7),USLOE2
         XC    USLOE3(25),USLOE3
         MVC   USRC,=F'0'
         CVD   R6,DOWO
         UNPK  RES,DOWO
         MVZ   RES+8(1),=X'F0'
         MVC   USPAC,RES+5
         CLC   PAC,=CL4' '
         BE    W120
         CLC   PAC,=X'00000000'
         BE    W120
         MVC   USPAC,PAC
W120     EQU   *
         MVC   USNEA,=XL8'3650350000000000'
         MVC   USERROR,=CL15'OPNCON STARTED'
         MVI   USFREE,C'O'
* EROEFFNEN DER VERBINDUNGEN (ASY)
         YGENCB BLK=RPB,OPTCD=(CA,Q,ACQUIRE,ASY),EID=OPEI,             -
               AAREALN=8200,TOVAL=32767
         CLM   R15,B'1000',=X'00'
         BE    W46
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/YGEN0'
         BAS   R14,FEHLER
W46      ST    R1,RPBA
         ST    R1,USRPBA
         CLC   USTYP,=C'TIAM'
         BE    W73
         CLC   USTYP,=C'U/D '
         BE    W73
         CLC   USTYP,=C'PDN '                ** CATS
         BE    W73PDN                        ** CATS
         YGENCB BLK=CCB,PTNNAME=OPEPN,PRONAME=OPEPRO,                  -
               EDIT=USER
         B     W74
W73PDN   YGENCB BLK=CCB,PTNNAME=OPEPN,PRONAME=OPEPRO,EDIT=USER,        -
               DEPROT=USER,PTNCHLN=8,APTNCH=PARTCHAR,EDITIN=LCASE,     -
               PROC=SYSCODE
         B     W74                            ** CATS
W73      YGENCB BLK=CCB,PTNNAME=OPEPN,PRONAME=OPEPRO,EDIT=DSSIM,       -
               DEPROT=USER,PTNCHLN=8,APTNCH=PARTCHAR,EDITIN=LCASE
W74      EQU   *
         CLM   R15,B'1000',=X'00'
         BE    W47
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/YGEN1'
         BAS   R14,FEHLER
W47      ST    R1,CCBA
         ST    R1,USCCBA
         ENAEI EINAMAD=OPEEI,EIIDRET=OPEI
         CLM   R15,B'1001',=X'0400'
         BE    W48
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/EINAEI'
         BAS   R14,FEHLER
W48      LA    R5,RPBA
         ENACO CONAMAD=OPECON,COADAD=OPENA,COMAD=(R5),COIDRET=OPCO,    -
               LEVEL=10
         CLM   R15,B'1001',=X'0400'
         BE    W49
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/EINACO'
         BAS   R14,FEHLER
W49      MVC   USEI,OPEI
         MVC   USCO,OPCO
         MVC   MVCF(2),USPID
         MVC   MVCF+2(2),STATTID
* AKTUELLER PARNTER WIRD ERST BEIM ERFOLGREICHEN YOPN
* VERSORGT
*        MVC   STATAKTP,USPID
*
         L     R5,CCBA
         L     R6,RPBA
         CLC   PW1,=CL4' '
         BE    W150
         L     R7,PW1
         YMODCB BLK=CCB,BLKADDR=(R5),LOGPW=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W150
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/YMOD0'
         BAS   R14,FEHLER
W150     EQU   *
*
         L     R7,MVCF
         YMODCB BLK=CCB,BLKADDR=(R5),USERFLD=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W50
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/YMOD'
         BAS   R14,FEHLER
W50      EQU   *
         CLC   LMSG(16),=CL80' '
         BE    W70
         LA    R1,LMSG
         LA    R2,LMSG+16
         XR    R7,R7
XXX      CLI   0(R1),X'00'
         BE    XX1
         AH    R1,=H'1'
         AH    R7,=H'1'
         CR    R1,R2
         BL    XXX
XX1      YOPNCON ACB=ACBCPX,CCB=(R5),RPB=(R6),AREA=LMSG,AREALN=(R7),   -
               AAREA=BN80
         B     W71
*W70      CLC   USTYP,=C'TIAM'    |
*         BNE   W70OP             |    NEU FUER BCAM V10 MUSS LMSG
*         MVC   LMSG(8),USCPNAME  >    FUER $DIALOG ANGEGEBEN WERDEN.
*         MVI   LMSG+8,X'35'      | BYTE 0-7: TERM.NAME,BYTE 8:TERM-TYP
*         LA    R7,9              |    LAENGE 9BYTES
W70      YOPNCON ACB=ACBCPX,CCB=(R5),RPB=(R6),AAREA=BN80
W71      EQU   *
         CLM   R15,B'1000',=X'00'
         BE    W51
         ST    R15,USRC
         MVC   USERROR,=CL15'OPNCON ERROR'
         MVI   USFREE,C'F'
         MVI   Z3,X'FF'   * CMD:*
         MVI   Z4,X'FF'   * KMASK * 
         MVC   Z2(80),=CL80' '
         MVC   Z2(35),=CL35'OPNCON ERROR:PARTNER NOT AVAILABLE'
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/YOPCON'
         BAS   R14,FEHLER
         L     R7,USAID
         YCLOSE AID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W201
         MVC   ERRTEXT,=CL20'S/SCH/YCLOSE'
         BAS   R14,FEHLER
W201     EQU   *
         DISEI EIID=OPEI
         DISCO COID=OPCO
         L     R7,USIN
* TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R7,12
         LTR   R7,R7
         BNZ   MCRELM9
         MVC   ERRTEXT,=CL20'A/RELM/RELM9/0'
         BAS   R14,FEHLER
         B     A09      
MCRELM9  EQU   *
         RELM  9,(R7)
         CLM   R15,B'0001',=X'00'
*        CMD   '/D %7'              REQM TRACE
         BE    A09
         MVC   ERRTEXT,=CL20'S/SCH/YCLOS/RELM'
         BAS   R14,FEHLER
A09      EQU   *
         B     BACKXY
         BAS   R14,FEHLER
W51      SOLSIG EIID=OPEI,COID=OPCO,LIFETIM=43200
         CLM   R15,B'1001',=X'0000'
         BE    BACKX
         MVC   ERRTEXT,=CL20'S/SCH/YOPEN/SOLSIG'
         BAS   R14,FEHLER
BACKX    EQU   *
         L     R15,TERMOUTA
         L     R14,=F'126'
         MVC   0(126,R15),KMASKANS
*        A     R15,=F'126'
         LA    R15,126(R15)
         MVC   Z2,OUTPUT2
         MVI   Z5,X'FF'
         MVI   Z6,X'FF'         * PAC --> SYSZ
         BAS   R13,KMASKE
W52      B     BACK
KILLPID  EQU   * 
         MVI   USDEC,C' '        * DEKL. BYTE ZURUECKGESETZT
         CLI   USFREE,C'D'       * WENN PARTNER NUR DEKL
         BNE   CLOSPID           * SONST NORMAL BEHANDLUB
         XC    USCPNAME(250),USCPNAME
         MVC   Z2(80),=CL80' '
         MVC   Z2(20),=CL20'PARTNER ERASED PAC:'
         MVC   Z2+20(4),EINPAC
         B     BACKXY
CLOSPID  EQU   *
         MVC   Z2(80),=CL80' '
         MVC   Z2(26),=CL26'PARTNER DISCONNECTED PAC:'
         MVC   Z2+25(4),EINPAC
         XR    R15,R15
         ST    R15,USRC
         MVC   USERROR,=CL15'CLOSCON STARTED'
         MVI   USFREE,C'F'
         L     R7,USAID
         YCLOSE AID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    B0     
         MVC   ERRTEXT,=CL20'S/SCH/CLS/YCLOSE'
         BAS   R14,FEHLER
B0       EQU   *
*******              AUSTRAG AUS USER-PAG-TAB
         BAS   R14,ERUSPGTB
*******
         LA    R7,USEI
         DISEI EIID=(R7)
         LA    R7,USCO
         DISCO COID=(R7)
         L     R7,USIN
* TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R7,12
         LTR   R7,R7
         BNZ   MCRELM10
         MVC   ERRTEXT,=CL20'A/RELM/RELM10/0'
         BAS   R14,FEHLER
         B     B1       
MCRELM10 EQU   *
         RELM  9,(R7)
         CLM   R15,B'0001',=X'00'
         BE    B1 
         MVC   ERRTEXT,=CL20'S/SCH/CLS/RELM'
         BAS   R14,FEHLER
B1       EQU   *
         B     BACKXY
*
BACK     MVI   STATK,X'00'
W54      EQU   *
W55      B     SCHLEIFE
SCHLEIFE EQU   *
*        L     R14,CRECCNT        |
*        LA    R14,1(R14)         >   ASYN REC ZAEHLER  (+1)
*        ST    R14,CRECCNT        |
*        C     R14,=H'1'          |   >1 ?
*        BNH   TMPCNT1            |
*        TERM  DUMP=Y,MODE=ABNORMAL
*MPCNT1  EQU   *                  |   NEIN
         L     R13,DCAMTEA
         MVC   0(10,R13),=CL80' '
         L     R14,AIDCP
         YRECEIVE RPB=RPBSYN,AAREA=(R13),AAREALN=4100,                 -
               CCB=CCBSYN,EID=TEREI,AID=(R14)
         CLM   R15,B'1000',=X'00'
         BE    W510
         MVC   ERRTEXT,=CL20'S/SCH/YREC'  
         BAS   R14,FEHLER
W510     EQU   *
         SOLSIG EIID=TEREI,COID=TERCO,LIFETIM=43200
         CLM   R15,B'1001',=X'0000'
         BE    W511
         MVC   ERRTEXT,=CL20'S/SCH/SOLSIG'
         BAS   R14,FEHLER
W511     RETCO
         DS    0H
         ENTRY SCHLEIFE
FEHLER   EQU   *
         ST    14,BRBACK
         ST    15,ERR15
         UNPK  ERRR15,ERR15(5)
         TR    ERRR15,HX-240
         WROUT ERRMSG,TERME
*        CMD   '/D %MR'
* BEI TOVAL ABGELAUFEN (CIRKA ALLE 6 STUNDEN)
* WIRD KEINE FM AUSGEGEBEN
         CLC   ERR15,=X'04001000'
         BE    TERME
*        TYPIO MSG=ERRMSG
         CLC   ERR15,=X'10040800'
         BNE   TERME
         PASS
         PASS
         PASS
         PASS
         MVC   ERRTEXT,=CL20'WAIT '
         WROUT ERRMSG,TERME
*        TYPIO MSG=ERRMSG
TERME    L     R14,BRBACK
         BR    R14
********************  AUSTRAG AUS USER-PAGING-TABELLE (INFO) *****
         DS    2F
ERUSPGTB EQU   *
         STM   R6,R7,ERUSPGTB-8
         L     R6,USPGTBA
         L     R7,=A(X'1F40')
ERUSX1   EQU   *
         CLM   R4,B'1111',1(R6)
         BE    ERUSX2
         LA    R6,9(R6)
         BCT   R7,ERUSX1
ERUSX2   EQU   *
         XC    0(9,R6),0(R6)       LOESCHEN / FREI  9BYTE
         LM    R6,R7,ERUSPGTB-8
         BR    R14
******************* EINTRAG IN DIAG-TAB ****************************
UPDIAUP1 EQU   *
         LA    R14,4(R14)
         STM   0,15,0(R14)      REGISTER VOR UP-AUFRUF (NUR 64 BYTE!!)
         B     UPDIAUPW
UPDIAUP  EQU   *
         LA    R14,4(R14)                              *DIA
         CONTXT SAVE=(R14),PROCESS=LAST                *DIA
UPDIAUPW LA    R14,68(R14)               LEN 68 BYTES  *DIA
         CL    R14,DIATABE
         BL    UPDIAUPE
         L     R14,UDIATBA
UPDIAUPE ST    R14,DIATABA      WRAP AROUND IN DIAG-TAB
         MVC   0(4,R14),=C'EEEE'    EEEE NACH LETZTEM EINTRAG
         BR    R13
***********************************  TRACE  *************************
TRACROUT EQU   *
         ST    14,BRBACK
         GDATE TOD=TRTIM
         MVC   TRBOUT+4(8),TRTIM
         MVC   TRBOUT+12(1),=C':'
         MVC   TRBOUT+13(4),USPAC
         MVC   TRBOUT+17(1),=C':'
         MVC   TRBOUT+18(8),USCPNAME
         MVC   TRBOUT+26(1),=C':'
*
         UNPK  TRCH(15),0(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+27(14),TRCH
         UNPK  TRCH(15),7(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+41(14),TRCH
         UNPK  TRCH(15),14(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+55(14),TRCH
         UNPK  TRCH(15),21(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+69(14),TRCH
         UNPK  TRCH(15),28(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+83(14),TRCH
         UNPK  TRCH(15),35(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+97(14),TRCH
         UNPK  TRCH(15),42(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+111(14),TRCH
         UNPK  TRCH(15),49(8,R2)
         TR    TRCH,TRCTAB-240
         MVC   TRBOUT+125(14),TRCH
         MVC   TRBOUT+139(1),=C':'
         MVC   TRBOUT+140(56),0(R2)
         WRLST TRBOUTL,TERME
         L     R14,BRBACK
         BR    R14
         TITLE 'E N D E '
ENDE     EQU   *
         BASR  R15,0
         USING *,R15
         TERM
         SPACE
         TITLE 'I N T R C   / INTR CONTI'
*******************************  /INTR CONTI **********************
         ENTRY FCBSEQ
INTRC    EQU   *
         BASR  R15,0
         USING *,R15
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CINT ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CINT'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
**      **
         CLC   INTRTXT(6),=C'CH-SEQ'
         BNE   INTRC1
         L     R15,CPCOPYA
         BASR  R14,R15
         B     INTRET
         EXTRN TRACE1
INTRC1   EQU   *
         CLC   INTRTXT(6),=C'TRC-ON'
         BNE   INTRC2
         SYSFL 'SYSLST=CP.TRACELIST'
         CMD   'TYPE',' %  ZCP0050 CP-TRACE: FILE CP.TRACELIST OPENED'
         L     R14,=A(TRACE1)
         USING TRACE1,R14
         MVZ   TRACE1+1(1),=X'00'
         DROP  R14
         MVZ   TRACE2+1(1),=X'00'
         MVZ   TRACE3+1(1),=X'00'
         MVZ   TRACE4+1(1),=X'00'
         B     INTRET
INTRC2   EQU   *
         CLC   INTRTXT(7),=C'TRC-OFF'
         BNE   INTRC3
         SYSFL 'SYSLST=(PRIMARY)'
         CMD   'TYPE',' %  ZCP0051 CP-TRACE: FILE CP.TRACELIST CLOSED'
         L     R14,=A(TRACE1)
         USING TRACE1,R14
         MVZ   TRACE1+1(1),=X'FF'
         DROP  R14
         MVZ   TRACE2+1(1),=X'FF'
         MVZ   TRACE3+1(1),=X'FF'
         MVZ   TRACE4+1(1),=X'FF'
         B     INTRET
INTRC3   EQU   *
         CLC   INTRTXT(6),=C'CH-LOG'
         BNE   INTRC4
         ST    R15,R15SAV
         L     R15,CPSYSFLA
         BASR  R14,R15
         L     R15,R15SAV
         B     INTRET
INTRC4   EQU   *
         CLC   INTRTXT(5),=C'SH-VT'
         BNE   INTRC41
         MVI   ITEMP,C'V'
         B     INTRC4B
INTRC41  CLC   INTRTXT(5),=C'SH-RT'
         BNE   INTRC42
         MVI   ITEMP,C'R'
         B     INTRC4B
INTRC42  CLC   INTRTXT(5),=C'SH-AP'
         BNE   INTRET
         MVI   ITEMP,C'A'
INTRC4B  EQU   *
INTNOP   NOP   INTRET
         MVI   INTNOP+1,X'F0'      INTR SH-.. CONTI GESPERRT
         POSSIG EIID=EIRETI
         MVC   IVTNAM+8(1),ITEMP
         MVC   IVTNAM(8),INTRTXT+6
         B     INTRET
INTSAV   DS    11F
INTRET   EQU   *
         MVC   INTRTXT(14),=CL80' '
         EXIT
         DS    0F
         SPACE
         TITLE 'I N F C O    / INFO CONTI'
INFCO    EQU   *
         BASR  R15,0
         USING *,R15
         CONTXT STACKR=(R8,R9,R10,R11,R12),OWNR=(R8,R9,R10,R11,R12)
         DROP  R15
** CINF ** DIAG-TAB                                    *DIA
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CINF'                     *DIA
         BAS   R13,UPDIAUP                             *DIA
**      **
         LTR   R2,R2
         BNZ   INFCORET
         L     R6,USPGTBA
         LA    R7,IVTNAM
         L     R15,CPINFA
         BASR  R14,R15
INFCORET EQU   *
         SOLSIG EIID=EIRETI,COID=IDINFCP
         MVI   INTNOP+1,X'00'      INTR SH-.. CONTI FREI
         RETCO
         DS    0F
*---------------- GLOBAL-TABELLE ----------------------------*
         DS    0F
         DC    C'*GLOBAL-TAB*'
STATANFA DS    F 
STATENDA DS    F 
SAVTABA  DS    F 
DCAMTESA DS    F
DCAMTEA  DS    F
TERMOUTA DS    F
*
USPGTBA  DS    F
UDIATBA  DS    F
DIATABA  DS    F
DIATABE  DS    F
OPEAPPL  DC    CL8'CP00000'
OPENUM   DC    F'0'
APLNAM   DC    CL8'CP01   '
PRONAM   DS    CL8
CPNAME   DC    C'CP'
VTERM    DC    C'Y'
CPVER    DC    C'V3.0AK4'
LANGUE   DC    C'D'          D=DEUTSCH / E=ENGLISH
ALLTERM  DC    C'Y'          Y=ALLE TERMINAL / N = NUR TERMINAL MIT TS
         ENTRY CPVER
         ENTRY STATANFA
         ENTRY STATENDA
         ENTRY APLNAM
         ENTRY USPGTBA     FUER MOD CPADMIN (V(KONST))
         ENTRY UDIATBA      YRECASY
         ENTRY DIATABA      YRECASY
         ENTRY DIATABE      YRECASY
         ENTRY PUTMASKE     CPBLTIN
         ENTRY LIB          CPLOGIN
         ENTRY OPENUM       CPLOGIN
         ENTRY CPNAME       CPLOGIN
*----------------- V-KONSTANTEN FUER UP'S --------------------*
CPCSTATA DC    V(CPCSTAT)
CPSYSFLA DC    V(CPSYSFL)
CPINFA   DC    V(CPINF)
CPCOPYA  DC    V(CPCOPY)
CPKMASKA DC    V(CPKMASK)
CPBUFHA  DC    V(CPBUFH)
HCPRCOA  DC    V(HCPRCO)
RECA     DC    V(YRECASY)
CPBLTINA DC    V(CPBLTIN)
CPADMINA DC    V(CPADMIN)
HCINITA  DC    V(HCINIT)
CPAUSERA DC    V(CPAUSER)
CPHELPAD DC    V(CPHELP)
CPHELPAE DC    V(CPHELPE)
CPLOGINA DC    V(CPLOGIN)
*----------------- A-KONSTANTEN CONTINGENCIES ----------------*
ALOGCP   DC    A(LOGCP)
ALOSCP   DC    A(LOSCP)
ALOSCO   DC    A(LOSCO)
INFCOA   DC    A(INFCO)
OPENA    DC    A(YOPNCON)
ENDEA    DC    A(ENDE)
TERMA    DC    A(TERM)
*------------------------------------------------------------*
COGAGA   DC    F'0'
R15SAV   DC    A(0)
BRBACK   DS    F
         DS    0D
LOCKTIM1 DC    PL8'0'
LOCKTIM  DS    F
CPUTIM   DC    CL6'000100'       1 MIN
CREQTIM  DS    D
*CRECCNT  DC    F'0'         TEMP ZAEHLER ASYN REC
         DS    0F
TRCTAB   DC    C'0123456789ABCDEF'
TRTIM    DS    CL8
TRCH     DS    CL16
         DS    0F
TRBOUTL  DC    Y(TRBOUTLE-TRBOUTL)
         DS    CL2
         DC    X'01'
TRBOUT   DS    CL196
TRBOUTLE EQU   *
         DS    0F
INTRTXT  DS    CL14
         DS    0F
FSBER1   DS    CL10
         DS    0F
OPEEI    DC    CL10'OP'
OPECON   DC    CL10'EI'
IVTNAM   DS    CL9
ITEMP    DS    CL1
         DS    0F
OPEPRO   DS    CL8
T        DS    CL8
MVCF     DS    F
FDBKOP   DS    F
MVCFOP   DS    F
RPBA     DS    F
CCBA     DS    F
OPEPN    DS    CL8
OPEPAC   DS    CL4
OPETYP   DS    CL4
OPCID    DS    F
         DS    0F
ACBCP    YACB  APPNAME=APLNAM,ATTR=(LOGON),ENB=ENBCP,                  -
               PRONAME=PRONAM,DCAMVER=8.0,LINK=APLNAM
ENBCP    YENB  LOGON=IDLOGCP,LOSCON=IDLOSCP,COMEND=IDENDECP
X6SAVL   DS    F
EIRETI   DS    F
IDINFCP  DS    F
EIIDHC   DS    F
IDHCOCP  DS    F
         ENTRY EIIDHC
         ENTRY IDHCOCP
IDENDECP DS    F
AIDCP    DS    F
AIDCPX   DS    F
EINPAC   DS    F
RES1     DS    CL9
         DS    0F
ENANUM   DC    F'0'
EINAMOP  DC    CL8'EI000000'
DOWO     DS    D
DOWO1    DS    D
RES      DS    CL9
         DS    0F
PARA     DS    0F
PAR1A    DS    F
IDLOGCP  DS    F
RPBAOP   DS    F
SAV4     DS    F
SAV3     DS    F
CCBOP    DS    F
CCBYR    DS    F
FDBKSY   DS    F
CIDLOG   DS    F
IDLOSCP  DS    F
IDLOSCO  DS    F
*TERA     DC    A(TERMNEU)
PNAMLOG  DS    CL8
PROLOG   DS    CL8
ENDTLE   DC    Y(ENDTTE-ENDT1)
ENDT1    DC    X'10401B206140404562540040000041212798279827981ED81DC8'
         DC    C'ZCP0030 CP NORMAL END'
ENDTTE   EQU   *
KMASKAN1 DC    X'26401B206140404562540040000041'
         DC    X'004040404048000021'
         DC    X'1B206148400000004040000000'    PAR00D   ANZ-ZEILE
         DC    X'21278227821ED81DC8'
KMASKANF DC    X'1E401B20614040456254004000004121'
         DC    X'1B206148400000004040000000'    PAR00D   ANZ-ZEILE
         DC    X'21278227821ED81DC8'
KMASKANS DC    X'1E401B20614040456254004000004121'
         DC    X'1B20614840000000404100000021'  PAR00D   SYS-ZEILE
         DC    X'2740817CD7'             LADEN SYSTEMZEILE MIT PAC
         DC    X'1D7C'         HELL
         DC    C'LTG'
         DC    CL52' '
         DC    C'TAST'                   * LEN 126
         DC    CL17' '
PACSYSZ  DC    CL4' '      =+112
         DC    X'19'
         DC    X'278227821ED81DC8'
*KMASKANF DC    X'10401B20614040456254004000000021278227821ED81DC8'
* PAG ANGABEN (WAR-ZEICHEN IN 1.2C00 OFFENSICHTLICH IMMER NOCH
* FALSCH)
*KMASKANF DC    X'0A484566540040000000278227821DC81ED8'
* MIT DIESEM NACHRICHTEN KOPF WURDEN DIE LA TASTEN GELOESCHT
* DA DURCH VERWENDUNG VON NK + PARAM0 DIE RESTLICHEN BEREICHE GELOESCHT
* WERDEN
*
         ENTRY KMASKANF
Z3       DS    CL1
Z4       DS    CL1
Z5       DS    CL1
Z6       DC    XL1'00'
KILL     DS    CL1
ESCSAV   DC    XL3'C927D5'    ESCN WENN KEINE PTASTE DEFINIERT
Z1       DS    CL80
Z2       DS    CL80
OUTPUT2  DC    CL80' '
OUTPUT   DC    CL26' '
OUTPUT1  DC    X'2791'  PROG BETRIEB EIN
* LAENGE NEU = 27
         DC    X'2740'   P16
ESCN     DC    X'C9'     P16    VOREINSTELL
         DC    X'27D5'   K7 (ESC N)
         DC    X'2791'  PROG BETRIEB AUS
         DC    X'2791'  PROG BETRIEB EIN
         DC    X'2740'   P17
ESCO     DC    X'D1'     P17    VOREINST
         DC    X'27D6'   K8 (ESC O)
         DC    X'2791'  PROG BETRIEB AUS
         DC    X'2791'  PROG BETRIEB EIN
         DC    X'2740'   P18
ESCW     DC    X'D2'     P18    VOREINST
         DC    X'276F'   K9 (ESC ?)
         DC    X'2791'  PROG BETRIEB AUS
*        DC    X'2784'   LSP
*        DC    X'2798'   LZE
*        DC    X'2784'   LSP
OUTPUTUC DC    X'10401B20614040456254004000004121278427981ED7'
OUTPUT11 DC    CL26'ZCP0000 CONNECTED WITH CP '
CPVER2   DC    C'VX.XXXX'
         DC    CL47' '
         DC    X'2798'   LZE
EDIT     DC    C'S'
ST       DC    C'N'
         DS    0H
BL       DC    C' '
         ENTRY OUTPUT1
*RPBLOG   YRPB  CCB=CCBLOG,OPTCD=(NQ,ANY,SYN,NTACK)
*CCBLOG   YCCB  PTNNAME=PNAMLOG,PRONAME=PROLOG,EDIT=SYSTEM,             -
*               EDITOUT=PHYS,EDITIN=(PHYS,LCASE)
USERFLD  DS    F
RPBCLOS  YRPB
RPBSYN   YRPB  CCB=CCBSYN,OPTCD=(ASY,Q,ANY,ACCEPT),TOVAL=32767,        -
               EID=TEREI,ACB=ACBCP
CCBSYN   YCCB  EDIT=SYSTEM,EDITIN=(PHYS,LCASE),EDITOUT=PHYS
ACBCPX   YACB  APPNAME=APPNAMX,ATTR=(NLOGON),DCAMVER=8.0,ENB=ENBX
ENBX     YENB  LOSCON=IDLOSCO
APPNAMX  DS    CL8
         DS    0F
PARTCHAR DS    0CL8
PARTTYP  DC    X'01'
STATTYP  DC    X'35'
ZEICH    DC    X'A0'
ZUSGR    DC    X'00'
ZEILL    DC    X'0050'
ZEILZ    DC    X'18'
ZUINFO   DC    X'00'
         DS    0F
EIDK     DS    F
OPCO     DS    F
OPEI     DS    F
TECO     DS    F
TEEI     DS    F
YOPCO    DS    F
YOPEI    DS    F
TEREI    DS    F
TERCO    DS    F
REECON   DC    CL10'RO'
REEEI    DC    CL10'RE'
         DS    0F
LMSG     DS    CL16
PAC      DS    CL4
PW       DS    CL7
         DS    0F
PW1      DS    F
REEI     DS    F
RECO     DS    F
SCHALT   DC    C'A'
         DS    0F
OPNMES   DS    CL11
NRTLEN   DS    F
         DS    0F
** ------------------ TERMLIB-SATZ
* MUSS IDENTISCH MIT LODAT AUS CPLOGIN SEIN !!!!!
LODAT    DS    F
LOPAC    DS    CL4
LOPRO    DS    CL8
LOTERM   DS    CL8
LOMSG    DS    CL16
         ORG   LOMSG+5
LOFREE   DS    CL1
LOADM    DS    CL1
         ORG   LOMSG+16
LOPASS   DS    CL7
LOPAR    DS    CL8
LOTYP    DS    CL4
         DS    CL1
LOSEQ    DS    CL4
LOREF    DS    CL1
LOFREEX  DS    CL50 
** -------------------------------
LD1FILE  DS    CL25
         DS    0F
SEQ      DC    CL54' '       SEQ-DATEI
         ENTRY SEQ
FCBSEQ   FCB   FCBTYPE=ISAM,RECFORM=V,OPEN=INPUT,EXIT=FCBSEQEX,        -
               RECSIZE=88,FILE=X,KEYARG=SEKEY,KEYPOS=5,KEYLEN=8
         ORG   FCBSEQ
         IDFCB ,F 
         ORG
FCBSEQEX EXLST NOFIND=C200
         ENTRY FCBSEQ          YRECASY
         EXTRN SEKEY
         EXTRN C200            YRECASY
TRANST   DC    X'000102030405060708090A0B0C0D0E0F'
         DC    X'101112131415161718191A1B1C1D1E1F'
         DC    X'202122232425262728292A2B2C2D2E2F'
         DC    X'303132333435363738393A3B3C3D3E3F'
         DC    X'404142434445464748494A4B4C4D4E4F'
         DC    X'505152535455565758595A5B5C5D5E5F'
         DC    X'606162636465666768696A6B6C6D6E6F'
         DC    X'707172737475767778797A7B7C7D7E7F'
         DC    X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F'
         DC    X'90D1D2D3D4D5D6D7D8D9DA9B9C9D9E9F'
         DC    X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF'
         DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'
         DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'
         DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'
         DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'
         DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'
         DS    0F
TRASCII  DC    X'00010203372D2E2F1605250B0C0D0E0F'   ASCII -> EBCDIC
         DC    X'101112133C3D322618193F271C1D1E1F'
         DC    X'405A7F7B5B6C507D4D5D5C4E6B604B61'
         DC    X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
         DC    X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
         DC    X'D7D8D9E2E3E4E5E6E7E8E9BBBCBD6A6D'
         DC    X'4A818283848586878889919293949596'
         DC    X'979899A2A3A4A5A6A7A8A9FB4FFDFF07'
         LTORG
OUT15    DS    L9
ERR15    DS    F
ERRMSG   DC    Y(ERRMSGE-ERRMSG)
         DC    C'   %  ZCP0006 CP-ERROR AT:'
ERRTEXT  DS    CL20
         DC    C'  RC:'
ERRR15   DS    L9
ERRMSGE  EQU   *-1
         ORG
ZCP3MSG  DC    Y(ZCP3MSGE-ZCP3MSG)
         DC    C'   CP-'
CPVER4   DC    C'VX.XXXX'
         DC    C'  PREFIX:'
CPNAMED  DC    C'XX'
         DC    C'  LAN:'
CPLAN    DC    C'X'
         DC    C'  TERM-MSG:'
CPVT     DC    C'X'
         DC    C'  ALLTERM:'
CPALL    DC    C'X'
         DC    C'  LIB:'
LIB      DC    CL45' '
         DC    C'  SEQ:'
CPSEQ    DC    CL54' '
ZCP3MSGE EQU   *
TEXT1    DC    X'1ED81D7C'
         DC    CL41'PAC  PARTNER  STATION  HOST     TYPE TEXT'
         DC    CL32'                        CP-MENU '
CPVER3   DC    C'VX.XXXX'
         DC    X'1ED81DC8'
*        DC    X'2798'   LZE
HX       DC    C'0123456789ABCDEF'
BN80     DS    CL80
         EJECT
*---------------------------------------------------------------------*
*        D S E C T ' S                                                *
*---------------------------------------------------------------------*
** STATION-ENTRY
         STATEIN
         EJECT
** USER-ENTRY
         USEREIN
*STATEIN  DSECT          (STATIONEINTRAG 1 FUER TERMINAL)
*STATPNA  DS    CL8      H1500350
*STATPRO  DS    CL8      V217H15
*STAIDCP  DS    F        AID --> CP
*USERPAGA DS    F        A(ANFANG BUFFERSEITE FUER PARTNERVERWALTUNG)
*USERPAGE DS    F        A(ENDE BUFFERSEITE)
*TERMTYP  DS    F        X'00000000'
*STATCID  DS    F        CID FUER TERMINAL --> CP
*STATAKTP DS    H        AKTUELLER PID
*STATTID  DS    H        TID FUER TERMINAL X'00000001'
*STATZZ   DS    CL1      X'00'
*STATK    DS    CL1      AUSLOESUNG DER DUE               
*STATK10  EQU   X'10'          K-TASTE GEDRUECKT
*STATK00  EQU   X'00'          NORMAL DUE
*STATRPBA DS    F
*STATCCBA DS    F
*STATEI   DS    F        EVENT ID FOR STATION
*STATRPB1 DS    F
*STATSTOP DS    0F       SOLSIG KZ
*         DS    H
*STATSTFF EQU   X'FF'          SOLSIG IN USE        IN CPBUFH
*STATST00 EQU   X'00'          SOLSIG NOT IN USE    IN CPBUFH
*STASTPID DS    H
*STATFREE DS    CL1      OPEN COMMAND FUER BENUTZER  (AUS TERMLIB)  
*STATFREY EQU   'Y'            OPEN COMMAND ALLOWED
*STATFREN EQU   'N'            OPEN COMMAND NOT ALLOWED
*STATADM  DS    CL1      ADMINISTRATOR FUNCTION
*STATADMY EQU   'Y'            ADMINISTRATOR          
*STATADMN EQU   'N'            NORMAL USER
*STATPW   DS    CL8
*STAPWSAV DS    CL8      PW SAVE AUS LIB
*STATDEV  DS    CL8      DEVICE NAME FUER HC
*STATFORM DS    CL8      FORMULAR NAME FUER HC
*STATHCPG DS    F        3 SEITEN FUER HC UND SO
*STATHCTY DS    CL1      CHARS/LINE FUER HC-DRUCKER      
*STATHCTP EQU   'P'           DRUCKER MIT 80 CHAR/LINE
*STATHCTN EQU   'N'           DRUCKER KANN 82 CHAR/LINE
*STATCLK  DS    F        CLOCK TIME LAST ENTRY
*STATVT   DS    CL8      VTNAME AUS OPNCON
*STATANM  DS    CL1      LOGIN- ODER PW-MWNU  
*STATANMA EQU   X'FF'         ANMELDEMENU (LOGIN)
*STATANMP EQU   X'00'         PASSWORTMENU
*STATFUTU DS    CL3      ####### FOR FUTURE USE #####
*USEREIN  DSECT          (PARTNEREINTRAG 1 FUER YOPNCON)
*USCPNAME DS    CL8      CP000001
*USPRO    DS    CL8      V217H21
*USAID    DS    F        AID --> CP00001
*USCID    DS    F        CID FUER CP00001 -- > CP
*USPNA    DS    CL8      $DIALOG
*USTYP    DS    CL4      TYP OF PARTNER 
**USTYPD   EQU   'U/D '        PARTNER IST UTM ODER DCAM
**USTYPT   EQU   'TIAM'        PARTNER IST TIAM-APPL. ($DIALOG ETC)
**USTYPU   EQU   'UCON'        PARTNER IST $CONSOLE
**USTYPP   EQU   'PDN '        PARTNER IST PDN-APPL.  (CATS  ETC)
*USPID    DS    H        PID X'01'
*USREF    DS    CL1      REFRESH GEWUENSCHT ?                        
*USREFY   EQU   'Y'           JA   - REFRESH DURCH CP
*USREFN   EQU   'N'           NEIN - K3 / KDCLAST
*USOKZ    DS    CL1      USED IN CPBUFH
*USOKZV   EQU   X'00'         ACTCELL VOR FRECELL
*USOKZN   EQU   X'10'         ACTCELL NACH FRECELL
*USTEXTA  DS    F        A(ANFNANG BUFFER FUER YRECEIVE)
*USTEXTE  DS    F        A(ENDE BUFFER FUER YRECEIVE)
*USTERMS  DS    F        A(ANFANG BUFFER FUER TERMINAL/PARTNERSEITE)
*USIN     DS    F        A(DCAM INPUT)
*USLEN    DS    F        A(DCAM LAENGE)
*USADR1   DS    F    *
*USADR2   DS    F    * 
*USADR3   DS    F    *
*USADR4   DS    F    *
*USPAC    DS    CL4      PAC DES PARTNERS
*USNEA    DS    CL8      NEABT-PROT
**   -->*<-- WIRD VOM MODUL VERSORGT UND GEFLEGT
*USRES    DS    F        REASON  X'00000001' --> ASY YRECEIVE EINGETROF N
**                               X'00000002' --> ACK VON TERMINAL
**                               X'00000003' --> NEUAUFBAU VON GEWUENSCH
** REG 1 -- > STATIONSTABELLENEINTRAG
** REG 2 -- > PARTNERTABELLEN EINTRAG
** BEI REASON 1 / BUFFERVERWALTUNG / TERMINALBUFFERVERWALTUNG / 
** YSEND AUF TERMINAL SOFERN AKTUELLER PID = YRECEIVE / VERSORGUNG USACK
** BEI REASON 2 / BUFFERVERWALTUNG / TERMINALBUFFERENTWERTUNG /
** YSEND AUFS TERMINAL
** BEI REASON 3 / VERSORGUNG USACK ?
** YSEND AUFS TERMINAL
*USRC     DS    F
*USERROR  DS    CL15
*USFREE   DS    CL1
*USFREED  EQU   'D'          AKT PARTNER DECLARED (AUCH BEI DURCHLAUFEN
**                           DISCON ROUTINE)
*USFREEF  EQU   'F'          AKT PARTNER DISCON
*USFREEO  EQU   'O'          AKT PARTNER NOCH NICHT VERBUNDEN
*USFREE#  EQU   ':'          PARTNER AKTIV
*USFREEY  EQU   'Y'          OPNCON ERFOLGREICH
*USCO     DS    F
*USEI     DS    F
*USRPBA   DS    F
*USCCBA   DS    F
*USLOE1   DS    CL16
*USLOE2   DS    CL7 
*USLOE3   DS    CL25
*USSEQ    DS    F
*USKEY1   DS    F
*USSEQSA  DS    F
*USDEC    DS    CL1     STATUS OF PAC
*USDECD   EQU   'D'          DECLARED
*USDECND  EQU   ' '          NOT DECLARED (CONNECTED) 
*USLOE1SA DS    CL16
*USLOE2SA DS    CL7
*         DS    CL20
*USTATPNA DS    CL8
*USTATPRO DS    CL8
*USTATVT  DS    CL8    VT-NAME AUS STATVT
         END