A煤n no tienes acceso a esta clase

Crea una cuenta y contin煤a viendo este curso

Curso de COBOL desde Cero

Curso de COBOL desde Cero

Carlos S谩nchez Botello

Carlos S谩nchez Botello

Siguientes pasos en COBOL

24/24
Recursos

Aportes 16

Preguntas 1

Ordenar por:

驴Quieres ver m谩s aportes, preguntas y respuestas de la comunidad? Crea una cuenta o inicia sesi贸n.

Carlos:

Este curso fue muy, muy bueno eres detallista, nos llevaste de la mano en un ambiente complejo.

Excelente curso introductorio

Excelente profesor.

Me encanto que nos resuelvas las dudas directamente.

Este curso estuvo excelente y muy detallado para un lenguaje que tiene muchas condiciones a la hora de codificar y compilar, es por esto que se encuentran pocos cursos de este lenguaje. Simplemente me encant贸 aunque me tard茅 en unas clases por errores que al final del d铆a era falta de puntos o mal uso de columnas.
Muchas gracias por este curso, su tiempo y paciencia

Excelente鈥 me ayudo mucho con la parte de los JCL

Profesor, muchas gracias por este curso me encanto, me ayudo bastante. El honor es todo m铆o. Nos vemos en m谩s cursos.

Gran curso y lo mas dif铆cil fue el prework de el mismo .El profesor explic贸 de manera especifica todo y fue muy ameno.
Muchas Gracias Profe Carlos.

Excelente Curso muy bien explicado todo , me encanto poder instalar mi propio maimframe , muchas gracias Carlos

Me encanto este curso Carlos 馃槂 , la verdad al principio se me dificulto 馃槮 , pero con la din谩mica de ense帽anzas la verdad fue f谩cil de entender . 馃槂

Agradezco todo tu conocimiento y por tomarte el tiempo de ayudarnos a responder todas las inquietudes . 馃槂

Muchas gracias.

Se te agradece tus conocimientos, eres muy bueno.

Me encanto este curso, aunque sinceramente no fue nada f谩cil.
Agradezco al profesor por responder todas las inquietudes que tuve y estoy listo para el curso de cobol practico.

隆Hasta pronto!

Bueno, en este capitulo si no tengo m谩s preguntas, 鈥淒ir谩s, por fin鈥, jajajaja, much铆simas gracias Carlos por hacer de este ambiente que es complejo para los nuevos un entorno f谩cil y amigable, explicando todo a cada detalle y teniendo en cuenta los usos en las distintas terminales 3270, adem谩s de tener el tiempo de responder a cada una de las preguntas que se van generando en el curso, mis respetos.

Excelente curso y espero m谩s cursos de usted profesor.

compilando y ejecutando:

les mando este codigo fuente de cobol que hice en 1997

   IDENTIFICATION DIVISION.
   PROGRAM-ID. MENCON.
   AUTHOR. MARTIN RAMIREZ**2.
  ************************************************
  **                                            **
  **    MENU GENERAL DE CONTABILIDAD GENERAL    **
  **                                            **
  ************************************************
   DATE-WRITTEN. 97/12/02.
   DATE-COMPILED.
   ENVIRONMENT DIVISION.
   CONFIGURATION SECTION.
   SOURCE-COMPUTER. IBM-PC.
   OBJECT-COMPUTER. IBM-PC.
   SPECIAL-NAMES.
       CRT  STATUS  IS  key-status.
   INPUT-OUTPUT SECTION.
   FILE-CONTROL.
       SELECT  FECHAS  ASSIGN  TO  DISK
               ORGANIZATION  IS  SEQUENTIAL
               ACCESS  MODE  IS  SEQUENTIAL.
       SELECT  MENUSS  ASSIGN  TO  DISK
               ORGANIZATION  IS  LINE SEQUENTIAL
               ACCESS  MODE  IS  SEQUENTIAL.
       SELECT  SEGURI  ASSIGN  TO  DISK
               ORGANIZATION  IS  INDEXED
               ACCESS  MODE  IS  DYNAMIC
               RECORD  KEY   IS  CLASEG
               ALTERNATE RECORD  KEY  IS  SEGAUX  =  PASSEG
               FILE  STATUS  IS  FS-SEGURI.
   DATA DIVISION.
   FILE SECTION.
   FD  FECHAS
       LABEL  RECORDS  ARE  STANDARD
       VALUE  OF  FILE-ID  IS  ARCFEC
       RECORD CONTAINS  15  CHARACTERS
       DATA   RECORD    IS  REGFEC.
   01  REGFEC.
       02  FECCIA      PIC  9(06).
       02  FECCIAR  REDEFINES  FECCIA.
           03  DIACIA  PIC  9(02).
           03  MESCIA  PIC  9(02).
           03  ANOCIA  PIC  9(02).
   FD  MENUSS
       LABEL  RECORDS  ARE  STANDARD
       VALUE  OF  FILE-ID  IS  ARCMEN
       RECORD CONTAINS  71  CHARACTERS
       DATA   RECORD   ARE  REGME1  REGME2  REGME3.
   01  REGME1.
       02  LINPR1      PIC  9(02).
       02  LINUL1      PIC  9(02).
       02  FILLER      PIC  X(01).
       02  COLUM1      PIC  9(02).
       02  ANCHO1      PIC  9(02).
       02  FILLER      PIC  X(01).
       02  LINOP1      PIC  9(02).
       02  COLOP1      PIC  9(02).
   01  REGME2.
       02  LINEA2      PIC  9(02).
       02  COLUM2      PIC  9(02).
       02  TIPLI2      PIC  X(01).
       02  DESCR2      PIC  X(66).
   01  REGME3.
       02  OPCME3      PIC  9(02).
       02  FILLER      PIC  X(01).
       02  NUMSG3      PIC  9(01).
       02  FILLER      PIC  X(01).
       02  PROGR3      PIC  X(10).
       02  FILLER      PIC  X(01).
       02  SGUNO3      PIC  9(03).
       02  FILLER      PIC  X(01).
       02  SGDOS3      PIC  9(03).
       02  FILLER      PIC  X(01).
       02  SGTRE3      PIC  9(03).
       02  FILLER      PIC  X(01).
       02  SGCUA3      PIC  9(03).
       02  FILLER      PIC  X(01).
       02  SGCIN3      PIC  9(03).
   COPY  FDSEG.CPY.
   WORKING-STORAGE SECTION.
   01  ARCFEC.
       02  ARCFE0      PIC  X(16).
       02  ARCFE1      PIC  X(10)     VALUE  "FECHAS.SEQ".
   01  ARCMEN.
       02  ARCME0      PIC  X(10).
   01  FS-SEGURI.
       02  FS-SEGUR1   PIC  X(01).
       02  FS-SEGUR2   PIC  X(01).
       02  FS-SEGUR3   REDEFINES  FS-SEGUR2  PIC  9(02)  COMP-X.
   01  EXISTE          PIC  X(08)     COMP-X.
   01  XXXXXX          PIC  X(10).
   COPY  PARAME.CPY.
   01  I               PIC  9(05)     VALUE  ZEROS.
   01  J               PIC  9(05)     VALUE  ZEROS.
   01  K               PIC  9(05)     VALUE  ZEROS.
   01  L               PIC  9(05)     VALUE  ZEROS.
   01  M               PIC  9(05)     VALUE  ZEROS.
   01  ACC             PIC S9(02).
   01  MAL             PIC  9(02)     VALUE  ZEROS.
   01  WIN             PIC S9(02).
   01  ACCION          PIC  X(13).
   01  CAMPOX          PIC  X(01).
   01  NOEXIS          PIC  9(02).
   01  NUMERO          PIC  9(02).
   01  LINOPC          PIC  9(02).
   01  COLOPC          PIC  9(02).
   01  OPCION          PIC  9(01).
       88  OPC    VALUES  ARE  1  THRU  2.
       88  OPCZ   VALUE   IS   99.
   01  OPCION2         PIC  9(02).
       88  OPC2   VALUES  ARE  01  THRU  59.
       88  OPC2Z  VALUE   IS   99.
   01  RESULT          PIC  9(04)V9(10).
   01  RESULTR  REDEFINES  RESULT.
       02  RESUL1      PIC  9(04).
       02  RESUL2      PIC  9(10).
   01  TABDIA.
       02  FILLER      PIC  X(26)     VALUE
       "31283130313031313031303131".
   01  TABDIAR  REDEFINES  TABDIA.
       02  DIAMES      PIC  X(02)  OCCURS  13  TIMES.
   01  FECHAM          PIC  9(06).
   01  FECHAMR  REDEFINES  FECHAM.
       02  ANOM        PIC  9(02).
       02  MESM        PIC  9(02).
       02  DIAM        PIC  9(02).
   01  HORASM          PIC  X(04).
   01  HORASS  REDEFINES  HORASM  PIC  9(02)V9(02).
   01  DIASSM          PIC  9(05).
   01  WCLAVE.
       02  WCLAV1      PIC  X(01).
       02  WCLAV2      PIC  X(01).
       02  WCLAV3      PIC  X(01).
       02  WCLAV4      PIC  X(01).
       02  WCLAV5      PIC  X(01).
   01  WPASSW.
       02  WPASS1      PIC  9(03).
       02  WPASS2      PIC  9(03).
       02  WPASS3      PIC  9(03).
       02  WPASS4      PIC  9(03).
       02  WPASS5      PIC  9(03).

  *  utilerias de cobol

  *  ventana 1
   01  win-1.
       02  datw1      PIC  9(04)     COMP-X  VALUE  0.
       02  bufw1      PIC  X(2000).
       02  atrw1      PIC  X(2000).
       02  lonw1      PIC  9(04)     COMP-X  VALUE  2000.

  *  ventana 2
   01  win-2.
       02  datw2      PIC  9(04)     COMP-X  VALUE  0.
       02  bufw2      PIC  X(2000).
       02  atrw2      PIC  X(2000).
       02  lonw2      PIC  9(04)     COMP-X  VALUE  2000.

  * status del accept
   01  key-status.
       03  key-type     PIC  X(01).
       03  key-code-1   PIC  9(02)   comp-x.
       03  key-code-2   PIC  9(02)   comp-x.

  * sombras
   01  screen-position.
       03  row-number   PIC  X(01)   comp-x.
       03  col-number   PIC  X(01)   comp-x.
   01  attribute        PIC  X(80)   value  all  X"08".
   01  string-length    PIC  X(02)   comp-x.
   01  status-code      PIC S9(04)   comp.

  * define flechas como funci垄n
   01  set-bit-pairs    pic  9(02)   comp-x  value  1.
   01  adis-key.
       03  adis-key-set pic  9(02)   comp-x.
       03  filler       pic  X(01)           value  "2".
       03  first-adis   pic  9(02)   comp-x.
       03  number-adis  pic  9(02)   comp-x.

  *  fin de utilerias de cobol

   01  TABPRO.
       02  NOMPRO      PIC  X(10)  OCCURS  60  TIMES.
       02  NUMOPC      PIC  9(01)  OCCURS  60  TIMES.
       02  OPCUNO      PIC  9(03)  OCCURS  60  TIMES.
       02  OPCDOS      PIC  9(03)  OCCURS  60  TIMES.
       02  OPCTRE      PIC  9(03)  OCCURS  60  TIMES.
       02  OPCCUA      PIC  9(03)  OCCURS  60  TIMES.
       02  OPCCIN      PIC  9(03)  OCCURS  60  TIMES.
   01  TABNOM.
       02  FILLER      PIC  X(55)     VALUE
       "脠脡脢脣脤脥脦脧脨脩脪脫脭脮脰脳脴脵脷脹脺脻脼脽脿谩芒茫盲氓忙莽猫茅锚毛矛铆卯茂冒帽貌贸么玫枚梅酶霉煤没眉媒镁".
       02  FILLER      PIC  X(07)     VALUE
       '!"#$%&'.
       02  FILLER      PIC  X(49)     VALUE
       "'()*+,-./0123456789:;<=>[email protected]".
       02  FILLER      PIC  X(56)     VALUE
       "XYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ 鈧佲毱掆炩︹犫∷嗏芭犫古捖嵟铰".
       02  FILLER      PIC  X(56)     VALUE
       "聬鈥樷欌溾濃⑩撯斔溾劉拧鈥号撀澟九嘎犅÷⒙Bぢヂβ┞奥甭猜陈绰德堵仿嘎孤郝宦悸铰韭棵脕脗脙脛脜脝脟".
   01  NOMTAB  REDEFINES  TABNOM.
       02  NOMBR       PIC  X(01)  OCCURS  223  TIMES.
   01  TABMES.
       02  FILLER      PIC  X(10)     VALUE  "  ENERO   ".
       02  FILLER      PIC  X(10)     VALUE  " FEBRERO  ".
       02  FILLER      PIC  X(10)     VALUE  "  MARZO   ".
       02  FILLER      PIC  X(10)     VALUE  "  ABRIL   ".
       02  FILLER      PIC  X(10)     VALUE  "   MAYO   ".
       02  FILLER      PIC  X(10)     VALUE  "  JUNIO   ".
       02  FILLER      PIC  X(10)     VALUE  "  JULIO   ".
       02  FILLER      PIC  X(10)     VALUE  "  AGOSTO  ".
       02  FILLER      PIC  X(10)     VALUE  "SEPTIEMBRE".
       02  FILLER      PIC  X(10)     VALUE  " OCTUBRE  ".
       02  FILLER      PIC  X(10)     VALUE  "NOVIEMBRE ".
       02  FILLER      PIC  X(10)     VALUE  "DICIEMBRE ".
       02  FILLER      PIC  X(10)     VALUE  "  CIERRE  ".
   01  MESTAB  REDEFINES  TABMES.
       02  MESES       PIC  X(10)  OCCURS  13  TIMES.
   SCREEN SECTION.
   01  VIDEO-FECHA.
       02  BACKGROUND-COLOR  1  FOREGROUND-COLOR  3.
           03  REVERSE-VIDEO.
               04  LINE  02  COLUMN  72  PIC  9(02)
                   USING  DIACIA  AUTO  BELL.
               04  LINE  02  COLUMN  75  PIC  9(02)
                   USING  MESCIA  AUTO.
               04  LINE  02  COLUMN  78  PIC  9(02)
                   USING  ANOCIA  AUTO.
   01  VIDEO-DERECH.
       02  BACKGROUND-COLOR  4  FOREGROUND-COLOR  7.
           02  LINE  04  COLUMN  03  VALUE
           "                                            ".
           02  LINE  05  COLUMN  03  VALUE
           "                                            ".
           02  LINE  06  COLUMN  03  VALUE
           "       CONTABILIDAD INFORMATICA (97)        ".
           02  LINE  07  COLUMN  03  VALUE
           "                                            ".
           02  LINE  08  COLUMN  03  VALUE
           "  Realizado por :                           ".
           02  LINE  09  COLUMN  03  VALUE
           "                                            ".
           02  LINE  10  COLUMN  03  VALUE
           "         脛脥冒 GRUPO  INFORMATICO 脛脥冒         ".
           02  LINE  11  COLUMN  03  VALUE
           "                                            ".
           02  LINE  12  COLUMN  03  VALUE
           "  Coatepec 43A-1 Fracc. Veracruz            ".
           02  LINE  13  COLUMN  03  VALUE
           "  Xalapa, 91020, Ver.    Tel. (28) 14-71-04 ".
           02  LINE  14  COLUMN  03  VALUE
           "                                            ".
           02  LINE  15  COLUMN  03  VALUE
           "  Version (4.1)   1997 Derechos Reservados. ".
           02  LINE  16  COLUMN  03  VALUE
           "  Este programa esta registrado en la       ".
           02  LINE  17  COLUMN  03  VALUE
           "  Secretaria de Educaci垄n P拢blica (SEP)     ".
           02  LINE  18  COLUMN  03  VALUE
           "  Conforme acuerdo Num. 114.                ".
           02  LINE  19  COLUMN  03  VALUE
           "                                            ".
           02  LINE  20  COLUMN  03  VALUE
           " SE PROHIBE LA REPRODUCCION TOTAL O PARCIAL ".
           02  LINE  21  COLUMN  03  VALUE
           " DE ESTE PROGRAMA BAJO SANCION DE LEY.      ".
           02  LINE  22  COLUMN  03  VALUE
           "                                            ".
           02  LINE  23  COLUMN  03  VALUE
           "                                            ".
           02  LINE  24  COLUMN  03  VALUE
           "                                            ".
   01  VIDEO-OPCION.
       02  BACKGROUND-COLOR  0  FOREGROUND-COLOR  8.
           03 LINE 06 COLUMN 26 VALUE "                           ".
           03 LINE 07 COLUMN 26 VALUE "                           ".
           03 LINE 08 COLUMN 26 VALUE "                           ".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  8.
           03 LINE 05 COLUMN 27 VALUE "脡脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥禄".
           03 LINE 06 COLUMN 27 VALUE "潞 C O N T A B I L I D A D 潞".
           03 LINE 07 COLUMN 27 VALUE "脠脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥录".
       02  BACKGROUND-COLOR  8  FOREGROUND-COLOR  8.
           03  LINE  12  COLUMN  04  VALUE  "                   ".
           03  LINE  13  COLUMN  04  VALUE  "                   ".
           03  LINE  14  COLUMN  04  VALUE  "                   ".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  15.
           03  LINE  11  COLUMN  05  VALUE  "脡脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥禄".
           03  LINE  12  COLUMN  05  VALUE  "潞 ACTUALIZACIONES 潞".
           03  LINE  13  COLUMN  05  VALUE  "脠脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥录".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  4.
           03  LINE  12  COLUMN  07  VALUE  "A".
       02  BACKGROUND-COLOR  8  FOREGROUND-COLOR  8.
           03  LINE  12  COLUMN  26  VALUE  "             ".
           03  LINE  13  COLUMN  26  VALUE  "             ".
           03  LINE  14  COLUMN  26  VALUE  "             ".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  15.
           03  LINE  11  COLUMN  27  VALUE  "脡脥脥脥脥脥脥脥脥脥脥脥禄".
           03  LINE  12  COLUMN  27  VALUE  "潞 CONSULTAS 潞".
           03  LINE  13  COLUMN  27  VALUE  "脠脥脥脥脥脥脥脥脥脥脥脥录".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  4.
           03  LINE  12  COLUMN  29  VALUE  "C".
       02  BACKGROUND-COLOR  8  FOREGROUND-COLOR  8.
           03  LINE  12  COLUMN  42  VALUE  "               ".
           03  LINE  13  COLUMN  42  VALUE  "               ".
           03  LINE  14  COLUMN  42  VALUE  "               ".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  15.
           03  LINE  11  COLUMN  43  VALUE  "脡脥脥脥脥脥脥脥脥脥脥脥脥脥禄".
           03  LINE  12  COLUMN  43  VALUE  "潞 IMPRESIONES 潞".
           03  LINE  13  COLUMN  43  VALUE  "脠脥脥脥脥脥脥脥脥脥脥脥脥脥录".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  4.
           03  LINE  12  COLUMN  45  VALUE  "I".
       02  BACKGROUND-COLOR  8  FOREGROUND-COLOR  8.
           03  LINE  12  COLUMN  60  VALUE  "                 ".
           03  LINE  13  COLUMN  60  VALUE  "                 ".
           03  LINE  14  COLUMN  60  VALUE  "                 ".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  15.
           03  LINE  11  COLUMN  61  VALUE  "脡脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥禄".
           03  LINE  12  COLUMN  61  VALUE  "潞 ADMINISTRADOR 潞".
           03  LINE  13  COLUMN  61  VALUE  "脠脥脥脥脥脥脥脥脥脥脥脥脥脥脥脥录".
       02  BACKGROUND-COLOR  7  FOREGROUND-COLOR  4.
           03  LINE  12  COLUMN  64  VALUE  "D".
   PROCEDURE DIVISION  CHAINING  PARAME.
   INICIO.
       PERFORM  DEFINE-FUNCIONES
       ACCEPT   FECHAM  FROM  DATE
       ACCEPT   HORASM  FROM  TIME
       ACCEPT   DIASSM  FROM  DAY
       .
       MOVE  SUBCIA  TO  ARCFE0
       OPEN  INPUT  FECHAS
       READ  FECHAS  AT  END  MOVE  1  TO  I.
       CLOSE  FECHAS
       .
  •      MOVE  DIAM    TO  DIACIA
    
  •      MOVE  MESM    TO  MESCIA
    
  •      MOVE  ANOM    TO  ANOCIA
         DISPLAY  VIDEO-FECHA
         .
         PERFORM  GUARDA-WIN1
         PERFORM  CHECA-SEGURI
         DISPLAY  VIDEO-DERECH
         PERFORM  PEDIR-PASSWD
         IF  MAL  =  ZEROS
             PERFORM  PINTA-WIN1
             DISPLAY  VIDEO-OPCION
             PERFORM  GUARDA-WIN2
             PERFORM  MUEVE-PARAME
             MOVE  ZEROS   TO  OPCION
             PERFORM  PROCESO  UNTIL  OPCION  =  1
             ACCEPT  FECHAM  FROM  DATE
             ACCEPT  HORASM  FROM  TIME
             ACCEPT  DIASSM  FROM  DAY
             MOVE  FECHAM  TO  UFESEG
             MOVE  HORASS  TO  UHRSEG
             PERFORM  GRABA-SEGURI
             OPEN  OUTPUT  FECHAS
             WRITE  REGFEC
             CLOSE  FECHAS
         .
         DISPLAY  (01, 01)  " "  WITH  BLANK  SCREEN
         EXIT PROGRAM
         .
     PROCESO.
         DISPLAY  VIDEO-FECHA
         PERFORM  GUARDA-WIN2
         MOVE  ZEROS  TO  WIN  OPCION  MAL
         PERFORM  PEDIR-OPCION  UNTIL  OPC
         PERFORM  CHECA-FECHAS
         IF  WIN  =  1
             MOVE  "MENACT.SEQ"  TO  ARCME0
         .
         IF  WIN  =  2
             MOVE  "MENCON.SEQ"  TO  ARCME0
         .
         IF  WIN  =  3
             MOVE  "MENIMP.SEQ"  TO  ARCME0
         .
         IF  WIN  =  4
             MOVE  "MENADM.SEQ"  TO  ARCME0
         .
         IF  MAL  =  ZEROS  AND  WIN  NOT  =  ZEROS
             PERFORM  DESP-OPCIONES
             MOVE  ZEROS  TO  OPCION2
             PERFORM  OPCIONES  UNTIL  OPCION2  =  99
         .
         PERFORM  PINTA-WIN2
         .
     DESP-OPCIONES.
         OPEN  INPUT  MENUSS
         READ  MENUSS  AT  END  MOVE  1  TO  I.
         move  COLUM1  to  col-number
         move  ANCHO1  to  string-length  M
         perform  varying  I  from  LINPR1  by  1  until  I  >  LINUL1
             move  I  to  row-number
             call  "cbl_write_scr_attrs" using screen-position
                    attribute string-length returning status-code
         end-perform
         COMPUTE  J  =  LINUL1  -  LINPR1  +  2
         COMPUTE  L  =  ANCHO1  -  2
         MOVE  LINOP1  TO  LINOPC
         MOVE  COLOP1  TO  COLOPC
         PERFORM  LEE-OPCIONES  VARYING  I  FROM  1  BY  1
                  UNTIL  I  >  J
         PERFORM  LEE-PROGRAMAS  VARYING  I  FROM  1  BY  1
                  UNTIL  I  >  60
         CLOSE  MENUSS
         .
     LEE-OPCIONES.
         READ  MENUSS  AT  END  MOVE  1  TO  K
         .
         MOVE  LINEA2  TO  LIN
         MOVE  COLUM2  TO  COL
         IF  TIPLI2  =  "N"
             DISPLAY  (LIN, COL)  DESCR2  WITH  SIZE  M
                      BACKGROUND-COLOR  7  FOREGROUND-COLOR  14
         .
         IF  TIPLI2  =  "I"
             DISPLAY  (LIN, COL)  DESCR2  WITH  SIZE  L
                      BACKGROUND-COLOR  7  FOREGROUND-COLOR  14
                      REVERSE-VIDEO
         .
     LEE-PROGRAMAS.
         READ  MENUSS  AT  END  MOVE  1  TO  K
         .
         MOVE  NUMSG3  TO  NUMOPC (I)
         MOVE  PROGR3  TO  NOMPRO (I)
         MOVE  SGUNO3  TO  OPCUNO (I)
         MOVE  SGDOS3  TO  OPCDOS (I)
         MOVE  SGTRE3  TO  OPCTRE (I)
         MOVE  SGCUA3  TO  OPCCUA (I)
         MOVE  SGCIN3  TO  OPCCIN (I)
         .
     OPCIONES.
         MOVE  ZEROS  TO  OPCION2
         PERFORM  PEDIR-OPCION2  UNTIL  OPC2  OR  OPC2Z
         .
         MOVE  ZEROS  TO  MAL
         IF  NOT  OPC2Z
             IF  NOMPRO (OPCION2)  =  "DATCIA.GNT"
                 IF  ACC001  NOT  =  "S"
                     MOVE  1  TO  MAL
         .
         IF  NOT  OPC2Z
             IF  NOMPRO (OPCION2)  =  "CAMFEC.GNT"
                 IF  ACC002  NOT  =  "S"
                     MOVE  1  TO  MAL
         .
         IF  NOT  OPC2Z
             IF  NOMPRO (OPCION2)  =  "ADMCON.GNT"
                 IF  ADMSEG  NOT  =  "S"
                     MOVE  1  TO  MAL
         .
         IF  NOT  OPC2Z   AND  MAL  =  ZEROS  AND
             NOMPRO (OPCION2)  NOT  =  "NOVALE.GNT"
             PERFORM  CHECA-FECHAS
             PERFORM  CHECA-ACCESO
             IF  MAL  =  ZEROS
                 IF  NOMPRO (OPCION2)  =  "CAMFEC.GNT"
                     PERFORM  PINTA-WIN1
                     PERFORM  CAMBIA-FECHA
                     PERFORM  MUEVE-PARAME
                     PERFORM  GUARDA-WIN1
    
  •                  PERFORM  PINTA-WIN2
    
  •                  DISPLAY  VIDEO-FECHA
    
  •                  PERFORM  GUARDA-WIN2
                     MOVE  99  TO  OPCION2
                 ELSE
                     PERFORM  CANCELA-FUNCIONES
                     PERFORM  MUEVE-PARAME2
                     CALL    NOMPRO (OPCION2)  USING  PARAME
                     CANCEL  NOMPRO (OPCION2)
                     PERFORM  DEFINE-FUNCIONES
                     IF  NOMPRO (OPCION2)  =  "ADMCON.GNT"
                         PERFORM  MUEVE-PARAME
                     END-IF
         .
     PEDIR-OPCION.
         ACCEPT  (24, 02)  CAMPOX  WITH  SECURE  AUTO-SKIP
         DISPLAY (24, 02)  "  "
         .
         IF  key-type  =  ZEROS
             IF  key-code-1  =  48  AND  key-code-2  =  13
                 MOVE  2  TO  OPCION
             ELSE
                 EVALUATE  CAMPOX
                     WHEN  "A"  MOVE  1  TO  WIN
                     WHEN  "C"  MOVE  2  TO  WIN
                     WHEN  "I"  MOVE  3  TO  WIN
                     WHEN  "D"  MOVE  4  TO  WIN
                     WHEN  OTHER  call  x"e5"
                 END-EVALUATE
         .
         IF  key-type  =  1
             IF  key-code-1  =  ZEROS  AND  key-code-2  =  ZEROS
                 MOVE  1  TO  OPCION
             ELSE
                 IF  key-code-1  =  30  AND  key-code-2  =  30
                     IF  CLASEG  =  "MRR"
                         PERFORM  CANCELA-FUNCIONES
                         CALL    "ADMCON.GNT"  USING  PARAME
                         CANCEL  "ADMCON.GNT"
                         PERFORM  DEFINE-FUNCIONES
                         PERFORM  LEE-SEGURI-IDX
                         PERFORM  MUEVE-PARAME
                     ELSE
                         call  x"e5"
                 ELSE
                     call  x"e5"
         .
         IF  key-type  =  2
             EVALUATE  key-code-1
                 WHEN  3
                     COMPUTE  WIN  =  WIN  -  1
                     IF  WIN  <  1
                         MOVE  4  TO  WIN
                     END-IF
                 WHEN  4
                     COMPUTE  WIN  =  WIN  +  1
                     IF  WIN  >  4
                         MOVE  1  TO  WIN
                     END-IF
                 WHEN  5
                     COMPUTE  WIN  =  WIN  -  1
                     IF  WIN  <  1
                         MOVE  4  TO  WIN
                     END-IF
                 WHEN  6
                     COMPUTE  WIN  =  WIN  +  1
                     IF  WIN  >  4
                         MOVE  1  TO  WIN
                     END-IF
                 WHEN  OTHER  call  x"e5"
             END-EVALUATE
         .
         EVALUATE  WIN
            WHEN  1
                PERFORM  PINTA-WIN2
                DISPLAY  (12, 07)  "ACTUALIZACIONES"
                        WITH  BACKGROUND-COLOR  7  FOREGROUND-COLOR  5
            WHEN  2
                PERFORM  PINTA-WIN2
                DISPLAY  (12, 29)  "CONSULTAS"
                        WITH  BACKGROUND-COLOR  7  FOREGROUND-COLOR  5
            WHEN  3
                PERFORM  PINTA-WIN2
                DISPLAY  (12, 45)  "IMPRESIONES"
                        WITH  BACKGROUND-COLOR  7  FOREGROUND-COLOR  5
            WHEN  4
                PERFORM  PINTA-WIN2
                DISPLAY  (12, 63)  "ADMINISTRADOR"
                        WITH  BACKGROUND-COLOR  7  FOREGROUND-COLOR  5
         END-EVALUATE
         .
    *    DISPLAY  (17, 01)  "key-type   "  key-type
    *    DISPLAY  (18, 01)  "key-code-1 "  key-code-1
    *    DISPLAY  (19, 01)  "key-code-2 "  key-code-2
    *    DISPLAY  (21, 01)  "claseg     "  CLASEG
    *    DISPLAY  (22, 01)  "win        "  win
         .
     PEDIR-OPCION2.
         MOVE  LINOPC  TO  LIN
         MOVE  COLOPC  TO  COL
         ACCEPT  (LIN, COL)  OPCION2  WITH  PROMPT  AUTO-SKIP  BEEP
         .
         IF  key-type  =  ZEROS  OR  key-type  =  1
             IF  OPCION2  =  ZEROS
                 MOVE  99  TO  OPCION2
         .
     PEDIR-PASSWD.
         MOVE  ZEROS  TO  MAL
         DISPLAY  (10, 50)  "                 "
         DISPLAY  (10, 50)  "PASSWORD: [     ]"
         ACCEPT   (10, 61)  WCLAVE  WITH  PROMPT  AUTO-SKIP  BEEP
                            NO-ECHO
         .
         PERFORM  MUEVE-PASSEG
         PERFORM  LEE-SEGURI-IDX
         IF  NOEXIS  =  1
             MOVE  1  TO  MAL
         .
     MUEVE-PASSEG.
         PERFORM  BUSCA  VARYING  I  FROM  1  BY  1  UNTIL  I  =  224
                  OR  WCLAV1  =  NOMBR (I)
         MOVE  I  TO  WPASS1
         PERFORM  BUSCA  VARYING  I  FROM  1  BY  1  UNTIL  I  =  224
                  OR  WCLAV2  =  NOMBR (I)
         MOVE  I  TO  WPASS2
         PERFORM  BUSCA  VARYING  I  FROM  1  BY  1  UNTIL  I  =  224
                  OR  WCLAV3  =  NOMBR (I)
         MOVE  I  TO  WPASS3
         PERFORM  BUSCA  VARYING  I  FROM  1  BY  1  UNTIL  I  =  224
                  OR  WCLAV4  =  NOMBR (I)
         MOVE  I  TO  WPASS4
         PERFORM  BUSCA  VARYING  I  FROM  1  BY  1  UNTIL  I  =  224
                  OR  WCLAV5  =  NOMBR (I)
         MOVE  I  TO  WPASS5
         MOVE  WPASSW  TO  PASSEG
         .
     MUEVE-PARAME.
         MOVE  FECCIA  TO  FECHA
         MOVE  MESES  (MES)  TO  NOMMES
         MOVE  CLASEG  TO  CLAUSU
         MOVE  ADMSEG  TO  ADMINI
         .
     MUEVE-PARAME2.
         MOVE  "N"  TO  SEGUR1  SEGUR2  SEGUR3  SEGUR4  SEGUR5
         IF  OPCUNO (OPCION2)  >  ZEROS
             MOVE  OPCUNO (OPCION2)  TO  I
             MOVE  ACCSEG (I)  TO  SEGUR1
         .
         IF  OPCDOS (OPCION2)  >  ZEROS
             MOVE  OPCDOS (OPCION2)  TO  I
             MOVE  ACCSEG (I)        TO  SEGUR2
         .
         IF  OPCTRE (OPCION2)  >  ZEROS
             MOVE  OPCTRE (OPCION2)  TO  I
             MOVE  ACCSEG (I)        TO  SEGUR3
         .
         IF  OPCCUA (OPCION2)  >  ZEROS
             MOVE  OPCCUA (OPCION2)  TO  I
             MOVE  ACCSEG (I)        TO  SEGUR4
         .
         IF  OPCCIN (OPCION2)  >  ZEROS
             MOVE  OPCCIN (OPCION2)  TO  I
             MOVE  ACCSEG (I)        TO  SEGUR5
         .
     CAMBIA-FECHA.
         ACCEPT   VIDEO-FECHA
         DISPLAY  VIDEO-FECHA
         COMPUTE  RESULT  =  ANOCIA  /  4
         IF  RESUL2  =  ZEROS
             MOVE  29  TO  DIAMES (2)
         ELSE
             MOVE  28  TO  DIAMES (2)
         .
         IF  MESCIA  <  1  OR  MESCIA  >  13
             GO TO  CAMBIA-FECHA
         .
         IF  DIACIA  <  1  OR  DIACIA  >  DIAMES (MESCIA)
             GO TO  CAMBIA-FECHA
         .
     BUSCA.
         EXIT.
     CHECA-FECHAS.
         IF  FECHAM  <  FEISEG  OR  FECHAM  >  FETSEG
             MOVE  1  TO  MAL
         .
         IF  HORASS  <  HRISEG  OR  HORASS  >  HRTSEG
             MOVE  1  TO  MAL
         .
     CHECA-ACCESO.
         IF  NUMOPC (OPCION2)  =  1
             MOVE  OPCUNO (OPCION2)  TO  I
             IF  ACCSEG (I)  =  "N"
                 MOVE  1  TO  MAL
         .
         IF  NUMOPC (OPCION2)  =  2
             MOVE  OPCUNO (OPCION2)  TO  I
             MOVE  OPCDOS (OPCION2)  TO  J
             IF  ACCSEG (I)  =  "N"  AND  ACCSEG (J)  =  "N"
                 MOVE  1  TO  MAL
         .
         IF  NUMOPC (OPCION2)  =  3
             MOVE  OPCUNO (OPCION2)  TO  I
             MOVE  OPCDOS (OPCION2)  TO  J
             MOVE  OPCTRE (OPCION2)  TO  K
             IF  ACCSEG (I)  =  "N"  AND  ACCSEG (J)  =  "N"  AND
                 ACCSEG (K)  =  "N"
                 MOVE  1  TO  MAL
         .
         IF  NUMOPC (OPCION2)  =  4
             MOVE  OPCUNO (OPCION2)  TO  I
             MOVE  OPCDOS (OPCION2)  TO  J
             MOVE  OPCTRE (OPCION2)  TO  K
             MOVE  OPCCUA (OPCION2)  TO  L
             IF  ACCSEG (I)  =  "N"  AND  ACCSEG (J)  =  "N"  AND
                 ACCSEG (K)  =  "N"  AND  ACCSEG (L)  =  "N"
                 MOVE  1  TO  MAL
         .
         IF  NUMOPC (OPCION2)  =  5
             MOVE  OPCUNO (OPCION2)  TO  I
             MOVE  OPCDOS (OPCION2)  TO  J
             MOVE  OPCTRE (OPCION2)  TO  K
             MOVE  OPCCUA (OPCION2)  TO  L
             MOVE  OPCCIN (OPCION2)  TO  M
             IF  ACCSEG (I)  =  "N"  AND  ACCSEG (J)  =  "N"  AND
                 ACCSEG (K)  =  "N"  AND  ACCSEG (L)  =  "N"  AND
                 ACCSEG (M)  =  "N"
                 MOVE  1  TO  MAL
         .
     CHECA-SEGURI.
         MOVE  ZEROS   TO  MAL
         CALL  "CBL_CHECK_FILE_EXIST"  USING  "SEGCON.DAT"  EXISTE
         IF  EXISTE  =  ZEROS
             MOVE  1  TO  MAL
         ELSE
             OPEN  I-O  SEGURI
             MOVE  LOW-VALUES  TO  CLASEG
             PERFORM  POSIC-SEGURI
             IF  I  =  ZEROS
                 NEXT  SENTENCE
             ELSE
                 MOVE  1  TO  MAL
         .
         IF  MAL  =  1
             PERFORM  MUEVE-PARAME
             DISPLAY  (01, 01)  " "  WITH  BLANK  SCREEN
             PERFORM  CANCELA-FUNCIONES
             CALL    "ADMCON.GNT"  USING  PARAME
             CANCEL  "ADMCON.GNT"
             PERFORM  LEE-SEGURI-IDX
             STOP  RUN
         .
     POSIC-SEGURI.
         MOVE  ZEROS  TO  I
         START  SEGURI  KEY  IS  NOT  LESS  THAN  CLASEG
                INVALID KEY  MOVE  1  TO  I
         .
     LEE-SEGURI-IDX.
         OPEN  I-O    SEGURI
         MOVE  ZEROS  TO  NOEXIS
         READ  SEGURI  WITH  LOCK  KEY  IS  SEGAUX  INVALID  KEY
               MOVE  1  TO  NOEXIS
         .
         CLOSE  SEGURI
         .
     GRABA-SEGURI.
         OPEN  I-O  SEGURI
         REWRITE  REGSEG  INVALID  KEY
                  STOP  "SEGURIDAD NO FUE ACTUALIZADO"
         .
         CLOSE  SEGURI
         .
     GUARDA-WIN1.
         call "CBL_READ_SCR_CHATTRS"  using datw1 bufw1 atrw1 lonw1
         .
     GUARDA-WIN2.
         call "CBL_READ_SCR_CHATTRS"  using datw2 bufw2 atrw2 lonw2
         .
     PINTA-WIN1.
         call "CBL_WRITE_SCR_CHATTRS" using datw1 bufw1 atrw1 lonw1
         .
     PINTA-WIN2.
         call "CBL_WRITE_SCR_CHATTRS" using datw2 bufw2 atrw2 lonw2
         .
     DEFINE-FUNCIONES.
    * define flechas
         MOVE   3  TO  adis-key-set
         MOVE   3  TO  first-adis
         MOVE   2  TO  number-adis
         call X"AF" using set-bit-pairs  adis-key
         .
         MOVE   1  TO  adis-key-set
         MOVE   5  TO  first-adis
         MOVE   2  TO  number-adis
         call X"AF" using set-bit-pairs  adis-key
         .
     CANCELA-FUNCIONES.
         MOVE   2  TO  adis-key-set
         MOVE   3  TO  first-adis
         MOVE   2  TO  number-adis
         call X"AF" using set-bit-pairs  adis-key
         .
         MOVE   2  TO  adis-key-set
         MOVE   5  TO  first-adis
         MOVE   2  TO  number-adis
         call X"AF" using set-bit-pairs  adis-key
         .
     FIN-PROGRAM.
         END PROGRAM  MENCON.
    

?

Exelente curso y Exelente profesor, Gracias profe por ayudarnos en cada detalle, error etc, Todos le agradecemos por ayudarnos en todos nuestros errores y dudas, este profe se lleva 5 estrellas!!. Nos vemos en el siguiente curso!

Un excelente curso, Muchas gracias por la informaci贸n. Consegu铆 un trabajo, en gran parte por este curso 馃槉馃憣馃憣

Gracias por el curso, estuvo muy bien explicado y a detalle los pasos para realizar la instalaci贸n y los programas.
viendo este curso entend铆 muchas cosas acerca de otros lenguajes de programacion de mas alto nivel en el que ya se da por sentado la declaraci贸n de variables y los ciclos, caso que no es el de cobol esto me ayuda a entender como funciona un lenguaje por debajo.