Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB3AR.ZIP
Filename : PRGPMT.PRG

 
Output of file : PRGPMT.PRG contained in archive : DB3AR.ZIP
*!!* dBASE CONVERT - dBASE III File Conversion Aid v1.0 6/14/84
*
SET SAFETY OFF
********************* PAYMENT TO INVOICE.(PRGPMT.PRG)
CLEAR
SET BELL OFF
SET CONFIRM ON
SET TALK OFF
SET EXACT ON
DO WHILE .T.
STORE ' ' TO MINV
STORE ' ' TO X
STORE CTOD(' / / ') TO MNEWDATE
STORE ' ' TO MCHKNO
STORE ' ' TO MNAME
STORE 0.00 TO MLSTPAY
MNET=0.00
OVER30=0.00
OVER45=0.00
OVER60=0.00
MCHK=0.00
MPAY=0.00
USE B:CUST INDEX B:ACCT
@ 2,0 CLEAR
@ 20,27 SAY 'Want to enter a payment?'
?
?
STORE ' ' TO OPTION
STORE ' ' TO X
WAIT ' ? ' TO OPTION
IF OPTION='N'
RETURN
ENDIF
@ 2,0 CLEAR
?
?
ACCEPT " Enter acct number " TO X
*!! EOF() will be true if NO FIND, and RECNO() will equal BOTTOM, not 0.
FIND &X
IF (EOF() .OR. BOF())
@ 2,0 CLEAR
? CHR(7)
@ 6,20 SAY " I can't find an account for # &X ..."
STORE 1 TO XX
DO WHILE XX<70
STORE XX+1 TO XX
ENDDO WHILE XX<70
LOOP
ENDIF (EOF() .OR. BOF())
@ 2,0 CLEAR
@ 6,15 SAY NAME
@ 6,50 SAY ACCT
@ 8,15 SAY ADDRESS
@ 8,50 SAY CITY
IF UCREDIT > 0.00
SET COLOR TO /W
@ 10,15 SAY 'Unapplied credits '
@ 10,32 SAY UCREDIT
SET COLOR TO W
ENDIF
@ 12,13 SAY ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
@ 15,25 SAY 'Is this the correct account?'
@ 16,0 SAY ' '
WAIT ' ? ' TO OPTION
IF OPTION='N'
LOOP
ENDIF
@ 2,0 CLEAR
STORE LOWER(TRIM(NAME)) TO MNAME
STORE 0 TO T
STORE LEN(MNAME) TO T
STORE (80-T)/2 TO T
@ 1,T SAY MNAME
@ 3,25 SAY 'Date last check received '
@ 3,51 SAY NEWDATE
@ 5,25 SAY 'New check date ' GET MNEWDATE
@ 7,25 SAY 'Last check number '
@ 7,44 SAY CHKNO
@ 9,25 SAY 'New check number ' GET MCHKNO PICTURE 'XXXXXXXXXXXXXXX'
@ 11,25 SAY 'Last amount of check '
@ 11,47 SAY LSTPAY
@ 13,25 SAY 'New check amount ' GET MLSTPAY PICTURE '999999.99'
@ 23,10 SAY 'If check number is blank none of the above will be 
changed'
READ
@ 15,0 SAY '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~;
~~~~~~~'
IF MCHKNO<>' '
REPLACE CHKNO WITH MCHKNO
REPLACE LSTPAY WITH MLSTPAY
REPLACE NEWDATE WITH MNEWDATE
ENDIF
@ 17,31 SAY 'Is this correct?'
?
WAIT ' ? ' TO OPTION
IF OPTION='N'
EDIT RECNO()
ENDIF
@ 2,0 CLEAR
STORE LSTPAY TO MCHK
DO WHILE .T.
SET HEADING OFF
USE B:INV INDEX B:ACCTS
@ 2,0 CLEAR
@ 3,31 SAY 'Just a moment...'
FIND &X
IF EOF()
? CHR(7)
@ 2,0 CLEAR
? [ Holy credits Batman, &MNAME has no invoices.]
?
?
?
WAIT ' Press any bat key to continue...'
?
? ' Keep the check Robin'
?
RETURN
ENDIF
USE B:INV
@ 2,0 CLEAR
? ' Inv.# PO # Date Price Credits Payments 
Due'
? ' 
~~~~~ ~~~~ ~~~~ ~~~~~ ~~~~~~~ ~~~~~~~~ ~~~'
DISPLAY ALL OFF INVNO,PONO,NEWDATE,PRICE,CRINV,AMTAPPL,NET FOR 
ACCT=X
STORE 1 TO POS
DO WHILE .T.
IF POS=16
STORE 1 TO POS
ENDIF
STORE ' ' TO MINV
@ 17,66 CLEAR
@ 17,66 SAY '|~~~~~~~~~~~~~'
@ 18,66 SAY '|'
@ 19,66 SAY '|'
@ 20,66 SAY '|'
@ 21,66 SAY '|'
@ 22,66 SAY '|'
@ 23,66 SAY '|_____________'
@ 18,67 SAY 'Bal'
@ 18,71 SAY STR(MCHK-MPAY,7,2)
@ 19,67 SAY '-------------'
@ 20,67 SAY 'Inv#' GET MINV
READ
IF MINV=' '
RETURN
ENDIF
SET COLOR TO /W
@ 20,67 SAY 'WAIT'
@ POS,67 SAY MINV
LOCATE FOR INVNO = MINV .AND. ACCT = X
SET COLOR TO W
IF EOF()
? CHR(7)
@ 22,70 SAY 'NO'
LOOP
ENDIF
@ 20,67 SAY 'Inv#'
@ 22,67 SAY '$' GET AMTAPPL
READ
STORE 0.00 TO SUBTOT
STORE AMTAPPL TO SUBTOT
REPLACE NET WITH PRICE-AMTAPPL-CRINV
@ POS,72 SAY STR(SUBTOT,6,2)
IF NET<=0.00
REPLACE PAYDATE WITH MNEWDATE
ENDIF
STORE AMTAPPL+MPAY TO MPAY
IF NET<=0.00
REPLACE PAID WITH .T.
ENDIF
@ 18,71 SAY STR(MCHK-MPAY,7,2)
@ 20,61 CLEAR
@ 23,69 SAY 'STOP? '
WAIT ' 
Y or N 'TO OPTION
STORE POS+1 TO POS
IF OPTION = 'Y'
CLEAR
@ 15,T SAY MNAME
SET EXACT ON
SET TALK ON
USE B:CUST INDEX B:ACCT
FIND &X
REPLACE ALLPAY WITH ALLPAY+MCHK
CLEA
SET TALK OFF
RETURN
ENDIF
SET HEADING OFF
LOOP
ENDDO
ENDDO
SET CONFIRM OFF
RETURN


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB3AR.ZIP
Filename : PRGPMT.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/