IBM AS/400 (iSeries)
001. PRG/DBCSフィールド短縮
*****************************************************************
* DBCSフィールド短縮
*
* PARAMETER : P@DBCS (256A ) DBCS FIELD
* : P@LEN ( 3P0) FIELD LENGTH
*
* DBCSフィールドの末尾のX'0F'セット
*
*****************************************************************
E DBCS 256 1 DBCS FIELD
*----------------------------------------------------------------
* < PARAMETER LIST OF ENTRY >
C *ENTRY PLIST
C PARM P@DBCS256 DBCS FIELD
C PARM P@LEN 30 FIELD LENGTH
* < FIELD DEFINITION >
C *NAMVAR DEFN W@POS 30 SI/SO POSITION
C *NAMVAR DEFN X 30
* < INITIALIZE >
C MOVEAP@DBCS DBCS DBCS FIELD
*----------------------------------------------------------------
C 1 DO 256 X
*
C X IFGT P@LEN FIELD LENGTH
C LEAVE
C ENDIF
*
C DBCS,X IFEQ X'0E' SO
C Z-ADDX W@POS SO POSITION
C ENDIF
*
C DBCS,X IFEQ X'0F' SI
C Z-ADD*ZERO W@POS
C ENDIF
*
C ENDDO
*----------------------------------------------------------------
* SIがない
C W@POS IFNE *ZERO
*
C ADD P@LEN W@POS LENGTH + POSITION
C W@POS DIV 2 X
C MVR W@POS
* X = SI挿入位置
C W@POS IFEQ *ZERO
C P@LEN SUB 1 X
C ELSE
C Z-ADDP@LEN X
C ENDIF
* SI挿入
C MOVEAX'0F40' DBCS,X SI
*
C ENDIF
* < FIELD SET >
C MOVEADBCS P@DBCS DBCS FIELD
*----------------------------------------------------------------
C SETON LR
C RETRN
*****************************************************************
|
002. PRG/日付チェック
*****************************************************************
*日付チェック
*
* PARAMETER : P@DATE ( 8P0)対象日付
* : P@GEN ( 1A )元号
* : P@WYY ( 2P0)和暦年
* : P@YOBI ( 5A )曜日
* : P@NISU ( 3P0)通算日数
* : P@WKNO ( 2P0)週番号
* : P@RTCD ( 2A )リターン・コード
*
* P@RTCD :'OK'=エラー無 'NG'=エラー有
*
* グレゴリオ暦に基づく日付チェックを行う。
* グレゴリオ暦開始日は、1582年10月15日。
*
* (1)元号が渡されたとき、和暦を西暦に変換する。
*
* (2)対象日付が4桁の場合
* JOB月の前5ヶ月、後6ヶ月の年。
*
* (3)対象日付が6桁の場合
* JOB年の前49年、後50年の年。
*
* 但し2000年など、年下2桁が00の場合、
* 対象日付を4桁と認識するので注意。
*
* (4)エラーが無いとき元号／和暦年／曜日／通算日数／週番号
* をSETする。
*
* P@YOBI : 1月,2火,3水,4木,5金,6土,7日
* P@NISU : 1/1から対象日付までの日数
* P@WKNO : 1/1を第1週として対象日付の週番号
* : 月 火 水 木 金 土 日
* : 1週 1 2 3 4
* : 2週 5 6 7 8 9 10 11
* : 3週 12 13 14 15 16 17 18
* : 4週 19 20 21 22 23 24 25
* : 5週 26 27 28 29 30 31
*
*****************************************************************
H Y
E ARY 12 12 2 0 月別日数
E GEN 1 4 2 KAI 8 0A改元日
*対象日付 YYYY/MM/DD
I DS
I 1 80W@YYMD
I 1 40W@YYYY
I 5 60W@MM
I 7 80W@DD
*プログラム状況
I SDS
I 199 2000S@YY
*****************************************************************
*メイン・ルーチン
*****************************************************************
*初期設定
C EXSR #INZ
*和暦→西暦
C EXSR #SUB01
*日付4桁→8桁
C EXSR #SUB02
*日付6桁→8桁
C EXSR #SUB03
*閏年チェック
C EXSR #SUB04
*日付チェック
C EXSR #SUB05
*
C P@RTCD IFEQ 'OK' エラー無
*元号／和暦年算出
C EXSR #SUB06
*曜日算出
C EXSR #SUB07
*通算日数／週番号算出
C EXSR #SUB08
*
C ENDIF
*
C SETON LR
C RETRN
*****************************************************************
*和暦→西暦
*****************************************************************
C #SUB01 BEGSR
*明治
C P@GEN IFEQ 'M' 元号
C P@WYY ADD 1867 W@YYYY 西暦
C ENDIF
*大正
C P@GEN IFEQ 'T' 元号
C P@WYY ADD 1911 W@YYYY 西暦
C ENDIF
*昭和
C P@GEN IFEQ 'S' 元号
C P@WYY ADD 1925 W@YYYY 西暦
C ENDIF
*平成
C P@GEN IFEQ 'H' 元号
C P@WYY ADD 1988 W@YYYY 西暦
C ENDIF
*対象日付
C Z-ADDW@YYMD P@DATE
*
C ENDSR
*****************************************************************
*日付4桁→8桁
*****************************************************************
C #SUB02 BEGSR
*日付が4桁のとき処理する
C W@YYYY IFEQ *ZERO
* JOB年
C Z-ADD*YEAR W@YYYY 年4桁
* JOB月(*MONTH)と対象月(W@DD)の差
C *MONTH SUB W@MM W@01
*
C W@01 IFLT -6
C SUB 1 W@YYYY 前年
C ENDIF
*
C W@01 IFGE 6
C ADD 1 W@YYYY 翌年
C ENDIF
*対象日付
C Z-ADDW@YYMD P@DATE
C ENDIF
*
C ENDSR
*****************************************************************
*日付6桁→8桁
*****************************************************************
C #SUB03 BEGSR
*日付が6桁のとき処理する
C W@YYYY IFLT 100
* JOB年の頭2桁
C MOVELS@YY W@YYYY 年4桁
* JOB年(UYEAR)と対象年(W@YYYY)の差
C UYEAR SUB W@YYYY W@01
*
C W@01 IFLT -50
C SUB 100 W@YYYY 前の世紀
C ENDIF
*
C W@01 IFGE 50
C ADD 100 W@YYYY 次の世紀
C ENDIF
*対象日付
C Z-ADDW@YYMD P@DATE
C ENDIF
*
C ENDSR
*****************************************************************
*閏年チェック
*****************************************************************
C #SUB04 BEGSR
*年(W@YYYY)を4,100,400で割る
C W@YYYY DIV 4 W@01 商
C MVR M@004 10 余り4
C W@YYYY DIV 100 W@01
C MVR M@100 30 余り100
C W@YYYY DIV 400 W@01
C MVR M@400 30 余り400
*年＝4の倍数、100の倍数でない･･･閏年
C M@004 IFEQ *ZERO
C M@100 ANDNE*ZERO
C ADD 1 ARY,2 2/29
C ENDIF
*年＝400の倍数･･･閏年
C M@400 IFEQ *ZERO
C ADD 1 ARY,2 2/29
C ENDIF
*
C ENDSR
*****************************************************************
*日付チェック
*****************************************************************
C #SUB05 BEGSR
* 1月～12月が対象
C W@MM IFGE 1
C W@MM ANDLE12
C Z-ADDW@MM X
*日付
C W@DD IFLT 1
C W@DD ORGT ARY,X
C MOVE 'NG' P@RTCD エラー有
C ENDIF
C ELSE
* 1月～12月以外はエラー
C MOVE 'NG' P@RTCD エラー有
C ENDIF
*
C ENDSR
*****************************************************************
*元号／和暦年算出
*****************************************************************
C #SUB06 BEGSR
*
C Z-ADD1 X
C P@DATE LOKUPKAI,X 9090改元日
C *IN90 IFEQ *ON
*元号
C MOVELGEN,X P@GEN
*和暦年
C KAI,X DIV 10000 W@01 改元西暦
C W@YYYY SUB W@01 P@WYY
C ADD 1 P@WYY
*
C ENDIF
*
C ENDSR
*****************************************************************
*曜日算出
*****************************************************************
C #SUB07 BEGSR
* 1月は前年の13月、2月は前年の14月とする
C W@MM IFLE 2
C SUB 1 W@YYYY
C ADD 12 W@MM
C ENDIF
* A=W@YYYY/4
C W@YYYY DIV 4 A 40
* B=W@YYYY/100
C W@YYYY DIV 100 B 40
* C=W@YYYY/400
C W@YYYY DIV 400 C 40
* D=(W@MM*13+8)/5
C W@MM MULT 13 D 40
C ADD 8 D
C DIV 5 D
* A=A-B+C+D+W@YYYY+W@DD
C SUB B A
C ADD C A
C ADD D A
C ADD W@YYYY A
C ADD W@DD A
* W@YOBI=A/7の余り
C A DIV 7 W@01
C MVR W@YOBI 曜日
*
C W@YOBI IFEQ *ZERO
C Z-ADD7 W@YOBI 日曜日
C END
*曜日
C SELEC
C W@YOBI WHEQ 1
C MOVE '1月' P@YOBI 月曜日
C W@YOBI WHEQ 2
C MOVE '2火' P@YOBI 火曜日
C W@YOBI WHEQ 3
C MOVE '3水' P@YOBI 水曜日
C W@YOBI WHEQ 4
C MOVE '4木' P@YOBI 木曜日
C W@YOBI WHEQ 5
C MOVE '5金' P@YOBI 金曜日
C W@YOBI WHEQ 6
C MOVE '6土' P@YOBI 土曜日
C W@YOBI WHEQ 7
C MOVE '7日' P@YOBI 日曜日
C ENDSL
*年(W@YYYY)／月(W@MM)を元に戻す
C W@MM IFGE 13
C ADD 1 W@YYYY
C SUB 12 W@MM
C ENDIF
*
C ENDSR
*****************************************************************
*通算日数／週番号算出
*****************************************************************
C #SUB08 BEGSR
* 1/1から対象日付までの日数を累計する
C Z-ADDW@DD W@01 累計日数
C Z-ADD1 X
C X DOWLTW@MM
C ADD ARY,X W@01
C ADD 1 X
C ENDDO
*通算日数
C Z-ADDW@01 P@NISU 通算日数
*曜日(W@YOBI)をマイナスし、13をプラスする
C SUB W@YOBI W@01
C ADD 13 W@01
*週番号
C W@01 DIV 7 P@WKNO
*
C ENDSR
*****************************************************************
*初期設定
*****************************************************************
C #INZ BEGSR
*パラメーター・リスト
C *ENTRY PLIST
C PARM P@DATE 80 対象日付
C PARM P@GEN 1 元号
C PARM P@WYY 20 和暦年
C PARM P@YOBI 5 曜日
C PARM P@NISU 30 通算日数
C PARM P@WKNO 20 週番号
C PARM P@RTCD 2 リターン・コード
*フィールド定義
C Z-ADD*ZERO W@YOBI 10 曜日
C Z-ADD*ZERO W@01 40 変数
C Z-ADD*ZERO X 20 変数
*初期設定
C Z-ADDP@DATE W@YYMD 対象日付
C MOVE *BLANK P@YOBI 曜日
C Z-ADD*ZERO P@NISU 通算日数
C Z-ADD*ZERO P@WKNO 週番号
C MOVE 'OK' P@RTCD リターン・コード
*
C ENDSR
*****************************************************************
** 月別日数
312831303130313130313031
** 改元日
M 18680908 明治
T 19120730 大正
S 19261225 昭和
H 19890108 平成
|
003. PRG/日付チェック&日数加算
*****************************************************************
*日付チェック&日数加算
*
* PARAMETER : P@DATE ( 8P0)対象日付
* : P@ADD ( 5P0)加算日数
* : P@RTCD ( 2A ) ﾘﾀｰﾝ･ｺｰﾄﾞ
*
* P@RTCD :'OK'= ｴﾗｰ無 'NG'= ｴﾗｰ有
*
* グレゴリオ暦に基づく日付チェックを行う。
* グレゴリオ暦開始日は、1582年10月15日。
*
* (1)対象日付が4桁の場合
* JOB月の前5ヶ月、後6ヶ月の年。
*
* (2)対象日付が6桁の場合
* JOB年の前49年、後50年の年。
*
* 但し2000年など、年下2桁が00の場合、
* 対象日付を4桁と認識するので注意。
*
* (3)エラーが無いとき対象日付に加算日数をﾌﾟﾗｽし、
* 対象日付を書き換える。
*
*****************************************************************
H Y
E ARY 12 12 2 0 月別日数
*対象日付 YYYY/MM/DD
I DS
I 1 80W@YYMD
I 1 40W@YYYY
I 5 60W@MM
I 7 80W@DD
*プログラム状況
I SDS
I 199 2000S@YY
*****************************************************************
*メイン・ルーチン
*****************************************************************
*初期設定
C EXSR #INZ
*日付4桁→8桁
C EXSR #SUB01
*日付6桁→8桁
C EXSR #SUB02
*閏年チェック
C EXSR #SUB03
*日付チェック
C EXSR #SUB04
*
C P@RTCD IFEQ 'OK' ｴﾗｰ無
*日数加算
C EXSR #SUB05
*
C ENDIF
*
C SETON LR
C RETRN
*****************************************************************
*日付4桁→8桁
*****************************************************************
C #SUB01 BEGSR
*日付が4桁のとき処理する
C W@YYYY IFEQ *ZERO
* JOB年
C Z-ADD*YEAR W@YYYY 年4桁
* JOB月(*MONTH)と対象月(W@DD)の差
C *MONTH SUB W@MM W@01
*
C W@01 IFLT -6
C SUB 1 W@YYYY 前年
C ENDIF
*
C W@01 IFGE 6
C ADD 1 W@YYYY 翌年
C ENDIF
*対象日付
C Z-ADDW@YYMD P@DATE
C ENDIF
*
C ENDSR
*****************************************************************
*日付6桁→8桁
*****************************************************************
C #SUB02 BEGSR
*日付が6桁のとき処理する
C W@YYYY IFLT 100
* JOB年の頭2桁
C MOVELS@YY W@YYYY 年4桁
* JOB年(UYEAR)と対象年(W@YYYY)の差
C UYEAR SUB W@YYYY W@01
*
C W@01 IFLT -50
C SUB 100 W@YYYY 前の世紀
C ENDIF
*
C W@01 IFGE 50
C ADD 100 W@YYYY 次の世紀
C ENDIF
*対象日付
C Z-ADDW@YYMD P@DATE
C ENDIF
*
C ENDSR
*****************************************************************
*閏年チェック
*****************************************************************
C #SUB03 BEGSR
*リセット
C Z-ADD28 ARY,2 2/28
*年(W@YYYY)を4,100,400で割る
C W@YYYY DIV 4 X 商
C MVR M@004 10 余り4
C W@YYYY DIV 100 X
C MVR M@100 30 余り100
C W@YYYY DIV 400 X
C MVR M@400 30 余り400
*年＝4の倍数、100の倍数でない･･･閏年
C M@004 IFEQ *ZERO
C M@100 ANDNE*ZERO
C ADD 1 ARY,2 2/29
C ENDIF
*年＝400の倍数･･･閏年
C M@400 IFEQ *ZERO
C ADD 1 ARY,2 2/29
C ENDIF
*
C ENDSR
*****************************************************************
*日付チェック
*****************************************************************
C #SUB04 BEGSR
* 1月～12月が対象
C W@MM IFGE 1
C W@MM ANDLE12
C Z-ADDW@MM X
*日付
C W@DD IFLT 1
C W@DD ORGT ARY,X
C MOVE 'NG' P@RTCD ｴﾗｰ有
C ENDIF
C ELSE
* 1月～12月以外はエラー
C MOVE 'NG' P@RTCD ｴﾗｰ有
C ENDIF
*
C ENDSR
*****************************************************************
*日数加算
*****************************************************************
C #SUB05 BEGSR
*
C Z-ADD*ZERO W@01
*
C P@ADD DOWNEW@01 加算日数
C SELEC
*---------------------------------------------------------------*
*加算日数(P@ADD)がﾌﾟﾗｽのとき
C P@ADD WHGT *ZERO ﾌﾟﾗｽ
C ADD 1 W@01 加算日数
C ADD 1 W@DD 日
C Z-ADDW@MM X 月
C W@DD IFGT ARY,X
C ADD 1 W@MM 月
C Z-ADD1 W@DD 日
C ENDIF
C W@MM IFGT 12
C ADD 1 W@YYYY 年
C Z-ADD1 W@MM 月
C EXSR #SUB03 閏年ﾁｪｯｸ
C ENDIF
*---------------------------------------------------------------*
*加算日数(P@ADD)がﾏｲﾅｽのとき
C P@ADD WHLT *ZERO ﾌﾟﾗｽ
C SUB 1 W@01 加算日数
C SUB 1 W@DD 日
C W@DD IFLE *ZERO
C SUB 1 W@MM 月
C W@MM IFLE *ZERO
C SUB 1 W@YYYY 年
C Z-ADD12 W@MM 月
C EXSR #SUB03 閏年ﾁｪｯｸ
C ENDIF
C Z-ADDW@MM X 月
C Z-ADDARY,X W@DD 日
C ENDIF
*---------------------------------------------------------------*
C ENDSL
C ENDDO
*
C Z-ADDW@YYMD P@DATE 対象日付
*
C ENDSR
*****************************************************************
*初期設定
*****************************************************************
C #INZ BEGSR
*パラメーター・リスト
C *ENTRY PLIST
C PARM P@DATE 80 対象日付
C PARM P@ADD 50 加算日数
C PARM P@RTCD 2 ﾘﾀｰﾝ･ｺｰﾄﾞ
*フィールド定義
C Z-ADD*ZERO W@01 50 変数
C Z-ADD*ZERO X 20 変数
*初期設定
C Z-ADDP@DATE W@YYMD 対象日付
C MOVE 'OK' P@RTCD ﾘﾀｰﾝ･ｺｰﾄﾞ
*
C ENDSR
*****************************************************************
** 月別日数
312831303130313130313031
|