set define off

REM This package contains functions and procedures 
REM to assist the construction of www-pages.
REM Author Harri Laine, 29.1.1999
create or replace package iht2 as
   procedure add_any_js(js in char, checkList in out varchar2);
      -- and-concatenates javascript condition js into checklist 
   
      
   procedure colored_text(cTextcolor char, cBgColor char, cText char, 
      nWidth integer:=100, nSize integer:=NULL);
      -- Outputs a text item in boldface style with colored background. 
      -- cTextcolor gives the color of the text in eiher as the name of the
      -- name of the color (e.g. red, white, blue,...) or as a RGB-value
      -- (e.g. #FFFFFF)
      -- cBgColor specifies the background color for the line coded as
      -- cTextcolor
      -- cText specifies the text to be printed
      -- nsize specifes the propotional font size, +I indidate increade of I units
      -- -I decrease of I units. Thus  1 is default+1 and
      -- -2 equals to default-2. zero and NULL result in default font.
      -- cWidth specifies the length of the background block as 
      -- percentage of the width of the page

   procedure field_print(cPrompt char, cElement in char, cStyle in char:= 'NL_COL2'); 
      -- Generates html-code for positioning the prompt (cprompt)
      -- of a form field (given in html as celement) as defined by 
      -- the parameter cstyle:
      --    cstyle='NL_COL2': prompt and field in two successive columns of
      --                      a new row in a table
      --    cstyle='COL2':    prompt and field in two successive columns of
      --                      within a row in a table
      --    cstyle='COL':     field in table column, no prompt
      --    cstyle='TOP':     prompt in small font above the field
      --    cstyle='TOP_COL': field and prompt in the same column of a
      --                      table, prompt in small font above the field
      --    cstyle='PRE':     prompt, delimiter colon (:) and the field
      -- prompt_special gives any additional attributes for the prompt
      -- elem_special gives any additional attributes for element value
      -- Example: form_field('Nimi:','Value','NL_COL2') 

   procedure form_button(cType char, cValue char, cName char:= null, cStyle char:='COL'); 
      -- Generates a button on the form. ctype ={SUBMIT/RESET}
      -- defines the type of the button. cvalue determines the text on the
      -- button. Optinal parameter cname defines the name for the object.
      -- If cname is not null the program to be called will obtain this 
      -- parameter in a call.   The effect of cstyle is defined in procedure
      -- form_field.
   
   procedure form_end;
     -- Generates the end tag for an html-form.
  
   procedure form_date_field(cPrompt char, cName char,
        cValue char := null, cStyle char := 'NL_COL2');
     -- Generates html-code for including a JavaScript
     -- checked date-field in a form. Date format is DD.MM.YYYY
     -- and the value must be within range 01.01.1901 - 31.12.2099.
     -- cprompt is the prompt attached to the field.
     -- cname is the name of the field.
     -- cvalue gives the initial value for the field.
     -- The effect of cstyle is defined in procedure form_field.

   procedure form_field(cPrompt in char, cElement in char, cStyle in char);
     -- Generates html-code for positioning the prompt (cprompt)
     -- of a form field (given in html as celement) as defined by 
     -- the parameter cstyle:
     --    cstyle='NL_COL2': prompt and field in two successive columns of
     --                      a new row in a table
     --    cstyle='COL2':    prompt and field in two successive columns of
     --                      within a row in a table
     --    cstyle='COL':     field in table column, no prompt
     --    cstyle='TOP':     prompt in small font above the field
     --    cstyle='TOP_COL': field and prompt in the same column of a
     --                      table, prompt in small font above the field
     --    cstyle='PRE':     prompt, delimiter colon (:) and the field
     --
     -- Example: form_field('Nimi:','<input ... >','NL_COL2') 
   
   procedure form_hidden_field(cName char, cValue char); 
     --  inserts a hidden field with the given name and value into
     --  a html-form.
  
   procedure form_menu(cPrompt char, cName char, cOptions char,
      cSelected char, cStyle char:= 'NL_COL2');
     -- Generates code to include a pull-down menu in the form.
     -- cprompt is the prompt attached to the menu.
     -- cname is the name of the field.
     -- options contains a comma separated list of menu
     --   options. A menu option may contain the visible value and
     --   the delivered value. Delivered value is optional. If given
     --   it should succeed the visible value after #-delimiter.
     --   Example 'VISIBLE1#DELIVERED1,VIS2, VIS3#DEL3'.
     --   cselected gives the default selection. It is compared
     --   to the delivered value.
     -- The effect of cstyle is defined in procedure form_field.

   procedure form_number_field(cPrompt char, cName char, nSize integer,
        cValue char:= null, cStyle char:= 'NL_COL2'); 
     -- Generates html-code for including a JavaScript
     -- checked numeric field in a form.
     -- nsize specifies the length of the field.
     -- cprompt is the prompt attached to the field.
     -- cname is the name of the field.
     -- cvalue gives the initial value for the field.
     -- The effect of cstyle is defined in procedure form_field.

   procedure form_range_field(cPrompt char,  cName char, nSize integer,
        nLower integer, nUpper integer,
        cvalue char := null, cStyle char:= 'NL_COL2');
     -- Generates html-code for including a JavaScript
     -- checked numeric field in a form. The value of the
     -- field must be between nlower and nupper.
     -- nsize specifies the length of the field.
     -- cprompt is the prompt attached to the field.
     -- cname is the name of the field.
     -- cvalue gives the initial value for the field.
     -- The effect of cstyle is defined in procedure form_field.

   procedure form_start(cURL in char, cMethod in char:='post',
        cSubmitCheck in char:=null);
     -- Generates html-code for starting a form.
     -- curl gives the URL of the program that will process the
     -- submitted form. 
     -- cmethod specifies the way to pass the parameters. Alternatives
     -- are 'post' (thru sysinput) and 'get' (thru environment variable)
     -- csubmitcheck contains the JavaScript checks to be executed
     -- before the form is submitted. Procedure add_presence_test can
     -- be used in construction of csubmitcheck.

   procedure form_textarea(cPrompt char, cName char, cValue char,
   nCols int:=40, nRows int:=3, cStyle char:='NL_COL2');
     -- Generates code for html textarea. 
     -- ncols is the width of the area and nrows is the height.
     -- cprompt is the prompt attached to the field.
     -- cname is the name of the field.
     -- cvalue gives the initial text. The size of the text must
     -- be less than 2400 bytes.
     -- The effect of style is defined in procedure form_field.

   procedure form_text_field(cPrompt char, cName char, nSize integer,
        nMaxLength integer, cValue char := null, cStyle char:= 'NL_COL2');
     -- Generates html-code for including a normal text field in 
     -- a form. 
     -- nsize specifies the length of the field.
     -- nmaxlength gives the maximun length of the value.
     -- cprompt is the prompt attached to the field.
     -- cname is the name of the field.
     -- cvalue gives the initial value for the field.
     -- The effect of style is defined in procedure form_field.

   
   procedure form_2_standard_buttons(cSubmit varchar2, cReset varchar2);
   
   procedure form_4_standard_buttons;

   procedure js_allchecks;
     --  generates javascript code for isEmpty, isNonEmpty,
     --  isDate, isInRange, isNumeric, dateCheck, numCheck,
     --  rangeCheck and presenceCheck.

   procedure js_checksonly;
     --  generates a javascript block that contains the functions
     --  generated by js_allchecks.

   procedure js_functions_start;
     -- produces javascript block starter tag

   procedure js_isempty;
     --  generates code for javascript function isEmpty(textfield) that
     --  evaluates true if the argument is empty and othervise false.

   procedure js_datecheck;
     --  generates code for javascript function dateCheck(textfield) that
     --  evaluates true if the argument is a valid date between
     --  1.1.1901 and 31.12.2099,
     --  otherwise it evaluates false and produces an error message.

   procedure js_isdate;
     --  generates code for javascript function isDate(textfield) that
     --  evaluates true if the argument is a valid date between
     --  1.1.1901 and 31.12.2099 and otherwise false.

   procedure js_isinrange;
     --  generates code for javascript function 
     --  isInRange(textfield, lower, upper) that
     --  evaluates true if the argument is numeric and is between
     --  lower and upper, otherwice false.

   procedure js_isnonempty;
     --  generates code for javascript function isNonEmpty(textfield) that
     --  evaluates true if the argument is non-empty and othervise false.

   procedure js_isnumber;
     --  generates code for javascript function isNumber(textfield) that
     --  evaluates true if the argument is numeric and othervise false

   procedure js_numcheck;
     --  generates code for javascript function numcheck(textfield) that
     --  evaluates true if the argument is numeric and otherwice 
     --  evaluates to false and produces an error message.

   procedure js_rangecheck;
     --  generates code for javascript function 
     --  rangecheck(textfield,lower,upper) that
     --  evaluates true if the argument is numeric between lower and upper,
     --  otherwise it evaluates false and produces an error message.
   
   procedure page_end( cdate varchar2, csignature varchar2);
     -- end tags 

   procedure page_start(cTitle in char);
     --  starts a normal html page, and prints its title. 

   procedure table_end;
     --  ends a table

   procedure table_start(cattributes char:=NULL);
     --  starts a table. cAttributes contain atributes to be included within
     --  the table tag

   function text_field(cName char, nSize integer, nMaxLength integer,
        cValue char , cCheck char) return varchar2;
     -- produces a html input text item
     -- cname will be the value of name-attribute
     -- nsize will be the value of size-attribute
     -- nmaxlength will be the value of maxlength-attribute
     -- cvalue will be the value of value-attribute
     -- ccheck contains text (usually JavaScript) to be included
     -- within the tag after the previous attributes
    
   function value_required(fieldname char) return varchar2;
      -- gives the javascript function to test if the field 'fieldname'
      -- has been given a value
     
end;
/
show errors
  
create or replace package body iht2 as

procedure add_any_js(js in char, checkList in out varchar2) is
begin
   if checklist is NULL then
      checklist:= js;
   elsif checklist ='' then
      checklist:= js;
   else
      checklist:= checklist||' && '||js;
   end if;
end;

function value_required(fieldname char) return varchar2 is
nstr varchar2(80);
begin
   nstr:='presencecheck('||fieldname||')';
   return nstr;
end;                                                                       

procedure colored_text(ctextcolor char, cbgcolor char, ctext char, 
      nwidth integer:=100, nsize integer:=NULL) is
  incr integer;
  astr varchar2(200);
begin
  htp.p('<table width="'||nwidth||'%" bgcolor="'||cbgcolor||'">');
  htp.p('<td>');
  incr:=nsize-4; 
  astr:= '<b><font color="'||ctextcolor||'"';
  if nsize is null then
     astr:=astr||'>';
  elsif nsize>0 then
     astr:= astr||' size="+'||to_char(nsize)||'">';
  elsif nsize<0 then
     astr:=astr||' size="'||to_char(nsize)||'">';
  else 
     astr:= astr||'>';
  end if;
  htp.P(astr||ctext||'</font></td></table>');
end;

procedure field_print(cprompt in char,celement in char, cstyle in char:= 'NL_COL2') is 
   pstr_s varchar2(128);
   pstr_e varchar2(12);
begin                
   if upper(cstyle)='NL_COL2' then
      pstr_s:= '<tr><td align="left"><b><small>'||cprompt||'</small></b></td><td>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='COL2' then
      pstr_s:= '<td align="left"><b><small>'||cprompt||'</small></b></th><td>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='COL' then
      pstr_s:= '<td>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='TOP' then
      pstr_s:= '<small><b>'||cprompt||'</b></small><br>';
      pstr_e:= '';
   elsif upper(cstyle)='TOP_COL' then
      pstr_s:= '<td><small><b>'||cprompt||'</b></small><br>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='NONE' then
      pstr_s:='';
      pstr_e:='';
   else
      pstr_s:= cprompt||': ';
      pstr_e:= '';
   end if;
   htp.p(pstr_s);
   htp.p(celement);
   htp.p(pstr_e);
end;

procedure form_end is
begin
   htp.p('</form>');
end;

procedure form_hidden_field(cname char, cvalue char) is
begin
   htp.p('<Input type="hidden" value="'||cvalue||'">');
end;

procedure form_start(curl in char, cmethod in char:='post',
   csubmitcheck in char:=null) is
begin
   htp.p('<form method="'||cmethod||'"');
   htp.p('action="'||curl||'" ');
   if csubmitcheck is not null then
      htp.p('   onSubmit="return('||csubmitcheck||')"');
   end if;
   htp.p('>');
end;

procedure form_button(ctype char, cvalue char, cname char:= null, cstyle char:='COL') is
   str varchar2(200);
   bval varchar2(30);
begin     
   if lower(ctype)='submit' then
      str:='<input type="submit" value="'||cvalue||'"';
      if cname is not null then
         str:= str||' name="'||cname||'"';
      end if;
      str:= str||'>';
      form_field('',str,cstyle);
   elsif lower(ctype)='reset' then
      str:= '<input type="reset" value="'||cvalue||'">'; 
      form_field('',str,cstyle);
   end if;
end;

procedure form_date_field(cprompt char, cname char,
   cvalue char := null, cstyle char:= 'NL_COL2') is
   str varchar2(240);
   ccheck varchar2(60);
begin
   ccheck:= 'onBlur="datecheck(this)"';
   str:= text_field(cname, 10,10,cvalue,ccheck);
   form_field(cprompt, str, cstyle);   
end;

procedure form_menu(cprompt char, cname char, coptions char,
   cselected char, cstyle char:= 'NL_COL2') is
   str varchar2(2000);
   rems varchar2(2000);
   item varchar(240);
   r_val varchar(240);
   v_val varchar(240);
   comma integer;
   colon integer;
begin
   str:='<select name="'||cname||'">';
   rems:= coptions;
   while length(rems)>0 loop
     comma:= instr(rems,',');
     if comma=0 then
        item:= rems;
        rems:= '';
     else
        item:= substr(rems,1,comma-1);
        rems:= substr(rems,comma+1);
     end if;
     colon:= instr(item,'#');
     if colon>0 then
        r_val:= substr(item,colon+1);
        v_val:= substr(item,1,colon-1);
        str:= str||'<option value="'||r_val||'"';
     else
        r_val:= item;
        v_val:= item;
        str:= str||'<option';
     end if;     
     if cselected=r_val then
        str:= str||' selected';
     end if;
     str:=str||'>';
     str:=Str||v_val||'</option>';
   end loop;
   str:= str||'</select>';   
   form_field(cprompt, str,cstyle);
end;       
   

procedure form_number_field(cprompt char, cname char,nsize integer,
   cvalue char := null, cstyle char:= 'NL_COL2') is
   str varchar2(240);
   ccheck varchar2(60);
begin
   ccheck:= 'onBlur="numcheck(this)"';
   str:= text_field(cname, nsize,nsize,cvalue,ccheck);
   form_field(cprompt, str, cstyle); 
end;

procedure form_range_field(cprompt char,  cname char,nsize integer,
   nlower integer, nupper integer,
   cvalue char := null, cstyle char:= 'NL_COL2') is
   str varchar2(240);
   ccheck varchar2(60);
begin
   ccheck:= 'onBlur="rangecheck(this,'||nlower||','||nupper||')"';
   str:= text_field(cname,nsize,nsize,cvalue,ccheck);
   form_field(cprompt,str,cstyle); 
end;


procedure form_textarea(cprompt char, cname char, cvalue char,
   ncols int:=40, nrows int:=3, cStyle char:='NL_COL2') is
   str varchar2(2400);
begin
   str:= '<textarea name="'||cname||'" cols="'||
        to_char(ncols)||'" rows= "'||to_char(nrows)||'">';
   if cvalue is not null then
      str:= str||cvalue;
   end if;
   str:= str||'</textarea>';
   form_field(cprompt,str,cstyle);
end;
   

procedure form_text_field(cprompt char, cname char, nsize integer,
   nmaxlength integer, cvalue char:= null, cstyle char:= 'NL_COL2') is
   str varchar2(240);
   ccheck varchar2(60);
begin
   ccheck:= '';
   str:= text_field(cname, nsize, nmaxlength,cvalue,ccheck);
   form_field(cprompt, str, cstyle); 
end;


procedure form_field(cprompt in char,celement in char, cstyle in char) is 
   pstr_s varchar2(128);
   pstr_e varchar2(12);
begin                
   if upper(cstyle)='NL_COL2' then
      pstr_s:= '<tr><th align="left">'||cprompt||'</th><td>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='COL2' then
      pstr_s:= '<th align="left">'||cprompt||'</th><td>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='COL' then
      pstr_s:= '<td>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='TOP' then
      pstr_s:= '<small>'||cprompt||'</small><br>';
      pstr_e:= '';
   elsif upper(cstyle)='TOP_COL' then
      pstr_s:= '<td><small>'||cprompt||'</small><br>';
      pstr_e:= '</td>';
   elsif upper(cstyle)='NONE' then
      pstr_s:='';
      pstr_e:='';
   else
      pstr_s:= cprompt||': ';
      pstr_e:= '';
   end if;
   htp.p(pstr_s);
   htp.p(celement);
   htp.p(pstr_e);
end;

function text_field(cname char,nsize integer,nmaxlength integer,
        cvalue char , ccheck char) return varchar2 is
   str varchar2(240);
begin   
   str:='<input type="text" name="'||cname||'" size="'||
        to_char(nsize)||
        '" maxlength="' ||
        to_char(nmaxlength) || 
        '" value="'||
        cvalue || '" '||ccheck ||'>';
   return str;   
end;

procedure form_2_standard_buttons(csubmit varchar2, creset varchar2) is
begin
   htp.p('<table><tr>');
   form_button('RESET',creset);
   form_button('SUBMIT',csubmit);
   htp.p('</table>');
end;

procedure form_4_standard_buttons is
begin
   htp.p('<table><tr>');
   form_button('RESET','Peru');
   form_button('SUBMIT','Poista','optype');
   form_button('SUBMIT','Kirjaa muutos','optype');
   form_button('SUBMIT','Uusi','optype');
   htp.p('</table>');
end;

procedure table_end is
begin
   htp.p('</table>');
end;

procedure table_start(cattributes char:=NULL) is
str varchar2(200);
begin
  str:='<table';
  if cattributes is not null then
     str:= str||' '||cattributes;
  end if;
  str:= str||'>';
  htp.p(str);
end;

-- JavaScript generation ----------------------------

procedure js_functions_start is 
begin    
   htp.p('<script language="JavaScript">');
   htp.p('<!-- hide');
end;  

procedure js_functions_end is 
begin
    htp.p('// -->');
    htp.p('</script>'); 
end;  

procedure js_isnumber is 
begin
    htp.p('function isNumber(textField) {');
    htp.p('  intValue= Number(textField.value); ');
    htp.p('  if (isNaN(intValue))   ');
    htp.p('     return false  ');
    htp.p('  else');
    htp.p('     return true; ');
    htp.p('}');
    htp.p(' '); 
end;  

procedure js_isinrange is 
begin
   htp.p('function isInRange(intValue, lower, upper) { ');
   htp.p('   if (intValue < lower || intValue > upper) ');
   htp.p('      return false ');
   htp.p('   else '); 
   htp.p('      return true; '); 
   htp.p('} ');
end;

procedure js_numcheck is 
begin
   htp.p('function numcheck(textField) { ');
   htp.p('  if (isNonEmpty(textField)) {');
   htp.p('    if (isNumber(textField))  ');
   htp.p('      return true ');
   htp.p('    else {  ');
   htp.p('      str = "''" + textField.value + "'' ei ole numero.";  ');
   htp.p('      alert(str);  ');
   htp.p('      textField.select();  ');
   htp.p('      textField.focus();  ');
   htp.p('      return false;  ');
   htp.p('    } ');
   htp.p('  } ');
   htp.p('  return true ');
   htp.p('} ');
   htp.p(' ');
end;


procedure js_isnonempty is
begin
   htp.p('function isNonEmpty(textfield) {');
   htp.p('   a=textfield.value;');
   htp.p('   if (a=="") ');
   htp.p('      return false');
   htp.p('   else ');
   htp.p('      return true;');
   htp.p('}');
   htp.p;
end;

procedure js_isempty is
begin
   htp.p('function isEmpty (textfield) {');
   htp.p('   a=textfield.value;');
   htp.p('   if (a=="") ');
   htp.p('      return true;');
   htp.p('   else');
   htp.p('      return false;');
   htp.p('}');
   htp.p;
end;


procedure js_rangecheck is 
begin
   htp.p('function rangecheck(textField, lower, upper) { ');
   htp.p('  if (isNonEmpty(textField)) {');
   htp.p('    var str = "Anna numero lukujen "+lower+" ja "+upper+" väliltä.\n"; ');
   htp.p('    if (isNumber(textField)) { '); 
   htp.p('      intValue = Number(textField.value); ');
   htp.p('      if (isInRange(intValue, lower, upper)) ');
   htp.p('         return true '); 
   htp.p('      else {');
   htp.p('         alert(str); ');
   htp.p('         textField.select(); ');
   htp.p('         textField.focus(); ');
   htp.p('         return false; ');
   htp.p('       }');
   htp.p('    }');
   htp.p('    else {');
   htp.p('      alert(str);');
   htp.p('      textField.select(); ');
   htp.p('      textField.focus(); ');
   htp.p('      return false;');
   htp.p('    }');
   htp.p('  }');
   htp.p('  return true'); 
   htp.p('}');
   htp.p(' ');
end;

procedure js_isdate is 
begin
   htp.p('function isDate(textField) { ');
   htp.p('   a=textField.value;');
   htp.p('   dotpos1= a.indexOf(".");');
   htp.p('   dotpos2= a.lastIndexOf(".");');
   htp.p('   if (dotpos1>0 && dotpos1<3 && dotpos2==a.length-5 && dotpos2>=dotpos1+1) {');
   htp.p('     d = a.substring(0,dotpos1);');
   htp.p('     m = a.substring(dotpos1+1,dotpos2);');
   htp.p('     y = a.substring(dotpos2+1,a.length);');
   htp.p('     if (isInRange(y,1901,2099) && isInRange(m,1,12) && isInRange(d,1,31)) {');
   htp.p('       if ((m==4 || m==6 || m==9 || m==11) && d>30) ');
   htp.p('         return false');
   htp.p('       else');
   htp.p('         if (m==2) ');
   htp.p('           if (d>29) ');
   htp.p('              return false');
   htp.p('           else ');
   htp.p('             if (d==29 && ((y/4)!=parseInt(y/4))) ');
   htp.p('               return false');
   htp.p('             else ');
   htp.p('   	       return true');
   htp.p('         else'); 
   htp.p('           return true');
   htp.p('     }');
   htp.p('     else');
   htp.p('        return false');
   htp.p('  }');
   htp.p('  else');
   htp.p('    return false'); 
   htp.p('}');
   htp.p(' ');
end;

procedure js_datecheck is 
begin 
   htp.p('function datecheck(textField) {');
   htp.p('  if (isNonEmpty(textField)) {');
   htp.p('   if (isDate(textField)) '); 
   htp.p('      return true'); 
   htp.p('   else {'); 
   htp.p('      alert(''Anna kelvollinen päiväys (pp.kk.vvvv) väliltä 1.1.1901 - 31.12.2099!'');'); 
   htp.p('      textField.select(); '); 
   htp.p('      textField.focus(); '); 
   htp.p('      return false;'); 
   htp.p('   }'); 
   htp.p('  }');
   htp.p('  return true'); 
   htp.p('}'); 
   htp.p(' ');
end;

procedure js_presencecheck is
begin
   htp.p('function presencecheck(textField) {');
   htp.p('   if (isNonEmpty(textField)) ');
   htp.p('      return true');
   htp.p('   else {'); 
   htp.p('      str= "Kenttä "+textField.name+" on pakollinen!";');
   htp.p('      alert(str);'); 
   htp.p('      textField.select(); '); 
   htp.p('      textField.focus(); '); 
   htp.p('      return false;');
   htp.p('   }');  
   htp.p('}'); 
   htp.p(' ');
end;

procedure js_allchecks is 
begin 
   js_isempty;
   js_isnonempty;
   js_isnumber; 
   js_isinrange; 
   js_isdate; 
   js_numcheck; 
   js_rangecheck; 
   js_datecheck; 
   js_presencecheck;
end;

procedure js_checksonly is
begin
   js_functions_start;
   js_allchecks;
   js_functions_end;
end;

procedure page_end(cdate varchar2, csignature varchar2) is
begin   
   htp.p('<HR>');
   htp.small(cdate || ' &#160; ' || csignature );
   htp.p('</BODY>');
   htp.p('</HTML>');                                                           
end; 


procedure page_start(ctitle in char) is
begin
   htp.p('<!doctype html public "-//W3C//DTD HTML 4.0//FI">'); 
   htp.title(ctitle);                                 
end;
                                                                       
end;

/
show errors
set define on
exit