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