FTN4,L
       SUBROUTINE XGTPM(ISTR,N,LOG,IDLU,MTLU,IVRFY),92067-1X548 REV.2001
     X 791101 
C*****************************************************************
C*                                                               *
C*  (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS       *
C*  RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,        *
C*  REPRODUCED OR TRANSLATED TO ANOTHER PROGRAMMING LANGUAGE     *
C*  WITHOUT THE PRIOR WRITTEN CONSENT OF THE HEWLETT-PACKARD     *
C*  COMPANY.                                                     *
C*                                                               *
C*****************************************************************
C 
C     NAME:  XGTPM
C   SOURCE:  92067-18548  
C    RELOC:  PART OF 92067-12003
C     PGMR:  J.S.W
C 
       DIMENSION ISTR(1),IPBUF(10)
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C GET PARAMETER ROUTINE 
C 
C     RU,<PROG-NAM>,<LOG LU>,<DISC LU>,<MT LU>,<OPTION>,<TITLE> 
C 
C  N=1 INDICATES LSAVE OR USAVE 
C  N=0           RESTOR 
C  ISTR-- ARRAY CONTAINING THE RUN STRING 
C  IDLU-  DISC LU 
C  MTLU-  MAG TAPE LU 
C  IVRFY- 1 FOR VERIFY OR DE OPTION 
C         0 NO VERFIFY OR ASK OK IN RESTOR
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      DO 2 I=1,75 
2     ISTR(I)=2H
C 
C 
C FIRST CHECK DATE CODE OF SYSTEM SOFTWARE IF > THAN 2001 
      LOG=1 
C 
      CALL DATCO(IDATE) 
      IF(IDATE.LT.2001) GO TO 960 
C 
C 
      IPTR=1
      CALL EXEC(14,1,ISTR,-80)
      CALL ABREG(IA,IB) 
      LEN=IB
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 500,10
10    IF(NAMR(IPBUF,ISTR,LEN,IPTR))500,15 
15    ISTR(1)=2H
      ISTR(2)=IAND(ISTR(2),377B)+20000B 
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 500,20
20    LOG=0 
      IF(IAND(IPBUF(4),3).EQ.1) LOG=IPBUF(1)
      IF(IAND(IPBUF(4),3).EQ.0) LOG=LOGLU(ISESS)
      IF(LOG.LE.0) GO TO 930
C 
C SEE IF LOG LU IS IN SESSION AND SEE 
C IF IT IS DISK LU, IF DISK LU, ILLEGAL 
C 
      CALL EXEC(13+100000B,LOG,IEQT5) 
      GO TO 930 
11    IF(IAND(IEQT5,37400B).EQ.15000B) GO TO 930
C 
C 
C PARSE DISK LU 
C 
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 500,30
30    IF(IAND(IPBUF(4),3).NEQ.1) GO TO 700
35    IDLU=IPBUF(1) 
      IF(IDLU.LE.0) GO TO 910 
C 
C 
C PARSE MTLU
C 
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 65,40 
40     MTLU=0 
      IF(IAND(IPBUF(4),3).GT.1) GO TO 800 
      IF(IAND(IPBUF(4),3).EQ.1) MTLU=IPBUF(1) 
      IF (MTLU.LT.0) GO TO 920
      IF(IAND(IPBUF(4),3).EQ.0) MTLU=8
      IF(MTLU.EQ.0) GO TO 65
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 75,50 
C 
C 
50    IVRFY=0 
      IF(IAND(IPBUF(4),3).EQ.0) GO TO 80
      IF(IPBUF(1).EQ.2HVE) IVRFY=1
      IF(IPBUF(1).EQ.2HDE) IVRFY=1
      IF(IVRFY.EQ.1.OR.N.EQ.0)  GO TO 80
      CALL EXEC(2,LOG,
     X47H ILLEGAL VERIFY PARAMETER- DEFAULT TO NO VERIFY,-47) 
      GO TO 80
C 
C 
65    MTLU=8
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C CHECK TO SEE IF MT IS ON-LINE ,IF NOT PRINT MESSAGE AND STOPS 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
75    IVRFY=0 
80    IF(MTLU.GE.64) GO TO 800
      CALL EXEC(13+100000B,MTLU,IEQT5,ISTAT1,ISTAT2)
      GO TO 800 
81    IF(IAND(IEQT5,37000B)-11000B) 800,88,800
88    IF(IAND(IEQT5,040000B).EQ.40000B) GO TO 890 
      IF(IAND(ISTAT2,100000B).EQ.100000B) GO TO 890 
C 
C NOW SEE IF MT LU IS LOCKED, IF YES PRINT MESSAGE, IF NOT
C SEE IF LOCK IS SUCCESSFUL.
C 
      CALL LURQ(140001B,MTLU,1) 
      GO TO 99
89    CALL ABREG(IA,IB) 
      IF(IA.NEQ.0) GO TO 99 
C 
C SEE IF MT ON-LINE 
C 
C 
      CALL EXEC(3,600B+MTLU)
      CALL ABREG(IA,IB) 
      IF(IAND(IA,1).NEQ.1) GO TO 200
      CALL EXEC(2,LOG+200B,17HMAG TAPE OFF-LINE,-17)
      STOP 66 
C 
C MT LU IS LOCKED 
C 
99    CALL EXEC(2,LOG+200B,12HMT LU LOCKED,-12) 
      STOP 66 
C 
C CHECK DISK LU VALIDITY
C 
200   IF(IDLU.GE.64) GO TO 250
      CALL EXEC(13+100000B,IDLU,IEQT5)
      GO TO 250 
220   IDTYPE=IAND(IEQT5,37400B)/256 
      IF(IDTYPE.GT.31B.AND.IDTYPE.LT.34B) RETURN
250   CALL EXEC(2,LOG+200B,15HILLEGAL DISK LU,-15)
      STOP 66 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C GET PARAMETER INTERACTIVELY 
C 
C FIRST CHECK IF LOG LU IS SUPPLIED, IF YES INVALID 
500   LOG=LOGLU(ISESS)
      CALL EXEC(2,LOG+200B,17HLOGLU DEFAULT TO_,-17)
      CALL CNUMD(LOG,IPBUF) 
      CALL EXEC(2,LOG+200B,IPBUF,-6)
C 
C ASK DISK LU 
C 
510   CALL EXEC(2,LOG,8HDISK LU?,-8)
      CALL REIO(1,LOG+400B,ISTR,-6) 
      CALL ABREG(IA,IB) 
      LEN= IB 
      IPTR=1
C 
C 
      IF(ISTR(1).EQ.2HEX.OR.ISTR(1).EQ.2HEN.OR.ISTR(1).EQ.2H/E) STOP
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 510,520 
C 
C 
520   IF(IPBUF(4).NEQ.1) GO TO 524
      IDLU=IPBUF(1) 
      IF(IDLU.LE.0) GO TO 524 
C 
C  CHECK IF DISK LU IS VALID
C 
       IF(IDLU.GE.64) GO TO 524 
      CALL EXEC(13+100000B,IDLU,IEQT5)
      GO TO 524 
523   IDTYPE=IAND(IEQT5,37400B)/256 
      IF(IDTYPE.GT.31B.AND.IDTYPE.LT.34B) GO TO 522 
524   CALL EXEC(2,LOG+200B,15HILLEGAL DISK LU,-15)
      GO TO 510 
C 
C 
522   CALL EXEC(2,LOG,18HMT LU? (DEFAULT=8),-18)
      CALL REIO(1,LOG+400B,ISTR,-6) 
      CALL ABREG(IA,IB) 
      LEN= IB 
C 
      IF(ISTR(1).EQ.2HEX.OR.ISTR(1).EQ.2HEN.OR.ISTR(1).EQ.2H/E)STOP 
C ASK MTLU
      IPTR=1
      IF(NAMR(IPBUF,ISTR,LEN,IPTR)) 530,530 
C 
530   MTLU=8
      IF(IAND(IPBUF(4),3).GT.1) GO TO 532 
      IF(IAND(IPBUF(4),3).EQ.1) MTLU=IPBUF(1) 
C 
C 
C CHECK IF MTLU IS VALID
C 
      IF(MTLU.GE.64) GO TO 532
      CALL EXEC(13+100000B,MTLU,IEQT5)
      GO TO 532 
531   IDTYPE=IAND(IEQT5,37400B)/256 
      IF(IDTYPE.GT.22B.AND.IDTYPE.LE.24B) GO TO 533 
532   CALL EXEC(2,LOG+200B,13HILLEGAL MT LU,-13)
      GO TO 522 
C 
C 
533   IVRFY=0 
      IF(N.EQ.0) GO TO 550
534   CALL EXEC(2,LOG,7HVERIFY?,-7) 
      CALL EXEC(1,LOG+400B,ISTR,-2) 
      IF(ISTR(1).EQ.2HVE.OR.ISTR(1).EQ.2HDE.OR.ISTR(1).EQ.2HYE) IVRFY=1 
      IF(ISTR(1).EQ.2HEN.OR.ISTR(1).EQ.2HEX.OR.ISTR(1).EQ.2H/E) STOP
      IF(ISTR(1).EQ.2HNO) GO TO 550 
      IF(IVRFY.EQ.0) GO TO 534
C 
C 
550    DO 600 I=1,50
600    ISTR(I)=2H 
C 
C IF SAVE ASK FOR LABEL 
C      THEN CHECK IF MT IS ON LINE
C 
C 
      IF(N.EQ.0) GO TO 80 
      CALL EXEC(2,LOG,16HFILE ID (LABEL)?,-16)
      CALL REIO(1,LOG+400B,ISTR(2),-40) 
      GO TO 80
700    CALL EXEC(2,LOG,39H ILLEGAL DISK LU: NON NUMERIC CHARACTER,-39)
      STOP 66 
800   CALL EXEC(2,LOG,14H ILLEGAL MT LU,-14)
      STOP 66 
890   CALL EXEC(2,LOG+200B,13HMAG TAPE DOWN,-13)
      STOP 66 
900   STOP 1
910   CALL EXEC(2,LOG,31H DISK LU MUST BE GREATER THAN 0,-31) 
      STOP 66 
920   CALL EXEC(2,LOG,31H MT LU MUST BE GREATER THAN 0  ,-31) 
      STOP 66 
930   LOG=LOGLU(ISESS)
      CALL EXEC(2,LOG,15H ILLEGAL LOG LU,-15) 
      STOP 66 
960   CALL EXEC(2,LOG,25H OUTDATED SYSTEM SOFTWARE, -25)
      STOP 66 
      END 
      END$
                                                                