SAS Component Language (SCL) Application |
The following sample application is referred to in SCL Programming Considerations. See that section for more information about updating concurrently shared data in SCL applications.
/*-------------------------------------------------------------------- * Inventory/Order System SCL application for use with PROC FSEDIT * when editing an orders data set. * * CAUTION: * + The deletion of a non-null order (quantity>0) results in an * error message being written to the SAS log because the inventory * data set will not have been updated to reflect the returned * inventory. * + Do not issue a DELETE command to cancel a new order (not yet added to the * data set ORDERS). In this case, the * program will not detect a cancel or delete condition and will * debit the inventory for the quantity in the cancelled order. * * The SCL program included here is designed to run with the following * set up and data set prototype: * * The data set ORDERS has these variables: * * o PRODUCT type=character /* Product Code */ * o QUANTITY type=numeric /* Amount of Order */ * * The INVENTOR data set has these variables: * * o CODE type=character /* Product Code */ * o DESC type=character /* Product Description */ * o INVENT type=numeric /* Stock on hand */ * * * * For information about selecting a communications access method * and server name, see Chapter 3. * To start a SAS/SHARE server to access the data that is used by this * example, execute these SAS statements in a SAS session: * * OPTIONS COMAMID=communications access method; * LIBNAME DLIB 'physical name'; * DATA DLIB.INVENTOR; * CODE='ABC'; DESC='PRODUCT ABC'; INVENT=100; * RUN; * DATA DLIB.ORDERS; * PRODUCT='ABC'; QUANTITY=20; * RUN; * PROC SERVER ID=server name; RUN; * * To create a client SAS session that you can use to execute this * example, execute these SAS statements in a second SAS session: * * OPTIONS COMAMID=communications access method; * LIBNAME DLIB SERVER=optional computer name.server name; * /* EDIT AND COMPILE SCL PROGRAM ON SCREEN AND RUN IT */ * PROC FSEDIT DATA=DLIB.ORDERS * SCREEN=DLIB.DISPLAY.ORDERS.SCREEN; RUN; *------------------------------------------------------------------*/ length rc 8 ; /* System return code storage */ length invent 8 ; /* Current n of items inventoried*/ FSEINIT: /*---------------------------------------------------------------- / Open the product control data set and save the needed variable / numbers. "Control term" ensures non-null deletions can be / detected in TERM. /---------------------------------------------------------------*/ codeid=open('dlib.inventor','U'); vdesc=varnum(codeid,'desc'); vinvent=varnum(codeid,'invent'); control term; return; INIT: /*---------------------------------------------------------------- / Save initial order values for later. For a pre-existing order, / get the inventory info (item description) for the display, and / do not forget to unlock the record. Also prohibit *changing* / the product code on a pre-existing order by using the FIELD / function. /---------------------------------------------------------------*/ _msg_=' '; sav_prod=product; sav_quan=quantity; if (obsinfo('new')) then do; oldorder=0; rc=field('unprotect','product'); if (product=' ') then link needcode; return; end; oldorder=1; link getrec; rc=unlock(codeid); rc=field('protect','product'); return; MAIN: /*---------------------------------------------------------------- / For a change in quantity or for a new order, fetch (and lock) the / inventory record, validate the request, and update the / inventory data set. In either case, if all operations succeed, / issue a SAVE command in the primary data set so that the data set / cannot be made out-of-sync with the inventory due to a / subsequent CANCEL command from the user. /---------------------------------------------------------------*/ if (_STATUS_='C') then return; else if (product=' ') then link needcode; else if (sav_quan^=quantity or ^oldorder) then do; /* Try to lock inventory record to update. */ loop_cnt=0; lokloop: loop_cnt=loop_cnt+1; link getrec; if (not gotrec) then return; if (rc=%sysrc(_swnoupd)) then do; if (loop_cnt<500) then goto lokloop; _msg_='Error: Product was locked.'; erroron product; return; end; /* Check and debit the inventory. */ link chkquan; if (not quanok) then goto unlok; invent=invent-quantity; call putvarn(codeid,vinvent,invent); rc=update(codeid); if (sysrc()>0) then do; _msg_=sysmsg(); erroron product; goto unlok; end; /* Force FSEDIT to save the observation so that */ /* the primary data set will be up-to-date now. */ call execcmd('save;'); /* In case user did not leave observation, */ /* clarify that this order is saved. */ sav_prod=product; sav_quan=quantity; oldorder=1; unlok: rc=unlock(codeid); end; return; getrec: /*---------------------------------------------------------------- / Usually, this section fetches the record of the inventory / data set that you want. If it is successful, 'gotrec' / will have value 1; else, 0. This section leaves the fetched / record locked. /---------------------------------------------------------------*/ gotrec=0; rc=WHERE(codeid,"code='"||product||" '"); if (rc>0) then do; _msg_='WHERE: '||sysmsg(); erroron product; return; end; rc=FETCH(codeid); if (rc>0) then do; /* Error! */ _msg_='FETCH: '||sysmsg(); erroron product; return; end; else if (rc=-1) then do; /* Product not found but no error. */ _msg_='ERROR: The product code is invalid. Please re-enter'; erroron product; return; end; else gotrec=1; desc=getvarc(codeid,vdesc); invent=getvarn(codeid,vinvent); return; chkquan: /* Check the amount available */ /*---------------------------------------------------------------- / This section checks that the available inventory is sufficient / for the quantity that is being requested. If so, 'quanok' will / have value 1; else, 0. This section may modify 'invent' if a / quantity change is being verified. /---------------------------------------------------------------*/ quanok=1; /* If just a quantity change, add back old quantity. */ if (oldorder) then invent=invent+sav_quan; if (quantity=0) then do; _msg_='This order is null due to a zero quantity'; cursor quantity; end; else if (quantity>invent) then do; _msg_='ERROR: Available stock is ' || put(invent,best.); erroron quantity; quanok=0; end; return; needcode: /*---------------------------------------------------------------- / Ask user to enter product code. Set ERRORON to prevent exiting / the observation. /---------------------------------------------------------------*/ _msg_='Please enter a product code'; desc=' '; erroron product; return; TERM: /*---------------------------------------------------------------- / For safety, check if the user accidentally deleted a non-null / observation, which we are leaving, and log an error message if so. /-----------------------------------------------------------------*/ if (oldorder & sav_quan & obsinfo('deleted')) then put 'ERROR: Order consisting of ' sav_quan 'units of product number ' sav_prod 'has been deleted.'; return; FSETERM: /*---------------------------------------------------------------- / Termination: Close the lookup data set if it was / successfully opened. /---------------------------------------------------------------*/ if (codeid>0) then rc=close(codeid); return;
Copyright © 2007 by SAS Institute Inc., Cary, NC, USA. All rights reserved.