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 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:' Volume') Attach_Resolve_Volumes('A', PERFORM_TYPE) TEMP = @FILES NUM_ITEMS = fieldcount(TEMP, @FM) STATUP(SINGLE$, STAT.MODAL$, 'Updating Indexes for ':PERFORM_TITLE:' Files') FOR J = 1 TO NUM_ITEMS WHILE CONTINUE THIS_FILE = TEMP 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:' Files File = ':FILENAME:'/Field = ':IDX_FIELDS<1,K>) * FORCE_INDEX_FLUSH(FILENAME, IDX_FIELDS<1,K>) STATUP(SINGLE$, STAT.MODAL$, 'Updating ':PERFORM_TITLE:' 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:' 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) *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 */