********************************************************************************
IDENTIFICATION DIVISION.
********************************************************************************

PROGRAM-ID.     FIND_HOLDER.
AUTHOR.         L.Tedder
INSTALLATION.   Farm Credit Systems.
DATE-WRITTEN.   17-OCT-1988.
DATE-COMPILED.  17-OCT-1988.

********************************************************************************
ENVIRONMENT DIVISION.
********************************************************************************

*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*
CONFIGURATION SECTION.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*

*==============================================================================*
SPECIAL-NAMES.
*==============================================================================*

********************************************************************************
DATA DIVISION.
********************************************************************************

*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*
WORKING-STORAGE SECTION.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*

01  TEMPORARY-STORAGE.
    05  BINARY-RIGHTS-HOLDER-GROUP.
        10  BINARY-RIGHTS-HOLDER        PIC 9(9)  COMP.
        10  FILLER                      PIC 9(9)  COMP.
    05  BINARY-RIGHTS-ID                PIC 9(9)  COMP.
    05  CONTEXT                         PIC 9(9)  COMP VALUE 0.
    05  RIGHTS-HOLDER                   PIC X(256).
    05  RIGHTS-HOLDER-LENGTH            PIC 9(4)  COMP.
    05  RIGHTS-ID                       PIC X(256).
    05  RIGHTS-ID-LENGTH                PIC 9(4)  COMP.
    05  STAT                            PIC S9(9) COMP.
    05  SS$-NOSUCHID                    PIC 9(9)  COMP VALUE EXTERNAL SS$_NOSUCHID.
    05  USER-PROMPT                     PIC X(22)      VALUE 
            "Enter the Identifier: ".

********************************************************************************
PROCEDURE DIVISION.
********************************************************************************

*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*
000-BEGINNING SECTION.
*<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*

********************************************************************************
000-BEGIN.
********************************************************************************

    CALL "LIB$GET_FOREIGN"
        USING
            BY DESCRIPTOR RIGHTS-ID,
            BY DESCRIPTOR USER-PROMPT,
            BY REFERENCE  RIGHTS-ID-LENGTH,
            OMITTED,
        GIVING STAT.
    IF STAT IS FAILURE
        CALL "LIB$STOP"
            USING
               BY VALUE STAT.

    IF RIGHTS-ID-LENGTH IS EQUAL TO 0
        STOP RUN.

    CALL "SYS$ASCTOID"
        USING
            BY DESCRIPTOR RIGHTS-ID(1:RIGHTS-ID-LENGTH),
            BY REFERENCE  BINARY-RIGHTS-ID,
            OMITTED,
        GIVING STAT.

    IF STAT IS FAILURE
        IF STAT IS EQUAL TO SS$-NOSUCHID
            DISPLAY "No Such ID as ",RIGHTS-ID(1:RIGHTS-ID-LENGTH)
            STOP RUN
        ELSE
            CALL "LIB$STOP"
                USING
                    BY VALUE STAT.

    PERFORM 010-FIND-HOLDERS
        UNTIL STAT IS EQUAL TO SS$-NOSUCHID.
    STOP RUN.

010-FIND-HOLDERS.
    CALL "SYS$FIND_HOLDER"
        USING
            BY VALUE     BINARY-RIGHTS-ID,
            BY REFERENCE BINARY-RIGHTS-HOLDER,
            OMITTED,
            BY REFERENCE CONTEXT,
        GIVING STAT.
    IF STAT IS FAILURE
        IF STAT IS NOT EQUAL TO SS$-NOSUCHID
            CALL "LIB$STOP"
                USING
                    BY VALUE STAT.
    IF STAT IS NOT EQUAL TO SS$-NOSUCHID
        CALL "SYS$IDTOASC"
            USING
                BY VALUE      BINARY-RIGHTS-HOLDER,
                BY REFERENCE  RIGHTS-HOLDER-LENGTH,
                BY DESCRIPTOR RIGHTS-HOLDER,
                OMITTED,
                OMITTED,
                OMITTED,
            GIVING STAT
        IF STAT IS FAILURE
            CALL "LIB$STOP"
                USING
                    BY VALUE STAT
        END-IF
        DISPLAY RIGHTS-HOLDER(1:RIGHTS-HOLDER-LENGTH).