Cpauser
Aus Si:Wiki von Siegrist SystemLösungen - Informatik und Rezepte
* RELM UEBERPRUEFEN AUF GUELTIGKEIT. ** V3.0AK4 * REQM UEBERPRUEFEN AUF GUELTIGKEIT. ** V3.0AK3 * KOMMANDO /LL FUER LINELEN 80 ODER 82 BYTE (DUMME PC'S) * 'P' = 80 BYTE / REST = 82 BYTE BREITE AUF DRUCKFORMULAR ** V2.0A00 (PILOT) * KOMMANDOS: /HC XXXXXXXX; /FORM XXXXXXXX; /? ** V2.0A00 CPAUSER CSECT * PRINT NOGEN R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 *---------------------------------------------------------------------* GPARMOD 31 CPAUSER AMODE ANY CPAUSER RMODE ANY ##BAL OPSYN ##BAS ##BALR OPSYN ##BASR *---------------------------------------------------------------------* * > REGISTERUEBERGABE < * R3 STATEIN * R4 USEREIN * R6 PARAMLIST * R14 RET. ADRES (BASR R14,R15) * > BENUTZTE REGISTER < * R1 DIV. * R5 SEND AREA * R7 SEND CID * R8 V(KONST)/ ARBEIT * R9 BASIS REG * R10 BASIS REG * R11 BASIS REG * R12 SEND AREALN * R13 SPRUNG REG / SEND RPB * R15 DIV. USING *,R15 STM R8,R12,SAVTAB ST R14,SAV14 USING CPAUSR,R9,R10 USING STATEIN,R3 USING USEREIN,R4 CPAUSR BASR R9,0 BCTR R9,R0 BCTR R9,R0 LA R1,4095 LA R10,1(R9,R1) DROP R15 B AUSBEG SAV14 DS F SAVTAB DS 5F *---------------------------------------------------------------------* * E X T R N ' S / E N T R I E S *---------------------------------------------------------------------* AUSBEG EQU * REQM 1 FUER AUSGABEPUFFER LTR R15,R15 BE AUSREQOK MVC ERRTEXT,=CL20'USR/BEG/REQM' BAS R13,UFEHLER L R14,SAV14 LM R8,R12,SAVTAB BR R14 AUSREQOK EQU * ST R1,ADMUPUFF XR R12,R12 XR R5,R5 LR R5,R1 MVC 0(22,R5),SENDNK NACHR.KOPF LA R12,22(R12) LA R5,22(R5) * CLI 0(R6),C'?' BE AUINFO CLC 0(3,R6),=CL3'HC?' BE AUHCWER CLC 0(4,R6),=CL4'HC ?' BE AUHCWER CLC 0(3,R6),=CL3'HC ' BE AUCHDEV CLC 0(5,R6),=CL5'FORM?' BE AUFOWER CLC 0(6,R6),=CL6'FORM ?' BE AUFOWER CLC 0(5,R6),=CL5'FORM ' BE AUCHFORM CLC 0(3,R6),=CL3'LL ' BE AUHCLL ******** AAAAAA AUNDEV MVC 0(AD0100Q,R5),AD0100 LA R12,AD0100Q(R12) LEN LA R5,AD0100Q(R5) DIST ******** AAAAAA B ADMURET *----------------------------------CH DEVICE NAME DES HC ------------* AUCHDEV EQU * CLI 3(R6),X'40' BE AUNDEV TR 3(8,R6),DEVTAB MVC AD0101F(8),STATDEV MVC AD0102F(8),3(R6) MVC STATDEV(8),3(R6) NAME NEU SETZEN IN STATEIN MVC 0(AD0101Q,R5),AD0101 LA R12,AD0101Q(R12) LEN LA R5,AD0101Q(R5) DIST MVC 0(AD0102Q,R5),AD0102 LA R12,AD0102Q(R12) LEN LA R5,AD0102Q(R5) DIST B ADMURET AUHCWER EQU * MVC AD0103F(8),STATDEV MVC 0(AD0103Q,R5),AD0103 LA R12,AD0103Q(R12) LEN LA R5,AD0103Q(R5) DIST B ADMURET *----------------------------------CH FORMULAR DES HC ------------* AUCHFORM EQU * CLI 5(R6),X'40' BE AUNDEV TR 5(8,R6),DEVTAB MVC AD0104F(8),STATFORM MVC AD0105F(8),5(R6) MVC STATFORM(8),5(R6) FORM NEU SETZEN IN STATEIN MVC 0(AD0104Q,R5),AD0104 LA R12,AD0104Q(R12) LEN LA R5,AD0104Q(R5) DIST MVC 0(AD0105Q,R5),AD0105 LA R12,AD0105Q(R12) LEN LA R5,AD0105Q(R5) DIST B ADMURET AUFOWER EQU * MVC AD0106F(8),STATFORM MVC 0(AD0106Q,R5),AD0106 LA R12,AD0106Q(R12) LEN LA R5,AD0106Q(R5) DIST B ADMURET AUHCLL EQU * CLI 3(R6),X'40' BE AUNDEV CLI 3(R6),C'P' 80 ? BNE AUHCLL1 MVC AD0108F(2),=C'80' B AUHCLL2 AUHCLL1 MVC AD0108F(2),=C'82' AUHCLL2 MVC STATHCTY(1),3(R6) LEN NEU SETZEN IN STATEIN MVC 0(AD0108Q,R5),AD0108 LA R12,AD0108Q(R12) LEN LA R5,AD0108Q(R5) DIST B ADMURET *---------------------------------- ALLGEMEINE INFOS ------------* AUINFO EQU * MVC AD0107P(8),STATPRO MVC AD0107S(8),STATPNA MVC 0(AD0107Q,R5),AD0107 LA R12,AD0107Q(R12) LEN LA R5,AD0107Q(R5) DIST B ADMURET ADMURET EQU * MVC 0(8,R5),SENDEND ENDE LA R12,8(R12) L R5,ADMUPUFF BAS R13,ADMUSEND L R5,ADMUPUFF SRA R5,12 LTR R5,R5 BNZ ARELM1 MVC ERRTEXT,=CL20'USR/BEG/REL/0' BAS R13,UFEHLER B ARELMNOK ARELM1 EQU * RELM 1,(R5) PUFFER WIEDER FREI ARELMNOK EQU * L R14,SAV14 LM R8,R12,SAVTAB BR R14 *------------------ YSEND --> R5 AREA / R12 --> AREALN --------------* * ANSPRING IMMER MIT R13 * DS F ADMUSEND ST R13,ADMUSEND-4 L R13,STATRPBA L R7,STATCID LA R2,STATEI AUSEND1 L R14,STAIDCP YSEND RPB=(R13),CID=(R7),AID=(R14),AREA=(R5),AREALN=(R12), - EID=(R2) CLM R15,B'1001',=X'0000' BE ADUENDE MVC ERRTEXT,=CL20'USR/SEND/YSEND' CLM R15,B'1110',=X'10040C' BNE AU777 SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=10 CLM R15,B'0001',=X'00' BE AUSEND1 MVC ERRTEXT,=CL20'USR/SEND/SOLSIG' AU777 BAS R13,UFEHLER ADUENDE L R13,ADMUSEND-4 BR R13 *----------------------------------------------------------------------* DS F UFEHLER EQU * ST R13,UFEHLER-4 ST R15,ERR15 UNPK ERRR15,ERR15(5) TR ERRR15,HX-240 WROUT ERRMSG,UTERME UTERME L R13,UFEHLER-4 BR R13 *----------------------------------------------------------------------* ADMUPUFF DS F AUSGABEPUFFER ERRMSG DC Y(ERRMSGE-ERRMSG) DC C' % ZCP0006 CP-ERROR AT:' ERRTEXT DS CL20 DC C' RC:' ERRR15 DS L9 ERRMSGE EQU *-1 ORG DS 0F HX DC C'0123456789ABCDEF' ERR15 DS F UERR15 DS 0L9 DS L4 DMSERR DS L4 DS L1 ***************** AD0100 DS 0H DC C'% ZCP0100 INPUT INVALID. PROCESSING TERMINATED.' DC X'2798' AD0100E EQU * ***************** AD0101 DS 0H DC C'% ZCP0101 OLD DEVICE NAME: ''' AD0101F DS CL8 DC C'''' DC X'2798' AD0101E EQU * ***************** AD0102 DS 0H DC C'% ZCP0102 NEW DEVICE NAME: ''' AD0102F DS CL8 DC C'''' DC X'2798' AD0102E EQU * ***************** AD0103 DS 0H DC C'% ZCP0103 ACTUAL DEVICE NAME FOR HARDCOPY: ''' AD0103F DS CL8 DC C'''' DC X'2798' AD0103E EQU * ***************** AD0104 DS 0H DC C'% ZCP0104 OLD FORMULAR NAME: ''' AD0104F DS CL8 DC C'''' DC X'2798' AD0104E EQU * AD0105 DS 0H DC C'% ZCP0105 NEW FORMULAR NAME: ''' AD0105F DS CL8 DC C'''' DC X'2798' AD0105E EQU * *----------------------------------------------------------------------* ***************** AD0106 DS 0H DC C'% ZCP0106 ACTUAL FORMULAR NAME FOR HARDCOPY: ''' AD0106F DS CL8 DC C'''' DC X'2798' AD0106E EQU * ***************** AD0108 DS 0H DC C'% ZCP0108 LINE LENGTH FOR HARDCOPY: ''' AD0108F DS CL2 DC C'''' DC X'2798' AD0108E EQU * ***************** AD0107 DS 0H DC C' ' DC X'2798' DC C' C P - I N F O ' DC X'2798' DC C' ' DC X'2798' DC C' PROCESSOR: ' AD0107P DS CL8 DC C' ' DC X'2798' DC C' STATION: ' AD0107S DS CL8 DC C' ' DC X'2798' DC C' ' DC X'2798' AD0107E EQU * ***************** SENDNK DS 0CL22 DC X'10401B2061404045625400400000412127822784' LSP DC X'2798' ***************** SENDEND DS 0CL8 ABSCHLUSS DC CL4'CMD:' DC X'27841ED7' ***************** * DS 0F AD0100Q EQU AD0100E-AD0100 AD0101Q EQU AD0101E-AD0101 AD0102Q EQU AD0102E-AD0102 AD0103Q EQU AD0103E-AD0103 AD0104Q EQU AD0104E-AD0104 AD0105Q EQU AD0105E-AD0105 AD0106Q EQU AD0106E-AD0106 AD0107Q EQU AD0107E-AD0107 AD0108Q EQU AD0108E-AD0108 ***************** DS 0F DEVTAB DC X'400102030405060708090A0B0C0D0E0F' 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 *---------------------------------------------------------------------* * LTORG <<<<<<<<<<<<<<<<< *---------------------------------------------------------------------* * D S E C T ' S *---------------------------------------------------------------------* STATEIN EJECT USEREIN *---------------------------------------------------------------------* END
