Yrecasy
Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
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
