home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol049 / arp010.pli < prev    next >
Encoding:
Text File  |  1984-04-29  |  12.0 KB  |  452 lines
  1. /*PROGRAM
  2.         ARP010 - A/R CUSTOMER MASTER FILE MAINTENANCE
  3.   PROGRAMMER
  4.         ROBERT M. WHITE
  5.   DATE WRITTEN
  6.         APRIL 15, 1981
  7.   PURPOSE
  8.         THIS PROGRAM ALLOWS THE OPERATOR TO UPDATE THE
  9.         A/R CUSTOMER MASTER FILE RECORDS.  THIS INCLUDES
  10.         ALL COMMON MAINTENANCE FUNCTIONS.
  11.   INPUT
  12.   OUTPUT
  13.   REMARKS
  14. */
  15.  
  16. ARP010: PROC;
  17. /* * * *   CUSTOMER MASTER FILE MAINTENANCE PROGRAM  * * * */
  18.  
  19. /* * *  PROGRAM REPLACEMENTS  * * */
  20. %INCLUDE 'C:BTCCS.PLI';
  21. %INCLUDE 'C:BTERRCS.PLI';
  22. %REPLACE FALSE BY '0'B;
  23. %REPLACE TRUE BY '1'B;
  24.  
  25. /* * *  PROGRAM AREAS  * * */
  26.     DCL    I BIN(15);    /* INDEX VARIABLE */
  27.     DCL    RP CHAR(1);  /* CHAR RESPONSE */
  28.     DCL    NRP BIN(15);  /* NUMERIC RESPONSE */
  29.     DCL    RTN_COD BIN(7); /* RETURN CODE */
  30.  
  31. /* * *  COMMON DCL INCLUDES  * * */
  32. %INCLUDE 'C:SUBS1.DCL';
  33. %INCLUDE 'ARCOMMON.DCL';
  34. %INCLUDE 'ARCUSTM.DCL';
  35.  
  36. /* * *  COMMON PROC INCLUDES * * */
  37.     DCL    BTREE ENTRY(BIN(7),BIN(7),PTR,BIN(7));
  38.     DCL    ARM010 ENTRY;    /* SCREEN ROUTINES */
  39.     DCL    ARM011 ENTRY;
  40.  
  41. /* * *  ZERO RECORD.  * * */
  42. ZERO_MSTR: PROC;
  43.     REC1.CSID=' ';
  44.     REC1.CSBILCON=' ';
  45.     REC1.CSBILCMP=' ';
  46.     REC1.CSBILAD1=' ';
  47.     REC1.CSBILAD2=' ';
  48.     REC1.CSBILAD3=' ';
  49.     REC1.CSBILZIP=' ';
  50.     REC1.CSBILTEL=' ';
  51.     REC1.CSBILEXT=0;
  52.     REC1.CSTECCON=' ';
  53.     REC1.CSTECCMP=' ';
  54.     REC1.CSTECAD1=' ';
  55.     REC1.CSTECAD2=' ';
  56.     REC1.CSTECAD3=' ';
  57.     REC1.CSTECZIP=' ';
  58.     REC1.CSTECTEL=' ';
  59.     REC1.CSTECEXT=0;
  60.     REC1.CSSTAT=' ';
  61.     REC1.CSTERM=' ';
  62.     REC1.CSBALTYP=' ';
  63.     REC1.CSPRCCOD=' ';
  64.     REC1.CSDISC=' ';
  65.     REC1.CSTAXCOD=' ';
  66.     REC1.CSCURAMT=0;
  67.     REC1.CS30DAMT=0;
  68.     REC1.CS60DAMT=0;
  69.     REC1.CSOVRAMT=0;
  70.     REC1.CSLYRAMT=0;
  71.     REC1.CSSPCL=' ';
  72.     END;
  73.  
  74. /* * *  ENTER A FIELD.  * * */
  75. GET_FLD: PROC (I);
  76.     DCL    I BIN(7);
  77.     GOTO FLDGET(I);
  78. FLDGET(01):
  79.     CALL GETSTR(04,17,LENGTH(REC1.CSBILCON),ADDR(REC1.CSBILCON),
  80.             RTN_COD);
  81.     RETURN;
  82. FLDGET(02):
  83.     CALL GETSTR(05,17,LENGTH(REC1.CSBILCMP),ADDR(REC1.CSBILCMP),
  84.             RTN_COD);
  85.     RETURN;
  86. FLDGET(03):
  87.     CALL GETSTR(06,17,LENGTH(REC1.CSBILAD1),ADDR(REC1.CSBILAD1),
  88.             RTN_COD);
  89.     RETURN;
  90. FLDGET(04):
  91.     CALL GETSTR(07,17,LENGTH(REC1.CSBILAD2),ADDR(REC1.CSBILAD2),
  92.             RTN_COD);
  93.     RETURN;
  94. FLDGET(05):
  95.     CALL GETSTR(08,17,LENGTH(REC1.CSBILAD3),ADDR(REC1.CSBILAD3),
  96.             RTN_COD);
  97.     RETURN;
  98. FLDGET(06):
  99.     CALL GETSTR(08,49,LENGTH(REC1.CSBILZIP),ADDR(REC1.CSBILZIP),
  100.             RTN_COD);
  101.     RETURN;
  102. FLDGET(07):
  103.     CALL GETSTR(09,17,LENGTH(REC1.CSBILTEL),ADDR(REC1.CSBILTEL),
  104.             RTN_COD);
  105.     RETURN;
  106. FLDGET(08):
  107.     CALL GETB15(09,36,REC1.CSBILEXT,0,9999,RTN_COD);
  108.     RETURN;
  109. FLDGET(09):
  110.     CALL GETSTR(11,17,LENGTH(REC1.CSTECCON),ADDR(REC1.CSTECCON),
  111.             RTN_COD);
  112.     RETURN;
  113. FLDGET(10):
  114.     CALL GETSTR(12,17,LENGTH(REC1.CSTECCMP),ADDR(REC1.CSTECCMP),
  115.             RTN_COD);
  116.     RETURN;
  117. FLDGET(11):
  118.     CALL GETSTR(13,17,LENGTH(REC1.CSTECAD1),ADDR(REC1.CSTECAD1),
  119.             RTN_COD);
  120.     RETURN;
  121. FLDGET(12):
  122.     CALL GETSTR(14,17,LENGTH(REC1.CSTECAD2),ADDR(REC1.CSTECAD2),
  123.             RTN_COD);
  124.     RETURN;
  125. FLDGET(13):
  126.     CALL GETSTR(15,17,LENGTH(REC1.CSTECAD3),ADDR(REC1.CSTECAD3),
  127.             RTN_COD);
  128.     RETURN;
  129. FLDGET(14):
  130.     CALL GETSTR(15,49,LENGTH(REC1.CSTECZIP),ADDR(REC1.CSTECZIP),
  131.             RTN_COD);
  132.     RETURN;
  133. FLDGET(15):
  134.     CALL GETSTR(16,17,LENGTH(REC1.CSTECTEL),ADDR(REC1.CSTECTEL),
  135.             RTN_COD);
  136.     RETURN;
  137. FLDGET(16):
  138.     CALL GETB15(16,36,REC1.CSTECEXT,0,9999,RTN_COD);
  139.     RETURN;
  140. FLDGET(17):
  141.     CALL GETSTR(18,12,LENGTH(REC1.CSSTAT),ADDR(REC1.CSSTAT),
  142.             RTN_COD);
  143.     RETURN;
  144. FLDGET(18):
  145.     CALL GETSTR(18,25,LENGTH(REC1.CSTERM),ADDR(REC1.CSTERM),
  146.             RTN_COD);
  147.     RETURN;
  148. FLDGET(19):
  149.     CALL GETSTR(18,46,LENGTH(REC1.CSBALTYP),ADDR(REC1.CSBALTYP),
  150.             RTN_COD);
  151.     RETURN;
  152. FLDGET(20):
  153.     CALL GETSTR(18,64,LENGTH(REC1.CSPRCCOD),ADDR(REC1.CSPRCCOD),
  154.             RTN_COD);
  155.     RETURN;
  156. FLDGET(21):
  157.     CALL GETSTR(18,76,LENGTH(REC1.CSDISC),ADDR(REC1.CSDISC),
  158.             RTN_COD);
  159.     RETURN;
  160. FLDGET(22):
  161.     CALL GETSTR(19,14,LENGTH(REC1.CSTAXCOD),ADDR(REC1.CSTAXCOD),
  162.             RTN_COD);
  163.     RETURN;
  164. FLDGET(23):
  165.     CALL GETSTR(19,29,LENGTH(REC1.CSSPCL),ADDR(REC1.CSSPCL),
  166.             RTN_COD);
  167.     RETURN;
  168. FLDGET(24):
  169.     CALL GETD92(20,13,REC1.CSCURAMT,0,0,RTN_COD);
  170.     RETURN;
  171. FLDGET(25):
  172.     CALL GETD92(20,39,REC1.CS30DAMT,0,0,RTN_COD);
  173.     RETURN;
  174. FLDGET(26):
  175.     CALL GETD92(20,65,REC1.CS60DAMT,0,0,RTN_COD);
  176.     RETURN;
  177. FLDGET(27):
  178.     CALL GETD92(21,13,REC1.CSOVRAMT,0,0,RTN_COD);
  179.     RETURN;
  180. FLDGET(28):
  181.     CALL GETD92(21,41,REC1.CSLYRAMT,0,0,RTN_COD);
  182.     RETURN;
  183.     END GET_FLD;
  184.  
  185. /* * *  UPDATE A FIELD  * * */
  186. UPD_FLDS: PROC;
  187.     DCL    I BIN(15);
  188. UPD_LOOP:
  189.     CALL    EOL(23,1);
  190.     CALL    PUTMSG(23,1,
  191.           'PLEASE ENTER FIELD NUMBER TO CHANGE OR <ENTER> FOR END: ');
  192.     CALL GETB15(23,57,I,0,28,RTN_COD);
  193.     IF I=0 THEN 
  194.        RETURN;
  195.     CALL    GET_FLD(I);
  196.     GOTO    UPD_LOOP;
  197.     END UPD_FLDS;
  198.  
  199. /* * *  PRINT A RECORD.  * * */
  200. PRNT_MSTR: PROC;
  201.     CALL ARM011;    /* PUT BACKGROUND ON SCREEN. */
  202.     CALL PUTSTR(04,17,LENGTH(REC1.CSBILCON),ADDR(REC1.CSBILCON));
  203.     CALL PUTSTR(05,17,LENGTH(REC1.CSBILCMP),ADDR(REC1.CSBILCMP));
  204.     CALL PUTSTR(06,17,LENGTH(REC1.CSBILAD1),ADDR(REC1.CSBILAD1));
  205.     CALL PUTSTR(07,17,LENGTH(REC1.CSBILAD2),ADDR(REC1.CSBILAD2));
  206.     CALL PUTSTR(08,17,LENGTH(REC1.CSBILAD3),ADDR(REC1.CSBILAD3));
  207.     CALL PUTSTR(08,49,LENGTH(REC1.CSBILZIP),ADDR(REC1.CSBILZIP));
  208.     CALL PUTSTR(09,17,LENGTH(REC1.CSBILTEL),ADDR(REC1.CSBILTEL));
  209.     CALL PUTB15(09,36,REC1.CSBILEXT);
  210.     CALL PUTSTR(11,17,LENGTH(REC1.CSTECCON),ADDR(REC1.CSTECCON));
  211.     CALL PUTSTR(12,17,LENGTH(REC1.CSTECCMP),ADDR(REC1.CSTECCMP));
  212.     CALL PUTSTR(13,17,LENGTH(REC1.CSTECAD1),ADDR(REC1.CSTECAD1));
  213.     CALL PUTSTR(14,17,LENGTH(REC1.CSTECAD2),ADDR(REC1.CSTECAD2));
  214.     CALL PUTSTR(15,17,LENGTH(REC1.CSTECAD3),ADDR(REC1.CSTECAD3));
  215.     CALL PUTSTR(15,49,LENGTH(REC1.CSTECZIP),ADDR(REC1.CSTECZIP));
  216.     CALL PUTSTR(16,17,LENGTH(REC1.CSTECTEL),ADDR(REC1.CSTECTEL));
  217.     CALL PUTB15(16,36,REC1.CSTECEXT);
  218.     CALL PUTSTR(18,12,LENGTH(REC1.CSSTAT),ADDR(REC1.CSSTAT));
  219.     CALL PUTSTR(18,25,LENGTH(REC1.CSTERM),ADDR(REC1.CSTERM));
  220.     CALL PUTSTR(18,46,LENGTH(REC1.CSBALTYP),ADDR(REC1.CSBALTYP));
  221.     CALL PUTSTR(18,64,LENGTH(REC1.CSPRCCOD),ADDR(REC1.CSPRCCOD));
  222.     CALL PUTSTR(18,76,LENGTH(REC1.CSDISC),ADDR(REC1.CSDISC));
  223.     CALL PUTSTR(19,14,LENGTH(REC1.CSTAXCOD),ADDR(REC1.CSTAXCOD));
  224.     CALL PUTSTR(19,29,LENGTH(REC1.CSSPCL),ADDR(REC1.CSSPCL));
  225.     CALL PUTD92(20,13,ADDR(REC1.CSCURAMT));
  226.     CALL PUTD92(20,39,ADDR(REC1.CS30DAMT));
  227.     CALL PUTD92(20,65,ADDR(REC1.CS60DAMT));
  228.     CALL PUTD92(21,13,ADDR(REC1.CSOVRAMT));
  229.     CALL PUTD92(21,41,ADDR(REC1.CSLYRAMT));
  230.     END PRNT_MSTR;
  231.  
  232. /* *    PRINT SECTION HEADING    * */
  233. PRNT_HDNG: PROC (SUB);
  234.     DCL    SUB CHAR(25) VARYING;
  235.     DCL    BLANKS CHAR(13) STATIC INITIAL(' ');
  236.     DCL    NUM_BLANKS BIN(15);
  237.  
  238. /* ADJUST INPUT. */
  239.     NUM_BLANKS=DIVIDE(25-LENGTH(SUB),2,5);
  240.     IF LENGTH(SUB)<25 THEN
  241.        SUB=SUBSTR(BLANKS,1,NUM_BLANKS)||SUB;
  242.  
  243. /* PRINT HEADINGS. */
  244.     CALL CLRSCRN;
  245.     CALL PUTMSG(1,15,'* * *  CUSTOMER FILE MAINTENANCE  * * *');
  246.     CALL PUTMSG(2,22,SUB);
  247.  
  248. /* RETURN TO CALLER. */
  249.     END PRNT_HDNG;
  250.  
  251. /* * *  START OF MAIN PROGRAM  * * */
  252. MAIN_MENU:
  253.     BEGIN;
  254.     CALL ARM010;    /* PRINT MENU */
  255.     CALL GETB15(09,23,NRP,0,04,RTN_COD); /* GET FUNCTION NUMBER. */
  256.     GOTO MAIN_FUNC(NRP);    /* PERFORM THE FUNCTION. */
  257.     END; /* MAIN_MENU */
  258.  
  259. /* * *  RETURN TO MAIN MENU  * * */
  260. MAIN_FUNC(00):
  261.     BEGIN;
  262.     CALL CLRSCRN;
  263.     CALL PUTMSG(1,1,'RETURNING TO MASTER MENU...');
  264.     RETURN;
  265.     END;
  266.  
  267. /* * *  ADD BY ID  * * */
  268. MAIN_FUNC(01):
  269.     BEGIN;
  270. /* GET THE KEY FIELD. */
  271.     CALL ZERO_MSTR;            /* ZERO THE RECORD. */
  272.     CALL PRNT_HDNG('***ADD A CUSTOMER***');
  273.     CALL PUTMSG(3,1,'ENTER ID:');
  274.     CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
  275.     IF REC1.CSID=' ' THEN
  276.        DO;
  277.          CALL PUTERR('*** 1)ID IS INVALID OR MISSING. ***');
  278.          GOTO ADD_NEXT;
  279.        END;
  280.     CALL BTREE(BT_LOCATE,IDX1,IOCB1P,RTN_COD);
  281.         IF RTN_COD=0 THEN
  282.            DO;
  283.               CALL PUTERR('RECORD ALREADY EXISTS!');
  284.           GOTO ADD_NEXT;
  285.            END;
  286.         IF RTN_COD=3 THEN  /* RECORD DOESN'T EXIST.*/
  287.            DO;
  288.            END;
  289.         ELSE
  290.        DO;
  291.               CALL PUTERR('ADD RETURN CODE ='||RTN_COD||'.');
  292.           GOTO ADD_NEXT;
  293.        END;
  294.  
  295. /* GET EACH FIELD IN THE RECORD. */
  296.     CALL PRNT_HDNG('ADDING: '||REC1.CSID);
  297.     CALL PRNT_MSTR;            /* FORMAT THE SCREEN. */
  298.     CALL EOL(23,1);            /* ERASE CURRENT LINE. */
  299.     CALL PUTMSG(23,1,'PLEASE ENTER EACH FIELD AS PROMPTED.');
  300.     DO I=1 TO 28;
  301.       CALL GET_FLD(I);
  302.     END;
  303.     CALL UPD_FLDS;
  304.  
  305. /* ADD THE RECORD TO THE FILE. */
  306.     CALL BTREE(BT_WRITE,IDX1,IOCB1P,RTN_COD);
  307.         IF RTN_COD=0 THEN
  308.            DO;
  309.               CALL PUTERR('RECORD SUCCESSFULLY ADDED');
  310.            END;
  311.         ELSE
  312.        DO;
  313.               CALL PUTERR('ADD RETURN CODE ='||RTN_COD||'.');
  314.        END;
  315.  
  316. /* EITHER RETURN OR DO ANOTHER RECORD */
  317. ADD_NEXT:
  318.     CALL EOL(23,1);            /* ASK ABOUT ANOTHER ADD */
  319.     CALL PUTMSG(23,1,'DO YOU WISH TO ADD ANOTHER N/A (Y/N)? ');
  320.     CALL GETSTR(23,39,1,ADDR(RP),RTN_COD);
  321.     IF RP~='N' THEN
  322.       GOTO MAIN_FUNC(01);
  323.     GOTO MAIN_MENU;
  324.     END;
  325.  
  326. /* * *  UPDATE BY ID  * * */
  327. MAIN_FUNC(02):
  328.     BEGIN;
  329. /* GET THE RECORD TO BE UPDATED */
  330.     CALL PRNT_HDNG('***UPDATE A CUSTOMER***');
  331.     CALL PUTMSG(3,1,'ENTER ID:');
  332.     CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
  333.     IF REC1.CSID=' ' THEN
  334.        DO;
  335.          CALL PUTERR('*** 1)ID IS INVALID OR MISSING. ***');
  336.          GOTO UPD_NEXT;
  337.        END;
  338.     CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD);
  339.         IF RTN_COD=0 THEN
  340.            DO;
  341.            END;
  342.         ELSE
  343.        DO;
  344.               CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
  345.           GOTO UPD_NEXT;
  346.        END;
  347.  
  348. /* UPDATE THE FIELDS IN THIS RECORD */
  349.     CALL PRNT_HDNG('UPDATING: '||REC1.CSID);
  350.     CALL PRNT_MSTR;            /* FORMAT THE SCREEN. */
  351.     CALL UPD_FLDS;
  352.  
  353. /* UPDATE THE RECORD. */
  354.     CALL BTREE(BT_UPDATE,IDX1,IOCB1P,RTN_COD);
  355.         IF RTN_COD=0 THEN
  356.            DO;
  357.           CALL PUTERR('RECORD SUCCESSFULLY UPDATED.');
  358.            END;
  359.         ELSE
  360.        DO;
  361.               CALL PUTERR('UPDATE RETURN CODE ='||RTN_COD||'.');
  362.        END;
  363.  
  364. /* EITHER RETURN OR DO ANOTHER RECORD. */
  365. UPD_NEXT:
  366.     CALL EOL(23,1);            /* ASK ABOUT ANOTHER ADD */
  367.     CALL PUTMSG(23,1,'DO YOU WISH TO UPDATE ANOTHER N/A (Y/N)? ');
  368.     CALL GETSTR(23,42,1,ADDR(RP),RTN_COD);
  369.     IF RP~='N' THEN
  370.       GOTO MAIN_FUNC(02);
  371.     GOTO MAIN_MENU;
  372.     END;
  373.  
  374. /* * *  DELETE BY ID  * * */
  375. MAIN_FUNC(03):
  376.     BEGIN;
  377. /* GET THE RECORD. */
  378.     CALL PRNT_HDNG('***DELETE A CUSTOMER***');
  379.     CALL PUTMSG(3,1,'ENTER ID:');
  380.     CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
  381.     CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD);
  382.         IF RTN_COD=0 THEN
  383.            DO;
  384.            END;
  385.         ELSE
  386.        DO;
  387.               CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
  388.           GOTO DELT_NEXT;
  389.        END;
  390.  
  391. /* DISPLAY THE RECORD. */
  392.     CALL PRNT_HDNG('DELETING: '||REC1.CSID);
  393.     CALL PRNT_MSTR;            /* FORMAT THE SCREEN. */
  394.  
  395. /* ISSUE THE DELETE TO MDBS. */
  396.     CALL PUTMSG(23,1,'DO YOU REALLY WANT TO DELETE THIS(Y/N)? ');
  397.     CALL GETSTR(23,41,1,ADDR(RP),RTN_COD);
  398.     IF RP~='Y' THEN
  399.        GOTO DELT_NEXT;
  400.     CALL BTREE(BT_DELETE,IDX1,IOCB1P,RTN_COD);
  401.         IF RTN_COD=0 THEN
  402.            DO;
  403.           CALL PUTERR('DELETE WAS SUCCESSFUL.');
  404.            END;
  405.         ELSE
  406.        DO;
  407.               CALL PUTERR('DELETE RETURN CODE ='||RTN_COD||'.');
  408.        END;
  409.  
  410. /* EITHER RETURN OR DO ANOTHER RECORD. */
  411. DELT_NEXT:
  412.     CALL EOL(23,1);            /* ASK ABOUT ANOTHER ADD */
  413.     CALL PUTMSG(23,1,'DO YOU WISH TO DELETE ANOTHER N/A (Y/N)? ');
  414.     CALL GETSTR(23,42,1,ADDR(RP),RTN_COD);
  415.     IF RP~='N' THEN
  416.       GOTO MAIN_FUNC(03);
  417.     GOTO MAIN_MENU;
  418.     END;
  419.  
  420. /* * *  DISPLAY BY ID  * * */
  421. MAIN_FUNC(04):
  422.     BEGIN;
  423. /* GET THE RECORD TO BE DISPLAYED. */
  424.     CALL PRNT_HDNG('***DISPLAY A CUSTOMER***');
  425.     CALL PUTMSG(3,1,'ENTER ID:');
  426.     CALL GETSTR(03,11,LENGTH(REC1.CSID),ADDR(REC1.CSID),RTN_COD);
  427.     CALL BTREE(BT_READ,IDX1,IOCB1P,RTN_COD);
  428.         IF RTN_COD=0 THEN
  429.            DO;
  430.            END;
  431.         ELSE
  432.        DO;
  433.               CALL PUTERR('READ RETURN CODE ='||RTN_COD||'.');
  434.           GOTO DSPL_NEXT;
  435.        END;
  436.  
  437. /* DISPLAY THE RECORD. */
  438.     CALL PRNT_HDNG('DISPLAYING: '||REC1.CSID);
  439.     CALL PRNT_MSTR;            /* FORMAT THE SCREEN. */
  440.  
  441. /* EITHER RETURN OR DO ANOTHER RECORD. */
  442. DSPL_NEXT:
  443.     CALL EOL(23,1);            /* ASK ABOUT ANOTHER ADD */
  444.     CALL PUTMSG(23,1,'DO YOU WISH TO DISPLAY ANOTHER N/A (Y/N)? ');
  445.     CALL GETSTR(23,42,1,ADDR(RP),RTN_COD);
  446.     IF RP~='N' THEN
  447.       GOTO MAIN_FUNC(04);
  448.     GOTO MAIN_MENU;
  449.     END;
  450.  
  451.     END ARP010;
  452.