home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / pgmmenu.lzh / CRC1234.CLP < prev    next >
Text File  |  1987-05-13  |  5KB  |  99 lines
  1.  CRC1234:      PGM        PARM(&USER)
  2.  
  3.              /*         Program - CRC1234  */
  4.              /*         CPP for command - PGMMNUDFT  */
  5.              /*         Written - 04/12/84 */
  6.              /*         Author  - R. Cozzi, Jr. */
  7.              /*         Revised - 10/21/85 - 12/30/85 - 02/04/86 */
  8.              /*                 - 02/27/86   */
  9.              /*         Programmer Menu user's defaults maintenance */
  10.  
  11.              DCL        &USER   *CHAR 20   /* User ID for defaults */
  12.              DCL        &CF01   *LGL  01   /* CMD 1 key pressed */
  13.              DCL        &PGMDFT *CHAR 2000 /* Menu default work var */
  14.              DCL        &MSGID  *CHAR 7    /* Message ID */
  15.              DCL        &MSGDTA *CHAR 132  /* Message data */
  16.              DCL        &MSG    *CHAR 80   /* Message from RPG PGM */
  17.              DCL        &MSGCNT  *DEC 3    /* Number of messages sent */
  18.              DCL        &MAXMSG  *DEC 3 10  /* Message limit */
  19.              DCL        &LIBL   *CHAR 275   /* Library list */
  20.              DCL        &NEW    *LGL 1 '0'  /* New user flag */
  21.              MONMSG     MSGID(CPF0000) EXEC(GOTO RCVMSG)
  22.  
  23.  
  24.              IF         (%SST(&USER 01 10) *EQ *DFT) +
  25.              CHGVAR     VAR(&USER) VALUE('PGMMENU   QGPL')
  26.  
  27.              IF         (%SST(&USER 11 10) *EQ *USRLIBL) DO
  28.              RTVJOBA    USRLIBL(&LIBL) /* Get library list. */
  29.              CHGVAR     VAR(%SST(&USER 11 10)) VALUE(%SST(&LIBL 01 10))
  30.              /*         Replace *USRLIBL with first library in LIBL */
  31.              ENDDO
  32.  
  33.              RTVDTAARA  DTAARA(%SST(&USER 01 10).%SST(&USER 11 10)) +
  34.                           RTNVAR(&PGMDFT)
  35.              MONMSG     MSGID(CPF1015) EXEC(DO)
  36.              /*         Send "creating" status message. */
  37.              SNDPGMMSG  MSGID(PGM1500) MSGF(PGMMSGF) MSGDTA(&USER) +
  38.                           TOPGMQ(*EXT) MSGTYPE(*STATUS)
  39.              CRTDTAARA  DTAARA(%SST(&USER 01 10).%SST(&USER 11 10)) +
  40.                           TYPE(*CHAR) LEN(2000) TEXT('CRC - +
  41.                           Programmer menu defaults for user:' *CAT +
  42.                           %SST(&USER 01 10))
  43.              CHGVAR     VAR(&NEW) VALUE('1') /* Flag for new user */
  44.              CHGVAR     VAR(&CF01) VALUE('1')
  45.              ENDDO
  46.  
  47.              CRTDTAARA  DTAARA(PGMDFT.QTEMP) TYPE(*CHAR) LEN(2000) +
  48.                           VALUE(&PGMDFT) PUBAUT(*ALL)
  49.              MONMSG     MSGID(CPF0000)
  50.              CHGDTAARA  DTAARA(PGMDFT.QTEMP) VALUE(&PGMDFT)
  51.              MONMSG     MSGID(CPF0000)
  52.  
  53.              CALL       PGM(CRC1235) PARM(&USER &CF01 &MSGID &MSG)
  54.  
  55.              IF         COND(&MSGID *NE ' ') THEN(DO)
  56.              SNDPGMMSG  MSG(&MSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  57.              SNDPGMMSG  MSG('User''s data area not modified') +
  58.                           TOPGMQ(*PRV) MSGTYPE(*COMP)
  59.              GOTO       ENDPGM
  60.              ENDDO
  61.  
  62.              IF         (&CF01) DO
  63.                IF         (&NEW) DO
  64.                 DLTDTAARA  DTAARA(%SST(&USER 01 10).%SST(&USER 11 10))
  65.                 MONMSG     MSGID(CPF0000)
  66.                ENDDO
  67.                           /* If new DTAARA, remove it. */
  68.              ENDDO
  69.              ELSE       DO
  70.                RTVDTAARA  DTAARA(PGMDFT) RTNVAR(&PGMDFT)
  71.                MONMSG     MSGID(CPF0000)
  72.                CHGDTAARA  DTAARA(%SST(&USER 01 10).%SST(&USER 11 10)) +
  73.                             VALUE(&PGMDFT)
  74.                MONMSG     MSGID(CPF0000)
  75.                DLTDTAARA  DTAARA(PGMDFT)
  76.                MONMSG     MSGID(CPF0000)
  77.                GOTO       ENDPGM
  78.              ENDDO
  79.              DLTDTAARA  DTAARA(PGMDFT)
  80.              MONMSG     MSGID(CPF0000)
  81.  
  82.  RCVMSG:     /*         Receive and forward program messages. */
  83.              IF         (&MSGCNT *LE &MAXMSG) DO
  84.              CHGVAR     VAR(&MSGCNT) VALUE(&MSGCNT + 1)
  85.              RCVMSG     RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
  86.              MONMSG     MSGID(CPF0000) EXEC(GOTO ENDPGM)
  87.              IF         (&MSGID *EQ ' ')  GOTO ENDPGM
  88.              IF         (%SST(&MSGID 1 2) *EQ 'CP'  +
  89.                      *OR %SST(&MSGID 1 3) *EQ 'MCH')  DO
  90.              IF         (&MSGDTA *EQ ' ') SNDPGMMSG  MSGID(&MSGID) +
  91.                           MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  92.              ELSE       SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) +
  93.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  94.              ENDDO
  95.              GOTO       RCVMSG
  96.              ENDDO
  97.  
  98.  ENDPGM:     ENDPGM
  99.