Pick/BASIC: A Programmer's Guide
WWW Edition January, 2000
Chapter 14
A Generalized Data Entry Program
|
Jonathan E. Sisk's
Pick/BASIC: A Programmer's Guide WWW Edition January, 2000 Chapter 14
|
Program example 12 employs nearly all the techniques discussed in the previous exercises. This is a full-blown data entry program which may be used to add data to the STAFF file, correct existing data, and remove unwanted data.
Note from the author (July 21, 1995): This credit for this program should have been attributed to the late Ken Simms long ago. It not only illustrates beautifully structured code, but is also an example of the kind of code generated by his Wizard 4GL, which is still commercially available today.
Enter the example program from the listing in Fig. 14-1. As you do, remember that the logic of the program is nearly as important as the program instructions used.
007 * SETUP WORK ARRAYS
008 *
009 DIM SCREEN.LABELS (10)
010 DIM LABEL.COLUMN(10)
011 DIM LABEL.ROW(10)
012 DIM DATA.COLUMN(10)
013 DIM DATA.ROW(10)
014 DIM INPUT.CONVERSIONS(10)
015 DIM OUTPUT.CONVERSIONS(10)
016 DIM LENGTH(10)
017 DIM STAFF.ITEM(10)
Fig. 14-1. Program Example 12.
EX.012
001 * FILE.IO
002 * UPDATING FILES AND ITEMS
003 * mm/dd/yy: date last modified
004 * JES: author's initials
005 *
006 *
007 * SETUP WORK ARRAYS
008 *
009 DIM SCREEN.LABELS(10)
010 DIM LABEL.COLUMN(10)
011 DIM LABEL.ROW(10)
012 DIM DATA.COLUMN(10)
013 DIM DATA.ROW(10)
014 DIM INPUT.CONVERSIONS(10)
015 DIM OUTPUT.CONVERSIONS(10)
016 DIM LENGTH(10)
017 DIM STAFF.ITEM(10)
018 *
019 * DEFINE CONSTANTS
020 *
021 PROMPT ""
022 EQUATE TRUE TO 1
023 EQUATE FALSE TO 0
024 LAST.FIELD = 7
025 *
026 * DEFINE VARIABLES
027 *
028 EXIT.FLAG = FALSE
029 ERROR.FLAG = FALSE
030 CURRENT.FIELD = 1
031 *
032 * OPEN FILES
033
*
034 OPEN "STAFF" TO STAFF.FILE ELSE
035 PRINT "STAFF IS NOT A FILE NAME"
036 INPUT ANYTHING
037 STOP
038 END
039 *
040 * DEFINE SCREEN.LABELS
041 *
042 SCREEN.LABELS(1) = "1 NAME"
043 SCREEN.LABELS(2) = "2 ADDRESS"
044 SCREEN.LABELS(3) = "3 CITY"
045 SCREEN.LABELS(4) = "4 STATE"
046 SCREEN.LABELS(5) = "5 ZIP"
047 SCREEN.LABELS(6) = "6 PHONE"
048 SCREEN.LABELS(7) = "7 BIRTHDAY"
049 *
050 * DEFINE LABEL.COLUMN
051 *
052 LABEL.COLUMN(1) = 3
053 LABEL.COLUMN(2) = 3
054 LABEL.COLUMN(3) = 3
055 LABEL.COLUMN(4) = 3
056 LABEL.COLUMN(5) = 3
057 LABEL.COLUMN(6) = 3
058 LABEL.COLUMN(7) = 3
059 *
060 * DEFINE LABEL.ROW
061 *
062 LABEL.ROW (1) = 4
063 LABEL.ROW(2) = 5
064 LABEL.ROW(3) = 6
065 LABEL.ROW(4) = 7
066 LABEL.ROW(5) = 8
067 LABEL.ROW(6) = 9
068 LABEL.ROW(7) = 10
069 *
070 * DEFINE DATA.COLUMN
071 *
072 DATA.COLUMN(1) = 20
073 DATA.COLUMN(2) = 20
074 DATA.COLUMN(3) = 20
075 DATA.COLUMN(4) = 20
076 DATA.COLUMN(5) = 20
077 DATA.COLUMN(6) = 20
078 DATA.COLUMN(7) = 20
079 *
080 * DEFINE DATA.ROW
081 *
082 DATA.ROW(l) = 4
083 DATA.ROW(2) = 5
084 DATA.ROW(3) = 6
085 DATA.ROW(4) = 7
086 DATA.ROW(5) = 8
087 DATA.ROW(6) = 9
088 DATA.ROW(7) = 10
089 *
090 * DEFINE INPUT.CONVERSIONS
091 *
092 INPUT.CONVERSIONS(l) = ""
093 INPUT.CONVERSIONS(2) = ""
094 INPUT.CONVERSIONS(3) = ""
095 INPUT.CONVERSIONS(4) = "P(2A)"
096 INPUT.CONVERSIONS(5) = "P(5N)"
097 INPUT.CONVERSIONS(6) = ""
098 INPUT.CONVERSIONS(7) = "D"
099 *
100 * DEFINE OUTPUT.CONVERSIONS
101 *
102 OUTPUT.CONVERSIONS(1) = ""
103 OUTPUT.CONVERSIONS(2) = ""
104 OUTPUT.CONVERSIONS(3) = ""
105 OUTPUT.CONVERSIONS(4) = ""
106 OUTPUT.CONVERSIONS(5) = ""
107 OUTPUT.CONVERSIONS(6) = ""
108 OUTPUT.CONVERSIONS(7) = "D2/"
109 *
110 * DEFINE LENGTH
111 *
112 LENGTH(1) = 30
113 LENGTH(2) = 30
114 LENGTH(3) = 30
115 LENGTH(4) = 30
116 LENGTH(5) = 30
117 LENGTH(6) = 30
118 LENGTH(7) = 30
119 *
120 * MAIN POINT OF PROGRAM
121 *
122 LOOP
123 GOSUB 1000 ; * ENTER ID
AND READ ITEM
124 UNTIL EXIT.FLAG DO
125 GOSUB 2000 ; * EDIT ITEM
126 REPEAT
127 STOP ; * END OF PROGRAM
128 *
129 1000 * ENTER ID AND READ ITEM
130 *
131 PRINT @(-1) : ; * CLEAR SCREEN
132 LOOP
133 PRINT @(3,2) : "ENTER ITEM-ID
OR 'QUIT' TO STOP" '
134 INPUT STAFF.ID
135 UNTIL STAFF.ID > '' DO REPEAT
136 IF STAFF. ID = "QUIT" THEN EXIT.FLAG = TRUE
ELSE EXIT.FLAG = FALSE
137 *
138 * READ ITEM
139 *
140 NEW.ITEM.FLAG = FALSE
141 MATREAD STAFF.ITEM FROM STAFF.FILE, STAFF.
ID ELSE
142 MAT STAFF.ITEM = ' '
143 NEW.ITEM.FLAG = TRUE
144 END
145 RETURN ; * DONE WITH ENTER ID AND READ ITEM
146 *
147 2000 * EDIT ITEM
148 *
149 GOSUB 10000 ; * PRINT LABELS
150 GOSUB 20000 ; * PRINT DATA
151 IF NEW. ITEM.FLAG THEN
152 GOSUB 30000 ; * ENTER NEW
ITEM
153 END
154 GOSUB 40000 ; * UPDATE OLD ITEM
155 RETURN
156 *
157 10000 * PRINT LABELS
158 *
159 FOR I = 1 TO LAST.FIELD
160 PRINT @(LABEL.COLUMN(I),LABEL.ROW(I)):
SCREEN.LABELS(I):
161 NEXT I
162 RETURN
163 *
164 20000 * PRINT DATA
165 *
166 FOR I = 1 TO LAST.FIELD
167 GOSUB 25000; * PRINT ONE
DATUM
168 NEXT I
169 RETURN
170 *
171 25000 * PRINT ONE DATUM
172 *
173 IF OUTPUT.CONVERSIONS(I) # "" THEN
174 PRINT.VALUE = OCONV(STAFF.ITEM(I)
,OUTPUT.CONVERSIONS(I))
175 END ELSE
176 PRINT.VALUE = STAFF.ITEM(I)
177 END
178 PRINT @(DATA.COLUMN(I),DATA.ROW(I)):(PRINT.VALUE)
('L#' :LENGTH(I) ):
179 RETURN
180 *
181 30000 * ENTER NEW ITEM
182 *
183 CURRENT.FIELD = 1
184 LOOP
185 PRINT @(DATA.COLUMN(CURRENT.FIELD)
,DATA.ROW(CURRENT.FIELD) ) :
186 INPUT ANS, LENGTH (CURRENT.FIELD)
187 BEGIN CASE
188 CASE
ANS = "QUIT"
189
EXIT.FLAG = TRUE
190 CASE
ANS = ""
191
CURRENT.FIELD = CURRENT.FIELD + 1
192 CASE
ANS = "^"
193
I = CURRENT.FIELD; GOSUB 25000; * PRINT ONE DATUM
194
IF CURRENT.FIELD >= 2 THEN CURRENT.FIELD=CURRENT.FIELD-1
195 CASE
1
196
GOSUB 35000 ; * GET VALIDATED DATUM, STORE IN STAFF.ITEM
197
IF NOT(ERROR.FLAG) THEN CURRENT.FIELD = CURRENT.FIELD + 1
198 END CASE
199 UNTIL CURRENT.FIELD > LAST.FIELD OR EXIT.FLAG
= TRUE DO REPEAT
200 RETURN
201 *
202 35000 * GET VALIDATED DATUM, STORE IN STAFF.ITEM, REPRINT
203 * INPUT = ANS > ". OUTPUT = ANS, ERROR.FLAG
204 *
205 IF ERROR.FLAG THEN PRINT @(3,21): @(-4):
206 ERROR.FLAG = FALSE
207 IF INPUT.CONVERSIONS(CURRENT.FIELD) > "" THEN
208 TEMP = ICONV(ANS,INPUT.CONVERSIONS(CURRENT.FIELD))
209 IF TEMP = "" THEN ; * NOT
GOOD
210 PRINT @(3,21):
"UNEXPECTED FORMAT. PLEASE TRY AGAIN"
211 ERROR.FLAG
= TRUE
212 END ELSE
213 ANS = TEMP
214 END
215 END
216 IF NOT(ERROR.FLAG) THEN STAFF.ITEM(CURRENT.FIELD)
= ANS
217 I = CURRENT.FIELD; GOSUB 25000; * PRINT ONE
DATUM
218 RETURN
219 *
220 40000 * UPDATE OLD ITEM
221 *
222 LOOP
223 PRINT @(3,20):
224 PRINT "ENTER FIELD # TO
CHANGE, E(X)IT, (D)ELETE, (F)ILE":
225 INPUT OPTION
226 BEGIN CASE
227 CASE
NUM(OPTION)
228
IF OPTION >= 1 AND OPTION <= LAST.FIELD THEN
229
CURRENT.FIELD = OPTION
230
PRINT @(DATA.COLUMN(CURRENT.FIELD),DATA.ROW(CURRENT.FIELD)):
231
INPUT ANS, LENGTH(CURRENT.FIELD)
232
IF ANS > "" THEN GOSUB 35000; * VALIDATE, STORE
233
END
234 CASE
OPTION = "X" OR OPTION = "QUIT"
235
EXIT.FLAG = TRUE
236 CASE
OPTION = "D"
237
DELETE STAFF.FILE,STAFF.ID
238
PRINT "ITEM DELETED"
239 CASE
OPTION = "F"
240
MATWRITE STAFF. ITEM ON STAFF.FILE,STAFF.ID
241 END CASE
242 UNTIL INDEX("XDF",OPTION,1) AND OPTION >
"" DO REPEAT
243 RETURN
244 *
245 END
A dimensioned array is very different from a dynamic array. No DIM (dimension) statement is required for dynamic arrays. An item read in with the READ statement is treated as one long string of characters, each of which is delimited by the special reserved delimiters: attribute marks, value marks, and subvalue marks. When an element from a dynamic array is referenced, the computer starts at the beginning of the string and scans through the delimiters until the requested element is found.
For example, suppose there were a dynamic array called INVOICE.ITEM, and attribute 17 of this array contains the following string:
W227]W338]T456]X889If you were to reference the third value from attribute 17 with either of the following statements:
PRINT EXTRACT(INVOICE.ITEM,17,3,0)or
PRINT INVOICE.ITEM<17,3>Here's how the process would work.
The computer starts from the beginning of the array and searches for attribute marks. Once it counts 17 attribute marks, it determines that the 17th attribute has been located, and then starts to search for value marks, until the second one is located. This might not seem like such a bad way of handling arrays, but there's a catch. Suppose the next line of code requested the fourth value from the same attribute. Rather than remembering where it was, the computer starts all the way back at the beginning of the item and again searches through all of the delimiters. On small items this doesn't have a significant impact on throughput, but when it comes to dealing with large items--such as those with several or more dozen attributes, many of which contain many values and subvalues--the throughput time is a big factor.
Dynamic arrays certainly have their place in PICK/BASIC programs. They are relatively easy to manipulate using the dynamic array reference symbols; they don't eat much (processing time) when dealing with small items; they don't require any previous declaration; and they don't take up much room.
Dimensioned arrays, by contrast, are a little less flexible, but the tradeoff is that they are generally much more efficient. As an aside here, many Pick technical types have strong opinions about this issue of dynamic versus dimensioned arrays, much as they do with regards to modulo and separation. Be advised that it may be less potentially dangerous to discuss religion or politics if you are looking for light conversation at a user group meeting.
Recall from Chapter 7 that an array is simply a data structure which contains data elements, each of which may be referenced by a numeric subscript. A dimensioned array simply means that rather than allowing an item with a variable number of array elements, as was the case with dynamic arrays, the program is told to preassign space for a fixed number of attributes before the array (item) is read with the MATREAD statement. This preassignment occurs through the DIM statement, which has the general form:
DIM array.variable(number.of.subscripts)For example:
DIM STAFF.ITEM(10)This statement tells PICK/BASIC to set aside ten storage locations for this array. When the array is read with a subsequent MATREAD statement, each attribute is loaded into its corresponding array location. This makes it much faster to find attributes, as their locations are calculated, rather than scanned for, each time an attribute is requested.
001 DIM STAFF.ITEM(10) 002 STAFF.ITEM(12) = DATE()Upon execution of line 2, the program immediately breaks into the debugger and displays a message that an attempt has been made to reference an invalid subscript location. This normally occurs when the subscript specification is made using a variable that accidentally contains the wrong value. Note that the "problem" of accidentally using the wrong subscript is just as big a problem with dynamic arrays. With dimensioned arrays, however, the system is able to tell us we screwed up--a problem which may go undetected with dynamic arrays.
The second problem with dimensioned arrays occurs when the array is under-dimensioned. Suppose, for example, that the program contains the statement:
DIM STAFF.ITEM(10)and later in the program the following statement is executed:
MATREAD STAFF.ITEM FROM STAFF.FILE, STAFF.ID ELSE ...If the item just read with the MATREAD statement contains more than ten attributes, you have a problem. Each attribute from one through nine loads into the corresponding array location. Attributes ten through the "end" of the item are stored in the "last" array location of the dimensioned array, with each attribute being delimited by an attribute mark (just like in a dynamic array). The scheme behind this logic is that the item will at least survive the MATWRITE statement without truncating all the "extra" array elements. The real problem occurs when you try to reference attribute ten.
I suggest that you "over-dimension" your dimensioned arrays by about five elements. This has the added benefit of providing growth space. This means that you won't have to change all of your programs that refer to this array when you add a new attribute to the file.
array.variable(amc.expression)The amc. expression is an expression which derives a number to be treated as an Attribute Mark Count (AMC).
For example, suppose there were a dimensioned array called STAFF.ITEM, and the following statement were issued:
PRINT STAFF.ITEMThe program would immediately crash and burn, leaving you the message
VARIABLE HAS BEEN DIMENSIONED AND USED WITHOUT SUBSCRIPTSIf, however, the following statement were issued:
PRINT STAFF.ITEM(1)The contents of the first array element would be printed. If it contains multiple values and/or subvalues, these too are printed, along with their corresponding delimiters, just as in dynamic arrays. That's the end of the similarities, however.
DIM TABLE(10,10)This tells PICK/BASIC to set up space for a table consisting of 10 rows and 10 columns. And remember:
The first dimension has nothing to do with attributes.
The second dimension has nothing to do with multivalues.
Consequently, I don't recommend MATREAD with two-dimensional arrays, unless you are prepared for the pain and agony of trying to make them work with the Pick record structure.
You may be wondering: "If dimensioned arrays have no syntactical provision for dealing with the three-dimensional record structure, then how are we going to reference multivalues and subvalues within the dimensioned arrays?" Good question. This has bothered the best philosophical minds since the beginning of time (about 1974). The answer is (hold your breath):
You combine both dynamic and dimensioned array reference symbols!
OK, you're confused. Remember the standard syntactical form of dynamic arrays?
array.variable<amc.expression>or
array.variable<amc.expression,vmc.expression>or
array.variable<amc.expression,vmc.expression,svmc.expression>Remember the standard syntactical form of dimensioned arrays?
array.variable(amc.expression)To combine dynamic array references with dimensioned array references, you first indicate the amc.expression, then follow it with the dynamic array symbols. For example:
PRINT STAFF.ITEM(1)<1,2>This tells PICK/BASIC to display the second value of the first attribute in the dimensioned array, STAFF.ITEM.
Now you may be wondering, "Why did we redundantly repeat the 1, which referred to the attribute number?" The answer is: Because we have to. Feel better?
We're told that we "have to" because of potential syntactical ambiguities. This is a fancy way of asking how the program would know the difference between what you just examined and this statement:
PRINT STAFF.ITEM(1)<2>The 1 obviously means attribute one. Yet the 2 could mean either attribute two or value two, hence the requirement to repeat the amc.expression.
The bottom line is that when you are referring to multivalues or subvalues of a single attribute within a dimensioned array, the first dynamic array subscript must be the number 1 (one).
The following examples are similar to the exercises that were covered earlier in the explanation of dynamic arrays. If the following statement were executed:
PRINT STAFF.ITEM(1)<1,2>The second value from the first attribute would be printed. And finally, if you were to issue the statement:
PRINT STAFF.ITEM(1)<1,2,3>The third subvalue from the second value of the first attribute would be displayed.
019 * DEFINE CONSTANTS 020 * 021 PROMPT "" 022 EQUATE TRUE TO 1 023 EQUATE FALSE TO 0 024 LAST.FIELD = 7Line 21 assigns a "null" as the prompt character, line 22 equates the value of 1 to the constant TRUE, and line 23 equates the value of 0 to the constant FALSE. Line 24 assigns the value of 7 to the constant LAST.FIELD, which is the number of fields in the data entry program, and is used later as the upper boundary of a FOR-NEXT statement.
The next step is to assign initial values to some critical variables that are used throughout the program:
026 * DEFINE VARIABLES 027 * 028 EXIT.FLAG = FALSE 029 ERROR.FLAG = FALSE 030 CURRENT.FIELD = 1Line 28 assigns the value FALSE, which was equated to 0 (zero), to the variable EXIT.FLAG. This variable is used as a flag to determine when to terminate the program. Line 29 assigns the value FALSE to the variable, ERROR.FLAG. This variable is used to indicate whether a problem occurred in the format of data entry. Finally, line 30 assigns the value 1 (one), to the variable CURRENT.FIELD. This variable keeps track of the current field (or attribute) number being processed during program execution.
032 * OPEN FILES 033 * 034 OPEN "STAFF" TO STAFF.FILE ELSE 035 PRINT "STAFF IS NOT A FILE NAME" · 036 INPUT ANYTHING 037 STOP 038 ENDIf the file is not found, the statements on lines 35 through 37 are executed, which advises the operator that the file was not found, awaits a response, and then stops the program. If the file is found, execution continues at line 39.
039 * 040 * DEFINE SCREEN.LABELS 041 * 042 SCREEN.LABELS(l) = "1 NAME" 043 SCREEN.lABELS(2) = "2 ADDRESS" 044 SCREEN.LABELS(3) = "3 CITY" 045 SCREEN.LABELS(4) = "4 STATE" 046 SCREEN.LABELS(5) = "5 ZIP" 047 SCREEN.LABELS(6) = "6 PHONE" 048 SCREEN.LABELS(7) = "7 BIRTHDAY"This first table being defined is called SCREEN.LABELS. These are the data labels that appear on the screen to let the operator know what is being requested. Rather than "hard coding" the data labels into a series of PRINT statements later in the program, they are gathered together in this one array. This technique tends to make program maintenance much easier. The tables could even be kept in a file to make the code more parameterized. Lines 42 through 48 assign the data labels to the appropriate locations in the SCREEN.LABELS array.
050 * DEFINE LABEL.COLUMN 051 * 052 LABEL .COLUMN (1) = 3 053 LABEL.COLUMN(2) = 3 054 LABEL.COLUMN(3) = 3 055 LABEL.COLUMN(4) = 3 056 LABEL.COLUMN(5) = 3 057 LABEL.COLUMN(6) = 3 058 LABEL.COLUMN(7) = 3Lines 62 through 68 assign the row positions to the corresponding positions in the array LABEL.ROW. This table is used later to determine the row coordinate at which to place the data labels on the screen:
060 * DEFINE LABEL.ROW 061 * 062 LABEL.ROW(l) = 4 063 LABEL.ROW(2) = 5 064 LABEL.ROW(3) = 6 065 LABEL.ROW(4) = 7 066 LABEL.ROW(5) = 8 067 LABEL.ROW(6) = 9 068 LABEL.ROW(7) = 10
070 * DEFINE DATA.COLUMN 071 * 072 DATA.COLUMN(1) = 20 073 DATA.COLUMN(2) = 20 074 DATA.COLUMN(3) = 20 075 DATA.COLUMN(4) = 20 076 DATA.COLUMN(5) = 20 077 DATA.COLUMN(6) = 20 078 DATA.COLUMN (7) = 20Lines 82 through 88 assign the row positions to the corresponding positions in the array DATA.ROW. This table is used later to determine the row coordinate at which to display (and enter) the actual data for each field on the screen:
080 * DEFINE DATA.ROW 081 * 082 DATA.ROW(l) = 4 083 DATA.ROW(2) = 5 084 DATA.ROW(3) = 6 085 DATA.ROW(4) = 7 086 DATA.ROW(5) = 8 087 DATA.ROW(6) = 9 088 DATA.ROW(7) = 10
090 * DEFINE INPUT.CONVERSIONS 091 * 092 INPUT.CONVERSIONS(l) = "" 093 INPUT.CONVERSIONS(2) = "" 094 INPUT.CONVERSIONS(3) = "" 095 INPUT.CONVERSIONS(4) = "P(2A)" 096 INPUT.CONVERSIONS(5) = "P(5N)" 097 INPUT.CONVERSIONS(6) = "" 098 INPUT.CONVERSIONS(7) = "D"The first three fields--NAME, ADDRESS, and CITY--require no special input conversions, so they are assigned a null. Field 4, which is the STATE field, is assigned the input conversion P(2A). This "pattern match" conversion allows only two alphabetic characters. Field 5, the ZIP field, is assigned the input conversion P(5N), which accepts only 5-digit numbers. Field 7, the BIRTHDAY, is assigned the D conversion, which does the external-to- internal date conversion discussed earlier.
All of these conversions are used later to ensure that the data received is in a valid format.
Lines 102 through 107 assign null output conversions to the corresponding positions in the ruble.
100 * DEFINE OUTPUT.CONVERSIONS 101 * 102 OUTPUT.CONVERSIONS(l) = "" 103 OUTPUT.CONVERSIONS(2) = "" 104 OUTPUT.CONVERSIONS(3) = "" 105 OUTPUT.CONVERSIONS(4) = "" 106 OUTPUT.CONVERSIONS(5) = "" 107 OUTPUT.CONVERSIONS(6) = "" 108 OUTPUT.CONVERSIONS(7) = "D2/"Field 7, the BIRTHDAY, is the only field which actually requires an output conversion. It is assigned the ACCESS conversion D2/, which outputs the birthday in the form MM/DD/YY--except in Europe, where it is DD/MM/YY.
110 * DEFINE LENGTH 111 * 112 LENGTH(1) = 30 113 LENGTH(2) = 30 114 LENGTH(3) = 30 115 LENGTH(4) = 30 116 LENGTH(5) = 30 117 LENGTH(6) = 30 118 LENGTH(7) = 30
120 * MAIN POINT OF PROGRAM 121 * 122 LOOP 123 GOSUB 1000 ; * ENTER ID AND READ ITeM 124 UNTIL EXIT.FLAG DO 125 GOSUB 2000 ; * EDIT ITEM 126 REPEAT 127 STOP ; * END OF PROGRAMLine 122 establishes the top of the loop. Line 123 executes local subroutine 1000, which is used to request the item-id or the word QUIT. Line 124 tests the condition of EXIT. FLAG to determine if it is 0 (zero) or 1 (one). If EXIT.FLAG evaluates to 1 ("true"), then execution falls out of the loop and executes the STOP statement on line 127. If EXIT.FLAG evaluates to 0 ("false"), then line 125 executes local subroutine 2000, which allows the item to be constructed or modified.
Pretty simple, isn't it? The good news is that this program is generalized and may easily be modified to fit your files. All you need to do is modify this program by filling in the tables at the top of the program.
Line 131 clears the screen with the @( -1) function. Line 132 defines the top of the loop. The loop is used to request either an item-id or the word QUIT. The data is then stored in the variable, STAFF.ID.
Line 135 defines the conditional logic, which repeats the loop until the response received is greater than "null." Line 136 tests the response to determine if the operator entered the word QUIT. If QUIT was entered, then EXIT.FLAG is assigned the value TRUE (set to 1). If QUIT was not entered, then EXIT. FLAG is assigned the value FALSE (set to zero).
129 1000 * ENTER ID AND READ ITEM 130 * 131 PRINT @(-1) : ; * CLEAR SCREEN 132 LOOP 133 PRINT @(3,2) : "ENTER ITEM-ID OR 'QUIT' TO STOP" : 134 INPUT STAFF.ID 135 UNTIL STAFF.ID > " DO REPEAT 136 IF STAFF.ID = "QUIT" THEN EXIT.FLAG=TRUE ELSE EXIT.FLAG=FALSE 137 * 138 * READ ITEM 139 * 140 NEW. ITEM.FLAG = FALSE 141 MATREAD STAFF.ITEM FROM STAFF.FILE,STAFF.ID ELSE 142 MAT STAFF.ITEM = " 143 NEW.ITEM.FLAG = TRUE 144 END 145 RETURN ; * DONE WITH ENTER ID AND READ ITEMFig. 14-2. Subroutine to obtain a value for STAFF.ID and retrieve the item from a file.
Line 140 sets the value of the variable NEW.ITEM.FLAG to false (zero). This happens before the item is read, for two reasons: to ensure that the variable has been assigned a value before it is referred to later, and to reset it after it has been set to TRUE.
Line 141 reads in the item with the MATREAD statement, which has the following general form:
MATREAD array.variable FROM file.variable,id.expression...
...{THEN statement(s)} ELSE statement(s)
The MATREAD statement is used to retrieve an item into a dimensioned array.
The THEN clause is optional, and when it is used, any statements following
it are executed when the item being read is found. The ELSE clause is required;
any statements following the ELSE clause are executed when the requested
item-id is not found in the file. (If you had entered the item-id 1234567,
which is not currently in the file, the statements on lines 142 and 143
would be executed.)
MAT array.variable = valueFor example:
142 MAT STAFF.ITEM = ""This statement assigns a null to each element of the dimensioned array, clearing each element of any former contents.
Incidentally, one array may be assigned to another, provided they are the same size. This operation has the general form:
MAT array.variable = MAT array.variableIf the two arrays are not the same size, however, one of two possible events is likely to happen. If the destination array (the array on the left side of the assignment operator) is larger than the source array, then the assignment is successful; if the destination array is smaller than the source array, then the program crashes and burns.
In the program example, if the item isn't found, the STAFF.ITEM array is initialized on line 142. Then line 143 assigns the value TRUE (1), to the variable NEW.ITEM.FLAG, since the item was not found.
Whether the item was found or not, line 145 executes a RETURN statement, sending execution back to line 124, which checks the status of the EXIT.FLAG variable. If EXIT.FLAG is not TRUE, then line 125 is executed, which transfers execution to local subroutine 2000:
124 UNTIL EXIT.FLAG DO 125 GOSUB 2000 ; * EDIT ITEM
147 2000 * EDIT ITEM 148 * 149 GOSUB 10000 ; * PRINT LABELS 150 GOSUB 20000 ; * PRINT DATA 151 IF NEW. ITEM.FLAG THEN 152 GOSUB 30000 ; * ENTER NEW ITEM 153 END 154 GOSUB 40000 ; * UPDATE OLD ITEM 155 RETURN 157 10000 * PRINT LABELS 158 * 159 FOR I = 1 TO LAST.FIELD 160 PRINT @(LABEL.COLUMN(I),LABEL.ROW(I)) :SCREEN.LABELS(I): 161 NEXT I 162 RETURNFig. 14-3. Subroutines to edit the item and print data labels.
This routine is used to print the data labels at the predefined cursor coordinates on the screen. Line 159 establishes the loop boundaries by setting the initial value of I to 1 (one) and the upper boundary to LAST.FIELD (which is currently 7).
Then line 160 positions the cursor to the coordinates derived from the arrays LABEL.COLUMN and LABEL.ROW. Since the current value of I is 1 (one), when this statement is executed the value of LABEL.COLUMN(l) is retrieved. This value is used as the column coordinate, or the number of character positions from the left-hand side of the screen. The value of LABEL.ROW(l) is used to determine the fowl or number of lines from the top of the screen. LABEL.COLUMN(l) was assigned the value 3, and LABEL.ROW(l) was assigned the value 4. Consequently, the cursor is placed at position 3 on line 4 of the screen.
Finally, the current contents of SCREEN.LABELS(I), which was assigned the value "1 NAME," is displayed at the current cursor position.
Each time through the FOR-NEXT loop, I is incremented by 1 (one), until all seven of the data labels have been displayed at their appropriate screen positions. Upon completing the display of the data labels, the RETURN statement on line 162 is executed, transferring execution to line 150, where another GOSUB statement is executed. This time, local subroutine 20000 is executed, which is the routine to print the data elements.
164 20000 * PRINT DATA
165 *
166 FOR I = 1 TO LAST.FIELD
167 GOSUB 25000; * PRINT ONE DATUM
168 NEXT I
169 RETURN
170 *
171 25000 * PRINT ONE DATUM
172 *
173 IF OUTPUT.CONVERSIONS(I) # "" THEN
174 PRINT.VALUE = OCONV(STAFF.ITEM(I) ,OUTPUT.CONVERSIONS(I) )
175 END ELSE
176 PRINT.VALUE = STAFF.ITEM(I)
177 END
178 PRINT @(DATA.COLUMN(I) ,DATA.ROW(I)): (PRINT.VALUE) ('L#' LENGTH(I)):
179 RETURN
Fig. 14-4. Subroutines to select and print data items.
The first part of line 178 positions the cursor to the data location using the tables DATA.COLUMN and DATA.ROW. This is done exactly as it was done before for the placement of the data labels. The second part of line 178, which reads:
...: (PRINT.VALUE) ('L#':LENGTH(I)):
outputs the current value of PRINT.VALUE, using the mask expression derived
from the LENGTH table for the current field.
In this example, all of the values of the array LENGTH were set to 30. Thus, this statement is the same as issuing the statement:
...: (PRINT.VALUE) ("L#30"):
which outputs the current value of PRINT.VALUE, left-justified in a field
of 30 blanks.
151 IF NEW.ITEM.FLAG THEN 152 GOSUB 30000 ; * ENTER NEW ITEM 153 END
At line 184, a loop is started. Line 185, which reads:
185 PRINT @(DATA.COLUMN](CURRENT.FIELD),DATA.ROW(CURRENT.FIELD)):
181 30000 * ENTER NEW ITEM 182 * 183 CURRENT.FIELD = 1 184 LOOP 185 PRINT @(DATA.COLUMN(CURRENT.FIELD),DATA.ROW(CURRENT.FIELD) ): 186 INPUT ANS,LENGTH(CURRENT.FIELD) 187 BEGIN CASE 188 CASE ANS = "QUIT" 189 EXIT.FLAG = TRUE 190 CASE ANS = "" 191 CURRENT.FIELD = CURRENT.FIELD + 1 192 CASE ANS = "^" 193 I = CURRENT.FIELD; GOSUB 25000; * PRINT ONE DATUM 194 IF CURRENT.FIELD >=2 THEN CURRENT.FIELD = CURRENT.FIELD-1 195 CASE 1 196 GOSUB 35000; * GET VALIDATED DATUM,STORE IN STAFF.ITEM 197 IF NOT(ERROR.FLAG) THEN CURRENT.FIELD = CURRENT.FIELD + 1 198 END CASE 199 UNTIL CURRENT.FIELD > LAST.FIELD OR EXIT.FLAG = TRUE DO REPEAT 200 RETURNFig. 14-5. New-item entry subroutine.
positions the cursor to the appropriate input field location, based upon the value of CURRENT.FIELD. Then line 186 executes the INPUT statement to request the value for the array location indicated by CURRENT. FIELD. The length of the input is restricted to the corresponding value of the LENGTH array for the current field.
After receiving the input from the operator, line 187 starts a CASE construct with a BEGIN CASE statement to determine how to handle the operator's response. The CASE statement on line 188 checks for the presence of the response, QUIT. If this response is received, the EXIT.FLAG variable is assigned the value TRUE, and execution leaves the CASE construct, unconditionally executing the statement at line 199.
Line 199 defines the "until" portion of the loop. It appears as:
199 UNTIL CURRENT.FIELD > LAST.FIELD OR EXIT.FLAG = TRUE DO REPEATThis specifies that either of two conditions which will terminate the loop may occur. The first condition is if the current value of CURRENT. FIELD is greater than LAST. FIELD. If this is true, then it means that all of the fields have been entered. The second condition is based upon the value of EXIT.FLAG. If EXIT.FLAG is 1 (true), then it means that the operator typed "QUIT." If either condition is true, the loop terminates.
The next CASE statement, at line 190, checks the response to determine if no response was provided (the operator entered a Return < cr >. If this is the case, then the value of CURRENT. FIELD is incremented by 1 (one), and execution falls out of the CASE construct. None of the fields in this program are required to have input, other than the item-id.
Line 192 executes a CASE statement to determine if the response is an up-arrow or caret ("^' '). This is provided as a data entry convention to allow the operator to "back up" one field. Suppose, for example, that the NAME entry had been misspelled and that the program is now requesting the ADDRESS field. By entering a caret, the program repositions the cursor back to the (previous) field--in this case, the "NAME" field--and allows the operator to reenter the name.
If a caret is entered, the statement at line 193 is executed. This assigns the value of the current field to the variable 1 and then immediately executes subroutine 25000, which reprints the value of the current field. Upon returning from subroutine 25000, a test is performed to determine if the current value of CURRENT. FIELD is greater than or equal to 2. If it is, then the value of CURRENT.FIELD is decremented by 1. This means that the "^" character backs up a field at any field other than the first field.
Line 195 performs the "otherwise" case. This is executed upon receiving anything that was not already detected in any of the previous CASE statements, meaning, that it is not QUIT, null or "^". In other words, data was entered.
When line 196 is executed, subroutine 35000 is called, which validates the response. Upon returning from subroutine 35000, the value of ERROR. FLAG is checked. Line 197 appears as:
197 IF NOT(ERROR.FLAG) THEN CURRENT.FIELD = CURRENT.FIELD + 1
For example, consider the following source line:
IF NUM(RESPONSE) THEN PRINT "NUMERIC" ELSE PRINT "NON-NUMERIC"This means that if the value of RESPONSE is numeric, then the program executes the THEN clause; otherwise, if RESPONSE is not numeric, the statement after the ELSE initiator is executed.
Now examine the exact same statement using the NOT function:
IF NOT(NUM(RESPONSE)) THEN PRINT "NOT-NUMERIC" ELSE PRINT "NUMERIC"This line means that if the value of RESPONSE is not numeric, then the program executes the instruction after the THEN initiator; otherwise, if RESPONSE is numeric, the statement after the ELSE initiator is executed.
Consequently, line 197 of this program reads, "If ERROR.FLAG is not true (meaning that it must be 0), then increment the value of CURRENT.FIELD by 1 (one)." Whether ERROR.FLAG is true or not, the CASE construct is terminated at line 198, and the program unconditionally executes line 199. Again, this is the point at which the current value of CURRENT.FIELD is checked to determine if it is greater than LAST.FIELD, or to determine if EXIT. FLAG is true (1)--either of which means that it is time to leave the loop.
205 IF ERROR.FLAG THEN PRINT @(3,21): @(-4):This line checks the status of ERROR.FLAG to determine if it is true (1). lf ERROR. FLAG is true, then the cursor is positioned to position 3 on line 21 and the @(-4) function is issued, which clears the display from the current cursor position to the end of the current line. Then line 206 "resets" the current value of ERROR.FLAG to false (0).
Line 207 tests for the presence of an input conversion for the current field. If there is an input conversion to be applied against the input, the statement on line 208 is executed; otherwise, execution falls through to line 216, which will be discussed shortly.
Assuming that there is an input conversion, line 208 is executed. This is:
208 TEMP = ICONV(ANS,INPUT.CONVERSIONS(CURRENT.FIELD))The input conversion for the current field is applied to the value of ANS. The result of the conversion is then assigned to the temporary variable TEMP. The easiest way to determine if the input conversion worked properly is to check the value of TEMP after the conversion. Input conversions that validate data produce a null if they fail. For instance, if the attempted conversion was D (for "Date' ') and the response entered was "NEW YORK CITY," then the date conversion fails, storing a null in the TEMP variable.
Line 209 is where the test on TEMP takes place. It means: If TEMP is null, then the operator blew it, in which case the statements on lines 210 and 211 are executed. The statement on line 210 displays the message "UNEXPECTED FORMAT. PLEASE TRY AGAIN".
202 35000 * GET VALIDATED) DATUM, STORE IN STAFF.ITEM, REPRINT 203 * INPUT = ANS > "" OUTPUT = ANS, ERROR.FLAG 204 * 205 IF ERROR.FLAG THEN PRINT @(3,21): @(-4): 206 ERROR.FLAG = FALSE 207 IF INPUT.CONVERSIONS(CURRENT.FIELD) > "" THEN 208 TEMP = ICONV(ANS,INPUT.CONVERSIONS(CURRENT.FIELD)) 209 IF TEMP = "" THEN ; * NOT GOOD 210 PRINT @(3,21) :"UNEXPECTED FORMAT. PLEASE TRY AGAIN" 211 ERROR.FLAG = TRUE 212 END ELSE 213 ANS = TEMP 214 END 215 END 216 IF NOT(ERROR.FLAG) THEN STAFF.ITEM(CURRENT.FIELD) = ANS 217 I = CURRENT.FIELD; GOSUB 25000; * PRINT ONE DATUM 218 RETURNFig. 14-6. Input validation subroutine.
AGAIN" at position 3 on line 21. Line 211 sets the value of ERROR.FLAG to true (1), and then falls out of the IF statement to execute line 216.
The second possibility after testing TEMP is that it is not null, meaning that the input conversion "worked." If this is the case, then the statement on line 213 is executed. Line 213 assigns the value of the variable TEMP to the variable ANS and then falls out of the IF statement.
Line 216 checks the status of ERROR. FLAG. If ERROR. FLAG i s not true (meaning that it is 0), the received input is valid and the current value of ANS is assigned to the appropriate location within the array variable STAFF.ARRAY. If ERROR.FLAG is true (1), no assignment takes place. (After all, you don't want to stuff garbage into the array.)
Line 217 assigns the value of CURRENT. FIELD to the variable I and then executes subroutine 25000, which displays the data for field "I."
This concludes subroutine 30000, which returns execution to line 154. (Don't panic; we're almost done.) Line 154 executes subroutine 40000, which allows any field in the item to be updated.
220 40000 * UPDATE OLD ITEM
221 *
222 LOOP
223 PRINT @(3,20) :
224 PRINT "ENTER FIELD # TO CHANGE, E(X) IT, (D) ELETE, (F) ILE":
225 INPUT OPTION
226 BEGIN CASE
227 CASE NUM(OPTION)
228 IF OPTION >= 1 AND OPTION <= LAST.FIELD THEN
229 CURRENT.FIELD = OPTION
230 PRINT @ (DATA.COLUMN(CURRENT.FIELD) ,DATA.ROW(CURRENT.FIELD) ):
231 INPUT ANS, LENGTH (CURRENT.FIELD)
232 IF ANS > "" THEN GOSUB 35000; * VALIDATE, STORE
233 END
234 CASE OPTION = "X" OR OPTION = "QUIT"
235 EXIT.FLAG = TRUE
236 CASE OPTION = "D"
237 DELETE STAFF.FILE,STAFF.ID
238 PRINT "ITEM DELETED"
239 CASE OPTION = "F"
240 MATWRITE STAFF.ITEM ON STAFF.FILE,STAFF.ID
241 END CASE
242 UNTIL INDEX("XDF",OPTION,1) AND OPTION > "" DO REPEAT
243 RETURN
Fig. 14-7. Update subroutine.
well as handling the logic for determining what to do with the item before returning to the top of the program to retrieve the next item.
Line 222 starts the loop, line 223 positions the cursor to position 3 on line 20, and line 224 displays the message;
ENTER FIELD # TO CHANGE, E(X)IT, (D)ELETE, (F)ILELine 225 executes the INPUT statement to request the variable OPTION.
Once the response has been provided to OPTION, a CASE construct is started on line 226. The first CASE statement checks the response to determine if it was a number. This indicates that the operator has chosen to change one of the fields. Line 228 checks the number to ensure that it is a valid field number, which means that it is greater than or equal to 1 (one) and less than the value of LAST.FIELD. If both of these conditions evaluate to true, then lines 229 through 232 are executed.
Line 229 assigns the (numeric) value of OPTION to the variable CURRENT. FIELD, line 230 positions the cursor at the appropriate position for the field being changed, and line 231 awaits the input, again restricting its length to the restriction specified for this field by the current value of the corresponding subscript in the LENGTH array.
After receiving the input, line 232 checks whether the response entered was null. If the response is not null (something was entered), then subroutine 35000 is executed, which validates and stores one datum. Next, execution falls out of the CASE construct and executes the "until" portion of the loop.
Line 234 executes the second CASE statement. This checks the response to determine if the operator entered "X" or "QUIT," meaning that the operator wanted to exit without updating the file. If this is the case, then line 235 assigns the value of true to the variable EXIT.FLAG.
Line 236 executes the next CASE statement, which checks the response to determine if it is the letter "D," meaning that the item is to be deleted.
DELETE array.variable,item.idIf the operator did enter the letter "D, " then the DELETE statement on line 237 is executed. This deletes the current item from the file and then prints the message (on line 238) that the item has been deleted. After completing this example, as an exercise you may want to add the logic to ask the operator if he or she is "sure" that they want to do this.
Note that with any of the file-access statements, the "default" file.variable option is always available, which means that the DELETE statement possibly could take the form:
DELETE item.id
The MATREAD statement was discussed earlier in this program, noting that the statement is always used with dimensioned arrays. Its counterpart for writing an item to a file is called MATWRITE, which has the general format:
MATWRITE array.variable ON file.variable,id.expressionNotice that no THEN or ELSE clauses are required. This is because "writes" in the Pick System are unconditional. As a note for those of you who came from a COBOL environment, there is no REWRITE statement in Pick. When Pick is instructed to "write" an array, it does. Pick doesn't particularly care whether or not the item is, or was, already in the file. It adds the item if it is new, or writes over the "old" item if it was already there. Finally, the "until" portion of the loop occurs on line 242, which is:
242 UNTIL INDEX("XDF",OPTION,1) AND OPTION > " DO REPEAT
This means to repeat the loop until the response received from the operator
is either the letter "X," "D," or "F," and the response is not null. The
only way out of the loop is one of the three letters just mentioned, or
the word "QUIT."
There now, that wasn't too bad, was it? Since this is a generalized data entry program, customizing it for your own particular needs is simple. You copy the item and then change the "tables" at the beginning of the program. The main logic is generalized, and thus does not have to be changed.
One more note: Play with this program! Test all of its features. Don't forget to test things like the "back up one field" feature, by entering the "^" at any field. Also try to put invalid data in the fields that have input conversions. Have fun.
