*DECK UCPVAL
USETEXT COMCBEG 
USETEXT COMRAPL 
USETEXT COMRSFC 
USETEXT COMRRHH 
PROC UCPVAL((JOBID), SYSORG, RETURNCODE); 
# TITLE UCPVAL - VALIDATE UCP. #
  
      BEGIN  # UCPVAL # 
  
# 
**    UCPVAL - VALIDATE UCP.
* 
*     THIS PROCEDURE WILL VALIDATE A UCP. 
* 
*     PROC UCPVAL(JOBID, SYSORG, RETURNCODE). 
* 
*     ENTRY   - JOBID CONTAINS JOB IDENTIFICATION OF UCP TO BE VALIDATED
*                APL$HEADER IS BASED ARRAY FOR APPLICATION HEADER.
* 
*     EXIT   -   RETURNCODE - 0 - UCP SWAPPED.
*                             1 - UCP NOT VALIDATED.
*                             2 - UCP VALIDATED.
*                SYSORG     - TRUE, IF UCP FROM SYSTEM LIBRARY (NOS/BE) 
*                                           OR PRIVILEGED (NOS).
* 
*     CONTROL IFEQ OS$NOSBE 
*     PROCESS -  CALL RHH TO REQUEST UCP VALIDATION LEVEL 
*                WAIT FOR RHH CALL TO COMPLETE
*                IF UCP SWAPPED OUT 
*                  SET RETURNCODE = 0.
*                ELSE:  
*                  IF (APPLICATION IS SERVER OR AUTO-STARTABLE) 
*                      BUT UCP-S SOURCE ID IS NOT $RH 
*                    OR APPLICATION MUST BE SYSTEM-ORIGIN 
*                      BUT UCP IS NOT FROM SYSTEM-LIBRARY:  
*                    SET RETURNCODE = 1.
*                  ELSE:  
*                    SET SYSORG = RHH SYS-LIB-RESIDENT FLAG.
*                    SET RETURNCODE = 2.
*     CONTROL ENDIF 
*     CONTROL IFEQ OS$NOS 
*     PROCESS - CALL SSF TO VALIDATE UCP. 
*               IF UCP SWAPPED OUT
*                 SET RETURNCODE = 0. 
*               ELSE: 
*                  IF (APPLICATION IS SERVER OR AUTO-STARTABLE) 
*                      BUT UCP IS NOT SYSTEM-ORIGIN 
*                    OR APPLICATION MUST BE SYSTEM-ORIGIN 
*                      BUT UCP IS NOT PRIVILEGED
*                    OR SSF DETECTED ERROR: 
*                    SET RETURNCODE = 1.
*                  ELSE:  
*                    SET SYSORG = SSF UCP-PRIVILEGED FLAG.
*                    SET RETURNCODE = 2.
*     CONTROL ENDIF 
# 
  
      ITEM RETURNCODE I;             # UCPVAL RETURN CODE # 
      ITEM JOBID      I;             # JOBID OF UCP # 
      ITEM SYSORG     B;             # TRUE IF UCP IS SYSTEM ORIGIN # 
  
# 
****  PROC UCPVAL - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC CALLSYS;                # MAKE RA+1 REQUEST #
        PROC WAIT;                   # WAIT FOR COMPLETE BIT #
        END 
  
# 
****  PROC UCPVAL - XREF LIST END.
# 
  
  
CONTROL EJECT;
  
      CONTROL IFEQ OS$NOSBE;
  
      RHHFUNCTN = RH$VALIDAT; 
      RHH$PARAM = 0;
      RHH$JDTORD = JOBID; 
      CALLSYS(RHHCALL); 
      WAIT(LOC(RHH$PARAM)); 
  
      IF RHH$SWAP 
      THEN
        BEGIN  # UCP SWAPPED OUT #
        RETURNCODE = 0; 
        END 
  
      ELSE
        BEGIN  # UCP SWAPPED IN # 
        IF   ((APL$SVR OR APL$ASTART) AND NOT RHH$$RH)
          OR (APL$SORGRQ AND NOT RHH$SYSLIB)
        THEN
          BEGIN  # IMPROPER VALIDATION #
          RETURNCODE = 1; 
          END 
  
        ELSE
          BEGIN  # UCP VALID #
          SYSORG = RHH$SYSLIB;
          RETURNCODE = 2; 
          END 
  
        END 
  
      CONTROL ENDIF;
      CONTROL IFEQ OS$NOS;
  
      SFC$WD1 = 0;
      SFC$FC1 = SF$STAT;
      SFC$JOBID = JOBID;
      SSFRCL = FALSE; 
      SSFADDR = LOC(SFC$WD1); 
      CALLSYS(SSF$CALL);
  
      IF SFC$RC1 EQ SFRC$SWAP 
      THEN
        BEGIN  # UCP SWAPPED OUT #
        RETURNCODE = 0; 
        END 
  
      ELSE
        BEGIN  # UCP SWAPPED IN # 
        IF   ((APL$SVR OR APL$ASTART) AND NOT SFC$FP1PU)
          OR (APL$SORGRQ AND NOT SFC$FP1PP) 
          OR (SFC$RC1 NE 0) 
        THEN
          BEGIN  # UCP IMPROPER VALIDATION #
          RETURNCODE = 1; 
          END 
  
        ELSE
          BEGIN  # UCP VALID #
          SYSORG = SFC$FP1PP; 
          RETURNCODE = 2; 
          END 
  
        END 
  
      CONTROL ENDIF;
  
      RETURN; 
      END  # UCPVAL # 
  
      TERM
