Desarrolle excelentes listados utilizando cualquier lenguaje y cualquier sistema operativo.

Ejemplo de impresión de Rpv en Rm COBOL 85. [home]
Vea también: ejemplo de impresión en Power Cobol.

El ejemplo que vemos a continuación nos muestra como preparar un listado de calidad Windows utilizando RM/COBOL 85
Es importante destacar que para lograr la calidad de impresión de Windows, no es estrictamente necesario que Ud trabaje sobre entorno gráfico ya puede ser obtenida aún cuando sus programas estén preparados para DOS.

Descargue el fichero ZIP que contiene los archivos CBL, DAT y COB correspondientes a este ejemplo.

         IDENTIFICATION DIVISION.
         PROGRAM-ID. RPVEX.
         AUTHOR. DMP.
         ENVIRONMENT DIVISION.
         CONFIGURATION SECTION.
         SPECIAL-NAMES.
         DECIMAL-POINT IS COMMA.
         INPUT-OUTPUT SECTION.
         FILE-CONTROL.
        *
         SELECT OPTIONAL PUPILS ASSIGN TO RANDOM "C:PUP.DAT"
            ORGANIZATION IS INDEXED
            ACCESS IS DYNAMIC
            RECORD KEY IS PUP-CLV
            FILE STATUS IS STATUS-ISM.

         SELECT FILE-PRINTER ASSIGN TO DISK "C:PUPILS.RPV"
            FILE STATUS IS STATUS-ISM.

         DATA DIVISION.
         FILE SECTION.

         FD PUPILS.
        *
         01 PUP-REGISTRO.
            03 PUP-CLV.
               05 PUP-ID PIC 9(9).
            03 PUP-DATOS.
               05 PUP-NAME PIC X(50).
               05 PUP-PHONE PIC X(20).
               05 PUP-ZIP-CODE PIC 9(9).

         FD FILE-PRINTER.
         01 LINE-PRT PIC X(120).

         WORKING-STORAGE SECTION.
         77 STATUS-ISM PIC XX VALUE SPACES.
         77 XXX PIC XX VALUE SPACES.
         77 CONTA PIC 9(8)9 VALUE ZEROS.
         77 CONTAZ PIC Z(8)9 VALUE ZEROS.
         77 CONTAT PIC 9(8)9 VALUE ZEROS.
         77 CONTATZ PIC Z(8)9 VALUE ZEROS.

         01 RPV-LINE.
            03 FILLER PIC X(4) VALUE '{$1}'.
            03 PUP-ID-PRT PIC Z(9) VALUE ZEROS.
            03 FILLER PIC X(4) VALUE '{$2}'.
            03 PUP-NAME-PRT PIC X(50) VALUE SPACES.
            03 FILLER PIC X(8) VALUE '{A=R;$3}'.
            03 PUP-PHONE-PRT PIC X(20) VALUE SPACES.
            03 FILLER PIC X(8) VALUE '{A=L;$4}'.
            03 PUP-ZIP-CODE-PRT PIC Z(9) VALUE ZEROS.
            03 FILLER PIC X(4) VALUE '{\N}'.


         PROCEDURE DIVISION.
         DECLARATIVES.
         C-E SECTION.
         USE AFTER STANDARD ERROR PROCEDURE ON
            PUPILS FILE-PRINTER.
         END DECLARATIVES.
         PRIMER SECTION.
         MAIN-PROGRAM.
        *
         OPEN INPUT PUPILS.
         OPEN OUTPUT FILE-PRINTER.
        *
         WRITE LINE-PRT FROM 'REPORT_TITLE=Test with RM-COBOL 85'.
         WRITE LINE-PRT FROM '$1=400'.
         WRITE LINE-PRT FROM '$2=1500'.
         WRITE LINE-PRT FROM '$3=5000'.
         WRITE LINE-PRT FROM '$4=5700'.
         WRITE LINE-PRT FROM 'SPACING=250'.
         WRITE LINE-PRT FROM '[header]'.
         WRITE LINE-PRT FROM '{F=ARIAL;S=12;B=Y;C=2;\N}'.
         WRITE LINE-PRT FROM
         '{$1} Test using RM/COBOL 85 {C=0;\n;\n}'.
         WRITE LINE-PRT FROM '{S=10}'
         WRITE LINE-PRT FROM
         '{$1} Id {$2} Name {A=R;$3} Phone {A=L;$4} Zip {\n;\n;b=n}'.
         WRITE LINE-PRT FROM '[data]'.
        
         PERFORM UNTIL STATUS-ISM NOT = '00'
            READ PUPILS NEXT
            IF STATUS-ISM = '00'
               MOVE PUP-ID TO PUP-ID-PRT
               MOVE PUP-NAME TO PUP-NAME-PRT
               MOVE PUP-PHONE TO PUP-PHONE-PRT
               MOVE PUP-ZIP-CODE TO PUP-ZIP-CODE-PRT
               WRITE LINE-PRT FROM RPV-LINE
            END-IF
         END-PERFORM.
         CLOSE PUPILS FILE-PRINTER.
         CALL 'SYSTEM' USING 'RPV.EXE C:PUPILS.RPV /E'.
         STOP RUN.