1|*
2|**************************************************************************
3|* Copyright (c) 2004 Schellenbach & Associates, Inc. dba AccuSoft *
4|* Enterprises as an unpublished work. Permission is hereby granted, free *
5|* of charge, to any person obtaining a copy of this software, to use the *
6|* software without restriction, including without limitation the rights *
7|* to use, copy, modify, merge, publish or distribute the software, and *
8|* to permit persons to whom the software is furnished to do so, subject *
9|* to the following conditions: This copyright notice and permission *
10|* notice shall be included in all copies or substantial portions of the *
11|* software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY *
12|* KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
13|* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
14|* NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR *
15|* ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF *
16|* CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION *
17|* WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *
18|**************************************************************************
19|**************************************************************************
20|*
21|* MOUSE DEMO PROGRAM 3
22|*
23|**************************************************************************
24|**************************************************************************
25|*
26|* The CUST.REC INCLUDE item declares the CUST.REC array, which is used to
27|* store a working copy of the current data record. It also defines the
28|* record layout by equating field names to array positions in the CUST.REC
29|* array.
30|*
31|$INCLUDE UIEX UIEX.CUST.REC
32|*
33|**************************************************************************
34|*
35|* EQUates for control characters and delimiters and other constants
36|*
37|EQU VM TO CHAR(253)
38|EQU BEL TO CHAR(7)
39|EQU ESC TO CHAR(27)
40|EQU STX TO CHAR(2)
41|EQU CR TO CHAR(13)
42|EQU BACKSPACE TO CHAR(8)
43|EQU FALSE TO 0
44|EQU TRUE TO 1
45|*
46|**************************************************************************
47|*
48|* Open our files...
49|*
50|OPEN 'CUST.SAMPLE' TO FN.CUST ELSE PRINT 'NO CUST.SAMPLE FILE';STOP
51|OPEN 'CUST.SAMPLE.CTRL' TO FN.CUST.CTRL ELSE PRINT 'NO CUST.SAMPLE.CTRL FILE';STOP
52|OPEN 'CUST.SAMPLE.XREF' TO FN.CUST.XREF ELSE PRINT 'NO CUST.SAMPLE.XREF';STOP
53|*
54|**************************************************************************
55|*
56|* Define the data field control structures. NUMFLDS is the number of
57|* fields. The CONTROL array defines the field control elements such as
58|* field label, label position, field position and size, and field prompt.
59|* The IDATA array stores the current field values, and is initialized from
60|* the CUST.REC array when a data record is read from the file. When the
61|* record is updated, values are copied from the IDATA array to the
62|* CUST.REC array and the CUST.REC array is passed to the CUST.UPDATE
63|* subroutine to update the data and index files (a separate subroutine is
64|* used to update the file since the update process may handle other
65|* functions like updating indexes).
66|*
67|NUMFLDS = 12
68|DIM CONTROL(12)
69|DIM IDATA(12)
70|*
71|* Define field control elements
72|* value 1: field label text
73|* value 2: field label column
74|* value 3: field label row
75|* value 4: field label width (0 for actual width, no padding)
76|* value 5: field data column
77|* value 6: field data row
78|* value 7: field data width
79|* value 8: field data height
80|* value 9: field prompt message
81|CONTROL(1) = 'Customer IDý7ý2ý20ý28ý2ý30ý1ýEnter the ID, or name to search for, or N for next number'
82|CONTROL(2) = 'Contactý7ý4ý20ý28ý4ý30ý1ýEnter the contact name'
83|CONTROL(3) = 'Company nameý7ý5ý20ý28ý5ý30ý1ýEnter the company name'
84|CONTROL(4) = 'Address line 1ý7ý6ý20ý28ý6ý30ý1ýEnter address line 1'
85|CONTROL(5) = 'Address line 2ý7ý7ý20ý28ý7ý30ý1ýEnter address line 2'
86|CONTROL(6) = 'Cityý7ý8ý20ý28ý8ý25ý1ýEnter the city'
87|CONTROL(7) = 'State or provinceý7ý9ý20ý28ý9ý15ý1ýEnter the state or province abbreviation'
88|CONTROL(8) = 'Zip/postal codeý7ý10ý20ý28ý10ý10ý1ýEnter the zip or postal code'
89|CONTROL(9) = 'Countryý7ý11ý20ý28ý11ý18ý1ýEnter the country'
90|CONTROL(10) = 'Phoneý7ý12ý20ý28ý12ý15ý1ýEnter the phone number'
91|CONTROL(11) = 'Faxý7ý13ý20ý28ý13ý15ý1ýEnter the fax number'
92|CONTROL(12) = 'Notesý7ý14ý20ý28ý14ý30ý1ýEnter any notes about this customer'
93|*
94|**************************************************************************
95|*
96|* Define some screen control strings for prompts & errors
97|*
98|PROMPT ''
99|CLR = @(-1) ;* Clear entire screen
100|CEOL = @(-4) ;* Clear to end of line
101|PL = @(5,22):CEOL ;* Prompt line
102|EL = @(5,23):CEOL ;* Error line
103|*
104|* Wyse 60 attributes for NORMAL, REVERSE, DIM REVERSE and UNDERLINE
105|* REVERSE (we like Wyse 60 because the attributes dont take any space on
106|* the screen, and more than one attribute can be displayed at one time).
107|* If running AccuTerm in Viewpoint A2 Enhanced emulation, you can use the
108|* ADDS 4000 attributes instead. Just change the upper-case "G" below to
109|* lower-case "g".
110|*
111|NORMAL = ESC:'G0' ;* Normal - display headings & field labels
112|REVERSE = ESC:'G4' ;* Reverse - display active field data
113|DIMREV = ESC:'Gt' ;* Dim Reverse - display inactive field data
114|UNDREV = ESC:'G<' ;* Underline Reverse - display warnings
115|*
116|*
117|MOUSE.ON = ESC:STX:'1'
118|MOUSE.OFF = ESC:STX:'0'
119|*
120|**************************************************************************
121|*
122|* This program processes one customer record at a time, and is organized
123|* using three nested loops. The outermost loop (the RECORD loop) is
124|* executed once for each record accessed. The loop repeats until the XIT
125|* control variable is set to TRUE.
126|*
127|XIT = FALSE
128|LOOP UNTIL XIT DO
129| *
130| *************************************************************************
131| *
132| * Before prompting for the customer ID, reset the internal data array
133| * (IDATA) and CUST.ID variables, then clear the screen and display the
134| * heading and field labels.
135| *
136| GOSUB RESTART
137| GOSUB DSPSCRN
138| *
139| *************************************************************************
140| *
141| * The middle loop is the ACTION loop. It is executed for the current
142| * record until the user performs an action that terminates processing of
143| * that record, such as exiting, cancelling, saving or deleting the
144| * record. The field number to begin prompting (NXTFLD) is initialized to
145| * 1, causing the ID field to be prompted first. The loop immediately
146| * enters the PROMPT loop, followed by the field modification prompt. The
147| * loop repeats until the DONE control variable is set to TRUE.
148| *
149| NXTFLD = 1
150| DONE = FALSE
151| LOOP
152| *
153| ************************************************************************
154| *
155| * The inner loop is the PROMPT loop. It is executed for each prompt
156| * field as specified by the NXTFLD variable. The prompt loop simply
157| * calls the local INPUT.FIELD subroutine which performs field input,
158| * data validation and keyboard command decoding. The FIELD loop repeats
159| * until the field number is greater than the number of fields, or until
160| * the DONE control variable is set to TRUE. The DONE control variable
161| * may be set to TRUE in the INPUT.FIELD subroutine, if the user enters a
162| * NULL to for the item-ID.
163| *
164| LOOP
165| CURFLD = NXTFLD
166| UNTIL DONE OR CURFLD > NUMFLDS DO
167| *
168| ***********************************************************************
169| *
170| * Prompt for the next field. Update the NXTFLD variable with the field
171| * number to prompt next.
172| *
173| GOSUB INPUT.FIELD
174| REPEAT ;* end of PROMPT loop
175| *
176| ************************************************************************
177| *
178| * If the FIELD loop exited with the DONE control variable set to TRUE,
179| * bypass the modification prompt because no action is required.
180| * Otherwise, prompt for which field to modify, or other actions such as
181| * save or delete.
182| *
183| IF NOT(DONE) THEN
184| *
185| NXTFLD = NUMFLDS + 1 ;* assume we need to reprompt for action
186| *
187| PRINT PL:'Enter field number to modify or FI to save, DE to delete, EX to exit: ':
188| GOSUB INPCMD
189| PRINT EL:
190| *
191| ***********************************************************************
192| *
193| * Decode the response
194| *
195| IF CMD = 'CLK' THEN
196| * decode mouse click
197| IF MOUSEROW = 20 THEN
198| * clicked in function label row
199| BEGIN CASE
200| CASE MOUSECOL >= 5 AND MOUSECOL < 20; CMD = 'FI'
201| CASE MOUSECOL >= 20 AND MOUSECOL < 35; CMD = 'DE'
202| CASE MOUSECOL >= 35 AND MOUSECOL < 50; CMD = 'EX'
203| CASE 1; CMD = ''
204| END CASE
205| END ELSE
206| FOR I = 1 TO NUMFLDS
207| IF MOUSEROW = CONTROL(I)<1,3> AND MOUSECOL >= CONTROL(I)<1,2> AND MOUSECOL < (CONTROL(I)<1,5> + CONTROL(I)<1,7>) THEN
208| DIO = I
209| I = NUMFLDS
210| END
211| NEXT I
212| CMD = ''
213| END
214| END
215| IF CMD NE '' THEN ANS = CMD ELSE ANS = OCONV(DIO, 'MCU')
216| BEGIN CASE
217| CASE NUM(ANS) AND ANS >= 1 AND ANS <= NUMFLDS; NXTFLD = ANS
218| CASE ANS EQ 'FI'; GOSUB SAVE.RECORD
219| CASE ANS EQ 'DE'; GOSUB DELETE.RECORD
220| CASE ANS EQ 'EX' OR ANS EQ ''; GOSUB CHECK.EXIT
221| END CASE
222| *
223| END
224| *
225| UNTIL DONE DO REPEAT ;* end of ACTION loop
226| *
227|REPEAT ;* end of RECORD loop
228|*
229|**************************************************************************
230|*
231|* All done - clear the screen and exit!
232|PRINT CLR:
233|STOP
234|*
235|*
236|**************************************************************************
237|**************************************************************************
238|* LOCAL SUBROUTINES
239|**************************************************************************
240|**************************************************************************
241|*
242|*
243|**************************************************************************
244|*
245|* The INPUT.FIELD subroutine is the main prompting routine. This routine
246|* displays the prompt string (from the CONTROL array), and enters a loop,
247|* prompting for a specified field (CURFLD) and setting the next field
248|* variable (NXTFLD) appropriately. The loop repeats until the NXTFLD
249|* (initially set to CURFLD) changes. This causes the field prompt to be
250|* repeated in case invalid data is entered (illegal customer ID, etc.) If
251|* a NULL is entered for the ID field, and there is no current record, the
252|* ACTION loop control variable, DONE, and the RECORD loop control
253|* variable, XIT, are set to TRUE, and this routine exits.
254|*
255|INPUT.FIELD:
256|*
257|**************************************************************************
258|*
259|* Display the prompt message
260|*
261|PRINT PL:CONTROL(CURFLD)<1,9>:
262|*
263|**************************************************************************
264|*
265|* Initialize current value, next field
266|*
267|PREVAL = IDATA(CURFLD) ;* Save previous field value to detect change in value
268|*
269|**************************************************************************
270|*
271|* Prompt for this field until NXTFLD variable is updated
272|*
273|LOOP
274| *
275| *************************************************************************
276| *
277| * Assume next field number is next sequential field
278| *
279| NXTFLD = CURFLD + 1
280| *
281| * Highlight current field data
282| *
283| XLINE = CURFLD ;* Set the field number to display
284| ACTIVE = CURFLD ;* Set the active field number to highlight field
285| GOSUB DSPLINE
286| *
287| * Prompt for input
288| *
289| PRINT @(CONTROL(CURFLD)<1,5>,CONTROL(CURFLD)<1,6>):REVERSE:
290| GOSUB INPCMD
291| IDATA(CURFLD) = DIO
292| *
293| * Check for NULL
294| *
295| K = LEN(IDATA(CURFLD))
296| IF K = 0 THEN
297| *
298| * No change if NULL entered
299| *
300| IDATA(CURFLD) = PREVAL
301| END ELSE
302| *
303| * Erase old data
304| *
305| IF K < CONTROL(CURFLD)<1,7> THEN
306| PRINT @(K+CONTROL(CURFLD)<1,5>,CONTROL(CURFLD)<1,6>):SPACE(CONTROL(CURFLD)<1,7> - K):
307| END
308| END
309| *
310| * Reset display attribute
311| *
312| PRINT NORMAL:
313| *
314| * Clear the error line
315| *
316| PRINT EL:
317| *
318| *************************************************************************
319| *
320| * Check for any special values (like 'END' or 'EXIT')
321| *
322| IF OCONV(DIO,'MCU') = 'END' THEN CMD = 'EX'
323| IF CMD NE '' THEN
324| IF CMD = 'CLK' THEN
325| * decode mouse click
326| IF MOUSEROW = 20 THEN
327| * clicked in function label row
328| BEGIN CASE
329| CASE MOUSECOL >= 5 AND MOUSECOL < 20; CMD = 'FI'
330| CASE MOUSECOL >= 20 AND MOUSECOL < 35; CMD = 'DE'
331| CASE MOUSECOL >= 35 AND MOUSECOL < 50; CMD = 'EX'
332| CASE 1; CMD = ''
333| END CASE
334| END ELSE
335| CMD = '' ;* ignore field number while prompting
336| END
337| END
338| BEGIN CASE
339| CASE CMD = 'EX'
340| IDATA(CURFLD) = PREVAL ;* Restore previous value
341| GOSUB CHECK.ABANDON ;* Ensure OK to loose changes
342| IF OK THEN
343| *
344| ***********************************************************************
345| *
346| * No changes, or user OKs abandoning them, so we are outa here!
347| *
348| DONE = TRUE
349| XIT = TRUE
350| RETURN
351| *
352| END ELSE
353| *
354| ***********************************************************************
355| *
356| * User does not want to abandon changes, so reprompt
357| *
358| NXTFLD = CURFLD ;* Reprompt
359| *
360| END
361| CASE CMD = 'FI'
362| GOSUB SAVE.RECORD
363| CASE CMD = 'DE'
364| GOSUB DELETE.RECORD
365| END CASE
366| END
367| IF IDATA(CURFLD) EQ SPACE(LEN(IDATA(CURFLD))) THEN IDATA(CURFLD) = ''
368| *
369| *************************************************************************
370| *
371| * Peform field data validation if next field number changed
372| *
373| IF NXTFLD NE CURFLD THEN
374| BEGIN CASE
375| *
376| CASE CURFLD EQ 1
377| *
378| **********************************************************************
379| *
380| * Validate the ID field. If NULL, quit. If changed, read new record.
381| *
382| IF CUST.ID EQ '' AND IDATA(CURFLD) EQ '' THEN
383| DONE = TRUE
384| XIT = TRUE
385| RETURN
386| END
387| *
388| IF IDATA(CURFLD) NE PREVAL THEN
389| ID = IDATA(CURFLD)
390| GOSUB CHECK.ID ;* Check the newly entered ID handling index lookups
391| IF OK THEN
392| *
393| ********************************************************************
394| *
395| * New ID (or result of index lookup) is good!
396| *
397| IDATA(CURFLD) = ID ;* Update the current field value in case of index lookup
398| *
399| END ELSE
400| *
401| ********************************************************************
402| *
403| * New ID is invalid
404| *
405| IDATA(CURFLD) = PREVAL ;* Restore previous value
406| NXTFLD = CURFLD ;* Reprompt
407| *
408| END
409| END
410| *
411| END CASE
412| END
413| *
414|WHILE CURFLD EQ NXTFLD DO REPEAT
415|*
416|* Redisplay the field data using the inactive highlighting
417|*
418|XLINE = CURFLD
419|ACTIVE = 0
420|GOSUB DSPLINE
421|*
422|RETURN
423|*
424|*
425|**************************************************************************
426|*
427|* The CHECK.EXIT subroutine checks if any field data has changed, and
428|* prompts if the user wants to abandon changes. If no changes, or the user
429|* decides to abandon the changes, the DONE and XIT loop control variables
430|* are set to TRUE, causing all three loops to terminate, and the program
431|* itself to exit.
432|*
433|CHECK.EXIT: *
434|*
435|GOSUB CHECK.ABANDON
436|IF OK THEN
437| DONE = TRUE
438| XIT = TRUE
439|END
440|RETURN
441|*
442|*
443|**************************************************************************
444|*
445|* The CHECK.ID subroutine validates a newly entered item-ID. If the
446|* current record has unsaved changes, the user is prompted to abandon the
447|* changes. If no changes, or the user abandons the changes, and the new ID
448|* is not NULL, an attempt is made to read a record using the new ID. If
449|* the read is not successful, the ID is assumed to be a search string, and
450|* the search subroutine is called to select an ID based on the search
451|* string. If a valid ID is returned (or if one was initially entered), the
452|* new record data is displayed. If the new ID is null, or if the search
453|* routine did not return a valid ID, a warning message is displayed and
454|* the OK indicator variable is set to FALSE. Otherwise it is set to TRUE.
455|*
456|CHECK.ID: *
457|*
458|**************************************************************************
459|*
460|* Make sure we don't have any unsaved data before changing the ID
461|*
462|GOSUB CHECK.ABANDON
463|IF NOT(OK) THEN RETURN ;* Reprompt for the ID
464|IF ID EQ '' THEN
465| OK = FALSE ;* NULL is not a valid ID!
466|END ELSE
467| *
468| *************************************************************************
469| *
470| * Check if user wants new ID
471| *
472| IF ID EQ 'N' OR ID EQ 'n' THEN
473| * Get next sequential ID
474| READVU ID FROM FN.CUST.CTRL,'NEXT',2 THEN
475| WRITEV ID + 1 ON FN.CUST.CTRL,'NEXT',2
476| GOSUB RESTART
477| IDATA(1) = ID
478| END ELSE
479| PRINT EL:UNDREV:'Next item counter record not found!':NORMAL:BEL:
480| GOSUB INPCMD
481| PRINT EL:
482| OK = FALSE
483| RETURN
484| END
485| END ELSE
486| *
487| *************************************************************************
488| *
489| * Try to read the customer record from the entered ID
490| *
491| GOSUB READ.RECORD
492| IF NOT(OK) THEN
493| *
494| ************************************************************************
495| *
496| * The attempt to read a record failed - assume the ID is a search string
497| *
498| CALL UIEX.GET.CUST.IDX(XID,ID,FN.CUST.XREF,FN.CUST)
499| GOSUB DSPSCRN ;* Refresh the screen after index lookup
500| *
501| ************************************************************************
502| *
503| * If the user did not select an item in the search routine, reprompt
504| *
505| IF XID EQ '' THEN RETURN
506| *
507| ************************************************************************
508| *
509| * Try to read the customer record from the selected ID
510| *
511| ID = XID
512| GOSUB READ.RECORD
513| *
514| END
515| END
516|END
517|*
518|**************************************************************************
519|*
520|* If success, display the new record, otherwise show warning message
521|*
522|IF OK THEN
523| GOSUB DSPDATA ;* Display new record
524|END ELSE
525| PRINT EL:UNDREV:'Please enter a valid customer ID!':NORMAL:BEL:
526|END
527|RETURN
528|*
529|*
530|**************************************************************************
531|*
532|* The READ.RECORD subroutine reads a new customer record from the file and
533|* initializes the internal field data array (IDATA) from the record array
534|* (CUST.REC). If the record does not exist, the routine returns with the
535|* OK indicator variable set to FALSE. Otherwise OK is set to TRUE, and the
536|* CUST.ID variable is set to the new ID.
537|*
538|READ.RECORD: *
539|*
540|MATREAD CUST.REC FROM FN.CUST,ID THEN
541| CUST.ID = ID
542| IDATA(1) = CUST.ID
543| IDATA(2) = CUST.CONTACT
544| IDATA(3) = CUST.NAME
545| IDATA(4) = CUST.ADDRESS1
546| IDATA(5) = CUST.ADDRESS2
547| IDATA(6) = CUST.CITY
548| IDATA(7) = CUST.ST
549| IDATA(8) = CUST.ZIP
550| IDATA(9) = CUST.COUNTRY
551| IDATA(10) = CUST.PHONE
552| IDATA(11) = CUST.FAX
553| IDATA(12) = CUST.HISTORY
554| OK = TRUE ;* Set the SUCCESS indicator
555|END ELSE
556| OK = FALSE ;* Set the FAILURE indicator
557|END
558|RETURN
559|*
560|*
561|**************************************************************************
562|*
563|* The DELETE.RECORD subroutine confirms that the user intends to delete
564|* the current record. If the action is confirmed, the CUST.DELETE
565|* subroutine is called to perform the deletion. A separate subroutine is
566|* used to handle updating indexes, etc.
567|*
568|DELETE.RECORD: *
569|*
570|IF CUST.ID NE '' THEN
571| PRINT EL:UNDREV:'Are you sure you want to delete this customer? ':NORMAL:
572| GOSUB INPCMD
573| IF DIO[1,1] EQ 'Y' OR DIO[1,1] EQ 'y' THEN
574| * Deletion has been confirmed - do the delete
575| OK = TRUE ;* Set the SUCCESS indicator
576| CALL UIEX.CUST.DELETE(CUST.ID,FN.CUST,FN.CUST.XREF)
577| DONE = TRUE ;* proceed to next record
578| END ELSE
579| OK = FALSE ;* Set the FAILURE indicator
580| END
581|END
582|RETURN
583|*
584|*
585|**************************************************************************
586|*
587|* The SAVE.RECORD subroutine copies internal field data from the IDATA
588|* array to the customer record array (CUST.REC). The CUST.UPDATE
589|* subroutine is called to perform the update. A separate subroutine is
590|* used to handle updating indexes, etc.
591|*
592|SAVE.RECORD: *
593|*
594|IF IDATA(1) NE '' THEN
595| * Copy data from the internal field data array (IDATA) to the CUST.REC array
596| CUST.ID = IDATA(1)
597| CUST.CONTACT = IDATA(2)
598| CUST.NAME = IDATA(3)
599| CUST.ADDRESS1 = IDATA(4)
600| CUST.ADDRESS2 = IDATA(5)
601| CUST.CITY = IDATA(6)
602| CUST.ST = IDATA(7)
603| CUST.ZIP = IDATA(8)
604| CUST.COUNTRY = IDATA(9)
605| CUST.PHONE = IDATA(10)
606| CUST.FAX = IDATA(11)
607| CUST.HISTORY = IDATA(12)
608| * Update the file
609| CALL UIEX.CUST.UPDATE(CUST.ID,MAT CUST.REC,FN.CUST,FN.CUST.XREF)
610| OK = TRUE ;* Set the SUCCESS indicator
611|END ELSE
612| OK = FALSE ;* Set the FAILURE indicator
613|END
614|DONE = TRUE ;* proceed to next record
615|RETURN
616|*
617|*
618|**************************************************************************
619|*
620|* The RESTART subroutine prepares the internal field data array (IDATA),
621|* customer record array (CUST.REC) and ID for a new customer record.
622|*
623|RESTART: *
624|*
625|CUST.ID = ''
626|MAT CUST.REC = ''
627|MAT IDATA = ''
628|ACTIVE = 0
629|RETURN
630|*
631|*
632|**************************************************************************
633|*
634|* The CHECK.CHANGED subroutine checks if any internal field data has been
635|* changed. The OK indicator variable is set to FALSE if any data is
636|* changed, otherwise it is set to TRUE. The ID field is not checked, since
637|* it is appropriately handled by the CHECK.ID subroutine.
638|*
639|CHECK.CHANGED: *
640|*
641|OK = FALSE
642|IF CUST.CONTACT # IDATA(2) THEN RETURN
643|IF CUST.NAME # IDATA(3) THEN RETURN
644|IF CUST.ADDRESS1 # IDATA(4) THEN RETURN
645|IF CUST.ADDRESS2 # IDATA(5) THEN RETURN
646|IF CUST.CITY # IDATA(6) THEN RETURN
647|IF CUST.ST # IDATA(7) THEN RETURN
648|IF CUST.ZIP # IDATA(8) THEN RETURN
649|IF CUST.COUNTRY # IDATA(9) THEN RETURN
650|IF CUST.PHONE # IDATA(10) THEN RETURN
651|IF CUST.FAX # IDATA(11) THEN RETURN
652|IF CUST.HISTORY # IDATA(12) THEN RETURN
653|OK = TRUE
654|RETURN
655|*
656|*
657|**************************************************************************
658|*
659|* The CHECK.ABANDON subroutine calls CHECK.CHANGED. If any changes are
660|* found, a message is displayed and the user is prompted to abandon the
661|* changes. If there are no changes, or if the user decides to abandon
662|* changes, the OK indicator variable is set to TRUE. Otherwise it is set
663|* to FALSE.
664|*
665|CHECK.ABANDON: *
666|*
667|GOSUB CHECK.CHANGED
668|IF NOT(OK) THEN
669| PRINT EL:UNDREV:'Do you want to abandon all your changes? ':NORMAL:BEL:
670| GOSUB INPCMD
671| IF DIO[1,1] EQ 'Y' OR DIO[1,1] EQ 'y' THEN OK = 1
672| PRINT EL:
673|END
674|RETURN
675|*
676|*
677|**************************************************************************
678|*
679|* The DSPSCRN subroutine is used to refresh the entire screen.
680|*
681|DSPSCRN: *
682|*
683|* Clear the screen
684|PRINT CLR:NORMAL:
685|*
686|* Display heading & labels
687|PRINT @(5,0):'Customer File Maintenance':
688|FOR XLINE = 1 TO NUMFLDS
689| LBWD = CONTROL(XLINE)<1,4>
690| LBTX = (XLINE 'L#2 ') : CONTROL(XLINE)<1,1> ;* Prepend line number to label
691| IF LBWD > 0 THEN LBTX = (LBTX : STR('.',LBWD))[1,LBWD] ;* Pad label with dots
692| PRINT @(CONTROL(XLINE)<1,2>,CONTROL(XLINE)<1,3>):LBTX:
693|NEXT XLINE
694|*
695|PRINT @(5,20):REVERSE:'F5 = Save':NORMAL:
696|PRINT @(20,20):REVERSE:'F3 = Delete':NORMAL:
697|PRINT @(35,20):REVERSE:'F2 = Exit':NORMAL:
698|*
699|* Display the field data
700|GOSUB DSPDATA
701|RETURN
702|*
703|*
704|**************************************************************************
705|*
706|* The DSPDATA subroutine is used to refresh the field data for all fields.
707|*
708|DSPDATA: *
709|*
710|FOR XLINE = 1 TO NUMFLDS
711| GOSUB DSPLINE
712|NEXT XLINE
713|RETURN
714|*
715|*
716|**************************************************************************
717|*
718|* The DSPLINE subroutine is used to refresh the field data for one field.
719|* The field to be refreshed is specified by the XLINE variable. If the
720|* field is active (XLINE = ACTIVE), then the field data is displayed using
721|* the REVERSE display attribute. Otherwise it is displayed using the
722|* DIMREV display attribute.
723|*
724|DSPLINE: *
725|*
726|MSK = 'L#':CONTROL(XLINE)<1,7>
727|PRINT @(CONTROL(XLINE)<1,5>,CONTROL(XLINE)<1,6>):
728|IF XLINE EQ ACTIVE THEN
729| PRINT REVERSE:
730|END ELSE
731| PRINT DIMREV:
732|END
733|PRINT IDATA(XLINE) MSK:
734|PRINT NORMAL:
735|RETURN
736|*
737|*
738|**************************************************************************
739|*
740|* The INPCMD subroutine is used to input data or function key. If function
741|* key presed, the CMD variable is set to 'FI', 'DE', or 'EX'. If a mouse
742|* button is clicked, CMD is set to 'CLK' and MOUSECOL & MOUSEROW
743|* contain the position of the click. Otherwise, CMD is null, and the
744|* entered data is returned in DIO.
745|*
746|INPCMD: *
747|*
748|PRINT MOUSE.ON:
749|ECHO OFF
750|DIO = ''
751|CMD = ''
752|INPDONE = FALSE
753|LOOP UNTIL INPDONE DO
754| CHR = KEYIN(); * get raw character (no echo)
755| CHRNUM = SEQ(CHR) ;* get ASCII value
756| BEGIN CASE
757| CASE CHRNUM = 13 OR CHRNUM = 10
758| * CR or LF terminates input
759| INPDONE = TRUE
760| CASE CHRNUM = 8
761| * Backspace
762| IF DIO NE '' THEN
763| DIO = DIO[1,LEN(DIO)-1]
764| PRINT BACKSPACE:' ':BACKSPACE:
765| END
766| CASE CHRNUM = 1
767| * Wyse function key lead-in
768| INPUT REST:
769| IF DIO = '' THEN
770| * Decode the function key if pressed at beginning of input
771| BEGIN CASE
772| CASE REST = 'A'; CMD = 'EX'; INPDONE = TRUE
773| CASE REST = 'B'; CMD = 'DE'; INPDONE = TRUE
774| CASE REST = 'D'; CMD = 'FI'; INPDONE = TRUE
775| CASE TRUE; * ignore other function keys
776| END CASE
777| END
778| CASE CHRNUM = 2
779| * AccuTerm mouse lead-in
780| INPUT BTN:
781| INPUT MOUSEPOS:
782| IF DIO = '' THEN
783| IF BTN = 'p' THEN
784| * left button single click
785| CMD = 'CLK'
786| MOUSECOL = FIELD(MOUSEPOS,'.',1)
787| MOUSEROW = FIELD(MOUSEPOS,'.',2)
788| INPDONE = TRUE
789| END
790| END
791| CASE CHRNUM = 27
792| * Discard escape sequences - Wyse escape sequences are
793| * ESC followed by another character
794| CHR = KEYIN() ;*
795| CASE CHRNUM >= 32
796| * append printable characters to DIO & echo
797| DIO = DIO : CHR
798| PRINT CHR:
799| END CASE
800|REPEAT
801|ECHO ON
802|PRINT MOUSE.OFF:
803|RETURN
804|*
805|*
806|END
807|