perm filename CMONEY.SAI[MNT,CSR] blob sn#233863 filedate 1976-08-29 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	CMONEY
C00007 00003	the HASHCK procedure
C00009 00004	the ORDER procedure
C00013 00005	more order     file insert
C00017 00006	the AMOUNT procedure
C00019 00007	the ADDAMT procedure
C00023 00008	CMONEY runs
C00028 ENDMK
C⊗;
COMMENT CMONEY;

ENTRY;
BEGIN

INTERNAL PROCEDURE CMONEY;
BEGIN "CMONEY"

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

REAL OWETAX;
INTEGER I,J,K,DUM,PGG,COUNTER,NUMM,LIKENUM;
STRING ARRAY LIKEHASH[0:NUMBER+2];
STRING MONTH,AMT,ESTRING,JK;
BOOLEAN ALOOK,BLOOK,CURRENT,CHANGE;
FORWARD SIMPLE PROCEDURE AMOUNT;
FORWARD SIMPLE PROCEDURE HASHCK;

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);⊃;

DEFINE INSERT=⊂PTOSTR(PL,ESTRING); ESTRING←'175; PTOSTR(PL,ESTRING);
	STT←PTYIN(PL,4,BRCHAR); JK←PTYALL(PL);⊃;
DEFINE RET=⊂IF EQU(TYPEIN[1 TO 1],'15) THEN⊃;
DEFINE QUEST=⊂IF (EQU(TYPEIN[1 TO 1],"?")) OR (EQU(TYPEIN[1 TO 4],"HELP")) THEN BEGIN
	PRTERR,	"    ?<cr>   WILL PRINT YOUR OPTIONS",CRLF,
		" HELP<cr>   WILL PROVIDE SOME HELP",CRLF,
		"     <cr>   "⊃;
COMMENT this is help for csord;
DEFINE HPORD=⊂PRT,
       "This procedure will process incoming orders.  It will iteratively:",CRLF,
       "	1. Check the hash code and provide a search if",CRLF,
       "	   the hash is not available.",CRLF,
       "	2. Process the orders as they are received.",CRLF,
       "	3. Optionally process any money sent with the order.",CRLF,CRLF,
       "Once all of the orders are received for the session the procedure",CRLF,
       "will update ORDER.DSK, and inform the operator if any of the",CRLF,
       "reports have been depleted during this session.");⊃;
COMMENT this is help for csrecd;
DEFINE HPPAY=⊂PRT,
	"This procedure will process payment for reports that have been ",CRLF,
	"sent out.  It first checks the HASH CODE, if no match is found	",CRLF,
	"a search will be performed.  Next it asks the amount received,",CRLF,
	"and updates the charge balance for the customer.  You will be 	",CRLF,
	"informed of the balance.					");⊃;

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 HASHCK procedure;

SIMPLE PROCEDURE HASHCK;
BEGIN "HASHCK"
COMMENT this procedure receives the hashcode, and checks to be sure
	that it is in the file;

WHILE BLOOK DO 
	BEGIN
	PRT,"HASH CODE *"); TTIN;  HASH←"";
	RET RETURN;
	IF EQU(TYPEIN[1 TO 4],"HELP") AND (SWITCH) THEN HPORD;
	IF EQU(TYPEIN[1 TO 4],"HELP") AND (NOT SWITCH) THEN HPPAY;
	QUEST,"WILL PROCESS THE INPUTS (IF ANY) AND RETURN TO CSREPT",CRLF,
		"HHHHH<cr>   THE FIVE DIGIT HASH CODE.");
		CONTINUE;
		END;

	IF LENGTH(TYPEIN)≠6 THEN
		BEGIN
		PRT,"ERROR - The hash code should be 5 characters.");
		CONTINUE;
		END;

	HASH←TYPEIN[1 TO 5];
	UP←FALSE;
	BILOOK;	IF UP THEN PRT,"SORRY ",HASH," is not in the file.");
		IF UP THEN SEARCH;
		IF UP THEN CONTINUE;
	FINDER;
	PRT,"IS ",ADDRESS[1][1 TO LENGTH(ADDRESS[1])-1]," THE CORRECT CUSTOMER? (Y OR N)*");
	TTIN;
	IF EQU(TYPEIN[1 TO 1],"Y") THEN DONE;
	IF EQU(TYPEIN[1 TO 1],"N") THEN CONTINUE;
	TYPEIN←"";
	PRT,"This verification is necessary in order to assure the the proper customer",crlf,
	    "is processed for ordering and accounting purposes.");
	END;

END "HASHCK";
COMMENT the ORDER procedure;

PROCEDURE ORDER;
BEGIN "ORDER"
COMMENT this procedure will process incoming orders.  it will iteratively:
		1. check the hash code and provide a search if
		   the hash is not available
		2. process the orders recieved by the individual.
		3.optionally process any money sent with the order.
	Once all of the orders are received for the session the procedure
	will update ORDER.DSK, and inform the operator if any of the
	reports have been depleted during this session;

INTEGER KK,V;
STRING BUILDER;
BOOLEAN ERR;
INTEGER ARRAY ORDERS[1:I+1];
FOR J←1 STEP 1 UNTIL I+1 DO ORDERS[J]←0;
BUILDER←"";

COMMENT ALOOK is the loop for processing the incoming orders.
	After checking the hash it inputs the order and if the inputs
	match order characters it adds the order to BUILDER for later
	input into the file.  It also records the stock counts to 
	update REPT.DSK, and calls AMOUNT to process funds;

WHILE ALOOK DO
	BEGIN
	HASHCK;
	IF (EQU(TYPEIN[1 TO 1],'15)) AND (EQU(HASH,"")) THEN
		BEGIN IF COUNTER>0 THEN DONE ELSE RETURN; END;

	COMMENT input and process the order;
	WHILE BLOOK DO
		BEGIN
		PRT,"REPORT NUMBERS #"); TTIN; RET DONE;
		QUEST,"WILL CAUSE THE ORDER TO BE FLUSHED",CRLF,
			"  ###<cr>   THE ORDER NUMBERS (OR LETTERS) OF REPORTS");
		CONTINUE;  END;
		STT←TYPEIN[1 TO (LENGTH(TYPEIN)-1)];
		V←LENGTH(TYPEIN);
		FOR J←1 STEP 1 UNTIL V-1 DO
                         BEGIN
			ERR←FALSE;
			K←LOP(TYPEIN); K←K-'60; IF K>9 THEN K←K-7;
			IF K>I THEN
				BEGIN
                 		PRT,"ERROR - ONE OF THE REPORTS THAT YOU REQUESTED DOES NOT EXITS.",CRLF,
				 "THE ORDER WILL BE DISCARDED, TRY AGAIN.");
				ERR←TRUE;
				DONE;
				END;
              		ORDERS[K]←ORDERS[K]+1;
			END;
		IF ERR THEN CONTINUE;
		BUILDER←BUILDER&"*"&HASH[1 TO 5]&STT&'15&'12;
		COUNTER←COUNTER+1;
		PRT,"WAS ANY MONEY SENT WITH THE ORDER? (Y OR N)*");
		TTIN; IF EQU(TYPEIN[1 TO 1],"Y") THEN AMOUNT;
		DONE;
		END;
	END;
COMMENT more order     file insert;

ETVIN;
COUNT←COUNT+COUNTER;
WHILE ALOOK DO
	BEGIN
	COMMENT this is the section that will use E to add the orders
		to the ORDER.DSK file;
	CLOSE(C3);
	PTOSTR(PL,"ET ORDER.DSK"&'15&'12);
	STT←PTYIN(PL,7,BRCHAR);
	SETFORMAT(-4,2);
	IF CURRENT THEN
	ESTRING←CVS(PGG)&"PDI"&MONTH[1 TO 3]&"*ORDERS="&CVS(COUNT)&" REPORTS="&NUMM&'15&'12 ELSE
	ESTRING←CVS(PGG)&"PDI"&MONTH[1 TO 3]&" ORDERS="&CVS(COUNT)&" REPORTS="&NUMM&'15&'12;
	INSERT;
	WHILE BLOOK DO
		BEGIN
		ESTRING←"∞LI";
		FOR I←1 STEP 1 UNTIL 10 DO
			BEGIN
		        STT←SCAN(BUILDER,1,BRCHAR);
			ESTRING←ESTRING&STT&'12;
			IF LENGTH(BUILDER)<7 THEN DONE;
			END;
		INSERT;
		IF LENGTH(BUILDER)<7 THEN DONE;
		END;
	PTOSTR(PL,"E");
	STT←PTYIN(PL,5,BRCHAR);
     	DONE;
	END;

COMMENT this is the inventory check;
COUNTER←0; BUILDER←"";
CLOSE(C4);
LOOKUP(C3,"REPT.DSK",FLAG);
ENTER(C4,"REPT.DSK",FLAG); USETO(C4,0);
USETI(C3,1); I←1; PGIN;
DO LINE←SCAN(PAGE,1,BRCHAR) UNTIL EQU(LINE[14 TO 16],MONTH[1 TO 3]);
DO BEGIN PAGE←INPUT(C3,2); IF NOT EQU(PAGE[1 TO 3],MONTH[1 TO 3]) THEN
	BUILDER←BUILDER&PAGE; END UNTIL EQU(PAGE[1 TO 3],MONTH[1 TO 3]);
SCIN;  BUILDER←BUILDER&LINE;
KK←NUMM-'60;  IF KK>9 THEN KK←KK-7;
SETFORMAT(-4,2);
FOR I←1 STEP 1 UNTIL KK DO
	BEGIN
	IF (I MOD 2)=1 THEN BEGIN SCIN;
			STT←SCAN(LINE,8,BRCHAR);
			BUILDER←BUILDER&STT; END;
        IF ORDERS[I]≠0 THEN
		BEGIN
		IF (I MOD 2)=1 THEN V←8 ELSE V←26;
		LINE←LINE[1 TO V-1]&CVS(ORDERS[I]+CVD(LINE[V TO V+3]))&LINE[V+4 TO 100];
		IF NOT EQU(LINE[V-5 TO V-2],"NONO") AND
	           CVD(LINE[V TO V+3])=CVD(LINE[V-5 TO V-2]) THEN PRT,"REPORT ",STT," HAS JUST RUN OUT");
		END;
	IF (I MOD 2)=0 THEN BEGIN BUILDER←BUILDER&LINE;  LINE←""; END;
	END;
BUILDER←BUILDER&PAGE;
DO BEGIN PAGE←INPUT(C3,2); BUILDER←BUILDER&PAGE; END UNTIL EQU(PAGE[1 TO 3],"DEC");
OUT(C4,BUILDER);
CLOSE(C3);  CLOSE(C4);
PTOSTR(PL,"ET REPT.DSK"&'15&'12);
STT←PTYIN(PL,11,BRCHAR);
PTOSTR(PL,"YE");
STT←PTYIN(PL,5,BRCHAR);
ETVOUT;
END "ORDER";
COMMENT the AMOUNT procedure;

SIMPLE PROCEDURE AMOUNT;
BEGIN
COMMENT this is the procedure that processes the funds as they are received.
	It will check to assure the hash exists and offer a search if not.
	Then it will save the amount and hash to be processed by addamt after
	all of the changes have been made;
REAL AMT,I1;

WHILE ALOOK DO
	BEGIN
	SETFORMAT(-5,2);
	PRT,"AMOUNT RECEIVED $");  TTIN;
	QUEST,"WILL CANCEL CURRENT CUSTOMER'S PROCESSING.",CRLF,
		"##.##<cr>   THE AMOUNT OF MONEY SENT.");
	CONTINUE; end;
	RET RETURN;
 
	COMMENT This will save the data for later use (page number,line number,
		hashcode, and value;
	LIKENUM←LIKENUM+1;
	LIKEHASH[LIKENUM]←HASH[1 TO 5];
	LIKEHASH[LIKENUM]←LIKEHASH[LIKENUM]&TYPEIN[1 TO LENGTH(TYPEIN)-1];
	AMT←REALSCAN(TYPEIN,BRCHAR); 
	PRT,"IS $",CVF(AMT)," THE CORRECT AMOUNT? (Y OR N)*"); TTIN;
	IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN BEGIN LIKENUM←LIKENUM-1; CONTINUE; END;
	CHANGE←TRUE;

	COMMENT If tax is to be witheld then do it;
	IF CVD(HASH[1 TO 3])>899 AND CVD(HASH[1 TO 3])<967 AND EQU(ADDRESS[0][2 TO 2]," ") THEN
		BEGIN
		I1←AMT*TAX*((1.0)/(TAX+1.0));
		OWETAX←OWETAX+I1;
		END;
	DONE;
	END;
END;
COMMENT the ADDAMT procedure;

SIMPLE PROCEDURE ADDAMT;
BEGIN
INTEGER L1,L2,L3,PAG,TOTAL;
REAL R1,R2;
STRING S1,S2,S3;
BOOLEAN LP,LLP;

COMMENT Now update the debits in the addfil, and the amount of tax due in lbdata
	this first part is the address file update;
ETVIN;
PTOSTR(PL,"ET ADDFIL.DSK"&'15&'12);
STT←PTYIN(PL,7,BRCHAR);
TOTAL←LIKENUM;
  
COMMENT first the address file;
FOR LIKENUM←1 STEP 1 UNTIL TOTAL DO
	BEGIN
	HASH←LIKEHASH[LIKENUM];
	LIKEHASH[LIKENUM]←LIKEHASH[LIKENUM][6 TO 20]&'12;
        BILOOK; FINDER;

	COMMENT first configure the new line 0 to insert;
	L1←LENGTH(ADDRESS[0]);
	S2←(ADDRESS[0][L1-7 TO L1-2])&'12;
	R2←REALSCAN(S2,BRCHAR);
 	IF NOT EQU(ADDRESS[0][L1-1 TO L1-1]," ") THEN R2←(-1)*R2;
	R1←REALSCAN(LIKEHASH[LIKENUM],BRCHAR); R1←(-1.0)*R1;
	R1←R1+R2;
	SETFORMAT(-5,2);
	S3←CVF(ABS(R1)); WHILE EQU(S3[1 TO 1]," ") DO DUM←LOP(S3);
	IF LENGTH(S3)≠6 THEN
	FOR L3←LENGTH(S3) STEP 1 UNTIL 5 DO S3←"0"&S3;
	ADDRESS[0]←ADDRESS[0][1 TO L1-8]&S3;
	IF R1<0 THEN ADDRESS[0]←ADDRESS[0]&"-"&'15&'12 ELSE
                     ADDRESS[0]←ADDRESS[0]&" "&'15&'12;

	COMMENT now its time to put it in;
	ESTRING←CVS(PG)&"P"&CVS(JMP)&"LDI"&ADDRESS[0];
	INSERT;
	END;

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

COMMENT now update the taxes;
IF OWETAX>0.0 THEN
	BEGIN
	LP←LLP←TRUE;
	CLOSE(C3); CLOSE(C4);
	LOOKUP(C3,"LBDATA.DSK",FLAG);
	ENTER(C4,"LBDATA.DSK",FLAG);
	USETI(C3,1);
	I←0;  STT←"";
	DO BEGIN I←I+1; PGIN; END UNTIL EQU(PAGE[1 TO 4],"DATA");
	DO BEGIN SCIN; STT←STT&LINE&'12 ;END UNTIL EQU(LINE[4 TO 7],"NAME");
	SCIN;
	S1←LINE[8 TO 200];  R1←REALSCAN(S1,BRCHAR);
	R1←R1+OWETAX;
	LINE←CVF(R1)&S1&'12&PAGE; 
	WHILE EQU(LINE[1 TO 1]," ") DO DUM←LOP(LINE);
	PAGE←STT&"8. OWE="&LINE;

	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;
END;
COMMENT CMONEY runs;

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

CURRENT←ALOOK←BLOOK←TRUE;
CHANGE←FALSE;
LIKENUM←0;  OWETAX←0.0;

COMMENT the SWITCH loop is to process orders as they are received;
WHILE SWITCH DO
	BEGIN
	CLOSE(C3);
	LOOKUP(C3,"ORDER.DSK",FLAG);
	I←1; PGIN;
	CURRENT←TRUE;
	PRT,"ORDER - MONTH *"); TTIN; RET RETURN;
	DO BEGIN SCIN; END UNTIL (EQU(LINE[14 TO 16],TYPEIN[1 TO 3]) OR
				 EQU(LINE[8 TO 10],"END"));
	IF EQU(TYPEIN[1 TO 4],"HELP") THEN BEGIN HPORD; CONTINUE; END;
	IF EQU(LINE[8 TO 10],"END") THEN
		BEGIN
		PRTERR,"INPUT WAS NOT A MONTH IN THE FILE",CRLF,
		"	<cr>   TO END THE PROCESSING		",CRLF,
		"   HELP<cr>   FOR A TUTORIAL			",CRLF,
		"  LLLLL<cr>   MONTH OF THE ORDERS TO PROCESS");
		CONTINUE;
		END;
	IF NOT EQU(LINE[17 TO 17],"*") THEN
		BEGIN
		CURRENT←FALSE;
		PRT,"CAUTION THIS IS NOT THE CURRENTLY OPEN ORDER FILE!",
                    " DO YOU WISH TO CONTINUE? (Y OR N) *");
		TTIN;
		IF NOT EQU(TYPEIN[1 TO 1],"Y") THEN CONTINUE;
		END;
 	CLOSE(C3); LOOKUP(C3,"ORDER.DSK",FLAG);

	COMMENT this gathers the month, page, record number, number of reports, and calls order;
 	PGG←CVD(LINE[8 TO 12]);
	I←CVD(LINE[2 TO 6]);
	MONTH←TYPEIN[1 TO 3];
	PGIN;
	IF NOT EQU(PAGE[1 TO 3],MONTH[1 TO 3]) THEN
		BEGIN
		I←1;
		DO BEGIN PGIN; END UNTIL EQU(PAGE[1 TO 3],MONTH[1 TO 3]);
		END;
        I←PAGE[25 TO 25]-'60; IF I>9 THEN I←I-7; NUMM←PAGE[25 TO 25];
	COUNT←CVD(PAGE[12 TO 15]);
     	ORDER;
	CLOSE(C3);
        DONE;
	END;


COMMENT this is the loop that will process the payments;
WHILE NOT SWITCH DO
	BEGIN
	HASHCK;
	IF (EQU(TYPEIN[1 TO 1],'15)) AND (EQU(HASH,"")) THEN DONE;
	AMOUNT;
	END;

IF CHANGE THEN ADDAMT;
END "CMONEY";
END;