Media Share 9

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

/ Media Share 9 / MEDIASHARE_09.ISO / clarion / spd_20.zip / CUSTOM3.MDL < prev next >

Wrap

Text File | 1990-04-26 | 90KB | 2,241 lines

*Global************************************************************************* INCLUDE('\CLARION\STD_KEYS.CLA') INCLUDE('\CLARION\CTL_KEYS.CLA') INCLUDE('\CLARION\ALT_KEYS.CLA') INCLUDE('\CLARION\SHF_KEYS.CLA') Reject_Key EQUATE(Ctrl_Esc) Accept_Key EQUATE(Ctrl_Enter) True EQUATE(1) False EQUATE(0) eMark EQUATE('<251>') MAP PROC(G_OPENFILES) @RUNMAP @Modules MODULE('D:\CLARION\ChkErr_') !! PROC(ChkErr) !! . !! MODULE('DOS1'),BINARY !! PROC(GoDOS) !! . !! MODULE('PutKbd'),BINARY !! PROC(PutKbd) !! . !! MODULE('D:\CLARION\NoRecs_') !! PROC(NoRecs) !! . !! MODULE('D:\CLARION\GDevice_') !! PROC(GetDevice_) !! . !! MODULE('D:\CLARION\View_') !! PROC(View_) !! . !! MODULE('D:\CLARION\ShwCncl_') !! PROC(ShowCancel_) !! . !! MODULE('D:\CLARION\AbortYN_') FUNC(AbortEditYN_),STRING . . EJECT('File Layouts') @File EJECT('Global Memory Variables') Action SHORT eDone EQUATE(0) !!0 = No Action eAdd EQUATE(1) !!1 = Add Record eChange EQUATE(2) !!2 = Change Record eDelete EQUATE(3) !!3 = Delete Record eView EQUATE(4) !!4 = Lookup/View @Memory INCLUDE('MEM_VARS.CPY') ! !!Add This Screen ! OpenDatScr_ SCREEN WINDOW(6,25),AT(10,29),HUE(7,1) ! ROW(6,1) PAINT(1,1),TRN ! ROW(1,25) PAINT(1,1),TRN ! COL(1) STRING('╔═<0{20}>═╗'),ENH ! ROW(2,1) REPEAT(3);STRING('║<0{22}>║'),ENH . ! ROW(5,1) STRING('╚═{22}╝'),ENH ! ROW(2,25) REPEAT(4);STRING('░'),HUE(7,0) . ! ROW(6,2) STRING('░{24}'),HUE(7,0) ! ROW(1,3) STRING(' Opening data files '),HUE(0,3) ! OpenDatMsg_ ROW(2,2) STRING(22),ENH,BLK ! DataFile_ ROW(3,9) STRING(8),HUE(14,1) ! . EJECT('Code Section') CODE SETHUE(7,0) !Set White On Black BLANK ! And Blank HELP(@HELPFILE) !OPEN THE HELP FILE SETHUE() ! The Screen (!!Move Line) G_OPENFILES !OPEN OR CREATE FILES @BaseProc !Call The Base Procedure RETURN !Exit To Dos !=============================================================================== G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR CODE @OPENFILES !OPEN EACH FILE BLANK !BLANK THE SCREEN @RUNPROC *NormMenu*********************************************************************** @ProcName PROCEDURE !Original Menu Model Proc Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields MENU,USE(Menu_Field),REQ !!Remove "?" From Use @CHOICES . . Menu_Field STRING(80) !!Add This Varible EJECT CODE OPEN(Screen) !Open The Menu Screen SETCURSOR !Turn Off Any Cursor @Setup !Call Setup Procedure LOOP !Loop Until User Exits @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Turn Off All Alerted Keys ALERT(Reject_Key) !Alert Screen Reject Key ALERT(Accept_Key) !Alert Screen Accept Key @Alert !Alert Hot Keys ACCEPT !Read A Field Or Menu Choice @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key THEN RETURN. !Return On Screen Reject Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key !On Screen Accept Key UPDATE ! Move All Fields From Screen Edit_Range# = ?Menu_Field - 1 ! And Edit Remaining Fields SELECT(?Menu_Field) ! If Ok Then Start Here Next . ! LOOP Field# = FIELD() TO Edit_Range# !Edit Fields In The Edit Range CASE Field# !Jump To Field Edit Routine OF ?First_Field !From The First Field IF KEYCODE() = Esc_Key THEN RETURN. ! Return On Esc Key @Edits !Edit Routines Go Here OF ?Menu_Field !From The Menu Field EXECUTE CHOICE() ! Call The Selected Procedure @Menu ! . . . . *Menu*************************************************************************** @ProcName PROCEDURE !!New Menu Model Procedure Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields MENU,USE(Menu_Field),REQ !!Remove "?" From Use @CHOICES . . Menu_Field STRING(80) !!Add This Variable EJECT CODE OPEN(Screen) !Open The Menu Screen SETCURSOR !Turn Off Any Cursor @Setup !Call Setup Procedure LOOP !Loop Until User Exits @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Turn Off All Alerted Keys ALERT(Reject_Key) !Alert Screen Reject Key ALERT(Accept_Key) !Alert Screen Accept Key ALERT(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key @Alert !Alert Hot Keys ACCEPT !Read A Field Or Menu Choice @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key !!If Reject Key Pressed RETURN !! Return ELSIF KEYCODE() = Shft_Tab | !!Elsif Shft_Tab Pressed AND FIELD() ~= ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go Back One Field ELSIF KEYCODE() = Tab_Key !!Elsif Tab Key Pressed UPDATE(?) !! Update Current Field . !!. Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key !On Screen Accept Key UPDATE ! Move All Fields From Screen Edit_Range# = ?Menu_Field - 1 ! And Edit Remaining Fields SELECT(?Menu_Field) ! If Ok Then Start Here Next . ! LOOP Field# = FIELD() TO Edit_Range# !Edit Fields In The Edit Range CASE Field# !Jump To Field Edit Routine OF ?First_Field !From The First Field IF KEYCODE() = Esc_Key THEN RETURN. ! Return On Esc Key @Edits !Edit Routines Go Here OF ?Menu_Field !From The Menu Field EXECUTE CHOICE() ! Call The Selected Procedure @Menu ! . . . . *MainMenu*********************************************************************** @ProcName PROCEDURE !!This Is A New Modified Proc Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields MENU,USE(Menu_Field),REQ !!Remove "?" From Use @Choices . . Menu_Field STRING(80) !!Add This Variable EJECT CODE OPEN(Screen) !Open The Menu Screen SETCURSOR !Turn Off Any Cursor @Setup !Call Setup Procedure LOOP !Loop Until User Exits @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Turn Off All Alerted Keys ALERT(Accept_Key) !Alert Screen Accept Key ALERT(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key @Alert !Alert Hot Keys ACCEPT !Read A Field Or Menu Choice @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Shft_Tab | !!If Shft_Tab Pressed AND FIELD() ~= ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go Back One Field ELSIF KEYCODE() = Tab_Key !!Elsif Tab Key Pressed UPDATE(?) !! Update Current Field . !!. 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 @Edits !Edit Routines Go Here OF ?Menu_Field !From The Menu Field EXECUTE CHOICE() ! Call The Selected Procedure @Menu ! . . . . *HorzMenu*********************************************************************** @ProcName PROCEDURE !!New Menu Model Procedure Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields MENU,USE(Menu_Field),REQ !!Remove "?" From Use @CHOICES . . Menu_Field STRING(80) !!Add This Variable Esc_Ok BYTE !!Add This Variable EJECT CODE OPEN(Screen) !Open The Menu Screen SETCURSOR !Turn Off Any Cursor Esc_Ok = True !!Turn On Esc & Ctrl-Esc @Setup !Call Setup Procedure LOOP !Loop Until User Exits @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Turn Off All Alerted Keys ALERT(Accept_Key) !Alert Screen Accept Key IF Esc_Ok !!IF Esc & Ctrl-Esc On ALERT(Reject_Key) ! Alert Screen Reject Key . !!. @Alert !Alert Hot Keys ALIAS(Down_Key,Enter_Key) !!Make Down Key Another Enter ACCEPT !Read A Field Or Menu Choice ALIAS(Down_Key,Down_Key) @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key THEN RETURN. !!Return On Reject Key. Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key !!If Screen Accept 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 AND Esc_Ok !! If Esc Key Pressed RETURN !! Exit From Menu . !! . @Edits !Edit Routines Go Here OF ?Menu_Field !From The Menu Field EXECUTE CHOICE() ! Call The Selected Procedure @Menu ! . . . . *VertMenu*********************************************************************** @ProcName PROCEDURE !!New Menu Model Procedure Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields MENU,USE(Menu_Field),REQ !!Remove "?" From Use @CHOICES . . Menu_Field STRING(80) !!Add This Variable EJECT CODE OPEN(Screen) !Open The Menu Screen SETCURSOR !Turn Off Any Cursor @Setup !Call Setup Procedure LOOP !Loop Until User Exits @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Turn Off All Alerted Keys ALERT(Accept_Key) !Alert Screen Accept Key ALERT(Reject_Key) !Alert Screen Reject Key ALERT(Right_Key) !!Alert Right Key ALERT(Left_Key) !!Alert Left Key @Alert !Alert Hot Keys ACCEPT !Read A Field Or Menu Choice UPDATE(?) !Update Menu Choice For Sticky @CheckHot !On Hot Key, Call Procedure Edit_Range# = FIELD() !!Move !Set One Field Edit Range CASE KEYCODE() !!Check key OF Reject_Key !! If Reject Key RETURN !! Return OF Left_Key !! If Left Key PutKbd('<0,75,0,80>') !! Push Keys: Left, Down RETURN !! Return To Main Menu OF Right_Key !! If Right Key PutKbd('<0,77,0,80>') !! Push Keys: Right, Down RETURN !! Return To Main Menu OF Accept_Key !!Change !! If Accept Key UPDATE !!Move ! Move All Fields From Scr Edit_Range# = ?Menu_Field - 1 !!Move ! Edit Remaining Fields SELECT(?Menu_Field) !!Move ! Start Here Next . LOOP Field# = FIELD() TO Edit_Range# !Edit Fields In The Edit Range CASE Field# !Jump To Field Edit Routine OF ?First_Field !From The First Field IF KEYCODE() = Esc_Key THEN RETURN. ! Return On Esc Key. @Edits !Edit Routines Go Here OF ?Menu_Field !From The Menu Field EXECUTE CHOICE() ! Call The Selected Procedure @Menu ! . . . . *Table************************************************************************** @ProcName PROCEDURE Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields @PrePoint REPEAT(@Count),EVERY(@PRows),INDEX(Ndx) @PLoc POINT(@PRows,@Cols),USE(?Point),ESC(?-1) @ScrollVariables . . Ndx BYTE !Repeat Index For Point Field Row BYTE !Actual Row Of Scroll Area Col BYTE !Actual Column Of Scroll Area Max LONG !Lesser Of Count And Records Count BYTE(@Count) !Number Of Items To Scroll Rows BYTE(@Rows) !Number Of Rows To Scroll Cols BYTE(@Cols) !Number Of Columns To Scroll Add_Ok BYTE !!Flag For Adds Chg_Ok BYTE !!Flag For Changes Del_Ok BYTE !!Flag For Deletes @SAVETOTALS EJECT CODE Relocate_# = False Action# = Action !Save Action OPEN(Screen) !Open The Screen SetCursor !Turn Off Any Cursor Add_Ok=1; Chg_Ok=1; Del_Ok=1 !!Set Flags @Setup !Call Setup Procedure Ndx = 1 !Put Selector Bar On Top Item Row = ROW(?Point) !Remember Top Row And Col = COL(?Point) ! Left Column Of Scroll Area @TOTALCALC !BUILD TABLE TOTAL FIELDS IF Action = eView !If This Is A Lookup Request SET(@KeyName,@KeyName); ChkErr ! Find It In The File NEXT(@FileName) !!No ChkErr ! And Read It Pointer# = POINTER(@FileName) ! Save Pointer To Current SKIP(@FileName,-1) ! Make It The Top Record DO Show_Table ! Fill Scroll Area GET(@FileName,Pointer#) !!No ChkErr ! And Refresh Current Record ELSE !Otherwise SET(@KeyName); ChkErr ! Set To First Record In File DO Show_Table ! Fill Scroll Area . Records# = True !Initialize Records Flag LOOP !Loop Until User Exits Mem:Message = CENTER(Mem:Message) !!Center Message 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 IF Add_Ok !! If Ok To Add Records CLEAR(@Pre:Record) ! Clear Record Area Action = eAdd ! Set Action To Add @AutoNumKey ! Auto Increment Key Field @UPDATE ! Call Form For First Record IF ~RECORDS(@KeyName) THEN BREAK. ! If Add Aborted Then Exit DO SHOW_RECORD ! PERFORM ALL CALCULATIONS @TOTPLUS ! UPDATE TOTAL FIELDS SET(@KeyName); ChkErr ! Set To New Record DO Show_Table ! Fill Scroll Area Ndx = 1 ! Put Selector On Top Item Max = 1 ! Maximum Displayed Is 1 ELSE !! Else (No Adds Allowed) NoRecs !! Tell User BREAK !! Break From Screen Loop . . !. . ALERT !Reset Alerted Keys ALERT(Reject_Key) !Alert Screen Reject Key ALERT(Accept_Key) !Alert Screen Accept Key ALERT(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key @Alert !Alert Hot Key ACCEPT !Read A Field @TableHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key !!If Reject Key Pressed BREAK !! Break ELSIF KEYCODE() = Shft_Tab | !!Else If Shft-Tab Pressed AND FIELD() ~= ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go To Previous Field ELSIF KEYCODE() = Tab_Key !!Else If Tab Pressed UPDATE(?) !! Update Current Field . !!. 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 | ! Return On Esc Key OR Records# = False ! Or No Records RETURN . @Edits !Edit Routines Go Here Records# = True ! Assume Records Are Here @InitLocate !Show Cursor For Locator OF ?Point !From The Point Field @Locate CASE KEYCODE() ! Process The Keystroke OF Ins_Key !Insert Key IF Add_Ok !! If Ok To Add Records CLEAR(@Pre:Record) ! Clear Record Area Action = eAdd ! Set Action To Add @AutoNumKey ! Auto Increment Key Field @TOTCHECK ! SAVE TOTAL FIELD AMOUNT @Update ! Call Form For New Record @AUTONUMESC ! RECORD NOT ADDED IF ~Action ! If A New Record Was Added Pointer# = POINTER(@FileName) ! Remember Which Record SET(@KeyName,@KeyName); ChkErr ! Set To New Record And SKIP(@FileName,-1) ! Make It The Top Item DO Show_Table ! Display That Page . ! . ELSE !! Else (No Adds Allowed) Mem:Message='You may not add records!'!! Inform User BEEP !! Beep . !! . OF Enter_Key !Enter Key Or OROF Accept_Key !Ctrl Enter Key DO Get_Record ! Read The Selected Record IF Action = eView | ! If This Is A Lookup Request AND KEYCODE() = Enter_Key ! Action = eDone ! Set Action To Complete RETURN ! And Return To Caller . ! IF Chg_Ok !! If Ok To Change Records Action = eChange ! 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); ChkErr ! Set To Changed Record SKIP(@FileName,-1) ! Make It The Top Item DO Show_Table ! And Display That Page ELSE ! Otherwise SKIP(@FileName,Max-Ndx); ChkErr ! Skip Back To Same Page . ! . ELSE !! Else (Changes Not Allowed) Action = eView !! Set Action To View @Update !! Call Form To View Record SKIP(@FileName,Max-Ndx); ChkErr !! Skip Back To Same Page . !!. OF Del_Key !Delete Key IF Del_Ok !! If Ok To Delete Records DO Get_Record ! Read The Selected Record Action = eDelete ! Set Action To Delete @TOTSAVE ! SAVE TOTAL FIELD AMOUNT @Update ! Call Form To Delete Record IF ~Action ! If Record Was Deleted @TOTMINUS ! SUBTRACT FROM TOTAL FLDS SKIP(@FileName,-Ndx) ! Set Next Record On Top DO Show_Table ! And Display That Page ELSE ! Otherwise SKIP(@FileName,(Max-Ndx)) ! Skip Back To Same Page . ! . ELSE !! Else (Deletes Not Allowed) Mem:Message='You may not delete records!'!! Inform User BEEP !! Beep . !! . 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); ChkErr ! Read The Bottom Record DO Show_Record ! And Display It . OF PgDn_Key !Page Down Key IF EOF(@FileName) ! On The Last Page Ndx = Max ! Point To Bottom Item ELSE ! Otherwise DO Show_Table ! Display Next Page . OF Ctrl_PgDn !Ctrl-Page Down Key Ndx = Max ! Point To Bottom Item IF NOT EOF(@FileName) ! On The Last Page SET(@KeyName); ChkErr ! Set To Bottom Record Minus SKIP(@FileName,-Count) ! One Page Of Records DO Show_Table ! Display The Last Page . OF Up_Key !Up Arrow Key SKIP(@FileName,-(Count-1)) ! Set To Top Record Minus 1 IF NOT BOF(@FileName) ! If There Is A Prior Record PREVIOUS(@FileName) ! Read The Top Record IF NOT ERROR() ! If Read A Record SCROLL(Row,Col,Rows,Cols,-(ROWS(?Point)))! Scroll The Screen Down DO Show_Record ! And Display It ELSIF ERRORCODE() = 33 ! Elsif Record Not Available NEXT(@FileName); ChkErr ! Retrieve First One . . SKIP(@FileName,Count-1) ! Set Record For Next Page OF PgUp_Key !Page Up Key SKIP(@FileName,-(Count-1)) ! Set To Top Record Minus One IF BOF(@FileName) ! If There Is No Prior Record Ndx = 1 ! Then Point To Top Item SKIP(@FileName,Count-1) ! Set Record For This Page ELSE ! Otherwise SKIP(@FileName,-(Count+1)) ! Set Record For Prior Page DO Show_Table ! And Display The Page . OF Ctrl_PgUp !Ctrl-Page Up Key SET(@KeyName); ChkErr ! Set To First Record Ndx = 1 ! Point To Top Item DO Show_Table ! And Display The Page . . . . !. RETURN !Return To Caller Show_Table ROUTINE !Display A Page Of Records SKIP(@FileName,Count-1) ! Set To The Bottom Record IF EOF(@FileName) ! For A Partial Page SET(@KeyName); ChkErr ! 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 IF Relocate_# | AND (INRANGE(KEYBOARD(),32,254) | OR KEYBOARD()=BS_Key) EXIT . NEXT(@FileName); ChkErr ! Read The Next Record DO Show_Record ! And Display It IF POINTER(@FileName) = Pointer# !Point To Correct Record Ndx# = Ndx @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 . Relocate_# = False Show_Record ROUTINE !Display A Record @LookupScroll ! Display From Other Files @ShowScroll ! Display String Variables @ComputeScroll ! Display Computed Fields @ConditionalScrl ! Display Conditional Fields @ResultScroll ! Assign Result Fields Get_Record ROUTINE !Read Selected Record SKIP(@FileName,-(Max-Ndx+1)) ! Set To Selected Record NEXT(@FileName) !!No ChkErr ! And Read It Find_Record ROUTINE !Locate Requested Record SET(@KeyName,@KeyName); ChkErr ! Set To Requested Record IF EOF(@FileName) ! If Beyond End Of File PREVIOUS(@FileName); ChkErr ! Get The Last Record ELSE ! Else NEXT(@FileName); ChkErr ! 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#); ChkErr ! Get The Record SET(@KeyName,@KeyName); ChkErr ! Set To The Same Record 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 Add_Ok BYTE !!Flag For Adds Chg_Ok BYTE !!Flag For Changes Del_Ok BYTE !!Flag For Deletes Table TABLE !Table Of Record Keys TblPtr LONG ! Pointer To Data Record Key GROUP,PRE(Tbl) ! Record Key Fields @Components . . @SaveItems @SAVETOTALS EJECT CODE Relocate_# = False Action# = Action !Save Action OPEN(Screen) !Open The Screen SETCURSOR !Turn Off Any Cursor Add_Ok=1; Chg_Ok=1; Del_Ok=1 !!Init Flags @Setup !Call Setup Procedure @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 Mem:Message = CENTER(Mem:Message) !!Center Message 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(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key @Alert !Alert Hot Key ACCEPT !Read A Field Mem:Message = '' !Clear Message Area @TableHot !On Hot Key, Call Procedure IF KEYCODE() = REJECT_KEY !!If Reject Key Pressed BREAK !! Return ELSIF KEYCODE() = Shft_Tab | !!If Shft_Tab Pressed AND FIELD() ~= ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go Back One Field ELSIF KEYCODE() = Tab_Key !!Elsif Tab Key Pressed UPDATE(?) !! Update Current Field . !!. Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key | !On Screen Accept Key AND 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 | ! Return On Esc Key OR Records# = False ! Or No Records FREE(Table) ! Free The Table Of Points RETURN ! Return To Caller . @Edits !Edit Routines Go Here Records# = True ! Assume There Are Records @InitLocate OF ?Point !Process The Point Field IF ~RECORDS(Table) !If There Are No Records IF Add_Ok !! If Ok To Add Records CLEAR(@Pre:Record) ! Clear Record Area UPDATE ! Update All Fields Action = eAdd ! Set Action To Add @AutoNumKey ! Auto Increment Key Field @TOTCHECK ! SAVE TOTAL FIELD AMOUNT @Update ! Call Form For First Record IF ~Action ! If Record Was Added DO Add_Table ! Then Add New Table Entry DO Sort_Table ! Sort The Table DO Show_Table ! And Display First Page . ! . IF ~RECORDS(Table) ! If Add Aborted Try Again Records# = False ! Indicate No Records SELECT(?-1) ! Select Previous Field BREAK ! End The Edits . ! . CYCLE ! Continue The Edit ELSE !! Else (Adds Not Allowed) NoRecs !! Inform User SELECT(?-1) !! Select Previous Field BREAK !! End The Edits . . !. . @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 = eView | ! If This Is A Lookup Request AND KEYCODE() = Enter_Key Action = eDone ! Set Action To Complete FREE(Table) ! Free The Table Of Points RETURN ! Return To Caller . IF Chg_Ok !! If Ok To Add Records Action = eChange ! 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); ChkErr ! Delete Old Table Entry DO Add_Table ! Add New Table Entry DO Sort_Table ! Sort The Table DO Show_Table ! And Display That Page . ! . ELSE !! Else (Changes Not Allowed) Action = eView !! Set Action To View @Update !! Call Proc To View Record . !!. OF Ins_Key !Ins Key IF Add_Ok !! If Ok To Add Records CLEAR(@Pre:Record) ! Clear Record Area Update ! Update All Fields Action = eAdd ! Set Action To Add @AutoNumKey ! Auto Increment Key Field @Update ! Call Form For New Record IF ~Action ! If Record Was Added DO Add_Table ! Add New Table Entry DO Sort_Table ! Sort The Table DO Show_Table ! And Display That Page . ! . ELSE !! Else (Adds Not Allowed) MEM:MESSAGE='You may not add records!'!! Set Error Message BEEP !! Beep . !!. OF Del_Key !Del Key IF Del_Ok !! If Ok To Delete Records 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 = eDelete ! Set Action To Delete @Update ! Call Form To Delete Record IF ~Action ! If Record Was Deleted @TOTMINUS ! SUBTRACT FROM TOTAL FLDS DELETE(Table); ChkErr ! Delete Table Entry DO Show_Table ! And Display That Page . ! . ELSE !! Else (Deletes Not Allowed) Mem:Message='You may not delete records!'!! Inform User BREAK !! Break From Edits . OF Down_Key !Down Arrow Key IF Ptr <= RECORDS(Table)-Count ! If There Are More Entries SCROLL(Row,Col,Rows,Cols,ROWS(?Point)) ! Scroll The Screen Up Ptr += 1 ! Set To The Next Entry DO Show_Record ! And Display The Record . OF PgDn_Key !Page Down Key IF Ptr >= RECORDS(Table)-Count+1 ! On The Last Page Ndx = Count ! Point To Bottom Item . Ptr += Count ! Otherwise TblPtr = -1 ! Not Set To A Record DO Show_Table ! Display The Next Page OF Ctrl_PgDn !Ctrl-Page Down Key Ptr = RECORDS(Table) - Count + 1 ! Set To Last Page Ndx = Count ! Point To Bottom Item TblPtr = -1 ! Not Set To A Record DO Show_Table ! Display The Last Page OF Up_Key !Up Arrow Key IF Ptr > 1 ! If There Is A Prior Record Ptr -= 1 ! Set To Prior Record SCROLL(Row,Col,Rows,Cols,-(ROWS(?Point)))! Scroll The Screen Down DO Show_Record ! Display The Record . OF PgUp_Key !Page Up Key IF Ptr = 1 THEN Ndx = 1. ! On First Page Point To Top Ptr -= Rows ! Otherwise Back Up 1 Page TblPtr = -1 ! Not Set To A Record DO Show_Table ! And Display It OF Ctrl_PgUp !Ctrl-Page Up Ptr = 1 ! Point To First Record Ndx = 1 ! Point To Top Item TblPtr = -1 ! Not Set To A Record DO Show_Table ! And Display The First Page . . . . ! FREE(Table) !Free Memory Table RETURN !And Return To Caller Build_Table ROUTINE !Build Memory Table Free(Table) !!Redundant With Readtable !Empty The Table Clear(@Pre:Record) !!Redundant With Readtable !Make Sure Record Cleared @TOTCLEAR !ZERO TOTAL FIELDS @Restselects !!Redundant With Readtable !Restore Selector Criteria ! Update !!Causes Partial Tables !Update All Fields ! #Result !!Causes Partial Tables !Do Computed Fields Results @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); ChkErr ! 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 IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. 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 . Relocate_# = False Show_Record ROUTINE !Display A Record TblPtr = 0 ! Start With No Record GET(Table,Ptr+Ndx-1) ! Get The Table Entry IF ~ERROR() ! If There Is One GET(@FileName,TblPtr) ! Read A Data Record IF ~ERROR() @RestSelects ! Restore Selector Fields ! #LookupScroll ! Display From Other Files ! #ShowScroll ! Display String Variables ! #ComputeScroll ! Display Computed Fields ! #ConditionalScrl ! Display Conditional Fields ! #ResultScroll ! Assign Result 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); ChkErr ! Get The Table Entry GET(@FileName,TblPtr); ChkErr ! Read The Data Record Find_Record ROUTINE !Locate Requested Record @SetComponents ! Move Them To The Table IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. GET(Table,Key) ! Get The Table Entry IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. Ptr = POINTER(Table) ! Set Record Pointer IF ~Ptr THEN Ptr = RECORDS(Table). ! Set To Last If No Pointer GET(Table,Ptr); ChkErr ! And Read The Data Record IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. DO Show_Table ! Display That Page Same_Page ROUTINE !Set To Same Page Routine DO Sort_Table ! Sort The Table @COMPUTETOTS !CALCULATE TOTAL FIELDS *MarkSelTable******************************************************************* @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 . . Space_Key EQUATE(32) 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 Add_Ok BYTE !!Flag For Adds Chg_Ok BYTE !!Flag For Changes Del_Ok BYTE !!Flag For Deletes Table TABLE,PRE(Tbl) !Table Of Record Keys TblPtr LONG ! Pointer To Data Record Mark STRING(1) Key GROUP ! Record Key Fields @Components . . @SaveItems @SAVETOTALS EJECT CODE Relocate_# = False Action# = Action !Save Action OPEN(Screen) !Open The Screen SETCURSOR !Turn Off Any Cursor Add_Ok=1; Chg_Ok=1; Del_Ok=1 !!Init Flags @Setup !Call Setup Procedure @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 Mem:Message = CENTER(Mem:Message) !!Center Message Max = RECORDS(Table) !!Set Lesser Of File Record IF Max > Count THEN Max = Count. !!Count And Scroll Item Count 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(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key @Alert !Alert Hot Key ACCEPT !Read A Field Mem:Message = '' !Clear Message Area @TableHot !On Hot Key, Call Procedure IF KEYCODE() = REJECT_KEY !!If Reject Key Pressed BREAK !! Return ELSIF KEYCODE() = Shft_Tab | !!If Shft_Tab Pressed AND FIELD() ~= ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go Back One Field ELSIF KEYCODE() = Tab_Key !!Elsif Tab Key Pressed UPDATE(?) !! Update Current Field . !!. Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key | !On Screen Accept Key AND 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 | ! Return On Esc Key OR Records# = False ! Or No Records FREE(Table) ! Free The Table Of Points RETURN ! Return To Caller . @Edits !Edit Routines Go Here Records# = True ! Assume There Are Records @InitLocate OF ?Point !Process The Point Field IF ~RECORDS(Table) !If There Are No Records IF Add_Ok !! If Ok To Add Records CLEAR(@Pre:Record) ! Clear Record Area UPDATE ! Update All Fields Action = eAdd ! Set Action To Add @AutoNumKey ! Auto Increment Key Field @TOTCHECK ! SAVE TOTAL FIELD AMOUNT @Update ! Call Form For First Record IF ~Action ! If Record Was Added DO Add_Table ! Then Add New Table Entry DO Sort_Table ! Sort The Table DO Show_Table ! And Display First Page . ! . IF ~RECORDS(Table) ! If Add Aborted Try Again Records# = False ! Indicate No Records SELECT(?-1) ! Select Previous Field BREAK ! End The Edits . ! . CYCLE ! Continue The Edit ELSE !! Else (Adds Not Allowed) NoRecs !! Inform User SELECT(?-1) !! Select Previous Field BREAK !! End The Edits . . !. . @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 = eView | ! If This Is A Lookup Request AND KEYCODE() = Enter_Key Action = eDone ! Set Action To Complete FREE(Table) ! Free The Table Of Points RETURN ! Return To Caller . IF Chg_Ok !! If Ok To Add Records Action = eChange ! 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); ChkErr ! Delete Old Table Entry DO Add_Table ! Add New Table Entry DO Sort_Table ! Sort The Table DO Show_Table ! And Display That Page . ! . ELSE !! Else (Changes Not Allowed) Action = eView !! Set Action To View @Update !! Call Proc To View Record . !!. OF Ins_Key !Ins Key IF Add_Ok !! If Ok To Add Records CLEAR(@Pre:Record) ! Clear Record Area Update ! Update All Fields Action = eAdd ! Set Action To Add @AutoNumKey ! Auto Increment Key Field @Update ! Call Form For New Record IF ~Action ! If Record Was Added DO Add_Table ! Add New Table Entry DO Sort_Table ! Sort The Table DO Show_Table ! And Display That Page . ! . ELSE !! Else (Adds Not Allowed) MEM:MESSAGE='You may not add records!'!! Set Error Message BEEP !! Beep . !!. OF Del_Key !Del Key IF Del_Ok !! If Ok To Delete Records 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 = eDelete ! Set Action To Delete @Update ! Call Form To Delete Record IF ~Action ! If Record Was Deleted @TOTMINUS ! SUBTRACT FROM TOTAL FLDS DELETE(Table); ChkErr ! Delete Table Entry DO Show_Table ! And Display That Page . ! . ELSE !! Else (Deletes Not Allowed) Mem:Message='You may not delete records!'!! Inform User BREAK !! Break From Edits . OF Down_Key !Down Arrow Key IF Ptr <= RECORDS(Table)-Count ! If There Are More Entries SCROLL(Row,Col,Rows,Cols,ROWS(?Point)) ! Scroll The Screen Up Ptr += 1 ! Set To The Next Entry DO Show_Record ! And Display The Record . OF PgDn_Key !Page Down Key IF Ptr >= RECORDS(Table)-Count+1 ! On The Last Page Ndx = Count ! Point To Bottom Item . Ptr += Count ! Otherwise TblPtr = -1 ! Not Set To A Record DO Show_Table ! Display The Next Page OF Ctrl_PgDn !Ctrl-Page Down Key Ptr = RECORDS(Table) - Count + 1 ! Set To Last Page Ndx = Count ! Point To Bottom Item TblPtr = -1 ! Not Set To A Record DO Show_Table ! Display The Last Page OF Up_Key !Up Arrow Key IF Ptr > 1 ! If There Is A Prior Record Ptr -= 1 ! Set To Prior Record SCROLL(Row,Col,Rows,Cols,-(ROWS(?Point)))! Scroll The Screen Down DO Show_Record ! Display The Record . OF PgUp_Key !Page Up Key IF Ptr = 1 THEN Ndx = 1. ! On First Page Point To Top Ptr -= Rows ! Otherwise Back Up 1 Page TblPtr = -1 ! Not Set To A Record DO Show_Table ! And Display It OF Ctrl_PgUp !Ctrl-Page Up Ptr = 1 ! Point To First Record Ndx = 1 ! Point To Top Item TblPtr = -1 ! Not Set To A Record DO Show_Table ! And Display The First Page . . . . ! FREE(Table) !Free Memory Table RETURN !And Return To Caller Build_Table ROUTINE !Build Memory Table Free(Table) !!Redundant With Readtable !Empty The Table Clear(@Pre:Record) !!Redundant With Readtable !Make Sure Record Cleared @TOTCLEAR !ZERO TOTAL FIELDS @Restselects !!Redundant With Readtable !Restore Selector Criteria ! Update !!Causes Partial Tables !Update All Fields ! #Result !!Causes Partial Tables !Do Computed Fields Results @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); ChkErr ! 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 IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. 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 . Relocate_# = False Show_Record ROUTINE !Display A Record TblPtr = 0 ! Start With No Record GET(Table,Ptr+Ndx-1) ! Get The Table Entry IF ~ERROR() ! If There Is One GET(@FileName,TblPtr) ! Read A Data Record IF ~ERROR() @RestSelects ! Restore Selector Fields ! #LookupScroll ! Display From Other Files ! #ShowScroll ! Display String Variables ! #ComputeScroll ! Display Computed Fields ! #ConditionalScrl ! Display Conditional Fields ! #ResultScroll ! Assign Result 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); ChkErr ! Get The Table Entry GET(@FileName,TblPtr); ChkErr ! Read The Data Record Find_Record ROUTINE !Locate Requested Record @SetComponents ! Move Them To The Table IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. GET(Table,Key) ! Get The Table Entry IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. Ptr = POINTER(Table) ! Set Record Pointer IF ~Ptr THEN Ptr = RECORDS(Table). ! Set To Last If No Pointer GET(Table,Ptr); ChkErr ! And Read The Data Record IF Relocate_# AND (INRANGE(KEYBOARD(),32,254) OR KEYBOARD()=BS_Key); EXIT. DO Show_Table ! Display That Page Same_Page ROUTINE !Set To Same Page Routine DO Sort_Table ! Sort The Table @COMPUTETOTS !CALCULATE TOTAL FIELDS *NormForm*********************************************************************** @ProcName PROCEDURE !Normal Form With View Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields @Pause ENTRY,USE(?Last_Field) PAUSE(''),USE(?Pause) !!Change To ?Pause . EJECT CODE OPEN(Screen) !Open The Screen SETCURSOR !Turn Off Any Cursor @Setup !Call Setup Procedure DISPLAY !Display The Fields EXECUTE Action !Set The Current Record Pointer Pointer# = 0 ! No Record For Add Pointer# = POINTER(@FileName) ! Current Record For Change Pointer# = POINTER(@FileName) ! Current Record For Delete Pointer# = POINTER(@FileName) !! Current Record For View . LOOP !Loop Thru All The Fields Mem:Message = CENTER(Mem:Message) !!Center Action Message @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Reset Alerted Keys ALERT(Accept_Key) !Alert Screen Accept Key ALERT(Reject_Key) !Alert Screen Reject Key @Alert !Alert Hot Key ACCEPT !Read A Field @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key THEN RETURN. !Return On Screen Reject Key EXECUTE Action !Set Action Message Mem:Message = 'Record will be added' ! Mem:Message = 'Record will be changed' ! Mem:Message = 'Press <<Enter> to delete' ! Mem:Message = 'Press <<Enter> to continue' !! . ! Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key !On Screen Accept Key UPDATE ! Move All Fields From Screen Edit_Range# = FIELDS() ! And Edit Remaining Fields . ! LOOP Field# = FIELD() TO Edit_Range# !Edit Fields In The Edit Range CASE Field# !Jump To Field Edit Routine OF ?First_Field !From The First Field IF KEYCODE() = Esc_Key THEN RETURN. ! Return On Esc Key IF Action = eDelete OR Action = eView !! If Action Is Delete Or View SELECT(?Pause) !! Select Pause Field . !! . @Edits !Edit Routines Go Here OF ?Last_Field !From The Last Field EXECUTE Action ! Update The File ADD(@FileName) ! Add New Record PUT(@FileName) ! Change Existing Record DELETE(@FileName) ! Delete Existing Record . ! . ChkErr ! Check For Errors PUT(@FileName2); ChkErr ! Update Secondary Files PUT(@FileName3); ChkErr ! Update Secondary Files PUT(@FileName4); ChkErr ! Update Secondary Files @NextForm ! Call Next Form Procedure Action = eDone ! Set Action To Complete RETURN ! And Return To Caller OF ?Pause !From The Pause 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 . . . . *Form*************************************************************************** @ProcName PROCEDURE !Form With View, Up, Sh/Tab Screen SCREEN PRE(Scr),@ScreenOpt @Paints @Strings @Variables ENTRY,USE(?First_Field) @Fields @Pause ENTRY,USE(?Last_Field) PAUSE(''),USE(?Pause) !!Change To ?Pause . Up_Ok BYTE Tab_Ok BYTE EJECT CODE Changed_# = False OPEN(Screen) !Open The Screen SETCURSOR !Turn Off Any Cursor Up_Ok=True; Tab_Ok=True @Setup !Call Setup Procedure DISPLAY !Display The Fields EXECUTE Action !Set The Current Record Pointer Pointer# = 0 ! No Record For Add Pointer# = POINTER(@FileName) ! Current Record For Change Pointer# = POINTER(@FileName) ! Current Record For Delete Pointer# = POINTER(@FileName) !! Current Record For View . LOOP !Loop Thru All The Fields Mem:Message = CENTER(Mem:Message) !!Center 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 IF Up_Ok ALERT(Up_Key) !!Alert Cursor Up Key . IF Tab_Ok ALERT(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key . @Alert !Alert Hot Key ACCEPT !Read A Field IF REFER() THEN Changed_# = TRUE. @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key !!If Reject Key Pressed IF Changed_# CASE AbortEditYN_() OF 'Y'; RETURN OF 'N'; SELECT(?) CYCLE OF 'S'; SELECT(?Last_Field) CYCLE . ELSE RETURN . ELSIF (KEYCODE() = Up_Key | !!Elsif (Up_Key Pressed OR KEYCODE() = Shft_Tab) | !!Or Shft_Tab Pressed) AND FIELD() > ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go Back One Field CYCLE !! Loop For More Field Input ELSIF KEYCODE() = Tab_Key !!Elsif Tab Key Pressed UPDATE(?) !! Update Current Field . !!. EXECUTE Action !Set Action Message Mem:Message = 'Record will be added' ! Mem:Message = 'Record will be changed' ! Mem:Message = 'Press <<Enter> to delete' ! Mem:Message = 'Press <<Enter> to continue' !! . 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 IF Changed_# CASE AbortEditYN_() OF 'Y'; RETURN OF 'N'; SELECT(?) BREAK OF 'S'; SELECT(?Last_Field) Field# = ?Last_Field-1 CYCLE . ELSE RETURN . ELSIF Action = eDelete OR Action = eView !! If Action Is Delete Or View SELECT(?Pause) !! Select Pause Field BREAK . !! . @Edits !Edit Routines Go Here OF ?Last_Field !From The Last Field EXECUTE Action ! Update The File ADD(@FileName) ! Add New Record PUT(@FileName) ! Change Existing Record DELETE(@FileName) ! Delete Existing Record . ! . ChkErr ! Check For Errors PUT(@FileName2); ChkErr ! Update Secondary Files PUT(@FileName3); ChkErr ! Update Secondary Files PUT(@FileName4); ChkErr ! Update Secondary Files @NextForm ! Call Next Form Procedure Action = eDone ! Set Action To Complete RETURN ! And Return To Caller OF ?Pause !From The Delete/View 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 . . . . *NormMemForm******************************************************************** @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 Mem:Message = CENTER(Mem:Message) !Center Action Message @Lookups !Display From Other Files @Show !Display String Variables @Compute !Display Computed Fields @Conditional !Display Conditional Fields @Result !Move Resulting Values ALERT !Reset Alerted Keys ALERT(Accept_Key) !Alert Screen Accept Key ALERT(Reject_Key) !Alert Screen Reject Key @Alert !Alert Hot Key ACCEPT !Read A Field @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key THEN RETURN. !Return On Screen Reject Key Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key !On Screen Accept Key UPDATE ! Move All Fields From Screen Edit_Range# = FIELDS() ! And Edit Remaining Fields . ! LOOP Field# = FIELD() TO Edit_Range# !Edit Fields In The Edit Range CASE Field# !Jump To Field Edit Routine OF ?First_Field !From The First Field IF KEYCODE() = Esc_Key THEN RETURN. ! Return On Esc Key @Edits !Edit Routines Go Here OF ?Last_Field !From The Last Field PUT(@FileName2); ChkErr ! Update Secondary Files PUT(@FileName3); ChkErr ! Update Secondary Files PUT(@FileName4); ChkErr ! Update Secondary Files @NextForm ! Call Next Form Procedure Action = eDone ! Set Action To Complete RETURN ! And Return To Caller . . . *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 Mem:Message = CENTER(Mem:Message) !Center 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(Up_Key) !!Alert Cursor Up Key ALERT(Tab_Key) !!Alert Tab Key ALERT(Shft_Tab) !!Alert Shift-Tab Key @Alert !Alert Hot Key ACCEPT !Read A Field @CheckHot !On Hot Key, Call Procedure IF KEYCODE() = Reject_Key !!If Reject Key Pressed RETURN !! Return ELSIF (KEYCODE() = Up_Key | !!Elsif (Up_Key Pressed OR KEYCODE() = Shft_Tab) | !!Or Shft_Tab Pressed) AND FIELD() ~= ?First_Field !!And Not First Field UPDATE(?) !! Update Current Field SELECT(?-1) !! Go Back One Field CYCLE !! Loop For More Field Input ELSIF KEYCODE() = Tab_Key !!Elsif Tab Key Pressed UPDATE(?) !! Update Current Field . !!. Edit_Range# = FIELD() !Set One Field Edit Range IF KEYCODE() = Accept_Key !On Screen Accept Key UPDATE ! Move All Fields From Screen Edit_Range# = FIELDS() ! And Edit Remaining Fields . ! LOOP Field# = FIELD() TO Edit_Range# !Edit Fields In The Edit Range CASE Field# !Jump To Field Edit Routine OF ?First_Field !From The First Field IF KEYCODE() = Esc_Key THEN RETURN. ! Return On Esc Key @Edits !Edit Routines Go Here OF ?Last_Field !From The Last Field PUT(@FileName2); ChkErr ! Update Secondary Files PUT(@FileName3); ChkErr ! Update Secondary Files PUT(@FileName4); ChkErr ! Update Secondary Files @NextForm ! Call Next Form Procedure Action = eDone ! Set Action To Complete RETURN ! And Return To Caller . . . *Report************************************************************************* @PROCNAME PROCEDURE REPORT @REPORT @SAVEITEMS CODE DONE# = 0 !TURN OFF DONE FLAG @SETUP !CALL SETUP PROCEDURE @INITSELECTS !SAVE SELECTOR FIELDS CLEAR(@PRE:RECORD) !MAKE SURE RECORD CLEARED @RESTSELECTS !RESTORE SELECTOR CRITERIA BUILD(@INDEX) !BUILD FILE INDEX @INITREPORT !INIT REPORT VARIABLES @RPTHEADER !DO REPORT HEADER COMPUTES PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE @PRINTMEMO !PRINT ANY MEMO FILES CLOSE(TITLE) !CLOSE TITLE REPORT @SETFILE !SET TO FIRST RECORD @PAGEFOOTER !DO PAGE FOOTER COMPUTES @PAGEHEADER !DO PAGE HEADER COMPUTES DO NEXT_RECORD !READ FIRST RECORD @PAGEHEADER !DO PAGE HEADER COMPUTES OPEN(REPORT) !OPEN THE REPORT @FIRSTBREAK !PRINT INITIAL BREAK HEADERS LOOP UNTIL DONE# !READ ALL RECORDS IN FILE SAVE_LINE# = MEM:LINE ! SAVE LINE NUMBER LAST_REC# = POINTER(@FILENAME) @RUNTOTALS ! ACCUMULATE RUNNING TOTALS @INITDETAIL ! SET UP FOR DETAIL LINE PRINT(RPT:DETAIL) ! PRINT DETAIL LINES DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED @PRINTMEMO ! PRINT ANY MEMO FIELD @TOTALS ! ACCUMULATE TOTALS @PAGEFOOTER ! DO PAGE FOOTER COMPUTES @PAGEHEADER ! DO PAGE HEADER COMPUTES @PAGEEJECT ! GO TO NEW PAGE DO NEXT_RECORD ! GET NEXT RECORD @CHECKBREAK ! CHECK FOR BREAK . ! @LASTBREAK ! PRINT ENDING BREAK FOOTERS @RPTFOOTER !DO REPORT FOOTER COMPUTES PRINT(RPT:RPT_FOOT) !PRINT GRAND TOTALS DO CHECK_PAGE ! DO PAGE BREAK IF NEEDED @PRINTMEMO ! PRINT ANY MEMO FIELD CLOSE(REPORT) !CLOSE REPORT RETURN !RETURN TO CALLER NEXT_RECORD ROUTINE !GET NEXT RECORD LOOP UNTIL EOF(@FILENAME) ! READ UNTIL END OF FILE NEXT(@FILENAME) ! READ NEXT RECORD @CHECKSELECT ! STOP IF PAST SELECTOR @DETAIL ! DO DETAIL COMPUTES IF ~(@FILTER) THEN CYCLE. ! IF FILTERED OUT, GET NEXT EXIT ! EXIT THE ROUTINE . ! DONE# = 1 ! ON EOF, SET DONE FLAG CHECK_PAGE ROUTINE !CHECK FOR NEW PAGE IF MEM:LINE <= SAVE_LINE# ! ON PAGE OVERFLOW SAVE_LINE# = MEM:LINE ! RESET LINE NUMBER @INITPAGE ! INIT PAGE VARIABLES . LOOP UNTIL NOT KEYBOARD() !LOOK FOR KEYSTROKE ASK IF KEYCODE() = REJECT_KEY THEN RETURN. !ABORT REPORT . @BREAKRTN !CHECK FOR GROUP BREAK *MemReport********************************************************************** @PROCNAME PROCEDURE REPORT @REPORT CODE @SETUP !CALL SETUP PROCEDURE @INITREPORT !INIT REPORT VARIABLES @RPTHEADER !DO REPORT HEADER COMPUTES PRINT(TTL:RPT_HEAD) !PRINT TITLE PAGE @MEMMEMO !PRINT ANY MEMO FILES CLOSE(TITLE) !CLOSE TITLE REPORT @PAGEFOOTER !DO PAGE FOOTER COMPUTES @PAGEHEADER !DO PAGE HEADER COMPUTES OPEN(REPORT) !OPEN REPORT BODY @MEMMEMO !PRINT ANY MEMO FIELD @DETAIL !DO DETAIL COMPUTES @RUNTOTALS !ACCUMULATE RUNNING TOTALS @INITDETAIL !SET UP FOR DETAIL RECORD PRINT(RPT:DETAIL) !PRINT DETAIL LINES @MEMMEMO !PRINT ANY MEMO FIELD @TOTALS !ACCUMULATE TOTALS @MEMMEMO !PRINT ANY MEMO FIELD @PAGEFOOTER !DO PAGE FOOTER COMPUTES @RPTFOOTER !DO REPORT FOOTER COMPUTES PRINT(RPT:RPT_FOOT) !PRINT REPORT FOOTER @MEMMEMO !PRINT ANY MEMO FIELD CLOSE(REPORT) !CLOSE REPORT RETURN !RETURN TO CALLER *PrintMemo********************************************************************** @MemoLen !Determine Memo Size J# = 2 !Start With Second Row LOOP !Loop Thru All Used Rows MemoDone# = False !! No Memos Done Yet @SetMemo ! Set The Memo Variables IF MemoDone# = False THEN BREAK. !! All Memos Printed @PrtDetail ! And Print It J# += 1 ! Increment Counter DO Check_Page ! Do Page Break If Needed . DO Check_Page !Do Page Break If Needed *SetMemo************************************************************************ IF J# <= @MemoTmp# !If In The Range Of This Memo @MemoVar = @MemoRow[J#] ! Move A Memo Field Row MemoDone# = True !! 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); ChkErr !Print The Detail Record *MemMemo************************************************************************ @MemoLen !Determine Memo Size J# = 2 !Start With Row 2 LOOP !Loop Thru All Used Rows MemoDone# = False !! No Memos Done Yet @SetMemo ! Set The Memo Variables IF MemoDone# = False 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 !!Add This Screen Screen SCREEN WINDOW(4,42),AT(10,20),HUE(7,4) ROW(1,42) PAINT(1,1),TRN ROW(4,1) PAINT(1,1),TRN ROW(1,1) STRING('╔═{39}╗'),ENH ROW(2,1) STRING('║<0{39}>║'),ENH ROW(3,1) STRING('╚═{39}╝'),ENH ROW(2,42) REPEAT(2);STRING('░'),HUE(7,0) . ROW(4,2) STRING('░{41}'),HUE(7,0) ROW(2,3) STRING('This procedure hasn''t been completed!') | HUE(11,4) . CODE !Code Section OPEN(Screen) !!Open Screen BEEP !!Beep ASK !!Wait For A Keystroke 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 IF Pointer# !! If There Is A Current Rec GET(@FileName,Pointer#); ChkErr ! 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 . . CLEAR(@Pre:Record) !!Clear Record IF Pointer# !!If There Is A Current Rec GET(@FileName,Pointer#); ChkErr ! Re-Read The Old Record . !! UPDATE ! And Re-Update The Record *SetTop************************************************************************* SET(@KeyName); ChkErr !Set To First Record *SetSelect********************************************************************** SET(@KeyName,@KeyName); ChkErr !Set To First Selected Record *InitLocate********************************************************************* OF ?Pre_Point ! IF KEYCODE() = Esc_Key | ! If Going Up OR KEYCODE() = Up_Key | ! The Screen OR 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************************************************************************* LOOP IF Relocate_# THEN ASK. 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 Relocate_# = False . 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 Relocate_# = True CYCLE !Cycle to get key with ASK . IF Len# ! And Find The Record Relocate_# = True DO Find_Record ELSE Relocate_# = False . IF Relocate_# = False THEN BREAK. . *StrLocate********************************************************************** @LocField = CLIP(Scr:Locator) ! Update The Key Field *PicLocate********************************************************************** @LocField = DEFORMAT(Scr:Locator) ! Update The Key Field *Selector*********************************************************************** CLEAR(@Pre:Record) !!Clear Any Stray Values @RestSelects !!Reset Selector Fields SET(@KeyName,@KeyName); ChkErr !Set At First Selected Record LOOP UNTIL EOF(@FileName) !Loop Until End Of File NEXT(@FileName); ChkErr ! Read A Record @CheckSelect ! Check That It Is Selected DO Add_Table ! And Add To Memory Table . *Filter************************************************************************* BUFFER(@Filename,0.25) !Use 1/4Th Of Memory For Buffer SET(@FileName); ChkErr !Read Data Record Sequence LOOP UNTIL EOF(@FileName) !Loop Until End Of File NEXT(@FileName); ChkErr ! 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 = eView ! Request Table Lookup @Lookup ! Call Lookup Procedure @Field = @AccessField ! Move Lookup Field DISPLAY(?@Field) ! And Display It IF Action !! No Selection Was Made SELECT(?@Field) !! Action = Action# !! BREAK !! . !! Action = Action# ! Restore Action . *AutoTable********************************************************************** @AccessField = @Field !Move Related Fields GET(@FileName,@AccessKey) !Read The Record Action# = Action !Save Action Action = eView !Request Table Lookup @Lookup !Call Lookup Procedure @LookField = @AccessField !Save Lookup Field @Field = @AccessField !Move Lookup Field DISPLAY(?@Field) !And Display It IF Action THEN SELECT(?@Field-1). !No Selection Was Made Action = Action# !Restore Action *HotTable*********************************************************************** IF KEYCODE() = @HotKey !If Hot Key Pressed UPDATE ! Update All Fields @AccessField = @Field ! Move Related Fields GET(@FileName,@AccessKey) ! Read The Record Action# = Action ! Save Action Action = eView ! Request Table Lookup @Lookup ! Call Lookup Procedure @Field = @AccessField ! Move Lookup Field DISPLAY(?@Field) ! And Display It IF Action THEN SELECT(?@Field). ! No Selection Was Made Action = Action# ! Restore Action . *NextForm*********************************************************************** IF Action <> eDelete !If This Is Not A Delete Action = eChange ! 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 IF @AccessField <> @Field @AccessField = @Field !Move Related Key Fields GET(@FileName,@AccessKey) !Read The Record IF ERROR() !!If Not Found CLEAR(@Pre:Record) !! Clear The Record !! SHOW(ROW(#ScrField),COL(#ScrField),'NF') !! Show Short Message !! #ScrField = 'Not Found!' !! Show Long Message . . @ScrField = @LookupField !! Display Lookup Field *LookupScroll******************************************************************* IF @AccessField <> @Field @AccessField = @Field !Move Related Key Fields GET(@FileName,@AccessKey) !Read The Record IF ERROR() !!If Not Found CLEAR(@Pre:Record) !! Clear The Record !! SHOW(ROW(@ScrField),COL(#ScrField),'NF') !! Show Short Message !! #ScrField = 'Not Found!' !! Show Long Message . . @ScrField = @LookupField !! Display Lookup Field *OpenFiles********************************************************************** ! DataFile_ = '@FileName' !!Show Name Of File SHOW(25,1,CENTER('OPENING FILE: ' & '@FILENAME',80)) !DISPLAY FILE NAME OPEN(@FileName) !Open The File IF ERROR() !OPEN RETURNED AN ERROR CASE ERRORCODE() ! CHECK FOR SPECIFIC ERROR OF 46 ! KEYS NEED TO BE REQUILT SETHUE(0,7) ! BLACK ON WHITE SHOW(25,1,CENTER('REBUILDING KEY FILES FOR @FILENAME',80)) !INDICATE MSG BUILD(@FILENAME) ! CALL THE BUILD PROCEDURE SETHUE(7,0) ! WHITE ON BLACK BLANK(25,1,1,80) ! BLANK THE MESSAGE @CREATEFILE ! IF NOT FOUND, THEN CREATE OF 51 BLANK(25,1,1,80) ! BLANK THE MESSAGE ELSE ! ANY OTHER ERROR LOOP;STOP('@FILENAME: ' & ERROR()). ! STOP EXECUTION . . *CreateFile********************************************************************* OF 2 ! IF ERRORCODE() = 2 !If Not Found, Then Create CREATE(@FileName) ChkErr !IS THIS MY ERROR ? DAVID ! . *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 !*CheckBreak********************************************************************* ! IF @Field <> @SaveField THEN BREAK. !Break On New Group *SortTable********************************************************************** SORT(Table,@Component) !Sort Table Into Key Sequence *CheckSelect******************************************************************** IF @Field <> @SaveField THEN BREAK. !Break On End Of Selection *CheckAdd*********************************************************************** IF @Field <> @SaveField THEN EXIT. !Exit On End Of Selection *CheckHot*********************************************************************** IF KEYCODE() = @HotKey !On Hot Key @HotProc ! Call Hot Key Procedure SELECT(?) ! Do Same Field Again CYCLE ! And Loop Again . *TableHot*********************************************************************** IF KEYCODE() = @HotKey !On Hot Key IF FIELD() = ?Point THEN DO Get_Record. ! Read Record If Needed @HotProc ! Call Hot Key Procedure DO Same_Page ! Reset To Same Page DO Show_Table ! Display A Page Of Records CYCLE ! And Loop Again . *BuildTable********************************************************************* Ptr = 1 !Start At Table Entry Ndx = 1 !Put Selector Bar On Top Item DO Build_Table !Build Memory Table Ok Keys *AutoNumKey********************************************************************* DO GET_RECORD !READ CURRENT SCREEN RECORD SAVPTR# = POINTER(@FILENAME) ! AND SAVE POSITION SET(@KEYNAME);ChkErr !SET TO HIGHEST KEY VALUE PREVIOUS(@FILENAME) !READ LAST KEY RECORD IF NOT ERROR() !! KEYFIELD# = @INCFIELD + 1 !!INCREMENT FIELD ELSE KEYFIELD# = 1 !!INCREMENT FIELD . CLEAR(@PRE:RECORD) !CLEAR LAST KEY RECORD @INCFIELD = KEYFIELD# !LOAD KEY FIELD *AUTONUMESC********************************************************************* IF ACTION !FORM WAS NOT COMPLETED @TOTESC !CLEAR TOTAL FIELD CALCULATIONS POINTER# = SAVPTR# !SET POINTER TO PROPER REC GET(@FILENAME,POINTER#) !READ RECORD SET(@KEYNAME,@KEYNAME) !POSITION FILE SKIP(@FILENAME,-1) !BACK UP ONE DO SHOW_TABLE !RE-DISPLAY PAGE . *AutoNumSel********************************************************************* GET(Table,RECORDS(Table)) !Read Highest Key Value IF ERROR() THEN CLEAR(Table). !Zero Fields If Empty Table @RESTSELECTS !LOAD PRIOR KEY FIELDS @INCFIELD = @TABLEFIELD + 1 !LOAD INCREMENT FIELD *Conditional******************************************************************** IF @IfCond !Evaluate Condition @IfCondTrue ! Condition Is True ELSE !Otherwise @IfCondFalse ! Condition Is False . *RUNMAP************************************************************************* PROC(G_RUNPROC) !GLOBAL MODULE RUN PROCEDURE *RUNPROC************************************************************************ G_RUNPROC PROCEDURE(DOSPROG) !GLOBAL RUN PROCEDURE DOSPROG STRING(12) !PROGRAM TO RUN SCREEN SCREEN WINDOW(25,80),HUE(7,0,0). !SAVE WINDOW CODE OPEN(SCREEN) !SAVE CURRENT SCREEN SETCURSOR(25,1) !POSITION CURSOR AT BOTTOM RUN(DOSPROG) !RUN DOS PROGRAM CLOSE(SCREEN) !RESTORE SCREEN RETURN !EXIT BACK TO CALLING MENU *RUNCODE************************************************************************ G_RUNPROC('@RUNDESC') !RUN DOS PROGRAM *FIRSTBREAK********************************************************************* BRK_FLAG# = 0 !CLEAR BREAK LEVEL FLAG DO PRT_BRK_HDRS !PRINT GROUP HEADER(S) *CHECKBREAK********************************************************************* 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 . ********************************************************************************