home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
clarion
/
nrlpull.zip
/
NRLSYS.MDL
< prev
next >
Wrap
Text File
|
1989-04-17
|
55KB
|
1,057 lines
*GLOBAL*************************************************************************
INCLUDE('\CLARION\STD_KEYS.CLA')
INCLUDE('\CLARION\CTL_KEYS.CLA')
INCLUDE('\CLARION\ALT_KEYS.CLA')
INCLUDE('\CLARION\SHF_KEYS.CLA')
REJECT_KEY EQUATE(CTRL_ESC)
ACCEPT_KEY EQUATE(CTRL_ENTER)
TRUE EQUATE(1)
FALSE EQUATE(0)
MAP
@MODULES
.
EJECT('FILE LAYOUTS')
@FILE
EJECT('GLOBAL MEMORY VARIABLES')
ACTION SHORT !0 = NO ACTION
!1 = ADD RECORD
!2 = CHANGE RECORD
!3 = DELETE RECORD
!4 = LOOKUP FIELD
@MEMORY
EJECT('CODE SECTION')
CODE
SETHUE(7,0) !SET WHITE ON BLACK
BLANK ! AND BLANK
SETHUE() ! THE SCREEN
HELP(@HELPFILE) !OPEN THE HELP FILE
@OPENFILES !OPEN OR CREATE FILES
@BASEPROC !CALL THE BASE PROCEDURE
RETURN !EXIT TO DOS
*MENU***************************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
MENU,USE(MENU_FIELD),REQ
@CHOICES
. .
MENU_FIELD STRING(80)
EJECT
CODE
OPEN(SCREEN) !OPEN THE MENU SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
LOOP !LOOP UNTIL USER EXITS
@LOOKUPS !DISPLAY FROM OTHER FILES
@SHOW !DISPLAY STRING VARIABLES
@COMPUTE !DISPLAY COMPUTED FIELDS
@RESULT !MOVE RESULTING VALUES
ALERT !TURN OFF ALL ALERTED KEYS
ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
@ALERT !ALERT HOT KEYS
ACCEPT !READ A FIELD OR MENU CHOICE
@CHECKHOT !ON HOT KEY, CALL PROCEDURE
IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT
EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
UPDATE ! MOVE ALL FIELDS FROM SCREEN
EDIT_RANGE# = ?MENU_FIELD - 1 ! AND EDIT REMAINING FIELDS
SELECT(?MENU_FIELD) ! IF OK THEN START HERE NEXT
. !
LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY
@EDITS !EDIT ROUTINES GO HERE
OF ?MENU_FIELD !FROM THE MENU FIELD
EXECUTE CHOICE() ! CALL THE SELECTED PROCEDURE
@MENU !
. . . .
*TABLE**************************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
@PREPOINT
REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX)
@PLOC POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1)
@SCROLLVARIABLES
. .
NDX BYTE !REPEAT INDEX FOR POINT FIELD
ROW BYTE !ACTUAL ROW OF SCROLL AREA
COL BYTE !ACTUAL COLUMN OF SCROLL AREA
MAX LONG !LESSER OF COUNT AND RECORDS
COUNT BYTE(@COUNT) !NUMBER OF ITEMS TO SCROLL
ROWS BYTE(@ROWS) !NUMBER OF ROWS TO SCROLL
COLS BYTE(@COLS) !NUMBER OF COLUMNS TO SCROLL
EJECT
CODE
ACTION# = ACTION !SAVE ACTION
OPEN(SCREEN) !OPEN THE SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
NDX = 1 !PUT SELECTOR BAR ON TOP ITEM
ROW = ROW(?POINT) !REMEMBER TOP ROW AND
COL = COL(?POINT) ! LEFT COLUMN OF SCROLL AREA
IF ACTION = 4 !IF THIS IS A LOOKUP REQUEST
SET(@KEYNAME,@KEYNAME) ! FIND IT IN THE FILE
NEXT(@FILENAME) ! AND READ IT
POINTER# = POINTER(@FILENAME) ! SAVE POINTER TO CURRENT
SKIP(@FILENAME,-1) ! MAKE IT THE TOP RECORD
DO SHOW_TABLE ! FILL SCROLL AREA
GET(@FILENAME,POINTER#) ! AND REFRESH CURRENT RECORD
ELSE !OTHERWISE
SET(@KEYNAME) ! SET TO FIRST RECORD IN FILE
DO SHOW_TABLE ! FILL SCROLL AREA
.
RECORDS# = TRUE !INITIALIZE RECORDS FLAG
LOOP !LOOP UNTIL USER EXITS
MAX = RECORDS(@KEYNAME) !SET LESSER OF FILE RECORD
IF MAX > COUNT THEN MAX = COUNT. ! COUNT AND SCROLL ITEM COUNT
ACTION = ACTION# !RESTORE ACTION
POINTER# = 0 !CLEAR ADD POINTER
@LOOKUPS !DISPLAY FROM OTHER FILES
@SHOW !DISPLAY STRING VARIABLES
@COMPUTE !DISPLAY COMPUTED FIELDS
@RESULT !MOVE RESULTING VALUES
IF ~RECORDS(@KEYNAME) !IF THERE ARE NO RECORDS
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
ACTION = 1 ! SET ACTION TO ADD
@UPDATE ! CALL FORM FOR FIRST RECORD
IF ~RECORDS(@KEYNAME) THEN BREAK. ! IF ADD ABORTED THEN EXIT
SET(@KEYNAME) ! SET TO NEW RECORD
DO SHOW_TABLE ! FILL SCROLL AREA
NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM
MAX = 1 ! MAXIMUM DISPLAYED IS 1
. !
ALERT !RESET ALERTED KEYS
ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
@ALERT !ALERT HOT KEY
ACCEPT !READ A FIELD
@TABLEHOT !ON HOT KEY, CALL PROCEDURE
IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY
EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
IF KEYCODE() = ACCEPT_KEY AND | !ON SCREEN ACCEPT KEY
EDIT_RANGE# <> ?POINT ! AND NOT ON THE POINT FIELD
UPDATE ! MOVE ALL FIELDS FROM SCREEN
EDIT_RANGE# = ?POINT - 1 ! AND EDIT REMAINING FIELDS
SELECT(?POINT) ! IF OK THEN START HERE NEXT
. !
LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY OR | ! RETURN ON ESC KEY
RECORDS# = FALSE ! OR NO RECORDS
RETURN
.
@EDITS !EDIT ROUTINES GO HERE
RECORDS# = TRUE ! ASSUME RECORDS ARE HERE
@INITLOCATE !SHOW CURSOR FOR LOCATOR
OF ?POINT !FROM THE POINT FIELD
@LOCATE
CASE KEYCODE() ! PROCESS THE KEYSTROKE
OF INS_KEY !INSERT KEY
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
ACTION = 1 ! SET ACTION TO ADD
@UPDATE ! CALL FORM FOR NEW RECORD
IF ~ACTION ! IF A NEW RECORD WAS ADDED
POINTER# = POINTER(@FILENAME) ! REMEMBER WHICH RECORD
SET(@KEYNAME,@KEYNAME) ! SET TO NEW RECORD AND
SKIP(@FILENAME,-1) ! MAKE IT THE TOP ITEM
DO SHOW_TABLE ! DISPLAY THAT PAGE
.
OF ENTER_KEY !ENTER KEY OR
OROF ACCEPT_KEY !CTRL ENTER KEY
DO GET_RECORD ! READ THE SELECTED RECORD
IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST
ACTION = 0 ! SET ACTION TO COMPLETE
RETURN ! AND RETURN TO CALLER
. !
ACTION = 2 ! SET ACTION TO CHANGE
@UPDATE ! CALL FORM TO CHANGE RECORD
IF ~ACTION ! IF THE RECORD WAS CHANGED
POINTER# = POINTER(@FILENAME) ! REMEMBER WHICH RECORD
SET(@KEYNAME,@KEYNAME) ! SET TO CHANGED RECORD
SKIP(@FILENAME,-1) ! MAKE IT THE TOP ITEM
DO SHOW_TABLE ! AND DISPLAY THAT PAGE
ELSE ! OTHERWISE
SKIP(@FILENAME,(MAX-NDX)) ! SKIP BACK TO SAME PAGE
.
OF DEL_KEY !DELETE KEY
DO GET_RECORD ! READ THE SELECTED RECORD
ACTION = 3 ! SET ACTION TO DELETE
@UPDATE ! CALL FORM TO DELETE RECORD
IF ~ACTION ! IF RECORD WAS DELETED
SKIP(@FILENAME,-NDX) ! SET NEXT RECORD ON TOP
DO SHOW_TABLE ! AND DISPLAY THAT PAGE
ELSE ! OTHERWISE
SKIP(@FILENAME,(MAX-NDX)) ! SKIP BACK TO SAME PAGE
.
OF DOWN_KEY !DOWN ARROW KEY
IF NOT EOF(@FILENAME) ! IF THERE ARE MORE RECORDS
SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP
NEXT(@FILENAME) ! READ THE BOTTOM RECORD
DO SHOW_RECORD ! AND DISPLAY IT
.
OF PGDN_KEY !PAGE DOWN KEY
IF EOF(@FILENAME) ! ON THE LAST PAGE
NDX = MAX ! POINT TO BOTTOM ITEM
ELSE ! OTHERWISE
DO SHOW_TABLE ! DISPLAY NEXT PAGE
.
OF CTRL_PGDN !CTRL-PAGE DOWN KEY
NDX = MAX ! POINT TO BOTTOM ITEM
IF NOT EOF(@FILENAME) ! ON THE LAST PAGE
SET(@KEYNAME) ! SET TO BOTTOM RECORD MINUS
SKIP(@FILENAME,-COUNT) ! ONE PAGE OF RECORDS
DO SHOW_TABLE ! DISPLAY THE LAST PAGE
.
OF UP_KEY !UP ARROW KEY
SKIP(@FILENAME,-(COUNT-1)) ! SET TO TOP RECORD MINUS 1
IF NOT BOF(@FILENAME) ! IF THERE IS A PRIOR RECORD
PREVIOUS(@FILENAME) ! READ THE TOP RECORD
IF NOT ERROR() ! IF READ A RECORD
SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN
DO SHOW_RECORD ! AND DISPLAY IT
ELSIF ERRORCODE() = 33 ! ELSIF RECORD NOT AVAILABLE
NEXT(@FILENAME) ! RETRIEVE FIRST ONE
. .
SKIP(@FILENAME,COUNT-1) ! SET RECORD FOR NEXT PAGE
OF PGUP_KEY !PAGE UP KEY
SKIP(@FILENAME,-(COUNT-1)) ! SET TO TOP RECORD MINUS ONE
IF BOF(@FILENAME) ! IF THERE IS NO PRIOR RECORD
NDX = 1 ! THEN POINT TO TOP ITEM
SKIP(@FILENAME,COUNT-1) ! SET RECORD FOR THIS PAGE
ELSE ! OTHERWISE
SKIP(@FILENAME,-(COUNT+1)) ! SET RECORD FOR PRIOR PAGE
DO SHOW_TABLE ! AND DISPLAY THE PAGE
.
OF CTRL_PGUP !CTRL-PAGE UP KEY
SET(@KEYNAME) ! SET TO FIRST RECORD
NDX = 1 ! POINT TO TOP ITEM
DO SHOW_TABLE ! AND DISPLAY THE PAGE
.
. . .
RETURN !RETURN TO CALLER
SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS
SKIP(@FILENAME,COUNT-1) ! SET TO THE BOTTOM RECORD
IF EOF(@FILENAME) ! FOR A PARTIAL PAGE
SET(@KEYNAME) ! SET TO THE LAST RECORD
SKIP(@FILENAME,-COUNT) ! AND BACK UP ONE PAGE
ELSE ! OTHERWISE
SKIP(@FILENAME,-(COUNT-1)) ! SET RECORD FOR THIS PAGE
.
NDX# = NDX ! SAVE REPEAT INDEX
LOOP NDX = 1 TO COUNT ! LOOP THRU THE SCROLL AREA
IF EOF(@FILENAME) THEN BREAK. ! BREAK ON END OF FILE
NEXT(@FILENAME) ! READ THE NEXT RECORD
DO SHOW_RECORD ! AND DISPLAY IT
IF POINTER(@FILENAME) = POINTER# THEN NDX# = NDX.!POINT TO CORRECT RECORD
.
NDX = NDX# ! RESTORE REPEAT INDEX
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
IF RECORDS(@KEYNAME) < COUNT ! IF RECORDS DO NOT FILL
NDX#= RECORDS(@KEYNAME) * @PROWS ! GET NUMBER TIMES SIZE
BLANK(ROW + NDX#,COL,ROWS-NDX#,COLS) ! BLANK REMAINING AREA
.
SHOW_RECORD ROUTINE !DISPLAY A RECORD
@LOOKUPSCROLL ! DISPLAY FROM OTHER FILES
@SHOWSCROLL ! DISPLAY STRING VARIABLES
@COMPUTESCROLL ! DISPLAY COMPUTED FIELDS
GET_RECORD ROUTINE !READ SELECTED RECORD
SKIP(@FILENAME,-(MAX-NDX+1)) ! SET TO SELECTED RECORD
NEXT(@FILENAME) ! AND READ IT
FIND_RECORD ROUTINE !LOCATE REQUESTED RECORD
SET(@KEYNAME,@KEYNAME) ! SET TO REQUESTED RECORD
IF EOF(@FILENAME) ! IF BEYOND END OF FILE
PREVIOUS(@FILENAME) ! GET THE LAST RECORD
ELSE ! ELSE
NEXT(@FILENAME) ! READ THIS RECORD
.
POINTER# = POINTER(@FILENAME) ! SAVE ITS RECORD POINTER
SKIP(@FILENAME,-1) ! MAKE IT THE TOP RECORD
DO SHOW_TABLE ! AND FILL THE SCROLL AREA
SAME_PAGE ROUTINE !SET TO SAME PAGE ROUTINE
POINTER# = POINTER(@FILENAME) ! SAVE ITS RECORD POINTER
GET(@FILENAME,POINTER#) ! GET THE RECORD
SET(@KEYNAME,@KEYNAME) ! SET TO THE SAME RECORD
SKIP(@FILENAME,-1) ! SKIP TO TOP OF SAME PAGE
*SELTABLE***********************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
@PREPOINT
REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX)
@PLOC POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1)
@SCROLLVARIABLES
. .
PTR LONG !ENTRY POINTER FOR KEY TABLE
NDX BYTE !REPEAT INDEX FOR POINT AREA
ROW BYTE !ACTUAL ROW OF SCROLL AREA
COL BYTE !ACTUAL COLUMN OF SCROLL AREA
COUNT BYTE(@COUNT) !NUMBER OF ITEMS TO SCROLL
ROWS BYTE(@ROWS) !NUMBER OF ROWS TO SCROLL
COLS BYTE(@COLS) !NUMBER OF COLUMNS TO SCROLL
TABLE TABLE !TABLE OF RECORD KEYS
TBLPTR LONG ! POINTER TO DATA RECORD
KEY GROUP,PRE(TBL) ! RECORD KEY FIELDS
@COMPONENTS
. .
@SAVEITEMS
EJECT
CODE
ACTION# = ACTION !SAVE ACTION
OPEN(SCREEN) !OPEN THE SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
@INITSELECTS !SAVE SELECTOR FIELDS
PTR = 1 !START AT TABLE ENTRY
NDX = 1 !PUT SELECTOR BAR ON TOP ITEM
ROW = ROW(?POINT) !REMEMBER TOP ROW AND
COL = COL(?POINT) !LEFT COLUMN OF SCROLL AREA
RECORDS# = TRUE !INITIALIZE RECORDS FLAG
LOOP !LOOP UNTIL USER EXITS
ACTION = ACTION# !RESTORE ACTION
@RESTSELECTS !RESTORE SELECTOR FIELDS
@LOOKUPS !DISPLAY FROM OTHER FILES
@SHOW !DISPLAY STRING VARIABLES
@COMPUTE !DISPLAY COMPUTED FIELDS
@RESULT !MOVE RESULTING VALUES
ALERT !RESET ALERTED KEYS
ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
@ALERT !ALERT HOT KEY
ACCEPT !READ A FIELD
MEM:MESSAGE = '' !CLEAR MESSAGE AREA
@TABLEHOT !ON HOT KEY, CALL PROCEDURE
IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY
EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
IF KEYCODE() = ACCEPT_KEY AND | !ON SCREEN ACCEPT KEY
EDIT_RANGE# <> ?POINT ! AND NOT ON THE POINT FIELD
UPDATE ! MOVE ALL FIELDS FROM SCREEN
EDIT_RANGE# = ?POINT - 1 ! AND EDIT REMAINING FIELDS
SELECT(?POINT) ! IF OK THEN START HERE NEXT
. !
LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY OR | ! RETURN ON ESC KEY
RECORDS# = FALSE ! OR NO RECORDS
FREE(TABLE) ! FREE THE TABLE OF POINTS
RETURN ! RETURN TO CALLER
.
@EDITS !EDIT ROUTINES GO HERE
RECORDS# = TRUE ! ASSUME THERE ARE RECORDS
@INITLOCATE
OF ?POINT !PROCESS THE POINT FIELD
IF ~RECORDS(TABLE) !IF THERE ARE NO RECORDS
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
UPDATE ! UPDATE ALL FIELDS
ACTION = 1 ! SET ACTION TO ADD
@UPDATE ! CALL FORM FOR FIRST RECORD
IF ~ACTION ! IF RECORD WAS ADDED
DO ADD_TABLE ! THEN ADD NEW TABLE ENTRY
DO SORT_TABLE ! SORT THE TABLE
DO SHOW_TABLE ! AND DISPLAY FIRST PAGE
.
IF ~RECORDS(TABLE) ! IF ADD ABORTED TRY AGAIN
RECORDS# = FALSE ! INDICATE NO RECORDS
SELECT(?-1) ! SELECT PREVIOUS FIELD
BREAK ! END THE EDITS
.
CYCLE ! CONTINUE THE EDIT
.
@LOCATE
CASE KEYCODE() !PROCESS THE KEYSTROKE
OF ENTER_KEY !ENTER KEY OR
OROF ACCEPT_KEY !CTRL-ENTER KEY
DO GET_RECORD ! READ THE SELECTED RECORD
IF ERROR() ! IF RECORD HAS BEEN DELETED
MEM:MESSAGE = ERROR() ! TELL USER WHAT HAPPENED
SELECT(?) ! STAY IN THE POINT FIELD
DO BUILD_TABLE ! REBUILD TABLE
DO SORT_TABLE ! SORT IT
DO SHOW_TABLE ! SHOW IT
BREAK ! AND GET ANOTHER KEY
.
IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST
ACTION = 0 ! SET ACTION TO COMPLETE
FREE(TABLE) ! FREE THE TABLE OF POINTS
RETURN ! RETURN TO CALLER
.
ACTION = 2 ! SET ACTION TO CHANGE
@UPDATE ! CALL FORM TO CHANGE RECORD
IF ~ACTION ! IF THE RECORD WAS CHANGED
DELETE(TABLE) ! DELETE OLD TABLE ENTRY
DO ADD_TABLE ! ADD NEW TABLE ENTRY
DO SORT_TABLE ! SORT THE TABLE
DO SHOW_TABLE ! AND DISPLAY THAT PAGE
.
OF INS_KEY !INS KEY
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
UPDATE ! UPDATE ALL FIELDS
ACTION = 1 ! SET ACTION TO ADD
@UPDATE ! CALL FORM FOR NEW RECORD
IF ~ACTION ! IF RECORD WAS ADDED
DO ADD_TABLE ! ADD NEW TABLE ENTRY
DO SORT_TABLE ! SORT THE TABLE
DO SHOW_TABLE ! AND DISPLAY THAT PAGE
.
OF DEL_KEY !DEL KEY
DO GET_RECORD ! READ THE SELECTED RECORD
IF ERROR() ! IF RECORD HAS BEEN DELETED
MEM:MESSAGE = ERROR() ! TELL USER WHAT HAPPENED
SELECT(?) ! STAY ON THE POINT FIELD
DO BUILD_TABLE ! REBUILD TABLE
DO SORT_TABLE ! SORT IT
DO SHOW_TABLE ! SHOW IT
BREAK ! AND GET ANOTHER KEY
.
ACTION = 3 ! SET ACTION TO DELETE
@UPDATE ! CALL FORM TO DELETE RECORD
IF ~ACTION ! IF RECORD WAS DELETED
DELETE(TABLE) ! DELETE TABLE ENTRY
DO SHOW_TABLE ! AND DISPLAY THAT PAGE
.
OF DOWN_KEY !DOWN ARROW KEY
IF PTR <= RECORDS(TABLE)-COUNT ! IF THERE ARE MORE ENTRIES
SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP
PTR += 1 ! SET TO THE NEXT ENTRY
DO SHOW_RECORD ! AND DISPLAY THE RECORD
.
OF PGDN_KEY !PAGE DOWN KEY
IF PTR >= RECORDS(TABLE)-COUNT+1 ! ON THE LAST PAGE
NDX = COUNT. ! POINT TO BOTTOM ITEM
PTR += COUNT ! OTHERWISE
TBLPTR = -1 ! NOT SET TO A RECORD
DO SHOW_TABLE ! DISPLAY THE NEXT PAGE
OF CTRL_PGDN !CTRL-PAGE DOWN KEY
PTR = RECORDS(TABLE) - COUNT + 1 ! SET TO LAST PAGE
NDX = COUNT ! POINT TO BOTTOM ITEM
TBLPTR = -1 ! NOT SET TO A RECORD
DO SHOW_TABLE ! DISPLAY THE LAST PAGE
OF UP_KEY !UP ARROW KEY
IF PTR > 1 ! IF THERE IS A PRIOR RECORD
PTR -= 1 ! SET TO PRIOR RECORD
SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN
DO SHOW_RECORD ! DISPLAY THE RECORD
.
OF PGUP_KEY !PAGE UP KEY
IF PTR = 1 THEN NDX = 1. ! ON FIRST PAGE POINT TO TOP
PTR -= ROWS ! OTHERWISE BACK UP 1 PAGE
TBLPTR = -1 ! NOT SET TO A RECORD
DO SHOW_TABLE ! AND DISPLAY IT
OF CTRL_PGUP !CTRL-PAGE UP
PTR = 1 ! POINT TO FIRST RECORD
NDX = 1 ! POINT TO TOP ITEM
TBLPTR = -1 ! NOT SET TO A RECORD
DO SHOW_TABLE ! AND DISPLAY THE FIRST PAGE
.
. . . !
FREE(TABLE) !FREE MEMORY TABLE
RETURN !AND RETURN TO CALLER
BUILD_TABLE ROUTINE !BUILD MEMORY TABLE
FREE(TABLE) !EMPTY THE TABLE
@READTABLE !DO SELECTOR OR FILTER
TBLPTR = -1 !INITIALIZE TO NO RECORD
DO SHOW_TABLE !DISPLAY A PAGE OF RECORDS
ADD_TABLE ROUTINE !ADD ENTRY TO MEMORY TABLE
@CHECKADD !
IF ~(@FILTER) THEN EXIT. ! EXIT IF FILTERED OUT
@SETCOMPONENTS ! MOVE KEY COMPONENTS
TBLPTR = POINTER(@FILENAME) ! SAVE DATA RECORD POINTER
ADD(TABLE) ! ADD NEW TABLE ENTRY
IF ERROR() ! IF OUT OF MEMORY
MEM:MESSAGE = ERROR() ! INFORM USER
BEEP ! SOUND ALARM
.
SORT_TABLE ROUTINE !SORT TABLE ENTRIES
TBLPTR# = TBLPTR ! SAVE DATA RECORD POINTER
@SORTTABLE ! SORT THE TABLE
LOOP PTR = 1 TO RECORDS(TABLE) ! LOOK UP THE SAVED POINTER
GET(TABLE,PTR) ! SO WE WILL STILL POINT
IF TBLPTR = TBLPTR# THEN EXIT. ! AT THE SAME RECORD
.
SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS
IF PTR > RECORDS(TABLE)-COUNT+1 ! FOR A PARTIAL PAGE
PTR = RECORDS(TABLE)-COUNT+1. ! SET TO THE LAST RECORD
IF PTR < 1 THEN PTR = 1. ! AND BACK UP ONE PAGE
TBLPTR# = TBLPTR ! SAVE DATA RECORD POINTER
NDX# = NDX ! SAVE REPEAT INDEX
LOOP NDX = 1 TO COUNT ! LOOP THRU THE SCROLL AREA
DO SHOW_RECORD ! DISPLAY A RECORD
IF TBLPTR# = TBLPTR THEN NDX# = NDX. ! POINT TO CORRECT RECORD
. !
NDX = NDX# ! RESTORE REPEAT INDEX
IF NDX > RECORDS(TABLE) THEN NDX = RECORDS(TABLE).!SHOWING THE LAST
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
IF RECORDS(TABLE) < COUNT ! IF RECORDS DO NOT FILL
NDX#= RECORDS(TABLE) * @PROWS ! GET NUMBER TIMES SIZE
BLANK(ROW + NDX#,COL,ROWS-NDX#,COLS) ! BLANK REMAINING AREA
.
SHOW_RECORD ROUTINE !DISPLAY A RECORD
TBLPTR = 0 ! START WITH NO RECORD
GET(TABLE,PTR+NDX-1) ! GET THE TABLE ENTRY
IF ~ERROR() ! IF THERE IS ONE
GET(@FILENAME,TBLPTR) ! READ A DATA RECORD
IF ~ERROR()
@RESTSELECTS ! RESTORE SELECTOR FIELDS
@LOOKUPSCROLL ! DISPLAY FROM OTHER FILES
@SHOWSCROLL ! DISPLAY STRING VARIABLES
@COMPUTESCROLL ! DISPLAY COMPUTED FIELDS
. .
GET_RECORD ROUTINE !READ SELECTED RECORD
GET(TABLE,PTR+NDX-1) ! GET THE TABLE ENTRY
GET(@FILENAME,TBLPTR) ! READ THE DATA RECORD
FIND_RECORD ROUTINE !LOCATE REQUESTED RECORD
@SETCOMPONENTS ! MOVE THEM TO THE TABLE
GET(TABLE,KEY) ! GET THE TABLE ENTRY
PTR = POINTER(TABLE) ! SET RECORD POINTER
IF ~PTR THEN PTR = RECORDS(TABLE). ! SET TO LAST IF NO POINTER
GET(TABLE,PTR) ! AND READ THE DATA RECORD
DO SHOW_TABLE ! DISPLAY THAT PAGE
SAME_PAGE ROUTINE !SET TO SAME PAGE ROUTINE
DO SORT_TABLE ! SORT THE TABLE
*FORM***************************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
@PAUSE
ENTRY,USE(?LAST_FIELD)
PAUSE(''),USE(?DELETE_FIELD)
.
EJECT
CODE
OPEN(SCREEN) !OPEN THE SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
DISPLAY !DISPLAY THE FIELDS
EXECUTE ACTION !SET THE CURRENT RECORD POINTER
POINTER# = 0 ! NO RECORD FOR ADD
POINTER# = POINTER(@FILENAME) ! CURRENT RECORD FOR CHANGE
.
LOOP !LOOP THRU ALL THE FIELDS
MEM:MESSAGE = CENTER(MEM:MESSAGE,SIZE(MEM:MESSAGE)) !DISPLAY ACTION MESSAGE
@LOOKUPS !DISPLAY FROM OTHER FILES
@SHOW !DISPLAY STRING VARIABLES
@COMPUTE !DISPLAY COMPUTED FIELDS
@RESULT !MOVE RESULTING VALUES
ALERT !RESET ALERTED KEYS
ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
@ALERT !ALERT HOT KEY
ACCEPT !READ A FIELD
@CHECKHOT !ON HOT KEY, CALL PROCEDURE
IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT KEY
EXECUTE ACTION !SET ACTION MESSAGE
MEM:MESSAGE = 'Record will be Added' !
MEM:MESSAGE = 'Record will be Changed' !
MEM:MESSAGE = 'Press Enter to Delete' !
.
EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
UPDATE ! MOVE ALL FIELDS FROM SCREEN
EDIT_RANGE# = FIELDS() ! AND EDIT REMAINING FIELDS
. !
LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY
IF ACTION = 3 THEN SELECT(?DELETE_FIELD).! OR CONFIRM FOR DELETE
@EDITS !EDIT ROUTINES GO HERE
OF ?LAST_FIELD !FROM THE LAST FIELD
EXECUTE ACTION ! UPDATE THE FILE
ADD(@FILENAME) ! ADD NEW RECORD
PUT(@FILENAME) ! CHANGE EXISTING RECORD
DELETE(@FILENAME) ! DELETE EXISTING RECORD
.
IF ERROR() THEN STOP(ERROR()). ! CHECK FOR UNEXPECTED ERROR
PUT(@FILENAME2) ! UPDATE SECONDARY FILES
PUT(@FILENAME3) ! UPDATE SECONDARY FILES
PUT(@FILENAME4) ! UPDATE SECONDARY FILES
@NEXTFORM ! CALL NEXT FORM PROCEDURE
ACTION = 0 ! SET ACTION TO COMPLETE
RETURN ! AND RETURN TO CALLER
OF ?DELETE_FIELD !FROM THE DELETE FIELD
IF KEYCODE() = ENTER_KEY | ! ON ENTER KEY
OR KEYCODE() = ACCEPT_KEY ! OR CTRL-ENTER KEY
SELECT(?LAST_FIELD) ! DELETE THE RECORD
ELSE ! OTHERWISE
BEEP ! BEEP AND ASK AGAIN
. . . .
*MEMFORM************************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
@PAUSE
ENTRY,USE(?LAST_FIELD)
.
EJECT
CODE
OPEN(SCREEN) !OPEN THE SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
DISPLAY !DISPLAY THE FIELDS
LOOP !LOOP THRU ALL THE FIELDS
@LOOKUPS !DISPLAY FROM OTHER FILES
@SHOW !DISPLAY STRING VARIABLES
@COMPUTE !DISPLAY COMPUTED FIELDS
@RESULT !MOVE RESULTING VALUES
ALERT !RESET ALERTED KEYS
ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
@ALERT !ALERT HOT KEY
ACCEPT !READ A FIELD
@CHECKHOT !ON HOT KEY, CALL PROCEDURE
IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT KEY
EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
UPDATE ! MOVE ALL FIELDS FROM SCREEN
EDIT_RANGE# = FIELDS() ! AND EDIT REMAINING FIELDS
. !
LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY
@EDITS !EDIT ROUTINES GO HERE
OF ?LAST_FIELD !FROM THE LAST FIELD
PUT(@FILENAME2) ! UPDATE SECONDARY FILES
PUT(@FILENAME3) ! UPDATE SECONDARY FILES
PUT(@FILENAME4) ! UPDATE SECONDARY FILES
@NEXTFORM ! CALL NEXT FORM PROCEDURE
ACTION = 0 ! SET ACTION TO COMPLETE
RETURN ! AND RETURN TO CALLER
. . .
*REPORT*************************************************************************
@PROCNAME PROCEDURE
REPORT @REPORT
@SAVEITEMS
CODE
DONE# = 0 !TURN OFF DONE FLAG
@SETUP !CALL SETUP PROCEDURE
@INITSELECTS !SAVE SELECTOR FIELDS
BUILD(@INDEX) !BUILD FILE INDEX
@INITREPORT !INIT REPORT VARIABLES
@RPTHEADER !DO REPORT HEADER COMPUTES
PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE
@PRINTMEMO !PRINT ANY MEMO FILES
@SETFILE !SET TO FIRST RECORD
@PAGEFOOTER !DO PAGE FOOTER COMPUTES
@PAGEHEADER !DO PAGE HEADER COMPUTES
DO NEXT_RECORD !READ FIRST RECORD
@PAGEHEADER !DO PAGE HEADER COMPUTES
OPEN(REPORT) !OPEN THE REPORT
LOOP UNTIL DONE# !READ ALL RECORDS IN FILE
@INITBREAK ! SET BREAK CRITERIA
@INITGROUP ! INIT GROUP VARIABLES
@GRPHEADER ! DO HEADER COMPUTES
PRINT(RPT:GRP_HEAD) ! PRINT GROUP HEADER
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
@PRINTMEMO ! PRINT ANY MEMO FIELD
LOOP UNTIL DONE# ! READ ALL RECORDS IN GROUP
SAVE_LINE# = MEM:LINE ! SAVE LINE NUMBER
@RUNTOTALS ! ACCUMULATE RUNNING TOTALS
@INITDETAIL ! SET UP FOR DETAIL LINE
PRINT(RPT:DETAIL) ! PRINT DETAIL LINES
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
@PRINTMEMO ! PRINT ANY MEMO FIELD
@TOTALS ! ACCUMULATE TOTALS
@PAGEFOOTER ! DO PAGE FOOTER COMPUTES
@PAGEHEADER ! DO PAGE HEADER COMPUTES
DO NEXT_RECORD ! GET NEXT RECORD
@CHECKBREAK ! EXIT ON NEW GROUP
. !
@GRPFOOTER ! DO FOOTER COMPUTES
PRINT(RPT:GRP_FOOT) ! PRINT GROUP FOOTER
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
@PRINTMEMO ! PRINT ANY MEMO FIELD
. !
@RPTFOOTER !DO REPORT FOOTER COMPUTES
PRINT(RPT:RPT_FOOT) !PRINT GRAND TOTALS
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
@PRINTMEMO ! PRINT ANY MEMO FIELD
CLOSE(REPORT) !CLOSE REPORT
RETURN !RETURN TO CALLER
NEXT_RECORD ROUTINE !GET NEXT RECORD
LOOP UNTIL EOF(@FILENAME) ! READ UNTIL END OF FILE
NEXT(@FILENAME) ! READ NEXT RECORD
@CHECKSELECT ! STOP IF PAST SELECTOR
@DETAIL ! DO DETAIL COMPUTES
IF ~(@FILTER) THEN CYCLE. ! IF FILTERED OUT, GET NEXT
EXIT ! EXIT THE ROUTINE
. !
DONE# = 1 ! ON EOF, SET DONE FLAG
CHECK_PAGE ROUTINE !CHECK FOR NEW PAGE
IF MEM:LINE <= SAVE_LINE# ! ON PAGE OVERFLOW
@INITPAGE ! INIT PAGE VARIABLES
.
*MEMREPORT**********************************************************************
@PROCNAME PROCEDURE
REPORT @REPORT
CODE
@SETUP !CALL SETUP PROCEDURE
@INITREPORT !INIT REPORT VARIABLES
@RPTHEADER !DO REPORT HEADER COMPUTES
PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE
@PAGEFOOTER !DO PAGE FOOTER COMPUTES
@PAGEHEADER !DO PAGE HEADER COMPUTES
OPEN(REPORT) !OPEN REPORT BODY
@INITGROUP !INIT GROUP VARIABLES
@GRPHEADER !DO HEADER COMPUTES
PRINT(RPT:GRP_HEAD) !PRINT GROUP HEADER
@MEMMEMO !PRINT ANY MEMO FIELD
@DETAIL !DO DETAIL COMPUTES
@RUNTOTALS !ACCUMULATE RUNNING TOTALS
@INITDETAIL !SET UP FOR DETAIL RECORD
PRINT(RPT:DETAIL) !PRINT DETAIL LINES
@MEMMEMO !PRINT ANY MEMO FIELD
@TOTALS !ACCUMULATE TOTALS
@GRPFOOTER !DO FOOTER COMPUTES
PRINT(RPT:GRP_FOOT) !PRINT GROUP FOOTER
@MEMMEMO !PRINT ANY MEMO FIELD
@PAGEFOOTER !DO PAGE FOOTER COMPUTES
@RPTFOOTER !DO REPORT FOOTER COMPUTES
PRINT(RPT:RPT_FOOT) !PRINT REPORT FOOTER
@MEMMEMO !PRINT ANY MEMO FIELD
CLOSE(REPORT) !CLOSE REPORT
RETURN !RETURN TO CALLER
*PRINTMEMO**********************************************************************
@MEMOLEN !DETERMINE MEMO SIZE
J# = 2 !START WITH SECOND ROW
LOOP !LOOP THRU ALL USED ROWS
MEMODONE# = 0 ! NO MEMOS DONE YET
@SETMEMO ! SET THE MEMO VARIABLES
IF MEMODONE# = 0 THEN BREAK. ! ALL MEMOS PRINTED
@PRTDETAIL ! AND PRINT IT
J# += 1 ! INCREMENT COUNTER
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
.
DO CHECK_PAGE !DO PAGE BREAK IF NEEDED
*SETMEMO************************************************************************
IF J# <= @MEMOTMP# !IF IN THE RANGE OF THIS MEMO
@MEMOVAR = @MEMOROW[J#] ! MOVE A MEMO FIELD ROW
MEMODONE# = 1 ! MEMO HAS BEEN MOVED
ELSE !OTHERWISE
@MEMOVAR = '' ! NO MEMO TO DO
. ! END OF SETMEMO
*MEMOLEN************************************************************************
LOOP @MEMOTMP# = @MEMOSIZE TO 2 BY -1 !BACKSCAN THE MEMO FIELD TO
IF @MEMOROW[@MEMOTMP#] <> '' THEN BREAK. ! FIND NUMBER OF ROWS USED
. ! END OF MEMOLEN
*PRTDETAIL**********************************************************************
PRINT(@MEMDETAIL) !PRINT THE DETAIL RECORD
*MEMMEMO************************************************************************
@MEMOLEN !DETERMINE MEMO SIZE
J# = 2 !START WITH ROW 2
LOOP !LOOP THRU ALL USED ROWS
MEMODONE# = 0 ! NO MEMOS DONE YET
@SETMEMO ! SET THE MEMO VARIABLES
IF MEMODONE# = 0 THEN BREAK. ! ALL MEMOS PRINTED
@PRTDETAIL ! AND PRINT IT
J# += 1 ! INCREMENT COUNTER
.
*ALERT**************************************************************************
ALERT(@HOTKEY) !ALERT HOT KEY
*TODO***************************************************************************
@PROCNAME PROCEDURE !THIS PROCEDURE IS NOT DEFINED
CODE !
RETURN !RETURN TO CALLER
*SHOWMEMO***********************************************************************
LOOP I# = 1 TO @MEMOROWS !DISPLAY MEMO FIELD BY ROWS
SHOW(ROW(@SCRMEMO)+I#-1,COL(@SCRMEMO),@MEMOROW[I#],@S@MEMOCOLS)
.
*INRANGE************************************************************************
IF ~INRANGE(@FIELD,@LOWER,@UPPER) !IF FIELD IS OUT OF RANGE
BEEP ! SOUND KEYBOARD ALARM
SELECT(?@FIELD) ! AND STAY ON THIS FIELD
BREAK !
.
*REQUIRED***********************************************************************
IF @FIELD = '' !IF REQUIRED FIELD IS EMPTY
BEEP ! SOUND KEYBOARD ALARM
SELECT(?@FIELD) ! AND STAY ON THIS FIELD
BREAK !
.
*NOTREQUIRED********************************************************************
IF @FIELD = '' !IF NOT REQUIRED THEN
@EDITPROC ! CALL THE EDIT PROCEDURE
CYCLE ! END THE EDIT
.
*UNIQUEKEY**********************************************************************
GET(@FILENAME,@ACCESSKEY) !READ THE RECORD BY KEY
IF NOT ERROR() !IF A RECORD IS FOUND
IF POINTER(@FILENAME) <> POINTER# ! BUT NOT THE SAME RECORD
CLEAR(@PRE:RECORD) ! CLEAR IN CASE OF ADD
GET(@FILENAME,POINTER#) ! RE-READ THE OLD RECORD
UPDATE ! RE-UPDATE THE RECORD
MEM:MESSAGE = 'CREATES DUPLICATE KEY'! MOVE AN ERROR MESSAGE
SELECT(?@FIELD) ! STAY ON THE SAME FIELD
BEEP ! SOUND THE KEYBOARD ALARM
BREAK ! AND LOOP AGAIN
. .
GET(@FILENAME,POINTER#) ! RE-READ THE OLD RECORD
UPDATE ! AND RE-UPDATE THE RECORD
*SETTOP*************************************************************************
SET(@KEYNAME) !SET TO FIRST RECORD
*SETSELECT**********************************************************************
SET(@KEYNAME,@KEYNAME) !SET TO FIRST SELECTED RECORD
*INITLOCATE*********************************************************************
OF ?PRE_POINT !
IF KEYCODE() = ESC_KEY OR | ! IF GOING UP
KEYCODE() = UP_KEY OR | ! THE SCREEN
RECORDS# = FALSE ! OR NO RECORDS ON SCREEN
SCR:LOCATOR = '' ! CLEAR LOCATOR
SELECT(?-1) ! AND GO TO PREVIOUS FIELD
SETCURSOR ! AND TURN CURSOR OFF
ELSE ! OTHERWISE, GOING DOWN
LEN# = 0 ! RESET TO START OF LOCATOR
SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)) !AND TURN CURSOR ON
.
*PREPOINT***********************************************************************
ENTRY,USE(?PRE_POINT)
*LOCATE*************************************************************************
IF KEYCODE() > 31 | !THE DISPLAYABLE CHARACTERS
AND KEYCODE() < 255 !ARE USED TO LOCATE RECORDS
IF LEN# < SIZE(SCR:LOCATOR) ! IF THERE IS ROOM LEFT
SCR:LOCATOR = SUB(SCR:LOCATOR,1,LEN#) & CHR(KEYCODE())
LEN# += 1 ! INCREMENT THE LENGTH
.
ELSIF KEYCODE() = BS_KEY !BACKSPACE UNTYPES A CHARACTER
IF LEN# > 0 ! IF THERE ARE CHARACTERS LEFT
LEN# -= 1 ! DECREMENT THE LENGTH
SCR:LOCATOR = SUB(SCR:LOCATOR,1,LEN#) ! ERASE THE LAST CHARACTER
.
ELSE !FOR ANY OTHER CHARACTER
LEN# = 0 ! ZERO THE LENGTH
SCR:LOCATOR = '' ! ERASE THE LOCATOR FIELD
.
SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)+LEN#) !AND RESET THE CURSOR
@SETLOCATE
IF KEYBOARD() > 31 | !THE DISPLAYABLE CHARACTERS
AND KEYBOARD() < 255 | !ARE USED TO LOCATE RECORDS
OR KEYBOARD() = BS_KEY !INCLUDE BACKSPACE
CYCLE
.
IF LEN# > 0 THEN DO FIND_RECORD. ! AND FIND THE RECORD
*STRLOCATE**********************************************************************
@LOCFIELD = CLIP(SCR:LOCATOR) ! UPDATE THE KEY FIELD
*PICLOCATE**********************************************************************
@LOCFIELD = DEFORMAT(SCR:LOCATOR) ! UPDATE THE KEY FIELD
*SELECTOR***********************************************************************
SET(@KEYNAME,@KEYNAME) !SET AT FIRST SELECTED RECORD
LOOP UNTIL EOF(@FILENAME) !LOOP UNTIL END OF FILE
NEXT(@FILENAME) ! READ A RECORD
@CHECKSELECT ! CHECK THAT IT IS SELECTED
DO ADD_TABLE ! AND ADD TO MEMORY TABLE
.
*FILTER*************************************************************************
BUFFER(@FILENAME,.25) !USE 1/4TH OF MEMORY FOR BUFFER
SET(@FILENAME) !READ DATA RECORD SEQUENCE
LOOP UNTIL EOF(@FILENAME) !LOOP UNTIL END OF FILE
NEXT(@FILENAME) ! READ A RECORD
DO ADD_TABLE ! ADD IT TO MEMORY TABLE
.
FREE(@FILENAME) !FREE MEMORY USED FOR BUFFERING
DO SORT_TABLE !SORT TABLE INTO KEY SEQUENCE
PTR = 1 !DISPLAY FROM TOP OF TANLE
*VALIDATE***********************************************************************
@ACCESSFIELD = @FIELD !MOVE RELATED FIELDS
GET(@FILENAME,@ACCESSKEY) !READ THE RECORD
IF ERROR() !IF NO RECORD IS FOUND
MEM:MESSAGE = 'RECORD NOT FOUND' ! MOVE AN ERROR MESSAGE
BEEP ! SOUND THE KEYBOARD ALARM
SELECT(?@FIELD) ! AND STAY ON THE SAME FIELD
.
*ENTERTABLE*********************************************************************
@ACCESSFIELD = @FIELD !MOVE RELATED FIELDS
GET(@FILENAME,@ACCESSKEY) !READ THE RECORD
IF ERROR() !IF NO RECORD IS FOUND
ACTION# = ACTION ! SAVE ACTION
ACTION = 4 ! REQUEST TABLE LOOKUP
@LOOKUP ! CALL LOOKUP PROCEDURE
@FIELD = @ACCESSFIELD ! MOVE LOOKUP FIELD
DISPLAY(?@FIELD) ! AND DISPLAY IT
IF ACTION THEN SELECT(?@FIELD). ! NO SELECTION WAS MADE
ACTION = ACTION# ! RESTORE ACTION
.
*AUTOTABLE**********************************************************************
@ACCESSFIELD = @FIELD !MOVE RELATED FIELDS
GET(@FILENAME,@ACCESSKEY) !READ THE RECORD
ACTION# = ACTION !SAVE ACTION
ACTION = 4 !REQUEST TABLE LOOKUP
@LOOKUP !CALL LOOKUP PROCEDURE
@LOOKFIELD = @ACCESSFIELD !SAVE LOOKUP FIELD
@FIELD = @ACCESSFIELD !MOVE LOOKUP FIELD
DISPLAY(?@FIELD) !AND DISPLAY IT
IF ACTION THEN SELECT(?@FIELD-1). !NO SELECTION WAS MADE
ACTION = ACTION# !RESTORE ACTION
*HOTTABLE***********************************************************************
IF KEYCODE() = @HOTKEY !IF HOT KEY PRESSED
UPDATE ! UPDATE ALL FIELDS
@ACCESSFIELD = @FIELD ! MOVE RELATED FIELDS
GET(@FILENAME,@ACCESSKEY) ! READ THE RECORD
ACTION# = ACTION ! SAVE ACTION
ACTION = 4 ! REQUEST TABLE LOOKUP
@LOOKUP ! CALL LOOKUP PROCEDURE
@FIELD = left(@ACCESSFIELD) ! MOVE LOOKUP FIELD
DISPLAY(?@FIELD) ! AND DISPLAY IT
IF ACTION THEN SELECT(?@FIELD). ! NO SELECTION WAS MADE
ACTION = ACTION# ! RESTORE ACTION
.
*NEXTFORM***********************************************************************
IF ACTION <> 3 !IF THIS IS NOT A DELETE
ACTION = 2 ! SET ACTION TO CHANGE MODE
@NEXTPAGE ! CALL NEXT FORM PROCEDURE
IF ACTION ! IF RECORD WAS NOT CHANGED
SELECT(?LAST_FIELD - 1) ! SELECT THE LAST ENTRY
BREAK ! AND LOOP AGAIN
. .
*PAUSE**************************************************************************
OF ?PAUSE_FIELD !ON PAUSE FIELD
IF KEYCODE() <> ENTER_KEY | !IF NOT ENTER KEY
AND KEYCODE() <> ACCEPT_KEY !AND NOT CTRL-ENTER KEY
BEEP ! SOUND KEYBOARD ALARM
SELECT(?PAUSE_FIELD) ! AND STAY ON PAUSE FIELD
.
*LOOKUPS************************************************************************
UPDATE !UPDATE RECORD KEYS
@ACCESSFIELD = @FIELD !MOVE RELATED KEY FIELDS
GET(@FILENAME,@ACCESSKEY) !READ THE RECORD
IF ERROR() THEN CLEAR(@PRE:RECORD). !IF NOT FOUND, CLEAR RECORD
@SCRFIELD = @LOOKUPFIELD !DISPLAY LOOKUP FIELD
*LOOKUPSCROLL*******************************************************************
@ACCESSFIELD = @FIELD !MOVE RELATED KEY FIELDS
GET(@FILENAME,@ACCESSKEY) !READ THE RECORD
IF ERROR() THEN CLEAR(@PRE:RECORD). !IF NOT FOUND, CLEAR RECORD
@SCRFIELD = @LOOKUPFIELD !DISPLAY LOOKUP FIELD
*OPENFILES**********************************************************************
OPEN(@FILENAME) !OPEN THE FILE
@CREATEFILE !IF NOT FOUND, THEN CREATE
*CREATEFILE*********************************************************************
IF ERRORCODE() = 2 THEN CREATE(@FILENAME). !IF NOT FOUND, THEN CREATE
*SAVEITEMS**********************************************************************
GROUP,PRE(SAV)
@BREAKFIELDS
@SELECTFIELDS
.
*INITBREAK**********************************************************************
@SAVEFIELD = @FIELD !SAVE BREAK FIELD
*INITSELECTS********************************************************************
@SAVEFIELD = @FIELD !SAVE SELECTOR FIELD
*RESTSELECTS********************************************************************
@FIELD = @SAVEFIELD !RESTORE SELECTOR FIELD
*CHECKBREAK*********************************************************************
IF @FIELD <> @SAVEFIELD THEN BREAK. !BREAK ON NEW GROUP
*SORTTABLE**********************************************************************
SORT(TABLE,@COMPONENT) !SORT TABLE INTO KEY SEQUENCE
*CHECKSELECT********************************************************************
IF @FIELD <> @SAVEFIELD THEN BREAK. !BREAK ON END OF SELECTION
*CHECKADD***********************************************************************
IF @FIELD <> @SAVEFIELD THEN EXIT. !EXIT ON END OF SELECTION
*CHECKHOT***********************************************************************
IF KEYCODE() = @HOTKEY !ON HOT KEY
@HOTPROC ! CALL HOT KEY PROCEDURE
SELECT(?) ! DO SAME FIELD AGAIN
CYCLE ! AND LOOP AGAIN
.
*TABLEHOT***********************************************************************
IF KEYCODE() = @HOTKEY !ON HOT KEY
IF FIELD() = ?POINT THEN DO GET_RECORD. ! READ RECORD IF NEEDED
@HOTPROC ! CALL HOT KEY PROCEDURE
DO SAME_PAGE ! RESET TO SAME PAGE
DO SHOW_TABLE ! DISPLAY A PAGE OF RECORDS
CYCLE ! AND LOOP AGAIN
.
*BUILDTABLE*********************************************************************
PTR = 1
NDX = 1
DO BUILD_TABLE !BUILD MEMORY TABLE OK KEYS
********************************************************************************