home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / SAMPLE / CSTLEDGR.PRG < prev    next >
Encoding:
Text File  |  1989-11-06  |  5.1 KB  |  206 lines
  1. * ┌─────────────────────────────────────────────────────────────────────┐ *
  2. * │  CSTLEDGR.PRG: CUSTOMER LEDGER                                      │ *
  3. * │  Copyright (c) 1989 Tech III, Inc. All rights reserved.             │ *
  4. * │  Tech III of San Pedro, California      (213) 547-2191.             │ *
  5. * │  "The bridge connecting people and technology."(tm)                 │ *
  6. * └─────────────────────────────────────────────────────────────────────┘ *
  7. @ 00,00 SAY WINTITLE(PROMPT())
  8.  
  9. * FILE HANDLING
  10. SELECT customer
  11.  
  12. * INITIALIZE VARIABLES
  13. SET ORDER TO cus_com   && Company-name order
  14. GO TOP
  15. STORE company TO start_co && Top company name
  16. GO BOTTOM
  17. STORE company TO end_co && Bottom company name
  18.  
  19. STORE .t. TO _box, _wrap, printing
  20. STORE 79 TO _rmargin
  21. * Boxes, and word-wrapping ON, Printing is a control variable to allow
  22. * user to cancel the job.
  23.  
  24. STORE .f. TO done
  25. STORE .t. TO firstpage
  26. STORE 0   TO pageno
  27. STORE SET('MEMOWIDTH') TO memocols  && Save old setting
  28. SET MEMOWIDTH TO 36
  29.  
  30. * DEFINITIONS
  31. SET ESCAPE ON
  32. ON ESCAPE STORE .f. TO printing
  33.  
  34. DEFINE POPUP company FROM 9,15 PROMPT FIELD company
  35. ON SELECTION POPUP company DEACTIVATE POPUP
  36.  
  37. * USER INPUT: SELECT CUSTOMER RANGE TO PRINT
  38. STORE 'N' TO okay
  39. DO WHILE .NOT. okay $ 'YC'
  40.   @ 03,02 SAY 'Start with company: ' GET start_co VALID GETFRST(start_co)
  41.   @ 05,02 SAY 'End with company:   ' GET end_co VALID GETLST(end_co) ;
  42.   RANGE start_co,
  43.   @ 07,02 SAY 'Okay? Yes/No/Cancel:' GET okay PICTURE '@M Y,N,C'
  44.   READ
  45. ENDDO
  46. IF okay = 'C' && cancel
  47.   RETURN
  48. ENDIF
  49.  
  50. IF .NOT. YESNO("System is ready to print.")
  51.   RETURN
  52. ELSE
  53.   IF .NOT. READY2PR()
  54.     RETURN
  55.   ENDIF
  56. ENDIF
  57. SEEK start_co
  58.  
  59. IF .NOT. printing
  60.   DO standby WITH 'You have canceled this report.'
  61. ELSE
  62.   * START PRINTING
  63.   ACTIVATE WINDOW pticker
  64.   SET PRINT ON
  65.   SET CONSOLE OFF
  66.   
  67.   PRINTJOB
  68.     SCAN REST WHILE printing .AND. company <= end_co
  69.       DO prn_head
  70.       DO prn_cust
  71.     ENDSCAN
  72.     
  73.     EJECT
  74.   ENDPRINTJOB
  75.   SET PRINTER OFF
  76.   SET CONSOLE ON
  77.   DO standby WITH 'Your print request has been completed.'
  78.   DEACTIVATE WINDOW pticker
  79. ENDIF
  80.  
  81. RETURN
  82.  
  83. * HEADINGS
  84. PROCEDURE prn_head
  85.   IF pageno<>0
  86.     EJECT
  87.   ENDIF
  88.   STORE 0 TO _plineno, _pcolno
  89.   DEFINE BOX FROM 00 TO 79 HEIGHT 4 AT LINE 3 DOUBLE
  90.   ? PTICKER()
  91.   ? PTICKER()
  92.   ? PTICKER()
  93.   pageno=pageno+1
  94.   STORE LTRIM(STR(pageno,3)) TO pagestr
  95.   ?  PTICKER() + DTOC(DATE()) AT 2
  96.   ?? PTICKER() + 'CUSTOMER LEDGER' AT 32
  97.   ?? PTICKER() + 'PAGE:  ' + pagestr AT 68
  98.   ?  PTICKER() + 'Customer #: '+customer->cust_id+'  '+customer->company AT 2
  99.   ?  PTICKER()
  100.   ?  PTICKER() + 'Date      Description                                     Amount       Balance' AT 0
  101.   ?  PTICKER() + REPLICATE("─",80) AT 0
  102.   *             123456   12345678901234567890134567890134567890
  103.   *            0        9                                          52
  104.   *
  105.   RETURN
  106.   
  107.   
  108.   * CUSTOMER LEDGER
  109. PROCEDURE prn_cust
  110.   
  111.   *locate the first invoice for the customer
  112.   SELECT invoice
  113.   SET ORDER TO inv_cus
  114.   thiscust=customer->cust_id
  115.   SEEK thiscust
  116.   moreinv=FOUND()
  117.   minv_date=IIF(moreinv,inv_date,{12/31/99})
  118.   
  119.   *locate the first payment for the customer
  120.   SELECT payments
  121.   SEEK thiscust
  122.   morepmt=FOUND()
  123.   mpmt_date=IIF(morepmt,DATE,{12/31/99})
  124.   
  125.   custbal=0
  126.   
  127.   DO WHILE moreinv .OR. morepmt 
  128.     IF (minv_date <= mpmt_date) .OR. EOF("customer")
  129.       SELECT invoice
  130.       ? PTICKER() + DTOC(invoice->inv_date)
  131.       ?? '  '
  132.       ?? 'Invoice:'+STR(invoice->invoice,6,0)
  133.       STORE INVSUB() + INVTAX() TO invamt
  134.       ?? TRANSFORM(invamt,'99,999,999.99') AT 50
  135.       custbal= custbal + invamt
  136.       ?? TRANSFORM((custbal),'99,999,999.99') AT 65
  137.       SELECT invoice
  138.       SKIP
  139.       moreinv = (cust_id=thiscust) .AND. .NOT. EOF()
  140.       minv_date=IIF(moreinv,inv_date,{12/31/99})
  141.     ELSE
  142.       IF morepmt
  143.         SELECT payments
  144.         ? PTICKER() + DTOC(mpmt_date)
  145.         ?? '  '
  146.         ?? 'Payment: '+payments->reference
  147.         ?? TRANSFORM(-1*payments->amount,'99,999,999.99') AT 50
  148.         custbal=custbal-payments->amount
  149.         ?? TRANSFORM((custbal),'99,999,999.99') AT 65
  150.         SKIP
  151.         morepmt = (cust_id=thiscust) .AND. .NOT. EOF()
  152.         mpmt_date=IIF(morepmt,DATE,{12/31/99})
  153.       ENDIF
  154.     ENDIF
  155.     IF PROW() > 52
  156.       DO prn_foot
  157.     ENDIF
  158.   ENDDO
  159.   SELECT customer
  160.   RETURN
  161.   
  162.   * FOOTERS
  163. PROCEDURE prn_foot
  164.   IF .NOT. PRINTSTATUS()
  165.     RETURN
  166.   ENDIF
  167.   EJECT
  168.   STORE _pageno + 1 TO _pageno
  169.   IF .NOT. done
  170.     DO prn_head
  171.   ENDIF
  172.   RETURN
  173.   
  174.   
  175. FUNCTION getfrst
  176.   PARAMETER a_coname
  177.   SEEK a_coname
  178.   DO WHILE .NOT. FOUND()
  179.     keyboard LEFT(a_coname,1)
  180.     ACTIVATE POPUP company
  181.     IF EMPTY(PROMPT())
  182.       LOOP
  183.     ENDIF
  184.     STORE PROMPT() TO start_co
  185.     SEEK start_co
  186.   ENDDO
  187.   RETURN .t.
  188.   
  189. FUNCTION getlst
  190.   PARAMETER a_coname
  191.   SEEK a_coname
  192.   DO WHILE .NOT. FOUND()
  193.     SET FILTER TO company >= start_co
  194.     keyboard LEFT(a_coname,1)
  195.     ACTIVATE POPUP company
  196.     IF EMPTY(PROMPT())
  197.       LOOP
  198.     ENDIF
  199.     STORE PROMPT() TO end_co
  200.     SEEK end_co
  201.   ENDDO
  202.   SET FILTER TO
  203.   RETURN .t.
  204.   
  205.   *
  206.