Aqui tienes algo que te puede ayudar.......
100 D* ************************************************
31/10/07
200 D* APISYSVAL: RECUPERA HASTA 20 VALORES DEL SISTEMA
31/10/07
300 D* ************************************************
31/10/07
400 D URCVVARLEN S 9B 0
31/10/07
500 D UNBRSYSVAL S 9B 0
31/10/07
600 D UNAMESYSVAL S 10A DIM(20)
31/10/07
700 D MSG S 52A
31/10/07
800 DURCVVAR DS
31/10/07
900 D UVALRTN 9B 0
31/10/07
1000 D UOFFSET 9B 0 DIM(20)
31/10/07
1100 D UINFAREA 2048
31/10/07
1200 DDSINFAREA DS
31/10/07
1300 D USYSVAL 1 10
31/10/07
1400 D UTYPEDATA 11 11
31/10/07
1500 D UINFSTATUS 12 12
31/10/07
1600 D UDATALEN 13 16B 0
31/10/07
1700 D UDATA 17 2048
31/10/07
1800 D* -------------------------
31/10/07
1900 D* ESTRUCTURA DE ERRORES API
31/10/07
2000 D* -------------------------
31/10/07
2100 DAPIERR DS
31/10/07
2200 D QBYTPRV 1 4B 0 INZ(128)
31/10/07
2300 D QBYTAVL 5 8B 0
31/10/07
2400 D QEXCPID 9 15
31/10/07
2500 D QRESERV 16 16
31/10/07
2600 D QDATA 17 128
31/10/07
2700 D* ----------------------------------------------------
31/10/07
2800 D* DEFINICION CAMPOS PARA API QMHSNDPM (enviar mensaje)
31/10/07
2900 D* ----------------------------------------------------
31/10/07
3000 DÑMHSNDPM DS
31/10/07
3100 D ÑMSGID 1 7A
31/10/07
3200 D ÑMSGF 8 27A
31/10/07
3300 D ÑMSGDTA 28 107A
31/10/07
3400 D ÑMSGLEN 108 111B 0 INZ(80)
31/10/07
3500 D ÑMSGTYPE 112 121A
31/10/07
3600 D ÑSTACK 122 131A
31/10/07
3700 D ÑSTACKC 132 135B 0
31/10/07
3800 D ÑMSGKEY 136 139A
31/10/07
3900 D* --------------------------------
31/10/07
4000 D* AREA DE INFORMACION DEL PROGRAMA
31/10/07
4100 D* --------------------------------
31/10/07
4200 D ÑÑDS SDS
31/10/07
4300 D ÑÑPGM 1 10
31/10/07
4400 D ÑÑLIB 81 90
31/10/07
4500 D ÑÑJOB 244 253
31/10/07
4600 D ÑÑUSER 254 263
31/10/07
4700 D ÑÑJOBN 264 269 0
31/10/07
4800 DDS_SysVal DS
31/10/07
4900 D NbrSysVal 4B 0
31/10/07
5000 D LstSysVal 200
31/10/07
5100 C*============================================================
31/10/07
5200 C *ENTRY PLIST
31/10/07
5300 C PARM DS_SysVal
31/10/07
5400 C*
31/10/07
5500 C if NbrSysVal>0 and NbrSysVal<21
31/10/07
5600 C 1 DO NbrSysVal I 3 0
31/10/07
5700 C EVAL
UNAMESYSVAL(I)=%subst(LstSysVal:1+(10*(I-1)))
31/10/07
5800 C ENDDO
31/10/07
5900 C* Inicializa campo de valores devueltos
31/10/07
6000 C EVAL UVALRTN=0
31/10/07
6100 C*
31/10/07
6200 C CALL 'QWCRSVAL'
31/10/07
6300 C PARM URCVVAR
31/10/07
6400 C PARM 2132 URCVVARLEN
31/10/07
6500 C PARM NbrSysVal UNBRSYSVAL
31/10/07
6600 C PARM UNAMESYSVAL
31/10/07
6700 C PARM APIERR
31/10/07
6800 C*
31/10/07
6900 C SELECT
31/10/07
7000 C WHEN QEXCPID<>*BLANK
31/10/07
7100 C EXSR SENDMSG
31/10/07
7200 C OTHER
31/10/07
7300 C 1 DO UVALRTN I 3 0
31/10/07
7400 C EVAL
DSINFAREA=%SUBST(URCVVAR:UOFFSET(I)+1)
31/10/07
7500 C EVAL
QDATA=USYSVAL+'='+%subst(UDATA:1:UDATALEN)
31/10/07
7600 C EVAL QEXCPID='CPF9897'
31/10/07
7700 C EXSR SENDMSG
31/10/07
7800 C ENDDO
31/10/07
7900 C ENDSL
31/10/07
8000 C*
31/10/07
8100 C* VALORES DEVUELTOS <> VALORES SOLICITADOS
31/10/07
8200 C IF UVALRTN<>NbrSysVal
31/10/07
8300 C EVAL QEXCPID='CPF9897'
31/10/07
8400 C EVAL QDATA='NO SE HAN DEVUELTO TODOS LOS
VALORES' 31/10/07
8500 C EXSR SENDMSG
31/10/07
8600 C ENDIF
31/10/07
8700 C*
31/10/07
8800 C ENDIF
31/10/07
8900 C MOVEL *ON *INLR
31/10/07
9000 C*=============================================================
31/10/07
9100 C SENDMSG BEGSR
31/10/07
9200 C MOVEL(P) 'QCPFMSG ' ÑMSGF
31/10/07
9300 C MOVE '*LIBL ' ÑMSGF
31/10/07
9400 C CALL 'QMHSNDPM'
31/10/07
9500 C PARM QEXCPID ÑMSGID
31/10/07
9600 C PARM ÑMSGF
31/10/07
9700 C PARM QDATA ÑMSGDTA
31/10/07
9800 C PARM 80 ÑMSGLEN
31/10/07
9900 C PARM '*NOTIFY' ÑMSGTYPE
31/10/07
10000 C PARM '*EXT' ÑSTACK
31/10/07
10100 C PARM 0 ÑSTACKC
31/10/07
10200 C PARM ÑMSGKEY
31/10/07
10300 C PARM APIERR
31/10/07
10400 C ENDSR
31/10/07
10500>>> [EMAIL PROTECTED] 11/21 11:06 a.m. >>> Hola , me podrian decir como rescatar el nombre del sistema desde un RPGLE ? Alguna API quiza. gracias -- ..::. Nicolas Machado Metodo Argentina S.A. _____________________ __________________________________________________ Forum.HELP400 es un servicio m&#225;s de NEWS/400. &#169; Publicaciones Help400, S.L. - Todos los derechos reservados http://www.help400.es _____________________________________________________ Para darte de baja visita la siguente URL: http://listas.combios.es/mailman/listinfo/forum.help400 __________________________________________________ Forum.HELP400 es un servicio m&#225;s de NEWS/400. &#169; Publicaciones Help400, S.L. - Todos los derechos reservados http://www.help400.es _____________________________________________________ Para darte de baja visita la siguente URL: http://listas.combios.es/mailman/listinfo/forum.help400
