Ver Mensaje Individual
  #6
Antiguo 19 de diciembre de 2023, 11:46
Josber
Moderador Global
Activista del Foro: Activista del Foro - Issue reason: Por aportar manuales y enriquecer  Agradecimientos: Por muchos agradecimientos de parte de los Foreros - Issue reason: Por muchos agradecimientos 
Última Actividad 20.09.2026 12:17
Posts Posts: 883
Likes enviados Enviados: 418
Likes recibidos Recibidos: 492

Bueno pues, sin probarlo, porque no tengo los ficheros de datos ni compilador para MS-DOS, con algo así a lo que te pongo, debería de funcionar.

Código COBOL:
  1.  
  2.        IDENTIFICATION DIVISION.
  3.        PROGRAM-ID. TRASPASO.
  4.      *
  5.        ENVIRONMENT DIVISION.
  6.        INPUT-OUTPUT SECTION.
  7.        FILE-CONTROL.
  8.             SELECT OPTIONAL RENT-FILE
  9.                    ASSIGN TO "alquiler.txt"
  10.                    ORGANIZATION IS LINE SEQUENTIAL
  11.                    FILE STATUS IS STRE.
  12.      *
  13.             SELECT OPTIONAL VENTAS-FILE
  14.                    ASSIGN TO "ventas.txt"
  15.                    ORGANIZATION IS LINE SEQUENTIAL
  16.                    FILE STATUS IS STVE.
  17.      *
  18.             SELECT OPTIONAL DESTINO
  19.                    ASSIGN TO "Destino.txt"
  20.                    ORGANIZATION IS LINE SEQUENTIAL
  21.                    FILE STATUS IS STDE.
  22.      *
  23.        DATA DIVISION.
  24.        FILE SECTION.
  25.        FD  RENT-FILE.
  26.        01  RENT-RECORD.
  27.            03  ITEM-NO                  PIC 9(03).
  28.            03  VIDEO-NAME               PIC X(20).
  29.            03  TAPES-IN-STOCK           PIC 9(03).
  30.      *
  31.        FD  VENTAS-FILE.
  32.        01  VENTAS-RECORD.
  33.            03  ITEM-NO-V                PIC 9(03).
  34.            03  VIDEO-NAME-V             PIC X(20).
  35.            03  TAPES-FOR-SALE           PIC 9(03).
  36.      *
  37.        FD  DESTINO.
  38.        01  DESTINO-RECORD.
  39.            03  ITEM-NO-D                PIC 9(03).
  40.            03  VIDEO-NAME-D             PIC X(20).
  41.            03  STOCK-D                  PIC 9(03).
  42.            03  SALE-D                   PIC 9(03).
  43.      *
  44.        WORKING-STORAGE SECTION.
  45.        77  STRE                         PIC XX.
  46.        77  STVE                         PIC XX.
  47.        77  STDE                         PIC XX.
  48.  
  49.        01  CONTA                        PIC 9(04) COMP-5.
  50.        01  CONTA-EDI                    PIC ZZZ9.
  51.        01  TECLA                        PIC X(01).
  52.        01  ERR.
  53.            03                           PIC X(37) VALUE
  54.                             "Error fichero 'Destino.txt' status: ".
  55.            03  ERRO                     PIC XX.
  56.            03                           PIC X(02) VALUE ".".
  57.        01  ERR1.
  58.            03                           PIC X(14) VALUE
  59.                             "El registro  ".
  60.            03  ERRO1                    PIC ZZ9.
  61.            03                           PIC X(38) VALUE
  62.                             ", no existe en el fichero de ventas. ".
  63.      *
  64.        PROCEDURE DIVISION.
  65.        DECLARATIVES.
  66.        DECLA-DESTINO SECTION.
  67.             USE AFTER STANDAR ERROR PROCEDURE ON DESTINO.
  68.        DESTINO-DECLA.
  69.             IF STDE = "35" OR STDE = "30"
  70.                OPEN OUTPUT DESTINO
  71.                CLOSE DESTINO
  72.                OPEN EXTEND DESTINO
  73.             ELSE
  74.                MOVE STDE TO ERRO
  75.                DISPLAY ERR
  76.                ACCEPT TECLA
  77.                CLOSE RENT-FILE
  78.                      VENTAS-FILE
  79.                STOP RUN
  80.             END-IF.
  81.        END DECLARATIVES.
  82.      *
  83.        UNICA SECTION.
  84.        ABRIR.
  85.             OPEN INPUT
  86.                  RENT-FILE
  87.                  VENTAS-FILE
  88.             OPEN EXTEND
  89.                  DESTINO.
  90.        INICIO.
  91.             DISPLAY "Pulse una tecla para iniciar ... "
  92.             ACCEPT TECLA WITH NO ADVANCING.
  93.             INITIALIZE CONTA CONTA-EDI.
  94.      *
  95.        PROCESAR.
  96.             PERFORM WITH NO LIMIT
  97.                     READ RENT-FILE
  98.                          NEXT RECORD
  99.                               AT END
  100.                                  EXIT PERFORM
  101.                               NOT AT END
  102.                                   MOVE ITEM-NO TO ITEM-NO-V ITEM-NO-D
  103.                                   READ VENTAS-FILE
  104.                                        INVALID KEY
  105.                                                MOVE ITEM-NO TO ERRO1
  106.                                                DISPLAY ERR1
  107.                                                ACCEPT TECLA WITH NO ADVANCING
  108.                                        NOT INVALID KEY
  109.                                            MOVE TAPES-FOR-SALE TO SALE-D
  110.                                   END-READ
  111.                                   MOVE VIDEO-NAME TO VIDEO-NAME-D
  112.                                   MOVE TAPES-IN-STOCK TO STOCK-D
  113.                                   WRITE DESTINO-RECORD
  114.                                   ADD 1 TO CONTA
  115.                     END-READ
  116.             END-PERFORM.
  117.      *
  118.         FIN.
  119.             MOVE CONTA TO CONTA-EDI.
  120.      *
  121.             CLOSE RENT-FILE
  122.                   VENTAS-FILE
  123.                   DESTINO.
  124.      *
  125.             DISPLAY "Fin del proceso, se han creado " WITH NO ADVANCING
  126.             DISPLAY CONTA-EDI                         WITH NO ADVANCING
  127.             DISPLAY ", pulse una tecla para terminar ... "
  128.                                                       WITH NO ADVANCING.
  129.             ACCEPT TECLA                              WITH NO ADVANCING.
  130.             STOP RUN.
  131.      *
  132.             END PROGRAM TRASPASO.

No sé que compilador vas a usar, por lo que igual la sentencia PERFORM WITH NO LIMIT, igual no la tiene tu compilador, pero eso se soluciona rápidamente con un sencillo PERFORM a un PROCEDIMIENTO (o ETIQUETA, como lo llames)

Ya nos dirás, si te funciona, si hay algo que no entiendas, pregunta, que estamos para eso.

Un salu2.-
Josber is offline   Responder Con Cita