如何從一文字(DDS A type)欄位擷取 Packed (DDS P type)形態的數字？
有時候您的資料若是從其他較舊的系統如 S/36 或是從 IBM mainframe 上取得，
有可能某些欄位定義是文字格式，但是其內容為卻又是 Packed 形態的數字，那你
就必須依其應該有的格式將他轉為 Packed 形態的數字，才能用來處理計算式，或
直接將舊有資料轉為 AS/400 新格式以利後續處理。
底下的範例是，處理 2 位文字但其內含 3 位長度的 packed數字，有兩個函數，一
個是處理 3 位整數，沒有小數；而另一個函數是處理 1 位整數，兩位小數。
*--------------------------------------------------------------*
* Vengoal Chang Development Resource Copyright 2001.10 *
* *
* \\\\\\\ *
* ( o o ) *
*-------------------oOO----(_)----OOo--------------------------*
* *
* System name . . . : Technical Support *
* Text . . . . . . . : Convert Character filed to Packed Num *
* *
* Author . . . . . . : Vengoal Chang *
* *
* ooooO Ooooo *
* ( ) ( ) *
*-----------------( )-------------( )----------------------*/
* (_) (_) */
* */
* */
*Extracting Packed Data From A Character Field */
* */
* Complied with command CRTBNDRPG CVTCHR2PK */
* */
* Example : CALL CVTCHR2PK X'123F' will display 123 and 1.23 */
* CALL CVTCHR2PK X'1234' will display "Invalid" */
* CALL CVTCHR2PK X'123D' will display 123- and 1.23- */
* */
*--------------------------------------------------------------*/
H dftactgrp(*NO)
D GetDec_03_00 pr N
D charin 2 const
D pckout 3p 0
D GetDec_03_02 pr N
D charin 2 const
D pckout 3p 2
D packOut30 S 3p 0
D packOut32 S 3p 2
D tempStr S 20
D error S N
C *entry Plist
C Parm Char 2
C Eval Error= GetDec_03_00(Char : packOut30)
C If Not Error
C Eval tempStr = %editc(packOut30 : 'L')
C 'Packed 3,0' Dsply tempStr
C EndIf
C Eval Error= GetDec_03_02(Char : packOut32)
C If Not Error
C Eval tempStr = %editc(packOut32 : 'L')
C 'Packed 3,2' Dsply tempStr
C EndIf
C Eval *InLr = *On
*===========================================================
*Assume that a input field has a three-digit packed
*decimal values with zero decimal positions
*===========================================================
P GetDec_03_00 b export
D pi N
D charin 2 const
D pckout 3p 0
D charout ds 2
D decout 3p 0
D*--- PACKED FIELD MANIPULATION
D PCK S 1 DIM(16)
D PCKC S 16
D idx S 2 0 inz(1)
*-- PACKED NUMERIC DATA STRUCTURES
D PNUMD0 DS INZ
D PNUM0 1 16P 0
D PACKEVEN
D*-- VALID PACKED SIGNS
D C@PKSN c const(
D X'0F1F2F3F4F5F6F7F8F9F-
D 0D1D2D3D4D5D6D7D8D9D-
D 0C1C2C3C4C5C6C7C8C9C')
* calcs to verify that charin is valid packed data
C move charin PCKC
C Z-ADD *ZEROS PNUM0
C MOVEA PNUMD0 PCK
C MOVEA PCKC PCK
*-- CHECK EACH BYTE
C DO 16 idx
C PCK(idx) IFGE X'00'
C PCK(idx) ANDLE X'99'
C idx ANDNE 16
C ITER
C ENDIF
*
*-- ON THE LAST BYTE, CHECK FOR VALID SIGNS
C idx IFEQ 16
C C@PKSN CHECK PCK(idx) 80
C N80 LEAVE
C ENDIF
*
*-- INVALID DIGIT FOUND
*
C 'Invalid' Dsply
C ENDDO
C If *In80 = *Off
C eval charout = charin
C eval pckout = decout
C return *Off
C Else
C return *On
C EndIf
P e
*===========================================================
*Assume that a input field has a three-digit packed
*decimal values with two decimal positions
*===========================================================
P GetDec_03_02 b export
D pi N
D charin 2 const
D pckout 3p 2
D charout ds 2
D decout 3p 2
D*--- PACKED FIELD MANIPULATION
D PCK S 1 DIM(16)
D PCKC S 16
D idx S 2 0 inz(1)
*-- PACKED NUMERIC DATA STRUCTURES
D PNUMD0 DS INZ
D PNUM0 1 16P 0
D PACKEVEN
D*-- VALID PACKED SIGNS
D C@PKSN c const(
D X'0F1F2F3F4F5F6F7F8F9F-
D 0D1D2D3D4D5D6D7D8D9D-
D 0C1C2C3C4C5C6C7C8C9C')
* calcs to verify that charin is valid packed data
C move charin PCKC
C Z-ADD *ZEROS PNUM0
C MOVEA PNUMD0 PCK
C MOVEA PCKC PCK
*-- CHECK EACH BYTE
C DO 16 idx
C PCK(idx) IFGE X'00'
C PCK(idx) ANDLE X'99'
C idx ANDNE 16
C ITER
C ENDIF
*
*-- ON THE LAST BYTE, CHECK FOR VALID SIGNS
C idx IFEQ 16
C C@PKSN CHECK PCK(idx) 80
C N80 LEAVE
C ENDIF
*
*-- INVALID DIGIT FOUND
*
C 'Invalid' Dsply
C ENDDO
C If *In80 = *Off
C eval charout = charin
C eval pckout = decout
C return *Off
C Else
C return *On
C EndIf
P e
星期三, 11月 01, 2023
2001-10-22 如何從一文字(DDS A type)欄位擷取 Packed (DDS P type)形態的數字？
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言