home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / addlibl.lzh / CPP2040.CLP < prev   
Text File  |  1985-12-02  |  6KB  |  132 lines
  1.              PGM        PARM(&LIB &POSITION &PROMPT)
  2.  
  3.              /*         ADDLIBL  */
  4.              /*         Add to Library List. CPP  */
  5.  
  6.              DCL        VAR(&LIB)      TYPE(*CHAR) LEN(242)
  7.              DCL        VAR(&ALIB)     TYPE(*CHAR) LEN(264)
  8.              DCL        VAR(&POSITION) TYPE(*CHAR) LEN(13)
  9.              DCL        VAR(&POS)      TYPE(*CHAR) LEN(10)
  10.              DCL        VAR(&BA)       TYPE(*CHAR) LEN(1)
  11.              DCL        VAR(&PROMPT)   TYPE(*LGL)  LEN(1)
  12.              DCL        VAR(&RPLLIBL)  TYPE(*CHAR) LEN(15)
  13.              DCL        VAR(&LIBL)     TYPE(*CHAR) LEN(275)
  14.  
  15.              DCL        VAR(&OFFSET)  TYPE(*DEC) LEN(3 0)
  16.              DCL        VAR(&OFFSET1) TYPE(*DEC) LEN(3 0) VALUE(1)
  17.              DCL        VAR(&OFFSET2) TYPE(*DEC) LEN(3 0) VALUE(3)
  18.              DCL        VAR(&LEN)     TYPE(*DEC) LEN(3 0)
  19.              DCL        VAR(&LEN2)    TYPE(*DEC) LEN(3 0)
  20.              DCL        VAR(&LIBNAME) TYPE(*CHAR) LEN(10)
  21.  
  22.              DCL        VAR(&TIMES)   TYPE(*DEC)  LEN(3 0)
  23.              DCL        VAR(&CMD)     TYPE(*CHAR) LEN(350)
  24.              DCL        VAR(&COUNTER) TYPE(*DEC)  LEN(3 0)
  25.              DCL        VAR(&CNT)     TYPE(*DEC)  LEN(15 0)
  26.              DCL        VAR(&P1)      TYPE(*DEC)  LEN(3 0)
  27.              DCL        VAR(&MSGID)   TYPE(*CHAR) LEN(7)
  28.              DCL        VAR(&MSGDTA)  TYPE(*CHAR) LEN(132)
  29.              MONMSG     MSGID(CPF0000 MCH0000)    EXEC(GOTO RCVMSG)
  30.  
  31.              RTVJOBA    USRLIBL(&LIBL)
  32.              CHGVAR     VAR(&POS) VALUE(%SST(&POSITION 03 10))
  33.              CHGVAR     VAR(&BA) VALUE(%SST(&POSITION 13 01))
  34.              BINCVT     BINVAL(%SST(&LIB 01 02)) DECVAR(&CNT)
  35.              CHGVAR     VAR(&P1) VALUE((&CNT * 11))
  36.  
  37.  LOOP:       IF         (&TIMES *LT &CNT) DO
  38.              CHGVAR     VAR(%SST(&ALIB &OFFSET1 10)) VALUE(%SST(&LIB +
  39.                           &OFFSET2 10))
  40.              CHGVAR     VAR(&OFFSET1) VALUE(&OFFSET1 + 11)
  41.              CHGVAR     VAR(&OFFSET2) VALUE(&OFFSET2 + 10)
  42.              CHGVAR     VAR(&TIMES) VALUE(&TIMES + 1)
  43.              GOTO       LOOP
  44.              ENDDO
  45.  
  46.              IF         COND(&PROMPT) THEN(CHGVAR VAR(&RPLLIBL) +
  47.                           VALUE('? RPLLIBL LIBL('))
  48.              ELSE       CMD(CHGVAR VAR(&RPLLIBL) VALUE('RPLLIBL +
  49.                           LIBL('))
  50.  
  51.              IF         (&POS *EQ '*FIRST') DO
  52.              CHGVAR     VAR(&OFFSET) VALUE(1)
  53.              GOTO       SETUP
  54.              ENDDO
  55.  
  56.              IF         COND(&POS *EQ '*LAST') THEN(CHGVAR +
  57.                           VAR(&LIBNAME) VALUE('          '))
  58.              ELSE       CHGVAR     VAR(&LIBNAME) VALUE(&POS)
  59.  
  60.              CHGVAR     VAR(&OFFSET) VALUE(1)
  61.  
  62.  LOOP2:      IF         COND(%SST(&LIBL &OFFSET 10) *EQ &LIBNAME *OR +
  63.                           %SST(&LIBL &OFFSET 10) *EQ ' ') THEN(GOTO +
  64.                           CMDLBL(START))
  65.  
  66.              CHGVAR     VAR(&OFFSET) VALUE(&OFFSET + 11)
  67.  
  68.              IF         (&OFFSET *GT 266) DO
  69.              SNDPGMMSG  MSG('Library list is full.   No more +
  70.                           libraries may be entered.') TOPGMQ(*PRV) +
  71.                           MSGTYPE(*DIAG)
  72.              GOTO       RCVMSG
  73.              ENDDO
  74.  
  75.              GOTO       LOOP2
  76.  
  77.  START:      IF         ((&POS *EQ '*LAST') *OR (&LIBNAME *EQ ' ')) +
  78.                           CHGVAR VAR(&OFFSET) VALUE(&OFFSET - 11)
  79.  
  80.  SETUP:      IF         (&BA = '0') DO    /* Place before */
  81.  
  82.              IF         (&OFFSET = 1) DO  /* If first library then +
  83.                           bypass code. */
  84.              CHGVAR     VAR(&LIBL) VALUE(&ALIB *BCAT &LIBL)
  85.              GOTO       EXECMD
  86.              ENDDO
  87.  
  88.              /*           Move offset pointer to library to the left +
  89.                           of the selected library.  This will cause +
  90.                           the "place before" action. */
  91.              CHGVAR     VAR(&OFFSET) VALUE(&OFFSET - 11)
  92.              ENDDO
  93.  
  94.              CHGVAR     VAR(&LEN) VALUE(&OFFSET + 10)
  95.              CHGVAR     VAR(&LEN2) VALUE((275 - (&OFFSET + 10)) - 1)
  96.              CHGVAR     VAR(&OFFSET) VALUE(&OFFSET + 11)
  97.  
  98.              CHGVAR     VAR(&LIBL) VALUE(%SST(&LIBL 1 &LEN) *BCAT +
  99.                           &ALIB *BCAT %SST(&LIBL &OFFSET &LEN2))
  100.  
  101.  EXECMD:     CHGVAR     VAR(&CMD) VALUE(&RPLLIBL *CAT &LIBL *TCAT ')')
  102.  
  103.              CALL       PGM(QCACHECK) PARM(&CMD 350)
  104.              MONMSG     MSGID(CPF0006) EXEC(DO)
  105.              SNDPGMMSG  MSG(%SST(&CMD 01 132)) TOPGMQ(*PRV) +
  106.                           MSGTYPE(*DIAG)
  107.              SNDPGMMSG  MSG(%SST(&LIB 02 132)) TOPGMQ(*PRV) +
  108.                           MSGTYPE(*DIAG)
  109.              SNDPGMMSG  MSG(%SST(&ALIB 01 132)) TOPGMQ(*PRV) +
  110.                           MSGTYPE(*DIAG)
  111.              GOTO       CPP2040
  112.              ENDDO
  113.  
  114.              CALL       PGM(QCAEXEC) PARM(&CMD 300)
  115.  
  116.              GOTO       CPP2040
  117.  
  118.  RCVMSG:     RCVMSG     RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
  119.              IF         (&MSGID *NE ' ')    DO
  120.              IF         (%SST(&MSGID 1 3) *EQ 'CPF' +
  121.                      *OR %SST(&MSGID 1 3) *EQ 'MCH')  DO
  122.              IF         (&MSGDTA *EQ ' ') SNDPGMMSG  MSGID(&MSGID) +
  123.                           MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  124.              ELSE       SNDPGMMSG  MSGID(&MSGID) MSGF(QCPFMSG) +
  125.                           MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
  126.              CHGVAR     VAR(&COUNTER) VALUE(&COUNTER + 1)
  127.              ENDDO
  128.              IF         (&COUNTER *LE 10) GOTO RCVMSG
  129.              ENDDO
  130.  CPP2040:    /*         CONTINUE  */
  131.              ENDPGM
  132.