/**********************************************************************/ 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; /**********************************************************************/