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


   /* Example 1 */

PROC 0 SUBSYS()                                           
SET INSTMT=&STR(IS="%INC ''''MIS.PUBTK.SRC(START)'''';")  
SAS OPTIONS ( ' NONEWS SYSPARM="SYS=&SUBSYS" &INSTMT ' ) +
    SASAUTOS ('''SASMIS.GEN.MACROS''') +                  
    CONFIG ( ' ''MIS.GEN.SOURCE(CONFIG)'' ') 


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


   /* Example 2 */

modified=0;                                                 
                                                            
      /* In the PUBTRAK application, CHECK determines if  */
      /* the user modified any field and sets the         */
      /* value of MODIFIED accordingly                    */
   link check;                                              
                                                            
if modified then do;                                        
                                                            
      /* Assign appropriate values to the WHOTW and       */
      /* UPDTTW variables.                                */
   whotw=symget('sysjobid');                                
   updttw=today();                                          
end;                                                        
return;


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


   /* Example 3 */

   /* Get the current command.                         */
cmd=upcase(word(1));                                     
                                                            
   /* Execute any custom commands.                     */
if cmd='KEEP' then link keepvals;                        
else if cmd = 'RETRIEVE' then link retvals;              


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


keepvals:                                                   
                                                            
      /* Open a temporary data set containing all         */
      /* variables on the data set being edited with      */
      /* the FSEDIT procedure.                            */
   pubskel=open('work.pubskel','U');                        
   call set(pubskel);                                       
                                                            
      /* Get the second observation (the first is used    */
      /* for sending letters).                            */
   rc=fetchobs(pubskel,2,'NOSET');                          

      /* Push the current value of all variables          */ 
      /* into the observation.                            */ 
   if update(pubskel) then do;                               
                                                             
  

   end;                                                      
                                                             
      /* We no longer want the DSID to be set,            */ 
      /* so close and then reopen the data set.           */ 
   rc=close(pubskel);                                        
   pubskel=open('work.pubskel','U');                         
                                                             
      /* Again fetch the second observation ...           */ 
   rc=fetchobs(pubskel,2);                                   
                                                             
      /* ... for all variables.  VAR is an SCL list       */ 
      /* that contains character elements, each of        */ 
      /* which names a variable to be duplicated          */ 
   i=0;                                                      
   do while(i<varlen);                                       
      i=i + 1;                                               
      name=getitemc(var,i);                                  
                                                             
            /* Put a missing value in that variable,      */ 
            /* based on the variable type.                */ 
         varnum=varnum(pubskel,name);                        
         if vartype(pubskel,varnum)='C' then                 
            call putvarc(pubskel,varnum,' '); 
         else                                                
            call putvarn(pubskel,varnum,.);                  
      end;                                                   
   end;                                                      
                                                             
      /* Push the new values (blanks on top of old        */ 
      /* values) into the data set.                       */ 
   if update(pubskel) then do;                               
                                                             


   end;                                                      
   rc=close(pubskel);                                        
   return;                                                   
                                                             
retvals:                                                     
                                                             
      /* The TWNUM does not change, even though           */ 
      /* it was either kept or blanked out when the       */ 
      /* KEEP command was issued.                         */ 
   curtw=twnum;                                              
                                                             
      /* Create the DSID for the temporary data set       */ 
      /* and pass it to the SET routine.                  */ 
   pubskel=open('work.pubskel');                             
   call set(pubskel);                                        

      /* Read in all values from the second observation   */ 
      /* (the observation KEEP placed values into).       */ 
   rc=fetchobs(pubskel,2);
   rc=close(pubskel);                                       
                                                            
      /* Be sure to keep the old TWNUM for                */
      /* this observation.                                */
   twnum=curtw;                                             
return;                                                     


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


   /* Example 4 */

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;                                                     


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


   /* Example 5 */

   /* Create an array of commands used with letters.   */
array letcmds {*} $6 ('LETTER','SEND','EDIT');           

   /* Name the location of the letters and forms       */         
   /* using the form libref.catalog.                   */
letcat='pubtklet.letter';                                         


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

                                                            
cmd=upcase(word(1));                                     
if cmd in letcmds then do;                               
                                                            
      /* Push the current values into the temporary    */
      /* data set.                                     */
   pubskel=open('work.pubskel','U');                     
   call set(pubskel);                                    
   rc=fetchobs(pubskel,1,'NOSET');                       
   rc=update(pubskel);                                   
   rc=close(pubskel);                                    

      /* Call the LETTER routine, specifying a         */
      /* letter if necessary.                          */
   if cmd ne 'LETTER' then do;                           
      let=upcase(word(2));                               
      if let ne ' ' then                                 
         call letter(letcat || '.' || let,cmd,           
                    'WORK.PUBSKEL');                     
      else                                               
         _msg_='No letter specified for the              
               ' || cmd || ' command.';                  
   end;                                                  
   else 
      call letter(letcat,'EDIT','WORK.PUBSKEL');
end; 


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


   /* Example 6 */

if (curfld() ne ' ') and (cmd=' ') then do;              
                                                            
      /* Name the field being clicked on and look up   */
      /* that field in the control data set.           */
   field=curfld();                                       
   rc=setkey(fields,'FIELD');                            
   if fetch(fields) ne %sysrc(_SWEOF) then do;           
                                                           
         /* If that field was in the control data set, */
         /* act accordingly (field is associated       */
         /* with VARNAME in the data set).             */
      varnum=varnum(pubskel,varname);                    
      vartype=vartype(pubskel,varnum);                   

         /* If the field was modified, or the          */
         /* field is such that modifications are       */
         /* not kept, then take some action.           */
      if not field('MODIFIED',field) or bksltrak='I'     
         then do;                                        

            /* Insert the current value of that        */
            /* field into a list.                      */
         templ=makelist();                               
         if vartype='C' then                             
            rc=setnitemc(templ,getvarc(pubskel,varnum),  
                        'VALUE');                        
         else                                            
            rc=setnitemn(templ,getvarn(pubskel,varnum),  
                        'VALUE');                        
                                                         
            /* Take whatever action is indicated by    */
            /* the value of HYPLOC in the control data */
            /* set for the observation corresponding   */
            /* to the field being clicked on.          */
         call method('hyprtext.scl',hyploc,templ);       
         rc=dellist(templ);                              
         end;                                            
      end;                                               
   end;                                                  
return;                                 


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