指定日付に加減した日付を計算します。
<< CLP CALDATEC >>
|
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 |
PGM PARM(&DAYS &TOVAR &DATE &TOVARFMT &DATEFMT + &TOVAR2) DCL VAR(&DAYS) TYPE(*DEC) LEN(5 0) DCL VAR(&TOVAR) TYPE(*CHAR) LEN(6) DCL VAR(&TOVAR2) TYPE(*CHAR) LEN(10) DCL VAR(&DATE) TYPE(*DEC) LEN(6 0) DCL VAR(&TOVARFMT) TYPE(*CHAR) LEN(7) DCL VAR(&DATEFMT) TYPE(*CHAR) LEN(7) DCL VAR(&WRKDAT) TYPE(*CHAR) LEN(6) DCL VAR(&WRKDAT2) TYPE(*CHAR) LEN(10) DCL VAR(&WRKDAT5) TYPE(*CHAR) LEN(5) DCL VAR(&JULIANA) TYPE(*CHAR) LEN(5) DCL VAR(&YRD) TYPE(*DEC) LEN(2 0) DCL VAR(&DAYSD) TYPE(*DEC) LEN(3 0) DCL VAR(&LEAP) TYPE(*DEC) LEN(2 0) DCL VAR(&DAYSINYEAR) TYPE(*DEC) LEN(3 0) DCL VAR(&NUM5) TYPE(*DEC) LEN(5) DCL VAR(&NUM2) TYPE(*DEC) LEN(2) DCL VAR(&NOTOVAR) TYPE(*CHAR) LEN(1) DCL VAR(&NOTOVAR2) TYPE(*CHAR) LEN(1) DCL VAR(&ERRORSW) TYPE(*LGL) DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) DCL VAR(&MSG) TYPE(*CHAR) LEN(512) DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(512) DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4) DCL VAR(&KEYVAR2) TYPE(*CHAR) LEN(4) DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2) IF COND((&TOVARFMT *EQ '*MDYY') *OR (&TOVARFMT + *EQ '*DMYY') *OR (&TOVARFMT *EQ '*YYMD') *OR + (&TOVARFMT *EQ '*ISO') *OR (&TOVARFMT *EQ + '*USA') *OR (&TOVARFMT *EQ '*EUR') *OR + (&TOVARFMT *EQ '*CYMD') *OR (&TOVARFMT *EQ + '*JIS')) THEN(DO) CHGVAR VAR(&TOVAR2) VALUE(' ') MONMSG MSGID(MCH3601) EXEC(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('IF ONE + OF THE NEW DATE FORMATS IS USED FOR TOVARFMT, + YOU CANNOT USE A RETURN VARIABLE FOR TOVAR. + YOU MUST USE A RETURN VARIABLE FOR TOVAR2') + MSGTYPE(*ESCAPE) ENDDO ENDDO CHGVAR VAR(&TOVAR) VALUE(' ') MONMSG MSGID(MCH3601) EXEC(CHGVAR VAR(&NOTOVAR) + VALUE('X')) CHGVAR VAR(&TOVAR2) VALUE(' ') MONMSG MSGID(MCH3601) EXEC(CHGVAR VAR(&NOTOVAR2) + VALUE('X')) IF ((&NOTOVAR *EQ 'X') *AND (&NOTOVAR2 *EQ + 'X')) THEN(DO) SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('YOU MUST + SPECIFY A RETURN VARIABLE FOR EITHER TOVAR OR + TOVAR2') MSGTYPE(*ESCAPE) ENDDO IF (&DATE *EQ 0) THEN(DO) RTVSYSVAL SYSVAL(QDATE) RTNVAR(&WRKDAT) GOTO CVTDAT ENDDO IF COND(&DATE *EQ -1) THEN(DO) RTVJOBA DATE(&WRKDAT) GOTO CVTDAT ENDDO CHGVAR VAR(&WRKDAT) VALUE(&DATE) IF (&DATEFMT *NE '*JUL') THEN(DO) CVTDAT: CVTDAT DATE(&WRKDAT) TOVAR(&JULIANA) + FROMFMT(&DATEFMT) TOFMT(*JUL) TOSEP(*NONE) MONMSG MSGID(CPF0555) EXEC(SNDPGMMSG MSGID(CPF9898) + MSGF(QCPFMSG) MSGDTA('DATE PARAMETER VALUE + CANNOT BE CONVERTED') MSGTYPE(*ESCAPE)) ENDDO IF (&DATEFMT *EQ '*JUL') THEN(DO) CHGVAR VAR(&WRKDAT5) VALUE(%SST(&WRKDAT 2 5)) CVTDAT DATE(&WRKDAT5) TOVAR(&JULIANA) + FROMFMT(&DATEFMT) TOFMT(*JUL) TOSEP(*NONE) MONMSG MSGID(CPF0555) EXEC(SNDPGMMSG MSGID(CPF9898) + MSGF(QCPFMSG) MSGDTA('DATE PARAMETER VALUE + CANNOT BE CONVERTED') MSGTYPE(*ESCAPE)) ENDDO CHGVAR VAR(&YRD) VALUE(%SST(&JULIANA 1 2)) CHGVAR VAR(&DAYSD) VALUE(%SST(&JULIANA 3 3)) CHGVAR VAR(&NUM5) VALUE(&DAYSD + &DAYS) CHKPLUS: IF (&NUM5 *GT 0) THEN(GOTO CMDLBL(CHKLEAP)) IF (&YRD *EQ 00) THEN(CHGVAR VAR(&YRD) + VALUE(99)) ELSE (CHGVAR VAR(&YRD) VALUE(&YRD -1)) CHKLEAP: CHGVAR VAR(&NUM2) VALUE(&YRD / 4) CHGVAR VAR(&LEAP) VALUE(&YRD - (&NUM2 * 4)) IF (&LEAP *GT 0) THEN(CHGVAR + VAR(&DAYSINYEAR) VALUE(365)) ELSE (CHGVAR VAR(&DAYSINYEAR) VALUE(366)) IF (&NUM5 *LE 0) THEN(DO) CHGVAR VAR(&NUM5) VALUE(&NUM5 + &DAYSINYEAR) GOTO CHKPLUS ENDDO IF (&NUM5 *GT &DAYSINYEAR) THEN(DO) IF (&YRD *EQ 99) THEN(CHGVAR VAR(&YRD) + VALUE(-1)) CHGVAR VAR(&YRD) VALUE(&YRD + 1) CHGVAR VAR(&NUM5) VALUE(&NUM5 - &DAYSINYEAR) GOTO (CHKLEAP) ENDDO CHGVAR VAR(&DAYSD) VALUE(&NUM5) CHGVAR VAR(%SST(&JULIANA 1 2)) VALUE(&YRD) CHGVAR VAR(%SST(&JULIANA 3 3)) VALUE(&DAYSD) CVTDAT DATE(&JULIANA) TOVAR(&WRKDAT2) FROMFMT(*JUL) + TOFMT(&TOVARFMT) TOSEP(*NONE) IF (%SST(&WRKDAT2 7 4) *EQ ' ') THEN(DO) CHGVAR VAR(&TOVAR) VALUE(&WRKDAT2) MONMSG MSGID(MCH3601) ENDDO CHGVAR VAR(&TOVAR2) VALUE(&WRKDAT2) MONMSG MSGID(MCH3601) RMVMSG CLEAR(*ALL) RETURN ENDPGM |
|
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 |
CRTCMD CMD(xxxxx/CALDATE) PGM(xxxxx/CALDATEC) ALLOW(*BPGM *IPGM) CMD PROMPT('日付の計算') PARM KWD(DAYS) TYPE(*DEC) LEN(5) RANGE(-35000 + 35000) MIN(1) PROMPT('日数 + (5 0)') PARM KWD(TOVAR) TYPE(*CHAR) LEN(6) RTNVAL(*YES) + PROMPT('新日付の変数 (6)') PARM KWD(DATE) TYPE(*DEC) LEN(6 0) DFT(*TODAY) + RANGE(000000 999999) + SPCVAL((*TODAY 0)(*JOB -1)) + PROMPT('旧日付 (6 0)') PARM KWD(TOVARFMT) TYPE(*CHAR) LEN(7) + DFT(*JOB) RSTD(*YES) + VALUES('*SYSVAL' '*MDY' '*DMY' '*YMD' + '*JUL' '*JOB' '*CYMD' '*MDYY' '*DMYY' + '*YYMD' '*ISO' '*USA' '*EUR' '*JIS') + PROMPT('新日付の形式') PARM KWD(DATEFMT) TYPE(*CHAR) LEN(7) + DFT(*JOB) RSTD(*YES) + VALUES('*SYSVAL' '*MDY' '*DMY' '*YMD' + '*JUL' '*JOB') + PROMPT('旧日付の形式') PARM KWD(TOVAR2) TYPE(*CHAR) LEN(10) RTNVAL(*YES) + PROMPT('新日付の変数２ (10)') |