Media Share 9

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

/ Media Share 9 / MEDIASHARE_09.ISO / clarion / ntwk_rhr.zip / NTWK_RHR.MDL < prev next >

Wrap

Text File | 1990-08-14 | 53KB | 1,302 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) PROC(OpenFile) !!Generalized Open File Proc @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 !5 = AUTONUMKEY ADD @MEMORY EJECT('CODE SECTION') 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 @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 !!============================================================================= !! OpenFile Procedure !!============================================================================= OpenFile PROCEDURE(FileName) !!Open Files & Check For Error FileName EXTERNAL,FILE !! FullName STRING(64) !!Full File Name BaseName STRING(8) !!Base File Name LastDot BYTE !!Position of Last . LastSlash BYTE !!Position of Last \ CODE FullName = UPPER(NAME(FileName)) !!Get Full File Name LastDot = 0 !!Clear Last Dot Position LOOP !!Loop to find Last Dot P# = INSTRING('.',SUB(FullName,LastDot+1,LEN(FullName)-LastDot)) !! IF P# !! If One Is Found LastDot += P# !! Save Its Position ELSE !! Otherwise BREAK !! Break . . !!.. IF ~LastDot !!If Not Found LastDot = LEN(CLIP(FullName))+1 !! Assume At End Of Name . !!. LastSlash = 0 !!Clear Last Slash Position LOOP !!Loop To Find Last Slash P# = INSTRING('\',SUB(FullName,LastSlash+1,LEN(FullName)-LastSlash)) !! IF P# !! If One Is Found LastSlash += P# !! Save Its Position ELSE !! Otherwise BREAK !! Break . . !!.. BaseName = SUB(FullName,LastSlash+1,LastDot-(LastSlash+1)) !!Set Base Name SHOW(25,1,CENTER('SHARING FILE: ' & BaseName,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 Rebuilt SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ' & BaseName,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 OF 2 !! If Not Found, CREATE(FileName) !! Then Create CLOSE(FileName) !! Close It So It Can SHARE(FileName) !! Be Opened Shared IF ERROR() !! Check For Error LOOP;STOP(CLIP(BaseName) & ': ' & ERROR()). !! Stop Execution . !! ELSE !! Any Other Error LOOP;STOP(CLIP(BaseName) & ': ' & ERROR()). !! Stop Execution . . @RUNPROC *MENU*************************************************************************** @PROCNAME PROCEDURE SCREEN SCREEN PRE(SCR),@SCREENOPT @PAINTS @STRINGS @VARIABLES ENTRY,USE(?FIRST_FIELD) @FIELDS ENTRY,USE(?PRE_MENU) MENU,USE(MENU_FIELD"),REQ @CHOICES . . EJECT CODE OPEN(SCREEN) !OPEN THE MENU SCREEN SETCURSOR !TURN OFF ANY CURSOR MENU_FIELD" = '' !START MENU WITH FIRST ITEM @SETUP !CALL SETUP PROCEDURE LOOP !LOOP UNTIL USER EXITS @LOOKUPS !DISPLAY FROM OTHER FILES @SHOW !DISPLAY STRING VARIABLES @COMPUTE !DISPLAY COMPUTED FIELDS @RESULT !MOVE RESULTING VALUES ALERT !TURN OFF ALL ALERTED KEYS ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY @ALERT !ALERT HOT KEYS ACCEPT !READ A FIELD OR MENU CHOICE @CHECKHOT !ON HOT KEY, CALL PROCEDURE IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY UPDATE ! MOVE ALL FIELDS FROM SCREEN SELECT(?) ! START WITH CURRENT FIELD SELECT ! EDIT ALL FIELDS CYCLE ! GO TO TOP OF LOOP . ! CASE FIELD() !JUMP TO FIELD EDIT ROUTINE OF ?FIRST_FIELD !FROM THE FIRST FIELD IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY @EDITS !EDIT ROUTINES GO HERE OF ?PRE_MENU !PRE MENU FIELD CONDITION IF KEYCODE() = ESC_KEY ! BACKING UP? SELECT(?-1) ! SELECT PREVIOUS FIELD ELSE ! GOING FORWARD SELECT(?+1) ! SELECT MENU FIELD . OF ?MENU_FIELD" !FROM THE MENU FIELD EXECUTE CHOICE() ! CALL THE SELECTED PROCEDURE @MENU ! . . . *TABLE************************************************************************** @PROCNAME PROCEDURE SCREEN SCREEN PRE(SCR),@SCREENOPT @PAINTS @STRINGS @VARIABLES ENTRY,USE(?FIRST_FIELD) @FIELDS ENTRY,USE(?PRE_POINT) REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX) @PLOC POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1) @SCROLLVARIABLES . . NDX BYTE !REPEAT INDEX FOR POINT AREA ROW BYTE !ACTUAL ROW OF SCROLL AREA COL BYTE !ACTUAL COLUMN OF SCROLL AREA COUNT BYTE(@COUNT) !NUMBER OF ITEMS TO SCROLL ROWS BYTE(@ROWS) !NUMBER OF ROWS TO SCROLL COLS BYTE(@COLS) !NUMBER OF COLUMNS TO SCROLL FOUND BYTE !RECORD FOUND FLAG NEWPTR LONG !POINTER TO NEW RECORD TABLE TABLE,PRE(TBL) !TABLE OF RECORD DATA @TABLEFIELDS ! SCREEN AND KEY COMPONENTS PTR LONG ! POINTER TO FILE RECORD . @SAVEITEMS !SELECTOR FIELD SAVE AREA @SAVETOTALS !TOTAL FIELD ACCUMULATORS EJECT CODE IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count ACTION# = ACTION !SAVE ACTION OPEN(SCREEN) !OPEN THE SCREEN SETCURSOR !TURN OFF ANY CURSOR @SETUP !CALL SETUP PROCEDURE @INITSELECTS !SAVE SELECTOR FIELDS @TOTCLEAR !ZERO TOTAL ACCUMULATORS TBL:PTR = 1 !START AT TABLE ENTRY NDX = 1 !PUT SELECTOR BAR ON TOP ITEM ROW = ROW(?POINT) !REMEMBER TOP ROW AND COL = COL(?POINT) !LEFT COLUMN OF SCROLL AREA RECORDS# = TRUE !INITIALIZE RECORDS FLAG @BUILDTABLE !BUILD SCROLLING TABLE LOOP !LOOP UNTIL USER EXITS ACTION = ACTION# !RESTORE ACTION @RESTSELECTS !RESTORE SELECTOR FIELDS @TOTSHOW !DISPLAY TOTAL AMOUNTS ON SCRN @LOOKUPS !DISPLAY FROM OTHER FILES @SHOW !DISPLAY STRING VARIABLES @COMPUTE !DISPLAY COMPUTED FIELDS @RESULT !MOVE RESULTING VALUES ALERT !RESET ALERTED KEYS ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY @ALERT !ALERT HOT KEYS ACCEPT !READ A FIELD MEM:MESSAGE = '' !CLEAR MESSAGE AREA @TABLEHOT !CALL HOT KEY PROCEDURES IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY IF KEYCODE() = ACCEPT_KEY | !ON SCREEN ACCEPT KEY AND FIELD() <> ?POINT !BUT NOT ON THE POINT FIELD UPDATE ! MOVE ALL FIELDS FROM SCREEN SELECT(?) ! START WITH CURRENT FIELD SELECT ! EDIT ALL FIELDS CYCLE ! GO TO TOP OF LOOP . CASE FIELD() !JUMP TO FIELD EDIT ROUTINE OF ?FIRST_FIELD !FROM THE FIRST FIELD IF KEYCODE() = ESC_KEY | ! RETURN ON ESC KEY OR RECORDS# = FALSE ! OR NO RECORDS BREAK ! EXIT PROGRAM . @EDITS !FIELD EDIT ROUTINES OF ?PRE_POINT !PRE POINT FIELD CONDITION IF KEYCODE() = ESC_KEY ! BACKING UP? SELECT(?-1) ! SELECT PREVIOUS FIELD ELSE ! GOING FORWARD SELECT(?POINT) ! SELECT MENU FIELD . @INITLOCATE !SHOW CURSOR FOR LOCATOR OF ?POINT !PROCESS THE POINT FIELD IF RECORDS(TABLE) = 0 !IF THERE ARE NO RECORDS CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA UPDATE ! UPDATE ALL FIELDS ACTION = 1 ! SET ACTION TO ADD GET(@FILENAME,0) ! CLEAR PENDING RECORD @AUTONUMKEY ! AUTO INCREMENT KEY FIELD @TOTACTN ! SAVE TOTALS @RESTSELECTS ! RESTORE SELECTOR FIELDS @UPDATE ! CALL FORM FOR NEW RECORD @AUTONUMESC ! DELETE AUTO INCREMENT REC NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD DO FIRST_PAGE ! DISPLAY THE FIRST PAGE IF RECORDS(TABLE) = 0 ! IF THERE AREN'T ANY RECORDS RECORDS# = FALSE ! INDICATE NO RECORDS SELECT(?PRE_POINT-1) ! SELECT THE PRIOR FIELD . CYCLE ! AND LOOP AGAIN . @LOCATE !PERORM LOCATOR LOGIC CASE KEYCODE() !PROCESS THE KEYSTROKE OF INS_KEY !INS KEY CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA ACTION = 1 ! SET ACTION TO ADD GET(@FILENAME,0) ! CLEAR PENDING RECORD @AUTONUMKEY ! AUTO INCREMENT KEY FIELD @TOTACTN ! SAVE TOTALS @RESTSELECTS ! RESTORE SELECTOR FIELDS @UPDATE ! CALL FORM FOR NEW RECORD IF ~ACTION ! IF RECORD WAS ADDED NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD DO FIND_RECORD ! POSITION IN FILE . @AUTONUMESC ! DELETE AUTO INCREMENT REC OF ENTER_KEY !ENTER KEY OROF ACCEPT_KEY !CTRL-ENTER KEY DO GET_RECORD ! GET THE SELECTED RECORD IF ACTION = 4 AND KEYCODE() = ENTER_KEY! IF THIS IS A LOOKUP REQUEST ACTION = 0 ! SET ACTION TO COMPLETE BREAK ! AND RETURN TO CALLER . IF ~ERROR() ! IF RECORD IS STILL THERE ACTION = 2 ! SET ACTION TO CHANGE @TOTCHECK ! SAVE TOTALS @UPDATE ! CALL FORM TO CHANGE REC IF ACTION THEN CYCLE. ! IF SUCCESSFUL RE-DISPLAY @TOTMINUS ! SUBTRACT CURRENT AMOUNTS . NEWPTR = POINTER(@FILENAME) ! SET POINTER TO NEW RECORD DO FIND_RECORD ! POSITION IN FILE OF DEL_KEY !DEL KEY DO GET_RECORD ! READ THE SELECTED RECORD IF ~ERROR() ! IF RECORD IS STILL THERE ACTION = 3 ! SET ACTION TO DELETE @TOTCHECK ! SAVE TOTALS @UPDATE ! CALL FORM TO DELETE IF ~ACTION ! IF SUCCESSFUL @TOTMINUS ! SUBTRACT CURRENT AMOUNTS N# = NDX ! SAVE POINT INDEX DO SAME_PAGE ! RE-DISPLAY NDX = N# ! RESTORE POINT INDEX . . OF DOWN_KEY !DOWN ARROW KEY DO SET_NEXT ! POINT TO NEXT RECORD DO FILL_NEXT ! FILL A TABLE ENTRY IF FOUND ! FOUND A NEW RECORD SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) ! SCROLL THE SCREEN UP GET(TABLE,RECORDS(TABLE)) ! GET RECORD FROM TABLE DO FILL_SCREEN ! DISPLAY ON SCREEN . OF PGDN_KEY !PAGE DOWN KEY DO SET_NEXT ! POINT TO NEXT RECORD DO NEXT_PAGE ! DISPLAY THE NEXT PAGE OF CTRL_PGDN !CTRL-PAGE DOWN KEY DO LAST_PAGE ! DISPLAY THE LAST PAGE NDX = RECORDS(TABLE) ! POSITION POINT BAR OF UP_KEY !UP ARROW KEY DO SET_PREV ! POINT TO PREVIOUS RECORD DO FILL_PREV ! FILL A TABLE ENTRY IF FOUND ! FOUND A NEW RECORD SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN GET(TABLE,1) ! GET RECORD FROM TABLE DO FILL_SCREEN ! DISPLAY ON SCREEN . OF PGUP_KEY !PAGE UP KEY DO SET_PREV ! POINT TO PREVIOUS RECORD DO PREV_PAGE ! DISPLAY THE PREVIOUS PAGE OF CTRL_PGUP !CTRL-PAGE UP DO FIRST_PAGE ! DISPLAY THE FIRST PAGE NDX = 1 ! POSITION POINT BAR . . . FREE(TABLE) !FREE MEMORY TABLE IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If RETURN !AND RETURN TO CALLER SAME_PAGE ROUTINE !DISPLAY THE SAME PAGE GET(TABLE,1) ! GET THE FIRST TABLE ENTRY DO FILL_RECORD ! FILL IN THE RECORD SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POSITION FILE FREE(TABLE) ! EMPTY THE TABLE DO NEXT_PAGE ! DISPLAY A FULL PAGE FIRST_PAGE ROUTINE !DISPLAY FIRST PAGE BLANK(ROW,COL,ROWS,COLS) FREE(TABLE) ! EMPTY THE TABLE CLEAR(@PRE:RECORD,-1) ! CLEAR RECORD TO LOW VALUES CLEAR(TBL:PTR) ! ZERO RECORD POINTER @SETFILE ! POSITION FILE POINTERS LOOP NDX = 1 TO COUNT ! FILL UP THE TABLE DO FILL_NEXT ! FILL A TABLE ENTRY IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD . NDX = 1 ! SET TO TOP OF TABLE DO SHOW_PAGE ! DISPLAY THE PAGE LAST_PAGE ROUTINE !DISPLAY LAST PAGE BLANK(ROW,COL,ROWS,COLS) ! CLEAR SCROLLING AREA FREE(TABLE) ! EMPTY THE TABLE CLEAR(@PRE:RECORD,1) ! CLEAR RECORD TO HIGH VALUES CLEAR(TBL:PTR,1) ! CLEAR PTR TO HIGH VALUE @SETFILE ! POSITION FILE POINTERS LOOP NDX = COUNT TO 1 BY -1 ! FILL UP THE TABLE DO FILL_PREV ! FILL A TABLE ENTRY IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD . DO SHOW_PAGE ! DISPLAY THE PAGE FIND_RECORD ROUTINE !POSITION TO SPECIFIC RECORD SET(@KEYNAME,@KEYNAME,NEWPTR) !POSITION FILE IF NEWPTR = 0 !NEWPTR NOT SET NEXT(@FILENAME) ! READ NEXT RECORD NEWPTR = POINTER(@FILENAME) ! SET NEWPTR SKIP(@FILENAME,-1) ! BACK UP TO DISPLAY RECORD . FREE(TABLE) ! CLEAR THE RECORD DO NEXT_PAGE ! DISPLAY A PAGE NEXT_PAGE ROUTINE !DISPLAY NEXT PAGE SAVECNT# = RECORDS(TABLE) ! SAVE RECORD COUNT LOOP COUNT TIMES ! FILL UP THE TABLE DO FILL_NEXT ! FILL A TABLE ENTRY IF NOT FOUND ! IF NONE ARE LEFT IF NOT SAVECNT# ! IF REBUILDING TABLE DO LAST_PAGE ! FILL IN RECORDS EXIT ! EXIT OUT OF ROUTINE . BREAK ! EXIT LOOP . . DO SHOW_PAGE ! DISPLAY THE PAGE SET_NEXT ROUTINE !POINT TO THE NEXT PAGE GET(TABLE,RECORDS(TABLE)) ! GET THE LAST TABLE ENTRY DO FILL_RECORD ! FILL IN THE RECORD SET(@KEYNAME,@KEYNAME,TBL:PTR+1) ! POSITION FILE FILL_NEXT ROUTINE !FILL NEXT TABLE ENTRY FOUND = FALSE ! ASSUME RECORD NOT FOUND LOOP UNTIL EOF(@FILENAME) ! LOOP UNTIL END OF FILE NEXT(@FILENAME) ! READ THE NEXT RECORD @CHECKSELECT ! SELECTOR IF ~(@FILTER) THEN CYCLE. ! FILTER FOUND = TRUE ! SET RECORD FOUND DO FILL_TABLE ! FILL IN THE TABLE ENTRY ADD(TABLE) ! ADD LAST TABLE ENTRY GET(TABLE,RECORDS(TABLE)-COUNT) ! GET ANY OVERFLOW RECORD DELETE(TABLE) ! AND DELETE IT EXIT ! RETURN TO CALLER . PREV_PAGE ROUTINE !DISPLAY PREVIOUS PAGE LOOP COUNT TIMES ! FILL UP THE TABLE DO FILL_PREV ! FILL A TABLE ENTRY IF NOT FOUND THEN BREAK. ! GET OUT IF NO RECORD . DO SHOW_PAGE ! DISPLAY THE PAGE SET_PREV ROUTINE !POINT TO PREVIOUS PAGE GET(TABLE,1) ! GET THE FIRST TABLE ENTRY DO FILL_RECORD ! FILL IN THE RECORD SET(@KEYNAME,@KEYNAME,TBL:PTR-1) ! POSITION FILE FILL_PREV ROUTINE !FILL PREVIOUS TABLE ENTRY FOUND = FALSE ! ASSUME RECORD NOT FOUND LOOP UNTIL BOF(@FILENAME) ! LOOP UNTIL BEGINNING OF FILE PREVIOUS(@FILENAME) ! READ THE NEXT RECORD @CHECKSELECT ! SELECTOR IF ~(@FILTER) THEN CYCLE. ! FILTER FOUND = TRUE ! SET RECORD FOUND DO FILL_TABLE ! FILL IN THE TABLE ENTRY ADD(TABLE,1) ! ADD FIRST TABLE ENTRY GET(TABLE,COUNT+1) ! GET ANY OVERFLOW RECORD DELETE(TABLE) ! AND DELETE IT EXIT ! RETURN TO CALLER . SHOW_PAGE ROUTINE !DISPLAY THE PAGE NDX# = NDX ! SAVE SCREEN INDEX LOOP NDX = 1 TO RECORDS(TABLE) ! LOOP THRU THE TABLE GET(TABLE,NDX) ! GET A TABLE ENTRY DO FILL_SCREEN ! AND DISPLAY IT IF TBL:PTR = NEWPTR ! SET INDEX FOR NEW RECORD NDX# = NDX ! POINT TO CORRECT RECORD @DOTOTALS ! CALCULATE TOTAL FIELDS . . NDX = NDX# ! RESTORE SCREEN INDEX NEWPTR = 0 ! CLEAR NEW RECORD POINTER CLEAR(@PRE:RECORD) ! CLEAR RECORD AREA FILL_TABLE ROUTINE !MOVE FILE TO TABLE @LOOKUPSCROLL ! PERFORM LOOKUPS @FILLTABLE ! LOAD TABLE FIELDS TBL:PTR = POINTER(@FILENAME) ! SAVE RECORD POINTER @COMPUTESCROLL ! DO COMPUTES AND CONDITIONALS @RESULTSCROLL ! MOVE RESULT FIELDS FILL_RECORD ROUTINE !MOVE TABLE TO FILE @FILLRECORD ! LOAD FILE KEYS FILL_SCREEN ROUTINE !MOVE TABLE TO SCREEN @FILLSCREEN ! DISPLAY SCREEN VARIABLES GET_RECORD ROUTINE !GET SELECTED RECORD GET(TABLE,NDX) ! GET TABLE ENTRY GET(@FILENAME,TBL:PTR) ! GET THE RECORD @COMPUTETOTS !CALCULATE TOTAL FIELDS *FORM*************************************************************************** @PROCNAME PROCEDURE SCREEN SCREEN PRE(SCR),@SCREENOPT @PAINTS @STRINGS @VARIABLES ENTRY,USE(?FIRST_FIELD) @FIELDS @PAUSE ENTRY,USE(?LAST_FIELD) PAUSE(''),USE(?DELETE_FIELD) . TABLE TABLE,PRE(SAV) SAVE_RECORD GROUP;BYTE,DIM(SIZE(@PRE:RECORD)). SAVE_MEMO GROUP;BYTE,DIM(SIZE(@MEMO)). . EJECT CODE IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count OPEN(SCREEN) !OPEN THE SCREEN SETCURSOR !TURN OFF ANY CURSOR SAVE_RECORD = @PRE:RECORD !SAVE THE ORIGINAL SAVE_MEMO = @MEMO !SAVE THE ORIGINAL ADD(TABLE,1) !STORE IN MEMORY TABLE 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 . @SETUP !CALL SETUP PROCEDURE 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 DO CALCFIELDS !CALCULATE DISPLAY FIELDS ALERT !RESET ALERTED KEYS ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY @ALERT !ALERT HOT KEY ACCEPT !READ A FIELD @CHECKHOT !ON HOT KEY, CALL PROCEDURE IF KEYCODE() = REJECT_KEY THEN BREAK. !RETURN ON SCREEN REJECT KEY EXECUTE ACTION !SET MESSAGE MEM:MESSAGE = 'Record will be Added' ! MEM:MESSAGE = 'Record will be Changed' ! MEM:MESSAGE = 'Press Enter to Delete' ! . IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY UPDATE ! MOVE ALL FIELDS FROM SCREEN SELECT(?) ! START WITH CURRENT FIELD SELECT ! EDIT ALL FIELDS CYCLE ! GO TO TOP OF LOOP . CASE FIELD() !JUMP TO FIELD EDIT ROUTINE OF ?FIRST_FIELD !FROM THE FIRST FIELD IF KEYCODE() = ESC_KEY THEN BREAK. ! 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 IF ACTION = 2 OR ACTION = 3 !IF UPDATING RECORD SAVE_RECORD = @PRE:RECORD ! SAVE CURRENT CHANGES SAVE_MEMO = @MEMO ! SAVE CURRENT CHANGES ADD(TABLE,2) ! STORE IN MEMORY TABLE GET(TABLE,1) ! RETRIEVE ORIGINAL RECORD HOLD(@FILENAME) ! HOLD FILE GET(@FILENAME,POINTER#) ! RE-READ SAME RECORD IF ERRORCODE() = 35 ! IF RECORD WAS DELETED IF DISK_ACTN# = 2 ! IF TRYING TO UPDATE DISK_ACTN# = 1 ! THEN ADD IT BACK ELSE ! RELEASE(@FILENAME) ! RELEASE FILE ACTION = 0 ! TURN OFF ACTION . ELSIF | !OTHERWISE @MEMO <> SAVE_MEMO OR | ! IF IT HAS BEEN CHANGED @PRE:RECORD <> SAVE_RECORD ! BY ANOTHER STATION MEM:MESSAGE = 'CHANGED BY ANOTHER STATION' !INFORM USER SELECT(2) ! GO BACK TO TOP OF FORM BEEP ! SOUND ALARM RELEASE(@FILENAME) ! RELEASE FILE SAVE_RECORD = @PRE:RECORD ! SAVE RECORD SAVE_MEMO = @MEMO ! SAVE MEMO DISPLAY ! DISPLAY THE FIELDS PUT(TABLE) ! FREE SAVED CHANGES CYCLE ! AND CONTINUE . GET(TABLE,2) ! READ CURRENT (CHANGED) REC @PRE:RECORD = SAVE_RECORD ! MOVE RECORD @MEMO = SAVE_MEMO ! MOVE MEMO DELETE(TABLE) ! DELETE MEMORY TABLE ITEM . 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 CYCLE ! 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 BREAK ! 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 . . . IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If FREE(TABLE) ! RELEASE MEMORY TABLE RETURN ! AND RETURN TO CALLER CALCFIELDS ROUTINE IF FIELD() > ?FIRST_FIELD !BEYOND FIRST_FIELD? IF KEYCODE() = 0 AND SELECTED() > FIELD() THEN EXIT. !GET OUT IF NOT NONSTOP . @LOOKUPS !DISPLAY FROM OTHER FILES @SHOW !DISPLAY STRING VARIABLES @COMPUTE !DISPLAY COMPUTED FIELDS @RESULT !MOVE RESULTING VALUES *MEMFORM************************************************************************ @PROCNAME PROCEDURE SCREEN SCREEN PRE(SCR),@SCREENOPT @PAINTS @STRINGS @VARIABLES ENTRY,USE(?FIRST_FIELD) @FIELDS @PAUSE ENTRY,USE(?LAST_FIELD) . EJECT CODE OPEN(SCREEN) !OPEN THE SCREEN SETCURSOR !TURN OFF ANY CURSOR @SETUP !CALL SETUP PROCEDURE DISPLAY !DISPLAY THE FIELDS LOOP !LOOP THRU ALL THE FIELDS @LOOKUPS !DISPLAY FROM OTHER FILES @SHOW !DISPLAY STRING VARIABLES @COMPUTE !DISPLAY COMPUTED FIELDS @RESULT !MOVE RESULTING VALUES ALERT !RESET ALERTED KEYS ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY @ALERT !ALERT HOT KEY ACCEPT !READ A FIELD @CHECKHOT !ON HOT KEY, CALL PROCEDURE IF KEYCODE() = REJECT_KEY THEN RETURN. !RETURN ON SCREEN REJECT KEY IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY UPDATE ! MOVE ALL FIELDS FROM SCREEN SELECT(?) ! START WITH CURRENT FIELD SELECT ! EDIT ALL FIELDS CYCLE ! GO TO TOP OF LOOP . ! CASE FIELD() !JUMP TO FIELD EDIT ROUTINE OF ?FIRST_FIELD !FROM THE FIRST FIELD IF KEYCODE() = ESC_KEY THEN RETURN. ! RETURN ON ESC KEY @EDITS !EDIT ROUTINES GO HERE OF ?LAST_FIELD !FROM THE LAST FIELD PUT(@FILENAME2) ! UPDATE SECONDARY FILES PUT(@FILENAME3) ! UPDATE SECONDARY FILES PUT(@FILENAME4) ! UPDATE SECONDARY FILES @NEXTFORM ! CALL NEXT FORM PROCEDURE ACTION = 0 ! SET ACTION TO COMPLETE RETURN ! AND RETURN TO CALLER . . *REPORT************************************************************************* @PROCNAME PROCEDURE REPORT @REPORT @SAVEITEMS CODE IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count 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 @SETRPTFILE !SET TO FIRST RECORD DO NEXT_RECORD !READ FIRST RECORD @PAGEFOOTER !DO PAGE FOOTER COMPUTES @PAGEHEADER !DO PAGE HEADER COMPUTES @APPENDON !APPEND REPORT TO TITLE OPEN(REPORT) !OPEN THE REPORT @FIRSTBREAK !PRINT INITIAL BREAK HEADERS LOOP UNTIL DONE# !READ ALL RECORDS IN FILE SAVE_LINE# = MEM:LINE ! SAVE LINE NUMBER LAST_REC# = POINTER(@FILENAME) @RUNTOTALS ! ACCUMULATE RUNNING TOTALS @INITDETAIL ! SET UP FOR DETAIL LINE PRINT(RPT:DETAIL) ! PRINT DETAIL LINES DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED @PRINTMEMO ! PRINT ANY MEMO FIELD @TOTALS ! ACCUMULATE TOTALS @PAGEFOOTER ! DO PAGE FOOTER COMPUTES DO NEXT_RECORD ! GET NEXT RECORD @PAGEHEADER ! DO PAGE HEADER COMPUTES @PAGEEJECTDTL ! GO TO NEW PAGE @CHECKBREAK ! CHECK FOR BREAK . ! @LASTBREAK ! PRINT ENDING BREAK FOOTERS @RPTFOOTER !DO REPORT FOOTER COMPUTES PRINT(RPT:RPT_FOOT) !PRINT GRAND TOTALS DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED @PRINTMEMO ! PRINT ANY MEMO FIELD CLOSE(REPORT) !CLOSE REPORT @APPENDOFF !TURN OFF REPORT APPEND IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If 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 !ON CTRL-ESC CLOSE(REPORT) ! CLOSE REPORT RETURN ! ABORT PRINT . . @BREAKRTN !CHECK FOR GROUP BREAK *MEMREPORT********************************************************************** @PROCNAME PROCEDURE REPORT @REPORT CODE @SETUP !CALL SETUP PROCEDURE @INITREPORT !INIT REPORT VARIABLES @RPTHEADER !DO REPORT HEADER COMPUTES PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE @MEMMEMO !PRINT ANY MEMO FILES CLOSE(TITLE) !CLOSE TITLE REPORT @PAGEFOOTER !DO PAGE FOOTER COMPUTES @PAGEHEADER !DO PAGE HEADER COMPUTES @APPENDON !APPEND REPORT TO TITLE OPEN(REPORT) !OPEN REPORT BODY @MEMMEMO !PRINT ANY MEMO FIELD @DETAIL !DO DETAIL COMPUTES @RUNTOTALS !ACCUMULATE RUNNING TOTALS @INITDETAIL !SET UP FOR DETAIL RECORD PRINT(RPT:DETAIL) !PRINT DETAIL LINES @MEMMEMO !PRINT ANY MEMO FIELD @TOTALS !ACCUMULATE TOTALS @MEMMEMO !PRINT ANY MEMO FIELD @PAGEFOOTER !DO PAGE FOOTER COMPUTES @RPTFOOTER !DO REPORT FOOTER COMPUTES PRINT(RPT:RPT_FOOT) !PRINT REPORT FOOTER @MEMMEMO !PRINT ANY MEMO FIELD CLOSE(REPORT) !CLOSE REPORT @APPENDOFF !TURN OFF REPORT APPEND RETURN !RETURN TO CALLER *ALERT************************************************************************** ALERT(@HOTKEY) !ALERT HOT KEY *APPENDON*********************************************************************** APPEND# = FALSE !TURN OFF APPEND FLAG IF SUB(MEM:DEVICE,1,1) <> '+' !NOT ALREADY APPENDING REPORTS MEM:DEVICE = '+' & MEM:DEVICE ! APPEND DISK RPT TO TITLE APPEND# = TRUE ! SET FLAG TO TURN OFF APPEND . *APPENDOFF********************************************************************** IF APPEND# !IF REPORT WAS APPENDED MEM:DEVICE = SUB(MEM:DEVICE,2,LEN(MEM:DEVICE)-1)!TURN OFF APPEND REPORT . *AUTONUMESC********************************************************************* IF ACTION !FORM WAS NOT COMPLETED HOLD(@FILENAME) !HOLD RECORD GET(@FILENAME,POINTER#) !READ RECORD DELETE(@FILENAME) !DELETE RECORD DO SAME_PAGE . *AUTONUMKEY********************************************************************* LOOP CLEAR(@PRE:RECORD,1) !CLEAR RECORD TO HIGH VALUES @SETFILE !SET TO HIGHEST KEY VALUE PREVIOUS(@FILENAME) !READ LAST KEY RECORD IF ERROR() THEN CLEAR(@PRE:RECORD). !CLEAR BUFFER WHEN NO RECORDS @CHECKSELAUTO !CHECK SELECTOR KEYFIELD# = @INCFIELD + 1 !INCREMENT FIELD CLEAR(@PRE:RECORD) !CLEAR LAST KEY RECORD @RESTSELECTS !LOAD PRIOR KEY FIELDS @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 . . *AUTOTABLE********************************************************************** IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count @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 IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If CYCLE ! GO TO TOP OF LOOP . @LOOKFIELD = @ACCESSFIELD !DISPLAY LOOKUP FIELD @FIELD = @ACCESSFIELD !MOVE LOOKUP FIELD DISPLAY(?@FIELD) !AND DISPLAY IT ACTION = ACTION# !RESTORE ACTION IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If *BREAKFOOTER******************************************************************** IF BRK_FLAG# <= @BRKNUM !CHECK BREAK LEVEL @GRPFOOTER ! DO FOOTER COMPUTES PRINT(GRP_FOOT@BRKNUM) ! PRINT GROUP FOOTER @PRINTMEMO ! PRINT ANY MEMO FIELD DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED @PAGEEJECT ! GO TO NEW PAGE . *BREAKHEADER******************************************************************** IF BRK_FLAG# <= @BRKNUM !CHECK BREAK LEVEL @INITGROUP ! INIT GROUP VARIABLES @GRPHEADER ! DO HEADER COMPUTES PRINT(GRP_HEAD@BRKNUM) ! PRINT GROUP HEADER @PRINTMEMO ! PRINT ANY MEMO FIELD DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED . *BREAKRTN*********************************************************************** CHECK_BREAK ROUTINE !CHECK FOR GROUP BREAK @COMPAREBREAK !GENERATE IF STATEMENTS PRT_BRK_HDRS ROUTINE !DO GROUP HEADERS @BREAKHEADER !PRINT HEADERS @INITBREAK !INITIALIZE BREAK FIELDS PRT_BRK_FTRS ROUTINE !DO GROUP FOOTERS GET(@FILENAME,LAST_REC#) !REREAD PREVIOUS RECORD @BREAKFOOTER !PRINT FOOTERS SKIP(@FILENAME,-1) !BACKUP ONE RECORD NEXT(@FILENAME) !AND REREAD IT *BUILDTABLE********************************************************************* @TOTALCALC !CALC TABLE TOTAL FIELDS IF ACTION = 4 ! TABLE LOOKUP REQUEST NEWPTR = POINTER(@FILENAME) ! SET POINTER TO RECORD IF NOT NEWPTR ! RECORD NOT PASSED TO TABLE SET(@KEYNAME,@KEYNAME) ! POSITION TO CLOSEST RECORD NEXT(@FILENAME) ! READ RECORD NEWPTR = POINTER(@FILENAME) ! SET POINTER . DO FIND_RECORD ! POSITION FILE ELSE NDX = 1 ! PUT SELECTOR BAR ON TOP ITEM DO FIRST_PAGE ! BUILD MEMORY TABLE OF KEYS . RECORDS# = TRUE ! ASSUME THERE ARE RECORDS *CHECKBREAK********************************************************************* IF NOT DONE# THEN DO CHECK_BREAK. ! CHECK FOR GROUP BREAK *CHECKHOT*********************************************************************** IF KEYCODE() = @HOTKEY !ON HOT KEY UPDATE(?) ! RETRIEVE FIELD @HOTPROC ! CALL HOT KEY PROCEDURE SELECT(?) ! DO SAME FIELD AGAIN CYCLE ! AND LOOP AGAIN . *CHECKSELAUTO******************************************************************* IF @FIELD <> @SAVEFIELD THEN CLEAR(@PRE:RECORD). !NO SELECTOR MATCHES *CHECKSELECT******************************************************************** IF @FIELD <> @SAVEFIELD THEN BREAK. !BREAK ON END OF SELECTION *COMPAREBREAK******************************************************************* IF @FIELD <> @SAVEFIELD !BREAK ON NEW GROUP BRK_FLAG# = @BRKNUM !SET BREAK LEVEL DO PRT_BRK_FTRS !PRINT FOOTERS FOR THIS LEVEL DO PRT_BRK_HDRS !PRINT HEADERS FOR THIS LEVEL EXIT !RETURN TO REPORT . *COMPUTETOTS******************************************************************** COMP_TOTALS ROUTINE !CALCULATE TOTAL FIELDS IF NOT ACTN# THEN EXIT. !GET OUT IF ACTN NOT SET @TOTPLUS !ADD TO TOTALS ACTN# = 0 !CLEAR ACTION *CONDITIONAL******************************************************************** IF @IFCOND !EVALUATE CONDITION @IFCONDTRUE ! CONDITION IS TRUE ELSE !OTHERWISE @IFCONDFALSE ! CONDITION IS FALSE . *CREATEFILE********************************************************************* OF 2 !IF NOT FOUND, CREATE(FileName) ! THEN CREATE CLOSE(FileName) ! CLOSE IT SO IT CAN SHARE(FileName) ! BE OPENED SHARED *DOTOTALS*********************************************************************** DO COMP_TOTALS !CALCULATE TABLE TOTALS *ENTERTABLE********************************************************************* IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count @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 IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If CYCLE ! GO TO TOP OF LOOP . @FIELD = @ACCESSFIELD ! MOVE LOOKUP FIELD DISPLAY(?@FIELD) ! AND DISPLAY IT ACTION = ACTION# ! RESTORE ACTION . IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If *FIRSTBREAK********************************************************************* BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG DO PRT_BRK_HDRS !PRINT GROUP HEADER(S) *HOTTABLE*********************************************************************** IF KEYCODE() = @HOTKEY !IF HOT KEY PRESSED IF ~Mem:@FileName !! If File Not Open OpenFile(@FileName) !! Open It . !! . Mem:@FileName += 1 !! Increment File Open Count 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 IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If CYCLE ! GO TO TOP OF LOOP . @FIELD = @ACCESSFIELD ! MOVE LOOKUP FIELD DISPLAY(?@FIELD) ! AND DISPLAY IT ACTION = ACTION# ! RESTORE ACTION IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If . *INITBREAK********************************************************************** @SAVEFIELD = @FIELD !SAVE BREAK FIELD *INITLOCATE********************************************************************* IF KEYCODE() = ESC_KEY ! BACKING UP? SCR:LOCATOR = '' ! CLEAR LOCATOR SETCURSOR ! AND TURN CURSOR OFF ELSE ! GOING FORWARD LEN# = 0 ! RESET TO START OF LOCATOR SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)) ! AND TURN CURSOR ON . *INITSELECTS******************************************************************** @SAVEFIELD = @FIELD !SAVE SELECTOR FIELD *INRANGE************************************************************************ IF ~INRANGE(@FIELD,@LOWER,@UPPER) !IF FIELD IS OUT OF RANGE BEEP ! SOUND KEYBOARD ALARM SELECT(?@FIELD) ! AND STAY ON THIS FIELD CYCLE ! . *LASTBREAK********************************************************************** BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG DO PRT_BRK_FTRS !PRINT GROUP FOOTER(S) *LOCATE************************************************************************* IF KEYCODE() > 31 | !THE DISPLAYABLE CHARACTERS AND KEYCODE() < 255 !ARE USED TO LOCATE RECORDS IF LEN# < SIZE(SCR:LOCATOR) ! IF THERE IS ROOM LEFT SCR:LOCATOR = SUB(SCR:LOCATOR,1,LEN#) & CHR(KEYCODE()) LEN# += 1 ! INCREMENT THE LENGTH . ELSIF KEYCODE() = BS_KEY !BACKSPACE UNTYPES A CHARACTER IF LEN# > 0 ! IF THERE ARE CHARACTERS LEFT LEN# -= 1 ! DECREMENT THE LENGTH SCR:LOCATOR = SUB(SCR:LOCATOR,1,LEN#) ! ERASE THE LAST CHARACTER . ELSE !FOR ANY OTHER CHARACTER LEN# = 0 ! ZERO THE LENGTH SCR:LOCATOR = '' ! ERASE THE LOCATOR FIELD . SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)+LEN#) !AND RESET THE CURSOR @SETLOCATE IF KEYBOARD() > 31 | !THE DISPLAYABLE CHARACTERS AND KEYBOARD() < 255 | !ARE USED TO LOCATE RECORDS OR KEYBOARD() = BS_KEY !INCLUDE BACKSPACE CYCLE . IF LEN# > 0 !ON A LOCATOR REQUEST @RESTSELECTS ! --SET SELECTOR COMPONENTS-- @SETLOCATE SET(@KEYNAME,@KEYNAME) ! POINT TO NEW RECORD NEXT(@FILENAME) ! READ A RECORD IF (EOF(@FILENAME) AND ERROR()) ! IF EOF IS REACHED SET(@KEYNAME) ! SET TO FIRST RECORD PREVIOUS(@FILENAME) ! READ THE LAST RECORD . NEWPTR = POINTER(@FILENAME) ! SET NEW RECORD POINTER SKIP(@FILENAME,-1) ! BACK UP TO FIRST RECORD FREE(TABLE) ! CLEAR THE TABLE DO NEXT_PAGE ! AND DISPLAY A NEW PAGE . *LOOKUPS************************************************************************ IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count 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 IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If *LOOKUPSCROLL******************************************************************* IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. Mem:@FileName += 1 !!Increment File Open Count @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 IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If *MEMMEMO************************************************************************ @MEMOLEN !DETERMINE MEMO SIZE J# = 2 !START WITH ROW 2 LOOP !LOOP THRU ALL USED ROWS MEMODONE# = 0 ! NO MEMOS DONE YET @SETMEMO ! SET THE MEMO VARIABLES IF MEMODONE# = 0 THEN BREAK. ! ALL MEMOS PRINTED @PRTDETAIL ! AND PRINT IT J# += 1 ! INCREMENT COUNTER . *MEMOLEN************************************************************************ LOOP @MEMOTMP# = @MEMOSIZE TO 2 BY -1 !BACKSCAN THE MEMO FIELD TO IF @MEMOROW[@MEMOTMP#] <> '' THEN BREAK. ! FIND NUMBER OF ROWS USED . ! END OF MEMOLEN *NEXTFORM*********************************************************************** IF ACTION <> 3 !IF THIS IS NOT A DELETE ACTION = 2 ! SET ACTION TO CHANGE MODE @NEXTPAGE ! CALL NEXT FORM PROCEDURE IF ACTION ! IF RECORD WAS NOT CHANGED SELECT(?LAST_FIELD - 1) ! SELECT THE LAST ENTRY CYCLE ! AND LOOP AGAIN . . *NOTREQUIRED******************************************************************** IF @FIELD = '' !IF NOT REQUIRED THEN @EDITPROC ! CALL THE EDIT PROCEDURE CYCLE ! END THE EDIT . *OPENFILES********************************************************************** IF Mem:@FileName !!If File Open Flag is Set OpenFile(@FileName) !! Open The File . !!. *PAUSE************************************************************************** OF ?PAUSE_FIELD !ON PAUSE FIELD IF KEYCODE() <> ENTER_KEY | !IF NOT ENTER KEY AND KEYCODE() <> ACCEPT_KEY | !AND NOT CTRL-ENTER KEY AND KEYCODE() <> 0 !AND NOT NONSTOP MODE BEEP ! SOUND KEYBOARD ALARM SELECT(?PAUSE_FIELD) ! AND STAY ON PAUSE FIELD . *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 . *PICLOCATE********************************************************************** @LOCFIELD = DEFORMAT(SCR:LOCATOR) ! UPDATE THE KEY FIELD *PRINTMEMO********************************************************************** @MEMOLEN !DETERMINE MEMO SIZE J# = 2 !START WITH SECOND ROW LOOP !LOOP THRU ALL USED ROWS MEMODONE# = 0 ! NO MEMOS DONE YET @SETMEMO ! SET THE MEMO VARIABLES IF MEMODONE# = 0 ! ALL MEMOS PRINTED DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED BREAK ! EXIT MEMO PRINT LOOP . ! @PRTDETAIL ! AND PRINT IT J# += 1 ! INCREMENT COUNTER DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED . *PRTDETAIL********************************************************************** PRINT(@MEMDETAIL) !PRINT THE DETAIL RECORD *REQUIRED*********************************************************************** IF @FIELD = '' !IF REQUIRED FIELD IS EMPTY BEEP ! SOUND KEYBOARD ALARM SELECT(?@FIELD) ! AND STAY ON THIS FIELD CYCLE ! . *RESTSELECTS******************************************************************** @FIELD = @SAVEFIELD !RESTORE SELECTOR FIELD *RUNCODE************************************************************************ G_RUNPROC('@RUNDESC') !RUN DOS PROGRAM *RUNMAP************************************************************************* PROC(G_RUNPROC) !GLOBAL MODULE RUN PROCEDURE *RUNPROC************************************************************************ G_RUNPROC PROCEDURE(DOSPROG) !GLOBAL RUN PROCEDURE DOSPROG STRING(12) !PROGRAM TO RUN SCREEN SCREEN WINDOW(25,80),HUE(7,0,0). !SAVE WINDOW CODE OPEN(SCREEN) !SAVE CURRENT SCREEN SETCURSOR(25,1) !POSITION CURSOR AT BOTTOM RUN(DOSPROG) !RUN DOS PROGRAM G_OPENFILES !RE-OPEN FILES CLOSE(SCREEN) !RESTORE SCREEN RETURN !EXIT BACK TO CALLING MENU *SAVEITEMS********************************************************************** GROUP,PRE(SAV) @BREAKFIELDS @SELECTFIELDS . *SAVETOTALS********************************************************************* TOT_GROUP GROUP,PRE(TOT) !TABLE TOTAL FIELDS @TOTALFIELDS . *SETKEY************************************************************************* SET(@KEYNAME) ! POINT TO FIRST RECORD *SETKEYKEY********************************************************************** @RESTSELECTS !--SET SELECTOR COMPONENTS SET(@KEYNAME,@KEYNAME,TBL:PTR) ! POINT PAST LAST RECORD *SETMEMO************************************************************************ IF J# <= @MEMOTMP# !IF IN THE RANGE OF THIS MEMO @MEMOVAR = @MEMOROW[J#] ! MOVE A MEMO FIELD ROW MEMODONE# = 1 ! MEMO HAS BEEN MOVED ELSE !OTHERWISE @MEMOVAR = '' ! NO MEMO TO DO . ! END OF SETMEMO *SETRECORD********************************************************************** SET(@FILENAME) ! POINT TO FIRST RECORD *SETSELECT********************************************************************** SET(@KEYNAME,@KEYNAME) !SET TO FIRST SELECTED RECORD *SETTOP************************************************************************* SET(@KEYNAME) !SET TO FIRST RECORD *SHOWMEMO*********************************************************************** R# = ROW(@SCRMEMO) !SAVE ROW OF MEMO C# = COL(@SCRMEMO) !SAVE COL OF MEMO SETHUE(FOREHUE(R#,C#),BACKHUE(R#,C#)) !RETRIEVE COLOR OF MEMO LOOP I# = 1 TO @MEMOROWS !DISPLAY MEMO FIELD BY ROWS SHOW(R#+I#-1,C#,@MEMOROW[I#],@S@MEMOCOLS) !SHOW NEXT ROW . SETHUE !TURN OFF COLOR *STRLOCATE********************************************************************** @LOCFIELD = CLIP(SCR:LOCATOR) ! UPDATE THE KEY FIELD *TABLEHOT*********************************************************************** IF KEYCODE() = @HOTKEY !ON HOT KEY IF FIELD() = ?POINT THEN DO GET_RECORD. ! READ RECORD IF NEEDED @HOTPROC ! CALL HOT KEY PROCEDURE DO SAME_PAGE ! RESET TO SAME PAGE CYCLE ! AND LOOP AGAIN . *TODO*************************************************************************** @PROCNAME PROCEDURE !THIS PROCEDURE IS NOT DEFINED CODE ! RETURN !RETURN TO CALLER *TOTACTN************************************************************************ ACTN# = ACTION !SAVE ACTION FOR COMP_TOTALS *TOTALCALC********************************************************************** @TOTCLEAR !ZERO TOTALS CLEAR(@PRE:RECORD,-1) !CLEAR RECORD TO LOW VALUES CLEAR(TBL:PTR) !SET POINTER TO ZERO SETHUE(BACKHUE(ROW,COL),BACKHUE(ROW,COL)) !TURN OFF DISPLAY @SETFILETOT !READ DATA RECORD SEQUENCE LOOP UNTIL EOF(@FILENAME) !LOOP UNTIL END OF FILE NEXT(@FILENAME) ! READ A RECORD @CHECKSELECT ! SELECTOR MATCH? IF ~(@FILTER) THEN CYCLE. ! FILTER MATCH? ACTN# = 1 !SET ACTION FOR ADD DO FILL_TABLE ! TOTAL SCREEN VARIABLES DO COMP_TOTALS ! ADD TO TOTAL AMOUNT . SETHUE() !TURN OFF SETHUE FREE(@FILENAME) !FREE MEMORY USED FOR BUFFERING *TOTCHECK*********************************************************************** @TOTACTN !SAVE ACTION @TOTSAVE !SAVE EXISTING VALUES *TOTCLEAR*********************************************************************** CLEAR(TOT_GROUP) !ZERO TOTALS @TOTCLEARIMPL !ZERO AVERAGE CALC IMPLICITS *UNIQUEKEY********************************************************************** IF DUPLICATE(@ACCESSKEY) ! CHECK FOR DUPLICATE KEY MEM:MESSAGE = 'CREATES DUPLICATE ENTRY' ! MOVE AN ERROR MESSAGE SELECT(?@FIELD) ! STAY ON THE SAME FIELD BEEP ! SOUND THE KEYBOARD ALARM CYCLE ! AND LOOP AGAIN . *VALIDATE*********************************************************************** IF ~Mem:@FileName !!If File Not Open OpenFile(@FileName) !! Open It . !!. @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 . IF Mem:@FileName <= 1 !!If Last User Of File CLOSE(@FileName) !! Close The File Mem:@FileName = 0 !! ReSet File Open Count ELSE !!Otherwise Mem:@FileName -= 1 !! Decrement File Open Count . !!End If ********************************************************************************