*process source attributes xref or(!) options nest;
 abc: Proc Options(main);
 /* REXX --------------------------------------------------------------
 * 10.01.2013 Walter Pachl  counts the number of possible ways
 * translated from Rexx version 2
 *-------------------------------------------------------------------*/

 Dcl (ADDR,HBOUND,INDEX,LEFT,LENGTH,MAX,SUBSTR,TRANSLATE) builtin;
 Dcl sysprint Print;
 Dcl (i,j,k,m,mm,wi,wj,wlen,ways,lw) Bin Fixed(15);
 Dcl blocks(20) Char(2)
        Init('BO','XK','DQ','CP','NA','GT','RE','TG','QD','FS','JW',
             'HU','VI','AN','OB','ER','FS','LY','PC','ZM');
 Dcl blk Char(2);
 Dcl words(8) Char(7) Var
        Init('$','A','baRk','bOOk','trEat','coMMon','squaD','conFuse');
 Dcl word     Char(7) Var;
 Dcl c Char(1);
 Dcl (show,cannot) Bit(1) Init('0'b);
 Dcl poss(100,0:100) Pic'99';  poss=0;
 Dcl s(20,100) char(100) Var;
 Dcl str Char(100);
 Dcl 1 *(30) Based(addr(str)),
      2 strp Pic'99',
      2 * Char(1);
 Dcl ns(20) Bin Fixed(15) Init((20)0);
 Dcl ol(100) Char(100) Var;
 Dcl os      Char(100) Var;
 wlen=0;
 Dcl lower Char(26) Init('abcdefghijklmnopqrstuvwxyz');
 Dcl upper Char(26) Init('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
 Do wi=1 To hbound(words);
   wlen=max(wlen,length(words(wi)));
   End;
 Do wi=1 To hbound(words);
   word = translate(words(wi),upper,lower);
   ways=0;
   lw=length(word);
   cannot='0'b;
   poss=0;
   ns=0;
   ol='';
 iloop:
   Do i=1 To lw;                       /* loop over the characters   */
     c=substr(word,i,1);               /* the current character      */
     Do j=1 To hbound(blocks);         /* loop over blocks           */
       blk=blocks(j);
       If index(blk,c)>0 Then Do;  /* block can be used in this pos( */
         poss(i,0)+=1;        /* number of possible blocks for pos i */
         poss(i,poss(i,0))=j;
         End;
       End;
     If poss(i,0)=0 Then Do;
       Leave iloop;
       End;
     End;
   If i>lw Then Do;                     /* no prohibitive character  */
     ns=0;
     Do j=1 To poss(1,0);       /* build possible strings for char 1 */
       ns(1)+=1;;
       s(1,j)=poss(1,j);
       End;
     Do m=2 To lw;        /* build possible strings for chars 1 to i */
       mm=m-1;
       Do j=1 To ns(mm);
         Do k=1 To poss(m,0);
           ns(m)+=1;
           s(m,ns(m))=s(mm,j)!!' '!!poss(m,k);
           End;
         End;
       End;
     Do m=1 To ns(lw);
       If valid(s(lw,m)) Then Do;
         ways+=1;
         str=s(lw,m);
         Do k=1 To lw;
           ol(ways)=ol(ways)!!blocks(strp(k))!!' ';
           End;
         End;
       End;
     End;
 /*--------------------------------------------------------------------
 * now show the result
 *-------------------------------------------------------------------*/
   os=left(''''!!word!!'''',wlen+2);
   Select;
     When(ways=0)
       os=os!!' cannot be spelt.';
     When(ways=1)
       os=os!!' can be spelt.';
     Otherwise
       os=os!!' can be spelt in'!!ways!!' ways.';
     End;
   Put Skip List(os);
   If show Then Do;
     Do wj=1 To ways;
       Put Edit('          '!!ol(wj))(Skip,a);
       End;
     End;
   End;
 Return;

 valid: Procedure(list) Returns(bit(1));
 /*--------------------------------------------------------------------
 * Check if the same block is used more than once -> 0
 * Else: the combination is valid
 *-------------------------------------------------------------------*/
 Dcl list Char(*) Var;
 Dcl i Bin Fixed(15);
 Dcl used(20) Bit(1);
 str=list;
 used='0'b;
 Do i=1 To lw;
   If used(strp(i)) Then
     Return('0'b);
   used(strp(i))='1'b;
   End;
 Return('1'b);
 End;

 End;