Compile function Archive_Services(@Service, @Params) #pragma precomp SRP_PreCompiler $Insert SERVICE_SETUP $insert LOGICAL $insert APP_INSERTS $Insert WO_LOG_EQUATES $Insert WO_STEP_EQUATES $Insert RDS_EQUATES $Insert REACT_RUN_EQUATES $Insert RDS_LAYER_EQUATES $Insert RDS_TEST_EQUATES $Insert ARCHIVE_EQUATES $Insert RLIST_EQUATES $Insert ARCHIVE_QUEUE_EQUATES $Insert DELETE_QUEUE_EQUATES $Insert DELETE_QUEUE_ERROR_EQUATES $Insert ARCHIVE_QUEUE_ERROR_EQUATES $insert SRPJSONX EQU COMMA$ To ',' Declare subroutine Change_Log_Services, Logging_Services, Error_Services, Database_Services Declare subroutine Set_Status, Set_MFS, Btree.Extract, Archive_Services, Delay Declare function SRP_Datetime, Logging_Services, Environment_Services, Datetime, RTI_CreateGUID Declare function Database_Services, Wo_Mat_Services, Error_Services, RDS_Services, RTI_OS_Directory Declare function WM_In_Services, WM_Out_Services, DirExists, Archive_Services, Work_Order_Services Declare function email_Services, UCase, Date_Services LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive' LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ArchiveService.csv' Headers = 'Logging DTM' : @FM : 'Message' : @FM : 'Cutoff Date' objLogArchiveService = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$) LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM OPTIONS ARCHIVE_TYPES = 'WO_LOG' GoToService Return Response or "" //----------------------------------------------------------------------------- // SERVICES //----------------------------------------------------------------------------- /* RunArchive Step 1.1 of data archiving procedures. Responsible for initiating the Archive Process by creating ARCHIVE records of a specified type. No return type. Parameters- ArchiveType - Determines what method will be run to generate the ARCHIVE record. */ Service RunArchive(ArchiveType=ARCHIVE_TYPES) hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then ErrorMsg = '' If ArchiveType NE '' then ArchiveSettings = Database_Services('ReadDataRow', 'APP_INFO', 'ARCHIVE_CONFIG') Locate ArchiveType in ArchiveSettings<1> using @VM setting ArchConfPos then YearsBackSetting = ArchiveSettings<2, ArchConfPos> CreatedArchiveRecId = '' KeysToArchive = '' Begin Case Case ArchiveType EQ 'WO_LOG' //Get WO_LOG Keys KeysToArchive = Work_Order_Services('GetClosedWOsToArchive', YearsBackSetting) if Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end Case Otherwise$ ErrorMsg = 'Invalid archive type.' End Case end else ErrorMsg = 'Archive settings not found in APP_INFO -> ARCHIVE_CONFIG.' end If ErrorMsg EQ '' then ArchiveRecordsIds = '' If KeysToArchive NE '' then ArchiveCountLimit = 30000 ArchiveCount = 0 for each Key in KeysToArchive using @VM Until ArchiveCount EQ ArchiveCountLimit CreatedArchiveRecId = Archive_Services('CreateArchiveRecord', Key, ArchiveType, False$, True$) If Error_Services('NoError') then If CreatedArchiveRecId NE '' then ArchiveRecordsIds<1, -1> = CreatedArchiveRecId ArchiveCount += 1 end end else ErrorMsg = Error_Services('GetMessage') end Next Key end Archive_Services('GenerateArchiveCreationReport', ArchiveRecordsIds) end end else ErrorMsg = 'Archive type was null.' end If ErrorMsg NE '' then Error_Services('Add', ErrorMsg) end Unlock hSysLists, ServiceKeyID else Null end end service /* CreateArchiveRecord Step 1.2 of data archiving procedures. Responsible for creating an ARCHIVE record for WO_LOG hierarchies. Returns the key ID for a record created in the ARCHIVE table. The key is a GUID string. Parameters- ParentRecordId - The key ID of the parent record. ArchiveType - The table of the parent record. */ Service CreateArchiveRecord(ParentRecordId, ArchiveType, ReArchive, AddToQueue) LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\ArchiveRecordCreation' LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ArchiveCreation.csv' Headers = 'Logging DTM' : @FM : 'Record Table' : @FM : 'Record Id' : @FM : 'Success' : @FM : 'Message' objRecordArchival = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$) ErrorMsg = '' ArchiveId = '' ArchiveSeq = 1 If ParentRecordId NE '' then If ArchiveType NE '' then if Not(ReArchive) then ArchiveId = ArchiveType : '*' : ParentRecordId : '*' : ArchiveSeq end else ValidId = False$ for ArchiveSeq = 1 to 99 Until ValidId = True$ ArchiveId = ArchiveType : '*' : ParentRecordId : '*' : ArchiveSeq If Not(RowExists('ARCHIVE', ArchiveId)) then ValidId = True$ end Next ArchiveSeq end If Not(RowExists('ARCHIVE', ArchiveId)) then ArchiveRecord = '' ChildRecords = '' Begin Case Case ArchiveType EQ 'WO_LOG' ChildRecords = Work_Order_Services('GetWOLogHierachy', ParentRecordId) MetaData = Work_Order_Services('GetWOMetaData', ParentRecordId) If Error_Services('NoError') then ChildRecordCount = DCount(ChildRecords, @VM) If ChildRecordCount LE 0 then ErrorMsg = '0 child records returned.' end end else ErrorMsg = Error_Services('GetMessage') end Case Otherwise$ ErrorMsg = 'Unsupported Archive Type.' End Case If ErrorMsg EQ '' then ArchivePath = Environment_Services('GetTextDataBackupRootDir'):ArchiveType:'\':ParentRecordId:'\':ArchiveSeq:'\' DirectoryCreated = RTI_OS_Directory( 'CREATE', ArchivePath) If DirectoryCreated then ArchiveRecord = Datetime() ArchiveRecord = ArchivePath ArchiveRecord = MetaData<1> ArchiveRecord = MetaData<2> ArchiveRecord = MetaData<3> for RecPos = 1 to DCount(ChildRecords<1>, @VM) ArchiveRecord = ChildRecords<1, RecPos> ArchiveRecord = ChildRecords<2, RecPos> ArchiveRecord = False$ ArchiveRecord = False$ Next i Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRecord) If Error_Services('NoError') then CreatedArchiveId = ArchiveId If AddToQueue then AddedToArchiveQueue = Archive_Services('AddToArchiveQueue', CreatedArchiveId) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Error creating text file backup directory.' end end end else ErrorMsg = 'Archive record already exists.' end end else ErrorMsg = 'Archive Type was null.' end end else ErrorMsg = 'Record ID was null.' end If ErrorMsg EQ '' then LogData = '' LogData<1> = LoggingDTM; LogData<2> = ArchiveType LogData<3> = ParentRecordId LogData<4> = True$ LogData<5> = 'Successfully created ARCHIVE record - ' : ArchiveId Logging_Services('AppendLog', objRecordArchival, LogData, @RM, @FM, False$) Response = ArchiveId end else LogData = '' LogData<1> = LoggingDTM; LogData<2> = ArchiveType LogData<3> = ParentRecordId LogData<4> = False$ LogData<5> = 'Error creating ARCHIVE record - ' : ErrorMsg Logging_Services('AppendLog', objRecordArchival, LogData, @RM, @FM, False$) Error_Services('Add', ErrorMsg) end end service /* AddToArchiveQueue Step 1.3 of data archiving procedures. Responsible for creating record in the ARCHIVE_QUEUE table. These records relate to an ARCHIVE record. Returns the GUID key ID of the ARCHIVE_QUEUE record created. Parameters- ArchiveId - The key ID of the ARCHIVE record which is being queued for child record archival. */ Service AddToArchiveQueue(ArchiveId) ErrorMsg = '' AddedToArchiveQueue = False$ If ArchiveId NE '' then If RowExists('ARCHIVE', ArchiveId) then ArchiveQueueId = RTI_CreateGUID() ArchiveQueueRec = '' ArchiveQueueRec = ArchiveId Database_Services('WriteDataRow', 'ARCHIVE_QUEUE', ArchiveQueueId, ArchiveQueueRec) If Error_Services('NoError') then AddedToArchiveQueue = True$ end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive record ' : ArchiveId : ' was not found in ARCHIVE table.' end end else ErrorMsg = 'Archive Id was null' end If ErrorMsg NE '' then Error_Services('Add', 'Error adding archive to archive queue : ' : ErrorMsg) end Response = AddedToArchiveQueue end service /* ProcessArchiveQueue Step 2.1 of data archiving procedures. Responsible for getting and looping through keys in the ARCHIVE_QUEUE table. Then processing the record with that key and passing it off to the ArchiveRecords service If the ArchiveRecords service returns true then deletes the ARCHIVE_QUEUE record. If the ArchiveRecords service returns false, then tranfers the ARCHIVE_QUEUE record to the ARCHIVE_QUEUE_ERROR table. Deletes the ARCHIVE_QUEUE record. Parameters- None. */ Service ProcessArchiveQueue() ErrorMsg = '' LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordArchiving' ServiceErrMsg = '' ServiceLogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ServiceLog.csv' ServiceHeaders = 'Logging DTM' : @FM : 'Message' ServiceLogObj = Logging_Services('NewLog', LogPath, ServiceLogFileName, CRLF$, ',', ServiceHeaders, '', False$, False$) hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then open 'ARCHIVE_QUEUE' to FileIn then SelectStmt = 'SELECT ARCHIVE_QUEUE' RList(SelectStmt,TARGET_ACTIVELIST$,'','','') Done = False$ loop readnext ArchiveQueueId else Done = 1 until Done ArchiveId = XLATE('ARCHIVE_QUEUE', ArchiveQueueId, ARCHIVE_QUEUE_ARCHIVE_ID$, 'X') Archive_Services('ArchiveRecords', ArchiveId, True$) If Error_Services('HasError') then ProcessError = Error_Services('GetMessage') Error_Services('Clear') ArchiveErrQueueRec = '' ArchiveErrQueueRec = ArchiveId ArchiveErrQueueRec = ProcessError Database_Services('WriteDataRow', 'ARCHIVE_QUEUE_ERROR', ArchiveQueueId, ArchiveErrQueueRec) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end Database_Services('DeleteDataRow', 'ARCHIVE_QUEUE', ArchiveQueueId, True$, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end Done = True$; // Limits service to run one record at a time. REPEAT end else ErrorMsg = 'Error opening RECORD_ARCHIVE_QUEUE table.' end // Service level Logging if ErrorMsg EQ '' then ServiceMessage = 'Archive queue service finished without error.' end else ServiceMessage = ErrorMsg end LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogData = '' LogData<1> = LoggingDTM LogData<2> = ServiceMessage Logging_Services('AppendLog', ServiceLogObj, LogData, @RM, @FM, False$) end Unlock hSysLists, ServiceKeyID else Null end service /* ArchiveRecords Step 2.2 of data archiving procedures. Responsible for looping through an ARCHIVE records CHILD_RECORDS field. Then for each record pass it to the ArchiveRecordToTxtFile service to be backed up(Or any new methods meant to back up a record). If all records successfully archive returns a True. If any records fail then processing of the ARCHIVE record pauses and returns a false. Parameters - ArchiveId - The key ID to the ARCHIVE record being processed. */ Service ArchiveRecords(ArchiveId, AddToDeleteQ) ErrorMsg = '' LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordArchiving' LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ExecutionLog.csv' Headers = 'Logging DTM' : @FM : 'Archive Queue ID' : @FM : 'Archive ID' : @FM : 'Message' objArchiveRecordsLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$) AllRecordsArchived = False$ If ArchiveId NE '' then ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$) If Error_Services('NoError') then ArchiveSavePath = ArchiveRec NumRecordsToArchive = DCOUNT(ArchiveRec, @VM) if NumRecordsToArchive GT 0 then for each Record in ArchiveRec using @VM setting RecPos Until ErrorMsg NE '' ThisRecord = ArchiveRec ThisTable = ArchiveRec ThisRecordArchived = ArchiveRec If Not(ThisRecordArchived) then RecordArchivedTxt = Archive_Services('ArchiveRecordToTxtFile', ThisTable, ThisRecord, ArchiveSavePath) if Error_Services('NoError') then RecordArchivedJson = Archive_Services('ArchiveRecordToJson', ThisRecord, ThisTable, ArchiveSavePath) If Error_Services('NoError') then If RecordArchivedTxt AND RecordArchivedJson then ArchiveRec = True$ Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'One or more archive methods failed.' end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = Error_Services('GetMessage') end end Next Record If ErrorMsg EQ '' then if AddToDeleteQ then Archive_Services('AddToDeleteQueue', ArchiveId) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end end else ErrorMsg = 'Archive record had zero child records.' end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive ID was null.' end If ErrorMsg EQ '' then LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogData = '' LogData<1> = LoggingDTM; LogData<2> = ArchiveId LogData<3> = 'Successfully archived all records in ARCHIVE.' Logging_Services('AppendLog', objArchiveRecordsLog, LogData, @RM, @FM, False$) AllRecordsArchived = True$ end else ErrorMsg = 'Error in ArchiveRecords service - ' : ErrorMsg LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogData = '' LogData<1> = LoggingDTM; LogData<2> = ArchiveId LogData<3> = ErrorMsg Logging_Services('AppendLog', objArchiveRecordsLog, LogData, @RM, @FM, False$) Error_Services('Add', ErrorMsg) end Response = AllRecordsArchived end service /* ArchiveRecordToTxtFile Step 2.3 of data archiving procedures. One of the possible methods that can used to backup a file. This service reads a specific record and backs up the data to raw text in a .txt file. Then verifies content by calling the VerifyTextBackup service. If VerifyTextBackup service returns false then this service returns false. If VerifyTextBackup service returns true then this service returns true. Parameters- RecordTable - The table of the record being backed up RecordId - The key id of the record being backed up SavePath - The location to save the txt file backup. */ Service ArchiveRecordToTxtFile(RecordTable, RecordId, SavePath) ErrorMsg = '' RecordBackedUp = False$ If RecordTable NE '' then If RecordId NE '' then If RowExists(RecordTable, RecordId) then If SavePath NE '' then SavePathExists = DirExists(SavePath) If SavePathExists then Record = Database_Services('ReadDataRow', RecordTable, RecordId, True$, 0, False$) If Error_Services('NoError') then FileName = RecordTable:'-':RecordId:'.txt' FullSavePath = SavePath : FileName swap '*' with '%2A' in FullSavePath Set_Status(0) OSWrite Record to FullSavePath; // Todo Error checking for write and read TextBackupVerified = Archive_Services('VerifyTextBackup', RecordTable, RecordId, FullSavePath, True$) if Error_Services('NoError') then if TextBackupVerified then RecordBackedUp = True$ end else ErrorMsg = 'Error in text file backup verification.' end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Specified save path was not found.' end end else ErrorMsg = 'Save path was null.' end end else ErrorMsg = 'Specific record {':RecordTable:'} {':RecordId:'} was not found in the specified table.' end end else ErrorMsg = 'Record Id was null.' end end else ErrorMsg = 'Record Table was null.' end If ErrorMsg NE '' then Error_Services('Add', ErrorMsg) end Response = RecordBackedUp end service Service ArchiveRecordToJson(RecordId, RecordTable, SavePath) SavedToJson = False$ ErrorMsg = '' If RecordId NE '' then If RecordTable NE '' then If SavePath NE '' then SavePathExists = DirExists(SavePath) If SavePathExists then If RowExists(RecordTable, RecordId) then FileName = RecordTable:'-':RecordId:'.json' FullSavePath = SavePath : FileName swap '*' with '%2A' in FullSavePath RecordJSonData = Archive_Services('ConvertGenericRecordToJson', RecordId, RecordTable) If Error_Services('NoError') then ValidJson = SRP_JsonX_Parse('JsonCheck', RecordJSonData) If ValidJson then Set_Status(0) OSWrite RecordJSonData to FullSavePath SavedToJson = True$ end else ErrorMsg = 'No valid json detected.' end end else ErrorMsg = Error_Services('GetMessage') end Set_Status(0) OSWrite RecordJSonData to FullSavePath; If Get_Status(errCode) then ErrorMsg = 'Error writing archive Json file.' end end else ErrorMsg = RecordId : ' in ' : RecordTable : ' does not exist.' end end else ErrorMsg = 'Specified save path was not found.' end end else ErrorMsg = 'SavePath parameter was null.' end end else ErrorMsg = 'RecordTable parameter was null.' end end else ErrorMsg = 'RecordId parameter was null.' end If ErrorMsg EQ '' then Response = SavedToJson end else Error_Services('Add', ErrorMsg) end end service Service ConvertArchiveRecordToJson(ArchiveId) ErrorMsg = '' JsonData = '' If ArchiveId NE '' then ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$) If Error_Services('NoError') then SRP_JsonX_Begin('JSON', '{') SRP_JsonX('ArchiveId', ArchiveId, 'String') DtmCreated = Date_Services('ConvertDateTimeToISO8601', ArchiveRec) SRP_JsonX('ArchiveCreationDtm', DtmCreated) SRP_JsonX('ArchiveFilePath', ArchiveRec, 'String') SRP_JsonX('ArchiveCompleted', ArchiveRec, 'Bool') DtmCompleted = Date_Services('ConvertDateTimeToISO8601', ArchiveRec) SRP_JsonX('ArchiveCompletionDtm', DtmCompleted) SRP_JsonX('ChildRecords', '[') for each Record in ArchiveRec using @VM setting RecPos SRP_JsonX('{') SRP_JsonX('RecordTable', ArchiveRec, 'String') SRP_JsonX('RecordId', ArchiveRec, 'String') SRP_JsonX('RecordArchived', ArchiveRec, 'Bool') SRP_JsonX('RecordDeleted', ArchiveRec, 'Bool') SRP_JsonX('}') Next Record SRP_JsonX(']') SRP_JsonX('MetaData', '[') for each MetaDataField in ArchiveRec using @VM setting mdPos SRP_JsonX('{') SRP_JsonX('FieldName', ArchiveRec, 'String') FieldType = ArchiveRec FieldValue = ArchiveRec SRP_JsonX('FieldType', FieldType , 'String') If FieldType EQ 'DateTime' then FieldValue = OConv(FieldValue, 'DT') end SRP_JsonX('FieldValue', FieldValue, 'String') SRP_JsonX('}') Next MetaDataField SRP_JsonX(']') DtmDeArchived = Date_Services('ConvertDateTimeToISO8601', ArchiveRec) SRP_JsonX('DeArchiveDtm', DtmDeArchived, 'String') JsonData = SRP_JsonX_End('Pretty') end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'ArchiveId parameter was null.' end If ErrorMsg EQ '' then Response = JsonData end else Error_Services('Add', ErrorMsg) end end service Service ConvertGenericRecordToJson(RecordId, RecordTable) ErrorMsg = '' RecordJson = '' If RecordId NE '' then If RecordTable NE '' then If RowExists(RecordTable, RecordId) then Record = Database_Services('ReadDataRow', RecordTable, RecordId, True$, 0, False$) If Error_Services('NoError') then SRP_JsonX_Begin(RecordTable : '*' : RecordId, '{') For each Field in Record using @FM setting FieldPos If Indexc(Field, @VM, 1) then //Value Marks Present SRP_JsonX(FieldPos, '[') For each Value in Field using @VM setting ValuePos SRP_JsonX('{') If Indexc(Value, @SVM, 1) then SRP_JsonX(ValuePos, '[') for each SubValue in Value using @SVM setting SubValuePos SRP_JsonX('{') SRP_JsonX(SubValuePos, Record) SRP_JsonX('}') Next SubValue SRP_JsonX(']') end else SRP_JsonX(ValuePos, Record) end SRP_JsonX('}') Next Value SRP_JsonX(']') end else //No Value Marks Present SRP_JsonX(FieldPos, Record) end Next Field RecordJson = SRP_JsonX_End('Pretty') end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = RecordId : ' in ' : RecordTable : ' does not exist.' end end else ErrorMsg = 'RecordTable parameter was null.' end end else ErrorMsg = 'RecordId parameter was null.' end If ErrorMsg EQ '' then Response = RecordJson end else Error_Services('Add', ErrorMsg) end end service Service ConvertJsonToRecord(JsonData) ErrorMsg = '' ConvertedData = '' If SRP_JsonX_Parse('JsonTest', JsonData) then NumFields = SRP_JsonX_Count('') for FieldPos = 1 to NumFields NumValueMarks = SRP_JsonX_Count(FieldPos) If NumValueMarks then // Field has value marks For ValueMarkPos = 1 to NumValueMarks NumSubValueMarks = SRP_JsonX_Count(FieldPos : '[':ValueMarkPos:'].':ValueMarkPos) If NumSubValueMarks GT 1 then // Value Mark is further delimited with sub-value marks For SubValueMarkPos = 1 to NumSubValueMarks ConvertedData = SRP_JsonX_Get(FieldPos : '[':ValueMarkPos:'].':ValueMarkPos: '[':SubValueMarkPos:']':'.':SubValueMarkPos) Next SubValueMarkPos end else // Value Mark is not delimited. ConvertedData = SRP_JsonX_Get(FieldPos : '[':ValueMarkPos:'].':ValueMarkPos) end Next ValueMarkPos end else // The field does not have value marks. FieldData = SRP_JsonX_Get(FieldPos) ConvertedData = SRP_JsonX_Get(FieldPos) end Next FieldPos end else ErrorMsg = 'JsonData passed to routine was invalid.' end If ErrorMsg EQ '' then Response = ConvertedData end else Error_Services('Add', ErrorMsg) end end service /* VerifyTextBackup Step 2.4 of data archiving procedures. This service compares the content of a specified txt file and the raw text data of a record in the system. OR the existence of a text file. If the data between the two entities matches this service returns a true If the data between the two entities does not match then this service returns a false. Parameters- RecordTable - The table of the record being compared RecordId - The key id of the record being compares SavePath - The location of the txt file containing the data. VerifyFileContents - Optional parameter. If this parameter is false or null then only the existence of a matching text file occurs If this parameter is true then the content of the text file is compared. */ Service VerifyTextBackup(RecordTable, RecordId, PathToTextFile, VerifyFileContents) ErrorMsg = '' VerificationPassed = False$ If RecordTable NE '' then If RecordId NE '' then If RowExists(RecordTable, RecordId) then If PathToTextFile NE '' then FileExists = DirExists(PathToTextFile) If FileExists EQ 0 OR FileExists EQ 1 then If VerifyFileContents then Record = Database_Services('ReadDataRow', RecordTable, RecordId, True$, 0, False$) If Error_Services('NoError') then Set_Status(0) OSRead RecordVerify from PathToTextFile then If RecordVerify EQ Record then VerificationPassed = True$ end else ErrorMsg = 'Record backup verification failed.' end end else ErrorMsg = 'Error verifying record.' end end else ErrorMsg = Error_Services('GetMessage') end end else VerificationPassed = True$ end end else ErrorMsg = 'Specific path was not found' end end else ErrorMsg = 'Path to text file was null.' end end else ErrorMsg = 'Specific record was not found in the specified table.' end end else ErrorMsg = 'Record Id was null.' end end else ErrorMsg = 'Record Table was null.' end If ErrorMsg NE '' then Error_Services('Add', ErrorMsg) end Response = VerificationPassed end service /* AddToDeleteQueue Step 3.1 of data archiving procedures. Responsible for creating record in the DELETE_QUEUE table. These records relate to an ARCHIVE record. Returns the GUID key ID of the DELETE_QUEUE record created. Parameters- ArchiveId - The key ID of the ARCHIVE record which is being queued for child record deletion. */ Service AddToDeleteQueue(ArchiveId) ErrorMsg = '' AddedToDeleteQueue = False$ If ArchiveId NE '' then If RowExists('ARCHIVE', ArchiveId) then ArchiveQueueId = RTI_CreateGUID() ArchiveQueueRec = '' ArchiveQueueRec = ArchiveId Database_Services('WriteDataRow', 'DELETE_QUEUE', ArchiveQueueId, ArchiveQueueRec) If Error_Services('NoError') then AddedToDeleteQueue = True$ end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive record ' : ArchiveId : ' was not found in ARCHIVE table.' end end else ErrorMsg = 'Archive Id was null' end If ErrorMsg NE '' then Error_Services('Add', 'Error adding archive to deletion queue : ' : ErrorMsg) end Response = AddedToDeleteQueue end service /* ProcessDeleteQueue Step 3.2 of data archiving procedures. Responsible for getting and looping through keys in the DELETE_QUEUE table. Then processing the record with that key by passing it off to the DeleteRecords service If the DeleteRecords service returns true then deletes the DELETE_QUEUE record. If the DeleteRecords service returns false, then tranfers the DELETE_QUEUE record to the DELETE_QUEUE_ERROR table. Deletes the DELETE_QUEUE record. Parameters- None. */ Service ProcessDeleteQueue() ErrorMsg = '' LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordDeletion' LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ServiceLog.csv' Headers = 'Logging DTM' : @FM : 'Message' ServiceLogObj = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$) hSysLists = Database_Services('GetTableHandle', 'SYSLISTS') Lock hSysLists, ServiceKeyID then open 'DELETE_QUEUE' to FileIn then SelectStmt = 'SELECT DELETE_QUEUE' RList(SelectStmt,TARGET_ACTIVELIST$,'','','') Done = 0 loop readnext DeleteQueueId else Done = 1 until Done ExecutionErrMsg = '' ArchiveId = Database_Services('ReadDataColumn', 'DELETE_QUEUE', DeleteQueueIdm, DELETE_QUEUE_ARCHIVE_ID$, True$, 0, False$) If Error_Services('NoError') then If ArchiveId NE '' then If RowExists('ARCHIVE', ArchiveId) then Archive_Services('DeleteRecords', ArchiveId) If Error_Services('HasError') then ProcessError = Error_Services('GetMessage') Error_Services('Clear') DeleteErrQueueRec = '' DeleteErrQueueRec = ArchiveId DeleteErrQueueRec = ProcessError Database_Services('WriteDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, DeleteErrQueueRec) If Error_Services('NoError') then Database_Services('DeleteDataRow', 'DELETE_QUEUE', DeleteQueueId, True$, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end Database_Services('DeleteDataRow', 'DELETE_QUEUE', DeleteQueueId, True$, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end else ErrorMsg = 'Archive ID within the DELETE Queue record was null.' end end else ErrorMsg = Error_Services('GetMessage') end Done = True$; //Limits each service call to 1 record to process at a time. REPEAT end else ErrorMsg = 'Error opening Delete Queue table.' end // Service level Logging if ErrorMsg EQ '' then ServiceMessage = 'Delete queue service finished without error.' end else ServiceMessage = ErrorMsg end LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogData = '' LogData<1> = LoggingDTM LogData<2> = ServiceMessage Logging_Services('AppendLog', ServiceLogObj, LogData, @RM, @FM, False$) Unlock hSysLists, ServiceKeyID else Null end end service Service RetryDeleteErrorQueue() ErrorMsg = '' open 'DELETE_QUEUE_ERROR' to FileIn then SelectStmt = 'SELECT DELETE_QUEUE_ERROR' RList(SelectStmt,TARGET_ACTIVELIST$,'','','') Done = 0 loop readnext DeleteQueueId else Done = 1 until Done ExecutionErrMsg = '' DeleteQueueErrorRec = Database_Services('ReadDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, True$, 0, False$) if Error_Services('NoError') then ArchiveId = DeleteQueueErrorRec If ArchiveId NE '' then If RowExists('ARCHIVE', ArchiveId) then Archive_Services('DeleteRecords', ArchiveId) If Error_Services('NoError') then Database_Services('DeleteDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, True$, False$) end else ProcessError = Error_Services('GetMessage') DeleteQueueErrorRec = ProcessError Database_Services('WriteDataRow', 'DELETE_QUEUE_ERROR', DeleteQueueId, DeleteErrQueueRec, True$, 0, False$) end end end end REPEAT end end service /* DeleteRecords Step 3.3 of data archiving procedures. Responsible for looping through an ARCHIVE records CHILD_RECORDS field. Then for each record pass it to the DeleteRecord service to be deleted from the database. If all records successfully delete, returns a True. If any records fail then processing of the DELETE record pauses and returns a false. Parameters - ArchiveId - The key ID to the ARCHIVE record being processed. */ Service DeleteRecords(ArchiveId) ErrorMsg = '' AllRecordsDeleted = False$ LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Archive\RecordDeletion' LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' ExecutionLog.csv' Headers = 'Logging DTM' : @FM : 'Archive ID' : @FM : 'Message' objDeleteRecordsLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, ',', Headers, '', False$, False$) If ArchiveId NE '' then ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$) for RecPos = DCount(ArchiveRec, @VM) to 1 step -1 ThisRecord = ArchiveRec ThisTable = ArchiveRec Archive_Services('VerifyRelationalIndexes', ThisTable, ThisRecord) Next RecPos If Error_Services('NoError') then for RecPos = DCount(ArchiveRec, @VM) to 1 step -1 Until ErrorMsg NE '' ThisRecord = ArchiveRec ThisTable = ArchiveRec ThisRecordArchived = ArchiveRec ThisRecordDeleted = ArchiveRec If ThisRecordArchived then If Not(ThisRecordDeleted) then Archive_Services('DeleteRecord', ThisTable, ThisRecord) If Error_Services('NoError') then ArchiveRec = True$ Locate 0 in ArchiveRec using @VM setting DeletedPos else ArchiveRec = True$ ArchiveRec = Datetime() end Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = Error_Services('GetMessage') end end else ArchiveRec = True$ Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end else ErrorMsg = 'Record ' : ThisRecord : ' in table ' : ThisTable : ' has not been archived.' end Next RecPos end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive ID was null.' end If ErrorMsg EQ '' then LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogData = '' LogData<1> = LoggingDTM; LogData<2> = ArchiveId LogData<3> = 'Successfully deleted all records in ARCHIVE.' Logging_Services('AppendLog', objDeleteRecordsLog, LogData, @RM, @FM, False$) AllRecordsDeleted = True$ end else ErrorMsg = 'Error in DeleteRecords service - ' : ErrorMsg LogDate = Oconv(Date(), 'D4/') LogTime = Oconv(Time(), 'MTS') LoggingDTM = LogDate : ' ' : LogTime LogData = '' LogData<1> = LoggingDTM; LogData<2> = ArchiveId LogData<3> = ErrorMsg Logging_Services('AppendLog', objDeleteRecordsLog, LogData, @RM, @FM, False$) Error_Services('Add', ErrorMsg) end Response = AllRecordsDeleted end service /* DeleteRecord Step 3.4 of data archiving procedures. Responsible for deleting a record. This method is special because it temporarily removes all MFS's in order to avoid triggering any MFS logic for the specified record. Once MFS's are removed, the deletion occurs. Once the deletion attempt is complete the MFS's are added back to the tables. If the deletion is successful this service returns a true. If the deletion fails this service returns a false. Parameters- TableName - The table of the record being deleted RecordId - The key id of the record being deleted */ Service DeleteRecord(TableName, RecordId) ErrorMsg = '' RecordDeleted = False$ If TableName NE '' then If RecordId NE '' then If RowExists(TableName, RecordId) then TableHandle = Database_Services('GetTableHandle', TableName) If Error_Services('NoError') then RetryCount = 3 Done = False$ for i = 1 to RetryCount Until Done if i GT 1 then Delay(2) //Temporarily remove MFS's to skip their execution OrigMFSList = TableHandle<1, 1> NumMFS = DCount(OrigMFSList, @SVM) TempMFSList = OrigMFSList ReAddMFSList = OrigMFSList For MFSCnt = NumMFS to 1 Step -1 MFSRoutine = TempMFSList<0, 0, MFSCnt> // Removal of BASE_MFS allows us to delete records // Removal of SQL_MFS skips any SQL replication which keeps us from deleting the record there as well. // Need to remove RTP57 because it auto adds itself and causes an error if you add it manually. If (MFSRoutine EQ 'BASE_MFS') OR (MFSRoutine EQ 'SQL_MFS*LSL2') OR (MFSRoutine EQ 'RTP57') then TempMFSList = Delete(TempMFSList, 0, 0, MFSCnt) if MFSRoutine EQ 'RTP57' then ReAddMFSList = Delete(ReAddMFSList, 0, 0, MFSCnt) end end Next MFSCnt Set_MFS(TableName, TempMFSList, 4);// Remove all MFS's If Not(Get_Status(ErrCode)) then //Archive_Services('VerifyRelationalIndexes', TableName, RecordId, True$) //Rewrite the record prior to deletion to resolve any index issues. RecordPriorToDeletion = Database_Services('ReadDataRow', TableName, RecordId) If Error_Services('NoError') then Database_Services('WriteDataRow', TableName, RecordId, RecordPriorToDeletion) if Error_Services('NoError') then Database_Services('DeleteDataRow', TableName, RecordId) If Error_Services('NoError') then RecordDeleted = Not(RowExists(TableName, RecordId)) If RecordDeleted then Done = True$ end else ErrorMsg = TableName : ' - ' : RecordId : ' failed to delete.' end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = Error_Services('GetMessage') end Set_MFS(TableName, ReAddMFSList, 4);// Remove all MFS's;//Put MFS Back onto table end else ErrorMsg = 'Error removing MFS from ' : TableName end Next i end else ErrorMsg = Error_Services('GetMessage') end end else // Do Nothing as this is okay. Record is deleted one way or the other. end end else ErrorMsg = 'RecordID was null.' end end else ErrorMsg = 'TableName was null.' end If ErrorMsg EQ '' then RecordDeleted = True$ end else RecordDeleted = False$ Error_Services('Add', ErrorMsg) end Response = RecordDeleted end service Service VerifyRelationalIndexes(TableName, RecordId, SkipMFSRemoval) ErrorMsg = '' If ( (TableName NE '') and (RecordId NE '') ) then TableName = UCase(TableName) If Not(SkipMFSRemoval) then GoSub RemoveMFS end ServiceModule = TableName:'_SERVICES' ServiceName = 'VerifyRelationalIndexes' If RowExists('SYSOBJ', '$':ServiceModule:'*LSL2') then ServiceModuleContents = Database_Services('ReadDataRow', 'SYSPROCS', ServiceModule:'*LSL2') If Error_Services('NoError') then If IndexC(ServiceModuleContents, ServiceName, 1) then FunctionResponse = Function(@ServiceModule(ServiceName, RecordId)) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end If Not(SkipMFSRemoval) then GoSub ReAddMFS end end If ErrorMsg NE '' then Error_Services('Add', ErrorMsg) end service Service GetAllArchiveIDs() ErrorMsg = '' ArchiveIds = '' open 'ARCHIVE' to FileIn then SelectStmt = 'SELECT ARCHIVE' RList(SelectStmt,TARGET_ACTIVELIST$,'','','') if Not(Get_Status(errCode)) then Done = 0 loop readnext ArchiveId else Done = 1 until Done ArchiveIds<-1> = ArchiveId Repeat end else ErrorMsg = 'Error querying ARCHIVE records.' end end else ErrorMsg = 'Error opening ARCHIVE table.' end If ErrorMsg EQ '' then Response = ArchiveIds end else Error_Services('Add', ErrorMsg) end end service /* FindRecordInArchive Step 1 of the data de-archive process. Responsible for locating the ARCHIVE record that contains the key id of an archived child record. If the record is found the ARCHIVE record ID is returned. Parameters- RecordId - The key ID of the record being searched for. Table - The table the RecordId was contained in prior to being archived. */ Service GetArchiveIDsByRecord(RecordId, Table) ErrorMsg = '' ArchiveIds = '' If RecordId NE '' then If Table NE '' then Open 'DICT.ARCHIVE' to hArchiveDict then ArchiveKeys = '' SearchString = 'CHILD_RECORD':@VM:RecordId:@FM SearchString := 'CHILD_TABLE':@VM:Table:@FM Btree.Extract(SearchString, 'ARCHIVE', hArchiveDict, ArchiveKeys, 0, 0) If Not(Get_Status(errCode)) then If ArchiveKeys NE '' then for each ArchiveKey in ArchiveKeys using @VM ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveKey) if Error_Services('NoError') then Locate RecordId in ArchiveRec using @VM setting RecIdPos then RecTable = ArchiveRec If RecTable EQ Table then ArchiveIds<-1> = ArchiveKey end end end else ErrorMsg = Error_Services('GetMessage') end Next ArchiveKey end else ErrorMsg = 'No Archive keys found for matching the parameter combination.' end end else ErrorMsg = 'Error in querying the Archive table.' end end else ErrorMsg = 'Error opening Archive dictionary.' end end else ErrorMsg = 'Table parameter was null.' end end else ErrorMsg = 'RecordId parameter was null.' end If ErrorMsg NE '' then Error_Services('Add', ErrorMsg) end Response = ArchiveIds end service Service GetArchiveIDsByMetaData(Fields, Values) ErrorMsg = '' ArchiveIds = '' If Fields NE '' then If Values NE '' then SearchString = '' PossibleRecords = '' Table = 'ARCHIVE' for each SearchTerm in Values using @VM setting TermPos SearchString := 'METADATA_FIELD':@VM:Fields<1, TermPos>:@FM SearchString := 'METADATA_VALUE':@VM:Values<1, TermPos>:@FM Next SearchTerm Open 'DICT.ARCHIVE' to hArchiveDict then Flag = "" Btree.Extract(SearchString, 'ARCHIVE', hArchiveDict, PossibleRecords, 0, Flag) if PossibleRecords NE '' then for each RecordId in PossibleRecords using @VM setting RecIdPos Until ErrorMsg NE '' //Need to now verify that the possible found records match the combinations passed in. FoundComboMatch = False$ ThisArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', RecordId, True$, 0, False$) MetaDataFields = ThisArchiveRec MetaDataValues = ThisArchiveRec For each SearchTerm in Values using @VM setting FieldPos Until FoundComboMatch = True$ for each MdValue in MetaDataValues using @VM setting mdPos Until FoundComboMatch EQ True$ If Fields<1, FieldPos> EQ MetaDataFields<1, mdPos> then FoundComboMatch = True$ end Next MdValue Next Field If FoundComboMatch True$ then ArchiveIds<-1> = RecordId end Next RecordId end else ErrorMsg = 'No matching records found.' end end else ErrorMsg = 'Error opening ARCHIVE dictionary.' end end else ErrorMsg = 'SearchTerm parameter was null.' end end else ErrorMsg = 'Fields parameter was null.' end If ErrorMsg EQ '' then Response = ArchiveIds end else Error_Services('Add', ErrorMsg) end end service /* DeArchiveData Step 2 of the data de-archive process. Responsible for reading data back in from a backup to the OpenInsight live system. Reads an ARCHIVE record to get the file path of the backup then reads the CHILD_RECORD and CHILD_TABLE fields to find the text files and write them back into the system. Upon first attempt of de-archive, the de-archive date in the ARCHIVE record is set. Parameters- ArchiveId - The whole ARCHIVE record to be de-archived. */ Service DeArchiveDataFromTxt(ArchiveId) ErrorMsg = '' DeArchiveSuccess = False$ If ArchiveId NE '' then If RowExists('ARCHIVE', ArchiveId) then ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId) If Error_Services('NoError') then //Set the de-archive dtm. ArchiveRec = Datetime() ArchiveFilesPath = ArchiveRec for i = DCount(ArchiveRec, @VM) to 1 step -1 until ErrorMsg NE '' RecordExists = False$ RecordId = ArchiveRec TableName = ArchiveRec RecordDeArchived = ArchiveRec If Not(RecordDeArchived) then If Not(RowExists(RecordTable, TableName)) then TxtFilePath = ArchiveFilesPath TxtFileName = TableName : '-' : RecordId : '.txt' swap '*' with '%2A' in TxtFileName FullSavePath = TxtFilePath : TxtFileName Record = '' OSRead Record from FullSavePath then GoSub RemoveMFS If ErrorMsg EQ '' then Database_Services('WriteDataRow', TableName, RecordId, Record) if Error_Services('NoError') then If RowExists(TableName, RecordId) then RecordExists = True$ end else ErrorMsg = 'An unspecified error occured saving the record.' end end else ErrorMsg = Error_Services('GetMessage') end GoSub ReAddMFS end end end else RecordExists = True$ end If RecordExists then ArchiveRec = True$ ArchiveRec = False$ ArchiveRec = False$ end else ErrorMsg = 'An unspecified error occured saving the record.' end end Next i Database_Services('WriteDataRow', 'ARCHIVE', ArchiveId, ArchiveRec, True$, 0, False$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive record was not found.' end end else ErrorMsg = 'ArchiveId was null.' end If ErrorMsg EQ '' then Response = True$ end else Response = False$ Error_Services('Add', ErrorMsg) end end service Service DeArchiveDataFromJson(ArchiveId) ErrorMsg = '' DeArchiveSuccess = False$ If ArchiveId NE '' then If RowExists('ARCHIVE', ArchiveId) then ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId) ArchiveRec = Datetime() If Error_Services('NoError') then ArchiveFilesPath = ArchiveRec for i = DCount(ArchiveRec, @VM) to 1 step -1 RecordId = ArchiveRec TableName = ArchiveRec If Not(RowExists(RecordTable, TableName)) then JsonFilePath = ArchiveFilesPath JsonFileName = TableName : '-' : RecordId : '.json' swap '*' with '%2A' in JsonFileName FullSavePath = JsonFilePath : JsonFileName Record = '' OSRead Json from FullSavePath then //ParseJson GoSub RemoveMFS If ErrorMsg EQ '' then Database_Services('WriteDataRow', TableName, RecordId, Record) if Error_Services('NoError') then DeArchiveSuccess = True$ end else ErrorMsg = Error_Services('GetMessage') end GoSub ReAddMFS end end end Next i end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive record was not found.' end end else ErrorMsg = 'ArchiveId was null.' end Response = DeArchiveSuccess end service Service ReArchive(ArchiveId) ErrorMsg = '' NewArchiveId = '' If RowExists('ARCHIVE', ArchiveId) then OrigArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$) If Error_Services('NoError') then ArchiveType = Field(ArchiveId, '*', 1) ArchiveParent = Field(ArchiveId, '*', 2) If ArchiveType NE '' AND ArchiveParent NE '' then NewArchiveId = Archive_Services('CreateArchiveRecord', ArchiveParent, ArchiveType, True$, True$) If Error_Services('HasError') then ErrorMsg = Error_Services('GetMessage') end end end else ErrorMsg = Error_Services('GetMessage') end end else ErrorMsg = 'Archive record did not exist.' end If ErrorMsg NE '' then Error_Services('Add', ErrorMsg) end Reponse = NewArchiveId end service Service GenerateArchiveCreationReport(ArchiveIds) ErrorMsg = '' ArchiveData = '' If ArchiveIds NE '' then For each ArchiveId in ArchiveIds using @VM setting aPos ArchiveRec = Database_Services('ReadDataRow', 'ARCHIVE', ArchiveId, True$, 0, False$) if Error_Services('NoError') then ArchiveData = Field(ArchiveId, '*', 1);// Table Name ArchiveData = Field(ArchiveId, '*', 2);// Parent Record Id ArchiveData = DCount(ArchiveRec, @VM) end else ErrorMsg = Error_Services('GetMessage') end Next ArchiveId end else ArchiveData = 'No records found to Archive.' end if ArchiveData NE '' then MessageDate = OConv(DateTime(), 'DT') eMailBody = 'Archive Initialization Report' eMailBody<-1> = 'The following parents records have been detected as ready to archive on ' : MessageDate : '. All records have been queued to for archive.' eMailBody<-1> = '' eMailBody<-1> = ArchiveData swap @VM with ', ' in eMailBody swap @FM with CRLF$ in eMailBody emailHeader = 'Archive Report for ' : MessageDate SentFrom = 'oinotify@infineon.com' SendTo = 'jonathan.ouellette@infineon.com' Success = Email_Services('SendEmail', SentFrom, SendTo, eMailHeader, eMailBody) end else MessageDate = OConv(DateTime(), 'DT') eMailBody = 'Archive Initialization Report' eMailBody<-1> = 'Archive service ran on ' : MessageDate : '. No records were detected.' swap @FM with CRLF$ in eMailBody emailHeader = 'Archive Report for ' : MessageDate SentFrom = 'oinotify@infineon.com' SendTo = 'jonathan.ouellette@infineon.com' Success = Email_Services('SendEmail', SentFrom, SendTo, eMailHeader, eMailBody) end end service //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// // Internal GoSubs //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// RemoveMFS: TableHandle = Database_Services('GetTableHandle', TableName) If Error_Services('NoError') then //Temporarily remove MFS's to skip their execution OrigMFSList = TableHandle<1, 1> NumMFS = DCount(OrigMFSList, @SVM) TempMFSList = OrigMFSList ReAddMFSList = OrigMFSList For MFSCnt = NumMFS to 1 Step -1 MFSRoutine = TempMFSList<0, 0, MFSCnt> // Removal of BASE_MFS allows us to delete records // Removal of SQL_MFS skips any SQL replication which keeps us from deleting the record there as well. // Need to remove RTP57 because it auto adds itself and causes an error if you add it manually. If (MFSRoutine EQ 'BASE_MFS') OR (MFSRoutine EQ 'SQL_MFS*LSL2') OR (MFSRoutine EQ 'RTP57') then TempMFSList = Delete(TempMFSList, 0, 0, MFSCnt) if MFSRoutine EQ 'RTP57' then ReAddMFSList = Delete(ReAddMFSList, 0, 0, MFSCnt) end end Next MFSCnt Set_MFS(TableName, TempMFSList, 4);// Remove all MFS's If Get_Status(ErrCode) then ErrorMsg = 'Error Setting MFS' end end else ErrorMsg = Error_Services('GetMessage') end return ReAddMFS: Set_MFS(TableName, ReAddMFSList, 4);// Remove all MFS's;//Put MFS Back onto table return ClearCursors: For counter = 0 to 8 ClearSelect counter Next counter return