
PROC qcm$display_qcu_correction, display_qcu_correction, disqc (
qcu_ident           : name = $required
status )


crev ignore k=status
crev qi k=string v=$string($value(qcu_ident))
crev work k=string
crev msg k=string
crev count
crev base k=string v=$substr(qi,1,4)
crev valid k=boolean s=xdcl

validate_qcu_base $value(qcu_ident) valid
IF NOT valid THEN
 putl ' The value '//qi//' is not a valid system level'
 EXIT_PROC
IFEND

crev qcu_path k=string v=':CSERV.CSERV.QCU.'//base//'.data.$asis'
crev psr_path k=string v=':CSERV.ARHOPS.'
crev temp k=string v=$unique//'.$asis'
crev pl_path k=string v='.'//$job(user)//'.'//$strrep(qi)//'_PL'
crev na_path k=string v='.'//$job(user)//'.'//$strrep(qi)//'_NA'
crev cb_path k=string v='.'//$job(user)//'.'//$strrep(qi)//'_CB'

delf $fname(pl_path) status=ignore
delf $fname(na_path) status=ignore
delc $fname(cb_path) do=cac status=ignore
detf $fname(qcu_path) status=ignore
attf $fname(qcu_path) op=$asis status=ignore

crev psr k=string v=''
crev found k=boolean
crev break k=string v='_'
crev link_path k=string

accl v=work  i=$fname(qcu_path) lc=count
WHILE count > 0 DO
 IF $substr(work,1,6) = qi THEN
    psr = $substr(work,11,7)
    found = true
    EXIT
 IFEND
accl v=work i=$fname(qcu_path) lc=count
WHILEND

IF NOT found THEN
 putl ' The value '//qi//' does not represent a valid qcu identifier'
 EXIT_PROC
IFEND

psr_path = psr_path//psr


RESPF l=$fname(temp)
DISBF BF=$fname(psr_path)
QUIT

crev counter
rewf $fname(temp) status=ignore
WHILE counter < 2 DO
 accl v=work i=$fname(temp) lc=count
 IF $substr(work,2,1) = ':' THEN
  counter = counter + 1
 IFEND
WHILEND

crev base_path k=string
crev name_path k=string
crev head_path k=string

link_path = work
count = $scan_string(break,work)
count = count -1
base_path = $substr(work,1,count)
name_path = base_path//'_names'
head_path = base_path//'_pl'
rewf $fname(temp) status=ignore

RESPF l=$fname(temp)
RESC c=$fname(link_path) ncn=$fname(cb_path) bf=$fname(psr_path)
RESF f=$fname(name_path) nfn=$fname(na_path) bf=$fname(psr_path)
RESF f=$fname(head_path) nfn=$fname(pl_path) bf=$fname(psr_path)
QUIT

crev o k=string v=$unique
crev previous_base k=string
count = 1
attf $fname(pl_path) op=$asis
 msg =  '       FIELD CORRECTION DESCRIPTION FOR '//$strrep(qi)
 putl ' '//msg o=$fname(o//'.$eoi')
 putl '' o=$fname(o//'.$eoi')
accl v=work i=$fname(pl_path) lc=count
WHILE count <> 0 DO
 IF $substr(work,8,10) = 'Identifier' THEN
    putl '             QCU '//$substr(work,8,$strlen(work)) o=$fname(o//'.$eoi')
 ELSEIF $substr(work,8,4) = 'Type' THEN
    putl '             '//$substr(work,8,$strlen(work)) o=$fname(o//'.$eoi')
 ELSEIF $substr(work,8,5) = 'Creat' THEN
    putl '             '//$substr(work,8,$strlen(work)) o=$fname(o//'.$eoi')
 ELSEIF $substr(work,8,6) = 'Medium' THEN
    putl '             '//$substr(work,8,$strlen(work)) o=$fname(o//'.$eoi')
 ELSEIF $substr(work,11,7) = 'Product' THEN
    putl '             '//$substr(work,11,$strlen(work)) o=$fname(o//'.$eoi')
 ELSEIF $substr(work,6,6) = 'Correc' THEN
    putl '             '//$substr(work,6,$strlen(work)) o=$fname(o//'.$eoi')
    previous_base = $substr(work,22,12)
 ELSEIF $substr(work,6,6) = 'Answer' THEN
    putl '             '//$substr(work,6,$strlen(work)) o=$fname(o//'.$eoi')
 IFEND
accl v=work i=$fname(pl_path) lc=count
WHILEND
rewf $fname(o) status=ignore
copf $fname(o)

delf $fname(pl_path) status=ignore
delf $fname(na_path) status=ignore
delc $fname(cb_path) do=cac status=ignore


PROCEND qcm$display_qcu_correction
