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
.
********************************************************************************