Software Du Jour/SoftwareDuJour.iso/BUSINESS/DBASE/DB3AR.ARC/PRGPMT.PRG

Text File | 1985-10-02 | 4.1 KB | 198 lines

*!!*       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