Shareware Overload

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Overload / ShartewareOverload.cdr / busi / office1.zip / PERSONAL.MDL < prev next >

Wrap

Text File | 1988-10-05 | 42KB | 1,040 lines

*GLOBAL************************************************************************* INCLUDE('STD_KEYS.CLA') INCLUDE('CTL_KEYS.CLA') INCLUDE('ALT_KEYS.CLA') INCLUDE('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 . . 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 !ON SCREEN ACCEPT KEY 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 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 ! 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 . @LOCATE . . . 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 SKIP(@FILENAME,-NDX) ! 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 !ON SCREEN ACCEPT KEY 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 . 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 ! 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 . @LOCATE . . . ! 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 DO NEXT_RECORD !READ FIRST RECORD 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 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 @PAGEHEADER ! DO PAGE HEADER COMPUTES @PAGEFOOTER ! DO PAGE FOOTER COMPUTES 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 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 @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 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 = @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 DO SAME_PAGE ! RESET TO SAME PAGE @HOTPROC ! CALL HOT KEY PROCEDURE 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 ********************************************************************************