RE: Sub-Procedures with Local Display Files?

I was asked to supply the DDS for my Email Prompt sub-procedure. I am
going to, below, and will also include the entire sub-procedure (I left out
the irrelevant stuff from the previous messages that I didn't want to
confuse/cloud the issue).

I'm new to programming, so this is all new to me. Please don't kill me for
horrible technique, ideas, or implementation. All of the sub-procedures
are located in a Service Program (the first one I've ever written...) that
I just use to make my job easier.

I'll also include a couple of examples of use. You can call this
sub-procedure with no parameters, and it will display default program name,
title, message lines, and error messages. Or you can pass each of these to
the screen (must provide them in that order, as they are *NoPass,
eliminating the need to use *Omit on the call. Here's everything (if
there's a prettier way to present code, let me know!):

____________

Example Calls
____________

myEmail = ChrGetEmail; //Uses Default Screen Content
myEmail = ChrGetEmail(myPgm); //Displays Pgm Name, all else = Default
myEmail = ChrGetEmail(myPgm:myTitle:'Please Enter Email');
myEmail = ChrGetEmail(myPgm:myTitle:myMsg1:myMsg2:myError); //Fully
Customized

____

DDS
____

A DSPSIZ(24 80 *DS3)
A INDARA
A PRINT
A R EMAIL1
A WINDOW(5 5 11 67)
A WDWBORDER((*COLOR BLU) (*DSPATR
RI)-
A (*CHAR ' '))
A CF12(12)
A CF03(03)
A WDWTITLE((*TEXT '
ENTER-Continue-
A
-
A F12-Cancel') *BOTTOM *LEFT)
A 8 1'EMail Address:'
A COLOR(WHT)
A EMLEMAIL 50A B 8 16
A EMLTITLE 40 1 14COLOR(WHT)
A EMLMSG1 66 O 4 1COLOR(BLU)
A EMLMSG2 66 O 5 1COLOR(BLU)
A EMLERROR 65A O 10 2DSPATR(HI)
A DSPATR(BL)
A COLOR(RED)
A 1 1USER
A 1 59DATE
A EDTCDE(Y)
A 2 59TIME
A EMLPGM 10 O 2 1
A R ASSUMEEML
A ASSUME
A 5 1' '

____

RPG
____

//Prompt for email address for any purpose.

PChrGetEmail B Export
FEMAILFM CF E WORKSTN InDDS(DSIndAra)
DChrGetEmail PI 100A Varying
D PgmName 10A Const Options(*NoPass)
D Title 40A Const Options(*NoPass)
D Msg1 66A Const Options(*NoPass)
D Msg2 66A Const Options(*NoPass)
D Error 65A Const Options(*NoPass)
//Local Variables
DDSEmail DS LikeRec(EMAIL1:*all)
DDSIndAra DS
D F3 3 3N
D F12 12 12N
DOutput S 100A
/Free

If %parms >= 1;
DSEmail.EmlPgm = PgmName;
Else;
DSEmail.EmlPgm = 'CHRTOOLS';
EndIf;

If %parms >= 2;
DSEmail.EmlTitle = Title;
Else;
DSEmail.EmlTitle = 'Get Email Address';
EndIf;
DSEmail.EmlTitle = ChrCenterThis(DSEmail.EmlTitle);

If %parms >= 3;
DSEmail.EmlMsg1 = Msg1;
Else;
DSEmail.EmlMsg1 = 'Enter a Valid Email Address';
EndIf;
DSEmail.EmlMsg1 = ChrCenterThis(DSEmail.EmlMsg1);

If %parms >= 4;
DSEmail.EmlMsg2 = ChrCenterThis(Msg2);
Else;
Clear DSEmail.EmlMsg2;
EndIf;

If %parms = 5;
DSEmail.EmlError = Error;
Else;
Clear DSEmail.EmlError;
EndIf;

DoU F3 = *On or F12 = *On;
ExFmt Email1 DSEmail;
Clear DSEmail.EmlError;

If F3 = *On or F12 = *On;
Clear Output;
Return Output;
EndIf;

If DSEmail.EmlEmail = *Blanks;
DSEmail.EmlError = 'Blank Email';
Iter;
Else;
If Not ChrValEmail(DSEmail.EmlEmail);
DSEmail.EmlError = 'Invalid Email Addres';
Iter;
Else;
Output = DSEmail.EmlEmail;
Return Output;
EndIf;
EndIf;

EndDo;

/End-Free
PChrGetEmail E


______________________________________________________

Other Sub-Procedures I've Built that are Called from ChrGetEmail
______________________________________________________

//Center text into a field given it's length and contents.
//I saw I'm not supposed to return large variables, but I'm
// not on OS 7 yet (6.1), and don't know a way to keep it
// flexible. Sorry?

PChrCenterThis B Export
DChrCenterThis PI 32740A Varying
D InputStr 32740A Const Varying
//Local Variables
D Length S 10I 0 Inz
D StrLength S 10I 0 Inz
D Output S 32740A
/Free

StrLength = %len(InputStr);

If StrLength > (%len(%trim(InputStr)) + 1);
Length = ((StrLength -
%len(%trim(InputStr)))/2)+1;
%subst(Output:Length) = %trim(InputStr);
Return Output;
Else;
Return InputStr;
EndIf;

/End-Free
PChrCenterThis E


//Determine if email address is in a valid format (x@y.z)

PChrValEmail B Export
DChrValEmail PI N
D Email 100A Const Varying
//Local Variables
D Y1 S 10I 0 Inz
D MaxY1 S 10I 0 Inz
D Y2 S 10I 0 Inz
D MaxY2 S 10I 0 Inz
D StartPos S 10I 0 Inz
/Free

//Check for @ Symbol
StartPos = 1;
DoU Y1 = *zero;
Y1 = %scan('@':Email:StartPos);
If Y1 <> *zero;
MaxY1 = Y1;
EndIf;
If MaxY1 = *zero;
Return *Off;
ElseIf Y1 < %len(Email);
StartPos = Y1 + 1;
Else;
Leave;
EndIf;
EndDo;

//Verify Address Exists Before Final @ Symbol
If MaxY1 <= 1;
Return *Off;
EndIf;

//Check for . Separator
StartPos = 1;
DoU Y2 = *zero;
Y2 = %scan('.':Email:StartPos);
If Y2 <> *zero;
MaxY2 = Y2;
EndIf;
If MaxY2 = *zero;
Return *Off;
ElseIf Y2 < %len(Email);
StartPos = Y2 +1;
Else;
Leave;
EndIf;
EndDo;

//Verify Domain Exists Before Final . Separator
If MaxY2 <= 3;
Return *Off;
EndIf;

//Check for Final . Separator Comes Before Final @ Symbol
If MaxY1 > MaxY2;
Return *Off;
EndIf;

//Verify Top-Level Domain Exists AFter Final . Separator
If %len(ChrGetExt(Email)) = 0; //Top-Level Domain Missing
Return *Off;
EndIf;

//No Issues - Valid Email Format
Return *On;

/End-Free
PChrValEmail E