* $$ JOB JNM=VSELIBRM,CLASS=0                                           00000001
* $$ LST CLASS=P                                                        00000002
// JOB VSELIBRM       SUBROUTINE TO ACCESS VSE LIBRARIES                00000003
// OPTION LOG                                                           00000004
// EXEC LIBR,PARM='MSHP;ACC S=PRD2.BTAM'                                00000005
   CATAL VSELIBRM.A        REP=YES                                      00000006
         PUNCH ' CATALR VSELIBRM '                                      00000007
* --------------------------------------------------------------------* 00000008
* Based on samples for the Librarian LIBRM services                   * 00000009
* VSE/ESA Guide to System Functions                                   * 00000010
*                                                                     * 00000011
* This program allows read/write members of VSE Libraries.            * 00000012
*                                                                     * 00000013
* Gustavo Torres                 clgtorres@gmail.com                  * 00000014
* --------------------------------------------------------------------* 00000015
VSELIBRM CSECT                                                          00000016
         USING *,R15                                                    00000017
         STM   R14,R12,12(R13)         STORE REGS IN SAVEAREA           00000018
         DROP  R15                     R15 TO BE USED BY MACROS         00000019
         USING VSELIBRM,R11,R12        R11 NOW BASE REGISTER            00000020
         LR    R11,R15                 ESTABLISH ADDRESSABILITY         00000021
         LA    R12,4095(R11)                                            00000022
         LA    R12,1(R12)              SECOND BASE                      00000023
         ST    R13,APIMONS1+4          STORE MAIN PGM SAVEAREA          00000024
         LR    R10,R13                 SAVE R13                         00000025
         LA    R13,APIMONS1            SAVE AREA FOR THIS TASK          00000026
         ST    R13,8(R10)              STORE EXIT SAVE ADDRESS          00000027
* --------------------------------------------------------------------* 00000028
*        STATEMENTS FOR SET UP FIELDS NEEDED FOR LIBRM                * 00000029
* --------------------------------------------------------------------* 00000030
         L     R2,0(R1)                PARMS ADDRESS                    00000031
         ST    R2,PARMADDR             SAVE                             00000032
         MVC   PARMS,0(R2)             MOVE                             00000033
         L     R9,PBUFADR              LOAD TABRECS ADDRESS             00000034
         ST    R9,TABRECSA             SET  TABRECS ADDRESS             00000035
         USING TABRECS,R9              ESTABLISH ADDRESSABILITY         00000036
         MVC   GETLIB,PLIB             MOVE LIBRARY NAME                00000037
         MVC   GETSUBLB,PSLIB          MOVE SUBLIBR NAME                00000038
         MVC   GETMEMBN,PMEMB          MOVE MEMBER NAME                 00000039
         MVC   GETMEMTY,PMEMT          MOVE MEMBER TYPE                 00000040
* --------------------------------------------------------------------* 00000041
*        GET LDCB MAP                                                 * 00000042
* --------------------------------------------------------------------* 00000043
         LIBRDCB FUNC=MAP                                               00000044
* --------------------------------------------------------------------* 00000045
*        ALLOCATE GETVIS FOR LDCB USED IN THIS TASK                   * 00000046
* --------------------------------------------------------------------* 00000047
         LIBRM SHOWCB,CB=LDCB,CBLEN=LEN1  LENGTH OF LDCB                00000048
         L     R0,LEN1                                                  00000049
*                                                                       00000050
         GETVIS ADDRESS=(1),LENGTH=(0)                                  00000051
*                                                                       00000052
         LTR    R15,R15                GETVIS RC ZERO ?                 00000053
         BNZ    APIERR10               NOT ZERO, WRITE MESSAGE & EXIT   00000054
         ST     R0,APISTADL            SAVE GETVIS AREA LENGTH          00000055
         ST     R1,APISTADA            SAVE LDCB ADDRESS                00000056
         LR     R3,R1                  USED FOR ADDRESSING              00000057
* --------------------------------------------------------------------* 00000058
*        GENERATE LDCB                                                * 00000059
* --------------------------------------------------------------------* 00000060
         LIBRDCB FUNC=GEN,                                             *00000061
               AREA=(3),                                               *00000062
               CONT=YES,                                               *00000063
               ERRAD=APIERR00                                           00000064
* --------------------------------------------------------------------* 00000065
*        MODIFY LDCB FOR GET MEMBER REQUEST                           * 00000066
* --------------------------------------------------------------------* 00000067
APIMOD00 EQU   *                                                        00000068
         LIBRDCB FUNC=MOD,                                             *00000069
               AREA=(3),                                               *00000070
               LIB=GETLIB,                                             *00000071
               SUBLIB=GETSUBLB,                                        *00000072
               MEMBER=GETMEMBN,                                        *00000073
               TYPE=GETMEMTY,                                          *00000074
               DIRINF=GETDIRNF,                                        *00000075
               DIRINFL=GETDIRNL,                                       *00000076
               BUFFER=GETBUFER,                                        *00000077
               BUFSIZE=GETBUFLN,                                       *00000078
               RECNO=0,                                                *00000079
               UNITS=0,                                                *00000080
               EROPT=RET,                                              *00000081
               ERRAD=APIERR00                                           00000082
* --------------------------------------------------------------------* 00000083
*        INVOKE GET/PUT MEMBER SERVICE                                * 00000084
* --------------------------------------------------------------------* 00000085
         XC    RECNO,RECNO            CLEAR RECNO                       00000086
         LA    R10,ENDPROC            RETURN ADDRESS                    00000087
         CLC   PFUNC,=C'PUT'          PUT FUNCTION ?                    00000088
         BNE   APIRDM00               NO, READ A MEMBER                 00000089
         B     APIWTM00               YES, WRITE A MEMBER               00000090
*                                                                       00000091
ENDPROC  EQU   *                                                        00000092
         L     R9,TABRECSA            RESTORE TABRECS ADDRESS           00000093
         L     R10,NORL               NO. RECORDS                       00000094
PRINT    MVC   LINEA,0(R9)            PRINT RECORD                      00000095
         LA    R9,80(R9)                                                00000096
*        PUT   PRINTER                                                  00000097
         BCT   R10,PRINT                                                00000098
* --------------------------------------------------------------------* 00000099
*        FREE LDCB SPACE                                              * 00000100
* --------------------------------------------------------------------* 00000101
         L     R0,APISTADL            RELOAD GETVIS AREA LENGTH         00000102
         L     R1,APISTADA            RELOAD GETVIS AREA ADDRESS        00000103
*                                                                       00000104
         FREEVIS ADDRESS=(1),LENGTH=(0)                                 00000105
*                                                                       00000106
* --------------------------------------------------------------------* 00000107
*        EOJ AND DUMP EXITS                                           * 00000108
* --------------------------------------------------------------------* 00000109
APIMONEX EQU   *                                                        00000110
APIMONDP EQU   *                                                        00000111
         CLC   PFUNC,=C'PUT'           PUT FUNCTION ?                   00000112
         BE    *+10                    YES,                             00000113
         MVC   PNORL,NORL              PASS NO RECORDS                  00000114
         CLI   SWFULL,C'1'             BUFFER IS FULL ?                 00000115
         BNE   *+10                    NO                               00000116
         MVC   PRETCOD,=C'999'         YES, SET RC=999                  00000117
         L     R9,PARMADDR             RESTORE PARM ADDRESS             00000118
         MVC   0(L'PARMS,R9),PARMS     MOVE PARMS                       00000119
*                                                                       00000120
         L     R13,4(R13)              ADDRESS OF MAIN PGM SAVEAREA     00000121
         L     R14,12(R13)             RESTORE RETURN REGISTER          00000122
         LM    R0,R12,20(R13)          RESTORE REGS 0-12                00000123
         BR    R14                     RETURN TO MAIN PGM               00000124
*                                                                       00000125
* --------------------------------------------------------------------* 00000126
*        LIBRM GET MEMBER                                             * 00000127
* --------------------------------------------------------------------* 00000128
APIRDM00 EQU   *                                                        00000129
* --------------------------------------------------------------------* 00000130
*        LIBR OPEN TYPEFLE=INPUT                                      * 00000131
* --------------------------------------------------------------------* 00000132
APIOPN00 EQU   *                                                        00000133
         LIBRM OPEN,                                                   *00000134
               TYPEFLE=INPUT,                                          *00000135
               NOTFND=APIOPN20,                                        *00000136
               LDCB=(3)                                                 00000137
*                                                                       00000138
         LA    R6,APIOPNMT            *MESSAGE TABLE FOR OPEN           00000139
         BAL   R7,APICRC00             CHECK RETURN CODE                00000140
*                                                                       00000141
         LA    R2,GETDIRNF             POINT TO MEMBER DIRECTORY INFO   00000142
         USING INLCMBST,R2             SET ADDRESSABILITY               00000143
*        MVC   NORL,MBSTNORL           MOVE NO OF RECORDS               00000144
         XC    NORL,NORL               CLEAR NO OF RECORDS              00000145
         MVI   PSYSIPT,C'Y'            DATA=YES                         00000146
         TM    MBSTATTR,MBSTSIPT       SYSIPT (DATA=YES) ?              00000147
         BO    APIGET00                YES, GO GET MEMBER               00000148
         MVI   PSYSIPT,C'N'            NO (DATA=NO)                     00000149
         DROP  R2                      RELEASE INLCMBST                 00000150
         B     APIGET00                GET MEMBER                       00000151
*                                                                       00000152
APIOPN20 EQU   *                                                        00000153
         LA    R6,APIOPNMT            *MESSAGE TABLE FOR OPEN           00000154
         BAL   R7,APICRC00             CHECK RETURN CODE                00000155
         B     APIMONEX                                                 00000156
* --------------------------------------------------------------------* 00000157
*        LIBR GET                                                     * 00000158
* --------------------------------------------------------------------* 00000159
APIGET00 EQU   *                                                        00000160
         LA    R2,1                    SET UNITS TO 1 RECORDS           00000161
         L     R4,RECNO                SET STARTING BYTE/RECORD         00000162
*                                                                       00000163
         LIBRM GET,                                                    *00000164
               LDCB=(3),                                               *00000165
               RECNO=(4),                                              *00000166
               UNITS=(2),                                              *00000167
               MOVELEN=GETMOVEL                                         00000168
*                                                                       00000169
         LA    R4,1(R4)                NEXT RECORD                      00000170
         ST    R4,RECNO                                                 00000171
*                                                                       00000172
         C     R15,=F'4'               LAST RECORD ?                    00000173
         BE    APIGET10                YES                              00000174
         LA    R6,APIGETMT            *MESSAGE TABLE FOR GET            00000175
         BAL   R7,APICRC00             CHECK RETURN CODE                00000176
*                                                                       00000177
APIGET10 EQU   *                                                        00000178
         C     R9,PENDBUF              REACH END OF BUFFER ?            00000179
         BNE   APIGET20                NO,                              00000180
         MVI   SWFULL,C'1'             YES, SETON SW                    00000181
         B     APICLO00                                                 00000182
APIGET20 EQU   *                                                        00000183
         MVI   SWFULL,C'0'             NO FULL CONDITION                00000184
         MVC   TABREC,GETBUFER         SAVE RECORD                      00000185
         L     R1,NORL                                                  00000186
         LA    R1,1(R1)                ADD 1 TO                         00000187
         ST    R1,NORL                          NORL                    00000188
         LA    R9,80(R9)               POINT TO NEXT ENTRY              00000189
*                                                                       00000190
         C     R15,=F'4'               LAST RECORD ?                    00000191
         BNE   APIGET00                NO                               00000192
* --------------------------------------------------------------------* 00000193
*        LIBR CLOSE                                                   * 00000194
* --------------------------------------------------------------------* 00000195
APICLO00 EQU   *                                                        00000196
         LIBRM CLOSE,                                                  *00000197
               LDCB=(3),                                               *00000198
               COMMIT=YES                                               00000199
*                                                                       00000200
         LA    R6,APICLOMT            *MESSAGE TABLE FOR CLOSE          00000201
         BAL   R7,APICRC00             CHECK RETURN CODE                00000202
         BR    R10                     RETURN                           00000203
* --------------------------------------------------------------------* 00000204
*        LIBRM PUT MEMBER                                             * 00000205
* --------------------------------------------------------------------* 00000206
APIWTM00 EQU   *                                                        00000207
* --------------------------------------------------------------------* 00000208
*        LIBR OPEN TYPEFLE=(OUTPUT,REPLACE)                           * 00000209
* --------------------------------------------------------------------* 00000210
         MVC   LIBOPEN+12(2),=X'9620'  FORCE SYSIPT=YES                 00000211
         CLI   PSYSIPT,C'Y'            DATA=YES ?                       00000212
         BE    LIBOPEN                 YES                              00000213
         MVC   LIBOPEN+12(2),=X'94DF'  NO, FORCE SYSIPT=NO              00000214
*                                                                       00000215
LIBOPEN  LIBRM OPEN,                                                   *00000216
               TYPEFLE=(OUTPUT,REPLACE),                               *00000217
               SYSIPT=YES,             DATA=YES/NO                     *00000218
               EROPT=CANCEL,           LIBRARIAN ERR MSG TO SYSLOG     *00000219
               LDCB=(3)                                                 00000220
*                                                                       00000221
         LA    R6,APIOPNMT            *MESSAGE TABLE FOR OPEN           00000222
         BAL   R7,APICRC00             CHECK RETURN CODE                00000223
*                                                                       00000224
         L     R4,PNORL                NO RECS                          00000225
* --------------------------------------------------------------------* 00000226
*        LIBR PUT                                                     * 00000227
* --------------------------------------------------------------------* 00000228
APIPUT00 EQU   *                                                        00000229
         LA    R2,1                    SET UNITS TO 1 RECORDS           00000230
         ST    R4,NORL                 NO REMAINDER RECS                00000231
         MVC   GETBUFER(80),TABREC     MOVE RECORD TO PUTBUFER          00000232
*                                                                       00000233
         LIBRM PUT,                                                    *00000234
               LDCB=(3),                                               *00000235
               UNITS=(2),                                              *00000236
               EROPT=CANCEL            LIBRARIAN ERR MSG TO SYSLOG      00000237
*                                                                       00000238
         LA    R6,APIGETMT            *MESSAGE TABLE FOR PUT            00000239
         BAL   R7,APICRC00             CHECK RETURN CODE                00000240
*                                                                       00000241
         LA    R9,80(R9)               POINT TO NEXT ENTRY              00000242
         L     R4,NORL                 NO RECS                          00000243
         BCT   R4,APIPUT00             NEXT RECORD                      00000244
         B     APICLO00                                                 00000245
*                                                                       00000246
* --------------------------------------------------------------------* 00000247
*        CHECK RETURN CODES FROM SERVICES                             * 00000248
*        INPUT : REGISTER 7  LINK REGISTER                            * 00000249
*                REGISTER 6  MESSAGE TABLE ADDRESS                    * 00000250
*                REGISTER 15 SEVERITY CODE FROM SERVICE               * 00000251
*                REGISTER 0  REASON CODE FROM SERVICE                 * 00000252
* --------------------------------------------------------------------* 00000253
APICRC00 EQU   *                       CHECK RETURN CODES               00000254
         MVC   PRETCOD,=C'000'         CLEAR RETURN CODE                00000255
         LTR   R15,R15                 SC 0 ?                           00000256
         BZR   R7                      YES, RETURN                      00000257
         SLR   R4,R4                                                    00000258
         LR    R5,R4                                                    00000259
         IC    R5,2(R6)                GET MAX SEVERITY CODE            00000260
         CR    R15,R5                  SEVERITY CODE WITHIN LIMIT       00000261
         BH    APICRC30                NO                               00000262
         IC    R4,3(R6)                GET MAX REASON CODE              00000263
         USING INLCIALC,R3                                              00000264
         LH    R0,IALCFDBC             GET REASON CODE                  00000265
         DROP  R3                                                       00000266
         CR    R0,R4                   REASON CODE WITHIN LIMIT         00000267
         BH    APICRC30                NO                               00000268
         LR    R2,R6                   ADDRESS TABLE ENTRY              00000269
         LA    R2,4(R2)                POINT TO FIRST MESSAGE ENTRY     00000270
         AR    R2,R15                  CORRECT DISPLACEMENT FOR SC      00000271
         MVC   APICRFL1,0(R2)          GET FLAG BYTE                    00000272
         NI    APICRFL1,X'0F'          CLEAR BIT 0-3                    00000273
         SLR   R3,R3                   CLEAR WORK REGISTER              00000274
         IC    R3,APICRFL1             LOAD POSSIBLE CORRECTION         00000275
         AR    R2,R3                   CORRECT TABLE DISPLACEMENT       00000276
         AR    R2,R0                   CORRECT DISPLACEMENT FOR RC      00000277
         TM    0(R2),RCINV             INVALID SEVERITY/REASON CODE     00000278
         BO    APICRC30                YES                              00000279
         TM    0(R2),RCCON             CAN LIVE WITH RC                 00000280
         BZ    APICRC25                YES                              00000281
         LA    R7,APIMONEX             NO, EXIT AFTER MESSAGE           00000282
APICRC25 EQU   *                                                        00000283
         L     R1,0(R2)                MESSAGE TEXT ADDRESS             00000284
         L     R3,APISTADA             LOAD LDCB ADDRESS                00000285
         MVC   4(08,R1),8(R3)          COMMAND NAME TO MESSAGE          00000286
         BAL   R8,APIERR94             WRITE MESSAGE                    00000287
         BR    R7                      RETURN                           00000288
APICRC30 EQU   *                                                        00000289
         LA    R1,APIMSG08             GET MESSAGE ADDRESS              00000290
         CVD   R15,APIRCPAK            TRANSLATE SEVERITY CODE          00000291
         UNPK  21(2,R1),APIRCPAK+6(2)  UNPACK                           00000292
         OI    22(R1),C'0'             CORRECT SIGN BYTE                00000293
         CVD   R0,APIRCPAK             TRANSLATE REASON CODE            00000294
         UNPK  27(2,R1),APIRCPAK+6(2)  UNPACK                           00000295
         OI    28(R1),C'0'             CORRECT SIGN BYTE                00000296
         L     R3,APISTADA             LOAD LDCB ADDRESS                00000297
         MVC   4(08,R1),8(R3)          COMMAND NAME TO MESSAGE          00000298
         B     APIERR92                WRITE MESSAGE AND EXIT           00000299
* --------------------------------------------------------------------* 00000300
*        ERROR HANDLING FOR RETURN CODE GT 12                         * 00000301
* --------------------------------------------------------------------* 00000302
APIERR00 EQU   *                                                        00000303
         ST    R15,APISAVSC            SAVE SEVERITY CODE               00000304
         LR    R15,R0                  GET REASON CODE                  00000305
         LA    R1,APIMSG03             MESSAGE TEXT ADDRESS             00000306
         CLI   APISAVSC+3,RC16         IS THIS RC 16                    00000307
         BE    APIERR90                YES                              00000308
         LA    R1,APIMSG04             MESSAGE TEXT ADDRESS             00000309
         CLI   APISAVSC+3,RC20         IS THIS RC 20                    00000310
         BE    APIERR90                YES                              00000311
         LA    R1,APIMSG05             MESSAGE TEXT ADDRESS             00000312
         CLI   APISAVSC+3,RC32         IS THIS RC 32                    00000313
         BE    APIERR92                YES                              00000314
         LA    R1,APIMSG06             MESSAGE TEXT ADDRESS             00000315
         L     R15,APISAVSC            RELOAD RETURN CODE               00000316
         B     APIERR90                UNEXPECTED RETURN CODE           00000317
* --------------------------------------------------------------------* 00000318
*        GETVIS AND OTHER ERROR EXITS                                 * 00000319
* --------------------------------------------------------------------* 00000320
APIERR10 EQU   *                       NOT ENOUGH GETVIS FOR EXECUTION  00000321
         LA    R1,APIMSG01             MESSAGE TEXT ADDRESS             00000322
         B     APIERR90                                                 00000323
APIERR20 EQU   *                       FREEVIS RETURN CODE NOT ZERO     00000324
         LA    R1,APIMSG02             MESSAGE TEXT ADDRESS             00000325
         B     APIERR92                                                 00000326
APIERR30 EQU   *                       NUMBER OF DIRECTORY ENTRIES ZERO 00000327
         LA    R1,APIMSG07             MESSAGE TEXT ADDRESS             00000328
         B     APIERR92                                                 00000329
* --------------------------------------------------------------------* 00000330
*        WRITE MESSAGE ON SYSLOG                                      * 00000331
* --------------------------------------------------------------------* 00000332
APIERR90 EQU   *                                                        00000333
         CVD   R15,APIRCPAK            TRANSLATE RETURN CODE            00000334
         UNPK  35(3,R1),APIRCPAK+5(3)  UNPACK                           00000335
         OI    37(R1),C'0'             CORRECT SIGN BYTE                00000336
APIERR92 EQU   *                                                        00000337
         LA    R8,APIMONDP             SET CONTINUATION                 00000338
APIERR94 EQU   *                                                        00000339
         CVD   R15,APIRCPAK            TRANSLATE RETURN CODE            00000340
         UNPK  PRETCOD,APIRCPAK+5(3)   UNPACK                           00000341
         OI    PRETCOD+2,C'0'          CORRECT SIGN BYTE                00000342
         MVC   PMSG,0(R1)              RETURN ERROR MSG                 00000343
         STCM  R1,7,APIERCCW+1         TO ERROR CCW                     00000344
         LA    R1,APIERCCB             LOAD CORRESPONDING CCB           00000345
         SPACE                                                          00000346
         EXCP  (1)                     WRITE MESSAGE                    00000347
         WAIT  (1)                     WAIT FOR I/O COMPLETE            00000348
         BR    R8                      CONTINUE AS INDICATED            00000349
* --------------------------------------------------------------------* 00000350
*        REGISTER EQUATES                                             * 00000351
* --------------------------------------------------------------------* 00000352
R0       EQU   0                                                        00000353
R1       EQU   1                                                        00000354
R2       EQU   2                                                        00000355
R3       EQU   3                                                        00000356
R4       EQU   4                                                        00000357
R5       EQU   5                                                        00000358
R6       EQU   6                                                        00000359
R7       EQU   7                                                        00000360
R8       EQU   8                                                        00000361
R9       EQU   9                                                        00000362
R10      EQU   10                                                       00000363
R11      EQU   11                                                       00000364
R12      EQU   12                                                       00000365
R13      EQU   13                                                       00000366
R14      EQU   14                                                       00000367
R15      EQU   15                                                       00000368
* --------------------------------------------------------------------* 00000369
*        SAVE AREA DECLARATIONS                                       * 00000370
* --------------------------------------------------------------------* 00000371
         DS    0F                                                       00000372
APIMONS1 DC    XL72'00'                MONITOR TASK SAVE AREA           00000373
APISAVSC DC    F'0'                     SEVERITY CODE FROM REG. 15      00000374
APISAVRC DC    F'0'                     REASON CODE FROM REG. 0         00000375
RC16     EQU   X'10'                    SEVERITY CODE 16                00000376
RC20     EQU   X'14'                    SEVERITY CODE 20                00000377
RC32     EQU   X'20'                    SEVERITY CODE 32                00000378
TABRECSA DC    F'0'                     GETVIS TABRECS ADDRESS          00000379
APISTADA DC    F'0'                     GETVIS LDCB ADDRESS             00000380
APISTADL DC    F'0'                     GETVIS LDCB LENGTH              00000381
APISAVIL DC    F'0'                     SAVE DIRINF LENGTH              00000382
LEN1     DC    F'0'                     TEMP FIELD                      00000383
RECNO    DC    F'0'                     SAVE CURRENT POSITION           00000384
NORL     DC    F'0'                     SAVE NO OF RECORDS              00000385
* --------------------------------------------------------------------* 00000386
*        WORKFIELDS                                                   * 00000387
* --------------------------------------------------------------------* 00000388
         DS    0D                                                       00000389
APIRCPAK DC    D'00'                    CVD AREA                        00000390
*                                                                       00000391
* --------------------------------------------------------------------* 00000392
*        PARAMETER FIELD DEFINITIONS FOR GET MEMBER                   * 00000393
* --------------------------------------------------------------------* 00000394
GETLIB   DC    CL7' '                 REQUESTED LIBRARY                 00000395
GETSUBLB DC    CL8' '                 REQUESTED SUBLIBRARY              00000396
GETMEMBN DC    CL8' '                 REQUESTED MEMBER NAME             00000397
GETMEMTY DC    CL8' '                 REQUESTED MEMBER TYPE             00000398
GETDIRNF DC    256X'00'               DIRECTORY INFORMATION             00000399
GETDIRNL EQU   *-GETDIRNF             LENGTH OF DIRINF AREA             00000400
GETMOVEL DS    F                      RECORDS/BYTES TRANSFERED          00000401
GETBUFER DC    10XL80'00'             BUFFER TO CONTAIN DATA            00000402
GETBUFLN EQU   *-GETBUFER             BUFFER LENGTH                     00000403
* --------------------------------------------------------------------* 00000404
*        MESSAGE TABLES                                               * 00000405
* --------------------------------------------------------------------* 00000406
         DS    0F                       ALIGNEMENT                      00000407
APIOPNMT EQU   *                        OPEN MEMBER MESSAGE TABLE       00000408
APIGETMT EQU   *                        GET MEMBER MESSAGE TABLE        00000409
APICLOMT EQU   *                        CLOSE MEMBER MESSAGE TABLE      00000410
         DC    XL4'00000C08'            MAX SEVERITY/REASON CODE        00000411
         DC    AL1(X'00'),AL3(APIGETM1) SC 00 RC 00                     00000412
         DC    AL1(X'44'),AL3(APIGETM2) SC 00 RC 04                     00000413
         DC    AL1(X'08'),AL3(APIGETM3) SC 04 RC 00                     00000414
         DC    AL1(X'48'),AL3(APIGETM4) SC 04 RC 04                     00000415
         DC    AL1(X'40'),AL3(APIGETM5) SC 08 RC 00                     00000416
         DC    AL1(X'40'),AL3(APIGETM6) SC 12 RC 00                     00000417
         DC    AL1(X'40'),AL3(APIGETM7) SC 12 RC 04                     00000418
         DC    AL1(X'40'),AL3(APIGETM8) SC 12 RC 08                     00000419
         SPACE                                                          00000420
APICRFL1 DC    X'00'                    WORKFIELD FOR MESSAGE FLAG      00000421
RCINV    EQU   X'80'                    INVALID SEVERITY/REASON CODE    00000422
RCCON    EQU   X'40'                    CAN'T CONTINUE WITH THIS RC     00000423
* --------------------------------------------------------------------* 00000424
*        ERROR MESSAGE DEFINITIONS                                    * 00000425
* --------------------------------------------------------------------* 00000426
         DS    0D                                                       00000427
APIERCCB CCB   SYSLOG,APIERCCW                                          00000428
APIERCCW CCW   X'09',APIMSG01,X'20',L'APIMSG01                          00000429
*                                                                       00000430
SWFULL   DS    C                        BUFFER FULL SW                  00000431
APIMSG01 DC    C'API MON :     GETVIS FAILED   RC = XXX               ' 00000432
APIMSG02 DC    C'API MON :    FREEVIS FAILED   RC = XXX               ' 00000433
APIMSG03 DC    C'API  EXT.SYS ERROR  RC = 16   FB = XXX               ' 00000434
APIMSG04 DC    C'API  INT.SYS ERROR  RC = 20   FB = XXX               ' 00000435
APIMSG05 DC    C'API  ACCESS CONTROL RC = 32   (PREECEDING MSG L163I) ' 00000436
APIMSG06 DC    C'API  UNDEFINED  RETURN CODE   RC = XXX               ' 00000437
APIMSG07 DC    C'API STATE MEMBER : NO DIRECTORY INFORMATION RETURNED ' 00000438
APIMSG08 DC    C'API             : SC=XX RC=XX  UNEXPECTED OR INVALID ' 00000439
*                                                                       00000440
APIGETM1 DC    C'API          SC=00 RC=00 INFORM.STORED IN DIRINF     ' 00000441
APIGETM2 DC    C'API          SC=00 RC=04 DIRINF NOT SPECIFIED        ' 00000442
APIGETM3 DC    C'API          SC=04 RC=00 DIRINF TOO SMALL CONT=YES   ' 00000443
APIGETM4 DC    C'API          SC=04 RC=04 DIRINF TOO SMALL CONT=NO    ' 00000444
APIGETM5 DC    C'API          SC=08 RC=00 MEMBER NOT FOUND            ' 00000445
APIGETM6 DC    C'API          SC=12 RC=00 SUBLIBRARY DOES NOT EXIST   ' 00000446
APIGETM7 DC    C'API          SC=12 RC=04 LIBRARY DOES NOT EXIST      ' 00000447
APIGETM8 DC    C'API          SC=12 RC=08 CHAIN DOES NOT EXIST        ' 00000448
*                                                                       00000449
PRINTER  DTFPR DEVADDR=SYSLST,IOAREA1=PRTAR,BLKSIZE=81,CTLCHR=ASA       00000450
PRTAR    DC    C' '                                                     00000451
LINEA    DS    CL80                                                     00000452
* --------------------------------------------------------------------* 00000453
         LTORG                                                          00000454
* --------------------------------------------------------------------* 00000455
*        PARAMETROS                                                   * 00000456
* --------------------------------------------------------------------* 00000457
PARMADDR DS    F                                                        00000458
*                                                                       00000459
PARMS    DS    0CL102                                                   00000460
PFUNC    DS    CL3         FUNCTION GET/PUT                             00000461
PSYSIPT  DS    C           DATA=Y/N                                     00000462
PBUFADR  DS    F           BUFFER ADDRESS                               00000463
PNORL    DS    F           NO RECORDS                                   00000464
PENDBUF  DS    F           END BUFFER ADDRESS                           00000465
PLIB     DS    CL7         LIBRARY NAME                                 00000466
PSLIB    DS    CL8         SUBLIBRARY NAME                              00000467
PMEMB    DS    CL8         MEMBER NAME                                  00000468
PMEMT    DS    CL8         MEMBER TYPE                                  00000469
PRETCOD  DS    CL3         R15                                          00000470
PMSG     DS    CL52        APIMSGXX                                     00000471
* --------------------------------------------------------------------* 00000472
*        TABLA P/SALVAR RECS DE MIEMBRO LEIDO (GETVIS AREA)           * 00000473
* --------------------------------------------------------------------* 00000474
TABRECS  DSECT                                                          00000475
TABREC   DS    CL80                                                     00000476
* --------------------------------------------------------------------* 00000477
*        LIBR MEMBER STATUS INFORMATION BLOCK (DSECT)                 * 00000478
* --------------------------------------------------------------------* 00000479
         INLCMBST                                                       00000480
         END                                                            00000481
/+                                                                      00000482
/*                                                                      00000483
* $$ LST DISP=D,CLASS=P                                                 00000484
* $$ PUN DISP=I,CLASS=0                                                 00000485
// JOB VSELIBRM    ASSEMBLY                                             00000486
// EXEC IESINSRT                                                        00000487
$ $$ LST DISP=D,CLASS=P                                                 00000488
// JOB VSELIBRM    LIBR/CATALR                                          00000489
// EXEC LIBR,PARM='MSHP;ACC S=PRD2.BTAM'                                00000490
* $$ END                                                                00000491
// OPTION DECK                                                          00000492
// LIBDEF *,SEARCH=PRD2.BTAM                                            00000493
// EXEC ASSEMBLY                                                        00000494
         COPY  VSELIBRM                                                 00000495
/*                                                                      00000496
// EXEC IESINSRT                                                        00000497
/*                                                                      00000498
#&                                                                      00000499
* $$ END                                                                00000500
/&                                                                      00000501
* $$ EOJ                                                                00000502
