Trailing-Edge
-
PDP-10 Archives
-
decuslib20-08
-
decus/20-0175/jobadm.for
There is 1 other file named jobadm.for in the archive. Click here to see a list.
C RENBR(JOBADM/JOBS - ADMINISTRATOR PROGRAM)
C
C DONALD BARTH, YALE SCHOOL OF MANAGEMENT
C
C THIS PROGRAM IS PART OF THE JOB INTERVIEW REQUEST SYSTEM
C
COMMON/JOBONE/LOADED
C
C ARRAYS CONTAINING 1 NUMBER OR 1 STRING FOR EACH FIRM
DIMENSION LTRINC(40,200),LTRDPT(30,200),LTRADR(30,200)
DIMENSION LENGTH(200),KNTOPN(200),NUMBER(200),
1 INTRVW(200),IUSDUP(200),INCLSD(200),JNCLSD(200),
2 KFIRST(200)
C
C ARRAYS CONTAINING 1 NUMBER FOR EACH RECRUITER
DIMENSION JFIRST(1000),JFINAL(1000),JDATE(1000),
1 JSCHDL(1000)
C
C ARRAYS CONTAINING 1 NUMBER FOR EACH TIME PROFILE
DIMENSION KNTSLT(50),NUMSLT(50),LNGSLT(50)
C
C ARRAY CONTAINING 1 NUMBER FOR EACH TIME IN ALL PROFILES
DIMENSION INI060(500)
C
C ARRAY CONTAINING 1 NUMBER FOR EACH TIME IN SINGLE PROFILE
DIMENSION INISCH(16)
C
C ARRAYS CONTAINING COMMANDS TYPED BY ADMINISTRATOR
DIMENSION LTRCMD(32)
DIMENSION LNGCMD(7)
C
C VARIOUS OTHER CHARACTER STRINGS
DIMENSION LTRBFR(80),LTRDGT(10),LTRWHO(40),
1 LWRWHO(40),LTRWEK(21),LTRTIM(15)
C
C FOLLOWING LINES ARE PROVIDED AS A REFERENCE ONLY
C THE REAL PROFILES ARE READ FROM A FILE IN CENTRAL AREA
C
C STANDARD TIMES IN BOTH 60 MINUTE HOURS AND
C AS STORED IN THE FILE WHICH DEFINES PROFILES
C
C 115, 145, 230, 300, 330, 400, 430
C 900, 930,1000,1030,1100,1245,1315,1345,1430,1500,1530,1600,1630
C 540, 570, 600, 630, 660, 765, 795, 825, 870, 900, 930, 960, 990
C
C 100 145, 230, 315, 400
C 845, 930,1015,1100,1300,1345,1430,1515,1600
C 525, 570, 615, 660, 780, 825, 870, 915, 960
C
C 100, 200, 300, 400
C 900,1000,1100,1300,1400,1500,1600
C 540, 600, 660, 780, 840, 900, 960
C
C COMMANDS WHICH CAN BE TYPED BY USER
DATA LTRCMD/
11HM,1HO,1HD,1HI,1HF,1HY,
21HE,1HN,1HT,1HE,1HR,
31HS,1HH,1HO,1HW,
41HS,1HA,1HV,1HE,
51HE,1HX,1HI,1HT,
61HL,1HI,1HS,1HT,
71HP,1HR,1HI,1HN,1HT/
DATA LNGCMD/6,5,4,4,4,4,5/
DATA KNTSPL,KNTCMD/32,7/
C
C NAMES OF DAYS OF WEEK
DATA LTRWEK/
1 1HS,1Hu,1Hn,
2 1HM,1Ho,1Hn,
3 1HT,1Hu,1He,
4 1HW,1He,1Hd,
5 1HT,1Hh,1Hu,
6 1HF,1Hr,1Hi,
7 1HS,1Ha,1Ht/
C
C DIMENSIONS OF ARRAYS CONTAINING CHARACTER INFORMATION
C LMTINC = NUMBER LETTERS IN FIRM NAME
C LMTDPT = NUMBER LETTERS IN DEPARTMENT NAME
C LMTADR = NUMBER LETTERS IN ADDRESS
C LMTBFR = NUMBER LETTERS IN LTRBFR BUFFER ARRAY
C LMTWHO = NUMBER LETTERS IN NAME OF THIS ACCOUNT
DATA LMTINC,LMTDPT,LMTADR,LMTBFR,LMTWHO/
1 40,30,30,80,40/
C
C DIMENSIONS OF ARRAYS LIMITING SIZE OF CASE HANDLED
C LMTSCH = MAXIMUM NUMBER OF PEOPLE ANY ONE RECRUITER CAN
C TALK TO IN 1 DAY. MAXIMUM NUMBER OF TIMES IN 1
C SCHEDULE.
C LMTSLT = MAXIMUM NUMBER OF DIFFERENT PROFILES OF INTERVIEW
C SCHEDULES.
C LMTTIM = MAXIMUM NUMBER OF DIFFERENT TIMES FOR ALL DIFFERENT
C PROFILES OF INTERVIEW SCHEDULES.
C LMTRCT = MAXIMUM NUMBER OF RECRUITERS ACROSS ALL FIRMS
C LMTFRM = MAXIMUM NUMBER OF FIRMS
DATA LMTSCH,LMTSLT,LMTTIM,LMTRCT,LMTFRM/
1 16,50,500,1000,200/
C
C DIGITS ZERO THROUGH NINE
DATA LTRDGT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C ODD LETTERS
DATA LTRSPA,LTRCOM,LTRSTA,LTRQUE/1H ,1H,,1H*,1H?/
C
C UNIT NUMBERS FOR TERMINAL AND FILES
DATA ITTY,IDISK/5,1/
C
C NUMBER OF LINES ON SINGLE CRT SCREEN MINUS THE BOTTOM
C TWO WHICH ARE USED FOR COMMUNICATIONS
DATA LNGCRT/22/
C
C INFORM USER OF WHAT PROGRAM THIS IS
WRITE(ITTY,1)
1 FORMAT(' JOBADM'/' Job interview administrator program'/1X)
C
C TEST IF COMMON BLOCK IS LOADED
IF(LOADED.NE.1234)GO TO 560
C
C TURN OFF STOPPING EVERY 24 LINES OF SCREEN DISPLAY
CALL TTYSET
C
C VARIABLE NEEDED BY INITIAL HELP MESSAGES
IMOD=0
C
C IDENTIFY CURRENT USER
CALL RSMWHO(LTRWHO,IPRJCT,IPRGRM,NUMWHO)
C
C DETERMINE IF CURRENT USER IS ENABLED AS ADMINISTRATOR
CALL RSMCHK(LTRWHO,LWRWHO,LMTWHO,IPRJCT,IPRGRM, IDISK,
1 IYEAR,ICHECK,IPRINT,JVIDEO,LTRBFR,LMTBFR,ITTY,NUMWHO)
IF(IYEAR.GE.0)GO TO 548
C
C ************************************
C * *
C * GET PROFILES OF STARTING TIMES *
C * *
C ************************************
C
CALL RSMOPN(9,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 572
CALL JOBPRO(NUMWHO,KLASS,ITTY,IDISK,
1 LMTSCH,KNTSLT,LNGSLT,NUMSLT,LMTSLT,MAXSLT,
2 INI060,LMTTIM,MAXTIM,LTRBFR,LMTBFR)
CALL RSMCLS(9,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
IF(MAXSLT.GT.0)GO TO 2
IF(MAXSLT.EQ.0)GO TO 570
IF(MAXSLT.EQ.-2)GO TO 574
IF(MAXSLT.EQ.-3)GO TO 576
IF(MAXSLT.EQ.-4)GO TO 578
IF(MAXSLT.EQ.-5)GO TO 580
2 CONTINUE
C
C ***********************************************************
C * *
C * DETERMINE CLASS FOR WHICH SCHEDULES ARE TO BE ENTERED *
C * *
C ***********************************************************
C
C ASK FOR CLASS NUMBER
IF(ICHECK.GT.IPRINT)GO TO 552
IF(ICHECK.EQ.IPRINT)GO TO 14
3 IF((IPRINT-ICHECK).EQ.1)WRITE(ITTY,4)ICHECK,IPRINT
4 FORMAT(' Set recruiter schedule for which class (',
1 1I4,' or',1I4,')? ',$)
IF((IPRINT-ICHECK).GT.1)WRITE(ITTY,5)ICHECK,IPRINT
5 FORMAT(' Set recruiter schedule for which class (',
1 1I4,' thru',1I4,')? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 13
IF(MAXBFR.EQ.0)GO TO 7
LOWBFR=1
CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(11,11,6),KIND
6 IF(IVALUE.LT.ICHECK)GO TO 9
IF(IVALUE.GT.IPRINT)GO TO 9
GO TO 16
7 WRITE(ITTY,8)
8 FORMAT(' Class number must be specified')
GO TO 3
9 WRITE(ITTY,10)
10 FORMAT(' You are not allowed to change schedules for this class')
GO TO 3
11 WRITE(ITTY,12)
12 FORMAT(' Type ? for help')
GO TO 3
13 CALL ADMHLP(ITTY,14,IMOD)
GO TO 3
14 IVALUE=ICHECK
WRITE(ITTY,15)IVALUE
15 FORMAT(' Changing recruiter schedules for class',1I4)
16 KLASS=IVALUE
C
C ***************************************
C * *
C * DETERMINE CURRENT ROUND AND STAGE *
C * *
C ***************************************
C
CALL JOBNOW(NUMWHO,KLASS,ITTY,IDISK,LTRBFR,LMTBFR,
1 IERROR,JMOVE,JPASS,MANNER,KANRUN)
IF(IERROR.LT.0)GO TO 550
IF(IERROR.GT.0)GO TO 554
IF(KANRUN.LT.0)GO TO 582
C
C *************************************
C * *
C * READ THE OLD INTERVIEW SCHEDULE *
C * *
C *************************************
C
ICLASS=KLASS
MAXNUM=0
MAXSTG=0
MAXRND=0
MAXALL=0
MAXBID=0
MAXPAY=0
IMOVE=JMOVE
IPASS=JPASS
KNTINC=0
IVERSN=0
KNTRCT=0
JLOOP=1
CALL RSMOPN(4,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 34
READ(IDISK,17)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN
17 FORMAT(5I)
C IDMMY1 = WHERE TYPE OF BIDDING STORED IN FILE
READ(IDISK,18)KNTINC,MAXNUM,IDMMY1,MAXSTG,MAXRND,
1 MAXALL,MAXBID,MAXPAY
18 FORMAT(8I)
IF(KNTINC.LE.0)GO TO 24
IF(KNTINC.GT.LMTFRM)GO TO 564
DO 23 NOWINC=1,KNTINC
READ(IDISK,19)
1(LTRINC(I,NOWINC),I=1,LMTINC),
2(LTRDPT(I,NOWINC),I=1,LMTDPT),
3(LTRADR(I,NOWINC),I=1,LMTADR),
4NUMBER(NOWINC),
5LENGTH(NOWINC),KNTOPN(NOWINC),INTRVW(NOWINC),
6IUSDUP(NOWINC),INCLSD(NOWINC),JNCLSD(NOWINC)
19 FORMAT(40A1/30A1/30A1/7I)
LIMIT=INTRVW(NOWINC)
KFIRST(NOWINC)=KNTRCT+1
IF(LIMIT.LE.0)GO TO 22
IF((KNTRCT+LIMIT).GT.LMTRCT)GO TO 562
DO 21 IPERSN=1,LIMIT
KNTRCT=KNTRCT+1
READ(IDISK,20)JDATE(KNTRCT),JFIRST(KNTRCT),
1 JFINAL(KNTRCT),JSCHDL(KNTRCT)
20 FORMAT(4I)
21 CONTINUE
22 CONTINUE
23 CONTINUE
24 CALL RSMCLS(4,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
C
C VERIFY THAT CORRECT ADMINISTRATOR FILE WAS READ
IF(IAUTHR.LT.1)GO TO 558
IF(IAUTHR.GT.2)GO TO 558
IF(ICLASS.NE.KLASS)GO TO 556
C
C *********************************
C * *
C * TELL USER WHAT MOVE THIS IS *
C * *
C *********************************
C
C DETERMINE IF ARE CONTINUING A MOVE
JLOOP=0
IF(IMOVE.EQ.JMOVE)GO TO 31
C
C ASK IF REALLY MEAN TO START A NEW MOVE
WRITE(ITTY,25)IMOVE,JMOVE
25 FORMAT(
1' The schedule file is for round',1I3,' and we are about',
2' to begin round',1I3)
26 WRITE(ITTY,27)
27 FORMAT(
1' Are we really starting a new round? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(26,26,30,29,28),KNDYES
28 CALL ADMHLP(ITTY,16,IMOD)
GO TO 26
29 JMOVE=IMOVE
JPASS=IPASS
GO TO 32
30 KNTINC=0
GO TO 34
31 IF(IPASS.NE.JPASS)GO TO 34
32 WRITE(ITTY,33)JMOVE,JPASS
33 FORMAT(' Continuing round',1I3,', stage',1I3)
GO TO 36
34 WRITE(ITTY,35)JMOVE,JPASS
35 FORMAT(' Starting round',1I3,', stage',1I3)
36 IMOVE=JMOVE
IPASS=JPASS
IF(KNTINC.EQ.0)WRITE(ITTY,37)
37 FORMAT(
1' No schedules have been entered so far'/1X)
IF(KNTINC.NE.0)WRITE(ITTY,38)KNTINC
38 FORMAT(
1' Schedules have already been entered for',1I5,' firms'/1X)
C
C TELL ADMINISTRATOR THE TYPE OF BIDDING ALLOWED
IF(MANNER.EQ. 1)WRITE(ITTY,39)
IF(MANNER.EQ. 2)WRITE(ITTY,40)
IF(MANNER.EQ.11)WRITE(ITTY,41)
IF(MANNER.EQ.12)WRITE(ITTY,42)
IF(MANNER.EQ.13)WRITE(ITTY,43)
IF(MANNER.EQ.21)WRITE(ITTY,44)
IF(MANNER.EQ.22)WRITE(ITTY,45)
IF(MANNER.EQ.23)WRITE(ITTY,46)
39 FORMAT(
1' Students rank requests.'/
2' If a request fails, those of lower priority are boosted.')
40 FORMAT(
1' Students rank requests.'/
2' If a request fails, those of lower priority are not boosted.')
41 FORMAT(
1' Students can assign high (A) priority to some requests.'/
2' Total number of high priority requests for entir',
3'e season is fixed.')
42 FORMAT(
1' Students can assign high (A) priority to some requests.'/
2' Total number of high priority requests for each ',
3'round is fixed.')
43 FORMAT(
1' Students can assign high (A) priority to some requests.'/
2' Total number of high priority requests for each stag',
3'e of each round is fixed.')
44 FORMAT(
1' Students bid for interviews in an auction.'/
2' Total amount bid during entire season is fixed.')
45 FORMAT(
1' Students bid for interviews in an auction.'/
2' Total amount bid during each round is fixed.')
46 FORMAT(
1' Students bid for interviews in an auction.'/
2' Total amount bid during each stage of each round is fixed.')
WRITE(ITTY,47)
47 FORMAT(1X)
C
C *************************************************
C * *
C * CONVERT TIMES OF INTERVIEWS INTO SUBSCRIPTS *
C * *
C *************************************************
C
IF(KNTINC.EQ.0)GO TO 56
DO 55 NOWINC=1,KNTINC
LIMIT=INTRVW(NOWINC)
IF(LIMIT.EQ.0)GO TO 55
IPERSN=KFIRST(NOWINC)
DO 54 JPERSN=1,LIMIT
IF(JFIRST(IPERSN).LT.0)GO TO 53
I=0
J3045=0
48 IF(I.GE.MAXSLT)GO TO 566
I=I+1
I3045=J3045+1
J3045=J3045+KNTSLT(I)
IF(LNGSLT(I).NE.LENGTH(NOWINC))GO TO 48
IF(NUMSLT(I).NE.JSCHDL(IPERSN))GO TO 48
49 IF(I3045.GT.J3045)GO TO 568
IF(INI060(I3045).EQ.JFIRST(IPERSN))GO TO 50
I3045=I3045+1
GO TO 49
50 JFIRST(IPERSN)=I3045
51 IF(I3045.GT.J3045)GO TO 568
IF(INI060(I3045).EQ.JFINAL(IPERSN))GO TO 52
I3045=I3045+1
GO TO 51
52 JFINAL(IPERSN)=I3045
53 IPERSN=IPERSN+1
54 CONTINUE
55 CONTINUE
56 CONTINUE
C
C *************************************************
C * *
C * ASK FOR MAXIMUM NUMBERS OF REQUESTS ALLOWED *
C * *
C *************************************************
C
GO TO 58
57 JLOOP=0
58 DO 124 ILOOP=1,5
GO TO(61,61,61,59,60),ILOOP
59 IF(MANNER.EQ.21)GO TO 61
IF(MANNER.EQ.22)GO TO 61
IF(MANNER.EQ.23)GO TO 61
GO TO 124
60 IF(MANNER.EQ.1)GO TO 124
IF(MANNER.EQ.2)GO TO 124
GO TO 61
61 CONTINUE
IF(ILOOP.EQ.1)JVALUE=MAXSTG
IF(ILOOP.EQ.2)JVALUE=MAXRND
IF(ILOOP.EQ.3)JVALUE=MAXALL
IF(ILOOP.EQ.4)JVALUE=MAXBID
IF(ILOOP.EQ.5)JVALUE=MAXPAY
IF(JVALUE.EQ.0)GO TO 82
GO TO(62,64,66,68,70),ILOOP
62 WRITE(ITTY,63)JVALUE
63 FORMAT(' Each student can request',1I4,
1' interviews in this stage of this round')
GO TO 77
64 WRITE(ITTY,65)JVALUE
65 FORMAT(' Each student can request',1I4,
1' interviews total in all stages of this round')
GO TO 77
66 WRITE(ITTY,67)JVALUE
67 FORMAT(' Each student can request',1I4,
1' interviews total during entire interview season')
GO TO 77
68 WRITE(ITTY,69)JVALUE
69 FORMAT(' Each student can bid up to',1I8,
1' for a single firm')
GO TO 77
70 IF(MANNER.EQ.11)WRITE(ITTY,71)JVALUE
IF(MANNER.EQ.12)WRITE(ITTY,72)JVALUE
IF(MANNER.EQ.13)WRITE(ITTY,73)JVALUE
IF(MANNER.EQ.21)WRITE(ITTY,74)JVALUE
IF(MANNER.EQ.22)WRITE(ITTY,75)JVALUE
IF(MANNER.EQ.23)WRITE(ITTY,76)JVALUE
71 FORMAT(' Each student can make',1I4,' high priorit',
1'y requests during entire season')
72 FORMAT(' Each student can make',1I4,' high priorit',
1'y requests during all stages of this round')
73 FORMAT(' Each student can make',1I4,' high priorit',
1'y requests during this stage of this round')
74 FORMAT(' Each student can bid a total of',1I8,' du',
1'ring entire season')
75 FORMAT(' Each student can bid a total of',1I8,' du',
1'ring all stages of this round')
76 FORMAT(' Each student can bid a total of',1I8,' du',
1'ring this stage of this round')
GO TO 77
77 IF(JLOOP.EQ.0)GO TO 124
GO TO 80
C
C ASK USER FOR THE MAXIMUM NUMBER OF INTERVIEWS ALLOWED
78 IF(JVALUE.EQ.0)GO TO 82
WRITE(ITTY,79)JVALUE
79 FORMAT(
1' Maximum number:',1I7)
80 WRITE(ITTY,81)
81 FORMAT(' Change to? ',$)
GO TO 98
82 GO TO(83,85,87,89,91),ILOOP
83 WRITE(ITTY,84)
84 FORMAT(
1' How many interviews can 1 student request in this stage? ',
2$)
GO TO 98
85 WRITE(ITTY,86)
86 FORMAT(
1' How many interviews can 1 student request in all',
2' stages of round? ',
3$)
GO TO 98
87 WRITE(ITTY,88)
88 FORMAT(
1' How many interviews can 1 student request during',
2' entire season? ',
3$)
GO TO 98
89 WRITE(ITTY,90)
90 FORMAT(
1' What is maximum which each student can bid for single firm? ',
2$)
GO TO 98
91 IF(MANNER.EQ.11)WRITE(ITTY,92)
IF(MANNER.EQ.12)WRITE(ITTY,93)
IF(MANNER.EQ.13)WRITE(ITTY,94)
IF(MANNER.EQ.21)WRITE(ITTY,95)
IF(MANNER.EQ.22)WRITE(ITTY,96)
IF(MANNER.EQ.23)WRITE(ITTY,97)
92 FORMAT(
1' How many high priority requests can student make dur',
2'ing this season? ',$)
93 FORMAT(
1' How many high priority requests can student make dur',
2'ing this round? ',$)
94 FORMAT(
1' How many high priority requests can student make dur',
2'ing this stage? ',$)
95 FORMAT(
1' How much can each student bid during this season? ',$)
96 FORMAT(
1' How much can each student bid during this round? ',$)
97 FORMAT(
1' How much can each student bid during this stage? ',$)
GO TO 98
98 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 101
IF(MAXBFR.GT.0)GO TO 117
99 IF(JVALUE.EQ.0)GO TO 109
WRITE(ITTY,100)
100 FORMAT(' Maximum number not changed')
GO TO 123
101 GO TO(102,103,104,105,106),ILOOP
102 CALL ADMHLP(ITTY,12,IMOD)
GO TO 78
103 CALL ADMHLP(ITTY,21,IMOD)
GO TO 78
104 CALL ADMHLP(ITTY,24,IMOD)
GO TO 78
105 CALL ADMHLP(ITTY,23,IMOD)
GO TO 78
106 IF(MANNER.LE.13)CALL ADMHLP(ITTY,22,IMOD)
IF(MANNER.GE.20)CALL ADMHLP(ITTY,25,IMOD)
GO TO 78
107 WRITE(ITTY,108)
108 FORMAT(' Type ? for help')
GO TO 78
109 WRITE(ITTY,110)
110 FORMAT(' Maximum number must be specified')
GO TO 78
111 WRITE(ITTY,112)
112 FORMAT(' Maximum number must be greater than zero')
GO TO 78
113 WRITE(ITTY,114)
114 FORMAT(' Maximum number must be less than 1000')
GO TO 78
115 WRITE(ITTY,116)
116 FORMAT(' Maximum number must be less than 1000000')
GO TO 78
117 LOWBFR=1
CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(99,107,118),KIND
118 IF(IVALUE.LE.0)GO TO 111
IF(ILOOP.LE.3)GO TO 119
IF(MANNER.LT.20)GO TO 119
IF(IVALUE.GT.9999999)GO TO 115
GO TO 120
119 IF(IVALUE.GT.999)GO TO 113
120 IF(IVALUE.EQ.JVALUE)WRITE(ITTY,121)
121 FORMAT(' Maximum number not changed')
IF(IVALUE.NE.JVALUE)WRITE(ITTY,122)
122 FORMAT(' Maximum number changed')
JVALUE=IVALUE
123 CONTINUE
IF(ILOOP.EQ.1)MAXSTG=JVALUE
IF(ILOOP.EQ.2)MAXRND=JVALUE
IF(ILOOP.EQ.3)MAXALL=JVALUE
IF(ILOOP.EQ.4)MAXBID=JVALUE
IF(ILOOP.EQ.5)MAXPAY=JVALUE
124 CONTINUE
IF(JLOOP.NE.0)GO TO 57
JLOOP=1
125 WRITE(ITTY,126)
126 FORMAT(' Is the above information correct? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(125,125,128,58,127),KNDYES
127 CALL ADMHLP(ITTY,26,IMOD)
GO TO 125
128 CONTINUE
C
C *********************
C * *
C * GET NEXT OPTION *
C * *
C *********************
C
129 WRITE(ITTY,130)
130 FORMAT(' What next? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
131 IF(MAXBFR.LT.0)GO TO 132
IF(MAXBFR.EQ.0)GO TO 129
LOWBFR=1
CALL DAVERB(1,KNTSPL,LTRCMD,1,KNTCMD,
1LNGCMD,LTRBFR,MAXBFR,LOWBFR,KIND,MATCH,LCNWRD,
2LCNKNT,LCNBFR)
GO TO(129,135,133,133,135),KIND
132 CALL ADMHLP(ITTY,1,IMOD)
GO TO 129
C
C VERIFY THAT NOTHING OTHER THAN NUMBER FOLLOWS COMMAND
133 IF(LOWBFR.GT.MAXBFR)GO TO 137
IF(LTRBFR(LOWBFR).EQ.LTRSPA)GO TO 137
LTRNOW=LTRBFR(LOWBFR)
DO 134 I=1,10
IF(LTRNOW.EQ.LTRDGT(I))GO TO 137
134 CONTINUE
135 WRITE(ITTY,136)
136 FORMAT(' Type ? for help')
GO TO 129
C
C ************************
C * *
C * GET NUMBER OF FIRM *
C * *
C ************************
C
C CHECK IF FIRM NUMBER IS NEEDED
137 KOMAND=MATCH
GO TO(138,151,138,151,151,151,151),KOMAND
C
C CHECK IF USER TYPED ANYTHING TO RIGHT OF COMMAND
138 IF(LOWBFR.LE.MAXBFR)GO TO 141
C
C ASK ADMINISTRATOR WHAT FIRM IS TO BE EDITED
139 WRITE(ITTY,140)
140 FORMAT(' Firm number? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 144
IF(MAXBFR.EQ.0)GO TO 129
LOWBFR=1
141 CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(129,142,143),KIND
142 IF(LTRBFR(LOWBFR).EQ.LTRQUE)GO TO 144
GO TO 145
143 IF(LOWBFR.GT.MAXBFR)GO TO 147
IF(LTRBFR(LOWBFR).NE.LTRSPA)GO TO 145
LOWBFR=LOWBFR+1
GO TO 143
144 CALL ADMHLP(ITTY,2,IMOD)
GO TO 139
145 WRITE(ITTY,146)
146 FORMAT(' Type ? for help')
GO TO 139
147 IF(KNTINC.LE.0)GO TO 149
DO 148 KOMPNY=1,KNTINC
IF(NUMBER(KOMPNY).NE.IVALUE)GO TO 148
NOWFRM=KOMPNY
GO TO 151
148 CONTINUE
149 WRITE(ITTY,150)IVALUE
150 FORMAT(' ',1I5,' is not currently a firm number')
GO TO 129
C
C BRANCH TO COMMAND NEEDING THE ARGUMENT
151 GO TO(152,159,482,533,533,456,486),KOMAND
C
C ******************************
C * *
C * GET INFORMATION FOR FIRM *
C * *
C ******************************
C
C IF MODIFYING, MOVE SCHEDULING INFO TO TOP OF STACK
C JMOD = 0, ENTERING NEW FIRM
C = 1, MODIFYING OLD FIRM
152 JMOD=1
153 IMOD=1
LOWSWP=KFIRST(NOWFRM)
MIDSWP=KFIRST(NOWFRM)+INTRVW(NOWFRM)-1
CALL DASWAP(JDATE,LOWSWP,MIDSWP,KNTRCT)
CALL DASWAP(JFIRST,LOWSWP,MIDSWP,KNTRCT)
CALL DASWAP(JFINAL,LOWSWP,MIDSWP,KNTRCT)
CALL DASWAP(JSCHDL,LOWSWP,MIDSWP,KNTRCT)
DO 154 I=1,KNTINC
IF(KFIRST(I).GT.LOWSWP)KFIRST(I)=KFIRST(I)-INTRVW(NOWFRM)
154 CONTINUE
KFIRST(NOWFRM)=KNTRCT-INTRVW(NOWFRM)+1
C
C REPORT NAMES, INTERVIEW LENGTH, NUMBER OF INTERVIEWS
GO TO 484
155 WRITE(ITTY,156)
156 FORMAT(' Is the above information correct? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(155,155,266,158,157),KNDYES
157 CALL ADMHLP(ITTY,15,IMOD)
GO TO 155
158 CONTINUE
GO TO 161
C
C IF ENTERING NEW FIRM, CREATE THE NULL FIRM
159 IF(KNTINC.GE.LMTFRM)GO TO 454
JMOD=0
IMOD=0
KNTINC=KNTINC+1
NOWFRM=KNTINC
MAXNUM=MAXNUM+1
NUMBER(KNTINC)=MAXNUM
IUSDUP(KNTINC)=0
INCLSD(KNTINC)=0
JNCLSD(KNTINC)=0
KFIRST(KNTINC)=KNTRCT+1
INTRVW(KNTINC)=0
KNTOPN(KNTINC)=0
LENGTH(KNTINC)=0
WRITE(ITTY,160)MAXNUM
160 FORMAT(' Ready to enter information for firm',1I5)
C
C GET NAME OF FIRM
161 IF(IMOD.EQ.0)GO TO 166
J=LMTINC
162 IF(LTRINC(J,NOWFRM).NE.LTRSPA)GO TO 163
J=J-1
IF(J.GT.1)GO TO 162
163 WRITE(ITTY,164)(LTRINC(I,NOWFRM),I=1,J)
164 FORMAT(' Firm name: ',40A1)
WRITE(ITTY,165)
165 FORMAT(' Change to? ',$)
GO TO 168
166 WRITE(ITTY,167)
167 FORMAT(' Firm name? ',$)
168 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 170
IF(MAXBFR.GT.0)GO TO 171
IF(IMOD.EQ.0)GO TO 451
WRITE(ITTY,169)
169 FORMAT(' Firm name not changed')
GO TO 174
170 CALL ADMHLP(ITTY,3,IMOD)
GO TO 161
171 DO 172 I=1,LMTINC
LTRINC(I,NOWFRM)=LTRSPA
IF(I.GT.MAXBFR)GO TO 172
IF(LTRBFR(I).EQ.LTRSTA)GO TO 172
LTRINC(I,NOWFRM)=LTRBFR(I)
172 CONTINUE
IF(IMOD.EQ.0)GO TO 174
WRITE(ITTY,173)
173 FORMAT(' Firm name changed')
174 CONTINUE
C
C GET NAME OF DIVISION
175 IF(IMOD.EQ.0)GO TO 180
J=LMTDPT
176 IF(LTRDPT(J,NOWFRM).NE.LTRSPA)GO TO 177
J=J-1
IF(J.GT.1)GO TO 176
177 WRITE(ITTY,178)(LTRDPT(I,NOWFRM),I=1,J)
178 FORMAT(' Division: ',40A1)
WRITE(ITTY,179)
179 FORMAT(' Change to (type * to cancel division)? ',$)
GO TO 182
180 WRITE(ITTY,181)
181 FORMAT(' Division? ',$)
182 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 184
IF(MAXBFR.GT.0)GO TO 185
IF(IMOD.EQ.0)GO TO 185
WRITE(ITTY,183)
183 FORMAT(' Division not changed')
GO TO 188
184 CALL ADMHLP(ITTY,4,IMOD)
GO TO 175
185 DO 186 I=1,LMTDPT
LTRDPT(I,NOWFRM)=LTRSPA
IF(I.GT.MAXBFR)GO TO 186
IF(LTRBFR(I).EQ.LTRSTA)GO TO 186
LTRDPT(I,NOWFRM)=LTRBFR(I)
186 CONTINUE
IF(IMOD.EQ.0)GO TO 188
WRITE(ITTY,187)
187 FORMAT(' Division changed')
188 CONTINUE
C
C GET ADDRESS
189 IF(IMOD.EQ.0)GO TO 194
J=LMTADR
190 IF(LTRADR(J,NOWFRM).NE.LTRSPA)GO TO 191
J=J-1
IF(J.GT.1)GO TO 190
191 WRITE(ITTY,192)(LTRADR(I,NOWFRM),I=1,J)
192 FORMAT(' Address: ',40A1)
WRITE(ITTY,193)
193 FORMAT(' Change to (type * to cancel address)? ',$)
GO TO 196
194 WRITE(ITTY,195)
195 FORMAT(' Address? ',$)
196 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 198
IF(MAXBFR.GT.0)GO TO 199
IF(IMOD.EQ.0)GO TO 199
WRITE(ITTY,197)
197 FORMAT(' Address not changed')
GO TO 202
198 CALL ADMHLP(ITTY,5,IMOD)
GO TO 189
199 DO 200 I=1,LMTADR
LTRADR(I,NOWFRM)=LTRSPA
IF(I.GT.MAXBFR)GO TO 200
IF(LTRBFR(I).EQ.LTRSTA)GO TO 200
LTRADR(I,NOWFRM)=LTRBFR(I)
200 CONTINUE
IF(IMOD.EQ.0)GO TO 202
WRITE(ITTY,201)
201 FORMAT(' Address changed')
202 CONTINUE
C
C GET LENGTH OF INTERVIEW
203 IF(IMOD.EQ.0)GO TO 206
WRITE(ITTY,204)LENGTH(NOWFRM)
204 FORMAT(' Length:',1I4)
WRITE(ITTY,205)
205 FORMAT(' Change to? ',$)
GO TO 208
206 WRITE(ITTY,207)
207 FORMAT(' Length? ',$)
208 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 213
IF(MAXBFR.GT.0)GO TO 219
209 IF(IMOD.NE.0)GO TO 230
WRITE(ITTY,210)
210 FORMAT(' Interview length must be specified')
GO TO 203
211 WRITE(ITTY,212)
212 FORMAT(' Type ? for help')
GO TO 203
213 CALL ADMHLP(ITTY,7,IMOD)
J=0
214 K=J
DO 216 I=1,MAXSLT
IF(K.GE.LNGSLT(I))GO TO 216
IF(J.EQ.K)GO TO 215
IF(J.LE.LNGSLT(I))GO TO 216
215 J=LNGSLT(I)
216 CONTINUE
IF(K.EQ.J)GO TO 218
WRITE(ITTY,217)J
217 FORMAT(1X,1I3,' minutes')
GO TO 214
218 GO TO 203
219 LOWBFR=1
CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(209,211,220),KIND
220 DO 221 I=1,MAXSLT
IF(IVALUE.EQ.LNGSLT(I))GO TO 223
221 CONTINUE
WRITE(ITTY,222)
222 FORMAT(' There is no profile of starting times',
1' for interviews of this length')
GO TO 203
223 IF(IMOD.EQ.0)GO TO 232
IF(LENGTH(NOWFRM).EQ.IVALUE)GO TO 230
LENGTH(NOWFRM)=IVALUE
I=KFIRST(NOWFRM)
K=0
L=KFIRST(NOWFRM)+INTRVW(NOWFRM)
224 IF(I.GE.L)GO TO 225
IF(JDATE(I).GE.0)K=K+1
I=I+1
GO TO 224
225 KNTRCT=KNTRCT-INTRVW(NOWFRM)+K
INTRVW(NOWFRM)=K
IF(K.EQ.0)GO TO 228
WRITE(ITTY,229)
WRITE(ITTY,226)
226 FORMAT(' Dates and starting and ending times will ',
1'have to be redefined')
I=KFIRST(NOWFRM)
DO 227 J=1,K
JDATE(I)=0
I=I+1
227 CONTINUE
GO TO 233
228 WRITE(ITTY,229)
229 FORMAT(' Length changed')
GO TO 233
230 WRITE(ITTY,231)
231 FORMAT(' Length not changed')
GO TO 233
232 LENGTH(NOWFRM)=IVALUE
GO TO 233
233 CONTINUE
C
C GET NUMBER OF INTERVIEWERS
234 IF(IMOD.EQ.0)GO TO 239
INIINT=0
IF(INTRVW(NOWFRM).EQ.0)GO TO 236
JPERSN=KFIRST(NOWFRM)
KPERSN=JPERSN+INTRVW(NOWFRM)-1
DO 235 IPERSN=JPERSN,KPERSN
IF(JDATE(IPERSN).GE.0)INIINT=INIINT+1
235 CONTINUE
236 WRITE(ITTY,237)INIINT
237 FORMAT(' How many schedules:',1I4)
WRITE(ITTY,238)
238 FORMAT(' Change to? ',$)
GO TO 241
239 INIINT=0
WRITE(ITTY,240)
240 FORMAT(' How many schedules? ',$)
241 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 246
IF(MAXBFR.GT.0)GO TO 247
242 IF(IMOD.NE.0)GO TO 263
WRITE(ITTY,243)
243 FORMAT(' Number of schedules must be specified')
GO TO 234
244 WRITE(ITTY,245)
245 FORMAT(' Type ? for help')
GO TO 234
246 CALL ADMHLP(ITTY,8,IMOD)
GO TO 234
247 LOWBFR=1
CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(242,244,248),KIND
248 IF(IVALUE.LT.0)GO TO 244
IF(IVALUE.EQ.0)GO TO 253
IF(IVALUE.EQ.INIINT)GO TO 263
IF(IVALUE.GT.INIINT)GO TO 251
249 IF(INIINT.LE.IVALUE)GO TO 261
INIINT=INIINT-1
250 INTRVW(NOWFRM)=INTRVW(NOWFRM)-1
I=JDATE(KNTRCT)
KNTRCT=KNTRCT-1
IF(I.LT.0)GO TO 250
GO TO 249
251 IF((KNTRCT+IVALUE-INIINT).GT.LMTRCT)GO TO 259
252 IF(INIINT.GE.IVALUE)GO TO 261
INTRVW(NOWFRM)=INTRVW(NOWFRM)+1
INIINT=INIINT+1
KNTRCT=KNTRCT+1
JDATE(KNTRCT)=0
GO TO 252
253 IF(JMOD.EQ.0)GO TO 254
IF(INIINT.EQ.0)GO TO 265
254 IF(JMOD.EQ.0)WRITE(ITTY,255)
255 FORMAT(' Do you really want to cancel this firm? ',$)
IF(JMOD.NE.0)WRITE(ITTY,256)
256 FORMAT(' Do you really want to cancel all intervie',
1'ws for this firm? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(254,254,258,234,257),KNDYES
257 IF(JMOD.EQ.0)CALL ADMHLP(ITTY,19,IMOD)
IF(JMOD.NE.0)CALL ADMHLP(ITTY,20,IMOD)
GO TO 254
258 KNTRCT=KNTRCT-INTRVW(NOWFRM)
INTRVW(NOWFRM)=0
KNTOPN(NOWFRM)=0
GO TO 265
259 WRITE(ITTY,260)
260 FORMAT(' Total number of schedules for all firms exceeded')
GO TO 234
261 IF(IMOD.NE.0)WRITE(ITTY,262)
262 FORMAT(' Number of schedules changed')
GO TO 265
263 IF(IMOD.NE.0)WRITE(ITTY,264)
264 FORMAT(' Number of schedules not changed')
GO TO 265
C
C REDISPLAY THE FIRM INFORMATION
265 GO TO 153
266 IF(INTRVW(NOWFRM).LE.0)GO TO 451
C
C *********************************************
C * *
C * OBTAIN INFORMATION ABOUT EACH RECRUITER *
C * *
C *********************************************
C
C DETERMINE WHETHER THERE ARE ENTRIES TO BE FILLED IN
C KMOD = -1, DON'T YET KNOW IF THERE ARE GAPS IN SCHEDULES
C = 0, FILLING IN GAPS IN SCHEDULES
C = 1, MODIFYING OLD SCHEDULES
KMOD=-1
NOWINT=0
IFIRST=KFIRST(NOWFRM)
267 IF(IFIRST.GT.KNTRCT)GO TO 268
IF(JDATE(IFIRST).GE.0)NOWINT=NOWINT+1
IF(JDATE(IFIRST).EQ.0)GO TO 286
IFIRST=IFIRST+1
GO TO 267
C
C ASK FOR NEXT SCHEDULE TO BE MODIFIED
268 IF(KMOD.EQ.0)GO TO 444
KMOD=1
269 WRITE(ITTY,270)
270 FORMAT(' Modify which schedule (RETURN if done)? ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 273
IF(MAXBFR.EQ.0)GO TO 444
LOWBFR=1
CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(444,271,274),KIND
271 WRITE(ITTY,272)
272 FORMAT(' Type ? for help')
GO TO 269
273 CALL ADMHLP(ITTY,13,IMOD)
GO TO 269
C
C LOCATE SCHEDULE REQUESTED BY ADMINISTRATOR
274 NOWINT=0
IFIRST=KFIRST(NOWFRM)
275 IF(IFIRST.GT.KNTRCT)GO TO 277
IF(JDATE(IFIRST).LT.0)GO TO 276
NOWINT=NOWINT+1
IF(NOWINT.EQ.IVALUE)GO TO 279
276 IFIRST=IFIRST+1
GO TO 275
277 WRITE(ITTY,278)
278 FORMAT(' Not a schedule number')
GO TO 269
279 IFINAL=IFIRST
280 IF(IFINAL.GE.KNTRCT)GO TO 281
IF(JDATE(IFINAL+1).GE.0)GO TO 281
IFINAL=IFINAL+1
GO TO 280
C
C DISPLAY THE SCHEDULE AND ASK IF TO BE MODIFIED
281 GO TO 485
282 WRITE(ITTY,283)
283 FORMAT(' Is the above information correct? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(282,282,285,288,284),KNDYES
284 CALL ADMHLP(ITTY,15,IMOD)
GO TO 282
285 IF(KMOD.NE.0)GO TO 269
IFIRST=IFINAL+1
GO TO 267
C
C PREPARE TO DEFINE NEW SCHEDULE
286 WRITE(ITTY,287)NOWINT
287 FORMAT(' Schedule',1I4)
IMOD=0
KMOD=0
NDATE=0
IFINAL=IFIRST
GO TO 289
C
C PREPARE TO MODIFY SCHEDULE
288 NDATE=JDATE(IFIRST)
NSCHDL=JSCHDL(IFIRST)
NFIRST=JFIRST(IFIRST)
NFINAL=JFINAL(IFINAL)
IMOD=1
GO TO 289
289 CONTINUE
C
C GET PROFILE OF SCHEDULE IF THERE IS MORE THAN 1
I=0
MAXSCH=0
290 IF(I.GE.MAXSLT)GO TO 291
I=I+1
IF(LNGSLT(I).NE.LENGTH(NOWFRM))GO TO 290
MAXSCH=MAXSCH+1
IF(MAXSCH.GT.1)GO TO 290
IF(JDATE(IFIRST).NE.0)GO TO 290
NSCHDL=NUMSLT(I)
GO TO 290
291 IF(JDATE(IFIRST).NE.0)GO TO 292
IF(IFIRST.EQ.KFIRST(NOWFRM))GO TO 292
NSCHDL=JSCHDL(IFIRST-1)
292 IF(MAXSCH.LE.1)GO TO 315
IF(JDATE(IFIRST).EQ.0)GO TO 295
WRITE(ITTY,293)LENGTH(NOWFRM),NSCHDL
293 FORMAT(1X,1I3,' minute profile:',1I4)
WRITE(ITTY,294)
294 FORMAT(' Change to? ',$)
GO TO 297
295 WRITE(ITTY,296)LENGTH(NOWFRM),NSCHDL
296 FORMAT(1X,1I3,' minute profile (merely return if',1I4,')? ',$)
297 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 306
IF(MAXBFR.EQ.0)GO TO 298
LOWBFR=1
CALL DAHEFT(0,0,0,LTRBFR,LMTBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
GO TO(298,299,301),KIND
298 IF(JDATE(IFIRST).EQ.0)GO TO 315
GO TO 313
299 WRITE(ITTY,300)
300 FORMAT(' Type ? for help')
GO TO 292
301 DO 304 I=1,MAXSLT
IF(LNGSLT(I).NE.LENGTH(NOWFRM))GO TO 304
IF(IVALUE.NE.NUMSLT(I))GO TO 304
IF(JDATE(IFIRST).EQ.0)GO TO 303
IF(NSCHDL.EQ.IVALUE)GO TO 313
WRITE(ITTY,302)
302 FORMAT(' Profile changed.'/
1' Starting and ending times will have to be respecified.')
JDATE(IFIRST)=0
IMOD=0
303 NSCHDL=IVALUE
GO TO 315
304 CONTINUE
WRITE(ITTY,305)
305 FORMAT(' This is not a profile number')
GO TO 292
306 CALL ADMHLP(ITTY,18,IMOD)
L3045=0
DO 312 NOWSLT=1,MAXSLT
K3045=L3045+1
L3045=L3045+KNTSLT(NOWSLT)
IF(LNGSLT(NOWSLT).NE.LENGTH(NOWFRM))GO TO 312
WRITE(ITTY,307)NUMSLT(NOWSLT),LENGTH(NOWFRM)
307 FORMAT(' Profile',1I4,' for',1I4,' minute interviews')
LOWBFR=0
DO 310 I3045=K3045,L3045
ITIME=INI060(I3045)
ITIME=40*(ITIME/60) + ITIME
308 CALL DAHOUR(ITIME,0,0,0,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
IF(IERROR.NE.1)GO TO 309
WRITE(ITTY,376)(LTRBFR(J),J=1,LOWBFR)
LOWBFR=0
GO TO 308
309 IF(LOWBFR.GE.LMTBFR)GO TO 310
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRSPA
310 CONTINUE
IF(LOWBFR.GT.0)WRITE(ITTY,376)(LTRBFR(J),J=1,LOWBFR)
WRITE(ITTY,311)
311 FORMAT(1X)
312 CONTINUE
GO TO 292
313 WRITE(ITTY,314)
314 FORMAT(' Profile not changed')
GO TO 315
315 L3045=0
I=0
316 I=I+1
K3045=L3045+1
L3045=L3045+KNTSLT(I)
IF(LNGSLT(I).NE.LENGTH(NOWFRM))GO TO 316
IF(NUMSLT(I).NE.NSCHDL)GO TO 316
C
C GET DATE OF THIS PARTICULAR INTERVIEW SCHEDULE
317 IF(NDATE.NE.0)GO TO 319
I=IFIRST
318 I=I-1
IF(I.LT.KFIRST(NOWFRM))GO TO 325
IF(JDATE(I).LE.0)GO TO 318
NDATE=JDATE(I)
319 LOWBFR=0
CALL DAWHEN(NDATE,JDAY,JMONTH,JYEAR,LTRBFR,LOWBFR,LMTBFR)
IF(JDATE(IFIRST).EQ.0)GO TO 320
GO TO 322
320 WRITE(ITTY,321)(LTRBFR(I),I=1,9)
321 FORMAT(' Date of interviews (merely RETURN if ',9A1,')? ',$)
GO TO 327
322 WRITE(ITTY,323)(LTRBFR(I),I=1,9)
323 FORMAT(
1' Date of interviews: ',9A1)
WRITE(ITTY,324)
324 FORMAT(' Change to? ',$)
GO TO 327
325 WRITE(ITTY,326)
326 FORMAT(' Date of interviews? ',$)
327 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 333
IF(MAXBFR.GT.0)GO TO 329
IF(NDATE.GT.0)GO TO 337
WRITE(ITTY,328)
328 FORMAT(' Date must be specified')
GO TO 317
329 LOWBFR=1
CALL DADATE(1,LTRBFR,LMTBFR,LOWBFR,KIND ,
1 JDAY ,JMONTH,JYEAR ,LCNBFR)
IF(KIND.LT.11)GO TO 331
IF(KIND.GT.17)GO TO 331
IF(JYEAR.LE.80)JYEAR=JYEAR+2000
IF(JYEAR.LT.100)JYEAR=JYEAR+1900
CALL DAWEEK(0,IVALUE,JDAY,JMONTH,JYEAR,IWEEK)
IF(IVALUE.GT.0)GO TO 334
WRITE(ITTY,330)
330 FORMAT(' Illogical date')
GO TO 317
331 WRITE(ITTY,332)
332 FORMAT(' Date must consist of day, month and year in any',
1' conventional notation')
GO TO 317
333 CALL ADMHLP(ITTY,6,IMOD)
GO TO 317
334 IF(JDATE(IFIRST).EQ.0)GO TO 336
IF(NDATE.EQ.IVALUE)GO TO 337
WRITE(ITTY,335)
335 FORMAT(' Date changed')
336 NDATE=IVALUE
GO TO 340
337 IF(JDATE(IFIRST).EQ.0)GO TO 339
WRITE(ITTY,338)
338 FORMAT(' Date not changed')
339 GO TO 340
340 CONTINUE
C
C PREPARE TO GET TIME OF FIRST INTERVIEW
341 INIEND=-1
GO TO 342
C
C GET TIME OF INTERVIEW
342 IF(INIEND.EQ.0)GO TO 347
IF(INIEND.GT.0)GO TO 352
C
C GET TIME OF FIRST INTERVIEW
IF(JDATE(IFIRST).EQ.0)GO TO 345
IF(NFIRST.LT.0)GO TO 345
LOWBFR=0
ITIME=INI060(NFIRST)
ITIME=40*(ITIME/60) + ITIME
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
WRITE(ITTY,343)(LTRBFR(I),I=1,LOWBFR)
343 FORMAT(' First interview starts: ',80A1)
WRITE(ITTY,344)
344 FORMAT(' Change to? ',$)
GO TO 356
345 NFIRST=K3045
ITIME=INI060(NFIRST)
ITIME=40*(ITIME/60) + ITIME
LOWBFR=0
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
WRITE(ITTY,346)(LTRBFR(I),I=1,7)
346 FORMAT(
1' First interview starts when (merely RETURN if ',7A1,')? ',
2$)
GO TO 356
C
C GET TIME OF FINAL INTERVIEW
347 IF(JDATE(IFIRST).EQ.0)GO TO 350
IF(NFINAL.LT.0)GO TO 350
LOWBFR=0
ITIME=INI060(NFINAL)
ITIME=40*(ITIME/60) + ITIME
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
WRITE(ITTY,348)(LTRBFR(I),I=1,LOWBFR)
348 FORMAT(' Final interview starts: ',80A1)
WRITE(ITTY,349)
349 FORMAT(' Change to? ',$)
GO TO 356
350 NFINAL=L3045
ITIME=INI060(NFINAL)
ITIME=40*(ITIME/60) + ITIME
LOWBFR=0
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
WRITE(ITTY,351)(LTRBFR(I),I=1,LOWBFR)
351 FORMAT(
1' Final interview starts when (merely RETURN if ',7A1,')? ',
2$)
GO TO 356
C
C GET TIME OF SKIPPED INTERVIEW
352 IF(MAXSCH.EQ.0)GO TO 354
WRITE(ITTY,353)
353 FORMAT(' Skip which additional interview (merely R',
1'ETURN if no change)? ',$)
GO TO 356
354 WRITE(ITTY,355)
355 FORMAT(
1' Skip which interview (merely RETURN if all held)? ',$)
GO TO 356
C
C GET TIME AND EVALUATE IT
356 CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.LT.0)GO TO 370
IF(MAXBFR.EQ.0)GO TO 380
LOWBFR=1
357 CALL DADATE(2,LTRBFR,LMTBFR,LOWBFR,KIND ,
1 IHOUR ,IMINUT,IAMPM ,LCNBFR)
IF(KIND.EQ.3)GO TO 358
IF(KIND.LT.18)GO TO 368
IF(KIND.GT.21)GO TO 368
IF(IHOUR.LT.0)GO TO 368
358 IF(IMINUT.LT.0)IMINUT=0
C ADUST TIMES SUCH AS 12AM AND 12PM
IF(IHOUR.NE.12)GO TO 361
IF(IAMPM.EQ.3)GO TO 360
IF(IAMPM.EQ.2)GO TO 359
IF(IAMPM.EQ.1)IHOUR=0
GO TO 362
359 IF(IMINUT.EQ.0)IHOUR=24
GO TO 362
360 IF(IMINUT.NE.0)GO TO 368
GO TO 362
361 IF(IAMPM.EQ.2)IHOUR=IHOUR+12
IF(IAMPM.EQ.3)GO TO 368
362 IF(IHOUR.GT.24)GO TO 368
ITIME=(60*IHOUR)+IMINUT
C
C CHECK FOR EXACT MATCH OF TIME
363 DO 364 I3045=K3045,L3045
IF(ITIME.NE.INI060(I3045))GO TO 364
ITIME=I3045
GO TO 386
364 CONTINUE
C
C IF NO MATCH IN MORNING, CHECK FOR MATCH IN AFTERNOON
IF(ITIME.GT.(12*60))GO TO 366
IF(KIND.EQ.3)GO TO 365
IF(KIND.EQ.18)GO TO 365
GO TO 366
365 ITIME=ITIME+12*60
GO TO 363
366 WRITE(ITTY,367)
367 FORMAT(' No interview starts at this time.')
GO TO 342
368 WRITE(ITTY,369)
369 FORMAT(' Type ? for help')
GO TO 342
C
C HELP MESSAGES INCLUDING LIST OF TIMES
370 IF(INIEND.EQ.0)GO TO 371
IF(INIEND.GT.0)GO TO 372
CALL ADMHLP(ITTY,9,IMOD)
GO TO 373
371 CALL ADMHLP(ITTY,10,IMOD)
GO TO 373
372 CALL ADMHLP(ITTY,17,IMOD)
C
C WRITE LIST OF POSSIBLE INTERVIEWS
373 LOWBFR=0
DO 378 I3045=K3045,L3045
IF(INIEND.LT.0)GO TO 374
IF(I3045.LT.NFIRST)GO TO 378
IF(INIEND.LE.0)GO TO 374
IF(I3045.GT.NFINAL)GO TO 378
374 ITIME=INI060(I3045)
ITIME=40*(ITIME/60) + ITIME
375 CALL DAHOUR(ITIME,0,0,0,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
IF(IERROR.NE.1)GO TO 377
WRITE(ITTY,376)(LTRBFR(J),J=1,LOWBFR)
376 FORMAT(1X,80A1)
LOWBFR=0
GO TO 375
377 IF(LOWBFR.GE.LMTBFR)GO TO 378
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRSPA
378 CONTINUE
IF(LOWBFR.GT.0)WRITE(ITTY,376)(LTRBFR(J),J=1,LOWBFR)
IF(INIEND.LE.0)GO TO 342
IF(MAXSCH.EQ.0)GO TO 342
WRITE(ITTY,379)
379 FORMAT(1X/
1' You have indicated following interviews will be skipped'/1X)
GO TO 402
C
C NO TIME STATED
380 IF(INIEND.EQ.0)GO TO 383
IF(INIEND.GT.0)GO TO 420
IF(JDATE(IFIRST).EQ.0)GO TO 382
WRITE(ITTY,381)
381 FORMAT(' Time not changed')
382 GO TO 390
383 IF(NFIRST.GT.NFINAL)GO TO 439
IF(JDATE(IFIRST).EQ.0)GO TO 385
WRITE(ITTY,384)
384 FORMAT(' Time not changed')
385 GO TO 395
C
C TIME TYPED
386 IF(INIEND.EQ.0)GO TO 391
IF(INIEND.GT.0)GO TO 407
C
C TIME OF FIRST INTERVIEW
IF(JDATE(IFIRST).EQ.0)GO TO 389
IF(NFIRST.EQ.ITIME)WRITE(ITTY,387)
387 FORMAT(' Time not changed')
IF(NFIRST.NE.ITIME)WRITE(ITTY,388)
388 FORMAT(' Time changed')
389 NFIRST=ITIME
390 INIEND=0
GO TO 342
C
C TIME OF FINAL INTERVIEW
391 IF(ITIME.LT.NFIRST)GO TO 439
IF(JDATE(IFIRST).EQ.0)GO TO 394
IF(NFINAL.EQ.ITIME)WRITE(ITTY,392)
392 FORMAT(' Time not changed')
IF(NFINAL.NE.ITIME)WRITE(ITTY,393)
393 FORMAT(' Time changed')
394 NFINAL=ITIME
395 INIEND=1
C
C OBTAIN ORIGINAL LIST OF SKIPPED INTERVIEWS
MAXSCH=0
IF(JDATE(IFIRST).EQ.0)GO TO 398
IF(JFIRST(IFIRST).LT.0)GO TO 398
MPERSN=IFIRST
396 IF(MPERSN.GE.IFINAL)GO TO 398
I=JFINAL(MPERSN)
MPERSN=MPERSN+1
J=JFIRST(MPERSN)
397 I=I+1
IF(I.GE.J)GO TO 396
MAXSCH=MAXSCH+1
INISCH(MAXSCH)=I
GO TO 397
398 CONTINUE
C
C REJECT TIMES ON ORIGINAL LIST OUTSIDE CURRENT RANGE
IF(MAXSCH.EQ.0)GO TO 400
J=MAXSCH
MAXSCH=0
DO 399 I=1,J
IF(INISCH(I).LT.NFIRST)GO TO 399
IF(INISCH(I).GT.NFINAL)GO TO 399
MAXSCH=MAXSCH+1
INISCH(MAXSCH)=INISCH(I)
399 CONTINUE
400 CONTINUE
C
C WRITE LIST OF SKIPPED INTERVIEWS
IF(MAXSCH.LE.0)GO TO 406
WRITE(ITTY,401)
401 FORMAT(
1' Following interviews will be skipped')
402 LOWBFR=0
DO 405 NOWSCH=1,MAXSCH
ITIME=INISCH(NOWSCH)
ITIME=INI060(ITIME)
ITIME=40*(ITIME/60) + ITIME
403 CALL DAHOUR(ITIME,0,0,0,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
IF(IERROR.NE.1)GO TO 404
WRITE(ITTY,376)(LTRBFR(J),J=1,LOWBFR)
LOWBFR=0
GO TO 403
404 IF(LOWBFR.GE.LMTBFR)GO TO 405
LOWBFR=LOWBFR+1
LTRBFR(LOWBFR)=LTRSPA
405 CONTINUE
IF(LOWBFR.GT.0)WRITE(ITTY,376)(LTRBFR(J),J=1,LOWBFR)
406 GO TO 342
C
C STORE TIME OF SKIPPED INTERVIEW
407 IF(ITIME.LT.NFIRST)GO TO 413
IF(ITIME.GT.NFINAL)GO TO 413
NOWSCH=0
408 NOWSCH=NOWSCH+1
IF(NOWSCH.GT.MAXSCH)GO TO 409
IF(ITIME.GT.INISCH(NOWSCH))GO TO 408
IF(ITIME.EQ.INISCH(NOWSCH))GO TO 415
409 MAXSCH=MAXSCH+1
I=MAXSCH
410 IF(I.LE.NOWSCH)GO TO 411
INISCH(I)=INISCH(I-1)
I=I-1
GO TO 410
411 INISCH(NOWSCH)=ITIME
WRITE(ITTY,412)
412 FORMAT(' Interview will not be held')
GO TO 419
413 WRITE(ITTY,414)
414 FORMAT(' This interview is outside range already specified')
GO TO 419
415 WRITE(ITTY,416)
416 FORMAT(' This interview was previously specified as skipped.'/
1' Interview will be held instead.')
MAXSCH=MAXSCH-1
417 IF(NOWSCH.GT.MAXSCH)GO TO 419
INISCH(NOWSCH)=INISCH(NOWSCH+1)
NOWSCH=NOWSCH+1
GO TO 417
C
C AFTER GETTING GOOD TIME, CHECK IF ANYTHING ELSE TYPED
418 LOWBFR=LOWBFR+1
419 IF(LOWBFR.GT.MAXBFR)GO TO 342
IF(LTRBFR(LOWBFR).EQ.LTRSPA)GO TO 418
IF(LTRBFR(LOWBFR).EQ.LTRCOM)GO TO 418
IF(LTRBFR(LOWBFR).EQ.LTRQUE)GO TO 370
GO TO 357
C
C ************************************************
C * *
C * MERGE SKIPPED TIMES INTO INTERVIEW STORAGE *
C * *
C ************************************************
C
C CHECK IF START OR END TIMES ARE BEING SKIPPED
420 IF(MAXSCH.EQ.0)GO TO 436
IF(INISCH(1).GT.NFIRST)GO TO 423
MAXSCH=MAXSCH-1
IF(MAXSCH.LE.0)GO TO 422
DO 421 I=1,MAXSCH
INISCH(I)=INISCH(I+1)
421 CONTINUE
422 CONTINUE
NFIRST=NFIRST+1
IF(NFIRST.GT.NFINAL)GO TO 439
GO TO 420
423 IF(INISCH(MAXSCH).LT.NFINAL)GO TO 424
MAXSCH=MAXSCH-1
NFINAL=NFINAL-1
IF(NFIRST.GT.NFINAL)GO TO 439
GO TO 420
C
C DETERMINE NUMBER OF LOCATIONS NEEDED FOR SCHEDULE
424 NEEDED=2
IF(MAXSCH.EQ.1)GO TO 426
DO 425 I=2,MAXSCH
IF(INISCH(I-1).NE.(INISCH(I)-1))NEEDED=NEEDED+1
425 CONTINUE
426 CONTINUE
C
C CHECK IF NEED TO EXPAND OR CONTRACT ENTRY
IF(NEEDED.EQ.(IFINAL-IFIRST+1))GO TO 432
IF(NEEDED.GT.(IFINAL-IFIRST+1))GO TO 428
C
C NEW ENTRY IS SMALLER THAN BEFORE
KNTRCT=KNTRCT+NEEDED-IFINAL+IFIRST-1
INTRVW(NOWFRM)=INTRVW(NOWFRM)+NEEDED-IFINAL+IFIRST-1
I=IFINAL
J=IFIRST+NEEDED-1
IFINAL=J
427 IF(J.GE.KNTRCT)GO TO 432
I=I+1
J=J+1
JDATE(J)=JDATE(I)
JFIRST(J)=JFIRST(I)
JFINAL(J)=JFINAL(I)
JSCHDL(J)=JSCHDL(I)
GO TO 427
C
C NEW ENTRY IS LARGER THAN BEFORE
428 IF((KNTRCT+NEEDED-IFINAL+IFIRST-1).GT.LMTRCT)GO TO 430
I=KNTRCT
KNTRCT=KNTRCT+NEEDED-IFINAL+IFIRST-1
INTRVW(NOWFRM)=INTRVW(NOWFRM)+NEEDED-IFINAL+IFIRST-1
J=KNTRCT
IFINAL=IFIRST+NEEDED-1
429 IF(J.LE.IFINAL)GO TO 432
JDATE(J)=JDATE(I)
JFIRST(J)=JFIRST(I)
JFINAL(J)=JFINAL(I)
JSCHDL(J)=JSCHDL(I)
I=I-1
J=J-1
GO TO 429
C
C ERROR
430 WRITE(ITTY,431)
431 FORMAT(' Insufficient room to store schedules')
GO TO 341
C
C STORE SCHEDULE CONTAINING SKIPPED INTERVIEWS
432 I=NFIRST
K=1
IFINAL=IFIRST
433 J=INISCH(K)
JDATE(IFINAL)=NDATE
JFIRST(IFINAL)=I
JFINAL(IFINAL)=J-1
JSCHDL(IFINAL)=NSCHDL
NDATE=-1
IFINAL=IFINAL+1
I=J
434 IF(K.GE.MAXSCH)GO TO 435
I=I+1
K=K+1
IF(INISCH(K).EQ.I)GO TO 434
GO TO 433
435 JDATE(IFINAL)=NDATE
JFIRST(IFINAL)=I+1
JFINAL(IFINAL)=NFINAL
JSCHDL(IFINAL)=NSCHDL
GO TO 443
C
C NEW ENTRY HAS NO SKIPPED INTERVIEWS
436 IF(IFINAL.EQ.IFIRST)GO TO 438
KNTRCT=KNTRCT-IFINAL+IFIRST
INTRVW(NOWFRM)=INTRVW(NOWFRM)-IFINAL+IFIRST
I=IFINAL
N=IFIRST
437 IF(N.GE.KNTRCT)GO TO 438
I=I+1
N=N+1
JDATE(N)=JDATE(I)
JFIRST(N)=JFIRST(I)
JFINAL(N)=JFINAL(I)
JSCHDL(N)=JSCHDL(I)
GO TO 437
438 JDATE(IFIRST)=NDATE
JFIRST(IFIRST)=NFIRST
JFINAL(IFIRST)=NFINAL
JSCHDL(IFIRST)=NSCHDL
IFINAL=IFIRST
GO TO 443
C
C SCHEDULE DOES NOT CONTAIN ANY INTERVIEWS
439 WRITE(ITTY,440)
440 FORMAT(' Cancelling all interviews in this schedule.'/
1' Schedule will remain in list, but will be empty.')
KNTRCT=KNTRCT-IFINAL+IFIRST
INTRVW(NOWFRM)=INTRVW(NOWFRM)-IFINAL+IFIRST
I=IFINAL
N=IFIRST
441 IF(N.GE.KNTRCT)GO TO 442
I=I+1
N=N+1
JDATE(N)=JDATE(I)
JFIRST(N)=JFIRST(I)
JFINAL(N)=JFINAL(I)
JSCHDL(N)=JSCHDL(I)
GO TO 441
442 JDATE(IFIRST)=NDATE
JFIRST(IFIRST)=-1
JFINAL(IFIRST)=-1
JSCHDL(IFIRST)=NSCHDL
IFINAL=IFIRST
GO TO 443
C
C ASK USER IF THE ENTRY IS NOW CORRECT
443 GO TO 281
C
C COMPUTE NUMBER OF OPEN INTERVIEWS
444 KNTOPN(NOWFRM)=0
LIMIT=INTRVW(NOWFRM)
IF(LIMIT.LE.0)GO TO 447
JPERSN=KFIRST(NOWFRM)
DO 446 IFINAL=1,LIMIT
IF(JFIRST(JPERSN).LT.0)GO TO 445
KNTOPN(NOWFRM)=KNTOPN(NOWFRM)+JFINAL(JPERSN)-JFIRST(JPERSN)+1
445 JPERSN=JPERSN+1
446 CONTINUE
447 CONTINUE
C
C DISPLAY ENTIRE SCHEDULE TO USER
GO TO 483
C
C ASK IF THIS INFORMATION IS CORRECT
448 WRITE(ITTY,449)
449 FORMAT(
1' Is the above information correct? ',$)
CALL YESNO(1,KNDYES,ITTY)
GO TO(448,448,129,153,450),KNDYES
450 CALL ADMHLP(ITTY,15,IMOD)
GO TO 448
C
C CANCEL THE FIRM
451 IF(JMOD.NE.0)GO TO 453
WRITE(ITTY,452)
452 FORMAT(' Cancelling entry of new firm')
KNTINC=KNTINC-1
MAXNUM=MAXNUM-1
453 GO TO 129
C
C TOO MANY FIRMS TO ENTER ANOTHER FIRM
454 WRITE(ITTY,455)LMTFRM
455 FORMAT(' Maximum allowed number of',1I4,
1' firms already specified')
GO TO 129
C
C ***************************
C * *
C * CONCISE LIST OF FIRMS *
C * *
C ***************************
C
C SET MAXBFR SINCE USER CAN TYPE SOMETHING AT BOTTOM OF PAGE
456 MAXBFR=0
IF(KNTINC.LE.0)GO TO 479
KNTLIN=0
DO 478 KOMPNY=1,KNTINC
C
C GET LENGTHS OF NAME, DIVISION AND ADDRESS
LNGINC=LMTINC
457 IF(LTRINC(LNGINC,KOMPNY).NE.LTRSPA)GO TO 458
LNGINC=LNGINC-1
IF(LNGINC.GT.0)GO TO 457
458 LNGDPT=LMTDPT
459 IF(LTRDPT(LNGDPT,KOMPNY).NE.LTRSPA)GO TO 460
LNGDPT=LNGDPT-1
IF(LNGDPT.GT.0)GO TO 459
460 LNGADR=LMTADR
461 IF(LTRADR(LNGADR,KOMPNY).NE.LTRSPA)GO TO 462
LNGADR=LNGADR-1
IF(LNGADR.GT.0)GO TO 461
462 CONTINUE
IF(LNGINC.EQ.0)LNGINC=1
LNGLIN=LNGINC
IF(LNGDPT.GT.0)LNGLIN=LNGLIN+LNGDPT+2
IF(LNGADR.GT.0)LNGLIN=LNGLIN+LNGADR+2
C
C CHECK IF SCREEN IS FULL
KNTLIN=KNTLIN+3
IF(LNGLIN.GT.80)KNTLIN=KNTLIN+1
IF(KNTLIN.LE.LNGCRT)GO TO 464
KNTLIN=3
IF(LNGLIN.GT.80)KNTLIN=KNTLIN+1
WRITE(ITTY,463)
463 FORMAT(1X/' (Press RETURN to continue) ',$)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
IF(MAXBFR.NE.0)GO TO 481
C
C CONSTRUCT DATE IN FORM DD-MMM-YY
464 LOWBFR=0
IF(INTRVW(KOMPNY).LE.0)GO TO 469
IPERSN=KFIRST(KOMPNY)
JPERSN=IPERSN+INTRVW(KOMPNY)-1
ISMITH=0
DO 466 KPERSN=IPERSN,JPERSN
IF(JDATE(KPERSN).LT.0)GO TO 466
IF(JFIRST(KPERSN).LT.0)GO TO 466
IF(ISMITH.NE.0)GO TO 465
ISMITH=JDATE(KPERSN)
JSMITH=ISMITH
GO TO 466
465 IF(ISMITH.GT.JDATE(KPERSN))ISMITH=JDATE(KPERSN)
IF(JSMITH.LT.JDATE(KPERSN))JSMITH=JDATE(KPERSN)
466 CONTINUE
CALL DAWHEN(ISMITH,JDAY,JMONTH,JYEAR,LTRBFR,LOWBFR,LMTBFR)
CALL DAWHEN(JSMITH,JDAY,JMONTH,JYEAR,LTRBFR,LOWBFR,LMTBFR)
C
C WRITE STATUS LINE
IF(ISMITH.EQ.JSMITH)WRITE(ITTY,467)NUMBER(KOMPNY),
1KNTOPN(KOMPNY),(LTRBFR(I),I=1,9)
467 FORMAT(' Code:',1I4,', Open slots:',1I4,', Date: ',9A1)
IF(ISMITH.NE.JSMITH)WRITE(ITTY,468)NUMBER(KOMPNY),
1KNTOPN(KOMPNY),(LTRBFR(I),I=1,18)
468 FORMAT(' Code:',1I4,', Open slots:',1I4,
1', Date: ',9A1,' to ',9A1)
GO TO 471
469 WRITE(ITTY,470)NUMBER(KOMPNY)
470 FORMAT(' Code:',1I4,', Cancelled')
GO TO 471
C
C TYPE SECOND LINE WITH NAME, DIVISION, ADDRESS
471 IF(LNGADR.GT.0)GO TO 473
IF(LNGDPT.GT.0)GO TO 472
WRITE(ITTY,475)(LTRINC(I,KOMPNY),I=1,LNGINC)
GO TO 476
472 WRITE(ITTY,475)(LTRINC(I,KOMPNY),I=1,LNGINC),
1LTRCOM,LTRSPA,(LTRDPT(I,KOMPNY),I=1,LNGDPT)
GO TO 476
473 IF(LNGDPT.GT.0)GO TO 474
WRITE(ITTY,475)(LTRINC(I,KOMPNY),I=1,LNGINC),
1LTRCOM,LTRSPA,(LTRADR(I,KOMPNY),I=1,LNGADR)
GO TO 476
474 WRITE(ITTY,475)(LTRINC(I,KOMPNY),I=1,LNGINC),
1LTRCOM,LTRSPA,(LTRDPT(I,KOMPNY),I=1,LNGDPT),
2LTRCOM,LTRSPA,(LTRADR(I,KOMPNY),I=1,LNGADR)
475 FORMAT(1X,80A1)
476 WRITE(ITTY,477)
477 FORMAT(1X)
478 CONTINUE
GO TO 481
479 WRITE(ITTY,480)
480 FORMAT(' No firms have scheduled interviews')
GO TO 481
C
C ALL FIRMS LISTED
481 CONTINUE
GO TO 131
C
C ***************************************
C * *
C * DETAILED LIST OF ONE OR ALL FIRMS *
C * *
C ***************************************
C
C SHOW COMMAND
C SHOW EVERYTHING FOR SINGLE FIRM
482 IRETRN=1
ININUM=NOWFRM
LSTNUM=NOWFRM
KNTLIN=0
GO TO 491
C
C MODIFY COMMAND
C SHOW EVERYTHING FOR SINGLE FIRM
483 IRETRN=4
ININUM=NOWFRM
LSTNUM=NOWFRM
KNTLIN=0
GO TO 491
C
C MODIFY COMMAND
C DISPLAY SINGLE FIRM NAME, LENGTH, NUMBER OF RECRUITERS
484 IRETRN=5
ININUM=NOWFRM
LSTNUM=NOWFRM
KNTLIN=0
GO TO 491
C
C MODIFY COMMAND
C DISPLAY SINGLE SCHEDULE
485 IRETRN=3
ININUM=NOWFRM
LSTNUM=NOWFRM
KOMPNY=ININUM
MPERSN=IFIRST
LPERSN=IFINAL
JPERSN=LPERSN
KPERSN=NOWINT
KNTLIN=0
GO TO 501
C
C ENTRY IF WRITE ALL FIRMS TO FILE
486 IRETRN=2
KNTLIN=0
ININUM=1
LSTNUM=KNTINC
IF(KNTINC.EQ.0)GO TO 531
CALL RSMOPN(8,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 487
GO TO 489
487 WRITE(ITTY,488)
488 FORMAT(' Cannot write output file')
GO TO 129
C
C TYPE OF BIDDING AND NUMBER OF INTERVIEWS ALLOWED
489 CALL TSTAMP(LTRTIM)
WRITE(IDISK,490)ICLASS,IMOVE,IPASS,LTRTIM
490 FORMAT(' Interviewer Schedules for Class',1I4,
1 ', Round',1I4,', Stage',1I4,/1X/1X,15A1/1X)
IF(MANNER.EQ. 1)WRITE(IDISK,39)
IF(MANNER.EQ. 2)WRITE(IDISK,40)
IF(MANNER.EQ.11)WRITE(IDISK,41)
IF(MANNER.EQ.12)WRITE(IDISK,42)
IF(MANNER.EQ.13)WRITE(IDISK,43)
IF(MANNER.EQ.21)WRITE(IDISK,44)
IF(MANNER.EQ.22)WRITE(IDISK,45)
IF(MANNER.EQ.23)WRITE(IDISK,46)
WRITE(IDISK,47)
WRITE(IDISK,63)MAXSTG
WRITE(IDISK,65)MAXRND
WRITE(IDISK,67)MAXALL
IF(MANNER.GE.21)WRITE(IDISK,69)MAXBID
IF(MANNER.EQ.11)WRITE(IDISK,71)MAXPAY
IF(MANNER.EQ.12)WRITE(IDISK,72)MAXPAY
IF(MANNER.EQ.13)WRITE(IDISK,73)MAXPAY
IF(MANNER.EQ.21)WRITE(IDISK,74)MAXPAY
IF(MANNER.EQ.22)WRITE(IDISK,75)MAXPAY
IF(MANNER.EQ.23)WRITE(IDISK,76)MAXPAY
C
C START OF COMPANY LOOP
491 KOMPNY=ININUM
492 IF(IRETRN.EQ.2)WRITE(IDISK,493)
493 FORMAT(1X)
IF(IRETRN.NE.2)WRITE(ITTY,494)NUMBER(KOMPNY),
1(LTRINC(I,KOMPNY),I=1,LMTINC),
2(LTRDPT(I,KOMPNY),I=1,LMTDPT),
3(LTRADR(I,KOMPNY),I=1,LMTADR)
IF(IRETRN.EQ.2)WRITE(IDISK,494)NUMBER(KOMPNY),
1(LTRINC(I,KOMPNY),I=1,LMTINC),
2(LTRDPT(I,KOMPNY),I=1,LMTDPT),
3(LTRADR(I,KOMPNY),I=1,LMTADR)
494 FORMAT(
1' Number:',1I6/
2' Name: ',40A1/
3' Division: ',30A1/
4' Location: ',30A1)
KNTLIN=KNTLIN+4
I=KFIRST(KOMPNY)
J=I+INTRVW(KOMPNY)
K=0
495 IF(I.GE.J)GO TO 496
IF(JDATE(I).GE.0)K=K+1
I=I+1
GO TO 495
496 CONTINUE
IF(IRETRN.NE.2)WRITE(ITTY,497)LENGTH(KOMPNY),K
IF(IRETRN.EQ.2)WRITE(IDISK,497)LENGTH(KOMPNY),K
497 FORMAT(
1' Length:',1I6,' minutes'/
2' Schedules:',1I6)
KNTLIN=KNTLIN+2
IF(IRETRN.EQ.5)GO TO 529
IF(INTRVW(KOMPNY).LE.0)GO TO 527
IF(IRETRN.NE.2)WRITE(ITTY,498)KNTOPN(KOMPNY)
IF(IRETRN.EQ.2)WRITE(IDISK,498)KNTOPN(KOMPNY)
498 FORMAT(
1' Total:',1I6,' interviews')
KNTLIN=KNTLIN+1
C
C FIND LIMITS OF SCHDEULE FOR NEXT RECRUITER
C JPERSN = UPPER END OF ALL SCHEDULES FOR THIS FIRM
C KPERSN = SCHEDULE NUMBER
C MPERSN = START OF SCHEDULE
C LPERSN = END OF SCHEDULE
C
MPERSN=KFIRST(KOMPNY)
JPERSN=MPERSN+INTRVW(KOMPNY)-1
KPERSN=0
499 LPERSN=MPERSN
KPERSN=KPERSN+1
500 IF(LPERSN.GE.JPERSN)GO TO 501
IF(JDATE(LPERSN+1).GE.0)GO TO 501
LPERSN=LPERSN+1
GO TO 500
C
C CHECK IF SCREEN IS FULL
501 KNTLIN=KNTLIN+1
IF(KNTLIN.LE.LNGCRT)GO TO 502
IF(IRETRN.EQ.2)GO TO 502
KNTLIN=1
WRITE(ITTY,463)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
502 CONTINUE
C
C CHECK IF THERE ARE DUPLICATE SCHEDULES
IDUPLI=KPERSN
IF(IRETRN.EQ.3)GO TO 507
503 IF(LPERSN.EQ.JPERSN)GO TO 507
J=LPERSN+1
K=J
504 IF(K.GE.JPERSN)GO TO 505
IF(JDATE(K+1).GE.0)GO TO 505
K=K+1
GO TO 504
505 IF((K-J).NE.(LPERSN-MPERSN))GO TO 507
L=MPERSN
DO 506 I=J,K
IF(JDATE(L).NE.JDATE(I))GO TO 507
IF(JFIRST(L).NE.JFIRST(I))GO TO 507
IF(JFINAL(L).NE.JFINAL(I))GO TO 507
IF(JSCHDL(L).NE.JSCHDL(I))GO TO 507
L=L+1
506 CONTINUE
MPERSN=J
LPERSN=K
KPERSN=KPERSN+1
GO TO 503
507 JDUPLI=KPERSN-IDUPLI+1
C
C COMPUTE NUMBER OF OPEN INTERVIEWS IN EACH SCHEDULE
KNTINT=0
IF(JFIRST(MPERSN).LT.0)GO TO 509
DO 508 INDEX=MPERSN,LPERSN
KNTINT=KNTINT+JFINAL(INDEX)-JFIRST(INDEX)+1
508 CONTINUE
509 CONTINUE
C
C CONSTRUCT TEXT DESCRIPTION OF DATES
LOWBFR=0
ISMITH=JDATE(MPERSN)
CALL DAWEEK(-1,ISMITH,JDAY,JMONTH,JYEAR,IWEEK)
JWEEK=3*IWEEK
IWEEK=JWEEK-2
CALL DAWHEN(ISMITH,JDAY,JMONTH,JYEAR,LTRBFR,LOWBFR,LMTBFR)
IF(JFIRST(MPERSN).LT.0)GO TO 517
ITIME=JFIRST(MPERSN)
ITIME=INI060(ITIME)
ITIME=40*(ITIME/60) + ITIME
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
IF(JFIRST(MPERSN).EQ.JFINAL(LPERSN))GO TO 513
ITIME=JFINAL(LPERSN)
ITIME=INI060(ITIME)
ITIME=40*(ITIME/60) + ITIME
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
C
C RANGE OF TIMES
IF(IDUPLI.NE.KPERSN)GO TO 511
IF(IRETRN.NE.2)WRITE(ITTY,510)KPERSN,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,23),JSCHDL(MPERSN)
IF(IRETRN.EQ.2)WRITE(IDISK,510)KPERSN,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,23),JSCHDL(MPERSN)
510 FORMAT(' Schedule',1I4,':',1I6,' Interviews ',
1 3A1,1X,9A1,1X,7A1,' to ',7A1,' (Profile',1I4,')')
GO TO 521
511 IF(IRETRN.NE.2)WRITE(ITTY,512)IDUPLI,KPERSN,JDUPLI,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,23),JSCHDL(MPERSN)
IF(IRETRN.EQ.2)WRITE(IDISK,512)IDUPLI,KPERSN,JDUPLI,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,23),JSCHDL(MPERSN)
512 FORMAT(1X,1I5,' to',1I4,':',1I3,'*',1I2,' Interviews ',
1 3A1,1X,9A1,1X,7A1,' to ',7A1,' (Profile',1I4,')')
GO TO 521
C
C SINGLE TIME
513 IF(IDUPLI.NE.KPERSN)GO TO 515
IF(IRETRN.NE.2)WRITE(ITTY,514)KPERSN,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,16),JSCHDL(MPERSN)
IF(IRETRN.EQ.2)WRITE(IDISK,514)KPERSN,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,16),JSCHDL(MPERSN)
514 FORMAT(' Schedule',1I4,':',1I6,' Interviews ',
1 3A1,1X,9A1,1X,7A1,11X,' (Profile',1I4,')')
GO TO 521
515 IF(IRETRN.NE.2)WRITE(ITTY,516)IDUPLI,KPERSN,JDUPLI,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,16),JSCHDL(MPERSN)
IF(IRETRN.EQ.2)WRITE(IDISK,516)IDUPLI,KPERSN,JDUPLI,KNTINT,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,16),JSCHDL(MPERSN)
516 FORMAT(1X,1I5,' to',1I4,':',1I3,'*',1I2,' Interviews ',
1 3A1,1X,9A1,1X,7A1,11X,' (Profile',1I4,')')
GO TO 521
C
C NO TIMES
517 IF(IDUPLI.NE.KPERSN)GO TO 519
IF(IRETRN.NE.2)WRITE(ITTY,518)KPERSN,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,9),JSCHDL(MPERSN)
IF(IRETRN.EQ.2)WRITE(IDISK,518)KPERSN,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,9),JSCHDL(MPERSN)
518 FORMAT(' Schedule',1I4,': 0 Cancelled ',
1 3A1,1X,9A1,19X,' (Profile',1I4,')')
GO TO 521
519 IF(IRETRN.NE.2)WRITE(ITTY,520)IDUPLI,KPERSN,JDUPLI,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,9),JSCHDL(MPERSN)
IF(IRETRN.EQ.2)WRITE(IDISK,520)IDUPLI,KPERSN,JDUPLI,
1(LTRWEK(I),I=IWEEK,JWEEK),(LTRBFR(I),I=1,9),JSCHDL(MPERSN)
520 FORMAT(1X,1I5,' to',1I4,':',1I3,'* 0 Cancelled ',
1 3A1,1X,9A1,19X,' (Profile',1I4,')')
GO TO 521
C
C LOCATE SKIPPED INTERVIEWS
521 IF(MPERSN.GE.LPERSN)GO TO 526
ITIME=JFINAL(MPERSN)+1
MPERSN=MPERSN+1
JTIME=JFIRST(MPERSN)-1
IF(ITIME.GT.JTIME)GO TO 521
C
C CHECK IF SCREEN IS FULL
KNTLIN=KNTLIN+1
IF(KNTLIN.LE.LNGCRT)GO TO 522
IF(IRETRN.EQ.2)GO TO 522
KNTLIN=1
WRITE(ITTY,463)
CALL GETLIN(ITTY,LTRBFR,LMTBFR,MAXBFR)
522 CONTINUE
C
C WRITE LINE DESCRIBING SKIPPED TIMES
LOWBFR=0
ITIME=INI060(ITIME)
ITIME=40*(ITIME/60) + ITIME
CALL DAHOUR(ITIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
JTIME=INI060(JTIME)
JTIME=40*(JTIME/60) + JTIME
CALL DAHOUR(JTIME,0,0,1,LTRBFR,LMTBFR,
1LOWBFR,IERROR)
IF(ITIME.LT.JTIME)GO TO 524
IF(IRETRN.NE.2)WRITE(ITTY,523)(LTRBFR(I),I=1,7)
IF(IRETRN.EQ.2)WRITE(IDISK,523)(LTRBFR(I),I=1,7)
523 FORMAT(41X,'skip ',7A1)
GO TO 521
524 IF(IRETRN.NE.2)WRITE(ITTY,525)(LTRBFR(I),I=1,14)
IF(IRETRN.EQ.2)WRITE(IDISK,525)(LTRBFR(I),I=1,14)
525 FORMAT(41X,'skip ',7A1,' to ',7A1)
GO TO 521
C
C DONE SHOWING THIS RECRUITER SCHEDULE
526 MPERSN=LPERSN+1
IF(MPERSN.LE.JPERSN)GO TO 499
GO TO 529
C
C FIRM DOES NOT HAVE ANY SCHEDULES
527 IF(IRETRN.NE.2)WRITE(ITTY,528)
IF(IRETRN.EQ.2)WRITE(IDISK,528)
528 FORMAT(' Schedule : Cancelled')
KNTLIN=KNTLIN+1
C
C END OF REPORT LOOP
529 KOMPNY=KOMPNY+1
IF(KOMPNY.LE.LSTNUM)GO TO 492
GO TO(129,530,282,448,155),IRETRN
C
C DONE WITH LISTING FILE
530 CALL RSMCLS(8,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
GO TO 533
531 WRITE(ITTY,532)
532 FORMAT(' No schedules have been entered')
GO TO 129
C
C ****************************************
C * *
C * WRITE NEW VERSION OF SCHEDULE FILE *
C * *
C ****************************************
C
533 IVERSN=IVERSN+1
IF(IVERSN.GT.99999)IVERSN=1
C
C WRITE THE NEW VERSION OF SCHEDULE
CALL RSMOPN(7,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
IF(IFOPEN.EQ.0)GO TO 534
GO TO 536
534 WRITE(ITTY,535)
535 FORMAT(' CANNOT WRITE OUTPUT FILE')
GO TO 129
536 IAUTHR=1
WRITE(IDISK,537)IAUTHR,ICLASS,IMOVE,IPASS,IVERSN,NUMWHO
537 FORMAT(5I6,1I7)
WRITE(IDISK,538)KNTINC,MAXNUM,MANNER,MAXSTG,MAXRND,
1 MAXALL,MAXBID,MAXPAY
538 FORMAT(6I6,2I10)
IF(KNTINC.LE.0)GO TO 546
DO 545 KOMPNY=1,KNTINC
WRITE(IDISK,539)(LTRINC(I,KOMPNY),I=1,LMTINC)
539 FORMAT(40A1)
WRITE(IDISK,540)(LTRDPT(I,KOMPNY),I=1,LMTDPT)
540 FORMAT(30A1)
WRITE(IDISK,541)(LTRADR(I,KOMPNY),I=1,LMTADR)
541 FORMAT(30A1)
WRITE(IDISK,542)NUMBER(KOMPNY),LENGTH(KOMPNY),
1KNTOPN(KOMPNY),INTRVW(KOMPNY),IUSDUP(KOMPNY),
2INCLSD(KOMPNY),JNCLSD(KOMPNY)
542 FORMAT(7I6)
IF(INTRVW(KOMPNY).LE.0)GO TO 545
IPERSN=KFIRST(KOMPNY)
JPERSN=IPERSN+INTRVW(KOMPNY)-1
DO 544 KPERSN=IPERSN,JPERSN
LFIRST=JFIRST(KPERSN)
IF(LFIRST.GT.0)LFIRST=INI060(LFIRST)
LFINAL=JFINAL(KPERSN)
IF(LFINAL.GT.0)LFINAL=INI060(LFINAL)
WRITE(IDISK,543)JDATE(KPERSN),LFIRST,
1 LFINAL,JSCHDL(KPERSN)
543 FORMAT(4I6)
544 CONTINUE
545 CONTINUE
546 CALL RSMCLS(7,NUMWHO,KLASS,ITTY,IDISK,IFOPEN)
IF(KOMAND.NE.4)GO TO 584
WRITE(ITTY,547)
547 FORMAT(' Current schedules have been saved')
GO TO 129
C
C ******************
C * *
C * FATAL ERRORS *
C * *
C ******************
C
548 WRITE(ITTY,549)
549 FORMAT(' You are not authorized to run this program')
GO TO 599
550 WRITE(ITTY,551)
551 FORMAT(' Cannot read file specifying current round')
GO TO 599
552 WRITE(ITTY,553)
553 FORMAT(' Incorrect class limits in account validation file')
GO TO 599
554 WRITE(ITTY,555)
555 FORMAT(' Class not in file specifying current round')
GO TO 599
556 WRITE(ITTY,557)ICLASS
557 FORMAT(' Firm schedule file is for class',1I5)
GO TO 599
558 WRITE(ITTY,559)
559 FORMAT(' Found some other file instead of firm schedule file')
GO TO 599
560 WRITE(ITTY,561)
561 FORMAT(' BLOCK DATA routine not loaded')
GO TO 599
562 WRITE(ITTY,563)LMTRCT
563 FORMAT(' More than',1I5,' recruiter schedules given earlier')
GO TO 599
564 WRITE(ITTY,565)LMTFRM
565 FORMAT(' More than',1I5,' firms given earlier')
GO TO 599
566 WRITE(ITTY,567)
567 FORMAT(' Firm file references unknown schedule profile')
GO TO 599
568 WRITE(ITTY,569)
569 FORMAT(' Firm file contains time not in profile')
GO TO 599
570 WRITE(ITTY,571)
571 FORMAT(' No profiles of starting times have been supplied')
GO TO 599
572 WRITE(ITTY,573)
573 FORMAT(' Cannot read file specifying profiles of starting times')
GO TO 599
574 WRITE(ITTY,575)LMTSLT
575 FORMAT(' Profiles of more than',1I4,' scedules specified')
GO TO 599
576 WRITE(ITTY,577)LMTTIM
577 FORMAT(' More than',1I4,' times in profiles of all schedules')
GO TO 599
578 WRITE(ITTY,579)LMTSCH
579 FORMAT(' More than',1I4,' times in a single profile of schedules')
GO TO 599
580 WRITE(ITTY,581)
581 FORMAT(' Error in contents of schedule profile file')
GO TO 599
582 WRITE(ITTY,583)
583 FORMAT(' Requests for this class are being processed.'/
1' Please contact computer services staff if you ne',
2'ed to run this program now.')
GO TO 599
C
C ***************************
C * *
C * TYPE USAGE STATISTICS *
C * *
C ***************************
C
C COMPUTE STATISTICS
584 MAXINT=0
KNTSCH=0
KNTSKP=0
KNTTLK=0
KNTCCL=0
IF(KNTINC.EQ.0)GO TO 588
DO 587 NOWFRM=1,KNTINC
IF(INTRVW(NOWFRM).EQ.0)KNTCCL=KNTCCL+1
IF(INTRVW(NOWFRM).EQ.0)GO TO 587
J=KFIRST(NOWFRM)
K=J+INTRVW(NOWFRM)-1
L=0
M=0
KNTTLK=KNTTLK+KNTOPN(NOWFRM)
DO 586 I=J,K
IF(JDATE(I).LT.0)GO TO 585
KNTSCH=KNTSCH+1
L=L+1
M=1
GO TO 586
585 IF(M.NE.0)KNTSKP=KNTSKP+1
M=0
586 CONTINUE
IF(MAXINT.LT.L)MAXINT=L
587 CONTINUE
588 CONTINUE
C
C TYPE STATISTICS
WRITE(ITTY,589)
589 FORMAT(' Storage Summary'/1X)
WRITE(ITTY,590)KNTTLK
590 FORMAT(1X,1I5,' ', 5X,' total interviews')
WRITE(ITTY,591)KNTSCH
591 FORMAT(1X,1I5,' ', 5X,' total schedules')
WRITE(ITTY,592)KNTINC,LMTFRM
592 FORMAT(1X,1I5,' of',1I5,' maximum firms')
WRITE(ITTY,593)KNTCCL
593 FORMAT(1X,1I5,' ', 5X,' cancelled firms')
WRITE(ITTY,594)MAXINT
594 FORMAT(1X,1I5,' ', 5X,' maximum schedules for single firm')
WRITE(ITTY,595)KNTSKP
595 FORMAT(1X,1I5,' ', 5X,' schedules containing ski',
1'pped interviews')
WRITE(ITTY,596)KNTRCT,LMTRCT
596 FORMAT(1X,1I5,' of',1I5,' maximum groups of contig',
1'uous interviews')
WRITE(ITTY,597)MAXSLT,LMTSLT
597 FORMAT(1X,1I5,' of',1I5,' maximum time profiles')
WRITE(ITTY,598)MAXTIM,LMTTIM
598 FORMAT(1X,1I5,' of',1I5,' maximum times in profiles')
C
C EXIT WITHOUT FORTRAN'S USUAL TIMESTAMP
599 CALL LEAVE
STOP
END