C..WPACNT.FTN   BOHDEN K. CMAYLO    NOV 1981 
C..
C..  ROUTINE LISTS, ADDS, DELETES WP: ACCOUNTS
C..
	BYTE INPUT(80),INX(50),LINX(5),INXX(80,40)
	BYTE INBRAC(3),IPBRAC(4),IUBRAC(5),IMBRAC(3),IBRAC(2),ICOMMA
	EQUIVALENCE (XINPUT,INPUT)
	DATA INBRAC/'<','N','>'/
	DATA IPBRAC/'<','P','W','>'/
	DATA IUBRAC/'<','U','I','D','>'/
	DATA IMBRAC/'<','M','>'/
	DATA IBRAC/'<','>'/
	DATA ICOMMA/','/
	NODEL=0
106	TYPE 100
100	FORMAT('0 *** WPACNT ***'//'$* ENTER OPTION: ')
	ACCEPT 101,IQ,(INPUT(I),I=1,IQ)
101	FORMAT(Q,80A1)
	CALL CAPS(INPUT,IQ)
	IF(XINPUT.EQ.'NAME') GO TO 10
	IF(XINPUT.EQ.'UIC:') GO TO 20
	IF(XINPUT.EQ.'UID:') GO TO 25
	IF(XINPUT.EQ.'ADD:') GO TO 30
	IF(XINPUT.EQ.'DELE') GO TO 40
107	TYPE 102,(INPUT(I),I=1,IQ)
102	FORMAT('0*** INVALID OPTION: ',80A1)
	TYPE 105
105	FORMAT(//'  OPTIONS ARE:'//
     1 '  NAME:xxxxxx        list of accounts with name xxxxxx'//
     2 '  UIC:[nnn,nnn]      list of accounts with UICs nnn,sss'//
     2 '  UID:nnn            list of accounts with UID of nnn'//
     3 '  ADD:               add an account'//
     4 '  DELETE:xxxxxx      delete account with name xxxxxx'//)
	GO TO 106
C.. SET NAME OPTION
10	CONTINUE
	IOP=1
	ISTART=6
41	LAST=IQ-ISTART+1
	IF(LAST.LE.0) GO TO 107
	LIN=3
	CALL BYTEDO(LINX,LINX(LIN),INBRAC)
	GO TO 21
C..	SET UP UIC 
20	CONTINUE
	IOP=2
	ISTART=5
	LAST=IQ-ISTART+1
	IF(LAST.LE.0) GO TO 107
	LIN=3
	CALL BYTEDO(LINX,LINX(LIN),IMBRAC)
	GO TO 21
C..	SET UP UID 
25	CONTINUE
	IOP=1
	ISTART=5
	LAST=IQ-ISTART+1
	IF(LAST.LE.0) GO TO 107
	LIN=5
	CALL BYTEDO(LINX,LINX(LIN),IUBRAC)
21	CALL BYTEDO(INX,INX(LAST),INPUT(ISTART))
	GO TO 50
C..  SET UP ADD OPTION
30	IOP=3
	GO TO 50
C..  SET UP DELETE OPTION, BY NAME
40	IOP=4
	ISTART=8
	IF(INPUT(5).EQ.'T'.AND.INPUT(6).EQ.'E'.AND.INPUT(7).EQ.':')
     1 GO TO 41
	GO TO 107
C.. ASSIGN DATA FILE
50	CONTINUE
	CALL XSPAWN('DXF WPACNT.DAT/TYPE:TE:SPACES=LB:[201,201]DOC002.
     1 W11/TYPE:DOC!')
	IN=1
	IF(IOP.LE.2.OR.IOP.EQ.4) CALL FDBSET(IN,'OLD')
	IOUT=2
	IF(IOP.EQ.4) OPEN
     1 (UNIT=IOUT,NAME='WPACNT.NEW',CARRIAGECONTROL='LIST',TYPE='NEW')
	IF(IOP.EQ.3) CALL FDBSET(IN,'APPEND')
	CALL ASSIGN(IN,'WPACNT.DAT')
	IF(IOP.EQ.3) GO TO 32
C.. READ DATA AND SEE IF MATCHES  (SAVE UP TO LAST '<>')
59	INREAD=0
	IPRINT=0
51	INREAD=INREAD+1
	READ(IN,101,END=99)IQ,(INXX(I+1,INREAD),I=1,IQ)
	CALL CAPS(INXX(2,INREAD),IQ)
	INXX(1,INREAD)=IQ
C..	CHECK FOR <> FOR END OF GROUP
	IF(INXX(2,INREAD).EQ.IBRAC(1).AND.INXX(3,INREAD).EQ.IBRAC(2))
     1 GO TO 58
C..  CHECK FOR OPTION
	IF(IOP.EQ.2.AND.INXX(2,INREAD).EQ.ICOMMA) GO TO 60
	DO 54 I=1,LIN
	IF(LINX(I).NE.INXX(I+1,INREAD)) GO TO 51
54	CONTINUE
C..  FOUND TYPE, CHECK VALUE
60	CONTINUE
	CALL STRCHK(INX,LAST,INXX(2,INREAD),IQ,IOK)
	IF(IOK.EQ.0) GO TO 51
C..  FOUND, PRINT OR SET UP DELETE GROUP
	IPRINT=1
	GO TO 51
C.. PRINT IF FOUND
58	CONTINUE
	IF(IPRINT.LE.0) GO TO 61
	DO 56 I=1,INREAD
	IQ=INXX(1,I)
	TYPE 57,(INXX(J+1,I),J=1,IQ)
57	FORMAT(' : ',80A1)
56	CONTINUE
	IF(IOP.NE.4) GO TO 59
C.. SEE IF GROUP TO DELETE
	TYPE 103
103	FORMAT(/'$ DELETE ABOVE GROUP (Y/N): ')
	ACCEPT 101,IQ,INPUT(1)
	NODEL=NODEL+1
	IF(INPUT(1).EQ.'Y'.OR.INPUT(1).EQ.'y') GO TO 59
	NODEL=NODEL-1
61	CONTINUE
	IF(IOP.NE.4) GO TO 59
	DO 44 I=1,INREAD
	IQ=INXX(1,I)
	WRITE(IOUT,301)(INXX(J+1,I),J=1,IQ)
44	CONTINUE
	GO TO 59
C..
C..   EOF SECTION 
C..
99	CONTINUE
	CALL CLOSE(IN)
	IF(IOP.EQ.3) CALL XSPAWN
     1 ('DXF LB:[201,201]DOC002.W11/TYPE:DOC=WPACNT.DAT/TYPE:TE:CP!')
	IF(IOP.NE.4) GO TO 64
	ENDFILE IOUT
	CLOSE(UNIT=IOUT)
	IF(NODEL.GT.0) CALL XSPAWN
     1 ('DXF LB:[201,201]DOC002.W11/TYPE:DOC=WPACNT.NEW/TYPE:TE:CP!')
	CALL XSPAWN('PIP WPACNT.NEW;*/DE/NM!')
64	CALL XSPAWN('PIP WPACNT.DAT;*/DE/NM!')
	CALL EXIT
C..	ADD SECTION
32	CONTINUE
	TYPE 201,INBRAC
201	FORMAT(/'$',80A1)
	ACCEPT 101,IQ,(INPUT(I),I=1,IQ)
	INPUT(IQ+1)=' '
	IQ=IQ+1
	WRITE(IN,301)IBRAC
301	FORMAT(80A1)
	WRITE(IN,301)INBRAC,(INPUT(I),I=1,IQ)
	TYPE 201,IUBRAC
	ACCEPT 101,IQ,(INPUT(I),I=1,IQ)
	WRITE(IN,301)IUBRAC,(INPUT(I),I=1,IQ)
	INM=0
31	INM=INM+1
	TYPE 201,IMBRAC
	ACCEPT 101,IQ,(INPUT(I),I=1,IQ)
	IF(IQ.LE.0) GO TO 34
	IF(INM.EQ.1) WRITE(IN,301)IMBRAC,(INPUT(I),I=1,IQ)
	IF(INM.GT.1) WRITE(IN,301)ICOMMA,(INPUT(I),I=1,IQ)
	GO TO 31
34	CONTINUE
	TYPE 201,IPBRAC
	ACCEPT 101,IQ,(INPUT(I),I=1,IQ)
	WRITE(IN,301)IPBRAC,(INPUT(I),I=1,IQ)
	WRITE(IN,301)IBRAC
	GO TO 99
	END