Mainframe Utility: INSCOPY

Return to Mainframe Utilities Page

Module


ISREDIT MACRO (OPT1 OPT2)
ISPEXEC CONTROL ERRORS RETURN
/**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT
IF &OPT1 = HELP THEN GOTO HELPSEC
/**********************************************************************
/* UTILITY: INSCOPY                                                   *
/* AUTHOR: DAVID LEIGH                                                *
/* FUNCTION: THIS EDIT MACRO PARSES A COBOL PROGRAM LOOKING FOR       *
/*           UNCOMMENTED "COPY" STATEMENTS, READS THE COPY LIBRARIES, *
/*           AND INSERTS THE CONTENTS OF THE COPY LIBRARIES AS        *
/*           MESSAGE LINES IN THE COBOL PROGRAM.                      *
/**********************************************************************

/**********************************************************************
/* PARSE ANY PASSED OPTIONS                                           *
/**********************************************************************
SET LINETYPE = MSGLINE
IF &STR(&OPT1) = WRITE THEN +
    DO
        SET LINETYPE = DATALINE
        SET OPT1 = &STR(&SYSNSUB(1,&OPT2))
        SET OPT2 =
    END
IF &STR(&OPT2) = WRITE THEN +
    DO
        SET LINETYPE = DATALINE
        SET OPT2 =
    END
/**********************************************************************
/* SAVE THE USER'S CURRENT LOCATION.                                  *
/**********************************************************************
ISREDIT (SLN,SCL) = CURSOR

/**********************************************************************
/* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED?                  *
/**********************************************************************
ISREDIT (X,Y) = NUMBER
IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN +
    DO
        SET COL1 = 1
        SET COL2 = 66
    END
ELSE +
    DO
        SET COL1 = 7
        SET COL2 = 72
    END

/**********************************************************************
/* ATTEMPT TO DETERMINE IF THIS IS A GSS OR SLSS SEARCH               *
/**********************************************************************
ISREDIT (DATASET) = DATASET
ISREDIT (MEMBER) = MEMBER
IF &SUBSTR(1:2,&STR(&SYSUID)) = &STR(P@) THEN SET SEARCH = SLSS
IF &SUBSTR(1:2,&STR(&SYSUID)) = &STR(P#) THEN SET SEARCH = GSS
IF &SYSINDEX(&STR(SLSS.),&STR(&DATASET)) > 0 THEN SET SEARCH = SLSS
IF &SYSINDEX(&STR(GSS.),&STR(&DATASET)) > 0 THEN SET SEARCH = GSS
IF &SYSINDEX(&STR(SLS),&STR(&DATASET)) = 1 THEN SET SEARCH = SLSS
IF &SYSINDEX(&STR(GSS),&STR(&DATASET)) = 1 THEN SET SEARCH = GSS
IF &SEARCH =      THEN SET SEARCH = SLSS

/**********************************************************************
/* START LOOPING THROUGH THE CODE AND GETTING THE COPY MEMBERS.       *
/**********************************************************************
SET GOOD = 0
SET BAD  = 0
ISREDIT RESET EXCLUDED
ISREDIT EXCLUDE ALL '*' &COL1
ISREDIT FIND FIRST ' COPY ' &COL1 &EVAL(&COL1 + 55 + 3) NX

DO WHILE &LASTCC = 0
    ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
    ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
    ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
    ISREDIT (LN,CL1) = CURSOR
/*  ISREDIT CURSOR = &LN &EVAL(&CL1 + 8)
/*  ISREDIT FIND PREV '.' .ZCSR .ZCSR
/*  ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
    ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
    ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
    ISREDIT (NULL,CL2) = CURSOR
    ISREDIT (MEMBER) = LINE .ZCSR
    IF &SUBSTR(&CL2:&CL2,&STR(&MEMBER)) = &STR(.) THEN +
        SET &CL2 = &CL2 - 1
    IF &CL2 < &CL1 OR &CL2 > &LENGTH(&STR(&MEMBER)) THEN +
        SET MEMBER =
    ELSE +
        SET MEMBER = &SUBSTR(&CL1:&CL2,&STR(&MEMBER))
    IF &STR(&MEMBER) =     THEN +
        DO
          SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
          ISPEXEC CONTROL DISPLAY LOCK
          ISPEXEC DISPLAY MSG(UTLZ000W)
          ISREDIT LABEL .ZCSR = .CURR
          ISREDIT SEEK NEXT P'=' 1
          IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
          ELSE +
              DO
                  SET XLABEL = &STR(.ZLAST)
                  ISREDIT LINE_AFTER .ZLAST = ' '
              END
          SET HEADER  = &STR(*** COULD NOT FIND THE COPYBOOK NAME ON +
                               THIS LINE ***)
          ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
          SET BAD = &BAD + 1
          GOTO GETNEXT
        END
/**********************************************************************/
/* THIS SELECT IS REPEATED IN THIS CLIST ELSEWHERE                    */
/**********************************************************************/
    SELECT
        WHEN (&SYSDSN('&OPT1(&MEMBER)')=OK) +
            SET DSN = &STR(&OPT1)
        WHEN (&SYSDSN('&SYSUID..&SEARCH..COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SYSUID..&SEARCH..COPYLIB)
        WHEN (&SYSDSN('&SYSUID..STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SYSUID..STR.COPYLIB)
        WHEN (&SYSDSN('QDEVL.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(QDEVL.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRD00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRD00.DCLGEN)
        WHEN (&SYSDSN('PDBA.USELMD00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USELMD00.DCLGEN)
        WHEN (&SYSDSN('QQUAL.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(QQUAL.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRQ00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRQ00.DCLGEN)
        WHEN (&SYSDSN('&SEARCH..RFP.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SEARCH..RFP.COPYLIB)
        WHEN (&SYSDSN('MMODO.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(MMODO.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRM00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRM00.DCLGEN)
        WHEN (&SYSDSN('&SEARCH..PRD.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SEARCH..PRD.COPYLIB)
        WHEN (&SYSDSN('PEMER.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(PEMER.STR.COPYLIB)
        WHEN (&SYSDSN('PPROD.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(PPROD.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRP00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRP00.DCLGEN)
        WHEN (&SYSDSN('SYS4.CICS.COBLIB(&MEMBER)')=OK) +
            SET DSN = &STR(SYS4.CICS.COBLIB)
        WHEN (&SYSDSN('SYS3.CACOMMON.PROD.CAIMAC(&MEMBER)')=OK) +
            SET DSN = &STR(SYS3.CACOMMON.PROD.CAIMAC)
        WHEN (&SYSDSN('SYS3.ACF2CICS.PROD.ACFMAC(&MEMBER)')=OK) +
            SET DSN = &STR(SYS3.ACF2CICS.PROD.ACFMAC)
        WHEN (&SYSDSN('CRS.V2R1M0.SELACOPY(&MEMBER)')=OK) +
            SET DSN = &STR(CRS.V2R1M0.SELACOPY)
        OTHERWISE SET DSN =
    END
    IF &STR(&DSN) >     THEN +
        DO
            SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
            ISPEXEC CONTROL DISPLAY LOCK
            ISPEXEC DISPLAY MSG(UTLZ000W)
            ISREDIT LABEL .ZCSR = .CURR
            ISREDIT SEEK NEXT P'=' 1
            IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
            ELSE +
                DO
                    SET XLABEL = &STR(.ZLAST)
                    ISREDIT LINE_AFTER .ZLAST = ' '
                END
            SET GOOD = &GOOD + 1
            SET HEADER = &STR(>>> COPYBOOK "&DSN(&MEMBER)" AS OF +
                              &SYSDATE &SYSTIME <<<)
            ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
            ISPEXEC LMINIT DATAID(COPYDID) DATASET('&DSN')
            ISPEXEC LMOPEN DATAID(&COPYDID)
            ISPEXEC LMMFIND DATAID(&COPYDID) MEMBER(&MEMBER)
            ISPEXEC LMGET DATAID(&COPYDID) +
                          MODE(INVAR) +
                          DATALOC(COPYDD) +
                          DATALEN(NULL) +
                          MAXLEN(80)
            DO WHILE &LASTCC < 8
                ERROR DO
                    RETURN
                END
                IF &COL2 = 66 THEN +
                    SET COPYDD = &SUBSTR(7:80,&STR(&SYSNSUB(1,&COPYDD)))
                ERROR OFF
                ISREDIT LINE_BEFORE &XLABEL = &LINETYPE (COPYDD)
                ISPEXEC LMGET DATAID(&COPYDID) +
                              MODE(INVAR) +
                              DATALOC(COPYDD) +
                              DATALEN(NULL) +
                              MAXLEN(80)
            END
            ISPEXEC LMCLOSE DATAID(&COPYDID)
            ISPEXEC LMFREE DATAID(&COPYDID)
            IF &XLABEL = &STR(.ZLAST) THEN ISREDIT DELETE .ZLAST
        END
    ELSE +
        DO
          SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
          ISPEXEC CONTROL DISPLAY LOCK
          ISPEXEC DISPLAY MSG(UTLZ000W)
          ISREDIT LABEL .ZCSR = .CURR
          ISREDIT SEEK NEXT P'=' 1
          IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
          ELSE +
              DO
                  SET XLABEL = &STR(.ZLAST)
                  ISREDIT LINE_AFTER .ZLAST = ' '
              END
          SET HEADER = &STR(>>> COPYBOOK "&DSN(&MEMBER)" NOT FOUND +
                      AS OF &SYSDATE &SYSTIME <<<)
          ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
          SET BAD = &BAD + 1
          GOTO GETNEXT
        END
GETNEXT: +
    ISREDIT FIND LAST P'=' .CURR .CURR
    ISREDIT FIND NEXT ' COPY ' &COL1 &EVAL(&COL1 + 55 + 3) NX
END

/**********************************************************************
/* START LOOPING THROUGH THE CODE AND GETTING THE CICSCOPY MEMBERS    *
/**********************************************************************
ISREDIT RESET EXCLUDED
ISREDIT EXCLUDE ALL '*' &COL1
ISREDIT FIND FIRST ' CICSCOPY ' &COL1 &EVAL(&COL1 + 51 + 3) NX

DO WHILE &LASTCC = 0
    ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
    ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
    ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
    ISREDIT (LN,CL1) = CURSOR
/*  ISREDIT CURSOR = &LN &EVAL(&CL1 + 8)
/*  ISREDIT FIND PREV '.' .ZCSR .ZCSR
/*  ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
    ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
    ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
    ISREDIT (NULL,CL2) = CURSOR
    ISREDIT (MEMBER) = LINE .ZCSR
    IF &SUBSTR(&CL2:&CL2,&STR(&MEMBER)) = &STR(.) THEN +
        SET &CL2 = &CL2 - 1
    IF &CL2 < &CL1 OR &CL2 > &LENGTH(&STR(&MEMBER)) THEN +
        SET MEMBER =
    ELSE +
        SET MEMBER = &SUBSTR(&CL1:&CL2,&STR(&MEMBER))
    IF &STR(&MEMBER) =     THEN +
        DO
          SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
          ISPEXEC CONTROL DISPLAY LOCK
          ISPEXEC DISPLAY MSG(UTLZ000W)
          ISREDIT LABEL .ZCSR = .CURR
          ISREDIT SEEK NEXT P'=' 1
          IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
          ELSE +
              DO
                  SET XLABEL = &STR(.ZLAST)
                  ISREDIT LINE_AFTER .ZLAST = ' '
              END
          SET HEADER  = &STR(*** COULD NOT FIND THE COPYBOOK NAME ON +
                               THIS LINE ***)
          ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
          SET BAD = &BAD + 1
          GOTO GETNEXT2
        END
/**********************************************************************/
/* THIS SELECT IS REPEATED IN THIS CLIST ELSEWHERE                    */
/**********************************************************************/
    SELECT
        WHEN (&SYSDSN('&OPT1(&MEMBER)')=OK) +
            SET DSN = &STR(&OPT1)
        WHEN (&SYSDSN('&SYSUID..&SEARCH..COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SYSUID..&SEARCH..COPYLIB)
        WHEN (&SYSDSN('&SYSUID..STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SYSUID..STR.COPYLIB)
        WHEN (&SYSDSN('QDEVL.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(QDEVL.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRD00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRD00.DCLGEN)
        WHEN (&SYSDSN('PDBA.USELMD00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USELMD00.DCLGEN)
        WHEN (&SYSDSN('QQUAL.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(QQUAL.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRQ00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRQ00.DCLGEN)
        WHEN (&SYSDSN('&SEARCH..RFP.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SEARCH..RFP.COPYLIB)
        WHEN (&SYSDSN('MMODO.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(MMODO.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRM00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRM00.DCLGEN)
        WHEN (&SYSDSN('&SEARCH..PRD.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SEARCH..PRD.COPYLIB)
        WHEN (&SYSDSN('PEMER.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(PEMER.STR.COPYLIB)
        WHEN (&SYSDSN('PPROD.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(PPROD.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRP00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRP00.DCLGEN)
        WHEN (&SYSDSN('SYS4.CICS.COBLIB(&MEMBER)')=OK) +
            SET DSN = &STR(SYS4.CICS.COBLIB)
        WHEN (&SYSDSN('SYS3.CACOMMON.PROD.CAIMAC(&MEMBER)')=OK) +
            SET DSN = &STR(SYS3.CACOMMON.PROD.CAIMAC)
        WHEN (&SYSDSN('SYS3.ACF2CICS.PROD.ACFMAC(&MEMBER)')=OK) +
            SET DSN = &STR(SYS3.ACF2CICS.PROD.ACFMAC)
        WHEN (&SYSDSN('CRS.V2R1M0.SELACOPY(&MEMBER)')=OK) +
            SET DSN = &STR(CRS.V2R1M0.SELACOPY)
        OTHERWISE SET DSN =
    END
    IF &STR(&DSN) >     THEN +
        DO
            SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
            ISPEXEC CONTROL DISPLAY LOCK
            ISPEXEC DISPLAY MSG(UTLZ000W)
            ISREDIT LABEL .ZCSR = .CURR
            ISREDIT SEEK NEXT P'=' 1
            IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
            ELSE +
                DO
                    SET XLABEL = &STR(.ZLAST)
                    ISREDIT LINE_AFTER .ZLAST = ' '
                END
            SET GOOD = &GOOD + 1
            SET HEADER = &STR(>>> COPYBOOK "&DSN(&MEMBER)" AS OF +
                              &SYSDATE &SYSTIME <<<)
            ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
            ISPEXEC LMINIT DATAID(COPYDID) DATASET('&DSN')
            ISPEXEC LMOPEN DATAID(&COPYDID)
            ISPEXEC LMMFIND DATAID(&COPYDID) MEMBER(&MEMBER)
            ISPEXEC LMGET DATAID(&COPYDID) +
                          MODE(INVAR) +
                          DATALOC(COPYDD) +
                          DATALEN(NULL) +
                          MAXLEN(80)
            DO WHILE &LASTCC < 8
                ERROR DO
                    RETURN
                END
                IF &COL2 = 66 THEN +
                    SET COPYDD = &SUBSTR(7:80,&STR(&SYSNSUB(1,&COPYDD)))
                ERROR OFF
                ISREDIT LINE_BEFORE &XLABEL = &LINETYPE (COPYDD)
                ISPEXEC LMGET DATAID(&COPYDID) +
                              MODE(INVAR) +
                              DATALOC(COPYDD) +
                              DATALEN(NULL) +
                              MAXLEN(80)
            END
            ISPEXEC LMCLOSE DATAID(&COPYDID)
            ISPEXEC LMFREE DATAID(&COPYDID)
            IF &XLABEL = &STR(.ZLAST) THEN ISREDIT DELETE .ZLAST
        END
    ELSE +
        DO
          SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
          ISPEXEC CONTROL DISPLAY LOCK
          ISPEXEC DISPLAY MSG(UTLZ000W)
          ISREDIT LABEL .ZCSR = .CURR
          ISREDIT SEEK NEXT P'=' 1
          IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
          ELSE +
              DO
                  SET XLABEL = &STR(.ZLAST)
                  ISREDIT LINE_AFTER .ZLAST = ' '
              END
          SET HEADER = &STR(>>> COPYBOOK "&DSN(&MEMBER)" NOT FOUND +
                      AS OF &SYSDATE &SYSTIME <<<)
          ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
          SET BAD = &BAD + 1
          GOTO GETNEXT2
        END
GETNEXT2: +
    ISREDIT FIND LAST P'=' .CURR .CURR
    ISREDIT FIND NEXT ' CICSCOPY ' &COL1 &EVAL(&COL1 + 51 + 3) NX
END

/**********************************************************************
/* START LOOPING THROUGH THE CODE AND GETTING THE INCLUDE MEMBERS     *
/**********************************************************************
ISREDIT RESET EXCLUDED
ISREDIT EXCLUDE ALL '*' &COL1
ISREDIT FIND FIRST ' INCLUDE ' &COL1 &EVAL(&COL1 + 52 + 3) NX

DO WHILE &LASTCC = 0
    ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
    ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
    ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
    ISREDIT (LN,CL1) = CURSOR
/*  ISREDIT CURSOR = &LN &EVAL(&CL1 + 8)
/*  ISREDIT FIND PREV '.' .ZCSR .ZCSR
/*  ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
    ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
    ISREDIT FIND PREV P'¬' .ZCSR .ZCSR
    ISREDIT (NULL,CL2) = CURSOR
    ISREDIT (MEMBER) = LINE .ZCSR
    IF &SUBSTR(&CL2:&CL2,&STR(&MEMBER)) = &STR(.) THEN +
        SET &CL2 = &CL2 - 1
    IF &CL2 < &CL1 OR &CL2 > &LENGTH(&STR(&MEMBER)) THEN +
        SET MEMBER =
    ELSE +
        SET MEMBER = &SUBSTR(&CL1:&CL2,&STR(&MEMBER))
    IF &STR(&MEMBER) =     THEN +
        DO
          SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
          ISPEXEC CONTROL DISPLAY LOCK
          ISPEXEC DISPLAY MSG(UTLZ000W)
          ISREDIT LABEL .ZCSR = .CURR
          ISREDIT SEEK NEXT P'=' 1
          IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
          ELSE +
              DO
                  SET XLABEL = &STR(.ZLAST)
                  ISREDIT LINE_AFTER .ZLAST = ' '
              END
          SET HEADER  = &STR(*** COULD NOT FIND THE COPYBOOK NAME ON +
                               THIS LINE ***)
          ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
          SET BAD = &BAD + 1
          GOTO GETNEXT2
        END
/**********************************************************************/
/* THIS SELECT IS REPEATED IN THIS CLIST ELSEWHERE                    */
/**********************************************************************/
    SELECT
        WHEN (&SYSDSN('&OPT1(&MEMBER)')=OK) +
            SET DSN = &STR(&OPT1)
        WHEN (&SYSDSN('&SYSUID..&SEARCH..COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SYSUID..&SEARCH..COPYLIB)
        WHEN (&SYSDSN('&SYSUID..STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SYSUID..STR.COPYLIB)
        WHEN (&SYSDSN('QDEVL.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(QDEVL.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRD00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRD00.DCLGEN)
        WHEN (&SYSDSN('PDBA.USELMD00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USELMD00.DCLGEN)
        WHEN (&SYSDSN('QQUAL.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(QQUAL.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRQ00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRQ00.DCLGEN)
        WHEN (&SYSDSN('&SEARCH..RFP.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SEARCH..RFP.COPYLIB)
        WHEN (&SYSDSN('MMODO.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(MMODO.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRM00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRM00.DCLGEN)
        WHEN (&SYSDSN('&SEARCH..PRD.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(&SEARCH..PRD.COPYLIB)
        WHEN (&SYSDSN('PEMER.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(PEMER.STR.COPYLIB)
        WHEN (&SYSDSN('PPROD.STR.COPYLIB(&MEMBER)')=OK) +
            SET DSN = &STR(PPROD.STR.COPYLIB)
        WHEN (&SYSDSN('PDBA.USSTRP00.DCLGEN(&MEMBER)')=OK) +
            SET DSN = &STR(PDBA.USSTRP00.DCLGEN)
        WHEN (&SYSDSN('SYS4.CICS.COBLIB(&MEMBER)')=OK) +
            SET DSN = &STR(SYS4.CICS.COBLIB)
        WHEN (&SYSDSN('SYS3.CACOMMON.PROD.CAIMAC(&MEMBER)')=OK) +
            SET DSN = &STR(SYS3.CACOMMON.PROD.CAIMAC)
        WHEN (&SYSDSN('SYS3.ACF2CICS.PROD.ACFMAC(&MEMBER)')=OK) +
            SET DSN = &STR(SYS3.ACF2CICS.PROD.ACFMAC)
        WHEN (&SYSDSN('CRS.V2R1M0.SELACOPY(&MEMBER)')=OK) +
            SET DSN = &STR(CRS.V2R1M0.SELACOPY)
        OTHERWISE SET DSN =
    END
    IF &STR(&DSN) >     THEN +
        DO
            SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
            ISPEXEC CONTROL DISPLAY LOCK
            ISPEXEC DISPLAY MSG(UTLZ000W)
            ISREDIT LABEL .ZCSR = .CURR
            ISREDIT SEEK NEXT P'=' 1
            IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
            ELSE +
                DO
                    SET XLABEL = &STR(.ZLAST)
                    ISREDIT LINE_AFTER .ZLAST = ' '
                END
            SET GOOD = &GOOD + 1
            SET HEADER = &STR(>>> COPYBOOK "&DSN(&MEMBER)" AS OF +
                              &SYSDATE &SYSTIME <<<)
            ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
            ISPEXEC LMINIT DATAID(COPYDID) DATASET('&DSN')
            ISPEXEC LMOPEN DATAID(&COPYDID)
            ISPEXEC LMMFIND DATAID(&COPYDID) MEMBER(&MEMBER)
            ISPEXEC LMGET DATAID(&COPYDID) +
                          MODE(INVAR) +
                          DATALOC(COPYDD) +
                          DATALEN(NULL) +
                          MAXLEN(80)
            DO WHILE &LASTCC < 8
                ERROR DO
                    RETURN
                END
                IF &COL2 = 66 THEN +
                    SET COPYDD = &SUBSTR(7:80,&STR(&SYSNSUB(1,&COPYDD)))
                ERROR OFF
                ISREDIT LINE_BEFORE &XLABEL = &LINETYPE (COPYDD)
                ISPEXEC LMGET DATAID(&COPYDID) +
                              MODE(INVAR) +
                              DATALOC(COPYDD) +
                              DATALEN(NULL) +
                              MAXLEN(80)
            END
            ISPEXEC LMCLOSE DATAID(&COPYDID)
            ISPEXEC LMFREE DATAID(&COPYDID)
            IF &XLABEL = &STR(.ZLAST) THEN ISREDIT DELETE .ZLAST
        END
    ELSE +
        DO
          SET ZEDLMSG = &STR(*** PROCESSING "&DSN(&MEMBER)" ***)
          ISPEXEC CONTROL DISPLAY LOCK
          ISPEXEC DISPLAY MSG(UTLZ000W)
          ISREDIT LABEL .ZCSR = .CURR
          ISREDIT SEEK NEXT P'=' 1
          IF &LASTCC = 0 THEN SET XLABEL = &STR(.ZCSR)
          ELSE +
              DO
                  SET XLABEL = &STR(.ZLAST)
                  ISREDIT LINE_AFTER .ZLAST = ' '
              END
          SET HEADER = &STR(>>> COPYBOOK "&DSN(&MEMBER)" NOT FOUND +
                      AS OF &SYSDATE &SYSTIME <<<)
          ISREDIT LINE_BEFORE &XLABEL = MSGLINE (HEADER)
          SET BAD = &BAD + 1
          GOTO GETNEXT3
        END
GETNEXT3: +
    ISREDIT FIND LAST P'=' .CURR .CURR
    ISREDIT FIND NEXT ' INCLUDE ' &COL1 &EVAL(&COL1 + 52 + 3) NX
END

SET TOTAL = &EVAL(&GOOD + &BAD)
SET ZEDLMSG = &STR(*** &GOOD OF &TOTAL COPY MEMBERS WERE SUCCESSFULLY +
                   PROCESSED ***)
IF &TOTAL = &GOOD THEN +
    ISPEXEC SETMSG MSG(UTLZ000)
ELSE +
    ISPEXEC SETMSG MSG(UTLZ001)

ISREDIT RESET EXCLUDED
ISREDIT CURSOR = &SLN &SCL

EXIT

HELPSEC: +                                                              02480000
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)                             02490000
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR INSCOPY UTILITY +             02490000
                   *** NO PROCESSING PERFORMED ***)                     02490000
ISPEXEC SETMSG MSG(UTLZ000)                                             02490000

EXIT
            


Documentation


 The INSCOPY edit macro will insert the lines from all of the copy book members
 in a COBOL program into the program as edit "message" lines.

 So, you're editing your program and you would like to see all of your copy book
 lines.  Just type INSCOPY on the command line and it will parse your program
 for all the uncommented "COPY" verbs and their associated member names.  It
 then reads those members and inserts the lines in your code as edit "message"
 lines.  When we upgrade to the next level of ISPF, you will be able to actually
 make those message lines into normal data lines and store them with your code
 using the new MD ("make data") line command.
            


Leave a Reply

Your email address will not be published. Required fields are marked *