
PROC make_quick_corrective_update,  makqcu (
qcu_ident, qcu : name = $required
help, hp: key of help, hp, nohelp, np = nohelp
delivery_medium, dm: list of key tape, t, electronic, e, both, b = electronic
include_deadstart_tape, idt: boolean = FALSE
no_pause, np: boolean = FALSE
 status)


setta hp=off
crev work k=string
crev work1 k=string
crev ignore k=status
crev use_oc k=boolean v=TRUE
crev check k=boolean v=FALSE
crev predecessor k=boolean v=FALSE
crev local_status k=boolean
crev msg k=string
crev base k=string
crev qi   k=string v=$string($value(qcu_ident))
crev omap_path k=string v=':CSERV.CSERV.DEBUG_TABLES.'//$strrep(qi)
crev wev$working_catalog k=string scope=xref
crev wev$development_base k=string scope=xref
crev wev$build_level k=string s=xref

crev ty_path k=string v=wev$development_base//'.OS.'
     ty_path = ty_path//wev$build_level//'.TYING'

incf $fname(ty_path)
tl = $strlen(wev$release_level)

IF tl < 10 THEN
wev$release_level = 'R142_L727xx'
IFEND



crev name k=string d=1..50 v=''
crev found k=boolean v=FALSE
crev rejects k=string d=1..50  v=''
crev rcnt v=1

name(1) = 'OSF$MONITOR'
name(2) = 'OSF$SYSTEM_CORE_113'
name(3) = 'OSF$SYSTEM_CORE_133'
name(4) = 'OSF$SYSTEM_CORE_13D'
name(5) = 'OSF$SYSTEM_CORE_1DD'
name(6) = 'OSF$JOB_TEMPLATE_223'
name(7) = 'OSF$JOB_TEMPLATE_236'
name(8) = 'OSF$JOB_TEMPLATE_23D'
name(9) = 'OSF$JOB_TEMPLATE_2DD'
name(10) = 'OSF$VERSION'
name(11) = 'OSF$MESSAGE_TEMPLATES'
name(12) = 'OSF$BOOT_JOB'
  IF $string($value(help)) = 'HELP' OR $string($value(help)) = 'HP'  THEN
   makqcu12,check
   IF NOT check THEN
    EXIT_PROC
   IFEND
  IFEND

crev qev$os_level k=string v= $string($value(qcu_ident)) s=xdcl
crev qev$release_level k=string s=xdcl
crev qev$release_date k=string v=$date(mdy) s=xdcl

"************************************************************************
" Go initialize the Object catalog.
"************************************************************************
  makqcu11 $value(qcu_ident),check
   IF check THEN
    EXIT_PROC
   IFEND

p1 = $substr(qi,5,2)
putl ' '
putl ' Generating QCU materials'
putl ' '


"************************************************************************
" Announce type of media being produced
"************************************************************************
crev typet k=boolean v=FALSE       "generate only tape
crev typeb k=boolean v=FALSE       "generate both tape and electronic
crev typee k=boolean v=TRUE        "generate only elctronic
crev dtype k=string v='ELECTRONIC'
IF $string($value(delivery_medium)) = 'TAPE' OR..
 $string($value(delivery_medium)) = 'T' THEN
    typee = FALSE
    typet = TRUE
    dtype = 'TAPE'

ELSE
 IF $string($value(delivery_medium)) = 'BOTH' OR..
  $string($value(delivery_medium)) = 'B' THEN
    typee = FALSE
    typeb = TRUE
    dtype = 'BOTH'
 IFEND
IFEND
putl ' You have selected a QCU packaging medium for'
IF typeb THEN
putl '              both'
putl '          Tape delivery'
putl '              and'
putl '          Electronic delivery'
ELSEIF typet THEN
putl '          Tape delivery'
ELSE
putl '          Electronic delivery'
IFEND

"*******************************************************************************
"   This section will search the CSERV data base to ensure that a QCU
"   identifier was specified that is known to the system. A failure
"   here means that an invalid QCU ident was specified, or, the caller
"   of the procedure forgot to do a ASSQCU first, or, the CSERV data
"   base is corrupted, or, ??.
"******************************************************************************
putl ' '
putl ' Validating QCU identifier '
putl '           '//qi

IF $strlen(qi) <> 6 THEN
 putl ' An invalid identifier was specified'
 EXIT_PROC
IFEND

qcm$validate_qcu_base,qcu_ident,found

IF NOT found THEN
 putl '-'
 putl '                   ABORTING'
 putl ''
 putl '       '//$substr(qi,1,4)//' is not a system level that is'
 putl '       currently supported by this process.'
 putl '-'
 EXIT_PROC
IFEND

ipath = '.cserv.qcu.'//$substr(qi,1,4)//'.data.$asis'
detf $fname(ipath) status=ignore
attf $fname(ipath)
crev count
crev flag k=boolean v=FALSE
crev qev$qcu_base k=string s=xdcl status=ignore
crev qev$psr k=string s=xdcl status=ignore

accl v=work i=$fname(ipath) lc=count
WHILE count > 0 DO
 level = $substr(work,5,2)
 IF level <> p1 THEN
   accl v=work i=$fname(ipath) lc=count
 ELSE
   flag = TRUE
    qev$qcu_base = $Trim($substr(work,63,6))  "get base that qcu is built on
    qev$psr = $substr(work,11,7)              "get psr that qcu corrects
   accl v=work i=$fname(ipath) lc=count
 IFEND
WHILEND

   detf $fname(ipath) status=ignore
  IF NOT flag THEN
    putl ' '
    putl ' QCU ident '//qi//' is not known to the system '
    putl ' '
    putl ' Aborting request'
    putl ' '
    EXIT_PROC
  IFEND
"*******************************************************************************
"    This section  establishes path values.
"*******************************************************************************
work_path = wev$working_catalog
crev lib_path k=string v=work_path//'.OBJECT.MAINTENANCE'
crev imap_path k=string v=work_path//'.OBJECT.SYSTEM_DEBUG_TABLE'
crev e1_path k=string v=work_path//'.OBJECT.MONITOR_TEMPLATE'
crev e2_path k=string v=work_path//'.OBJECT.SYSTEM_CORE_DEBUG_TABLE'
crev e3_path k=string v=work_path//'.OBJECT.SYSTEM_CORE_SYMBOL_TABLE'
crev e4_path k=string v=work_path//'.OBJECT.SYSTEM_CORE_TEMPLATE'
crev e5_path k=string v=work_path//'.OBJECT.VIRTUAL_MEMORY_IMAGE'


"*******************************************************************************
" This section will show which libraries have been generated
"******************************************************************************
temp1_path = $unique//'.$asis'

name_path = '.'//$job(user)//'.'//$strrep(qi)//'_NAMES.$ASIS'
temp3_path = $unique//'.$asis'


delete_file $fname(name_path) status=ignore

crev bcus k=string d=1..30
crev bcnt v=19                " this is a temporary value till we automate


bcus(1) = '18521 - L727   - 1.4.2'
bcus(2) = '18525 - L727AA - 1.4.2'
bcus(3) = '18526 - L727AB - 1.4.2'
bcus(4) = '18527 - L727AC - 1.4.2'
bcus(5) = '18528 - L727AD - 1.4.2'
bcus(6) = '18529 - L727AE - 1.4.2'
bcus(7) = '18530 - L727AF - 1.4.2'
bcus(8) = '18531 - L727AG - 1.4.2'
bcus(9) = '17838 - L716   - 1.4.1'
bcus(10) = '17839 - L716AA - 1.4.1'
bcus(11) = '17840 - L716AB - 1.4.1'
bcus(12) = '17841 - L716AC - 1.4.1'
bcus(13) = '17842 - L716AD - 1.4.1'
bcus(14) = '17843 - L716AE - 1.4.1'
bcus(15) = '17844 - L716AF - 1.4.1'
bcus(16) = '17845 - L716AG - 1.4.1'
bcus(17) = '17846 - L716AH - 1.4.1'
bcus(18) = '17847 - L716AI - 1.4.1'
bcus(19) = '17848 - L716AJ - 1.4.1'

build = wev$build_level


detf $fname(work_path) status=ignore

 FOR i = 1 TO bcnt DO
  IF $substr(build,7,5) = $substr(bcus(i),1,5) THEN
    msg = $substr(bcus(i),9,6)
    base = $substr(bcus(i),18,5)
    EXIT
  IFEND
 FOREND


putl ' '
putl ' The system identifiers being used are'
putl '           RI = '//base
putl '           PI = '//qi
putl ' '
putl ' You specified that the corrections are based on'
putl '            '//msg
putl '    via the SETWE command'
putl '             and'
putl ' Should be applied on top of '
putl '            '//qev$qcu_base
putl '    via the ASSQCU command'
putl ' '


"*****************************************************************************
" See if there is a PACS catalog in .cserv.debug_tables to
" build on. Else, use the working catalog base.
"*****************************************************************************
  crev check_ic k=string v='.CSERV.DEBUG_TABLES.'//qev$qcu_base//'_QCU'
  predecessor = $file($fname(check_ic),permanent)

IF NOT predecessor THEN
 IF qev$qcu_base <> msg THEN
 putl ''
 putl ''
 putl '                     BE WARNED '
 putl ''
 putl ' Although specified by the '//$substr(qi,1,4)//' qcu data base, it seems'
 putl ' There is no predecessor QCU material available for '//qev$qcu_base//'.'
 putl ''
 putl ' You have the options of continuing or aborting this session.'
 putl ' If you should choose to continue, the '//msg//' base will'
 putl ' be used in it''s stead.'
 putl ' '
 putl ''
 putl ''
 IFEND
IFEND

IF $value(no_pause) = FALSE THEN
putl ' Enter QUIT if you do not wish to continue'
putl '        else, NEXT/RETURN'
accl v=work p='   ' i=input lc=count
  IF $TRANSLATE(LTU,$substr(work,1,1)) = 'Q' THEN
      EXIT_PROC
  IFEND
IFEND

putl ''
putl ' Begin QCU material collection'

" ***********************************************************************
" If generating a 1.4.1 QCU it is necessary to use the 1.4.2 or
" higher command library to compensate for and error in the raf$library.
"************************************************************************
IF base = '1.4.1' THEN

putl '-'
putl ' Note : Building a 1.4.1 QCU requires the presence of the'
putl '        .intve.r142_l727.os.build.maintenance.command_library'
putl '        in your command list. Otherwise a FATAL LL 164 error'
putl '        will abort the process.'
putl ''
putl '        If necessary, you may add the command library now ... '
putl ''
putl '        Enter GO when ready to continue the makqcu process.'
putl ''
accl v=work i=input p= '? ' lc=count
  WHILE count <> 0
   IF $translate(ltu,$substr(work,1,2)) = 'GO' THEN
      EXIT
   IFEND
    incl work
    accl v=work i=input p= '? '
  WHILEND
IFEND

"****************************************************************************
" Verify that the libraries in the Maintenance subcatalog are all part
" of the NOSVE_MAINTENANCE subproduct. Report any exceptions and query
" the user for directions.
"*****************************************************************************
disc $fname(lib_path) o=$fname(temp1_path)
rewf $fname(temp1_path)
crev libs k=string d=1..100  v=''
crev libc v=1

count = 1
WHILE count > 0 DO
  accl v=work i=$fname(temp1_path) lc=count
  IF $substr(work,5,5) = 'FILE:' AND count > 0 ..
   AND $substr(work,11,3) <> 'RAF' THEN
   libc = libc + 1
   libs(libc) = $trim($substr(work,11,31))
  IFEND
WHILEND


IF libc <> 0 THEN
 FOR j = 1 TO libc DO
    found = FALSE
   FOR i = 1 TO 50 DO
     IF name(i) = libs(j) THEN
        found = true
     IFEND
   FOREND
    IF NOT found THEN
     rejects(rcnt) = libs(j)
     rcnt = rcnt + 1
    IFEND
   FOREND

  rcnt = rcnt-1
 IF rcnt > 0 THEN
  putl '-'
   putl '-'
   putl '                 BE WARNED'
   putl ''
   putl ' This QCU specifies libraries that are not candidates for'
   putl ' electronic delivery and installation. You have the options '
   putl ' of continuing or aborting this session. If you choose to'
   putl ' continue, the end product of the following libraries will'
   putl ' not be included as part of the QCU''s electronic or tape'
   putl ' CP deliverables. If the libraries are DS tape resident'
   putl ' they will be included as part ot the IDT option if'
   putl ' selected.'
   putl ''
     FOR i = 1 TO rcnt DO
      putl '                '//rejects(i)
     FOREND
   putl '-'
   putl ''
   putl ''
   putl '    Enter QUIT if you do not wish to continue'
   putl '           else, NEXT/RETURN'
   accl v=work p='   ' i=input lc=count
  IF $TRANSLATE(LTU,$substr(work,1,1)) = 'Q' THEN
      EXIT_PROC
  IFEND
 IFEND
    detf $fname(temp1_path) status=ignore
IFEND





"**************************************************************************
" Go get the library names for the predecessor QCU for verification and
" the PAC modification for use as a feature catalog.
"*************************************************************************
 crev oname k=string d=1..100
 crev oc v=1

  IF predecessor THEN
   makqcu7,$value(qcu_ident),$name(qev$qcu_base)
   crev fc_path k=string v='.'//$job(user)//'.'//qev$qcu_base
   crev nl_path k=string v='.'//$job(user)//'.'//$strrep(qi)//'_NL.$ASIS'

   attf $fname(nl_path) status=ignore
   count = 1
   WHILE count > 0 DO
    accl v=work i=$fname(nl_path) lc=count
    IF count <> 0 THEN
       oname(oc) = work
       oc = oc + 1
    IFEND
   WHILEND
  IFEND

"*******************************************************************************
" Make sure that the predecessor QCU is actually included in this one.
"*******************************************************************************
  crev valid k=boolean v=FALSE

    FOR j = 1 TO oc DO
      IF oname(j) = 'OSF$VERSION' THEN
         j = j+1
      IFEND
    FOR i = 1 TO libc DO
      IF oname(j) = libs(i) THEN
       valid = TRUE
      IFEND
    FOREND
    IF NOT valid THEN
       crev m1 k=string v=$strrep(qi)
       crev m2 k=string v=qev$qcu_base
    putl ''
    putl '-'
    putl '-'
    putl ''
    putl '                    BE WARNED'
    putl ''
    putl ' QCU '//m1//' claims to be based on QCU '//m2//'. However,'
    putl ' materials provided with this session are not logically'
    putl ' connected to the materials used to construct '//m2//'.'
    putl ''
    putl ' Should you choose to continue, the "base" value specified by '
    putl ' the qcu data base for '//m1//' will be ignored and the '//msg
    putl ' base as specified by the working environment will be used.'
   putl ''
   putl ''
   putl ''
   putl ''
   putl ''
   putl '     Enter QUIT if you do not wish to continue'
   putl '            else, NEXT/RETURN'
   accl v=work p='   ' i=input lc=count
      IF $TRANSLATE(LTU,$substr(work,1,1)) = 'Q' THEN
       delcc $fname(fc_path) status=ignore
       delc $fname(fc_path) status=ignore
       delf $fname(nl_path) status=ignore

          EXIT_PROC
      ELSE
          use_oc = FALSE
          EXIT
      IFEND
     IFEND
    FOREND
delv libs status=ignore
delv libc status=ignore

"************************************************************************
" Now go link the system.
"************************************************************************
putl ''
putl '        Linking the QCU'

  linqcu,lsc=on,bos=on,sbl=on,ri=base,pi=qi,wc=$fname(work_path)..
,bl=$name(build)



"******************************************************************************
" This section moves the debug table generated by the QCU link to the cserv
" debug_tables catalog. Once moved it purges the users version of the table.
"******************************************************************************
putl ' '
putl '        Moving debug tables from '
putl '    '//imap_path
putl '                   to   '
putl '    '//omap_path
putl ' '

           copf $fname(imap_path) $fname(omap_path)  status=ignore





"**************************************************************************
" Get all the file names from the maintenance catalog for use in building
" the PACS catalog.
"**************************************************************************
disc $fname(lib_path) o=$fname(temp1_path)
rewf $fname(temp1_path)
crev libs k=string d=1..100  v=''
crev libc v=1


"**************************************************************************
" Add identifier osf$version since it's always modified by a QCU.
"**************************************************************************
   putl 'OSF$VERSION' o=$fname(name_path)
   libs(libc) = 'OSF$VERSION'


count = 1
WHILE count > 0 DO
  accl v=work i=$fname(temp1_path) lc=count
  IF $substr(work,5,5) = 'FILE:' AND count > 0 ..
   AND $substr(work,11,3) <> 'RAF' THEN
   putl $substr(work,11,31) o=$fname(name_path//'.$EOI')
   libc = libc + 1
   libs(libc) = $trim($substr(work,11,31))
  IFEND
WHILEND

IF use_oc THEN
 FOR i = 1 TO libc DO
  n1 = libs(i)
   FOR j = 1 TO oc DO
     IF n1 = oname(j) THEN
       oname(j) = ''
     IFEND
   FOREND
 FOREND

    FOR i = 1 TO oc DO
      IF oname(i) <> '' AND $substr(oname(i),1,3) <> 'RAF' THEN
       putl oname(i) o=$fname(name_path//'.$EOI')
      IFEND
    FOREND
IFEND

putl ' '
detf $fname(name_path) status=ignore
attf $fname(name_path) status=ignore
rewf $fname(name_path)

IF libc = 0 THEN
   putl ' There are no libraries to generate'
   putl ' Aborting request'
ELSE
putl ' This QCU modified the following libraries'
  count = 1
 WHILE count > 0 DO
  accl v=work i=$fname(name_path) lc=count
    IF count <> 0 THEN
      putl '          '//work
    IFEND
 WHILEND
IFEND




"****************************************************************************
" Go establish the correct platform (base) for the QCU generation.
"****************************************************************************
    makqcu10,$value(qcu_ident)


"****************************************************************************
" Go generate the corrections for the QCU
"****************************************************************************
    makqcu1,$value(qcu_ident),typee,local_status,$value(no_pause)


     IF  local_status = TRUE THEN



"***************************************************************************
" Generate a deadstart tape if requested with vsn=QCU_ident + D preface
"**************************************************************************
    IF $value(include_deadstart_tape) = TRUE THEN
     putl ' Generating deadstart tape with vsn of '//$string(D)//$substr(qi,2,5)
     putl '       At '//$time(hms)//'  On '//$date(mdy)

     work = 'GENQDT evsn=''D'//$substr(qi,2,5)//''''
     incl work
   IFEND
 delf $fname(temp1_path) status=ignore
 delf $fname(name_path) status=ignore
IFEND


crev a1 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_DF'
crev a2 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_NL'
crev a3 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_PL'
crev a4 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_FC'
crev a5 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_CF'
crev a6 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_QF'
crev a7 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_PA'
crev a8 k=string v='.'//$job(user)//'.'//$strrep(qi)//'_PB'






 delf $fname(e1_path) status=ignore    "get rid of unnecessary files
 delf $fname(e2_path) status=ignore
 delf $fname(e3_path) status=ignore
 delf $fname(e4_path) status=ignore
 delf $fname(e5_path) status=ignore
 delf $fname(imap_path) status=ignore

 delf $fname(a1) status=ignore
 delf $fname(a2) status=ignore
 delf $fname(a3) status=ignore
 delc $fname(a4) do=cac status=ignore
 delf $fname(a5) status=ignore
 delf $fname(a6) status=ignore
 delc $fname(a7) do=cac status=ignore
 delc $fname(a8) do=cac status=ignore

delcc $fname(fc_path) status=ignore
delc $fname(fc_path) status=ignore

putl ' '
putl ' QCU generation complete'
putl ' '

setta hp=on        " reset the hold page option

 PROCEND make_quick_corrective_update
