/*PROGRAM
		ARP020 - HWCS A/R TECHNICAL LABEL REPORT
  PROGRAMMER
		ROBERT M. WHITE
  DATE WRITTEN
		APRIL 15, 1981
  PURPOSE
		THIS ROUTINE PRINTS LABELS FOR THE TECHNICAL
		CONTACTS IN THE A/R CUSTOMER FILE.
  INPUT
  OUTPUT
  REMARKS
		1. PRINTING IS TERMINATED IF THE ESC KEY IS
		   PRESSED AT THE END OF THE NEXT LABEL.
*/

ARP020: 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 */


/* * *  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	ARM020 ENTRY;	/* EXTERNAL MAPS */
%INCLUDE 'OUTZIP.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 A RECORD.  * * */
PRNT_RECS: PROC;
	DCL NUM_BLANK BIN(7);	/* NUMBER OF BLANK LINES */

/* DO INITIALIZATION. */
	NUM_BLANK=0;

/* PRINT 1ST LINE. */
	PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSTECCON) (A(32));

/* PRINT 2ND LINE. */
	IF REC1.CSTECCMP~=' ' THEN
	   DO;
	      PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSTECCMP) (A(32));
	   END;
	ELSE
	   NUM_BLANK=NUM_BLANK+1;

/* PRINT 3RD LINE. */
	IF REC1.CSTECAD1~=' ' THEN
	   DO;
	      PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSTECAD1) (A(32));
	   END;
	ELSE
	   NUM_BLANK=NUM_BLANK+1;

/* PRINT 4TH LINE. */
	IF REC1.CSTECAD2~=' ' THEN
	   DO;
	      PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSTECAD2) (A(32));
	   END;
	ELSE
	   NUM_BLANK=NUM_BLANK+1;

/* PRINT 5TH LINE. */
	PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSTECAD3,OUT_ZIP(REC1.CSTECZIP))
	    (A(23),X(1),A(10));
	PUT FILE(PRINTFILE) SKIP;

/* PRINT FILLER/SEPERATOR LINES. */
	DO I=1 TO NUM_BLANK;
	   PUT FILE(PRINTFILE) SKIP;
	END;

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

/* * *  START OF MAIN PROGRAM  * * */
MAIN_MENU:
	BEGIN;
	CALL ARM020;		/* 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;

/* ALIGN LABELS. */
ALN_LBL:
	CALL EOL(24,1);
	CALL PUTMSG(24,1,'PRINT TEST LABEL (Y/N):');
	CALL GETSTR(24,25,1,ADDR(RP),RTN_COD);
	IF RP~='Y' THEN
	   GOTO END_ALN;
	PUT FILE(PRINTFILE) SKIP LIST('1111111111111111111111111111111');
	PUT FILE(PRINTFILE) SKIP LIST('2222222222222222222222222222222');
	PUT FILE(PRINTFILE) SKIP LIST('3333333333333333333333333333333');
	PUT FILE(PRINTFILE) SKIP LIST('4444444444444444444444444444444');
	PUT FILE(PRINTFILE) SKIP LIST('5555555555555555555555555555555');
	PUT FILE(PRINTFILE) SKIP;
	GOTO ALN_LBL;
END_ALN:

/* PRINT THE DATA FROM THE FILE. */
	RCD_CNT=0;
	PUT SKIP LIST('PRINTING THE REPORT...');
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 ARP020;