perm filename LISTUP.SAI[MNT,CSR] blob
sn#233860 filedate 1976-08-31 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00013 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 The DECLARATIONS
C00005 00003 The THEBOS procedure
C00007 00004 the CHAG porcedure
C00012 00005 more adds
C00019 00006 The MODIFY procedure
C00023 00007 more modify Procedure
C00034 00008 the ETV procedure
C00039 00009 The DELETE procedure
C00044 00010 the HASHER procedure
C00046 00011 The HELPAD procedure
C00054 00012 more help
C00059 00013 The MAIN body of the address file maintainence
C00061 ENDMK
C⊗;
COMMENT The DECLARATIONS;
ENTRY;
BEGIN
INTERNAL PROCEDURE LISTUP;
BEGIN "ADDRESSFILE"
COMMENT This program is designed to insert, delete, and modify
entries of the address file. The program is organized
procedurally by function, and is intended to be used
interactively.
The file is maintained on disk, and is called ADDFIL.DSK[ L,WTC]
It is maintained in E format, and therefore can be edited with
the ETv text editor. The user is cautioned that the file is
referenced using HASH and statistical data from the lead code
line and any manual editing with E could cause address errors
if it is not done properly;
REQUIRE "⊂⊃" DELIMITERS;
DEFINE CRLF=⊂ '15 & '12 ⊃;
DEFINE PRT=⊂PRINT(CRLF⊃;
DEFINE INSERT=⊂PTOSTR(PL,ESTRING); ESTRING←'175; PTOSTR(PL,ESTRING);
STT←PTYIN(PL,11,BRCHAR); PTOSTR(PL,"1D"); STT←PTYIN(PL,4,BRCHAR);
JK←PTYALL(PL);⊃;
COMMENT Obtain a pseudo teletype to use when writting on
the address file;
DEFINE ETVIN=⊂PL←PTYGET;
PTOSTR(PL,"L USE.CSR"&'15&'12);
STT←PTYIN(PL,5,BRCHAR);
I←'4226000000; PTYSTL(PL,I);⊃;
DEFINE ETVOUT=⊂PTOSTR(PL,"K"&'15&'12);
STT←PTYIN(PL,12,BRCHAR);⊃;
INTEGER NUMB,HELP,IT,I,J,K,ENTRY;
BOOLEAN THRU,CHANGE,TESTIT,COMPLETE;
STRING RECORD,ESTRING,NUMBERS,EX,CKHASH,JK;
EXTERNAL INTEGER C1,C2,C3,C4,PL,COUNT,DSKCT,BRCHAR,NUMBER,JMP,REC,PG,NOW,UPDATES;
EXTERNAL BOOLEAN EOF,EF1,FLAG,UP;
EXTERNAL STRING TYPEIN,STT,PAGE,LINE,HEADER,HASH;
EXTERNAL STRING ARRAY ADDRESS[0:5],HASHTB[1:NUMBER+2];
EXTERNAL PROCEDURE BILOOK;
EXTERNAL PROCEDURE SEARCH;
EXTERNAL PROCEDURE SHELST;
EXTERNAL PROCEDURE FINDER;
FORWARD PROCEDURE CHAG;
FORWARD SIMPLE PROCEDURE DELIT;
FORWARD SIMPLE PROCEDURE HELPAD;
FORWARD SIMPLE PROCEDURE HASHER;
COMMENT The THEBOS procedure;
INTERNAL SIMPLE PROCEDURE THEBOS;
COMMENT THEBOS is the traffic cop. He interprets requests for file
update desired and calls the processors. This is accomplished
within a loop which is ended when the user is done at which time
the program will reformat the file and exit;
BEGIN "THEBOS"
DEFINE XXX=⊂ THEN BEGIN TT←1; ⊃;
INTEGER TT;
THRU←FALSE;
WHILE NOT THRU DO
BEGIN
COMMENT TESTIT is used to determine of MOD is being called from ADD
CHANGE notifies if an update has been made;
CHANGE←FALSE;
PRINT(CRLF,"LISTUP - Function or <cr> to exit *");
CLRBUF;TYPEIN←TTYINL(1,BRCHAR);
I←0;
TESTIT←FALSE;
TT←0;
HELP←0;
DO I←I+1 UNTIL NOT EQU(TYPEIN[I TO I]," ");
IF EQU(TYPEIN[I TO I],'15) XXX THRU←TRUE; END;
IF EQU(TYPEIN[I TO I],"H") XXX HELP←1; HELPAD; END;
IF EQU(TYPEIN[I TO I+2],"ADD") XXX CHAG; END;
IF EQU(TYPEIN[I TO I+2],"MOD") XXX CHAG; END;
IF EQU(TYPEIN[I TO I+2],"DEL") XXX DELIT; END;
IF TT=0 THEN BEGIN HELP←5; HELPAD; END;
IF CHANGE THEN PRINT(CRLF,"The file update has been made");
END;
END "THEBOS";
COMMENT the CHAG porcedure;
PROCEDURE CHAG;
BEGIN
COMMENT this procedure is used so that all of the adds and mods to the
address file can be made iteratively, and the processing done
all at once. This should allow the operator to process changes
in a rapid manner;
BOOLEAN AMOK;
INTEGER CGS;
STRING JMPG,HEADS;
STRING ARRAY LINES[0:5];
FORWARD SIMPLE PROCEDURE MODIFY;
SIMPLE PROCEDURE ADDNEW;
COMMENT This procedure ADDS a new entry to the address file either on
the first page that is not full, or at the end;
BEGIN "ADDNEW"
STRING ZIP,CAT,SAVE,HASHED,FILESV;
BOOLEAN OK,LOOKING,LOOK,ALOOK;
IF EQU(TYPEIN[LENGTH(TYPEIN)-4 TO LENGTH(TYPEIN)-1],"HELP") THEN
BEGIN
HELP←2; HELPAD;
RETURN;
END ELSE
BEGIN
ALOOK←OK←TRUE;
COMMENT This while loop will attempt to build up the entry for the
addressee to be added to the file. If an error is encountered
on input the procedure will be terminated and control passed
back to THEBOS.
When the entry is composed control will be transfered to MODIFY
so that the new entry can be displayed, changed if necessary,
and entered into the file;
WHILE OK DO
BEGIN "AD"
PRINT(CRLF,"TYPE IN THE FIRST LINE (THE NAME) OF THIS ENTRY OR <cr> TO EXIT",
CRLF,"*");
CLRBUF; ADDRESS[1]←TTYINL(1,BRCHAR);
IF EQU(ADDRESS[1][1 TO 1],'15) THEN RETURN;
IF (ADDRESS[1][1 TO 1]<'101) OR (ADDRESS[1][ 1 TO 1]>'173) THEN
BEGIN
PRINT("THE NAME IS TO BE ENTERED IN ANY FORMAT, STARTING WITH A LETTER.");
CONTINUE;
END;
COMMENT Determine the billing category;
WHILE ALOOK DO
BEGIN
PRINT(CRLF,"BILLING CATEGORY *");
CLRBUF; CAT←TTYINL(1,BRCHAR);
IF ((CAT[1 TO 1]='15) OR
(CAT[1 TO 2]='101&'15) OR
(CAT[1 TO 2]='106&'15) OR
(CAT[1 TO 2]='115&'15) OR
(CAT[1 TO 2]='116&'15)) THEN DONE ELSE
PRINT(CRLF,"THERE ARE FIVE BILLING CATEGORIES:",
CRLF,CRLF," <cr> NORMAL ENTRY",CRLF,
" N<cr> ONR LIST",CRLF,
" M<cr> ARPA LIST",CRLF,
" A<cr> AUTOMATIC LIST",CRLF,
" F<cr> FREE LIST",CRLF,CRLF);
END;
IF EQU(CAT[1 TO 1],'15) THEN CAT←" ";
COMMENT more adds
COMMENT Now the zip code or country code will be determined;
IF EQU(CAT[1 TO 1],"N") THEN ZIP←"ONRXX";
IF EQU(CAT[1 TO 1],"M") THEN ZIP←"DARPA";
IF EQU(CAT[1 TO 1],"A") THEN ZIP←"AUTOM";
IF EQU(CAT[1 TO 1],"F") OR EQU(CAT[1 TO 1]," ") THEN
WHILE ALOOK DO
BEGIN
PRINT(CRLF,"ZIP CODE, OR COUNTRY *");
CLRBUF; ZIP←TTYINL(1,BRCHAR);
IF EQU(ZIP[1 TO 4],"HELP") OR
EQU(ZIP[1 TO 1]," ") OR
((LENGTH(ZIP)<6) AND (NOT EQU(ZIP[1 TO 1],"U"))) OR
EQU(ZIP[1 TO 1],'15) OR
EQU(ZIP[1 TO 1],"?") THEN
BEGIN
PRINT(CRLF,"THERE ARE FOUR OPTION TYPED AS FOLLOWS",CRLF,CRLF,
" #####<cr> US ZIP CODE NNNNN",CRLF,
" FFFFF<cr> NAME OF FOREIGN COUNTRY(NOT USSR)",CRLF,
" USSR<cr> RUSSIAN",CRLF,
" IDMAI<cr> INTER-DEPARTMENTAL MAIL");
END ELSE DONE
END;
PRINT(" Please don't reenter the zip with the address",CRLF);
PRINT(" Be sure to enter the zip for DARPA, ONR or AUTO",CRLF);
IF EQU(ZIP[LENGTH(ZIP) TO LENGTH(ZIP)],'15) THEN ZIP←ZIP[1 TO LENGTH(ZIP)-1];
ZIP←ZIP&" ";
COMMENT The following code will assemble the lead address line, and
the HASH CODE. the HASH is formed as follows:
NNNLL --- NNN are the first three NUMBERs of the
zip code for the users in the United States.
or the first three letters of a foreign country
LL Are two letters picked by progressing through
the alphabet until a combination is found that
is not a duplicate, starting values are the two
letters closets to 1/3 and 2/3 way through the
name line;
K←LENGTH(ADDRESS[1]); J←(K DIV 3); K←2*J;
WHILE ((ADDRESS[1][J TO J] <'101) OR (ADDRESS[1][J TO J]>'173))
AND (J>1) DO J←J-1;
WHILE ((ADDRESS[1][K TO K] <'101) OR (ADDRESS[1][K TO K]>'173))
AND NOT EQU(ADDRESS[1][K TO K],'15) DO K←K+1;
HASH←ZIP[1 TO 3]&ADDRESS[1][J TO J]&ADDRESS[1][K TO K];
IF CVO(ZIP[1 TO 1])>'71 THEN ZIP←" ";
ADDRESS[0]←"*"&CAT[1 TO 1]&ZIP[1 TO 5]&"|NNNNNNNNNNNN#";
COMMENT call hasher to insure a unique hash;
HASHER;
COMMENT The rest of the address will now be assembled;
ADDRESS[0]←ADDRESS[0]&HASH[1 TO 5]&"$000.00 "&'15;
FOR J←2 STEP 1 UNTIL 5 DO
BEGIN
PRINT(CRLF,"LINE ",J," *");
CLRBUF; ADDRESS[J]←TTYINL(1,BRCHAR);
IF EQU(ADDRESS[J][1 TO 1],"?") THEN
BEGIN
J←J-1;
PRINT(CRLF,"YOU ARE ALLOWED UP TO FIVE LINES FOR THE ADDRESS",CRLF,"LINE 1 IS THE NAME, THESE MAY BE IN ANY FORMAT.");
CONTINUE;
END;
END;
COMMENT The ADD Procedure will now exit to the MOD procedure
to check the input befor file update;
TESTIT←TRUE;
HASH←"#####";
MODIFY;
END "AD";
END;
END "ADDNEW";
COMMENT The MODIFY procedure;
SIMPLE PROCEDURE MODIFY;
COMMENT MODIFY does the actual modification of the address file
for both ADDS and MODS. It uses E to do all of the
writting on the file, any or all of the lines of the
address. no changes are made, however, until the user
approves the entire entry;
BEGIN "MOD"
INTEGER I1,I2,jc,TAME;
BOOLEAN SATISFIED,ENDFIL,LOOKING,LOOK,THEMOD;
STRING ZIP,SAVE,HASHED,FILESV,FILES,TYPEER;
THEMOD←TRUE;
WHILE THEMOD DO
BEGIN "THEMOD"
COMMENT testit will be false in the case of a modify, and this loop will get
the hash code, if testit is true it is an add and the address information
is already available from procedure ADD;
WHILE NOT TESTIT DO
BEGIN
IF EQU(TYPEIN[LENGTH(TYPEIN)-4 TO LENGTH(TYPEIN)-1],"HELP") THEN
BEGIN
HELP←3; HELPAD;
RETURN;
END;
PRINT(CRLF,"HASH CODE OR <cr> TO EXIT *");
CLRBUF; HASH←TTYINL(1,BRCHAR);
FOR I←1 STEP 1 UNTIL CGS DO
IF EQU(CKHASH[(I-1)*5+1 TO (I-1)*5+5],HASH[1 TO 5]) THEN
BEGIN
PRT,"An entry that has been updated cannot be chaged until",CRLF,
"the changes are made to the file.");
HASH←"?";
END;
IF EQU(HASH[1 TO 1],'15) THEN RETURN;
IF EQU(HASH[1 TO 1],"?") OR LENGTH(HASH)≠6 THEN
BEGIN
PRINT(CRLF,"Enter the five character HASH CODE if you know it, or",
CRLF,"ZZZZZ (any nonexistent hash to search the address file.");
CONTINUE;
END;
DONE;
END;
COMMENT find the entry and retiieve it, if the hashcode cannot be found
in the HASHTB then a search will be performed;
UP←FALSE;
BILOOK;
IF UP THEN
BEGIN
PRINT(CRLF,"SORRY - - HE'S NOT IN THE FILE"); SEARCH;
IF UP THEN CONTINUE;
END;
FINDER;
IF TESTIT THEN EX←ADDRESS[0][22 TO 26]&HASHTB[NOW][6 TO 15] ELSE EX←HASHTB[NOW];
TAME←NOW;
COMMENT WE NOW HAVE pg - page of entry
rec - record number of page
jmp - line of code line for addressee
header - page lead line
address[0,1,2,3,4,5] - address;
COMMENT more modify Procedure
This loop will execute until the user approves the modified
entry, or aborts the request;
SATISFIED←FALSE;
WHILE NOT SATISFIED DO
BEGIN "SAT"
PRINT(CRLF,"THE ENTRY YOU WISH TO CHANGE IS:");
SETFORMAT(1,1);
FOR J←0 STEP 1 UNTIL 5 DO
BEGIN
IF EQU(ADDRESS[J][LENGTH(ADDRESS[J]) TO LENGTH(ADDRESS[J])],'15) THEN
ADDRESS[J]←ADDRESS[J][1 TO LENGTH(ADDRESS[J])-1];
IF EQU(ADDRESS[J][LENGTH(ADDRESS[J]) TO LENGTH(ADDRESS[J])]," ") THEN
DO ADDRESS[J]←ADDRESS[J][1 TO LENGTH(ADDRESS[J])-1] UNTIL
NOT EQU(ADDRESS[J][LENGTH(ADDRESS[J]) TO LENGTH(ADDRESS[J])]," ");
PRINT(CRLF," LINE# ",J," ",ADDRESS[J]);
END;
SETFORMAT(-4,2);
PRINT(CRLF,"UPdate,ABort,OR LINE NUMBERS TO CHANGE *");
CLRBUF; TYPEIN←TTYINL(1,BRCHAR);
IF EQU(TYPEIN[1 TO 2],"AB") THEN RETURN;
IF EQU(TYPEIN[1 TO 2],"UP") THEN
BEGIN
COMMENT this will change the hash table if it is necessary;
IF CHANGE OR TESTIT THEN
BEGIN
COMMENT insert the new hashtb ebtry;
FOR I←NOW STEP 1 UNTIL NUMBER-1 DO HASHTB[I]←HASHTB[I+1];
FOR I←1 STEP 1 UNTIL NUMBER-1 DO
IF (CVASC(EX[1 TO 3])>CVASC(HASHTB[I][1 TO 3]) OR I=1) AND
CVASC(EX[1 TO 3])≤CVASC(HASHTB[I+1][1 TO 3]) THEN DONE;
IF (CVASC(EX[1 TO 3])<CVASC(HASHTB[1][1 TO 3]) AND I=1) THEN I←0;
FOR J←NUMBER STEP -1 UNTIL I+2 DO HASHTB[J]←HASHTB[J-1];
HASHTB[I+1]←EX[1 TO 15];
COMMENT add new page to file if it is full;
IF EQU(HASH[1 TO 1],"#")
AND NOT EQU(HASHTB[NOW][1 TO 1],"#")
AND NOT EQU(HASHTB[NOW-1][1 TO 1],"#")
AND NOT EQU(HASHTB[NOW+1][1 TO 1],"#") then
BEGIN
HASH←"#####";
CLOSE(C2); CLOSE(C3); CLOSE(C4);
PRINT(CRLF,"A new page will be added to the file.");
COMMENT ***** This next check determines whether the
directory page has gone over a (640-char) record
boundary. *****;
IF (PG*76 + 92) MOD 640 ≤ 76 THEN
PRINT(CRLF, "A new record has been added to the address file directory page.",
CRLF,"Please exit REPORT now and rebuild the HASHES file. This can be ",
CRLF,"done by deleting page 2 of HASHES and running REPORT.");
ETVIN;
PTOSTR(PL,"ET ADDFIL.DSK"&'15&'12);
STT←PTYIN(PL,7,BRCHAR);
ESTRING←"∞P∞LI*#####,#####,#####,#####,#####,#####,#####,#####,#####,#####/"&'15&'12;
INSERT;
PTOSTR(PL,"-1LXMARK"&'15&'12);
ESTRING←'175; PTOSTR(PL,ESTRING); STT←PTYIN(PL,4,BRCHAR);
PTOSTR(PL,"E"); STT←PTYIN(PL,5,BRCHAR);
ETVOUT;
COMMENT and also update the hashtb;
FOR I←NUMBER STEP -1 UNTIL 1 DO
BEGIN
K←I;
IF CVASC(HASHTB[I][1 TO 5])<CVASC(HASH[1 TO 5]) THEN DONE;
HASHTB[I+10]←HASHTB[I];
END;
LOOKUP(C2,"ADDFIL.DSK",FLAG); USETI(C2,1);
DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 4],"COMM");
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(PAGE[8 TO 10],"END");
I1←CVD(LINE[2 TO 6]); I2←CVD(LINE[8 TO 12]);
SETFORMAT(-5,2);
FOR J←1 STEP 1 UNTIL 10 DO HASHTB[K+J]←"#####"&CVS(I1)&CVS(I2);
SETFORMAT(-4,2);
NUMBER←NUMBER+10;
END;
END;
COMMENT collect the data to be changed in the file by e later;
CGS←CGS+1;
IF CGS>1 THEN
FOR I←0 STEP 1 UNTIL CGS-2 DO
BEGIN
COMMENT fix the address file page header line if there are
two changes on the same page;
IF CVD(JMPG[(10*I+1) TO (10*I+5)])=PG THEN
BEGIN
IF TESTIT
THEN JMP←JMP+6;
HEADER←HEADS[62*I+1 TO 62*I+62];
END;
END;
SETFORMAT(-5,2); JMPG←JMPG&CVS(PG)&CVS(JMP); SETFORMAT(-4,2);
HEADER←HEADER[1 TO JMP-1]&ADDRESS[0][22 TO 26]&HEADER[JMP+5 TO 61]&'12;
HEADS←HEADS&HEADER;
CKHASH←CKHASH&ADDRESS[0][22 TO 26];
FOR I←0 STEP 1 UNTIL 5 DO LINES[I]←LINES[I]&ADDRESS[I]&'12;
DONE;
END;
IF (TYPEIN[1 TO 1]<'60) OR (TYPEIN[1 TO 1]>'71) THEN
BEGIN
PRINT(CRLF,"THE MOD REQUEST HAS THREE OPTIONS:",CRLF,
" NNNNNN<cr> THE LINE NUMBS OF THE ENTRIES",
" THAT YOU WISH TO MODIFY",CRLF,
" UPdate<cr> GRANTS PERMISSION TO UPDATE",CRLF,
" ABort<cr> ABORT THE ATTEMPT AND RESTART");
CONTINUE;
END
ELSE
COMMENT receive the changes, and substitue them in ADDRESS[X];
BEGIN "CHECK"
HASH←ADDRESS[0][22 TO 26];
TYPEER←TYPEIN;
J←1;
WHILE NOT EQU(TYPEER[J TO J],'15) DO
BEGIN
K←CVD(TYPEer[J TO J]);
J←J+1;
IF (K≤5) AND (K≥1) THEN
BEGIN
PRINT(CRLF,"CHANGES*");
LODED(ADDRESS[K]);
ADDRESS[K]←TTYINL(C1,BRCHAR);
END;
COMMENT line 0, the code, is a special case for processing purposes;
IF K=0 THEN
BEGIN
ZIP←ADDRESS[0][3 TO 5];
PRINT(CRLF,"IT IS NOT POSSIBLE TO MANUALLY CHANGE THE HASH.");
SETFORMAT(1,1);
PRINT(CRLF,"CHANGES*");
LODED(ADDRESS[K]);
TYPEIN←TTYINL(C1,BRCHAR);
IF LENGTH(TYPEIN)≠34 THEN BEGIN
PRINT(CRLF,"ERROR IN CODE LINE - (remember to end with a space) - TRY AGAIN"); DONE; END ELSE
COMMENT Now construct a new hash, and check the order file so that
any orders can be updated to reflect the proper hash;
IF NOT EQU(ZIP[1 TO 3],TYPEIN[3 TO 5]) THEN
BEGIN
ADDRESS[0]←TYPEIN;
PRT,"HASH WILL BE RECALCULATED AND UPDATED.");
SAVE←HASH[1 TO 5];
HASH←ADDRESS[0][3 TO 5]&HASH[4 TO 5];
HASHER; COMMENT this procedure will insure uniqueness;
CLOSE(C2); CLOSE(C3); CLOSE(C4);
LOOKUP(C4,"ORDER.DSK",FLAG);USETI(C4,2);
LOOKING←LOOK←TRUE;I←1; FILES←"";
COMMENT check the order file and change the entry;
WHILE LOOKING DO
BEGIN
EF1←FALSE; I←I+1; FILESV←"";
PAGE←INPUT(C4,2);
WHILE LENGTH(PAGE)<5 DO PAGE←INPUT(C4,2);
IF EQU(PAGE[1 TO 3],"DEC") THEN EF1←TRUE;
WHILE LOOK DO
BEGIN
LINE←SCAN(PAGE,9,BRCHAR);
IF LENGTH(LINE)<6 THEN
BEGIN
FILES←FILES&FILESV&LINE;
FILESV←""; LINE←"";
IF BRCHAR='14 OR LENGTH(PAGE)=0 THEN DONE;
END;
IF EQU(LINE[2 TO 6],SAVE[1 TO 5]) THEN
LINE←"*"&HASH[1 TO 5]&LINE[7 TO 45];
FILESV←FILESV&LINE;
END;
IF EF1 THEN DONE;
END;
ETVIN;
ENTER(C3,"ORDER.DSK",FLAG);USETO(C3,0);
OUT(C3,FILES);
CLOSE(C3); CLOSE(C4);
PTOSTR(PL,"ET ORDER.DSK"&'15&'12);
STT←PTYIN(PL,10,BRCHAR);
PTOSTR(PL,"YE");
STT←PTYIN(PL,5,BRCHAR);
ETVOUT;
COMMENT now change the hashtb;
HASHED←HASH; EF1←UP←FALSE;
EX←HASHED[1 TO 5]&HASHTB[TAME][6 TO 19];
CHANGE←TRUE;
END;
ADDRESS[0]←TYPEIN[1 TO 21]&HASH[1 TO 5]&TYPEIN[27 TO 35];
END;
END;
END "CHECK";
END "SAT";
IF TESTIT THEN RETURN;
END "THEMOD";
END "MOD";
COMMENT the ETV procedure;
SIMPLE PROCEDURE ETV;
BEGIN
COMMENT The following code will actually UPDATE the
file. This is done using the ETv editor, and
will update the directory page upon exit.
The data used to update the file are:
ADDRESS[X] - THE UPDATED ENTRIES REC - RECORD NUMBER OF PAGE
HEADER - THE NEW HEADER LINE PG - PAGE NUMBER
HASH - THE HASH CODE JMP - LINE NUMBER;
INTEGER CM;
COMMENT open the file to e;
CLOSE(C2);
ETVIN;
PTOSTR(PL,"ET ADDFIL.DSK"&'15&'12);
STT←PTYIN(PL,7,BRCHAR);
FOR CM←1 STEP 1 UNTIL CGS DO
BEGIN
PG←CVD(JMPG[1 TO 5]); JMP←CVD(JMPG[6 TO 10]); JMPG←JMPG[11 TO 10000];
HEADER←SCAN(HEADS,1,BRCHAR);
FOR I←0 STEP 1 UNTIL 5 DO ADDRESS[I]←SCAN(LINES[I],1,BRCHAR);
COMMENT insert the page herder line, and the addres;
IF (JMP>54) AND (EQU(HEADER[61 TO 61],"/")) THEN
HEADER←HEADER[1 TO 60]&",";
HEADER←HEADER[1 TO JMP-1]&ADDRESS[0][22 TO 26]&HEADER[JMP+5 TO 61];
ESTRING←CVS(PG)&"P1LI"&HEADER&'15&'12;
INSERT ;
FOR I←0 STEP 1 UNTIL 5 DO
BEGIN
ESTRING←CVS(JMP+I)&"LI"&ADDRESS[I]&'12;
INSERT;
END;
END;
PTOSTR(PL,"E");
STT←PTYIN(PL,5,BRCHAR);
CHANGE←TRUE;
ETVOUT;
COMMENT this will save the hashtb to avoid the recomputation;
LOOKUP(C3,"HASHES",FLAG); USETI(C3,1);
ENTER(C4,"HASHES",FLAG); USETO(C4,0);
HASH←"HASH"&'12&CVS(NUMBER)&'12;
FOR I←1 STEP 1 UNTIL NUMBER DO HASH←HASH&HASHTB[I]&'12;
HASH←HASH&'14;
OUT(C4,HASH);
CLOSE(C3); CLOSE(C4);
END;
COMMENT this is the running of chag;
AMOK←TRUE;
CGS←0;
CKHASH←HEADS←JMPG←"";
FOR J←1 STEP 1 UNTIL 5 DO LINES[J]←"";
COMMENT this the add/mod loop;
WHILE AMOK DO
BEGIN
IF EQU(TYPEIN[1 TO 3],"MOD") THEN MODIFY;
IF EQU(TYPEIN[1 TO 3],"ADD") THEN ADDNEW;
TESTIT←FALSE;
PRINT(CRLF,"ADD/MOD enter option *");
CLRBUF; TYPEIN←TTYINL(1,BRCHAR);
DO I←I+1 UNTIL NOT EQU(TYPEIN[I TO I]," ");
IF EQU(TYPEIN[1 TO 1],"?")
OR EQU(TYPEIN[1 TO 4],"HELP") THEN
BEGIN
PRINT(CRLF,"LEGAL RESPONSES ARE:",CRLF,
" ADD<cr> TO ADD A NEW ENTRY",CRLF,
" MOD<cr> TO CHANGE AN ENTRY",CRLF,
" ADD HELP<cr> FOR HELP WITH AN ADD",CRLF,
" MOD HELP<cr> FOR HELP WITH A CHANGE",CRLF,
" <cr> TO PROCESS THE MODIFICATIONS AND EXIT");
CONTINUE;
END;
IF EQU(TYPEIN[1 TO 1],'15) THEN DONE;
END;
COMMENT now process the adds/mods if any were made;
IF CGS>0 THEN
BEGIN
PRINT(CRLF,"The changes will be made.");
ETV;
END;
END;
COMMENT The DELETE procedure;
SIMPLE PROCEDURE DELIT;
COMMENT This procedure will use E to DELIT any NUMB of
entries from the address file within a loop;
BEGIN "DEL"
INTEGER DEL,INT;
STRING DELS;
BOOLEAN FINI;
FINI←FALSE;
I←I-1;
DO I←I+1 UNTIL EQU(TYPEIN[I TO I]," ") OR
EQU(TYPEIN[I TO I],'15);
DO I←I+1 UNTIL NOT EQU(TYPEIN[I TO I]," ") OR
EQU(TYPEIN[I TO I],'15);
IF EQU(TYPEIN[I TO I+3],"HELP") THEN
BEGIN
HELP←4;
HELPAD;
RETURN;
END;
DEL←0; DELS←"";
HASH←"#####"; BILOOK; INT←NOW;
WHILE NOT FINI DO
BEGIN
PRINT(CRLF,"HASH CODE TO DELETE, OR <cr> TO EXIT *");
CLRBUF; HASH←TTYINL(1,BRCHAR);
IF EQU(HASH[1 TO 1],'15) THEN DONE;
IF EQU(HASH[1 TO 1],"?") OR LENGTH(HASH)≠6 THEN
BEGIN
PRINT(CRLF,"ENTER THE FIVE CHARACTER HASH CODE IF YOU KNOW IT, OR",
CRLF,"ZZZZZ (ANY NONEXISTENT HASH) IF YOU WANT TO SEARCH.");
CONTINUE;
END;
UP←FALSE;
BILOOK;
IF UP THEN
BEGIN
PRINT(CRLF,"SORRY - - HE'S NOT IN THE FILE"); SEARCH;
IF UP THEN CONTINUE;
END;
FINDER;
PRINT(CRLF,"CAN I DELETE:",ADDRESS[1]," (Yes OR No) *");
CLRBUF; TYPEIN←TTYINL(C1,BRCHAR);
IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN CONTINUE;
DEL←DEL+1;
SETFORMAT(-4,2);
IF DEL>1 THEN
FOR I←0 STEP 1 UNTIL DEL-2 DO
IF CVD(DELS[(I*72+5) TO (I*72 +8)])=PG THEN
BEGIN
HEADER←HEADER[1 TO JMP-1]&HEADER[JMP+6 TO 60]&",#####"&HEADER[61 TO 61];
IF CVD(DELS[(I*72+9) TO (I*72 +12)])<JMP THEN JMP←JMP-6;
END;
DELS←DELS&CVS(NOW)&CVS(PG)&CVS(JMP)&HEADER[1 TO 61];
STT←HASHTB[NOW][6 TO 16];
FOR I←NOW STEP 1 UNTIL NUMBER-1 DO HASHTB[I]←HASHTB[I+1];
FOR I←NUMBER STEP -1 UNTIL INT+1 DO HASHTB[I]←HASHTB[I-1];
SETFORMAT(-4,2); HASHTB[INT]←"#####"&STT;
END;
IF DEL=0 THEN RETURN;
COMMENT Now call E to do the DELETE;
CLOSE(C2);
ETVIN;
PTOSTR(PL,"ET ADDFIL.DSK"&'15&'12);
STT←PTYIN(PL,7,BRCHAR); comment have to wait for e;
FOR I←1 STEP 1 UNTIL DEL DO
BEGIN
NOW←CVD(DELS[1 TO 4]); PG←CVD(DELS[5 TO 8]); JMP←CVD(DELS[9 TO 12]);
DELS←DELS[13 TO 10000];
HEADER←DELS[1 TO 61]; DELS←DELS[62 TO 10000];
STT←HEADER[1 TO JMP-1]&HEADER[JMP+6 TO 60]&",#####"&HEADER[61 TO 61];
ESTRING←CVS(PG)&"P1LI"&STT&'15&'12;
INSERT;
ESTRING←CVS(JMP)&"L5D";
INSERT;
END;
CHANGE←TRUE;
PTOSTR(PL,"E");
STT←PTYIN(PL,5,BRCHAR); comment wait to close the file;
ETVOUT;
COMMENT this will save the hashtb to avoid the recomputation;
LOOKUP(C3,"HASHES",FLAG); USETI(C3,1);
ENTER(C4,"HASHES",FLAG); USETO(C4,0);
HASH←"HASH"&'12&CVS(NUMBER)&'12;
FOR I←1 STEP 1 UNTIL NUMBER DO HASH←HASH&HASHTB[I]&'12;
HASH←HASH&'14;
OUT(C4,HASH);
CLOSE(C3); CLOSE(C4);
END "DEL";
COMMENT the HASHER procedure;
SIMPLE PROCEDURE HASHER;
COMMENT This section is intended to insure a unique hash;
BEGIN
INTEGER II,JJ;
BOOLEAN LOOKING;
LOOKING←TRUE; II←JJ←1;
WHILE LOOKING DO
BEGIN
UP←FALSE;
BILOOK;
IF NOT UP THEN
COMMENT if not unique change the last letter by one;
BEGIN
HASH←HASH[1 TO 4]&(HASH[5 TO 5]+'1);
IF EQU(HASH[5 TO 5],"[") THEN HASH←HASH[1 TO 4]&"A";
II←II+1;
IF II=27 THEN
COMMENT if still not nique change the next to last;
BEGIN
HASH←HASH[1 TO 3]&(HASH[4 TO 4]+'1)&HASH[5 TO 5];
II←1;
IF EQU(HASH[4 TO 4],"[") THEN HASH←HASH[1 TO 3]&"A"&HASH[5 TO 5];
JJ←JJ+1;
IF JJ=27 THEN
COMMENT if there are 676 entrise in the same zip
region then the files too big;
BEGIN
PRINT(CRLF,"CANNOT FIND UNIQUE HASH");
RETURN;
END;
END;
END ELSE DONE;
END;
END;
COMMENT The HELPAD procedure;
SIMPLE PROCEDURE HELPAD;
COMMENT This is merely a case statement that tells how each one
of the functions works;
BEGIN "HELPAD"
DEFINE ER1=⊂PRINT(CRLF,"LEGAL RESPONSES ARE:",CRLF⊃;
DEFINE ER2=⊂" ADD<cr> TO ADD A NEW ENTRY",CRLF,
" MOD<cr> TO CHANGE AN ENTRY",CRLF,
" DEL<cr> TO DELIT AN ENTRY",CRLF,
" ADD HELP<cr> FOR HELP WITH AN ADD",CRLF,
" MOD HELP<cr> FOR HELP WITH A CHANGE",CRLF,
" DEL HELP<cr> FOR HELP WITH THE DELIT",CRLF,
" <cr> TO EXIT",CRLF);⊃;
CASE HELP-1 OF
BEGIN
COMMENT This is the procedure introduction and help output;
PRINT(CRLF,CRLF,CRLF,"ADDRESS FILW UPDATE PROGRAM HELP",CRLF,CRLF,
"THE PROGRAM IS DESIGNED TO MAKE ANY UPDATES NECESSARY ",CRLF,
"TO THE USER FILE FOR CSREPORT RECIPIENTS. THE FILE",CRLF,
"IS MAINTAINED IN ETv FORMAT AND CAN BE READ USING THE",CRLF,
"ETv TEXT EDITING SYSTEM. IT IS REQUESTED THAT ALL FILE ",CRLF,
"UPDATES BE DONE USING THIS PROGRAM SO THAT THE INTERNAL ",CRLF,
"FILE REFERENCING BY THE CSREPORT SYSTEM CAN BE DONE. "
,CRLF,CRLF,"CHANGES ARE MADE TO THE FILE THROUGH INTERACTION",CRLF,
"WITH THE USER, FIRST THE INPUTS ARE CHECKED AND IF AN ",CRLF,
"ERROR IS DETECTED YOU WILL BE GIVEN AN OPPORTUNITY TO RESTART ",CRLF,
"THEN IF ALL IS CORRECT THE PROGRAM WILL USE E TO PERFORM ",CRLF,
"THE UPDATE AND RECONFIGURE THE FILE. ",CRLF,CRLF,
"IN ORDER TO INITIATE THE PROCESS ENTER:",CRLF,
" ADD<cr> TO ADD A NEW ENTRY",CRLF,
" MOD<cr> TO CHANGE AN ENTRY",CRLF,
" DEL<cr> TO DELIT AN ENTRY",CRLF,
" ADD HELP<cr> FOR HELP WITH AN ADD",CRLF,
" MOD HELP<cr> FOR HELP WITH A CHANGE",CRLF,
" DEL HELP<cr> FOR HELP WITH THE DELIT",CRLF,
" <cr> TO EXIT",CRLF,CRLF,"THERE IS HELP AVAILABLE ",
"FOR MOST OF THE INPUT REQUESTS, AND",CRLF,"YOU WILL BE PROMPTED ",
"TO ASK FOR IT.",CRLF,CRLF,
"NOW TYPE IN YOUR REQUEST--");
COMMENT This is the ADD help statement;
PRINT(CRLF,CRLF,CRLF,"ADD HELP:",CRLF,CRLF,
"THIS REQUIRES SOME PREPROCESSING IN ORDER TO DETERMINE THE ",CRLF,
"USER'S HASH CODE, AND PACK IT WITH THE STATISTICAL DATA ",CRLF,
"WHICH WILL BE MAINTAINED WITH THE ADDRESS.",CRLF,CRLF,
"THE PROCEDURE THAT PERFORMS THE ADD OPERATION REQUEST ",CRLF,
"ACTUALLY ONLY PREPROCESSES THE DATA INTERACTIVELY, AND ",CRLF,
"PASSES IT TO THE MODIFY PROCEDURE. BY DOING THIS ",CRLF,
"YOU WILL HAVE THE OPPORTUNITY TO CHECK YOUR INPUT, ",CRLF,
"AND CHANGE IT IF IT IS WRONG. THE ACTUAL ADD WILL NOT ",CRLF,
"BE PERFORMED UNTIL YOU OK ENTRY.",CRLF,CRLF,CRLF,
"THE FORMAT OF AN ENTRY IS:",CRLF,CRLF,
" *CXXXXX|MMMMMMMMMMMM#HHHHH$000.00S <code line>",CRLF,
" <address line 1 - name> ",CRLF,
" <address line 2 > ",CRLF,
" <address line 3 > ",CRLF,
" <address line 4 > ",CRLF,
" <address line 5 > ",CRLF);
COMMENT more help;
COMMENT The MOD help;
PRINT(CRLF,CRLF,CRLF,"MOD HELP:",CRLF,
"THE MODIFY FUNCTION WILL ALLOW YOU TO CHANGE ",CRLF,
"ANY OR ALL OF THE LINES OF THE ADDRESS FOR ANY CUSTOMER ",CRLF,
"THAT IS IN THE ADDRESS FILE (YOU CAN'T CHANGE THE USER ",CRLF,
"HASH CODE), BUT WON'T MAKE AN UPDATE TO THE FILE UNTIL ",CRLF,
"YOU HAVE APPROVED THE ENTRY COMPLETELY. ",CRLF,CRLF,
"YOU WILL BE ASKED TO SUPPLY THE USER HASH WHICH IS USED ",CRLF,
"TO LOCATE THE ENTRY IN THE FILE, IF THE PROGRAM CAANNOT ",CRLF,
"LOCATE THE ENTRY YOU WILL BE TOLD TO REINITIATE THE MOD ",CRLF,
"AND TRY AGAIN IF YOU MISTYPED, OTHERWISE ENTER THE INDIVIDUAL ",CRLF,
"AS AN ADD. ONCE THE ENTRY TO BE CHANGED HAS BEEN FOUND IT ",CRLF,
"WILL BE DISPLAYED WITH LINE NUMBS. YOU WILL THEN BE ",CRLF,
"ASKED TO ENTER THE NUMBs of the lines YOU WISH TO CHANGE ",CRLF,
"THERE ARE THREE RESPONCES TO THIS:",CRLF,CRLF,
" NNNNNN<cr> THE LINE NUMBS OF THE ENTRIES",CRLF,
" THAT YOU WISH TO MODIFY",CRLF,
" UPdate<cr> GRANTS PERMISSION TO UPDATE",CRLF,
" ABort<cr> ABORT THE ATTEMPT AND RESTART",CRLF,CRLF,
"WHEN APPROVED THE ACTUAL CHANGE WILL BE DONE BY ETv UNDER ",CRLF,
"PROGRAM CONTROL.");
COMMENT Help for the DELETE function;
PRINT(CRLF,CRLF,CRLF,"DELETE HELP:",CRLF,
"THE DELETE FUNCTION IS VERY SIMPLE. IT MERELY ASKS ",CRLF,
"FOR THE USER HASH, AND WHEN IT FINDS THE ENTRY IT WILL ",CRLF,
"PRINT OUT THE NAME AND ASK FOR PERMISSION TO DELETE. ",CRLF,
" IF PERMISSION IS GRANTED THE ENTRY WILL BE DELETED.");
COMMENT thebos error;
ER1,ER2;
END;
COMMENT The rest of the add help;
IF EQU(TYPEIN[1 TO 3],"ADD") THEN
BEGIN
PRINT(" - - TYPE <cr> TO CONTINUE HELP - -");
CLRBUF; TYPEIN←TTYINL(1,BRCHAR);
IF EQU(TYPEIN[1 TO 1],'15) THEN
PRINT(CRLF,"YOU WILL BE ALLOWED 5 LINES FOR THE USERS ADDRESS ",CRLF,CRLF,
" CODE LINE KEYS: C -BILLING CODE OF b ,N,M,A,F",CRLF,
" XXXXX -ZIP OR COUNTRY CODE OF b ,USSR,IDMAI",
CRLF," M -NUMBER OF ORDERS EACH OF LAST 12 MON",
CRLF," HHHHH -USER HASH CODE FOR SORTING THE FILE",
CRLF," MADE FROM ZIP CODE AND NAME",CRLF,
" $000.00S -MONEY USER OWES AND SIGN.",CRLF,CRLF,
"YOU WILL BE ASKED TO INPUT: THE USERS NAME, THE BILLING ",CRLF,
"CATEGORY (HELP IS AVAILABLE), ZIP OR COUNTRY CODE (HELP ",CRLF,
"IS AVAILABLE), AND UP TO 4 OTHER ADDRESS LINES.",CRLF,CRLF,
"THE MOD PROGRAM WILL THEN DISPLAY YOUR ENTRY AND IF IT ",CRLF,
"IS OK YOU CAN ACCEPT IT, IF NOT YOU CAN CHANGE ANY LINE, ",CRLF,
"CAUTION SHOULD BE EXERCISED IN CHANGING THE TITLE LINE ",CRLF,
"YOU CANNOT CHANGE THE HASH CODE.");
END;
END "HELPAD";
COMMENT The MAIN body of the address file maintainence
will call THEBOS to work;
SETBREAK(1,'12,NULL,"IKP");
SETBREAK(2,'14,NULL,"IAP");
SETBREAK(3,'15,NULL,"IAP");
SETBREAK(4,'113,NULL,"IAP");
SETBREAK(5,'136,NULL,"IAP");
SETBREAK(6,'117,NULL,"IAP");
SETBREAK(7,'26,NULL,"IAP");
SETBREAK(8,'104,NULL,"IAP");
SETBREAK(9,'12&'14,NULL,"IAP");
SETBREAK(10,'77,NULL,"IAP");
SETBREAK(11,'44,NULL,"IAP");
SETBREAK(12,'56,NULL,"IAP");
THEBOS;
END "ADDRESSFILE";
END;