forked from IBM/IBM-Z-zOS
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathIEAMDBL3.s
3888 lines (3888 loc) · 308 KB
/
IEAMDBL3.s
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
* START OF SPECIFICATIONS ******************************************** 00010000
* * 00020000
*01* MEMBER-NAME: IEAMDBL3 * 00030000
* * 00040000
*02* DESCRIPTIVE-NAME: Sample program to read records from an * 00050000
* Operations Log stream and convert them to * 00060000
* DLOG format, and to delete records from @TTC* 00070000
* the stream. * 00080000
* * 00090000
*********************************************************************** 00100000
* * 00110018
*01* COPYRIGHT = * 00220000
* * 00220118
* Beginning of Copyright and License * 00220200
* * 00220300
* Copyright 2019 IBM Corp. * 00220400
* * 00220500
* Licensed under the Apache License, Version 2.0 (the "License"); * 00220600
* you may not use this file except in compliance with the License. * 00220700
* You may obtain a copy of the License at * 00220800
* * 00220900
* http://www.apache.org/licenses/LICENSE-2.0 * 00221000
* * 00222018
* Unless required by applicable law or agreed to in writing, * 00223018
* software distributed under the License is distributed on an * 00224018
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, * 00225018
* either express or implied. See the License for the specific * 00226018
* language governing permissions and limitations under the License.* 00227018
* * 00228018
* End of Copyright and License * 00229018
* * 00230018
*********************************************************************** 00230118
* * 00230200
*01* DISCLAIMER = * 00230300
* * 00230400
* This sample source is provided for tutorial purposes only. A * 00240000
* complete handling of error conditions has not been shown or * 00250000
* attempted, and this source has not been submitted to formal IBM * 00260000
* testing. This source is distributed on an 'as is' basis * 00270000
* without any warranties either expressed or implied. * 00280000
* * 00290000
*01* FUNCTION: * 00300000
* * 00310000
* This program is an example of how to use the services of the * 00320000
* MVS System Logger to retrieve and delete records from the * 00330000
* Operations Log stream. In response to parameters, it can @D2A* 00340000
* read the records created in a given time span, convert @D2A* 00350000
* them from Message Data Block (MDB) format to Hard-copy Log @D2A* 00360000
* format (JES3 DLOG), mapped by DSECT DLOGLINE, and write @TTC* 00370000
* the DLOG-format records to a file; and/or it can delete @TTC* 00380000
* all the records from the stream that were created prior @TTC* 00390000
* to a given date. @TTC* 00400000
* @TTA* 00401000
* It is assumed the Operations Log (Operlog) contains JES2- @TTA* 00402000
* generated records. Running this program against JES3- @TTA* 00403000
* generated records will produce incompatible format for @TTA* 00404000
* JES3 Global-generated messages. @TTA* 00405000
* @D2A* 00410000
* The parameters are as follows: @D2A* 00420000
* @D2A* 00430000
* COPY([start_date][,end_date]), DELETE(date) @D2A* 00440000
* (>nnn) (>nnn) @D2A* 00450000
* @D2A* 00460000
* COPY: Records are to be copied to the DLOG-format file. @TTC* 00470000
* If COPY is not specified, no records are copied. @D2A* 00480000
* @D2A* 00490000
* start_date,end_date: The starting and ending dates of @D2A* 00500000
* the time span, both in the format YYYYDDD. start_date @D2A* 00510000
* must not be later than end_date. end_date must not be @D2A* 00520000
* later than today, the day the program runs. The @D2A* 00530000
* default for start_date is the date of the oldest @D2A* 00540000
* record in the log stream, and for end_date is @D2A* 00550000
* yesterday, the day before the program runs. If both @D2A* 00560000
* start_date and end_date are allowed to default, the @D2A* 00570000
* parentheses after COPY may be omitted. If you @01C* 00580000
* specify a start date of today, you must also specify @01A* 00590000
* the end date of today, otherwise the program will @01A* 00600000
* assume an end date of yesterday and abend. @01A* 00610000
* @D2A* 00620000
* >nnn: Indicates that records dated more than nnn days @D2A* 00630000
* before today are to be copied. The time span will @D2A* 00640000
* start with the date of the oldest record in the log @D2A* 00650000
* stream and end nnn+1 days before today (that is, @D2A* 00660000
* records dated more than nnn days before today will @D2A* 00670000
* be copied. nnn is a number between zero and 999. @D2A* 00680000
* For example, if the program is run on May 25, @D2A* 00690000
* specifying "COPY(>3)" will copy records dated up to @D2A* 00700000
* and including May 21. Note that >0 corresponds to @D2A* 00710000
* yesterday. To copy today's records, you must use the @D2A* 00720000
* "[start_date][,end_date]" form and specify today as @D2A* 00730000
* the end date. @D2A* 00740000
* @D2A* 00750000
* DELETE: Records are to be deleted. If DELETE is not @D2A* 00760000
* specified, no records are deleted. @D2A* 00770000
* @D2A* 00780000
* date: The date of the newest record to be deleted from @D2A* 00790000
* the log stream. All records dated on or before that @D2A* 00800000
* date will be deleted. The date must not be later than @D2A* 00810000
* today. If the date specified is today, all records in @D2A* 00820000
* the log stream will be deleted. @D2A* 00830000
* @D2A* 00840000
* >nnn: Indicates that records dated more than nnn days @D2A* 00850000
* before today are to be deleted. nnn is a number @D2A* 00860000
* between zero and 999. For example, if the program is @D2A* 00870000
* run on July 15, specifying "DELETE(>5)" will delete @D2A* 00880000
* records dated up to and including July 9. Note that @D2A* 00890000
* >0 corresponds to yesterday. To delete today's @D2A* 00900000
* records, you must use the "date" form and specify @D2A* 00910000
* today as the date. @D2A* 00920000
* @D2A* 00930000
* If DELETE is specified, either the date or ">nnn" must @D2A* 00940000
* be given. @D2A* 00950000
* @D2A* 00960000
* You may specify either COPY or DELETE or both. If you @D2A* 00970000
* specify both they must be separated by a comma and may @D2A* 00980000
* appear in either order. However, regardless of the order @D2A* 00990000
* in which the parameters are specified, the copy operation @D2A* 01000000
* will always occur before the delete. @D2A* 01010000
* @D2A* 01020000
* HCFORMAT: Specifies whether the output records (in JES3 @TTC* 01030000
* DLOG format) should have a 2-digit or a 4-digit date. @TTC* 01040000
* @04A* 01050000
* YEAR: A 2-digit year will appear in the output records. @04A* 01060000
* The DLOGLINE mapping will be used to map the JES3 DLOG @TTC* 01070000
* format output records. If the HCFORMAT keyword is @04A* 01080000
* not specified HCFORMAT(YEAR) is the default. @04A* 01090000
* @D2A* 01100000
* CENTURY: A 4-digit year will appear in the output @04A* 01110000
* records. The DLOGLINE mapping will be used to map the @TTC* 01120000
* JES3 DLOG format output records. @TTC* 01130000
* @D2A* 01140000
* An optional DD - JES3IN - can be used in the JCL to allow @TTA* 01140400
* for a more customized format. (It is assumed that the @TTA* 01140800
* customer will use the same set of processors in JES2 as @TTA* 01141200
* were used in JES3.) Two JES3 Initialization statements @TTA* 01141600
* are supported: @TTA* 01142000
* @TTA* 01142400
* - MAINPROC @TTA* 01142800
* - MSGROUTE @TTA* 01143200
* @TTA* 01143600
* Other statements, if provided, are ignored. No error @TTA* 01144000
* messages for extranous statements or syntax errors found @TTA* 01144400
* are issued. @TTA* 01144800
* @TTA* 01145200
* The MAINPROC is used to extract the format of the Receive @TTA* 01145600
* id for each processor defined in the configuration. The @TTA* 01146000
* MSGROUTE is used to determine what JES3 Destination code @TTA* 01146400
* and/or console name should be displayed on the output line @TTA* 01146800
* based on the routing code. @TTA* 01147200
* @TTA* 01147600
* If neither statement is provided, the receive id will be @TTA* 01148000
* the same as system name. The routing code will be used @TTA* 01148400
* to display the JES3 Destination class with no further @TTA* 01148800
* changes. @TTA* 01149200
* @TTA* 01149600
* Warning: When copying records, this program detects the @D2A* 01150000
* end of a day's records when it either reads the first @D2A* 01160000
* record for the next day or attempts to read past the @D2A* 01170000
* newest record in the log stream. This means that, if @D2A* 01180000
* end_date is today and the log stream is being written at @D2A* 01190000
* the time this program runs, the records that are copied @D2A* 01200000
* may not be predictable. In particular, if both COPY with @D2A* 01210000
* an ending date of today and DELETE with a date of today @D2A* 01220000
* are specified, there may be more records deleted than @D2A* 01230000
* copied. @D2A* 01240000
* @D2A* 01250000
* Warning: When the ">nnn" form of the COPY or DELETE @D2A* 01260000
* parameter is specified, program converts it to a date by @D2A* 01270000
* subtracting nnn days from the date the program is run. @D2A* 01280000
* The calculation is done once, at the beginning of the @D2A* 01290000
* program. If the program is run shortly before midnight, @D2A* 01300000
* so that the calculation occurs before midnight and the @D2A* 01310000
* actual copying or deletion of records occurs after @D2A* 01320000
* midnight, the records copied or deleted will not reflect @D2A* 01330000
* the number of days specified. To prevent this, you should @D2A* 01340000
* avoid running the program close to midnight with the @D2A* 01350000
* ">nnn" form. @D2A* 01360000
* @D2A* 01370000
* Note that if the program is run regularly after midnight @D2A* 01380000
* with the parameter "COPY(>0),DELETE(>1)", it will copy @D2A* 01390000
* records from the previous day and earlier, and will delete @D2A* 01400000
* from the records from two days ago, leaving something over @D2A* 01410000
* 24 hours' worth of records in the log each time. @D2A* 01420000
* @D2A* 01430000
* Limitations: * 01440000
* * 01450000
* (1) The selection of records uses the internal timestamp of * 01460000
* log stream records, which corresponds to the time of the * 01470000
* request to write the record to the stream. It is possible * 01480000
* for records to be out of sequence in the log, in which * 01490000
* case the records ostensibly for a given day may include * 01500000
* some from the previous or next day. Moreover, the * 01510000
* timestamp in an MDB is not necessarily the same as that of * 01520000
* the internal log stream record. * 01530000
* * 01540000
* Therefore the selection by date is no better than an * 01550000
* approximation. * 01560000
* * 01570000
* However, the set of records selected for a given day will * 01580000
* be unique. * 01590000
* * 01600000
* (2) Records could be missing based on prior @01A* 01610000
* activities. In these cases, a message will be @01A* 01620000
* written to the output file with a unique format to @01A* 01630000
* identify it. This will be done for record gaps @01A* 01640000
* or deletions found at the beginning or end of the @01A* 01650000
* data, or any place in the middle. If the special @01A* 01660000
* messages would interfere with any applications using @01A* 01670000
* the output, adjust or remove the code as appropriate. @01A* 01680000
* @01A* 01690000
*01* OPERATION: * 01700000
* * 01710000
*********************************************************************** 01720000
* * 01730000
* Initialization: * 01740000
* * 01750000
* If COPY was specified, get end and start dates or calculate @D2A* 01760000
* defaults, yesterday and "oldest" respectively. @D2A* 01770000
* @D2A* 01780000
* If DELETE was specified, get delete date. @D2A* 01790000
* * 01800000
* If HCFORMAT was specified, set the appropriate flags to @04A* 01810000
* indicate if HCFORMAT(YEAR) or HCFORMAT(CENTURY) was @04A* 01820000
* specified. @04A* 01830000
* * 01840000
* Open the JES3IN DD, if present, and parse the MAINPROC and @TTA* 01842000
* MSGROUTE initialization statements. Build tables to be used @TTA* 01844000
* during output formatting. @TTA* 01846000
* @TTA* 01848000
* Obtain a buffer area for logger record and set up its base * 01850000
* * 01860000
* Connect to the log stream * 01870000
* * 01880000
*********************************************************************** 01890000
* * 01900000
* Copy: @D2A* 01910000
* @D2A* 01920000
* If COPY was specified: @D2A* 01930000
* @D2A* 01940000
* Start a log stream browse session and position the log stream @D2A* 01950000
* to first record in the range @D2A* 01960000
* @D2A* 01970000
* Copy loop: @D2A* 01980000
* * 01990000
* Read successive records from the stream, starting with the * 02000000
* earliest record bearing the start date and ending with the * 02010000
* latest record on or before the end date * 02020000
* @01A* 02030000
* If the return and reason code indicates a gap in records @01A* 02040000
* or deleted records, show this by adding a special message @01A* 02050000
* to the output file. @01A* 02060000
* * 02070000
* For each record (MDB) that is read: * 02080000
* * 02090000
* Get the general and CP objects * 02100000
* * 02110000
* Extract the fixed info * 02120000
* * 02130000
* For every line (text object) in the message: * 02140000
* * 02150000
* Write a DLOG-format line to the output file @TTC* 02160000
* * 02170000
* If line was too long, also write a continuation line * 02180000
* * 02190000
* End the log stream browse session * 02200000
* * 02210000
* Close the output file * 02220000
* * 02230000
* 6#@TTD* 02231001
* * 02240000
*********************************************************************** 02250000
* Delete: @D2A* 02260000
* @D2A* 02270000
* If delete was specified: @D2A* 02280000
* @D2A* 02290000
* Start a log stream browse session and position the log stream @D2A* 02300000
* to oldest record to be kept @D2A* 02310000
* @D2A* 02320000
* Delete all records prior to that position @D2A* 02330000
* @D2A* 02340000
* End the log stream browse session @D2A* 02350000
* @D2A* 02360000
*********************************************************************** 02370000
* HCFORMAT: @04A* 02380000
* @04A* 02390000
* If HCFORMAT was specified: @04A* 02400000
* @04A* 02410000
* If HCFORMAT(CENTURY) was specified the output records will @04A* 02420000
* have a 4-digit date and the HCR mapping will be used to map @04A* 02430000
* the records, otherwise the output records will have a 2-digit @04A* 02440000
* date and the HCL mapping will be used to map the records. @04A* 02450000
* * 02460000
*********************************************************************** 02470000
* * 02480000
* Cleanup: * 02490000
* * 02500000
* Disconnect from the log stream * 02510000
* * 02520000
* Free the buffer area * 02530000
* * 02540000
* Exit * 02550000
* * 02560000
*********************************************************************** 02570000
* * 02580000
* Sample Invocation Jobs: @D2C* 02590000
* * 02600000
* (1) Using YYYYDDD format parameters, and having a 2-digit year @04C* 02610000
* in the output records. @04A* 02620000
* @D2A* 02630000
* //jjj JOB ... * 02640000
* //sss EXEC PGM=IEAMDBL3, @D2C* 02650000
* // PARM='COPY(2021182),DELETE(2021181),HCFORMAT(YEAR)' @TTC* 02660000
* //DLOG DD DSN=ALL.DLOGS(+1), @TTC* 02670000
* // DISP=(NEW,CATLG,DELETE), * 02680000
* // DCB=BLKSIZE=22880 * 02690000
* //JES3IN DD DSN=JES3.INIT.STREAM,DISP=SHR @TTA* 02695000
* * 02700000
* NOTE: This example job will copy records created between July @TTC* 02710000
* 1, 2021, and "yesterday", inclusive, and will delete @TTC* 02720000
* from the log stream any records created on or before * 02730000
* June 30, 2021. The date part of the output records will @TTC* 02740000
* have a 2-digit year. @TTC* 02750000
* @D2A* 02760000
* (2) Using >nnn format parameters, and having a 4-digit year @04C* 02770000
* in the output records. @04A* 02780000
* @D2A* 02790000
* //jjj JOB ... @D2A* 02800000
* //sss EXEC PGM=IEAMDBL3, @D2A* 02810000
* // PARM='COPY(>5),DELETE(>8),HCFORMAT(CENTURY)' @04C* 02820000
* //DLOG DD DSN=ALL.DLOGS(+1), @TTC* 02830000
* // DISP=(NEW,CATLG,DELETE), @D2A* 02840000
* // DCB=BLKSIZE=22880 @D2A* 02850000
* //JES3IN DD DSN=JES3.INIT.STREAM,DISP=SHR @TTA* 02855000
* @D2A* 02860000
* NOTE: Assuming it is run on July 15, this example job will @D2A* 02870000
* copy records created on or before July 9, and will @D2A* 02880000
* delete from the log stream any records created on or @D2A* 02890000
* before July 6. The date part of the output records @04C* 02900000
* will have a 4-digit year. @04A* 02910000
* * 02920000
* ENTRY POINT = IEAMDBL3 * 02930000
* PURPOSE = Copy records from an operations log stream to a * 02940000
* sequential file in DLOG format, and delete @TTC* 02950000
* records from the operations log. * 02960000
* LINKAGE = BRANCH * 02970000
* INPUT = Whether records are to be copied, and if so @D2A* 02980000
* the starting and ending dates of the @D2C* 02990000
* interval of records to copy; and whether @D2C* 03000000
* records are to be deleted, and if so the @D2A* 03010000
* date of the newest record to delete. @D2A* 03020000
* * 03030000
* REGISTERS SAVED= NONE * 03040000
* REGISTER USAGE = R1 - Address of a fullword pointer to the * 03050000
* parameter area. The parameter area is on a * 03060000
* halfword boundary, and consists of a * 03070000
* halfword length of the parameter followed * 03080000
* by the parameter. @D2C* 03090000
* * 03100000
* R14 - Return address. * 03110000
* REGISTERS RESTORED * 03120000
* = NONE * 03130000
* * 03140000
*01* RECOVERY OPERATION: * 03150000
* * 03160000
* None. This program make no attempt to recover from failures. * 03170000
* The caller's recovery environment, if any, will remain in * 03180000
* effect. For any abend other than one of the user abends @01C* 03190000
* issued normally by this program, you should check the output @01A* 03200000
* file for any additional information. @01A* 03210000
* * 03220000
* If additional levels of recovery are needed for particular * 03230000
* environments, the program must be modified and reassembled. * 03240000
* * 03250000
*01* SYSTEM BUILD INFORMATION * 03260000
* LOAD MODULE = IEAMDBL3 * 03270000
* DISTRIBUTION LIBARY = SYS1.ASAMPLIB * 03280000
* SYSGEN MAC = none * 03290000
* ALIAS NAME = none * 03300000
* ENTRY POINT = IEAMDBL3 * 03310000
* PAGE BOUNDARY = NO * 03320000
* TARGET LIBRARY = Any * 03330000
* ASSEMBLER LIBRARIES = SYS1.MACLIB, * 03340000
* SYS1.AMODGEN * 03350000
* LINKAGE EDITOR ATTRIBUTES = REUS * 03360000
* AMODE = 31 * 03370000
* RMODE = 31 @TTC* 03380000
* * 03390000
* NOTES = @01A* 03400000
* @01A* 03410000
* - This program makes use of logger service routines. @01A* 03420000
* Changes to these service routines (e.g. new return @01A* 03430000
* or reason codes) may necessitate changes to this @01A* 03440000
* program. @01A* 03450000
* * 03460000
* - This program must be link edited as Non-Reentrant, @PCA* 03461000
* since this program uses global variables which @PCA* 03463000
* allow for it to modify its own storage. To make @PCA* 03464000
* the link edit job Non-Reentrant remove RENT from @PCA* 03464100
* the PARM= statement. 03464200
* - Example JCL: @PCA* 03465000
* @PCA* 03465100
* //*---------------------------------------------------- @PCA* 03465600
* //LNKLPA EXEC PGM=linkproc,PARM='MAP,LET,LIST,NORENT' @PCA* 03465700
* //SYSLMOD DD DSN=linked.userlib,DISP=SHR @PCA* 03465900
* //SYSUT1 DD UNIT=SYSDA,SPACE=(CYL,(3,2)),DSN=&SYSUT1 @PCA* 03466000
* //SYSPRINT DD SYSOUT=*,DCB=(RECFM=FB,BLKSIZE=3509) @PCA* 03466100
* //DR1 DD DSN=assem.ieamdbl3.obj,DISP=SHR @PCA* 03466200
* //SYSLIN DD * @PCA* 03466900
* ******************************************************* @PCA* 03467000
* * IEAMDBL3 Sample program @PCA* 03467300
* ******************************************************* @PCA* 03467500
* INCLUDE DR1(IEAMDBL3) @PCA* 03467700
* ENTRY IEAMDBL3 @PCA* 03467800
* NAME IEAMDBL3(R) RC=0 @PCA* 03467900
* @PCA* 03468000
* * 03469000
*01* MESSAGES = * 03470000
* The following messages are displayed on the issuing console @01A* 03480000
* * 03490000
* MLG001I INVALID OR MISSING PARAMETER @D2C* 03500000
* * 03510000
* Meaning: The parameter on the EXEC statement statement could * 03520000
* not be parsed. The program will abend with * 03530000
* completion code U0001. Correct the parameter and * 03540000
* rerun the step. * 03550000
* * 03560000
* * 03570000
* MLG002I ERROR DURING SYSTEM LOGGER rrrrrrrr-n, @P6C* 03580000
* RETURN CODE xxx, REASON CODE yyyy * 03590000
* * 03600000
* Meaning: A request to a System Logger service failed. The * 03610000
* program will abend with completion code U002. The * 03620000
* failing service is identified by "rrrrrrrr", which * 03630000
* may be "IXGCONN", "IXGBRWSE", or "IXGDELET". * 03640000
* If there is more than one invocation of the @P6C* 03650000
* service, the invocation that failed is indicated @P6C* 03660000
* by "-n", where n is a number that identifies the @P6C* 03670000
* instance. @P6C* 03680000
* "xxx" is the return code and "yyyy" the reason code. * 03690000
* See the documentation of the system logger services, * 03700000
* correct the problem, and rerun the step. * 03710000
* * 03720000
* * 03730000
* MLG003I NO RECORDS IN RANGE * 03740000
* * 03750000
* Meaning: There were no records in the operations log stream * 03760000
* created between the starting and ending dates, * 03770000
* inclusive. The program will continue. Any records * 03780000
* in the log stream that are eligible for deletion will * 03790000
* be deleted. The output file will be empty. * 03800000
* @01A* 03810000
* MLG004I LOG STREAM IS EMPTY @03A* 03820000
* @03A* 03830000
* Meaning: The return from IXGBRWSE has indicated that there @03A* 03840000
* are no records in the log stream. @03A* 03850000
* * 03860000
* The following message is issued to the output file @01A* 03870000
* @01A* 03880000
* ILG0001 RECORDS NOT AVAILABLE. IXGxxxxx-nn RETURN CODE nnn, @01A* 03890000
* REASON CODE nnnn @01A* 03900000
* @01A* 03910000
* Meaning: The return and reason codes from a log stream @01A* 03920000
* service routine indicate that data may be missing @01A* 03930000
* @01A* 03940000
* the -nn at the end of the service routine name @01A* 03950000
* identifies the specific instance of the routine @01A* 03960000
* invoked at which point the unavailable records @01A* 03970000
* were detected. @01A* 03980000
* @01A* 03990000
* If the service routine is IXGCONN, then the @01A* 04000000
* service routine has indicated that data may be @01A* 04010000
* missing. @01A* 04020000
* @01A* 04030000
* If the service routine is IXGBRWSE, then one of @01A* 04040000
* the following has probably occurred. @01A* 04050000
* @01A* 04060000
* - A gap has been found in records immediately @01A* 04070000
* prior to the first record found meeting @01A* 04080000
* selection criteria. @01A* 04090000
* - Records had previously been deleted immediately @01A* 04100000
* prior to the first record found meeting @01A* 04110000
* selection criteria. @01A* 04120000
* - There was a gap or deleted records between two @01A* 04130000
* records within selection criteria. @01A* 04140000
* - A gap or deleted records immediately follow @01A* 04150000
* the last record meeting criteria. This routine @01A* 04160000
* then either encountered end of file, or the @01A* 04170000
* next record was out of selection criteria. @01A* 04180000
* - records could be permanently missing from the @01A* 04190000
* log stream. @01A* 04200000
* @01A* 04210000
* In all cases, check the return and reason codes @01A* 04220000
* of the indicated logger service routine for @01A* 04230000
* additional information. @01A* 04240000
* * 04250000
*01* ABEND CODES = * 04260000
* * 04270000
* U0001 The parameter on the EXEC statement could not be * 04280000
* parsed. Message MLG001I is issued. See the * 04290000
* description of message MLG001I for more information. * 04300000
* * 04310000
* U0002 A request for a system logger service failed. * 04320000
* Message MLG002I is issued. See the description of * 04330000
* message MLG002I for more information. * 04340000
* * 04350000
* U0003 A request to open the output file failed. Messages * 04360000
* about the failure are issued by DPF. See the * 04370000
* desription of those messages for more information. * 04380000
* * 04390000
* *01* CHANGE ACTIVITY = * 04400000
* * 04410000
* $MOD(IEAMDBLG), COMP(SC1CK): SAMPLE PROGRAM TO CONVERT OPERLOG RECS * 04420000
* $L0=OPLOG7DG HBB5520 940331 PDDG: ORIGINAL MODULE * 04430000
* $D1=DN70048 HBB5520 940603 PDDG: GET CONSNAME, MCSFLAGS FROM MDB * 04440000
* $P1=PN71025 HBB5520 940713 PDCM: USE LOCAL TIME, NOT GMT * 04450000
* $P2=PN71000 HBB5520 940727 PDCM: PROLOG CLARIFICATIONS * 04460000
* $P3=PN70702 HBB5520 940803 PDDG: REMOVE DMTI MACRO REFERENCE * 04470000
* $D2=DN70103 HBB5520 941108 PDDG: SEPARATE COPY AND DELETE PARMS * 04480000
* $P4=PN72038 HBB5520 941108 PDDG: ADD MULTILINE ID TO MAJOR LINE * 04490000
* $P5=PN72143 HBB5520 941219 PDDG: MSG MLG002 HAS WRONG LENGTH * 04500000
* $P6=PN72276 HBB5520 950105 PDDG: FAILS W/RC 403 FROM IXGBRWSE * 04510000
* $01=OW12221 HBB5520 950221 PDCM: GAPS NOT INDICATED * 04520000
* $02=OW13278 HBB5520 950511 PDCM: NO DELETE IF FULL DIRECTORY * 04530000
* $03=OW14366 HBB5520 950718 PDCM: Issue OPEN before IXGCONN. * 04540000
* Don't abend on empty stream * 04550000
* $04=OW18292 HBB5510 960215 PDHL: Year 2000 Support * 04560000
* $P7=PQC0781 HBB6603 960905 PDCM: Fails w/RC 405 from IXGBRWSE * 04570000
* $P8=PYM0069 HBB7706 010401 PDKP: Fix PUT interfaces * 04580000
* $P9=PYV0223 HBB7707 011210 PDCM: Don't abend IXGBRWSE RC8 RS0804 * 04590000
* $L1=CNZ2A HBB7730 040618 PDD0: 1-Byte Console Id Removal Part2 * 04600000
* $L2=DCRA990 HBB7730 050525 PDKX: Skip MDB if MDB has been sent * 04601000
* from USS * 04602000
* $PA=ME06901 HBB7740 060616 PDKP: Missing issuing console name * 04603000
* $PB=ME07925 HBB7740 060925 PDSS: Correct copyright * 04603100
* $05=OA29939 HBB7770 090930 PDSW: Multi-line WTO message problems * 04603200
* when spanning more than one MDB * 04603300
* $PC=ME16085 HBB7770 090930 PDSW: IEAMDBLG Prolog updates * 04603400
* $PD=ME17166 HBB7770 091015 PDSW: Character translation to convert* 04603500
* unreadable characters to blanks * 04603600
* and DBCS Shifts to either < or >* 04603700
* $06=OA47714 HBB7780 151113 PDHB: MLID formatting confusion. @06A* 04603800
* $TT=W334216 HBB77C0 190731 PDPK: Replaced SYSLOG format by @TTA* 04603918
* DLOG @TTA* 04604000
* * 04604100
****END OF SPECIFICATIONS********************************************** 04605000
* 04606000
* READCOK - (C) Use Local time instead of GMT for comparisons @P1C* 04607000
* Prolog - (c) Clarification of prolog to not use tool to get @P2A* 04608000
* today's output - results in U002 abend. @P2A* 04609000
* CHKMCS - (d) Remove code to address UCM and test for JES3 @P3A* 04610000
* Dsects - (d) Remove mapping macro for UCM @P3A* 04620000
* Initialization - (c) Allow new parm format COPY(),DELETE() @D2A* 04630000
* COPYLOOP - (c) Separate copy operation from delete @D2A* 04640000
* NOTCOPY - (a) Position log browse session and delete records @D2A* 04650000
* FIXDATE - (a) New subroutine for parsing parameters @D2A* 04660000
* CONVSTCK - (a) New subroutine for parsing parameters @D2A* 04670000
* CPRC - (a) Save descriptor codes @P4A* 04680000
* WTLOK - (c) Set RDW for WTL to correct length @P4A* 04690000
* TXTLP - (c) Fix up split point @P4A* 04700000
* TXTDN - (a) Add multiline ID to the text @P4A* 04710000
* PNOTCOPY- (c) Fix length on test for min. length (10) @P5A* 04720000
* BADPMSG - (c) Add LOGRMSGD label to compute msg data length @P5A* 04730000
* OPENOK - (c) Allow for gap in IXGBRWSE START for COPY @P6A* 04740000
* NOTCOPY - (c) Allow for gap in IXGBRWSE START for DELETE @P6A* 04750000
* DPOINTOKL (c) Allow for gap in IXGBRWSE READCURSOR for DELETE @P6A* 04760000
* LOGRMSGT (c) Add footprint to logger service error msg @P6A* 04770000
* IXGxxx macros (c) Test for good completion using IXGRETCODEOK @P6A* 04780000
* OBJLP (a) Handle gaps in records or deleted records @01A* 04790000
* OPENOK (c) Handle delete request when directory full occurs @02A* 04800000
* GAPMSG (a) Bypass issuing message to output file if there is @02A* 04810000
* no output file (possible on DELETE request) @02A* 04820000
* CONNOK (c) Move OPEN of output file before IXGCONN-1. That @03A* 04830000
* way, if any recoverable errors are detected for a @03A* 04840000
* COPY request, they can be written to the output file. @03A* 04850000
* CONNOK (a) If return from IXGBRWSE-1 indicates empty stream, @03A* 04860000
* don't abend. Instead, issue message. @03A* 04870000
* (a) Added support for the new HCFORMAT keyword. The @04A* 04880000
* output records will have a 4-digit year if @04A* 04890000
* HCFORMAT(CENTURY) is specified. The output records @04A* 04900000
* will have a 2-digit year if HCFORMAT(YEAR) is @04A* 04910000
* specified or if the HCFORMAT keyword is not specified @04A* 04920000
* at all. @04A* 04930000
* NOTCOPY Tolerate IXGRsnCodeLossOfData reason code 405 @P7A* 04940000
* PUT macros (c) Change the PUT interfaces to run in 31 bit AMODE @P8A* 04950000
* DELDONE On IXGBRWSE REQUEST=END, accept RC8 RS0804 (No block) @P9A* 04960000
* and do not issue AbendU0002. This condition is @P9A* 04970000
* acceptable by logger as all data is older than the @P9A* 04980000
* specified time stamp. @P9A* 04990000
* NOTINTL4, NOTINTL (D) Remove check for MDBMCSH (sent by QREG 0) @L1A* 05000000
* CPROK,CPROK4,NOTCMD,NOTCMD4 Add request type of U for @L1A* 05010000
* command echo from the unknown console id. @L1A* 05020000
* NOTG (a) Add support for USS Msg Integration to write @L2A* 05030000
* Messages to operlog. @L2A* 05040000
* CPRSP,CPRSP4 (c) Incorrect branch instruction caused blanks to @PAA* 05050000
* go into HCLCONID (issuing console) for a command @PAA* 05060000
* response message for a command issued by an MCS @PAA* 05070000
* console. @PAA* 05080000
* PROCLINE (A) Add an additional check to see if the current @05A* 05081000
* Message Line ID (MLID) is the same as the previous @05A* 05082000
* MLID. If so, then make sure we do not skip over @05A* 05082100
* setting up the type correctly. @05A* 05083000
* PROCLINE (A) Add additional checks to the procedure to help @05A* 05084000
* verify when it is a multiline message with additional @05A* 05084100
* connect lines to make sure the MLID is added to the @05A* 05084200
* end of the major line. @05A* 05084300
* PROLOG (A) Add additional comments to the prolog that will @PCA* 05085000
* describe the how a user can update the sample to @PCA* 05086000
* convert its format from OPERLOG to JES3 DLOG for @PCA* 05087000
* jobnames. @PCA* 05087100
* OBJLP (A) Add comments and code to indicate the field need to @PCA* 05087200
* convert the log stream into a SYSLOG format to @PCA* 05087300
* convert the log stream into a JES3 DLOG jobname @PCA* 05087400
* format. See eye catcher JES3Jobname. @PCA* 05087500
* PROLOG (A) Add additional comments to indicate that IEAMDBLG @PCA* 05088000
* must be setup as NON-REENTRANT (NORENT), otherwise @PCA* 05089000
* 0C4-abend can occur. @PCA* 05089100
* PUTREC (A) Add a translation step to translate unreadable chars @PDA* 05089200
* to blanks and DBCS shift-out and shift-in to < and >. @PDA* 05089300
* PROCLINE (C) Rearranged the check added with OA29939 (@05) to avoid 05089400
* erroneously 'merging' sequential message lines that 05089500
* have the same Message Line ID (MLID) (usually from 05089600
* different systems, possibly from the same). 05089700
* - OA29939 overlooked identical MLIDs from different 05089800
* systems in sequential order. @06A 05089900
* 05090000
*********************************************************************** 05091000
SYSSTATE ARCHLVL=2 Allow macro jumpification @TTA 05095000
IEAMDBL3 CSECT , 05100000
* * 05110000
* * 05130000
IEAMDBL3 AMODE 31 05140000
IEAMDBL3 RMODE 31 @TTC 05150000
MDBLGCOD LOCTR Start code segment @TTA 05152000
MDBLGDAT LOCTR Start data segment @TTA 05154000
DC 0D'0',CL8'MDBLGDAT' Tag the storage @TTA 05156000
MDBLGCOD LOCTR @TTA 05158000
*********************************************************************** 05160000
* begin linkage * 05170000
*********************************************************************** 05180000
BAKR R14,0 Save registers @TTC 05190000
* @TTD 05200000
MODID , Eye catcher and date @TTC 05210000
LARL R12,MDBLGDAT Data segment base @TTA 05212000
USING MDBLGDAT,R12 Set up data addressability @TTA 05214000
L R9,0(R1,0) save parm addr 05220000
* 7#@TTD 05230000
LA R13,SV Point R13 to save area @TTC 05300000
MVC 4(4,R13),=C'F1SA' set acro in save area 05310000
*********************************************************************** 05320000
* end linkage * 05330000
*********************************************************************** 05340000
USING PSA,R0 Set up PSA addressability @TTA 05345000
* 05350000
*********************************************************************** 05360000
* Begin initialization * 05370000
*********************************************************************** 05380000
* 05390000
*********************************************************************** 05400000
* If COPY was specified, get end and start dates or calculate @D2A* 05410000
* defaults, yesterday and "oldest" respectively. @D2A* 05420000
* @D2A* 05430000
* If DELETE was specified, get delete date. @D2A* 05440000
* If HCFORMAT was specified, set the appropriate flag. @04A* 05450000
*********************************************************************** 05460000
* 05470000
* R9 -> parm @D2A 05480000
* 05490000
* Results: 05500000
* PFLAGS -- DELETE flag set if DELETE was specified, @D2A 05510000
* COPY flag set if COPY was specified, @D2A 05520000
* HCFORMAT flag set if HCFORMAT was specified, @04A 05530000
* YEAR flag set if the HCFORMAT keyword was not @04A 05540000
* specified (YEAR is the default), or if @04A 05550000
* HCFORMAT(YEAR) was specified, @04A 05560000
* CENTURY flag set if HCFORMAT(CENTURY) was specified @04A 05570000
* MFLAGS - All flags initialized as off @01A 05580000
* SDATE - If COPY is specified, the specified starting date or @D2C 05590000
* default to 1900001; otherwise zero @D2C 05600000
* EDATE - If COPY is specified, the day after the specified @D2C 05610000
* ending date or default to today;otherwise zero @D2C 05620000
* DDATE - If DELETE is specified, the day after the deletion @D2C 05630000
* date; otherwise zero @D2C 05640000
* SSTCK, ESTCK, and DSTCK are the same dates in STCK format. 05650000
* COPYDAYS - If COPY(>nnn) is specified, the number of days @D2A 05660000
* nnn; otherwise binary zero @D2A 05670000
* DELDAYS - If DELETE(>nnn) is specified, the number of days @D2A 05680000
* nnn; otherwise binary zero @D2A 05690000
* `` 05700000
* @TTD 05710000
MVI PFLAGS,YEAR Set the default flag if the @TTC*05720000
the HCFORMAT keyword is not *05730000
specified (YEAR is the default). *05740000
@04A 05750000
MVI MFLAGS,0 clear out miscellaneous flags @01A 05760000
XC SDATE,SDATE clear out start date 05770000
XC EDATE,EDATE clear out end date 05780000
XC DDATE,DDATE clear out del date 05790000
XC COPYDAYS,COPYDAYS clear out number of days @D2A 05800000
XC DELDAYS,DELDAYS clear out number of days @D2A 05810000
LH R3,0(R9) length of parm @D2A 05820000
LA R9,2(R9) get past length 05830000
CHI R3,0 is there a parm? @TTC 05840000
JE BADPARM no, error (parm is required) @D2A 05850000
CHI R3,256 is it too long (for TRT)? @TTC 05860000
JNH PLENOK no, ok @D2A 05870000
BADPARM LA R2,BADPMSG point to parm error msg 05880000
JAS R14,MESSR display it 05890000
ABEND 1,DUMP abend 05900000
PLENOK DS 0H @D2A 05910000
PLOOP DS 0H @D2A 05920000
* loop through parameter processing each entry @D2A 05930000
* r9 = address of remaining parm @D2A 05940000
* r3 = length of remaining parm @D2A 05950000
LR R14,R9 initial starting point @D2A 05960000
PLOOPR DS 0H @D2A 05970000
* resume the scan @D2A 05980000
* r14 = address of resume point @D2A 05990000
LA R1,0(R3,R9) point past parm (in case there @D2AX06000000
is no comma) @D2A 06010000
LR R15,R1 end of parm + 1 @D2A 06020000
SR R15,R14 subtract start addr to get len @D2A 06030000
BCTR R15,0 subtract 1 to get machine len @D2A 06040000
SR R2,R2 clear reg. for character found @D2A 06050000
EX R15,TRT1 scan the parm; r1 will point to X06060000
comma or lt paren or end+1 of parm X06070000
@D2A 06080000
C R2,ZLPAREN did it stop on left paren? @D2A 06090000
JNE PSCANOK no, ok @D2A 06100000
* scan to right paren @D2A 06110000
LA R15,0(R3,R9) end of parm + 1 @D2A 06120000
SR R15,R1 subtract start addr to get len @D2A 06130000
EX R15,TRT2 scan to right paren @D2A 06140000
JZ BADPARM error if not found @D2A 06150000
LR R14,R1 set resume address @D2A 06160000
J PLOOPR resume the scan @D2A 06170000
PSCANOK DS 0H @D2A 06180000
LR R4,R1 save pointer to comma or end @D2A 06190000
SR R4,R9 length of this parm entry @D2A 06200000
* @D2A 06210000
* interpret and process a parm entry @D2A 06220000
* r9 = address of parm entry @D2A 06230000
* r4 = length of parm entry @D2A 06240000
CHI R4,4 is length at least 4 ("COPY")? @TTC 06250000
JL BADPARM no, error @D2A 06260000
CLC =C'COPY',0(R9) is it COPY? @D2A 06270000
JNE PNOTCOPY no @D2A 06280000
TM PFLAGS,COPY was COPY already processed? @D2A 06290000
JO BADPARM yes,error @D2A 06300000
OI PFLAGS,COPY set COPY flag @D2A 06310000
CHI R4,5 is length 5? @TTC 06320000
JL PNEXT length less than 5, must be 4, X06330000
'COPY', use defaults @D2A 06340000
JE BADPARM length 5, error @D2A 06350000
CLI 4(R9),C'(' does it start with left paren? @D2A 06360000
JNE BADPARM no, error @D2A 06370000
LA R15,0(R4,R9) end of parm + 1 @D2A 06380000
BCTR R15,0 end of parm @D2A 06390000
CLI 0(R15),C')' does it end with right paren? @D2A 06400000
JNE BADPARM no, error @D2A 06410000
CHI R4,6 is it 'COPY()' @TTC 06420000
JE PNEXT yes, use defaults @D2A 06430000
CHI R4,21 are both dates given? @TTC 06440000
JNE PNOTBOTH no, keep checking @D2A 06450000
CLI 12(R9),C',' is there a comma? @D2A 06460000
JNE BADPARM no, error @D2A 06470000
MVC SDATE,5(R9) save start date @D2A 06480000
MVC EDATE,13(R9) save end date @D2A 06490000
J PNEXT look for next entry @D2A 06500000
PNOTBOTH CHI R4,13 is it start all alone? @TTC 06510000
JE PSTART yes, so save it 06520000
CHI R4,14 could it be one date w/comma? @TTC 06530000
JNE PCOPYND no, must be ">nnn" @D2A 06540000
CLI 12(R9),C',' does it end with comma? @D2A 06550000
JE PSTART yes, so it's "start_date," 06560000
CLI 5(R9),C',' does it start with comma? @D2A 06570000
JNE BADPARM no, error 06580000
MVC EDATE,6(R9) save end date @D2A 06590000
J PNEXT look for next entry @D2A 06600000
PSTART MVC SDATE,5(R9) save start date @D2A 06610000
J PNEXT look for next entry @D2A 06620000
PCOPYND DS 0H must be COPY(>nnn) @D2A 06630000
CHI R4,8 is it too short? @TTC 06640000
JL BADPARM yes, error @D2A 06650000
CHI R4,10 is it too long? @TTC 06660000
JH BADPARM yes, error @D2A 06670000
CLI 5(R9),C'>' does it start with >? @D2A 06680000
JNE BADPARM no, error @D2A 06690000
* save number of days, n thru nnn @D2A 06700000
MVC COPYDAYS,=C'000' initialize receiving field @D2A 06710000
LR R14,R4 get length of entry @D2A 06720000
AHI R14,-8 get length of number - 1 @TTC 06730000
LA R15,COPYDAYS+2 end of receiving field @D2A 06740000
SR R15,R14 back up to correct position @D2A 06750000
EX R14,MVCCOPY move in number of days @D2A 06760000
J PNEXT look for next entry @D2A 06770000
PNOTCOPY DS 0H @D2A 06780000
CLC =C'DELETE',0(R9) is it DELETE? @D2A 06790000
JNE CHKFRMT Check if HCFORMAT is specified @04C 06800000
TM PFLAGS,DELETE was DELETE already processed? @D2A 06810000
JO BADPARM yes,error @D2A 06820000
OI PFLAGS,DELETE set DELETE flag @D2A 06830000
CHI R4,10 is length 10 (the minimum)? @TTC 06840000
JL BADPARM error if less than min @D2A 06850000
CLI 6(R9),C'(' does it start with left paren? @D2A 06860000
JNE BADPARM no, error @D2A 06870000
LA R15,0(R4,R9) end of parm + 1 @D2A 06880000
BCTR R15,0 end of parm @D2A 06890000
CLI 0(R15),C')' does it end with right paren? @D2A 06900000
JNE BADPARM no, error @D2A 06910000
CHI R4,15 is it "DELETE(yyyyddd)" @TTC 06920000
JNE PDELND no, must be ">nnn" @D2A 06930000
MVC DDATE,7(R9) save delete date @D2A 06940000
J PNEXT look for next entry @D2A 06950000
PDELND DS 0H must be DELETE(>nnn) @D2A 06960000
* we already checked for minimum length @D2A 06970000
CHI R4,12 is it too long? @TTC 06980000
JH BADPARM yes, error @D2A 06990000
CLI 7(R9),C'>' does it start with >? @D2A 07000000
JNE BADPARM no, error @D2A 07010000
* save number of days, n thru nnn @D2A 07020000
MVC DELDAYS,=C'000' initialize receiving field @D2A 07030000
LR R14,R4 get length of entry @D2A 07040000
AHI R14,-10 get length of number - 1 @TTC 07050000
LA R15,DELDAYS+2 end of receiving field @D2A 07060000
SR R15,R14 back up to correct position @D2A 07070000
EX R14,MVCDEL move in number of days @D2A 07080000
J PNEXT @D2A 07090000
CHKFRMT DS 0H @04A 07100000
CLC =C'HCFORMAT',0(R9) is it HCFORMAT? @04A 07110000
JNE BADPARM no, error @04A 07120000
TM PFLAGS,HCFORMAT was HCFORMAT already processed? @04A 07130000
JO BADPARM yes,error @04A 07140000
OI PFLAGS,HCFORMAT set HCFORMAT flag @04A 07150000
CHI R4,14 is length 14 (the minimum)? @TTC 07160000
JL BADPARM error if less than min @04A 07170000
CLI 8(R9),C'(' does it start with left paren? @04A 07180000
JNE BADPARM no, error @04A 07190000
LA R15,0(R4,R9) end of parm + 1 @04A 07200000
BCTR R15,0 end of parm @04A 07210000
CLI 0(R15),C')' does it end with right paren? @04A 07220000
JNE BADPARM no, error @04A 07230000
CHI R4,14 is it the right length for @TTCX07240000
"HCFORMAT(YEAR)"? @04A 07250000
JNE CHKCENT No, check for "HCFORMAT(CENTURY)" X07260000
@04A 07270000
CLC =C'YEAR',9(R9) is it "HCFORMAT(YEAR)" @04A 07280000
JNE BADPARM no, error @04A 07290000
J PNEXT look for next entry @04A 07300000
CHKCENT DS 0H @04A 07310000
CHI R4,17 is it the right length for @TTCX07320000
"HCFORMAT(CENTURY)"? @04A 07330000
JNE BADPARM no, error @04A 07340000
CLC =C'CENTURY',9(R9) is it "HCFORMAT(CENTURY)" @04A 07350000
JNE BADPARM no, error @04A 07360000
NI PFLAGS,X'FF'-YEAR Reset the default @TTA 07365000
OI PFLAGS,CENTURY Indicate that the output *07370000
should have a 4-digit year @04A 07380000
MDBLGDAT LOCTR @TTC 07390000
TRT1 TRT 0(*-*,R14),TRTTAB1 scan parm for comma or l. paren @D2A 07400000
TRT2 TRT 0(*-*,R1),TRTTAB2 scan parm for r. paren @D2A 07410000
MVCCOPY MVC 0(*-*,R15),6(R9) move in number of days @D2A 07420000
MVCDEL MVC 0(*-*,R15),8(R9) move in number of days @D2A 07430000
MDBLGCOD LOCTR @TTA 07435000
PNEXT DS 0H @D2A 07440000
* get to next parm entry @D2A 07450000
A R4,=F'1' add comma to len of this entry @D2A 07460000
AR R9,R4 point to next entry @D2A 07470000
SR R3,R4 calculate remaining length @D2A 07480000
JP PLOOP loop back until parm is done @D2A 07490000
* 07500000
* see if defaults are needed @TTC 07510000
TIME , get today's date @D2A 07520000
ST 1,DATEWORK copy it 07530000
AP DATEWORK(4),=P'1900000' add to correct the century 07540000
UNPK TDATE,DATEWORK convert and save today's date @D2A 07550000
OI TDATE+6,C'0' fix sign @D2A 07560000
* @D2A 07570000
* check parameters @D2A 07580000
* @D2A 07590000
TM PFLAGS,COPY was copy specified? @D2A 07600000
JNO PVDELETE no, so see if delete @D2A 07610000
* @D2A 07620000
* check for valid copy days @D2A 07630000
* @D2A 07640000
NC COPYDAYS,COPYDAYS was copy days given? @D2A 07650000
JZ PNCOPYD no, so check for dates @D2A 07660000
LA R15,L'COPYDAYS length of copydays field @D2A 07670000
PCOPYDL LA R14,COPYDAYS-1(R15) position within copydays @D2A 07680000
CLI 0(R14),C'0' is character less than 0? @D2A 07690000
JL BADPARM yes, error @D2A 07700000
CLI 0(R14),C'9' is character greater than 9? @D2A 07710000
JH BADPARM yes, error @D2A 07720000
JCT R15,PCOPYDL loop to check all chars @D2A 07730000
PACK DAYSWORK,COPYDAYS convert to decimal @D2A 07740000
PACK DATEWORK,TDATE get today's date @D2A 07750000
SP DATEWORK+2(2),DAYSWORK subtract days from today @D2A 07760000
JAS R14,FIXDATE adjust for the year @D2A 07770000
UNPK EDATE,DATEWORK save it as end date @D2A 07780000
OI EDATE+6,C'0' fix sign @D2A 07790000
MVC SDATE,=C'1900001' set start date to earliest @D2A 07800000
J PVDELETE go see if delete was specified @D2A 07810000
PNCOPYD DS 0H ">nnn" was not specified @D2A 07820000
* 07830000
* see if start date was given, get default if not 07840000
* 07850000
CLC SDATE,=XL7'00' was start date given? 07860000
JE PSTARTDF no, so get default 07870000
LA R9,SDATE point to start date 07880000
JAS R14,CHKDATE see if it is valid 07890000
LTR R15,R15 is date valid? 07900000
JNZ BADPARM error if not 07910000
J PENDCK check end date @D2A 07920000
* 07930000
* get default start date of 1900001 @D2A 07940000
* 07950000
PSTARTDF MVC SDATE,=C'1900001' Get default start date @D2A 07960000
* 07970000
* check for valid end date @D2A 07980000
* @D2A 07990000
PENDCK CLC EDATE,=XL7'00' was end date given? @D2A 08000000
JE PENDDEF no, so get default @D2A 08010000
LA R9,EDATE point to end date @D2A 08020000
JAS R14,CHKDATE see if it is valid @D2A 08030000
LTR R15,R15 is date valid? @D2A 08040000
JNZ BADPARM error if not @D2A 08050000
CLC EDATE,TDATE is it after today? @D2A 08060000
JH BADPARM yes, error @D2A 08070000
* @D2A 08080000
* recalculate end date as the day after the given date @D2A 08090000
* @D2A 08100000
PACK DATEWORK,EDATE convert end date to decimal @D2A 08110000
AP DATEWORK+2(2),=PL1'1' add 1 to day @D2A 08120000
JAS R14,FIXDATE adjust for the year @D2A 08130000
UNPK EDATE,DATEWORK save it as end date @D2A 08140000
OI EDATE+6,C'0' fix sign @D2A 08150000
J PENDOK @D2A 08160000
* @D2A 08170000
* set default end date as today @D2A 08180000
* @D2A 08190000
PENDDEF MVC EDATE,TDATE get today's date @D2A 08200000
PENDOK DS 0H @D2A 08210000
* 08220000
* 08230000
* 08240000
CLC SDATE,EDATE see if start date < end date @D2A 08250000
JNL BADPARM error if not 08260000
* @D2A 08270000
* see if DELETE was specified @D2A 08280000
* @D2A 08290000
PVDELETE DS 0H @D2A 08300000
TM PFLAGS,DELETE was delete specified? @D2A 08310000
JNO PDELOK no, ok @D2A 08320000
* @D2A 08330000
* check for valid delete days @D2A 08340000
* @D2A 08350000
NC DELDAYS,DELDAYS was delete days given? @D2A 08360000
JZ PNDELD no, so check the given date @D2A 08370000
LA R15,L'DELDAYS length of deldays field @D2A 08380000
PDELDL LA R14,DELDAYS-1(R15) position within deldays @D2A 08390000
CLI 0(R14),C'0' is character less than 0? @D2A 08400000
JL BADPARM yes, error @D2A 08410000
CLI 0(R14),C'9' is character greater than 9? @D2A 08420000
JH BADPARM yes, error @D2A 08430000
JCT R15,PDELDL loop to check all chars @D2A 08440000
PACK DAYSWORK,DELDAYS convert to decimal @D2A 08450000
PACK DATEWORK,TDATE get today's date @D2A 08460000
SP DATEWORK+2(2),DAYSWORK subtract days from today @D2A 08470000
JAS R14,FIXDATE adjust for the year @D2A 08480000
UNPK DDATE,DATEWORK save it as delete date @D2A 08490000
OI DDATE+6,C'0' fix sign @D2A 08500000
J PDELOK done with DELETE @D2A 08510000
* @D2A 08520000
* check for valid delete date @D2A 08530000
* @D2A 08540000
PNDELD LA R9,DDATE point to delete date @D2A 08550000
JAS R14,CHKDATE see if it is valid @D2A 08560000
LTR R15,R15 is date valid? @D2A 08570000
JNZ BADPARM error if not @D2A 08580000
* @D2A 08590000
* recalculate delete date as the day after the given date @D2A 08600000
* @D2A 08610000
PACK DATEWORK,DDATE convert delete date to decimal @D2A 08620000
AP DATEWORK+2(2),=PL1'1' add 1 to day @D2A 08630000
JAS R14,FIXDATE adjust for the year @D2A 08640000
UNPK DDATE,DATEWORK save it as delete date @D2A 08650000
OI DDATE+6,C'0' fix sign @D2A 08660000
PDELOK DS 0H @D2A 08670000
* @D2A 08680000
* convert dates to stck format @D2A 08690000
* @D2A 08700000
LA R3,SDATE start date yyyyddd @D2A 08710000
LA R4,SSTCK field for stck form @D2A 08720000
JAS R14,CONVSTCK convert yyyyddd to stck format @D2A 08730000
LA R3,EDATE start date yyyyddd @D2A 08740000
LA R4,ESTCK field for stck form @D2A 08750000
JAS R14,CONVSTCK convert yyyyddd to stck format @D2A 08760000
LA R3,DDATE start date yyyyddd @D2A 08770000
LA R4,DSTCK field for stck form @D2A 08780000
JAS R14,CONVSTCK convert yyyyddd to stck format @D2A 08790000
******************************************************************@TTA* 08791000