Retro1.org codex

*DECK NXZFN 
USETEXT NIPDEF
FUNC NXZFN(ZNAME)C(10); 
*IF DEF,IMS 
 #
*1DC  XZFN
* 
*     1. PROC NAME           AUTHOR              DATE 
*        XZFN                M. D. PICKARD       77/03/12 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        CHANGE BLANKS TO ZEROS IN A TEN CHARACTER FIELD
* 
*     3. METHOD USED
*        STEP THROUGH THE WORD TO BE ZERO FILLED ONE CHARACTER AT A TIME
*        WHEN ONE IS FOUND TO BE BLANK CHANGE IT AND THE REMAINING
*        CHARACTERS TO ZERO. IF THE ENTRIRE WORD IS SCANNED WITHOUT 
*        FINDING ANY BLANKS DO NOTHING. 
* 
*     4. ENTRY PARAMETERS 
*        ZNAME               10 CHARACTER NAME TO BE ZERO FILLED
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMDECKS CALLED
*        NONE 
* 
*     7. ROUTINES CALLED
*        NONE 
* 
*     8. DAYFILE MESSAGES 
*        NONE 
 #
*ENDIF
# TITLE NXZFN - ZERO-FILLED NAME.                                   # 
 
      BEGIN    # NXZFN #
# 
**    NXZFN - ZERO-FILLED NAME. 
* 
*     J.C. LEE    1981
* 
*     THIS IS A UTILITY FUNCTION SUBPROGRAM.
*     ITS FUNCTION IS TO ZERO FILL A NAME.
* 
*     FUNC(ZNAME) C(10) 
* 
*     ENTRY:  
*       ZNAME - NAME TO BE ZERO FILLED. 
* 
*     EXIT: 
*       NONE. 
* 
*     METHOD: 
*       SEARCH FOR THE FIRST BLANK WITHIN THE NAME. 
*       WHEN FOUND, ZERO REMAINING CHARACTERS STARTING
*       FROM THIS FIRST BLANK.
* 
# 
      ITEM ZNAME      C(10);           # NAME TO ZERO FILL             #
      ITEM I          U;               # LOOP VARIABLE                 #
      ITEM ZEROED     B;               # LOOP END INDICATOR            #
CONTROL EJECT;
      ZEROED = FALSE;        # INITIALIZE END INDICATOR                #
      FOR I=0 STEP 1 WHILE NOT ZEROED 
        AND I LS WC 
      DO
        BEGIN 
        IF C<I,1>ZNAME EQ " " 
        THEN
          BEGIN 
          B<I*6,60-(I*6)>ZNAME = 0; # ZERO REMANING CHARACTERS         #
          ZEROED = TRUE;     # DEED IS DONE                            #
          END 
        END 
      NXZFN = ZNAME;         # PASS BACK AS FUNCTION                   #
      RETURN; 
      END # XZFN #
      TERM