home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol049 / arp040.pli < prev    next >
Text File  |  1984-04-29  |  8KB  |  283 lines
  1. /*PROGRAM
  2.         ARP040 - HWCS A/R CUSTOMER LIST REPORT
  3.   PROGRAMMER
  4.         ROBERT M. WHITE
  5.   DATE WRITTEN
  6.         APRIL 15, 1981
  7.   PURPOSE
  8.         THIS ROUTINE PRINTS THE INFORMATION NECESSARY
  9.         FOR A CONCISE CALL LIST OF ALL THE CUSTOMERS.
  10.   INPUT
  11.   OUTPUT
  12.   REMARKS
  13.         1. PRINTING IS TERMINATED IF THE ESC KEY IS
  14.            PRESSED AT THE END OF THE NEXT LABEL.
  15. */
  16.  
  17. ARP040: PROC;
  18. /* * * *   A/R MASTER MENU PROGRAM  * * * */
  19.  
  20. /* * *  PROGRAM REPLACEMENTS * * */
  21. %INCLUDE 'C:BTCCS.PLI';        /* BT-80 FUNCTIONS */
  22. %INCLUDE 'C:BTERRCS.PLI';    /* BT-80 ERROR RETURN CODES */
  23. %REPLACE FALSE BY '0'B;
  24. %REPLACE TRUE BY '1'B;
  25.  
  26. /* * *  PROGRAM AREAS  * * */
  27.     DCL    I BIN(7);    /* INDEX VARIABLE */
  28.     DCL    RP CHAR(1);  /* CHAR RESPONSE */
  29.     DCL    NRP BIN(15);  /* NUMERIC RESPONSE */
  30.     DCL    RTN_COD BIN(7); /* SUBROUTINE RETURN CODE */
  31.     DCL    SYSPRINT FILE; /* CONSOLE OUTPUT FILE */
  32.     DCL    PRINTFILE FILE; /* OUTPUT PRINT FILE */
  33.     DCL    SEL_TYPE(25) CHAR(2); /* PRINT SELECT TYPES */
  34.     DCL    SEL_NUM BIN(7);
  35.     DCL    FIRST_TIME BIT(1) STATIC INITIAL('0'B);
  36.     DCL    EOF_MSTR BIT(1) STATIC INITIAL('0'B);
  37.     DCL    NUM_MSTR BIN(7); /* 1=A ONLY, 2=A & B */
  38.     DCL    RCD_CNT BIN(15); /* TOTAL # OF RECORDS PRINTED */
  39.     DCL    PAGE_NUMBER BIN(7); /* PAGE NUMBER */
  40.     DCL    LINE_NUMBER BIN(7); /* LINE NUMBER */
  41.  
  42. /* * *  COMMON DCL INCLUDES  * * */
  43. %INCLUDE 'C:SUBS1.DCL';
  44. %INCLUDE 'ARCOMMON.DCL';
  45. %INCLUDE 'ARCUSTM.DCL';
  46.  
  47. /* * *  COMMON PROC INCLUDES * * */
  48.     DCL    BTREE ENTRY(BIN(7),BIN(7),PTR,BIN(7));
  49.     DCL    ARM040 ENTRY;    /* EXTERNAL MAPS */
  50. %INCLUDE 'OUTZIP.PLI';
  51. %INCLUDE 'OUTTEL.PLI';
  52.  
  53. /* * *  PRINT A RECORD.  * * */
  54. GET_RECS: PROC;
  55.  
  56. /* DO INITIALIZATION. */
  57.     NUM_MSTR=0;
  58.  
  59. /* READ RECORD FOR A. */
  60. READ_REC_A:
  61.     CALL BTREE(BT_READN,IDX1,IOCB1P,RTN_COD);
  62.     IF RTN_COD=0 THEN
  63.        NUM_MSTR=1;
  64.     ELSE
  65.        DO;
  66.           CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
  67.           EOF_MSTR='1'B;
  68.           RETURN;
  69.        END;
  70.  
  71. /* SELECT THE RECORD. */
  72.     IF SEL_NUM=0 THEN
  73.        RETURN;
  74.     DO I=1 TO SEL_NUM;
  75.        IF SEL_TYPE(I)=REC1.CSSTAT THEN
  76.           GOTO GET_RECS_END;
  77.     END;
  78.     GOTO READ_REC_A;    /* DIDN'T FIND THE TYPE SO SKIP IT. */
  79.  
  80. /* RETURN TO CALLER. */
  81. GET_RECS_END:
  82.     RETURN;
  83.     END GET_RECS;
  84.  
  85. /* * *  PRINT THE HEADINGS.  * * */
  86. PRNT_HDNG: PROC;
  87.  
  88. /* BUMP COUNTS. */
  89.     LINE_NUMBER=0;
  90.     PAGE_NUMBER=PAGE_NUMBER+1;
  91.  
  92. /* PRINT THE HEADING LINES. */
  93.     PUT FILE(PRINTFILE) PAGE;
  94.     PUT FILE(PRINTFILE) SKIP(3)
  95.         EDIT('ARP040','H & W COMPUTER SYSTEMS, INC.')
  96.             (X(5),A(6),X(25),A(28));
  97.     PUT FILE(PRINTFILE) SKIP 
  98.         EDIT(CURDAT,'CUSTOMER LIST','PAGE',PAGE_NUMBER)
  99.             (X(5),A(08),X(28),A(18),X(35),A(4),F(4));
  100.     PUT FILE(PRINTFILE) SKIP EDIT('ID',
  101.         'BILLING DATA','TECHNICAL DATA','MISCELLANEOUS')
  102.         (X(5),A(06),X(1),A(32),X(5),A(32),X(5),A(24));
  103.     PUT FILE(PRINTFILE) SKIP;
  104.  
  105. /* RETURN TO CALLER. */
  106.     END PRNT_HDNG;
  107.  
  108. /* * *  PRINT A RECORD.  * * */
  109. PRNT_DESC: PROC;
  110.  
  111. /* PRINT 1ST LINE. */
  112.     PUT FILE(PRINTFILE) SKIP EDIT('ID','BILLING CONTACT',
  113.         'TECHNICAL CONTACT','STATUS','MISCELLANEOUS')
  114.         (X(5),A(06),X(1),A(32),X(5),A(32),X(1),A(6),X(2),A(20));
  115.  
  116. /* PRINT 2ND LINE. */
  117.     PUT FILE(PRINTFILE) SKIP EDIT('BILLING COMPANY NAME',
  118.         'TECHNICAL COMPANY NAME','TERM','CURRENT AMOUNT')
  119.         (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20));
  120.  
  121. /* PRINT 3RD LINE. */
  122.     PUT FILE(PRINTFILE) SKIP EDIT('BILLING ADDRESS #1',
  123.         'TECHNICAL ADDRESS #1','BALTYP','OVER 30 AMOUNT')
  124.         (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20));
  125.  
  126. /* PRINT 4TH LINE. */
  127.     PUT FILE(PRINTFILE) SKIP EDIT('BILLING ADDRESS #2',
  128.         'TECHNICAL ADDRESS #2','PRCCOD','OVER 60 AMOUNT')
  129.         (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20));
  130.  
  131. /* PRINT 5TH LINE. */
  132.     PUT FILE(PRINTFILE) SKIP EDIT('BILLING ADDRESS #3',
  133.         'TECHNICAL ADDRESS #3','DISCNT','OVER 90 AMOUNT')
  134.         (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20));
  135.  
  136. /* PRINT 6TH LINE. */
  137.     PUT FILE(PRINTFILE) SKIP EDIT('BILLING PHONE/EXT',
  138.         'TECHNICAL PHONE/EXT','TAXCOD','LAST YEAR AMOUNT')
  139.         (X(12),A(32),X(5),A(32),X(1),A(6),X(2),A(20));
  140.  
  141. /* PRINT 7TH LINE. */
  142.     PUT FILE(PRINTFILE) SKIP;
  143.  
  144. /* PRINT HEADING IF NECESSARY. */
  145.     LINE_NUMBER=LINE_NUMBER+1;
  146.     IF LINE_NUMBER>07 THEN
  147.        CALL PRNT_HDNG;
  148.  
  149. /* RETURN TO CALLER. */
  150.     END PRNT_DESC;
  151.  
  152. /* * *  PRINT A RECORD.  * * */
  153. PRNT_RECS: PROC;
  154.  
  155. /* PRINT 1ST LINE. */
  156.     PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSID,REC1.CSBILCON,REC1.CSTECCON,
  157.                     REC1.CSSTAT,REC1.CSSPCL)
  158.         (X(5),A(06),X(1),A(32),X(5),A(32),X(5),A(2),X(2),A(20));
  159.  
  160. /* PRINT 2ND LINE. */
  161.     PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILCMP,REC1.CSTECCMP,
  162.                     REC1.CSTERM,REC1.CSCURAMT)
  163.         (X(12),A(32),X(5),A(32),X(5),A(2),X(2),P'--,---,--9.V99');
  164.  
  165. /* PRINT 3RD LINE. */
  166.     PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD1,REC1.CSTECAD1,
  167.                     REC1.CSBALTYP,REC1.CS30DAMT)
  168.         (X(12),A(32),X(5),A(32),X(5),A(1),X(3),P'--,---,--9.V99');
  169.  
  170. /* PRINT 4TH LINE. */
  171.     PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD2,REC1.CSTECAD2,
  172.                     REC1.CSPRCCOD,REC1.CS60DAMT)
  173.         (X(12),A(32),X(5),A(32),X(5),A(1),X(3),P'--,---,--9.V99');
  174.  
  175. /* PRINT 5TH LINE. */
  176.     PUT FILE(PRINTFILE) SKIP EDIT(REC1.CSBILAD3,OUT_ZIP(REC1.CSBILZIP),
  177.         REC1.CSTECAD3,OUT_ZIP(REC1.CSTECZIP),REC1.CSPRCCOD,REC1.CSOVRAMT)
  178.         (X(12),A(23),X(2),A(10),X(2),A(23),X(2),A(10),X(2),A(1),X(3),
  179.          P'--,---,--9.V99');
  180.  
  181. /* PRINT 6TH LINE. */
  182.     PUT FILE(PRINTFILE) SKIP EDIT(OUT_TEL(REC1.CSBILTEL),REC1.CSBILEXT,
  183.         OUT_TEL(REC1.CSTECTEL),REC1.CSTECEXT,REC1.CSDISC,REC1.CSLYRAMT)
  184.         (X(12),A(14),X(1),F(4),X(18),A(14),X(1),F(4),X(18),A(1),X(3),
  185.          P'--,---,--9.V99');
  186.  
  187. /* PRINT 7TH LINE. */
  188.     PUT FILE(PRINTFILE) SKIP;
  189.  
  190. /* PRINT HEADING IF NECESSARY. */
  191.     LINE_NUMBER=LINE_NUMBER+1;
  192.     IF LINE_NUMBER>07 THEN
  193.        CALL PRNT_HDNG;
  194.  
  195. /* RETURN TO CALLER. */
  196.     END PRNT_RECS;
  197.  
  198. /* * *  START OF MAIN PROGRAM  * * */
  199. MAIN_MENU:
  200.     BEGIN;
  201.     CALL ARM040;        /* DISPLAY BACKGROUND. */
  202.     CALL GETB15(06,23,NRP,0,1,RTN_COD); /* GET THE INPUT NUMBER. */
  203.     GOTO MAIN_FUNC(NRP);    /* PERFORM THE FUNCTION. */
  204.     END; /* MAIN_MENU */
  205.  
  206. /* * *  RETURN TO MAIN MENU  * * */
  207. MAIN_FUNC(00):
  208.     BEGIN;
  209.     CALL CLRSCRN;
  210.     CALL PUTMSG(1,1,'RETURNING TO MASTER MENU...');
  211.     RETURN;
  212.     END;
  213.  
  214. /* * *  PRINT THE REPORT  * * */
  215. MAIN_FUNC(01):
  216.     BEGIN;
  217.  
  218. /* GET THE STATUS CODES USED FOR RECORD SELECTION. */
  219.     SEL_NUM=0;
  220.     DO I=1 TO 50;
  221.       CALL EOL(24,1);
  222.       CALL PUTMSG(24,1,'DO YOU WISH TO ENTER A SELECTION CODE(Y/N)?');
  223.       CALL GETSTR(24,45,1,ADDR(RP),RTN_COD);
  224.       IF RP~='Y' THEN
  225.          GOTO SEL_END;
  226.       CALL EOL(24,1);
  227.       CALL PUTMSG(24,1,'ENTER SELECTION CODE:');
  228.       SEL_NUM=SEL_NUM+1;
  229.       CALL GETSTR(24,23,2,ADDR(SEL_TYPE(SEL_NUM)),RTN_COD);
  230.     END;
  231. SEL_END:
  232.  
  233. /* OPEN THE PRINT FILE AND PRINT THE FIRST HEADING. */
  234.     OPEN FILE(PRINTFILE) PRINT PAGESIZE(0) LINESIZE(132)
  235.          TITLE('$LST');
  236.  
  237. /* SETL TO THE FIRST MEMBER. */
  238.     EOF_MSTR='0'B;
  239.     DO I=1 TO LENGTH(REC1.CSID);    /* FORCE KEY TO LOW VALUES. */
  240.        SUBSTR(REC1.CSID,I,1)=ASCII(0);
  241.     END;
  242.     CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD);
  243.     IF RTN_COD=0 | RTN_COD=BT_KEYNOTFND THEN
  244.        ;
  245.     ELSE
  246.        DO;
  247.           CALL PUTERR('LOCATE RETURN CODE ='||RTN_COD||'.');
  248.           GOTO PRINT_END;
  249.        END;
  250.  
  251. /* PRINT THE DATA FROM THE FILE. */
  252.     RCD_CNT=0;
  253.     PUT SKIP LIST('PRINTING THE REPORT...');
  254.     PAGE_NUMBER=0;
  255.     CALL PRNT_HDNG;        /* PRINT INITIAL HEADINGS. */
  256.     CALL PRNT_DESC;        /* PRINT REPORT DESCRIPTION. */
  257. PRINT_LOOP:
  258.     DO WHILE(EOF_MSTR='0'B);
  259.       CALL GET_RECS;
  260.       IF EOF_MSTR='0'B THEN
  261.         DO;
  262.           CALL PRNT_RECS;
  263.           RCD_CNT=RCD_CNT+1;
  264.         END;
  265.       RP=CONINP();
  266.       IF RP=ASCII(27) THEN  /* OPERATOR INTERVENTION VIA ESC */
  267.          DO;
  268.            EOF_MSTR='1'B;
  269.          END;
  270.     END;
  271.  
  272. /* RETURN TO CALLER. */
  273. PRINT_END:
  274.     PUT FILE(PRINTFILE) SKIP;
  275.     PUT FILE(PRINTFILE) SKIP LIST('RECORDS PRINTED:',RCD_CNT);
  276.     PUT FILE(PRINTFILE) SKIP;
  277.     PUT FILE(PRINTFILE) PAGE;
  278.     CLOSE FILE(PRINTFILE);
  279.     GOTO MAIN_MENU;
  280.     END;
  281.  
  282.     END ARP040;
  283.