home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / ACCT_REC.PRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  8.8 KB  |  255 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: ACCT_REC.PRG
  3. *               ACCOUNTS RECEIVABLE DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 09/25/89 09:25AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8. *
  9. *       FILES USED:
  10. *       Database file       =  Acct_rec.dbf  (Accounts receivable file)
  11. *       Index file          =  Acct_rec.mdx
  12. *          TAGS: Invoice_no =  invoice_no  <= Master index
  13. *                Oldbalance =  oldbalance
  14. *                Cust_id    =  cust_id
  15. *       External procedure file = Library.prg
  16. ******************************************************************************
  17.  
  18. * Main procedure
  19. PROCEDURE Acct_rec
  20.  
  21.    * Link to external procedure file of "tool" procedures
  22.    SET PROCEDURE TO Library
  23.  
  24.    * Set up database environment
  25.    DO Set_env
  26.  
  27.    SET COLOR TO &c_standard.
  28.  
  29.    * Declare variables used:
  30.    * Database memory variables
  31.    STORE "" TO invoice_no, cust_id, comments, notes, invoice_no, invoic_old
  32.    STORE 0  TO amt_of_cur, amt_cur_pd, amt_of_bil, amt_lstbil
  33.    STORE 0  TO amt_lst_pd, oldbalance
  34.    STORE {} TO dat_of_bil, dat_lstbil
  35.  
  36.    * Miscellaneous variables - used to pass parameters to Library
  37.    dbf      = "ACCT_REC"                 && Standard report is available
  38.    mlist    = "NOT AVAILABLE"            && No mailing list available
  39.    cust_rpt = "N/A"                      && No custom reports available
  40.    STORE "m->invoice_no" TO key, key1
  41.    STORE "NONE" TO key2, key3
  42.    keyname1 = "Invoice #:"
  43.    STORE "" TO keyname2, keyname3
  44.    list_flds = "INVOICE_NO, CUST_ID, DAT_OF_BIL, AMT_OF_BIL, OLDBALANCE"
  45.    STORE 0 TO balance, age
  46.  
  47.    * Open database files and choose active indexes
  48.    SELECT 1
  49.    USE Acct_rec ORDER Invoice_no
  50.    USE Cust     ORDER Cust_id IN 2
  51.    SET RELATION TO cust_id INTO Cust
  52.    GO TOP
  53.  
  54.    record_num = RECNO()
  55.    * Load initial record from database into memory variables
  56.    DO Load_fld
  57.  
  58.    * Show data screen
  59.    CLEAR
  60.    DO Dstatus
  61.    DO Backgrnd
  62.    DO Show_data
  63.  
  64.    * Define popup menus
  65.    DO Bar_def
  66.  
  67.    * Activate main popup menu - execute user choices
  68.    SET COLOR TO &c_popup.
  69.    ACTIVATE POPUP main_mnu
  70.    DO Sub_ret
  71.    *
  72. RETURN
  73. *** END MAIN PROCEDURE ****************************************************
  74.  
  75. *  UTILITY PROCEDURES (Proprietary to Acct_rec.prg)
  76.  
  77. PROCEDURE Indexer
  78.    * Create/rebuild indexes
  79.    INDEX ON oldbalance TAG Oldbalance
  80.    INDEX ON cust_id    TAG Cust_id
  81.    INDEX ON invoice_no TAG Invoice_no
  82.    GO TOP
  83. RETURN
  84.  
  85. PROCEDURE Init_fld
  86.    * Initialize memory variable values for data entry
  87.    STORE SPACE(10) TO invoice_no, invoic_old
  88.    cust_id = SPACE(6)
  89.    STORE 0 TO amt_of_cur, amt_of_bil, amt_lstbil, amt_lst_pd
  90.    STORE SPACE(30) TO comments, notes
  91.    STORE {  /  /  } TO dat_of_bil, dat_lstbil
  92. RETURN
  93.  
  94. PROCEDURE Load_fld
  95.    * Load field values from Acct_rec database record into memory variables
  96.    invoice_no = invoice_no
  97.    cust_id    = cust_id
  98.    amt_of_cur = amt_of_cur
  99.    amt_cur_pd = amt_cur_pd
  100.    dat_of_bil = dat_of_bil
  101.    amt_of_bil = amt_of_bil
  102.    comments   = comments
  103.    notes      = notes
  104.    dat_lstbil = dat_lstbil
  105.    amt_lstbil = amt_lstbil
  106.    amt_lst_pd = amt_lst_pd
  107.    oldbalance = oldbalance
  108.    invoic_old = invoic_old
  109. RETURN
  110.  
  111. PROCEDURE Repl_fld
  112.    * Replace database fields with values of current memory variables
  113.    REPLACE invoice_no WITH m->invoice_no, cust_id WITH m->cust_id,;
  114.            amt_of_cur WITH m->amt_of_cur, dat_of_bil WITH m->dat_of_bil,;
  115.            amt_of_bil WITH m->amt_of_bil, comments WITH m->comments
  116.    REPLACE notes WITH m->notes, dat_lstbil WITH m->dat_lstbil,;
  117.            amt_lstbil WITH m->amt_lstbil, amt_lst_pd WITH m->amt_lst_pd,;
  118.            invoic_old WITH m->invoic_old, oldbalance WITH m->oldbalance,;
  119.            amt_cur_pd WITH m->amt_cur_pd
  120. RETURN
  121.  
  122. PROCEDURE Backgrnd
  123.    * Show background screen
  124.    * Draw and fill in boxes
  125.    @  1,18 TO  3,41 DOUBLE COLOR &c_blue.
  126.    @  5, 1 TO  7,56 DOUBLE COLOR &c_red.
  127.    @  2,19 FILL TO  2,40   COLOR &c_red.
  128.    @  6, 2 FILL TO  6,55   COLOR &c_red.
  129.    @  9, 2 FILL TO 20,55   COLOR &c_red.
  130.    @ 10, 1 TO 10,56        COLOR &c_red.
  131.    @ 18, 1 TO 18,56        COLOR &c_red.
  132.    @  8, 1 TO 21,56        COLOR &c_red.
  133.    SET COLOR TO &c_data.
  134.    @  2,20 SAY "ACCT. REC. DATABASE"
  135.    @  6, 3 SAY "INVOICE NO.:"
  136.    @  6,28 SAY "BILLING DATE:"
  137.    @  9, 3 SAY "CUSTOMER NO.:"
  138.    @ 11, 3 SAY "-- LAST INVOICE --"
  139.    @ 12, 3 SAY "NUMBER:"
  140.    @ 13, 3 SAY "DATE:"
  141.    @ 14, 3 SAY "AGE:"
  142.    @ 11,28 SAY "--------- AMOUNTS ---------"
  143.    @ 12,28 SAY "LAST BILL      $"
  144.    @ 14,16 SAY "days"
  145.    @ 13,28 SAY "LAST PAID      $"
  146.    @ 14,28 SAY "OLD  BALANCE   $"
  147.    @ 15,28 SAY "CURRENT ORDERS $"
  148.    @ 16,45 SAY "=========="
  149.    @ 17, 3 SAY "CURRENT PMT.$"
  150.    @ 17,28 SAY "CURRENT BILL$"
  151.    @ 19, 3 SAY "COMMENT:"
  152.    @ 20, 3 SAY "NOTE:"
  153.    SET COLOR TO &c_standard.
  154. RETURN
  155.  
  156. PROCEDURE Show_data
  157.    * Show screen for data entry
  158.    * Calculate temporary data
  159.    * Old balance = amount last billed less amount last paid
  160.    oldbalance = amt_lstbil - amt_lst_pd
  161.    * Amount of this bill is oldbalance plus amount of current purchases
  162.    amt_of_bil = oldbalance + amt_of_cur
  163.    * Aging if a balance is outstanding: today's date less date of last bill
  164.    age = IIF(oldbalance > 0, DATE() - dat_lstbil, 0)
  165.    *
  166.    SET COLOR TO &c_fields.
  167.    @  6,16 SAY invoice_no
  168.    @  6,42 SAY dat_of_bil
  169.    @  9,17 SAY cust_id
  170.    @  9,24 SAY Cust->customer COLOR &c_yelowhit.
  171.    @ 12,11 SAY invoic_old
  172.    @ 13,11 SAY dat_lstbil
  173.    * Set colors to show levels of aging of old balance
  174.    age_color = "W"                     && Monochrome monitor
  175.    IF ISCOLOR()                        && Color monitor
  176.       DO CASE
  177.          CASE m->age >= 60
  178.             age_color = c_red          && Red for danger
  179.          CASE m->age >= 45
  180.             age_color = c_yellow       && Yellow for caution
  181.          OTHERWISE
  182.             age_color = c_green        && Green - OK
  183.       ENDCASE
  184.    ENDIF
  185.    @ 12,45 SAY amt_lstbil PICTURE "999,999.99"
  186.    @ 14,12 SAY m->age PICTURE "999" COLOR &age_color.
  187.    @ 13,45 SAY amt_lst_pd PICTURE "999,999.99"
  188.    bal_color = "W"                     && Monochrome monitor
  189.    IF ISCOLOR()                        && Color monitor
  190.       DO CASE
  191.          * Set color to show level of balance due from last bill
  192.          CASE oldbalance >= 1000
  193.             bal_color = c_red          && Red for danger
  194.          CASE oldbalance >= 100
  195.             bal_color = c_yelowhit     && Yellow for caution
  196.          OTHERWISE
  197.             bal_color = c_green        && Green - OK
  198.       ENDCASE
  199.    ENDIF
  200.    @ 14,45 SAY m->oldbalance      PICTURE "999,999.99" COLOR &bal_color.
  201.    @ 15,45 SAY amt_of_cur PICTURE "999,999.99"
  202.    @ 17,17 SAY amt_cur_pd PICTURE "999,999.99"
  203.    @ 17,45 SAY  m->amt_of_bil     PICTURE "999,999.99" COLOR &c_yelowhit.
  204.    @ 19,12 SAY comments
  205.    @ 20,12 SAY notes
  206.    IF ISCOLOR()
  207.       @ 22,1 SAY "Yellow text/numbers from related database file or calc. " ;
  208.              COLOR &c_yelowhit.
  209.    ELSE
  210.       @ 22,1 SAY "Dim text/numbers from related database or calc." ;
  211.              COLOR &c_red.
  212.    ENDIF
  213.    SET COLOR TO &c_standard.
  214. RETURN
  215.  
  216. PROCEDURE Get_data
  217.    SET COLOR TO &c_data.
  218.    @  6,16 GET m->invoice_no ;
  219.                VALID Duplicat(m->invoice_no) ;
  220.                ERROR "Duplicate invoice number; please re-enter" ;
  221.                MESSAGE "Enter a valid invoice number " + ;
  222.                        "(customer ID + year + month)"
  223.    @  6,42 GET m->dat_of_bil
  224.    @  9,17 GET m->cust_id PICTURE  "!XXXXX" ;
  225.                VALID Lookupid((m->cust_id), "Cust", "Customer", 2) ;
  226.                ERROR "Invalid customer ID number, please re-enter" ;
  227.                MESSAGE "Enter a customer ID number (starting with a " + ;
  228.                        "letter), or Esc to quit"
  229.    IF .NOT. PROMPT() = " Add record"
  230.       @ 9,24 SAY Cust->customer COLOR &c_yelowhit.
  231.    ELSE
  232.       @ 9,24 SAY SPACE(30)             && Erase customer name when in Add mode
  233.    ENDIF
  234.    @ 12,11 GET m->invoic_old
  235.    @ 13,11 GET m->dat_lstbil FUNCTION "D"
  236.    @ 12,45 GET m->amt_lstbil PICTURE "999,999.99"
  237.    @ 13,45 GET m->amt_lst_pd PICTURE "999,999.99"
  238.    @ 15,45 GET m->amt_of_cur PICTURE "999,999.99"
  239.    @ 17,17 GET m->amt_cur_pd PICTURE "999,999.99"
  240.    @ 19,12 GET m->comments   FUNCTION "!"
  241.    @ 20,12 GET m->notes      FUNCTION "!"
  242.    IF ISCOLOR()
  243.       @ 22,1 SAY "Yellow text/numbers from related database file or calc. " ;
  244.              COLOR &c_yelowhit.
  245.    ELSE
  246.       @ 22,1 SAY "Dim text/numbers from related database or calc." ;
  247.              COLOR &c_red.
  248.    ENDIF
  249.    SET COLOR TO &c_standard.
  250.    ON KEY LABEL F9 DO Findcust WITH m->cust_id
  251. RETURN
  252.  
  253. *** END ACCT_REC.PRG *********************************************************
  254.  
  255.