Get member records

In order to extract all records in a member, File Manager first makes a GetFirstMemberRecord call, followed by multiple GetNextMemberRecord calls. If there is a record, then the rc=0. At any time, the process can be normally terminated with an End Of File (RAM-RC-EOF) return code.

The GetFirstMemberRecord call requires a member name as a parameter. It is passed as follows:

01 MEMBER-ID-SPEC.
    05 SOFTWARE-VERSION PIC 9(4) BINARY.
    05 MEM-ID-SPEC-COLL-PTR POINTER.
01 MEM-ID-SPEC-COLL.
    05 SOFTWARE-VERSION PIC 9(4) BINARY.
    05 MEM-ID-COMPONENT-COUNT PIC 9(4) BINARY.
    05 MEM-ID-COMPONENT-PTR POINTER
           OCCURS 1 TO 10 TIMES
           DEPENDING ON MEM-ID-COMPONENT-COUNT.
01 MEM-ID-COMPONENT.
    05 MEM-ID-COMP-TYPE PIC 9(4) BINARY.
    05 MEM-ID-COMP-NAME-STRING.
       10 MEM-ID-COMP-NAME-LEN PIC 9(4) BINARY.
       10 MEM-ID-COMP-NAME-GROUP.
          15 MEM-ID-COMP-NAME PIC X
                OCCURS 1 TO 10 TIMES
                DEPENDING ON MEM-ID-COMP-NAME-LEN.
01 MEMBER-NAME-STRING.
    05 MEMBER-NAME-LEN PIC 9(4) BINARY.
    05 MEMBER-NAME-GROUP.
       10 MEMBER-NAME PIC X
                      OCCURS 1 TO 10 TIMES
                      DEPENDING ON MEMBER-NAME-LEN.
GET-RAM-PARM3-MEM-ID.
     SET ADDRESS OF MEMBER-ID-SPEC TO RAM-PARM3
     SET ADDRESS OF MEM-ID-SPEC-COLL
                 TO MEM-ID-SPEC-COLL-PTR
     IF MEM-ID-COMPONENT-COUNT NOT = 1 THEN
        SET RAM-RC-MEM-ID-SPEC-BAD TO TRUE
     ELSE
        SET ADDRESS OF MEM-ID-COMPONENT
            TO MEM-ID-COMPONENT-PTR(1)
        IF MEM-ID-COMP-TYPE NOT = 0 THEN
           SET RAM-RC-MEM-ID-SPEC-BAD TO TRUE
        END-IF
     END-IF
     IF RAM-RC-OK THEN
        SET ADDRESS OF MEMBER-NAME-STRING
           TO ADDRESS OF MEM-ID-COMP-NAME-STRING
        IF TRACELVL >= TRACEBAS THEN
          MOVE SPACES TO LOG-TEXT
          STRING "Member = " DELIMITED BY SIZE
                 MEMBER-NAME-GROUP DELIMITED BY SIZE
                 INTO LOG-TEXT
          CALL LOGFUNC USING LOG-HOST, LOG-MODULE, LOG-TEXT
        END-IF
     END-IF.

If you are writing a user exit in COBOL, it is unlikely you will need to change this code which gets the member name argument. This code describes the data structures and is provided for users who want to rewrite the exit into PL/I or HLASM.

Here is the code for getting the first member record:

GET-1ST-MEM-REC.
     PERFORM GET-RAM-PARM2-RAM-ARGS
     PERFORM VAL-REPOS-VS-RAM-ARGS
     IF RAM-RC-OK THEN
        PERFORM GET-RAM-PARM3-MEM-ID
        PERFORM USER-GET-1ST-MEM-REC
     END-IF.

It uses the VAL-REPOS-VS-RAM-ARGS routine to determine if the library has already been validated. If so, it does not need to be redone. Then it gets the member name, and calls the USER-GET-1ST-MEM-REC paragraph. This is where you should insert your calls to the user library access methods.

The member record results are returned in a data area which looks like this:

01 REC-DATA-RETURN-AREA.
    05 REC-DATA-RETURN-ATTR1 PIC 9(4) BINARY VALUE 1.
    05 REC-DATA-RETURN-LEN1  PIC 9(4) BINARY VALUE 80.
    05 REC-DATA-RETURN-STR1  PIC X(80).
    05 REC-DATA-RETURN-END   PIC X(2)        VALUE X"FFFF".

The member record text is placed in REC-DATA-RETURN-STR1 and a return code of 0 returned.

If the member is empty, a RAM-RC-EOF (180) return code is returned.

Note: If you are providing support for an LMS which provides the capability to place proprietary INCLUDE statements in the member, the proprietary INCLUDEs should be fully expanded.

When getting the second and subsequent records in a member, the member name parameter is not passed to the exit.