home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / REKN_REC.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  8.9 KB  |  255 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: REKN_REC.PRG
  3. *               ACCOUNTS RECEIVABLE DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 080692
  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 Rekn_rec
  20.  
  21.    * Link to external procedure file of "tool" procedures
  22.    SET PROCEDURE TO Biblio
  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 factuur_nr, klant_nr, commentaar, opmerking, factuur_nr, fact_oud
  32.    STORE 0  TO huidg_bedr, bed_hui_bt, fact_bedrg, bed_lstrek
  33.    STORE 0  TO bed_lstbet, vrg_saldo
  34.    STORE {} TO fact_datum, dat_lstrek
  35.  
  36.    * Miscellaneous variables - used to pass parameters to Library
  37.    dbf      = "REKN_REC"                 && Standard report is available
  38.    mlist    = "NIET BESCHIKBAAR"            && No mailing list available
  39.    cust_rpt = "N/B"                      && No custom reports available
  40.    STORE "m->factuur_nr" TO key, key1
  41.    STORE "GEEN" TO key2, key3
  42.    keyname1 = "Factuurnr.:"
  43.    STORE "" TO keyname2, keyname3
  44.    list_flds = "FACTUUR_NR, KLANT_NR, FACT_DATUM, FACT_BEDRG, VRG_SALDO"
  45.    STORE 0 TO balance, age
  46.  
  47.    * Open database files and choose active indexes
  48.    SELECT 1
  49.    USE Rekn_rec ORDER Factuur_nr
  50.    USE Klnt     ORDER Klantnaam IN 2
  51.    SET RELATION TO Klant_nr INTO Klnt
  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 vrg_saldo TAG Vrg_saldo
  80.    INDEX ON klant_nr    TAG Klant_nr
  81.    INDEX ON factuur_nr TAG Factuur_nr
  82.    GO TOP
  83. RETURN
  84.  
  85. PROCEDURE Init_fld
  86.    * Initialize memory variable values for data entry
  87.    STORE SPACE(10) TO factuur_nr, fact_oud
  88.    klant_nr = SPACE(6)
  89.    STORE 0 TO huidg_bedr, fact_bedrg, bed_lstrek, bed_lstbet
  90.    STORE SPACE(30) TO commentaar, opmerking
  91.    STORE {  -  -  } TO fact_datum, dat_lstrek
  92. RETURN
  93.  
  94. PROCEDURE Load_fld
  95.    * Load field values from Acct_rec database record into memory variables
  96.    factuur_nr = factuur_nr
  97.    klant_nr    = klant_nr
  98.    huidg_bedr  = huidg_bedr
  99.    bed_hui_bt = bed_hui_bt
  100.    fact_datum = fact_datum
  101.    fact_bedrg = fact_bedrg
  102.    commentaar = commentaar
  103.    opmerking  = opmerking
  104.    dat_lstrek = dat_lstrek
  105.    bed_lstrek = bed_lstrek
  106.    bed_lstbet = bed_lstbet
  107.    vrg_saldo = vrg_saldo
  108.    fact_oud = fact_oud
  109. RETURN
  110.  
  111. PROCEDURE Repl_fld
  112.    * Replace database fields with values of current memory variables
  113.    REPLACE factuur_nr WITH m->factuur_nr, klant_nr WITH m->klant_nr,;
  114.            huidg_bedr WITH m->huidg_bedr, fact_datum WITH m->fact_datum,;
  115.            fact_bedrg WITH m->fact_bedrg, commentaar WITH m->commentaar
  116.    REPLACE opmerking WITH m->opmerking, dat_lstrek WITH m->dat_lstrek,;
  117.            bed_lstrek WITH m->bed_lstrek, bed_lstbet WITH m->bed_lstbet,;
  118.            fact_oud WITH m->fact_oud, vrg_saldo WITH m->vrg_saldo,;
  119.            bed_hui_bt WITH m->bed_hui_bt
  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 "DATABASE REKN. REC."
  135.    @  6, 3 SAY "FACTUURNR.:"
  136.    @  6,28 SAY "FACTUURDATUM:"
  137.    @  9, 3 SAY "KLANTNR.:"
  138.    @ 11, 3 SAY "- LAATSTE FACTUUR -"
  139.    @ 12, 3 SAY "NUMMER:"
  140.    @ 13, 3 SAY "DATUM:"
  141.    @ 14, 3 SAY "LOOPTIJD:"
  142.    @ 11,28 SAY "--------- BEDRAGEN ---------"
  143.    @ 12,28 SAY "LAATSTE REK.   ƒ"
  144.    @ 14,17 SAY "dagen"
  145.    @ 13,28 SAY "LAATST BETAALD ƒ"
  146.    @ 14,28 SAY "VORIG SALDO    ƒ"
  147.    @ 15,28 SAY "LOPENDE ORDERS ƒ"
  148.    @ 16,45 SAY "=========="
  149.    @ 17, 3 SAY "LOPENDE BET.   ƒ"
  150.    @ 17,28 SAY "LOPENDE REK.   ƒ"
  151.    @ 19, 3 SAY "COMMENT.:"
  152.    @ 20, 3 SAY "OPMERK.:"
  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.    vrg_saldo = bed_lstrek - bed_lstbet
  161.    * Amount of this bill is oldbalance plus amount of current purchases
  162.    fact_bedrg = vrg_saldo + huidg_bedr
  163.    * Aging if a balance is outstanding: today's date less date of last bill
  164.    age = IIF(vrg_saldo > 0, DATE() - dat_lstrek, 0)
  165.    *
  166.    SET COLOR TO &c_fields.
  167.    @  6,16 SAY factuur_nr
  168.    @  6,42 SAY fact_datum
  169.    @  9,17 SAY klant_nr
  170.    @  9,24 SAY Klnt->klantnaam COLOR &c_yelowhit.
  171.    @ 12,11 SAY fact_oud
  172.    @ 13,11 SAY dat_lstrek
  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 bed_lstrek PICTURE "999999.99"
  186.    @ 14,12 SAY m->age PICTURE "9999" COLOR &age_color.
  187.    @ 13,45 SAY bed_lstbet PICTURE "999999.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 vrg_saldo >= 1000
  193.             bal_color = c_red          && Red for danger
  194.          CASE vrg_saldo >= 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->vrg_saldo      PICTURE "999999.99" COLOR &bal_color.
  201.    @ 15,45 SAY huidg_bedr PICTURE "999999.99"
  202.    @ 17,17 SAY bed_hui_bt PICTURE "999999.99"
  203.    @ 17,45 SAY  m->fact_bedrg     PICTURE "999999.99" COLOR &c_yelowhit.
  204.    @ 19,12 SAY commentaar
  205.    @ 20,12 SAY opmerking
  206.    IF ISCOLOR()
  207.       @ 22,1 SAY "Gele tekst/getallen uit verwante database/berekening.   " ;
  208.              COLOR &c_yelowhit.
  209.    ELSE
  210.       @ 22,1 SAY "Grijze tekst/getallen uit verwante database/berekening. " ;
  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->factuur_nr ;
  219.                VALID Duplicat(m->factuur_nr) ;
  220.                ERROR "Factuurnummer bestaat al; voer opnieuw in" ;
  221.                MESSAGE "Voer geldig factuurnummer in " + ;
  222.                        "(klantnummer + jaar + maand)"
  223.    @  6,42 GET m->fact_datum
  224.    @  9,17 GET m->klant_nr PICTURE  "!XXXXX" ;
  225.                VALID Lookupid((m->klant_nr), "Klnt", "Klantnaam", 2) ;
  226.                ERROR "Ongeldig klantnummer; voer ander nummer in" ;
  227.                MESSAGE "Voer een klantnummer in (beginnend met een " + ;
  228.                        "letter), of annuleer met Esc"
  229.    IF .NOT. PROMPT() = " Toevoegen record"
  230.       @ 9,24 SAY Klnt->klantnaam 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->fact_oud
  235.    @ 13,11 GET m->dat_lstrek FUNCTION "D"
  236.    @ 12,45 GET m->bed_lstrek PICTURE "999999.99"
  237.    @ 13,45 GET m->bed_lstbet PICTURE "999999.99"
  238.    @ 15,45 GET m->huidg_bedr PICTURE "999999.99"
  239.    @ 17,17 GET m->bed_hui_bt PICTURE "999999.99"
  240.    @ 19,12 GET m->commentaar   FUNCTION "!"
  241.    @ 20,12 GET m->opmerking      FUNCTION "!"
  242.    IF ISCOLOR()
  243.       @ 22,1 SAY "Gele tekst/getallen uit verwante database/berekening.   " ;
  244.              COLOR &c_yelowhit.
  245.    ELSE
  246.       @ 22,1 SAY "Grijze tekst/getallen uit verwante database/berekening. " ;
  247.              COLOR &c_red.
  248.    ENDIF
  249.    SET COLOR TO &c_standard.
  250.    ON KEY LABEL F9 DO Findcust WITH m->klant_nr
  251. RETURN
  252.  
  253. *** END REKN_REC.PRG *********************************************************
  254.  
  255.