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-18403 
C 
C     RELOCATABLE PART NUMBER : 92067-16363 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACTRM- PROGRAM ACTRM INATION ROUTINE
C 
C     CALLING SEQUENCE:  CALL ACTRM 
C 
C 
      SUBROUTINE ACTRM ,92067-16363 REV.2001 791020 
      DIMENSION LU2(2)
      COMMON /ACOMC/ IECHO,LULOG
      COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(12) 
      COMMON /ACOM1/NDCB(272),NBUF(256) 
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      COMMON /ACOM4/ICMND(40),NAMPR(3),ICLFG,NMPR3
      COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2,IDSZE
      DIMENSION MSEND(5)
      DATA MSEND/2HEN,2HD ,2HAC,2HCT,2HS /
      DATA LU2 / 0,0/ 
   10 CALL CLOSE(ITDCB) 
      CALL CLOSE(NDCB)
      CALL ACCLS(LLDCB,3) 
      IF(LLIST.GT.255) GO TO 440
      LU2(1)=IOR(LLIST,100000B) 
      CALL LURQ(70000B,LU2,1) 
      GO TO 440 
  430 CONTINUE
  440 LU2(1)=IOR(LULOG,100000B) 
      IF(ITYPE.GE.0) CALL XLUEX(2,LU2,MSEND,5)
C 
C     IF CLEAN UP REQUIRED SCHEDULE "ACCTS" TO CLEAN UP 
C 
      IF(ICLFG.EQ.-1.AND.IPFLG.LE.0) GO TO 500
C 
C     IF I AM NOT "ACCTS" SCHEDULE "ACCTS"
C 
      IF(NMPR3.EQ.2HS ) GO TO 490 
      CALL EXEC(100030B,NAMPR,-1) 
      GO TO 500 
  480 GO TO 500 
C 
C     ELSE WAKE ME UP IN 30 SEC OUTSIDE OF SESSION
C 
  490 CALL DTACH
      CALL EXEC(12,NAMPR,3,0,-2)  
      CALL EXEC(6,0,0,-1) 
  500 CALL EXEC(6)
      RETURN
      END 
                                                                                                                                              