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 
C     SOURCE PART NUMBER : 92067-18362
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C     ACMND - COMMAND DISPATCH ROUTINE
C 
C     CALLING SEQUENCE:  CALL ACMND(IEXIT)
C                WHERE
C                        IEXIT = 1 IF COMMAND IS EXIT (RETURNED)
C 
C     ACERRS:            -205  INVALID COMMAND
C 
C 
      SUBROUTINE ACMND(IEXIT) ,92067-16361 REV.2013 800131
      DIMENSION NEXT(3) 
      COMMON /ACOM2/ LRTRN,LRTR2,LGOTO,ITYPE,ITTYT,LTOSEG,NAMSG(3)
      COMMON /ACOM6 /LOC(6),IRN,IPFLG,IRN2
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      COMMON /ACOM4/ICMND(40) 
      COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) 
      COMMON /ACOMA  /ISRCH,ISR1,ISR2 
      COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID 
      LOGICAL  ISRCH
      EQUIVALENCE (IPB1,IPBUF)
      DATA NEXT/2HNE,2HXT,2H? / 
C 
C     RESET SEARCH FLAG 
C 
   50 ISRCH=.FALSE. 
C 
C     IF SHUT DOWN PRINT "SHUT DOWN"
      IF(IPFLG.GE.0) GO TO 70 
      IF(IPFLG.EQ.-2) GO TO 60
      CALL ACWRI(10H SHUT DOWN   ,5 ) 
      GO TO 70
   60 CALL ACWRI(14H ACCTS PURGED  ,7 ) 
C 
C     PROMPT WITH "NEXT?" 
C 
   70 CALL ACPRM(NEXT,3)
C 
C     READ AND PARSE THE COMMAND
C 
      CALL ACREI(ICMND,IERR)
      ISTRC=1 
      CALL NAMR(IPBUF,ICMND,80,ISTRC) 
C 
C     CHECK IF COMMAND IS ASCII 
C 
      IF(IAND(IPBUF(4),3).NE.3) GO TO 100 
      ASSIGN 100 TO LRTR2 
      ASSIGN 1300 TO LRTRN
C 
C     SAVE THE COMMAND
C 
      ICNMD=IPB1
C 
C     CHECK FOR A VALID ACCTS COMMAND 
C 
      IF(IPB1.EQ.2HNE) GO TO 150
      IF(IPB1.EQ.2HAL) GO TO 150
      IF(IPB1.EQ.2HLI) CALL ACLNK (2H4 ,1)
      IF(IPB1.EQ.2HPU) GO TO 150
      IF(IPB1.EQ.2HSD) GO TO 200
      IF(IPB1.EQ.2HSU) GO TO 200
      IF(IPB1.EQ.2HTE) CALL ACLNK (2H5 ,2)
      IF(IPB1.EQ.2HRE) GO TO 200
      IF(IPB1.EQ.2HEX) GO TO 800
      IF(IPB1.EQ.2H/E) GO TO 800
      IF(IPB1.EQ.2H/A) GO TO 800
      IF(IPB1.EQ.2HUN) CALL ACLNK (2H5 ,3)
      IF(IPB1.EQ.2HLO) GO TO 200
      IF(IPB1.EQ.2HHE) GO TO 700
      IF(IPB1.EQ.2HTR) GO TO 1200 
      IF(IPB1.EQ.2HPA) CALL ACLNK(2H3  ,7)
C 
C     PROCESS INVALID COMMAND 
C 
  100 IERR=-205 
  105 CALL RNRQ(140004B,IRN2,ISTAT) 
      GO TO 120 
  110 CONTINUE
  120 CALL ACERR(IERR)
      GO TO 50
C 
C     CHECK IF HE IS A GROUP MANAGER
C 
  150 IF(MYCAP.EQ.63) GO TO 300 
C 
C     CHECK IF HE IS SYSTEM MANAGER 
C 
  200 IF(IDSES.EQ.7777B) GO TO 300
  250 CALL ACERR(46)
      GO TO 50
  300 CALL RNRQ(1,IRN2,ISTAT) 
      IF(IPB1.EQ.2HNE) CALL ACLNK (2H2 ,1)
      IF(IPB1.EQ.2HAL) GO TO 2300 
      ITT=0 
      IF(IPB1.EQ.2HPU) GO TO 900
      ITT=2 
      IF(IPB1.EQ.2HRE) GO TO 900
      IF(IPB1.EQ.2HLO) GO TO 1500 
      IF(IPB1.EQ.2HSD) GO TO 1100 
      IF(IPB1.NE.2HSU.OR.IPFLG.GE.0) RETURN 
  400 IPFLG=1 
      ASSIGN 1300 TO LRTR2
      CALL ACLNK (2H1 ,4) 
  700 CALL ACHLP (ICMND,ISTRC)
      RETURN
  800 IEXIT=1 
      RETURN
  900 CALL NAMR(IPBUF,ICMND,80,ISTRC) 
      IF(IAND(IPBUF(4),3).NE.3) GO TO 100 
      ITEMP=IPB1/256
      IF(IDSES.EQ.7777B) GO TO 950
      IF(ICNMD.NE.2HPU.OR.ITEMP.NE.125B) GO TO 250
  950 IF(ITEMP.EQ.101B.AND.ICMND.EQ.2HPU) GO TO 1000
      IF(ITEMP.NE.125B.AND.ITEMP.NE.107B) GO TO 100 
      IF(ITEMP.EQ.125B) IT=1+ITT
      IF(ITEMP.EQ.107B) IT=2+ITT
      CALL ACLNK (2H3  ,IT) 
C 
C     PURGE ACCOUNTS
C 
 1000 CALL ACLNK (2H4 ,3) 
 1100 CALL ACLNK (2H4 ,2) 
 1200 IERR=0
      CALL ACXFR(ICMND,ISTRC,IERR)
      IF(IERR.EQ.0) GO TO 1300
      IF(IERR.EQ.10) IERR=0 
      CALL ACERR(IERR)
 1300 CALL RNRQ(140004B,IRN2,ISTAT) 
      GO TO 1320
 1310 CONTINUE
 1320 RETURN
C 
C     LOAD CALL MUST SHUT DOWN FIRST
C 
 1500 CALL NAMR(LIST,ICMND,80,ISTRC)
      LIST(4)=IAND(LIST(4),3) 
      CALL NAMR(IPBUF,ICMND,80,ISTRC) 
      JP=2
      IF(IPB1.EQ.2HAL) JP=3 
      IF(LIST(4).EQ.1.AND.LIST(1).EQ.0) GO TO 1600
C 
C     OPEN SOURCE FILE
C 
      CALL ACOPL(IERR,1,0)
      IF(IERR.NE.0) GO TO 105 
 1550 ASSIGN 1600 TO LRTRN
      ASSIGN 1700 TO LRTR2
      CALL ACLNK (2H4  ,4)
 1600 ASSIGN 1650 TO LRTRN
      ASSIGN 100 TO LRTR2 
      CALL ACLNK (2H2  ,JP) 
 1650 ASSIGN 1300 TO LRTRN
      GO TO 400 
 1700 GO TO 50
 2300 CALL NAMR(IPBUF,ICMND,80,ISTRC) 
      IF(IAND(IPBUF(4),3).NE.3) GO TO 100 
      ITEMP=IPB1/256
      IF(ITEMP.EQ.125B) CALL ACLNK(2H3 ,5)
      IF(ITEMP.EQ.107B) CALL ACLNK(2H3 ,6)
      IF(IDSES.NE.7777B) GO TO 250
      IF(ITEMP.EQ.101B) CALL ACLNK(2H5 ,1)
      GO TO 100 
      END 
                                                                    