Example of a REXX Panel Program

/* data base */
ACCOUNT.1234561     = '1231 John W. Smith Mr.'
ACCOUNT.1234562     = '1232 Jane M. Brown Miss'
ACCOUNT.1234563     = '1233 Mary R. Scott Mrs.'

MESSAGE = ''          /* no output message yet */
COMPANYNAME = 'ACME On-Line Tax Services'
CURS_NAME = 'ACCOUNT_NUM'   /* put cursor on LNAME field */
ATTR_STRING = ''      /* no dynamic attributes on first send */
PATH_NAME = 'FILE(POOL1:\USERS\BLAKELY)'
CLR_INP_FIELDS = 'CLR'
  'PANEL SEND SIGNON' CLR_INP_FIELDS PATH_NAME ,
        'CURSOR(' CURS_NAME ')' ATTR_STRING
  IF RC > 4 THEN  /* more than a warning */
    SIGNAL ERROR  /* clean up and exit */
  'PANEL RECEIVE SIGNON '
  IF RC > 4 THEN
    SIGNAL ERROR  /* clean up and exit */
    ITERATE                /* redisplay panel */

  CLR_INP_FIELDS = ''   /* display input fields with variable values */
  IF &lnot;SEARCH(ACCOUNT_NUM) THEN      /* search for account number */
    DO;
      MESSAGE = ' Account Number not found, Please re-ENTER Number'
      CURS_NAME = 'ACCOUNT_NUM'  /* put cursor in ACCOUNT field */
      ATTR_STRING = 'ATTR( ACCOUNT_NUM REV)'
      ITERATE
    END;
    DO;
      MESSAGE = ' PIN Number is incorrect, Please check to see your',
      'Account Number is correct and re-ENTER your PIN';
      CURS_NAME = 'PIN';
      ATTR_STRING = 'ATTR( PIN REV)';
      ITERATE ; /* display the panel again */
    END;
 LEAVE ;
END ; /* forever */
DISP_DATE = DATE('U');     /* set to display current date */
MSG.1 = 'Be sure cursor is in the first column!';
MSG.2 = 'Press ENTER or and PF key to continue.';
SALUTATION = 'Hi' WORD(ACCOUNT.ACCOUNT_NUM,5) ,
                WORD(ACCOUNT.ACCOUNT_NUM,4) ||,
            ', How may we be a service to you?';
  PAN.CNAM = '';
  'PANEL SEND SERVICE CURSOR(SERVICE.1)' PATH_NAME
  IF RC > 4 THEN
    SIGNAL ERROR; /* clean up and exit */
  'PANEL RECEIVE SERVICE'
  IF RC > 4 THEN
    SIGNAL ERROR; /* clean up and exit */
  SALUTATION = '';  /* greeting only once */
    WHEN PAN.CNAM = 'SERVICE.1' THEN
       CALL ITEMIZE_ROUTINE;
    WHEN PAN.CNAM = 'SERVICE.2' THEN
       CALL NON_ITEMIZE_ROUTINE;
    WHEN PAN.CNAM = 'SERVICE.3' THEN
       CALL QUERY_RET_ROUTINE;
    WHEN PAN.CNAM = 'SERVICE.4' THEN
       CALL CAL;
    WHEN PAN.CNAM = 'SERVICE.5' THEN
       CALL EXIT_ROUTINE;
      DO;
        'PANEL SEND MSGBOX2 POS(7 10) NOERASE' PATH_NAME
        IF RC > 4 THEN
          SIGNAL ERROR;
        'PANEL RECEIVE MSGBOX2'
        IF RC > 4 THEN
          SIGNAL ERROR;
      END;
  END; /* select */
END; /* do forever */
EXIT
IF SYMBOL('ACCOUNT.ACC_NUM') == 'VAR' THEN
  RETURN(1)
ELSE
  RETURN(0);
NON_ITEMIZE_ROUTINE:
QUERY_RET_ROUTINE:
'PANEL SEND MSGBOX1 POS(7 10) NOERASE' PATH_NAME
 IF RC > 4 THEN
   SIGNAL ERROR;
'PANEL RECEIVE MSGBOX1'
IF RC > 4 THEN
  SIGNAL ERROR;
RETURN;
COMPANYNAME = 'ACME On-Line Tax Service';
PATH_NAME   = 'FILE(POOL1:\USERS\BLAKELY\)'
DISP_DATE = DATE('U');

/* calling date function in on statement ensures consistent date */
/* data save has format of YYYYMMDDNNNNNN                        */
DATE_SAVE = DATE('S') || DATE('B');
NUM_OF_DAYS.1 = 31;
NUM_OF_DAYS.3 = 31;
NUM_OF_DAYS.4 = 30;
NUM_OF_DAYS.5 = 31;
NUM_OF_DAYS.6 = 30;
NUM_OF_DAYS.7 = 31;
NUM_OF_DAYS.8 = 31;
NUM_OF_DAYS.9 = 30;
NUM_OF_DAYS.10 = 31;
NUM_OF_DAYS.11 = 30;
NUM_OF_DAYS.12 = 31;
MONTH_NAME.1 = 'January';
MONTH_NAME.2 = 'February';
MONTH_NAME.3 = 'March';
MONTH_NAME.4 = 'April';
MONTH_NAME.5 = 'May';
MONTH_NAME.6 = 'June';
MONTH_NAME.7 = 'July';
MONTH_NAME.8 = 'August';
MONTH_NAME.9 = 'September';
MONTH_NAME.10 = 'October';
MONTH_NAME.11 = 'November';
MONTH_NAME.12 = 'December';
TOT_DAYS = SUBSTR(DATE_SAVE,9,6)-SUBSTR(DATE_SAVE,7,2) +1;

/* save current year and month to highlight today date on display */
CUR_YEAR = SUBSTR(DATE_SAVE,1,4);
/* get month part of date. adding 0 strips the leading zero */
CUR_MONTH = SUBSTR(DATE_SAVE,5,2) +0;

YEAR = CUR_YEAR;/* these variables will change with whats displayed */
MONTH = CUR_MONTH;

IF YEAR // 400  &lnot;= 0  & YEAR // 4 = 0 THEN /* leap year? */
  NUM_OF_DAYS.2 = 29;
ELSE
  NUM_OF_DAYS.2 = 28;
FIRST_WEEKDAY = (TOT_DAYS+1) // 7;
FIRST_WEEKDAY_SAVE = FIRST_WEEKDAY;

DISP_CENTER_MON = MONTH_NAME.MONTH; /* center display month name */
CENTER_DAYS. = ''; /* null out all unused month days */
/* starting at the first weekday of the month fill in center month */
DO I = FIRST_WEEKDAY+1 TO NUM_OF_DAYS.MONTH + FIRST_WEEKDAY ;
  CENTER_DAYS.I = I - FIRST_WEEKDAY;
END;
IF MONTH = 1 THEN
  LEFT_MONTH = 12;
ELSE
  LEFT_MONTH = MONTH - 1;

DISP_LEFT_MON = MONTH_NAME.LEFT_MONTH;  /* left display month name */
FIRST_WEEKDAY = (TOT_DAYS - NUM_OF_DAYS.LEFT_MONTH+1) // 7;
LEFT_DAYS. = '';
DO I = FIRST_WEEKDAY+1 TO NUM_OF_DAYS.LEFT_MONTH + FIRST_WEEKDAY ;
  LEFT_DAYS.I = I - FIRST_WEEKDAY;
END;
FIRST_WEEKDAY = (TOT_DAYS + NUM_OF_DAYS.MONTH +1) // 7;
IF MONTH = 12 THEN
  RIGHT_MONTH = 1;
ELSE
  RIGHT_MONTH = MONTH + 1;
DISP_RIGHT_MON = MONTH_NAME.RIGHT_MONTH; /* right display month name */
RIGHT_DAYS. = '';
DO I = FIRST_WEEKDAY+1 TO NUM_OF_DAYS.RIGHT_MONTH + FIRST_WEEKDAY ;
  RIGHT_DAYS.I = I - FIRST_WEEKDAY;
END;
ATTR_STRING = 'ATTRIB(' CUR_DAY_FIELD 'RED )' ;

 'PANEL SEND CALENDAR' PATH_NAME ATTR_STRING
 'PANEL RECEIVE CALENDAR'
  IF PAN.AID = 'PF3' THEN
    RETURN;

  IF PAN.AID = 'PF7' THEN /* go back one month request */
    DO;
      IF MONTH = 1 THEN  /* always keep track of center month */
        DO;
          MONTH = 12;
          YEAR = YEAR - 1;
          IF YEAR // 400  &lnot;= 0  &  YEAR // 4  = 0  THEN /* leap year? */
            NUM_OF_DAYS.2 = 29;
          ELSE
            NUM_OF_DAYS.2 = 28;
        END;
        MONTH = MONTH - 1;
      TOT_DAYS = TOT_DAYS - NUM_OF_DAYS.MONTH;
      DISP_RIGHT_MON = DISP_CENTER_MON;
      DISP_CENTER_MON = DISP_LEFT_MON;
      DO I = 1 TO 37;
        RIGHT_DAYS.I = CENTER_DAYS.I;
        CENTER_DAYS.I = LEFT_DAYS.I;
      END;
        LEFT_MONTH = 12;
      ELSE
        LEFT_MONTH = MONTH - 1;
      FIRST_WEEKDAY = (TOT_DAYS - NUM_OF_DAYS.LEFT_MONTH +1) // 7;
      DISP_LEFT_MON = MONTH_NAME.LEFT_MONTH;
      LEFT_DAYS. = '';
      DO I = FIRST_WEEKDAY+1 TO NUM_OF_DAYS.LEFT_MONTH + FIRST_WEEKDAY ;
        LEFT_DAYS.I = I - FIRST_WEEKDAY;
      END;
    END; /* if pan.aid = 'pf7' */
  ELSE
    DO;
      TOT_DAYS = TOT_DAYS + NUM_OF_DAYS.MONTH;
      IF MONTH = 12 THEN  /* always keep track of center month */
        DO;
          MONTH = 1;
          YEAR = YEAR + 1;
          IF YEAR // 400  &lnot;= 0  &  YEAR // 4  = 0  THEN /* leap year? */
            NUM_OF_DAYS.2 = 29;
          ELSE
            NUM_OF_DAYS.2 = 28;
        END;
      ELSE
        MONTH = MONTH + 1;
      DISP_CENTER_MON = DISP_RIGHT_MON;
      DO I = 1 TO 37
        LEFT_DAYS.I = CENTER_DAYS.I; /* shift the months to left    */
        CENTER_DAYS.I = RIGHT_DAYS.I;
      END;

      IF MONTH = 12 THEN  /* need a new right month  */
        RIGHT_MONTH = 1;
      ELSE
        RIGHT_MONTH = MONTH + 1;
      FIRST_WEEKDAY = (TOT_DAYS + NUM_OF_DAYS.MONTH +1) // 7;
      RIGHT_DAYS. = '';
      DO I = FIRST_WEEKDAY+1 TO NUM_OF_DAYS.RIGHT_MONTH + FIRST_WEEKDAY;
        RIGHT_DAYS.I = I - FIRST_WEEKDAY;
      END;
    END; /* if pan.aid = 'pf8'  */
/* and set it to red.                                               */

  ATTR_STRING = ''; /* assume current day not on screen */
  IF YEAR = CUR_YEAR THEN
    SELECT;
      WHEN MONTH = CUR_MONTH THEN /* current month in middle */
        DO;
          CUR_DAY_FIELD = 'CENTER_DAYS.'||,
                     (SUBSTR(DATE_SAVE,7,2)+FIRST_WEEKDAY_SAVE);
          ATTR_STRING = 'ATTRIB(' CUR_DAY_FIELD 'RED )' ;
        END;
        DO;
          CUR_DAY_FIELD = 'LEFT_DAYS.'||,
                     (SUBSTR(DATE_SAVE,7,2)+FIRST_WEEKDAY_SAVE);
          ATTR_STRING = 'ATTRIB(' CUR_DAY_FIELD 'RED )' ;
        END;
        DO;
          CUR_DAY_FIELD = 'RIGHT_DAYS.'||,
                     (SUBSTR(DATE_SAVE,7,2)+FIRST_WEEKDAY_SAVE);
          ATTR_STRING = 'ATTRIB(' CUR_DAY_FIELD 'RED )' ;
        END;
    END; /* select */
 'PANEL RECEIVE CALENDAR'

END; /* do forever loop */

ERROR:
  SAY 'RETURN CODE ' RC
  SAY 'REA    CODE ' PAN.REA
  SAY 'LOC    CODE ' PAN.LOC
  EXIT;
EXIT_ROUTINE:
  'PANEL END';
  SENDE;
  EXIT;
each definition needs to be in a separate RFS file.
******************************************************





Reference Reference

Feedback


Timestamp icon Last updated: Tuesday, 7 January 2014


http://pic.dhe.ibm.com/infocenter/cicsts/v5r1/topic/com.ibm.cics.rexx.doc//dfhrx/rvse310.html