/* 
 * This program will allocate 1000 blocks to the file new.tmp.
 */
OPEN_TEST: PROC OPTIONS(MAIN);

DCL F FILE OUTPUT;

OPEN FILE(F) ENVIRONMENT(USER_OPEN(MY_OPEN))  TITLE('NEW.TMP');

RETURN;

    /*
     * This function will set the appropriate bit in the FAB to allocate
     * 1000 blocks for the file.
     */
    MY_OPEN:PROC(FAB,RAB,OPEN_FLAG) RETURNS(FIXED BIN);

    %INCLUDE $FABDEF;
    %INCLUDE $RABDEF;

    DCL 1 FAB LIKE FABDEF;
    DCL 1 RAB LIKE RABDEF;
    DCL OPEN_FLAG FIXED BIN;
    DCL STATUS FIXED BIN;

    %INCLUDE SYS$OPEN;
    %INCLUDE SYS$CREATE;

    /*
     * Store the allocation quantity.
     */
    FAB.FAB$L_ALQ = 1000;
    
    /* 
     * Call sys$open or sys$create and return its status to the Run-Time 
     * Library.
     */
    IF OPEN_FLAG = 1 THEN
        STATUS = SYS$OPEN(FAB,,);
    ELSE
        STATUS = SYS$CREATE(FAB,,,);
    RETURN(STATUS);

    END MY_OPEN;

END OPEN_TEST;