home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a075 / 1.img / TOOLKIT1.EXE / SST125.PRG < prev    next >
Encoding:
Text File  |  1989-08-08  |  1.7 KB  |  73 lines
  1. ********************
  2.  
  3. PROCEDURE R_s_array
  4.  
  5.    PARAMETERS _repl, _tarray, _tfile, _therec, _tfield, _thelen
  6.  
  7.    * _repl is the REPLACE/STORE toggle
  8.    * _tarray is the name of the array to work with
  9.    * _tfile is the name of the database or work area to work with
  10.    * _therec is the record number to work with; 0 means to APPEND BLANK
  11.    * _tfield is the field number to begin to work with
  12.    * _thelen is the number of fields to perform this operation with.
  13.  
  14.    PRIVATE _retto, old_length, _qaz, _bfields, _startat, _inc, _qazz
  15.  
  16.    IF !EMPTY(_tfile)
  17.       _retto = STR(SELECT())
  18.       IF LEN(_tfile) = 1
  19.          SELECT &_tfile
  20.       ELSE
  21.          SELECT 0
  22.          USE (_tfile)
  23.       ENDIF
  24.    ENDIF
  25.  
  26.    IF LASTREC() < _therec .OR. _therec = 0
  27.       GO BOTTOM
  28.       IF _repl
  29.          APPEND BLANK
  30.       ENDIF
  31.    ELSE
  32.       GOTO _therec
  33.    ENDIF
  34.  
  35.    IF EMPTY(_thelen)
  36.       _thelen = LEN(_tarray)
  37.    ELSE
  38.       IF _thelen > LEN(_tarray)
  39.          _thelen = LEN(_tarray)
  40.       ENDIF
  41.    ENDIF
  42.  
  43.    old_length = _thelen
  44.  
  45.    IF !EMPTY(_tfield)
  46.       _bfields = ""
  47.       FOR _qaz = 1 TO FCOUNT()
  48.          _bfields = _bfields + FILL_OUT(FIELDNAME(_qaz), 10)
  49.       NEXT
  50.       _startat = (AT(UPPER(FILL_OUT(_tfield, 10)), _bfields) + 9) / 10
  51.       _thelen = INT(_thelen + _startat - 1)
  52.    ELSE
  53.       _startat = 1
  54.    ENDIF
  55.  
  56.    _startat = INT(IF(_startat <= 1, 1, _startat))
  57.  
  58.    _inc = 1
  59.    FOR _qazz = _startat TO _thelen
  60.       _tblank = FIELDNAME(_qazz)
  61.       ARRAY_ACT(_repl, _tblank, _tarray, _inc)
  62.       _inc = _inc + 1
  63.    NEXT
  64.  
  65.    IF !EMPTY(_tfile)
  66.       IF LEN(_tfile) > 1
  67.          CLOSE DATABASE
  68.       ENDIF
  69.       SELECT &_retto.
  70.    ENDIF
  71.  
  72. * End of File
  73.