Google
 

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