
PROC make_qcu_phase_6, makqcu6 (
qcu_ident, qi: name = $required
status )


"*******************************************************************************
" This procedure deletes the deck calls from qcf$product_table and
" qcf$qcu_product_table that are not related to the current correction.
"*******************************************************************************



crev wev$working_catalog k=string s=xref
crev local_status k=status
crev ignore k=status

crev a_path k=string v='.'//$job(user)//'.'//$strrep(qcu_ident)//'_ae.$ASIS'
crev b_path k=string v='.'//$job(user)//'.'//$strrep(qcu_ident)//'_names.$asis'
crev c_path k=string v= $unique
crev al_path k=string v= wev$working_catalog//'.OBJECT.MAINTENANCE.'
     al_path = al_path//'QCF$BASE_PRODUCT_TABLE'

crev bl_path k=string v= wev$working_catalog//'.OBJECT.MAINTENANCE.'
     bl_path = bl_path//'QCF$QCU_PRODUCT_TABLE'

delf $fname(a_path) status=ignore


SCU
  usel $fname(al_path)
  edid d=NOSVE_MAINTENANCE  p=$null m=SPECIAL o=$fname(a_path)
  rewf $fname(a_path)
  l '*copy ' n=all
  quit
QUIT

detf $fname(a_path) status=ignore
attf $fname(a_path)

crev entry k=string d=1..20 v=''
crev work k=string
crev count v=1
crev cnt v=1
crev modified k=boolean v=FALSE

detf $fname(b_path) status=ignore
attf $fname(b_path)

WHILE count > 0 DO
 accl v=work i=$fname(b_path) lc=count
  IF work <> ' ' AND count <> 0 THEN
   entry(cnt) = $substr(work,5,$strlen(work)-4)
   cnt = cnt + 1
  IFEND
WHILEND

cnt = cnt-1

rewf $fname(a_path) status=ignore
count = 1

WHILE count > 0 DO
     accl v=work i=$fname(a_path) lc=count
     l1 = $substr(work,18,$strlen(work)-17)
     flagger = FALSE
   FOR i = 1 TO cnt DO
     IF entry(i) =  l1 THEN
      flagger = TRUE
     IFEND
   FOREND
     IF NOT flagger AND $substr(work,12,7) <> 'VERSION' THEN
      putl 'delt t='''//$substr(work,2,$strlen(work)-1)//''''..
        o=$fname(c_path//'.$EOI')
      modified = TRUE
     IFEND
WHILEND

"******************************************************************************
" Make sure there is somthing to modify in the library, else exit.
"******************************************************************************
IF NOT modified THEN
   EXIT_PROC
IFEND

rewf $fname(c_path) status=ignore

putl ''
putl ' Modifying the platform product table'
SCU
  usel $fname(al_path) r=$fname(al_path//'.$NEXT')
  edid d=NOSVE_MAINTENANCE  p=$null m=SPECIAL o=$null
  incf $fname(c_path)
  quit
QUIT,YES

rewf $fname(c_path) status=ignore


putl ''
putl ' Modifying the levels product table'
SCU
  usel $fname(bl_path) r=$fname(bl_path//'.$NEXT')
  edid d=NOSVE_MAINTENANCE  p=$null m=SPECIAL o=$null
  incf $fname(c_path)
  quit
QUIT,YES


delf $fname(a_path) status=ignore
delf $fname(c_path) status=ignore
detf $fname(al_path) status=ignore
detf $fname(bl_path) status=ignore
detf $fname(name_path) status=ignore

PROCEND make_qcu_phase_6

