digrt: Proc Options(main);
 /* REXX ***************************************************************
 * Test digroot
 **********************************************************************/

 Call digrtst('7');
 Call digrtst('627615');
 Call digrtst('39390');
 Call digrtst('588225');
 Call digrtst('393900588225');

 digrtst: Proc(n);
 Dcl n Char(100) Var;
 Dcl dr Pic'9';
 Dcl p  Dec Fixed(5);
 Call digroot(n,dr,p);
 Put Edit(n,dr,p)(skip,a,col(20),f(1),f(3));
 End;

 digroot: Proc(n,dr,p);
 /**********************************************************************
 * Compute the digital root and persistence of the given decimal number
 * 27.07.2012 Walter Pachl (derived from REXX)
 **********************************************************************/
 Dcl n Char(100) Var;
 Dcl dr Pic'9';
 Dcl p  Dec Fixed(5);
 Dcl s  Pic'(14)Z9';
 Dcl v  Char(100) Var;
 p=0;
 v=strip(n);                         /* copy the number               */
 If length(v)=1 Then
   dr=v;
 Else Do;
   Do While(length(v)>1);            /* more than one digit in v      */
     s=0;                            /* initialize sum                */
     p+=1;                           /* increment persistence         */
     Do i=1 To length(v);            /* loop over all digits          */
       dig=substr(v,i,1);            /* pick a digit                  */
       s=s+dig;                      /* add to the new sum            */
       End;
   /*Put Skip Data(v,p,s);*/
     v=strip(s);                     /* the 'new' number              */
     End;
   dr=Decimal(s,1,0);
   End;
 Return;
 End;

 strip: Proc(x) Returns(Char(100) Var);
 Dcl x Char(*);
 Dcl res Char(100) Var Init('');
 Do i=1 To length(x);
   If substr(x,i,1)>' ' Then
     res=res||substr(x,i,1);
   End;
 Return(res);
 End;
 End;