Hcprco

Aus SiWiki
Wechseln zu: Navigation, Suche
HCPRCO   CSECT
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS AG  1988                                   *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
*
* AENDERUNG HC-HEADER MIT REAL UND VT-NAME
** V3.0AK2
* ES WIRD UNTERSCHIDEN ZWISCHEN 80 UND 82 BYTE DRUCKERN ( DUMME PCS)
** V2.0A00 (PILOT)
** V2.0A00
*
         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
HCPRCO   AMODE ANY
HCPRCO   RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
* > REGISTERUEBERGABE <
* R3  STATEIN
* R4  USEREIN
* R14 RET. ADRES   (BASR R14,R15)
         USING *,R15
         USING CPHCCO,R9,R10
         USING STATEIN,R3
         USING USEREIN,R4
CPHCCO   BASR  R9,0
         BCTR  R9,R0
         BCTR  R9,R0
*              R3       ADR STATEIN    UEBER SPOSTR MITT. AUS HCINIT
         LA    R1,4095
         LA    R10,1(R9,R1)
         DROP  R15
         CLM   R2,B'1001',=X'0800'   EVENT MIT POSTCODE EINGETRETEN
         BE    HCCOBEG
         B     HCRETCO   FALSCHER ANSPRUNG Z.B. TIMER ABLAUF..
         B     HCCOBEG
SAV14    DS    F
SAVTAB   DS    5F
         EXTRN HCARECL            AUD MOD. HCINIT
         EXTRN EIIDHC             AUS MOD. MCP002
         EXTRN IDHCOCP            AUS MOD. MCP002
*---------------------------------------------------------------------*
HCCOBEG  EQU   *
         MVC   HCDEV(8),STATDEV
         MVC   HCFORM(8),STATFORM
         L     R5,STATHCPG
         ST    R5,HCPAGE
         LA    R1,4095
         LA    R5,1(R1,R5)
         LA    R5,1(R1,R5)
         ST    R5,HCPOUT         3. SEITE
*
HCUMCOD  EQU   *
         L     R11,HCPAGE
         L     R4,HCPOUT          ERGEBNISFELD
         LA    R11,11(R11)          HEADER WEG
         L     R1,=A(HCARECL)
         L     R5,0(R1)           LENGTH EINDATEN
HCLOOP2  CLI   0(R11),X'1E'        IS2-FOLGE
         BE    HCLOOP3
         CLI   0(R11),X'1D'        IS3-FOLGE
         BE    HCLOOP3
         CLI   0(R11),X'27'        ESC-FOLGE
         BE    HCLLZE
HCLOOPW  MVC   0(1,R4),0(R11)
         LA    R11,1(R11)
         LA    R4,1(R4)
         BCT   R5,HCLOOP2
         B     HCISFE
HCLLZE   EQU   *
         CLC   0(2,R11),=X'2798'     LZE ??
         BNE   HCLLZEE           NO, SONST WAS
         MVI   0(R4),X'00'       LZE DURCH NUL ERSETZTEN
         LA    R11,2(R11)          IN  +2
         LA    R4,1(R4)          OUT +1
         BCT   R5,HCLOOP2
         B     HCISFE
HCLLZEE  B     HCLOOPW
HCLOOP3  EQU   *
         LA    R11,2(R11)           2 BYTE IS-FOLGE AUSFUEGEN
         BCT   R5,HCLOOP2
         PRINT GEN
HCISFE   EQU   *
         CLI   STATHCTY,C'P'   80 CHAR ?
         BE    HSISFE          YES
         GDATE ULOGDAT,FORMAT=ISO4,TOD=ULOGTIM
         MVC   HCSTIME(2),ULOGTIM
         MVC   HCSTIME+2(2),ULOGTIM+3
         MVC   HCSTIME+4(2),ULOGTIM+6
         MVC   HCSYSFL+58(6),HCSTIME
         MVC   HCLST2D(8),ULOGTIM
         MVC   HCLST2D+10(10),ULOGDAT
         CNOP  0,4
HCSYSFL  SYSFL 'SYSLST=CP.TEMP.HC.XXXXXX'
         CLI   STATVT,X'40'
         BNH   HCLSTNVT
         MVC   HCLST5(8),STATVT
         MVC   HCLST5VT(3),=C'VT:'
HCLSTNVT EQU   *
         MVC   HCLST2(8),STATPNA
         WRLST HCLST3L,HCLERR
         WRLST HCLST2L,HCLERR
         WRLST HCLST3L,HCLERR
         WRLST HCLST4L,HCLERR
         MVC   HCLST5VT(3),=C'   '
         MVC   HCLST5(8),=C'        '
         L     R4,HCPOUT          ERGEBNISFELD
         LA    R5,24              24 X 80 = 1920
HCLOOP1  TR    0(80,R4),HCTRANST   X'00' = X'40'
         MVC   HCLST1(80),0(R4)
         WRLST HCLST1L,HCLERR
         LA    R4,80(R4)
         BCT   R5,HCLOOP1
         WRLST HCLST4L,HCLERR
HCLERR   EQU   *
         SYSFL 'SYSLST=(PRIMARY)'
         MVC   HCPRNT+19(6),HCSTIME
         MVC   HCPRNT+37(8),HCFORM
         MVC   HCPRNT+50(8),HCDEV
         CNOP  0,4
HCPRNT   PRNT  CP.TEMP.HC.XXXXXX,ERASE,DEV=XXXXXXXX,FORM=XXXXXXXX
HCRETCO  EQU   *
         SOLSIG EIID=EIIDHC,COID=IDHCOCP,LIFETIM=43000
         RETCO
***************************  PC FORMAT 80 CHAR.
HSISFE   EQU   *
         GDATE ULOGDAT,FORMAT=ISO4,TOD=ULOGTIM
         MVC   HCSTIME(2),ULOGTIM
         MVC   HCSTIME+2(2),ULOGTIM+3
         MVC   HCSTIME+4(2),ULOGTIM+6
         MVC   HSSYSFL+58(6),HCSTIME
         MVC   HSLST2D(8),ULOGTIM
         MVC   HSLST2D+10(10),ULOGDAT
         CNOP  0,4
HSSYSFL  SYSFL 'SYSLST=CP.TEMP.HC.XXXXXX'
         CLI   STATVT,X'40'
         BNH   HSLSTNVT
         MVC   HSLST5(8),STATVT
         MVC   HSLST5VT(3),=C'VT:'
HSLSTNVT EQU   *
         MVC   HSLST2(8),STATPNA
         WRLST HSLST3L,HSLERR
         WRLST HSLST2L,HCLERR
         WRLST HSLST3L,HCLERR
         WRLST HSLST4L,HCLERR
         L     R4,HCPOUT          ERGEBNISFELD
         LA    R5,24              24 X 80 = 1920
HSLOOP1  TR    0(80,R4),HCTRANST   X'00' = X'40'
         MVC   HSLST1(80),0(R4)
         WRLST HSLST1L,HSLERR
         LA    R4,80(R4)
         BCT   R5,HSLOOP1
         WRLST HSLST4L,HSLERR
HSLERR   EQU   *
         SYSFL 'SYSLST=(PRIMARY)'
         MVC   HCPRNT+19(6),HCSTIME
         MVC   HCPRNT+37(8),HCFORM
         MVC   HCPRNT+50(8),HCDEV
         B     HCPRNT
         CNOP  0,4
*----------------------------------------------------------------------*
HCDEV    DC    CL8' '
HCFORM   DC    CL8' '
Z80      DC    F'80'
ULOGDAT  DS    CL14
ULOGTIM  DS    CL8
HCSTIME  DS    CL6
HCPAGE   DS    F
HCPOUT   DS    F
*HCARECL  DS    F        LENGTH DER EMPF. NACHR.
HCMVC1   MVC   HCLST1(0),0(R5)
         DS     0F
HCLST1L  DC    Y(HCLST1LE-HCLST1L)
         DS    CL2
         DC    C'!'
HCLST1   DS    CL80
         DC    C'!'
HCLST1LE EQU   *
         DS     0F
HCLST2L  DC    Y(HCLST2LE-HCLST2L)
         DS    CL2
         DC    CL33'C P  -  H A R D C O P Y   FROM : '
HCLST2   DS    CL8
         DC    CL2' '
HCLST5VT DC    CL3' '       
         DC    CL1' '
HCLST5   DS    CL8
         DC    CL7' '
HCLST2D  DC    CL20' '  DATUM ZEIT
HCLST2LE EQU   *
         DS     0F
HCLST3L  DC    Y(HCLST3LE-HCLST3L)
         DS    CL2
HCLST3   DC    CL82' '
HCLST3LE EQU   *
         DS     0F
HCLST4L  DC    Y(HCLST4LE-HCLST4L)
         DS    CL2
         DC    C'+'
HCLST4   DC    80CL1'-'
         DC    C'+'
HCLST4LE EQU   *
         DS     0F
********************** PC FORMAT 80 CHAR
HSLST1L  DC    Y(HSLST1LE-HSLST1L)
         DS    CL2
HSLST1   DS    CL80
HSLST1LE EQU   *
         DS     0F
HSLST2L  DC    Y(HSLST2LE-HSLST2L)
         DS    CL2
         DC    CL33'C P  -  H A R D C O P Y   FROM : '
HSLST2   DS    CL8
         DC    CL2' '
HSLST5VT DC    CL3' '       
         DC    CL1' '
HSLST5   DS    CL8
         DC    CL5' '
HSLST2D  DC    CL20' '  DATUM ZEIT
HSLST2LE EQU   *
         DS     0F
HSLST3L  DC    Y(HSLST3LE-HSLST3L)
         DS    CL2
HSLST3   DC    CL80' '
HSLST3LE EQU   *
         DS     0F
HSLST4L  DC    Y(HSLST4LE-HSLST4L)
         DS    CL2
HSLST4   DC    80CL1'-'
HSLST4LE EQU   *
         DS     0F
**HCRPB    YRPB   OPTCD=(CS,SPEC)
         DS     0F
HCTRANST DC    X'400102030405060708090A0B0C0D0E0F'     X'00'=X'40'
         DC    X'101112131415161718191A1B1C1D1E1F'
         DC    X'202122232425262728292A2B2C2D2E2F'
         DC    X'303132333435363738393A3B3C3D3E3F'
         DC    X'404142434445464748494A4B4C4D4E4F'
         DC    X'505152535455565758595A5B5C5D5E5F'
         DC    X'606162636465666768696A6B6C6D6E6F'
         DC    X'707172737475767778797A7B7C7D7E7F'
         DC    X'808182838485868788898A8B8C8D8E8F'
         DC    X'909192939495969798999A9B9C9D9E9F'
         DC    X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'
         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