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-18375 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
      SUBROUTINE ACPUA(JTYPE,IERR)  ,92067-16361 REV.1940 790801  
      LOGICAL XFTTY 
      DIMENSION ICOM(10),LU2(2),NALL(11),SUCMD(4) 
      COMMON /ACOM1/NDCB(272),NBUF(256),MBUF(256) 
      COMMON /ACOMC/IECHO,LULOG,ITLOG,KECHO 
      COMMON /ACOM6 /LOC(6),IRN,IPFLG 
      COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) 
      COMMON /ACOM4/ICMND(40) 
      COMMON /ACOMD/ICLASS
      DATA ICOM /2HSP,0,2HSG,0,2HRP,100000B,2HRG,40000B,0,0 / 
      DATA LU2(2) / 0 / 
      DATA SUCMD / 4HSUNP,4HSDNP,4HSD,B,4HSD,S  / 
      DATA NALL/257,2H@ ,2H  ,2H  ,2H  ,2H  , 
     1              2H@ ,2H  ,2H  ,2H  ,2H  / 
C 
C     ACPUA(2) PURGES THE ACCOUNTS FILE 
C       AFTER THE SYSTEM BECOMES QUIET
C 
C     ACPUA(1) SHUTS DOWN SESSION SYSTEM
C       AFTER THE SYSTEM BECOMES QUIET
C 
C     ACPUA(3) SHUTS DOWN SESSION SYSTEM
C       FOR AN ACCOUNTS FILE LOAD 
C 
C     ACPUA(4) SHUTS DOWN SESSION SYSTEM
C       AND RELEASES MEMORY 
C 
C 
      ITYPE=JTYPE 
      IERR=0
      IF(ITYPE.EQ.3) GO TO 610
      IF(ITYPE.NE.2) GO TO 100
   25 CALL ACNVS(62HDO YOU REALLY WANT TO PURGE THE SESSION SYSTEM (YES 
     1OR NO)?  _ ,31,0) 
      IF(IPBUF(1).EQ.2HNO) RETURN 
      IF(IPBUF(1).NE.2HYE.OR.IPBUF(2).NE.2HS  ) GO TO 25
   50 IF(IPFLG.LT.0) GO TO 60 
      IPBUF(4)=0
      IF(ITYPE.EQ.3) GO TO 55 
C 
C     PROMPT FOR SHUT DOWN MESSAGE
C 
      CALL ACNVS(28HSHUT DOWN MESSAGE (20 CHARS)   ,14,0) 
   55 CALL LMES(-17,18HSESSION SHUT DOWN   ,-1) 
      IF(ITLOG.GT.20) ITLOG=20
      IF(IAND(IPBUF(4),3).NE.0) CALL LMES(-ITLOG,ICMND,-1)
C 
C     SET PURGE FLAG IN HEADER
C 
   60 CALL RNRQ(1,IRN,ISTAT)
      CALL READF(NDCB,IERR,NBUF,128,LEN,1)
      NBUF(30)=-ITYPE 
      NBUF(28)=0
      CALL WRITF(NDCB,IERR,NBUF,128,1)
      CALL RNRQ(4,IRN,ISTAT)
      IPFLG=-ITYPE
      IF(NBUF(29).EQ.0) GO TO 70
      CALL ACLIA(2) 
   70 CALL ACGSP(NALL,IERR,4HDSNP)
      IF(IERR.NE.0) CALL ACGSP(NALL,IERR,4HDS   ) 
      CALL ACGSP(NALL,JERR,4HDJNP ) 
      IF(JERR.NE.0) CALL ACGSP(NALL,JERR,4HDJ   ) 
      CALL READF(NDCB,KERR,NBUF,128,LEN,1)
      IF(IOR(IOR(NBUF(29),IERR),JERR).EQ.0) GO TO 95
      CALL ACWRI(32HTO SHUT DOWN "NOW" WE MUST ABORT  ,16)
      CALL ACWRI(32HTHE ABOVE PROCESSES!!             ,16)
      CALL ACWRI(32H---------------------             ,16)
      CALL ACNVS(40HABORT THE ABOVE PROCESSES (YES OR NO)? _ ,20,0) 
      IF(IPBUF(1).NE.2HYE) GO TO 800
      IF(IPBUF(2).NE.2HS ) GO TO 800
C 
C     MUST ABORT ABOVE SESSIONS,JOBS,AND SPOOLS 
C 
      CALL DTACH
C 
C     SEARCH ACTIVE SESSION BLOCK 
C 
      IREC=LOC(1) 
      ILAST=128*(LOC(2)-IREC) 
      DO 80 IDX=1,ILAST,4 
      LU=IVBUF(IDX,IREC)
      IF(LU.EQ.0) GO TO 80
      LU=IOR(20000B,LU) 
      CALL ACSDN(LU,JERR) 
   80 CONTINUE
C 
C     DISABLE SYSTEM CONSOLE AS SESSION TERMINAL
C 
      CALL ACSDN(0,JERR)
C                  CLEAR IVBUF
      CALL IVBUF
C 
C     ABORT JOBS AND KILL SPOOLS
C 
      CALL ACGSP(NALL,ISD,4HSDNP) 
C 
C     ISD GIVES STATE OF BATCH SPOOL SYSTEM 
C       1    BATCH AND SPOOL UP 
C       2    BATCH AND SPOOL SHUT DOWN
C       3    BATCH SHUT DOWN
C       4    SPOOL SHUT DOWN
C 
      CALL ACGSP(NALL,IERR,4HABNP)
      CALL ACSDN(20377B,JERR) 
      CALL ACGSP(NALL,JERR,4HKSNP)
      CALL ACGSP(NALL,IERR,4HSUNP)
      DO 85 I=1,10
      CALL ACGSP(NALL,IERR,4HABNP)
      CALL ACSDN(20377B,JERR) 
      CALL ACGSP(NALL,JERR,4HKSNP)
      IF(IERR.EQ.0.AND.JERR.EQ.0) GO TO 90
C 
C     WAIT 1 SEC
C 
      CALL EXEC(12,0,1,0,-100)
   85 CONTINUE
C 
C     CANT KILL SPOOLS OR ABORT JOBS
C 
      CALL ACERR(-218)
      GO TO 800 
C 
C     RESET BATCH SPOOL SYSTEM
C 
   90 CALL ACGSP(NALL,IERR,SUCMD(ISD))
C 
C     DISABLE SYSTEM SESSION CONSOLE
C 
   95 CALL ACSDN(0,JERR)
C 
C     TELL LOGON AND LGOFF TO SHUT DOWN 
C 
      CALL ACSES(-2)
      IERR=0
      RETURN
C 
C     CHECK FOR PARAMATERS
C 
  100 CALL NAMR(JPBUF,ICMND,80,ISTRC) 
      IF(IAND(JPBUF(4),3).NE.1) GO TO 700 
      LU=JPBUF(1) 
  150 IERR=-222 
      IF(LU.LT.0.OR.LU.GT.255) GO TO 500
      IERR=-223 
      IF(LU.EQ.LUTRU(1)) GO TO 500
      LU=IOR(20000B,LU) 
      DO 300 I=1,3
      CALL NAMR(JPBUF,ICMND,80,ISTRC) 
      DO 200 J=1,12,2 
      IF(JPBUF(1).EQ.ICOM(J)) GO TO 300 
  200 CONTINUE
C 
C     NOT A LEAGAL RESPONSE 
C 
      GO TO 500 
C 
C     MERGE BIT 
C 
  300 LU=IOR(LU,ICOM(J+1))
C 
C     GO SCHEDULE LGOFF 
C 
      CALL ACSDN(LU,IERR) 
      IF(IERR.NE.0) GO TO 500 
      IERR=0
      RETURN
C 
C     ACERR RETURN
C 
  400 IERR=-223 
  500 CALL ACERR(IERR)
      RETURN
  600 IF(ITYPE.EQ.1) GO TO 700
  610 CALL ACNVS(38HPURGE EXISTING ACCOUNTS (YES OR NO)? _  ,19,0)
      GO TO 750 
C 
C     SESSION WIDE SHUT DOWN
C 
  700 CALL ACNVS(66HDO YOU REALLY WANT TO SHUT DOWN THE SESSION SYSTEM  * 
     1(YES OR NO)? _,33,0)
  750 IERR=-218 
      IF(IPBUF(1).EQ.2HNO) RETURN 
      IF(IPBUF(1).NE.2HYE.OR.IPBUF(2).NE.2HS ) GO TO 600
      IF(JPBUF(1).EQ.2HRE) ITYPE=4
      IERR=0
      GO TO 50
  800 CALL ACWRI( 
     1 48HWAITING FOR SESSIONS,JOBS,AND SPOOLS TO COMPLETE  ,24)
      IERR=-218 
      RETURN
      END 
                                                                                          