TITLE '             M E R G E   U P   T O   9 9 9   F I L E S'
*---------------------------------------------------------------------*
*        OPENS INPUT FILES (INP001->999) UNTIL INPUT FILE NOT FOUND.
*---------------------------------------------------------------------*
         SPACE 2
MERG999  CSECT ,                                         2003JUN18ESOTO
         PRINT NOGEN
         DC    CL8'MERG999',CL8'SYSDATE',CL8'SYSTIME'
MER000   DS    0D
         USING *,13
         STM   14,12,12(13)        SAVE O/S REGISTERS.
         ST    15,8(,13)           SAVE MERG999 R13.
         ST    13,4(,15)           SAVE O/S R13.
         LR    13,15               R13 NOW BASE REGISTER/SAVEREGS.
         B     18*4+48(,13)        GO TO OPEN MERGED,SYSLST.
         ORG   MER000
         DS    0D,18A,48X          SAVEREGS/RE-ENTRANT MODULE WORK AREA
         OPEN  (MERGED,OUTPUT,SYSLST,OUTPUT)
         SPACE 2
*---------------------------------------------------------------------*
*        I N I T I A L I Z E S    I N P U T    F I L E S
*---------------------------------------------------------------------*
         LA    4,INFILE            POINT TO DUMMY INFILE.
MER100   DS    0H
         LA    0,INPLEN            LENGTH OF NEEDED INFILE STORAGE.
         GETMAIN R,LV=(0)          GET STORAGE FOR ONE INFILE SEGMENT.
         MVC   0(INPLEN,1),INFILE  CREATING AN INFILE SEGMENT.
         ST    1,0(,4)             POINT BWD.
         ST    1,4(,4)             POINT BWD; FOR END OF JOB.
         ST    4,8(,1)             POINT FWD.
         LR    4,1                 R4 NOW ADR OF CURRENT INFILE.
         AP    INPNUM,=P'1'        CREATING DDNAME NUMBER (001->999).
         OI    INPNUM+L'INPNUM-1,15  USABLE AFTER UNPACK.
         UNPK  83(3,4),INPNUM      DDNAME NOW INP001->INP999.
         UNPK  21(3,4),INPNUM      SAVE DDNAME #001->999, FOR EOJ.
         LA    5,40(,4)            POINT TO INPUT FILE DCB.
         OPEN  ((5),INPUT)         OPEN INPUT FILE.
         LTR   15,15               Q,OPEN ERROR?
         BNZ   MER200               Y,ASSUMES, INPUT FILE NOT FOUND.
         GET   (5)                 GET 1ST RECORD OF INPUT FILE.
         ST    1,12(,4)            SAVE 1ST RECORD ADDRESS.
         MVC   24(16,4),0(1)       SAVE 1ST RECORD KEY.
         B     MER100              INITIALIZE NEXT INPUT FILE.
         EJECT
*---------------------------------------------------------------------*
*        C O M P L E T E S    I N I T I A L I Z A T I O N
*---------------------------------------------------------------------*
MER200   DS    0H
         SP    INPNUM,=P'1'        NOW ACTUAL NUMBER OF INPUT FILES.
         BNP   MER900              NO INPUT FILES? END OF JOB.
         CVB   3,INPNUM            R3 NOW NUMBER OF INPUT FILES.
         L     4,INFILE            R4 POINTS TO 1ST INFILE SEGMENT.
         STM   3,4,EOJCNT          NEEDED FOR END OF JOB.
         STM   3,4,INPCNT          NEEDED TO SKIP EMPTY INPUT FILES.
MER300   DS    0H
         CLC   =A(XFFKEY),12(4)    Q,EMPTY INPUT FILE.
         BNE   MAN400               N,SKIP TO NEXT INFILE SEGMENT.
         L     1,8(,4)             R1 NOW ADR OF PREVIOUS INFILE.
         MVC   0(4,1),0(4)         SKIP EMPTY FILE. POINT TO NEXT.
         L     1,0(,4)             R1 NOW ADR OF NEXT INFILE SEGMENT.
         MVC   8(4,1),8(4)         NEXT INFILE POINTS TO PREV INFILE.
         L     1,INPCNT            ADJUSTING INPUT COUNT DOWNWARD.
         BCTR  1,0                 LESS ONE EMPTY INPUT FILE.
         ST    1,INPCNT            SAVE NEW COUNT.
MAN400   DS    0H
         L     4,0(,4)             POINT TO NEXT INFILE SEGMENT.
         BCT   3,MER300            TEST NEXT INPUT FILE.
         L     1,INPCNT            TESTING IF ANY INPUT FILE TO MERGE.
         LTR   1,1                 Q,ANY INPUT FILES LEFT TO MERGE?
         BNP   MER750               N,PRINT EMPTY FILE(S) INFO.
         L     4,INFILE            R4 NOW ADR OF 1ST INFILE SEGMENT.
         L     5,0(,4)             R5 NOW ADR OF 2ND INFILE SEGMENT.
         STM   4,5,INP1ST          INP1ST/2ND; INITIAL INPUT PAIR.
         OI    INPNUM+L'INPNUM-1,15  MAKE PRINTABLE.
         UNPK  OPRNUM,INPNUM       MOVE TO OPERATOR MESSAGE.
         LA    1,OPRMSG            POINT TO OPERATOR MESSAGE.
         SVC   35                  ISSUE WTO (WRITE TO OPERATOR) SVC.
         LTR   15,15               Q,WTO ERROR?
         BZ    MER500               N,START MERGING.
         EX    0,*                  Y,ABORT JOB (EXECUTE EXCEPTION).
         EJECT
*---------------------------------------------------------------------*
*        M A I N    L I N E    R O U T I N E
*---------------------------------------------------------------------*
MER500   DS    0H
         LM    3,5,INPCNT          LOAD INITIAL INFILE PARAMETERS.
MER550   DS    0H
         CLC   24(16,4),24(5)      Q,1ST INFILE KEY LOW OR EQUAL?
         BNH   MER600               Y,KEYS IN SEQUENCE.
         LR    4,5                  N,MAKE 2ND INFILE 1ST.
MER600   DS    0H
         L     5,0(,5)             POINT TO NEXT INFILE SEGMENT.
         BCT   3,MER550            TEST NEXT PAIR OF INFILE KEYS.
         AP    16(5,4),=P'1'       INPUT FILE COPIED COUNT (MERGED).
         L     5,12(,4)            R5 NOW ADR OF RECORD TO BE MERGED.
         PUT   MERGED,(5)          COPY RECORD TO OUTPUT MERGED FILE.
         LA    5,40(,4)            R5 NOW ADR OF INPUT FILE DCB.
         GET   (5)                 GET NEXT INPUT RECORD.
         ST    1,12(,4)            SAVE INPUT RECORD ADR.
         MVC   24(16,4),0(1)       SAVE INPUT RECORD KEY.
         B     MER500              FIND NEXT RECORD TO BE MERGED.
         SPACE 2
*---------------------------------------------------------------------*
*        E N D    O F    F I L E    R O U T I N E
*---------------------------------------------------------------------*
MER700   DS    0H
         CLOSE (5)                 CLOSE INPUT FILE.
         CLC   =A(XFFKEY),12(4)    Q,INPUT FILE INITIALLY EMPTY?
         BE    MER100               Y,INITIALIZE NEXT INPUT FILE.
         L     1,8(,4)             R1 POINTS TO PREVIOUS INFILE ADR.
         MVC   0(4,1),0(4)         SKIP CLOSED FILE; POINT TO NEXT.
         L     1,0(,4)             R1 NOW ADR OF NEXT INFILE SEGMENT.
         MVC   8(4,1),8(4)         NEXT INFILE POINTS TO PREV INFILE.
         L     1,INFILE            IN CASE OF CHANGE RESET POINTERS.
         L     2,0(,1)             R2 NOW ADR OF 2ND INFILE AREA.
         STM   1,2,INP1ST          INP1ST/2ND; INITIAL INPUT PAIR.
         L     1,INPCNT            CHECKING FOR ANY REMAINING FILE.
         BCTR  1,0                 LESS CLOSED INPUT FILE.
         ST    1,INPCNT            SAVE NEW INPUT FILES COUNT.
         LTR   1,1                 Q,ANY REMAINING FILE?
         BP    MER500               Y,MERGE REMAINING FILES.
         EJECT
*---------------------------------------------------------------------*
*        E N D    O F    J O B    R O U T I N E
*---------------------------------------------------------------------*
MER750   DS    0H
         LR    1,13
         SH    1,=Y(3*8)           R1 NOW ADR OF MERG999 SYSDATE,ETC.
         MVC   PRTOUT+1(3*8),0(1)  MOVES ‘MERG999 MM/DD/YYHH/MM/SS’
         PUT   SYSLST,PRTOUT       NEW PAGE PRINT MERG999 INFO.
         MVC   PRTOUT,PRTOUT-1     BLANK-OUT PRINT AREA.
         LM    3,4,EOJCNT          LOAD EOJ PARAMETERS.
MER800   DS    0H
         AP    OUTCNT,16(5,4)      ADD INPUT FILE COUNT TO OUTCNT.
         MVC   PRTOUT+L'EDCNT+4(3),21(4)  INPUT FILE # 001->999.
         MVC   PRTOUT+L'EDCNT+1(3),=C'INP'  NOW INP001->INP999.
         MVC   PRTOUT(L'EDCNT),EDCNT  MOVE EDIT PATTERN.
         ED    PRTOUT(L'EDCNT),16(4)  EDIT INPUT FILE COUNT.
         PUT   SYSLST,PRTOUT       PRINT INPUT FILE COUNT.
         L     4,4(,4)             POINT TO NEXT INFILE SEGMENT.
         BCT   3,MER800            GO TO PRINT NEXT INPUT FILE COUNT.
MER900   DS    0H
         MVC   PRTOUT+L'EDCNT+1(6),=C'MERGED'
         MVC   PRTOUT(L'EDCNT),EDCNT
         ED    PRTOUT(L'EDCNT),OUTCNT
         PUT   SYSLST,PRTOUT       PRINT FINAL OUTPUT MERGED COUNT.
         CLOSE (MERGED,,SYSLST)
         L     13,4(,13)           RESTORE O/S R13.
         LM    14,12,12(13)        RESTORE O/S REGISTERS.
         XR    15,15               RETURN CODE: ALWAYS GOOD
         BR    14                  RETURN TO O/S CONTROL.
*
INPNUM   DC    0D,PL8'0'           001-999
         DC    C’ ‘       1X4      NEEDED TO BLANK-OUT PRTOUT.
PRTOUT   DS    0CL25      2X4      PRINTER OUTPUT AREA.
         DC    C’1’       3X4      SKIP TO CHANNEL-1, NEW PAGE.
         DS    CL24       4X4
OUTCNT   DC    PL5'0'              OUTPUT MERGED COUNT.
EDCNT    DC    X'402020206B2020206B212020'
*
OPRMSG   DC    0F,Y(OPRLEN,0)                 1X3
OPRNUM   DC    C'000',C' INPUT FILES FOUND.'  2X3
OPRLEN   EQU   *-OPRMSG                       3X3
*
INPCNT   DS    A   1X3             ACTUAL # OF FILES TO BE MERGED.
INP1ST   DS    A   2X3             ADR OF 1ST INFILE SEGMENT.
INP2ND   DS    A   3X3             ADR OF 2ND INFILE SEGMENT.
EOJCNT   DS    A   1X2             ACTUAL # OF FILES (FOR EOJ).
EOJ1ST   DS    A   2X2             ADR OF 1ST INFILE (FOR EOJ).
*
INFILE   DC    A(0,0,0,XFFKEY),PL5'0',C'000'                 1X4
XFFKEY   DC    0XL16,16X'FF'                                 2X4
INP000   DCB   DDNAME=INP000,DSORG=PS,MACRF=GL,EODAD=MER700  3X4
INPLEN   EQU   *-INFILE                                      4X4
*
MERGED   DCB   DDNAME=MERGED,DSORG=PS,MACRF=PM,RECFM=FB
*
SYSLST   DCB   DDNAME=SYSLST,DSORG=PS,MACRF=PM,LRECL=25,RECFM=FBA
*
         END   MER000

© Copyright Edward Soto & IT Doctors.co.uk. 2003