perm filename CSREPT.SAI[MNT,CSR]2 blob
sn#233859 filedate 1976-08-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CSREPT
C00005 00003 The PRESID procedure
C00007 00004 The BILOOK subprocedure
C00010 00005 The FINDER subprocedure
C00012 00006 The SEARCH procedure
C00015 00007 more search zip search
C00019 00008 more search name
C00023 00009 The DATA subprocedure
C00026 00010 The HELPER subprocedure
C00033 00011 The PRESID runs
C00039 00012 CSREPT runs:
C00052 ENDMK
C⊗;
COMMENT CSREPT;
BEGIN
COMMENT The control program through any of the subprograms can be
reached. The entire system is run from a procedure called
PRESID which initially sets up a numerically ordered list of
addressees using a Shell sort. It then allows the operator
to request any of the subprograms.
This section also provides a help procedure, a binary sorting
procedure, and a locator procedure.;
EXTERNAL PROCEDURE LISTUP;
EXTERNAL PROCEDURE MAKEML;
EXTERNAL PROCEDURE CMONEY;
EXTERNAL PROCEDURE CSMAIL;
EXTERNAL PROCEDURE BAIL;
REQUIRE "⊂⊃" DELIMITERS;
REQUIRE 10000 STRING_SPACE;
INTERNAL INTEGER C1,C2,PL,COUNT,DSKCT,BRCHAR,NUMBER,JMP,REC,PG,NOW;
INTERNAL INTEGER C3,COPIES,LINEST,LINELB,C4,C5,UPDATES;
INTERNAL REAL PRICER,OWE,BASE,TAX;
INTERNAL BOOLEAN EOF,FLAG,EF1,UP,SHAKE,SWITCH;
INTERNAL STRING TYPEIN,STT,PAGE,LINE,HEADER,HASH,PAT;
INTEGER DUM,JH,J,I,DAT;
DEFINE TTIN=⊂CLRBUF; TYPEIN←TTYINL(1,BRCHAR); WHILE EQU(TYPEIN[1 TO 1]," ")
DO DUM←LOP(TYPEIN);⊃;
DEFINE PTIN=⊂STT←PTYIN(PL,5,BRCHAR);⊃;
DEFINE SCIN=⊂LINE←SCAN(PAGE,1,BRCHAR);⊃;
DEFINE PRT=⊂PRINT(CRLF⊃;
DEFINE CRLF=⊂'15&'12⊃;
DEFINE FILER=⊂CLOSE(C2); LOOKUP(C2,"ADDFIL.DSK",FLAG); USETI(C2,1);⊃;
DEFINE PGIN=⊂USETI(C3,I);PAGE←INPUT(C3,2);
WHILE LENGTH(PAGE)<5 DO PAGE←INPUT(C3,2);⊃;
COMMENT The PRESID procedure;
PROCEDURE PRESID;
COMMENT Preside controls the running of all of the functions of CSREPT
through an internal/external linkage with the "subprograms".
It also provides the sorting and searching utilities for
locating an addressee from the list;
BEGIN
STRING NUMBERS;
BOOLEAN COMPLETE;
EXTERNAL PROCEDURE LISTUP;
INTERNAL STRING ARRAY HASHTB[1:NUMBER+111],ADDRESS[0:5];
INTEGER HELP,ENTRY;
INTERNAL SIMPLE PROCEDURE SHELST;
BEGIN
COMMENT This procedure will sort the unordered addressee list into
numerical order by the first three hash characters. It does
this by using a shell sort. the input and output is in the
array called HASHTB;
INTEGER S,H,P,Q;
STRING COMPARE;
H←1093;
FOR S←1 STEP 1 UNTIL 6 DO
BEGIN
H←(H-1)/3; P←1;
FOR P←P+H STEP H UNTIL NUMBER DO
BEGIN
Q←P-H;
COMPARE←HASHTB[P];
WHILE CVASC(HASHTB[Q][1 TO 3])>CVASC(COMPARE[1 TO 3]) DO
BEGIN
HASHTB[Q+H]←HASHTB[Q];
Q←Q-H;
IF Q≤0 THEN DONE;
END;
HASHTB[Q+H]←COMPARE;
END;
END;
END;
COMMENT The BILOOK subprocedure;
INTERNAL SIMPLE PROCEDURE BILOOK;
BEGIN
INTEGER HI,LO;
COMMENT Bilook is intended as a utility procedure to provide
a binary search of the orderd input file. Outputs of
the procedure are: UP a flag set if hash not found
REC the record number of the entry
PG the page number of the entry;
BOOLEAN YEA;
LO←1; HI←NUMBER; YEA←TRUE;
WHILE YEA DO
BEGIN
IF EQU(HASH[1 TO 3],HASHTB[LO][1 TO 3]) THEN BEGIN NOW←LO; DONE; END;
IF EQU(HASH[1 TO 3],HASHTB[HI][1 TO 3]) THEN BEGIN NOW←HI; DONE; END;
NOW←(HI + LO) DIV 2;
IF (NOW=LO) OR (NOW=HI) THEN BEGIN UP←TRUE; RETURN; END;
IF EQU(HASH[1 TO 3],HASHTB[NOW][1 TO 3]) THEN DONE;
IF (CVASC(HASH[1 TO 3])<CVASC(HASHTB[NOW][1 TO 3])) THEN HI←NOW
ELSE LO←NOW;
END;
IF NOW≠1 THEN
DO NOW←NOW-1
UNTIL NOT EQU(HASH[1 TO 3],HASHTB[NOW][1 TO 3]) ELSE NOW←NOW-1;
I←NOW+1; COMMENT to be used in SEARCH;
DO NOW←NOW+1
UNTIL (EQU(HASH[1 TO 5],HASHTB[NOW][1 TO 5])) OR (NOW=NUMBER+1);
COMMENT this is to find the first empty slot;
IF EQU(HASH[1 TO 1],"#") THEN
BEGIN
NOW←NOW-1;
DO NOW←NOW+1 UNTIL NOT EQU(HASHTB[NOW][1 TO 1],"#");
NOW←NOW-1;
END;
COMMENT if the entry could not be found signal;
IF NOW=NUMBER+1 THEN
BEGIN
UP←TRUE;
RETURN;
END;
REC←CVD(HASHTB[NOW][6 TO 10]);
PG←CVD(HASHTB[NOW][11 TO 15]);
END;
COMMENT The FINDER subprocedure;
INTERNAL SIMPLE PROCEDURE FINDER;
BEGIN
COMMENT This procedure will find a HASH CODE entry on a page,
and return the page header line in a string called HEADER
and the 6 lines of the address in the string array ADDRESS
and the line number of the first address line in JMP
INPUTS REC the record number of the entry (from bilook)
HASH the hash code of interest;
INTEGER IT;
FILER; USETI(C2,REC);
PAGE←INPUT(C2,2);
WHILE NOT EQU(PAGE[1 TO 1],"*") DO PAGE←INPUT(C2,2);
SCIN;
HEADER←LINE;
JMP←-4;
IF SHAKE THEN
DO JMP←JMP+6 UNTIL EQU(HASH[1 TO 3],HEADER[JMP TO JMP+2]) ELSE
DO JMP←JMP+6 UNTIL EQU(HASH[1 TO 5],HEADER[JMP TO JMP+4]);
IF NOT EQU(HASH[1 TO 5],"#####") THEN
BEGIN
FOR IT←2 STEP 1 UNTIL JMP-1 DO SCIN;
FOR IT←1 STEP 1 UNTIL 6 DO ADDRESS[IT-1]←SCAN(PAGE,1,BRCHAR);
END;
CLOSE(C2);
END;
COMMENT The SEARCH procedure;
INTERNAL SIMPLE PROCEDURE SEARCH;
BEGIN
COMMENT this procedure is designed to allow the user to search for an
addressee whose BY HASH, ZIP or NAME. The operator is first
allowed to search for an entry using the hash code if he knows it.
Next the operator is asked if he knows the zip code so a random search
can be made. If the zip is unknown then the search is performed
keying on the last name serially through the entire file;
INTEGER LEN,LENLIN,CT,A,K;
STRING NAME,SAVE,CHECK;
BOOLEAN LOPP,LOOKIE;
LOOKIE←LOPP←TRUE;
COMMENT this is the fastest search, by the hash code;
IF NOT UP THEN
WHILE LOPP DO
BEGIN
PRT,"SEARCH: DO YOU KNOW THE HASH CODE? (Y, N OR <cr>) TO EXIT*"); TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
IF EQU(TYPEIN[1 TO 1],"N") THEN DONE;
IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN BEGIN PRT,"TYPING ERROR"); CONTINUE;END;
PRT,"HASH CODE *"); TTIN; HASH←TYPEIN[1 TO 5];
UP←FALSE;BILOOK; IF UP THEN BEGIN PRT,"HASH CODE NOT FOUND."); CONTINUE;END;
FINDER; PRT,"YOUR ENTRY IS ON PAGE: ",PG);
FOR J←0 STEP 1 UNTIL 5 DO PRT,ADDRESS[J]);
PRT,"DO YOU WISH TO DO ANOTHER SEARCH? (Y OR N) *"); TTIN;
IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN RETURN;
END;
COMMENT This is check to determine if a zip or name search is desired;
WHILE LOPP DO
BEGIN
PRT,"SEARCH: DO YOU KNOW THE ZIP CODE? (Y,N OR <cr> TO EXIT)*"); TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
IF (NOT EQU(TYPEIN[1 TO 1],"Y")) AND
(NOT EQU(TYPEIN[1 TO 1],"N")) THEN
PRT,"LEGAL RESPONCES ARE:",CRLF,
" Y to do a fast zip search ",CRLF,
" N to do a slow last name search ",CRLF,
" EXIT to exit the search ") ELSE DONE;
END;
COMMENT more search zip search;
DEFINE SCLOOK=⊂IF LENGTH(PAGE)>10 THEN SCIN;
IF LENGTH(PAGE)≤10 THEN DONE;⊃;
IF EQU(TYPEIN[1 TO 1],"Y") THEN
BEGIN
PRT,"ZIPCODE? *"); TTIN; HASH←TYPEIN[1 TO 5];
CHECK←"";
FOR J←1 STEP 1 UNTIL (NUMBER DIV 10) DO CHECK←CHECK&"N";
DUM←I←J←0;
UP←FALSE;
BILOOK;
COMMENT when a page is read in all matches will be printed, so
check is used as a marker, the value I is returned by BILOOK;
WHILE LOOKIE DO
BEGIN
IF I=0 THEN DONE;
DUM←CVD(HASHTB[I][11 TO 15]);
IF EQU(CHECK[DUM TO DUM],"Y") THEN I←I+1;
IF EQU(CHECK[DUM TO DUM],"Y") THEN CONTINUE;
PG←CVD(HASHTB[I][11 TO 15]);
CHECK←CHECK[1 TO DUM-1]&"Y"&CHECK[DUM+1 TO 300];
IF (EQU(HASHTB[I][1 TO 3],HASH[1 TO 3])) THEN
BEGIN
REC←CVD(HASHTB[I][6 TO 10]);
SHAKE←TRUE; FINDER; SHAKE←FALSE;
I←I+1;
END;
IF EQU(HASH[1 TO 5],ADDRESS[0][3 TO 7]) THEN
BEGIN
PRT,"HASH=",ADDRESS[0][22 TO 26]," PAGE=",PG," NAME= ",ADDRESS[1]);
J←J+1;
END;
COMMENT check the rest of this page for matches;
WHILE LOPP DO
BEGIN
SCLOOK; ADDRESS[0]←LINE;
IF EQU(HASH[1 TO 5],ADDRESS[0][3 TO 7]) THEN
BEGIN
J←J+1;
PRT,"HASH=",ADDRESS[0][22 TO 26]," PAGE=",PG);
SCLOOK;
PRINT(" NAME= ",LINE);
IF LENGTH(PAGE)<40 THEN DONE;
END ELSE SCLOOK;
SCLOOK; SCLOOK; SCLOOK; SCLOOK;
END;
IF (J>23) OR ((NOT EQU(HASHTB[I][1 TO 3],HASH[1 TO 3])) AND (J>0)) THEN
WHILE LOPP DO
BEGIN
PRT,"ENTER HASH IF HE IS SHOWN, ELSE <cr> TO CONTINUE. *");
TTIN;
IF LENGTH(TYPEIN)>3 THEN
BEGIN
HASH←TYPEIN[1 TO 5];
UP←FALSE;
BILOOK; IF NOT UP THEN FINDER;
IF UP THEN
BEGIN
PRT,"HASH ENTERED INCORRECTLY");
CONTINUE;
END;
PRT,"THE ENTRY FOR THE HASH YOU GAVE IS:");
FOR K←0 STEP 1 UNTIL 5 DO PRT,ADDRESS[K]);
RETURN;
END;
J←0;
DONE;
END;
IF NOT (EQU(HASHTB[I][1 TO 3],HASH[1 TO 3])) THEN DONE;
END;
PRT,"COULD NOT FIND YOUR PERSON WITH A ZIP SEARCH WILL TRY NAME");
END;
COMMENT more search name;
UP←TRUE;
COMMENT this serial search will look for matches to the sequence of letters on
the within the name line of each entry in the file until either an
acceptabe match is found, or the end of the list is encountered;
PRT,"LAST NAME? (OR <cr> TO EXIT) *"); TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
LEN←LENGTH(TYPEIN);
NAME←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
CT←0;
FILER; I←2;
USETI(C2,I);
COMMENT check the address file one page at a time;
FOR J←1 STEP 1 UNTIL (NUMBER DIV 10) DO
BEGIN
DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 1],"*");
SCIN;
COMMENT now we've got the page;
FOR K←1 STEP 1 UNTIL 10 DO
BEGIN
SAVE←SCIN;
SCIN; COMMENT we've now got the name line;
LENLIN←LENGTH(LINE);
IF LENLIN≥LEN THEN
FOR A←1 STEP 1 UNTIL (LENLIN-LEN+1) DO
BEGIN
IF NAME[1 TO 1]=LINE[A TO A] AND
NAME[2 to 2]=LINE[A+1 TO A+1] THEN
IF EQU(NAME,LINE[A TO (A+LEN-2)]) THEN
BEGIN
CT←CT+1;
PRT,"HASH=",SAVE[22 TO 26]," PAGE=",J+1," NAME= ",LINE);
DONE;
END;
END;
SCIN; SCIN; SCIN; SCIN;
IF LENGTH(PAGE)<20 THEN DONE;
END;
COMMENT see if he is amoung the found;
IF (CT>23) OR ((J≥(NUMBER DIV 10)) AND (CT>0)) THEN
WHILE LOPP DO
BEGIN
PRT,"ENTER HASH IF HE IS SHOWN, ELSE <cr> TO CONTINUE. *");
TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN BEGIN CT←0; DONE; END;
IF LENGTH(TYPEIN)>3 THEN
BEGIN
HASH←TYPEIN[1 TO 5];
UP←FALSE;
BILOOK; IF NOT UP THEN FINDER;
IF UP THEN
BEGIN
PRT,"HASH ENTERED INCORRECTLY");
CONTINUE;
END;
PRT,"THE ENTRY FOR THE HASH YOU GAVE IS:");
FOR K←0 STEP 1 UNTIL 5 DO PRT,ADDRESS[K]);
RETURN;
END;
CT←0;
DONE;
END;
END;
PRT,"COULD NOT FIND A MATCH, HE IS NOT IN THE FILE YOU WILL HAVE TO ADD HIM");
UP←TRUE;
RETURN;
END;
COMMENT The DATA subprocedure;
SIMPLE PROCEDURE DATA;
BEGIN
COMMENT this procedure will allow the oprator to check and change
the program computation data;
BOOLEAN LP,LLP;
INTEGER PAG;
LP←LLP←TRUE;
CLOSE(C3); CLOSE(C4);
LOOKUP(C3,"LBDATA.DSK",FLAG);
ENTER(C4,"LBDATA.DSK",FLAG);
USETI(C3,1);
I←0;
DO BEGIN I←I+1; PGIN; END UNTIL EQU(PAGE[1 TO 4],"DATA");
PAG←I;
COMMENT this is the change loop;
WHILE LLP DO
BEGIN
PRT,"DATA - THE CURRENT VALUES ARE:",CRLF,PAGE);
WHILE LP DO
BEGIN
PRT,"NUMBER OF THE ITEM TO BE CHANGED, OR <cr> TO EXIT *");
TTIN; IF EQU(TYPEIN[1 TO 1],'15) THEN DONE;
IF (TYPEIN[1 TO 1]<'61) OR (TYPEIN[1 TO 1]>'71) THEN
PRT,"INPUT MUST BE A DIGIT EQUAL TO A DATA NUMBER")
ELSE DONE;
END;
IF EQU(TYPEIN[1 TO 1],'15) THEN DONE;
STT←TYPEIN[1 TO 1];
PRT,"NEW VALUE *"); TTIN; I←7;
DO I←I+1 UNTIL EQU(PAGE[I TO I+1],STT[1 TO 1]&".");
DO I←I+1 UNTIL EQU(PAGE[I TO I],"=");
J←I+5+(LENGTH(TYPEIN)-1);
PAGE←PAGE[1 TO I]&TYPEIN[1 TO (J-I-5)]&" "&PAGE[J+1 TO 11111];
CASE CVD(STT)-1 OF
BEGIN
BASE←REALSCAN(TYPEIN,BRCHAR);
PRICER←REALSCAN(TYPEIN,BRCHAR);
TAX←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)])/1000.0;
COPIES←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]);
LINELB←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]);
LINEST←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]);
PAT←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
OWE←REALSCAN(TYPEIN,BRCHAR);
END;
END;
COMMENT put the entries in the file;
LINE←STT←"";
DO BEGIN LINE←INPUT(C3,2); PAGE←PAGE&LINE; END
UNTIL EQU(LINE[1 TO 3],"INV");
USETO(C4,0);
OUT(C4,PAGE);
CLOSE(C3);
CLOSE(C4);
END;
COMMENT The HELPER subprocedure; ;
SIMPLE PROCEDURE HELPER;
BEGIN
COMMENT This procedure provides the general help as an overview,
and the printout for mistyping;
DEFINE RESP=⊂PRT,"LEGAL RESPONSES ARE:",CRLF⊃;
CASE HELP-1 OF
BEGIN
PRT,CRLF,CRLF,"HELP FOR THE CS REPORT DISTRIBUTION SYSTEM",CRLF,CRLF,
" THE COMPUTER SCIENCE REPORT PROGRAM (CSREPT) IS ",CRLF,
"TO PROVIDE THE ACCOUNTING AND DISTRIBUTION FUNCTION FOR THE",CRLF,
"LIBRARY AND PUBLICATIONS COMMITTEE. IT IS COMPOSED OF SIX",CRLF,
"FUNCTIONS WHICH ARE DESCRIBED BELOW, THEY CAN BE REACHED ",CRLF,
"BY TYPING THE FOLLOWING RESPONSES WHEN ASKED BY CSREPT WHAT",CRLF,
"YOU WISH TO DO: ",CRLF,
" LISTup<cr> - this function is intended to make all ",CRLF,
" changes to the mailing list. ",CRLF,
" MAKEml<cr> - makes the mailing labels, the order forms",CRLF,
" and prepares the files to receive the ",CRLF,
" report orders and payments. ",CRLF,
" CSORD<cr> - processes the orders as they are received",CRLF,
" and will inform you when all copies of",CRLF,
" a document have been ordered. ",CRLF,
" CSMAIL<cr> - prints the invoices and mailing labels",CRLF,
" and provides summary of orders. ",CRLF,
" CSRECD<cr> - processes payments received. ",CRLF,
" DATA<cr> - allows you to make changes to some of ",CRLF,
" of the data used in processing- ",CRLF,
" price per page,number of copies of",CRLF,
" lists to output. ",CRLF,
" SEARCH<cr> - allows you to search for an addressee ",CRLF,
" in the file. You can search by the ",CRLF,
" hash code which is fastest, the zip ",CRLF,
" which is fairly efficient, or the last",CRLF,
" name which is rediculously bad. If ",CRLF,
" you run a function that needs a hash ",CRLF,
" which is supplied incorrectly it will ",CRLF,
" cause an automatic search ",CRLF,
" ",CRLF,
"THE PROGRAMS ARE DESIGNED SO THAT INPUTS ARE CHECKED AS YOU",CRLF,
"TYPE THEM, AND IF THEY ARE FOUND TO BE WRONG YOU ARE SHOWN",CRLF,
"THE ACCEPTABLE INPUTS. HELP IS AVAILABLE BY TYPING-HELP<cr>¬",CRLF,
"ON THE ENTRANCE TO ANY PROGRAM, AND MANY MAJOR FUNCTIONS OF",CRLF,
"THE PROGRAMS. IF AT ANY TIME YOU ARE UNSURE AS TO THE ",CRLF,
"EXPECTED INPUT SIMPLY TYPE -?<cr>-. FOR A DETAILED DISCUSSION",CRLF,
"OF THE PROGRAM OPERATION READ THE REPORT. ");
RESP," LISTup<cr>- to change to mailing list",CRLF,
" MAKEml<cr>- send the abstract listing",CRLF,
" CSORD<cr>- process incoming orders",CRLF,
" CSMAIL<cr>- send out the reports and bills (invoice)",CRLF,
" CSRECD<cr>- process payments received",CRLF,
" DATA<cr> - update data items",CRLF,
" SEARCH<cr>- searches for adressee",CRLF,
" HELP<cr> - for a little help from a friend",CRLF,
" <cr> - to exit (<cr> will usually exit one level",CRLF);
END; END;
COMMENT The PRESID runs;
COMMENT Put the unordered table in HASHTB;
UP←COMPLETE←FALSE;
ENTRY←0;
LOOKUP(C3,"HASHES",FLAG);
COMMENT now read in the hashtb if its can be found;
IF FLAG=0 THEN
BEGIN
USETI(C3,1);
FOR I←1 STEP 1 UNTIL 10 DO
BEGIN
PAGE←INPUT(C3,2);
IF EQU(PAGE[1 TO 4],"HASH") THEN BEGIN CLOSE(C3); DONE; END;
END;
END;
IF EQU(PAGE[1 TO 4],"HASH") THEN
BEGIN
SCIN; SCIN;
IF EQU(LINE[LENGTH(LINE) TO LENGTH(LINE)],'15) THEN LINE←LINE[1 TO LENGTH(LINE)-1];
NUMBER←CVD(LINE);
FOR I←1 STEP 1 UNTIL NUMBER DO
BEGIN
SCIN;
IF EQU(LINE[LENGTH(LINE) TO LENGTH(LINE)],'15) THEN LINE←LINE[1 TO LENGTH(LINE)-1];
HASHTB[I]←LINE;
END;
END
ELSE
BEGIN
PRINT(CRLF,"THE HASH TABLE COULD NOT BE FOUND, IT WILL BE RECOMPUTED.");
COMMENT Read in the address directory and start thee sort;
CLOSE(C2);
LOOKUP(C2,"ADDFIL.DSK",FLAG);
USETI(C2,1);
PAGE←INPUT(C2,2);
NUMBER←LENGTH(PAGE);
NUMBER←((NUMBER DIV 75)-3)*10;
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(LINE[1 TO 2],"C0");
WHILE NOT COMPLETE DO
BEGIN
LINE←SCAN(PAGE,1,BRCHAR);
IF EQU(LINE[8 TO 8],"E") THEN DONE;
NUMBERS←LINE[2 TO 6]&LINE[8 TO 12];
FOR I←15 STEP 6 UNTIL 69 DO
HASHTB[ENTRY←ENTRY+1]←LINE[I TO I+4]&NUMBERS;
END;
COMMENT Use the Shell sort to order the list;
SHELST;
COMMENT this will save the hashtb to avoid the recomputation;
CLOSE(C2); CLOSE(C3); CLOSE(C4); CLOSE(C5);
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 Now give them a chance;
DEFINE TN=⊂THEN BEGIN JH←1; ⊃;
COMPLETE←FALSE; UPDATES←0;
WHILE NOT COMPLETE DO
BEGIN
PRT," CSREPT - What can I do for you? *");
CLOSE(C2); CLOSE(C3); CLOSE(C4); CLOSE(C5);
TTIN; HELP←2; JH←0; UP←FALSE;
IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
IF EQU(TYPEIN[1 TO 4],"LIST") TN LISTUP; END;
IF EQU(TYPEIN[1 TO 4],"MAKE") TN MAKEML; END;
IF EQU(TYPEIN[1 TO 5],"CSORD") TN SWITCH←TRUE; CMONEY; END;
IF EQU(TYPEIN[1 TO 6],"CSRECD") TN SWITCH←FALSE; CMONEY; END;
IF EQU(TYPEIN[1 TO 6],"CSMAIL") TN CSMAIL; END;
IF EQU(TYPEIN[1 TO 4],"HELP") TN HELP←1; HELPER; END;
IF EQU(TYPEIN[1 TO 4],"DATA") TN DATA; END;
IF EQU(TYPEIN[1 TO 6],"SEARCH") TN SEARCH; END;
IF JH=0 THEN HELPER;
END;
END;
COMMENT CSREPT runs:
THIS will handle the IO channels, initiate the
variables, and call PRESID which is the program neculus;
SETBREAK(1,'12,NULL,"IPK");
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,'54,NULL,"IAP");
COMMENT Open the I/O channels;
OPEN(C1←GETCHAN,"TTY",0,2,2,COUNT,BRCHAR,EOF);
OPEN(C2←GETCHAN,"DSK",0,2,0,DSKCT,BRCHAR,EF1);
OPEN(C3←GETCHAN,"DSK",0,2,2,DSKCT,BRCHAR,EF1);
OPEN(C4←GETCHAN,"DSK",0,2,2,DSKCT,BRCHAR,EF1);
OPEN(C5←GETCHAN,"DSK",0,2,2,DSKCT,BRCHAR,EF1);
COMMENT Set the run parameters;
COUNT←100;
DSKCT←40000;
SHAKE←FALSE;
COMMENT set the data base values;
I←0;
LOOKUP(C3,"LBDATA.DSK",FLAG);
ENTER(C3,"LBDATA.DSK",FLAG);
DO BEGIN I←I+1; PGIN; END UNTIL EQU(PAGE[1 TO 4],"DATA");
I←CVD(PAGE[6 TO 6]); SCIN;
FOR J←1 STEP 1 UNTIL I DO
BEGIN
SCIN; DO DUM←LOP(LINE) UNTIL EQU(LINE[1 TO 1],"="); DUM←LOP(LINE);
STT←""; DO BEGIN STT←STT&LINE[1 TO 1]; DUM←LOP(LINE); END
UNTIL EQU(LINE[1 TO 1]," ");
CASE J-1 OF
BEGIN
BASE←REALSCAN(STT,BRCHAR);
PRICER←REALSCAN(STT,BRCHAR);
DAT←CVD(STT);
COPIES←CVD(STT);
LINELB←CVD(STT);
LINEST←CVD(STT);
PAT←STT&LINE[1 TO 15];
OWE←REALSCAN(STT,BRCHAR);
END;
END;
TAX←DAT/1000.0;
CLOSE(C3);
SETFORMAT(-4,2);
LOOKUP(C2,"ADDFIL.DSK",FLAG);
USETI(C2,1);
PAGE←INPUT(C2,2);
NUMBER←LENGTH(PAGE);
NUMBER←((NUMBER DIV 75)-3)*10;
PRESID;
CLOSE(C2);
CLOSE(C3);
RELEASE(C1);
RELEASE(C2);
RELEASE(C3);
RELEASE(C4);
END;