The purpose of this
application is to illustrate how SCL can be used to create an interactive
interface to the records in a VSAM data set. In the interest of clarity
of the code, this application does little error checking:
INIT:
/* Set the VSAMLOAD and VSAMUPDATE SAS options. */
/* Assign a fileref to the VSAM data set. */
/* Read records into a SAS data set from a VSAM KSDS. */
/* Deallocate the fileref. */
/* Open the SAS data set for processing. */
control asis;
error=0;
submit continue STATUS;
option vsamload vsamupdate;
filename myksds 'dsname.ksds.student' disp=shr;
data stdrecs;
infile myksds vsam;
input id $9.
lastname $10.
frstname $10.
address $25.
city $15.
state $2.
zip $5.
balance $5.
gpa $4.
class $2.
hrs $2.
finaid $1.;
run;
filename myksds clear;
endsubmit;
dsid=open('work.stdrecs','u');
prevrec=0;
nextrec=2;
rc=fetchobs(dsid,1);
link readval;
return;
MAIN:
/* Determine what you want to do, and perform */
/* the appropriate action. */
/* length cmd $ 10 idnum $ 9; */
length cmd $ 10;
cmd='';
put 'in MAIN - cmd = ' cmd;
call notify('RETRIEVE','_getText',cmd);
if (cmd = 'RETRIEVE') then do;
put cmd=;
link retrieve;
return;
end;
call notify('CHANGE','_getText',cmd);
if (cmd = 'CHANGE') then do;
put cmd=;
link change;
return;
end;
call notify('ADD','_getText',cmd);
if (cmd = 'ADD') then do;
put cmd=;
link add;
return;
end;
/* call notify('NEXT','_getText',cmd); */
if (cmd = 'NEXT') then do;
put cmd=;
/* link next; */
return;
end;
call notify('PREV','_getText',cmd);
if (cmd = 'PREV') then do;
put cmd=;
link prev;
return;
end;
call notify('QUIT','_getText',cmd);
if (cmd = 'QUIT') then do;
put cmd=;
goto term;
return;
end;
cmd='';
return;
TERM:
/* Close the SAS data set. Sort the SAS data set by the */
/* variable holding the VSAM key value. Delete the old */
/* VSAM data set. Create a new VSAM data set to hold */
/* the updated records. (Note: The method used here */
/* (building a SAS macro to be submitted to the operating */
/* system command processor) only works on the z/OS operating */
/* system.) Assign a fileref to the newly created VSAM data */
/* set. Write the records from the SAS data set to the VSAM */
/* data set. Deallocate the fileref. */
call close(dsid);
submit terminate;
proc sort data=work.stdrecs;
by id;
run;
x "delete ('dsname.ksds.student') purge cluster";
%let mac=%str(define cluster %(name('dsname.ksds.student') ) ;
%let mac=%mac %str(records(10 5) );
%let mac=&mac %str(recsz(90 90) );
%let mac=&mac %str(shareoptions(2,3) );
%let mac=&mac %str(reuse );
%let mac=&mac %str(volumes(APP004) );
%let mac=&mac %str(cisz(2048) );
%let mac=%mac %str(keys(9 0)%) );
%let mac=&mac %str(data );
%let mac=&mac %str(%(name('dsname.ksds.student.data') );
%let mac=&mac %str(cisz(2048)%) );
%let mac=&mac %str(index );
%let mac=&mac %str(%(name('dsname.ksds.student.index') );
%let mac=&mac %str(cisz(512)%) );
/* Submit the macro variable for execution. */
%sysexec &mac;
filename myksds 'dsname.ksds.student' disp=shr;
data _null_;
set work.stdrecs;
file myksds vsam reset;
/* Write the data from the variables in the SAS data set to */
/* the appropriate column in the current record of the KSDS. */
if id ^= ' ' then do;
put @1 id $9. /* Student's Social Security number */
@10 lastname $10. /* Student's surname */
@20 frstname $10. /* Student's given name */
@30 address $25. /* Permanent mailing address */
@55 city $15. /* City of residence */
@70 state $2. /* State of residence */
@72 zip $5. /* Five-digit ZIP code */
@77 balance $5. /* Balance from previous semester */
@82 gpa $4. /* Grade point average on a4.00 scale */
@86 class $2. /* FR, SO, JU, SE, or GR */
@88 hrs $2. /* Hours registered for in next semester */
@90 finaid $1.; /* Financial aid eligibility, Y or N */
end;
run;
filename myksds clear;
endsubmit;
return;
RETRIEVE:
/* Use a WHERE clause to subset the data set to contain only */
/* the record associated with the requested ID number. If */
/* there is an observation left in the data set, display its */
/* values. If there are no observations left in the data set, */
/* blank out any values in fields other than idnum and explain */
/* that there was no match found. */
clause="id='"||idnum||"'";
rc=where(dsid,clause);
rc=fetchobs(dsid,1);
if rc=0 then
link readval;
else do;
link blanks;
_msg_='No matching record found.';
end;
return;
CHANGE:
/* Update the values in the current observation. */
link writeval;
if error then
error=0;
else
rc=update(dsid);
return;
ADD:
/* Check to see whether a record with that SSN already exists. If */
/* so, explain. Else add a new observation to the */
/* data set and update its variables. */
clause="id='"||idnum||"'";
put clause=;
rc=where(dsid,clause);
put rc=;
rc=fetchobs(dsid,1);
put rc=;
if rc=0 then do;
_msg_='A record with that key already exists.';
_msg_='No duplicates allowed';
end ;
else do;
rc=append(dsid);
link writeval;
end;
if error then
error=0;
else
rc=update(dsid);
return;
NEXT:
put 'next - nextrec = ' nextrec;
put 'next - prevrec = ' prevrec;
rc=fetchobs(dsid,nextrec);
put rc=;
if rc=0 then do;
prevrec=prevrec+1;
nextrec=nextrec+1;
link readval;
end;
else
_msg_='NOTE: At bottom.';
return;
PREV:
put 'prev - nextrec = ' nextrec;
put 'prev - prevrec = ' prevrec;
if prevrec>0 then do;
rc=fetchobs(dsid,prevrec);
put rc=;
if rc=0 then do;
prevrec=prevrec-1;
nextrec=nextrec-1;
link readval;
end;
else
_msg_='NOTE: At top.';
end;
else
_msg_='NOTE: At top.';
return;
BLANKS:
/* Blank out all values on the screen. */
idnum ='';
lname ='';
fname ='';
address= '';
city ='';
s ='';
zip ='';
bal ='';
gpa ='';
c ='';
h ='';
fa ='';
return;
READVAL:
/* Assign the screen variables the values contained in the */
/* current observation. */
idnum =getvarc(dsid,1);
lname =getvarc(dsid,2);
fname =getvarc(dsid,3);
address= getvarc(dsid,4);
city =getvarc(dsid,5);
s =getvarc(dsid,6);
zip =getvarc(dsid,7);
bal =put(input(getvarc(dsid,8),5.),dollar10.2);
gpa =getvarc(dsid,9);
c =getvarc(dsid,10);
h =getvarc(dsid,11);
if getvarc(dsid,12)='Y' then
fa='Yes';
else
fa='No';
return;
WRITEVAL:
/* Write the values contained in the screen variables to the */
/* variables in the current observation. */
length tempbal $ 10;
call putvarc(dsid,1,idnum);
call putvarc(dsid,2,lname);
call putvarc(dsid,3,fname);
call putvarc(dsid,4,address);
call putvarc(dsid,5,city);
call putvarc(dsid,6,s);
call putvarc(dsid,7,zip);
tempbal=substr(bal,2);
pos=index(tempbal,',');
if pos>0 then
tempbal=substr(tempbal,1,pos-1)||substr(tempbal,pos+1);
tempbal=substr(tempbal,1,index(tempbal,'.')-1);
call putvarc(dsid,8,tempbal);
call putvarc(dsid,9,gpa);
call putvarc(dsid,10,c);
call putvarc(dsid,11,h);
temp=upcase(substr(fa,1,1));
if (temp='Y') | (temp='N') then
call putvarc(dsid,12,temp);
else do;
_msg_='Invalid value for Financial Aid Eligibility,(Yes or No)';
error=1;
end;
return;