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