3000 FUNCTION INTEGER Getsuper (STRING Id)

3001 OPTION TYPE = EXPLICIT, SIZE = INTEGER LONG

     REM ************************************************
         This function prints the supervisory ladder of 
         employee with id equal to Id.  It calls the main 
         program function Rdb_error to handle errors.
         If the error is deadlock or lock conflict, this
         function returns 0 to the main module and 
         control returns to the ON ERROR clause.
         ************************************************

3010 DECLARE STRING Save_id,    &
                    Super_id,   &
                    Last_name,  &
                    Super_dept

     DECLARE INTEGER CONSTANT TRUE = -1%
     DECLARE INTEGER CONSTANT Out_file = 2%
   
 !invoke database using dbhandle 'pers'

  &RDB& INVOKE DATABASE EXTERNAL Pers = 
  &RDB&           FILENAME 'RDM$DEMO:personnel'

 !keep printing supervisors until super 
 !supervises self (top of ladder)

3020 Super_ladder:
             
       WHILE TRUE
 
         Save_id = Id
        
 !print supervisor id, name, department code

         &RDB&  FOR C IN CURRENT_JOB CROSS SC IN CURRENT_JOB
         &RDB&    WITH C.EMPLOYEE_ID = Id
         &RDB&    AND C.SUPERVISOR_ID = SC.EMPLOYEE_ID
         &RDB&      ON ERROR 
                      CALL Rdb_error
         &RDB&        ROLLBACK
                      Getsuper = 0%
                      EXIT FUNCTION
         &RDB&      END_ERROR
         &RDB&    GET
         &RDB&        ON ERROR 
                        CALL Rdb_error
         &RDB&          ROLLBACK
                        Getsuper = 0%
                        EXIT FUNCTION
         &RDB&        END_ERROR
         &RDB&      Super_id = C.SUPERVISOR_ID;
         &RDB&      Last_name = SC.LAST_NAME;
         &RDB&      Super_dept = SC.DEPARTMENT_CODE
         &RDB&    END_GET
    
                  IF (Super_id <> Id)
                    THEN
                      PRINT #Out_file, Super_dept, Super_id, &
                                       Last_name
                  END IF
 
         &RDB&  END_FOR

         EXIT Super_ladder IF Super_id = Save_id

         Id = Super_id            !now go get supervisor of super
      
       NEXT

       Getsuper = -1%

     END FUNCTION