|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
/**********************************************************************
/* UTILITY: MAPREDEF *
/* AUTHOR: DAVID LEIGH *
/* FUNCTION: THIS UTILITY CONVERTS "VANILLA" CICS BMS MAP COBOL *
/* SYMBOLIC LAYOUTS TO A MORE READABLE REDEFINES. IT *
/* TAKES INPUT OF A PREFIX STRING SUCH AS "MAP-" WHICH IT *
/* PREFIXES TO ALL THE DATA NAMES AND THEN SUFFIXES THE *
/* ATTRIBUTE, FLAG, AND LENGTH DATANAMES WITH LENG, *
/* ATTR AND FLAG. THE ACTUAL DATA FIELD SUFFIX OF "I" IS *
/* REMOVED. A BLANK COMMENT BOX IS PLACED BEFORE THE *
/* DEFINITION AND EACH FIELD HAS AN ASTERISK SEPARATOR *
/* LINE IN FRONT OF IT. *
/**********************************************************************
ISREDIT MACRO (PREFIX)
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
/**********************************************************************
/* EDIT THE USER INPUT *
/**********************************************************************
IF &STR(&PREFIX) = THEN +
DO
SET ZEDLMSG = &STR(*** A FIELD NAME PREFIX MUST BE +
SPECIFIED ***)
ISPEXEC SETMSG MSG(UTLZ001)
EXIT CODE(12)
END
/**********************************************************************
/* GET RID OF THE "OUTPUT" REDEFINES AND SET SOME VARIABLES *
/**********************************************************************
SET SEPARATE = &STR( ********************************************)+
&STR(*********************)
SET LINEBREK = &STR( /*******************************************)+
&STR(*********************)
SET OPENBOXL = &STR( * )+
&STR( *)
SET LP = &STR((
SET RP = &STR())
ISREDIT FIND LAST ' 01 '
ISREDIT DELETE .ZCSR .ZLAST
/**********************************************************************
/* LOOP THROUGH AND MAKE THE FORMATTING CHANGES *
/**********************************************************************
ISREDIT FIND FIRST P' ## ' 1 20
DO WHILE &LASTCC = 0
ISREDIT (SYSDVAL) = LINE .ZCSR
READDVAL LEVEL NAME PARM1 PARM2 PARM3
SET LNAME = &LENGTH(&STR(&NAME))
IF &STR(&NAME) = FILLER THEN +
DO
IF &STR(&PARM1) = PIC THEN +
DO
SET LEVEL = &STR(05)
SET L = &SYSINDEX(&STR(&LP),&STR(&PARM2))
SET R = &SYSINDEX(&STR(&RP),&STR(&PARM2))
IF &SUBSTR(1:2,&STR(&PARM2)) = &STR(S9) THEN +
SET SPC =
ELSE +
SET SPC = &STR( )
IF &EVAL(&R-&L) = 2 THEN +
SET PICTURE = &STR(PIC )+
&STR(&SPC)+
&SUBSTR(1:&L,&STR(&PARM2))+
&STR(0)+
&SUBSTR(&L+1:&R,&STR(&PARM2))+
&STR(.)
ELSE +
SET PICTURE = &STR(PIC )+
&STR(&SPC)+
&SUBSTR(1:&R,&STR(&PARM2))+
&STR(.)
END
IF &STR(&PARM1) = REDEFINES THEN +
DO
ISREDIT DELETE .ZCSR .ZCSR
GOTO GETNEXT
END
END
ELSE +
DO
SELECT (&SUBSTR(&LNAME:&LNAME,&STR(&NAME)))
WHEN (.) DO
SET SUFFIX = &STR(-AREA REDEFINES &NAME)
SET LNAME = &LNAME - 1
SET PICTURE =
SET LEVEL = &STR(01)
END
WHEN (I) DO
SET LEVEL = &STR(05)
SET SUFFIX =
SET L = &SYSINDEX(&STR(&LP),&STR(&PARM2))
SET R = &SYSINDEX(&STR(&RP),&STR(&PARM2))
IF &SUBSTR(1:2,&STR(&PARM2)) = &STR(S9) THEN +
SET SPC =
ELSE +
SET SPC = &STR( )
IF &EVAL(&R-&L) = 2 THEN +
SET PICTURE = &STR(PIC )+
&STR(&SPC)+
&SUBSTR(1:&L,&STR(&PARM2))+
&STR(0)+
&SUBSTR(&L+1:&R,&STR(&PARM2))+
&STR(.)
ELSE +
SET PICTURE = &STR(PIC )+
&STR(&SPC)+
&SUBSTR(1:&R,&STR(&PARM2))+
&STR(.)
END
WHEN (L) DO
ISREDIT LINE_BEFORE .ZCSR = (SEPARATE)
SET LEVEL = &STR(05)
SET SUFFIX = &STR(-LENG)
SET PICTURE = &STR(PIC S9(04) COMP.)
END
WHEN (A) DO
SET LEVEL = &STR(05)
SET SUFFIX = &STR(-ATTR REDEFINES)
SET PICTURE =
END
WHEN (F) DO
SET LEVEL = &STR(05)
SET SUFFIX = &STR(-FLAG)
SET PICTURE = &STR(PIC X(01).)
SET PREVNAME = &STR(XXXXXXXXXX)
END
END
SET NAME = &STR(&PREFIX)+
&SUBSTR(1:&LNAME-1,&STR(&NAME))+
&STR(&SUFFIX)
END
SELECT (&STR(&LEVEL))
WHEN (01) DO
SET LEVLOC = 08
SET NAMLOC = 12
SET PICLOC = 56
END
WHEN (05) DO
SET LEVLOC = 12
SET NAMLOC = 16
SET PICLOC = 56
END
END
ISREDIT LINE .ZCSR = <(LEVLOC,LEVEL) (NAMLOC,NAME) (PICLOC,PICTURE)>
IF &STR(&PREVNAME) > AND +
&STR(&PREVNAME) ¬= &STR(XXXXXXXXXX) THEN +
DO
SET PICTURE = &STR(PIC X(01).)
SET NAME = &STR(&PREVNAME)
ISREDIT LINE_AFTER .ZCSR = <(NAMLOC,NAME) (PICLOC,PICTURE)>
SET PREVNAME =
END
IF &STR(&PREVNAME) = &STR(XXXXXXXXXX) THEN +
SET PREVNAME = &STR(&NAME)
ISREDIT FIND FIRST P'=' 30 .ZCSR .ZCSR
GETNEXT: +
ISREDIT FIND NEXT P' ## ' 1 20
END
ISREDIT LINE_BEFORE .ZFIRST = (SEPARATE)
ISREDIT LINE_BEFORE .ZFIRST = (OPENBOXL)
ISREDIT LINE_BEFORE .ZFIRST = (LINEBREK)
ISREDIT CURSOR = 1 1
EXIT
|
|
