home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / 3x400 / creatopt.lzh / PGMREXIT.CLP < prev    next >
Text File  |  1988-03-12  |  6KB  |  77 lines
  1. /*      CRTOPT PUBAUT(*ALL)                                          */         
  2. /*********************************************************************/         
  3. /* PROGRAM-             PGMREXIT                                     */         
  4. /* AUTHOR-              GREG THIELEN                                 */         
  5. /* DATE WRITTEN-        JANUARY 1, 1985                              */         
  6. /* PROGRAM DESCRIPTION- EXIT PROGRAM FOR DSPPGMMNU CMD.              */         
  7. /*********************************************************************/         
  8.              PGM        PARM(&OPTION &PARM &TYPE &PARM2 &TEXT &LOGRQS +         
  9.                           &SRCFILE &SRCLIB &OBJLIB &JOBD &RQSLEN +              
  10.                           &RQSDTA512 &CF4 &CF11 &OBJEXIST)                      
  11.              DCL        VAR(&OPTION) TYPE(*CHAR) LEN(2)                         
  12.              DCL        VAR(&PARM) TYPE(*CHAR) LEN(10)                          
  13.              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(4)                           
  14.              DCL        VAR(&PARM2) TYPE(*CHAR) LEN(21)                         
  15.              DCL        VAR(&TEXT) TYPE(*CHAR) LEN(50)                          
  16.              DCL        VAR(&LOGRQS) TYPE(*CHAR) LEN(4)                         
  17.              DCL        VAR(&SRCFILE) TYPE(*CHAR) LEN(10)                       
  18.              DCL        VAR(&SRCLIB) TYPE(*CHAR) LEN(10)                        
  19.              DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)                        
  20.              DCL        VAR(&JOBD) TYPE(*CHAR) LEN(10)                          
  21.              DCL        VAR(&RQSLEN) TYPE(*DEC) LEN(3 0)                        
  22.              DCL        VAR(&RQSDTA512) TYPE(*CHAR) LEN(512)                    
  23.              DCL        VAR(&CF4) TYPE(*LGL)                                    
  24.              DCL        VAR(&CF11) TYPE(*LGL)                                   
  25.              DCL        VAR(&OBJEXIST) TYPE(*LGL)                               
  26.              DCL        VAR(&RQSDTA256) TYPE(*CHAR) LEN(256)                    
  27.              DCL        VAR(&RQSERR) TYPE(*LGL)                                 
  28.              DCL        VAR("E) TYPE(*LGL)                                  
  29.              DCL        VAR(&R512INX) TYPE(*DEC) LEN(3 0)                       
  30.              DCL        VAR(&R256INX) TYPE(*DEC) LEN(3 0)                       
  31.              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                          
  32.              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                          
  33.              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                       
  34.              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                       
  35.              CHGVAR     VAR(&RQSDTA256) VALUE('CALL PGMRCREAT ''')              
  36.              CHGVAR     VAR(%SST(&RQSDTA256 17 10)) VALUE(&SRCFILE)             
  37.              CHGVAR     VAR(%SST(&RQSDTA256 27 10)) VALUE(&SRCLIB)              
  38.              CHGVAR     VAR(%SST(&RQSDTA256 37 10)) VALUE(&PARM)                
  39.              CHGVAR     VAR(%SST(&RQSDTA256 47 3)) VALUE(&RQSLEN)               
  40.              CHGVAR     VAR(&RQSERR) VALUE('0')                                 
  41.              CHGVAR     VAR("E) VALUE('0')                                  
  42.              CHGVAR     VAR(&R256INX) VALUE(50)                                 
  43.              CHGVAR     VAR(&R512INX) VALUE(1)
  44.              /* Examine request to expand embedded single quotes. */
  45.  STRRQS:     CHGVAR     VAR(%SST(&RQSDTA256 &R256INX 1)) +                      
  46.                           VALUE(%SST(&RQSDTA512 &R512INX 1))                    
  47.              IF         COND(&R512INX *LT &RQSLEN) THEN(DO)                     
  48.                IF         COND((%SST(&RQSDTA512 &R512INX 1) *EQ '''') +         
  49.                             *AND (*NOT "E)) THEN(CHGVAR VAR("E) +       
  50.                             VALUE('1'))                                         
  51.                ELSE       CMD(DO)                                               
  52.                  CHGVAR     VAR("E) VALUE('0')                              
  53.                  CHGVAR     VAR(&R512INX) VALUE(&R512INX + 1)                   
  54.                ENDDO                                                            
  55.                IF         COND(&R256INX *LT 255) THEN(DO)                       
  56.                  CHGVAR     VAR(&R256INX) VALUE(&R256INX + 1)                   
  57.                  GOTO       CMDLBL(STRRQS)                                      
  58.                ENDDO                                                            
  59.                ELSE       CMD(CHGVAR VAR(&RQSERR) VALUE('1'))                   
  60.              ENDDO                                                              
  61.              IF         COND(&RQSERR) THEN(SNDPGMMSG MSGID(CPF9898) +           
  62.                           MSGF(QCPFMSG) MSGDTA('Command too long to +           
  63.                           submit') MSGTYPE(*ESCAPE))                            
  64.              CHGVAR     VAR(&R256INX) VALUE(&R256INX + 1)                       
  65.              CHGVAR     VAR(%SST(&RQSDTA256 &R256INX 1)) VALUE('''')            
  66.              SBMJOB     JOB(&PARM) JOBD(&JOBD) RQSDTA(&RQSDTA256) +             
  67.                           LOG(0)                                                
  68.              MONMSG     MSGID(CPF0000)                                          
  69.  RCVMSG:     RCVMSG     MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +             
  70.                           MSGFLIB(&MSGFLIB)                                     
  71.              IF         COND(&MSGID *NE ' ') THEN(DO)                           
  72.                SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGF.&MSGFLIB) +                  
  73.                             MSGDTA(&MSGDTA)                                     
  74.                GOTO       CMDLBL(RCVMSG)                                        
  75.              ENDDO                                                              
  76.              ENDPGM                                                             
  77.