*********Attention **********************************

************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
ADDMACRO CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12,11 *Say the base register 11 & 12 00060000
LA 11,4095(0,12) 00060000
LA 11,1(0,11) *reg 11 has base address 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
B BEGIN 00100000
LIT1 DC CL20'PROGRAM STARTED' 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
BEGIN DS 0H 00130000
WTO 'TO SHOW add ',ROUTCDE=11
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
addfull full1,(FULL2,FULL3,FULL4,FULL5) 00142000
L 5,FULL1 00142000
CVD 5,DWD 00142000
UNPK TYPE+10(10),DWD 00142000
OI TYPE+19,X'F0' 00142000
WTO TEXT=DISP 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
DISP DC AL2(20) 00147000
TYPE DC CL10'SUM OF NS:' 00147000
DS CL10 00147000
DS 0F 00148000
SAVE DS 18F 00149000
full1 Ds F 00149000
full2 Dc F'5' 00149000
full3 Dc F'25' 00149000
full4 Dc F'25' 00149000
full5 Dc F'25' 00149000
DS 0D 00149000
DWD DS D 00149000
END ADDMACRO 00150003
*** ARITHMATIC OPERATIONS MULTIPICATION AND DIVISION
ARITH CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
 ST 13,SAVE+4
LA 13,SAVE
B MAIN
**************************************
A DC F'300'
B DC F'51'
SAVE7 DS F
MAIN DS 0H
******6 IS THE EVEN REGISTER FOR THE MULTIPLICATION OPERATION
L 7,B
M 6,A
CVD 7,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG
******8 IS THE EVEN REGISTER FOR THE DIVISION OPERATION
SR 9,9
**ANOTHER WAY IS L 9,=F'0'
SR 8,8
L 9,A
D 8,B
CVD 9,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG
CVD 8,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG
******7 IS THE REGISTER FOR HALFWORD OPERATION
ST 7,SAVE7 STORE THE CONTENTS OF REG 7
SR 7,7
L 7,A
MH 7,=H'20'
CVD 7,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG
L 7,SAVE7 RESTORE THE CONTENTS OF REG 7
******8 IS THE TEMP REGISTER
SR 8,8
A 8,A CONTENTS OF A ADDED TO REG 8
A 8,B CONTENTS OF 8 IS A+B
CVD 8,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG

L 13,SAVE+4
LM 14,12,12(13)
LA 15,4
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
DW DS D
END
ARRAY CSECT
BALR 12,0
 USING *,12
SAVE (14,12)
ST 13,SAVE+4
LA 13,SAVE
SR 7,7 REG 7 IS THE INDEX REGISTER FOR ARRAY ARR
XR 4,4 REG 4 IS ACCUMULATING THE TOTALS
LA 10,10(0,0) LOAD VALUE 10 INTO REG 10
LOOP A 4,ARR(7)
LA 7,4(0,7)
BCT 10,LOOP BRANCH ON COUNT
*
CVD 4,DOUBLE
ZAP TEMP,DOUBLE
ED SUMD,TEMP
WTO TEXT=SUM
L 13,SAVE+4
RETURN (14,12),,RC=0
DS 0F
SAVE DS 18F
SUM DC AL2(20)
DC C'THE SUM IS: '
SUMD DC XL8'402120202020202020'
TEMP DC PL3'0'
DS 0D
DOUBLE DC PL8'0'
ARR DC F'1,2,3,4,5,6,7,8,9,10'
END
ARRAY1 CSECT
BALR 12,0
USING *,12
SAVE (14,12)
ST 13,SAVE+4
LA 13,SAVE
********************************************END OF TEMPLATE
LA 10,MTBLNUM(0,0) LOAD NUMBER OF ENTRIES IN TABLE
LA 9,MONTHTBL
LOOP CLC 0(2,9),MONTH
BE FOUND
BCT 10,LOOP
*
FOUND DS 0H
MVC MON,0(9)
WTO TEXT=SUM
L 13,SAVE+4
RETURN (14,12),,RC=0
DS 0F
SAVE DS 18F
SUM DC AL2(6)
SUML DS CL2
FILLER DC C':'
MON DS CL3
****END OF WTO
MONTH DC C'06'
MONTHTBL DC C'01',C'JAN'
MTBLSIZ EQU *-MONTHTBL
DC C'02',C'FEB'
DC C'03',C'MAR'
DC C'04',C'APR'
DC C'05',C'MAY'
 DC C'06',C'JUN'
DC C'07',C'JUL'
DC C'08',C'AUG'
DC C'09',C'SEP'
DC C'10',C'OCT'
DC C'11',C'NOV'
DC C'12',C'DEC'
MTBLNUM EQU (*-MONTHTBL)/MTBLSIZ
END
* TO DISPLAY A MESSAGE 10 TIMES - LOOPS 00001000
BCTEG CSECT 00010000
SAVE (14,12) 00011000
BALR 12,0 00020000
USING *,12 00030000
ST 13,SAVE+4 00040000
LA 13,SAVE 00050000
* 00060000
* LOOPING START 00062200
L 4,ENDVAL
LOOP EQU * 00062300
MVC MSGTEXT,DISPLAY 00062500
WTO MF=(E,MSG),ROUTCDE=11 00062600
BCT 4,LOOP 00062800
* LOOPING END 00062900
L 13,SAVE+4 00064000
RETURN (14,12),,RC=0 00065000
* 00066000
DS 0F 00070000
SAVE DS 18F 00090000
ENDVAL DC F'10' X'0000000A' 00195000
* WTO MESSAGE AREA 00100000
MSG DC H'19' 00110000
DC H'0' 00120000
MSGTEXT DS CL15 00130000
DISPLAY DC C'HAVE A NICE DAY' 00180000
END 00200000
*** COMPARE 3 FULL WORD NUMBERS
COMPARE1 CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
* CLC STR1,STR2
L 3,NUM1
C 3,NUM2
BL NEXT
MVC LOW,NUM1
NEXT DS OH
DISP EQU *
MVC RES2,STR2
WTO TEXT=MSG
DEBUGMAC R,VAR=3,TEXT='REGISTER 3 = '
L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
MSG DC AL2(7)
LOWD DS CL8
HIGHD DS CL8
*****************************************
NUM1 DC F'200'
NUM2 DC F'1000'
NUM3 DC F'-300'
LOW DS F
HIGH DS F
END
*** DISPLAY A BINARY NUMBER
BINDISP CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
* L 4,FWD
L R4,=F'2850'
CVD 4,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG
DEBUGMAC R,VAR=4,TEXT='REGISTER 4 = '
L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
FWD DC F'2850'
DS 0D
DW DS D
END
ARRAY1 CSECT
BALR 12,0
USING *,12
SAVE (14,12)
ST 13,SAVE+4
LA 13,SAVE
********************************************END OF TEMPLATE
****SET UP THE INDEX REGISTER, INCREMENT REGISTER AND LIMIT REG
*****BXLE
LA 5,0(0,0) INDEX
LA 6,MTBLSIZ(0,0) INCREMENT
LA 7,MTBLSIZ*MTBLNUM(0,0) LIMIT
LOOP LA 9,MONTHTBL(5)
CLC 0(2,9),MONTH
BE FOUND
BXLE 5,6,LOOP
*
FOUND DS 0H
MVC SUML,0(9)
MVC MON,2(9)
WTO TEXT=SUM
 L 13,SAVE+4
RETURN (14,12),,RC=0
DS 0F
SAVE DS 18F
SUM DC AL2(6)
SUML DS CL2
FILLER DC C':'
MON DS CL3
****END OF WTO
MONTH DC C'06'
MONTHTBL DC C'01',C'JAN'
MTBLSIZ EQU *-MONTHTBL
DC C'02',C'FEB'
DC C'03',C'MAR'
DC C'04',C'APR'
DC C'05',C'MAY'
DC C'06',C'JUN'
DC C'07',C'JUL'
DC C'08',C'AUG'
DC C'09',C'SEP'
DC C'10',C'OCT'
DC C'11',C'NOV'
DC C'12',C'DEC'
MTBLNUM EQU (*-MONTHTBL)/MTBLSIZ
END
*** COMPARE 2 STRINGS
COMPARE CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
* CLC STR1,STR2
CLC STR1(1),STR2
BE EQUAL BE BNE BL B BNL
BL LOWER
MVC MSG+2(16),=C'FIRST > SECOND'
B DISP
EQUAL MVC MSG+2(16),=C'BOTH EQUAL '
B DISP
LOWER MVC MSG+2(16),=C'FIRST < SECOND'
DISP WTO TEXT=MSG
L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
STR1 DC C'5BC'
STR2 DC C'5EF'
END
*** COMPARE 2 STRINGS
COMPARE1 CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
 ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
* CLC STR1,STR2
CLC STR1(1),STR2
BE EQUAL BE BNE BL B BNL
BL LOWER
MVI RESR,C'>'
B DISP
EQUAL MVI RESR,C'='
B DISP
LOWER MVI RESR,C'<'
DISP MVC RES1,STR1
MVC RES2,STR2
WTO TEXT=MSG
L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
MSG DC AL2(7)
RES1 DS CL3
RESR DS CL1
RES2 DS CL3
STR1 DC C'5BC'
STR2 DC C'5EF'
END
//SYSUSR1C JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1) 00011000
//*JCLLIB ORDER=(SYSUSR1.ASM.PROC) 00012000
//DELDEF EXEC PGM=IDCAMS 00013000
//SYSPRINT DD SYSOUT=* 00013100
//SYSUDUMP DD SYSOUT=* 00013200
//SYSIN DD * 00013300
DELETE SYSUSR1.ASM.VSAMFILE CLUSTER 00021000
IF LASTCC=8 THEN SET MAXCC=0 00021100
DEFINE CLUSTER (NAME(SYSUSR1.ASM.VSAMFILE) - 00021200
CYLINDERS(2 1) - 00022001
FREESPACE(10 10) - 00026000
KEYS(6 0) - 00027000
RECORDSIZE(80 80) - 00028000
VOLUMES(USER01) - 00029000
INDEXED) - 00029300
DATA (NAME(SYSUSR1.ASM.VSAMFILE.DATA)) - 00030000
INDEX (NAME(SYSUSR1.ASM.VSAMFILE.INDEX)) 00150000
/* 00160000
//COPY EXEC PGM=IDCAMS 00170000
//INFILE DD DSN=SYSUSR1.ASM.STUDENT,DISP=SHR 00180000
//OUTFILE DD DSN=SYSUSR1.ASM.VSAMFILE,DISP=SHR 00200000
//SYSPRINT DD SYSOUT=* 00210000
//SYSUDUMP DD SYSOUT=* 00220000
//SYSIN DD * 00230000
REPRO INFILE(INFILE) OUTFILE(OUTFILE) 00240000
DATE370 CSECT
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
 LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
WTO TEXT=MESSAGE
*
TIME DEC,TIMEDATE,ZONE=LT,LINKAGE=SYSTEM
WTO TEXT=DISP1
* Supervisor call 18 returns
* time in R0; year with century
* in R1; day, month, and day of
* week in R2.
*
LR R3,R0 Put time in R3
LR R4,R1 Put time in R3
ST 3,DBL+4
UNPK TYPE+10(10),DBL+4(4)
OI TYPE+19,X'F0'
WTO TEXT=DISP
ST 4,DBL+4
UNPK TYPE+10(10),DBL+4(4)
OI TYPE+19,X'F0'
WTO TEXT=DISP
LR R3,R0 Put time in R3
SRL R3,24 hhmmssxx becomes 000000hh
CVD R3,DBL Hours only
UNPK TIME(2),DBL Move to output
OI TIME+1,X'F0' Remove sign
*
LR R3,R0 Put time in R3
SLL R3,8 hhmmssxx becomes mmssxx00
SRL R3,24 mmssxx00 becomes 000000mm
CVD R3,DBL Minutes only
UNPK TIME+3(2),DBL Move to output
OI TIME+4,X'F0' Remove sign
*
LR R3,R0 Put time in R3
SLL R3,16 hhmmssxx becomes ssxx0000
SRL R3,24 ssxx0000 becomes 000000ss
CVD R3,DBL Seconds only
UNPK TIME+6(2),DBL Move to output
OI TIME+7,X'F0' Remove sign
*
LR R3,R0 Put time in R3
SLL R3,24 hhmmssxx becomes xx000000
SRL R3,24 xx000000 becomes 000000xx
CVD R3,DBL Hundredths of seconds only
UNPK TIME+9(2),DBL Move to output
OI TIME+10,X'F0' Remove sign
*
CVD R1,DBL Year with century
UNPK DATE+6(4),DBL Move to output
OI DATE+9,X'F0' Remove sign
*
 LR R3,R2 Put date in R3
SRL R3,24 mmddww00 becomes 000000mm
CVD R3,DBL Month only
UNPK DATE(2),DBL Move to output
OI DATE+1,X'F0' Remove sign
*
LR R3,R2 Put date in R3
SLL R3,8 mmddww00 becomes ddww0000
SRL R3,24 ddww0000 becomes 000000dd
CVD R3,DBL Day of month only
UNPK DATE+3(2),DBL Move to output
OI DATE+4,X'F0' Remove sign
*
*
WTO text=MESSAGE (After)
*
L 13,SAVE+4
RETURN (14,12),,RC=0
*
MESSAGE DC al2(71)
DC CL18'DATE370...Time is '
TIME DC CL11'hh:mm:ss.xx'
DC CL11'...Date is '
DATE DC CL10'mm/dd/yyyy'
DC CL18'...Day of week is '
DOW DC CL3'ddd'
*
DBL DS D
DOWTBL DC C'SunMonTueWedThuFriSat'
DISP DC AL2(20) 00147000
TYPE DC CL10'SUM OF NS:' 00147000
DS CL10 00147000
SAVE DS 18F
DISP1 DC AL2(16) 00147000
TIMEDATE DS CL16 TIME AND DATE RETURNED
*
END
* TO EDIT PACKED DECIMAL NUMBER WITH ED AND EDMK 00010000
EDEX CSECT 00020000
SAVE (14,12) 00030000
BALR 12,0 00040000
USING *,12 00050000
ST 13,SAVE+4 00060000
LA 13,SAVE 00070000
*****END OF TEMPLATE 00071000
SRP PD1,1,0 DO A LEFT SHIFT 1 DIGIT (MULT BY 10) 00071101
AP PD1,PD2 ADD CONTENTS OF PD2 TO PD1 00071201
* MVC PATTERN,PATBKUP 00072001
MVC PATTERN,=X'402020204B21202040404040' 00073002
ED PATTERN,PD1 00080003
WTO MF=(E,MSG),ROUTCDE=11 00080100
L 13,SAVE+4 00082000
RETURN (14,12),,RC=0 00083000
* 00090000
* 00440000
DS 0F 00450000
R1 EQU 1 00460000
SAVE DS 18F 00470000
PD1 DC PL3'10.5' X'00105C' 00500001
PD2 DC PL3'2.25' X'00225C' 00510001
* MESSAGES 00530000
MSG DC H'16' 00540000
DC H'0' 00550000
***********END OF WTO MSG 00551200
PATTERN DS XL12 00551300
END 00730000
DSECTUSE CSECT 00010000
SAVE (14,12) 00020000
BALR 12,0 00030000
USING *,12 00040000
ST 13,SAVE+4 00050000
LA 13,SAVE 00060000
* 00070000
USING INREC,3 00071000
MVC MSGTEXT,MSGSTRT START PROCESSING 00080000
WTO MF=(E,MSG),ROUTCDE=11 00090000
OPEN (INFILE,INPUT) OPEN FILES 00100000
OPEN (OUTFILE,OUTPUT) 00110000
READFILE EQU * 00120000
GET INFILE READ INFILE LOCATE MODE 00130000
LR 3,1 DESCT REGISTER IS LOADED WITH RECORD ADDRESS 00131000
* 00140000
WRITE EQU * 00370000
MVC OUTREC(80),INREC POPULATE OUTREC 00391000
PUT OUTFILE,OUTREC WRITE OUTFILE 00400000
B READFILE 00410000
EOF EQU * 00420000
CLOSE (INFILE) CLOSE FILES 00450000
CLOSE (OUTFILE) 00460000
MVC MSGTEXT,MSGFINS FINISH PROCESSING 00470000
WTO MF=(E,MSG),ROUTCDE=11 00480000
* 00490000
L 13,SAVE+4 00500000
RETURN (14,12),,RC=0 00510000
* SAVEAREA 00670000
SAVE DS 18F 00680000
* WTO MESSAGE AREA 00690000
MSG DC H'80' 00700000
DC H'0' 00710000
MSGTEXT DS CL76 00720000
MSGSTRT DC C'PROCESSING STARTED' 00730000
DS CL58 00740000
MSGFINS DC C'PROCESSING FINISHED' 00750000
DS CL57 00760000
* FILES STRUCTURE AREA 00770000
OUTREC DS 0CL80 00860000
OTZD DS CL4 00861000
OTPD DS PL4 00862000
OINSTR1 DS CL10 00863000
OINSTR2 DS CL10 00864000
DS CL52 00865000
* COUNTERS 00870000
TOT1 DC PL6'0' 00880000
CNT1 DC PL4'0' 00890000
TOT2 DC PL6'0' 00900000
CNT2 DC PL4'0' 00910000
ERRCNT DC PL4'0' 00920000
ABCCNT DC PL4'0' 00930000
FLD2UNPK DS CL7 00940000
SAVR14 DS F 00950000
FLD1PCK DC PL3'0' 00960000
* DCB AREA 00970000
INFILE DCB DSORG=PS,MACRF=GL,DDNAME=INFILE,EODAD=EOF 00980000
OUTFILE DCB DSORG=PS,MACRF=PM,DDNAME=OUTFILE 00990000
* REGISTER EQUATES 01000000
R0 EQU 0 01010000
R1 EQU 1 01020000
R2 EQU 2 01030000
R3 EQU 3 01040000
R4 EQU 4 01050000
R5 EQU 5 01060000
R6 EQU 6 01070000
R7 EQU 7 01080000
R8 EQU 8 01090000
R9 EQU 9 01100000
R10 EQU 10 01110000
R11 EQU 11 01120000
R12 EQU 12 01130000
R13 EQU 13 01140000
R14 EQU 14 01150000
R15 EQU 15 01160000
* 01170000
INREC DSECT 01171000
INZD DS CL4 01172000
INPD DS PL4 01173000
INSTR1 DS CL10 01174000
INSTR2 DS CL10 01175000
DS CL52 01176000
* 01177000
END 01180000
* TO EDIT PACKED DECIMAL NUMBER WITH ED AND EDMK 00010000
EDEX CSECT 00020000
SAVE (14,12) 00030000
BALR 12,0 00040000
USING *,12 00050000
ST 13,SAVE+4 00060000
LA 13,SAVE 00070000
*****END OF TEMPLATE 00071000
MVC PATTERN,PATBKUP 00072003
ED PATTERN,PDNUM 00080000
WTO MF=(E,MSG),ROUTCDE=11 00080100
*AFTER EDMK REGISTER 1 CONTAINS ADDRESS WHERE FIRST SIGNIFICANT DGT 00080300
MVC PATTERN,PATBKUP 00080403
EDMK PATTERN,PDNUM1 00080503
S 1,FULLONE 00080601
MVI 0(R1),C'$' 00080701
WTO MF=(E,MSG),ROUTCDE=11 00080801
L 13,SAVE+4 00082000
RETURN (14,12),,RC=0 00083000
* 00090000
* 00440000
DS 0F 00450000
R1 EQU 1 00460000
SAVE DS 18F 00470000
FULLONE DC F'1' 00480001
PDNUM DC PL4'-124567' X'0124567D' 00500001
PDNUM1 DC PL4'4567' X'0004567C' 00510001
* MESSAGES 00530000
MSG DC H'16' 00540000
DC H'0' 00550000
***********END OF WTO MSG 00551200
PATTERN DS XL12 00551303
PATBKUP DC XL12'40206B2020206B2021206040' 00551403
END 00730000
* TO EDIT PACKED DECIMAL NUMBER WITH ED AND EDMK 00010000
EDEX1 CSECT 00020001
SAVE (14,12) 00030000
BALR 12,0 00040000
USING *,12 00050000
ST 13,SAVE+4 00060000
LA 13,SAVE 00070000
*****END OF TEMPLATE 00071000
MVC PATTERN,PATBKUP 00072000
EDMK PATTERN,PDNUM 00080002
CP PDNUM,=P'0' 00080102
BNL LOC1 00080202
S 1,FULLONE 00080302
MVI 0(R1),C'-' 00080402
LOC1 DS 0H 00080602
WTO MF=(E,MSG),ROUTCDE=11 00080702
MVC PATTERN,PATBKUP 00080802
EDMK PATTERN,PDNUM1 00080902
CP PDNUM1,=P'0' 00081002
BNL LOC2 00081102
S 1,FULLONE 00081202
MVI 0(R1),C'-' 00081302
LOC2 DS 0H 00081502
WTO MF=(E,MSG),ROUTCDE=11 00081602
L 13,SAVE+4 00082000
RETURN (14,12),,RC=0 00083000
* 00090000
* 00440000
DS 0F 00450000
R1 EQU 1 00460000
SAVE DS 18F 00470000
FULLONE DC F'1' 00480000
PDNUM DC PL4'-124567' X'0124567D' 00500000
PDNUM1 DC PL4'4567' X'0004567C' 00510000
* MESSAGES 00530000
MSG DC H'16' 00540000
DC H'0' 00550000
***********END OF WTO MSG 00551200
PATTERN DS XL12 00551300
PATBKUP DC XL12'40206B2020206B2021204040' 00551401
END 00730000
* EXAMPLE TO ILLUSTRATE THE EX INSTRUCTION USAGE 00010000
EXEG CSECT 00020000
R9 EQU 9 00021000
SAVE (14,12) 00030000
BALR 12,0 00040000
USING *,12 00050000
ST 13,SAVE+4 00060000
LA 13,SAVE 00070000
****END OF TEMPLATE 00070100
* LA R9,12(0,0) 00071000
L R9,MOVEVAL 00072000
 BCTR R9,0 DECREMENT REG 9 BY 1 00080000
EX R9,VARMVC 00080200
MVC MSGA,A 00080300
MVC MSGB,B 00080400
WTO MF=(E,MSG),ROUTCDE=11 00081000
L 13,SAVE+4 00082000
RETURN (14,12),,RC=0 00083000
* 00090000
* 00440000
DS 0F 00450000
SAVE DS 18F 00460000
* MESSAGES 00530000
MSG DC H'48' 00540000
DC H'0' 00550000
MSGA DS CL17 00550100
MSGX DC CL10' ' 00550200
MSGB DS CL17 00550300
VARMVC MVC A(0),B 00551000
A DC CL17'SOURCE : ORIGINAL' 00552000
B DC CL17'TARGET : COPY ' 00553000
MOVEVAL DC F'12' 00554000
END 00730000
FILEPROC CSECT 00010000
SAVE (14,12) 00020000
BALR 12,0 00030000
USING *,12 00040000
ST 13,SAVE+4 00050000
LA 13,SAVE 00060000
* 00070000
OPEN (INFILE,INPUT) OPEN FILES 00100000
OPEN (OUTFILE,OUTPUT) 00110000
READFILE EQU * 00120000
* GET INFILE,INREC READ INFILE INTO INREC 00130005
GET INFILE RECORD ADDRESS IN REG 1 00130105
ST R1,SAVER1 00130206
MVC MSG+2(80),0(1) 00130306
WTO TEXT=MSG 00130406
LH R5,COUNT LOAD COUNTER TO R5 00131007
LA R5,1(,R5) INCREMENT REGISTER 5 00132007
STH R5,COUNT 00133007
C R5,=F'1' IF =1 DO NOT WRITE...SKIP 00140007
BE READFILE 00150007
* 00310000
WRITE EQU * 00370000
* ADD CODE HERE TO MASSAGE INREC AND CREATE OUREC AS PER SPEC. 00380000
MVC OUTREC,=80C' ' 00390004
* MVC OUTREC(72),INREC POPULATE OUTREC 00390105
L R1,SAVER1 00391006
MVC OUTREC(72),0(1) 00392006
PUT OUTFILE,OUTREC WRITE OUTFILE 00400000
B READFILE 00410000
EOF EQU * 00420000
* DISPLAY THE CONTENTS OF THE COUNTER IN VARIABLE COUNT (H) 00430007
MVC MSG+2(80),=80C' ' 00440008
LH R5,COUNT 00440108
CVD 5,DWRD 00441007
ZAP PL1,DWRD COPY DWRD INTO PL1 00441109
ED PATTERN,PL1 00441210
MVC MSG+2(6),PATTERN 00443109
 WTO TEXT=MSG 00444007
CLOSE (INFILE) CLOSE FILES 00450000
CLOSE (OUTFILE) 00460000
* 00490000
L 13,SAVE+4 00500000
RETURN (14,12),,RC=0 00510000
* 00520000
MSG DC AL2(80) 00530001
DS CL80 00540001
* SAVEAREA 00670000
SAVE DS 18F 00680000
SAVER1 DS F 00681006
COUNT DC H'0' 00690000
DC 0D 00700007
DWRD DS D 00710007
PL1 DS PL3 00720009
PATTERN DC X'402020202120' 00730009
* FILES STRUCTURE INPUT FILE 00770000
INREC DS 0CL80 00780000
EMPNO DS CL6 00790000
EMPNAME DS CL25 00800000
DATEJOIN DS CL8 00810000
DS CL41 00830000
* 00840000
OUTREC DS CL80 00850002
* DCB AREA 00970000
*NFILE DCB DSORG=PS,MACRF=GM,DDNAME=INFILE,EODAD=EOF 00980005
INFILE DCB DSORG=PS,MACRF=GL,DDNAME=INFILE,EODAD=EOF 00980105
***** GM GET MOVE EODAD - AT END OF FILE 00981000
OUTFILE DCB DSORG=PS,MACRF=PM,DDNAME=OUTFILE 00990000
* REGISTER EQUATES 01000000
R0 EQU 0 01010000
R1 EQU 1 01020000
R2 EQU 2 01030000
R3 EQU 3 01040000
R4 EQU 4 01050000
R5 EQU 5 01060000
R6 EQU 6 01070000
R7 EQU 7 01080000
R8 EQU 8 01090000
R9 EQU 9 01100000
R10 EQU 10 01110000
R11 EQU 11 01120000
R12 EQU 12 01130000
R13 EQU 13 01140000
R14 EQU 14 01150000
R15 EQU 15 01160000
* 01170000
END 01180000
*** DISPLAY A BINARY NUMBER
FIRST CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
OPS OPEN (DUMPIT,OUTPUT)
 LA 7,1000
LA 8,1000
SNAP ID=1,STORAGE=(OPS,STEP1),PDATA=(REGS),DCB=DUMPIT
LAB1 BC X'00',STEP1 MASK FIRST TIME IS B'0000'
WTO 'INSIDE FOR FIRST TIME'
MVI LAB1+1,X'F0'
B LAB1
TESTC DC C'TESTING DUMP'
PL1 DC PL5'12345'
STEP1 DS 0H
SNAP ID=2,STORAGE=(OPS,STEP1),PDATA=(REGS),DCB=DUMPIT
WTO 'PROGRAM ENDED'
CLOSE (DUMPIT)
L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
DUMPIT DCB DSORG=PS,RECFM=VBA,MACRF=(W),BLKSIZE=882, C
LRECL=125,DDNAME=SOKDUMP
END
//TCHN005V JOB NOTIFY=&SYSUID,CLASS=A,MSGLEVEL=(1,1) 00001000
// JCLLIB ORDER=(TCHN005.TSO.PROCLIB) 00002000
//LISTC EXEC PGM=IDCAMS 00010000
//SYSPRINT DD SYSOUT=* 00020000
//SYSUDUMP DD SYSOUT=* 00030000
//SYSOUT DD SYSOUT=* 00040000
//SYSIN DD * 00050000
LISTC ENTRY('TCHN005.POLICY.VSAM') ALL 00060000
/* 00070000
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
MAIN CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
*LOAD THE PARAMETER ADDRESS IN REG 1 AND CALL SUBPGM -STATIC CALL
LA R1,PARMS
L R15,=V(SUBPGM)
BALR R14,R15
* LOAD EP=SUBPGM
* LR R15,R0
* LA R1,PARMS
* BALR R14,R15
*SUM WILL BE FILLED BY THE SUB PROGRAM
* ZAP SUM1,SUM
UNPK SUM1,SUM
OI SUM1+5,X'F0'
WTO TEXT=DISP
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
R1 EQU 1 00147000
R0 EQU 0 00147000
R14 EQU 14 00147000
R15 EQU 15 00147000
DS 0F 00148000
SAVE DS 18F SAVE AREA 00149000
PARMS EQU * 00149000
PL1 DC PL3'20' 00149000
PL2 DC PL3'30' 00149000
SUM DC PL3'0' 00149000
DISP EQU * 00149000
DC AL2(L'MSG+L'SUM1) 00149000
MSG DC C'SUM OF THE NUMBERS: ' 00149000
SUM1 DC CL6' ' 00149000
END MAIN 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
MAIN1 CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
*LOAD THE PARAMETER ADDRESS IN REG 1 AND CALL SUBPGM -STATIC CALL
LA R1,PARMS
L R15,=V(SUBPGM1)
BALR R14,R15 save the address of next ins in r14, br to r15
* LOAD EP=SUBPGM
* LR R15,R0
* LA R1,PARMS
* BALR R14,R15
*SUM WILL BE FILLED BY THE SUB PROGRAM
* ZAP SUM1,SUM
UNPK SUM1,SUM
 OI SUM1+5,X'F0'
WTO TEXT=DISP
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
PL1 DC PL3'20' 00147000
R1 EQU 1 00147000
R0 EQU 0 00147000
R14 EQU 14 00147000
R15 EQU 15 00147000
DS 0F 00148000
SAVE DS 18F SAVE AREA 00149000
SUM DS PL3 00149000
PARMS DC A(PL1) 00149000
DC A(PL2) 00149000
DC A(SUM) 00149000
DISP EQU * 00149000
DC AL2(L'MSG+L'SUM1) 00149000
MSG DC C'SUM OF THE NUMBERS: ' 00149000
SUM1 DC CL6' ' 00149000
PL2 DC PL3'30' 00149000
END MAIN1 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
MAIN1 CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
*LOAD THE PARAMETER ADDRESS IN REG 1 AND CALL SUBPGM -dynamic call
LOAD EP=SUBPGM1 after load, address of sub in r0
LR R15,R0
LA R1,PARMS
BALR R14,R15
*SUM WILL BE FILLED BY THE SUB PROGRAM
UNPK SUM1,SUM
OI SUM1+5,X'F0'
WTO TEXT=DISP
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
PL1 DC PL3'20' 00147000
R1 EQU 1 00147000
R0 EQU 0 00147000
R14 EQU 14 00147000
R15 EQU 15 00147000
DS 0F 00148000
SAVE DS 18F SAVE AREA 00149000
SUM DS PL3 00149000
PARMS DC A(PL1) 00149000
DC A(PL2) 00149000
DC A(SUM) 00149000
DISP EQU * 00149000
DC AL2(L'MSG+L'SUM1) 00149000
MSG DC C'SUM OF THE NUMBERS: ' 00149000
SUM1 DC CL6' ' 00149000
PL2 DC PL3'30' 00149000
END MAIN1 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
MAIN1 CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
*LOAD THE PARAMETER ADDRESS IN REG 1 AND CALL SUBPGM -dynamic call
LOAD EP=SUBPGM3 after load, address of sub in r0
LR R15,R0
LA R1,PARMS
BALR R14,R15
*SUM WILL BE FILLED BY THE SUB PROGRAM
lr 5,0
UNPK SUM1,0(3,5)
OI SUM1+5,X'F0'
WTO TEXT=DISP
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
 RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
PL1 DC PL3'20' 00147000
R1 EQU 1 00147000
R0 EQU 0 00147000
R14 EQU 14 00147000
R15 EQU 15 00147000
DS 0F 00148000
SAVE DS 18F SAVE AREA 00149000
SUM DS PL3 00149000
PARMS DC A(PL1) 00149000
DC A(PL2) 00149000
DISP EQU * 00149000
DC AL2(L'MSG+L'SUM1) 00149000
MSG DC C'SUM OF THE NUMBERS: ' 00149000
SUM1 DC CL6' ' 00149000
PL2 DC PL3'30' 00149000
END MAIN1 00150003
*** DISPLAY A BINARY NUMBER
BINDISP CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
**************************************
L 4,NUM1
ST 4,MIN
ST 4,MAX
L 4,NUM2
C 4,MIN
BNL NEXT1
ST 4,MIN
NEXT1 DS 0H
C 4,MAX
BL NEXT2
ST 4,MAX
NEXT2 DS 0H
L 4,NUM3
C 4,MIN
BNL NEXT3
ST 4,MIN
NEXT3 C 4,MAX
BL NEXT4
ST 4,MAX
NEXT4 EQU *
L 4,MIN
BAL 14,DISP
L 4,MAX
BAL 14,DISP
B FINISH
DISP DS 0H
ST 14,SAVE14
CVD 4,DW
UNPK MSG+2(16),DW
OI MSG+17,X'F0'
WTO TEXT=MSG
 L 14,SAVE14
BR 14
***************************************************
FINISH L 13,SAVE+4
LM 14,12,12(13)
LA 15,4
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
NUM1 DC F'200'
NUM2 DC F'1000'
NUM3 DC F'100'
MAX DC F'0'
MIN DC F'0'
SAVE14 DS F
DW DS D
END
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
MVCLEG CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
B BEGIN 00100000
LIT1 DC CL20'PROGRAM STARTED' 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
BEGIN DS 0H 00130000
WTO 'TO SHOW MVCL ',ROUTCDE=11
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
MVC TYPE,=C'TARGET BEF' 00142000
MVC DATA(250),TARGET 00142000
MVC DATA+250(250),TARGET+250 00142000
WTO TEXT=DISP 00142000
LA 4,TARGET 00142000
LA 5,500 00142000
LA 8,SOURCE 00142000
LA 9,15 00142000
ICM 9,8,PAD 00142000
MVCL 4,8 00142000
* MVC TYPE,=C'TARGET AFT' 00142000
MVC DATA(250),TARGET 00142000
MVC DATA+250(250),TARGET+250 00142000
 WTO TEXT=DISP 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
DISP DC AL2(511) 00147000
TYPE DC CL10'TARGET AFT' 00147000
DC C':' 00147000
DATA DS CL500 00147000
****END OF DATA FOR WTO 00147000
TARGET DS CL500 00147000
SOURCE DC CL15'ABCDEFGHIJKLMNO' 00147000
PAD DC C'*' 00147000
DS 0F 00148000
SAVE DS 18F 00149000
END MVCLEG 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
MVCLEG CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12,11 *Say the base register 11 & 12 00060000
LA 11,4095(0,12) 00060000
LA 11,1(0,11) *reg 11 has base address 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
B BEGIN 00100000
LIT1 DC CL20'PROGRAM STARTED' 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
BEGIN DS 0H 00130000
WTO 'TO SHOW MVCL ',ROUTCDE=11
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
mvcml MOVEL TARGET,DATA,1900 00142000
WTO TEXT=DISP 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
DISP DC AL2(2011) 00147000
TYPE DC CL10'TARGET AFT' 00147000
DC C':' 00147000
DATA DS CL2000 00147000
****END OF DATA FOR WTO 00147000
TARGET DS CL2000 00147000
SOURCE DC 200CL10'ABCDEFGHIJ' 00147000
DS 0F 00148000
SAVE DS 18F 00149000
END MVCLEG 00150003
*** PACKED DECIMAL OPERATIONS
PACKED CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
B MAIN
**************************************
PL1 DC PL4'3000' X'0003000C'
PL2 DC PL2'500' X'500C'
PL3 DS PL4
MAIN DS 0H
******ADD PL1 AND PL2 INTO PL3
ZAP PL3,PL1 PL3 WILL BE INITIALIZED AND ADDED WITH PL1
AP PL3,PL2
UNPK MSG+2(16),PL3
OI MSG+17,X'F0'
WTO TEXT=MSG
******8 IS THE EVEN REGISTER FOR THE DIVISION OPERATION
L 13,SAVE+4
LM 14,12,12(13)
LA 15,4
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
DW DS D
END
*** PACKED DECIMAL OPERATIONS
PACKED CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
B MAIN
**************************************
PL1 DC PL2'300' X'0003000C'
PL2 DC PL2'500' X'500C'
PL3 DC PL2'250' X'250C'
SUM DS PL4
PROD DS PL5
MAIN DS 0H
******ADD PL1 AND PL2 INTO PL3
ZAP SUM,PL1 PL3 WILL BE INITIALIZED AND ADDED WITH PL1
AP SUM,PL2
AP SUM,PL3
DP SUM,=PL2'3' SUM RIGHTMOST 2 BYTES -REMAINDER
**** SUM LEFTMOST 2 BYTES -QUOTIENT
ZAP PROD,PL1
MP PROD,PL3 PROD NOW CONTAINS PL1 * PL3
**** DISPLAY THE REMAINDER
UNPK MSG+2(16),SUM+2(2)
 OI MSG+17,X'F0'
WTO TEXT=MSG
**** DISPLAY THE QUOTIENT
UNPK MSG+2(16),SUM(2)
OI MSG+17,X'F0'
WTO TEXT=MSG
**** DISPLAY THE PRODUCT OF NUM1 AND NUM3
UNPK MSG+2(16),PROD
* OI MSG+17,X'F0'
WTO TEXT=MSG
******END OF BODY
L 13,SAVE+4
LM 14,12,12(13)
LA 15,4
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
DW DS D
END
PARMPASS CSECT 00010000
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING *,12 00040000
ST 13,SAVE+4 00050000
LA 13,SAVE 00060000
* REGISTER 1 ON ENTRY CONTAINS THE ADDRESS OF A FULLWORD 00070000
* THE FULLWORD CONTAINS THE ADDRESS OF THE DATA 00070100
* THE DATA CONTAINS FIRST 2 BYTES - LENGTH OF PARM REST-DATA 00070200
L 1,0(0,1) ....FULLWORD IS LOADED 00071000
LH 2,0(0,1) .....LENGTH OF PARM IS LOADED IN 2 00072000
STH 2,MSG 00073000
SH 2,=H'1' REDUCE THE LENGTH BY 1 TO MATCH OBJECT CODE 00073101
EX 2,MOVEL 00074000
WTO TEXT=MSG,ROUTCDE=11 00075000
L 13,SAVE+4 00080000
LM 14,12,12(13) 00090000
SR 15,15 00100000
BR 14 00110000
SAVE DS 18F 00120000
MSG DC AL2(0) 00121000
MSG1 DS CL100 00122000
MOVEL MVC MSG+2(0),2(1) 00123000
END 00130000
PARM1 CSECT 00010001
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING *,12 00040000
ST 13,SAVE+4 00050000
LA 13,SAVE 00060000
* REGISTER 1 ON ENTRY CONTAINS THE ADDRESS OF A FULLWORD 00070000
* THE FULLWORD CONTAINS THE ADDRESS OF THE DATA 00070100
* THE DATA CONTAINS FIRST 2 BYTES - LENGTH OF PARM REST-DATA 00070200
L 1,0(0,1) .... 1 CONTAINS ADDR OF DATA 00071001
LH 2,0(0,1) .....LENGTH OF PARM IS LOADED IN 2 00072000
LA 4,2(0,1) ....REG 4 POINT TO START OF DATA 00072102
AR 4,2 ...REG 4 POINTS 1 BYTE BEYOND DATA 00072202
BCTR 4,0 ...REG 4 POINTS TO LAST BYTE OF DATA 00072302
* REGISTER 1 POINT TO DATA 00072402
 LA 1,2(0,1) REGISTER 1 POINTS TO DATA 00072502
LA 3,NAME REGISTER 3 POINTS TO NAME 00072602
ST 1,SAVER1 SAVE REGISTER 1 00072708
CVD 1,DWD 00072803
UNPK MSG1(16),DWD 00072903
OI MSG1+15,X'F0' 00073003
WTO TEXT=DISP 00073103
CVD 4,DWD 00073203
UNPK MSG1(16),DWD 00073303
OI MSG1+15,X'F0' 00073403
WTO TEXT=DISP 00073503
L 1,SAVER1 00073607
FLOOP CLI 0(1),C' ' 00073703
BE FEXIT 00073803
MVC 0(1,3),0(1) 00074001
LA 1,1(0,1) 00074101
LA 3,1(0,3) 00074201
B FLOOP 00074301
FEXIT ST 1,SAVER1 SAVE REG 1 FOR WTO 00075009
CVD 1,DWD 00075109
UNPK MSG1(16),DWD 00075209
OI MSG1+15,X'F0' 00075309
WTO TEXT=DISP 00075409
MVC LIT,=C'FIRST NAME:' 00075609
WTO TEXT=MSG,ROUTCDE=11 00076001
* SKIP THE BLANK AND POINT TO THE FIRST BYTE OF LAST NAME 00080002
MVC NAME,=20C' ' 00080104
L 1,SAVER1 00080208
LA 1,1(0,1) 00080306
LA 3,NAME 00080406
LLOOP CR 1,4 00080502
BH LEXIT 00080602
MVC 0(1,3),0(1) 00080702
LA 1,1(0,1) 00080802
LA 3,1(0,3) 00080902
B LLOOP 00081002
LEXIT MVC LIT,=C'LAST NAME:' 00081102
WTO TEXT=MSG,ROUTCDE=11 00082002
L 13,SAVE+4 00083002
LM 14,12,12(13) 00090000
SR 15,15 00100000
BR 14 00110000
SAVE DS 18F 00120000
SAVER1 DS F 00120107
MSG DC AL2(31) 00121001
LIT DS CL11 00122001
NAME DS CL20 00122101
DISP DC AL2(16) 00122203
MSG1 DS CL(16) 00122303
DS 0D 00122403
DWD DS D 00122505
END 00130000
*** CALULATE AND DISPLAY PERCENTAGE
PACKED CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
 B MAIN
**************************************
NUM1 DC CL4'5000' 50.00
NUM2 DC CL4'1033' TWO DECIMAL 10.33% (50.00 X 10.33)/100.00
DISP1 DC AL2(15) X'250C'
PL1 DS PL4'0' X'250C'
PL2 DS PL4'0' 10X 100/100
PROD DS PL7'0'
MAIN DS 0H
******ADD PL1 AND PL2 INTO PL3
PACK PL1,NUM1 PACK ZD INTO PL
PACK PL2,NUM2
MVN PL1+L'PL1-1(1),=X'0C'
MVN PL2+L'PL2-1(1),=X'0C'
ZAP PROD,PL1
MP PROD,PL2 PROD CONTAINS MULT OF PL1 & PL2
*PROD PROD HAS 4 DECIMAL PLACES USE SRP TO ROUND 2 TWO DECIMAL
SRP PROD,64-2,5 ADJUST TO 2 DECIMAL PLACES
SRP PROD,64-2,0 DIVIDE BY 100 GET PERCENTAGE
WTO TEXT=DISP1
ED PATTERN(16),PROD
WTO TEXT=MSG
******END OF BODY
L 13,SAVE+4
LM 14,12,12(13)
LA 15,4
BR 14
SAVE DS 18F
MSG DC AL2(16)
PATTERN DC X'40',10X'20',X'21',C'.',3X'20'
END
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
SUBPGM CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
USING PARMS,R4 DSECT FOR PARMS
LR R4,R1 R1 CONTAINS PARMS ADDRESS
ZAP SSUM,SPL1 ZAP SSUM,0(3,1)
AP SSUM,SPL2 ZAP SSUM,3(3,1)
ZAP RESULT+2(3),SSUM
WTO TEXT=RESULT
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
R1 EQU 1 00148000
R4 EQU 4 00148000
DS 0F 00148000
SAVE DS 18F 00149000
RESULT EQU * 00149000
DC AL2(3) 00149000
DC PL3'0' 00149000
PARMS DSECT 00149000
SPL1 DC PL3'0' 00149000
SPL2 DC PL3'0' 00149000
SSUM DC PL3'0' 00149000
END SUBPGM 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
SUBPGM1 CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
USING PARMS,R4 DSECT FOR PARMS
LR R4,R1 R1 CONTAINS PARMS ADDRESS
L R5,APL1
L R6,ASUM
ZAP 0(3,6),0(3,5)
L R5,APL2
AP 0(3,6),0(3,5)
ZAP RESULT+2(3),0(3,6)
WTO TEXT=RESULT
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
R1 EQU 1 00148000
R4 EQU 4 00148000
R5 EQU 5 00148000
R6 EQU 6 00148000
DS 0F 00148000
SAVE DS 18F 00149000
RESULT EQU * 00149000
DC AL2(3) 00149000
DC PL3'0' 00149000
PARMS DSECT 00149000
APL1 DS F 00149000
APL2 DS F 00149000
ASUM DS F 00149000
END SUBPGM1 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
SUBPGM3 CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
USING PARMS,R4 DSECT FOR PARMS
LR R4,R1 R1 CONTAINS PARMS ADDRESS
L R5,APL1
LA R6,SUM
ZAP 0(3,6),0(3,5)
L R5,APL2
AP 0(3,6),0(3,5)
ZAP RESULT+2(3),0(3,6)
WTO TEXT=RESULT
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL LR 0,6 00143000
L 13,SAVE+4 00143000
lm 14,15,12(13) restore all registers except 0 00144000
lm 1,12,24(13) that contains address of sum 00144000
br 14 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
R1 EQU 1 00148000
R4 EQU 4 00148000
R5 EQU 5 00148000
R6 EQU 6 00148000
DS 0F 00148000
SAVE DS 18F 00149000
RESULT EQU * 00149000
DC AL2(3) 00149000
DC PL3'0' 00149000
sum Ds PL3 00149000
PARMS DSECT 00149000
APL1 DS F 00149000
APL2 DS F 00149000
END SUBPGM3 00150003
*********Attention **********************************
************************************************************ 00020000
*%%%% Instructions %%%%%%% 00020000
*%%%% 1. Change the program name replacing TEMPLATE %%%%%%% 00020000
*%%%% 2. Replace the Body with your core program %%%%%%% 00020000
************************************************************* 00020000
*------------------------------------------------------------
*********Entry conventions***********
*------------------------------------------------------------
TEMPLATE CSECT 00030002
SAVE (14,12) 00040000
BALR 12,0 *Load the base address 00050000
USING *,12 *Say the base register 00060000
ST 13,SAVE+4 *Store calling programs save area 00070000
LR 4,13 00080000
LA 13,SAVE *Load current save area address 00090000
ST 13,8(0,4) *Store in calling programs save area 00100000
****************************************** 00110000
**Body of the program 00120000
****************************************** 00130000
WTO 'THIS IS A TEST MESSAGE',ROUTCDE=11
***************************************** 00140000
**Housekeeping before returning control 00141000
***Exit conventions*******************
***************************************** 00142000
FINAL L 13,SAVE+4 00143000
RETURN (14,12),,RC=0 00144000
************************************** 00145000
***Save area*** 00146000
************************************** 00147000
DS 0F 00148000
SAVE DS 18F 00149000
END TEMPLATE 00150003
*** COMPARE 2 STRINGS
COMPARE1 CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
* CLC STR1,STR2
CLC STR1(1),STR2
BE EQUAL BE BNE BL B BNL
BL LOWER
MVI RESR,C'>'
B DISP
EQUAL MVI RESR,C'='
B DISP
LOWER MVI RESR,C'<'
DISP MVC RES1,STR1
MVC RES2,STR2
WTO TEXT=MSG
L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
MSG DC AL2(7)
RES1 DS CL3
RESR DS CL1
RES2 DS CL3
STR1 DC C'5BC'
STR2 DC C'5EF'
END
*** EXAMPLE FOR TEST UNDER MASK
TMEG CSECT
STM 14,12,12(13)
BALR 12,0
USING *,12
ST 13,SAVE+4
LA 13,SAVE
R4 EQU 4
******END OF PROLOGUE
TM PL1+2,B'00001100'
BNO NOTP
TM PL1+2,B'00000011'
BNZ NOTP
WTO 'POSITIVE PD NUMBER'
B FINISH
NOTP WTO 'NOT A POSITVE PD NUMBER'
FINISH L 13,SAVE+4
LM 14,12,12(13)
LA 15,0
BR 14
SAVE DS 18F
MSG DC AL2(16)
DS CL16
PL1 DC PL3'12' X'00012C' B'1100' = X'C'
END
TRANSLU CSECT 00010000
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING BEGIN,12 00040000
BEGIN EQU * 00041000
ST 13,SAVE+4 00050000
LA 13,SAVE 00060000
*****end of template 00070000
TR INP,TABLE 00080300
MVC MSG+2(10),INP 00080400
WTO TEXT=MSG,ROUTCDE=11 00080500
L 13,SAVE+4 00081000
LM 14,12,12(13) 00090000
SR 15,15 00100000
BR 14 00110000
SAVE DS 18F 00120000
MSG DC AL2(L'INP) 00121100
DS CL(L'INP) 00121200
INP dc cl10'Sample msg' 00121300
*ABLE DC 256AL1(*-TABLE) 00130500
* ORG TABLE+X'81' 00130600
* ORG TABLE+X'81' 00130700
TABLE DC X'000102030405060708090A0B0C0D0E0F' 16 HEX DIGITS 00130800
DC X'101112131415161718191A1B1C1D1E1F' 16 HEX DIGITS 00130900
DC X'202122232425262728292A2B2C2D2E2F' 16 HEX DIGITS 00131000
DC X'303132333435363738393A3B3C3D3E3F' 16 HEX DIGITS 00131100
DC X'404142434445464748494A4B4C4D4E4F' 16 HEX DIGITS 00131200
DC X'505152535455565758595A5B5C5D5E5F' 16 HEX DIGITS 00131300
DC X'606162636465666768696A6B6C6D6E6F' 16 HEX DIGITS 00131400
DC X'707172737475767778797A7B7C7D7E7F' 16 HEX DIGITS 00131500
DC X'808182838485868788898A8B8C8D8E8F' 16 HEX DIGITS 00131600
DC X'909192939495969798999A9B9C9D9E9F' 16 HEX DIGITS 00131700
DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' 16 HEX DIGITS 00131800
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 16 HEX DIGITS 00131900
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' 16 HEX DIGITS 00132000
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' 16 HEX DIGITS 00132100
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' 16 HEX DIGITS 00132200
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' 16 HEX DIGITS 00132300
ORG TABLE+X'81' 00132400
DC C'ABCDEFGHI' 00132500
ORG TABLE+X'91' 00132600
DC C'JKLMNOPQR' 00132700
ORG TABLE+X'A2' 00132800
DC C'STUVWXYZ' 00132900
ORG 00133000
END 00140000
TRANSLU CSECT 00010000
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING BEGIN,12 00040000
BEGIN EQU * 00041000
ST 13,SAVE+4 00050000
LA 13,SAVE 00060000
*****end of template 00070000
TR INP,TABLE 00080300
MVC MSG+2(10),INP 00080400
WTO TEXT=MSG,ROUTCDE=11 00080500
L 13,SAVE+4 00081000
LM 14,12,12(13) 00090000
SR 15,15 00100000
BR 14 00110000
SAVE DS 18F 00120000
MSG DC AL2(L'INP) 00121100
DS CL(L'INP) 00121200
INP dc cl10'Sample*msg$$$//' *,$,/ 00121301
*ABLE DC 256AL1(*-TABLE) 00130500
* ORG TABLE+X'81' 00130600
* ORG TABLE+X'81' 00130700
TABLE DC X'000102030405060708090A0B0C0D0E0F' 16 HEX DIGITS 00130800
DC X'101112131415161718191A1B1C1D1E1F' 16 HEX DIGITS 00130900
DC X'202122232425262728292A2B2C2D2E2F' 16 HEX DIGITS 00131000
DC X'303132333435363738393A3B3C3D3E3F' 16 HEX DIGITS 00131100
DC X'404142434445464748494A4B4C4D4E4F' 16 HEX DIGITS 00131200
DC X'505152535455565758595A5B5C5D5E5F' 16 HEX DIGITS 00131300
DC X'606162636465666768696A6B6C6D6E6F' 16 HEX DIGITS 00131400
DC X'707172737475767778797A7B7C7D7E7F' 16 HEX DIGITS 00131500
DC X'808182838485868788898A8B8C8D8E8F' 16 HEX DIGITS 00131600
DC X'909192939495969798999A9B9C9D9E9F' 16 HEX DIGITS 00131700
 DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' 16 HEX DIGITS 00131800
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 16 HEX DIGITS 00131900
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' 16 HEX DIGITS 00132000
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' 16 HEX DIGITS 00132100
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' 16 HEX DIGITS 00132200
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' 16 HEX DIGITS 00132300
ORG TABLE+C'a' 00132401
DC C'ABCDEFGHI' 00132500
ORG TABLE+X'91' 00132600
DC C'JKLMNOPQR' 00132700
ORG TABLE+X'A2' 00132800
DC C'STUVWXYZ' 00132900
ORG TABLE+C'*' 00133001
DC X'40' 00134001
ORG TABLE+C'$' 00135001
DC X'40' 00136001
ORG TABLE+C'/' 00137001
DC X'40' 00138001
ORG 00139001
END 00140000
TRTEG CSECT 00010000
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING BEGIN,12 00040000
BEGIN EQU * 00050000
ST 13,SAVE+4 00060000
LA 13,SAVE 00070000
TRT INP,TABLE 00080000
BZ notfound 00090000
stc 2,foundb 00091000
WTO 'numeric zoned decimal found' 00100000
mvc msg+2(10),=cl10' ' 00100100
mvc msg+2(5),=c'char=' 00100200
mvc msg+7(1),foundb 00100300
wto text=msg 00100400
b endpgm 00100500
notfound equ * 00101000
WTO 'numeric zoned decimal not found' 00101100
endpgm L 13,SAVE+4 00110000
LM 14,12,12(13) 00120000
SR 15,15 00130000
BR 14 00140000
foundb Dc cl1' ' 00150000
DS 0f 00150100
SAVE DS 18F 00151000
MSG DC AL2(10) 00160000
DC CL10' ' 00170000
inp dc cl10'xxxx23xxxx' 00180001
TABLE DC 256x'00' 00190000
ORG TABLE+X'F0' 00200000
DC C'0123456789' 00210000
ORG 00260000
END 00270000
TRTEG1 CSECT 00010001
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING BEGIN,12 00040000
***TO USE TRT TO VALIDATE WHETHER INPUT IS A VALID NUMBER 00050001
BEGIN EQU * 00051001
 ST 13,SAVE+4 00060000
LA 13,SAVE 00060111
*****begin main logic 00061011
LA 6,INP address of inp in reg 6 00071008
LA 7,L'INP(0,6) reg 7 address last char of inp 00072012
MVC OUT,INP 00073012
LA 8,INP 00074012
**** USE ex INSTRUCTION TO DYNAMICALLY ALTER THE LENGTH OF trt 00080007
TRTLOOP cr 6,7 00081008
bh endpgm address past the last character 00090008
lr 9,7 inp last char address in reg 9 loaded 00091011
sr 9,6 00092008
bctr 9,0 reduce length by 1 00093011
ex 9,trtex 00094008
bz endpgm 00095008
mvc foundb,0(1) REGISTER 1 CONTAIN ADDRESS OF INVALID CHAR 00096012
mvc 0(1,1),X'40' REPLACE INVALID WITH BLANKS 00096112
st 1,saver1 00097008
WTO 'non numeric value found ' 00100001
mvc msg+2(10),=cl10' ' 00100100
mvc msg+2(5),=c'char=' 00100200
mvc msg+7(2),foundb 00100304
wto text=msg 00100400
l 1,saver1 00100508
lr 6,1 00100608
la 6,1(0,6) 00100710
b trtloop 00100810
numeric equ * 00101001
WTO 'all characters were digits' 00101101
endpgm MVC OUTPUT+2(15),INP 00110012
WTO TEXT=OUTPUT 00110112
L 13,SAVE+4 00111012
LM 14,12,12(13) 00120000
SR 15,15 00130000
BR 14 00140000
trtex trt 0(0,6),table 00150008
foundb Dc cl1' ' 00150108
DS 0f 00150208
SAVE DS 18F 00151000
SAVER1 DS f 00152009
MSG DC AL2(10) 00160000
DC CL10' ' 00170000
inp dc cl15'1/34a67*9067$%6' 00180011
OUT dS cl15 00181012
OUTPUT dC AL2(15) 00182012
dS CL15 00183013
TABLE DC 256x'FF' 00190001
ORG TABLE+X'F0' 00200000
DC 10X'00' 00210001
ORG 00260000
END 00270000
VALID CSECT 00010001
STM 14,12,12(13) 00020000
BALR 12,0 00030000
USING BEGIN,12 00040000
***TO USE TRT TO VALIDATE WHETHER INPUT IS A VALID NUMBER 00050000
BEGIN EQU * 00051000
ST 13,SAVE+4 00060000
LA 13,SAVE 00070000
 LA 6,INP 00071000
LA 7,L'INP(0,6) END OF INP 00072001
CMPLOOP DS 0H 00081001
CLC 0(1,6),=C'0' 00090001
BL INVALID 00090101
CLC 0(1,6),=C'9' 00090201
BH INVALID 00090301
LA 6,1(,6) POINT TO THE NEXT BYTE IN THE INPUT 00090401
CR 6,7 00090501
BH ENDPGM 00090601
B CMPLOOP 00090701
INVALID DS 0H 00090801
mvc foundb,0(1) 00091000
WTO 'non numeric value found ' 00100000
mvc msg+2(10),=cl10' ' 00100100
mvc msg+2(5),=c'char=' 00100200
mvc msg+7(2),foundb 00100300
wto text=msg 00100400
b endpgm 00100500
numeric equ * 00101000
WTO 'all characters were digits' 00101100
endpgm L 13,SAVE+4 00110000
LM 14,12,12(13) 00120000
SR 15,15 00130000
BR 14 00140000
foundb Dc cl1' ' 00150000
DS 0f 00150100
SAVE DS 18F 00151000
MSG DC AL2(10) 00160000
DC CL10' ' 00170000
inp dc cl10'1/34a67*90' 00180000
TABLE DC 256x'FF' 00190000
ORG TABLE+X'F0' 00200000
DC 10X'00' 00210000
ORG 00260000
END 00270000
VSAMINS1 CSECT 00010007
SAVE (14,12) 00020000
BALR 3,0 00021000
USING *,3 00022000
ST 13,SAVE+4 00030000
LA 13,SAVE 00040000
***END OF TEMPLATE 00041006
OPEN (VSAMACB,(INPUT)) 00050000
LTR 15,15 00050100
BNZ VSMOPERR 00050200
OPEN (INFILE,(INPUT)) 00051000
INLOOP GET INFILE 00080000
LR 12,1 00080100
MVC INBUFF,0(12) 00080203
MVC SNOO,SNOI 00081003
MVC DJOINO,DJOINI 00081103
MVC RESTO,RESTI 00081203
MVC NAMEO,NAMEI 00081303
PUT RPL=VSAMRPL 00081403
LTR 15,15 00081600
BZ INLOOP 00081700
CVD 15,DWD 00081800
UNPK MSG+2(16),DWD 00081900
 OI MSG+17,X'F0' 00082001
WTO TEXT=MSG 00082100
B ERROR2 00082200
VSMOPERR WTO 'ERROR OPENING VSAM' 00240000
L 13,SAVE+4 00241000
RETURN (14,12),RC=1 00250000
ERROR2 MVC STUD,0(12) 00254000
MVC ERRD,=C'INS ' 00260001
WTO TEXT=DISP 00270000
B INLOOP 00271000
ENDRTN CLOSE VSAMACB 00300000
CLOSE INFILE 00301000
L 13,SAVE+4 00310000
RETURN (14,12),RC=0 00320000
MSG DC AL2(16) 00330000
DS CL16 00330100
DISP DC AL2(L'ERRL+L'ERRD+L'STUD) 00330200
ERRL DC C'ERROR IN ' 00330300
ERRD DS CL4 ' 00330400
STUD DS CL6 00330500
INBUFF DS 0CL80 00331003
SNOI DS CL6 00332003
NAMEI DS CL25 00333003
DJOINI DS CL8 00334003
RESTI DS CL43 00335003
OUTBUFF DS 0CL80 00340000
SNOO DS CL6 00341003
NAMEO DS CL25 00342003
DJOINO DS CL8 00343003
RESTO DS CL43 00344003
DS 0F 00350000
SAVE DS 18F 00350100
SAVER14 DS F 00351000
DS 0D 00352000
DWD DS D 00360000
RETCODE DS F 00361000
INFILE DCB DDNAME=INFILE,MACRF=GL,DSORG=PS,EODAD=ENDRTN 00362000
VSAMACB ACB AM=VSAM,DDNAME=INVSAM,MACRF=(KEY,DIR,OUT) 00390006
VSAMRPL RPL AM=VSAM,ACB=VSAMACB,AREA=OUTBUFF, *00400000
AREALEN=80,ARG=VSAMKEY,KEYLEN=6, *00410000
OPTCD=(KEY,MVE,NUP),RECLEN=80 00420006
VSAMKEY DS CL6 00430000
END 00440000
VSAMINS1 CSECT 00010000
SAVE (14,12) 00020000
BALR 3,0 00021000
USING *,3 00022000
ST 13,SAVE+4 00030000
LA 13,SAVE 00040000
***END OF TEMPLATE 00041000
OPEN (VSAMACB,(INPUT)) 00050000
LTR 15,15 00050100
BNZ VSMOPERR 00050200
OPEN (INFILE,(INPUT)) 00051000
INLOOP GET INFILE,EMPREC 00080001
*SECRETCODE IS SECCODE -CL3 00080301
MVC TEMPNAME,EMPNAME 00080401
TR TEMPNAME(1),SECTBL 00080501
TR TEMPNAME(3),SECTBL 00080601
 TR TEMPNAME(5),SECTBL 00080701
MVC SECC(1),TEMPNAME 00080801
MVC SECC(2),TEMPNAME+2 00081001
MVC SECC(3),TEMPNAME+4 00081101
00081201
00081301
00081401
PUT RPL=VSAMRPL 00081501
LTR 15,15 00081600
BZ INLOOP 00081700
CVD 15,DWD 00081800
UNPK MSG+2(16),DWD 00081900
OI MSG+17,X'F0' 00082000
WTO TEXT=MSG 00082100
B ERROR2 00082200
VSMOPERR WTO 'ERROR OPENING VSAM' 00240000
L 13,SAVE+4 00241000
RETURN (14,12),RC=1 00250000
ERROR2 MVC STUD,0(12) 00254000
MVC ERRD,=C'INS ' 00260000
WTO TEXT=DISP 00270000
B INLOOP 00271000
ENDRTN CLOSE VSAMACB 00300000
CLOSE INFILE 00301000
L 13,SAVE+4 00310000
RETURN (14,12),RC=0 00320000
MSG DC AL2(16) 00330000
DS CL16 00330100
DISP DC AL2(L'ERRL+L'ERRD+L'STUD) 00330200
ERRL DC C'ERROR IN ' 00330300
ERRD DS CL4 ' 00330400
STUD DS CL6 00330500
INBUFF DS 0CL80 00331000
SNOI DS CL6 00332000
NAMEI DS CL25 00333000
DJOINI DS CL8 00334000
RESTI DS CL43 00335000
EMPIN DS 0CL200 INPUT FILE 00340001
EMPNO DS CL6 00341001
NAME DS CL25 00342001
SECC DS CL3 00343001
LOCATION DS CL10 00344001
BPAY DS CL8 00345001
GRADE DS CL1 00346001
DJOIN DS CL8 00347001
PAYARRAY DS 12CL10 00348001
REST DS CL19 00349001
DS 0F 00350000
SAVE DS 18F 00350100
SAVER14 DS F 00351000
DS 0D 00352000
DWD DS D 00360000
RETCODE DS F 00361000
INFILE DCB DDNAME=INFILE,MACRF=GM,DSORG=PS,EODAD=ENDRTN 00362001
VSAMACB ACB AM=VSAM,DDNAME=INVSAM,MACRF=(KEY,DIR,OUT) 00390000
VSAMRPL RPL AM=VSAM,ACB=VSAMACB,AREA=OUTBUFF, *00400000
AREALEN=200,ARG=VSAMKEY,KEYLEN=6, *00410001
OPTCD=(KEY,MVE,NUP),RECLEN=200 00420001
VSAMKEY DS CL6 00430000
SECTBL DC X'000102030405060708090A0B0C0D0E0F' 16 HEX DIGITS 00432001
DC X'101112131415161718191A1B1C1D1E1F' 16 HEX DIGITS 00433001
DC X'202122232425262728292A2B2C2D2E2F' 16 HEX DIGITS 00434001
DC X'303132333435363738393A3B3C3D3E3F' 16 HEX DIGITS 00435001
DC X'404142434445464748494A4B4C4D4E4F' 16 HEX DIGITS 00436001
DC X'505152535455565758595A5B5C5D5E5F' 16 HEX DIGITS 00437001
DC X'606162636465666768696A6B6C6D6E6F' 16 HEX DIGITS 00438001
DC X'707172737475767778797A7B7C7D7E7F' 16 HEX DIGITS 00439001
DC X'808182838485868788898A8B8C8D8E8F' 16 HEX DIGITS 00439101
DC X'909192939495969798999A9B9C9D9E9F' 16 HEX DIGITS 00439201
DC X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF' 16 HEX DIGITS 00439301
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 16 HEX DIGITS 00439401
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' 16 HEX DIGITS 00439501
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' 16 HEX DIGITS 00439601
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' 16 HEX DIGITS 00439701
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' 16 HEX DIGITS 00439801
ORG TABLE+C'A' 00439901
DC C'CDEFGHIJK' 00440001
ORG TABLE+X'J' 00441001
DC C'LMNOPQRST' 00442001
ORG TABLE+X'S' 00443001
DC C'UVWXYZAB' 00444001
ORG TABLE+C'a' 00444101
DC C'cdefghijk' 00444201
ORG TABLE+X'j' 00444301
DC C'lmnopqrst' 00444401
ORG TABLE+X's' 00444501
DC C'uvwxyzab' 00444601
ORG 00445001
END 00450000
VSMINS CSECT 00010000
SAVE (14,12) 00020000
BALR 3,0 00021000
USING *,3 00022000
ST 13,SAVE+4 00030000
LA 13,SAVE 00040000
OPEN (OUTFILE,OUTPUT) 00041004
OPEN (VSAMACB,(INPUT)) 00050000
LTR 15,15 00050204
BNZ VSMOPERR 00050304
MVC VSAMKEY,=6X'00' 00051002
VSAMLOOP GET RPL=VSAMRPL 00080001
MVC SNOO,SNOI 00081000
MVC DJOINO,DJOINI 00081100
MVC RESTO,RESTI 00081200
MVC NAMEO,NAMEI 00081300
PUT OUTFILE,OUTBUFF 00081404
B VSAMLOOP 00082201
VSMOPERR WTO 'ERROR OPENING VSAM' 00240000
L 13,SAVE+4 00241000
RETURN (14,12),RC=1 00250000
ERROR2 MVC STUD,0(12) 00254000
MVC ERRD,=C'INS ' 00260000
WTO TEXT=DISP 00270000
B VSAMLOOP 00271003
ENDRTN CLOSE VSAMACB 00300000
CLOSE OUTFILE 00301004
L 13,SAVE+4 00310000
RETURN (14,12),RC=0 00320000
MSG DC AL2(16) 00330000
DS CL16 00330100
DISP DC AL2(L'ERRL+L'ERRD+L'STUD) 00330200
ERRL DC C'ERROR IN ' 00330300
ERRD DS CL4 ' 00330400
STUD DS CL6 00330500
INBUFF DS 0CL80 00340004
SNOI DS CL6 00341006
NAMEI DS CL25 00342006
DJOINI DS CL8 00343006
RESTI DS CL43 00344006
OUTBUFF DS 0CL80 00345004
SNOO DS CL6 00346004
NAMEO DS CL25 00347004
DJOINO DS CL8 00348004
RESTO DS CL43 00349004
DS 0F 00350000
SAVE DS 18F 00350100
SAVER14 DS F 00351000
DS 0D 00352000
DWD DS D 00360000
OUTFILE DCB DDNAME=OUTFILE,MACRF=PM,DSORG=PS 00370007
VSAMACB ACB AM=VSAM,DDNAME=INVSAM,MACRF=(KEY,DIR,OUT), *00390001
EXLST=LIST 00391002
LIST EXLST EODAD=ENDRTN 00392003
VSAMRPL RPL AM=VSAM,ACB=VSAMACB,AREA=INBUFF, *00400004
AREALEN=80,ARG=VSAMKEY,KEYLEN=6, *00410000
OPTCD=(FWD,ARD,MVE,NUP),RECLEN=80 00420001
VSAMKEY DS CL6 00430000
END 00440000
VSMUPD CSECT 00010018
SAVE (14,12) 00020000
BALR 3,0 00021000
USING *,3 00022000
ST 13,SAVE+4 00030000
LA 13,SAVE 00040000
OPEN (VSAMACB,(INPUT)) 00050000
LTR 15,15 00050100
BNZ VSMOPERR 00050200
OPEN (INFILE,(INPUT)) 00051000
INLOOP GET INFILE 00080000
LR 12,1 00080100
MVC VSAMKEY,0(12) 00083003
GET RPL=VSAMRPL 00090000
LTR 15,15 TEST RETURN CODE IN R15 00200006
BNZ ERROR2 00201018
MVC NAME,6(12) 00211001
MVC DATEJOIN,31(12) 00212021
PUT RPL=VSAMRPL UPDATE VSAM FILE 00220022
B INLOOP 00230000
VSMOPERR WTO 'ERROR OPENING VSAM' 00240000
L 13,SAVE+4 00241000
RETURN (14,12),RC=1 00250000
ERROR2 MVC STUD,0(12) 00254007
MVC ERRD,=C'UPD ' 00260018
WTO TEXT=DISP 00270007
B INLOOP 00271007
ENDRTN CLOSE VSAMACB 00300000
CLOSE INFILE 00301000
 L 13,SAVE+4 00310000
RETURN (14,12),RC=0 00320000
MSG DC AL2(16) 00330012
DS CL16 00330110
DISP DC AL2(L'ERRL+L'ERRD+L'STUD) 00330210
ERRL DC C'ERROR IN ' 00330310
ERRD DS CL4 ' 00330410
STUD DS CL6 00330510
INBUFF DS CL80 00331004
OUTBUFF DS 0CL80 00340000
SNO DS CL6 00341001
NAME DS CL25 00342001
DATEJOIN DS CL8 00343021
REST DS CL41 00344021
DS 0F 00350011
SAVE DS 18F 00350111
SAVER14 DS F 00351002
DS 0D 00352011
DWD DS D 00360011
RETCODE DS F 00361000
INFILE DCB DDNAME=INFILE,MACRF=GL,DSORG=PS,EODAD=ENDRTN 00362000
VSAMACB ACB AM=VSAM,DDNAME=INVSAM,MACRF=(KEY,DIR,OUT) 00390000
VSAMRPL RPL AM=VSAM,ACB=VSAMACB,AREA=OUTBUFF, *00400000
AREALEN=80,ARG=VSAMKEY,KEYLEN=6, *00410001
OPTCD=(KEY,DIR,MVE,UPD),RECLEN=80 00420009
VSAMKEY DS CL6 00430000
END 00440000
VSMMOD CSECT 00010005
SAVE (14,12) 00020000
BALR 3,0 00021000
USING *,3 00022000
ST 13,SAVE+4 00030000
LA 13,SAVE 00040000
OPEN (VSAMACB,(INPUT)) 00050000
LTR 15,15 00050100
BNZ VSMOPERR 00050200
OPEN (INFILE,(INPUT)) 00051000
INLOOP GET INFILE 00080000
LR 12,1 00080100
MVC VSAMKEY,0(12) 00083000
GET RPL=VSAMRPL 00090000
LTR 15,15 TEST RETURN CODE IN R15 00200000
BNZ INSERT RECORD NOT FOUND SO DO INSERT 00201001
UPDNDEL DS 0H UPDATE ROUTINE 00201106
MVI OPTION,C'U' OPTION FLAG FOR MODRPL 00201202
BAL 14,MODRPL 00201302
MVC SNO,VSAMKEY 00203001
***** CHECK IF FIELDS ARE EMPTY IN INPUT FILE 00204006
***** IF ONLY KEY PRESENT THEN IT IS A DELETE 00205006
CLC 6(74,12),=74C' ' 00206006
BE DELREC 00207006
***** CHECK IF FIELDS ARE SAME DO NOT UPDATE 00208006
CLC OUTBUFF+6(74),6(12) 00211006
BE UPDERR 00211106
MVC NAME,6(12) 00211406
MVC DJOIN,31(12) 00212001
PUT RPL=VSAMRPL 00220000
LTR 15,15 IF UPDATE SUCCESSFUL? 00221001
BZ INLOOP 00222001
UPDERR MVC ERRD,=C'UPD:' 00230006
MVC STUD,VSAMKEY 00231001
WTO TEXT=DISP 00231101
B INLOOP 00231201
DELREC ERASE RPL=VSAMRPL 00231306
B INLOOP 00231406
*****FIRST CHECK IF RPL IS ALREADY IN THE INSERT MODE 00232000
VSMOPERR WTO 'ERROR OPENING VSAM' 00240000
L 13,SAVE+4 00241000
RETURN (14,12),RC=1 00250000
ERROR2 MVC STUD,0(12) 00254000
MVC ERRD,=C'UPD ' 00260000
WTO TEXT=DISP 00270000
B INLOOP 00271000
ENDRTN CLOSE VSAMACB 00300000
CLOSE INFILE 00301000
L 13,SAVE+4 00310000
RETURN (14,12),RC=0 00320000
INSERT MVI OPTION,C'I' 00321002
BAL 14,MODRPL WILL UPDATE OPTCD TO NUP 00322005
MVC SNO,VSAMKEY 00323001
MVC NAME,6(12) 00324001
MVC DJOIN,31(12) 00325001
PUT RPL=VSAMRPL 00326001
LTR 15,15 IF INSERT SUCCESSFUL? 00327005
BZ INLOOP 00328001
MVC ERRD,=C'UPD:' 00329001
MVC STUD,VSAMKEY 00329101
WTO TEXT=DISP 00329201
B INLOOP 00329301
MSG DC AL2(16) 00330000
DS CL16 00330100
DISP DC AL2(L'ERRL+L'ERRD+L'STUD) 00330200
ERRL DC C'ERROR IN ' 00330300
ERRD DS CL4 00330401
STUD DS CL6 00330500
INBUFF DS CL80 00331000
OUTBUFF DS 0CL80 00340000
SNO DS CL6 00341000
NAME DS CL25 00342000
DJOIN DS CL8 00343001
REST DS CL41 00344001
DS 0F 00350000
SAVE DS 18F 00350100
SAVER14 DS F 00351000
DS 0D 00352000
DWD DS D 00360000
RETCODE DS F 00361000
OPTION DS CL1 00361102
INFILE DCB DDNAME=INFILE,MACRF=GL,DSORG=PS,EODAD=ENDRTN 00362000
VSAMACB ACB AM=VSAM,DDNAME=INVSAM,MACRF=(KEY,DIR,OUT) 00390000
VSAMRPL RPL AM=VSAM,ACB=VSAMACB,AREA=OUTBUFF, *00400000
AREALEN=80,ARG=VSAMKEY,KEYLEN=6, *00410000
OPTCD=(KEY,DIR,MVE,UPD),RECLEN=80 00420000
VSAMKEY DS CL6 00430000
MODRPL EQU * 00431000
ST 14,SAVER14 00432000
CLI OPTION,C'I' 00433000
BE INSOPT CHANGE TO UPDATE 00434003
*** CHECK FOR UPDATE OPTCD OTHERWISE CHANGE IT 00434102
TESTCB RPL=VSAMRPL,OPTCD=UPD 00434200
BE SKIP 00434302
MODCB RPL=VSAMRPL,OPTCD=UPD 00434400
SKIP B MODRET 00434500
*** CHECK FOR INSERT OPTCD OTHERWISE CHANGE IT 00434602
INSOPT TESTCB RPL=VSAMRPL,OPTCD=NUP 00435003
BE MODRET 00436000
MODCB RPL=VSAMRPL,OPTCD=NUP 00437000
MODRET L 14,SAVER14 00438000
BR 14 00439000
END 00440000
00440000
MACRO
&LABEL ADDFULL &F1,&F2
AIF ('&F1' EQ '').ERR1
AIF (N'&F2 EQ 0).ERR2
LCLA &COUNT,&SUB
SR 5,5
&COUNT SETA N'&F2
&SUB SETA 1
.LOOP ANOP
A 5,&F2(&SUB)
AIF (&SUB EQ &COUNT).EXIT
&SUB SETA &SUB+1
AGO .LOOP
.ERR1 MNOTE 12,'F1 PARAMETER MISSING'
AGO .END
.ERR2 MNOTE 12,'F2 PARAMETER MISSING'
AGO .END
.EXIT ST 5,&F1
.END MEND
MACRO
&LABEL MOVEL &FROM,&TO,&LEN
AIF ('&FROM' EQ '').ERR1
AIF ('&TO' EQ '').ERR2
AIF ('&LEN' EQ '').ERR3
LCLA &DIFF,&L
&L SETA &LEN
.LOOP ANOP
AIF (&L LT 256).EXIT
MVC &TO+&DIFF.(256),&FROM+&DIFF
&DIFF SETA &DIFF+256
&L SETA &L-256
AGO .LOOP
.EXIT MVC &TO+&DIFF.(&L),&FROM+&DIFF
AGO .END
.ERR1 MNOTE 12,'&FROM PARAMETER MISSING'
AGO .END
.ERR2 MNOTE 12,'&TO PARAMETER MISSING'
AGO .END
.ERR3 MNOTE 12,'&LEN PARAMETER MISSING'
.END MEND

Displaying 3127.txt.