home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / C7101.ZIP / RELATION.TPX < prev    next >
Text File  |  1994-01-31  |  53KB  |  753 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                              Relation.TPX              │Version: 3007.101│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│RIUpdates             GROUP                                               │
  7. #!│WriteUpdates          GROUP                                               │
  8. #!│RIDeletes             GROUP                                               │
  9. #!│WriteDeletes          GROUP                                               │
  10. #!│InitLogout            GROUP                                               │
  11. #!│BtrieveTrxFraming     GROUP                                               │
  12. #!│SavePrimaryLinks      GROUP                                               │
  13. #!│ConcurrentWrite       GROUP                                               │
  14. #!│ConcurrentDelete      GROUP                                               │
  15. #!│DriverCheck           GROUP                                               │
  16. #!│PrimaryDriverCheck    GROUP                                               │
  17. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  18. #!│Version   Comments                                                        │
  19. #!│────────  ────────────────────────────────────────────────────────────────│
  20. #!│3007.000  Release of CDD3 version 3007 templates                          │
  21. #!│3007.101  Repaired RIUpdates GROUP                                        │
  22. #!│          Modified PrimaryDriverCheck GROUP                               │
  23. #!│          Modified DriverCheck GROUP                                      │
  24. #!└──────────────────────────────────────────────────────────────────────────┘
  25. #!
  26. #!***************************************************************************
  27. #GROUP(%RIUpdates)                               #!Perform Referential Updates
  28. #!
  29. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  30. #!│                                RIUpdates               │Version: 3007.101│
  31. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  32. #!│Purpose:      Constructs RI Update code                                   │
  33. #!│Called From:  FORM.TPX and MULTIPG.TPX (Near the end)                     │
  34. #!│Assumptions:  None                                                        │
  35. #!│Inserts:      WriteUpdates (perform RI updates)                           │
  36. #!│              InitLogout (performs transaction logging)                   │
  37. #!│              RIRestrictMsg (warns user if constrained as restricted)     │
  38. #!│              AbortTransactionMsg (warns user if transaction aborted)     │
  39. #!│              RIUpdateError (warns user on RI update error)               │
  40. #!│Symbols Set:  None                                                        │
  41. #!│Notes:        None                                                        │
  42. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  43. #!│Version   Comments                                                        │
  44. #!│────────  ────────────────────────────────────────────────────────────────│
  45. #!│3007.000  Release of CDD3 version 3007 templates                          │
  46. #!│3007.101  Repaired code generating the %LogoutList symbol.  Primary needed│
  47. #!│          to be added to the list.                                        │
  48. #!└──────────────────────────────────────────────────────────────────────────┘
  49. #!
  50. #FOR(%File)                                      #! Cycle through each file
  51.   #SET(%FileIsParent,%Null)                      #! Is the file a parent?
  52.   #SET(%FileIsChild,%Null)                       #! Is the file a child?
  53.   #SET(%RIUpdateNeeded,%Null)                    #! Is an RI Update necessary?
  54.   #SET(%CheckPre,('['&%FilePre&']'))             #! Setup to find %File Prefix
  55.   #IF((INSTRING(%CheckPre,%UpdateParentList,1,1)))#!Search for file as parent
  56.     #SET(%FileIsParent,'TRUE')                   #! If it is, set that flag
  57.     #SET(%RIUpdateNeeded,'TRUE')                 #! And RI Routine is needed
  58.   #ENDIF                                         #! END (IF a Parent)
  59.   #IF((INSTRING(%CheckPre,%UpdateChildList,1,1)))#! Search for file as child
  60.     #SET(%FileIsChild,'TRUE')                    #! If it is, set that flag
  61.     #SET(%RIUpdateNeeded,'TRUE')                 #! And RI Routine is needed
  62.   #ENDIF                                         #! END (IF a Child)
  63.   #IF(%RIUpdateNeeded)                           #! If either parent or child
  64.     #IF(%FIleIsChild)                            #! If a child relation in proc
  65.       #FOR(%Relation)                            #! For every relation
  66.         #SET(%RelationString,('['&%RelationPre&'∙'&%FilePre&']'))
  67.                                                  #! Setup to find relationship
  68.                                                  #! between file and parents
  69.         #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  70.                                                  #! If the relation was
  71.                                                  #! flagged for RI Code Generation
  72. #INSERT(%WriteUpdates)                           #! Write the update code
  73.         #ENDIF                                   #! END (IF the relation...)
  74.       #ENDFOR                                    #! END (FOR every relation...)
  75.     #ELSE                                        #! ELSE (If not child)
  76.                                                  #! (Should only apply to
  77.                                                  #! %Primary)
  78. #INSERT(%WriteUpdates)                           #! Write the update code
  79.     #ENDIF                                       #! END (IF a Child)
  80.   #ENDIF                                         #! END (IF RI Update needed)
  81. #ENDFOR                                          #! END (FOR File)
  82. #IF(%UpdateChildList)                            #!IF RI Update Children
  83. !─────────────────────────────────────────────────────────────────────────────
  84. ConstrainedUpdate ROUTINE                        !Perform RI Updates
  85.   CLEAR(RI:RestrictUpdate,0)                     ! Clear Restrict Flag
  86.   CLEAR(AbortTransaction,0)                      ! Clear ABORT flag
  87.   #SET(%LogoutList,(','&%Primary))               #!Initialize Logout List
  88.   #FOR(%File)                                    #!For Each File
  89.     #SET(%ChildString,('['&%FilePre&']'))        #!Setup to find as child
  90.     #IF((INSTRING(%ChildString,%UpdateChildList,1,1)))#!If %File is Child
  91.       #INSERT(%DriverCheck)                      #! Check for Driver Type
  92.       #IF(%CloseFiles)                           #!If Closing opened files
  93.   %FilePre::Opened = CheckOpen(%File)            #<! Open %FIle (If Necessary)
  94.       #ELSE                                      #!ELSE (If not closing files)
  95.   CheckOpen(%File)                               #<! Open %FIle (If Necessary)
  96.       #ENDIF                                     #!END (If Closing open files)
  97.       #SET(%LogoutList,(%LogoutList&','&%File))  #!Append %File to Logout List
  98.     #ENDIF                                       #!END (If file is child)
  99.   #ENDFOR                                        #!END (For Each File)
  100.   #INSERT(%InitLogout)                           #!Insert Logout Code
  101.   DO Update:%Primary                             #<! Perform the Updates
  102.   IF RI:RestrictUpdate                           #<! If update was restricted
  103.     #INSERT(%RIRestrictMsg)                      #! Alert the User
  104.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  105.     ROLLBACK                                     #<! Rollback transaction
  106.   #ENDIF                                         #!END (If supporting logout)
  107.     AbortTransaction = True                      #<! Set the ABORT flag
  108.     EXIT                                         #<! and exit the routine
  109.   END                                            #<! END (If restricted update)
  110.   PUT(%Primary)                                  #<! Put %Primary
  111.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  112.   IF ~ERRORCODE()                                #<! If the Parent update Ok
  113.     COMMIT                                       #<! Commit the transaction
  114.   ELSE                                           #<! else on any error
  115.     AbortTransaction = True                      #<! Set the ABORT flag
  116.     ROLLBACK                                     #<! Rollback the transaction
  117.     #INSERT(%AbortTransactionMsg)                #! Alert the user
  118.   END                                            #<! End If ErrorCode()
  119.   #ELSE                                          #!NoLogoutSupport
  120.   IF ERRORCODE()                                 #<! Was the update ok?
  121.     AbortTransaction = True                      #<! Set the ABORT flag
  122.     #INSERT(%RIUpdateError)                      #! Alert the User
  123.   END                                            ! END (If ErrorCode)
  124.   #ENDIF                                         #!END (If supporting logout)
  125.   EXIT                                           #<! Exit the ROUTINE
  126. #ENDIF                                           #!END (If update Child)
  127. #!***************************************************************************
  128. #GROUP(%WriteUpdates)                            #!Perform Referential Updates
  129.  
  130. #IF(%FileIsChild)                                #!If part of child relationship
  131. !─────────────────────────────────────────────────────────────────────────────
  132. Update:%RelationPre::%FilePre ROUTINE            #<!%Relation - %File
  133.                                                  ! Constraint: %RelationConstraintUpdate
  134. #ELSE                                            #!Otherwise (Parent Only)
  135. !─────────────────────────────────────────────────────────────────────────────
  136. Update:%File ROUTINE                             #<!RI Update of %File
  137. #ENDIF                                           #!END (If Child)
  138. #SET(%SaveFile,%File)                            #!Save the value of %File
  139. #SET(%SaveRelation,%Relation)                    #!And the value of %Relation
  140. #IF(%FileIsChild)                                #!Is the file a child
  141.                                                  #!(This code applies to all
  142.                                                  #! files but %Primary)
  143.   #FIX(%File,%SaveRelation)                      #!And swap the relationship
  144.   #FIX(%Relation,%SaveFile)                      #!for correct symbol access
  145.   #SET(%KeyFieldCounter,'0')                     #!Clear Field Counter
  146.   #FOR(%RelationKeyField)                        #!For each field in key
  147.     #IF(%RelationKeyFieldLink)                   #!If the field is linked
  148.       #SET(%KeyFieldCounter,(%KeyFieldCounter+1))#!Increment Field Counter
  149.     #ENDIF                                       #!END (If field is linked)
  150.   #ENDFOR                                        #!END (For relation field)
  151.   #SET(%IfWritten,%Null)                         #!Prepare For If Structure
  152.   #FOR(%RelationKeyField)                        #!For each field in key
  153.     #IF(%KeyFieldCounter='1')                    #!If this is last link field
  154.       #IF(%IfWritten)                            #!If the IF statement written
  155.   AND %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink #<! Check against save value
  156.       #ELSE                                      #!If IF not written yet
  157.   IF %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink #<! Check against save value
  158.       #ENDIF                                     #!END (If IF Written)
  159.       #BREAK                                     #!Break out of loop
  160.     #ELSE                                        #!otherwise (Counter > 1)
  161.       #IF(%IfWritten)                            #!If the IF statement written
  162.   AND %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  163.       #ELSE                                      #!If IF not written yet
  164.   IF %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  165.       #ENDIF                                     #!END (If IF Written)
  166.     #ENDIF                                       #!END (If Field Counter = 1)
  167.     #SET(%KeyFieldCounter,(%KeyFieldCounter-1))  #!Decrement Counter
  168.     #SET(%IfWritten,'TRUE')                      #!The IF statement written
  169.   #ENDFOR                                        #!END (For Relation Field)
  170.     EXIT                                         #<! If Save Value Match, Exit
  171.   END                                            #<! END (If Save Values Match)
  172.   #FIX(%File,%SaveRelation)                      #!And swap the relationship
  173.   #FIX(%Relation,%SaveFile)                      #!for correct symbol access
  174.   GET(%Relation,0)                               #<! Disconnect record buffer
  175.   CLEAR(%RelationPre:Record,-1)                  #<! Clear record
  176.   #SET(%KeyFieldCounter,'0')                     #!Clear Field Counter
  177.                                                  #!Field Counter is used to
  178.                                                  #!construct a readable IF
  179.                                                  #!structure inside loop.
  180.                                                  #!Inside the loop, we search
  181.                                                  #!each field of key, but use
  182.                                                  #!Field Counter instead of
  183.                                                  #!%RelationalKeyFieldLink
  184.   #FOR(%RelationKeyField)                        #!For each field in key
  185.     #IF(%RelationKeyFieldLink)                   #!If the field is linked
  186.       #SET(%KeyFieldCounter,(%KeyFieldCounter+1))#!Increment Field Counter
  187.   %RelationKeyField = %RelationPre::%RelationKeyFieldLink #<! Set to original value
  188.     #ENDIF                                       #!END (If field is linked)
  189.   #ENDFOR                                        #!END (For relation field)
  190.   SET(%RelationKey,%RelationKey)                 #<! Set for sequential access
  191.   LOOP                                           ! Search through records
  192.     NEXT(%Relation)                              #<! Get the next record
  193.     IF ERRORCODE() THEN BREAK.                   ! If out of records, break.
  194.   #SET(%IfWritten,%Null)                         #!Prepare For If Structure
  195.   #FOR(%RelationKeyField)                        #!For each field in key
  196.     #IF(%KeyFieldCounter='1')                    #!If this is last link field
  197.       #IF(%IfWritten)                            #!If the IF statement written
  198.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  199.       #ELSE                                      #!If IF not written yet
  200.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  201.       #ENDIF                                     #!END (If IF Written)
  202.       #BREAK                                     #!Break out of loop
  203.     #ELSE                                        #!otherwise (Counter > 1)
  204.       #IF(%IfWritten)                            #!If the IF statement written
  205.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  206.       #ELSE                                      #!If IF not written yet
  207.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  208.       #ENDIF                                     #!END (If IF Written)
  209.     #ENDIF                                       #!END (If Field Counter = 1)
  210.     #SET(%KeyFieldCounter,(%KeyFieldCounter-1))  #!Decrement Counter
  211.     #SET(%IfWritten,'TRUE')                      #!The IF statement written
  212.   #ENDFOR                                        #!END (For Relation Field)
  213.       BREAK                                      ! Break out of update loop
  214.     END                                          ! END (If out of range)
  215.   #IF(%RelationConstraintUpdate = 'RESTRICT')    #!If RESTRICTed update
  216.     ri:RestrictUpdate = True                     #<! Set Restricted Update flag
  217.     #FOR(%RelationKeyField)                      #!For each field in key
  218.       #IF(%RelationKeyFieldLink)                 #!If the field is linked
  219.     %RelationKeyFieldLink = %RelationPre::%RelationKeyFieldLink #<! Set to original condition
  220.       #ENDIF                                     #!END (If field is linked)
  221.     #ENDFOR                                      #!END (For relation field)
  222.     DISPLAY()                                    ! Redisplay reset values
  223.     BREAK                                        ! BREAK from processing loop
  224.   #ELSE                                          #!ELSE (If not RESTRICT)
  225.     #IF(%FileIsParent)                           #!If the file is a parent
  226.       #FIX(%File,%SaveFile)                      #!Reset the file to original
  227.       #FOR(%Relation)                            #!For each relationship
  228.         #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  229.                                                   #!Setup to find relationship
  230.         #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  231.                                                  #!Search for Relationship
  232.                                                  #!In Update Relation List
  233.           #FOR(%RelationKeyField)                #!For Each Field of Key
  234.             #IF(%RelationKeyFieldLink)           #!If the field is linked
  235.     %RelationPre::%RelationKeyFieldLink = %RelationKeyFieldLink #<! Save Link Field Value
  236.             #ENDIF                               #!END (IF Field is linked)
  237.           #ENDFOR                                #!END (FOR Each Key Field)
  238.         #ENDIF                                   #!END (IF valid relation)
  239.       #ENDFOR                                    #!END (FOR each relation)
  240.     #ENDIF                                       #!END (IF the file is parent)
  241.     #FIX(%File,%SaveRelation)                    #!FIX to process REL as FILE
  242.     #FIX(%Relation,%SaveFile)                    #!FIX to process FILE as REL
  243.     #IF(%RelationConstraintUpdate = 'CASCADE')   #!IF CASCADE constraint
  244.       #FOR(%RelationKeyField)                    #!For each field in key
  245.         #IF(%RelationKeyFieldLink)               #!If the field is linked
  246.     %RelationKeyField = %RelationKeyFieldLink    #<! Set to new value
  247.         #ENDIF                                   #!END (If field is linked)
  248.       #ENDFOR                                    #!END (For relation field)
  249.     #ELSE                                        #!ELSE (IF not CASCADE)
  250.       #FOR(%RelationKeyField)                    #!For each field in key
  251.         #IF(%RelationKeyFieldLink)               #!If the field is linked
  252.     CLEAR(%RelationKeyField,0)                   #<! Clear link field value
  253.         #ENDIF                                   #!END (If field is linked)
  254.       #ENDFOR                                    #!END (For relation field)
  255.     #ENDIF                                       #!ELSE (IF not CASCADE)
  256.     #FIX(%File,%SaveFile)                        #!Reset the file to original
  257.     #IF(%FileIsParent)                           #!If the file is a parent
  258.       #FOR(%Relation)                            #!For each relationship
  259.         #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  260.                                                   #!Setup to find relationship
  261.         #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  262.                                                  #!Search for Relationship
  263.                                                  #!In Update Relation List
  264.     DO Update:%FilePre::%RelationPre             #<! Call Update Routine
  265.     IF ri:RestrictUpdate THEN EXIT.              ! If Restrict then exit
  266.         #ENDIF                                   #!END (IF valid relation)
  267.       #ENDFOR                                    #!END (FOR each relation)
  268.     #ENDIF                                       #!END (IF File is Parent)
  269.     PUT(%File)                                   #<! PUT updated record
  270.   #ENDIF                                         #!END (If RESTRICT Constraint)
  271.   END                                            ! END loop
  272.   EXIT                                           ! Exit to calling routine
  273. #ELSE                                            #!ELSE (If NOT a child)
  274.                                                  #!This applies only to
  275.                                                  #!%Primary
  276.   #FOR(%Relation)                                #!For each Relation
  277.     #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  278.                                                  #!Setup to find relationship
  279.     #IF((INSTRING(%RelationString,%UpdateRelations,1,1)))
  280.                                                  #!Search for Relationship
  281.                                                  #!In Update Relation List
  282.   DO Update:%FilePre::%RelationPre               #<! Call Update Routine
  283.   IF ri:RestrictUpdate THEN EXIT.                ! If Restrict then exit
  284.     #ENDIF                                       #!END (IF valid relation)
  285.   #ENDFOR                                        #!END (FOR each relation)
  286.   EXIT                                           #<! Exit to calling routine
  287. #ENDIF                                           #!ELSE (File is child)
  288. #!***************************************************************************
  289. #!
  290. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  291. #!│                                RIDeletes               │Version: 3007.101│
  292. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  293. #!│Purpose:      Constructs RI Delete code                                   │
  294. #!│Called From:  FORM.TPX and MULTIPG.TPX (Near the end)                     │
  295. #!│Assumptions:  None                                                        │
  296. #!│Inserts:      WriteDeletes (perform RI deletes)                           │
  297. #!│              InitLogout (performs transaction logging)                   │
  298. #!│              RIRestrictMsg (warns user if constrained as restricted)     │
  299. #!│              AbortTransactionMsg (warns user if transaction aborted)     │
  300. #!│              RIDeleteError (warns user on RI delete error)               │
  301. #!│Symbols Set:  None                                                        │
  302. #!│Notes:        None                                                        │
  303. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  304. #!│Version   Comments                                                        │
  305. #!│────────  ────────────────────────────────────────────────────────────────│
  306. #!│3007.000  Release of CDD3 version 3007 templates                          │
  307. #!│3007.101  Repaired code generating the %LogoutList symbol.  Primary needed│
  308. #!│          to be added to the list.                                        │
  309. #!└──────────────────────────────────────────────────────────────────────────┘
  310. #!
  311. #GROUP(%RIDeletes)                               #!Perform Referential Deletes
  312. #FOR(%File)                                      #!Cycle through each file
  313.   #SET(%FileIsParent,%Null)                      #!Is the file a parent?
  314.   #SET(%FileIsChild,%Null)                       #!Is the file a child?
  315.   #SET(%RIDeleteNeeded,%Null)                    #!Is an RI Delete necessary?
  316.   #SET(%CheckPre,('['&%FilePre&']'))             #!Setup to find %File Prefix
  317.   #IF((INSTRING(%CheckPre,%DeleteParentList,1,1))) #!Search for file as parent
  318.     #SET(%FileIsParent,'TRUE')                   #!If it is, set that flag
  319.     #SET(%RIDeleteNeeded,'TRUE')                 #!And RI Routine is needed
  320.   #ENDIF                                         #!END (IF a Parent)
  321.   #IF((INSTRING(%CheckPre,%DeleteChildList,1,1))) #!Search for file as child
  322.     #SET(%FileIsChild,'TRUE')                    #!If it is, set that flag
  323.     #SET(%RIDeleteNeeded,'TRUE')                 #!And RI Routine is needed
  324.   #ENDIF                                         #!END (IF a Child)
  325.   #IF(%RIDeleteNeeded)                           #!If we need to delete children
  326.     #IF(%FIleIsChild)                            #!If the file is a child
  327.       #FOR(%Relation)                            #!For Every Relation
  328.         #SET(%RelationString,('['&%RelationPre&'∙'&%FilePre&']'))
  329.                                                  #!Setup to find child relation
  330.         #IF((INSTRING(%RelationString,%DeleteRelations,1,1)))
  331.                                                  #!If the file is child
  332. #INSERT(%WriteDeletes)                           #!Write the delete code
  333.         #ENDIF                                   #!END (If file is child)
  334.       #ENDFOR                                    #!END (For Relation)
  335.     #ELSE                                        #!ELSE (File is parent only)
  336. #INSERT(%WriteDeletes)                           #!Write the Delete Code
  337.     #ENDIF                                       #!END (If File is Child)
  338.   #ENDIF                                         #!END (IF Delete Needed)
  339. #ENDFOR                                          #!END (For File)
  340. #IF(%DeleteChildList)                            #!IF RI Delete Children
  341.  
  342. !─────────────────────────────────────────────────────────────────────────────
  343. ConstrainedDelete ROUTINE                        !Perform RI Deletes
  344.   CLEAR(RI:RestrictDelete,0)                     ! Clear Restrict Flag
  345.   CLEAR(AbortTransaction,0)                      ! Clear ABORT flag
  346.   #SET(%LogoutList,(','&%Primary))               #!Initialize Logout List
  347.   #FOR(%File)                                    #!For Each File
  348.     #SET(%ChildString,('['&%FilePre&']'))        #!Setup to find as child
  349.     #IF((INSTRING(%ChildString,%DeleteChildList,1,1)))#!If %File is Child
  350.       #INSERT(%DriverCheck)                      #!Check File Drivers
  351.       #IF(%CloseFiles)                           #!If Closing opened files
  352.   %FilePre::Opened = CheckOpen(%File)            #<! Open %FIle (If Necessary)
  353.       #ELSE                                      #!ELSE (If not closing files)
  354.   CheckOpen(%File)                               #<! Open %FIle (If Necessary)
  355.       #ENDIF                                     #!END (If Closing open files)
  356.       #SET(%LogoutList,(%LogoutList&','&%File))  #!Append %File to Logout List
  357.     #ENDIF                                       #!END (If file is child)
  358.   #ENDFOR                                        #!END (For Each File)
  359.   #INSERT(%InitLogout)                           #!Insert Logout Code
  360.   DO Delete:%Primary                             #<! Perform the Deletes
  361.   IF RI:RestrictDelete                           #<! If delete was restricted
  362.     #INSERT(%RIRestrictMsg)                      #!Alert the user
  363.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  364.     ROLLBACK                                     #<! Rollback transaction
  365.   #ENDIF                                         #!END (If supporting logout)
  366.     AbortTransaction = True                      #<! Set the ABORT flag
  367.     EXIT                                         #<! and exit the routine
  368.   END                                            #<! END (If restricted delete)
  369.   DELETE(%Primary)                               #<! Put %Primary
  370.   #IF(%NoLogoutSupport=%Null)                    #!If supporting logout
  371.   IF ~ERRORCODE()                                #<! If the Parent delete Ok
  372.     COMMIT                                       ! Commit the transaction
  373.   ELSE                                           ! else on any error
  374.     AbortTransaction = True                      ! Set the ABORT flag
  375.     ROLLBACK                                     ! Rollback the transaction
  376.     #INSERT(%AbortTransactionMsg)                #! Write Messages
  377.   END                                            ! End If ErrorCode()
  378.   #ELSE                                          #!NoLogoutSupport
  379.   IF ERRORCODE()                                 #<! Was the delete ok?
  380.     AbortTransaction = True                      ! Set the ABORT flag
  381.     #INSERT(%RIDeleteError)                      #! Alert the  user
  382.   END                                            ! END (If ErrorCode)
  383.   #ENDIF                                         #!END (If supporting logout)
  384.   EXIT                                           #<! EXIT ConstrainedDelete
  385. #ENDIF                                           #!END (If delete Child)
  386. #!***************************************************************************
  387. #GROUP(%WriteDeletes)                            #! Write Delete Routines
  388.  
  389. #IF(%FileIsChild)                                #!If the File is Child
  390. !─────────────────────────────────────────────────────────────────────────────
  391. Delete:%RelationPre::%FilePre ROUTINE            #<!%Relation - %File
  392.                                                  !Constraint: %RelationConstraintDelete
  393. #ELSE                                            #!Otherwise (Parent Only)
  394. !─────────────────────────────────────────────────────────────────────────────
  395. Delete:%File ROUTINE                             #<!Delete Parent Record
  396. #ENDIF                                           #!END (If Child)
  397. #SET(%SaveFile,%File)                            #!Save File for later use
  398. #SET(%SaveRelation,%Relation)                    #!Save Relation for later use
  399. #IF(%FileIsChild)                                #!Is the file a child
  400.   #FIX(%File,%SaveRelation)                      #!And swap the relationship
  401.   #FIX(%Relation,%SaveFile)                      #!for correct symbol access
  402.   GET(%Relation,0)                               #<! Disconnect record buffer
  403.   CLEAR(%RelationPre:Record,-1)                  #<! Clear %Relation record
  404.   #SET(%KeyFieldCounter,'0')                     #!Clear Field Counter
  405.                                                  #!Field Counter is used to
  406.                                                  #!construct a readable IF
  407.                                                  #!structure inside loop.
  408.                                                  #!Inside the loop, we search
  409.                                                  #!each field of key, but use
  410.                                                  #!Field Counter instead of
  411.                                                  #!%RelationalKeyFieldLink
  412.   #FOR(%RelationKeyField)                        #!For each field in key
  413.     #IF(%RelationKeyFieldLink)                   #!If the field is linked
  414.       #SET(%KeyFieldCounter,(%KeyFieldCounter+1)) #!Increment Field Counter
  415.   %RelationKeyField = %RelationPre::%RelationKeyFieldLink #<! Set to original value
  416.     #ENDIF                                       #!END (If field is linked)
  417.   #ENDFOR                                        #!END (For relation field)
  418.   SET(%RelationKey,%RelationKey)                 #<! Set for sequential access
  419.   LOOP                                           ! Search through records
  420.     NEXT(%Relation)                              #<! Get the next record
  421.     IF ERRORCODE() THEN BREAK.                   ! If out of records, break.
  422.   #SET(%IfWritten,%Null)                         #!Prepare For If Structure
  423.   #FOR(%RelationKeyField)                        #!For each field in key
  424.     #IF(%KeyFieldCounter='1')                    #!If this is last link field
  425.       #IF(%IfWritten)                            #!If the IF statement written
  426.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  427.       #ELSE                                      #!If IF not written yet
  428.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink #<! Check against save value
  429.       #ENDIF                                     #!END (If IF Written)
  430.       #BREAK                                     #!Break out of loop
  431.     #ELSE                                        #!otherwise (Counter > 1)
  432.       #IF(%IfWritten)                            #!If the IF statement written
  433.     OR %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  434.       #ELSE                                      #!If IF not written yet
  435.     IF %RelationKeyField <> %RelationPre::%RelationKeyFieldLink|#<! Check against save value
  436.       #ENDIF                                     #!END If IF statement written
  437.     #ENDIF                                       #!END (If Field Counter = 1)
  438.     #SET(%KeyFieldCounter,(%KeyFieldCounter-1))  #!Decrement Counter
  439.     #SET(%IfWritten,'TRUE')                      #!SET IF Statement written flag
  440.   #ENDFOR                                        #!END (For Relation Field)
  441.       BREAK                                      ! Break out of delete loop
  442.     END                                          ! END (If out of range)
  443.   #IF(%RelationConstraintDelete = 'RESTRICT')#!If RESTRICTed delete
  444.     ri:RestrictDelete = True                     #<! Set Restricted Delete flag
  445.     BREAK                                        ! BREAK from processing loop
  446.   #ELSE                                          #!ELSE (If not RESTRICT)
  447.     #FIX(%File,%SaveFile)                        #!Reset the file to original
  448.     #IF(%FileIsParent)                           #!File is both Parent and Child
  449.       #FOR(%Relation)                            #!Get Each Relation
  450.         #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  451.                                                  #!Setup to find relationship
  452.         #IF((INSTRING(%RelationString,%DeleteRelations,1,1)))
  453.                                                  #!Search for Relationship
  454.                                                  #!In Delete Relation List
  455.           #FOR(%RelationKeyField)                #!For Each Field of Key
  456.             #IF(%RelationKeyFieldLink)           #!If the field is linked
  457.     %RelationPre::%RelationKeyFieldLink = %RelationKeyFieldLink #<! Save Link Field Value
  458.             #ENDIF                               #!END (IF Field is linked)
  459.           #ENDFOR                                #!END (FOR Each Key Field)
  460.     DO Delete:%FilePre::%RelationPre             #<! Call Delete Routine
  461.     IF ri:RestrictDelete THEN EXIT.              ! If Restrict then exit
  462.         #ENDIF                                   #!END (IF valid relationship)
  463.       #ENDFOR                                    #!END (FOR Relation)
  464.     #ENDIF                                       #!END (File is Parent)
  465.     #IF(%RelationConstraintDelete = 'CASCADE')#!IF CASCADE constraint
  466.     DELETE(%File)                                #<! DELETE record
  467.     #ELSIF(%RelationConstraintDelete = 'CLEAR')  #! If we clear link fields
  468.       #FOR(%RelationKeyField)                    #!For each field in key
  469.         #IF(%RelationKeyFieldLink)               #!If the field is linked
  470.     CLEAR(%RelationKeyField,0)                   #<! Clear link field value
  471.         #ENDIF                                   #!END (If field is linked)
  472.       #ENDFOR                                    #!END (For relation field)
  473.     PUT(%File)                                   #<! And put cleared record
  474.     #ENDIF                                       #!END (If file is parent)
  475.   #ENDIF                                         #!END (If RESTRICT Constraint)
  476.   END                                            ! END loop
  477.   EXIT                                           ! Exit to calling routine
  478. #ELSE                                            #!ELSE (If NOT a child)
  479.                                                  #!This applies only to
  480.                                                  #!%Primary
  481.   #FOR(%Relation)                                #!For each Relation
  482.     #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  483.                                                  #!Setup to find relationship
  484.     #IF((INSTRING(%RelationString,%DeleteRelations,1,1)))
  485.                                                  #!Search for Relationship
  486.                                                  #!In Delete Relation List
  487.   DO Delete:%FilePre::%RelationPre               #<! Call Delete Routine
  488.   IF ri:RestrictDelete THEN EXIT.                ! If Restrict then exit
  489.     #ENDIF                                       #!END (IF valid relation)
  490.   #ENDFOR                                        #!END (FOR each relation)
  491.   EXIT                                           #<! Exit to calling routine
  492. #ENDIF                                           #!ELSE (File is child)
  493. #!****************************************************************************
  494. #GROUP(%InitLogout)                              #!Initialize and check logout
  495. #IF(%NoLogoutSupport=%Null)                      #!If logout supported
  496.   #SET(%LogoutList,('logout(2'&%LogoutList&')')) #!Prepare the logout code line
  497. %LogoutList                                      #<! Begin the transaction
  498. IF ERRORCODE()                                   #<! If logout unsuccessful
  499.   AbortTransaction = True                        #<! Set the Abort Flag
  500.   ROLLBACK                                       #<! Rollback the transaction
  501.   CASE ERRORCODE()                               #<! Check the errorcode
  502.   OF IsLockedErr                                 #<! IF File Locked
  503.     #INSERT(%TransactionLockMsg)                 #! Alert the user
  504.   ELSE                                           #<! Other Error
  505.     #INSERT(%TransactionErrorMsg)                #! Alert the user
  506.   END                                            #<! END (If File Locked)
  507.   DISABLE(1,FIELDS())                            #<! Disable the screen fields
  508.   #IF(%FirstField)                               #!If First Field Designated
  509.   ENABLE(%FirstField)                            #<! Enable First Field
  510.   SELECT(%FirstField)                            #<! Select First Entry Field
  511.   #ELSE                                          #!Otherwise (~%FirstField)
  512.     #FIX(%ScreenField,'?Cancel')                 #!Try to get the Cancel button
  513.     #IF(%ScreenField)                            #!If we have a ?Cancel button
  514.   ENABLE(?Cancel)                                #<! Enable the ?Cancel Button
  515.   SELECT(?Cancel)                                #<! Select the ?Cancel Button
  516.     #ELSE                                        #!If no ?Cancel Button
  517.       #FIX(%ScreenField,'?OK')                   #!Try to get the Cancel button
  518.       #IF(%ScreenField)                          #!If we have a ?Cancel button
  519.   ENABLE(?OK)                                    #<! Enable the ?OK Button
  520.   SELECT(?OK)                                    #<! Select the ?OK Button
  521.       #ENDIF                                     #!END (If ?OK Button)
  522.     #ENDIF                                       #!END (If ?Cancel Button)
  523.   #ENDIF                                         #!END (If %FirstField)
  524.   EXIT                                           #<! Exit the Routine
  525. END                                              #<! No errors, start transaction
  526. #INSERT(%BtrieveTrxFraming)                      #!Btrieve transaction system
  527.                                                  #!requires that the acquisition
  528.                                                  #!of the record affected by the
  529.                                                  #!put take place between the
  530.                                                  #!logout and commit
  531. #ENDIF                                           #!END (If logout supported)
  532. #!***************************************************************************
  533. #GROUP(%BtrieveTrxFraming)                       #!Initialize Btrieve Transaction
  534. #IF(%PrimaryDriver='Btrieve')                    #!If %Primary uses Btrieve
  535. SAV:SaveRecord = %FilePre:Record                 #<! Save the record image
  536.   #FOR(%FileMemo)                                #!For each memo
  537.     #FIX(%Field,%FileMemo)                       #!Get the Field ID
  538. SAV:%FieldID = %FileMemo                         #<! Save the memo image
  539.   #ENDFOR                                        #!END (For each memo)
  540. SAV:Position = POSITION(%Primary)                #<! Save the record position
  541. RESET(%Primary,SAV:Position)                     #<! and reset to position
  542. NEXT(%Primary)                                   #<! and reread the record
  543. IF SAV:Position <> POSITION(%Primary)            #<! If on a different record
  544.   AbortTransaction = True                        ! ABORT the Update
  545.   ROLLBACK                                       ! Roll back changes
  546.   #INSERT(%RIRecNotAvailMsg)                     #! Alert the user
  547.   EXIT                                           ! And leave the routine
  548. END                                              ! END (If not good record)
  549. %FilePre:Record = SAV:SaveRecord                 #<! Reset Record Value
  550.   #FOR(%FileMemo)                                #!For each memo
  551.     #FIX(%Field,%FileMemo)                       #!Fix the memo field
  552. %FileMemo = SAV:%FieldID                         #<! Reset the memo value
  553.   #ENDFOR                                        #!END (For each memo)
  554. #ENDIF                                           #!END (If using Btrieve)
  555. #!***************************************************************************
  556. #GROUP(%SavePrimaryLinks)                        #!Save Links to Primary
  557. #FIX(%File,%Primary)                             #!Setup to read primary
  558. #FOR(%Relation)                                  #!Get Each Relation
  559.   #SET(%RelationString,('['&%FilePre&'∙'&%RelationPre&']'))
  560.                                                  #!Setup to find relationship
  561.   #IF((INSTRING(%RelationString,%AllRelations,1,1)))
  562.                                                  #!Search for Relationship
  563.                                                  #!In Update Relation List
  564.     #FOR(%RelationKeyField)                      #!For Each Field of Key
  565.       #IF(%RelationKeyFieldLink)                 #!If the field is linked
  566. %RelationPre::%RelationKeyFieldLink = %RelationKeyFieldLink #<! Save Link Field Value
  567.       #ENDIF                                     #!END (IF Field is linked)
  568.     #ENDFOR                                      #!END (FOR Each Key Field)
  569.   #ENDIF                                         #!END (IF valid relationship)
  570. #ENDFOR                                          #!END (FOR Relation)
  571. #!***************************************************************************
  572. #GROUP(%ConcurrentWrite)
  573. #IF(%SharedFiles)
  574.  
  575. !─────────────────────────────────────────────────────────────────────────────
  576. ConcurrentWrite ROUTINE
  577.   CLEAR(AbortTransaction,0)                      #<!Initialize AbortWrite#
  578.   #IF(%AutoInc)
  579.   IF AutoIncAdd THEN EXIT.                       #<!Not an Autoincrement ADD
  580.   #ENDIF
  581.   GET(RecordQueue,2)                             #<!Add the changed record
  582.   Sav:SaveRecord = %FilePre:Record               #<!Save Record to the Queue
  583.   #IF(%MemoChk)
  584.     #FOR(%FileMemo)
  585.       #FIX(%Field,%FileMemo)
  586.   SAV:%FieldID = %FileMemo                       #<!Save Memo to the Queue
  587.     #ENDFOR
  588.   #ENDIF
  589.   PUT(RecordQueue)
  590.   GET(RecordQueue,1)                             #<!Get the original record
  591.   RESET(%Primary,SavePointer)                    #<!Position to record on disk
  592.   HOLD(%Primary,2)                               #<!Set HOLD retry for 2 seconds
  593.   NEXT(%Primary)                                 #<!Read the record into buffer
  594.   IF ERRORCODE()                                 #<!Was there an error?
  595.     CASE ERRORCODE()                             #<!Process recoverable errors
  596.     OF IsHeldErr                                 #<!Record is already held
  597.       #INSERT(%TransactionHeldMsg)
  598.       SELECT(1)                                  #<!Place cursor on 1st field
  599.       RELEASE(%Primary)                          #<!Release the HOLD
  600.       AbortTransaction = True                    #<!Turn on AbortWrite#
  601.       EXIT                                       #<!Back to main Loop
  602.     ELSE                                         #<!On any other error
  603.       IF DiskError('File Access Error')          #<!Call the Diskerror function
  604.         RELEASE(%Primary)                        #<!Release the hold
  605.         FREE(RecordQueue)                        #<!Free the memory Queue
  606.         DISABLE(1,FIELDS())                      #<!Disable all screen fields
  607.   #IF(%FirstField)                               #!If First Field Designated
  608.         ENABLE(%FirstField)                      #<! Enable First Field
  609.         SELECT(%FirstField)                      #<! Select First Entry Field
  610.   #ELSE                                          #!Otherwise (~%FirstField)
  611.     #FIX(%ScreenField,'?Cancel')                 #!Try to get the Cancel button
  612.     #IF(%ScreenField)                            #!If we have a ?Cancel button
  613.         ENABLE(?Cancel)                          #<! Enable the ?Cancel Button
  614.         SELECT(?Cancel)                          #<! Select the ?Cancel Button
  615.     #ELSE                                        #!If no ?Cancel Button
  616.       #FIX(%ScreenField,'?OK')                   #!Try to get the Cancel button
  617.       #IF(%ScreenField)                          #!If we have a ?Cancel button
  618.         ENABLE(?OK)                              #<! Enable the ?OK Button
  619.         SELECT(?OK)                              #<! Select the ?OK Button
  620.       #ENDIF                                     #!END (If ?OK Button)
  621.     #ENDIF                                       #!END (If ?Cancel Button)
  622.   #ENDIF                                         #!END (If %FirstField)
  623.         AbortTransaction = True                  #<!Turn on AbortWrite#
  624.         EXIT                                     #<!and exit the routine
  625.       END                                        #<!End IF Diskerror
  626.     END                                          #<!End CASE Errorcode()
  627.   ELSIF Sav:SaveRecord <> %FilePre:Record        #<!Has the record been changed
  628.     Sav:SaveRecord = %FilePre:Record             #<!Then update the Queue record
  629.   #IF(%MemoChk = 'Y')
  630.     #FOR(%FileMemo)
  631.       #FIX(%Field,%FileMemo)
  632.     SAV:%FieldID = %Field                        #<!Then update the Queue memo
  633.     #ENDFOR
  634.   #ENDIF
  635.     #INSERT(%ConflictUpdate)
  636.   #IF(%MemoChk = 'Y')
  637.     #FOR(%FileMemo)
  638.       #FIX(%Field,%FileMemo)
  639.   ELSIF SAV:%FieldID <> %Field                   #<!Has the Memo been changed?
  640.     SAV:%FieldID = %Field                        #<!Then update the Queue memo
  641.     #INSERT(%ConflictUpdate)
  642.     #ENDFOR
  643.   #ENDIF
  644.   ELSE                                           #<!Its ok to update the file
  645.     GET(RecordQueue,2)                           #<!Retrieve the users changes
  646.     %FilePre:Record = Sav:SaveRecord             #<!Move changes to record buffer
  647.   #IF(%MemoChk)
  648.     #FOR(%FileMemo)
  649.       #FIX(%Field,%FileMemo)
  650.     %Field = SAV:%FieldID                        #<!Move Memo to buffer
  651.     #ENDFOR
  652.   #ENDIF
  653.   END                                            #<!End IF Errorcode()
  654.   EXIT
  655. #ENDIF
  656. #!***************************************************************************
  657. #GROUP(%ConcurrentDelete)
  658. #IF(%SharedFiles)
  659.  
  660. !─────────────────────────────────────────────────────────────────────────────
  661. ConcurrentDelete ROUTINE
  662.   AbortTransaction = False
  663.   RESET(%Primary,SavePointer)                    #<!Set position in Primary file
  664.   HOLD(%Primary,2)                               #<!Hold the record
  665.   NEXT(%Primary)                                 #<!Read the record into buffer
  666.   IF ERRORCODE()                                 #<!Check for file access error
  667.     CASE ERRORCODE()                             #<!Case for recoverable errors
  668.     OF IsHeldErr                                 #<!Record is already held
  669.       #INSERT(%TransactionHeldMsg)
  670.       SELECT(1)                                  #<!Place cursor on 1st field
  671.       RELEASE(%Primary)                          #<!Release HOLD request
  672.       AbortTransaction = True                    #<!Set AbortDelete# ON
  673.       EXIT                                       #<!Re-start main LOOP
  674.     ELSE                                         #<!for any other error
  675.       IF DiskError('Unable to process current Record') #<!Call error function
  676.         #INSERT(%UnableToContinueMsg)
  677.         DO ProcedureReturn
  678.       END                                        #<!End IF Diskerror
  679.     END                                          #<!End CASE errorcode
  680.   ELSIF POSITION(%Primary) <> SavePointer        #<!Is the record already deleted?
  681.     RELEASE(%Primary)                            #<!Relase record Hold
  682.     DO ProcedureReturn                           #<!Return to the calling procedure
  683.   END                                            #<!End IF errorcode()
  684.   EXIT
  685. #ENDIF
  686. #!***************************************************************************
  687. #GROUP(%DriverCheck)
  688. #!
  689. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  690. #!│                               DriverCheck              │Version: 3007.101│
  691. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  692. #!│Purpose:      Checks that all files use the same driver                   │
  693. #!│Called From:  FORM and MULTIPG                                            │
  694. #!│Assumptions:  None                                                        │
  695. #!│Inserts:      None                                                        │
  696. #!│Symbols Set:  None                                                        │
  697. #!│Notes:        None                                                        │
  698. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  699. #!│Version   Comments                                                        │
  700. #!│────────  ────────────────────────────────────────────────────────────────│
  701. #!│3007.000  Release of CDD3 version 3007 templates                          │
  702. #!│3007.101  Changed comparison of %NoLogoutSupport to any non-null value.   │
  703. #!└──────────────────────────────────────────────────────────────────────────┘
  704. #!
  705. #IF(NOT %NoLogoutSupport)
  706.   #IF(%FileType <> %PrimaryDriver)
  707.     #SET(%ErrorMessage,%NULL)
  708.     #ERROR(%ErrorMessage)
  709.     #SET(%ErrorMessage,(' WARNING during Source Code Generation in Procedure: '& %Procedure ))
  710.     #ERROR(%ErrorMessage)
  711.     #SET(%ErrorMessage, ' the FILE Relationship uses multiple file drivers')
  712.     #ERROR(%ErrorMessage)
  713.     #SET(%ErrorMessage,(' see FORM Template Help, TOPIC: No Transaction Framing'))
  714.     #ERROR(%ErrorMessage)
  715.     #SET(%ErrorMessage, %NULL)
  716.     #ERROR(%ErrorMessage)
  717.     #SET(%NoLogoutSupport,'Y')
  718.   #ENDIF
  719. #ENDIF
  720. #!***************************************************************************
  721. #GROUP(%PrimaryDriverCheck)
  722. #!
  723. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  724. #!│                           PrimaryDriverCheck           │Version: 3007.101│
  725. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  726. #!│Purpose:      Checks if the Driver for %Primary supports LOGOUT           │
  727. #!│Called From:  FORM and MULTIPG                                            │
  728. #!│Assumptions:  None                                                        │
  729. #!│Inserts:      None                                                        │
  730. #!│Symbols Set:  None                                                        │
  731. #!│Notes:        None                                                        │
  732. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  733. #!│Version   Comments                                                        │
  734. #!│────────  ────────────────────────────────────────────────────────────────│
  735. #!│3007.000  Release of CDD3 version 3007 templates                          │
  736. #!│3007.101  Added check of %NoLogoutSupport coming in to group              │
  737. #!└──────────────────────────────────────────────────────────────────────────┘
  738. #!
  739. #IF(NOT %NoLogoutSupport)
  740.   #IF((UPPER(%PrimaryDriver) <> 'BTRIEVE') AND (UPPER(%PrimaryDriver) <> 'CLARION'))
  741.     #SET(%ErrorMessage,%NULL)
  742.     #ERROR(%ErrorMessage)
  743.     #SET(%ErrorMessage,(' WARNING during Code Generation in Procedure: '& %Procedure ))
  744.     #ERROR(%ErrorMessage)
  745.     #SET(%ErrorMessage,( ' PRIMARY file driver (' & %PrimaryDriver & ') does not support LOGOUT() '))
  746.     #ERROR(%ErrorMessage)
  747.     #SET(%ErrorMessage,(' see FORM Template Help, Topic: No Transaction Framing'))
  748.     #ERROR(%ErrorMessage)
  749.     #SET(%NoLogoutSupport,'Y')
  750.   #ENDIF
  751. #ENDIF
  752. #CHAIN('ScrnFlds.TPX')
  753.