*DECK C$ALPCM 
          IDENT  C$ALPCM
          TITLE  CBALPCM - IF ALPHABETIC FOR FIELDS OF > 1 CHAR 
  
          MACHINE   ANY,I 
  
          COMMENT   IF ALHABETIC FOR 1+ CHAR FIELDS 
          SST 
 C.ALPCM  SPACE  4
**        C.ALPCM - IF ALPHABETIC OBJECT ROUTINE FOR 1+ CHAR FLDS 
* 
*                SIMPLY CHECKS EACH CHAR IN THE ITEM TO SEE IF
*                IT IS A - Z OR SPACE.
* 
*         CALLING SEQ:  
*         SB4    BASE ADDR
*         SB5    LENGTH (BYTES) 
*         SB6    OFFSET (IN BYTES)
*         RJ     =XC.ALPCM
* 
*         RETURNS:  
*         B4 = 0 IF TRUE
*              1 IF FALSE 
* 
*         USES: 
*                X  - - - 3 4 5 6 - 
*                A  - - - 3 - - - - 
*                B  - - - 3 4 5 6 7 
* 
*         ENTRY POINTS: 
          ENTRY  C.ALPCM
* 
* 
*         EXTERNALS REFERENCED: 
*         NONE
* 
          SPACE  4
 C.ALPCM  DATA   0
          SB7    10 
          SX4    B6+0 
          LT     B6,B7,IFALPH1     BCP, NOT INDEX 
          SX5    52429
          IX6    X5*X4
          AX6    19          DIVIDE BY 10 
 IFA      IFEQ   OP.MODEL,OP.6400 
          LX5    X6,B1       X6*2 
          SB4    B4+X6       UP BASE ADDR 
          LX6    3           X6*8 
          IX6    X6+X5       X6*10
 IFA      ELSE
          SX5    10 
          SB4    B4+X6       UP BASE ADDR 
          IX6    X6*X5
 IFA      ENDIF 
          IX4    X4-X6       X4 = BCP NOW 
  
 IFALPH1  SB6    1R0
          SB3    X4 
          SA3    B4 
          SB4    B7-B3       10-BCP 
          LT     B4,B5,IFALPH2
          SB4    B5          ONE WORD ITEM
 IFALPH2  SB5    B5-B4       NR CHARS LEFT AFTER THIS WORD
 IFB      IFEQ   OP.MODEL,OP.6400 
          LX6    X4,B1       X4*2 
          LX4    2           X4*4 
          IX4    X4+X6       X4*6 
 IFB      ELSE
          SX6    6
          IX4    X4*X6
 IFB      ENDIF 
          SX6    77B         MASK 
          SB3    X4          SHIFT COUNT
          LX3    X3,B3       L. JUST X3 
  
 ALPLOOP  ZR     B4,GETNXT   NOTHING LEFT IN WORD 
          LX3    6
          BX4    X3*X6       MASK OFF CHAR
          ZR     X4,NOTALPH  COLON IS NOT ALHABETIC 
          SB3    X4 
          SB4    B4-B1
          LT     B3,B6,ALPLOOP     OK CHAR...LOOP 
          SX4    X4-1R
          ZR     X4,ALPLOOP  BLANK IS OK
 NOTALPH  SB4    1           SET FALSE
          EQ     C.ALPCM
  
 GETNXT   ZR     B5,DONE
          SB4    B7 
          SA3    A3+B1       GET NEXT WORD
          GE     B5,B7,GTNXT1 
          SB4    B5          SHORT WORD 
          SB5    B7 
 GTNXT1   SB5    B5-B7
          EQ     ALPLOOP
  
 DONE     SB4    B0          SET TRUE 
          EQ     C.ALPCM
  
          END 
