INIT:                                                       
                                                            
      /* Get the parameter list.                          */
   entry myparms 8;                                         
   length msg $200;                                         
return;                                                     
                                                            
MAIN:                                                       
                                                            
      /* Get the parameters, execute the program, and     */
      /* assign any return values.                        */
   link getparms;                                           
   link execute;                                            
   link setparms;                                           
return;                                                     
                                                            
TERM:                                                       
return;                                                     
                                                            
GETPARMS:                                                   
                                                            
      /* Strip off any supplied parameters.               */
   dsid=getnitemn(myparms,'DSID',1,1,0);                    
   if not dsid then                                         
      dsname=getnitemc(myparms,'DSNAME',1,1,                
             optgetc('_LAST_'));                            
   obs=getnitemn(myparms,'OBS',1,1,1);                      
   time=getnitemn(myparms,'TIME',1,1,1);                    
   maxtrys=getnitemn(myparms,'TRYS',1,1,9999);              
   modvar=getnitemc(myparms,'VARIABLE',1,1,' ');            
   modamt=getnitemn(myparms,'AMOUNT',1,1,0);                

      /* Delete any premature return values, possibly     */
      /* due to an earlier call.                          */
   if nameditem(myparms,'MESSAGE') then                     
      rc=delnitem(myparms,'MESSAGE'); 
   if nameditem(myparms,'SUCCESS') then                      
      rc=delnitem(myparms,'SUCCESS');                        
return;                                                      
                                                             
EXECUTE:                                                     
                                                             
      /* Assume no success.                               */ 
   success=0;                                                
                                                             
      /* If a DSID was not supplied, create one           */ 
      /* for the named data set.                          */ 
   if not dsid then                                          
      dsid=open(dsname);                                     
                                                             
      /* If a DSID was either found or created, try to    */ 
      /* lock the observation.                            */ 
   if dsid then do;                                          
                                                             
         /* Starting now, we have not tried and           */ 
         /* no time has elapsed.                          */ 
      try=0;                                                 
      elapse=0;                                              
      start=time();                                          
                                                             
         /* While we have not locked it, exceeded         */ 
         /* our allotted tries or time, try again.        */ 
      do while((elapse < time) and (try < maxtrys)           
         and (not success));                                 
         rc=fetchobs(dsid,obs);                              

            /* If the update was not successful,          */ 
            /* we do not have a lock.                     */ 
         if update(dsid) then do;                            
                                                             
               /* Note why the update failed, increment   */ 
               /* our number of tries, and calculate the  */ 
               /* elapsed time.                           */ 
            msg=sysmsg();                                    
            elapse=time() - start;                           
            try=try + 1;                                     
            end;                                             
                                                             
            /* Or else we have locked it.                 */ 
         else do;                                            
                                                             
               /* Note the success and modify any         */ 
               /* specified variable.                     */ 
            success=1;                                       
            if modvar not= ' ' then do;                      

                  /* If the variable exists, add some     */ 
                  /* amount to it.                        */ 
               vnum=varnum(dsid,modvar);                     
               if vnum then do;                              
                                                             
                     /* Note the new value and save that  */ 
                     /* value in the data set.            */ 
                  newvalue=getvarn(dsid,vnum) + modamt;      
                  call putvarn(dsid,vnum,newvalue);          
                  rc=update(dsid);
                end;                                        
             end;                                           
          end;                                              
       end;                                                 
    end;                                                    
 return;                                                    
                                                            
SETPARMS:                                                   
                                                            
      /* Note the success or reason for failure.          */
   if success then                                          
      rc=setnitemn(myparms,1,'SUCCESS');                    
   else                                                     
      rc=setnitemc(myparms,msg,'MESSAGE');                  
                                                            
      /* If the DSID was not supplied, send one back.     */
   if not dsid then                                         
      rc=setnitemn(myparms,dsid,'DSID');                    
                                                            
      /* Note the new value.                              */
rc=setnitemn(myparms,newvalue,'NEWVALUE');                  
return;


/**********************************************************************/


      /* Open the data set containing the current         */
      /* unique TWNUM number.                             */
   poolid=open('pubtkda.pool','U');                         
                                                            
      /* Make a list to act as the parameter for GETLOCK. */
   poolparm=makelist();                                     
                                                            
      /* The opened DSID is the DSID to use in GETLOCK.   */
   rc=setnitemn(poolparm,poolid,'DSID');                    
                                                            
      /* The variable containing the current unique       */
      /* TWNUM number is named NUMBER.                    */
   rc=setnitemc(poolparm,'NUMBER','VARIABLE');              
                                                            
      /* Add 1 to the current value for each              */
      /* call to GETLOCK.                                 */
   rc=setnitemn(poolparm,1,'AMOUNT');                       

      /* Use observation 1, where the description of the  */
      /* number is TWNUM.                                 */
   rc=where(poolid,'DESCRIP="TWNUM"');                      
 return;


/**********************************************************************/


      /* If the observation is new, get the next          */
      /* available TWNUM number.                          */
   if obsinfo('NEW') then do;                               
                                                            
         /* Call GETLOCK to get the next number.          */
      call display('getlock.scl',poolparm);                 
                                                            
         /* The TWNUM is the returned number              */
         /* with a TW appended.                           */
      twnum=trim(left(put(getnitemn                         
                (poolparm,'NEWVALUE'),8.))) || 'TW';        
                                                            
         /* Be sure to unlock the locked observation.     */
      rc=unlock(poolid);                                    
   end;                                                     


/**********************************************************************/