CTITLEJVPROJ -- VERIFY PROJECT NUMBER AND AREA NAME 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RALPH MCMILLAN 00020000 CA DESIGNER RALPH MCMILLAN 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 10-08-87 00060000 C REVISED 00070000 C 08-13-90 RFC ADDED RECTYPE = NOT INVC TO FSPEC2 00080000 C 03-12-92 ESN CHANGED WORDING ON MESSAGES TO THE OPERATOR 00090000 C FROM 'CLASS J' TO 'JOBGEN GROUP'. 00100000 C 03-12-92 REM CHANGE USERIDS TO DBSDWH & DBSRFE AND ADD DBGREM 00110000 C FOR MSG ABOUT DUPLICATE LINE NAMES. 00120000 C 06-10-93 REM CHANGE IFSTRT TO IFSTRN AND ADD CHANL NAMES 00130000 CA 00140000 CA CALL JVPROJ (DIST, PROJ, LINE, AREA, IPR, STATUS) 00150000 CA 00160000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00170000 CA IN DIST CH2 DISTRICT NUMBER FROM ACCT CARD 00180000 CA IN PROJ CH5 PROJECT NUMBER FROM ACCT CARD 00190000 CA IN LINE CH18 LINE NAME FROM ACCT CARD 00200000 CA IN AREA CH30 AREA NAME FROM ACCT CARD 00210000 CA IN IPR I4 NORMAL FORTRAN PRINT UNIT FOR ERROR 00220000 CA MESSAGES 00230000 CA OUT STATUS I4 0 = OK; NON-ZERO ERROR MESSAGE PRINTED 00240000 CA 00250000 CA 00260000 CA THIS SUBROUTINE SEARCHES THE PROJECT AND LINE DATA BASES TO VERIFY00270000 CA THE DISTRICT, PROJECT NUMBER, LINE NAME AND AREA NAME. 00280000 CA ANY APPROPRIATE ERROR MESSAGES WILL BE PRINTED ON UNIT IPR 00290000 C 00300000 C 00310000 C 00320000 C EJECT 00330000 SUBROUTINE JVPROJ (DIST, PROJ, LINE, AREA, IPR, STATUS) 00340000 C 00350000 IMPLICIT INTEGER (A-Z) 00360000 C-------------------------- PARAMETER LIST VARIABLES 00370000 CHARACTER*30 AREA 00380000 CHARACTER*2 DIST 00390000 CHARACTER*18 LINE 00400000 CHARACTER*5 PROJ 00410000 C-------------------------- GENERAL VARIABLES 00420000 CHARACTER*4 BLANK /' '/ 00430000 CHARACTER*4 MSGBUF (80) /80*' '/ 00440000 INTEGER MSG1L /73/ 00450000 CHARACTER*73 MSG1 /'CAN NOT ACCESS DATA BASES! PUT JOBGEN GROUP 00460000 *ON HOLD AND REQUEUE THIS JOB.'/ 00470000 C 00480000 INTEGER MSG2L /78/ 00490000 CHARACTER*78 MSG2 /'CAN NOT OPEN PROJECT DATA BASE! PUT JOBGEN G00500000 *ROUP ON HOLD AND REQUEUE THIS JOB.'/ 00510000 C 00520000 INTEGER MSG3L /75/ 00530000 CHARACTER*75 MSG3 /'CAN NOT OPEN LINE DATA BASE! PUT JOBGEN GROU00540000 *P ON HOLD AND REQUEUE THIS JOB.'/ 00550000 C 00560000 INTEGER MSG4L /73/ 00570000 CHARACTER*73 MSG4 /'LINE DB HAS DUPLICATE RECORDS FOR PROJ= 00580000 * AND LINE= '/ 00590000 C 00600000 CHARACTER*43 PRREC 00610000 CHARACTER*8 REPLY 00620000 C-------------------------- VARIABLES FOR M204 00630000 CCCCC CHARACTER*8 CHANL /'IFAM2HLT'/ 00640001 CHARACTER*8 CHANL /'IFAM2HLA'/ 00650001 CHARACTER*19 FSPEC1 /'PROJECT= ;END; '/ 00660000 CHARACTER*63 FSPEC2 /'PROJECT= ;LNAME= 00670000 *;RECTYPE = NOT INVC;END; '/ 00680000 CHARACTER*11 INITL /'FILE LINE;;'/ 00690000 CHARACTER*14 INITP /'FILE PROJECT;;'/ 00700000 CHARACTER*12 LOGIN /'JOBGEN;JGN; '/ 00710000 CHARACTER*58 GSPEC1 00720000 */'EDIT(PROJECT,AREA,DISTRICT,CLDATE) (A(5),A(30),A(2),A(6));'/ 00730000 C 00740000 C 00750000 IF (1 .EQ. 2) CALL IFCALL 00760000 STATUS = 0 00770000 C 00780000 C--------------------- BUILD FIND SPEC 00790000 C 00800000 FSPEC1(9:13) = PROJ 00810000 C 00820000 C--------------------------- LOGIN INTO M204 00830000 C 00840000 CALL IFSTRN (IRC,2,LOGIN,0,ITHRD,CHANL) 00850000 IF (IRC .NE. 0) THEN 00860000 CALL USWTOR (MSG1,MSG1L,REPLY,8,STATUS) 00870000 STATUS = 1 00880000 GO TO 2000 00890000 END IF 00900000 C---------------------------- OPEN THE PROJECT DB 00910000 CALL IFOPEN (IRC,INITP) 00920000 IF (IRC.NE.0 .AND. IRC.NE.16 .AND. IRC.NE.32) THEN 00930000 C EXIT M204 00940000 CALL IFFNSH(IRC) 00950000 IF (IRC .NE. 1000) THEN 00960000 WRITE (IPR,9040) IRC 00970000 CALL IFGERR(IRC,MSGBUF) 00980000 WRITE(IPR,9051) IRC,MSGBUF 00990000 END IF 01000000 C TELL THE OPERATOR ABOUT THE PROBLEM 01010000 CALL USWTOR (MSG2,MSG2L,REPLY,8,STATUS) 01020000 STATUS = 1 01030000 GO TO 2000 01040000 END IF 01050000 C--------------------------- FIND THE RECORDS 01060000 CALL IFFIND (IRC,FSPEC1) 01070000 IF (IRC .NE. 0) THEN 01080000 WRITE (IPR,9020) IRC 01090000 CALL IFGERR(IRC,MSGBUF) 01100000 WRITE(IPR,9051) IRC,MSGBUF 01110000 STATUS = 1 01120000 GO TO 1000 01130000 END IF 01140000 C--------------------------- COUNT THE RECORD 01150000 CALL IFCNT (IRC,CNT) 01160000 IF (IRC .NE. 0) THEN 01170000 WRITE (IPR,9030) IRC 01180000 CALL IFGERR(IRC,MSGBUF) 01190000 WRITE(IPR,9051) IRC,MSGBUF 01200000 STATUS = 1 01210000 GO TO 1000 01220000 END IF 01230000 C 01240000 C CNT OF 0 MEANS NO MATCH FOUND 01250000 C 01260000 IF (CNT .NE. 1) THEN 01270000 WRITE (IPR, 9000) PROJ 01280000 STATUS = 1 01290000 GO TO 1000 01300000 END IF 01310000 C 01320000 C----------------------------- GET THE RECORD 01330000 CALL IFGET (IRC,PRREC,GSPEC1) 01340000 IF (IRC .NE. 0) THEN 01350000 WRITE (IPR,9050) IRC 01360000 CALL IFGERR(IRC,MSGBUF) 01370000 WRITE(IPR,9051) IRC,MSGBUF 01380000 STATUS = 1 01390000 GO TO 1000 01400000 END IF 01410000 C 01420000 C CLOSE THE PROJECT DATA BASE 01430000 C 01440000 CALL IFCLOS (IRC) 01450000 C 01460000 C CHECK FOR A CLOSED PROJECT 01470000 C 01480000 IF (PRREC(38:43) .NE. ' ') THEN 01490000 WRITE (IPR, 9010) PROJ 01500000 STATUS = 1 01510000 GO TO 1000 01520000 ENDIF 01530000 C 01540000 C SKIP R&D PROJECTS 01550000 C 01560000 IF (DIST .EQ. '99') GO TO 1000 01570000 C 01580000 IF (DIST .NE. PRREC(36:37)) THEN 01590000 WRITE (IPR, 9060) DIST 01600000 STATUS = 1 01610000 ENDIF 01620000 C 01630000 IF (PROJ .NE. '09705' .AND. PROJ .GT. '02000' .AND. 01640000 * PROJ .LT. '10000') GO TO 1000 01650000 C 01660000 IF (AREA .NE. PRREC(6:35)) THEN 01670000 WRITE (IPR, 9070) AREA 01680000 STATUS = 1 01690000 ENDIF 01700000 C 01710000 C NOW VERIFY THE LINE NAME IN THE LINE DATA BASE 01720000 C 01730000 FSPEC2(9:13) = PROJ 01740000 FSPEC2(21:38) = LINE 01750000 C 01760000 C---------------------------- OPEN THE LINE DB 01770000 CALL IFOPEN (IRC,INITL) 01780000 IF (IRC.NE.0 .AND. IRC.NE.16 .AND. IRC.NE.32) THEN 01790000 C EXIT M204 01800000 CALL IFFNSH(IRC) 01810000 IF (IRC .NE. 1000) THEN 01820000 WRITE (IPR,9040) IRC 01830000 CALL IFGERR(IRC,MSGBUF) 01840000 WRITE(IPR,9051) IRC,MSGBUF 01850000 END IF 01860000 C LET THE OPERATOR KNOW ABOUT THE ERROR 01870000 CALL USWTOR (MSG3,MSG3L,REPLY,8,STATUS) 01880000 STATUS = 1 01890000 GO TO 2000 01900000 END IF 01910000 C--------------------------- FIND THE RECORD 01920000 CALL IFFIND (IRC,FSPEC2) 01930000 IF (IRC .NE. 0) THEN 01940000 WRITE (IPR,9020) IRC 01950000 CALL IFGERR(IRC,MSGBUF) 01960000 WRITE(IPR,9051) IRC,MSGBUF 01970000 STATUS = 1 01980000 GO TO 1000 01990000 END IF 02000000 C--------------------------- COUNT THE RECORD 02010000 CALL IFCNT (IRC,CNT) 02020000 IF (IRC .NE. 0) THEN 02030000 WRITE (IPR,9030) IRC 02040000 CALL IFGERR(IRC,MSGBUF) 02050000 WRITE(IPR,9051) IRC,MSGBUF 02060000 STATUS = 1 02070000 GO TO 1000 02080000 END IF 02090000 C------------------------------------- EXIT M204 02100000 CALL IFFNSH(IRC) 02110000 IF (IRC .NE. 1000) THEN 02120000 WRITE (IPR,9040) IRC 02130000 CALL IFGERR(IRC,MSGBUF) 02140000 WRITE(IPR,9051) IRC,MSGBUF 02150000 END IF 02160000 C 02170000 C CNT OF 0 MEANS NO MATCH FOUND 02180000 C 02190000 IF (CNT .EQ. 0) THEN 02200000 WRITE (IPR, 9080) LINE 02210000 STATUS = 1 02220000 GO TO 2000 02230000 END IF 02240000 C 02250000 IF (CNT .GT. 1) THEN 02260000 MSG4(40:44) = PROJ 02270000 MSG4(56:73) = LINE 02280000 CALL USWTSO ('DBSDWH ', MSG4, MSG4L, ERR) 02290000 CALL USWTSO ('DBSRFC ', MSG4, MSG4L, ERR) 02300000 CALL USWTSO ('DBGREM ', MSG4, MSG4L, ERR) 02310000 END IF 02320000 C 02330000 GO TO 2000 02340000 C------------------------------------- EXIT M204 02350000 1000 CALL IFFNSH(IRC) 02360000 IF (IRC .NE. 1000) THEN 02370000 WRITE (IPR,9040) IRC 02380000 CALL IFGERR(IRC,MSGBUF) 02390000 WRITE(IPR,9051) IRC,MSGBUF 02400000 END IF 02410000 C------------------------------------- EXIT 02420000 2000 RETURN 02430000 C------------------------------- FORMAT STATEMENTS 02440000 9000 FORMAT (' *** PROJECT NUMBER ', A5,' IS INVALID') 02450000 9010 FORMAT (' *** PROJECT ',A5,' IS CLOSED') 02460000 9020 FORMAT (' *** FIND FAILURE(PROJECT) - REASON CODE = ',I4) 02470000 9030 FORMAT (' *** COUNT FAILURE(PROJECT) - REASON CODE = ',I4) 02480000 9040 FORMAT (' *** ERROR ON FINISH - REASON CODE = ',I4) 02490000 9050 FORMAT (' *** IFGET ERROR - REASON CODE = ',I4) 02500000 9051 FORMAT (2X,I4,1X,20A4) 02510000 9060 FORMAT (' *** DISTRICT NUMBER ',A2,' IS INVALID') 02520000 9070 FORMAT (' *** AREA NAME "',A30,'" IS INVALID') 02530000 9080 FORMAT (' *** LINE NAME "',A18,'" IS INVALID') 02540000 END 02550000