added LSL2 stored procedures

LSL2/STPROC/DED_INDEXER.txt

@@ -0,0 +1,137 @@
+compile subroutine ded_indexer( Dum )
+/*
+DECLARE SUBROUTINE FORCE_INDEX_FLUSH, MSG, BORDER.UP, PRINT_CENTER, DELAY
+declare subroutine fsmsg, Attach_Resolve_Volumes, statup
+DECLARE FUNCTION VIDEO.RW
+
+if IdxRTrace@ then
+   CALL ROUTINE_TRACE('INDEX_REP', 'START')
+end
+
+PERFORM_TITLE = 'Training':@FM:'Production'
+PERFORM_TYPE = 'TRAIN':@FM:'PROD'
+PERFORM_POS   = 1
+
+GOSUB SCRN_SETUP
+CONTINUE = TRUE$
+
+LOOP
+   WHILE (PERFORM_POS <= 2) AND CONTINUE
+      ThisAttachTitle = PERFORM_TITLE<PERFORM_POS>
+      ProcessOK = true$
+      if ThisAttachTitle = 'Training' then
+         STATUP(SINGLE$, STAT.MODAL$, 'Determining if users are in Training...')
+
+         ProcessOK = false$
+         * check to see if there is anyone in training...
+         open "VOC" to VocFile else
+            fsmsg()
+            stop
+         end
+         TrainingID = 1
+         loop
+            LockId = 'IN_TRAINING*':TrainingID
+            lock VocFile, LockID then
+               * no one using this training ID
+               unlock VocFile, LockID
+               TrainingID += 1
+              end else
+               * couldn't get the lock
+               ProcessOK = true$
+            end
+         until (ProcessOK) or (TrainingID > 100)
+         repeat
+      end
+
+      if ProcessOK then
+         STATUP(SINGLE$, STAT.MODAL$, 'Attaching files for ':PERFORM_TITLE<PERFORM_POS>:' Volume')
+         Attach_Resolve_Volumes('A', PERFORM_TYPE<PERFORM_POS>)
+   
+         TEMP = @FILES
+         NUM_ITEMS = fieldcount(TEMP, @FM)
+         STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE<PERFORM_POS>:' Files')
+
+         FOR J = 1 TO NUM_ITEMS WHILE CONTINUE
+             THIS_FILE = TEMP<J>
+             IF THIS_FILE[1,1] = '!' THEN
+                FILENAME = THIS_FILE[2,999]
+                *IDX_FIELDS = XLATE(THIS_FILE, '*INDEXES', '', 'X')
+                *NUM_FIELDS = fieldcount(IDX_FIELDS, @VM)
+                *FOR K = 1 TO NUM_FIELDS WHILE CONTINUE
+                    GOSUB CHECK_KEY_HIT
+                *    IF CONTINUE THEN
+                *       TRANS_PRESENT = XLATE(THIS_FILE, '0', '', 'X')
+                *       IF (LEN(TRANS_PRESENT)) AND ((LEN(TRANS_PRESENT) > 2) OR (TRANS_PRESENT<1> <> 0)) THEN
+                *          STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE<PERFORM_POS>:' Files   File = ':FILENAME:'/Field = ':IDX_FIELDS<1,K>)
+                *          FORCE_INDEX_FLUSH(FILENAME, IDX_FIELDS<1,K>)
+                           STATUP(SINGLE$, STAT.MODAL$, 'Updating ':PERFORM_TITLE<PERFORM_POS>:' Indexes - File = ':FILENAME)
+                           FORCE_INDEX_FLUSH(FILENAME, '')
+                *       END
+                *    END
+                *NEXT K
+                * need to check the presence of transactions again to verify
+                * that no fields are stranded due to index removal....
+                FLUSH
+                GARBAGECOLLECT
+                *TRANS_PRESENT = XLATE(THIS_FILE, '0', '', 'X')
+                *IF (LEN(TRANS_PRESENT)) AND ((LEN(TRANS_PRESENT) > 2) OR (TRANS_PRESENT<1> <> 0)) THEN
+                *   STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE<PERFORM_POS>:' Files   File = ':FILENAME:'/All Fields Update')
+                *   * do an all fields call - index may have been removed
+                *   FORCE_INDEX_FLUSH(FILENAME, '')
+                *END
+             END
+         NEXT J
+        end else
+         * bypassing training...
+         STATUP(SINGLE$, STAT.MODAL$, 'Bypassing update for ':PERFORM_TITLE<PERFORM_POS>)
+         *msg('%B%bypass', 'T3', '','')
+         delay(1)
+      end
+      IF @DATA = '' THEN
+         PERFORM_POS += 1
+      END
+REPEAT
+
+IF PERFORM_POS = 1 THEN
+   STATUP(SINGLE$, STAT.MODAL$, 'Re-attaching files for ':PERFORM_TITLE<2>:' Volume before exiting')
+   Attach_Resolve_Volumes('A', PERFORM_TYPE<2>)
+END
+
+* restore the original image
+gosub clear_box
+
+if IdxRTrace@ then
+   CALL ROUTINE_TRACE('INDEX_REP', 'END')
+end
+RETURN
+
+CLEAR_BOX:
+   CALL STATUP(POP$, '', statup_state)
+   msg('', 'DB', ScrImg, '')
+RETURN
+
+*============================================================================*
+
+SCRN_SETUP:
+   msg('Index Processing Active...', 'UB', ScrImg, '')
+   CALL STATUP(PUSH$, '', statup_state)
+RETURN
+
+*============================================================================*
+
+CHECK_KEY_HIT:
+   INPUT KEYSTROKE, -1
+   IF ((KEYSTROKE = '') AND MOUSE_ACTIVE@) THEN
+      KEYSTROKE = MOUSE_TEST
+   END
+   IF (KEYSTROKE <> '') THEN
+      CONTINUE = FALSE$
+      IF @CAPTURE THEN
+         @SCRIPT := KEYSTROKE
+      END
+      @DATA := KEYSTROKE
+     END ELSE
+      CONTINUE = TRUE$
+   END
+RETURN
+*/