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-18373 
C 
C     RELOCATABLE PART NUMBER : 92067-16362 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     ACNWU - NEW USER COMMAND ROUTINE
C 
C     CALLING SEQUENCE:  CALL ACNWU 
C 
C     ACERRS:            -200  ACCOUNT NOT FOUND
C                        -201  NO FREE ACCOUNTS 
C                        -202  ACCOUNT WITH THIS NAME ALREADY EXISTS
C                        -203  INVALID ACCOUNT NAME 
C                        -204  INVALID PASSWORD 
C                        -206  INVALID FILE NAME
C                        -207  INVALID CAPABILITY 
C                        -208  INVALID DISC LIMIT 
C                        -209  INVALID SST ENTRY
C                        -210  CONFLICT IN SST DEFINITION 
C                        -211  USER OR GROUP ID NOT AVAILABLE 
C                        -212  INVALID NUMBER OF SST SPARES 
C                         FMP ACERR (READF,WRITF) 
C 
C 
      SUBROUTINE ACNWU ,92067-16362 REV.2013 800131 
      DIMENSION MSNAM(5),MSGNM(6),MSGST(12),MSUPW(7),MSHFL(8) 
      DIMENSION MSCAP(8),MSMXD(12),MSSST(29),MSSPR(11),MSLNK(32)
      DIMENSION MSGNX(9),LUMS1(27),LUMS2(31)
      DIMENSION IUSER(5),IDMY(2),IRECG(2) 
      COMMON /ACOM1/NDCB(272),NBUF(128) 
      COMMON /ACOM6 /LOC(6),IRN 
      COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) 
      COMMON /ACOM9/IBUF(40),JBUF(96) 
      COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID 
      DATA MSNAM/2HUS,2HER,2H N,2HAM,2HE?/
      DATA MSGNM/2HGR,2HOU,2HP ,2HNA,2HME,2H? / 
      DATA MSGST/2HUS,2HE ,2HGR,2HOU,2HP ,2HSS,2HT ,2H(Y,2H O,
     1     2HR ,2HN),2H? /
      DATA MSUPW/2HUS,2HER,2H P,2HAS,2HSW,2HOR,2HD?/
      DATA MSHFL/2HUS,2HER,2H H,2HEL,2HLO,2H F,2HIL,2HE?/ 
      DATA MSCAP/2HUS,2HER,2H C,2HAP,2HAB,2HIL,2HIT,2HY?/ 
      DATA MSMXD/2HMA,2HXI,2HMU,2HM ,2HDI,2HSC,2H C,2HAR,2HTR,
     1     2HID,2HGE,2HS?/
      DATA MSSST/2HSS,2HT ,2HDE,2HFI,2HNI,2HTI,2HON,2H? ,2H(E,
     1     2HNT,2HER,2H S,2HES,2HSI,2HON,2H L,2HU,,2H S,2HYS, 
     2     2HTE,2HM ,2HLU,2H, ,2HOR,2H E,2HNT,2HER,2H /,2HE)/ 
      DATA MSSPR/2HNU,2HMB,2HER,2H O,2HF ,2HSS,2HT ,2HSP,2HAR,
     1     2HES,2H? / 
      DATA MSLNK/2HLI,2HNK,2H T,2HO ,2HAN,2H E,2HXI,2HST,2HIN,
     1     2HG ,2HAC,2HCO,2HUN,2HT?,2H (,2HEN,2HTE,2HR ,2H" ,2H" ,
     2     2HOR,2H U,2HSE,2HR.,2HGR,2HOU,2HP/,2HPA,2HSS,2HWO, 
     3     2HRD,2H) / 
      DATA MSGNX/2HNE,2HXT,2H G,2HRO,2HUP,2H O,2HR ,2H/E,2H?  / 
      DATA LUMS1/2HCO,2HNF,2HLI,2HCT,2H I,2HN ,2HSS,2HT ,2HDE,
     1     2HFI,2HNI,2HTI,2HON,2H -,2H A,2HSS,2HUM,2HIN,2HG , 
     2     2HUS,2HER,2H D,2HEF,2HIN,2HIT,2HIO,2HN / 
      DATA LUMS2/2HUS,2HER,2H: ,2HSE,2HS ,2HLU,2H  ,2H  ,2H, ,
     1     2HSY,2HS ,2HLU,2H  ,2H  ,2H  ,2H  ,2H G,2HRO,2HUP, 
     2     2H: ,2HSE,2HS ,2HLU,2H  ,2H  ,2H, ,2HSY,2HS ,2HLU, 
     3     2H  ,2H  / 
C 
C 
C     CHECK IF A FREE ACCOUNT OF 128 WORDS EXISTS 
C 
      CALL ACFDF(IDIRN,IRECN,IOFST,IERR,1)
      IF(IERR.EQ.0) GO TO 100 
      CALL ACERR(-201)
      RETURN
C 
C     PROMPT FOR THE USER NAME
C 
  100 CALL ACPRM(MSNAM,5) 
C 
C     READ AND PARSE THE USER NAME
C 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(IPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF((IPBUF(2).EQ.2H/A).OR.(IPBUF(2).EQ.2H/E)) RETURN 
C 
C     IF NAME IS INVALID, REPORT ACERR AND RE-PROMPT
C     NAME CANNOT BE IN USER.GROUP FORMAT 
C     NAME CANNOT BE "@" OR NULL
C 
      IF(IERR.NE.0) GO TO 200 
      IF(IAND(IPBUF(1),255).NE.0) GO TO 200 
      IF(IPBUF(2).EQ.2H@ ) GO TO 200
      IF(IPBUF(1).NE.0) GO TO 300 
  200 CALL ACERR(-203)
      GO TO 100 
  300 IF(IDSES.EQ.7777B) GO TO 310
C 
C     GET THE GROUP NAME FROM 
C     MY ACCOUNT
C 
      CALL ACDIR(1,MYDIR,IBUF,IERR) 
      JPBUF(1)=256*LBYTE(IBUF(1)) 
      JPBUF(2)=IBUF(7)
      JPBUF(3)=IBUF(8)
      JPBUF(4)=IBUF(9)
      JPBUF(5)=IBUF(10) 
      JPBUF(6)=IBUF(11) 
C 
C     SET MAXIMUM CAPABILITY
C 
      MAXCAP=62 
      GO TO 600 
C 
  310 MAXCAP=63 
C 
C     PROMPT FOR THE GROUP NAME 
C 
      CALL ACPRM(MSGNM,6) 
C 
C     READ AND PARSE THE GROUP NAME 
C 
  320 CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 
C 
C     IF NAME IS INVALID, REPORT ACERR AND RE-PROMPT
C     NAME CANNOT BE IN USER.GROUP FORMAT AND CANNOT BE "@" 
C 
  330 IF(IERR.NE.0) GO TO 400 
      IF(IAND(JPBUF(1),255).NE.0) GO TO 400 
      IF(JPBUF(2).NE.2H@ ) GO TO 500
  400 CALL ACERR(-203)
      GO TO 300 
C 
C     IF NO GROUP SPECIFIED, DEFAULT TO GENERAL 
C 
  500 IF(JPBUF(1).NE.0) GO TO 600 
      JPBUF(1)=3400B
      JPBUF(2)=2HGE 
      JPBUF(3)=2HNE 
      JPBUF(4)=2HRA 
      JPBUF(5)=2HL
C 
C     CHECK THAT GROUP ACCOUNT EXISTS 
C 
  600 IUSER(1)=0
      CALL ACFDA(IUSER,JPBUF(2),IDMY,IDMY,IDMY,IERR)
      IF(IERR.EQ.0) GO TO 700 
      CALL ACERR(-200)
      IF(IDSES.EQ.7777B) GO TO 310
      RETURN
C 
C     CHECK IF USER.GROUP ACCOUNT ALREADY EXISTS
C 
  700 CALL ACFDA(IPBUF(2),JPBUF(2),IDMY,IDMY,IDMY,IERR) 
      IF(IERR.EQ.-200) GO TO 800
  710 CALL ACERR(-202)
      GO TO 100 
C 
C     SAVE GROUP INFO (LENGTH OF NAME, NAME)
C 
  800 DO 900 I=2,6
      IPBUF(I+5)=JPBUF(I) 
  900 CONTINUE
      IPBUF(1)=IPBUF(1)+(JPBUF(1)/256)
C 
C     PROMPT FOR WHETHER TO USE GROUP SST 
C 
      CALL ACPRM(MSGST,12)
C 
C     READ AND PARSE FOR Y OR N 
C 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 
C 
C     SET SIGN BIT IF Y OR NULL TO INDICATE USE GROUP SST 
C 
      JBUF(33)=0
      ITEMP=JPBUF(2)/256
      IF((ITEMP.EQ.131B).OR.(JPBUF(1).EQ.0))
     1    JBUF(33)=100000B
C 
C     PROMPT FOR USER PASSWORD
C 
 1100 CALL ACPRM(MSUPW,7) 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
      IF(IERR.EQ.0) GO TO 1120
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 
 1110 CALL ACERR(-204)
      IERR=0
      GO TO 1100
C 
C     IF NO PASSWORD SPECIFIED, DEFAULT TO NONE 
C 
 1120 IF(JPBUF(1).NE.0) GO TO 1140
      DO 1130 KNDX=2,6
      JBUF(KNDX)=2H 
 1130 CONTINUE
      GO TO 1170
C 
C     PASSWORD CAN'T BE IN USER.GROUP FORMAT
C 
 1140 IF(IAND(JPBUF(1),255).NE.0) GO TO 1110
      DO 1150 KNDX=2,6
      JBUF(KNDX)=JPBUF(KNDX)
 1150 CONTINUE
 1170 JBUF(1)=JPBUF(1)/256
C 
C     PROMPT FOR USER HELLO FILE
C 
 1200 CALL ACPRM(MSHFL,8) 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN 
C     CHECK IF NULL OR BLANK (DEFAULT TO NO HELLO FILE) 
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(ITEMP.NE.0.AND.JPBUF(1).NE.2H/E ) GO TO 1208 
      DO 1205 KNDX=7,9
      JBUF(KNDX)=2H 
 1205 CONTINUE
      JBUF(10)=0
      JBUF(11)=0
      GO TO 1300
C 
C     CHECK IF ASCII
C 
 1208 IF(ITEMP.EQ.3) GO TO 1210 
      CALL ACERR(-206)
      GO TO 1200
C 
C     MOVE HELLO FILE NAMR
C 
 1210 I=1 
      DO 1220 KNDX=7,9
      JBUF(KNDX)=JPBUF(I) 
      I=I+1 
 1220 CONTINUE
      JBUF(10)=JPBUF(5) 
      JBUF(11)=JPBUF(6) 
C 
C     PROMPT FOR USER CAPABILITY
C 
 1300 CALL ACPRM(MSCAP,8) 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT CAPABILITY TO 30)
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(ITEMP.NE.0) GO TO 1305 
      JBUF(22)=30 
      GO TO 1400
C 
C     CHECK IF INTEGER, 1-63
C 
 1305 IF(ITEMP.EQ.1) GO TO 1320 
 1310 CALL ACERR(-207)
      GO TO 1300
 1320 IF(JPBUF(1).LE.0.OR.JPBUF(1).GT.MAXCAP) GO TO 1310
C 
C     MOVE CAPABILITY 
C 
      JBUF(22)=JPBUF(1) 
C 
C     PROMPT FOR MAXIMUM DISC CARTRIDGES
C 
 1400 CALL ACPRM(MSMXD,12)
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT LIMIT TO 2)
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(ITEMP.NE.0) GO TO 1405 
      JBUF(31)=2
      GO TO 1450
C 
C     CHECK FOR INTEGER BETWEEN 0 AND 60
C 
 1405 IF(ITEMP.EQ.1) GO TO 1420 
 1410 CALL ACERR(-208)
      GO TO 1400
 1420 IF((JPBUF(1).GT.60).OR.(JPBUF(1).LT.0)) GO TO 1410
      JBUF(31)=JPBUF(1) 
C 
C     ZERO OUT LAST LOG-ON, CUMULATIVE TIME, CPU TIME 
C 
 1450 DO 1460 I=23,28 
      JBUF(I)=0 
 1460 CONTINUE
C 
C     PROMPT FOR USER SST DEFINITION
C 
      ICL=29
      KNDX=33 
 1500 CALL ACPRM(MSSST,ICL) 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO END SST DEFINITION 
C 
      IF(JPBUF(1).EQ.2H/E) GO TO 1600 
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT TO NO USER SST)
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(KNDX.NE.33) GO TO 1510 
      IF(ITEMP.EQ.0) GO TO 1600 
C 
C     READ, PARSE AND VALIDATE SST ENTRY
C     SYSTEM LU MUST BE NUMERIC, 0-254
C     SESSION LU MUST BE NUMERIC, 4-63
C 
 1510 IF(ITEMP.NE.1) GO TO 1540 
      ISES=JPBUF(1) 
C 
C     PARSE THE SYSTEM LU 
C 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
      ISYS=JPBUF(1) 
      IF((ISYS.LT.0).OR.(ISYS.GT.254)) GO TO 1540 
      IF(IAND(JPBUF(4),3).NE.1) GO TO 1540
      IF((ISES.LT.4).OR.(ISES.GT.63)) GO TO 1540
C 
C     CHECK IF SESSION LU HAS ALREADY BEEN DEFINED
C 
      IF(KNDX.EQ.33) GO TO 1530 
      DO 1520 I=34,KNDX 
      ITEMP=IAND(JBUF(I),255)+1 
      IF(ITEMP.EQ.ISES) GO TO 1540
 1520 CONTINUE
 1530 KNDX=KNDX+1 
      JBUF(KNDX)=(IAND(255,ISYS-1)*256)+ISES-1
      ICL=8 
      GO TO 1500
 1540 CALL ACERR(-209)
      ICL=8 
      GO TO 1500
C 
C     SAVE INDEX FOR END OF USER SST
C 
1600  KNDXSV=KNDX 
C 
C     PROMPT FOR SST SPARES 
C 
 1605 CALL ACPRM(MSSPR,11)
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A.OR.JPBUF(1).EQ.2H/E) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT TO 5)
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(ITEMP.LE.1) GO TO 1620 
 1610 CALL ACERR(-212)
      GO TO 1605
 1620 IF(ITEMP.EQ.0) JPBUF(1)=5 
      IF((JPBUF(1).LT.0).OR.(JPBUF(1).GT.60)) GO TO 1610
      ISPAR=JPBUF(1)
      IF(ISPAR+KNDX.GT.100) GO TO 1610
C 
C     PROMPT FOR LINK TO EXISTING ACCOUNT 
C 
 1700 CALL ACPRM(MSLNK,32)
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 
C 
C     CHECK FOR ERROR 
C 
      IF(IERR.EQ.0) GO TO 1704
      CALL ACERR(-203)
      GO TO 1700
C 
C     CHECK FOR NULL OR BLANK (DEFAULT TO N), OR N
C 
 1704 IF(JPBUF(1).EQ.0) GO TO 1780
C 
C     NAME MUST BE IN USER.GROUP FORMAT 
C 
      IF(IAND(JPBUF(1),255).NE.0) GO TO 1720
 1710 CALL ACERR(-203)
      GO TO 1700
C 
C     CHECK IF USER.GROUP ACCOUNT EXISTS
C 
 1720 CALL ACGTU(JPBUF(2),JPBUF(7),NBUF,IOFST,IERR) 
      IF(IERR.EQ.0) GO TO 1725
      CALL ACERR(-200)
      GO TO 1700
C 
C     CHECK THE PASSWORD (SKIP IF NO PASSWORD)
 1725 ITEMP=IAND(NBUF(IOFST+1),77777B)
      IF(ITEMP.EQ.0) GO TO 1750 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
      DO 1730 I=2,6 
      IF(JPBUF(I).NE.NBUF(IOFST+I)) GO TO 1740
 1730 CONTINUE
      GO TO 1750
 1740 CALL ACERR(-204)
      GO TO 1700
C 
C     GET THE USER ID FROM THE ACCOUNT ENTRY
C 
 1750 ID=NBUF(IOFST+29) 
      IF(ID.GE.7776B) GO TO 1710
      GO TO 1790
C 
C     GET A USER ID 
C 
 1780 CALL ACGID(1,ID,IERR) 
      IF(IERR.NE.-2) GO TO 1790 
      CALL ACERR(-211)
      RETURN
 1790 JBUF(29)=ID 
C 
C     GET GROUP ACCOUNT RECORD NUMBER 
C 
 1800 IUSER(1)=0
      CALL ACFDA(IUSER,IPBUF(7),IDMY,IDMY,IRECG,IERR) 
      IOFST=IRECG(2)
      CALL READF(NDCB,IERR,NBUF,128,LEN,IRECG)
C 
C     MERGE IN THE GROUP SST
C 
      IGLEN=0 
C 
C     CHECK IF GROUP SST IS TO BE USED
C 
      IF(JBUF(33).EQ.0) GO TO 1890
      ICNT=IABS(NBUF(IOFST+6))
C 
C     CHECK FOR EMPTY GROUP SST 
C 
      IF(ICNT.LE.0.OR.ICNT.GT.64) GO TO 1890
      K=IOFST+6 
C 
C     VALIDATE EACH GROUP SST ENTRY 
C 
      DO 1880 I=1,ICNT
      ITEMP=IAND(NBUF(I+K),255) 
C 
C     CHECK FOR CONFLICTS OR DUPLICATE SST DEFINITIONS
C 
      IF(KNDX.LT.34) GO TO 1865 
      DO 1860 J=34,KNDX 
      ISES=IAND(JBUF(J),255)
      IF(ITEMP.NE.ISES) GO TO 1860
C 
C     FOUND MATCHING SESSION LU - IF DUPLICATE DEFINITION 
C     IGNORE IT, ELSE REPORT SST CONFLICT 
C 
      IF(JBUF(J).EQ.NBUF(I+K)) GO TO 1880 
      GO TO 1870
 1860 CONTINUE
C 
C     MOVE GROUP SST ENTRY TO USER
C 
 1865 KNDX=KNDX+1 
      JBUF(KNDX)=NBUF(I+K)
      IGLEN=IGLEN+1 
      GO TO 1880
C 
C     CONFLICT BETWEEN USER AND GROUP SST DEFINITION
C 
 1870 CALL ACERR(-210)
C 
C     PRINT THE CONFLICTING LU DEFINITIONS
C 
      ISYSG=(NBUF(I+K)/256)+1 
      ISYSU=(JBUF(J)/256)+1 
      CALL ACITA(ISES+1,LUMS2(7),2) 
      CALL ACITA(ISYSU,LUMS2(13),2) 
      CALL ACITA(ISYSG,LUMS2(30),2) 
      LUMS2(24)=LUMS2(7)
      LUMS2(25)=LUMS2(8)
      CALL ACWRI(LUMS1,27)
      CALL ACWRI(LUMS2,31)
 1880 CONTINUE
C 
C     POST THE GROUP ID 
C 
1890  JBUF(30)=IAND(NBUF(IOFST+1),77777B) 
C 
C     WRITE SST LENGTH WORDS
C 
      JBUF(32)=(IGLEN*256)+ISPAR
      JBUF(33)=IOR(JBUF(33),KNDX-33)
C 
C     SET BIT INDICATING ACCOUNT EXTENDS PAST 64 WORDS
C 
      CALL RNRQ(1,IRN,ISTAT)
      IF(KNDX.LE.64) GO TO 1930 
      JBUF(1)=IOR(JBUF(1),100000B)
C 
C     FIND A FREE ACCOUNT ENTRY 
C 
      CALL ACFDF(IDIRN,IRECN,IOFST,IERR,2)
      IF(IERR.EQ.0) GO TO 1895
 1892 CALL ACERR(IERR)
      CALL RNRQ(4,IRN,ISTAT)
      RETURN
C 
C     BUILD THE DIRECTORY ENTRY 
C 
 1895 CALL ACPGA(-2,IDIRN,0)
C 
C     COPY SECOND PART INTO ACCOUNT ENTRY 
C 
      CALL READF(NDCB,IERR,NBUF,128,LEN,IRECN)
      DO 1920 I=1,33
      NBUF(I+IOFST)=JBUF(63+I)
 1920 CONTINUE
      CALL WRITF(NDCB,IERR,NBUF,128,IRECN)
C 
C     SET JBUF(64)= RECORD NUMBER OF SECOND PART
C 
      IF(IOFST.NE.0) IRECN=IRECN+100000B
      JBUF(64)=IRECN
C 
C     FIND A FREE ACCOUNT ENTRY 
C 
 1930 CALL ACFDF(IDIRN,IRECN,IOFST,IERR,1)
      IF(IERR.NE.0) GO TO 1892
C 
C     GENERATE MESSAGE FILE NAME
C 
      CALL ACMSN(IDIRN,JBUF(17))
C 
C     BUILD THE DIRECTORY ENTRY 
C 
 1900 DO 2000 I=1,11
      IBUF(I)=IPBUF(I)
 2000 CONTINUE
      IBUF(12)=ID 
      IBUF(13)=JBUF(30) 
      IBUF(14)=IRECG(1) 
      IF(IRECG(2).GT.0) IBUF(14)=IOR(IBUF(14),100000B)
      IBUF(15)=IRECN
      IF(IOFST.GT.0) IBUF(15)=IOR(IRECN,100000B)
      IBUF(16)=0
      CALL ACDIR(2,IDIRN,IBUF,IERR) 
C 
C     BUILD THE USER ACCOUNT ENTRY
C 
      CALL READF(NDCB,IERR,NBUF,128,LEN,IRECN)
      DO 2200 I=1,64
      NBUF(I+IOFST)=JBUF(I) 
 2200 CONTINUE
      CALL WRITF(NDCB,IERR,NBUF,128,IRECN)
      CALL RNRQ(4,IRN,ISTAT)
C 
C     MORE GROUPS?
C 
 2250 CALL ACPRM(MSGNX,9) 
C 
C     READ AND PARSE THE NEXT GROUP NAME
C 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND OR EXIT GROUP DEFINITION 
C     ALSO CHECK FOR NULL OR BLANK
C 
      IF((JPBUF(2).EQ.2H/A).OR.(JPBUF(2).EQ.2H/E)) RETURN 
C 
C     IF NAME IS INVALID, REPORT ACERR AND RE-PROMPT
C     NAME CANNOT BE IN USER.GROUP FORMAT AND CANNOT BE "@" 
C 
      IF(IERR.NE.0) GO TO 2300
      IF(IAND(JPBUF(1),255).NE.0) GO TO 2300
      IF(JPBUF(2).NE.2H@ ) GO TO 2400 
 2300 CALL ACERR(-203)
      GO TO 2250
C 
C     IF NO GROUP SPECIFIED, DEFAULT TO GENERAL 
C 
 2400 IF(JPBUF(1).NE.0) GO TO 2500
      JPBUF(1)=3400B
      JPBUF(2)=2HGE 
      JPBUF(3)=2HNE 
      JPBUF(4)=2HRA 
      JPBUF(5)=2HL
C 
C     CHECK THAT GROUP ACCOUNT EXISTS 
C 
 2500 IUSER(1)=0
      CALL ACFDA(IUSER,JPBUF(2),IDMY,IDMY,IDMY,IERR)
      IF(IERR.EQ.0) GO TO 2600
      CALL ACERR(-200)
      GO TO 2250
C 
C     CHECK IF USER.GROUP ACCOUNT ALREADY EXISTS
C 
 2600 CALL ACFDA(IPBUF(2),JPBUF(2),IDMY,IDMY,IDMY,IERR) 
      IF(IERR.EQ.-200) GO TO 2700 
      CALL ACERR(-202)
      GO TO 2250
C 
C     SAVE GROUP INFORMATION (LENGTH OF NAME, NAME) 
C 
 2700 DO 2800 I=2,6 
      IPBUF(I+5)=JPBUF(I) 
 2800 CONTINUE
      IPBUF(1)=IAND(IPBUF(1),177400B)+(JPBUF(1)/256)
C 
C     PROMPT FOR WHETHER TO USE GROUP SST 
C 
      CALL ACPRM(MSGST,12)
C 
C     READ AND PARSE FOR Y OR N 
C 
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 
C 
C     SET SIGN BIT IF Y OR NULL TO INDICATE USE GROUP SST 
C 
      JBUF(33)=0
      ITEMP=JPBUF(2)/256
      IF((ITEMP.EQ.131B).OR.(JPBUF(1).EQ.0))
     1    JBUF(33)=100000B
C 
C     RESET KNDX TO COPY USER SST ONLY
C 
      KNDX=KNDXSV 
      GO TO 1800
      END