added LSL2 stored procedures
This commit is contained in:
329
LSL2/STPROC/COMM_DIALOG_CARTON_PACK.txt
Normal file
329
LSL2/STPROC/COMM_DIALOG_CARTON_PACK.txt
Normal file
@ -0,0 +1,329 @@
|
||||
COMPILE FUNCTION Comm_Dialog_Carton_Pack(Instruction, Parm1)
|
||||
|
||||
/*
|
||||
Commuter module for PACK_CARTON dialog window.
|
||||
|
||||
9/16/2003 - John C. Henry, J.C. Henry & Co., Inc.
|
||||
*/
|
||||
|
||||
DECLARE SUBROUTINE Set_Property, End_Dialog, Send_Event, Set_Status
|
||||
DECLARE SUBROUTINE ErrMsg, Send_Message
|
||||
DECLARE FUNCTION Get_Property, Get_Status, Dialog_Box, Utility, Center_Window, Send_Message
|
||||
DECLARE FUNCTION obj_WM_Out
|
||||
|
||||
EQU CRLF$ TO \0D0A\
|
||||
|
||||
|
||||
EQU COL$ORDER_NO TO 1 ;* Order Line Item edit table column equates
|
||||
EQU COL$LINE_NO TO 2
|
||||
EQU COL$STEP_NO TO 3
|
||||
EQU COL$CASS_NO TO 4
|
||||
EQU COL$RDS_NO TO 5
|
||||
EQU COL$PART_NO TO 6
|
||||
EQU COL$LOT_NO TO 7
|
||||
EQU COL$REJECT TO 8
|
||||
EQU COL$WAFER_QTY TO 9
|
||||
|
||||
EQU COL$CASS1 TO 1 ;* Carton edit table column equates
|
||||
EQU COL$CASS2 TO 2
|
||||
EQU COL$CASS3 TO 3
|
||||
EQU COL$CASS4 TO 4
|
||||
EQU COL$CASS5 TO 5
|
||||
EQU COL$CASS6 TO 6
|
||||
|
||||
|
||||
EQU LTGREY$ TO 229 + (229*256) + (229*65536) ;* JCH standard colors for edittable backgrounds
|
||||
EQU GREY$ TO 192 + (192*256) + (192*65536)
|
||||
EQU GREEN$ TO 192 + (220*256) + (192*65536)
|
||||
EQU RED$ TO 255 + (128*256) + (128*65536)
|
||||
EQU BLUE$ TO 128 + (255*256) + (255*65536)
|
||||
EQU WHITE$ TO 255 + (255*256) + (255*65536)
|
||||
EQU YELLOW$ TO 255 + (255*256) + (202*65536)
|
||||
EQU LTBLUE$ TO 128 + (255*256) + (255*65536)
|
||||
EQU PURPLE$ TO 225 + (181*256) + (255*65536)
|
||||
|
||||
EQU DTS_MULTIROW$ TO 512
|
||||
EQU DTS_LARGEDATA$ TO 4096
|
||||
|
||||
$INSERT COC_EQU
|
||||
$INSERT WO_LOG_EQU
|
||||
$INSERT RDS_EQU
|
||||
$INSERT PS_EQUATES
|
||||
$INSERT ORDER_EQU
|
||||
|
||||
ErrTitle = 'Error in Comm_Dialog_Carton_Pack'
|
||||
ErrorMsg = ''
|
||||
|
||||
Instructions = 'Create':@FM
|
||||
Instructions := 'PackCarton':@FM
|
||||
Instructions := 'PackNext':@FM
|
||||
Instructions := 'UnpackCarton':@FM
|
||||
Instructions := 'PrintLabels':@FM ;* This functions as the 'OK' button
|
||||
Instructions := 'Cancel'
|
||||
|
||||
RetVal = ''
|
||||
|
||||
LOCATE Instruction IN Instructions USING @FM SETTING Pos THEN
|
||||
ON Pos GOSUB Create,PackCarton,PackNext,UnpackCarton,PrintLabels,Cancel
|
||||
END
|
||||
|
||||
RETURN RetVal
|
||||
|
||||
|
||||
* * * * * * *
|
||||
Create:
|
||||
* * * * * * *
|
||||
|
||||
COCId = Parm1
|
||||
|
||||
IF COCId = '' THEN GOTO Cancel ;* Nothing to do
|
||||
|
||||
* get the current style
|
||||
|
||||
Style = Get_Property(@WINDOW:'.CASSETTES', 'STYLE')
|
||||
|
||||
/* the style property can be in hex format but bitor only works with decimal integers */
|
||||
|
||||
IF Style [1,2] _EQC "0x" THEN
|
||||
CONVERT @LOWER.CASE TO @UPPER.CASE IN STYLE
|
||||
Style = ICONV(Style [3,99], "MX")
|
||||
END
|
||||
|
||||
AddStyle = 512 ;* MultiLine Select
|
||||
|
||||
Style = BitOr(Style, AddStyle)
|
||||
Set_Property(@WINDOW:'.CASSETTES', "STYLE", Style)
|
||||
|
||||
Set_Property(@WINDOW,'TEXT','Packing Cartons for Certicate of Compliance: ':COCId)
|
||||
|
||||
Void = Center_Window(@WINDOW)
|
||||
|
||||
COCRec = XLATE('COC',COCId,'','X')
|
||||
|
||||
WONo = COCRec<coc_wo$>
|
||||
WORec = XLATE('WO_LOG',WONo,'','X')
|
||||
|
||||
OrderNo = WORec<WO_LOG_ORDER_NO$>
|
||||
OrderRec = XLATE('ORDER',OrderNo,'','X')
|
||||
|
||||
RDSNos = COCRec<COC_RDS_NO$>
|
||||
WOStepNos = COCRec<COC_WO_STEP$>
|
||||
CassNos = COCRec<COC_CASS_NO$>
|
||||
|
||||
|
||||
RDSList = ''
|
||||
|
||||
FOR I = 1 TO COUNT(WOStepNos,@VM) + (WOStepNos NE '')
|
||||
WMOutKey = WONo:'*':WOStepNos<1,I>:'*':CassNos<1,I>
|
||||
IF RDSNos<1,I> = '' THEN
|
||||
RdsNo = ''
|
||||
WfrsOut = XLATE('WM_OUT',WMOutKey,'WFRS_OUT','X')
|
||||
WfrsRej = XLATE('WM_OUT',WMOutKey,'WFRS_REJ','X')
|
||||
|
||||
PartNo = obj_WM_Out('GetPartNoQtys',WMOutKey)<1> ; IF INDEX(PartNo,@VM,1) THEN PartNo = 'Multi'
|
||||
LotNo = obj_WM_Out('GetLotNos',WMOutKey) ; IF INDEX(LotNo,@VM,1) THEN LotNo = 'Multi'
|
||||
OrderItem = obj_WM_Out('GetOrderItems',WMOutKey) ; IF INDEX(OrderItem,@VM,1) THEN OrderItem = 'Multi'
|
||||
END ELSE
|
||||
RdsNo = RDSNos<1,I>
|
||||
RDSRec = XLATE('RDS',RDSNo,'','X')
|
||||
WfrsOut = XLATE('RDS',RDSNo,'WFRS_OUT','X')
|
||||
WfrsRej = XLATE('RDS',RDSNo,'TOT_REJ','X')
|
||||
PartNo = RDSRec<RDS_PART_NUM$>
|
||||
LotNo = RDSRec<RDS_LOT_NUM$>
|
||||
OrderItem = RDSRec<RDS_ORDER_ITEM$>
|
||||
END
|
||||
|
||||
|
||||
RDSList<I,COL$ORDER_NO> = OrderNo
|
||||
RDSList<I,COL$LINE_NO> = OrderItem
|
||||
RDSList<I,COL$STEP_NO> = WOStepNos<1,I>
|
||||
RDSList<I,COL$CASS_NO> = CassNos<1,I>
|
||||
RDSList<I,COL$RDS_NO> = RDSNo
|
||||
RDSList<I,COL$PART_NO> = PartNo
|
||||
RDSList<I,COL$LOT_NO> = LotNo
|
||||
|
||||
RDSList<I,COL$REJECT> = WfrsRej
|
||||
RDSList<I,COL$WAFER_QTY> = WfrsOut
|
||||
|
||||
NEXT I
|
||||
|
||||
|
||||
Set_Property(@WINDOW:'.CASSETTES','LIST',RDSList)
|
||||
|
||||
|
||||
GOSUB Refresh
|
||||
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
Refresh:
|
||||
* * * * * * *
|
||||
|
||||
CassList = Get_Property(@WINDOW:'.CASSETTES','LIST')
|
||||
|
||||
IF CassList<1,1> = '' THEN
|
||||
Set_Property(@WINDOW:'.PRINT_LABEL_BUTTON','ENABLED',1)
|
||||
Set_Property(@WINDOW:'.PACK_BUTTON','ENABLED',0)
|
||||
END ELSE
|
||||
Set_Property(@WINDOW:'.PRINT_LABEL_BUTTON','ENABLED',0)
|
||||
Set_Property(@WINDOW:'.PACK_BUTTON','ENABLED',1)
|
||||
END
|
||||
|
||||
CartonList = Get_Property(@WINDOW:'.CARTONS','LIST')
|
||||
IF CartonList<1,1> = '' THEN
|
||||
Set_Property(@WINDOW:'.UNPACK_BUTTON','ENABLED',0)
|
||||
END ELSE
|
||||
Set_Property(@WINDOW:'.UNPACK_BUTTON','ENABLED',1)
|
||||
END
|
||||
|
||||
|
||||
|
||||
RETURN
|
||||
|
||||
* * * * * * *
|
||||
PackCarton:
|
||||
* * * * * * *
|
||||
|
||||
SelectedRows = Get_Property(@WINDOW:'.CASSETTES','SELPOS')<2> ;* Returns list of selected row numbers
|
||||
|
||||
CONVERT @VM TO @FM in SelectedRows
|
||||
|
||||
SelCnt = COUNT(SelectedRows,@FM) + (SelectedRows NE '')
|
||||
|
||||
IF SelCnt > 6 THEN
|
||||
ErrMsg('Maximum of 6 cassettes per carton permitted.')
|
||||
RETURN
|
||||
END
|
||||
IF SelCnt = 0 THEN RETURN
|
||||
|
||||
Cassettes = ''
|
||||
FOR I = 1 TO SelCnt
|
||||
Cassette = Get_Property(@WINDOW:'.CASSETTES','CELLPOS',0:@FM:SelectedRows<I>) ;* Retrive rows of data
|
||||
Cassettes<-1> = Cassette
|
||||
NEXT I
|
||||
CONVERT @VM TO '|' IN Cassettes
|
||||
|
||||
CartonList = Get_Property(@WINDOW:'.CARTONS','LIST')
|
||||
|
||||
CartonCnt = COUNT(CartonList,@FM) + (CartonList NE '')
|
||||
NextCartonNo = 1 ;* Find next empty carton number
|
||||
LOOP
|
||||
UNTIL CartonList<NextCartonNo,COL$CASS1> = ''
|
||||
NextCartonNo += 1
|
||||
REPEAT
|
||||
|
||||
IF NextCartonNo = CartonCnt THEN
|
||||
Dummy = Send_Message(@WINDOW:'.CARTONS', "INSERT", -1, @VM:@VM:@VM:@VM:@VM)
|
||||
END
|
||||
|
||||
Set_Property(@WINDOW:'.CARTONS','SELPOS',COL$CASS1:@FM:NextCartonNo)
|
||||
Set_Property(@WINDOW:'.CARTONS','ROWDATA',Cassettes) ;* Fill carton with Cassette data
|
||||
|
||||
FOR I = SelCnt TO 1 STEP -1
|
||||
Send_Message(@WINDOW:'.CASSETTES','DELETE',SelectedRows<I>) ;* Remove Cassette rows from list
|
||||
NEXT I
|
||||
|
||||
GOSUB Refresh
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
PackNext:
|
||||
* * * * * * *
|
||||
|
||||
CartonPack = Get_Property(@WINDOW:'.CASS_PER_CARTON','TEXT')
|
||||
IF CartonPack = '' THEN RETURN
|
||||
|
||||
SelColumns = ''
|
||||
FOR I = 1 TO CartonPack
|
||||
SelColumns<1,-1> = I
|
||||
NEXT I
|
||||
|
||||
Set_Property(@WINDOW:'.CASSETTES','SELPOS',1:@FM:SelColumns)
|
||||
|
||||
GOTO PackCarton
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
UnpackCarton:
|
||||
* * * * * * *
|
||||
|
||||
CartonData = Get_Property(@WINDOW:'.CARTONS','ROWDATA')
|
||||
|
||||
|
||||
CONVERT @VM TO @FM IN CartonData
|
||||
CONVERT '|' TO @VM IN CartonData
|
||||
|
||||
CartonCnt = COUNT(CartonData,@VM) + (CartonData NE '')
|
||||
|
||||
CassList = Get_Property(@WINDOW:'.CASSETTES','LIST')
|
||||
|
||||
CassCnt = COUNT(CassList,@FM) + (CassList NE '')
|
||||
|
||||
CassSortArray = ''
|
||||
FOR I = 1 TO CassCnt
|
||||
SortKey = CassList<I,COL$ORDER_NO>:CassList<I,COL$LINE_NO>:CassList<I,COL$STEP_NO>:CassList<I,COL$CASS_NO>
|
||||
UNTIL SortKey = '' ;* Found empty line
|
||||
LOCATE SortKey IN CassSortArray BY 'AR' USING @VM SETTING Pos ELSE
|
||||
CassSortArray = INSERT(CassSortArray,1,Pos,0,SortKey)
|
||||
END
|
||||
NEXT I
|
||||
|
||||
FOR I = 1 TO CartonCnt
|
||||
SortKey = CartonData<I,COL$ORDER_NO>:CartonData<I,COL$LINE_NO>:CartonData<I,COL$STEP_NO>:CartonData<I,COL$CASS_NO>
|
||||
UNTIL SortKey = ''
|
||||
LOCATE SortKey IN CassSortArray BY 'AR' USING @VM SETTING Pos ELSE
|
||||
CassSortArray = INSERT(CassSortArray,1,Pos,0,SortKey)
|
||||
CassList = INSERT(CassList,Pos,0,0,CartonData<I>)
|
||||
END
|
||||
NEXT I
|
||||
|
||||
Set_Property(@WINDOW:'.CASSETTES','LIST',CassList) ;* Put cassettes back in the list of cassettes
|
||||
|
||||
CurrCartonRow = Get_Property(@WINDOW:'.CARTONS','SELPOS')<2>
|
||||
|
||||
Send_Message(@WINDOW:'.CARTONS','DELETE',CurrCartonRow) ;* Remove cassettes from carton
|
||||
|
||||
GOSUB Refresh
|
||||
|
||||
RETURN
|
||||
|
||||
* * * * * * *
|
||||
PrintLabels:
|
||||
* * * * * * *
|
||||
|
||||
CartonList = Get_Property(@WINDOW:'.CARTONS','LIST')
|
||||
|
||||
SWAP '|' WITH @SVM IN CartonList
|
||||
|
||||
* Strip out any blank columns or rows left from the edit table
|
||||
|
||||
CartonData = ''
|
||||
CLCnt = COUNT(CartonList,@FM) + (CartonList NE '')
|
||||
FOR I = 1 TO CLCnt
|
||||
UNTIL CartonList<I,1> = ''
|
||||
FOR N = 1 TO 6
|
||||
UNTIL CartonList<I,N,1> = ''
|
||||
CartonData<I,N> = CartonList<I,N>
|
||||
NEXT N
|
||||
NEXT I
|
||||
|
||||
End_Dialog(@WINDOW,CartonData)
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
* * * * * * *
|
||||
Cancel:
|
||||
* * * * * * *
|
||||
|
||||
End_Dialog(@WINDOW,'Cancel')
|
||||
|
||||
RETURN
|
||||
|
||||
|
Reference in New Issue
Block a user