82 lines
2.7 KiB
Plaintext
82 lines
2.7 KiB
Plaintext
|
subroutine U11A2( proc, ibn, pib, sib, ip, obn, pob, sob )
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Pad the current input buffer with enough zeroes to achieve the
|
||
|
|
* total specified number of digits
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This "user-exit", called from a ProVerb, left zero-fills the string in
|
||
|
|
* the current input buffer until the number of digits requested is
|
||
|
|
* achieved. It returns the result to the current input buffer.
|
||
|
|
*
|
||
|
|
* Usage:
|
||
|
|
* U11A2
|
||
|
|
* requested.number.of.digits
|
||
|
|
*
|
||
|
|
* Arguments to this subroutine are:
|
||
|
|
* proc - the text of the proc itself
|
||
|
|
* ibn - the current input buffer switch (0 = primary;
|
||
|
|
* 1 = secondary)
|
||
|
|
* pib - the primary input buffer
|
||
|
|
* sib - the secondary input buffer
|
||
|
|
* ip - the input buffer pointer (character count)
|
||
|
|
* obn - the current output buffer switch (0 = primary;
|
||
|
|
* 1 = secondary)
|
||
|
|
* pob - the primary output buffer
|
||
|
|
* sob - the secondary output buffer
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* The documentation says to pad the current value in the SECONDARY input
|
||
|
|
* buffer with zeroes.
|
||
|
|
* Assume that we mean the currently active input buffer
|
||
|
|
* and that the current value is pointed to by "ip". If "ip" points to an
|
||
|
|
* attribute mark, then we move foward one character and try again.
|
||
|
|
|
||
|
|
REMOVE n FROM proc SETTING x
|
||
|
|
cp = ip + 1
|
||
|
|
IF ibn THEN
|
||
|
|
IF sib[ cp, 1 ] = @AM THEN cp += 1
|
||
|
|
t = sib[ cp, len( sib )]
|
||
|
|
END ELSE
|
||
|
|
IF pib[ cp, 1 ] = @AM THEN cp += 1
|
||
|
|
t = pib[ cp, len( pib )]
|
||
|
|
END
|
||
|
|
|
||
|
|
t = t< 1 >
|
||
|
|
|
||
|
|
len.t = len( t )
|
||
|
|
t = STR( "0", n - len.t ) : t
|
||
|
|
IF ibn THEN
|
||
|
|
IF sib[ ip, 1 ] = @AM THEN ip += 1
|
||
|
|
first.part = sib[ 1, ip - 1 ] : t : @AM
|
||
|
|
last.part = sib[ ip + 1, len( sib )]
|
||
|
|
DEL last.part< 1 >
|
||
|
|
sib = first.part : last.part
|
||
|
|
END ELSE
|
||
|
|
IF pib[ ip, 1 ] = @AM THEN ip += 1
|
||
|
|
first.part = pib[ 1, ip - 1 ] : t : @AM
|
||
|
|
last.part = pib[ ip + 1, len( pib )]
|
||
|
|
DEL last.part< 1 >
|
||
|
|
pib = first.part : last.part
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|