home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / clarion / brokcode.zip / KW33CORR.EXE / DYNAMIC.MDL next >
Text File  |  1991-07-16  |  58KB  |  1,449 lines

  1. *GLOBAL*************************************************************************
  2.  
  3.          INCLUDE('\clabeta\STD_KEYS.CLA')
  4.          INCLUDE('\clabeta\CTL_KEYS.CLA')
  5.          INCLUDE('\clabeta\ALT_KEYS.CLA')
  6.          INCLUDE('\clabeta\SHF_KEYS.CLA')
  7.  
  8. REJECT_KEY   EQUATE(CTRL_ESC)
  9. ACCEPT_KEY   EQUATE(CTRL_ENTER)
  10. TRUE         EQUATE(1)
  11. FALSE         EQUATE(0)
  12.  
  13.          MAP
  14.            PROC(G_OPENFILES)
  15.            @RUNMAP
  16.            @MODULES
  17.          .
  18.          EJECT('FILE LAYOUTS')
  19.          @FILE
  20.          EJECT('GLOBAL MEMORY VARIABLES')
  21. ACTION         SHORT                 !0 = NO ACTION
  22.                          !1 = ADD RECORD
  23.                          !2 = CHANGE RECORD
  24.                          !3 = DELETE RECORD
  25.                          !4 = LOOKUP FIELD
  26.          @MEMORY
  27.  
  28.          EJECT('CODE SECTION')
  29.   CODE
  30.   SETHUE(7,0)                     !SET WHITE ON BLACK
  31.   BLANK                         !  AND BLANK
  32.   HELP(@HELPFILE)                 !OPEN THE HELP FILE
  33.   G_OPENFILES                     !OPEN OR CREATE FILES
  34.   SETHUE()                     !    THE SCREEN
  35.   @BASEPROC                     !CALL THE BASE PROCEDURE
  36.   RETURN                     !EXIT TO DOS
  37.  
  38. G_OPENFILES  PROCEDURE                 !OPEN FILES & CHECK FOR ERROR
  39.   CODE
  40.   @OPENFILES                     !OPEN EACH FILE
  41.   BLANK                         !BLANK THE SCREEN
  42.  
  43.   @RUNPROC
  44.  
  45. *MENU***************************************************************************
  46. @PROCNAME    PROCEDURE
  47.  
  48. SCREEN         SCREEN      PRE(SCR),@SCREENOPT
  49.               @PAINTS
  50.               @STRINGS
  51.               @VARIABLES
  52.               ENTRY,USE(?FIRST_FIELD)
  53.               @FIELDS
  54.               ENTRY,USE(?PRE_MENU)
  55.               MENU,USE(MENU_FIELD"),REQ
  56.                 @CHOICES
  57.          .          .
  58.  
  59.   EJECT
  60.   CODE
  61.   OPEN(SCREEN)                     !OPEN THE MENU SCREEN
  62.   SETCURSOR                     !TURN OFF ANY CURSOR
  63.   MENU_FIELD" = ''                 !START MENU WITH FIRST ITEM
  64.   @SETUP                     !CALL SETUP PROCEDURE
  65.   LOOP                         !LOOP UNTIL USER EXITS
  66.     @LOOKUPS                     !DISPLAY FROM OTHER FILES
  67.     @SHOW                     !DISPLAY STRING VARIABLES
  68.     @COMPUTE                     !DISPLAY COMPUTED FIELDS
  69.     @RESULT                     !MOVE RESULTING VALUES
  70.     ALERT                     !TURN OFF ALL ALERTED KEYS
  71.     ALERT(REJECT_KEY)                 !ALERT SCREEN REJECT KEY
  72.     ALERT(ACCEPT_KEY)                 !ALERT SCREEN ACCEPT KEY
  73.     @ALERT                     !ALERT HOT KEYS
  74.     ACCEPT                     !READ A FIELD OR MENU CHOICE
  75.     @CHECKHOT                     !ON HOT KEY, CALL PROCEDURE
  76.     IF KEYCODE() = REJECT_KEY THEN RETURN.     !RETURN ON SCREEN REJECT
  77.  
  78.     IF KEYCODE() = ACCEPT_KEY             !ON SCREEN ACCEPT KEY
  79.       UPDATE                     !  MOVE ALL FIELDS FROM SCREEN
  80.       SELECT(?)                     !  START WITH CURRENT FIELD
  81.       SELECT                     !  EDIT ALL FIELDS
  82.       CYCLE                     !  GO TO TOP OF LOOP
  83.     .                         !
  84.  
  85.     CASE FIELD()                 !JUMP TO FIELD EDIT ROUTINE
  86.     OF ?FIRST_FIELD                 !FROM THE FIRST FIELD
  87.       IF KEYCODE() = ESC_KEY THEN RETURN.     !  RETURN ON ESC KEY
  88.  
  89.     @EDITS                     !EDIT ROUTINES GO HERE
  90.     OF ?PRE_MENU                 !PRE MENU FIELD CONDITION
  91.       IF KEYCODE() = ESC_KEY             !  BACKING UP?
  92.     SELECT(?-1)                 !    SELECT PREVIOUS FIELD
  93.       ELSE                     !  GOING FORWARD
  94.     SELECT(?+1)                 !    SELECT MENU FIELD
  95.       .
  96.     OF ?MENU_FIELD"                 !FROM THE MENU FIELD
  97.       EXECUTE CHOICE()                 !  CALL THE SELECTED PROCEDURE
  98.     @MENU                     !
  99.   . . .
  100. *TABLE**************************************************************************
  101. @PROCNAME    PROCEDURE
  102.  
  103. SCREEN         SCREEN      PRE(SCR),@SCREENOPT
  104.               @PAINTS
  105.               @STRINGS
  106.               @VARIABLES
  107.               ENTRY,USE(?FIRST_FIELD)
  108.               @FIELDS
  109.               ENTRY,USE(?PRE_POINT)
  110.               REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX)
  111.           @PLOC        POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1)
  112.                 @SCROLLVARIABLES
  113.          .          .
  114.  
  115. NDX         BYTE                 !REPEAT INDEX FOR POINT AREA
  116. ROW         BYTE                 !ACTUAL ROW OF SCROLL AREA
  117. COL         BYTE                 !ACTUAL COLUMN OF SCROLL AREA
  118. COUNT         BYTE(@COUNT)             !NUMBER OF ITEMS TO SCROLL
  119. ROWS         BYTE(@ROWS)             !NUMBER OF ROWS TO SCROLL
  120. COLS         BYTE(@COLS)             !NUMBER OF COLUMNS TO SCROLL
  121. FOUND         BYTE                 !RECORD FOUND FLAG
  122. NEWPTR         LONG                 !POINTER TO NEW RECORD
  123.  
  124. TABLE         TABLE,PRE(TBL)             !TABLE OF RECORD DATA
  125.            @TABLEFIELDS             !  SCREEN AND KEY COMPONENTS
  126. PTR           LONG                 !  POINTER TO FILE RECORD
  127.          .
  128.          @SAVEITEMS                 !SELECTOR FIELD SAVE AREA
  129.          @SAVETOTALS             !TOTAL FIELD ACCUMULATORS
  130.  
  131.   EJECT
  132.   CODE
  133.   ACTION# = ACTION                 !SAVE ACTION
  134.   OPEN(SCREEN)                     !OPEN THE SCREEN
  135.   SETCURSOR                     !TURN OFF ANY CURSOR
  136.   @SETUP                     !CALL SETUP PROCEDURE
  137.   @INITSELECTS                     !SAVE SELECTOR FIELDS
  138.   @TOTCLEAR                     !ZERO TOTAL ACCUMULATORS
  139.   TBL:PTR = 1                     !START AT TABLE ENTRY
  140.   NDX = 1                     !PUT SELECTOR BAR ON TOP ITEM
  141.   ROW = ROW(?POINT)                 !REMEMBER TOP ROW AND
  142.   COL = COL(?POINT)                 !LEFT COLUMN OF SCROLL AREA
  143.   RECORDS# = TRUE                 !INITIALIZE RECORDS FLAG
  144.   CACHE(@KEYNAME,.25)                 !CACHE KEY FILE
  145.   @BUILDTABLE                     !BUILD SCROLLING TABLE
  146.   LOOP                         !LOOP UNTIL USER EXITS
  147.     ACTION = ACTION#                 !RESTORE ACTION
  148.     @RESTSELECTS                 !RESTORE SELECTOR FIELDS
  149.     @TOTSHOW                     !DISPLAY TOTAL AMOUNTS ON SCRN
  150.     @LOOKUPS                     !DISPLAY FROM OTHER FILES
  151.     @SHOW                     !DISPLAY STRING VARIABLES
  152.     @COMPUTE                     !DISPLAY COMPUTED FIELDS
  153.     @RESULT                     !MOVE RESULTING VALUES
  154.     ALERT                     !RESET ALERTED KEYS
  155.     ALERT(REJECT_KEY)                 !ALERT SCREEN REJECT KEY
  156.     ALERT(ACCEPT_KEY)                 !ALERT SCREEN ACCEPT KEY
  157.     @ALERT                     !ALERT HOT KEYS
  158.     ACCEPT                     !READ A FIELD
  159.  !KW DELETE MEM:MESSAGE
  160.    @TABLEHOT                     !CALL HOT KEY PROCEDURES
  161.     IF KEYCODE() = REJECT_KEY THEN BREAK.     !RETURN ON SCREEN REJECT KEY
  162.  
  163.     IF    KEYCODE() = ACCEPT_KEY      |         !ON SCREEN ACCEPT KEY
  164.     AND FIELD() <> ?POINT             !BUT NOT ON THE POINT FIELD
  165.       UPDATE                     !  MOVE ALL FIELDS FROM SCREEN
  166.       SELECT(?)                     !  START WITH CURRENT FIELD
  167.       SELECT                     !  EDIT ALL FIELDS
  168.       CYCLE                     !  GO TO TOP OF LOOP
  169.     .
  170.  
  171.     CASE FIELD()                 !JUMP TO FIELD EDIT ROUTINE
  172.  
  173.     OF ?FIRST_FIELD                 !FROM THE FIRST FIELD
  174.       IF KEYCODE() = ESC_KEY   |         !  RETURN ON ESC KEY
  175.       OR RECORDS# = FALSE             !  OR NO RECORDS
  176.     BREAK                     !    EXIT PROGRAM
  177.       .
  178.     @EDITS                     !FIELD EDIT ROUTINES
  179.     OF ?PRE_POINT                 !PRE POINT FIELD CONDITION
  180.       IF KEYCODE() = ESC_KEY             !  BACKING UP?
  181.     SELECT(?-1)                 !    SELECT PREVIOUS FIELD
  182.       ELSE                     !  GOING FORWARD
  183.     SELECT(?POINT)                 !    SELECT MENU FIELD
  184.       .
  185.       @INITLOCATE                 !    SHOW CURSOR FOR LOCATOR
  186.     OF ?POINT                     !PROCESS THE POINT FIELD
  187.       IF RECORDS(TABLE) = 0             !IF THERE ARE NO RECORDS
  188.     CLEAR(@PRE:RECORD)             !  CLEAR RECORD AREA
  189.     ACTION = 1                 !  SET ACTION TO ADD
  190.     GET(@FILENAME,0)             !  CLEAR PENDING RECORD
  191.     @AUTONUMKEY                 !  AUTO INCREMENT KEY FIELD
  192.     @TOTACTN                 !  SAVE TOTACTN
  193.     @RESTSELECTS                 !  RESTORE SELECTOR FIELDS
  194.     @UPDATE                     !  CALL FORM FOR NEW RECORD
  195.     NEWPTR = POINTER(@FILENAME)         !    SET POINTER TO NEW RECORD
  196.     DO FIRST_PAGE                 !  DISPLAY THE FIRST PAGE
  197.     IF RECORDS(TABLE) = 0             !  IF THERE AREN'T ANY RECORDS
  198.       RECORDS# = FALSE             !    INDICATE NO RECORDS
  199.       SELECT(?PRE_POINT-1)             !    SELECT THE PRIOR FIELD
  200.     .
  201.     CYCLE                     !    AND LOOP AGAIN
  202.       .
  203.       @LOCATE                     !PERORM LOCATOR LOGIC
  204.       CASE KEYCODE()                 !PROCESS THE KEYSTROKE
  205.  
  206.       OF INS_KEY                 !INS KEY
  207.     CLEAR(@PRE:RECORD)             !  CLEAR RECORD AREA
  208.     ACTION = 1                 !  SET ACTION TO ADD
  209.     GET(@FILENAME,0)             !  CLEAR PENDING RECORD
  210.     @AUTONUMKEY                 !  AUTO INCREMENT KEY FIELD
  211.     @TOTACTN                 !  SAVE TOTALS
  212.     @RESTSELECTS                 !  RESTORE SELECTOR FIELDS
  213.     @UPDATE                     !  CALL FORM FOR NEW RECORD
  214.     IF ~ACTION                 !  IF RECORD WAS ADDED
  215.       NEWPTR = POINTER(@FILENAME)         !    SET POINTER TO NEW RECORD
  216.       DO FIND_RECORD             !    POSITION IN FILE
  217.     .
  218.       OF ENTER_KEY                 !ENTER KEY
  219.       OROF ACCEPT_KEY                 !CTRL-ENTER KEY
  220.     DO GET_RECORD                 !  GET THE SELECTED RECORD
  221.     IF ACTION = 4 AND KEYCODE() = ENTER_KEY!    IF THIS IS A LOOKUP REQUEST
  222.       ACTION = 0                 !    SET ACTION TO COMPLETE
  223.       BREAK                     !    AND RETURN TO CALLER
  224.     .
  225.     IF ~ERROR()                 !  IF RECORD IS STILL THERE
  226.       ACTION = 2                 !    SET ACTION TO CHANGE
  227.       @TOTCHECK                 !    SAVE TOTALS
  228.       @UPDATE                 !    CALL FORM TO CHANGE REC
  229.       IF ACTION THEN CYCLE.             !    IF SUCCESSFUL RE-DISPLAY
  230.       @TOTMINUS                 !    SUBTRACT CURRENT AMOUNTS
  231.     .
  232.     NEWPTR = POINTER(@FILENAME)         !    SET POINTER TO NEW RECORD
  233.     DO FIND_RECORD                 !    POSITION IN FILE
  234.       OF DEL_KEY                 !DEL KEY
  235.     DO GET_RECORD                 !  READ THE SELECTED RECORD
  236.     IF ~ERROR()                 !  IF RECORD IS STILL THERE
  237.       ACTION = 3                 !    SET ACTION TO DELETE
  238.       @TOTCHECK                 !    SAVE TOTALS
  239.       @UPDATE                 !    CALL FORM TO DELETE
  240.       IF ~ACTION                 !    IF SUCCESSFUL
  241.         @TOTMINUS                 !    SUBTRACT CURRENT AMOUNTS
  242.         N# = NDX                 !    SAVE POINT INDEX
  243.         DO SAME_PAGE             !    RE-DISPLAY
  244.         NDX = N#                 !    RESTORE POINT INDEX
  245.     . .
  246.       OF DOWN_KEY                 !DOWN ARROW KEY
  247.     DO SET_NEXT                 !  POINT TO NEXT RECORD
  248.     DO FILL_NEXT                 !  FILL A TABLE ENTRY
  249.     IF FOUND                 !  FOUND A NEW RECORD
  250.       SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) !    SCROLL THE SCREEN UP
  251.       GET(TABLE,RECORDS(TABLE))         !  GET RECORD FROM TABLE
  252.       DO FILL_SCREEN             !  DISPLAY ON SCREEN
  253.     .
  254.  
  255.       OF PGDN_KEY                 !PAGE DOWN KEY
  256.     DO SET_NEXT                 !  POINT TO NEXT RECORD
  257.     DO NEXT_PAGE                 !  DISPLAY THE NEXT PAGE
  258.  
  259.       OF CTRL_PGDN                 !CTRL-PAGE DOWN KEY
  260.     DO LAST_PAGE                 !  DISPLAY THE LAST PAGE
  261.     NDX = RECORDS(TABLE)             !  POSITION POINT BAR
  262.  
  263.       OF UP_KEY                     !UP ARROW KEY
  264.     DO SET_PREV                 !  POINT TO PREVIOUS RECORD
  265.     DO FILL_PREV                 !  FILL A TABLE ENTRY
  266.     IF FOUND                 !  FOUND A NEW RECORD
  267.       SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN
  268.       GET(TABLE,1)                 !  GET RECORD FROM TABLE
  269.       DO FILL_SCREEN             !  DISPLAY ON SCREEN
  270.     .
  271.  
  272.       OF PGUP_KEY                 !PAGE UP KEY
  273.     DO SET_PREV                 !  POINT TO PREVIOUS RECORD
  274.     DO PREV_PAGE                 !  DISPLAY THE PREVIOUS PAGE
  275.  
  276.       OF CTRL_PGUP                 !CTRL-PAGE UP
  277.     DO FIRST_PAGE                 !  DISPLAY THE FIRST PAGE
  278.     NDX = 1                     !  POSITION POINT BAR
  279.   . . .
  280.   FREE(TABLE)                     !FREE MEMORY TABLE
  281.   RETURN                     !AND RETURN TO CALLER
  282.  
  283. SAME_PAGE ROUTINE                 !DISPLAY THE SAME PAGE
  284.   GET(TABLE,1)                     !  GET THE FIRST TABLE ENTRY
  285.   DO FILL_RECORD                 !  FILL IN THE RECORD
  286.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POSITION FILE
  287.   FREE(TABLE)                     !  EMPTY THE TABLE
  288.   DO NEXT_PAGE                     !  DISPLAY A FULL PAGE
  289.  
  290. FIRST_PAGE ROUTINE                 !DISPLAY FIRST PAGE
  291.   BLANK(ROW,COL,ROWS,COLS)
  292.   FREE(TABLE)                     !  EMPTY THE TABLE
  293.   CLEAR(@PRE:RECORD,-1)                 !  CLEAR RECORD TO LOW VALUES
  294.   CLEAR(TBL:PTR)                 !  ZERO RECORD POINTER
  295.   @SETFILE                     !  POSITION FILE POINTERS
  296.   LOOP NDX = 1 TO COUNT                 !  FILL UP THE TABLE
  297.     DO FILL_NEXT                 !    FILL A TABLE ENTRY
  298.     IF NOT FOUND THEN BREAK.             !    GET OUT IF NO RECORD
  299.   .
  300.   NDX = 1                     !  SET TO TOP OF TABLE
  301.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  302.  
  303. LAST_PAGE ROUTINE                 !DISPLAY LAST PAGE
  304.   NDX# = NDX                     !  SAVE SELECTOR POSITION   KW
  305.   BLANK(ROW,COL,ROWS,COLS)             !  CLEAR SCROLLING AREA
  306.   FREE(TABLE)                     !  EMPTY THE TABLE
  307.   CLEAR(@PRE:RECORD,1)                 !  CLEAR RECORD TO HIGH VALUES
  308.   CLEAR(TBL:PTR,1)                 !  CLEAR PTR TO HIGH VALUE
  309.   @SETFILE                     !  POSITION FILE POINTERS
  310.   LOOP NDX = COUNT TO 1 BY -1             !  FILL UP THE TABLE
  311.     DO FILL_PREV                 !    FILL A TABLE ENTRY
  312.     IF NOT FOUND THEN BREAK.             !    GET OUT IF NO RECORD
  313.   .                         !  END OF LOOP
  314.   NDX = NDX#                     !  RESTORE SELECTOR POSITION    KW
  315.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  316.  
  317. FIND_RECORD ROUTINE                 !POSITION TO SPECIFIC RECORD
  318.   SET(@KEYNAME,@KEYNAME,NEWPTR)             !POSITION FILE
  319.   IF NEWPTR = 0                     !NEWPTR NOT SET
  320.     NEXT(@FILENAME)                 !  READ NEXT RECORD
  321.     NEWPTR = POINTER(@FILENAME)             !  SET NEWPTR
  322.     SKIP(@FILENAME,-1)                 !  BACK UP TO DISPLAY RECORD
  323.   .
  324.   FREE(TABLE)                     !  CLEAR THE RECORD
  325.   DO NEXT_PAGE                     !  DISPLAY A PAGE
  326.  
  327. NEXT_PAGE ROUTINE                 !DISPLAY NEXT PAGE
  328.   SAVECNT# = RECORDS(TABLE)             !  SAVE RECORD COUNT
  329.   LOOP COUNT TIMES                 !  FILL UP THE TABLE
  330.     DO FILL_NEXT                 !    FILL A TABLE ENTRY
  331.     IF NOT FOUND                 !    IF NONE ARE LEFT
  332.       IF NOT SAVECNT#                 !    IF REBUILDING TABLE
  333.     DO LAST_PAGE                 !    FILL IN RECORDS
  334.     EXIT                     !    EXIT OUT OF ROUTINE
  335.       .
  336.       BREAK                     !    EXIT LOOP
  337.   . .
  338.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  339.  
  340. SET_NEXT ROUTINE                 !POINT TO THE NEXT PAGE
  341.   GET(TABLE,RECORDS(TABLE))             !  GET THE LAST TABLE ENTRY
  342.   DO FILL_RECORD                 !  FILL IN THE RECORD
  343.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POSITION FILE KW
  344.   NEXT(@FILENAME)                 !  READ THE CURRENT RECORD KW
  345.  
  346. FILL_NEXT ROUTINE                 !FILL NEXT TABLE ENTRY
  347.   FOUND = FALSE                     !  ASSUME RECORD NOT FOUND
  348.   LOOP UNTIL EOF(@FILENAME)             !  LOOP UNTIL END OF FILE
  349.     NEXT(@FILENAME)                 !    READ THE NEXT RECORD
  350.     @CHECKSELECT                 !    SELECTOR
  351.     IF ~(@FILTER) THEN CYCLE.             !    FILTER
  352.     FOUND = TRUE                 !    SET RECORD FOUND
  353.     DO FILL_TABLE                 !    FILL IN THE TABLE ENTRY
  354.     ADD(TABLE)                     !    ADD LAST TABLE ENTRY
  355.     GET(TABLE,RECORDS(TABLE)-COUNT)         !    GET ANY OVERFLOW RECORD
  356.     DELETE(TABLE)                 !    AND DELETE IT
  357.     EXIT                     !    RETURN TO CALLER
  358.   .
  359. PREV_PAGE ROUTINE                 !DISPLAY PREVIOUS PAGE
  360.   LOOP COUNT TIMES                 !  FILL UP THE TABLE
  361.     DO FILL_PREV                 !    FILL A TABLE ENTRY
  362.     IF NOT FOUND THEN BREAK.             !    GET OUT IF NO RECORD
  363.   .
  364.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  365.  
  366. SET_PREV ROUTINE                 !POINT TO PREVIOUS PAGE
  367.   GET(TABLE,1)                     !  GET THE FIRST TABLE ENTRY
  368.   DO FILL_RECORD                 !  FILL IN THE RECORD
  369.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POSITION FILE KW
  370.   PREVIOUS(@FILENAME)                 !  READ THE CURRENT RECORD KW
  371.  
  372. FILL_PREV ROUTINE                 !FILL PREVIOUS TABLE ENTRY
  373.   FOUND = FALSE                     !  ASSUME RECORD NOT FOUND
  374.   LOOP UNTIL BOF(@FILENAME)             !  LOOP UNTIL BEGINNING OF FILE
  375.     PREVIOUS(@FILENAME)                 !    READ THE PREVIOUS RECORD
  376.     @CHECKSELECT                 !    SELECTOR
  377.     IF ~(@FILTER) THEN CYCLE.             !    FILTER
  378.     FOUND = TRUE                 !    SET RECORD FOUND
  379.     DO FILL_TABLE                 !    FILL IN THE TABLE ENTRY
  380.     ADD(TABLE,1)                 !    ADD FIRST TABLE ENTRY
  381.     GET(TABLE,COUNT+1)                 !    GET ANY OVERFLOW RECORD
  382.     DELETE(TABLE)                 !    AND DELETE IT
  383.     EXIT                     !    RETURN TO CALLER
  384.   .
  385. SHOW_PAGE ROUTINE                 !DISPLAY THE PAGE
  386.   NDX# = NDX                     !  SAVE SCREEN INDEX
  387.   LOOP NDX = 1 TO RECORDS(TABLE)         !  LOOP THRU THE TABLE
  388.     GET(TABLE,NDX)                 !    GET A TABLE ENTRY
  389.     DO FILL_SCREEN                 !    AND DISPLAY IT
  390.     IF TBL:PTR = NEWPTR                 !    SET INDEX FOR NEW RECORD
  391.       NDX# = NDX                 !    POINT TO CORRECT RECORD
  392.       @DOTOTALS                     !    CALCULATE TOTAL FIELDS
  393.   . .
  394.   NDX = NDX#                     !  RESTORE SCREEN INDEX
  395.   NEWPTR = 0                     !  CLEAR NEW RECORD POINTER
  396.   CLEAR(@PRE:RECORD)                 !  CLEAR RECORD AREA
  397.  
  398. FILL_TABLE ROUTINE                 !MOVE FILE TO TABLE
  399.   @LOOKUPSCROLL                     !  PERFORM LOOKUPS  KW     MOVED UP
  400.   @FILLTABLE                     !  LOAD TABLE FIELDS
  401.   TBL:PTR = POINTER(@FILENAME)             !  SAVE RECORD POINTER
  402.   @COMPUTESCROLL                 !  DO COMPUTES AND CONDITIONALS
  403.   @RESULTSCROLL                     !  MOVE RESULT FIELDS
  404.  
  405. FILL_RECORD ROUTINE                 !MOVE TABLE TO FILE
  406.   @FILLRECORD                     !  LOAD FILE KEYS
  407.  
  408. FILL_SCREEN ROUTINE                 !MOVE TABLE TO SCREEN
  409.   @FILLSCREEN                     !  DISPLAY SCREEN VARIABLES
  410.  
  411. GET_RECORD ROUTINE                 !GET SELECTED RECORD
  412.   GET(TABLE,NDX)                 !  GET TABLE ENTRY
  413.   GET(@FILENAME,TBL:PTR)             !  GET THE RECORD
  414.  
  415.   @COMPUTETOTS                     !CALCULATE TOTAL FIELDS
  416.  
  417. *FORM***************************************************************************
  418. @PROCNAME    PROCEDURE
  419.  
  420. SCREEN         SCREEN      PRE(SCR),@SCREENOPT
  421.               @PAINTS
  422.               @STRINGS
  423.               @VARIABLES
  424.               ENTRY,USE(?FIRST_FIELD)
  425.               @FIELDS
  426.               @PAUSE
  427.               ENTRY,USE(?LAST_FIELD)
  428.               PAUSE(''),USE(?DELETE_FIELD)
  429.          .
  430.  
  431.   EJECT
  432.   CODE
  433.   OPEN(SCREEN)                     !OPEN THE SCREEN
  434.   SETCURSOR                     !TURN OFF ANY CURSOR
  435.   @SETUP                     !CALL SETUP PROCEDURE
  436.   DISPLAY                     !DISPLAY THE FIELDS
  437.   LOOP                         !LOOP THRU ALL THE FIELDS
  438.     MEM:MESSAGE = CENTER(MEM:MESSAGE,SIZE(MEM:MESSAGE)) !DISPLAY ACTION MESSAGE
  439.     DO CALCFIELDS                 !CALCULATE DISPLAY FIELDS
  440.     ALERT                     !RESET ALERTED KEYS
  441.     ALERT(ACCEPT_KEY)                 !ALERT SCREEN ACCEPT KEY
  442.     ALERT(REJECT_KEY)                 !ALERT SCREEN REJECT KEY
  443.     @ALERT                     !ALERT HOT KEY
  444.     ACCEPT                     !READ A FIELD
  445.     @CHECKHOT                     !ON HOT KEY, CALL PROCEDURE
  446.     IF KEYCODE() = REJECT_KEY THEN RETURN.     !RETURN ON SCREEN REJECT KEY
  447.     EXECUTE ACTION                 !SET MESSAGE
  448.       MEM:MESSAGE = 'Record will be Added'     !
  449.       MEM:MESSAGE = 'Record will be Changed'     !
  450.       MEM:MESSAGE = 'Press Enter to Delete'     !
  451.     .
  452.     IF KEYCODE() = ACCEPT_KEY             !ON SCREEN ACCEPT KEY
  453.       UPDATE                     !  MOVE ALL FIELDS FROM SCREEN
  454.       SELECT(?)                     !  START WITH CURRENT FIELD
  455.       SELECT                     !  EDIT ALL FIELDS
  456.       CYCLE                     !  GO TO TOP OF LOOP
  457.     .
  458.     CASE FIELD()                 !JUMP TO FIELD EDIT ROUTINE
  459.     OF ?FIRST_FIELD                 !FROM THE FIRST FIELD
  460.       IF KEYCODE() = ESC_KEY THEN RETURN.     !  RETURN ON ESC KEY
  461.       IF ACTION = 3 THEN SELECT(?DELETE_FIELD).!    OR CONFIRM FOR DELETE
  462.  
  463.     @EDITS                     !EDIT ROUTINES GO HERE
  464.     OF ?LAST_FIELD                 !FROM THE LAST FIELD
  465.       EXECUTE ACTION                 !  UPDATE THE FILE
  466.     ADD(@FILENAME)                 !    ADD NEW RECORD
  467.     PUT(@FILENAME)                 !    CHANGE EXISTING RECORD
  468.     DELETE(@FILENAME)             !    DELETE EXISTING RECORD
  469.       .
  470.       IF ERRORCODE() = 40             !  DUPLICATE KEY ERROR         KW
  471.     MEM:MESSAGE = ERROR()             !    DISPLAY ERR MESSAGE    KW
  472.     SELECT(2)                 !    POSITION TO TOP OF FORM        KW
  473.     CYCLE                     !    GET OUT OF EDIT LOOP        KW
  474.       ELSIF ERROR()                 !  CHECK FOR UNEXPECTED ERROR    KW
  475.     STOP(ERROR())                 !    HALT EXECUTION        KW
  476.       .                                                              ! KW
  477.       PUT(@FILENAME2)                 !  UPDATE SECONDARY FILES
  478.       PUT(@FILENAME3)                 !  UPDATE SECONDARY FILES
  479.       PUT(@FILENAME4)                 !  UPDATE SECONDARY FILES
  480.       @NEXTFORM                     !  CALL NEXT FORM PROCEDURE
  481.       ACTION = 0                 !  SET ACTION TO COMPLETE
  482.       RETURN                     !  AND RETURN TO CALLER
  483.  
  484.     OF ?DELETE_FIELD                 !FROM THE DELETE FIELD
  485.       IF KEYCODE() = ENTER_KEY |         !  ON ENTER KEY
  486.       OR KEYCODE() = ACCEPT_KEY             !  OR CTRL-ENTER KEY
  487.     SELECT(?LAST_FIELD)             !    DELETE THE RECORD
  488.       ELSE                     !  OTHERWISE
  489.     BEEP                     !    BEEP AND ASK AGAIN
  490.   . . .
  491.  
  492. CALCFIELDS   ROUTINE
  493.   IF FIELD() > ?FIRST_FIELD             !BEYOND FIRST_FIELD?
  494.     IF KEYCODE() = 0 AND SELECTED() > FIELD() THEN EXIT. !GET OUT IF NOT NONSTOP
  495.   .
  496.   @LOOKUPS                     !DISPLAY FROM OTHER FILES
  497.   @SHOW                         !DISPLAY STRING VARIABLES
  498.   @COMPUTE                     !DISPLAY COMPUTED FIELDS
  499.   @RESULT                     !MOVE RESULTING VALUES
  500.  
  501. *MEMFORM************************************************************************
  502. @PROCNAME    PROCEDURE
  503.  
  504. SCREEN         SCREEN      PRE(SCR),@SCREENOPT
  505.               @PAINTS
  506.               @STRINGS
  507.               @VARIABLES
  508.               ENTRY,USE(?FIRST_FIELD)
  509.               @FIELDS
  510.               @PAUSE
  511.               ENTRY,USE(?LAST_FIELD)
  512.          .
  513.  
  514.   EJECT
  515.   CODE
  516.   OPEN(SCREEN)                     !OPEN THE SCREEN
  517.   SETCURSOR                     !TURN OFF ANY CURSOR
  518.   @SETUP                     !CALL SETUP PROCEDURE
  519.   DISPLAY                     !DISPLAY THE FIELDS
  520.   LOOP                         !LOOP THRU ALL THE FIELDS
  521.     @LOOKUPS                     !DISPLAY FROM OTHER FILES
  522.     @SHOW                     !DISPLAY STRING VARIABLES
  523.     @COMPUTE                     !DISPLAY COMPUTED FIELDS
  524.     @RESULT                     !MOVE RESULTING VALUES
  525.     ALERT                     !RESET ALERTED KEYS
  526.     ALERT(ACCEPT_KEY)                 !ALERT SCREEN ACCEPT KEY
  527.     ALERT(REJECT_KEY)                 !ALERT SCREEN REJECT KEY
  528.     @ALERT                     !ALERT HOT KEY
  529.     ACCEPT                     !READ A FIELD
  530.     @CHECKHOT                     !ON HOT KEY, CALL PROCEDURE
  531.     IF KEYCODE() = REJECT_KEY THEN RETURN.     !RETURN ON SCREEN REJECT KEY
  532.  
  533.     IF KEYCODE() = ACCEPT_KEY             !ON SCREEN ACCEPT KEY
  534.       UPDATE                     !  MOVE ALL FIELDS FROM SCREEN
  535.       SELECT(?)                     !  START WITH CURRENT FIELD
  536.       SELECT                     !  EDIT ALL FIELDS
  537.       CYCLE                     !  GO TO TOP OF LOOP
  538.     .                         !
  539.  
  540.     CASE FIELD()                 !JUMP TO FIELD EDIT ROUTINE
  541.     OF ?FIRST_FIELD                 !FROM THE FIRST FIELD
  542.       IF KEYCODE() = ESC_KEY THEN RETURN.     !  RETURN ON ESC KEY
  543.  
  544.     @EDITS                     !EDIT ROUTINES GO HERE
  545.     OF ?LAST_FIELD                 !FROM THE LAST FIELD
  546.       PUT(@FILENAME2)                 !  UPDATE SECONDARY FILES
  547.       PUT(@FILENAME3)                 !  UPDATE SECONDARY FILES
  548.       PUT(@FILENAME4)                 !  UPDATE SECONDARY FILES
  549.       @NEXTFORM                     !  CALL NEXT FORM PROCEDURE
  550.       ACTION = 0                 !  SET ACTION TO COMPLETE
  551.       RETURN                     !  AND RETURN TO CALLER
  552.   . .
  553.  
  554. *REPORT*************************************************************************
  555.  
  556. @PROCNAME    PROCEDURE
  557.  
  558. REPORT         @REPORT
  559.  
  560.          @SAVEITEMS
  561.  
  562.   CODE
  563.   DONE# = 0                     !TURN OFF DONE FLAG
  564.   @SETUP                     !CALL SETUP PROCEDURE
  565.   @INITSELECTS                     !SAVE SELECTOR FIELDS
  566.   CLEAR(@PRE:RECORD,-1)                 !MAKE SURE RECORD CLEARED  KW
  567.   @RESTSELECTS                     !RESTORE SELECTOR CRITERIA
  568.   BUILD(@INDEX)                     !BUILD FILE INDEX
  569.   @INITREPORT                     !INIT REPORT VARIABLES
  570.   @RPTHEADER                     !DO REPORT HEADER COMPUTES
  571.   PRINT(TTL:RPT_HEAD)                 !PRINT TITLE PAGE
  572.   @PRINTMEMO                     !PRINT ANY MEMO FILES
  573.   CLOSE(TITLE)                     !CLOSE TITLE REPORT
  574.   @SETRPTFILE                     !SET TO FIRST RECORD
  575.   DO NEXT_RECORD                 !READ FIRST RECORD
  576.   @PAGEHEADER                     !DO PAGE HEADER COMPUTES
  577.   @PAGEFOOTER                     !DO PAGE FOOTER COMPUTES
  578.   @APPENDON                     !APPEND REPORT TO TITLE
  579.   OPEN(REPORT)                     !OPEN THE REPORT
  580.   @FIRSTBREAK                     !PRINT INITIAL BREAK HEADERS
  581.   LOOP UNTIL DONE#                 !READ ALL RECORDS IN FILE
  582.     SAVE_LINE# = MEM:LINE             !  SAVE LINE NUMBER
  583.     LAST_REC# = POINTER(@FILENAME)
  584.     @RUNTOTALS                     !  ACCUMULATE RUNNING TOTALS
  585.     @INITDETAIL                     !  SET UP FOR DETAIL LINE
  586.     PRINT(RPT:DETAIL)                 !  PRINT DETAIL LINES
  587.     DO CHECK_PAGE                 !  DO PAGE BREAK IF NEEDED
  588.     @PRINTMEMO                     !  PRINT ANY MEMO FIELD
  589.     @TOTALS                     !  ACCUMULATE TOTALS
  590.     @PAGEFOOTER                     !  DO PAGE FOOTER COMPUTES
  591.     DO NEXT_RECORD                 !  GET NEXT RECORD
  592.     @PAGEHEADER                     !  DO PAGE HEADER COMPUTES
  593.     @PAGEEJECTDTL                 !  GO TO NEW PAGE
  594.     @CHECKBREAK                     !  CHECK FOR BREAK
  595.   .                         !
  596.   @LASTBREAK                     !  PRINT ENDING BREAK FOOTERS
  597.   @RPTFOOTER                     !DO REPORT FOOTER COMPUTES
  598.   PRINT(RPT:RPT_FOOT)                 !PRINT GRAND TOTALS
  599.   DO CHECK_PAGE                     !  DO PAGE BREAK IF NEEDED
  600.   @PRINTMEMO                     !  PRINT ANY MEMO FIELD
  601.   CLOSE(REPORT)                     !CLOSE REPORT
  602.   @APPENDOFF                     !TURN OFF REPORT APPEND
  603.   RETURN                     !RETURN TO CALLER
  604.  
  605.  
  606. NEXT_RECORD ROUTINE                 !GET NEXT RECORD
  607.   LOOP UNTIL EOF(@FILENAME)             !  READ UNTIL END OF FILE
  608.     NEXT(@FILENAME)                 !    READ NEXT RECORD
  609.     @CHECKSELECT                 !    STOP IF PAST SELECTOR
  610.     @DETAIL                     !    DO DETAIL COMPUTES
  611.     IF ~(@FILTER) THEN CYCLE.             !    IF FILTERED OUT, GET NEXT
  612.     EXIT                     !    EXIT THE ROUTINE
  613.   .                         !
  614.   DONE# = 1                     !  ON EOF, SET DONE FLAG
  615.  
  616. CHECK_PAGE ROUTINE                 !CHECK FOR NEW PAGE
  617.   IF MEM:LINE <= SAVE_LINE#             !  ON PAGE OVERFLOW
  618.     SAVE_LINE# = MEM:LINE             !    RESET LINE NUMBER
  619.     @INITPAGE                     !    INIT PAGE VARIABLES
  620.   .
  621.   LOOP UNTIL NOT KEYBOARD()             !LOOK FOR KEYSTROKE
  622.     ASK                         !GET KEYCODE
  623.     IF KEYCODE() = REJECT_KEY             !ON CTRL-ESC
  624.       @APPENDOFF                 !  TURN OFF REPORT APPENDING  KW
  625.       CLOSE(REPORT)                 !  CLOSE REPORT
  626.       RETURN                     !  ABORT PRINT
  627.   . .
  628.  
  629. @BREAKRTN                     !CHECK FOR GROUP BREAK
  630. *MEMREPORT**********************************************************************
  631.  
  632. @PROCNAME    PROCEDURE
  633.  
  634. REPORT         @REPORT
  635.  
  636.   CODE
  637.   @SETUP                     !CALL SETUP PROCEDURE
  638.   @INITREPORT                     !INIT REPORT VARIABLES
  639.   @RPTHEADER                     !DO REPORT HEADER COMPUTES
  640.   PRINT(TTL:RPT_HEAD)                 !PRINT TITLE PAGE
  641.   @MEMMEMO                     !PRINT ANY MEMO FILES
  642.   CLOSE(TITLE)                     !CLOSE TITLE REPORT
  643.   @PAGEFOOTER                     !DO PAGE FOOTER COMPUTES
  644.   @PAGEHEADER                     !DO PAGE HEADER COMPUTES
  645.   @APPENDON                     !APPEND REPORT TO TITLE
  646.   OPEN(REPORT)                     !OPEN REPORT BODY
  647.   @MEMMEMO                     !PRINT ANY MEMO FIELD
  648.   @DETAIL                     !DO DETAIL COMPUTES
  649.   @RUNTOTALS                     !ACCUMULATE RUNNING TOTALS
  650.   @INITDETAIL                     !SET UP FOR DETAIL RECORD
  651.   PRINT(RPT:DETAIL)                 !PRINT DETAIL LINES
  652.   @MEMMEMO                     !PRINT ANY MEMO FIELD
  653.   @TOTALS                     !ACCUMULATE TOTALS
  654.   @MEMMEMO                     !PRINT ANY MEMO FIELD
  655.   @PAGEFOOTER                     !DO PAGE FOOTER COMPUTES
  656.   @RPTFOOTER                     !DO REPORT FOOTER COMPUTES
  657.   PRINT(RPT:RPT_FOOT)                 !PRINT REPORT FOOTER
  658.   @MEMMEMO                     !PRINT ANY MEMO FIELD
  659.   CLOSE(REPORT)                     !CLOSE REPORT
  660.   @APPENDOFF                     !TURN OFF REPORT APPEND
  661.   RETURN                     !RETURN TO CALLER
  662.  
  663. *ALERT**************************************************************************
  664.   ALERT(@HOTKEY)                 !ALERT HOT KEY
  665. *APPENDON***********************************************************************
  666.   APPEND# = FALSE                 !TURN OFF APPEND FLAG
  667.   IF SUB(MEM:DEVICE,1,1) <> '+'             !NOT ALREADY APPENDING REPORTS
  668.     MEM:DEVICE = '+' & MEM:DEVICE         !  APPEND DISK RPT TO TITLE
  669.     APPEND# = TRUE                 !  SET FLAG TO TURN OFF APPEND
  670.   .
  671. *APPENDOFF**********************************************************************
  672.   IF APPEND#                     !IF REPORT WAS APPENDED
  673.     MEM:DEVICE = SUB(MEM:DEVICE,2,LEN(MEM:DEVICE)-1)!TURN OFF APPEND REPORT
  674.   .
  675. *AUTONUMKEY*********************************************************************
  676.   CLEAR(@PRE:RECORD,1)                 !CLEAR RECORD TO HIGH VALUES
  677.   @SETFILE                     !SET TO HIGHEST KEY VALUE
  678.   PREVIOUS(@FILENAME)                 !READ LAST KEY RECORD
  679.   IF ERROR()                     !IF THERE WAS AN ERROR         KW
  680.      CLEAR(@PRE:RECORD)                 !  CLEAR THE RECORD         KW
  681.      KEYFIELD# = @LOWER                 !  INTITIALIZE THE FIELD    KW
  682.      IF KEYFIELD# = 0 THEN KEYFIELD# = 1.     !  IF ITS 0 MAKE IT 1    KW
  683.   @CHECKSELAUTO                     !  CHECK SELECTOR AND             KW
  684.   ELSE                         !ELSE                     KW
  685.      KEYFIELD# = @INCFIELD + 1             !  INCREMENT FIELD         KW
  686.   .                                                                       ! KW
  687.   CLEAR(@PRE:RECORD)                 !CLEAR LAST KEY RECORD
  688.   @RESTSELECTS                     !LOAD PRIOR KEY FIELDS
  689.   @INCFIELD = KEYFIELD#                 !LOAD KEY FIELD
  690. *AUTOTABLE**********************************************************************
  691.   @ACCESSFIELD = @FIELD                 !MOVE RELATED FIELDS
  692.   GET(@FILENAME,@ACCESSKEY)             !READ THE RECORD
  693.   ACTION# = ACTION                 !SAVE ACTION
  694.   ACTION = 4                     !REQUEST TABLE LOOKUP
  695.   @LOOKUP                     !CALL LOOKUP PROCEDURE
  696.   IF ACTION                     !NO SELECTION WAS MADE
  697.     SELECT(?@FIELD-1)                 ! BACK UP ONE FIELD
  698.     ACTION = ACTION#                 ! RESTORE ACTION
  699.     CYCLE                     ! GO TO TOP OF LOOP
  700.   .
  701.   @LOOKFIELD = @ACCESSFIELD             !DISPLAY LOOKUP FIELD
  702.   @FIELD = @ACCESSFIELD                 !MOVE LOOKUP FIELD
  703.   DISPLAY(?@FIELD)                 !AND DISPLAY IT
  704.   ACTION = ACTION#                 !RESTORE ACTION
  705. *BREAKFOOTER********************************************************************
  706.   IF BRK_FLAG# <= @BRKNUM             !CHECK BREAK LEVEL
  707.     @GRPFOOTER                     ! DO FOOTER COMPUTES
  708.     PRINT(GRP_FOOT@BRKNUM)             ! PRINT GROUP FOOTER
  709.     @PRINTMEMO                     ! PRINT ANY MEMO FIELD
  710.     DO CHECK_PAGE                 ! DO PAGE BREAK IF NEEDED
  711.     @PAGEEJECT                     ! GO TO NEW PAGE
  712.   .
  713. *BREAKHEADER********************************************************************
  714.   IF BRK_FLAG# <= @BRKNUM             !CHECK BREAK LEVEL
  715.     @INITGROUP                     ! INIT GROUP VARIABLES
  716.     @GRPHEADER                     ! DO HEADER COMPUTES
  717.     PRINT(GRP_HEAD@BRKNUM)             ! PRINT GROUP HEADER
  718.     @PRINTMEMO                     ! PRINT ANY MEMO FIELD
  719.     DO CHECK_PAGE                 ! DO PAGE BREAK IF NEEDED
  720.   .
  721. *BREAKRTN***********************************************************************
  722. CHECK_BREAK  ROUTINE                 !CHECK FOR GROUP BREAK
  723.   @COMPAREBREAK                     !GENERATE IF STATEMENTS
  724.  
  725. PRT_BRK_HDRS ROUTINE                 !DO GROUP HEADERS
  726.   @BREAKHEADER                     !PRINT HEADERS
  727.   @INITBREAK                     !INITIALIZE BREAK FIELDS
  728.  
  729. PRT_BRK_FTRS ROUTINE                 !DO GROUP FOOTERS
  730.   GET(@FILENAME,LAST_REC#)             !REREAD PREVIOUS RECORD
  731.   @BREAKFOOTER                     !PRINT FOOTERS
  732.   SKIP(@FILENAME,-1)                 !BACKUP ONE RECORD
  733.   NEXT(@FILENAME)                 !AND REREAD IT
  734. *BUILDTABLE*********************************************************************
  735.   @TOTALCALC                     !CALC TABLE TOTAL FIELDS
  736.   IF ACTION = 4                     !  TABLE LOOKUP REQUEST
  737.     NEWPTR = POINTER(@FILENAME)             !  SET POINTER TO RECORD
  738.     IF NOT NEWPTR                 !  RECORD NOT PASSED TO TABLE
  739.       SET(@KEYNAME,@KEYNAME)             !    POSITION TO CLOSEST RECORD
  740.       NEXT(@FILENAME)                 !    READ RECORD
  741.       NEWPTR = POINTER(@FILENAME)         !    SET POINTER
  742.     .
  743.     DO FIND_RECORD                 !  POSITION FILE
  744.   ELSE
  745.     NDX = 1                     !  PUT SELECTOR BAR ON TOP ITEM
  746.     DO FIRST_PAGE                 !  BUILD MEMORY TABLE OF KEYS
  747.   .
  748.   RECORDS# = TRUE                 !  ASSUME THERE ARE RECORDS
  749. *CHECKBREAK*********************************************************************
  750.   IF NOT DONE# THEN DO CHECK_BREAK.         !  CHECK FOR GROUP BREAK
  751. *CHECKHOT***********************************************************************
  752.   IF KEYCODE() = @HOTKEY             !ON HOT KEY
  753.     UPDATE(?)                     !  RETRIEVE FIELD
  754.     SAVACTN# = ACTION                 !  SAVE ACTION        KW
  755.     @HOTPROC                     !  CALL HOT KEY PROCEDURE
  756.     ACTION = SAVACTN#                 !  RESTORE ACTION     KW
  757.     SELECT(?)                     !  DO SAME FIELD AGAIN
  758.     CYCLE                     !  AND LOOP AGAIN
  759.   .
  760. *CHECKSELAUTO*******************************************************************
  761.   ELSIF @FIELD <> @SAVEFIELD             !NO SELECTOR MATCHES        KW
  762.      CLEAR(@PRE:RECORD)                 !  CLEAR THE RECORD        KW
  763.      KEYFIELD# = @LOWER                 !  AND INITIALIZE THE FIELD    KW
  764.      IF KEYFIELD# = 0 THEN KEYFIELD# = 1.     !  IF ITS 0 MAKE IT 1    KW
  765. *CHECKSELECT********************************************************************
  766.   IF @FIELD <> @SAVEFIELD             !IF END OF SELECTION        KW
  767.      @FIELD = @SAVEFIELD             !  RESTORE THE SELECTOR    KW
  768.      BREAK                     !  AND BREAK                KW
  769.   .                                                                      !kw
  770. *COMPAREBREAK*******************************************************************
  771.   IF @FIELD <> @SAVEFIELD             !BREAK ON NEW GROUP
  772.     BRK_FLAG# = @BRKNUM                 !SET BREAK LEVEL
  773.     DO PRT_BRK_FTRS                 !PRINT FOOTERS FOR THIS LEVEL
  774.     DO PRT_BRK_HDRS                 !PRINT HEADERS FOR THIS LEVEL
  775.     EXIT                     !RETURN TO REPORT
  776.   .
  777. *COMPUTETOTS********************************************************************
  778. COMP_TOTALS  ROUTINE                 !CALCULATE TOTAL FIELDS
  779.   IF NOT ACTN# THEN EXIT.             !GET OUT IF ACTN NOT SET
  780.   @TOTPLUS                     !ADD TO TOTALS
  781.   ACTN# = 0                     !CLEAR ACTION
  782. *CONDITIONAL********************************************************************
  783.   IF @IFCOND                     !EVALUATE CONDITION
  784.     @IFCONDTRUE                     !  CONDITION IS TRUE
  785.   ELSE                         !OTHERWISE
  786.     @IFCONDFALSE                 !  CONDITION IS FALSE
  787.   .
  788. *CREATEFILE*********************************************************************
  789.   OF 2                         !IF NOT FOUND,
  790.     CREATE(@FILENAME)                 ! CREATE
  791. *DOTOTALS***********************************************************************
  792.   DO COMP_TOTALS                 !CALCULATE TABLE TOTALS
  793. *ENTERTABLE*********************************************************************
  794.   @ACCESSFIELD = @FIELD                 !MOVE RELATED FIELDS
  795.   GET(@FILENAME,@ACCESSKEY)             !READ THE RECORD
  796.   IF ERROR()                     !IF NO RECORD IS FOUND
  797.     ACTION# = ACTION                 !  SAVE ACTION
  798.     ACTION = 4                     !  REQUEST TABLE LOOKUP
  799.     @LOOKUP                     !  CALL LOOKUP PROCEDURE
  800.     IF ACTION                     !  NO SELECTION WAS MADE
  801.       SELECT(?@FIELD)                 !    STAY ON FIELD
  802.       ACTION = ACTION#                 !    RESTORE ACTION
  803.       CYCLE                     !    GO TO TOP OF LOOP
  804.     .
  805.     @FIELD = @ACCESSFIELD             !  MOVE LOOKUP FIELD
  806.     DISPLAY(?@FIELD)                 !  AND DISPLAY IT
  807.     ACTION = ACTION#                 !  RESTORE ACTION
  808.   .
  809. *FIRSTBREAK*********************************************************************
  810.   BRK_FLAG# = 0                     !CLEAR BREAK LEVEL FLAG
  811.   DO PRT_BRK_HDRS                 !PRINT GROUP HEADER(S)
  812. *HOTTABLE***********************************************************************
  813.   IF KEYCODE() = @HOTKEY             !IF HOT KEY PRESSED
  814.     UPDATE                     !  UPDATE ALL FIELDS
  815.     @ACCESSFIELD = @FIELD             !  MOVE RELATED FIELDS
  816.     GET(@FILENAME,@ACCESSKEY)             !  READ THE RECORD
  817.     ACTION# = ACTION                 !  SAVE ACTION
  818.     ACTION = 4                     !  REQUEST TABLE LOOKUP
  819.     @LOOKUP                     !  CALL LOOKUP PROCEDURE
  820.     IF ACTION                     !  NO SELECTION WAS MADE
  821.       SELECT(?@FIELD)                 !   BACK UP ONE FIELD
  822.       ACTION = ACTION#                 !   RESTORE ACTION
  823.       CYCLE                     !   GO TO TOP OF LOOP
  824.     .
  825.     @FIELD = @ACCESSFIELD             !  MOVE LOOKUP FIELD
  826.     DISPLAY(?@FIELD)                 !  AND DISPLAY IT
  827.     ACTION = ACTION#                 !  RESTORE ACTION
  828.   .
  829. *INITBREAK**********************************************************************
  830.   @SAVEFIELD = @FIELD                 !SAVE BREAK FIELD
  831. *INITLOCATE*********************************************************************
  832.   IF KEYCODE() = ESC_KEY             !  BACKING UP?
  833.     SCR:LOCATOR = ''                 !    CLEAR LOCATOR
  834.     SETCURSOR                     !    AND TURN CURSOR OFF
  835.   ELSE                         !  GOING FORWARD
  836.     LEN# = 0                     !    RESET TO START OF LOCATOR
  837.     SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)) !    AND TURN CURSOR ON
  838.   .
  839. *INITSELECTS********************************************************************
  840.   @SAVEFIELD = @FIELD                 !SAVE SELECTOR FIELD
  841. *INRANGE************************************************************************
  842.   IF ~INRANGE(@FIELD,@LOWER,@UPPER)         !IF FIELD IS OUT OF RANGE
  843.     BEEP                     !  SOUND KEYBOARD ALARM
  844.     SELECT(?@FIELD)                 !  AND STAY ON THIS FIELD
  845.     CYCLE                     !  GO TO TOP OF LOOP
  846.   .
  847. *LASTBREAK**********************************************************************
  848.   BRK_FLAG# = 0                     !CLEAR BREAK LEVEL FLAG
  849.   DO PRT_BRK_FTRS                 !PRINT GROUP FOOTER(S)
  850. *LOCATE*************************************************************************
  851.   IF KEYCODE() > 31             |         !THE DISPLAYABLE CHARACTERS
  852.   AND KEYCODE() < 255                 !ARE USED TO LOCATE RECORDS
  853.     IF LEN# < SIZE(SCR:LOCATOR)             !  IF THERE IS ROOM LEFT
  854.       SCR:LOCATOR = SUB(SCR:LOCATOR,1,LEN#) & CHR(KEYCODE())
  855.       LEN# += 1                     !    INCREMENT THE LENGTH
  856.     .
  857.   ELSIF KEYCODE() = BS_KEY             !BACKSPACE UNTYPES A CHARACTER
  858.     IF LEN# > 0                     !  IF THERE ARE CHARACTERS LEFT
  859.       LEN# -= 1                     !    DECREMENT THE LENGTH
  860.       SCR:LOCATOR = SUB(SCR:LOCATOR,1,LEN#)     !    ERASE THE LAST CHARACTER
  861.     .
  862.   ELSE                         !FOR ANY OTHER CHARACTER
  863.     LEN# = 0                     !  ZERO THE LENGTH
  864.     SCR:LOCATOR = ''                 !  ERASE THE LOCATOR FIELD
  865.   .
  866.   SETCURSOR(ROW(SCR:LOCATOR),COL(SCR:LOCATOR)+LEN#) !AND RESET THE CURSOR
  867.   @SETLOCATE
  868.   IF KEYBOARD() > 31             |         !THE DISPLAYABLE CHARACTERS
  869.   AND KEYBOARD() < 255             |         !ARE USED TO LOCATE RECORDS
  870.   OR KEYBOARD() = BS_KEY             !INCLUDE BACKSPACE
  871.     CYCLE
  872.   .
  873.   IF LEN# > 0                     !ON A LOCATOR REQUEST
  874.     @RESTSELECTS                 !  --SET SELECTOR COMPONENTS--
  875.     @SETLOCATE
  876.     SET(@KEYNAME,@KEYNAME)             !  POINT TO NEW RECORD
  877.     NEXT(@FILENAME)                 !  READ A RECORD
  878.     IF (EOF(@FILENAME) AND ERROR())         !  IF EOF IS REACHED
  879.       SET(@KEYNAME)                 !    SET TO FIRST RECORD
  880.       PREVIOUS(@FILENAME)             !    READ THE LAST RECORD
  881.     .
  882.     NEWPTR = POINTER(@FILENAME)             !  SET NEW RECORD POINTER
  883.     SKIP(@FILENAME,-1)                 !  BACK UP TO FIRST RECORD
  884.     FREE(TABLE)                     !  CLEAR THE TABLE
  885.     DO NEXT_PAGE                 !  AND DISPLAY A NEW PAGE
  886.   .
  887. *LOOKUPS************************************************************************
  888.   UPDATE                     !UPDATE RECORD KEYS
  889.   @ACCESSFIELD = @FIELD                 !MOVE RELATED KEY FIELDS
  890.   GET(@FILENAME,@ACCESSKEY)             !READ THE RECORD
  891.   IF ERROR() THEN CLEAR(@PRE:RECORD).         !IF NOT FOUND, CLEAR RECORD
  892.   @SCRFIELD = @LOOKUPFIELD             !DISPLAY LOOKUP FIELD
  893. *LOOKUPSCROLL*******************************************************************
  894.   @ACCESSFIELD = @FIELD                 !MOVE RELATED KEY FIELDS
  895.   GET(@FILENAME,@ACCESSKEY)             !READ THE RECORD
  896.   IF ERROR() THEN CLEAR(@PRE:RECORD).         !IF NOT FOUND, CLEAR RECORD
  897.   @SCRFIELD = @LOOKUPFIELD             !DISPLAY LOOKUP FIELD
  898. *MEMMEMO************************************************************************
  899.   @MEMOLEN                     !DETERMINE MEMO SIZE
  900.   J# = 2                     !START WITH ROW 2
  901.   LOOP                         !LOOP THRU ALL USED ROWS
  902.     MEMODONE# = 0                 !  NO MEMOS DONE YET
  903.     @SETMEMO                     !  SET THE MEMO VARIABLES
  904.     IF MEMODONE# = 0 THEN BREAK.         !  ALL MEMOS PRINTED
  905.     @PRTDETAIL                     !  AND PRINT IT
  906.     J# += 1                     !  INCREMENT COUNTER
  907.   .
  908. *MEMOLEN************************************************************************
  909.   LOOP @MEMOTMP# = @MEMOSIZE TO 2 BY -1         !BACKSCAN THE MEMO FIELD TO
  910.     IF @MEMOROW[@MEMOTMP#] <> '' THEN BREAK.     ! FIND NUMBER OF ROWS USED
  911.   .                         ! END OF MEMOLEN
  912. *NEXTFORM***********************************************************************
  913.   IF ACTION <> 3                 !IF THIS IS NOT A DELETE
  914.     ACTION = 2                     !  SET ACTION TO CHANGE MODE
  915.     @NEXTPAGE                     !  CALL NEXT FORM PROCEDURE
  916.     IF ACTION                     !  IF RECORD WAS NOT CHANGED
  917.       SELECT(?LAST_FIELD - 1)             !    SELECT THE LAST ENTRY
  918.       CYCLE                     !    AND LOOP AGAIN
  919.   . .
  920. *NOTREQUIRED********************************************************************
  921.   IF @FIELD = ''                 !IF NOT REQUIRED THEN
  922.     @EDITPROC                     !  CALL THE EDIT PROCEDURE
  923.     CYCLE                     !  END THE EDIT
  924.   .
  925. *OPENFILES**********************************************************************
  926.   SHOW(25,1,CENTER('OPENING FILE: ' & '@FILENAME',80)) !DISPLAY FILE NAME
  927.   OPEN(@FILENAME)                 !OPEN THE FILE
  928.   IF ERROR()                     !OPEN RETURNED AN ERROR
  929.     CASE ERRORCODE()                 ! CHECK FOR SPECIFIC ERROR
  930.     OF 46                     !  KEYS NEED TO BE REQUILT
  931.       SETHUE(0,7)                 !  BLACK ON WHITE
  932.       SHOW(25,1,CENTER('REBUILDING KEY FILES FOR @FILENAME',80)) !INDICATE MSG
  933.       BUILD(@FILENAME)                 !  CALL THE BUILD PROCEDURE
  934.       SETHUE(7,0)                 !  WHITE ON BLACK
  935.       BLANK(25,1,1,80)                 !  BLANK THE MESSAGE
  936.     @CREATEFILE                     !  IF NOT FOUND, THEN CREATE
  937.     ELSE                     ! ANY OTHER ERROR
  938.       LOOP;STOP('@FILENAME: ' & ERROR()).     !  STOP EXECUTION
  939.   . .
  940.  
  941. *PAGEEJECT**********************************************************************
  942.   MEM:LINE = 0                     !  SET FOR CALL TO CHECK_PAGE
  943.   DO CHECK_PAGE                     !  INITIALIZE PAGE VARIABLES
  944.   IF NOT DONE#                     !  MORE ITEMS TO PRINT
  945.     PRINT(PAGE_FOOT)                 !  PRINT PAGE FOOTER
  946.     PRINT(PAGE_HEAD)                 !  PRINT PAGE HEADER
  947.   .
  948. *PAUSE**************************************************************************
  949.   OF ?PAUSE_FIELD                 !ON PAUSE FIELD
  950.     IF KEYCODE() <> ENTER_KEY     |         !IF NOT ENTER KEY
  951.     AND KEYCODE() <> ACCEPT_KEY     |         !AND NOT CTRL-ENTER KEY
  952.     AND KEYCODE() <> 0                 !AND NOT NONSTOP MODE
  953.       BEEP                     !  SOUND KEYBOARD ALARM
  954.       SELECT(?PAUSE_FIELD)             !  AND STAY ON PAUSE FIELD
  955.     .
  956. *PICLOCATE**********************************************************************
  957.   @LOCFIELD = DEFORMAT(SCR:LOCATOR)         !    UPDATE THE KEY FIELD
  958. *PRINTMEMO**********************************************************************
  959.   @MEMOLEN                     !DETERMINE MEMO SIZE
  960.   J# = 2                     !START WITH SECOND ROW
  961.   LOOP                         !LOOP THRU ALL USED ROWS
  962.     MEMODONE# = 0                 !  NO MEMOS DONE YET
  963.     @SETMEMO                     !  SET THE MEMO VARIABLES
  964.     IF MEMODONE# = 0                 !  ALL MEMOS PRINTED
  965.       DO CHECK_PAGE                 !  DO PAGE BREAK IF NEEDED
  966.       BREAK                     !  EXIT MEMO PRINT LOOP
  967.     .                         !
  968.     @PRTDETAIL                     !  AND PRINT IT
  969.     J# += 1                     !  INCREMENT COUNTER
  970.     DO CHECK_PAGE                 !  DO PAGE BREAK IF NEEDED
  971.   .
  972. *PRTDETAIL**********************************************************************
  973.   PRINT(@MEMDETAIL)                 !PRINT THE DETAIL RECORD
  974. *REQUIRED***********************************************************************
  975.   IF @FIELD = ''                 !IF REQUIRED FIELD IS EMPTY
  976.     BEEP                     !  SOUND KEYBOARD ALARM
  977.     SELECT(?@FIELD)                 !  AND STAY ON THIS FIELD
  978.     CYCLE                     !
  979.   .
  980. *RESTSELECTS********************************************************************
  981.   @FIELD = @SAVEFIELD                 !RESTORE SELECTOR FIELD
  982. *RUNCODE************************************************************************
  983.   G_RUNPROC('@RUNDESC')                 !RUN DOS PROGRAM
  984. *RUNMAP*************************************************************************
  985.   PROC(G_RUNPROC)                 !GLOBAL MODULE RUN PROCEDURE
  986. *RUNPROC************************************************************************
  987. G_RUNPROC    PROCEDURE(DOSPROG)             !GLOBAL RUN PROCEDURE
  988. DOSPROG         STRING(12)                 !PROGRAM TO RUN
  989. SCREEN         SCREEN    WINDOW(25,80),HUE(7,0,0). !SAVE WINDOW
  990.  
  991.   CODE
  992.   OPEN(SCREEN)                     !SAVE CURRENT SCREEN
  993.   SETCURSOR(25,1)                 !POSITION CURSOR AT BOTTOM
  994.   RUN(DOSPROG)                     !RUN DOS PROGRAM
  995.   CLOSE(SCREEN)                     !RESTORE SCREEN
  996.   RETURN                     !EXIT BACK TO CALLING MENU
  997. *SAVEITEMS**********************************************************************
  998.   GROUP,PRE(SAV)
  999.     @BREAKFIELDS
  1000.     @SELECTFIELDS
  1001.   .
  1002. *SAVETOTALS*********************************************************************
  1003. TOT_GROUP    GROUP,PRE(TOT)             !TABLE TOTAL FIELDS
  1004.            @TOTALFIELDS
  1005.          .
  1006. *SETKEY*************************************************************************
  1007.   SET(@KEYNAME)                     !  POINT TO FIRST RECORD
  1008. *SETKEYKEY**********************************************************************
  1009.   @RESTSELECTS                     !--SET SELECTOR COMPONENTS
  1010.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POINT PAST LAST RECORD
  1011. *SETMEMO************************************************************************
  1012.   IF J# <= @MEMOTMP#                 !IF IN THE RANGE OF THIS MEMO
  1013.     @MEMOVAR = @MEMOROW[J#]             !  MOVE A MEMO FIELD ROW
  1014.     MEMODONE# = 1                 !  MEMO HAS BEEN MOVED
  1015.   ELSE                         !OTHERWISE
  1016.     @MEMOVAR = ''                 !  NO MEMO TO DO
  1017.   .                         ! END OF SETMEMO
  1018. *SETRECORD**********************************************************************
  1019.   BUFFER(@FILENAME,.25)
  1020.   SET(@FILENAME)                 !  POINT TO FIRST RECORD
  1021. *SETSELECT**********************************************************************
  1022.   SET(@KEYNAME,@KEYNAME)             !SET TO FIRST SELECTED RECORD
  1023. *SETTOP*************************************************************************
  1024.   SET(@KEYNAME)                     !SET TO FIRST RECORD
  1025. *SHOWMEMO***********************************************************************
  1026.   R# = ROW(@SCRMEMO)                 !SAVE ROW OF MEMO
  1027.   C# = COL(@SCRMEMO)                 !SAVE COL OF MEMO
  1028.   SETHUE(FOREHUE(R#,C#),BACKHUE(R#,C#))         !RETRIEVE COLOR OF MEMO
  1029.   LOOP I# = 1 TO @MEMOROWS             !DISPLAY MEMO FIELD BY ROWS
  1030.     SHOW(R#+I#-1,C#,@MEMOROW[I#],@S@MEMOCOLS)!SHOW NEXT ROW       KW
  1031.   .
  1032.   SETHUE                     !TURN OFF COLOR
  1033. *STRLOCATE**********************************************************************
  1034.   @LOCFIELD = CLIP(SCR:LOCATOR)             !    UPDATE THE KEY FIELD
  1035. *TABLEHOT***********************************************************************
  1036.   IF KEYCODE() = @HOTKEY             !ON HOT KEY
  1037.     IF FIELD() = ?POINT THEN DO GET_RECORD.     !  READ RECORD IF NEEDED
  1038.     @HOTPROC                     !  CALL HOT KEY PROCEDURE
  1039.     DO SAME_PAGE                 !  RESET TO SAME PAGE
  1040.     CYCLE                     !  AND LOOP AGAIN
  1041.   .
  1042. *TODO***************************************************************************
  1043. @PROCNAME    PROCEDURE                 !THIS PROCEDURE IS NOT DEFINED
  1044.  
  1045.   CODE                         !
  1046.   ACTION = 0                     !SET ACTION TO 0    KW
  1047.   RETURN                     !RETURN TO CALLER
  1048. *TOTACTN************************************************************************
  1049.   ACTN# = ACTION                 !SAVE ACTION FOR COMP_TOTALS
  1050. *TOTALCALC**********************************************************************
  1051.   @TOTCLEAR                     !ZERO TOTALS
  1052.   CLEAR(@PRE:RECORD,-1)                 !CLEAR RECORD TO LOW VALUES
  1053.   CLEAR(TBL:PTR)                 !SET POINTER TO ZERO
  1054.   SETHUE(BACKHUE(ROW,COL),BACKHUE(ROW,COL))     !TURN OFF DISPLAY
  1055.   @SETFILETOT                     !READ DATA RECORD SEQUENCE
  1056.   LOOP UNTIL EOF(@FILENAME)             !LOOP UNTIL END OF FILE
  1057.     NEXT(@FILENAME)                 !  READ A RECORD
  1058.     @CHECKSELECT                 !  SELECTOR MATCH?
  1059.     IF ~(@FILTER) THEN CYCLE.             !  FILTER MATCH?
  1060.     ACTN# = 1                     !SET ACTION FOR ADD
  1061.     DO FILL_TABLE                 !  TOTAL SCREEN VARIABLES
  1062.     DO COMP_TOTALS                 !  ADD TO TOTAL AMOUNT
  1063.   .
  1064.   SETHUE()                     !TURN OFF SETHUE
  1065.   FREE(@FILENAME)                 !FREE MEMORY USED FOR BUFFERING
  1066.   FREE(TABLE)                     !FREE MEMORY TABLE
  1067. *TOTCHECK***********************************************************************
  1068.   @TOTACTN                     !SAVE ACTION
  1069.   @TOTSAVE                     !SAVE EXISTING VALUES
  1070. *TOTCLEAR***********************************************************************
  1071.   CLEAR(TOT_GROUP)                 !ZERO TOTALS
  1072.   @TOTCLEARIMPL                     !ZERO AVERAGE CALC IMPLICITS
  1073. *UNIQUEKEY**********************************************************************
  1074.   IF DUPLICATE(@ACCESSKEY)             !  CHECK FOR DUPLICATE KEY
  1075.     MEM:MESSAGE = 'CREATES DUPLICATE ENTRY'     !    MOVE AN ERROR MESSAGE
  1076.     SELECT(?@FIELD)                 !    STAY ON THE SAME FIELD
  1077.     BEEP                     !    SOUND THE KEYBOARD ALARM
  1078.     CYCLE                     !    AND LOOP AGAIN
  1079.   .
  1080. *VALIDATE***********************************************************************
  1081.   @ACCESSFIELD = @FIELD                 !MOVE RELATED FIELDS
  1082.   GET(@FILENAME,@ACCESSKEY)             !READ THE RECORD
  1083.   IF ERROR()                     !IF NO RECORD IS FOUND
  1084.     MEM:MESSAGE = 'RECORD NOT FOUND'         !  MOVE AN ERROR MESSAGE
  1085.     BEEP                     !  SOUND THE KEYBOARD ALARM
  1086.     SELECT(?@FIELD)                 !  AND STAY ON THE SAME FIELD
  1087.   .
  1088. ********************************************************************************
  1089. *DYNTABLE**************************************************************************
  1090. @PROCNAME    PROCEDURE
  1091.  
  1092. SCREEN         SCREEN      PRE(SCR),@SCREENOPT
  1093.               @PAINTS
  1094.               @STRINGS
  1095.               @VARIABLES
  1096.               ENTRY,USE(?FIRST_FIELD)
  1097.               @FIELDS
  1098.               ENTRY,USE(?PRE_POINT)
  1099.               REPEAT(@COUNT),EVERY(@PROWS),INDEX(NDX)
  1100.           @PLOC        POINT(@PROWS,@COLS),USE(?POINT),ESC(?-1)
  1101.                 @SCROLLVARIABLES
  1102.          .          .
  1103.  
  1104. NDX         BYTE                 !REPEAT INDEX FOR POINT AREA
  1105. ROW         BYTE                 !ACTUAL ROW OF SCROLL AREA
  1106. COL         BYTE                 !ACTUAL COLUMN OF SCROLL AREA
  1107. COUNT         BYTE(@COUNT)             !NUMBER OF ITEMS TO SCROLL
  1108. ROWS         BYTE(@ROWS)             !NUMBER OF ROWS TO SCROLL
  1109. COLS         BYTE(@COLS)             !NUMBER OF COLUMNS TO SCROLL
  1110. FOUND         BYTE                 !RECORD FOUND FLAG
  1111. NEWPTR         LONG                 !POINTER TO NEW RECORD
  1112.  
  1113. TABLE         TABLE,PRE(TBL)             !TABLE OF RECORD DATA
  1114.            @TABLEFIELDS             !  SCREEN AND KEY COMPONENTS
  1115. PTR           LONG                 !  POINTER TO FILE RECORD
  1116.          .
  1117.          @SAVEITEMS                 !SELECTOR FIELD SAVE AREA
  1118.          @SAVETOTALS             !TOTAL FIELD ACCUMULATORS
  1119.  
  1120.   EJECT
  1121.   CODE
  1122.   ACTION# = ACTION                 !SAVE ACTION
  1123.   OPEN(SCREEN)                     !OPEN THE SCREEN
  1124.   SETCURSOR                     !TURN OFF ANY CURSOR
  1125.   @SETUP                     !CALL SETUP PROCEDURE
  1126.   @INITSELECTS                     !SAVE SELECTOR FIELDS
  1127.   @TOTCLEAR                     !ZERO TOTAL ACCUMULATORS
  1128.   TBL:PTR = 1                     !START AT TABLE ENTRY
  1129.   NDX = 1                     !PUT SELECTOR BAR ON TOP ITEM
  1130.   ROW = ROW(?POINT)                 !REMEMBER TOP ROW AND
  1131.   COL = COL(?POINT)                 !LEFT COLUMN OF SCROLL AREA
  1132.   RECORDS# = TRUE                 !INITIALIZE RECORDS FLAG
  1133.   CACHE(@KEYNAME,.25)                 !CACHE KEY FILE
  1134.   @BUILDTABLE                     !BUILD SCROLLING TABLE
  1135.   LOOP                         !LOOP UNTIL USER EXITS
  1136.     ACTION = ACTION#                 !RESTORE ACTION
  1137.     @RESTSELECTS                 !RESTORE SELECTOR FIELDS
  1138.     @TOTSHOW                     !DISPLAY TOTAL AMOUNTS ON SCRN
  1139.     @LOOKUPS                     !DISPLAY FROM OTHER FILES
  1140.     @SHOW                     !DISPLAY STRING VARIABLES
  1141.     @COMPUTE                     !DISPLAY COMPUTED FIELDS
  1142.     @RESULT                     !MOVE RESULTING VALUES
  1143.     ALERT                     !RESET ALERTED KEYS
  1144.     ALERT(REJECT_KEY)                 !ALERT SCREEN REJECT KEY
  1145.     ALERT(ACCEPT_KEY)                 !ALERT SCREEN ACCEPT KEY
  1146.     ALERT(DOWN_KEY)                 !ALERT DOWN ARROW
  1147.     ALERT(UP_KEY)                 !ALERT UP ARROW
  1148.     ALERT(HOME_KEY)                 !ALERT HOME KEY
  1149.     ALERT(END_KEY)                 !ALERT END KEY
  1150.     ALERT(TAB_KEY)                 !ALERT TAB KEY
  1151.     ALERT(SHFT_TAB)                 !ALERT SHIFT TAB KEY
  1152.     ALERT(LEFT_KEY)                 !ALERT LEFT KEY
  1153.     ALERT(RIGHT_KEY)                 !ALERT RIGHT KEY
  1154.  
  1155.     @ALERT                     !ALERT HOT KEYS
  1156.     ACCEPT                     !READ A FIELD
  1157.    @TABLEHOT                     !CALL HOT KEY PROCEDURES
  1158.     IF KEYCODE() = REJECT_KEY THEN BREAK.     !RETURN ON SCREEN REJECT KEY
  1159.  
  1160.     IF    KEYCODE() = ACCEPT_KEY      |         !ON SCREEN ACCEPT KEY
  1161.     AND FIELD() <> ?POINT             !BUT NOT ON THE POINT FIELD
  1162.       UPDATE                     !  MOVE ALL FIELDS FROM SCREEN
  1163.       SELECT(?)                     !  START WITH CURRENT FIELD
  1164.       SELECT                     !  EDIT ALL FIELDS
  1165.       CYCLE                     !  GO TO TOP OF LOOP
  1166.     .
  1167.  
  1168.     CASE FIELD()                 !JUMP TO FIELD EDIT ROUTINE
  1169.  
  1170.     OF ?FIRST_FIELD                 !FROM THE FIRST FIELD
  1171.       IF KEYCODE() = ESC_KEY   |         !  RETURN ON ESC KEY
  1172.       OR RECORDS# = FALSE             !  OR NO RECORDS
  1173.     BREAK                     !    EXIT PROGRAM
  1174.       .
  1175.     @EDITS                     !FIELD EDIT ROUTINES
  1176.     OF ?PRE_POINT                 !PRE POINT FIELD CONDITION
  1177.       IF KEYCODE() = ESC_KEY             !  BACKING UP?
  1178.     SELECT(?-1)                 !    SELECT PREVIOUS FIELD
  1179.     CLEAR(@PRE:RECORD)             !    CLEAR DATA    ****
  1180.       ELSE                     !  GOING FORWARD
  1181.     SELECT(?POINT)                 !    SELECT MENU FIELD
  1182.       .
  1183.       @INITLOCATE                 !    SHOW CURSOR FOR LOCATOR
  1184.     OF ?POINT                     !PROCESS THE POINT FIELD
  1185.       IF RECORDS(TABLE) = 0             !IF THERE ARE NO RECORDS
  1186.     CLEAR(@PRE:RECORD)             !  CLEAR RECORD AREA
  1187.     ACTION = 1                 !  SET ACTION TO ADD
  1188.     GET(@FILENAME,0)             !  CLEAR PENDING RECORD
  1189.     @AUTONUMKEY                 !  AUTO INCREMENT KEY FIELD
  1190.     @TOTACTN                 !  SAVE TOTACTN
  1191.     @RESTSELECTS                 !  RESTORE SELECTOR FIELDS
  1192.     @UPDATE                     !  CALL FORM FOR NEW RECORD
  1193.     NEWPTR = POINTER(@FILENAME)         !    SET POINTER TO NEW RECORD
  1194.     DO FIRST_PAGE                 !  DISPLAY THE FIRST PAGE
  1195.     IF RECORDS(TABLE) = 0             !  IF THERE AREN'T ANY RECORDS
  1196.       RECORDS# = FALSE             !    INDICATE NO RECORDS
  1197.       SELECT(?PRE_POINT-1)             !    SELECT THE PRIOR FIELD
  1198.     .
  1199.     CYCLE                     !    AND LOOP AGAIN
  1200.       .
  1201.       @LOCATE                     !PERORM LOCATOR LOGIC
  1202.       CASE KEYCODE()                 !PROCESS THE KEYSTROKE
  1203.  
  1204.       OF INS_KEY                 !INS KEY
  1205.     CLEAR(@PRE:RECORD)             !  CLEAR RECORD AREA
  1206.     ACTION = 1                 !  SET ACTION TO ADD
  1207.     GET(@FILENAME,0)             !  CLEAR PENDING RECORD
  1208.     @AUTONUMKEY                 !  AUTO INCREMENT KEY FIELD
  1209.     @TOTACTN                 !  SAVE TOTALS
  1210.     @RESTSELECTS                 !  RESTORE SELECTOR FIELDS
  1211.     @UPDATE                     !  CALL FORM FOR NEW RECORD
  1212.     IF ~ACTION                 !  IF RECORD WAS ADDED
  1213.       NEWPTR = POINTER(@FILENAME)         !    SET POINTER TO NEW RECORD
  1214.       DO FIND_RECORD             !    POSITION IN FILE
  1215.     .
  1216.       OF ENTER_KEY                 !ENTER KEY
  1217.       OROF ACCEPT_KEY                 !CTRL-ENTER KEY
  1218.     DO GET_RECORD                 !  GET THE SELECTED RECORD
  1219.     IF ACTION = 4 AND KEYCODE() = ENTER_KEY!    IF THIS IS A LOOKUP REQUEST
  1220.       ACTION = 0                 !    SET ACTION TO COMPLETE
  1221.       BREAK                     !    AND RETURN TO CALLER
  1222.     .
  1223.     IF ~ERROR()                 !  IF RECORD IS STILL THERE
  1224.       ACTION = 2                 !    SET ACTION TO CHANGE
  1225.       @TOTCHECK                 !    SAVE TOTALS
  1226.       @UPDATE                 !    CALL FORM TO CHANGE REC
  1227.       IF ACTION THEN CYCLE.             !    IF SUCCESSFUL RE-DISPLAY
  1228.       @TOTMINUS                 !    SUBTRACT CURRENT AMOUNTS
  1229.     .
  1230.     NEWPTR = POINTER(@FILENAME)         !    SET POINTER TO NEW RECORD
  1231.     DO FIND_RECORD                 !    POSITION IN FILE
  1232.       OF DEL_KEY                 !DEL KEY
  1233.     DO GET_RECORD                 !  READ THE SELECTED RECORD
  1234.     IF ~ERROR()                 !  IF RECORD IS STILL THERE
  1235.       ACTION = 3                 !    SET ACTION TO DELETE
  1236.       @TOTCHECK                 !    SAVE TOTALS
  1237.       @UPDATE                 !    CALL FORM TO DELETE
  1238.       IF ~ACTION                 !    IF SUCCESSFUL
  1239.         @TOTMINUS                 !    SUBTRACT CURRENT AMOUNTS
  1240.         N# = NDX                 !    SAVE POINT INDEX
  1241.         DO SAME_PAGE             !    RE-DISPLAY
  1242.         NDX = N#                 !    RESTORE POINT INDEX
  1243.     . .
  1244.       OF DOWN_KEY                 !DOWN ARROW KEY
  1245.     IF NDX = RECORDS(TABLE)             !IF AT BOTTOM OF SCREEN
  1246.       DO SET_NEXT                 !  POINT TO NEXT RECORD
  1247.       DO FILL_NEXT                 !  FILL A TABLE ENTRY
  1248.       IF FOUND                 !  FOUND A NEW RECORD
  1249.         SCROLL(ROW,COL,ROWS,COLS,ROWS(?POINT)) !    SCROLL THE SCREEN UP
  1250.         GET(TABLE,RECORDS(TABLE))         !  GET RECORD FROM TABLE
  1251.         DO FILL_SCREEN             !  DISPLAY ON SCREEN
  1252.       .
  1253.     ELSE                     !ELSE NOT AT BOTTOM
  1254.       NDX  += 1                 !  MOVE CURSOR DOWN 1 LINE
  1255.     .
  1256.  
  1257.  
  1258.       OF PGDN_KEY                 !PAGE DOWN KEY
  1259.     DO SET_NEXT                 !  POINT TO NEXT RECORD
  1260.     DO NEXT_PAGE                 !  DISPLAY THE NEXT PAGE
  1261.  
  1262.       OF CTRL_PGDN                 !CTRL-PAGE DOWN KEY
  1263.     DO LAST_PAGE                 !  DISPLAY THE LAST PAGE
  1264.     NDX = RECORDS(TABLE)             !  POSITION POINT BAR
  1265.  
  1266.       OF UP_KEY                     !UP ARROW KEY
  1267.     !IF AT TOP OF SCREEN, SCROLL AS NORMAL
  1268.     IF NDX = 1                   !IF AT TOP OF SCREEN
  1269.       DO SET_PREV                   !  POINT TO PREVIOUS RECORD
  1270.       DO FILL_PREV                   !  FILL A TABLE ENTRY
  1271.       IF FOUND                   !  FOUND A NEW RECORD
  1272.         SCROLL(ROW,COL,ROWS,COLS,-(ROWS(?POINT)))! SCROLL THE SCREEN DOWN
  1273.         GET(TABLE,1)               !  GET RECORD FROM TABLE
  1274.         DO FILL_SCREEN               !  DISPLAY ON SCREEN
  1275.       .
  1276.     ELSE                       ! IF NOT AT TOP OF SCREEN
  1277.       NDX -= 1                   !   MOVE CURSOR UP 1 LINE
  1278.      .
  1279.  
  1280.       OF PGUP_KEY                 !PAGE UP KEY
  1281.     DO SET_PREV                 !  POINT TO PREVIOUS RECORD
  1282.     DO PREV_PAGE                 !  DISPLAY THE PREVIOUS PAGE
  1283.  
  1284.       OF CTRL_PGUP                 !CTRL-PAGE UP
  1285.     DO FIRST_PAGE                 !  DISPLAY THE FIRST PAGE
  1286.     NDX = 1                     !  POSITION POINT BAR
  1287.      !*****                     !**********
  1288.      OF HOME_KEY                 !HOME KEY
  1289.        NDX = 1                     ! LIGHT BAR TO TOP LINE
  1290.  
  1291.      OF END_KEY                     !END KEY
  1292.        NDX = RECORDS(TABLE)             ! LIGHT BAR TO BOTTOM LINE
  1293.  
  1294.      OF TAB_KEY                     !TAB KEY OR
  1295.      OROF RIGHT_KEY                 !RIGHT ARROW KEY
  1296.        IF NDX < RECORDS(TABLE) THEN NDX += 1.     !MOVE LIGHT BAR DOWN 1 LINE
  1297.                          !  NO SCROLL OR SCREEN WRAP
  1298.  
  1299.      OF SHFT_TAB                 !SHIFT TAB OR
  1300.      OROF LEFT_KEY                 !LEFT ARROW KEY
  1301.        IF NDX = 1                 ! IF AT TOP OF SCREEN
  1302.      NDX = RECORDS(TABLE)             !   WRAP TO BOTTOM LINE
  1303.        ELSE                     ! ELSE
  1304.      NDX -= 1                 !   MOVE LIGHT BAR UP 1 LINE
  1305.        .
  1306.       .
  1307.       DO GET_RECORD                 ! GET RECORD FOR ANNOTATION
  1308.   . .
  1309.  
  1310.   FREE(TABLE)                     !FREE MEMORY TABLE
  1311.   RETURN                     !AND RETURN TO CALLER
  1312.  
  1313. SAME_PAGE ROUTINE                 !DISPLAY THE SAME PAGE
  1314.   GET(TABLE,1)                     !  GET THE FIRST TABLE ENTRY
  1315.   DO FILL_RECORD                 !  FILL IN THE RECORD
  1316.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POSITION FILE
  1317.   FREE(TABLE)                     !  EMPTY THE TABLE
  1318.   DO NEXT_PAGE                     !  DISPLAY A FULL PAGE
  1319.  
  1320. FIRST_PAGE ROUTINE                 !DISPLAY FIRST PAGE
  1321.   BLANK(ROW,COL,ROWS,COLS)
  1322.   FREE(TABLE)                     !  EMPTY THE TABLE
  1323.   CLEAR(@PRE:RECORD,-1)                 !  CLEAR RECORD TO LOW VALUES
  1324.   CLEAR(TBL:PTR)                 !  ZERO RECORD POINTER
  1325.   @SETFILE                     !  POSITION FILE POINTERS
  1326.   LOOP NDX = 1 TO COUNT                 !  FILL UP THE TABLE
  1327.     DO FILL_NEXT                 !    FILL A TABLE ENTRY
  1328.     IF NOT FOUND THEN BREAK.             !    GET OUT IF NO RECORD
  1329.   .
  1330.   NDX = 1                     !  SET TO TOP OF TABLE
  1331.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  1332.   DO GET_RECORD                     !  GET RECORD FOR FIRST DISPLAY
  1333.  
  1334. LAST_PAGE ROUTINE                 !DISPLAY LAST PAGE
  1335.   NDX# = NDX                     !  SAVE SELECTOR POSITION   KW
  1336.   BLANK(ROW,COL,ROWS,COLS)             !  CLEAR SCROLLING AREA
  1337.   FREE(TABLE)                     !  EMPTY THE TABLE
  1338.   CLEAR(@PRE:RECORD,1)                 !  CLEAR RECORD TO HIGH VALUES
  1339.   CLEAR(TBL:PTR,1)                 !  CLEAR PTR TO HIGH VALUE
  1340.   @SETFILE                     !  POSITION FILE POINTERS
  1341.   LOOP NDX = COUNT TO 1 BY -1             !  FILL UP THE TABLE
  1342.     DO FILL_PREV                 !    FILL A TABLE ENTRY
  1343.     IF NOT FOUND THEN BREAK.             !    GET OUT IF NO RECORD
  1344.   .                         !  END OF LOOP
  1345.   NDX = NDX#                     !  RESTORE SELECTOR POSITION    KW
  1346.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  1347.  
  1348. FIND_RECORD ROUTINE                 !POSITION TO SPECIFIC RECORD
  1349.   SET(@KEYNAME,@KEYNAME,NEWPTR)             !POSITION FILE
  1350.   IF NEWPTR = 0                     !NEWPTR NOT SET
  1351.     NEXT(@FILENAME)                 !  READ NEXT RECORD
  1352.     NEWPTR = POINTER(@FILENAME)             !  SET NEWPTR
  1353.     SKIP(@FILENAME,-1)                 !  BACK UP TO DISPLAY RECORD
  1354.   .
  1355.   FREE(TABLE)                     !  CLEAR THE RECORD
  1356.   DO NEXT_PAGE                     !  DISPLAY A PAGE
  1357.  
  1358. NEXT_PAGE ROUTINE                 !DISPLAY NEXT PAGE
  1359.   SAVECNT# = RECORDS(TABLE)             !  SAVE RECORD COUNT
  1360.   LOOP COUNT TIMES                 !  FILL UP THE TABLE
  1361.     DO FILL_NEXT                 !    FILL A TABLE ENTRY
  1362.     IF NOT FOUND                 !    IF NONE ARE LEFT
  1363.       IF NOT SAVECNT#                 !    IF REBUILDING TABLE
  1364.     DO LAST_PAGE                 !    FILL IN RECORDS
  1365.     EXIT                     !    EXIT OUT OF ROUTINE
  1366.       .
  1367.       BREAK                     !    EXIT LOOP
  1368.   . .
  1369.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  1370.  
  1371. SET_NEXT ROUTINE                 !POINT TO THE NEXT PAGE
  1372.   GET(TABLE,RECORDS(TABLE))             !  GET THE LAST TABLE ENTRY
  1373.   DO FILL_RECORD                 !  FILL IN THE RECORD
  1374.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POSITION FILE KW
  1375.   NEXT(@FILENAME)                 !  READ THE CURRENT RECORD KW
  1376.  
  1377. FILL_NEXT ROUTINE                 !FILL NEXT TABLE ENTRY
  1378.   FOUND = FALSE                     !  ASSUME RECORD NOT FOUND
  1379.   LOOP UNTIL EOF(@FILENAME)             !  LOOP UNTIL END OF FILE
  1380.     NEXT(@FILENAME)                 !    READ THE NEXT RECORD
  1381.     @CHECKSELECT                 !    SELECTOR
  1382.     IF ~(@FILTER) THEN CYCLE.             !    FILTER
  1383.     FOUND = TRUE                 !    SET RECORD FOUND
  1384.     DO FILL_TABLE                 !    FILL IN THE TABLE ENTRY
  1385.     ADD(TABLE)                     !    ADD LAST TABLE ENTRY
  1386.     GET(TABLE,RECORDS(TABLE)-COUNT)         !    GET ANY OVERFLOW RECORD
  1387.     DELETE(TABLE)                 !    AND DELETE IT
  1388.     EXIT                     !    RETURN TO CALLER
  1389.   .
  1390. PREV_PAGE ROUTINE                 !DISPLAY PREVIOUS PAGE
  1391.   LOOP COUNT TIMES                 !  FILL UP THE TABLE
  1392.     DO FILL_PREV                 !    FILL A TABLE ENTRY
  1393.     IF NOT FOUND THEN BREAK.             !    GET OUT IF NO RECORD
  1394.   .
  1395.   DO SHOW_PAGE                     !  DISPLAY THE PAGE
  1396.  
  1397. SET_PREV ROUTINE                 !POINT TO PREVIOUS PAGE
  1398.   GET(TABLE,1)                     !  GET THE FIRST TABLE ENTRY
  1399.   DO FILL_RECORD                 !  FILL IN THE RECORD
  1400.   SET(@KEYNAME,@KEYNAME,TBL:PTR)         !  POSITION FILE KW
  1401.   PREVIOUS(@FILENAME)                 !  READ THE CURRENT RECORD KW
  1402.  
  1403. FILL_PREV ROUTINE                 !FILL PREVIOUS TABLE ENTRY
  1404.   FOUND = FALSE                     !  ASSUME RECORD NOT FOUND
  1405.   LOOP UNTIL BOF(@FILENAME)             !  LOOP UNTIL BEGINNING OF FILE
  1406.     PREVIOUS(@FILENAME)                 !    READ THE PREVIOUS RECORD
  1407.     @CHECKSELECT                 !    SELECTOR
  1408.     IF ~(@FILTER) THEN CYCLE.             !    FILTER
  1409.     FOUND = TRUE                 !    SET RECORD FOUND
  1410.     DO FILL_TABLE                 !    FILL IN THE TABLE ENTRY
  1411.     ADD(TABLE,1)                 !    ADD FIRST TABLE ENTRY
  1412.     GET(TABLE,COUNT+1)                 !    GET ANY OVERFLOW RECORD
  1413.     DELETE(TABLE)                 !    AND DELETE IT
  1414.     EXIT                     !    RETURN TO CALLER
  1415.   .
  1416. SHOW_PAGE ROUTINE                 !DISPLAY THE PAGE
  1417.   NDX# = NDX                     !  SAVE SCREEN INDEX
  1418.   LOOP NDX = 1 TO RECORDS(TABLE)         !  LOOP THRU THE TABLE
  1419.     GET(TABLE,NDX)                 !    GET A TABLE ENTRY
  1420.     DO FILL_SCREEN                 !    AND DISPLAY IT
  1421.     IF TBL:PTR = NEWPTR                 !    SET INDEX FOR NEW RECORD
  1422.       NDX# = NDX                 !    POINT TO CORRECT RECORD
  1423.       @DOTOTALS                     !    CALCULATE TOTAL FIELDS
  1424.   . .
  1425.   NDX = NDX#                     !  RESTORE SCREEN INDEX
  1426.   NEWPTR = 0                     !  CLEAR NEW RECORD POINTER
  1427.   CLEAR(@PRE:RECORD)                 !  CLEAR RECORD AREA
  1428.  
  1429. FILL_TABLE ROUTINE                 !MOVE FILE TO TABLE
  1430.   @LOOKUPSCROLL                     !  PERFORM LOOKUPS  KW     MOVED UP
  1431.   @FILLTABLE                     !  LOAD TABLE FIELDS
  1432.   TBL:PTR = POINTER(@FILENAME)             !  SAVE RECORD POINTER
  1433.   @COMPUTESCROLL                 !  DO COMPUTES AND CONDITIONALS
  1434.   @RESULTSCROLL                     !  MOVE RESULT FIELDS
  1435.  
  1436. FILL_RECORD ROUTINE                 !MOVE TABLE TO FILE
  1437.   @FILLRECORD                     !  LOAD FILE KEYS
  1438.  
  1439. FILL_SCREEN ROUTINE                 !MOVE TABLE TO SCREEN
  1440.   @FILLSCREEN                     !  DISPLAY SCREEN VARIABLES
  1441.  
  1442. GET_RECORD ROUTINE                 !GET SELECTED RECORD
  1443.   GET(TABLE,NDX)                 !  GET TABLE ENTRY
  1444.   GET(@FILENAME,TBL:PTR)             !  GET THE RECORD
  1445.  
  1446.   @COMPUTETOTS                     !CALCULATE TOTAL FIELDS
  1447.  
  1448.  
  1449.