home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / SBTAR6.ZIP / SYSBCAL.PRG < prev    next >
Encoding:
Text File  |  1990-06-18  |  23.5 KB  |  713 lines
  1. ********************** ' MultiNet Source Code ' ***********************
  2. ** '                       SBT Corporation                         ' **
  3. ** '         One Harbor Drive, Sausalito, California 94965         ' **
  4. ** '                   Telephone (415) 331-9900                    ' **
  5. ***********************************************************************
  6. ** '   (c) Copyright 1984, Revisions 1985 - 1990 SBT Corporation   ' **
  7. ** '            All Rights Reserved by SBT Corporation             ' **
  8. ** '                                                               ' **
  9. ***********************************************************************
  10. ** ' 06/12/90 = Last Update  **  SYSBCAL.PRG  **   Version 6.30.02 ' **
  11. ***********************************************************************
  12. * ' Recalculate File balances - called by SYSBUST, APUTIL,
  13. * '                                       ARUTIL, POUTIL, SOUTIL
  14. *
  15. CLOSE DATABASES
  16. SELECT a
  17. IF .NOT. m0single
  18.   DO p0sysmnt WITH .t.
  19.   IF .NOT. mreturn
  20.     RETURN
  21.   ENDIF
  22. ENDIF
  23. CLEAR
  24. @ 1,1 SAY m0date
  25. @ 1,28 SAY 'Recalculate File Balances'
  26. @ 1,73 SAY SUBSTR(m0company,79,6)
  27. @ 2,1 SAY SUBSTR(m0company,1,78)
  28. @ 6,1 SAY '*****  Opening Work Areas  *****'
  29. SET ESCAPE OFF
  30. USE &m0sysdr.sysdata
  31. STORE .f. TO mar, map, mso, mpo, mma, mar635, mso635
  32. STORE SPACE(30) TO m0apdr, m0ardr, m0sodr, m0podr, m0madr, m0cusdr, ;
  33. m0invdr, m0vendr
  34. * ' Search for custom file locator record
  35. LOCATE FOR UPPER(a->sysid) = '@@' + SUBSTR(m0comp,1,2) ;
  36. .AND. SUBSTR(a->pass2,1,1) <> 'D'
  37. IF .NOT. EOF()
  38.   * ' Setup custom file descriptors
  39.   IF LEN(TRIM(SUBSTR(a->str5,1,30))) <> 0
  40.     STORE TRIM(SUBSTR(a->str5,1,30)) TO m0cusdr
  41.   ENDIF
  42.   IF LEN(TRIM(SUBSTR(a->str6,1,30))) <> 0
  43.     STORE TRIM(SUBSTR(a->str6,1,30)) TO m0invdr
  44.   ENDIF
  45.   IF LEN(TRIM(SUBSTR(a->str7,1,30))) <> 0
  46.     STORE TRIM(SUBSTR(a->str7,1,30)) TO m0vendr
  47.   ENDIF
  48. ENDIF
  49. LOCATE FOR UPPER(sysid) = 'AP' + SUBSTR(m0comp,1,2) .AND. ;
  50. SUBSTR(a->pass2,1,1) <> 'D'
  51. IF .NOT. EOF()
  52.   STORE .t. TO map
  53.   STORE TRIM(SUBSTR(drive,61,30)) TO m0apdr
  54.   IF LEN(TRIM(m0vendr)) = 0
  55.     STORE m0apdr TO m0vendr
  56.   ENDIF
  57.   STORE m0apdr + 'APMAST' + SUBSTR(m0comp,1,2) TO apmastf
  58.   STORE m0apdr + 'APMASV' + SUBSTR(m0comp,1,2) TO apmasvf
  59.   STORE m0apdr + 'APCHCK' + SUBSTR(m0comp,1,2) TO apchckf
  60.   STORE m0vendr + 'APVEND' + SUBSTR(m0comp,1,2) TO apvendf
  61. ENDIF
  62. LOCATE FOR UPPER(sysid) = 'AR' + SUBSTR(m0comp,1,2) .AND. ;
  63. SUBSTR(a->pass2,1,1) <> 'D'
  64. IF .NOT. EOF()
  65.   STORE .t. TO mar
  66.   IF SUBSTR(drive, 198, 3) = '635'
  67.     STORE .t. TO mar635
  68.   ENDIF
  69.   STORE TRIM(SUBSTR(drive,61,30)) TO m0ardr
  70.   IF LEN(TRIM(m0cusdr)) = 0
  71.     STORE m0ardr TO m0cusdr
  72.   ENDIF
  73.   IF LEN(TRIM(m0invdr)) = 0
  74.     STORE m0ardr TO m0invdr
  75.   ENDIF
  76.   STORE m0ardr + 'ARCASH' + SUBSTR(m0comp,1,2) TO arcashf
  77.   STORE m0cusdr + 'ARCUST' + SUBSTR(m0comp,1,2) TO arcustf
  78.   STORE m0ardr + 'ARMAST' + SUBSTR(m0comp,1,2) TO armastf
  79.   STORE m0ardr + 'ARMASC' + SUBSTR(m0comp,1,2) TO armascf
  80.   STORE m0invdr + 'ARINVT' + SUBSTR(m0comp,1,2) TO arinvtf
  81.   STORE m0ardr + 'ARITRN' + SUBSTR(m0comp,1,2) TO aritrnf
  82.   STORE m0ardr + 'ARTRAN' + SUBSTR(m0comp,1,2) TO artranf
  83.   STORE m0ardr + 'ARTRAC' + SUBSTR(m0comp,1,2) TO artracf
  84. ENDIF
  85. LOCATE FOR UPPER(sysid) = 'PO' + SUBSTR(m0comp,1,2) .AND. ;
  86. SUBSTR(a->pass2,1,1) <> 'D'
  87. IF .NOT. EOF()
  88.   STORE .t. TO mpo
  89.   STORE TRIM(SUBSTR(drive,61,30)) TO m0podr
  90.   IF LEN(TRIM(m0vendr)) = 0
  91.     STORE m0podr TO m0vendr
  92.   ENDIF
  93.   IF LEN(TRIM(m0invdr)) = 0
  94.     STORE m0podr TO m0invdr
  95.   ENDIF
  96.   STORE m0podr + 'POMAST' + SUBSTR(m0comp,1,2) TO pomastf
  97.   STORE m0podr + 'POMASV' + SUBSTR(m0comp,1,2) TO pomasvf
  98.   STORE m0podr + 'PORECP' + SUBSTR(m0comp,1,2) TO porecpf
  99.   IF .NOT. map
  100.     STORE m0vendr + 'APVEND' + SUBSTR(m0comp,1,2) TO povendf
  101.   ELSE
  102.     STORE apvendf TO povendf
  103.   ENDIF
  104.   IF .NOT. mar
  105.     STORE m0invdr + 'ARINVT' + SUBSTR(m0comp,1,2) TO poinvtf
  106.   ELSE
  107.     STORE arinvtf TO poinvtf
  108.   ENDIF
  109.   STORE m0podr + 'POTRAN' + SUBSTR(m0comp,1,2) TO potranf
  110. ENDIF
  111. LOCATE FOR UPPER(sysid) = 'SO' + SUBSTR(m0comp,1,2) .AND. ;
  112. SUBSTR(a->pass2,1,1) <> 'D'
  113. IF .NOT. EOF()
  114.   STORE .t. TO mso
  115.   IF SUBSTR(drive, 198, 3) = '635'
  116.     STORE .t. TO mso635
  117.   ENDIF
  118.   STORE TRIM(SUBSTR(drive,61,30)) TO m0sodr
  119.   IF LEN(TRIM(m0cusdr)) = 0
  120.     STORE m0sodr TO m0cusdr
  121.   ENDIF
  122.   IF LEN(TRIM(m0invdr)) = 0
  123.     STORE m0sodr TO m0invdr
  124.   ENDIF
  125.   STORE m0sodr + 'SOMAST' + SUBSTR(m0comp,1,2) TO somastf
  126.   STORE m0sodr + 'SOMASC' + SUBSTR(m0comp,1,2) TO somascf
  127.   STORE m0sodr + 'SOSHIP' + SUBSTR(m0comp,1,2) TO soshipf
  128.   STORE m0sodr + 'SOTRAN' + SUBSTR(m0comp,1,2) TO sotranf
  129.   IF .NOT. mar
  130.     STORE m0cusdr + 'ARCUST' + SUBSTR(m0comp,1,2) TO socustf
  131.   ELSE
  132.     STORE arcustf TO socustf
  133.   ENDIF
  134.   DO CASE
  135.     CASE .NOT. mar .AND. .NOT. mpo
  136.       STORE m0invdr + 'ARINVT' + SUBSTR(m0comp,1,2) TO soinvtf
  137.     CASE mar
  138.       STORE arinvtf TO soinvtf
  139.     CASE mpo
  140.       STORE poinvtf TO soinvtf
  141.   ENDCASE
  142. ENDIF
  143. LOCATE FOR UPPER(sysid) = 'MA' + SUBSTR(m0comp,1,2) .AND. ;
  144. SUBSTR(a->pass2,1,1) <> 'D'
  145. IF .NOT. EOF()
  146.   STORE .t. TO mma
  147.   STORE TRIM(SUBSTR(drive,61,30)) TO m0madr
  148.   IF LEN(TRIM(m0invdr)) = 0
  149.     STORE m0madr TO m0invdr
  150.   ENDIF
  151.   STORE m0madr + 'MATRAN' + SUBSTR(m0comp,1,2) TO matranf
  152.   STORE m0madr + 'MATINV' + SUBSTR(m0comp,1,2) TO matinvf
  153.   DO CASE
  154.     CASE .NOT. mar .AND. .NOT. mpo .AND. .NOT. mso
  155.       STORE m0invdr + 'ARINVT' + SUBSTR(m0comp,1,2) TO mainvtf
  156.     CASE mar
  157.       STORE arinvtf TO mainvtf
  158.     CASE mpo
  159.       STORE poinvtf TO mainvtf
  160.     CASE mso
  161.       STORE soinvtf TO mainvtf
  162.   ENDCASE
  163. ENDIF
  164. USE
  165. STORE 0.00 TO arbal, arptdbill, arptdcash, arptddisc, arinvtbal, arinvtrec, ;
  166. arptdnon, arinvtshp, arptdtax, apbal, apptdpay, apptdpaid, apptddisc, ;
  167. appapprov, apdapprov, soopen, soptdord, soptdship, poopen, poptdord, poptdrecp
  168. @ 6,0 CLEAR
  169. @ 6,1 SAY 'Step 1.  Accounts Payable'
  170. @ 8,1 SAY 'Step 2.  Accounts Receivable'
  171. @ 10,1 SAY 'Step 3.  Purchase Orders'
  172. @ 12,1 SAY 'Step 4.  Sales Orders'
  173. @ 14,1 SAY 'Step 5.  Update System File'
  174. SET ESCAPE OFF
  175. IF .NOT. map
  176.   @ 6,35 SAY SUBSTR(m0border,173,3) + ' Cancelled'
  177. ELSE
  178.   @ 6,35 SAY SUBSTR(m0border,173,3) + ' Working'
  179.   IF FILE('&apmastf..dbf')
  180.     USE &apmastf
  181.     DO p0flockd
  182.     IF lockedf
  183.       @ 22,0
  184.       @ 22,1 SAY '*****  Calculating Current AP Balance  *****'
  185.       SUM puramt - paidamt - disamt - adjamt TO apbal FOR ;
  186.       apstat <> 'V' .AND. .NOT. DELETED()
  187.       @ 22,0
  188.       @ 22,1 SAY '*****  Calculating PTD AP Payables  *****'
  189.       SUM puramt TO apptdpay FOR current = ' ' .AND. ;
  190.       apstat <> 'V' .AND. .NOT. DELETED()
  191.       @ 22,0
  192.       @ 22,1 SAY '*****  Calculating AP Approved to Pay  *****'
  193.       SUM aprpay, aprdis + apradj TO appapprov, apdapprov FOR apstat ;
  194.       <> 'V' .AND. .NOT. DELETED()
  195.     ENDIF
  196.   ENDIF
  197.   IF FILE('&apchckf..dbf')
  198.     USE &apchckf
  199.     DO p0flockd
  200.     IF lockedf
  201.       @ 22,0
  202.       @ 22,1 SAY '*****  Calculating PTD AP Payments  *****'
  203.       SUM aprpay TO apptdpaid FOR ckstat <> 'V' .AND. .NOT. ppriority $ ;
  204.       'AD' .AND. .NOT. DELETED()
  205.       @ 22,0
  206.       @ 22,1 SAY '*****  Calculating PTD AP Discounts/Adjustments *****'
  207.       SUM aprpay TO apptddisc FOR ckstat <> 'V' .AND. ppriority $ ;
  208.       'AD' .AND. .NOT. DELETED()
  209.     ENDIF
  210.   ENDIF
  211.   IF FILE('&apmastf..dbf') .AND. FILE('&apvendf..dbf') .AND. ;
  212.     FILE('&apvendf..ndx')
  213.     USE &apmastf
  214.     COPY STRUCTURE TO &m0dbfdr.&m0tmpf1
  215.     INDEX ON vendno TO &m0dbfdr.&m0tmpf1..ndx
  216.     TOTAL ON vendno TO &m0dbfdr.&m0tmpf1 FIELDS puramt, paidamt, ;
  217.     disamt, adjamt, aprpay FOR apstat <> 'V' .AND. .NOT. DELETED()
  218.     USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  219.     SELECT b
  220.     USE &apvendf INDEX &apvendf..ndx
  221.     DO p0flockd
  222.     IF lockedf
  223.       @ 22,0
  224.       @ 22,1 SAY '*****  Updating Balance in Vendor File  *****'
  225.       REPLACE ALL balance WITH 0.00, aprpay WITH 0.00
  226.       SELECT a
  227.       DO WHILE .NOT. EOF()
  228.         SELECT b
  229.         SEEK a->vendno
  230.         IF .NOT. EOF()
  231.           REPLACE balance WITH balance + a->puramt - a->paidamt - ;
  232.           a->disamt - a->adjamt, aprpay WITH aprpay + a->aprpay
  233.         ENDIF
  234.         SELECT a
  235.         SKIP
  236.       ENDDO
  237.     ENDIF
  238.     CLOSE DATABASES
  239.     SELECT a
  240.   ENDIF
  241.   @ 6,35 SAY SUBSTR(m0border,173,3) + ' Completed'
  242. ENDIF && .NOT. map
  243. IF .NOT. mar
  244.   @ 8,35 SAY SUBSTR(m0border,173,3) + ' Cancelled'
  245. ELSE
  246.   @ 8,35 SAY SUBSTR(m0border,173,3) + ' Working'
  247.   IF FILE('&armastf..dbf') .AND. FILE('&armastf..ndx')
  248.     @ 22,0
  249.     @ 22,1 SAY '*****  Calculating Current AR Balance  *****'
  250.     CLOSE DATABASES
  251.     SELECT a
  252.     * ' Re-initialize AR balances
  253.     USE &armastf
  254.     SET FILTER TO arstat <> 'V' .AND. .NOT. DELETED()
  255.     DO p0flockn
  256.     SUM balance TO arbal
  257. *\ SYSBCA02 01 06/12/90 AV Exclude tax only CMs from AR totals
  258.     SUM invamt, tax TO arptdbill, arptdtax FOR current = ' ' .AND. ;
  259.     .NOT. artype $ 'RT'
  260.     GO TOP
  261.     * ' Update customer file
  262.     SELECT b
  263.     USE &arcustf INDEX &arcustf..ndx
  264.     DO p0flockd
  265.     IF lockedf
  266.       IF mar635
  267.         REPLACE ALL balance WITH 0.00, credit WITH 0.00, forward WITH 0.00
  268.       ELSE
  269.         REPLACE ALL balance WITH 0.00, credit WITH 0.00
  270.       ENDIF
  271.       SELECT a
  272.       DO WHILE .NOT. EOF()
  273.         STORE a->custno TO mcust
  274.         SELECT b
  275.         SEEK mcust
  276.         IF .NOT. EOF()
  277.           REPLACE balance WITH balance + a->balance
  278.           * ' Update balance forward field with invoices that were in file
  279.           * ' at start of period
  280.           IF a->current = 'X' .AND. mar635
  281.             REPLACE forward WITH forward + a->balance
  282.             * ' Increase balance forward by amount of payments applied
  283.             * ' to previous period invoices in current period
  284.             SELECT c
  285. *\ SYSBCA01 01 06/08/90 LA Added ..ndx to index
  286.             USE &arcashf INDEX &arcashf..ndx
  287.             SEEK a->custno + a->invno
  288.             DO WHILE custno = a->custno .AND. invno = a->invno .AND. ;
  289.               .NOT. EOF()
  290.               IF invno = '_RECEIPT' .AND. refno <> a->refno
  291.                 * ' _RECEIPT records need to have their refno matched
  292.                 SKIP
  293.                 LOOP
  294.               ENDIF
  295.               SELECT b
  296.               REPLACE forward WITH forward + c->paidamt + c->disamt
  297.               SELECT c
  298.               SKIP
  299.             ENDDO
  300.             USE
  301.             SELECT b
  302.           ENDIF
  303.           IF a->artype $ 'CR'
  304.             REPLACE credit WITH credit - a->balance
  305.           ENDIF
  306.         ENDIF && .NOT. EOF()
  307.         SELECT a
  308.         SKIP
  309.       ENDDO
  310.     ENDIF && lockedf
  311.     CLOSE DATABASES
  312.     SELECT a
  313.   ENDIF && FILE('&armastf..dbf') .AND. FILE('&armastf..ndx')
  314.   IF FILE('&arcashf..dbf')
  315.     USE &arcashf
  316.     DO p0flockd
  317.     IF lockedf
  318.       @ 22,0
  319.       @ 22,1 SAY '*****  Calculating PTD Cash Receipts  *****'
  320.       SUM paidamt TO arptdcash FOR artype $ ' ' .AND. .NOT. DELETED()
  321.       SUM disamt TO arptddisc FOR artype $ ' R' .AND. .NOT. DELETED()
  322.       * ' Handle Non-AR receipts separately.
  323.       IF mar635
  324.         SUM paidamt TO arptdnon FOR artype $ 'N' .AND. .NOT. DELETED()
  325.       ENDIF
  326.     ENDIF
  327.   ENDIF
  328.   IF FILE('&arinvtf..dbf')
  329.     USE &arinvtf
  330.     DO p0flockd
  331.     IF lockedf
  332.       @ 22,0
  333.       @ 22,1 SAY '*****  Calculating Inventory Value  *****'
  334.       SUM onhand * cost TO arinvtbal FOR stkcode = 'Y' .AND. .NOT. DELETED()
  335.     ENDIF
  336.   ENDIF
  337.   IF FILE('&artranf..dbf')
  338.     USE &artranf
  339.     DO p0flockd
  340.     IF lockedf
  341.       @ 22,0
  342.       @ 22,1 SAY '*****  Calculating PTD AR COGS  *****'
  343.       SUM 0 - qtyshp * cost TO arinvtshp FOR arstat <> 'V' ;
  344.       .AND. current = ' ' .AND. .NOT. DELETED()
  345.     ENDIF
  346.   ENDIF
  347.   IF FILE('&aritrnf..dbf')
  348.     USE &aritrnf
  349.     DO p0flockd
  350.     IF lockedf
  351.       SUM cost * qty TO arinvtrec FOR .NOT. DELETED() .AND. CODE = 'R'
  352.     ENDIF
  353.   ENDIF
  354.   USE
  355.   @ 8,35 SAY SUBSTR(m0border,173,3) + ' Completed '
  356. ENDIF && .NOT. mar
  357. IF .NOT. mpo
  358.   @ 10,35 SAY SUBSTR(m0border,173,3) + ' Cancelled'
  359. ELSE
  360.   @ 10,35 SAY SUBSTR(m0border,173,3) + ' Working'
  361.   @ 22,0
  362.   * ' Move update of master from detail to top of PO
  363.   IF FILE('&pomastf..dbf') .AND. FILE('&potranf..dbf') .AND. ;
  364.     FILE('&potranf..ndx')
  365.     @ 22,0
  366.     @ 22,1 SAY '*****  Updating PO Totals from Detail Records  *****'
  367.     SELECT a
  368.     USE &pomastf
  369.     SET FILTER TO postat <> 'V' .AND. potype <> 'B' .AND. .NOT. DELETED()
  370.     DO p0flockd
  371.     IF lockedf
  372.       SELECT b
  373.       USE &potranf INDEX &potranf..ndx
  374.       SET FILTER TO postat <> 'V' .AND. potype <> 'B' .AND. .NOT. DELETED()
  375.       DO p0flockd
  376.       IF lockedf
  377.         SELECT a
  378.         GO TOP
  379.         DO WHILE .NOT. EOF()
  380.           STORE 0.00 TO mpuramt, mrecamt
  381.           SELECT b
  382.           SEEK a->purno
  383.           DO WHILE b->purno = a->purno .AND. .NOT. EOF()
  384.             IF (b->qtyord - b->qtyrec) * b->cost * (100 - b->disc) < 0
  385.               REPLACE extcost WITH .01 * INT((b->qtyord - b->qtyrec) * ;
  386.               b->cost * (100 - b->disc) - .5), exttax WITH .01 * ;
  387.               INT(b->extcost * b->taxrate - .5)
  388.               STORE mpuramt + .01 * INT(b->qtyord * b->cost * (100 - ;
  389.               b->disc) - .5) + .0001 * INT(b->taxrate * (b->qtyord * ;
  390.               b->cost * (100 - b->disc)) - .5) TO mpuramt
  391.               STORE mrecamt + .01 * INT(b->qtyrec * b->cost * (100 - ;
  392.               b->disc) - .5) + .0001 * INT(b->taxrate * (b->qtyrec * ;
  393.               b->cost * (100 - b->disc)) - .5) TO mrecamt
  394.             ELSE
  395.               REPLACE extcost WITH .01 * INT((b->qtyord - b->qtyrec) * ;
  396.               b->cost * (100 - b->disc) + .5), exttax WITH .01 * ;
  397.               INT(b->extcost * b->taxrate + .5)
  398.               STORE mpuramt + .01 * INT(b->qtyord * b->cost * (100 - ;
  399.               b->disc) + .5) + .0001 * INT(b->taxrate * (b->qtyord * ;
  400.               b->cost * (100 - b->disc)) + .5) TO mpuramt
  401.               STORE mrecamt + .01 * INT(b->qtyrec * b->cost * (100 - ;
  402.               b->disc) + .5) + .0001 * INT(b->taxrate * (b->qtyrec * ;
  403.               b->cost * (100 - b->disc)) + .5) TO mrecamt
  404.             ENDIF
  405.             SKIP
  406.           ENDDO && WHILE b->purno = a->purno .AND. .NOT. EOF()
  407.           SELECT a
  408.           REPLACE puramt WITH mpuramt, recamt WITH mrecamt
  409.           SKIP
  410.         ENDDO && WHILE .NOT. EOF()
  411.       ENDIF && lockedf
  412.     ENDIF && lockedf
  413.     CLOSE DATABASES
  414.     SELECT a
  415.   ENDIF && FILE('&pomastf..dbf') .AND. FILE('&potranf..dbf') .AND. etc.
  416.   IF FILE('&pomastf..dbf')
  417.     USE &pomastf
  418.     DO p0flockd
  419.     IF lockedf
  420.       @ 22,0
  421.       @ 22,1 SAY '*****  Calculating PTD PO Orders  *****'
  422.       SUM puramt TO poptdord FOR current = ' ' ;
  423.       .AND. postat <> 'V' .AND. potype <> 'B' .AND. .NOT. DELETED()
  424.       @ 22,0
  425.       @ 22,1 SAY '*****  Calculating Open Purchase Orders  *****'
  426.       SUM puramt - recamt TO poopen FOR postat <> 'V' .AND. ;
  427.       potype <> 'B'.AND. .NOT. DELETED()
  428.     ENDIF
  429.   ENDIF
  430.   IF FILE('&porecpf..dbf')
  431.     USE &porecpf
  432.     DO p0flockd
  433.     IF lockedf
  434.       @ 22,0
  435.       @ 22,1 SAY '*****  Calculating PTD PO Receipts  *****'
  436.       SUM cost * qtyrec TO poptdrecp FOR .NOT. DELETED()
  437.     ENDIF
  438.   ENDIF
  439.   * ' Move update of master from detail to top of PO
  440.   IF FILE('&pomastf..dbf') .AND. FILE('&povendf..dbf') .AND. ;
  441.     FILE('&povendf..ndx')
  442.     USE &pomastf
  443.     COPY STRUCTURE TO &m0dbfdr.&m0tmpf1
  444.     INDEX ON vendno TO &m0dbfdr.&m0tmpf1..ndx
  445.     TOTAL ON vendno TO &m0dbfdr.&m0tmpf1 FIELDS puramt, recamt FOR ;
  446.     postat <> 'V' .AND. potype <> 'B' .AND. .NOT. DELETED()
  447.     USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  448.     SELECT b
  449.     USE &povendf INDEX &povendf..ndx
  450.     DO p0flockd
  451.     IF lockedf
  452.       @ 22,0
  453.       @ 22,1 SAY '*****  Updating Open PO Balance in Vendor File  *****'
  454.       REPLACE ALL openpo WITH 0.00
  455.       SELECT a
  456.       DO WHILE .NOT. EOF()
  457.         SELECT b
  458.         SEEK a->vendno
  459.         IF .NOT. EOF()
  460.           REPLACE openpo WITH openpo + a->puramt - a->recamt
  461.         ENDIF
  462.         SELECT a
  463.         SKIP
  464.       ENDDO
  465.     ENDIF && lockedf
  466.     CLOSE DATABASES
  467.     SELECT a
  468.   ENDIF
  469.   IF FILE('&potranf..dbf') .AND. FILE('&poinvtf..dbf') .AND. ;
  470.     FILE('&poinvtf..ndx')
  471.     USE &potranf
  472.     COPY STRUCTURE TO &m0dbfdr.&m0tmpf1
  473.     INDEX ON item TO &m0dbfdr.&m0tmpf1..ndx
  474.     TOTAL ON item TO &m0dbfdr.&m0tmpf1 FIELDS qtyord, qtyrec FOR ;
  475.     postat <> 'V' .AND. potype <> 'B' .AND. .NOT. DELETED()
  476.     USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  477.     SELECT b
  478.     USE &poinvtf INDEX &poinvtf..ndx
  479.     DO p0flockd
  480.     IF lockedf
  481.       @ 22,0
  482.       @ 22,1 SAY '*****  Updating On Order in Inventory File  *****'
  483.       REPLACE ALL onorder WITH 0.000
  484.       SELECT a
  485.       DO WHILE .NOT. EOF()
  486.         SELECT b
  487.         SEEK a->item
  488.         IF .NOT. EOF()
  489.           REPLACE onorder WITH onorder + a->qtyord - a->qtyrec
  490.         ENDIF
  491.         SELECT a
  492.         SKIP
  493.       ENDDO
  494.     ENDIF && lockedf
  495.     CLOSE DATABASES
  496.     SELECT a
  497.   ENDIF
  498.   IF .NOT. mar .AND. .NOT. mso .AND. FILE('&poinvtf..dbf')
  499.     USE &poinvtf
  500.     DO p0flockd
  501.     IF lockedf
  502.       @ 22,0
  503.       @ 22,1 SAY '*****  Calculating Inventory Value  *****'
  504.       SUM onhand * cost TO arinvtbal FOR stkcode = 'Y' .AND. .NOT. DELETED()
  505.     ENDIF
  506.   ENDIF
  507.   @ 10,35 SAY SUBSTR(m0border,173,3) + ' Completed'
  508. ENDIF && .NOT. mpo
  509. IF .NOT. mso
  510.   @ 12,35 SAY SUBSTR(m0border,173,3) + ' Cancelled'
  511. ELSE
  512.   @ 12,35 SAY SUBSTR(m0border,173,3) + ' Working'
  513.   IF FILE('&somastf..dbf')
  514.     USE &somastf
  515.     SET FILTER TO sostat <> 'V' .AND. sotype <> 'B' .AND. .NOT. DELETED()
  516.     @ 22,0
  517.     @ 22,1 SAY '*****  Calculating PTD SO Orders  *****'
  518.     DO p0flockd
  519.     IF  lockedf
  520.       SUM ordamt + shpamt TO soptdord FOR current = ' '
  521.       @ 22,0
  522.       @ 22,1 SAY '*****  Calculating Open Sales Orders  *****'
  523.       SUM ordamt TO soopen
  524.       IF FILE('&socustf..dbf') .AND. FILE('&socustf..ndx') .AND. ;
  525.         FILE('&somastf..ndx')
  526.         USE &somastf
  527.         COPY STRUCTURE TO &m0dbfdr.&m0tmpf1
  528.         INDEX ON custno TO &m0dbfdr.&m0tmpf1..ndx
  529.         TOTAL ON custno TO &m0dbfdr.&m0tmpf1 FIELDS ordamt FOR ;
  530.         sostat <> 'V' .AND. sotype <> 'B' .AND. .NOT. DELETED()
  531.         USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  532.         SELECT b
  533.         USE &socustf INDEX &socustf..ndx
  534.         DO p0flockd
  535.         IF lockedf
  536.           REPLACE ALL onorder WITH 0.00
  537.           SELECT a
  538.           DO WHILE .NOT. EOF()
  539.             SELECT b
  540.             SEEK a->custno
  541.             IF .NOT. EOF()
  542.               REPLACE onorder WITH onorder + a->ordamt
  543.             ENDIF
  544.             SELECT a
  545.             SKIP
  546.           ENDDO
  547.         ENDIF && lockedf
  548.         CLOSE DATABASES
  549.         SELECT a
  550.       ENDIF
  551.     ENDIF && lockedf
  552.   ENDIF && FILE('&somastf..dbf')
  553.   IF FILE('&soshipf..dbf')
  554.     @ 22,0
  555.     @ 22,1 SAY '*****  Calculating PTD SO Shipments  *****'
  556.     USE &soshipf
  557.     DO p0flockd
  558.     IF lockedf
  559.       * ' Include tax calculated on item by item basis in PTD shipments
  560.       * ' matches calculation in soshpp
  561.       * ' (its a management report, not an accounting report)
  562.       SUM extprice + (.01 * INT(taxrate * extprice + ;
  563.       IIF(taxrate * extprice < 0, -.5, .5))) TO soptdship FOR .NOT. DELETED()
  564.     ENDIF
  565.   ENDIF
  566.   IF FILE('&soinvtf..dbf') .AND. FILE('&soinvtf..ndx')
  567.     SELECT b
  568.     USE &soinvtf INDEX &soinvtf..ndx
  569.     DO p0flockd
  570.     IF lockedf
  571.       @ 22,0
  572.       @ 22,1 SAY '*****  Clearing Allocated Inventory to Recalculate  *****'
  573.       REPLACE ALL aloc WITH 0.00
  574.       IF FILE('&sotranf..dbf')
  575.         SELECT a
  576.         USE &sotranf
  577.         COPY STRUCTURE TO &m0dbfdr.&m0tmpf1
  578.         INDEX ON item TO &m0dbfdr.&m0tmpf1..ndx
  579.         TOTAL ON item TO &m0dbfdr.&m0tmpf1 FIELDS qtyord FOR ;
  580.         sostat <> 'V' .AND. sotype <> 'B' .AND. .NOT. DELETED()
  581.         USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  582.         @ 22,0
  583.         @ 22,1 SAY '*****  Updating Allocated Inventory from Sales Orders  *****'
  584.         SELECT a
  585.         DO WHILE .NOT. EOF()
  586.           SELECT b
  587.           SEEK a->item
  588.           IF a->qtyord > 0.000 .AND. .NOT. EOF()
  589.             REPLACE aloc WITH aloc + a->qtyord
  590.           ENDIF
  591.           SELECT a
  592.           SKIP
  593.         ENDDO
  594.         SELECT a
  595.         USE
  596.       ENDIF
  597.       IF mma .AND. FILE('&matranf..dbf') .AND. FILE('&matinvf..ndx')
  598.         @ 22,0
  599.         @ 22,1 SAY '*****  Updating Allocated Inventory ' + ;
  600.         'from Manufacturing  *****'
  601.         SELECT c
  602.         USE &matranf INDEX &matinvf..ndx
  603.         COPY STRUCTURE TO &m0dbfdr.&m0tmpf1
  604.         SET FILTER TO level > 1 .AND. ;
  605.         SUBSTR(process,8,1) = 'Y' .AND. .NOT. DELETED()
  606.         GO TOP
  607.         TOTAL ON item TO &m0dbfdr.&m0tmpf1 FIELDS oqty FOR .NOT. DELETED()
  608.         SELECT a
  609.         USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  610.         INDEX ON item TO &m0dbfdr.&m0tmpf1..ndx
  611.         DO WHILE .NOT. EOF()
  612.           STORE 0 TO mfqty
  613.           SELECT c
  614.           SEEK a->item
  615.           DO WHILE item = a->item .AND. .NOT. EOF()
  616.             IF SUBSTR(process,6,1) = 'Y'
  617.               STORE fqty + mfqty TO mfqty
  618.             ENDIF
  619.             SKIP
  620.           ENDDO
  621.           SELECT b
  622.           SEEK a->item
  623.           IF .NOT. EOF()
  624.             REPLACE aloc WITH aloc + a->oqty + mfqty
  625.           ENDIF
  626.           SELECT a
  627.           SKIP
  628.         ENDDO
  629.       ENDIF && mma .AND. FILE('&matranf..dbf') .AND. FILE('&matinvf..ndx')
  630.     ENDIF && lockedf
  631.     CLOSE DATABASES
  632.     SELECT a
  633.   ENDIF
  634.   IF .NOT. mar .AND. FILE('&soinvtf..dbf')
  635.     USE &soinvtf
  636.     DO p0flockd
  637.     IF lockedf
  638.       @ 22,0
  639.       @ 22,1 SAY '*****  Calculating Inventory Value  *****'
  640.       SUM onhand * cost TO arinvtbal FOR stkcode = 'Y' .AND. .NOT. DELETED()
  641.     ENDIF
  642.   ENDIF
  643.   @ 12,35 SAY SUBSTR(m0border,173,3) + ' Completed'
  644. ENDIF && .NOT. mso
  645. @ 14,35 SAY SUBSTR(m0border,173,3) + ' Working'
  646. USE &m0sysdr.sysdata
  647. DO p0flockd
  648. IF lockedf
  649.   @ 22,0
  650.   @ 22,1 SAY '***** Updating Business Status Fields in System File  *****'
  651.   IF map
  652.     LOCATE FOR UPPER(sysid) = 'AP' + SUBSTR(m0comp,1,2)
  653.     REPLACE num1 WITH apbal, num2 WITH apptdpay, num3 WITH apptdpaid, ;
  654.     num4 WITH appapprov, num6 WITH apptddisc, num7 WITH apdapprov
  655.   ENDIF
  656.   IF mar
  657.     LOCATE FOR UPPER(sysid) = 'AR' + SUBSTR(m0comp,1,2)
  658.     REPLACE num1 WITH arbal, num2 WITH arptdbill, num3 WITH arptdcash, ;
  659.     num4 WITH arinvtbal, num5 WITH arinvtrec, num6 WITH arinvtshp
  660.     REPLACE num7 WITH arptdtax, num8 WITH arptddisc, num9 WITH arptdnon
  661.   ENDIF
  662.   IF mpo
  663.     LOCATE FOR UPPER(sysid) = 'PO' + SUBSTR(m0comp,1,2)
  664.     REPLACE num1 WITH poopen, num2 WITH poptdord, num3 WITH poptdrecp
  665.     IF .NOT. mar
  666.       REPLACE num4 WITH arinvtbal, num5 WITH arinvtrec
  667.     ELSE
  668.       * ' Set to zero if AR set to new value
  669.       REPLACE num4 WITH 0, num5 WITH 0
  670.     ENDIF
  671.   ENDIF
  672.   IF mso
  673.     LOCATE FOR UPPER(sysid) = 'SO' + SUBSTR(m0comp,1,2)
  674.     REPLACE num1 WITH soopen, num2 WITH soptdord, num3 WITH soptdship
  675.     IF .NOT. mar .AND. .NOT. mpo
  676.       REPLACE num4 WITH arinvtbal, num5 WITH arinvtrec
  677.     ELSE
  678.       * ' Set to zero if AR set to new value
  679.       REPLACE num4 WITH 0, num5 WITH 0
  680.     ENDIF
  681.   ENDIF
  682.   IF mma
  683.     * ' Set to zero if AR sets new value/locate just if mma
  684.     LOCATE FOR UPPER(sysid) = 'MA' + SUBSTR(m0comp,1,2)
  685.     IF .NOT. mar .AND. .NOT. mpo .AND. .NOT. mso
  686.       REPLACE num4 WITH arinvtbal, num5 WITH arinvtrec
  687.     ELSE
  688.       REPLACE num4 WITH 0, num5 WITH 0
  689.     ENDIF
  690.   ENDIF
  691. ENDIF && lockedf
  692. USE
  693. IF FILE('&m0dbfdr.&m0tmpf1..dbf')
  694.   DELETE FILE &m0dbfdr.&m0tmpf1..dbf
  695. ENDIF
  696. IF FILE('&m0dbfdr.&m0tmpf1..ndx')
  697.   DELETE FILE &m0dbfdr.&m0tmpf1..ndx
  698. ENDIF
  699. @ 22,0
  700. @ 14,35 SAY SUBSTR(m0border,173,3) + ' Completed'
  701. SET ESCAPE ON
  702. IF .NOT. m0single
  703.   DO p0sysmnt WITH .f.
  704. ENDIF
  705. RETURN
  706. *
  707. * ' $Revision:   1.31  $
  708. * ' $Date:   18 Jun 1990 10:18:08  $
  709. ***********************
  710. *** ' SYSBCAL.PRG ' ***
  711. *** ' 711 Lines   ' ***
  712. ***********************
  713.