2000-10-04 如何於 RPG 或 RPGIV 中處理讀取檔案資料時所產生 的數字欄位, 是 Packed type 的數字錯誤(Decimal error)？

□ Tips : 如何於 ＲＰＧ 或ＲＰＧＩＶ中處理讀取檔案資料時所產生 的數字欄位
                是 Packed type 的數字錯誤(Decimal error)？


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
1. ＲＰＧ 程式以  CRTRPGPGM PGM(XXXX)... IGNDECERR(*YES) Compiled 
   執行程式時若遇到讀取檔案資料時 數字錯誤，系統會自動以以零取代錯誤值，程式不
   會被中斷。

2. ＲＰＧＩＶ程式於 H - Spec 中加入 FixNbr( *Zoned : *InputPacked )  參數，
   FixNbr( *Zoned )==> 系統會自動以以零取代錯誤值，程式不會被中斷。

   FixNbr(*InputPacked)==> 系統會自動以以零取代錯誤值，程式會被中斷，並有錯
                              誤訊息 MCH1202 產生於 Joblog 。

   FixNbr( *Zoned : *InputPacked )系統會自動以以零取代錯誤值，程式會被中斷，並
                              有錯誤訊息 MCH1202 產生於 Joblog 。

3. 使用 CPYF 命令，定義一與原檔案相同新的ＤＤＳ，但更改 packed 數字欄位
   為 zoned 數字欄位，並建立一新的空檔案。下 Command :

   CPYF  FROMFILE(old-packed file)  TOFILE(new-zoned file)  FMTOPT(*MAP) ERRLVL(*NOMAX)
   CPYF  FROMFILE(new-zoned file)  TOFILE(old-packed file)  FMTOPT(*MAP) MBROPT(*REPLACE)

   使用這個方法，你可以修復任何你想要的數值，不只是 0 而已，包含於 DDS 中 DFT 
   關鍵字所設定的任何數值。

4. 使用下列程式，其中pack1，pack2，pack30 是檔案中 packed 數字欄位名稱，
   請修改成你自己檔案名稱及檔案中的數字欄位名稱
      

     Ffile      uf   f   22        disk

     D ds            e ds                  extname(file)

     D fixPacked       pr
     D addr                            *   value
     D len                           10i 0 value
     D changed                        1a

     D doUpdate        s              1a   inz('0')
     C                   read      file          ds                     lrlr
     C                   dow       not *inlr
     C                   callp     fixPacked(%addr(pack1)
     C                             : %size(pack1)
     C                             : doUpdate)
     C                   callp     fixPacked(%addr(pack2)
     C                             : %size(pack2)
     C                             : doUpdate)
     C                   callp     fixPacked(%addr(pack30)
     C                             : %size(pack30)
     C                             : doUpdate)
     C                   if        doUpdate = '1'
     C                   update    file          ds
     C                   endif
     C                   read      file          ds                     lrlr
     C                   enddo

     P fixPacked       b
     D fixPacked       pi
     D addr                            *   value
     D len                           10i 0 value
     D changed                        1a
     D inputVal        s             16a   based(addr)
      * Valid values for a byte of a packed field except the final byte
     D okFirst         C                   x'-
     D                                     00010203040506070809-
     D                                     10111213141516171819-
     D                                     20212223242526272829-
     D                                     30313233343536373839-
     D                                     40414243444546474849-
     D                                     50515253545556575859-
     D                                     60616263646566676869-
     D                                     70717273747576777879-
     D                                     80818283848586878889-
     D                                     90919293949596979899-
     D                                     '
     D* Valid values for the final byte of packed field
     D okLast          c                   x'-
     D                                     0a1a2a3a4a5a6a7a9a9a-
     D                                     0b1b2b3b4b5b6b7b9b9b-
     D                                     0c1c2c3c4c5c6c7c9c9c-
     D                                     0d1d2d3d4d5d6d7d9d9d-
     D                                     0e1e2e3e4e5e6e7e9e9e-
     D                                     0f1f2f3f4f5f6f7f9f9f-
     D                                     '
     D* Area for checking the first len-1 bytes of the packed field
     D checkFirst      s             16a
     D lastByte        s              1a
      * Check the first n-1 bytes
     C                   if        len > 1
     C                   eval      checkFirst = okFirst
     C                   eval      %subst(checkFirst : 1 : len - 1) =
     C                             %subst(inputVal : 1 : len - 1)
     C     okFirst       check     checkFirst                             10
     C   10              exsr      bad
     C                   endif
	     * Check the last byte
     C                   eval      lastByte = %subst(inputVal : len : 1)
     C     okLast        check     lastByte                               10
     C   10              exsr      bad
     C                   return
      * Subroutine to put a packed zero in the parameter
     C     bad           begsr
     C                   eval      %subst(inputVal : 1 : len) = *allx'00'
     C                   eval      %subst(inputVal : len : 1) = x'0f'
     C                   eval      changed = '1'
     C                   return
     C                   endsr
     P fixPacked       e