home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / crtoutf.lzh / CPP1720.CLP next >
Text File  |  1985-12-02  |  4KB  |  104 lines
  1.  CPP1720:    PGM        PARM(&OUTFILE &FORMAT &REPLACE &MEMBERS &SIZE +
  2.                           &KEYFLDS)
  3.  
  4.              /*         Program - CPP1720  */
  5.              /*         Create output file */
  6.  
  7.              DCL        &OUTFILE *CHAR 20 /* Output file name */
  8.              DCL        &FORMAT  *CHAR 42 /* OUTFILE Command name */
  9.              DCL        &REPLACE *LGL  1  /* Replace existing file? */
  10.              DCL        &MEMBERS *DEC  5  /* Maximum members */
  11.              DCL        &SIZE    *CHAR 13 /* Output file size */
  12.              DCL        &KEYFLDS *CHAR 1282 /* Key fields */
  13.  
  14.              DCL        &MAXMBRS *CHAR 6  /* Maximum members-*Char */
  15.              DCL        &SIZE1 *CHAR 8    /* Initial file size */
  16.              DCL        &SIZE2 *CHAR 5    /* Increment records */
  17.              DCL        &SIZE3 *CHAR 5    /* Maximum increments */
  18.  
  19.              DCL        &CNT   *DEC  3    /* Counter for messages */
  20.              DCL        &MSGID *CHAR 7    /* Message ID */
  21.              DCL        &MSGDTA *CHAR 132 /* Message data */
  22.  
  23.              MONMSG     MSGID(CPF0000) EXEC(GOTO  RCVMSG)
  24.  
  25.  REPLACE:    IF         (&REPLACE)   GOTO CHKOBJ
  26.              CHKOBJ     OBJ(%SST(&OUTFILE 01 10).%SST(&OUTFILE 11 +
  27.                           10)) OBJTYPE(*FILE)
  28.              MONMSG     MSGID(CPF9801) EXEC(DO) /* Ignore not found */
  29.              RCVMSG
  30.              GOTO       CHKOBJ
  31.              ENDDO
  32.              SNDPGMMSG  MSGID(CPF5813) MSGF(QCPFMSG) MSGDTA(&OUTFILE) +
  33.                           TOPGMQ(*SAME) MSGTYPE(*ESCAPE) /* Duplicate +
  34.                           file name--CANCEL. */
  35.              GOTO       RCVMSG
  36.  
  37.  CHKOBJ:     CHKOBJ     OBJ(QDDSSRC.QTEMP) OBJTYPE(*FILE) +
  38.                           MBR(%SST(&OUTFILE 01 10))
  39.              MONMSG     MSGID(CPF9801) EXEC(DO)
  40.              CRTSRCPF   FILE(QDDSSRC.QTEMP) MBR(%SST(&OUTFILE 01 10)) +
  41.                           SIZE(20 20 20) TEXT('File created by +
  42.                           CRTOUTF command.')
  43.              RCVMSG
  44.              RCVMSG
  45.              RCVMSG
  46.              GOTO       OVRDBF
  47.              ENDDO
  48.              MONMSG     MSGID(CPF9815) EXEC(DO)
  49.              ADDPFM     FILE(QDDSSRC.QTEMP) MBR(%SST(&OUTFILE 01 10))
  50.              RCVMSG
  51.              RCVMSG
  52.              GOTO       OVRDBF
  53.              ENDDO
  54.  
  55.  CLRPFM:     CLRPFM     FILE(QDDSSRC.QTEMP) MBR(%SST(&OUTFILE 01 10))
  56.              RCVMSG
  57.  
  58.  OVRDBF:     OVRDBF     FILE(QDDSSRC) TOFILE(QDDSSRC.QTEMP) +
  59.                           MBR(%SST(&OUTFILE 01 10)) LVLCHK(*NO)
  60.  
  61.  CALLPGM:    CALL       PGM(CPP1721) PARM(&FORMAT &SIZE &KEYFLDS +
  62.                           &SIZE1 &SIZE2 &SIZE3)
  63.  
  64.  DLTFILE:    IF         (&REPLACE) DO
  65.              DLTF       FILE(%SST(&OUTFILE 01 10).%SST(&OUTFILE 11 10))
  66.              MONMSG     MSGID(CPF2105)
  67.              ENDDO
  68.  
  69.  CHGMBRS:    IF         (&MEMBERS *EQ  0) DO
  70.                         CHGVAR VAR(&MAXMBRS) VALUE('*NOMAX')
  71.               ENDDO
  72.               ELSE      DO
  73.                         CHGVAR VAR(&MAXMBRS) VALUE(&MEMBERS)
  74.              ENDDO
  75.  
  76.  CRTPF:      CRTPF      FILE(%SST(&OUTFILE 01 10).%SST(&OUTFILE 11 +
  77.                           10)) SRCFILE(QDDSSRC.QTEMP) OPTION(*NOSRC +
  78.                           *NOLIST) MAXMBRS(&MAXMBRS) LVLCHK(*NO)
  79.  
  80.  CHGPF:      IF         (&SIZE1 *EQ '*NOMAX') DO
  81.              CHGPF      FILE(%SST(&OUTFILE 01 10).%SST(&OUTFILE 11 +
  82.                           10)) SIZE(*NOMAX)
  83.              ENDDO
  84.              ELSE       DO
  85.              CHGPF      FILE(%SST(&OUTFILE 01 10).%SST(&OUTFILE 11 +
  86.                           10)) SIZE(&SIZE1 &SIZE2 &SIZE3)
  87.              ENDDO
  88.  
  89.  RCVMSG:     CHGVAR     VAR(&CNT) VALUE(1)
  90.  LOOP:       IF         (&CNT *LE 10) DO
  91.                RCVMSG     MSGDTA(&MSGDTA) MSGID(&MSGID)
  92.                IF         (&MSGID *EQ ' ') GOTO ENDPGM
  93.                IF         ((%SST(&MSGID 01 02) *EQ 'CP')) +
  94.                SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) MSGDTA(&MSGDTA) +
  95.                           MSGTYPE(*DIAG)
  96.                ELSE       DO
  97.                SNDPGMMSG  MSGID(&MSGID) MSGF('Q' *CAT %SST(&MSGID 01 +
  98.                           03) *CAT 'MSG')  MSGDTA(&MSGDTA)
  99.                ENDDO
  100.                CHGVAR     VAR(&CNT) VALUE(&CNT + 1)
  101.                GOTO       LOOP
  102.              ENDDO
  103.  ENDPGM:     ENDPGM     /* CPP1720 */
  104.