KEYCOMPR

Compare 2 files that have keys. You can compare only the keys, or, both keys and data. A couple days ago, I posted my version of a program named UTLPRINT. This is my version of a program named UTLCOMPR.
Again, email me, and I'll send you a good copy.

AGO .START

C:\USERS\LIN\DOCUMENTS\Z390CODE\KEYCOMPR

SET PA="1,11,A,12,10,A,22,33,A "

SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\KEYCOMPR

SET IN1=%G%.IN1.TXT

SET IN2=%G%.IN2.TXT

SET MATCH1=%G%.MATCH1.TXT

SET MATCH2=%G%.MATCH2.TXT

SET NMATCH1=%G%.NMATCH1.TXT

SET NMATCH2=%G%.NMATCH2.TXT

SET DATA1=%G%.DATA1.TXT

SET DATA2=%G%.DATA2.TXT

SET SYSPRINT=%G%.SYSPRINT.TXT

ASMLG %G%.MLC TIME(1) PARM(%PA%

.START ANOP

KEYCOMPR START 0

YREGS

USING *,13

DS 18F

ORG *-72

STM 14,12,12(13)

ST 13,4(15) C=(1,4,A,6,2,A,11,12,D)

ST 15,8(13)

LR 13,15

L R1,0(R1)

LH R2,0(R1)

SH R2,=H'1'

BM NOPARM

MVC PARM(0),2(R1)

EX R2,*-6

B GOTPARM

ORG

* ----------------------------------------------

PUSH PRINT

PRINT NOGEN

USING IHADCB,2

OPENCOPY LR R1,R2

MVI DCBRECFM,0

BAL R14,2(R12)

OPENOUT TM DCBOFLGS,DCBOFOPN

BOR R9

MVC OPENMSG(8),DCBDDNAM

MVC OPENMSG+51(6),=C'OUTPUT'

OPEN ((2),OUTPUT)

B OPENM

OPENIN TM DCBOFLGS,DCBOFOPN

BOR R9

MVC OPENMSG(8),DCBDDNAM

MVC OPENMSG+51(6),=C' INPUT'

OPEN ((2),INPUT)

POP PRINT

OPENM TM DCBOFLGS,DCBOFOPN

BZ OPENXX

MVC OPENMSG+45(4),=C'OPEN'

UNPK OPENMSG+15(3),DCBRECFM(2)

TR OPENMSG+15(2),HEX-240

MVI OPENMSG+17,C' '

LH R0,DCBLRECL

CVD R0,DW

OI DW+7,X'0F'

UNPK OPENMSG+24(5),DW+5(3)

LH R0,DCBBLKSI

CVD R0,DW

OI DW+7,X'0F'

UNPK OPENMSG+38(5),DW+5(3)

MVC LINE(L'OPENMSG),OPENMSG

PUT SYSPRINT,LINE-1

* CLC OPENMSG+51(6),=C'OUTPUT'

* BNE NOPUTL

* PUT (2),LINE

* NOPUTL DS 0H

MVC LINE,LINE-1

BR R9

OPENXX MVC LINE(8),OPENMSG

MVC LINE+9(12),=C'DID NOT OPEN'

PUT SYSPRINT,LINE-1

MVC LINE,LINE-1

BR R9

OPENMSG DC CL60'........ RECFM=.. LRECL=..... BLKSIZE=.....'

* ----------------------------------------------

DC F'0'

QPARM ST R9,QPARM-4

LA R2,SYSPRINT

BAL R9,OPENOUT

PUT SYSPRINT,PARM-1

LA R4,PARM

B QP10

QP5 MVC PARM,PARM+1

QP4 MVC PARM,PARM+4

QP10 CLC =C'TEST,',PARM

BNE NPTEST

MVI FLAGTEST,C'T'

B QP5

NPTEST CLC =C'ALL,',PARM

BNE NPALL

MVI FLAGALL,C'A'

B QP4

NPALL CLC =C'DOC,',PARM

BNE NPDOC

MVI FLAGDOC,C'D'

B QP4

NPDOC CLC =C'LIST,',PARM

BNE NPLIST

MVI FLAGLIST,C'L'

B QP5

NPLIST CLC =C'STOP=',PARM

BNE NPLISTE

LA R4,PARM+5

LA R2,16(R13)

BAL R14,GET#

* ZAP LIST#,DW

MVC LIST#,DW+2

MVC PARM,0(R4)

B QP10

LIST# DC P'99999999999'

NPLISTE LM R2,R3,=A(DOC,ENDDOC-4)

MVCDOC MVC LINE(L'DOC),0(R2)

PUT SYSPRINT,LINE-1

LA R2,L'DOC(R2)

CR R2,R3

BNL GETLOC

CLI FLAGDOC,C'D'

BE MVCDOC

* ----------------------------------------------

GETLOC LA R4,PARM

LA R2,DOC-4

GETLOCL MVC LINE(99),0(R4)

PUT SYSPRINT,LINE-1

BAL R14,GET#

CLI 0(R4),C'A'

BE MVCAD

CLI 0(R4),C'D'

BE MVCAD

BAL R14,R4ERR

MVCAD MVC 1(1,R2),0(R4) C=(2,11,A,44,3,D)

LA R4,2(R4)

MVI 4(R2),X'FF'

CLI 0(R4),C' '

BNE GETLOCL

L R9,QPARM-4

BR R9

* ----------------------------------------------

GET# CLI 0(R4),C'0'

BNL *+8

BAL R14,R4ERR

LR R15,R4

LA R15,1(R15)

CLI 0(R15),C'0'

BNL *-8

LA R0,1(R15)

SR R15,R4

BCTR R15,0

EX R15,GET#PACK

CVB R1,DW

LA R2,4(R2)

SH R1,=H'1'

BNM *+8

BAL R14,R4ERR

ST R1,0(R2)

LR R4,R0

BR R14

GET#PACK PACK DW,0(0,R4)

* ----------------------------------------------

NOPARM LA R2,SYSIN

BAL R9,OPENIN

GET SYSIN,PARM

GOTPARM BAL R9,QPARM

* ----------------------------------------------

OPEN LA R2,IN1

BAL R9,OPENIN

LA R2,IN2

BAL R9,OPENIN

LH R2,DCBLRECL-IHADCB+IN1

LH R3,DCBLRECL-IHADCB+IN2

LR R4,R2

CR R4,R3

BL *+6

LR R4,R3

BCTR R4,0

ST R4,COMPLEN

CR R2,R3

BH *+8

LR R2,R3

LA R2,256(R2)

LR R0,R2

MH R0,=H'3'

ST R0,LGETMAIN

GETMAIN R,LV=(0)

ST R1,AGETMAIN

AR R2,R1

ST R2,AGETMAIN+4

MVI 0(R1),C' '

MVC 1(255,R1),0(R1)

MVC 0(256,R2),0(R1)

* LA R1,17(R1)

* LA R2,17(R2)

* STM R1,R2,BUFFER

LA R12,OPENX+4

LA R2,MATCH1

BAL R9,OPENCOPY

LA R2,MATCH2

BAL R9,OPENCOPY

LA R2,NMATCH1

BAL R9,OPENCOPY

LA R2,NMATCH2

BAL R9,OPENCOPY

CLI FLAGALL,C'A'

BNE *+20

LA R2,DATA1

BAL R9,OPENCOPY

LA R2,DATA2

BAL R9,OPENCOPY

MVC LINE,LINE-1

PUT SYSPRINT,LINE-1

LM R2,R3,AGETMAIN

SR R10,R10

B GETBOTH

MAT SP LIST#,=P'1'

BNP END##

CLI FLAGALL,C'A'

BNE NOTDATA

LA R14,16(R2)

LA R15,16(R3)

LA R0,255

L R1,COMPLEN

CR R1,R0

BNH SHORT

COMPLONG CLC 0(256,R14),0(R15)

BNE NOTSAME

LA R14,255(R14)

LA R15,255(R15)

SR R1,R0

CR R1,R0

BH COMPLONG

B SHORT

NOTSAME BAL R10,ND1

BAL R10,ND2

SR R10,R10

B GETBOTH

CLC 0(0,R14),0(R15)

SHORT EX R1,SHORT-6

BNE NOTSAME

NOTDATA PUT MATCH1,16(2)

PUT MATCH2,16(3)

AP #MATCH,=P'1'

OI #IN1+4,X'0F'

OI #IN2+4,X'0F'

UNPK 1(5,R2),#IN1+2(3)

MVI 6(R2),C'/'

UNPK 7(5,R2),#IN2+2(3)

MVC 12(4,R2),=C' M= '

LR R14,R2

BAL R9,QLIST

GETBOTH BAL R9,GET1

BAL R9,GET2

CLI FLAGTEST,C'T'

BNE COMPARE

* ----------------------------------------------

LA R4,DCBS+8

LA R5,6

TESTLOOP L R1,0(R4)

PUT (1),(2)

L R1,0(R4)

PUT (1),(3)

LA R4,4(R4)

BCT R5,TESTLOOP

B GETBOTH

FLAGTEST DC C' '

* ----------------------------------------------

CLCA CLC 0(0,R4),0(R5)

CLCD CLC 0(0,R5),0(R4)

COMPARE L R8,=A(DOC)

COMPAREL LM R14,R15,0(R8)

LA R4,16(R2,R14)

LA R5,16(R3,R14)

LA R1,CLCA

CLI 5(R8),C'D'

BNE *+8

LA R1,CLCD

EX R15,0(R1)

BL NOM1

BH NOM2

LA R8,8(R8)

CLI 0(R8),0

BE COMPAREL

B MAT

* ----------------------------------------------

PREFIX DC CL16' '

ND2 LA R1,DATA2

MVC PREFIX+11(5),=C' D2= '

AP #D2,=P'1'

B N2PUT

NOM2 LA R1,NMATCH2

MVC PREFIX+11(5),=C' N2= '

AP #2N,=P'1'

N2PUT PUT (1),16(3)

OI #IN2+4,X'0F'

UNPK PREFIX+1(9),#IN2

MVC 0(16,R3),PREFIX

LR R14,R3

BAL R9,QLIST

BAL R9,GET2

LTR R10,R10

BZ COMPARE

BR R10

QLIST CLI FLAGLIST,C'L'

BNER R9

PUT SYSPRINT,(14)

SP LIST#,=P'1'

BPR R9

B END##

ND1 LA R1,DATA1

MVC PREFIX+11(5),=C' D1= '

AP #D1,=P'1'

B N1PUT

NOM1 LA R1,NMATCH1

MVC PREFIX+11(5),=C' N1= '

AP #1N,=P'1'

N1PUT PUT (1),16(2)

OI #IN1+4,X'0F'

UNPK PREFIX+1(9),#IN1

MVC 0(16,R2),PREFIX

LR R14,R2

BAL R9,QLIST

BAL R9,GET1

LTR R10,R10

BZ COMPARE

BR R10

* ----------------------------------------------

GET1 GET IN1,16(2)

AP #IN1,=P'1'

BR R9

GET2 GET IN2,16(3)

AP #IN2,=P'1'

BR R9

* ----------------------------------------------

USING IHADCB,2

CLOSEIT TM DCBOFLGS,DCBOFOPN

BZR R9

CLOSE ((2))

TM DCBOFLGS-IHADCB+SYSPRINT,DCBOFOPN

BZR R9

MVC LINE(8),DCBDDNAM

MVC LINE+9(6),=C'CLOSED'

PUT SYSPRINT,LINE-1

MVC LINE,LINE-1

BR R9

DROP 2

ZFLAG DC CL4' '

Z1 CLC ZFLAG,SPACES

BNE COUNTS

MVI ZFLAG+1,C'Z'

Z1GET BAL R9,GET2

BAL R10,NOM2

B Z1GET

Z2 CLC ZFLAG,SPACES

BNE COUNTS

MVI ZFLAG+2,C'Z'

Z2GET BAL R9,GET1

BAL R10,NOM1

B Z2GET

END##M DC C'ENDED DUE TO STOP=##'

END## MVC LINE(L'END##M),END##M

PUT SYSPRINT,LINE-1

COUNTS MVC LINE,LINE-1

LA R2,#IN1

CLI FLAGALL,C'A'

BNE CNTLOOP

LA R2,#D1

CNTLOOP MVC LINE(L'ED9),ED9

ED LINE(L'ED9),0(R2)

MVC LINE+L'ED9+2(32),5(R2)

PUT SYSPRINT,LINE-1

LA R2,#2N-#1N(R2)

CLI 0(R2),X'99'

BL CNTLOOP

MVC LINE,LINE-1

B Z

DCBS DC A(IN1,IN2,MATCH1,MATCH2,NMATCH1,NMATCH2,DATA1,DATA2)

DC A(SYSIN,SYSPRINT),X'FF'

Z LA R3,DCBS-4

LA R3,4(R3)

L R2,0(R3)

BAL R9,CLOSEIT

CLI 4(R3),0

BE Z+4

LM R0,R1,LGETMAIN

LTR R0,R0

BZ NOFREEM

FREEMAIN R,LV=(0),A=(1)

NOFREEM SR 15,15

IC 15,RC

L 13,4(13)

L 14,12(13)

LM 0,12,20(13)

BR 14

ZZ LA R4,=C'PARM/SYSIN'

BAL R14,R4ERR

R4ERR MVC ERRMSG+21(10),0(R4)

LA R14,0(R14)

SR R14,R13

ST R14,DW

UNPK ERRMSG+2(5),DW+2(3)

TR ERRMSG+2(4),HEX-240

MVI ERRMSG+6,C')'

PUT SYSPRINT,ERRMSG

MVI RC,12

LM R2,R3,=A(DOC+64,ENDDOC-4)

ERRDOC MVC LINE(64),0(R2)

PUT SYSPRINT,LINE

LA R2,64(R2)

CR R2,R3

BL ERRDOC

MVC LINE,LINE-1

B Z

ERRMSG DC CL133' (....) ERROR, DATA= '

LTORG

FLAGLIST DC C' '

FLAGDOC DC C' '

FLAGALL DC C' '

#D1 DC PL5'0',CL33'//IN1 KEYS MATCH, REC DIDN''T'

#D2 DC PL5'0',CL33'//IN2 KEYS MATCH, REC DIDN''T'

#IN1 DC PL5'0',CL33'//IN1 RECORDS READ '

#IN2 DC PL5'0',CL33'//IN2 RECORDS READ '

#1N DC PL5'0',CL33'//IN1 RECORD KEYS NOT MATCHED'

#2N DC PL5'0',CL33'//IN2 RECORD KEYS NOT MATCHED'

#MATCH DC PL5'0',CL33'//IN1, //IN2 KEYS MATCHED ',X'FF'

RC DC X'00'

HEX DC C'0123456789ABCDEF'

ED9 DC X'402020206B2020206B212020'

DW DC D'0'

COMPLEN DC F'0'

LGETMAIN DC F'0'

AGETMAIN DC 2F'0'

BUFFER DC 2F'0',C' '

PARM DC CL102' '

SPACES DC CL32' '

LINE DC CL133' '

* ----------------------------------------------

OPENX DC 0F'0',X'85',AL3(OPENX+4)

PUSH USING

DROP 13

USING *,12

LR 12,15

USING IHADCB,1

OPENXC CLI DCBRECFM,0

BNER R14

LA R8,IN1

C R1,=A(IN2)

BL *+8

LA R8,IN2

MVC DCBLRECL,DCBLRECL-IHADCB(R8)

MVC DCBBLKSI,DCBBLKSI-IHADCB(R8)

MVC DCBRECFM,DCBRECFM-IHADCB(R8)

BR R14

LTORG

* ----------------------------------------------

PUSH PRINT

PRINT NOGEN

DS 0D

SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,LRECL=133,RECFM=FT

SYSIN DCB DDNAME=SYSIN,DSORG=PS,EODAD=ZZ,MACRF=GL,LRECL=133,RECFM=FT

IN1 DCB DDNAME=IN1,DSORG=PS,EODAD=Z1,MACRF=GM,LRECL=166,RECFM=FT

MATCH1 DCB DDNAME=MATCH1,DSORG=PS,MACRF=PM

NMATCH1 DCB DDNAME=NMATCH1,DSORG=PS,MACRF=PM

DATA1 DCB DDNAME=DATA1,DSORG=PS,MACRF=PM

IN2 DCB DDNAME=IN2,DSORG=PS,EODAD=Z2,MACRF=GM,LRECL=166,RECFM=FT

MATCH2 DCB DDNAME=MATCH2,DSORG=PS,MACRF=PM

NMATCH2 DCB DDNAME=NMATCH2,DSORG=PS,MACRF=PM

DATA2 DCB DDNAME=DATA2,DSORG=PS,MACRF=PM

POP PRINT

* SYSPRINT DS 0D

* DCB DEVD=DA,DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,LRECL=133,RECFM=FB

* SYSIN DCB DEVD=DA,DDNAME=SYSIN,DSORG=PS,EODAD=ZZ,MACRF=GL

* IN1 DCB DEVD=DA,EXLST=OPENX.DDNAME=IN1,DSORG=PS,EODAD=Z1,MACRF=GM

* MATCH1 DCB DEVD=DA,EXLST=OPENX.DNAME=MATCH1,DSORG=PS,MACRF=PM

* DATA1 DCB DEVD=DA,EXLST=OPENX.DNAME=DATA1,DSORG=PS,MACRF=PM

* NMATCH1 DCB DEVD=DA,EXLST=OPENX.DDNAME=NMATCH1,DSORG=PS,MACRF=PM

* IN2 DCB DEVD=DA,EXLST=OPENX.DDNAME=IN2,DSORG=PS,EODAD=Z2,MACRF=GM

* MATCH2 DCB DEVD=DA,EXLST=OPENX.DDNAME=MATCH2,DSORG=PS,MACRF=PM

* DATA2 DCB DEVD=DA,EXLST=OPENX.DNAME=DATA2,DSORG=PS,MACRF=PM

* NMATCH2 DCB DEVD=DA,EXLST=OPENX.DDNAME=NMATCH2,DSORG=PS,MACRF=PM

* DCBD DEVD=DA

DOC DC CL64'KEYCOMPR V01.01 ASM &SYSDATE AT &SYSTIME COMPARES 2 FILES'

DC C'INPUT MUST BE 2 FILES THAT ARE SORTED ON KEYS. '

DC C'CONTROL CAN BE EITHER PARM FIELD OR //SYSIN '

* AGO .END

DC C' '

DC C'/COMPARE EXEC PGM=KEYCOMPR,PARM="1,9,A,12,4,A,33,5,D" '

DC C'//STEPLIB DD DISP=SHR,DSN= '

DC C'//SYSPRINT DD SYSOUT=* '

DC C'//SYSIN DD * <== DO NOT USE IF YOU USED PARM= '

DC C'LIST,DOC,ALL,1,9,A,12,4,A,33,5,D '

DC C'//IN1 DD DISP=SHR,DSN= '

DC C'//IN2 DD DISP=SHR,DSN= 2 '

DC C'//MATCH1 DD DUMMY (CAUSE YOU REALLY DON"T WANT TO SEE IT) '

DC C'//MATCH2 DD DUMMY DITTO '

DC C'//NMATCH1 DD SYSOUT=* (CAUSE YOU DO WANT TO SEE THESE) '

DC C'//NMATCH2 DD SYSOUT=* '

DC C'//DATA1 DD SYSOUT=* CONTAINS RECORDS WHERE THE KEYS MATCHED'

DC C'//DATA2 DD SYSOUT=* BUT THE REST OF THE DATA DID NOT. '

DC C' '

DC C'PARM=DOC,##,## PRINTS THIS DESCRIPTION. '

DC C'PARM=LIST,##,## ... LISTS MATCHING AND NON-MATCHING RECORDS. '

DC C'PARM=STOP=123,##,## STOP COMPARE AFTER ABOUT 123 RECORDS. '

DC C'PARM=ALL,##, ... COMPARE ENTIRE RECORD, NOT JUST KEY. '

DC C' '

DC C'IF YOU USE LIST, THEN //SYSPRINT WILL CONTAIN RECORDS LIKE: '

DC C' '

*DC C'000001704 N2=CBUF2 DC F"-1" '

*DC C'01145/01705 M=CHAIN LR R14,R7 '

*DC C'01146/01706 M=CHAIN04 L R14,DNEXT-DSECT(R14) '

*DC C'01147/01707 M=CHAIN05 OI RC,8 '

*DC C'01148/01708 M=CHAIN05M MSG "GOTO= DESTINATION LABEL NOT FOUND"'

*DC C'01149/01709 M=CLOSE TM DCBOFLGS-IHADCB(R2),DCBOFOPN '

*DC C'000001710 N2=CLOSLOOP BAL R9,CLOSE '

*DC C'000001150 N1=CLOSLOOP LA R2,4(R2) '

*DC C'01151/01711 M=CLOSMSG MSG " CLOSED" '

*DC C'000001712 N2=COND CLI DSTR1LEN,X"FF" Q. NULL STRING?'

*DC C'000000861 N1= DC C'.@,EDIT= ..... STARTS WITH ORIGINAL RECORD. '

*DC C'000000862 N1= DC C'.@,IF= ..... STARTS WITH ORIGINAL RECORD. '

*DC C'00863/01343 M= DC C'.A,EDIT=(1,0,C"EWRT",C"TRE"),WRITE=DD8,1,11 '

*DC C'000001344 N2= DC C'.AA,IF= ..... STARTS WITH ORIGINAL RECORD.'

*DC C'00864/01345 M= DC C'.B,WRITE=DD11 '

*DC C'000001346 N2= DC C'.BC,EDIT= ..... STARTS WITH ORIGINAL RECORD.'

*DC C' '

DC C' 000000747 N2= LA R0,255 '

DC C' 000000748 N2= LA R0,255 '

DC C' 00454/00749 M= LA R0,32 '

DC C' 00455/00750 M= LA R0,4 '

DC C' 00456/00751 M= LA R0,4 '

DC C' 00457/00752 M= LA R0,64 '

DC C' 000000458 N1= LA R0,DSTR2LEN '

DC C' 000000459 N1= LA R0,DSTR2LEN '

DC C' '

DC C' 000001903 N2=QDUPDD CLI DOPCODE-DSECT(R1),C"W" '

DC C' 000001904 N2=QDUPDDB L R1,DNEXT '

DC C' 01277/01905 M=QF10 SR R15,R15 '

DC C' 01278/01906 M=QF20 LA R2,1(R2) '

DC C' 000001907 N2=QFREQ CLI DSTR1LEN,0 '

DC C' 000001279 N1=QFREQ LA R0,1 '

DC C' '

DC C'M= MEANS THAT THE KEYS (NOT NECESSARILY THE RECORDS) MATCH. '

DC C'N1= MEANS THERE IS NO MATCHING KEY IN THE //IN2 FILE. '

DC C'N2= MEANS THERE IS NO MATCHING KEY IN THE //IN1 FILE. '

DC C' '

DC C'RECORD #S ARE SHOWN IN CASE YOU WANT TO FIND THEM IN THE FILE. '

DC C'LOTS-A LUCK. -LIN LYONS (RETIRED, I CAN PUT MY NAME ANYWHERE)'

DC C' '

.END ANOP

ENDDOC EQU *

* @@PAD#1 EQU ((*-KEYCOMPR)/4096+1)*4096

* @@PAD#2 EQU @@PAD#1-(*-KEYCOMPR)

ORG *+@@PAD#2

END KEYCOMPR