COMPILE SUBROUTINE REPORT_POSTCLEANS(Dummy) * PostCleans Report - goes straight to Excel * 9/25/2007 John C. Henry, J.C. Henry & Co., Inc. Initial coding DECLARE SUBROUTINE ErrMsg, Btree.Extract, Set_Status, SetInitDirOptions, mSG DECLARE FUNCTION Msg, Get_Status, obj_Calendar, Utility, SetInitDirOptions, Dialog_Box, obj_RDS, Environment_Services $INSERT RDS_EQU $INSERT WO_STEP_EQU $INSERT WO_MAT_EQUATES $INSERT WM_OUT_EQUATES $INSERT MSG_EQUATES EQU COL$WMO_KEY TO 1 EQU COL$RDS_NO TO 2 EQU COL$WO_STEP_PS_NO TO 3 EQU COL$CUST_NAME TO 4 EQU COL$PART_NO TO 5 EQU COL$WO_STEP_POST_CLEAN TO 6 EQU COL$POST_CLEAN TO 7 EQU COL$WO_STEP_WFRS_OUT TO 8 EQU COL$RX_DTM TO 9 EQU COL$HOLD_STATUS TO 10 EQU COL$PERIOD TO 12 EQU COL$PERIOD_VALUE TO 13 EQU COL$PERIOD_START TO 14 EQU COL$PERIOD_END TO 15 EQU CRLF$ TO \0D0A\ equ xlTrue to -1 equ xlFalse to 0 equ xlSheetVisible to -1 equ xlRangeAutoFormatSimple to -4154 equ xlRangeAutoFormatClassic1 to 1 equ xlCSV to 6 equ xlTextMSDOS to 21 equ xlCSVWindows to 23 eXcelCols = 'A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,AA,BB,CC,DD,EE,FF,GG,HH,II,JJ,KK,LL' SWAP "','" WITH ',' IN eXcelCols CONVERT ',' TO @VM IN eXcelCols DataArray = '' DataArray = 'WM_OUT Key' DataArray = 'RDS No' DataArray = 'WO Step PSN' DataArray = 'Customer Name' DataArray = 'Part No' DataArray = 'WO Step Post Clean' DataArray = 'Post Clean Code' DataArray = 'WO Step Wfrs Out' DataArray = 'Received DTM' DataArray = 'Hold Status' DataArray = 'Ran At' DataArray = '' DataArray = OCONV(Date(),'D4/') DataArray = OCONV(Time(),'MTH') OPEN 'DICT.RDS' TO RDSDict ELSE ErrMsg('Unable to open "DICT.RDS" for index lookup') RETURN END OPEN 'DICT.WM_OUT' TO WMOutDict ELSE ErrMsg('Unable to open "DICT.WM_OUT" for index lookup') RETURN END OPEN 'DICT.WO_MAT' TO @DICT ELSE ErrMsg('Unable to open "DICT.WO_MAT" for report') RETURN END OPEN 'WO_MAT' TO WOMatFile ELSE ErrMsg('Unable to open "WO_MAT" for report') RETURN END SearchString = 'CURR_STATUS':@VM:'PSTC':@VM:'HOLD':@FM ;******** RDSKeys = '' Option = '' Flag = '' Def = "" Def = "Selecting RDS records..." Def = "U" MsgUp = Msg(@window, Def) ;* display the processing message Set_Status(0) Btree.Extract(SearchString, 'RDS', RDSDict, RDSKeys, Option, Flag) Msg(@WINDOW, MsgUp) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END WMOutKeys = '' Option = '' Flag = '' Def = "" Def = "Selecting WM_OUT records..." Def = "U" MsgUp = Msg(@window, Def) ;* display the processing message Set_Status(0) Btree.Extract(SearchString, 'WM_OUT', WMOutDict, WMOutKeys, Option, Flag) Msg(@WINDOW, MsgUp) IF Get_Status(errCode) THEN ErrMsg(errCode) RETURN END RDSCnt = COUNT(RDSKeys,@VM) + (RDSKeys NE '') WMOutCnt = COUNT(WMOutKeys,@VM) + (WMOutKeys NE '') LineCnt = RDSCnt + WMOutCnt Def = "" Def = "Building Report..." Def = "GC" Def = RDSCnt Def = 600 MsgUp = Msg(@WINDOW, Def) WOMatKeys = '' ReportLines = '' LoopCnt = 0 FOR I = 1 TO RDSCnt RDSKey = RDSKeys<1,I> RDSRec = XLATE('RDS',RDSKey,'','X') ReactorType = XLATE('REACTOR',RDSRec,1,'X') IF ReactorType NE 'EPP' THEN WONo = RDSRec CassNo = RDSRec PSNo = RDSRec PartNo = RDSRec WfrsOut = obj_RDS('WafersOut',RDSKey:@RM:RDSRec) StepPostClean = XLATE( 'PROD_SPEC', PSNo, 'SUB_POST_CLEAN', 'X' ) PostClean = RDSRec OutDTM = OCONV(RDSRec,'D2/'):' ':OCONV(RDSRec HoldDates = RDSRec HoldStatus = '' IF Hold = 1 THEN IF PostClean NE 'External' THEN GOTO SkipRDS ;* HoldStatus = 'On Hold' END ELSE IF HoldDates = '' THEN HoldStatus = 'No' END ELSE HoldStatus = 'Off Hold' END END IF WONo NE '' AND CassNo NE '' THEN WOMatKey = WONo:'*':CassNo LOCATE WOMatKey IN WOMatKeys BY 'AR' USING @VM SETTING Pos ELSE CustName = XLATE('WO_MAT',WOMatKey,'CUST_NAME','X') WOMatKeys = INSERT(WOMatKeys,1,Pos,0,WOMatKey) ReportLines = INSERT(ReportLines,COL$WMO_KEY,Pos,0,'') ReportLines = INSERT(ReportLines,COL$RDS_NO,Pos,0,RDSKey) ReportLines = INSERT(ReportLines,COL$WO_STEP_PS_NO,Pos,0,PSNo) ReportLines = INSERT(ReportLines,COL$CUST_NAME,Pos,0,CustName) ReportLines = INSERT(ReportLines,COL$PART_NO,Pos,0,PartNo) ReportLines = INSERT(ReportLines,COL$WO_STEP_POST_CLEAN,Pos,0,StepPostClean) ReportLines = INSERT(ReportLines,COL$POST_CLEAN,Pos,0,PostClean) ReportLines = INSERT(ReportLines,COL$WO_STEP_WFRS_OUT,Pos,0,WfrsOut) ReportLines = INSERT(ReportLines,COL$RX_DTM,Pos,0,OutDTM) ReportLines = INSERT(ReportLines,COL$HOLD_STATUS,Pos,0,HoldStatus) END END END LoopCnt += 1 * * * * * * * SkipRDS: * * * * * * * WHILE Msg(@WINDOW, MsgUp, LoopCnt, MSGINSTUPDATE$) NEXT I FOR I = 1 TO WMOutCnt WMOutKey = WMOutKeys<1,I> WMOutRec = XLATE('WM_OUT',WMOutKey,'','X') WONo = FIELD(WMOutKey,'*',1) CassNo = FIELD(WMOutKey,'*',3) WOStepKey = FIELD(WMOutKey,'*',1,2) PSNo = XLATE('WO_STEP',WOStepKey,WO_STEP_PROD_SPEC_ID$,'X') WOMatKey = WONo:'*':CassNo WOMatRec = XLATE('WO_MAT',WOMatKey,'','X') PartNo = WOMatRec CustName = XLATE('WO_MAT',WOMatKey,'CUST_NAME','X') SpecPostClean = XLATE( 'PROD_SPEC', PSNo, 'SUB_POST_CLEAN', 'X' ) PostCode = WMOutRec RxDTM = OCONV(WOMatRec,'DT4/^HS') WfrsOut = XLATE('WM_OUT',WMOutKey,'WFRS_OUT','X') Hold = WMOutRec HoldDtms = WMOutRec HoldStatus = '' IF Hold = 1 THEN IF PostCode NE 'External' THEN GOTO SkipWMOut ;* HoldStatus = 'On Hold' END ELSE IF HoldDtms = '' THEN HoldStatus = 'No' END ELSE HoldStatus = 'Off Hold' END END LOCATE WOMatKey IN WOMatKeys BY 'AR' USING @VM SETTING Pos ELSE WOMatKeys = INSERT(WOMatKeys,1,Pos,0,WOMatKey) ReportLines = INSERT(ReportLines,COL$WMO_KEY,Pos,0,WOMatKey) ReportLines = INSERT(ReportLines,COL$RDS_NO,Pos,0,'') ReportLines = INSERT(ReportLines,COL$WO_STEP_PS_NO,Pos,0,PSNo) ReportLines = INSERT(ReportLines,COL$CUST_NAME,Pos,0,CustName) ReportLines = INSERT(ReportLines,COL$PART_NO,Pos,0,PartNo) ReportLines = INSERT(ReportLines,COL$WO_STEP_POST_CLEAN,Pos,0,SpecPostClean) ReportLines = INSERT(ReportLines,COL$POST_CLEAN,Pos,0,PostCode) ReportLines = INSERT(ReportLines,COL$WO_STEP_WFRS_OUT,Pos,0,WfrsOut) ReportLines = INSERT(ReportLines,COL$RX_DTM,Pos,0,RxDTM) ReportLines = INSERT(ReportLines,COL$HOLD_STATUS,Pos,0,HoldStatus) END LoopCnt += 1 * * * * * * SkipWMOut: * * * * * * WHILE Msg(@WINDOW, MsgUp, LoopCnt, MSGINSTUPDATE$) NEXT I DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines DataArray = ReportLines Msg(@WINDOW,MsgUp) xlApp = OleCreateInstance("excel.Application") OlePutProperty(XlApp, 'Visible', xlSheetVisible) if OleStatus() then Goto HadError xlWorkBooks =OleGetProperty(xlApp, "Workbooks") xlWkb = OleCallMethod(xlWorkbooks,"Add") if OleStatus() then Goto HadError xlSht = OleGetProperty(xlWkb, "Worksheets",1) if OleStatus() then Goto HadError LineCnt = COUNT(DataArray<1>,@VM) + (DataArray<1> NE '') ColCnt = COUNT(DataArray,@FM) + (DataArray NE '') FOR LineNo = 1 TO LineCnt FOR Column = 1 to ColCnt a = DataArray RangeColumn = eXcelCols<1,Column> range = OleGetProperty( xlSht, 'Range',RangeColumn:LineNo) OlePutProperty(range, 'Value', DataArray) IF OleStatus() THEN GOTO HadError NEXT Column NEXT LineCnt *range = OleGetProperty( xlSht, 'Range','B1:':RangeColumn:'1') *OlePutProperty( range, 'WrapText', xlTrue) *IF OleStatus() THEN GOTO HadError RangeColumn = eXcelCols<1,ColCnt> range = OleGetProperty( xlSht, 'Range','A1:':RangeColumn:LineCnt) Void = OleCallMethod( range, 'AutoFormat', xlRangeAutoFormatClassic1 ) * Void = OleCallMethod( xlWkb, 'SaveAs','C:\OIReports\CleansReport.CSV', xlCSVWindows ) Void = OleCallMethod( xlWkb, 'SaveAs',Environment_Services('GetReportsRootPath') : '\CleansReport.CSV', xlCSVWindows ) IF OleStatus() THEN GOTO HadError RETURN * * * * * * * HadError: * * * * * * * xlChart = '' Charts = '' range = '' xlSht = '' xlWkb='' xlWorkBooks = '' x = OleCallMethod(xlApp, 'Quit') RETURN /* end of code */