CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol049/arp030.pli

Text File | 1984-04-29 | 6KB | 229 lines

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