There are 2 programs here, not tested, just as a sample, playing around.
The first is a simple copy a card image file. (about 20 lines of code)
The second is to copy records that contain a character string, specified in the PARM field. (about 50 lines)
* =================== STRAIGHT COPY A FILE =========================
QCOPY START 0
USING *,13
B 72(15)
DC 17F'0'
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15 INITIALIZATION DONE.
OPEN (IN,INPUT,OUT,OUTPUT) OPEN FILES + COPY
GET GET IN
LR 0,1
PUT OUT,(0)
B GET
Z CLOSE (IN,,OUT)
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
OUT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,MACRF=PM,RECFM=FB,LRECL=80
IN DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL,RECFM=FB,LRECL=80,EODAD=Z
END QCOPY
* =====COPY ONLY RECORDS THAT CONTAIN A CHARACTER STRING IN PARM FIELD
QCOPYP START 0
REGS
USING *,13
B 72(15)
DC 17F'0'
STM 14,12,12(13)
ST 13,4(15)
ST 15,8(13)
LR 13,15 INITIALIZATION DONE.
L 7,0(1) ADDR OF PARM
LH 8,0(7) LENGTH OF PARM
SH 8,=H'1' CALC LENGTH-1
BNM OPEN
ABEND 1 ABEND IF LENGTH=0
OPEN OPEN (IN,INPUT,OUT,OUTPUT) OPEN FILES
SR 1,1
IC 1,2(7)
LA 1,TRTTBL(1) PUT NON-ZERO AT OFFSET OF
MVI 0(1),C' ' FIRST CHAR OF PARM FIELD
B GET
DC F'0'
PUT L R0,PUT-4
PUT OUT,(0)
GET GET IN
ST 1,PUT-4
LH R4,DCBLRECL-IHADCB+IN
SR R4,R8
LA R4,0(R4,R1)
LOOP LR R2,R4
SR R2,R1 Q. END OF REC (NO ROOM FOR PARM)
BNP GET YES, SKIP IT AND GET NEXT.
EX R2,TRT Q. FIND FIRST CHAR
BZ GET NOT FOUND, GET NEXT
EX R8,CLC Q. DOES STRING MATCH
BE PUT YES, WRITE THE REC
LA R1,1(R1) NO, BUMP LOC
B LOOP AND LOOP
TRT TRT 0(0,R1),TRTTBL LOOK FOR THE FIRST CHAR
CLC CLC 0(0,R1),2(R7) DOES STRING MATCH?
Z CLOSE (IN,,OUT)
L 13,4(13)
LM 14,12,12(13)
SR 15,15
BR 14
OUT DCB DDNAME=OUT,DSORG=PS,DEVD=DA,MACRF=PM,RECFM=FB,LRECL=80
IN DCB DDNAME=IN,DSORG=PS,DEVD=DA,MACRF=GL,RECFM=FB,LRECL=80,EODAD=Z
TRTTBL DC XL256'00'
END QCOPYP