MACRO                                                                  
&NAME    POS &FIELD,&X                                                          
* *********************************************************************         
*                              P O S                                  *         
*                                                                     *         
*        This macro will return the position of a passed character    *         
*        within a string. By default this will a x'40'                *         
*                                                                     *         
*        By using space as the 'end' character you can determine      *         
*        the length of a word in a string.                            *         
*                                                                     *         
*        The length of the string is returned in register 15          *         
*                                                                     *         
* *********************************************************************         
         LCLC  &CHAR                                                            
         GBLB  &LENGTH                                                          
         GBLA  &LN                                                              
         AIF   (K'&FIELD NE 0).OK                                               
         MNOTE 12,'***** No field specified *****'                              
         AGO   .EXIT                                                            
.OK      ANOP                                                                   
         AIF   ('LN' GT '1').GO2                                                
&LN      SETA  1                                                                
.GO2     ANOP                                                                   
         AIF   (K'&X NE 0).SETOK                                                
         MNOTE 0,'***** No end character specified. Space assumed'              
&CHAR    SETC  '40'                                                             
         AGO   .CONT                                                            
.SETOK   ANOP                                                                   
&CHAR    SETC  '&X'                                                             
.CONT    ANOP                                                                   
         AIF   (K'&CHAR LT 3).SETOK2                                            
         MNOTE 12,'***** Length error on passed character ******'               
         AGO   .EXIT                                                            
.SETOK2  ANOP                                                                   
         AIF   (&LENGTH).SKIPPY                                                 
         B     ASLLX&LN               Skip workarea                             
*                                                                               
*                     P O S    W O R K A R E A                                  
LNREG2   DS    F                                                                
         DS    0H                                                               
&LENGTH  SETB  1                      Set flag for one time defines             
*                                                                               
.SKIPPY  ANOP                                                                   
ASLLX&LN DS   0H                                                                
         AIF   (K'&Name EQ 0).SKIPNAME                                          
&NAME    DS    0H                                                               
.SKIPNAME ANOP                                                                  
         ST    R2,LNREG2              Save register 2                           
         XR    15,15                  Clear counter                             
         LA    2,&FIELD               Point to passed area                      
         LA    1,L'&FIELD             Load length of area into R1               
ASLLN&LN DS    0H                                                               
         AIF   (K'&CHAR EQ 1).SKIPCLI                                           
         CLI   0(2),X'&CHAR'          Match for string yet?                     
         AGO   .BRANCH                                                          
.SKIPCLI ANOP                                                                   
         CLI   0(2),C'&CHAR'          Match for string yet?                     
.BRANCH  ANOP                                                                   
         BE    END&LN                 Yes - Go to exit                          
         LA    15,1(15)               Increase counter                          
         LA    2,1(2)                 Next character                            
         BCT   1,ASLLN&LN             Loop back                                 
         LA    15,L'&FIELD            Set length to full field                  
END&LN   DS    0H                                                               
         LA    15,1(15)               Increase counter                          
         L     R2,LNREG2              Reload register 2                         
.EXIT    ANOP                                                                   
&LN      SETA  &LN+1                                                            
         MEXIT                                                                  
*                                                                     *         
*  Copyright - Abbydale Systems LLC.                                  *         
* *********************************************************************         
         MEND