** CGWRULE - ADD/CHG/DEL ATTRIBUTE RULES ** DON LOWENSTEIN 10-25-93 * * * * * * * * * * * * * * * #INCLUDE 'INKEY.CH' *************************************************************** FUNCTION REP_RECNO() REPLACE LINE_NUM WITH RECNO() RETURN .T. *************************************************************** FUNCTION RULE_DISPLINE LOCAL RETVAL, CURREC CURREC := STR(RECNO(),4 ) RETVAL := SUBS( 'L' + ALLTRIM(CURREC) + SPACE(10) , 1, 6) RETURN RETVAL ********************************************************* FUNCTION CK_OPERRULE LOCAL GOODOPER := .F. DO CASE CASE OPERATOR = '==' RETURN .T. CASE OPERATOR = 'LT' RETURN .T. CASE OPERATOR = 'GT' RETURN .T. CASE OPERATOR = 'EQ' RETURN .T. CASE OPERATOR = 'LE' RETURN .T. CASE OPERATOR = 'GE' RETURN .T. CASE OPERATOR = 'NE' RETURN .T. CASE ALLTRIM(OPERATOR) == '<' REPLACE OPERATOR WITH '< ' RETURN .T. CASE ALLTRIM(OPERATOR) == '>' REPLACE OPERATOR WITH '> ' RETURN .T. CASE ALLTRIM(OPERATOR) == '=' REPLACE OPERATOR WITH '= ' RETURN .T. CASE OPERATOR == '<=' RETURN .T. CASE OPERATOR == '>=' RETURN .T. CASE OPERATOR == '<>' RETURN .T. OTHERWISE ERR_BOX( ' *** INVALID FIELD OPERATOR ***' ,; ' "LT" or "<" is LESS THAN ³ "GT" or ">" is MORE THAN ',; ' "LE" or "<=" is LESS THAN or = ³ "GE" or ">=" is GR. or = ',; ' "EQ" or "=" is EQUAL ³ "NE" or "<>" is NOT EQUAL') RETURN .F. ENDCASE ****************************************************************** FUNCTION CK_COMMRULE() IF !LCOMMAND$'ID ' ERR_BOX( 'VALID COMMANDS ARE: I = Insert',; ' D = Delete') RETURN .F. ENDIF IF LCOMMAND=' ' RETURN .T. ENDIF IF LCOMMAND = 'D' IF RECNO() = 1 GOTOREC := RECNO() - 1 ELSE GOTOREC := 1 ENDIF DELETE PACK GOTO GOTOREC RETURN .T. ENDIF IF LCOMMAND = 'I' GOTOREC := RECNO() APPEND BLANK GOTO BOTTOM DO WHILE RECNO() <> GOTOREC SKIP -1 PLINE_NUM := LINE_NUM PLOGIC_GR := LOGIC_GR P_FIELD1 := FIELD1 P_FIELD1TYPE := FIELD1TYPE P_FIELD2TYPE := FIELD2TYPE P_ALIAS1 := ALIAS1 P_OPERATOR := OPERATOR P_FIELD2 := FIELD2 P_ALIAS2 := ALIAS2 PCONT_COND := CONT_COND SKIP 1 REPLACE RULE_CODE WITH RULES->RULE_CODE REPLACE LOGIC_GR WITH PLOGIC_GR REPLACE FIELD1 WITH P_FIELD1 REPLACE FIELD1TYPE WITH P_FIELD1TYPE REPLACE ALIAS1 WITH P_ALIAS1 REPLACE FIELD2 WITH P_FIELD2 REPLACE FIELD2TYPE WITH P_FIELD2TYPE REPLACE ALIAS2 WITH P_ALIAS2 REPLACE OPERATOR WITH P_OPERATOR REPLACE CONT_COND WITH PCONT_COND REPLACE LINE_NUM WITH RECNO() SKIP -1 ENDDO REPLACE RULE_CODE WITH RULES->RULE_CODE REPLACE LOGIC_GR WITH ' ' REPLACE FIELD1 WITH SPACE(10) REPLACE FIELD1TYPE WITH SPACE(1) REPLACE FIELD2 WITH SPACE(10) REPLACE FIELD2TYPE WITH SPACE(1) REPLACE ALIAS1 WITH ' ' REPLACE ALIAS2 WITH ' ' REPLACE OPERATOR WITH ' ' REPLACE CONT_COND WITH ' ' REPLACE LINE_NUM WITH RECNO() REPLACE LCOMMAND WITH ' ' RETURN .T. ENDIF *********************************************************** FUNCTION CK_CONTCOND LOCAL CC1 CC1 := SUBSTR(CONT_COND,1,1) IF CC1 = ' ' REPLACE CONT_COND WITH ' ' RETURN .T. ENDIF IF !CC1$'OA' ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' ERR_BOX( 'VALID CONTINUE CONDITIONS ARE: "A" = "AND" ',; ' (Blank is Also "AND") ',; ' "O" = "OR" ',; ' (See ' + ERRLINE + ') ') RETURN .F. ENDIF CURREC := RECNO() SKIP 1 ERRFLAG := .F. ** LOOK AT THE NEXT RECORD IF EOF() ELSE IF !EMPTY(LOGIC_GR) ERRFLAG := .T. ENDIF ENDIF GOTO CURREC IF ERRFLAG ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' ERR_BOX( ' You May NOT Place a CONTINUATION (And/Or) ',; ' Immediately Preceding a NEW LOGIC GROUP ',; ' or OR" on the LAST LINE. ',; ' (See ' + ERRLINE + ') ') RETURN .F. ENDIF IF CC1 = 'O' REPLACE CONT_COND WITH 'OR ' ELSE IF CC1 = 'A' REPLACE CONT_COND WITH 'AND' ELSE REPLACE CONT_COND WITH ' ' ENDIF ENDIF KEYBOARD CHR(13) RETURN .T. *********************************************************** FUNCTION CK_LOGICGR IF RECNO() = 1 REPLACE LOGIC_GR WITH ' 1' ENDIF IF EMPTY(LOGIC_GR) RETURN .T. ELSE IF LOGIC_GR == 'OR' RETURN .T. ELSE IF VAL(LOGIC_GR) > 0 REPLACE LOGIC_GR WITH STR(VAL(LOGIC_GR),2) RETURN .T. ELSE ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' ERR_BOX( 'VALID LOGIC GROUPS ARE: ',; ' - Numeric Sequence Numbers ',; ' - "OR" (Which Will Combine Logic Groups) ',; ' (See ' + ERRLINE + ') ') RETURN .F. ENDIF ENDIF ENDIF RETURN .T. *********************************************************** PROCEDURE LOGICERR ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' ERR_BOX( 'LOGIC GROUPS (' + ERRLINE + ') ARE OUT OF SEQUENCE ',; ' Please Re-enter with Consecutive ',; ' LOGIC GROUPS or NO LOGIC GROUPS AT ALL! ') RETURN ********************************************************* FUNCTION OPT_VAL_LOOK() // CALLED FROM THE ALIAS2 FIELD LOCAL NCHOICE := 0 LOCAL HEADER := 'Select File' LOCAL CHOICE_ARR := {}, SAVESEL := SELECT() LOCAL SAVESCR := SAVESCREEN(), SAVEORD LOCAL SAVECURSOR := SETCURSOR(), SAVEFILT LOCAL STRT_ROW := 10 LOCAL RETVAL := 10 PRIVATE DISPVAL, FILTERVAL IF FIELD2 == '"SYSTEM "' NCHOICE = 1 ELSE IF FIELD2 == '"CATEGORY"' NCHOICE = 2 ELSE IF FIELD2 == '"MODEL "' NCHOICE = 3 ELSE AADD(CHOICE_ARR, 'SYSTEM ATTRIBUTE Options') AADD(CHOICE_ARR, 'CATEGORY ATTRIBUTE Options') AADD(CHOICE_ARR, 'MODEL ATTRIBUTE Options') NCHOICE = LISTBOX(CHOICE_ARR,1,HEADER, STRT_ROW) IF LASTKEY() = 27 RESTSCREEN(,,,,SAVESCR) SETCURSOR(SAVECURSOR) RETURN .F. ENDIF ENDIF ENDIF ENDIF IF NCHOICE = 1 SELFILE = 'ATT_OPTS' DISPVAL := '"-" + ATT_CODE + " " + OPT_VALUE ' ELSE IF NCHOICE = 2 SELFILE = 'CAT_OPTS' DISPVAL := '"-" + CAT_CODE + " " + OPT_VALUE ' ELSE IF NCHOICE = 3 SELFILE = 'PROD_OPTS' DISPVAL := '"-" + PROD_CODE + " " + OPT_VALUE ' ENDIF ENDIF ENDIF SELECT (SELFILE) SAVEORD := INDEXORD() SAVEFILT := DBFILTER() IF NCHOICE <> 1 DONSETORD(2) ENDIF **SET FILTER TO ATT_CODE == (SAVESEL)->FIELD1 FILTERVAL := 'ATT_CODE == ' + STR(SAVESEL,2) + '->FIELD1' SET FILTER TO &FILTERVAL ***********************GBROWSE( SELFILE ) RETVAL := VAL_LOOKUP((SAVESEL)->FIELD1 + (SAVESEL)->ALIAS2, ; SELFILE, 5, {'ATT_CODE', DISPVAL} , 'Y' ,.F., ; STR(SAVESEL,2) + '->ALIAS2') ******************* SELFILE, 5, {'ATT_CODE', DISPVAL} , 'Y' ,.F., '(SAVESEL)->ALIAS2') SELECT (SELFILE) SET FILTER TO &SAVEFILT DONSETORD(SAVEORD) SELECT (SAVESEL) //** CHECK FOR ENTER OR F10 IF (LASTKEY() = 13 .OR. LASTKEY() = -9 ) .AND. RETVAL IF NCHOICE = 1 REPLACE (SAVESEL)->FIELD2 WITH '"SYSTEM "' ELSEIF NCHOICE = 2 REPLACE (SAVESEL)->FIELD2 WITH '"CATEGORY"' ELSE REPLACE (SAVESEL)->FIELD2 WITH '"MODEL "' ENDIF IF SELECT('TFILE') > 0 REPLACE (SAVESEL)->ALIAS2 WITH TFILE->OPT_VALUE SELECT TFILE USE SELECT (SAVESEL) ELSE REPLACE (SAVESEL)->ALIAS2 WITH (SELFILE)->OPT_VALUE ENDIF REPLACE (SAVESEL)->FIELD2TYPE WITH 'C' ENDIF RETURN RETVAL **************************************************** FUNCTION CK_CAT_MOD() IF FIELD2 = '"CATEGORY"' .OR. FIELD2 = '"MODEL "' ; .OR. FIELD2 = '"SYSTEM "' RETURN .T. ELSE RETURN .F. ENDIF **************************************************** FUNCTION RULE_LINE1() RETURN ' Att Code ' **************************************************** FUNCTION RULE_LINE2() RETURN ' Logic Att. /Option Attribute Cont Line' *********************************************************** ***FUNCTION GETRULES(MRULE_CODE ) // GET ALL RULES THAT APPLY TO THIS ITEM FUNCTION GETRULES(MRULE_CODE, SELFILE, GET_ARR, GET_ELM) ** RETURNS AN ARRAY WITH FIVE ELEMENTS, ONE ELEMENT FOR EACH SET ** OF RULES OF THAT TYPE LOCAL RULEARR, SAVESCR, I, II, CUSTRULES := {}, LOANRULES := {} LOCAL FSRULES := {}, TRRULES := {}, RETVAL, SAVESEL LOCAL LVRULES := {} SAVE SCREEN TO SAVESCR SAVESEL := SELECT() RULEARR := {} SELECT RULES SEEKKEY := MRULE_CODE SEEK SEEKKEY IF !FOUND() ERR_BOX('PRODUCT ' + ALLTRIM((SELFILE)->PROD_CODE) + ' contains the ' + ; 'RULE CODE ' + MRULE_CODE + '! ', ; 'The RULE was NOT FOUND IN the RULES File!', ; 'Define the RULE "' + ALLTRIM(MRULE_CODE) + '" and try again!') ENDIF DO WHILE RULE_CODE == MRULE_CODE .AND. !EOF() RETVAL := FILLRULE() IF !EMPTY(RETVAL) AADD(CUSTRULES, RETVAL) // RETARR ELE 1 ENDIF SELECT RULES SKIP 1 ENDDO SELECT RULES SELECT &SAVESEL RULEARR := CUSTRULES RESTORE SCREEN FROM SAVESCR RETURN RULEARR ****************************************************************** STATIC FUNCTION FILLRULE() LOCAL SEEKKEY, CURRULEPACK := {}, RULEPARMS := {}, LOGICARR := {} LOCAL SUBGRARR := {}, SAVESEL LOCAL TEMPADD := {} SAVESEL := SELECT() SEEKKEY := RULE_CODE SELECT RULEPACK SEEK SEEKKEY FSTREC := .T. LASTSUBGR := 1 CURLG := 0 IF FOUND() ** IF THE LOGIC GROUP IS NOT EMPTY, EITHER NEW LOGIC OR SUBLOGIC GR. ** THE RETURNED ARRAY MUST CONTAIN 1 ELEMENT PER LOGIC GROUP RULEPARMS := {, RULES->RULE_CODE,; RULES->RULE_LT, RULES->AUTO_GRADE,; RULES->RULE_DESC, RULES->SETUP_ID} LASTLG := LOGIC_GR DO WHILE RULE_CODE == SEEKKEY .AND. !EOF() IF !EMPTY(LOGIC_GR) .OR. FSTREC FSTREC := .F. IF LOGIC_GR = 'OR' SUBGR ++ ELSE IF CURLG <> 0 ** ADD THE RULE PACK FOR THE CURRENT SUBGROUP BEFORE ADDING LG AADD(SUBGRARR, {CURRULEPACK, LASTLG}) CURRULEPACK := {} ** LOGICARR CONTAINS 1 ELEMENT FOR EACH ACTUAL LOGIC GROUP AADD(LOGICARR, SUBGRARR) SUBGRARR := {} ENDIF CURLG := VAL(LOGIC_GR) SUBGR := 1 LASTSUBGR := 1 LASTLG := LOGIC_GR ENDIF ENDIF IF SUBGR <> LASTSUBGR ** CONTAINS 1 ELEMENT FOR EACH SUB GROUP (1 OR MORE PER LOGIC GR) ** EACH SUBGROUP ELEMENT WILL CONTAIN ALL RULES FOR THAT SUBGR AADD(SUBGRARR, {CURRULEPACK, LASTLG} ) CURRULEPACK := {} LASTSUBGR := SUBGR LASTLG := LOGIC_GR ENDIF AADD(CURRULEPACK, {FIELD1, OPERATOR, FIELD2, CONT_COND, FIELD1TYPE, FIELD2TYPE, ALIAS1, ALIAS2}) SKIP 1 ENDDO AADD(SUBGRARR, {CURRULEPACK, LASTLG} ) AADD(LOGICARR, SUBGRARR) SELECT &SAVESEL RETURN {RULEPARMS,LOGICARR} ELSE ERR_BOX('RULE CODE ' + SEEKKEY + ' was called for ', ; 'evaluation, but the RULE had NO RULE PACK ', ; 'LINE DEFINITIONS - PRESS ANY KEY TO CONTINUE ') SELECT &SAVESEL RETURN NIL ENDIF ********************************************************************* ** ALL RULES PASSED HERE. ** EVALUATE THE CUST RULES FIRST, THEN THE LOAN RULES ** IF ANY HIT, RETURN .T. TO CALLING PROC (FOR ANCILLARY PROCESS) ** THE NEXT STEP WILL RECEIVE ALL RULES OF A GIVEN TYPE FUNCTION EVALCLRULES(CLRULEARR, WHENFAIL, G_ARR, SELFILE) LOCAL I, RESULT := {}, THISRESULT := .F., HITCUST := .F. PRIVATE CURFILE, FIELDARR PRIVATE FAILFUNC := WHENFAIL PRIVATE GET_ARR := G_ARR PRIVATE RULE_SELFILE := SELFILE *PRIVATE SEEKVAL := SEEKKEY CURFILE := 'C' IF LEN(CLRULEARR[1]) > 0 // PASS WHOLE (L/C) RULE SET TO NEXT HITCUST := EVALRULESET(CLRULEARR[1]) ENDIF // STEP (ALL CUST RULES OR ALL IF HITCUST RETURN .T. ELSE RETURN .F. ENDIF ********************************************************************* ** ALL RULES PASSED HERE. (1ST CUST, THEN LOAN-WILL PROCESS 2 TIMES) ** EVALUATE EACH RULE SEPERATELY AND STORE RESULT IN RESULT ARRAY ** IF THE TOTAL EVALUATION IS TRUE, RETURN .T. TO CALLING FUNCTION ** THE NEXT STEP WILL EVALUATE EACH RULE AND WRITE THE GRADE RECS AS NEEDED FUNCTION EVALRULESET(THISRULEARR) LOCAL I, RESULT := {}, THISRESULT FOR I := 1 TO LEN(THISRULEARR) THISRESULT := EVAL1RULE(THISRULEARR[I]) // PASS THE WHOLE RULE TO NEXT AADD(RESULT, THISRESULT) // STEP IF !THISRESULT EXIT ENDIF NEXT // RESULT ARR 1 ELEMENT FOR EACH *** STRING RESULTS TOGETHER AND // RULE IN THE SET PASSED *** EVALUATE AS A HIT OR NOT ** NOW, EVALUATE THE COMBINED RULES TO SEE IF ANY HITS RETURNVAL := .T. FOR I := 1 TO LEN(RESULT) IF !RESULT[I] // THIS IS A MASSIVE "OR" (ANY FALSE => ALL FALSE) RETURNVAL := .F. ENDIF NEXT RETURN RETURNVAL // RETURNS T/F FOR ALL RULES EVALUATED // IF ANY ONE WAS TRUE, RETURNS TRUE ********************************************************************* ** EACH RULE PASSED HERE (REGARDLESS OF TYPE) ** EVALUATE THIS ONE RULE SINGLELY AND STORE RESULT IN RESULT ARRAY ** IF THIS RULE IS A HIT, WRITE OUT THE GRADE RECORD ** THE NEXT STEP WILL EVALUATE EACH LOGIC GROUP AS REQUIRED STATIC FUNCTION EVAL1RULE(WHOLERULE) LOCAL I, RESULT := {}, THISRESULT, STRVAL := '' LOCAL BAL, COLL, FACT PRIVATE MFILE_TYPE PRIVATE MRULE_LT PRIVATE MAUTOGRADE PRIVATE MRULE_DESC PRIVATE ML2VFACTOR MRULE_CODE := WHOLERULE[1][2] MRULE_DESC := WHOLERULE[1][5] RULE2CK := WHOLERULE[2] FOR I := 1 TO LEN(RULE2CK) // ONE ELEMENT FOR EACH LOGIC GR. THISRESULT := EVALLGGRP(RULE2CK[I]) // ONE LOGIC GROUP AADD(RESULT, THISRESULT) IF !THISRESULT // IF ANY LOGIC GROUP IN THE RULE IS FALSE, RETURN .F. // THE WHOLE RULE IS A NON-HIT ENDIF NEXT ** NOW, EVALUATE THE COMBINED LOGIC GROUPS IN THE RULE EVALSTR := '' STRVAL := '' FOR I := 1 TO LEN(RESULT) IF RESULT[I] STRVAL := '.T.' ELSE STRVAL := '.F.' ENDIF IF I = LEN(RESULT) EVALSTR := EVALSTR + STRVAL ELSE JOINER := '.AND.' EVALSTR := EVALSTR + STRVAL + JOINER ENDIF NEXT IF EVALSTR == '' RETURN .F. ELSE IF &EVALSTR .AND. FAILFUNC <> NIL WRITEFRREC() ENDIF RETURN &EVALSTR // RETURNS T/F FOR ALL LOGIC GROUPS IN THE RULE ENDIF ********************************************************************* ** EACH LOGIC GROUP PASSED HERE. ** EVALUATE LOGIC GROUP SINGLELY AND STORE RESULT IN RESULT ARRAY ** IF COMBINATION OF LOGIC GROUPS HITS, RETURN .T. TO CALLING FUNCTION ** THE NEXT STEP WILL EVALUATE EACH SUB GROUP AS REQUIRED STATIC FUNCTION EVALLGGRP(LGGROUP) LOCAL I, RESULT := {}, THISRESULT LOCAL EVALSTR, JOINER, STRVAL FOR I := 1 TO LEN(LGGROUP) // ONE ELEMENT FOR EACH LOGIC GROUP THISRESULT := EVALSUB(LGGROUP[I]) // PASS EACH SUBGROUP AADD(RESULT, THISRESULT) NEXT ** NOW, EVALUATE THE COMBINED SUB GROUPS IN THE LOGIC GROUP EVALSTR := '' STRVAL := '' FOR I := 1 TO LEN(RESULT) IF RESULT[I] STRVAL := '.T.' ELSE STRVAL := '.F.' ENDIF IF I = 1 EVALSTR := EVALSTR + STRVAL ELSE IF ALLTRIM(LGGROUP[I,2]) = 'OR' // THE LOGIC GROUP VALUE JOINER := '.OR.' ELSE JOINER := '.AND.' ENDIF EVALSTR := EVALSTR + JOINER + STRVAL ENDIF NEXT RETURN &EVALSTR // RETURNS T/F FOR ALL SUBGROUPS IN THE LOGIC GR. ********************************************************************* ** EACH SUB-LOGIC-GROUP PASSED HERE. ** EVALUATE SUB-GROUP SINGLELY AND STORE RESULT IN RESULT ARRAY ** IF COMBINATION OF SUB-LOGIC GROUPS HITS, RETURN .T. TO CALLING FUNCTION ** THE NEXT STEP WILL EVALUATE EACH LINE ITEM AS REQUIRED STATIC FUNCTION EVALSUB(TOTSUBGROUP) LOCAL I, RESULT := {}, THISRESULT LOCAL EVALSTR, JOINER, STRVAL := '', CURLGVAL SUBGROUP := TOTSUBGROUP[1] CURLGVAL := TOTSUBGROUP[2] FOR I := 1 TO LEN(SUBGROUP) // ONE ELEMENT FOR EACH LINE ITEM THISRESULT := EVALLINE(SUBGROUP[I]) // PASS EACH LINE ITEM AADD(RESULT, {THISRESULT, SUBGROUP[I,4]}) // STORE THE CONT_COND W/LINE LI NEXT ** NOW, EVALUATE THE SUB LOGIC GROUP EVALSTR := '' FOR I := 1 TO LEN(RESULT) IF RESULT[I,1] STRVAL := '.T.' ELSE STRVAL := '.F.' ENDIF IF I = LEN(RESULT) EVALSTR := EVALSTR + STRVAL ELSE IF ALLTRIM(RESULT[I,2]) = 'OR' JOINER := '.OR.' ELSE JOINER := '.AND.' ENDIF EVALSTR := EVALSTR + STRVAL + JOINER ENDIF NEXT RETURN &EVALSTR // RETURNS T/F FOR ALL LINES IN SUBGROUP ********************************************************************* ** EACH LINE OF THE FIELD COMPARISON RULE MADE IT TO HERE. ** EVALUATE THE LINE TO THE ACTUAL DATA IN THE PERMCUST/PERMLOAN ** THEN EVALUATE THE RESULT AND RETURN .T. IF THE RULE IS TRUE FOR DATA ** THIS FUNCTION EVALUATES DATA IN THE RECORD AND CALCULATES THE T/F ** VALUE BASED ON THE RULE DEFINITION. ********************************** STATIC FUNCTION EVALLINE(LINEITEM) LOCAL I, RESULT := {}, THISRESULT, REPVAR1, REPVAR2, OPER, CC, ELEM LOCAL MFIELD, SAVESEL := SELECT() PRIVATE AL1 // ALIAS1 := ALLTRIM(LINEITEM[7] PRIVATE AL2 // ALIAS2 := ALLTRIM(LINEITEM[8] PRIVATE LVAR1 := '' ** THIS VERSION KNOWS WHICH DATABASES TO LOOK AT BASED ON THE FILETYPE ** THE SURVEY VERSION WILL HAVE TO SELECT AND SEEK ON THE FLY! REPVAR1 := ALLTRIM(LINEITEM[1]) REPTYPE1 := ALLTRIM(LINEITEM[5]) IF REPTYPE1 = 'C' REPVAR1 = ALLTRIM( STRTRAN(REPVAR1, '"', '') ) ENDIF OPER := LINEITEM[2] REPVAR2 := ALLTRIM(LINEITEM[3]) REPTYPE2 := ALLTRIM(LINEITEM[6]) REPALIAS1 := ALLTRIM(LINEITEM[7]) REPALIAS2 := ALLTRIM(LINEITEM[8]) LVAR1 = '' LVAR2 = '' CC := LINEITEM[4] IF EMPTY(REPTYPE1) .OR. EMPTY(REPTYPE2) ERR_BOX('ERROR DURING RULE EVALUATION - EMPTY FIELDTYPE ' , ; ' The line in error reads as follows ', ; REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; ' PLEASE CORRECT AND RE-RUN THIS PROCESS') RETURN .F. ENDIF // determine value of 1st field to compare // IF IT IS A RANCH SLIDER, THEN REVERSE THE HEIGHT AND WIDTH IF REPVAR1 = 'WIDTH' .OR. REPVAR1 = 'HEIGHT' ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'RANCH SLID' }) IF ELEM > 0 .AND. ALLTRIM(GET_ARR[ELEM,4]) == 'RANCH SLIDER' IF REPVAR1 = 'WIDTH' REPVAR1 = 'HEIGHT' ELSE REPVAR1 = 'WIDTH' ENDIF ENDIF ENDIF IF REPTYPE1 = 'S' LVAR1 = SPECFLD_VALUE( REPVAR1, RULE_SELFILE ) ELSE IF REPTYPE1 = 'A' ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(REPVAR1) }) IF ELEM > 0 LVAR1 = GET_ARR[ELEM,4] //USER_RESP IF GET_ARR[ELEM,2]$'T' REPTYPE1 := 'C' // STRIP THE "V" OFF THE 1ST BYTE OF THE RESULT IF SUBS(LVAR1,1,1)$'V' .AND. ISDIGIT(SUBS(LVAR1,2,1)) LVAR1 := SUBS(LVAR1,2) ENDIF ELSE IF GET_ARR[ELEM,2]$'UC' REPTYPE1 := 'N' LVAR1 := VAL(LVAR1) ELSE REPTYPE1 := 'C' ENDIF ENDIF ELSE ERR_BOX('ERROR DURING EVALUATION OF RULE - (' + MRULE_CODE + ')',; ' ATT_CODE SPECIFIED - NOT FOUND' , ; ' The ATT CODE WAS "' + REPVAR1 + '"' , ; ' The line in error reads as follows ' , ; REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; ' PLEASE CORRECT LINE ITEM - '+STR((CUR_OL)->LINE_NUM)+'/'+(CUR_OL)->PROD_CODE) ENDIF ELSE LVAR1 = '' ERR_BOX('ERROR DURING RULE EVALUATION - INVALID FIELDTYPE1 ' , ; ' The VALUE TO LOOK FOR was ' + REPVAR1 , ; ' The line in error reads as follows ', ; REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; ' PLEASE CORRECT AND RE-RUN THIS PROCESS') RETURN .F. ENDIF ENDIF IF EMPTY(REPTYPE1) .OR. EMPTY(REPTYPE2) ERR_BOX('ERROR DURING RULE EVALUATION - EMPTY FIELDTYPE ' , ; ' The ATT CODE WAS ' + REPVAR1 + ' or ' + REPVAR2 , ; ' The line in error reads as follows ', ; REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; ' PLEASE CORRECT AND RE-RUN THIS PROCESS') RETURN .F. ENDIF IF REPVAR2 = '"CATEGORY"' .OR. REPVAR2 = '"MODEL"' .OR. REPVAR2 = '"SYSTEM"' ; .OR. REPVAR2 = '"MODEL "' .OR. REPVAR2 = '"SYSTEM "' LVAR2 = ALLTRIM(REPALIAS2) REPTYPE2 := 'C' ELSE LVAR2 := REPVAR2 // CHECK FOR NUMERIC DO CASE CASE REPTYPE2 = 'S' //** P3N - 6/29/01 LVAR2 := SPECFLD_VALUE(REPVAR2, RULE_SELFILE) //** P3N - 6/29/01 CASE REPTYPE2 = 'N' LVAR2 = VAL(LVAR2) CASE REPTYPE2 = 'C' LVAR2 = ALLTRIM(STRTRAN(LVAR2,'"', ' ')) CASE REPTYPE2 = 'A' FOR I = 1 TO LEN(GET_ARR) IF ALLTRIM(GET_ARR[I,1]) == REPVAR2 LVAR2 = GET_ARR[I,4] //USER_RESP IF GET_ARR[ELEM,2]$'T' REPTYPE1 := 'C' // STRIP THE "V" OFF THE 1ST BYTE OF THE RESULT IF SUBS(LVAR2,1,1)$'V' .AND. ISDIGIT(SUBS(LVAR2,2,1)) LVAR2 := SUBS(LVAR2,2) ENDIF ELSE IF GET_ARR[I,2]$'UC' REPTYPE2 := 'N' LVAR2 := VAL(LVAR2) ELSE REPTYPE2 := 'C' ENDIF ENDIF EXIT ENDIF NEXT OTHERWISE ERR_BOX('ERROR DURING RULE EVALUATION - INVALID FIELDTYPE2 ' , ; ' The line in error reads as follows ', ; REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; ' PLEASE CORRECT AND RE-RUN THIS PROCESS') RETURN .F. ENDCASE ENDIF // LVAR2 IS SET TO EITHER CHARSTR RESPONSE, NUMERIC OR A BLANK // MAKE LVAR/REPTYPE1 THE SAME AS TYPE2 IF VALTYPE(LVAR1) = 'C' DO CASE CASE REPTYPE2 = 'N' LVAR1 := VAL(LVAR1) // FORCE TO NUMERIC VALUE IN LVAR1 REPTYPE1 := 'N' CASE REPTYPE2 = 'C' // KEEP AS CHAR TO MATCH LVAR2 REPTYPE1 := 'C' CASE REPTYPE2 = ' ' // MAKE BOTH CHARACTER SINCE LVAR1 WAS CHAR REPTYPE1 := 'C' REPTYPE2 := 'C' ENDCASE ELSE IF VALTYPE(LVAR1) = 'N' DO CASE CASE REPTYPE2 = 'N' // KEEP AS NUMERIC SAME AS LVAR1 TYPE REPTYPE1 := 'N' CASE REPTYPE2 = 'C' // FORCE LVAR2 TO NUMERIC TO MATCH LVAR1 LVAR2 := VAL(LVAR2) REPTYPE1 := 'N' REPTYPE2 := 'N' CASE REPTYPE2 = ' ' LVAR2 := 0 REPTYPE1 := 'N' // MAKE BOTH NUMERIC TO MATCH LVAR1 TYPE REPTYPE2 := 'N' ENDCASE ENDIF ENDIF IF REPTYPE1 = 'C' LVAR1 = ALLTRIM( STRTRAN(LVAR1, '"', '') ) ENDIF IF REPTYPE2 = 'C' LVAR2 = ALLTRIM( STRTRAN(LVAR2, '"', '') ) ENDIF VTYPE1 := VALTYPE(LVAR1) VTYPE2 := VALTYPE(LVAR2) ** WHEN COMPARING CHARACTER FIELDS, FORCE TO UPPER CASE IF VTYPE1 = 'C' LVAR1 := UPPER(ALLTRIM(LVAR1)) IF LEN(LVAR1) = 0 LVAR1 := ' ' ENDIF ENDIF IF VTYPE2 = 'C' LVAR2 := UPPER(ALLTRIM(LVAR2)) IF LEN(LVAR2) = 0 LVAR2 := ' ' ENDIF ENDIF IF LEN(TRIM(OPER)) > 1 DO CASE CASE OPER = 'LT' OPER := '< ' CASE OPER = 'GT' OPER := '> ' CASE OPER = 'EQ' OPER := '= ' CASE OPER = 'LE' OPER := '<=' CASE OPER = 'GE' OPER := '>=' CASE OPER = 'NE' OPER := '<>' ENDCASE ENDIF CALCSTR := 'LVAR1 ' + OPER + ' LVAR2' SELECT (SAVESEL) RETURN &CALCSTR ******************************************************* ************************************************** STATIC FUNCTION EVALFLD(REPVAR, REPTYPE, REPALIAS) IF SUBSTR(REPVAR,1) = '"' REPVAR := ALLTRIM(STRTRAN(REPVAR, '"', '')) RETURN ALLTRIM(REPVAR) ELSE IF REPTYPE$'N' RETURN VAL(REPVAR) ELSE IF REPVAR = 'CURDATE' RETURN CURDATE ELSE IF REPTYPE$'F' *-***************************** *-HERE, YOU HAVE TO BE SURE THAT THE ALIAS IS OPEN AND SEEKED *-ON THE PROPER RECORD. THEN RETSTR := TRIM(AL1 OR AL2) + '->' + REPVAR ///////CHECK FOR CUSTOMER RECORD EXIST IN ALIAS, FOR L = 1 TO LEN(ALIAS_LIST) IF TRIM(ALIAS_LIST[L,1]) = TRIM(REPALIAS) .AND. ALIAS_LIST[L,2] REPVAR := REPALIAS + '->' + REPVAR RETURN &REPVAR ENDIF NEXT RETURN NIL ELSE IF REPTYPE$'D' RETURN CTOD(REPVAR) ELSE IF REPTYPE$'C' RETURN ALLTRIM( STRTRAN(REPVAR, '"', '') ) ELSE RETURN NIL ENDIF ENDIF ENDIF ENDIF ENDIF ENDIF ******************************************************* STATIC PROCEDURE UPDATENUMFAIL(MRULE_CODE) LOCAL I, X, SEEKKEY SELECT SURV_HIT SEEKKEY := MRULE_CODE SEEK SEEKKEY DO WHILE RULE_CODE = MRULE_CODE .AND. !EOF() X := 0 SEEKKEY := RULE_CODE + LOCATION SELECT RULEHIT SEEK SEEKKEY DO WHILE RULE_CODE + LOCATION == SEEKKEY X ++ SKIP 1 ENDDO SELECT SURV_HIT REPLACE NUM_FAIL WITH X SKIP 1 ENDDO RETURN ******************************************************* STATIC PROCEDURE WRITEFRREC *** WRITE THE GRADE FAIL RECORD HERE SAVESEL := SELECT() SELECT RULEHIT CLNUM := MASTER->LOCATION SEEKKEY := STR(DESCEND(CURDATE)) + MRULE_CODE ; + SUBSTR(CLNUM+SPACE(20), 1, 20) ; + MRULE_CODE SEEK SEEKKEY IF !FOUND() ADD_REC(3) REPLACE FAIL_DATE WITH CURDATE REPLACE RULE_CODE WITH MRULE_CODE REPLACE LOCATION WITH CLNUM * REPLACE FAIL_RFILE WITH MFILE_TYPE REPLACE FAIL_RCODE WITH MRULE_CODE ENDIF SELECT &SAVESEL RETURN *************************************** FUNCTION CK_IF_NUMERIC(CKFLD) LOCAL GOODVAR := '', I, CKCHAR LOCAL REPVAR := ALLTRIM(CKFLD) // -- FIELD TO VALIDATE LOCAL NUMDEC := 0 ** CHECK FOR ALPHA FIELD (!NUMERIC) FOR I = 1 TO LEN(REPVAR) CKCHAR := SUBSTR(REPVAR,I,1) IF !(CKCHAR$'0123456789-.') I := 999 ELSE IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) GOODVAR := GOODVAR + CKCHAR ELSE IF CKCHAR = '-' IF I = 1 GOODVAR := GOODVAR + CKCHAR ELSE I := 999 ENDIF ELSE IF CKCHAR = '.' NUMDEC ++ IF NUMDEC = 1 GOODVAR := GOODVAR + CKCHAR ELSE I := 999 ENDIF ENDIF ENDIF ENDIF ENDIF NEXT ***IF >= 999, THEN IT WAS AN ALPHA LITERAL STRING ***IF < 999, THEN IT WAS A NUMERIC VALUE IF I < 999 RETURN .T. ELSE RETURN .F. ENDIF *********************************************** ****THIS FUNCTION WILL CHECK FOR THE VALUE **** ** IN THE SPECIAL FIELDS LIST. IF PASSED A UPDATE ** FIELDNAME, THE SPEC_FLDS LOOKUP WILL UPDATE USERFILE2 ** *********************************************** FUNCTION SPEC_FLD(MNAME, WHEREFROM) // CHECK FOR MNAME IN SPECIAL FIELD LIST STATIC SPEC_R_FLDARR STATIC SPEC_C_FLDARR STATIC SPEC_M_FLDARR IF WHEREFROM = NIL WHEREFROM := 'RULE' ENDIF IF SPEC_R_FLDARR = NIL SPEC_R_FLDARR := SPECIAL_FIELDS(.F., 'RULE') // NO LOOKUP, BUT GET ARRAY ENDIF IF SPEC_C_FLDARR = NIL SPEC_C_FLDARR := SPECIAL_FIELDS(.F., 'CUT') // NO LOOKUP, BUT GET ARRAY ENDIF IF SPEC_M_FLDARR = NIL SPEC_M_FLDARR := SPECIAL_FIELDS(.F., 'MISC') // NO LOOKUP, BUT GET ARRAY ENDIF IF WHEREFROM = 'RULE' .AND. ASCAN(SPEC_R_FLDARR, {|X| TRIM(X)==TRIM(MNAME)}) > 0 RETURN .T. ELSE IF WHEREFROM = 'CUT' .AND. ASCAN(SPEC_C_FLDARR, {|X| TRIM(X)==TRIM(MNAME)}) > 0 RETURN .T. ELSE IF WHEREFROM = 'MISC' .AND. ASCAN(SPEC_M_FLDARR, {|X| TRIM(X)==TRIM(MNAME)}) > 0 RETURN .T. ELSE RETURN .F. ENDIF ENDIF ENDIF *********************************************** // CHECKS TO SEE IF THE FIELD IS A SPECIAL FIELD *********************************************** FUNCTION RULE_FIELD(UPDATE_FIELDNAME) **FUNCTION FLD_ERR1(MNAME) // CALLED DURING RULE PACK SETUP LOCAL RESULT, VERIFY_VAL, M2 LOCAL WHCHFLD := RIGHT( ALLTRIM(UPDATE_FIELDNAME) ,1) LOCAL REPTYPEFLD := 'FIELD' + WHCHFLD + 'TYPE' LOCAL SAVESEL := SELECT() VERIFY_VAL := &UPDATE_FIELDNAME IF LASTKEY() = -9 // F10 KEY - NO NEED TO CHECK THIS AGAIN! RETURN .T. ENDIF // CHECK SPECIAL FIELD LIST 1ST IF EMPTY(VERIFY_VAL) .AND. WHCHFLD = '1' ERR_BOX('You MUST Specify an ATTRIBUTE') RETURN .F. ENDIF IF SPEC_FLD(VERIFY_VAL) REPTYPEFLD := 'FIELD' + WHCHFLD + 'TYPE' REPLACE &REPTYPEFLD WITH 'S' RETURN .T. ELSE // BRING UP THE SPECIAL FIELD LIST IF UPDATE_FIELDNAME = NIL ? 'ERROR IN RULE_FIELD IN CGWRULE ' WAIT RETURN .F. ENDIF RESULT = SPECIAL_FIELDS(.T., 'RULE') // LOOK IT UP IF !EMPTY(RESULT) ** SAVESEL = SELECT() ** SELECT USERFILE2 SELECT (SAVESEL) ****REPLACE FIELD1 WITH RESULT REPLACE &UPDATE_FIELD WITH RESULT REPLACE &REPTYPEFLD WITH 'S' ** SELECT(SAVESEL) RETURN .T. ELSE IF VAL_LOOKUP(FIELD1, 'ATTRIBUTES', , {'ATT_CODE', 'DESC'} , 'Y',; .F., STR(SAVESEL,2) + '->FIELD1' ,{4,20,17,52}) ***** .F., 'USERFILE2->FIELD1' ,{4,20,17,52}) REPLACE &REPTYPEFLD WITH 'A' RETURN .T. ELSE IF WHCHFLD = '1' M2 = '' ELSE M2 = 'or a CHARACTER STRING, VALUE, or BLANK' ENDIF ERR_BOX('INVALID ENTRY - SPECIFY AN ATTRIBUTE ', ; M2,; ' PLEASE RE-ENTER') ENDIF ENDIF ENDIF ? 'ERROR IN RULE_FIELD IN CGWRULE ' WAIT RETURN .F. ********************************************************** FUNCTION PE_SPECFLD(FLD2CK) LOCAL SAVESEL := SELECT() LOCAL VERIFY_VAL, RESULT VERIFY_VAL := &FLD2CK IF LASTKEY() = K_F10 RETURN .T. ENDIF IF SPEC_FLD(VERIFY_VAL) RETURN .T. ELSE RESULT = SPECIAL_FIELDS(.T., 'RULE') // LOOK IT UP IF !EMPTY(RESULT) SELECT USERFILE2 REPLACE &FLD2CK WITH RESULT SELECT(SAVESEL) RETURN .T. ENDIF ENDIF RETURN .F. ****************************************************************** *********************************************************************