home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR36
/
C7101.ZIP
/
FORMGRPS.TPX
< prev
next >
Wrap
Text File
|
1994-02-01
|
34KB
|
793 lines
#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
#!│ FormGrps.TPX │Version: 3007.000│
#!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
#!│Structure Type Description │
#!│──────────────────── ───────── ─────────────────────────────────────────│
#!│InitQue GROUP │
#!│InitFields GROUP │
#!│SecondaryLookups GROUP │
#!│InsertMessage GROUP │
#!│ChangeMessage GROUP │
#!│DeleteMessage GROUP │
#!│AutoIncCode GROUP │
#!│RestoreAuto GROUP │
#!│SetupConcurrency GROUP │
#!│ConflictUpdate GROUP │
#!│DupKeyCode GROUP │
#!│ClearValues GROUP │
#!│InitFormSymbols GROUP │
#!│UpdateRelationSearch GROUP │
#!│DeleteRelationSearch GROUP │
#!│RelationalAccessFlds GROUP │
#!│GenFormulas GROUP │
#!│SecondaryChanged GROUP │
#!│FieldDups GROUP │
#!│SaveScrFlds GROUP │
#!│DupFldCall GROUP │
#!│DupField GROUP │
#!│InitButtonExist GROUP │
#!│AltKeys GROUP │
#!│ProcCounter GROUP │
#!│SavePrimedFields GROUP │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#GROUP(%InitQue)
#IF(%SharedFiles = 'TRUE')
!─────────────────────────────────────────────────────────────────────────────
InitializeQueue ROUTINE #<!save initial record values
FREE(RecordQueue)
Sav:SaveRecord = %FilePre:Record #<!Save the current record
#IF(%MemoChk)
#FOR(%FileMemo)
#FIX(%Field,%FileMemo)
SAV:%FieldID = %Field #<!Save the memo
#ENDFOR
#ENDIF
ADD(RecordQueue,1) #<!add record to Queue
ADD(RecordQueue,2) #<!add record again
IF ERRORCODE() #<!check Queue add error
CASE ERRORCODE()
OF NoMemErr #<!Is there enough memory?
#INSERT(%NotEnoughMemMsg)
ELSE #<!On any other error
#INSERT(%GeneralErrorMsg)
END #<!End CASE Errorcode
DISABLE(1,FIELDS()) #<!Disable the screen fields
#IF(%TableForm = %Null)
ENABLE(?Cancel) #<!Enable the Cancel button
SELECT(?Cancel) #<!Place the cursor on Cancel
#ELSIF(%TableForm)
#IF(%CancelExists = %Null)
ENABLE(%FirstField) #<!Enable the First Field
SELECT(%FirstField) #<!Place cursor on Cancel
PRESS(EscKey)
#ELSE
ENABLE(?Cancel) #<!Enable the Cancel button
SELECT(?Cancel) #<!Place the cursor on Cancel
#ENDIF
#ENDIF
DISPLAY #<!Update screen display
END #<!End IF Errorcode
EXIT
#ENDIF
#!***************************************************************************
#GROUP(%InitFields)
#IF(%InitRoutine = 'Y')
!─────────────────────────────────────────────────────────────────────────────
InitializeFields ROUTINE
#FOR(%Field)
#IF(%FieldInitial <> %NULL)
%Field = %FieldInitial
#ENDIF
#ENDFOR
#ENDIF
#!***************************************************************************
#GROUP(%SecondaryLookups)
!─────────────────────────────────────────────────────────────────────────────
SecondaryLookups ROUTINE
#INSERT(%GetSecondaryRecords) #<!Lookup into Secondary files
DISPLAY #<!Redisplay Screen Fields
#!***************************************************************************
#GROUP(%InsertMessage)
#IF(%InsertMsg <> %NULL)
LOC:Message = CENTER('%InsertMsg',SIZE(LOC:Message)) #<!Assign ADD message
#ELSE
LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message))#<!Assign ADD message
#ENDIF
#!***************************************************************************
#GROUP(%ChangeMessage)
#IF(%ChangeMsg <> %NULL)
LOC:Message = CENTER('%ChangeMsg',SIZE(LOC:Message)) #<!Assign CHANGE message
#ELSE
LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message))#<!Assign CHANGE message
#ENDIF
#!***************************************************************************
#GROUP(%DeleteMessage)
#IF(%DeleteMsg <> %NULL)
LOC:Message = CENTER('%DeleteMsg',SIZE(LOC:Message)) #<!Assign DELETE message
#ELSE
LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message))#<!Assign DELETE message
#ENDIF
#!***************************************************************************
#GROUP(%AutoIncCode)
#IF(%AutoInc = 'Y')
!─────────────────────────────────────────────────────────────────────────────
AutoNumber Routine
LOOP #<!Loop for autonumbering
#FIX(%File,%Primary)
#FOR(%Key)
#SET(%SaveKey,%Key)
#IF(%KeyAuto) #! <> %NULL
#FOR(%KeyField)
#FIX(%Field,%KeyField)
#IF(%KeyFieldSequence = 'ASCENDING') #! IF Ascending Key Field
#IF(UPPER(%FieldType) = 'PICTURE') #!Autonumber Picture data type
#IF(INSTRING('@N',UPPER(%FieldRecordPicture),1,1)) #!If its an @n picture
%KeyField = ALL('9') #<!Fill strings with 9's
#ELSE
CLEAR(%KeyField,1) #<!Clear Ascending to high value
#ENDIF
#ELSE
CLEAR(%KeyField,1) #<!Clear Ascending to high value
#ENDIF
#ELSE
#IF(UPPER(%FieldType) = 'PICTURE') #!Autonumber Picture data type
#IF(INSTRING('@N',UPPER(%FieldRecordPicture),1,1)) #!If its an @n picture
%KeyField = ALL('0') #<!Fill strings with 0's
#ELSE
CLEAR(%KeyField,-1) #<!Clear Descending to low value
#ENDIF
#ELSE
CLEAR(%KeyField,-1) #<!Clear Descending to low value
#ENDIF
#ENDIF
#ENDFOR
#FOR(%Formula)
#IF(UPPER(%FormulaClass) = 'PRIMEKEY')
#INSERT(%GenerateFormula)
#ENDIF
#ENDFOR
#IF(%PrimeKeysExist)
#FOR(%KeyField)
#IF(%KeyField <> %KeyAuto)
Prime::%KeyField = %KeyField #<!Save for Subset numbering
#ENDIF
#ENDFOR
#ENDIF
#FIX(%KeyField,%KeyAuto)
SET(%Key,%Key) #<!%KeyFieldSequence
#IF(%KeyFieldSequence='ASCENDING')
PREVIOUS(%Primary) #<!Read last record (Ascending)
#ELSE
NEXT(%Primary) #<!Read last record (Ascending)
#ENDIF
IF ERRORCODE() = BadRecErr #<!If Errorcode No Records
%KeyAuto:AutoInc# = 1 #<!then start numbering at 1
ELSIF ERRORCODE() #<!On any other error
#INSERT(%KeyedRecordReadMsg)
DO ProcedureReturn
ELSE
#FIX(%Key,%SaveKey)
#IF(%PrimeKeysExist)
#SET(%KeyFieldCounter,%Null)
#FOR(%KeyField)
#IF(%KeyField <> %KeyAuto)
#SET(%KeyFieldCounter,(%KeyCounter+1))
#ELSE
#BREAK
#ENDIF
#ENDFOR
#SET(%IfWritten,%Null)
#IF(%KeyFieldCounter)
#FOR(%KeyField)
#IF((%KeyFieldCounter='1'))
#IF(%IfWritten)
AND PRIME::%KeyField = %KeyField
#ELSE
IF PRIME::%KeyField = %KeyField
#ENDIF
#BREAK
#ELSE
#IF(%IfWritten)
AND PRIME::%KeyField = %KeyField|
#ELSE
IF PRIME::%KeyField = %KeyField|
#ENDIF
#SET(%KeyFieldCounter,(%KeyFieldCounter-1))
#SET(%IfWritten,'TRUE')
#ENDIF
#ENDFOR
%KeyAuto:AutoInc# = %KeyAuto + 1 #<!Subset incremented value
ELSE
%KeyAuto:AutoInc# = 1 #<!then start numbering at 1
END
#ELSE #!End test subset match
%KeyAuto:AutoInc# = %KeyAuto + 1 #<!Save incremented value
#ENDIF
#ELSE #!No subset support
%KeyAuto:AutoInc# = %KeyAuto + 1 #<!Save incremented value
#ENDIF
END #<!End IF errorcode
#ENDIF #!End IF keyauto
#ENDFOR #!End FOR KEY
#INSERT(%ClearValues)
#FOR(%Formula)
#IF(UPPER(%FormulaClass) = 'PRIMEKEY')
#INSERT(%GenerateFormula) #<!Allow for Subset numbering
#ENDIF
#ENDFOR
#FOR(%Key)
#IF(%KeyAuto <> %NULL)
%KeyAuto = %KeyAuto:AutoInc# #<!Move the incremented value
#ENDIF
#ENDFOR
ADD(%Primary) #<!Add the record now
IF ERRORCODE() #<!Was there an error?
CASE ERRORCODE() #<!Process errors
OF DupKeyErr #<!Is it a duplicate key?
CYCLE #<!then try again
ELSE #<!Else
IF DiskError('Record could not be ADDed') #<!Check any other error
DO ProcedureReturn
END #<!End IF Diskerror
END #<!End CASE errorcode
ELSE #<!Else no error
BREAK #<!so BREAK Loop
END #<!End IF errorcode
END #<!End LOOP for Autonumbering
AutoIncAdd = True #<!Switch AutoIncAdd ON
AutoAddPtr = POSITION(%Primary) #<!Save the record position
RESET(%Primary,AutoAddPtr) #<!Position to record we added
HOLD(%Primary,4) #<!Hold the record
NEXT(%Primary) #<!and read it in to buffer
IF DiskError('Could not READ Record') #<!Check for I/O error
DO ProcedureReturn
END #<!End IF Diskerror
Action = ChangeRecord #<!Action is now change
EXIT #<!Exit the routine
#ENDIF
#!***************************************************************************
#GROUP(%RestoreAuto)
#FOR(%Key)
#IF(%KeyAuto <> %NULL)
%KeyAuto = %KeyAuto:AutoInc# #<!Restore incremented value
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%SetupConcurrency)
DO InitializeQueue #<!Save record to QUEUE
SavePointer = POSITION(%Primary) #<!Save the record position
#!***************************************************************************
#GROUP(%ConflictUpdate)
PUT(RecordQueue) #<!Update the memory Queue
#INSERT(%RecordChangedMsg)
SELECT(1) #<!Place cursor on 1st field
DISPLAY #<!Update the screen
AbortTransaction = True #<!Turn AbortWrite# ON
EXIT #<!Exit the Routine
#!***************************************************************************
#GROUP(%DupKeyCode)
#FIX(%File,%Primary)
IF ERRORCODE() = DupKeyErr #<! Duplicate key detected
#FOR(%Key)
#IF(UPPER(%KeyDuplicate) <> 'Y')
IF DUPLICATE(%Key) #<!check unique keys
#IF(%SharedFiles = 'TRUE')
RELEASE(%File) #<!Release the HOLD
#ENDIF
GLO:Message3 = '[ '
#FOR(%KeyField)
GLO:Message3 = Clip(GLO:Message3) & (' %KeyField ')
#ENDFOR
GLO:Message3 = Clip(GLO:Message3)&' ]'
GLO:Message1 = 'This record creates a duplicate key entry'
GLO:Message2 = 'The unique key field(s) are listed below: '
ShowWarning #<!inform the user
END
#ENDIF
#ENDFOR
SELECT(1) #<!select first field
DISPLAY #<!re-display the screen
CYCLE #<!back to main loop
END #<!End IF Duplicate errorcode
#!***************************************************************************
#GROUP(%ClearValues)
CLEAR(%FilePre:Record) #<!CLEAR Record buffer
#FOR(%FileMemo)
CLEAR(%FileMemo) #<!CLEAR Memo buffer
#ENDFOR
#!***************************************************************************
#GROUP(%InitFormSymbols)
#! INITIALIZE FORM TEMPLATE SYMBOLS
#!────────────────────────────────────────────────────────────────────────────
#!User Defined Symbols Purpose/Meaning
#!────────────────────────────────────────────────────────────────────────────
#SET(%HotKeysExist,%Null) #!Do Hot Keys Exist
#SET(%AutoInc,%Null) #!Does %Primary use an Auto-Increment key
#SET(%DupKeyCheck,%Null) #!Does a ,DUP key exist for %Primary
#SET(%LoopFormulasExist,%Null) #!Do unclassed formulas exist?
#SET(%PrimeKeysExist,%Null) #!Are there any PrimeKey formulas
#SET(%MemoChk,%Null) #!Are any memos present in Primary
#SET(%InitRoutine,%Null) #!Do any fields have initial values?
#SET(%FileControlMode,%Null) #!Controls writing of file opening/closing
#SET(%ControlLookups,'Y') #!Searches Lookups for opening/closing
#SET(%ControlRelatedFiles,'Y') #!Searches relations for opening/closing
#SET(%RelatedFileListing,%Null) #!List Containing Related Files
#SET(%LevelOne,%Null) #!
#SET(%LevelOneLinks,%Null) #!
#SET(%LinkPool,%Null) #!
#SET(%RelatedFiles,%Null) #!
#SET(%RestrictDelete,%Null) #!
#SET(%RestrictUpdate,%Null) #!
#SET(%CascadeDelete,%Null) #!
#SET(%CascadeUpdate,%Null) #!
#SET(%ClearOnDelete,%Null) #!
#SET(%ClearOnUpdate,%Null) #!
#SET(%SecondaryExist,%Null) #!
#SET(%PrimaryUpdateConst,%Null)
#SET(%PrimaryDeleteConst,%Null)
#SET(%RelationString,%Null)
#SET(%ChildPre,%Null)
#SET(%ParentPre,%Null)
#SET(%AllRelations,%Null)
#SET(%RelatedChildList,%Null)
#SET(%RelatedParentList,%Null)
#SET(%UpdateRelations,%Null)
#SET(%UpdateChildList,%Null)
#SET(%UpdateParentList,%Null)
#SET(%DeleteRelations,%Null)
#SET(%DeleteChildList,%Null)
#SET(%DeleteParentList,%Null)
#SET(%ControlRelatedFiles,'TRUE')
#SET(%NonStopSelect,'TRUE')
#FIX(%File,%Primary) #!Prime File symbols
#SET(%PrimaryDriver,%FileType) #!Retrieve the file driver
#FOR(%HotKey) #!For Each Hot Key
#IF(%HotKeyProc) #!If there is a procedure
#SET(%HotKeysExist,'Y') #!Set the flag
#BREAK #!and stop looking
#ENDIF #!END (if %HotKeyProc)
#ENDFOR #!END (for %HotKey)
#FOR(%Key) #!For each key of %Primary
#IF(%KeyAuto <> %NULL) #!If asks for Auto Increment
#SET(%AutoInc,'Y') #!Set the flag
#ENDIF #!END (if %KeyAuto)
#IF(%KeyDuplicate <> 'Y') #!If dup checking needed
#SET(%DupKeyCheck,'Y') #!Set the Flag
#ENDIF #!END (if %KeyDuplicate)
#ENDFOR #!END (for %Key)
#FOR(%Formula) #!For each formula
#IF(UPPER(%FormulaClass) = '') #!If there's no class
#SET(%LoopFormulasExist,'Y') #!Flag for loop processing
#ENDIF #!END (if formulaclass = '')
#IF(UPPER(%FormulaClass) = 'PRIMEKEY') #!Formula primes key values
#SET(%PrimeKeysExist,'Y') #!Set the Flag
#ENDIF #!END (if formulaclass = 'P...')
#ENDFOR #!END (for %Formula)
#FOR(%FileMemo) #!For each memo field
#SET(%MemoChk,'Y') #!Set a flag that one exists
#BREAK #!and stop looking
#ENDFOR #!END (for %FileMemo)
#FOR(%Field) #!For each field of Primary
#IF(%FieldInitial <> %NULL) #!If Field has initial value
#SET(%InitRoutine,'Y') #!Flag for initializing code
#BREAK #!and quit looking
#ENDIF #!END (if %FieldInitial)
#ENDFOR #!END (for Field)
#SET(%ProcessingFile,%Primary) #!Set for Relations Search
#INSERT(%UpdateRelationSearch) #!Retrieves Relations
#SET(%ProcessingFile,%Primary) #!Set for Relations Search
#INSERT(%DeleteRelationSearch) #!Retrieves Relations
#FOR(%Secondary) #!For each secondary file
#IF(%SecondaryType = 'MANY:1') #!If relation = Many:1
#SET(%SecondaryExist,'Y') #!Set SecondaryExist flag
#ENDIF #!END (if SecondaryType = Many:1)
#ENDFOR #!END (for Secondary)
#!***************************************************************************
#GROUP(%UpdateRelationSearch)
#FIX(%File,%ProcessingFile)
#FOR(%Relation)
#IF(%RelationType = '1:MANY')
#IF(%RelationConstraintUpdate)
#SET(%NoLinkFound,%Null)
#FOR(%RelationKeyField)
#IF(UPPER(%RelationKeyFieldLink)='TODO')
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' contains undefined (TODO) links.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ELSIF(%RelationKeyFieldLink)
#IF(%NoLinkFound)
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' is an unenforcable constrained UPDATE relation.')
#ERROR(' A non-linked key element on the MANY side of a')
#ERROR(' relation may not be followed by linked key elements.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ENDIF
#ELSE
#SET(%NoLinkFound,'TRUE')
#ENDIF
#ENDFOR
#ENDIF
#SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
#SET(%ParentPre,('['&%FilePre&']'))
#SET(%ChildPre,('['&%RelationPre&']'))
#IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
#SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
#SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintUpdate)
#SET(%UpdateRelations,(%UpdateRelations&%RelationString))
#SET(%AllRelations,(%AllRelations&%RelationString))
#IF((INSTRING(%ParentPre,%UpdateParentList,1,1))=0)
#SET(%UpdateParentList,(%UpdateParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%UpdateChildList,1,1))=0)
#SET(%UpdateChildList,(%UpdateChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintUpdate<>'RESTRICT')
#SET(%ProcessingFile,%Relation)
#INSERT(%UpdateRelationSearch)
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%DeleteRelationSearch)
#FIX(%File,%ProcessingFile)
#FOR(%Relation)
#IF(%RelationType = '1:MANY')
#IF(%RelationConstraintDelete)
#SET(%NoLinkFound,%Null)
#FOR(%RelationKeyField)
#IF(UPPER(%RelationKeyFieldLink)='TODO')
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' contains undefined (TODO) links.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ELSIF(%RelationKeyFieldLink)
#IF(%NoLinkFound)
#ERROR(' DICTIONARY ERROR!')
#SET(%ErrorMessage,(' The Relation: ' & %File & '─' & %Relation))
#ERROR(%ErrorMessage)
#ERROR(' is an unenforcable constrained DELETE relation.')
#ERROR(' A non-linked key element on the MANY side of a')
#ERROR(' relation may not be followed by linked key elements.')
#ERROR(' Code generated will NOT compile')
#ERROR('')
#ENDIF
#ELSE
#SET(%NoLinkFound,'TRUE')
#ENDIF
#ENDFOR
#ENDIF
#SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
#SET(%ParentPre,('['&%FilePre&']'))
#SET(%ChildPre,('['&%RelationPre&']'))
#IF((INSTRING(%ParentPre,%RelatedParentList,1,1))=0)
#SET(%RelatedParentList,(%RelatedParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%RelatedChildList,1,1))=0)
#SET(%RelatedChildList,(%RelatedChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintDelete)
#SET(%DeleteRelations,(%DeleteRelations&%RelationString))
#IF((INSTRING(%RelationString,%AllRelations,1,1))=0)
#SET(%AllRelations,(%AllRelations&%RelationString))
#ENDIF
#IF((INSTRING(%ParentPre,%DeleteParentList,1,1))=0)
#SET(%DeleteParentList,(%DeleteParentList&%ParentPre))
#ENDIF
#IF((INSTRING(%ChildPre,%DeleteChildList,1,1))=0)
#SET(%DeleteChildList,(%DeleteChildList&%ChildPre))
#ENDIF
#IF(%RelationConstraintDelete<>'RESTRICT')
#SET(%ProcessingFile,%Relation)
#INSERT(%DeleteRelationSearch)
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
#!*************************************************************************
#GROUP(%RelationalAccessFlds)
#FOR(%File)
#SET(%ParentPre,('['&%FilePre&']'))
#IF((INSTRING(%ParentPre,%RelatedParentList,1,1)))
#FOR(%Relation)
#SET(%RelationString,('['&FilePre&'∙'&RelationPre&']'))
#IF((INSTRING(%RelationString,%AllRelations,1,1)))
#FOR(%RelationKeyField)
#IF(%RelationKeyFieldLink <> %NULL)
#FIX(%Field,%RelationKeyFieldLink)
#IF(%FieldType = 'GROUP')
%RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink),PRE(LNK) #<!Define a link field
#ELSE
%RelationPre::%RelationKeyFieldLink LIKE(%RelationKeyFieldLink) #<!Define a link field
#ENDIF
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#!**************************************************************************
#GROUP(%GenFormulas)
#IF(%GenerateFormulasOn)
!─────────────────────────────────────────────────────────────────────────────
FormulaFields ROUTINE
#FOR(%Formula)
#IF(UPPER(%FormulaClass) <> 'PRIMEKEY')
#IF(UPPER(%FormulaClass) <> 'SETUP')
#IF(UPPER(%FormulaClass) <> 'RETURN')
#IF(%CodePosition = %NULL OR %CodePosition = %FormulaClass)
#IF(%FormulaType = 'COMPUTED')
%Formula = %FormulaComputation #<!Computed Formula (no class)
#ELSE
IF %FormulaCondition #<!If Formula condition
%Formula = %FormulaTrue #<! is TRUE
#IF(%FormulaFalse)
ELSE ! else
%Formula = %FormulaFalse #<! condition is FALSE
#ENDIF
END #<!End formula condition
#ENDIF
#SET(%CurrentFormula,('?' & %Formula))
#FIX(%Screenfield,%CurrentFormula)
#IF(%Screenfield)
DISPLAY(?%Formula) #<!Update screen display
#ENDIF
#ENDIF
#ENDIF #!Not PrimeKey class
#ENDIF #!Not Setup class
#ENDIF #!Not Return class
#ENDFOR
#ENDIF
#!**************************************************************************
#GROUP(%SecondaryChanged)
#SET(%KeyFieldCounter,%Null)
#SET(%IfWritten,%Null)
#FOR(%Secondary) #! for fields on the form
#IF(%SecondaryType = 'MANY:1') #!Check for lookup files
#FIX(%File,%SecondaryTo)
#FIX(%Relation,%Secondary)
#FOR(%RelationKeyField)
#IF(RelationKeyFieldLink)
#SET(%KeyFieldCounter,(%KeyFieldCounter+1))
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#FIX(%File,%Primary)
#IF(%KeyFieldCounter)
#FOR(%Secondary) #! for fields on the form
#IF(%SecondaryType = 'MANY:1') #!Check for lookup files
#FIX(%File,%SecondaryTo)
#FIX(%Relation,%Secondary)
#FOR(%RelationKeyField)
#IF(RelationKeyFieldLink)
#IF(%KeyFieldCounter='1')
#IF(%IfWritten)
OR %RelationKeyField <> %RelationKeyFieldLink #<!Check for changes
#ELSE
IF %RelationKeyField <> %RelationKeyFieldLink #<!Check for changes
#ENDIF
#BREAK
#ELSE
#IF(%IfWritten)
OR %RelationKeyField <> %RelationKeyFieldLink | #<!Check for changes
#ELSE
IF %RelationKeyField <> %RelationKeyFieldLink |#<!Check for changes
#SET(%IfWritten,'TRUE')
#ENDIF
#SET(%KeyFieldCounter,(%KeyFieldCounter-1))
#ENDIF
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
DO SecondaryLookups #<!Call lookup Routine
END
#ENDIF
#!***************************************************************************
#GROUP(%FieldDups)
#FOR(%ScreenField)
#IF(%ScreenFieldUse)
#SET(%Fld,%ScreenFieldUse)
#FIX(%Field,%ScreenFieldUse)
#IF(SUB(%Fld,1,1) <> '?')
#IF(%FieldID)
#IF(UPPER(%FieldFile) = UPPER(%Primary))
#IF(%FieldDimension1)
#IF(INSTRING(%Field,%DimPool,1,1) = '0')
#SET(%DimPool,(%DimPool & ',' & %Field))
Dup::%Field LIKE(%Field)
#ENDIF
#ELSE
#IF(%FieldType = 'GROUP')
Dup::%ScreenFieldUse LIKE(%ScreenFieldUse),PRE(Dup)
#ELSE
Dup::%ScreenFieldUse LIKE(%ScreenFieldUse)
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%SaveScrFlds)
!─────────────────────────────────────────────────────────────────────────────
SaveScrFlds ROUTINE
#FOR(%ScreenField)
#IF(%ScreenFieldUse)
#SET(%Fld,%ScreenFieldUse)
#FIX(%Field,%ScreenFieldUse)
#IF(SUB(%Fld,1,1) <> '?')
#IF(%FieldID)
#IF(UPPER(%FieldFile) = UPPER(%Primary))
Dup::%ScreenFieldUse = %ScreenFieldUse #<!Save screen entry
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
#!***************************************************************************
#GROUP(%DupFldCall)
IF KEYCODE() = %CopyKey #<!User requested field copy
DO DupField #<!Call duplication Routine
END #<!End copy key check
#!***************************************************************************
#GROUP(%DupField)
!─────────────────────────────────────────────────────────────────────────────
DupField ROUTINE
CASE SELECTED() !Which field is selected?
#FOR(%ScreenField)
#IF(%ScreenFieldUse)
#SET(%Fld,%ScreenFieldUse)
#FIX(%Field,%ScreenFieldUse)
#IF(SUB(%Fld,1,1) <> '?')
#IF(%FieldID)
#IF(UPPER(%FieldFile) = UPPER(%Primary))
OF ?%ScreenFieldUse
%ScreenFieldUse = Dup::%ScreenFieldUse #<!Move saved entry to screen
#ENDIF
#ENDIF
#ENDIF
#ENDIF
#ENDFOR
END #<!End Case Selected
DISPLAY #<!Update screen display
#!***************************************************************************
#GROUP(%InitButtonExist)
#FIX(%ScreenField,'?Previous_Page')
#IF(%ScreenField)
#SET(%PrevExist,'1')
#ELSE
#SET(%PrevExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Next_Page')
#IF(%ScreenField)
#SET(%NextExist,'1')
#ELSE
#SET(%NextExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Base_Page')
#IF(%ScreenField)
#SET(%BaseExist,'1')
#ELSE
#SET(%BaseExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Last_Page')
#IF(%ScreenField)
#SET(%LastExist,'1')
#ELSE
#SET(%LastExist,%NULL)
#ENDIF
#FIX(%ScreenField,'?Ok')
#IF(%ScreenField)
#SET(%OkayExist,'1')
#ELSE
#SET(%OkayExist,%NULL)
#ENDIF
#!***************************************************************************
#GROUP(%AltKeys)
#IF(%Page2Proc)
OF Alt2 !Hotkey to Page 2
PRESS(AltN) !Press Next_Page Key
#ENDIF
#IF(%Page3Proc)
OF Alt3 !Hotkey to Page 3
LOC:Page = 2 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page4Proc)
OF Alt4 !Hotkey to Page 4
LOC:Page = 3 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page5Proc)
OF Alt5 !Hotkey to Page 5
LOC:Page = 4 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page6Proc)
OF Alt6 !Hotkey to Page 6
LOC:Page = 5 !Press Next_Page Key
PRESS(AltN)
#ENDIF
#IF(%Page7Proc)
OF Alt7
LOC:Page = 6 !Hotkey to Page 7
PRESS(AltN) !Press Next_Page Key
#ENDIF
#IF(%Page8Proc)
OF Alt8
LOC:Page = 7 !Hotkey to Page 8
PRESS(AltN) !Press Next_Page Key
#ENDIF
#IF(%Page9Proc)
OF Alt9
LOC:Page = 8 !Hotkey to Page 9
PRESS(AltN) !Press Next_Page Key
#ENDIF
#!***************************************************************************
#GROUP(%ProcCounter)
#IF(%Page2Proc)
#SET(%ProcCount,'2')
#IF(%Page3Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page4Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page5Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page6Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page7Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page8Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#IF(%Page9Proc)
#SET(%ProcCount,(%ProcCount + 1))
#ENDIF
#ENDIF
#!***************************************************************************
#GROUP(%SavePrimedFields)
#FOR(%Key)
#IF(%KeyAuto)
#FOR(%KeyField)
#IF(%KeyField <> %KeyAuto)
Prime::%KeyField LIKE(%KeyField)
#ENDIF
#ENDFOR
#ENDIF
#ENDFOR
#CHAIN('MiscGrps.TPX')