PC Direct 1996 May

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

/ PC Direct 1996 May / PCDMAY.ISO / software / clarion / 3rdparty / tools / library / twfix2.exe / TCTLBRW4.TPW < prev next >

Wrap

Text File | 1995-04-23 | 26.5 KB | 852 lines

#!########################################################################### #! TCtlBrw4.TPW #! #! #! Code Templates #! ------------------ #! TCountTags - Count the Number of Tagged Records in a given #! Tag Set Number #! TCopyTags - Copy Tags from one Tag Set to Another #! TTagCurrentRecord - Tags or Flips the Current Record #! TUnTagCurrentRecord - UnTag Current Record #! TClearTags - Clear All the tags for the given Tag Set #! TProcessTags - Writes code to loop through all tags, and #! do some sort of processing with each record. #! #!########################################################################### #! #! #! #!************************************************************************** #! Name ............: TCountTags #! Description......: This Code Template calls the tag library function #! Process Tags to get the number of tagged records... #!************************************************************************** #CODE(TCountTags,'TABOGA-Counts The Number of Tagged Records') #RESTRICT #ENDRESTRICT #DISPLAY('This Code Template is used to COUNT the Number of') #DISPLAY('Tagged Records in the Given Tag Set Number.') #DISPLAY('') #DISPLAY('') #PROMPT ('Show Message w/Count?:', CHECK), %TABShowMessage,DEFAULT(1) #DISPLAY('') #PROMPT ('&Tagging To:', DROP ('To a File|To a Memory Queue|File FIELD')), %TABTagging, DEFAULT('To a File') #BOXED(''), AT( ,72), WHERE(%TABTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABTagSet,REQ #DISPLAY('Enter UserID Number, or the variable to use as') #DISPLAY('UserID, or leave it Blank for a single User') #PROMPT ('User &ID :', @S60), %TABUserID #ENDBOXED #BOXED(''), AT( ,72), WHERE(%TABTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%Primary)), %TABTagField, REQ #PROMPT ('Fil&e to Use', FILE), %TABFile2Use, REQ #ENDBOXED #DISPLAY('') #DISPLAY('') #DISPLAY('This code templates introduces a variable called TABLong which ') #DISPLAY('is set to the NUMBER OF TAGGED RECORDS. If desired, a MESSAGE ') #DISPLAY('appears showing that number...') #! #LOCALDATA TABShort SHORT ! Multi purpose SHORT variable TABLong LONG ! Multi purpose LONG variable #ENDLOCALDATA #! #ATSTART #DECLARE(%TABCountEquates) #DECLARE(%TABUsingFile) #IF (%TABTagging = 'To a File') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 5) #ELSE #SET(%TABUsingFile, 9) #ENDIF #ELSIF (%TABTagging = 'To a Memory Queue') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 6) #ELSE #SET(%TABUsingFile, 10) #ENDIF #ENDIF #IF(~%TABUserID) #SET(%TABUserID, '0') #ENDIF #ENDAT #! #AT (%DataSectionBeforeWindow), WHERE(%TABCountEquates = %Null AND %TABTagging <> 'File FIELD') ! Count Tags Function codes... eCountTags EQUATE(1) #<! Count Tags #SET(%TABCountEquates, %True) #ENDAT #! #! #! #! #IF(%ControlEvent='Accepted') #IF(%TABTagging <> 'File FIELD') TABLong = ProcessTags(eCountTags, %TABUsingFile, %TABUserID, %TABTagSet) #ELSE TABLong = 0 SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() THEN BREAK. IF %TABTagField TABLong += 1 . . #ENDIF #! IF TABTagging <> 'File FIELD' #IF(%TABShowMessage) TABShort = MESSAGE('No of Records Tagged: ' & TABLong,'Records Tagged', ICON:Exclamation, Button:OK, BUTTON:OK,0) #ENDIF #ELSE #ERROR('Count Tags Code Template must be used for Accepted Control Events!') #ENDIF #! #! #! #!************************************************************************** #! Name ............: TCopyTags #! Description......: This Code Template copies tags from one TagSetNo #! to another. #!************************************************************************** #CODE(TCopyTags,'TABOGA-Copies a Set of Tagged Records to Another Set') #RESTRICT #ENDRESTRICT #DISPLAY('This Code Template is used to COPY the Tags from') #DISPLAY('one TagSet to Another...') #DISPLAY('') #PROMPT ('&Erase Destination Tags?:', DROP('Yes|No|Ask User')), %TABEraseTags,DEFAULT('Ask User') #ENABLE(%TABEraseTags = 'Ask User'),CLEAR #PROMPT ('Question to Ask User?:',@S40), %TABTagAskQuestion, REQ, DEFAULT('Would You Like to Remove Existing Tags From Destination?') #PROMPT ('Message Icon?:',DROP('ICON:Question|ICON:Exclamation|ICON:Asterisk')), %TABTagAskICON, DEFAULT('ICON:Question') #ENDENABLE #DISPLAY('') #PROMPT ('File Being Used:', FILE),%TABFile2Use,REQ #BOXED('Original Tag Set') #PROMPT ('&Tagged To :', DROP ('To a File|To a Memory Queue|File FIELD')), %TABOrigTagging, DEFAULT('To a File') #BOXED(''), AT( ,108), WHERE(%TABOrigTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABOrigPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABOrigTagSet,REQ #PROMPT ('User &ID :', @S60), %TABOrigUserID #ENDBOXED #BOXED(''), AT( ,108), WHERE(%TABOrigTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%TABFile2Use)), %TABOrigTagField, REQ #ENDBOXED #ENDBOXED #BOXED('Destination Tag Set') #PROMPT ('&Tagged To :', DROP ('To a File|To a Memory Queue|File FIELD')), %TABDestTagging, DEFAULT('To a File') #BOXED(''), AT( ,182), WHERE(%TABDestTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABDestPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABDestTagSet,REQ #PROMPT ('User &ID :', @S60), %TABDestUserID #ENDBOXED #BOXED(''), AT( ,182), WHERE(%TABDestTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%TABFile2Use)), %TABDestTagField, REQ #ENDBOXED #ENDBOXED #! #! #LOCALDATA TABShort SHORT ! Multi purpose SHORT variable TABLong LONG ! Multi purpose LONG variable #ENDLOCALDATA #! #ATSTART #DECLARE(%TABOrigUsingFile) #DECLARE(%TABDestUsingFile) #DECLARE(%TABCopyEquates) #IF (%TABOrigTagging = 'To a File') #IF(%TABOrigPosition = 'Pointer') #SET(%TABOrigUsingFile, 5) #ELSE #SET(%TABOrigUsingFile, 9) #ENDIF #ELSIF (%TABOrigTagging = 'To a Memory Queue') #IF(%TABOrigPosition = 'Pointer') #SET(%TABOrigUsingFile, 6) #ELSE #SET(%TABOrigUsingFile, 10) #ENDIF #ELSIF (%TABOrigTagging = 'File FIELD') #SET(%TABOrigUsingFile, 16) #ENDIF #IF (%TABDestTagging = 'To a File') #IF(%TABDestPosition = 'Pointer') #SET(%TABDestUsingFile, 5) #ELSE #SET(%TABDestUsingFile, 9) #ENDIF #ELSIF (%TABDestTagging = 'To a Memory Queue') #IF(%TABDestPosition = 'Pointer') #SET(%TABDestUsingFile, 6) #ELSE #SET(%TABDestUsingFile, 10) #ENDIF #ELSIF (%TABDestTagging = 'File FIELD') #SET(%TABDestUsingFile, 16) #ENDIF #IF(~%TABOrigUserID) #SET(%TABOrigUserID, '0') #ENDIF #IF(~%TABDestUserID) #SET(%TABDestUserID, '0') #ENDIF #DECLARE(%TABFieldType) #DECLARE(%TABIsString) #IF (%TABOrigTagging = 'File FIELD') #DECLARE(%TABOrigIsString) #FIND(%Field,%TABOrigTagField) #INSERT(%TABCheckIfString,%FieldType,%TABIsString) #SET(%TABOrigIsString, %TABIsString) #ENDIF #IF (%TABDestTagging = 'File FIELD') #DECLARE(%TABDestIsString) #FIND(%Field,%TABDestTagField) #INSERT(%TABCheckIfString,%FieldType,%TABIsString) #SET(%TABDestIsString, %TABIsString) #ENDIF #ENDAT #! #AT (%DataSectionBeforeWindow), WHERE(%TABCopyEquates = %Null) ! Copy Tags Function codes... eCopyTags EQUATE(2) #<! Copy Tags #SET(%TABCopyEquates, %True) #ENDAT #! #! #!----------------------------------- #IF(%ControlEvent='Accepted') #!----------------------------------- #! #!--------- #! If neither is to a File Field... #IF(%TABOrigUsingFile <> 16 AND %TABDestUsingFile <> 16) #!--------- #! #CASE(%TABEraseTags) #OF('Yes') ClearTags(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet) #OF('No') #OF('Ask User') IF Tags(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet) IF MESSAGE('%TABTagAskQuestion','Erase Destination Tags?', %TABTagAskICON, Button:Yes+Button:No, BUTTON:No,0) = Button:Yes ClearTags(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet) . . #ENDCASE TABLong = ProcessTags(eCopyTags, %TABOrigUsingFile, %TABOrigUserID, %TABOrigTagSet, %TABDestUsingFile, %TABDestUserID, %TABDestTagSet, %TABFile2Use) #! #!---------- #ELSIF (%TABOrigUsingFile = 16 AND %TABDestUsingFile <> 16) #!---------- #! #CASE(%TABEraseTags) #OF('Yes') ClearTags(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet) #OF('No') #OF('Ask User') IF Tags(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet) IF MESSAGE('%TABTagAskQuestion','Erase Destination Tags?', %TABTagAskICON, Button:Yes+Button:No, BUTTON:No,0) = Button:Yes ClearTags(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet) . . #ENDCASE SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. ! EOF() IF ~%TABOrigTagField THEN CYCLE. ! Cycle those that are not tagged... #IF(%TABDestPosition = 'Pointer') SetTag(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet, POINTER(%TABFile2Use), 1) #ELSE SetTagPos(%TABDestUsingFile, %TABDestUserID, %TABDestTagSet, POSITION(%TABFile2Use), 1) #ENDIF . #! #!-------- #! Destination is to a File Field #ELSIF (%TABOrigUsingFile <> 16 AND %TABDestUsingFile = 16) #!--------- #! #CASE(%TABEraseTags) #OF('Yes') SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. #<! EOF() IF ~%TABDestTagField THEN CYCLE. #<! Cycle those that are not tagged... #IF(%TABDestIsString) %TABDestTagField = '' #ELSE %TABDestTagField = 0 #ENDIF PUT(%TABFile2Use) . #OF('No') #OF('Ask User') TABShort = FALSE SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. #<! EOF() IF %TABDestTagField TABShort = TRUE BREAK . . IF TABShort IF MESSAGE('%TABTagAskQuestion','Erase Destination Tags?', %TABTagAskICON, Button:Yes+Button:No, BUTTON:No,0) = Button:Yes SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. #<! EOF() IF ~%TABDestTagField THEN CYCLE. #<! Cycle those that are not tagged... #IF(%TABDestIsString) %TABDestTagField = '' #ELSE %TABDestTagField = 0 #ENDIF PUT(%TABFile2Use) . . . #ENDCASE #IF (%TABOrigTagging = 'To a File') #IF(%TABOrigPosition = 'Pointer') CLEAR(Tag:RECORD) Tag:UserID = %TABOrigUserID Tag:TagSetNo = %TABOrigTagSet SET(Tag:By_FilePTR,Tag:By_FilePTR) LOOP NEXT(TagFILE) IF ERRORCODE() then BREAK. ! EOF() IF Tag:UserID <> UserID OR Tag:TagSetNo <> TagSetNo then BREAK. GET(%TABFile2Use, TAG:FilePtr) IF ERRORCODE() then CYCLE. ! Record Not There Anymore #IF(%TABDestIsString) %TABDestTagField = 'Tagged' #ELSE %TABDestTagField = 1 #ENDIF PUT(%TABFile2Use) . #! #ELSE #! CLEAR(TaP:RECORD) TaP:UserID = %TABUserID TaP:TagSetNo = %TABTagSet SET(TaP:By_FilePTR,TaP:By_FilePTR) LOOP NEXT(TagFILEPOS) IF ERRORCODE() then BREAK. ! EOF() IF TaP:UserID <> UserID OR TaP:TagSetNo <> TagSetNo then BREAK. REGET(%TABFile2Use, TaP:FilePtr) IF ERRORCODE() then CYCLE. ! Record Not There Anymore #IF(%TABDestIsString) %TABDestTagField = 'Tagged' #ELSE %TABDestTagField = 1 #ENDIF PUT(%TABFile2Use) . #! #ENDIF #! #ELSIF (%TABOrigTagging = 'To a Memory Queue') #IF(%TABOrigPosition = 'Pointer') #! eExternalProcess = 3 TABLong = 1 #<! Set to start processing... LOOP IF ~ProcessTags(3, %TABOrigUsingFile, %TABOrigUserID, %TABOrigTagSet,TABLong,,,%TABFile2Use) THEN BREAK. #IF(%TABDestIsString) %TABDestTagField = 'Tagged' #<! Tag the Tag Field on the current record. #ELSE %TABDestTagField = 1 #<! Tag the Tag Field on the current record. #ENDIF PUT(%TABFile2Use) TABLong = 0 #<! turn starting flag OFF . #ELSE #! eExternalProcess = 3 TABLong = 1 #<! Set to start processing... LOOP IF ~ProcessTags(3, %TABOrigUsingFile, %TABOrigUserID, %TABOrigTagSet,TABLong,,,%TABFile2Use) THEN BREAK. #IF(%TABDestIsString) %TABDestTagField = 'Tagged' #<! Tag the Tag Field on the current record. #ELSE %TABDestTagField = 1 #<! Tag the Tag Field on the current record. #ENDIF PUT(%TABFile2Use) TABLong = 0 #<! turn starting flag OFF . #ENDIF #! Pointer or Position #ENDIF #! File or Queue #! #!----------#! Original and Destination are File Field #ELSIF (%TABOrigUsingFile = 16 AND %TABDestUsingFile = 16) #!---------- #! #CASE(%TABEraseTags) #OF('Yes') SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. ! EOF() IF ~%TABDestTagField THEN CYCLE. ! Cycle those that are not tagged... #IF(%TABDestIsString) %TABDestTagField = '' #ELSE %TABDestTagField = 0 #ENDIF PUT(%TABFile2Use) . #OF('No') #OF('Ask User') TABShort = FALSE SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. #<! EOF() IF %TABDestTagField TABShort = TRUE BREAK . . IF TABShort IF MESSAGE('%TABTagAskQuestion','Erase Destination Tags?', %TABTagAskICON, Button:Yes+Button:No, BUTTON:No,0) = Button:Yes SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. ! EOF() IF ~%TABDestTagField THEN CYCLE. ! Cycle those that are not tagged... #IF(%TABDestIsString) %TABDestTagField = '' #ELSE %TABDestTagField = 0 #ENDIF PUT(%TABFile2Use) . . . #ENDCASE SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. ! EOF() IF ~%TABOrigTagField THEN CYCLE. ! Cycle those that are not tagged... #IF(%TABDestIsString) %TABDestTagField = 'Tagged' #ELSE %TABDestTagField = 1 #ENDIF PUT(%TABFile2Use) . #! #! #ENDIF #! #! #!----------------------------------- #ELSE #!----------------------------------- #ERROR('Copy Tags Code Template must be used for Accepted Control Events!') #ENDIF #! #! #! #!************************************************************************** #! Name ............: TTagOneRecord #! Description......: This Code Template Tags, or Flips the Current Record #!************************************************************************** #CODE(TTagOneRecord,'TABOGA-Tags or Flips the Current Record') #! #DISPLAY('This Code Template Tags or Flips the Current Record') #DISPLAY('') #PROMPT ('Tagging Mode:', DROP('Tag Only|Flip Record')),%TABTagMode,DEFAULT('Tag Only') #DISPLAY('') #PROMPT ('File Being Used:', FILE),%TABFile2Use,REQ #PROMPT ('&Tagging To:', DROP ('To a File|To a Memory Queue|File FIELD')), %TABTagging, DEFAULT('To a File') #BOXED(''), AT( ,64), WHERE(%TABTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABTagSet,REQ #DISPLAY('Enter UserID Number, or the variable to use as') #DISPLAY('UserID, or leave it Blank for a single User') #PROMPT ('User &ID :', @S60), %TABUserID #PROMPT ('User Provided Order?',CHECK),%TABTagProvideOrder #ENABLE (%TABTagProvideOrder),CLEAR #PROMPT('&Order to Use',@s80),%TABTagOrder #ENDENABLE #ENDBOXED #BOXED(''), AT( ,64), WHERE(%TABTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%Primary)), %TABTagField, REQ #ENDBOXED #DISPLAY('') #! #ATSTART #DECLARE(%TABTagModeCode) #IF(%TABTagMode = 'Tag Only') #SET(%TABTagModeCode , 1) #ELSE #SET(%TABTagModeCode , 4) #ENDIF #DECLARE(%TABUsingFile) #IF (%TABTagging = 'To a File') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 5) #ELSE #SET(%TABUsingFile, 9) #ENDIF #ELSIF (%TABTagging = 'To a Memory Queue') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 6) #ELSE #SET(%TABUsingFile, 10) #ENDIF #ELSIF (%TABTagging = 'File FIELD') #SET(%TABUsingFile, 16) #ENDIF #IF(~%TABUserID) #SET(%TABUserID, '0') #ENDIF #DECLARE(%TABFieldType) #DECLARE(%TABIsString) #IF (%TABTagging = 'File FIELD') #FIND(%Field,%TABTagField) #INSERT(%TABCheckIfString,%FieldType,%TABIsString) #ENDIF #ENDAT #! #! eTagRecord 1 #! eUnTagRecord 2 #! eFlip 4 #! #! #IF(%TABTagging <> 'File FIELD') #IF(%TABPosition = 'Pointer') #IF(%TABTagProvideOrder) SetTag(%TABUsingFile, %TABUserID, %TABTagSet, POINTER(%TABFile2Use), %TABTagModeCode, %TABTagOrder) #ELSE SetTag(%TABUsingFile, %TABUserID, %TABTagSet, POINTER(%TABFile2Use), %TABTagModeCode) #ENDIF #ELSE #IF(%TABTagProvideOrder) SetTagPos(%TABUsingFile, %TABUserID, %TABTagSet, POSITION(%TABFile2Use), %TABTagModeCode, %TABTagOrder) #ELSE SetTagPos(%TABUsingFile, %TABUserID, %TABTagSet, POSITION(%TABFile2Use), %TABTagModeCode) #ENDIF #ENDIF #ELSE #! IF %TABTagging = 'File FIELD' #IF(%TABTagMode = 'Tag Only') #IF (%TABIsString) %TABTagField = 'Tagged' #ELSE %TABTagField = 1 #ENDIF #ELSE #! Allow flips... #IF (%TABIsString) IF %TABTagField %TABTagField = '' ELSE %TABTagField = 'Tagged' . #ELSE %TABTagField = BXOR(%TABTagField,1) #ENDIF #ENDIF PUT(%TABFile2Use) #<! Save the changed record #ENDIF #! IF TABTagging = <> 'File FIELD' #! #! #!************************************************************************** #! Name ............: TUnTagOneRecord #! Description......: This Code Template untags the current record #!************************************************************************** #CODE(TUnTagOneRecord,'TABOGA-UnTags the Current Record') #! #DISPLAY('This Code Template UnTags the Current Record') #DISPLAY('') #PROMPT ('File Being Used:', FILE),%TABFile2Use,REQ #PROMPT ('&Tagging To:', DROP ('To a File|To a Memory Queue|File FIELD')), %TABTagging, DEFAULT('To a File') #BOXED(''), AT( ,48), WHERE(%TABTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABTagSet,REQ #DISPLAY('Enter UserID Number, or the variable to use as') #DISPLAY('UserID, or leave it Blank for a single User') #PROMPT ('User &ID :', @S60), %TABUserID #ENDBOXED #BOXED(''), AT( ,48), WHERE(%TABTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%Primary)), %TABTagField, REQ #ENDBOXED #DISPLAY('') #! #! #ATSTART #DECLARE(%TABTagModeCode) #SET(%TABTagModeCode , 2) #DECLARE(%TABUsingFile) #IF (%TABTagging = 'To a File') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 5) #ELSE #SET(%TABUsingFile, 9) #ENDIF #ELSIF (%TABTagging = 'To a Memory Queue') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 6) #ELSE #SET(%TABUsingFile, 10) #ENDIF #ENDIF #IF(~%TABUserID) #SET(%TABUserID, '0') #ENDIF #IF (%TABTagging = 'File FIELD') #FIND(%Field,%TABTagField) #INSERT(%TABCheckIfString,%FieldType,%TABIsString) #ENDIF #ENDAT #! #! eTagRecord 1 #! eUnTagRecord 2 #! eFlip 4 #! #! #IF(%TABTagging <> 'File FIELD') #IF(%TABPosition = 'Pointer') SetTag(%TABUsingFile, %TABUserID, %TABTagSet, POINTER(%TABFile2Use), %TABTagModeCode) #ELSE SetTagPos(%TABUsingFile, %TABUserID, %TABTagSet, POSITION(%TABFile2Use), %TABTagModeCode) #ENDIF #ELSIF (%TABTagging = 'File FIELD') #IF (%TABIsString) %TABTagField = '' #ELSE %TABTagField = 0 #ENDIF PUT(%TABFile2Use) #ENDIF #! #! #! #! #!************************************************************************** #! Name ............: TClearTags #! Description......: This Code Template Clears all the given TagSet tags #!************************************************************************** #CODE(TClearTags,'TABOGA-Clears all the Given TagSet tags') #! #DISPLAY('This Code Template Clears all the Given TagSet Tags') #DISPLAY('') #PROMPT ('&Tagging To:', DROP ('To a File|To a Memory Queue|File FIELD')), %TABTagging, DEFAULT('To a File') #BOXED(''), AT( ,40), WHERE(%TABTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABTagSet,REQ #DISPLAY('Enter UserID Number, or the variable to use as') #DISPLAY('UserID, or leave it Blank for a single User') #PROMPT ('User &ID :', @S60), %TABUserID #ENDBOXED #BOXED(''), AT( ,40), WHERE(%TABTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%Primary)), %TABTagField, REQ #PROMPT ('Fil&e to Use', FILE), %TABFile2Use, REQ #ENDBOXED #DISPLAY('') #! #! #ATSTART #DECLARE(%TABUsingFile) #IF (%TABTagging = 'To a File') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 5) #ELSE #SET(%TABUsingFile, 9) #ENDIF #ELSIF (%TABTagging = 'To a Memory Queue') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 6) #ELSE #SET(%TABUsingFile, 10) #ENDIF #ENDIF #IF(~%TABUserID) #SET(%TABUserID, '0') #ENDIF #DECLARE(%TABFieldType) #DECLARE(%TABIsString) #IF (%TABTagging = 'File FIELD') #FIND(%Field,%TABTagField) #INSERT(%TABCheckIfString,%FieldType,%TABIsString) #ENDIF #ENDAT #! #! #! #IF(%TABTagging <> 'File FIELD') ClearTags(%TABUsingFile, %TABUserID, %TABTagSet) #ELSE SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() THEN BREAK. IF %TABTagField #IF (%TABIsString) %TABTagField = '' #ELSE %TABTagField = 0 #ENDIF PUT(%TABFile2Use) . . #ENDIF #! #! #!************************************************************************** #! Name ............: TProcessTags #! Description......: This Code Template sets up a Loop that will go #! through all the tags, and allow for some processing. #!************************************************************************** #CODE(TProcessTags,'TABOGA-Go Through All Tags for the Given TagSet') #! #DISPLAY('This Code Template Goes Through all the given TagSet Tags') #DISPLAY(' If you need to perform some CODE for each of the Tags,') #DISPLAY(' set this code up in the two prompts provided for this.') #DISPLAY('') #PROMPT ('File Being Used:', FILE),%TABFile2Use,REQ #PROMPT ('&Tagging To:', DROP ('To a File|To a Memory Queue|File FIELD')), %TABTagging, DEFAULT('To a File') #BOXED(''), AT( ,64), WHERE(%TABTagging <> 'File FIELD'), CLEAR #PROMPT ('File Positio&n Type:', DROP ('Pointer|Position')), %TABPosition, DEFAULT('Pointer') #PROMPT ('Ta&g Set No. :', @n04), %TABTagSet #ENABLE(~%TABTagSet),CLEAR #PROMPT('Variable as Tag Set:',@S25),%TABTagSetVar #ENDENABLE #DISPLAY('Enter UserID Number, or the variable to use as') #DISPLAY('UserID, or leave it Blank for a single User') #PROMPT ('User &ID :', @S60), %TABUserID #ENDBOXED #BOXED(''), AT( ,64), WHERE(%TABTagging = 'File FIELD'), CLEAR #PROMPT ('&Field to Hold Tags', FIELD(%Primary)), %TABTagField, REQ #ENDBOXED #DISPLAY('Use the following two Prompts to enter the Code'),AT(10,,175) #DISPLAY('to execute for Processing Tagged Records...:'),AT(10,,175) #PROMPT ('', @s255),%ProcessTaggedRecords1,AT(10,,250) #PROMPT ('', @s255),%ProcessTaggedRecords2,AT(10,,250) #DISPLAY('') #DISPLAY('') #! #! #LOCALDATA TABLong LONG ! Multi purpose LONG variable #ENDLOCALDATA #! #ATSTART #DECLARE(%TABTagSetNo) #IF(~%TABUserID) #SET(%TABUserID, '0') #ENDIF #IF(%TABTagSet) #SET(%TABTagSetNo, %TABTagSet) #ELSE #SET(%TABTagSetNo, %TABTagSetVar) #ENDIF #! #DECLARE(%TABUsingFile) #IF (%TABTagging = 'To a File') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 5) #ELSE #SET(%TABUsingFile, 9) #ENDIF #ELSIF (%TABTagging = 'To a Memory Queue') #IF(%TABPosition = 'Pointer') #SET(%TABUsingFile, 6) #ELSE #SET(%TABUsingFile, 10) #ENDIF #ENDIF #! #ENDAT #! #! #IF (%TABTagging = 'To a File') #IF(%TABPosition = 'Pointer') CLEAR(Tag:RECORD) Tag:UserID = %TABUserID Tag:TagSetNo = %TABTagSetNo SET(Tag:By_FilePTR,Tag:By_FilePTR) LOOP NEXT(TagFILE) IF ERRORCODE() then BREAK. ! EOF() IF Tag:UserID <> %TABUserID OR Tag:TagSetNo <> %TABTagSetNo then BREAK. GET(%TABFile2Use, TAG:FilePtr) IF ERRORCODE() then CYCLE. ! Record Not There Anymore #IF(%ProcessTaggedRecords1) %ProcessTaggedRecords1 #ENDIF #IF(%ProcessTaggedRecords2) %ProcessTaggedRecords2 #ENDIF . #! #ELSE #! CLEAR(TaP:RECORD) TaP:UserID = %TABUserID TaP:TagSetNo = %TABTagSetNo SET(TaP:By_FilePTR,TaP:By_FilePTR) LOOP NEXT(TagFILEPOS) IF ERRORCODE() then BREAK. ! EOF() IF TaP:UserID <> %TABUserID OR TaP:TagSetNo <> %TABTagSetNo then BREAK. REGET(%TABFile2Use, TaP:FilePtr) IF ERRORCODE() then CYCLE. ! Record Not There Anymore #IF(%ProcessTaggedRecords1) %ProcessTaggedRecords1 #ENDIF #IF(%ProcessTaggedRecords2) %ProcessTaggedRecords2 #ENDIF . #! #ENDIF #! #ELSIF (%TABTagging = 'To a Memory Queue') #IF(%TABPosition = 'Pointer') #! eExternalProcess = 3 TABLong = 1 #<! Set to start processing... LOOP IF ~ProcessTags(3, %TABUsingFile, %TABUserID, %TABTagSet,TABLong,,,%TABFile2Use) THEN BREAK. #IF(%ProcessTaggedRecords1) %ProcessTaggedRecords1 #ENDIF #IF(%ProcessTaggedRecords2) %ProcessTaggedRecords2 #ENDIF TABLong = 0 #<! turn starting flag OFF . #ELSE #! eExternalProcess = 3 TABLong = 1 #<! Set to start processing... LOOP IF ~ProcessTags(3, %TABUsingFile, %TABUserID, %TABTagSet,TABLong,,,%TABFile2Use) THEN BREAK. #IF(%ProcessTaggedRecords1) %ProcessTaggedRecords1 #ENDIF #IF(%ProcessTaggedRecords2) %ProcessTaggedRecords2 #ENDIF TABLong = 0 #<! turn starting flag OFF . #ENDIF #ELSIF (%TABTagging = 'File FIELD') SET(%TABFile2Use) LOOP NEXT(%TABFile2Use) IF ERRORCODE() then BREAK. ! EOF() IF ~%TABTagField THEN CYCLE. ! Cycle those that are not tagged... #IF(%ProcessTaggedRecords1) %ProcessTaggedRecords1 #ENDIF #IF(%ProcessTaggedRecords2) %ProcessTaggedRecords2 #ENDIF . #ENDIF #! #! #!