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

PROGRAM-ID.     FIND_HELD.
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            PIC 9(18) 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(20)      VALUE 
            "Enter the Username: ".

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

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

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

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

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

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

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

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

010-FIND-HELD.
    CALL "SYS$FIND_HELD"
        USING
            BY REFERENCE BINARY-RIGHTS-HOLDER,
            BY REFERENCE BINARY-RIGHTS-ID,
            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-ID,
                BY REFERENCE  RIGHTS-ID-LENGTH,
                BY DESCRIPTOR RIGHTS-ID,
                OMITTED,
                OMITTED,
                OMITTED,
            GIVING STAT
        IF STAT IS FAILURE
            CALL "LIB$STOP"
                USING
                    BY VALUE STAT
        END-IF
        DISPLAY RIGHTS-ID(1:RIGHTS-ID-LENGTH).