Comparative procedures

The procedure-based sample application consists of several procedure files. Most of these files represent persistent procedures (procedure objects), and two of the files represent separate main-line procedures, each of which drives the application in a manner corresponding to one of the two Main class constructors in the class-based sample. The procedure objects also form super procedure relationships that are similar to the class hierarchies defined in the class-based sample. The following is a description of the relationships among these procedures, where ProcObject refers to a procedure object:

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

The descriptions and code listings for these files follow.

This is the top-level super procedure that provides common error handler and time-tracking routines:

CommonProc.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 */
VAR HANDLE hMsg.

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.

This is a procedure that extends CommonProc.p to provide general functionality for handling customers and is a super procedure for the NECustProc.p procedure, that handles New England customers:

CustProc.p

/* Main Block */                                                   /* 2 */
DEFINE NEW SHARED VARIABLE dtTimestamp AS DATETIME NO-UNDO.        /* 5 */
DEFINE     SHARED VARIABLE iNumCusts AS INTEGER  NO-UNDO.

VAR HANDLE hCommon.
VAR HANDLE hCreditProc.
VAR HANDLE hMsg.

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.
  VAR INT iCnt.
  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.

This procedure extends CustProc.p to handle New England customers by overriding the GetCustomerName procedure to return the customer’s E-mail address along with their name:

NECustProc.p 
DEFINE INPUT PARAMETER EmailFile AS CHARACTER NO-UNDO.

DEFINE NEW SHARED VARIABLE dtTimestamp AS DATETIME NO-UNDO.

VAR HANDLE hCustProc.
VAR HANDLE hCommonProc.

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.
  VAR INT iCnt.
  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.

This procedure provides a notification of customers who have exceeded their credit limit:

CreditProc.p
ROUTINE-LEVEL ON ERROR UNDO, THROW.                                /* 13 */

VAR INT TempCustNum.
VAR DECIMAL CustCreditLimit = ?.

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.

This procedure provides a common error handler for other procedures to report error information:

MsgProc.p
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 is the main driver for running the comparative procedures based on the CustProc.p procedure object:

Main.p
/** 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.
VAR HANDLE hCustProc.
VAR INT idx.
VAR INT piCustNum.
VAR CHAR pcCustName.
VAR DATETIME pdtTimeStamp.

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 is the main driver for running the comparative procedures based on the NECustProc.p procedure object:

NEMain.p
/* 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.

VAR HANDLE hCustProc.
VAR INT idx.
VAR INT piCustNum.
VAR CHAR pcCustName.
VAR DATETIME pdtTimeStamp.


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.