midrange.com code scratchpad
Name:
Get next sequence #
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
02/10/2012 06:50:01 pm
IP:
Logged
Description:
The user was to lazy to give a description
Code:
  1. /*********************************************************************/         
  2. /* Build name of MIME header file to be created                      */         
  3. /*********************************************************************/         
  4. /* Retrieve next sequence number */                                             
  5.              CHKOBJ     OBJ(&DTAARALIB/NXTMIME#) OBJTYPE(*DTAARA)               
  6.              MONMSG     MSGID(CPF9801) EXEC(CRTDTAARA +                         
  7.                           DTAARA(&DTAARALIB/NXTMIME#) TYPE(*CHAR) LEN(3) +      
  8.                           VALUE('000'))                                         
  9.  RTVMIME#:                                                                      
  10.              ALCOBJ     OBJ((&DTAARALIB/NXTMIME# *DTAARA *EXCLRD))              
  11.              MONMSG     MSGID(CPF0000) EXEC(DO)                                 
  12.              SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('Data +             
  13.                           area nxtmime# is locked and cannot be +               
  14.                           accessed')                                            
  15.              SNDMSG     MSG('Data area NXTMIME# is locked and +                 
  16.                           another program is trying to access it.') +           
  17.                           TOUSR(*SYSOPR)                                        
  18.              ALCOBJ     OBJ((&DTAARALIB/NXTMIME# *DTAARA *EXCLRD)) +            
  19.                           WAIT(180)                                             
  20.              ENDDO                                                              
  21.                                                                                 
  22.              RTVDTAARA  DTAARA(&DTAARALIB/NXTMIME#) RTNVAR(&SEQNO)              
  23.              CHGVAR     VAR(&SEQNO#) VALUE(&SEQNO)                              
  24. UpSequence:                                                                     
  25.              IF         COND(&SEQNO# *EQ 999) THEN(DO)                          
  26.                 CHGVAR     VAR(&SEQNO#) VALUE(001)                              
  27.              ENDDO                                                              
  28.              ELSE       CMD(DO)                                                 
  29.                 CHGVAR     VAR(&SEQNO#) VALUE(&SEQNO# + 1)                      
  30.              ENDDO                                                              
  31.              CHGVAR     VAR(&SEQNO) VALUE(&SEQNO#)                              
  32.                                                                                 
  33. /* Build name of MIME file to use */                                            
  34.              CHGVAR     VAR(&FILENAME) VALUE(&DIRECTORY *TCAT '/EMHDR' +        
  35.                           *TCAT &SEQNO *TCAT '.TXT')                            
  36.                                                                                 
  37. /* If file already exists, try again */                                         
  38.              CHGVAR     VAR(&PATH) VALUE(&FILENAME *TCAT &NULL)                 
  39.              CALLPRC    PRC('stat') PARM(&PATH &BUF) +                          
  40.                           RTNVAL(%BIN(&RTNVALINT 1 4))                          
  41.              CHGVAR     VAR(&RTNVAL) VALUE(%BIN(&RTNVALINT))                    
  42.              IF         COND(&RTNVAL *EQ '00') THEN(GOTO CMDLBL(UpSequence))    
  43.                                                                                 
  44.              /*LTS01d     CHGDTAARA  DTAARA(NXTMIME#) VALUE(&SEQNO)  */         
  45.              CHGDTAARA  DTAARA(&DTAARALIB/NXTMIME#) VALUE(&SEQNO) +             
  46.                           /*LTS01a*/                                            
  47.              DLCOBJ     OBJ((&DTAARALIB/NXTMIME# *DTAARA *EXCLRD))              
  48.  
© 2004-2019 by midrange.com generated in 0.013s valid xhtml & css