home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR36 / C7101.ZIP / CHLDGRPS.TPX < prev    next >
Text File  |  1994-01-12  |  9KB  |  205 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                              ChldGrps.TPX              │Version: 3007.000│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│SetChildSymbols       GROUP      Setup Code Generation Flags              │
  7. #!│GetChildSecondary     GROUP      Perform Many:1 Lookups                   │
  8. #!│ChildInitFields       GROUP      Initialize Fields for INSERTed record    │
  9. #!│NullParentCheck       GROUP      Check if Parent is Empty                 │
  10. #!│HoldParentRecord      GROUP      Hold parent Rec during execution of CHILD│
  11. #!│UpdateChildRecords    GROUP      Perform update to CHILD records          │
  12. #!│PutParentFile         GROUP      Put parent after execution of CHILD      │
  13. #!│FillQueueFields       GROUP      Fill up the List Box                     │
  14. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  15. #!│Version   Comments                                                        │
  16. #!│────────  ────────────────────────────────────────────────────────────────│
  17. #!│3007.000  Release of CDD3 version 3007 templates                          │
  18. #!└──────────────────────────────────────────────────────────────────────────┘
  19. #!
  20. #GROUP(%SetChildSymbols)
  21. #IF(%ParentFile = %Null)
  22.   #SET(%ErrorMessage, (%Procedure & ' ERROR: Parent File is required.'))
  23.   #ERROR(%ErrorMessage)
  24. #ENDIF
  25. #SET(%MemoExists,%Null)
  26. #FIX(%File,%Primary)
  27. #FIX(%Relation,%ParentFile)
  28. #IF(%RelationType = 'MANY:1')
  29.   #FOR(%RelationKeyField)
  30.     #SET(%ParentRelationField, %RelationKeyField)
  31.     #SET(%ChildRelationField, %RelationKeyFieldLink)
  32.     #BREAK
  33.   #ENDFOR
  34. #ENDIF
  35. #SET(%ScreenFldSetupExists,%Null)
  36. #FIX(%File,%Primary)
  37. #FOR(%Field)
  38.   #IF(%FieldType = 'MEMO')
  39.     #SET(%MemoExists,'Yes')
  40.     #BREAK
  41.   #ENDIF
  42. #ENDFOR
  43. #SET(%FixRows, '0')
  44. #SET(%ListField,'?List')
  45. #FIX(%ScreenField,%ListField)
  46. #FOR(%ScreenFieldFix)
  47.   #SET(%FixRows, (%FixRows + 1))
  48. #ENDFOR
  49. #FOR(%ScreenField)
  50.   #IF(%ScreenFieldSetup)
  51.     #SET(%ScreenFldSetupExists,'YES')
  52.     #BREAK
  53.   #ENDIF
  54. #ENDFOR
  55. #SET(%FirstEntryField,%Null)
  56. #FOR(%ScreenField)
  57.   #IF(%ScreenFieldSkip = %Null)
  58.     #SET(%FirstEntryField,%ScreenField)
  59.     #BREAK
  60.   #ENDIF
  61. #ENDFOR
  62. #FOR(%Field)
  63.   #IF(%FieldInitial <> %NULL)
  64.     #SET(%InitRoutine,'TRUE')
  65.     #BREAK
  66.   #ENDIF
  67. #ENDFOR
  68. #!***************************************************************************
  69. #GROUP(%GetChildSecondary)
  70.   #FOR(%Secondary)                             #! for fields in the list box
  71.     #IF(%Secondary <> %ParentFile)
  72.       #IF(%SecondaryType = 'MANY:1')           #!Check for lookup files
  73.         #FIX(%File,%SecondaryTo)
  74.         #FIX(%Relation,%Secondary)
  75.         #FOR(%RelationKeyField)
  76. IF %RelationKeyField <> %RelationKeyFieldLink  #<!If Link fields don't match
  77.   %RelationKeyField = %RelationKeyFieldLink    #<! Assign linking field value
  78. END                                            #<!End IF
  79.         #ENDFOR
  80. GET(%Secondary,%RelationKey)                  #<! Lookup record
  81.         #FIX(%File,%Secondary)
  82. IF ERRORCODE()                                #<! Clear record if unsuccessful
  83.   #INSERT(%ClearFileFields)
  84. END
  85.       #ENDIF
  86.     #ENDIF
  87.   #ENDFOR
  88. #!***************************************************************************
  89. #GROUP(%ChildInitFields)
  90. #IF(%InitRoutine = 'TRUE')
  91. InitializeFields ROUTINE
  92. #FOR(%Field)
  93. #IF(%FieldInitial <> %NULL)
  94.   %Field = %FieldInitial
  95. #ENDIF
  96. #ENDFOR
  97. #ENDIF
  98. #!***************************************************************************
  99. #GROUP(%NullParentCheck)
  100.   #IF(%NullParentExit)
  101.     #FIX(%File,%ParentFile)
  102. IF %FilePre:RECORD = ''                        #<!If Parent record is blank
  103.   RETURN                                       #<! Return to the caller
  104. END                                            #<!End IF
  105.     #FIX(%File,%Primary)
  106.   #ENDIF
  107. #!***************************************************************************
  108. #GROUP(%HoldParentRecord)
  109.   #IF(%SharedFiles)
  110. HOLD(%ParentFile,5)                            #<! When sharing the files
  111. IF ERRORCODE() = isLockedErr                   #<! Hold the parent record.
  112.   #INSERT(%ParentLockedMsg)
  113.   RETURN                                       #<!  and exit
  114. END                                            #<! End IF
  115.   #ENDIF
  116. #!***************************************************************************
  117. #GROUP(%UpdateChildRecords)
  118. #FIX(%File,%Primary)
  119. #FIX(%Relation,%ParentFile)
  120. LOOP                                           #<!For child records
  121.   NEXT(%Primary)                               #<! Get the next record
  122.   IF ERRORCODE()                               #<! IF Reading past EOF()
  123.     BREAK                                      #<!  BREAK out of the LOOP
  124.   #FOR(%RelationKeyField)
  125.     #IF(%RelationKeyFieldLink)
  126.   ELSIF %RelationKeyFieldLink <> %RelationKeyField #<! or no child records
  127.     BREAK                                      #<!  BREAK out of the LOOP
  128.     #ENDIF
  129.   #ENDFOR
  130.   END                                          #<! End IF
  131.   SAV:SaveRecord = %FilePre:RECORD             #<! Fill the Queue
  132.   GET(RecordQueue %SortString)                 #<! Get the matching QUEUE
  133.   IF ERRORCODE()                               #<! If Not found
  134.     DELETE(%Primary)                           #<!  Delete the file entry
  135.   ELSIF SAV:SaveRecord <> %FilePre:RECORD      #<! Else if Records don't match
  136.     DELETE(%Primary)                           #<!  Delete the file entry
  137. #FOR(%Field)
  138.   #IF(%FieldType = 'MEMO')
  139.   ELSIF SAV:%FieldID <> %Field                 #<! Else if Records don't match
  140.     DELETE(%Primary)                           #<!  Delete the file entry
  141.   #ENDIF
  142. #ENDFOR
  143.   ELSE                                         #<! Else
  144.     SAV:SkipRecord = 1                         #<!  Mark QUEUE record as skip
  145.     PUT(RecordQueue %SortString)               #<!  and PUT() back in QUEUE
  146.   END                                          #<! End IF
  147.   IF ERRORCODE()                               #<! If error on delete or PUT
  148.     TransactionError = ERRORCODE()             #<!  Save the error code
  149.     BREAK                                      #<!  and BREAK out of the loop
  150.   END                                          #<! End IF
  151. END                                            #<!End LOOP
  152. RecordEntryOne = %FixRows + 1                  #<!
  153. LOOP I = RecordEntryOne TO QRecs               #<! Loop through Queue
  154.   GET(RecordQueue,I)                           #<!  Get a QUEUE Element
  155.   IF ERRORCODE() THEN STOP(ERROR()).           #<!  Stop if Unexpected error
  156.   IF SAV:SkipRecord THEN CYCLE.                #<!  Skip unmodified records
  157.   %FilePre:RECORD = SAV:SaveRecord             #<!  Restore the Record
  158.   #FOR(%Field)
  159.     #IF(%FieldType = 'MEMO')
  160.       #SET(%MemoField,%FieldID)
  161.   %Field = SAV:%FieldID                        #<!  Restore the Memos
  162.     #ENDIF
  163.   #ENDFOR
  164.   ADD(%Primary)                                #<!  Add to the file.
  165.   IF ERRORCODE()                               #<!  If error during ADD
  166.     TransactionError = ERRORCODE()             #<!    Save the error
  167.     BREAK                                      #<!    and break from the loop
  168.   END                                          #<!  End IF
  169. END                                            #<! End LOOP
  170. #!***************************************************************************
  171. #GROUP(%PutParentFile)
  172.   #IF(%SharedFiles)
  173.     #IF(%PutParent)
  174. PUT(%ParentFile)                               #<!Put the parent record
  175. IF ERRORCODE()
  176.   #INSERT(%ParentWriteErrMsg)
  177. END
  178.     #ELSE
  179. RELEASE(%ParentFile)                           #<!Release the held record
  180.     #ENDIF
  181.   #ENDIF
  182. #!***************************************************************************
  183. #GROUP(%FillQueueFields)
  184. #FIX(%File, %ParentFile)
  185. #FIX(%Relation,%Primary)
  186. #IF(%RelationType = '1:MANY')
  187.   #FOR(%RelationKeyField)
  188.     #IF(%RelationKeyFieldLink)
  189. %RelationKeyField = %RelationKeyFieldLink      #<!Assign linking field value
  190.     #ENDIF
  191.   #ENDFOR
  192. #ENDIF
  193. #FIX(%ScreenField,'?List')
  194. SAV:Line = %ScreenFieldExpression              #<! Fill the DisplayQueue line
  195. #FIX(%File, %Primary)
  196. SAV:SaveRecord = %FilePre:RECORD               #<! Fill the QUEUE Record
  197. #FOR(%Field)
  198.   #IF(%FieldType = 'MEMO')
  199.   #SET(%MemoField,%FieldID)
  200.   SAV:%FieldID = %Field                        #<! Fill the QUEUE Memo
  201.   #ENDIF
  202. #ENDFOR
  203. #!***************************************************************************
  204. #CHAIN('FormGrps.TPX')
  205.