COMPILE FUNCTION obj_PRS_Prop(Method,Parms) /* Methods for the PRS_PROP table 05/7/2013 JCH - Initial Coding Properties: Methods: Delete() ;* Deletes Multiple Records */ DECLARE FUNCTION Get_Status, Msg, Utility, obj_Tables, NextKey DECLARE SUBROUTINE Set_Status, Msg, obj_Tables, RList, ErrMsg, Btree.Extract $INSERT MSG_EQUATES $INSERT PRS_STAGE_EQUATES $INSERT PROD_SPEC_EQUATES $INSERT PRS_PROP_EQUATES $INSERT PRS_LAYER_EQUATES ErrTitle = 'Error in Stored Procedure "obj_PRS_Prop"' ErrorMsg = '' 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 = 'GetIntervalFlag' ; GOSUB GetIntervalFlag CASE Method = 'DELETE' ; GOSUB Delete CASE Method = 'GetMeasure' ; GOSUB GetMeasure CASE Method = 'GetMinTarMax' ; GOSUB GetMinTarMax CASE 1 ErrorMsg = 'Unknown Method ':QUOTE(Method):' passed to object.' END CASE IF ErrorMsg NE '' THEN Set_Status(-1,ErrTitle:@SVM:ErrorMsg) RETURN '' END RETURN Result * * * * * * * GetIntervalFlag: * * * * * * * PSNo = Parms[1,@RM] PropCd = Parms[COL2()+1,@RM] CassNo = Parms[COL2()+1,@RM] IF PSNo = '' THEN RETURN IF PropCD = '' THEN RETURN IF CassNo = '' THEN RETURN LSKeys = XLATE('PROD_SPEC',PSNo,PROD_SPEC_PRS_LAYER_KEY$,'X') LSKey = LSKeys[-1,'B':@VM] ;* Get the last or only LSKey LSNo = FIELD(LSKey,'*',2) PSPropRec = XLATE('PRS_PROP',PSNo:'*':LSNo:'*':PropCd,'','X') IF PSPropRec = '' THEN RETURN Interval = PSPropRec Start = PSPropRec BEGIN CASE CASE Interval = 'F' AND CassNo = 1 ; Result = 1 CASE CassNo = Start ; Result = 1 CASE NUM(Interval) IF MOD(CassNo,Interval) - Start = 0 THEN Result = 1 END END CASE RETURN * * * * * * * Delete: * * * * * * * PropKeys = Parms[1,@RM] IF PropKeys = '' THEN RETURN CONVERT @VM:@SVM TO @FM:@FM IN PropKeys OPEN 'PRS_PROP' TO PropFile THEN KeyCnt = COUNT(PropKeys,@FM) + (PropKeys NE '') FOR I = 1 TO KeyCnt DELETE PropFile,PropKeys ELSE NULL NEXT I END RETURN * * * * * * * GetMeasure: * * * * * * * * Method returns Data Sets used in exports and reporting * Mostly for conversion compatibility with labels printing stuff PRSPropKey = Parms[1,@RM] PRSPropRec = Parms[COL2()+1,@RM] IF PRSPropKey = '' THEN RETURN IF PRSPropRec = '' THEN PRSPropRec = XLATE('PRS_PROP',PRSPropKey,'','X') IF PRSPropRec = '' THEN RETURN END Result<1,PRS_PROP_MTOOL$> = PRSPropRec Result<1,PRS_PROP_MTYPE$> = PRSPropRec Result<1,PRS_PROP_MRECIPE$> = PRSPropRec Result<1,PRS_PROP_MFREQ$> = PRSPropRec Result<1,PRS_PROP_MPROVEIN$> = PRSPropRec Result<1,PRS_PROP_MFIRST$> = PRSPropRec Result<1,PRS_PROP_MLAST$> = PRSPropRec Result<1,PRS_PROP_MSPC$> = PRSPropRec Result<1,PRS_PROP_MOVERGROW$> = PRSPropRec Result<1,PRS_PROP_MEXP_TW_QTY$> = PRSPropRec Result<1,PRS_PROP_MPATTERN$> = PRSPropRec Result<1,PRS_PROP_MINTERVAL> = PRSPropRec = PRSPropRec RETURN * * * * * * * * GetMinTarMax: * * * * * * * * PRSPropKey = Parms[1,@RM] PRSPropRec = Parms[COL2()+1,@RM] IF PRSPropKey = '' THEN RETURN IF PRSPropRec = '' THEN PRSPropRec = XLATE('PRS_PROP',PRSPropKey,'','X') IF PRSPropRec = '' THEN RETURN END Prop = FIELD(PRSPropKey,'*',3) Min = PRSPropRec Max = PRSPropRec IF Min NE '' AND Max NE '' THEN Target = Min + ((Max-Min)/2) END ELSE Target ='' END Result<1> = OCONV( Min , '[MET_PROP_CONV,':Prop:']') Result<2> = OCONV( Target , '[MET_PROP_CONV,':Prop:']') Result<3> = OCONV( Max , '[MET_PROP_CONV,':Prop:']') RETURN