RPV Reports / Usage Examples

*********************************************************
* RM/COBOL + RPV EXAMPLE
*
* THIS PROGRAM GENERATES A REPORT EXTRACTING DATA
* FROM 'CUSTOMER.DAT' FILE.
*
*********************************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. REPCUS-1.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
        DECIMAL-POINT IS COMMA.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
     COPY SELCUS.CPY.

     SELECT OUT-PRINTER ASSIGN TO DISK
            "C:COBOLRPVOUTPUTREPCUS_1.RPV"
            FILE STATUS IS STATUS-PRN.

DATA DIVISION.
FILE SECTION.
     COPY MAPCUS.CPY.

FD OUT-PRINTER.
01   LINE-TO-PRINT PIC X(220).

WORKING-STORAGE SECTION.
77 STATUS-ISM     PIC XX VALUE SPACES.
77 STATUS-PRN     PIC XX VALUE SPACES.
77 STATUS-KEY     PIC 99 VALUE ZEROS.

77 AXEPT          PIC X  VALUE SPACE.

* HERE WE DECLARE THE LINES TO BE PRINTED.

01 LINE-DETAIL.
    03 FILLER           PIC X(8)  VALUE '{a=r;$2}'.
    03 CUS-ID-PRN       PIC X(9)  VALUE SPACES.
    03 FILLER           PIC X(8)  VALUE '{a=l;$3}'.
    03 CUS-NAME-PRN     PIC X(20) VALUE SPACES.
    03 FILLER           PIC X(8)  VALUE '{tab=50}'.
    03 CUS-LASTNAME-PRN PIC X(20) VALUE SPACES.
    03 FILLER           PIC X(4)  VALUE '{$4}'.
    03 CUS-ADDRESS-PRN  PIC X(50) VALUE SPACES.
    03 FILLER           PIC X(4)  VALUE '{$5}'.
    03 CUS-PHONE-PRN    PIC X(20) VALUE SPACES.
    03 FILLER           PIC X(30) VALUE '{n}'.

COPY WIN.CPY.
*------------------------------------------------------------
SCREEN SECTION.

01 SCR.
    03 ARC-CRT.
       05 LINE 3 COLUMN 10 VALUE
                 'Press ENTER to generate the report.'.
       05 COLUMN PLUS 1 PIC X USING AXEPT.

PROCEDURE DIVISION.
DECLARATIVES.
C-E SECTION.
              USE AFTER STANDARD ERROR PROCEDURE ON
                        CUSTOMERS OUT-PRINTER.
END DECLARATIVES.
PRIMA SECTION.
MAIN-PROGRAM.
*
       DISPLAY SPACE ERASE.
       MOVE ZEROS TO STATUS-KEY.
       DISPLAY ARC-CRT
       ACCEPT  ARC-CRT
       ACCEPT STATUS-KEY FROM ESCAPE KEY
       IF STATUS-KEY = 13
          OPEN INPUT CUSTOMERS
          OPEN OUTPUT OUT-PRINTER
          PERFORM PROCESS THRU END-PROCESS
       END-IF.
       DISPLAY SPACE ERASE.
       STOP RUN.
*
*--------------------------------------------------------------
PROCESS.
*
      WRITE LINE-TO-PRINT FROM 'ORIENTATION=2'.
      WRITE LINE-TO-PRINT FROM '$1=400'.
      WRITE LINE-TO-PRINT FROM '$2=1700'.
      WRITE LINE-TO-PRINT FROM '$3=2000'.
      WRITE LINE-TO-PRINT FROM '$4=4500'.
      WRITE LINE-TO-PRINT FROM '$5=7500'.
      WRITE LINE-TO-PRINT FROM
                        'REPORT_TITLE=Customers report #1'.

      WRITE LINE-TO-PRINT FROM '[HEADER]'.

      WRITE LINE-TO-PRINT FROM '{n;F=Arial;s=18;b=y;c=2}'.

      WRITE LINE-TO-PRINT FROM
          '{$1} Rm/Cobol + Rpv Customers report. {n;n}'.

      WRITE LINE-TO-PRINT FROM '{s=12;c=0}'.

      WRITE LINE-TO-PRINT FROM
          '{$1} Example number one {n;n}'.
      WRITE LINE-TO-PRINT FROM
          '{line=400,10000;n;s=9;b=n}'.

      WRITE LINE-TO-PRINT FROM
              '{b=y;A=R;$2} Customer Id {A=L;$3} Name'.

      WRITE LINE-TO-PRINT FROM
              '{$4} Address {$5} Phone {n;n;b=n}'.

      WRITE LINE-TO-PRINT FROM '[DATA]'.

      PERFORM UNTIL STATUS-ISM = '10'
         READ CUSTOMERS NEXT
         IF STATUS-ISM = '00'
            MOVE CUS-ID       TO CUS-ID-PRN
            MOVE CUS-NAME     TO CUS-NAME-PRN
            MOVE CUS-LASTNAME TO CUS-LASTNAME-PRN
            MOVE CUS-ADDRESS  TO CUS-ADDRESS-PRN
            MOVE CUS-PHONE    TO CUS-PHONE-PRN
            WRITE LINE-TO-PRINT FROM LINE-DETAIL
         END-IF
      END-PERFORM.
      CLOSE CUSTOMERS OUT-PRINTER.
      CALL 'SYSTEM' USING
      'C:PROGRA~1RPVRPV.EXE C:COBOLRPVOUTPUTREPCUS_1.RPV'.
*
END-PROCESS.   EXIT.
*----------------------------------------------------------------