Return to Mainframe Utilities Page
Module
ISREDIT MACRO
CONTROL NOFLUSH
/* KEY PKK AT THE TOP OF A COBOL PROGRAM AND THIS CLIST WILL */
/* CALCULATE ALL OF THE PICTURE CLAUSES FOR YOU. IT WILL */
/* REPLACE PIC(KK) WITH THE CORRECT VALUE AND IT WILL */
/* ADD THE PICTURE CLAUSE TO LINES WITH JUST THE VALUE CLAUSE */
/* ON IT. (I.E VALUE 'TEST'. WILL BE PIC X(04) VALUE 'TEST'. */
SET &CNT = 0
SET &VALU = 'VALUE'
SET &PIC = 'PIC'
SET &TICK = &NRSTR(')
SET &PICKK = 'PIC X(&&COLLEN.) VALUE'
SET &CHNGE = '(KK)'
DOOVER: -
ISREDIT FIND &VALU NEXT
IF &LASTCC EQ 4 THEN -
DO
IF &CNT = 0 THEN -
DO
SET ZEDSMSG = &STR(STRING NOT FOUND)
ISPEXEC SETMSG MSG(ISRZ001)
GOTO ENDIT
END
ELSE -
DO
SET ZEDSMSG = &STR(REPLACED &CNT PIC CLAUSES)
ISPEXEC SETMSG MSG(ISRZ001)
GOTO ENDIT
END
END
SET &CNT = &CNT + 1
ISREDIT FIND &PIC .ZCSR .ZCSR PREV
IF &LASTCC EQ 0 THEN -
DO
ISREDIT FIND "&TICK" .ZCSR .ZCSR NEXT
ISREDIT (LINE,COLBEG) = CURSOR
ISREDIT FIND "&TICK" .ZCSR .ZCSR NEXT
ISREDIT (LINE,COLEND) = CURSOR
SET &COLLEN = &EVAL(&COLEND-&COLBEG-1)
ISREDIT FIND "(" .ZCSR .ZCSR PREV
ISREDIT (LINE,COL) = CURSOR
ISREDIT CURSOR = &LINE &EVAL(&COL-1)
ISREDIT CHANGE &CHNGE (&COLLEN.) .ZCSR .ZCSR NEXT
ISREDIT CURSOR = &EVAL(&LINE+1),1
GOTO BYPASS
END
ISREDIT (VLINE,VCOL) = CURSOR
ISREDIT FIND "&TICK" .ZCSR .ZCSR NEXT
ISREDIT (LINE,COLBEG) = CURSOR
ISREDIT FIND "&TICK" .ZCSR .ZCSR NEXT
ISREDIT (LINE,COLEND) = CURSOR
SET &COLLEN = &EVAL(&COLEND-&COLBEG-1)
ISREDIT CURSOR = &VLINE &EVAL(&VCOL-1)
ISREDIT CHANGE &VALU &PICKK NEXT
ISREDIT CURSOR = &VLINE &EVAL(&VCOL+15)
BYPASS: -
GOTO DOOVER
ENDIT: -
ISREDIT SAVE
EXIT
Documentation
PKK - This edit macro command will process all PICTURE and VALUE clauses within
the member being edited from the current cursor position to the end of the
member. It processes like COUNTPIC except that in addition it will insert the
PICTURE clause 'PIC x(xx)' in front of all VALUE clauses that do not contain a
PICTURE clause and replace the length with the computed length of the character
string. (i.e. VALUE 'test'. converts to PIC x(4) VALUE 'test'.) This edit
macro will only work on character VALUE clauses.

0 Comments