INSERTIT

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