Juan: No es en Cobol400… alguien me lo envió, no sé de donde salió, pero sirve. Saludos Ignacio T
0001.00 C *ENTRY PLIST 0002.00 C PARM RANNBR 90 0003.00 C PARM LOVAL 90 0004.00 C PARM HIVAL 90 0005.00 C PARM PGMEND 4 0006.00 C PARM STRVAL 90 0007.00 C LOVAL IFLT 0 0008.00 C SETON H1 0009.00 C GOTO BADEND 0010.00 C END 0011.00 C HIVAL IFLE LOVAL 0012.00 C SETON H2 0013.00 C END 0014.00 C PGMEND IFNE '*YES' 0015.00 C PGMEND ANDNE'*NO ' 0016.00 C SETON H3 0017.00 C GOTO BADEND 0018.00 C END 0019.00 C FSTTIM IFEQ ' ' 0020.00 C TIME TIME 60 0021.00 C Z-ADDTIME BGNVAL 90 0022.00 C PGMEND IFEQ '*YES' 0023.00 C HIVAL SUB LOVAL NBR1 0024.00 C NBR1 IFLE 1 0025.00 C MOVE TIME DEC1 10 0026.00 C 1 ADD NBR1 RANGE 30 0027.00 C Z-ADDDEC1 RANNBR 0028.00 C NBR1LP TAG 0029.00 C RANNBR IFGE RANGE 0030.00 C SUB RANGE RANNBR 0031.00 C GOTO NBR1LP 0032.00 C END 0033.00 C ADD LOVAL RANNBR 0034.00 C GOTO ENDPGM 0035.00 C END 0036.00 C END 0037.00 C STRVAL IFEQ 0 0038.00 C ELSE 0039.00 C Z-ADDSTRVAL BGNVAL 0040.00 C END 0041.00 C MOVE 31415 PI 54 0042.00 C BGNVAL MULT PI NBR1 90 0043.00 C MOVE 'X' FSTTIM 1 0044.00 C END 0045.00 C HIVAL SUB LOVAL MAX 134 0046.00 C ADD 1 MAX 0047.00 C SUB DECVAL MAX 0048.00 C MOVE 314159265 PI2 98 0049.00 C NBR1 MULT PI2 NBR2 157 0050.00 C NBR2 DIV 17 NBR3 154 0051.00 C Z-ADDNBR3 NBR4 153 0052.00 C MOVE NBR4 DEC4 44 0053.00 C PGMEND IFEQ '*YES' 0054.00 C MOVE NBR3 DEC5 53 0055.00 C ADD DEC5 NBR4 0056.00 C END 0057.00 C MOVE DEC4 DECVAL 66 0058.00 C MOVE NBR4 NBR5 90 0059.00 C NBR5 DIV MAX NBR6 150 0060.00 C MVR RANNBR 90 0061.00 C ADD LOVAL RANNBR 0062.00 C ENDPGM TAG 0063.00 C PGMEND IFEQ '*NO ' 0064.00 C MOVE NBR2 WRK1 101 0065.00 C ADD WRK1 NBR1 0066.00 C MOVE NBR3 WRK2 112 0067.00 C ADD WRK2 NBR1 0068.00 C ELSE 0050.00 C NBR2 DIV 17 NBR3 154 0051.00 C Z-ADDNBR3 NBR4 153 0052.00 C MOVE NBR4 DEC4 44 0053.00 C PGMEND IFEQ '*YES' 0054.00 C MOVE NBR3 DEC5 53 0055.00 C ADD DEC5 NBR4 0056.00 C END 0057.00 C MOVE DEC4 DECVAL 66 0058.00 C MOVE NBR4 NBR5 90 0059.00 C NBR5 DIV MAX NBR6 150 0060.00 C MVR RANNBR 90 0061.00 C ADD LOVAL RANNBR 0062.00 C ENDPGM TAG 0063.00 C PGMEND IFEQ '*NO ' 0064.00 C MOVE NBR2 WRK1 101 0065.00 C ADD WRK1 NBR1 0066.00 C MOVE NBR3 WRK2 112 0067.00 C ADD WRK2 NBR1 0068.00 C ELSE 0069.00 C SETON LR 0070.00 C END 0071.00 C RETRN 0072.00 C BADEND TAG De: [email protected] [mailto:[email protected]] En nombre de Juan Ramón Garcia Enviado el: miércoles, 17 de septiembre de 2014 9:25 Para: [email protected]; forum.help400 Asunto: Re: Números aleatorios en COBOL400 Muchas gracias Marcelo pero busco algo un poco más elaborado. El 17 de septiembre de 2014, 14:14, Marcelo Diaz <[email protected]<mailto:[email protected]>> escribió: Hice una rutina que tomaba la datetime y agarraba los ultimos 6 digitos ... El 17 de septiembre de 2014, 9:01, Juan Ramón Garcia <[email protected]<mailto:[email protected]>> escribió: Hola a tod@s: Tengo un pequeño problemilla, necesito generar un nº aleatorio en COBOL400 (NO ILE) y no puedo utilizar CEERAN0. He encontrado varios ejemplos en San Google pero ninguno me funciona, o son para COBOL-II o para ILE o simplemente no funcionan. ¿Alguien tiene una rutinilla en COBOL400 que calcule números aleatorios? Muchas gracias. Un saludo. Juanra El iSaurio RpgEro que se convirtió en CobolEro ;-) ____________________________________________________ Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd ) Forum.Help400 © Publicaciones Help400, S.L. ____________________________________________________ Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd ) Forum.Help400 © Publicaciones Help400, S.L. ----------------------------------------------------------------- Notice of Confidentiality: The information transmitted is intended only for the sender and person or entity to which it is addressed and may contain confidential and/or privileged material. Any review, e-transmission, dissemination or other use of, or taking of any action in reliance upon, this information by persons or entities other than the intended recipient is prohibited. If you received this in error, please contact the sender immediately by return electronic transmission and then immediately delete this transmission, including all attachments, without copying, distributing or disclosing same. ------------------------------------------------------------------ Aviso de Confidencialidad: Este correo electrónico y/o el material adjunto es para uso exclusivo del emisor y la persona o entidad a la que expresamente se le ha enviado, y puede contener información confidencial o material privilegiado. Si usted no es el destinatario legítimo del mismo, por favor repórtelo inmediatamente al remitente del correo y bórrelo. Cualquier revisión, retransmisión, difusión o cualquier otro uso de este correo, por personas o entidades distintas a las del destinatario legítimo, queda expresamente prohibido. Este correo electrónico no pretende ni debe ser considerado como constitutivo de ninguna relación legal, contractual o de otra índole similar.
____________________________________________________ Únete a Recursos AS400, nuestra Comunidad ( http://bit.ly/db68dd ) Forum.Help400 © Publicaciones Help400, S.L.
