home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a013 / 1.ddi / SOURCE.EXE / F_MAKEID.PRG < prev    next >
Encoding:
Text File  |  1991-01-25  |  2.1 KB  |  78 lines
  1. *****************************************************************
  2. FUNCTION MAKEID (name_var, id_var, look_ndx, id_row, id_col)
  3. *****************************************************************
  4.  
  5. * Creates a six character unique ID code from a string
  6.  
  7. * Copyright(c) 1991 -- James Occhiogrosso
  8.  
  9. LOCAL old_ndx := old_recd := count1 := count2 := 0, id_char := ''
  10.  
  11. * Use REQDDATA to force data entry in name variable
  12. IF .NOT. REQDDATA(name_var)
  13.     RETURN(.F.)
  14. ENDIF
  15.  
  16. * If help code undefined, define it for use below.
  17. IF TYPE('Helpcode') != 'C'
  18.     helpcode = 'ADD'
  19. ENDIF
  20.  
  21. * Generate ID codes in ADD mode
  22. IF UPPER(helpcode) == 'ADD'
  23.  
  24.     * Clear passed receiving variable
  25.     id_var = SPACE(LEN(id_var))
  26.  
  27.     * Save current index order and record number
  28.     old_ndx = INDEXORD()
  29.     old_recd = RECNO()
  30.     SET ORDER TO look_ndx
  31.  
  32.     * Set for three character positions
  33.     FOR count1 = 1 TO 3 
  34.         DO WHILE count2++ <= LEN(TRIM(name_var))
  35.  
  36.             * Get next character in passed name variable
  37.             id_char = UPPER(SUBSTR(name_var,count2,1))
  38.  
  39.             * Reject it if not a character
  40.             IF id_char >= 'A' .AND. id_char <= 'Z'
  41.                 id_var = TRIM(id_var) + id_char
  42.                 EXIT
  43.             ELSE
  44.                 LOOP
  45.             ENDIF
  46.         ENDDO
  47.     NEXT
  48.  
  49.     * Pad to minimum of three alphabetical places
  50.     id_var =  PADR(id_var,3,'?')  + '001'
  51.  
  52.     *
  53.     DO WHILE count1 < 1000
  54.         SEEK id_var
  55.         IF FOUND()
  56.             * ID code exists, increment counter and retry
  57.             count1++
  58.             id_var = SUBSTR(id_var,1,3) + PADL(count1)
  59.  
  60.         ELSE
  61.             * No record with this key, exit the loop.
  62.             EXIT
  63.         ENDIF
  64.     ENDDO WHILE count1 < 1000
  65.  
  66.     * Display data in GET color if row and column passed
  67.     IF VALTYPE(id_row) = 'N' .AND. VALTYPE(id_col) = 'N'
  68.         SWAPCOLOR(id_row, id_col, id_var)
  69.     ENDIF
  70.  
  71.     GOTO old_recd
  72.     SET ORDER TO old_ndx
  73. ENDIF
  74.  
  75. * Return true if ID code is valid or no database in use
  76. RETURN IF(count1 < 1000 .OR. EMPTY(ALIAS()), .T., .F.)
  77.  
  78.