/* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */ /* Structured Programming". Permission is given to reproduce and to use these procedures */ /* as part of a program, and to include them as part of a larger work to be sold for profit. */ /* However, the user is not permitted to sell the procedures separately. Provided always */ /* that these procedures and this copyright notice are reproduced in full. */ /* This procedure validates a FIXED DECIMAL value, submitted as a bit string. */ /* It must be used in conjunction with the macro definition %VALID in order to */ /* implement on S/390 the OS/2 built-in function VALID (which requires a FIXED DECIMAL */ /* argument). */ VALIDATE: PROCEDURE (Decimal_Value) OPTIONS (REORDER) RETURNS (BIT(1)); /* INCOMING: Decimal_Value = a packed decimal value, as a bit string from UNSPEC. */ DECLARE Decimal_Value BIT (*); DECLARE (LENGTH, SUBSTR) BUILTIN; DECLARE K BIT (4); DECLARE J FIXED BINARY; /* Inspect each digit of the packed decimal number. */ DO J = 1 TO LENGTH (Decimal_Value)-4 BY 4; K = SUBSTR (Decimal_Value, J, 4); IF K > '1001'B THEN /* Not a valid decimal digit. */ RETURN ( '0'B); END; /* Have finished with the digits; now check the sign. */ IF SUBSTR (Decimal_Value, J, 4) <= '1001'B THEN /* The sign is bad. */ RETURN ( '0'B); RETURN ( '1'B); /* The digits and the sign check OK. */ END VALIDATE; /* This macro procedure converts a function reference of the form: */ /* VALID (D) */ /* into the form: */ /* VALIDATE ( UNSPEC (D) ) */ %VALID: PROCEDURE (ARG) RETURNS (CHARACTER); DECLARE ARG CHARACTER; RETURN ( 'VALIDATE ( UNSPEC (' || ARG || '))' ); %END VALID; %ACTIVATE VALID NORESCAN;