Piper's Pit BBS/FTP: ibm 0020

home *** CD-ROM | disk | FTP | other *** search

/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / SBTAR4.ZIP / AROREC.PRG < prev next >

Wrap

Text File | 1990-08-08 | 11.0 KB | 324 lines

********************** ' MultiNet Source Code ' *********************** ** ' SBT Corporation ' ** ** ' One Harbor Drive, Sausalito, California 94965 ' ** ** ' Telephone (415) 331-9900 ' ** *********************************************************************** ** ' (c) Copyright 1984, Revisions 1985 - 1990 SBT Corporation ' ** ** ' All Rights Reserved by SBT Corporation ' ** ** ' ' ** *********************************************************************** ** ' 08/08/90 = Last Update ** AROREC.PRG ** Version 6.35.01 ' ** *********************************************************************** * ' Open Receivables Aging - called by ARREPT * * ' Passed variables: mdisprt = 'P' to print * ' 'D' to display * ' mtype = 'D' to age from due date * ' 'I' to age from invoice date * ' morder = 'C' to order report by customer * ' 'S' to order report by salesperson * ' mcustno = customer number or portion to match * USE &m0sysdr.sysdata LOCATE FOR UPPER(sysid) = m0pgmid + SUBSTR(m0comp,1,2) DO p0rlockd IF lockedr REPLACE str7 WITH STR(mday1,3,0) + STR(mday2,3,0) + ; STR(mday3,3,0) + STR(mday4,3,0) + SUBSTR(str7,13,18) ENDIF USE CLOSE DATABASES STORE TRIM(mcustno) TO mcustno STORE LEN(mcustno) TO mlc STORE 0.00 TO mtotal, mcurr, mper1, mper2, mper3, mper4, ; ttotal, tcurr, tper1, tper2, tper3, tper4 STORE .t. TO mcont STORE 'Open Receivables Aging' TO mhead1 @ 23,0 @ 23,4 SAY '***** Indexing File *****' IF morder = 'S' STORE mhead1 + ' by Salesperson' TO mhead1 ELSE STORE mhead1 + ' by Customer' TO mhead1 ENDIF IF mtype = 'D' STORE 'Aged from Due Date' TO mhead2 ELSE STORE 'Aged from Invoice Date' TO mhead2 ENDIF IF mlc > 0 STORE mhead2 + ', for Customer: ' + mcustno TO mhead2 ENDIF @ 23,0 @ 23,4 SAY '***** Locating Records in File *****' SELECT b USE &m0custf INDEX &m0custf..ndx SELECT a USE &m0armastf SET FILTER TO a->balance <> 0.00 .AND. SUBSTR(a->custno,1,mlc) = mcustno ; .AND. a->arstat <> 'V' .AND. .NOT. DELETED() GO TOP IF EOF() CLOSE DATABASES STORE ' ' TO mans @ 23,0 @ 23,4 SAY 'No matching records found. Report cancelled. ' + ; 'Press any key...' GET mans READ RETURN ENDIF @ 23,0 @ 23,4 SAY '***** Indexing File *****' IF morder = 'S' INDEX ON salesmn + custno + STR(CTOD(invdte) - CTOD('01/01/01'),8,0) ; TO &m0dbfdr.&m0tmpf1..ndx ELSE INDEX ON custno + STR(CTOD(invdte) - CTOD('01/01/01'),8,0) ; TO &m0dbfdr.&m0tmpf1..ndx ENDIF GO TOP STORE SPACE(6) TO mcust IF mdisprt = 'P' @ 23,0 @ 23,4 SAY '***** Printing Open Receivables Aging *****' STORE .t. TO m0prnesc DO p0setprn WITH 'ON', 'PRINT', 'OFF', 0 STORE 1 TO mpage @ 3,1 SAY 'Page ' + LTRIM(STR(mpage,4,0)) @ 3,40 - INT(LEN(m0cname)/2) SAY m0cname @ 4,1 SAY 'Date ' + DTOC(m0date) @ 4,40 - INT(LEN(mhead1)/2) SAY mhead1 @ 5,40 - INT(LEN(mhead2)/2) SAY mhead2 STORE 54 TO maxlines STORE 7 TO mline ELSE CLEAR @ 1,40 - INT(LEN(mhead1)/2) SAY mhead1 @ 2,40 - INT(LEN(mhead2)/2) SAY mhead2 STORE 18 TO maxlines STORE 4 TO mline ENDIF @ mline,1 SAY 'Cust # Company Contact ' + ; ' Phone' @ mline + 1,1 SAY 'Terms ' @ mline + 2,1 SAY 'Date Inv # Amount Currnt > ' + ; STR(mday1,3,0) + ' > ' + STR(mday2,3,0) + ' > ' + STR(mday3,3,0) + ; ' > ' + STR(mday4,3,0) + ' Open Bal Pymnt' @ mline + 3,1 SAY '===== ======== ========== ====== ====== ====== ' + ; '====== ====== =========== =====' STORE mline + 4 TO mline STORE 'ar' TO msalesmn DO WHILE .NOT. m0stpprn .AND. .NOT. EOF() IF morder = 'S' .AND. a->salesmn <> msalesmn *\ AROREC01 03 08/08/90 JG Don't print this line if it will be "widowed". IF mline + 3 < maxlines @ mline,1 SAY 'Open Receivables for Salesperson: ' + a->salesmn ENDIF STORE a->salesmn TO msalesmn STORE mline + 2 TO mline ENDIF STORE a->custno TO mcust SELECT b SEEK mcust SELECT a STORE 0.00 TO mtotal, mcurr, mper1, mper2, mper3, mper4, mcount IF mdisprt = 'P' .AND. morder <> 'S' STORE recno() TO mrecno STORE 1 TO mcount DO WHILE a->custno = mcust .AND. .NOT. EOF() SKIP 1 mcount = mcount + 1 ENDDO GOTO mrecno ENDIF IF (mline + mcount + 1) < maxlines .OR. mline < 35 @ mline,1 SAY mcust @ mline,8 SAY b->company @ mline,45 SAY b->contact @ mline,68 SAY SUBSTR(b->phone,1,12) @ mline + 1,1 SAY b->pterms ENDIF STORE mline + 3 TO mline DO WHILE .NOT. m0stpprn IF (mline > maxlines .OR. ((mline + mcount) > maxlines .AND. ; morder <> 'S' .AND. mline > 35)) .AND. .NOT. EOF() IF mdisprt = 'P' STORE mpage + 1 TO mpage @ 3,1 SAY 'Page ' + LTRIM(STR(mpage,4,0)) @ 3,40 - INT(LEN(m0cname)/2) SAY m0cname @ 4,1 SAY 'Date ' + DTOC(m0date) @ 4,40 - INT(LEN(mhead1)/2) SAY mhead1 @ 5,40 - INT(LEN(mhead2)/2) SAY mhead2 STORE 7 TO mline ELSE STORE .t. TO mcont SKIP -1 DO p0reptqu IF .NOT. mcont EXIT ENDIF CLEAR @ 1,40 - INT(LEN(mhead1)/2) SAY mhead1 @ 2,40 - INT(LEN(mhead2)/2) SAY mhead2 STORE 4 TO mline ENDIF @ mline,1 SAY 'Cust # Company ' + ; 'Contact Phone' @ mline + 1,1 SAY 'Terms ' @ mline + 2,1 SAY 'Date Inv # Amount Currnt > ' + ; STR(mday1,3,0) + ' > ' + STR(mday2,3,0) + ' > ' + STR(mday3,3,0) + ; ' > ' + STR(mday4,3,0) + ' Open Bal Pymnt' @ mline + 3,1 SAY '===== ======== ========== ====== ====== ====== ' + ; '====== ====== =========== =====' STORE mline + 4 TO mline IF morder = 'S' @ mline,1 SAY 'Open Receivables for Salesperson: ' + msalesmn STORE mline + 2 TO mline ENDIF IF mdisprt = 'P' .AND. mline < 15 @ mline,1 SAY mcust @ mline,8 SAY b->company @ mline,45 SAY b->contact @ mline,68 SAY SUBSTR(b->phone,1,12) @ mline + 1,1 SAY b->pterms STORE mline + 3 TO mline ENDIF ENDIF IF mcust = a->custno .AND. mline <= maxlines .AND. .NOT. EOF() STORE m0date - CTOD(a->invdte) TO mdays IF mtype = 'D' STORE mdays - a->pnet TO mdays ENDIF @ mline,1 SAY SUBSTR(a->invdte,1,5) @ mline,7 SAY artype + LTRIM(a->invno) @ mline,16 SAY a->invamt PICTURE '9999999.99' DO CASE CASE mdays <= mday1 STORE balance + mcurr TO mcurr @ mline,26 SAY INT(a->balance) PICTURE '9999999' CASE mdays <= mday2 STORE balance + mper1 TO mper1 @ mline,33 SAY INT(a->balance) PICTURE '9999999' CASE mdays <= mday3 STORE balance + mper2 TO mper2 @ mline,40 SAY INT(a->balance) PICTURE '9999999' CASE mdays <= mday4 STORE balance + mper3 TO mper3 @ mline,47 SAY INT(a->balance) PICTURE '9999999' CASE mdays > mday4 STORE balance + mper4 TO mper4 @ mline,54 SAY INT(a->balance) PICTURE '9999999' ENDCASE STORE a->balance + mtotal TO mtotal @ mline,63 SAY a->balance PICTURE '9999999.99' IF a->dtepaid <> ' ' .AND. a->dtepaid <> ' / / ' @ mline,74 SAY SUBSTR(a->dtepaid,1,5) ENDIF STORE mline + 1 TO mline STORE 0 TO mcount SKIP ELSE @ mline,1 SAY 'Totals:' IF mcurr <> 0 @ mline,26 SAY INT(mcurr) PICTURE '9999999' ENDIF IF mper1 <> 0 @ mline,33 SAY INT(mper1) PICTURE '9999999' ENDIF IF mper2 <> 0 @ mline,40 SAY INT(mper2) PICTURE '9999999' ENDIF IF mper3 <> 0 @ mline,47 SAY INT(mper3) PICTURE '9999999' ENDIF IF mper4 <> 0 @ mline,54 SAY INT(mper4) PICTURE '9999999' ENDIF @ mline,63 SAY mtotal PICTURE '9999999.99' @ mline,74 SAY '<====' STORE mline + 2 TO mline STORE mtotal + ttotal TO ttotal STORE mcurr + tcurr TO tcurr STORE mper1 + tper1 TO tper1 STORE mper2 + tper2 TO tper2 STORE mper3 + tper3 TO tper3 STORE mper4 + tper4 TO tper4 EXIT ENDIF ENDDO && WHILE .t. IF .NOT. mcont EXIT ENDIF ENDDO && WHILE .NOT. EOF() IF mdisprt = 'P' .AND. .NOT. m0stpprn STORE mpage + 1 TO mpage @ 3,1 SAY 'Page ' + LTRIM(STR(mpage,4,0)) @ 3,40 - INT(LEN(m0cname)/2) SAY m0cname @ 4,1 SAY 'Date ' + DTOC(m0date) @ 4,40 - INT(LEN(mhead1)/2) SAY mhead1 @ 5,40 - INT(LEN(mhead2)/2) SAY mhead2 @ 10,22 SAY 'Open Receivable Totals for ' + DTOC(m0date) @ 13,6 SAY 'Current > ' + STR(mday1,3,0) + ' > ' + ; STR(mday2,3,0) + ' > ' + STR(mday3,3,0) + ' > ' + ; STR(mday4,3,0) + ' Total Amt' @ 14,1 SAY '============ =========== =========== =========== ' + ; '=========== ===========' @ 16,1 SAY tcurr PICTURE '999999999.99' @ 16,14 SAY tper1 PICTURE '999999999.99' @ 16,27 SAY tper2 PICTURE '999999999.99' @ 16,40 SAY tper3 PICTURE '999999999.99' @ 16,53 SAY tper4 PICTURE '999999999.99' @ 16,66 SAY ttotal PICTURE '999999999.99' @ 19,34 SAY 'Total Amount Due Over ' + STR(mday1,3,0) + ' Days:' @ 19,67 SAY tper1 + tper2 + tper3 + tper4 PICTURE '99999999.99' STORE 22 TO mline IF morder = 'S' SELECT a GO TOP @ mline,1 SAY 'Summary of Open Receivables by Salesperson:' @ mline + 2,1 SAY 'Salesperson Total $ Due' @ mline + 3,1 SAY '============ ===========' STORE mline + 4 TO mline DO WHILE .NOT. EOF() STORE a->salesmn TO msalesmn STORE 0.00 TO mtotal DO WHILE a->salesmn = msalesmn .AND. .NOT. EOF() STORE mtotal + a->balance TO mtotal SKIP ENDDO @ mline,5 SAY msalesmn @ mline,14 SAY mtotal PICTURE '999999999.99' STORE mline + 1 TO mline IF mline > 54 .AND. .NOT. EOF() STORE mpage + 1 TO mpage @ 3,1 SAY 'Page ' + LTRIM(STR(mpage,4,0)) @ 3,40 - INT(LEN(m0cname)/2) SAY m0cname @ 4,1 SAY 'Date ' + DTOC(m0date) @ 4,28 SAY 'Open Receivables Report' @ 8,1 SAY 'Summary of Open Receivables by Salesperson:' @ 10,1 SAY 'Salesperson Total $ Due' @ 11,1 SAY '============ ===========' STORE 12 TO mline ENDIF ENDDO && WHILE .NOT. EOF() ENDIF && morder = 'S' ENDIF && mdisprt = 'P' IF mdisprt = 'D' IF mline <= maxlines .OR. EOF() STORE .t. TO mcont DO p0reptqu ENDIF ENDIF && mdisprt = 'D' IF mdisprt = 'P' EJECT DO p0setprn WITH 'ON', 'SCREEN', 'OFF', 0 ENDIF RETURN * * ' $Revision: 1.16 $ * ' $Date: 08 Aug 1990 12:30:08 $ ********************* ** ' AROREC.PRG ' ** ** ' 323 Lines ' ** *********************