home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / C7101.ZIP / FORMGRPS.TPX < prev    next >
Text File  |  1994-02-01  |  34KB  |  793 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                              FormGrps.TPX              │Version: 3007.000│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│InitQue               GROUP                                               │
  7. #!│InitFields            GROUP                                               │
  8. #!│SecondaryLookups      GROUP                                               │
  9. #!│InsertMessage         GROUP                                               │
  10. #!│ChangeMessage         GROUP                                               │
  11. #!│DeleteMessage         GROUP                                               │
  12. #!│AutoIncCode           GROUP                                               │
  13. #!│RestoreAuto           GROUP                                               │
  14. #!│SetupConcurrency      GROUP                                               │
  15. #!│ConflictUpdate        GROUP                                               │
  16. #!│DupKeyCode            GROUP                                               │
  17. #!│ClearValues           GROUP                                               │
  18. #!│InitFormSymbols       GROUP                                               │
  19. #!│UpdateRelationSearch  GROUP                                               │
  20. #!│DeleteRelationSearch  GROUP                                               │
  21. #!│RelationalAccessFlds  GROUP                                               │
  22. #!│GenFormulas           GROUP                                               │
  23. #!│SecondaryChanged      GROUP                                               │
  24. #!│FieldDups             GROUP                                               │
  25. #!│SaveScrFlds           GROUP                                               │
  26. #!│DupFldCall            GROUP                                               │
  27. #!│DupField              GROUP                                               │
  28. #!│InitButtonExist       GROUP                                               │
  29. #!│AltKeys               GROUP                                               │
  30. #!│ProcCounter           GROUP                                               │
  31. #!│SavePrimedFields      GROUP                                               │
  32. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  33. #!│Version   Comments                                                        │
  34. #!│────────  ────────────────────────────────────────────────────────────────│
  35. #!│3007.000  Release of CDD3 version 3007 templates                          │
  36. #!└──────────────────────────────────────────────────────────────────────────┘
  37. #!
  38. #GROUP(%InitQue)
  39. #IF(%SharedFiles = 'TRUE')
  40.  
  41. !─────────────────────────────────────────────────────────────────────────────
  42. InitializeQueue ROUTINE                          #<!save initial record values
  43.   FREE(RecordQueue)
  44.   Sav:SaveRecord = %FilePre:Record               #<!Save the current record
  45.   #IF(%MemoChk)
  46.     #FOR(%FileMemo)
  47.       #FIX(%Field,%FileMemo)
  48.   SAV:%FieldID   = %Field                        #<!Save the memo
  49.     #ENDFOR
  50.   #ENDIF
  51.   ADD(RecordQueue,1)                             #<!add record to Queue
  52.   ADD(RecordQueue,2)                             #<!add record again
  53.   IF ERRORCODE()                                 #<!check Queue add error
  54.     CASE ERRORCODE()
  55.       OF NoMemErr                                #<!Is there enough memory?
  56.       #INSERT(%NotEnoughMemMsg)
  57.     ELSE                                         #<!On any other error
  58.       #INSERT(%GeneralErrorMsg)
  59.     END                                          #<!End CASE Errorcode
  60.     DISABLE(1,FIELDS())                          #<!Disable the screen fields
  61.     #IF(%TableForm = %Null)
  62.     ENABLE(?Cancel)                            #<!Enable the Cancel button
  63.     SELECT(?Cancel)                            #<!Place the cursor on Cancel
  64.     #ELSIF(%TableForm)
  65.       #IF(%CancelExists = %Null)
  66.     ENABLE(%FirstField)                        #<!Enable the First Field
  67.     SELECT(%FirstField)                        #<!Place cursor on Cancel
  68.     PRESS(EscKey)
  69.       #ELSE
  70.     ENABLE(?Cancel)                            #<!Enable the Cancel button
  71.     SELECT(?Cancel)                            #<!Place the cursor on Cancel
  72.       #ENDIF
  73.     #ENDIF
  74.     DISPLAY                                    #<!Update screen display
  75.   END                                            #<!End IF Errorcode
  76.   EXIT
  77. #ENDIF
  78. #!***************************************************************************
  79. #GROUP(%InitFields)
  80. #IF(%InitRoutine = 'Y')
  81.  
  82. !─────────────────────────────────────────────────────────────────────────────
  83. InitializeFields ROUTINE
  84. #FOR(%Field)
  85. #IF(%FieldInitial <> %NULL)
  86.    %Field = %FieldInitial
  87. #ENDIF
  88. #ENDFOR
  89. #ENDIF
  90. #!***************************************************************************
  91. #GROUP(%SecondaryLookups)
  92. !─────────────────────────────────────────────────────────────────────────────
  93. SecondaryLookups ROUTINE
  94.   #INSERT(%GetSecondaryRecords)                  #<!Lookup into Secondary files
  95.   DISPLAY                                        #<!Redisplay Screen Fields
  96. #!***************************************************************************
  97. #GROUP(%InsertMessage)
  98. #IF(%InsertMsg <> %NULL)
  99. LOC:Message = CENTER('%InsertMsg',SIZE(LOC:Message)) #<!Assign ADD message
  100. #ELSE
  101. LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message))#<!Assign ADD message
  102. #ENDIF
  103. #!***************************************************************************
  104. #GROUP(%ChangeMessage)
  105. #IF(%ChangeMsg <> %NULL)
  106. LOC:Message = CENTER('%ChangeMsg',SIZE(LOC:Message)) #<!Assign CHANGE message
  107. #ELSE
  108. LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message))#<!Assign CHANGE message
  109. #ENDIF
  110. #!***************************************************************************
  111. #GROUP(%DeleteMessage)
  112. #IF(%DeleteMsg <> %NULL)
  113. LOC:Message = CENTER('%DeleteMsg',SIZE(LOC:Message)) #<!Assign DELETE message
  114. #ELSE
  115. LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message))#<!Assign DELETE message
  116. #ENDIF
  117. #!***************************************************************************
  118. #GROUP(%AutoIncCode)
  119. #IF(%AutoInc = 'Y')
  120.  
  121. !─────────────────────────────────────────────────────────────────────────────
  122. AutoNumber Routine
  123.   LOOP                                            #<!Loop for autonumbering
  124.   #FIX(%File,%Primary)
  125.   #FOR(%Key)
  126.     #SET(%SaveKey,%Key)
  127.     #IF(%KeyAuto)                                #! <> %NULL
  128.       #FOR(%KeyField)
  129.         #FIX(%Field,%KeyField)
  130.         #IF(%KeyFieldSequence = 'ASCENDING')     #! IF Ascending Key Field
  131.           #IF(UPPER(%FieldType) = 'PICTURE')     #!Autonumber Picture data type
  132.             #IF(INSTRING('@N',UPPER(%FieldRecordPicture),1,1)) #!If its an @n picture
  133.     %KeyField = ALL('9')                         #<!Fill strings with 9's
  134.             #ELSE
  135.     CLEAR(%KeyField,1)                           #<!Clear Ascending to high value
  136.             #ENDIF
  137.           #ELSE
  138.     CLEAR(%KeyField,1)                           #<!Clear Ascending to high value
  139.           #ENDIF
  140.         #ELSE
  141.           #IF(UPPER(%FieldType) = 'PICTURE')     #!Autonumber Picture data type
  142.             #IF(INSTRING('@N',UPPER(%FieldRecordPicture),1,1)) #!If its an @n picture
  143.     %KeyField = ALL('0')                         #<!Fill strings with 0's
  144.             #ELSE
  145.     CLEAR(%KeyField,-1)                          #<!Clear Descending to low value
  146.             #ENDIF
  147.           #ELSE
  148.     CLEAR(%KeyField,-1)                          #<!Clear Descending to low value
  149.           #ENDIF
  150.         #ENDIF
  151.       #ENDFOR
  152.       #FOR(%Formula)
  153.         #IF(UPPER(%FormulaClass) = 'PRIMEKEY')
  154.     #INSERT(%GenerateFormula)
  155.         #ENDIF
  156.       #ENDFOR
  157.       #IF(%PrimeKeysExist)
  158.         #FOR(%KeyField)
  159.           #IF(%KeyField <> %KeyAuto)
  160.     Prime::%KeyField = %KeyField                #<!Save for Subset numbering
  161.           #ENDIF
  162.         #ENDFOR
  163.       #ENDIF
  164.       #FIX(%KeyField,%KeyAuto)
  165.     SET(%Key,%Key)                               #<!%KeyFieldSequence
  166.       #IF(%KeyFieldSequence='ASCENDING')
  167.     PREVIOUS(%Primary)                           #<!Read last record (Ascending)
  168.       #ELSE
  169.     NEXT(%Primary)                               #<!Read last record (Ascending)
  170.       #ENDIF
  171.     IF ERRORCODE() = BadRecErr                   #<!If Errorcode No Records
  172.       %KeyAuto:AutoInc# = 1                      #<!then start numbering at 1
  173.     ELSIF ERRORCODE()                            #<!On any other error
  174.       #INSERT(%KeyedRecordReadMsg)
  175.       DO ProcedureReturn
  176.     ELSE
  177.       #FIX(%Key,%SaveKey)
  178.       #IF(%PrimeKeysExist)
  179.         #SET(%KeyFieldCounter,%Null)
  180.         #FOR(%KeyField)
  181.           #IF(%KeyField <> %KeyAuto)
  182.             #SET(%KeyFieldCounter,(%KeyCounter+1))
  183.           #ELSE
  184.             #BREAK
  185.           #ENDIF
  186.         #ENDFOR
  187.         #SET(%IfWritten,%Null)
  188.         #IF(%KeyFieldCounter)
  189.           #FOR(%KeyField)
  190.             #IF((%KeyFieldCounter='1'))
  191.               #IF(%IfWritten)
  192.       AND PRIME::%KeyField = %KeyField
  193.               #ELSE
  194.       IF PRIME::%KeyField = %KeyField
  195.               #ENDIF
  196.               #BREAK
  197.             #ELSE
  198.               #IF(%IfWritten)
  199.       AND PRIME::%KeyField = %KeyField|
  200.               #ELSE
  201.       IF PRIME::%KeyField = %KeyField|
  202.               #ENDIF
  203.               #SET(%KeyFieldCounter,(%KeyFieldCounter-1))
  204.               #SET(%IfWritten,'TRUE')
  205.             #ENDIF
  206.           #ENDFOR
  207.         %KeyAuto:AutoInc# = %KeyAuto + 1         #<!Subset incremented value
  208.       ELSE
  209.         %KeyAuto:AutoInc# = 1                    #<!then start numbering at 1
  210.       END
  211.         #ELSE                                    #!End test subset match
  212.       %KeyAuto:AutoInc# = %KeyAuto + 1           #<!Save incremented value
  213.         #ENDIF
  214.       #ELSE                                      #!No subset support
  215.       %KeyAuto:AutoInc# = %KeyAuto + 1           #<!Save incremented value
  216.       #ENDIF
  217.     END                                          #<!End IF errorcode
  218.     #ENDIF                                       #!End IF keyauto
  219.   #ENDFOR                                        #!End FOR KEY
  220.     #INSERT(%ClearValues)
  221.   #FOR(%Formula)
  222.     #IF(UPPER(%FormulaClass) = 'PRIMEKEY')
  223.     #INSERT(%GenerateFormula)                   #<!Allow for Subset numbering
  224.     #ENDIF
  225.   #ENDFOR
  226.   #FOR(%Key)
  227.     #IF(%KeyAuto <> %NULL)
  228.     %KeyAuto = %KeyAuto:AutoInc#                 #<!Move the incremented value
  229.     #ENDIF
  230.   #ENDFOR
  231.     ADD(%Primary)                                #<!Add the record now
  232.     IF ERRORCODE()                               #<!Was there an error?
  233.       CASE ERRORCODE()                           #<!Process errors
  234.       OF DupKeyErr                               #<!Is it a duplicate key?
  235.         CYCLE                                    #<!then try again
  236.       ELSE                                       #<!Else
  237.         IF DiskError('Record could not be ADDed') #<!Check any other error
  238.           DO ProcedureReturn
  239.         END                                      #<!End IF Diskerror
  240.       END                                        #<!End CASE errorcode
  241.     ELSE                                         #<!Else no error
  242.       BREAK                                      #<!so BREAK Loop
  243.     END                                          #<!End IF errorcode
  244.   END                                            #<!End LOOP for Autonumbering
  245.   AutoIncAdd = True                              #<!Switch AutoIncAdd ON
  246.   AutoAddPtr = POSITION(%Primary)                #<!Save the record position
  247.   RESET(%Primary,AutoAddPtr)                     #<!Position to record we added
  248.   HOLD(%Primary,4)                               #<!Hold the record
  249.   NEXT(%Primary)                                 #<!and read it in to buffer
  250.   IF DiskError('Could not READ Record')          #<!Check for I/O error
  251.     DO ProcedureReturn
  252.   END                                            #<!End IF Diskerror
  253.   Action = ChangeRecord                          #<!Action is now change
  254.   EXIT                                           #<!Exit the routine
  255. #ENDIF
  256. #!***************************************************************************
  257. #GROUP(%RestoreAuto)
  258.     #FOR(%Key)
  259.     #IF(%KeyAuto <> %NULL)
  260. %KeyAuto = %KeyAuto:AutoInc#                     #<!Restore incremented value
  261.     #ENDIF
  262.     #ENDFOR
  263. #!***************************************************************************
  264. #GROUP(%SetupConcurrency)
  265. DO InitializeQueue                               #<!Save record to QUEUE
  266. SavePointer = POSITION(%Primary)                 #<!Save the record position
  267. #!***************************************************************************
  268. #GROUP(%ConflictUpdate)
  269. PUT(RecordQueue)                                 #<!Update the memory Queue
  270. #INSERT(%RecordChangedMsg)
  271. SELECT(1)                                        #<!Place cursor on 1st field
  272. DISPLAY                                          #<!Update the screen
  273. AbortTransaction = True                          #<!Turn AbortWrite# ON
  274. EXIT                                             #<!Exit the Routine
  275. #!***************************************************************************
  276. #GROUP(%DupKeyCode)
  277. #FIX(%File,%Primary)
  278. IF ERRORCODE() = DupKeyErr                       #<! Duplicate key detected
  279.   #FOR(%Key)
  280.   #IF(UPPER(%KeyDuplicate) <> 'Y')
  281.   IF DUPLICATE(%Key)                             #<!check unique keys
  282.     #IF(%SharedFiles = 'TRUE')
  283.     RELEASE(%File)                               #<!Release the HOLD
  284.     #ENDIF
  285.     GLO:Message3 = '[ '
  286.     #FOR(%KeyField)
  287.     GLO:Message3 = Clip(GLO:Message3) & (' %KeyField ')
  288.     #ENDFOR
  289.     GLO:Message3 = Clip(GLO:Message3)&' ]'
  290.     GLO:Message1 = 'This record creates a duplicate key entry'
  291.     GLO:Message2 = 'The unique key field(s) are listed below: '
  292.     ShowWarning                                  #<!inform the user
  293.   END
  294.   #ENDIF
  295.   #ENDFOR
  296.   SELECT(1)                                      #<!select first field
  297.   DISPLAY                                        #<!re-display the screen
  298.   CYCLE                                          #<!back to main loop
  299. END                                              #<!End IF Duplicate errorcode
  300. #!***************************************************************************
  301. #GROUP(%ClearValues)
  302. CLEAR(%FilePre:Record)                           #<!CLEAR Record buffer
  303. #FOR(%FileMemo)
  304. CLEAR(%FileMemo)                                 #<!CLEAR Memo buffer
  305. #ENDFOR
  306. #!***************************************************************************
  307. #GROUP(%InitFormSymbols)
  308. #!                     INITIALIZE FORM TEMPLATE SYMBOLS
  309. #!────────────────────────────────────────────────────────────────────────────
  310. #!User Defined Symbols              Purpose/Meaning
  311. #!────────────────────────────────────────────────────────────────────────────
  312.   #SET(%HotKeysExist,%Null)       #!Do Hot Keys Exist
  313.   #SET(%AutoInc,%Null)            #!Does %Primary use an Auto-Increment key
  314.   #SET(%DupKeyCheck,%Null)        #!Does a ,DUP key exist for %Primary
  315.   #SET(%LoopFormulasExist,%Null)  #!Do unclassed formulas exist?
  316.   #SET(%PrimeKeysExist,%Null)     #!Are there any PrimeKey formulas
  317.   #SET(%MemoChk,%Null)            #!Are any memos present in Primary
  318.   #SET(%InitRoutine,%Null)        #!Do any fields have initial values?
  319.   #SET(%FileControlMode,%Null)    #!Controls writing of file opening/closing
  320.   #SET(%ControlLookups,'Y')       #!Searches Lookups for opening/closing
  321.   #SET(%ControlRelatedFiles,'Y')  #!Searches relations for opening/closing
  322.   #SET(%RelatedFileListing,%Null) #!List Containing Related Files
  323.   #SET(%LevelOne,%Null)           #!
  324.   #SET(%LevelOneLinks,%Null)      #!
  325.   #SET(%LinkPool,%Null)           #!
  326.   #SET(%RelatedFiles,%Null)       #!
  327.   #SET(%RestrictDelete,%Null)     #!
  328.   #SET(%RestrictUpdate,%Null)     #!
  329.   #SET(%CascadeDelete,%Null)      #!
  330.   #SET(%CascadeUpdate,%Null)      #!
  331.   #SET(%ClearOnDelete,%Null)      #!
  332.   #SET(%ClearOnUpdate,%Null)      #!
  333.   #SET(%SecondaryExist,%Null)     #!
  334.   #SET(%PrimaryUpdateConst,%Null)
  335.   #SET(%PrimaryDeleteConst,%Null)
  336.   #SET(%RelationString,%Null)
  337.   #SET(%ChildPre,%Null)
  338.   #SET(%ParentPre,%Null)
  339.   #SET(%AllRelations,%Null)
  340.   #SET(%RelatedChildList,%Null)
  341.   #SET(%RelatedParentList,%Null)
  342.   #SET(%UpdateRelations,%Null)
  343.   #SET(%UpdateChildList,%Null)
  344.   #SET(%UpdateParentList,%Null)
  345.   #SET(%DeleteRelations,%Null)
  346.   #SET(%DeleteChildList,%Null)
  347.   #SET(%DeleteParentList,%Null)
  348.   #SET(%ControlRelatedFiles,'TRUE')
  349.   #SET(%NonStopSelect,'TRUE')
  350.  
  351. #FIX(%File,%Primary)                             #!Prime File symbols
  352. #SET(%PrimaryDriver,%FileType)                   #!Retrieve the file driver
  353. #FOR(%HotKey)                                    #!For Each Hot Key
  354.  #IF(%HotKeyProc)                                #!If there is a procedure
  355.   #SET(%HotKeysExist,'Y')                        #!Set the flag
  356.   #BREAK                                         #!and stop looking
  357.  #ENDIF                                          #!END (if %HotKeyProc)
  358. #ENDFOR                                          #!END (for %HotKey)
  359. #FOR(%Key)                                       #!For each key of %Primary
  360.   #IF(%KeyAuto <> %NULL)                         #!If asks for Auto Increment
  361.     #SET(%AutoInc,'Y')                           #!Set the flag
  362.   #ENDIF                                         #!END (if %KeyAuto)
  363.   #IF(%KeyDuplicate <> 'Y')                      #!If dup checking needed
  364.     #SET(%DupKeyCheck,'Y')                       #!Set the Flag
  365.   #ENDIF                                         #!END (if %KeyDuplicate)
  366. #ENDFOR                                          #!END (for %Key)
  367. #FOR(%Formula)                                   #!For each formula
  368.   #IF(UPPER(%FormulaClass) = '')                 #!If there's no class
  369.     #SET(%LoopFormulasExist,'Y')                 #!Flag for loop processing
  370.   #ENDIF                                         #!END (if formulaclass = '')
  371.   #IF(UPPER(%FormulaClass) = 'PRIMEKEY')         #!Formula primes key values
  372.     #SET(%PrimeKeysExist,'Y')                    #!Set the Flag
  373.   #ENDIF                                         #!END (if formulaclass = 'P...')
  374. #ENDFOR                                          #!END (for %Formula)
  375. #FOR(%FileMemo)                                  #!For each memo field
  376.   #SET(%MemoChk,'Y')                             #!Set a flag that one exists
  377.   #BREAK                                         #!and stop looking
  378. #ENDFOR                                          #!END (for %FileMemo)
  379. #FOR(%Field)                                     #!For each field of Primary
  380.   #IF(%FieldInitial <> %NULL)                    #!If Field has initial value
  381.     #SET(%InitRoutine,'Y')                       #!Flag for initializing code
  382.     #BREAK                                       #!and quit looking
  383.   #ENDIF                                         #!END (if %FieldInitial)
  384. #ENDFOR                                          #!END (for Field)
  385. #SET(%ProcessingFile,%Primary)                   #!Set for Relations Search
  386. #INSERT(%UpdateRelationSearch)                   #!Retrieves Relations
  387. #SET(%ProcessingFile,%Primary)                   #!Set for Relations Search
  388. #INSERT(%DeleteRelationSearch)                   #!Retrieves Relations
  389. #FOR(%Secondary)                                 #!For each secondary file
  390.   #IF(%SecondaryType = 'MANY:1')                 #!If relation = Many:1
  391.     #SET(%SecondaryExist,'Y')                    #!Set SecondaryExist flag
  392.   #ENDIF                                         #!END (if SecondaryType = Many:1)
  393. #ENDFOR                                          #!END (for Secondary)
  394. #!***************************************************************************
  395. #GROUP(%UpdateRelationSearch)
  396. #FIX(%File,%ProcessingFile)
  397. #FOR(%Relation)
  398.   #IF(%RelationType = '1:MANY')
  399.     #IF(%RelationConstraintUpdate)
  400.       #SET(%NoLinkFound,%Null)
  401.       #FOR(%RelationKeyField)
  402.         #IF(UPPER(%RelationKeyFieldLink)='TODO')
  403.           #ERROR(' DICTIONARY ERROR!')
  404.           #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  405.           #ERROR(%ErrorMessage)
  406.           #ERROR('  contains undefined (TODO) links.')
  407.           #ERROR('  Code generated will NOT compile')
  408.           #ERROR('')
  409.         #ELSIF(%RelationKeyFieldLink)
  410.           #IF(%NoLinkFound)
  411.             #ERROR(' DICTIONARY ERROR!')
  412.             #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  413.             #ERROR(%ErrorMessage)
  414.             #ERROR('  is an unenforcable constrained UPDATE relation.')
  415.             #ERROR('  A non-linked key element on the MANY side of a')
  416.             #ERROR('  relation may not be followed by linked key elements.')
  417.             #ERROR('  Code generated will NOT compile')
  418.             #ERROR('')
  419.           #ENDIF
  420.         #ELSE
  421.           #SET(%NoLinkFound,'TRUE')
  422.         #ENDIF
  423.       #ENDFOR
  424.     #ENDIF
  425.     #SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
  426.     #SET(%ParentPre,('['&%FilePre&']'))
  427.     #SET(%ChildPre,('['&%RelationPre&']'))
  428.     #IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
  429.       #SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
  430.     #ENDIF
  431.     #IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
  432.       #SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
  433.     #ENDIF
  434.     #IF(%RelationConstraintUpdate)
  435.       #SET(%UpdateRelations,(%UpdateRelations&%RelationString))
  436.       #SET(%AllRelations,(%AllRelations&%RelationString))
  437.       #IF((INSTRING(%ParentPre,%UpdateParentList,1,1))=0)
  438.         #SET(%UpdateParentList,(%UpdateParentList&%ParentPre))
  439.       #ENDIF
  440.       #IF((INSTRING(%ChildPre,%UpdateChildList,1,1))=0)
  441.         #SET(%UpdateChildList,(%UpdateChildList&%ChildPre))
  442.       #ENDIF
  443.       #IF(%RelationConstraintUpdate<>'RESTRICT')
  444.         #SET(%ProcessingFile,%Relation)
  445. #INSERT(%UpdateRelationSearch)
  446.       #ENDIF
  447.     #ENDIF
  448.   #ENDIF
  449. #ENDFOR
  450. #!***************************************************************************
  451. #GROUP(%DeleteRelationSearch)
  452. #FIX(%File,%ProcessingFile)
  453. #FOR(%Relation)
  454.   #IF(%RelationType = '1:MANY')
  455.     #IF(%RelationConstraintDelete)
  456.       #SET(%NoLinkFound,%Null)
  457.       #FOR(%RelationKeyField)
  458.         #IF(UPPER(%RelationKeyFieldLink)='TODO')
  459.           #ERROR(' DICTIONARY ERROR!')
  460.           #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  461.           #ERROR(%ErrorMessage)
  462.           #ERROR('  contains undefined (TODO) links.')
  463.           #ERROR('  Code generated will NOT compile')
  464.           #ERROR('')
  465.         #ELSIF(%RelationKeyFieldLink)
  466.           #IF(%NoLinkFound)
  467.             #ERROR(' DICTIONARY ERROR!')
  468.             #SET(%ErrorMessage,('  The Relation: ' & %File & '─' & %Relation))
  469.             #ERROR(%ErrorMessage)
  470.             #ERROR('  is an unenforcable constrained DELETE relation.')
  471.             #ERROR('  A non-linked key element on the MANY side of a')
  472.             #ERROR('  relation may not be followed by linked key elements.')
  473.             #ERROR('  Code generated will NOT compile')
  474.             #ERROR('')
  475.           #ENDIF
  476.         #ELSE
  477.           #SET(%NoLinkFound,'TRUE')
  478.         #ENDIF
  479.       #ENDFOR
  480.     #ENDIF
  481.     #SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
  482.     #SET(%ParentPre,('['&%FilePre&']'))
  483.     #SET(%ChildPre,('['&%RelationPre&']'))
  484.     #IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
  485.       #SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
  486.     #ENDIF
  487.     #IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
  488.       #SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
  489.     #ENDIF
  490.     #IF(%RelationConstraintDelete)
  491.       #SET(%DeleteRelations,(%DeleteRelations&%RelationString))
  492.       #IF((INSTRING(%RelationString,%AllRelations,1,1))=0)
  493.         #SET(%AllRelations,(%AllRelations&%RelationString))
  494.       #ENDIF
  495.       #IF((INSTRING(%ParentPre,%DeleteParentList,1,1))=0)
  496.         #SET(%DeleteParentList,(%DeleteParentList&%ParentPre))
  497.       #ENDIF
  498.       #IF((INSTRING(%ChildPre,%DeleteChildList,1,1))=0)
  499.         #SET(%DeleteChildList,(%DeleteChildList&%ChildPre))
  500.       #ENDIF
  501.       #IF(%RelationConstraintDelete<>'RESTRICT')
  502.         #SET(%ProcessingFile,%Relation)
  503. #INSERT(%DeleteRelationSearch)
  504.       #ENDIF
  505.     #ENDIF
  506.   #ENDIF
  507. #ENDFOR
  508. #!*************************************************************************
  509. #GROUP(%RelationalAccessFlds)
  510. #FOR(%File)
  511.   #SET(%ParentPre,('['&%FilePre&']'))
  512.   #IF((INSTRING(%ParentPre,%RelatedParentList,1,1)))
  513.     #FOR(%Relation)
  514.       #SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
  515.       #IF((INSTRING(%RelationString,%AllRelations,1,1)))
  516.         #FOR(%RelationKeyField)
  517.           #IF(%RelationKeyFieldLink <> %NULL)
  518.             #FIX(%Field,%RelationKeyFieldLink)
  519.             #IF(%FieldType = 'GROUP')
  520. %RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink),PRE(LNK) #<!Define a link field
  521.             #ELSE
  522. %RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink) #<!Define a link field
  523.             #ENDIF
  524.           #ENDIF
  525.         #ENDFOR
  526.       #ENDIF
  527.     #ENDFOR
  528.   #ENDIF
  529. #ENDFOR
  530. #!**************************************************************************
  531. #GROUP(%GenFormulas)
  532. #IF(%GenerateFormulasOn)
  533.  
  534. !─────────────────────────────────────────────────────────────────────────────
  535. FormulaFields ROUTINE
  536.  #FOR(%Formula)
  537.   #IF(UPPER(%FormulaClass) <> 'PRIMEKEY')
  538.   #IF(UPPER(%FormulaClass) <> 'SETUP')
  539.   #IF(UPPER(%FormulaClass) <> 'RETURN')
  540.    #IF(%CodePosition = %NULL OR %CodePosition = %FormulaClass)
  541.      #IF(%FormulaType = 'COMPUTED')
  542.   %Formula = %FormulaComputation                 #<!Computed Formula (no class)
  543.      #ELSE
  544.   IF %FormulaCondition                           #<!If Formula condition
  545.     %Formula = %FormulaTrue                      #<! is TRUE
  546.        #IF(%FormulaFalse)
  547.   ELSE                                           ! else
  548.     %Formula = %FormulaFalse                     #<! condition is FALSE
  549.        #ENDIF
  550.   END                                            #<!End formula condition
  551.        #ENDIF
  552.        #SET(%CurrentFormula,('?' & %Formula))
  553.        #FIX(%Screenfield,%CurrentFormula)
  554.        #IF(%Screenfield)
  555.   DISPLAY(?%Formula)                             #<!Update screen display
  556.        #ENDIF
  557.    #ENDIF
  558.  
  559.   #ENDIF                                         #!Not PrimeKey class
  560.   #ENDIF                                         #!Not Setup class
  561.   #ENDIF                                         #!Not Return class
  562.  
  563.  #ENDFOR
  564. #ENDIF
  565. #!**************************************************************************
  566. #GROUP(%SecondaryChanged)
  567. #SET(%KeyFieldCounter,%Null)
  568. #SET(%IfWritten,%Null)
  569. #FOR(%Secondary)                                #! for fields on the form
  570.   #IF(%SecondaryType = 'MANY:1')                #!Check for lookup files
  571.     #FIX(%File,%SecondaryTo)
  572.     #FIX(%Relation,%Secondary)
  573.     #FOR(%RelationKeyField)
  574.       #IF(RelationKeyFieldLink)
  575.         #SET(%KeyFieldCounter,(%KeyFieldCounter+1))
  576.       #ENDIF
  577.     #ENDFOR
  578.   #ENDIF
  579. #ENDFOR
  580. #FIX(%File,%Primary)
  581. #IF(%KeyFieldCounter)
  582.   #FOR(%Secondary)                              #! for fields on the form
  583.     #IF(%SecondaryType = 'MANY:1')              #!Check for lookup files
  584.       #FIX(%File,%SecondaryTo)
  585.       #FIX(%Relation,%Secondary)
  586.       #FOR(%RelationKeyField)
  587.         #IF(RelationKeyFieldLink)
  588.           #IF(%KeyFieldCounter='1')
  589.             #IF(%IfWritten)
  590. OR %RelationKeyField <> %RelationKeyFieldLink    #<!Check for changes
  591.             #ELSE
  592. IF %RelationKeyField <> %RelationKeyFieldLink    #<!Check for changes
  593.             #ENDIF
  594.             #BREAK
  595.           #ELSE
  596.             #IF(%IfWritten)
  597. OR %RelationKeyField <> %RelationKeyFieldLink  | #<!Check for changes
  598.             #ELSE
  599. IF %RelationKeyField <> %RelationKeyFieldLink   |#<!Check for changes
  600.             #SET(%IfWritten,'TRUE')
  601.             #ENDIF
  602.             #SET(%KeyFieldCounter,(%KeyFieldCounter-1))
  603.           #ENDIF
  604.         #ENDIF
  605.       #ENDFOR
  606.     #ENDIF
  607.   #ENDFOR
  608.   DO SecondaryLookups                            #<!Call lookup Routine
  609. END
  610. #ENDIF
  611. #!***************************************************************************
  612. #GROUP(%FieldDups)
  613. #FOR(%ScreenField)
  614.   #IF(%ScreenFieldUse)
  615.     #SET(%Fld,%ScreenFieldUse)
  616.     #FIX(%Field,%ScreenFieldUse)
  617.     #IF(SUB(%Fld,1,1) <> '?')
  618.       #IF(%FieldID)
  619.         #IF(UPPER(%FieldFile) = UPPER(%Primary))
  620.           #IF(%FieldDimension1)
  621.             #IF(INSTRING(%Field,%DimPool,1,1) = '0')
  622.               #SET(%DimPool,(%DimPool & ',' & %Field))
  623. Dup::%Field          LIKE(%Field)
  624.             #ENDIF
  625.           #ELSE
  626.             #IF(%FieldType = 'GROUP')
  627. Dup::%ScreenFieldUse LIKE(%ScreenFieldUse),PRE(Dup)
  628.             #ELSE
  629. Dup::%ScreenFieldUse LIKE(%ScreenFieldUse)
  630.             #ENDIF
  631.           #ENDIF
  632.         #ENDIF
  633.       #ENDIF
  634.     #ENDIF
  635.   #ENDIF
  636. #ENDFOR
  637. #!***************************************************************************
  638. #GROUP(%SaveScrFlds)
  639.  
  640. !─────────────────────────────────────────────────────────────────────────────
  641. SaveScrFlds ROUTINE
  642.  #FOR(%ScreenField)
  643.  #IF(%ScreenFieldUse)
  644.   #SET(%Fld,%ScreenFieldUse)
  645.    #FIX(%Field,%ScreenFieldUse)
  646.   #IF(SUB(%Fld,1,1) <> '?')
  647.     #IF(%FieldID)
  648.       #IF(UPPER(%FieldFile) = UPPER(%Primary))
  649.   Dup::%ScreenFieldUse = %ScreenFieldUse         #<!Save screen entry
  650.       #ENDIF
  651.     #ENDIF
  652.   #ENDIF
  653.  #ENDIF
  654.  #ENDFOR
  655. #!***************************************************************************
  656. #GROUP(%DupFldCall)
  657. IF KEYCODE() = %CopyKey                          #<!User requested field copy
  658.   DO DupField                                    #<!Call duplication Routine
  659. END                                              #<!End copy key check
  660. #!***************************************************************************
  661. #GROUP(%DupField)
  662.  
  663. !─────────────────────────────────────────────────────────────────────────────
  664. DupField ROUTINE
  665.   CASE SELECTED()                                !Which field is selected?
  666.  #FOR(%ScreenField)
  667.  #IF(%ScreenFieldUse)
  668.   #SET(%Fld,%ScreenFieldUse)
  669.    #FIX(%Field,%ScreenFieldUse)
  670.   #IF(SUB(%Fld,1,1) <> '?')
  671.     #IF(%FieldID)
  672.       #IF(UPPER(%FieldFile) = UPPER(%Primary))
  673.     OF ?%ScreenFieldUse
  674.       %ScreenFieldUse = Dup::%ScreenFieldUse     #<!Move saved entry to screen
  675.       #ENDIF
  676.     #ENDIF
  677.   #ENDIF
  678.  #ENDIF
  679.  #ENDFOR
  680.   END                                            #<!End Case Selected
  681.   DISPLAY                                        #<!Update screen display
  682. #!***************************************************************************
  683. #GROUP(%InitButtonExist)
  684.   #FIX(%ScreenField,'?Previous_Page')
  685.   #IF(%ScreenField)
  686.     #SET(%PrevExist,'1')
  687.   #ELSE
  688.     #SET(%PrevExist,%NULL)
  689.   #ENDIF
  690.   #FIX(%ScreenField,'?Next_Page')
  691.   #IF(%ScreenField)
  692.     #SET(%NextExist,'1')
  693.   #ELSE
  694.     #SET(%NextExist,%NULL)
  695.   #ENDIF
  696.   #FIX(%ScreenField,'?Base_Page')
  697.   #IF(%ScreenField)
  698.     #SET(%BaseExist,'1')
  699.   #ELSE
  700.     #SET(%BaseExist,%NULL)
  701.   #ENDIF
  702.   #FIX(%ScreenField,'?Last_Page')
  703.   #IF(%ScreenField)
  704.     #SET(%LastExist,'1')
  705.   #ELSE
  706.     #SET(%LastExist,%NULL)
  707.   #ENDIF
  708.   #FIX(%ScreenField,'?Ok')
  709.   #IF(%ScreenField)
  710.     #SET(%OkayExist,'1')
  711.   #ELSE
  712.     #SET(%OkayExist,%NULL)
  713.   #ENDIF
  714. #!***************************************************************************
  715. #GROUP(%AltKeys)
  716. #IF(%Page2Proc)
  717. OF Alt2                                          !Hotkey to Page 2
  718.   PRESS(AltN)                                    !Press Next_Page Key
  719. #ENDIF
  720. #IF(%Page3Proc)
  721. OF Alt3                                          !Hotkey to Page 3
  722.   LOC:Page = 2                                   !Press Next_Page Key
  723.   PRESS(AltN)
  724. #ENDIF
  725. #IF(%Page4Proc)
  726. OF Alt4                                          !Hotkey to Page 4
  727.   LOC:Page = 3                                   !Press Next_Page Key
  728.   PRESS(AltN)
  729. #ENDIF
  730. #IF(%Page5Proc)
  731. OF Alt5                                          !Hotkey to Page 5
  732.   LOC:Page = 4                                   !Press Next_Page Key
  733.   PRESS(AltN)
  734. #ENDIF
  735. #IF(%Page6Proc)
  736. OF Alt6                                          !Hotkey to Page 6
  737.   LOC:Page = 5                                   !Press Next_Page Key
  738.   PRESS(AltN)
  739. #ENDIF
  740. #IF(%Page7Proc)
  741. OF Alt7
  742.   LOC:Page = 6                                   !Hotkey to Page 7
  743.   PRESS(AltN)                                    !Press Next_Page Key
  744. #ENDIF
  745. #IF(%Page8Proc)
  746. OF Alt8
  747.   LOC:Page = 7                                   !Hotkey to Page 8
  748.   PRESS(AltN)                                    !Press Next_Page Key
  749. #ENDIF
  750. #IF(%Page9Proc)
  751. OF Alt9
  752.   LOC:Page = 8                                   !Hotkey to Page 9
  753.   PRESS(AltN)                                    !Press Next_Page Key
  754. #ENDIF
  755. #!***************************************************************************
  756. #GROUP(%ProcCounter)
  757.       #IF(%Page2Proc)
  758.         #SET(%ProcCount,'2')
  759.         #IF(%Page3Proc)
  760.             #SET(%ProcCount,(%ProcCount + 1))
  761.          #ENDIF
  762.          #IF(%Page4Proc)
  763.             #SET(%ProcCount,(%ProcCount + 1))
  764.          #ENDIF
  765.          #IF(%Page5Proc)
  766.             #SET(%ProcCount,(%ProcCount + 1))
  767.          #ENDIF
  768.          #IF(%Page6Proc)
  769.             #SET(%ProcCount,(%ProcCount + 1))
  770.          #ENDIF
  771.          #IF(%Page7Proc)
  772.             #SET(%ProcCount,(%ProcCount + 1))
  773.          #ENDIF
  774.          #IF(%Page8Proc)
  775.             #SET(%ProcCount,(%ProcCount + 1))
  776.          #ENDIF
  777.          #IF(%Page9Proc)
  778.             #SET(%ProcCount,(%ProcCount + 1))
  779.          #ENDIF
  780.       #ENDIF
  781. #!***************************************************************************
  782. #GROUP(%SavePrimedFields)
  783. #FOR(%Key)
  784.  #IF(%KeyAuto)
  785.   #FOR(%KeyField)
  786.    #IF(%KeyField <> %KeyAuto)
  787. Prime::%KeyField  LIKE(%KeyField)
  788.    #ENDIF
  789.   #ENDFOR
  790.  #ENDIF
  791. #ENDFOR
  792. #CHAIN('MiscGrps.TPX')
  793.