QLRECL
If you'd like a copy, send me an email, and I'll send it to you.
Stupid google sites inserts blank lines when you copy+paste.
Anyone know how to avoid that?
QLRECL START 0
USING *,13
DS XL72
ORG QLRECL
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 PARM(0),2(R1)
EX R2,*-6
B OPEN
ORG
*
TBL DC H'80',CL4'80'
DC H'81',CL4'81'
DC H'120',CL4'120'
DC H'121',CL4'121'
DC H'132',CL4'132'
DC H'133',CL4'133'
DC X'FF'
PARM DC CL133' '
SPACES DC CL133' '
DS 0D
*
PUSH PRINT
* PRINT NOGEN
OPEN OPEN (I,INPUT,OUT,OUTPUT)
POP PRINT
PUT OUT,IDMSG
LA R7,7
SR R8,R8
CLI PARM,C' '
BE GET
LA R2,TBL
LA R3,PARM
PARMLOOP PUT OUT,(3)
CLI 0(R3),C'0'
BL BADPARM
LR R1,R3
LA R1,1(R1)
CLI 0(R1),C'0'
BNL *-8
LR R4,R1
SR R4,R3
BCTR R4,0
MVC 0(6,R2),SPACES
MVC 2(0,R2),0(R3)
EX R4,*-6
PACK 16(8,R13),0(0,R3)
EX R4,*-6
CVB R0,16(R13)
STH R0,0(R2)
LA R2,6(R2)
LA R3,1(R1)
CLI 0(R3),C' '
BNE PARMLOOP
MVI 0(R2),X'FF'
B GET
SKIP AP #SKIP,=P'1'
GET GET I
AP #REC,=P'1'
SR R2,R2
LH R3,DCBLRECL-IHADCB+I
CR R8,R3
BE SKIP
LR R8,R3
STM R2,R3,DW+8
CVD R3,DW
OI DW+7,X'0F'
UNPK MSG+48(5),DW+5(3)
LA R4,TBL
LOOP LM R2,R3,DW+8
LH R0,0(R4)
DR R2,R0
MVC MSG+7(3),2(R4)
CVD R3,DW
OI DW+7,X'0F'
UNPK MSG+19(3),DW+6(2)
CVD R2,DW
OI DW+7,X'0F'
UNPK MSG+35(3),DW+6(2)
CLC =C'000',MSG+35
BNE *+8
MVI MSG+56,C'*'
PUT OUT,MSG
MVI MSG+56,C' '
LA R4,6(R4)
CLI 0(R4),0
BE LOOP
PUT OUT,SPACES
BCT R7,GET
B Z
MSG DC CL133' LRECL= QUOTION= REMAINDER= BLKSIZE='
BADPARMM DC CL133'BAD PARM, CAN ONLY CONTAIN ##,###,### USED TO TESTX
BLOCK LENGTHS FOR LIKELY LRECL VALUES'
BADPARM PUT OUT,BADPARMM
Z OI #SKIP+3,X'0F'
OI #REC+3,X'0F'
UNPK READMSG+1(7),#REC
UNPK SKIPMSG+1(7),#SKIP
PUT OUT,READMSG
CLOSE (I,,OUT)
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
LTORG
*
#SKIP DC PL4'0'
#REC DC PL4'0'
READMSG DC C' ....... BLOCKS READ,'
SKIPMSG DC CL111' ....... HAD DUPLICATE LENGTHS '
DW DC 2D'0'
IDMSG DC CL133' QLRECL, ASM &SYSDATE AT &SYSTIME ANALYZE FILE FORX
LIKELY LRECL. DEFAULT= PARM=80,81,120,121,132,133'
* PUSH PRINT
* PRINT NOGEN
* I DCB DDNAME=IN,DSORG=PS,EODAD=Z,MACRF=GL,LRECL=266,RECFM=FT
* OUT DCB DDNAME=OUT,DSORG=PS,LRECL=110,RECFM=FT,MACRF=PM,
* POP PRINT
*
I DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL,BLKSIZE=32767,RECFM=U,EODAD=Z
OUT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,LRECL=110,RECFM=FB,MACRF=PM
*
* @@PAD#1 EQU ((*-QLRECL)/4096+1)*4096
* @@PAD#2 EQU @@PAD#1-(*-QLRECL)
* ORG *+@@PAD#2
*
PRINT NOGEN
DCBD DEVD=DA
END QLRECL