/* 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;