SVXLIST: PROC(STADR,LENG,ID);
    /* THIS ROUTTINE DUMPS A RECORD OF LENGTH "LENG" STARTING AD ADDRESS
    	"STADR" IN SAS FORMAT ("LIST") STATEMENT.  "ID" IS THE RECORD NUMBER.
 
    	MARK 1 T DOW 9/15/81 */

    DCL STADR PTR;
    DCL LENG FIXED BIN(31);
    DCL ID CHAR(5);

    /* THESE ARE REALLY GLOBAL VARIABLES DEFINED EXTERNALLY */
    DCL 1 SVX_COM EXTERNAL,
        2 LINESLEFT FIXED BIN(31),
        2 PAGESIZE FIXED BIN(31),
        2 FOLDSIZE FIXED BIN(31), /*TEST=50, NORMALLY 100*/
        2 UPPER BIT (1); /*1=ONLY UPPER CASE, 0=ALSO LOWER*/

    DCL UPCH CHAR (64) STATIC INIT(
   ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_');
    DCL UPLOCH CHAR(95) STATIC INIT(
   ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
`abcdefghijklmnopqrstuvwxyz{|}~');
    DCL UPTRANS CHAR(256) STATIC INIT ('................................
 !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
................................................................
................................................................
................................................................');
    DCL LOTRANS CHAR(256) STATIC INIT ('................................
 !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
`abcdefghijklmnopqrstuvwxyz{|}~
................................................................
................................................................
.................................');

    DCL START PTR,
    	STARB FIXED BIN(31) DEF START;
    DCL HERE_LENG FIXED BIN(31);
    DCL (NLINES,TLINES,MAXAD,POSCOUNT,FP12,I,RULELENG) FIXED BIN(31);
    DCL ARAY(120) CHAR(1) BASED(START);
    DCL AR CHAR(120) BASED(START);

    DCL PLINTOT CHAR(133), /*PRINT LINE, WITH CC IN POS 1*/
    	PLINCC CHAR(1) DEF (PLINTOT),
    	PLIN CHAR(132) DEF(PLINTOT) POS(2),
    	PLINAR(133) CHAR(1) DEF (PLINTOT);
    DCL VERTAB CHAR(95) VARYING;
    DCL TRANTAB CHAR(256);

    /***** ENTER HERE *****/
    IF UPPER THEN DO;
    	VERTAB = UPCH;
    	TRANTAB = UPTRANS;
    END;
    ELSE DO;
    	VERTAB = UPLOCH;
    	TRANTAB = LOTRANS; /* THIS WOULD BE DONE EXTERNALLY, OR INITIALLY*/
    END;
    RULELENG = FOLDSIZE;
    FP12 = FOLDSIZE + 12;
    START = STADR;
    MAXAD = STARB + LENG;
    POSCOUNT = 1;
    DO WHILE (STARB < MAXAD);
	HERE_LENG = MIN(MAXAD-STARB,FOLDSIZE);
	PLINTOT = ' ';
	IF VERIFY(SUBSTR(AR,1,HERE_LENG),VERTAB) = 0 THEN DO;
	    /*ALL CHARS ARE PRINTABLE*/
	    NLINES=1;
	    IF START = STADR THEN TLINES=2;
	    ELSE TLINES=1;
	END;
	ELSE DO;
	    NLINES=3;
	    TLINES = 4;
	END;
	IF (LINESLEFT-TLINES) <= 0 THEN CALL PRINT_RULE;
	IF TLINES > 1 THEN PLINCC = '0'; /*SKIP A LINE*/
	SUBSTR(PLINTOT,14,HERE_LENG) = TRANSLATE(SUBSTR(AR,1,HERE_LENG),
			                            TRANTAB);
    	IF (POSCOUNT>1) | (NLINES=1 & LENG>FOLDSIZE) THEN DO;
	  PUT STRING(SUBSTR(PLINTOT,8,5)) EDIT(POSCOUNT)(F(5));
          DO WHILE (SUBSTR(PLINTOT,8,1)=' ');
            SUBSTR(PLINTOT,8,5) = SUBSTR(PLINTOT,9,4);
    	  END;
        END;
    	ELSE IF POSCOUNT=1 & NLINES>1 THEN SUBSTR(PLINTOT,8,5) = 'CHAR ';
    	/*ELSE SUBSTR(PLINTOT,8,5) = ' '*/
	IF START=STADR THEN SUBSTR(PLINTOT,2,5) = ID;
	CALL PRINT_LINE;
	IF NLINES > 1 THEN DO;
	    PLINTOT = ' ';
	    SUBSTR(PLINTOT,8,5) = 'ZONE ';
	    DO I = 1 TO HERE_LENG;
	        PLINAR(I+13) = ZONE_NIB(ARAY(I));
	    END;
	    CALL PRINT_LINE;
	    PLINTOT = ' ';
	    SUBSTR(PLINTOT,8,5) = 'NUMR ';
	    DO I = 1 TO HERE_LENG;
	    	PLINAR(I+13) = NUMR_NIB(ARAY(I));
	    END;
	    CALL PRINT_LINE;
	END;
	STARB = STARB + FOLDSIZE;
	POSCOUNT = POSCOUNT + FOLDSIZE;
    END;

    PRINT_LINE: PROC;
    DCL(I,HH) FIXED BIN(31);
    IF PLINCC = '0' THEN DO;
    	PUT EDIT (PLINAR(2))(SKIP(2),A);
    	LINESLEFT = LINESLEFT - 1;
    END;
    ELSE PUT SKIP EDIT (PLINAR(2))(A);
    HH = HERE_LENG + 14;
    DO I = 3 TO HH;
    	PUT EDIT (PLINAR(I))(A);
    END;
    LINESLEFT = LINESLEFT - 1;
  END PRINT_LINE;

  ZONE_NIB: PROC(A) RETURNS(CHAR(1));
    DCL (A,B) CHAR(1);
    DCL C CHAR(1),
    	CB BIT(8) DEF(C);
    DCL X BIT(4);
    DCL D FIXED BIN(15),
        DB BIT(16) DEF (D);
    DCL TX (0:15)CHAR(1)  STATIC INIT('0','1','2','3','4','5','6','7','8','9',
                                   'A','B','C','D','E','F');
    
    C = A;
    X = SUBSTR(CB,5,4);
    DB = X ||'00000000000'B;
    B = TX(D);
    RETURN(B);
  END ZONE_NIB;

  NUMR_NIB: PROC(A) RETURNS(CHAR(1));
    DCL (A,B) CHAR(1);
    DCL C CHAR(1),
    	CB BIT(8) DEF(C);
    DCL X BIT(4);
    DCL D FIXED BIN(15),
        DB BIT(16) DEF (D);
    DCL TX(0:15)CHAR(1) STATIC INIT('0','1','2','3','4','5','6','7','8','9',
                                   'A','B','C','D','E','F');
    
    C = A;
    X = SUBSTR(CB,1,4);
    DB = X ||'00000000000'B;
    B = TX(D);
    RETURN(B);
  END NUMR_NIB;

  PRINT_RULE: PROC;
    DCL RULER CHAR(120) STATIC INIT
      ('----+----1----+----2----+----3----+----4----+----5----+----6
----+----7----+----8----+----9----+----0----+----1----+----2');
    DCL K FIXED BIN(31);
    PLINTOT = ' ';
    SUBSTR(PLINTOT,2,5) = 'RULE:';
    SUBSTR(PLINTOT,14,RULELENG) = RULER;
    PLINCC = '1';
    PUT PAGE EDIT (PLINAR(2))(A);
    DO K = 3 TO RULELENG+13;
    	PUT EDIT (PLINAR(K))(A);
    END;
    LINESLEFT = PAGESIZE - 1;
    PLINTOT = ' ';
    CALL PRINT_LINE;
  END PRINT_RULE;

  END SVXLIST;