         TITLE 'MCE VSAM I/O MODULE'                                    MCE00010
MCT410VS CSECT                                                          MCE00020
MCT410VS AMODE ANY                    (11.0)                            MCE00030
MCT410VS RMODE ANY                    (11.0)                            MCE00040
         USING *,R12                                                    MCE00050
         STM   R14,R12,12(R13)                                          MCE00060
         LR    R12,R15                                                  MCE00070
         LA    R3,SVREGS                                                MCE00080
         ST    R3,8(R13)                                                MCE00090
         ST    R13,4(R3)                                                MCE00100
         LR    R13,R3                                                   MCE00110
         B     RT(R1)                                                   MCE00120
         DC    C'MCT410VS'                                              MCE00130
*********************************************************************** MCE00140
* AT ENTRY: R1=0=> OPEN DATASET                                         MCE00150
*              4=> GET DIR KEY -- R2->KEY (CODE/VERSION)                MCE00160
*              8=> CLOSE                                                MCE00170
*********************************************************************** MCE00180
RT       B     OPEN                                                     MCE00190
         B     GETDIR                                                   MCE00200
         B     CLOSE                                                    MCE00210
*********************************************************************** MCE00220
OPEN     GENCB BLK=ACB,AM=VSAM,BUFND=2,BUFNI=1,                        XMCE00230
               DDNAME=MCE41DSC,MACRF=(DIR)                              MCE00240
         ST    R1,DDACB               ON RETURN, R1->GENERATED BLOCK    MCE00250
         LR    R2,R1                                                    MCE00260
         GENCB BLK=RPL,ACB=(R2),AM=VSAM,AREA=BUFF,                     XMCE00270
               AREALEN=4,ARG=VKEYAREA,OPTCD=(DIR,LOC)                   MCE00280
         ST    R1,DDRPL                                                 MCE00290
         L     R2,DDACB                                                 MCE00300
         OPEN  ((R2)),MODE=31         (24.0)31-BIT MODE                 MCE00310
         B     EXIT                                                     MCE00320
*********************************************************************** MCE00330
* RETRIEVE RECORD DIRECTLY BY KEY - R2->KEY/VERSION                     MCE00340
* FOR DIAGNOSIS, KEY WILL BE C.1 VALUE 1, C.7 I10 CODE, C.2 SEQUENCE    MCE00350
* FOR PROCEDURE, KEY WILL BE C.1 VALUE 2, C.7 I10 CODE, C.2 SEQUENCE    MCE00360
*                                                                       MCE00370
* THE UNIVERSAL KEY SAYS THAT THE DESCRIPTION FOR THE CODE IN           MCE00380
* QUESTION IS GOOD FOR ALL VERSIONS OF THE MCE                          MCE00390
* VARIOUS SEQUENCES WILL OCCUR IF THE CODE DESCRIPTION IS ONLY VALID    MCE00400
* FOR A LIMITED NUMBER OF MCE VERSIONS. IMMEDIATELY FOLLOWING THE       MCE00410
* KEY IN THE VSAM FILE WILL BE 16 BYTES CONTAINING THE                  MCE00420
* FROM DATE(8 BYTES) AND TO DATE(8 BYTES) WHICH DESCRIBE                MCE00430
* WHICH VERSIONS OF THE MCE THIS DESCRIPTION IS VALID FOR               MCE00440
* I10 EFFECTIVE DATE IN V33 2015 IS 10/01/2015
*********************************************************************** MCE00450
*(24.0)GETDIR   MVC   MCEVERS,=CL2'00' (11.0)START WITH UNIVERSAL VERS  MCE00460
GETDIR   XC    DSCRPFLG,DSCRPFLG      (10.0)                            MCE00470
         LA    R6,10                  (11.0)10 POSSIBLE SEQ PATTERN     MCE00490
         LA    R5,SEQNUM              (10.0)R5->TABLE OF SEQUENCE #     MCE00510
         MVC   VKEYCODE,0(R2)         (24.0)MOVE TO KEY ARGUMENT        MCE00520
         MVC   MCEDATE,8(R2)          (24.0)SAVE DISCHARGE DATE         MCE00530
         MVC   VKEYSEQ,=CL2'00'       (10.0)START W/UNIVERSAL SEQUENCE  MCE00540
         MVI   VKEYTYPE,C'0'          (30.0)DEFAULT TO I10 READ
         CLC   MCEDATE,=C'20151001'   (33.0 2015)CHECK DATE
         BNL   GETDIR2                (30.0)
         MVI   VKEYTYPE,C'9'          (30.0)CHANGE TO I9 READ
GETDIR2  L     R2,DDRPL                                                 MCE00550
         GET   RPL=(R2)               IF FOUND, WILL PUT ADDRESS OF     MCE00560
         LTR   R15,R15                  DESCRIPTION IN "BUFF"           MCE00570
         BNZ   NODEF                                                    MCE00580
         CLC   VKEYSEQ,=CL2'00'       (10.0)FOUND WITH UNIVERSAL KEY?   MCE00590
         BE    FOUND                  (10.0)YES                         MCE00600
         CLC   VKEYSEQ,=CL2'01'       (10.0)FOUND FIRST SEQUENCE?       MCE00610
         BNE   SKIP                   (10.0)NO                          MCE00620
         OI    DSCRPFLG,1             (10.0)YES-SET DSCRP FLAG          MCE00630
SKIP     L     R7,BUFF                (10.0)R7->DESCRP                  MCE00640
         MVC   FROMDATE,11(R7)        (33.0)SAVE FROM DATE              MCE00650
         MVC   TODATE,19(R7)          (33.0)SAVE TO DATE                MCE00660
*                                                                       MCE00750
         CLC   FROMDATE,MCEDATE       (24.0)COMPARE CODE DATE WITH TAB  MCE00670
         BE    FOUND                  (10.0)IN RANGE                    MCE00680
         BH    NODEF2                 (10.0)OUT OF RANGE-NO DESCRIPTION MCE00690
         CLC   TODATE,MCEDATE         (24.0)COMPARE CODE DATE WITH TAB  MCE00700
         BL    NODEF                  (10.0)OUT OF RANGE-GET NEXT SEQ # MCE00710
*                                                                       MCE00750
FOUND    L     R2,4(R13)                                                MCE00720
         MVC   24(4,R2),BUFF          RETURN R1->DESCRP                 MCE00730
         B     EXIT                                                     MCE00740
*********************************************************************** MCE00750
* IF LOOK-UP WITH THE UNIVERSAL SEQUENCE FAILS, SEE IF IT IS ONE OF     MCE00760
* CODES ADDED, DELETED OR MODIFIED BETWEEN RELEASES, IN WHICH CASE      MCE00770
* IT WILL HAVE A SEQUENCE NUMBER OTHER THAN THE UNIVERSAL SEQUENCE.     MCE00780
*                                                                       MCE00790
* A VALID CODE NOT FOUND WITH UNIVERSAL SEQUENCE WILL AT LEAST HAVE     MCE00800
* A SEQUENCE OF 01                                                      MCE00810
* A INVALID CODE WILL FAIL WITH UNIVERSAL SEQUENCE AND WITH A           MCE00820
* SEQUENCE OF 01 AND THEN EXIT THIS PGM                                 MCE00830
*********************************************************************** MCE00840
NODEF    CLC   VKEYSEQ,=CL2'01'       (10.0)FOUND INITIAL SEQUENCE?     MCE00850
         BNE   SKIP2                  (10.0)NO                          MCE00860
         TM    DSCRPFLG,1             (10.0)DOES CODE HAVE DSCRP?       MCE00870
         BZ    NODEF2                 (10.0A)NO-CODE NOT IN DSCRP FILE  MCE00880
SKIP2    MVC   VKEYSEQ,0(R5)          (10.0)CHANGE KEY                  MCE00890
         LA    R5,2(R5)               (10.0)ADVANCE FOR NEXT SEQ #      MCE00900
         BCT   R6,GETDIR2             (10.0)READ AGAIN                  MCE00910
NODEF2   L     R2,4(R13)              (4.0)                             MCE00920
         MVC   24(4,R2),ADDNO         RETURN R1->*                      MCE00930
         B     EXIT                                                     MCE00940
*********************************************************************** MCE00950
* CLOSE FILES                                                           MCE00960
*********************************************************************** MCE00970
CLOSE    L     R2,DDACB                                                 MCE00980
         CLOSE ((R2)),MODE=31         (24.0)31-BIT MODE                 MCE00990
EXIT     L     R13,4(R13)                                               MCE01000
         LM    R14,R12,12(R13)                                          MCE01010
         XR    R15,R15                                                  MCE01020
         BR    R14                                                      MCE01030
*********************************************************************** MCE01040
SVREGS   DS    18F                                                      MCE01050
DDACB    DS    F                                                        MCE01060
DDRPL    DS    F                                                        MCE01070
BUFF     DS    F                                                        MCE01080
ADDNO    DC    A(NONE)                                                  MCE01090
NONE     DC    C'*'                                                     MCE01100
MCEDATE  DS    CL8                    (24.0)                            MCE01110
FROMDATE DS    CL8                    (24.0)                            MCE01120
TODATE   DS    CL8                    (24.0)                            MCE01130
SEQNUM   DS   0CL22                   (12.0)                            MCE01140
         DC    CL2'01'                (10.0)                            MCE01150
         DC    CL2'02'                (10.0)                            MCE01160
         DC    CL2'03'                (10.0)                            MCE01170
         DC    CL2'04'                (10.0)                            MCE01180
         DC    CL2'05'                (10.0)                            MCE01190
         DC    CL2'06'                (10.0)                            MCE01200
         DC    CL2'07'                (10.0)                            MCE01210
         DC    CL2'08'                (10.0)                            MCE01220
         DC    CL2'09'                (10.0)                            MCE01230
         DC    CL2'10'                (11.0)                            MCE01240
         DC    CL2'11'                (12.0)                            MCE01250
*                                                                       MCE01260
VKEYAREA DS    0CL11                  (30.0)
VKEYTYPE DS    CL1                    (30.0)(0=I10, 9=I9)
VKEYCODE DS    CL8                    (30.0)(1=DX,2=SG, CODE = 7)
VKEYSEQ  DS    CL2                    (30.0)
*
DSCRPFLG DS    CL1                    (30.0)
*********************************************************************** MCE01300
* REGISTER EQUATES                                                      MCE01310
*********************************************************************** MCE01320
R0       EQU   0                                                        MCE01330
R1       EQU   1                                                        MCE01340
R2       EQU   2                                                        MCE01350
R3       EQU   3                                                        MCE01360
R4       EQU   4                                                        MCE01370
R5       EQU   5                                                        MCE01380
R6       EQU   6                                                        MCE01390
R7       EQU   7                                                        MCE01400
R8       EQU   8                                                        MCE01410
R9       EQU   9                                                        MCE01420
R10      EQU   10                                                       MCE01430
R11      EQU   11                                                       MCE01440
R12      EQU   12                                                       MCE01450
R13      EQU   13                                                       MCE01460
R14      EQU   14                                                       MCE01470
R15      EQU   15                                                       MCE01480
         LTORG                                                          MCE01490
         END                                                            MCE01500
