CP/M/CPM_CDROM.iso/lambda/soundpot/a/dbc.lbr/CODEDIT.CZD/CODEDIT.CMD

Text File | 1993-10-26 | 5.5 KB | 199 lines

* notice..: copyright 1985, all rights reserved
***************************************************************
** PROGRAM: CK85.XXX                                         **
** PURPOSE: CHECK TRACKING OR ACCOUNTS PAYABLE               **
** FEATURES: ALLOWS MANAGEMENT BY USE OF ACCOUNTING CODES    **
** AUTHOR:  DON SABA - SAN DIEGO, CA - SABALINE SYSOP        **
** HELP:  CALL SABALINE [phone]                        **
***************************************************************
SET talk OFF
USE codes
GO BOTTOM
STORE # TO mrecos
STORE t TO start
STORE 0 TO delcount
DO WHILE start
 IF delcount > 0
  SET deleted ON
 ENDIF delcount > 0
 ERASE
 STORE 1 TO x
 @ x,02 SAY "<<<  C O D E S    A D D  **  E D I T  **   D E L E T E " +;
 " M O D U L E   >>>"
 STORE '   ' TO mmalc
 STORE x+2 TO x
 USE codes INDEX codes
 GO TOP
 DO WHILE .not. eof
  @ x,0 SAY malc + " " + expense
  SKIP
  @ x,20 SAY malc + " " + expense
  SKIP
  @ x,40 SAY malc + " " + expense
  SKIP
  @ x,60 SAY malc + " " + expense
  SKIP
  STORE x+1 TO x
 ENDDO WHILE .not. eof
 STORE t TO CONTINUE
 DO WHILE CONTINUE
  *store x+1 to x
  @ x,00 SAY "--------------------------------------------------------" +;
  "-----------------------"
  STORE '               ' TO mexpense
  STORE ' ' TO maction
  STORE t TO entering
  STORE x+1 TO x
  @ x,0 SAY 'CODE    E X P E N S E   ACTION Y)ES N)O' +;
  ' D)ELETE Q)UIT'
  DO WHILE entering
   STORE x+1 TO x
   @ x,0 GET mmalc PICTURE '!99'
   @ x+2,0 SAY "R]eformat Screen  Q]uit or 3 Digit Code  <CR>"
   COUNT TO mrecos
   @ x+2,65 SAY "Records " + str(mrecos,2,0)
   READ
   @ x+2,0
   IF $(mmalc,1,1)= 'R'
    STORE f TO entering
    STORE f TO CONTINUE
   ELSE
    IF $(mmalc,1,1)= 'Q'
     STORE f TO entering
     STORE f TO CONTINUE
     STORE f TO start
    ELSE
     IF mmalc = ' '
      STORE f TO entering
      STORE f TO CONTINUE
      STORE f TO start
     ELSE
      GO TOP
      FIND &mmalc
      IF # <> 0
       STORE 'EDIT' TO mode
       @ x-1,0
       @ x-1,0 SAY 'CODE    E X P E N S E   ACTI' +;
       'ON &MODE Y)ES N)O D)ELETE Q)UIT'
       STORE expense TO mexpense
      ENDIF # <> 0
      IF # = 0
       STORE 'ADD' TO mode
       @ x-1,0
       @ x-1,0 SAY 'CODE    E X P E N S E   ACTI' +;
       'ON &MODE Y)ES N)O D)ELETE Q)UIT'
      ENDIF # = 0
      @ x,04 GET mexpense PICTURE '!!!!!!!!!!!!!!!'
      @ x,35 GET maction PICTURE '!'
      READ
      IF maction = ' ' .OR. mexpense = ' ' .OR. mmalc = ' '
       @ x,0
       STORE '   ' TO mmalc
       STORE '               ' TO mexpense
       STORE x-1 TO x
       LOOP
      ENDIF
      IF maction = 'N'
       @ x,0
       STORE '   ' TO mmalc
       STORE '               ' TO mexpense
       STORE x-1 TO x
       LOOP
      ENDIF maction = 'N'
      IF maction = 'Y' .AND. mode= 'ADD'
       @ x,0
       @ x,0 SAY 'ADDING RECORD FOR &MEXPENSE TO CODES.DBF'
       GO BOTTOM
       APPEND BLANK
       REPLACE malc WITH mmalc
       REPLACE expense WITH mexpense
       STORE '   ' TO mmalc
       STORE '               ' TO mexpense
       @ x,0
       @ x-1,0
       @ x-1,0 SAY 'CODE    E X P E N S E   ACTI' +;
       'ON &MODE Y)ES N)O D)ELETE Q)UIT'
       STORE x-1 TO x
       COUNT TO mrecos
      ENDIF maction = 'Y'
      IF maction = 'Y' .AND. mode= 'EDIT'
       @ x,0
       @ x,0 SAY 'EDITING RECORD FOR &MEXPENSE TO CODES.DBF'
       REPLACE malc WITH mmalc
       REPLACE expense WITH mexpense
       STORE '   ' TO mmalc
       STORE '               ' TO mexpense
       @ x,0
       @ x-1,0
       @ x-1,0 SAY 'CODE    E X P E N S E   ACTI' +;
       'ON  &MODE Y)ES N)O D)ELETE Q)UIT'
       STORE x-1 TO x
      ENDIF maction = 'Y'
      IF maction = 'D' .AND. mode= 'EDIT'
       STORE 'DELETE' TO mode
       IF *
        STORE 0 TO timer
        DO WHILE timer < 10
         @ x,0 SAY '&MMALC DELETED &MEXPENSE WILL BE REMOVED AFTER QUIT'
         STORE timer +1 TO timer
         @ x,0
         LOOP
        ENDDO WHILE timer < 10
       ENDIF *
       @ x,0
       @ x,0 SAY 'DELETING RECORD FOR &MEXPENSE TO CODES.DBF'
       DELETE
       STORE delcount + 1 TO delcount
       STORE '   ' TO mmalc
       STORE '               ' TO mexpense
       @ x,0
       @ x-1,0
       @ x-1,0 SAY 'CODE    E X P E N S E   ACTI' +;
       'ON  &MODE Y)ES N)O D)ELETE Q)UIT'
       STORE x-1 TO x
      ENDIF maction = 'Y'
      IF maction = 'Q'
       STORE f TO entering
       STORE f TO CONTINUE
       STORE f TO start
      ENDIF maction = 'Q'
     ENDIF mmalc = ' '
    ENDIF $(mmalc,1,1)= 'Q'
   ENDIF $(mmalc,1,1)= 'R'
  ENDDO WHILE entering
 ENDDO WHILE CONTINUE
ENDDO WHILE start
IF delcount > 0
 USE codes INDEX codes
 ERASE
 @ 10,0 SAY "Packing to PURGE DELETED Codes "
 PACK
 @ 10,0
 @ 10,0 SAY "Re-INDEXING Codes"
ENDIF delcount > 0
USE
@ 10,0
RETURN
***************************************************************
***************************************************************
***************************************************************

    ENDIF $(mmalc,1,1)= 'Q'
   ENDIF $(mmalc,1,1)= 'R'
  ENDDO WHILE entering
 ENDDO WHILE CONTINUE
ENDDO WHILE start
IF delcount > 0
 USE codes INDEX codes
 ERASE
 @ 10,0 SAY "Packing to PURGE DELETED Codes "
 PACK
 @ 10,0
 @ 10,0 SAY "Re-INDEXING Codes"
ENDIF delcount > 0
USE
@ 10,0
RETURN
***************************************************************