High Voltage Shareware

home *** CD-ROM | disk | FTP | other *** search

/ High Voltage Shareware / high1.zip / high1 / DIR2 / CLATPL.ZIP / CLARION6.TPX < prev next >

Wrap

Text File | 1993-07-26 | 29KB | 610 lines

#!-------------------------------------------------------------------------------#! #! CLARION6.TPX #! #! Child Update a batch of child records. #! #!------------------------------------------------------------------------------ #! #! The Child Template #! #! The Child template scrolls child records from a file on the screen #! and allows updating the records on the same screen. A parent #! file must be identified and a valid parent record must be in memory #! when this procedure is called. #! #! The QUEUE will contain all children records for a particular #! Parent record. Changes to the children records are made to the #! QUEUE and are only written to disk upon completion of the OK #! button. The update process is framed within a logged transaction. #! The child file must use a file driver which supports transaction #! processing in order to use this template. #! #! The Child template's screen will contain a scrolling listbox #! With Add, Change, Delete, Ok and Cancel pushbuttons and a fixed #! field entry area with Save and Exit Buttons. #! #! The Child template does not support autonumbering of keys. #! #!------------------------------------------------------------------------------ #PROCEDURE(Child,'Update child records from a parent'),SCREEN,PULLDOWN #! #DISPLAY('') #PROMPT('First Upd&ate Field',FIELD),%FirstUpdateField #PROMPT('Parent F&ile',FILE),%ParentFile #PROMPT('Exit on &Null Parent',CHECK),%NullParentExit #PROMPT('Upd&ate Parent on OK',CHECK),%PutParent #INSERT(%SetChildSymbols) #PROTOTYPE('') %Procedure PROCEDURE #INSERT(%CloseFilesFlags) #FIX(%File,%Primary) RecordQueue QUEUE,PRE(SAV) Line STRING(%ScreenFieldQueueSize) #<! Line to be scrolled SaveRecord LIKE(%FilePre:Record),PRE(SAV) SkipRecord BYTE #FIX(%Key,%PrimaryKey) #SET(%FirstField, %Null) #SET(%SortString,%Null) #FOR(%KeyField) #FIX(%Field,%KeyField) #IF(%FirstField = %Null) #SET(%FirstField, %KeyField) #SET(%FirstFieldSequence, %KeyFieldSequence) #ENDIF #IF(%KeyFieldSequence <> 'DESCENDING') #SET(%SortString, (CLIP(LEFT(%SortString)) & ',+SAV:' & %FieldID)) #ELSE #SET(%SortString, (CLIP(LEFT(%SortString)) & ',-SAV:' & %FieldID)) #ENDIF #ENDFOR RecordPosition STRING(256) #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) %FieldID STRING(SIZE(%Field)) #<! Restore the Memos #ENDIF #ENDFOR . #<!End Queue structure FirstPage BYTE(1) ! Page display variable EntryMode BYTE(0) ! Toggles for entry mode ScrollMode EQUATE(1) ! ScrollMode or UpdateMode EQUATE(2) ! UpdateMode DRecs SHORT ! Number of Child records QRecs SHORT ! Number of QUEUE records I BYTE ! QUEUE record pointer ChildAction BYTE(0) ! Update mode NoMoreFields BYTE(0) ! No more fields TransactionError BYTE(0) ! Transaction Error RecordEntryOne BYTE(0) ! Starting record in QUEUE %LocalData %ScreenStructure %PulldownStructure #EMBED('Data Section') CODE #EMBED('Setup Procedure') #INSERT(%NullParentCheck) #!Return if blank parent #INSERT(%OpenPrimary) #!Open Primary file #INSERT(%OpenSecondaryFiles) #!Open any secondary files #INSERT(%HoldParentRecord) #!Hold the parent record OPEN(SCREEN) !Open the screen #EMBED('Setup Screen') #IF(%Pulldown) #!If a Pulldown exists OPEN(%Pulldown) #<!Open the Pulldown #ENDIF DO EnterScrollMode !Select Scrolling mode DO FillQueues !Fill the Queues DRecs = RECORDS(RecordQueue) !Save the number of children #FIX(%File,%Primary) DISPLAY !Show the listbox LOOP #INSERT(%GenerateFormulas) #!Generate all formulas #EMBED('Top of Accept Loop') CASE SELECTED() !Jump to setup routine OF NoMoreFields SELECT(?Save) DO EnterScrollMode ! Switch modes #INSERT(%ScreenSetupRoutines) END !End CASE ACCEPT !Accept user input CASE KEYCODE() #FOR(%HotKey) OF %HotKey #<!User defined HotKey %HotKeyProc #<!HotKey Procedure #ENDFOR END IF EntryMode = ScrollMode !If processing the ScrollMode IF RECORDS(RecordQueue) = %FixRows #<! If deleted last record. DISABLE(?Change) ! Disable the change button DISABLE(?Delete) ! Disable the delete button END ! End IF CASE FIELD() ! Jump to edit routine OF ?List ! Process the List box GET(RecordQueue,CHOICE()) #<! Get the Record Data IF ERRORCODE() THEN CYCLE. ! Cycle if no records #FIX(%File,%Primary) %FilePre:Record = SAV:SaveRecord #<! Fill the fields #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) %Field = SAV:%FieldID #<! Restore the Memos #ENDIF #ENDFOR #INSERT(%GetChildSecondary) DISPLAY ! and re-display IF KEYCODE() = MouseLeft2 ! On Mouse double click PRESS(EnterKey) ! Press the EnterKey END ! End IF OF ?Insert ! Process the Insert Button #FIX(%File,%Primary) ChildAction = AddRecord ! Set to adding a record #INSERT(%ClearFileFields) #<! Clear the record for entry #INSERT(%GetChildSecondary) DO EnterUpdateMode ! Switch to update mode #IF(%InitRoutine) #<!Field(s) initial value DO InitializeFields !Initial values from dictionary #ENDIF OF ?Change ! Process the Change Button ChildAction = ChangeRecord ! Set to Changing a record DO EnterUpdateMode ! Switch modes OF ?Delete ! Process the Delete Button ChildAction = DeleteRecord ! Set to Deleting a record DELETE(RecordQueue) ! Delete Record Queue Entry #INSERT(%ClearFileFields) #<! Clear the record for entry DISPLAY ! Redisplay the list box IF RECORDS(RecordQueue) = %FixRows #<! If deleted last record. DISABLE(?Change) ! Disable the change button DISABLE(?Delete) ! Disable the delete button SELECT(?Insert) ! Select the insert button ELSE ! Else SELECT(?List) ! Select the list box END ! End IF ChildAction = 0 ! Reset the Action CYCLE ! Cycle to accept input OF ?Ok ! Process the Ok Button QRecs = RECORDS(RecordQueue) ! Save the queue record count #FIX(%File, %Primary) #INSERT(%ClearFileFields) #<!Clear the record buffer TransactionError = 0 !Clear Transaction error #FIX(%File, %ParentFile) #FIX(%Relation,%Primary) #IF(%RelationType = '1:MANY') #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ENDIF #ENDFOR #ENDIF SET(%RelationKey,%RelationKey) #<!Set to the matching record LOGOUT(2,%Primary) #<!Enable transaction logging IF ERRORCODE() = BadTranErr !If transaction error occurs GLO:Message1 = 'Unable to save your changes at this time.' GLO:Message2 = 'Another user may be saving a transaction.' GLO:Message3 = 'Try again.' ShowWarning ! Show the transaction error SELECT(?Ok) ! Reselect the Ok button CYCLE ! Cycle to ACCEPT input END !End IF #INSERT(%UpdateChildRecords) IF TransactionError !If transaction error occurs GLO:Message1 = 'Unable to save your changes at this time.' GLO:Message2 = 'Error: '& ERROR() GLO:Message3 = 'Make any necessary changes and try again.' ShowWarning ! Show the transaction error ROLLBACK ! Rollback the changes. SELECT(?List,I) ! Reselect the List box PRESS(EnterKey) ! Setup to change record CYCLE ! Cycle to ACCEPT input ELSE !Else COMMIT ! Commit the changes to disk END !End IF #INSERT(%PutParentFile) BREAK ! Break to Return to Caller OF ?Cancel !Process the Cancel Button BREAK ! Break to Return to Caller END !End CASE ELSE ! Else if update mode #INSERT(%GetChildSecondary) DISPLAY ! Display the new record CASE FIELD() ! #INSERT(%ChildEditRoutines) OF ?Save ! Process the Save Button CASE ChildAction ! Adding or Changing? OF AddRecord ! When adding a new record. #INSERT(%FillQueueFields) ADD(RecordQueue %SortString) #<! Add to the sorted queue ChildAction = 0 ! Reset the Action value OF ChangeRecord ! When changing a record #INSERT(%FillQueueFields) PUT(RecordQueue %SortString) #<! Add to the queue ChildAction = 0 ! Reset the Action value END ! Case SELECT(1) !Start with the first field SELECT !and cycle non-stop CYCLE !restart main process loop OF ?Exit ! Process the Exit Button DO EnterScrollMode ! Switch modes END ! End CASE END ! End IF CASE FIELD() #FOR(%PulldownField) #IF(%PulldownFieldProc <> %NULL) OF %PulldownField #<!For a selected menu item %PulldownFieldProc #<!Call the procedure #ENDIF #ENDFOR END !End CASE for Pulldowns END !End LOOP #EMBED('Prior to Return') #IF(%Pulldown) #!If a Pulldown exists CLOSE(%Pulldown) #<!Open the Pulldown #ENDIF #IF(%SharedFiles) RELEASE(%ParentFile) #<!Release held parent record #ENDIF FREE(RecordQueue) !Free the QUEUE memory #INSERT(%CloseOpenedFiles) #EMBED('End of Procedure') #INSERT(%ChildInitFields) EnterScrollMode ROUTINE !Switch screen mode routine DISABLE(1,FIELDS()) ! Disable listbox and buttons ENABLE(?List) ! Enable the list box ENABLE(?Insert, ?Cancel) ! Enable the Buttons IF RECORDS(RecordQueue) = %FixRows #<! If no records to scroll IF EntryMode ! If not before FillQueues DISABLE(?Change) ! Disable the change button DISABLE(?Delete) ! Disable the delete button SELECT(?Insert) ! Select the insert button END ! End IF ELSE ! Else SELECT(?List) ! Select the list box END ! End IF EntryMode = ScrollMode ! Switch to scroll mode #EMBED('Enter Scroll Mode Routine') EnterUpdateMode ROUTINE EntryMode = UpdateMode !Switch screen mode routine DISABLE(1,FIELDS()) ! Disable listbox and buttons ENABLE(?%FirstUpdateField, ?Exit) #<! Enable the entry fields Select(?%FirstUpdateField) #<! Select the first entry field #EMBED('Enter Update Mode Routine') FillQueues ROUTINE FREE(RecordQueue) #<!Clear the Record queue #SET(%FixRows, '0') #SET(%ListField,'?List') #FIX(%ScreenField,%ListField) #FOR(%ScreenFieldFix) #SET(%FixRows, (%FixRows + 1)) SAV:Line = %ScreenFieldFix #<!Add list box fixed fields ADD(RecordQueue %SortString) #<! Add to the sorted queue DISPLAY(?List) #<!Blank the listbox #ENDFOR #FIX(%File, %Primary) #INSERT(%ClearFileFields) #<!Clear the Child record #FIX(%File, %ParentFile) #FIX(%Relation,%Primary) #IF(%RelationType = '1:MANY') #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ENDIF #ENDFOR #ENDIF SET(%RelationKey,%RelationKey) #<!Set to keyed order LOOP !Get all selected records NEXT(%Primary) #<!Get the next record. IF ERRORCODE() THEN BREAK. !Quit if an error occurs #INSERT(%GetChildSecondary) #FIX(%File,%Primary) #FIX(%Key,%PrimaryKey) #IF(%ChildRelationField) #!If using a Range IF %ChildRelationField <> %ParentRelationField #<!If not in Range IF RECORDS(RecordQueue) <> %FixRows #<! If records were added #SET(%FirstNonFixedRecord,(%FixRows+1)) GET(RecordQueue,%FirstNonFixedRecord) #<! Get first non-fixed row RESET(%RelationKey,SAV:RecordPosition) #<! Reset to the last entry NEXT(%Primary) #<! Reread the last entry BREAK #<! Break out of the Loop ELSE ! Else no children found #INSERT(%ClearFileFields) #<! Clear the record BREAK #<! Break out of the Loop END ! End IF END !End IF #ENDIF #IF(%RecordFilterFormula) IF ~(%RecordFilterFormula) #<!If Filter condition not met CYCLE ! Try another record END !End IF #ELSE #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'FILTER') #IF(%FormulaType <> 'COMPUTED') IF ~(%FormulaCondition) #<!If Filter condition not met CYCLE ! Try another record END !End IF #ELSE IF ~(%FormulaComputation) #<!If Filter condition not met CYCLE ! Try another record END !End IF #ENDIF #ENDIF #ENDFOR #ENDIF #FOR(%Formula) #IF(UPPER(%FormulaClass) = 'LIST') #INSERT(%GenerateFormula) #!Generate LIST formulas #ENDIF #ENDFOR #FIX(%File,%Primary) #SET(%ListField,'?LIST') #FIX(%ScreenField,%ListField) SAV:Line = %ScreenFieldExpression #<! Fill the DisplayQueue line SAV:SaveRecord = %FilePre:Record ! Save the record data SAV:RecordPosition = POSITION(%RelationKey) ! Save the record position #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) SAV:%FieldID = %Field #<! Restore the Memos #ENDIF #ENDFOR ADD(RecordQueue %SortString) #<! Add to the sorted queue IF ERRORCODE() THEN BREAK. ! Quit out if error IF FirstPage ! If page 1 IF RECORDS(RecordQueue) = ROWS(?List) ! If we have a full screen FirstPage = 0 ! turn off the page flag END ! End IF DISPLAY(?List) ! Display page 1 END ! End IF END !End LOOP IF RECORDS(RecordQueue) = %FixRows #<!If the queue is empty IF RECORDS(%Primary) #<! If file is not empty IF ?List <> %FirstEntryField #<! And list is not first SELECT(1) ! Select the first field ELSE ! Else DISABLE(1,FIELDS()) ! Disable all fields ENABLE(?Insert) ! Enable the Insert and ENABLE(?Cancel) ! the cancel buttons SELECT(?Insert) ! Select the Insert Button END ! End IF ELSE ! Else the file is empty DISABLE(1,FIELDS()) ! Disable all fields ENABLE(?Insert) ! Enable the Insert and ENABLE(?Cancel) ! the cancel buttons SELECT(?Insert) ! Select the Insert Button END ! End IF ELSE !Else records exist GET(RecordQueue,%FirstNonFixedRecord) #<! Get first non-fixed row RESET(%RelationKey,SAV:RecordPosition) #<! Reset to the last entry NEXT(%Primary) #<! Reread the last entry #INSERT(%GetChildSecondary) END !End IF DISPLAY #! #!*************************************************************************** #GROUP(%SetChildSymbols) #IF(%ParentFile = %Null) #SET(%ErrorMessage, (%Procedure & ' ERROR: Parent File is required.')) #ERROR(%ErrorMessage) #ENDIF #SET(%MemoExists,%Null) #FIX(%File,%Primary) #FIX(%File,%Primary) #FIX(%Relation,%ParentFile) #IF(%RelationType = 'MANY:1') #FOR(%RelationKeyField) #SET(%ParentRelationField, %RelationKeyField) #SET(%ChildRelationField, %RelationKeyFieldLink) #BREAK #ENDFOR #ENDIF #SET(%ScreenFldSetupExists,%Null) #FIX(%File,%Primary) #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoExists,'Yes') #BREAK #ENDIF #ENDFOR #SET(%FixRows, '0') #SET(%ListField,'?List') #FIX(%ScreenField,%ListField) #FOR(%ScreenFieldFix) #SET(%FixRows, (%FixRows + 1)) #ENDFOR #FOR(%ScreenField) #IF(%ScreenFieldSetup) #SET(%ScreenFldSetupExists,'YES') #BREAK #ENDIF #ENDFOR #SET(%FirstEntryField,%Null) #FOR(%ScreenField) #IF(%ScreenFieldSkip = %Null) #SET(%FirstEntryField,%ScreenField) #BREAK #ENDIF #ENDFOR #FOR(%Field) #IF(%FieldInitial <> %NULL) #SET(%InitRoutine,'TRUE') #BREAK #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%GetChildSecondary) #FOR(%Secondary) #! for fields in the list box #IF(%Secondary <> %ParentFile) #IF(%SecondaryType = 'MANY:1') #!Check for lookup files #FIX(%File,%SecondaryTo) #FIX(%Relation,%Secondary) #FOR(%RelationKeyField) IF %RelationKeyField <> %RelationKeyFieldLink #<!If Link fields don't match %RelationKeyField = %RelationKeyFieldLink #<! Assign linking field value #ENDFOR GET(%Secondary,%RelationKey) #<! Lookup record #FIX(%File,%Secondary) IF ERRORCODE() #<! Clear record if unsuccessful #INSERT(%ClearFileFields) END END #<!End IF #ENDIF #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%ChildInitFields) #IF(%InitRoutine = 'TRUE') InitializeFields ROUTINE #FOR(%Field) #IF(%FieldInitial <> %NULL) %Field = %FieldInitial #ENDIF #ENDFOR #ENDIF #!*************************************************************************** #GROUP(%ChildEditRoutines) #FOR(%ScreenField) #IF(%ScreenFieldUse <> '?Ok') #IF(%ScreenFieldUse <> '?Cancel') #INSERT(%RangeLookupCheck) #IF(%ScreenFieldEdit OR %RangeCodeOn OR %FieldLookupOn) OF %ScreenField #IF(%FieldLookupOn) #INSERT(%FieldLookupCode) #ENDIF #IF(%RangeCodeOn) #INSERT(%RangeCode) #ENDIF #IF(%ScreenFieldEdit) %ScreenFieldEdit #ENDIF #ENDIF #ENDIF #ENDIF #ENDFOR #FOR(%PulldownField) #IF(%PulldownFieldProc <> %NULL) OF %PulldownField #<! For a selected menu item %PulldownFieldProc #<! Call the procedure #ENDIF #ENDFOR #!*************************************************************************** #GROUP(%NullParentCheck) #IF(%NullParentExit) #FIX(%File,%ParentFile) IF %FilePre:RECORD = '' #<!If Parent record is blank RETURN #<! Return to the caller END #<!End IF #FIX(%File,%Primary) #ENDIF #!*************************************************************************** #GROUP(%HoldParentRecord) #IF(%SharedFiles) HOLD(%ParentFile,5) #<! When sharing the files IF ERRORCODE() = isLockedErr #<! Hold the parent record. GLO:Message1 = 'This %ParentFile Entry is being updated' GLO:Message2 = 'by another user. Try again later. ' GLO:Message3 = '' #<! Show an error if another ShowWarning #<! user has the parent held RETURN #<! and exit END #<! End IF #ENDIF #!*************************************************************************** #GROUP(%UpdateChildRecords) #FIX(%File,%Primary) LOOP #<!For child records NEXT(%Primary) #<! Get the next record IF ERRORCODE() #<! IF Reading past EOF() BREAK #<! BREAK out of the LOOP ELSIF %ChildRelationField <> %ParentRelationField #<! or no child records BREAK #<! BREAK out of the LOOP END #<! End IF SAV:SaveRecord = %FilePre:RECORD #<! Fill the Queue GET(RecordQueue %SortString) #<! Get the matching QUEUE IF ERRORCODE() #<! If Not found DELETE(%Primary) #<! Delete the file entry ELSIF SAV:SaveRecord <> %FilePre:RECORD #<! Else if Records don't match DELETE(%Primary) #<! Delete the file entry #FOR(%Field) #IF(%FieldType = 'MEMO') ELSIF SAV:%FieldID <> %Field #<! Else if Records don't match DELETE(%Primary) #<! Delete the file entry #ENDIF #ENDFOR ELSE #<! Else SAV:SkipRecord = 1 #<! Mark QUEUE record as skip PUT(RecordQueue %SortString) #<! and PUT() back in QUEUE END #<! End IF IF ERRORCODE() #<! If error on delete or PUT TransactionError = ERRORCODE() #<! Save the error code BREAK #<! and BREAK out of the loop END #<! End IF END #<!End LOOP RecordEntryOne = %FixRows + 1 #<! LOOP I = RecordEntryOne TO QRecs #<! Loop through Queue GET(RecordQueue,I) #<! Get a QUEUE Element IF ERRORCODE() THEN STOP(ERROR()). #<! Stop if Unexpected error IF SAV:SkipRecord THEN CYCLE. #<! Skip unmodified records %FilePre:RECORD = SAV:SaveRecord #<! Restore the Record #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) %Field = SAV:%FieldID #<! Restore the Memos #ENDIF #ENDFOR ADD(%Primary) #<! Add to the file. IF ERRORCODE() #<! If error during ADD TransactionError = ERRORCODE() #<! Save the error BREAK #<! and break from the loop END #<! End IF END #<! End LOOP #!*************************************************************************** #GROUP(%PutParentFile) #IF(%SharedFiles) #IF(%PutParent) PUT(%ParentFile) #<!Put the parent record IF ERRORCODE() GLO:Message1 = 'Unable to save %ParentFile Entry.' GLO:Message2 = 'Error: '& ERROR() GLO:Message3 = 'The entry has not been saved.' #<!Show an error if another ShowWarning #<!Show the transaction error END #ELSE RELEASE(%ParentFile) #<!Release the held record #ENDIF #ENDIF #!*************************************************************************** #GROUP(%FillQueueFields) #FIX(%File, %ParentFile) #FIX(%Relation,%Primary) #IF(%RelationType = '1:MANY') #FOR(%RelationKeyField) #IF(%RelationKeyFieldLink) %RelationKeyField = %RelationKeyFieldLink #<!Assign linking field value #ENDIF #ENDFOR #ENDIF SAV:Line = %ScreenFieldExpression #<! Fill the DisplayQueue line #FIX(%File, %Primary) SAV:SaveRecord = %FilePre:RECORD #<! Fill the QUEUE Record #FOR(%Field) #IF(%FieldType = 'MEMO') #SET(%MemoField,%FieldID) SAV:%FieldID = %Field #<! Fill the QUEUE Memo #ENDIF #ENDFOR #!*************************************************************************** #CHAIN('CLARION7.TPX')