ASMB,R,L,C
      HED "IDRPL" FTN/SPL SUBROUTINE TO DO A FMGR ":RP,PROG"
*     SOURCE: 92067-18235 
*     RELOC:  92067-16185 
*     PGMR:   D.C.L.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
      NAM IDRPL,7 92067-16185 REV.2040 800710 
* 
*  MODIFICATION RECORD: 
*       DATE      REASON       BY WHOM
*  1)  800710    SUBROUTINE IDRPL CHANGED TO SUBROUTINE IDRP. 
*                THIS IS NOW AN INTERFACE INTO IDRP.   (DCL)
* 
* 
      ENT IDRPL 
      EXT .ENTR,IDRP
* 
A     EQU 0 
B     EQU 1 
      SKP 
*  PURPOSE: 
*    TO ACCOMPLISH THE EQUIVALENT OF A FMGR ":RP,PROG" IN A SUBROUTINE. 
*  CALLED:
*     CALL IDRPL (IDCB,IERR,NAME,NID) 
*           -OR-
*     IF (IDRPL (IDCB,IERR,NAME,NID).NE.0) GO TO IERROR 
*  WHERE: 
*     IERR = RETURN ERROR CODE (SAME AS ERROR CODES IN FMGR)
*     IDCB = AN OPEN DCB OF THE TYPE 6 FILE 
*     NAME = 5 CHARACTER BUFFER OF THE PROGRAM NAME PUT IN ID SEGMENT 
*     NID  = (OPTIONAL) RETURN ADDRESS OF NEW ID SEGMENT
* 
* 
*  RETURN:
* 
*     IERR =   0 > SUCCESSFUL INSTALLATION OF ID SEGMENT INTO SYSTEM
*     E-REG =  1 IF ERROR, ELSE E-REG =  0 (FOR SPL FRETURN)
*     IERR =  -1 > DISC ERROR 
*     IERR = -11 > IDCB NOT OPEN
*     IERR =  14 > NO BLANK ID SEGMENTS OR EXTENSIONS AVAILABLE 
*     IERR = -15 > ILLEGAL NAME 
*     IERR =  16 > FILE NOT ON DISC LU =  2 OR LU =  3
*                   AND INSUFFICIENT SYSTEM POOL TRACKS 
*                   AVAILABLE FOR COPY
*     IERR =  19 > ID(34),ID(35) WORDS DID NOT CHECKSUM CORRECTLY.
*     IERR =  23 > DUPLICATE PROGRAM NAME.
*     IERR =  75 > TYPE 6 PGM IS PROTECTED ON USER ID 
*     IERR =  76 > TYPE 6 PGM IS PROTECTED ON GROUP ID
*     IERR =  77 > TYPE 6 PGM IS PROTECTED ON CAPABILITY LEVEL
*     IERR =  78 > INTERNAL CONSISTENCY CHECK IN <IDRP> HAVE FAILED.
* 
*  NOTES: 
* 
*    (1)  A-REG = IERR ON RETURN, THEREFORE MAY BE USED AS FUNCTION 
*    (2)  IDRPL  DOES NOT CLOSE THE FILE. 
*    (3)  RECOMMEND FILE BE NON-EXECLUSIVELY OPENED 
*    (4)  E-REG = 1, IF ERROR, E=0, IF NO ERROR(FOR SPL)
*    (5)  ONLY THE 1ST 10 WORDS OF THE DCB ARE USED BY THIS SUBROUTINE. 
*    (6)  THIS IS MERELY AN INTERFACE INTO THE IDRP SUBROUTINE AND IS 
*         PROVIDED FOR BACKWARD AND FORWARD COMPATIBILITY.
*         YOU SHOULD CALL IDRPL BECAUSE IDRP WILL (DOES) NOT EXIST
*         IN ALL VERSIONS OF RTE. 
* 
      SKP 
IDCB  NOP           OPEN DCB ADDRESS
IERR  NOP           RETURNED ERROR CODE 
NAME  NOP           FIVE CHAR ASCII NAME TO GIVE PROGRAM
NID   DEF JUNK      ADDRESS OF NEW ID SEGMENT 
* 
IDRPL NOP           ENTRY 
      JSB .ENTR 
       DEF IDCB 
* 
      JSB IDRP
       DEF *+1+6
       DEF IDCB,I 
       DEF IERR,I 
       DEF NAME,I 
       DEF IBUF 
       DEF IBUFL
       DEF NID,I
* 
      STB JUNK      SAVE B-REG TEMPORARILY
      LDB AJUNK     RESET OPTIONAL PARAMETER
      STB NID         FOR NEXT ENTRY
      LDB JUNK      RESTORE B-REG 
* 
      JMP IDRPL,I   EXIT
* 
* 
ISIZE EQU 128       BUFFER SIZE 
IBUF  BSS ISIZE     BUFFER FOR DISK COPY
IBUFL ABS ISIZE     BUFFER LENGTH 
* 
JUNK  BSS 1         "NID" PARAMETER VALUE PUT HERE IF DEFAULTED 
AJUNK DEF JUNK
* 
      END 
                                                                                                                                                                                                                                                  