COMCSNM 
COMMON
          CTEXT  COMCSNM - SET NAME IN MESSAGE. 
          SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCSNM
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       SNM - SET NAME IN MESSAGE.
*         J. L. LARSON.      77/01/14.
 SNM      SPACE  4,10 
***              SNM REPLACES OCCURANCES OF THE SEARCH CHARACTER
*         WITHIN A MESSAGE OR LINE WITH THE CHARACTERS OF THE GIVEN 
*         NAME OR NUMBER, ELIMINATING ALL EXCESS OCCURANCES OF THE
*         SEARCH CHARACTER, AND GUARENTEEING END OF LINE IN THE NEW 
*         MESSAGE.  THE ORIGINAL MESSAGE MUST CONTAIN A SUFFICIENT
*         NUMBER OF SEARCH CHARACTERS (USUALLY CONSECUTIVE) TO ALLOW
*         FOR REPLACEMENT BY THE NAME OR NUMBER (UP TO 10 CHARACTERS).
*         THE MESSAGE MUST NOT CONTAIN COLONS (00B) SINCE THEY WILL 
*         BE INTERPRETTED AS EOL. 
* 
*         ENTRY  (B1) = 1.
*                (B2) = DISPLAY CODE SEARCH CHARACTER,
*                       RIGHT JUSTIFIED, BINARY ZERO FILLED.
*                (B3) = OPTIONAL ADDRESS OF ASSEMBLY AREA.
*                (B5) = FWA MESSAGE.
*                (B5) .LT. 0, USE (B3) AS ADDRESS OF ASSEMBLY AREA. 
*                (X1) = DISPLAY CODE NAME TO BE SET IN MESSAGE, 
*                       LEFT JUSTIFIED, BINARY ZERO FILLED. 
* 
*         EXIT   (A7) = LWA OF NEW MESSAGE. 
*                NAME ENTERED INTO MESSAGE IN PLACE OF SEARCH 
*                CHARACTERS.
* 
*         USES   A - 4, 7.
*                B - 3, 4.
*                X - 1, 2, 3, 4, 6, 7.
  
  
 SNM4     SX2    B4          INSURE EVEN NUMBER OF CHARACTERS 
          LX2    -1 
          PL     X2,SNM6     IF NOT ODD NUMBER OF CHARACTERS
          SX3    1R 
          BX2    -X6*X7 
          IX2    X2-X3
          NZ     X2,SNM5     IF LAST CHARACTER NOT BLANK
          AX7    6           REMOVE TRAILING BLANK
          SB4    B4+B1
          EQ     SNM6        LEFT JUSTIFY LAST WORD OF NEW MESSAGE
  
 SNM5     LX7    6           ADD TRAILING BLANK 
          SB4    B4-1 
          BX7    X3+X7
 SNM6     SB4    B4+B4       LEFT JUSTIFY LAST WORD OF NEW MESSAGE
          SB3    B4+B4       CALCULATE SHIFT COUNT
          MX2    -12
          SB4    B3+B4
          LX7    X7,B4
          SA7    A7+1 
          BX2    -X2*X7 
          ZR     X2,SNMX     IF END OF LINE SET 
          BX7    X7-X7       GUARANTEE END OF LINE
          SA7    A7+B1
  
 SNM      SUBR               ENTRY/EXIT 
          SB4    -B5         MESSAGE AREA 
          SX2    B3-B1       ASSEMBLY AREA - 1
          MX6    -6 
          SB3    B0 
          NG     B5,SNM0     IF MESSAGE ASSEMBLY AREA SPECIFIED 
          SB4    B5          MESSAGE AREA 
          SX2    B5-B1       SET ASSEMBLY AREA = MESSAGE AREA 
 SNM0     SA4    X2          PRESET ASSEMBLY AREA 
          BX7    X4 
          SA7    A4+         (A7) = ASSEMBLY AREA - 1 
          BX7    X7-X7
          SA4    B4-B1       (A4) = MESSAGE AREA - 1
          SB4    10 
 SNM1     SB3    B3-B1       DECREMENT OLD MESSAGE WORD CHARACTER COUNT 
          SX3    B2 
          PL     B3,SNM2     IF MORE CHARACTERS IN OLD MESSAGE WORD 
          SA4    A4+1        GET NEXT WORD IN ORIGINAL MESSAGE
          SB3    9           RESET OLD MESSAGE WORD CHARACTER COUNT 
 SNM2     LX4    6           GET NEXT CHARACTER FROM ORIGINAL MESSAGE 
          BX2    -X6*X4 
          ZR     X2,SNM4     IF END OF LINE 
          IX3    X2-X3
          NZ     X3,SNM3     IF NOT SEARCH CHARACTER
          LX1    6
          ZR     X1,SNM1     IF REPLACEMENT ALREADY COMPLETED 
          BX2    -X6*X1      GET NEXT CHARACTER FROM SPECIFIED NAME 
          BX1    X6*X1
 SNM3     LX7    6           ENTER NEXT CHARACTER INTO NEW MESSAGE WORD 
          BX7    X7+X2
          SB4    B4-1        DECREMENT NEW MESSAGE WORD CHARACTER COUNT 
          GT     B4,SNM1     IF NEW MESSAGE WORD NOT FULL 
          SA7    A7+B1       SAVE NEW MESSAGE WORD
          BX7    X7-X7
          SB4    10          RESET NEW MESSAGE WORD CHARACTER COUNT 
          EQ     SNM1        CONTINUE BUILDING NEW MESSAGE
          SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 SNM      EQU    /COMCSNM/SNM 
 QUAL$    ENDIF 
 SNM      ENDX
