home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Media Share 9
/
MEDIASHARE_09.ISO
/
clarion
/
brokcode.zip
/
KW33CORR.EXE
/
DYNAMIC.MDL
next >
Wrap
Text File
|
1991-07-16
|
58KB
|
1,449 lines
*GLOBAL*************************************************************************
INCLUDE('\clabeta\STD_KEYS.CLA')
INCLUDE('\clabeta\CTL_KEYS.CLA')
INCLUDE('\clabeta\ALT_KEYS.CLA')
INCLUDE('\clabeta\SHF_KEYS.CLA')
REJECT_KEY EQUATE(CTRL_ESC)
ACCEPT_KEY EQUATE(CTRL_ENTER)
TRUE EQUATE(1)
FALSE EQUATE(0)
MAP
PROC(G_OPENFILES)
@RUNMAP
@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
HELP(@HELPFILE) !OPEN THE HELP FILE
G_OPENFILES !OPEN OR CREATE FILES
SETHUE() ! THE SCREEN
@BASEPROC !CALL THE BASE PROCEDURE
RETURN !EXIT TO DOS
G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR
CODE
@OPENFILES !OPEN EACH FILE
BLANK !BLANK THE SCREEN
@RUNPROC
*MENU***************************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
ENTRY,USE(?PRE_MENU)
MENU,USE(MENU_FIELD"),REQ
@CHOICES
. .
EJECT
CODE
OPEN(SCREEN) !OPEN THE MENU SCREEN
SETCURSOR !TURN OFF ANY CURSOR
MENU_FIELD" = '' !START MENU WITH FIRST ITEM
@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
IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
UPDATE ! MOVE ALL FIELDS FROM SCREEN
SELECT(?) ! START WITH CURRENT FIELD
SELECT ! EDIT ALL FIELDS
CYCLE ! GO TO TOP OF LOOP
. !
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 ?PRE_MENU !PRE MENU FIELD CONDITION
IF KEYCODE() = ESC_KEY ! BACKING UP?
SELECT(?-1) ! SELECT PREVIOUS FIELD
ELSE ! GOING FORWARD
SELECT(?+1) ! SELECT MENU FIELD
.
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
ENTRY,USE(?PRE_POINT)
REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX)
@PLOC POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1)
@SCROLLVARIABLES
. .
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
FOUND BYTE !RECORD FOUND FLAG
NEWPTR LONG !POINTER TO NEW RECORD
TABLE TABLE,PRE(TBL) !TABLE OF RECORD DATA
@TABLEFIELDS ! SCREEN AND KEY COMPONENTS
PTR LONG ! POINTER TO FILE RECORD
.
@SAVEITEMS !SELECTOR FIELD SAVE AREA
@SAVETOTALS !TOTAL FIELD ACCUMULATORS
EJECT
CODE
ACTION# = ACTION !SAVE ACTION
OPEN(SCREEN) !OPEN THE SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
@INITSELECTS !SAVE SELECTOR FIELDS
@TOTCLEAR !ZERO TOTAL ACCUMULATORS
TBL: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
CACHE(@KEYNAME,.25) !CACHE KEY FILE
@BUILDTABLE !BUILD SCROLLING TABLE
LOOP !LOOP UNTIL USER EXITS
ACTION = ACTION# !RESTORE ACTION
@RESTSELECTS !RESTORE SELECTOR FIELDS
@TOTSHOW !DISPLAY TOTAL AMOUNTS ON SCRN
@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 KEYS
ACCEPT !READ A FIELD
!KW DELETE MEM:MESSAGE
@TABLEHOT !CALL HOT KEY PROCEDURES
IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY
IF KEYCODE() = ACCEPT_KEY | !ON SCREEN ACCEPT KEY
AND FIELD() <> ?POINT !BUT NOT ON THE POINT FIELD
UPDATE ! MOVE ALL FIELDS FROM SCREEN
SELECT(?) ! START WITH CURRENT FIELD
SELECT ! EDIT ALL FIELDS
CYCLE ! GO TO TOP OF LOOP
.
CASE FIELD() !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY | ! RETURN ON ESC KEY
OR RECORDS# = FALSE ! OR NO RECORDS
BREAK ! EXIT PROGRAM
.
@EDITS !FIELD EDIT ROUTINES
OF ?PRE_POINT !PRE POINT FIELD CONDITION
IF KEYCODE() = ESC_KEY ! BACKING UP?
SELECT(?-1) ! SELECT PREVIOUS FIELD
ELSE ! GOING FORWARD
SELECT(?POINT) ! SELECT MENU FIELD
.
@INITLOCATE ! SHOW CURSOR FOR LOCATOR
OF ?POINT !PROCESS THE POINT FIELD
IF RECORDS(TABLE) = 0 !IF THERE ARE NO RECORDS
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
ACTION = 1 ! SET ACTION TO ADD
GET(@FILENAME,0) ! CLEAR PENDING RECORD
@AUTONUMKEY ! AUTO INCREMENT KEY FIELD
@TOTACTN ! SAVE TOTACTN
@RESTSELECTS ! RESTORE SELECTOR FIELDS
@UPDATE ! CALL FORM FOR NEW RECORD
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD
DO FIRST_PAGE ! DISPLAY THE FIRST PAGE
IF RECORDS(TABLE) = 0 ! IF THERE AREN'T ANY RECORDS
RECORDS# = FALSE ! INDICATE NO RECORDS
SELECT(?PRE_POINT-1) ! SELECT THE PRIOR FIELD
.
CYCLE ! AND LOOP AGAIN
.
@LOCATE !PERORM LOCATOR LOGIC
CASE KEYCODE() !PROCESS THE KEYSTROKE
OF INS_KEY !INS KEY
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
ACTION = 1 ! SET ACTION TO ADD
GET(@FILENAME,0) ! CLEAR PENDING RECORD
@AUTONUMKEY ! AUTO INCREMENT KEY FIELD
@TOTACTN ! SAVE TOTALS
@RESTSELECTS ! RESTORE SELECTOR FIELDS
@UPDATE ! CALL FORM FOR NEW RECORD
IF ~ACTION ! IF RECORD WAS ADDED
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD
DO FIND_RECORD ! POSITION IN FILE
.
OF ENTER_KEY !ENTER KEY
OROF ACCEPT_KEY !CTRL-ENTER KEY
DO GET_RECORD ! GET THE SELECTED RECORD
IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST
ACTION = 0 ! SET ACTION TO COMPLETE
BREAK ! AND RETURN TO CALLER
.
IF ~ERROR() ! IF RECORD IS STILL THERE
ACTION = 2 ! SET ACTION TO CHANGE
@TOTCHECK ! SAVE TOTALS
@UPDATE ! CALL FORM TO CHANGE REC
IF ACTION THEN CYCLE. ! IF SUCCESSFUL RE-DISPLAY
@TOTMINUS ! SUBTRACT CURRENT AMOUNTS
.
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD
DO FIND_RECORD ! POSITION IN FILE
OF DEL_KEY !DEL KEY
DO GET_RECORD ! READ THE SELECTED RECORD
IF ~ERROR() ! IF RECORD IS STILL THERE
ACTION = 3 ! SET ACTION TO DELETE
@TOTCHECK ! SAVE TOTALS
@UPDATE ! CALL FORM TO DELETE
IF ~ACTION ! IF SUCCESSFUL
@TOTMINUS ! SUBTRACT CURRENT AMOUNTS
N# = NDX ! SAVE POINT INDEX
DO SAME_PAGE ! RE-DISPLAY
NDX = N# ! RESTORE POINT INDEX
. .
OF DOWN_KEY !DOWN ARROW KEY
DO SET_NEXT ! POINT TO NEXT RECORD
DO FILL_NEXT ! FILL A TABLE ENTRY
IF FOUND ! FOUND A NEW RECORD
SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP
GET(TABLE,RECORDS(TABLE)) ! GET RECORD FROM TABLE
DO FILL_SCREEN ! DISPLAY ON SCREEN
.
OF PGDN_KEY !PAGE DOWN KEY
DO SET_NEXT ! POINT TO NEXT RECORD
DO NEXT_PAGE ! DISPLAY THE NEXT PAGE
OF CTRL_PGDN !CTRL-PAGE DOWN KEY
DO LAST_PAGE ! DISPLAY THE LAST PAGE
NDX = RECORDS(TABLE) ! POSITION POINT BAR
OF UP_KEY !UP ARROW KEY
DO SET_PREV ! POINT TO PREVIOUS RECORD
DO FILL_PREV ! FILL A TABLE ENTRY
IF FOUND ! FOUND A NEW RECORD
SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN
GET(TABLE,1) ! GET RECORD FROM TABLE
DO FILL_SCREEN ! DISPLAY ON SCREEN
.
OF PGUP_KEY !PAGE UP KEY
DO SET_PREV ! POINT TO PREVIOUS RECORD
DO PREV_PAGE ! DISPLAY THE PREVIOUS PAGE
OF CTRL_PGUP !CTRL-PAGE UP
DO FIRST_PAGE ! DISPLAY THE FIRST PAGE
NDX = 1 ! POSITION POINT BAR
. . .
FREE(TABLE) !FREE MEMORY TABLE
RETURN !AND RETURN TO CALLER
SAME_PAGE ROUTINE !DISPLAY THE SAME PAGE
GET(TABLE,1) ! GET THE FIRST TABLE ENTRY
DO FILL_RECORD ! FILL IN THE RECORD
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE
FREE(TABLE) ! EMPTY THE TABLE
DO NEXT_PAGE ! DISPLAY A FULL PAGE
FIRST_PAGE ROUTINE !DISPLAY FIRST PAGE
BLANK(ROW,COL,ROWS,COLS)
FREE(TABLE) ! EMPTY THE TABLE
CLEAR(@PRE:RECORD,-1) ! CLEAR RECORD TO LOW VALUES
CLEAR(TBL:PTR) ! ZERO RECORD POINTER
@SETFILE ! POSITION FILE POINTERS
LOOP NDX = 1 TO COUNT ! FILL UP THE TABLE
DO FILL_NEXT ! FILL A TABLE ENTRY
IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD
.
NDX = 1 ! SET TO TOP OF TABLE
DO SHOW_PAGE ! DISPLAY THE PAGE
LAST_PAGE ROUTINE !DISPLAY LAST PAGE
NDX# = NDX ! SAVE SELECTOR POSITION KW
BLANK(ROW,COL,ROWS,COLS) ! CLEAR SCROLLING AREA
FREE(TABLE) ! EMPTY THE TABLE
CLEAR(@PRE:RECORD,1) ! CLEAR RECORD TO HIGH VALUES
CLEAR(TBL:PTR,1) ! CLEAR PTR TO HIGH VALUE
@SETFILE ! POSITION FILE POINTERS
LOOP NDX = COUNT TO 1 BY -1 ! FILL UP THE TABLE
DO FILL_PREV ! FILL A TABLE ENTRY
IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD
. ! END OF LOOP
NDX = NDX# ! RESTORE SELECTOR POSITION KW
DO SHOW_PAGE ! DISPLAY THE PAGE
FIND_RECORD ROUTINE !POSITION TO SPECIFIC RECORD
SET(@KEYNAME,@KEYNAME,NEWPTR) !POSITION FILE
IF NEWPTR = 0 !NEWPTR NOT SET
NEXT(@FILENAME) ! READ NEXT RECORD
NEWPTR = POINTER(@FILENAME) ! SET NEWPTR
SKIP(@FILENAME,-1) ! BACK UP TO DISPLAY RECORD
.
FREE(TABLE) ! CLEAR THE RECORD
DO NEXT_PAGE ! DISPLAY A PAGE
NEXT_PAGE ROUTINE !DISPLAY NEXT PAGE
SAVECNT# = RECORDS(TABLE) ! SAVE RECORD COUNT
LOOP COUNT TIMES ! FILL UP THE TABLE
DO FILL_NEXT ! FILL A TABLE ENTRY
IF NOT FOUND ! IF NONE ARE LEFT
IF NOT SAVECNT# ! IF REBUILDING TABLE
DO LAST_PAGE ! FILL IN RECORDS
EXIT ! EXIT OUT OF ROUTINE
.
BREAK ! EXIT LOOP
. .
DO SHOW_PAGE ! DISPLAY THE PAGE
SET_NEXT ROUTINE !POINT TO THE NEXT PAGE
GET(TABLE,RECORDS(TABLE)) ! GET THE LAST TABLE ENTRY
DO FILL_RECORD ! FILL IN THE RECORD
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE KW
NEXT(@FILENAME) ! READ THE CURRENT RECORD KW
FILL_NEXT ROUTINE !FILL NEXT TABLE ENTRY
FOUND = FALSE ! ASSUME RECORD NOT FOUND
LOOP UNTIL EOF(@FILENAME) ! LOOP UNTIL END OF FILE
NEXT(@FILENAME) ! READ THE NEXT RECORD
@CHECKSELECT ! SELECTOR
IF ~(@FILTER) THEN CYCLE. ! FILTER
FOUND = TRUE ! SET RECORD FOUND
DO FILL_TABLE ! FILL IN THE TABLE ENTRY
ADD(TABLE) ! ADD LAST TABLE ENTRY
GET(TABLE,RECORDS(TABLE)-COUNT) ! GET ANY OVERFLOW RECORD
DELETE(TABLE) ! AND DELETE IT
EXIT ! RETURN TO CALLER
.
PREV_PAGE ROUTINE !DISPLAY PREVIOUS PAGE
LOOP COUNT TIMES ! FILL UP THE TABLE
DO FILL_PREV ! FILL A TABLE ENTRY
IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD
.
DO SHOW_PAGE ! DISPLAY THE PAGE
SET_PREV ROUTINE !POINT TO PREVIOUS PAGE
GET(TABLE,1) ! GET THE FIRST TABLE ENTRY
DO FILL_RECORD ! FILL IN THE RECORD
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE KW
PREVIOUS(@FILENAME) ! READ THE CURRENT RECORD KW
FILL_PREV ROUTINE !FILL PREVIOUS TABLE ENTRY
FOUND = FALSE ! ASSUME RECORD NOT FOUND
LOOP UNTIL BOF(@FILENAME) ! LOOP UNTIL BEGINNING OF FILE
PREVIOUS(@FILENAME) ! READ THE PREVIOUS RECORD
@CHECKSELECT ! SELECTOR
IF ~(@FILTER) THEN CYCLE. ! FILTER
FOUND = TRUE ! SET RECORD FOUND
DO FILL_TABLE ! FILL IN THE TABLE ENTRY
ADD(TABLE,1) ! ADD FIRST TABLE ENTRY
GET(TABLE,COUNT+1) ! GET ANY OVERFLOW RECORD
DELETE(TABLE) ! AND DELETE IT
EXIT ! RETURN TO CALLER
.
SHOW_PAGE ROUTINE !DISPLAY THE PAGE
NDX# = NDX ! SAVE SCREEN INDEX
LOOP NDX = 1 TO RECORDS(TABLE) ! LOOP THRU THE TABLE
GET(TABLE,NDX) ! GET A TABLE ENTRY
DO FILL_SCREEN ! AND DISPLAY IT
IF TBL:PTR = NEWPTR ! SET INDEX FOR NEW RECORD
NDX# = NDX ! POINT TO CORRECT RECORD
@DOTOTALS ! CALCULATE TOTAL FIELDS
. .
NDX = NDX# ! RESTORE SCREEN INDEX
NEWPTR = 0 ! CLEAR NEW RECORD POINTER
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
FILL_TABLE ROUTINE !MOVE FILE TO TABLE
@LOOKUPSCROLL ! PERFORM LOOKUPS KW MOVED UP
@FILLTABLE ! LOAD TABLE FIELDS
TBL:PTR = POINTER(@FILENAME) ! SAVE RECORD POINTER
@COMPUTESCROLL ! DO COMPUTES AND CONDITIONALS
@RESULTSCROLL ! MOVE RESULT FIELDS
FILL_RECORD ROUTINE !MOVE TABLE TO FILE
@FILLRECORD ! LOAD FILE KEYS
FILL_SCREEN ROUTINE !MOVE TABLE TO SCREEN
@FILLSCREEN ! DISPLAY SCREEN VARIABLES
GET_RECORD ROUTINE !GET SELECTED RECORD
GET(TABLE,NDX) ! GET TABLE ENTRY
GET(@FILENAME,TBL:PTR) ! GET THE RECORD
@COMPUTETOTS !CALCULATE TOTAL FIELDS
*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
LOOP !LOOP THRU ALL THE FIELDS
MEM:MESSAGE = CENTER(MEM:MESSAGE,SIZE(MEM:MESSAGE)) !DISPLAY ACTION MESSAGE
DO CALCFIELDS !CALCULATE DISPLAY FIELDS
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 MESSAGE
MEM:MESSAGE = 'Record will be Added' !
MEM:MESSAGE = 'Record will be Changed' !
MEM:MESSAGE = 'Press Enter to Delete' !
.
IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
UPDATE ! MOVE ALL FIELDS FROM SCREEN
SELECT(?) ! START WITH CURRENT FIELD
SELECT ! EDIT ALL FIELDS
CYCLE ! GO TO TOP OF LOOP
.
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 ERRORCODE() = 40 ! DUPLICATE KEY ERROR KW
MEM:MESSAGE = ERROR() ! DISPLAY ERR MESSAGE KW
SELECT(2) ! POSITION TO TOP OF FORM KW
CYCLE ! GET OUT OF EDIT LOOP KW
ELSIF ERROR() ! CHECK FOR UNEXPECTED ERROR KW
STOP(ERROR()) ! HALT EXECUTION KW
. ! KW
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
. . .
CALCFIELDS ROUTINE
IF FIELD() > ?FIRST_FIELD !BEYOND FIRST_FIELD?
IF KEYCODE() = 0 AND SELECTED() > FIELD() THEN EXIT. !GET OUT IF NOT NONSTOP
.
@LOOKUPS !DISPLAY FROM OTHER FILES
@SHOW !DISPLAY STRING VARIABLES
@COMPUTE !DISPLAY COMPUTED FIELDS
@RESULT !MOVE RESULTING VALUES
*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
IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
UPDATE ! MOVE ALL FIELDS FROM SCREEN
SELECT(?) ! START WITH CURRENT FIELD
SELECT ! EDIT ALL FIELDS
CYCLE ! GO TO TOP OF LOOP
. !
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
CLEAR(@PRE:RECORD,-1) !MAKE SURE RECORD CLEARED KW
@RESTSELECTS !RESTORE SELECTOR CRITERIA
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
CLOSE(TITLE) !CLOSE TITLE REPORT
@SETRPTFILE !SET TO FIRST RECORD
DO NEXT_RECORD !READ FIRST RECORD
@PAGEHEADER !DO PAGE HEADER COMPUTES
@PAGEFOOTER !DO PAGE FOOTER COMPUTES
@APPENDON !APPEND REPORT TO TITLE
OPEN(REPORT) !OPEN THE REPORT
@FIRSTBREAK !PRINT INITIAL BREAK HEADERS
LOOP UNTIL DONE# !READ ALL RECORDS IN FILE
SAVE_LINE# = MEM:LINE ! SAVE LINE NUMBER
LAST_REC# = POINTER(@FILENAME)
@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
DO NEXT_RECORD ! GET NEXT RECORD
@PAGEHEADER ! DO PAGE HEADER COMPUTES
@PAGEEJECTDTL ! GO TO NEW PAGE
@CHECKBREAK ! CHECK FOR BREAK
. !
@LASTBREAK ! PRINT ENDING BREAK FOOTERS
@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
@APPENDOFF !TURN OFF REPORT APPEND
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
SAVE_LINE# = MEM:LINE ! RESET LINE NUMBER
@INITPAGE ! INIT PAGE VARIABLES
.
LOOP UNTIL NOT KEYBOARD() !LOOK FOR KEYSTROKE
ASK !GET KEYCODE
IF KEYCODE() = REJECT_KEY !ON CTRL-ESC
@APPENDOFF ! TURN OFF REPORT APPENDING KW
CLOSE(REPORT) ! CLOSE REPORT
RETURN ! ABORT PRINT
. .
@BREAKRTN !CHECK FOR GROUP BREAK
*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
@MEMMEMO !PRINT ANY MEMO FILES
CLOSE(TITLE) !CLOSE TITLE REPORT
@PAGEFOOTER !DO PAGE FOOTER COMPUTES
@PAGEHEADER !DO PAGE HEADER COMPUTES
@APPENDON !APPEND REPORT TO TITLE
OPEN(REPORT) !OPEN REPORT BODY
@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
@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
@APPENDOFF !TURN OFF REPORT APPEND
RETURN !RETURN TO CALLER
*ALERT**************************************************************************
ALERT(@HOTKEY) !ALERT HOT KEY
*APPENDON***********************************************************************
APPEND# = FALSE !TURN OFF APPEND FLAG
IF SUB(MEM:DEVICE,1,1) <> '+' !NOT ALREADY APPENDING REPORTS
MEM:DEVICE = '+' & MEM:DEVICE ! APPEND DISK RPT TO TITLE
APPEND# = TRUE ! SET FLAG TO TURN OFF APPEND
.
*APPENDOFF**********************************************************************
IF APPEND# !IF REPORT WAS APPENDED
MEM:DEVICE = SUB(MEM:DEVICE,2,LEN(MEM:DEVICE)-1)!TURN OFF APPEND REPORT
.
*AUTONUMKEY*********************************************************************
CLEAR(@PRE:RECORD,1) !CLEAR RECORD TO HIGH VALUES
@SETFILE !SET TO HIGHEST KEY VALUE
PREVIOUS(@FILENAME) !READ LAST KEY RECORD
IF ERROR() !IF THERE WAS AN ERROR KW
CLEAR(@PRE:RECORD) ! CLEAR THE RECORD KW
KEYFIELD# = @LOWER ! INTITIALIZE THE FIELD KW
IF KEYFIELD# = 0 THEN KEYFIELD# = 1. ! IF ITS 0 MAKE IT 1 KW
@CHECKSELAUTO ! CHECK SELECTOR AND KW
ELSE !ELSE KW
KEYFIELD# = @INCFIELD + 1 ! INCREMENT FIELD KW
. ! KW
CLEAR(@PRE:RECORD) !CLEAR LAST KEY RECORD
@RESTSELECTS !LOAD PRIOR KEY FIELDS
@INCFIELD = KEYFIELD# !LOAD KEY FIELD
*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
IF ACTION !NO SELECTION WAS MADE
SELECT(?@FIELD-1) ! BACK UP ONE FIELD
ACTION = ACTION# ! RESTORE ACTION
CYCLE ! GO TO TOP OF LOOP
.
@LOOKFIELD = @ACCESSFIELD !DISPLAY LOOKUP FIELD
@FIELD = @ACCESSFIELD !MOVE LOOKUP FIELD
DISPLAY(?@FIELD) !AND DISPLAY IT
ACTION = ACTION# !RESTORE ACTION
*BREAKFOOTER********************************************************************
IF BRK_FLAG# <= @BRKNUM !CHECK BREAK LEVEL
@GRPFOOTER ! DO FOOTER COMPUTES
PRINT(GRP_FOOT@BRKNUM) ! PRINT GROUP FOOTER
@PRINTMEMO ! PRINT ANY MEMO FIELD
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
@PAGEEJECT ! GO TO NEW PAGE
.
*BREAKHEADER********************************************************************
IF BRK_FLAG# <= @BRKNUM !CHECK BREAK LEVEL
@INITGROUP ! INIT GROUP VARIABLES
@GRPHEADER ! DO HEADER COMPUTES
PRINT(GRP_HEAD@BRKNUM) ! PRINT GROUP HEADER
@PRINTMEMO ! PRINT ANY MEMO FIELD
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
.
*BREAKRTN***********************************************************************
CHECK_BREAK ROUTINE !CHECK FOR GROUP BREAK
@COMPAREBREAK !GENERATE IF STATEMENTS
PRT_BRK_HDRS ROUTINE !DO GROUP HEADERS
@BREAKHEADER !PRINT HEADERS
@INITBREAK !INITIALIZE BREAK FIELDS
PRT_BRK_FTRS ROUTINE !DO GROUP FOOTERS
GET(@FILENAME,LAST_REC#) !REREAD PREVIOUS RECORD
@BREAKFOOTER !PRINT FOOTERS
SKIP(@FILENAME,-1) !BACKUP ONE RECORD
NEXT(@FILENAME) !AND REREAD IT
*BUILDTABLE*********************************************************************
@TOTALCALC !CALC TABLE TOTAL FIELDS
IF ACTION = 4 ! TABLE LOOKUP REQUEST
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO RECORD
IF NOT NEWPTR ! RECORD NOT PASSED TO TABLE
SET(@KEYNAME,@KEYNAME) ! POSITION TO CLOSEST RECORD
NEXT(@FILENAME) ! READ RECORD
NEWPTR = POINTER(@FILENAME) ! SET POINTER
.
DO FIND_RECORD ! POSITION FILE
ELSE
NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM
DO FIRST_PAGE ! BUILD MEMORY TABLE OF KEYS
.
RECORDS# = TRUE ! ASSUME THERE ARE RECORDS
*CHECKBREAK*********************************************************************
IF NOT DONE# THEN DO CHECK_BREAK. ! CHECK FOR GROUP BREAK
*CHECKHOT***********************************************************************
IF KEYCODE() = @HOTKEY !ON HOT KEY
UPDATE(?) ! RETRIEVE FIELD
SAVACTN# = ACTION ! SAVE ACTION KW
@HOTPROC ! CALL HOT KEY PROCEDURE
ACTION = SAVACTN# ! RESTORE ACTION KW
SELECT(?) ! DO SAME FIELD AGAIN
CYCLE ! AND LOOP AGAIN
.
*CHECKSELAUTO*******************************************************************
ELSIF @FIELD <> @SAVEFIELD !NO SELECTOR MATCHES KW
CLEAR(@PRE:RECORD) ! CLEAR THE RECORD KW
KEYFIELD# = @LOWER ! AND INITIALIZE THE FIELD KW
IF KEYFIELD# = 0 THEN KEYFIELD# = 1. ! IF ITS 0 MAKE IT 1 KW
*CHECKSELECT********************************************************************
IF @FIELD <> @SAVEFIELD !IF END OF SELECTION KW
@FIELD = @SAVEFIELD ! RESTORE THE SELECTOR KW
BREAK ! AND BREAK KW
. !kw
*COMPAREBREAK*******************************************************************
IF @FIELD <> @SAVEFIELD !BREAK ON NEW GROUP
BRK_FLAG# = @BRKNUM !SET BREAK LEVEL
DO PRT_BRK_FTRS !PRINT FOOTERS FOR THIS LEVEL
DO PRT_BRK_HDRS !PRINT HEADERS FOR THIS LEVEL
EXIT !RETURN TO REPORT
.
*COMPUTETOTS********************************************************************
COMP_TOTALS ROUTINE !CALCULATE TOTAL FIELDS
IF NOT ACTN# THEN EXIT. !GET OUT IF ACTN NOT SET
@TOTPLUS !ADD TO TOTALS
ACTN# = 0 !CLEAR ACTION
*CONDITIONAL********************************************************************
IF @IFCOND !EVALUATE CONDITION
@IFCONDTRUE ! CONDITION IS TRUE
ELSE !OTHERWISE
@IFCONDFALSE ! CONDITION IS FALSE
.
*CREATEFILE*********************************************************************
OF 2 !IF NOT FOUND,
CREATE(@FILENAME) ! CREATE
*DOTOTALS***********************************************************************
DO COMP_TOTALS !CALCULATE TABLE TOTALS
*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
IF ACTION ! NO SELECTION WAS MADE
SELECT(?@FIELD) ! STAY ON FIELD
ACTION = ACTION# ! RESTORE ACTION
CYCLE ! GO TO TOP OF LOOP
.
@FIELD = @ACCESSFIELD ! MOVE LOOKUP FIELD
DISPLAY(?@FIELD) ! AND DISPLAY IT
ACTION = ACTION# ! RESTORE ACTION
.
*FIRSTBREAK*********************************************************************
BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG
DO PRT_BRK_HDRS !PRINT GROUP HEADER(S)
*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
IF ACTION ! NO SELECTION WAS MADE
SELECT(?@FIELD) ! BACK UP ONE FIELD
ACTION = ACTION# ! RESTORE ACTION
CYCLE ! GO TO TOP OF LOOP
.
@FIELD = @ACCESSFIELD ! MOVE LOOKUP FIELD
DISPLAY(?@FIELD) ! AND DISPLAY IT
ACTION = ACTION# ! RESTORE ACTION
.
*INITBREAK**********************************************************************
@SAVEFIELD = @FIELD !SAVE BREAK FIELD
*INITLOCATE*********************************************************************
IF KEYCODE() = ESC_KEY ! BACKING UP?
SCR:LOCATOR = '' ! CLEAR LOCATOR
SETCURSOR ! AND TURN CURSOR OFF
ELSE ! GOING FORWARD
LEN# = 0 ! RESET TO START OF LOCATOR
SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)) ! AND TURN CURSOR ON
.
*INITSELECTS********************************************************************
@SAVEFIELD = @FIELD !SAVE SELECTOR FIELD
*INRANGE************************************************************************
IF ~INRANGE(@FIELD,@LOWER,@UPPER) !IF FIELD IS OUT OF RANGE
BEEP ! SOUND KEYBOARD ALARM
SELECT(?@FIELD) ! AND STAY ON THIS FIELD
CYCLE ! GO TO TOP OF LOOP
.
*LASTBREAK**********************************************************************
BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG
DO PRT_BRK_FTRS !PRINT GROUP FOOTER(S)
*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 !ON A LOCATOR REQUEST
@RESTSELECTS ! --SET SELECTOR COMPONENTS--
@SETLOCATE
SET(@KEYNAME,@KEYNAME) ! POINT TO NEW RECORD
NEXT(@FILENAME) ! READ A RECORD
IF (EOF(@FILENAME) AND ERROR()) ! IF EOF IS REACHED
SET(@KEYNAME) ! SET TO FIRST RECORD
PREVIOUS(@FILENAME) ! READ THE LAST RECORD
.
NEWPTR = POINTER(@FILENAME) ! SET NEW RECORD POINTER
SKIP(@FILENAME,-1) ! BACK UP TO FIRST RECORD
FREE(TABLE) ! CLEAR THE TABLE
DO NEXT_PAGE ! AND DISPLAY A NEW PAGE
.
*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
*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
.
*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
*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
CYCLE ! AND LOOP AGAIN
. .
*NOTREQUIRED********************************************************************
IF @FIELD = '' !IF NOT REQUIRED THEN
@EDITPROC ! CALL THE EDIT PROCEDURE
CYCLE ! END THE EDIT
.
*OPENFILES**********************************************************************
SHOW(25,1,CENTER('OPENING FILE: ' & '@FILENAME',80)) !DISPLAY FILE NAME
OPEN(@FILENAME) !OPEN THE FILE
IF ERROR() !OPEN RETURNED AN ERROR
CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR
OF 46 ! KEYS NEED TO BE REQUILT
SETHUE(0,7) ! BLACK ON WHITE
SHOW(25,1,CENTER('REBUILDING KEY FILES FOR @FILENAME',80)) !INDICATE MSG
BUILD(@FILENAME) ! CALL THE BUILD PROCEDURE
SETHUE(7,0) ! WHITE ON BLACK
BLANK(25,1,1,80) ! BLANK THE MESSAGE
@CREATEFILE ! IF NOT FOUND, THEN CREATE
ELSE ! ANY OTHER ERROR
LOOP;STOP('@FILENAME: ' & ERROR()). ! STOP EXECUTION
. .
*PAGEEJECT**********************************************************************
MEM:LINE = 0 ! SET FOR CALL TO CHECK_PAGE
DO CHECK_PAGE ! INITIALIZE PAGE VARIABLES
IF NOT DONE# ! MORE ITEMS TO PRINT
PRINT(PAGE_FOOT) ! PRINT PAGE FOOTER
PRINT(PAGE_HEAD) ! PRINT PAGE HEADER
.
*PAUSE**************************************************************************
OF ?PAUSE_FIELD !ON PAUSE FIELD
IF KEYCODE() <> ENTER_KEY | !IF NOT ENTER KEY
AND KEYCODE() <> ACCEPT_KEY | !AND NOT CTRL-ENTER KEY
AND KEYCODE() <> 0 !AND NOT NONSTOP MODE
BEEP ! SOUND KEYBOARD ALARM
SELECT(?PAUSE_FIELD) ! AND STAY ON PAUSE FIELD
.
*PICLOCATE**********************************************************************
@LOCFIELD = DEFORMAT(SCR:LOCATOR) ! UPDATE THE KEY FIELD
*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 ! ALL MEMOS PRINTED
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
BREAK ! EXIT MEMO PRINT LOOP
. !
@PRTDETAIL ! AND PRINT IT
J# += 1 ! INCREMENT COUNTER
DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED
.
*PRTDETAIL**********************************************************************
PRINT(@MEMDETAIL) !PRINT THE DETAIL RECORD
*REQUIRED***********************************************************************
IF @FIELD = '' !IF REQUIRED FIELD IS EMPTY
BEEP ! SOUND KEYBOARD ALARM
SELECT(?@FIELD) ! AND STAY ON THIS FIELD
CYCLE !
.
*RESTSELECTS********************************************************************
@FIELD = @SAVEFIELD !RESTORE SELECTOR FIELD
*RUNCODE************************************************************************
G_RUNPROC('@RUNDESC') !RUN DOS PROGRAM
*RUNMAP*************************************************************************
PROC(G_RUNPROC) !GLOBAL MODULE RUN PROCEDURE
*RUNPROC************************************************************************
G_RUNPROC PROCEDURE(DOSPROG) !GLOBAL RUN PROCEDURE
DOSPROG STRING(12) !PROGRAM TO RUN
SCREEN SCREEN WINDOW(25,80),HUE(7,0,0). !SAVE WINDOW
CODE
OPEN(SCREEN) !SAVE CURRENT SCREEN
SETCURSOR(25,1) !POSITION CURSOR AT BOTTOM
RUN(DOSPROG) !RUN DOS PROGRAM
CLOSE(SCREEN) !RESTORE SCREEN
RETURN !EXIT BACK TO CALLING MENU
*SAVEITEMS**********************************************************************
GROUP,PRE(SAV)
@BREAKFIELDS
@SELECTFIELDS
.
*SAVETOTALS*********************************************************************
TOT_GROUP GROUP,PRE(TOT) !TABLE TOTAL FIELDS
@TOTALFIELDS
.
*SETKEY*************************************************************************
SET(@KEYNAME) ! POINT TO FIRST RECORD
*SETKEYKEY**********************************************************************
@RESTSELECTS !--SET SELECTOR COMPONENTS
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POINT PAST LAST RECORD
*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
*SETRECORD**********************************************************************
BUFFER(@FILENAME,.25)
SET(@FILENAME) ! POINT TO FIRST RECORD
*SETSELECT**********************************************************************
SET(@KEYNAME,@KEYNAME) !SET TO FIRST SELECTED RECORD
*SETTOP*************************************************************************
SET(@KEYNAME) !SET TO FIRST RECORD
*SHOWMEMO***********************************************************************
R# = ROW(@SCRMEMO) !SAVE ROW OF MEMO
C# = COL(@SCRMEMO) !SAVE COL OF MEMO
SETHUE(FOREHUE(R#,C#),BACKHUE(R#,C#)) !RETRIEVE COLOR OF MEMO
LOOP I# = 1 TO @MEMOROWS !DISPLAY MEMO FIELD BY ROWS
SHOW(R#+I#-1,C#,@MEMOROW[I#],@S@MEMOCOLS)!SHOW NEXT ROW KW
.
SETHUE !TURN OFF COLOR
*STRLOCATE**********************************************************************
@LOCFIELD = CLIP(SCR:LOCATOR) ! UPDATE THE KEY FIELD
*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
CYCLE ! AND LOOP AGAIN
.
*TODO***************************************************************************
@PROCNAME PROCEDURE !THIS PROCEDURE IS NOT DEFINED
CODE !
ACTION = 0 !SET ACTION TO 0 KW
RETURN !RETURN TO CALLER
*TOTACTN************************************************************************
ACTN# = ACTION !SAVE ACTION FOR COMP_TOTALS
*TOTALCALC**********************************************************************
@TOTCLEAR !ZERO TOTALS
CLEAR(@PRE:RECORD,-1) !CLEAR RECORD TO LOW VALUES
CLEAR(TBL:PTR) !SET POINTER TO ZERO
SETHUE(BACKHUE(ROW,COL),BACKHUE(ROW,COL)) !TURN OFF DISPLAY
@SETFILETOT !READ DATA RECORD SEQUENCE
LOOP UNTIL EOF(@FILENAME) !LOOP UNTIL END OF FILE
NEXT(@FILENAME) ! READ A RECORD
@CHECKSELECT ! SELECTOR MATCH?
IF ~(@FILTER) THEN CYCLE. ! FILTER MATCH?
ACTN# = 1 !SET ACTION FOR ADD
DO FILL_TABLE ! TOTAL SCREEN VARIABLES
DO COMP_TOTALS ! ADD TO TOTAL AMOUNT
.
SETHUE() !TURN OFF SETHUE
FREE(@FILENAME) !FREE MEMORY USED FOR BUFFERING
FREE(TABLE) !FREE MEMORY TABLE
*TOTCHECK***********************************************************************
@TOTACTN !SAVE ACTION
@TOTSAVE !SAVE EXISTING VALUES
*TOTCLEAR***********************************************************************
CLEAR(TOT_GROUP) !ZERO TOTALS
@TOTCLEARIMPL !ZERO AVERAGE CALC IMPLICITS
*UNIQUEKEY**********************************************************************
IF DUPLICATE(@ACCESSKEY) ! CHECK FOR DUPLICATE KEY
MEM:MESSAGE = 'CREATES DUPLICATE ENTRY' ! MOVE AN ERROR MESSAGE
SELECT(?@FIELD) ! STAY ON THE SAME FIELD
BEEP ! SOUND THE KEYBOARD ALARM
CYCLE ! AND LOOP AGAIN
.
*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
.
********************************************************************************
*DYNTABLE**************************************************************************
@PROCNAME PROCEDURE
SCREEN SCREEN PRE(SCR),@SCREENOPT
@PAINTS
@STRINGS
@VARIABLES
ENTRY,USE(?FIRST_FIELD)
@FIELDS
ENTRY,USE(?PRE_POINT)
REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX)
@PLOC POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1)
@SCROLLVARIABLES
. .
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
FOUND BYTE !RECORD FOUND FLAG
NEWPTR LONG !POINTER TO NEW RECORD
TABLE TABLE,PRE(TBL) !TABLE OF RECORD DATA
@TABLEFIELDS ! SCREEN AND KEY COMPONENTS
PTR LONG ! POINTER TO FILE RECORD
.
@SAVEITEMS !SELECTOR FIELD SAVE AREA
@SAVETOTALS !TOTAL FIELD ACCUMULATORS
EJECT
CODE
ACTION# = ACTION !SAVE ACTION
OPEN(SCREEN) !OPEN THE SCREEN
SETCURSOR !TURN OFF ANY CURSOR
@SETUP !CALL SETUP PROCEDURE
@INITSELECTS !SAVE SELECTOR FIELDS
@TOTCLEAR !ZERO TOTAL ACCUMULATORS
TBL: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
CACHE(@KEYNAME,.25) !CACHE KEY FILE
@BUILDTABLE !BUILD SCROLLING TABLE
LOOP !LOOP UNTIL USER EXITS
ACTION = ACTION# !RESTORE ACTION
@RESTSELECTS !RESTORE SELECTOR FIELDS
@TOTSHOW !DISPLAY TOTAL AMOUNTS ON SCRN
@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(DOWN_KEY) !ALERT DOWN ARROW
ALERT(UP_KEY) !ALERT UP ARROW
ALERT(HOME_KEY) !ALERT HOME KEY
ALERT(END_KEY) !ALERT END KEY
ALERT(TAB_KEY) !ALERT TAB KEY
ALERT(SHFT_TAB) !ALERT SHIFT TAB KEY
ALERT(LEFT_KEY) !ALERT LEFT KEY
ALERT(RIGHT_KEY) !ALERT RIGHT KEY
@ALERT !ALERT HOT KEYS
ACCEPT !READ A FIELD
@TABLEHOT !CALL HOT KEY PROCEDURES
IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY
IF KEYCODE() = ACCEPT_KEY | !ON SCREEN ACCEPT KEY
AND FIELD() <> ?POINT !BUT NOT ON THE POINT FIELD
UPDATE ! MOVE ALL FIELDS FROM SCREEN
SELECT(?) ! START WITH CURRENT FIELD
SELECT ! EDIT ALL FIELDS
CYCLE ! GO TO TOP OF LOOP
.
CASE FIELD() !JUMP TO FIELD EDIT ROUTINE
OF ?FIRST_FIELD !FROM THE FIRST FIELD
IF KEYCODE() = ESC_KEY | ! RETURN ON ESC KEY
OR RECORDS# = FALSE ! OR NO RECORDS
BREAK ! EXIT PROGRAM
.
@EDITS !FIELD EDIT ROUTINES
OF ?PRE_POINT !PRE POINT FIELD CONDITION
IF KEYCODE() = ESC_KEY ! BACKING UP?
SELECT(?-1) ! SELECT PREVIOUS FIELD
CLEAR(@PRE:RECORD) ! CLEAR DATA ****
ELSE ! GOING FORWARD
SELECT(?POINT) ! SELECT MENU FIELD
.
@INITLOCATE ! SHOW CURSOR FOR LOCATOR
OF ?POINT !PROCESS THE POINT FIELD
IF RECORDS(TABLE) = 0 !IF THERE ARE NO RECORDS
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
ACTION = 1 ! SET ACTION TO ADD
GET(@FILENAME,0) ! CLEAR PENDING RECORD
@AUTONUMKEY ! AUTO INCREMENT KEY FIELD
@TOTACTN ! SAVE TOTACTN
@RESTSELECTS ! RESTORE SELECTOR FIELDS
@UPDATE ! CALL FORM FOR NEW RECORD
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD
DO FIRST_PAGE ! DISPLAY THE FIRST PAGE
IF RECORDS(TABLE) = 0 ! IF THERE AREN'T ANY RECORDS
RECORDS# = FALSE ! INDICATE NO RECORDS
SELECT(?PRE_POINT-1) ! SELECT THE PRIOR FIELD
.
CYCLE ! AND LOOP AGAIN
.
@LOCATE !PERORM LOCATOR LOGIC
CASE KEYCODE() !PROCESS THE KEYSTROKE
OF INS_KEY !INS KEY
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
ACTION = 1 ! SET ACTION TO ADD
GET(@FILENAME,0) ! CLEAR PENDING RECORD
@AUTONUMKEY ! AUTO INCREMENT KEY FIELD
@TOTACTN ! SAVE TOTALS
@RESTSELECTS ! RESTORE SELECTOR FIELDS
@UPDATE ! CALL FORM FOR NEW RECORD
IF ~ACTION ! IF RECORD WAS ADDED
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD
DO FIND_RECORD ! POSITION IN FILE
.
OF ENTER_KEY !ENTER KEY
OROF ACCEPT_KEY !CTRL-ENTER KEY
DO GET_RECORD ! GET THE SELECTED RECORD
IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST
ACTION = 0 ! SET ACTION TO COMPLETE
BREAK ! AND RETURN TO CALLER
.
IF ~ERROR() ! IF RECORD IS STILL THERE
ACTION = 2 ! SET ACTION TO CHANGE
@TOTCHECK ! SAVE TOTALS
@UPDATE ! CALL FORM TO CHANGE REC
IF ACTION THEN CYCLE. ! IF SUCCESSFUL RE-DISPLAY
@TOTMINUS ! SUBTRACT CURRENT AMOUNTS
.
NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD
DO FIND_RECORD ! POSITION IN FILE
OF DEL_KEY !DEL KEY
DO GET_RECORD ! READ THE SELECTED RECORD
IF ~ERROR() ! IF RECORD IS STILL THERE
ACTION = 3 ! SET ACTION TO DELETE
@TOTCHECK ! SAVE TOTALS
@UPDATE ! CALL FORM TO DELETE
IF ~ACTION ! IF SUCCESSFUL
@TOTMINUS ! SUBTRACT CURRENT AMOUNTS
N# = NDX ! SAVE POINT INDEX
DO SAME_PAGE ! RE-DISPLAY
NDX = N# ! RESTORE POINT INDEX
. .
OF DOWN_KEY !DOWN ARROW KEY
IF NDX = RECORDS(TABLE) !IF AT BOTTOM OF SCREEN
DO SET_NEXT ! POINT TO NEXT RECORD
DO FILL_NEXT ! FILL A TABLE ENTRY
IF FOUND ! FOUND A NEW RECORD
SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP
GET(TABLE,RECORDS(TABLE)) ! GET RECORD FROM TABLE
DO FILL_SCREEN ! DISPLAY ON SCREEN
.
ELSE !ELSE NOT AT BOTTOM
NDX += 1 ! MOVE CURSOR DOWN 1 LINE
.
OF PGDN_KEY !PAGE DOWN KEY
DO SET_NEXT ! POINT TO NEXT RECORD
DO NEXT_PAGE ! DISPLAY THE NEXT PAGE
OF CTRL_PGDN !CTRL-PAGE DOWN KEY
DO LAST_PAGE ! DISPLAY THE LAST PAGE
NDX = RECORDS(TABLE) ! POSITION POINT BAR
OF UP_KEY !UP ARROW KEY
!IF AT TOP OF SCREEN, SCROLL AS NORMAL
IF NDX = 1 !IF AT TOP OF SCREEN
DO SET_PREV ! POINT TO PREVIOUS RECORD
DO FILL_PREV ! FILL A TABLE ENTRY
IF FOUND ! FOUND A NEW RECORD
SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN
GET(TABLE,1) ! GET RECORD FROM TABLE
DO FILL_SCREEN ! DISPLAY ON SCREEN
.
ELSE ! IF NOT AT TOP OF SCREEN
NDX -= 1 ! MOVE CURSOR UP 1 LINE
.
OF PGUP_KEY !PAGE UP KEY
DO SET_PREV ! POINT TO PREVIOUS RECORD
DO PREV_PAGE ! DISPLAY THE PREVIOUS PAGE
OF CTRL_PGUP !CTRL-PAGE UP
DO FIRST_PAGE ! DISPLAY THE FIRST PAGE
NDX = 1 ! POSITION POINT BAR
!***** !**********
OF HOME_KEY !HOME KEY
NDX = 1 ! LIGHT BAR TO TOP LINE
OF END_KEY !END KEY
NDX = RECORDS(TABLE) ! LIGHT BAR TO BOTTOM LINE
OF TAB_KEY !TAB KEY OR
OROF RIGHT_KEY !RIGHT ARROW KEY
IF NDX < RECORDS(TABLE) THEN NDX += 1. !MOVE LIGHT BAR DOWN 1 LINE
! NO SCROLL OR SCREEN WRAP
OF SHFT_TAB !SHIFT TAB OR
OROF LEFT_KEY !LEFT ARROW KEY
IF NDX = 1 ! IF AT TOP OF SCREEN
NDX = RECORDS(TABLE) ! WRAP TO BOTTOM LINE
ELSE ! ELSE
NDX -= 1 ! MOVE LIGHT BAR UP 1 LINE
.
.
DO GET_RECORD ! GET RECORD FOR ANNOTATION
. .
FREE(TABLE) !FREE MEMORY TABLE
RETURN !AND RETURN TO CALLER
SAME_PAGE ROUTINE !DISPLAY THE SAME PAGE
GET(TABLE,1) ! GET THE FIRST TABLE ENTRY
DO FILL_RECORD ! FILL IN THE RECORD
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE
FREE(TABLE) ! EMPTY THE TABLE
DO NEXT_PAGE ! DISPLAY A FULL PAGE
FIRST_PAGE ROUTINE !DISPLAY FIRST PAGE
BLANK(ROW,COL,ROWS,COLS)
FREE(TABLE) ! EMPTY THE TABLE
CLEAR(@PRE:RECORD,-1) ! CLEAR RECORD TO LOW VALUES
CLEAR(TBL:PTR) ! ZERO RECORD POINTER
@SETFILE ! POSITION FILE POINTERS
LOOP NDX = 1 TO COUNT ! FILL UP THE TABLE
DO FILL_NEXT ! FILL A TABLE ENTRY
IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD
.
NDX = 1 ! SET TO TOP OF TABLE
DO SHOW_PAGE ! DISPLAY THE PAGE
DO GET_RECORD ! GET RECORD FOR FIRST DISPLAY
LAST_PAGE ROUTINE !DISPLAY LAST PAGE
NDX# = NDX ! SAVE SELECTOR POSITION KW
BLANK(ROW,COL,ROWS,COLS) ! CLEAR SCROLLING AREA
FREE(TABLE) ! EMPTY THE TABLE
CLEAR(@PRE:RECORD,1) ! CLEAR RECORD TO HIGH VALUES
CLEAR(TBL:PTR,1) ! CLEAR PTR TO HIGH VALUE
@SETFILE ! POSITION FILE POINTERS
LOOP NDX = COUNT TO 1 BY -1 ! FILL UP THE TABLE
DO FILL_PREV ! FILL A TABLE ENTRY
IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD
. ! END OF LOOP
NDX = NDX# ! RESTORE SELECTOR POSITION KW
DO SHOW_PAGE ! DISPLAY THE PAGE
FIND_RECORD ROUTINE !POSITION TO SPECIFIC RECORD
SET(@KEYNAME,@KEYNAME,NEWPTR) !POSITION FILE
IF NEWPTR = 0 !NEWPTR NOT SET
NEXT(@FILENAME) ! READ NEXT RECORD
NEWPTR = POINTER(@FILENAME) ! SET NEWPTR
SKIP(@FILENAME,-1) ! BACK UP TO DISPLAY RECORD
.
FREE(TABLE) ! CLEAR THE RECORD
DO NEXT_PAGE ! DISPLAY A PAGE
NEXT_PAGE ROUTINE !DISPLAY NEXT PAGE
SAVECNT# = RECORDS(TABLE) ! SAVE RECORD COUNT
LOOP COUNT TIMES ! FILL UP THE TABLE
DO FILL_NEXT ! FILL A TABLE ENTRY
IF NOT FOUND ! IF NONE ARE LEFT
IF NOT SAVECNT# ! IF REBUILDING TABLE
DO LAST_PAGE ! FILL IN RECORDS
EXIT ! EXIT OUT OF ROUTINE
.
BREAK ! EXIT LOOP
. .
DO SHOW_PAGE ! DISPLAY THE PAGE
SET_NEXT ROUTINE !POINT TO THE NEXT PAGE
GET(TABLE,RECORDS(TABLE)) ! GET THE LAST TABLE ENTRY
DO FILL_RECORD ! FILL IN THE RECORD
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE KW
NEXT(@FILENAME) ! READ THE CURRENT RECORD KW
FILL_NEXT ROUTINE !FILL NEXT TABLE ENTRY
FOUND = FALSE ! ASSUME RECORD NOT FOUND
LOOP UNTIL EOF(@FILENAME) ! LOOP UNTIL END OF FILE
NEXT(@FILENAME) ! READ THE NEXT RECORD
@CHECKSELECT ! SELECTOR
IF ~(@FILTER) THEN CYCLE. ! FILTER
FOUND = TRUE ! SET RECORD FOUND
DO FILL_TABLE ! FILL IN THE TABLE ENTRY
ADD(TABLE) ! ADD LAST TABLE ENTRY
GET(TABLE,RECORDS(TABLE)-COUNT) ! GET ANY OVERFLOW RECORD
DELETE(TABLE) ! AND DELETE IT
EXIT ! RETURN TO CALLER
.
PREV_PAGE ROUTINE !DISPLAY PREVIOUS PAGE
LOOP COUNT TIMES ! FILL UP THE TABLE
DO FILL_PREV ! FILL A TABLE ENTRY
IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD
.
DO SHOW_PAGE ! DISPLAY THE PAGE
SET_PREV ROUTINE !POINT TO PREVIOUS PAGE
GET(TABLE,1) ! GET THE FIRST TABLE ENTRY
DO FILL_RECORD ! FILL IN THE RECORD
SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE KW
PREVIOUS(@FILENAME) ! READ THE CURRENT RECORD KW
FILL_PREV ROUTINE !FILL PREVIOUS TABLE ENTRY
FOUND = FALSE ! ASSUME RECORD NOT FOUND
LOOP UNTIL BOF(@FILENAME) ! LOOP UNTIL BEGINNING OF FILE
PREVIOUS(@FILENAME) ! READ THE PREVIOUS RECORD
@CHECKSELECT ! SELECTOR
IF ~(@FILTER) THEN CYCLE. ! FILTER
FOUND = TRUE ! SET RECORD FOUND
DO FILL_TABLE ! FILL IN THE TABLE ENTRY
ADD(TABLE,1) ! ADD FIRST TABLE ENTRY
GET(TABLE,COUNT+1) ! GET ANY OVERFLOW RECORD
DELETE(TABLE) ! AND DELETE IT
EXIT ! RETURN TO CALLER
.
SHOW_PAGE ROUTINE !DISPLAY THE PAGE
NDX# = NDX ! SAVE SCREEN INDEX
LOOP NDX = 1 TO RECORDS(TABLE) ! LOOP THRU THE TABLE
GET(TABLE,NDX) ! GET A TABLE ENTRY
DO FILL_SCREEN ! AND DISPLAY IT
IF TBL:PTR = NEWPTR ! SET INDEX FOR NEW RECORD
NDX# = NDX ! POINT TO CORRECT RECORD
@DOTOTALS ! CALCULATE TOTAL FIELDS
. .
NDX = NDX# ! RESTORE SCREEN INDEX
NEWPTR = 0 ! CLEAR NEW RECORD POINTER
CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA
FILL_TABLE ROUTINE !MOVE FILE TO TABLE
@LOOKUPSCROLL ! PERFORM LOOKUPS KW MOVED UP
@FILLTABLE ! LOAD TABLE FIELDS
TBL:PTR = POINTER(@FILENAME) ! SAVE RECORD POINTER
@COMPUTESCROLL ! DO COMPUTES AND CONDITIONALS
@RESULTSCROLL ! MOVE RESULT FIELDS
FILL_RECORD ROUTINE !MOVE TABLE TO FILE
@FILLRECORD ! LOAD FILE KEYS
FILL_SCREEN ROUTINE !MOVE TABLE TO SCREEN
@FILLSCREEN ! DISPLAY SCREEN VARIABLES
GET_RECORD ROUTINE !GET SELECTED RECORD
GET(TABLE,NDX) ! GET TABLE ENTRY
GET(@FILENAME,TBL:PTR) ! GET THE RECORD
@COMPUTETOTS !CALCULATE TOTAL FIELDS