home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / clarion / ppstpx.zip / OM4.TPX < prev    next >
Text File  |  1993-06-08  |  50KB  |  1,173 lines
  1. #!-------------------------------------------------------------------------------#!
  2. #!      OM4.TPX
  3. #!
  4. #!    Form                 : Update a browse or lookup with a form
  5. #!    MultiPage Template   : Update a file with a multiple page entry form
  6. #!    PageOf Template      : data entry 'Page' used with the MultiPage Form
  7. #!
  8. #!------------------------------------------------------------------------------
  9. #!
  10. #PROCEDURE(Form,'Update a browse or lookup with a form'),SCREEN,PULLDOWN
  11. #!------------------------------------------------------------------------------
  12. #!
  13. #!                           The Form Template
  14. #!
  15. #!------------------------------------------------------------------------------
  16. #PROTOTYPE('')
  17. #PROMPT('Insert message',@S20),%InsertMsg
  18. #PROMPT('Chan&ge message',@S20),%ChangeMsg
  19. #PROMPT('De&lete message',@S20),%DeleteMsg
  20. #PROMPT('Action after ADD',OPTION),%AddAction
  21. #PROMPT('Return to caller ',RADIO)
  22. #PROMPT('Retain Record    ',RADIO)
  23. #PROMPT('Clear Record     ',RADIO)
  24. #PROMPT('Copy field hot&key:',KEYCODE),%CopyKey
  25. #PROMPT('Next Procedure ',PROCEDURE),%NextProcedure
  26. #INSERT(%StandardHeader)
  27. #INSERT(%InitFormSymbols)
  28. %Procedure      PROCEDURE
  29.  
  30. #INSERT(%LocalPPSVariables)                    #<! Declare Variables PPS
  31.  
  32. %LocalData
  33. NoMoreFields     BYTE(0)                         !No more fields flag
  34. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  35.  #IF(%CopyKey)
  36. SCREEN    %ScreenAttributes,ALRT(%CopyKey)
  37. %ScreenPaintDeclarations
  38. %ScreenStringDeclarations
  39. %ScreenFieldDeclarations
  40.           .
  41.   #IF(%SharedFiles = %NULL)
  42. SAV:SaveRecord LIKE(%FilePre:Record),PRE(SAV)
  43.   #ENDIF
  44.  #ELSE
  45. %ScreenStructure
  46.   #IF(%SharedFiles = %NULL)
  47. SAV:SaveRecord LIKE(%FilePre:Record),PRE(SAV)
  48.   #ENDIF
  49.  #ENDIF
  50. #ELSE
  51. %ScreenStructure
  52. #ENDIF
  53. %PullDownStructure
  54. #IF(%SharedFiles)
  55. RecordQueue   QUEUE,PRE(SAV)                     !Queue for concurrency checking
  56. SaveRecord    LIKE(%FilePre:Record),PRE(SAV)     #<!size of primary file record
  57. #FOR(%Field)
  58. #IF(%FieldType = 'MEMO')
  59. SAV:%FieldID   STRING(SIZE(%Field))
  60. #ENDIF
  61. #ENDFOR
  62.               .                                  #<!End Queue structure
  63. #ENDIF
  64. #IF(%RelatedFiles)
  65. #SET(%SetFile,%Primary)
  66. #INSERT(%RelationalAccessFlds)                   #<!Declare link fields
  67.  #IF(%PrimaryDriver = 'Paradox')
  68. #FIX(%File,%Primary)
  69. UpdRelation   STRING(SIZE(%FilePre:Record))      #<!Position of last related record
  70.  #ELSE
  71. UpdRelation   STRING(10)                         #<!Position of last related record
  72.  #ENDIF
  73. #ENDIF
  74. #IF(%PrimaryDriver = 'Paradox')
  75. #FIX(%File,%Primary)
  76. SavePointer   STRING(SIZE(%FilePre:Record))      !Position of current record
  77. AutoAddPtr    STRING(SIZE(%FilePre:Record))      !Position of autoinc record
  78. #ELSE
  79. SavePointer   STRING(10)                         !Position of current record
  80. AutoAddPtr    STRING(10)                         !Position of autoinc record
  81. #ENDIF
  82. AutoIncAdd    BYTE(0)                            !On for Autoincrement add
  83. #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  84. LastPosition  STRING(10)                         !Position of last ADD
  85. #ENDIF
  86. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  87.  #IF(%CopyKey)
  88. #INSERT(%FieldDups)
  89.  #ENDIF
  90. #ENDIF
  91. #IF(%PrimeKeysExist)
  92. #INSERT(%SavePrimedFields)
  93. #ENDIF
  94. #EMBED('Data Section')
  95.  
  96.   CODE
  97.   ProcedureName = '%Procedure'                 #<!Fill ProcedureName var. PPS
  98.  
  99.   #EMBED('Setup Procedure')
  100.   #INSERT(%FileMgrStart)                       #<!Insert File Manager. PPS
  101.   #IF(%SecondaryExist)                           #<!IF File schema Secondary
  102.   #INSERT(%OpenSecondaryFiles)                   #!Group from OM9.tpx
  103.   #ENDIF
  104.   #INSERT(%FieldLookupOpen)
  105.   CASE KEYCODE()                                 !What Key was pressed?
  106.     OF InsKey                                    !Insert a new record
  107.  
  108.       Action = AddRecord                         !Set action code 1 (ADD)
  109.       #INSERT(%InsertMessage)                    #<!Message for ADD RECORD
  110.       #INSERT(%ClearValues)                      #<!Clear RECORD and MEMO(s)
  111.       #IF(%AutoInc)
  112.       DO AutoNumber                              !Set autonumber key field(s)
  113.       #ENDIF
  114.       #IF(%InitRoutine)                          #<!Field(s) initial value
  115.       DO InitializeFields                        !Initial values from dictionary
  116.       #ENDIF
  117.  
  118.     OF EnterKey                                  !Process a CHANGE request
  119.     OROF MouseLeft2                              !on EnterKey or double mouse
  120.  
  121.       Action = ChangeRecord                      !Set action code 2 (CHANGE)
  122.       #INSERT(%ChangeMessage)                    #<!Message for CHANGE RECORD
  123.       #IF(%SharedFiles)
  124.       #INSERT(%SetupConcurrency)                 #<!Setup multi-user Concurrency
  125.       #ENDIF
  126.       #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  127.       DO RelationAccessSave                      !Save LINKS for relational update
  128.       #SET(%RelUpdateRoutine,'TRUE')
  129.       #ENDIF
  130.  
  131.     OF DelKey                                    !Process a DELETE request
  132.  
  133.       Action = DeleteRecord                      !Set action code 3 (DELETE)
  134.       #INSERT(%DeleteMessage)                    #<!Message for DELETE RECORD
  135.       SavePointer = POSITION(%Primary)           #<!Position in PRIMARY file
  136.       #IF(%CascadeDelete OR %ClearOnDelete OR %RestrictDelete)
  137.       DO RelationAccessSave                      !Save LINKS for relational update
  138.       #SET(%RelDeleteRoutine,'TRUE')
  139.       #ENDIF
  140.  
  141.   END                                            !End CASE Keycode
  142.  
  143.   #IF(%SecondaryExist)                           #<!IF schema has a Secondary
  144.   DO SecondaryLookups                            !Read any lookup fields
  145.   #ENDIF
  146.   #IF(%PullDownStructure)
  147.   OPEN(%PullDown)
  148.   #ENDIF
  149.   OPEN(Screen)                                   !Open the FORM screen
  150.   DISPLAY                                        !Display screen fields
  151.   IF Action = DeleteRecord                       !IF request for DELETE
  152.     DISABLE(1,FIELDS())                          !Disable all screen fields
  153.     ENABLE(?OK)                                  !Enable the OK and the
  154.     ENABLE(?Cancel)                              !Cancel buttons
  155.   END                                            !End IF request for delete
  156.   #FOR(%Formula)
  157.     #IF(UPPER(%FormulaClass) = 'SETUP')
  158.   #INSERT(%GenerateFormula)
  159.     #ENDIF
  160.   #ENDFOR
  161.   #EMBED('Setup Screen')
  162.  
  163.   LOOP                                           !Begin Main process loop
  164.     #IF(%FormulasExist = 'TRUE')                 #<!Are there Formula fields?
  165.      #SET(%GenerateFormulasOn,'TRUE')
  166.     DO FormulaFields                             !Calculate Formula fields
  167.     #ENDIF
  168.     #IF(%SecondaryExist)                         #<!IF File schema has Secondary
  169.     #INSERT(%SecondaryChanged)
  170.     #ENDIF
  171.  
  172.     CASE SELECTED()                              !Process selected Field
  173.     #INSERT(%ScreenSetupRoutines)
  174.       OF NoMoreFields                            !User pressed Enter or OK
  175.  
  176.             #EMBED('Right Before Action Case Loop') #<!PPS
  177.  
  178.         CASE Action                              !Process requested Action
  179.           OF AddRecord                           !Action = 1 (ADD)
  180.  
  181.             ADD(%Primary)                        #<!Add Record to Primary file
  182.             #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  183.             LastPosition = POSITION(%Primary)
  184.             #ENDIF
  185.  
  186.           OF ChangeRecord                        !Action = 2 (Change)
  187.  
  188.           #IF(%RestrictUpdate)
  189.           #SET(%ChkRestrictUpdate,'TRUE')      #!Check for relational RESTRICT
  190.           #ENDIF
  191.           #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  192.           #SET(%RelatedUpdateRoutine,'TRUE')
  193.           #ENDIF
  194.           #IF((%AutoInc AND %SharedFiles) OR (%AutoInc AND %RelatedUpdateRoutine))
  195.             IF AutoIncAdd                        #<!Was this an Autonumber?
  196.             #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  197.               LastPosition = POSITION(%Primary)  #<!Save last record position
  198.             #ENDIF
  199.               PUT(%Primary)                      #<!Write the Record
  200.             ELSE                                 #<!not AutoincAdd
  201.           #ENDIF
  202.           #IF(%SharedFiles)
  203.           #SET(%ConcurrentWriteOn,'TRUE')
  204.               DO ConcurrentWrite                 !Concurrent update ROUTINE
  205.               IF AbortWrite#                     !AbortWrite is on
  206.                 CYCLE                            !Let user choose response
  207.               END                                !End AbortWrite#
  208.           #IF(%RelatedUpdateRoutine = %NULL)
  209.               PUT(%Primary)                      #<!Write the Record
  210.           #ENDIF
  211.           #ENDIF
  212.           #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  213.             DO RelationalUpdate                  !Relational update ROUTINE
  214.             IF AbortTransaction#                 !AbortTransaction# is ON
  215.               SELECT(?Cancel)                    !Place cursor on Cancel
  216.               CYCLE                              !and restart Accept Loop
  217.             END                                  !End AbortTransaction#
  218.           #ENDIF
  219.           #IF((%AutoInc AND %SharedFiles) OR (%AutoInc AND %RelatedUpdateRoutine))
  220.             END                                  #<!IF AutoIncAdd
  221.           #ENDIF
  222.           #IF(%SharedFiles = %NULL)
  223.             #IF(%RelatedUpdateRoutine = %NULL)
  224.               #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  225.             LastPosition = POSITION(%Primary)    #<!Save last record position
  226.               #ENDIF
  227.             PUT(%Primary)                        #<!Write the Record
  228.             #ENDIF
  229.           #ENDIF
  230.  
  231.           OF DeleteRecord                        !Action = 3 (Delete)
  232.  
  233.             #IF(%RestrictDelete)                  #<!IF RESTRICT Constraint
  234.             DO CheckRestrictedDelete             !Check RESTRICT delete
  235.             IF RestrictDelete#                   !If RestrictDelete# is ON
  236.               SELECT(?Cancel)                    !Place cursor on cancel
  237.               CYCLE                              !Restart Loop
  238.             END                                  !End IF RestrictDelete#
  239.             #SET(%ChkRestrictDelete,'TRUE')      #<!RESTRICT delete code
  240.             #ENDIF
  241.             #IF(%CascadeDelete OR %ClearOnDelete)
  242.             #SET(%RelatedDeleteRoutine,'TRUE')
  243.             DO RelationalDelete                  !Relational delete ROUTINE
  244.             IF AbortTransaction#                 !AbortTransaction is on
  245.               CYCLE                              !Let user try again
  246.             END                                  !End AbortTransaction
  247.             #ELSIF(%SharedFiles)
  248.             #SET(%ConcurrentDeleteOn,'TRUE')
  249.             DO ConcurrentDelete                  !Concurrent update ROUTINE
  250.             IF AbortDelete#                      !AbortWrite is on
  251.               CYCLE                              !Restart main Loop
  252.             ELSE                                 !Its OK to Delete
  253.               DELETE(%Primary)                   !Delete this record
  254.             END                                  !End AbortWrite#
  255.             #ELSE
  256.             DELETE(%Primary)                     !Delete this record
  257.             #ENDIF
  258.  
  259.         END                                      !End CASE Action
  260.  
  261.       IF ERRORCODE()                             !Error check on File I/O
  262.         #IF(%DupKeyCheck)
  263.         #INSERT(%DupKeyCode)
  264.         #ENDIF
  265.         CASE Action                              !Error message based on Action
  266.           OF AddRecord
  267.             GLO:Message1 = 'Error attempting to ADD Record'
  268.           OF ChangeRecord
  269.             GLO:Message1 = 'Error attempting to CHANGE Record'
  270.           OF DeleteRecord
  271.             GLO:Message1 = 'Error attempting to DELETE Record'
  272.         END                                      !End CASE Action
  273.         GLO:Message2 = 'The file: %Primary could not be updated'
  274.         GLO:Message3 = 'Code:'&Errorcode()&': '&Error()
  275.         ShowWarning                              !Notify the user
  276.         #IF(%SharedFiles)
  277.         RELEASE(%Primary)                        #<!Release the held record
  278.         FREE(RecordQueue)                        !FREE the memory Queue
  279.         #ENDIF
  280.         DISABLE(1,FIELDS())                      !Disable all the fields
  281.         ENABLE(?Cancel)                          !Enable Cancel button
  282.         SELECT(?Cancel)                          !and place cursor on Cancel
  283.         DISPLAY                                  !Re-display the screen
  284.         CYCLE                                    !Re-start main LOOP
  285.       ELSE                                       !Else no errorcode()
  286.         #IF(%SharedFiles)
  287.         FREE(RecordQueue)                        !Free memory from Queue
  288.         #ENDIF
  289.         #IF(%NextProcedure)
  290.         #EMBED('Setup Next Procedure')
  291.         %NextProcedure                           #<!Call the Next Procedure
  292.         #EMBED('Return from Next Procedure')
  293.         #ENDIF
  294.         #IF(UPPER(CLIP(%AddAction)) = 'CLEAR RECORD')
  295.         IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd)
  296.           ERASE                                  #<!Erase screen fields
  297.           #INSERT(%InsertMessage)                #<!Message for ADD RECORD
  298.           DISPLAY                                !Update screen display
  299.           #FIX(%File,%Primary)
  300.           CLEAR(%FilePre:Record)                 #<!Clear the record buffer
  301.           #IF(%AutoInc)
  302.           DO AutoNumber                          !Increment autonumber key
  303.           DISPLAY                                !Display screen field
  304.           #ENDIF
  305.           SELECT(1)                              !Place cursor on 1st field
  306.           CYCLE                                  !Re-start main LOOP
  307.         END                                      !End IF (Action = ....)
  308.         #ELSIF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  309.         IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd)
  310.          #IF(%CopyKey <> %NULL)
  311.           DO SaveScrFlds                         #<!Save the Screen fields
  312.           ERASE
  313.           #INSERT(%InsertMessage)                #<!Message for ADD RECORD
  314.           DISPLAY                                !Update screen display
  315.           #FIX(%File,%Primary)
  316.           CLEAR(%FilePre:Record)                 #<!Clear the record buffer
  317.          #ELSE
  318.           #IF(%AutoInc)
  319.           SAV:SaveRecord = %FilePre:Record       #<!Save the record buffer
  320.           #ENDIF
  321.          #ENDIF
  322.           #IF(%AutoInc)
  323.           DO AutoNumber                          !Increment autonumber key
  324.           %FilePre:Record = SAV:SaveRecord       #<!Restore saved record
  325.           #INSERT(%RestoreAuto)                  #<!Restore AutoNumber(s)
  326.           DISPLAY                                !Display screen fields
  327.           #ENDIF
  328.           SELECT(1)                              !Place cursor on 1st field
  329.           CYCLE                                  !Re-start main LOOP
  330.         END                                      !End IF (Action = ....)
  331.         #ENDIF                                   #!End %AddAction code
  332.         BREAK                                    !Break from main Loop
  333.       END                                        !End IF Errorcode()
  334.  
  335.     END                                          !End CASE Selected()
  336.  
  337.     ACCEPT                                       !Enable screen entry
  338.     #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  339.      #IF(%CopyKey)
  340.     #INSERT(%DupFldCall)
  341.      #ENDIF
  342.     #ENDIF
  343. #! Moved if hotkeyexist to after case keycode() PPS
  344.     CASE KEYCODE()
  345.     #IF(%HotKeysExist)
  346.     #FOR(%HotKey)
  347.       OF %HotKey                                 !User defined HotKey
  348.         %HotKeyProc                              !HotKey Procedure
  349.     #ENDFOR
  350.     #ENDIF
  351.     #INSERT(%FileMgrView)                      #!Insert File Manager View PPS
  352.     END                                          !End CASE Keycode
  353.  
  354.     CASE FIELD()                                 !Process fields
  355.     #INSERT(%FormEditRoutines)
  356.       OF ?Ok                                     !On the OK button
  357.  
  358.         #EMBED('OK Button Press')
  359.         #FOR(%ScreenField)
  360.           #IF(%ScreenFieldUse = '?Ok')
  361.           #IF(%ScreenFieldEdit <> %NULL)
  362.         %ScreenFieldEdit                         #<!Field Edit procedure
  363.           #ENDIF
  364.           #ENDIF
  365.         #ENDFOR
  366.         SELECT(1)                                !Start with the first field
  367.         SELECT                                   !and cycle non-stop
  368.         CYCLE                                    !restart main process loop
  369.  
  370.       OF ?Cancel                                 !On Cancel button
  371.  
  372.       #IF(%AutoInc = 'TRUE')
  373.         IF AutoIncAdd                            !ADDed autoincrement record?
  374.           RESET(%Primary,AutoAddPtr)             #<!Re-position record pointer
  375.           NEXT(%Primary)                         #<!Re-read the record we added
  376.           IF DiskError('Could not READ Record')  !Check for file I/O error
  377.             #IF(%SharedFiles = 'TRUE')
  378.             FREE(RecordQueue)                    !Free the memory Queue
  379.             #ENDIF
  380.            #IF(%PullDownStructure)
  381.             CLOSE(%PullDown)
  382.            #ENDIF
  383.             RETURN                               !Return to caller
  384.           END                                    !End IF Diskerror
  385.           DELETE(%Primary)                       #<!DELETE the record
  386.           IF DiskError('Record could not be Deleted')
  387.             #IF(%SharedFiles = 'TRUE')
  388.             FREE(RecordQueue)                    !Free the memory Queue
  389.             #ENDIF
  390.             #IF(%PullDownStructure)
  391.             CLOSE(%PullDown)
  392.             #ENDIF
  393.             RETURN                               !Return to caller
  394.           END                                    !End IF Diskerror
  395.         END                                      !End IF AutoIncAdd
  396.       #ENDIF
  397.         #FOR(%ScreenField)
  398.           #IF(%ScreenFieldUse = '?Cancel')
  399.           #IF(%ScreenFieldEdit <> %NULL)
  400.         %ScreenFieldEdit                         #<!Field edit procedure
  401.           #ENDIF
  402.           #ENDIF
  403.         #ENDFOR
  404.         #IF(%SharedFiles = 'TRUE')
  405.         FREE(RecordQueue)                        !Free the memory Queue
  406.         #ENDIF
  407.         #IF(%PullDownStructure)
  408.         CLOSE(%PullDown)
  409.         #ENDIF
  410.         #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  411.         RESET(%Primary,LastPosition)             #<!Position to record we added
  412.         NEXT(%Primary)                           #<!and re-read
  413.         #ENDIF
  414.         BREAK                                    !Break from main LOOP
  415.     END                                          !End CASE FIELD
  416.  
  417.   END                                            !END MAIN PROCESS LOOP
  418.  
  419.   #IF(%PullDownStructure)
  420.   CLOSE(%PullDown)
  421.   #ENDIF
  422.   #FOR(%Formula)
  423.     #IF(UPPER(%FormulaClass) = 'RETURN')
  424.   #INSERT(%GenerateFormula)
  425.     #ENDIF
  426.   #ENDFOR
  427. #EMBED('End of Procedure')
  428. #INSERT(%FileMgrExit)                          #!Insert File Manager Exit PPS
  429. #INSERT(%AutoIncCode)
  430. #INSERT(%ConcurrentWrite)
  431. #IF(%RelUpdateRoutine OR %RelDeleteRoutine)
  432. #INSERT(%RelUpdSave)
  433. #ENDIF
  434. #INSERT(%RelUpdate)
  435. #IF(%ChkRestrictUpdate)
  436. #INSERT(%RestrictUpdateCheck)
  437. #ENDIF
  438. #INSERT(%RelDelete)
  439. #INSERT(%ConcurrentDelete)
  440. #INSERT(%ClearOnDeleteCode)
  441. #IF(%CascadeUpdate = 'TRUE')
  442. #INSERT(%CheckTransaction)
  443. #ELSIF(%ClearOnUpdate = 'TRUE')
  444. #INSERT(%CheckTransaction)
  445. #ELSIF(%ClearOnDelete = 'TRUE')
  446. #INSERT(%CheckTransaction)
  447. #ELSIF(%CascadeDelete = 'TRUE')
  448. #INSERT(%CheckTransaction)
  449. #ENDIF
  450. #IF(%CascadeDeleteOn)
  451. #INSERT(%CascadeDeleteCode)
  452. #ENDIF
  453. #IF(%ChkRestrictDelete)
  454. #INSERT(%RestrictDeleteCode)
  455. #ENDIF
  456. #INSERT(%InitQue)
  457. #INSERT(%InitFields)
  458. #INSERT(%GenFormulas)
  459. #IF(%SecondaryExist)
  460. #INSERT(%SecondaryLookups)
  461. #ENDIF
  462. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  463.  #IF(%CopyKey)
  464. #INSERT(%SaveScrFlds)
  465. #INSERT(%DupField)
  466.  #ENDIF
  467. #ENDIF
  468. #!***************************************************************************
  469. #!-------------------------------------------------------------------------------#!
  470. #!
  471. #!      Multi-Page Form    Update a browse or lookup with multiple pages
  472. #!
  473. #!------------------------------------------------------------------------------
  474. #!
  475. #PROCEDURE(MultiPage,'Multiple Page update form '),SCREEN,PULLDOWN
  476. #!------------------------------------------------------------------------------
  477. #!      OM4.TPX
  478. #!
  479. #!      Multi-Page Template: Update a file with a multiple page entry form
  480. #!
  481. #!------------------------------------------------------------------------------
  482. #PROTOTYPE('')
  483. #PROMPT('Insert message',@S20),%InsertMsg
  484. #PROMPT('Chan&ge message',@S20),%ChangeMsg
  485. #PROMPT('De&lete message',@S20),%DeleteMsg
  486. #PROMPT('2nd Page Procedure ',PROCEDURE),%Page2Proc
  487. #PROMPT('3rd Page Procedure ',PROCEDURE),%Page3Proc
  488. #PROMPT('4th Page Procedure ',PROCEDURE),%Page4Proc
  489. #PROMPT('5th Page Procedure ',PROCEDURE),%Page5Proc
  490. #PROMPT('6th Page Procedure ',PROCEDURE),%Page6Proc
  491. #PROMPT('7th Page Procedure ',PROCEDURE),%Page7Proc
  492. #PROMPT('8th Page Procedure ',PROCEDURE),%Page8Proc
  493. #PROMPT('9th Page Procedure ',PROCEDURE),%Page9Proc
  494. #PROMPT('Next Procedure ',PROCEDURE),%NextProcedure
  495. #INSERT(%StandardHeader)
  496. #INSERT(%InitFormSymbols)
  497. #INSERT(%ProcCounter)
  498.  
  499. %Procedure      PROCEDURE
  500.  
  501. #INSERT(%LocalPPSVariables)                    #<! Declare Variables PPS
  502.  
  503. %LocalData
  504. SaveAction       BYTE
  505. CheckRequired    BYTE(4)
  506. NoMoreFields     BYTE(0)                         !No more fields flag
  507.  
  508. SCREEN    %ScreenAttributes,ALRT(Alt2,Alt%ProcCount)
  509. %ScreenPaintDeclarations
  510. %ScreenStringDeclarations
  511. %ScreenFieldDeclarations
  512.           .
  513. %PullDownStructure
  514. #IF(%SharedFiles)
  515. RecordQueue   QUEUE,PRE(SAV)
  516. SaveRecord    LIKE(%FilePre:Record),PRE(SAV)
  517. #FOR(%Field)
  518. #IF(%FieldType = 'MEMO')
  519. SAV:%FieldID   STRING(SIZE(%Field))
  520. #ENDIF
  521. #ENDFOR
  522.               .                                  #<!End Queue structure
  523. #ENDIF
  524. #IF(%RelatedFiles)
  525. #SET(%SetFile,%Primary)
  526. #INSERT(%RelationalAccessFlds)                   #<!Declare link fields
  527.  #IF(%PrimaryDriver = 'Paradox')
  528. #FIX(%File,%Primary)
  529. UpdRelation   STRING(SIZE(%FilePre:Record))      #<!Position of last related record
  530.  #ELSE
  531. UpdRelation   STRING(10)                         #<!Position of last related record
  532.  #ENDIF
  533. #ENDIF
  534. #IF(%PrimaryDriver = 'Paradox')
  535. #FIX(%File,%Primary)
  536. SavePointer   STRING(SIZE(%FilePre:Record))      !Position of current record
  537. AutoAddPtr    STRING(SIZE(%FilePre:Record))      !Position of autoinc record
  538. #ELSE
  539. SavePointer   STRING(10)                         !Position of current record
  540. AutoAddPtr    STRING(10)                         !Position of autoinc record
  541. #ENDIF
  542. AutoIncAdd    BYTE(0)                            !On for Autoincrement add
  543. ProcCalls     BYTE,DIM(%ProcCount)
  544.  
  545. #EMBED('Data Section')
  546.  
  547.   CODE
  548.   ProcedureName = '%Procedure'                 #<!Fill ProcedureName var. PPS
  549.  
  550.   #EMBED('Setup Procedure')
  551.   #INSERT(%FileMgrStart)                       #<!Insert File Manager. PPS
  552.   #IF(%SecondaryExist)                           #<!IF File schema Secondary
  553.   #INSERT(%OpenSecondaryFiles)
  554.   #ENDIF
  555.   LOC:Pages = %ProcCount                         #<!PageOf procedure count
  556.   LOC:Page = 1                                   !Initialize page
  557.  
  558.   CASE KEYCODE()                                 !What Key was pressed?
  559.     OF InsKey                                    !Insert a new record
  560.  
  561.       Action = AddRecord                         !Set action code 1 (ADD)
  562.       #INSERT(%InsertMessage)                    #<!Message for ADD RECORD
  563.       #INSERT(%ClearValues)                      #<!Clear RECORD and MEMO(s)
  564.       #IF(%AutoInc)
  565.       DO AutoNumber                              !Set autonumber key field(s)
  566.       #ENDIF
  567.       #IF(%InitRoutine)                          #<!Field(s) initial value
  568.       DO InitializeFields                        !Initial values from dictionary
  569.       #ENDIF
  570.  
  571.     OF EnterKey                                  !Process a CHANGE request
  572.     OROF MouseLeft2                              !on EnterKey or double mouse
  573.  
  574.       Action = ChangeRecord                      !Set action code 2 (CHANGE)
  575.       #INSERT(%ChangeMessage)                    #<!Message for CHANGE RECORD
  576.       #IF(%SharedFiles)
  577.       #INSERT(%SetupConcurrency)                 #<!Setup multi-user Concurrency
  578.       #ENDIF
  579.       #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  580.       DO RelationAccessSave                      !Save LINKS for relational update
  581.       #SET(%RelUpdateRoutine,'TRUE')
  582.       #ENDIF
  583.       #IF(%SecondaryExist)                       #<!IF File schema Secondary
  584.       DO SecondaryLookups                        !Read any lookup fields
  585.       #ENDIF
  586.  
  587.     OF DelKey                                    !Process a DELETE request
  588.  
  589.       Action = DeleteRecord                      !Set action code 3 (DELETE)
  590.       #INSERT(%DeleteMessage)                    #<!Message for DELETE RECORD
  591.       SavePointer = POSITION(%Primary)           #<!Position in PRIMARY file
  592.       #IF(%CascadeDelete OR %ClearOnDelete OR %RestrictDelete)
  593.       DO RelationAccessSave                      !Save LINKS for relational update
  594.       #SET(%RelDeleteRoutine,'TRUE')
  595.       #ENDIF
  596.       #IF(%SecondaryExist)                       #<!IF File schema Secondary
  597.       DO SecondaryLookups                        !Read any lookup fields
  598.       #ENDIF
  599.   END                                            !End CASE Keycode
  600.  
  601.   #IF(%PullDownStructure)
  602.   OPEN(%PullDown)
  603.   #ENDIF
  604.   OPEN(Screen)                                   !Open the FORM screen
  605.   DISPLAY                                        !Display screen fields
  606.   IF Action = DeleteRecord                       !IF request for DELETE
  607.     DISABLE(1,FIELDS())                          !Disable all screen fields
  608.     ENABLE(?OK)                                  !Enable the OK and the
  609.     ENABLE(?Cancel)                              !Cancel buttons
  610.     ENABLE(?Next_Page)
  611.   END                                            !End IF request for delete
  612.   #FOR(%Formula)
  613.     #IF(UPPER(%FormulaClass) = 'SETUP')
  614.   #INSERT(%GenerateFormula)
  615.     #ENDIF
  616.   #ENDFOR
  617.   #EMBED('Setup Screen')
  618.  
  619.   LOOP                                           !Begin Main process loop
  620.  
  621.     #IF(%FormulasExist = 'TRUE')                 #<!Are there Formula fields?
  622.      #SET(%GenerateFormulasOn,'TRUE')
  623.     DO FormulaFields                             !Calculate Formula fields
  624.     #ENDIF
  625.     #IF(%SecondaryExist)                         #<!IF File schema Secondary
  626.     #INSERT(%SecondaryChanged)
  627.     #ENDIF
  628.  
  629.     CASE SELECTED()                              !Process selected Field
  630.     #INSERT(%ScreenSetupRoutines)
  631.       OF NoMoreFields                            !User pressed Enter or OK
  632.  
  633.              #EMBED('Right Before Action Case Loop') #<!            PPS
  634.  
  635.         CASE Action                              !Process requested Action
  636.           OF AddRecord                           !Action = 1 (ADD)
  637.  
  638.             ADD(%Primary)                        #<!Add Record to Primary file
  639.  
  640.           OF ChangeRecord                        !Action = 2 (Change)
  641.  
  642.           #IF(%RestrictUpdate)
  643.           #SET(%ChkRestrictUpdate,'TRUE')      #!Check for relational RESTRICT
  644.           #ENDIF
  645.           #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  646.           #SET(%RelatedUpdateRoutine,'TRUE')
  647.           #ENDIF
  648.           #IF((%AutoInc AND %SharedFiles) OR (%AutoInc AND %RelatedUpdateRoutine))
  649.             IF AutoIncAdd                        #<!Was this an Autonumber?
  650.               PUT(%Primary)                      #<!Write the Record
  651.             ELSE                                 #<!not AutoincAdd
  652.           #ENDIF
  653.           #IF(%SharedFiles)
  654.           #SET(%ConcurrentWriteOn,'TRUE')
  655.               DO ConcurrentWrite                 !Concurrent update ROUTINE
  656.               IF AbortWrite#                     !AbortWrite is on
  657.                 CYCLE                            !Let user choose response
  658.               END                                !End AbortWrite#
  659.           #IF(%RelatedUpdateRoutine = %NULL)
  660.               PUT(%Primary)                      #<!Write the Record
  661.           #ENDIF
  662.           #ENDIF
  663.           #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  664.             DO RelationalUpdate                  !Relational update ROUTINE
  665.             IF AbortTransaction#                 !AbortTransaction# is ON
  666.               SELECT(?Cancel)                    !Place cursor on Cancel
  667.               CYCLE                              !and restart Accept Loop
  668.             END                                  !End AbortTransaction#
  669.           #ENDIF
  670.           #IF((%AutoInc AND %SharedFiles) OR (%AutoInc AND %RelatedUpdateRoutine))
  671.             END                                  #<!IF AutoIncAdd
  672.           #ENDIF
  673.           #IF((%SharedFiles = %NULL) OR (%RelatedUpdateRoutine = %NULL))
  674.             PUT(%Primary)                        #<!Write the Record
  675.           #ENDIF
  676.  
  677.           OF DeleteRecord                        !Action = 3 (Delete)
  678.  
  679.             #IF(%RestrictDelete)                  #<!IF RESTRICT Constraint
  680.             DO CheckRestrictedDelete             !Check RESTRICT delete
  681.             IF RestrictDelete#                   !If RestrictDelete# is ON
  682.                SELECT(?Cancel)                   !Place cursor on cancel
  683.                CYCLE                             !Restart Loop
  684.             END                                  !End IF RestrictDelete#
  685.             #SET(%ChkRestrictDelete,'TRUE')      #<!RESTRICT delete code
  686.             #ENDIF
  687.             #IF(%CascadeDelete OR %ClearOnDelete)
  688.             #SET(%RelatedDeleteRoutine,'TRUE')
  689.             DO RelationalDelete                  !Relational delete ROUTINE
  690.             IF AbortTransaction#                 !AbortTransaction is on
  691.               CYCLE                              !Let user try again
  692.             END                                  !End AbortTransaction
  693.             #ELSIF(%SharedFiles)
  694.             #SET(%ConcurrentDeleteOn,'TRUE')
  695.             DO ConcurrentDelete                  !Concurrent update ROUTINE
  696.             IF AbortDelete#                      !AbortWrite is on
  697.               CYCLE                              !Restart main Loop
  698.             ELSE                                 !Its OK to Delete
  699.               DELETE(%Primary)                   !Delete this record
  700.             END                                  !End AbortWrite#
  701.             #ELSE
  702.             DELETE(%Primary)                     !Delete this record
  703.             #ENDIF
  704.         END                                      !End CASE Action
  705.  
  706.       IF ERRORCODE()                             !Error check on File I/O
  707.  
  708.         #IF(%DupKeyCheck)
  709.         #INSERT(%DupKeyCode)
  710.         #ENDIF
  711.         CASE Action                              !Error message based on Action
  712.           OF AddRecord
  713.             GLO:Message1 = 'Error attempting to ADD Record'
  714.           OF ChangeRecord
  715.             GLO:Message1 = 'Error attempting to CHANGE Record'
  716.           OF DeleteRecord
  717.             GLO:Message1 = 'Error attempting to DELETE Record'
  718.         END                                      !End CASE Action
  719.         GLO:Message2 = 'The file: %Primary could not be updated'
  720.         GLO:Message3 = 'Code:'&Errorcode()&': '&Error()
  721.         ShowWarning                              !Notify the user
  722.         #IF(%SharedFiles)
  723.         RELEASE(%Primary)                        #<!Release the held record
  724.         FREE(RecordQueue)                        !FREE the memory Queue
  725.         #ENDIF
  726.         DISABLE(1,FIELDS())                      !Disable all the fields
  727.         ENABLE(?Cancel)                          !Enable Cancel button
  728.         SELECT(?Cancel)                          !and place cursor on Cancel
  729.         DISPLAY                                  !Re-display the screen
  730.         CYCLE                                    !Re-start main LOOP
  731.       ELSE                                       !Else no errorcode()
  732.         #IF(%SharedFiles)
  733.         FREE(RecordQueue)                        !Free memory from Queue
  734.         #ENDIF
  735.         #IF(%NextProcedure)
  736.         #EMBED('Setup Next Procedure')
  737.         %NextProcedure                           #<!Call the Next Procedure
  738.         #EMBED('Return from Next Procedure')
  739.         #ENDIF
  740.         BREAK                                    !Break from main Loop
  741.       END                                        !End IF Errorcode()
  742.     END                                          !End CASE Selected()
  743.  
  744.     ACCEPT                                       !Enable screen entry
  745.  
  746.     CASE KEYCODE()
  747.     #FOR(%HotKey)
  748.     OF %HotKey                                   !User defined HotKey
  749.       %HotKeyProc                                #<!HotKey Procedure
  750.     #ENDFOR
  751.     #INSERT(%AltKeys)
  752.     #INSERT(%FileMgrView)                      #!Insert File Manager View PPS
  753.     END                                          !End CASE Keycode
  754.  
  755.     CASE FIELD()                                 !Process fields
  756.     #INSERT(%FormEditRoutines)
  757.       OF ?Ok                                     !On the OK button
  758.  
  759.         #EMBED('OK Button Press')
  760.         #FOR(%ScreenField)
  761.           #IF(%ScreenFieldUse = '?Ok')
  762.           #IF(%ScreenFieldEdit <> %NULL)
  763.         %ScreenFieldEdit                         #<!Field Edit procedure
  764.           #ENDIF
  765.           #ENDIF
  766.         #ENDFOR
  767.       #IF(%Page2Proc)
  768.       IF Action <> DeleteRecord
  769.         SaveAction = Action
  770.         Action = CheckRequired
  771.         LOC:Message = 'Verify Required Field(s)'
  772.         LOOP LOC:Page = 1 to %ProcCount
  773.           IF ProcCalls[LOC:Page]                 !If the Page has been called
  774.             CYCLE                                !then check the next page
  775.           ELSE                                   !Call the Page for CheckRequired
  776.       #IF(%Page2Proc)
  777.            EXECUTE (LOC:Page)
  778.             %Page2Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  779.         #IF(%Page3Proc)
  780.             %Page3Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  781.          #ENDIF
  782.          #IF(%Page4Proc)
  783.             %Page4Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  784.          #ENDIF
  785.          #IF(%Page5Proc)
  786.             %Page5Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  787.          #ENDIF
  788.          #IF(%Page6Proc)
  789.             %Page6Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  790.          #ENDIF
  791.          #IF(%Page7Proc)
  792.             %Page7Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  793.          #ENDIF
  794.          #IF(%Page8Proc)
  795.             %Page8Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  796.          #ENDIF
  797.          #IF(%Page9Proc)
  798.             %Page9Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  799.          #ENDIF
  800.            END                                   !End Execute LOC:Page
  801.           END                                    !END IF Page was called
  802.       #ENDIF
  803.       #ENDIF                                     #<!Are there any Pages?
  804.         END                                      !END LOOP for required fields
  805.        Action = SaveAction                       !Save the user Action
  806.       END                                        !End if Action <> delete
  807.       SELECT(1)                                  !Start with the first field
  808.       SELECT                                     !and cycle non-stop
  809.       CYCLE                                      !restart main process loop
  810.  
  811.       OF ?Next_Page                              !On the Next Page button
  812.  
  813.         #EMBED('Next Page Button Press')
  814.         #FOR(%ScreenField)
  815.           #IF(%ScreenFieldUse = '?Next_Page')
  816.           #IF(%ScreenFieldEdit <> %NULL)
  817.         %ScreenFieldEdit                         #<!Field Edit procedure
  818.           #ENDIF
  819.           #ENDIF
  820.         #ENDFOR
  821.       #IF(%Page2Proc)
  822.       LOC:Page += 1
  823.         LOOP
  824.           IF (LOC:Page - 1) = 0 THEN BREAK.
  825.           EXECUTE (LOC:Page - 1)
  826.            BEGIN
  827.             ProcCalls[LOC:Page - 1] = 1
  828.             %Page2Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  829.            .
  830.         #IF(%Page3Proc)
  831.            BEGIN
  832.             ProcCalls[LOC:Page] = 1
  833.             %Page3Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  834.            .
  835.          #ENDIF
  836.          #IF(%Page4Proc)
  837.            BEGIN
  838.             ProcCalls[LOC:Page] = 1
  839.             %Page4Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  840.            .
  841.          #ENDIF
  842.          #IF(%Page5Proc)
  843.            BEGIN
  844.             ProcCalls[LOC:Page] = 1
  845.             %Page5Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  846.            .
  847.          #ENDIF
  848.          #IF(%Page6Proc)
  849.            BEGIN
  850.             ProcCalls[LOC:Page] = 1
  851.             %Page6Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  852.            .
  853.          #ENDIF
  854.          #IF(%Page7Proc)
  855.            BEGIN
  856.             ProcCalls[LOC:Page] = 1
  857.             %Page7Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  858.            .
  859.          #ENDIF
  860.          #IF(%Page8Proc)
  861.            BEGIN
  862.             ProcCalls[LOC:Page] = 1
  863.             %Page8Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  864.            .
  865.          #ENDIF
  866.          #IF(%Page9Proc)
  867.            BEGIN
  868.             ProcCalls[LOC:Page] = 1
  869.             %Page9Proc(Action,LOC:Page,LOC:Pages,LOC:Message) !Call Page procedure
  870.            .
  871.          #ENDIF
  872.           .                                      !End Execute LOC:Page
  873.         END                                      !End LOOP
  874.       #ENDIF
  875.  
  876.       OF ?Cancel                                 !On Cancel button
  877.  
  878.       #IF(%AutoInc = 'TRUE')
  879.         IF AutoIncAdd                            !ADDed autoincrement record?
  880.           RESET(%Primary,AutoAddPtr)             #<!Re-position record pointer
  881.           NEXT(%Primary)                         #<!Re-read the record we added
  882.           IF DiskError('Could not READ Record')  !Check for file I/O error
  883.             #IF(%SharedFiles = 'TRUE')
  884.             FREE(RecordQueue)                    !Free the memory Queue
  885.             #ENDIF
  886.             #IF(%PullDownStructure)
  887.             CLOSE(%PullDown)
  888.             #ENDIF
  889.             RETURN                               !And return to caller
  890.           END                                    !End IF Diskerror
  891.           DELETE(%Primary)                       #<!DELETE the record
  892.           IF DiskError('Record could not be Deleted')
  893.             #IF(%SharedFiles = 'TRUE')
  894.             FREE(RecordQueue)                    !Free the memory Queue
  895.             #ENDIF
  896.             #IF(%PullDownStructure)
  897.             CLOSE(%PullDown)
  898.             #ENDIF
  899.             RETURN                               !And return to caller
  900.           END                                    !End IF Diskerror
  901.         END                                      !End IF AutoIncAdd
  902.       #ENDIF
  903.         #IF(%SharedFiles = 'TRUE')
  904.         FREE(RecordQueue)                        !Free the memory Queue
  905.         #ENDIF
  906.         #FOR(%ScreenField)
  907.           #IF(%ScreenFieldUse = '?Cancel')
  908.           #IF(%ScreenFieldEdit <> %NULL)
  909.         %ScreenFieldEdit                         #<!Field edit procedure
  910.           #ENDIF
  911.           #ENDIF
  912.         #ENDFOR
  913.         #IF(%PullDownStructure)
  914.         CLOSE(%PullDown)
  915.         #ENDIF
  916.         BREAK                                    !Break from main LOOP
  917.     END                                          !End CASE FIELD
  918.  
  919.   END                                            !END MAIN PROCESS LOOP
  920. #EMBED('End of Procedure')
  921. #INSERT(%FileMgrExit)                          #!Insert File Manager Exit PPS
  922. #INSERT(%AutoIncCode)
  923. #INSERT(%ConcurrentWrite)
  924. #IF(%RelUpdateRoutine OR %RelDeleteRoutine)
  925. #INSERT(%RelUpdSave)
  926. #ENDIF
  927. #INSERT(%RelUpdate)
  928. #IF(%ChkRestrictUpdate)
  929. #INSERT(%RestrictUpdateCheck)
  930. #ENDIF
  931. #INSERT(%RelDelete)
  932. #INSERT(%ConcurrentDelete)
  933. #INSERT(%ClearOnDeleteCode)
  934. #IF(%CascadeUpdate = 'TRUE')
  935. #INSERT(%CheckTransaction)
  936. #ELSIF(%ClearOnUpdate = 'TRUE')
  937. #INSERT(%CheckTransaction)
  938. #ELSIF(%ClearOnDelete = 'TRUE')
  939. #INSERT(%CheckTransaction)
  940. #ELSIF(%CascadeDelete = 'TRUE')
  941. #INSERT(%CheckTransaction)
  942. #ENDIF
  943. #IF(%CascadeDeleteOn)
  944. #INSERT(%CascadeDeleteCode)
  945. #ENDIF
  946. #IF(%ChkRestrictDelete)
  947. #INSERT(%RestrictDeleteCode)
  948. #ENDIF
  949. #INSERT(%InitQue)
  950. #INSERT(%InitFields)
  951. #INSERT(%GenFormulas)
  952. #IF(%SecondaryExist)
  953. #INSERT(%SecondaryLookups)
  954. #ENDIF
  955. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  956.  #IF(%CopyKey)
  957. #INSERT(%SaveScrFlds)
  958. #INSERT(%DupField)
  959.  #ENDIF
  960. #ENDIF
  961. #!***************************************************************************
  962. #!-------------------------------------------------------------------------------#!
  963. #!
  964. #!      PageOf the Multi-Page Form - A single page of a multiple page form
  965. #!
  966. #!------------------------------------------------------------------------------
  967. #!
  968. #PROCEDURE(PageOf,'Page of Multi-Page forms '),SCREEN,PULLDOWN
  969. #PROTOTYPE('(BYTE,*BYTE,BYTE,STRING)')
  970. #!------------------------------------------------------------------------------
  971. #!      OM4.TPX
  972. #!
  973. #!      PageOf Template:  a data entry 'Page' used with the MultiPage Form
  974. #!
  975. #!------------------------------------------------------------------------------
  976. #INSERT(%StandardHeader)
  977. #INSERT(%InitFormSymbols)
  978. #INSERT(%ButtonCheck)
  979. %Procedure      PROCEDURE(Action,Page,Pages,Message)
  980.  
  981. #INSERT(%LocalPPSVariables)                    #<! Declare Variables PPS
  982.  
  983. %LocalData
  984. NoMoreFields     BYTE(0)                         !No more fields flag
  985. CheckRequired    BYTE(4)
  986. NonStop          BYTE
  987.  
  988. SCREEN    %ScreenAttributes
  989. %ScreenPaintDeclarations
  990. %ScreenStringDeclarations
  991. %ScreenFieldDeclarations
  992.           .
  993. %PullDownStructure
  994. #EMBED('Data Section')
  995.  
  996.   CODE
  997.   ProcedureName = '%Procedure'                 #<!Fill ProcedureName var. PPS
  998.  
  999.   #EMBED('Setup Procedure')
  1000.   #INSERT(%FileMgrStart)                       #<!Insert File Manager. PPS
  1001.   #IF(%SecondaryExist)                           #<!IF File schema Secondary
  1002.   #INSERT(%OpenSecondaryFiles)
  1003.   #ENDIF
  1004.   #INSERT(%FieldLookupOpen)
  1005.   PAG:Message = Message                          !Move to local variable
  1006.   PAG:Page = Page                                !Move to local variable
  1007.   PAG:Pages = Pages                              !Move to local variable
  1008.   CASE Action                                    !What Action requested?
  1009.       #IF(%SecondaryExist)                       #<!IF File schema Secondary
  1010.     OF ChangeRecord                              !Process a CHANGE request
  1011.       DO SecondaryLookups                        !Read any lookup fields
  1012.       #ENDIF
  1013.  
  1014.       #IF(%SecondaryExist)                       #<!IF File schema Secondary
  1015.     OF DeleteRecord                              !Process a DELETE request
  1016.       DO SecondaryLookups                        !Read any lookup fields
  1017.       #ENDIF
  1018.  
  1019.     OF CheckRequired                             !Check REQ fields
  1020.  
  1021.       NonStop = 1
  1022.  
  1023.   END                                            !End CASE Action
  1024.  
  1025.   OPEN(Screen)                                   !Open the FORM screen
  1026.   DISPLAY                                        !Display screen fields
  1027.   IF Action = DeleteRecord                       !IF request for DELETE
  1028.     DISABLE(1,FIELDS())                          !Disable all screen fields
  1029.     ENABLE(?Next_Page)                           !Enable just the
  1030.     ENABLE(?Previous_Page)                       !useful buttons
  1031.     ENABLE(?Base_Page)                           !useful buttons
  1032.     ENABLE(?Last_Page)                           !useful buttons
  1033.   END                                            !End IF request for delete
  1034.   #EMBED('Setup Screen')
  1035.  
  1036.   LOOP                                           !Begin Main process loop
  1037.  
  1038.     #IF(%FormulasExist = 'TRUE')                 #<!Are there Formula fields?
  1039.       #SET(%GenerateFormulasOn,'TRUE')
  1040.     DO FormulaFields                             !Calculate Formula fields
  1041.     #ENDIF
  1042.     #IF(%SecondaryExist)                         #<!IF File schema Secondary
  1043.     #INSERT(%SecondaryChanged)
  1044.     #ENDIF
  1045.  
  1046.     IF NonStop                                   !Just check for required fields
  1047.       SELECT(1)                                  !Start at first field
  1048.       SELECT                                     !and enter Nonstop mode
  1049.       NonStop = 0                                !Switch indicator off
  1050.     END                                          #<!End If
  1051.     CASE SELECTED()                              !Process selected Field
  1052.       #INSERT(%ScreenSetupRoutines)
  1053.       OF NoMoreFields                            !All fields have been processed
  1054.  
  1055.       #IF(%DupKeyCheck)
  1056.        #INSERT(%DupKeyCode)
  1057.       #ENDIF
  1058.         #IF(%PullDownStructure)
  1059.         CLOSE(%PullDown)
  1060.         #ENDIF
  1061.         RETURN                                   !Return to caller
  1062.     END                                          !End CASE Selected()
  1063.  
  1064.     ACCEPT                                       !Enable screen entry
  1065.  
  1066.     CASE KEYCODE()                               !Process Alerted keys
  1067.     #FOR(%HotKey)
  1068.     OF %HotKey                                   #<!User HotKey
  1069.       %HotKeyProc                                #<!Call HotKey procedure
  1070.     #ENDFOR
  1071.     #INSERT(%FileMgrView)                      #!Insert File Manager View PPS
  1072.     OF CtrlPgUp
  1073.       Page = 1                                   !Decrement Page
  1074.       SELECT(1)                                  !Start with the first field
  1075.       SELECT                                     !and cycle non-stop
  1076.       CYCLE                                      !restart main process loop
  1077.     OF CtrlPgDn
  1078.       Page = Pages                               !Decrement Page
  1079.       SELECT(1)                                  !Start with the first field
  1080.       SELECT                                     !and cycle non-stop
  1081.       CYCLE                                      !restart main process loop
  1082.     OF EscKey
  1083.       Page -= 1                                  !Decrement Page
  1084.       #IF(%PullDownStructure)
  1085.       CLOSE(%PullDown)
  1086.       #ENDIF
  1087.       RETURN                                     !Return to caller
  1088.     END                                          ! End CASE
  1089.  
  1090.     CASE FIELD()                                 !Process fields
  1091.     #INSERT(%FormEditRoutines)
  1092.     #IF(%BasePageExists)
  1093.       OF ?Base_Page                              !On the Base Page button
  1094.  
  1095.         #EMBED('Base_Page Button Press')
  1096.         #FOR(%ScreenField)
  1097.           #IF(%ScreenFieldUse = '?Base_Page')
  1098.           #IF(%ScreenFieldEdit <> %NULL)
  1099.         %ScreenFieldEdit                         #<!Field Edit procedure
  1100.           #ENDIF
  1101.           #ENDIF
  1102.         #ENDFOR
  1103.         Page = 1                                 !Set to the MultiPage
  1104.         SELECT(1)                                !Start with the first field
  1105.         SELECT                                   !and cycle non-stop
  1106.         CYCLE                                    !restart main process loop
  1107.     #ENDIF
  1108.       OF ?Previous_Page                          !On Previous Page button
  1109.  
  1110.         #EMBED('Previous_Page Button Press')
  1111.         #FOR(%ScreenField)
  1112.           #IF(%ScreenFieldUse = '?Previous_Page')
  1113.           #IF(%ScreenFieldEdit <> %NULL)
  1114.         %ScreenFieldEdit                         #<!Field edit procedure
  1115.           #ENDIF
  1116.           #ENDIF
  1117.         #ENDFOR
  1118.         Page -= 1                                !Decrement Page number
  1119.         SELECT(1)                                !Start with the first field
  1120.         SELECT                                   !and cycle non-stop
  1121.         CYCLE                                    !restart main process loop
  1122.  
  1123.       OF ?Next_Page                              !On Next Page button
  1124.  
  1125.         #EMBED('Next_Page Button Press')
  1126.         #FOR(%ScreenField)
  1127.           #IF(%ScreenFieldUse = '?Next_Page')
  1128.           #IF(%ScreenFieldEdit <> %NULL)
  1129.         %ScreenFieldEdit                         #<!Field edit procedure
  1130.           #ENDIF
  1131.           #ENDIF
  1132.         #ENDFOR
  1133.         Page += 1                                !Increment Page number
  1134.         IF PAGE > PAGES THEN PAGE = 1.
  1135.         SELECT(1)                                !Start with the first field
  1136.         SELECT                                   !and cycle non-stop
  1137.         CYCLE                                    !restart main process loop
  1138.      #IF(%LastPageExists)
  1139.       OF ?Last_Page                              !On Last Page button
  1140.  
  1141.         #EMBED('Last_Page Button Press')
  1142.         #FOR(%ScreenField)
  1143.           #IF(%ScreenFieldUse = '?Last_Page')
  1144.           #IF(%ScreenFieldEdit <> %NULL)
  1145.         %ScreenFieldEdit                         #<!Field edit procedure
  1146.           #ENDIF
  1147.           #ENDIF
  1148.         #ENDFOR
  1149.         Page = Pages                             !Pages holds LAST page proc
  1150.         SELECT(1)                                !Start with the first field
  1151.         SELECT                                   !and cycle non-stop
  1152.         CYCLE                                    !restart main process loop
  1153.      #ENDIF
  1154.     END                                          !End CASE FIELD
  1155.  
  1156.   END                                            !END MAIN PROCESS LOOP
  1157.  
  1158. #EMBED('End of Procedure')
  1159. #INSERT(%FileMgrExit)                          #!Insert File Manager Exit PPS
  1160. #INSERT(%GenFormulas)
  1161. #IF(%SecondaryExist)
  1162. #INSERT(%SecondaryLookups)
  1163. #ENDIF
  1164. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  1165.  #IF(%CopyKey)
  1166. #INSERT(%SaveScrFlds)
  1167. #INSERT(%DupField)
  1168.  #ENDIF
  1169. #ENDIF
  1170. #INSERT(%InitFields)
  1171. #!***************************************************************************
  1172. #CHAIN('OM5.TPX')
  1173.