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.