PROGRAM FIND_OLD_JOB C* C* THE PURPOSE OF THIS PROGRAM IS TO FIND A KRONOS JOB (CHARACTERISTIC C* = 1) CALLED "KRONOS_DISASTER" IN THE QUEUE "BAT$KRONOS" AND C* RETURN THE ENTRY NUMBER TO THE CALLER IN SYMBOL "KDENTRY". C* INCLUDE '($QUIDEF)' INCLUDE '($JBCMSGDEF)' CHARACTER *256 MESS CHARACTER *39 JOB_NAME CHARACTER *31 Q INTEGER SYS$GETQUIW, SEARCH_FLAGS, ICHARS(4) C STRUCTURE / IOSBLK / INTEGER STS, ZEROED END STRUCTURE RECORD / IOSBLK / IOSB C STRUCTURE / ITMLST / INTEGER *2 BUFLEN, ITMCOD INTEGER BUFADR, RETADR END STRUCTURE RECORD / ITMLST / LIST(5) C C --- SET UP CONTEXT FOR THE RIGHT QUEUE C Q = 'BAT$KRONOS' SEARCH_FLAGS = (QUI$M_SEARCH_WILDCARD .OR. QUI$M_SEARCH_ALL_JOBS) LIST(1).BUFLEN = LENGTH(Q) LIST(1).ITMCOD = QUI$_SEARCH_NAME LIST(1).BUFADR = %LOC(Q) LIST(1).RETADR = 0 LIST(2).BUFLEN = 4 LIST(2).ITMCOD = QUI$_SEARCH_FLAGS LIST(2).BUFADR = %LOC(SEARCH_FLAGS) LIST(2).RETADR = 0 LIST(3).BUFLEN = 0 LIST(3).ITMCOD = 0 C C --- FIRST, FIND RIGHT QUEUE C 10 ISTAT = SYS$GETQUIW ( ,%VAL (QUI$_DISPLAY_QUEUE),,LIST,IOSB,,) IF (.NOT. ISTAT) GO TO 200 IF (.NOT. IOSB.STS) THEN ISTAT = IOSB.STS GO TO 200 ENDIF C C --- OK, FIND JOBS NOW C LIST(1).BUFLEN = 4 LIST(1).ITMCOD = QUI$_SEARCH_FLAGS LIST(1).BUFADR = %LOC(SEARCH_FLAGS) LIST(1).RETADR = 0 LIST(2).BUFLEN = 39 LIST(2).ITMCOD = QUI$_JOB_NAME LIST(2).BUFADR = %LOC(JOB_NAME) LIST(2).RETADR = %LOC(LJOB) LIST(3).BUFLEN = 4 LIST(3).ITMCOD = QUI$_ENTRY_NUMBER LIST(3).BUFADR = %LOC(IENTRY) LIST(3).RETADR = 0 LIST(4).BUFLEN = 16 LIST(4).ITMCOD = QUI$_CHARACTERISTICS LIST(4).BUFADR = %LOC(ICHARS) LIST(4).RETADR = 0 LIST(5).BUFLEN = 0 LIST(5).ITMCOD = 0 C C --- LOOP OVER ALL JOBS IN THIS QUEUE C 20 ISTAT = SYS$GETQUIW ( ,%VAL(QUI$_DISPLAY_JOB),,LIST,IOSB,,) IF (.NOT. ISTAT) THEN ISTAT = IOSB.STS GO TO 100 ENDIF C IF ((IOSB.STS .NE. JBC$_NOMOREJOB) .AND. $ (IOSB.STS .NE. JBC$_NOSUCHJOB)) THEN C C ----- A JOB HAS BEEN FOUND... C ----- IT IS THE RIGHT JOB IF IT WAS SUBMITTED WITH THE "KRONOS" C ----- CHARACTERISTIC AND IS NAMED "KRONOS_DISASTER" C C ----- CHARACTERISTIC 1 (BIT 1 SET) IS INTEGER 2 C IF ((JOB_NAME(1:LJOB) .EQ. 'KRONOS_DISASTER') .AND. $ (ICHARS(1) .EQ. 2)) THEN C C ------ FOUND THE RIGHT JOB, SET SYMBOL "KDENTRY" C WRITE(JOB_NAME,900,ERR=100) IENTRY CALL LEFT(JOB_NAME) ISTAT = LIB$SET_SYMBOL $ ('KDENTRY',JOB_NAME(1:LENGTH(JOB_NAME))) IF (.NOT. ISTAT) GO TO 100 C CALL SYS$GETQUIW ( ,%VAL (QUI$_CANCEL_OPERATION),,,,,) CALL EXIT ! AOK EXIT ENDIF GO TO 20 ENDIF C C --- DIDN'T FIND JOB... C ISTAT = 0 C C --- INTERNAL ERROR EXITS C C --- FIRST CLEANUP QUEUE SEARCH C 100 CALL SYS$GETQUIW ( ,%VAL (QUI$_CANCEL_OPERATION),,,,,) C C --- JOB HAS NO LOG FILE, SO TELL OPERATOR WHY WE BOMBED C 200 IF (ISTAT .NE. 0) THEN CALL SYS$GETMSG ( %VAL(ISTAT), LM, MESS ) CALL OPER ( 'FIND_JOB error: '//MESS(1:LM), 'CENTRAL' ) ENDIF CALL EXIT ( 3 ) 900 FORMAT(I5) END C C---END FIND_OLD_JOB C