Lo he montado de la siguiente manera:
El primer programa es temporal, es de tipo *PGM creado con un CRTBNDRPG y lo unico que
hace es pasar por parametro al primer modulo "A" las sentencias SQL.
/COPY NEWAPLICA/QPROTOSRC,PTCABDET
DSENTENCIA S 100A
DRETORN S 1A
*
*
C EVAL SENTENCIA = 'SELECT CPENUCPED, CPCLIEPED, +
C CPNPECPED, CPNOMEPED +
C FROM NEWAPLICA/PFCABEPEDI'
C EVAL RETORN = PR_CABDET(SENTENCIA)
C EVAL *INLR = *ON
El modulo "A" muestra un fichero de cabeceras en un subfichero. Lo he creado con un
CRTSQLRPGI con *MODULE. Como retorna un parametro la llamada el modulo "B" la hago con
una asignaci�n.
MODULA "A"
********************************************************
* 20/10/2002 Sergi. *
* PGM PARA MOTRAR TODAS LAS CABECERAS DEL FICHERO *
* PFCABEPEDI Y POR CADA CABECERA MUESTRA EL DETALLE *
* DEL FICHERO PFDETAPEDI. *
********************************************************
HDATEDIT(*DMY/) BNDDIR('DIENLACE01')
*
FPTCABDET CF E WORKSTN
F SFILE(SFLSFL:NRR)
F INDDS(Indicadores)
*
/COPY NEWAPLICA/QESTRUCSRC,ESINDICADO
D ActivarPagi N OVERLAY(Indicadores:80)
D Noizq N OVERLAY(Indicadores:82)
D Noder N OVERLAY(Indicadores:83)
D DeleteSfl N OVERLAY(Indicadores:91)
D HayRegSfl1 N OVERLAY(Indicadores:97)
D HayRegSfl3 N OVERLAY(Indicadores:98)
D Arriba N OVERLAY(Indicadores:17)
D Abajo N OVERLAY(Indicadores:18)
D MostrarPie N OVERLAY(Indicadores:66)
*
D NRR S 5S 0
D SSQL S 100A
/COPY NEWAPLICA/QPROTOSRC,PTCABDET
/COPY NEWAPLICA/QPROTOSRC,PTCABDET1
PPR_CABDET B EXPORT
DPR_CABDET PI 1A
D SentenciaSql 100A VALUE
*
D PPSALIR S 1A INZ('N')
*
C/EXEC SQL PREPARE S1 FROM :SentenciaSql
C/END-EXEC
*
C/EXEC SQL
C+ DECLARE CUR1 DYNAMIC SCROLL CURSOR FOR S1
C/END-EXEC
*
* BLOQUE PRINCIPAL
*
C MOVEL *BLANKS XLIBXFIL 20
C MOVEL *BLANKS PMBR 10
C EXSR DLTSFL
C EXSR OBRECURFIT
C EXSR LLEGIRFIT
C EXSR TANCARFI
C IF NRR > 0
C EVAL HayRegSfl1 = *ON
C ELSE
C EVAL HayRegSfl1 = *OFF
C ENDIF
C EVAL MOSTRARPIE = *ON
C WRITE PIE
C EXFMT SFLCTL
C DOW NOT Salir
C IF MdtoSistema
C CALL 'QUSCMDLN'
C ENDIF
C EXSR TRATASFL3
C IF PPSALIR = 'S'
C LEAVE
C ELSE
C WRITE PIE
C EXFMT SFLCTL
C ENDIF
C ENDDO
C RETURN 'A'
*
* Fin de programa
*
C MOVE *ON *INLR
********************************************************
* Subrutina para declarar cursor para PFCABEPEDI *
********************************************************
C OBRECURFIT BEGSR
*
C/EXEC SQL
C+ OPEN CUR1
C/END-EXEC
*
C ENDSR
********************************************************
* Subrutina para cargar los registros recuperados *
********************************************************
C LLEGIRFIT BEGSR
C DO 9999
C/EXEC SQL
C+ FETCH NEXT FROM CUR1 INTO :PPENUCPED,
C+ :PPCLIEPED,
C+ :PPNPECPED,
C+ :PPNOMEPED
C/END-EXEC
C SQLSTT IFEQ '02000'
C LEAVE
C ENDIF
*
C* EVAL PPENUCPED = WPENUCPED
C* EVAL PPCLIEPED = WPCLIEPED
C* EVAL PPNPECPED = WPNPECPED
C* EVAL PPNOMEPED = WPNOMEPED
C ADD 1 NRR
C WRITE SFLSFL
*
C ENDDO
*
C ENDSR
********************************************************
* Subrutina para cerrar los cursores utilizados *
********************************************************
C TANCARFI BEGSR
C/EXEC SQL
C+ CLOSE CUR1
C/END-EXEC
C ENDSR
**********************************************************
* Subrutina para tratar selecci�n detalle de una CABECERA*
**********************************************************
C TRATASFL3 BEGSR
*
C READC SFLSFL 95
C EVAL PPSALIR = 'N'
C DOW NOT *IN95 AND PPSALIR = 'N'
C IF PSELEC = 'X'
C EXSR SENTENCIES
C EVAL PPSALIR = PR_CABDET1(SSQL)
C ELSE
C LEAVE
C ENDIF
C EVAL Anterior = *OFF
C EVAL PSELEC = ' '
C UPDATE SFLSFL
C READC SFLSFL 95
C ENDDO
C ENDSR
********************************************************
* Subrutina para cerrar los cursores utilizados *
********************************************************
C SENTENCIES BEGSR
C
C
C EVAL SSQL = 'SELECT DPENPEPED, DPNUMFPED,+
C DPCODPPED, DPCANTPED, DPPRECPED, +
C DPIMPOPED, DPDTOCPED, DPCONCPED, +
C DPFOPAPED, DPIVAAPED FROM +
C NEWAPLICA/PFDETAPEDI WHERE +
C PPENUCPED = DPENUCPED'
C ENDSR
********************************************************
* Subrutina para inicializar el subfichero *
********************************************************
C DLTSFL BEGSR
C IF NRR > 0
C EVAL DeleteSfl = *ON
C Z-ADD 0 NRR 5 0
C WRITE SFLCTL
C EVAL DeleteSfl = *OFF
C ENDIF
C ENDSR
PPR_CABDET E
Para cada cabecera el modulo "B" muestra su detalle en otro subfichero.
Esta creado de la misma manera que el modulo "A". Al pasarle el debug, no consigo ver
el modulo "B". La unica manera de poder ver los dos mudulos es llamando el modulo "B"
con un CALLB, lo que passa es que el parametro no se passa correctamente.
Modulo "B"
********************************************************
* 20/10/2002 Sergi. *
* PGM PARA MOTRAR TODAS LAS CABECERAS DEL FICHERO *
* PFCABEPEDI Y POR CADA CABECERA MUESTRA EL DETALLE *
* DEL FICHERO PFDETAPEDI. *
********************************************************
*
F*IFICHERO IF E K DISK USROPN
F* EXTFILE(XLIBXFIL) EXTMBR(PMBR)
FPFDETAPEDIIF E K DISK
FPTCABDET CF E WORKSTN
F SFILE(SFLSFL2:NRR2)
F INDDS(Indicadores)
D NRR2 S 5S 0
/COPY NEWAPLICA/QESTRUCSRC,ESINDICADO
D ActivarPagi N OVERLAY(Indicadores:80)
D Noizq N OVERLAY(Indicadores:82)
D Noder N OVERLAY(Indicadores:83)
D DeleteSfl N OVERLAY(Indicadores:91)
D HayRegSfl2 N OVERLAY(Indicadores:98)
D Arriba N OVERLAY(Indicadores:17)
D Abajo N OVERLAY(Indicadores:18)
D MostrarPie N OVERLAY(Indicadores:65)
*
/COPY NEWAPLICA/QPROTOSRC,PTCABDET1
PPR_CABDET1 B EXPORT
DPR_CABDET1 PI 1A
D SentenciaSql 100A VALUE
*
D WPENPEPED S 7S 0
D WPNUMFPED S 7A
D WPCODPPED S 7A
D WPCANTPED S 5S 0
D WPPRECPED S 8S 2
D WPIMPOPED S 11S 2
D WPDTOCPED S 5S 2
D WPCONCPED S 4A
D WPFOPAPED S 2A
D WPIVAAPED S 5S 2
*
D PSALIR S 1A
*
* BLOQUE PRINCIPAL
*
C MOVEL *BLANKS XLIBXFIL 20
C MOVEL *BLANKS PMBR 10
C*** EVAL XLIBXFIL = 'NEWAPLICA/PFDETAPEDI'
C*** EVAL PMBR = 'PFDETAPEDI'
C* OPEN MIFICHERO
C EXSR OBRECURFIT
C EXSR LLEGIRFIT
C EXSR TANCARFI
C IF NRR2 > 0
C EVAL HayRegSfl2 = *ON
C ELSE
C EVAL HayRegSfl2 = *OFF
C ENDIF
C IF NOT SALIR AND NOT ANTERIOR
C IF HAYREGSFL2
C EXSR TRATASFL3
C ENDIF
C WRITE PIE
C EXFMT SFLCTL2
C IF MdtoSistema
C CALL 'QUSCMDLN'
C ENDIF
C ENDIF
C IF SALIR
C EVAL PSALIR = 'S'
C ENDIF
C EXSR DLTSFL
C RETURN PSALIR
*
* Fin de programa
*
C MOVE *ON *INLR
********************************************************
* Subrutina para declarar cursor para PFDETAPEDI *
********************************************************
C OBRECURFIT BEGSR
*
C/EXEC SQL PREPARE S1 FROM :SentenciaSql
C/END-EXEC
*
C/EXEC SQL
C+ DECLARE CUR2 DYNAMIC SCROLL CURSOR FOR S1
C/END-EXEC
*
C/EXEC SQL
C+ OPEN CUR2
C/END-EXEC
*
C ENDSR
********************************************************
* Subrutina para cargar los registros recuperados *
********************************************************
C LLEGIRFIT BEGSR
C DO 9999
C/EXEC SQL
C+ FETCH NEXT FROM CUR2 INTO :WPENPEPED,
C+ :WPNUMFPED,
C+ :WPCODPPED,
C+ :WPCANTPED,
C+ :WPPRECPED,
C+ :WPIMPOPED,
C+ :WPDTOCPED,
C+ :WPCONCPED,
C+ :WPFOPAPED,
C+ :WPIVAAPED
C/END-EXEC
C SQLSTT IFEQ '02000'
C LEAVE
C ENDIF
*
C EVAL PPENPEPED = WPENPEPED
C EVAL PPNUMFPED = WPNUMFPED
C EVAL PPCODPPED = WPCODPPED
C EVAL PPCANTPED = WPCANTPED
C EVAL PPPRECPED = WPPRECPED
C EVAL PPIMPOPED = WPIMPOPED
C EVAL PPDTOCPED = WPDTOCPED
C EVAL PPCONCPED = WPCONCPED
C EVAL PPFOPAPED = WPFOPAPED
C EVAL PPIVAAPED = WPIVAAPED
C ADD 1 NRR2
C WRITE SFLSFL2
*
C ENDDO
*
C ENDSR
********************************************************
* Subrutina para cerrar los cursores utilizados *
********************************************************
C TANCARFI BEGSR
C/EXEC SQL
C+ CLOSE CUR2
C/END-EXEC
C ENDSR
**********************************************************
* Subrutina para tratar selecci�n detalle de una *
**********************************************************
C TRATASFL3 BEGSR
*
C READC SFLSFL2 95
C DOW NOT *IN95
C IF PSELEC = 'X'
C* CALL 'PGDETALLE'
C IF NOT SALIR
C EVAL Anterior = *OFF
C EVAL PSELEC = ' '
C UPDATE SFLSFL2
C READC SFLSFL2 95
C ELSE
C LEAVE
C ENDIF
C ENDIF
C ENDDO
C ENDSR
********************************************************
* Subrutina para inicializar el subfichero *
********************************************************
C DLTSFL BEGSR
C IF NRR2 > 0
C EVAL DeleteSfl = *ON
C Z-ADD 0 NRR2 5 0
C WRITE SFLCTL
C EVAL DeleteSfl = *OFF
C ENDIF
C ENDSR
PPR_CABDET1 E
�Cu�l debo utilizar? �callB? �La asignaci�n? Os recuerdo que los dos modulos primero
los cree como tipo *PGM, y estan bien probados y funcionan. Siento enviar los fuentes,
y una explicaci�n tan larga, pero es que estoy deseperado y fustrado.
Muchas gracias por las molestias.
_____________________________________________________
Forum.HELP400 es un servicio m�s de NEWS/400.
� Publicaciones Help400, S.L. - Todos los derechos reservados
http://www.help400.es
_____________________________________________________
Para darte de baja, env�a el mensaje resultante de pulsar
mailto:forum.help400-request@;combios.es?body=LEAVE
