/*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;

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.