Media Share 9

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

/ Media Share 9 / MEDIASHARE_09.ISO / clarion / pswmodel.zip / PASSWORD.MDL < prev next >

Wrap

Text File | 1990-02-18 | 65KB | 1,663 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 PROC(G_OPENFILES) ! OPEN FILES FUNC(CHECK_PASS),LONG ! CHECK PASSWORD @RUNMAP @MODULES . EJECT('FILE LAYOUTS') @FILE PASSWORD FILE,PRE(PAS),CREATE,RECLAIM OWNER('MASTER'),ENCRYPT BY_OPERATOR KEY(PAS:OPERATOR_ID),NOCASE,OPT RECORD RECORD OPERATOR_ID STRING(5) PASSWORD STRING(20) LEVEL DECIMAL(2,0) . . EJECT('GLOBAL MEMORY VARIABLES') CLEARANCE LONG ! SECURITY CLEARANCE SAVE_CLEAR LONG ! TEMP HOLDING VARIABLE ! FOR CLEARANCE ON ENTRY ! AND EXIT OF PROCEDURES ACTION SHORT !0 = NO ACTION !1 = ADD RECORD !2 = CHANGE RECORD !3 = DELETE RECORD !4 = LOOKUP FIELD !5 = AUTONUMKEY ADD @MEMORY EJECT('CODE SECTION') GET_PASS SCREEN WINDOW(25,80),PRE(SCR),HLP('GETPASS'),HUE(7,0) ROW(10,20) PAINT(6,42),HUE(15,1) ROW(1,1) REPEAT(9);STRING('▒{80}') . ROW(10,1) STRING('▒{19}<0{42}>▒{19}') ROW(11,1) REPEAT(5);STRING('▒{19}<0{42}>░▒{18}') . ROW(16,1) STRING('▒{21}░{41}▒{18}') ROW(17,1) REPEAT(9);STRING('▒{80}') . ROW(10,20) STRING('╔═{40}╗') ROW(11,20) REPEAT(4);STRING('║<0{40}>║') . ROW(15,20) STRING('╚═{40}╝') ROW(13,22) STRING('Password:'),HUE(11,1) MSG ROW(11,31) STRING(20),HUE(31,1) ROW(12,22) STRING('Operator ID:'),HUE(11,1) COL(35) ENTRY(@S5),USE(OP_ID),HUE(14,1),SEL(0,7),OVR,LFT,UPR . OP_ID STRING(5) PW STRING(20) KEYPRESS STRING(1) CODE SETHUE(7,0) !SET WHITE ON BLACK BLANK ! AND BLANK HELP(@HELPFILE) !OPEN THE HELP FILE RECOVER(60) !HOLDS TIMEOUT IN 60 SECONDS G_OPENFILES !OPEN OR CREATE FILES SETHUE() ! THE SCREEN SHARE(PASSWORD) !OPEN PASSWORD FILE OPEN(GET_PASS) !OPEN THE PASSWORD SCREEN SETCURSOR !TURN OFF ANY CURSOR DISPLAY !DISPLAY THE FIELDS LOOP !LOOP THRU ALL THE FIELDS ALERT !RESET ALERTED KEYS ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY ACCEPT !READ A FIELD IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT KEY CASE FIELD() !JUMP TO FIELD EDIT ROUTINE OF ?OP_ID IF OP_ID = '' !IF REQUIRED FIELD IS EMPTY BEEP ! SOUND KEYBOARD ALARM SELECT(?OP_ID) ! AND STAY ON THIS FIELD CYCLE ! . PAS:OPERATOR_ID = OP_ID ! SET UP TO GET PASSWORD GET(PASSWORD,PAS:BY_OPERATOR) IF ERRORCODE() = 35 BEEP BEEP SELECT(?OP_ID) ! RESELECT OPERATOR ID MSG = 'Invalid Operator ID' MSG = CENTER(MSG) CYCLE . COL# = 35 PW = '' ! CLEAR PASSWORD LOOP ! LOOP THROUGH PASSWORD SETCURSOR(13,COL#) ! TURN CURSOR ON AT COLUMN ASK ! GET A KEYSTROKE ! UNTIL ENTER IS PRESSED KEYPRESS = CHR(KEYCODE()) ! STORE THE ASCII CODE ! INTO KEYPRESS VARIABLE IF KEYCODE() = ENTER_KEY OR KEYCODE() = ACCEPT_KEY THEN BREAK. IF KEYCODE() = BS_KEY ! WAS IT A BACKSPACE? IF COL# <> 35 ! IF NOT AT BEGINNING OF FIELD PW = SUB(PW,1,LEN(CLIP(PW)) - 1) ! PROCESS THE BACKSPACE AND COL# -= 1 ! DECREMENT COLUMN NO SHOW(13,COL#,' ') ! BLANK THAT POSITION ELSE BEEP ! IF AT BEGINNING BEEP AND ! IGNORE THE BACKSPACE . ELSE COL# += 1 ! INCREMENT COLUMN NO PW = CLIP(PW) & UPPER(KEYPRESS) ! OTHERWISE ADD THE CHAR ! (CHANGE IT TO UPPER CASE) SHOW(13,COL# - 1,'.') ! SHOW A PERIOD AT THAT ! CHARACTER POSITION . . IF PW = '' !IF REQUIRED FIELD IS EMPTY BEEP ! SOUND KEYBOARD ALARM SELECT(?OP_ID) ! AND SELECT OPERATOR ID CYCLE . IF PW <> UPPER(PAS:PASSWORD) ! DO PASSWORDS MATCH? BEEP BEEP SELECT(?OP_ID) ! RESELECT OPERATOR ID MSG = 'Invalid Password' MSG = CENTER(MSG) COUNT# += 1 ! INCREMENT BAD COUNT IF COUNT# > 4 ! GIVE THEM FOUR TRIES BEEP ! SOUND ALARM BEEP BEEP BEEP BEEP RETURN ! AND EXIT TO DOS . CYCLE . ! NOW SECURITY CLEARANCE LEVEL IS STORED IN PAS:LEVEL. MSG = 'Password Accepted' COUNT# = 0 ! CLEAR COUNTER LOOP 500 TIMES. ! WHOA HORSE... ! GIVE USER TIME TO READ ! MESSAGE BREAK . . CLOSE(PASSWORD) ! CLOSE PASSWORD FILE @BASEPROC !CALL THE BASE PROCEDURE CLOSE(GET_PASS) ! CLOSE PASSWORD SCREEN RETURN !EXIT TO DOS G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR CODE @OPENFILES !OPEN EACH FILE BLANK !BLANK THE SCREEN @RUNPROC CHECK_PASS FUNCTION DENY_ENTRY SCREEN WINDOW(10,53),HUE(7,0) ROW(1,53) PAINT(1,1),TRN ROW(10,1) PAINT(1,2),TRN ROW(1,1) PAINT(9,52),HUE(15,4) COL(1) STRING('╔═{50}╗'),HUE(14,4) ROW(2,1) REPEAT(5);STRING('║<0{50}>║'),HUE(14,4) . ROW(7,1) STRING('╟─{50}╢'),HUE(14,4) ROW(8,1) STRING('║<0{50}>║'),HUE(14,4) ROW(9,1) STRING('╚═{50}╝'),HUE(14,4) ROW(2,53) REPEAT(8);STRING('░') . ROW(10,3) STRING('░{51}') ROW(2,4) STRING('Sorry. You do not have security clearances' | & ' '),HUE(11,4) ROW(3,4) STRING('to this portion of the program.'),HUE(11,4) ROW(5,4) STRING('Please see your supervisor if you have any') | HUE(11,4) ROW(6,4) STRING('questions.'),HUE(11,4) ROW(8,15) PAUSE('Press Enter to continue...'),USE(?PAUSE) . CODE IF CLEARANCE = 0 ! DO THEY NEED SECURITY? RETURN(TRUE) . IF PAS:LEVEL < CLEARANCE ! DO THEY HAVE SECURITY OPEN(DENY_ENTRY) ! CLEARANCE? BEEP;BEEP;BEEP ACCEPT ! WAIT FOR PAUSE FIELD RETURN(FALSE) ! RETURN FALSE . RETURN(TRUE) ! ELSE RETURN TRUE *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 SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . 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 !RETURN ON SCREEN REJECT CLEARANCE = SAVE_CLEAR RETURN . 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 ! RETURN ON ESC KEY CLEARANCE = SAVE_CLEAR RETURN . @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 . . TABLE TABLE !TABLE OF RECORD POINTERS TBLPTR LONG ! POINTER TO DATA RECORD . 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 SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . 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 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 @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 @AUTONUMESC ! DELETE IF FORM NOT COMPLETED 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 FREE(TABLE) ! FREE THE MEMORY TABLE CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE 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 ! DELETE IF FORM NOT COMPLETED 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 ERROR() ! IF RECORD HAS BEEN DELETED MEM:MESSAGE = ERROR() ! TELL USER WHAT HAPPENED SELECT(?) ! STAY IN THE POINT FIELD 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 MEMORY TABLE CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE 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 . OF DEL_KEY !DELETE 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 SHOW_TABLE ! SHOW IT BREAK ! AND GET ANOTHER KEY . 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,-COUNT) ! SET NEXT RECORD ON TOP DO SHOW_TABLE ! AND DISPLAY THAT 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 GET(TABLE,1) ! GET THE TOP POINTER DELETE(TABLE) ! REMOVE TOP ITEM TBLPTR = POINTER(@FILENAME) ! DETERMINE RECORD POINTER ADD(TABLE) ! ADD TO BOTTOM OF TABLE 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 ONE IF NOT BOF(@FILENAME) ! IF THERE IS A PRIOR RECORD PREVIOUS(@FILENAME) ! READ THE TOP RECORD IF NOT ERROR() ! IF RETRIEVED OKAY SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN GET(TABLE,RECORDS(TABLE)) ! GET THE LAST POINTER DELETE(TABLE) ! REMOVE LAST ITEM TBLPTR = POINTER(@FILENAME) ! DETERMINE RECORD POINTER ADD(TABLE,1) ! ADD TO TOP OF TABLE DO SHOW_RECORD ! AND DISPLAY IT ELSIF ERRORCODE() = 33 ! ELSE IF RECORD NOT AVAIL NEXT(@FILENAME) ! RETURN TO FIRST RECORD . . 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 . . . . FREE(TABLE) !FREE THE MEMORY TABLE CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN !RETURN TO CALLER SHOW_TABLE ROUTINE !DISPLAY A PAGE OF RECORDS FREE(TABLE) ! FREE THE MEMORY TABLE 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 TBLPTR = POINTER(@FILENAME) ! GET THE RECORD NUMBER ADD(TABLE) ! ADD IT TO THE TABLE DO SHOW_RECORD ! AND DISPLAY IT IF POINTER(@FILENAME) = POINTER# ! POINT TO CORRECT RECORD NDX# = NDX ! POINT TO CORRECT RECORD @DOTOTALS ! CALCULATE TOTAL FIELDS . . 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 GET(TABLE,NDX) ! GET THE TABLE RECORD GET(@FILENAME,TBLPTR) ! GET THIS RECORD 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 CURRENT RECORD SET(@KEYNAME,@KEYNAME) ! SET TO NEW RECORD AND SKIP(@FILENAME,-1) ! SKIP TO TOP OF SAME PAGE @COMPUTETOTS !CALCULATE TOTAL FIELDS *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 @SAVETOTALS EJECT CODE ACTION# = ACTION !SAVE ACTION OPEN(SCREEN) !OPEN THE SCREEN SETCURSOR !TURN OFF ANY CURSOR SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . @INITSELECTS !SAVE SELECTOR FIELDS @TOTCLEAR !ZERO TOTAL 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 !DISPLAY TOTAL AMOUNTS ON SCRN @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(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 CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE 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 ! AUTO INCREMENT KEY FIELD @TOTCHECK ! SAVE TOTAL FIELD AMOUNT @UPDATE ! CALL FORM FOR FIRST RECORD @AUTONUMESC ! DELETE IF FORM NOT COMPLETED 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 CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN ! RETURN TO CALLER . ACTION = 2 ! SET ACTION TO CHANGE @TOTSAVE ! SAVE TOTAL FIELD AMOUNT @UPDATE ! CALL FORM TO CHANGE RECORD IF ~ACTION ! IF THE RECORD WAS CHANGED @TOTMINUS ! SUBTRACT OLD TOTAL AMOUNT 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 ! AUTO INCREMENT KEY FIELD @UPDATE ! CALL FORM FOR NEW RECORD @AUTONUMESC ! DELETE IF FORM NOT COMPLETED 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 ! SAVE TOTAL FIELD AMOUNT ACTION = 3 ! SET ACTION TO DELETE @UPDATE ! CALL FORM TO DELETE RECORD IF ~ACTION ! IF RECORD WAS DELETED @TOTMINUS ! SUBTRACT FROM TOTAL FLDS 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 !INITIALIZE TO NO 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 !INITIALIZE TO NO 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 -= COUNT ! OTHERWISE BACK UP 1 PAGE TBLPTR = -1 !INITIALIZE TO NO 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 !INITIALIZE TO NO RECORD DO SHOW_TABLE ! AND DISPLAY THE FIRST PAGE . . . . ! FREE(TABLE) !FREE MEMORY TABLE CLEARANCE = SAVE_CLEAR RETURN !AND RETURN TO CALLER BUILD_TABLE ROUTINE !BUILD MEMORY TABLE FREE(TABLE) !EMPTY THE TABLE CLEAR(@PRE:RECORD) !MAKE SURE RECORD CLEARED @TOTCLEAR !ZERO TOTAL FIELDS @RESTSELECTS !RESTORE SELECTOR CRITERIA @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 . @TOTALCALCSEL !CALCULATE TOTAL FIELDS 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 DO SHOW_LINE ! DISPLAY SCROLLING LINE . . 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 !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) . SAVE_RECORD GROUP;BYTE,DIM(SIZE(@PRE:RECORD)). SAVE_MEMO GROUP;BYTE,DIM(SIZE(@MEMO)). EJECT CODE OPEN(SCREEN) !OPEN THE SCREEN SETCURSOR !TURN OFF ANY CURSOR SAVE_RECORD = @PRE:RECORD !SAVE THE ORIGINAL SAVE_MEMO = @MEMO !SAVE THE ORIGINAL IF ACTION = 5 !AUTONUMBER ACTION DISK_ACTN# = 2 ! SET FOR PHYSICAL ACTION ACTION = 1 ! SET FOR LOGICAL ACTION ELSE !OTHERWISE DISK_ACTN# = ACTION ! SET ACTION FOR DISK WRITE . SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . DISPLAY !DISPLAY THE FIELDS EXECUTE DISK_ACTN# !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 . ACTION# = ACTION !STORE REQUIRED ACTION 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 !RETURN ON SCREEN REJECT KEY CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN . EXECUTE ACTION !SET 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 ! RETURN ON ESC KEY CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN . IF ACTION = 3 THEN SELECT(?DELETE_FIELD).! OR CONFIRM FOR DELETE @EDITS !EDIT ROUTINES GO HERE OF ?LAST_FIELD !FROM THE LAST FIELD IF ACTION = 2 OR ACTION = 3 !IF UPDATING RECORD HOLD(@FILENAME) ! HOLD FILE GET(@FILENAME,POINTER#) ! RE-READ SAME RECORD IF ERRORCODE() = 35 ! IF RECORD WAS DELETED IF ACTION = 2 ! IF TRYING TO UPDATE ACTION = 1 ! THEN ADD IT BACK ELSE ! RELEASE(@FILENAME) ! RELEASE FILE ACTION = 0 ! TURN OFF ACTION . ELSIF | ! IF IT HAS BEEN CHANGED @MEMO <> SAVE_MEMO OR | ! @PRE:RECORD <> SAVE_RECORD ! BY ANOTHER STATION MEM:MESSAGE = 'CHANGED BY ANOTHER STATION' !INFORM USER SELECT(2) ! GO BACK TO FIELD 1 BEEP ! SOUND ALARM RELEASE(@FILENAME) ! RELEASE FILE SAVE_RECORD = @PRE:RECORD ! SAVE RECORD SAVE_MEMO = @MEMO ! SAVE MEMO DISPLAY ! DISPLAY THE FIELDS BREAK ! AND CONTINUE . UPDATE !UPDATE FROM SCREEN TO RECORD @RESULT !MOVE RESULTING VALUES . EXECUTE DISK_ACTN# ! UPDATE THE FILE ADD(@FILENAME) ! ADD NEW RECORD PUT(@FILENAME) ! CHANGE EXISTING RECORD DELETE(@FILENAME) ! DELETE EXISTING RECORD . IF ERRORCODE() = 40 ! DUPLICATE KEY ERROR MEM:MESSAGE = ERROR() ! DISPLAY ERR MESSAGE SELECT(2) ! POSITION TO TOP OF FORM IF ACTION = 2 THEN RELEASE(@FILENAME). ! RELEASE HELD RECORD BREAK ! GET OUT OF EDIT LOOP ELSIF ERROR() ! CHECK FOR UNEXPECTED ERROR STOP(ERROR()) ! HALT EXECUTION . PUT(@FILENAME2) ! UPDATE SECONDARY FILES PUT(@FILENAME3) ! UPDATE SECONDARY FILES PUT(@FILENAME4) ! UPDATE SECONDARY FILES IF ACTION = 1 THEN POINTER# = POINTER(@FILENAME). !POINT TO RECORD SAVE_RECORD = @PRE:RECORD ! NEW ORIGINAL SAVE_MEMO = @MEMO ! NEW ORIGINAL ACTION = ACTION# ! RETRIEVE ORIGINAL OPERATION @NEXTFORM ! CALL NEXT FORM PROCEDURE ACTION = 0 ! SET ACTION TO COMPLETE CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE 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 SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . 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 !RETURN ON SCREEN REJECT KEY CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN . 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 ! RETURN ON ESC KEY CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN . @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 CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN ! AND RETURN TO CALLER . . . *REPORT************************************************************************* @PROCNAME PROCEDURE REPORT @REPORT @SAVEITEMS CODE DONE# = 0 !TURN OFF DONE FLAG SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . @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 CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE 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 IF KEYCODE() = REJECT_KEY !ABORT REPORT CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE RETURN . . @BREAKRTN !CHECK FOR GROUP BREAK *MEMREPORT********************************************************************** @PROCNAME PROCEDURE REPORT @REPORT CODE SAVE_CLEAR = CLEARANCE ! SAVE SECURITY CLEARANCE ! OF CALLER CLEARANCE = 0 ! ASSUME NO SECURITY @SETUP !CALL SETUP PROCEDURE IF NOT CHECK_PASS() ! IF THEY DO NOT HAVE CLEARANCE = SAVE_CLEAR ! SECURITY CLEARANCES RETURN ! THEN EXIT . @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 CLEARANCE = SAVE_CLEAR ! RESTORE CLEARANCE 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('SHARING FILE: ' & '@FILENAME',80)) !DISPLAY FILE NAME SHARE(@FILENAME) !OPEN THE FILE IN SHARED MODE 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 CLOSE(@FILENAME) ! LET BUILD OPEN FILE UNSHARED BUILD(@FILENAME) ! CALL THE BUILD PROCEDURE CLOSE(@FILENAME) ! CLOSE UNSHARED FILE SHARE(@FILENAME) ! OPEN FILE SHARED 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) ! THEN CREATE CLOSE(@FILENAME) ! CLOSE IT SO IT CAN SHARE(@FILENAME) ! BE OPENED SHARED *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 *TOTALCALCSEL******************************************************************* SETHUE(BACKHUE(ROW,COL),BACKHUE(ROW,COL)) !TURN OFF DISPLAY DO SHOW_LINE ! CALC SCROLLING LINE FIELDS @TOTPLUS ! ADD TO TOTALS SETHUE() *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 LOOP !LOOP TILL ADD IS SUCCESSFUL 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 ADD(@FILENAME) !ESTABLISH RECORD WITH UNIQUE IF NOT ERROR() !ADD WAS SUCCESSFUL POINTER# = POINTER(@FILENAME) !SAVE POINTER ACTION = 5 !SET ACTION FOR UPDATE BREAK !EXIT LOOP . . *AUTONUMESC********************************************************************* IF ACTION !FORM WAS NOT COMPLETED @TOTESC !CLEAR TOTAL FIELD CALCULATIONS HOLD(@FILENAME) !HOLD RECORD GET(@FILENAME,POINTER#) !READ RECORD DELETE(@FILENAME) !DELETE RECORD 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 !LOAD INCREMENT FIELD LOOP !LOOP TILL ADD IS SUCCESSFUL @INCFIELD += 1 ! INCREMENT FIELD ADD(@FILENAME) ! ESTABLISH REC WITH UNIQUE KY IF NOT ERROR() ! ADD WAS SUCCESSFUL POINTER# = POINTER(@FILENAME) !SAVE POINTER ACTION = 5 !SET ACTION FOR UPDATE BREAK !EXIT LOOP . . *AUTOSELESC********************************************************************* IF ACTION !FORM WAS NOT COMPLETED HOLD(@FILENAME) !HOLD RECORD GET(@FILENAME,POINTER#) !READ RECORD DELETE(@FILENAME) !DELETE RECORD . *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 G_OPENFILES !RE-OPEN FILES 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********************************************************************* IF NOT DONE# THEN 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 IF NOT DONE# ! MORE ITEMS TO PRINT PRINT(PAGE_FOOT) ! PRINT PAGE FOOTER PRINT(PAGE_HEAD) ! PRINT PAGE HEADER . ********************************************************************************