/**********************************************************************/
array words {3} $ 40 word1-word3;
array teststr {*} $ 12 ('AN','AND',. . . ,'CORPORATION',
'DEPARTMENT',. . .);
/* more SAS statements */
/**********************************************************************/
TERM:
/*-------------------------------------------------+
| Fill in the first two positions of the customer |
| number with the first two characters of the |
| ZIP code. |
+-------------------------------------------------*/
substr(custno,1,2)=left(czip);
/**********************************************************************/
/*----------------------------------------------------+
| Determine whether to use company name or customer's |
| first and last names. |
+----------------------------------------------------*/
if company ~=' '
then wordstr=company;
else wordstr=trim(left(fname))||' '||
trim(left(lname));
/*----------------------------------------------------+
| Process word string by removing all of the special |
| characters except '/' and '-'. Convert these two |
| into blanks. |
+----------------------------------------------------*/
wordstr=upcase(compress(wordstr,'&=<>@+#|?${}~|_().,*'));
wordstr=translate(wordstr,' ','/');
wordstr=translate(wordstr,' ','-');
word1=' ';
word2=' ';
word3=' ';
/**********************************************************************/
/*-----------------------------------------------------+
| Read in the words from the company or customer name. |
+-----------------------------------------------------*/
n=1;
cnt=1;
do until (word=' ');
word=scan(wordstr,n);
if ~(word in teststr) then do;
if cnt>3 then leave;
words(cnt)=word;
cnt+1;
end;
if cnt>3 then leave;
n+1;
end;
/**********************************************************************/
/*-------------------------------------------------+
| Assign the character values to the third and |
| fourth positions. |
+-------------------------------------------------*/
substr(custno,3,3)='000';
if length(word1)>0 then do;
if length(word1)=1 then substr(custno,3,1)=word1;
else if length(word1)=2 then substr(custno,3,2)=word1
else substr(custno,3,3)=word1;
end;
/*------------------------------------------------------+
| Fill in the fifth position with the first character |
| of the last name. If the first word of the customer's |
| or company's name is only one character in length, |
| fill in the fourth and fifth positions with the first |
| and second characters of the last name. |
+------------------------------------------------------*/
if length(word2)>0 then substr(custno,5,1)=word2;
/* more SAS statements */
/**********************************************************************/
/*------------------------+
| Handling special cases. |
+------------------------*/
if length(word1)=1 then do;
if length(word2)>1 then do;
substr(custno,4,2)=word2;
end;
else do;
substr(custno,4,2)='00';
if length(word2)>0 then substr(custno,4,1)=word2;
if length(word3)>0 then substr(custno,5,1)=word3;
end;
end;
return;
/**********************************************************************/
INIT:
/*-----------------------------------+
| Define the dynamic extended table. |
+-----------------------------------*/
call setrow(0,1,'N','Y');
control always;
return;
/**********************************************************************/
MAIN:
/* more SAS statements */
/*----------------------------+
| Build the new WHERE clause. |
+----------------------------*/
if length(cust) < 7
then do;
wherestr="CUSTNO CONTAINS '"||trim(left(cust))||"'";
if cust=' ' then wherestr="CUSTNO='XXXXXXX'";
end;
else wherestr="CUSTNO='"||trim(left(cust))||"'";
/*------------------------+
| Apply the WHERE clause. |
+------------------------*/
if (modified(cust) | cust~=' ') then do;
rc=where(cdbdsid,wherestr);
end;
return;
/**********************************************************************/
GETROW:
/*----------------------------------------------+
| If the application returns -1, the end of the |
| data meeting the criteria has been reached. |
+----------------------------------------------*/
if fetchobs(cdbdsid,_currow_)=-1 then do;
call endtable();
end;
return;
/**********************************************************************/
PUTROW:
/*---------------------------------------------------+
|Perform the desired action if Y, N, or F is entered.|
+---------------------------------------------------*/
select(selvar);
/*------------------------------------------------+
|If a set of data is selected, set flag and end. |
+------------------------------------------------*/
when('Y') do;
selflg=1;
end;
when('N') do;
selflg=1;
end;
when('F') do;
selflg=1;
end;
/*-------------------------------------------------+
|If an inappropriate value is entered, ignore it |
|and remain. |
+-------------------------------------------------*/
otherwise do;
rc=unselect(_currow_);
selflg=0;
cursor selvar;
end;
end;
/*-------------------------------------------------+
| Set the selected observation. |
+-------------------------------------------------*/
if selected(_currow_) then selobs=_currow_;
return;
/**********************************************************************/
entry optional=custno czip company salute fname
mname lname $;
INIT:
/*----------------------------------------------+
| Open the master file so the data can be added.|
+----------------------------------------------*/
cdbdsid=open('PUBCDB.MASTER','u');
call set(cdbdsid);
/* more SAS statements */
/*----------------------------------------------+
| Link to a routine that looks up the next |
| available customer number. |
+----------------------------------------------*/
link process;
control always;
return;
/**********************************************************************/
TERM:
/*------------------------------+
| Test for required fields. |
+------------------------------*/
if company=' ' & fname=' ' & lname=' ' then do;
_msg_='Note: Shipping Company or Name required.';
cursor company;
_status_='R';
return;
end;
/* more SAS statements */
/*------------------------------+
| Append the new observation |
| and close the master file. |
+------------------------------*/
rc=append(cdbdsid);
rc=close(cdbdsid);
/* more SAS statements */
return;
/**********************************************************************/
process:
/* more SAS statements */
root=substr(custno,1,5);
/*-----------------------------------------+
| Change the WHERE clause to match the new |
| root. |
+-----------------------------------------*/
rc=where(cdbdsid,"CUSTNO LIKE '"||root||"%'");
i=0;
*/-----------------------------------------+
| Find the next available sequence number |
| in the master database. |
+-----------------------------------------*/
do until(done);
i=i+1;
rc=where(cdbdsid,
"CUSTNO='"||root||trim(left(put
(i,z2.)))||"'");
done=(fetch(cdbdsid,'noset')=\minus 1);
end;
/*-----------------------------------------+
| Add the sequence number to the root of |
| the customer number. |
+-----------------------------------------*/
custno=root||put(i,z2.);
return;
/**********************************************************************/
entry optional=custno $;
INIT:
/*----------------------+
| Open the master file. |
+----------------------*/
cdbdsid=open('PUBCDB.MASTER(CNTLLEV=RECORD)','i');
call set(cdbdsid);
/*----------------------------------+
| Build and apply the WHERE clause. |
+----------------------------------*/
wherestr="CUSTNO='"||custno||"'";
rc=where(cdbdsid,wherestr);
/*---------------------------------+
| Fetch the observation. |
+---------------------------------*/
rc=fetch(cdbdsid);
return;
main:
return;
term:
/*-----------------------------+
| Close the master file. |
+------------------------------*/
rc=close(cdbdsid);
return;
/**********************************************************************/
entry optional=custno szip company salute fname
mname lname $;
INIT:
/*-------------------------------+
| Open the master file for edit. |
+-------------------------------*/
cdbdsid=open('PUBCDB.MASTER','u');
call set(cdbdsid);
/*-----------------------------------+
| Build and apply the WHERE clause. |
+-----------------------------------*/
wherestr="CUSTNO='"||custno||"'";
rc=where(cdbdsid,wherestr);
rc=fetch(cdbdsid);
/* more SAS statements */
control always;
return;
/**********************************************************************/
TERM:
/* more SAS statements */
/*----------------------------------------------+
| Update the changes and close the master file. |
+----------------------------------------------*/
rc=update(cdbdsid);
rc=close(cdbdsid);
return;
/**********************************************************************/