RevMedia

0001      EXPENDABLE SUBROUTINE USKEY (TYPE)
0002      ***
0003      ***  Gets account sequential key in format nnn*tail
0004      ***  and avoids network locking problems
0005      ***
0006      ***  Key prompt default should be set to text
0007      ***   (E.G. "New Record")
0008      ***
0009      ***  TYPE  =  1 for Post Prompt to get next free seq
0010      ***           2 for pre/post save to update counter
0011      ***
0012      ***  The standard AREV %SK% will not work with multipart keys.  If a
0013      ***  second user calls for %SK% before a previous %SK% has
0014      ***  been filed, the second user will be given the same number
0015      ***  plus a "record locked" message
0016      ***
0017      ***  There are two solutions.  Firstly allocate new sequence
0018      ***  numbers automatically when the records are filed; in this case
0019      ***  it is impossible to display a key during editing.
0020      ***
0021      ***  This routine uses a second method. No number is allocated
0022      ***  until the %SK% is accepted since the "record locked"
0023      ***  problem could occur.  The number is allocated immediately
0024      ***  prior to saving when no user delay is possible.  Since another
0025      ***  user may already have locked the %SK% record but not
0026      ***  updated the %SK% counter, this routine test locks
0027      ***  incrementing from %SK% until it finds a record it can lock.
0028      ***  It then immediately unlocks the record so that the window
0029      ***  interpreter locking can operate immediately thereafter.
0030      ***
0031      $INSERT WINDOW_COMMON%
0032      ***
0033      TAIL = '*' : Field(@ACCOUNT,'.',2)
0034      IF TAIL = "*" THEN
0035           CALL MSG("Window for divisional account","T1","","")
0036           WC_RESET% = 6
0037           RETURN
0038      END
0039      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"