open-insight/LSL2/STPROC/SUPPLEMENT_SERVICES.txt
2024-10-10 22:05:31 +02:00

616 lines
26 KiB
Plaintext

Compile function Supplement_Services(@Service, @Params)
/***********************************************************************************************************************
Name : Supplement_Services
Description : Handler program for all Supplement 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)
3/20/24 djm Original programmer.
***********************************************************************************************************************/
#pragma precomp SRP_PreCompiler
$insert APP_INSERTS
$Insert SERVICE_SETUP
$Insert SUPPLEMENTS_EQUATES
$Insert RDS_EQUATES
$Insert NOTIFICATION_EQUATES
Equ COMMA$ to ','
Declare function Database_Services, Supplement_Services, Rti_Createguid, SRP_Array, Datetime, Signature_Services
Declare function Environment_Services, Logging_Services, Select_Into
Declare subroutine Database_Services, Rds_Services, Supplement_Services, Logging_Services, Set_Status, SRP_Stopwatch
Declare subroutine Btree.Extract, obj_Notes
GoToService else
Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
end
Return Response or ''
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Service Parameter Options
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Options LOTTYPES = 'RDS', 'WO_MAT'
Options STAGES = 'VER', 'PREC','PREI', 'PRES', 'LOAD', 'FWII', 'FWIS', 'UNLOAD', 'LWII', 'LWIS', 'PSTC', 'PSTI', 'PSTS', 'QA', 'POST'
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// SERVICES
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//----------------------------------------------------------------------------------------------------------------------
// CreateSupplement
//
// LotType - [Required]
// LotID - [Required]
// Stage - [Required]
// SupplText - [Required]
// EntryUser - [Required]
//
// Create a new Supplement Record.
//
//----------------------------------------------------------------------------------------------------------------------
Service CreateSupplement(LotType=LOTTYPES, LotID, Stage=STAGES, SupplText, EntryUser)
EditEvent = ''
WriteNeeded = True$
Stages = Supplement_Services('GetStagesForLot', LotType, LotID)
If Stages NE False$ then
StageCheck = Count(Stages<1>, Stage)
If LotType NE '' AND LotID NE '' AND SupplText NE '' AND EntryUser NE '' then
Existing = Supplement_Services('GetSupplementsForLot', LotType, LotID, Stage)
If StageCheck NE 0 Then
If Existing EQ False$ then
SupplID = Rti_Createguid()
end else
SupplID = Existing
OrigText = Xlate("SUPPLEMENTS", SupplID, SUPPLEMENTS_SUPPL_TEXT$, 'X', '')
If OrigText EQ SupplText then
WriteNeeded = False$
Response = False$
end
end
end
If WriteNeeded then
NewSupRec = ''
NewSupRec<SUPPLEMENTS_LOT_TYPE$> = LotType
NewSupRec<SUPPLEMENTS_LOT_ID$> = LotID
NewSupRec<SUPPLEMENTS_STAGE$> = Stage
NewSupRec<SUPPLEMENTS_SUPPL_TEXT$> = SupplText
NewSupRec<SUPPLEMENTS_ENTRY_USER$> = EntryUser
NewSupRec<SUPPLEMENTS_ENTRY_DATETIME$> = Datetime()
Database_Services('WriteDataRow', 'SUPPLEMENTS', SupplID, NewSupRec, True$, False$, False$)
If Error_Services('NoError') then
Response = SupplID
If Existing EQ False$ then
EditEvent = 'Created'
end else
EditEvent = 'Edited'
end
Supplement_Services('LogSupplementChange', NewSupRec, EditEvent, EntryUser)
end else
Response = False$
Error_Services('Add', 'Error creating Supplement record.')
end
end
end else
Response = False$
Error_Services('Add', 'LotType, LotID, Stage, SupplText or EntryUser was missing in the ' : Service : ' service.')
end
end else
Response = False$
Error_Services('Add', 'Supplements can only be added to stages associated with the specified lot.')
end
End Service
//----------------------------------------------------------------------------------------------------------------------
// GetStagesWithSupplements
//
// LotType - [Required]
// LotID - [Required]
//
// Returns an array of stages with supplements associated for a given lot
//
//----------------------------------------------------------------------------------------------------------------------
Service GetStagesWithSupplements(LotType=LOTTYPES, LotID)
StageList = ''
Response = False$
If ( (LotType NE '') and (LotID NE '') ) then
KeyList = ''
Query = ''
Query<1> = 'LOT_TYPE' : @VM : LotType
Query<2> = 'LOT_ID' : @VM : LotID : @FM
Flag = ''
Open 'DICT.SUPPLEMENTS' to hDict then
Btree.Extract(Query, 'SUPPLEMENTS', hDict, KeyList, 'E', Flag)
If (Flag EQ 0) then
If KeyList NE '' then
Open 'SUPPLEMENTS' to hTable then
For each Key in KeyList using @VM setting vPos
Read SuppRec from hTable, Key then StageList<-1> = SuppRec<SUPPLEMENTS_STAGE$>
Next Key
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS table.')
end
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error calling Btree.Extract')
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS dictionary.')
end
end else
Error_Services('Add', 'LotType or LotID was missing in the ' : Service : ' service.')
end
If StageList NE '' then Response = StageList
end service
//----------------------------------------------------------------------------------------------------------------------
// GetLotsWithSupplements
//
// LotType - [Required]
//
// Returns an array of lots with associated Supplements.
//
//----------------------------------------------------------------------------------------------------------------------
Service GetLotsWithSupplements(LotType)
KeyList = ''
LotList = ''
Response = False$
If (LotType NE '') then
KeyList = ''
Query = 'LOT_TYPE' : @VM : LotType : @FM
Flag = ''
Open 'DICT.SUPPLEMENTS' to hDict then
Btree.Extract(Query, 'SUPPLEMENTS', hDict, KeyList, 'E', Flag)
If (Flag EQ 0) then
If KeyList NE '' then
LotList = Xlate('SUPPLEMENTS', KeyList, 'LOT_ID', 'X')
LotList = SRP_Array('Clean', LotList, 'TrimAndMakeUnique', @VM)
LotList = SRP_Array("SortSimpleList", LotList, 'AscendingNumbers', @VM)
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error calling Btree.Extract')
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS dictionary.')
end
end else
Error_Services('Add', 'LotType or LotID was missing in the ' : Service : ' service.')
end
If LotList NE '' then Response = LotList
end service
//----------------------------------------------------------------------------------------------------------------------
// GetSupplementsForLot
//
// LotType - [Required]
// LotID - [Required]
// Stage = [Optional]
//
// Returns an array of Supplement IDs for a lot, or for the stage of a lot.
//
//----------------------------------------------------------------------------------------------------------------------
Service GetSupplementsForLot(LotType=LOTTYPES, LotID, Stage=STAGES)
Response = False$
If ( (LotType NE '') and (LotID NE '') ) then
If (Stage EQ '') then
KeyList = ''
Query = ''
Query<1> = 'LOT_TYPE' : @VM : LotType
Query<2> = 'LOT_ID' : @VM : LotID : @FM
Flag = ''
Open 'DICT.SUPPLEMENTS' to hDict then
Btree.Extract(Query, 'SUPPLEMENTS', hDict, KeyList, 'E', Flag)
If (Flag EQ 0) then
If (KeyList NE '') then
SupplementList = ''
Stages = Supplement_Services('GetStagesForLot', LotType, LotID)
StageCount = Dcount(Stages<1>, @VM)
For I = 1 to StageCount
SupplementStage = Supplement_Services('GetSupplementsForLot', LotType, LotID, Stages<1,I>)
If SupplementStage NE False$ then SupplementList<-1> = SupplementStage
Next I
If SupplementList NE '' then Response = SupplementList
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error calling Btree.Extract')
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS dictionary.')
end
end else
StageSupplementList = ''
Query = ''
Query<1> = 'LOT_TYPE' : @VM : LotType
Query<2> = 'LOT_ID' : @VM : LotID
Query<3> = 'STAGE' : @VM : Stage : @FM
Flag = ''
Open 'DICT.SUPPLEMENTS' to hDict then
Btree.Extract(Query, 'SUPPLEMENTS', hDict, StageSupplementList, 'E', Flag)
If (Flag EQ 0) then
If StageSupplementList NE '' then Response = StageSupplementList
end else
Error_Services('Add', 'Error in ':Service:' service. Error calling Btree.Extract')
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS dictionary.')
end
end
end else
Error_Services('Add', 'LotType or LotID was missing in the ' : Service : ' service.')
end
end service
//----------------------------------------------------------------------------------------------------------------------
// DeleteSupplementByByLotStage
//
// EntryUser - [Required]
// LotType - [Required]
// LotID - [Required]
// Stage = [Required]
//
// Delete an existing Supplement.
//
//----------------------------------------------------------------------------------------------------------------------
Service DeleteSupplementByLotStage(EntryUser, LotType=LOTTYPES, LotID, Stage=STAGES)
Response = False$
If ( (LotType NE '') and (LotID NE '') and (Stage NE '') and (EntryUser NE '') ) then
ExistingSupps = Supplement_Services('GetSupplementsForLot', LotType, LotID, Stage)
If ExistingSupps NE '' then
For Each SupplID in ExistingSupps using @VM
SupplRec = Xlate('SUPPLEMENTS', SupplID, '', 'X', '')
Database_Services('DeleteDataRow', 'SUPPLEMENTS', SupplID, True$, False$)
If Error_Services('NoError') then
Supplement_Services('LogSupplementChange', SupplRec, 'Deleted', EntryUser)
Response = True$
end else
Error_Services('Add', 'Error deleting Supplement record.')
end
Next SupplID
end else
Error_Services('Add', 'Record does not exist.')
end
end else
Error_Services('Add', 'SupplID was missing in the ' : Service : ' service.')
end
end service
//----------------------------------------------------------------------------------------------------------------------
// GetStagesForLot
//
// LotType - [Required]
// LotID - [Required]
//
// Returns an array list of valid stages for validation.
//
//----------------------------------------------------------------------------------------------------------------------
Service GetStagesForLot(LotType=LOTTYPES, LotID)
If ( (LotType NE '') and (LotID NE '') ) then
Stages = ''
Begin Case
Case LotType EQ 'WO_MAT'
WOMatKey = LotID
Case LotType EQ 'RDS'
RDSRow = Database_Services('ReadDataRow', 'RDS', LotID)
WOMatKey = Xlate('RDS', LotID, 'WO_MAT_KEY', 'X')
End Case
SigProf = Signature_Services('GetSigProfile', WOMatKey, False$, LotID)
Stages = SigProf<1>
Response = Supplement_Services('TranslateStages', Stages)
End else
Error_Services('Add', 'LotType or LotID was missing in the ' : Service : ' service.')
Response = False$
end
end service
//----------------------------------------------------------------------------------------------------------------------
// TranslateStages
//
// ValidStages - Required]
//
// Returns an array of internal and external stages for a lot. <1> = internal, <2> = external.
//
//----------------------------------------------------------------------------------------------------------------------
Service TranslateStages(ValidStages)
If ( (ValidStages NE '') and (ValidStages NE False$) and ( Error_Services('NoError') ) ) then
ValidStageArray = ''
ValidStageArray<1> = ValidStages
AllStages = XLATE('SYSREPOSPOPUPS','LSL2**SIG_PROF_KEYS',8,'X')
Swap @VM with @FM in AllStages
Swap @SVM with @VM in AllStages
FlipAllStages = SRP_Array('Rotate', AllStages)
StageCount = DCount(ValidStages, @VM)
For each Stage in ValidStages using @VM setting ValidPOS
Locate Stage in FlipAllStages<1> using @VM setting AllPOS then
ValidStageArray<2,ValidPOS> = FlipAllStages<2,AllPOS>
end
Next Stage
Response = ValidStageArray
End else
Error_Services('Add', 'ValidStages was missing in the ' : Service : ' service.')
Response = FALSE$
end
end service
//----------------------------------------------------------------------------------------------------------------------
// AcknowledgeSupplement
//
// SupplID - [Required]
// EntryUser - [Required]
//
// Acknowledge an existing Supplement.
//
//----------------------------------------------------------------------------------------------------------------------
Service AcknowledgeSupplement(SupplID, EntryUser)
If ( (SupplID NE '') and (EntryUser NE '') ) then
OldRec = Xlate('SUPPLEMENTS', SupplID, '', 'X', '')
If OldRec NE '' then
NewRec = OldRec
NewRec<SUPPLEMENTS_SUPPL_ACK$> = True$
NewRec<SUPPLEMENTS_ACK_USER$> = EntryUser
NewRec<SUPPLEMENTS_ACK_DTM$> = Datetime()
Database_Services('WriteDataRow', 'SUPPLEMENTS', SupplID, NewRec, True$, False$, False$)
If Error_Services('NoError') then
Response = SupplID
Supplement_Services('LogSupplementChange', NewRec, 'Acknowledged', EntryUser)
end else
Response = FALSE$
Error_Services('Add', 'Error editing Supplement record.')
end
end else
Response = FALSE$
Error_Services('Add', 'Record does not exist.')
end
end else
Response = FALSE$
Error_Services('Add', 'SupplID or EntryUser was missing in the ' : Service : ' service.')
end
end service
//----------------------------------------------------------------------------------------------------------------------
// UnacknowledgedSupplementCheck
//
// LotType - [Required]
// LotID - [Required]
// Stage = [Required]
//
// Returns true or false for whether or not there are unacknowledged supplements remaining for a stage.
//
//----------------------------------------------------------------------------------------------------------------------
Service UnacknowledgedSupplementCheck(LotType=LOTTYPES, LotID, Stage=STAGES)
UnackList = ''
Response = False$
If ( (LotType NE '') and (LotID NE '') and (Stage NE '') ) then
KeyList = ''
Query = ''
Query<1> = 'LOT_TYPE' : @VM : LotType
Query<2> = 'LOT_ID' : @VM : LotID
Query<3> = 'STAGE' : @VM : Stage : @FM
Flag = ''
Open 'DICT.SUPPLEMENTS' to hDict then
Btree.Extract(Query, 'SUPPLEMENTS', hDict, KeyList, 'E', Flag)
If (Flag EQ 0) then
If KeyList NE '' then
Open 'SUPPLEMENTS' to hTable then
For each Key in KeyList using @VM setting vPos
AckField = Xlate('SUPPLEMENTS', Key, 'SUPPL_ACK', 'X', '')
If AckField NE True$ then UnackList<-1> = Key
Next Key
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS table.')
end
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error calling Btree.Extract')
end
end else
Error_Services('Add', 'Error in ':Service:' service. Error opening SUPPLEMENTS dictionary.')
end
end else
Error_Services('Add', 'LotType, LotID, or Stage was missing in the ' : Service : ' service.')
end
If UnackList NE '' then Response = UnackList
end service
//----------------------------------------------------------------------------------------------------------------------
// LogSupplementChange
//
// SupplementRec - [Required]
// EditEvent - [Required]
// EntryUser - [Required]
//
// Creates a comment in the lot record logging changes to supplements.
//
//----------------------------------------------------------------------------------------------------------------------
Service LogSupplementChange(SupplementRec, EditEvent, EntryUser)
If ( (SupplementRec NE '') and (EditEvent NE '') and (EntryUser NE '') ) then
SupplementText = SupplementRec<SUPPLEMENTS_SUPPL_TEXT$>
LotType = SupplementRec<SUPPLEMENTS_LOT_TYPE$>
LotID = SupplementRec<SUPPLEMENTS_LOT_ID$>
Stage = SupplementRec<SUPPLEMENTS_STAGE$>
LogComment = Stage : ' Supplement ' : Quote(SupplementText) : ' for ' : LotType : ': ': LotID : ' has been ' : EditEvent : ' by User: ' : EntryUser
Begin Case
Case LotType EQ 'RDS'
Rds_Services('AddComment', LotID, LogComment)
Supplement_Services('FileLogSuccessfulSupp', LogComment, EntryUser, EditEvent)
End Case
end else
Error_Services('Add', 'LotType, LotID, or Stage was missing in the ' : Service : ' service.')
end
end service
//----------------------------------------------------------------------------------------------------------------------
// FileLogSuccessfulSupp
//
// LogText- [Required]
// EntryUser - [Required]
//
// Creates a comment in the lot record logging changes to supplements.
//
//----------------------------------------------------------------------------------------------------------------------
Service FileLogSuccessfulSupp(LogText, EntryUser, EditEvent)
LogPath = Environment_Services('GetApplicationRootPath') : '\LogFiles\Supplements'
LogDate = Oconv(Date(), 'D4/')
LogTime = Oconv(Time(), 'MTS')
LogFileName = LogDate[7, 4] : '-' : LogDate[1, 2] : '-' : LogDate[4, 2] : ' Supplement Changes.csv'
Headers = 'Logging DTM' : @FM : 'User' :@FM: 'Event' : @FM : 'Notes'
objLog = Logging_Services('NewLog', LogPath, LogFileName, CRLF$, Comma$, Headers, '', False$, False$)
LoggingDTM = LogDate : ' ' : LogTime ; // Logging DTM
LogData = LoggingDTM :@VM: EntryUser :@VM: EditEvent :@VM: LogText
Logging_Services('AppendLog', objLog, LogData, @FM, @VM)
end service
Service SendNotifications(RDSList, EditEvent, Instructions, EntryUser)
Response = True$
ErrorMsg = ''
If RowExists('RDS', RDSList) then
Begin Case
Case ( (EditEvent _EQC 'Created') or (EditEvent _EQC 'Edited') )
PSN = Xlate('RDS', RDSList<1>, RDS_PROD_SPEC_ID$, 'X')
WoNo = Xlate('RDS', RDSList<1>, RDS_WO$, 'X')
ReactorNo = Xlate('RDS', RDSList<1>, RDS_REACTOR$, 'X');
Message = 'This Supplement was created or updated by ':OConv( EntryUser, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OConv( Date(), 'D2/' ):' at ':OConv( Time(), 'MTH' ):'.' : CRLF$
Message := 'WO# : ' : WoNo : CRLF$
Message := 'PSN : ' : PSN : CRLF$
Message := 'Reactor No : ' : ReactorNo : CRLF$
Message := CRLF$
Message := 'RDS #s : ' : CRLF$
For each RDSNo in RDSList using @FM
Message := RDSNo : ' - ': Instructions :CRLF$
Next RDSNo
Recipients = XLATE('NOTIFICATION','SUPPLEMENTS',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'New or Updated Supplement Created for WO# ': WoNo
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
Parms = Recipients:@RM:SendFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',Parms)
Case (EditEvent _EQC 'Deleted')
PSN = XLATE('RDS', RDSList<1>, RDS_PROD_SPEC_ID$, 'X')
WoNo = XLATE('RDS', RDSList<1>, RDS_WO$, 'X')
ReactorNo = XLATE('RDS', RDSList<1>, RDS_REACTOR$, 'X');
Message = 'This Supplement was removed by ':OConv( EntryUser, '[XLATE_CONV,LSL_USERS*FIRST_LAST]' ):' on ':OConv( Date(), 'D2/' ):' at ':OConv( Time(), 'MTH' ):'.' : CRLF$
Message := 'WO# : ' : WoNo : CRLF$
Message := 'PSN : ' : PSN : CRLF$
Message := 'Reactor No : ' : ReactorNo : CRLF$
Message := CRLF$
Message := 'RDS #s : ' : CRLF$
For each RDSNo in RDSList using @FM
Message := RDSNo :CRLF$
Next RDSNo
Recipients = XLATE('NOTIFICATION','SUPPLEMENTS',NOTIFICATION_USER_ID$,'X')
SendFrom = 'System'
Subject = 'Supplement Removed for WO# ': WoNo
AttachWindow = ''
AttachKey = ''
SendToGroup = ''
Parms = Recipients:@RM:SendFrom:@RM:Subject:@RM:Message:@RM:AttachWindow:@RM:AttachKey:@RM:SendToGroup
obj_Notes('Create',Parms)
Case Otherwise$
ErrorMsg = 'Error in ':Service:' service. Invalid EditEvent "':EditEvent:'" passed in.'
End Case
end else
ErrorMsg = 'Error in ':Service:' service. Invalid RDS record passed in.'
end
If ErrorMsg NE '' then
Error_Services('Add', ErrorMsg)
Response = False$
end
end service