COMPILE FUNCTION Comm_Note_Ptrs(Instruction, Parm1,Parm2) /* Commuter module for NOTE_PTRS window 02/12/2010 - John C. Henry, J.C. Henry & Co., Inc. */ DECLARE SUBROUTINE Set_Property, Set_Property, obj_Notes, obj_Appwindow, Errmsg DECLARE SUBROUTINE obj_Note_Ptrs, ErrMsg, Send_Event, obj_Tables, Start_Window, Database_Services, Error_Services DECLARE FUNCTION Get_Property, Get_Status, Popup, Dialog_Box, obj_Tables, NextKey, Notes_Services, Database_Services Declare function Error_Services, ErrMsg $INSERT POPUP_EQUATES $INSERT MSG_EQUATES $INSERT APPCOLORS $INSERT SECURITY_RIGHTS_EQU $INSERT NOTES_EQU $INSERT NOTE_PTRS_EQU $Insert LOGICAL EQU COL$SUBJECT TO 1 EQU COL$FROM TO 2 EQU COL$DATE TO 3 EQU COL$TIME TO 4 EQU COL$NEW TO 5 EQU COL$ATTACH TO 6 EQU COL$NOTE_ID TO 7 ;* 2pixels wide on screen EQU CRLF$ TO \0D0A\ ErrTitle = 'Error in Comm_Note_Ptrs' ErrorMsg = '' Result = '' BEGIN CASE CASE Instruction = 'Create' ; GOSUB Create CASE Instruction = 'Refresh' ; GOSUB Refresh CASE Instruction = 'Rebuild' ; GOSUB Rebuild CASE Instruction = 'ReadNote' ; GOSUB ReadNote CASE Instruction = 'WriteNote' ; GOSUB WriteNote CASE Instruction = 'MsgGroups' ; GOSUB MsgGroups CASE Instruction = 'Delete' ; GOSUB Delete CASE 1 ErrorMsg = 'Unknown Instruction passed to routine' END CASE IF ErrorMsg NE '' THEN ErrMsg(ErrorMsg) END RETURN Result * * * * * * * Create: * * * * * * * obj_Appwindow('Create',@WINDOW) Gosub Refresh Set_Property( @WINDOW: '.NOTE_DATA', 'SELPOS', 0) Set_Property( @WINDOW: '.NOTE_DATA2', 'SELPOS', 0) Set_Property( @WINDOW: '.NOTE_DATA', 'PREVSELPOS', 0) Set_Property( @WINDOW: '.NOTE_DATA2', 'PREVSELPOS', 0) RETURN * * * * * * * Refresh: * * * * * * * PrevInbox = Get_Property( @WINDOW: '.NOTE_DATA', 'SELPOS')<2> PrevArchive = Get_Property( @WINDOW: '.NOTE_DATA2', 'SELPOS')<2> InboxList = Notes_Services('GetInboxMessages', @USER4) CurrInbox = Get_Property( @WINDOW:'.NOTE_DATA', 'ARRAY') If InboxList NE CurrInbox then Set_Property( @WINDOW:'.NOTE_DATA', 'ARRAY', InboxList) If PrevInbox NE 0 then Set_Property( @WINDOW: '.NOTE_DATA', 'SELPOS', PrevInbox) end ArchiveList = Notes_Services('GetArchivedMessages', @USER4) CurrArchive = Get_Property( @WINDOW:'.NOTE_DATA2', 'ARRAY') If ArchiveList NE CurrArchive then Set_Property( @WINDOW:'.NOTE_DATA2', 'ARRAY', ArchiveList) If PrevArchive NE 0 then Set_Property( @WINDOW: '.NOTE_DATA2', 'SELPOS', PrevArchive) end RETURN * * * * * * * Rebuild: * * * * * * * NoteID = Get_Property(@WINDOW,'ID') Verify = Msg(@window,'','NOTE_PTRS_REBUILD') IF NOT(Verify) THEN RETURN Send_Event(@WINDOW,'CLEAR') Def = "" Def = "Rebuilding Messages for Last 90 Days..." Def = "U" MsgUp = Msg(@window, Def) obj_Notes('Rebuild',NoteID) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END Msg(@window, MsgUp) GOSUB Refresh RETURN * * * * * * * ReadNote: * * * * * * * PageNo = Get_Property(@WINDOW, 'VPOSITION') If PageNo<1> = 1 then NoteRow = Get_Property(@WINDOW:'.NOTE_DATA','ROWDATA') end else NoteRow = Get_Property(@WINDOW:'.NOTE_DATA2','ROWDATA') end NoteId = NoteRow IF NoteID NE '' THEN obj_AppWindow('ViewRelated','NOTE_MESSAGE':@RM:NoteID:@RM) END ELSE ErrMsg('Read Note called without a Note ID.') END npParms = 'NOTE_PTRS':@RM:@USER4 If RowExists('NOTE_PTRS', @User4) then UserRec = Database_Services('ReadDataRow', 'NOTE_PTRS', @USER4) end else UserRec = '' Database_Services('WriteDataRow', 'NOTE_PTRS', @User4, UserRec) end LOCATE NoteID IN UserRec USING @VM SETTING Fpos THEN UserRec = 'No' //npParms = FIELDSTORE(npParms,@RM,4,0,UserRec) //obj_Tables('WriteRec',npParms) Database_Services('WriteDataRow', 'NOTE_PTRS', @USER4, UserRec, True$, False$, True$) END GOSUB Refresh RETURN * * * * * * WriteNote: * * * * * * NoteID = NextKey('NOTES') obj_AppWindow('ViewRelated','NOTE_MESSAGE':@RM:NoteID) GOSUB Refresh RETURN * * * * * * * MsgGroups: * * * * * * * If Get_Property('NDW_MAIN', 'VISIBLE') then AppMain = 'NDW_MAIN' end else AppMain = 'LSL_MAIN2' end Start_Window('MSG_GROUPS',@WINDOW,'*CENTER',AppMain) GOSUB Refresh RETURN * * * * * * Delete: * * * * * * PageNo = Get_Property(@WINDOW, 'VPOSITION') If PageNo<1> = 1 then NoteDataList = Get_Property(@WINDOW:'.NOTE_DATA','LIST') CurrRow = Get_Property(@WINDOW:'.NOTE_DATA','SELPOS')<2> end else NoteDataList = Get_Property(@WINDOW:'.NOTE_DATA2','LIST') CurrRow = Get_Property(@WINDOW:'.NOTE_DATA2','SELPOS')<2> end CONVERT @VM TO @SVM IN NoteDataList CONVERT @FM TO @VM IN NoteDataList TypeOver = '' TypeOver = NoteDataList TypeOver = CurrRow NoteIDs = Popup(@WINDOW,TypeOver,'NOTE_PTRS') IF NoteIDS = '' THEN RETURN npParms = 'NOTE_PTRS':@RM:@USER4 UserRec = Database_Services('ReadDataRow', 'NOTE_PTRS', @User4) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END FOR I = 1 TO COUNT(NoteIDs,@VM) + (NoteIDs NE '') NoteID = NoteIDs<1,I> LOCATE NoteID IN UserRec USING @VM SETTING Fpos THEN UserRec = DELETE( UserRec, NOTE_PTRS_SUBJECT$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_FROM$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_DATE$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_TIME$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_NEW$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_ATTACHMENT$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_NOTE_IDS$, Fpos, 0 ) UserRec = DELETE( UserRec, NOTE_PTRS_ARCHIVED$, Fpos, 0 ) END NEXT I npParms = FIELDSTORE(npParms,@RM,4,0,UserRec) Database_Services('WriteDataRow', 'NOTE_PTRS', @User4, UserRec, True$, False$, True$) GOSUB Refresh RETURN