Networked %SK%

Recently a subscriber called to complain about the action of %SK% on a network. Coincidentally at the same time, Richard Guise of Consulting Support Services Ltd submitted the following code which not only answers the subscriber's query but expands on it.

  EXPENDABLE SUBROUTINE USKEY (TYPE)
  ***
  ***  Gets account sequential key in format nnn*tail
  ***  and avoids network locking problems
  ***
  ***  Key prompt default should be set to text
  ***   (E.G. "New Record")
  ***
  ***  TYPE  =  1 for Post Prompt to get next free seq
  ***           2 for pre/post save to update counter
  ***
  ***  The standard AREV %SK% will not work with multipart keys.  If a
  ***  second user calls for %SK% before a previous %SK% has
  ***  been filed, the second user will be given the same number
  ***  plus a "record locked" message
  ***
  ***  There are two solutions.  Firstly allocate new sequence
  ***  numbers automatically when the records are filed; in this case
  ***  it is impossible to display a key during editing.
  ***
  ***  This routine uses a second method. No number is allocated
  ***  until the %SK% is accepted since the "record locked"
  ***  problem could occur.  The number is allocated immediately
  ***  prior to saving when no user delay is possible.  Since another
  ***  user may already have locked the %SK% record but not
  ***  updated the %SK% counter, this routine test locks
  ***  incrementing from %SK% until it finds a record it can lock.
  ***  It then immediately unlocks the record so that the window
  ***  interpreter locking can operate immediately thereafter.
  ***
  $INSERT WINDOW_COMMON%
  ***
  TAIL = '*' : Field(@ACCOUNT,'.',2)
  IF TAIL = "*" THEN
       CALL MSG("Window for divisional account","T1","","")
       WC_RESET% = 6
       RETURN
  END
  SKID = %SK" : TAIL : "%"
  ON TYPE GOTO L1,L2
  ***
  L1:
  BEGIN CASE
       CASE IS = "="
  L1A:      READ SK FROM WC_SRC_DICT%, SKID ELSE SKID = 1
            CALL MSG ("Reset counter " : SKID,"RC",SK,"")
            IF NUM(SK) ELSE GOTO L1A
            WRITE SK ON WC_SRC_DICT%, SKID
            CALL CATALYST("K","{F8}")
       CASE NUM(IS)
            @ID = WC_IS% : TAIL
       CASE 1
            READ @ANS FROM WC_SRC_DICT%, SKID ELSE @ANS = 1
            LOOP
                 RETRY = "" ; NKY = @ANS  : TAIL
                 LOCK WC_SRC_FILE%, NKY ELSE RETRY = 1 ; @ANS += 1
            WHILE RETRY REPEAT
            UNLOCK WC_SRC_FILE%, NKY
            @ID = NKY
  END CASE
  RETURN
  ***
  L2:
  LOOP
       RETRY = ""
       LOCK WC_SRC_DICT%, SKID ELSE RETRY = 1
  WHILE RETRY REPEAT
  READ SK FROM WC_SRC_DICT%, SKID ELSE SK = 0
  NK = FIELD(@ID,"*",1)
  IF NK >= SK THEN WRITE NK+1 ON WC_SRC_DICT%, SKID
  UNLOCK WC_SRC_DICT%, SKID
  RETURN

(Volume 1, Issue 10, Pages 10,11)