mdrt: Proc Options(main);
 Dcl (x,p,r) Bin Fixed(31);
 Put Edit('number   persistence   multiplicative digital root')(Skip,a);
 Put Edit('-------  -----------   ---------------------------')(Skip,a);
 Call task1(123321);
 Call task1(  7739);
 Call task1(   893);
 Call task1(899998);

 task1: Procedure(x);
 Dcl x Bin Fixed(31);
 Call mdr(x,p,r);
 Put Edit(x,p,r)(Skip,f(8),f(8),f(22));
 End;

 Dcl zn(0:9) Bin Fixed(31);
 Dcl z(0:9,5) Bin Fixed(31);
 zn=0;
 zn(0)=1;
 z(0,1)=0;
 Do x=1 To 11111;
   Call mdr(x,p,r);
   If zn(r)<5 Then Do;
     zn(r)+=1;
     z(r,zn(r))=x;
     End;
   End;
 Put Edit(' ')(Skip,a);
 Put Edit('MDR  first 5 numbers that have a matching MDR')(Skip,a);
 Put Edit('---  ----------------------------------------')(Skip,a);

 Do r=0 To 9;
   Put Edit(r,'  ')(Skip,f(3),a);
   Do i=1 To 5;
     Put Edit(z(r,i))(f(6));
     End;
   End;

 mdr: Procedure(y,p,r);
 Dcl (y,p,r) Bin Fixed(31);
 Dcl (k,yy) Bin Fixed(31);
 Dcl pic Pic'(10)9';
 Dcl d   Pic'9';
 pic=abs(y);
 Do p=1 By 1 Until(pic<10);
   Do k=1 To 10 Until(substr(pic,k,1)>'0');
     End;
   r=1;
   Do k=k To 10;
     d=substr(pic,k,1);
     r=r*d;
     End;
   pic=r;
   End;
 End;
 End;