Yrecasy

Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
Wechseln zu: Navigation, Suche
YRECASY  CSECT RESIDENT
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS AG  1988                                   *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
         PRINT NOGEN,BASE
* RELM AUF ADDR0 UEBERPRUEFEN
** V3.0AK4
* CDUMP USFREE ENTFERNT
** V3.0A00
* RELM AUF 9 SEITEN AENDERN WEGEN SAP 8-K NACHRICHTEN. SIEHE MCP002.
** V2.1B10
*----------------------------------------------------------------------*
****     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
YRECASY  AMODE ANY
YRECASY  RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
*        E X T R N  S                                                 *
*---------------------------------------------------------------------*
         EXTRN TERMOUTA
         EXTRN UDIATBA
         EXTRN DIATABE
         EXTRN FCBSEQ
         EXTRN DIATABA
         EXTRN STATANFA
         EXTRN STATENDA
         EXTRN KMASKANF
         EXTRN DIATABA
         EXTRN Z2
         EXTRN Z3
         EXTRN Z4
         EXTRN Z5
*---------------------------------------------------------------------*
         TITLE 'Y R E C A S Y   / ASYN REC VON PARTNER/$DIALOG'
YRANF    BASR  R8,0
         BCTR  R8,0
         BCTR  R8,0
         LR    R5,R1           R1  COMAD =RPBADRESS
*                              R3  EIDREF = USPID/STATTID
         USING YRANF,R8,R9,R10,R11
         LA    R1,4095
         LA    R9,1(R8,R1)
         LA    R10,1(R9,R1)
         LA    R11,1(R10,R1)
         USING STATEIN,R3
         USING USEREIN,R4
** CYRE ** DIAG-TAB                                    *DIA
         L     R12,=A(DIATABA)
         USING DIATABA,R12
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'CYRE'                     *DIA
         BAS   R13,YUPDIAUP                            *DIA
**      **
         ST    R3,MVCFYR
         MVI   MVCFYR,X'00'
         ST    R5,RPBAYR
         YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=FDBKYR,LENGTH=4,           -
               FIELDS=(FDBK)
         L     R15,FDBKYR
         CLM   R15,B'1000',=X'00'
         BE    W1     
         CLM   R15,B'1000',=X'08'
         BNE   FDBKN08
         CLM   R15,B'0100',=X'40'  * SOFERN ANW.ZUST FALSCH Z.B YCLOSE
         BL    W7                  * SOFORT AUF RETCO
FDBKN08  EQU   *
         MVC   YERRTEXT,=CL20'A/YREC/FDBK'
         BAS   R14,YFEHLER
         L     R15,FDBKYR               * FBK WIRD NEU GELADEN SONST
*                                         FOLGENDE ABFRGAE FALSCH
         CLM   R15,B'1010',=X'0410'     * SOFERN TOVAL ABGE
         BE    W2                       * WIRD NEUER YREC ABGESETZT
         B     W7                       * SONST RETCO
W1       YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=MVCFYR,LENGTH=4,           -
               FIELDS=(USER)
         CLM   R15,B'1001',=X'0000'
         BE    W2     
         MVC   YERRTEXT,=CL20'A/YREC/USER'
         BAS   R14,YFEHLER
W2       EQU   *
W3       XR    R5,R5
         XR    R6,R6
         LH    R5,MVCFYR+2        (STATTID)
         LH    R6,MVCFYR          (USPID)
         L     R12,=A(STATANFA)
         USING STATANFA,R12
         L     R3,STATANFA
         L     R12,=A(STATENDA)
         USING STATENDA,R12
         L     R4,STATENDA
YRELOOP  EQU   *
*        A     R3,=A(X'100')
         LA    R3,256(R3)        + X'100'
         CLM   R5,B'0011',STATTID
         BE    YREGOT
         CR    R3,R4
         BL    YRELOOP
         RETCO
YREGOT   EQU   *
         L     R4,USERPAGA
         L     R5,USERPAGE
YREPOP   EQU   *
*        A     R4,=A(X'100')
         LA    R4,256(R4)         + X'100'
         CLM   R6,B'0011',USPID
         BE    YRTOP
         CR    R4,R5
         BL    YREPOP
         RETCO
YRTOP    EQU   *
* SOFERN DAVOR KEINE ORDENTLICH MELDUNG (D.H USFREE <> : ODER Y)
* WIRD YRECASY VERWORFEN
         CLI   USFREE,C':'
         BE    C777
         CLI   USFREE,C'Y'
         BE    C777
         MVC   YERRTEXT,=CL20'A/YREC/USFRE'
         MVC   YERRTEX1(8),STATPNA        EINTRAG STATION BEI ERR
         MVC   YERRTEX1+10(8),USPRO           "   PROZ.    "   "
         MVC   YERRTEX1+20(8),USPNA            "   ANWEND   "   "
         MVC   YERRTEX1+30(1),USFREE           "   BELEGUNG "   
*        CDUMP
         BAS   R14,YFEHLER       ^ DYN.DUMP BEI NACHR.+FREIG.
         RETCO
C777     CLC   FDBKYR,=X'04001000'     * SOFERN TOVAL ABGE
         BE    YRNOS                     SETZE NEUEN YREC AB
         L     R5,USRPBA
         YSHOWCB BLK=RPB,BLKADDR=(R5),WAREA=YRLEN,LENGTH=4,            -
               FIELDS=(ARECLN)
         CLM   R15,B'1000',=X'00'
         BE    W4      
         MVC   YERRTEXT,=CL20'A/YREC/ARECLN'
         BAS   R14,YFEHLER
W4       EQU   *
         L     R2,USIN
         MVC   USNEA,0(R2)
         MVC   USLEN,YRLEN
         MVC   YREEI,USEI
         MVC   YRECO,USCO
         MVC   USRC,=F'0'
         MVC   USERROR,=CL15'RECEIVE   '
         MVI   USFREE,C':'
         L     R2,STAIDCP
         L     R6,STATCID
         L     R7,YRLEN
         L     R14,USIN
         CLI   FDBKYR,X'00'           * SOFERN FDBKYR IO 
         BE    YRW0                      LETS GO !
         MVC   USERROR,=CL15'RECEIVE ERROR'
         MVI   USFREE,C'F'
         MVC   USRC,FDBKYR
         L     R7,USAID
         YCLOSE AID=(R7)
         CLM   R15,B'1001',=X'0000'
         BE    W202
         MVC   YERRTEXT,=CL20'A/YREC/YCLOSE'
         BAS   R14,YFEHLER
W202     EQU   *
         LA    R7,USEI
         DISEI EIID=(R7)
         LA    R7,USCO
         DISCO COID=(R7)
         L     R7,USIN
*        CLI   STATSTOP,X'FF'     WARTEN AUF GO-SIGNAL IN CPBUFH ??
*        BNE   CCNGO
*        CLC   STASTPID(2),USPID  MIT DIESEM PID ???
*        BE    A01                DANN DARF NICHT FREIGEGEBEN WERDEN
*CCNGO    EQU   *
* TEXTPAGE WIRD FREIGEGEBEN (SIEHE REQM)
         SRA   R7,12
*         LTR   R7,R7
*         BNZ   NODUMP7
*         TERM  DUMP=Y,MODE=ABNORMAL
*NODUMP7  EQU   *
         LTR   R7,R7
         BNZ   YRELM1
         XR    R15,R15
         MVC   YERRTEXT,=CL20'A/YREC/RELM/0'
         BAS   R14,YFEHLER
         B     A01
YRELM1   EQU   *
         RELM  9,(R7)
         CLM   R15,B'0001',=X'00'
*        CMD   '/D %7'            REQM TRACE
         BE    A01
         MVC   YERRTEXT,=CL20'A/YREC/RELM'
         BAS   R14,YFEHLER
A01      EQU   *
         L     R12,=A(TERMOUTA)
         USING TERMOUTA,R12
         L     R15,TERMOUTA
         L     R14,=F'38'
         L     R12,=A(KMASKANF)
         USING KMASKANF,R12
         MVC   0(38,R15),KMASKANF
*        A     R15,=F'38'
         LA    R15,38(R15)        + 38
         L     R12,=A(Z2)
         USING Z2,R12
         MVI   Z2,X'FF'
         L     R12,=A(Z3)
         USING Z3,R12
         MVI   Z3,X'FF'
         L     R12,=A(Z4)
         USING Z4,R12
         MVI   Z4,X'FF'
         L     R12,=A(Z5)
         USING Z5,R12
         MVI   Z5,X'FF'
         BAS   R13,YKMASKE
         B     W7
*
YRW0     EQU   *
* SPRUNG MIT RESON = 1 (FUER ASY REC)
*  TRACE *********************
TRACE1   B     TRACE1E           B / NOP
         MVC   TRBOUT(4),=C'IN :'
         L     R2,USIN
         BAS   R14,YTRACOUT
TRACE1E  EQU   *
         CNOP  0,4
         ENTRY TRACE1
*  TRACE *********************
         MVC   USRES,=F'1'
         ST    R15,YR15SAV
** UBUF ** DIAG-TAB                                    *DIA
         L     R12,=A(DIATABA)
         USING DIATABA,R12
         L     R14,DIATABA                             *DIA
         MVC   0(4,R14),=CL4'UBUF'                     *DIA
         BAS   R13,YUPDIAUP                            *DIA
**      **
         L     R15,YCPBUFHA
         BASR  R14,R15
         L     R15,YR15SAV
         B     YRNOS
         DS    0F
YR15SAV  DS    F
YCPBUFHA DC    V(CPBUFH)
**----------------------------   AB INS MOD
**----------------------------   AB INS MOD
YRNOS    EQU   *
         L     R2,USIN
         L     R5,USRPBA
         LA    R6,USEI
         L     R7,USAID
         L     R14,USCID
         CLC   USSEQ,=C'0000'
         BE    C300 
         CLC   USTYP,=C'UCON'    
         BE    C120
         CLC   USTYP,=C'U/D '
         BE    C100
         CLC   USTYP,=C'PDN '             ** CATS
         BE    C100
         CLI   USNEA,X'33'
         BE    C100
         CLI   USNEA,X'37'
         BE    C100
         B     C300
C100     MVC   SEKEY(4),USSEQ
         MVC   SEKEY+4(4),USKEY1
         L     R12,=A(FCBSEQ)
         USING FCBSEQ,R12
         GETKY FCBSEQ,SEDAT
         GET   FCBSEQ,SEDAT
         CLC   USSEQ(4),SEKEY
         BNE   C200
         MVC   USKEY1,SEKEY+4
         MVC   SENDCMD,USNEA
         MVC   SENDCMD1,SECMD
         XI    SENDCMD,X'20'
         XR    R13,R13
         LH    R13,=H'7'
         AH    R13,SELEN
         CLI   SENDCMD,X'00'
         BE    C101
         CLI   SENDCMD,X'01'
         BE    C101
         CLI   SENDCMD,X'11'
         BE    C101
         CLI   SENDCMD,X'13'
         BE    C101
         CLI   SENDCMD,X'15'
         BE    C101
         CLI   SENDCMD,X'17'
         BE    C101
*        CLI   SENDCMD,X'16'
* AUF USER WRITE X'36' WIRD MIT X'41' GEANTWORT (GEN BEI DCAM)
*        BNE   C101
         MVI   SENDCMD,X'41'
C101     L     R14,USCID
         YSEND RPB=(R5),AREA=SENDCMD,AREALN=(R13),AID=(R7),CID=(R14)
         CLM   R15,B'1001',=X'0000'
         BNE   C900
* USNEA WIRD MIT ASYN NACHRICHT VORBELEGT
         MVI   USNEA,X'36'
*
         B     C300
C900     MVC   YERRTEXT,=CL20'A/YREC/YSEN/SEQ'
         BAS   R14,YFEHLER
         B     C200
C120     MVC   SEKEY(4),USSEQ
         MVC   SEKEY+4(4),USKEY1
         L     R12,=A(FCBSEQ)
         USING FCBSEQ,R12
         GETKY FCBSEQ,SEDAT
         GET   FCBSEQ,SEDAT
         CLC   USSEQ(4),SEKEY
         BNE   C200
         MVC   USKEY1,SEKEY+4
         MVC   SENDCMD1,SECMD
         XR    R13,R13
         LH    R13,SELEN
         SH    R13,=H'12'
C121     L     R14,USCID
         YSEND RPB=(R5),AREA=SENDCMD1,AREALN=(R13),AID=(R7),CID=(R14)
         CLM   R15,B'1001',=X'0000'
         BE    C300
         MVC   YERRTEXT,=CL20'A/YREC/YSEN/SEQ/UC'
         BAS   R14,YFEHLER
         B     C200
C200     MVC   USSEQ,=C'0000'         !!!!!!!!!!!!!!!!
         MVC   USKEY1,=C'0000'
*
         ENTRY C200    MCP002  !!!!!!!!!!!!!
C300     EQU   *
         L     R14,USCID
         YRECEIVE RPB=(R5),AAREA=(R2),EID=(R6),AID=(R7),CID=(R14)
         CLM   R15,B'1000',=X'00'
         BE    W6
         MVC   YERRTEXT,=CL20'A/YREC/YREC'
         BAS   R14,YFEHLER
W6       LA    R7,USCO
         SOLSIG EIID=(R6),COID=(R7),LIFETIM=43200
         CLM   R15,B'1001',=X'0000'
         BE    W7
         MVC   YERRTEXT,=CL20'A/YREC/SOLS'
         BAS   R14,YFEHLER
*
W7       RETCO
         SPACE
*---------------------------------  FEHLER  ------------------------*
YFEHLER  EQU   *
         ST    14,YBRBACK
         ST    15,YERR15
         UNPK  YERRR15,YERR15(5)
         TR    YERRR15,YHX-240
         WROUT YERRMSG,YTERME
         MVC   YERRTEX1,=CL32' '              FELD LOESCHEN
* BEI TOVAL ABGELAUFEN (CIRKA ALLE 6 STUNDEN)
* WIRD KEINE FM AUSGEGEBEN
         CLC   YERR15,=X'04001000'
         BE    YTERME
         CLC   YERR15,=X'10040800'
         BNE   YTERME
         PASS
         PASS
         PASS
         PASS
         MVC   YERRTEXT,=CL20'WAIT '
         WROUT YERRMSG,YTERME
YTERME   L     R14,YBRBACK
         BR    R14
*------------------ EINTRAG IN DIAG-TAB ----------------------------*
YUPDIAUP EQU   *
         LA    R14,4(R14)
         STM   0,15,0(R14)      REGISTER VOR UP-AUFRUF (NUR 64 BYTE!!)
         LA    R14,68(R14)               LEN 68 BYTES  *DIA
         L     R12,=A(DIATABE)
         CL    R14,0(R12)
         BL    YUPDIAUE
         L     R12,=A(UDIATBA)
         L     R14,0(R12)       TABANFANG
YUPDIAUE EQU   *
         L     R12,=A(DIATABA)  AKT. POINTER DIAGTAB
         ST    R14,0(R12)       WRAP AROUND IN DIAG-TAB
         MVC   0(4,R14),=C'EEEE'    EEEE NACH LETZTEM EINTRAG
         BR    R13
         DROP  R12
*---------------------------------  KMASKE  ------------------------*
         DC    3A(0)
YKMASKE  EQU   *
         ST    R13,YKMASKE-4    SAVEN
         ST    R7,YKMASKE-8
         ST    R2,YKMASKE-12
         L     R13,YKMASKA
         BASR  R7,R13
         LTR   R15,R15   <> 0       FEHLER GES. IN MODUL CPKMASK??
         BZ    YKMASKEE
         BAS   R14,YFEHLER
YKMASKEE L     R13,YKMASKE-4
         L     R7,YKMASKE-8
         L     R2,YKMASKE-12
         BR    R13
         DS    0F
*----------------------------------  TRACE  ------------------------*
YTRACOUT EQU   *
         ST    14,YTRACOUT-4
         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,YTRACEE
YTRACEE  L     R14,YTRACOUT-4
         BR    R14
         SPACE
*-------------------------------------------------------------------*
*  DEFINITIONEN                                                     *
*-------------------------------------------------------------------*
         DS    0F
YKMASKA  DC    V(CPKMASK)        CPKMASK
MVCFYR   DS    F
RPBAYR   DS    F
FDBKYR   DS    F
YRLEN    DS    F
YRECO    DS    F
YREEI    DS    F
*-- FEHLER ---*
YBRBACK  DC    A(0)     SAVE
YERR15   DS    F
         DS    0F
YHX      DC    C'0123456789ABCDEF'
         DS    0F
YERRMSG  DC    Y(YERRMSGE-YERRMSG)
         DC    C'   %  ZCP0006 CP-ERROR AT:'
YERRTEXT DS    CL20
         DC    C'  RC:'
YERRR15  DS    L9
YERRTEX1 DC    CL32' '
YERRMSGE EQU   *-1
         ORG
*--------------*
         DS    0F
TRCTAB   DC    C'0123456789ABCDEF'
         DS    0F
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
*-- SEQ DAT  --*
SENDCMD  DS    CL8
         DC    X'4040484040306740436644'
SENDCMD1 DS    CL72
         DS    F
SEDAT    DS    0CL84
SELEN    DS    H
         DS    CL2
SEKEY    DS    CL8
SECMD    DS    CL72
SEFREE   DS    CL50 
         ENTRY SEKEY
*-------------------------------------------------------------------*
*  D S E C T S                                                      *
*-------------------------------------------------------------------*
*  ZENTRALE TABELLEN *
         STATEIN
         EJECT
         USEREIN
         END