Pascal/Turbo Pascal - NUMERO KAPREKAR

Hola, tengo una duda sobre el siguiente programa del numero kaprekar: http://es.wikipedia.org/wiki/N%C3%BAmero_de_Kaprekar
Solo me faltan los procedures 'descomponer' y 'escribir cabecera', alguien que me ayude? (agradeceria que me respondiesen justo sobre este programa, la duda concreta que tengo, no que hagan otro distinto. Si hay otro fallo en el resto del programa avisadme. muchas gracias).

PROGRAM KapreKar;

USES crt;


PROCEDURE obtener_num_valido ({S} VAR n: integer);
BEGIN Repeat write ('dime un numero de 4 digitos no todos iguales: ');
readln
Until (n>0) and (n<9999) and (n mod 1111<>0)
END;

PROCEDURE escribir_cabecera;


PROCEDURE calcular_siguiente ({E/S} VAR n: integer);
VAR mayor, menor: integer;
d0, d1, d2, d3: integer;

PROCEDURE intercambiar ( VAR aux, di, dj: integer);
BEGIN aux:=di; di:=dj; dj:= aux;
END;

PROCEDURE ordenar ({E/S} d3, d2, d1, d0: integer);
BEGIN If d3<d2 Then intercambiar (d3,d2);
If d2<d1 Then intercambiar (d2,d1);
If d1<d0 Then intercambiar (d1,d2); {d0 es el menor}
If d3<d2 Then intercambiar (d3,d2);
If d2<d1 Then intercambiar (d2,d1); {en el siguiente menor}
If d3<d2 Then intercambiar (d3,d2);
END;

PROCEDURE descomponer ({E} VAR n: integer; {S} VAR d3,d2,d1,d0: integer);
BEGIN d3:= n div 1000;
d2:= (n div 100) mod 10;
d1:= (n div 10) mod 10;
d0:= n mod 10
END;

BEGIN descomponer (n,d3,d2,d1,d0);
ordenar(d3,d2,d1,d0); {devuelve d3>=d2>=d1>=d0}
componer (mayor,d3,d2,d1,d0);
componer (menor,d0,d1,d2,d3);
writeln(n:6, mayor, menor:8, mayor-menor:8); n:=mayor-menor
END;


VAR n: integer;
anterior: integer;

BEGIN
obtener_num_valido(n);
escribir_cabecera;
repeat anterior:=n;
calcular_siguiente(n)
until anterior=n;
END.

uses crt;

var
numero: longint;
con : integer;
verdad : boolean ;
cad1 , cad2 : string;
res : char;

(********************************************)
(* Esta funcion eleva un numero al cuadrado *)
(********************************************)
function cuadrado(nn: longint): longint;
begin
cuadrado := nn * nn ;
end;

(************************************************)
(* Esta funcion transforma una cadena en entero *)
(************************************************)
function cad_num(ss: string): longint;
var
i : longint;
code : integer ;
begin
Val(ss, i, code);
cad_num := i;
end;

(************************************************)
(* Esta funcion transforma un unumero a cadena *)
(************************************************)
function num_cad(nn:longint): string;
var
I : longint;
S : string ;
begin
Str(nn, S);
num_cad := S;
end;


(***************************************)
(* Extrae una subcadena de una cadena *)
(***************************************)

function extraer(S:string; inicio,final:integer): string ;
var
cad : string;
begin
cad := '';
cad := copy(S,inicio,final);
extraer := cad ;
end;


(************************************************)
(* Devuelve verdadero si el numero es Kaprekar *)
(************************************************)
function sieskasper(str1,str2 : string ; nn:longint): boolean;
var
xx : longint;

begin
xx := 0 ;
verdad := false ;
if (cad_num(str2) > 0) then
begin
xx := cad_num(str1) + cad_num(str2) ;
if (xx = nn) then
begin
verdad := true ;
end;
end;
sieskasper := verdad ;
end;


(*************************)
(* programa principal *)
(*************************)

begin
clrscr;
res := 'S';
repeat

repeat
clrscr;
gotoxy(10,10);
writeln('Ingresar un numero: ');
gotoxy(30,10);
readln(numero);
until (numero>=1) and (numero<= 45000);


con := 0;
verdad := false;
repeat
inc(con);
cad1 := '';
cad2 := '';
if (numero = 1) then
begin
verdad := true;
end
else
begin
cad1 := extraer(num_cad(cuadrado(numero)),1,con);
cad2 := extraer(num_cad(cuadrado(numero)),con+1,length(num_cad(cuadrado(numero))));
sieskasper(cad1,cad2 ,numero);
end;
until (con = (length(num_cad(cuadrado(numero)))-1)) or (verdad) ;



if (verdad) then
begin
gotoxy(10,12);
write('El numero : ' ,numero , ' si es kaprekar ');
end
else
begin
gotoxy(10,12);
write('El numero : ' ,numero , ' no es kaprekar ');
end;

gotoxy(10,16);
write('Desea Continuar [S/N]: ');
res := upcase(readkey);

until (res <> 'S');




end.