** PCM1122 - MATHPACK CALCULATION MIKE LEWIS 4-07-92 ******************************************************* FUNCTION DEL_MP( MATT_CODE, MPROD_CODE ) LOCAL SAVESEL := SELECT(), DELARR := {}, I LOCAL XXX := GETACTIVE(), SEEKKEY IF EMPTY(XXX) //** P3N - 8/25/98 RETURN .T. //** P3N - 8/25/98 ELSEIF !EMPTY(MATT_CODE) .OR. EMPTY(XXX:ORIGINAL()) RETURN .T. ENDIF SELECT MATHPACK SEEKKEY := MPROD_CODE + XXX:ORIGINAL() SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() AADD(DELARR, RECNO() ) SKIP 1 ENDDO FOR I := 1 TO LEN(DELARR) GOTO DELARR[I] REC_LOCK(1) REPLACE CAT_CODE WITH ' ' DELETE NEXT SELECT (SAVESEL) RETURN .T. ******************************************************* FUNCTION CK_MATH(F_TYPE, CAT_NAME, ATT_NAME, WHEREFROM , SELFILE) LOCAL SCR1122 := SAVESCREEN(), SAVESEL := SELECT() LOCAL MATHSCR, FREEZE_COL, TOPHEADING PRIVATE CUR_CATEGORY := CAT_NAME IF WHEREFROM = NIL *** BUILD THE TEMP MATHPACK FILE IF !F_TYPE$'C' RETURN .T. ENDIF ENDIF IF WHEREFROM = '_SP_CUT' FROM = WHEREFROM CAT_NAME = PRODUCT->PROD_CODE ELSE IF WHEREFROM = '_MISCITEM' FROM = WHEREFROM ****CAT_NAME = (SAVESEL)->UOM ELSE FROM := ' ' ENDIF ENDIF BLDNEWMATH(CAT_NAME, ATT_NAME) DEFINE_MATH(CAT_NAME, ATT_NAME, SELFILE, WHEREFROM ) RESTSCREEN(,,,,SCR1122) RETURN .T. *********************************************************************** PROCEDURE DEFINE_MATH(CAT_NAME, ATT_NAME, SELFILE, WHEREFROM) LOCAL SAVESEL := SELECT(), SAVEORD LOCAL P1,P2,P3,P4,P5,P6,P7,P8,P9,P10 LOCAL ALLOW_APPEND := .T. LOCAL FREEZE_COL := 1 LOCAL LOOKUP := .F. LOCAL SORTPROC := NIL LOCAL SCRNUM := 'CALC' LOCAL CORRECT := .F. LOCAL FINALEDIT LOCAL ALLOK, CORR SELECT MATHPACK DONSETORD(1) SELECT USERFILE5 DONSETORD(0) PRIVATE TBARR := {} * * SET UP 3d ARRAY TO SEND TO DBROWSE * * * IF ATT_NAME = '_MISCITEM' TOPHEADING := {' Define the MATH CALCULATION FOR UOM ' + TRIM(CAT_NAME), ; ' FIELD or Operator FIELD or Command ', ; ' VALUE or (+)/(-) VALUE or (Insert) '} ELSE TOPHEADING := {' Define the MATH CALCULATION FOR FIELD ' + TRIM(ATT_NAME), ; ' FIELD or Operator FIELD or Command ', ; ' VALUE or (+,-,%) VALUE or (Insert) '} ENDIF P1 = 'Line # ' P2 = 'MATH_DISPLINE()' AADD(TBARR, {P1, P2, NIL}) P1 = 'Prior Line ' P2 = 'FIELD1' P3 = 'USERFILE5' P4 = NIL IF EMPTY(SELFILE) P5 = 'CK_M_FIELD(FIELD1, 1,,.T.)' // .T. = CK DECIMAL ELSE P5 = 'CK_M_FIELD(FIELD1, 1,' + '"' + SELFILE +'"' + ',.T.)' ENDIF P6 = '@!' AADD(TBARR, {P1, P2, P3, P4, P5, P6}) P1 = '(*,/) ' P2 = 'OPERATOR' P3 = 'USERFILE5' P4 = NIL P5 = 'CK_M_OPER()' P6 = '!' AADD(TBARR, {P1, P2, P3, P4, P5, P6}) P1 = 'Prior Line ' P2 = 'FIELD2' P3 = 'USERFILE5' P4 = NIL *-P5 = 'CK_M_FIELD(FIELD2, 2)' IF EMPTY(SELFILE) P5 = 'CK_M_FIELD(FIELD2, 2,,.T.)' ELSE P5 = 'CK_M_FIELD(FIELD2, 2,' + '"' + SELFILE +'"' + ',.T.)' ENDIF P6 = '@!' AADD(TBARR, {P1, P2, P3, P4, P5, P6}) P1 = '(Delete) ' P2 = 'M_COMMAND' P3 = 'USERFILE5' P4 = NIL IF EMPTY(SELFILE) P5 = 'CK_M_COMMAND()' ELSE P5 = 'CK_M_COMMAND(' + '"' + SELFILE + '")' ENDIF P6 = '@!' AADD(TBARR, {P1, P2, P3, P4, P5, P6}) * * * SELECT USERFILE5 GOTO TOP * DO WHILE .NOT. CORRECT SELECT USERFILE5 DONSETORD(0) SETCOLOR(LNOR) FINALEDIT := .F. CLEAR TYPEAHEAD DBROWSE(10, 15, MAXROW()-5, 70, ALLOW_APPEND, TBARR, FREEZE_COL, LOOKUP, TOPHEADING, SORTPROC) // CHECK FOR ESCAPE KEY IF LASTKEY() = 27 M1 = ' You have ELECTED TO ESCAPE ' M2 = ' Do you which to DISCARD ' M3 = ' ALL CHANGES??? ' IF !PROMPT_BOX(M1,M2,M3) .AND. LASTKEY() <> 27 // NOT OK TO DISCARD CHANGES LOOP ENDIF CORRECT = .T. ABORTKEY = .T. RESETMP(CAT_NAME, ATT_NAME) LOOP ENDIF * * SETCOLOR(LNOR) FINALEDIT := .T. IF RECCOUNT() = 1 GOTO 1 IF EMPTY(FIELD1) .AND. EMPTY(FIELD2) SELECT USERFILE5 ZAP RESETMP(CAT_NAME, ATT_NAME) CORRECT := .T. LOOP ENDIF ENDIF ALLOK := EDITMATH(CAT_NAME, ATT_NAME, SELFILE, .T.) // .T. = CK VALID DECIMAL IF !ALLOK IF RECNO() <> 1 SKIP -1 ENDIF LOOP ENDIF @ 23,0 CORR := CORRCHEK() IF CORR = 'N' SELECT USERFILE5 IF !ALLOK IF RECNO() <> 1 SKIP -1 ENDIF ENDIF LOOP ELSE CORRECT := .T. IF CORR = 'X' SELECT USERFILE5 ZAP RESETMP(CAT_NAME, ATT_NAME) CORRECT := .T. LOOP ELSE SELECT MATHPACK DONSETORD(1) SELECT USERFILE5 GOTO TOP DO WHILE !EOF() SELECT USERFILE5 MLINE := RECNO() SEEKKEY := CAT_NAME + ATT_NAME + STR(MLINE,4) SELECT MATHPACK SEEK SEEKKEY IF !FOUND() ADD_REC(3) REPLACE CAT_CODE WITH CAT_NAME REPLACE ATT_CODE WITH ATT_NAME REPLACE LINE_NUM WITH MLINE ELSE REC_LOCK(3) REPLACE UPDATED WITH ' ' ENDIF REPLACE FIELD1 WITH UPPER(USERFILE5->FIELD1) REPLACE FIELD1TYPE WITH UPPER(USERFILE5->FIELD1TYPE) REPLACE OPERATOR WITH USERFILE5->OPERATOR REPLACE FIELD2 WITH UPPER(USERFILE5->FIELD2) REPLACE FIELD2TYPE WITH UPPER(USERFILE5->FIELD2TYPE) IF WHEREFROM = '_SP_CUT' REPLACE TYPE WITH 'C' // CUTTING SPEC MATH PACK! ELSE IF WHEREFROM = '_MISCITEM' REPLACE TYPE WITH 'M' // MISC ITEM MATH PACK! ELSE REPLACE TYPE WITH ' ' // CATEGORY CALC FIELD MATH PACK ENDIF ENDIF UNLOCK SELECT USERFILE5 SKIP 1 ENDDO ENDIF ENDIF ENDDO SELECT USERFILE5 ZAP SELECT MATHPACK DELMATHPACK(CAT_NAME, ATT_NAME) DONSETORD(1) IF EMPTY(SELFILE) SELECT USERFILE2 // ATTRIBUTE FILE WHERE YOU WERE! ELSE SELECT &SELFILE ENDIF RETURN ************************************************************ STATIC PROCEDURE DELMATHPACK(CAT_NAME, ATT_NAME) LOCAL DELMATHPK := .F., DELARR := {} LOCAL I, MAC PRIVATE SEEKKEY SEEKKEY := CAT_NAME + ATT_NAME SELECT MATHPACK SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() IF UPDATED <> ' ' REC_LOCK(3) AADD(DELARR, RECNO() ) DELETE DELMATHPK := .T. UNLOCK ENDIF SKIP 1 ENDDO IF DELMATHPK FOR I = 1 TO LEN(DELARR) GOTO DELARR[I] REC_LOCK(1) REPLACE CAT_CODE WITH '' REPLACE ATT_CODE WITH '' UNLOCK NEXT * PACK ENDIF RETURN ******************************************************************* PROCEDURE BLDNEWMATH(CAT_NAME , ATT_NAME) LOCAL SAVESEL := SELECT(), SAVEORD, MAC PRIVATE SEEKKEY SELECT USERFILE5 ZAP SELECT MATHPACK SEEKKEY = CAT_NAME + ATT_NAME SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() REC_LOCK(3) REPLACE UPDATED WITH 'P' UNLOCK SELECT USERFILE5 ADD_ONEREC('MATHPACK','USERFILE5') * APPEND BLANK * REPLACE CAT_CODE WITH MATHPACK->CAT_CODE * REPLACE ATT_CODE WITH MATHPACK->ATT_CODE * REPLACE LINE_NUM WITH MATHPACK->LINE_NUM * REPLACE FIELD1 WITH MATHPACK->FIELD1 * REPLACE FIELD1TYPE WITH MATHPACK->FIELD1TYPE * REPLACE FIELD2 WITH MATHPACK->FIELD2 * REPLACE FIELD2TYPE WITH MATHPACK->FIELD2TYPE * REPLACE OPERATOR WITH MATHPACK->OPERATOR SELECT MATHPACK SKIP 1 ENDDO SELECT USERFILE5 IF RECCOUNT() = 0 APPEND BLANK REPLACE CAT_CODE WITH CAT_NAME REPLACE ATT_CODE WITH ATT_NAME REPLACE LINE_NUM WITH 1 ENDIF SELECT MATHPACK DONSETORD(SAVEORD) SELECT(SAVESEL) RETURN .T. ****************************************************************** STATIC PROCEDURE RESETMP(CAT_NAME, ATT_NAME) LOCAL MAC PRIVATE SEEKKEY SEEKKEY := CAT_NAME + ATT_NAME SELECT MATHPACK SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() IF UPDATED <> ' ' REC_LOCK(3) REPLACE UPDATED WITH ' ' UNLOCK ENDIF SKIP 1 ENDDO RETURN ****************************************************************** ****** ****** FUNCTION CK_MCOMMAND(SELFILE) SELECT USERFILE5 IF !M_COMMAND$'ID ' ERR_BOX( 'VALID COMMANDS ARE: I = Insert',; ' D = Delete') RETURN .F. ENDIF IF M_COMMAND=' ' RETURN .T. ENDIF IF M_COMMAND = 'D' IF RECNO() = 1 GOTOREC := RECNO() - 1 ELSE GOTOREC := 1 ENDIF DELETE PACK GOTO GOTOREC * KEYBOARD CHR(19) RETURN .T. ENDIF IF M_COMMAND = 'I' GOTOREC := RECNO() APPEND BLANK GOTO BOTTOM DO WHILE RECNO() <> GOTOREC SKIP -1 P_SYSNAME := SYSNAME P_FTYPE := FILETYPE P_FNAME := FNAME P_FIELD1 := FIELD1 P_FIELD1TYPE := FIELD1TYPE P_OPERATOR := OPERATOR P_FIELD2 := FIELD2 P_FIELD2TYPE := FIELD2TYPE SKIP 1 REPLACE SYSNAME WITH P_SYSNAME REPLACE FILETYPE WITH P_FTYPE REPLACE FNAME WITH P_FNAME REPLACE FIELD1 WITH P_FIELD1 REPLACE FIELD1TYPE WITH P_FIELD1TYPE REPLACE FIELD2 WITH P_FIELD2 REPLACE FIELD2TYPE WITH P_FIELD2TYPE REPLACE OPERATOR WITH P_OPERATOR REPLACE LINE_NUM WITH RECNO() SKIP -1 ENDDO REPLACE SYSNAME WITH USERFILE->SYSNAME REPLACE FILETYPE WITH MFILETYPE REPLACE FNAME WITH USERFNAME REPLACE FIELD1 WITH SPACE(10) REPLACE FIELD1TYPE WITH SPACE(1) REPLACE FIELD2 WITH SPACE(10) REPLACE FIELD2TYPE WITH SPACE(1) REPLACE OPERATOR WITH ' ' REPLACE LINE_NUM WITH RECNO() REPLACE M_COMMAND WITH ' ' RETURN .T. ENDIF ********************************************************** * FUNCTION CK_M_OPER SELECT USERFILE5 IF OPERATOR$'+-*/%' RETURN .T. ELSE ERR_BOX( '*** INVALID FIELD OPERATOR ***' ,; ' + = Addition, - = Subtraction ' ,; ' * = Multiplication % = Modulus Calc ' ,; ' / = Division') RETURN .F. ENDIF *************************************************************** *- STATIC FUNCTION EDITMATH(CAT_NAME, ATT_NAME, SELFILE, CK_VALDEC) IF CK_VALDEC = NIL CK_VALDEC = .F. ENDIF SELECT USERFILE5 DONSETORD(0) GOTO TOP DO WHILE .NOT. EOF() IF !CK_M_FIELD(USERFILE5->FIELD1, 1, SELFILE, CK_VALDEC) RETURN .F. ENDIF IF !CK_M_OPER() RETURN .F. ENDIF IF !CK_M_FIELD(USERFILE5->FIELD2, 2, SELFILE, CK_VALDEC) RETURN .F. ENDIF SKIP 1 ENDDO DONSETORD(0) RETURN .T. *- *************************************************************** *- FUNCTION MATH_DISPLINE LOCAL RETVAL, CURREC SELECT USERFILE5 CURREC := STR(RECNO(),4 ) RETVAL := 'L' + ALLTRIM(CURREC) + SPACE(10) RETVAL := SUBSTR(RETVAL,1,6) RETURN RETVAL ************************************************************ FUNCTION CK_M_FIELD(CKFLD,FIELDNUM, SELFILE , CK_VALDEC) IF PCOUNT() > 1 ELSE FIELDNUM = 1 ENDIF IF CK_VALDEC = NIL CK_VALDEC = .F. ENDIF IF !CKTHEFIELD(CKFLD,FIELDNUM, SELFILE, CK_VALDEC) RETURN .F. ENDIF RETURN .T. * * * * * * * * * * * * * * * * * * * * * STATIC FUNCTION CKTHEFIELD(CKFLD,FIELDNUM, P_SELFILE, CK_VALDEC) // IE. "WIDTH" ATTRIBUTE + "LENGTH" ATTRIBUTE LOCAL CURREC, SCRNVAR, GOTOREC:=RECNO(), BROW_PICK, SAVESEL := SELECT() LOCAL RESULT, MVALID_FUNC, VFUNC2DO, SAVEFILT LOCAL M_ARR := {}, LOOKUP, ACTION, GOODREC := .F. PRIVATE SELFILE := P_SELFILE IF CK_VALDEC = NIL CK_VALDEC = .F. ENDIF LOOKUP = .F. IF EMPTY(P_SELFILE) SELFILE = 'USERFILE2' ACTION = 'MATH' ELSE **IF SELECT('MISC_ITEMS') > 0 // MISC ITEM DEFINITIONS IF SELFILE = 'USERFILE4' // MISC ITEM DEFINITIONS ACTION = 'MISC' ELSE IF SELFILE = 'USERFILE3' ACTION = 'CUT' ENDIF ENDIF ENDIF M_ARR = SPECIAL_FIELDS(LOOKUP, ACTION) *-M_ARR = SPECIAL_FIELDS(LOOKUP, 'MATH') BROW_PICK = .F. STUFFALIAS = ' ' IF SUBSTR(CKFLD,1,1) = '?' SCRNVAR := SAVESCREEN() LOOKUP = .T. CKFLD = SPECIAL_FIELDS(LOOKUP, ACTION) IF CKFLD <> 'OTHER FIELD LIST' IF FIELDNUM = 1 REPLACE USERFILE5->FIELD1 WITH CKFLD ELSE REPLACE USERFILE5->FIELD2 WITH CKFLD ENDIF ELSE //* don comment out 9-4-97 ****IF ACTION = 'MATH' .OR. ACTION = 'CUT' IF ACTION = 'MATH' SELECT &SELFILE // CURRENT LIST OF ATTRIBUTES TO EDIT SAVEFILT = DBFILTER() SET FILTER TO FIELD_TYPE$'UC' GOTOREC := RECNO() CURFNAME := ATT_CODE IF FIELDNUM = 1 MVALID_FUNC = "VAL_LOOKUP(USERFILE5->FIELD1, SELFILE, @_@, {'ATT_CODE','ATT_DESC(ATT_CODE)'}," MVALID_FUNC=MVALID_FUNC + " 'Y' ,.F., 'USERFILE5->FIELD1'," ELSE MVALID_FUNC = "VAL_LOOKUP(USERFILE5->FIELD2, SELFILE, @_@, {'ATT_CODE','ATT_DESC(ATT_CODE)'}," MVALID_FUNC=MVALID_FUNC + " 'Y' ,.F., 'USERFILE5->FIELD2'," ENDIF MVALID_FUNC=MVALID_FUNC + " {10,20})" VFUNC2DO = SET_VALID(MVALID_FUNC,1) RESULT= &VFUNC2DO IF LASTKEY() = 13 CKFLD = TFILE->ATT_CODE // FORCE CKFLD TO WHAT WAS SELECTED! ENDIF ELSE // ACTION = CUT IF ACTION = 'CUT' ENDIF ENDIF ENDIF RESTSCREEN(,,,,SCRNVAR) KEYBOARD CHR(21) // CONTROL 'U' TO CLEAR THE CURRENT GET FIELD IF ACTION = 'MATH' SELECT &SELFILE // LIST OF ATTRIBUTES UNDER EDIT SET FILTER TO &SAVEFILT GOTO GOTOREC ENDIF SELECT (SAVESEL) // CURRENT MATHPACK UNDER EDIT BROW_PICK = .T. IF LASTKEY() = 27 RETURN .F. ENDIF ENDIF SELECT (SAVESEL) // CURRENT MATHPACK GOODVAR := '' REPVAR := ALLTRIM(CKFLD) NUMDEC := 0 IF LEN(REPVAR) = 0 MATH_FLDERROR() SELECT (SAVESEL) // CURRENT MATHPACK RETURN .F. ENDIF // CHECK FOR ALPHA FIELD (!NUMERIC) FOR I = 1 TO LEN(REPVAR) CKCHAR := SUBSTR(REPVAR,I,1) IF !(CKCHAR$'0123456789-.') I := 999 // NOT A NUMERIC VALUE!!! ELSE IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) GOODVAR := GOODVAR + CKCHAR ELSE IF CKCHAR = '-' IF I = 1 GOODVAR := GOODVAR + CKCHAR ELSE I := 999 // NOT A NUMERIC VALUE!! ENDIF ELSE IF CKCHAR = '.' NUMDEC ++ IF NUMDEC = 1 GOODVAR := GOODVAR + CKCHAR ELSE I := 999 // NOT A NUMERIC VALUE ENDIF ENDIF ENDIF ENDIF ENDIF NEXT // IF < 999, THEN PASSED THE NUMERIC TEST IF I < 999 SELECT (SAVESEL) IF FIELDNUM = 1 REPLACE FIELD1TYPE WITH 'N' ELSE IF FIELDNUM = 2 REPLACE FIELD2TYPE WITH 'N' ENDIF ENDIF IF CK_VALDEC IF VALID_DECIMAL(VAL(CKFLD)) RETURN .T. ELSE RETURN .F. ENDIF ELSE RETURN .T. ENDIF ENDIF //IF REPVAR = 'WIDTH, HEIGHT, UI SIZE, SQFT' // CHECK RESERVED WORD FUNCTION // CHECK FOR PRIOR LINE GOODVAR := '' REPVAR := ALLTRIM(CKFLD) FOR I = 1 TO LEN(REPVAR) CKCHAR := SUBSTR(REPVAR,I,1) IF I = 1 .AND. CKCHAR <> 'L' I := 999 ELSE GOODVAR := GOODVAR + CKCHAR II := I NUMPART := '' DO WHILE II < LEN(REPVAR) II++ CKCHAR := SUBSTR(REPVAR,II,1) IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) GOODVAR := GOODVAR + CKCHAR NUMPART := NUMPART + CKCHAR ELSE II := 999 I := 999 ENDIF ENDDO IF LEN(NUMPART) > 0 IF VAL(NUMPART) >= RECNO() I := 999 ENDIF ENDIF ENDIF NEXT ** IF 1ST CHAR <> L OR OTHER ALPHA, FAILED ABOVE ** ELSE IT WAS A PRIOR LINE AND RETURN .T. IF I < 999 **SELECT USERFILE5 // CURRENT MATHPACK SELECT (SAVESEL) // CURRENT MATHPACK IF FIELDNUM = 1 REPLACE FIELD1TYPE WITH 'P' ELSE IF FIELDNUM = 2 REPLACE FIELD2TYPE WITH 'P' ENDIF ENDIF RETURN .T. ENDIF // CHECK FOR VALID ATTRIBUTE NAME CURREC2 = 1 IF ACTION = 'MATH' SELECT &SELFILE // CURRENT ATTRIBUTE FILE UNDER EDIT CURREC2 := RECNO() LOCATE FOR ALLTRIM(ATT_CODE) == ALLTRIM(CKFLD) .AND. FIELD_TYPE$'UC' IF FOUND() GOODREC = .T. ELSE // SEE IF IT'S A SPECIAL FIELD! IF ASCAN(M_ARR, {|X| X==ALLTRIM(CKFLD) }) > 0 GOODREC = .T. ENDIF ENDIF ELSE IF ACTION = 'CUT' // SEE IF IT'S A SPECIAL FIELD! SELECT ATTRIBUTES SEEK CKFLD IF FOUND() GOODREC := .T. ELSE IF ASCAN(M_ARR, {|X| X==ALLTRIM(CKFLD) }) > 0 GOODREC = .T. ENDIF ENDIF ELSE IF ASCAN(M_ARR, {|X| X==ALLTRIM(CKFLD) }) > 0 GOODREC = .T. ENDIF ENDIF ENDIF IF !GOODREC SELECT &SELFILE // CURRENT ATTRIBUTES UNDER EDIT GOTO CURREC2 SELECT (SAVESEL) // CURRENT MATHPACK MATH_FLDERROR() RETURN .F. ELSE // VALID ATTRIBUTE NAME ENTERED SELECT (SAVESEL) // CURRENT MATHPACK IF FIELDNUM = 1 REPLACE FIELD1TYPE WITH 'F' // DATATYPE OF FIELD ELSE IF FIELDNUM = 2 REPLACE FIELD2TYPE WITH 'F' ENDIF ENDIF IF ACTION = 'MATH' SELECT &SELFILE // CURRENT ATTRIBUTE FILE GOTO CURREC2 ENDIF SELECT (SAVESEL) // CURRENT MATHPACK RETURN .T. ENDIF ****************************************************** PROCEDURE MATH_FLDERROR ERR_BOX( ' Enter an ATTRIBUTE CODE which is ', ; ' "USER ENTERED" or "CALCULATED", ',; ' or L1, L2, etc. for PRIOR LINES.',; ' (Press "?" to Browse Field Names)') KEYBOARD CHR(19) RETURN ******************************************* FUNCTION CK_M_COMMAND(SELFILE) SELECT USERFILE5 IF !M_COMMAND$'IDR ' ERR_BOX( 'VALID COMMANDS ARE: I = Insert',; ' R = Repeat', ; ' D = Delete') RETURN .F. ENDIF IF M_COMMAND=' ' RETURN .T. ENDIF IF SELFILE = NIL SELFILE := 'USERFILE2' ENDIF IF M_COMMAND = 'D' IF RECNO() = 1 GOTOREC := RECNO() - 1 ELSE GOTOREC := 1 ENDIF DELETE PACK GOTO GOTOREC RETURN .T. ENDIF IF M_COMMAND = 'I' GOTOREC := RECNO() APPEND BLANK GOTO BOTTOM DO WHILE RECNO() <> GOTOREC SKIP -1 P_CAT_CODE := CAT_CODE P_ATT_CODE := ATT_CODE P_FIELD1 := FIELD1 P_FIELD1TYPE := FIELD1TYPE P_OPERATOR := OPERATOR P_FIELD2 := FIELD2 P_FIELD2TYPE := FIELD2TYPE SKIP 1 REPLACE CAT_CODE WITH P_CAT_CODE REPLACE ATT_CODE WITH P_ATT_CODE REPLACE FIELD1 WITH P_FIELD1 REPLACE FIELD1TYPE WITH P_FIELD1TYPE REPLACE FIELD2 WITH P_FIELD2 REPLACE FIELD2TYPE WITH P_FIELD2TYPE REPLACE OPERATOR WITH P_OPERATOR REPLACE LINE_NUM WITH RECNO() SKIP -1 ENDDO REPLACE CAT_CODE WITH CUR_CATEGORY **REPLACE ATT_CODE WITH USERFILE2->ATT_CODE REPLACE ATT_CODE WITH (SELFILE)->ATT_CODE REPLACE FIELD1 WITH SPACE(10) REPLACE FIELD1TYPE WITH SPACE(1) REPLACE FIELD2 WITH SPACE(10) REPLACE FIELD2TYPE WITH SPACE(1) REPLACE OPERATOR WITH ' ' REPLACE LINE_NUM WITH RECNO() REPLACE M_COMMAND WITH ' ' RETURN .T. ENDIF IF M_COMMAND = 'R' // REPLICATE GOTOREC := RECNO() APPEND BLANK GOTO BOTTOM DO WHILE RECNO() <> GOTOREC SKIP -1 P_CAT_CODE := CAT_CODE P_ATT_CODE := ATT_CODE P_FIELD1 := FIELD1 P_FIELD1TYPE := FIELD1TYPE P_OPERATOR := OPERATOR P_FIELD2 := FIELD2 P_FIELD2TYPE := FIELD2TYPE SKIP 1 REPLACE CAT_CODE WITH P_CAT_CODE REPLACE ATT_CODE WITH P_ATT_CODE REPLACE FIELD1 WITH P_FIELD1 REPLACE FIELD1TYPE WITH P_FIELD1TYPE REPLACE FIELD2 WITH P_FIELD2 REPLACE FIELD2TYPE WITH P_FIELD2TYPE REPLACE OPERATOR WITH P_OPERATOR REPLACE LINE_NUM WITH RECNO() SKIP -1 ENDDO REPLACE M_COMMAND WITH ' ' RETURN .T. ENDIF RETURN .T. /// ?????? ******************************************* FUNCTION ATT_DESC(MATT_CODE) // RETURN THE DESCRIPTION FOR MATT_CODE LOCAL SAVESEL := SELECT(), RETVAL SELECT ATTRIBUTES SEEK MATT_CODE RETVAL = DESC SELECT(SAVESEL) RETURN RETVAL * * * * * * * * * * * * * * * * * FUNCTION EVAL_MATH(PACKMATH, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) LOCAL X, LASTVAL, I, ELEM PACK2MATH := PACKMATH MATHVALUE := {} FOR I = 1 TO LEN(PACK2MATH) REPVAR1 := ALLTRIM(PACK2MATH[I,1]) OPER := PACK2MATH[I,2] REPVAR2 := ALLTRIM(PACK2MATH[I,3]) LVAR1 := EVAL_FLD(REPVAR1, I, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) LVAR2 := EVAL_FLD(REPVAR2, I, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) CALCSTR := 'LVAR1 ' + OPER + ' LVAR2' AADD(MATHVALUE, &CALCSTR) LASTVAL := MATHVALUE[I] NEXT RETURN LASTVAL * * * * * * * * * * * * * * * * * STATIC FUNCTION EVAL_FLD(REPVAR, ELEM, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) LOCAL MELEM REPVAR = ALLTRIM(REPVAR) NUMPART := '' DO CASE CASE SPEC_FLD(REPVAR, WHEREFROM) // IS IT A SPECIAL FIELD RETURN SPECFLD_VALUE(REPVAR,SELFILE,WHEREFROM) CASE CKNUM(REPVAR) RETURN VAL(REPVAR) CASE CKPRIOR(REPVAR) RETURN MATHVALUE[VAL(NUMPART)] ENDCASE // CHECK FOR ATTRIBUTE VALUE MELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == REPVAR}) IF MELEM > 0 RETURN DECVAL(GET_ARR[MELEM,4]) ENDIF ERR_BOX( 'INVALID REFERENCE IN MATH PACK!!!',; 'CATEGORY -' + ALLTRIM(MCAT_CODE) + ' ATTRIBUTE ' + MATT_CODE,; 'VARIABLE IN ERROR - ' + REPVAR) RETURN 0 ************************************************* FUNCTION SPECFLD_VALUE(MSPEC_FLD, SELFILE) LOCAL LINEFILE := 'ORD_LINES', OR_ARR LOCAL SEEKKEY, RAN_SLID, ADDL_MODE, ITEM_CAT_CODE, IS_ALWAYS_SLID ********************************************************* ***** YOU MUST ALSO UPDATE THE STUFF IN ****** ***** THE "EVAL SPECIAL FIELDS FUNCTION " ****** ***** SPECIAL_FIELDS(LOOK_UP,FROM) LOCATED BELOW. **** ***** ****** ********************************************************* // RETURN THE VALUE OF THE MSPEC_FLD IF SELFILE <> NIL LINEFILE := SELFILE ELSE ? ABEND IF SELECT('USERFILE2') > 0 LINEFILE := 'USERFILE2' ENDIF ENDIF DO CASE CASE MSPEC_FLD = 'WIDTH' RETURN DECVAL(&LINEFILE->WIDTH) CASE MSPEC_FLD = 'HEIGHT' RETURN DECVAL(&LINEFILE->HEIGHT) CASE MSPEC_FLD = "TT WIDTH'" RETURN (LINEFILE)->ACT_WIDTH / 12 CASE MSPEC_FLD = 'TT WIDTH' RETURN (LINEFILE)->ACT_WIDTH CASE MSPEC_FLD = "TT HEIGHT'" RETURN (LINEFILE)->ACT_HEIGHT / 12 CASE MSPEC_FLD = 'TT HEIGHT' RETURN (LINEFILE)->ACT_HEIGHT CASE MSPEC_FLD = 'NOM WIDTH' RETURN (LINEFILE)->NOM_WIDTH CASE MSPEC_FLD = 'NOM HEIGHT' RETURN (LINEFILE)->NOM_HEIGHT CASE MSPEC_FLD = 'UI SIZE' RETURN (LINEFILE)->UI_SIZE CASE MSPEC_FLD = 'SIZE' RETURN (LINEFILE)->ENTRY_SIZE CASE MSPEC_FLD = 'SQFT' RETURN (LINEFILE)->SQFT CASE MSPEC_FLD = 'IN STOCK' RETURN (LINEFILE)->IN_STOCK CASE MSPEC_FLD = 'STD SIZE' RETURN (LINEFILE)->STD_SIZE CASE MSPEC_FLD = 'ORIEL SIZE' RETURN (LINEFILE)->ORIEL_SIZE CASE MSPEC_FLD = 'CMR' IF (LINEFILE)->ORIEL_SIZE$'N' RETURN (LINEFILE)->ACT_HEIGHT / 2 ELSE IF CUR_OO = 'ADDL_OPTS' ADDL_MODE := .T. ELSE ADDL_MODE := .T. ENDIF RAN_SLID := CK_SLIDER(SELFILE, CUR_OO, ADDL_MODE) ITEM_CAT_CODE = GET_CATCODE( (SELFILE)->PROD_CODE) OR_ARR := CK_ORIEL(ITEM_CAT_CODE, SELFILE, CUR_OO, ADDL_MODE, RAN_SLID ) RETURN (LINEFILE)->ACT_HEIGHT - OR_ARR[2] // TOTAL - BOTTOM ENDIF CASE MSPEC_FLD = 'BAL SIZE' .OR. ; //**P3N - 3/24/99 MSPEC_FLD = 'HTLESSBAL' //**P3N - 6/29/01 IF CUR_OO = 'ADDL_OPTS' //**P3N - 3/24/99 ADDL_MODE := .T. //**P3N - 3/24/99 ELSE //**P3N - 3/24/99 ADDL_MODE := .F. //**P3N - 3/24/99 ENDIF //**P3N - 3/24/99 ITEM_CAT_CODE := GET_CATCODE((SELFILE)->PROD_CODE) //**P3N - 3/24/99 RAN_SLID := CK_SLIDER(SELFILE, CUR_OO, ADDL_MODE) //**P3N - 3/24/99 IS_ALWAYS_SLID := ALWAYS_SLIDER(SELFILE, CUR_OO, ADDL_MODE) OR_ARR := CK_ORIEL(ITEM_CAT_CODE, SELFILE, CUR_OO, ADDL_MODE, RAN_SLID, IS_ALWAYS_SLID ) IF MSPEC_FLD = 'BAL SIZE' //**P3N - 6/29/01 IF EMPTY(OR_ARR[3]) //**P3N - 3/24/99 RETURN 0 //**P3N - 3/24/99 ELSE //**P3N - 3/24/99 RETURN VAL(OR_ARR[3]) // BALANCE SIZE //**P3N - 3/24/99 ENDIF ELSE //**P3N - 6/29/01 IF EMPTY(OR_ARR[9]) //**P3N - 6/29/01 RETURN 0 //**P3N - 6/29/01 ELSE //**P3N - 6/29/01 RETURN OR_ARR[9] // DIFF BETWEEN HT AND BAL //**P3N - 6/29/01 ENDIF //**P3N - 6/29/01 ENDIF //**P3N - 6/29/01 CASE MSPEC_FLD = 'SALE PRICE' RETURN (LINEFILE)->SALE_PRICE CASE MSPEC_FLD = 'MODEL' RETURN (LINEFILE)->PROD_CODE CASE MSPEC_FLD = 'ATTACH TO' RETURN (LINEFILE)->PAR_PROD CASE MSPEC_FLD = 'DELIVERY' RETURN (CUR_MAST)->PICK_DEL CASE MSPEC_FLD = 'HOW MEAS' RETURN (LINEFILE)->HOW_MEAS CASE MSPEC_FLD = 'PRICING' RETURN (LINEFILE)->PRICE_SHT CASE MSPEC_FLD = 'QUANTITY' RETURN (LINEFILE)->QUANTITY CASE MSPEC_FLD = 'CATEGORY' RETURN = GET_CATCODE( (LINEFILE)->PROD_CODE ) CASE MSPEC_FLD = 'CUSTOMER' RETURN (CUR_MAST)->CUST_ID CASE MSPEC_FLD = 'ITEM PRICE' RETURN (LINEFILE)->BASE_PRI + ; (LINEFILE)->OPT_PRI + ; (LINEFILE)->EXT_PRICE // ADD ALL PRICE COMPONENTS SO FAR CASE MSPEC_FLD = 'BASE PRICE' RETURN (LINEFILE)->BASE_PRI OTHERWISE ERR_BOX('*** INVALID CALL TO SPEC FIELDS ' , ; '*** Lookup Value was ' + MSPEC_FLD ) RETURN NIL END CASE ********************************************************* ***** YOU MUST ALSO UPDATE THE STUFF IN ****** ***** THE "EVAL SPECIAL FIELDS FUNCTION " ****** ***** SPECFLD_VALUE(MSPEC_FLD) LOCATED ABOVE. ****** ***** ****** ********************************************************* FUNCTION SPECIAL_FIELDS(LOOKUP, FROM) // IF NOT A LOOKUP, RETURN THE SPECIAL FIELD ARRAY // ELSE, CHECK THE FIELD NAME FOR SPECIAL NAME IN RULE OR MATHPACK // M_ARR HOLDS A LIST OF SPECIAL FIELDS PLUS 'OTHER FIELD LIST' // FROM = RULE OR MATH LOCAL M_ARR := {}, NCHOICE := 0, SCRNVAR STATIC MARRMATH STATIC MARROTHER STATIC MARR_CUT STATIC MARR_MISC IF MARR_CUT = NIL MARR_CUT = {} AADD(MARR_CUT, 'BAL SIZE') //** P3N - 3/24/99 AADD(MARR_CUT, 'CMR') AADD(MARR_CUT, 'HTLESSBAL') //** P3N - 6/29/01 AADD(MARR_CUT, 'NOM HEIGHT') AADD(MARR_CUT, 'NOM WIDTH') AADD(MARR_CUT, 'TT HEIGHT') AADD(MARR_CUT, 'TT WIDTH') //* don comment out 9-4-97 **AADD(MARR_CUT, 'OTHER FIELD LIST') ENDIF IF MARR_MISC= NIL MARR_MISC= {} AADD(MARR_MISC, 'HEIGHT') AADD(MARR_MISC, 'WIDTH') ENDIF IF MARRMATH = NIL .OR. MARROTHER = NIL AADD(M_ARR, 'ATTACH TO') AADD(M_ARR, 'BASE PRICE') AADD(M_ARR, 'BAL SIZE') //** P3N - 3/24/99 AADD(M_ARR, 'CATEGORY') AADD(M_ARR, 'CUSTOMER') AADD(M_ARR, 'DELIVERY') AADD(M_ARR, 'HEIGHT') AADD(M_ARR, 'HTLESSBAL') //** P3N - 6/29/01 AADD(M_ARR, 'HOW MEAS') AADD(M_ARR, 'IN STOCK') AADD(M_ARR, 'ITEM PRICE') AADD(M_ARR, 'MODEL') AADD(M_ARR, 'NOM HEIGHT') AADD(M_ARR, 'NOM WIDTH') AADD(M_ARR, 'ORIEL SIZE') AADD(M_ARR, 'PRICING') AADD(M_ARR, 'QUANTITY') AADD(M_ARR, 'SALE PRICE') AADD(M_ARR, 'SIZE') AADD(M_ARR, 'SQFT') AADD(M_ARR, 'STD SIZE') AADD(M_ARR, 'TT HEIGHT') AADD(M_ARR, "TT HEIGHT'") AADD(M_ARR, 'TT WIDTH') AADD(M_ARR, "TT WIDTH'") AADD(M_ARR, 'UI SIZE') AADD(M_ARR, 'WIDTH') MARROTHER := ACLONE(M_ARR) AADD(M_ARR, 'OTHER FIELD LIST') MARRMATH := ACLONE(M_ARR) ENDIF IF FROM = 'MATH' M_ARR := MARRMATH ELSE IF FROM = 'CUT' M_ARR = MARR_CUT ELSE IF FROM = 'MISC' M_ARR := MARR_MISC ELSE M_ARR := MARROTHER ENDIF ENDIF ENDIF IF !LOOKUP RETURN M_ARR ENDIF SCRNVAR := SAVESCREEN() // MSG, SELECT "SQFT", "UI SIZE", "HEIGHT" "WIDTH" OR ITEM FROM THE FOLLOWING LIST DO WHILE .T. NCHOICE = LISTBOX(M_ARR,1,'Select One') IF LASTKEY() = 27 RESTSCREEN(,,,,SCRNVAR) RETURN '' ENDIF IF LASTKEY() = 13 RESTSCREEN(,,,,SCRNVAR) RETURN M_ARR[NCHOICE] ENDIF ENDDO **************************************************** FUNCTION DECVAL(C_NUM) // CONVERT THE CHARACTER STRING M_NUM INTO A DECIMAL VALUE // // FRACTIONS ARE REPRESENTED AS 3/4, 1/8 ........ LOCAL SLASH_POS, SPACE_POS, WHOLE_NUM, FRACTION LOCAL TOP_FRACTION, BOTT_FRACTION, DECIMAL_NUM := 0.0000, SAVE_DEC LOCAL FTPOS, NUMFT, NUMIN FTPOS := AT("'", C_NUM) IF FTPOS = 0 NUMFT := 0 ELSE NUMFT := VAL( SUBS( C_NUM,1,FTPOS ) ) C_NUM := ALLTRIM( SUBS( C_NUM, FTPOS + 1 ) ) ENDIF SLASH_POS = AT('/', C_NUM) IF SLASH_POS = 0 RETURN (NUMFT * 12) + VAL(C_NUM) ENDIF SPACE_POS = AT(' ', C_NUM) IF SPACE_POS > SLASH_POS // NO WHOLE NUMBER! WHOLE_NUM = 0 SPACE_POS = 1 ELSE WHOLE_NUM = VAL(LEFT(C_NUM, SPACE_POS-1)) SPACE_POS++ // POINT TO FIRST FRACTION DIGIT! ENDIF IF SLASH_POS = 0 // NO FRACTION! TOP_FRACTION = 0 ELSE TOP_FRACTION = VAL(SUBSTR(C_NUM, SPACE_POS, SLASH_POS-SPACE_POS)) BOTT_FRACTION = VAL(SUBSTR(C_NUM, SLASH_POS+1)) SET DECIMALS TO 4 DECIMAL_NUM = (TOP_FRACTION * 100) / (BOTT_FRACTION * 100) SET DECIMALS TO 2 ENDIF RETVAL = ( NUMFT * 12 ) + WHOLE_NUM + DECIMAL_NUM RETURN RETVAL ****************************************************