The following illustrates the sample batch program as output from the assembler.
1 *DMLIST 000000 2 SAMPLE1 START 3 #REGEQU 4+* 5+* REGISTER EQUATES 6+* 00000 7+R0 EQU 0 01-#REGE 00001 8+R1 EQU 1 01-#REGE 00002 9+R2 EQU 2 01-#REGE 00003 10+R3 EQU 3 01-#REGE 00004 11+R4 EQU 4 01-#REGE 00005 12+R5 EQU 5 01-#REGE 00006 13+R6 EQU 6 01-#REGE 00007 14+R7 EQU 7 01-#REGE 00008 15+R8 EQU 8 01-#REGE 00009 16+R9 EQU 9 01-#REGE 0000A 17+R10 EQU 10 01-#REGE 0000B 18+R11 EQU 11 01-#REGE 0000C 19+R12 EQU 12 01-#REGE 0000D 20+R13 EQU 13 01-#REGE 0000E 21+R14 EQU 14 01-#REGE 0000F 22+R15 EQU 15 01-#REGE 000000 90EC D00C 0000C 23 STM R14,R12,12(R13) 000004 18CF 24 LR R12,R15 R:CBA 00000 25 USING SAMPLE1,R12,R11,R10 000006 18BC 26 LR R11,R12 000008 41BB 0FFF 00FFF 27 LA R11,4095(R11) 00000C 41BB 0001 00001 28 LA R11,1(R11) 000010 41AB 0FFF 00FFF 29 LA R10,4095(R11) 000014 41AA 0001 00001 30 LA R10,1(R10) 000018 50D0 B410 01410 31 ST R13,SAVEAREA+4 00001C 4170 B40C 0140C 32 LA R7,SAVEAREA 000020 507D 0008 00008 33 ST R7,8(R13) 000024 41D0 B40C 0140C 34 LA R13,SAVEAREA 000028 47F0 CD58 00D58 35 B BEGIN 36 @MODE MODE=BATCH,DEBUG=YES 37 * @INVOKE SUBSCH=EMPSS01,SCHEMA=EMPSCHM,VERSION=100 38 * @COPY IDMS,SUBSCHEMA-CTRL 000030 39 DS 0D 000030 40 SSCTRL DS 0CL216 000030 4040404040404040 41 PGMNAME DC CL8' ' 000038 F1F4F0F0 42 ERRSTAT DC CL4'1400' 00003C 43 DBKEY DS FL4 000040 4040404040404040 44 RECNAME DC CL16' ' 000050 4040404040404040 45 AREANAME DC CL16' ' 000060 4040404040404040 46 ERRORSET DC CL16' ' 000070 4040404040404040 47 ERRORREC DC CL16' ' 000080 4040404040404040 48 ERRAREA DC CL16' ' 000090 49 SSCIDBCM DS 0CL100 000090 50 IDBMSCOM DS 100CL1 0000F4 00090 51 ORG SSCIDBCM 000090 52 RDBMSCOM DS 0CL100 000090 53 PGINFO DS 0CL4 000090 54 PGINFGRP DS HL2 000092 55 PGINFDBK DS HL2 000094 56 DS CL96 0000F4 00000000 57 DIRDBKEY DC FL4'0' 0000F8 58 DBSTATUS DS 0CL8 0000F8 59 DBSTMTCD DS CL2 0000FA 60 DBSTATCD DS CL5 0000FF 61 DS CL1 000100 00000000 62 RECOCCUR DC FL4'0' 000104 00000000 63 DMLSEQ DC FL4'0' 64 **************************************** 65 * @COPY IDMS,SUBSCHEMA-RECORDS 000108 66 DS 0D 000108 67 STRUCTUR DS 0CL12 000108 68 STRCODE DS CL2 69 ADMIN EQU C'A' 70 PROJECT EQU C'P1' 00010A 71 STRDATE DS 0CL8 00010A 72 STRYEAR DS CL4 00010E 73 STRMONTH DS CL2 000110 74 STRDAY DS CL2 000112 75 DS CL2 76 **************************************** 000114 77 DS CL4 000118 78 DS 0D 000118 79 SKILLA DS 0CL76 000118 80 SKILID DS CL4 00011C 81 SKILNAME DS CL12 000128 82 SKILDESC DS CL60 83 **************************************** 000164 84 DS CL4 000168 85 DS 0D 000168 86 OFFIC DS 0CL76 000168 87 OFFCODE DS CL3 00016B 88 OFFADDR DS 0CL46 00016B 89 OFFSTRT DS CL20 00017F 90 OFFCITY DS CL15 00018E 91 OFFSTATE DS CL2 000190 92 OFFZIP DS 0CL9 000190 93 OFFZIPF5 DS CL5 000195 94 OFFZIPL4 DS CL4 000199 95 OFFPHONE DS 3CL7 0001AE 96 OFFAREA DS CL3 0001B1 97 OFFSPEED DS CL3 98 **************************************** 0001B4 99 DS CL4 0001B8 100 DS 0D 0001B8 101 NONHSPCL DS 0CL1052 0001B8 102 NHCLMDT DS 0CL8 0001B8 103 NHCLMYR DS CL4 0001BC 104 NHCLMMO DS CL2 0001BE 105 NHCLMDAY DS CL2 0001C0 106 NHPTNAME DS 0CL25 0001C0 107 NHPTFNAM DS CL10 0001CA 108 NHPTLNAM DS CL15 0001D9 109 NHPTBDAT DS 0CL8 0001D9 110 NHPTBYR DS CL4 0001DD 111 NHPTBMO DS CL2 0001DF 112 NHPTBDA DS CL2 0001E1 113 NHPTSEX DS CL1 0001E2 114 NHRELEMP DS CL10 0001EC 115 NHPHYNAM DS 0CL25 0001EC 116 NHPHYFNM DS CL10 0001F6 117 NHPHYLNM DS CL15 000205 118 NHPHYADD DS 0CL46 000205 119 NHPHYSTR DS CL20 000219 120 NHPHYCTY DS CL15 000228 121 NHPHYSTA DS CL2 00022A 122 NHPHYZIP DS 0CL9 00022A 123 NHPHYZ5 DS CL5 00022F 124 NHPHYZ4 DS CL4 000233 125 NHPHYSID DS CL6 000239 126 NHDIAGN DS 2CL60 0002B1 127 NHNOPROC DS HL2 0002B3 128 DS CL1 0002B4 129 NHPHYCHG DS 0CL800 0002B4 130 NHSERVDT DS 0CL8 0002B4 131 NHSERVYR DS CL4 0002B8 132 NHSERVMO DS CL2 0002BA 133 NHSERVDA DS CL2 0002BC 134 NHPROCCD DS CL4 0002C0 135 NHDESCSV DS CL60 0002FC 136 NHFEE DS PL5 000301 137 DS CL3 000304 138 DS CL720 139 **************************************** 0005D4 140 DS CL4 0005D8 141 DS 0D 0005D8 142 JOBA DS 0CL296 0005D8 143 JOBID DS CL4 0005DC 144 JOBTITLE DS CL20 0005F0 145 JOBDESCR DS 0CL120 0005F0 146 JOBDSCLN DS 2CL60 000668 147 JOBRQMNT DS 0CL120 000668 148 JOBREQLN DS 2CL60 0006E0 149 JOBMNSAL DS CL8 0006E8 150 JOBMXSAL DS CL8 0006F0 151 JOBSALGR DS 4CL2 0006F8 152 JOBNMPOS DS CL3 0006FB 153 JOBNMOPN DS CL3 0006FE 154 DS CL2 155 **************************************** 000700 156 DS 0D 000700 157 INSPLAN DS 0CL132 000700 158 INPCODE DS CL3 159 GROUPLIF EQU C'001' 160 HMO EQU C'002' 161 GRPHLTH EQU C'003' 162 GROUPDNT EQU C'004' 000703 163 INPCNAME DS CL45 000730 164 INPCADDR DS 0CL46 000730 165 INPCSTRT DS CL20 000744 166 INPCCITY DS CL15 000753 167 INPCSTAT DS CL2 000755 168 INPCZIP DS 0CL9 000755 169 INPCZPF5 DS CL5 00075A 170 INPCZPL4 DS CL4 00075E 171 INPCPHON DS CL10 000768 172 INPGRPNO DS CL6 00076E 173 INPDESCR DS 0CL20 00076E 174 INPDEDCT DS PL5 000773 175 INPMXLIF DS PL5 000778 176 INPFAMCS DS PL5 00077D 177 INPDEPCS DS PL5 000782 178 DS CL2 179 **************************************** 000784 180 DS CL4 000788 181 DS 0D 000788 182 HOSPCLM DS 0CL300 000788 183 HCCLMDT DS 0CL8 000788 184 HCCLMYR DS CL4 00078C 185 HCCLMMO DS CL2 00078E 186 HCCLMDAY DS CL2 000790 187 HCPTNAME DS 0CL25 000790 188 HCPTFNAM DS CL10 00079A 189 HCPTLNAM DS CL15 0007A9 190 HCPTBDAT DS 0CL8 0007A9 191 HCPTBYR DS CL4 0007AD 192 HCPTBMO DS CL2 0007AF 193 HCPTBDA DS CL2 0007B1 194 HCPTSEX DS CL1 0007B2 195 HCRELEMP DS CL10 0007BC 196 HCHSPNAM DS CL25 0007D5 197 HCHSPADD DS 0CL46 0007D5 198 HCHSPSTR DS CL20 0007E9 199 HCHSPCTY DS CL15 0007F8 200 HCHSPSTA DS CL2 0007FA 201 HCHSPZIP DS 0CL9 0007FA 202 HCHSPZF5 DS CL5 0007FF 203 HCHSPZL4 DS CL4 000803 204 HCADMTDT DS 0CL8 000803 205 HCADMTYR DS CL4 000807 206 HCADMTMO DS CL2 000809 207 HCADMTDA DS CL2 00080B 208 HCDSCGDT DS 0CL8 00080B 209 HCDSCGYR DS CL4 00080F 210 HCDSCGMO DS CL2 000811 211 HCDSCGDA DS CL2 000813 212 HCDIAGN DS 2CL60 00088B 213 HCHSPCHG DS 0CL41 00088B 214 HCRMBRD DS 0CL26 00088B 215 HCWARD DS 0CL13 00088B 216 HCWDDAYS DS PL3 00088E 217 HCWDRATE DS PL5 000893 218 HCWDTOTL DS PL5 000898 219 HCSPRIV DS 0CL13 000898 220 HCSDAYS DS PL3 00089B 221 HCSRATE DS PL5 0008A0 222 HCSTOTAL DS PL5 0008A5 223 HCOTHCHG DS 0CL15 0008A5 224 HCDELVCH DS PL5 0008AA 225 HCANSTHC DS PL5 0008AF 226 HCLABCST DS PL5 227 **************************************** 0008B4 228 DS CL4 0008B8 229 DS 0D 0008B8 230 EXPRTISE DS 0CL12 0008B8 231 EXPSKLVL DS CL2 232 EXPERT EQU C'04' 233 PROFICNT EQU C'03' 234 COMPETNT EQU C'02' 235 ELEMNTRY EQU C'01' 0008BA 236 EXPDATE DS 0CL8 0008BA 237 EXPYEAR DS CL4 0008BE 238 EXPMONTH DS CL2 0008C0 239 EXPDAY DS CL2 0008C2 240 DS CL2 241 **************************************** 0008C4 242 DS CL4 0008C8 243 DS 0D 0008C8 244 EMPOSITN DS 0CL32 0008C8 245 EPSTRTDT DS 0CL8 0008C8 246 EPSTRTYR DS CL4 0008CC 247 EPSTRTMO DS CL2 0008CE 248 EPSTRTDA DS CL2 0008D0 249 EPFINIDT DS 0CL8 0008D0 250 EPFINIYR DS CL4 0008D4 251 EPFINIMO DS CL2 0008D6 252 EPFINIDA DS CL2 0008D8 253 EPSALGRD DS CL2 0008DA 254 EPSALAMT DS PL5 0008DF 255 EPBONPCT DS PL2 0008E1 256 EPCMMPCT DS PL2 0008E3 257 EPOTRATE DS PL2 0008E5 258 DS CL3 259 **************************************** 0008E8 260 DS 0D 0008E8 261 EMPLOYE DS 0CL120 0008E8 262 EMPID DS CL4 0008EC 263 EMPNAME DS 0CL25 0008EC 264 EMPFNAME DS CL10 0008F6 265 EMPLNAME DS CL15 000905 266 EMPADDR DS 0CL46 000905 267 EMPSTRET DS CL20 000919 268 EMPCITY DS CL15 000928 269 EMPSTATE DS CL2 00092A 270 EMPZIP DS 0CL9 00092A 271 EMPZIPF5 DS CL5 00092F 272 EMPZIPL4 DS CL4 000933 273 EMPPHONE DS CL10 00093D 274 EMPSTATU DS CL2 275 ACTIVE EQU C'01' 276 STDSBL EQU C'02' 277 LTDSBL EQU C'03' 278 LVOFAB EQU C'04' 279 TRMINATD EQU C'05' 00093F 280 EMPSSNUM DS CL9 000948 281 EMPSTDT DS 0CL8 000948 282 EMPSTYR DS CL4 00094C 283 EMPSTMO DS CL2 00094E 284 EMPSTDA DS CL2 000950 285 EMPTRMDT DS 0CL8 000950 286 EMPTRMYR DS CL4 000954 287 EMPTRMMO DS CL2 000956 288 EMPTRMDA DS CL2 000958 289 EMPBIRDT DS 0CL8 000958 290 EMPBIRYR DS CL4 00095C 291 EMPBIRMO DS CL2 00095E 292 EMPBIRDA DS CL2 293 **************************************** 000960 294 DS 0D 000960 295 DEPARTMT DS 0CL56 000960 296 DEPTID DS CL4 000964 297 DEPTNAME DS CL45 000991 298 DEPTHDID DS CL4 000995 299 DS CL3 300 **************************************** 000998 301 DS 0D 000998 302 DENTCLM DS 0CL932 000998 303 DCCLMDT DS 0CL8 000998 304 DCCLMYR DS CL4 00099C 305 DCCLMMO DS CL2 00099E 306 DCCLMDA DS CL2 0009A0 307 DCPNAME DS 0CL25 0009A0 308 DCPFNAME DS CL10 0009AA 309 DCPLNAME DS CL15 0009B9 310 DCPBIRDT DS 0CL8 0009B9 311 DCPBIRYR DS CL4 0009BD 312 DCPBIRMO DS CL2 0009BF 313 DCPBIRDA DS CL2 0009C1 314 DCPSEX DS CL1 0009C2 315 DCRELEMP DS CL10 0009CC 316 DCDNNAME DS 0CL25 0009CC 317 DCDNFNAM DS CL10 0009D6 318 DCDNLNAM DS CL15 0009E5 319 DCDNADDR DS 0CL46 0009E5 320 DCDNSTR DS CL20 0009F9 321 DCDNCITY DS CL15 000A08 322 DCDNSTAT DS CL2 000A0A 323 DCDNZIP DS 0CL9 000A0A 324 DCDNZPF5 DS CL5 000A0F 325 DCDNZPL4 DS CL4 000A13 326 DCDNLICN DS CL6 000A19 327 DCNOPROC DS HL2 000A1B 328 DS CL1 000A1C 329 DCDNCHGS DS 0CL800 000A1C 330 DCTOTHNO DS CL2 000A1E 331 DCSERVDT DS 0CL8 000A1E 332 DCSERVYR DS CL4 000A22 333 DCSERVMO DS CL2 000A24 334 DCSERVDA DS CL2 000A26 335 DCPROCCD DS CL4 000A2A 336 DCDESCSV DS CL60 000A66 337 DCFEE DS PL5 000A6B 338 DS CL1 000A6C 339 DS CL720 340 **************************************** 000D3C 341 DS CL4 000D40 342 DS 0D 000D40 343 COVERGE DS 0CL20 000D40 344 COVSELDT DS 0CL8 000D40 345 COVSELYR DS CL4 000D44 346 COVSELMO DS CL2 000D46 347 COVSELDA DS CL2 000D48 348 COVTRMDT DS 0CL8 000D48 349 COVTRMYR DS CL4 000D4C 350 COVTRMMO DS CL2 000D4E 351 COVTRMDA DS CL2 000D50 352 COVTYPE DS CL1 353 COVMASTR EQU C'M' 354 COVFAMLY EQU C'F' 355 COVDPNDT EQU C'D' 000D51 356 COVPLNCD DS CL3 357 GROUP_LIFE EQU C'001' 358 HMO EQU C'002' 359 GROUP_HEALTH EQU C'003' 360 GROUP_DENTAL EQU C'004' 361 **************************************** 000D54 362 DS CL4 000D58 363 BEGIN DS 0F 364 * @COPY IDMS,SUBSCHEMA-BINDS 365 @BIND SUBSCH='EMPSS01 ',SCB=SSCTRL,DICTNAM='APPLDICT' 366+* *** BEGIN DML EXPANSION *** 000D58 4100 C030 00030 367+ LA 0,SSCTRL 02-@IDMS 000D5C 5000 C094 00094 368+ ST 0,SSCIDBCM+4 02-@IDMS 000D60 4100 C0CA 000CA 369+ LA 0,SSCIDBCM+59-1 02-@IDMS 000D64 5000 C098 00098 370+ ST 0,SSCIDBCM+8 02-@IDMS 000D68 4100 C030 00030 371+ LA 0,SSCTRL 02-@IDMS 000D6C 5000 C09C 0009C 372+ ST 0,SSCIDBCM+12 02-@IDMS 000D70 4100 B834 01834 373+ LA 0,=CL18'EMPSS01 ' 02-@IDMS 000D74 5000 C0A0 000A0 374+ ST 0,SSCIDBCM+16 02-@IDMS 000D78 4100 C030 00030 375+ LA 0,SSCTRL 02-@IDMS 000D7C 5000 C0A4 000A4 376+ ST 0,SSCIDBCM+20 02-@IDMS 000D80 4100 C030 00030 377+ LA 0,SSCTRL 02-@IDMS 000D84 5000 C0A8 000A8 378+ ST 0,SSCIDBCM+24 02-@IDMS 000D88 D207 C050 B7A0 00050 017A0 379+ MVC AREANAME(8),=CL8' ' 01-@BIND 000D8E D207 C058 B7A8 00058 017A8 380+ MVC AREANAME+8(8),=CL8'APPLDICT' 01-@BIND 000D94 4100 C050 00050 381+ LA 0,AREANAME 02-@IDMS 000D98 5000 C0AC 000AC 382+ ST 0,SSCIDBCM+28 02-@IDMS 000D9C 9680 C0AC 000AC 383+ OI SSCIDBCM+28,X'80' 02-@IDMS 000DA0 4100 0001 00001 384+ LA 0,1 02-@IDMS 000DA4 5000 C104 00104 385+ ST 0,DMLSEQ 02-@IDMS 386+*, DML-SEQUENCE = 1 02-@IDMS 000DA8 4110 C094 00094 387+ LA 1,SSCIDBCM+4 02-@IDMS 000DAC 58F0 B7B0 017B0 388+ L 15,=V(IDMS) 02-@IDMS 000DB0 05EF 389+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 390+* *** END DML EXPANSION *** 391 @BIND REC='OFFICE',IOAREA=OFFIC 392+* *** BEGIN DML EXPANSION *** 000DB2 4100 C030 00030 393+ LA 0,SSCTRL 02-@IDMS 000DB6 5000 C094 00094 394+ ST 0,SSCIDBCM+4 02-@IDMS 000DBA 4100 C0BF 000BF 395+ LA 0,SSCIDBCM+48-1 02-@IDMS 000DBE 5000 C098 00098 396+ ST 0,SSCIDBCM+8 02-@IDMS 000DC2 4100 B846 01846 397+ LA 0,=CL18'OFFICE' 02-@IDMS 000DC6 5000 C09C 0009C 398+ ST 0,SSCIDBCM+12 02-@IDMS 000DCA 4100 C168 00168 399+ LA 0,OFFIC 02-@IDMS 000DCE 5000 C0A0 000A0 400+ ST 0,SSCIDBCM+16 02-@IDMS 000DD2 9680 C0A0 000A0 401+ OI SSCIDBCM+16,X'80' 02-@IDMS 000DD6 4100 0002 00002 402+ LA 0,2 02-@IDMS 000DDA 5000 C104 00104 403+ ST 0,DMLSEQ 02-@IDMS 404+*, DML-SEQUENCE = 2 02-@IDMS 000DDE 4110 C094 00094 405+ LA 1,SSCIDBCM+4 02-@IDMS 000DE2 58F0 B7B0 017B0 406+ L 15,=V(IDMS) 02-@IDMS 000DE6 05EF 407+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 408+* *** END DML EXPANSION *** 409 @BIND REC='EMPLOYEE',IOAREA=EMPLOYE 410+* *** BEGIN DML EXPANSION *** 000DE8 4100 C030 00030 411+ LA 0,SSCTRL 02-@IDMS 000DEC 5000 C094 00094 412+ ST 0,SSCIDBCM+4 02-@IDMS 000DF0 4100 C0BF 000BF 413+ LA 0,SSCIDBCM+48-1 02-@IDMS 000DF4 5000 C098 00098 414+ ST 0,SSCIDBCM+8 02-@IDMS 000DF8 4100 B858 01858 415+ LA 0,=CL18'EMPLOYEE' 02-@IDMS 000DFC 5000 C09C 0009C 416+ ST 0,SSCIDBCM+12 02-@IDMS 000E00 4100 C8E8 008E8 417+ LA 0,EMPLOYE 02-@IDMS 000E04 5000 C0A0 000A0 418+ ST 0,SSCIDBCM+16 02-@IDMS 000E08 9680 C0A0 000A0 419+ OI SSCIDBCM+16,X'80' 02-@IDMS 000E0C 4100 0003 00003 420+ LA 0,3 02-@IDMS 000E10 5000 C104 00104 421+ ST 0,DMLSEQ 02-@IDMS 422+*, DML-SEQUENCE = 3 02-@IDMS 000E14 4110 C094 00094 423+ LA 1,SSCIDBCM+4 02-@IDMS 000E18 58F0 B7B0 017B0 424+ L 15,=V(IDMS) 02-@IDMS 000E1C 05EF 425+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 426+* *** END DML EXPANSION *** 427 @BIND REC='DEPARTMENT',IOAREA=DEPARTMT 428+* *** BEGIN DML EXPANSION *** 000E1E 4100 C030 00030 429+ LA 0,SSCTRL 02-@IDMS 000E22 5000 C094 00094 430+ ST 0,SSCIDBCM+4 02-@IDMS 000E26 4100 C0BF 000BF 431+ LA 0,SSCIDBCM+48-1 02-@IDMS 000E2A 5000 C098 00098 432+ ST 0,SSCIDBCM+8 02-@IDMS 000E2E 4100 B86A 0186A 433+ LA 0,=CL18'DEPARTMENT' 02-@IDMS 000E32 5000 C09C 0009C 434+ ST 0,SSCIDBCM+12 02-@IDMS 000E36 4100 C960 00960 435+ LA 0,DEPARTMT 02-@IDMS 000E3A 5000 C0A0 000A0 436+ ST 0,SSCIDBCM+16 02-@IDMS 000E3E 9680 C0A0 000A0 437+ OI SSCIDBCM+16,X'80' 02-@IDMS 000E42 4100 0004 00004 438+ LA 0,4 02-@IDMS 000E46 5000 C104 00104 439+ ST 0,DMLSEQ 02-@IDMS 440+*, DML-SEQUENCE = 4 02-@IDMS 000E4A 4110 C094 00094 441+ LA 1,SSCIDBCM+4 02-@IDMS 000E4E 58F0 B7B0 017B0 442+ L 15,=V(IDMS) 02-@IDMS 000E52 05EF 443+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 444+* *** END DML EXPANSION *** 445 OPEN (OUTFILE,OUTPUT) 000E54 446+ CNOP 0,4 ALIGN LIST TO FULLWORD 01-OPEN 000E54 4510 CE5C 00E5C 447+ BAL 1,*+8 LOAD REG1 W/LIST ADDR. @L2A 01-OPEN 000E58 8F 448+ DC AL1(143) OPTION BYTE 01-OPEN 000E59 00173C 449+ DC AL3(OUTFILE) DCB ADDRESS 01-OPEN 000E5C 0A13 450+ SVC 19 ISSUE OPEN SVC 01-OPEN 000E5E D200 B5C4 B8BC 015C4 018BC 451 MVC EDSW,=C'N' SET SWITCHES 000E64 D200 B5C5 B8BC 015C5 018BC 452 MVC DSW,=C'N' 000E6A D200 B5C6 B8BC 015C6 018BC 453 MVC ESW,=C'N' 000E70 4150 CE78 00E78 454 LA R5,MAIN000 LOAD ADDRESS OF MAINLINE ROUTINE 000E74 47F0 B3A4 013A4 455 B PRTHEAD 00E78 456 MAIN000 EQU * 457 @READY ALL,RDONLY=YES READY ALL DATABASE AREAS 458+* *** BEGIN DML EXPANSION *** 000E78 4100 C030 00030 459+ LA 0,SSCTRL 02-@IDMS 000E7C 5000 C094 00094 460+ ST 0,SSCIDBCM+4 02-@IDMS 000E80 4100 C0B4 000B4 461+ LA 0,SSCIDBCM+37-1 02-@IDMS 000E84 5000 C098 00098 462+ ST 0,SSCIDBCM+8 02-@IDMS 000E88 9680 C098 00098 463+ OI SSCIDBCM+8,X'80' 02-@IDMS 000E8C 4100 0005 00005 464+ LA 0,5 02-@IDMS 000E90 5000 C104 00104 465+ ST 0,DMLSEQ 02-@IDMS 466+*, DML-SEQUENCE = 5 02-@IDMS 000E94 4110 C094 00094 467+ LA 1,SSCIDBCM+4 02-@IDMS 000E98 58F0 B7B0 017B0 468+ L 15,=V(IDMS) 02-@IDMS 000E9C 05EF 469+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 470+* *** END DML EXPANSION *** 000E9E D503 C038 B46A 00038 0146A 471 CLC ERRSTAT,STATOK CHECK IF ERROR 000EA4 4770 B1F4 011F4 472 BNE AREAERR BRANCH TO ERROR ROUTINE 473 @OBTAIN FIRST,AREA='ORG-DEMO-REGION',REC='OFFICE' 474+* *** BEGIN DML EXPANSION *** 000EA8 4100 C030 00030 475+ LA 0,SSCTRL 03-@IDMS 000EAC 5000 C094 00094 476+ ST 0,SSCIDBCM+4 03-@IDMS 000EB0 4100 C0A2 000A2 477+ LA 0,SSCIDBCM+18+1-1 03-@IDMS 000EB4 5000 C098 00098 478+ ST 0,SSCIDBCM+8 03-@IDMS 000EB8 4100 B846 01846 479+ LA 0,=CL18'OFFICE' 03-@IDMS 000EBC 5000 C09C 0009C 480+ ST 0,SSCIDBCM+12 03-@IDMS 000EC0 4100 B87C 0187C 481+ LA 0,=CL18'ORG-DEMO-REGION' 03-@IDMS 000EC4 5000 C0A0 000A0 482+ ST 0,SSCIDBCM+16 03-@IDMS 000EC8 4100 C0BA 000BA 483+ LA 0,SSCIDBCM+43-1 02-@IDMS 000ECC 5000 C0A4 000A4 484+ ST 0,SSCIDBCM+20 02-@IDMS 000ED0 9680 C0A4 000A4 485+ OI SSCIDBCM+20,X'80' 02-@IDMS 000ED4 4100 0006 00006 486+ LA 0,6 02-@IDMS 000ED8 5000 C104 00104 487+ ST 0,DMLSEQ 02-@IDMS 488+*, DML-SEQUENCE = 6 02-@IDMS 000EDC 4110 C094 00094 489+ LA 1,SSCIDBCM+4 02-@IDMS 000EE0 58F0 B7B0 017B0 490+ L 15,=V(IDMS) 02-@IDMS 000EE4 05EF 491+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 492+* *** END DML EXPANSION *** 000EE6 D503 C038 B46A 00038 0146A 493 NEWOFFC CLC ERRSTAT,STATOK CHECK IF NO OFFICE 000EEC 4770 B1F4 011F4 494 BNE AREAERR 000EF0 D202 B470 C168 01470 00168 495 MVC OCODE,OFFCODE 000EF6 D20E B473 C17F 01473 0017F 496 MVC OCITY,OFFCITY 497 @OBTAIN FIRST,SET='OFFICE-EMPLOYEE',REC='EMPLOYEE' 498+* *** BEGIN DML EXPANSION *** 000EFC 4100 C030 00030 499+ LA 0,SSCTRL 03-@IDMS 000F00 5000 C094 00094 500+ ST 0,SSCIDBCM+4 03-@IDMS 000F04 4100 C0A1 000A1 501+ LA 0,SSCIDBCM+18+0-1 03-@IDMS 000F08 5000 C098 00098 502+ ST 0,SSCIDBCM+8 03-@IDMS 000F0C 4100 B858 01858 503+ LA 0,=CL18'EMPLOYEE' 03-@IDMS 000F10 5000 C09C 0009C 504+ ST 0,SSCIDBCM+12 03-@IDMS 000F14 4100 B88E 0188E 505+ LA 0,=CL18'OFFICE-EMPLOYEE' 03-@IDMS 000F18 5000 C0A0 000A0 506+ ST 0,SSCIDBCM+16 03-@IDMS 000F1C 4100 C0BA 000BA 507+ LA 0,SSCIDBCM+43-1 02-@IDMS 000F20 5000 C0A4 000A4 508+ ST 0,SSCIDBCM+20 02-@IDMS 000F24 9680 C0A4 000A4 509+ OI SSCIDBCM+20,X'80' 02-@IDMS 000F28 4100 0007 00007 510+ LA 0,7 02-@IDMS 000F2C 5000 C104 00104 511+ ST 0,DMLSEQ 02-@IDMS 512+*, DML-SEQUENCE = 7 02-@IDMS 000F30 4110 C094 00094 513+ LA 1,SSCIDBCM+4 02-@IDMS 000F34 58F0 B7B0 017B0 514+ L 15,=V(IDMS) 02-@IDMS 000F38 05EF 515+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 516+* *** END DML EXPANSION *** 000F3A D503 C038 B46A 00038 0146A 517 CLC ERRSTAT,STATOK CHECK IF NO EMPLOYEE 000F40 4770 B260 01260 518 BNE OBERR1 000F44 D203 B482 C8E8 01482 008E8 519 MVC EID,EMPID MOVE EMPLOYEE ID 000F4A D209 B486 C8EC 01486 008EC 520 MVC FNAME,EMPFNAME MOVE EMPLOYEE FIRST NAME 000F50 D20E B492 C8F6 01492 008F6 521 MVC LNAME,EMPLNAME MOVE EMPLOYEE LAST NAME 000F56 D203 B4A1 C8E8 014A1 008E8 522 MVC WALK,EMPID SAVE ID 000F5C D201 B454 C93D 01454 0093D 523 MVC STATNUM,EMPSTATU MOVE EMPLOYEE STATUS 000F62 4160 CF6A 00F6A 524 LA R6,NEWDPT LOAD ADDRESS OF NEW DEPT ROUTINE 000F66 47F0 B342 01342 525 B CKSTAT BRANCH TO STATUS-CHECK RTN 00F6A 526 NEWDPT EQU * 527 @OBTAIN OWNER,SET='DEPT-EMPLOYEE' 528+* *** BEGIN DML EXPANSION *** 000F6A 4100 C030 00030 529+ LA 0,SSCTRL 03-@IDMS 000F6E 5000 C094 00094 530+ ST 0,SSCIDBCM+4 03-@IDMS 000F72 4100 C0AE 000AE 531+ LA 0,SSCIDBCM+31-1 03-@IDMS 000F76 5000 C098 00098 532+ ST 0,SSCIDBCM+8 03-@IDMS 000F7A 4100 B8A0 018A0 533+ LA 0,=CL18'DEPT-EMPLOYEE' 03-@IDMS 000F7E 5000 C09C 0009C 534+ ST 0,SSCIDBCM+12 03-@IDMS 000F82 4100 C0BA 000BA 535+ LA 0,SSCIDBCM+43-1 02-@IDMS 000F86 5000 C0A0 000A0 536+ ST 0,SSCIDBCM+16 02-@IDMS 000F8A 9680 C0A0 000A0 537+ OI SSCIDBCM+16,X'80' 02-@IDMS 000F8E 4100 0008 00008 538+ LA 0,8 02-@IDMS 000F92 5000 C104 00104 539+ ST 0,DMLSEQ 02-@IDMS 540+*, DML-SEQUENCE = 8 02-@IDMS 000F96 4110 C094 00094 541+ LA 1,SSCIDBCM+4 02-@IDMS 000F9A 58F0 B7B0 017B0 542+ L 15,=V(IDMS) 02-@IDMS 000F9E 05EF 543+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 544+* *** END DML EXPANSION *** 000FA0 D503 C038 B46A 00038 0146A 545 CLC ERRSTAT,STATOK CHECK IF DEPARTMENT 000FA6 4770 B26E 0126E 546 BNE OBERR2 000FAA D203 B4A5 C960 014A5 00960 547 MVC DID,DEPTID 000FB0 D22C B4A9 C964 014A9 00964 548 MVC DEPT,DEPTNAME 000FB6 4150 CFBE 00FBE 549 LA R5,MAIN020 LOAD ADDRESS OF SET-WALK RTN 000FBA 47F0 B2AE 012AE 550 B PRINTREC PRINT DEPARTMENT INFORMATION 00FBE 551 MAIN020 EQU * * 552 @OBTAIN NEXT,SET='DEPT-EMPLOYEE',REC='EMPLOYEE' 553+* *** BEGIN DML EXPANSION *** 000FBE 4100 C030 00030 554+ LA 0,SSCTRL 03-@IDMS 000FC2 5000 C094 00094 555+ ST 0,SSCIDBCM+4 03-@IDMS 000FC6 4100 C099 00099 556+ LA 0,SSCIDBCM+10+0-1 03-@IDMS 000FCA 5000 C098 00098 557+ ST 0,SSCIDBCM+8 03-@IDMS 000FCE 4100 B858 01858 558+ LA 0,=CL18'EMPLOYEE' 03-@IDMS 000FD2 5000 C09C 0009C 559+ ST 0,SSCIDBCM+12 03-@IDMS 000FD6 4100 B8A0 018A0 560+ LA 0,=CL18'DEPT-EMPLOYEE' 03-@IDMS 000FDA 5000 C0A0 000A0 561+ ST 0,SSCIDBCM+16 03-@IDMS 000FDE 4100 C0BA 000BA 562+ LA 0,SSCIDBCM+43-1 02-@IDMS 000FE2 5000 C0A4 000A4 563+ ST 0,SSCIDBCM+20 02-@IDMS 000FE6 9680 C0A4 000A4 564+ OI SSCIDBCM+20,X'80' 02-@IDMS 000FEA 4100 0009 00009 565+ LA 0,9 02-@IDMS 000FEE 5000 C104 00104 566+ ST 0,DMLSEQ 02-@IDMS 567+*, DML-SEQUENCE = 9 02-@IDMS 000FF2 4110 C094 00094 568+ LA 1,SSCIDBCM+4 02-@IDMS 000FF6 58F0 B7B0 017B0 569+ L 15,=V(IDMS) 02-@IDMS 000FFA 05EF 570+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 571+* *** END DML EXPANSION *** 000FFC D503 C038 0133 00038 00133 572 CLC ERRSTAT,0307 CHECK IF END OF SET 001002 4780 B038 01038 573 BE MAIN030 BRANCH IF END OF SET 001006 D503 C038 B46A 00038 0146A 574 CLC ERRSTAT,STATOK CHECK IF ERROR 00100C 4770 B27C 0127C 575 BNE OBERR3 001010 D203 B482 C8E8 01482 008E8 576 MVC EID,EMPID MOVE EMPLOYEE ID 001016 D209 B486 C8EC 01486 008EC 577 MVC FNAME,EMPFNAME MOVE EMPLOYEE FIRST NAME 00101C D20E B492 C8F6 01492 008F6 578 MVC LNAME,EMPLNAME MOVE EMPLOYEE LAST NAME 001022 D201 B454 C93D 01454 0093D 579 MVC STATNUM,EMPSTATU MOVE EMPLOYEE STATUS 001028 4160 B030 01030 580 LA R6,MAIN025 LOAD ADDRESS OF PRINT LINK 00102C 47F0 B342 01342 581 B CKSTAT 01030 582 MAIN025 EQU * 001030 4150 CFBE 00FBE 583 LA R5,MAIN020 001034 47F0 B2AE 012AE 584 B PRINTREC 01038 585 MAIN030 EQU * 001038 D203 C8E8 B4A1 008E8 014A1 586 MVC EMPID,WALK 587 @FIND CALC,REC='EMPLOYEE' FIND NEXT EMPLOYEE 588+* *** BEGIN DML EXPANSION *** 00103E 4100 C030 00030 589+ LA 0,SSCTRL 02-@IDMS 001042 5000 C094 00094 590+ ST 0,SSCIDBCM+4 02-@IDMS 001046 4100 C0AF 000AF 591+ LA 0,SSCIDBCM+32-1 02-@IDMS 00104A 5000 C098 00098 592+ ST 0,SSCIDBCM+8 02-@IDMS 00104E 4100 B858 01858 593+ LA 0,=CL18'EMPLOYEE' 02-@IDMS 001052 5000 C09C 0009C 594+ ST 0,SSCIDBCM+12 02-@IDMS 001056 9680 C09C 0009C 595+ OI SSCIDBCM+12,X'80' 02-@IDMS 00105A 4100 000A 0000A 596+ LA 0,10 02-@IDMS 00105E 5000 C104 00104 597+ ST 0,DMLSEQ 02-@IDMS 598+*, DML-SEQUENCE = 10 02-@IDMS 001062 4110 C094 00094 599+ LA 1,SSCIDBCM+4 02-@IDMS 001066 58F0 B7B0 017B0 600+ L 15,=V(IDMS) 02-@IDMS 00106A 05EF 601+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 602+* *** END DML EXPANSION *** 00106C D503 C038 B46A 00038 0146A 603 CLC ERRSTAT,STATOK CHECK IF ERROR 001072 4770 B218 01218 604 BNE CALCERR 01076 605 REPEAT EQU * 606 @OBTAIN NEXT,SET='OFFICE-EMPLOYEE',REC='EMPLOYEE' 607+* *** BEGIN DML EXPANSION *** 001076 4100 C030 00030 608+ LA 0,SSCTRL 03-@IDMS 00107A 5000 C094 00094 609+ ST 0,SSCIDBCM+4 03-@IDMS 00107E 4100 C099 00099 610+ LA 0,SSCIDBCM+10+0-1 03-@IDMS 001082 5000 C098 00098 611+ ST 0,SSCIDBCM+8 03-@IDMS 001086 4100 B858 01858 612+ LA 0,=CL18'EMPLOYEE' 03-@IDMS 00108A 5000 C09C 0009C 613+ ST 0,SSCIDBCM+12 03-@IDMS 00108E 4100 B88E 0188E 614+ LA 0,=CL18'OFFICE-EMPLOYEE' 03-@IDMS 001092 5000 C0A0 000A0 615+ ST 0,SSCIDBCM+16 03-@IDMS 001096 4100 C0BA 000BA 616+ LA 0,SSCIDBCM+43-1 02-@IDMS 00109A 5000 C0A4 000A4 617+ ST 0,SSCIDBCM+20 02-@IDMS 00109E 9680 C0A4 000A4 618+ OI SSCIDBCM+20,X'80' 02-@IDMS 0010A2 4100 000B 0000B 619+ LA 0,11 02-@IDMS 0010A6 5000 C104 00104 620+ ST 0,DMLSEQ 02-@IDMS 621+*, DML-SEQUENCE = 11 02-@IDMS 0010AA 4110 C094 00094 622+ LA 1,SSCIDBCM+4 02-@IDMS 0010AE 58F0 B7B0 017B0 623+ L 15,=V(IDMS) 02-@IDMS 0010B2 05EF 624+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 625+* *** END DML EXPANSION *** 0010B4 D503 C038 B7B4 00038 017B4 626 CLC ERRSTAT,=C'0307' END OF SET ? 0010BA 4780 B126 01126 627 BE MAIN040 BRANCH IF END OF SET 0010BE D503 C038 B46A 00038 0146A 628 CLC ERRSTAT,STATOK 0010C4 4770 B260 01260 629 BNE OBERR1 630 @IF SET='DEPT-EMPLOYEE',MEMBER=YES,GOTO=REPEAT 631+* *** BEGIN DML EXPANSION *** 0010C8 4100 C030 00030 632+ LA 0,SSCTRL 02-@IDMS 0010CC 5000 C094 00094 633+ ST 0,SSCIDBCM+4 02-@IDMS 0010D0 4100 C0CB 000CB 634+ LA 0,SSCIDBCM+60-1 02-@IDMS 0010D4 5000 C098 00098 635+ ST 0,SSCIDBCM+8 02-@IDMS 0010D8 4100 B8A0 018A0 636+ LA 0,=CL18'DEPT-EMPLOYEE' 02-@IDMS 0010DC 5000 C09C 0009C 637+ ST 0,SSCIDBCM+12 02-@IDMS 0010E0 9680 C09C 0009C 638+ OI SSCIDBCM+12,X'80' 02-@IDMS 0010E4 4100 000C 0000C 639+ LA 0,12 02-@IDMS 0010E8 5000 C104 00104 640+ ST 0,DMLSEQ 02-@IDMS 641+*, DML-SEQUENCE = 12 02-@IDMS 0010EC 4110 C094 00094 642+ LA 1,SSCIDBCM+4 02-@IDMS 0010F0 58F0 B7B0 017B0 643+ L 15,=V(IDMS) 02-@IDMS 0010F4 05EF 644+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 645+* *** END DML EXPANSION *** 0010F6 D503 C038 B7B8 00038 017B8 646+ CLC ERRSTAT,=C'0000' 01-@IF 0010FC 4780 B076 01076 647+ BE REPEAT 01-@IF 001100 D203 B482 C8E8 01482 008E8 648 MVC EID,EMPID MOVE EMPLOYEE ID 001106 D209 B486 C8EC 01486 008EC 649 MVC FNAME,EMPFNAME MOVE EMPLOYEE FIRST NAME 00110C D20E B492 C8F6 01492 008F6 650 MVC LNAME,EMPLNAME MOVE EMPLOYEE LAST NAME 001112 D203 B4A1 C8E8 014A1 008E8 651 MVC WALK,EMPID 001118 D201 B454 C93D 01454 0093D 652 MVC STATNUM,EMPSTATU 00111E 4160 CF6A 00F6A 653 LA R6,NEWDPT ADDRESS OF DEPT ROUTINE 001122 47F0 B342 01342 654 B CKSTAT 01126 655 MAIN040 EQU * 656 @OBTAIN NEXT,AREA='ORG-DEMO-REGION',REC='OFFICE' 657+* *** BEGIN DML EXPANSION *** 001126 4100 C030 00030 658+ LA 0,SSCTRL 03-@IDMS 00112A 5000 C094 00094 659+ ST 0,SSCIDBCM+4 03-@IDMS 00112E 4100 C09A 0009A 660+ LA 0,SSCIDBCM+10+1-1 03-@IDMS 001132 5000 C098 00098 661+ ST 0,SSCIDBCM+8 03-@IDMS 001136 4100 B846 01846 662+ LA 0,=CL18'OFFICE' 03-@IDMS 00113A 5000 C09C 0009C 663+ ST 0,SSCIDBCM+12 03-@IDMS 00113E 4100 B87C 0187C 664+ LA 0,=CL18'ORG-DEMO-REGION' 03-@IDMS 001142 5000 C0A0 000A0 665+ ST 0,SSCIDBCM+16 03-@IDMS 001146 4100 C0BA 000BA 666+ LA 0,SSCIDBCM+43-1 02-@IDMS 00114A 5000 C0A4 000A4 667+ ST 0,SSCIDBCM+20 02-@IDMS 00114E 9680 C0A4 000A4 668+ OI SSCIDBCM+20,X'80' 02-@IDMS 001152 4100 000D 0000D 669+ LA 0,13 02-@IDMS 001156 5000 C104 00104 670+ ST 0,DMLSEQ 02-@IDMS 671+*, DML-SEQUENCE = 13 02-@IDMS 00115A 4110 C094 00094 672+ LA 1,SSCIDBCM+4 02-@IDMS 00115E 58F0 B7B0 017B0 673+ L 15,=V(IDMS) 02-@IDMS 001162 05EF 674+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 675+* *** END DML EXPANSION *** 001164 47F0 CEE6 00EE6 676 B NEWOFFC 01168 677 EOF EQU * 678 @FINISH * 679+* *** BEGIN DML EXPANSION *** 001168 4100 C030 00030 680+ LA 0,SSCTRL 02-@IDMS 00116C 5000 C094 00094 681+ ST 0,SSCIDBCM+4 02-@IDMS 001170 4100 C091 00091 682+ LA 0,SSCIDBCM+2-1 02-@IDMS 001174 5000 C098 00098 683+ ST 0,SSCIDBCM+8 02-@IDMS 001178 9680 C098 00098 684+ OI SSCIDBCM+8,X'80' 02-@IDMS 00117C 4100 000E 0000E 685+ LA 0,14 02-@IDMS 001180 5000 C104 00104 686+ ST 0,DMLSEQ 02-@IDMS 687+*, DML-SEQUENCE = 14 02-@IDMS 001184 4110 C094 00094 688+ LA 1,SSCIDBCM+4 02-@IDMS 001188 58F0 B7B0 017B0 689+ L 15,=V(IDMS) 02-@IDMS 00118C 05EF 690+ BALR 14,15 *** CALL IDMS MODE=BATCH *** 02-@IDMS 691+* *** END DML EXPANSION *** 00118E D503 C038 B46A 00038 0146A 692 CLC ERRSTAT,STATOK 001194 4770 B23C 0123C 693 BNE FINERR 694 CLOSE (OUTFILE) 001198 695+ CNOP 0,4 ALIGN LIST TO FULLWORD 01-CLOSE 001198 4510 B1A0 011A0 696+ BAL 1,*+8 LOAD REG1 W/LIST ADDR. @L2A 01-CLOSE 00119C 80 697+ DC AL1(128) OPTION BYTE 01-CLOSE 00119D 00173C 698+ DC AL3(OUTFILE) DCB ADDRESS 01-CLOSE 0011A0 0A14 699+ SVC 20 ISSUE CLOSE SVC 01-CLOSE 0011A2 58D0 B410 01410 700 L R13,SAVEAREA+4 0011A6 98EC D00C 0000C 701 LM R14,R12,12(R13) 0011AA 07FE 702 BR R14 RETURN 703 * ERROR ROUTINES * 011AC 704 BSERROR EQU * 0011AC 9240 B50D 0150D 705 MVI ERRMSG,C' ' 0011B0 D212 B50E B50D 0150E 0150D 706 MVC ERRMSG+1(19),ERRMSG 0011B6 9240 B521 01521 707 MVI ERRNUM,C' ' 0011BA D202 B522 B521 01522 01521 708 MVC ERRNUM+1(3),ERRNUM 0011C0 D203 B521 C038 01521 00038 709 MVC ERRNUM,ERRSTAT 0011C6 D213 B50D B560 0150D 01560 710 MVC ERRMSG,BSMSG 0011CC 47F0 B28A 0128A 711 B PRINTERR 011D0 712 BRERROR EQU * 0011D0 9240 B50D 0150D 713 MVI ERRMSG,C' ' 0011D4 D212 B50E B50D 0150E 0150D 714 MVC ERRMSG+1(19),ERRMSG 0011DA 9240 B521 01521 715 MVI ERRNUM,C' ' 0011DE D202 B522 B521 01522 01521 716 MVC ERRNUM+1(3),ERRNUM 0011E4 D203 B521 C038 01521 00038 717 MVC ERRNUM,ERRSTAT 0011EA D213 B50D B574 0150D 01574 718 MVC ERRMSG,BRMSG 0011F0 47F0 B28A 0128A 719 B PRINTERR 011F4 720 AREAERR EQU * 0011F4 9240 B50D 0150D 721 MVI ERRMSG,C' ' 0011F8 D212 B50E B50D 0150E 0150D 722 MVC ERRMSG+1(19),ERRMSG 0011FE 9240 B521 01521 723 MVI ERRNUM,C' ' 001202 D202 B522 B521 01522 01521 724 MVC ERRNUM+1(3),ERRNUM 001208 D203 B521 C038 01521 00038 725 MVC ERRNUM,ERRSTAT 00120E D213 B50D B588 0150D 01588 726 MVC ERRMSG,AREAMSG 001214 47F0 B28A 0128A 727 B PRINTERR 01218 728 CALCERR EQU * 001218 9240 B50D 0150D 729 MVI ERRMSG,C' ' 00121C D212 B50E B50D 0150E 0150D 730 MVC ERRMSG+1(19),ERRMSG 001222 9240 B521 01521 731 MVI ERRNUM,C' ' 001226 D202 B522 B521 01522 01521 732 MVC ERRNUM+1(3),ERRNUM 00122C D203 B521 C038 01521 00038 733 MVC ERRNUM,ERRSTAT 001232 D213 B50D B59C 0150D 0159C 734 MVC ERRMSG,CALMSG 001238 47F0 B28A 0128A 735 B PRINTERR 0123C 736 FINERR EQU * 00123C 9240 B50D 0150D 737 MVI ERRMSG,C' ' 001240 D212 B50E B50D 0150E 0150D 738 MVC ERRMSG+1(19),ERRMSG 001246 9240 B521 01521 739 MVI ERRNUM,C' ' 00124A D202 B522 B521 01522 01521 740 MVC ERRNUM+1(3),ERRNUM 001250 D203 B521 C038 01521 00038 741 MVC ERRNUM,ERRSTAT 001256 D213 B50D B5B0 0150D 015B0 742 MVC ERRMSG,FINMSG 00125C 47F0 B28A 0128A 743 B PRINTERR 01260 744 OBERR1 EQU * 001260 D200 B5C4 B8BD 015C4 018BD 745 MVC EDSW,=C'Y' 001266 4150 B126 01126 746 LA R5,MAIN040 00126A 47F0 B2AE 012AE 747 B PRINTREC 0126E 748 OBERR2 EQU * 00126E D200 B5C5 B8BD 015C5 018BD 749 MVC DSW,=C'Y' 001274 4150 B076 01076 750 LA R5,REPEAT 001278 47F0 B2AE 012AE 751 B PRINTREC 0127C 752 OBERR3 EQU * 00127C D200 B5C6 B8BD 015C6 018BD 753 MVC ESW,=C'Y' 001282 4150 B038 01038 754 LA R5,MAIN030 001286 47F0 B2AE 012AE 755 B PRINTREC 756 * PRINT ROUTINES 0128A 757 PRINTERR EQU * 00128A D284 B4D6 0040 014D6 00040 758 MVC ERRLINE,C' ' 001290 D283 B4D7 B4D6 014D7 014D6 759 MVC ERRLINE+1(132),ERRLINE 001296 92F0 B4D6 014D6 760 MVI ERRLINE,C'0' 761 PUT OUTFILE,ERRLINE 00129A 4110 B73C 0173C 762+ LA 1,OUTFILE LOAD PARAMETER REG 1 02-IHBIN 00129E 4100 B4D6 014D6 763+ LA 0,ERRLINE LOAD PARAMETER REG 0 02-IHBIN 0012A2 1FFF 764+ SLR 15,15 CLEAR REGISTER @L1A 01-PUT 0012A4 BFF7 1031 00031 765+ ICM 15,7,49(1) LOAD PUT ROUTINE ADDR @L1C 01-PUT 0012A8 05EF 766+ BALR 14,15 LINK TO PUT ROUTINE 01-PUT 0012AA 47F0 B168 01168 767 B EOF 012AE 768 PRINTREC EQU * 0012AE 9240 B5C7 015C7 769 MVI LINE1,C' ' 0012B2 D283 B5C8 B5C7 015C8 015C7 770 MVC LINE1+1(132),LINE1 0012B8 92F0 B5C7 015C7 771 MVI LINE1,C'0' 0012BC 9240 B64C 0164C 772 MVI LINE2,C' ' 0012C0 D283 B64D B64C 0164D 0164C 773 MVC LINE2+1(132),LINE2 0012C6 D500 B5C4 B8BD 015C4 018BD 774 CLC EDSW,=C'Y' 0012CC 4780 B302 01302 775 BE SKIPED 0012D0 D500 B5C5 B8BD 015C5 018BD 776 CLC DSW,=C'Y' 0012D6 4780 B2F0 012F0 777 BE SKIPD 0012DA D22C B5E2 B4A9 015E2 014A9 778 MVC LINE1+27(45),DEPT 0012E0 D203 B667 B4A5 01667 014A5 779 MVC LINE2+27(4),DID 0012E6 D500 B5C5 B8BD 015C5 018BD 780 CLC DSW,=C'Y' 0012EC 4780 B302 01302 781 BE SKIPED 012F0 782 SKIPD EQU * 0012F0 D21A B614 B486 01614 01486 783 MVC LINE1+77(27),ENAME 0012F6 D203 B699 B482 01699 01482 784 MVC LINE2+77(4),EID 0012FC D213 B634 B456 01634 01456 785 MVC LINE1+109(20),STAT 01302 786 SKIPED EQU * 001302 D20E B5CE B473 015CE 01473 787 MVC LINE1+7(15),OCITY 001308 D203 B653 B470 01653 01470 788 MVC LINE2+7(4),OCODE 789 PUT OUTFILE,LINE1 00130E 4110 B73C 0173C 790+ LA 1,OUTFILE LOAD PARAMETER REG 1 02-IHBIN 001312 4100 B5C7 015C7 791+ LA 0,LINE1 LOAD PARAMETER REG 0 02-IHBIN 001316 1FFF 792+ SLR 15,15 CLEAR REGISTER @L1A 01-PUT 001318 BFF7 1031 00031 793+ ICM 15,7,49(1) LOAD PUT ROUTINE ADDR @L1C 01-PUT 00131C 05EF 794+ BALR 14,15 LINK TO PUT ROUTINE 01-PUT 795 PUT OUTFILE,LINE2 00131E 4110 B73C 0173C 796+ LA 1,OUTFILE LOAD PARAMETER REG 1 02-IHBIN 001322 4100 B64C 0164C 797+ LA 0,LINE2 LOAD PARAMETER REG 0 02-IHBIN 001326 1FFF 798+ SLR 15,15 CLEAR REGISTER @L1A 01-PUT 001328 BFF7 1031 00031 799+ ICM 15,7,49(1) LOAD PUT ROUTINE ADDR @L1C 01-PUT 00132C 05EF 800+ BALR 14,15 LINK TO PUT ROUTINE 01-PUT 00132E D200 B5C4 B8BC 015C4 018BC 801 MVC EDSW,=C'N' 001334 D200 B5C5 B8BC 015C5 018BC 802 MVC DSW,=C'N' 00133A D200 B5C6 B8BC 015C6 018BC 803 MVC ESW,=C'N' 001340 07F5 804 BR R5 805 * CHECK STATUS ROUTINE * 01342 806 CKSTAT EQU * 001342 D501 B454 B8B2 01454 018B2 807 CLC STATNUM,=C'01' 001348 4780 B37C 0137C 808 BE ACT 00134C D501 B454 B8B4 01454 018B4 809 CLC STATNUM,=C'02' 001352 4780 B384 01384 810 BE STD 001356 D501 B454 B8B6 01454 018B6 811 CLC STATNUM,=C'03' 00135C 4780 B38C 0138C 812 BE LTD 001360 D501 B454 B8B8 01454 018B8 813 CLC STATNUM,=C'04' 001366 4780 B394 01394 814 BE LVO 00136A D501 B454 B8BA 01454 018BA 815 CLC STATNUM,=C'05' 001370 4780 B39C 0139C 816 BE TRM 001374 D213 B456 B7BC 01456 017BC 817 MVC STAT,=C' STATUS CODE ERROR ' 00137A 07F6 818 BR R6 0137C 819 ACT EQU * 00137C D213 B456 B7D0 01456 017D0 820 MVC STAT,=C' ACTIVE ' 001382 07F6 821 BR R6 01384 822 STD EQU * 001384 D213 B456 B7E4 01456 017E4 823 MVC STAT,=C' SHORT TERM DISABLED' 00138A 07F6 824 BR R6 0138C 825 LTD EQU * 00138C D213 B456 B7F8 01456 017F8 826 MVC STAT,=C' LONG TERM DISBALED ' 001392 07F6 827 BR R6 01394 828 LVO EQU * 001394 D213 B456 B80C 01456 0180C 829 MVC STAT,=C' LEAVE OF ABSENCE ' 00139A 07F6 830 BR R6 0139C 831 TRM EQU * 00139C D213 B456 B820 01456 01820 832 MVC STAT,=C' TERMINATED ' 0013A2 07F6 833 BR R6 834 * PRINT REPORT HEADING ROUTINE * 013A4 835 PRTHEAD EQU * 0013A4 9240 B5C7 015C7 836 MVI LINE1,C' ' 0013A8 D283 B5C8 B5C7 015C8 015C7 837 MVC LINE1+1(132),LINE1 0013AE 92F1 B5C7 015C7 838 MVI LINE1,C'1' 0013B2 D219 B5FD B6D1 015FD 016D1 839 MVC LINE1+54(26),HEAD1 840 PUT OUTFILE,LINE1 0013B8 4110 B73C 0173C 841+ LA 1,OUTFILE LOAD PARAMETER REG 1 02-IHBIN 0013BC 4100 B5C7 015C7 842+ LA 0,LINE1 LOAD PARAMETER REG 0 02-IHBIN 0013C0 1FFF 843+ SLR 15,15 CLEAR REGISTER @L1A 01-PUT 0013C2 BFF7 1031 00031 844+ ICM 15,7,49(1) LOAD PUT ROUTINE ADDR @L1C 01-PUT 0013C6 05EF 845+ BALR 14,15 LINK TO PUT ROUTINE 01-PUT 0013C8 9240 B5C7 015C7 846 MVI LINE1,C' ' 0013CC D283 B5C8 B5C7 015C8 015C7 847 MVC LINE1+1(132),LINE1 0013D2 9260 B5C7 015C7 848 MVI LINE1,C'-' 0013D6 D211 B5CD B6EB 015CD 016EB 849 MVC LINE1+6(18),HEAD2O 0013DC D219 B5E1 B6FD 015E1 016FD 850 MVC LINE1+26(26),HEAD2D 0013E2 D213 B613 B717 01613 01717 851 MVC LINE1+76(20),HEAD2E 0013E8 D20E B633 B72B 01633 0172B 852 MVC LINE1+108(15),HEAD2S 853 PUT OUTFILE,LINE1 0013EE 4110 B73C 0173C 854+ LA 1,OUTFILE LOAD PARAMETER REG 1 02-IHBIN 0013F2 4100 B5C7 015C7 855+ LA 0,LINE1 LOAD PARAMETER REG 0 02-IHBIN 0013F6 1FFF 856+ SLR 15,15 CLEAR REGISTER @L1A 01-PUT 0013F8 BFF7 1031 00031 857+ ICM 15,7,49(1) LOAD PUT ROUTINE ADDR @L1C 01-PUT 0013FC 05EF 858+ BALR 14,15 LINK TO PUT ROUTINE 01-PUT 0013FE 07F5 859 BR R5 860 * 001400 E6D6D9D260C6C9C5 861 WORKFLDS DC C'WORK-FIELDS' 00140B 00 00140C 0000000000000000 862 SAVEAREA DC 18F'0' 001454 863 STATNUM DS CL2 001456 864 STAT DS CL20 00146A F0F0F0F0 865 STATOK DC CL4'0000' 00146E 866 STATUS DS CL2 001470 867 OCODE DS CL3 001473 868 OCITY DS CL15 001482 869 EID DS CL4 001486 870 ENAME DS 0CL27 001486 871 FNAME DS CL10 001490 872 DS CL2 001492 873 LNAME DS CL15 0014A1 874 WALK DS CL4 0014A5 875 DID DS CL4 0014A9 876 DEPT DS CL45 0014D6 877 ERRLINE DS 0CL133 0014D6 878 DS CL1 0014D7 5C405C405C405C40 879 DC CL48'* * * * * * * * * * * * * * * * * * * * ' 001507 404040404040 880 DC CL6' ' 00150D 881 ERRMSG DS CL20 001521 882 ERRNUM DS CL4 001525 404040404040 883 DC CL6' ' 00152B 5C405C405C405C40 884 DC CL48'* * * * * * * * * * * * * * * * * * * * ' 00155B 4040404040 885 DC CL5' ' 001560 C2C9D5C440E2E4C2 886 BSMSG DC CL20'BIND SUBSCH ERROR # ' 001574 C2C9D5C440D9C5C3 887 BRMSG DC CL20'BIND RECORD ERROR # ' 001588 D9C5C1C4E840C1D9 888 AREAMSG DC CL20'READY AREA ERROR # ' 00159C C6C9D5C440C3C1D3 889 CALMSG DC CL20'FIND CALC ERROR # ' 0015B0 7CC6C9D5C9E2C840 890 FINMSG DC CL20'@FINISH ERROR # ' 0015C4 891 EDSW DS CL1 0015C5 892 DSW DS CL1 0015C6 893 ESW DS CL1 0015C7 894 LINE1 DS CL133 00164C 895 LINE2 DS CL133 0016D1 D6C6C6C9C3C54040 896 HEAD1 DC CL26'OFFICE PERSONNEL LISTING' 0016EB D6C6C6C9C3C561D6 897 HEAD2O DC CL18'OFFICE/OFFICE CODE' 0016FD C4C5D7C1D9E3D4C5 898 HEAD2D DC CL26'DEPARTMENT/DEPARTMENT CODE' 001717 C5D4D7D3D6E8C5C5 899 HEAD2E DC CL20'EMPLOYEE/EMPLOYEE ID' 00172B C5D4D7D3D6E8C5C5 900 HEAD2S DC CL15'EMPLOYEE STATUS' 901 * OUTPUT FILE DCB INFO 902 OUTFILE DCB DDNAME=OUTFILE,MACRF=PM,BLKSIZE=133,LRECL=133, X DSORG=PS 904+* DATA CONTROL BLOCK 905+* 00173A 0000 00173C 906+OUTFILE DC 0F'0' ORIGIN ON WORD BOUNDARY 01-DCB 907+* DIRECT ACCESS DEVICE INTERFACE 00173C 0000000000000000 908+ DC BL16'0' FDAD, DVTBL 01-DCB 00174C 00000000 909+ DC A(0) KEYLEN, DEVT, TRBAL 01-DCB 910+* COMMON ACCESS METHOD INTERFACE 001750 00 911+ DC AL1(0) BUFNO, NUMBER OF BUFFERS 01-DCB 001751 000001 912+ DC AL3(1) BUFCB, BUFFER POOL CONTROL BLOCK 01-DCB 001754 0000 913+ DC AL2(0) BUFL, BUFFER LENGTH 01-DCB 001756 4000 914+ DC BL2'0100000000000000' DSORG, DATA SET ORGANIZATION 01-DCB 001758 00000001 915+ DC A(1) IOBAD FOR EXCP OR RESERVED 01-DCB 916+* FOUNDATION EXTENSION 00175C 00 917+ DC BL1'00000000' BFTEK, BFALN, DCBE INDICATORS 01-DCB 00175D 000001 918+ DC AL3(1) EODAD (END OF DATA ROUTINE ADDRESS) 01-DCB 001760 00 919+ DC BL1'00000000' RECFM (RECORD FORMAT) 01-DCB 001761 000000 920+ DC AL3(0) EXLST (EXIT LIST ADDRESS) 01-DCB 921+* FOUNDATION BLOCK 001764 D6E4E3C6C9D3C540 922+ DC CL8'OUTFILE' DDNAME 01-DCB 00176C 02 923+ DC BL1'00000010' OFLGS (OPEN FLAGS) 01-DCB 00176D 00 924+ DC BL1'00000000' IFLGS (IOS FLAGS) 01-DCB 00176E 0050 925+ DC BL2'0000000001010000' MACR (MACRO FORMAT) 01-DCB 926+* BSAM-BPAM-QSAM INTERFACE 001770 00 927+ DC BL1'00000000' OPTCD, OPTION CODES 01-DCB 001771 000001 928+ DC AL3(1) CHECK OR INTERNAL QSAM SYNCHRONIZING RTN. 01-DCB 001774 00000001 929+ DC A(1) SYNAD, SYNCHRONOUS ERROR RTN. (3 BYTES) 01-DCB 001778 0000 930+ DC H'0' INTERNAL ACCESS METHOD FLAGS 01-DCB 00177A 0085 931+ DC AL2(133) BLKSIZE, BLOCK SIZE 01-DCB 00177C 00000000 932+ DC F'0' INTERNAL ACCESS METHOD FLAGS 01-DCB 001780 00000001 933+ DC A(1) INTERNAL ACCESS METHOD USE 01-DCB 934+* QSAM INTERFACE 001784 00000001 935+ DC A(1) EOBAD 01-DCB 001788 00000001 936+ DC A(1) RECAD 01-DCB 00178C 0000 937+ DC H'0' QSWS (FLAGS) AND EITHER DIRCT OR BUFOFF 01-DCB 00178E 0085 938+ DC AL2(133) LRECL 01-DCB 001790 00 939+ DC BL1'00000000' EROPT, ERROR OPTION 01-DCB 001791 000001 940+ DC AL3(1) CNTRL 01-DCB 001794 00000000 941+ DC H'0,0' RESERVED AND PRECL 01-DCB 001798 00000001 942+ DC A(1) EOB, INTERNAL ACCESS METHOD FIELD 01-DCB 0017A0 943 LTORG 0017A0 4040404040404040 944 =CL8' ' 0017A8 C1D7D7D3C4C9C3E3 945 =CL8'APPLDICT' 0017B0 00000000 946 =V(IDMS) 0017B4 F0F3F0F7 947 =C'0307' 0017B8 F0F0F0F0 948 =C'0000' 0017BC 40E2E3C1E3E4E240 949 =C' STATUS CODE ERROR ' 0017D0 40C1C3E3C9E5C540 950 =C' ACTIVE ' 0017E4 40E2C8D6D9E340E3 951 =C' SHORT TERM DISABLED' 0017F8 40D3D6D5C740E3C5 952 =C' LONG TERM DISBALED ' 00180C 40D3C5C1E5C540D6 953 =C' LEAVE OF ABSENCE ' 001820 40E3C5D9D4C9D5C1 954 =C' TERMINATED ' 001834 C5D4D7E2E2F0F140 955 =CL18'EMPSS01 ' 001846 D6C6C6C9C3C54040 956 =CL18'OFFICE' 001858 C5D4D7D3D6E8C5C5 957 =CL18'EMPLOYEE' 00186A C4C5D7C1D9E3D4C5 958 =CL18'DEPARTMENT' 00187C D6D9C760C4C5D4D6 959 =CL18'ORG-DEMO-REGION' 00188E D6C6C6C9C3C560C5 960 =CL18'OFFICE-EMPLOYEE' 0018A0 C4C5D7E360C5D4D7 961 =CL18'DEPT-EMPLOYEE' 0018B2 F0F1 962 =C'01' 0018B4 F0F2 963 =C'02' 0018B6 F0F3 964 =C'03' 0018B8 F0F4 965 =C'04' 0018BA F0F5 966 =C'05' 0018BC D5 967 =C'N' 0018BD E8 968 =C'Y' 000000 969 END SAMPLE1
|
Copyright © 2014 CA.
All rights reserved.
|
|