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