A bit ago, someone asked for a way to insert a column into an existing file.
This program does that, and little more. I did post an ADSTRING / ADDFIELD
program that does that, and more, but for a single column, I like INSERTIT better.
The documentation, and running, is much simpler.
https://sites.google.com/site/linlyons/z390-adstring-program
There's a GBLC variable that sets the program to run either in an MVS
environment, or on EZ390, where it was developed, and tested. While similar,
the systems are not exactly identical. Anyway, if you've a need, try it.
It's free, it was just a mental exercise. The variable font looks ugly, but with
a fixed font, it's pretty normal. I use SPFlite and Z390, and highly recommend
both.
It would actually be pretty nice if someone tried it and let me know whether
it worked or not. It's been 20 years since I've seen a real mainframe.
GBLC &SYST
&SYST SETC 'EZ390' OR 'MVS'
* &SYST SETC 'MVS'
GBLA &L256
&L256 SETA 256 (I USED 33 FOR TESTING)
MNOTE ,'SYSTEN = &SYST AND MVC LEN = &L256 '
AGO .PAST ALL THIS GOBBLDYGOOK IS FOR Z390 .ORG TESTING
EDITED USING SPFLITE ON MY PC.
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT.MLC
SET OUT=C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT.OUTPUT.TXT
ASMLG C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT TEST PARM(321)
SET IN=C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT.MLC
SET OUT=C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT.OUTPUT.TXT
EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT TEST PARM(321)
C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTITT
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\INSERTIT
SET SYSPRINT=%G%.OUTPUT.SYSPRINT.TXT
SET G=C:\USERS\LIN\DOCUMENTS\Z390CODE\
SET LISTING=%G%.PRN
SET ATFILE=%G%.ATFILE.TXT
SET COMMANDS=%G%.BREAK.COMMANDS.TXT
SET SYSIN=%G%.BREAK.SYSIN.TXT
EZ390 C:\USERS\LIN\DOCUMENTS\Z390CODE\QBR.MLC PARM(SYSIN)
------------------------------------------------------------------
SOME PROGRAM DESCRIPTION MIGHT BE GOOD. TO USE INSERTIT,
//STEP EXEC PGM=INSERTIT,PARM='32,ABCD' OR PARM='32,X"C1C2C3C4"
//STEPLIB DD DISP=SHR,DSN= OR PARM='WTO,32,ABCD'
//IN DD DISP=SHR,DSN= YOUR FILE
//OUT DD DISP=(,CATLG),DSN= ALL THAT STUFF
ABCD WILL BE INSERTED INTO LOC 32 OF THE FILE, WITH EVERYTHING ELSE
PUSHED OUT TO THE RIGHT. THERE'S COMPLICATED, AND THERE'S SIMPLE.
THIS IS SIMPLE. BECAUSE I'M TOO OLD AND DEMENTED TO DO COMPLICATED.
HAVE FUN, ANYONE IS FREE TO USE IT. QUESTIONS? YAHOO EMAIL IS LINLYONS
.PAST ANOP
MACRO
&LABEL ERR &MSG
&LABEL BAL R2,EOD-8
DC AL2(L'SYS&SYSNDX+4,0)
SYS&SYSNDX DC C&MSG
MEND
INSERTIT START 0
USING *,13
STM 14,12,12(13) THIS PROGRAM IS FREEWARE,
ST 13,4(15) NOT TO BE SOLD OR RENTED
ST 15,8(13) OR COPYRIGHTED.
LA 13,0(15) Linwood Lyons
L 2,0(1)
LH 3,0(2)
SH 3,=H'1'
BP SAVEPARM
MVI RC+1,12
MVC DOC+4(44),=CL44'PARM=##,C/X"FIELD" MISSING. REQUIRED.'
MVC PARM(0),2(2)
SAVEPARM EX 3,*-6
MVC PARM+100,PARM
MVC 0(4,R13),RESTART-4
MVC OPENMSGM(8),DCBDDNAM-IHADCB+SYSPRINT
PUSH PRINT
PRINT NOGEN
OPEN (SYSPRINT,OUTPUT)
POP PRINT
CLC =C'WTO',PARM
BNE *+14
MVI FLAGWTO,C'W'
MVC PARM(99),PARM+4
LA R2,DOC
DOCLOOP BAL R9,PUTWTO
MVC 60(4,R2),0(R2)
LA R2,60(R2)
C R2,=A(ENDDOC-6)
BL DOCLOOP
CLI RC+1,0
BNE EOD12
LA R2,PARMWTO
BAL R9,PUTWTO
BAL R9,OPENMSG
B GETLOC
*
B RESTART
RESTART MVC PARM,PARM+L'PARM
* --------------------------- SAVE LEN, START STRING SCAN ------
GETLOC LA R1,PARM
BAL R14,GET#1 PARM='23,ABC'
SH R0,=H'1'
BM BADSTR
ST R0,LOC PARM='23,X'C1C2C3'
LA R1,1(R1) POINT TO DATA
*
CLC =C'X"',0(R1)
BE OKAYHEX
CLC =C'X''',0(R1)
BE OKAYHEX
CLC =C'X$',0(R1)
BE OKAYHEX
B NOTHEX
* ----------------------------- HEX PROCESS--------------------
OKAYHEX MVC DW(2),0(R1) SAVE QUOTE TO LOOK FOR
LA R3,2(R1) POINT TO HEX DATA
LA R1,PARM PUT THE HEX DATA HERE
LR R2,R1 DUPLICATE TO SAVE LOC+LENG
OKHEXL TRT 0(2,R3),TESTHEX Q. GOOD HEX
BNZ BADSTR NO, ERROR
TR 0(2,R3),MAKEHEX YES, MAKE IT 01040B
PACK 0(2,R2),0(3,R3) PACK 2 BYTES INTO 1
LA R3,2(R3) BUMP SOURCE
LA R2,1(R2) BUMP OUTPUT
CLI 0(R3),C' ' Q. SPACE?
BE BADSTR YES, ERROR
CLC 0(1,R3),DW+1 Q. END OF STRING?
BNE OKHEXL NO, LOOP.
B FOUNDEND
* --------------------------------------------------------------
NOTHEX LR R2,R1
CLC =C'C"',0(R1)
BE CQUOTE
CLC =C'C''',0(R1)
BE CQUOTE
CLC =C'C$',0(R1)
BE CQUOTE
B NOQUOTE
* --------------------- C"ABC" PROCESS ------------------------
CQUOTE LR R5,R1
LA R1,2(R1)
LR R2,R1
CQUOTEL LA R2,1(R2)
CLC 0(1,R2),1(R5)
BE FOUNDEND
CLC SPACES,0(R2)
BNE CQUOTEL
ERR 'ENDING DELIMITER MISSING'
* --------------------- MISSING END QUOTE ----------------------
BADSTR MVI RC+1,12
LA R2,MISSINGQ-4
BAL R9,PUTWTO
B EOD12
DC AL2(L'MISSINGQ+4,0)
MISSINGQ DC C'NO END DELIM, BAD HEX, LEN=0, STRING ERR, LOC=0, ??'
* ------------------- NO QUOTE, JUST 23,ABC -------------------
NOQUOTE LA R2,1(R2)
CLC SPACES,0(R2)
BNE NOQUOTE
* ----------------------SAVE LOC AND LENG-----------------------
FOUNDEND ST R1,DATALOC
SR R2,R1
ST R2,DATALEN
SH R2,=H'1'
BM BADSTR
ST R2,DATALEN+4
B OPEN
*
PUSH PRINT
PRINT NOGEN
OPEN SR R10,R10
MVC OPENMSGM(8),DCBDDNAM-IHADCB+IN
OPEN (IN,INPUT)
BAL R9,OPENMSG
MVC OPENMSGM(8),DCBDDNAM-IHADCB+OUT
OPEN (OUT,OUTPUT)
BAL R9,OPENMSG
POP PRINT
*
LA R12,HALFLDOC
LH R1,DCBLRECL-IHADCB+OUT
CR R1,R12
BNL GETMAIN
LA R11,DOC
LA R12,0(R11,R12)
ST R11,AGETMAIN
ST R12,ARECORD
B SKIPGETM
*
LH R2,DCBLRECL-IHADCB+IN
A R2,DATALEN
LA R2,16(R2)
SRL R2,3
SLL R2,3
ST R2,LGETMAIN-4
LR R0,R2
SLL R0,1
ST 0,LGETMAIN
*
GETMAIN GETMAIN R,LV=(0)
ST R1,AGETMAIN
LR 11,1
ST R11,AINPUT
LR 12,11
A 12,LGETMAIN-4
ST R12,ARECORD
SKIPGETM SR R10,R10
SR R6,R6 F
SR R7,R7
TM DCBRECFM-IHADCB+IN,X'80'
BNZ GET
L R10,DATALEN
* ---------------------------------------------------
GET GET IN ,(11)
LR R11,R1
LA R6,1(R6)
LH R4,DCBLRECL-IHADCB+IN
TM DCBRECFM-IHADCB+IN,X'80'
BNZ *+8
LH R4,0(R11) R4 = LENGHT OF RECORD
LA R5,0(R4,R11) R5 = END OF RECORD
LR R1,R5
SR R1,R11
*
LR R14,R11
LR R15,R12
L R1,LOC
SH R1,=H'1'
BM *+8
*
BAL R9,MOVE
BAL R9,MOVEPARM
LR R1,R5
SR R1,R14
BNP PUT
BAL R9,MOVE
*
PUT LTR R10,R10
BZ PUTPUT
LH R1,0(R12)
AR R1,R10
STH R1,0(R12)
PUTPUT PUT OUT,(12)
LA R7,1(R7)
AP #RECS,=P'1'
B GET
* -------------------------------------------------------
GET#1 SR R0,R0
GET#1IC IC R15,0(R1)
N R15,=F'15'
MH R0,=H'10'
AR R0,R15
LA R1,1(R1)
CLI 0(R1),C'0'
BNL GET#1IC
CVD R0,DW
BR R14
*
MVCPARM MVC 0(0,R15),0(R2)
MOVEPARM LM R1,R2,DATALEN+4
EX R1,MVCPARM
LA R15,1(R1,R15)
*
MOVE CH R1,=H'&L256.'
BL SHORT
MVC 0(&L256.,R15),0(R14)
LA R14,&L256.(R14)
LA R15,&L256.(R15)
SH R1,=H'&L256.'
BMR R9
B MOVE
*
MVC 0(0,R15),0(R14)
SHORT LTR R1,R1
BMR R9
EX R1,SHORT-6
LA R14,1(R1,R14)
LA R15,1(R1,R15)
BR R9
*
DC AL2(L'OPENMSGM+4,0)
OPENMSGM DC C'........ RECFM= LRECL=..... BLKSI=..... '
OPENMSG UNPK OPENMSGM+15(3),DCBRECFM-IHADCB(2,R1)
TR OPENMSGM+15(2),HEX-240 )
MVI OPENMSGM+17,C' '
LH R0,DCBLRECL-IHADCB(R1)
CVD R0,12(R13)
OI 19(R13),X'0F'
UNPK OPENMSGM+23(5),17(3,R13)
LH R0,DCBBLKSI-IHADCB(R1)
CVD R0,12(R13)
OI 19(R13),X'0F'
UNPK OPENMSGM+35(5),17(3,R13)
LA R2,OPENMSGM-4
B PUTWTO
OI RC+1,0
BAL R9,PUTWTO
*
EOD12 MVI RC+1,12
EOD LM R0,R1,LGETMAIN
LTR R0,R0
BZ SKIPFREE
FREEMAIN R,LV=(0),A=(1)
SKIPFREE OI #RECS+L'#RECS-1,X'0F'
UNPK WTOB(11),#RECS
LA R2,WTOB-4
BAL R9,PUTWTO
*
LA R2,DCBLIST
L R3,0(R2)
EODCLOSE TM DCBOFLGS-IHADCB(R3),DCBOFOPN
BZ NOCLO
CLOSE ((3))
NOCLO LA R2,4(R2)
L R3,0(R2)
LTR R3,R3
BNZ EODCLOSE
*
EXIT LH 15,RC
L 13,4(13)
L 14,12(13)
LM 0,12,20(13)
BR 14
DCBLIST DC A(IN,OUT,SYSPRINT,0)
WTO DC AL2(50,0),C' '
LINE DC CL121' '
HEX DC C'0123456789ABCDEF'
DC AL2(L'WTOB+4,0)
WTOB DC C' RECORDS COPIED.'
*
PUTWTO CLI FLAGWTO,C'W'
BNE NOWTO
WTO MF=(E,(2))
NOWTO LH R1,0(R2)
SH R1,=H'5'
BP *+8
EX 0,*
CH R1,=H'99'
BL *+8
EX 0,*
MVC LINE(0),4(R2)
EX R1,*-6
B PUTPRINT
PUTPRINT PUT SYSPRINT,LINE
MVC LINE,LINE-1
BR R9
*
EXLST DC 0F'0',X'85',AL3(EXLST+4) THIS OPEN EXIT
PUSH USING COPIES LRECL
DROP 13 AND RECFM
USING *,15 FROM //IN TO
CLC =H'0',DCBLRECL-IHADCB+OUT //OUT
BNER 14 ADDING THE LENGTH
LH R1,DCBLRECL-IHADCB+IN OF THE FIELDS THAT
A R1,DATALEN WERE SPECIFIED.
STH R1,DCBLRECL-IHADCB+OUT
CLI DCBRECFM-IHADCB+OUT,0
BNER 14
MVC DCBRECFM-IHADCB+OUT,DCBRECFM-IHADCB+IN
BR 14
DROP 15
POP USING
LTORG
*
DW DC D'0'
DATALEN DC 2F'0'
DATALOC DC F'0' DATA LOC MUST FOLLOW LEN-1
LOC DC F'0'
ARECORD DC F'0'
AINPUT DC F'0'
DC F'0'
LGETMAIN DC F'0'
AGETMAIN DC F'0'
#RECS DC PL6'0'
RC DC H'0'
FLAGWTO DC C' '
*
PUSH PRINT
AIF ('&SYST' EQ 'MVS').MVS
AIF ('&SYST' EQ 'EZ390').EZ390
MNOTE 12,'GBLC SYST MUST BE MVS OR EZ390, NOT &SYST'
AGO .PASTDCB
.EZ390 ANOP ,
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,RECFM=FT,LRECL=120,EODAD=EOD
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=120,EXLST=EXLST
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FT,LRECL=120
AGO .PASTDCB
.MVS ANOP ,
PRINT NOGEN
IN DCB DDNAME=IN,DSORG=PS,MACRF=GL,DEVD=DA,EODAD=EOD
OUT DCB DDNAME=OUT,DSORG=PS,MACRF=PM,DEVD=DA,EXLST=EXLST
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM,RECFM=FB,LRECL=120, X
DEVD=DA
.PASTDCB ANOP ,
POP PRINT
*
CNOP 4,8
PARMWTO DC H'80,0'C' '
PARM DC 2CL100' '
TESTHEX EQU *-192
DC XL8'4000000000000040'
SPACES DC CL40' '
DC XL10'00',CL6' '
MAKEHEX EQU *-192
DC CL1' ',AL1(10,11,12,13,14,15)
DC CL9' ',CL32' '
DC AL1(0,1,2,3,4,5,6,7,8,9)
*
DOC DC H'64,0'
DC CL60'INSERTIT, V01,01 &SYSDATE &SYSTIME STARTED'
DC CL60'COPY FROM //IN TO //OUT INSERTING THE PARM STRING INTO '
DC CL60'RECPRDS AT THE SPECIFIED LOCATION. EG. TO ADD ABCD TO '
DC CL60'LOCATION 23 OF EACH RECORD, PUSHING THE REST OF THE REC OUT,'
DC CL60' '
DC CL60'//COPYADD EXEC PGM=INSERTIT,PARM=''23,X"C1C2C3C4"'' '
DC CL60' PARM CAN ALSO BE 23,C"ABCD" OR PARM=''23,ABCD'' '
DC CL60' '
DC CL60'YOU CAN ONLY ADD ONE FIELD. IF YOU NEED TO ADD MORE, YOU CAN'
DC CL60'RUN IT TWICE OR I HAVE ANOTHER PROGRAM, ADDFIELD, THAT CAN'
DC CL60'ADD MULTIPLE FIELDS, SKIP INPUT FIELDS, AND MORE. I ADDED A'
DC CL60'COUPLE "FEATURES" THAT AREN''T WORKING, BUT THEY WILL. '
DC CL60' '
DC CL60'http://sites.google.com/site/linlyons/z390-adstring-program'
DC CL60' '
DC C'IF THAT''S NOT SUFFICIENT, I''M ALSO WORKING ON EDITFILE, THAT'
DC CL60'SHOULD BE MUCH BETTER, BUT AT MY AGE (80) AND MY STATE OF '
DC CL60'DIMENTIA(?) I''M NOT AT ALL SURE THAT IT WILL EVER WORK. '
ENDDOC EQU *
LDOC EQU ENDDOC-DOC-8
HALFLDOC EQU (ENDDOC-DOC-8)/2
*
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
*
AIF ('&SYST' EQ 'MVS').NOPAD
@@PAD#1 EQU ((*-INSERTIT)/4096+1)*4096
@@PAD#2 EQU @@PAD#1-(*-INSERTIT)
ORG *+@@PAD#2
*
.NOPAD AIF ('&SYST' NE 'MVS').END
DCBD DEVD=DA
.END END