SQL

/*                                               2011/2012  MCSERRA  */
/*                                                                   */
/*                                             NAO ALTERAR POR FAVOR */
/* ----------------------------------------------------------------- */
/* SQL
     TSO/ISPF COMMAND - DESCRICAO SUMARIA DE SQLCODES
     SINTAX:
        TSO SQL <SQLCODE>
        EXEMPLO:  TSO SQL -180
*/
/* ----------------------------------------------------------------- */
/*                                                                   */
PARSE ARG SQLCODE
   "ISPEXEC CONTROL ERRORS RETURN"
   SQLCODE = STRIP(SQLCODE)
   TXC = 'VLC ALLOC DSNNAME Z#SQLCOD'
   IF SQLCODE = "" THEN
      "ISPEXEC VIEW DATASET('DES.CCS.EXEC(Z#SQLCOD)')"
   SINAL = SUBSTR(SQLCODE, 1, 1)
   MX = SUBSTR(TXC, 5, 4)
   IF DATATYPE(SINAL, NUMBER) = 1 THEN
      SQLCODE = '+'SQLCODE
   ELSE
     IF SINAL <> '-' & SINAL <> '+' THEN
        SQLCODE = '+'SUBSTR(SQLCODE, 2, 3)

   DDSNAME = MX''V
   SQLCODE = SUBSTR(SQLCODE, 1, 4)
   IF DATATYPE(SUBSTR(SQLCODE, 2, ), NUMBER) <> 1 THEN
      DO
         ZEDSMSG = SQLCODE ' INVALIDO'
         ZEDLMSG = 'SQLCODE ' SQLCODE ' DEVE SER NUMERICO'
         "ISPEXEC SETMSG MSG(ISRZ001)"
         EXIT
      END

   SQL.0 = 0
   "ALLOC DA('DES.CCS.EXEC(Z#SQLCOD)') FI(DIN) SHR REU"
   "EXECIO * DISKR DIN (STEM SQL. OPEN FINIS"
   IF RC > 4 THEN
      DO
         ZEDSMSG = 'ERRO FICH. SQLCODES'
         ZEDLMSG = 'ERRO ABERTURA DO FICHEIRO SQLCODES: ' RC
         "ISPEXEC SETMSG MSG(ISRZ001)"
         EXIT
      END
   "FREE FI(DIN)"
   TOTL = SQL.0

   IF TOTL = 0 THEN
      DO
        ZEDSMSG = 'FICH. SQLCODES VAZIO'
        ZEDLMSG = 'FICHEIRO SQLCODES SEM DADOS'
        "ISPEXEC SETMSG MSG(ISRZ001)"
        EXIT
      END
   RESULT = ""
   DO N = 1 TO TOTL
      SQLCF = SUBSTR(SQL.N, 1, 4)
      IF SQLCODE = SQLCF THEN
      DO
          /* SAY SQL.N  */
          ZEDLMSG = STRIP(SQL.N)
          "ISPEXEC SETMSG MSG(ISRZ001)"
          EXIT
      END
   END
   CALL DDSNAME
   ZEDSMSG =  SQLCODE ' INEXISTENTE'
   ZEDLMSG = 'SQLCODE ' SQLCODE ' NAO ENCONTRADO NO FICHEIRO'
   "ISPEXEC SETMSG MSG(ISRZ001)"
 EXIT
/*                                 */
/*                                               2011/2012  MCSERRA  */

Comentários

Mensagens populares deste blogue

CC

ED

Z#SQLCOD