home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / FOXDCOMP.ZIP / TEST.PRG < prev   
Encoding:
Text File  |  1990-12-04  |  16.6 KB  |  526 lines
  1. * PROGRAM.: test.PRG
  2. * Author..: Barry Doyle
  3. * DATE....: 05/21/90
  4. * NOTES...: Example program source for FOXDCOMP.
  5.  
  6. * initialize new variables
  7. usermsg="Enter transaction number or data        "
  8. fkeys="[ESC] Exit [^End] Retrieve/Add     "
  9. data_flag = "N"
  10.  
  11. * open database
  12. SELECT A
  13. USE sequence
  14. SELECT B
  15. USE tranhist INDEX tranhist, trancli, tranver
  16. SELECT C
  17. USE client INDEX client
  18.  
  19. DO WHILE .T.
  20. * The DO WHILE will be terminated by an EXIT command
  21.    IF data_flag = "E"                 && edit error were found
  22.       IF action = "ADD"
  23.          SET FORMAT TO tru30s1
  24.       ELSE
  25.          SET FORMAT TO tru30s2
  26.       ENDIF
  27.       IF w_tran_nbr = 00000
  28.          data_flag = "N"
  29.          fkeys="[ESC] Exit [^End] Retrieve/Add     "
  30.          @ 23 , 43 SAY fkeys
  31.       ELSE
  32.          data_flag = "Y"
  33.       ENDIF
  34.    ELSE
  35.       ctime=TIME()
  36.       if data_flag = "Y"              && amount and type can't change
  37.          SET FORMAT TO tru30s2
  38.       ELSE
  39.          SET FORMAT TO tru30s1
  40.       ENDIF
  41.  
  42.       IF data_flag= "N"               && no data to modify is on screen
  43.          CLEAR
  44.          fkeys="[ESC] Exit [^End] Retrieve/Add     "
  45.          prv_tran   = 00000
  46.          w_tran_nbr = 00000
  47.          w_client   = 00000
  48.          w_type     = space(2)
  49.          w_amount   = 0000000.00
  50.          w_typedesc = space(20)
  51.          w_pay_name = space(40)
  52.          w_pay_str  = space(30)
  53.          w_pay_city = space(25)
  54.          w_pay_st   = space(2)
  55.          w_pay_zip  = space(15)
  56.          w_desc     = space(50)
  57.          w_stat     = "AC"
  58.          w_statmean = space(20)
  59.          w_prt_chk  = " "
  60.          w_cancel   = " "
  61.          w_chk_nbr  = 000000
  62.          w_cname    = space(51)
  63.          w_add_dt   = CTOD("  /  /  ")
  64.          w_fund_dt  = CTOD("  /  /  ")
  65.          w_chk_pdte = CTOD("  /  /  ")
  66.          w_chk_ptme = space(5)
  67.          w_rule     = 00000
  68.          w_inv_reas = space(30)
  69.          w_bef_bal  = 0000000.00
  70.          w_aft_bal  = 0000000.00
  71.       ELSE                            && data is on screen to modify
  72.          fkeys="[ESC] Exit [^End] Retrieve/Modify  "
  73.       ENDIF && If data_flag = "N"
  74.    ENDIF && If data_flag = "E"
  75.  
  76.    READ
  77.  
  78.    w_type=UPPER(w_type)
  79.    w_prt_chk=UPPER(w_prt_chk)
  80.    w_cancel=UPPER(w_cancel)
  81.    usermsg=SPACE(40)
  82.  
  83.    * get key pressed
  84.    keyhit = READKEY()
  85.  
  86.    * process user response
  87.    action="NO "
  88.    IF keyhit = 12 .OR. keyhit = 268    && escape
  89.       EXIT
  90.    ENDIF
  91.  
  92.    IF keyhit = 14  .OR.;
  93.       keyhit = 15  .OR.;
  94.       keyhit = 270 .OR.;
  95.       keyhit = 271
  96.       IF data_flag = "N"
  97.          IF w_tran_nbr = 00000
  98.             action = "ADD"
  99.          ELSE
  100.             action = "GET"
  101.          ENDIF && w_tran_nbr not = 0
  102.       ELSE     && data_flag was "Y"
  103.          IF w_tran_nbr = 00000
  104.             action = "ADD"
  105.          ELSE
  106.             IF w_tran_nbr = prv_tran
  107.                action = "MOD"
  108.             ELSE
  109.                action = "GET"
  110.             ENDIF
  111.          ENDIF && w_tran_nbr = 0
  112.       ENDIF && If data_flag = 'N'
  113.    ELSE && If keyhit was enter
  114.       usermsg="Bad key hit - control data not updated  "
  115.       action = "NO "
  116.    ENDIF && If keyhit was enter
  117.  
  118.    passedit = "Y"
  119.    * perform action as determined above
  120.    IF action = "GET"
  121.       SELECT B
  122.       SEEK w_tran_nbr
  123.       IF FOUND()
  124.          data_flag = "Y"
  125.          usermsg="Transaction retrieved - Enter changes"
  126.          prv_tran   = tran_nbr
  127.          w_tran_nbr = tran_nbr
  128.          w_client   = client_nbr
  129.          w_type     = tran_type
  130.          DO CASE
  131.            CASE w_type = "MW"
  132.               w_typedesc = "Manual Withdrawal   "
  133.            CASE w_type = "MD"
  134.               w_typedesc = "Manual Deposit      "
  135.            CASE w_type = "AW"
  136.               w_typedesc = "Automatic Withdrawal"
  137.            CASE w_type = "AD"
  138.               w_typedesc = "Automatic Deposit   "
  139.            CASE w_type = "PA"
  140.               w_typedesc = "Positive Adjustment "
  141.            CASE w_type = "NA"
  142.               w_typedesc = "Negative Adjustment "
  143.            CASE w_type = "CW"
  144.               w_typedesc = "W/D Cancel Adj.     "
  145.            CASE w_type = "CD"
  146.               w_typedesc = "Deposit Cancel Adj. "
  147.            CASE w_type = "CP"
  148.               w_typedesc = "Pos/Adj Cancel Adj. "
  149.            CASE w_type = "CN"
  150.               w_typedesc = "Neg/Adj Cancel Adj. "
  151.            OTHERWISE
  152.               w_typedesc = space(20)
  153.          ENDCASE
  154.          w_amount   = tran_amt
  155.          w_pay_name = tran_name
  156.          w_pay_str  = tran_str
  157.          w_pay_city = tran_city
  158.          w_pay_st   = tran_state
  159.          w_pay_zip  = tran_zip
  160.          w_desc     = tran_desc
  161.          w_stat     = tran_stat
  162.          DO CASE
  163.            CASE w_stat = "AC"
  164.               w_statmean = "Accepted            "
  165.            CASE w_stat = "RJ"
  166.               w_statmean = "Rejected            "
  167.            CASE w_stat = "UV"
  168.               w_statmean = "Unverified          "
  169.            CASE w_stat = "CA"
  170.               w_statmean = "Cancelled           "
  171.            OTHERWISE
  172.               w_statmean = space(20)
  173.          ENDCASE
  174.          w_prt_chk  = " "
  175.          w_cancel   = " "
  176.          w_chk_nbr  = chk_nbr
  177.          w_add_dt   = tran_date
  178.          w_fund_dt  = fund_date
  179.          w_chk_pdte = chk_pdate
  180.          w_chk_ptme = chk_ptime
  181.          w_rule     = tran_rule
  182.          w_inv_reas = inv_reason
  183.          w_bef_bal  = before_bal
  184.          w_aft_bal  = after_bal
  185.          SELECT C
  186.          SEEK w_client
  187.          w_cname    = TRIM(first_name) + " " + last_name
  188.          w_balance  = bal_amount
  189.       ELSE
  190.          usermsg="Transaction " + LTRIM(STR(w_tran_nbr)) + " not found"
  191.          data_flag = "N"
  192.       ENDIF
  193.    ELSE && (action = "GET")
  194.       IF action = "ADD"                    && add edits start
  195.          SELECT C
  196.          SEEK w_client
  197.          IF .NOT. FOUND()
  198.             usermsg="Client number is not on file            "
  199.             data_flag = "E"
  200.             passedit = "N"
  201.          ENDIF
  202.  
  203.          IF passedit = "Y"
  204.             IF (w_type <> "MD") .AND.;
  205.                (w_type <> "MW") .AND.;
  206.                (w_type <> "PA") .AND.;
  207.                (w_type <> "NA")
  208.                usermsg="Type must be MD, MW, PA, or NA          "
  209.                data_flag = "E"
  210.                passedit = "N"
  211.             ENDIF
  212.          ENDIF
  213.  
  214.          IF passedit = "Y"
  215.             IF (w_amount = 0) .OR.;
  216.                (w_amount < 0)
  217.                usermsg="Amount must be greater than zero        "
  218.                data_flag = "E"
  219.                passedit = "N"
  220.             ENDIF
  221.          ENDIF
  222.  
  223.          IF passedit = "Y"
  224.             IF (w_type = "MW") .OR.;
  225.                (w_type = "NA")
  226.                IF (w_amount > bal_amount)
  227.                   usermsg="Insufficient client balance - rejected  "
  228.                   data_flag = "E"
  229.                   passedit="N"
  230.                ENDIF
  231.             ENDIF
  232.          ENDIF
  233.  
  234.          IF passedit = "Y"
  235.             IF (w_type <> "MW") .AND.;
  236.                (w_chk_nbr <> 000000)
  237.                usermsg="Check # is only valid for withdrawal"
  238.                data_flag = "E"
  239.                passedit="N"
  240.             ENDIF
  241.          ENDIF
  242.  
  243.          IF passedit = "Y"                 && add edits passed.
  244.             SELECT A                       && modify sequence.
  245.             w_tran_nbr = tran_seq + 1
  246.             prv_tran   = w_tran_nbr
  247.             REPLACE tran_seq    WITH w_tran_nbr
  248.             SELECT C                       && modify client.
  249.             SEEK w_client
  250.             w_bef_bal = bal_amount
  251.             IF (w_type = "MD") .OR.;
  252.                (w_type = "PA")
  253.                w_aft_bal = w_bef_bal + w_amount
  254.             ELSE
  255.                w_aft_bal = w_bef_bal - w_amount
  256.             ENDIF
  257.             w_balance = w_aft_bal
  258.             REPLACE bal_amount  WITH w_aft_bal
  259.             SELECT B                       && add tranhist
  260.             APPEND BLANK
  261.             REPLACE tran_nbr    WITH w_tran_nbr
  262.             REPLACE tran_type   WITH w_type
  263.             REPLACE client_nbr  WITH w_client
  264.             REPLACE tran_date   WITH DATE()
  265.             REPLACE fund_date   WITH DATE()
  266.             REPLACE chk_pdate   WITH CTOD("  /  /  ")
  267.             REPLACE chk_ptime   WITH space(5)
  268.             REPLACE tran_rule   WITH 00000
  269.             REPLACE tran_amt    WITH w_amount
  270.             REPLACE tran_stat   WITH "AC"
  271.             REPLACE before_bal  WITH w_bef_bal
  272.             REPLACE after_bal   WITH w_aft_bal
  273.             w_statmean = "Accepted"
  274.             DO CASE
  275.               CASE w_type = "MW"
  276.                  w_typedesc = "Manual Withdrawal   "
  277.               CASE w_type = "MD"
  278.                  w_typedesc = "Manual Deposit      "
  279.               CASE w_type = "PA"
  280.                  w_typedesc = "Positive Adjustment "
  281.               CASE w_type = "NA"
  282.                  w_typedesc = "Negative Adjustment "
  283.               OTHERWISE
  284.                  w_typedesc = space(20)
  285.             ENDCASE
  286.             action = "MOA"
  287.             data_flag = "Y"
  288.          ENDIF
  289.       ENDIF
  290.    ENDIF
  291.  
  292.    IF action = "MOD"
  293.       SELECT B
  294.       SEEK w_tran_nbr
  295.       passedit = "Y"
  296.  
  297.       IF w_stat = "CA" .AND. w_prt_chk = "Y"
  298.          usermsg="Check not printed - cancelled trans.    "
  299.          data_flag = "E"
  300.          passedit="N"
  301.       ENDIF
  302.  
  303.       IF w_stat <> "AC" .AND. w_prt_chk = "Y"
  304.          usermsg="Check not printed - status must be AC"
  305.          data_flag = "E"
  306.          passedit="N"
  307.       ENDIF
  308.  
  309.       IF passedit = "Y"
  310.          IF w_prt_chk <> "Y" .AND. w_prt_chk <> " "
  311.             usermsg="Print check must be Y or blank          "
  312.             data_flag = "E"
  313.             passedit="N"
  314.          ENDIF
  315.       ENDIF
  316.  
  317.       IF passedit = "Y"
  318.          IF w_prt_chk = "Y" .AND.;
  319.             w_type <> "MW"  .AND.;
  320.             w_type <> "AW"
  321.             usermsg="Can only print check for withdrawal"
  322.             data_flag = "E"
  323.             passedit="N"
  324.          ENDIF
  325.       ENDIF
  326.  
  327.       IF passedit = "Y"
  328.          IF w_stat = "CA" .AND. w_cancel = "Y"
  329.             usermsg="Transaction is already cancelled        "
  330.             data_flag = "E"
  331.             passedit="N"
  332.          ENDIF
  333.       ENDIF
  334.  
  335.       IF passedit = "Y"
  336.          IF w_type = "CN" .OR.;
  337.             w_type = "CP" .OR.;
  338.             w_type = "CD" .OR.;
  339.             w_type = "CW"
  340.             usermsg="Cancel adj. trans. can't be cancelled"
  341.             data_flag = "E"
  342.             passedit="N"
  343.          ENDIF
  344.       ENDIF
  345.  
  346.       IF passedit = "Y"
  347.          IF w_cancel <> "Y" .AND. w_cancel <> " "
  348.             usermsg="Cancel must be Y or blank               "
  349.             data_flag = "E"
  350.             passedit="N"
  351.          ENDIF
  352.       ENDIF
  353.  
  354.       IF passedit = "Y"
  355.          IF w_cancel <> " " .AND. w_prt_chk <> " "
  356.             usermsg="Both cancel and print selected          "
  357.             data_flag = "E"
  358.             passedit="N"
  359.          ENDIF
  360.       ENDIF
  361.  
  362.       IF passedit = "Y"
  363.          IF w_type = "PA" .OR.;
  364.             w_type = "MD" .OR.;
  365.             w_type = "AD"
  366.             IF w_cancel = "Y"       .AND.;
  367.                tran_amt > w_balance .AND.;
  368.                w_stat = "AC"
  369.                usermsg="Not cancelled - insufficient funds      "
  370.                data_flag = "E"
  371.                passedit="N"
  372.             ENDIF
  373.          ENDIF
  374.       ENDIF
  375.  
  376.       IF passedit = "Y"
  377.          IF ((w_type <> "MW")  .AND.;
  378.              (w_type <> "AW")) .AND.;
  379.             (w_chk_nbr <> 000000)
  380.             usermsg="Check # is only valid for withdrawal"
  381.             data_flag = "E"
  382.             passedit="N"
  383.          ENDIF
  384.       ENDIF
  385.  
  386.    ENDIF
  387.  
  388.    IF passedit = "Y"
  389.       IF action = "MOD" .OR. action = "MOA"
  390.          REPLACE tran_name   WITH w_pay_name
  391.          REPLACE tran_str    WITH w_pay_str
  392.          REPLACE tran_city   WITH w_pay_city
  393.          REPLACE tran_state  WITH w_pay_st
  394.          REPLACE tran_zip    WITH w_pay_zip
  395.          REPLACE tran_desc   WITH w_desc
  396.          REPLACE tran_stat   WITH w_stat
  397.          REPLACE chk_nbr     WITH w_chk_nbr
  398.          IF w_cancel = "Y"
  399.             REPLACE tran_stat WITH "CA"
  400.          ENDIF
  401.  
  402.          IF action = "MOD"
  403.             usermsg="Transaction " + LTRIM(STR(w_tran_nbr))
  404.             IF w_cancel = "Y"
  405.                SELECT C                    && modify client balance
  406.                SEEK w_client
  407.                w_bef_bal = bal_amount
  408.                w_aft_bal = bal_amount
  409.                IF (w_type = "MD") .OR.;
  410.                   (w_type = "PA") .OR.;
  411.                   (w_type = "AD")
  412.                   IF w_stat = "AC"
  413.                      w_aft_bal = w_bef_bal - w_amount
  414.                   ENDIF
  415.                ELSE
  416.                   IF w_stat = "AC"
  417.                      w_aft_bal = w_bef_bal + w_amount
  418.                   ENDIF
  419.                ENDIF
  420.                w_balance = w_aft_bal
  421.                REPLACE bal_amount  WITH w_aft_bal
  422.                SELECT A             && modify sequence for adjusting txn
  423.                w_tran_nbr = tran_seq + 1
  424.                REPLACE tran_seq    WITH w_tran_nbr
  425.                SELECT B            && add adjusting tranhist
  426.                APPEND BLANK
  427.                REPLACE tran_nbr    WITH w_tran_nbr
  428.  
  429.                IF w_type = "AW" .OR. w_type = "MW"
  430.                   REPLACE tran_type   WITH "CW"
  431.                ELSE
  432.                   IF w_type = "AD" .OR. w_type = "MD"
  433.                      REPLACE tran_type   WITH "CD"
  434.                   ELSE
  435.                      IF w_type = "PA"
  436.                         REPLACE tran_type   WITH "CP"
  437.                      ELSE
  438.                         REPLACE tran_type   WITH "CN"
  439.                      ENDIF
  440.                   ENDIF
  441.                ENDIF
  442.  
  443.                REPLACE client_nbr  WITH w_client
  444.                REPLACE tran_date   WITH DATE()
  445.                REPLACE fund_date   WITH DATE()
  446.                REPLACE tran_rule   WITH 00000
  447.                REPLACE tran_amt    WITH w_amount
  448.                REPLACE tran_stat   WITH "AC"
  449.                REPLACE before_bal  WITH w_bef_bal
  450.                REPLACE after_bal   WITH w_aft_bal
  451.                REPLACE tran_name   WITH w_pay_name
  452.                REPLACE tran_str    WITH w_pay_str
  453.                REPLACE tran_city   WITH w_pay_city
  454.                REPLACE tran_state  WITH w_pay_st
  455.                REPLACE tran_zip    WITH w_pay_zip
  456.                REPLACE tran_desc   WITH usermsg + " cancel adjustment"
  457.                usermsg = usermsg + " cancelled"
  458.             ELSE
  459.                usermsg = usermsg + " modified"
  460.             ENDIF
  461.  
  462.             data_flag = "N"
  463.          ELSE && if w_cancel = "Y"
  464.             usermsg="Transaction " + LTRIM(STR(w_tran_nbr)) + " added"
  465.             data_flag = "N"
  466.          ENDIF && "MOD" or "MOA"
  467.          * Print check logic
  468.          IF w_prt_chk = "Y"
  469.             SET PRINT ON
  470.             IF chk_pdate = CTOD("  /  /  ")
  471.                REPLACE chk_pdate WITH DATE()
  472.                REPLACE chk_ptime WITH SUBSTR(TIME(), 1, LEN(TIME()) - 3)
  473.             ENDIF
  474.             w_line = 1
  475.             DO WHILE w_line < w_chkdtrow
  476.                ? " "
  477.                w_line = w_line + 1
  478.             ENDDO
  479.             ? SPACE(w_chkdtcol - 1) + DTOC(fund_date)
  480.             w_line = w_line + 1
  481.             DO WHILE w_line < w_chkptrow
  482.                ? " "
  483.                w_line = w_line + 1
  484.             ENDDO
  485.             ? SPACE(w_chkptcol - 1) + tran_name
  486.             p_tran_amt = "$" + LTRIM(STR(tran_amt,10,2))
  487.             w_leadsp = 12 - LEN(p_tran_amt)
  488.             p_tran_amt = SPACE(w_leadsp) + p_tran_amt
  489.             ?? SPACE(w_chkamcol - LEN(tran_name)) + p_tran_amt
  490.             DO WHILE w_line < w_chkdorow
  491.                ? " "
  492.                w_line = w_line + 1
  493.             ENDDO
  494.             p_tran_dol = LTRIM(STR(INT(tran_amt))) + " AND "
  495.             p_tran_cnt = LTRIM(STR((tran_amt - INT(tran_amt)) * 100))
  496.             p_tran_dol = p_tran_dol + p_tran_cnt + "/100"
  497.  
  498.             p_tran_dol = SPACE(w_chkdocol - 1) + p_tran_dol
  499.             ? p_tran_dol
  500.             w_stars = w_chkdolen - LEN(p_tran_dol)
  501.             ?? REPLICATE("*", w_stars)
  502.             w_line = w_line + 1
  503.             DO WHILE w_line < w_chkderow
  504.                ? " "
  505.                w_line = w_line + 1
  506.             ENDDO
  507.             ? SPACE(w_chkdecol-1) + LTRIM(STR(tran_nbr))
  508.             IF tran_rule <> 0
  509.                ?? "-" + LTRIM(STR(tran_rule))
  510.             ENDIF
  511.             DO WHILE w_line <= w_chklines
  512.                ? " "
  513.                w_line = w_line + 1
  514.             ENDDO
  515.             SET PRINT OFF
  516.          ENDIF && w_prt_chk = "Y"
  517.       ENDIF && "MOD"
  518.    ENDIF  && passedit
  519. ENDDO
  520.  
  521. * Re-Set working environment
  522. CLOSE DATABASES
  523. RETURN
  524. * Eof: test.prg
  525.  
  526.