*================================================================
      * PROGRAMA....: EDTDTAARA
      * DESCRIPCION.: Editar área de datos.
      * ANALISIS....: Diego M. ACEVEDO
      * PROGRAMACION: Diego M. ACEVEDO
      * FECHA.......: 20/03/2000
      *                                        Buenos Aires -ARGENTINA-
      *================================================================
     H        1
      *----------------------------------------------------------------
     FEDTARAFMCF  E                    WORKSTN      KINFDS STATUS
     F                                        W0REC1KSFILE @ASFL
      *----------------------------------------------------
      * MATRICES Y SERIES                                 .
      *----------------------------------------------------
     E                    $KEY    1   7 78               Function keys.
     E                    $DTA     2000  1
     E                    FLD        50  1
     E                    ALC    46  46  1               Allocate object.
     E                    DLC    46  46  1               Deallocate object.
     E                    CHG    57  57  1               Change data area.
      *----------------------------------------------------
      * Data structures                                   .
      *----------------------------------------------------
      * Display file feedback area                        .
      *----------------------------------------------------
     ISTATUS      DS
     I                                      369 369 W0AIB
     I                                    B 378 3790W0SFPS
      *----------------------------------------------------
      * Program information                               .
      *----------------------------------------------------
     I           SDS
     I                                        1  10 P$$PGM
      *----------------------------------------------------
     IÑÑLEN      IDS
     I I            2037                  B   1   40VARLEN
     I I            1                     B   5   80STRPOS
     I I            2037                  B   9  120DTALEN
      *
     IRTNVAR     IDS                           2037
     I I                                  B   1   40$BIN1
     I I                                  B   5   80$BIN2
     I I                                      9  18 $TYPE
     I I                                     19  28 $LIB
     I I                                  B  29  320$LONG
     I I                                  B  33  360$BIN4
     I I                                     372036 $DTA
      *
     IRCVVAR     IDS                           2037
     I I                                    101 150 $DESCR
      *
     I           IDS
     I I            0                     B   1   40STACK
     I I            100                   B   5   80MSGLEN
     I I                                      9  12 MSGKEY
     I I                                     13  22 MSGTYP
      *
     IERRCOD     IDS
     I I            272                   B   1   40BYTPRV
     I I                                  B   5   80BYTAVA
     I I                                      9  15 ERRID
     I I                                     16  16 ERRÑÑÑ
     I I                                     17 272 MSGDTA
      *----------------------------------------------------
      * Input parameter                                   .
      *----------------------------------------------------
     IQUALNM      DS
     I                                        1  10 P$ARA
     I                                       11  20 P$LIBL
      *----------------------------------------------------
      * Constant                                          .
      *----------------------------------------------------
     I              '001001'              C         CLEAR
     I              '010000'              C         SET
     I              '1'                   C         ENTER
     I              9                     C         SPAG1
     I              50                    C         R
     I              ''''                  C         APOST
     I              ' '                   C         BL
     I              'Valor '' no permitid-C         TEXTO
     I              'o para el campo'
     I              'RCLRSC *CALLER'      C         RCLRSC
     I              'QCPFMSG   *LIBL     'C         SYSMSG
      *----------------------------------------------------
      * Definición de parámetros de entrada.
     C           *ENTRY    PLIST
     C                     PARM           QUALNM
      *
      * Definición de campos referenciados.
     C           *LIKE     DEFN W$$SR1    W0REC1
     C           *LIKE     DEFN W$$SR1    W1REC1
     C           *LIKE     DEFN W$$SR1    W0LAST
      *
      *====================================================
      *
      *              M A I N   P R O G R A M
      *
      *====================================================
      *
      * Borrar cola de mensajes.
     C                     EXSR RMVMSG
      *
     C           *IN03     DOUEQ*ON                        «-------------+
     C           *IN12     OREQ *ON                        «-------------|
      *                                                                  |
     C                     RESETERRCOD                                   |
     C                     RESETÑÑLEN                                    |
      *                                                                  |
      * Retrieve data area.                                              |
     C                     CALL 'QWCRDTAA'                               |
     C           RTNVAR    PARM           RTNVAR                         |
     C                     PARM           VARLEN                         |
     C                     PARM           QUALNM                         |
     C                     PARM -1        STRPOS                         |
     C                     PARM           DTALEN                         |
     C           ERRCOD    PARM           ERRCOD                         |
      *                                                                  |
     C                     Z-ADD1         STACK                          |
      *                                                                  |
     C           BYTAVA    CASNE*ZEROS    SNDMSG                         |
     C                     END                                           |
      *                                                                  |
     C           ERRID     IFEQ *BLANKS                    «------------+|
      *                                                                 ||
     C                     MOVEACLEAR     *IN,30                        ||
     C                     WRITE@ACTL                                   ||
     C                     MOVEASET       *IN,30                        ||
      *                                                                 ||
     C                     Z-ADD1         X                             ||
     C                     CLEARY                                       ||
     C                     MOVELQUALNM    W$ANAM                        ||
     C                     MOVEL$DESCR    W$ATXT                        ||
     C                     MOVEL$LIB      W$ALIB                        ||
     C                     MOVEL$TYPE     W$ATYP                        ||
     C                     Z-ADD$LONG     W$ALEN                        ||
     C                     CLEARW0REC1                                  ||
     C                     CLEARW1REC1                                  ||
     C                     CLEARW$$SR1                                  ||
      *                                                                 ||
     C                     EXSR $$FCKY                                  ||
     C                     EXSR $$LPAG                                  ||
      *                                                                 ||
     C           *IN03     DOUEQ*ON                        «-----------+||
     C           *IN05     OREQ *ON                        «-----------|||
     C           *IN12     OREQ *ON                        «-----------|||
      *                                                                |||
      * Mostrar pantalla y mensajes.                                   |||
     C                     WRITESFLCTL                                 |||
     C                     MOVEA'00'      *IN,37                       |||
      *                                                                |||
     C                     WRITE@ACTL                                  |||
      *                                                                |||
     C                     READ EDTARAFM               0303            |||
     C                     EXSR RMVMSG                                 |||
     C                     SETOF                     6099              |||
      *                                                                |||
     C                     Z-ADDW0SFPS    W$$SR1                       |||
      *                                                                |||
      * Procesa teclas de función.                                     |||
     C           W0AIB     CASEQENTER     $$CTRL                       |||
     C           *IN03     CASEQ*ON       $$CNCL                       |||
     C           *IN12     CASEQ*ON       $$CNCL                       |||
     C           *IN17     CASEQ*ON       $$TOP                        |||
     C           *IN18     CASEQ*ON       $$BOTT                       |||
     C           *IN25     CASEQ*ON       $$LPAG                       |||
     C           *IN26     CASEQ*ON       $$NMOR                       |||
     C                     END                                         |||
     C                     END                             »-----------+||
      *                                                                 ||
     C                     ELSE                            }------------||
     C                     MOVE *ON       *IN03                         ||
     C                     END                             »------------+|
     C                     END                             »-------------+
      *
     C                     EXSR $$CNCL
      *
      *====================================================
      *                 S U B R U T I N A S
      *====================================================
      *----------------------------------------------------
      * SUBRUTINA: $$CNCL
      * PROPOSITO: Cancelación del programa.
      *----------------------------------------------------
     C           $$CNCL    BEGSR
      *
     C           *IN98     IFEQ *OFF                       «-------------+
     C                     MOVEANAME      DLC,10                         |
     C                     MOVEADLC       CMDSTR    P                    |
     C                     CALL 'QCMDEXC'                                |
     C                     PARM           CMDSTR                         |
     C                     PARM 46        CMDLEN                         |
     C                     END                             »-------------+
      *
     C                     MOVE *ON       *INLR
     C                     CALL 'QCMDEXC'
     C                     PARM RCLRSC    CMD
     C                     PARM 16        CMDLEN
     C                     RETRN
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$FCKY
      * PROPOSITO: Arma linea de mandatos.
      *----------------------------------------------------
     C           $$FCKY    BEGSR
      *
     C                     MOVEL$KEY,1    W$$CK1
     C                     MOVEL$KEY,2    W$$CK2
     C                     MOVE *ON       *IN36
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$LPAG
      * PROPOSITO: Cargar subfile.
      *----------------------------------------------------
     C           $$LPAG    BEGSR
      *
     C                     Z-ADDW1REC1    W0REC1
      *
     C           *IN34     IFEQ *OFF                       «-------------+
      *                                                                  |
     C                     DO   SPAG1                      «------------+|
      *                                                                 ||
     C                     CLEAR@ASFL                                   ||
     C           $LONG     SUB  X         Y            70               ||
     C  N70      Y         COMP 50                     71               ||
      *                                                                 ||
     C           X         IFLT $LONG                      «-----------+||
     C           *IN71     ANDEQ*OFF                       «-----------|||
     C                     MOVEA$DTA,X    W$DATA                       |||
     C                     Z-ADDR         W$FLEN                       |||
      *                                                                |||
     C                     ELSE                            }-----------|||
     C           Y         IFGE 50                         «----------+|||
     C                     MOVEA$DTA,X    W$DATA                      ||||
     C                     MOVEL*ON       *IN34                       ||||
     C                     Z-ADDR         L                           ||||
     C                     ELSE                            }----------||||
     C                     ADD  2         Y                           ||||
     C           Y         IFGE 50                         «---------+||||
     C                     MOVEA$DTA      W$DATA                     |||||
     C                     MOVEL*ON       *IN34                      |||||
     C                     Z-ADDR         L                          |||||
     C                     ELSE                            }---------|||||
     C                     MOVEA$DTA,X    FLD                        |||||
     C                     MOVEAAPOST     FLD,Y                      |||||
     C           Y         SUB  1         W$FLEN                     |||||
     C                     Z-ADDW$FLEN    L                          |||||
     C                     MOVEAFLD       W$DATA                     |||||
     C                     MOVEL*ON       *IN34                      |||||
     C                     END                             »---------+||||
     C                     END                             »----------+|||
     C                     END                             »-----------+||
      *                                                                 ||
     C           X         SUB  1         W$OFST                        ||
     C                     ADD  1         W0REC1     30                 ||
     C                     WRITE@ASFL                                   ||
     C           X         ADD  R         X                             ||
     C  N34                END                             »------------+|
      *                                                                  |
     C                     ELSE                            }-------------|
     C                     MOVEL'CPD6A69' ERRID                          |
     C                     MOVELSYSMSG    $MSGF                          |
     C                     MOVEL'*INFO'   MSGTYP    P                    |
     C                     MOVEL'*'       PGMQ      P                    |
     C                     Z-ADD*ZERO     STACK                          |
     C                     EXSR SNDMSG                                   |
     C                     END                             »-------------+
      *
     C                     Z-ADDW0REC1    W1REC1
     C                     Z-ADDW0REC1    W$$SR1
     C   34                Z-ADDW0REC1    W0LAST
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$NMOR
      * PROPOSITO: Primera página.
      *----------------------------------------------------
     C           $$NMOR    BEGSR
      *
     C                     MOVEL'CPD6A66' ERRID
     C                     MOVELSYSMSG    $MSGF
     C                     MOVEL'*INFO'   MSGTYP    P
     C                     Z-ADD*ZERO     STACK
     C                     EXSR SNDMSG
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$CTRL
      * PROPOSITO: Procesar registro de control.
      *----------------------------------------------------
     C           $$CTRL    BEGSR
      *
     C                     SETOF                     39
      *
     C           *IN30     IFEQ *ON                        «-------------+
      *                                                                  |
     C                     READC@ASFL                    41              |
     C           *IN41     DOWEQ*OFF                       «------------+|
      *                                                                 ||
     C           APOST     SCAN W$DATA                   90             ||
      *                                                                 ||
     C                     SELEC                           «-----------+||
     C           *IN90     WHEQ *ON                        «-----------|||
     C           W0REC1    ANDNEW0LAST                     «-----------|||
     C                     SETON                     9960              |||
     C                     MOVEL'CPF9898' ERRID                        |||
     C                     MOVELTEXTO     MSGDTA    P                  |||
     C                     Z-ADD*ZEROS    STACK                        |||
     C                     EXSR SNDMSG                                 |||
     C                     MOVE *ON       *IN39                        |||
     C                     UPDAT@ASFL                                  |||
     C                     MOVE *OFF      *IN39                        |||
     C                     LEAVE                                       |||
      *                                                                |||
     C                     OTHER                           «-----------|||
     C                     EXSR $$CHGD                                 |||
     C                     END                             »-----------+||
      *                                                                 ||
     C                     UPDAT@ASFL                                   ||
     C                     MOVE *OFF      *IN39                         ||
     C                     READC@ASFL                    41             ||
     C                     END                             »------------+|
     C                     END                             »-------------+
      *
     C  N99                MOVE *ON       *IN03
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$CHGD
      * PROPOSITO: Cambiar área de datos.
      *----------------------------------------------------
     C           $$CHGD    BEGSR
      *
     C                     CLEARCMDSTR
     C                     Z-ADD50        W0LEN
      *
     C           W$DATA    IFEQ *BLANKS                    «-------------+
     C                     CLEARW$DATA                                   |
     C                     Z-ADD1         @                              |
     C           W0REC1    IFEQ W0LAST                     «------------+|
     C                     Z-ADDL         W0LEN                         ||
     C                     ELSE                            }------------||
     C                     MOVE '50'      W1LEN                         ||
     C                     END                             »------------+|
      *                                                                  |
     C                     ELSE                            }-------------|
     C           APOST     SCAN W$DATA                   90              |
     C   90      APOST:BL  XLATEW$DATA    W$DATA                         |
     C   90      ' '       CHEKRW$DATA    W0LEN                          |
     C                     CLEAR@                                        |
     C                     END                             »-------------+
      *
     C                     MOVE W0LEN     W1LEN
      *
     C                     MOVEANAME      CHG,18
     C           W$OFST    ADD  1         W0OFST
     C                     MOVE W0OFST    W1OFST
     C                     MOVEAW1OFST    CHG,41
     C                     MOVEAW1LEN     CHG,46
     C                     MOVEACHG       CMDSTR
     C           CMDSTR    CAT  W$DATA:0  CMDSTR
     C           CMDSTR    CAT  ''')':@   CMDSTR    P
      *
     C                     CALL 'QCMDEXC'              99
     C                     PARM           CMDSTR
     C                     PARM 200       CMDLEN
      *
     C   99                EXSR *PSSR
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$TOP
      * PROPOSITO: Inicio del subfile.
      *----------------------------------------------------
     C           $$TOP     BEGSR
      *
     C                     Z-ADD1         W$$SR1
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: $$BOTT
      * PROPOSITO: Fin del subfile.
      *----------------------------------------------------
     C           $$BOTT    BEGSR
      *
     C           *IN34     DOWEQ*OFF                       «-------------+
     C                     EXSR $$LPAG                                   |
     C                     END                             »-------------+
      *
     C                     Z-ADDW1REC1    W$$SR1
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: RMVMSG
      * PROPOSITO: Borrar cola de mensajes.
      *----------------------------------------------------
     C           RMVMSG    BEGSR
      *
     C                     RESETERRCOD
     C                     CALL 'QMHRMVPM'
     C                     PARM '*'       PGMQ
     C                     PARM 0         STACK
     C                     PARM *BLANKS   MSGKEY
     C                     PARM '*ALL'    MSGTYP
     C           ERRCOD    PARM           ERRCOD
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: SNDMSG
      * PROPOSITO: Enviar mensajes.
      *----------------------------------------------------
     C           SNDMSG    BEGSR
      *
     C                     CALL 'QMHSNDPM'
     C                     PARM           ERRID
     C                     PARM SYSMSG    $MSGF
     C                     PARM           MSGDTA
     C                     PARM           MSGLEN
     C                     PARM '*INFO'   MSGTYP
     C                     PARM '*'       PGMQ
     C                     PARM           STACK
     C                     PARM *BLANKS   MSGKEY
     C           ERRCOD    PARM           ERRCOD
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: *PSSR
      * PROPOSITO: Subrutina de excepción/error.
      *----------------------------------------------------
     C           *PSSR     BEGSR
      *
     C           $ALOC     IFEQ *ON                        «-------------+
     C                     MOVEANAME      DLC,10                         |
     C                     MOVEADLC       CMDSTR    P                    |
     C                     CALL 'QCMDEXC'                                |
     C                     PARM           CMDSTR                         |
     C                     PARM 46        CMDLEN                         |
     C                     END                             »-------------+
      *
     C                     DUMP
     C                     Z-ADD1         STACK
     C                     EXSR SNDMSG
     C                     MOVE *ON       *INLR
     C                     CALL 'QCMDEXC'
     C                     PARM RCLRSC    CMD
     C                     PARM 16        CMDLEN
     C                     RETRN
      *
     C                     ENDSR
      *----------------------------------------------------
      * SUBRUTINA: *INZSR
      * PROPOSITO: Inicialización.
      *----------------------------------------------------
     C           *INZSR    BEGSR
      *
     C                     MOVE *ON       *IN40
     C                     MOVEL*BLANKS   CMD    16
     C                     Z-ADD*ZEROS    X       40
     C                     Z-ADD*ZEROS    Y       40
     C                     Z-ADD*ZEROS    L       20
     C                     Z-ADD*ZEROS    W0LEN   20
     C                     MOVEL*BLANKS   W1LEN   2
     C                     Z-ADD*ZEROS    @       20
     C                     Z-ADD*ZEROS    W0OFST  40
     C                     MOVEL*BLANKS   W1OFST  4
     C                     MOVEL*BLANKS   PGMQ   10
     C                     MOVEL*BLANKS   MSGKEY  4
     C                     MOVEL*BLANKS   MSGTYP 10
     C                     MOVEL*BLANKS   $MSGF  20
     C                     MOVEL'OBJD0200'FORMAT  8
     C                     MOVEL'*DTAARA' OBJTYP 10
     C                     MOVEL*BLANKS   CMDSTR200
     C                     Z-ADD*ZEROS    CMDLEN 155
     C                     MOVEL*OFF      $ALOC   1
      *
     C           '*'       SCAN P$ARA     CHECK   10     98
      *
     C           *IN98     IFEQ *ON                        «-------------+
     C                     CLEARP$LIBL                                   |
     C                     MOVELP$ARA     NAME      P                    |
     C                     ELSE                            }-------------|
     C           P$LIBL    CAT  '/':0     NAME   21                      |
     C           NAME      CAT  P$ARA:0   NAME      P                    |
      *                                                                  |
     C                     CALL 'QUSROBJD'                               |
     C           RCVVAR    PARM *BLANKS   RCVVAR                         |
     C                     PARM           VARLEN                         |
     C                     PARM           FORMAT                         |
     C                     PARM           QUALNM                         |
     C                     PARM           OBJTYP                         |
     C           ERRCOD    PARM           ERRCOD                         |
     C                     END                             »-------------+
      *
     C           BYTAVA    CASNE*ZEROS    *PSSR
     C                     END
      *
     C           *IN98     IFEQ *OFF                       «-------------+
     C                     MOVEL*ON       $ALOC                          |
     C                     MOVEANAME      ALC,10                         |
     C                     MOVEAALC       CMDSTR    P                    |
     C                     CALL 'QCMDEXC'                                |
     C                     PARM           CMDSTR                         |
     C                     PARM 46        CMDLEN                         |
     C                     END                             »-------------+
      *
     C                     ENDSR
      *====================================================
      *                  T A B L A S
      *====================================================
**     $KEY
F3=Salir     F5=Renovar     F12=Cancelar
F17=Principio     F18=Fin
**     ALC
alcobj ((                      *dtaara *excl))
**     DLC
dlcobj ((                      *dtaara *excl))
**     CHG
chgdtaara dtaara(                      (       )) value('