ProcObject MsgProc.p
ProcObject CreditProc.p ProcObject CommonProc.p instantiates and uses MsgProc.p ProcObject CustProc.p instantiates and uses CommonProc.p as a super procedure instantiates and uses CreditProc.p uses MsgProc.p ProcObject NECustProc.p instantiates and uses CommonProc.p as a super procedure instantiates and uses CustProc.p as a super procedure Procedure Main.p instantiates and uses CustProc.p Procedure NEMain.p instantiates and uses NECustProc.p |
/* Define dtTimestamp as SHARED to illustrate the counterpart to inherited
data members in classes (#5 in Table 5.1) */ DEFINE SHARED VARIABLE dtTimestamp AS DATETIME NO-UNDO. /* 5 */ DEFINE VARIABLE hMsg AS HANDLE NO-UNDO. PROCEDURE updateTimestamp: DEFINE OUTPUT PARAMETER pdtTimeStamp AS DATETIME NO-UNDO. ASSIGN dtTimestamp = NOW pdtTimeStamp = dtTimestamp. END PROCEDURE. FUNCTION MessageHandler RETURNS HANDLE (INPUT ProcType AS CHARACTER). RUN MsgProc.p PERSISTENT SET hMsg (INPUT ProcType). RETURN hMsg. END FUNCTION. PROCEDURE CleanUp: IF VALID-HANDLE (hMsg) THEN DELETE OBJECT hMsg. END PROCEDURE. |
/* Main Block */ /* 2 */ DEFINE NEW SHARED VARIABLE dtTimestamp AS DATETIME NO-UNDO. /* 5 */ DEFINE SHARED VARIABLE iNumCusts AS INTEGER NO-UNDO. DEFINE VARIABLE hCommon AS HANDLE NO-UNDO. DEFINE VARIABLE hCreditProc AS HANDLE NO-UNDO. DEFINE VARIABLE hMsg AS HANDLE NO-UNDO. DEFINE TEMP-TABLE ttCustomer NO-UNDO /* 14 */ FIELD RecNum AS INTEGER FIELD CustNum LIKE Customer.CustNum FIELD Name LIKE Customer.Name FIELD State AS CHARACTER. RUN CommonProc.p PERSISTENT SET hCommon. /* 1 */ THIS-PROCEDURE:ADD-SUPER-PROCEDURE(hCommon). RUN CreditProc.p PERSISTENT SET hCreditProc. FUNCTION GetCreditLimit RETURNS INTEGER ( ) IN hCreditProc. FUNCTION MessageHandler RETURNS HANDLE (INPUT ProcType AS CHARACTER) IN SUPER. /* Fill temp table and get row count */ FOR EACH Customer WHERE CreditLimit > 50000: CREATE ttCustomer. ASSIGN iNumCusts = iNumCusts + 1 ttCustomer.RecNum = iNumCusts ttCustomer.CustNum = Customer.CustNum ttCustomer.Name = Customer.Name ttCustomer.State = Customer.State. END. hMsg = MessageHandler(INPUT "CustProc"). /* 3 */ PROCEDURE GetTT: /* 14 */ DEFINE OUTPUT PARAMETER TABLE FOR ttCustomer BIND. END PROCEDURE. PROCEDURE GetCustomerName: DEFINE INPUT PARAMETER piRecNum AS INTEGER NO-UNDO. DEFINE OUTPUT PARAMETER poName AS CHARACTER NO-UNDO. FIND ttCustomer WHERE ttCustomer.RecNum = piRecNum NO-ERROR. /* 15 */ IF AVAILABLE ttCustomer THEN poName = ttCustomer.Name. ELSE DO: RUN Alert IN hMsg("Customer number" + STRING(ttCustomer.RecNum) + "does not exist"). poName = ?. END. END PROCEDURE. PROCEDURE CheckCredit: IF VALID-HANDLE(hCreditProc) THEN DO: FOR EACH ttCustomer: RUN SetCurrentCustomer IN hCreditProc (ttCustomer.CustNum). RUN CheckCustCredit IN hCreditProc. RUN InfoMsg IN hMsg (ttCustomer.Name + " is in good standing." + " Credit Limit has been increased to " + STRING (GetCreditLimit( )) ). /* 12 */ CATCH e AS Progress.Lang.AppError: /* 13 */ IF e:ReturnValue = "Over Limit" THEN RUN Alert IN hMsg (ttCustomer.Name + " is on Credit Hold." + " Balance exceeds Credit Limit of " + STRING(GetCreditLimit( ))). /* 12 */ ELSE RUN Alert IN hMsg ("Customer not found"). END CATCH. END. /* FOR EACH */ END. ELSE RUN Alert IN hMsg ("Unable to check credit"). END PROCEDURE. /* dtTimestamp is a SHARED variable defined in CommonProc.p as well */ PROCEDURE printProc: /* 11 */ DEFINE INPUT PARAMETER piCopies AS INTEGER NO-UNDO. DEFINE VARIABLE iCnt AS INTEGER. OUTPUT TO PRINTER. IF piCopies <> 0 THEN DO iCnt = 1 TO ABS(piCopies): DISPLAY dtTimestamp. /* 5 */ FOR EACH ttCustomer: DISPLAY ttCustomer. END. END. OUTPUT CLOSE. IF ABS(piCopies) > 1 THEN /* 16 */ PUBLISH "OutputGenerated" (STRING(piCopies) + " copies of report sent to printer"). ELSE PUBLISH "OutputGenerated" ("One copy of report sent to printer"). END PROCEDURE. PROCEDURE logProc: DEFINE INPUT PARAMETER pcFilename AS CHARACTER NO-UNDO. OUTPUT TO VALUE(pcFilename). DISPLAY dtTimestamp. /* 5 */ FOR EACH ttCustomer: DISPLAY ttCustomer. END. OUTPUT CLOSE. PUBLISH "OutputGenerated" ("One copy of report sent to " /* 16 */ + pcFilename + " file"). END PROCEDURE. PROCEDURE CleanUp: EMPTY TEMP-TABLE ttCustomer. DELETE OBJECT hMsg. DELETE OBJECT hCreditProc. RUN CleanUp IN hCommon. DELETE OBJECT hCommon. END PROCEDURE. |
DEFINE INPUT PARAMETER EmailFile AS CHARACTER NO-UNDO.
DEFINE NEW SHARED VARIABLE dtTimestamp AS DATETIME NO-UNDO. DEFINE VARIABLE hCustProc AS HANDLE NO-UNDO. DEFINE VARIABLE hCommonProc AS HANDLE NO-UNDO. DEFINE TEMP-TABLE ttCustomer NO-UNDO REFERENCE-ONLY /* 14 */ FIELD RecNum AS INTEGER FIELD CustNum LIKE Customer.CustNum FIELD Name LIKE Customer.Name FIELD State AS CHARACTER. DEFINE TEMP-TABLE ttEmail NO-UNDO FIELD RecNum AS INTEGER FIELD Name AS CHARACTER FORMAT "X(20)" FIELD Email AS CHARACTER FORMAT "X(20)". /* Super procedures are searched in LIFO order */ RUN CommonProc.p PERSISTENT SET hCommonProc. /* 8 */ THIS-PROCEDURE:ADD-SUPER-PROCEDURE(hCommonProc). /* 7 */ RUN CustProc.p PERSISTENT SET hCustProc. /* 8 */ THIS-PROCEDURE:ADD-SUPER-PROCEDURE(hCustProc). /* 7 */ RUN GetTT (OUTPUT TABLE ttCustomer BIND). INPUT FROM VALUE(EmailFile). FOR EACH ttCustomer WHERE ttCustomer.State = "MA" OR /* 14 */ ttCustomer.State = "VT" OR ttCustomer.State = "NH" OR ttCustomer.State = "CT" OR ttCustomer.State = "RI" OR ttCustomer.State = "ME": CREATE ttEmail. ASSIGN ttEmail.RecNum = ttCustomer.RecNum ttEmail.Name = ttCustomer.Name. IMPORT ttEmail.Email. END. INPUT CLOSE. PROCEDURE GetCustomerName: /* 9 */ DEFINE INPUT PARAMETER piRecNum AS INTEGER NO-UNDO. DEFINE OUTPUT PARAMETER poName AS CHARACTER NO-UNDO. RUN SUPER(INPUT piRecNum, OUTPUT poName). FIND FIRST ttEmail WHERE ttEmail.Name = poName NO-ERROR. /* 15 */ IF AVAILABLE(ttEmail) THEN RETURN poName + ";" + ttEmail.Email. END PROCEDURE. /* dtTimestamp is a SHARED variable defined in CommonProc.p as well */ PROCEDURE printProc: /* 11 */ DEFINE INPUT PARAMETER piCopies AS INTEGER NO-UNDO. DEFINE VARIABLE iCnt AS INTEGER. OUTPUT TO PRINTER. IF piCopies <> 0 THEN DO iCnt = 1 TO ABS(piCopies): DISPLAY dtTimestamp. /* 5 */ FOR EACH ttEmail: DISPLAY ttEmail. END. END. OUTPUT CLOSE. IF ABS(piCopies) > 1 THEN /* 16 */ PUBLISH "OutputGenerated" (STRING(piCopies) + " copies of report sent to printer"). ELSE PUBLISH "OutputGenerated" ("One copy of report sent to printer"). END PROCEDURE. PROCEDURE logProc: DEFINE INPUT PARAMETER pcFilename AS CHARACTER NO-UNDO. OUTPUT TO VALUE(pcFilename). DISPLAY dtTimestamp. /* 5 */ FOR EACH ttEmail: DISPLAY ttEmail. END. OUTPUT CLOSE. PUBLISH "OutputGenerated" ("One copy of report sent to " /* 16 */ + pcFilename + " file"). END PROCEDURE. |
ROUTINE-LEVEL ON ERROR UNDO, THROW. /* 13 */
DEFINE VARIABLE TempCustNum AS INTEGER NO-UNDO. DEFINE VARIABLE CustCreditLimit AS DECIMAL NO-UNDO INITIAL ?. /* 12 */ FUNCTION GetCreditLimit RETURNS DECIMAL ( ): /* Returns the credit limit of the current customer. If there is no current customer, it returns Unknown (?). */ RETURN CustCreditLimit. END FUNCTION. FUNCTION SetCreditLimit RETURNS LOGICAL PRIVATE (INPUT iCL AS DECIMAL): /* Raise Credit Limit for Customers in good standing */ /* Current increase is $1,000 */ IF Customer.Balance > iCL THEN DO: CustCreditLimit = Customer.Creditlimit. RETURN FALSE. /* 13 */ END. ELSE DO: ASSIGN Customer.Creditlimit = iCL + 1000 CustCreditLimit = Customer.Creditlimit. RETURN TRUE. END. END FUNCTION. PROCEDURE SetCurrentCustomer: DEFINE INPUT PARAMETER iCustNum AS INTEGER NO-UNDO. FIND FIRST Customer WHERE Customer.CustNum = iCustNum NO-ERROR. /* 15 */ END PROCEDURE. PROCEDURE CheckCustCredit: IF AVAILABLE (Customer) THEN DO: IF SetCreditLimit (Customer.Creditlimit) THEN /* 12 */ RETURN "Credit Good". ELSE UNDO, THROW NEW Progress.Lang.AppError( "Over Limit" ). /* 13 */ END. ELSE UNDO, THROW NEW Progress.Lang.AppError( "No Customer" ). /* 13 */ END PROCEDURE. |
DEFINE INPUT PARAMETER ProcType AS CHARACTER NO-UNDO.
PROCEDURE Alert: DEFINE INPUT PARAMETER ErrorString AS CHARACTER NO-UNDO. MESSAGE "Error in" ProcType "!" SKIP ErrorString VIEW-AS ALERT-BOX ERROR. END PROCEDURE. PROCEDURE InfoMsg: DEFINE INPUT PARAMETER MsgString AS CHARACTER NO-UNDO. MESSAGE MsgString VIEW-AS ALERT-BOX. END PROCEDURE. |
/** This procedure drives the CustProc.p example **/ /* 10 */
/* Define iNumCusts as SHARED to illustrate the counterpart to PUBLIC data members in classes. */ DEFINE NEW SHARED VARIABLE iNumCusts AS INTEGER NO-UNDO. DEFINE VARIABLE hCustProc AS HANDLE NO-UNDO. DEFINE VARIABLE idx AS INTEGER NO-UNDO. DEFINE VARIABLE piCustNum AS INTEGER NO-UNDO. DEFINE VARIABLE pcCustName AS CHARACTER NO-UNDO. DEFINE VARIABLE pdtTimeStamp AS DATETIME NO-UNDO. DEFINE TEMP-TABLE ttCustNames NO-UNDO FIELD CustName AS CHARACTER. RUN CustProc.p PERSISTENT SET hCustProc. SUBSCRIBE TO "OutputGenerated" IN hCustProc. /* 16 */ RUN updateTimestamp IN hCustProc (OUTPUT pdtTimeStamp). /* 4 */ MESSAGE "Initializing reports for all customers at" STRING(pdtTimeStamp) VIEW-AS ALERT-BOX. DO idx = 1 TO iNumCusts: CREATE ttCustNames. RUN GetCustomerName IN hCustProc(INPUT idx, OUTPUT pcCustName). ttCustNames.CustName = pcCustName. END. RUN CheckCredit IN hCustProc. RUN printProc IN hCustProc. RUN logProc IN hCustProc ("CustomersProc.out"). RUN CleanUp IN hCustProc. /* 6 */ DELETE OBJECT hCustProc. PROCEDURE OutputGenerated: /* 16 */ DEFINE INPUT PARAMETER pcOutputType AS CHARACTER NO-UNDO. MESSAGE pcOutputType "for all customers." VIEW-AS ALERT-BOX. END PROCEDURE. |
/* This procedure drives the NECustProc.p example */ /* 10 */
/* Define iNumCusts as SHARED to illustrate the counterpart to PUBLIC data members in classes. */ DEFINE NEW SHARED VARIABLE iNumCusts AS INTEGER NO-UNDO. DEFINE VARIABLE hCustProc AS HANDLE NO-UNDO. DEFINE VARIABLE idx AS INTEGER NO-UNDO. DEFINE VARIABLE piCustNum AS INTEGER NO-UNDO. DEFINE VARIABLE pcCustName AS CHARACTER NO-UNDO. DEFINE VARIABLE pdtTimeStamp AS DATETIME NO-UNDO. DEFINE TEMP-TABLE ttCustNames NO-UNDO FIELD CustName AS CHARACTER. RUN NECustProc.p PERSISTENT SET hCustProc ("email.txt"). SUBSCRIBE TO "OutputGenerated" IN hCustProc. /* 16 */ RUN updateTimestamp IN hCustProc (OUTPUT pdtTimeStamp). /* 4 */ MESSAGE "Initializing reports for New England customers at" STRING(pdtTimeStamp) VIEW-AS ALERT-BOX. DO idx = 1 TO iNumCusts: CREATE ttCustNames. RUN GetCustomerName IN hCustProc (INPUT idx, OUTPUT pcCustName). ttCustNames.CustName = pcCustName. END. RUN CheckCredit IN hCustProc. RUN printProc IN hCustProc (2). RUN logProc IN hCustProc ("NECustomersProc.out"). RUN CleanUp IN hCustProc. /* 6 */ DELETE OBJECT hCustProc. PROCEDURE OutputGenerated: /* 16 */ DEFINE INPUT PARAMETER pcOutputType AS CHARACTER NO-UNDO. MESSAGE pcOutputType "for New England customers." VIEW-AS ALERT-BOX. END PROCEDURE. |