/* ovrpun.i dps 12/21/98 */

/* procedure ovrpun.ip
 * overpunches the last digit of a number
 * call with:
 *      decimal value to convert
 *      numeric format string e.g. 'ZZZ9.99-', 'ZZZZ9-', 'ZZ,ZZ9.99-'
 *      overpunch positive number if yes
 *      output converted number
 */

PROCEDURE ovrpun.ip:

    DEF INPUT PARAM ix  AS DECIMAL                          NO-UNDO.
    DEF INPUT PARAM fmt AS CHAR                             NO-UNDO.
    DEF INPUT PARAM opf AS LOGICAL                          NO-UNDO.
    DEF OUTPUT PARAM oc AS CHAR                             NO-UNDO.

    DEF VAR num         AS CHAR INITIAL '.0123456789'       NO-UNDO.
    DEF VAR plus        AS CHAR INITIAL '.~{ABCDEFGHI'      NO-UNDO.
    DEF VAR minus       AS CHAR INITIAL '.}JKLMNOPQR'       NO-UNDO.

    DEF VAR i           AS INTEGER                          NO-UNDO.
    DEF VAR j           AS INTEGER                          NO-UNDO.
    DEF VAR pos         AS INTEGER                          NO-UNDO.
    DEF VAR ic          AS CHAR                             NO-UNDO.

    ic = STRING(ix,fmt) NO-ERROR.
    IF SUBSTRING(ic,1,1) = '?' THEN DO: /* format overflow */
        ic = ''.
        DO i = 1 TO LENGTH(fmt):
            ic = ic + IF CAN-DO('z,Z,9',SUBSTRING(fmt,i,1)) THEN '9'
                      ELSE IF ix >= 0 AND SUBSTRING(fmt,i,1) = "-" THEN "+"
                      ELSE SUBSTRING(fmt,i,1).
        END.
    END.
     
    j = LENGTH(ic) - 1.

    IF SUBSTRING(ic,LENGTH(ic),1) = '-' THEN DO i = 1 TO j:     /* if minus */
        ASSIGN pos = INDEX(num,SUBSTRING(ic,i,1))
               oc  = oc + IF pos = 0 OR i <> j THEN SUBSTRING(ic,i,1)
                          ELSE SUBSTRING(minus,pos,1).
    END.
    ELSE DO i = 1 TO j:                                         /* if plus */
        IF opf THEN
            ASSIGN pos = INDEX(num,SUBSTRING(ic,i,1))
                   oc  = oc + IF pos = 0 OR i <> j THEN SUBSTRING(ic,i,1)
                              ELSE SUBSTRING(plus,pos,1).
        ELSE
            oc = oc + SUBSTRING(ic,i,1).
    END.

END PROCEDURE. /* ovrpun.ip */

/* end of module */