home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / SBTAR4.ZIP / ARLKGL.PRG < prev    next >
Encoding:
Text File  |  1990-06-04  |  7.3 KB  |  268 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/04/90 = Last Update  **  ARLKGL.PRG  **    Version 6.35.00 ' **
  11. ***********************************************************************
  12. * ' Release Postings to General Ledger - called by ARMENU
  13. *
  14. CLOSE DATABASES
  15. @ 21,0 CLEAR
  16. @ 22,2 SAY '*****  Checking General Ledger Linking File  *****'
  17. SELECT b
  18. USE &m0gllkf
  19. LOCATE FOR amount <> 0.00
  20. IF EOF()
  21.   USE
  22.   SELECT a
  23.   STORE ' ' TO mans
  24.   ?? CHR(7)
  25.   @ 22,0
  26.   @ 22,2 SAY 'No postings found in Ledger linking file. ' + ;
  27.   'Press any key...' GET mans
  28.   READ
  29.   RETURN
  30. ENDIF
  31. SET ESCAPE OFF
  32. SUM amount TO mbal
  33. STORE 0 - mbal TO mbal
  34. SELECT a
  35. USE &m0sysdr.sysdata
  36. LOCATE FOR UPPER(sysid) = 'GL' + SUBSTR(m0link,2,2)
  37. IF EOF() .OR. SUBSTR(pass2,1,1) = 'D' .OR. DELETED() .OR. SUBSTR(a->link,21,9) ;
  38.   = SPACE(9)
  39.   STORE '39999-   ' TO msuspens
  40. ELSE
  41.   STORE SUBSTR(a->link,21,9) TO msuspens
  42. ENDIF
  43. LOCATE FOR UPPER(sysid) = m0pgmid + SUBSTR(m0comp,1,2)
  44. DO p0rlockd
  45. IF .NOT. lockedr
  46.   CLOSE DATABASES
  47.   SET ESCAPE ON
  48.   RETURN
  49. ENDIF
  50. STORE SUBSTR(a->link,193,8) TO mbegin
  51. STORE TRIM(SUBSTR(link,4,30)) + m0pgmid + 'GLTR' + ;
  52. SUBSTR(a->link,2,2) TO mgltrf
  53. STORE TRIM(SUBSTR(link,4,30)) + m0pgmid + 'GLHD' + ;
  54. SUBSTR(a->link,2,2) TO mglhdf
  55. IF DTOC(CTOD(mbegin)) <> mbegin
  56.   STORE DTOC(m0date) TO mbegin
  57. ENDIF
  58. STORE SUBSTR(STR(1000 + VAL(SUBSTR(a->link,37,3)),4,0),2,3) TO mbatch
  59. STORE 'Y' TO mans
  60. @ 22,0
  61. @ 22,2 SAY 'Do you want to print a Posting Register ? (Y/N) ' + ;
  62. SUBSTR(m0border,181,5) GET mans PICTURE 'Y'
  63. READ
  64. IF mans = 'Y'
  65.   @ 22,0
  66.   @ 22,2 SAY 'Turn on printer and align paper. Ready to ' + ;
  67.   'print? (Y/N) ' + SUBSTR(m0border,180,7) GET mans PICTURE 'Y'
  68.   READ
  69.   @ 22,0
  70.   IF mans = 'N'
  71.     RETURN
  72.   ENDIF
  73.   @ 22,2 SAY '*****  Printing Posting Register  *****'
  74.   SELECT b
  75.   COPY TO &m0dbfdr.&m0tmpf1 FOR amount <> 0.00
  76.   SELECT c
  77.   USE &m0dbfdr.&m0tmpf1 EXCLUSIVE
  78.   IF VAL(STR(mbal,10,2)) <> 0.00
  79.     APPEND BLANK
  80.     REPLACE account WITH 'SUSPENSE ', amount WITH mbal
  81.   ENDIF
  82.   REPLACE ALL begin WITH mbegin, end WITH DTOC(m0date), batch WITH mbatch
  83.   INDEX ON account TO &m0dbfdr.&m0tmpf1..ndx
  84.   GO TOP
  85.   IF DATE() <> CTOD('01/01/80')
  86.     STORE '; Printed  at ' + TIME() TO mtime
  87.   ELSE
  88.     STORE ' ' TO mtime
  89.   ENDIF
  90.   DO p0setprn WITH 'OFF', 'PRINT', 'ON', 0
  91.   REPORT FORM &m0cmddr.sysgllk FOR amount <> 0.00 HEADING ;
  92.   [Posting from &m0system.&mtime.; for &m0cname.] TO PRINT
  93.   DO p0setprn WITH 'ON', 'SCREEN', 'OFF', 0
  94.   USE
  95.   DELETE FILE &m0dbfdr.&m0tmpf1..dbf
  96.   DELETE FILE &m0dbfdr.&m0tmpf1..ndx
  97.   SELECT b
  98.   GO TOP
  99. ENDIF
  100. SELECT b
  101. IF VAL(STR(mbal,10,2)) <> 0.00
  102.   ?? CHR(7)
  103.   STORE ' ' TO mans
  104.   @ 21,0 CLEAR
  105.   @ 21,2 SAY 'This Ledger posting is not balanced (Credits <> Debits).'
  106.   @ 22,2 SAY 'A balancing entry will be posted to the Suspense account.'
  107.   @ 23,2 SAY 'Press any key to continue...' GET mans
  108.   READ
  109.   @ 21,0 CLEAR
  110.   @ 22,2 SAY 'Confirm Suspense account or blanks to quit ' + ;
  111.   SUBSTR(m0border,180,6) GET msuspens PICTURE '#####-###'
  112.   READ
  113.   SELECT d
  114.   USE &m0glanf INDEX &m0glanf..ndx
  115.   DO WHILE .t.
  116.     SEEK msuspens
  117.     IF msuspens <> ' ' .AND. (d->glstat = 'I' .OR. DELETED() .OR. EOF())
  118.       ?? CHR(7)
  119.       @ 22,2 SAY 'Confirm Suspense account or blanks to quit ' + ;
  120.       SUBSTR(m0border,180,6) GET msuspens PICTURE '#####-###'
  121.       @ 23,2 SAY 'Invalid or Inactive account.  Please reenter...'
  122.       READ
  123.     ELSE
  124.       EXIT
  125.     ENDIF
  126.   ENDDO
  127.   IF msuspens = ' '
  128.     CLOSE DATABASES
  129.     SELECT a
  130.     SET ESCAPE ON
  131.     RETURN
  132.   ENDIF
  133.   STORE ' ' TO mans
  134.   @ 22,0 CLEAR
  135.   @ 22,2 SAY '** An entry of ' + LTRIM(STR(mbal,10,2)) + ' will be posted ' + ;
  136.   'to account ' + RTRIM(msuspens) + ' **'
  137.   @ 23,2 SAY 'Press any key to continue...' GET mans
  138.   READ
  139.   USE
  140.   SELECT b
  141. ENDIF
  142. STORE 'Y' TO mans
  143. @ 22,0 CLEAR
  144. @ 22,2 SAY 'Release Information to General Ledger? (Y/N) ' + ;
  145. SUBSTR(m0border,181,5) GET mans PICTURE 'Y'
  146. READ
  147. IF mans = 'N'
  148.   CLOSE DATABASES
  149.   SELECT a
  150.   SET ESCAPE ON
  151.   RETURN
  152. ENDIF
  153. CLEAR GETS
  154. SET ESCAPE OFF
  155. SELECT b
  156. @ 22,0
  157. @ 22,2 SAY ;
  158. '*****  Releasing Information from General Ledger Linking File  *****'
  159. DO p0flockd
  160. IF .NOT. lockedf
  161.   CLOSE DATABASES
  162.   SELECT a
  163.   RETURN
  164. ENDIF
  165. LOCATE FOR amount <> 0.00
  166. IF EOF()
  167.   SELECT a
  168.   CLOSE DATABASES
  169.   STORE ' ' TO mans
  170.   ?? CHR(7)
  171.   @ 22,0
  172.   @ 22,3 SAY 'A user at another station has released this ' + m0pgmid + ;
  173.   ' batch to Ledger. '
  174.   @ 23,3 SAY 'Press any key...' GET mans
  175.   READ
  176.   SET ESCAPE ON
  177.   RETURN
  178. ENDIF
  179. IF VAL(STR(mbal,10,2)) <> 0.00
  180.   SET INDEX TO &m0gllkf..ndx
  181.   SEEK msuspens
  182.   IF EOF()
  183.     APPEND BLANK
  184.     REPLACE account WITH msuspens, amount WITH mbal
  185.   ELSE
  186.     REPLACE amount WITH amount + mbal
  187.   ENDIF
  188.   SET INDEX TO
  189. ENDIF
  190. GO TOP
  191. REPLACE ALL begin WITH mbegin, end WITH DTOC(m0date), batch WITH mbatch
  192. IF FILE('&mgltrf..dbf')
  193.   COPY TO &m0dbfdr.&m0tmpf1 FOR amount <> 0.00
  194.   SELECT c
  195.   DO WHILE FILE('&mglhdf..dbf')
  196.     STORE 'Y' TO mretry
  197.     @ 22,0 CLEAR
  198.     @ 22,2 SAY 'A user at another station is releasing ' + m0pgmid + ;
  199.     ' information to this GL company. '
  200.     @ 23,2 SAY 'Do you want to try again? (Y/N)' GET mretry PICTURE 'Y'
  201.     READ
  202.     IF mretry = 'N'
  203.       CLOSE DATABASES
  204.       IF FILE('&m0dbfdr.&m0tmpf1..dbf')
  205.         DELETE FILE &m0dbfdr.&m0tmpf1..dbf
  206.       ENDIF
  207.       SELECT a
  208.       SET ESCAPE ON
  209.       RETURN
  210.     ENDIF
  211.   ENDDO
  212.   RENAME &mgltrf..dbf TO &mglhdf..dbf
  213.   USE &mglhdf EXCLUSIVE
  214.   APPEND FROM &m0dbfdr.&m0tmpf1
  215.   USE
  216.   DELETE FILE &m0dbfdr.&m0tmpf1..dbf
  217.   SELECT b
  218. ELSE
  219.   DO WHILE FILE('&mglhdf..dbf')
  220.     STORE 'Y' TO mretry
  221.     @ 22,0 CLEAR
  222.     @ 22,2 SAY 'A user at another station is releasing ' + m0pgmid + ;
  223.     ' information to this GL company. '
  224.     @ 23,2 SAY 'Do you want to try again? (Y/N)' GET mretry PICTURE 'Y'
  225.     READ
  226.     IF mretry = 'N'
  227.       CLOSE DATABASES
  228.       IF FILE('&m0dbfdr.&m0tmpf1..dbf')
  229.         DELETE FILE &m0dbfdr.&m0tmpf1..dbf
  230.       ENDIF
  231.       SELECT a
  232.       SET ESCAPE ON
  233.       RETURN
  234.     ENDIF
  235.   ENDDO
  236.   COPY TO &mglhdf FOR amount <> 0.00
  237. ENDIF
  238. REPLACE ALL amount WITH 0.00
  239. USE
  240. IF .NOT. FILE('&mgltrf..dbf')
  241.   RENAME &mglhdf..dbf TO &mgltrf..dbf
  242. ELSE
  243.   USE &mgltrf EXCLUSIVE
  244.   APPEND FROM &mglhdf
  245.   IF FILE('&mglhdf..dbf')
  246.     DELETE FILE &mglhdf..dbf
  247.   ENDIF
  248.   USE
  249. ENDIF
  250. SELECT a
  251. STORE SUBSTR(STR(1000 + VAL(mbatch) + 1,4,0),2,3) TO mbatch
  252. IF mbatch = '000'
  253.   STORE '001' TO mbatch
  254. ENDIF
  255. REPLACE link WITH SUBSTR(link,1,36) + mbatch + ;
  256. SUBSTR(link,40,153) + DTOC(m0date)
  257. UNLOCK
  258. CLOSE DATABASES
  259. SET ESCAPE ON
  260. RETURN
  261. *
  262. * ' $Revision:   1.16  $
  263. * ' $Date:   25 May 1990 16:20:10  $
  264. **********************
  265. ** '  ARLKGL.PRG  ' **
  266. ** '  267 Lines   ' **
  267. **********************
  268.