Media Share 9

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

/ Media Share 9 / MEDIASHARE_09.ISO / clarion / brokcode.zip / STDARROW.MDL < prev next >

Wrap

Text File | 1989-10-16 | 54KB | 1,330 lines

*GLOBAL***** STDARROW MODEL VERSION 2009 ************************************** OMIT('##-END-##') This model will allow arrows to be added to both the TABLE and SELTABLE routines. This is done with two implicit variables up_arrow" and down_arrow". ##-END-## 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 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 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 @CONDITIONAL !DISPLAY CONDITIONAL 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************************************************************************** ! This model is a copy of the standard model with changes being annotated with ! a !*!. This procedure will place arrows in the table corresponding to data ! either above or below the view screen. To get arrows in your table, add a ! calculated field on the top and bottom of the table at least two spaces ! from any scrolling data. Use calculated fields and refer to up_arrow" ! and down_arrow". @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 @SAVETOTALS 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 @TOTALCALC !BUILD TABLE TOTAL FIELDS IF ACTION = 4 !IF THIS IS A LOOKUP REQUEST ! DO FIND_RECORD ! POSITION FILE ! GET(@FILENAME,POINTER#) ! REFRESH CURRENT RECORD 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 GET(@FILENAME,POINTER#) !*!v! AND REFRESH CURRENT RECORD DO SHOW_TABLE !*!^! FILL SCROLL AREA 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 !----- !*! ARROW INSERT SAVE#=POINTER(@KEYNAME) !*! " SET(@KEYNAME) !*! " PREVIOUS(@FILENAME) !*! " END#=POINTER(@KEYNAME) !*! " SET(@KEYNAME,SAVE#) !*! " NEXT(@FILENAME) !*! " !----- !*! ARROW INSERT @TOTSHOW !DISPLAY TOTAL AMOUNT ON SCREEN @LOOKUPS !DISPLAY FROM OTHER FILES @SHOW !DISPLAY STRING VARIABLES @COMPUTE !DISPLAY COMPUTED FIELDS @CONDITIONAL !DISPLAY CONDITIONAL 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 @AUTONUMKEY ! AUTO INCREMENT KEY FIELD @UPDATE ! CALL FORM FOR FIRST RECORD IF ~RECORDS(@KEYNAME) THEN BREAK. ! IF ADD ABORTED THEN EXIT DO SHOW_RECORD ! PERFORM ALL CALCULATIONS @TOTPLUS ! UPDATE TOTAL FIELDS 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 ! PERFORM LOCATOR LOGIC CASE KEYCODE() ! PROCESS THE KEYSTROKE OF INS_KEY !INSERT KEY CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA ACTION = 1 ! SET ACTION TO ADD @AUTONUMKEY ! AUTO INCREMENT KEY FIELD @TOTCHECK ! SAVE TOTAL FIELD AMOUNT @UPDATE ! CALL FORM FOR NEW RECORD @AUTONUMESC ! RECORD NOT ADDED 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 @TOTCHECK ! SAVE TOTAL FIELD AMOUNT @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 SET(@KEYNAME,@KEYNAME) ! SET TO CHANGED RECORD SKIP(@FILENAME,-ndx) ! MAKE IT THE TOP ITEM DO SHOW_TABLE ! AND DISPLAY THAT PAGE . OF DEL_KEY !DELETE KEY DO GET_RECORD ! READ THE SELECTED RECORD ACTION = 3 ! SET ACTION TO DELETE @TOTSAVE ! SAVE TOTAL FIELD AMOUNT @UPDATE ! CALL FORM TO DELETE RECORD IF ~ACTION ! IF RECORD WAS DELETED @TOTMINUS ! SUBTRACT FROM TOTAL FLDS 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 SKIP(@FILENAME,-COUNT+1) !*! ARROW INSERT DO SHOW_TABLE !*! ARROW INSERT . 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 SKIP(@FILENAME,-1) !*! ARROW INSERT DO SHOW_TABLE !*! ARROW INSERT 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 DOWN_ARROW"=' ' !*! SKIP(@FILENAME,-COUNT) ! AND BACK UP ONE PAGE ELSE ! OTHERWISE NEXT(@FILENAME) !*! IF POINTER(@KEYNAME)=END# OR EOF(@FILENAME) !*! DOWN_ARROW"=' ' !*! ELSE !*! DOWN_ARROW"='' !*! . !*! PREVIOUS(@FILENAME) !*! SKIP(@FILENAME,-(COUNT-1)) ! SET RECORD FOR THIS PAGE . !*! NEXT(@FILENAME) !*! IF POINTER(@KEYNAME)=1 OR BOF(@FILENAME) !*! UP_ARROW"=' ' !*! ELSE !*! UP_ARROW"='' !*! . !*! PREVIOUS(@FILENAME) !*! 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# !POINT TO CORRECT RECORD NDX# = NDX ! @DOTOTALS !*! . . 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 @CONDITIONALSCRL ! DISPLAY CONDITIONAL FIELDS @RESULTSCROLL ! ASSIGN RESULT 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 @COMPUTETOTS !CALCULATE TOTAL FIELDS *SELTABLE*********************************************************************** ! See table header for explanation of changes. @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 @SAVETOTALS 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 @TOTSHOW @LOOKUPS !DISPLAY FROM OTHER FILES @SHOW !DISPLAY STRING VARIABLES @COMPUTE !DISPLAY COMPUTED FIELDS @CONDITIONAL ! 2008 @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 @AUTONUMKEY ! 2008 @TOTCHECK @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 @TOTSAVE @UPDATE ! CALL FORM TO CHANGE RECORD IF ~ACTION ! IF THE RECORD WAS CHANGED @TOTMINUS 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 @AUTONUMKEY ! 2008 @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 . @TOTSAVE ACTION = 3 ! SET ACTION TO DELETE @UPDATE ! CALL FORM TO DELETE RECORD IF ~ACTION ! IF RECORD WAS DELETED @TOTMINUS 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 PTR += 1 ! SET TO THE NEXT ENTRY TBLPTR = -1 !*! DO SHOW_TABLE !*! . OF UP_KEY !UP ARROW KEY IF PTR > 1 ! IF THERE IS A PRIOR RECORD PTR -= 1 ! SET TO PRIOR RECORD TBLPTR = -1 DO SHOW_TABLE . 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 PGUP_KEY !PAGE UP KEY IF PTR = 1 THEN NDX = 1. ! ON FIRST PAGE POINT TO TOP PTR -= ROWS ! OTHERWISE BACK UP 1 PAGE IF PTR < 1 !*! PTR = 1 !*! NDX = 1 !*! . !*! TBLPTR = -1 ! NOT SET TO A RECORD DO SHOW_TABLE ! AND DISPLAY IT 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 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 CLEAR(@PRE:RECORD) ! 2008 @TOTCLEAR @RESTSELECTS ! 2008 @READTABLE ! UPDATE ! 2008 ! @RESULT ! 2008 @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 . SETHUE(BACKHUE(ROW,COL),BACKHUE(ROW,COL)) !TURN OFF DISPLAY DO SHOW_LINE ! CALC SCROLLING LINE FIELDS @TOTPLUS ! ADD TO TOTALS SETHUE() 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 DOWN_ARROW"=' ' !*! PTR = RECORDS(TABLE)-COUNT+1 ! SET TO THE LAST RECORD ELSE !*! IF (COUNT+PTR-1) = RECORDS(TABLE) !*! DOWN_ARROW"=' ' !*! ELSE !*! DOWN_ARROW"='' !*! . . !*! IF PTR < 1 THEN PTR = 1. ! AND BACK UP ONE PAGE IF PTR=1 !*! UP_ARROW"=' ' !*! ELSE !*! UP_ARROW"='' . !*! 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 @CONDITIONALSCRL ! 2008 @RESULTSCROLL ! 2008 . . SHOW_LINE ROUTINE !DISPLAY SCROLLING LINE @LOOKUPSCROLL ! DISPLAY FROM OTHER FILES @SHOWSCROLL ! DISPLAY STRING VARIABLES @COMPUTESCROLL ! DISPLAY COMPUTED FIELDS @CONDITIONALSCRL ! DISPLAY CONDITIONAL FIELDS @RESULTSCROLL ! ASSIGN RESULT 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 @COMPUTETOTS *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 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 @CONDITIONAL !DISPLAY CONDITIONAL 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 @CONDITIONAL !DISPLAY CONDITIONAL 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 CLEAR(@PRE:RECORD) !MAKE SURE RECORD CLEARED @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 @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 @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 @PAGEHEADER ! DO PAGE HEADER COMPUTES @PAGEEJECT ! GO TO NEW PAGE DO NEXT_RECORD ! GET NEXT RECORD @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 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 . LOOP UNTIL NOT KEYBOARD() !LOOK FOR KEYSTROKE ASK IF KEYCODE() = REJECT_KEY THEN RETURN. !ABORT REPORT . @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 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 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 ! 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 . *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*********************************************************************** 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 . SETHUE !TURN OFF COLOR *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 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 . *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 !SAVE LOOKUP FIELD @FIELD = @ACCESSFIELD !MOVE LOOKUP FIELD DISPLAY(?@FIELD) !AND DISPLAY IT 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 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 . *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********************************************************************** 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 . . *CREATEFILE********************************************************************* OF 2 !IF NOT FOUND, CREATE(@FILENAME) ! CREATE *SAVEITEMS********************************************************************** GROUP,PRE(SAV) @BREAKFIELDS @SELECTFIELDS . *SAVETOTALS********************************************************************* TOT_GROUP GROUP,PRE(TOT) !TABLE TOTAL FIELDS @TOTALFIELDS . *TOTALCALC********************************************************************** BUFFER(@FILENAME,.25) !USE 1/4TH OF MEMORY FOR BUFFER @TOTCLEAR !ZERO TOTALS SET(@FILENAME) !READ DATA RECORD SEQUENCE SETHUE(BACKHUE(ROW,COL),BACKHUE(ROW,COL)) !TURN OFF DISPAY LOOP UNTIL EOF(@FILENAME) !LOOP UNTIL END OF FILE NEXT(@FILENAME) ! READ A RECORD DO SHOW_RECORD ! DO COMPUTEDS, CONDS, & LKUPS @TOTPLUS ! ADD IT TO TOTAL AMOUNT . SETHUE() !TURN OFF SETHUE FREE(@FILENAME) !FREE MEMORY USED FOR BUFFERING *DOTOTALS*********************************************************************** IF ACTN# THEN DO COMP_TOTALS. !CALCULATE TABLE TOTALS *COMPUTETOTS******************************************************************** COMP_TOTALS ROUTINE !CALCULATE TOTAL FIELDS CASE ACTN# !CHECK FOR ADD,REV,DEL OF INS_KEY !ADD NEW AMOUNT TO TOTAL @TOTPLUS OF ENTER_KEY !REVISE TOTAL AMOUNT @TOTCHANGE . ACTN# = '' *TOTCHECK*********************************************************************** ACTN# = KEYCODE() !SAVE ACTION FOR COMP_TOTALS @TOTSAVE *TOTCLEAR*********************************************************************** CLEAR(TOT_GROUP) !ZERO TOTALS @TOTCLEARIMPL !ZERO AVERAGE CALC IMPLICITS *TOTESC************************************************************************* ACTN# = '' !RESET ACTN *INITBREAK********************************************************************** @SAVEFIELD = @FIELD !SAVE BREAK FIELD *INITSELECTS******************************************************************** @SAVEFIELD = @FIELD !SAVE SELECTOR FIELD *RESTSELECTS******************************************************************** @FIELD = @SAVEFIELD !RESTORE SELECTOR FIELD *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 !START AT TABLE ENTRY NDX = 1 !PUT SELECTOR BAR ON TOP ITEM DO BUILD_TABLE !BUILD MEMORY TABLE OK KEYS *AUTONUMKEY********************************************************************* DO GET_RECORD !READ CURRENT SCREEN RECORD SAVPTR# = POINTER(@FILENAME) ! AND SAVE POSITION SET(@KEYNAME) !SET TO HIGHEST KEY VALUE PREVIOUS(@FILENAME) !READ LAST KEY RECORD KEYFIELD# = @INCFIELD + 1 !INCREMENT FIELD CLEAR(@PRE:RECORD) !CLEAR LAST KEY RECORD @INCFIELD = KEYFIELD# !LOAD KEY FIELD *AUTONUMESC********************************************************************* IF ACTION !FORM WAS NOT COMPLETED @TOTESC !CLEAR TOTAL FIELD CALCULATIONS POINTER# = SAVPTR# !SET POINTER TO PROPER REC GET(@FILENAME,POINTER#) !READ RECORD SET(@KEYNAME,@KEYNAME) !POSITION FILE SKIP(@FILENAME,-1) !BACK UP ONE DO SHOW_TABLE !RE-DISPLAY PAGE . *AUTONUMSEL********************************************************************* GET(TABLE,RECORDS(TABLE)) !READ HIGHEST KEY VALUE IF ERROR() THEN CLEAR(TABLE). !ZERO FIELDS IF EMPTY TABLE @RESTSELECTS !LOAD PRIOR KEY FIELDS @INCFIELD = @TABLEFIELD + 1 !LOAD INCREMENT FIELD *CONDITIONAL******************************************************************** IF @IFCOND !EVALUATE CONDITION @IFCONDTRUE ! CONDITION IS TRUE ELSE !OTHERWISE @IFCONDFALSE ! CONDITION IS FALSE . *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 *RUNCODE************************************************************************ G_RUNPROC('@RUNDESC') !RUN DOS PROGRAM *FIRSTBREAK********************************************************************* BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG DO PRT_BRK_HDRS !PRINT GROUP HEADER(S) *CHECKBREAK********************************************************************* DO CHECK_BREAK ! CHECK FOR GROUP BREAK *LASTBREAK********************************************************************** BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG DO PRT_BRK_FTRS !PRINT GROUP FOOTER(S) *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 *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 . *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 . *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 . *PAGEEJECT********************************************************************** MEM:LINE = 0 ! SET FOR CALL TO CHECK_PAGE DO CHECK_PAGE ! INITIALIZE PAGE VARIABLES PRINT(PAGE_FOOT) ! PRINT PAGE FOOTER PRINT(PAGE_HEAD) ! PRINT PAGE HEADER ********************************************************************************