433 lines
11 KiB
Plaintext
433 lines
11 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, Push.Select, Pop.Select, Run_Report
|
|
DECLARE FUNCTION Set_Printer, Get_Printer, Msg, Get_Status, Printer_Select, obj_Install, Dialog_Box
|
|
DECLARE FUNCTION Reactor_Services
|
|
|
|
$INSERT OIPRINT_EQUATES
|
|
$INSERT INVOICE_EQU
|
|
$INSERT APPCOLORS
|
|
$INSERT MSG_EQUATES
|
|
|
|
Equ BASE_NUM_COLS$ to 9
|
|
Equ REPORT_WIDTH$ to 14670
|
|
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>
|
|
PSNs = Params<6>
|
|
IncludeReactItemIds = Params<7>
|
|
IncludeInjSettings = Params<8>
|
|
IncludeReactRatios = Params<9>
|
|
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 PSNs <> '' THEN
|
|
SWAP @VM WITH "' '" IN PSNs
|
|
PSNs = "'":PSNs:"'"
|
|
WithStmt :=' AND WITH PROD_SPEC_NO = ':PSNs
|
|
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
|
|
PrintSetup<1, 2> = 0
|
|
|
|
PrintPath = ''
|
|
|
|
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
|
|
|
|
NumCols = BASE_NUM_COLS$
|
|
// 14670 width to work with
|
|
|
|
* Make Column Heading
|
|
If IncludeReactItemIds then
|
|
NumCols += 1
|
|
end
|
|
|
|
If IncludeInjSettings then
|
|
NumCols += 1
|
|
end
|
|
|
|
If IncludeReactRatios then
|
|
NumCols += 1
|
|
end
|
|
|
|
colHead = '' ; colFmt = ''
|
|
colHead<1,-1> = 'R' ; colFmt<1,-1> = '^':(REPORT_WIDTH$ * (.050 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'PSN' ; colFmt<1,-1> = '^':(REPORT_WIDTH$ * (.049 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'Problem Cat Desc' ; colFmt<1,-1> = '<':(REPORT_WIDTH$ * (.117 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'Serv':CRLF$:'ID' ; colFmt<1,-1> = '^':(REPORT_WIDTH$ * (.073 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'Reactor Svc Desc' ; colFmt<1,-1> = '<':(REPORT_WIDTH$ * (.258 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'Tech' ; colFmt<1,-1> = '^':(REPORT_WIDTH$ * (.068 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
If IncludeReactItemIds then
|
|
colHead<1,-1> = 'Reactor Item ID' ; colFmt<1,-1> = '<':(REPORT_WIDTH$ * ( 1 / NumCols) )
|
|
end
|
|
If IncludeInjSettings then
|
|
colHead<1,-1> = 'Inj Settings' ; colFmt<1,-1> = '<':(REPORT_WIDTH$ * ( 1 / NumCols) - 50 )
|
|
end
|
|
If IncludeReactRatios then
|
|
colHead<1,-1> = 'Ratios' ; colFmt<1,-1> = '<':(REPORT_WIDTH$ * ( 1 / NumCols) + 150 )
|
|
end
|
|
colHead<1,-1> = 'Notes' ; colFmt<1,-1> = '<':(REPORT_WIDTH$ * (.248 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'Start' ; colFmt<1,-1> = '^':(REPORT_WIDTH$ * (.079 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
colHead<1,-1> = 'Hrs' ; colFmt<1,-1> = '>':(REPORT_WIDTH$ * (.043 * (BASE_NUM_COLS$ / NumCols) ) )
|
|
|
|
* 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.PSN = {PROD_SPEC_NO}
|
|
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}
|
|
Push.Select(f1, f2, f3, f4)
|
|
S.InjSettings = ''
|
|
InjSettings = OConv(Reactor_Services('GetInjectorSettingsByReactorLog', @ID), 'MD3,')
|
|
NumSettings = DCount(InjSettings, @VM)
|
|
If NumSettings GT 0 then
|
|
For SettingIndex = 1 to NumSettings
|
|
S.InjSettings<0, SettingIndex> = 'Inj ':SettingIndex:': ':InjSettings<0, SettingIndex>
|
|
Next SettingIndex
|
|
end
|
|
Pop.Select(f1, f2, f3, f4)
|
|
Push.Select(f1, f2, f3, f4)
|
|
S.ReactorRatios = ''
|
|
ReactorRatios = OConv(Reactor_Services('GetRatiosByReactorLog', @ID), 'MD3,')
|
|
NumRatios = DCount(ReactorRatios, @VM)
|
|
If NumRatios GT 0 then
|
|
For RatioIndex = 1 to NumRatios
|
|
S.ReactorRatios<0, RatioIndex> = 'Ratio ':RatioIndex:': ':ReactorRatios<0, RatioIndex>
|
|
Next RatioIndex
|
|
end
|
|
Pop.Select(f1, f2, f3, f4)
|
|
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
|
|
SWAP @VM WITH CRLF$ IN S.InjSettings
|
|
SWAP @VM WITH CRLF$ IN S.ReactorRatios
|
|
|
|
* 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
|
|
|
|
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,-1> = S.PSN
|
|
colData<1,-1> = S.React_Prob_Cat_Desc
|
|
colData<1,-1> = S.React_Serv_ID
|
|
colData<1,-1> = S.React_Serv_Desc
|
|
colData<1,-1> = S.Tech
|
|
If IncludeReactItemIds then
|
|
colData<1,-1> = S.React_Item_IDS
|
|
end
|
|
If IncludeInjSettings then
|
|
colData<1,-1> = S.InjSettings
|
|
end
|
|
If IncludeReactRatios then
|
|
colData<1,-1> = S.ReactorRatios
|
|
end
|
|
colData<1,-1> = S.Notes
|
|
colData<1,-1> = S.StartDTM
|
|
colData<1,-1> = 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
|
|
|