RE:desplegar caracter en campo numérico
Publicado por
ros (1 intervención) el 17/03/2008 12:06:45
E CCC 1 1 1
*****************************************************************
*
*****************************************************************
* RECIBE ALFANUMERICO DE 30
* RECIBE ALFANUMERICO DE 5 CON EL NUMERO DE DECIMALES PARA EL CAMPO
* RECIBE ALFANUMERICO DE 1 POR SI DEBE COLOCAR SIGNO
* SALE EL MISMO CAMPO DE ENTRADA DE 30 CON EL VALOR EDITADO
*
*
* INICIO DE PROGRAMA
*
C EXSR PARTE1
C EXSR PARTE2
*
*----------------------------------------------------------------
* FIN DEL PROGRAMA.
*----------------------------------------------------------------
C MOVE *ON *INLR
C RETRN
*
*================================================================
* PARTE1 : PONER UN NUMERO SIN CEROS.
*================================================================
C PARTE1 BEGSR
*
C MOVE *ZEROS XNUME1
C MOVE *BLANK XNUME2
C MOVE XNUME0 XNUME1
C MOVE *BLANK A
C MOVE *OFF *IN25
*
C XNUME0 IFNE *ZEROS
*
* BUSCAR PRIMERA POSICION NUMERICA.
C 1 DO 30 Z
C 1 SUBSTXNUME1:Z A
C A IFNE '0'
C Z-ADDZ X
C LEAVE
C ENDIF
C ENDDO
*
C SUB 1 X
*-----
C 1 DO 30 Z
C 31 SUB Z Y
C XDECI0 IFEQ Z
C CCC,1 CAT XNUME2 XNUME2
C ENDIF
C Y IFLE X
C Z ANDGTXDECI0
C MOVE *ON *IN25
C ENDIF
C *IN25 IFEQ *OFF
C 1 SUBSTXNUME1:Y A
C A CAT XNUME2 XNUME2
C ELSE
C *IN26 IFEQ *OFF
C PSIGN ANDEQ'S'
C ' ' CAT XNUME2 XNUME2
C ELSE
C ' ' CAT XNUME2 XNUME2
C ENDIF
C MOVE *ON *IN26
C ENDIF
C XDECI0 IFGT *ZEROS
C Z ANDGE29
C LEAVE
C ENDIF
C ENDDO
*
C ELSE
* CUANDO NUMERO ES CERO
C MOVE '0' XNUME2
C SELEC
C XDECIX WHEQ 1
C CAT CCC,1:0 XNUME2
C CAT '0':0 XNUME2
C XDECIX WHEQ 2
C CAT CCC,1:0 XNUME2
C CAT '00':0 XNUME2
C XDECIX WHEQ 3
C CAT CCC,1:0 XNUME2
C CAT '000':0 XNUME2
C XDECIX WHEQ 4
C CAT CCC,1:0 XNUME2
C CAT '0000':0 XNUME2
C XDECIX WHEQ 5
C CAT CCC,1:0 XNUME2
C CAT '00000':0 XNUME2
C XDECIX WHEQ 6
C CAT CCC,1:0 XNUME2
C CAT '000000':0XNUME2
C ENDSL
*
C ENDIF
*--
C PSIGN IFEQ 'S'
C XNUME2 CAT '-' XNUME3 31
C MOVE XNUME3 XNUME2
C ADD 1 XDECI0
C ENDIF
*--
C ENDSR
*================================================================
* PARTE2 : PONER PUNTOS DE MILLAR
*================================================================
C PARTE2 BEGSR
*
C XNUME2 IFNE *BLANK
C MOVE XNUME2 XNUME1
C CLEARXNUME2
C CLEARX
C SUB 1 X
*
C 1 DO Z30 Z
C 31 SUB Z Y
C 1 SUBSTXNUME1:Y A
*
C Z IFGT XDECI0
C A ANDNE*BLANK
*
C ADD 1 X
C X IFEQ 3
C '.' CAT XNUME2 XNUME2
C A CAT XNUME2 XNUME2
C CLEARX
C SUB 1 Z30
C ELSE
C A CAT XNUME2 XNUME2
C ENDIF
*
C ELSE
C A CAT XNUME2 XNUME2
C ENDIF
*
C ENDDO
*
C ENDIF
*
C ENDSR
*================================================================
* RUTINA DE INICIALIZACION.
*================================================================
C *INZSR BEGSR
*
*----------------------------------------------------------------
* ENTRADA DE PARAMETROS.
C *ENTRY PLIST
C PARM XNUME2 PNUME 30
C PARM PDECI 5
C PARM PSIGN 1
*
*----------------------------------------------------------------
* DECLARACION Y BORRADO DE VARIABLES
C Z-ADD*ZEROS XNUME0 300
C MOVE *BLANK XNUME1 30
C MOVE *BLANK XNUME2 30
C Z-ADD*ZEROS XDECI0 50
C Z-ADD*ZEROS XDECIX 50
C MOVE *BLANK A 1
C Z-ADD*ZEROS X 50
C Z-ADD*ZEROS Y 50
C Z-ADD*ZEROS Z 50
C Z-ADD30 Z30 50
C MOVE *OFF *IN25
*
*----------------------------------------------------------------
*TRASPASO DE PARAMETROS DE ENTRADA
C MOVE PNUME XNUME0
C MOVE PDECI XDECI0
C MOVE PDECI XDECIX
*
C XNUME0 IFLT *ZEROS
C XNUME0 MULT -1 XNUME0
C ENDIF
*
C XDECI0 IFGT *ZEROS
C ADD 1 XDECI0
C ENDIF
*
C ENDSR
**
,
----------------------------------------------
entrada
call UTIL0099 (' 1234567890' '00003' 'S')
entrada desde programa
Z-ADD1234567,890 XNUME2 103
CLEARPNUME
MOVE XNUME2 PNUME
CALL 'UTIL0099'
PARM PNUME 30
PARM '00003' PDECI 5
PARM 'S' PSIGN 1
donde en PSIGN S=negativo y N=positivo
PNUME es el numero a formatear
PDECI la cantidad de decimales que tiene el numero original
salida
' 1.234.567,890-'
CLEARWNUME
MOVE PNUME WNUME
siendo WNUME el campo alfanumerico del subfichero de una longitud en este caso de 15.
Espero que te sirva la utilidad util0099, es un programa en RPGIV, pero lo puedes clavar tal cual, en ILE cambiando la hoja E