home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR2 / CLATPL.ZIP / CLARION3.TPX < prev    next >
Text File  |  1993-07-26  |  87KB  |  2,085 lines
  1. !------------------------------------------------------------------------------
  2. #!
  3. #!      CLARION3.TPX
  4. #!
  5. #!      Browse    Scroll records from a file one page at a time
  6. #!      List      Scroll records from a file from a memory queue
  7. #!      Lookup    Lookup a field value from a file
  8. #!      Select    Load a selected record into memory
  9. #!      Validate  Validate an entry field
  10. #!
  11. #!------------------------------------------------------------------------------
  12. #!
  13. #PROCEDURE(Browse,'Scroll records from a file'),SCREEN,PULLDOWN
  14. #!------------------------------------------------------------------------------
  15. #!
  16. #!                           The Browse Template
  17. #!
  18. #!------------------------------------------------------------------------------
  19. #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
  20. #PROMPT('Range &Value Field',FIELD),%RangeValue
  21. #PROMPT('Record Filter',@S180),%RecordFilter
  22. #PROMPT('Locator Field',COMPONENT),%Locator
  23. #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
  24. #PROMPT('First &Hot Field',FIELD),%First
  25. #PROMPT('Last &Hot Field',FIELD),%Last
  26. #PROMPT('Enable Hot Records',CHECK),%HotBar
  27. #INSERT(%StandardHeader)
  28. #MAP('BROWSE.INC')
  29. #PROJECT('%clapfx%BROWS.LIB')
  30. #PROTOTYPE('')
  31. %Procedure       PROCEDURE
  32. #INSERT(%SetBrowseSymbols)
  33. #INSERT(%BrowseErrorCheck)
  34. #!
  35. #FIX(%ScreenField,'?List')
  36. Queue            QUEUE
  37.                    STRING(%ScreenFieldQueueSize)
  38.                  .
  39. #IF(%KeyRangeField)
  40.   #FIX(%Key,%PrimaryKey)
  41.   #SET(%Found, %Null)
  42.   #FOR(%KeyField)
  43.     #IF(%Found <> 'Yes')
  44. SAV::%KeyField  Like(%KeyField)
  45.     #ENDIF
  46.     #IF(%KeyField = %KeyRangeField)
  47.      #SET(%Found, 'Yes')
  48.     #ENDIF
  49.   #ENDFOR
  50. #ENDIF
  51. ButtonIsDisabled BYTE                            !Flag to allow button enable
  52. #INSERT(%CloseFilesFlags)
  53. %LocalData
  54. %ScreenStructure
  55. %PulldownStructure
  56. #EMBED('Data Section')
  57.  
  58.   CODE
  59.   #EMBED('Setup Procedure')
  60.   #FIX(%File,%Primary)
  61.   #INSERT(%OpenPrimary)
  62.   #INSERT(%OpenSecondaryFiles)
  63.   FREE(Queue)                                    !Make sure Queue is empty
  64.   OPEN(Screen)                                   !Open the screen
  65.   #EMBED('Setup Screen')
  66.   DISPLAY                                        !Display screen fields
  67.   #INSERT(%SaveRangeFields)
  68.   #IF(%Pulldown)                                #!If a Pulldown exists
  69.   OPEN(%Pulldown)                              #<!Open the Pulldown
  70.   #ENDIF
  71.   #INSERT(%AddFixedListLines)
  72.   #INSERT(%BeginBrowse)
  73.   LOOP                                           !Process browse requests
  74.     CASE BrowseAction(%Primary,%PrimaryKey,Queue)#<!Browse the file
  75.     OF FormatQueue                               !Format a queue element
  76.       #INSERT(%GetSecondaryRecords)
  77.   #FOR(%Formula)
  78.     #IF(UPPER(%FormulaClass) = 'LIST')
  79.       #INSERT(%GenerateFormula)
  80.     #ENDIF
  81.   #ENDFOR
  82.       #EMBED('LIST Class formula')
  83.   #FIX(%ScreenField,'?List')
  84.       Queue = %ScreenFieldExpression           #<!Format the listbox queue
  85.     OF ProcessField                              !Process a field
  86.   #FOR(%Formula)
  87.     #IF(UPPER(%FormulaClass) <> 'LIST')
  88.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  89.       #INSERT(%GenerateFormula)
  90.       #ENDIF
  91.     #ENDIF
  92.   #ENDFOR
  93.       #EMBED('End of General Formulas')
  94.   #IF(%HotKeyExists)
  95.       CASE KEYCODE()                             !User defined hotkey check
  96.     #FOR(%HotKey)
  97.       OF %HotKey                               #<!User defined HotKey
  98.         %HotKeyProc                            #<!HotKey Procedure
  99.     #ENDFOR
  100.       END                                        !End CASE
  101.   #ENDIF
  102.       IF SELECTED() <> FIELD()                   ! If a new field is selected
  103.         CASE SELECTED()                          ! Jump to setup routine
  104.         #IF(%KeyRangeField)
  105.         OF ?List
  106.           #INSERT(%SaveRangeFields)
  107.         #ENDIF
  108.         #INSERT(%ScreenSetupRoutines)
  109.         END                                      ! End CASE SELECTED()
  110.       END                                        ! End IF
  111.       CASE FIELD()                               !Jump to edit routine
  112.   #FOR(%ScreenField)
  113.     #IF(%ScreenField = '?Insert')
  114.       #IF(%UpdateProc)
  115.        OF ?Insert                                !Process the Insert Button
  116.         #IF(%ScreenFieldEdit)
  117.         %ScreenFieldEdit                       #<! Insert button Edit Routine
  118.         #ENDIF
  119.         #INSERT(%ClearFileFields)
  120.         #INSERT(%RestoreRangeFields)
  121.         SETKEYCODE(InsKey)                       ! Set action to Insert
  122.         Do UpdateProcedure                       ! Call the update procedure
  123.         SELECT(?List)                            ! Reselect the List field
  124.       #ENDIF
  125.     #ELSIF(%ScreenField = '?Change')
  126.       #IF(%UpdateProc)
  127.       OF ?Change                                 !Process the Change Button
  128.         #IF(%ScreenFieldEdit)
  129.         %ScreenFieldEdit                       #<! Change button Edit Routine
  130.         #ENDIF
  131.         SETKEYCODE(EnterKey)                     ! Set action to Change
  132.         Do UpdateProcedure                       ! Call the update procedure
  133.         SELECT(?List)                            ! Reselect the List field
  134.       #ENDIF
  135.     #ELSIF(%ScreenField = '?Delete')
  136.       #IF(%UpdateProc)
  137.       OF ?Delete                                 !Process the Delete Button
  138.         #IF(%ScreenFieldEdit)
  139.         %ScreenFieldEdit                       #<! Delete button Edit Routine
  140.         #ENDIF
  141.         SETKEYCODE(DelKey)                       ! Set action to Delete
  142.         DO UpdateProcedure                       ! Call the update procedure
  143.         SELECT(?List)                            ! Reselect the List field
  144.       #ENDIF
  145.     #ELSIF(%ScreenField = '?List')
  146.       #IF(%UpdateProc)
  147.       OF ?List                                   !Process the list field
  148.         CASE KEYCODE()                           ! Jump to keycode routine
  149.         #IF(%NoButtonsExist OR %InsertExists)
  150.         OF InsKey                                ! For the insert key
  151.           #INSERT(%ClearFileFields)
  152.           #INSERT(%RestoreRangeFields)
  153.           DO UpdateProcedure                     !  Call the update procedure
  154.         #ENDIF
  155.         #IF(%NoButtonsExist OR %DeleteExists)
  156.         OF DelKey                                ! For the delete key
  157.           DO UpdateProcedure                     !  Call the update procedure
  158.         #ENDIF
  159.         #IF(%NoButtonsExist OR %ChangeExists )
  160.         OF EnterKey                              ! Or the enter key
  161.         OROF MouseLeft2                          ! Or a double mouse click
  162.           DO UpdateProcedure                     !  Call the update procedure
  163.         #ENDIF
  164.         END                                      ! End CASE
  165.       #ENDIF
  166.     #ELSIF(%ScreenField = '?Exit')
  167.       OF ?Exit                                   !Process the Exit button
  168.       #IF(%ScreenFieldEdit)
  169.         %ScreenFieldEdit                       #<! Exit button Edit Routine
  170.       #ENDIF
  171.         BREAK                                    ! Return to caller
  172.     #ELSIF(%ScreenFieldEdit)
  173.       OF %ScreenField                          #<! Completed %ScreenField
  174.         %ScreenFieldEdit                       #<!  %ScreenField edit routine
  175.     #ENDIF
  176.   #ENDFOR
  177.       #INSERT(%PulldownEditRoutines)
  178.       END                                        !End CASE FIELD()
  179.     OF NoRecords                                 !No records to browse
  180.       #INSERT(%ClearFileFields)
  181.       #INSERT(%RestoreRangeFields)
  182.       DISPLAY
  183.   #IF(%ChangeExists)
  184.       DISABLE(?Change)                           ! Disable the change button
  185.   #ENDIF
  186.   #IF(%DeleteExists)
  187.       DISABLE(?Delete)                           ! Disable the delete button
  188.   #ENDIF
  189.       ButtonIsDisabled = TRUE
  190.       IF RECORDS(%Primary)                     #<! If file is not empty
  191.         IF ?List <> %FirstEntryField           #<!  And list is not first
  192.           SELECT(%FirstEntryField)             #<!   Select the first field
  193.         ELSE                                     !  Else
  194.   #IF(%UpdateProc)
  195.     #IF(%InsertExists)
  196.           SELECT(?Insert)                        !   Select the Insert Button
  197.     #ELSE
  198.           #INSERT(%RestoreRangeFields)
  199.           SETKEYCODE(InsKey)                     !   Ask for a new record
  200.           DO UpdateProcedure                     !   Call the update procedure
  201.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  202.             BREAK                                !    Return to caller
  203.           ELSE                                   !   Else record was added
  204.       #IF(%ChangeExists)
  205.             ENABLE(?Change)                      !   Disable the change button
  206.       #ENDIF
  207.       #IF(%DeleteExists)
  208.             ENABLE(?Delete)                      !   Disable the delete button
  209.       #ENDIF
  210.             ButtonIsDisabled = FALSE
  211.           END                                    !   End IF
  212.     #ENDIF
  213.   #ELSE
  214.           BREAK                                  !   Return to caller
  215.   #ENDIF
  216.         END                                      !  End IF
  217.       ELSE                                       ! Else if file is empty
  218.   #IF(%UpdateProc)
  219.         #INSERT(%RestoreRangeFields)
  220.         SETKEYCODE(InsKey)                       !  Ask for a new record
  221.         DO UpdateProcedure                       !  Call the update procedure
  222.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  223.             BREAK                                !    Return to caller
  224.           ELSE                                   !   Else record was added
  225.     #IF(%ChangeExists)
  226.             ENABLE(?Change)                      !   Disable the change button
  227.     #ENDIF
  228.     #IF(%DeleteExists)
  229.             ENABLE(?Delete)                      !   Disable the delete button
  230.     #ENDIF
  231.             ButtonIsDisabled = FALSE
  232.           END                                    !   End IF
  233.   #ELSE
  234.         BREAK                                    !  Return to caller
  235.   #ENDIF
  236.       END                                        ! End IF
  237.   #IF(%FilterExists OR %KeyRangeField)
  238.     OF FilterRecord                              !Should we add this record
  239.       IF ButtonIsDisabled
  240.     #IF(%ChangeExists)
  241.         ENABLE(?Change)                          ! Enable the change button
  242.     #ENDIF
  243.     #IF(%DeleteExists)
  244.         ENABLE(?Delete)                          ! Enable the delete button
  245.     #ENDIF
  246.         ButtonIsDisabled = FALSE
  247.       END
  248.     #IF(%KeyRangeField)                         #!If using range limits
  249.       #IF(%RangeValue)                          #! If using range value field
  250.       IF (%KeyRangeField <> %RangeValue)       #<! If range field has changed
  251.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  252.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  253.         CYCLE                                    !  Cycle for BrowseAction
  254.       END                                        ! End IF
  255.       #ELSE
  256.         #SET(%Found, %Null)
  257.         #FOR(%KeyField)
  258.           #IF(%Found <> 'Yes')
  259.       IF (%KeyField <> SAV::%KeyField)         #<! If range field has changed
  260.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  261.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  262.         CYCLE                                    !  Cycle for BrowseAction
  263.       END                                        ! End IF
  264.           #ENDIF
  265.           #IF(%KeyField = %KeyRangeField)
  266.             #SET(%Found, 'Yes')
  267.           #ENDIF
  268.         #ENDFOR
  269.       #ENDIF
  270.     #ENDIF
  271.     #IF(%RecordFilter)
  272.       IF ~(%RecordFilter)                      #<!If Filter condition not met
  273.         GET(%Primary,0)                        #<! Dereference the record
  274.         CYCLE                                    ! Return to Top of LOOP
  275.       END                                        !End IF
  276.     #ELSE
  277.       #FOR(%Formula)
  278.         #IF(UPPER(%FormulaClass) = 'FILTER')
  279.           #IF(%FormulaType <> 'COMPUTED')
  280.       IF ~(%FormulaCondition)                  #<!If Filter condition not met
  281.         GET(%Primary,0)                        #<! Dereference the record
  282.         CYCLE                                    ! Return to Top of LOOP
  283.       END                                        !End IF
  284.           #ELSE
  285.       IF ~(%FormulaComputation)                #<!If Filter condition not met
  286.         GET(%Primary,0)                        #<! Dereference the record
  287.         CYCLE                                    ! Return to Top of LOOP
  288.       END                                        !End IF
  289.           #ENDIF
  290.         #ENDIF
  291.       #ENDFOR
  292.     #ENDIF
  293.       #EMBED('After Filter and Range Check')
  294.   #ENDIF
  295.   #IF(%KeyRangeField)
  296.     OF ResetFirst                                !Set to first in a Range
  297.       CLEAR(%FilePre:RECORD,-1)
  298.       #INSERT(%RestoreRangeFields)
  299.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  300.       #EMBED('Set to First Record')
  301.     OF ResetLast                                 !Set to last in a Range
  302.       CLEAR(%FilePre:RECORD,1)
  303.       #INSERT(%RestoreRangeFields)
  304.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  305.       #EMBED('Set to Last Record')
  306.   #ENDIF
  307.   #IF(%HotBar OR %First)
  308.     OF ProcessSelected                           !Process highlighted record
  309.       #INSERT(%GetSecondaryRecords)
  310.     #FOR(%Formula)
  311.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  312.       #INSERT(%GenerateFormula)
  313.       #ENDIF
  314.     #ENDFOR
  315.       #EMBED('Process Selected Record')
  316.     #IF(%First AND %Last)
  317.       DISPLAY(?%First,?%Last)                  #<!  Display the hot fields
  318.     #ELSIF(%First)
  319.       DISPLAY(?%First)                         #<!  Display the hot fields
  320.     #ENDIF
  321.   #ENDIF
  322.     END                                          ! End CASE
  323.   END                                            !End LOOP
  324.   EndBrowse                                      !End the browse session
  325.   FREE(Queue)                                    !Free the Queue memory
  326.   #IF(%Pulldown)                                #!If a Pulldown exists
  327.   CLOSE(%Pulldown)                             #<!Close the Pulldown
  328.   #ENDIF
  329.   #INSERT(%CloseOpenedFiles)
  330. #EMBED('End of Procedure')
  331.   #IF(%UpdateProc)
  332.  
  333. UpdateProcedure ROUTINE
  334.   #EMBED('Prior to Update Procedure')
  335.   %UpdateProc
  336.   #EMBED('After Update Procedure')
  337.   #ENDIF
  338. #!
  339. #PROCEDURE(Lookup,'Lookup a field value from a file'),SCREEN,PULLDOWN
  340. #!------------------------------------------------------------------------------
  341. #!
  342. #!                           The Lookup Template
  343. #!
  344. #!            A Lookup procedure must be called as a Setup Procedure
  345. #!
  346. #!------------------------------------------------------------------------------
  347. #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
  348. #PROMPT('Range &Value Field',FIELD),%RangeValue
  349. #PROMPT('Record Filter',@S180),%RecordFilter
  350. #PROMPT('Lookup Field',COMPONENT),%LookupField
  351. #PROMPT('Input Field Picture',@S30),%LookupPicture
  352. #PROMPT('Locator Field',COMPONENT),%Locator
  353. #PROMPT('Display Key',KEY),%DisplayKey
  354. #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
  355. #PROMPT('First &Hot Field',FIELD),%First
  356. #PROMPT('Last &Hot Field',FIELD),%Last
  357. #PROMPT('Enable Hot Records',CHECK),%HotBar
  358. #!
  359. #MAP('BROWSE.INC')
  360. #PROJECT('%clapfx%BROWS.LIB')
  361. #PROTOTYPE('')
  362. #INSERT(%SetBrowseSymbols)
  363. #INSERT(%BrowseErrorCheck)
  364. #FIX(%File,%Primary)
  365. #SET(%LookupKey,%PrimaryKey)
  366. #FIX(%Field,%LookupField)
  367. #IF(%FieldType = 'STRING'OR %FieldType = 'CSTRING'OR %FieldType = 'PSTRING')
  368.   #SET(%LookupType,'STRING')
  369. #ENDIF
  370. #IF(%DisplayKey = %Null)
  371.   #SET(%DisplayKey, %PrimaryKey)
  372. #ENDIF
  373. #!
  374. #INSERT(%StandardHeader)
  375.  
  376. %Procedure       PROCEDURE
  377.  
  378. #FIX(%ScreenField,'?List')
  379. Queue            QUEUE
  380.                    STRING(%ScreenFieldQueueSize)
  381.                  END
  382.  
  383. #IF(%KeyRangeField)
  384.   #FIX(%Key,%PrimaryKey)
  385.   #SET(%Found, %Null)
  386.   #FOR(%KeyField)
  387.     #IF(%Found <> 'Yes')
  388. SAV::%KeyField  Like(%KeyField)
  389.     #ENDIF
  390.     #IF(%KeyField = %KeyRangeField)
  391.      #SET(%Found, 'Yes')
  392.     #ENDIF
  393.   #ENDFOR
  394. #ENDIF
  395. #IF(%LookupPicture)
  396. DeformatString   STRING(80)
  397. #ENDIF
  398. ButtonIsDisabled BYTE                            !Flag to allow button enable
  399.  
  400. #INSERT(%CloseFilesFlags)
  401. %LocalData
  402. %ScreenStructure
  403. %PulldownStructure
  404. #EMBED('Data Section')
  405.  
  406.   CODE
  407.   #EMBED('Setup Procedure')
  408.   #FIX(%File,%Primary)
  409.   #INSERT(%OpenPrimary)
  410.   #SET(%FromLookup, 'TRUE')
  411.   #INSERT(%LookupRecord)
  412.   #INSERT(%OpenSecondaryFiles)
  413.   FREE(Queue)                                    !Make sure Queue is empty
  414.   OPEN(Screen)                                   !Open the screen
  415.   #EMBED('Setup Screen')
  416.   DISPLAY                                        !Display screen fields
  417.   #INSERT(%SaveRangeFields)
  418.   #IF(%Pulldown)                                #!If a Pulldown exists
  419.   OPEN(%Pulldown)                              #<!Open the Pulldown
  420.   #ENDIF
  421.   #INSERT(%AddFixedListLines)
  422.   #INSERT(%BeginBrowse)
  423.   LOOP                                           !Process browse requests
  424.     CASE BrowseAction(%Primary,%DisplayKey,Queue)#<!Browse the file
  425.     OF FormatQueue                               !Format a queue element
  426.       #INSERT(%GetSecondaryRecords)
  427.   #FOR(%Formula)
  428.     #IF(UPPER(%FormulaClass) = 'LIST')
  429.       #INSERT(%GenerateFormula)
  430.     #ENDIF
  431.   #ENDFOR
  432.       #EMBED('LIST Class formula')
  433.   #FIX(%ScreenField,'?List')
  434.       Queue = %ScreenFieldExpression
  435.     OF ProcessField                              !Process a field
  436.   #FOR(%Formula)
  437.     #IF(UPPER(%FormulaClass) <> 'LIST')
  438.       #INSERT(%GenerateFormula)
  439.     #ENDIF
  440.   #ENDFOR
  441.       #EMBED('End of General Formulas')
  442.   #IF(%HotKeyExists)
  443.       CASE KEYCODE()
  444.     #FOR(%HotKey)
  445.       OF %HotKey                                 !User defined HotKey
  446.         %HotKeyProc                              !HotKey Procedure
  447.     #ENDFOR
  448.       END
  449.   #ENDIF
  450.       IF SELECTED() <> FIELD()                   ! If a new field is selected
  451.         CASE SELECTED()                          ! Jump to setup routine
  452.         #IF(%KeyRangeField)
  453.         OF ?List
  454.           #INSERT(%SaveRangeFields)
  455.         #ENDIF
  456.         #INSERT(%ScreenSetupRoutines)
  457.         END                                      ! End CASE SELECTED()
  458.       END                                        ! End IF
  459.       CASE FIELD()                               !Jump to edit routine
  460.   #FOR(%ScreenField)
  461.     #IF(%ScreenField = '?List')
  462.       OF ?List                                   !Process the list field
  463.         CASE KEYCODE()                           !Jump to keycode routine
  464.       #IF(%UpdateProc)
  465.         #IF(%NoButtonsExist OR %InsertExists)
  466.         OF InsKey                                !For the insert key
  467.           #INSERT(%ClearFileFields)
  468.           Do UpdateProcedure                     ! Call the update procedure
  469.         #ELSIF(%ChangeExists <> 'YES')
  470.         OF InsKey                                !For the insert key
  471.           #INSERT(%ClearFileFields)
  472.           Do UpdateProcedure                     ! Call the update procedure
  473.         #ENDIF
  474.         #IF(%ChangeExists)
  475.         OF CtrlEnter                             !Or the Ctrl-Enter key
  476.           Do UpdateProcedure                     ! Call the update procedure
  477.         #ELSIF(%InsertExists <> 'YES')
  478.         OF CtrlEnter                             !Or the Ctrl-Enter key
  479.           Do UpdateProcedure                     ! Call the update procedure
  480.         #ENDIF
  481.       #ENDIF
  482.         OF MouseLeft2                            !On mouse double click
  483.         OROF EnterKey                            !or the enter key
  484.           SELECT(?Select)                        ! Select the Select button
  485.           PRESS(EnterKey)                        ! And complete it.
  486.         END                                      !End CASE
  487.     #ELSIF(%ScreenField = '?Insert')
  488.       #IF(%UpdateProc)
  489.       OF ?Insert                                 !Process the Insert Button
  490.         #IF(%ScreenFieldEdit)
  491.         %ScreenFieldEdit                       #<!Insert button Edit Routine
  492.         #ENDIF
  493.         #INSERT(%ClearFileFields)
  494.         #INSERT(%RestoreRangeFields)
  495.         SETKEYCODE(InsKey)                       !Set action to Insert
  496.         Do UpdateProcedure                       ! Call the update procedure
  497.         SELECT(?List)                            !Reselect the List field
  498.       #ENDIF
  499.     #ELSIF(%ScreenField = '?Change')
  500.       #IF(%UpdateProc)
  501.       OF ?Change                                 !Process the Change Button
  502.       #IF(%ScreenFieldEdit)
  503.         %ScreenFieldEdit                       #<!Change button Edit Routine
  504.       #ENDIF
  505.         SETKEYCODE(EnterKey)                     !Set action to Change
  506.         Do UpdateProcedure                       ! Call the update procedure
  507.         SELECT(?List)                            !Reselect the List field
  508.       #ENDIF
  509.     #ELSIF(%ScreenField = '?Select')
  510.       OF ?Select                                 !Process the Select button
  511.       #IF(%ScreenFieldEdit)
  512.         %ScreenFieldEdit                       #<!Select button Edit Routine
  513.       #ENDIF
  514.       #IF(%Pulldown)                            #!If a Pulldown exists
  515.         CLOSE(%Pulldown)                       #<!Close the Pulldown
  516.       #ENDIF
  517.         CLOSE(Screen)                            !Close the screen
  518.         ERASE(SELECTED())                        !Erase the old field contents
  519.       #IF(%LookupPicture)
  520.         PRESS(CLIP(LEFT(FORMAT(%LookupField,%LookupPicture)))) #<! Type in the field value
  521.       #ELSIF(%LookupType = 'STRING')
  522.         PRESS(CLIP(LEFT(%LookupField)))        #<!Type in the field value
  523.       #ELSE
  524.         PRESS(CLIP(LEFT(FORMAT(%LookupField,@N15))))#<!Type in the field value
  525.       #ENDIF
  526.         PRESS(TabKey)                            !  and a tab key
  527.         BREAK                                    !Return to caller
  528.     #ELSIF(%ScreenFieldEdit)
  529.       OF %ScreenField                          #<! Completed %ScreenField
  530.         %ScreenFieldEdit                       #<!  %ScreenField edit routine
  531.     #ENDIF
  532.   #ENDFOR
  533.       #INSERT(%PulldownEditRoutines)
  534.       END                                        !End CASE FIELD()
  535.     OF NoRecords                                 !No records to browse
  536.       #INSERT(%ClearFileFields)
  537.       #INSERT(%RestoreRangeFields)
  538.       DISPLAY
  539.   #IF(%ChangeExists)
  540.       DISABLE(?Change)                           ! Disable the change button
  541.   #ENDIF
  542.   #IF(%DeleteExists)
  543.       DISABLE(?Delete)                           ! Disable the delete button
  544.   #ENDIF
  545.       ButtonIsDisabled = TRUE
  546.       IF RECORDS(%Primary)                     #<!If file is not empty
  547.         IF ?List <> %FirstEntryField           #<!  And list is not first
  548.           SELECT(%FirstEntryField)             #<!    Select the first field
  549.         ELSE                                     !  End IF
  550.   #IF(%UpdateProc)
  551.     #IF(%InsertExists)
  552.           SELECT(?Insert)                        ! Select the Insert Button
  553.     #ELSE
  554.           #INSERT(%RestoreRangeFields)
  555.           SETKEYCODE(InsKey)                     !  Ask for a new record
  556.           Do UpdateProcedure                     ! Call the update procedure
  557.           IF POSITION(%DisplayKey) = ''          !  If record not added
  558.             BREAK                                !   Return to caller
  559.           END                                    ! End IF
  560.     #ENDIF
  561.   #ELSE
  562.           BREAK                                  ! Return to caller
  563.   #ENDIF
  564.         END                                      ! End IF
  565.       ELSE                                       !If file is empty
  566.   #IF(%UpdateProc)
  567.         #INSERT(%RestoreRangeFields)
  568.         SETKEYCODE(InsKey)                       !  Ask for a new record
  569.         Do UpdateProcedure                       ! Call the update procedure
  570.         IF POSITION(%DisplayKey) = ''          #<!  If record not added
  571.           BREAK                                  !   Return to caller
  572.         END                                      !  End IF
  573.   #ELSE
  574.         BREAK                                    ! Return to caller
  575.   #ENDIF
  576.       END                                        !End IF
  577.   #IF(%FilterExists OR %KeyRangeField)
  578.     OF FilterRecord                              !Should we add this record
  579.       IF ButtonIsDisabled
  580.     #IF(%ChangeExists)
  581.         ENABLE(?Change)                          ! Enable the change button
  582.     #ENDIF
  583.     #IF(%DeleteExists)
  584.         ENABLE(?Delete)                          ! Enable the delete button
  585.     #ENDIF
  586.         ButtonIsDisabled = FALSE
  587.       END
  588.     #IF(%KeyRangeField)                         #!If using range limits
  589.       #IF(%RangeValue)                          #! If using range value field
  590.       IF (%KeyRangeField <> %RangeValue)       #<! If range field has changed
  591.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  592.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  593.         CYCLE                                    !  Cycle for BrowseAction
  594.       END                                        ! End IF
  595.       #ELSE
  596.         #SET(%Found, %Null)
  597.         #FOR(%KeyField)
  598.           #IF(%Found <> 'Yes')
  599.       IF (%KeyField <> SAV::%KeyField)         #<! If range field has changed
  600.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  601.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  602.         CYCLE                                    !  Cycle for BrowseAction
  603.       END                                        ! End IF
  604.           #ENDIF
  605.           #IF(%KeyField = %KeyRangeField)
  606.             #SET(%Found, 'Yes')
  607.           #ENDIF
  608.         #ENDFOR
  609.       #ENDIF
  610.     #ENDIF
  611.     #IF(%RecordFilter)
  612.       IF ~(%RecordFilter)                      #<!If Filter condition not met
  613.         GET(%Primary,0)                        #<! Dereference the record
  614.         CYCLE                                    ! Return to Top of LOOP
  615.       END                                        !End IF
  616.     #ELSE
  617.       #FOR(%Formula)
  618.         #IF(UPPER(%FormulaClass) = 'FILTER')
  619.           #IF(%FormulaType <> 'COMPUTED')
  620.       IF ~(%FormulaCondition)                  #<!If Filter condition not met
  621.         GET(%Primary,0)                        #<! Dereference the record
  622.         CYCLE                                    ! Return to Top of LOOP
  623.       END                                        !End IF
  624.           #ELSE
  625.       IF ~(%FormulaComputation)                #<!If Filter condition not met
  626.         GET(%Primary,0)                        #<! Dereference the record
  627.         CYCLE                                    ! Return to Top of LOOP
  628.       END                                        !End IF
  629.           #ENDIF
  630.         #ENDIF
  631.       #ENDFOR
  632.     #ENDIF
  633.       #EMBED('After Filter and Range Check')
  634.   #ENDIF
  635.   #IF(%KeyRangeField)
  636.     OF ResetFirst                                !Set to first in a Range
  637.       CLEAR(%FilePre:RECORD,-1)
  638.       #INSERT(%RestoreRangeFields)
  639.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  640.       #EMBED('Set to First Record')
  641.     OF ResetLast                                 !Set to last in a Range
  642.       CLEAR(%FilePre:RECORD,1)
  643.       #INSERT(%RestoreRangeFields)
  644.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  645.       #EMBED('Set to Last Record')
  646.   #ENDIF
  647.   #IF(%HotBar OR %First)
  648.     OF ProcessSelected                           !Process highlighted record
  649.       #INSERT(%GetSecondaryRecords)
  650.     #FOR(%Formula)
  651.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  652.       #INSERT(%GenerateFormula)
  653.       #ENDIF
  654.     #ENDFOR
  655.       #EMBED('Process Selected Record')
  656.     #IF(%First AND %Last)
  657.       DISPLAY(?%First,?%Last)                  #<!  Display the hot fields
  658.     #ELSIF(%First)
  659.       DISPLAY(?%First)                         #<!  Display the hot fields
  660.     #ENDIF
  661.   #ENDIF
  662.     END                                          !  End CASE
  663.   END                                            !End LOOP
  664.   EndBrowse                                      !End the browse session
  665.   FREE(Queue)                                    !Free the Queue memory
  666.   #INSERT(%CloseOpenedFiles)
  667.  
  668. #EMBED('End of Procedure')
  669. #IF(%UpdateProc)
  670.  
  671. UpdateProcedure  ROUTINE
  672.   #EMBED('Prior to Update Procedure')
  673.   %UpdateProc
  674.   #EMBED('After Update Procedure')
  675. #ENDIF
  676.  
  677. #PROCEDURE(Validate,'Lookup invalid field value from a file'),SCREEN,PULLDOWN
  678. #!------------------------------------------------------------------------------
  679. #!
  680. #!                           The Validate Template
  681. #!
  682. #!          A Validate procedure must be called as an Edit Procedure
  683. #!
  684. #!------------------------------------------------------------------------------
  685. #MAP('BROWSE.INC')
  686. #PROJECT('%clapfx%BROWS.LIB')
  687. #PROTOTYPE('')
  688. #!
  689. #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
  690. #PROMPT('Range &Value Field',FIELD),%RangeValue
  691. #PROMPT('Record Filter',@S180),%RecordFilter
  692. #PROMPT('Lookup Field',COMPONENT),%LookupField
  693. #PROMPT('Input Field Picture',@S30),%LookupPicture
  694. #PROMPT('Locator Field',COMPONENT),%Locator
  695. #PROMPT('Display Key',KEY),%DisplayKey
  696. #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
  697. #PROMPT('First &Hot Field',FIELD),%First
  698. #PROMPT('Last &Hot Field',FIELD),%Last
  699. #PROMPT('Enable Hot Records',CHECK),%HotBar
  700. #PROMPT('Lookup Hot Key',KEYCODE),%LookupHotKey
  701. #!
  702. #INSERT(%SetBrowseSymbols)
  703. #INSERT(%BrowseErrorCheck)
  704. #IF(%LookupField = %Null)
  705.   #SET(%ErrorMessage, (%Procedure & ' ERROR: Lookup Field is required.'))
  706.   #ERROR(%ErrorMessage)
  707. #ENDIF
  708. #!
  709. #FIX(%File,%Primary)
  710. #SET(%LookupKey,%PrimaryKey)
  711. #FIX(%Field,%LookupField)
  712. #!
  713. #IF(%FieldType='STRING' OR %FieldType='CSTRING' OR %FieldType='PSTRING')
  714.   #SET(%LookupType,'STRING')
  715. #ENDIF
  716. #IF(%DisplayKey = %Null)
  717.   #SET(%DisplayKey,%PrimaryKey)
  718. #ENDIF
  719. #INSERT(%StandardHeader)
  720.  
  721. %Procedure       PROCEDURE
  722.  
  723. #FIX(%ScreenField,'?List')
  724. Queue            QUEUE
  725.                    STRING(%ScreenFieldQueueSize)
  726.                  END
  727. #IF(%KeyRangeField)
  728.  
  729.   #FIX(%Key,%PrimaryKey)
  730.   #SET(%Found, %Null)
  731.   #FOR(%KeyField)
  732.     #IF(%Found <> 'Yes')
  733. SAV::%KeyField  Like(%KeyField)
  734.     #ENDIF
  735.     #IF(%KeyField = %KeyRangeField)
  736.      #SET(%Found, 'Yes')
  737.     #ENDIF
  738.   #ENDFOR
  739. #ENDIF
  740.  
  741. #IF(%LookupPicture)
  742. DeformatString   STRING(80)
  743. #ENDIF
  744. ButtonIsDisabled BYTE                            !Flag to allow button enable
  745.  
  746. #INSERT(%CloseFilesFlags)
  747. %LocalData
  748. %ScreenStructure
  749. %PulldownStructure
  750. #EMBED('Data Section')
  751.  
  752.   CODE
  753.   #EMBED('Setup Procedure')
  754.   #INSERT(%OpenPrimary)
  755.   #EMBED('Before Validate Lookup')
  756.   #IF(%LookupHotKey)
  757.   IF KEYCODE() <> %LookupHotKey                #<!If not requested by hot key
  758.     #INSERT(%LookupRecord)
  759.   END                                            !End IF
  760.   #ELSE
  761.   #INSERT(%LookupRecord)
  762.   #ENDIF
  763.   #INSERT(%OpenSecondaryFiles)
  764.   OPEN(Screen)                                   !Open the screen
  765.   #EMBED('Setup Screen')
  766.   DISPLAY                                        !Display screen fields
  767.   #IF(%Pulldown)                                #!If a Pulldown exists
  768.   OPEN(%Pulldown)                              #<!Open the Pulldown
  769.   #ENDIF
  770.   #INSERT(%AddFixedListLines)
  771.   #INSERT(%BeginBrowse)
  772.   LOOP                                           !Process browse requests
  773.     CASE BrowseAction(%Primary,%DisplayKey,Queue)#<!Browse the file
  774.     OF FormatQueue                               !Format a queue element
  775.       #INSERT(%GetSecondaryRecords)
  776.   #FOR(%Formula)
  777.     #IF(UPPER(%FormulaClass) = 'LIST')
  778.       #INSERT(%Generateformula)
  779.     #ENDIF
  780.   #ENDFOR
  781.       #EMBED('LIST Class formula')
  782.   #FIX(%ScreenField,'?List')
  783.        Queue = %ScreenFieldExpression            !Format the queue line
  784.     OF ProcessField                              !Process a field
  785.   #FOR(%Formula)
  786.     #IF(UPPER(%FormulaClass) <> 'LIST')         #!
  787.       #INSERT(%GenerateFormula)                 #! Generate Formulas
  788.     #ENDIF
  789.   #ENDFOR
  790.       #EMBED('End of General Formulas')
  791.   #IF(%HotkeyExists)
  792.       CASE KEYCODE()
  793.     #FOR(%HotKey)
  794.       OF %HotKey                                 !User defined HotKey
  795.         %HotKeyProc                              !HotKey Procedure
  796.     #ENDFOR
  797.       END
  798.   #ENDIF
  799.       IF SELECTED() <> FIELD()                   ! If a new field is selected
  800.         CASE SELECTED()                          ! Jump to setup routine
  801.         #IF(%KeyRangeField)
  802.         OF ?List
  803.           #INSERT(%SaveRangeFields)
  804.         #ENDIF
  805.         #INSERT(%ScreenSetupRoutines)
  806.         END                                      ! End CASE SELECTED()
  807.       END                                        ! End IF
  808.       CASE FIELD()                               !Jump to edit routine
  809.   #FOR(%ScreenField)
  810.     #IF(%ScreenField = '?List')
  811.       OF ?List                                   !Process the list field
  812.         CASE KEYCODE()                           !Jump to keycode routine
  813.       #IF(%UpdateProc)
  814.         #IF(%NoButtonsExist OR %InsertExists)
  815.         OF InsKey                                !For the insert key
  816.           #INSERT(%ClearFileFields)
  817.           Do UpdateProcedure                     ! Call the update procedure
  818.         #ELSIF(%ChangeExists <> 'YES')
  819.         OF InsKey                                !For the insert key
  820.           #INSERT(%ClearFileFields)
  821.           Do UpdateProcedure                     ! Call the update procedure
  822.         #ENDIF
  823.         #IF(%ChangeExists)
  824.         OF CtrlEnter                             !Or the Ctrl-Enter key
  825.           Do UpdateProcedure                     ! Call the update procedure
  826.         #ELSIF(%InsertExists <> 'YES')
  827.         OF CtrlEnter                             !Or the Ctrl-Enter key
  828.           Do UpdateProcedure                     ! Call the update procedure
  829.         #ENDIF
  830.       #ENDIF
  831.         OF MouseLeft2                            !On mouse double click
  832.         OROF EnterKey                            !or the enter key
  833.           SELECT(?Select)                        ! Select the Select button
  834.           PRESS(EnterKey)                        ! And complete it.
  835.         END                                      !End CASE
  836.     #ELSIF(%ScreenField = '?Insert')
  837.       #IF(%UpdateProc)
  838.       OF ?Insert                                 !Process the Insert Button
  839.         #IF(%ScreenFieldEdit)
  840.         %ScreenFieldEdit                       #<!Insert button Edit Routine
  841.         #ENDIF
  842.         #INSERT(%ClearFileFields)
  843.         #INSERT(%RestoreRangeFields)
  844.         SETKEYCODE(InsKey)                       !Set action to Insert
  845.         Do UpdateProcedure                       ! Call the update procedure
  846.         SELECT(?List)                            !Reselect the List field
  847.       #ENDIF
  848.     #ELSIF(%ScreenField = '?Change')
  849.       #IF(%UpdateProc)
  850.       OF ?Change                                 !Process the Change Button
  851.         #IF(%ScreenFieldEdit)
  852.         %ScreenFieldEdit                       #<!Change button Edit Routine
  853.         #ENDIF
  854.         SETKEYCODE(EnterKey)                     !Set action to Change
  855.         Do UpdateProcedure                       ! Call the update procedure
  856.         SELECT(?List)                            !Reselect the List field
  857.       #ENDIF
  858.     #ELSIF(%ScreenField = '?Select')
  859.       OF ?Select                                 !Process the Select button
  860.       #IF(%ScreenFieldEdit)
  861.         %ScreenFieldEdit                       #<!Select button Edit Routine
  862.       #ENDIF
  863.       #IF(%Pulldown)                            #!If a Pulldown exists
  864.         CLOSE(%Pulldown)                       #<!Close the Pulldown
  865.       #ENDIF
  866.         CLOSE(Screen)                            !Close the screen
  867.         SELECT(?)                                !Select the same field
  868.         ERASE(?)                                 !Erase the bad value
  869.       #IF(%LookupPicture)
  870.         PRESS(CLIP(LEFT(FORMAT(%LookupField,%LookupPicture)))) #<! Type in the field value
  871.       #ELSIF(%LookupType = 'STRING')
  872.         PRESS(CLIP(LEFT(%LookupField)))        #<!Type in the field value
  873.       #ELSE
  874.         PRESS(CLIP(LEFT(FORMAT(%LookupField,@N15))))#<!Type in the field value
  875.       #ENDIF
  876.         PRESS(TabKey)                            !  and a tab key
  877.         BREAK                                    !Return to caller
  878.     #ELSIF(%ScreenFieldEdit)
  879.       OF %ScreenField                          #<! Completed %ScreenField
  880.         %ScreenFieldEdit                       #<!  %ScreenField edit routine
  881.     #ENDIF
  882.   #ENDFOR
  883.       #INSERT(%PulldownEditRoutines)
  884.       END                                        !End CASE FIELD()
  885.     OF NoRecords                                 !No records to browse
  886.       #INSERT(%ClearFileFields)
  887.       #INSERT(%RestoreRangeFields)
  888.       DISPLAY
  889.       IF RECORDS(%Primary)                     #<!If file is not empty
  890.         IF ?List <> %FirstEntryField           #<!  And list is not first
  891.           SELECT(%FirstEntryField)             #<!    Select the first field
  892.         ELSE                                     !  From the first field
  893.   #IF(%UpdateProc)
  894.     #IF(%InsertExists)
  895.           SELECT(?Insert)                        !   Select the Insert Button
  896.     #ELSE
  897.           #INSERT(%RestoreRangeFields)
  898.           SETKEYCODE(InsKey)                     !   Ask for a new record
  899.           DO UpdateProcedure                     !   Call the update procedure
  900.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  901.             BREAK                                !    Return to caller
  902.           END                                    !   End IF
  903.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  904.             BREAK                                !    Return to caller
  905.           END                                    !   End IF
  906.     #ENDIF
  907.   #ELSE
  908.           BREAK                                  !   Return to caller
  909.   #ENDIF
  910.         END                                      !  End IF
  911.       ELSE                                       !If file is empty
  912.   #IF(%UpdateProc)
  913.         #INSERT(%ClearFileFields)
  914.         #INSERT(%RestoreRangeFields)
  915.         SETKEYCODE(InsKey)                       !  Ask for a new record
  916.         Do UpdateProcedure                       ! Call the update procedure
  917.         IF RECORDS(%Primary) = 0               #<!  If a record was not added
  918.           BREAK
  919.         END                                      !  End IF
  920.   #ELSE
  921.         BREAK                                    !  Return to caller
  922.   #ENDIF
  923.       END                                        !End IF
  924.   #IF(%FilterExists OR %KeyRangeField)
  925.     OF FilterRecord                              !Should we add this record
  926.       IF ButtonIsDisabled
  927.     #IF(%ChangeExists)
  928.         ENABLE(?Change)                          ! Enable the change button
  929.     #ENDIF
  930.     #IF(%DeleteExists)
  931.         ENABLE(?Delete)                          ! Enable the delete button
  932.     #ENDIF
  933.         ButtonIsDisabled = FALSE
  934.       END
  935.     #IF(%KeyRangeField)                         #!If using range limits
  936.       #IF(%RangeValue)                          #! If using range value field
  937.       IF (%KeyRangeField <> %RangeValue)       #<! If range field has changed
  938.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  939.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  940.         CYCLE                                    !  Cycle for BrowseAction
  941.       END                                        ! End IF
  942.       #ELSE
  943.         #SET(%Found, %Null)
  944.         #FOR(%KeyField)
  945.           #IF(%Found <> 'Yes')
  946.       IF (%KeyField <> SAV::%KeyField)         #<! If range field has changed
  947.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  948.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  949.         CYCLE                                    !  Cycle for BrowseAction
  950.       END                                        ! End IF
  951.           #ENDIF
  952.           #IF(%KeyField = %KeyRangeField)
  953.             #SET(%Found, 'Yes')
  954.           #ENDIF
  955.         #ENDFOR
  956.       #ENDIF
  957.     #ENDIF
  958.     #IF(%RecordFilter)
  959.       IF ~(%RecordFilter)                      #<!If Filter condition not met
  960.         GET(%Primary,0)                        #<! Dereference the record
  961.         CYCLE                                    ! Return to Top of LOOP
  962.       END                                        !End IF
  963.     #ELSE
  964.       #FOR(%Formula)
  965.         #IF(UPPER(%FormulaClass) = 'FILTER')
  966.           #IF(%FormulaType <> 'COMPUTED')
  967.       IF ~(%FormulaCondition)                  #<!If Filter condition not met
  968.         GET(%Primary,0)                        #<! Dereference the record
  969.         CYCLE                                    ! Return to Top of LOOP
  970.       END                                        !End IF
  971.           #ELSE
  972.       IF ~(%FormulaComputation)                #<!If Filter condition not met
  973.         GET(%Primary,0)                        #<! Dereference the record
  974.         CYCLE                                    ! Return to Top of LOOP
  975.       END                                        !End IF
  976.           #ENDIF
  977.         #ENDIF
  978.       #ENDFOR
  979.     #ENDIF
  980.       #EMBED('After Filter and Range Check')
  981.   #ENDIF
  982.   #IF(%KeyRangeField)
  983.     OF ResetFirst                                !Set to first in a Range
  984.       CLEAR(%FilePre:RECORD,-1)
  985.       #INSERT(%RestoreRangeFields)
  986.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  987.       #EMBED('Set to First Record')
  988.     OF ResetLast                                 !Set to last in a Range
  989.       CLEAR(%FilePre:RECORD,1)
  990.       #INSERT(%RestoreRangeFields)
  991.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  992.       #EMBED('Set to Last Record')
  993.   #ENDIF
  994.   #IF(%HotBar OR %First)
  995.     OF ProcessSelected                           !Process highlighted record
  996.       #INSERT(%GetSecondaryRecords)
  997.     #FOR(%Formula)
  998.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  999.       #INSERT(%GenerateFormula)
  1000.       #ENDIF
  1001.     #ENDFOR
  1002.       #EMBED('Process Selected Record')
  1003.     #IF(%First AND %Last)
  1004.       DISPLAY(?%First,?%Last)                  #<!  Display the hot fields
  1005.     #ELSIF(%First)
  1006.       DISPLAY(?%First)                         #<!  Display the hot fields
  1007.     #ENDIF
  1008.   #ENDIF
  1009.     END                                          !End CASE
  1010.   END                                            !End LOOP
  1011.   EndBrowse                                      !End the browse session
  1012.   FREE(Queue)                                    !Free the Queue memory
  1013.   #IF(%Pulldown)                                #!If a Pulldown exists
  1014.   CLOSE(%Pulldown)                             #<!Close the Pulldown
  1015.   #ENDIF
  1016.   #INSERT(%CloseOpenedFiles)
  1017. #EMBED('End of Procedure')
  1018. #IF(%UpdateProc)
  1019.  
  1020. UpdateProcedure  ROUTINE
  1021.   #EMBED('Prior to Update Procedure')
  1022.   %UpdateProc
  1023.   #EMBED('After Update Procedure')
  1024. #ENDIF
  1025.  
  1026. #!
  1027. #PROCEDURE(List,'Scroll all selected records from a file'),SCREEN,PULLDOWN
  1028. #!------------------------------------------------------------------------------
  1029. #!
  1030. #!                           The List Template
  1031. #!
  1032. #!   The List template loads the entire set of selected records into
  1033. #!   a memory queue for displaying with a list box structure.
  1034. #!
  1035. #!   Since the entire queue is filled at load time, this template should
  1036. #!   not be used with very large files as they may overflow the primary
  1037. #!   virtual memory area and spill over to disk.  The result would be
  1038. #!   a listbox which works very slow and accesses the hard disk drive when
  1039. #!   scrolling.
  1040. #!
  1041. #!   A checkbox is available to view a file in Record order. This is
  1042. #!   primarily useful in viewing ASCII, DOS, or BASIC files.
  1043. #!   (The View template may also be used.)
  1044. #!
  1045. #!   If the Record Order checkbox is on, any reference to the
  1046. #!   PrimaryKey is ignored.  Deletes, and Updates may not be allowed
  1047. #!   with certain non-keyed data file types.
  1048. #!
  1049. #!   Also, a checkbox is available to display the queue in reverse
  1050. #!   order.  If both the Record Order checkbox, and the Reverse Order
  1051. #!   checkbox are on then the file will be displayed in Reverse record
  1052. #!   order.  If Just the Reverse Order checkbox is on, the file
  1053. #!   will be displayed in Reverse key order.
  1054. #!
  1055. #!   Use with an Update Procedure:
  1056. #!
  1057. #!   Since a Form template allows the multiple add ability, and
  1058. #!   since a List procedure may be used on a network, a checkbox
  1059. #!   has been added to control the rebuilding of the queue upon
  1060. #!   return from the Update Procedure.  When checked, the queue
  1061. #!   will always be rebuilt to accomodate any updates made by other
  1062. #!   network file users, or multiple record adds by another procedure.
  1063. #!
  1064. #!------------------------------------------------------------------------------
  1065. #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
  1066. #PROMPT('Range &Value Field',FIELD),%RangeValue
  1067. #PROMPT('Record Filter',@S180),%RecordFilter
  1068. #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
  1069. #PROMPT('First &Hot Field',FIELD),%First
  1070. #PROMPT('Last &Hot Field',FIELD),%Last
  1071. #PROMPT('Enable Hot Records',CHECK),%HotBar
  1072. #PROMPT('&Queue Rebuild',CHECK),%QueueRebuild
  1073. #PROMPT('Record Order',CHECK),%RecordOrder
  1074. #PROMPT('Reverse Order',CHECK),%ReverseOrder
  1075. #PROMPT('Progress &Indicator',CHECK),%ShowProg
  1076. #PROMPT('Progress &Character',@S8),%ProgChar
  1077. #PROTOTYPE('')
  1078. #INSERT(%StandardHeader)
  1079. #INSERT(%SetBrowseSymbols)
  1080.  
  1081. %Procedure       PROCEDURE
  1082.  
  1083. Queue            QUEUE                           !Listbox Queue contains
  1084. FilePointer      Ulong
  1085. #FIX(%File,%Primary)
  1086. #FIX(%Key,%PrimaryKey)
  1087. #SET(%FirstField, %Null)
  1088. #FOR(%KeyField)
  1089. QUE::%KeyField    LIKE(%KeyField)              #<! And Key element(s) for sort
  1090.   #IF(%FirstField = %Null)
  1091.     #SET(%FirstField, %KeyField)
  1092.     #SET(%FirstFieldSequence, %KeyFieldSequence)
  1093.   #ENDIF
  1094.   #IF(%RecordOrder = %Null)
  1095.     #IF(%KeyFieldSequence <> 'DESCENDING' AND %ReverseOrder = %Null)
  1096.       #SET(%SortString, (CLIP(LEFT(%SortString)) & ',+QUE::' & %KeyField))
  1097.     #ELSE
  1098.       #SET(%SortString, (CLIP(LEFT(%SortString)) & ',-QUE::' & %KeyField))
  1099.     #ENDIF
  1100.   #ENDIF
  1101. #ENDFOR
  1102. #IF((%RecordOrder AND %ReverseOrder))
  1103.   #SET(%SortString,(','& %FixRows+1))
  1104. #ENDIF
  1105. #FIX(%ScreenField,'?LIST')
  1106. Line             STRING(%ScreenFieldQueueSize) #<! Line to be scrolled
  1107.                  .
  1108. #IF(%KeyRangeField)
  1109.   #FIX(%Key,%PrimaryKey)
  1110.   #SET(%Found, %Null)
  1111.   #FOR(%KeyField)
  1112.     #IF(%Found <> 'Yes')
  1113. SAV::%KeyField  Like(%KeyField)
  1114.     #ENDIF
  1115.     #IF(%KeyField = %KeyRangeField)
  1116.      #SET(%Found, 'Yes')
  1117.     #ENDIF
  1118.   #ENDFOR
  1119. #ENDIF
  1120. ButtonIsDisabled BYTE                            !Flag to allow button enable
  1121. #INSERT(%CloseFilesFlags)
  1122. %LocalData
  1123. %ScreenStructure
  1124. %PulldownStructure
  1125. #EMBED('Data Section')
  1126.  
  1127. PreUpdateCount   ULONG                           !Records in file count.
  1128. FirstPage        BYTE                            !First page flag
  1129. #IF(%ShowProg)
  1130. VEW::Length      BYTE                            ! Progress variable
  1131. VEW::ProgString  STRING('<176>{80}')             ! Progress display variable
  1132. #ENDIF
  1133.  
  1134.   CODE
  1135.   #EMBED('Setup Procedure')
  1136.   #INSERT(%OpenPrimary)
  1137.   #INSERT(%OpenSecondaryFiles)
  1138.   OPEN(Screen)                                   !Open the screen
  1139.   #EMBED('Setup Screen')
  1140.   DISPLAY                                        !Display screen fields
  1141.   #INSERT(%BuildListIndex)
  1142.   IF ?LIST = %FirstEntryField                  #<!If no entry for ranges
  1143.     DO FillQueue                                 ! Fill the QUEUE
  1144.     IF RECORDS(Queue) = %FixRows               #<! If no QUEUE records
  1145.   #IF(%InsertExists)
  1146.       SELECT(?Insert)                            !  Select the Insert button
  1147.   #ELSIF(%UpdateProc)
  1148.       #INSERT(%RestoreRangeFields)
  1149.       SETKEYCODE(InsKey)                         ! Set action to Insert
  1150.       Do UpdateProcedure                         ! Call the update procedure
  1151.       DO FillQueue                               !  Fill the QUEUE
  1152.       IF RECORDS(Queue) = %FixRows             #<!  If still no records
  1153.         FREE(Queue)                              !   Free the QUEUE
  1154.         #INSERT(%CloseOpenedFiles)
  1155.         RETURN                                   !   Return to the caller
  1156.       END                                        !  End IF
  1157.   #ELSE
  1158.       FREE(Queue)                                !  Free the QUEUE
  1159.       #INSERT(%CloseOpenedFiles)
  1160.       RETURN                                     !  Return to the caller
  1161.   #ENDIF
  1162.     END                                          !  End IF
  1163.   END                                            !End IF
  1164.   LOOP                                           !Screen handling loop
  1165.   #FOR(%Formula)
  1166.     #IF(UPPER(%FormulaClass) <> 'LIST')
  1167.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  1168.     #INSERT(%GenerateFormula)
  1169.       #ENDIF
  1170.     #ENDIF
  1171.   #ENDFOR
  1172.     #EMBED('End of General Formulas')
  1173.     CASE SELECTED()                              !Jump to field setup routine
  1174.       #INSERT(%ScreenSetupRoutines)
  1175.     END                                          !End CASE
  1176.     ACCEPT                                       !Enable the keyboard
  1177.     CASE KEYCODE()                               !Jump to hotkey procedures
  1178.     #FOR(%HotKey)
  1179.     OF %HotKey                                   !User defined HotKey
  1180.       %HotKeyProc                                !HotKey Procedure
  1181.     #ENDFOR
  1182.     END                                          !End CASE
  1183.     IF REFER() AND SELECTED() = ?List |          !If list field is selected
  1184.        AND FIELD() < ?List                       ! From a prior changed field
  1185.       DO FillQueue                               !  Fill the QUEUE
  1186.     END                                          !End IF
  1187.     CASE FIELD()                                 !Jump to edit routine
  1188.   #FOR(%ScreenField)
  1189.     #IF(%ScreenField = '?Insert')
  1190.       #IF(%UpdateProc)
  1191.     OF ?Insert                                   !Process the Insert Button
  1192.         #IF(%ScreenFieldEdit)
  1193.       %ScreenFieldEdit                         #<! Insert button Edit Routine
  1194.         #ENDIF
  1195.       GET(%Primary,0)                          #<! Dereference current record
  1196.       #INSERT(%ClearFileFields)
  1197.       #INSERT(%RestoreRangeFields)
  1198.       PreUpdateCount = Records(%Primary)       #<! Save a record count
  1199.       SETKEYCODE(InsKey)                         ! Set action to Insert
  1200.       Do UpdateProcedure                         ! Call the update procedure
  1201.         #IF(%QueueRebuild)
  1202.       Do FillQueue                               ! Fill the QUEUE
  1203.         #ELSE
  1204.       CASE RECORDS(%Primary)                   #<! Check the record count
  1205.       OF PreUpdateCount                          !  If no change
  1206.         SELECT(?List)                            !   Reselect the list box
  1207.       OF PreUpdateCount + 1                      !  If 1 record added
  1208.           #FIX(%ScreenField,'?List')
  1209.         Line = %ScreenFieldExpression          #<!   Fill the QUEUE line
  1210.         FilePointer = POINTER(%Primary)        #<!   Save the file pointer
  1211.         #INSERT(%FillKeyValues)
  1212.         ADD(Queue %SortString)                 #<!   Add the record sorted
  1213.       ELSE                                       !  Otherwise
  1214.         Do FillQueue                             !   Rebuild the QUEUE
  1215.       END                                        !  End CASE
  1216.         #ENDIF
  1217.       SELECT(?List)                              ! Reselect the List field
  1218.       #ENDIF
  1219.     #ENDIF
  1220.     #IF(%ScreenField = '?Change')
  1221.       #IF(%UpdateProc)
  1222.     OF ?Change                                   !Process the Change Button
  1223.         #IF(%ScreenFieldEdit)
  1224.       %ScreenFieldEdit                         #<! Change button Edit Routine
  1225.         #ENDIF
  1226.       GET(Queue,CHOICE(?List))                   !Get the QUEUE element
  1227.       GET(%Primary,FilePointer)                #<!Get the record
  1228.       SETKEYCODE(EnterKey)                       ! Set action to Change
  1229.       Do UpdateProcedure                         ! Call the update procedure
  1230.         #IF(%QueueRebuild)
  1231.       Do FillQueue                               !  Fill the QUEUE
  1232.         #ENDIF
  1233.       SELECT(?List)                              ! Reselect the List field
  1234.       #ENDIF
  1235.     #ENDIF
  1236.     #IF(%ScreenField = '?Delete')
  1237.       #IF(%UpdateProc)
  1238.     OF ?Delete                                   !Process the Delete Button
  1239.         #IF(%ScreenFieldEdit)
  1240.       %ScreenFieldEdit                         #<! Delete button Edit Routine
  1241.         #ENDIF
  1242.       GET(Queue,CHOICE(?List))                   ! Get the QUEUE element
  1243.       GET(%Primary,FilePointer)                #<! Get the record
  1244.       SETKEYCODE(DelKey)                         ! Set action to Delete
  1245.       Do UpdateProcedure                         ! Call the update procedure
  1246.         #IF(%QueueRebuild)
  1247.       Do FillQueue                               !  Fill the QUEUE
  1248.         #ENDIF
  1249.       SELECT(?List)                              ! Reselect the List field
  1250.       #ENDIF
  1251.     #ENDIF
  1252.     #IF(%ScreenField = '?List')
  1253.     OF ?List                                     !Process the list field
  1254.       #IF(%HotBar OR %First)
  1255.       GET(Queue,CHOICE(?List))                   !  Get the QUEUE element
  1256.       GET(%Primary,FilePointer)                #<!  Get the record
  1257.       #ENDIF
  1258.       #IF(%ScreenFieldEdit)
  1259.       %ScreenFieldEdit                         #<! Exit button Edit Routine
  1260.       #ENDIF
  1261.       #IF(%First AND %Last)
  1262.       DISPLAY(?%First,?%Last)                  #<!  Display the hot fields
  1263.       #ELSIF(%First)
  1264.       DISPLAY(?%First)                         #<!  Display the hot fields
  1265.       #ENDIF
  1266.       #IF(%UpdateProc)
  1267.       CASE KEYCODE()                             ! Jump to keycode routine
  1268.         #IF(%NoButtonsExist OR %InsertExists)
  1269.       OF InsKey                                  ! For the insert key
  1270.         GET(%Primary,0)                        #<!  Dereference current record
  1271.         #INSERT(%ClearFileFields)
  1272.         Do UpdateProcedure                       ! Call the update procedure
  1273.           #IF(%QueueRebuild)
  1274.         Do FillQueue                             !  Fill the QUEUE
  1275.           #ENDIF
  1276.         #ENDIF
  1277.         #IF(%NoButtonsExist OR %DeleteExists)
  1278.       OF DelKey                                  ! For the delete key
  1279.         PreUpdateCount = Records(%Primary)       !  Save a record count
  1280.         GET(Queue,CHOICE(?List))                 !  Get the QUEUE element
  1281.         GET(%Primary,FilePointer)              #<!  Get the record
  1282.         Do UpdateProcedure                       ! Call the update procedure
  1283.           #IF(%QueueRebuild)
  1284.         Do FillQueue                             !  Fill the QUEUE
  1285.           #ELSE
  1286.         IF RECORDS(%Primary) = PreUpdateCount -1 #<! If the record was deleted
  1287.           DELETE(Queue)                          !  Delete the Queue entry
  1288.         END                                      ! End IF
  1289.           #ENDIF
  1290.         #ENDIF
  1291.         #IF(%NoButtonsExist OR %ChangeExists )
  1292.       OF EnterKey                                ! Or the enter key
  1293.       OROF MouseLeft2                            ! Or a double mouse click
  1294.         GET(Queue,CHOICE(?List))                 !  Get the QUEUE element
  1295.         GET(%Primary,FilePointer)              #<!  Get the record
  1296.         Do UpdateProcedure                       ! Call the update procedure
  1297.           #IF(%QueueRebuild)
  1298.         Do FillQueue                             !  Fill the QUEUE
  1299.           #ENDIF
  1300.         #ENDIF
  1301.       END                                        ! End CASE keycode
  1302.       #ENDIF
  1303.     #ELSIF(%ScreenField = '?Exit')
  1304.     OF ?Exit                                     !Process the Exit button
  1305.       #IF(%ScreenFieldEdit)
  1306.       %ScreenFieldEdit                         #<! Exit button Edit Routine
  1307.       #ENDIF
  1308.       BREAK                                      ! Return to caller
  1309.     #ELSIF(%ScreenFieldEdit)
  1310.     OF %ScreenField                            #<! Completed %ScreenField
  1311.       %ScreenFieldEdit                         #<!  %ScreenField edit routine
  1312.     #ENDIF
  1313.   #ENDFOR
  1314.     #INSERT(%PulldownEditRoutines)
  1315.     END                                          !End CASE FIELD()
  1316.     DISPLAY
  1317.   END                                            !End LOOP
  1318.   FREE(Queue)                                    !Free the QUEUE
  1319.   #IF(%Pulldown)                                #!If a Pulldown exists
  1320.   CLOSE(%Pulldown)                             #<!Close the Pulldown
  1321.   #ENDIF
  1322.   #INSERT(%CloseOpenedFiles)
  1323.  
  1324. #EMBED('End of Procedure')
  1325.  
  1326. FillQueue Routine
  1327.  
  1328.   #EMBED('Start of Fill Queue Routine')
  1329.   FREE(Queue)                                  #<!Clear the QUEUE
  1330.   Firstpage = 1                                  !Set the FirstPage flag
  1331.   #IF(%ShowProg)                                #!If showing the progress
  1332.   VEW::Length = 1                                !Set the status bar counter
  1333.   #ENDIF
  1334.   #FIX(%ScreenField,'?List')
  1335.   #FOR(%ScreenFieldFix)
  1336.   Line = %ScreenFieldFix                       #<!Add list box fields
  1337.     #IF(%RecordOrder = %Null)
  1338.       #IF(%FirstFieldSequence <> 'DESCENDING' AND %ReverseOrder = %Null)
  1339.   CLEAR(QUE::%FirstField)                      #<!Clear the key field
  1340.       #ELSE
  1341.   CLEAR(QUE::%FirstField,1)                    #<!Clear the key field
  1342.       #ENDIF
  1343.     #ENDIF
  1344.   ADD(Queue)                                     !Add the fixed line
  1345.   DISPLAY(?List)                               #<!Blank the listbox
  1346.   #ENDFOR
  1347.   #IF(%RecordOrder)
  1348.   SET(%Primary)                                #<!Set to file order
  1349.   #ELSIF(%KeyRangeField)
  1350.     #IF(%ReverseOrder)
  1351.   CLEAR(%FilePre:RECORD,1)                     #<!Clear to highest value
  1352.     #ELSE
  1353.   CLEAR(%FilePre:RECORD)                       #<!Clear to lowest value
  1354.     #ENDIF
  1355.   %KeyRangeField = %RangeValue                 #<!Fill range field
  1356.   SET(%PrimaryKey,%PrimaryKey)                 #<!Set to keyed order
  1357.   #ELSE
  1358.   SET(%PrimaryKey)                             #<!Set to keyed order
  1359.   #ENDIF
  1360.   #IF(%ShowProg)                                #!If showing the progress
  1361.   VEW::ProgString = ALL(%ProgChar)             #<!Fill the progress string
  1362.   #ENDIF
  1363.   LOOP                                           !Get all selected records
  1364.   #IF(%RecordOrder)
  1365.     NEXT(%Primary)                             #<! Get the next record.
  1366.   #ELSIF(%ReverseOrder)
  1367.     PREVIOUS(%Primary)                         #<! Get the previous record
  1368.   #ELSE
  1369.     NEXT(%Primary)                             #<! Get the next record.
  1370.   #ENDIF
  1371.     IF ERRORCODE() THEN BREAK.                   ! Quit if an error occurs
  1372.     #INSERT(%GetSecondaryRecords)
  1373.   #FIX(%File,%Primary)
  1374.   #FIX(%Key,%PrimaryKey)
  1375.   #IF(%KeyRangeField)                           #!If using a Range
  1376.     IF %KeyRangeField <> %RangeValue           #<! If not in Range
  1377.       BREAK                                    #<!  Break out of the Loop
  1378.     END                                          ! End IF
  1379.   #ENDIF
  1380.   #IF(%RecordFilter)
  1381.     IF ~(%RecordFilter)                        #<! If Filter condition not met
  1382.       CYCLE                                      !  Try another record
  1383.     END                                          ! End IF
  1384.   #ELSE
  1385.     #FOR(%Formula)
  1386.       #IF(UPPER(%FormulaClass) = 'FILTER')
  1387.         #IF(%FormulaType <> 'COMPUTED')
  1388.     IF ~(%FormulaCondition)                    #<! If Filter condition not met
  1389.       CYCLE                                      !  Try another record
  1390.     END                                          ! End IF
  1391.         #ELSE
  1392.     IF ~(%FormulaComputation)                  #<! If Filter condition not met
  1393.       CYCLE                                      !  Try another record
  1394.     END                                          ! End IF
  1395.         #ENDIF
  1396.       #ENDIF
  1397.     #ENDFOR
  1398.   #ENDIF
  1399.   #FOR(%Formula)
  1400.     #IF(UPPER(%FormulaClass) = 'LIST')
  1401.     #INSERT(%GenerateFormula)
  1402.     #ENDIF
  1403.   #ENDFOR
  1404.     #EMBED('LIST Class formula')
  1405.   #IF(%ShowProg)                                #!If showing the progress
  1406.     #INSERT(%ShowFileProgress)                  #!Insert the progress code
  1407.   #ENDIF
  1408.   #FIX(%ScreenField,'?LIST')
  1409.     Line = %ScreenFieldExpression              #<! Fill the QUEUE line
  1410.     FilePointer = POINTER(%Primary)            #<! Fill the file pointer
  1411.   #FOR(%KeyField)
  1412.     QUE::%KeyField =%KeyField                  #<! Fill the key field
  1413.   #ENDFOR
  1414.     ADD(Queue %SortString)                     #<! Add to the QUEUE
  1415.     IF ERRORCODE() THEN BREAK.                   ! Quit out if error
  1416.     IF FirstPage                                 ! If page 1
  1417.       IF RECORDS(Queue) = ROWS(?List)            !  If we have a full screen
  1418.         FirstPage = 0                            !   turn off the page flag
  1419.       END                                        !  End IF
  1420.       DISPLAY(?List)                             !  Display page 1
  1421.     END                                          ! End IF
  1422.     LOOP WHILE KEYBOARD()                        ! While Keyboard Input
  1423.       SELECT(?List)                              !  Select the List box
  1424.       ACCEPT                                     !  Accept a Key
  1425.       IF KEYCODE() = EscKey                      !  If the Escape key
  1426.         FREE(Queue)                              !   Free the QUEUE
  1427.         #INSERT(%CloseOpenedFiles)
  1428.         RETURN                                   !   Return to caller
  1429.       END                                        !  End IF
  1430.       DISPLAY(?List)                             !  Redisplay the list box
  1431.     END                                          ! End LOOP
  1432.   END                                            !End LOOP
  1433.   #IF(%ShowProg)                                #!If showing the progress
  1434.   ERASE(?StatusLine)                             !Clear the StatusLine
  1435.   #ENDIF
  1436.   DISPLAY                                        !Redisplay the screen
  1437.  
  1438. #IF(%UpdateProc)
  1439. UpdateProcedure  ROUTINE
  1440.   #EMBED('Prior to Update Procedure')
  1441.   %UpdateProc
  1442.   #EMBED('After Update Procedure')
  1443. #ENDIF
  1444. #!
  1445. #PROCEDURE(Select,'Select a record from a file'),SCREEN,PULLDOWN
  1446. #!------------------------------------------------------------------------------
  1447. #!
  1448. #!                           The Select Template
  1449. #!
  1450. #!                  Select a record from a file into memory
  1451. #!
  1452. #!------------------------------------------------------------------------------
  1453. #MAP('BROWSE.INC')
  1454. #PROJECT('%clapfx%BROWS.LIB')
  1455. #PROTOTYPE('')
  1456. #!
  1457. #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
  1458. #PROMPT('Range &Value Field',FIELD),%RangeValue
  1459. #PROMPT('Record Filter',@S180),%RecordFilter
  1460. #PROMPT('Locator Field',COMPONENT),%Locator
  1461. #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
  1462. #PROMPT('First &Hot Field',FIELD),%First
  1463. #PROMPT('Last &Hot Field',FIELD),%Last
  1464. #PROMPT('Enable Hot Records',CHECK),%HotBar
  1465. #!
  1466. #INSERT(%SetBrowseSymbols)
  1467. #INSERT(%BrowseErrorCheck)
  1468. #INSERT(%StandardHeader)
  1469.  
  1470. %Procedure       PROCEDURE
  1471.  
  1472. #FIX(%ScreenField,'?List')
  1473. Queue            QUEUE
  1474.                    STRING(%ScreenFieldQueueSize)
  1475.                  END
  1476. #IF(%KeyRangeField)
  1477.   #FIX(%Key,%PrimaryKey)
  1478.   #SET(%Found, %Null)
  1479.   #FOR(%KeyField)
  1480.     #IF(%Found <> 'Yes')
  1481. SAV::%KeyField  Like(%KeyField)
  1482.     #ENDIF
  1483.     #IF(%KeyField = %KeyRangeField)
  1484.      #SET(%Found, 'Yes')
  1485.     #ENDIF
  1486.   #ENDFOR
  1487. #ENDIF
  1488. ButtonIsDisabled BYTE                            !Flag to allow button enable
  1489. #INSERT(%CloseFilesFlags)
  1490. %LocalData
  1491. %ScreenStructure
  1492. %PulldownStructure
  1493. #EMBED('Data Section')
  1494.  
  1495.   CODE
  1496.   #EMBED('Setup Procedure')
  1497.   #INSERT(%OpenPrimary)
  1498.   #INSERT(%OpenSecondaryFiles)
  1499.   OPEN(Screen)                                   !Open the screen
  1500.   #EMBED('Setup Screen')
  1501.   DISPLAY                                        !Display screen fields
  1502.   #INSERT(%SaveRangeFields)
  1503.   #IF(%Pulldown)                                #!If a Pulldown exists
  1504.   OPEN(%Pulldown)                              #<!Open the Pulldown
  1505.   #ENDIF
  1506.   #INSERT(%AddFixedListLines)
  1507.   #INSERT(%BeginBrowse)
  1508.   LOOP                                           !Process browse requests
  1509.     CASE BrowseAction(%Primary,%PrimaryKey,Queue)#<!Browse the file
  1510.     OF FormatQueue                               !Format a QUEUE element
  1511.       #INSERT(%GetSecondaryRecords)
  1512.   #FOR(%Formula)
  1513.     #IF(UPPER(%FormulaClass) = 'LIST')
  1514.       #INSERT(%Generateformula)
  1515.     #ENDIF
  1516.   #ENDFOR
  1517.       #EMBED('LIST Class formula')
  1518.   #FIX(%ScreenField,'?List')
  1519.       Queue = %ScreenFieldExpression             !Format the QUEUE line
  1520.     OF ProcessField                              !Process a field
  1521.   #FOR(%Formula)
  1522.     #IF(UPPER(%FormulaClass) <> 'LIST')         #!
  1523.       #INSERT(%GenerateFormula)                 #! Generate Formulas
  1524.     #ENDIF
  1525.   #ENDFOR
  1526.       #EMBED('End of General Formulas')
  1527.   #IF(%HotKeyExists)
  1528.       CASE KEYCODE()
  1529.     #FOR(%HotKey)
  1530.       OF %HotKey                               #<!User defined HotKey
  1531.         %HotKeyProc                            #<!HotKey Procedure
  1532.     #ENDFOR
  1533.       END
  1534.   #ENDIF
  1535.       IF SELECTED() <> FIELD()                   ! If a new field is selected
  1536.         CASE SELECTED()                          ! Jump to setup routine
  1537.   #IF(%KeyRangeField)
  1538.         OF ?List
  1539.           #INSERT(%SaveRangeFields)
  1540.   #ENDIF
  1541.         #INSERT(%ScreenSetupRoutines)
  1542.         END                                      ! End CASE SELECTED()
  1543.       END                                        ! End IF
  1544.       CASE FIELD()                               !Jump to edit routine
  1545.   #FOR(%ScreenField)
  1546.     #IF(%ScreenField = '?List')
  1547.       OF ?List                                   !Process the list field
  1548.         CASE KEYCODE()                           !Jump to keycode routine
  1549.       #IF(%UpdateProc)
  1550.         #IF(%NoButtonsExist OR %InsertExists)
  1551.         OF InsKey                                !For the insert key
  1552.           #INSERT(%ClearFileFields)
  1553.           Do UpdateProcedure                     ! Call the update procedure
  1554.         #ELSIF(%ChangeExists <> 'YES')
  1555.         OF InsKey                                !For the insert key
  1556.           #INSERT(%ClearFileFields)
  1557.           Do UpdateProcedure                     ! Call the update procedure
  1558.         #ENDIF
  1559.         #IF(%ChangeExists)
  1560.         OF CtrlEnter                             !Or the Ctrl-Enter key
  1561.           Do UpdateProcedure                     ! Call the update procedure
  1562.         #ELSIF(%InsertExists <> 'YES')
  1563.         OF CtrlEnter                             !Or the Ctrl-Enter key
  1564.           Do UpdateProcedure                     ! Call the update procedure
  1565.         #ENDIF
  1566.       #ENDIF
  1567.         OF MouseLeft2                            !On mouse double click
  1568.         OROF EnterKey                            !or the enter key
  1569.           SELECT(?Select)                        ! Select the Select button
  1570.           PRESS(EnterKey)                        ! And complete it.
  1571.         END                                      !End CASE
  1572.     #ELSIF(%ScreenField = '?Insert')
  1573.       #IF(%UpdateProc)
  1574.       OF ?Insert                                 !Process the Insert Button
  1575.         #IF(%ScreenFieldEdit)
  1576.         %ScreenFieldEdit                       #<!Insert button Edit Routine
  1577.         #ENDIF
  1578.         #INSERT(%ClearFileFields)
  1579.         #INSERT(%RestoreRangeFields)
  1580.         SETKEYCODE(InsKey)                       !Set action to Insert
  1581.         Do UpdateProcedure                       ! Call the update procedure
  1582.         SELECT(?List)                            !Reselect the List field
  1583.       #ENDIF
  1584.     #ELSIF(%ScreenField = '?Change')
  1585.       #IF(%UpdateProc)
  1586.       OF ?Change                                 !Process the Change Button
  1587.         #IF(%ScreenFieldEdit)
  1588.         %ScreenFieldEdit                       #<!Change button Edit Routine
  1589.         #ENDIF
  1590.         SETKEYCODE(EnterKey)                     !Set action to Change
  1591.         Do UpdateProcedure                       ! Call the update procedure
  1592.         SELECT(?List)                            !Reselect the List field
  1593.       #ENDIF
  1594.     #ELSIF(%ScreenField = '?Select')
  1595.       OF ?Select                                 !Process the Select button
  1596.       #IF(%ScreenFieldEdit)
  1597.         %ScreenFieldEdit                       #<!Select button Edit Routine
  1598.       #ENDIF
  1599.         BREAK
  1600.     #ELSIF(%ScreenField = '?Cancel')
  1601.       OF ?Cancel                                 !Process the Select button
  1602.       #IF(%ScreenFieldEdit)
  1603.         %ScreenFieldEdit                       #<!Select button Edit Routine
  1604.       #ENDIF
  1605.         #INSERT(%ClearFileFields)
  1606.         BREAK
  1607.     #ELSIF(%ScreenFieldEdit)
  1608.       OF %ScreenField                          #<! Completed %ScreenField
  1609.         %ScreenFieldEdit                       #<!  %ScreenField edit routine
  1610.     #ENDIF
  1611.   #ENDFOR
  1612.       #INSERT(%PulldownEditRoutines)
  1613.       END                                        !End CASE FIELD()
  1614.     OF NoRecords                                 !No records to browse
  1615.       #INSERT(%ClearFileFields)
  1616.       #INSERT(%RestoreRangeFields)
  1617.       DISPLAY
  1618.   #IF(%ChangeExists)
  1619.       DISABLE(?Change)                           ! Disable the change button
  1620.   #ENDIF
  1621.   #IF(%DeleteExists)
  1622.       DISABLE(?Delete)                           ! Disable the delete button
  1623.   #ENDIF
  1624.       ButtonIsDisabled = TRUE
  1625.       IF RECORDS(%Primary)                     #<! If file is not empty
  1626.         IF ?List <> %FirstEntryField           #<!  And list is not first
  1627.           SELECT(%FirstEntryField)             #<!   Select the first field
  1628.         ELSE                                     !  Else
  1629.   #IF(%UpdateProc)
  1630.     #IF(%InsertExists)
  1631.           SELECT(?Insert)                        !   Select the Insert Button
  1632.     #ELSE
  1633.           #INSERT(%RestoreRangeFields)
  1634.           SETKEYCODE(InsKey)                     !   Ask for a new record
  1635.           DO UpdateProcedure                     !   Call the update procedure
  1636.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  1637.             BREAK                                !    Return to caller
  1638.           ELSE                                   !   Else record was added
  1639.       #IF(%ChangeExists)
  1640.             ENABLE(?Change)                      !   Disable the change button
  1641.       #ENDIF
  1642.       #IF(%DeleteExists)
  1643.             ENABLE(?Delete)                      !   Disable the delete button
  1644.       #ENDIF
  1645.             ButtonIsDisabled = FALSE
  1646.           END                                    !   End IF
  1647.     #ENDIF
  1648.   #ELSE
  1649.           BREAK                                  !   Return to caller
  1650.   #ENDIF
  1651.         END                                      !  End IF
  1652.       ELSE                                       ! Else if file is empty
  1653.   #IF(%UpdateProc)
  1654.         #INSERT(%RestoreRangeFields)
  1655.         SETKEYCODE(InsKey)                       !  Ask for a new record
  1656.         DO UpdateProcedure                       !  Call the update procedure
  1657.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  1658.             BREAK                                !    Return to caller
  1659.           ELSE                                   !   Else record was added
  1660.     #IF(%ChangeExists)
  1661.             ENABLE(?Change)                      !   Disable the change button
  1662.     #ENDIF
  1663.     #IF(%DeleteExists)
  1664.             ENABLE(?Delete)                      !   Disable the delete button
  1665.     #ENDIF
  1666.             ButtonIsDisabled = FALSE
  1667.           END                                    !   End IF
  1668.   #ELSE
  1669.         BREAK                                    !  Return to caller
  1670.   #ENDIF
  1671.       END                                        ! End IF
  1672.   #IF(%FilterExists OR %KeyRangeField)
  1673.     OF FilterRecord                              !Should we add this record
  1674.       IF ButtonIsDisabled
  1675.     #IF(%ChangeExists)
  1676.         ENABLE(?Change)                          ! Enable the change button
  1677.     #ENDIF
  1678.     #IF(%DeleteExists)
  1679.         ENABLE(?Delete)                          ! Enable the delete button
  1680.     #ENDIF
  1681.         ButtonIsDisabled = FALSE
  1682.       END
  1683.     #IF(%KeyRangeField)                         #!If using range limits
  1684.       #IF(%RangeValue)                          #! If using range value field
  1685.       IF (%KeyRangeField <> %RangeValue)       #<! If range field has changed
  1686.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  1687.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  1688.         CYCLE                                    !  Cycle for BrowseAction
  1689.       END                                        ! End IF
  1690.       #ELSE
  1691.         #SET(%Found, %Null)
  1692.         #FOR(%KeyField)
  1693.           #IF(%Found <> 'Yes')
  1694.       IF (%KeyField <> SAV::%KeyField)         #<! If range field has changed
  1695.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  1696.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  1697.         CYCLE                                    !  Cycle for BrowseAction
  1698.       END                                        ! End IF
  1699.           #ENDIF
  1700.           #IF(%KeyField = %KeyRangeField)
  1701.             #SET(%Found, 'Yes')
  1702.           #ENDIF
  1703.         #ENDFOR
  1704.       #ENDIF
  1705.     #ENDIF
  1706.     #IF(%RecordFilter)
  1707.       IF ~(%RecordFilter)                      #<!If Filter condition not met
  1708.         GET(%Primary,0)                        #<! Dereference the record
  1709.         CYCLE                                    ! Return to Top of LOOP
  1710.       END                                        !End IF
  1711.     #ELSE
  1712.       #FOR(%Formula)
  1713.         #IF(UPPER(%FormulaClass) = 'FILTER')
  1714.           #IF(%FormulaType <> 'COMPUTED')
  1715.       IF ~(%FormulaCondition)                  #<!If Filter condition not met
  1716.         GET(%Primary,0)                        #<! Dereference the record
  1717.         CYCLE                                    ! Return to Top of LOOP
  1718.       END                                        !End IF
  1719.           #ELSE
  1720.       IF ~(%FormulaComputation)                #<!If Filter condition not met
  1721.         GET(%Primary,0)                        #<! Dereference the record
  1722.         CYCLE                                    ! Return to Top of LOOP
  1723.       END                                        !End IF
  1724.           #ENDIF
  1725.         #ENDIF
  1726.       #ENDFOR
  1727.     #ENDIF
  1728.       #EMBED('After Filter and Range Check')
  1729.   #ENDIF
  1730.   #IF(%KeyRangeField)
  1731.     OF ResetFirst                                !Set to first in a Range
  1732.       CLEAR(%FilePre:RECORD,-1)
  1733.       #INSERT(%RestoreRangeFields)
  1734.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  1735.       #EMBED('Set to First Record')
  1736.     OF ResetLast                                 !Set to last in a Range
  1737.       CLEAR(%FilePre:RECORD,1)
  1738.       #INSERT(%RestoreRangeFields)
  1739.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  1740.       #EMBED('Set to Last Record')
  1741.   #ENDIF
  1742.   #IF(%HotBar OR %First)
  1743.     OF ProcessSelected                           !Process highlighted record
  1744.       #INSERT(%GetSecondaryRecords)
  1745.     #FOR(%Formula)
  1746.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  1747.       #INSERT(%GenerateFormula)
  1748.       #ENDIF
  1749.     #ENDFOR
  1750.       #EMBED('Process Selected Record')
  1751.     #IF(%First AND %Last)
  1752.       DISPLAY(?%First,?%Last)                  #<!  Display the hot fields
  1753.     #ELSIF(%First)
  1754.       DISPLAY(?%First)                         #<!  Display the hot fields
  1755.     #ENDIF
  1756.   #ENDIF
  1757.     END                                          !End CASE
  1758.   END                                            !End LOOP
  1759.   EndBrowse                                      !End the browse session
  1760.   FREE(Queue)                                    !Free the Queue memory
  1761.   #IF(%Pulldown)                                #!If a Pulldown exists
  1762.   CLOSE(%Pulldown)                             #<!Close the Pulldown
  1763.   #ENDIF
  1764.   #INSERT(%CloseOpenedFiles)
  1765. #EMBED('End of Procedure')
  1766. #IF(%UpdateProc)
  1767.  
  1768. UpdateProcedure  ROUTINE
  1769.   #EMBED('Prior to Update Procedure')
  1770.   %UpdateProc
  1771.   #EMBED('After Update Procedure')
  1772. #ENDIF
  1773. #!
  1774. #!***************************************************************************
  1775. #GROUP(%ShowFileProgress)
  1776. VEW::Length += 1
  1777. StatusLine = ' Reading File: ' & SUB(VEW::ProgString,1,VEW::Length)
  1778. IF VEW::Length = LEN(StatusLine) - 15
  1779.   VEW::Length = 1
  1780.   StatusLine = ' Reading File: ' & ' {65}'
  1781. END
  1782. Display(?StatusLine)
  1783. #!
  1784. #!***************************************************************************
  1785. #GROUP(%SetBrowseSymbols)
  1786.   #SET(%FirstEntryField,%Null)
  1787.   #SET(%NoButtonsExist,%Null)
  1788.   #SET(%InsertExists,%Null)
  1789.   #SET(%ChangeExists,%Null)
  1790.   #SET(%DeleteExists,%Null)
  1791.   #SET(%ExitExists,%Null)
  1792.   #SET(%FileExists,%Null)
  1793.   #SET(%FilterExists,%Null)
  1794.   #SET(%HotKeyExists,%Null)
  1795.   #SET(%ScreenFldSetupExists,%Null)
  1796.   #SET(%ScreenFldEditExists,%Null)
  1797.   #FOR(%File)
  1798.     #SET(%FileExists,'YES')
  1799.     #BREAK
  1800.   #ENDFOR
  1801.   #FIX(%File,%Primary)
  1802.   #FOR(%HotKey)
  1803.     #SET(%HotKeyExists,'YES')
  1804.     #BREAK
  1805.   #ENDFOR
  1806.   #FOR(%Formula)
  1807.     #IF(UPPER(%FormulaClass) = 'FILTER')
  1808.       #SET(%FilterExists, 'YES')
  1809.     #ENDIF
  1810.   #ENDFOR
  1811.   #IF(%RecordFilter)
  1812.     #SET(%FilterExists, 'YES')
  1813.   #ENDIF
  1814.   #SET(%FirstEntryFound,%Null)
  1815.   #FOR(%ScreenField)
  1816.     #SET(%ScreenFieldExists,'YES')
  1817.     #IF(%FirstEntryFound = %Null)
  1818.       #SET(%FirstEntryField, (%FirstEntryField + 1))
  1819.       #IF(%ScreenFieldSkip <> 'Y')
  1820.         #SET(%FirstEntryFound,'YES')
  1821.       #ENDIF
  1822.     #ENDIF
  1823.     #IF(%ScreenFieldType = 'BUTTON')
  1824.       #IF(UPPER(%ScreenField) = '?INSERT')
  1825.         #SET(%InsertExists, 'YES')
  1826.       #ELSIF(UPPER(%ScreenField) = '?CHANGE')
  1827.         #SET(%ChangeExists, 'YES')
  1828.       #ELSIF(UPPER(%ScreenField) = '?DELETE')
  1829.         #SET(%DeleteExists, 'YES')
  1830.       #ELSIF(UPPER(%ScreenField) = '?EXIT')
  1831.         #SET(%ExitExists, 'YES')
  1832.       #ENDIF
  1833.     #ENDIF
  1834.     #IF(%ScreenFieldSetup)
  1835.       #SET(%ScreenFldSetupExists,'YES')
  1836.     #ENDIF
  1837.     #IF(%ScreenFieldEdit)
  1838.       #SET(%ScreenFldEditExists,'YES')
  1839.     #ENDIF
  1840.   #ENDFOR
  1841.   #IF(%InsertExists=%Null AND %ChangeExists=%Null AND %DeleteExists=%Null)
  1842.     #SET(%NoButtonsExist, 'YES')
  1843.   #ENDIF
  1844.   #SET(%FixRows, '0')
  1845.   #FIX(%ScreenField,'?List')
  1846.   #FOR(%ScreenFieldFix)
  1847.     #SET(%FixRows, (%FixRows + 1))
  1848.   #ENDFOR
  1849. #!
  1850. #!***************************************************************************
  1851. #GROUP(%LookupRecord)                           #!Group to Lookup a record
  1852. #IF(%FromLookup)
  1853.   #IF(%LookupPicture)
  1854. DeformatString = CONTENTS(SELECTED())          #<! Fill the Key Value
  1855.   #ELSE
  1856. %LookupField = CONTENTS(SELECTED())            #<! Fill the Key Value
  1857.   #ENDIF
  1858. #ELSE
  1859.   #IF(%LookupPicture)
  1860. DeformatString = CONTENTS(FIELD())             #<! Fill the Key Value
  1861.   #ELSE
  1862. %LookupField = CONTENTS(FIELD())               #<! Fill the Key Value
  1863.   #ENDIF
  1864. #ENDIF
  1865. #IF(%LookupPicture)
  1866. %LookupField = DEFORMAT(DeformatString,%LookupPicture)
  1867. #ENDIF
  1868. GET(%Primary,%LookupKey)                       #<! Get the matching record
  1869. IF ~ERRORCODE()                                #<! If found then return
  1870.   #INSERT(%CloseOpenedFiles)
  1871.   RETURN
  1872. END
  1873. #!***************************************************************************
  1874. #GROUP(%AddFixedListLines)                   #!Group to add any QUEUE fixed
  1875. #FIX(%ScreenField,'?List')                   #! lines to the QUEUE.
  1876. #FOR(%ScreenFieldFix)
  1877. Queue = %ScreenFieldFix                      #<!Add fixed listbox line
  1878. ADD(Queue)                                     ! to the QUEUE
  1879. #ENDFOR
  1880. #!***************************************************************************
  1881. #GROUP(%BeginBrowse)
  1882.   #IF(%Locator)                                #!Conditionally initialize
  1883.     #IF(%HotBar OR %First)                     #! the browse session manager
  1884. BeginBrowse(?List,?%Locator,1)                 #<!Begin a browse session
  1885.     #ELSE
  1886. BeginBrowse(?List,?%Locator)                   #<!Begin a browse session
  1887.     #ENDIF
  1888. #ELSE
  1889.     #IF(%HotBar OR %First)
  1890. BeginBrowse(?List,,1)                          #<!Begin a browse session
  1891.     #ELSE
  1892. BeginBrowse(?List)                             #<!Begin a browse session
  1893.     #ENDIF
  1894.   #ENDIF
  1895. #!***************************************************************************
  1896. #GROUP(%BrowseEditRoutines)
  1897. #FOR(%ScreenField)                             #! on a screen field
  1898.   #IF(%ScreenFieldEdit)                        #! And not on one of the
  1899.     #IF(UPPER(%ScreenField)<>'?INSERT')        #! predefined buttons
  1900.       #IF(UPPER(%ScreenField)<>'?CHANGE')
  1901.         #IF(UPPER(%ScreenField)<>'?DELETE')
  1902.           #IF(UPPER(%ScreenField)<>'?EXIT')
  1903. OF %ScreenField                                #<!Edit Procedure or source
  1904.   %ScreenFieldEdit                             #<! for %ScreenField
  1905.           #ENDIF
  1906.         #ENDIF
  1907.       #ENDIF
  1908.     #ENDIF
  1909.   #ENDIF
  1910. #ENDFOR
  1911. #!
  1912. #! *******************************************************************
  1913. #GROUP(%ListEditRoutines)
  1914. #FOR(%ScreenField)                             #! On a screen field
  1915.   #IF(%ScreenFieldEdit)                        #! And not on one of the
  1916.     #IF(UPPER(%ScreenField)<>'?INSERT')        #! predefined buttons
  1917.       #IF(UPPER(%ScreenField)<>'?CHANGE')
  1918.         #IF(UPPER(%ScreenField)<>'?DELETE')
  1919. OF %ScreenField                                #<!Edit Procedure or source
  1920.   %ScreenFieldEdit                             #<! for %ScreenField
  1921.         #ENDIF
  1922.       #ENDIF
  1923.     #ENDIF
  1924.   #ENDIF
  1925. #ENDFOR
  1926. #!
  1927. #!***************************************************************************
  1928. #GROUP(%FillKeyValues)
  1929. #FOR(%KeyField)
  1930. QUE::%KeyField =%KeyField                      #<!   Fill any key fields
  1931. #ENDFOR
  1932. #!
  1933. #!***************************************************************************
  1934. #GROUP(%BrowseErrorCheck)
  1935. #!
  1936. #IF(%Primary = %Null)
  1937.   #SET(%ErrorMessage, (%Procedure & ' ERROR: No file has been chosen for this procedure.'))
  1938.   #ERROR(%ErrorMessage)
  1939.   #SET(%ErrorMessage, ' A file must be selected for this procedure.')
  1940.   #ERROR(%ErrorMessage)
  1941. #ENDIF
  1942. #IF(%PrimaryKey = %Null)
  1943.   #SET(%ErrorMessage, (%Procedure & ' ERROR: No Access Key has been chosen for this procedure.'))
  1944.   #ERROR(%ErrorMessage)
  1945.   #SET(%ErrorMessage, ' An Access Key must be identified on the File Schematic.')
  1946.   #ERROR(%ErrorMessage)
  1947. #ENDIF
  1948. #IF(%KeyRangeField)
  1949.   #IF(%KeyRangeField = %RangeValue)
  1950.     #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must'))
  1951.     #ERROR(%ErrorMessage)
  1952.     #SET(%ErrorMessage, ' be separate fields.')
  1953.     #ERROR(%ErrorMessage)
  1954.   #ENDIF
  1955. #ENDIF
  1956. #IF(%First)
  1957.   #SET(%FirstHotEquate, ('?' & %First))
  1958.   #FIX(%ScreenField,%FirstHotEquate)
  1959.   #IF(%ScreenField <> %FirstHotEquate)
  1960.     #SET(%ErrorMessage, (%Procedure & ' ERROR: the First Hot field must be a display'))
  1961.     #ERROR(%ErrorMessage)
  1962.     #SET(%ErrorMessage, ' field on the SCREEN. ')
  1963.     #ERROR(%ErrorMessage)
  1964.   #ENDIF
  1965. #ENDIF
  1966. #IF(%Last)
  1967.   #SET(%LastHotEquate, ('?' & %Last))
  1968.   #FIX(%ScreenField,%LastHotEquate)
  1969.   #IF(%ScreenField <> %LastHotEquate)
  1970.     #SET(%ErrorMessage, (%Procedure & ' ERROR: the Last Hot field must be a display'))
  1971.     #ERROR(%ErrorMessage)
  1972.     #SET(%ErrorMessage, ' field on the SCREEN. ')
  1973.     #ERROR(%ErrorMessage)
  1974.   #ENDIF
  1975. #ENDIF
  1976. #FIX(%File,%Primary)
  1977. #IF(%DisplayKey)
  1978.   #FIX(%Key,%DisplayKey)
  1979. #ELSE
  1980.   #FIX(%Key,%PrimaryKey)
  1981. #ENDIF
  1982. #IF(%Locator)
  1983.   #SET(%FieldFound,%Null)
  1984.   #FOR(%KeyField)
  1985.     #IF(%KeyField = %Locator)
  1986.       #SET(%FieldFound,'Yes')
  1987.       #BREAK
  1988.     #ENDIF
  1989.   #ENDFOR
  1990.   #IF(%FieldFound = %Null)
  1991.     #SET(%ErrorMessage, (%Procedure & ' ERROR: the Locator Field must be a component of'))
  1992.     #ERROR(%ErrorMessage)
  1993.     #SET(%ErrorMessage, (' the ' & %Key & ' key.'))
  1994.     #ERROR(%ErrorMessage)
  1995.   #ENDIF
  1996. #ENDIF
  1997. #FIX(%Key,%PrimaryKey)
  1998. #IF(%KeyRangeField)
  1999.   #SET(%FieldFound,%Null)
  2000.   #FOR(%KeyField)
  2001.     #IF(%KeyField = %KeyRangeField)
  2002.       #SET(%FieldFound,'Yes')
  2003.       #BREAK
  2004.     #ENDIF
  2005.   #ENDFOR
  2006.   #IF(%FieldFound = %Null)
  2007.     #SET(%ErrorMessage, (%Procedure & ' ERROR: Key Range Field must be a component of the'))
  2008.     #ERROR(%ErrorMessage)
  2009.     #SET(%ErrorMessage, ' File Access Key')
  2010.     #ERROR(%ErrorMessage)
  2011.   #ENDIF
  2012. #ENDIF
  2013. #!
  2014. #!***************************************************************************
  2015. #GROUP(%ListErrorCheck)
  2016. #!
  2017. #IF(%Primary = %Null)
  2018.   #SET(%ErrorMessage, (%Procedure & ' ERROR: No file has been chosen for this procedure.'))
  2019.   #ERROR(%ErrorMessage)
  2020.   #SET(%ErrorMessage, '  A file must be identified on the File Schematic.')
  2021.   #ERROR(%ErrorMessage)
  2022. #ENDIF
  2023. #IF(%KeyRangeField)
  2024.   #IF(%KeyRangeField = %RangeValue)
  2025.     #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must'))
  2026.     #ERROR(%ErrorMessage)
  2027.     #SET(%ErrorMessage, '   be separate fields.')
  2028.     #ERROR(%ErrorMessage)
  2029.   #ENDIF
  2030.   #IF(%KeyRangeField <> %Null and %RecordOrder <> %Null)
  2031.     #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limits may only be used with keyed order.'))
  2032.     #ERROR(%ErrorMessage)
  2033.     #SET(%ErrorMessage, '   Record order has been selected.')
  2034.     #ERROR(%ErrorMessage)
  2035.   #ENDIF
  2036. #ENDIF
  2037. #!
  2038. #!***************************************************************************
  2039. #GROUP(%BuildListIndex)
  2040. #FIX(%File, %Primary)
  2041. #FIX(%Key, %PrimaryKey)
  2042. #IF(%KeyIndex)
  2043. BUILD(%PrimaryKey)                           #<!Build the index
  2044. #ENDIF
  2045. #!
  2046. #!***************************************************************************
  2047. #GROUP(%SaveRangeFields)
  2048. #IF(%KeyRangeField)
  2049.   #SET(%Found, %Null)
  2050.   #FOR(%KeyField)
  2051.     #IF(%Found <> 'Yes')
  2052. SAV::%KeyField = %KeyField                     #<!Save range limit fields
  2053.     #ENDIF
  2054.     #IF(%KeyField = %KeyRangeField)
  2055.        #SET(%Found, 'Yes')
  2056.     #ENDIF
  2057.   #ENDFOR
  2058. #ENDIF
  2059. #!
  2060. #!***************************************************************************
  2061. #GROUP(%RestoreRangeFields)
  2062. #IF(%KeyRangeField)
  2063.   #IF(%RangeValue)
  2064. %KeyRangeField = %RangeValue
  2065.   #ELSE
  2066.     #SET(%Found, %Null)
  2067.     #FOR(%KeyField)
  2068.       #IF(%Found <> 'Yes')
  2069. %KeyField = SAV::%KeyField                     #<! Restore range limit fields
  2070.       #ENDIF
  2071.       #IF(%KeyField = %KeyRangeField)
  2072.         #SET(%Found, 'Yes')
  2073.       #ENDIF
  2074.     #ENDFOR
  2075.   #ENDIF
  2076. #ENDIF
  2077. #!
  2078. #!***************************************************************************
  2079. #GROUP(%ClearFileFields)
  2080. CLEAR(%FilePre:Record)                           #<!CLEAR Record buffer
  2081. #FOR(%FileMemo)
  2082. CLEAR(%FileMemo)                                 #<!CLEAR Memo buffer
  2083. #ENDFOR
  2084. #CHAIN('CLARION4.TPX')
  2085.