FTN4,L
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 PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C     SOURCE PART NUMBER :92067-18411 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
      SUBROUTINE ACHLP (ICMND,ISTRC),92067-16361 REV.1940 790722  
      LOGICAL  ISRCH
      COMMON /ACOM1/NDCB(272),NBUF(256) 
      COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3)
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      DIMENSION ICMND(40),IPBUF(11) 
      COMMON /ACOM5/LOWUS,IHIGR 
      COMMON /ACOM6 /LOC(6),IRN,IPFLG 
      COMMON /ACOM8/LASTP(40),LENP
      COMMON /ACOMA  /ISRCH,ISR1,ISR2,ISR3,ISR4 
      COMMON /ACOMB /ISTK(90),IPT 
      COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO,IERFG,KERRB(8)
      COMMON /ACOMD/ICLASS,KPB,KRR,KRRR 
      DIMENSION LU2(2)
      EQUIVALENCE (LIST,LIST1)
      DATA LU2 / 0,0 /
      CALL NAMR(IPBUF,ICMND,80,ISTRC) 
      ISV=ISTRC 
      IP4=IAND(IPBUF(4),3)
      CALL NAMR(LIST,ICMND,80,ISTRC)
      IF(IERFG.EQ.-1.OR.IP4.EQ.1) GO TO 300 
      LIST(4)=IAND(LIST(4),3) 
      CALL ACOPL(IERR,3,24) 
      IF(IERR.NE.0) GO TO 100 
      KPB=IPBUF(1)
      LSAVE=LRTRN 
      ASSIGN 75 TO LRTRN
      CALL ACLNK(2H5 ,4)
  75  LRTRN=LSAVE 
      IERR=KRR
      IF(KRRR.NE.0) CALL ACWRL(20H  KEYWORD NOT FOUND  ,10,IERR)
      IF(IERR.GE.0) GO TO 150 
  100 CALL ACERR(IERR)
  150 CALL ACCLL
      KPB=0 
      RETURN
C 
C     CONVERT INTEGER ACERR NUMBER TO ASCII 
C 
  300 IF(IPBUF(1).NE.0) CALL ACITA(IPBUF,KERRB(5),2)
C 
C     CONVERT LIST DEVICE 
C 
      KERRB(8)=2H 
      IF(LIST1.NE.0) CALL ACITA(LIST,KERRB(7),2)
      LIST1=LUTRU(LIST1)
      IF(LIST1.NE.LLIST) GO TO 450
C 
C     UNLOCK LU SO HELP CAN USE IT
C 
      LU2=IOR(LLIST,100000B)
      CALL LURQ(70000B,LU2,1) 
      GO TO 450 
  440 CONTINUE
C 
C     PUT IN COMMA
C 
  450 KERRB(7)=2H , 
      CALL EXEC(100027B,6HHELP  ,LIST,0,0,0,0,KERRB,8)
      GO TO 500 
  460 IF(LIST1.EQ.LLIST) CALL ACLCK(LLIST,IERR) 
      LIST1=-1
C 
C     SET LIST DEVICE UNASSIGNED
      RETURN
C 
C     TELL HELP NOT LOADED
C 
  500 CALL ACWRI(16H HELP NOT LOADED  ,8) 
      RETURN
      END 
                                                                                                                                                                                                                                                    