				Wiki
	updated on 2004.06.23

a.21. 2000年問題其の弐拾壱

[ Previous ] [ HOME ] [ Upper ] [ Next ]

日付のセパレータは？

JISの規格やISO規格では、YYYYMMDDのセパレータは-です。つまり、YYYY-MM-DDとなります。年が2桁の場合は、YY/MM/DDですが、年4桁だとハイフンになるようです。ところで、年4桁＋月って、どうなるのだろう？YYYY-MMかYYYY/MMか？よく分からないけど、年4桁はYYYY/MMにした。年月日はYYYY-MM-DDにした。まあ、いいや。ところで、たとえば顧客のとうろく画面だと、名称や住所、そして、電話番号が入りますよね。これがまた、ハイフンで仕切られる。ぱっとみて、電話番号が増えたような錯覚をしてしまった。でも、市外局番が1999や2000なんてないので、すぐ分かるけど、なんか気になる。まあ、いいや。

ＣＬＰのミス多し

CLPの修正で、%SSTや、CVTDAT ... *YYMDなどは、ちゃんとしているのに、DCL文の桁数を修正し忘れているのが多いのに気づきました。まあ、200本近くを、2,3日で修正してしまったので、仕方ないのですが、まずいなあ。でも、どうしよう。フリーカラムなので、DCL文がソースの中に、自由な場所にある。RPGなら、まだなんとかなるのだけどなあ。仕方なく、コンパイルリストを物理ファイルにCPYSPLFして、そのファイルから、桁を定義する部分だけ、ファイルに取りだすことにしました。また、おかしいところを見つけても、どこに有るのか分からなくては、意味がないですよね。なんとかソースメンバーが分かるようにしなくては。できたものは、結構使えました。下がそのソース。こ汚いのはご勘弁を。

PGM

          DCL &SRCTYPE   *CHAR    10
          DCL &CPFMSG    *CHAR   256

          DCL &NBRRCDS   *DEC    (10 0)
          DCL &JOB       *CHAR    10
          DCL &USER      *CHAR    10
          DCL &JOBNBR    *CHAR     6

          DCL &SRCFL     *CHAR    20  'Y2K       TKY2K     'ソースファイル名とライブラリー名。
          DCL &SRCFILE   *CHAR    10
          DCL &SRCLIB    *CHAR    10
          DCL &SRCMBR    *CHAR    10  '*ALL'

          DCL &SIZE      *CHAR     4
          DCL &W1SEQC    *CHAR     3
          DCL &W1SEQ     *DEC     (3 0)

          DCL &USRSPC       *CHAR    20   'MBRLIST   QTEMP     '

          DCL &ERR_BYT      *CHAR     4
          DCL &ERR_AVA      *CHAR     4
          DCL &ERR_ID       *CHAR     7
          DCL &ERR_RSV      *CHAR     1
          DCL &ERR_MSG      *CHAR   100
          DCL &ERRDTA       *CHAR   116

          DCL &HEADER       *CHAR    16
          DCL &MBRLDTA      *CHAR   100

          DCL &LSTCNT       *DEC     (9 0)
          DCL &WRKCNT       *DEC     (9 0)

          DCL &RTVSTRB      *CHAR     4
          DCL &RTVLENB      *CHAR     4

          MONMSG CPF0000

     RTVJOBA JOB(&JOB) USER(&USER) NBR(&JOBNBR)

     CHGVAR &SRCFILE   %SST(&SRCFL    1   10)
     CHGVAR &SRCLIB    %SST(&SRCFL    11  10)

/*--------------------------------------*/
/* CREATE USER SPACE                    */
/*--------------------------------------*/

  CHGVAR %BIN(&SIZE) 1024
      CHKOBJ %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10) *USRSPC
    MONMSG CPF9801 *N +
      CALL QUSCRTUS (&USRSPC 'WRK       ' &SIZE ' ' '*ALL' ' ')

/*--------------------------------------*/
/* MAKE ANE ERROR STRUCTURE             */
/*--------------------------------------*/

  CHGVAR %BIN(&ERR_BYT) 116
  CHGVAR %BIN(&ERR_AVA) 0
  CHGVAR &ERRDTA (&ERR_BYT||&ERR_AVA||&ERR_ID||&ERR_RSV||&ERR_MSG)

/*--------------------------------------*/
/* SPREAD DATA BY API                   */
/*--------------------------------------*/

   CALL QUSLMBR (&USRSPC 'MBRL0100' &SRCFL  &SRCMBR '0' &ERRDTA)

IF (%BIN(&ERRDTA  5  4) *NE 0) DO
      CHGVAR &ERR_BYT  %SST(&ERRDTA  1    4)
      CHGVAR &ERR_ID   %SST(&ERRDTA  9    7)
      CHGVAR &ERR_MSG  %SST(&ERRDTA 17  100)
      SNDPGMMSG  MSGID(&ERR_ID) MSGF(QCPFMSG) +
                                MSGDTA(&ERR_MSG) MSGTYPE(*ESCAPE)
      MONMSG CPF0000
      GOTO \END
ENDDO

/*--------------------------------------*/
/* RETRIEVE HEADER FROM USER SPACE      */
/*--------------------------------------*/

      CHGVAR %BIN(&RTVSTRB) 125
      CHGVAR %BIN(&RTVLENB) 16

      CALL   QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &HEADER)

      CHGVAR &LSTCNT %BIN(&HEADER  9  4)
      IF (&LSTCNT = 0 ) GOTO \END

/*--------------------------------------*/
/* PREPARATION OF RETRIEVE LIST DATA    */
/*--------------------------------------*/

      CHGVAR &WRKCNT         0
      CHGVAR %BIN(&RTVSTRB) (%BIN(&HEADER  1  4) + 1)
      CHGVAR &RTVLENB        %SST(&HEADER 13  4)

/*--------------------------------------*/
/* RETRIEVE LIST DATA FORM USER SPACE   */
/*--------------------------------------*/

 \RTVMBRL:

     CHGVAR &WRKCNT  (&WRKCNT + 1)
     CALL   QUSRTVUS (&USRSPC &RTVSTRB &RTVLENB &MBRLDTA)

/*--------------------------------------*/
/* RETRIEVE MBRNAME LIST                */
/*--------------------------------------*/

     CHGVAR &SRCMBR  %SST(&MBRLDTA  1 10)

     CHKOBJ &SRCLIB/&SRCFILE *FILE  MBR(&SRCMBR)
     MONMSG CPF9800 *N GOTO \NEXTENTRY

     RTVMBRD &SRCLIB/&SRCFILE MBR(&SRCMBR) SRCTYPE(&SRCTYPE)

IF (&SRCTYPE *EQ 'CLP    ') DO

     CRTCLPGM &SRCMBR &SRCLIB/&SRCFILE OPTION(*NOGEN)

             CLRPFM IPLTEMP/CHKCLPGM1
             CLRPFM IPLTEMP/CHKCLPGM2

             CPYSPLF    FILE(&SRCMBR) TOFILE(IPLTEMP/CHKCLPGM1) +
                          JOB(&JOBNBR/&USER/&JOB) SPLNBR(*LAST)

             DLTSPLF    FILE(&SRCMBR) JOB(&JOBNBR/&USER/&JOB) +
                          SPLNBR(*LAST)

             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          NBRRCDS(2) FMTOPT(*NOCHK)

             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*CHAR              2')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*CHAR              4')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*CHAR              6')

             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*DEC               2')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*DEC               4')
             CPYF       FROMFILE(IPLTEMP/CHKCLPGM1) FMTOPT(*NOCHK) +
                          TOFILE(IPLTEMP/CHKCLPGM2) MBROPT(*ADD) +
                          INCCHAR(*RCD 32 *EQ '*DEC               6')

     RTVMBRD    FILE(IPLTEMP/CHKCLPGM2) NBRCURRCD(&NBRRCDS)

     IF (&NBRRCDS > 2) DO
        CPYF IPLTEMP/CHKCLPGM2 IPLTEMP/CHKCLPGM3 MBROPT(*ADD) +
        FMTOPT(*NOCHK)
     ENDDO

ENDDO

\NEXTENTRY:

/*--------------------------------------*/
/* PREPARATION FOR NEXT LIST ITME       */
/*--------------------------------------*/

 IF (&LSTCNT = &WRKCNT) GOTO \END

   CHGVAR %BIN(&RTVSTRB) (%BIN(&RTVSTRB) + %BIN(&RTVLENB))
   GOTO \RTVMBRL

ERR:

/* |~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~| */
/* |                      MESSGAE  HANDLING                        | */
/* |_______________________________________________________________| */

 END_MSG:    RCVMSG     MSG(&CPFMSG)
                   MONMSG CPF0000 *N GOTO \END
             IF (&CPFMSG=' ') GOTO \END
             SNDPGMMSG  MSG(&CPFMSG)
                   MONMSG CPF0000 *N GOTO \END

             GOTO END_MSG

\END:

     IF (%SST(&USRSPC 11 10)='QTEMP') DO
         DLTUSRSPC %SST(&USRSPC 11 10)/%SST(&USRSPC 1 10)
     ENDDO

RETURN
ENDPGM

ひえー、結構長いなー。すみません。ファイルは、予め、IPLTEMP（任意）に、CHKCLPGM1やCHKCLPGM2やCHKCLPGM3をレコード長200、IGCDTA(*YES)で作成しておきます。ここには、コンパイルリストの1行目と2行目がはいって、さらに、*CHAR,*DECの2桁、4桁、6桁のフィールドの名前が入ります。すると、だいたい、フィールド名から、内容が分かり、あらら、というものに気づくわけです。最終的には、CHKCLPGM3に入っています。また、画面のフィールド名と桁数もでるし、DCLしたけど、使われていないフィールドは、使用行がブランクなので、すぐに気づきます。便利でした。実行に時間がかかりますので、バッチでお願いします。

便利なCMPPFMコマンド

以前紹介した、CMPPFMは活躍しています。実は、AIDをデータエリアにしていたのですが、（システム38から）、RPGの固定情報に修正する作業で、機械的に、追加と削除をしているときに、データエリアのDEFN文を消しているところで、間違って、KFLDを消していることを修正中に、気づきました。「どーしよう」。そこで、CMPPFMの出番です。前日のバックアップから、旧イメージのソースを取り出し、それと比較しながら、変更のみをスプールしました。削除は、スプールの右の方にD-と出ていますので、このスプールをCPYSPLFで物理ファイルに移してから、D-の行だけを、ファイルにコピーしました。ここで見つけた行を、再びスプール検索で探し、ソースメンバー名を特定して、修正出来ました。2個もありました。KFLDの最後の方なので、コンパイルは通ってしまうので、やっかいなものだったのです。よかった。でも、XをYに変えると、Xは削除（D-）、Yは挿入（I-）となって、ここでも、D-が出てくることに注意してください。どうせなら、B-（Before change:変更前）、A-（After change:変更後）にして欲しかったな。尚、メンバー名は*ALLが使えますので、ソースファイル単位にメンバーそっくり全部比較出来ます。（メンバー名が一致するもののみ）。

~~これに比べると、MRGSRCは、なんか余り気に入らないなぁ。~~とんでもない、間違いでした。結構便利です！

長くつらい日々

一日16個くらいテストをして、9月末には、現在のシステム年でテスト完了して、さらに10月から、2000年のシステム値でテストをする予定です。もう、疲れ切っています。バックレようかなぁ。

1998/08/14

続く...