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(©DID)
ISPEXEC LMMFIND DATAID(©DID) MEMBER(&MEMBER)
ISPEXEC LMGET DATAID(©DID) +
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,©DD)))
ERROR OFF
ISREDIT LINE_BEFORE &XLABEL = &LINETYPE (COPYDD)
ISPEXEC LMGET DATAID(©DID) +
MODE(INVAR) +
DATALOC(COPYDD) +
DATALEN(NULL) +
MAXLEN(80)
END
ISPEXEC LMCLOSE DATAID(©DID)
ISPEXEC LMFREE DATAID(©DID)
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(©DID)
ISPEXEC LMMFIND DATAID(©DID) MEMBER(&MEMBER)
ISPEXEC LMGET DATAID(©DID) +
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,©DD)))
ERROR OFF
ISREDIT LINE_BEFORE &XLABEL = &LINETYPE (COPYDD)
ISPEXEC LMGET DATAID(©DID) +
MODE(INVAR) +
DATALOC(COPYDD) +
DATALEN(NULL) +
MAXLEN(80)
END
ISPEXEC LMCLOSE DATAID(©DID)
ISPEXEC LMFREE DATAID(©DID)
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(©DID)
ISPEXEC LMMFIND DATAID(©DID) MEMBER(&MEMBER)
ISPEXEC LMGET DATAID(©DID) +
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,©DD)))
ERROR OFF
ISREDIT LINE_BEFORE &XLABEL = &LINETYPE (COPYDD)
ISPEXEC LMGET DATAID(©DID) +
MODE(INVAR) +
DATALOC(COPYDD) +
DATALEN(NULL) +
MAXLEN(80)
END
ISPEXEC LMCLOSE DATAID(©DID)
ISPEXEC LMFREE DATAID(©DID)
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.

0 Comments