|
| |
NOTE - Use your Browsers BACK Button to return to prior page or
CLICK here.
| We'll slowly build a "Rain
Forest" as we examine some simple SQR routines... |
 |
This section of SQRTOOLS.COM explores some basic SQR routines... As we
proceed we'll put a nice rain forest together... Pictured to the left is a family of
gibbons... one is grooming another... possibly looking for lice as a nutritious and tasty
snack... maybe we should stick to the SQR routines! Let's move on... next is a chameleon
and a month conversion. |
| 2-Way Month Conversion -
Alternate Approach... |
 |
This routine converts a 2-digit month to a 3-character literal... and vice
versa... an EVALUATE is used against the string length (2 or 3)... The result is based on
an index or pointer into a month conversion string... |
!**********************************************************************
!* *
!* MODULE: TDMONTH.SQC *
!* AUTHOR: TONY DELIA. *
!* DATE: 08/20/97. *
!* SYSTEM: TD SQR UTILITY SERIES. *
!* DESC: MONTH CONVERSION. *
!* *
!**********************************************************************
!* *
!* USAGE: let $w-in = '01' *
!* do TD-Month-Conv($w-in, $w-out) *
!* . *
!* let $w-in = 'JUN' *
!* do TD-Month-Conv($w-in, $w-out) *
!* . *
!* let $w-in = '99' *
!* do TD-Month-Conv($w-in, $w-out) *
!* . *
!* let $w-in = 'EGG' *
!* do TD-Month-Conv($w-in, $w-out) *
!* . *
!* . *
!* #Include 'tdmonth.sqc' *
!* *
!**********************************************************************
!* *
!* RESULTS: Example 1 returns 'JAN' in $w-out *
!* Example 2 returns '06' in $w-out *
!* Example 3 returns '***' in $w-out *
!* Example 4 returns '00' in $w-out *
!* *
!**********************************************************************
!* *
!* LEGAL: CONFIDENTIALITY INFORMATION. *
!* *
!* This module is the original work of Tony DeLia. It *
!* can be considered ShareWare under the following *
!* conditions. *
!* *
!* A - The author's name (Tony DeLia) remains on any *
!* and all versions of this module. *
!* B - Any modifications must be clearly identified. *
!* C - A "vanilla" copy of this module must be kept *
!* alongside any revised versions. *
!* *
!**********************************************************************
!* *
!* WEBSITE: http://www.sqrtools.com *
!* *
!* Questions/Comments: tdelia@erols.com *
!* *
!**********************************************************************
begin-procedure TD-Month-Conv($td-in, :$td-out)
let $TDtab = 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC***'
let #tdlen = length($td-in)
evaluate #tdlen
when = 2 ! Month to Literal
let #tdx = to_number($td-in) * 3 - 2
let #tdi = (#tdx + 35) / 36
let #tdi = trunc(#tdi,0)
if #tdi <> 1
let #tdx = 37
end-if
let $td-out = substr($TDtab,#tdx,3)
when = 3 ! Literal to Month
uppercase $td-in
let #tdx = 1
while #tdx < 37
if $td-in = substr($TDtab,#tdx,3)
break
end-if
let #tdx = #tdx + 3
end-while
let #tdx = (#tdx + 2) / 3
let #tdx = trunc(#tdx, 0)
if #tdx > 12
let #tdx = 0
end-if
let $td-out = edit(#tdx,'09')
when-other ! Invalid Conversion
let $td-out = '00'
end-evaluate
end-procedure
!**********************************************************************
!* End of Program *
!**********************************************************************
|
| Here's the "Usual"
Approach to month conversions... |
 |
The code below will work just as well as the code above... but there is no
creativity or skill required to produce this... In addition, every month and literal must
be hard-coded... That's 24 individual "when" clauses for a 2-way month
conversion! |
!**********************************************************************
!* Boring Month Conversion *
!**********************************************************************
begin-procedure Boring-Month-Conversion($in, :$out)
evaluate $in
when = '01'
let $out = 'JAN'
when = '02'
let $out = 'FEB'
... etc ... ! 03 thru 11 goes here
when = '12'
let $out = 'DEC'
when = 'JAN'
let $out = '01'
when = 'FEB'
let $out = '02'
... etc ... ! MAR thru NOV goes here
when = 'DEC'
let $out = '12'
when-other
let $out = '00'
end-evaluate
end-procedure
!**********************************************************************
!* End of Program *
!**********************************************************************
|
| Numeric Validation (Very simple
version) |
 |
Here's a simple numeric validation routine... A string is passed and
evaluated... A return code is set to 'Y' if it is a valid numeric field... One decimal
point is accepted... |
!**********************************************************************
!* *
!* MODULE: TDNUMBER.SQC *
!* AUTHOR: TONY DELIA. *
!* DATE: 09/09/97. *
!* SYSTEM: TD SQR UTILITY SERIES. *
!* DESC: NUMERIC VALIDATION ROUTINE. *
!* *
!**********************************************************************
!* *
!* USAGE: let $w-in = '0123456789' *
!* do TD-Numeric($w-in, $w-code) *
!* . *
!* let $w-in = 'HELLO' *
!* do TD-Numeric($w-in, $w-code) *
!* . *
!* let $w-in = '' *
!* do TD-Numeric($w-in, $w-code) *
!* . *
!* . *
!* . *
!* #Include 'tdnumber.sqc' *
!* *
!**********************************************************************
!* *
!* RESULTS: Example 1 returns 'Y' in $w-code (Numeric) *
!* Example 2 returns 'N' in $w-code (Non-Numeric) *
!* Example 3 returns 'E' in $w-code (Error - NULL) *
!* *
!**********************************************************************
!* *
!* LEGAL: CONFIDENTIALITY INFORMATION. *
!* *
!* This module is the original work of Tony DeLia. It *
!* can be considered ShareWare under the following *
!* conditions. *
!* *
!* A - The author's name (Tony DeLia) remains on any *
!* and all versions of this module. *
!* B - Any modifications must be clearly identified. *
!* C - A "vanilla" copy of this module must be kept *
!* alongside any revised versions. *
!* *
!**********************************************************************
!* *
!* WEBSITE: http://www.sqrtools.com *
!* *
!* Questions/Comments: tdelia@erols.com *
!* *
!**********************************************************************
begin-procedure TD-Numeric($NUMin, :$NUMok)
let $NUMstring = '0123456789.' ! 0-9 (and 1 decimal)
let $NUMok = 'E'
let #NUMlen = length($NUMin)
let #NUMpos = 1
let #NUMdec = 0 ! First Decimal Pointer
let #NUMextra = 0 ! Extra Decimal Pointer
let #NUMdec = instr($NUMin, '.', 1)
if #NUMdec > 0
and #NUMdec < #NUMlen
let #NUMextra = instr($NUMin, '.', #NUMdec + 1)
end-if
if #NUMextra = 0
while #NUMpos <= #NUMlen
let $NUMok = 'Y'
let $NUM = substr($NUMin, #NUMpos, 1)
let #NUM = instr($NUMstring, $NUM, 1)
if #NUM = 0
let $NUMok = 'N' ! Non-Numeric Detected
let #NUMpos = #NUMlen ! Set Position to Length
end-if
let #NUMpos = #NUMpos + 1
end-while
end-if
end-procedure
!**********************************************************************
!* End of Program *
!**********************************************************************
|
| Number of Occurances (of a
Character) in a String... |
 |
Here's a routine that determines the number of times a character occurs in
a string... to the left is a toucan staring at some flowers... Our rain forest will be
complete soon! |
!**********************************************************************
!* *
!* MODULE: TDCHARS.SQC *
!* AUTHOR: TONY DELIA. *
!* DATE: 10/21/1998. *
!* SYSTEM: TD SQR UTILITY SERIES. *
!* DESC: DETERMINE NUMBER OF CHARACTERS IN STRING. *
!* *
!**********************************************************************
!* *
!* USAGE: let $lf = chr(10) *
!* do Number-Of-Chars($rec,$lf,#ctr) *
!* . *
!* display 'Number of LineFeeds: ' noline *
!* display #ctr 99999 *
!* . *
!* #Include 'tdchars.sqc' *
!* *
!**********************************************************************
!* *
!* LEGAL: CONFIDENTIALITY INFORMATION. *
!* *
!* This module is the original work of Tony DeLia. It *
!* can be considered ShareWare under the following *
!* conditions. *
!* *
!* A - The author's name (Tony DeLia) remains on any *
!* and all versions of this module. *
!* B - Any modifications must be clearly identified. *
!* C - A "vanilla" copy of this module must be kept *
!* alongside any revised versions. *
!* *
!**********************************************************************
!* *
!* WEBSITE: http://www.sqrtools.com *
!* *
!* Questions/Comments: tdelia@erols.com *
!* *
!**********************************************************************
!**********************************************************************
!* Number of Characters in String *
!**********************************************************************
begin-procedure Number-Of-Chars($I_string, $I_char, :#O_ctr)
let #O_ctr = -1
let #pos = 0
while #pos > 0
or #O_ctr < 0
let #pos = instr($I_String, $I_char, #pos + 1)
let #O_ctr = #O_ctr + 1
end-while
end-procedure
!**********************************************************************
!* End of Program *
!**********************************************************************
|
| Input Parameters (String,
Character), Output Parameter (Count)... |
 |
The Input parameters include the source string and the search character...
the number of times the character is found (count) is returned... this could be a very
useful routine... |
| A couple extra "rain
forest" pieces... |
 |
Here's a couple extra pieces of our Rain Forest... I'm sure everyone is
waiting with great anticipation... I hope this lives up to the build up! In any event this
completes our 'Simple Routines' section... Without furthur delay... The completed
"Rain Forest"... |
 |
 |
I would appreciate any feedback you may have on this site.
Send mail to tdelia@erols.com or click on the
Octopus. |
Tony DeLia - Updated July 22, 1999
|
