Cpbltin

CPBLTIN  CSECT         
************************************************************************
*                                                                      *
*     COPYRIGHT (C) SIEMENS AG  1988                                   *
*     COPYRIGHT (C) SIEMENS NIXDORF INFORMATIONSSYSTEME AG  1991       *
*     ALL RIGHTS RESERVED                                              *
*                                                                      *
************************************************************************
         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
CPBLTIN  AMODE ANY
CPBLTIN  RMODE ANY
##BAL    OPSYN ##BAS
##BALR   OPSYN ##BASR
*---------------------------------------------------------------------*
* R14    RUECKSPRUNGADRESSE
* R15    ANSPRUNGADRESSE           BASR R14,15
* R3     STATEIN
* R4     USEREIN
* R5     BASIS REGISTER
*---------------------------------------------------------------------*
         USING *,R15
         STM   R8,R12,SAVTAB
         ST    R14,SAV14
         USING CPBLTINA,R5    
CPBLTINA BASR  R5,0
         BCTR  R5,R0
         BCTR  R5,R0
         DROP  15
         B     BEG
SAV14    DS    F
SAVTAB   DS    5F
         USING STATEIN,R3
         USING USEREIN,R4
*---------------------------------------------------------------------*
*        E X T R N   S
*---------------------------------------------------------------------*
*---------------------------------------------------------------------*
         DS    0F
BEG      EQU   *
         LA    R6,24             24 ZEILEN
         LA    R7,BLTNBER1       STATISCH           
BLTCL    EQU   *
         MVC   0(80,R7),=CL80' ' LOESCHEN BEREICH AUF BLANK
         BCT   R6,BLTCL
         OPEN  BULLETIN          
BLTGET   EQU   *
         LA    R6,24             24 ZEILEN
         LA    R7,BLTNBER1       STATISCH           
BLTLOOP  EQU   *
         GET   BULLETIN,INBER 
         LH    R8,INBER          LENGTH OF RECORD
         SH    R8,=H'5'          -4 (SL)  -1 (MVC)
         EX    R8,MVCREC
         LA    R7,80(R7)         + 80 (1 SATZ)
         BCT   R6,BLTLOOP
         B     BLTEOF            END OF FILE
*--------------------------------
BLTOPN   EQU   *
         LA    R6,BULLETIN
         USING ID1FCB,R6
         CLC   ID1ECB(2),=X'0D33'          NO EXIST
         BE    RETCOB                      NO MESSAGE
         UNPK  DMSERR(5),ID1ECB(3)
         TR    DMSERR,HXTAB-240
         MVC   DMSERRO(4),DMSERR
         MVC   DMSECD(4),=C'OPEN'
         WROUT BLTEOUT,RETCOB
         B     RETCOB
BLTCOM   EQU   *
         LA    R6,BULLETIN
         USING ID1FCB,R6
         UNPK  DMSERR(5),ID1ECB(3)
         TR    DMSERR,HXTAB-240
         MVC   DMSERRO(4),DMSERR
         MVC   DMSECD(4),=C'READ'
         WROUT BLTEOUT,RETCOB
         CLOSE BULLETIN
         B     RETCOB
*----------------------------------------------------------------------*
BLTEOF   EQU   *                 END OF FILE
         CLOSE BULLETIN
         LA    R8,BLTNBER              ADDR OF AREA
         LH    R6,BLTNBERL             LENGTH
BLTSEND  EQU   *
         LA    R2,STATEI
         L     R4,STAIDCP  
         L     R9,STATCID
         L     R14,STATRPBA
         YSEND RPB=(R14),CID=(R9),AREA=(R8),AREALN=(R6),AID=(R4),      -
               EID=(R2)
         CLM   R15,B'1001',=X'0000'
         BE    BLTRET
         CLM   R15,B'1110',=X'10040C'
         BNE   BLTERR
         SOLSIG EIID=(R2),COND=UNCOND,LIFETIM=3 
         CLM   R15,B'0001',=X'00'
         BE    BLTSEND
         MVC   ERRTEXT(20),=CL20'S/BLTN/SOLSIG'  
         BAS   R14,FEHLER
         B     RETCOB
BLTERR   EQU   *    
         MVC   ERRTEXT(20),=CL20'S/BLTN/YSEND'   
         BAS   R14,FEHLER
         B     RETCOB
BLTRET   EQU   *
         LM    R8,R12,SAVTAB
         L     R14,SAV14
         BR    R14
*
RETCOB   EQU   *
         L     R14,=V(PUTMASKE)
         LM    R8,R12,SAVTAB
         BR    R14
*---------------------------------------------------------------------*
FEHLER   EQU   *
         ST    R15,ERR15
         UNPK  ERRR15,ERR15(5)
         TR    ERRR15,HX-240
         WROUT ERRMSG,BLTRET
         BR    R14
*---------------------------------------------------------------------*
         DS    0F
ERRMSG   DC    Y(ERRMSGE-ERRMSG)
         DC    C'   %  ZCP0006 CP-ERROR AT:'
ERRTEXT  DS    CL20
         DC    C'  RC:'
ERRR15   DS    L9
ERRMSGE  EQU   *-1
         ORG
ERR15    DS    F
HX       DC    C'0123456789ABCDEF'
         DS    0F
*
*----------------------------------------------------------------------*
         DS    0F
BULLETIN FCB   FCBTYPE=SAM,                                            -
               EXIT=BLTNEX,                                            -
               LINK=BULLETIN,                                          -
               OPEN=INPUT,                                             -
               RECFORM=V,                                              -
               RECSIZE=84 
*
BLTNEX   EXLST EOFADDR=BLTEOF,COMMON=BLTCOM,OPENER=BLTOPN,OPENC=BLTOPN 
*-----------------------------------------------------------------
         DS    0F
BLTNBER  EQU   *  
         DC    X'10401B20614040455165005040004121'
         DC    X'27822784'
         DC    X'1ED81D7C'     NP   HELL GESCHUETZT
BLTNBER1 DC    1920C' '
BLTNBERE EQU   *
         DS    0F
BLTNBERL DC    Y(BLTNBERE-BLTNBER)
         DS    0F
*-----------------------------------------------------------------
DMSERR   DS    CL4           FELD FUER UNPK
         DS    CL2           RESTFELD FUER UNPK
         DS    0F
INBER    DS    CL84          INPUT BEREICH + SL
MVCREC   MVC   0(0,R7),INBER+4 
         DS    0F
HXTAB    DC    C'0123456789ABCDEF'
         DS    0F
BLTEOUT  DC    Y(BLTEOUTE-BLTEOUT)
         DC    C'   %  ZCP0021 '                   
DMSECD   DS    CL4                  OPEN / READ
         DC    C'-ERROR ''DMS'
DMSERRO  DS    CL4
         DC    C''' ON FILE  ''BULLETIN'' .'
BLTEOUTE EQU   *
         LTORG              <<<<<<<<<<<<<<<<<
*---------------------------------------------------------------------*
*        D S E C T ' S
*---------------------------------------------------------------------*
         PRINT GEN
         IDFCB D,I
*
         STATEIN
         EJECT
         USEREIN
*---------------------------------------------------------------------*
         END