653 lines
14 KiB
Plaintext
653 lines
14 KiB
Plaintext
COMPILE SUBROUTINE Print_Reactor_Maint1(Dummy)
|
|
|
|
/*
|
|
Print Reactor Maint Report
|
|
12/18/2006 - John C. Henry, J.C. Henry & Co., Inc. - Initial coding
|
|
*/
|
|
|
|
|
|
DECLARE SUBROUTINE Utility, ErrMsg, Set_Status, Set_Printer, RList
|
|
DECLARE FUNCTION Set_Printer, Get_Printer, Msg, Get_Status, Printer_Select, obj_Install, Dialog_Box
|
|
|
|
$INSERT OIPRINT_EQUATES
|
|
$INSERT INVOICE_EQU
|
|
$INSERT APPCOLORS
|
|
$INSERT MSG_EQUATES
|
|
|
|
|
|
EQU TAB$ TO \09\
|
|
EQU TARGET_ACTIVELIST$ TO 5
|
|
|
|
ErrorTitle = 'Error in stored procedure Print_Reactor_Maint'
|
|
|
|
OPEN 'REACTOR_LOG' TO ReactLogTable ELSE
|
|
ErrorMsg = 'Unable to open "REACTOR_LOG" table.'
|
|
ErrMsg(ErrorTitle:@SVM:ErrorMsg)
|
|
RETURN
|
|
END
|
|
|
|
OPEN 'DICT.REACTOR_LOG' TO @DICT ELSE
|
|
ErrorMsg = 'Unable to open "DICT.Reactor_LOG" table.'
|
|
ErrMsg(ErrorTitle:@SVM:ErrorMsg)
|
|
RETURN
|
|
END
|
|
|
|
|
|
Params = Dialog_Box( 'REACTOR_LOG_SRPT1', @WINDOW, '*CENTER' )
|
|
|
|
IF Params = 'CANCEL' OR Params = '' THEN
|
|
RETURN
|
|
END
|
|
|
|
|
|
CONVERT '*' TO @FM IN Params
|
|
|
|
StartDateFrom = Params<1>
|
|
StartDateThru = Params<2>
|
|
Reactors = Params<3>
|
|
ProblemCats = Params<4>
|
|
ServiceIDs = Params<5>
|
|
|
|
WithStmt = ''
|
|
|
|
IF StartDateFrom AND StartDateThru THEN
|
|
WithStmt:= 'WITH START_DATE FROM "':StartDateFrom:'" TO "':StartDateThru:'"'
|
|
END ELSE
|
|
IF StartDateFrom THEN
|
|
WithStmt := 'WITH START_DATE >= "':StartDateFrom:'"'
|
|
END
|
|
IF StartDateThru THEN
|
|
WithStmt := 'WITH START_DATE <= "':StartDateThru:'"'
|
|
END
|
|
END
|
|
|
|
IF Reactors <> '' THEN
|
|
SWAP @VM WITH "' '" IN Reactors
|
|
Reactors = "'":Reactors:"'"
|
|
WithStmt :=' AND WITH REACTOR = ':Reactors
|
|
END
|
|
|
|
IF ProblemCats <> '' THEN
|
|
SWAP @VM WITH "' '" IN ProblemCats
|
|
ProblemCats = "'":ProblemCats:"'"
|
|
WithStmt :=' AND WITH REACT_PROB_CAT_ID = ':ProblemCats
|
|
END
|
|
|
|
IF ServiceIDs <> '' THEN
|
|
SWAP @VM WITH "' '" IN ServiceIDs
|
|
ServiceIDs = "'":ServiceIDs:"'"
|
|
WithStmt :=' AND WITH REACT_SERV_ID = ':ServiceIDs
|
|
END
|
|
|
|
IF Reactors <> '' THEN
|
|
SWAP "'" WITH '' IN Reactors
|
|
SWAP " " WITH ", " IN Reactors
|
|
Reactors[-4,4]= " & ":Reactors[-2,2]
|
|
ReactorHeader = "Reactors: ":Reactors
|
|
END ELSE
|
|
ReactorHeader = ''
|
|
END
|
|
|
|
DateRange = "Dates: ":StartDateFrom:" Through ": StartDateThru
|
|
|
|
Utility( 'CURSOR', 'H' )
|
|
|
|
WithStmt = 'SELECT REACTOR_LOG ':WithStmt
|
|
|
|
WithStmt := ' AND WITH CATEGORY = "M" BY REACTOR BY START_DATE'
|
|
|
|
RLIST( WithStmt, TARGET_ACTIVELIST$, '', '', '' )
|
|
|
|
IF Get_Status(errCode) THEN CALL ErrMsg(errCode)
|
|
|
|
IF @Reccount = 0 THEN
|
|
ErrMsg('No records selected with that criteria...')
|
|
RETURN
|
|
END
|
|
|
|
* Start of printing process
|
|
|
|
FileName = 'Print Reactor Maintenance Report'
|
|
Title = 'Printing Reactor Maintenance Report'
|
|
|
|
PageInfo = ''
|
|
PageInfo<1> = '0.50' ;* Left Margin
|
|
PageInfo<2> = '1.00' ;* Top Margin
|
|
PageInfo<3> = '0.50' ;* Right Margin
|
|
PageInfo<4> = '0.75' ;* Bottom Margin
|
|
PageInfo<7> = LETTER ;* Pagesize
|
|
|
|
|
|
PageSetup = '1' ;* Landscape = 1
|
|
PrintSetup = '2' ;* Preview Normal
|
|
PrintPath = Printer_Select()
|
|
|
|
If PrintPath EQ '' then return
|
|
|
|
stat = Set_Printer('INIT',FileName,Title,PageInfo,PageSetup,PrintSetup,PrintPath)
|
|
IF stat < 0 THEN GOTO OIPrintErr
|
|
|
|
|
|
PageHeight = Get_Printer('PAGESIZE')<2>
|
|
MaxPrint = PageHeight - PageInfo<2> - PageInfo<4>
|
|
|
|
Header = "'D'":@VM:obj_Install('Get_Prop','CompTitle'):' Reactor Maintenance Report':@VM:"Page 'P'"
|
|
IF ReactorHeader NE '' THEN
|
|
Header<-1> = ReactorHeader
|
|
END
|
|
Header<-1> = "'T'":@VM:DateRange
|
|
Header<-1> = '' ;* Blank line following heading
|
|
|
|
font = 'Arial'
|
|
font<2> = '10'
|
|
font<4> = '1' ;* Bold
|
|
|
|
stat = Set_Printer('FONTHEADFOOT',font) ; IF stat < 0 THEN GOTO OIPrintErr
|
|
stat = Set_Printer('HEADER',Header) ; IF stat < 0 THEN GOTO OIPrintErr
|
|
|
|
@RECCOUNT= 0
|
|
|
|
FirstPass = 1
|
|
LastRecord = 0
|
|
FirstLine = 1
|
|
|
|
* Make Column Heading
|
|
|
|
colHead = '' ; colFmt = ''
|
|
colHead<1,1> = 'R' ; colFmt<1,1> = '^360'
|
|
colHead<1,2> = 'Problem Cat Desc' ; colFmt<1,2> = '<1800'
|
|
colHead<1,3> = 'Serv':CRLF$:'ID' ; colFmt<1,3> = '^540'
|
|
colHead<1,4> = 'Reactor Svc Desc' ; colFmt<1,4> = '<3600'
|
|
colHead<1,5> = 'Tech' ; colFmt<1,5> = '^1080'
|
|
colHead<1,6> = 'Reactor Item ID' ; colFmt<1,6> = '<2160'
|
|
colHead<1,7> = 'Notes' ; colFmt<1,7> = '<3600'
|
|
colHead<1,8> = 'Start' ; colFmt<1,8> = '^810'
|
|
colHead<1,9> = 'Hrs' ; colFmt<1,9> = '>720'
|
|
|
|
* Zero Accumulators For Each Break
|
|
|
|
Elapsed_Hours.Reactor.Total = 0
|
|
Elapsed_Hours.Reactor.Count = 0
|
|
Elapsed_Hours.Grand.Total = 0
|
|
Elapsed_Hours.Grand.Count = 0
|
|
|
|
* Null Previous Break Buckets
|
|
|
|
Prev.Reactor=''
|
|
Last.Reactor.Break = 1
|
|
|
|
|
|
* * * * * * *
|
|
ReadRecord:
|
|
* * * * * * *
|
|
|
|
* Zero Break Flags To False
|
|
|
|
Reactor.Break = 0
|
|
|
|
READNEXT @ID ELSE
|
|
LastRecord = 1
|
|
Reactor.Break = 1
|
|
Reactor = Prev.Reactor
|
|
END
|
|
|
|
S.ATID = @ID
|
|
|
|
IF FirstPass AND LastRecord THEN
|
|
GOTO Bail
|
|
END
|
|
|
|
IF LastRecord THEN GOTO BREAKS
|
|
|
|
|
|
READO @RECORD FROM ReactLogTable,@ID ELSE
|
|
GOTO ReadRecord
|
|
END
|
|
|
|
@RECCOUNT += 1
|
|
|
|
* CALCULATE VALUE(S) FOR COLUMN(S)
|
|
|
|
S.ATID = {@ID}
|
|
|
|
S.Reactor={REACTOR}
|
|
|
|
S.React_Prob_Cat_Desc = {REACT_PROB_CAT_DESC}
|
|
S.React_Serv_ID = {REACT_SERV_ID}
|
|
S.React_Serv_Desc = {REACT_SERV_DESC}
|
|
S.Tech = {TECH_SIG}
|
|
S.Notes = {NOTES}
|
|
S.StartDTM = OCONV({START_DATE},'D2/'):' ':OCONV({START_TIME},'MTS')
|
|
S.Elapsed_Hours = {ELAPSED_HOURS}
|
|
S.React_Item_IDS = {REACT_ITEM_IDS}
|
|
|
|
SWAP @VM WITH CRLF$ IN S.React_Prob_Cat_Desc
|
|
SWAP @VM WITH CRLF$ IN S.React_Serv_ID
|
|
SWAP @VM WITH CRLF$ IN S.React_Serv_Desc
|
|
SWAP @VM WITH CRLF$ IN S.Notes
|
|
SWAP @VM WITH CRLF$ IN S.React_Item_IDS
|
|
|
|
|
|
* TEST FOR CONTROL BREAK(S)
|
|
|
|
IF (S.Reactor NE Prev.Reactor) OR Reactor.Break THEN
|
|
Reactor = Prev.Reactor
|
|
Prev.Reactor = S.Reactor
|
|
Reactor.Break += 1
|
|
END
|
|
|
|
|
|
IF FirstPass THEN
|
|
FirstPass=0
|
|
GOTO DETAIL
|
|
END
|
|
|
|
* * * * * * *
|
|
BREAKS:
|
|
* * * * * * *
|
|
|
|
* Print Break Total(s) And Accumulate Total(s)
|
|
|
|
IF Reactor.Break THEN
|
|
|
|
colData = Reactor
|
|
colData<1,2> = ''
|
|
colData<1,7> = 'Reactor Subtotal:'
|
|
colData<1,9> = OCONV(Elapsed_Hours.Reactor.Total ,"MD2")
|
|
|
|
GOSUB PrintTable
|
|
|
|
stat = Set_Printer('TEXT','')
|
|
|
|
Elapsed_Hours.Grand.Total += Elapsed_Hours.Reactor.Total
|
|
Elapsed_Hours.Reactor.Total = 0
|
|
Elapsed_Hours.Grand.Count += Elapsed_Hours.Reactor.Count
|
|
Elapsed_Hours.Reactor.Count = 0
|
|
|
|
END
|
|
|
|
* Perform Last Record Output If Done
|
|
|
|
IF LastRecord THEN
|
|
|
|
colData = ""
|
|
colData<1,1> = ''
|
|
colData<1,7> = 'Report Totals:'
|
|
colData<1,9> = OCONV(Elapsed_Hours.Grand.Total ,"MD2")
|
|
|
|
GOSUB PrintTable
|
|
|
|
*status = Set_Printer('TEXT','')
|
|
*status = Set_Printer('TEXT',@RECCOUNT:' Records Processed')
|
|
|
|
|
|
GOTO Bail
|
|
|
|
END
|
|
|
|
* * * * * * *
|
|
DETAIL:
|
|
* * * * * * *
|
|
|
|
|
|
* Accumulate Total(s)
|
|
|
|
|
|
IF NUM(S.Elapsed_Hours) AND S.Elapsed_Hours NE "" THEN
|
|
Elapsed_Hours.Reactor.Total += S.Elapsed_Hours
|
|
Elapsed_Hours.Reactor.Count += 1
|
|
END
|
|
|
|
|
|
* Print Detail Line
|
|
|
|
colData = ""
|
|
colData<1,1> = S.Reactor
|
|
colData<1,2> = S.React_Prob_Cat_Desc
|
|
colData<1,3> = S.React_Serv_ID
|
|
colData<1,4> = S.React_Serv_Desc
|
|
colData<1,5> = S.Tech
|
|
colData<1,6> = S.React_Item_IDS
|
|
colData<1,7> = S.Notes
|
|
colData<1,8> = S.StartDTM
|
|
colData<1,9> = OCONV(S.Elapsed_Hours,'MD2')
|
|
|
|
GOSUB PrintTable
|
|
|
|
|
|
GOTO ReadRecord
|
|
|
|
|
|
* * * * * * *
|
|
Bail:
|
|
* * * * * * *
|
|
|
|
stat = Set_Printer('TERM',1)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * * *
|
|
OIPrintErr:
|
|
* * * * * * *
|
|
|
|
ErrMsg(ErrorTitle:@SVM:ErrorMsg)
|
|
ErrMsg(ErrorTitle:@SVM:'Set_Printer returned errorcode ':stat)
|
|
stat = Set_Printer('TERM',1)
|
|
|
|
RETURN
|
|
|
|
|
|
* * * * * *
|
|
PrintTable:
|
|
* * * * * *
|
|
|
|
|
|
stat = Set_Printer('CALCTABLE',colFmt:@FM:colData)
|
|
TableSize = Get_Printer('CALCTABLE')
|
|
TableHeight = TableSize<2>
|
|
Test = Get_Printer('POS')<2>
|
|
|
|
IF Get_Printer('POS')<2> + TableHeight > MaxPrint OR FirstLine THEN
|
|
IF NOT(FirstLine) THEN
|
|
stat = Set_Printer('PAGEBREAK')
|
|
END
|
|
FirstLine = 0
|
|
font<2> = 8
|
|
font<4> = 1 ;* Bold
|
|
stat = Set_Printer('FONT',font,'100')
|
|
|
|
stat = Set_Printer('ADDTABLE',colFmt,colHead,'',LTGREY$,'',0,TB_ALL)
|
|
|
|
|
|
font<4> = 0
|
|
stat = Set_Printer('FONT',font,fontSpacing)
|
|
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',0,7)
|
|
|
|
END ELSE
|
|
font<2> = 8
|
|
font<4> = 0
|
|
stat = Set_Printer('FONT',font,fontSpacing)
|
|
stat = Set_Printer('ADDTABLE',colFmt,'',colData,LTGREY$,'',1,TB_ALL)
|
|
END
|
|
|
|
|
|
RETURN
|
|
|
|
|
|
/*
|
|
|
|
* ZERO ACCUMULATORS FOR EACH BREAK
|
|
|
|
Elapsed_Hours.Reactor.Total=0
|
|
Elapsed_Hours.Reactor.Count=0
|
|
Elapsed_Hours.Grand.Total=0
|
|
Elapsed_Hours.Grand.Count=0
|
|
|
|
* NULL PREVIOUS BREAK BUCKETS
|
|
|
|
Prev.Reactor=''
|
|
Last.Reactor.Break = 1
|
|
|
|
* * * * * * *
|
|
READRECORD:
|
|
* * * * * * *
|
|
|
|
IF @RECCOUNT GE 10 THEN
|
|
Last.Record=1
|
|
Reactor.Break=1
|
|
REACTOR=Prev.Reactor
|
|
REACTOR=Prev.Reactor
|
|
GOTO BREAKS
|
|
END
|
|
*
|
|
*
|
|
* ZERO BREAK FLAGS TO FALSE
|
|
*
|
|
Reactor.Break=0
|
|
*
|
|
*
|
|
READNEXT @ID, WHICH.VALUE ELSE
|
|
IF STATUS() GT 0 THEN
|
|
STATX = SET_FSERROR()
|
|
RETURN
|
|
END
|
|
IF @FILE.ERROR<1> EQ 421 THEN
|
|
STATX = SET_FSERROR()
|
|
GOTO READRECORD
|
|
END
|
|
IF @FILE.ERROR<1> NE 111 THEN
|
|
@ANS = @FILE.ERROR<1>
|
|
STATX = SEND_DYN( {RLIST_TEXT_4} )
|
|
READERR += 1
|
|
GOTO READRECORD
|
|
END
|
|
Last.Record=1
|
|
Reactor.Break=1
|
|
REACTOR=Prev.Reactor
|
|
END
|
|
@FILE.ERROR.MODE=0
|
|
|
|
S.ATID = @ID
|
|
|
|
IF FirstPass AND Last.Record THEN
|
|
STATX = SEND_DYN( {RLIST_TEXT_2} )
|
|
RETURN
|
|
END
|
|
|
|
IF Last.Record THEN GOTO BREAKS
|
|
|
|
IF @REDUCTION.DONE THEN
|
|
READO @RECORD FROM FILE.IN, @ID ELSE
|
|
@FILE.ERROR.MODE = 0
|
|
IF STATUS() GT 0 THEN
|
|
STATX = SET_FSERROR()
|
|
RETURN
|
|
END
|
|
IF @FILE.ERROR<1> NE 100 THEN
|
|
READERR += 1
|
|
END
|
|
GOTO READRECORD
|
|
END
|
|
END
|
|
|
|
@RECCOUNT += 1
|
|
|
|
|
|
* CALCULATE VALUE(S) FOR COLUMN(S)
|
|
|
|
S.ATID={@ID}
|
|
I.ATID=S.ATID
|
|
S.Reactor={REACTOR}
|
|
I.Reactor=S.Reactor
|
|
S.Reactor1={REACTOR}
|
|
I.Reactor1=S.Reactor1
|
|
M.REACT_PROB_CAT_DESC={REACT_PROB_CAT_DESC}<1,WHICH.VALUE> ; P.REACT_PROB_CAT_DESC=1 ; C.REACT_PROB_CAT_DESC=7
|
|
|
|
* INITIALIZE MULTIVALUE BREAK CHECK VARIABLE
|
|
|
|
S.REACT_PROB_CAT_DESC = M.REACT_PROB_CAT_DESC
|
|
M.REACT_SERV_ID={REACT_SERV_ID}<1,WHICH.VALUE> ; P.REACT_SERV_ID=1 ; C.REACT_SERV_ID=7
|
|
|
|
* INITIALIZE MULTIVALUE BREAK CHECK VARIABLE
|
|
|
|
S.REACT_SERV_ID = M.REACT_SERV_ID
|
|
M.REACT_SERV_DESC={REACT_SERV_DESC}<1,WHICH.VALUE> ; P.REACT_SERV_DESC=1 ; C.REACT_SERV_DESC=7
|
|
|
|
* INITIALIZE MULTIVALUE BREAK CHECK VARIABLE
|
|
|
|
S.REACT_SERV_DESC = M.REACT_SERV_DESC
|
|
S.TECH_SIG={TECH_SIG}
|
|
I.TECH_SIG=S.TECH_SIG
|
|
M.NOTES=FMT({NOTES},"T#20") ; P.NOTES=1 ; C.NOTES=7
|
|
|
|
* INITIALIZE TEXT BREAK CHECK VARIABLE(S)
|
|
|
|
S.NOTES = M.NOTES
|
|
S.START_DATE={START_DATE}
|
|
I.START_DATE=S.START_DATE
|
|
S.Elapsed_Hours={Elapsed_Hours}
|
|
I.Elapsed_Hours=S.Elapsed_Hours
|
|
|
|
PREVIOUS.MARK.LEVEL=0
|
|
|
|
* TEST FOR CONTROL BREAK(S)
|
|
|
|
IF (S.Reactor NE Prev.Reactor) OR Reactor.Break THEN
|
|
REACTOR=Prev.Reactor
|
|
Prev.Reactor=S.Reactor
|
|
Reactor.Break+=1
|
|
END
|
|
|
|
|
|
IF FirstPass THEN
|
|
FirstPass=0
|
|
GOTO DETAIL
|
|
END
|
|
|
|
* * * * * *
|
|
BREAKS:
|
|
* * * * * *
|
|
|
|
* PRINT BREAK TOTAL(S) AND ACCUMULATE TOTAL(S)
|
|
|
|
IF Reactor.Break THEN
|
|
STATX = SEND_DYN("")
|
|
PRINTLINE = ""
|
|
PRINTLINE := FMT("***" : "", "R#14") : TAB$
|
|
|
|
PRINTLINE := SPACE(14) : TAB$
|
|
|
|
PRINTLINE := SPACE(24) : TAB$
|
|
|
|
PRINTLINE := SPACE(14) : TAB$
|
|
|
|
PRINTLINE := SPACE(20) : TAB$
|
|
|
|
PRINTLINE := SPACE(20) : TAB$
|
|
|
|
PRINTLINE := SPACE(20) : TAB$
|
|
|
|
PRINTLINE := SPACE(11) : TAB$
|
|
|
|
PRINTLINE := FMT(OCONV(Elapsed_Hours.Reactor.Total ,"MD2") , "R#16")
|
|
STATX = SEND_DYN( PRINTLINE )
|
|
STATX = SEND_DYN("")
|
|
|
|
Elapsed_Hours.Grand.Total+=Elapsed_Hours.Reactor.Total
|
|
Elapsed_Hours.Reactor.Total=0
|
|
Elapsed_Hours.Grand.Count+=Elapsed_Hours.Reactor.Count
|
|
Elapsed_Hours.Reactor.Count=0
|
|
END
|
|
|
|
* PERFORM LAST RECORD OUTPUT IF DONE
|
|
|
|
IF Last.Record THEN
|
|
STATX = SEND_DYN("")
|
|
PRINTLINE = ""
|
|
PRINTLINE := FMT("***" : "", "R#14") : TAB$
|
|
PRINTLINE := SPACE(14) : TAB$
|
|
PRINTLINE := SPACE(24) : TAB$
|
|
PRINTLINE := SPACE(14) : TAB$
|
|
PRINTLINE := SPACE(20) : TAB$
|
|
PRINTLINE := SPACE(20) : TAB$
|
|
PRINTLINE := SPACE(20) : TAB$
|
|
PRINTLINE := SPACE(11) : TAB$
|
|
PRINTLINE := FMT(OCONV(Elapsed_Hours.Grand.Total ,"MD2") , "R#16")
|
|
STATX = SEND_DYN( PRINTLINE )
|
|
STATX = SEND_DYN("")
|
|
@ANS=@RECCOUNT
|
|
STATX = SEND_DYN( {RLIST_TEXT_1} )
|
|
IF READERR THEN
|
|
@ANS=READERR
|
|
STATX = SEND_DYN( {RLIST_TEXT_3} )
|
|
END
|
|
RETURN
|
|
END
|
|
|
|
* * * * * * *
|
|
DETAIL:
|
|
* * * * * * *
|
|
|
|
* REMOVE APPROPRIATE VALUE FROM MULTI-VALUED COLUMN(S)
|
|
|
|
NEW.MARK.LEVEL=0
|
|
|
|
IF C.REACT_PROB_CAT_DESC GE PREVIOUS.MARK.LEVEL THEN
|
|
REMOVE I.REACT_PROB_CAT_DESC FROM M.REACT_PROB_CAT_DESC AT P.REACT_PROB_CAT_DESC SETTING C.REACT_PROB_CAT_DESC
|
|
S.REACT_PROB_CAT_DESC=I.REACT_PROB_CAT_DESC
|
|
END
|
|
IF C.REACT_PROB_CAT_DESC GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.REACT_PROB_CAT_DESC
|
|
|
|
IF C.REACT_SERV_ID GE PREVIOUS.MARK.LEVEL THEN
|
|
REMOVE I.REACT_SERV_ID FROM M.REACT_SERV_ID AT P.REACT_SERV_ID SETTING C.REACT_SERV_ID
|
|
S.REACT_SERV_ID=I.REACT_SERV_ID
|
|
END
|
|
IF C.REACT_SERV_ID GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.REACT_SERV_ID
|
|
|
|
IF C.REACT_SERV_DESC GE PREVIOUS.MARK.LEVEL THEN
|
|
REMOVE I.REACT_SERV_DESC FROM M.REACT_SERV_DESC AT P.REACT_SERV_DESC SETTING C.REACT_SERV_DESC
|
|
S.REACT_SERV_DESC=I.REACT_SERV_DESC
|
|
END
|
|
IF C.REACT_SERV_DESC GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.REACT_SERV_DESC
|
|
|
|
IF C.NOTES GE PREVIOUS.MARK.LEVEL THEN
|
|
REMOVE I.NOTES FROM M.NOTES AT P.NOTES SETTING C.NOTES
|
|
S.NOTES=I.NOTES
|
|
END
|
|
IF C.NOTES GT NEW.MARK.LEVEL THEN NEW.MARK.LEVEL=C.NOTES
|
|
|
|
|
|
* DO CONVERSIONS IF ANY
|
|
|
|
IF S.Reactor NE "" THEN S.Reactor=OCONV(S.Reactor,"MD0")
|
|
IF S.Reactor1 NE "" THEN S.Reactor1=OCONV(S.Reactor1,"MD0")
|
|
IF S.REACT_SERV_ID NE "" THEN S.REACT_SERV_ID=OCONV(S.REACT_SERV_ID,"MD0")
|
|
IF S.START_DATE NE "" THEN S.START_DATE=OCONV(S.START_DATE,"D2/")
|
|
IF S.Elapsed_Hours NE "" THEN S.Elapsed_Hours=OCONV(S.Elapsed_Hours,"MD2")
|
|
|
|
* ACCUMULATE TOTAL(S)
|
|
|
|
IF NUM(I.Elapsed_Hours) AND I.Elapsed_Hours NE "" THEN
|
|
Elapsed_Hours.Reactor.Total+=I.Elapsed_Hours
|
|
Elapsed_Hours.Reactor.Count+=1
|
|
I.Elapsed_Hours=''
|
|
END
|
|
|
|
* PRINT DETAIL LINE
|
|
|
|
PRINTLINE = ""
|
|
PRINTLINE := FMT( S.Reactor, "R#14") : TAB$
|
|
PRINTLINE := FMT( S.Reactor1, "R#14") : TAB$
|
|
PRINTLINE := FMT( S.REACT_PROB_CAT_DESC, "L#24") : TAB$
|
|
PRINTLINE := FMT( S.REACT_SERV_ID, "R#14") : TAB$
|
|
PRINTLINE := FMT( S.REACT_SERV_DESC, "L#20") : TAB$
|
|
PRINTLINE := FMT( S.TECH_SIG, "L#20") : TAB$
|
|
PRINTLINE := FMT( S.NOTES, "L#20") : TAB$
|
|
PRINTLINE := FMT( S.START_DATE, "R#11") : TAB$
|
|
PRINTLINE := FMT( S.Elapsed_Hours, "R#16")
|
|
STATX = SEND_DYN( PRINTLINE )
|
|
|
|
IF NEW.MARK.LEVEL THEN
|
|
S.Reactor=''
|
|
S.Reactor1=''
|
|
S.REACT_PROB_CAT_DESC=''
|
|
S.REACT_SERV_ID=''
|
|
S.REACT_SERV_DESC=''
|
|
S.TECH_SIG=''
|
|
S.NOTES=''
|
|
S.START_DATE=''
|
|
S.Elapsed_Hours=''
|
|
PREVIOUS.MARK.LEVEL=NEW.MARK.LEVEL
|
|
GOTO DETAIL
|
|
END
|
|
|
|
GOTO READRECORD
|
|
|
|
END
|
|
|
|
*/
|
|
|
|
|