jsoltys/CGW
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
CGW/CGWMATH.PRG
T
Jason Soltys 7905c43278 first commit
2026-07-14 00:41:31 -05:00

1256 lines
29 KiB
Plaintext
Raw Permalink Blame History

** 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
****************************************************

Reference in New Issue View Git Blame Copy Permalink