RTVPFNAM





Retrouver nom système d'un PF à partir du nom long SQL



/********************************************************************/
/*                                                                  */
/* A COMPILER PAR :                                                 */
/*                                                                  */
/*    CRTCMD CMD(?????/RTVPFNAM) PGM(?????/RTVPFNAMG)             */
/*            ALLOW(*BPGM *IPGM *BMOD *IMOD)                        */
/*                                                                  */
/********************************************************************/
             CMD        PROMPT('Retrouver nom court DBF')
             PARM       KWD(NOM) TYPE(*NAME) LEN(128) EXPR(*YES) +
                          PROMPT('Nom long')
             PARM       KWD(LIB) TYPE(*NAME) DFT(*LIBL) +
                          SPCVAL((*LIBL) (*CURLIB))  +
                          PROMPT('Bibliothèque')
             PARM       KWD(NOM10) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
                          PROMPT('Variable retour. . . .CHAR(10)')


Retrouver nom PF à partir nom long (CPP)


| 
     dnomlong          s            128
     dwnomlong         s                   like(nomlong)
     dbibnomlong       s             10
     drtnval           s             10


     Dmin              c                   'abcdefghijklmnopqrstuvwxyz'
     DMAJ              c                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'


     ddsretour         ds
     d  retour_nom                   10
     d  retour_bib                   10
     dcoderreur        ds
     d  cod_lg                       10I 0 inz(%len(coderreur))
     d  cod_lgr                      10I 0
     d  cod_cpf                       7
     d  cod_filler                    1


     Drtvsn            pr                  extpgm('QDBRTVSN')
     d retour                              like(dsretour)
     d nom                                 like(nomlong)          const
     d nom_len                       10I 0                        const
     d bib                                 like(bibnomlong)       const
     d code                                like(coderreur)


     c     *entry        plist
     c                   parm                    nomlong
     c                   parm                    bibnomlong
     c                   parm                    rtnval


     c     min:MAJ       xlate     nomlong       wnomlong


     c                   callp     rtvsn(dsretour : wnomlong    :
     c                                   %len(%trimr(nomlong))  :
     c                                   bibnomlong  : coderreur )


     c                   if        cod_cpf = ' '
     c                   eval      rtnval = retour_nom
     c                   endif
     c                   return





©AF400