C				LABIN.FTN
C
C  A PROGRAM TO PICK UP ADDRESSES AND STORE IN A DATA FILE
C
	BYTE	NAME(84)
	BYTE	TNAME(10)
	INTEGER	COUN		! IF A BIT IN THIS WORD IS SET, MEM OF COUNCIL
	INTEGER	NAR,BEG,DIR		! RECORD NUMBER TO WRITE TO
	INTEGER	ENDS			! END OF SORTED PORTION
	INTEGER	POSI		! FUNCTION INDICATING POSITION OF ST
	INTEGER	ACT		! ACTION TO TAKE (1 TO ADD NEW ADR, ETC
	INTEGER	DAYS		! SUBROUTINE TO CALCULATE DAY
      INTEGER BITTER            ! FUNCTION TO SEE IF BIT IS SET
      INTEGER SEQ               ! = 1 IF SEARCH SEQUENTIALLY
	INTEGER	DAY
C	COMMON	NAME
	EQUIVALENCE (NAME(81),COUN),(NAME(79),DAY)
	CALL ATTACH
	BEG=3
	CALL ASSIGN(2,'LABEL.DAT;1')
	DEFINE FILE 2(32000,42,U,NXT)
	CALL FDBSET(2,'OLD','SHARE')
10	FORMAT(I6)
	READ(2'1)NAR,ENDS, NLIST
100	WRITE(5,110)
110	FORMAT(' Enter 1 to add new addresses, 2 to make changes',/,
     1 '$3 Delete all before given date, 4 Change no. of lists.:  ')
	READ(5,10)ACT
	IF(ACT.LT.1) GO TO 900
	IF(ACT.GT.4) GO TO 100
	GO TO(130,200,400, 460)ACT
130	CALL ERASA
	CALL CUR(3,5)
	WRITE(5,135)
135	FORMAT('+PLACE NAME AND ADDRESS BELOW')
140	I=NAR
	CALL LOA(NAME,84,"40)		! LOAD NAME WITH BLANKS
	DAY=DAYS(NXT,J,K,1)		! GET TODAY'S DAY
	NAME(76)=0
	NAME(77)=0
	CALL BLDDIS(NAME,NXT, NLIST)	! BUILD THE DISPLAY
	CALL GETCHA(NAME,NXT, NLIST)	! GET THE NAME AND ADDRESS
	CALL TERDIS(NAME,NXT)		! TEAR IT DOWN (PLACE INFOR
	IF(NAME(1).LE."40)GO TO 900	! THEY WANT TO QUIT
	WRITE(2'I)NAME			! AND STORE INFORMATION
	READ(2'1)NAR,ENDS, NLIST
	NAR=NAR+1
	WRITE(2'1)NAR,ENDS, NLIST
	GO TO 140
C
C  COME HERE TO MAKE CHANGES
C
200	CALL LOA(TNAME,10,0)		! LOAD TNAME WITH NULLS
	SEQ=0
	WRITE(5,260)
260	FORMAT(/,'$ENTER NAME TO CHANGE OR DELETE  ')
	CALL GETF(TNAME,10)
	IF(TNAME(1).LE."4)GO TO 900
	J=NAR-1			! CHANGE NAR TO LAST RECORD
	CALL SPIT(TNAME,3,J,I,DIR,ENDS)
	READ(2'I)NAME
	IF(DIR.EQ.1)GO TO 323	! FOUND A NAME, GET CHANGES
	WRITE(5,265)
265	FORMAT('$ENTER 1 TO SEARCH SEQUENTIALLY:  ')
	READ(5,10)SEQ
	IF(SEQ.NE.1)GO TO 200
270	DO 280 I=2,NAR-1	! SEARCH SEQUENTIALLY FOR NAME
	READ(2'I)NAME
	IF(NAME(1).EQ."71)GO TO 280	! THIS NAME HAS BEEN DELETED
	J=POSI(NAME,TNAME,1,70)
	IF((J.GE.1).AND.(J.LE.70))GO TO 290	! FOUND THE NAME
280	CONTINUE
	WRITE(5,282)
282	FORMAT(' FAILED TO FIND')
	GO TO 200
C
C  FOUND A NAME WHILE SEARCHING SEQUENTIALLY
C
290	WRITE(5,292)I,POSI(NAME,TNAME,1,10),(NAME(J),J=1,75)
292	FORMAT(' THIS NAME WAS FOUND IN REC',I4,' IN POSITION'
	1,I4,' WITHIN THE ADDRESS'/1X,75A1)
	WRITE(5,322)
322	FORMAT('$IF THIS IS THE ADDRESS YOU WANT, ENTER 1, IF NOT HIT
	1 ENTER:  ')
	READ(5,10)J
	IF(J.NE.1)GO TO 280
	CALL ERASA
C
C  HERE IS WHERE WE ACTUALLY MAKE THE CHANGES
C
323	CALL BLDDIS(NAME,NXT, NLIST)
	CALL GETCHA(NAME,NXT, NLIST)
	CALL TERDIS(NAME,NXT)
	WRITE(2'I)NAME			! STORE THE CHANGES
	GO TO 200
C
C  DELETE ALL BEFORE A GIVEN DATE
C
400   SEQ=DAYS(I,J,K,1)                ! SEQ IS TODAYS DATE
      WRITE(5,410)
410   FORMAT('$WHAT IS THE CUT OFF DATE:  ')
      CALL INDAY(ENDS)                 ! ENDS IS THE CUT OFF DATE
      IF(ENDS.NE.0)GO TO 430            ! THEY ACTUALLY GAVE A DATE
      WRITE(5,420)
420   FORMAT(' NO NAMES ARE DELETED.')
      GO TO 900
430   DO 450 I=2,NAR-1
      READ(2'I)NAME
C
C  THE FOLLOWING LINE ELIMINATES CHECKING ON LIST #2 SO THAT IF THE
C  PERSON IS ON THIS LIST, HE IS LEFT IN THE FILE.  TEMPORARILY DELETED
C     IF(BITTER(COUN,3,3).EQ.1)GO TO 450 ! IF ON AMER COUN, DON'T CHECK
      IF(DAY.LT.ENDS)GO TO 435         ! DAY STORED IS TO EARLY
      IF(DAY.LE.SEQ)GO TO 450          ! DAY STORED IS < OR= TODAY
435   NAME(1)="71                      ! DELETE THE NAME
      WRITE(2'I)NAME                   ! STORE THIS FACT BACK ON DISK
450   CONTINUE
      GO TO 900
C
C  CHANGE THE NUMBER OF MAILING LISTS
C
460   READ(2'1)NAR,ENDS,NLIST
      WRITE(5,470)NLIST
470   FORMAT('$NUMBER OF LISTS IS NOW',I5,' TO CHANGE, ENTER DESIRED
     1 NUMBER: ')
      READ(5,10)I
      IF(I.GT.0)NLIST=I
      WRITE(2'1)NAR,ENDS,NLIST
900	CALL CLOSE(2)
	CALL DETACH
	CALL EXIT
	END