home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / qryf.lzh / QRYF.CLP next >
Text File  |  1987-09-04  |  5KB  |  97 lines
  1. /*-------------------------------------------------------------------*/
  2. /* PURPOSE: CCP for the QRYF command, create a temp QRY application  */
  3. /* METHOD:  The QRYF passes the request, this program sets it up     */
  4. /*          and calls QRYFR to generate the UDS statements, uses     */
  5. /*          the CRTQRYAPP command to create the query and runs it    */
  6. /*                                                                   */
  7. /* INVOKED:  QRYF command                                            */
  8. /* SCHEDULE: On request                                              */
  9. /*                                                                   */
  10. /* PROGRAMMER:  Robert   Hughes         DATE: 08/87                  */
  11. /* REVISED:     F------- L--------      DATE: mm/yy                  */
  12. /* REASON:                                                           */
  13. /*-------------------------------------------------------------------*/
  14.  
  15.              PGM        PARM(&FILE &FORMAT &TITLE &FIELDS &MBR)
  16.              DCL        VAR(&FILE) TYPE(*CHAR) LEN(20)
  17.              DCL        VAR(&FNAM) TYPE(*CHAR) LEN(10)
  18.              DCL        VAR(&FLIB) TYPE(*CHAR) LEN(10)
  19.              DCL        VAR(&FPARM) TYPE(*CHAR) LEN(21)
  20.              DCL        VAR(&MBR ) TYPE(*CHAR) LEN(10)
  21.              DCL        VAR(&TITLE ) TYPE(*CHAR) LEN(32)
  22.              DCL        VAR(&FORMAT) TYPE(*CHAR) LEN(10)
  23.              DCL        VAR(&FIELDS) TYPE(*CHAR) LEN(512)
  24.              DCL        VAR(&MMSG) TYPE(*LGL) VALUE('0')
  25.              DCL        VAR(&MSGID ) TYPE(*CHAR) LEN( 7)
  26.              DCL        VAR(&MSGF  ) TYPE(*CHAR) LEN(10)
  27.              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(100)
  28.              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
  29.              MONMSG     MSGID(CPF0000 RPG0000 IDU0000) EXEC(GOTO +
  30.                           CMDLBL(ERROR))
  31.  
  32. /* Extract file.lib names and setup parm to pass to QRYFR           */
  33.              CHGVAR     VAR(&FNAM) VALUE(%SST(&FILE 1 10))
  34.              CHGVAR     VAR(&FLIB) VALUE(%SST(&FILE 11 10))
  35.              CHGVAR     VAR(&FPARM) VALUE(&FNAM │< '.' ││ &FLIB)
  36.  
  37. /* Setup a work source file in QTEMP                               */
  38.              CRTSRCPF   FILE(QRYF.QTEMP) MAXMBRS(2) SIZE(500 100 10)
  39.              MONMSG     MSGID(CPF7302) EXEC(CHGVAR VAR(&MMSG) +
  40.                           VALUE('1')) /* Make MONMSG IF/ELSE */
  41.              IF         COND(&MMSG) THEN(DO)
  42.               CLRPFM     FILE(QRYF.QTEMP) MBR(QRYF)
  43.               CLRPFM     FILE(QRYF.QTEMP) MBR(COPY)
  44.              ENDDO
  45.              ELSE       CMD(DO)
  46.               ADDPFM     FILE(QRYF.QTEMP) MBR(QRYF)
  47.               ADDPFM     FILE(QRYF.QTEMP) MBR(COPY)
  48.              ENDDO
  49.  
  50. /* Call the RPG pgm QRYFR to write the UDS statements               */
  51.              OVRDBF     FILE(QCLSRC) TOFILE(QRYF.QTEMP) MBR(QRYF)
  52.              OVRDBF     FILE(QCLSRC2) TOFILE(QRYF.QTEMP) MBR(COPY)
  53.              CALL       PGM(QRYFR.QGPL) PARM(&FPARM &FORMAT &TITLE +
  54.                           &FIELDS)
  55.  
  56. /* Use CRTQRYAPP to create the QRY program                          */
  57.              DLTPGM     PGM(QRYF.QTEMP)
  58.              MONMSG     MSGID(CPF0000)
  59.              CRTQRYAPP  APP(QRYF.QTEMP) SRCFILE(QRYF.QTEMP)
  60.              MONMSG     MSGID(IDU0000) EXEC(GOTO CMDLBL(ERROR))
  61.  
  62. /* If &MBR = *OPNQRYF then extract the data to a temporary file and */
  63. /* run the QRYDTA from it. (QRYDTA cannot run from a OPNQRYF)       */
  64.              IF         COND(&MBR *EQ '*OPNQRYF') THEN(DO)
  65.               DLTF       FILE(QRYFWRK.QTEMP)
  66.               MONMSG     MSGID(CPF0000)
  67.               CRTDUPOBJ  OBJ(&FNAM) FROMLIB(&FLIB) OBJTYPE(*FILE) +
  68.                            TOLIB(QTEMP) NEWOBJ(QRYFWRK)
  69.               FMTDTA     INFILE((&FNAM.&FLIB)) OUTFILE(QRYFWRK.QTEMP) +
  70.                           SRCFILE(QRYF.QTEMP) SRCMBR(COPY) +
  71.                           OPTION(*NOPRT)
  72.               OVRDBF     FILE(&FNAM) TOFILE(QRYFWRK.QTEMP) SECURE(*YES)
  73.               QRYDTA     APP(QRYF.QTEMP) OUTPUT(*LIST)
  74.              ENDDO
  75. /* Else use QRYDTA against the actual file to create the report      */
  76.              ELSE       CMD(DO)
  77.               IF         COND(&MBR *NE '*FIRST') THEN(OVRDBF +
  78.                            FILE(&FNAM) TOFILE(&FNAM.&FLIB) MBR(&MBR))
  79.               ELSE       CMD(OVRDBF FILE(&FNAM) TOFILE(&FNAM.&FLIB))
  80.               QRYDTA     APP(QRYF.QTEMP) OUTPUT(*LIST)
  81.              ENDDO
  82.              GOTO       CMDLBL(END)
  83.  
  84.  
  85. /* Error handling routine to receive any *ESCAPE messages and resend  +
  86.    them to the user and then end with a CPF9898 *ESCAPE message      */
  87.  ERROR:      RCVMSG     MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
  88.                           MSGFLIB(&MSGFLIB)
  89.              IF         COND(&MSGID *EQ ' ') THEN(GOTO CMDLBL(FAIL))
  90.              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGF.&MSGFLIB) +
  91.                           MSGDTA(&MSGDTA) MSGTYPE(*INFO)
  92.              GOTO       CMDLBL(ERROR)
  93.  FAIL:       SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG.QSYS) MSGDTA('The +
  94.                           QRYF command failed to complete, review +
  95.                           prior messages') MSGTYPE(*ESCAPE)
  96.  END:        ENDPGM
  97.