553 lines
17 KiB
Plaintext
553 lines
17 KiB
Plaintext
COMPILE FUNCTION obj_PM_Spec(Method,Parms)
|
|
/*
|
|
Methods for PM_SPEC table
|
|
|
|
8/29/2016 JCH - Initial Coding
|
|
|
|
Properties:
|
|
|
|
Methods:
|
|
|
|
AllPMKeys ;* Returns all PM keys in descending date order
|
|
SendReminders ;* Send Notes reminding of calibrations coming due
|
|
*/
|
|
|
|
DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, Dialog_Box, Popup, NextKey, Database_Services, Datetime, SRP_Datetime
|
|
DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, RList, obj_Notes, ErrMsg, Btree.Extract, Database_Services
|
|
|
|
$INSERT LOGICAL
|
|
$INSERT MSG_EQUATES
|
|
$INSERT PM_SPEC_EQUATES
|
|
$INSERT PM_EQUATES
|
|
$INSERT RLIST_EQUATES
|
|
$INSERT NOTIFICATION_EQU
|
|
$INSERT CALIB_LIST_EQUATES
|
|
$INSERT TOOL_EQUATES
|
|
|
|
EQU PDISPLAY$ TO 8 ;* From Popup_Equates
|
|
|
|
EQU CRLF$ TO \0D0A\
|
|
|
|
ErrCode = ''
|
|
ErrorMsg = ''
|
|
ErrTitle = 'Error in Stored Procedure "obj_PM_Spec"'
|
|
|
|
|
|
IF NOT(ASSIGNED(Method)) THEN ErrorMsg = 'Unassigned parameter "Method" passed to subroutine'
|
|
IF NOT(ASSIGNED(Parms)) THEN Parms = ''
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
|
RETURN ''
|
|
END
|
|
|
|
Result = ''
|
|
|
|
BEGIN CASE
|
|
CASE Method = 'SchedStart' ; GOSUB SchedStart
|
|
CASE Method = 'EarlyStart' ; GOSUB EarlyStart
|
|
CASE Method = 'LateStart' ; GOSUB LateStart
|
|
CASE Method = 'SchedNewPM' ; GOSUB SchedNewPM
|
|
CASE Method = 'SendReminders' ; GOSUB SendReminders
|
|
CASE Method = 'GetHistory' ; GOSUB GetHistory
|
|
CASE Method = 'LastPMCompDTM' ; GOSUB LastPMCompDTM
|
|
|
|
CASE 1
|
|
|
|
END CASE
|
|
|
|
IF ErrorMsg NE '' THEN
|
|
Set_Status(-1,ErrTitle:@SVM:ErrorMsg)
|
|
RETURN ''
|
|
END
|
|
|
|
RETURN Result
|
|
|
|
* * * * * * *
|
|
SchedStart:
|
|
* * * * * * *
|
|
|
|
PMSpecKey = Parms[1,@RM]
|
|
PMSpecRec = Parms[COL2()+1,@RM]
|
|
|
|
IF PMSpecKey = '' THEN RETURN
|
|
|
|
IF PMSpecRec = '' THEN
|
|
PMSpecRec = XLATE('PM_SPEC',PMSpecKey,'','X')
|
|
IF PMSpecRec = '' THEN
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
SchedUnits = PMSpecRec<PM_SPEC_UNITS$>
|
|
PMKeys = PMSpecRec<PM_SPEC_PM_KEYS$>
|
|
pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '')
|
|
|
|
FOR I = 1 TO pmCnt
|
|
PMKey = PMKeys<1,I>
|
|
PMRec = XLATE('PM',PMKey,'','X')
|
|
SchedStart = ''
|
|
|
|
IF SchedUnits = 'D' OR SchedUnits = 'M' THEN
|
|
SchedStart = OCONV(PMRec<PM_SCHED_DT$>,'D')
|
|
END
|
|
|
|
IF SchedUnits = 'T' THEN
|
|
ThisSchedTime = OCONV(PMRec<PM_SCHED_TM$>,'MT')
|
|
if ThisSchedTime = '' then ThisSchedTime = '00:00'
|
|
SchedStart = OCONV(PMRec<PM_SCHED_DT$>,'D4'):' ':ThisSchedTime
|
|
END
|
|
|
|
IF SchedUnits = 'Q' THEN
|
|
SchedStart = PMRec<PM_SCHED_QTY$>
|
|
END
|
|
|
|
Result<1,I> = SchedStart
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
EarlyStart:
|
|
* * * * * * *
|
|
|
|
PMSpecKey = Parms[1,@RM]
|
|
PMSpecRec = Parms[COL2()+1,@RM]
|
|
|
|
IF PMSpecKey = '' THEN RETURN
|
|
|
|
IF PMSpecRec = '' THEN
|
|
PMSpecRec = XLATE('PM_SPEC',PMSpecKey,'','X')
|
|
IF PMSpecRec = '' THEN
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
SchedUnits = PMSpecRec<PM_SPEC_UNITS$>
|
|
PMKeys = PMSpecRec<PM_SPEC_PM_KEYS$>
|
|
pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '')
|
|
Delta = PMSpecRec<PM_SPEC_EARLY_START_DELTA$> ;*
|
|
|
|
FOR I = 1 TO pmCnt
|
|
PMKey = PMKeys<1,I>
|
|
PMRec = XLATE('PM',PMKey,'','X')
|
|
EarlyStart = ''
|
|
|
|
IF SchedUnits = 'D' THEN
|
|
EarlyStart = OCONV(PMRec<PM_SCHED_DT$> - Delta ,'D')
|
|
END
|
|
|
|
If SchedUnits = 'M' then
|
|
EarlyStart = OConv(SRP_Datetime('AddMonths', PMRec<PM_SCHED_DT$>, (-Delta)), 'D')
|
|
end
|
|
|
|
IF SchedUnits = 'T' THEN
|
|
Delta = ( Delta/24 ) ;* Convert hours to decimal part of day
|
|
SchedTM = ( PMRec<PM_SCHED_TM$> / 86400 ) ;* Sec (since midnight ) * Sec/Day => decimal part of day
|
|
EarlyStart = OCONV( PMRec<PM_SCHED_DT$> + ( SchedTm - Delta ) , 'DT' )
|
|
END
|
|
|
|
IF SchedUnits = 'Q' THEN
|
|
EarlyStart = PMRec<PM_SCHED_QTY$> - Delta
|
|
END
|
|
|
|
Result<1,I> = EarlyStart
|
|
NEXT I
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LateStart:
|
|
* * * * * * *
|
|
|
|
PMSpecKey = Parms[1,@RM]
|
|
PMSpecRec = Parms[COL2()+1,@RM]
|
|
|
|
IF PMSpecKey = '' THEN RETURN
|
|
|
|
IF PMSpecRec = '' THEN
|
|
PMSpecRec = XLATE('PM_SPEC',PMSpecKey,'','X')
|
|
IF PMSpecRec = '' THEN
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
SchedUnits = PMSpecRec<PM_SPEC_UNITS$>
|
|
PMKeys = PMSpecRec<PM_SPEC_PM_KEYS$>
|
|
pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '')
|
|
Delta = PMSpecRec<PM_SPEC_LATE_START_DELTA$> ;*
|
|
|
|
FOR I = 1 TO pmCnt
|
|
PMKey = PMKeys<1,I>
|
|
PMRec = XLATE('PM',PMKey,'','X')
|
|
Start = ''
|
|
|
|
IF SchedUnits = 'D' THEN
|
|
Start = OCONV(PMRec<PM_SCHED_DT$> + Delta ,'D')
|
|
END
|
|
|
|
If SchedUnits = 'M' then
|
|
Start = OConv(SRP_Datetime('AddMonths', PMRec<PM_SCHED_DT$>, (Delta)), 'D')
|
|
end
|
|
|
|
IF SchedUnits = 'T' THEN
|
|
Delta = ( Delta/24 ) ;* Convert hours to decimal part of day
|
|
SchedTM = ( PMRec<PM_SCHED_TM$> / 86400 ) ;* Sec (since midnight ) * Sec/Day => decimal part of day
|
|
Start = OCONV( PMRec<PM_SCHED_DT$> + ( SchedTm + Delta ) , 'DT' )
|
|
END
|
|
|
|
IF SchedUnits = 'Q' THEN
|
|
Start = PMRec<PM_SCHED_QTY$> + Delta
|
|
END
|
|
|
|
Result<1,I> = Start
|
|
NEXT I
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
SchedNewPM:
|
|
* * * * * * *
|
|
|
|
PMSID = Parms[1,@RM]
|
|
StartDt = Parms[COL2()+1,@RM] ;* Comp Date
|
|
StartTm = Parms[COL2()+1,@RM] ;* Comp Time
|
|
StartQty = Parms[COL2()+1,@RM] ;* Tool Cycle Count @ Completion of PM
|
|
PMNo = Parms[COL2()+1,@RM] ;* Last PM complete
|
|
|
|
Swap ',' with '' in PMSID
|
|
Swap ',' with '' in PMNo
|
|
|
|
PMSpecRec = Database_Services('ReadDataRow', 'PM_SPEC', PMSID)
|
|
|
|
ToolID = Xlate('PM_SPEC', PMSID, 'TOOL_ID', 'X')
|
|
ToolMode = Xlate('TOOL', ToolID, 'CURR_MODE', 'X')
|
|
If ToolMode NE 'OUT' then
|
|
|
|
IF PMSID = '' THEN ErrorMsg = 'Null Parameter "PMSID" passed to routine. (':Method:')'
|
|
IF StartDt = '' THEN ErrorMsg = 'Null Parameter "StartDt" passed to routine. (':Method:')'
|
|
|
|
IF ErrorMsg NE '' THEN RETURN
|
|
|
|
thisStartDt = ICONV(StartDt,'D')
|
|
|
|
IF thisStartDt = '' THEN
|
|
ErrorMsg = 'Invalid parameter StartDt ':QUOTE(StartDt):' passed to routine. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
|
|
thisStartQty = ICONV(StartQty,'MD0')
|
|
|
|
IF thisStartQty = '' THEN
|
|
ErrorMsg = 'Invalid parameter StartQty ':QUOTE(StartQty):' passed to routine. (':Method:')'
|
|
RETURN
|
|
|
|
END
|
|
|
|
Units = PMSpecRec<PM_SPEC_UNITS$>
|
|
|
|
IF Units = 'T' THEN
|
|
|
|
IF StartTm = '' THEN
|
|
ErrorMsg = 'Null Parameter "StartDt" passed to routine. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
thisStartTm = ICONV(StartTm,'MT')
|
|
IF thisStartTm = '' THEN
|
|
ErrorMsg = 'Invalid parameter StartTm ':QUOTE(StartTm):' passed to routine. (':Method:')'
|
|
RETURN
|
|
END
|
|
END
|
|
|
|
|
|
SchedDt = ''
|
|
SchedTm = ''
|
|
SchedQty = ''
|
|
|
|
Interval = PMSpecRec<PM_SPEC_INTERVAL$>
|
|
|
|
BEGIN CASE
|
|
CASE Units = 'D'
|
|
SchedDt = thisStartDt + PMSpecRec<PM_SPEC_INTERVAL$> ;* Interval is in days
|
|
|
|
Case Units = 'M'
|
|
SchedDt = SRP_Datetime('AddMonths', thisStartDt, PMSpecRec<PM_SPEC_INTERVAL$>)
|
|
|
|
CASE Units = 'T'
|
|
Interval = PMSpecRec<PM_SPEC_INTERVAL$> ;* Interval is in hours
|
|
Interval = ( Interval/24 ) ;* Convert hours to decimal part of day
|
|
EarlyStartDelta = (PMSpecRec<PM_SPEC_EARLY_START_DELTA$> / 24) ;* Convert hours to decimal part of day
|
|
PrevSchedDt = Xlate('PM', PMNo, 'SCHED_DT', 'X')
|
|
PrevSchedTm = Xlate('PM', PMNo, 'SCHED_TM', 'X')
|
|
PrevSchedTm = ( PrevSchedTM / 86400 ) ;* Sec (since midnight ) * Sec/Day => decimal part of day
|
|
PrevSchedDTM = PrevSchedDt + PrevSchedTm
|
|
IF PrevSchedTm EQ 0 then
|
|
//Condition for midnight
|
|
SchedDTM = (thisStartDt + 1) + ( PrevSchedTm + Interval )
|
|
end else
|
|
SchedDTM = thisStartDt + ( PrevSchedTm + Interval )
|
|
end
|
|
|
|
SchedDiff = SchedDTM - EarlyStartDelta - Datetime()
|
|
If SchedDiff GT Interval then
|
|
// This is too far out
|
|
SchedDTM = thisStartDt + PrevSchedTm
|
|
end
|
|
If SchedDTM LT PrevSchedDTM then SchedDTM = PrevSchedDTM
|
|
CurrDtm = Datetime()
|
|
If SchedDTM LE CurrDtm then
|
|
Loop
|
|
Until SchedDTM GE CurrDtm
|
|
SchedDtm += Interval
|
|
Repeat
|
|
end
|
|
SchedDTM = OCONV(SchedDTM, 'DT/^S')
|
|
SchedDt = SchedDTM[1,' ']
|
|
SchedTm = SchedDTM[COL2()+1,' ']
|
|
SchedDt = ICONV(SchedDt,'D')
|
|
SchedTm = ICONV(SchedTm,'MT')
|
|
|
|
CASE Units = 'Q'
|
|
// Run-based PM
|
|
SchedQty = Interval + thisStartQty
|
|
|
|
CASE 1
|
|
* Missing Units
|
|
RETURN
|
|
END CASE
|
|
|
|
CurrDTM = OCONV(Date(),'D4/'):' ':OCONV(Time(),'MTH')
|
|
CurrDTM = ICONV(CurrDTM,'DT')
|
|
|
|
If ( (PMSId EQ 653) or (PMSId EQ 654) ) then
|
|
PMResult = Xlate('PM', PMNo, 'PASS_FAIL', 'X')
|
|
If PMResult EQ 'Pass' then
|
|
// Schedule time-based PM four days from now.
|
|
PMSId = 654 ;* Key to time-based PM_SPEC template
|
|
PMNo = NextKey('PM') ;* Next PMKey
|
|
PMRec = ''
|
|
PMRec<PM_PMS_ID$> = PMSId ;* New PMRec
|
|
PMrec<PM_ENTER_BY$> = 'AUTO' ;* Automated process user
|
|
PMRec<PM_ENTER_DTM$> = CurrDTM
|
|
PMRec<PM_SCHED_DT$> = Date() + 4
|
|
PMRec<PM_SCHED_TM$> = Time()
|
|
PMRec<PM_SCHED_QTY$> = ''
|
|
end else
|
|
// Reset cycle counter and schedule another PM with the same interval.
|
|
ToolRec = Database_Services('ReadDataRow', 'TOOL', ToolID)
|
|
ToolRec<TOOL_CYCLE_CNT$> = 0
|
|
Database_Services('WriteDataRow', 'TOOL', ToolID, ToolRec, True$, False$, True$)
|
|
PMSId = 653 ;* Key to run-based PM_SPEC template
|
|
PMSInterval = Xlate('PM_SPEC', PMSId, 'INTERVAL', 'X')
|
|
PMNo = NextKey('PM') ;* Next PMKey
|
|
PMRec = ''
|
|
PMRec<PM_PMS_ID$> = PMSId ;* New PMRec
|
|
PMrec<PM_ENTER_BY$> = 'AUTO' ;* Automated process user
|
|
PMRec<PM_ENTER_DTM$> = CurrDTM
|
|
PMRec<PM_SCHED_DT$> = PMSInterval
|
|
PMRec<PM_SCHED_TM$> = PMSInterval
|
|
PMRec<PM_SCHED_QTY$> = PMSInterval
|
|
end
|
|
end else
|
|
PMNo = NextKey('PM') ;* Next PMKey
|
|
PMRec = ''
|
|
PMRec<PM_PMS_ID$> = PMSId ;* New PMRec
|
|
PMrec<PM_ENTER_BY$> = 'AUTO' ;* Automated process user
|
|
PMRec<PM_ENTER_DTM$> = CurrDTM
|
|
PMRec<PM_SCHED_DT$> = SchedDt
|
|
PMRec<PM_SCHED_TM$> = SchedTm
|
|
PMRec<PM_SCHED_QTY$> = OCONV(SchedQty,'MD0')
|
|
end
|
|
|
|
otParms = 'PM':@RM:PMNo:@RM:@RM:PMRec
|
|
obj_Tables('WriteRec',otParms) ;* Write new PM record
|
|
|
|
IF Get_Status(errCode) THEN
|
|
ErrMsg(errCode)
|
|
RETURN
|
|
END
|
|
end
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
GetHistory:
|
|
* * * * * * *
|
|
|
|
PMSId = Parms[1,@RM]
|
|
|
|
IF PMSId = '' THEN RETURN
|
|
|
|
OPEN 'DICT.PM' TO DictVar ELSE
|
|
ErrorMsg = 'Unable to open DICT.PM for index lookup'
|
|
RETURN
|
|
END
|
|
|
|
Search = ''
|
|
|
|
IF PMSID NE '' THEN Search := 'PMS_ID':@VM:PMSId:@FM
|
|
|
|
Option = ''
|
|
Flag = ''
|
|
PMKeys = ''
|
|
|
|
Btree.Extract(Search, 'PM', DictVar, PMKeys, Option, Flag) ;* Get unsorted keys based on Search parameters
|
|
|
|
* Put sort data in first column (Install DTM)
|
|
|
|
WorkList = ''
|
|
pmCnt = COUNT(PMKeys,@VM) + (PMKeys NE '')
|
|
FOR I = 1 TO pmCnt
|
|
PMKey = PMKeys<1,I>
|
|
WorkList<I> = XLATE('PM',PMKey,PM_COMP_DTM$,'X'):@VM:pmKey
|
|
NEXT I
|
|
|
|
WorkList := @RM
|
|
|
|
CONVERT @FM:@VM TO @RM:@FM IN WorkList ;* push delimiters higher for V119
|
|
CALL V119('S','','D','R',WorkList,'') ;* Descending Left justified sort
|
|
CONVERT @FM:@RM TO @VM:@FM IN WorkList ;* pull delimiters lower
|
|
WorkList[-1,1] = '' ;* Trim trailing delimiter
|
|
|
|
FOR I = 1 TO pmCnt
|
|
Result<1,I> = WorkList<I,2> ;* Strip Sort column(s)
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
LastPMCompDTM:
|
|
* * * * * * *
|
|
|
|
GOSUB GetHistory
|
|
HistKeys = FIELD(Result,@VM,1,20)
|
|
Result = ''
|
|
|
|
LOOP
|
|
PMNo = HistKeys[1,@VM]
|
|
HistKeys[1,COL2()] = ''
|
|
CompDTM = XLATE('PM',PMNo,PM_COMP_DTM$,'X')
|
|
UNTIL CompDTM NE '' OR HistKeys = ''
|
|
|
|
REPEAT
|
|
|
|
Result = CompDTM
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
SendReminders:
|
|
* * * * * * *
|
|
|
|
RETURN ;* Update for PM_SPEC table JCH
|
|
|
|
OPEN 'PM_SPEC' TO FileIn ELSE
|
|
ErrorMsg = 'Unable to open "PM_SPEC" table. (':Method:')'
|
|
RETURN
|
|
END
|
|
|
|
|
|
CheckDt = OCONV(Date()+15,'D4/')
|
|
SelectSent = 'SELECT CALIB_LIST WITH NEXT_CAL_DT < ':QUOTE(CheckDt):' BY NEXT_CAL_DT'
|
|
|
|
RList(SelectSent,TARGET_ACTIVELIST$,'','','')
|
|
|
|
NoteText = ''
|
|
Depts = ''
|
|
|
|
Done = 0
|
|
LOOP
|
|
READNEXT CLNo ELSE Done = 1
|
|
UNTIL Done
|
|
READ CLRec FROM FileIn,CLNo THEN
|
|
|
|
NextCalDt = OCONV(XLATE('CALIB_LIST',CLNo,'NEXT_CAL_DT','X'),'D4/')
|
|
|
|
IF NextCalDt NE '' THEN
|
|
|
|
CLType = CLRec<CALIB_LIST_CL_TYPE$>
|
|
Dept = CLRec<CALIB_LIST_DEPT$>
|
|
IF Dept = '' THEN Dept = 'MET'
|
|
|
|
IF CLType = 'E' THEN
|
|
Desc = CLRec<CALIB_LIST_EQ_DESC$>
|
|
SN = CLRec<CALIB_LIST_EQ_SN$>
|
|
Loc = CLRec<CALIB_LIST_EQ_LOC$
|
|
NewLine = Desc:' (S/N: ':SN:') located in the ':Loc:' is due for calibration on ':NextCalDt:CRLF$
|
|
END
|
|
IF CLType = 'S' THEN
|
|
Desc = CLRec<CALIB_LIST_STD_DESC$>
|
|
SN = CLRec<CALIB_LIST_STD_SN$>
|
|
Loc = CLRec<CALIB_LIST_STD_LOC$>
|
|
NewLine = 'The NIST Standard ':Desc:' (S/N: ':SN:') located in the ':Loc:' is due for calibration on ':NextCalDt:CRLF$
|
|
END
|
|
|
|
LOCATE Dept IN Depts USING @FM SETTING Pos ELSE
|
|
Depts = INSERT(Depts,Pos,0,0,Dept)
|
|
END
|
|
NoteText<Pos> = NoteText<Pos>:NewLine
|
|
|
|
END ;* End of check for NextCalDt
|
|
END ;* End of CLRec read
|
|
REPEAT
|
|
|
|
DeptUsers = ''
|
|
DeptDescs =''
|
|
|
|
PopupLiteral = XLATE('SYSREPOSPOPUPS',@APPID<1>:'**DEPT',PDISPLAY$,'X')
|
|
|
|
CONVERT @VM:@SVM TO @FM:@VM IN PopupLiteral
|
|
|
|
LiteralCnt = COUNT(PopupLiteral,@FM) + (PopupLiteral NE '')
|
|
|
|
FOR I = 1 TO LiteralCnt
|
|
Dept = PopupLiteral<I,1>
|
|
DeptDesc = PopupLiteral<I,2>
|
|
UserNames = PopupLiteral<I,3>
|
|
LOCATE Dept IN Depts USING @FM SETTING Pos THEN
|
|
CONVERT ' ' TO '' IN UserNames
|
|
CONVERT ',' TO @VM IN UserNames
|
|
DeptUsers<Pos> = UserNames
|
|
DeptDescs<Pos> = DeptDesc
|
|
END
|
|
NEXT I
|
|
|
|
NoteSubject = "Equipment Calibration Reminder"
|
|
|
|
DeptCnt = COUNT(Depts,@FM) + (Depts NE '')
|
|
|
|
FOR I = 1 TO DeptCnt
|
|
|
|
IF NoteText<I> NE '' THEN
|
|
Recipients = DeptUsers<I>
|
|
|
|
LOCATE @USER4 IN Recipients SETTING Dummy THEN
|
|
Recipient = @USER4
|
|
SentFrom = 'System'
|
|
Subject = DeptDescs<I>:" Department - Equipment Calibration Reminder"
|
|
Message = NoteText<I>
|
|
AttachWindow = 'MASTER_CALIB_LIST'
|
|
AttachKeys = ''
|
|
SendToGroup = ''
|
|
|
|
Obj_Notes('Create',Recipient:@RM:'System':@RM:NoteSubject:@RM:NoteText<I>:@RM:'MASTER_CALIB_LIST')
|
|
END
|
|
END
|
|
|
|
NEXT I
|
|
|
|
RETURN
|
|
|
|
|
|
|
|
|
|
|