perm filename MAKEML.SAI[MNT,CSR] blob sn#233861 filedate 1976-08-29 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	MAKEML
C00004 00003	the BUILD procedure
C00007 00004	more build   the loop
C00010 00005	more bulid 
C00013 00006	more build
C00016 00007	more build   the check
C00020 00008	more build  open the files
C00023 00009	the MAKE procedure
C00030 00010	the MAKE procedure
C00035 00011	more make
C00041 00012	more make   the report
C00047 00013	some HELP
C00053 00014	MAKEML runs:
C00066 ENDMK
C⊗;
COMMENT MAKEML;

ENTRY;
BEGIN
EXTERNAL PROCEDURE BAIL;

INTERNAL PROCEDURE MAKEML;
BEGIN "MAKEML"


EXTERNAL INTEGER C1,C2,PL,COUNT,DSKCT,BRCHAR,NUMBER,JMP,REC,PG,C3;
EXTERNAL INTEGER C4,LINELB,LINEST,COPIES;
EXTERNAL REAL PRICER,BASE;
EXTERNAL BOOLEAN EOF,FLAG,EF1,UP;
EXTERNAL STRING TYPEIN,STT,PAGE,LINE,HEADER,HASH,PAT;
EXTERNAL STRING ARRAY ADDRESS[0:5],HASHTB[0:NUMBER+2];
EXTERNAL PROCEDURE FINDER;

INTEGER ARRAY MIKE[1:25],HARD[1:25],PCT[1:50];
STRING ARRAY BDDRE[1:5];
INTEGER I,J,K,DUM,TOT,IT;
STRING MONTH,ENT,ENTRY,ESTRING,JK;
BOOLEAN LOOKING,NEW;


REQUIRE "⊂⊃" DELIMITERS;
DEFINE CRLF=⊂'15&'12⊃;
DEFINE PRT=⊂PRINT(CRLF⊃;
DEFINE PRTERR=⊂PRT,"THE LEGAL RESPONSES ARE:",CRLF,CRLF⊃;
DEFINE TTIN=⊂CLRBUF; TYPEIN←TTYINL(1,BRCHAR); WHILE EQU(TYPEIN[1 TO 1]," ")
	      DO DUM←LOP(TYPEIN);⊃;
DEFINE SCIN=⊂LINE←SCAN(PAGE,1,BRCHAR);⊃;
DEFINE PGIN=⊂USETI(C3,I);  PAGE←INPUT(C3,2);
             WHILE LENGTH(PAGE)<5 DO PAGE←INPUT(C3,2);⊃;

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,10,BRCHAR);⊃;




COMMENT the BUILD procedure;


SIMPLE PROCEDURE BUILD;
BEGIN "BLD"
COMMENT this procedure is called to interactively build the 
	monthly report file (REPT.DSK) and open the order file
	(ORDER.DSK).  It receives as input the page header line
	which contains the month, record, and page;

INTEGER NXT,PAGER,RECNUM,PROCESSED,EXISTING,COUNT;
BOOLEAN BUILDING;
STRING ENT,ENTREE,HLD;




DEFINE ENTADD=⊂SETFORMAT(1,1); IF NXT<9 THEN ENT←ENT&CVS(NXT←NXT+1)&"," ELSE
       BEGIN NXT←NXT+1;  ENT←ENT&(NXT+55)&",";   END; SETFORMAT(-4,2);⊃;
DEFINE IFF=⊂IF(EQU(TYPEIN[1 TO 1],"?")) OR
              (EQU(TYPEIN[1 TO 4],"HELP")) OR
              (EQU(TYPEIN[1 TO 1],'15))⊃;
DEFINE NOTE=⊂PRT,"NOTE - A PRICE IS NECESSARY, INPUT EITHER A PRICE, ",
            CRLF,"OR PAGE ESTIMATE THIS CAN BE CHANGED AT BILLING TIME.");⊃;
DEFINE NNNN=⊂IF (NOT EQU(TYPEIN[1 TO 2],"NO")) AND
		((TYPEIN[1 TO 1]>'71) OR
		(TYPEIN[1 TO 1]<'60)) THEN
	BEGIN
	PRTERR,	"    ####<cr>   NUMBER OF COPIES AVAILABLE",CRLF,
		"      NO<cr>   IF NOT AVAILABLE AT THIS TIME OR NO LIMIT");
	CONTINUE;
	END;⊃;




BUILDING←TRUE;
MONTH←LINE[14 TO 16];
RECNUM←CVD(LINE[2 TO 6]);
PAGER←CVD(LINE[8 TO 12]);
EXISTING←CVD(LINE[26 TO 29]);
NXT←0;
IF NOT NEW THEN BEGIN NXT←LINE[39 TO 39]; NXT←NXT-'60; IF NXT>9 THEN NXT←NXT-7; END;
COUNT←0;

COMMENT more build   the loop;

COMMENT the entry will be assembled and approved through operator 
	interaction with the operator within a loop.  ENT is the 
	string used to build up the entry, and upon approval it will
	be entered into the string ENTREE for subsequent inclusion
	into the file REPT.DSK. (the ents are coming);

WHILE BUILDING DO
BEGIN

COMMENT receive the report numbers;
WHILE LOOKING DO
BEGIN
PRT,"REPORT NUMBER *");
TTIN;
IF EQU(TYPEIN[1 TO 1],'15) THEN
	BEGIN
	IF COUNT=0 THEN RETURN;
 	BUILDING←FALSE;
	DONE;
	END;
IFF OR ((NOT EQU(TYPEIN[1 TO 2],"AI")) 
    AND (NOT EQU(TYPEIN[1 TO 2],"ST"))) THEN PRTERR,
	" STAN-CS465-AIM154<cr>     CS REPORT NUMBER WITH AN OPTIONAL",CRLF,
 	"                           EXTENSION (ie AIM,SLACR,AI,TN,OR)",CRLF,
 	"                           MUST BEGIN WITH STAN OR AIM      ",CRLF,
	"                  <cr>     IF NO MORE ENTRIES ARE TO BE   ",CRLF,
	"                           MADE.                          ",CRLF,
	"                 ?<cr>     OR ANY INPUT EXCEPT THOSE ABOVE",CRLF,
	"                           GIVE YOU THIS.                 ",CRLF);
IF EQU(TYPEIN[1 TO 2],"AI") OR
   EQU(TYPEIN[1 TO 2],"ST") THEN
	BEGIN
	ENT←"*"&TYPEIN[1 TO (LENGTH(TYPEIN)-1)]&"|";
	ENTADD;
	DONE;
	END;
END;

IF NOT BUILDING THEN DONE;

COMMENT the number of hardcopies;
WHILE LOOKING DO
BEGIN
PRT,"NUMBER OF HARDCOPIES AVAILABLE *");
TTIN;  NNNN;
IF NOT EQU(TYPEIN[1 TO 2],"NO") THEN
ENT←ENT&CVS(CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)])) ELSE ENT←ENT&"NONO";
ENT←ENT&",0000,";
DONE;
END;

TYPEIN← "";
COMMENT more bulid ;

COMMENT time to determine the price;
WHILE LOOKING DO
BEGIN
SETFORMAT(-4,2);
IF EQU(TYPEIN[1 TO 2],"NO") THEN NOTE;
PRT,"PRICE(NN.NN ie 19.76) $");
TTIN; TYPEIN←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
IF EQU(TYPEIN[1 TO 1],"$") THEN DUM←LOP(TYPEIN);
IF EQU(TYPEIN[1 TO 4],"COMP") THEN
	BEGIN
	PRT,"NUMBER OF PAGES *");
	TTIN;
	NNNN;
        TYPEIN←CVF(BASE+PRICER*CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]));
	WHILE EQU(TYPEIN[1 TO 1]," ") DO TYPEIN←TYPEIN[2 TO 11];
	SETFORMAT(1,1);
        IF TYPEIN[LENGTH(TYPEIN) TO LENGTH(TYPEIN)]>'67 THEN
	TYPEIN←TYPEIN[1 TO LENGTH(TYPEIN)-2]&CVS((CVD(TYPEIN[LENGTH(TYPEIN)-1 TO LENGTH(TYPEIN)-1])+1) MOD 10)&0;
	IF TYPEIN[LENGTH(TYPEIN) TO LENGTH(TYPEIN)]<'63 OR
           TYPEIN[LENGTH(TYPEIN) TO LENGTH(TYPEIN)]>'67 THEN
	TYPEIN←TYPEIN[1 TO LENGTH(TYPEIN)-1]&"0" ELSE
	TYPEIN←TYPEIN[1 TO LENGTH(TYPEIN)-1]&"5";
	PRT,"THE COMPUTED PRICE IS $",TYPEIN);
	SETFORMAT(-4,2);
	END;
IF (TYPEIN[1 TO 1]<'60) OR (TYPEIN[1 TO 1]>'71) THEN
	BEGIN
	PRTERR,	"   COMPute<cr>   THE PRICE WILL BE COMPUTED, BUT  ",CRLF,
               	"                 THE NUMBER OF PAGES MUST BE INPUT",CRLF,
               	"     DD.DD<cr>   PRICE: TWO DIGITS, A DECIMAL POINT",CRLF,
               	"                 FOLLOWED BY TWO DECIMALS (ie 04.23)",CRLF);
	CONTINUE;
	END;
        WHILE LENGTH(TYPEIN)<5 DO TYPEIN←"0"&TYPEIN;
IF EQU(TYPEIN[1 TO 1],"N") THEN CONTINUE
ELSE
	BEGIN
	ENT←ENT&TYPEIN[1 TO 5]&"|";
	DONE;
	END;
END;


ENTADD;
WHILE LOOKING DO
BEGIN
PRT,"NUMBER OF MICROFICHE AVAILABLE *");
TTIN;
NNNN;
IF NOT EQU(TYPEIN[1 TO 2],"NO") THEN
ENT←ENT&CVS(CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]))
ELSE ENT←ENT&"NONO";
ENT←ENT&",0000|";
DONE;
END;
J←0;

COMMENT more build;

COMMENT process the accounting information;
I←J←0;  HLD←"";
WHILE LOOKING DO
	BEGIN
	PRT,"ACCOUNT *");  TTIN;
	IF EQU(TYPEIN[1 TO 1],"?") THEN
		BEGIN
		PRT,"THE ACCOUNT NUMBER OF ONE OF THE INDIVIDUALS SPONSORING THE REPORT.");
		PRT,CRLF,"A REPORT MAY HAVE ANY NUMBER OF SPONSORS, AS LONG AS THE TOTAL IS 100%.");
		CONTINUE;
		END;
	STT←"";
	STT←STT&TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
	PRT,"PERCENT *"); TTIN;
   	IF (LENGTH(TYPEIN)>4) OR
           (TYPEIN[1 TO 1]<'60) OR
           (TYPEIN[1 TO 1]>'71) THEN
		BEGIN
		PRT,"PERCENTAGES MUST BE ENTERED AS TWO DECIMALS OR 100");
		CONTINUE;
		END;
	J←CVD(TYPEIN[1 TO (LENGTH(TYPEIN)-1)]);
	I←I+J;
	SETFORMAT(2,2);
	HLD←HLD&STT&"."&CVS(J-1)&",";
	SETFORMAT(-4,2);
	IF I=100 THEN DONE;
	IF I<100 THEN
		BEGIN
		SETFORMAT(3,2);
		PRT,CVS(I),"% ALLOCATED, THE TOTAL MUST EQUAL 100");
		SETFORMAT(-4,2);
		CONTINUE;
		END;
	IF I>100 THEN
		BEGIN
		I←J←0;
		HLD←"";
		PRT,"ERROR, OVER 100%, REINPUT ALL ACCOUNTS AND PERCENTAGES");
		CONTINUE;
		END;
	SETFORMAT(-4,2);
	DONE;
	END;
	ENT←ENT&HLD;
	SETFORMAT(1,1);
	J←0;
	PRT,"ONR REPORT (Y OR N)? *");  TTIN;
	IF EQU(TYPEIN[1 TO 1],"Y") THEN J←1;
	PRT,"ARPA REPORT (Y OR N)? *");  TTIN;
	IF EQU(TYPEIN[1 TO 1],"Y") THEN J←J+2;
	ENT←ENT[1 TO (LENGTH(ENT)-1)]&"|"&CVOS(J)&'15&'12;
	SETFORMAT(-4,2);

COMMENT more build   the check;

COMMENT this loop will ask for approval of the entry if it
	is given the ENT will be included in ENTREE for later
	inclusion into the REPT.DSK file, if the entry is
	disapproved the entry will be discarded, and the operator 
	must start over.  If anything else is input the opeator
	will be given an explanation, and the chance to approve;

WHILE LOOKING DO
	BEGIN
	PRT,CRLF,"THIS IS THE CODED ENTRY:",CRLF,ENT);
	PRT,"IS IT OK (Y,N,?)");  TTIN;
	IF EQU(TYPEIN[1 TO 1],"Y") THEN
		BEGIN
		ENTREE←ENTREE&ENT;
		COUNT←COUNT+1;
		DONE;
		END;

	IF EQU(TYPEIN[1 TO 1],"N") THEN 
		BEGIN
		IF NXT=64 THEN NXT←9;
		IF NXT=63 THEN NXT←8;
		PRT,"THE ENTRY WILL BE DISCARDED, AND YOU CAN RESTART");
		NXT←NXT-2; IF NXT=64 THEN NXT←9; IF NXT=63 THEN NXT←8;
		DONE;
		END;

COMMENT this is the default explanation of the entry that loops back
	to the approval cycle;

	PRTERR,
	"	Y<cr>	approval, the entry will be included	",CRLF,
	"	N<cr>	disapproval, the entry will be discarded",CRLF,
 	"   (default)   anything else will give you this, and   ",CRLF,
 	"		then give you another chance to approve.",CRLF,CRLF,
" *CSXXX-AIXX|H,NNNN,0000,PP.PP|M,NNNN,0000|AAAA.%%|Y	",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   ↓   ↓    ↓       |Y=1 ONR REPORT",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   ↓   ↓    ↓       |Y=2 ARPA REPORT",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   ↓   ↓    ↓       |Y=3 BOTH ARPA&ONR",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   ↓   ↓    ACCOUNT # AND PERCENT-1",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   ↓   NUMBER FICHE ORDERED (ACCOUNTING)",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   NUMBER OF MICROFICHE",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  ↓   NONO NOT AVAILABLE OR UNLIMITED",CRLF,
"	 ↓   ↓ ↓       ↓    ↓  COMPUTED ORDER NUMBER FOR MICROFICHE",CRLF,
"	 ↓   ↓ ↓       ↓    PRICE PER HARDCOPY			",CRLF,
"	 ↓   ↓ ↓       NUMBER OF HARDCOPIES ORDERED		",CRLF,
"	 ↓   ↓ NUMBER HARD COPIES AVAILABLE			",CRLF,
"	 ↓   COMPUTED HARDCOPY ORDER NUMBER			",CRLF,
"	 CS REPORT NUMBER WITH OPTIONAL EXTENSION		");


	END;
END;
COMMENT more build  open the files;

COMMENT  the entree will nowbe included into the REPT.DSK file
	and the ORDER.DSK file will be opened;

DEFINE INSERT=⊂PTOSTR(PL,ESTRING);  ESTRING←'175; PTOSTR(PL,ESTRING);
	STT←PTYIN(PL,4,BRCHAR); PTOSTR(PL,"1D"); STT←PTYIN(PL,4,BRCHAR);
	JK←PTYALL(PL);⊃;
ETVIN;
BUILDING←TRUE;
WHILE LOOKING DO
	BEGIN
	CLOSE(C3);
	PTOSTR(PL,"ET REPT.DSK"&'15&'12);
	STT←PTYIN(PL,12,BRCHAR);
	ESTRING←CVS(PAGER)&"PI"&MONTH&"*ENTRIES="&CVS(COUNT+EXISTING);
	SETFORMAT(1,1);
	IF NXT<10 THEN NXT←NXT+'60 ELSE NXT←NXT+55;
        ESTRING←ESTRING&" REPORTS="&NXT&'15&'12;
	SETFORMAT(-4,2);
	INSERT;
        IF NEW THEN
		BEGIN
		ESTRING←"∞D";
		PTOSTR(PL,ESTRING);
		STT←PTYIN(PL,4,BRCHAR);
		END;
	WHILE BUILDING DO
		BEGIN
		ESTRING←"∞LI";
		FOR I←1 STEP 1 UNTIL 10 DO
			BEGIN
			IF LENGTH(ENTREE)<7 THEN DONE;
			STT←SCAN(ENTREE,1,BRCHAR);
			ESTRING←ESTRING&STT&'12;
			END;
		INSERT;
		IF LENGTH(ENTREE)<7 THEN DONE;
		END;

	PTOSTR(PL,"E");
	STT←PTYIN(PL,5,BRCHAR);


	COMMENT now prepare ORDER.DSK;
	LOOKUP(C3,"ORDER.DSK",FLAG);
	I←1;PGIN;
	DO BEGIN SCIN; END UNTIL EQU(LINE[14 TO 16],MONTH);
	SETFORMAT(1,1);
        ESTRING←LINE[8 TO 12]&"PI"&MONTH&"*ORDERS=0000 REPORTS="&NXT&'15&'12;
	SETFORMAT(-4,2);
    	CLOSE(C3);
	PTOSTR(PL,"ET ORDER.DSK"&'15&'12);
	STT←PTYIN(PL,12,BRCHAR);
	INSERT;
	PTOSTR(PL,"∞DE");
	STT←PTYIN(PL,5,BRCHAR);
	DONE;
	END;
ETVOUT;
END "BLD";
COMMENT the MAKE procedure;


SIMPLE PROCEDURE MAKE;
BEGIN "MAKE"
COMMENT this procedure uses two subprocedure to produce the
	output for the MAKEML function:
		LABELS:	outputs the mailing labels to a file to
			be listed of gum labels when you are ready.
		FORM:   outputs the mailing order list for the 
			XGP, number of copies is a data base item
                        and provides the summary data;

INTEGER USA,FNR,RUS,IDM,ONR,ARP,AUT,FRE,COUNT,L1;



SIMPLE PROCEDURE LABELS;
BEGIN
STRING ADDER;
BOOLEAN LOPP,CHES;
INTEGER CSST,CHA;
SETFORMAT(5,2);
CLOSE(C4);
ENTER(C4,MONTH[1 TO 3]&"LAB",FLAG);  USETO(C4,1);
USA←FNR←RUS←IDM←ONR←ARP←AUT←FRE←COUNT←0; LOPP←TRUE;

COMMENT the leader info;
ADDER←"";
IF LINEST>1 THEN
FOR I←1 STEP 1 UNTIL LINEST-1 DO ADDER←ADDER&'15&'12;
ADDER←ADDER&"COMPUTER SCIENCE DEPARTMENT"&'15&'12&"LIBRARY AND PUBLICATIONS "
       &"COMMITTEE"&'15&'12&MONTH&" ABSTRACT MAILING LIST"&'15&'12;
FOR I←1 STEP 1 UNTIL LINELB-3 DO ADDER←ADDER&'15&'12;
OUT(C4,ADDER);  ADDER←"";
CLOSE(C2); LOOKUP(C2,"ADDFIL.DSK",FLAG); USETI(C2,1);
CSST←1;

DEFINE LOCAT=⊂IF EQU(ADDRESS[0][2 TO 2]⊃;
COMMENT now print the lables;
TOT←0;

COMMENT determint which type of labels to use;
WHILE LOPP DO
	BEGIN
	PRT,"Are Cheshire labels to be printed? (Y or N)*");
	TTIN; 
	IF EQU(TYPEIN[1 TO 1],"Y") THEN BEGIN CHES←TRUE; DONE; END;
	IF EQU(TYPEIN[1 TO 1],"N") THEN BEGIN CHES←FALSE; DONE; END;
	PRTERR,"	Yes	Will cause to labels to be printed in the format",CRLF,
	"		necessary for automatic label processing.",CRLF,
	"	No	Will cause the labels to be printed in the format",CRLF,
	"		for AVERY labels.");
	END;
IF NOT CHES THEN
BEGIN
FOR J←1 STEP 1 UNTIL NUMBER DO
	BEGIN
	HASH←HASHTB[J][1 TO 5];
	IF EQU(HASH,"#####") THEN BEGIN TOT←TOT+1; CONTINUE; END;
	REC←CVD(HASHTB[J][6 TO 10]);
        USETI(C2,REC);
	DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 1],"*");
	SCIN;
	HEADER←LINE;
	JMP←-4;
	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 
			BEGIN
			ADDRESS[IT-1]←SCAN(PAGE,1,BRCHAR);
			IF LENGTH(ADDRESS[IT-1])>36 THEN 
			ADDRESS[IT-1]←ADDRESS[IT-1][1 TO 35]&'15;
			END;
		END;

	COMMENT this is to gather some summary data;
	IF ADDRESS[0][3 TO 3]<'72 THEN USA←USA+1;
	IF EQU(ADDRESS[0][3 TO 7],"IDMAI") THEN IDM←IDM+1;
	IF EQU(ADDRESS[0][3 TO 6],"USSR") THEN RUS←RUS+1;
	IF (ADDRESS[0][3 TO 3]≥'72) AND
          (NOT EQU(ADDRESS[0][3 TO 7],"IDMAI")) AND
          (NOT EQU(ADDRESS[0][3 TO 6],"USSR")) THEN FNR←FNR+1;

	LOCAT,"N") THEN ONR←ONR+1;
	LOCAT,"M") THEN ARP←ARP+1;
	LOCAT,"A") THEN AUT←AUT+1;
	LOCAT,"F") THEN FRE←FRE+1;

	COMMENT move in the zip code;
	IF ((ADDRESS[0][3 TO 3]≤'71) AND (ADDRESS[0][3 TO 3]≥'60)) THEN
		BEGIN
		K←5;
		WHILE LENGTH(ADDRESS[K])<5 DO K←K-1;
              IF K<5 THEN ADDRESS[K+1]←"                    "&ADDRESS[0][3 TO 7]&'15
		ELSE
			BEGIN
			ADDRESS[K]←ADDRESS[K][1 TO LENGTH(ADDRESS[K])-1]&"                                ";
			ADDRESS[K]←ADDRESS[K][1 TO 27]&"  "&ADDRESS[0][3 TO 7]&'15;
			END;
		END;

	COMMENT now insert the hashcode;
	ADDRESS[1]←ADDRESS[1][1 TO LENGTH(ADDRESS[1])-1]&"                                        ";
        ADDRESS[1]←ADDRESS[1][1 TO 27]&" #"&ADDRESS[0][22 TO 26]&'15;
	IF NOT EQU(ADDRESS[0][2 TO 2]," ") THEN
		BEGIN
		ADDRESS[2]←ADDRESS[2][1 TO LENGTH(ADDRESS[2])-1]&"                                        ";
	        ADDRESS[2]←ADDRESS[2][1 TO 27]&" (FREE)"&'15;
		END;

	FOR I←1 STEP 1 UNTIL 5 DO ADDER←ADDER&ADDRESS[I]&'12;
	FOR I←1 STEP 1 UNTIL LINELB-5 DO ADDER←ADDER&'15&'12;
	CSST←CSST+1;
	IF CSST=10 THEN
		BEGIN
		ADDER←ADDER[1 TO LENGTH(ADDER)-1]&'14;
		CSST←0;
		END;

	IF LENGTH(ADDER)>8000  THEN BEGIN OUT(C4,ADDER); ADDER←""; END;
	END;
	OUT(C4,ADDER);
	CLOSE(C4);

	PRT,"The mailing labels have been written into the",CRLF,"file: ",
		MONTH,"LAB which can be listed when the labels are available.",CRLF,
	     "They are formatted for AVERY labels.");
END;
COMMENT the MAKE procedure
	This loop will produce the labels in Cheshire format;
IF CHES THEN
BEGIN
CHA←0;
FOR J←1 STEP 1 UNTIL NUMBER DO
	BEGIN
	HASH←HASHTB[J][1 TO 5];
	IF EQU(HASH,"#####") THEN BEGIN TOT←TOT+1; CONTINUE; END;
	REC←CVD(HASHTB[J][6 TO 10]);
        USETI(C2,REC);
	DO PAGE←INPUT(C2,2) UNTIL EQU(PAGE[1 TO 1],"*");
	SCIN;
	HEADER←LINE;
	JMP←-4;
	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 
			BEGIN
			ADDRESS[IT-1]←SCAN(PAGE,1,BRCHAR);
			IF LENGTH(ADDRESS[IT-1])>36 THEN 
			ADDRESS[IT-1]←ADDRESS[IT-1][1 TO 35]&'15;
			END;
		END;

	COMMENT this is to gather some summary data;
	IF ADDRESS[0][3 TO 3]<'72 THEN USA←USA+1;
	IF EQU(ADDRESS[0][3 TO 7],"IDMAI") THEN IDM←IDM+1;
	IF EQU(ADDRESS[0][3 TO 6],"USSR") THEN RUS←RUS+1;
	IF (ADDRESS[0][3 TO 3]≥'72) AND
          (NOT EQU(ADDRESS[0][3 TO 7],"IDMAI")) AND
          (NOT EQU(ADDRESS[0][3 TO 6],"USSR")) THEN FNR←FNR+1;

	LOCAT,"N") THEN ONR←ONR+1;
	LOCAT,"M") THEN ARP←ARP+1;
	LOCAT,"A") THEN AUT←AUT+1;
	LOCAT,"F") THEN FRE←FRE+1;

	COMMENT move in the zip code;
	IF ((ADDRESS[0][3 TO 3]≤'71) AND (ADDRESS[0][3 TO 3]≥'60)) THEN
		BEGIN
		K←5;
		WHILE LENGTH(ADDRESS[K])<5 DO K←K-1;
              IF K<5 THEN ADDRESS[K+1]←"                    "&ADDRESS[0][3 TO 7]&'15
		ELSE
			BEGIN
			ADDRESS[K]←ADDRESS[K][1 TO LENGTH(ADDRESS[K])-1]&"                                ";
			ADDRESS[K]←ADDRESS[K][1 TO 27]&"  "&ADDRESS[0][3 TO 7]&'15;
			END;
		END;

	COMMENT now insert the hashcode;
	ADDRESS[1]←ADDRESS[1][1 TO LENGTH(ADDRESS[1])-1]&"                                        ";
        ADDRESS[1]←ADDRESS[1][1 TO 27]&" #"&ADDRESS[0][22 TO 26]&'15;
	IF NOT EQU(ADDRESS[0][2 TO 2]," ") THEN
		BEGIN
		ADDRESS[2]←ADDRESS[2][1 TO LENGTH(ADDRESS[2])-1]&"                                        ";
	        ADDRESS[2]←ADDRESS[2][1 TO 27]&" (FREE)"&'15;
		END;

	COMMENT set up the format for the cheshire type labels; 
	FOR I←1 STEP 1 UNTIL 5 DO
		BEGIN
		ADDRESS[I]←ADDRESS[I][1 TO LENGTH(ADDRESS[I])-1];
		IF LENGTH(ADDRESS[I])>35 THEN DO
		ADDRESS[I]←ADDRESS[I][1 TO LENGTH(ADDRESS[I])-1]
		UNTIL LENGTH(ADDRESS[I])=35;
		IF LENGTH(ADDRESS[I])<35 THEN DO
		ADDRESS[I]←ADDRESS[I]&" "
		UNTIL LENGTH(ADDRESS[I])=35;
		BDDRE[I]←BDDRE[I]&ADDRESS[I];
		END;
	CHA←CHA+1;
	IF CHA=3 THEN
		BEGIN
		CHA←0;
		FOR I←1 STEP 1 UNTIL 5 DO ADDER←ADDER&BDDRE[I]&'15&'12;
		ADDER←ADDER&'15&'12;
		FOR I←1 STEP 1 UNTIL 5 DO BDDRE[I]←"";
		CSST←CSST+1;
		IF CSST=10 THEN
			BEGIN
			ADDER←ADDER[1 TO LENGTH(ADDER)-1]&'14;
			CSST←0;
			IF LENGTH(ADDER)>8000  THEN BEGIN OUT(C4,ADDER); ADDER←""; END;
			END;

		END;
	END;
	OUT(C4,ADDER);
	CLOSE(C4);

	PRT,"The mailing labels have been written into the",CRLF,"file: ",
		MONTH,"LAB which can be listed when the labels are available.",CRLF,
	    "They are in the CHESHIRE format, be sure to adjust the paper in the",CRLF,
	    "to start printing at the first line before yuo start the listing.");
END;
SETFORMAT(-4,2);
END;
COMMENT more make;
COMMENT this procedure will first make the order form, and then
	do the reporting;


SIMPLE PROCEDURE FORM;
BEGIN "FORM"
STRING DATE,LETTER,H,P,M,CS,FILED,SAVER,FILETO,TITLE;
BOOLEAN FLAGER;
REAL CHARGE,PRICE,TOTAL;
INTEGER L1,L2,RPT,YY;
SETFORMAT(5,2);
ENTER(C4,"INFORM",FLAG); USETO(C4,1);
LOOKUP(C3,"REPT.DSK",FLAG);
DEFINE BLK=⊂LINE←LINE&" ";⊃;
DEFINE PUT=⊂LETTER←LETTER&LINE&'15&'12; L1←L1+1; LINE←"";⊃;

PRT,"ENTER THE CUTOFF DATE FOR ORDERS *"); TTIN;
DATE←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];

COMMENT make the leader information;
L1←1; LINE←" ";
LETTER←"                STANFORD COMPUTER SCIENCE REPORT ORDER FORM"&'15&'12; PUT;
LINE←"     To order reports, or change your mailing address,return this sheet by";
PUT;
LINE←DATE&" checking the reports you wish to receive."; PUT; PUT;


COMMENT process the report entries;
I←1; PGIN;
DO BEGIN SCIN; END UNTIL ((EQU(LINE[17 TO 17],"*")) OR (EQU(LINE[8 TO 10],"END")));
IF EQU(LINE[8 TO 10],"END") THEN BEGIN PRT,"ERROR - THERE IS NO OPEN REPT.DSK");
			RETURN; END;
I←CVD(LINE[2 TO 6]); PGIN;
RPT←CVD(LINE[26 to 29]);
LINE←"     HARDCOPY					  MICROFICHE"; PUT;

FILED←"";
FOR I←1 STEP 1 UNTIL RPT DO
	BEGIN
	DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(LINE[1 TO 1],"*");
	FILED←FILED&LINE;
	CS←SCAN(LINE,8,BRCHAR);
	H←LOP(LINE);
	IF EQU(LINE[2 TO 5],"0000") THEN HARD[I]←0 ELSE HARD[I]←1;
	DO DUM←LOP(LINE) UNTIL EQU(LINE[3 TO 3],".");
	P←LINE[1 TO 5];
	M←LINE[7 TO 7];
	IF EQU(LINE[9 TO 12],"0000") THEN MIKE[I]←0 ELSE MIKE[I]←1;

	LINE←H&". ___ "&CS;
	L2←LENGTH(LINE);  FOR J←L2 STEP 1 UNTIL 33 DO BLK;
	IF HARD[I]=0 THEN LINE←H&". NOT AVAILABLE" ELSE
	LINE←LINE&"$"&P;
	L2←LENGTH(LINE);  FOR J←L2 STEP 1 UNTIL 44 DO BLK;
	IF MIKE[I]=0 THEN LINE←LINE&M&". NOT AVAILABLE" ELSE
		BEGIN
		LINE←LINE&M&". ___ "&CS;
		L2←LENGTH(LINE);  FOR J←L2 STEP 1 UNTIL 70 DO BLK;
		LINE←LINE&" FREE";
		END;
	PUT;
	END;
        PUT;

COMMENT trailer for the order form;
LINE←"Please do not send money with your order, microfiche are free of charge.";
PUT;
LINE←"Check here __ to change your address, print changes on the back of this form.";
PUT;
LINE←"__________________________________________________________________________________"; PUT;

COMMENT  this section will put the return address on the bottom of the form
	so that it can be used as a mailer;
DEFINE MOV=⊂ FOR I←LENGTH(LINE) STEP 1 UNTIL 70 DO BLK;⊃;
DEFINE MOVD=⊂LINE←"";  FOR I←1 STEP 1 UNTIL 45 DO BLK;⊃;
FOR I←L1 STEP 1 UNTIL 41 DO PUT;
LINE←"__________________________________________________________________________________"; PUT; PUT;PUT;
      LINE←LINE&"COMPUTER SCIENCE DEPARTMENT"; 
MOV;  LINE←LINE&"AFFIX"; PUT;
      LINE←LINE&"STANFORD,CAL 94305"; 
MOV;  LINE←LINE&"POSTAGE"; PUT;
FOR I←1 STEP 1 UNTIL 6 DO PUT;
MOVD; LINE←LINE&PAT; PUT;
MOVD; LINE←LINE&"LIBRARY AND PUBLICATIONS COMMITTEE"; PUT;
MOVD; LINE←LINE&"COMPUTER SCIENCE DEPARTMENT"; PUT;
MOVD; LINE←LINE&"STANFORD UNIVERSTY"; PUT;
MOVD; LINE←LINE&"STANFORD, CALIFORNIA  94305"; PUT;
LETTER←LETTER&'14;

COMMENT now input it into the file as many times as you wany copies;
FOR I←1 STEP 1 UNTIL COPIES DO
OUT(C4,LETTER);

COMMENT more make   the report;

SETFORMAT(4,2);
YY←0;
LETTER←""; PUT; PUT; PUT;
LINE←"TO: LIBRARY AND PUBLICATIONS COMMITTEE"; PUT; PUT;
LINE←"SUBJECT: "&MONTH&" ABSTRACT AND MAILING SUMMARY"; PUT; PUT;
LINE←"FROM: "&PAT; PUT; PUT; PUT;
LINE←"There are a total of "&CVS(RPT)&" reports to be offered this month."; PUT;
LINE←"The order cutoff date is "&DATE&".  The following reports were offered:";
PUT; PUT; 
FILETO←FILED;
FOR I←1 STEP 1 UNTIL RPT DO
	BEGIN
	LINE←SCAN(FILED,3,BRCHAR);
	PUT;
	END;
PUT; PUT; PUT; 
LINE←"SUMMARY OF ABSTRACTS MAILED:"; PUT; PUT;
LINE←"     TOTAL     "&CVS(NUMBER-TOT); PUT;
DEFINE OVER=⊂FOR I←(45-LENGTH(LINE)) DO BLK;⊃;
LINE←"        US  "&CVS(USA); OVER;
LINE←LINE&"       ONR  "&CVS(ONR); PUT;
LINE←"   FOREIGN  "&CVS(FNR); OVER;
LINE←LINE&"      ARPA  "&CVS(ARP); PUT;
LINE←"      USSR  "&CVS(RUS); OVER;
LINE←LINE&" AUTOMATIC  "&CVS(AUT); PUT;
LINE←"     IDMAI  "&CVS(IDM); OVER;
LINE←LINE&"      FREE  "&CVS(FRE); PUT; PUT; PUT;
SETFORMAT(-4,2);

COMMENT determine who is accountable;
LINE←"ACCOUNTING DATA"; PUT;
LINE←"          ACCOUNT         REPORT                 PERCENT           TOTAL PCT"; PUT; PUT;
K←0; SETFORMAT(-4,2); SAVER←LINE←""; TOTAL←CHARGE←0;

FOR I←1 STEP 1 UNTIL RPT DO
	BEGIN
	STT←SCAN(FILETO,9,BRCHAR);
	TITLE←STT←SCAN(FILETO,8,BRCHAR);
	STT←FILED[13 TO 19];
	PRICE←REALSCAN(STT,BRCHAR);
	TOTAL←TOTAL+PRICE;
   	STT←SCAN(FILETO,8,BRCHAR);
   	STT←SCAN(FILETO,8,BRCHAR);
   
		COMMENT we now have an account to process in stt;
	WHILE LOOKING DO
		BEGIN
		FLAGER←FALSE;
		STT←SCAN(FILETO,10,BRCHAR);
   		LINE←"          ";
		LINE←LINE&STT; FOR J←LENGTH(LINE) STEP 1 UNTIL 25 DO BLK;
		SETFORMAT(5,2);
		LINE←LINE&TITLE;
                FOR J←LENGTH(LINE) STEP 1 UNTIL 45 DO BLK;
		LINE←LINE&" "&CVS(CVD(FILETO[1 TO 2])+1)&"%"; 
		RUS←CVD(FILETO[1 TO 2])+1;
		DUM←LOP(FILETO); DUM←LOP(FILETO);
		DUM←(RUS/RPT) DIV 1;
		COMMENT k is the number of accounts so far, and we will check
			to see if he is already in the file ;
		YY←YY+1;
		IF K>0 THEN
		FOR J←1 STEP 1 UNTIL YY DO
			BEGIN
			USA←((72*(J-1))+1);
			IF EQU(SAVER[USA TO USA+24],LINE[1 TO 25])  THEN
                               BEGIN
				DUM←DUM+CVD(SAVER[USA+65 TO USA+69]);
               			FLAGER←TRUE;
				LINE←"                         "&LINE[26 TO 70];
				SETFORMAT(5,2);
           			DO LINE←LINE&" " UNTIL LENGTH(LINE)=70; LINE←LINE&'15&'12;
           	                SAVER←SAVER[1 TO USA+64]&CVS(DUM)&'15&'12&LINE&SAVER[USA+72 TO 5000];
				DONE;
				END;
			END;

		COMMENT if this is the first time this month add a line for this
			sponsor;
		IF NOT FLAGER THEN
			BEGIN
			DO LINE←LINE&" " UNTIL LENGTH(LINE)=70; LINE←LINE&'15&'12;
			SETFORMAT(5,2);
			LINE←LINE[1 TO 65]&CVS(DUM)&LINE[71 TO 72];
			SAVER←SAVER&LINE;   
			K←K+1;
			END;
		IF EQU(FILETO[1 TO 1],"|") THEN DONE ELSE STT←LOP(FILETO);
		END;
     	END;
LINE←SAVER; PUT; PUT;
LINE←"The labels are in file "&MONTH[1 TO 3]&"LAB, and can be listed whenever the"; PUT;
LINE←"avery labels have been mounted on the printer by the monitor command"; PUT;
LINE←"SP "&MONTH[1 TO 3]&"LAB<cr>.  Don't forget to delete the file after listing it."; PUT;
PUT;
SETFORMAT(-4,2);
LINE←"The price was determined by operator input or at a rate of $"&CVF(PRICER); PUT;
SETFORMAT(3,2);
LINE←"per page.  There will be "&CVS(COPIES)&" masters of the order form printed."; PUT;
LETTER←LETTER&'14;
OUT(C4,LETTER);
CLOSE(C3);
CLOSE(C4);
END;
LABELS;
FORM;
PRT,"Order forms and summaries are in the file: INFORM.",CRLF);
END "MAKE";
COMMENT some HELP;

DEFINE HP=⊂PRT,CRLF,CRLF,"  HELP FOR THE MAKEML FUNCTION",CRLF,CRLF,
	"THIS PROGRAM WILL:  1. Produce the mailing labels on a ",CRLF,
	"			temporary file so you can list 	",CRLF,
	"			them on the printer.		",CRLF,
	"	             2. Produce master copies of the mailing	",CRLF,
	"			list order form.		",CRLF,
	"		     3. Build or update the files for the",CRLF,
	"			report information, and the orders received.",CRLF,
	"		     4. Provide summaries of the people	",CRLF,
	"			sent lists, and accounts responsible.",CRLF,CRLF,
	"FOR EACH MAILING OF AN ABSTRACT A NEW FILE WILL BE OPENED,",CRLF,
	"THESE ARE REFERRED TO AS MONTHLY FILES, BUT CAN BE SENT ",CRLF,
	"AT ANY INTERVAL.  ONCE A FILE IS OPENED YOU CAN CONTINUE ",CRLF,
	"TO ADD REPORTS TO IT UNTIL THE MAILING LIST AND ABSTRACT",CRLF,
	"ARE SENT AT WHICH TIME THE FILE WILL BE MARKED AS SENT AND YOU	",CRLF,
	"WILL BE ASKED -MONTH- THE NEXT TIME YOU ENTER.			",CRLF,
	"	 							",CRLF,
	"     WHEN YOU ENTER THE PROGRAM A CHECK IS MADE TO DETERMINE IF",CRLF,
	"A FILE IS ALREADY OPEN, IF NOT YOU WILL BE ASKED THE MONTH, AND ",CRLF,
	"A FILE WILL BE OPENED, IF ONE IS ALREADY OPEN YOU WILL BE ASKED",CRLF,
	"IF YOU WISH TO ADD MORE REPORTS OR MAKE THE LABELS,LIST,ETC.	",CRLF,
	"								",CRLF,
	"     ENTRIES ARE ADDED TO THE FILE THROUGH INTERACTION, IF AT	",CRLF,
	"ANY TIME YOU ARE NOT SURE OF THE PROPER RESPONSE SIMPLY TYPE ?.",CRLF,
	"								",CRLF,
	"     WHEN YOU HAVE FINISHED ADDING ENTRIES, YOU WILL BE ASKED	",CRLF,
	"IF YOU WISH TO MAIL THE LISTING, IF SO THE REPORTS WILL BE GENERATED",CRLF,
	"AND OUTPUT, AND THE FILE MARKED AS CLOSED FOR THAT MONTH.");⊃;
COMMENT MAKEML runs:
	this will determine the month of the report file to use,
	and call either BUILD or MAKE or both;

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,'54,NULL,"IAP");
SETBREAK(8,'174,NULL,"IP");
SETBREAK(9,'52,NULL,"IP");
SETBREAK(10,'56,NULL,"IP");
SETBREAK(11,'60,NULL,"IP");
SETBREAK(12,'26,NULL,"IP");


LOOKUP(C3,"REPT.DSK",FLAG);
LOOKING←TRUE;
NEW←TRUE;
I←1;
PGIN;
DO BEGIN SCIN; END UNTIL (EQU(LINE[17 TO 17],"*")) OR (EQU(LINE[8 TO 10],"END"));


COMMENT this first loop determine the month of the report,and if it already
	exists.  if the report exists the operator has the option of either 
	adding to it or publishing it, or both.  if the file does not exist
	the operator is asked for the month, and it will be opened;
WHILE LOOKING DO
	BEGIN
	IF EQU(LINE[8 TO 10],"END") THEN
		BEGIN
		PRT,"MAKEML - Enter month *");
		TTIN;  PGIN;
		DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL
                  (EQU(LINE[14 TO 16],TYPEIN[1 TO 3])) OR
		  (EQU(LINE[8 TO 10],"END"));
		MONTH←LINE[14 TO 16];
		IF EQU(LINE[8 TO 10],"END") THEN
			BEGIN
			IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
			IF EQU(TYPEIN[1 TO 4],"HELP") THEN HP;
			IF NOT EQU(TYPEIN[1 TO 4],"HELP") THEN 
			PRTERR,
			"           <cr>   TO EXIT",CRLF,
   		        "       HELP<cr>  FOR A TUTORIAL",CRLF,
			"       LLLL<cr>  MONTH TO BUILD THE MAIL LIST");
			PGIN;
			CONTINUE;
			END ELSE DONE;
		END ELSE

	COMMENT this is for already existing list;
		BEGIN
		MONTH←LINE[14 TO 16];
		PRT,"MAKEML - The ",LINE[14 TO 16]," list is open and will be used. ",
			"Enter option *");
		TTIN;  NEW←FALSE;
 	         IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
		IF EQU(TYPEIN[1 TO 4],"HELP") THEN BEGIN HP; CONTINUE; END;
		IF (NOT EQU(TYPEIN[1 TO 5],"BUILD")) AND
                   (NOT EQU(TYPEIN[1 TO 4],"MAIL")) THEN
			BEGIN
			PRTERR,
			"      	    <cr> -	to exit makeml		",CRLF,
			"	HELP<cr> -	for a brief tutorial	",CRLF,
                      	"      BUILD<cr> -	to add to the report list	",CRLF,
			"	MAIL<cr> -	to send the mail/order list");
			END ELSE DONE;
		END;
	END;
IF NOT EQU(TYPEIN[1 TO 4],"MAIL") THEN BUILD;

WHILE LOOKING DO
	BEGIN
	IF EQU(TYPEIN[1 TO 4],"MAIL") THEN DONE;
	PRT,"WOULD YOU LIKE TO MAIL THE LISTING NOW? (Y OR N)*");
	TTIN;
	IF EQU(TYPEIN[1 TO 1],'15) THEN RETURN;
	IF EQU(TYPEIN[1 TO 1],"N") THEN RETURN;
	IF EQU(TYPEIN[1 TO 1],"Y") THEN DONE;   
	IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN
	PRTERR,
	"     <cr>	to exit				",CRLF,
	"    N<cr>	to exit				",CRLF,
	"    Y<cr>      to make the mailing list,labels	",CRLF,
	"               and summaries",CRLF,
	"IF YOU DO NOT MAIL THE LIST NOW, IT WILL REMAIN OPEN",CRLF,
	"FOR ADDITIONAL REPORT ENTRIES, UNTIL MAILING TIME.");
	END;
MAKE;
END "MAKEML";
END;