* 
* 
*  Copyright 2003 Pervasive Software Inc. All Rights Reserved 
* 
* 
*  BTRSAMP.CBL 
* This is a sample COBOL program that makes Btrieve calls 
* from an application using Micro Focus COBOL v3.x. 
* 
* 
       IDENTIFICATION DIVISION. 
      * 
       PROGRAM-ID. TEST1. 
      * 
      * 
       ENVIRONMENT DIVISION. 
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. IBM-PC. 
       OBJECT-COMPUTER. IBM-PC. 
      * 
      * 
       DATA DIVISION. 
      * 
       WORKING-STORAGE SECTION. 
      * 
      * BTRIEVE OP CODES 
      * 
       01 B-OPEN                        PIC 9(4) COMP-5 VALUE 0. 
       01 B-INSERT                      PIC 9(4) COMP-5 VALUE 2. 
       01 B-GETFIRST                    PIC 9(4) COMP-5 VALUE 12. 
       01 B-UPDATE                      PIC 9(4) COMP-5 VALUE 3. 
       01 B-CLOSE                       PIC 9(4) COMP-5 VALUE 1. 
      * 
       01 B-STATUS                      PIC 9(4) COMP-5 VALUE 0. 
       01 KEY-NUMBER                    PIC 9(4) COMP-5 VALUE 0. 
       01 BUF-LEN                       PIC 9(4) COMP-5 VALUE 0. 
       01 FILE-NAME                     PIC X(13) VALUE SPACES. 
       01 POSITION-BLOCK                PIC X(128) VALUE SPACES. 
       01 DATA-BUFFER. 
          02 DECIMAL-FIELD              PIC 9(4) COMP-3 VALUE 0. 
          02 STRING-FIELD               PIC X(36) VALUE SPACES. 
       01 DSP-STATUS                    PIC 9(5) COMP-5. 
      * 
      * 
      * 
       PROCEDURE DIVISION. 
       BEGIN. 
      * 
      * Open TEST.BTR 
      * 
      * 
           MOVE 0   TO BUF-LEN. 
           MOVE 0   TO KEY-NUMBER. 
           MOVE `TEST.BTR ` TO FILE-NAME. 
           CALL "_BTRV" USING B-OPEN, B-STATUS, POSITION-BLOCK, 
                             DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER. 
           IF B-STATUS NOT = 0 
             DISPLAY `Error opening file. Status= ` B-STATUS 
           ELSE 
             DISPLAY `File ` FILE-NAME ` successfully opened' 
           END-IF. 
      * 
      * Insert into TEST.BTR 
      * 
      * 
           MOVE 1    TO DECIMAL-FIELD. 
           MOVE `Record 1' TO STRING-FIELD. 
           MOVE 40   TO BUF-LEN. 
           MOVE 0    TO KEY-NUMBER 
           CALL "_BTRV" USING B-INSERT, B-STATUS, POSITION-BLOCK, 
                             DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER. 
           IF B-STATUS NOT = 0 
             DISPLAY `Error inserting into file. Status= ` B-STATUS 
           ELSE 
             DISPLAY `Inserted:  ` DECIMAL-FIELD STRING-FIELD 
           END-IF. 
      * 
      * GetFirst 
      * 
      * 
           MOVE 40   TO BUF-LEN. 
           MOVE 0    TO KEY-NUMBER 
           CALL "_BTRV" USING B-GETFIRST, B-STATUS, POSITION-BLOCK, 
                             DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER. 
           IF B-STATUS NOT = 0 
             DISPLAY `Error Getting first record. Status= ` B-STATUS 
           ELSE 
             DISPLAY `Retrieved:  ` DECIMAL-FIELD STRING-FIELD 
           END-IF. 
      * 
      * Update into TEST.BTR 
      * 
      * 
           MOVE 2    TO DECIMAL-FIELD. 
           MOVE `Record 2' TO STRING-FIELD. 
           MOVE 40   TO BUF-LEN. 
           MOVE 0    TO KEY-NUMBER 
           CALL "_BTRV" USING B-UPDATE, B-STATUS, POSITION-BLOCK, 
                             DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER. 
           IF B-STATUS NOT = 0 
             DISPLAY `Error updating file. Status= ` B-STATUS 
           ELSE 
             DISPLAY `Updated to:  ` DECIMAL-FIELD STRING-FIELD 
           END-IF. 
      * 
      * Close TEST.BTR 
      * 
      * 
           MOVE 0   TO BUF-LEN. 
           MOVE 0    TO KEY-NUMBER 
           CALL "_BTRV" USING B-CLOSE, B-STATUS, POSITION-BLOCK, 
                             DATA-BUFFER, BUF-LEN, FILE-NAME, KEY-NUMBER. 
           IF B-STATUS NOT = 0 
             DISPLAY `Error closing file. Status= ` B-STATUS 
           ELSE 
             DISPLAY `Successfully closed TEST.BTR' 
           END-IF. 
           STOP RUN.