H Y/
H*****************************************************************
H** TEXT : 年月日チェック **
E*****************************************************************
E* ＡＲＲＡＹ／ＴＡＢＬＥ **
E*****************************************************************
E**日付チェックテーブル
E TABA 12 12 2 0 TABB 2 0
I*****************************************************************
I* ＤＡＴＡ ＳＴＲＵＣＴＵＲＥ **
I*****************************************************************
I*日付編集用
I DS
I 1 80DSYMD
I 1 40DSYY
I 5 60DSMM
I 7 80DSDD
C****************************************************************
C* パラメータ・リスト *
C****************************************************************
C *ENTRY PLIST
C PARM 8 日付
C PARM 3 リターンＣＤ
C**=============================================================**
C* ＭＡＩＮ ＲＯＵＴＩＮＥ
C**=============================================================**
C*
C IFLE '00000000'
C*月指定エラー
C MOVEL'ER3' リターンＣＤ
C*
C SETON LR
C RETRN
C END
C*
C MOVEL*BLANK リタンＣＤ
C DSYMD 日付
C*ワークフイールド
C Z-ADD*ZERO WKMVR 30 閏年チェック
C*月末日を求める
C DSMM LOKUPTABA TABB 90
C *IN90 IFEQ '1'
C* 閏年の計算
C DSMM IFEQ 2 ２月
C DSYY DIV 4 WKMVR
C MVR WKMVR
C WKMVR IFEQ 0
C*
C DSYY DIV 100 WKMVR
C MVR WKMVR
C WKMVR IFEQ 0
C*
C DSYY DIV 400 WKMVR
C MVR WKMVR
C WKMVR IFEQ 0
C ADD 1 TABB 閏年
C ENDIF
C ELSE
C ADD 1 TABB 閏年
C ENDIF
C ENDIF
C ENDIF
C*日にちチェック（０１～月末日）
C DSDD IFGT *ZERO
C DSDD ANDLETABB
C MOVEL*BLANK リターンＣＤ
C ELSE
C MOVEL'ER1' リターンＣＤ
C END
C ELSE
C*月指定エラー
C MOVEL'ER2' リターンＣＤ
C END
C*
C SETON LR
C RETRN
C**=============================================================**
** TABA-TABB月末日
013102280331043005310630073108310930103111301231
阅读(1653) | 评论(0) | 转发(2) |
