Mainframe Utility: PIC

ISREDIT MACRO (OPT1)
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
/******************************************************************/
/* 'PIC' EDIT MACRO. DISPLAY THE LENGTH OF A PICTURE LITERAL      */
/* AUTHOR : DAVID LEIGH    DATE : 5-8-89                          */
/******************************************************************/

IF &STR(&OPT1) = &STR(HELP) THEN GOTO HELPSEC

ISREDIT (LN,CL) = CURSOR
ISREDIT (DATA) = LINE .ZCSR

SET A = &SYSINDEX(&STR('),&NRSTR(&DATA))
IF &A = 0 THEN +
    DO
        SET ZEDLMSG = &STR(NO "'" FOUND IN LINE. THERE MUST BE 2 )+
                      &STR("'"'S.)
        ISPEXEC SETMSG MSG(UTLZ001)
        EXIT CODE(8)
    END
ELSE +
    DO
        SET A = &A + 1
        SET B = &LENGTH(&NRSTR(&DATA))
        SET DATA = &SUBSTR(&A:&B,&NRSTR(&DATA))
    END

SET A = &SYSINDEX(&STR('),&NRSTR(&DATA))
IF &A = 0 THEN +
    DO
        SET ZEDLMSG = &STR(2ND "'" NOT FOUND IN LINE. THERE MUST BE 2 )+
                      &STR("'"'S.)
        ISPEXEC SETMSG MSG(UTLZ001)
        EXIT CODE(8)
    END
ELSE +
    DO
        SET A = &A - 1
        SET DATA = &SUBSTR(1:&A,&NRSTR(&DATA))
    END

SET A = &LENGTH(&NRSTR(&DATA))
ISREDIT CURSOR = &LN &CL

IF &STR(&OPT1) = BATCH THEN +
    DO
        SET PICLEN = &STR(&A)
        ISPEXEC VPUT PICLEN SHARED
        EXIT
    END

SET ZEDSMSG = &STR(STRING LENGTH = &A)
SET ZEDLMSG = &STR(THE STRING BETWEEN "'"'S IS &A CHARATERS LONG)
ISPEXEC SETMSG MSG(UTLZ000)

IF &OPT1 = WRITE THEN +
    DO
        SET X = &LENGTH(&A)
        SET Y =
        DO &I = 1 TO &X
            SET Y = &STR(&Y=)
        END
        ISREDIT CHANGE P'&Y' '&A' .ZCSR .ZCSR &CL
    END

EXIT

HELPSEC: +
CLEAR
WRITE *** HELP FOR EDIT MACRO 'PIC' ***
WRITE
WRITE THE 'PIC' EDIT MACRO WILL AUTOMATICALLY DISPLAY HOW LONG A STRING
WRITE IS IN THE CURRENT LINE THAT THE CURSOR IS ON IN A FILE THAT YOU
WRITE ARE EDITING.  IT LOOKS FOR 2 SINGLE QUOTES AND COUNTS THE NUMBER
WRITE OF CHARACTERS BETWEEN THE QUOTES.  A PROBABLE APPLICATION IS FOR
WRITE THE WORKING STORAGE SECTION OF A COBOL PROGRAM.  IT WOULD SAVE
WRITE "CURSOR COUNTING" TIME FOR LONG "VALUE" CLAUSES.
WRITE
WRITE BASIC SYNTAX : (PLACE CURSOR ON THE DESIRED DATA LINE)
WRITE
WRITE COMMAND ===> PIC
WRITE
WRITE EXAMPLE (ASSUME THE CURSOR IS ON LINE 3
WRITE
WRITE EDIT ---- MY.PDS(MYMEMBER) - 01.00 --------------- COLUMNS 001 072
WRITE COMMAND ===> PIC
WRITE ****** ***************************** TOP OF DATA *****************
WRITE 000001        01  RECORD-LAYOUT.
WRITE 000002            05  FILLER                 PIC X(??) VALUE
WRITE 000003                'LJHLKJHSDLHFLKJHSDOUIYOAUEYR,MBDXVLSIUSE'.
WRITE 000004
WRITE 000005
WRITE ****** **************************** BOTTOM OF DATA ***************
WRITE
WRITE &STR(MESSAGE AFTER COMMAND EXECUTION : =============/)
WRITE &STR(                                               /)
WRITE EDIT ---- MY.PDS(MYMEMBER) - 01.00 ------------ STRING LENGTH = 40
WRITE COMMAND ===>
WRITE ****** ***************************** TOP OF DATA *****************
WRITE 000001        01  RECORD-LAYOUT.
WRITE 000002            05  FILLER                 PIC X(??) VALUE
WRITE 000003                'LJHLKJHSDLHFLKJHSDOUIYOAUEYR,MBDXVLSIUSE'.
WRITE 000004
WRITE 000005
WRITE ****** **************************** BOTTOM OF DATA ***************
WRITE
WRITE *** END OF HELP *** NO PROCESSING PERFORMED ***
EXIT
            

 This utility is particularly helpful in languages such as COBOL where you have
 to match the length of a literal string delimited by single quotes with an
 explicit length number.  It can be used in any edit session however.  Place the
 cursor on the line w/the string and type PIC on the command line.  You may also
 set a PF key to PIC.  An example is as follows :

 EDIT ---- TCWCA.TWB.QNDPGMS(ALLUSERS) - 01.01 ------------ STRING LENGTH = 52
 COMMAND ===> pic                                             SCROLL ===> CSR
 023400        01  ws-start                     pic x(52) value
 023500            '*** program allusers working storage begins here ***'.

 You have verified that this string is 52 chars. long w/o having to count it.