,<LAST NAME>, and <FIRST NAME> fields to ! list document when <NAME> field is requested. Lines 4232, ! 4233, FN.STRIP.WPS$, FN.REMOVE$ ! ! Insert blank line to separate records. Line 4275. !--------------------------------------------------------------------- 100 ! & ! Summary: & ! & ! Creates a word processing List Document file from a mailing & ! list or a specified sublist. & ! & ! Description: & ! & ! This subprogram prompts the user for the selection criteria & ! (that is: all, permanent sublist, or temporary sublist), asks & ! for a sort order (only primary or secondary key sorts are & ! available), requests the name of the output List Document & ! File, and prompts the user for the specific categories to & ! include in the output document. It then outputs to the List & ! Document File the field names and field values specified by & ! the user for all addresses that meet the criteria chosen. & ! & ! & !--------------------------------------------------------------------- 200 ! & ! & ! Interfaces: & ! & ! COMERR - Common Error buffer & ! COMCON - Common Constant buffer & ! COMVAR - Common Variable buffer & ! & ! MAPSCR - Screen buffer & ! MAPHDR - Mail file header buffer & ! MAPMLF - Address record buffer & ! MAPSUB - Sublist definition buffer & ! MAPADD - Unpacked address buffer & ! MAPSEL - Sublist definition array buffer & ! & ! & !--------------------------------------------------------------------- 300 ! & ! & ! Input / Output: & ! & ! & ! Channel Filename Map name Status at entry/exit & ! ------- --------- -------- -------------------- & ! CH.ADD% M11.MAIL.FILE$ MAPMLF OPEN/OPEN & ! CH.KB% "KB:" OPEN/OPEN & ! CH.PRT% LIST.DOC.FILE$ CLOSED/CLOSED & ! & !--------------------------------------------------------------------- 400 ! & ! & ! Variable and Array Definitions: & ! & ! & ! ACCOUNT.SPECIFIED% Flags presence of [n,n] in output file spec & ! AND% Constant value for logical AND & ! ANS$ User keyboard response from M11SCR & ! DEFAULT$ Default value passed to M11SCR & ! ERL Line in which error occurred & ! ERR Set to error number after error & ! FIELD.COUNT% Index used for specifying address fields & ! FIELD.NUMBER%(17%) Contains indices of included address fields. & ! FILE.AROUND% Flags List Document File as open & ! FILE.OK% Flags input file spec as valid/invalid & ! F.END% Control Z was typed by user (M11SCR) & ! INCLUDED.FIELD.COUNT% Counts number of address fields specified & ! LINES% Number of lines displayed on screen & ! MATCH% Logical value returned from SUBEXT (does & ! the address match the selection criteria & ! NAM$ Name of sublist selected by user & ! NAMES% Total number of addresses displayed & ! OR% Constant value for logical OR & ! REC$ Dynamic length buffer returned from M11UPK & ! ROW.POS% Contains row position for obtaining response & ! from the field selection screen & ! SAV.PRIME.ID$ Variable to contain sublist def. record key & ! TERMINATING.RECORD$ Constant ("<>") Record terminator & ! & !--------------------------------------------------------------------- 600 ! & ! COMMON Statements & ! & !--------------------------------------------------------------------- 650 !-------------------------------------------------------------------- & ! & ! MAP Statements & ! & !--------------------------------------------------------------------- 700 !-------------------------------------------------------------------- & ! & ! & ! Subprograms: & ! & ! Name Description & ! ---- ----------- & ! & ! M11SCD Forms display & ! M11SCW Screen write (writes one line to screen) & ! M11SCR Screen read (reads one field from screen) & ! M11UPK Upacks one address record and leaves in & ! MAPADD & ! & !-------------------------------------------------------------------- & ! 800 ! Subroutines: & ! & ! Line Number Description & ! ---- ------ ----------- & ! & ! 12000 (SUBLSD) Load sublist definition into memory & ! 12100 (SUBCNV) Convert sublist definition numeric and date & ! fields & ! 13500 (SUBEXT) Determine if address record meets selection & ! criteria & ! 14800 (SUBNOT) Print an informational message on the screen & ! 14900 (SUBERR) Print an error message on the screen & ! & ! & !-------------------------------------------------------------------- & ! & ! Functions: & ! & ! Name Description & ! ---- ----------- & ! & ! FN.DATE.CNV$ Convert a date from DD-MMM-YY to YYMMDD & ! FN.RJZF$ Right justify zero fill a numeric string & ! FNFILE% Checks for a valid file spec & ! & !-------------------------------------------------------------------- & 900 DIM TRUTH%(30%) ! One logical entry for each sublist def line & \ DIM AND.OR%(30%) ! AND or OR with the previous def line? & \ DIM FIELD.NUMBER%(17%) ! Holds which fields are in list file & \ DIM DEFAULT.ANS$(17%) ! Holds default responses to field specifers & 1000 !******************************************************************** & ! & ! & ! S T A R T P R O G R A M L O G I C & ! & ! & !******************************************************************** & 1010 ON ERROR GOTO 19000 & \ ERR.PROGNAM$ = "M11WPS VER:01" & \ ERR.SUBNAM$ = "" & \ ERR.MSG$ = "Unexpected fatal error" & \ PLEASE.WAIT$ = "The next address is in use by another user. Please wait." & ! Set standard error trap. Set up common for error reporting. & & 1040 AND% = 1% & \ OR% = 2% & ! Initialize constants. & 2000 !-------------------------------------------------------------------- & ! & ! Entire List or just sublist ? & ! & !-------------------------------------------------------------------- & 2100 CALL M11SCD (SCR.LIST.SELECT%) & ! Show the list selection choice. & 2120 CALL M11SCR (ANS$, 18%, 42%, 1%, "A", "A", F.END%) & \ GO TO 9000 IF F.END% & ! Get the answer, clear out if 'END'. & 2140 M11.LIST.CODE$ = ANS$ & \ GO TO 2200 IF POS("AST",ANS$,1%) > 0% & ! Save answer. Skip help message if valid response was entered. & 2190 CALL M11SCD (SCR.HLP.13%) & \ M11.MSG$ = " " & \ GO SUB 14900 & \ GO TO 2100 & ! Give help because answer not acceptable (including help requests) & 2200 GO TO 2300 UNLESS M11.LIST.CODE$ = "S" & \ DEFAULT$ = "" & \ DEFAULT$ = M11.SUBLIST.NAME$ IF M11.SUBLIST.CODE% = PERM% & \ CALL M11SCR (NAM$, 10%, 41%, 10%, DEFAULT$, "A", F.END%) & \ GO TO 2120 IF F.END% & \ GO TO 2190 IF NAM$ = "?" & \ IF NAM$ = "" & THEN IF M11.SUBLIST.CODE% = TEMP% & THEN GOSUB 12100 ! Convert numeric + date fields & \ GO TO 3000 & ELSE M11.MSG$ = "A temporary sublist does not currently exist." & \ GO TO 2290 & ELSE IF M11.SUBLIST.CODE% = PERM% AND NAM$ = M11.SUBLIST.NAME$ & THEN GOSUB 12100 ! Convert numeric + date fields & \ GO TO 3000 & ELSE SAV.PRIME.ID$ = SUB.CHR$ + SEG$ (NAM$ + SPACE$(10%), 1%,10%) & \ SUB.KEY0$ = SAV.PRIME.ID$ + "00001" & 2210 GET #CH.ADD%, KEY #0% EQ SUB.KEY0$ & 2220 M11.SUBLIST.CODE% = PERM% & \ M11.SUBLIST.NAME$ = NAM$ & \ GOSUB 12000 ! Load sublist definition & \ GOSUB 12100 ! Convert numeric + date fields & \ GO TO 3000 & ! If the answer is "sublist"... & ! Ask the user which one (the default is the current one, if any). & ! Unless the user picks the current one, send her back to main menu. & 2289 M11.MSG$ = "Sublist " + NAM$ + " does not currently exist." & ! Program traps back to here if the stored sublist does not exist. & 2290 CALL M11SCW (M11.MSG$, 23%, 1%) & \ M11.MSG$ = "Do you wish to go back to create that sublist definition (Y/N)?" & \ CALL M11SCW (M11.MSG$, 24%, 1%) & \ CALL M11SCR (ANS$, 24%, 66%, 1%, "Y", "Y", F.END%) & \ CALL M11SCW (ERASE.EOL$, 23%, 1%) & \ GO TO 2120 IF F.END% & \ IF ANS$ = "Y" & THEN ERR.CODE% = 10% & \ GO TO 9000 & ELSE GO TO 2120 & ! Handle the case where the user has requested a sublist that does & ! not exist (yet). & 2300 GO TO 3000 UNLESS M11.LIST.CODE$ = "T" & \ IF M11.SUBLIST.CODE% = TEMP% & THEN GOSUB 12100 & \ GO TO 3000 & ELSE M11.MSG$ = "A temporary sublist does not currently exist." & \ GO TO 2290 & ! If the temporary sublist was requested, check that it exists. If & ! it does, convert date and numeric fields. Otherwise, complain. & 3000 !-------------------------------------------------------------------- & ! & ! Sort Options & ! & !-------------------------------------------------------------------- & 3100 CALL M11SCD (SCR.DSP.SORT.MENU%) & ! Show the sort option menu. & 3120 CALL M11SCR (ANS$, 19%, 42%, 1%, "P", "A", F.END%) & \ GO TO 2000 IF F.END% & ! Get the answer, clear out if 'END'. & 3140 GO TO 3200 IF POS ("PA", ANS$, 1%) > 0% & ! Check for a proper answer. & 3190 CALL M11SCD (SCR.HLP.19%) & \ M11.MSG$ = " " & \ GO SUB 14900 & \ GO TO 3100 & ! Give help because answer not acceptable (including help requests). & 3200 M11.SORT.CODE$ = ANS$ & ! Save answer. & 3300 !-------------------------------------------------------------------- & ! & ! Any acceptable addresses ? & ! & !-------------------------------------------------------------------- & 3320 IF M11.SORT.CODE$ = "A" & THEN RESTORE #CH.ADD%, KEY #1% & ELSE RESTORE #CH.ADD%, KEY #0% & ! Start by determining and setting the access key. & 3330 IF M11.SORT.CODE$ = "A" & THEN GET #CH.ADD%, KEY #1% GE " " & ELSE GET #CH.ADD%, KEY #0% GT SUB.CHR$ + "zzzzzzzzzzzzzzz" & ! Then get the first name record (after any header records). & 3340 MOVE FROM #CH.ADD%, REC$ = RECOUNT & \ CALL M11UPK (REC$) & \ GO TO 4000 IF M11.LIST.CODE$ = "A" & \ GO SUB 13500 & \ GO TO 4000 IF MATCH% & 3350 GET #CH.ADD% & & \ GO TO 3340 & ! Loop thru the Mailing List File, until the first acceptable & ! address is found. & 3390 M11.MSG$ = "There are no addresses in this Mailing List File." & IF ERL = 3330 & \ M11.MSG$ = "There are no addresses that meet the sublist definition." & IF ERL = 3350 & \ GO SUB 14900 & \ GO TO 9000 IF M11.LIST.CODE$ = "A" & \ GO TO 2000 IF M11.LIST.CODE$ <> "A" & ! Warn the user that there is nothing to print. & ! Transfer to Main Menu if there is nothing at all; & ! transfer to the list selection if there is nothing in that sublist. & 3400 CALL M11SCW(PLEASE.WAIT$,24%,1%) & \ SLEEP 2% & \ CALL M11SCW(ERASE.EOL$,24%,1%) & \ GO TO 3330 & ! Handle a locked record at 3330. & 3420 CALL M11SCW (PLEASE.WAIT$, 24%, 1%) & \ SLEEP 2% & \ CALL M11SCW (ERASE.EOL$, 24%, 1%) & \ GO TO 3350 & ! Handle a locked record at 3350. & 4000 !-------------------------------------------------------------------- & ! & ! & ! List Document Specification & ! & ! & !-------------------------------------------------------------------- & 4020 UNLOCK #CH.ADD% & \ CALL M11SCD (SCR.WPSLIST%) & \ CALL M11SCW (HDR.CAT.PROMPT$(I%), 8%+I%, 47%) FOR I% = 1% TO 6% & \ LIST.DOC.FILE$ = "" & \ FILE.AROUND% = FALSE% & \ DEFAULT.ANS$(I%) = "N" FOR I% = 1% TO 17% & ! Show the List Document Selection Screen & ! Fill in the custom category information & ! Initialize output filename, file opened flag, default selections. & 4030 CALL M11SCR (ANS$, 5%, 37%, 30%, LIST.DOC.FILE$, "A", F.END%) & \ KILL LIST.DOC.FILE$ IF F.END% AND FILE.AROUND% & \ GO TO 3000 IF F.END% & \ IF SEG$(ANS$, 1%, 1%) = "?" & THEN CALL M11SCD(SCR.HLP.WPSLIST%) & \ M11.MSG$ = "" & \ GO SUB 14900 & \ KILL LIST.DOC.FILE$ IF FILE.AROUND% & \ GO TO 4020 & ! Ask the user for the name of the output file. & ! Finish up if the user aborts by END or ^Z. & ! Provide help if the user types ?, then refresh previous screen. & 4035 GO TO 4100 IF (ANS$ = LIST.DOC.FILE$) AND FILE.AROUND% & \ ANS$ = ANS$ + ".DOC" IF POS (ANS$, ".", 1%) = 0% & \ FILE.OK% = FNFILE% (ANS$) & \ IF NOT FILE.OK% & THEN LIST.DOC.FILE$ = "" & \ GO TO 4030 & ELSE CALL M11SCW(ANS$, 5%, 37%) & ! If the user does not provide a file type in his specification, & ! then provide the default (.DOC). & ! If the file name is incorrect, or if a non privileged user is & ! trying to create a file in another account, then reprompt for & ! a file specification. If it is OK, then redisplay file spec. & 4040 IF FILE.AROUND% & THEN FILE.AROUND% = FALSE% & \ KILL LIST.DOC.FILE$ & ! Don't reopen file if it had been previously opened. & ! Kill old file and reset flag if changing files. & 4045 LIST.DOC.FILE$ = ANS$ & 4050 OPEN LIST.DOC.FILE$ FOR OUTPUT AS FILE #CH.PRT%, MODE 128% & \ FILE.AROUND% = TRUE% & ! Open the user specified file & ! Proceed with address field specification. & 4100 !-------------------------------------------------------------------- & ! & ! Address Field Selection & ! & !-------------------------------------------------------------------- & 4110 INCLUDED.FIELD.COUNT% = 0% & ! Initialize the number of included fields to zero & 4120 FOR FIELD.COUNT% = 1% TO 17% & \ IF FIELD.COUNT% <= 7% & THEN COLUMN.POS% = 29% & \ ROW.POS% = FIELD.COUNT% + 8% & ELSE COLUMN.POS% = 68% & \ ROW.POS% = FIELD.COUNT% + 1% & ! Set up loop to get user response to each address field & ! Compute row and column positions for inputting from the two & ! column screen (fields 1-7 in left column, 8-17 in right column). & 4125 CALL M11SCR (ANS$, ROW.POS%, COLUMN.POS%, 1%, & DEFAULT.ANS$(FIELD.COUNT%), "Y", F.END%) & \ GO TO 4030 IF F.END% AND FIELD.COUNT% = 1% & \ GO TO 4100 IF F.END% & ! Get the users answer for the particular address field. & ! If the user typed END or ^Z, go back to output file specification. & 4130 IF ANS$ = "?" & THEN M11.MSG$ = "Type Y to include the field, " & + "N to exclude it." & \ CALL M11SCW (M11.MSG$, 24%, 1%) & \ GO TO 4125 & ! Provide help because the user requested it. & ! Display help. & ! Continue where he left off. & 4135 IF ANS$ = "Y" & THEN INCLUDED.FIELD.COUNT% = INCLUDED.FIELD.COUNT% + 1% & \ FIELD.NUMBER%(INCLUDED.FIELD.COUNT%) = FIELD.COUNT% & \ DEFAULT.ANS$(FIELD.COUNT%) = "Y" & ! If the user specifies the field to be included, & ! then increment the number of included fields counter, & ! and store which field it is (1=NAME, 2=ADDR1, etc). & 4140 NEXT FIELD.COUNT% & ! Process the next address field. & 4150 IF INCLUDED.FIELD.COUNT% = 0% & THEN M11.MSG$ = "You must say yes to at least one field." & \ GO SUB 14900 & \ GO TO 4120 & ! If the user did not select any address fields, & ! then notify user of the error, and return to the first & ! address field. & 4200 !---------------------------------------------------------------------& ! & ! Build List Document File & ! & !---------------------------------------------------------------------& 4210 NAMES% = 0% & \ TERMINATING.RECORD$ = "<>" & ! Initialize counters and constants for List Document generation & ! NAMES% indicates the number of address records output. & ! TERMINATING.RECORD$ is the delimiter between address records in & ! the output file. & 4220 CLOSE #CH.KB% & \ C = CTRLC & \ OPEN "KB:" AS FILE #CH.KB% & ! Close keyboard (block mode). & ! Enable Control/C trapping. & ! Reopen keyboard in normal mode. & 4225 M11.MSG$ = "Creating List Document File " + LIST.DOC.FILE$ & + " ... Please wait" & \ GO SUB 14800 & ! Notify the user that the list document file is being created & 4230 FOR I% = 1% TO INCLUDED.FIELD.COUNT% & \ CAT% = FIELD.NUMBER%(I%) - 7% & \ ON FIELD.NUMBER%(I%) GO TO 4232, 4234, 4236, 4238, 4240, 4242, & 4244, 4246, 4246, 4246, 4246, 4246, & 4246, 4258, 4260, 4262, 4264 & ! For each field that the user selected, branch to a section of & ! the program which prints the appropriate <FIELD IDENTIFIER> & ! and field value to the output file. & ! INCLUDED.FIELD.COUNT% indicates the number of address fields & ! selected for inclusion in the list document file. & 4232 PRINT #CH.PRT%, "<NAME>"; EDIT$ (ADD.NAME$, 128%) ! First, print the name field. NAME$ = EDIT$ ( ADD.NAME$, 128% + 16% ) SPACE% = POS ( NAME$, " ", 1% ) IF SEG$ ( NAME$, SPACE%-1%, SPACE%-1% ) = "." THEN PRINT #CH.PRT%, "<TITLE>"; SEG$ ( NAME$, 1%, SPACE%-1% ) ELSE PRINT #CH.PRT%, "<TITLE>" END IF ! Print the TITLE field name, and the field value if one was found. Z9$ = FN.STRIP.WPS$ ( NAME$ ) Z9$ = EDIT$ ( Z9$, 128% ) Z9.LEN% = LEN (Z9$) GO TO 4233 IF SEG$ (Z9$, P%, P% ) = " " & FOR P% = Z9.LEN% TO 1% STEP -1% P% = 0% ! Remove titles and words ending with "." . ! Locate space before last name. 4233 LAST_NAME$ = SEG$ (Z9$, P% + 1%, Z9.LEN%) PRINT #CH.PRT%, "<LAST NAME>"; LAST_NAME$ ! Extract last (or only) name and print last name field ! and field value. SPACE% = POS ( Z9$, " " , 1% ) IF SPACE% = 0% THEN FIRST_NAME$ = "" ELSE FIRST_NAME$ = SEG$ ( Z9$, 1%, SPACE%-1% ) END IF PRINT #CH.PRT%, "<FIRST NAME>"; FIRST_NAME$ ! Locate FIRST space and extract first name if there is one. ! Print first name field and field value. GO TO 4270 4234 PRINT #CH.PRT%, "<ADDRESS LINE 1>"; EDIT$ (ADD.ADDR1$, 128%) & \ GO TO 4270 & 4236 PRINT #CH.PRT%, "<ADDRESS LINE 2>"; EDIT$ (ADD.ADDR2$, 128%) & \ GO TO 4270 & 4238 PRINT #CH.PRT%, "<ADDRESS LINE 3>"; EDIT$ (ADD.ADDR3$, 128%) & \ GO TO 4270 & 4240 PRINT #CH.PRT%, "<CITY/TOWN>"; EDIT$ (ADD.CITY$, 128%) & \ GO TO 4270 & 4242 PRINT #CH.PRT%, "<STATE/COUNTRY>"; EDIT$ (ADD.STATE$, 128%) & \ GO TO 4270 & 4244 PRINT #CH.PRT%, "<ZIP CODE>"; EDIT$ (ADD.ZIP$, 128%) & \ GO TO 4270 & 4246 PRINT #CH.PRT%, "<"; EDIT$ (HDR.CAT.PROMPT$(CAT%), 8%+ 128%); & ">"; EDIT$ (ADD.CATEGORIES$(CAT%-1%), 128%) & \ GO TO 4270 & 4258 PRINT #CH.PRT%, "<COUNTER>"; EDIT$ (NUM1$(ADD.COUNTER%),128%) & \ GO TO 4270 & 4260 PRINT #CH.PRT%, "<REMARK>"; EDIT$ (ADD.COMMENT$, 128%) & \ GO TO 4270 & 4262 PRINT #CH.PRT%, "<PRIMARY ID>"; EDIT$ (ADD.PRIME.ID$, 128%) & \ GO TO 4270 & 4264 PRINT #CH.PRT%, "<ALTERNATE ID>"; EDIT$ (ADD.ALTERNATE.ID$,128%) & \ GO TO 4270 & 4270 NEXT I% & ! Get the next selected address field. & 4275 PRINT #CH.PRT%, TERMINATING.RECORD$ + CR + LF & \ NAMES% = NAMES% + 1% & \ IF (NAMES% / 10% * 10%) = NAMES% & THEN M11.MSG$ = "Addresses Printed = " + STR$(NAMES%) & \ CALL M11SCW (M11.MSG$, 16%, 10%) & ! Print the terminating record of the set of address output records. & ! Update the addresses printed counter. & ! Notify user every ten records printed. 4280 GET #CH.ADD% & ! Get next record. & 4285 MOVE FROM #CH.ADD%, REC$ = RECOUNT & \ CALL M11UPK (REC$) & \ GO TO 4230 IF M11.LIST.CODE$ = "A" & \ GO SUB 13500 & \ IF MATCH% THEN GO TO 4230 & ELSE GO TO 4280 & ! If it matches the sublist definition then go print it out. & ! If it does not match, then go get another record. & 4290 CALL M11SCW(PLEASE.WAIT$,24%,1%) & \ SLEEP 2% & \ CALL M11SCW(ERASE.EOL$,24%,1%) & \ GO TO 4280 & ! Handle a locked record at 4280. & 4300 !-------------------------------------------------------------------- & ! & ! Display Total & ! & !-------------------------------------------------------------------- & 4340 UNLOCK #CH.ADD% & \ M11.MSG$ ="task completed, total selected addresses = "+STR$(NAMES%)& \ GO SUB 14800 & ! Print total addresses selected and notify the user that task is & ! done. & & 9000 !******************************************************************** & ! & ! & ! E N D O F P R O C E S S I N G & ! & ! & !******************************************************************** & 9990 OPEN "KB:" AS FILE #CH.KB%, MODE 8% & \ CLOSE #CH.PRT% & \ UNLOCK #CH.ADD% & \ GO TO 32767 & ! Reopen the keyboard in echo control mode. If there were any & ! numeric or date fields converted in the sublist definition, then & ! we have to reconvert it. Jump around the junk and leave. & 10000 !*************************************************************** & ! & ! & ! S U B R O U T I N E S L O C A L T O & ! & ! T H I S P R O G R A M & ! & ! & !*************************************************************** & 12000 ! SUBLSD.120 will be appended here at compile time. & 12100 ! SUBCNV.121 will be appended here at compile time. & 13500 ! SUBEXT.135 will be appended here at compile time. & 14900 ! SUBERR.149 will be appended here at compile time. & 15000 !*************************************************************** & ! & ! & ! F U N C T I O N S L O C A L T O & ! & ! T H I S P R O G R A M & ! & ! & !*************************************************************** & 15600 ! FNDCNV.156 will be appended here at compile time. & 16000 ! FNRJZF.160 will be appended here at compile time. & & 16200 !-------------------------------------------------------------------- & ! & ! & ! FN.REMOVE$ (A$, B$) & ! & !-------------------------------------------------------------------- & ! & ! This function removes all occurrences of B$ from & ! A$ and returns the result as the function value. & ! & ! & !-------------------------------------------------------------------- & 16220 DEF FN.REMOVE$ (A$, B$) & \ Z.B.LEN% = LEN (B$) & \ Z.LOC% = POS (A$, B$, 1%) & ! Define the function. & 16240 UNTIL Z.LOC% = 0% & \ A$ = SEG$(A$,1%,Z.LOC%-1%) + SEG$(A$,Z.LOC%+Z.B.LEN%,LEN(A$)) & \ Z.LOC% = POS (A$, B$, 1%) & \ NEXT & ! Loop removing B$ from A$ (as many times as necessary). & 16260 FN.REMOVE$ = A$ & \ FNEND & & 16300 !********************************************************************* ! ! FN.STRIP.WPS$ ( ARG$ ) ! !********************************************************************* 16310 DEF FN.STRIP.WPS$ ( ARG$ ) ! This routine is identical to FN.STRIP$ except that ! ARG$ is not upcased at line 16350. 16350 !* Z9$ = EDIT$ (ARG$, 56%) & Z9$ = EDIT$ (ARG$, 24%) & ! After all this, everything is uppercase alphabetic only & ! except for periods, and single spaces which delimit words. & 16370 Z9$ = FN.REMOVE$ (Z9$, "THE ") & \ Z9$ = FN.REMOVE$ (Z9$, "The ") & \ Z9$ = FN.REMOVE$ (Z9$, " III") & \ Z9$ = FN.REMOVE$ (Z9$, " II") & ! Remove all the formal stuff. & ! For most names, we are now left with a first name, an optional & ! middle name or initial, and a surname as the last word in the name. & 16380 Z9$ = Z9$ + " " & \ DOT% = POS (Z9$, ". ", 1%) & \ GO TO 16400 IF DOT% = 0% & \ LENZ9% = LEN (Z9$) & \ SPACE% = 0% & \ SPACE% = J% IF MID (Z9$, J%, 1%) = " " FOR J% = 1% TO DOT%-1% & \ Z1$ = "" & \ Z1$ = SEG$ (Z9$,1%,SPACE%) IF SPACE% > 0% & \ Z1$ = Z1$ + SEG$ (Z9$,DOT%+2%,LEN(Z9$)) IF (DOT%+2%) <= LENZ9% & \ Z9$ = Z1$ & \ GO TO 16380 & & ! Wipe out any word in the name field that ends in "." . & ! This means that Mr., Jr., Lic. and initials (with a ".") are wiped, & ! but that names with an imbedded "." and initials without are left. & ! The algorithm searches for each ". " until no more are found. & ! It then searches for each space up to the ".". & ! The position of the last space before the "." is left in the & ! variable (SPACE%). & ! The new name string is set to the first portion, including the & ! space, plus the last portion after the ". ". & 16400 FN.STRIP.WPS$ = Z9$ & \ FNEND & 19000 !*************************************************************** & ! & ! & ! S T A N D A R D E R R O R H A N D L I N G & ! & ! & !*************************************************************** & 19010 GO TO 19990 IF ERN$ <> SEG$ (ERR.PROGNAM$,1%,6%) & ! Only tracing back an error from another subprogram. & 19100 IF ERR = 154% & THEN RESUME 3400 IF ERL = 3330% & \ RESUME 3420 IF ERL = 3350% & \ RESUME 4290 IF ERL = 4280% & ! Handle record/bucket lock for address records. & 19200 RESUME 3390 IF ERL = 3330 AND ERR = 11 ! eof & \ RESUME 3390 IF ERL = 3330 AND ERR = 155 ! not on file & \ RESUME 3390 IF ERL = 3350 AND ERR = 11 ! eof & \ RESUME 3390 IF ERL = 3350 AND ERR = 155 ! not on file & \ RESUME 2210 IF ERL = 2210 AND ERR = 154 ! locked & \ RESUME 2289 IF ERL = 2210 AND ERR = 11 ! eof & \ RESUME 2289 IF ERL = 2210 AND ERR = 155 ! not on file & \ RESUME 4340 IF ERL = 4280 AND ERR = 11 ! eof & ! Handle expected error traps. & 19250 GO TO 3000 IF ERR = 5 AND (ERL = 4030 OR ERL = 4040) & ! Resume at sort selection menu if you tried to kill a non-existant & ! file. & 19300 GO TO 19990 IF ERL <> 4050 & ! Branch around next block of error checking if not trapped & ! at line 4050. & 19400 M11.MSG$ = "Error in opening " + LIST.DOC.FILE$ & \ M11.MSG$ = "File name is invalid as specified." IF ERR = 2 & \ M11.MSG$ = "Account or device in use." IF ERR = 3 & \ M11.MSG$ = "Specified device is full." IF ERR = 4 & \ M11.MSG$ = "Specified account does not exist." IF ERR = 5 & \ M11.MSG$ = "Specified device does not exist." IF ERR = 6 & \ M11.MSG$ = "That device isn't available." IF ERR = 8 & \ M11.MSG$ = "Disk pack mounted for read only." IF ERR = 10 & \ M11.MSG$ = "Specified device is write protected." IF ERR = 14 & \ M11.MSG$ = "That output file already exists." IF ERR = 16 & \ M11.MSG$ = "No pack mounted on specified device." IF ERR = 21 & \ M11.MSG$ = "?Disk pack is locked out." IF ERR = 22 & \ M11.MSG$ = "Pack on specified device is private." IF ERR = 24 & \ M11.MSG$ = TRM$ (M11.MSG$) +" Someone logged onto that terminal?" & IF SEG$ (LIST.DOC.FILE$, 1%, 2%) = "KB" AND ERR = 8 & \ RESUME 19410 & 19410 GO SUB 14900 & \ LIST.DOC.FILE$ = "" & \ GO TO 4030 & ! Handle specific error. & 19900 ERR.ERL% = ERL & \ ERR.ERR% = ERR & \ ERR.CODE% = FATAL.ERROR% & ! On fatal error, set the error code. & 19990 ON ERROR GO BACK & ! Return to calling program for fatal error processing. & & & 32767 SUBEND �

1 SUB M11WPS & 2 !******************************************************************** & ! & ! & ! M11WPS & ! & ! Creates a Word Processing compatible List & ! Document File from a Mailing List or Sublist & ! & ! & !******************************************************************** & ! 3 ! Program : M11WPS & ! Version : 01 10-Dec-82 & ! Programmer : Brian Keane & ! Releaser : Jean Fullerton & ! & !--------------------------------------------------------------------- 11 ! & ! & ! & ! C O P Y R I G H T & ! & ! & ! & ! (C) Copyright 1982 & ! Digital Equipment Corporation, Maynard, Massachusetts & ! & ! This software is furnished under a license for use only & ! on a single computer system and may be copied only with & ! the inclusion of the above copyright notice. This & ! software, or any other copies thereof, may not be pro- & ! vided or otherwise made available to any other person & ! except for use of such system and to one who agrees to & ! these license terms. Title to and ownership of the & ! software shall at all times remain in DIGITAL. & ! & ! The information in this software is subject to change & ! without notice and should not be construed as a commit- & ! ment by Digital Equipment Corporation. & ! & ! DIGITAL assumes no responsibility for the use or relia- & ! bility of its software on equipment that is not sup- & ! plied by DIGITAL. & ! & !--------------------------------------------------------------------- 20 ! ! ! MODIFICATION HISTORY ! ! Ver Date By ! 1.1 15-Jun-84 Mike Brown ! Added ,<LAST NAME>, and <FIRST NAME> fields to ! list document when <NAME> field is requested. Lines 4232, ! 4233, FN.STRIP.WPS$, FN.REMOVE$ ! ! Insert blank line to separate records. Line 4275. !--------------------------------------------------------------------- 100 ! & ! Summary: & ! & ! Creates a word processing List Document file from a mailing & ! list or a specified sublist. & ! & ! Description: & ! & ! This subprogram prompts the user for the selection criteria & ! (that is: all, permanent sublist, or temporary sublist), asks & ! for a sort order (only primary or secondary key sorts are & ! available), requests the name of the output List Document & ! File, and prompts the user for the specific categories to & ! include in the output document. It then outputs to the List & ! Document File the field names and field values specified by & ! the user for all addresses that meet the criteria chosen. & ! & ! & !--------------------------------------------------------------------- 200 ! & ! & ! Interfaces: & ! & ! COMERR - Common Error buffer & ! COMCON - Common Constant buffer & ! COMVAR - Common Variable buffer & ! & ! MAPSCR - Screen buffer & ! MAPHDR - Mail file header buffer & ! MAPMLF - Address record buffer & ! MAPSUB - Sublist definition buffer & ! MAPADD - Unpacked address buffer & ! MAPSEL - Sublist definition array buffer & ! & ! & !--------------------------------------------------------------------- 300 ! & ! & ! Input / Output: & ! & ! & ! Channel Filename Map name Status at entry/exit & ! ------- --------- -------- -------------------- & ! CH.ADD% M11.MAIL.FILE$ MAPMLF OPEN/OPEN & ! CH.KB% "KB:" OPEN/OPEN & ! CH.PRT% LIST.DOC.FILE$ CLOSED/CLOSED & ! & !--------------------------------------------------------------------- 400 ! & ! & ! Variable and Array Definitions: & ! & ! & ! ACCOUNT.SPECIFIED% Flags presence of [n,n] in output file spec & ! AND% Constant value for logical AND & ! ANS$ User keyboard response from M11SCR & ! DEFAULT$ Default value passed to M11SCR & ! ERL Line in which error occurred & ! ERR Set to error number after error & ! FIELD.COUNT% Index used for specifying address fields & ! FIELD.NUMBER%(17%) Contains indices of included address fields. & ! FILE.AROUND% Flags List Document File as open & ! FILE.OK% Flags input file spec as valid/invalid & ! F.END% Control Z was typed by user (M11SCR) & ! INCLUDED.FIELD.COUNT% Counts number of address fields specified & ! LINES% Number of lines displayed on screen & ! MATCH% Logical value returned from SUBEXT (does & ! the address match the selection criteria & ! NAM$ Name of sublist selected by user & ! NAMES% Total number of addresses displayed & ! OR% Constant value for logical OR & ! REC$ Dynamic length buffer returned from M11UPK & ! ROW.POS% Contains row position for obtaining response & ! from the field selection screen & ! SAV.PRIME.ID$ Variable to contain sublist def. record key & ! TERMINATING.RECORD$ Constant ("<>") Record terminator & ! & !--------------------------------------------------------------------- 600 ! & ! COMMON Statements & ! & !--------------------------------------------------------------------- 650 !-------------------------------------------------------------------- & ! & ! MAP Statements & ! & !--------------------------------------------------------------------- 700 !-------------------------------------------------------------------- & ! & ! & ! Subprograms: & ! & ! Name Description & ! ---- ----------- & ! & ! M11SCD Forms display & ! M11SCW Screen write (writes one line to screen) & ! M11SCR Screen read (reads one field from screen) & ! M11UPK Upacks one address record and leaves in & ! MAPADD & ! & !-------------------------------------------------------------------- & ! 800 ! Subroutines: & ! & ! Line Number Description & ! ---- ------ ----------- & ! & ! 12000 (SUBLSD) Load sublist definition into memory & ! 12100 (SUBCNV) Convert sublist definition numeric and date & ! fields & ! 13500 (SUBEXT) Determine if address record meets selection & ! criteria & ! 14800 (SUBNOT) Print an informational message on the screen & ! 14900 (SUBERR) Print an error message on the screen & ! & ! & !-------------------------------------------------------------------- & ! & ! Functions: & ! & ! Name Description & ! ---- ----------- & ! & ! FN.DATE.CNV$ Convert a date from DD-MMM-YY to YYMMDD & ! FN.RJZF$ Right justify zero fill a numeric string & ! FNFILE% Checks for a valid file spec & ! & !-------------------------------------------------------------------- & 900 DIM TRUTH%(30%) ! One logical entry for each sublist def line & \ DIM AND.OR%(30%) ! AND or OR with the previous def line? & \ DIM FIELD.NUMBER%(17%) ! Holds which fields are in list file & \ DIM DEFAULT.ANS$(17%) ! Holds default responses to field specifers & 1000 !******************************************************************** & ! & ! & ! S T A R T P R O G R A M L O G I C & ! & ! & !******************************************************************** & 1010 ON ERROR GOTO 19000 & \ ERR.PROGNAM$ = "M11WPS VER:01" & \ ERR.SUBNAM$ = "" & \ ERR.MSG$ = "Unexpected fatal error" & \ PLEASE.WAIT$ = "The next address is in use by another user. Please wait." & ! Set standard error trap. Set up common for error reporting. & & 1040 AND% = 1% & \ OR% = 2% & ! Initialize constants. & 2000 !-------------------------------------------------------------------- & ! & ! Entire List or just sublist ? & ! & !-------------------------------------------------------------------- & 2100 CALL M11SCD (SCR.LIST.SELECT%) & ! Show the list selection choice. & 2120 CALL M11SCR (ANS$, 18%, 42%, 1%, "A", "A", F.END%) & \ GO TO 9000 IF F.END% & ! Get the answer, clear out if 'END'. & 2140 M11.LIST.CODE$ = ANS$ & \ GO TO 2200 IF POS("AST",ANS$,1%) > 0% & ! Save answer. Skip help message if valid response was entered. & 2190 CALL M11SCD (SCR.HLP.13%) & \ M11.MSG$ = " " & \ GO SUB 14900 & \ GO TO 2100 & ! Give help because answer not acceptable (including help requests) & 2200 GO TO 2300 UNLESS M11.LIST.CODE$ = "S" & \ DEFAULT$ = "" & \ DEFAULT$ = M11.SUBLIST.NAME$ IF M11.SUBLIST.CODE% = PERM% & \ CALL M11SCR (NAM$, 10%, 41%, 10%, DEFAULT$, "A", F.END%) & \ GO TO 2120 IF F.END% & \ GO TO 2190 IF NAM$ = "?" & \ IF NAM$ = "" & THEN IF M11.SUBLIST.CODE% = TEMP% & THEN GOSUB 12100 ! Convert numeric + date fields & \ GO TO 3000 & ELSE M11.MSG$ = "A temporary sublist does not currently exist." & \ GO TO 2290 & ELSE IF M11.SUBLIST.CODE% = PERM% AND NAM$ = M11.SUBLIST.NAME$ & THEN GOSUB 12100 ! Convert numeric + date fields & \ GO TO 3000 & ELSE SAV.PRIME.ID$ = SUB.CHR$ + SEG$ (NAM$ + SPACE$(10%), 1%,10%) & \ SUB.KEY0$ = SAV.PRIME.ID$ + "00001" & 2210 GET #CH.ADD%, KEY #0% EQ SUB.KEY0$ & 2220 M11.SUBLIST.CODE% = PERM% & \ M11.SUBLIST.NAME$ = NAM$ & \ GOSUB 12000 ! Load sublist definition & \ GOSUB 12100 ! Convert numeric + date fields & \ GO TO 3000 & ! If the answer is "sublist"... & ! Ask the user which one (the default is the current one, if any). & ! Unless the user picks the current one, send her back to main menu. & 2289 M11.MSG$ = "Sublist " + NAM$ + " does not currently exist." & ! Program traps back to here if the stored sublist does not exist. & 2290 CALL M11SCW (M11.MSG$, 23%, 1%) & \ M11.MSG$ = "Do you wish to go back to create that sublist definition (Y/N)?" & \ CALL M11SCW (M11.MSG$, 24%, 1%) & \ CALL M11SCR (ANS$, 24%, 66%, 1%, "Y", "Y", F.END%) & \ CALL M11SCW (ERASE.EOL$, 23%, 1%) & \ GO TO 2120 IF F.END% & \ IF ANS$ = "Y" & THEN ERR.CODE% = 10% & \ GO TO 9000 & ELSE GO TO 2120 & ! Handle the case where the user has requested a sublist that does & ! not exist (yet). & 2300 GO TO 3000 UNLESS M11.LIST.CODE$ = "T" & \ IF M11.SUBLIST.CODE% = TEMP% & THEN GOSUB 12100 & \ GO TO 3000 & ELSE M11.MSG$ = "A temporary sublist does not currently exist." & \ GO TO 2290 & ! If the temporary sublist was requested, check that it exists. If & ! it does, convert date and numeric fields. Otherwise, complain. & 3000 !-------------------------------------------------------------------- & ! & ! Sort Options & ! & !-------------------------------------------------------------------- & 3100 CALL M11SCD (SCR.DSP.SORT.MENU%) & ! Show the sort option menu. & 3120 CALL M11SCR (ANS$, 19%, 42%, 1%, "P", "A", F.END%) & \ GO TO 2000 IF F.END% & ! Get the answer, clear out if 'END'. & 3140 GO TO 3200 IF POS ("PA", ANS$, 1%) > 0% & ! Check for a proper answer. & 3190 CALL M11SCD (SCR.HLP.19%) & \ M11.MSG$ = " " & \ GO SUB 14900 & \ GO TO 3100 & ! Give help because answer not acceptable (including help requests). & 3200 M11.SORT.CODE$ = ANS$ & ! Save answer. & 3300 !-------------------------------------------------------------------- & ! & ! Any acceptable addresses ? & ! & !-------------------------------------------------------------------- & 3320 IF M11.SORT.CODE$ = "A" & THEN RESTORE #CH.ADD%, KEY #1% & ELSE RESTORE #CH.ADD%, KEY #0% & ! Start by determining and setting the access key. & 3330 IF M11.SORT.CODE$ = "A" & THEN GET #CH.ADD%, KEY #1% GE " " & ELSE GET #CH.ADD%, KEY #0% GT SUB.CHR$ + "zzzzzzzzzzzzzzz" & ! Then get the first name record (after any header records). & 3340 MOVE FROM #CH.ADD%, REC$ = RECOUNT & \ CALL M11UPK (REC$) & \ GO TO 4000 IF M11.LIST.CODE$ = "A" & \ GO SUB 13500 & \ GO TO 4000 IF MATCH% & 3350 GET #CH.ADD% & & \ GO TO 3340 & ! Loop thru the Mailing List File, until the first acceptable & ! address is found. & 3390 M11.MSG$ = "There are no addresses in this Mailing List File." & IF ERL = 3330 & \ M11.MSG$ = "There are no addresses that meet the sublist definition." & IF ERL = 3350 & \ GO SUB 14900 & \ GO TO 9000 IF M11.LIST.CODE$ = "A" & \ GO TO 2000 IF M11.LIST.CODE$ <> "A" & ! Warn the user that there is nothing to print. & ! Transfer to Main Menu if there is nothing at all; & ! transfer to the list selection if there is nothing in that sublist. & 3400 CALL M11SCW(PLEASE.WAIT$,24%,1%) & \ SLEEP 2% & \ CALL M11SCW(ERASE.EOL$,24%,1%) & \ GO TO 3330 & ! Handle a locked record at 3330. & 3420 CALL M11SCW (PLEASE.WAIT$, 24%, 1%) & \ SLEEP 2% & \ CALL M11SCW (ERASE.EOL$, 24%, 1%) & \ GO TO 3350 & ! Handle a locked record at 3350. & 4000 !-------------------------------------------------------------------- & ! & ! & ! List Document Specification & ! & ! & !-------------------------------------------------------------------- & 4020 UNLOCK #CH.ADD% & \ CALL M11SCD (SCR.WPSLIST%) & \ CALL M11SCW (HDR.CAT.PROMPT$(I%), 8%+I%, 47%) FOR I% = 1% TO 6% & \ LIST.DOC.FILE$ = "" & \ FILE.AROUND% = FALSE% & \ DEFAULT.ANS$(I%) = "N" FOR I% = 1% TO 17% & ! Show the List Document Selection Screen & ! Fill in the custom category information & ! Initialize output filename, file opened flag, default selections. & 4030 CALL M11SCR (ANS$, 5%, 37%, 30%, LIST.DOC.FILE$, "A", F.END%) & \ KILL LIST.DOC.FILE$ IF F.END% AND FILE.AROUND% & \ GO TO 3000 IF F.END% & \ IF SEG$(ANS$, 1%, 1%) = "?" & THEN CALL M11SCD(SCR.HLP.WPSLIST%) & \ M11.MSG$ = "" & \ GO SUB 14900 & \ KILL LIST.DOC.FILE$ IF FILE.AROUND% & \ GO TO 4020 & ! Ask the user for the name of the output file. & ! Finish up if the user aborts by END or ^Z. & ! Provide help if the user types ?, then refresh previous screen. & 4035 GO TO 4100 IF (ANS$ = LIST.DOC.FILE$) AND FILE.AROUND% & \ ANS$ = ANS$ + ".DOC" IF POS (ANS$, ".", 1%) = 0% & \ FILE.OK% = FNFILE% (ANS$) & \ IF NOT FILE.OK% & THEN LIST.DOC.FILE$ = "" & \ GO TO 4030 & ELSE CALL M11SCW(ANS$, 5%, 37%) & ! If the user does not provide a file type in his specification, & ! then provide the default (.DOC). & ! If the file name is incorrect, or if a non privileged user is & ! trying to create a file in another account, then reprompt for & ! a file specification. If it is OK, then redisplay file spec. & 4040 IF FILE.AROUND% & THEN FILE.AROUND% = FALSE% & \ KILL LIST.DOC.FILE$ & ! Don't reopen file if it had been previously opened. & ! Kill old file and reset flag if changing files. & 4045 LIST.DOC.FILE$ = ANS$ & 4050 OPEN LIST.DOC.FILE$ FOR OUTPUT AS FILE #CH.PRT%, MODE 128% & \ FILE.AROUND% = TRUE% & ! Open the user specified file & ! Proceed with address field specification. & 4100 !-------------------------------------------------------------------- & ! & ! Address Field Selection & ! & !-------------------------------------------------------------------- & 4110 INCLUDED.FIELD.COUNT% = 0% & ! Initialize the number of included fields to zero & 4120 FOR FIELD.COUNT% = 1% TO 17% & \ IF FIELD.COUNT% <= 7% & THEN COLUMN.POS% = 29% & \ ROW.POS% = FIELD.COUNT% + 8% & ELSE COLUMN.POS% = 68% & \ ROW.POS% = FIELD.COUNT% + 1% & ! Set up loop to get user response to each address field & ! Compute row and column positions for inputting from the two & ! column screen (fields 1-7 in left column, 8-17 in right column). & 4125 CALL M11SCR (ANS$, ROW.POS%, COLUMN.POS%, 1%, & DEFAULT.ANS$(FIELD.COUNT%), "Y", F.END%) & \ GO TO 4030 IF F.END% AND FIELD.COUNT% = 1% & \ GO TO 4100 IF F.END% & ! Get the users answer for the particular address field. & ! If the user typed END or ^Z, go back to output file specification. & 4130 IF ANS$ = "?" & THEN M11.MSG$ = "Type Y to include the field, " & + "N to exclude it." & \ CALL M11SCW (M11.MSG$, 24%, 1%) & \ GO TO 4125 & ! Provide help because the user requested it. & ! Display help. & ! Continue where he left off. & 4135 IF ANS$ = "Y" & THEN INCLUDED.FIELD.COUNT% = INCLUDED.FIELD.COUNT% + 1% & \ FIELD.NUMBER%(INCLUDED.FIELD.COUNT%) = FIELD.COUNT% & \ DEFAULT.ANS$(FIELD.COUNT%) = "Y" & ! If the user specifies the field to be included, & ! then increment the number of included fields counter, & ! and store which field it is (1=NAME, 2=ADDR1, etc). & 4140 NEXT FIELD.COUNT% & ! Process the next address field. & 4150 IF INCLUDED.FIELD.COUNT% = 0% & THEN M11.MSG$ = "You must say yes to at least one field." & \ GO SUB 14900 & \ GO TO 4120 & ! If the user did not select any address fields, & ! then notify user of the error, and return to the first & ! address field. & 4200 !---------------------------------------------------------------------& ! & ! Build List Document File & ! & !---------------------------------------------------------------------& 4210 NAMES% = 0% & \ TERMINATING.RECORD$ = "<>" & ! Initialize counters and constants for List Document generation & ! NAMES% indicates the number of address records output. & ! TERMINATING.RECORD$ is the delimiter between address records in & ! the output file. & 4220 CLOSE #CH.KB% & \ C = CTRLC & \ OPEN "KB:" AS FILE #CH.KB% & ! Close keyboard (block mode). & ! Enable Control/C trapping. & ! Reopen keyboard in normal mode. & 4225 M11.MSG$ = "Creating List Document File " + LIST.DOC.FILE$ & + " ... Please wait" & \ GO SUB 14800 & ! Notify the user that the list document file is being created & 4230 FOR I% = 1% TO INCLUDED.FIELD.COUNT% & \ CAT% = FIELD.NUMBER%(I%) - 7% & \ ON FIELD.NUMBER%(I%) GO TO 4232, 4234, 4236, 4238, 4240, 4242, & 4244, 4246, 4246, 4246, 4246, 4246, & 4246, 4258, 4260, 4262, 4264 & ! For each field that the user selected, branch to a section of & ! the program which prints the appropriate <FIELD IDENTIFIER> & ! and field value to the output file. & ! INCLUDED.FIELD.COUNT% indicates the number of address fields & ! selected for inclusion in the list document file. & 4232 PRINT #CH.PRT%, "<NAME>"; EDIT$ (ADD.NAME$, 128%) ! First, print the name field. NAME$ = EDIT$ ( ADD.NAME$, 128% + 16% ) SPACE% = POS ( NAME$, " ", 1% ) IF SEG$ ( NAME$, SPACE%-1%, SPACE%-1% ) = "." THEN PRINT #CH.PRT%, "<TITLE>"; SEG$ ( NAME$, 1%, SPACE%-1% ) ELSE PRINT #CH.PRT%, "<TITLE>" END IF ! Print the TITLE field name, and the field value if one was found. Z9$ = FN.STRIP.WPS$ ( NAME$ ) Z9$ = EDIT$ ( Z9$, 128% ) Z9.LEN% = LEN (Z9$) GO TO 4233 IF SEG$ (Z9$, P%, P% ) = " " & FOR P% = Z9.LEN% TO 1% STEP -1% P% = 0% ! Remove titles and words ending with "." . ! Locate space before last name. 4233 LAST_NAME$ = SEG$ (Z9$, P% + 1%, Z9.LEN%) PRINT #CH.PRT%, "<LAST NAME>"; LAST_NAME$ ! Extract last (or only) name and print last name field ! and field value. SPACE% = POS ( Z9$, " " , 1% ) IF SPACE% = 0% THEN FIRST_NAME$ = "" ELSE FIRST_NAME$ = SEG$ ( Z9$, 1%, SPACE%-1% ) END IF PRINT #CH.PRT%, "<FIRST NAME>"; FIRST_NAME$ ! Locate FIRST space and extract first name if there is one. ! Print first name field and field value. GO TO 4270 4234 PRINT #CH.PRT%, "<ADDRESS LINE 1>"; EDIT$ (ADD.ADDR1$, 128%) & \ GO TO 4270 & 4236 PRINT #CH.PRT%, "<ADDRESS LINE 2>"; EDIT$ (ADD.ADDR2$, 128%) & \ GO TO 4270 & 4238 PRINT #CH.PRT%, "<ADDRESS LINE 3>"; EDIT$ (ADD.ADDR3$, 128%) & \ GO TO 4270 & 4240 PRINT #CH.PRT%, "<CITY/TOWN>"; EDIT$ (ADD.CITY$, 128%) & \ GO TO 4270 & 4242 PRINT #CH.PRT%, "<STATE/COUNTRY>"; EDIT$ (ADD.STATE$, 128%) & \ GO TO 4270 & 4244 PRINT #CH.PRT%, "<ZIP CODE>"; EDIT$ (ADD.ZIP$, 128%) & \ GO TO 4270 & 4246 PRINT #CH.PRT%, "<"; EDIT$ (HDR.CAT.PROMPT$(CAT%), 8%+ 128%); & ">"; EDIT$ (ADD.CATEGORIES$(CAT%-1%), 128%) & \ GO TO 4270 & 4258 PRINT #CH.PRT%, "<COUNTER>"; EDIT$ (NUM1$(ADD.COUNTER%),128%) & \ GO TO 4270 & 4260 PRINT #CH.PRT%, "<REMARK>"; EDIT$ (ADD.COMMENT$, 128%) & \ GO TO 4270 & 4262 PRINT #CH.PRT%, "<PRIMARY ID>"; EDIT$ (ADD.PRIME.ID$, 128%) & \ GO TO 4270 & 4264 PRINT #CH.PRT%, "<ALTERNATE ID>"; EDIT$ (ADD.ALTERNATE.ID$,128%) & \ GO TO 4270 & 4270 NEXT I% & ! Get the next selected address field. & 4275 PRINT #CH.PRT%, TERMINATING.RECORD$ + CR + LF & \ NAMES% = NAMES% + 1% & \ IF (NAMES% / 10% * 10%) = NAMES% & THEN M11.MSG$ = "Addresses Printed = " + STR$(NAMES%) & \ CALL M11SCW (M11.MSG$, 16%, 10%) & ! Print the terminating record of the set of address output records. & ! Update the addresses printed counter. & ! Notify user every ten records printed. 4280 GET #CH.ADD% & ! Get next record. & 4285 MOVE FROM #CH.ADD%, REC$ = RECOUNT & \ CALL M11UPK (REC$) & \ GO TO 4230 IF M11.LIST.CODE$ = "A" & \ GO SUB 13500 & \ IF MATCH% THEN GO TO 4230 & ELSE GO TO 4280 & ! If it matches the sublist definition then go print it out. & ! If it does not match, then go get another record. & 4290 CALL M11SCW(PLEASE.WAIT$,24%,1%) & \ SLEEP 2% & \ CALL M11SCW(ERASE.EOL$,24%,1%) & \ GO TO 4280 & ! Handle a locked record at 4280. & 4300 !-------------------------------------------------------------------- & ! & ! Display Total & ! & !-------------------------------------------------------------------- & 4340 UNLOCK #CH.ADD% & \ M11.MSG$ ="task completed, total selected addresses = "+STR$(NAMES%)& \ GO SUB 14800 & ! Print total addresses selected and notify the user that task is & ! done. & & 9000 !******************************************************************** & ! & ! & ! E N D O F P R O C E S S I N G & ! & ! & !******************************************************************** & 9990 OPEN "KB:" AS FILE #CH.KB%, MODE 8% & \ CLOSE #CH.PRT% & \ UNLOCK #CH.ADD% & \ GO TO 32767 & ! Reopen the keyboard in echo control mode. If there were any & ! numeric or date fields converted in the sublist definition, then & ! we have to reconvert it. Jump around the junk and leave. & 10000 !*************************************************************** & ! & ! & ! S U B R O U T I N E S L O C A L T O & ! & ! T H I S P R O G R A M & ! & ! & !*************************************************************** & 12000 ! SUBLSD.120 will be appended here at compile time. & 12100 ! SUBCNV.121 will be appended here at compile time. & 13500 ! SUBEXT.135 will be appended here at compile time. & 14900 ! SUBERR.149 will be appended here at compile time. & 15000 !*************************************************************** & ! & ! & ! F U N C T I O N S L O C A L T O & ! & ! T H I S P R O G R A M & ! & ! & !*************************************************************** & 15600 ! FNDCNV.156 will be appended here at compile time. & 16000 ! FNRJZF.160 will be appended here at compile time. & & 16200 !-------------------------------------------------------------------- & ! & ! & ! FN.REMOVE$ (A$, B$) & ! & !-------------------------------------------------------------------- & ! & ! This function removes all occurrences of B$ from & ! A$ and returns the result as the function value. & ! & ! & !-------------------------------------------------------------------- & 16220 DEF FN.REMOVE$ (A$, B$) & \ Z.B.LEN% = LEN (B$) & \ Z.LOC% = POS (A$, B$, 1%) & ! Define the function. & 16240 UNTIL Z.LOC% = 0% & \ A$ = SEG$(A$,1%,Z.LOC%-1%) + SEG$(A$,Z.LOC%+Z.B.LEN%,LEN(A$)) & \ Z.LOC% = POS (A$, B$, 1%) & \ NEXT & ! Loop removing B$ from A$ (as many times as necessary). & 16260 FN.REMOVE$ = A$ & \ FNEND & & 16300 !********************************************************************* ! ! FN.STRIP.WPS$ ( ARG$ ) ! !********************************************************************* 16310 DEF FN.STRIP.WPS$ ( ARG$ ) ! This routine is identical to FN.STRIP$ except that ! ARG$ is not upcased at line 16350. 16350 !* Z9$ = EDIT$ (ARG$, 56%) & Z9$ = EDIT$ (ARG$, 24%) & ! After all this, everything is uppercase alphabetic only & ! except for periods, and single spaces which delimit words. & 16370 Z9$ = FN.REMOVE$ (Z9$, "THE ") & \ Z9$ = FN.REMOVE$ (Z9$, "The ") & \ Z9$ = FN.REMOVE$ (Z9$, " III") & \ Z9$ = FN.REMOVE$ (Z9$, " II") & ! Remove all the formal stuff. & ! For most names, we are now left with a first name, an optional & ! middle name or initial, and a surname as the last word in the name. & 16380 Z9$ = Z9$ + " " & \ DOT% = POS (Z9$, ". ", 1%) & \ GO TO 16400 IF DOT% = 0% & \ LENZ9% = LEN (Z9$) & \ SPACE% = 0% & \ SPACE% = J% IF MID (Z9$, J%, 1%) = " " FOR J% = 1% TO DOT%-1% & \ Z1$ = "" & \ Z1$ = SEG$ (Z9$,1%,SPACE%) IF SPACE% > 0% & \ Z1$ = Z1$ + SEG$ (Z9$,DOT%+2%,LEN(Z9$)) IF (DOT%+2%) <= LENZ9% & \ Z9$ = Z1$ & \ GO TO 16380 & & ! Wipe out any word in the name field that ends in "." . & ! This means that Mr., Jr., Lic. and initials (with a ".") are wiped, & ! but that names with an imbedded "." and initials without are left. & ! The algorithm searches for each ". " until no more are found. & ! It then searches for each space up to the ".". & ! The position of the last space before the "." is left in the & ! variable (SPACE%). & ! The new name string is set to the first portion, including the & ! space, plus the last portion after the ". ". & 16400 FN.STRIP.WPS$ = Z9$ & \ FNEND & 19000 !*************************************************************** & ! & ! & ! S T A N D A R D E R R O R H A N D L I N G & ! & ! & !*************************************************************** & 19010 GO TO 19990 IF ERN$ <> SEG$ (ERR.PROGNAM$,1%,6%) & ! Only tracing back an error from another subprogram. & 19100 IF ERR = 154% & THEN RESUME 3400 IF ERL = 3330% & \ RESUME 3420 IF ERL = 3350% & \ RESUME 4290 IF ERL = 4280% & ! Handle record/bucket lock for address records. & 19200 RESUME 3390 IF ERL = 3330 AND ERR = 11 ! eof & \ RESUME 3390 IF ERL = 3330 AND ERR = 155 ! not on file & \ RESUME 3390 IF ERL = 3350 AND ERR = 11 ! eof & \ RESUME 3390 IF ERL = 3350 AND ERR = 155 ! not on file & \ RESUME 2210 IF ERL = 2210 AND ERR = 154 ! locked & \ RESUME 2289 IF ERL = 2210 AND ERR = 11 ! eof & \ RESUME 2289 IF ERL = 2210 AND ERR = 155 ! not on file & \ RESUME 4340 IF ERL = 4280 AND ERR = 11 ! eof & ! Handle expected error traps. & 19250 GO TO 3000 IF ERR = 5 AND (ERL = 4030 OR ERL = 4040) & ! Resume at sort selection menu if you tried to kill a non-existant & ! file. & 19300 GO TO 19990 IF ERL <> 4050 & ! Branch around next block of error checking if not trapped & ! at line 4050. & 19400 M11.MSG$ = "Error in opening " + LIST.DOC.FILE$ & \ M11.MSG$ = "File name is invalid as specified." IF ERR = 2 & \ M11.MSG$ = "Account or device in use." IF ERR = 3 & \ M11.MSG$ = "Specified device is full." IF ERR = 4 & \ M11.MSG$ = "Specified account does not exist." IF ERR = 5 & \ M11.MSG$ = "Specified device does not exist." IF ERR = 6 & \ M11.MSG$ = "That device isn't available." IF ERR = 8 & \ M11.MSG$ = "Disk pack mounted for read only." IF ERR = 10 & \ M11.MSG$ = "Specified device is write protected." IF ERR = 14 & \ M11.MSG$ = "That output file already exists." IF ERR = 16 & \ M11.MSG$ = "No pack mounted on specified device." IF ERR = 21 & \ M11.MSG$ = "?Disk pack is locked out." IF ERR = 22 & \ M11.MSG$ = "Pack on specified device is private." IF ERR = 24 & \ M11.MSG$ = TRM$ (M11.MSG$) +" Someone logged onto that terminal?" & IF SEG$ (LIST.DOC.FILE$, 1%, 2%) = "KB" AND ERR = 8 & \ RESUME 19410 & 19410 GO SUB 14900 & \ LIST.DOC.FILE$ = "" & \ GO TO 4030 & ! Handle specific error. & 19900 ERR.ERL% = ERL & \ ERR.ERR% = ERR & \ ERR.CODE% = FATAL.ERROR% & ! On fatal error, set the error code. & 19990 ON ERROR GO BACK & ! Return to calling program for fatal error processing. & & & 32767 SUBEND �