/*PROGRAM
               ARP030 - HWCS A/R BILLING LABEL REPORT
 PROGRAMMER
               ROBERT M. WHITE
 DATE WRITTEN
               APRIL 15, 1981
 PURPOSE
               THIS ROUTINE PRINTS LABELS FOR THE BILLING
               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.
*/

ARP030: 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     ARM030 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.CSBILCON) (A(32));

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

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

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

/* PRINT 5TH LINE. */
       PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD3,OUT_ZIP(REC1.CSBILZIP))
           (A(23),X(2),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 ARM030;            /* 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 ARP030;

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.