phares3757/open-insight
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added AD group support to notifications system

Browse Source
This commit is contained in:
Infineon\StieberD 2024-10-04 17:35:08 -07:00
parent 0b5ce72c39
commit 2a5abee93e
38 changed files with 9811 additions and 2732 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -1 +1,2 @@
LSL2/STPROC/TEST_DANIEL3.txt
LSL2/STPROC/TEST_DANIEL3.txt

1995
LSL2/OIWIN/NDW_ACTIVE_DIRECTORY_GROUPS.json Normal file
View File

File diff suppressed because it is too large Load Diff

16
LSL2/OIWIN/NDW_MAIN.json
View File

@ -10391,13 +10391,23 @@
"<2,2,166>": {
"<2,2,166,1>": "R",
"<2,2,166,2>": "EXECUTE",
"<2,2,166,3>": "LSL2*OIWINEXE**NOTIFICATION",
"<2,2,166,3>": "LSL2*OIWINEXE**NDW_NOTIFICATION",
"<2,2,166,4>": {
"<2,2,166,4,1>": "",
"<2,2,166,4,1>": "CreateParam",
"<2,2,166,4,2>": "@WINDOW"
},
"<2,2,166,5>": "",
"<2,2,166,6>": ""
"<2,2,166,6>": "",
"<2,2,166,7>": "",
"<2,2,166,8>": "",
"<2,2,166,9>": "",
"<2,2,166,10>": "",
"<2,2,166,11>": "",
"<2,2,166,12>": "",
"<2,2,166,13>": "",
"<2,2,166,14>": "",
"<2,2,166,15>": "STARTWIN",
"<2,2,166,16>": "0"
},
"<2,2,167>": {
"<2,2,167,1>": "R",

5457
LSL2/OIWIN/NDW_NOTIFICATION.json Normal file
View File

File diff suppressed because it is too large Load Diff

1
LSL2/STPROC/ACTIVE_DIRECTORY_SERVICES.txt
View File

@ -182,6 +182,7 @@ end service
// 9/26/2024 - [JRO] Initial Programmer.
//----------------------------------------------------------------------------------------------------------------------
Service GetADGroupsByString(SearchString, Domain=DOMAIN, SearchByDescription=DESCRIPTION_BOOL, GroupType=AD_GROUP_TYPE)
Set_Status(0)
ErrMessage = ''
ADGroups = ''

202
LSL2/STPROC/COMM_NOTE_PTRS.txt
View File

@ -60,15 +60,16 @@ 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)
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:
* * * * * * *
@ -92,78 +93,77 @@ Refresh:
RETURN
* * * * * * *
Rebuild:
* * * * * * *
NoteID = Get_Property(@WINDOW,'ID')
NoteID = Get_Property(@WINDOW,'ID')
Verify = Msg(@window,'','NOTE_PTRS_REBUILD')
Verify = Msg(@window,'','NOTE_PTRS_REBUILD')
IF NOT(Verify) THEN RETURN
IF NOT(Verify) THEN RETURN
Send_Event(@WINDOW,'CLEAR')
Send_Event(@WINDOW,'CLEAR')
Def = ""
Def<MTEXT$> = "Rebuilding Messages for Last 90 Days..."
Def<MTYPE$> = "U"
Def = ""
Def<MTEXT$> = "Rebuilding Messages for Last 90 Days..."
Def<MTYPE$> = "U"
MsgUp = Msg(@window, Def)
MsgUp = Msg(@window, Def)
obj_Notes('Rebuild',NoteID)
obj_Notes('Rebuild',NoteID)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
Msg(@window, MsgUp)
Msg(@window, MsgUp)
GOSUB Refresh
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
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<COL$NOTE_ID>
NoteId = NoteRow<COL$NOTE_ID>
IF NoteID NE '' THEN
obj_AppWindow('ViewRelated','NOTE_MESSAGE':@RM:NoteID:@RM)
IF NoteID NE '' THEN
obj_AppWindow('ViewRelated','NOTE_MESSAGE':@RM:NoteID:@RM)
END ELSE
ErrMsg('Read Note called without a Note ID.')
END
END ELSE
ErrMsg('Read Note called without a Note ID.')
END
npParms = 'NOTE_PTRS':@RM:@USER4
UserRec = Database_Services('ReadDataRow', 'NOTE_PTRS', @USER4)
npParms = 'NOTE_PTRS':@RM:@USER4
UserRec = Database_Services('ReadDataRow', 'NOTE_PTRS', @USER4)
IF Error_Services('HasError') THEN
ErrMsg(Error_Services('GetMessage'))
RETURN
END
IF Error_Services('HasError') THEN
ErrMsg(Error_Services('GetMessage'))
RETURN
END
LOCATE NoteID IN UserRec<NOTE_PTRS_NOTE_IDS$> USING @VM SETTING Fpos THEN
UserRec<NOTE_PTRS_NEW$,Fpos> = 'No'
LOCATE NoteID IN UserRec<NOTE_PTRS_NOTE_IDS$> USING @VM SETTING Fpos THEN
UserRec<NOTE_PTRS_NEW$,Fpos> = 'No'
//npParms = FIELDSTORE(npParms,@RM,4,0,UserRec)
//obj_Tables('WriteRec',npParms)
Database_Services('WriteDataRow', 'NOTE_PTRS', @USER4, UserRec, True$, False$, True$)
END
//npParms = FIELDSTORE(npParms,@RM,4,0,UserRec)
//obj_Tables('WriteRec',npParms)
Database_Services('WriteDataRow', 'NOTE_PTRS', @USER4, UserRec, True$, False$, True$)
END
GOSUB Refresh
GOSUB Refresh
RETURN
@ -172,10 +172,10 @@ RETURN
WriteNote:
* * * * * *
NoteID = NextKey('NOTES')
obj_AppWindow('ViewRelated','NOTE_MESSAGE':@RM:NoteID)
NoteID = NextKey('NOTES')
obj_AppWindow('ViewRelated','NOTE_MESSAGE':@RM:NoteID)
GOSUB Refresh
GOSUB Refresh
RETURN
@ -184,14 +184,14 @@ 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)
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
GOSUB Refresh
RETURN
@ -200,63 +200,55 @@ 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
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
CONVERT @VM TO @SVM IN NoteDataList
CONVERT @FM TO @VM IN NoteDataList
TypeOver = ''
TypeOver<PDISPLAY$> = NoteDataList
TypeOver<PINITSELECT$> = CurrRow
TypeOver = ''
TypeOver<PDISPLAY$> = NoteDataList
TypeOver<PINITSELECT$> = CurrRow
NoteIDs = Popup(@WINDOW,TypeOver,'NOTE_PTRS')
NoteIDs = Popup(@WINDOW,TypeOver,'NOTE_PTRS')
IF NoteIDS = '' THEN RETURN
IF NoteIDS = '' THEN RETURN
npParms = 'NOTE_PTRS':@RM:@USER4
UserRec = obj_Tables('ReadRec',npParms)
npParms = 'NOTE_PTRS':@RM:@USER4
UserRec = obj_Tables('ReadRec',npParms)
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<NOTE_PTRS_NOTE_IDS$> 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 )
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
NEXT I
npParms = FIELDSTORE(npParms,@RM,4,0,UserRec)
obj_Tables('WriteRec',npParms)
FOR I = 1 TO COUNT(NoteIDs,@VM) + (NoteIDs NE '')
NoteID = NoteIDs<1,I>
GOSUB Refresh
LOCATE NoteID IN UserRec<NOTE_PTRS_NOTE_IDS$> 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)
obj_Tables('WriteRec',npParms)
GOSUB Refresh
RETURN

177
LSL2/STPROC/COMM_NOTIFICATION.txt
View File

@ -54,17 +54,17 @@ RETURN Result
Create:
* * * * * * *
IF NOT(Admin_User( @USER4 )) THEN
Message = 'You do not have the proper security to enter Message Notifications...'
Message<micon$> = 'H'
Msg( '', Message )
send_event( @window, 'CLOSE' )
END
IF NOT(Admin_User( @USER4 )) THEN
Message = 'You do not have the proper security to enter Message Notifications...'
Message<micon$> = 'H'
Msg( '', Message )
send_event( @window, 'CLOSE' )
END
obj_Appwindow('Create',@WINDOW)
obj_Appwindow('Create',@WINDOW)
GOSUB Refresh
GOSUB Refresh
RETURN
@ -74,7 +74,7 @@ Read:
* * * * * * *
GOSUB Refresh
GOSUB Refresh
RETURN
@ -90,7 +90,7 @@ RETURN
Clear:
* * * * * * *
GOTO Refresh
GOTO Refresh
RETURN
@ -99,12 +99,12 @@ RETURN
Delete:
* * * * * * *
IF NOT(Security_Check('RDS',DELETE$)) THEN
Security_Err_Msg('RDS',DELETE$)
RETURN
END
IF NOT(Security_Check('RDS',DELETE$)) THEN
Security_Err_Msg('RDS',DELETE$)
RETURN
END
Result = 0 ;* OK to proceed with the delete
Result = 0 ;* OK to proceed with the delete
RETURN
@ -114,9 +114,9 @@ RETURN
Page:
* * * * * * *
obj_Appwindow('Page')
obj_Appwindow('Page')
GOSUB Refresh
GOSUB Refresh
RETURN
@ -135,43 +135,43 @@ Refresh:
* * * * * * *
* QBF buttons
* QBF buttons
Ctrls = @WINDOW:'.QBF_FIRST_FIX':@RM ; Props = 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_PREV_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_ABS_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_NEXT_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_LAST_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_STOP_FIX' ; Props := 'ENABLED'
Ctrls = @WINDOW:'.QBF_FIRST_FIX':@RM ; Props = 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_PREV_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_ABS_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_NEXT_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_LAST_FIX':@RM ; Props := 'ENABLED':@RM
Ctrls := @WINDOW:'.QBF_STOP_FIX' ; Props := 'ENABLED'
IF Get_Property(@WINDOW,'QBFLIST') = '' THEN
Vals = 0:@RM:0:@RM:0:@RM:0:@RM:0:@RM:0
END ELSE
Vals = 1:@RM:1:@RM:1:@RM:1:@RM:1:@RM:1
END
Set_Property(Ctrls,Props,Vals)
* Turn edit table symbolic column backgrounds to green
ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow
ETCtrls = ETSymbolics<1>
ETCols = ETSymbolics<2>
FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '')
ETCtrl = ETCtrls<1,I>
IF ETCtrl NE @WINDOW:'.CASSETTES' THEN
ETList = Get_Property(ETCtrl,'LIST')
FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '')
IF ETList<Line,1> NE '' THEN
FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '')
stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$)
NEXT N
END
NEXT Line
IF Get_Property(@WINDOW,'QBFLIST') = '' THEN
Vals = 0:@RM:0:@RM:0:@RM:0:@RM:0:@RM:0
END ELSE
Vals = 1:@RM:1:@RM:1:@RM:1:@RM:1:@RM:1
END
NEXT I
Set_Property(Ctrls,Props,Vals)
* Turn edit table symbolic column backgrounds to green
ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow
ETCtrls = ETSymbolics<1>
ETCols = ETSymbolics<2>
FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '')
ETCtrl = ETCtrls<1,I>
IF ETCtrl NE @WINDOW:'.CASSETTES' THEN
ETList = Get_Property(ETCtrl,'LIST')
FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '')
IF ETList<Line,1> NE '' THEN
FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '')
stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$)
NEXT N
END
NEXT Line
END
NEXT I
RETURN
@ -182,16 +182,16 @@ LUNotifyID:
* * * * * * *
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
IF NOT(ASSIGNED(Parm1)) THEN FocusControl = '' ELSE FocusControl = Parm1
IF NOT(ASSIGNED(Parm2)) THEN FocusPos = '' ELSE FocusPos = Parm2
TypeOver = ''
TypeOver<PSELECT$> = 1
TypeOver = ''
TypeOver<PSELECT$> = 1
NotifyID = Popup(@WINDOW,TypeOver,'NOTIFICATION')
IF NotifyID NE '' THEN
obj_Appwindow('LUValReturn',NotifyID:@RM:FocusControl:@RM:FocusPos)
END
NotifyID = Popup(@WINDOW,TypeOver,'NOTIFICATION')
IF NotifyID NE '' THEN
obj_Appwindow('LUValReturn',NotifyID:@RM:FocusControl:@RM:FocusPos)
END
RETURN
@ -202,53 +202,34 @@ RETURN
AddUsers:
* * * * * * *
CtrlEntID = @WINDOW:'.USER_ID'
CtrlEntID = @WINDOW:'.USER_ID'
CurrUserIDs = Get_Property(CtrlEntID,'ARRAY')<1> ;* Existing MFC codes in edit table
CurrUserIDsTrimmed = ''
FOR I = 1 TO COUNT(CurrUserIDs,@VM) + (CurrUserIDs NE '')
IF CurrUserIDs<1,I> NE '' THEN
CurrUserIDsTrimmed<1,I> = CurrUserIDs<1,I>
END
NEXT I
CurrUserIDs = CurrUserIDsTrimmed
CurrUserIDs = Get_Property(CtrlEntID,'ARRAY')<1> ;* Existing MFC codes in edit table
CurrUserIDsTrimmed = ''
FOR I = 1 TO COUNT(CurrUserIDs,@VM) + (CurrUserIDs NE '')
IF CurrUserIDs<1,I> NE '' THEN
CurrUserIDsTrimmed<1,I> = CurrUserIDs<1,I>
END
NEXT I
CurrUserIDs = CurrUserIDsTrimmed
NewUserIDs = Popup(@WINDOW,'','SHOW_USERS')
NewUserIDs = Popup(@WINDOW,'','SHOW_USERS')
IF NewUserIDs = '' OR NewUserIDs = CHAR(27) THEN RETURN
IF NewUserIDs = '' OR NewUserIDs = CHAR(27) THEN RETURN
FOR I = 1 TO COUNT(NewUserIDs,@VM) + (NewUserIDs NE '')
NewUserID = NewUserIDs<1,I>
LOCATE NewUserID IN CurrUserIDs BY 'AL' USING @VM SETTING POS ELSE
CurrUserIDs = INSERT(CurrUserIDs,1,POS,0,NewUserID)
END
FOR I = 1 TO COUNT(NewUserIDs,@VM) + (NewUserIDs NE '')
NewUserID = NewUserIDs<1,I>
LOCATE NewUserID IN CurrUserIDs BY 'AL' USING @VM SETTING POS ELSE
CurrUserIDs = INSERT(CurrUserIDs,1,POS,0,NewUserID)
END
NEXT I
NEXT I
Set_Property(CtrlEntID,'DEFPROP',CurrUserIDs)
Send_Event(CtrlEntID,'CALCULATE',2)
Set_Property(CtrlEntID,'DEFPROP',CurrUserIDs)
Send_Event(CtrlEntID,'CALCULATE',2)
GOSUB Refresh
GOSUB Refresh
RETURN

5
LSL2/STPROC/COMM_WO_MAT_WFR.txt
View File

@ -866,8 +866,8 @@ AddMakeup:
Convert @VM to '' in SlotWaferIDs
// Flush/update pending index transactions.
Update_Index('WO_MAT', 'MU_PART_NO', False$)
Update_Index('WO_MAT', 'CURR_STATUS', False$)
Update_Index('WO_MAT', 'MU_PART_NO', False$, True$)
Update_Index('WO_MAT', 'CURR_STATUS', False$, True$)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
@ -1197,3 +1197,4 @@ return

1335
LSL2/STPROC/COMM_WO_MAT_WFR_DEV.txt
View File

File diff suppressed because it is too large Load Diff

4
LSL2/STPROC/DATABASE_SERVICES.txt
View File

@ -666,7 +666,6 @@ Service SearchIndex(TableName, ColumnName, SearchValue, UpdateIndex)
ServiceKeyID := '*' : TableName : '*' : ColumnName : '*' : SearchValue
ServiceKeyID = SRP_Encode(ServiceKeyID, 'BASE64')
* KeyIDList = Memory_Services('GetValue', ServiceKeyID, True$, 5)
KeyIDList = ''
If TableName NE '' AND ColumnName NE '' AND SearchValue NE '' then
@ -674,7 +673,7 @@ Service SearchIndex(TableName, ColumnName, SearchValue, UpdateIndex)
DictTableHandle = Database_Services('GetTableHandle', 'DICT.' : TableName)
If Error_Services('NoError') then
Set_Status(0)
If UpdateIndex then Update_Index(TableName, ColumnName 0)
If UpdateIndex then Update_Index(TableName, ColumnName, False$, True$)
Set_Status(0)
Flag = ''
Btree.Extract(ColumnName : @VM : SearchValue : @FM, Tablename, DictTableHandle, KeyIDList, 'S', Flag)
@ -1045,3 +1044,4 @@ end service
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

122
LSL2/STPROC/LSL_USERS_SERVICES.txt
View File

@ -25,6 +25,7 @@ $insert LOGICAL
$insert SERVICE_SETUP
$Insert LSL_USERS_EQU
$Insert RLIST_EQUATES
$Insert NOTIFICATION_EQUATES
equ crlf$ to \0D0A\
equ tab$ to char(09)
@ -40,11 +41,17 @@ EQU FRIDAY$ to 5
EQU SATURDAY$ to 6
EQU SUNDAY$ to 7
Declare Function Get.RecCount, SRP_Datetime, Datetime, SRP_MATH, Lsl_Users_Services
Declare Function DCount
Declare Function Database_Services,
Declare Function Environment_Services
Declare subroutine Btree.Extract
Declare Function Get.RecCount, SRP_Datetime, Datetime, SRP_MATH, Lsl_Users_Services, Active_Directory_Services
Declare Function DCount, Database_Services, Environment_Services, SRP_Array, Logging_Services
Declare subroutine Btree.Extract, Logging_Services
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\LSLUsers'
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Notification Groups Update Log.csv'
Headers = 'Logging DTM' : @FM : 'Notification ID' : @FM : 'Notes'
objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
GoToService else
Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' services module.')
@ -187,6 +194,28 @@ Service GetOnShiftUsersByClass(Class, IncludeNextShift)
end service
Service GetOnShiftUsers()
DatetimeNow = OConv(SRP_DateTime("Now"), 'DT')
CurrentShift = Lsl_Users_Services('GetShiftByDate', DatetimeNow)
Open 'DICT.LSL_USERS' to DictLSLUsers then
SearchString = ''
SearchString := 'SHIFT' : @VM : CurrentShift : @VM : '' : @FM ; // Include office personnel (i.e. no shift assigned)
SearchString := 'ACTIVE' : @VM : True$ : @FM
LSLUsersKeys = ''
Btree.Extract(SearchString, 'LSL_USERS', DictLSLUsers, LSLUsersKeys, '', '')
ErrCode = ''
IF Get_Status(ErrCode) then
ErrorMsg = 'Error in ':Service:' service. Error calling Btree.Extract. Error code ':ErrCode:'.'
end
Response = LSLUsersKeys
end else
ErrorMsg = 'Error in ':Service:' service. Error opening LSL_USERS dictionary.'
end
end service
Service GetShiftByDate(Date, GenerateFlag)
OnShift = ''; *Return Value
@ -350,3 +379,86 @@ Service GetShiftByDate(Date, GenerateFlag)
end service
Service UpdateNotificationGroups()
hSysLists = Database_Services('GetTableHandle', 'SYSLISTS')
Lock hSysLists, ServiceKeyID then
Open 'NOTIFICATION' to hTable then
EOF = False$
Select hTable
Loop
ReadNext KeyId else EOF = True$
Until EOF
Lock hTable, KeyId then
Read Rec from hTable, KeyId then
UseAD = Rec<NOTIFICATION_USE_ACTIVE_DIRECTORY$>
If UseAD then
LSLUserList = ''
// Update LSL_User list based on current members in Active Directory groups
ADGroups = Rec<NOTIFICATION_ACTIVE_DIRECTORY_GROUPS$>
For each GroupName in ADGroups using @VM
MemberList = Active_Directory_Services('GetADGroupMembersByGroupName', GroupName, 'INFINEON')
MemberList = SRP_Array('Rotate', MemberList, @FM, @VM)
ADUserNames = MemberList<1>
LSLUserNames = ''
LSLNames = ''
Open 'DICT.LSL_USERS' to hDict then
For each ADUserName in ADUserNames using @VM setting vPos
Query = 'DOMAIN_USERNAME':@VM:ADUserName:@FM:'ACTIVE':@VM:True$:@FM
Flag = ''
LSLUsername = ''
Btree.Extract(Query, 'LSL_USERS', hDict, LSLUsername, '', Flag)
If Flag EQ 0 then
If LSLUsername NE '' then
LSLUserList<0, -1> = LSLUsername
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = KeyId
LogData<3> = 'No LSL_USERS record found for active directory member "':ADUserName:'".'
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = KeyId
LogData<3> = 'Btree.Extract call failed for DOMAIN_USERNAME "':ADUserName:'".'
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
end
Next ADUserName
end
Next GroupName
LSLUserList = SRP_Array('Clean', LSLUserList, 'TrimAndMakeUnique', @VM)
LSLUserList = SRP_Array('SortSimpleList', LSLUserList, 'AscendingText', @VM)
Rec<NOTIFICATION_USER_ID$> = LSLUserList
Write Rec on hTable, KeyId else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = KeyId
LogData<3> = 'Failed to write record during update.'
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
end
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = KeyId
LogData<3> = 'Failed to read record during update.'
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
end
Unlock hTable, KeyId else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = KeyId
LogData<3> = 'Failed to unlock record during update.'
Logging_Services('AppendLog', objLog, LogData, @RM, @FM)
end
end
Repeat
end
Unlock hSysLists, ServiceKeyID else Null
end
end service

151
LSL2/STPROC/NDW_ACTIVE_DIRECTORY_GROUPS_EVENTS.txt Normal file
View File

@ -0,0 +1,151 @@
Compile function NDW_ACTIVE_DIRECTORY_GROUPS_EVENTS(CtrlEntId, Event, @PARAMS)
/***********************************************************************************************************************
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
permission from Infineon.
Name : NDW_Active_Directory_Groups_Events
Description : This function acts as a commuter module for all events related to this window.
Notes : Commuter Modules are automatically called from the Promoted_Events function which is called by the
application-specific promoted event handler. This makes it possible to add QuickEvents that need to
execute Basic+ logic without having use the Form Designer to make the association, although this is
limited to the events which are currently promoted.
If the form needs to call the commuter module directly then the QuickEvent parameters should be
formatted like this:
'@SELF','@EVENT',['@PARAM1','@PARAMx']
Parameters :
CtrlEntId [in] -- The fully qualified name of the control calling the promoted event
Event [in] -- The event being executed. See the Notes section regarding "PRE" events
Param1-15 [in] -- Additional event parameter holders
EventFlow [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
EVENT_SETUP insert
History : (Date, Initials, Notes)
10/01/24 djs Created initial commuter module.
***********************************************************************************************************************/
#pragma precomp SRP_PreCompiler
#window NDW_ACTIVE_DIRECTORY_GROUPS
$Insert EVENT_SETUP
$Insert LOGICAL
$Insert RTI_STYLE_EQUATES
$Insert MSG_EQUATES
Declare function Active_Directory_Services, Send_Message, SRP_Array
Declare subroutine End_Dialog, Set_Property, Btree.Extract
GoToEvent Event for CtrlEntId else
// Event not implemented
end
Return EventFlow or 1
//-----------------------------------------------------------------------------
// EVENT HANDLERS
//-----------------------------------------------------------------------------
Event WINDOW.CREATE(CreateParam)
SelGroups = CreateParam
Def = ""
Def<MCOL$> = -2
Def<MROW$> = -2
Def<MTEXT$> = "Loading groups..."
Def<MTYPE$> = "U"
MsgUp = Msg(@window, Def) ;* display the processing message
ADGroupData = Active_Directory_Services('GetADGroupsByString', 'MES-Mesa*', 'INFINEON')
ADGroupData<-1> = Active_Directory_Services('GetADGroupsByString', 'IFX-IRF-Mesa*', 'INFINEON')
ADGroupData<-1> = Active_Directory_Services('GetADGroupsByString', 'KLU-Mesa*', 'INFINEON')
ADGroupData = SRP_Array('Clean', ADGroupData, 'TrimAndMakeUnique', @FM)
NumRows = DCount(ADGroupData, @FM)
If NumRows GT 0 then
For RowIndex = 1 to NumRows
ThisGroupID = ADGroupData<RowIndex, 1>
Selected = InList(SelGroups, ThisGroupID, @VM)
ADGroupData = Insert(ADGroupData, RowIndex, 1, 0, Selected)
Next RowIndex
end
Set_Property(@Window:'.EDT_AD_GROUPS', 'LIST', ADGroupData)
ColStyles = Send_Message(@Window:'.EDT_AD_GROUPS','COLSTYLE',0,'')
ColStyles<1> = BitOr(ColStyles<1>,DTCS_CHECKBOX$)
ColStyles<1> = BitOr(ColStyles<1>,DTCS_CHECKBOXCENTER$)
void = Send_Message(@Window:'.EDT_AD_GROUPS','COLSTYLE',0,ColStyles)
Msg(@window, MsgUp) ;* take down the processing message
End Event
Event PUB_OK.CLICK()
SelGroups = ''
List = Get_Property(@Window:'.EDT_AD_GROUPS', 'LIST')
If List NE '' then
For each Row in List using @FM setting RowIndex
RowSelected = Row<0, 1>
If RowSelected then
SelGroups<-1> = Row<0, 2> : @VM : Row<0, 3> : @VM : Row<0, 4>
end
Next Row
end
End_Dialog(@Window, SelGroups)
end event
Event PUB_CANCEL.CLICK()
End_Dialog(@Window, '')
end event
Event EDT_AD_GROUPS.ROWSELCHANGED(SelRow, SelState)
Def = ""
Def<MCOL$> = -2
Def<MROW$> = -2
Def<MTEXT$> = "Loading group data..."
Def<MTYPE$> = "U"
MsgUp = Msg(@window, Def) ;* display the processing message
List = Get_Property(CtrlEntId, 'LIST')
RowData = List<SelRow>
GroupName = RowData<0, 2>
Array = Get_Property(@Window, '@':GroupName)
If Array EQ '' then
MemberList = Active_Directory_Services('GetADGroupMembersByGroupName', GroupName, 'INFINEON')
MemberList = SRP_Array('Rotate', MemberList, @FM, @VM)
ADUserNames = MemberList<1>
LSLUserNames = ''
LSLNames = ''
Open 'DICT.LSL_USERS' to hDict then
For each ADUserName in ADUserNames using @VM setting vPos
Query = 'DOMAIN_USERNAME':@VM:ADUserName:@FM
Flag = ''
LSLUsername = ''
Btree.Extract(Query, 'LSL_USERS', hDict, LSLUsername, '', Flag)
LSLUsernames<0, vPos> = LSLUsername<0, 1>
LSLNames<0, vPos> = Xlate('LSL_USERS', LSLUserName<0, 1>, 'FIRST_LAST', 'X')
Next ADUserName
end
Array = ADUsernames : @FM : LSLUsernames : @FM : LSLNames
Set_Property(@Window, '@':GroupName, Array)
end
Set_Property(@Window:'.EDT_AD_MEMBERS', 'ARRAY', Array)
Msg(@window, MsgUp) ;* take down the processing message
end event

3
LSL2/STPROC/NDW_AUDIT_REPORT_EVENTS.txt
View File

@ -93,7 +93,7 @@ Set_List:
List = ""
Table = "AUDIT_WO_MAST_SCHED"
Field = "DATE_IN"
Update_Index(Table, Field, No$)
Update_Index(Table, Field, No$, True$)
Open Table to hTable else null
@ -133,3 +133,4 @@ Set_List:
Set_Property(@Window:".RPT_LIST", "OLE.List", List)
return

2
LSL2/STPROC/NDW_MAIN_EVENTS.txt
View File

@ -378,6 +378,7 @@ Event WINDOW.TIMER()
end
Notes_Services('UpdateNotes', @User4)
If Error_Services('HasError') then Error_Services('DisplayError')
NewMessages = Notes_Services('GetUnreadMessageCount', @User4)
ColorFill = ''
@ -852,3 +853,4 @@ return

438
LSL2/STPROC/NDW_NOTIFICATION_EVENTS.txt Normal file
View File

@ -0,0 +1,438 @@
Compile function NDW_NOTIFICATION_EVENTS(CtrlEntId, Event, @PARAMS)
/***********************************************************************************************************************
This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
permission from Infineon.
Name : NDW_Notification_Events
Description : This function acts as a commuter module for all events related to this window.
Notes : Commuter Modules are automatically called from the Promoted_Events function which is called by the
application-specific promoted event handler. This makes it possible to add QuickEvents that need to
execute Basic+ logic without having use the Form Designer to make the association, although this is
limited to the events which are currently promoted.
If the form needs to call the commuter module directly then the QuickEvent parameters should be
formatted like this:
'@SELF','@EVENT',['@PARAM1','@PARAMx']
Parameters :
CtrlEntId [in] -- The fully qualified name of the control calling the promoted event
Event [in] -- The event being executed. See the Notes section regarding "PRE" events
Param1-15 [in] -- Additional event parameter holders
EventFlow [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
EVENT_SETUP insert
History : (Date, Initials, Notes)
09/30/24 djs Created initial commuter module.
***********************************************************************************************************************/
#pragma precomp SRP_PreCompiler
#window NDW_NOTIFICATION
$Insert EVENT_SETUP
$Insert APP_INSERTS
$Insert MSG_EQUATES
$Insert POPUP_EQUATES
$Insert NOTIFICATION_EQUATES
EQU READONLY_GREEN$ TO 192 + (220*256) + (192*65536)
Declare function Admin_User, Database_Services, Error_Services, Active_Directory_Services, SRP_Array
Declare subroutine PlaceDialog, Error_Services, Database_Services, Btree.Extract
GoToEvent Event for CtrlEntId else
// Event not implemented
end
Return EventFlow or 1
//-----------------------------------------------------------------------------
// EVENT HANDLERS
//-----------------------------------------------------------------------------
Event WINDOW.CREATE(CreateParam)
PlaceDialog(-2, -2)
ColorArray = Send_Message(@Window:'.EDT_LSL_USERS', "COLOR_BY_POS", 2, 0)
ColorArray<1> = READONLY_GREEN$
Send_Message(@Window:'.EDT_LSL_USERS', "COLOR_BY_POS", 1, 0, ColorArray)
Send_Message(@Window:'.EDT_LSL_USERS', "COLOR_BY_POS", 2, 0, ColorArray)
Send_Message(@Window:'.EDT_AD_GROUPS', "COLOR_BY_POS", 1, 0, ColorArray)
Send_Message(@Window:'.EDT_AD_GROUPS', "COLOR_BY_POS", 2, 0, ColorArray)
Send_Message(@Window:'.EDT_AD_GROUPS', "COLOR_BY_POS", 3, 0, ColorArray)
End Event
Event WINDOW.READ()
Key = Get_Property(@Window:'.EDL_NOTIFICATION_ID', 'TEXT')
Begin Case
Case Key EQ ''
Set_Property(@Window:'.EDT_LSL_USERS', 'ENABLED', False$)
Case RowExists('NOTIFICATION', Key)
// Populate form
HaveLock = Database_Services('GetKeyIDLock', 'NOTIFICATION', Key, True$)
If HaveLock then
Set_Property(@Window, '@HAVE_LOCK', HaveLock)
Set_Property(@Window, '@LOCK_KEY', Key)
Set_Property(@Window:'.EDL_DESCRIPTION', 'ENABLED', True$)
Set_Property(@Window:'.CHK_USE_AD', 'ENABLED', True$)
Set_Property(@Window:'.CHK_LIMIT_TO_ACTIVE_SHIFT', True$)
Set_Property(@Window:'.PUB_CLEAR', 'ENABLED', True$)
Set_Property(@Window:'.PUB_DELETE', 'ENABLED', True$)
Set_Property(@Window:'.PUB_SAVE', 'ENABLED', True$)
NotifyRec = Database_Services('ReadDataRow', 'NOTIFICATION', Key)
If Error_Services('NoError') then
Set_Property(@Window, '@RECORD', NotifyRec)
Set_Property(@Window:'.EDL_DESCRIPTION', 'TEXT', NotifyRec<NOTIFICATION_DESC$>)
UseAD = NotifyRec<NOTIFICATION_USE_ACTIVE_DIRECTORY$>
Set_Property(@Window:'.CHK_USE_AD', 'DEFPROP', UseAD)
LimitOnShift = NotifyRec<NOTIFICATION_LIMIT_TO_ACTIVE_SHIFT$>
Set_Property(@Window:'.CHK_LIMIT_TO_ACTIVE_SHIFT', 'DEFPROP', LimitOnShift)
LSLUsers = NotifyRec<NOTIFICATION_USER_ID$>
LSLUsernames = Xlate('LSL_USERS', LSLUsers, 'FIRST_LAST', 'X')
LSLUsersArray = LSLUsers : @FM : LSLUsernames
Set_Property(@Window:'.EDT_LSL_USERS', 'ARRAY', LSLUsersArray)
ADGroups = NotifyRec<NOTIFICATION_ACTIVE_DIRECTORY_GROUPS$>
GroupList = ''
If ADGroups NE '' then
For each ADGroup in ADGroups using @VM setting vPos
GroupList<-1> = Active_Directory_Services('GetADGroupsByString', ADGroup, 'INFINEON')
Next ADGroup
end
Set_Property(@Window:'.EDT_AD_GROUPS', 'LIST', GroupList)
GoSub EnableControls
end else
Msg(@Window, '', 'OK', '', 'Error':@FM:'Error locking NOTIFICATION record "':Key:'" for update!')
end
end else
Msg(@Window, '', 'OK', '', 'Error':@FM:'Error reading NOTIFICATION record "':Key:'"!')
end
Case Otherwise$
// User is creating a new record
Set_Property(@Window:'.PUB_ADD_USERS', 'ENABLED', True$)
GoSub EnableControls
End Case
end event
Event WINDOW.CLEAR(bSaveKey, bSuppressWarning, bMaintainFocus)
GoSub EnableControls
Set_Property(@Window:'.PUB_DELETE', 'ENABLED', False$)
Set_Property(@Window:'.PUB_CLEAR', 'ENABLED', True$)
Set_Property(@Window:'.EDL_DESCRIPTION', 'ENABLED', False$)
Set_Property(@Window:'.CHK_USE_AD', 'ENABLED', False$)
Set_Property(@Window:'.CHK_LIMIT_TO_ACTIVE_SHIFT', 'ENABLED', False$)
Set_Property(@Window:'.PUB_ADD_USERS', 'ENABLED', False$)
Set_Property(@Window:'.REM_ADD_USERS', 'ENABLED', False$)
Set_Property(@Window:'.GRB_AD_GROUPS', 'ENABLED', False$)
Set_Property(@Window:'.EDT_AD_GROUPS', 'ENABLED', False$)
Set_Property(@Window:'.PUB_ADD_GROUPS', 'ENABLED', False$)
Set_Property(@Window:'.REM_ADD_GROUPS', 'ENABLED', False$)
end event
Event WINDOW.WRITE()
Key = Get_Property(@Window:'.EDL_NOTIFICATION_ID', 'TEXT')
NotifyRec = Get_Property(@Window, '@RECORD')
NotifyRec<NOTIFICATION_DESC$> = Get_Property(@Window:'.EDL_DESCRIPTION', 'TEXT')
UserArray = Get_Property(@Window:'.EDT_LSL_USERS', 'ARRAY')
UserIds = UserArray<1>
NotifyRec<NOTIFICATION_USER_ID$> = UserIds
GroupArray = Get_Property(@Window:'.EDT_AD_GROUPS', 'ARRAY')
GroupIds = GroupArray<1>
NotifyRec<NOTIFICATION_ACTIVE_DIRECTORY_GROUPS$> = GroupIds
NotifyRec<NOTIFICATION_USE_ACTIVE_DIRECTORY$> = Get_Property(@Window:'.CHK_USE_AD', 'DEFPROP')
NotifyRec<NOTIFICATION_LIMIT_TO_ACTIVE_SHIFT$> = Get_Property(@Window:'.CHK_LIMIT_TO_ACTIVE_SHIFT', 'DEFPROP')
Database_Services('WriteDataRow', 'NOTIFICATION', Key, NotifyRec, True$, False$, True$)
If Error_Services('NoError') then
GoSub UnlockRec
Post_Event(@Window, 'CLEAR')
end else
Msg(@Window, '', 'OK', '', 'Error':@FM:Error_Services('GetMessage'))
end
end event
Event WINDOW.CLOSE(CancelFlag, CloseFlags)
GoSub UnlockRec
end event
Event PUB_SAVE.CLICK()
Post_Event(@Window, 'WRITE')
end event
Event PUB_CLEAR.CLICK()
GoSub UnlockRec
Post_Event(@Window, 'CLEAR')
end event
Event PUB_LU_ID.CLICK()
TypeOver = ''
TypeOver<PSELECT$> = 1
NotifyID = Popup(@WINDOW,TypeOver,'NOTIFICATION')
IF NotifyID NE '' THEN
Set_Property(@Window:'.EDL_NOTIFICATION_ID', 'TEXT', NotifyID)
end
end event
Event EDT_LSL_USERS.ROWSELCHANGED(SelRow, SelState)
GoSub EnableControls
end event
Event EDT_AD_GROUPS.ROWSELCHANGED(SelRow, SelState)
GoSub EnableControls
end event
Event EDL_NOTIFICATION_ID.CHANGED(NewData)
If NewData NE '' then
GoSub UnlockRec
Post_Event(@Window, 'READ')
end
end event
Event EDL_NOTIFICATION_ID.LOSTFOCUS(Flag, FocusID)
If Flag EQ 1 then
GoSub UnlockRec
Post_Event(@Window, 'READ')
end
end event
Event PUB_ADD_USERS.CLICK()
CurrUserIDs = Get_Property(@Window:'.EDT_LSL_USERS','ARRAY')<1>
CurrUserIDsTrimmed = ''
FOR I = 1 TO COUNT(CurrUserIDs,@VM) + (CurrUserIDs NE '')
IF CurrUserIDs<1,I> NE '' THEN
CurrUserIDsTrimmed<1,I> = CurrUserIDs<1,I>
END
NEXT I
CurrUserIDs = CurrUserIDsTrimmed
NewUserIDs = Popup(@WINDOW,'','SHOW_USERS')
IF NewUserIDs = '' OR NewUserIDs = CHAR(27) THEN RETURN
FOR I = 1 TO COUNT(NewUserIDs,@VM) + (NewUserIDs NE '')
NewUserID = NewUserIDs<1,I>
LOCATE NewUserID IN CurrUserIDs BY 'AL' USING @VM SETTING POS ELSE
CurrUserIDs = INSERT(CurrUserIDs,1,POS,0,NewUserID)
END
NEXT I
LSLNames = Xlate('LSL_USERS', CurrUserIDs, 'FIRST_LAST', 'X')
NewArray = CurrUserIDs : @FM : LSLNames
Set_Property(@Window:'.EDT_LSL_USERS', 'ARRAY', NewArray)
end event
Event PUB_REM_USERS.CLICK()
SelRows = Get_Property(@Window:'.EDT_LSL_USERS', 'SELPOS')
SelRows = SelRows<2>
SelData = ''
NewList = ''
If SelRows NE '' then
DataList = Get_Property(@Window:'.EDT_LSL_USERS', 'LIST')
For each Row in DataList using @FM setting RowIndex
If Not(InList(SelRows, RowIndex, @VM)) then NewList<-1> = Row
Next Row
Set_Property(@Window:'.EDT_LSL_USERS', 'LIST', NewList)
GoSub EnableControls
end
end event
Event PUB_ADD_GROUPS.CLICK()
GroupArray = Get_Property(@Window:'.EDT_AD_GROUPS', 'ARRAY')
GroupIds = GroupArray<1>
SelGroups = Dialog_Box('NDW_ACTIVE_DIRECTORY_GROUPS', @Window, GroupIds)
Set_Property(@Window:'.EDT_AD_GROUPS', 'LIST', SelGroups)
Def = ""
Def<MCOL$> = -2
Def<MROW$> = -2
Def<MTEXT$> = "Updating LSL user list..."
Def<MTYPE$> = "U"
MsgUp = Msg(@window, Def) ;* display the processing message
GroupArray = Get_Property(@Window:'.EDT_AD_GROUPS', 'ARRAY')
GroupIds = GroupArray<1>
If GroupIds NE '' then
LSLUserNames = ''
LSLNames = ''
For each GroupId in GroupIds using @VM
MemberList = Active_Directory_Services('GetADGroupMembersByGroupName', GroupId, 'INFINEON')
MemberList = SRP_Array('Rotate', MemberList, @FM, @VM)
ADUserNames = MemberList<1>
Open 'DICT.LSL_USERS' to hDict then
For each ADUserName in ADUserNames using @VM setting vPos
Query = 'DOMAIN_USERNAME':@VM:ADUserName:@FM
Flag = ''
LSLUsername = ''
Btree.Extract(Query, 'LSL_USERS', hDict, LSLUsername, '', Flag)
If LSLUsername NE '' then LSLUsernames<0, -1> = LSLUsername<0, 1>
Next ADUserName
end
Next GroupId
If LSLUsernames NE '' then
LSLNames = Xlate('LSL_USERS', LSLUserNames, 'FIRST_LAST', 'X')
end
end
Array = LSLUsernames : @FM : LSLNames
Set_Property(@Window:'.EDT_LSL_USERS', 'ARRAY', Array)
Msg(@window, MsgUp) ;* take down the processing message
end event
Event PUB_REM_GROUPS.CLICK()
SelRows = Get_Property(@Window:'.EDT_AD_GROUPS', 'SELPOS')
SelRows = SelRows<2>
SelData = ''
NewList = ''
If SelRows NE '' then
DataList = Get_Property(@Window:'.EDT_AD_GROUPS', 'LIST')
For each Row in DataList using @FM setting RowIndex
If Not(InList(SelRows, RowIndex, @VM)) then NewList<-1> = Row
Next Row
Set_Property(@Window:'.EDT_AD_GROUPS', 'LIST', NewList)
GoSub EnableControls
end
end event
Event CHK_USE_AD.CLICK()
GoSub EnableControls
end event
EnableControls:
NotifyID = Get_Property(@Window:'.EDL_NOTIFICATION_ID', 'TEXT')
UseAD = Get_Property(@Window:'.CHK_USE_AD', 'DEFPROP')
Set_Property(@Window:'.PUB_CLEAR', 'ENABLED', (NotifyID NE ''))
Set_Property(@Window:'.EDL_DESCRIPTION', 'ENABLED', (NotifyID NE ''))
Set_Property(@Window:'.CHK_USE_AD', 'ENABLED', (NotifyID NE ''))
If UseAD NE True$ then Set_Property(@Window:'.CHK_LIMIT_TO_ACTIVE_SHIFT', 'DEFPROP', False$)
Set_Property(@Window:'.CHK_LIMIT_TO_ACTIVE_SHIFT', 'ENABLED', UseAD)
Set_Property(@Window:'.PUB_ADD_USERS', 'ENABLED', (UseAD NE True$))
Set_Property(@Window:'.EDT_LSL_USERS', 'ENABLED', (NotifyID NE ''))
If NotifyID NE '' then
Backcolor = WHITE$
end else
Backcolor = GREY$
end
Set_Property(@Window:'.EDT_LSL_USERS', 'BACKCOLOR', Backcolor)
Set_Property(@Window:'.GRB_AD_GROUPS', 'ENABLED', (UseAD EQ True$))
Set_Property(@Window:'.PUB_ADD_GROUPS', 'ENABLED', (UseAD EQ True$))
Set_Property(@Window:'.EDT_AD_GROUPS', 'ENABLED', (UseAD EQ True$))
If ( (NotifyID NE '') and (UseAD EQ True$) ) then
Backcolor = WHITE$
end else
Backcolor = GREY$
end
Set_Property(@Window:'.EDT_AD_GROUPS', 'BACKCOLOR', Backcolor)
DelBtnEnabled = False$
SelRows = Get_Property(@Window:'.EDT_LSL_USERS', 'SELPOS')
SelRows = SelRows<2>
SelData = ''
If SelRows NE '' then
Data = Get_Property(@Window:'.EDT_LSL_USERS', 'LIST')
Convert @VM to '' in Data
For each Row in SelRows using @VM
If Data<Row> NE '' then
SelData<-1> = Data<Row>
end
Next Row
If (SelData NE '') and (UseAD NE True$) then DelBtnEnabled = True$
end
Set_Property(@Window:'.PUB_REM_USERS', 'ENABLED', DelBtnEnabled)
DelBtnEnabled = False$
SelRows = Get_Property(@Window:'.EDT_AD_GROUPS', 'SELPOS')
SelRows = SelRows<2>
SelData = ''
If SelRows NE '' then
Data = Get_Property(@Window:'.EDT_AD_GROUPS', 'LIST')
Convert @VM to '' in Data
For each Row in SelRows using @VM
If Data<Row> NE '' then
SelData<-1> = Data<Row>
end
Next Row
If (SelData NE '') and (UseAD EQ True$) then DelBtnEnabled = True$
end
Set_Property(@Window:'.PUB_REM_GROUPS', 'ENABLED', DelBtnEnabled)
return
UnlockRec:
Key = Get_Property(@Window, '@LOCK_KEY')
If Key NE '' then
HaveLock = Get_Property(@Window, '@HAVE_LOCK')
If HaveLock then
Database_Services('ReleaseKeyIDLock', 'NOTIFICATION', Key)
end
end
return

3
LSL2/STPROC/NDW_SCHEDULE_SEARCH_EVENTS.txt
View File

@ -67,7 +67,7 @@ OnClick.HYP_FIND:
Case Field EQ "WO" ; Field = "WO_NO2"
Case Field EQ "PSN" ; Field = "PSN_NO"
End Case
Update_Index(Table, Field, No$)
Update_Index(Table, Field, No$, Yes$)
Extract_SI_Keys(Table, Field, Find, Keys)
rv = Xlate(Table, Keys, "REACT_NO", "X") :@FM: Xlate(Table, Keys, "WO_NO", "X") :@FM: Keys
Appts = "";!!
@ -109,3 +109,4 @@ Window.CREATE:
SRP_Redirect_OLE_Events()
return

579
LSL2/STPROC/NOTES_SERVICES.txt
View File

@ -1,15 +1,80 @@
Compile function Notes_Services(@Service, @Params)
/***********************************************************************************************************************
Declare function Database_Services,obj_Notes_Sent, Get_Status, Error_Services, Obj_Tables, Datetime, SRP_Datetime
Declare subroutine Obj_Tables, Obj_Notes_Sent, Update_Index, Errmsg, Database_Services, Btree.Extract, Error_Services
Declare subroutine Notes_Services
Name : RDS_Services
Description : Handler program for all RDS services.
Notes : Application errors should be logged using the Error Services module. There are a few methodological
assumptions built into way errors are managed which are important to understand in order to properly
work with Error Services:
- The term 'top' refers to the originating procedure of a call stack and the term 'bottom' refers to
the last routine (or the current routine) within a call stack. Within the OpenInsight Debugger
this will appear backwards since the originating procedure always appears at the bottom of the
list and the current routine appears at the top of the list. We are using this orientation because
it is common to refer to the process of calling other procedures as 'drilling down'.
- The reason for defining the orientation of the call stack is because Error_Services allows for
multiple error conditions to be appended to an original error. In most cases this will happen when
a procedure at the bottom of the stack generates an error condition and then returns to its
calling procedure. This higher level procedure can optionally add more information relevant to
itself. This continues as the call stack 'bubbles' its way back to the top to where the
originating procedure is waiting.
- Native OpenInsight commands that handle errors (e.g., Set_Status, Set_FSError, Set_EventStatus)
preserve their error state until explicitly cleared. This can hinder the normal execution of code
since subsequent procedures (usually SSPs) will fail if a pre-existing error condition exists.
Our philosophy is that error conditions should automatically be cleared before a new procedure
is executed to avoid this problem. However, the nature of Basic+ does not make this easy to
automate for any given stored procedure. Therefore, if a stored procedure wants to conform to our
philosophy then it should include a call into the 'Clear' service request at the top of the
program. Alternatively this can be done through a common insert (see SERVICE_SETUP for example.)
- Service modules will use the SERVICE_SETUP insert and therefore automatically clear out any
error conditions that were set before.
Parameters :
Service [in] -- Name of the service being requested
Param1-10 [in/out] -- Additional request parameter holders
Response [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
Metadata :
History : (Date, Initials, Notes)
10/16/24 djs Added service to process notes queue.
***********************************************************************************************************************/
#pragma precomp SRP_PreCompiler
$insert LOGICAL
$insert NOTE_PTRS_EQU
$insert MSG_EQUATES
$Insert NOTES_EQU
*$Insert NOTES_EQUATES
$Insert SERVICE_SETUP
$Insert LOGICAL
$Insert NOTE_PTRS_EQUATES
$Insert MSG_EQUATES
$Insert NOTES_EQUATES
$Insert LSL_USERS_EQUATES
$Insert EMAIL_BOX_EQUATES
$Insert NOTES_QUEUE_EQUATES
$Insert NOTIFICATION_EQUATES
Declare function Database_Services, obj_Notes_Sent, Get_Status, Error_Services, Obj_Tables, Datetime, SRP_Datetime
Declare function SRP_Array, Environment_Services, Logging_Services, RTI_CreateGuid, LSL_Users_Services
Declare subroutine Obj_Tables, Obj_Notes_Sent, Update_Index, Errmsg, Database_Services, Btree.Extract, Error_Services
Declare subroutine Notes_Services, Logging_Services
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\NOTES'
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Notes Queue Processing Log.csv'
Headers = 'Logging DTM' : @FM : 'Notes Queue ID' : @FM : 'Notes'
objNotesQProcLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Notes Queue Log.csv'
Headers = 'Logging DTM' : @FM : 'Notes Queue ID' : @FM : 'Notes'
objNotesQueueLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
GoToService
@ -20,36 +85,40 @@ Return Response or ""
//-----------------------------------------------------------------------------
Service SnoozeNewMessageNotifications(UserID)
Open 'NOTE_PTRS' to hTable then
SnoozeTime = Datetime()
WriteV SnoozeTime to hTable, UserID, NOTE_PTRS_SNOOZE$ else
Errmsg('Error setting snooze.')
end
SnoozeTime = Datetime()
WriteV SnoozeTime to hTable, UserID, NOTE_PTRS_SNOOZE$ else
Errmsg('Error setting snooze.')
end
end else
Errmsg('Error setting snooze.')
Errmsg('Error setting snooze.')
end
end service
Service AllowNewMessageNotifications(UserID)
Open 'NOTE_PTRS' to hTable then
SnoozeTime = ''
WriteV SnoozeTime to hTable, UserID, NOTE_PTRS_SNOOZE$ else
Errmsg('Error setting snooze.')
end
SnoozeTime = ''
WriteV SnoozeTime to hTable, UserID, NOTE_PTRS_SNOOZE$ else
Errmsg('Error setting snooze.')
end
end else
Errmsg('Error setting snooze.')
Errmsg('Error setting snooze.')
end
end service
Service CheckForNotificationSnooze(UserID)
SnoozeRow = ''
Snoozed = FALSE$
UserRec = Database_Services('ReadDataRow','NOTE_PTRS', @USER4, '', '', '')
SnoozeRow = ''
Snoozed = FALSE$
UserRec = Database_Services('ReadDataRow','NOTE_PTRS', @USER4, '', '', '')
CurrentTime = Datetime()
SnoozeRow = UserRec<NOTE_PTRS_SNOOZE$>
SnoozeRow = UserRec<NOTE_PTRS_SNOOZE$>
If SnoozeRow NE '' then
CutoffTime = SRP_DateTime("AddMinutes", SnoozeRow, 30)
If CurrentTime LE CutoffTime then
@ -62,8 +131,9 @@ Service CheckForNotificationSnooze(UserID)
end service
Service GetInboxMessages(UserID)
//debug
InboxList = ''
UserRec = Database_Services('ReadDataRow','NOTE_PTRS', @USER4, '', '', '')
MessageCount = Dcount(UserRec<1>, @VM)
@ -80,10 +150,12 @@ Service GetInboxMessages(UserID)
end
Next index
Response = InboxList
end service
Service GetArchivedMessages(UserID)
//debug
ArchiveList = ''
UserRec = Database_Services('ReadDataRow','NOTE_PTRS', @USER4, '', '', '')
MessageCount = Dcount(UserRec<1>, @VM)
@ -100,142 +172,379 @@ Service GetArchivedMessages(UserID)
end
Next index
Response = ArchiveList
end service
Service UpdateNotes(UserID)
ErrorMsg = ''
IF UserID = '' THEN ErrorMsg = 'Unassigned Parameter "UserID" passed to object. (':Method:')'
IF ErrorMsg NE '' THEN RETURN
//OtParms = 'NOTE_PTRS':@RM:UserID
//NPRec = obj_Tables('ReadRec',OtParms) ;* If not found then returns null, otherwise reads and sets the lock
NPRec = Database_Services('ReadDataRow', 'NOTE_PTRS', UserID)
IF LEN(NPRec) > 60000 THEN
* Dump the oldest note pointers
PtrCnt = COUNT(NPRec<note_ptrs_from$>, @vm) + (NPRec<note_ptrs_from$> NE '')
FOR N = PtrCnt TO (PtrCnt - 100) STEP -1
NPRec = Delete(NPRec, note_ptrs_subject$, N, 0)
NPRec = Delete(NPRec, note_ptrs_from$, N, 0)
NPRec = Delete(NPRec, note_ptrs_date$, N, 0)
NPRec = Delete(NPRec, note_ptrs_time$, N, 0)
NPRec = Delete(NPRec, note_ptrs_new$, N, 0)
NPRec = Delete(NPRec, note_ptrs_note_ids$, N, 0)
NPRec = Delete(NPRec, note_ptrs_attachment$, N, 0)
NPRec = Delete(NPRec, note_ptrs_archived$, N, 0)
NEXT N
TLen = LEN(NPRec)
END
NotesSentKeys = obj_Notes_Sent('GetUserKeys',UserID)
IF NotesSentKeys NE '' THEN
FOR I = 1 TO COUNT(NotesSentKeys,@VM) + (NotesSentKeys NE '')
NotesSentKey = NotesSentKeys<1,I>
NoteID = FIELD(NotesSentKey,'*',2)
LOCATE NoteID IN NPRec<NOTE_PTRS_NOTE_IDS$> USING @VM SETTING POS ELSE
NoteRec = XLATE('NOTES',NoteID,'','X')
SentFrom = NoteRec<NOTES_FROM$>
SentDate = NoteRec<NOTES_ENTRY_DATE$>
SentTime = NoteRec<NOTES_ENTRY_TIME$>
AttachWindow = NoteRec<NOTES_ATTACH_WINDOW$>
AttachKeys = NoteRec<NOTES_ATTACH_KEYS$>
Subject = NoteRec<NOTES_SUBJECT$>
IF AttachWindow NE '' AND AttachKeys NE '' THEN
Attachment = 'Yes'
END ELSE
Attachment = 'No'
ErrorMsg = ''
IF UserID NE '' then
NPRec = Database_Services('ReadDataRow', 'NOTE_PTRS', UserID)
If Error_Services('NoError') then
IF LEN(NPRec) > 60000 THEN
* Dump the oldest note pointers
PtrCnt = COUNT(NPRec<note_ptrs_from$>, @vm) + (NPRec<note_ptrs_from$> NE '')
FOR N = PtrCnt TO (PtrCnt - 100) STEP -1
NPRec = Delete(NPRec, note_ptrs_subject$, N, 0)
NPRec = Delete(NPRec, note_ptrs_from$, N, 0)
NPRec = Delete(NPRec, note_ptrs_date$, N, 0)
NPRec = Delete(NPRec, note_ptrs_time$, N, 0)
NPRec = Delete(NPRec, note_ptrs_new$, N, 0)
NPRec = Delete(NPRec, note_ptrs_note_ids$, N, 0)
NPRec = Delete(NPRec, note_ptrs_attachment$, N, 0)
NPRec = Delete(NPRec, note_ptrs_archived$, N, 0)
NEXT N
TLen = LEN(NPRec)
END
NPRec = INSERT( NPRec, note_ptrs_subject$, 1, 0, Subject ) ;* Add the subject
NotesSentKeys = obj_Notes_Sent('GetUserKeys',UserID)
ConvSentFrom = OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
IF ConvSentFrom NE '' THEN SentFrom = ConvSentFrom
IF NotesSentKeys NE '' THEN
FOR I = 1 TO COUNT(NotesSentKeys,@VM) + (NotesSentKeys NE '')
NPRec = INSERT( NPRec, note_ptrs_from$, 1, 0, SentFrom )
NPRec = INSERT( NPRec, note_ptrs_date$, 1, 0, OCONV(SentDate,'D2/') )
NPRec = INSERT( NPRec, note_ptrs_time$, 1, 0, OCONV(SentTime,'MTH') )
NPRec = INSERT( NPRec, note_ptrs_new$, 1, 0, 'Yes' )
NPRec = INSERT( NPRec, note_ptrs_note_ids$, 1, 0, NoteID )
NPRec = INSERT( NPRec, note_ptrs_attachment$, 1, 0, Attachment )
NPRec = INSERT( NPRec, note_ptrs_archived$, 1, 0, '0' )
END
Database_Services('WriteDataRow', 'NOTE_PTRS', UserID, NPRec, True$, False$, True$)
NEXT I
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END ELSE
obj_Notes_Sent('Delete',NotesSentKeys)
NotesSentKey = NotesSentKeys<1,I>
NoteID = FIELD(NotesSentKey,'*',2)
Update_Index('NOTES_SENT','USER_ID','')
END
END ELSE
//obj_Tables('UnlockRec',OtParms)
END
LOCATE NoteID IN NPRec<NOTE_PTRS_NOTE_IDS$> USING @VM SETTING POS ELSE
NoteRec = XLATE('NOTES',NoteID,'','X')
SentFrom = NoteRec<NOTES_FROM$>
SentDate = NoteRec<NOTES_ENTRY_DATE$>
SentTime = NoteRec<NOTES_ENTRY_TIME$>
AttachWindow = NoteRec<NOTES_ATTACH_WINDOW$>
AttachKeys = NoteRec<NOTES_ATTACH_KEYS$>
Subject = NoteRec<NOTES_SUBJECT$>
IF AttachWindow NE '' AND AttachKeys NE '' THEN
Attachment = 'Yes'
END ELSE
Attachment = 'No'
END
NPRec = INSERT( NPRec, note_ptrs_subject$, 1, 0, Subject ) ;* Add the subject
ConvSentFrom = OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
IF ConvSentFrom NE '' THEN SentFrom = ConvSentFrom
NPRec = INSERT( NPRec, note_ptrs_from$, 1, 0, SentFrom )
NPRec = INSERT( NPRec, note_ptrs_date$, 1, 0, OCONV(SentDate,'D2/') )
NPRec = INSERT( NPRec, note_ptrs_time$, 1, 0, OCONV(SentTime,'MTH') )
NPRec = INSERT( NPRec, note_ptrs_new$, 1, 0, 'Yes' )
NPRec = INSERT( NPRec, note_ptrs_note_ids$, 1, 0, NoteID )
NPRec = INSERT( NPRec, note_ptrs_attachment$, 1, 0, Attachment )
NPRec = INSERT( NPRec, note_ptrs_archived$, 1, 0, '0' )
END
Database_Services('WriteDataRow', 'NOTE_PTRS', UserID, NPRec, True$, False$, True$)
NEXT I
IF Get_Status(errCode) THEN
ErrorMsg = 'Error in service: ':Service:'. Error code: ':errCode
END ELSE
obj_Notes_Sent('Delete',NotesSentKeys)
Update_Index('NOTES_SENT','USER_ID', False$, True$)
END
END
end else
ErrorMsg = Error_Services('GetMessage')
end
end else
ErrorMsg = 'Error in service: ':Service:'. Unassigned Parameter "UserID" passed into service.'
end
If ErrorMsg NE '' then Error_Services('Add', ErrorMsg)
end service
Service GetUnreadMessageCount(UserID)
unreadMessageCount = 0
IF UserID NE '' then
if xlate( 'NOTE_PTRS', @user4, 'NEW_MESSAGES', 'X' ) then
NotePtrRec = xlate( 'NOTE_PTRS', @user4, '', 'X' )
LOCATE 'Yes' in NotePtrRec<note_ptrs_new$> using @VM setting mPos then
*If any are marked as yes, that means there are unread messages
for each messageRead in NotePtrRec<note_ptrs_new$> using @VM
if messageRead EQ 'Yes' then unreadMessageCount += 1
Next message
end
end
end
Response = unreadMessageCount
unreadMessageCount = 0
IF UserID NE '' then
if xlate( 'NOTE_PTRS', @user4, 'NEW_MESSAGES', 'X' ) then
NotePtrRec = xlate( 'NOTE_PTRS', @user4, '', 'X' )
LOCATE 'Yes' in NotePtrRec<note_ptrs_new$> using @VM setting mPos then
*If any are marked as yes, that means there are unread messages
for each messageRead in NotePtrRec<note_ptrs_new$> using @VM
if messageRead EQ 'Yes' then unreadMessageCount += 1
Next message
end
end
end
Response = unreadMessageCount
end service
Service GetNewMessages(UserId)
NotesSentKeys = ''
IF UserId NE '' THEN
OPEN 'DICT.NOTES_SENT' TO DictVar THEN
SearchString = 'USER_ID':@VM:UserId:@FM
Flag = ''
Btree.Extract(SearchString,'NOTES_SENT',DictVar,NotesSentKeys,'',Flag)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
END
end
Response = NotesSentKeys
NotesSentKeys = ''
IF UserId NE '' THEN
OPEN 'DICT.NOTES_SENT' TO DictVar THEN
SearchString = 'USER_ID':@VM:UserId:@FM
Flag = ''
Btree.Extract(SearchString,'NOTES_SENT',DictVar,NotesSentKeys,'',Flag)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
END
end
Response = NotesSentKeys
end service
Service MarkAllAsRead(UserId)
if UserID NE '' then
NotePtrsRec = Database_Services('ReadDataRow', 'NOTE_PTRS', UserId)
NotePtrsStatus = NotePtrsRec<NOTE_PTRS_NEW$>
for each NotePtrsRead in NotePtrsStatus using @VM setting nPos
NotePtrsRec<NOTE_PTRS_NEW$, nPos> = 'No'
Next NotePtrsRead
isNPRecCurrent = NotePtrsRec<NOTE_PTRS_TIME$> EQ Database_Services('ReadDataRow', 'NOTE_PTRS', UserId)<NOTE_PTRS_TIME$>
if isNPRecCurrent then
Database_Services('WriteDataRow','NOTE_PTRS', UserId, NotePtrsRec, '','', true$)
end
end else
Error_Services('Set', 'Error in Notes Service, MarkAllAsRead. UserId parameter not supplied')
end
if UserID NE '' then
NotePtrsRec = Database_Services('ReadDataRow', 'NOTE_PTRS', UserId)
NotePtrsStatus = NotePtrsRec<NOTE_PTRS_NEW$>
for each NotePtrsRead in NotePtrsStatus using @VM setting nPos
NotePtrsRec<NOTE_PTRS_NEW$, nPos> = 'No'
Next NotePtrsRead
isNPRecCurrent = NotePtrsRec<NOTE_PTRS_TIME$> EQ Database_Services('ReadDataRow', 'NOTE_PTRS', UserId)<NOTE_PTRS_TIME$>
if isNPRecCurrent then
Database_Services('WriteDataRow','NOTE_PTRS', UserId, NotePtrsRec, '','', true$)
end
end else
Error_Services('Set', 'Error in Notes Service, MarkAllAsRead. UserId parameter not supplied')
end
end service
Service SendNotes()
hSysLists = Database_Services('GetTableHandle', 'SYSLISTS')
Lock hSysLists, ServiceKeyID then
ErrorMsg = ''
Open 'NOTES_QUEUE' to hNotesQueue then
Select hNotesQueue
EOF = False$
Loop
ReadNext NotesQueueId else EOF = True$
Until EOF
// Send NOTES record
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Being processing NOTES_QUEUE record, "':NotesQueueID:'".'
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
DeleteRec = False$
Read NotesQueueRec from hNotesQueue, NotesQueueId then
NotesId = NotesQueueRec<NOTES_QUEUE.NOTES_ID$>
If NotesId NE '' then
NotesRec = Database_Services('ReadDataRow', 'NOTES', NotesId)
If Error_Services('NoError') then
If NotesRec NE '' then
DeleteRec = True$
Recipients = NotesRec<NOTES_SEND_TO$>
SentFrom = NotesRec<NOTES_FROM$>
Subject = NotesRec<NOTES_SUBJECT$>
Message = NotesRec<NOTES_MESSAGE$>
AttachWindow = NotesRec<NOTES_ATTACH_WINDOW$>
AttachKeys = NotesRec<NOTES_ATTACH_KEYS$>
SendToGroup = NotesRec<NOTES_MSG_GROUPS_IDS$>
GroupRecipients = ''
If SendToGroup NE '' then
NotifyGroupRecipients = ''
SecGroupRecipients = ''
For each GroupID in SendToGroup using @VM
If RowExists('NOTIFICATION', GroupID) then
GroupRec = Database_Services('ReadDataRow', 'NOTIFICATION', GroupID)
If Error_Services('NoError') then
GroupUsers = GroupRec<NOTIFICATION_USER_ID$>
LimitToOnShift = GroupRec<NOTIFICATION_LIMIT_TO_ACTIVE_SHIFT$>
If LimitToOnShift then
UsersOnShift = LSL_Users_Services('GetOnShiftUsers')
NotifyGroupRecipients = SRP_Array('Join', GroupUsers, UsersOnShift, 'AND', @VM)
end else
NotifyGroupRecipients = GroupUsers
end
end
end
If RowExists('SEC_GROUPS', GroupID) then
! Todo: Add SEC_GROUPS support
end
GroupRecipients = SRP_Array('Join', NotifyGroupRecipients, GroupRecipients, 'OR', @VM)
GroupRecipients = SRP_Array('Join', SecGroupRecipients, GroupRecipients, 'OR', @VM)
Next GroupID
end
thisRecipients = ''
RecipCnt = 0
Recipients = SRP_Array('Join', GroupRecipients, Recipients, 'OR', @VM)
thisRecipients = SRP_Array('Clean', Recipients, 'TrimAndMakeUnique', @VM)
RecipCnt = DCount(thisRecipients, @VM)
// Previous logic from obj_Notes
CurrDTM = OConv(Date(),'D4/'):' ':OConv(Time(),'MTHS')
RecipientsText = thisRecipients
SWAP @VM WITH ', ' IN RecipientsText
FOR RecipIndex = 1 TO RecipCnt
thisRecipient = thisRecipients<1, RecipIndex>
obj_Notes_Sent('Create',thisRecipient:@RM:NotesId:@RM:CurrDTM) ;* Add to Notes Sent buffer table
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
eMailAddr = UserRec<LSL_USERS_EMAIL$>
IF FwdFlag = 1 AND eMailAddr NE '' THEN
Text = ''
Text<-1> = 'OI eMail From: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
IF AttachWindow NE '' THEN
Text<-1> = ''
Text<-1> = 'Attached Window: ':AttachWindow
END
IF AttachKeys NE '' THEN
Text<-1> = ''
Text<-1> = 'Record Key: ':AttachKeys
END
IF SendToGroup NE '' THEN
Text<-1> = ''
Text<-1> = 'Sent to Group: ':SendToGroup
END
HeaderText = Text<1>
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
eMailBoxKey = NotesId:'*':thisRecipient
eMailBoxRec = ''
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
obj_Tables('WriteRec',ebParms)
END ;* End of check for forwarding flag
Next RecipIndex
end else
// Log this condition, but delete record since we have nothing to send.
DeleteRec = True$
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Error in ':Service:' service. Failed to send Note due to null NOTES record, "':NotesId:'", read in.'
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Error in ':Service:' service. Failed to read NOTES record, "':NotesId:'". Error message: ':Error_Services('GetMessage')
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
end else
// Log this condition, but delete record since we have nothing to send.
DeleteRec = True$
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Error in ':Service:' service. Null NotesId in NOTES_QUEUE record, "':NotesQueueId:'".'
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Error in ':Service:' service. Error reading NOTES_QUEUE record, "':NotesQueueId:'". File error: ':@File.Error
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
If DeleteRec then
Database_Services('DeleteDataRow', 'NOTES_QUEUE', NotesQueueId, True$, False$)
If Error_Services('NoError') then
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Successfuly deleted NOTES_QUEUE record, "':NotesQueueID:'".'
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
end
Repeat
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesQueueId
LogData<3> = 'Error in ':Service:' service. Failed to open NOTES_QUEUE table.'
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
Unlock hSysLists, ServiceKeyID else Null
end
end service
Service AddToQueue(NotesId)
If NotesId NE '' then
If RowExists('NOTES', NotesId) then
QueueId = RTI_CreateGuid()
If QueueId NE '' then
QueueRec = NotesId
Database_Services('WriteDataRow', 'NOTES_QUEUE', QueueId, QueueRec)
If Error_Services('HasError') then
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesId
ErrorMsg = 'Error in ':Service:' service. Failed to write NOTES_QUEUE record, "':QueueID:'", for NOTES record, "':NotesId:'".'
ErrorMsg := 'Error message: ':Error_Services('GetMessage')
LogData<3> = ErrorMsg
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesId
ErrorMsg = 'Error in ':Service:' service. Failed to genereate NOTES_QUEUE Id for NOTES record, "':NotesId:'".'
LogData<3> = ErrorMsg
Logging_Services('AppendLog', objNotesQProcLog, LogData, @RM, @FM)
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesId
ErrorMsg = 'Error in ':Service:' service. NOTES record, "':NotesId:'", does not exist!.'
LogData<3> = ErrorMsg
end
end else
LogData = ''
LogData<1> = LoggingDtm
LogData<2> = NotesId
ErrorMsg = 'Error in ':Service:' service. Null NOTES Id passed into service.'
LogData<3> = ErrorMsg
end
end service

686
LSL2/STPROC/NOTE_MESSAGE.txt
View File

@ -7,7 +7,7 @@ COMPILE FUNCTION Note_Message(EntID,Event,Parm1,Parm2,Parm3,Parm4,Parm5)
*/
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status, Center_Window, Post_Event, RList
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow
DECLARE SUBROUTINE ErrMsg, Send_Message, Set_Property, Send_Event, Btree.Extract, obj_AppWindow, Notes_Services
DECLARE SUBROUTINE obj_Notes, Security_Err_Msg, End_Window, Forward_Event, Start_Window, Create_Note, obj_Notes_Sent
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Popup, Collect.Ixvals, Admin_User, Printer_Select, obj_Notes
@ -41,9 +41,6 @@ BEGIN CASE
CASE Event = 'CLOSE' ; GOSUB Close
CASE Event = 'READ' ; GOSUB Read
CASE Event = 'WRITE' ; GOSUB Write
END CASE
CASE EntID = @WINDOW:'.YOUR_GROUPS' AND Event = 'CLICK' ; GOSUB YourGroupsClick
@ -70,24 +67,23 @@ END
RETURN Result
* * * * * * *
Create:
* * * * * * *
obj_Appwindow('Create',@WINDOW)
obj_Appwindow('Create',@WINDOW)
IF Parm1 NE '' THEN
AttachWindow = Parm1[1,@FM]
AttachKey = Parm1[COL2()+1,@FM]
IF Parm1 NE '' THEN
AttachWindow = Parm1[1,@FM]
AttachKey = Parm1[COL2()+1,@FM]
IF AttachWindow NE '' THEN
Set_Property(@WINDOW,'@ATTACH_WINDOW',AttachWindow)
Set_Property(@WINDOW,'@ATTACH_KEY',AttachKey)
IF AttachWindow NE '' THEN
Set_Property(@WINDOW,'@ATTACH_WINDOW',AttachWindow)
Set_Property(@WINDOW,'@ATTACH_KEY',AttachKey)
END
END
END
GOSUB Refresh
GOSUB Refresh
RETURN
@ -96,106 +92,105 @@ RETURN
Close:
* * * * * * *
End_Dialog(@WINDOW,'')
End_Dialog(@WINDOW,'')
RETURN
* * * * * * *
Refresh:
* * * * * * *
IF MemberOf(@USER4,'OI_ADMIN') THEN
Set_Property(@WINDOW:'.SEQ','VISIBLE',1)
END ELSE
Set_Property(@WINDOW:'.SEQ','VISIBLE',0)
END
IF MemberOf(@USER4,'OI_ADMIN') THEN
Set_Property(@WINDOW:'.SEQ','VISIBLE',1)
END ELSE
Set_Property(@WINDOW:'.SEQ','VISIBLE',0)
END
IF Get_Property(@WINDOW:'.ENTRY_ID','DEFPROP') = '' THEN
Set_Property(@WINDOW:'.ENTRY_ID','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ENTRY_ID','ENABLED',0)
END
IF Get_Property(@WINDOW:'.ENTRY_ID','DEFPROP') = '' THEN
Set_Property(@WINDOW:'.ENTRY_ID','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ENTRY_ID','ENABLED',0)
END
IF Get_Property(@WINDOW:'.ENTRY_DATE','DEFPROP') = '' THEN
Set_Property(@WINDOW:'.ENTRY_DATE','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ENTRY_DATE','ENABLED',0)
END
IF Get_Property(@WINDOW:'.ENTRY_DATE','DEFPROP') = '' THEN
Set_Property(@WINDOW:'.ENTRY_DATE','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ENTRY_DATE','ENABLED',0)
END
IF Get_Property(@WINDOW:'.ENTRY_TIME','DEFPROP') = '' THEN
Set_Property(@WINDOW:'.ENTRY_TIME','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ENTRY_TIME','ENABLED',0)
END
IF Get_Property(@WINDOW:'.ENTRY_TIME','DEFPROP') = '' THEN
Set_Property(@WINDOW:'.ENTRY_TIME','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ENTRY_TIME','ENABLED',0)
END
AttachWindow = Get_Property(@WINDOW:'.ATTACH_WINDOW','DEFPROP')
IF AttachWindow NE '' THEN
Set_Property(@WINDOW:'.ATTACH_GROUP','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ATTACH_GROUP','ENABLED',0)
END
AttachWindow = Get_Property(@WINDOW:'.ATTACH_WINDOW','DEFPROP')
IF AttachWindow NE '' THEN
Set_Property(@WINDOW:'.ATTACH_GROUP','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.ATTACH_GROUP','ENABLED',0)
END
* Turn edit table symbolic column backgrounds to green
* Turn edit table symbolic column backgrounds to green
ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow
ETSymbolics = Get_Property(@WINDOW,'@ET_SYMBOLICS') ;* Loaded during 'Create' in obj_Appwindow
ETCtrls = ETSymbolics<1>
ETCols = ETSymbolics<2>
ETCtrls = ETSymbolics<1>
ETCols = ETSymbolics<2>
FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '')
ETCtrl = ETCtrls<1,I>
FOR I = 1 TO COUNT(ETCtrls,@VM) + (ETCtrls NE '')
ETCtrl = ETCtrls<1,I>
ETList = Get_Property(ETCtrl,'LIST')
FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '')
IF ETList<Line,1> NE '' THEN
FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '')
stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$)
NEXT N
END
NEXT Line
ETList = Get_Property(ETCtrl,'LIST')
FOR Line = 1 TO COUNT(ETList,@FM) + (ETList NE '')
IF ETList<Line,1> NE '' THEN
FOR N = 1 TO COUNT(ETCols<1,I>,@SVM) + (ETCols<1,I> NE '')
stat = Send_Message(ETCtrl,'COLOR_BY_POS',ETCols<1,I,N>,Line,GREEN$)
NEXT N
END
NEXT Line
NEXT I
NEXT I
RETURN
RETURN
* * * * * * *
Read:
* * * * * * *
EntryID = Get_Property(@WINDOW:'.ENTRY_ID','DEFPROP')
EntryID = Get_Property(@WINDOW:'.ENTRY_ID','DEFPROP')
IF EntryID = '' THEN
Set_Property(@WINDOW:'.ENTRY_ID','DEFPROP',@USER4)
Send_Event(@WINDOW:'.ENTRY_ID','LOSTFOCUS')
Set_Property(@WINDOW:'.ENTRY_DATE','DEFPROP',OCONV(Date(),'D4/'))
Set_Property(@WINDOW:'.ENTRY_TIME','DEFPROP',OCONV(Time(),'MTS'))
IF EntryID = '' THEN
Set_Property(@WINDOW:'.ENTRY_ID','DEFPROP',@USER4)
Send_Event(@WINDOW:'.ENTRY_ID','LOSTFOCUS')
Set_Property(@WINDOW:'.ENTRY_DATE','DEFPROP',OCONV(Date(),'D4/'))
Set_Property(@WINDOW:'.ENTRY_TIME','DEFPROP',OCONV(Time(),'MTS'))
AttachWindow = Get_Property(@WINDOW,'@ATTACH_WINDOW')
AttachKey = Get_Property(@WINDOW,'@ATTACH_KEY')
AttachWindow = Get_Property(@WINDOW,'@ATTACH_WINDOW')
AttachKey = Get_Property(@WINDOW,'@ATTACH_KEY')
IF AttachWindow NE '' THEN Set_Property(@WINDOW:'.ATTACH_WINDOW','DEFPROP',AttachWindow)
IF AttachKey NE '' THEN Set_Property(@WINDOW:'.ATTACH_KEY','DEFPROP',AttachKey)
IF AttachWindow NE '' THEN Set_Property(@WINDOW:'.ATTACH_WINDOW','DEFPROP',AttachWindow)
IF AttachKey NE '' THEN Set_Property(@WINDOW:'.ATTACH_KEY','DEFPROP',AttachKey)
Set_Property(@WINDOW:'.FROM','DEFPROP',@USER4)
Send_Event(@WINDOW:'.FROM','LOSTFOCUS')
Send_Event(@WINDOW:'.ENTRY_ID','LOSTFOCUS')
Set_Property(@WINDOW:'.FROM','DEFPROP',@USER4)
Send_Event(@WINDOW:'.FROM','LOSTFOCUS')
Send_Event(@WINDOW:'.ENTRY_ID','LOSTFOCUS')
Set_Property('SYSTEM','FOCUS',@WINDOW:'.SUBJECT')
Set_Property('SYSTEM','FOCUS',@WINDOW:'.SUBJECT')
Set_Property(@WINDOW:'.REPLY','ENABLED',0)
Set_Property(@WINDOW:'.REPLY_ALL','ENABLED',0)
Set_Property(@WINDOW:'.FORWARD','ENABLED',0)
Set_Property(@WINDOW:'.MENU.FILE.SAVE_ROW','ENABLED',1)
Set_Property(@WINDOW:'.REPLY','ENABLED',0)
Set_Property(@WINDOW:'.REPLY_ALL','ENABLED',0)
Set_Property(@WINDOW:'.FORWARD','ENABLED',0)
Set_Property(@WINDOW:'.MENU.FILE.SAVE_ROW','ENABLED',1)
END ELSE
Set_Property(@WINDOW:'.SEND','ENABLED',0)
END
END ELSE
Set_Property(@WINDOW:'.SEND','ENABLED',0)
END
GOSUB Refresh
GOSUB Refresh
RETURN
@ -204,88 +199,68 @@ RETURN
Write:
* * * * * * *
NoteID = Get_Property(@WINDOW:'.SEQ','DEFPROP')
NoteID = Get_Property(@WINDOW:'.SEQ','DEFPROP')
SendToArray = Get_Property(@WINDOW:'.SEND_TO','ARRAY')
SendToIDs = SendToArray<COL$ST_ID>
SendToArray = Get_Property(@WINDOW:'.SEND_TO','ARRAY')
SendToIDs = SendToArray<COL$ST_ID>
IF RowExists('NOTES',NoteID) THEN
IF RowExists('NOTES',NoteID) THEN
Send_Event(@WINDOW,'CLEAR',0,1,1)
Send_Event(@WINDOW,'CLOSE')
Send_Event(@WINDOW,'CLEAR',0,1,1)
Send_Event(@WINDOW,'CLOSE')
END ELSE
END ELSE
Forward_Event()
Forward_Event()
Notes_Services('AddToQueue', NoteId)
obj_Notes('PostEMail',NoteID) ;* Forwards to Outlook eMail if the users flag is set
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
Pos = 1
Flag = ""
LOOP
REMOVE SendToID FROM SendToIDs AT Pos SETTING FLAG
IF SendToID NE '' THEN
obj_Notes_Sent('Create',SendToID:@RM:NoteID:@RM:CurrDTM)
END
WHILE Flag
REPEAT
END
RETURN 0
* * * * * * *
YourGroupsClick:
* * * * * * *
SelectSent = 'SELECT MSG_GROUPS WITH ENTRY_ID = ':QUOTE(@USER4):' BY GROUP_NAME'
SelectSent = 'SELECT MSG_GROUPS WITH ENTRY_ID = ':QUOTE(@USER4):' BY GROUP_NAME'
RList(SelectSent,TARGET_ACTIVELIST$, '', '', '' )
RList(SelectSent,TARGET_ACTIVELIST$, '', '', '' )
IF @RECCOUNT THEN
IF @RECCOUNT THEN
GroupNames = Popup(@WINDOW,'','SHOW_GROUP_NAMES')
GroupNames = Popup(@WINDOW,'','SHOW_GROUP_NAMES')
IF GroupNames NE '' THEN
IF GroupNames NE '' THEN
LOCATE 'ALL_ACTIVE_USERS' IN GroupNames USING @VM SETTING Pos THEN
NewSendToIDs = obj_Notes('AllActiveUsers')
END ELSE
NewSendToIDs = XLATE('MSG_GROUPS',GroupNames,'USER_IDS','X')
END
IF NewSendToIDs NE '' THEN
GOSUB AddSendToIDs
END
LOCATE 'ALL_ACTIVE_USERS' IN GroupNames USING @VM SETTING Pos THEN
NewSendToIDs = obj_Notes('AllActiveUsers')
END ELSE
NewSendToIDs = XLATE('MSG_GROUPS',GroupNames,'USER_IDS','X')
END
IF NewSendToIDs NE '' THEN
GOSUB AddSendToIDs
END
END ELSE
END
ErrMsg('You do not have any group names...')
END ELSE
ErrMsg('You do not have any group names...')
END
END
RETURN
* * * * * * *
CopyYourSelfClick:
* * * * * * *
NewSendToIDs = ''
NewSendToIDs = ''
GOSUB AddSendToIDs
GOSUB AddSendToIDs
RETURN
@ -294,15 +269,15 @@ RETURN
AllActiveUsersClick:
* * * * * * *
Check = Msg(@WINDOW,'','CC_ALL_USERS')
Check = Msg(@WINDOW,'','CC_ALL_USERS')
IF Check = CHAR(27) THEN RETURN
IF Check = CHAR(27) THEN RETURN
NewSendToIDs = obj_Notes('AllActiveUsers')
NewSendToIDs = obj_Notes('AllActiveUsers')
Set_Property(@WINDOW:'.SEND_TO','ARRAY','')
Set_Property(@WINDOW:'.SEND_TO','ARRAY','')
GOSUB AddSendToIDs
GOSUB AddSendToIDs
RETURN
@ -311,12 +286,11 @@ RETURN
AllUsersClick:
* * * * * * *
NewSendToIDs = Popup(@WINDOW,'','USER_ID')
NewSendToIDs = Popup(@WINDOW,'','USER_ID')
IF NewSendToIDs = CHAR(27) THEN RETURN
IF NewSendToIDs = CHAR(27) THEN RETURN
GOSUB AddSendToIDs
GOSUB AddSendToIDs
RETURN
@ -325,44 +299,44 @@ RETURN
AddSendToIDs:
* * * * * * *
SendToArray = Get_Property(@WINDOW:'.SEND_TO','ARRAY')
RawSendToIDs = SendToArray<COL$ST_ID>
SendToArray = Get_Property(@WINDOW:'.SEND_TO','ARRAY')
RawSendToIDs = SendToArray<COL$ST_ID>
SendToCnt = 0
SendToIDs = ''
SendToCnt = 0
SendToIDs = ''
TestCnt = COUNT(RawSendToIDs,@VM) + (RawSendToIDs NE '')
FOR I = 1 TO TestCnt
IF RawSendToIDs<1,I> NE '' THEN
SendToIDs<1,-1> = RawSendToIDs<1,I>
SendToCnt += 1
TestCnt = COUNT(RawSendToIDs,@VM) + (RawSendToIDs NE '')
FOR I = 1 TO TestCnt
IF RawSendToIDs<1,I> NE '' THEN
SendToIDs<1,-1> = RawSendToIDs<1,I>
SendToCnt += 1
END
NEXT I
NewCnt = COUNT(NewSendToIDs,@VM) + (NewSendToIDs NE '')
FOR I = 1 TO NewCnt
NewSendToID = NewSendToIDs<1,I>
LOCATE NewSendToID IN SendToIDs BY 'AL' USING @VM SETTING Pos ELSE
SendToIDs = INSERT(SendToIDs,1,Pos,0,NewSendToID)
END
NEXT I
SendToYourself = Get_Property(@WINDOW:'.COPY_YOURSELF','CHECK')
Myself = @USER4
LOCATE Myself IN SendToIDs BY 'AL' USING @VM SETTING Pos THEN
IF SendToYourSelf = 0 THEN SendToIDs = DELETE(SendToIDS,1,Pos,0)
END ELSE
IF SendToYourSelf = 1 THEN SendToIDs = INSERT(SendToIDs,1,Pos,0,Myself)
END
NEXT I
NewCnt = COUNT(NewSendToIDs,@VM) + (NewSendToIDs NE '')
SendToIDs := @VM ;* BlankLine on end
FOR I = 1 TO NewCnt
NewSendToID = NewSendToIDs<1,I>
LOCATE NewSendToID IN SendToIDs BY 'AL' USING @VM SETTING Pos ELSE
SendToIDs = INSERT(SendToIDs,1,Pos,0,NewSendToID)
END
NEXT I
SendToYourself = Get_Property(@WINDOW:'.COPY_YOURSELF','CHECK')
Myself = @USER4
LOCATE Myself IN SendToIDs BY 'AL' USING @VM SETTING Pos THEN
IF SendToYourSelf = 0 THEN SendToIDs = DELETE(SendToIDS,1,Pos,0)
END ELSE
IF SendToYourSelf = 1 THEN SendToIDs = INSERT(SendToIDs,1,Pos,0,Myself)
END
SendToIDs := @VM ;* BlankLine on end
SendToArray<COL$ST_ID> = SendToIDs
Set_Property(@WINDOW:'.SEND_TO','DEFPROP',SendToArray)
Send_Event(@WINDOW:'.SEND_TO','CALCULATE',COL$ST_NAME)
SendToArray<COL$ST_ID> = SendToIDs
Set_Property(@WINDOW:'.SEND_TO','DEFPROP',SendToArray)
Send_Event(@WINDOW:'.SEND_TO','CALCULATE',COL$ST_NAME)
RETURN
@ -371,174 +345,171 @@ RETURN
Reply:
* * * * * *
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.FROM':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.SEND_TO':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP'
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.FROM':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.SEND_TO':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP'
Vals = Get_Property(Ctrls,Props)
Vals = Get_Property(Ctrls,Props)
Message = Vals[1,@RM]
Subject = Vals[COL2()+1,@RM]
FromID = Vals[COL2()+1,@RM]
SendTo = Vals[COL2()+1,@RM]
AttachWindow = Vals[COL2()+1,@RM]
AttachKey = Vals[COL2()+1,@RM]
EntryID = Vals[COL2()+1,@RM]
EntryDate = Vals[COL2()+1,@RM]
EntryTime = Vals[COL2()+1,@RM]
Message = Vals[1,@RM]
Subject = Vals[COL2()+1,@RM]
FromID = Vals[COL2()+1,@RM]
SendTo = Vals[COL2()+1,@RM]
AttachWindow = Vals[COL2()+1,@RM]
AttachKey = Vals[COL2()+1,@RM]
EntryID = Vals[COL2()+1,@RM]
EntryDate = Vals[COL2()+1,@RM]
EntryTime = Vals[COL2()+1,@RM]
EntryDate = OCONV(Date(),'D2/') ;* JCH 7/15/2010
EntryTime = OCONV(Time(),'MTH') ;* JCH 7/15/2010
EntryDate = OCONV(Date(),'D2/') ;* JCH 7/15/2010
EntryTime = OCONV(Time(),'MTH') ;* JCH 7/15/2010
SWAP @TM WITH @TM:'>' IN Message
SWAP @TM WITH @TM:'>' IN Message
Subject = 'RE: ':Subject
Message = CRLF$:CRLF$:'>':Message
Subject = 'RE: ':Subject
Message = CRLF$:CRLF$:'>':Message
Set_Property(@WINDOW,'SAVEWARN',0)
Send_Event(@WINDOW,'CLEAR',0,1,1)
Set_Property(@WINDOW,'SAVEWARN',0)
Send_Event(@WINDOW,'CLEAR',0,1,1)
IF EntID = 'NOTE_MESSAGE.REPLY_ALL' THEN
Set_Property('NOTE_MESSAGE.SEND_TO','DEFPROP',SendTo)
NewSendToIDs = FromID
GOSUB AddSendToIDs
Set_Property(@WINDOW:'.FROM','DEFPROP',@USER4)
END ELSE
Ctrls = @WINDOW:'.FROM':@RM ; Props = 'DEFPROP':@RM ; Vals = @USER4:@RM
Ctrls := @WINDOW:'.SEND_TO' ; Props := 'DEFPROP' ; Vals := FromID
Set_Property(Ctrls,Props,Vals)
END
SeqNo = NextKey('NOTES')
Set_Property(@WINDOW:'.SEQ','DEFPROP',SeqNo)
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM ; Vals = Message:@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM ; Vals := Subject:@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM ; Vals := Attachwindow:@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM ; Vals := AttachKey:@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryID:@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryDate:@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP' ; Vals := EntryTime
IF EntID = 'NOTE_MESSAGE.REPLY_ALL' THEN
Set_Property('NOTE_MESSAGE.SEND_TO','DEFPROP',SendTo)
NewSendToIDs = FromID
GOSUB AddSendToIDs
Set_Property(@WINDOW:'.FROM','DEFPROP',@USER4)
END ELSE
Ctrls = @WINDOW:'.FROM':@RM ; Props = 'DEFPROP':@RM ; Vals = @USER4:@RM
Ctrls := @WINDOW:'.SEND_TO' ; Props := 'DEFPROP' ; Vals := FromID
Set_Property(Ctrls,Props,Vals)
END
SeqNo = NextKey('NOTES')
Set_Property(@WINDOW:'.SEQ','DEFPROP',SeqNo)
Send_Event(@WINDOW:'.FROM_NAME','CALCULATE')
Send_Event(@WINDOW:'.ENTRY_ID_NAME','CALCULATE')
Send_Event(@WINDOW:'.SEND_TO','CALCULATE',COL$ST_NAME)
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM ; Vals = Message:@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM ; Vals := Subject:@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM ; Vals := Attachwindow:@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM ; Vals := AttachKey:@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryID:@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryDate:@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP' ; Vals := EntryTime
IOOptions = Get_Property( @WINDOW, 'IOOPTIONS' )
Set_Property(Ctrls,Props,Vals)
IOOptions<2> = 0 ;* do the lock creating a new reply another WTFO??????
Send_Event(@WINDOW:'.FROM_NAME','CALCULATE')
Send_Event(@WINDOW:'.ENTRY_ID_NAME','CALCULATE')
Send_Event(@WINDOW:'.SEND_TO','CALCULATE',COL$ST_NAME)
IOOptions = Get_Property( @WINDOW, 'IOOPTIONS' )
IOOptions<2> = 0 ;* do the lock creating a new reply another WTFO??????
Set_Property( @WINDOW, 'IOOPTIONS', IoOptions )
Set_Property( @WINDOW, 'IOOPTIONS', IoOptions )
Set_Property(@WINDOW:'.SEND','ENABLED',1)
Set_Property(@WINDOW:'.REPLY','ENABLED',0)
Set_Property(@WINDOW:'.REPLY_ALL','ENABLED',0)
Set_Property(@WINDOW:'.FORWARD','ENABLED',0)
Set_Property(@WINDOW:'.MENU.FILE.SAVE_ROW','ENABLED',1)
Set_Property(@WINDOW:'.MESSAGE', "FOCUS", 1)
Set_Property(@WINDOW:'.SEND','ENABLED',1)
Set_Property(@WINDOW:'.REPLY','ENABLED',0)
Set_Property(@WINDOW:'.REPLY_ALL','ENABLED',0)
Set_Property(@WINDOW:'.FORWARD','ENABLED',0)
Set_Property(@WINDOW:'.MENU.FILE.SAVE_ROW','ENABLED',1)
Set_Property(@WINDOW:'.MESSAGE', "FOCUS", 1)
RETURN
* * * * * * *
Forward:
* * * * * * *
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.FROM':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.SEND_TO':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP'
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.FROM':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.SEND_TO':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP'
Vals = Get_Property(Ctrls,Props)
Vals = Get_Property(Ctrls,Props)
OrgMessage = Vals[1,@RM]
Subject = Vals[COL2()+1,@RM]
FromID = Vals[COL2()+1,@RM]
SendTo = Vals[COL2()+1,@RM]
AttachWindow = Vals[COL2()+1,@RM]
AttachKey = Vals[COL2()+1,@RM]
EntryID = Vals[COL2()+1,@RM]
EntryDate = Vals[COL2()+1,@RM]
EntryTime = Vals[COL2()+1,@RM]
OrgMessage = Vals[1,@RM]
Subject = Vals[COL2()+1,@RM]
FromID = Vals[COL2()+1,@RM]
SendTo = Vals[COL2()+1,@RM]
AttachWindow = Vals[COL2()+1,@RM]
AttachKey = Vals[COL2()+1,@RM]
EntryID = Vals[COL2()+1,@RM]
EntryDate = Vals[COL2()+1,@RM]
EntryTime = Vals[COL2()+1,@RM]
SWAP @TM WITH @TM:'>' IN OrgMessage
SWAP @TM WITH @TM:'>' IN OrgMessage
SendToUserIDs = SendTo<COL$ST_ID>
SWAP @VM WITH ', ' IN SendToUserIDs
SendToUserIDs = SendTo<COL$ST_ID>
SWAP @VM WITH ', ' IN SendToUserIDs
Subject = '[FW: ':Subject:']'
Subject = '[FW: ':Subject:']'
Message = CRLF$:CRLF$
Message := '--------- Original Message ---------':CRLF$:CRLF$
Message := 'Subject: ':Subject:CRLF$
Message := ' Date: ':OCONV(EntryDate,'D4/'):' ':OCONV(EntryTime,'MTS'):CRLF$
Message := ' From: ':FromID:CRLF$
Message := ' To: ':SendToUserIDs:CRLF$
Message := CRLF$:CRLF$
Message = CRLF$:CRLF$
Message := '--------- Original Message ---------':CRLF$:CRLF$
Message := 'Subject: ':Subject:CRLF$
Message := ' Date: ':OCONV(EntryDate,'D4/'):' ':OCONV(EntryTime,'MTS'):CRLF$
Message := ' From: ':FromID:CRLF$
Message := ' To: ':SendToUserIDs:CRLF$
Message := CRLF$:CRLF$
Message := CRLF$:CRLF$:'>':OrgMessage
Message := CRLF$:CRLF$:'>':OrgMessage
Set_Property(@WINDOW,'SAVEWARN',0)
Send_Event(@WINDOW,'CLEAR',0,1,1)
Set_Property(@WINDOW,'SAVEWARN',0)
Send_Event(@WINDOW,'CLEAR',0,1,1)
IF EntID = 'NOTE_MESSAGE.REPLY_ALL' THEN
Set_Property('NOTE_MESSAGE.SEND_TO','DEFPROP',SendTo)
NewSendToIDs = FromID
GOSUB AddSendToIDs
Set_Property(@WINDOW:'.FROM','DEFPROP',@USER4)
END ELSE
Ctrls = @WINDOW:'.FROM':@RM ; Props = 'DEFPROP':@RM ; Vals = @USER4:@RM
Ctrls := @WINDOW:'.SEND_TO' ; Props := 'DEFPROP' ; Vals := ''
Set_Property(Ctrls,Props,Vals)
END
SeqNo = NextKey('NOTES')
Set_Property(@WINDOW:'.SEQ','DEFPROP',SeqNo)
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM ; Vals = Message:@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM ; Vals := Subject:@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM ; Vals := AttachWindow:@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM ; Vals := AttachKey:@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryID:@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryDate:@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP' ; Vals := EntryTime
IF EntID = 'NOTE_MESSAGE.REPLY_ALL' THEN
Set_Property('NOTE_MESSAGE.SEND_TO','DEFPROP',SendTo)
NewSendToIDs = FromID
GOSUB AddSendToIDs
Set_Property(@WINDOW:'.FROM','DEFPROP',@USER4)
END ELSE
Ctrls = @WINDOW:'.FROM':@RM ; Props = 'DEFPROP':@RM ; Vals = @USER4:@RM
Ctrls := @WINDOW:'.SEND_TO' ; Props := 'DEFPROP' ; Vals := ''
Set_Property(Ctrls,Props,Vals)
END
SeqNo = NextKey('NOTES')
Set_Property(@WINDOW:'.SEQ','DEFPROP',SeqNo)
Send_Event(@WINDOW:'.FROM_NAME','CALCULATE')
Send_Event(@WINDOW:'.ENTRY_ID_NAME','CALCULATE')
Send_Event(@WINDOW:'.SEND_TO','CALCULATE',COL$ST_NAME)
Ctrls = @WINDOW:'.MESSAGE':@RM ; Props = 'DEFPROP':@RM ; Vals = Message:@RM
Ctrls := @WINDOW:'.SUBJECT':@RM ; Props := 'DEFPROP':@RM ; Vals := Subject:@RM
Ctrls := @WINDOW:'.ATTACH_WINDOW':@RM ; Props := 'DEFPROP':@RM ; Vals := AttachWindow:@RM
Ctrls := @WINDOW:'.ATTACH_KEY':@RM ; Props := 'DEFPROP':@RM ; Vals := AttachKey:@RM
Ctrls := @WINDOW:'.ENTRY_ID':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryID:@RM
Ctrls := @WINDOW:'.ENTRY_DATE':@RM ; Props := 'DEFPROP':@RM ; Vals := EntryDate:@RM
Ctrls := @WINDOW:'.ENTRY_TIME' ; Props := 'DEFPROP' ; Vals := EntryTime
IOOptions = Get_Property( @WINDOW, 'IOOPTIONS' )
Set_Property(Ctrls,Props,Vals)
IOOptions<2> = 0 ;* do the lock creating a new reply another WTFO??????
Send_Event(@WINDOW:'.FROM_NAME','CALCULATE')
Send_Event(@WINDOW:'.ENTRY_ID_NAME','CALCULATE')
Send_Event(@WINDOW:'.SEND_TO','CALCULATE',COL$ST_NAME)
Set_Property( @WINDOW, 'IOOPTIONS', IoOptions )
IOOptions = Get_Property( @WINDOW, 'IOOPTIONS' )
IOOptions<2> = 0 ;* do the lock creating a new reply another WTFO??????
Set_Property( @WINDOW, 'IOOPTIONS', IoOptions )
Set_Property(@WINDOW:'.SEND','ENABLED',1)
Set_Property(@WINDOW:'.REPLY','ENABLED',0)
Set_Property(@WINDOW:'.REPLY_ALL','ENABLED',0)
Set_Property(@WINDOW:'.FORWARD','ENABLED',0)
Set_Property(@WINDOW:'.MENU.FILE.SAVE_ROW','ENABLED',1)
Set_Property(@WINDOW:'.MESSAGE', "FOCUS", 1)
Set_Property(@WINDOW:'.SEND','ENABLED',1)
Set_Property(@WINDOW:'.REPLY','ENABLED',0)
Set_Property(@WINDOW:'.REPLY_ALL','ENABLED',0)
Set_Property(@WINDOW:'.FORWARD','ENABLED',0)
Set_Property(@WINDOW:'.MENU.FILE.SAVE_ROW','ENABLED',1)
Set_Property(@WINDOW:'.MESSAGE', "FOCUS", 1)
RETURN
@ -547,12 +518,12 @@ RETURN
ViewAttachment:
* * * * * * *
AttachWindow = Get_Property(@WINDOW:'.ATTACH_WINDOW','DEFPROP')
AttachKey = Get_Property(@WINDOW:'.ATTACH_KEY','DEFPROP')
AttachWindow = Get_Property(@WINDOW:'.ATTACH_WINDOW','DEFPROP')
AttachKey = Get_Property(@WINDOW:'.ATTACH_KEY','DEFPROP')
IF AttachWindow NE '' AND AttachKey NE '' THEN
obj_Appwindow('ViewRelated',AttachWindow:@RM:AttachKey)
END
IF AttachWindow NE '' AND AttachKey NE '' THEN
obj_Appwindow('ViewRelated',AttachWindow:@RM:AttachKey)
END
RETURN
@ -561,93 +532,84 @@ RETURN
SendToPC:
* * * * * * *
NextColumn = Parm1
NextRow = Parm2
NextColumn = Parm1
NextRow = Parm2
Forward_Event(NextColumn,NextRow)
Forward_Event(NextColumn,NextRow)
CurrRow = Get_Property(@WINDOW:'.SEND_TO','ROWDATA')
CurrRow = Get_Property(@WINDOW:'.SEND_TO','ROWDATA')
CurrRow<COL$ST_NAME> = OCONV(CurrRow<1,COL$ST_ID>,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
CurrRow<COL$ST_NAME> = OCONV(CurrRow<1,COL$ST_ID>,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
Set_Property(@WINDOW:'.SEND_TO','ROWDATA',CurrRow)
Set_Property(@WINDOW:'.SEND_TO','ROWDATA',CurrRow)
GOSUB Refresh
GOSUB Refresh
RETURN
* * * * * * *
Print:
* * * * * * *
PrintPath = Printer_Select('',1) ;* Get default printer
PrintPath = Printer_Select('',1) ;* Get default printer
Stat = Set_Printer( 'INIT', '', '', 1.25:@FM:'':@FM:1.0:@FM:'', 0,'',PrintPath )
GOSUB CheckErr
Stat = Set_Printer( 'INIT', '', '', 1.25:@FM:'':@FM:1.0:@FM:'', 0,'',PrintPath )
GOSUB CheckErr
Font = "Courier New,12,L,1"
CONVERT ',' TO @FM IN Font
Hf = Font
Stat = Set_Printer( 'FONT', Font )
GOSUB CheckErr
Font = "Courier New,12,L,1"
CONVERT ',' TO @FM IN Font
Hf = Font
Stat = Set_Printer( 'FONT', Font )
GOSUB CheckErr
SendTo = Get_Property(@WINDOW:'.SEND_TO','ARRAY')
SendTo = Get_Property(@WINDOW:'.SEND_TO','ARRAY')
Void = Set_Printer( 'TEXT', 'TO:' )
Table = ''
Void = Set_Printer( 'TEXT', 'TO:' )
Table = ''
SendTo<1> = ex_vm_rem( SendTo<1> )
Rcnt = COUNT(SendTo<1>,@VM) + (SendTo NE '')
SendTo<1> = ex_vm_rem( SendTo<1> )
Rcnt = COUNT(SendTo<1>,@VM) + (SendTo NE '')
FOR I = 1 TO Rcnt
Tvar = SendTo<2,I>:@VM:SendTo<2,I+1>:@VM:SendTo<2,I+2>
Table<-1> = Tvar
I = I+2 ; *skip column 2 & 3 that just got appended
next i
Void = Set_Printer( 'ADDTABLE', '2880':@VM:'2880':@VM:'2880', '', Table, '','','', TB_ALL )
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', 'From: ':Get_Property(@WINDOW:'.FROM','DEFPROP'):' ':Get_Property(@WINDOW:'.FROM_NAME','DEFPROP'))
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', 'Date: ':Get_Property(@WINDOW:'.ENTRY_DATE','DEFPROP'))
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', 'Subject: ':Get_Property(@WINDOW:'.SUBJECT'))
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', ' M E S S A G E' )
Void = Set_Printer( 'TEXT', '' )
FOR I = 1 TO Rcnt
Tvar = SendTo<2,I>:@VM:SendTo<2,I+1>:@VM:SendTo<2,I+2>
Table<-1> = Tvar
I = I+2 ; *skip column 2 & 3 that just got appended
next i
Void = Set_Printer( 'ADDTABLE', '2880':@VM:'2880':@VM:'2880', '', Table, '','','', TB_ALL )
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', 'From: ':Get_Property(@WINDOW:'.FROM','DEFPROP'):' ':Get_Property(@WINDOW:'.FROM_NAME','DEFPROP'))
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', 'Date: ':Get_Property(@WINDOW:'.ENTRY_DATE','DEFPROP'))
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', 'Subject: ':Get_Property(@WINDOW:'.SUBJECT'))
Void = Set_Printer( 'TEXT', '' )
Void = Set_Printer( 'TEXT', ' M E S S A G E' )
Void = Set_Printer( 'TEXT', '' )
MessageText = Get_Property(@WINDOW:'.MESSAGE','DEFPROP')
MessageText = Get_Property(@WINDOW:'.MESSAGE','DEFPROP')
SWAP @TM WITH CRLF$ IN MessageText
SWAP @TM WITH CRLF$ IN MessageText
TableColInfo = '9360'
x = Set_Printer("ADDTABLE", TableColInfo, '', MessageText, '', '', 1, TB_NONE)
TableColInfo = '9360'
x = Set_Printer("ADDTABLE", TableColInfo, '', MessageText, '', '', 1, TB_NONE)
Stat = Set_Printer( 'TERM' )
Stat = Set_Printer( 'TERM' )
GOSUB CheckErr
GOSUB CheckErr
RETURN
* * * * * * *
CheckErr:
* * * * * * *
IF Stat < 0 THEN
Void = msg( '', Stat )
Stat = Set_Printer( 'TERM' )
END
IF Stat < 0 THEN
Void = msg( '', Stat )
Stat = Set_Printer( 'TERM' )
END
RETURN

828
LSL2/STPROC/OBJ_NOTES.txt
View File

@ -15,9 +15,9 @@ COMPILE FUNCTION obj_Notes(Method,Parms)
*/
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey, SRP_Send_Mail, obj_Calendar, Database_Services, SRP_Stopwatch
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey, SRP_Send_Mail, obj_Calendar, Database_Services, SRP_Stopwatch
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, RList, ErrMsg, obj_Notes_Sent, Btree.Extract, Send_Info, obj_Notes
Declare subroutine Obj_Post_Log, SRP_Stopwatch
DECLARE SUBROUTINE Obj_Post_Log, SRP_Stopwatch, Notes_Services
$INSERT MSG_EQUATES
$INSERT NOTES_EQU
@ -69,342 +69,276 @@ RETURN Result
Inbox:
* * * * * * *
UserName = Parms[1,@RM]
UserName = Parms[1,@RM]
IF UserName = '' THEN UserName = @USER4
IF UserName = '' THEN UserName = @USER4
IF XLATE( 'NOTE_PTRS', UserName, 'NEW_MESSAGES', 'X' ) THEN
NotePtrRec = XLATE( 'NOTE_PTRS', UserName, '', 'X' )
IF NotePtrRec<NOTE_PTRS_NEW$,1> = 'Yes' THEN
IF XLATE( 'NOTE_PTRS', UserName, 'NEW_MESSAGES', 'X' ) THEN
NotePtrRec = XLATE( 'NOTE_PTRS', UserName, '', 'X' )
IF NotePtrRec<NOTE_PTRS_NEW$,1> = 'Yes' THEN
* the top one is new
* the top one is new
MsgInfo = ''
MsgInfo<MICON$> = '!'
Mtext = 'You have a new message from ':NotePtrRec<note_ptrs_from$,1>:'.'
MsgInfo<MTEXT$> = MText
MsgInfo<MCOL$> = -2
MsgInfo<MROW$> = -2
Msg( @WINDOW, MsgInfo )
END
END
MsgInfo = ''
MsgInfo<MICON$> = '!'
Mtext = 'You have a new message from ':NotePtrRec<note_ptrs_from$,1>:'.'
MsgInfo<MTEXT$> = MText
MsgInfo<MCOL$> = -2
MsgInfo<MROW$> = -2
Msg( @WINDOW, MsgInfo )
END
END
RETURN
* * * * * * *
Create:
* * * * * * *
Recipients = Parms[1,@RM]
SentFrom = Parms[COL2()+1,@RM]
Subject = Parms[COL2()+1,@RM]
Message = Parms[COL2()+1,@RM]
AttachWindow = Parms[COL2()+1,@RM]
AttachKeys = Parms[COL2()+1,@RM]
SendToGroup = Parms[COL2()+1,@RM]
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
Recipients = Parms[1,@RM]
SentFrom = Parms[COL2()+1,@RM]
Subject = Parms[COL2()+1,@RM]
Message = Parms[COL2()+1,@RM]
AttachWindow = Parms[COL2()+1,@RM]
AttachKeys = Parms[COL2()+1,@RM]
SendToGroup = Parms[COL2()+1,@RM]
IF NOT(ASSIGNED(AttachWindow)) THEN AttachWindow = ''
IF NOT(ASSIGNED(AttachKeys)) THEN AttachKeys = ''
IF NOT(ASSIGNED(SendToGroup)) THEN SendToGroup = ''
IF ( NOT(ASSIGNED(Recipients)) AND NOT(ASSIGNED(SendToGroup)) ) THEN
ErrorMsg = 'Unassigned Parameter "Recipients" or "SendToGroup" passed to object. (':Method:')'
end
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
IF ErrorMsg NE '' THEN RETURN
IF NOT(ASSIGNED(AttachWindow)) THEN AttachWindow = ''
IF NOT(ASSIGNED(AttachKeys)) THEN AttachKeys = ''
IF NOT(ASSIGNED(SendToGroup)) THEN SendToGroup = ''
thisRecipients = ''
RecipCnt = 0
IF ErrorMsg NE '' THEN RETURN
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
Recipient = Recipients<1,I>
IF Recipient NE '' THEN
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
RecipCnt += 1
thisRecipients = ''
RecipCnt = 0
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
Recipient = Recipients<1,I>
IF Recipient NE '' THEN
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
RecipCnt += 1
END
END
END
NEXT I
NEXT I
NextNoteKey = NextKey('NOTES')
NextNoteKey = NextKey('NOTES')
NoteRec = ''
NoteRec<notes_message_type$> = 'I'
NoteRec<notes_entry_date$> = Date()
NoteRec<notes_entry_time$> = Time()
NoteRec<notes_send_to$> = thisRecipients
NoteRec<notes_from$> = SentFrom
NoteRec<notes_message$> = Message
NoteRec<notes_entry_id$> = @USER4
NoteRec<notes_subject$> = Subject
NoteRec<notes_attach_window$> = AttachWindow
NoteRec<notes_attach_keys$> = AttachKeys
NoteRec<notes_msg_groups_ids$> = SendToGroup
NoteRec = ''
NoteRec<notes_message_type$> = 'I'
NoteRec<notes_entry_date$> = Date()
NoteRec<notes_entry_time$> = Time()
NoteRec<notes_send_to$> = thisRecipients
NoteRec<notes_from$> = SentFrom
NoteRec<notes_message$> = Message
NoteRec<notes_entry_id$> = @USER4
NoteRec<notes_subject$> = Subject
NoteRec<notes_attach_window$> = AttachWindow
NoteRec<notes_attach_keys$> = AttachKeys
NoteRec<notes_msg_groups_ids$> = SendToGroup
OtParms = 'NOTES':@RM:NextNoteKey:@RM:@RM:NoteRec
obj_Tables('WriteRec',OtParms) ;* Writes the Note record to disk
OtParms = 'NOTES':@RM:NextNoteKey:@RM:@RM:NoteRec
obj_Tables('WriteRec',OtParms) ;* Writes the Note record to disk
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
RecipientsText = thisRecipients
SWAP @VM WITH ', ' IN RecipientsText
FOR I = 1 TO RecipCnt
thisRecipient = thisRecipients<1,I>
obj_Notes_Sent('Create',thisRecipient:@RM:NextNoteKey:@RM:CurrDTM) ;* Add to Notes Sent buffer table
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
eMailAddr = UserRec<LSL_USERS_EMAIL$>
IF FwdFlag = 1 AND eMailAddr NE '' THEN
Text = ''
Text<-1> = 'OI eMail From: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
IF AttachWindow NE '' THEN
Text<-1> = ''
Text<-1> = 'Attached Window: ':AttachWindow
END
IF AttachKeys NE '' THEN
Text<-1> = ''
Text<-1> = 'Record Key: ':AttachKeys
END
IF SendToGroup NE '' THEN
Text<-1> = ''
Text<-1> = 'Sent to Group: ':SendToGroup
END
HeaderText = Text<1>
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
eMailBoxKey = NextNoteKey:'*':thisRecipient
eMailBoxRec = ''
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
obj_Tables('WriteRec',ebParms)
END ;* End of check for forwarding flag
NEXT I
Notes_Services('AddToQueue', NextNoteKey)
RETURN
* * * * * * *
Rebuild:
* * * * * * *
thisRecipient = Parms[1,@RM]
thisRecipient = Parms[1,@RM]
IF thisRecipient = '' THEN thisRecipient = @USER4
IF thisRecipient = '' THEN thisRecipient = @USER4
SelectSent = 'SELECT NOTES WITH SEND_TO "':thisRecipient:'" AND WITH ENTRY_DATE GE ':QUOTE(OCONV(Date()-90,'D4/'))
SelectSent = 'SELECT NOTES WITH SEND_TO "':thisRecipient:'" AND WITH ENTRY_DATE GE ':QUOTE(OCONV(Date()-90,'D4/'))
RList(SelectSent,'NOTES',TARGET_ACTIVELIST$,'','')
RList(SelectSent,'NOTES',TARGET_ACTIVELIST$,'','')
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
NoteIDs = ''
Done = 0
LOOP
READNEXT NoteID ELSE Done = 1
UNTIL Done
LOCATE NoteID IN NoteIDs BY 'DR' USING @FM SETTING Pos ELSE
NoteIDs = INSERT(NoteIDs,Pos,0,0,NoteID)
END
REPEAT
OtParms = 'NOTE_PTRS':@RM:thisRecipient
obj_Tables('LockRec',OtParms) ;* If not found then returns null, otherwise reads and sets the lock
NPRec = ''
FOR I = 1 TO COUNT(NoteIDs,@FM) + (NoteIDs NE '')
NoteID = NoteIDs<I>
NoteRec = XLATE('NOTES',NoteID,'','X')
Subject = NoteRec<NOTES_SUBJECT$>
SentFrom = NoteRec<NOTES_FROM$>
NoteDt = OCONV(NoteRec<NOTES_ENTRY_DATE$>,'D2/')
NoteTime = OCONV(NoteRec<NOTES_ENTRY_TIME$>,'MTH')
AttachWindow = NoteRec<notes_attach_window$>
AttachKeys = NoteRec<notes_attach_keys$>
IF AttachWindow NE '' AND AttachKeys NE '' THEN
Attachment = 'Yes'
END ELSE
Attachment = 'No'
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
LOCATE NoteID IN NPRec<note_ptrs_note_ids$> BY 'DR' USING @VM SETTING Pos ELSE
NoteIDs = ''
NPRec = INSERT( NPRec, note_ptrs_subject$, Pos, 0, Subject ) ;* Add the subject
ConvSentFrom = OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
IF ConvSentFrom NE '' THEN SentFrom = ConvSentFrom
NPRec = INSERT( NPRec, note_ptrs_from$, Pos, 0, SentFrom )
NPRec = INSERT( NPRec, note_ptrs_date$, Pos, 0, NoteDt )
NPRec = INSERT( NPRec, note_ptrs_time$, Pos, 0, NoteTime )
NPRec = INSERT( NPRec, note_ptrs_new$, Pos, 0, 'Yes' )
NPRec = INSERT( NPRec, note_ptrs_note_ids$, Pos, 0, NoteID )
NPRec = INSERT( NPRec, note_ptrs_attachment$, Pos, 0, Attachment )
NPRec = INSERT( NPRec, note_ptrs_archived$, Pos, 0, '0')
END
Done = 0
LOOP
READNEXT NoteID ELSE Done = 1
UNTIL Done
LOCATE NoteID IN NoteIDs BY 'DR' USING @FM SETTING Pos ELSE
NoteIDs = INSERT(NoteIDs,Pos,0,0,NoteID)
END
REPEAT
UNTIL LEN(NPRec) > 128000
NEXT I
OtParms = 'NOTE_PTRS':@RM:thisRecipient
obj_Tables('LockRec',OtParms) ;* If not found then returns null, otherwise reads and sets the lock
NPRec = ''
OtParms = FIELDSTORE(OtParms,@RM,4,0,NPRec)
obj_Tables('WriteRec',OtParms)
FOR I = 1 TO COUNT(NoteIDs,@FM) + (NoteIDs NE '')
NoteID = NoteIDs<I>
NoteRec = XLATE('NOTES',NoteID,'','X')
Subject = NoteRec<NOTES_SUBJECT$>
SentFrom = NoteRec<NOTES_FROM$>
NoteDt = OCONV(NoteRec<NOTES_ENTRY_DATE$>,'D2/')
NoteTime = OCONV(NoteRec<NOTES_ENTRY_TIME$>,'MTH')
AttachWindow = NoteRec<notes_attach_window$>
AttachKeys = NoteRec<notes_attach_keys$>
IF AttachWindow NE '' AND AttachKeys NE '' THEN
Attachment = 'Yes'
END ELSE
Attachment = 'No'
END
LOCATE NoteID IN NPRec<note_ptrs_note_ids$> BY 'DR' USING @VM SETTING Pos ELSE
NPRec = INSERT( NPRec, note_ptrs_subject$, Pos, 0, Subject ) ;* Add the subject
ConvSentFrom = OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
IF ConvSentFrom NE '' THEN SentFrom = ConvSentFrom
NPRec = INSERT( NPRec, note_ptrs_from$, Pos, 0, SentFrom )
NPRec = INSERT( NPRec, note_ptrs_date$, Pos, 0, NoteDt )
NPRec = INSERT( NPRec, note_ptrs_time$, Pos, 0, NoteTime )
NPRec = INSERT( NPRec, note_ptrs_new$, Pos, 0, 'Yes' )
NPRec = INSERT( NPRec, note_ptrs_note_ids$, Pos, 0, NoteID )
NPRec = INSERT( NPRec, note_ptrs_attachment$, Pos, 0, Attachment )
NPRec = INSERT( NPRec, note_ptrs_archived$, Pos, 0, '0')
END
UNTIL LEN(NPRec) > 128000
NEXT I
OtParms = FIELDSTORE(OtParms,@RM,4,0,NPRec)
obj_Tables('WriteRec',OtParms)
RETURN
* * * * * * *
AllActiveUsers:
* * * * * * *
OPEN 'DICT.LSL_USERS' TO DictVar ELSE RETURN
OPEN 'DICT.LSL_USERS' TO DictVar ELSE RETURN
SearchString = 'ACTIVE':@VM:'1':@FM
TableName = 'LSL_USERS'
Option = ''
Flag = ''
SearchString = 'ACTIVE':@VM:'1':@FM
TableName = 'LSL_USERS'
Option = ''
Flag = ''
Btree.Extract(SearchString, TableName, DictVar, AllUserList, Option, Flag )
Btree.Extract(SearchString, TableName, DictVar, AllUserList, Option, Flag )
IF Get_Status(errCode) THEN RETURN
IF Get_Status(errCode) THEN RETURN
Result = AllUserList
Result = AllUserList
RETURN
* * * * * * *
PostEMail:
* * * * * * *
NoteKey = Parms[1,@RM]
NoteKey = Parms[1,@RM]
IF NoteKey = '' THEN RETURN
IF NoteKey = '' THEN RETURN
NoteRec = XLATE('NOTES',NoteKey,'','X')
NoteRec = XLATE('NOTES',NoteKey,'','X')
SentFrom = NoteRec<NOTES_FROM$>
Recipients = NoteRec<NOTES_SEND_TO$>
Subject = NoteRec<NOTES_SUBJECT$>
Message = NoteRec<NOTES_MESSAGE$>
AttachWindow = NoteRec<NOTES_ATTACH_WINDOW$>
AttachKeys = NoteRec<NOTES_ATTACH_KEYS$>
SendToGroup = NoteRec<NOTES_MSG_GROUPS_IDS$>
SentFrom = NoteRec<NOTES_FROM$>
Recipients = NoteRec<NOTES_SEND_TO$>
Subject = NoteRec<NOTES_SUBJECT$>
Message = NoteRec<NOTES_MESSAGE$>
AttachWindow = NoteRec<NOTES_ATTACH_WINDOW$>
AttachKeys = NoteRec<NOTES_ATTACH_KEYS$>
SendToGroup = NoteRec<NOTES_MSG_GROUPS_IDS$>
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
RecipientsText = Recipients
RecipientsText = Recipients
SWAP @VM WITH ', ' IN RecipientsText
SWAP @VM WITH ', ' IN RecipientsText
RecipCnt = COUNT(Recipients,@VM) + (Recipients NE '')
RecipCnt = COUNT(Recipients,@VM) + (Recipients NE '')
FOR I = 1 TO RecipCnt
FOR I = 1 TO RecipCnt
Recipient = Recipients<1,I>
Recipient = Recipients<1,I>
UserRec = XLATE('LSL_USERS',Recipient,'','X')
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
eMailAddr = UserRec<LSL_USERS_EMAIL$>
UserRec = XLATE('LSL_USERS',Recipient,'','X')
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
eMailAddr = UserRec<LSL_USERS_EMAIL$>
IF FwdFlag = 1 AND eMailAddr NE '' THEN
IF FwdFlag = 1 AND eMailAddr NE '' THEN
Text = ''
Text<-1> = 'OI eMail from: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
IF AttachWindow NE '' THEN
Text = ''
Text<-1> = 'OI eMail from: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Attached Window: ':AttachWindow
END
IF AttachKeys NE '' THEN
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Record Key: ':AttachKeys
END
IF SendToGroup NE '' THEN
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
Text<-1> = 'Sent to Group: ':SendToGroup
END
HeaderText = TEXT<1>
IF AttachWindow NE '' THEN
Text<-1> = ''
Text<-1> = 'Attached Window: ':AttachWindow
END
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
IF AttachKeys NE '' THEN
Text<-1> = ''
Text<-1> = 'Record Key: ':AttachKeys
END
eMailBoxKey = NoteKey:'*':Recipient
eMailBoxRec = ''
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
IF SendToGroup NE '' THEN
Text<-1> = ''
Text<-1> = 'Sent to Group: ':SendToGroup
END
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
obj_Tables('WriteRec',ebParms)
HeaderText = TEXT<1>
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
END ;* End of check for forwarding flag
eMailBoxKey = NoteKey:'*':Recipient
eMailBoxRec = ''
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
NEXT I
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
obj_Tables('WriteRec',ebParms)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
END
END ;* End of check for forwarding flag
NEXT I
RETURN
@ -459,9 +393,7 @@ ForwardEMail:
MsgSent = SRP_Send_Mail(Message, ConfigFile)
IF MsgSent = 1 THEN
* obj_Tables('DeleteRec',mbParms)
END ELSE
IF MsgSent NE True$ THEN
Set_Status(0)
obj_Tables('UnlockRec',mbParms)
@ -498,99 +430,94 @@ EMail:
* Direct outside eMail without creating a NOTES record
Recipients = Parms[1,@RM]
SentFrom = Parms[COL2()+1,@RM]
Subject = Parms[COL2()+1,@RM]
Message = Parms[COL2()+1,@RM]
Recipients = Parms[1,@RM]
SentFrom = Parms[COL2()+1,@RM]
Subject = Parms[COL2()+1,@RM]
Message = Parms[COL2()+1,@RM]
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
IF ErrorMsg NE '' THEN RETURN
IF ErrorMsg NE '' THEN RETURN
thisRecipients = ''
RecipCnt = 0
thisRecipients = ''
RecipCnt = 0
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
Recipient = Recipients<1,I>
IF Recipient NE '' THEN
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
RecipCnt += 1
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
Recipient = Recipients<1,I>
IF Recipient NE '' THEN
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
RecipCnt += 1
END
END
END
NEXT I
NEXT I
RecipientsText = OCONV(thisRecipients,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
RecipientsText = OCONV(thisRecipients,'[XLATE_CONV,LSL_USERS*FIRST_LAST]')
SWAP @VM WITH ', ' IN RecipientsText
SWAP @VM WITH ', ' IN RecipientsText
CurrDTM = obj_Calendar('CurrDTM')
CurrDTM = obj_Calendar('CurrDTM')
FOR I = 1 TO RecipCnt
thisRecipient = thisRecipients<1,I>
FOR I = 1 TO RecipCnt
thisRecipient = thisRecipients<1,I>
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
eMailAddr = UserRec<LSL_USERS_EMAIL$>
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
eMailAddr = UserRec<LSL_USERS_EMAIL$>
IF eMailAddr NE '' THEN
IF eMailAddr NE '' THEN
Text = ''
Text<-1> = 'OI eMail from: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
Text = ''
Text<-1> = 'OI eMail from: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
HeaderText = TEXT<1>
HeaderText = TEXT<1>
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
ConfigFile = ''
ConfigFile<1> = SendUsing_Port$
ConfigFile<2> = ''
ConfigFile<3> = 25 ;* Server port
*ConfigFile<4> = 'appmail.eu.infineon.com' ;* IFX Mail server
ConfigFile<4> = 'mailrelay-external.infineon.com'
ConfigFile<5> = Yes$ ;* Authenticate
ConfigFile<6> = 'oinotify@infineon.com' ;* Username
ConfigFile<7> = 'oinotify1' ;* Password
ConfigFile<8> = No$ ;* Use SSL
ConfigFile = ''
ConfigFile<1> = SendUsing_Port$
ConfigFile<2> = ''
ConfigFile<3> = 25 ;* Server port
ConfigFile<4> = 'mailrelay-external.infineon.com'
ConfigFile<5> = Yes$ ;* Authenticate
ConfigFile<6> = 'oinotify@infineon.com' ;* Username
ConfigFile<7> = 'oinotify1' ;* Password
ConfigFile<8> = No$ ;* Use SSL
SentFrom = 'oinotify@infineon.com'
SendTo = eMailAddr
SentFrom = 'oinotify@infineon.com'
SendTo = eMailAddr
Message = ''
Message<1> = HeaderText ; * Subject
Message<2> = SentFrom ; * From (email address)
Message<3> = eMailAddr ; * Send to (email address)
Message<5> = '' ; * Blind Carbon Copy (email address)
Message<6> = '' ; * Reply To (email address)
Message<7> = 'TEXT' ; * Content Type (TEXT or HTML)
Message<8> = Text ; * Content / Body
Message<9> = '' ; * Attachment(s) (path to file name(s))
Message = ''
Message<1> = HeaderText ; * Subject
Message<2> = SentFrom ; * From (email address)
Message<3> = eMailAddr ; * Send to (email address)
Message<5> = '' ; * Blind Carbon Copy (email address)
Message<6> = '' ; * Reply To (email address)
Message<7> = 'TEXT' ; * Content Type (TEXT or HTML)
Message<8> = Text ; * Content / Body
Message<9> = '' ; * Attachment(s) (path to file name(s))
MsgSent = SRP_Send_Mail(Message, ConfigFile)
MsgSent = SRP_Send_Mail(Message, ConfigFile)
END
NEXT I ;* End of Recipient Loop
END
NEXT I ;* End of Recipient Loop
RETURN
@ -598,160 +525,151 @@ RETURN
* * * * * * *
BulkCreate:
* * * * * * *
* SRP_Stopwatch('Reset')
Recipients = Parms[1,@RM]
SentFrom = Parms[COL2()+1,@RM]
Subject = Parms[COL2()+1,@RM]
Message = Parms[COL2()+1,@RM]
AttachWindow = Parms[COL2()+1,@RM]
AttachKeys = Parms[COL2()+1,@RM]
SendToGroup = Parms[COL2()+1,@RM]
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
Recipients = Parms[1,@RM]
SentFrom = Parms[COL2()+1,@RM]
Subject = Parms[COL2()+1,@RM]
Message = Parms[COL2()+1,@RM]
AttachWindow = Parms[COL2()+1,@RM]
AttachKeys = Parms[COL2()+1,@RM]
SendToGroup = Parms[COL2()+1,@RM]
IF NOT(ASSIGNED(AttachWindow)) THEN AttachWindow = ''
IF NOT(ASSIGNED(AttachKeys)) THEN AttachKeys = ''
IF NOT(ASSIGNED(SendToGroup)) THEN SendToGroup = ''
IF NOT(ASSIGNED(Recipients)) THEN ErrorMsg = 'Unassigned Parameter "Recipients" passed to object. (':Method:')'
IF NOT(ASSIGNED(SentFrom)) THEN ErrorMsg = 'Unassigned Parameter "SentFrom" passed to object. (':Method:')'
IF NOT(ASSIGNED(Subject)) THEN ErrorMsg = 'Unassigned Parameter "Subject" passed to object. (':Method:')'
IF NOT(ASSIGNED(Message)) THEN ErrorMsg = 'Unassigned Parameter "Message" passed to object. (':Method:')'
IF ErrorMsg NE '' THEN RETURN
IF NOT(ASSIGNED(AttachWindow)) THEN AttachWindow = ''
IF NOT(ASSIGNED(AttachKeys)) THEN AttachKeys = ''
IF NOT(ASSIGNED(SendToGroup)) THEN SendToGroup = ''
thisRecipients = ''
RecipCnt = 0
IF ErrorMsg NE '' THEN RETURN
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
Recipient = Recipients<1,I>
IF Recipient NE '' THEN
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
RecipCnt += 1
thisRecipients = ''
RecipCnt = 0
FOR I = 1 TO COUNT(Recipients,@VM) + (Recipients NE '')
Recipient = Recipients<1,I>
IF Recipient NE '' THEN
LOCATE Recipient IN thisRecipients USING @VM SETTING Pos ELSE
thisRecipients = INSERT(thisRecipients,1,Pos,0,Recipient)
RecipCnt += 1
END
END
END
NEXT I
NEXT I
NextNoteKey = NextKey('NOTES')
NextNoteKey = NextKey('NOTES')
NoteRec = ''
NoteRec<notes_message_type$> = 'I'
NoteRec<notes_entry_date$> = Date()
NoteRec<notes_entry_time$> = Time()
NoteRec<notes_send_to$> = thisRecipients
NoteRec<notes_from$> = SentFrom
NoteRec<notes_message$> = Message
NoteRec<notes_entry_id$> = @USER4
NoteRec<notes_subject$> = Subject
NoteRec<notes_attach_window$> = AttachWindow
NoteRec<notes_attach_keys$> = AttachKeys
NoteRec<notes_msg_groups_ids$> = SendToGroup
NoteRec = ''
NoteRec<notes_message_type$> = 'I'
NoteRec<notes_entry_date$> = Date()
NoteRec<notes_entry_time$> = Time()
NoteRec<notes_send_to$> = thisRecipients
NoteRec<notes_from$> = SentFrom
NoteRec<notes_message$> = Message
NoteRec<notes_entry_id$> = @USER4
NoteRec<notes_subject$> = Subject
NoteRec<notes_attach_window$> = AttachWindow
NoteRec<notes_attach_keys$> = AttachKeys
NoteRec<notes_msg_groups_ids$> = SendToGroup
OtParms = 'NOTES':@RM:NextNoteKey:@RM:@RM:NoteRec
OtParms = 'NOTES':@RM:NextNoteKey:@RM:@RM:NoteRec
Fields = notes_message_type$:@VM ; Values = 'I' :@VM
Fields := notes_entry_date$:@VM ; Values := Date() :@VM
Fields := notes_entry_time$:@VM ; Values := Time() :@VM
Fields := notes_send_to$:@VM ; Values := thisRecipients :@VM
Fields := notes_from$:@VM ; Values := SentFrom :@VM
Fields := notes_message$:@VM ; Values := Message :@VM
Fields := notes_entry_id$:@VM ; Values := @USER4 :@VM
Fields := notes_subject$:@VM ; Values := Subject :@VM
Fields := notes_attach_window$:@VM ; Values := AttachWindow :@VM
Fields := notes_attach_keys$:@VM ; Values := AttachKeys :@VM
Fields := notes_msg_groups_ids$ ; Values := SendToGroup
Fields = notes_message_type$:@VM ; Values = 'I' :@VM
Fields := notes_entry_date$:@VM ; Values := Date() :@VM
Fields := notes_entry_time$:@VM ; Values := Time() :@VM
Fields := notes_send_to$:@VM ; Values := thisRecipients :@VM
Fields := notes_from$:@VM ; Values := SentFrom :@VM
Fields := notes_message$:@VM ; Values := Message :@VM
Fields := notes_entry_id$:@VM ; Values := @USER4 :@VM
Fields := notes_subject$:@VM ; Values := Subject :@VM
Fields := notes_attach_window$:@VM ; Values := AttachWindow :@VM
Fields := notes_attach_keys$:@VM ; Values := AttachKeys :@VM
Fields := notes_msg_groups_ids$ ; Values := SendToGroup
oblParms = 'NOTES' :@RM
oblParms := NextNoteKey :@RM
oblParms := Fields :@RM
oblParms := Values :@RM
oblParms := "TOP" :@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP"
oblParms = 'NOTES' :@RM
oblParms := NextNoteKey :@RM
oblParms := Fields :@RM
oblParms := Values :@RM
oblParms := "TOP" :@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP":@VM: "TOP" :@VM: "TOP"
* SRP_Stopwatch('Start', 'NOTES Write')
//Obj_Post_Log('Create', oblParms)
obj_Tables('WriteRec',OtParms) ;* Writes the Note record to disk
* SRP_Stopwatch('Stop', 'NOTES Write')
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
obj_Tables('WriteRec',OtParms) ;* Writes the Note record to disk
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTHS')
RecipientsText = thisRecipients
RecipientsText = thisRecipients
SWAP @VM WITH ', ' IN RecipientsText
SWAP @VM WITH ', ' IN RecipientsText
FOR I = 1 TO RecipCnt
FOR I = 1 TO RecipCnt
thisRecipient = thisRecipients<1,I>
thisRecipient = thisRecipients<1,I>
obj_Notes_Sent('Create',thisRecipient:@RM:NextNoteKey:@RM:CurrDTM) ;* Add to Notes Sent buffer table
obj_Notes_Sent('Create',thisRecipient:@RM:NextNoteKey:@RM:CurrDTM) ;* Add to Notes Sent buffer table
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
eMailAddr = UserRec<LSL_USERS_EMAIL$>
UserRec = XLATE('LSL_USERS',thisRecipient,'','X')
FwdFlag = UserRec<LSL_USERS_FWD_EMAIL$>
eMailAddr = UserRec<LSL_USERS_EMAIL$>
IF FwdFlag = 1 AND eMailAddr NE '' THEN
IF FwdFlag = 1 AND eMailAddr NE '' THEN
Text = ''
Text<-1> = 'OI eMail From: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
IF AttachWindow NE '' THEN
Text = ''
Text<-1> = 'OI eMail From: ':OCONV(SentFrom,'[XLATE_CONV,LSL_USERS*FIRST_LAST]'):' at ':CurrDTM
Text<-1> = ''
Text<-1> = 'Attached Window: ':AttachWindow
END
IF AttachKeys NE '' THEN
Text<-1> = 'Recipients: ':RecipientsText
Text<-1> = ''
Text<-1> = 'Record Key: ':AttachKeys
END
IF SendToGroup NE '' THEN
Text<-1> = 'Subject: ':Subject
Text<-1> = ''
Text<-1> = 'Message: '
Text<-1> = ''
Text<-1> = Message
Text<-1> = ''
Text<-1> = 'Sent to Group: ':SendToGroup
END
HeaderText = Text<1>
IF AttachWindow NE '' THEN
Text<-1> = ''
Text<-1> = 'Attached Window: ':AttachWindow
END
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
IF AttachKeys NE '' THEN
Text<-1> = ''
Text<-1> = 'Record Key: ':AttachKeys
END
eMailBoxKey = NextNoteKey:'*':thisRecipient
IF SendToGroup NE '' THEN
Text<-1> = ''
Text<-1> = 'Sent to Group: ':SendToGroup
END
eMailBoxRec = ''
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
SRP_Stopwatch('Start', 'Email Write')
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
//obj_Tables('WriteRec',ebParms)
HeaderText = Text<1>
Fields = EMAIL_BOX_EMAIL_ADDR$:@VM ; Values = eMailAddr :@VM
Fields := EMAIL_BOX_EMAIL_TEXT$:@VM ; Values := Text :@VM
Fields := EMAIL_BOX_EMAIL_HEADER$:@VM ; Values := HeaderText :@VM
Fields := EMAIL_BOX_FROM_USER$:@VM ; Values := SentFrom :@VM
CONVERT \00\ TO ',' IN Text
SWAP @VM WITH ':@VM:' IN Text
SWAP @FM WITH CHAR(13):CHAR(10) IN Text
SWAP @TM WITH CHAR(13):CHAR(10) IN Text
eblParms = 'EMAIL_BOX' :@RM
eblParms := eMailBoxKey :@RM
eblParms := Fields :@RM
eblParms := Values :@RM
eblParms := "TOP" :@VM: "TOP" :@VM: "TOP":@VM: "TOP"
* obj_Tables('WriteRec',ebParms)
Obj_Post_Log('Create' eblParms)
* SRP_Stopwatch('Stop', 'Email Write')
END ;* End of check for forwarding flag
eMailBoxKey = NextNoteKey:'*':thisRecipient
eMailBoxRec = ''
eMailBoxRec<EMAIL_BOX_EMAIL_ADDR$> = eMailAddr
eMailBoxRec<EMAIL_BOX_EMAIL_TEXT$> = Text
eMailBoxRec<EMAIL_BOX_EMAIL_HEADER$> = HeaderText
eMailBoxRec<EMAIL_BOX_FROM_USER$> = SentFrom
SRP_Stopwatch('Start', 'Email Write')
ebParms = 'EMAIL_BOX':@RM:eMailBoxKey:@RM:@RM:eMailBoxRec
Fields = EMAIL_BOX_EMAIL_ADDR$:@VM ; Values = eMailAddr :@VM
Fields := EMAIL_BOX_EMAIL_TEXT$:@VM ; Values := Text :@VM
Fields := EMAIL_BOX_EMAIL_HEADER$:@VM ; Values := HeaderText :@VM
Fields := EMAIL_BOX_FROM_USER$:@VM ; Values := SentFrom :@VM
eblParms = 'EMAIL_BOX' :@RM
eblParms := eMailBoxKey :@RM
eblParms := Fields :@RM
eblParms := Values :@RM
eblParms := "TOP" :@VM: "TOP" :@VM: "TOP":@VM: "TOP"
Obj_Post_Log('Create' eblParms)
END ;* End of check for forwarding flag
NEXT I
NEXT I
//SRP_Stopwatch('ShowAll')
* Test = SRP_Stopwatch('GetAll')
* debug
RETURN

74
LSL2/STPROC/OBJ_NOTES_SENT.txt
View File

@ -14,7 +14,6 @@ COMPILE FUNCTION obj_Notes_Sent(Method,Parms)
*/
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, ErrMsg, Btree.Extract,ErrMsg, Update_Index
@ -58,53 +57,51 @@ END
RETURN Result
* * * * * * *
Create:
* * * * * * *
Recipient = Parms[1,@RM]
NoteID = Parms[COL2()+1,@RM]
TxDTM = Parms[COL2()+1,@RM] ;* In External format
Recipient = Parms[1,@RM]
NoteID = Parms[COL2()+1,@RM]
TxDTM = Parms[COL2()+1,@RM] ;* In External format
IF Recipient = '' THEN ErrorMsg = 'Unassigned Parameter "Recipient" passed to object. (':Method:')'
IF NoteID = '' THEN ErrorMsg = 'Unassigned Parameter "NoteID" passed to object. (':Method:')'
IF TxDTM = '' THEN ErrorMsg = 'Unassigned Parameter "TxDTM" passed to object. (':Method:')'
IF Recipient = '' THEN ErrorMsg = 'Unassigned Parameter "Recipient" passed to object. (':Method:')'
IF NoteID = '' THEN ErrorMsg = 'Unassigned Parameter "NoteID" passed to object. (':Method:')'
IF TxDTM = '' THEN ErrorMsg = 'Unassigned Parameter "TxDTM" passed to object. (':Method:')'
IF ErrorMsg NE '' THEN RETURN
IF ErrorMsg NE '' THEN RETURN
thisTxDTM = ICONV(TxDTM,'DT')
thisTxDTM = ICONV(TxDTM,'DT')
IF thisTxDTM = '' THEN
ErrorMsg = 'Invalid parameter "TxDTM" = ':QUOTE(TxDTM):' passed to object. (':Method:')'
RETURN
END
IF thisTxDTM = '' THEN
ErrorMsg = 'Invalid parameter "TxDTM" = ':QUOTE(TxDTM):' passed to object. (':Method:')'
RETURN
END
OtParms = 'NOTES_SENT':@RM:Recipient:'*':NoteID:@RM:@RM:TxDTM ;* First (and only) field in record is TxDTM
obj_Tables('WriteRec',OtParms) ;* Writes new record
OtParms = 'NOTES_SENT':@RM:Recipient:'*':NoteID:@RM:@RM:TxDTM ;* First (and only) field in record is TxDTM
obj_Tables('WriteRec',OtParms) ;* Writes new record
Update_Index('NOTES_SENT','USER_ID','')
Update_Index('NOTES_SENT','USER_ID','', True$)
RETURN
* * * * * * *
Delete:
* * * * * * *
NotesSentKeys = Parms[1,@RM]
NotesSentKeys = Parms[1,@RM]
IF NotesSentKeys = '' THEN RETURN
IF NotesSentKeys = '' THEN RETURN
OPEN 'NOTES_SENT' TO NotesSentFile THEN
KeyCnt = COUNT(NotesSentKeys,@VM) + (NotesSentKeys NE '')
FOR I = 1 TO KeyCnt
DELETE NotesSentFile,NotesSentKeys<1,I> ELSE NULL
NEXT I
END
OPEN 'NOTES_SENT' TO NotesSentFile THEN
KeyCnt = COUNT(NotesSentKeys,@VM) + (NotesSentKeys NE '')
FOR I = 1 TO KeyCnt
DELETE NotesSentFile,NotesSentKeys<1,I> ELSE NULL
NEXT I
END
RETURN
@ -113,22 +110,21 @@ RETURN
GetUserKeys:
* * * * * * *
Recipient = Parms[1,@RM]
Recipient = Parms[1,@RM]
IF Recipient = '' THEN RETURN
IF Recipient = '' THEN RETURN
OPEN 'DICT.NOTES_SENT' TO DictVar THEN
SearchString = 'USER_ID':@VM:Recipient:@FM
Flag = ''
Btree.Extract(SearchString,'NOTES_SENT',DictVar,NotesSentKeys,'',Flag)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
OPEN 'DICT.NOTES_SENT' TO DictVar THEN
SearchString = 'USER_ID':@VM:Recipient:@FM
Flag = ''
Btree.Extract(SearchString,'NOTES_SENT',DictVar,NotesSentKeys,'',Flag)
IF Get_Status(errCode) THEN
ErrMsg(errCode)
RETURN
END
Result = NotesSentKeys
END
Result = NotesSentKeys
END
RETURN

3
LSL2/STPROC/OBJ_NOTE_PTRS.txt
View File

@ -16,6 +16,7 @@ COMPILE FUNCTION obj_Note_Ptrs(Method,Parms)
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey, obj_Notes_Sent
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, RList, ErrMsg, obj_Notes_Sent, Update_Index
$INSERT LOGICAL
$INSERT MSG_EQUATES
$INSERT NOTES_EQU
$INSERT NOTE_PTRS_EQU
@ -128,7 +129,7 @@ IF NotesSentKeys NE '' THEN
END ELSE
obj_Notes_Sent('Delete',NotesSentKeys)
Update_Index('NOTES_SENT','USER_ID','')
Update_Index('NOTES_SENT','USER_ID', False$, True$)
END
END ELSE
obj_Tables('UnlockRec',OtParms)

3
LSL2/STPROC/OBJ_PROD_SPEC.txt
View File

@ -1730,7 +1730,7 @@ END
* obj_PRS_Stage('Convert',PSNo) ;* Dead JCH 3/11/2013
// Flush pending index transactions
Update_Index("PRS_LAYER", "PRS_PROP_KEY", "")
Update_Index("PRS_LAYER", "PRS_PROP_KEY", False$, True$)
RETURN
@ -2109,3 +2109,4 @@ GetQAMet:
RETURN

9
LSL2/STPROC/OBJ_REACTOR_LOG.txt
View File

@ -198,8 +198,8 @@ PostReactItems:
//obj_Tables('WriteRec',otParms)
Database_Services('WriteDataRow', 'REACTOR_LOG', RLNo, ReactorLogRec, 1, 0, 1)
Update_Index('REACT_ITEM_HIST', 'INST_RL_ID', '') ;* Don't wait for indexer - flush pending indexes now
Update_Index('REACT_ITEM_HIST', 'REM_RL_ID', '')
Update_Index('REACT_ITEM_HIST', 'INST_RL_ID', False$, True$) ;* Don't wait for indexer - flush pending indexes now
Update_Index('REACT_ITEM_HIST', 'REM_RL_ID', False$, True$)
end else
Error_Services('Add', ValidationFailureReason)
end
@ -299,8 +299,8 @@ UnpostReactItems:
//obj_Tables('WriteRec',otParms)
Database_Services('WriteDataRow', 'REACTOR_LOG', RLNo, ReactorLogRec, 1,0,1)
Update_Index('REACT_ITEM_HIST', 'REM_RL_ID', '') ;* Don't wait for indexer - flush pending indexes now
Update_Index('REACT_ITEM_HIST', 'INST_RL_ID', '')
Update_Index('REACT_ITEM_HIST', 'REM_RL_ID', False$, True$) ;* Don't wait for indexer - flush pending indexes now
Update_Index('REACT_ITEM_HIST', 'INST_RL_ID', False$, True$)
RETURN
@ -392,3 +392,4 @@ RETURN

3
LSL2/STPROC/PRINT_WO_MASTER_SCHEDULER.txt
View File

@ -73,7 +73,7 @@ Appts:
// Build list of keys that fall on the three days
Keys = ""
Field = "DATE_SPAN_XREF"
Update_Index(Table, Field, No$)
Update_Index(Table, Field, No$, Yes$)
For i = 0 to 2
Extract_SI_Keys(Table, Field, Date+i, rv)
Keys<-1> = rv
@ -271,3 +271,4 @@ Print_Two:
Next r
Next x
return

9
LSL2/STPROC/SQL_SERVICES.txt
View File

@ -3548,10 +3548,10 @@ Service ProcessSQLRequests()
GoSub ClearCursors
Sentence = 'SELECT ':Tablename:' WITH RESPONSE_DATE EQ "" BY REQUEST_DATE BY REQUEST_TIME'
Set_Status(0)
Update_Index(Tablename, 'REQUEST_DATE', 0)
Update_Index(Tablename, 'REQUEST_TIME', 0)
Update_Index(Tablename, 'RESPONSE_DATE', 0)
Update_Index(Tablename, 'RESPONSE_TIME', 0)
Update_Index(Tablename, 'REQUEST_DATE', False$, True$)
Update_Index(Tablename, 'REQUEST_TIME', False$, True$)
Update_Index(Tablename, 'RESPONSE_DATE', False$, True$)
Update_Index(Tablename, 'RESPONSE_TIME', False$, True$)
RList(Sentence, TARGET_ACTIVELIST$, '', '', '')
EOF = False$
Loop
@ -3640,3 +3640,4 @@ return

5
LSL2/STPROC/SVC_SCHEDULER.txt
View File

@ -417,7 +417,7 @@ Bump:
Table = "WO_MAST_SCHED"
Open Table to hTable then
Update_Index(Table, "DATE_REACT", No$)
Update_Index(Table, "DATE_REACT", No$, Yes$)
Extract_SI_Keys(Table, "DATE_REACT", DateReact, Keys)
Duration = (Appt<3> - Appt<2>)
If Noon then Duration -= .5
@ -785,7 +785,7 @@ return
WO_Status_Colors:
Color_F = "" ; Color_B = "" ; Color_S = ""
Begin Case
Case Event EQ "Down – No Material" ; Color_F = White$ ; Color_B = "Sienna" ; Color_S = "Offline"
Case Event EQ "Down – No Material" ; Color_F = White$ ; Color_B = "Sienna" ; Color_S = "Offline"
Case Event ; Color_F = Black$ ; Color_B = "GoldenRod" ; Color_S = "Offline"
Case WO.Done ; Color_F = Black$ ; Color_B = "Gainsboro" ; Color_S = "Completed"
Case Hot ; Color_F = Black$ ; Color_B = "LightCoral" ; Color_S = "Hot"
@ -855,3 +855,4 @@ Reactor_List:
Next i
return

5
LSL2/STPROC/TEST.txt
View File

@ -506,8 +506,8 @@ Database_Services('WriteDataRow', 'WO_MAT', WOMatKey, WOMatRow, True$, False, Tr
WOMatRow<12> = RDSNo ; // Restore the RDS No so the index on RDS_FINAL_SIG will be forced to recalculate with the most recent value.
WOMatRow<23> = True$ ; // Restore the MakeUp box flag so the index will be forced to recalculate.
Database_Services('WriteDataRow', 'WO_MAT', WOMatKey, WOMatRow, True$, False, True$)
call Update_Index('WO_MAT', 'MU_PART_NO', False$)
call Update_Index('WO_MAT', 'CURR_STATUS', False$)
call Update_Index('WO_MAT', 'MU_PART_NO', False$, True$)
call Update_Index('WO_MAT', 'CURR_STATUS', False$, True$)
@ -950,3 +950,4 @@ Debug
Return

19
LSL2/STPROC/TEST_DANIEL3.txt
View File

@ -94,6 +94,24 @@ $Insert PS_EQUATES
* $INSERT PRINTSETUP_EQUATES
* equ REV_CREATE_ENGINE_NO_UI$ to 0x040
Main:
debug
Recipients = ''
SentFrom = @USER4
SendToGroup = 'RDS_HOLD' : @VM : 'FI_SUPPORT'
Subject = 'Testing 2'
Message = 'Testing 1234'
AttachWindow = ''
AttachKey = ''
Parms = Recipients:@RM:SentFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',Parms)
return
* Main:
* debug
* Open 'LSL_USERS' to hTable then
@ -203,3 +221,4 @@ Main2:
return

7
LSL2/STPROC/TOOL_SERVICES.txt
View File

@ -163,7 +163,7 @@ Service ChangeToolMode(ToolID, NewMode, NewReason, CurrUser, ForceModeChange)
// Close old mode record
// Don't wait for the indexer. Flush pending index transactions BEFORE reading
// the Tool CURR_MODE_KEY.
Update_Index('TOOL_LOG', 'TOOL_CURR_MODE', False$)
Update_Index('TOOL_LOG', 'TOOL_CURR_MODE', False$, True$)
// Get Current Mode - There should only be one key, but we will verify before proceeding.
CurrModeKeys = Xlate('TOOL', ToolID, TOOL_CURR_MODE_KEY$, 'X')
// CurrModeKey will be set within the following GoSub
@ -313,10 +313,10 @@ VerifyCurrModeIndex:
StopDtm = ToolLogRec<TOOL_LOG_STOP_DTM$>
ToolLogRec<TOOL_LOG_STOP_DTM$> = ''
Database_Services('WriteDataRow', 'TOOL_LOG', CurrModeKey, ToolLogRec, True$, False$, True$)
Update_Index('TOOL_LOG', 'TOOL_CURR_MODE', False$)
Update_Index('TOOL_LOG', 'TOOL_CURR_MODE', False$, True$)
ToolLogRec<TOOL_LOG_STOP_DTM$> = StopDtm
Database_Services('WriteDataRow', 'TOOL_LOG', CurrModeKey, ToolLogRec, True$, False$, True$)
Update_Index('TOOL_LOG', 'TOOL_CURR_MODE', False$)
Update_Index('TOOL_LOG', 'TOOL_CURR_MODE', False$, True$)
Next CurrModeKey
// The index should be healthy now and we should only have one key.
@ -328,3 +328,4 @@ VerifyCurrModeIndex:
return

1
LSL2/STPROC/WAFER_COUNTER_SERVICES.txt
View File

@ -409,3 +409,4 @@ return

3
LSL2/STPROC/WO_SET_SCHEDULE.txt
View File

@ -82,7 +82,7 @@ Open:
// Update indexes
Wait = SRP_Wait("Init", "Scheduler Load":@RM:"Updating indexes...")
Update_Index(Table, "SCHED_DT", No$)
Update_Index(Table, "SCHED_DT", No$, Yes$)
return
@ -286,3 +286,4 @@ Check_Pace:
end
end
return

25
LSL2/STPROCINS/NOTES_EQUATES.txt Normal file
View File

@ -0,0 +1,25 @@
compile insert NOTES_EQUATES
* Equates for NOTES created on 10/16/2024 11:02AM
Equ NOTES_MESSAGE_TYPE$ to 1
equ NOTES_ENTRY_DATE$ to 2
equ NOTES_ENTRY_TIME$ to 3
equ NOTES_SEND_TO$ to 4
equ NOTES_FROM$ to 5
equ NOTES_COMPANY$ to 6
equ NOTES_PHONE$ to 7
equ NOTES_INTL_PHONE$ to 8
equ NOTES_MESSAGE$ to 9
equ NOTES_ENTRY_ID$ to 10
equ NOTES_PT_PHONED$ to 11
equ NOTES_PT_CALL_BACK$ to 12
equ NOTES_PT_RET_CALL$ to 13
equ NOTES_PT_WANTS_SEE$ to 14
equ NOTES_PT_WILL_CALL$ to 15
equ NOTES_PT_WAS_IN$ to 16
equ NOTES_PT_URGENT$ to 17
equ NOTES_SUBJECT$ to 18
equ NOTES_ATTACH_WINDOW$ to 19
equ NOTES_ATTACH_KEYS$ to 20 ;* Not used anymore
equ NOTES_ATTACH_KEY$ to 20
equ NOTES_MSG_GROUPS_IDS$ to 21

12
LSL2/STPROCINS/NOTES_QUEUE_EQUATES.txt Normal file
View File

@ -0,0 +1,12 @@
compile insert NOTES_QUEUE_EQUATES
/*----------------------------------------
Author : Table Create Insert Routine
Written : 16/10/2024
Description : Insert for Table NOTES_QUEUE
----------------------------------------*/
#ifndef __NOTES_QUEUE_EQUATES__
#define __NOTES_QUEUE_EQUATES__
equ NOTES_QUEUE.NOTES_ID$ to 1
#endif

14
LSL2/STPROCINS/NOTE_PTRS_EQUATES.txt Normal file
View File

@ -0,0 +1,14 @@
compile insert NOTE_PTRS_EQUATES
* Equates for NOTE_PTRS created on 08/03/95 07:31AM
Equ NOTE_PTRS_SUBJECT$ to 1
Equ NOTE_PTRS_FROM$ to 2
Equ NOTE_PTRS_DATE$ to 3
Equ NOTE_PTRS_TIME$ to 4
Equ NOTE_PTRS_NEW$ to 5
Equ NOTE_PTRS_ATTACHMENT$ to 6
Equ NOTE_PTRS_NOTE_IDS$ to 7
Equ NOTE_PTRS_ARCHIVED$ to 8
Equ NOTE_PTRS_SNOOZE$ to 9

9
LSL2/STPROCINS/NOTIFICATION_EQUATES.txt
View File

@ -6,6 +6,9 @@ compile insert NOTIFICATION_EQUATES
----------------------------------------*/
Equ NOTIFICATION_NOTIFY_ID$ To 0
Equ NOTIFICATION_DESC$ To 1
Equ NOTIFICATION_USER_ID$ To 2
Equ NOTIFICATION_NOTIFY_ID$ To 0
Equ NOTIFICATION_DESC$ To 1
Equ NOTIFICATION_USER_ID$ To 2
Equ NOTIFICATION_USE_ACTIVE_DIRECTORY$ To 3
Equ NOTIFICATION_ACTIVE_DIRECTORY_GROUPS$ To 4
Equ NOTIFICATION_LIMIT_TO_ACTIVE_SHIFT$ To 5

4
SYSPROG/STPROC/DATABASE_SERVICES.txt
View File

@ -666,7 +666,6 @@ Service SearchIndex(TableName, ColumnName, SearchValue, UpdateIndex)
ServiceKeyID := '*' : TableName : '*' : ColumnName : '*' : SearchValue
ServiceKeyID = SRP_Encode(ServiceKeyID, 'BASE64')
* KeyIDList = Memory_Services('GetValue', ServiceKeyID, True$, 5)
KeyIDList = ''
If TableName NE '' AND ColumnName NE '' AND SearchValue NE '' then
@ -674,7 +673,7 @@ Service SearchIndex(TableName, ColumnName, SearchValue, UpdateIndex)
DictTableHandle = Database_Services('GetTableHandle', 'DICT.' : TableName)
If Error_Services('NoError') then
Set_Status(0)
If UpdateIndex then Update_Index(TableName, ColumnName 0)
If UpdateIndex then Update_Index(TableName, ColumnName, False$, True$)
Set_Status(0)
Flag = ''
Btree.Extract(ColumnName : @VM : SearchValue : @FM, Tablename, DictTableHandle, KeyIDList, 'S', Flag)
@ -1045,3 +1044,4 @@ end service
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

9
SYSPROG/STPROC/SQL_SERVICES.txt
View File

@ -3548,10 +3548,10 @@ Service ProcessSQLRequests()
GoSub ClearCursors
Sentence = 'SELECT ':Tablename:' WITH RESPONSE_DATE EQ "" BY REQUEST_DATE BY REQUEST_TIME'
Set_Status(0)
Update_Index(Tablename, 'REQUEST_DATE', 0)
Update_Index(Tablename, 'REQUEST_TIME', 0)
Update_Index(Tablename, 'RESPONSE_DATE', 0)
Update_Index(Tablename, 'RESPONSE_TIME', 0)
Update_Index(Tablename, 'REQUEST_DATE', False$, True$)
Update_Index(Tablename, 'REQUEST_TIME', False$, True$)
Update_Index(Tablename, 'RESPONSE_DATE', False$, True$)
Update_Index(Tablename, 'RESPONSE_TIME', False$, True$)
RList(Sentence, TARGET_ACTIVELIST$, '', '', '')
EOF = False$
Loop
@ -3640,3 +3640,4 @@ return

38
SYSPROG/STPROC/TEMP.txt
View File

@ -1,24 +1,26 @@
Compile Subroutine Temp(dummy)
Declare Function datetime
Debug
Open 'SYSENV' To hSysenv Then
Open 'TEMP_SYSENV' To hNewSysenv Then
Select hSysenv
EOF = 0
Loop
Readnext Key Else EOF = 1
Until EOF
//If IndexC(Key, 'SRP', 1) then
Read Rec From hSysenv, Key Then
Write Rec To hNewSysenv, Key Else
Debug
end
End
//end
Repeat
End
End
dt = datetime()
*Open 'SYSENV' To hSysenv Then
* Open 'TEMP_SYSENV' To hNewSysenv Then
* Select hSysenv
* EOF = 0
* Loop
* Readnext Key Else EOF = 1
* Until EOF
* //If IndexC(Key, 'SRP', 1) then
* Read Rec From hSysenv, Key Then
* Write Rec To hNewSysenv, Key Else
* Debug
* end
* End
* //end
* Repeat
* End
*End
return