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  */

Comentários

Mensagens populares deste blogue

CC

ED

Z#SQLCOD