PIC
/* 2011/2012 MCSERRA */
/* REXX */
/* ----------------------------------------------------------------- */
/* NAO ALTERAR POR FAVOR */
/* PIC
MACRO EDIT - CALCULA TAMANHO TOTAL DAS PICTURES DE UMA ESTRUTURA
DE VARIAVEIS COBOL
SINTAX:
PIC .I .F
ONDE .I E .F SAO FACULTATIVOS, E CORRESPONDEM A LABELS
DE LINHA QUE DELIMITAM A ACCAO DO CALCULO ENTRE DUAS
LINHAS. QUANDO OMISSOS, CALCULA TODO O ELEMENTO EM EDICAO.
NOTAS: - A PALAVRA RESERVADA 'PIC' DEVERA ESTAR SEMPRE NA MESMA
LINHA QUE A NUMERACAO (LEVEL) DA VARIAVEL.
*/
/* ----------------------------------------------------------------- */
"ISREDIT MACRO ("PARM")"
IF RC > 0 THEN
DO
ZERRSM = ' '
ZERRLM = 'A MACRO PIC SO PODE SER EXECUTADA EM EDICAO.'
ADDRESS ISPEXEC 'SETMSG MSG(ISRS087)'
EXIT 999
END
/* */
"ISPEXEC CONTROL ERRORS RETURN"
/*- */
IF STRIP(PARM) = '?' THEN
DO
CALL HELP
EXIT
END
DEBUG = 'N'
CALL INICIALIZA
CALL PROCESSO
"ISREDIT UNNUM"
"ISREDIT C ALL '£' X'6B' "
ZEDSMSG = 'TAMANHO TOTAL: ' TOTAL
ZEDLMSG = 'NR BYTES TOTAL DO COPY: ' TOTAL
"ISPEXEC SETMSG MSG(ISRZ001)"
"ISREDIT FIND LAST '"FNDL"' "P1" "P2
/* */
EXIT
/* */
INICIALIZA:
/*--------------------------------------------------------------------*/
P1 = ""
P2 = ""
IF PARM <> "" THEN PARSE UPPER VALUE PARM WITH P1 P2
IF P2 = "" THEN P2 = ".ZLAST"
IF P1 = "" THEN P1 = ".ZFIRST"
"ISREDIT X ALL"
"ISREDIT F ALL ' ' " P1 " " P2
"ISREDIT X ALL '*' 1 8"
/* "ISREDIT HIDE X" */
"ISREDIT F ' ' FIRST NX " P1 " " P2
"ISREDIT (LIN,COL) = CURSOR"
PRIMEIRA = LIN
"ISREDIT F ' ' LAST NX " P1 " " P2
"ISREDIT (LIN,COL) = CURSOR"
ULTIMA = LIN
"ISREDIT RES"
"ISREDIT REN STD COB"
"ISREDIT C ALL X'6B' '£'"
IF DEBUG = 'S' THEN
SAY 'LINHAS: ' ULTIMA
/* */
LNAX = '*'
LNAX = LNAX'.................................... '
LNAF = LNAX' TOTAL'
LNAX = LNAX'SUBTOTAL'
/* */
RETURN
/* */
PROCESSO:
/*--------------------------------------------------------------------*/
MDGR = 'S'
CONTA = 'S'
GRPANT = '00'
GRPOCC = '00'
GRPRED = '00'
OCCUR = 'N'
REDEF = 'N'
TOTGRPANT = 0
TOTAL = 0
NROCC = 1
GN = 1
GNMX = 20
LH = 1
DO GN = 1 TO GNMX
GR.GN = '00'
TGR.GN = 0
END
GN = 1
DO N = PRIMEIRA TO ULTIMA
CALL CALCULO
END
CALL ULTGRUPO
LHT = LH - 1
DO WHILE LH > 0
"ISREDIT LINE_AFTER "LHN.LH" = MSGLINE '"LHX.LH"' "
LH = LH - 1
END
RETURN
CALCULO:
CP = 'N'
COMP = 'N'
COMP3 = 'N'
COMP4 = 'N'
NUMER = 'N'
ALFA = 'N'
DEC = 'N'
VALPIC = 0
"ISREDIT (LINHA) = LINE " N
POCC = POS('OCCURS', LINHA)
IF POCC > 0 THEN
DO
OCCUR = 'S'
GRPOCC = GRUPO
AUX = POS('PIC', LINHA)
IF AUX > 0 THEN
DO
SAY '**********************************************'
SAY '** PIC ENCONTRADO NA LINHA DO OCCURS. LINHA: ' N
SAY '** PROCESSO DE CALCULO NAO IMPLEMENTADO'
SAY '** SUBSTITUA POR EQUIVALENTE E TENTE NOVAMENTE'
"ISREDIT RES"
EXIT
END
PARSE UPPER VALUE LINHA WITH LIXO 'OCCURS' NROCC RESTO
END
PRED = POS('REDEFINES', LINHA)
PRAS = POS('*', LINHA)
IF PRED > 0 & (PRAS = 0 | PRAS > 7 ) THEN
DO
REDEF = 'S'
GRPRED = GRPANT
IF DEBUG = 'S' THEN
SAY 'REDEF : 'GRPRED
END
PARSE UPPER VALUE LINHA WITH GRUPO RESTO
GRUPO = STRIP(GRUPO)
IF SUBSTR(GRUPO, 1, 1) = '*' THEN SIGNAL FINAL
IF SUBSTR(GRUPO, 1, 1) < '0' THEN SIGNAL FINAL
IF SUBSTR(GRUPO, 1, 1) > '9' THEN SIGNAL FINAL
IF SUBSTR(GRUPO, 1, 2) > '88' THEN SIGNAL FINAL
IF DEBUG = 'S' THEN
SAY '#LN: ' N ' ANT: ' GRPANT ' GRP: ' GRUPO
IF POCC > 0 THEN
DO
GRPOCC = GRUPO
IF DEBUG = 'S' THEN
SAY ' GRPOCC ' GRPOCC ' OCCURS ' NROCC ' TIMES'
END
IF MDGR = 'S' THEN GR.GN = GRUPO
IF GRUPO <> GRPANT & TOTGRPANT = 0 THEN MDGR = 'N'
IF GRUPO <> GRPANT THEN
DO
CALL QUEBRA
END
GRPANT = GRUPO
IF POCC > 0 THEN SIGNAL FINAL
RESTO = STRIP(RESTO)
PRED = POS('REDEFINE', RESTO)
IF PRED > 0 THEN REDEF = 'S'
IF PRED > 0 THEN GRPRED = GRUPO
IF PRED > 0 & DEBUG = 'S' THEN
SAY 'REDEF : 'GRPRED '(APOS QUEBRA) GRUPO: 'GRUPO
AUX = POS('PIC', RESTO)
IF AUX = 0 THEN SIGNAL FINAL
IF REDEF = 'N' THEN
CALL CALCPIC
TOTGRPANT = TOTGRPANT + VALPIC
FINAL:
GRUPO = '00'
RETURN
/************************************************************/
ULTGRUPO:
LINHAX = LNAX' FINAL 'GRPANT': ' TOTGRPANT
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
TOTAL = TOTAL + TOTGRPANT
TGR.GN = TGR.GN + TOTGRPANT
DBGL = '*..GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N-1" = MSGLINE '"DBGL"'"
IF GN > 1 THEN
DO
GNX = GN
GN = GN - 1
IF DEBUG = 'S' THEN
SAY 'N: ' N ' GN: ' GN ' GR: ' GR.GN ' GNX: ' GNX' AH'
IF GN > 0 THEN
DO
TGR.GN = TGR.GN + TGR.GNX
TGR.GNX = 0
GR.GNX = '00'
DO WHILE GRUPO < GR.GN & GN > 1
IF DEBUG = 'S' THEN
SAY 'GRUPO: 'GRUPO' GR.'GN': 'GR.GN
GNA = GN + 1
IF DEBUG = 'S' THEN
DO
SAY 'GR.'GN': 'GR.GN '<> GR.'GNA': 'GR.GNA
SAY 'TGR.'GN': 'TGR.GN '<> TGR.'GNA': 'TGR.GNA
END
IF GR.GN <> GR.GNA | TGR.GN <> TGR.GNA THEN
DO
IF TGR.GN > 0 THEN
DO
IF GN < 3 THEN
LINHAX = LNAF' FINAL 'GR.GN': ' TGR.GN
ELSE
LINHAX = LNAX' FINAL 'GR.GN': ' TGR.GN
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
END
END
GNX = GN
IF GN > 1 THEN
DO
GN = GN - 1
TGR.GN = TGR.GN + TGR.GNX
END
/* TGR.GNX = 0
GR.GNX = '00' */
END
END
END
DBGL = '*F.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "ULTIMA" = MSGLINE '"DBGL"'"
RETURN
/************************************************************/
QUEBRA:
IF GRUPO < GRPANT THEN
DO
TOTAL = TOTAL + TOTGRPANT
TGR.GN = TGR.GN + TOTGRPANT
IF TGR.GN > 0 THEN
DO
LINHAX = LNAX' 'GR.GN': ' TGR.GN
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
END
DBGL = '*<.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N-1" = MSGLINE '"DBGL"'"
IF GN > 1 THEN
DO
GNX = GN
GN = GN - 1
IF DEBUG = 'S' THEN
SAY 'N: ' N ' GN: ' GN ' GR: ' GR.GN ' GNX: ' GNX' AH'
IF GN > 0 THEN
DO
TGR.GN = TGR.GN + TGR.GNX
TGR.GNX = 0
GR.GNX = '00'
DO WHILE GRUPO < GR.GN
IF TGR.GN > 0 THEN
DO
LINHAX = LNAX' 'GR.GN': ' TGR.GN
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
END
GNX = GN
IF GN > 1 THEN
DO
GN = GN - 1
TGR.GN = TGR.GN + TGR.GNX
END
TGR.GNX = 0
GR.GNX = '00'
END
END
END
TOTGRPANT = VALPIC
IF DEBUG = 'S' THEN
SAY ' QUEBRA TOT GRPANT: ' TOTGRPANT ' TOTAL: ' TOTAL
IF GRPOCC > GRUPO THEN
DO
IF DEBUG = 'S' THEN
SAY ' FIM GRUPO ' GRPOCC ' OCCURS ' NROCC ' TIMES'
NROCC = 1
OCCUR = 'N'
GRPOCC = '00'
END
IF REDEF = 'S' THEN
DO
IF GRPRED > GRUPO | GRPRED = GRUPO THEN
DO
IF DEBUG = 'S' THEN
SAY ' FIM REDEFINES ' GRPRED ' GRUPO: 'GRUPO
REDEF = 'N'
GRPRED = '00'
END
END
END
IF GRUPO > GRPANT THEN
DO
TOTAL = TOTAL + TOTGRPANT
TGR.GN = TGR.GN + TOTGRPANT
/*-----------------------------------------*/
IF TOTGRPANT > 0 THEN
DO
LINHAX = LNAX' PARC. 'GRPANT': ' TOTGRPANT
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
END
/*-----------------------------------------*/
DBGL = '*>.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N-1" = MSGLINE '"DBGL"'"
GN = GN + 1
GR.GN = GRUPO
IF DEBUG = 'S' THEN
SAY ' GRPANT: 'GRPANT' TOTAL: ' TOTAL
TOTGRPANT = VALPIC
DBGL = '*+.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N" = MSGLINE '"DBGL"'"
END
RETURN
/************************************************************/
CALCPIC:
PARSE VALUE RESTO WITH FNDL 'PIC' PICT
PICT = STRIP(PICT)
AUX = POS('VALUE', PICT)
IF AUX > 0 THEN
DO
RESTO = PICT
PARSE VALUE RESTO WITH PICT 'VALUE' LIXO
END
PICT = STRIP(PICT)
IF SUBSTR(PICT, 1 , 1) = 'S' THEN PICT = SUBSTR(PICT, 2)
PICT = STRIP(PICT)
IF SUBSTR(PICT, 1, 1) = '9' THEN NUMER = 'S'
IF SUBSTR(PICT, 1, 1) = 'X' THEN ALFA = 'S'
/* */
IF NUMER = 'S' THEN CALL NUMERICO
IF ALFA = 'S' THEN CALL ALFANUM
/* */
VALPIC = VALUE(VALPIC)
VALPIC = VALPIC * 1
IF CP = 'S' THEN
DO
IF COMP3 = 'S' THEN
DO
VALPIC = (VALPIC % 2) + 1
END
ELSE
DO
IF COMP = 'S' | COMP4 = 'S' THEN
DO
IF VALPIC < 5 THEN
VALPIC = 2
ELSE
IF VALPIC < 10 THEN
VALPIC = 4
ELSE
VALPIC = 8
END
ELSE
DO
SAY ' **COMP-?. ENCONTRADO. LINHA ' N
SAY 'PROCESSO DE CALCULO NAO IMPLEMENTADO'
SAY 'SUBSTITUA POR EQUIVALENTE E TENTE NOVAMENTE'
"ISREDIT RES"
EXIT
END
END
END
IF DEBUG = 'S' THEN
SAY ' PIC: 'PICT' VALPIC: ' VALPIC CP COMP COMP3 COMP4
VALPIC = VALPIC * NROCC
IF DEBUG = 'S' THEN
SAY ' VALPIC FINAL: ' VALPIC
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
NUMERICO:
AUX = POS('COMP', PICT)
IF AUX > 0 THEN CP = 'S'
IF CP = 'S' THEN
DO
AUX = POS('COMP-4', PICT)
IF AUX > 0 THEN COMP4 = 'S'
IF AUX = 0 THEN
DO
AUX = POS('COMP-3', PICT)
IF AUX > 0 THEN COMP3 = 'S'
IF AUX = 0 THEN
DO
COMP = 'S'
END
END
PARSE VALUE PICT WITH PICT 'COMP' LIXO
PICT = STRIP(PICT)
/* */
/* IF COMP4 = 'S' THEN SAY ' COMP-4 - PICT: ' PICT */
/* IF COMP3 = 'S' THEN SAY ' COMP-3 - PICT: ' PICT */
/* IF COMP = 'S' THEN SAY ' COMP - PICT: ' PICT */
END
AUX = POS('V', PICT)
VIRGULA = 'N'
IF AUX = 0 THEN
DO
AUX=POS('£', PICT)
IF AUX > 0 THEN VIRGULA = 'S'
END
IF AUX > 0 THEN DEC = 'S'
AUXU = POS('USAGE',PICT)
IF AUXU > 0 THEN PARSE VALUE PICT WITH PICT 'USAGE' RR
IF VIRGULA = 'S' THEN
DO
IF DEC = 'S' THEN PARSE VALUE PICT WITH PICTI '£' PICTD
SAY 'PICTD: ' PICTD
END
ELSE
IF DEC = 'S' THEN PARSE VALUE PICT WITH PICTI 'V' PICTD
IF DEC = 'S' THEN
DO
PICTI = STRIP(PICTI)
PICTD = STRIP(PICTD)
IF LENGTH(PICTD) = 0 THEN DEC = 'N'
END
IF DEC = 'N' THEN
DO
PICTI = STRIP(PICT)
PICTD = ''
END
PPEI = POS('(', PICTI)
IF DEC = 'S' THEN PPED = POS('(', PICTD)
PPDI = POS(')', PICTI)
IF DEC = 'S' THEN PPDD = POS(')', PICTD)
IF PPEI > 0 & PPDI = 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES ESQO SEM DRTO (INT): ' N
"ISREDIT RES"
EXIT
END
IF PPEI = 0 & PPDI > 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES DRTO SEM ESQO (INT): ' N
"ISREDIT RES"
EXIT
END
IF DEC = 'S' THEN
DO
IF PPED > 0 & PPDD = 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES ESQO SEM DRTO (DEC): ' N
SAY '** PPED: ' PPED ' PPDD: ' PPDD ' PICTD: ' PICTD
"ISREDIT RES"
EXIT
END
IF PPED = 0 & PPDD > 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES DRTO SEM ESQO (DEC): ' N
SAY '** PPED: ' PPED ' PPDD: ' PPDD ' PICTD: ' PICTD
"ISREDIT RES"
EXIT
END
END
/* */
CALL INTEIRO
IF DEC = 'S' THEN CALL DECIMAL
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
INTEIRO:
IF PPEI = 0 THEN
DO
MF = LENGTH(PICTI)
IF MF = 0 THEN MF = 1
DO M = 1 TO MF
AUX = SUBSTR(PICTI, M, 1)
IF AUX = '9' THEN VALPIC = VALPIC + 1
IF AUX = '.' & M < MF THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM (INT): ' N
"ISREDIT RES"
EXIT
END
IF AUX <> '9' & AUX <> '.' THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM (INT): ' N
"ISREDIT RES"
EXIT
END
END
END
ELSE
DO
LENP = ( PPDI - PPEI ) - 1
VALPIC = VALUE(SUBSTR(PICTI, PPEI + 1 , LENP))
END
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
DECIMAL:
IF PPED = 0 THEN
DO
MF = LENGTH(PICTD)
IF MF = 0 THEN MF = 1
DO M = 1 TO MF
AUX = SUBSTR(PICTD, M, 1)
IF AUX = '9' THEN VALPIC = VALPIC + 1
IF AUX = '.' & M < MF THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM (DEC): ' N
"ISREDIT RES"
EXIT
END
IF AUX <> '9' & AUX <> '.' THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA ALFA EM NUMER. (DEC): ' N
SAY '** PICT: ' PICT ' PICTD: ' PICTD ' AUX: ' AUX
"ISREDIT RES"
EXIT
END
END
END
ELSE
DO
LENP = ( PPDD - PPED ) - 1
VALPIC = VALPIC + VALUE(SUBSTR(PICTD, PPED + 1 , LENP))
END
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
ALFANUM:
PPE = POS('(', PICT)
PPD = POS(')', PICT)
IF PPE > 0 & PPD = 0 THEN
DO
SAY '*******************************************'
SAY '** PIC COM PARENTISES ESQO SEM DRTO (ALFA): ' N
"ISREDIT RES"
EXIT
END
IF PPE = 0 & PPD > 0 THEN
DO
SAY '*******************************************'
SAY '** PIC COM PARENTISES DRTO SEM ESQO (ALFA): ' N
"ISREDIT RES"
EXIT
END
IF PPE = 0 THEN
DO
MF = LENGTH(PICT)
IF MF = 0 THEN MF = 1
DO M = 1 TO MF
AUX = SUBSTR(PICT, M, 1)
IF AUX = 'X' THEN VALPIC = VALPIC + 1
IF AUX = '.' & M < MF THEN
DO
SAY '**********************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM: ' N
SAY '**' LINHA
"ISREDIT RES"
EXIT
END
IF AUX <> 'X' & AUX <> '.' THEN
DO
SAY '**********************************************'
SAY '** PIC MAL FORMAT. CHR INV. EM ALFAN.: ' N
SAY '** ' LINHA
"ISREDIT RES"
EXIT
END
END
END
ELSE
DO
LENP = ( PPD - PPE ) - 1
VALPIC = VALUE(SUBSTR(PICT, PPE + 1 , LENP))
IF VIRGULA = 'S' THEN VALPIC = VALPIC + 1
END
/* */
RETURN
/* */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
HELP:
/* */
"ISREDIT (LIN,COL) = CURSOR"
HLPL.35 = '*----------------------------------------------------*'
HLPL.34 = '* PIC - AJUDA E SINTAX *'
HLPL.33 = '* *'
HLPL.32 = '* MACRO PARA CALCULO DO TAMANHO DE REGISTO, COM BASE *'
HLPL.31 = '* NUMA DEFINICAO DE LAYOUT EM COBOL. *'
HLPL.30 = '* PODE SER UTILIZADO QUER EM SOURCES QUER EM COPYS. *'
HLPL.29 = '* EFECTUA O CALCULO PELO NO SOMATORIO DAS PICTURES *'
HLPL.28 = '* EM COBOL. CONTEMPLANDO TAMBEM AS OCORRENCIAS DE *'
HLPL.27 = '* ARRAYS (OCCURS). *'
HLPL.26 = '* SINTAX: *'
HLPL.25 = '* PIC ? - MOSTRA ESTA AJUDA *'
HLPL.24 = '* PIC Ý .LABELI Ý .LABELF ¨¨ *'
HLPL.23 = '* *'
HLPL.22 = '* > ONDE .LABELI CORRESPONDE A UMA LABEL DE LINHA *'
HLPL.21 = '* QUALQUER. QUE DEFINE A LINHA DO SOURCE/COPY *'
HLPL.20 = '* A PARTIR DA QUAL SE EFECTUA O CALCULO. *'
HLPL.19 = '* (INCLUSIVE) *'
HLPL.18 = '* *'
HLPL.17 = '* > ONDE .LABELF CORRESPONDE A UMA LABEL DE LINHA *'
HLPL.16 = '* QUALQUER. QUE DEFINE A LINHA DO SOURCE/COPY *'
HLPL.15 = '* ATE A QUAL SE EFECTUA O CALCULO. (INCLUSIVE) *'
HLPL.14 = '* *'
HLPL.13 = '* EXEMPLOS: *'
HLPL.12 = '* PIC *'
HLPL.11 = '* (EFECTUA O CALULO NA TOTALIDADE DO ELEMENTO *'
HLPL.10 = '* *'
HLPL.9 = '* PIC .A .B *'
HLPL.8 = '* (EFECTUA O CALULO ENTRE AS LINHAS DO *'
HLPL.7 = '* ELEMENTO MARCADAS COM AS LABELS .A E .B *'
HLPL.6 = '* ONDE .A MARCA O INICIO E .B O FIM ) *'
HLPL.5 = '* *'
HLPL.4 = '* PIC .A *'
HLPL.3 = '* (EFECTUA O CALULO A PARTIR DA LINHA DO *'
HLPL.2 = '* ELEMENTO MARCADA COM A LABEL .A ) *'
HLPL.1 = '*----------------------------------------------------*'
DO HL = 1 TO 35
"ISREDIT LINE_AFTER "LIN" = MSGLINE '"HLPL.HL"'"
END
/* */
RETURN
/* 2011/2015 MCSERRA */
/* REXX */
/* ----------------------------------------------------------------- */
/* NAO ALTERAR POR FAVOR */
/* PIC
MACRO EDIT - CALCULA TAMANHO TOTAL DAS PICTURES DE UMA ESTRUTURA
DE VARIAVEIS COBOL
SINTAX:
PIC .I .F
ONDE .I E .F SAO FACULTATIVOS, E CORRESPONDEM A LABELS
DE LINHA QUE DELIMITAM A ACCAO DO CALCULO ENTRE DUAS
LINHAS. QUANDO OMISSOS, CALCULA TODO O ELEMENTO EM EDICAO.
NOTAS: - A PALAVRA RESERVADA 'PIC' DEVERA ESTAR SEMPRE NA MESMA
LINHA QUE A NUMERACAO (LEVEL) DA VARIAVEL.
*/
/* ----------------------------------------------------------------- */
"ISREDIT MACRO ("PARM")"
IF RC > 0 THEN
DO
ZERRSM = ' '
ZERRLM = 'A MACRO PIC SO PODE SER EXECUTADA EM EDICAO.'
ADDRESS ISPEXEC 'SETMSG MSG(ISRS087)'
EXIT 999
END
/* */
"ISPEXEC CONTROL ERRORS RETURN"
/*- */
IF STRIP(PARM) = '?' THEN
DO
CALL HELP
EXIT
END
DEBUG = 'N'
CALL INICIALIZA
CALL PROCESSO
"ISREDIT UNNUM"
"ISREDIT C ALL '£' X'6B' "
ZEDSMSG = 'TAMANHO TOTAL: ' TOTAL
ZEDLMSG = 'NR BYTES TOTAL DO COPY: ' TOTAL
"ISPEXEC SETMSG MSG(ISRZ001)"
"ISREDIT FIND LAST '"FNDL"' "P1" "P2
/* */
EXIT
/* */
INICIALIZA:
/*--------------------------------------------------------------------*/
P1 = ""
P2 = ""
IF PARM <> "" THEN PARSE UPPER VALUE PARM WITH P1 P2
IF P2 = "" THEN P2 = ".ZLAST"
IF P1 = "" THEN P1 = ".ZFIRST"
"ISREDIT X ALL"
"ISREDIT F ALL ' ' " P1 " " P2
"ISREDIT X ALL '*' 1 8"
/* "ISREDIT HIDE X" */
"ISREDIT F ' ' FIRST NX " P1 " " P2
"ISREDIT (LIN,COL) = CURSOR"
PRIMEIRA = LIN
"ISREDIT F ' ' LAST NX " P1 " " P2
"ISREDIT (LIN,COL) = CURSOR"
ULTIMA = LIN
"ISREDIT RES"
"ISREDIT REN STD COB"
"ISREDIT C ALL X'6B' '£'"
IF DEBUG = 'S' THEN
SAY 'LINHAS: ' ULTIMA
/* */
LNAX = '*'
LNAX = LNAX'.................................... '
LNAF = LNAX' TOTAL'
LNAX = LNAX'SUBTOTAL'
/* */
RETURN
/* */
PROCESSO:
/*--------------------------------------------------------------------*/
MDGR = 'S'
CONTA = 'S'
GRPANT = '00'
GRPOCC = '00'
GRPRED = '00'
OCCUR = 'N'
REDEF = 'N'
TOTGRPANT = 0
TOTAL = 0
NROCC = 1
GN = 1
GNMX = 20
LH = 1
DO GN = 1 TO GNMX
GR.GN = '00'
TGR.GN = 0
END
GN = 1
DO N = PRIMEIRA TO ULTIMA
CALL CALCULO
END
CALL ULTGRUPO
LHT = LH - 1
DO WHILE LH > 0
"ISREDIT LINE_AFTER "LHN.LH" = MSGLINE '"LHX.LH"' "
LH = LH - 1
END
RETURN
CALCULO:
CP = 'N'
COMP = 'N'
COMP3 = 'N'
COMP4 = 'N'
NUMER = 'N'
ALFA = 'N'
DEC = 'N'
VALPIC = 0
"ISREDIT (LINHA) = LINE " N
POCC = POS('OCCURS', LINHA)
IF POCC > 0 THEN
DO
OCCUR = 'S'
GRPOCC = GRUPO
AUX = POS('PIC', LINHA)
IF AUX > 0 THEN
DO
SAY '**********************************************'
SAY '** PIC ENCONTRADO NA LINHA DO OCCURS. LINHA: ' N
SAY '** PROCESSO DE CALCULO NAO IMPLEMENTADO'
SAY '** SUBSTITUA POR EQUIVALENTE E TENTE NOVAMENTE'
"ISREDIT RES"
EXIT
END
PARSE UPPER VALUE LINHA WITH LIXO 'OCCURS' NROCC RESTO
END
PRED = POS('REDEFINES', LINHA)
PRAS = POS('*', LINHA)
IF PRED > 0 & (PRAS = 0 | PRAS > 7 ) THEN
DO
REDEF = 'S'
GRPRED = GRPANT
IF DEBUG = 'S' THEN
SAY 'REDEF : 'GRPRED
END
PARSE UPPER VALUE LINHA WITH GRUPO RESTO
GRUPO = STRIP(GRUPO)
IF SUBSTR(GRUPO, 1, 1) = '*' THEN SIGNAL FINAL
IF SUBSTR(GRUPO, 1, 1) < '0' THEN SIGNAL FINAL
IF SUBSTR(GRUPO, 1, 1) > '9' THEN SIGNAL FINAL
IF SUBSTR(GRUPO, 1, 2) > '88' THEN SIGNAL FINAL
IF DEBUG = 'S' THEN
SAY '#LN: ' N ' ANT: ' GRPANT ' GRP: ' GRUPO
IF POCC > 0 THEN
DO
GRPOCC = GRUPO
IF DEBUG = 'S' THEN
SAY ' GRPOCC ' GRPOCC ' OCCURS ' NROCC ' TIMES'
END
IF MDGR = 'S' THEN GR.GN = GRUPO
IF GRUPO <> GRPANT & TOTGRPANT = 0 THEN MDGR = 'N'
IF GRUPO <> GRPANT THEN
DO
CALL QUEBRA
END
GRPANT = GRUPO
IF POCC > 0 THEN SIGNAL FINAL
RESTO = STRIP(RESTO)
PRED = POS('REDEFINE', RESTO)
IF PRED > 0 THEN REDEF = 'S'
IF PRED > 0 THEN GRPRED = GRUPO
IF PRED > 0 & DEBUG = 'S' THEN
SAY 'REDEF : 'GRPRED '(APOS QUEBRA) GRUPO: 'GRUPO
AUX = POS('PIC', RESTO)
IF AUX = 0 THEN SIGNAL FINAL
IF REDEF = 'N' THEN
CALL CALCPIC
TOTGRPANT = TOTGRPANT + VALPIC
FINAL:
GRUPO = '00'
RETURN
/************************************************************/
ULTGRUPO:
LINHAX = LNAX' FINAL 'GRPANT': ' TOTGRPANT
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
TOTAL = TOTAL + TOTGRPANT
TGR.GN = TGR.GN + TOTGRPANT
DBGL = '*..GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N-1" = MSGLINE '"DBGL"'"
IF GN > 1 THEN
DO
GNX = GN
GN = GN - 1
IF DEBUG = 'S' THEN
SAY 'N: ' N ' GN: ' GN ' GR: ' GR.GN ' GNX: ' GNX' AH'
IF GN > 0 THEN
DO
TGR.GN = TGR.GN + TGR.GNX
TGR.GNX = 0
GR.GNX = '00'
DO WHILE GRUPO < GR.GN & GN > 1
IF DEBUG = 'S' THEN
SAY 'GRUPO: 'GRUPO' GR.'GN': 'GR.GN
GNA = GN + 1
IF DEBUG = 'S' THEN
DO
SAY 'GR.'GN': 'GR.GN '<> GR.'GNA': 'GR.GNA
SAY 'TGR.'GN': 'TGR.GN '<> TGR.'GNA': 'TGR.GNA
END
IF GR.GN <> GR.GNA | TGR.GN <> TGR.GNA THEN
DO
IF TGR.GN > 0 THEN
DO
IF GN < 3 THEN
LINHAX = LNAF' FINAL 'GR.GN': ' TGR.GN
ELSE
LINHAX = LNAX' FINAL 'GR.GN': ' TGR.GN
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
END
END
GNX = GN
IF GN > 1 THEN
DO
GN = GN - 1
TGR.GN = TGR.GN + TGR.GNX
END
/* TGR.GNX = 0
GR.GNX = '00' */
END
END
END
DBGL = '*F.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "ULTIMA" = MSGLINE '"DBGL"'"
RETURN
/************************************************************/
QUEBRA:
IF GRUPO < GRPANT THEN
DO
TOTAL = TOTAL + TOTGRPANT
TGR.GN = TGR.GN + TOTGRPANT
IF TGR.GN > 0 THEN
DO
LINHAX = LNAX' 'GR.GN': ' TGR.GN
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
END
DBGL = '*<.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N-1" = MSGLINE '"DBGL"'"
IF GN > 1 THEN
DO
GNX = GN
GN = GN - 1
IF DEBUG = 'S' THEN
SAY 'N: ' N ' GN: ' GN ' GR: ' GR.GN ' GNX: ' GNX' AH'
IF GN > 0 THEN
DO
TGR.GN = TGR.GN + TGR.GNX
TGR.GNX = 0
GR.GNX = '00'
DO WHILE GRUPO < GR.GN
IF TGR.GN > 0 THEN
DO
LINHAX = LNAX' 'GR.GN': ' TGR.GN
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
/* "ISREDIT LINE_AFTER "N-1" = MSGLINE '"LINHAX"' " */
END
GNX = GN
IF GN > 1 THEN
DO
GN = GN - 1
TGR.GN = TGR.GN + TGR.GNX
END
TGR.GNX = 0
GR.GNX = '00'
END
END
END
TOTGRPANT = VALPIC
IF DEBUG = 'S' THEN
SAY ' QUEBRA TOT GRPANT: ' TOTGRPANT ' TOTAL: ' TOTAL
IF GRPOCC > GRUPO THEN
DO
IF DEBUG = 'S' THEN
SAY ' FIM GRUPO ' GRPOCC ' OCCURS ' NROCC ' TIMES'
NROCC = 1
OCCUR = 'N'
GRPOCC = '00'
END
IF REDEF = 'S' THEN
DO
IF GRPRED > GRUPO | GRPRED = GRUPO THEN
DO
IF DEBUG = 'S' THEN
SAY ' FIM REDEFINES ' GRPRED ' GRUPO: 'GRUPO
REDEF = 'N'
GRPRED = '00'
END
END
END
IF GRUPO > GRPANT THEN
DO
TOTAL = TOTAL + TOTGRPANT
TGR.GN = TGR.GN + TOTGRPANT
/*-----------------------------------------*/
IF TOTGRPANT > 0 THEN
DO
LINHAX = LNAX' PARC. 'GRPANT': ' TOTGRPANT
LHX.LH = LINHAX
LHN.LH = N-1
LH = LH + 1
END
/*-----------------------------------------*/
DBGL = '*>.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N-1" = MSGLINE '"DBGL"'"
GN = GN + 1
GR.GN = GRUPO
IF DEBUG = 'S' THEN
SAY ' GRPANT: 'GRPANT' TOTAL: ' TOTAL
TOTGRPANT = VALPIC
DBGL = '*+.GRUPO: 'GRUPO' GRPANT: 'GRPANT' TOT: 'TOTAL
DBGL = DBGL' TTGNT: 'TOTGRPANT' TGR.'GN': ' TGR.GN' GR: 'GR.GN
IF DEBUG = 'S' THEN
"ISREDIT LINE_AFTER "N" = MSGLINE '"DBGL"'"
END
RETURN
/************************************************************/
CALCPIC:
PARSE VALUE RESTO WITH FNDL 'PIC' PICT
PICT = STRIP(PICT)
AUX = POS('VALUE', PICT)
IF AUX > 0 THEN
DO
RESTO = PICT
PARSE VALUE RESTO WITH PICT 'VALUE' LIXO
END
PICT = STRIP(PICT)
IF SUBSTR(PICT, 1 , 1) = 'S' THEN PICT = SUBSTR(PICT, 2)
PICT = STRIP(PICT)
IF SUBSTR(PICT, 1, 1) = '9' THEN NUMER = 'S'
IF SUBSTR(PICT, 1, 1) = 'X' THEN ALFA = 'S'
/* */
IF NUMER = 'S' THEN CALL NUMERICO
IF ALFA = 'S' THEN CALL ALFANUM
/* */
VALPIC = VALUE(VALPIC)
VALPIC = VALPIC * 1
IF CP = 'S' THEN
DO
IF COMP3 = 'S' THEN
DO
VALPIC = (VALPIC % 2) + 1
END
ELSE
DO
IF COMP = 'S' | COMP4 = 'S' THEN
DO
IF VALPIC < 5 THEN
VALPIC = 2
ELSE
IF VALPIC < 10 THEN
VALPIC = 4
ELSE
VALPIC = 8
END
ELSE
DO
SAY ' **COMP-?. ENCONTRADO. LINHA ' N
SAY 'PROCESSO DE CALCULO NAO IMPLEMENTADO'
SAY 'SUBSTITUA POR EQUIVALENTE E TENTE NOVAMENTE'
"ISREDIT RES"
EXIT
END
END
END
IF DEBUG = 'S' THEN
SAY ' PIC: 'PICT' VALPIC: ' VALPIC CP COMP COMP3 COMP4
VALPIC = VALPIC * NROCC
IF DEBUG = 'S' THEN
SAY ' VALPIC FINAL: ' VALPIC
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
NUMERICO:
AUX = POS('COMP', PICT)
IF AUX > 0 THEN CP = 'S'
IF CP = 'S' THEN
DO
AUX = POS('COMP-4', PICT)
IF AUX > 0 THEN COMP4 = 'S'
IF AUX = 0 THEN
DO
AUX = POS('COMP-3', PICT)
IF AUX > 0 THEN COMP3 = 'S'
IF AUX = 0 THEN
DO
COMP = 'S'
END
END
PARSE VALUE PICT WITH PICT 'COMP' LIXO
PICT = STRIP(PICT)
/* */
/* IF COMP4 = 'S' THEN SAY ' COMP-4 - PICT: ' PICT */
/* IF COMP3 = 'S' THEN SAY ' COMP-3 - PICT: ' PICT */
/* IF COMP = 'S' THEN SAY ' COMP - PICT: ' PICT */
END
AUX = POS('V', PICT)
VIRGULA = 'N'
IF AUX = 0 THEN
DO
AUX=POS('£', PICT)
IF AUX > 0 THEN VIRGULA = 'S'
END
IF AUX > 0 THEN DEC = 'S'
AUXU = POS('USAGE',PICT)
IF AUXU > 0 THEN PARSE VALUE PICT WITH PICT 'USAGE' RR
IF VIRGULA = 'S' THEN
DO
IF DEC = 'S' THEN PARSE VALUE PICT WITH PICTI '£' PICTD
SAY 'PICTD: ' PICTD
END
ELSE
IF DEC = 'S' THEN PARSE VALUE PICT WITH PICTI 'V' PICTD
IF DEC = 'S' THEN
DO
PICTI = STRIP(PICTI)
PICTD = STRIP(PICTD)
IF LENGTH(PICTD) = 0 THEN DEC = 'N'
END
IF DEC = 'N' THEN
DO
PICTI = STRIP(PICT)
PICTD = ''
END
PPEI = POS('(', PICTI)
IF DEC = 'S' THEN PPED = POS('(', PICTD)
PPDI = POS(')', PICTI)
IF DEC = 'S' THEN PPDD = POS(')', PICTD)
IF PPEI > 0 & PPDI = 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES ESQO SEM DRTO (INT): ' N
"ISREDIT RES"
EXIT
END
IF PPEI = 0 & PPDI > 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES DRTO SEM ESQO (INT): ' N
"ISREDIT RES"
EXIT
END
IF DEC = 'S' THEN
DO
IF PPED > 0 & PPDD = 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES ESQO SEM DRTO (DEC): ' N
SAY '** PPED: ' PPED ' PPDD: ' PPDD ' PICTD: ' PICTD
"ISREDIT RES"
EXIT
END
IF PPED = 0 & PPDD > 0 THEN
DO
SAY '*********************************************'
SAY '** PIC COM PARENTISES DRTO SEM ESQO (DEC): ' N
SAY '** PPED: ' PPED ' PPDD: ' PPDD ' PICTD: ' PICTD
"ISREDIT RES"
EXIT
END
END
/* */
CALL INTEIRO
IF DEC = 'S' THEN CALL DECIMAL
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
INTEIRO:
IF PPEI = 0 THEN
DO
MF = LENGTH(PICTI)
IF MF = 0 THEN MF = 1
DO M = 1 TO MF
AUX = SUBSTR(PICTI, M, 1)
IF AUX = '9' THEN VALPIC = VALPIC + 1
IF AUX = '.' & M < MF THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM (INT): ' N
"ISREDIT RES"
EXIT
END
IF AUX <> '9' & AUX <> '.' THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM (INT): ' N
"ISREDIT RES"
EXIT
END
END
END
ELSE
DO
LENP = ( PPDI - PPEI ) - 1
VALPIC = VALUE(SUBSTR(PICTI, PPEI + 1 , LENP))
END
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
DECIMAL:
IF PPED = 0 THEN
DO
MF = LENGTH(PICTD)
IF MF = 0 THEN MF = 1
DO M = 1 TO MF
AUX = SUBSTR(PICTD, M, 1)
IF AUX = '9' THEN VALPIC = VALPIC + 1
IF AUX = '.' & M < MF THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM (DEC): ' N
"ISREDIT RES"
EXIT
END
IF AUX <> '9' & AUX <> '.' THEN
DO
SAY '*******************************************'
SAY '** PIC MAL FORMATADA ALFA EM NUMER. (DEC): ' N
SAY '** PICT: ' PICT ' PICTD: ' PICTD ' AUX: ' AUX
"ISREDIT RES"
EXIT
END
END
END
ELSE
DO
LENP = ( PPDD - PPED ) - 1
VALPIC = VALPIC + VALUE(SUBSTR(PICTD, PPED + 1 , LENP))
END
RETURN
/*- -*/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
ALFANUM:
PPE = POS('(', PICT)
PPD = POS(')', PICT)
IF PPE > 0 & PPD = 0 THEN
DO
SAY '*******************************************'
SAY '** PIC COM PARENTISES ESQO SEM DRTO (ALFA): ' N
"ISREDIT RES"
EXIT
END
IF PPE = 0 & PPD > 0 THEN
DO
SAY '*******************************************'
SAY '** PIC COM PARENTISES DRTO SEM ESQO (ALFA): ' N
"ISREDIT RES"
EXIT
END
IF PPE = 0 THEN
DO
MF = LENGTH(PICT)
IF MF = 0 THEN MF = 1
DO M = 1 TO MF
AUX = SUBSTR(PICT, M, 1)
IF AUX = 'X' THEN VALPIC = VALPIC + 1
IF AUX = '.' & M < MF THEN
DO
SAY '**********************************************'
SAY '** PIC MAL FORMATADA . ANTES DO FIM: ' N
SAY '**' LINHA
"ISREDIT RES"
EXIT
END
IF AUX <> 'X' & AUX <> '.' THEN
DO
SAY '**********************************************'
SAY '** PIC MAL FORMAT. CHR INV. EM ALFAN.: ' N
SAY '** ' LINHA
"ISREDIT RES"
EXIT
END
END
END
ELSE
DO
LENP = ( PPD - PPE ) - 1
VALPIC = VALUE(SUBSTR(PICT, PPE + 1 , LENP))
IF VIRGULA = 'S' THEN VALPIC = VALPIC + 1
END
/* */
RETURN
/* */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -*/
HELP:
/* */
"ISREDIT (LIN,COL) = CURSOR"
HLPL.35 = '*----------------------------------------------------*'
HLPL.34 = '* PIC - AJUDA E SINTAX *'
HLPL.33 = '* *'
HLPL.32 = '* MACRO PARA CALCULO DO TAMANHO DE REGISTO, COM BASE *'
HLPL.31 = '* NUMA DEFINICAO DE LAYOUT EM COBOL. *'
HLPL.30 = '* PODE SER UTILIZADO QUER EM SOURCES QUER EM COPYS. *'
HLPL.29 = '* EFECTUA O CALCULO PELO NO SOMATORIO DAS PICTURES *'
HLPL.28 = '* EM COBOL. CONTEMPLANDO TAMBEM AS OCORRENCIAS DE *'
HLPL.27 = '* ARRAYS (OCCURS). *'
HLPL.26 = '* SINTAX: *'
HLPL.25 = '* PIC ? - MOSTRA ESTA AJUDA *'
HLPL.24 = '* PIC Ý .LABELI Ý .LABELF ¨¨ *'
HLPL.23 = '* *'
HLPL.22 = '* > ONDE .LABELI CORRESPONDE A UMA LABEL DE LINHA *'
HLPL.21 = '* QUALQUER. QUE DEFINE A LINHA DO SOURCE/COPY *'
HLPL.20 = '* A PARTIR DA QUAL SE EFECTUA O CALCULO. *'
HLPL.19 = '* (INCLUSIVE) *'
HLPL.18 = '* *'
HLPL.17 = '* > ONDE .LABELF CORRESPONDE A UMA LABEL DE LINHA *'
HLPL.16 = '* QUALQUER. QUE DEFINE A LINHA DO SOURCE/COPY *'
HLPL.15 = '* ATE A QUAL SE EFECTUA O CALCULO. (INCLUSIVE) *'
HLPL.14 = '* *'
HLPL.13 = '* EXEMPLOS: *'
HLPL.12 = '* PIC *'
HLPL.11 = '* (EFECTUA O CALULO NA TOTALIDADE DO ELEMENTO *'
HLPL.10 = '* *'
HLPL.9 = '* PIC .A .B *'
HLPL.8 = '* (EFECTUA O CALULO ENTRE AS LINHAS DO *'
HLPL.7 = '* ELEMENTO MARCADAS COM AS LABELS .A E .B *'
HLPL.6 = '* ONDE .A MARCA O INICIO E .B O FIM ) *'
HLPL.5 = '* *'
HLPL.4 = '* PIC .A *'
HLPL.3 = '* (EFECTUA O CALULO A PARTIR DA LINHA DO *'
HLPL.2 = '* ELEMENTO MARCADA COM A LABEL .A ) *'
HLPL.1 = '*----------------------------------------------------*'
DO HL = 1 TO 35
"ISREDIT LINE_AFTER "LIN" = MSGLINE '"HLPL.HL"'"
END
/* */
RETURN
/* 2011/2015 MCSERRA */
Comentários
Enviar um comentário