home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol049 / arp060.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  4.2 KB  |  174 lines
  1. /*PROGRAM
  2.         ARP060 - HWCS ACCOUNTS RECEIVABLE CUSTOMER FILE LOAD
  3.   PROGRAMMER
  4.         ROBERT M. WHITE
  5.   DATE WRITTEN
  6.         APRIL 15, 1981
  7.   PURPOSE
  8.         THIS ROUTINE LOADS THE CUSTOMER FILE FROM A
  9.         PREVIOUSLY SAVED SEQUENTIAL FILE.  THIS COM-
  10.         PLEMENTS THE CUSTOMER FILE OFFLOAD PROGRAM.
  11.   INPUT
  12.   OUTPUT
  13.   REMARKS
  14. */
  15.  
  16. ARP060: PROC;
  17. /* * * *   A/R MASTER MENU PROGRAM  * * * */
  18.  
  19. /* * *  PROGRAM REPLACEMENTS * * */
  20. %INCLUDE 'C:BTCCS.PLI';        /* BT-80 FUNCTIONS */
  21. %INCLUDE 'C:BTERRCS.PLI';    /* BT-80 ERROR RETURN CODES */
  22. %REPLACE FALSE BY '0'B;
  23. %REPLACE TRUE BY '1'B;
  24.  
  25. /* * *  PROGRAM AREAS  * * */
  26.     DCL    I BIN(7);    /* INDEX VARIABLE */
  27.     DCL    RP CHAR(2);  /* CHAR RESPONSE */
  28.     DCL    NRP BIN(15);  /* NUMERIC RESPONSE */
  29.     DCL    RTN_COD BIN(7); /* SUBROUTINE RETURN CODE */
  30.     DCL    SYSPRINT FILE; /* CONSOLE OUTPUT FILE */
  31.     DCL    PRINTFILE FILE; /* OUTPUT PRINT FILE */
  32.     DCL    PF_TITLE CHAR(15); /* FILE NAME FOR PRINTFILE */
  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); /* RECORD COUNT */
  39.  
  40.  
  41. /* * *  COMMON DCL INCLUDES  * * */
  42. %INCLUDE 'C:SUBS1.DCL';
  43. %INCLUDE 'ARCOMMON.DCL';
  44. %INCLUDE 'ARCUSTM.DCL';
  45.  
  46. /* * *  COMMON PROC INCLUDES * * */
  47.     DCL    BTREE ENTRY(BIN(7),BIN(7),PTR,BIN(7));
  48.     DCL    ARM060 ENTRY;    /* EXTERNAL MAPS */
  49.  
  50. /* * *  PRINT A RECORD.  * * */
  51. PUT_RECS: PROC;
  52.  
  53. /* DELETE THE RECORD IF IT ALREADY EXISTS. */
  54.     CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD);
  55.     IF RTN_COD=0 THEN
  56.        CALL BTREE(BT_ERASE,IDX1,IOCB1P,RTN_COD);
  57.  
  58. /* PUT THE RECORD. */
  59.     CALL BTREE(BT_WRITE,IDX1,IOCB1P,RTN_COD);
  60.     IF RTN_COD=0 THEN
  61.        PUT SKIP LIST(REC1.CSID,' HAS BEEN ADDED.');
  62.     ELSE
  63.        PUT SKIP LIST('WRITE RETURN CODE FOR ',REC1.CSID,' IS',RTN_COD,
  64.              '.');
  65.  
  66. /* RETURN TO CALLER. */
  67.     END PUT_RECS;
  68.  
  69. /* * *  PRINT A RECORD.  * * */
  70. GET_RECS: PROC;
  71.  
  72. /* READ A RECORD. */
  73.     GET FILE(PRINTFILE) SKIP LIST(REC1.CSID,
  74.                     REC1.CSBILCON,
  75.                     REC1.CSBILCMP,
  76.                     REC1.CSBILAD1,
  77.                     REC1.CSBILAD2,
  78.                     REC1.CSBILAD3,
  79.                     REC1.CSBILZIP,
  80.                     REC1.CSBILTEL,
  81.                     REC1.CSBILEXT,
  82.                     REC1.CSTECCON,
  83.                     REC1.CSTECCMP,
  84.                     REC1.CSTECAD1,
  85.                     REC1.CSTECAD2,
  86.                     REC1.CSTECAD3,
  87.                     REC1.CSTECZIP,
  88.                     REC1.CSTECTEL,
  89.                     REC1.CSTECEXT,
  90.                     REC1.CSSTAT,
  91.                     REC1.CSTERM,
  92.                     REC1.CSBALTYP,
  93.                     REC1.CSPRCCOD,
  94.                     REC1.CSDISC,
  95.                     REC1.CSCURAMT,
  96.                     REC1.CS30DAMT,
  97.                     REC1.CS60DAMT,
  98.                     REC1.CSOVRAMT,
  99.                     REC1.CSLYRAMT,
  100.                     REC1.CSSPCL);
  101.  
  102. /* RETURN TO CALLER. */
  103.     RETURN;
  104.     END GET_RECS;
  105.  
  106. /* * *  START OF MAIN PROGRAM  * * */
  107. MAIN_MENU:
  108.     BEGIN;
  109.     CALL ARM060;        /* PUT UP BACKGROUND. */
  110.     CALL GETB15(06,23,NRP,0,1,RTN_COD); /* GET THE FUNCTION. */
  111.     GOTO MAIN_FUNC(NRP);    /* PERFORM THE FUNCTION. */
  112.     END; /* MAIN_MENU */
  113.  
  114. /* * *  RETURN TO MAIN MENU  * * */
  115. MAIN_FUNC(00):
  116.     BEGIN;
  117.     CALL CLRSCRN;
  118.     CALL PUTMSG(1,1,'RETURNING TO MASTER MENU...');
  119.     RETURN;
  120.     END;
  121.  
  122. /* * *  PRINT THE REPORT  * * */
  123. MAIN_FUNC(01):
  124.     BEGIN;
  125. /* DO INITIALIZATION. */
  126.     CALL CLRSCRN;
  127.     PUT SKIP LIST(' * * *  CUSTOMER FILE LOAD PROGRAM  * * *');
  128.     PUT SKIP LIST('          ***PRINT THE REPORT***');
  129.     EOF_MSTR='0'B;
  130.  
  131. /* OPEN THE PRINT FILE AND PRINT THE FIRST HEADING. */
  132.     CALL EOL(24,1);
  133.     CALL PUTMSG(24,1,'ENTER INPUT FILE NAME:');
  134.     CALL GETSTR(24,26,LENGTH(PF_TITLE),ADDR(PF_TITLE),RTN_COD);
  135.     OPEN FILE(PRINTFILE) STREAM INPUT PAGESIZE(0) LINESIZE(512)
  136.          ENV(B(4096)) TITLE(PF_TITLE);
  137.     ON ENDFILE(PRINTFILE)
  138.     BEGIN;
  139.       EOF_MSTR='1'B;
  140.     END;
  141.  
  142. /* PRINT THE DATA FROM THE FILE. */
  143.     RCD_CNT=0;
  144.     CALL CLRSCRN;
  145.     PUT SKIP(0);
  146.     PUT SKIP LIST('LOADING THE FILE......');
  147. PRINT_LOOP:
  148.     DO WHILE(EOF_MSTR='0'B);
  149.       CALL GET_RECS;
  150.       IF EOF_MSTR='0'B THEN
  151.         DO;
  152.           CALL PUT_RECS;
  153.           RCD_CNT=RCD_CNT+1;
  154.         END;
  155.       RP=CONINP();
  156.       IF RP=ASCII(27) THEN  /* OPERATOR INTERVENTION VIA ESC */
  157.          DO;
  158.             EOF_MSTR='1'B;
  159.          END;
  160.     END;
  161.  
  162. /* RETURN TO CALLER. */
  163. PRINT_END:
  164.     CLOSE FILE(PRINTFILE);
  165.     PUT SKIP;
  166.     PUT SKIP LIST('RECORDS PRINTED:',RCD_CNT);
  167.     PUT SKIP;
  168.     CALL PUTMSG(24,1,'PRESS <ENTER> TO CONTINUE.');
  169.     CALL GETSTR(24,60,1,ADDR(RP),RTN_COD);
  170.     GOTO MAIN_MENU;
  171.     END;
  172.  
  173.     END ARP060;
  174.