*AINDMS1CV01 -- DATE CONVERSION, MO-DA-YR TO BYRDAY 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *TITLE S1CV01 -- DATE CONVERSION, MO-DA-YR TO BYRDAY 00020000 *A AUTHOR HANS HOOGSTRAAT 00030000 *A DESIGNER HANS HOOGSTRAAT 00040000 *A LANGUAGE S/360 ASSEMBLER 00050000 *A WRITTEN UNKNOWN 00060000 * ABSTRACT 1-8-76 FAC 00070000 * REVISED 10/20/85 REM. DELETE ASSEMBLER TITLE CARD TO AVOID ERR. 00080000 * REVISED 03/02/88 WAB. ADDED LEAP YEAR CODE THROUGH 2012 00090010 *A 00100000 *A 00110000 *A CALL S1CV01 (HDATE, CDATE) 00120000 *A INPUT HDATE = DATE FOR PEOPLE, MO-DA-YR. 8 BYTES 00130000 *A OUTPUT CDATE = DATE FOR S/370, BYRDAY. 6 BYTES 00140000 *A B = BLANK. 00150000 *A 00160000 *A 00170000 *A BLANKS IN HDATE ARE INTERPRETED AS ZEROS. 00180000 *A THE SEPARATION CHARACTER IN HDATE IS NOT SIGNIFICANT. 00190000 *A 00200000 *A EXAMPLES: 01-08-76 BECOMES B76008 00210000 *A B1-B8-76 BECOMES B76008 00220000 *A B1BB8B76 BECOMES B76008 00230000 *A 01/08/76 BECOMES B76008 00240000 *A 00250000 *AEND 00260000 *TITLE S1CV02 -- DATE CONVERSION, BYRDAY TO MO/DA/YR 00270000 *A AUTHOR HANS HOOGSTRAAT 00280000 *A DESIGNER HANS HOOGSTRAAT 00290000 *A LANGUAGE S/360 ASSEMBLER 00300000 *A WRITTEN UNKNOWN 00310000 * ABSTRACT 1-8-76 FAC 00320000 *A 00330000 *A 00340000 *A CALL S1CV02 (CDATE, HDATE) 00350000 *A INPUT CDATE = DATE FOR S/370, BYRDAY. 6 BYTES 00360000 *A B = BLANK. 00370000 *A OUTPUT HDATE = DATE FOR PEOPLE, MO/DA/YR. 8 BYTES 00380000 *A 00390000 *A 00400000 *A BLANKS IN CDATE ARE INTERPRETED AS ZEROS. 00410000 *A LEADING ZEROS ARE USED IN HDATE. 00420000 *A 00430000 *A EXAMPLES: B76008 BECOMES 01/08/76 00440000 *A B76BB8 BECOMES 01/08/76 00450000 *A 00460000 *AEND 00470000 * 00480000 S1CV01 CSECT 00490000 ENTRY S1CV02 00500000 COPY S1REG 00510000 * 00520000 BASE EQU R9 00530000 * 00540000 DD EQU 3 00550000 MM EQU 0 00560000 * 00570000 STM R14,R12,12(R13) 00580000 * 00590000 BALR BASE,0 00600000 USING *,BASE 00610000 * 00620000 L R5,0(R1) ADDRESS OF MM/DD/YY 00630000 L R6,4(R1) ADDRESS OF BYYDDD 00640000 * CHECK FOR LEAP YEAR AND SET THE LEAP YEAR FLAG 00650001 LA 7,6(R5) POINT TO YY IN MM/DD/YY 00660001 LA 8,YEARS POINT TO LEAP YEAR TABLE 00670002 LA 10,0 COUNTER REGISTER 00680006 LA 11,10 LOOP LIMIT 00690003 MVC LFLAG,=C'N' 00700008 DOLOOP CLC 0(2,7),0(8) 00710002 BE LEAP 00720002 A 8,=F'2' 00730005 A 10,=F'2' 00740006 CR 10,11 00750006 BL DOLOOP 00760003 B DONE 00770002 LEAP MVC LFLAG,=C'Y' 00780003 * 00790000 DONE IC R3,MM(R5) GET MM FROM MM/DD/YY 00800002 N R3,=F'15' AND CONVERT IT TO (MM-1) DAYS 00810000 M R2,=F'10' 00820000 LR R2,R3 00830000 IC R3,MM+1(R5) 00840000 N R3,=F'15' 00850000 AR R2,R3 00860000 SLL R2,1 00870000 CLC LFLAG,=C'Y' 00880003 BE M1 00890002 LH R4,MONTH-2(R2) 00900000 B M11 00910002 M1 LH R4,LMONTH-2(R2) 00920002 * 00930000 M11 IC R3,DD(R5) ADD DD FROM MM/DD/YY TO IT 00940002 N R3,=F'15' 00950000 M R2,=F'10' 00960000 AR R4,R3 00970000 IC R3,DD+1(R5) 00980000 N R3,=F'15' 00990000 AR R4,R3 01000000 LR R3,R4 01010000 LA R2,0 R2/R3 = BIN OF DD/MM 01020000 * 01030000 MVI 0(R6),C' ' MOVE BLANK INTO BYYDDD 01040000 MVC 1(2,R6),6(R5) MOVE YY INTO BYYDDD 01050000 * 01060000 D R2,=F'10' SET DDD INTO BYYDDD 01070000 O R2,=X'000000F0' 01080000 STC R2,5(R6) 01090000 LA R2,0 01100000 D R2,=F'10' 01110000 O R2,=X'000000F0' 01120000 STC R2,4(R6) 01130000 O R3,=X'000000F0' 01140000 STC R3,3(R6) 01150000 * 01160000 RETURN LM R14,R12,12(R13) 01170000 BR R14 01180000 * 01190000 S1CV02 STM R14,R12,12(R13) 01200000 BALR BASE,0 01210000 LA R3,S1CV02-S1CV01 01220000 SR BASE,R3 01230000 * 01240000 L R5,4(R1) ADDRESS OF MM/DD/YY 01250000 L R6,0(R1) ADDRESS OF BYYDDD 01260000 * 01270007 * CHECK FOR LEAP YEAR AND SET THE LEAP YEAR FLAG 01280007 LA 7,1(R6) POINT TO YY BYYDDD 01290008 LA 8,YEARS POINT TO LEAP YEAR TABLE 01300007 LA 10,0 COUNTER REGISTER 01310007 LA 11,10 LOOP LIMIT 01320007 MVC LFLAG,=C'N' SET TO NOT LEAP YEAR 01330008 DOLOOP1 CLC 0(2,7),0(8) 01340007 BE LEAP1 01350007 A 8,=F'2' 01360007 A 10,=F'2' 01370007 CR 10,11 01380007 BL DOLOOP1 01390007 B DONE1 01400007 LEAP1 MVC LFLAG,=C'Y' 01410007 * 01420000 DONE1 IC R3,3(R6) GET BIN OF DDD 01430007 N R3,=F'15' 01440000 M R2,=F'10' 01450000 IC R2,4(R6) 01460000 N R2,=F'15' 01470000 AR R3,R2 01480000 M R2,=F'10' 01490000 IC R2,5(R6) 01500000 N R2,=F'15' 01510000 AR R3,R2 01520000 * 01530000 LA R4,2 SEARCH FOR MONTH 01540000 CLC LFLAG,=C'Y' 01550007 BE M2 01560007 CH R3,MONTH(R4) 01570000 B M21 01580007 M2 CH R3,LMONTH(R4) 01590007 * 01600007 M21 BNH *+12 01610007 LA R4,2(R4) 01620000 B *-12 01630000 CLC LFLAG,=C'Y' 01640007 BE M3 01650007 SH R3,MONTH-2(R4) R3 = BIN OF DD 01660000 B M31 01670007 M3 SH R3,LMONTH-2(R4) R3 = BIN OF DD 01680007 * 01690007 M31 SRL R4,1 R4 = BIN OF MM 01700007 * 01710000 LA R2,0 SET DD INTO MM/DD/YY 01720000 D R2,=F'10' 01730000 O R2,=X'000000F0' 01740000 O R3,=X'000000F0' 01750000 STC R3,DD(R5) 01760000 STC R2,DD+1(R5) 01770000 * 01780000 LR R3,R4 SET MM INTO MM/DD/YY 01790000 LA R2,0 01800000 D R2,=F'10' 01810000 O R2,=X'000000F0' 01820000 O R3,=X'000000F0' 01830000 STC R3,MM(R5) 01840000 STC R2,MM+1(R5) 01850000 * 01860000 MVC 6(2,R5),1(R6) MOVE YY INTO DD/MM/YY 01870000 * 01880000 MVI 2(R5),C'/' SET SLASHES 01890000 MVI 5(R5),C'/' 01900000 B RETURN 01910000 * 01920000 MONTH DC H'0,31,59,90,120,151,181,212,243,273,304,334,365,999' 01930000 LMONTH DC H'0,31,60,91,121,152,182,213,244,274,305,335,366,999' 01940002 YEARS DC C'72' 01950009 DC C'76' 01960001 DC C'80' 01970001 DC C'84' 01980001 DC C'88' 01990001 DC C'92' 02000001 DC C'96' 02010001 DC C'04' 02020001 DC C'08' 02030001 DC C'12' 02040001 LFLAG DC C'N' 02050004 LTORG 02060000 END 02070000