home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / copysavf.lzh / CPP3420.CLP next >
Text File  |  1986-08-01  |  4KB  |  72 lines

  1.  CPP3420:    PGM        PARM(&SAVF &FILE &MBR &CRTFILE &REPLACE)
  2.  
  3.              /*         Program name - CPP3420 */
  4.              /*         Copy from a Save File CPP */
  5.              /*         Command processing program for CPYFRMSAVF */
  6.  
  7.              DCL        &SAVF *CHAR 20  /* Save file name */
  8.              DCL        &FILE *CHAR 20  /* Target file name */
  9.              DCL        &MBR  *CHAR 10  /* Target file member name */
  10.              DCL        &CRTFILE *LGL 1 /* Create Target file? */
  11.              DCL        &REPLACE *LGL 1 /* Replace Target file data? */
  12.  
  13.              DCL        &ERRORCODE *LGL 1 /* Error while proceesing */
  14.  
  15.              MONMSG     MSGID(CPF0000) EXEC(GOTO ENDPGM)
  16.  
  17.              CHKOBJ     OBJ(%SST(&SAVF 01 10).%SST(&SAVF 11 10)) +
  18.                           OBJTYPE(*FILE)
  19.              MONMSG     MSGID(CPF9801) EXEC(DO)
  20.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Save +
  21.                           file:' *BCAT %SST(&SAVF 01 10) *TCAT '.' +
  22.                           *CAT %SST(&SAVF 11 10) *BCAT 'was not +
  23.                           found') MSGTYPE(*DIAG)
  24.              GOTO       CMDLBL(ENDPGM)
  25.              ENDDO
  26.              CHKOBJ     OBJ(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  27.                           OBJTYPE(*FILE)
  28.              MONMSG     MSGID(CPF9801) EXEC(DO)
  29.              IF         COND(&CRTFILE) THEN(DO)
  30.  CRTFILE:    CRTPF      FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  31.                           RCDLEN(528) OPTION(*NOLIST *NOSRC) +
  32.                           FILETYPE(*DATA) MBR(*NONE) MAXMBRS(*NOMAX) +
  33.                           SIZE(20000 20000 10) TEXT('Q38-SaveFile +
  34.                           database file')
  35.              ENDDO
  36.              ELSE       CMD(DO)
  37.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('File' +
  38.                           *BCAT %SST(&FILE 01 10) *TCAT '.' *CAT +
  39.                           %SST(&FILE 11 10) *BCAT 'not found') +
  40.                           MSGTYPE(*DIAG)
  41.              GOTO       ENDPGM
  42.              ENDDO
  43.              ENDDO
  44.              IF         COND(&MBR *EQ '*SAVF') THEN(DO)
  45.              CHGVAR     VAR(&MBR) VALUE(%SST(&SAVF 01 10))
  46.              ENDDO
  47.              CHKOBJ     OBJ(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  48.                           OBJTYPE(*FILE) MBR(&MBR)
  49.              MONMSG     MSGID(CPF9815) EXEC(DO)
  50.              ADDPFM     FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  51.                           MBR(&MBR) TEXT('Q38 - Save file:' *BCAT +
  52.                           %SST(&SAVF 01 10) *TCAT '.' *CAT %SST(&SAVF +
  53.                           11 10))
  54.              ENDDO
  55.              IF         COND(&REPLACE) THEN(DO)
  56.              CLRPFM     FILE(%SST(&FILE 01 10).%SST(&FILE 11 10)) +
  57.                           MBR(&MBR)
  58.              ENDDO
  59.              OVRSAVF    FILE(CPP3421I) TOFILE(%SST(&SAVF 01 +
  60.                           10).%SST(&SAVF 11 10))
  61.              OVRDBF     FILE(CPP3421O) TOFILE(%SST(&FILE 01 +
  62.                           10).%SST(&FILE 11 10)) MBR(&MBR)
  63.  CALLPGM:    CALL       PGM(CPP3421) PARM(&ERRORCODE)
  64.              IF         COND(&ERRORCODE) THEN(DO)
  65.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Error +
  66.                           occurred while processing save file.  +
  67.                           Unpredictable data may be in file' *BCAT +
  68.                           %SST(&FILE 01 10) *TCAT '.' *CAT %SST(&FILE +
  69.                           11 10)) MSGTYPE(*DIAG)
  70.              ENDDO
  71.  ENDPGM:     ENDPGM
  72.