/*PROGRAM
		ARP070 - HWCS A/R TELEPHONE CALL REPORT
  PROGRAMMER
		ROBERT M. WHITE
  DATE WRITTEN
		APRIL 15, 1981
  PURPOSE
		THIS ROUTINE PRINTS THE INFORMATION NECESSARY
		FOR A CONCISE CALL LIST OF ALL THE CUSTOMERS.
  INPUT
  OUTPUT
  REMARKS
		1. PRINTING IS TERMINATED IF THE ESC KEY IS
		   PRESSED AT THE END OF THE NEXT LABEL.
*/

ARP070: PROC;
/* * * *   A/R MASTER MENU PROGRAM  * * * */

/* * *  PROGRAM REPLACEMENTS * * */
%INCLUDE 'C:BTCCS.PLI';		/* BT-80 FUNCTIONS */
%INCLUDE 'C:BTERRCS.PLI';	/* BT-80 ERROR RETURN CODES */
%REPLACE FALSE BY '0'B;
%REPLACE TRUE BY '1'B;

/* * *  PROGRAM AREAS  * * */
	DCL	I BIN(7);    /* INDEX VARIABLE */
	DCL	RP CHAR(1);  /* CHAR RESPONSE */
	DCL	NRP BIN(15);  /* NUMERIC RESPONSE */
	DCL	RTN_COD BIN(7); /* SUBROUTINE RETURN CODE */
	DCL	SYSPRINT FILE; /* CONSOLE OUTPUT FILE */
	DCL	PRINTFILE FILE; /* OUTPUT PRINT FILE */
	DCL	SEL_TYPE(25) CHAR(2); /* PRINT SELECT TYPES */
	DCL	SEL_NUM BIN(7);
	DCL	FIRST_TIME BIT(1) STATIC INITIAL('0'B);
	DCL	EOF_MSTR BIT(1) STATIC INITIAL('0'B);
	DCL	NUM_MSTR BIN(7); /* 1=A ONLY, 2=A & B */
	DCL	RCD_CNT BIN(15); /* TOTAL # OF RECORDS PRINTED */
	DCL	PAGE_NUMBER BIN(7); /* PAGE NUMBER */
	DCL	LINE_NUMBER BIN(7); /* LINE NUMBER */

/* * *  COMMON DCL INCLUDES  * * */
%INCLUDE 'C:SUBS1.DCL';
%INCLUDE 'ARCOMMON.DCL';
%INCLUDE 'ARCUSTM.DCL';

/* * *  COMMON PROC INCLUDES * * */
	DCL	BTREE ENTRY(BIN(7),BIN(7),PTR,BIN(7));
	DCL	ARM070 ENTRY;	/* EXTERNAL MAPS */
%INCLUDE 'OUTZIP.PLI';
%INCLUDE 'OUTTEL.PLI';

/* * *  PRINT A RECORD.  * * */
GET_RECS: PROC;

/* DO INITIALIZATION. */
	NUM_MSTR=0;

/* READ RECORD FOR A. */
READ_REC_A:
	CALL BTREE(BT_READN,IDX1,IOCB1P,RTN_COD);
	IF RTN_COD=0 THEN
	   NUM_MSTR=1;
	ELSE
	   DO;
	      CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
	      EOF_MSTR='1'B;
	      RETURN;
	   END;

/* SELECT THE RECORD. */
	IF SEL_NUM=0 THEN
	   RETURN;
	DO I=1 TO SEL_NUM;
	   IF SEL_TYPE(I)=REC1.CSSTAT THEN
	      GOTO GET_RECS_END;
	END;
	GOTO READ_REC_A;	/* DIDN'T FIND THE TYPE SO SKIP IT. */

/* RETURN TO CALLER. */
GET_RECS_END:
	RETURN;
	END GET_RECS;

/* * *  PRINT THE HEADINGS.  * * */
PRNT_HDNG: PROC;

/* BUMP COUNTS. */
	LINE_NUMBER=0;
	PAGE_NUMBER=PAGE_NUMBER+1;

/* PRINT THE HEADING LINES. */
	PUT FILE(PRINTFILE) PAGE;
	PUT FILE(PRINTFILE) SKIP(3)
		EDIT('ARP070','H & W COMPUTER SYSTEMS, INC.')
		    (X(5),A(6),X(22),A(28));
	PUT FILE(PRINTFILE) SKIP 
		EDIT(CURDAT,'CUSTOMER CALL LIST','PAGE',PAGE_NUMBER)
		    (X(5),A(08),X(23),A(18),X(15),A(4),F(4));
	PUT FILE(PRINTFILE) SKIP EDIT('ID',
		'COMPANY NAME/ BILLING CONTACT/ TECHNICAL CONTACT')
	    (X(5),A(06),X(2),A(48));
	PUT FILE(PRINTFILE) SKIP;

/* RETURN TO CALLER. */
	END PRNT_HDNG;

/* * *  PRINT A RECORD.  * * */
PRNT_RECS: PROC;

/* PRINT 1ST LINE. */
	PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSID,REC1.CSTECCMP)
				(X(5),A(06),X(2),A(32));
/* PRINT 2ND LINE. */
	PUT FILE(PRINTFILE) SKIP
		EDIT(REC1.CSBILCON,OUT_TEL(REC1.CSBILTEL),REC1.CSBILEXT)
		    (X(13),A(32),X(2),A(14),X(1),F(4));

/* PRINT 3RD LINE. */
	PUT FILE(PRINTFILE) SKIP
		EDIT(REC1.CSTECCON,OUT_TEL(REC1.CSTECTEL),REC1.CSTECEXT)
		    (X(13),A(32),X(2),A(14),X(1),F(4));

/* PRINT 4TH LINE. */
	PUT FILE(PRINTFILE) SKIP;

/* PRINT HEADER IF NECESSARY. */
	LINE_NUMBER=LINE_NUMBER+1;
	IF LINE_NUMBER>13 THEN
	   CALL PRNT_HDNG;

/* RETURN TO CALLER. */
	RETURN;
	END PRNT_RECS;

/* * *  START OF MAIN PROGRAM  * * */
MAIN_MENU:
	BEGIN;
	CALL ARM070;		/* DISPLAY BACKGROUND. */
	CALL GETB15(06,23,NRP,0,1,RTN_COD); /* GET THE INPUT NUMBER. */
	GOTO MAIN_FUNC(NRP);	/* PERFORM THE FUNCTION. */
	END; /* MAIN_MENU */

/* * *  RETURN TO MAIN MENU  * * */
MAIN_FUNC(00):
	BEGIN;
	CALL CLRSCRN;
	CALL PUTMSG(1,1,'RETURNING TO MASTER MENU...');
	RETURN;
	END;

/* * *  PRINT THE REPORT  * * */
MAIN_FUNC(01):
	BEGIN;

/* GET THE STATUS CODES USED FOR RECORD SELECTION. */
	SEL_NUM=0;
	DO I=1 TO 50;
	  CALL EOL(24,1);
	  CALL PUTMSG(24,1,'DO YOU WISH TO ENTER A SELECTION CODE(Y/N)?');
	  CALL GETSTR(24,45,1,ADDR(RP),RTN_COD);
	  IF RP~='Y' THEN
	     GOTO SEL_END;
	  CALL EOL(24,1);
	  CALL PUTMSG(24,1,'ENTER SELECTION CODE:');
	  SEL_NUM=SEL_NUM+1;
	  CALL GETSTR(24,23,2,ADDR(SEL_TYPE(SEL_NUM)),RTN_COD);
	END;
SEL_END:

/* OPEN THE PRINT FILE AND PRINT THE FIRST HEADING. */
	OPEN FILE(PRINTFILE) PRINT PAGESIZE(0) LINESIZE(132)
	     TITLE('$LST');

/* SETL TO THE FIRST MEMBER. */
	EOF_MSTR='0'B;
	DO I=1 TO LENGTH(REC1.CSID);	/* FORCE KEY TO LOW VALUES. */
	   SUBSTR(REC1.CSID,I,1)=ASCII(0);
	END;
	CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD);
	IF RTN_COD=0 | RTN_COD=BT_KEYNOTFND THEN
	   ;
	ELSE
	   DO;
	      CALL PUTERR('LOCATE RETURN CODE ='||RTN_COD||'.');
	      GOTO PRINT_END;
	   END;

/* PRINT THE DATA FROM THE FILE. */
	RCD_CNT=0;
	PUT SKIP LIST('PRINTING THE REPORT...');
	PAGE_NUMBER=0;
	CALL PRNT_HDNG;		/* PRINT INITIAL HEADINGS. */
PRINT_LOOP:
	DO WHILE(EOF_MSTR='0'B);
	  CALL GET_RECS;
	  IF EOF_MSTR='0'B THEN
	    DO;
	      CALL PRNT_RECS;
	      RCD_CNT=RCD_CNT+1;
	    END;
	  RP=CONINP();
	  IF RP=ASCII(27) THEN  /* OPERATOR INTERVENTION VIA ESC */
	     DO;
	       EOF_MSTR='1'B;
	     END;
	END;

/* RETURN TO CALLER. */
PRINT_END:
	PUT FILE(PRINTFILE) SKIP;
	PUT FILE(PRINTFILE) SKIP LIST('RECORDS PRINTED:',RCD_CNT);
	PUT FILE(PRINTFILE) SKIP;
	PUT FILE(PRINTFILE) PAGE;
	CLOSE FILE(PRINTFILE);
	GOTO MAIN_MENU;
	END;

	END ARP070;