home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
parsomat.zip
/
exampl21.pom
< prev
next >
Wrap
Text File
|
2001-07-15
|
10KB
|
359 lines
;==============================================================================
;
; Prologue
;
;------------------------------------------------------------------------------
PROLOGUE
;============================================================================
;
; Initialization
;
;----------------------------------------------------------------------------
;
; Handy Constants
; ---------------
;
SET ALL = "A"
SET BOTH = "B"
SET COMMA = ","
SET DASH = "-"
SET DIGITS = "0123456789"
SET FIRST = ""
SET LAST = ""
SET LASTSPACE = ">* "
SET LEFT = "L"
SET NO = "N"
SET NULL = ""
SET POSNANY = ""
SET POSNLAST = ">"
SET POSNFIRST = "<"
SET RIGHT = "R"
SET SPACE = " "
SET YES = "Y"
;
; Initialize Input Trackers
; -------------------------
;
SET AddrCount = "0"
;============================================================================
;
; Scanlists
;
;----------------------------------------------------------------------------
;
; States
; ------
;
SET STATES = "/AB/AK/AL/AR/AZ/BC/CA/CO/CT/DC/DE/FL/GA/HI/IA/ID/IL/IN/KS/KY/LA/MA/MB/MD/ME/MI/MN/MO/MS/MT/NB/NC/ND/NE/NF/NH/NJ/NM/NS/NV/NY/OH/OK/ON/OR/PA/PR/QC/RI/SC/SD/SK/TN/TX/UT/VA/VT/WA/WI/WV/WY"
;============================================================================
;
; Array Scanlists
;
;----------------------------------------------------------------------------
;
; About Arrays of ScanLists
;
; These arrays can be expanded by adding another scanlist with the next
; number (e.g. after XYZ,5 you would add XYZ,6).
;
; Each scanterm must be preceded by the same character that appears in
; the first position of the scanlist (usually a slash). You should put
; the most obvious items first. Try to put VERY obvious items in the
; first scanlist.
;
; No POM file line can extend beyond the 255th character.
;
; Salutation Prefixes
; -------------------
;
SET SALUTATN,1 = "/MR/MISS /MS/MRS/DR /DR./REVEREND /REV /REV."
SET SALUTATN,2 = "/SIR /DAME /LADY /HRH /THE RIGHT/THE HONORABLE"
SET SALUTATN,3 = "/MAJOR /MAJOR-GENERAL/MJR-/LT /LT./LT-/SARGEANT"
SET SALUTATN,4 = "/CPL /CPL./CORPORAL /GENERAL/GNL./OFFICER/OFF."
SET SALUTATN,5 = "/CAPTAIN/CPTN/CPTN./CPT/CPT."
;
; Name Suffixes
; -------------
;
SET NAMESUFF,1 = "/ SR./ JR./ SR/ JR/ II/ III/ IV/ V/ VI"
SET NAMESUFF,2 = "/ SENIOR/ JUNIOR/ CPA/ MD/ M.D./ PHD"
SET NAMESUFF,3 = "/ FSC/ F.S.C./ MBA/ M.B.A."
END
;==============================================================================
;
; Mainline Code
;
;------------------------------------------------------------------------------
;
; Count this record
;
SET AddrCount = AddrCount+
;
; Get fields
;
SET Name = $FLUPC[ 1 23]
SET Title = $FLUPC[ 24 50]
SET Company = $FLUPC[ 51 79]
SET Addr1 = $FLUPC[ 80 104]
SET CityStateZip = $FLUPC[105 135]
;
; Tidy up fields
;
TRIM Name BOTH SPACE
TRIM Title BOTH SPACE
TRIM Company BOTH SPACE
TRIM Addr1 BOTH SPACE
CHANGE Addr1 " " SPACE
TRIM CityStateZip BOTH SPACE
;
; Process
;
CALL "Deduce Fields"
CALL "Output"
;==============================================================================
;
; Subroutines
;
;------------------------------------------------------------------------------
CODE "Deduce Fields"
;
; Initialize
;
SET NameSalutatn = NULL
SET NameFirst = NULL
SET NameMiddle = NULL
SET NameLast = NULL
SET NameSuffix = NULL
SET City = NULL
SET State = NULL
SET Zip = NULL
SET ZipExt = NULL
;
; Remove any noise spaces
;
CHANGE Name " " SPACE
CHANGE CityStateZip " " SPACE
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
; Deduce Name Fields
;
CALL "Get Name Parts"
;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;
; Deduce CityStateZip fields
;
;
; Look for the Zip
;
TRIM CityStateZip ALL COMMA
PARSE ZipData CityStateZip LASTSPACE LAST
SETLEN ZipLen ZipData
SET Placed = NO
SET TestNum = ZipData[1 5]
CALL "Test Numeric"
BEGIN TestNumeric = YES
;
; Looks like a ZIP code
;
TRIM ZipData ALL DASH
EXTRACT Zip ZipData "1" "5"
EXTRACT Zip4 ZipData "1" "4"
EXTRACT ZipExt ZipData "1" "3"
SET Placed = YES
ELSE
;
; Not a ZIP code
;
; Maybe this is a state (i.e. there was no Zip)
;
BEGIN ZipLen = "2"
BEGIN States ^ ZipData
SET State = ZipData
SET Placed = YES
END
END
END
BEGIN Placed = YES
PEEL toss CityStateZip LASTSPACE LAST
END
;
; Look for State
;
BEGIN State = NULL
PEEL State CityStateZip LASTSPACE LAST
END
;
; Get City
;
SET City = CityStateZip
END
;------------------------------------------------------------------------------
CODE "Get Name Parts"
SET ScanVarName = "Name"
SET ScanListName = "SALUTATN"
SET ScanNeedPosn = POSNFIRST
CALL "Array Scan"
BEGIN ScanFrom <> "0"
;
; We found a salutation
;
PEEL NameSalutatn Name FIRST SPACE
END
;
; NameFirst
;
TRIM Name LEFT SPACE
PEEL NameFirst Name FIRST SPACE
;
; NameMiddle (actually, it's a middle initial)
;
TRIM Name LEFT SPACE
BEGIN Name[2] = SPACE
PEEL NameMiddle Name FIRST SPACE
END
;
; NameLast
;
TRIM Name LEFT SPACE
SET NameLast = Name
;
; Name Suffix
;
SET ScanVarName = "NameLast"
SET ScanListName = "NAMESUFF"
SET ScanNeedPosn = POSNLAST
CALL "Array Scan"
BEGIN ScanFrom <> "0"
;
; We found a suffix
;
PEEL NameSuffix NameLast LASTSPACE LAST
END
END
;------------------------------------------------------------------------------
CODE "Output"
;
; Output
;
SET RecNum = AddrCount
OUTEND $LINECOUNTER <> "1" |
OUTEND |RECORD NUMBER: {RecNum}
OUT |NAME INFO: [{NameSalutatn}] [{NameFirst}]
OUTEND | [{NameMiddle}] [{NameLast}] [{NameSuffix}]
OUTEND Title <> NULL |TITLE: {Title}
OUTEND Company <> NULL |COMPANY: {Company}
OUTEND |ADDR1: {Addr1}
OUTEND |CITY & STATE: [{City}] [{State}]
OUTEND |ZIP PARTS: [{Zip}] [{Zip4}] [{ZipExt}]
END
;==============================================================================
;
; General Parsing Routines
;
;------------------------------------------------------------------------------
;
; "Array Scan" checks data against the array of scanlists we specify
;
; Input Variables
; ScanVarName The literal name of the variable to scan (e.g. "MyVar")
; ScanListName The literal root name of the array (e.g. "MyArray")
; The array must start with index 1 (e.g. MyArray,1)
; ScanNeedPosn POSNLAST means "must be found at the end of the item"
; POSNFIRST means "must be found in position 1"
; POSNANY means "may be found anywhere"
;
; Output Variables
; ScanFrom First position ("0" if not found)
; ScanTo Last position ("0" if not found)
;
; Reset Variables
; ScanLineFrom Set to NULL
; ScanLineTo Set to NULL
;
CODE "Array Scan"
;
; Initialize
;
SET ScanFrom = "0"
SET ScanTo = "0"
SET scan_specs = ScanNeedPosn
SETLEN scanvar_len (@ScanVarName)
;
; Loop through lists
;
SET listnum = "1"
SET searching = YES
SET scanfound = NO
BEGIN
;
; Look for it in this list
;
SCANPOSN from to (@ScanVarName) (@ScanListName,@listnum) scan_specs
;
; If we found it, see if it scanfound
;
BEGIN from <> "0"
BEGIN ScanNeedPosn = POSNFIRST
IF from = "1" THEN scanfound = YES
END
BEGIN ScanNeedPosn = POSNLAST
IF to = scanvar_len THEN scanfound = YES
END
IF ScanNeedPosn = POSNANY THEN scanfound = YES
END
;
; Test our result
;
BEGIN scanfound = YES
;
; Return the values
;
SET searching = NO
SET ScanFrom = from
SET ScanTo = to
ELSE
SET listnum = listnum+
IF (@ScanListName,@listnum) = NULL THEN searching = NO
END
AGAIN searching = YES
END
;------------------------------------------------------------------------------
;
; "Test Numeric" checks if an item is numeric (i.e. only digits)
;
; Input Variables
; TestNum The value to be tested
;
; Output Variables
; TestNumeric Set to YES if numeric, or NO if non-numeric or null
;
CODE "Test Numeric"
BEGIN TestNum = NULL
SET TestNumeric = NO
ELSE
SET TestNumeric = YES
SETLEN tncounter TestNum
BEGIN tncounter <> "0"
COPY testdigit TestNum tncounter tncounter
IF DIGITS ~ testdigit THEN TestNumeric = NO
SET tncounter = tncounter-
AGAIN TestNumeric = YES
END
END