If you send me an email, I'll be happy to email you the source.
*
* AGO .START
* C:\USERS\LIN\DOCUMENTS\Z390CODE\UTLPRINT
* SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\UTLPRINT
* SET IN=%G%.PRN
* SET OUT=%G%.OUTPUT.OUT.TXT
* ASMLG %G%.MLC TIME(1)
*
* NOTE THAT THIS WEIRD STUFF, AND THE EXTRA DCBS,
* WERE USED TO TEST THE CODE ON Z390.
*
* THIS IS A REWRITE OF A PROGRAM THAT I USED 50+ YEARS AGO.
* WHEN IT'S IN A FIXED FONT FILE, THE PROGRAM WILL LOOK FINE.
*
* .START ANOP
UTLPRINT START 0
USING *,13
YREGS
STM 14,12,12(13)
ST 15,8(13)
ST 13,4(15)
LR 13,15
L R1,0(R1)
LH R2,0(R1)
SH R2,=H'1'
BM OPEN
MVC LINE(0),2(R1)
EX R2,*-6
*
QPARM CLC =C'HEX',LINE
BNE NHEX
MVI FLAGHEX,C'H'
MVC LINE,LINE+4
B QPARM
NHEX CLI LINE,C'0'
BL BADPARM
LA R1,LINE
LA R1,1(R1)
CLI 0(R1),C'0'
BNL *-8
LA R2,1(R1)
S R1,=A(LINE+1)
PACK STOPAFT,LINE(0)
EX R1,*-6
MVC LINE,0(R2)
B QPARM
*
BADPARM CLI LINE,C' '
BE OPEN
MVI FLAGHEX,C'Z'
OI RC,12
MVC BADPARMM+16(9),LINE
*
PUSH PRINT
PRINT NOGEN
OPEN OPEN (IN,INPUT,OUT,OUTPUT)
POP PRINT
*
CLI FLAGHEX,C'Z'
BNE LDCB
LM R2,R3,=A(DOC,ENDDOC-4)
PRINTDOC MVC LINE(64),0(R2)
PUT OUT,LINE-1
LA R2,64(R2)
CR R2,R3
BL PRINTDOC
B EOD
*
LDCB LA R1,IN
BAL R9,LISTDCB
LA R1,OUT
BAL R9,LISTDCB
B GET
*
USING IHADCB,1
LISTDCB MVC DCBM+1(3),DCBDDNAM
UNPK DCBM+11(3),DCBRECFM(2)
TR DCBM+11(2),HEX-240
MVI DCBM+13,C','
LH R0,DCBLRECL
CVD R0,16(R13)
OI 23(R13),X'0F'
UNPK DCBM+21(5),21(3,R13)
LH R0,DCBBLKSI
CVD R0,16(R13)
OI 23(R13),X'0F'
UNPK DCBM+35(5),21(3,R13)
PUT OUT,DCBM
BR R9
DROP 1
DCBM DC CL133' ... RECFM=XX, LRECL=..... BLKSIZE=..... '
GET SP STOPAFT,=P'1'
BM EOD
GET IN
ZAP BYTE,=P'0'
AP REC#,=P'1'
OI REC#+5,X'0F'
UNPK LOC+1(7),REC#+2(4)
LR R2,R1
LH R3,DCBLRECL-IHADCB+IN
BCTR R3,0
B LOOP
PUT100 MVC LINE(100),0(R2)
PUT OUT,LOC
BAL R9,QHEX
MVC LOC,SPACES
LA R2,100(R2)
SH R3,=H'100'
LOOP OI BYTE+2,X'0F'
CLI LOC+3,C' '
BNE *+10
UNPK LOC+3(5),BYTE
AP BYTE,=P'100'
*
CLI BYTE+1,X'10' 00500C
BE PUTDEL
CLI BYTE+1,X'60'
BNE NODEL
PUTDEL PUT OUT,DELIM
*
NODEL CH R3,=H'100'
BH PUT100
MVC LINE,LINE-1
MVC LINE(0),0(R2)
EX R3,*-6
PUT OUT,LOC
BAL R9,QHEX
B GET
*
HEXMVC1 MVC HEXLINE(0),LINE
HEXTR1 TR HEXLINE(0),HEXF0
HEXMVC2 MVC HEXLINE(0),LINE
HEXTR2 TR HEXLINE(0),HEX0F
*
QHEX CLI FLAGHEX,C'H'
BNER R9
LA R4,99
CR R4,R3
BL *+6
LR R4,R3
*
EX R4,HEXMVC1
EX R4,HEXTR1
PUT OUT,HEXLINEP
*
EX R4,HEXMVC2
EX R4,HEXTR2
PUT OUT,HEXLINEP
*
MVC HEXLINE,HEXLINE-1
PUT OUT,HEXLINEP
BR R9
*
HEXF0 DC 16C'0',16C'1',16C'2',16C'3',16C'4',16C'5',16C'6',16C'7'
DC 16C'8',16C'9',16C'A',16C'B',16C'C',16C'D',16C'E',16C'F'
HEX0F DC 16C'0123456789ZBCDEF'
HEXLINEP DC CL9' '
HEXLINE DC CL133' '
*
EOD MVC LINE,LINE-1
OI REC#+5,X'0F'
UNPK LINE+1(11),REC#
MVC LINE+13(13),=C'RECORDS READ'
PUT OUT,LINE
CLOSE (IN,,OUT)
SR R15,R15
IC R15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
LTORG
FLAGHEX DC C' '
RC DC X'00'
HEX DC C'0123456789ABCDEF'
*
REC# DC PL6'0'
BYTE DC PL3'0'
STOPAFT DC PL8'99999999999999'
LOC DC C' ....... '
LINE DC CL133' '
DELIM DC CL9' '
DC C'....5...10....5...20....5...30....5...40....5...50'
DC C'....5...60....5...70....5...80....5...90....5..100'
SPACES DC CL33' '
*
* PUSH PRINT
* PRINT NOGEN
* IN DCB DDNAME=IN,DSORG=PS,EODAD=EOD,MACRF=GL,LRECL=212,RECFM=FT
* OUT DCB DDNAME=OUT,DSORG=PS,LRECL=110,RECFM=FT,MACRF=PM,
* POP PRINT
*
IN DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL
OUT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,LRECL=110,RECFM=FB,MACRF=PM
*
DOC DC CL64'UTLPRINT ASM &SYSDATE AT &SYSTIME PRINTS A FILE'
BADPARMM DC CL64' INVALID PARM, (.........) '
DC C'//UTLPRINT EXEC PGM=UTLPRINT ,PARM="HEX,##" '
DC C'//STEPLIB DD DISP=SHR,DSN= '
DC C'//OUT DD SYSOUT=* '
DC C'//IN DD DISP=SHR,DSN= '
DC C' --- OR --- '
DC C'//IN DD DISP=SHR,RECFM=U,LRECL=32767.BLKSIZE=32767,DSN= '
DC C' WOULD PRINT CONTENTS OF FILE W/O FORMATTING '
DC C' '
DC C'PARM=HEX PRINTS THE HEX CHARACTERS '
DC C'PARM=### LIMITS THE OUTPUT. PARM="12" PRINTS THE FIRST 12 RECS'
ENDDOC EQU *
DCBD DEVD=DA
END UTLPRINT