Piper's Pit BBS/FTP: ibm 0020 - 0029/ibm0020-0029/ibm0028.tar/ibm0028/SBTAR4.ZIP/ARMANT.PRG

Text File | 1990-06-20 | 12.1 KB | 390 lines

********************** ' MultiNet Source Code ' ***********************
** '                       SBT Corporation                         ' **
** '         One Harbor Drive, Sausalito, California 94965         ' **
** '                   Telephone [phone]                    ' **
***********************************************************************
** '   (c) Copyright 1984, Revisions 1985 - 1990 SBT Corporation   ' **
** '            All Rights Reserved by SBT Corporation             ' **
** '                                                               ' **
***********************************************************************
** ' 06/20/90 = Last Update  **   ARMANT.PRG   **  Version 6.35.01 ' **
***********************************************************************
* ' Change/Void Invoice/Credit Memos - called by ARMENU
* '                                    calls ARMANE, ARMANV
*
STORE .f. TO mlist, mselcust
STORE .t. TO merase, mselinvo
DO WHILE .t.
  CLOSE DATABASES
  SELECT a
  USE &m0armastf INDEX &m0armastf..ndx
  SET FILTER TO arstat <> 'V' .AND. artype <> 'R' .AND. .NOT. DELETED()
  IF merase
    CLEAR
    @ 1,1 SAY m0date
    @ 1,25 SAY 'Change/Void Invoice/Credit Memo'
    @ 1,73 SAY SUBSTR(m0company,79,6)
    @ 2,1 SAY SUBSTR(m0company,1,78)
    STORE .f. TO merase
  ENDIF
  STORE SPACE(8) TO minvno
  IF mselinvo
    @ 4,0
    @ 4,1 SAY 'Enter Invoice No, "?" to List, or <Enter> to search '+ ;
    'on Customer No ' + SUBSTR(m0border,183,4) GET minvno PICTURE '!#######'
    READ
    IF minvno = SPACE(8)
      STORE .f. TO mselinvo
      STORE .t. TO mselcust
    ELSE
      STORE .t. TO mselinvo
      STORE .f. TO mselcust
    ENDIF
  ENDIF
  IF mselcust
    STORE SPACE(6) TO mcust
    @ 4,0
    @ 4,1 SAY 'Enter Customer Number, "?" to List, or <Enter> to ' + ;
    'Quit ' + SUBSTR(m0border,182,5) GET mcust PICTURE '!!!!!!'
    READ
    CLEAR GETS
    IF SUBSTR(mcust,1,1) = ' '
      STORE 'Y' TO mans
      @ 6,0 CLEAR
      @ 6,1 SAY 'Finished ? (Y/N) ' + SUBSTR(m0border,179,8) ;
      GET mans PICTURE 'Y'
      READ
      IF mans = 'N'
        STORE .t. TO mselinvo, merase
        STORE .f. TO mselcust
        @ 4,0 CLEAR
        LOOP
      ENDIF
      CLEAR
      @ 9,22 SAY '*****  Returning to Main Menu  *****'
      CLOSE DATABASES
      RETURN
    ENDIF
    SELECT d
    USE &m0custf INDEX &m0custf..ndx
    @ 22,1 SAY '*****  Searching File  *****'
    * ' Search on Customer number
    SET EXACT ON
    SEEK mcust
    SET EXACT OFF
    STORE .f. TO maddok
    IF EOF()
      STORE TRIM(mcust) TO m0key
      STORE 'custno' TO m0field
      STORE 'ARCUST' TO m0file
      * ' Call procedure to list on screen
      DO syslist WITH m0field, m0key, m0file, 4
      SEEK mcust
      IF EOF()
        LOOP
      ENDIF
      CLEAR
    ENDIF
    STORE custno TO mcust
*\ ARMANT01 00 06/20/90 JG Get rid of unnecessary ENDIF/IF
    STORE '?       ' TO minvno
    CLEAR
    @ 1,1 SAY m0date
    @ 1,25 SAY 'Change/Void Invoice/Credit Memo'
    @ 1,73 SAY SUBSTR(m0company,79,6)
    @ 2,1 SAY SUBSTR(m0company,1,78)
  ENDIF
  @ 22,1 SAY '*****  Searching File  *****'
  IF SUBSTR(minvno,1,1) <> '?'
    STORE STR(VAL(minvno),8,0) TO minvno
  ENDIF
  SELECT a
  SET INDEX TO &m0armastf..ndx
  IF mselcust
    SET FILTER TO .NOT. DELETED() .AND. mcust = custno
  ELSE
    SET FILTER TO .NOT. DELETED()
  ENDIF
  SEEK minvno
  IF EOF()
    STORE 'Invoice/CM' TO mtitle
    STORE 'Invoice No.   Inv Date  Order No.   Cust No.    ' + ;
    '$ Total       Balance' TO mheading
    STORE TRIM(minvno) TO m0key
    STORE 'invno' TO m0field
    STORE 'ARMAST' TO m0file
    * ' Call procedure to list on screen
    DO syslist WITH m0field, m0key, m0file, 5
    SEEK minvno
    IF EOF()
      LOOP
    ENDIF
    @ 4,0 CLEAR
  ENDIF && EOF()
  SELECT b
  USE &m0artranf INDEX &m0artracf..ndx
  SET FILTER TO arstat <> 'V' .AND. .NOT. DELETED()
  SELECT d
  USE &m0custf INDEX &m0custf..ndx
  SELECT a
  SET ESCAPE OFF
  STORE .f. TO mrevise
  STORE .t. TO merase
  STORE ' ' TO maction
  DO WHILE .t.
    SELECT a
    IF BOF() .OR. EOF()
      STORE ' ' TO mans
      @ 20,0
      IF BOF()
        @ 20,1 SAY 'Top of File. Press any key to continue...' GET mans
      ELSE
        @ 20,1 SAY 'End of File. Press any key to continue...' GET mans
      ENDIF
      READ
      EXIT
    ENDIF
    STORE a->custno TO mcust
    STORE a->invno TO minvno
    STORE SPACE(35) TO mcompany, mscompany
    STORE SPACE(30) TO maddr1, maddr2, maddr3, msaddr1, msaddr2, msaddr3
    SELECT d
    SET INDEX TO &m0custf..ndx
    SEEK mcust
    IF .NOT. EOF()
      STORE d->company TO mcompany, mscompany
      STORE d->address1 + SPACE(5) TO maddr1, msaddr1
      STORE d->address2 + SPACE(5) TO maddr2, msaddr2
      STORE TRIM(TRIM(d->city) + ', ' + TRIM(SUBSTR(d->state,1,2)) + ;
      ' ' + TRIM(d->zip) + ' ' + d->country) TO maddr3
      STORE SUBSTR(maddr3 + SPACE(35),1,35) TO maddr3, msaddr3
    ENDIF
    IF a->tosw <> ' '
      SELECT d
      USE &m0araddrf INDEX &m0araddrf..ndx
      SEEK minvno
      IF .NOT. EOF()
        STORE d->company TO mscompany
        STORE d->address1 TO msaddr1
        STORE d->address2 TO msaddr2
        STORE d->address3 TO msaddr3
      ENDIF
      USE &m0custf INDEX &m0custf..ndx
      SEEK mcust
    ENDIF
    SELECT a
    STORE a->artype TO martype
    IF a->artype $ 'CTF'
      STORE a->artype + LTRIM(minvno) TO mxinvno
    ELSE
      STORE LTRIM(minvno) TO mxinvno
    ENDIF
    DO CASE
      CASE a->artype = 'C'
        STORE 'Credit Memo' TO mform
      CASE a->artype = 'T'
        STORE 'Credit Memo for Tax Only' TO mform
      CASE a->artype = 'F'
        STORE 'Finance Charge' TO mform
      OTHERWISE
        STORE 'Invoice' TO mform
    ENDCASE
    STORE 'Change ' + mform + ' Number ' + mxinvno TO mtitle
    IF .NOT. a->maint $ ' -'
      STORE mtitle + '-' + a->maint TO mtitle
    ENDIF
    IF merase
      CLEAR
      @ 1,1 SAY DTOC(m0date)
      @ 1,73 SAY SUBSTR(m0company,79,6)
      @ 2,1 SAY SUBSTR(m0company,1,78)
      @ 3,1 TO 6,78
      @ 12,1 TO 19,78
      @ 7,1 TO 12,38
      @ 7,41 TO 12,78
      DO CASE
        CASE m0os = 'D' .OR. SUBSTR(m0border,170,1) = 'Y'
          @ 12,1 SAY CHR(195)
          @ 12,38 SAY CHR(193)
          @ 12,41 SAY CHR(193)
          @ 12,78 SAY CHR(180)
        CASE m0os = 'M'
          @ 12,1 SAY CHR(224)
          @ 12,38 SAY CHR(227)
          @ 12,41 SAY CHR(227)
          @ 12,78 SAY CHR(225)
      ENDCASE
      @ 3,2 SAY ' Customer Information: '
      @ 7,42 SAY ' Ship To: '
      @ 4,3 SAY 'Balance ' + SUBSTR(m0border,180,5)
      @ 4,30 SAY 'YTD Sales ' + SUBSTR(m0border,182,3)
      @ 4,56 SAY 'Last Sale ' + SUBSTR(m0border,183,2)
      @ 5,3 SAY 'Avl Credit ' + SUBSTR(m0border,183,2)
      @ 5,30 SAY 'On Order ' + SUBSTR(m0border,181,4)
      @ 5,56 SAY 'Last Paid ' + SUBSTR(m0border,183,2)
      @ 13,3 SAY SUBSTR(m0border,91,2) + 'Date' + SUBSTR(m0border,91,2) + ;
      '   ' + SUBSTR(m0border,91,2) + 'Ship Via' + SUBSTR(m0border,91,2) + ;
      '    ' + SUBSTR(m0border,91,3) + 'F.O.B.' + SUBSTR(m0border,91,3)
      @ 13,46 SAY SUBSTR(m0border,91,5) + 'PO Number' + ;
      SUBSTR(m0border,91,6) + '   ' + SUBSTR(m0border,91,3) + 'Ref' + ;
      SUBSTR(m0border,91,2)
      IF m0lntax
        @ 15,13 SAY 'Slspersn  Terr District  Order Date  ' + ;
        'Order Number     Sales Disc'
      ELSE
        @ 15,3 SAY 'Tax Rate  Slspersn  Terr District  Order Date  ' + ;
        'Order Number     Sales Disc'
      ENDIF
      @ 17,3 SAY SUBSTR(m0border,91,7) + 'Terms' + SUBSTR(m0border,91,8) + ;
      '      Payment Discount    Net Due Days'
      IF SUBSTR(m0link,1,1) = 'Y'
        @ 17,65 SAY 'AR Link Code'
      ENDIF
      @ 16,76 SAY '%'
      @ 18,37 SAY '%'
      @ 18,43 SAY 'Days'
      @ 18,55 SAY 'Days'
      STORE .f. TO merase
    ENDIF && merase
    @ 1,20 SAY SPACE(40)
    @ 1,40 - INT(LEN(mtitle)/2) SAY mtitle
    @ 7,2 SAY ' Bill To: (' + TRIM(mcust) + ') ' + SUBSTR(m0border,91,5)
    @ 4,17 SAY d->balance PICTURE '99999999.99'
    @ 4,44 SAY d->ytdsls PICTURE '9999999.99'
    @ 4,69 SAY d->ldate
    @ 5,17 SAY d->limit - d->balance PICTURE '99999999.99'
    @ 5,44 SAY d->onorder PICTURE '9999999.99'
    @ 5,69 SAY d->lastpay
    @ 8,3 SAY mcompany
    @ 9,3 SAY maddr1
    @ 10,3 SAY maddr2
    @ 11,3 SAY maddr3
    @ 8,43 SAY mscompany
    @ 9,43 SAY msaddr1
    @ 10,43 SAY msaddr2
    @ 11,43 SAY msaddr3
    @ 14,3 SAY a->invdte PICTURE '##/##/##'
    @ 14,14 SAY a->shipvia PICTURE 'XXXXXXXXXXXX'
    @ 14,30 SAY a->fob PICTURE 'XXXXXXXXXXXX'
    @ 14,46 SAY a->ponum PICTURE 'XXXXXXXXXXXXXXXXXXXX'
    @ 14,69 SAY a->refno PICTURE 'XXXXXXXX'
    IF .NOT. m0lntax
      @ 16,3 SAY a->taxrate PICTURE '###.###'
    ENDIF
    @ 16,16 SAY a->salesmn PICTURE '!!'
    @ 16,24 SAY a->terr PICTURE '!!'
    @ 16,30 SAY a->taxdist PICTURE '!!!!'
    @ 16,39 SAY a->ordate PICTURE '##/##/##'
    @ 16,52 SAY a->ornum PICTURE 'XXXXXXXX'
    @ 16,68 SAY a->disc PICTURE '###.###'
    @ 18,3 SAY a->pterms PICTURE 'XXXXXXXXXXXXXXXXXXXX'
    @ 18,29 SAY a->pdisc PICTURE '###.###'
    @ 18,39 SAY a->pdays PICTURE '###'
    @ 18,51 SAY a->pnet PICTURE '###'
    IF SUBSTR(m0link,1,1) = 'Y'
      @ 18,69 SAY a->glarec PICTURE '!!!'
    ENDIF
    @ 20,0 CLEAR
    IF d->limit - d->balance < 0.00 .AND. mcust <> 'CASH  '
      ?? CHR(7)
      @ 21,1 SAY '*** Credit Limit Exceeded by $ ' + ;
      LTRIM(STR(d->balance - d->limit,11,2)) + ' ***'
    ENDIF
    @ 22,1 SAY 'Total ='
    @ 22,32 SAY 'Tax ='
    @ 22,56 SAY 'Bal Due ='
    @ 22,11 SAY a->invamt PICTURE '99,999,999.99'
    @ 22,39 SAY a->tax PICTURE '99,999.99'
    @ 22,66 SAY a->balance PICTURE '9,999,999.99'
    STORE 'F' TO maction
    STORE 'FBQ' TO moptns
    DO CASE
      CASE a->arstat = 'V' .OR. DELETED()
        * ' Can't do anything to voided invoice
        ?? CHR(7)
        STORE mform + ' Voided.  Enter Choice (Fwd/Back/Quit) ' TO msg
*\ ARMANT01 01 06/20/90 JG Disallow voiding Tax Only Credit Memos
      CASE a->current = 'X' .OR. a->artype = 'T'
        * ' Can't void prior period invoice
        STORE 'Enter Choice (Edit/Fwd/Back/Quit) ' TO msg
        STORE 'EFBQ' TO moptns
        STORE 'E' TO maction
      OTHERWISE
        STORE 'Enter Choice (Edit/Void/Fwd/Back/Quit) ' TO msg
        STORE 'EVFBQ' TO moptns
        STORE 'E' TO maction
    ENDCASE
    @ 20,1 SAY msg + SUBSTR(m0border,180,7) GET maction PICTURE '!'
    READ SAVE
    DO WHILE .NOT. maction $ moptns
      ?? CHR(7)
      READ SAVE
    ENDDO
    @ 20,0
    @ 21,0
    CLEAR GETS
    IF .NOT. maction $ 'FBQ'
      DO p0rlockd
      IF .NOT. lockedr
        LOOP
      ENDIF
      IF a->signature = 99
        UNLOCK
        STORE ' ' TO mans
        ?? CHR(7)
        @ 20,0 CLEAR
        @ 20,1 SAY mform + ' is being maintained by another user.'
        @ 22,1 SAY 'Press any key...' GET mans
        READ
        @ 20,0 CLEAR
        LOOP
      ENDIF
      REPLACE signature WITH 99
      UNLOCK
    ENDIF
    DO CASE
      CASE maction = 'E'
        * ' call header edit program
        DO armane
      CASE maction = 'V'
        * ' call void program
        DO armanv
    ENDCASE
    SELECT a
    IF maction $ 'FBQ'
      IF mrevise .AND. a->prtid <> ' '
        STORE AT(a->maint,' ABCDEFGHIJKLMNOPQRSTUVWXYZZ') TO mpos
        IF mpos > 0
          STORE SUBSTR(' ABCDEFGHIJKLMNOPQRSTUVWXYZZ',mpos,2) TO imaint
        ELSE
          STORE a->maint + '*' TO imaint
        ENDIF
        DO p0rlockn
        REPLACE maint WITH SUBSTR(imaint,2,1), prtid WITH ' '
      ENDIF
      STORE .f. TO mrevise
    ELSE
      DO p0rlockn
      REPLACE signature WITH 0
    ENDIF
    UNLOCK
    DO CASE
      CASE maction = 'F'
        SKIP
      CASE maction = 'B'
        SKIP -1
      CASE maction = 'Q'
        EXIT
    ENDCASE
  ENDDO && WHILE .t.
  STORE .t. TO merase
ENDDO && WHILE .t.
RETURN
*
* ' $Revision:   1.13  $
* ' $Date:   20 Jun 1990 17:10:54  $
*********************
** ' ARMANT.PRG  ' **
** ' 389 Lines   ' **
*********************