// don lowenstein - June 1993 -(preproc) for acd on screen 2100 // all unique procs for the CGW SYSTEM //** #INCLUDE 'CGWINCLD.PRG' // #INCLUDE 'FIVEWIN.CH' #INCLUDE 'INKEY.CH' #INCLUDE 'BOX.CH' ****************************************************************** FUNCTION ACD_ATTRIB_CUT() LOCAL SAVESEL := SELECT() LOCAL SAVESCR := SAVESCREEN() LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' ACD_PAR_CHILD(1, 'Cutting Attribute Definitions', {NIL, 'ATTRIB_CUT', .F. ,,'ADD',,,,,,.F., 'USERFILET'}) ELSE ACD_PAR_CHILD(3, 'Cutting Attribute Definitions', {NIL, 'ATTRIB_CUT', .F. ,,'REV',,,,,,.F., 'USERFILET'}) ENDIF SELECT (SAVESEL) RESTSCREEN(,,,,SAVESCR) RETURN .T. ****************************************************************** FUNCTION CUT_SPEC_DISP(ACTION) // DISPLAYS GB_EXTRA FOR SEQ_NUM IN CUT SPEC FILE LOCAL RETVAL := '' IF !EMPTY(ATT_CODE) IF ACTION = 'PROFILE' RETVAL := DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"PROFILE"}) ELSE RETVAL := DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"PRINT_DESC"}) ** RETVAL := RETVAL + ' ' + DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"DESC"}) RETVAL := DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"DESC"}) ENDIF ENDIF RETURN RETVAL ****************************************************************** FUNCTION SIZE_ERR( ) ERR_BOX( ' Entry Sizes MUST Be HHHWWW ', ; ' For NOMINAL SIZES or 99 X 99 ',; " or 99G Basement or 9'9 Width Only",; ' PLEASE RE-ENTER ') RETURN .T. ****************************************************************** FUNCTION BLANK_1ST( ALLOW, FIELD, ALTPRICE ) // CHECK TO SEE IF BLANK RECORD IS OK IF F10 ON EMPTY 1ST RECORD LOCAL ALLOW_ENTER := .F. //** P3N - 6/30/98 IF EMPTY(ALTPRICE) //** P3N - 6/30/98 ALLOW_ENTER := .F. //** P3N - 6/30/98 ELSEIF ALTPRICE == 'ALT_SPRICE' //** P3N - 6/30/98 ALLOW_ENTER := .T. //** P3N - 6/30/98 ENDIF //** P3N - 6/30/98 IF ALLOW_ENTER //** ALLOW ENTER ON ALT_SPRICE EDIT - P3N - 6/30/98 IF ALLOW .AND. EMPTY(&FIELD) .AND. RECNO() = 1 REPLACE ORDER_NUM WITH ' ' ENDIF RETURN .T. ELSE IF LASTKEY() <> K_F10 RETURN .F. ELSE IF ALLOW .AND. EMPTY(&FIELD) .AND. RECNO() = 1 REPLACE ORDER_NUM WITH ' ' RETURN .T. ELSE RETURN .F. ENDIF ENDIF ENDIF ****************************************************************** FUNCTION DISPCOLOR(ADDL_MODE, REALFILE) // DISPLAY THE COLOR OF PRODUCT ON THE LINE ITEM SCREEN FOR EACH MODEL LOCAL RETVAL, SEEKKEY LOCAL SAVESEL := SELECT() IF REALFILE = NIL REALFILE := 'USERFILE8' // USER ORDER_OPTS / ADDL_OPTS , NOT USERFILE8 ENDIF IF ADDL_MODE = NIL ADDL_MODE := .F. ENDIF IF ADDL_MODE SEEKKEY := &CUR_MAST->ORDER_NUM + PROD_CODE + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' ELSE SEEKKEY := &CUR_MAST->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' ENDIF SELECT (REALFILE) SEEK SEEKKEY IF FOUND() RETVAL := TRIM( (REALFILE)->USER_RESP) ELSE RETVAL := 'N/A' ENDIF SELECT (SAVESEL) RETURN RETVAL ****************************************************************** FUNCTION NEED_CALC(ACTIONCODE, FLD_NAME, UP_RECNO) LOCAL SAVESEL := SELECT(), ADDL_MODE, SEEKKEY STATIC LASTVAL := NIL IF UP_RECNO = NIL UP_RECNO := .F. ENDIF ADDL_MODE := UP_RECNO IF UP_RECNO REPLACE LINE_NUM WITH RECNO() ENDIF IF PROCNAME(1) = 'EDITGBROW' // F10 KEY PRESSED RETURN .T. ENDIF IF ACTIONCODE = 'W' // A BU_WHEN CONDITION LASTVAL := USERFILE2->&FLD_NAME ELSE IF ACTIONCODE = 'V' // VALID_FUNC IF !EMPTY(LASTVAL) // CAN'T CHANGE CERTAIN ITEMS IF LASTVAL == USERFILE2->&FLD_NAME // LEAVE THE NEEDCALC FLAG ALONE! ELSE // DIFFERENT VALUES SELECT USERFILE8 IF ADDL_MODE SEEKKEY := &CUR_MAST->ORDER_NUM + USERFILE2->PROD_CODE + STR(USERFILE2->LINE_NUM,3) ELSE SEEKKEY := &CUR_MAST->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) ENDIF SEEK SEEKKEY IF FOUND() SELECT (SAVESEL) DO CASE // IF SPECIAL PROTECTED FIELD, REVERT TO OLD VALUE - LEAVE CALC FLAG ALONE CASE FLD_NAME == 'PROD_CODE' // CAN'T CHANGE MODEL NUMBER REPLACE USERFILE2->PROD_CODE WITH LASTVAL ERR_BOX( ' You Can NOT Change the MODEL ', ; ' You may DELETE incorrect Line Items ', ; ' Model Changed to Original Value ') CASE FLD_NAME == 'STD_OPTS' // CAN'T CHANGE STD OPTS REPLACE USERFILE2->STD_OPTS WITH LASTVAL ERR_BOX( ' You Can NOT Change the STANDARD OPTIONS FLAG ', ; ' You may DELETE incorrect Line Items ', ; ' SO Changed to Original Value ') OTHERWISE // DIFFERENT VALUE/NON PROTECTED/SET NEEDCALC REPLACE USERFILE2->NEED_CALC WITH 'Y' ENDCASE ELSE /// NO USERFILE8 OPTS FOUND SELECT (SAVESEL) REPLACE USERFILE2->NEED_CALC WITH 'Y' ENDIF ENDIF ELSE // WAS EMPTY LASTVAL - NEED A CALC REPLACE USERFILE2->NEED_CALC WITH 'Y' ENDIF LASTVAL := NIL REPLACE USERFILE2->GL311_AMT WITH ; ( SET_GL311(USERFILE2->PROD_CODE) * USERFILE2->QUANTITY ) ENDIF ENDIF RETURN .T. ****************************************************************** FUNCTION SET_TCALC() LOCAL SAVESEL := SELECT(), SEEKKEY := &CUR_MAST->ORDER_NUM LOCAL SAVEORD, TAGNAME IF &CUR_MAST->NEED_CALC$'Y' .AND. SELECT('USERFILE2') > 0 SELECT USERFILE2 IF FIELDPOS('NEED_CALC') > 0 REPLACE ALL NEED_CALC WITH 'Y' ENDIF ENDIF IF SELECT('USERFILE8') > 0 //** P3N - 5/18/98 SELECT USERFILE8 ZAP ELSE SELECT (CUR_OO) //** P3N - 5/18/98 COPY STRUCTURE TO &USERFILE8 NET_USE( USERFILE8, .T., 3, 'USERFILE8' ) ENDIF //*SELECT ORDER_OPTS SELECT (CUR_OO) SAVEORD := INDEXORD() DONSETORD(1) NDX_EXP = INDEXKEY() SELECT USERFILE8 **INDEX ON &NDX_EXP TO &USERFILE8 IF __DBDRIVER = 'CDX' TAGNAME := 'T1' INDEX ON &NDX_EXP TAG &TAGNAME TO &USERFILE8 ELSE INDEX ON &NDX_EXP TO &USERFILE8 ENDIF //*SELECT ORDER_OPTS SELECT (CUR_OO) DONSETORD(SAVEORD) SELECT (SAVESEL) RETURN .T. ****************************************************************** FUNCTION NEED_TCALC() LOCAL SAVESEL := SELECT() LOCAL LOOKARR, ELEM, I LOCAL DBFVAR, G_ACT_LIST, GA_DBFVAR G_ACT_LIST := GETACTIVE() IF EMPTY(G_ACT_LIST) .OR. EMPTY(GETLIST) RETURN .T. ENDIF I := G_ACT_LIST[2,1] GA_DBFVAR := GETVARS[I,3] DBFVAR := &GA_DBFVAR MEMVAR := GETVARS[I,4] IF EMPTY(&CUR_MAST->NEED_CALC) RETURN .T. ENDIF IF DBFVAR == MEMVAR ELSE REC_LOCK(3) REPLACE &CUR_MAST->NEED_CALC WITH 'Y' UNLOCK ENDIF RETURN .T. ****************************************************************** FUNCTION CGWACD(OPTION, TITLE, WHICHFILE) // OPEN CUST_MAST FILE FOR CUSTOMER SPECIFIC OPTIONS DBOPEN('CUST_MAST', .F.) //** P3N - 3/2/99 // OPEN MATHPACK FILE FOR 'C' FIELDS DBOPEN('MATHPACK', .F.) DO CASE CASE WHICHFILE = 'PRODUCTS' ACD_PAR_CHILD(OPTION, TITLE, {'PRODUCT', 'PROD_ATTS', .T., 3, 'ADD' }) CASE WHICHFILE = 'CATEGORY' ACD_PAR_CHILD(OPTION, TITLE, {'CATEGORY', 'CAT_ATTS', .T., 3, 'ADD' }) ENDCASE RETURN ****************************************************************** FUNCTION CGWPRINT(OPTION, TITLE, WHICHFILE) LOCAL GET_PARMS, PRNT_KEY, CORR_MSG, CORR PRIVATE PAGE_BREAK CLS DO CASE CASE WHICHFILE = 'MODEL OPTIONS' SAYTITLE('Select Model to PRINT', 'PRDI' ) DBOPEN('ATTRIBUTES') GET_PARMS := DBOPEN('PRODUCT') PRNT_KEY = GET_KEY(GET_PARMS, .T.) IF LASTKEY() = 27 CLOSE DATABASES RETURN ENDIF PRNTDISP(OPTION, TITLE, "MODEL OPTIONS") CASE WHICHFILE = 'CATEGORY OPTIONS' SAYTITLE('Select CATEGORY to PRINT', 'PRDI' ) DBOPEN('ATTRIBUTES') GET_PARMS := DBOPEN('CATEGORY') PRNT_KEY = GET_KEY(GET_PARMS, .T.) IF LASTKEY() = 27 CLOSE DATABASES RETURN ENDIF PRNTDISP(OPTION, TITLE, "CATEGORY OPTIONS") CASE WHICHFILE = 'MODEL BASE PRICE' SAYTITLE('Select Model to PRINT', 'PRDI' ) DBOPEN('CATEGORY') GET_PARMS := DBOPEN('PRODUCT') PRNT_KEY = GET_KEY(GET_PARMS, .T.) IF LASTKEY() = 27 CLOSE DATABASES RETURN ENDIF PRNTDISP(OPTION, TITLE, WHICHFILE) CASE WHICHFILE = 'CATEGORY BASE PRICE' SAYTITLE('Select CATEGORY to PRINT', 'PRDI' ) DBOPEN('PRODUCT') GET_PARMS := DBOPEN('CATEGORY') PRNT_KEY = GET_KEY(GET_PARMS, .T.) IF LASTKEY() = 27 CLOSE DATABASES RETURN ENDIF SELECT PRODUCT DONSETORD(3) SEEK CATEGORY->CAT_CODE DONSETORD(1) CORR_MSG := 'PAGE BREAK BETWEEN PRODUCTS? ' PAGE_BREAK := CORRCHEK( 10, CORR_MSG, , 2 ) *- READ() IF LASTKEY() = 27 .OR. PAGE_BREAK$'X' CLOSE DATABASES RETURN ENDIF PRNTDISP(OPTION, TITLE, WHICHFILE) ENDCASE RETURN ****************************************************************** FUNCTION SIZE_CONVERT( MPROD_CODE, IN_HM, OUT_HM, IN_WIDTH, IN_HEIGHT ) LOCAL SAVESEL := SELECT(), RETVAL LOCAL WORKVAR1, WORKVAR2 IF PRODUCT->(DBSEEK(MPROD_CODE)) DO CASE CASE IN_HM = 'OS' IF OUT_HM = 'TT' WORKVAR1 := IN_WIDTH + PRODUCT->OS_WIDTH + PRODUCT->SAW_WIDTH WORKVAR2 := IN_HEIGHT + PRODUCT->OS_HEIGHT + PRODUCT->SAW_HEIGHT RETVAL := {WORKVAR1, WORKVAR2} ELSEIF OUT_HM = 'NS' WAIT_BOX('** NOT ACTIVE FOR "FROM" TT "TO" NS CONVERSIONS YET') ENDIF CASE IN_HM = 'TT' WAIT_BOX('** NOT ACTIVE FOR "FROM" TT CONVERSIONS YET') IF OUT_HM = 'OS' ELSEIF OUT_HM = 'NS' ENDIF CASE IN_HM = 'NS' WAIT_BOX('** NOT ACTIVE FOR "FROM" OS CONVERSIONS YET') IF OUT_HM = 'TT' ELSEIF OUT_HM = 'OS' ENDIF ENDCASE ENDIF RETURN RETVAL * * * * * * * * * * FUNCTION CGW11PRE(WHICHFILE) // GET KEY --- PRODUCT ATTRIBUTE, FOR UPDATING OPTIONS LOCAL RETVAL IF WHICHFILE = 'CATEGORY' RETVAL := { USERFILE2->CAT_CODE, USERFILE2->ATT_CODE } ELSE IF WHICHFILE = 'PRODUCT' RETVAL := { USERFILE2->PROD_CODE, USERFILE2->ATT_CODE } ELSE IF WHICHFILE = 'CUST' RETVAL := { USERFILE3->CUST_ID, USERFILE3->PROD_CODE, USERFILE3->ATT_CODE } ENDIF ENDIF ENDIF RETURN RETVAL ********************************************************** FUNCTION CONT_PROC(M1, M2, M3) /// the system is pointing to the product parent record! LOCAL SEEKKEY := PRODUCT->PROD_CODE IF ( PROD_ATTS->(DBSEEK( SEEKKEY ) ) ) ELSE IF !PROMPT_BOX(M1,M2,M3) CLEAR TYPEAHEAD KEYBOARD CHR(27) INKEY() ENDIF ENDIF RETURN NIL ****************************************************** FUNCTION MAKE_MATH(FILENUM) LOCAL USERFILE := 'USERFILE' + FILENUM LOCAL SAVESEL := SELECT() DBOPEN('PROD_OPTS') DBOPEN('CAT_OPTS') DBOPEN('MATHPACK') IF SELECT('USERFILE5') > 0 SELECT USERFILE5 USE ENDIF SELECT MATHPACK **COPY STRUCT TO &USERFILE5 COPYSTRUCT(USERFILE5, .T.) NET_USE('&USERFILE5', .T., 3, 'USERFILE5') IF SAVESEL > 0 SELECT (SAVESEL) ENDIF RETURN .T. *************************************************************** FUNCTION WHCHPRICE(NCHOICE) STATIC M_ARR @2,0 CLEAR TO 20,80 IF M_ARR = NIL M_ARR := BLD_M_ARR() ENDIF NCHOICE = LISTBOX(M_ARR, NCHOICE, 'Price Sheet') RETURN NCHOICE ************************************************** FUNCTION BLD_M_ARR() LOCAL M_ARR := {} AADD(M_ARR, 'Dealer Price') AADD(M_ARR, 'Special Dealer Price') AADD(M_ARR, 'Builder/Build Stock Price') AADD(M_ARR, 'Lumbermen Price') AADD(M_ARR, 'Distributor Price') AADD(M_ARR, 'Intercompany Price') RETURN M_ARR *************************************************************** PROCEDURE CUSTP_TABLE( ) LOCAL SAVESEL := SELECT(), SAVESCR := SAVESCREEN() LOCAL CUSTID := USERFILE2->CUST_ID LOCAL MPROD := USERFILE2->PROD_CODE LOCAL MTITLE := 'Select CUSTOMER to Copy Pricing for Customer ' + ALLTRIM(CUSTID) + '/'+ALLTRIM(MPROD) LOCAL FILE_CP := 'U'+ ALLTRIM(USERFILE2->PROD_CODE) //** P3N - 2/25/99 LOCAL FILE_CP_SFX := '', PRICEFL := '', ORIGPRFL := '' //** P3N - 2/25/99 LOCAL M1 := 'Customer pricing does not exist for this customer.' LOCAL M2 := ' ' LOCAL M3 := 'Do you want to copy pricing from an existing customer?' LOCAL CPRICENUM := CUST_MAST->CPRICE_NUM IF USERFILE2->BASEFAC <> 0 ERR_BOX('*** Price for this Product ' + MPROD + ' Customer # ' + CUSTID , ; '*** Is Set Up as ' + STR(USERFILE2->BASEFAC,8,4) + '% of DEALER PRICE' ,; '*** NO PRICE TABLE AVAILABLE ') RETURN ENDIF IF !CK_SPEC_PRICE( CUSTID, MPROD, CURDATE, 'USERFILE2' ) ERR_BOX('*** NO SPECIAL Pricing Attributes FOUND', ; '*** or SPECIAL Pricing Is EXPIRED', ; '*** FOR This CUSTOMER - Set ATTS/OPTS 1st') RETURN ENDIF WAIT_BOX('*** Retrieving CUSTOMER PRICE TABLE ***', ; '*** Please Wait ***') IF EMPTY(CPRICENUM) DBOPEN('CONTROL') IF CPRICE_NUM = 999 ERR_BOX('*** 999 Customer Price Tables Defined', ; '*** No More May Be Added - Call Don') USE SELECT(SAVESEL) RETURN ELSE REC_LOCK(1) REPLACE CPRICE_NUM WITH CPRICE_NUM + 1 SELECT CUST_MAST REC_LOCK(1) REPLACE CUST_MAST->CPRICE_NUM WITH CONTROL->CPRICE_NUM UNLOCK CPRICENUM := CUST_MAST->CPRICE_NUM SELECT CONTROL USE ENDIF SELECT (SAVESEL) ENDIF FILE_CP_SFX := STR(CPRICENUM,3) //** P3N - 2/25/99 FILE_CP_SFX := STRTRAN(FILE_CP_SFX, ' ', '0') //** P3N - 2/25/99 PRICEFL := FILE_CP +'.'+FILE_CP_SFX //** P3N - 2/25/99 IF FILE(PRICEFL) //** P3N - 2/26/99 ELSEIF PROMPT_BOX(M1, M2, M3) //** P3N - 2/26/99 @ 00, 00 CLEAR TO 24, 80 //** P3N - 2/26/99 SAYTITLE( MTITLE, 'CUSTPR') //** P3N - 2/26/99 GET_THE_CUST(' ') //** P3N - 2/26/99 FILE_CP_SFX := STR(CUST_MAST->CPRICE_NUM,3) //** P3N - 2/26/99 FILE_CP_SFX := STRTRAN(FILE_CP_SFX, ' ', '0') //** P3N - 2/26/99 ORIGPRFL := FILE_CP +'.'+FILE_CP_SFX //** P3N - 2/25/99 IF FILE(ORIGPRFL) //** P3N - 2/26/99 COPY FILE (ORIGPRFL) TO (PRICEFL) //** P3N - 2/26/99 ENDIF //** P3N - 2/26/99 ENDIF //** P3N - 2/26/99 CUST_MAST->(DBSEEK(CUSTID)) //** P3N - 2/26/99 CGWPRICE( NIL, 'CUSTOMER PRICING - ' + CUSTID + '/' + ALLTRIM(MPROD), ; 99, CUSTID, MPROD, PADL(ALLTRIM(STR(CPRICENUM,3)),3,'0') ) SELECT (SAVESEL) RESTSCREEN(,,,,SAVESCR) RETURN .T. *************************************************************** PROCEDURE CGWPRICE(OPTION, TITLE, PNCHOICE, PPR_CUSTID, PPRODCODE, P_CPRICENUM ) LOCAL MODELPARMS := DBOPEN("PRODUCT"), CORRECT, SAVESCR2 LOCAL MPROD_CODE, L, L2, POINTER, OFFSET, I , II, NUMVARS LOCAL CURVAL, VARYPOS, FLD_ARR, PREFIX LOCAL C_ARR := {}, R_ARR := {}, NEWFILE, NCHOICE LOCAL COL_ARR := {}, ROW_ARR := {}, FILE1, FILE2 LOCAL SEEKKEY, MFILE, DESC_ARR := {}, CHK_BLOCK, DBNAME LOCAL CNTR, COUNT_ARR := {}, NUM_2_DO, MCODE LOCAL NTOP, NLEFT, NRIGHT, NBOTTOM, TBARR := {} LOCAL NUM_DONE, SAVESCR, LOOPKEY, MPRICE_SHEET LOCAL REAL_FILE, OLDDESC_ARR := {}, MSG LOCAL OLDDBF_ARR, NEWDBF_ARR, DIFFERENT, OLD_MFILE := '' LOCAL MPERCENT, MCHOICE, OLD_PRICE_CD := '', CORR LOCAL SV_SEL, SV_ORD, DLR_FILE, SV_REAL_FILE LOCAL DESC_SIZE := 50, ELEM LOCAL P1, P2, P3, P4, COPYTO LOCAL PR_CUSTID := PPR_CUSTID LOCAL CPRICENUM := P_CPRICENUM STATIC FILESOPEN, M_ARR, ALL_PR_ARR := {} IF PR_CUSTID = NIL PR_CUSTID := SPACE(8) ENDIF //** P3N - 01/02/02 HAPPY NEW YEAR - LINDA //**IF FILESOPEN = NIL .OR. SELECT('CAT_OPTS') = 0 DBOPEN('ATTRIBUTES') DBOPEN('ATT_OPTS') DBOPEN('CUST_ATTS') DONSETORD(2) // CUSTID + PROD_CODE + ORDER DBOPEN('CUST_OPTS') DBOPEN('PROD_ATTS') DONSETORD(2) // PROD_CODE + ORDER DBOPEN('PROD_OPTS') DBOPEN('CAT_ATTS') DONSETORD(2) // CAT_CODE + ORDER DBOPEN('CAT_OPTS') FILESOPEN = .T. //**ENDIF IF EMPTY(M_ARR) M_ARR := BLD_M_ARR() ENDIF SAVESCR = SAVESCREEN() DO WHILE .T. IF PNCHOICE = NIL .OR. PNCHOICE = 99 // MENU OPTION FOR UPDATE PRICE TABLES - PRODUCT OR CUSTOMER CLS SAYTITLE(TITLE,'PRPO') IF PNCHOICE = NIL MPROD_CODE := {GET_KEY( GET_FILEPARM("PRODUCT") )} IF LASTKEY() = 27 CLOSE DATABASES RETURN ENDIF ELSE MPROD_CODE := {PPRODCODE} ENDIF ELSE RESTSCREEN(,,,,SAVESCR) ENDIF DO WHILE .T. IF PNCHOICE = NIL NCHOICE := WHCHPRICE(1) IF LASTKEY() = 27 EXIT ENDIF ELSE NCHOICE := PNCHOICE ENDIF IF NCHOICE = 99 MPRICE_SHEET = 'U' // USER SPECIFIC CUSTOMER PRICING ELSE MPRICE_SHEET = LEFT(M_ARR[NCHOICE],1) ENDIF IF NCHOICE = 5 // IF IT'S DISTRIBUTOR MPRICE_SHEET = 'J' // USE 'J' FOR THE CODE! (JOBBER) ENDIF IF PNCHOICE <> NIL .AND. PNCHOICE <> 99 //PRINT THE BASE PRICE RPT MFILE := PRODUCT->PROD_CODE REAL_FILE := STRTRAN(ALLTRIM(MFILE), ' ', '_') REAL_FILE := STRTRAN(REAL_FILE, '-', '_') SV_REAL_FILE := REAL_FILE REAL_FILE := MPRICE_SHEET + REAL_FILE DLR_FILE := 'D' + SV_REAL_FILE RETURN {REAL_FILE, DLR_FILE, MPRICE_SHEET} ELSE // CALLED FROM A MENU / UPDATE SCREEN IF PNCHOICE = NIL // REGULAR PRICING BUILD TABLE FROMMENU MSG = M_ARR[NCHOICE] ELSE MSG = '' // CUSTOMER SPECIFIC PRICING ENDIF MFILE = MPROD_CODE[1] MCODE = MFILE REAL_FILE = STRTRAN(ALLTRIM(MFILE), ' ', '_') REAL_FILE = STRTRAN(REAL_FILE, '-', '_') REAL_FILE = MPRICE_SHEET + REAL_FILE PREFIX := REAL_FILE IF PNCHOICE = NIL REAL_FILE = REAL_FILE + '.DBF' ELSE REAL_FILE = REAL_FILE + '.' + CPRICENUM ENDIF ENDIF // SEE IF IT'S THE SAME ONE TO DO, IF NOT BUILD THE STUFF FROM SCRATCH ELEM := ASCAN(ALL_PR_ARR, {|X| X[1] == REAL_FILE .AND. X[5] == PR_CUSTID} ) IF ELEM > 0 FLD_ARR := ALL_PR_ARR[ELEM,2] MFILE := ALL_PR_ARR[ELEM,3] DESC_ARR := ALL_PR_ARR[ELEM,4] ELSE SEEKKEY = MCODE // SEEK SO THE PERCENT OF DEALER STUFF IS ALWAYS VISIBLE IF !EMPTY(PR_CUSTID) SELECT CUST_ATTS FILE1 = 'CUST_ATTS' FILE2 = 'CUST_OPTS' DBNAME = 'CUST_ID + PROD_CODE' SEEKKEY := PR_CUSTID + MCODE CUST_ATTS->(DBSEEK(SEEKKEY)) IF CUST_ATTS->(FOUND()) ELSE **********ERR_BOX('*** Customer Price table NOT FOUND! Pricing table/attributes', ; ********** '*** will be copied from the MODEL. You MUST save (F10) these', ; ********** '*** table/attributes to ensure accurate Price table creation!') ENDIF ENDIF IF EMPTY(PR_CUSTID) .OR. !FOUND() SEEKKEY = MCODE SELECT PROD_ATTS FILE1 = 'PROD_ATTS' FILE2 = 'PROD_OPTS' DBNAME = 'PROD_CODE' SEEK SEEKKEY IF !FOUND() SELECT CAT_ATTS SEEK SEEKKEY FILE1 = 'CAT_ATTS' FILE2 = 'CAT_OPTS' DBNAME = 'CAT_CODE' ENDIF ENDIF * SEEKKEY = MCODE * * SELECT PROD_ATTS * FILE1 = 'PROD_ATTS' * FILE2 = 'PROD_OPTS' * DBNAME = 'PROD_CODE' * SEEK SEEKKEY * IF !FOUND() ** SELECT PRODUCT ** SEEK SEEKKEY ** MCODE = CAT_CODE ** SEEKKEY = MCODE * * SELECT CAT_ATTS * SEEK SEEKKEY * /// IF STILL NOT FOUND, DO MESSAGE THEN RETURN! * FILE1 = 'CAT_ATTS' * FILE2 = 'CAT_OPTS' * DBNAME = 'CAT_CODE' * ENDIF // SITTING ON FILE1, EITHER PRODUCTS OR CATEGORY FILE OR CUST_ATTS FILE // SHOULD HAVE FOUND AN APPROPRIATE RECORD C_ARR := {} R_ARR := {} DO WHILE SEEKKEY == &DBNAME .AND. !EOF() IF !EMPTY(PR_CUSTID) IF LINK_CODE$'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_CODE$'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF ELSE DO CASE CASE NCHOICE = 1 IF LINK_CODE = 'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_CODE = 'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF CASE NCHOICE = 2 IF LINK_SD = 'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_SD = 'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF CASE NCHOICE = 3 IF LINK_BU = 'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_BU = 'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF CASE NCHOICE = 4 IF LINK_LU = 'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_LU = 'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF CASE NCHOICE = 5 IF LINK_DI = 'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_DI = 'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF CASE NCHOICE = 6 IF LINK_IN = 'C' AADD(C_ARR, ATT_CODE) ELSE IF LINK_IN = 'R' AADD(R_ARR, ATT_CODE) ENDIF ENDIF END CASE ENDIF SKIP 1 ENDDO // IF EMPTY C_ARR OR R_ARR, DO MESSAGE THEN RETURN LOOPKEY = .F. IF EMPTY(C_ARR) .OR. EMPTY(R_ARR) IF MPRICE_SHEET$'D' ERR_BOX( ' CANNOT find all ROW or COLUMN Information ', ; ' for the ' + TRIM(MFILE) + ' Model! ', ; ' Please Set them up in MODEL DEFINITIONS') LOOPKEY = .T. LOOP ELSE IF NCHOICE = 99 // CUSTOMER PRICING MPERCENT = USERFILE2->BASEFAC IF MPERCENT = 0 ERR_BOX( ' CANNOT find all ROW or COLUMN Information ', ; ' for Model ' + TRIM(MFILE) + ' Customer ' + PR_CUSTID, ; ' and the % of DEALER was 0.00 ', ; ' Please Set them up in CUSTOMER PRICING') RETURN ENDIF ELSE SELECT PRODUCT DO CASE CASE NCHOICE = 2 MPERCENT = SD_BASEFAC CASE NCHOICE = 3 MPERCENT = BU_BASEFAC CASE NCHOICE = 4 MPERCENT = LU_BASEFAC CASE NCHOICE = 5 MPERCENT = DI_BASEFAC CASE NCHOICE = 6 MPERCENT = IN_BASEFAC ENDCASE CORRECT := .F. DO WHILE !CORRECT @ 10,10 SAY 'Dealer Price Percentage' GET MPERCENT PICTURE '999.9999' READ() IF LASTKEY() = 27 CORRECT := .T. EXIT ENDIF CORR := CORRCHEK() IF CORR = 'N' LOOP ELSE CORRECT := .T. IF CORR = 'Y' SELECT PRODUCT REC_LOCK(1) DO CASE CASE NCHOICE = 2 REPLACE SD_BASEFAC WITH MPERCENT CASE NCHOICE = 3 REPLACE BU_BASEFAC WITH MPERCENT CASE NCHOICE = 4 REPLACE LU_BASEFAC WITH MPERCENT CASE NCHOICE = 5 REPLACE DI_BASEFAC WITH MPERCENT CASE NCHOICE = 6 REPLACE IN_BASEFAC WITH MPERCENT END CASE UNLOCK ENDIF ENDIF ENDDO ENDIF LOOP ENDIF ENDIF // IF IT GOT THIS FAR THEN IT'S GOING TO BE A PRICE TABLE // NEED TO ZERO OUT ANY OLD PERCENTAGE AMOUNT FOR THIS TYPE SELECT PRODUCT REC_LOCK(1) DO CASE CASE NCHOICE = 2 REPLACE SD_BASEFAC WITH 0 CASE NCHOICE = 3 REPLACE BU_BASEFAC WITH 0 CASE NCHOICE = 4 REPLACE LU_BASEFAC WITH 0 CASE NCHOICE = 5 REPLACE DI_BASEFAC WITH 0 CASE NCHOICE = 6 REPLACE IN_BASEFAC WITH 0 END CASE UNLOCK SELECT (FILE2) COL_ARR := {} FOR L = 1 TO LEN(C_ARR) AADD(COL_ARR, {}) // MAKE ARRAY BUCKET FOR CURRENT ATTRIBUTE IF !EMPTY(PR_CUSTID) CHK_BLOCK = {|| CUST_ID + PROD_CODE + ATT_CODE} SELECT CUST_OPTS FILE2 = 'CUST_OPTS' SEEKKEY = PR_CUSTID + MPROD_CODE[1] + C_ARR[L] SEEK SEEKKEY ENDIF IF EMPTY(PR_CUSTID) .OR. !FOUND() // CHECK PRODUCT LEVEL NEXT SELECT PROD_OPTS CHK_BLOCK = {|| PROD_OPTS->PROD_CODE + PROD_OPTS->ATT_CODE} SEEKKEY = MPROD_CODE[1] + C_ARR[L] // MODEL + ATTRIBUTE SEEK SEEKKEY IF !FOUND() // CHECK CATEGORY LEVEL NEXT SELECT CAT_OPTS SEEKKEY = PRODUCT->CAT_CODE + C_ARR[L] // CAT CODE + ATTRIBUTE SEEK SEEKKEY CHK_BLOCK = {|| CAT_OPTS->CAT_CODE + CAT_OPTS->ATT_CODE} ENDIF IF !FOUND() // CHECK ATTRIBUTE LEVEL NEXT SELECT ATT_OPTS SEEKKEY = C_ARR[L] // ATTRIBUTE SEEK SEEKKEY CHK_BLOCK = {|| ATT_OPTS->ATT_CODE} ENDIF ENDIF DO WHILE SEEKKEY == EVAL(CHK_BLOCK) .AND. !EOF() AADD(COL_ARR[L], ALLTRIM(OPT_VALUE) ) SKIP 1 ENDDO NEXT // IF EMPTY COL_ARR, DO MESSAGE THEN RETURN LOOPKEY = .F. FOR L = 1 TO LEN(COL_ARR) IF EMPTY(COL_ARR[L]) ERR_BOX( ' CANNOT find COLUMN OPTION Info' , ; ' for the ' + TRIM(MFILE) + ' Model! ', ; ' Please Set them up in DEFAULT OPTIONS') LOOPKEY = .T. IF EMPTY(PR_CUSTID) LOOP ELSE RETURN ENDIF ENDIF NEXT IF LOOPKEY LOOP ENDIF ROW_ARR := {} FOR L = 1 TO LEN(R_ARR) AADD(ROW_ARR, {}) // MAKE ARRAY BUCKET FOR CURRENT ATTRIBUTE IF !EMPTY(PR_CUSTID) CHK_BLOCK = {|| CUST_ID + PROD_CODE + ATT_CODE} SELECT CUST_OPTS FILE2 = 'CUST_OPTS' SEEKKEY = PR_CUSTID + MPROD_CODE[1] + R_ARR[L] SEEK SEEKKEY ENDIF IF EMPTY(PR_CUSTID) .OR. !FOUND() // CHECK IT AT THE PRODUCT LEVEL SELECT PROD_OPTS DONSETORD(1) // PROD_CODE + ATT_CODE CHK_BLOCK = {|| PROD_OPTS->PROD_CODE + PROD_OPTS->ATT_CODE} SEEKKEY = MPROD_CODE[1] + R_ARR[L] SEEK SEEKKEY IF !FOUND() // CHECK IT AT THE CATEGORY LEVEL SELECT CAT_OPTS DONSETORD(1) // CAT_CODE + ATT_CODE SEEKKEY = PRODUCT->CAT_CODE + R_ARR[L] // CAT ATTT + ATTRIBUTE SEEK SEEKKEY CHK_BLOCK = {|| CAT_OPTS->CAT_CODE + CAT_OPTS->ATT_CODE} ENDIF IF !FOUND() // CHECK ATTRIBUTE LEVEL NEXT SELECT ATT_OPTS SEEKKEY = R_ARR[L] // ATTRIBUTE SEEK SEEKKEY CHK_BLOCK = {|| ATT_OPTS->ATT_CODE} ENDIF ENDIF DO WHILE SEEKKEY == EVAL(CHK_BLOCK) .AND. !EOF() AADD(ROW_ARR[L], ALLTRIM(OPT_VALUE) ) SKIP 1 ENDDO NEXT // IF EMPTY ROW_ARR, DO MESSAGE THEN RETURN LOOPKEY = .F. FOR L = 1 TO LEN(ROW_ARR) IF EMPTY(ROW_ARR[L]) ERR_BOX( ' CANNOT find ROW OPTION Info' , ; ' for the ' + TRIM(MFILE) + ' Model! ', ; ' Please Set them up in DEFAULT OPTIONS') LOOPKEY = .T. LOOP ENDIF NEXT IF LOOPKEY LOOP ENDIF // BUILD FIELD LIST FLD_ARR := {} AADD(FLD_ARR, {'DESC', DESC_SIZE, 'C', 0}) // ADD REQUIRED FIELD FIRST! FOR L = 1 TO LEN(COL_ARR) FOR L2 = 1 TO LEN(COL_ARR[L]) VAR = COL_ARR[L,L2] VAR = STRTRAN(ALLTRIM(VAR), ' ', '_') VAR = STRTRAN(VAR, '-', '_') // NO NUMERICS IN FIRST CHARACTER! IF ISDIGIT(LEFT(VAR,1)) VAR = 'V' + VAR ENDIF // VAR CAN'T BE LONGER THAN 10 BYTES!!! VAR = LEFT(VAR+SPACE(10), 10) AADD(FLD_ARR, {VAR, 7, 'N', 2 } ) NEXT NEXT AADD(FLD_ARR, {'COL_HEAD1', 15, 'C', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'COL_HEAD2', 15, 'C', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'COL_HEAD3', 15, 'C', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'CUST_ID', 8, 'C', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'DATE_STAMP', 8, 'D', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'TIME_STAMP', 5, 'C', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'USER_STAMP', 8, 'C', 0}) // ADD REQUIRED FIELD FIRST! AADD(FLD_ARR, {'UPDATED', 1, 'C', 0}) // ADD REQUIRED FIELD FIRST! NUMVARS := LEN(ROW_ARR) // SET UP THE 'DESC' FIELD VALUES DESC_ARR := {} ROWVARS := {} CURVAL := {} NUM_2_DO = 1 FOR I = 1 TO NUMVARS // IE 3 ROW VARIABLES NUM_2_DO = NUM_2_DO * LEN(ROW_ARR[I]) // IE 2 VALUES OF EACH VARIABLE AADD(ROWVARS, LEN(ROW_ARR[I]) ) // IE # VALUES FOR THIS ATTRIBUTE AADD(CURVAL, 1) // IE CURRENT VALUE POINTER FOR THIS ATTRIBUTE NEXT FOR L = 1 TO NUM_2_DO // CREATE EMPTY ARRAY AADD(DESC_ARR, '') NEXT // MAKE ONE DESCVAR FOR EACH COMBINATION OF ALL ELEMENTS // IE. FACTORIAL(ROW_ARR) VARYPOS := NUMVARS POINTER := 0 FOR I := 1 TO NUM_2_DO / ROWVARS[NUMVARS] // IE 3 ATTRIBUTES FOR II := 1 TO ROWVARS[NUMVARS] // IE 2 CHOICES EACH ATTRIB POINTER ++ CURVAL[NUMVARS] := II DESC_ARR[POINTER] := BLD_PRICE_LINE(ROW_ARR, CURVAL ) NEXT FOR III := NUMVARS-1 TO 1 STEP -1 IF CURVAL[III] < ROWVARS[III] CURVAL[III] ++ EXIT ELSE CURVAL[III] := 1 ENDIF NEXT NEXT AADD(ALL_PR_ARR, {REAL_FILE, FLD_ARR, MFILE, DESC_ARR, PR_CUSTID} ) ENDIF DIFFERENT = .F. REAL_FILE = STRTRAN(ALLTRIM(MFILE), ' ', '_') REAL_FILE = STRTRAN(REAL_FILE, '-', '_') REAL_FILE = MPRICE_SHEET + REAL_FILE IF CPRICENUM = NIL REAL_FILE = REAL_FILE + '.DBF' ELSE REAL_FILE = REAL_FILE + '.' + CPRICENUM ENDIF ** IF !FILE(REAL_FILE + '.DBF') IF !FILE(REAL_FILE ) NEWFILE = .T. ELSE // SEE IF STRUCTURE HAS CHANGED NEWFILE = .F. DIFFERENT = .F. SET EXACT ON NET_USE(REAL_FILE, .T., 5, 'REAL_FILE') OLDDBF_ARR = ASORT(DBSTRUCT(),,, {|X,Y| X[1] < Y[1]}) // GET OLD STRUCTURE NEWDBF_ARR = ASORT(ACLONE(FLD_ARR),,, {|X,Y| X[1] < Y[1]}) IF LEN(OLDDBF_ARR) <> LEN(NEWDBF_ARR) DIFFERENT = .T. ELSE FOR L = 1 TO LEN(OLDDBF_ARR) IF OLDDBF_ARR[L,1] <> NEWDBF_ARR[L,1] DIFFERENT = .T. EXIT ENDIF NEXT ENDIF // SEE IF THE 'DESC' FIELD VALUES HAVE CHANGED! OLDDESC_ARR := {} DO WHILE !EOF() AADD(OLDDESC_ARR, ALLTRIM(DESC) ) SKIP 1 ENDDO IF LEN(OLDDESC_ARR) <> LEN(DESC_ARR) DIFFERENT = .T. ELSE FOR L = 1 TO LEN(OLDDESC_ARR) IF PADR(OLDDESC_ARR[L],DESC_SIZE) = PADR(DESC_ARR[L],DESC_SIZE) ELSE DIFFERENT = .T. EXIT ENDIF NEXT ENDIF SET EXACT OFF IF DIFFERENT IF PROMPT_BOX ('PRICE TABLE &/or OPTS for - ' + ALLTRIM(MFILE) + ' '+ ; 'Have Possibly Changed!', ; //** P3N - 3/08/00 '"YES" TO USE THE EXISTING ' + REAL_FILE, ; //** P3N - 3/08/00 'To RESTORE ORIGINAL FILE - copy '+ ; //** P3N - 3/08/00 ALLTRIM(PREFIX) + '.OLD to ' + REAL_FILE, 1) //** P3N - 3/08/00 SELECT REAL_FILE //** P3N - 3/08/00 DIFFERENT := .F. //** P3N - 3/08/00 FLD_ARR := DBSTRUCT() //** GET CURRENT STRUCTURE INFO IF FILE(PREFIX+'.OLD') //** P3N - 12/27/01 ERASE(PREFIX+'.OLD') //** P3N - 12/27/01 ENDIF //** P3N - 12/27/01 ALL_PR_ARR := {} //** P3N - 12/27/01 ELSE //** P3N - 03/08/00 SELECT REAL_FILE USE ?? CHR(7) ERR_BOX( ' WARNING! The Pricing File for the ' + MFILE +' ', ; ' Model has Changed! Some PRICES May Be LOST!', ; ' Press to QUIT, or any other to continue.') IF LASTKEY() = 27 RETURN ENDIF ENDIF //** P3N - 03/08/00 ENDIF ENDIF IF NEWFILE .OR. DIFFERENT IF DIFFERENT NET_USE(REAL_FILE, .T., 5, 'REAL_FILE') COPY TO &USERFILEX COPYTO := ALLTRIM(PREFIX) + '.OLD' COPY TO ©TO USE NET_USE(USERFILEX, .T., 5, 'TEMP_FILE') ENDIF CREATE_DBF(REAL_FILE, FLD_ARR) NET_USE(REAL_FILE, .T., 5, 'REAL_FILE') // LOAD THE ROW DESC RECORDS NUM_ELEMS = LEN(DESC_ARR) FOR L = 1 TO NUM_ELEMS ADD_REC(3) REPLACE DESC WITH DESC_ARR[L] NEXT IF DIFFERENT SELECT REAL_FILE GOTO TOP DO WHILE !EOF() SELECT TEMP_FILE LOCATE FOR ALLTRIM(DESC) == ALLTRIM(REAL_FILE->DESC) IF FOUND() REP_ONEREC('TEMP_FILE', 'REAL_FILE') ENDIF SELECT REAL_FILE SKIP 1 ENDDO SELECT TEMP_FILE USE SELECT REAL_FILE GOTO TOP ENDIF ENDIF // DBROWSE WITH UPDATE ON CURRENT FILE TBARR := {} NTOP = 5 NLEFT = 1 NRIGHT = 78 NBOTTOM = 20 P1 = 'Description' P2 = 'DESC' P3 = NIL P4 = 30 AADD(TBARR, {P1, P2, P3, P4}) FOR L = 2 TO LEN(FLD_ARR) IF FLD_ARR[L,1] <> 'UPDATED' .AND. FLD_ARR[L,1] <> 'CUST_ID' P1 = ALLTRIM(FLD_ARR[L,1]) P2 = FLD_ARR[L,1] P3 = 'REAL_FILE' P5 = 'CK_PR_CHG()' IF RIGHT(FLD_ARR[L,1],5) = 'STAMP' // AUDIT STAMPS P7 = '.F.' ELSE P7 = NIL ENDIF AADD(TBARR, {P1, P2, P3, NIL, P5}) ENDIF NEXT //////////////////////////////////////////////////////////// OLD_MFILE = MFILE // SAVE IT IN CASE WE HAVE TO DO IT AGAIN OLD_PRICE_CD = MPRICE_SHEET @ 0,0 TOPHEADING := {} GOTO TOP IF EMPTY(CPRICENUM) //P3N - 2-5-98 XTITLE := TITLE + ' ' + PRODUCT->PROD_CODE ELSE XTITLE := TITLE + ' ' + CPRICENUM ENDIF DO WHILE .T. BROWINST(XTITLE + ' ' + MSG, 'PRPO') DBROWSE(NTOP,NLEFT,NBOTTOM,NRIGHT,.F.,TBARR,1,.F.,TOPHEADING) @ 21,0 CLEAR CORR = CORRCHEK() IF CORR <> 'N' .OR. LASTKEY() = 27 EXIT ENDIF ENDDO SELECT REAL_FILE IF !EMPTY(PR_CUSTID) // ONE TIME THRU FOR SPEC CUST PRICING REPLACE ALL CUST_ID WITH PR_CUSTID USE RETURN ELSE USE // CLOSE THE MFILE ENDIF ENDDO ENDDO RETURN //******************************************************************* //** P3N - 2/26/99 //** F2-CUST PRICE HOTKEY TO REMOVE PRICE TABLE //******************************************************************* FUNCTION REMOVE_CUSTPR() LOCAL CUSTID := USERFILE2->CUST_ID LOCAL MPROD := USERFILE2->PROD_CODE LOCAL MTITLE := 'Select CUSTOMER to Copy Pricing for Customer ' + ALLTRIM(CUSTID) + '/'+ALLTRIM(MPROD) LOCAL FILE_CP := 'U'+ ALLTRIM(USERFILE2->PROD_CODE) LOCAL FILE_CP_SFX := '', PRICEFL := '', ORIGPRFL := '' LOCAL M1 := 'Are you sure you want to remove pricing for this Customer/Model?' LOCAL M2 := ' ' LOCAL M3 := 'Customer - ' + CUSTID + '/' LOCAL CPRICENUM := CUST_MAST->CPRICE_NUM FILE_CP_SFX := STR(CPRICENUM,3) FILE_CP_SFX := STRTRAN(FILE_CP_SFX, ' ', '0') PRICEFL := FILE_CP +'.'+FILE_CP_SFX IF FILE(PRICEFL) M3 := M3 + PRICEFL IF PROMPT_BOX(M1, M2, M3) ERASE(PRICEFL) ENDIF ENDIF RETURN *************************************************************** FUNCTION CK_PR_CHG() LOCAL GETO := GETACTIVE() IF GETO:CHANGED AUDIT_STAMP( "PRICETABLE" ) ENDIF RETURN .T. *************************************************************** FUNCTION BLD_PRICE_LINE(ROWARR, CURVARS) LOCAL I, RETVAL FOR I = 1 TO LEN(ROWARR) IF RETVAL = NIL RETVAL := '' ELSE RETVAL := RETVAL + '-' ENDIF RETVAL := RETVAL + ALLTRIM(ROWARR[I,CURVARS[I]]) NEXT RETURN RETVAL *************************************************************** FUNCTION COPY_OPTS(WHICH_OPT_FILE, WHICH_FILE) LOCAL SAVESEL := SELECT(), SAVEFILT LOCAL SAVEORD, MAC, FILTEXP, SEEKKEY, MACX, NEWMSG LOCAL FILTX LOCAL NEWCUST := .F. //** P3N - 12/27/01 PRIVATE CPYCUST := GETAVAR('CPYCUST') //** P3N - 12/27/01 PRIVATE ITEMCATCODE IF EMPTY(CPYCUST) //** P3N - 12/27/01 CPYCUST := '' //** P3N - 12/27/01 ENDIF //** P3N - 12/27/01 SELECT USERFILE1 IF RECCOUNT() > 0 RETURN .T. ENDIF SELECT (WHICH_OPT_FILE) //CAT_OPTS OR ATT_OPTS SAVEORD := INDEXORD() SAVEFILT := DBFILTER() // CALLED FROM PRODUCT SETUP IF WHICH_FILE = 'PROD_OPTS' // 1ST, LOOK AT CATEGORY OPTS - 2ND TIME THRU SEEKKEY := 'USERFILE2->ATT_CODE' IF WHICH_OPT_FILE = 'CAT_OPTS' // CATEGORY OPTS TO PRODUCT OPTS ****SET FILTER TO CAT_CODE = PRODUCT->CAT_CODE FILTEXP := 'CAT_CODE = PRODUCT->CAT_CODE' DONSETORD(2) // ATT_CODE + OPTION NEWMSG := 'CATEGORY' ELSE IF WHICH_OPT_FILE = 'ATT_OPTS' // ATTRIBUTE OPTS TO PRODUCT OPTS ** SET FILTER TO ATT_CODE = USERFILE2->ATT_CODE FILTEXP := 'ATT_CODE = USERFILE2->ATT_CODE' DONSETORD(1) // ATT_CODE + OPTION NEWMSG := 'SYSTEM ATTRIBUTE' ENDIF ENDIF ELSE IF WHICH_FILE = 'CAT_OPTS' // ATTRIBUTE OPTS TO CATEGOTY OPTS SEEKKEY := 'USERFILE2->ATT_CODE' ** SET FILTER TO ATT_CODE = USERFILE2->ATT_CODE FILTEXP := 'ATT_CODE = USERFILE2->ATT_CODE' DONSETORD(1) // ATT_CODE + OPTION NEWMSG := 'ATTRIBUTE' ELSE IF WHICH_FILE = 'CUST_OPTS' // CALLED FROM CUSTOMER PRICING SETUP NEWCUST := .F. //** P3N - 12/27/01 FILTEXP := '' //** P3N - 12/27/01 SEEKKEY := CPYCUST + USERFILE3->PROD_CODE + USERFILE3->ATT_CODE IF (WHICH_FILE)->(DBSEEK(SEEKKEY)) //** P3N - 12/27/01 SELECT(WHICH_FILE) //** P3N - 12/27/01 NEWCUST := .T. //** P3N - 12/27/01 ENDIF //** P3N - 12/27/01 SEEKKEY := 'USERFILE3->ATT_CODE' IF WHICH_OPT_FILE = 'PROD_OPTS' // CATEGORY OPTS TO CUST_OPTS ** SET FILTER TO PROD_CODE = USERFILE3->PROD_CODE NEWMSG := 'PRODUCT' IF NEWCUST //** P3N - 12/27/01 NEWMSG := 'CUSTOMER' //** P3N - 12/27/01 FILTEXP := 'CUST_ID == CPYCUST .AND. ' //** P3N - 12/27/01 ENDIF //** P3N - 12/27/01 FILTEXP := FILTEXP + 'PROD_CODE = USERFILE3->PROD_CODE' //** FILTEXP := 'PROD_CODE = USERFILE3->PROD_CODE' DONSETORD(2) // ATT_CODE + OPTION ELSEIF WHICH_OPT_FILE = 'CAT_OPTS' // CATEGORY OPTS TO CUST_OPTS ********* SET FILTER TO CAT_CODE = ITEMCATCODE ITEMCATCODE := GET_CATCODE(USERFILE3->PROD_CODE) NEWMSG := 'CATEGORY' IF NEWCUST //** P3N - 12/27/01 NEWMSG := 'CUSTOMER' //** P3N - 12/27/01 FILTEXP := 'CUST_ID == CPYCUST .AND. ' //** P3N - 12/27/01 ENDIF //** P3N - 12/27/01 FILTEXP := FILTEXP + 'CAT_CODE = ITEMCATCODE' //** P3N - 12/27/01 //** FILTEXP := 'CAT_CODE = ITEMCATCODE' DONSETORD(2) // ATT_CODE + OPTION ELSEIF WHICH_OPT_FILE = 'ATT_OPTS' // ATTRIBUTE OPTS TO CUST_OPTS **********SET FILTER TO ATT_CODE = USERFILE3->ATT_CODE NEWMSG := 'SYSTEM ATTRIBUTE' IF NEWCUST //** P3N - 12/27/01 NEWMSG := 'CUSTOMER' //** P3N - 12/27/01 FILTEXP := 'CUST_ID == CPYCUST .AND. ' //** P3N - 12/27/01 ENDIF //** P3N - 12/27/01 FILTEXP := FILTEXP + 'ATT_CODE = USERFILE3->ATT_CODE' DONSETORD(1) // ATT_CODE + OPTION ENDIF ENDIF ENDIF ENDIF MAC := 'ATT_CODE == ' + SEEKKEY SEEKKEY := &SEEKKEY SEEK SEEKKEY ** MACX := &('{|| ' + MAC + '}') MACX := MAKE_BLOCK(MAC) FILTX := MAKE_BLOCK(FILTEXP) DO WHILE EVAL(MACX) IF EVAL( FILTX ) __WHEREFROM := NEWMSG SELECT USERFILE1 IF NEWCUST //** P3N - 12/27/01 ADD_ONEREC(WHICH_FILE, 'USERFILE1' ) //** CUST_OPTS ELSE //** P3N -12/27/01 ADD_ONEREC(WHICH_OPT_FILE, 'USERFILE1' ) ENDIF //** P3N -12/27/01 ENDIF SELECT (WHICH_OPT_FILE) //CAT_OPTS OR ATT_OPTS IF NEWCUST //** P3N - 12/27/01 SELECT(WHICH_FILE) //** P3N - 12/27/01 CUST_OPTS ENDIF //** P3N - 12/27/01 SKIP 1 ENDDO DONSETORD(SAVEORD) SET FILTER TO &SAVEFILT SELECT (SAVESEL) RETURN .T. **************************************************** **************************************************** FUNCTION CAT_PAINT // PUT COLUMN HEADING ON SCREEN FOR PRODUCTION INFO LOCAL SAVECOLOR := SETCOLOR(HNOR) @ 11,1 SAY 'Conversion' @ 12,1 SAY '--------------------' @ 11,23 SAY 'Width' @ 12,23 SAY '--------' @ 11,34 SAY 'Height' @ 12,34 SAY '--------' SETCOLOR(SAVECOLOR) RETURN NIL **************************************************** ** P3N - 02/13/04 ** **************************************************** FUNCTION CATPAINT2() // PUT DOUBLE SPACING ORDER OPTIONS INFO ON SCREEN FOR CATEGORY SETUP LOCAL SAVECOLOR := SETCOLOR(HNOR) @ 13,25 SAY '(Select Order Double Spacing Options)' @ 14,07 SAY '-----------------------------------------------------------------------' @ 15,34 SAY '( "F" Frame/"G" Glass/"S" Screen/"R" GoldRod )' @ 16,34 SAY '( "D" Delivery/"O" OrderDesk /"I" ICO )' @ 17,34 SAY '( "I" Invoice/"B" PreBill/"C" PreCost )' @ 18,34 SAY '( "Y" Yes )' SETCOLOR(SAVECOLOR) RETURN NIL **************************************************** FUNCTION GET_ORD_NUM(SCRNUM, CHGTYPE) // GENERATE A NUMBER FOR A NEW ORDER LOCAL SAVESEL, MSG1, MORDER_NUM, NKEY LOCAL LAST_GOOD_ORD, OLDCOLOR LOCAL CLOSECTL := .T. //** P3N - 6/25/98 F5ORD := 0 //** P3N - 3/9/00 IF CHGTYPE <> NIL .AND. CHGTYPE = 'MANUAL' **IF _CUROPT = 2 // CHANGE RETURN '?' ENDIF IF SELECT('USERFILE8') = 0 .AND. SCRNUM <> 'QCNV' RETURN .T. ENDIF SAVESEL := SELECT() NKEY = NEXTKEY() IF NKEY = ASC('Y') .OR. NKEY = ASC('y') .OR. NKEY = 19 // LEFT ARROW KEY ELSE CLEAR TYPEAHEAD ENDIF IF CUR_MAST = 'ORD_MAST' MSG1 := ' ADD New Sales ORDER? ' ELSE OLDCOLOR := SETCOLOR(BLOW) @ 05,13 SAY ' ' @ 06,13 SAY ' * * * * Q U O T E P R O C E S S I N G * * * * ' @ 07,13 SAY ' ' SETCOLOR(OLDCOLOR) MSG1 := ' ADD New Sales QUOTE? ' ENDIF IF SELECT('CONTROL') > 0 //** P3N - 6/25/98 CLOSE CONTROL CLOSECTL := .F. ENDIF IF SCRNUM == 'QCNV' DBOPEN('CONTROL') REC_LOCK() MORDER_NUM = STR( (VAL(ORDER_NUM) + 1),6) // GET NEW ORDER NUMBER REPLACE ORDER_NUM WITH MORDER_NUM USE ELSE IF PROMPT_BOX(MSG1,'','',1) // ASKS YES/NO, YES = .T., NO = .F. DBOPEN('CONTROL') REC_LOCK() IF CUR_MAST = 'ORD_MAST' MORDER_NUM = STR( (VAL(ORDER_NUM) + 1),6) // GET NEW ORDER NUMBER REPLACE ORDER_NUM WITH MORDER_NUM ELSE MORDER_NUM = STR( (VAL(QUOTE_NUM) + 1),6) // GET NEW QUOTE NUMBER REPLACE QUOTE_NUM WITH MORDER_NUM ENDIF USE ELSE MORDER_NUM = SPACE(6) // MAKE IT EMPTY ENDIF ENDIF IF CLOSECTL //** P3N - 6/25/98 //** SHOULD ALREADY BE CLOSED ELSE DBOPEN('CONTROL') ENDIF SELECT(SAVESEL) @ 10,0 RETURN MORDER_NUM ************************************************************ // RESET CONTROL FILE IF SOMEONE ESCAPED SOMEWHERE FROM NEW ORDER FUNCTION RESET_CNTL(WHICHNUM) LOCAL SAVESEL := SELECT() IF WHICHNUM = 'ORDER' DBOPEN('CONTROL') REC_LOCK(1) REPLACE ORDER_NUM WITH STR( VAL(ORDER_NUM) - 1, 6) USE ELSE IF NEWREC IF CUR_MAST = 'ORD_MAST' DBOPEN('CONTROL') REC_LOCK(1) IF (CUR_MAST)->ORDER_NUM = ORDER_NUM REPLACE ORDER_NUM WITH STR( VAL(ORDER_NUM) - 1, 6) ENDIF USE ELSE DBOPEN('CONTROL') REC_LOCK(1) IF (CUR_MAST)->ORDER_NUM = QUOTE_NUM REPLACE QUOTE_NUM WITH STR( VAL(QUOTE_NUM) - 1, 6) ENDIF USE ENDIF ENDIF ENDIF SELECT (SAVESEL) RETURN * **************************************************** FUNCTION UP_OM_NEED_CALC() SELECT (CUR_MAST) REC_LOCK(3) REPLACE NEED_CALC WITH 'N' UNLOCK SELECT USERFILE2 RETURN .T. **************************************************** FUNCTION GET_LINEOPTS(MCODE, PACTION, UP_RECNO, ADDL_MODE) // GET LINE OPTIONS FOR MODEL MCODE LOCAL FILE1, FILE2, DBNAME, GET_ARR := {}, OPT_ARR := {}, WORKVAR LOCAL SAVESEL := SELECT(), NCURSOR := SETCURSOR(1) LOCAL ROW, SAVESCRN1 := SAVESCREEN(), SAVESCRN LOCAL MORDER_NUM := &CUR_MAST->ORDER_NUM, EXITKEY, THISTITLE LOCAL MLINE_NUM, MPROD_CODE LOCAL SAVEDELIM := SET(_SET_DELIMITERS, .F.) LOCAL MSTD_OPTS := USERFILE2->STD_OPTS, MTYPE, GET_IT LOCAL SAVEREC, PRICE_ARR := {} LOCAL SAVECURSOR := SETCURSOR(), PACK_FLAG LOCAL CUR_PRICE_VALU := USERFILE2->SALE_PRICE LOCAL RETVAL, NDX_EXP, FOUND_FLAG LOCAL PIRATE_VAR, INFINAL := .F., TTEDIT LOCAL CUR_USER_REC, MIDDLE, XSTD_OPTS, REPLINE LOCAL DISC_ARR := {}, F7CALC_PRICE := 0 LOCAL THIS_DISC_AMT := 0 LOCAL PR_CUSTID := SPACE(8), RETARR := {}, M_MODEL LOCAL HM_VAR, HMERR := .F., HM_VAROUT:="" STATIC P_CHGLIST := '' STATIC O_CHGLIST := '' STATIC STOP_SHOW := .F. PRIVATE SGACTION := PACTION PRIVATE _SELFILE := SELECT() IF UP_RECNO = NIL UP_RECNO := .F. ENDIF IF ADDL_MODE = NIL ADDL_MODE := .F. ENDIF IF UP_RECNO SELECT USERFILE2 REPLACE LINE_NUM WITH RECNO() ENDIF MLINE_NUM = STR(USERFILE2->LINE_NUM,3) IF PROCNAME(1) = 'EDITGBROW' // F10 FINAL EDIT INFINAL := .T. ENDIF IF RECNO() = 1 O_CHGLIST := '' // RESET CHANGED OPTION ITEMS P_CHGLIST := '' // RESET CHANGED PRICE LINE ITEMS STOP_SHOW := .F. // BE SURE STOP_SHOW ALWAYS FALSE ENDIF // WHEN ENTERING THE PRICE FINAL EDIT // ON 1ST RECORD IF SGACTION = NIL IF !_OC_CAPABLE .OR. GETAVAR('ACTION_CODE') <> 'ADD' SGACTION = 'REV' ENDIF IF SGACTION = NIL SGACTION = 'GET' ENDIF **SGACTION = 'GET' ENDIF IF PROCNAME(1) = 'EDITGBROW' .AND. USERFILE2->NEED_CALC = 'N' // DONT DO THE SYSTEM EDITS! SET(_SET_DELIMITERS, SAVEDELIM) IF RECNO() = LASTREC() .AND. STOP_SHOW DISP_CHANGES(P_CHGLIST, O_CHGLIST) KEYBOARD CHR(1) // HOME KEY RETURN .F. ELSE RETURN .T. ENDIF ENDIF CUR_USER_REC := RECNO() PIRATE_VAR := FILL_EMPTY(MCODE, SGACTION, ADDL_MODE) SELECT USERFILE2 GOTO CUR_USER_REC MCODE = USERFILE2->PROD_CODE MPROD_CODE := MCODE PRODUCT->(DBSEEK(MCODE)) IF EMPTY(PRODUCT->ALLOW_SIZE) HM_VAR := 'OTN' // ALLOW OS / TT / NS ELSE HM_VAR := PRODUCT->ALLOW_SIZE ENDIF IF PIRATE_VAR == 'NO CONT' IF RECNO() == 1 .AND. BLANK_1ST( .T.,'PROD_CODE') SET(_SET_DELIMITERS, SAVEDELIM) RETURN .T. ELSE ?? CHR(7) ERR_BOX( ' MUST supply Missing Line Item Fields! ') IF PROCNAME(1) = 'EDITGBROW' RETURN .F. ELSE RETURN .T. ENDIF ENDIF ENDIF // DO SPECIAL FIELD EDITS HERE! // DO SPECIAL FIELD EDITS HERE! // DO SPECIAL FIELD EDITS HERE! // DO SPECIAL FIELD EDITS HERE! IF EMPTY(ENTRY_SIZE) // ONLY NEED TO CHECK IF EMPTY // IF ! EMPTY, THE SIZE ALREADY VALIDATED RETURN .F. ENDIF IF !USERFILE2->STD_OPTS$'YN' ERR_BOX( ' Invalid STANDARD OPTIONS CODE ' , ; ' "Y" = Use Std Options ' ,; ' "N" = Special Options ' ,; ' PLEASE RE-ENTER') RETURN .F. ENDIF TTEDIT := CK_ENTRY_SIZE( HM_VAR, USERFILE2->ENTRY_SIZE, USERFILE2->HOW_MEAS ) IF TTEDIT == 'OK' RND_WID_HT(MPROD_CODE, GET_ARR ) //CALC THE BILLING SIZE BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE ELSE IF TTEDIT = 'INVALID' .OR. TTEDIT = 'MU' RETURN .F. ELSE ERR_BOX( ' UNKNOWN TTEDIT CODE IN CGWPRPO ' , ; ' ') RETURN .F. ENDIF ENDIF // IN CASE OF AN EMPTY PRICE_SHEET IF EMPTY(USERFILE2->PRICE_SHT) DISC_ARR := CALC_DISC(USERFILE2->PROD_CODE) IF !EMPTY(DISC_ARR[2]) REPLACE USERFILE2->PRICE_SHT WITH DISC_ARR[2] ELSE REPLACE USERFILE2->PRICE_SHT WITH &CUR_MAST->PRICE_SHT ENDIF ENDIF IF PROCNAME(1) = 'EDITGBROW' DO CASE CASE PIRATE_VAR = 'NO_OPTS_NO_PIRATE' SGACTION = 'GET' OTHERWISE SGACTION = 'PRICE' END CASE ENDIF **IF LASTKEY() = -6 // F7 KEY - GET PRICE IF LASTKEY() = K_F7 // F7 KEY - GET PRICE DO CASE CASE PIRATE_VAR = 'NO_OPTS_NO_PIRATE' SGACTION = 'GET' OTHERWISE SGACTION = 'PRICE' END CASE ENDIF IF SGACTION == 'PRICE' WAIT_BOX(' *** Calculating Price *** ',; ' *** PLEASE WAIT ***') ENDIF M_MODEL = MCODE // SAVE MODEL NAME FOR PRICING LOOKUP, MCODE MIGHT BE CATEGORY LATER ON! IF CK_SPEC_PRICE( (CUR_MAST)->CUST_ID, MCODE, (CUR_MAST)->ORDER_DATE, 'CUST_BP' ) PR_CUSTID := (CUR_MAST)->CUST_ID ENDIF // GO GET THE GET_ARR AND PRICE_ARR FOR THIS MODEL RETVAL = BUILD_GETARR(MCODE, 1, MORDER_NUM, MLINE_NUM, PIRATE_VAR, , ADDL_MODE, PR_CUSTID, , 'USERFILE2') GET_ARR = RETVAL[1] PRICE_ARR = RETVAL[2] RND_WID_HT(MPROD_CODE, GET_ARR ) //ROUND THE WIDTH AND HEIGHT BASED ON OPTIONS BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE PROD_SIZE(GET_ARR,MPROD_CODE, ADDL_MODE) // MAKE SURE CURRENT PROD SIZE INFO IS IN THERE LAST_CODE = MCODE // SAVE LAST MCODE // SET THE INSTOCK, STDSIZE, ORIELSIZE FIELDS IN THE USERFILE RECORD CK_STD_STOCK_SIZE(MPROD_CODE, GET_ARR, 'ALL', ADDL_MODE) IF SGACTION = 'GET' .OR. SGACTION = 'REV' @ 0,0 CLEAR THISTITLE := 'Line Item Options For Model '+ ALLTRIM(MCODE) IF ADDL_MODE THISTITLE := THISTITLE + '(Attach to ' + ALLTRIM(USERFILE2->PAR_COLOR) + ' '+ ALLTRIM(USERFILE2->PAR_PROD) + ')' ENDIF SAYTITLE(THISTITLE, 'PRPO') @ 2,0 CLEAR ENDIF //** P3N - 3/18/98 F7CALC_PRICE := LASTKEY() RETARR := PROCESS_GETVALS( GET_ARR, ADDL_MODE, SGACTION, ; STOP_SHOW, O_CHGLIST, P_CHGLIST, ; MORDER_NUM, MLINE_NUM, MPROD_CODE, ; M_MODEL, PR_CUSTID, PRICE_ARR, THISTITLE) STOP_SHOW := RETARR[1] O_CHGLIST := RETARR[2] P_CHGLIST := RETARR[3] SETCURSOR(SAVECURSOR) SELECT USERFILE2 IF (CUR_PRICE_VALU <> USERFILE2->SALE_PRICE) ; .AND. PROCNAME(1) = 'EDITGBROW' STOP_SHOW := .T. P_CHGLIST := P_CHGLIST + STR(RECNO() ,3) ENDIF SELECT USERFILE2 //** P3N - 3/18/98 - F7 CALC PRICE DISPLAY ALL PRICING COMPONENTS IF F7CALC_PRICE = K_F7 DISP_PRICE_COMP() ENDIF IF RECNO() = LASTREC() .AND. STOP_SHOW .AND. SGACTION = "PRICE" DISP_CHANGES(P_CHGLIST, O_CHGLIST) KEYBOARD CHR(1) // HOME KEY RETVAL := .F. ELSE RETVAL := .T. ENDIF SET(_SET_DELIMITERS, SAVEDELIM) RESTSCREEN(,,,,SAVESCRN1) SELECT(SAVESEL) RETURN RETVAL *************************************************************** * //** P3N - 3/18/98 * IF F7 KEY DEPRESSED - DISPLAY ALL PRICE COMPONENTS * (IE: LINE ITEM - BASE_PRICE, OPT_PRICE, AND EXT_PRICE) *************************************************************** FUNCTION DISP_PRICE_COMP() LOCAL L1 := 'Base Price - ' + STR(BASE_PRI,7,2) LOCAL L2 := 'Opt. Price - ' + STR(OPT_PRI,7,2) LOCAL L3 := 'Ext. Price - ' + STR(EXTRA_PRI,7,2) LOCAL L4 := 'Sale Price - ' + STR(SALE_PRICE,7,2) LOCAL L5 := 'SPECIAL CUSTOMER PRICING EXISTS' //** P3N - 07/17/02 IF EMPTY(CUST_MAST->CPRICE_NUM) L5 := '' ENDIF PRICEBOX( L5, L1, L2, L3, ; ' --------', ; L4, ; ' ========') RETURN .T. //**************************************************************** //** p3n - 05/01/03 *** //** ADDRESS MSG LINES PASSED *** //** (IE: MSG7 VARIABLE DOES NOT EXIST ABEND) *** //**************************************************************** FUNCTION PRICEBOX(LINE1, LINE2, LINE3, LINE4, LINE5, LINE6, LINE7) LOCAL SCRN1, I, LONGEST, H, SAVECOL, SAVESCR //**ATE LINEVAR, MSG1, MSG2, MSG3 PRIVATE LINEVAR, MSG1, MSG2, MSG3, MSG4, MSG5, MSG6, MSG7 CLEAR TYPEAHEAD MSG1 := LINE1 MSG2 := LINE2 MSG3 := LINE3 MSG4 := LINE4 MSG5 := LINE5 MSG6 := LINE6 MSG7 := LINE7 SAVECOL := SETCOLOR() SETCOLOR(HREV) SAVE SCREEN TO SAVESCR LONGEST := 25 FOR I = 1 TO PCOUNT() LINEVAR := 'MSG' + STR(I,1) IF &LINEVAR = NIL ELSE IF LEN(&LINEVAR) > LONGEST LONGEST := LEN(&LINEVAR) ENDIF ENDIF NEXT H = ((80 - LONGEST) / 2) @ 12,H-5 CLEAR TO 17 + PCOUNT(),H+5+LONGEST @ 12,H-5 TO 17 + PCOUNT(),H+5+LONGEST DOUBLE V = 14 @ V,H SAY LINE1 IF PCOUNT() > 1 V++ @ V ,H SAY LINE2 ENDIF IF PCOUNT() > 2 V++ @ V,H SAY LINE3 ENDIF IF PCOUNT() > 3 V++ @ V,H SAY LINE4 ENDIF IF PCOUNT() > 4 V++ @ V,H SAY LINE5 ENDIF IF PCOUNT() > 5 V++ @ V,H SAY LINE6 ENDIF IF PCOUNT() > 6 V++ @ V,H SAY LINE7 ENDIF V++ V++ @ V,H SAY "Press Any Key to Continue" INKEY(0) RESTORE SCREEN FROM SCRN1 SETCOLOR(SAVECOL) RESTORE SCREEN FROM SAVESCR RETURN (.T.) *************************************************************** * *************************************************************** FUNCTION CK_ENTRY_SIZE( HM_VAR, ENTSIZE, HOWMEAS ) LOCAL MIDDLE := AT('X', ENTSIZE) LOCAL GPOS := AT('G', ENTSIZE) LOCAL WOVAR := AT("'", ENTSIZE) LOCAL FTVAR := 0 , I LOCAL INVAR := 0 LOCAL HMERR := .F., HM_VAROUT := '' FOR I := 1 TO LEN( ENTSIZE ) IF SUBS(ENTSIZE,I,1)$"'" FTVAR ++ ENDIF NEXT FOR I := 1 TO LEN( ENTSIZE ) IF SUBS(ENTSIZE,I,1)$'"' INVAR ++ ENDIF NEXT IF !EMPTY(HM_VAR) DO CASE CASE HOWMEAS=='TT' .AND. AT( 'T', HM_VAR ) = 0 HMERR := .T. CASE HOWMEAS=='OS' .AND. AT( 'O', HM_VAR ) = 0 HMERR := .T. CASE HOWMEAS=='NS' .AND. AT( 'N', HM_VAR ) = 0 HMERR := .T. CASE HOWMEAS=='WO' .AND. AT( 'W', HM_VAR ) = 0 HMERR := .T. CASE HOWMEAS=='BW' .AND. AT( 'B', HM_VAR ) = 0 HMERR := .T. CASE HOWMEAS=='OT' .AND. AT( '1', HM_VAR ) = 0 HMERR := .T. CASE HOWMEAS=='TO' .AND. AT( '2', HM_VAR ) = 0 HMERR := .T. ENDCASE IF HMERR IF AT('O', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"OS" ' ENDIF IF AT('T', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"TT" ' ENDIF IF AT('N', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"NS" ' ENDIF IF AT('W', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"WO" ' ENDIF IF AT('B', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"BW" ' ENDIF IF AT('1', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"OT" ' ENDIF IF AT('2', HM_VAR) > 0 HM_VAROUT := HM_VAROUT + '"TO" ' ENDIF ERR_BOX('*** Invalid HOW MEASURE ', ; '*** Valid Method(s) - ' + HM_VAROUT ) RETURN 'INVALID' ENDIF ENDIF WORKVAR := VAL_WD( 'USERFILE2', ENTSIZE) DO CASE CASE HOWMEAS=='TT' .AND. MIDDLE > 0 TTEDIT := 'OK' CASE HOWMEAS=='OS' .AND. MIDDLE > 0 TTEDIT := 'OK' CASE ( HOWMEAS=='NS' .AND. MIDDLE = 0 ) .OR. FTVAR = 2 TTEDIT := 'OK' CASE HOWMEAS=='WO' .AND. WORKVAR[2] = 'WO' TTEDIT := 'OK' * CASE HOWMEAS=='WO' .AND. WOVAR > 0 .AND. FTVAR = 1 * TTEDIT := 'OK' * CASE HOWMEAS=='WO' .AND. INVAR = 1 * TTEDIT := 'OK' * CASE HOWMEAS=='WO' .AND. VAL_WD('USERFILE2', ENTSIZE ) * TTEDIT := 'OK' CASE HOWMEAS=='BW' .AND. GPOS > 0 TTEDIT := 'OK' CASE HOWMEAS=='TO' .AND. MIDDLE > 0 TTEDIT := 'OK' CASE HOWMEAS=='OT' .AND. MIDDLE > 0 TTEDIT := 'OK' OTHERWISE DO CASE CASE HOWMEAS=='TT' TTEDIT := 'MU' CASE HOWMEAS=='OS' TTEDIT := 'MU' CASE HOWMEAS=='NS' TTEDIT := 'MU' CASE HOWMEAS=='WO' TTEDIT := 'MU' CASE HOWMEAS=='BW' TTEDIT := 'MU' CASE HOWMEAS=='TO' TTEDIT := 'MU' CASE HOWMEAS=='OT' TTEDIT := 'MU' OTHERWISE TTEDIT := 'INVALID' ENDCASE ENDCASE IF TTEDIT = 'MU' // MIXED - UP ERR_BOX( ' Size and HOW MEASURE are ILLOGICAL ' , ; ' "TT/OS/TO/OT" = 99 X 99' , ; ' "NS" = 9999 ' , ; [ "WO" = 99'99 ] , ; ' "BW" = 99G99 ') REPLACE USERFILE2->HOW_MEAS WITH ' ' TTEDIT := 'INVALID' **RETURN .F. ENDIF IF TTEDIT = 'INVALID' ERR_BOX( ' Invalid HOW MEASURE CODE ' , ; '"TT" = Tip to Tip "BW" = Basement Window ' , ; '"OS" = Opening Size "WO" = Width Only ' , ; '"TO" = TT WD - OS HT "OT" = OS WD - TT WD ' , ; '"NS" = Nominal Size ') **RETURN .F. ENDIF RETURN TTEDIT ***************************************************************** FUNCTION PROCESS_GETVALS( GET_ARR, ADDL_MODE, SGACTION, ; STOP_SHOW, O_CHGLIST, P_CHGLIST, ; MORDER_NUM, MLINE_NUM, MPROD_CODE, ; M_MODEL, PR_CUSTID, PRICE_ARR, THISTITLE) LOCAL PAGENUM := 0, STRTROW, ENDROW, FULLPAGE, FSTPAGE, GET_COL LOCAL L, NUM2GET, L2, MTYPE, GET_IT, ROW, SAY_COL, DESCVAR LOCAL CORRECT, EXITKEY, CORR, SAVEL, FSTGET, LASTGET LOCAL REPLINE, PACK_FLAG, MOPT_VALUE, ELEM, XSTD_OPTS, SEEKKEY LOCAL DISC_ARR, MSALE_PRICE, BPD, OPD, EPD LOCAL PRNT_DESARR LOCAL ASALE // P3N - 2/18/98 LOCAL BASEPRICE_CUST // P3N - 2/18/98 // PUT GET ARRAY ON SCREEN SETCOLOR(LNOR) STRTROW = 2 ENDROW := MAXROW() - 3 FULLPAGE := ENDROW - STRTROW FSTPAGE := .T. PAGENUM := 0 GET_COL = 35 FOR L = 1 TO LEN(GET_ARR) PAGENUM ++ ROW := STRTROW NUM2GET = 0 NUMGOT := 0 FSTGET := 0 LASTGET := 0 GOTFST := .F. * IF SGACTION <> 'PRICE' * @ 2,0 CLEAR * ENDIF DO WHILE ROW < ENDROW .AND. L <= LEN(GET_ARR) NUM2GET++ IF FSTGET = 0 FSTGET := L ENDIF LASTGET := L MTYPE = GET_ARR[L,2] GET_IT = .F. IF MTYPE$'UP' GET_IT = .T. ENDIF IF MTYPE = 'P' .AND. USERFILE2->STD_OPTS = 'Y' GET_IT = .F. // MAKE SURE THERE ARE DEFAULTS IN THE PICK LIST // LOOK FOR THE DEFAULT VALUE IF GET_ARR[L,7] .OR. EMPTY(GET_DEFAULT(L,GET_ARR, ADDL_MODE)) GET_IT = .T. ENDIF ENDIF GET_ARR[L,7] = GET_IT // LET ARR KNOW TO GET/SAY OR NOT! IF GET_IT .AND. (SGACTION = 'GET' .OR. SGACTION = 'REV') IF !GOTFST GOTFST := .T. CLS IF SGACTION = 'GET' .OR. SGACTION = 'REV' IF SGACTION <> 'PRICE' SAYTITLE(THISTITLE, 'PRPO') @ 2,0 CLEAR ENDIF // PUT UP MSG FOR SECOND GET_ARR COLUMN * IF CUR_OO = 'ACT_OPTS' * PMSG = 'Actual # Before ' + DTOC(MDISP_DATE) * @ 2,55 SAY PMSG * ENDIF ENDIF ENDIF ROW++ NUMGOT ++ DESCVAR := ALLTRIM(GET_ARR[L,5]) SAY_COL = GET_COL - LEN(DESCVAR) -1 @ ROW, SAY_COL SAY DESCVAR ENDIF L++ // SET LOOP COUNTER TO NEXT ELEMENT ENDDO L-- // RESET LOOP COUNTER TO CORRECT ELEMENT IF SGACTION = 'GET' .OR. SGACTION = 'REV' SAY_GET('SAY',GET_COL, L, NUM2GET, GET_ARR, USERFILE2->STD_OPTS, ADDL_MODE, STRTROW) ENDIF * * GET USER'S INPUT * CORRECT := .F. EXITKEY = .F. DO WHILE !CORRECT // AND IT IS EDIT MODE IF SGACTION = 'GET' SAY_GET( 'GET', GET_COL, L, NUM2GET, GET_ARR, USERFILE2->STD_OPTS, ADDL_MODE, STRTROW) ENDIF IF LASTKEY() = 27 CORRECT := .T. EXITKEY = .T. CORR := 'X' L := LEN(GET_ARR) + 1 SETKEY(-4,{|| ' '}) //** TURN OFF F5-PICKLIST HOTKEY - P3N - 6/18/98 RETURN {STOP_SHOW, O_CHGLIST, P_CHGLIST} ******EXIT ENDIF IF EXITKEY L := LEN(GET_ARR) + 1 RETURN {STOP_SHOW, O_CHGLIST, P_CHGLIST} ENDIF CORR = ' ' IF SGACTION = 'GET' .OR. SGACTION = 'REV' SAY_GET('SAY',GET_COL, L, NUM2GET, GET_ARR, USERFILE2->STD_OPTS, ADDL_MODE, STRTROW) FOR L2 = FSTGET TO LASTGET IF GET_ARR[L2,7] // DID WE 'GET' THIS ONE? IF GET_ARR[L2,4] = 'No DEFAULT' .OR. !VALID_PICK(GET_ARR, L2) ERR_BOX( 'INVALID Response for the ', ; ALLTRIM(GET_ARR[L2,5]) + ' Option!', ; ' PLEASE RE-ENTER ') CORR = 'N' EXIT ENDIF ENDIF NEXT IF CORR = 'N' LOOP ENDIF IF NUMGOT > 0 CORR := CORRCHEK( MAXROW()-1) @ MAXROW()-1,0 CLEAR // ERASE CORRCHEK LINE ENDIF ELSE CORR = 'Y' ENDIF IF CORR = 'N' LOOP ELSE CORRECT := .T. IF CORR = 'X' CORRECT := .T. EXITKEY = .T. L = LEN(GET_ARR) // EXIT ENTIRE LOOP EXIT ELSE // ASSUMES CORR = 'Y' // good record - do the update ENDIF ENDIF ENDDO NEXT // CALCULATE/UPDATE BILLING/PRODUCTION SIZE BASED ON OPTIONS // ALSO WILL CALC THE ACTUAL FINISHED PRODUCTION SIZE RND_WID_HT(MPROD_CODE, GET_ARR) //ROUND WID/HT ENTRY SIZE BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE PROD_SIZE(GET_ARR,MPROD_CODE, ADDL_MODE) REPLINE := USERFILE2->LINE_NUM SELECT USERFILE6 REPLACE ALL UPDATED WITH 'X' FOR LINE_NUM = REPLINE SELECT USERFILE2 PACK_FLAG = .F. SAVEL := L FOR L2 = 1 TO LEN(GET_ARR) // SEE IF THERE IS A PARENT PRODUCT FOR THIS OPTION // OR IF THERE IS AN ADDITIONAL PRODUCT FOR THIS OPTION MOPT_VALUE = GET_ARR[L2,4] IF !EMPTY(MOPT_VALUE) ELEM = ASCAN(GET_ARR[L2,3], {|X| X[1] == MOPT_VALUE}) IF ELEM > 0 IF !EMPTY(GET_ARR[L2,3,ELEM,11]) // PARENT PRODUCT CODE REPLACE USERFILE2->PAR_PROD WITH GET_ARR[L2,3,ELEM,11] ENDIF IF !EMPTY(GET_ARR[L2,3,ELEM,10]) // addl product code IF USERFILE2->STD_OPTS <> 'Y' // USE USERFILE2 BECAUSE IT GETS UPDATED ON THE FLY IN // PIRATE OPTS / FILL_EMPTY PROCESSING XSTD_OPTS = CHK_ADDITIONAL(GET_ARR[L2,1],; GET_ARR[L2,3,ELEM,10], GET_ARR[L2,5], GET_ARR[L2,4]) ELSE XSTD_OPTS = 'Y' ENDIF // SEE IF WE NEED TO ADDIT TO LINEITEM FILE ADD_ADDITIONAL(GET_ARR[L2,3,ELEM,10], XSTD_OPTS, GET_ARR) ENDIF ENDIF ENDIF // REEVALUATE ALL ITEMS SELECT FOR DEFAULT INCASE // THE DEFAULT IS NOW DIFFERENT DUE TO USER RESPONSES IF GET_ARR[L2,9] == '*' // DEFAULT GET_ARR[L2,4] = GET_DEFAULT(L2, GET_ARR, ADDL_MODE) ENDIF // UPDATE THE DATA FILE IF GET_ARR[L2,2] = 'C' // CALC FIELD UPDATE_MATH(L2, GET_ARR) // GO DO MATH CALCULATIONS ENDIF // DON'T PUT DEFAULT OR EMPTY VALUES INTO THE ORDER OPTION FILE IF ( EMPTY(GET_ARR[L2,4]) .OR. ; GET_ARR[L2,9] == '*' ) .AND. ; TRIM(GET_ARR[L2,1]) <> 'RANCH SLID' // ALWAYS WRITE RANCH SLIDER ATTRIBUTES SELECT USERFILE8 IF ADDL_MODE SEEKKEY = MORDER_NUM + MPROD_CODE + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE ELSE SEEKKEY = MORDER_NUM + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE ENDIF SEEK SEEKKEY IF FOUND() REC_LOCK(1) DELETE PACK_FLAG = .T. ENDIF ELSE // NOT DEFAULT OR EMPTY CHOICE OR N/A SELECT USERFILE8 IF ADDL_MODE SEEKKEY = MORDER_NUM + MPROD_CODE + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE ELSE SEEKKEY = MORDER_NUM + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE ENDIF SEEK SEEKKEY IF !FOUND() ADD_REC(3) ELSE REC_LOCK(3) ENDIF // SET KEY ON ORDER OPTS FILE REPLACE ORDER_NUM WITH MORDER_NUM REPLACE LINE_NUM WITH VAL(MLINE_NUM) REPLACE ATT_CODE WITH GET_ARR[L2,1] REPLACE USER_RESP WITH GET_ARR[L2,4] IF ADDL_MODE REPLACE PROD_CODE WITH MPROD_CODE ENDIF UNLOCK ENDIF NEXT L := SAVEL // REMOVE RECORDS NO LONGER NEEDED! SELECT USERFILE6 DELETE ALL FOR UPDATED = 'X' PACK IF PACK_FLAG SELECT USERFILE8 PACK ENDIF // BUILD PRINT DESCRIPTION // MSG TO SHOW PROCESSING IS OCCURING!! // CALCULATE/UPDATE BILLING/PRODUCTION SIZE BASED ON OPTIONS // ALSO WILL CALC THE ACTUAL FINISHED PRODUCTION SIZE RND_WID_HT(MPROD_CODE, GET_ARR) //ROUND WID/HT ENTRY SIZE BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE PROD_SIZE(GET_ARR,MPROD_CODE, ADDL_MODE) // SS CLEAR GLASS? USED IN GLASS BOX PROCESSING DURING PRINT. CLR_SS_GLASS(GET_ARR, 'USERFILE2') // standard size edit CK_STD_STOCK_SIZE(MPROD_CODE, GET_ARR, 'ALL', ADDL_MODE) // DO WE HAVE ANY SYSTEM LEVEL/PRODUCT LINE DISCOUNTS? // THIS DISC% / PRICE_SHT COMES FROM CUST_PRICE OR (CUR_MAST) DISC_ARR := CALC_DISC(USERFILE2->PROD_CODE) // GO GET PRICING //**MSALE_PRICE = GET_SALEPRICE(M_MODEL, USERFILE2->PRICE_SHT, PRICE_ARR, GET_ARR, ADDL_MODE, PR_CUSTID) ASALE := GET_SALEPRICE(M_MODEL, USERFILE2->PRICE_SHT, PRICE_ARR, GET_ARR, ADDL_MODE, PR_CUSTID) MSALE_PRICE := ASALE[1] //* P3N - 2/18/98 BASEPRICE_CUST := ASALE[2] //* P3N - 2/18/98 IF &CUR_MAST->QUOTE_PRIC = 0 // CALC THE SYSTEM DISCOUNT IF REQUIRED IF USERFILE2->PRICE_SHT == DISC_ARR[2] .AND. EMPTY(USERFILE2->ALT_SPRICE) REPLACE USERFILE2->SYS_DISC WITH DISC_ARR[1] BPD:=0 OPD:=0 EPD:=0 IF DISC_ARR[3] = 'Y' BPD := (USERFILE2->SYS_DISC * USERFILE2->BASE_PRI * .01) ENDIF IF DISC_ARR[4] = 'Y' OPD := (USERFILE2->SYS_DISC * USERFILE2->OPT_PRI * .01) ENDIF IF DISC_ARR[5] = 'Y' EPD := (USERFILE2->SYS_DISC * USERFILE2->EXTRA_PRI * .01) ENDIF REPLACE USERFILE2->DISC_S_AMT WITH BPD + OPD + EPD ELSE IF (CUR_MAST)->DISCOUNT <> 0 REPLACE USERFILE2->SYS_DISC WITH (CUR_MAST)->DISCOUNT IF EMPTY(USERFILE2->ALT_SPRICE) .AND. EMPTY(USERFILE2->DISCOUNT) REPLACE USERFILE2->DISC_S_AMT WITH MSALE_PRICE * ((CUR_MAST)->DISCOUNT*.01) ELSEIF !EMPTY(USERFILE2->ALT_SPRICE) .AND. !EMPTY(USERFILE2->DISCOUNT) REPLACE USERFILE2->DISC_S_AMT WITH USERFILE2->ALT_SPRICE * (USERFILE2->DISCOUNT*.01) ELSEIF EMPTY(USERFILE2->ALT_SPRICE) REPLACE USERFILE2->DISC_S_AMT WITH MSALE_PRICE * (USERFILE2->DISCOUNT*.01) ELSE REPLACE USERFILE2->DISC_S_AMT WITH 0 REPLACE USERFILE2->SYS_DISC WITH 0 ******ELSE ****** REPLACE USERFILE2->DISC_S_AMT WITH USERFILE2->ALT_SPRICE * (USERFILE2->DISCOUNT*.01) ENDIF ELSE REPLACE USERFILE2->SYS_DISC WITH 0 REPLACE USERFILE2->DISC_S_AMT WITH 0 ENDIF ENDIF ELSE // QUOTED PRICE REPLACE USERFILE2->CALC_PRICE WITH MSALE_PRICE MSALE_PRICE := 0 REPLACE USERFILE2->DISCOUNT WITH 0 REPLACE USERFILE2->SYS_DISC WITH 0 REPLACE USERFILE2->DISC_S_AMT WITH 0 ENDIF IF BASEPRICE_CUST //* P3N - 2/18/98 - PER ELLEN REPLACE USERFILE2->DISCOUNT WITH 0 REPLACE USERFILE2->SYS_DISC WITH 0 REPLACE USERFILE2->DISC_S_AMT WITH 0 ENDIF SELECT USERFILE2 REPLACE SALE_PRICE WITH MSALE_PRICE IF USERFILE2->NEED_CALC <> 'N' STOP_SHOW := .T. O_CHGLIST := O_CHGLIST + STR( RECNO(), 3) ENDIF IF EMPTY(USERFILE2->ALT_SPRICE) //** P3N - 6/30/98 //** ALLOW AN ALT PRICE TO BE ENTERED - NO STOP_SHOW ELSE STOP_SHOW := .F. //** P3N - 6/30/98 ENDIF REPLACE USERFILE2->NEED_CALC WITH 'N' // BUILD PRINT DESCRIPTION PRNT_DESARR := BLD_DESC(GET_ARR, 'USERFILE2') REPLACE USERFILE2->ITEM_DESC WITH PRNT_DESARR[1] REPLACE USERFILE2->LINE_DESC WITH PRNT_DESARR[4] IF USERFILE2->(FIELDPOS('LDESC_COPY')) > 0 REPLACE USERFILE2->LDESC_COPY WITH PRNT_DESARR[5] ENDIF IF USERFILE2->(FIELDPOS('GLINE_DESC')) > 0 REPLACE USERFILE2->GLINE_DESC WITH PRNT_DESARR[6] ENDIF REPLACE USERFILE2->LINE_DESC WITH PRNT_DESARR[4] REPLACE USERFILE2->LOC_CODE WITH PRNT_DESARR[2] REPLACE USERFILE2->GLASSORDER WITH IF(PRNT_DESARR[3], 'Y', 'N') RETURN { STOP_SHOW, O_CHGLIST, P_CHGLIST } *************************************************** FUNCTION DISP_CHANGES(P_CHGLIST, O_CHGLIST) LOCAL M1:= '' , M2 := '' IF LEN(P_CHGLIST) > 0 M1 = ' PRICE CHANGES on Lines ' + P_CHGLIST ENDIF IF LEN(O_CHGLIST) > 0 M2 = ' OPTION CHANGES on Lines ' + O_CHGLIST ENDIF ERR_BOX( M1, ; M2, ; ' PLEASE REVIEW Each Line ') RETURN .T. *************************************************** FUNCTION CK_STOCK_SIZE(MPROD_CODE, GET_ARR) // STOCK ITEM edit (proper stock rule and std_size) LOCAL RESULT, SAVESEL := SELECT(), RETVAL := .T. // ONLY ITEMS WITH IN_STOCK$'X' GOT TO HERE. // FIRST CHECK IF THERE IS A RULE AT THE SS FILE LEVEL // THEN CHECK IF THERE IS A RULE AT THE PRODUCT FILE LEVEL // IF NO RULES, RETURN .T. IF !EMPTY(STD_SIZES->RULE_PACK) RESULT = CHK_RULE(STD_SIZES->RULE_PACK, GET_ARR, , _SELFILE) IF RESULT RETVAL := .T. ELSE RETVAL := .F. ENDIF ELSE SELECT PRODUCT SEEK MPROD_CODE // stock item rule stored in the product file IF !EMPTY(PRODUCT->RULE_PACK) RESULT = CHK_RULE(PRODUCT->RULE_PACK, GET_ARR, , _SELFILE) IF RESULT RETVAL := .T. ELSE RETVAL := .F. ENDIF ENDIF SELECT (SAVESEL) ENDIF RETURN RETVAL ****************************************************************** FUNCTION CK_STD_STOCK_SIZE(MPROD_CODE, GET_ARR, ACTION, ADDL_MODE) LOCAL SAVESEL := SELECT(), RETVAL := .T. LOCAL SAVEORD, ELEM1, ELEM2, PARENT_ARR LOCAL POTENTIAL_STOCK:=.F., SEEKPROD LOCAL OR_TOP := 0, OR_BOT := 0 LOCAL OR_RES := 'N' LOCAL SS_RES := 'N', SIZE_ARR LOCAL SK_RES := 'N', MWIDTH := 0, MHEIGHT := 0 LOCAL I, WK_TOP //P3N - 2/20/98 IF ACTION = NIL ACTION = 'ALL' ENDIF FILE2USE := 'USERFILE2' MWIDTH := DECVAL( (FILE2USE)->WIDTH ) MHEIGHT:= DECVAL( (FILE2USE)->HEIGHT) SELECT STD_SIZES DONSETORD(2) ELEM1 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'ORIEL TOP'}) ELEM2 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'ORIEL BOTT'}) IF ELEM2 > 0 OR_BOT := DECVAL(GET_ARR[ELEM2, 4]) ENDIF IF ELEM1 > 0 OR_TOP := DECVAL(GET_ARR[ELEM1, 4]) ENDIF IF EMPTY(USERFILE2->PAR_PROD) // NOT ADDL MODE **SEEK MPROD_CODE + STR( (FILE2USE)->ACT_WIDTH,10,6) + STR( (FILE2USE)->ACT_HEIGHT,10,6) SIZE_ARR := CONV_SIZE( MPROD_CODE, MWIDTH,; MHEIGHT, (FILE2USE)->HOW_MEAS, .T.) SEEK MPROD_CODE + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) ELSE * SIZE_ARR := CONV_SIZE(USERFILE2->PAR_PROD, DECVAL(USERFILE2->WIDTH),; * DECVAL(USERFILE2->HEIGHT), USERFILE2->HOW_MEAS) * SIZE_ARR := CONV_SIZE(USERFILE2->PAR_PROD, USERFILE2->ACT_WIDTH,; * USERFILE2->ACT_HEIGHT, USERFILE2->HOW_MEAS) SIZE_ARR := CONV_SIZE(USERFILE2->PAR_PROD, MWIDTH,; MHEIGHT, USERFILE2->HOW_MEAS, .T.) **SEEK USERFILE2->PAR_PROD + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) SEEK MPROD_CODE + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) ENDIF IF ADDL_MODE PARENT_ARR := SET_PARENT(USERFILE2->ORDER_NUM+STR(USERFILE2->LINE_NUM) ) SS_RES := PARENT_ARR[1] //STD_SIZE SK_RES := PARENT_ARR[2] //IN_STOCK OR_RES := PARENT_ARR[3] //ORIEL_SIZE ** SS_RES = PARENT SS ** SK_RES = PARENT SK ** OR_RES = PARENT OR ELSE IF FOUND() // POTENTIAL STD/STOCK/STOCK_ORIEL SS_RES := 'Y' IF STD_SIZES->ORIEL_SIZE$'X' .OR. OR_TOP <> OR_BOT OR_RES := 'Y' ELSE //** P3N - 2/20/98 -( KC ONLY SITE W\"IS ORIEL") //** NON STANDARD ORIEL I := ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'IS ORIEL'}) IF EMPTY(I) // NO IS ORIEL OPTION ELSEIF ALLTRIM(GET_ARR[I,4]) == 'ORIEL' //USER OPT RESPONSE OR_RES := 'Y' //SET AS AN ORIEL I := ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'ORIEL TOP'}) IF EMPTY(I) // NO ORIEL TOP ELSEIF EMPTY(GET_ARR[I,4]) //NO USER OPT RESPONSE FOR ORIEL TOP //DEFAULT TO STD SIZE ORIEL TOP IF EMPTY(STD_SIZES->ORIEL_TOP) ELSE WK_TOP := STR(STD_SIZES->ORIEL_TOP,7,4) GET_ARR[I,4] := PADR(WK_TOP, 20, ' ') ENDIF ENDIF ENDIF ENDIF // NO ATTACHMENTS TO BE CONSIDERED IN STOCK // 4-2-97 CHECK ATTACHMENTS FOR STOCK / PRODUCE ITEMS **IF STD_SIZES->STOCK_SIZE$'X' .AND. EMPTY( (FILE2USE)->PAR_PROD ) IF STD_SIZES->STOCK_SIZE$'X' POTENTIAL_STOCK := CK_STOCK_SIZE(MPROD_CODE, GET_ARR) ENDIF IF POTENTIAL_STOCK .AND. (FILE2USE)->STD_OPTS$'Y' // NO ORIEL ATTRIBUTES FOUND .OR. SPECIFIED IF (FILE2USE)->STD_OPTS$'Y' IF OR_TOP = 0 .AND. OR_BOT = 0 SK_RES := 'Y' ENDIF ENDIF ENDIF ELSE IF OR_TOP <> OR_BOT OR_RES := 'Y' ENDIF ENDIF ENDIF REPLACE (FILE2USE)->STD_SIZE WITH SS_RES REPLACE (FILE2USE)->IN_STOCK WITH SK_RES REPLACE (FILE2USE)->ORIEL_SIZE WITH OR_RES DONSETORD(SAVEORD) SELECT (SAVESEL) RETURN RETVAL ****************************************************************** * GET THE PARENT STOCK, STD_SIZE, ORIEL_SIZE * ****************************************************************** FUNCTION SET_PARENT(KEY) LOCAL RET_ARR := {'N', 'N', 'N'} IF (CUR_OL)->(DBSEEK(KEY)) RET_ARR[1] := (CUR_OL)->STD_SIZE RET_ARR[2] := (CUR_OL)->IN_STOCK RET_ARR[3] := (CUR_OL)->ORIEL_SIZE ENDIF RETURN RET_ARR ****************************************************************** FUNCTION CONV_SIZE(PROD, MWIDTH, MHEIGHT, HM, USE_SAW) // CONVERTS WIDTH,HEIGHT TO TIP TO TIP MEASUREMENT FOR PROD_CODE LOCAL SAVESEL := SELECT(), SAVEREC, ES_WD := 0, ES_HT := 0 SELECT PRODUCT SAVEREC := RECNO() SEEK PROD IF USE_SAW = NIL USE_SAW := .F. ENDIF DO CASE // THE FINAL SIZE IS THE CONVERTED ENTRY SIZE + CATEGORY ADJS // AND ADJUSTMENTS BASED ON HOW MEASURED // THIS IS THE CONVERTED ENTRY SIZE OF EITHER STAND-ALONE PRODUCT // OR THE PRODUCT IT IS TO BE ATTACHED TO. CASE UPPER( HM ) == 'OS' //* OPENING SIZE ES_WD := PRODUCT->OS_WIDTH + MWIDTH ES_HT := PRODUCT->OS_HEIGHT + MHEIGHT CASE UPPER( HM ) == 'TO' //* TT WIDTH OS HEIGHT ES_WD := PRODUCT->TT_WIDTH + MWIDTH ES_HT := PRODUCT->OS_HEIGHT + MHEIGHT CASE UPPER( HM ) == 'OT' //* OS WIDTH TT HEIGHT ES_WD := PRODUCT->OS_WIDTH + MWIDTH ES_HT := PRODUCT->TT_HEIGHT + MHEIGHT CASE UPPER( HM ) == 'WO' //* WIDTH ONLY ES_WD := PRODUCT->NS_WIDTH + MWIDTH ES_HT := 0 CASE UPPER( HM ) == 'BW' //* BASEMENT WINDOW ES_WD := PRODUCT->TT_WIDTH + MWIDTH ES_HT := 0 CASE UPPER( HM ) == 'TT' //* TIP-TIP ES_WD := PRODUCT->TT_WIDTH + MWIDTH ES_HT := PRODUCT->TT_HEIGHT + MHEIGHT CASE UPPER( HM ) == 'NS' //* NOMINAL SIZE ES_WD := PRODUCT->NS_WIDTH + MWIDTH ES_HT := PRODUCT->NS_HEIGHT + MHEIGHT ENDCASE IF USE_SAW ES_WD := ES_WD + PRODUCT->SAW_WIDTH ES_HT := ES_HT + PRODUCT->SAW_HEIGHT ENDIF GOTO SAVEREC SELECT (SAVESEL) RETURN {ES_WD, ES_HT} ****************************************************************** FUNCTION STD_SIZE_EDIT(MPROD_CODE) LOCAL LEFTPART, RITEPART, TT_ARR := {} LOCAL MIDDLE := AT(' X ', OPT_VALUE) LOCAL NOM_SIZE := .F., MENTRY_SIZE := ALLTRIM(OPT_VALUE) LOCAL REG_SIZE := .T. LOCAL WDFEET, WDINCH, HTFEET, HTINCH LOCAL LEFTVAL, RITEVAL, WONLY_OK := .F. * // CHECK FOR VALID 99 X 99 SIZE PRODUCT->(DBSEEK(MPROD_CODE)) IF EMPTY(PRODUCT->ALLOW_SIZE) .OR. 'W'$PRODUCT->ALLOW_SIZE WONLY_OK := .T. ENDIF IF MIDDLE = 0 REG_SIZE := .F. ELSE // GOT ?? X ??, NOW CHECK FOR VALID ITEMS BOTH SIDES OF "X" LEFTPART = ALLTRIM(LEFT(OPT_VALUE, MIDDLE-1)) RITEPART = ALLTRIM(SUBS(OPT_VALUE, MIDDLE+3)) LEFTVAL := DECVAL(LEFTPART) RITEVAL := DECVAL(RITEPART) IF !CHK_FRACTION(LEFTPART, 'EDIT') .OR. !CHK_FRACTION(RITEPART,'EDIT') REG_SIZE := .F. ELSEIF DECVAL(LEFTPART) = 0 REG_SIZE := .F. ELSEIF DECVAL(RITEPART) = 0 .AND. !WONLY_OK REG_SIZE := .F. ENDIF ENDIF IF !REG_SIZE .AND. !NOM_SIZE IF EMPTY(OPT_VALUE) //** P3N - 4/2/98 RETURN .T. //** ALLOW THE DELETION OF STD SIZES ELSE SS_ERROR() RETURN .F. ENDIF ELSE REPLACE OS_WIDTH WITH LEFTVAL REPLACE OS_HEIGHT WITH RITEVAL REPLACE OPT_VALUE WITH LEFTPART + ' X ' + RITEPART TT_ARR := SIZE_CONVERT(MPROD_CODE, 'OS', 'TT', OS_WIDTH, OS_HEIGHT) REPLACE TT_WIDTH WITH TT_ARR[1] REPLACE TT_HEIGHT WITH TT_ARR[2] ENDIF RETURN .T. *********************************** FUNCTION SS_ERROR() ERR_BOX( ' Standard Opening Sizes MUST Be in Format ', ; ' 99 X 99 (With Fractions) ', ; ' PLEASE RE-ENTER ') RETURN .T. * * * * * * * * * * * * * STATIC PROCEDURE SAY_GET(CMD, GET_COL, LAST_GETVAR, NUM2GET, GET_ARR, MSTD_OPTS, ADDL_MODE, ROW) LOCAL I, STRT_INLIST, L2, NUMGET := 0 **LOCAL ROW SETCOLOR(HNOR) **ROW = 4 STRT_INLIST = LAST_GETVAR - NUM2GET + 1 FOR I := STRT_INLIST TO LAST_GETVAR IF GET_ARR[I,7] // PROCESS THIS ONE? ROW++ *** NUMGET++ NUMGET := NUMGET + 1 IF CMD = 'SAY' @ ROW,GET_COL SAY ':' @ ROW,GET_COL+1 SAY GET_ARR[I,4] @ROW(), COL() SAY ':' ELSE // GETLOOP @ ROW,GET_COL+1 GET GET_ARR[I,4] WHEN WHEN_GET(GET_ARR, ADDL_MODE) ; VALID VALID_GET(GET_ARR, ADDL_MODE) ENDIF ENDIF NEXT IF CMD = 'GET' .AND. NUMGET > 0 READ() ENDIF SETCOLOR(LNOR) RETURN * * * * * * * * * * * * * FUNCTION VALID_GET(GET_ARR, ADDL_MODE) // THIS IS THE VALID CONDITION ON THE GETS IN SAY_GET // NEED TO VALIDATE THE PICK LIST INPUT LOCAL X, ELEM, NEW_VAL, MTYPE, ELEM2, RESULT LOCAL DEF_VALU, OPT_ARR, CUROPT // IF IT'S A CURSOR MOVEMENT, DON'T DO THE VALID IF LASTKEY() = K_UP .OR. LASTKEY() = K_DOWN .OR. LASTKEY() = K_PGUP ; .OR. LASTKEY() = K_PGDN @ 0,0 SAY SPACE(12) SETKEY(-4,{|| ''}) RETURN .T. ENDIF X = GETACTIVE() ELEM = X[2,1] *****NEW_VAL = X[12] NEW_VAL = X:BUFFER MTYPE = GET_ARR[ELEM,2] //** P3N - 10/13/06 - PER ELLEN IF ADDL OPT USE PARENT FRAME COLOR CUROPT := GET_ARR[ELEM,1] //** P3N - 10/13/06 DO CASE CASE MTYPE$'PT' // PICK LIST OR TABLE LIST??? IF ADDL_MODE //** P3N - 10/13/06 IF CUROPT = 'FR COLOR' //** P3N - 10/13/06 IF EMPTY(NEW_VAL) //** P3N - 10/13/06 NEW_VAL := USERFILE2->PAR_COLOR //** P3N - 10/13/06 ENDIF //** P3N - 10/13/06 ENDIF //** P3N - 10/13/06 ENDIF //** P3N - 10/13/06 ELEM2 = ASCAN(GET_ARR[ELEM,3], {|XX| ALLTRIM(XX[1]) == ALLTRIM(NEW_VAL)}) //**IF ELEM2 = 0 //** P3N - 10/13/06 IF ELEM2 = 0 .OR. ADDL_MODE //** P3N - 10/13/06 IF ADDL_MODE .AND. NEW_VAL = 'N/A' //** P3N - 10/13/06 RESULT := .T. ELSE RESULT = SET_PICK(GET_ARR, NEW_VAL) // GET INPUT FROM PICKLIST ENDIF //** RESULT = SET_PICK(GET_ARR) // GET INPUT FROM PICKLIST IF !RESULT RETURN .F. ENDIF ENDIF IF ELEM2 > 0 OPT_ARR := GET_ARR[ELEM,3] GET_ARR[ELEM,11] := OPT_ARR[ELEM2,11] // UPDATE CURRENT PAR_PROD ENDIF IF X:CHANGED X:KILLFOCUS() // TERMINATE THE GET // CHECK TO SEE IF THE "NEW" VALUE IS THE DEFAULT OR NOT. DEF_VALU := GET_DEFAULT(ELEM, GET_ARR, ADDL_MODE) IF GET_ARR[ELEM,4] == DEF_VALU GET_ARR[ELEM,9] := '*' ELSE GET_ARR[ELEM,9] := ' ' ENDIF ELSE X:KILLFOCUS() // TERMINATE THE GET ENDIF CASE MTYPE$'U' IF X:CHANGED IF GET_ARR[ELEM,1] = 'ORIEL TOP' .OR. GET_ARR[ELEM,1] = 'ORIEL BOTT' CK_STD_STOCK_SIZE(USERFILE2->PROD_CODE, GET_ARR, 'ALL', ADDL_MODE) ENDIF ENDIF ENDCASE @ 0,0 SAY SPACE(12) SETKEY(-4,{|| ''}) RETURN .T. * * * * * * * * * * * * * FUNCTION WHEN_GET(GET_ARR, ADDL_MODE) // THIS IS THE WHEN CONDITION ON THE GETS IN SAY_GET LOCAL X, ELEM, ELEM2, MTYPE, ARR := {}, NCHOICE LOCAL CUR_VAL, NTOP, NLEFT, NRIGHT, NBOTTOM, SAVEBOX LOCAL L, BCENTER, OFFSET, HEADER, RESULT, NCOLOR, NPOS LOCAL RULE_ARR := {}, MELEM, SAVESEL := SELECT(), DEF_VALU, GET_LEN LOCAL CHG_2_DEF := .F., MRULE, ADDIT @ 0,0 SAY SPACE(12) X = GETACTIVE() ELEM = X[2,1] MTYPE = GET_ARR[ELEM,2] // CHECK INCLUDE RULE AT THE ATTRIBUTE LEVEL RESULT = CHK_RULE(GET_ARR[ELEM,6], GET_ARR, , _SELFILE) IF !RESULT // SEE IF THERE IS AN OPTION RECORD OUT THERE & DELETE IT! SELECT USERFILE8 IF ADDL_MODE SEEKKEY = USERFILE2->ORDER_NUM + USERFILE2->PROD_CODE + STR(USERFILE2->LINE_NUM,3) + GET_ARR[ELEM,1] // ATT_CODE ELSE SEEKKEY = USERFILE2->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + GET_ARR[ELEM,1] // ATT_CODE ENDIF SEEK SEEKKEY IF FOUND() REC_LOCK(3) REPLACE ORDER_NUM WITH '' REPLACE LINE_NUM WITH 0 REPLACE ATT_CODE WITH '' REPLACE USER_RESP WITH '' IF ADDL_MODE REPLACE PROD_CODE WITH '' ENDIF DELETE UNLOCK ENDIF SELECT(SAVESEL) // MAKE VALUE = "N/A" AND REDISPLAY IT IF MTYPE$'U' GET_ARR[ELEM,4] = ' ' + SPACE( LEN(GET_ARR[ELEM,4]) -3 ) ELSE GET_ARR[ELEM,4] = 'N/A' + SPACE( LEN(GET_ARR[ELEM,4]) -3 ) ENDIF X:DISPLAY(GET_ARR[ELEM,4]) // PUT VALUE ON THE SCREEN RETURN .F. // RULES DIDN'T PASS! ENDIF // IF NO DEFAULT OPTIONS OR (STD_OPTS AND PICKED DEFAULT) // REEVALUATE THE DEFAULT JUST IN CASE OTHER CHANGES RESULT // IN A NEW DEFAULT GET_LEN := LEN(GET_ARR[ELEM,4]) IF GET_ARR[ELEM,2]$'PT' // LOOK FOR THE DEFAULT VALUE DEF_VALU := GET_DEFAULT(ELEM, GET_ARR, ADDL_MODE) IF !EMPTY(DEF_VALU) IF GET_ARR[ELEM,9] = '*' ; .AND. GET_ARR[ELEM,4] <> DEF_VALU CHG_2_DEF := .T. ELSE IF USERFILE2->STD_OPTS$'Y' ; .AND. GET_ARR[ELEM,4] <> DEF_VALU CHG_2_DEF := .T. ELSE IF !USERFILE2->STD_OPTS$'Y' ; // NON STANDARD OPTIONS-INVALID OPTION .AND. !VALID_OPTION(GET_ARR[ELEM]) CHG_2_DEF := .T. ENDIF ENDIF ENDIF ENDIF IF CHG_2_DEF .AND. GET_ARR[ELEM,4] <> DEF_VALU GET_ARR[ELEM,4] = DEF_VALU GET_ARR[ELEM,9] := '*' // IF THE CALCULATED DEFAULT DON'T GET IT! X:DISPLAY(GET_ARR[ELEM,4]) // PUT VALUE ON THE SCREEN RETURN .F. ENDIF ENDIF // HILITE THE CURRENT GET CUR_VAL = GET_ARR[X[2,1], X[2,2] ] X:SETFOCUS() // MUST SET FOCUS TO DO THE FOLLOWING NCOLOR = X:COLORSPEC() // GET THE CURRENT COLORS NPOS = AT(',', NCOLOR) NCOLOR = LEFT(NCOLOR,NPOS) + 'W+/R' X:COLORDISP(NCOLOR) // SET THE SELECTED COLOR X:DISPLAY(CUR_VAL) // PUT VALUE ON THE SCREEN X:KILLFOCUS() // TERMINATE THE GET DO CASE CASE MTYPE = 'U' // USER INPUT @ 0,0 SAY SPACE(12) SETKEY(-4,{|| ''}) RETURN .T. CASE MTYPE = 'C' // CALCULATION TYPE - SHOULD NEVER GET HERE! @ 0,0 SAY SPACE(12) SETKEY(-4,{|| ''}) // MAKE SURE HOT KEY IS OFF RETURN .F. // DONT DO A GET! CASE MTYPE$'P' // PICK LIST FOR L = 1 TO LEN(GET_ARR[ELEM,3]) // LOAD UP THE AVAILABLE OPTIONS!! ******AADD(ARR, GET_ARR[ELEM,3,L,1]) ******MRULE := GET_ARR[ELEM,3,L,3] MRULE := GET_ARR[ELEM,3,L,18] ADDIT := .T. IF !EMPTY(MRULE) // DON'T INCLUDE IF RULE ISN'T TRUE ADDIT := CHK_RULE(MRULE, GET_ARR, , _SELFILE) // SINCE NOT A DEFAULT SITUATION ENDIF IF ADDIT AADD(ARR, GET_ARR[ELEM,3,L,1]) ENDIF NEXT IF LEN(ARR) > 1 // SET UP HOT KEY SETKEY(-4, {|| SET_PICK(GET_ARR)}) SETCOLOR(HREV) @ 0,0 SAY 'F5 for List' SETCOLOR(LNOR) // CHECK IF CURRENT VALUE IS IN VALID LIST IF ASCAN(ARR, {|X| X == GET_ARR[ELEM,4] }) = 0 GET_ARR[ELEM,4] := SPACE(LEN(GET_ARR[ELEM,4])) KEYBOARD CHR(13) // FORCE IT INTO THE PICKLIST!!! ENDIF ELSE // IF 1 ELEMENT AND GOING DOWN THRU LIST, STUFF IT INTO KEYBOARD IF LEN(ARR) = 1 .AND. ; !(LASTKEY() = K_UP .OR. LASTKEY() = K_PGUP ) KEYBOARD ARR[1] ENDIF ENDIF IF GET_ARR[ELEM,4] = 'No DEFAULT Options!!' ; .OR. ALLTRIM(GET_ARR[ELEM,4]) = 'N/A' KEYBOARD CHR(13) // FORCE IT INTO THE PICKLIST!!! ENDIF RETURN .T. ENDCASE @ 0,0 SAY SPACE(12) SETKEY(-4,{|| ''}) RETURN .T. *************************************************************** FUNCTION VALID_OPTION(VAL_ARR) LOCAL OPTARR := VAL_ARR[3] LOCAL ELEM := ASCAN(OPTARR, {|X| X[1] == VAL_ARR[4]}) IF ELEM > 0 RETURN .T. ELSE RETURN .F. ENDIF *************************************************************** * * * * * * * * * * * * * FUNCTION SET_ORDKEY // SET A HOT KEY TO UPDATE THE ORDER OPTIONS FROM THE ORDER LINE SCREEN LOCAL SAVECOLOR := SETCOLOR(HREV) SET KEY -3 TO GET_LINEOPTS(USERFILE2->PROD_CODE) @ 0,0 SAY 'F4 to Update Options' SETCOLOR(SAVECOLOR) RETURN NIL * * * * * * * * * * * * * FUNCTION RESET_ORDKEY // RESET A HOT KEY TO UPDATE THE ORDER OPTIONS FROM THE ORDER LINE SCREEN SET KEY -3 RETURN NIL * * * * * * * * * * * * * * * * * * * * * * * * * * //** P3N - 4/16/98 (YES I survived tax day!) - BARELY **FUNCTION GET_TOTQTY() **LOCAL WKFLD := ALLTRIM(STR(LINE_NUM, 3)) + '/' + ALLTRIM(PROD_CODE) **LOCAL SHIPQTY := CHK_SHIPQTY('SHIPQTY') **ERR_BOX ('** Order Quantity for '+WKFLD+' is - ' + ALLTRIM(STR(QUANTITY,3)) + ' **', ; ** '** Quantity Shipped '+SPACE(LEN(WKFLD))+' is - ' + ALLTRIM(STR(SHIPQTY,3)) + ' **' ) **RETURN .T. * * * * * * * * * * * * * * * * * * * * * * * * * * //HOTKEY CTRL+T RETURNS THE CURRENT DATE FOR THE ORDER CONTROL SCREEN //** P3N - 4/16/98 (YES I survived tax day!) - BARELY * * * * * * * * * * * * * //** NOTE: IF THE IMPORTCUST DEFINITION FOR THE ORD_SHIP (CGW0OSW/CGW0OST) //** NOTE: OR THE IMPORTCUST DEFINITION FOR THE ORD_PROD (CGW0OPW/CGW0OPT) //** NOTE: CHANGES FOR THE FIELDS COMPL_DATE, SHIP_DATE, OR CONFIRM_DATE //** NOTE: THIS LOGIC IS SUBJECT TO CHANGE ACCORDING TO THE ORDER OF THE //** NOTE: THE FIELDS IN THE IMPORT CUST AND THE COLUMN HEADINGS. * * * * * * * * * * * * * **FUNCTION GET_CURDATE(REMOVEDT) **LOCAL OCURR_COL := OBROW:GETCOLUMN(OBROW:COLPOS) **LOCAL FLD, COL_HEADING := UPPER( OCURR_COL:HEADING ) **LOCAL RETVAL := .T., REPLVAL **IF EMPTY(REMOVEDT) ** REPLVAL := CURDATE **ELSEIF REMOVEDT == 'REMOVEDT' ** REPLVAL := CTOD(' / / ') **ENDIF **REC_LOCK(3) **IF COL_HEADING = 'PROD DATE' ** FLD := COLARR[3,2] //** COMPL_DATE-ORD_PROD ** REPLACE &FLD WITH REPLVAL //** COMPL_DATE-ORD_PROD **ELSEIF COL_HEADING = 'SHIP ' ** FLD := COLARR[5,2] //** SHIP_DATE-ORD_SHIP ** IF EMPTY(&FLD) //** SHIP_DATE-ORD_SHIP ** REPLACE &FLD WITH REPLVAL //** SHIP_DATE-ORD_SHIP ** ENDIF ****ELSEIF COL_HEADING = 'DELIV' **** FLD := COLARR[6,2] //** CONFIRM_DT-ORD_SHIP **** REPLACE &FLD WITH REPLVAL //** CONFIRM_DT-ORD_SHIP **ENDIF **IF DUPL_CTRLDT() ** REPLACE &FLD WITH CTOD(' / / ') //** DUPL DATE RESET TO EMPTY **ENDIF **UNLOCK **RETURN RETVAL ** * * * * * * * * * * * * * *********************************** //**FUNCTION SET_PICK(GET_ARR) //** P3N 10/13/06 FUNCTION SET_PICK(GET_ARR, NEW_VAL) //** P3N - 10/13/06 // USE PICKLIST FOR CURRENT GET - CONTAINS LIST OF OPTIONS AVAILABLE LOCAL X, ELEM, L, ARR := {}, ELEM2, CUR_VAL, MIRULE LOCAL NTOP, NLEFT, NRIGHT, NBOTTOM, SAVEBOX LOCAL BCENTER, OFFSET, HEADER, RESULT, MRULE, MDEF, ADDIT := .F. LOCAL SVSCRN := SAVESCREEN() SET KEY -4 TO // TURN OFF HOT KEY X = GETACTIVE() ELEM = X[2,1] // DON'T ADD TO ARRAY IF THE RULE IF FALSE AND NO DEFAULT FLAG FOR L = 1 TO LEN(GET_ARR[ELEM,3]) // IF NO ASTERICK AND A RULE IS PRESENT // THEN ONLY AN OPTION IF THE RULE IS TRUE. MRULE := GET_ARR[ELEM,3,L,3] MIRULE := GET_ARR[ELEM,3,L,18] MDEF := GET_ARR[ELEM,3,L,2] ADDIT := .T. IF !EMPTY(MIRULE) // DON'T INCLUDE IF RULE ISN'T TRUE ADDIT := CHK_RULE(MIRULE, GET_ARR, , _SELFILE) ELSE IF MDEF = ' ' .AND. !EMPTY(MRULE) // DON'T INCLUDE IF RULE ISN'T TRUE ADDIT := CHK_RULE(MRULE, GET_ARR, , _SELFILE) // SINCE NOT A DEFAULT SITUATION ENDIF ENDIF IF EMPTY(NEW_VAL) //** P3N - 10/13/06 //** USE CUR_VAL //** P3N - 10/13/06 ELSE //** P3N - 10/13/06 //** P3N - 10/13/06 - PER ELLEN IF ADDL OPT USE PARENT FRAME COLOR ADDIT := .F. //** P3N - 10/13/06 IF GET_ARR[ELEM,3,L,1] = NEW_VAL //** P3N - 10/13/06 ADDIT := .T. //** P3N - 10/13/06 ENDIF //** P3N - 10/13/06 ENDIF //** P3N - 10/13/06 IF ADDIT AADD(ARR, GET_ARR[ELEM,3,L,1]) ENDIF NEXT IF LEN(ARR) > 1 CUR_VAL = GET_ARR[X[2,1], X[2,2] ] HEADER = GET_ARR[ELEM,1] ELEM2 = ASCAN(ARR, {|X| X == CUR_VAL}) NTOP = X:ROW - 1 NLEFT = X:COL + LEN(CUR_VAL) NRIGHT = NLEFT + LEN(CUR_VAL) NBOTTOM = NTOP + LEN(ARR) + 1 IF NBOTTOM > MAXROW() -2 NBOTTOM = MAXROW() -2 ENDIF SAVEBOX = SAVESCREEN(NTOP,NLEFT,NBOTTOM+1,NRIGHT+1) * SETCOLOR(BLACK) @ NTOP+1,NLEFT+1 CLEAR TO NBOTTOM+1,NRIGHT+1 // DRAW SHADOW BOX SETCOLOR(HNOR) @ NTOP,NLEFT CLEAR TO NBOTTOM,NRIGHT // DRAW BACKROUND COLOR @ NTOP,NLEFT TO NBOTTOM,NRIGHT // DRAW DOUBLE LINE // FIND THE CENTER OF THE BOX BCENTER = INT( (NRIGHT - NLEFT) / 2) OFFSET = INT(LEN(HEADER) / 2) SETCOLOR(HREV) @ NTOP,NLEFT+(BCENTER-OFFSET) SAY HEADER SETCOLOR(LNOR) DO WHILE .T. NCHOICE := ACHOICE(NTOP+1,NLEFT+1,NBOTTOM-1,NRIGHT-1,ARR,,,ELEM2) // DON'T LEAVE UNLESS VALID INPUT OR ESCAPE KEY IS PRESSED!!! IF NCHOICE <> 0 EXIT ELSE IF LASTKEY() = 27 RESTSCREEN(NTOP,NLEFT,NBOTTOM+1,NRIGHT+1,SAVEBOX) SETKEY(-4, {|| SET_PICK(GET_ARR)}) // TURN HOT KEY BACK ON RETURN .F. ENDIF ENDIF ENDDO ELSE NCHOICE = 1 ENDIF IF EMPTY(NCHOICE) .OR. NCHOICE > LEN(ARR) RESTSCREEN(,,,,SVSCRN) SETKEY(-4, {|| SET_PICK(GET_ARR)}) // TURN HOT KEY BACK ON RETURN .F. ELSE X:BUFFER = ARR[NCHOICE] // STUFF THE BUFFER X:ASSIGN() // UPDATE THE GET VAR IF LEN(ARR) > 1 RESTSCREEN(NTOP,NLEFT,NBOTTOM+1,NRIGHT+1,SAVEBOX) ENDIF IF PROCNAME(1) = '(b)WHEN_GET' KEYBOARD ARR[NCHOICE] ENDIF SETKEY(-4, {|| SET_PICK(GET_ARR)}) // TURN HOT KEY BACK ON! RETURN .T. ENDIF ************************************************* FUNCTION CHK_RULE(MRULE, GET_ARR, MTYPE, SELFILE, GETELM) // CHECK THE RULE FOR MRULE // MTYPE = 'M' FOR MATH PACKS LOCAL MELEM, L, RULE_ARR := {}, RESULT := .T. STATIC ALL_RULES IF ALL_RULES = NIL ALL_RULES := {} ENDIF IF !EMPTY(MRULE) // RULE PACK NAME MELEM = 0 FOR L = 1 TO LEN(ALL_RULES) IF ALLTRIM(ALL_RULES[L,1]) == ALLTRIM(MRULE) MELEM = L EXIT ENDIF NEXT IF MELEM = 0 RULE_ARR = GETRULES(MRULE, SELFILE, GET_ARR, GETELM) // RULE PACK NAME IF !EMPTY(RULE_ARR) AADD(ALL_RULES, {MRULE , RULE_ARR}) MELEM = LEN(ALL_RULES) ELSE //////////////////////////////////////////////////////////// // A RULE NAME WAS PASSED BUT NO RULE PACKET INFO WAS FOUND!!!! //////////////////////////////////////////////////////////// IF MTYPE = 'M' RETURN RULE_ARR ELSE RETURN .T. ENDIF ENDIF ELSE RULE_ARR = ALL_RULES[MELEM,2] ENDIF IF MTYPE = 'M' RETURN RULE_ARR ELSE RESULT = EVALCLRULES({RULE_ARR},,GET_ARR, SELFILE) // RULE ARRAY ENDIF ENDIF RETURN RESULT ******************************************************************** FUNCTION GET_DEFAULT(ELEM, GET_ARR, ADDL_MODE) // GET DEFAULT VALUE OPTION LOCAL RETVAL := '', L2, RESULT, I, GOODNUM LOCAL RETVALLEN, NUM_AVAIL, CK_ARR:= {} IF !EMPTY(GET_ARR[ELEM,3]) // HAS OPTIONS ** CHECK TO SEE IF THE ATTRIBUTE IS RULE DEPENDENT. IF !CHK_RULE(GET_ARR[ELEM,6], GET_ARR, , _SELFILE) // THE RULE NAME AT ATTRIBUTE LEVEL RETURN RETVAL ENDIF FOR L2 = 1 TO LEN(GET_ARR[ELEM,3]) IF EMPTY(GET_ARR[ELEM,3,L2,18]) ; // IF OPTION HAS AN INCLUDE RULE .OR. CHK_RULE(GET_ARR[ELEM,3,L2,18], GET_ARR, , _SELFILE) // THE RULE NAME AADD(CK_ARR, GET_ARR[ELEM,3,L2]) ENDIF NEXT **FOR L2 = 1 TO LEN(GET_ARR[ELEM,3]) FOR L2 = 1 TO LEN(CK_ARR) ** IF GET_ARR[ELEM,3,L2,2] = '*' .OR. LEN(GET_ARR[ELEM,3]) = 1 IF CK_ARR[L2,2] = '*' .OR. LEN(CK_ARR) = 1 ** CHECK TO SEE IF THE DEFAULT OPTION IS RULE DEPENDENT. RESULT = .T. // CHECK FOR OPTION RULE! **** IF !EMPTY(GET_ARR[ELEM,3,L2,3]) // IF OPTION HAS A DEFAULT RULE IF !EMPTY(CK_ARR[L2,3]) // IF OPTION HAS A DEFAULT RULE ***** RESULT = CHK_RULE(GET_ARR[ELEM,3,L2,3], GET_ARR, , _SELFILE) // THE RULE NAME RESULT = CHK_RULE(CK_ARR[L2,3], GET_ARR, , _SELFILE) // THE RULE NAME ENDIF IF RESULT // GOOD RESULT ****** RETVAL = GET_ARR[ELEM,3,L2,1] // DEFAULT VALUE RETVAL = CK_ARR[L2,1] // DEFAULT VALUE RETVALLEN := LEN(RETVAL) IF GET_ARR[ELEM,2] = 'T' // IF TABLE TYPE IF ISDIGIT(LEFT(LTRIM(RETVAL),1)) RETVAL = 'V' + LTRIM(RETVAL) ELSE RETVAL = SUBS(LTRIM(RETVAL)+SPACE(RETVALLEN), 1, RETVALLEN) ENDIF ENDIF EXIT // NO NEED TO DO ANYMORE! ENDIF ENDIF NEXT ENDIF RETURN RETVAL ****************************************************************** FUNCTION PAR_ATT_VALU(ADDL_MODE, REALFILE) // DISPLAY THE COLOR OF PRODUCT ON THE LINE ITEM SCREEN FOR EACH MODEL LOCAL RETVAL, SEEKKEY LOCAL SAVESEL := SELECT() IF REALFILE = NIL REALFILE := 'USERFILE8' // USER ORDER_OPTS / ADDL_OPTS , NOT USERFILE8 ENDIF IF ADDL_MODE = NIL ADDL_MODE := .F. ENDIF IF ADDL_MODE SEEKKEY := &CUR_MAST->ORDER_NUM + PROD_CODE + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' ELSE SEEKKEY := &CUR_MAST->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' ENDIF SELECT (REALFILE) SEEK SEEKKEY IF FOUND() RETVAL := TRIM( (REALFILE)->USER_RESP) ELSE RETVAL := 'N/A' ENDIF SELECT (SAVESEL) RETURN RETVAL ******************************************************************** FUNCTION UPDATE_MATH(ELEM, GET_ARR) // UPDATE THE CALCULATION FIELDS LOCAL RESULT, MATH_ARR := {}, MCAT_CODE, MATT_CODE, SAVESEL := SELECT() MCAT_CODE = GET_CATCODE(USERFILE2->PROD_CODE) MATT_CODE = GET_ARR[ELEM,1] SEEKKEY = MCAT_CODE + MATT_CODE SELECT MATHPACK SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() IF MATHPACK->TYPE$' ' AADD(MATH_ARR, {FIELD1, OPERATOR, FIELD2}) ENDIF SKIP 1 ENDDO IF !EMPTY(MATH_ARR) RESULT = EVAL_MATH(MATH_ARR, GET_ARR, MCAT_CODE, MATT_CODE, _SELFILE ) DO CASE CASE VALTYPE(RESULT) = 'C' GET_ARR[ELEM,4] = RESULT CASE VALTYPE(RESULT) = 'N' GET_ARR[ELEM,4] = STR(RESULT) END CASE ENDIF SELECT (SAVESEL) RETURN NIL ******************************************************************** FUNCTION SIZE_NEEDED( SELFILE ) LOCAL RESULT, MATH_ARR := {}, MCAT_CODE, MATT_CODE LOCAL SAVESEL := SELECT(), SEEKKEY MCAT_CODE = (SELFILE)->UOM MATT_CODE = '_MISCITEM ' SEEKKEY = MCAT_CODE + MATT_CODE SELECT MATHPACK SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() IF MATHPACK->TYPE$'M' // MISC ITEM AADD(MATH_ARR, {FIELD1, OPERATOR, FIELD2}) ENDIF SKIP 1 ENDDO SELECT (SAVESEL) IF EMPTY(MATH_ARR) REPLACE ENTRY_SIZE WITH '' RETURN .F. ELSE RETURN .T. ENDIF ******************************************************************** FUNCTION MISC_PRICE( SELFILE ) LOCAL RESULT, MATH_ARR := {}, MCAT_CODE, MATT_CODE LOCAL SAVESEL := SELECT(), UOMVAR := 1, SEEKKEY LOCAL PRICEUOM:=0, PRICECOL:=0 MCAT_CODE = (SELFILE)->UOM MATT_CODE = '_MISCITEM ' SEEKKEY = MCAT_CODE + MATT_CODE SELECT MATHPACK SEEK SEEKKEY DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() IF MATHPACK->TYPE$'M' // MISC ITEM AADD(MATH_ARR, {FIELD1, OPERATOR, FIELD2}) ENDIF SKIP 1 ENDDO SELECT (SAVESEL) IF !EMPTY(MATH_ARR) .AND. EMPTY( (SELFILE)->ENTRY_SIZE ) IF LASTKEY() = K_F10 ERR_BOX( '*** Size Information is REQUIRED ') RETURN .F. ELSE UOMVAR := 0 ENDIF ELSE IF !EMPTY(MATH_ARR) UOMVAR = EVAL_MATH(MATH_ARR, {}, MCAT_CODE, MATT_CODE, SELFILE, 'MISC' ) IF VALTYPE(RESULT) = 'C' UOMVAR = VAL(RESULT) ENDIF ENDIF SEEKKEY := (SELFILE)->PARTNUM + (SELFILE)->UOM MISC_PUOM->(DBSEEK ( SEEKKEY )) DO CASE CASE (SELFILE)->PRICE_SHT$'D' PRICEUOM := MISC_PUOM->DLR_AMT CASE (SELFILE)->PRICE_SHT$'S' PRICEUOM := MISC_PUOM->SD_AMT CASE (SELFILE)->PRICE_SHT$'B' PRICEUOM := MISC_PUOM->BU_AMT CASE (SELFILE)->PRICE_SHT$'J' PRICEUOM := MISC_PUOM->DIST_AMT CASE (SELFILE)->PRICE_SHT$'L' PRICEUOM := MISC_PUOM->LUMB_AMT CASE (SELFILE)->PRICE_SHT$'I' PRICEUOM := MISC_PUOM->IC_AMT OTHERWISE PRICEUOM := 0 ENDCASE ENDIF IF PRICEUOM * UOMVAR > 9999.99 //** P3N - 2/23/99 ERR_BOX('** ERROR in SALE PRICE calculation! **', ' ', ; ' SALE PRICE should be less than 9999.99 / calc. = ' + ; STR(PRICEUOM * UOMVAR , 12,4) ) ELSE REPLACE (SELFILE)->SALE_PRICE WITH (PRICEUOM * UOMVAR) ENDIF //** P3N - 2/23/99 RETURN .T. ******************************************************************** FUNCTION GET_CATCODE(MPROD_CODE) // RETURN THE ASSOCIATED CATEGORY CODE FOR MPROD_CODE LOCAL SAVESEL := SELECT(), RETVAL, SAVEREC SELECT PRODUCT SAVEREC := RECNO() SEEK MPROD_CODE RETVAL = CAT_CODE GOTO SAVEREC SELECT(SAVESEL) RETURN RETVAL ******************************************************************** FUNCTION CHK_SIZE( PUFILENAME, ALLOW_EMPTY ) // VALIDATE THE VALUE IN THE ENTRY_SIZE FIELD FOR LINE ITEMS // MUST BE FOUR DIGITS IF HOW MEASURED = 'NS' // MUST BE DELIMITED WITH AN 'X' IF NOT! // IF ANY ENTRY SIZE ADJUSTMENTS REQUIRED THEN MAKE THEM HERE LOCAL DO_ERR := .F., MLEN, MHOW_MEAS, SEEKKEY, I LOCAL LEFTNUM, RITENUM, MIDDLE, RESULT1, RESULT2, SAVEORD LOCAL SAVESEL := SELECT() LOCAL M1:= ' ', ERRFLAG, LEFTPART, RITEPART LOCAL M2:= ' ', WORKVAR LOCAL M3:= ' ', UFILENAME LOCAL XWIDTH, XHEIGHT, ISNOMINAL := .F. LOCAL GPOS, WOPOS, ADD_QUOTE2 := .F., ADD_QUOTE1 := .F. LOCAL MHEIGHT, MWIDTH, WWIDTH, WHEIGHT, WHOWMEAS, RETVAL := .F. /* IF NOMINAL SIZE --> OK IF 99 X 99 SIZE --> OK IF 4/5/6 DIGIT SIZE --> REPLACE HOW_MEAS WITH 'NS' IF 99 X 99 SIZE --> AND HOW_MEAS <> 'TT' .OR. 'OS' - REPLACE HOW_MEAS WITH ' ' */ IF PUFILENAME = NIL UFILENAME := 'USERFILE2' ELSE UFILENAME := PUFILENAME ENDIF IF ALLOW_EMPTY = NIL ALLOW_EMPTY := .F. ENDIF IF EMPTY((UFILENAME)->ENTRY_SIZE) .AND. !ALLOW_EMPTY SIZE_ERR() RETURN .F. ENDIF IF PROCNAME(1) = 'EDITGBROW' // F10 - SIZE WAS VALIDATED AT DATA ENTRY TIME RETURN .T. ENDIF MENTRY_SIZE = ALLTRIM((UFILENAME)->ENTRY_SIZE) WORKVAR := NIL // SOMETHING X SOMETHING XPOS := AT('X', MENTRY_SIZE) IF XPOS > 0 LEFTNUM := ALLTRIM(SUBS(MENTRY_SIZE,1,XPOS -1)) IF RIGHT(LEFTNUM,1)$'"' LEFTNUM := ALLTRIM( STRTRAN( LEFTNUM, '"', ' ' )) ADD_QUOTE1 := .T. ENDIF WORKVAR := VAL_WD( UFILENAME, LEFTNUM ) IF !EMPTY(WORKVAR) WWIDTH := LEFTNUM WHOWMEASE := WORKVAR[2] RITENUM := ALLTRIM(SUBS(MENTRY_SIZE,XPOS +1)) IF RIGHT(RITENUM,1)$'"' RITENUM := ALLTRIM( STRTRAN( RITENUM, '"', ' ' )) ADD_QUOTE2 := .T. ENDIF WORKVAR := VAL_WD( UFILENAME, RITENUM ) IF !EMPTY(WORKVAR) WORKVAR[1] := WWIDTH WORKVAR[2] := RITENUM // CURRENT ONE RETURNED ******WORKVAR[3] := '' WORKVAR := { WORKVAR[1], WORKVAR[2], '' } MENTRY_SIZE := ALLTRIM(WORKVAR[1]) + ' X ' + WORKVAR[2] ENDIF ENDIF ELSE // BASEMENT WINDOWS IF AT('G', MENTRY_SIZE) > 0 WORKVAR := VAL_BW( UFILENAME, MENTRY_SIZE ) // BASEMENT WINDOW ELSE // NS ENTRY WWWHHH WORKVAR := VAL_NS( UFILENAME, MENTRY_SIZE ) IF EMPTY(WORKVAR) // SINGLE NUMBER PROCESSING LEFTNUM := ALLTRIM(MENTRY_SIZE) IF RIGHT(LEFTNUM,1)$'"' LEFTNUM := ALLTRIM( STRTRAN( LEFTNUM, '"', ' ' )) ADD_QUOTE2 := .T. ENDIF WORKVAR := VAL_WD( UFILENAME, LEFTNUM ) IF !EMPTY(WORKVAR) WORKVAR := {LEFTNUM, '', 'WO'} MENTRY_SIZE := ALLTRIM(LEFTNUM) ENDIF ENDIF ENDIF ENDIF // GOOD SIZE / HOW MEAS COMBO, NOW TEST FOR REASONABLE ENTRY SIZES IF EMPTY(WORKVAR) SIZE_ERR() RETURN .F. ENDIF MWIDTH := WORKVAR[1] MHEIGHT := WORKVAR[2] MHOW_MEAS := WORKVAR[3] XWIDTH := DECVAL(MWIDTH) XHEIGHT := DECVAL(MHEIGHT) IF PUFILENAME = NIL // NOT MISC LINE ITEMS SEEKKEY := (UFILENAME)->PROD_CODE PRODUCT->(DBSEEK(SEEKKEY)) M1 := ' MAX WIDTH IS ' + STR(PRODUCT->MAXWIDTH) M2 := ' MAX HEIGHT IS ' + STR(PRODUCT->MAXHEIGHT) M3 := ' MAX SQFT IS ' + STR(PRODUCT->MAXSQFT) M4 := ' Press Any Key to Continue . . .' ERRFLAG := .F. IF PRODUCT->MAXWIDTH > 0 IF XWIDTH > PRODUCT->MAXWIDTH ERRFLAG := .T. ENDIF ENDIF IF PRODUCT->MAXHEIGHT > 0 IF XHEIGHT > PRODUCT->MAXHEIGHT ERRFLAG := .T. ENDIF ENDIF IF PRODUCT->MAXSQFT > 0 IF (XWIDTH * XHEIGHT) / 144 > PRODUCT->MAXSQFT ERRFLAG := .T. ENDIF ENDIF IF ERRFLAG ERR_BOX('*** WARNING - MAXIMUM SIZE WAS EXCEEDED!', M1, M2, M3, M4) ENDIF ENDIF // IT'S A GOOD ENTRY, SO UPDATE HEIGHT & WIDTH SELECT (UFILENAME) REPLACE WIDTH WITH MWIDTH REPLACE HEIGHT WITH MHEIGHT IF !EMPTY(MHOW_MEAS) REPLACE HOW_MEAS WITH MHOW_MEAS ENDIF IF ADD_QUOTE1 .OR. ADD_QUOTE2 IF AT('X', MENTRY_SIZE)>0 WORKVAR := SUBS(MENTRY_SIZE,1, AT('X', MENTRY_SIZE) -1 ) IF ADD_QUOTE1 WORKVAR := WORKVAR + '"' ENDIF IF AT('X', MENTRY_SIZE ) > 0 WORKVAR := WORKVAR + ' X ' ENDIF WORKVAR := WORKVAR + SUBS(MENTRY_SIZE, AT('X', MENTRY_SIZE)+1 ) IF ADD_QUOTE2 WORKVAR := WORKVAR + '"' ENDIF MENTRY_SIZE := ALLTRIM(WORKVAR) ELSE IF ADD_QUOTE2 MENTRY_SIZE := ALLTRIM(MENTRY_SIZE) + '"' ENDIF ENDIF ENDIF REPLACE (UFILENAME)->ENTRY_SIZE WITH MENTRY_SIZE ** REPLACE (UFILENAME)->ENTRY_SIZE WITH ALLTRIM(MENTRY_SIZE) + ' "' **ENDIF IF PUFILENAME = NIL // NOT MISC LINE ITEMS // SET ADDL LINE ENTRY SIZES IF CHANGING PREVIOUS ORDER SEEKKEY := ORDER_NUM + PROD_CODE + STR(LINE_NUM,3) SELECT USERFILE6 SAVEORD := INDEXORD() DONSETORD(2) // ORDER + PAR_PROD + LINE_NUM SEEK SEEKKEY IF FOUND() .AND. ENTRY_SIZE <> (UFILENAME)->ENTRY_SIZE REPLACE ENTRY_SIZE WITH (UFILENAME)->ENTRY_SIZE REPLACE WIDTH WITH (UFILENAME)->WIDTH REPLACE HEIGHT WITH (UFILENAME)->HEIGHT REPLACE HOW_MEAS WITH (UFILENAME)->HOW_MEAS REPLACE PRICE_SHT WITH (UFILENAME)->PRICE_SHT REPLACE NEED_CALC WITH 'Y' ENDIF DONSETORD(SAVEORD) ENDIF SELECT(SAVESEL) IF MHOME_LOC_CODE == 'LINDS ' //** P3N - 5/02/00 //** LINDA DOES NOT LIKE THIS EDIT RETVAL := .T. //** P3N - 5/02/00 ELSEIF CK_ENTRYSZ() //** P3N - 4/21/00 RETVAL := .T. //** P3N - 4/21/00 ELSE //** P3N - 4/21/00 RETVAL := .F. //** P3N - 4/21/00 ERR_BOX( ' You can NOT change the entry size!', ; //** P3N - 4/21/00 ' ', ; //** P3N - 4/21/00 ' DELETE line item(F3) and Re-Enter.') //** P3N - 4/21/00 ENDIF RETURN RETVAL //**RETURN .T. *********************************************************** FUNCTION VAL_BW( UFILENAME, MENTRY_SIZE ) // BASEMENT WINDOW // TEST FOR BASEMENT WINDOW 12G, ETC LOCAL GPOS := AT( 'G', MENTRY_SIZE ) LOCAL LEFT_NUM, RIGHT_NUM, MWIDTH, MHEIGHT IF GPOS > 0 IF LEN(MENTRY_SIZE) = 3 .AND. ; ISDIGIT( SUBS(MENTRY_SIZE,1,1) ) .AND. ; ISDIGIT( SUBS(MENTRY_SIZE,2,1) ) .AND. ; GPOS = 3 // GOOD BASEMENT WINDOW // ONLY GOOD SIZES GOT THIS FAR // GET HEIGHT & WIDTH LEFT_NUM = LEFT(MENTRY_SIZE,2) // NOW GET THE STRING OF IT MWIDTH = VAL(LEFT_NUM) MWIDTH = LTRIM(STR( MWIDTH )) MHEIGHT = '0' ** REPLACE (UFILENAME)->HOW_MEAS WITH 'BW' RETURN {MWIDTH, MHEIGHT, 'BW'} ENDIF ENDIF RETURN NIL * ELSE * RETURN NIL * ERR_BOX( ' BASEMENT WINDOWS Must be ', ; * ' WINDOW SIZE "G" ', ; * ' ie: "20G" ' , ; * ' PLEASE RE-ENTER ') * * RETURN .F. * ENDIF * RETURN .T. *ELSE * RETURN .F. *ENDIF *********************************************************** FUNCTION VAL_FI( UFILENAME, MENTRY_SIZE , DOMSG) // FEET'INCHES // CHECK FOR WIDTH ONLY MEASUREMENT IE 3'6 FI - FEET'INCHES LOCAL WOPOS := AT( "'", MENTRY_SIZE) LOCAL LEFTPART, RITEPART, WORKVAR, I LOCAL LEFT_NUM, RIGHT_NUM, DO_ERR := .F. LOCAL STARTFRAC := 0 IF DOMSG = NIL DOMSG := .T. ENDIF IF WOPOS > 1 // AT LEAST IN SECOND POSTION LEFTPART = SUBS(MENTRY_SIZE,1, WOPOS-1) // COULD HAVE FRACTIONS OR NOT? RITEPART = ALLTRIM(SUBS(MENTRY_SIZE,WOPOS+1)) STARTFRAC := AT( " ", RITEPART) IF STARTFRAC = 0 STARTFRAC := LEN(RITEPART) ENDIF IF VAL(LEFTPART ) > 0 WORKVAR := '' FOR I := 1 TO LEN(RITEPART) IF !ISDIGIT(SUBS(RITEPART,I,1)) DO_ERR := .T. EXIT ELSE WORKVAR := WORKVAR + SUBS(RITEPART,I,1) ENDIF NEXT IF LEN(WORKVAR) = 0 DO_ERR := .T. ENDIF ELSE DO_ERR := .T. ENDIF IF DO_ERR IF DO_MSG ERR_BOX( ' WIDTH ONLY WINDOWS Must be', ; ' Width in FEET and INCHES ', ; [ ie: "3'6" ] , ; ' PLEASE RE-ENTER ') ENDIF RETURN .F. ELSE // GOOD WIDTH ONLY WINDOW // ONLY GOOD SIZES GOT THIS FAR // GET HEIGHT & WIDTH LEFT_NUM = LEFTPART RIGHT_NUM = RITEPART // NOW GET THE STRING OF IT MWIDTH = ( VAL(LEFT_NUM) * 12 ) + VAL(RIGHT_NUM) MWIDTH = LTRIM(STR( MWIDTH )) MHEIGHT = '0' REPLACE (UFILENAME)->HOW_MEAS WITH 'WO' ENDIF RETURN .T. ELSE RETURN .F. ENDIF *********************************************************** FUNCTION VAL_WD( UFILENAME, MENTRY_SIZE , DOMSG) // FEET'INCHES // CHECK FOR WIDTH ONLY MEASUREMENT IE 3'6 1/4 FI - FEET'INCHES LOCAL WOPOS := AT( "'", MENTRY_SIZE) LOCAL FRPOS := AT( "/", MENTRY_SIZE) LOCAL PEPOS := AT( ".", MENTRY_SIZE) LOCAL LEFTPART, RITEPART, WORKVAR, I LOCAL FT_NUM:='', IN_NUM:='', DO_ERR := .F. LOCAL FTPART:=0, INPART:=0, FRPART:=0 LOCAL STARTFRAC := 0 IF DOMSG = NIL DOMSG := .T. ENDIF IF WOPOS > 1 // HAVE THE FEET PART FT_NUM = SUBS(MENTRY_SIZE,1, WOPOS-1) ENDIF RITEPART := ALLTRIM(SUBS(MENTRY_SIZE,WOPOS+1)) IF FRPOS = 0 ; // NO "/" FRACTION .OR. PEPOS > 0 .AND. FRPOS = 0 // DECIMAL IE 10' 6.5 IN_NUM := RITEPART ELSE IF FRPOS > 0 IN_NUM := CHK_FRACTION(RITEPART, 'VALUE') ENDIF ENDIF IF EMPTY(IN_NUM) .AND. EMPTY(FT_NUM) RETURN NIL ELSE // GOOD WIDTH ONLY WINDOW // ONLY GOOD SIZES GOT THIS FAR // GET HEIGHT & WIDTH // NOW GET THE STRING OF IT MWIDTH = ( VAL(FT_NUM) * 12 ) + DECVAL(IN_NUM) MWIDTH = LTRIM(STR( MWIDTH,10,4 )) **MHEIGHT = '0' **REPLACE (UFILENAME)->HOW_MEAS WITH 'WO' **RETURN { MWIDTH, MHEIGHT, 'WO' } RETURN { MWIDTH, 'WO' } ENDIF *********************************************************** FUNCTION VAL_NS( UFILENAME, MENTRY_SIZE ) // NOMINAL SIZE LOCAL MLEN := LEN(ALLTRIM(MENTRY_SIZE)) LOCAL DO_ERR:=.F., L, LEFT_NUM, RIGHT_NUM LOCAL MWIDTH, MHEIGHT MENTRY_SIZE := ALLTRIM(MENTRY_SIZE) // SEE IF A NOMINAL VALID SIZE IF MLEN < 4 .OR. MLEN > 6 RETURN NIL **DO_ERR := .T. ELSE FOR L = 1 TO LEN(MENTRY_SIZE) IF !ISDIGIT(SUBSTR(MENTRY_SIZE,L,1)) RETURN NIL ******EXIT ENDIF NEXT ENDIF * IF DO_ERR * RETURN .F. * ELSE // ONLY GOOD SIZES GOT THIS FAR // GET HEIGHT & WIDTH DO CASE CASE MLEN = 4 LEFT_NUM = '0' + LEFT(MENTRY_SIZE,2) RIGHT_NUM = '0' + RIGHT(MENTRY_SIZE,2) CASE MLEN = 5 LEFT_NUM = LEFT(MENTRY_SIZE,3) RIGHT_NUM = '0' + RIGHT(MENTRY_SIZE,2) CASE MLEN = 6 LEFT_NUM = LEFT(MENTRY_SIZE,3) RIGHT_NUM = RIGHT(MENTRY_SIZE,3) ENDCASE // NOW GET THE STRING OF IT MWIDTH = (VAL(LEFT(LEFT_NUM,2)) * 12) + VAL(RIGHT(LEFT_NUM,1)) MWIDTH = LTRIM(STR( MWIDTH )) MHEIGHT = (VAL(LEFT(RIGHT_NUM,2)) * 12) + VAL(RIGHT(RIGHT_NUM,1)) MHEIGHT = LTRIM(STR( MHEIGHT)) // UPDATE NS HOW MEAS FOR NOMINAL SIZES // OR REMOVE NS IF 'X' TYPE ENTRY SIZE **REPLACE (UFILENAME)->HOW_MEAS WITH 'NS' RETURN { MWIDTH, MHEIGHT, 'NS' } ** ENDIF RETURN .T. **************************************************************** // ROUND THE WIDTH / HEIGHT IF ADJUST ENTRY SIZE INFO FOUND FUNCTION RND_WID_HT(MPROD_CODE, GET_ARR) //* SPIN THRU GET_ARR FOR ALL WIDTH/HT ADJUSTMENTS AND KEEP RUNNING TOTAL LOCAL WK_WIDTH := DECVAL(USERFILE2->WIDTH) LOCAL WORKVAL, WK_HEIGHT := DECVAL(USERFILE2->HEIGHT) LOCAL ADJ_ARR, STRARR IF EMPTY(GET_ARR) RETURN .T. ENDIF ADJ_ARR := FIND_OPTS(GET_ARR) // UPDATE PRD SIZE FIRST IF ADJ_ARR[5] <> 0 // ROUND WIDTH TO WORKVAL := ROUNDUP(WK_WIDTH, ADJ_ARR[5]) STR_ARR := PRNT_SIZE( WORKVAL, , , , .T. ) REPLACE USERFILE2->WIDTH WITH ALLTRIM( STR_ARR[1] ) ENDIF IF ADJ_ARR[6] <> 0 // ROUND HEIGHT TO WORKVAL := ROUNDUP(WK_HEIGHT, ADJ_ARR[6]) STR_ARR := PRNT_SIZE( WORKVAL, , , , .T. ) REPLACE USERFILE2->HEIGHT WITH ALLTRIM( STR_ARR[1] ) ENDIF RETURN .T. **************************************************************** //* CALCULATE THE BILLING HEIGHT/WIDTH **************************************************************** FUNCTION BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) // ENTRY SIZE IS THE SIZE USER ENTERED // BIL_SIZE IS THE SIZE TO BILL ON BASED ON CONVERSION // FROM HOW_MEASURED AND CUTTING ADJUSTMENTS **// ACT_SIZE IS THE ACTUAL TIP TO TIP MEASURMENT OF WINDOW / PARENT PRODUCT LOCAL MWIDTH, SEEKKEY LOCAL MHEIGHT, ADDL_CATCODE, SIZE_ARR LOCAL ACT_PAR_WD LOCAL ACT_PAR_HT LOCAL SEEKPROD LOCAL ES_WD:=0, ES_HT:=0 LOCAL ADJ_ARR IF EMPTY(GET_ARR) RETURN .T. ENDIF ADJ_ARR := FIND_OPTS(GET_ARR) // RETURNS {WIDTH, HEIGHT, BWIDTH, BHEIGHT, WID_RND, HT_RND, WID_BRND, HT_BRND } MWIDTH := DECVAL(USERFILE2->WIDTH) MHEIGHT := DECVAL(USERFILE2->HEIGHT) IF EMPTY( USERFILE2->PAR_PROD ) SEEKPROD := USERFILE2->PROD_CODE ELSE SEEKPROD := USERFILE2->PAR_PROD ENDIF IF PRODUCT->(DBSEEK(SEEKPROD)) ELSE ? 'ERROR IN SEEK ON PRODUCT IN BILL_SIZE IN CGWPRPO! ' WAIT ENDIF SIZE_ARR := CONV_SIZE(SEEKPROD, MWIDTH, MHEIGHT, USERFILE2->HOW_MEAS) IF EMPTY(SIZE_ARR[1]) .AND. EMPTY(ADJ_ARR[3]) ES_WD := 0 ELSEIF EMPTY(ADJ_ARR[3]) ES_WD := SIZE_ARR[1] ELSEIF EMPTY(SIZE_ARR[1]) ES_WD := ADJ_ARR[3] ELSE ES_WD := SIZE_ARR[1] + ADJ_ARR[3] ENDIF IF EMPTY(SIZE_ARR[2]) .AND. EMPTY(ADJ_ARR[4]) ES_HT := 0 ELSEIF EMPTY(ADJ_ARR[4]) ES_HT := SIZE_ARR[2] ELSEIF EMPTY(SIZE_ARR[2]) ES_HT := ADJ_ARR[4] ELSE ES_HT := SIZE_ARR[2] + ADJ_ARR[4] ENDIF // NOW, ES_HT AND ES_WIDTH ARE THE TIP TO TIP MEASURMENTS OF // PRODUCT OR ATTACH TO PARENT PRODUCT // ADDITIONAL MODE OR PARENT PRODUCT- GET SIZE SPECS FROM PARENT DEFINITION // WHICH WILL FURTHER ADJUST THE "ATTACH ON" PRODUCT IF !EMPTY( USERFILE2->PAR_PROD ) ADDL_CATCODE := GET_CATCODE(USERFILE2->PROD_CODE) // GET THE TIP TO TIP MEASUREMENT OF PARENT WINDOW SELECT USERFILE2 DO CASE CASE TRIM(ADDL_CATCODE) == 'SCREENS' CASE TRIM(ADDL_CATCODE) == 'STORMS' ES_WD := PRODUCT->STR_WIDTH + ES_WD ES_HT := PRODUCT->STR_HEIGHT + ES_HT OTHERWISE ? 'NEW/UNDEFINED ADDITIONAL PRODUCT APPEARED IN BILL_SIZE-CGWPRPO' WAIT ENDCASE ENDIF IF ES_WD > 999.9999 ERR_BOX('** ERROR in Billing Width calculation! **', ' ', ; ' Billing Width should be less than 999.9999 / calc. = ' + ; STR(ES_WD, 12,4) ) ELSE REPLACE USERFILE2->BIL_WIDTH WITH ES_WD ENDIF IF ES_HT > 999.9999 ERR_BOX('** ERROR in Billing Height calculation! **', ' ', ; ' Billing Height should be less than 999.9999 / calc. = ' + ; STR(ES_HT, 12,4) ) ELSE REPLACE USERFILE2->BIL_HEIGHT WITH ES_HT ENDIF // UI SIZE USED FOR BILLING ONLY WHEN PRICED BY THE UNITED INCH IF (USERFILE2->BIL_WIDTH+USERFILE2->BIL_HEIGHT) > 999.99 ERR_BOX('** ERROR in UI SIZE calculation! **', ' ', ; ' UI SIZE should be less than 999.99 / calc. = ' + ; STR(USERFILE2->BIL_WIDTH+USERFILE2->BIL_HEIGHT, 8,2) ) ELSE REPLACE USERFILE2->UI_SIZE WITH ; ROUNDUP(USERFILE2->BIL_WIDTH) + ROUNDUP(USERFILE2->BIL_HEIGHT) ENDIF // UPDATE ACTUAL SIZE FOR SAW HERE BASED ON SIZE BEFORE OPTIONS ADJUSTMENTS. IF ADDL_MODE .OR. !EMPTY(USERFILE2->PAR_PROD) SELECT PRODUCT SEEK USERFILE2->PROD_CODE // GO BACK TO ADDL_PRODUCT DEFINITION ENDIF RETURN **************************************************************** **************************************************************** //* CALCULATE THE PRODUCTION HEIGHT/WIDTH **************************************************************** **************************************************************** FUNCTION CLR_SS_GLASS(GET_ARR, FILE2USE) LOCAL SAVESEL := SELECT() LOCAL ELEM1, ELEM2 //* SPIN THRU GET_ARR AND LOOK FOR GL TYPE = 'CLEAR' .AND. GL STRENG = 'SINGLE' ELEM1 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'GL STREN'}) IF ELEM1 > 0 .AND. ALLTRIM(GET_ARR[ELEM1, 4]) == 'SINGLE STRENGTH' ELEM2 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'GL TYPE'}) IF ELEM2 > 0 .AND. ALLTRIM(GET_ARR[ELEM2, 4]) == 'CLEAR' REPLACE (FILE2USE)->CLEAR_SS WITH 'Y' RETURN ENDIF ENDIF REPLACE (FILE2USE)->CLEAR_SS WITH 'N' RETURN **************************************************************** FUNCTION PROD_SIZE(GET_ARR,SEEKPROD, ADDL_MODE) //* SPIN THRU GET_ARR FOR ALL WIDTH/HT ADJUSTMENTS AND KEEP RUNNING TOTAL // PRODUCTION SIZE USED TO PRINT ON ORDERS // THE PRODUCTION SIZE IS THE (ENTRY SIZE + CATEGORY ADJUSTMENTS) // -OR- THE BILLING SIZE ABOVE + THE OPTION SIZE ADJUSTMENTS // ALSO WILL CALC THE ACTUAL FINISHED PRODUCTION SIZE LOCAL ADJ_ARR, SIZE_ARR := {} LOCAL MWIDTH := DECVAL(USERFILE2->WIDTH) LOCAL MHEIGHT := DECVAL(USERFILE2->HEIGHT) LOCAL ES_WD := 0, EW_HT := 0, WK := 0 LOCAL AES_WD := 0, AEW_HT := 0 IF EMPTY(GET_ARR) RETURN .T. ENDIF ADJ_ARR := FIND_OPTS(GET_ARR) // ADJ ADJ ADJ BILL SIZE? RND_TT_WD RND_TT_H RND_BI_WD RND_BI_HT ADJ_TTSZ? // RETURNS {WIDTH, HEIGHT, BWIDTH, BHEIGHT, WID_RND, HT_RND, WID_BRND, HT_BRND, ADJ_ACT_WD, ADJ_ACT_HT } IF EMPTY( USERFILE2->PAR_PROD ) SEEKPROD := USERFILE2->PROD_CODE ELSE SEEKPROD := USERFILE2->PAR_PROD ENDIF PRODUCT->(DBSEEK(SEEKPROD)) SIZE_ARR := CONV_SIZE(SEEKPROD, MWIDTH, MHEIGHT, USERFILE2->HOW_MEAS) ES_WD := SIZE_ARR[1] + ADJ_ARR[1] ES_HT := SIZE_ARR[2] + ADJ_ARR[2] AES_WD := ES_WD - ADJ_ARR[9] AES_HT := ES_HT - ADJ_ARR[10] **AES_WD := SIZE_ARR[1] + ADJ_ARR[9] **AES_HT := SIZE_ARR[2] + ADJ_ARR[10] // UPDATE PRD SIZE FIRST **IF AES_WD > 999.9999 // PERRY - 2/18/98 IF AES_WD > 999.9999 // PERRY - 2/18/98 ERR_BOX('** ERROR in Production Width calculation! **', ' ', ; ' Production Width should be less than 999.9999 / calc. = ' + ; STR(ES_WD, 12,4) ) ELSE **REPLACE USERFILE2->PRD_WIDTH WITH ES_WD // AES??? PERRY - 2/18/98 REPLACE USERFILE2->PRD_WIDTH WITH AES_WD // PERRY - 2/18/98 ENDIF **IF ES_HT > 999.9999 // PERRY - 2/18/98 IF AES_HT > 999.9999 // PERRY - 2/18/98 ERR_BOX('** ERROR in Production Height calculation! **', ' ', ; ' Production Height should be less than 999.9999 / calc. = ' + ; STR(ES_HT, 12,4) ) ELSE **REPLACE USERFILE2->PRD_HEIGHT WITH ES_HT REPLACE USERFILE2->PRD_HEIGHT WITH AES_HT // PERRY - 2/18/98 ENDIF **REPLACE USERFILE2->PRD_WIDTH WITH USERFILE2->BIL_WIDTH + ADJ_ARR[1] **REPLACE USERFILE2->PRD_HEIGHT WITH USERFILE2->BIL_HEIGHT + ADJ_ARR[2] * IF ADJ_ARR[5] <> 0 // ROUND WIDTH TO * REPLACE USERFILE2->PRD_WIDTH WITH ROUNDUP(USERFILE2->PRD_WIDTH, ADJ_ARR[5]) * ENDIF * IF ADJ_ARR[6] <> 0 // ROUND HEIGHT TO * REPLACE USERFILE2->PRD_HEIGHT WITH ROUNDUP(USERFILE2->PRD_HEIGHT, ADJ_ARR[6]) * ENDIF // UPDATE ACTUAL SIZE NEXT // ALWAYS ADJUST FOR SAW CUTTING ?? IF AES_WD+PRODUCT->SAW_WIDTH > 999.9999 // PERRY - 4/8/98 ERR_BOX('** ERROR in ACTUAL Width calculation! **', ' ', ; ' Actual Width should be less than 999.9999 / calc. = ' + ; STR(AES_WD + PRODUCT->SAW_WIDTH, 12,4) ) ELSE REPLACE USERFILE2->ACT_WIDTH WITH AES_WD ; + PRODUCT->SAW_WIDTH ENDIF IF AES_HT+PRODUCT->SAW_HEIGHT > 999.9999 // PERRY - 4/8/98 ERR_BOX('** ERROR in ACTUAL Height calculation! **', ' ', ; ' Actual Height should be less than 999.9999 / calc. = ' + ; STR(AES_HT + PRODUCT->SAW_HEIGHT, 12,4) ) ELSE REPLACE USERFILE2->ACT_HEIGHT WITH AES_HT ; + PRODUCT->SAW_HEIGHT ENDIF **REPLACE USERFILE2->ACT_WIDTH WITH USERFILE2->PRD_WIDTH + PRODUCT->SAW_WIDTH **REPLACE USERFILE2->ACT_HEIGHT WITH USERFILE2->PRD_HEIGHT + PRODUCT->SAW_HEIGHT * REPLACE USERFILE2->ACT_WIDTH WITH USERFILE2->ACT_WIDTH + ADJ_ARR[3] * REPLACE USERFILE2->ACT_HEIGHT WITH USERFILE2->ACT_HEIGHT + ADJ_ARR[4] * IF ADJ_ARR[7] <> 0 // ROUND WIDTH TO ON TT SIZE * REPLACE USERFILE2->ACT_WIDTH WITH ROUNDUP(USERFILE2->ACT_WIDTH, ADJ_ARR[7]) * ENDIF * IF ADJ_ARR[8] <> 0 // ROUND HEIGHT TO ON TT SIZE * REPLACE USERFILE2->ACT_HEIGHT WITH ROUNDUP(USERFILE2->ACT_HEIGHT, ADJ_ARR[8]) * ENDIF // UPDATE ACTUAL NOMINAL WIDTH, HEIGHT // ADJUSTED FOR TT ROUNDING ABOVE IN THE ACT_HEIGHT PART WK := USERFILE2->ACT_WIDTH - PRODUCT->SAW_WIDTH - PRODUCT->NS_WIDTH IF WK > 999.9999 .OR. WK < -999.9999 //** P3N - 4/8/98 ERR_BOX('** ERROR in ACTUAL NOM Width calculation! **', ' ', ; ' Actual NOM Width should be less than 999.9999 / calc. = ' + ; STR(WK, 12,4) ) ELSE REPLACE USERFILE2->NOM_WIDTH WITH USERFILE2->ACT_WIDTH ; - PRODUCT->SAW_WIDTH - PRODUCT->NS_WIDTH ENDIF WK := USERFILE2->ACT_HEIGHT - PRODUCT->SAW_HEIGHT - PRODUCT->NS_HEIGHT IF WK > 999.9999 .OR. WK < -999.9999 //** P3N - 4/8/98 ERR_BOX('** ERROR in ACTUAL NOM Height calculation! **', ' ', ; ' Actual NOM Height should be less than 999.9999 / calc. = ' + ; STR(WK, 12,4) ) ELSE REPLACE USERFILE2->NOM_HEIGHT WITH USERFILE2->ACT_HEIGHT ; - PRODUCT->SAW_HEIGHT - PRODUCT->NS_HEIGHT ENDIF RETURN .T. ******************************************************************** * THIS FUNC ROUNDS NUMBERS UP IF NEEDED (THE OLD ROUND FUNC) ******************************************************************** FUNCTION ROUNDUP(VAL2ROUND, ROUND2) LOCAL WORKVAL, DECVAL IF ROUND2 = NIL ROUND2 := 0 ENDIF IF ROUND2 > 1 .OR. ROUND2 < 0 ERR_BOX('*** INVALID ROUND TO VALUE ' + STR(ROUND2,8,4) , ; '*** Value NOT ROUNDED!' , ; '*** CHECK THE MODEL SETUP') RETURN VAL2ROUND ENDIF IF ROUND2 = 0 // ROUND TO INTEGER IF VAL2ROUND - INT(VAL2ROUND) = 0 RETURN VAL2ROUND ELSE RETURN INT(VAL2ROUND) + 1 ENDIF ELSE DECVAL := VAL2ROUND - INT(VAL2ROUND) // DECIMAL PORTION IF DECVAL = 0 RETURN VAL2ROUND ELSE WORKVAL := DECVAL DO WHILE WORKVAL > ROUND2 WORKVAL := WORKVAL - ROUND2 ENDDO RETURN VAL2ROUND + (ROUND2 - WORKVAL) // ORIG AMT + (DIFF BETWEEN DECVAL AND ROUND2) ENDIF ENDIF ******************************************************************** * THIS FUNC FINDS ALL OPTIONS IN ORDER TO CALC THE HEIGHT/WIDTH ADJS. * AT ALL LEVELS ******************************************************************** FUNCTION FIND_OPTS(GET_ARR) LOCAL M_HEIGHT := 0, M_WIDTH := 0, MADJ_INVSZ LOCAL BHEIGHT := 0, BWIDTH := 0 LOCAL OO_KEY, I, II, USER_CHOICE, MRULE, WID_RND := 0, HT_RND := 0 LOCAL WID_BADJ := 0 LOCAL HT_BADJ := 0, H_ADJAMT:= 0, W_ADJAMT:= 0 LOCAL WID_AADJ := 0 LOCAL HT_AADJ := 0 //* SEARCH ALL SELECTED OPTIONS IN THE GET_ARR, AND MAKE ADJUSTMENTS ON //* ALL OPTIONS FOUND IN THE ORDER OPTIONS FILE SELECTED AT ORDER ENTRY TIME FOR I := 1 TO LEN(GET_ARR) USER_CHOICE := GET_ARR[I,4] FOR II := 1 TO LEN(GET_ARR[I, 3]) // OPTION ARRAY IF ALLTRIM(USER_CHOICE) == ALLTRIM(GET_ARR[I, 3, II, 1]) // OPT DESC MRULE := GET_ARR[I,3,II,14] // ROUND WIDTH RULE // ALWAYS ADJUST THE WIDTH - NO RULE // CHECK IF THERE IS A WIDTH ROUND RULE IF EMPTY(MRULE) .OR. CHK_RULE(MRULE, GET_ARR, , _SELFILE) WID_RND := WID_RND + GET_ARR[I,3,II,13] // ROUND WIDTH AMOUNT ENDIF MRULE := GET_ARR[I,3,II,16] // ROUND HEIGHT RULE // ALWAYS ADJUST THE HEIGHT - NO RULE // CHECK IF THERE IS A HEIGHT ROUND RULE IF EMPTY(MRULE) .OR. CHK_RULE(MRULE, GET_ARR, , _SELFILE) HT_RND := HT_RND + GET_ARR[I,3,II,15] // ROUND HEIGHT AMOUNT ENDIF // AMT TO ADJUST PRODUCTION WIDTHS AND HEIGHTS (PRD AND ACTUAL) W_ADJAMT := GET_ARR[I,3,II,8] // ADJ WD AMT H_ADJAMT := GET_ARR[I,3,II,9] // ADJ HT AMT IF W_ADJAMT <> 0 .OR. H_ADJAMT <> 0 //// IF MADJ_TTSZ$'Y' M_WIDTH := M_WIDTH + W_ADJAMT // OPT WIDTH ADJ M_HEIGHT := M_HEIGHT + H_ADJAMT // OPT HEIGHT ADJ * M_WIDTH := M_WIDTH + GET_ARR[I, 3, II, 8] // OPT WIDTH ADJ * M_HEIGHT := M_HEIGHT + GET_ARR[I, 3, II, 9] // OPT HEIGHT ADJ MADJ_INVSZ := GET_ARR[I, 3, II, 12] // OPT ADJ BILL? IF MADJ_INVSZ$'Y' // AMT TO ADJUST BILLING WIDTHS AND HEIGHTS BWIDTH := BWIDTH + W_ADJAMT // OPT WIDTH ADJ BHEIGHT := BHEIGHT + H_ADJAMT // OPT HEIGHT ADJ ** BWIDTH := BWIDTH + GET_ARR[I, 3, II, 8] // OPT WIDTH ADJ ** BHEIGHT := BHEIGHT + GET_ARR[I, 3, II, 9] // OPT HEIGHT ADJ WID_BADJ := WID_BADJ + W_ADJAMT HT_BADJ := HT_BADJ + H_ADJAMT ENDIF IF GET_ARR[I,3,II,17]$'N' // ADJ_TTSZ BLANK DEFAULTS TO YES WID_AADJ := WID_AADJ + W_ADJAMT // THIS IS AMT TO ADD BACK IF NO ADJ HT_AADJ := HT_AADJ + H_ADJAMT ENDIF ENDIF ENDIF NEXT NEXT //PRD/ACT ADJ BILL ADJ ROUND TO PRD/ACT ADJ ROUND TO BILL ADJ? ADJ TT SIZE? RETURN {M_WIDTH, M_HEIGHT, BWIDTH, BHEIGHT, WID_RND, HT_RND , WID_BADJ, HT_BADJ , WID_AADJ, HT_AADJ } ******************************************************************** //** P3N - 4/21/00 DO NOT ALLOW UPDATE OF A LINE ITEM ENTRY SIZE //** PER SCOTT IN KC ******************************************************************** FUNCTION CK_ENTRYSZ() LOCAL SVREC := (CUR_OL)->(RECNO()) LOCAL CURFILE := ALIAS(), RETVAL := .T. //**LOCAL SEEKKEY := (CURFILE)->ORDER_NUM + STR( (CURFILE)->LINE_NUM, 3) //** P3N - 07/10/02 LOCAL SEEKKEY := (CURFILE)->ORDER_NUM //** P3N - 07/10/02 ADDRESS ABEND FOR DARLENE - IOLA IF VALTYPE( (CURFILE)->LINE_NUM ) $'N' //** P3N - 07/10/02 SEEKKEY := SEEKKEY + STR( (CURFILE)->LINE_NUM, 3) //** P3N - 07/10/02 ELSE //** P3N - 07/10/02 SEEKKEY := SEEKKEY + (CURFILE)->LINE_NUM //** P3N - 07/10/02 ENDIF //** P3N - 07/10/02 IF (CUR_OL)->(DBSEEK(SEEKKEY)) IF (CUR_OL)->ENTRY_SIZE == (CURFILE)->ENTRY_SIZE RETVAL := .T. ELSE RETVAL := .F. ENDIF ENDIF (CUR_OL)->(DBGOTO(SVREC)) RETURN RETVAL ******************************************************************** FUNCTION UPDATE_SQFT() // CALCULATE AND UPDATE THE UI SIZE FIELD LOCAL MHEIGHT, MWIDTH, MCALC IF !EMPTY(USERFILE2->HEIGHT) .AND. !EMPTY(USERFILE2->WIDTH) MHEIGHT = DECVAL(USERFILE2->HEIGHT) // CONVERT CHARACTER FRACTIONS MWIDTH = DECVAL(USERFILE2->WIDTH) MCALC := (MHEIGHT * MWIDTH) / 144 IF MCALC > 999.99 ERR_BOX('** ERROR in Square Ft. Calculation! **' ,' ', ; '** Sqft. MUST BE LESS THAN 999.99 / calc. = ' + STR(MCALC,9,2) ) ELSE REPLACE USERFILE2->SQFT WITH (MHEIGHT * MWIDTH) / 144 ENDIF ENDIF RETURN .T. ******************************************************************** FUNCTION CHK_FRACTION(C_NUM, ACTION) // MAKE SURE C_NUM IS A CHARACTER STRING OF DIGITS AND/OR FRACTIONS // FRACTIONS MUST BE IN THIS FORM 1/2, 3/8, WITH NO DECIMALS OR LETTERS // IF ACTION = 'VALUE' THEN JUST RETURN THE VALUE, DON'T UPDATE GET FIELD LOCAL SLASH_POS, SPACE1_POS, SPACE2_POS, WHOLE_NUM, FRACTION LOCAL TOP_FRACTION, BOTT_FRACTION, DECIMAL_NUM LOCAL N_CHOICE, L, X, I, FRACT_PARR := {} , RETVAL IF ACTION = NIL ACTION = 'UPDATE' ENDIF IF EMPTY(C_NUM) IF ACTION = 'VALUE' RETURN C_NUM ELSE RETURN .T. ENDIF ELSE C_NUM = ALLTRIM(C_NUM) + ' ' ENDIF IF AT('.', C_NUM) > 0 IF ACTION = 'VALUE' RETURN C_NUM ELSE RETURN .F. ENDIF ENDIF FOR L = 1 TO LEN(C_NUM) X = UPPER(SUBSTR(C_NUM,L,1)) IF !X$"0123456789/ '" IF X$["'X] ELSE ERR_BOX( X + ' is an INVALID Character',; 'Please Re-Enter!') ENDIF IF ACTION = 'VALUE' RETURN C_NUM ELSE RETURN .F. ENDIF ENDIF NEXT // CHECK THE SYNTAX SLASH_POS = AT('/', C_NUM) **SPACE1_POS = AT(' ', C_NUM) SPACE1_POS := LEN(C_NUM) FOR I := LEN(C_NUM) - 1 TO 1 STEP -1 IF SUBS(C_NUM,I,1)$' ' SPACE1_POS := I EXIT ENDIF NEXT IF SPACE1_POS > SLASH_POS .AND. SLASH_POS <> 0 // NO WHOLE NUMBER! WHOLE_NUM = 0 SPACE1_POS = 1 ELSE WHOLE_NUM = VAL(LEFT(C_NUM, SPACE1_POS-1)) SPACE1_POS++ // POINT TO FIRST FRACTION DIGIT! ENDIF // FIND END OF FRACTION EXPRESSION SPACE2_POS = LEN(C_NUM) FOR L = SLASH_POS TO LEN(C_NUM) X = SUBSTR(C_NUM,L,1) IF X = ' ' SPACE2_POS = L-1 // NEED ACTUAL END OF FRACTION EXPRESSION EXIT ENDIF NEXT // MAKE SURE NOTHING COMES AFTER THE FRACTION IF !EMPTY(RIGHT(C_NUM, LEN(C_NUM)-SPACE2_POS) ) ERR_BOX( 'ERRONEOUS Characters Detected after number',; 'Please Re-Enter!') IF ACTION = 'VALUE' RETURN C_NUM ELSE RETURN .F. ENDIF ENDIF IF SLASH_POS = 0 // NO FRACTION! // CHECK FOR REALISTIC VALUE IF WHOLE_NUM > 300 ERR_BOX( 'That Value is too LARGE',; 'Please Re-Enter!') ** RETURN .F. IF ACTION = 'VALUE' RETURN ALLTRIM(STR(WHOLE_NUM,3)) ELSE RETURN .F. ENDIF ELSE ****RETURN .T. IF ACTION = 'VALUE' RETURN ALLTRIM(STR(WHOLE_NUM,3)) ELSE RETURN .T. ENDIF ENDIF ELSE // VALIDATE FRACTION EXPRESSION FRACTION = ALLTRIM(SUBSTR(C_NUM, SPACE1_POS, SPACE2_POS)) IF ASCAN(FRACTION_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(FRACTION)}) = 0 IF ACTION = 'EDIT' ERR_BOX( 'Invalid FRACTION Entered' ,; 'Please Reenter!') RETURN .F. ENDIF DO WHILE .T. FOR I := 1 TO LEN(FRACTION_ARR) AADD(FRACT_PARR, FRACTION_ARR[I,1]) NEXT NCHOICE = LISTBOX(FRACT_PARR,1,'Choose A Fraction') IF LASTKEY() = 27 IF ACTION = 'VALUE' RETURN '0' ELSE RETURN .F. ENDIF ENDIF IF NCHOICE <> 0 FRACTION = FRACTION_ARR[ NCHOICE, 1 ] EXIT ENDIF ENDDO IF ACTION = 'VALUE' IF WHOLE_NUM = 0 RETURN FRACTION ELSE RETURN LTRIM(STR(WHOLE_NUM)) + ' ' + FRACTION ENDIF ELSE // UPDATE THE GET VARIABLE IF IT'S A GET X = GETACTIVE() // GET CURRENT GET INFO IF X:HASFOCUS IF WHOLE_NUM = 0 X:BUFFER := PADR(ALLTRIM(FRACTION), LEN(X[13]), ' ') // X[13] = OLD VALUE OF GET VAR ELSE X:BUFFER := PADR(LTRIM(STR(WHOLE_NUM)) + ' ' + ALLTRIM(FRACTION) ,LEN(X[13]), ' ') ENDIF X:ASSIGN() ENDIF ENDIF ENDIF ENDIF IF ACTION = 'VALUE' IF WHOLE_NUM = 0 RETURN FRACTION ELSE RETURN LTRIM(STR(WHOLE_NUM)) + ' ' + FRACTION ENDIF ELSE RETURN .T. ENDIF ******************************************************************** FUNCTION GET_SALEPRICE(MMODEL, MPRICE_TYPE, XPRICE_ARR, GET_ARR, ADDL_MODE, PR_CUSTID) // GET THE WHOLE PRICE LOCAL BASE_AMT, OPT_AMT, MEXT_AMT, MSALE_PRICE LOCAL DISC_AMT := 0 LOCAL SAVESEL := SELECT() LOCAL MCAT_CODE LOCAL MSYS_DISC := 0 LOCAL MDISC_AMT := 0 LOCAL MSYS_PCT := (USERFILE2->SYS_DISC * .01) LOCAL BASEPRICE_CUST := .F. //P3N - 2/18/98 LOCAL ABASEPRICE //P3N - 2/18/98 // GET THE PRICE ARRAY FOR THIS MPRICE TYPE MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, MPRICE_TYPE, PR_CUSTID) // GET BASE PRICE IF ADDL_MODE .AND. USERFILE2->STD_OPTS$'Y' BASE_AMT := 0 ELSE ABASEPRICE := GET_BASEPRICE(MMODEL, MPRICE_TYPE, XPRICE_ARR, GET_ARR, PR_CUSTID) BASE_AMT := ABASEPRICE[1] //* P3N - 2/18/98 BASEPRICE_CUST := ABASEPRICE[2] //* P3N - 2/18/98 ENDIF IF BASE_AMT > 9999.99 ERR_BOX('** ERROR in BASE Price Calculation! **' , ' ', ; ' Base Price should be less than 9999.99 / calc = ' + ; STR(BASE_AMT, 9,2) ) ELSE REPLACE USERFILE2->BASE_PRI WITH BASE_AMT ENDIF // GET ANY OPTION PRICING BEFORE EXTRAS OPT_AMT = GET_OPTPRICE(MMODEL, MPRICE_ARR, GET_ARR, 'B') IF OPT_AMT > 9999.99 ERR_BOX('** ERROR in OPTION Pricing Calculation! **' , ' ', ' Option Price should be less than 9999.99 / calc = ' + STR(OPT_AMT, 9,2) ) ELSE REPLACE USERFILE2->OPT_PRI WITH OPT_AMT ENDIF // GET EXTRA PRICING MEXT_AMT = GET_EXTPRICE(GET_ARR, PR_CUSTID) IF MEXT_AMT > 9999.99 ERR_BOX('** ERROR in EXTRA Pricing Calculation! **' , ' ', ; ' Extra Price should be less than 9999.99 / calc = ' + ; STR(MEXT_AMT, 9,2) ) ELSE REPLACE USERFILE2->EXTRA_PRI WITH MEXT_AMT ENDIF // GET ANY OPTION PRICING AFTER EXTRAS OPT_AMT = GET_OPTPRICE(MMODEL, MPRICE_ARR, GET_ARR, 'A') IF OPT_AMT > 9999.99 ERR_BOX('** ERROR in EXTRA OPTION Pricing Calculation - GET_OPTPRICE()! **' , ' ', ; ' Option Price should be less than 9999.99 / calc = ' + ; STR(OPT_AMT, 9,2) ) ELSE IF OPT_AMT+USERFILE2->OPT_PRI > 9999.99 ERR_BOX('** ERROR in EXTRA OPTION Pricing Calculation! **' , ' ', ; ' Option Price should be less than 9999.99 / calc = ' + ; STR(OPT_AMT+USERFILE2->OPT_PRI, 9,2) ) ELSE REPLACE USERFILE2->OPT_PRI WITH USERFILE2->OPT_PRI + OPT_AMT ENDIF ENDIF // ADD COMPONENTS TOGETHER TO GET FINAL PRICE MSALE_PRICE = USERFILE2->BASE_PRI + ; USERFILE2->OPT_PRI + ; USERFILE2->EXTRA_PRI IF MSALE_PRICE > 9999.99 ERR_BOX('** ERROR in SALE Price Calculation! **' , ; ' Sale Price should be less than 9999.99 / calc = ' + ; STR(MSALE_PRICE, 9,2), ' ', ; ' Sale Price can NOT be calculated!' ) MSALE_PRICE := 0 ENDIF // ROUND TO NEAREST NICKEL MSALE_PRICE = ROUND_IT(MSALE_PRICE, .05) SELECT (SAVESEL) RETURN { MSALE_PRICE, BASEPRICE_CUST } //** MSALE_PRICE // THIS IS THE PER UNIT PRICE //** BASEPRICE_CUST // TELLS IF THE BASE PRICE IS FROM THE CUST LVL ******************************************************************** FUNCTION GET_BASEPRICE(MMODEL, MPRICE_TYPE, XPRICE_ARR, GET_ARR, PR_CUSTID) // LOOKUP AND CALCULATE PRICING FOR MMODEL ACCORDING TO PRICE TYPE // PRICE TYPE: D = DEALER, S = SPECIAL DEALER, B = BUILDER/BUILD TO STOCK // PRICE TYPE: J = JOBBER(DISTRUBUTER), L = LUMBERMAN // PRICE ARRAY = LIST OF ROW AND COLUMNS // GET ARRAY HOLDS THE USER RESPONSES (SEE GET_LINEOPTS FOR ARRAY LAYOUT) LOCAL L, SEEKKEY, MATT_CODE, ELEM, DB_ARR := {} LOCAL M_NUM, MUI_SIZE, MFIELD := '', BASE_PRICE:=0, SAVESEL := SELECT() LOCAL MCOL_VAR, RETVAL, ELEM2, SCANVAR LOCAL MPERCENT, SPECPRICE, FLD_ARR LOCAL XFILE, YFILE := ' ',DFILE := ' ' //P3N 2-5-98-CUST.PRICING UPGRD LOCAL BASEPRICE_CUST := .F. IF MPRICE_TYPE = NIL MPRICE_TYPE = '' ENDIF **SPECPRICE := CUST_SPEC_BP(MMODEL) **IF SPECPRICE <> NIL ** RETURN SPECPRICE **ENDIF SELECT PRODUCT SEEK MMODEL MPERCENT = 0 IF !EMPTY(PR_CUSTID) CUST_BP->(DBSEEK( PR_CUSTID + MMODEL )) MPERCENT := CUST_BP->BASEFAC ELSE DO CASE CASE MPRICE_TYPE = 'S' IF SD_BASEFAC <> 0 MPERCENT = SD_BASEFAC ENDIF CASE MPRICE_TYPE = 'B' IF BU_BASEFAC <> 0 MPERCENT = BU_BASEFAC ENDIF CASE MPRICE_TYPE = 'L' IF LU_BASEFAC <> 0 MPERCENT = LU_BASEFAC ENDIF CASE MPRICE_TYPE = 'J' IF DI_BASEFAC <> 0 MPERCENT = DI_BASEFAC ENDIF CASE MPRICE_TYPE = 'I' IF IN_BASEFAC <> 0 MPERCENT = IN_BASEFAC ENDIF END CASE ENDIF // SELECT THE PRICE TABLE IF MPERCENT <> 0 // FORCE IT TO USE DEALER PRICE TABLE XFILE = 'D' + ALLTRIM(MMODEL) + '.DBF' // NEED TO GET THE DEALER PRICE ARRAY!!! MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, 'D', PR_CUSTID) ELSE MPERCENT = 100 // SET THIS TO 100, FOR NO CHANGE IN PRICE CALC (BELOW) IF EMPTY(PR_CUSTID) XFILE = MPRICE_TYPE + ALLTRIM(MMODEL) + '.DBF' ****XFILE := XFILE + '.DBF' //** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS // GET THE PRICE ARRAY FOR THIS MPRICE TYPE MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, MPRICE_TYPE, PR_CUSTID) ELSE DFILE := 'D' + ALLTRIM(MMODEL) + '.DBF' YFILE := MPRICE_TYPE + ALLTRIM(MMODEL) + '.DBF' // UXXXXXXX.001 PRICE DBF XFILE := 'U' + ALLTRIM(MMODEL) XFILE := XFILE + '.' + PADL( ALLTRIM(STR( CUST_MAST->CPRICE_NUM )),3,'0') //** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS // GET THE PRICE ARRAY FOR THIS CUSTOMER TYPE 'D'-DEALER MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, 'D', PR_CUSTID) ENDIF //** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS // GET THE PRICE ARRAY FOR THIS MPRICE TYPE **MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, MPRICE_TYPE, PR_CUSTID) ENDIF //** P3N - 4/1/98 - CHANGED TO ADDRESS PRICING CONCERNS (APRIL FOOLS) //** (IE: PRICE TABLE '*PWS-O.DBF' - S/B '*PWS_O.DBF' ) XFILE := STRTRAN(XFILE, '-', '_') YFILE := STRTRAN(YFILE, '-', '_') DFILE := STRTRAN(DFILE, '-', '_') IF VALTYPE(MPRICE_ARR) = 'N' // NO PRICE TABLE, NO PERCENT BASE_PRICE := 0 **RETURN BASE_PRICE + PICKUP_DISC(MMODEL) RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } ENDIF **IF !FILE(XFILE + '.DBF') IF !FILE(XFILE) BASE_PRICE = 0.00 **RETURN BASE_PRICE + PICKUP_DISC(MMODEL) RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } ELSE IF SELECT('XMFILE') > 0 SELECT XMFILE USE ENDIF NET_USE(XFILE, .F., 5, 'XMFILE') ENDIF SEEKKEY = '' FOR L = 1 TO LEN(MPRICE_ARR) IF MPRICE_ARR[L,2] = 'R' // ROW? MATT_CODE = MPRICE_ARR[L,1] ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(MATT_CODE)}) IF ELEM <> 0 IF !EMPTY(SEEKKEY) SEEKKEY = SEEKKEY + '-' ENDIF SEEKKEY = SEEKKEY + TRIM(GET_ARR[ELEM,4]) ENDIF ELSE IF MPRICE_ARR[L,2] = 'C' MCOL_VAR = MPRICE_ARR[L,1] ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(MCOL_VAR)}) IF ELEM > 0 MFIELD = ALLTRIM(GET_ARR[ELEM,4]) ENDIF ENDIF ENDIF NEXT // CHECK THAT OPTION RESPONSE IS A VALID FIELD NAME!!! FLD_ARR = DBSTRUCT() // GET FIELD LIST SCANVAR := LEFT( STRTRAN(MFIELD, ' ', '_') + SPACE(10), 10) ELEM2 = ASCAN(FLD_ARR, {|X| LEFT(X[1]+SPACE(10),10) == SCANVAR}) IF ELEM2 = 0 .OR. ELEM = NIL .OR. ELEM = 0 IF EMPTY(PR_CUSTID) IF ELEM = NIL .OR. ELEM = 0 ERR_BOX( ' CANNOT Calculate Base Price! ', ; ' The ' + TRIM(MMODEL) + ' Price Table ',; ' May NOT Be Set Up Correctly ') ELSE ERR_BOX( ' CANNOT Calculate Base Price! ', ; ' Field ' + MFIELD + ' for Option ' + ALLTRIM(GET_ARR[ELEM,1]) ,; ' Does NOT Exist. Check the Option Responses ', ; ' Or The ' + TRIM(MMODEL) + ' Price Table ') ENDIF ENDIF IF EMPTY(PR_CUSTID) BASE_PRICE = GET_ALTPRICE(MMODEL) ELSE BASE_PRICE = 0 ENDIF **RETURN BASE_PRICE + PICKUP_DISC(MMODEL) RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } ENDIF LOCATE FOR TRIM(DESC) == SEEKKEY **IF !EMPTY(SCANVAR) IF !EMPTY(SCANVAR) .AND. FIELDPOS(SCANVAR) > 0 BASE_PRICE = &SCANVAR BASE_PRICE = BASE_PRICE * (MPERCENT*.01) ENDIF USE //** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS ***IF EMPTY(PR_CUSTID) .AND. BASE_PRICE = 0 *** BASE_PRICE = GET_ALTPRICE(MMODEL) ***ENDIF IF EMPTY(PR_CUSTID) IF BASE_PRICE = 0 BASE_PRICE := GET_ALTPRICE(MMODEL) ELSE // BASE PRICE CALCULATED ABOVE! ENDIF ELSE // CUST. BASE PRICE NOT CALCULATED ABOVE - GET FROM REAL BASE PRICE TABLE! IF BASE_PRICE = 0 BASE_PRICE := GET_REALBASE(YFILE, SEEKKEY, SCANVAR, MPERCENT, DFILE) ELSE // CUSTOMER BASE PRICE CALCULATED ABOVE! // DO NOT APPLY A DISCOUNT FOR CUSTOMER BASE PRICE ITEMS! BASEPRICE_CUST := .T. //* P3N - 2/18/98 ENDIF ENDIF SELECT(SAVESEL) RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } ** RETURN BASE_PRICE + PICKUP_DISC(MMODEL) ********************************************************** * CUSTOMER BASE PRICE WAS ZERO GET THE REAL BASE PRICE * FROM THE ORIGINAL BASE PRICE TABLE - PRICE SHEET OR DEALER * // P3N 2-5-98 - CUSTOMER PRICING UPGRADE ********************************************************** FUNCTION GET_REALBASE(YFILE, SEEKKEY, SCANVAR, MPERCENT, DFILE) LOCAL BASE_PRICE := 0.00 IF FILE(YFILE) // IF PRICE SHEET TABLE EXISTS GET THE // BASE_PRICE FROM PRICE SHEET PRICE TABLE! BASE_PRICE := SEEK_BASE(SEEKKEY, YFILE, SCANVAR, MPERCENT) ENDIF IF EMPTY(BASE_PRICE) // NO PRICE @ PRICE SHEET TABLE IF FILE(DFILE) // DEFAULT IS THE DEALER PRICE TABLE BASE_PRICE := SEEK_BASE(SEEKKEY, DFILE, SCANVAR, MPERCENT) ENDIF ENDIF RETURN BASE_PRICE ********************************************************** * SEEK AND RETIREVE THE BASE PRICE FROM THE PRICE SHEET OR DEALER TABLE * // P3N 2-5-98 - CUSTOMER PRICING UPGRADE ********************************************************** FUNCTION SEEK_BASE(SEEKKEY, PFILE, SCANVAR, MPERCENT) LOCAL SVSEL := SELECT(), BASE_PRICE := 0.00 IF SELECT('XMFILE') > 0 SELECT XMFILE USE ENDIF NET_USE(PFILE, .F., 5, 'PFILE') LOCATE FOR TRIM(DESC) == SEEKKEY IF !EMPTY(SCANVAR) .AND. FIELDPOS(SCANVAR) > 0 BASE_PRICE = &SCANVAR IF EMPTY(MPERCENT) ELSE BASE_PRICE = BASE_PRICE * (MPERCENT*.01) ENDIF ENDIF USE SELECT(SVSEL) RETURN BASE_PRICE ********************************************************************** * ARE THERE ANY SPECIAL CUSTOMER BASE PRICE TABLES ACTIVE? ********************************************************************** FUNCTION CK_SPEC_PRICE( CUSTID, MMODEL, CKDATE, LOOKFILE ) LOCAL SEEKKEY := CUSTID + MMODEL LOCAL MDATE1, MDATE2, SAVESEL := SELECT(), RETVAL := .F. IF LOOKFILE = 'CUST_BP' SELECT CUST_BP CUST_BP->(DBSEEK(SEEKKEY)) ELSE SELECT (LOOKFILE) LOCATE FOR PROD_CODE == MMODEL ENDIF IF FOUND() IF EMPTY(DATE1) MDATE1 := CTOD('01/01/1960') ELSE MDATE1 := DATE1 ENDIF IF EMPTY(DATE2) MDATE2 := CTOD('01/01/2050') ELSE MDATE2 := DATE2 ENDIF IF CKDATE >= MDATE1 .AND. CKDATE <= MDATE2 RETVAL := .T. ENDIF ENDIF SELECT (SAVESEL) RETURN RETVAL ******************************************************************** ** FUNCTION CUST_SPEC_BP(MMODEL) ** LOCAL SEEKKEY, RETVAL, MDATE1, MDATE2 ** LOCAL SPEC_PRICE ** ** SEEKKEY := (CUR_MAST)->CUST_ID + MMODEL ** SELECT CUST_BP ** SEEK SEEKKEY ** IF !FOUND() ** RETURN NIL ** ENDIF ** ** IF EMPTY(DATE1) ** MDATE1 := CTOD('01/01/1960') ** ELSE ** MDATE1 := DATE1 ** ENDIF ** ** IF EMPTY(DATE2) ** MDATE2 := CTOD('01/01/2050') ** ELSE ** MDATE2 := DATE2 ** ENDIF ** ** **IF !(USERFILE2->ORDER_DATE >= MDATE1 .AND. USERFILE2->ORDER_DATE <= MDATE2) ** ** IF !( (CUR_MAST)->ORDER_DATE >= MDATE1 .AND. (CUR_MAST)->ORDER_DATE <= MDATE2 ) ** RETURN NIL ** ENDIF ** ** SPEC_PRICE := CALC_CUST_PR( MMODEL, USERFILE2->UI_SIZE ) ** ** RETURN SPEC_PRICE ** ** ** ******************************************************************** ** FUNCTION CALC_CUST_PR(MMODEL, SIZEVAL) ** LOCAL SEEKKEY ** ** SELECT CUST_BPLVL ** SEEKKEY := (CUR_MAST)->CUST_ID + MMODEL ** SEEK SEEKKEY ** IF !FOUND() ** RETURN NIL ** ENDIF ** ** DO WHILE CUST_ID + PROD_CODE == SEEKKEY .AND. !EOF() ** IF SIZEVAL <= VAL(UI_BREAK) ** // RETURN THE (UI PRICE * SIZE) + THE "EACH" PRICE ** RETURN (SIZEVAL * PRICE) + UNIT_PRICE ** ENDIF ** SKIP 1 ** ENDDO ** ** RETURN NIL ** ******************************************************************** FUNCTION PICKUP_DISC(MMODEL, SELFILE) // LOOKUP AND CALCULATE DISCOUNT FOR DEALER PICKUPS // PICKUP DELIVERY DISCOUNT FOR DEALERS LOCAL RETVAL := 0, SAVESEL := SELECT() IF SELFILE = NIL SELFILE := 'USERFILE2' ENDIF **IF (SELFILE)->PRICE_SHT$'D' ; // DEALER PRICING **IF ((MHOME_LOC_CODE = 'KC' .AND. (SELFILE)->PRICE_SHT$'D') ; ** .OR. MHOME_LOC_CODE <> 'KC' ) ; // IF THIS PRICE SHEET CODE IS IN THE CONTROL FILE PICKUPDISC LIST // AND THE ORDER IS TO BE PICKED UP IF (SELFILE)->PRICE_SHT$MPICKUPDISC ; .AND. &CUR_MAST->PICK_DEL == 'P' // PICKUP SELECT PRODUCT SEEK MMODEL SELECT CATEGORY SEEK PRODUCT->CAT_CODE RETVAL := D_PICKDISC * -1 ENDIF SELECT (SAVESEL) RETURN RETVAL ******************************************************************** FUNCTION GET_OPTPRICE(MMODEL, MPRICE_ARR, GET_ARR, WHCHOPTS) // LOOKUP AND CALCULATE PRICING FOR MMODEL OPTIONS LOCAL L, SAVESEL := SELECT(), MOPT_PRICE := 0 LOCAL SEEKKEY, MCAT_CODE LOCAL II, CUR_ATTSTUFF, CUR_ATTOPTS, CUR_OPTPRICES, CUR_OPTOPTS LOCAL CUR_ELEM, M1, M2, M3, M4, M5, M6 FOR L = 1 TO LEN(GET_ARR) IF WHCHOPTS <> GET_ARR[L,10] // BAFLAG FOR OPTIONS LOOP ENDIF CUR_ATTSTUFF := GET_ARR[L] MUSER_RESP := CUR_ATTSTUFF[4] IF ASCAN(MPRICE_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(MUSER_RESP)} ) > 0 LOOP // DON'T PROCESS BASE PRICE STUFF ENDIF IF !GET_ARR[L,2]$'P' LOOP // ONLY PROCESS THE P TYPE ATTRIBUTES ENDIF IF !EMPTY(MUSER_RESP) .AND. TRIM(MUSER_RESP) <> 'N/A' ; .AND. TRIM(MUSER_RESP) <> 'NO OPTIONS FOUND!!' CUR_ATTOPTS := CUR_ATTSTUFF[3] CUR_ELEM := ASCAN(CUR_ATTOPTS, {|X| ALLTRIM(X[1]) == ALLTRIM(MUSER_RESP)} ) IF EMPTY(CUR_ELEM) //NO attribute OPTIONS M1 := '**************************************************' M2 := '** NO attribute OPTIONS found for ' + ALLTRIM(CUR_ATTSTUFF[5]) M3 := '**' M4 := '** In the MODEL/PRODUCT setup function enter the ' M5 := '** attribute OPTIONS for ' + ALLTRIM(CUR_ATTSTUFF[1]) M6 := '**************************************************' ERR_BOX( M1, M2, M3, M4, M5, M6) ELSE CUR_OPTOPTS := CUR_ATTOPTS[CUR_ELEM] CUR_OPTPRICES := CUR_OPTOPTS[4] // WHICH COLUMN TO DO!? DO CASE CASE CUR_OPTPRICES[1] <> 0 // LIST PER UNIT MOPT_PRICE = MOPT_PRICE + CUR_OPTPRICES[1] CASE CUR_OPTPRICES[2] <> 0 // TIMES UNITED INCHES MOPT_PRICE = MOPT_PRICE + (CUR_OPTPRICES[2]*USERFILE2->UI_SIZE) CASE CUR_OPTPRICES[3] <> 0 // TIMES SQFT PRICE MOPT_PRICE = MOPT_PRICE + (CUR_OPTPRICES[3]*USERFILE2->SQFT) ENDCASE ENDIF ENDIF NEXT SELECT(SAVESEL) RETURN MOPT_PRICE ******************************************************************** FUNCTION GET_EXTPRICE(GET_ARR, PR_CUSTID) // LOOKUP AND CALCULATE EXTRA PRICING FOR OPTION // AT THE CATEGORY LEVEL ONLY LOCAL SAVESEL := SELECT(), MEXT_PRICE := 0 LOCAL RULE_ARR := {}, GOOD_RESULT, M_AMT := 0, MULTIPLIER := 0 LOCAL TFVALUE := 0.0000, RESULT, TVVALUE LOCAL SAVEORD LOCAL TVSTRTRAN LOCAL OPT_VAL_TYPE, WHCHCHOICE, CHOICEARR, CHOICEPRICES LOCAL MROUND_UP LOCAL WORKVAL1, WORKVAL2 LOCAL GET_PRICE SELECT PRI_EXTRAS SAVEORD := INDEXORD() DONSETORD(2) MCAT_CODE = GET_CATCODE(USERFILE2->PROD_CODE) SEEK MCAT_CODE DO WHILE CAT_CODE == MCAT_CODE .AND. !EOF() IF AT('U', PRI_EXTRAS->PRICE_SHT) > 0 ; // USER PRICING .AND. CUST_PE->(DBSEEK(PRI_EXTRAS->CAT_CODE + PRI_EXTRAS->OPTION + (CUR_MAST)->CUST_ID)) // USE THIS OPTION GET_PRICE := 'CUST_PE' ELSE GET_PRICE := 'PRI_EXTRAS' // NO SPECIAL USER PRICING - CHECK PRICE SHEET FROM ORDER LINE IF EMPTY(PR_CUSTID) .AND. AT(USERFILE2->PRICE_SHT, PRI_EXTRAS->PRICE_SHT) = 0 SKIP 1 LOOP ENDIF // IF A 'U' IS NOT IN THE PRI_EXTRAS->PRICE_SHT - EXIT // ELSE SPECIAL CUSTOMERS WILL HAVE ACCESS BASED ON PRI_EXTRAS PRICE VALUES IF !EMPTY(PR_CUSTID) .AND. AT(USERFILE2->PRICE_SHT, 'U') = 0 SKIP 1 LOOP ENDIF ENDIF IF !EMPTY(RULE_PACK) IF ALLTRIM(RULE_PACK) = 'ORIEL' IF USERFILE2->ORIEL_SIZE$'N' .OR. (CUR_MAST)->ORIEL_CHRG$'N' SKIP 1 LOOP ENDIF ENDIF DO CASE CASE !EMPTY( (GET_PRICE)->UNIT_SALE) M_AMT = (GET_PRICE)->UNIT_SALE CASE !EMPTY( (GET_PRICE)->UI_SALE) // TIMES NUMBER OF UNITED INCHES M_AMT = (GET_PRICE)->UI_SALE * USERFILE2->UI_SIZE CASE !EMPTY( (GET_PRICE)->SQFT_SALE) // TIMES NUMBER OF SQUARE FEET M_AMT = (GET_PRICE)->SQFT_SALE * USERFILE2->SQFT ENDCASE MROUND_UP := ROUND_UP // SHOULD TRUE/FALSE VALUE BE ROUNDED UP? /* STEP 1. TEST RULE STEP 2. IF TRUE, EVAL(TRUE VAL) IF FALSE, USE FALSE VAL STEP 3. TAKE EVAL FROM STEP 2 * M_AMT */ ** RULE_ARR = GETRULES(RULE_PACK) // RULE PACK NAME ** GOOD_RESULT = EVALCLRULES({RULE_ARR},,GET_ARR) // RULE ARRAY GOOD_RESULT = CHK_RULE(RULE_PACK, GET_ARR, , _SELFILE ) // RULE ARRAY IF GOOD_RESULT TRUE_FALSE = ALLTRIM(TRUE_VAL) ELSE TRUE_FALSE = ALLTRIM(FALSE_VAL) ENDIF ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == TRUE_FALSE}) // IT'S AN OPTION VALUE TFVALUE := 0 DO CASE CASE ELEM > 0 // DECVAL() (IN CGWMATH) EXPECTS A CHARACTER, AND RETURNS A NUMERIC OPT_VAL_TYPE = GET_ARR[ELEM,2] DO CASE CASE OPT_VAL_TYPE$'UC' TFVALUE = DECVAL(GET_ARR[ELEM,4]) // * USER_RESP CASE OPT_VAL_TYPE$'P' // IF PICK LIST, GET THE PRICES FROM THE SELECTED OPTION // THEN EVALUATE THE TRUE FALSE ON THAT LIKE A NUMERIC ONE CHOICEARR = GET_ARR[ELEM,3] WHCHCHOICE = ASCAN(CHOICEARR, {|X| ALLTRIM(X[1]) == ALLTRIM(GET_ARR[ELEM,4])}) IF WHCHCHOICE = 0 TFVALUE := 0 ELSE CHOICEPRICES = CHOICEARR[WHCHCHOICE,4] DO CASE CASE CHOICEPRICES[1] <> 0 TFVALUE := CHOICEPRICES[1] CASE CHOICEPRICES[2] <> 0 TFVALUE := CHOICEPRICES[2] CASE CHOICEPRICES[3] <> 0 TFVALUE := CHOICEPRICES[3] ENDCASE ENDIF ENDCASE CASE ALLTRIM(TRUE_FALSE) == 'ITEM PRICE' TFVALUE := USERFILE2->BASE_PRI + USERFILE2->OPT_PRI ; + MEXT_PRICE // ADD ALL PRICE COMPONENTS SO FAR // DON'T USE "SPECIAL_FIELDS()" BECAUSE IT RETURNS STORED VALUE // OF THE EXT_PRICE IN DBF VS. THE CURRENT CALCULATED VALUE TFVALUE = ROUND_IT(TFVALUE, .05) CASE ALLTRIM(TRUE_FALSE) == 'BASE PRICE' TFVALUE := USERFILE2->BASE_PRI CASE ALLTRIM(TRUE_FALSE) == "TT WIDTH'" TFVALUE := USERFILE2->ACT_WIDTH / 12 CASE ALLTRIM(TRUE_FALSE) == 'TT WIDTH' TFVALUE := USERFILE2->ACT_WIDTH CASE ALLTRIM(TRUE_FALSE) == "TT HEIGHT'" TFVALUE := USERFILE2->ACT_HEIGHT / 12 CASE ALLTRIM(TRUE_FALSE) == 'TT HEIGHT' TFVALUE := USERFILE2->ACT_HEIGHT CASE SPEC_FLD(TRUE_FALSE) // IS IT A SPECIAL FIELD? TVSTRTRAN:= STRTRAN(ALLTRIM(TRUE_FALSE),' ', '_') // INCASE BLANKS TFVALUE := USERFILE2->&TVSTRTRAN IF VALTYPE(TFVALUE)$'C' TFVALUE := VAL(TFVALUE) ENDIF CASE VALTYPE(TRUE_FALSE) = 'C' TFVALUE = VAL(TRUE_FALSE) // IS IT ALWAYS A CHARACTER? OTHERWISE TFVALUE = TRUE_FALSE // IS IT ALWAYS A NUMERIC? ENDCASE IF MROUND_UP = 'Y' WORKVAL1 := TFVALUE - INT(TFVALUE) IF WORKVAL1 > 0 TFVALUE := INT(TFVALUE) + 1 ENDIF ENDIF MEXT_PRICE = MEXT_PRICE + (TFVALUE * M_AMT) ENDIF SKIP 1 ENDDO DONSETORD(SAVEORD) SELECT(SAVESEL) RETURN MEXT_PRICE ******************************************************************** * BASE PRICE COULD NOT BE CALCULATED ALLOW USER TO ENTER A PRICE! ******************************************************************** FUNCTION GET_ALTPRICE(MODEL_NUM) // ASK USER FOR A BASE_PRICE LOCAL BASE_PRICE := USERFILE2->ALT_BPRICE, SAVESCR := SAVESCREEN() LOCAL NTOP, NBOTT, NLEFT, NRIGHT NTOP = 10 NBOTT = 17 NLEFT = 20 NRIGHT = 61 SETCOLOR(BLACK) @ NTOP+1,NLEFT+1 CLEAR TO NBOTT+1,NRIGHT+1 // DRAW SHADOW BOX SETCOLOR(HREV) @ NTOP,NLEFT CLEAR TO NBOTT,NRIGHT // DRAW BACKROUND COLOR @ NTOP,NLEFT TO NBOTT,NRIGHT // DRAW DOUBLE LINE @ NTOP+2,NLEFT+3 SAY ' Base Price for LINE #' + STR(USERFILE2->LINE_NUM,3) + ' Was Zero' @ NTOP+4,NLEFT+3 SAY ' Enter Price for this ' + ALLTRIM(MODEL_NUM) GET BASE_PRICE; PICTURE '9999.99' READ() SETCOLOR(LNOR) RESTSCREEN(,,,,SAVESCR) REPLACE USERFILE2->ALT_BPRICE WITH BASE_PRICE RETURN BASE_PRICE ************************************************************** //* DELETE THE CURRENT LINE IN THE TEMP ORDER LINES FILE ************************************************************** FUNCTION DEL_LINEDETAIL(ADDL_MODE) LOCAL SAVEREC, CORR, MSG, DEL_LINE, SEEKKEY, MORDER_NUM, CUR_LINE, DONE := .F. LOCAL SAVESCR := SAVESCREEN(), SAVEORD LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') LOCAL SVSEL := SELECT() //** P3N - 8/4/98 LOCAL M1 := 'Order ' + (CUR_MAST)->ORDER_NUM + ' shippped on ' + ; DTOC((CUR_MAST)->SHIP_DATE) + '. ' LOCAL M2 := 'If you continue Shipping Information will be REMOVED!' LOCAL M3 := 'DO YOU WANT TO CONTINUE?' IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' @ 23,0 CLEAR ? CHR(7) IF SELECT('ORD_SHIP') > 0 //** P3N - 8/4/98 ELSE //** P3N - 8/4/98 DBOPEN('ORD_SHIP') //** P3N - 8/4/98 ENDIF //** P3N - 8/4/98 IF ORD_SHIP->(DBSEEK( (SVSEL)->ORDER_NUM )) //** P3N - 8/4/98 ERR_BOX ('Order ' + (SVSEL)->ORDER_NUM + ' shippped on ' + ; DTOC((CUR_MAST)->SHIP_DATE) + '!' , ; 'Contact Supervisor to DELETE this Line !!' ) IF LASTKEY() <> 126 //** '~' //** P3N - 8/4/98 RESTSCREEN(,,,,SAVESCR) //** P3N - 8/4/98 RETURN .F. //** P3N - 8/4/98 ENDIF //** P3N - 8/4/98 ENDIF //** P3N - 8/4/98 SELECT(SVSEL) //** P3N - 8/4/98 MSG = ' DELETE Line ' + LTRIM(STR(RECNO())) + ' --- Are You Sure?' CORR = CORRCHEK(23, MSG) IF CORR <> 'Y' RESTSCREEN(,,,,SAVESCR) RETURN .F. ENDIF //** P3N - 10/15/98 IF EMPTY( (CUR_MAST)->SHIP_DATE ) ELSEIF PROMPT_BOX(M1, M2, M3) //** P3N - 10/15/98 IF REMOVE_ORD_SHIP() //** P3N - 10/15/98 // USER REQUESTED TO CONTINUE WITH THE DELETE - SEND INFO MSG ERR_BOX('Order Control Shipping Information has been REMOVED. ', ' ', ; 'This Order MUST be RE-SHIPPED!! ', ' ',; 'INFORM Order Control to RE-SHIP this Order!! ') ELSE RETURN .F. //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 ELSE //** P3N - 10/15/98 RETURN .F. //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 MORDER_NUM = ORDER_NUM DEL_LINE = RECNO() // LINE ITEM NUMBER TO DELETE IN ODER_OPTS SAVEREC := DEL_LINE - 1 DELETE PACK IF LASTREC() = 0 ADD_REC(3) ELSE SAVEORD := INDEXORD() DONSETORD(0) REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE DONSETORD(SAVEORD) ENDIF // UPDATE THE ORDER OPTIONS STUFF! SELECT USERFILE8 // ORDER OPTIONS (ORD_OPTS-CGW0OO) IF ADDL_MODE SEEKKEY = MORDER_NUM + USERFILE2->PROD_CODE + STR(DEL_LINE,3) ELSE SEEKKEY = MORDER_NUM + STR(DEL_LINE,3) ENDIF DO WHILE .T. SEEK SEEKKEY IF !FOUND() EXIT ENDIF REC_LOCK(3) REPLACE ORDER_NUM WITH '' REPLACE LINE_NUM WITH 0 DELETE ENDDO CUR_LINE = DEL_LINE // ADJUST ALL ORDER OPTS WITH LINE NUMBER GREATER THAN DEL_LINE SELECT USERFILE8 //** ORDER OPTS(ORD_OPTS-CGW0OO) SAVEORD := INDEXORD() DONSETORD(0) REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE DONSETORD(SAVEORD) PACK *-// ADJUST ALL ORDER OPTS WITH LINE NUMBER GREATER THAN DEL_LINE *-DELETE ALL RECS IN ADDL_LINES WHICH HAVE THIS ORDER NUMBER *-AND THIS LINE NUMBER. THEN DELETE ALL ADDL_OPTS RECORDS FOR *-THIS ORDER NUMBER AND THIS LINE NUMBER. *- *-AFTER YOU DELETE THE RECORDS, THEN RENUMBER SUBSEQUENT RECORDS *-SO THEIR LINE NUMBERS MATCH WHAT THEY ARE SUPPOSED TO BE! SELECT USERFILE6 //** ADDL LINES (CGW0XL) SAVEORD := INDEXORD() DONSETORD(0) DELETE ALL FOR LINE_NUM = DEL_LINE REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE DONSETORD(SAVEORD) PACK // ADJUST ALL ADDL OPTS WITH LINE NUMBER GREATER THAN DEL_LINE SELECT USERFILE9 //** ADDL OPTS (CGW0XO) SAVEORD := INDEXORD() DONSETORD(0) DELETE ALL FOR LINE_NUM = DEL_LINE REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE DONSETORD(SAVEORD) PACK SELECT USERFILE2 GOTO MAX(SAVEREC,1) KEYBOARD CHR(5) + CHR(19) ELSEIF ACTION_CODE = 'REV' ERR_BOX('You CAN NOT Delete line Items in REVIEW mode!') ELSE ERR_BOX('You DO NOT have Authorization to Delete line Items!') ENDIF RETURN .T. *********************************************** FUNCTION F5_NOTACTIVE() LOCAL M1 := 'The SORT OPTON is NOT ACTIVE' LOCAL M2 := 'While Entering Line Items.' LOCAL M3 := 'Request for SORT was IGNORED.' ERR_BOX( M1, M2, M3) RETURN .T. *********************************************** FUNCTION ROUND_IT(M_AMT, ROUNDER) // ROUND OFF M_AMT TO THE NEXT ROUNDER AMOUNT // IN CENTS ONLY LOCAL CENTS, ROUND_CENTS, DIFFERENCE, RESULT, DO_ROUND := 'N' IF SELECT('CUST_MAST') > 0 DO_ROUND := CUST_MAST->RND_PRICE ENDIF IF M_AMT = 0 .OR. DO_ROUND$'N' RETURN M_AMT ENDIF SET DECIMALS TO 2 // ONLY WANT 2 DECIMALS! CENTS = M_AMT - INT(M_AMT) RESULT = CENTS / ROUNDER REMAINDER = RESULT - INT(RESULT) ///// HAVE TO DO THIS BULLSHIT BECAUSE CLIPPER DOESN'T THINK 0 = 0 !!!??? IF STR(REMAINDER) = STR(0.00) // IS IT DIVISIBLE BY 5, EVENLY? SET DECIMALS TO RETURN M_AMT ENDIF ROUND_CENTS = ( INT( CENTS / ROUNDER ) + 1) * ROUNDER DIFFERENCE = ROUND_CENTS - CENTS SET DECIMALS TO RETURN M_AMT + DIFFERENCE *********************************************** FUNCTION FILL_EMPTY(MCODE, ACTION, ADDL_MODE) // THIS WILL FILL THE EMPTY LINE ITEM FIELDS (CURRENT RECORD) // WITH THE VALUES OF THE PREVIOUS RECORD LOCAL SAVESEL := SELECT(), RETVAL := .T., SEEKKEY, NEWSEEK LOCAL MPROD_CODE := '', MDISCOUNT, MHOW_MEAS LOCAL MSTD_OPTS := '', MPAR_COLOR := '' SELECT USERFILE2 // ORDER LINE ITEMS RECORD IF RECNO() > 1 SKIP -1 // POINT TO PREVIOUS RECORD MPROD_CODE := PROD_CODE MDISCOUNT := DISCOUNT MHOW_MEAS := HOW_MEAS MSTD_OPTS := STD_OPTS IF EMPTY(FIELDPOS('PAR_COLOR')) MPAR_COLOR := ' ' ELSE MPAR_COLOR := PAR_COLOR ENDIF SKIP 1 // POINT BACK TO ORIGINAL RECORD ENDIF IF RECNO() = 1 ; // MUST FILL EVERYTHING MANUALLY .OR. ( !EMPTY(PROD_CODE) .AND. (PROD_CODE <> MPROD_CODE)) IF EMPTY(PROD_CODE) RETVAL := .F. ENDIF IF EMPTY(HOW_MEAS) RETVAL := .F. ENDIF IF EMPTY(STD_OPTS) RETVAL := .F. ENDIF IF RETVAL = .F. SELECT (SAVESEL) RETURN 'NO CONT' // NEED TO GET USERFILE2 INFO FROM USER ELSE SELECT USERFILE8 IF ADDL_MODE SEEKKEY := (CUR_MAST)->ORDER_NUM + USERFILE2->PROD_CODE + STR(USERFILE2->LINE_NUM,3) ELSE SEEKKEY := (CUR_MAST)->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) ENDIF SEEK SEEKKEY IF !FOUND() // MEANS OPTS NOT THERE SELECT(SAVESEL) RETURN 'NO_OPTS_NO_PIRATE' ELSE SELECT(SAVESEL) RETURN 'HAS_OWN_OPTS' ENDIF ENDIF ENDIF // ALL ITEMS HAD SAME PRODUCT CODE AS ITEM ABOVE IT. // PIRATE ANY MISSING ITEMS FROM THE GUY ABOVE. IF EMPTY(PROD_CODE) REPLACE PROD_CODE WITH MPROD_CODE ENDIF IF EMPTY(HOW_MEAS) REPLACE HOW_MEAS WITH MHOW_MEAS ENDIF IF EMPTY(STD_OPTS) REPLACE STD_OPTS WITH MSTD_OPTS ENDIF //FILL ANY EMPTY LINE_OPTS WHICH ARE MISSING SELECT USERFILE8 IF ADDL_MODE SEEKKEY := (CUR_MAST)->ORDER_NUM + MPROD_CODE + STR(USERFILE2->LINE_NUM,3) ELSE SEEKKEY := (CUR_MAST)->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) ENDIF SEEK SEEKKEY IF !FOUND() // MEANS OPTS NOT THERE IF USERFILE2->STD_OPTS == MSTD_OPTS .AND. CK_PAR_COLOR(MPAR_COLOR) RETVAL := 'PIRATE_OPTS' //COPY ORDER_OPTS FOR LINE PREVIOUS ELSE RETVAL = 'NO_OPTS_NO_PIRATE' ENDIF ELSE RETVAL := 'HAS_OWN_OPTS' //DON'T COPY ORDER_OPTS FOR LINE PREVIOUS ENDIF SELECT(SAVESEL) RETURN RETVAL ***************************************************** * IS THERE A PARENT COLOR FOR THIS LINE ITEM? * * IF SO IS IT THE SAME AS THE PREV LINE ITEM? * ***************************************************** FUNCTION CK_PAR_COLOR(MPAR_COLOR) LOCAL RET_VAL IF EMPTY(USERFILE2->(FIELDPOS('PAR_COLOR'))) RETVAL := .T. ELSEIF USERFILE2->PAR_COLOR == MPAR_COLOR RETVAL := .T. ELSE RETVAL := .F. ENDIF RETURN RETVAL ***************************************************** FUNCTION BUILD_GETARR(MPROD_CODE, ACTION, MORDER_NUM, MLINE_NUM, PIRATE_VAR, USE_TMP, ADDL_MODE, PPR_CUSTID, DISP_WAIT, SELFILE) // BUILDS A GET ARRAY AND A PRICING ARRAY FOR MPROD_CODE // ACTION = 1, GET THE OPTIONS FROM THE ORDER OPTION FILE // ACTION = 2, JUST BUILD THE GET_ARR & PRICING ARRAY // LAYOUT FOR THE PRICE_ARR // 1 = PRICE TABLE TYPE (DEALER, SPEC DEALER, INSTALLER, LUMBERMAN, DISTRIBUTOR) // 1 = ATTRIBUTE NAME // 2 = PRICE TYPE (R=ROW, C=COLUMN) // LAYOUT FOR THE GET_ARR // 1 = ATTRIBUTE NAME // 2 = FIELD TYPE (P=PICK, U=USER INPUT, C=CALCULATE, T=PRICE TABLE) // 3 = ARRAY OF ALL THE POSSIBLE ATTRIBUTE OPTIONS (FOR THE PICK TYPE) // 1 = OPTION VALUE // 2 = HOLDS THE DEFAULT FLAG (IF IT'S AN ASTERISK, IT'S THE DEFAULT) // 3 = HOLDS THE DEFAULT FLAG RULE // 4 = ARRAY OF PRICES // 1 = UNIT SALE PRICE // 2 = UNITED INCH SALE PRICE // 3 = SQUARE FEET SALE PRICE // 5 = SEQUENCE NUMBER FOR OPTIONS // 6 = PRINT INDICATOR USED FOR OPTIONAL PRINT VALUES // 7 = OPTIONAL PRINT VALUE - USED WITH PRINT INDICATOR // 8 = OPTION ADJUSTMENT WIDTH // 9 = OPTION ADJUSTMENT HEIGHT // 10 = (ADDITIONAL) LINK PRODUCT CODE (ie A STORM WINDOW FOR A 404) // 11 = (PARENT PRODUCT LINK CODE (ie A STORM WINDOW FOR A 404) // 12 = RND_TTW_TO - ROUND TT WID TO SIZE (AND PROD SIZE) // 13 = RND_TTW_RU - ROUND TT WID TO SIZE RULE // 14 = RND_TTH_TO - ROUND TT HT TO SIZE (AND PROD SIZE) // 15 = RND_TTH_RU - ROUND TT HT TO SIZE RULE // 4 = THE VALUE THAT THE USER CHOOSES, TO GO IN THE FILE (USER RESPONSE) // 5 = ATTRIBUTE DESCRIPTION // 6 = RULE TO EXECUTE // 7 = LOGIC VAR, WHETHER TO GET/SAY IT OR NOT // 8 = HOLDS THE FILE NAME WHERE THE OPTIONS WERE FOUND // 9 = TELLS IF THE OPTION WAS A DEFAULT SELECTION // 10 = IS THE ATTRIBUTE CALCULATED BEFORE/AFTER CATEGORY EXTRAS? // 11 = CURRENT PARENT PRODUCT // PIRATE_VAR TELLS WHETHER OR NOT TO PIRATE THE LINE_OPT RECORDS ***************************************************** LOCAL MCODE := MPROD_CODE, L, CHK_BLOCK LOCAL SEEKKEY, FILE1, FILE2, DBNAME, MATT_CODE, MDESC LOCAL GET_ARR := {}, PRICE_ARR := {}, OPT_ARR, OPT_ARRAMT LOCAL NEW_PCODE, NEW_STD_OPTS, ELEM := 0 LOCAL SV_SEL := SELECT(), SAVESCRN := SAVESCREEN() LOCAL LINEFILE, OPTFILE, MSTD_OPTS LOCAL D_ARR := {}, S_ARR := {}, B_ARR := {}, L_ARR := {}, J_ARR := {} LOCAL CUST_PARR := {} LOCAL TEMP_ARR := {}, NEW_GET_ARR := .T., I_ARR := {} LOCAL MHOW_MEAS, PR_CUSTID := SPACE(8) LOCAL RND_TTW_RULE := '' LOCAL RND_TTH_RULE := '' STATIC ALLGET_ARR := {} STATIC ALLPRI_ARR := {} PRIVATE _SELFILE := SELFILE IF DISP_WAIT = NIL DISP_WAIT := .T. ENDIF //**IF SELECT('USERFILE2') > 0 //** P3N-4/22/98 //** MSTD_OPTS := USERFILE2->STD_OPTS //** MHOW_MEAS := USERFILE2->HOW_MEAS //**ELSE //** MSTD_OPTS := NIL //** MHOW_MEAS := NIL //**ENDIF IF FIELDPOS('STD_OPTS') > 0 //** P3N - 4/22/98 MSTD_OPTS := STD_OPTS ELSE MSTD_OPTS := NIL ENDIF IF FIELDPOS('HOW_MEAS') > 0 //** P3N - 4/22/98 MHOW_MEAS := HOW_MEAS ELSE MHOW_MEAS := NIL ENDIF IF DISP_WAIT WAIT_BOX('*** Retrieving Product Options ***' , ; ' ', ; '*** Please Wait ***') ENDIF IF USE_TMP == NIL USE_TMP := .T. ENDIF IF PPR_CUSTID = NIL PR_CUSTID := SPACE(8) ELSE PR_CUSTID := PPR_CUSTID ENDIF ELEM := ASCAN(ALLGET_ARR, {|X| X[1] == MPROD_CODE ; .AND. X[2] == MHOW_MEAS ; .AND. X[5] == MSTD_OPTS ; .AND. X[6] == PR_CUSTID } ) IF ELEM > 0 GET_ARR := ACLONE(ALLGET_ARR[ELEM, 4]) PRICE_ARR := ACLONE(ALLPRI_ARR[ELEM, 4]) FILE1 := ALLPRI_ARR[ELEM,6] ELSE SEEKKEY = MCODE // SEEK SO THE PERCENT OF DEALER STUFF IS ALWAYS VISIBLE SELECT PRODUCT SEEK SEEKKEY IF !EMPTY(PR_CUSTID) SELECT CUST_ATTS FILE1 = 'CUST_ATTS' FILE2 = 'CUST_OPTS' DBNAME = 'CUST_ID + PROD_CODE' SEEKKEY := PR_CUSTID + MCODE SEEK SEEKKEY ENDIF IF EMPTY(PR_CUSTID) .OR. !FOUND() SEEKKEY = MCODE SELECT PROD_ATTS FILE1 = 'PROD_ATTS' FILE2 = 'PROD_OPTS' DBNAME = 'PROD_CODE' SEEK SEEKKEY IF !FOUND() SELECT CAT_ATTS SEEKKEY := PRODUCT->CAT_CODE SEEK SEEKKEY FILE1 = 'CAT_ATTS' FILE2 = 'CAT_OPTS' DBNAME = 'CAT_CODE' ENDIF ENDIF // SITTING ON FILE1, EITHER CUST_ATTS OR PRODUCTS OR CATEGORY FILE // GET LIST OF ATTRIBUTES GET_ARR := {} DO WHILE SEEKKEY == &DBNAME .AND. !EOF() MATT_CODE = ATT_CODE SELECT ATTRIBUTES SEEK MATT_CODE MDESC = DESC SELECT &FILE1 AADD(GET_ARR, {ATT_CODE, FIELD_TYPE, {}, SPACE(20), MDESC, ; RULE_PACK, .F., '', '', BEF_AFT_X, ''}) //////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\ // SET UP THE PRICING ARRAY TOO // ALL CUSTOMER ROWS/COLS ARE IN LINK_CODE IF !EMPTY(PR_CUSTID) IF LINK_CODE$'RC' AADD(D_ARR, {ATT_CODE, LINK_CODE}) ENDIF ELSE IF LINK_CODE$'RC' AADD(D_ARR, {ATT_CODE, LINK_CODE}) ENDIF IF LINK_SD$'RC' AADD(S_ARR, {ATT_CODE, LINK_SD}) ENDIF IF LINK_BU$'RC' AADD(B_ARR, {ATT_CODE, LINK_BU}) ENDIF IF LINK_LU$'RC' AADD(L_ARR, {ATT_CODE, LINK_LU}) ENDIF IF LINK_DI$'RC' AADD(J_ARR, {ATT_CODE, LINK_DI}) ENDIF IF LINK_IN$'RC' AADD(I_ARR, {ATT_CODE, LINK_IN}) ENDIF ENDIF SKIP 1 ENDDO IF !EMPTY(D_ARR) AADD(PRICE_ARR, {'D', D_ARR}) ENDIF IF !EMPTY(B_ARR) AADD(PRICE_ARR, {'B', B_ARR}) ELSE AADD(PRICE_ARR, {'B', PRODUCT->BU_BASEFAC}) ENDIF IF !EMPTY(S_ARR) AADD(PRICE_ARR, {'S', S_ARR}) ELSE AADD(PRICE_ARR, {'S', PRODUCT->SD_BASEFAC}) ENDIF IF !EMPTY(L_ARR) AADD(PRICE_ARR, {'L', L_ARR}) ELSE AADD(PRICE_ARR, {'L', PRODUCT->LU_BASEFAC}) ENDIF IF !EMPTY(J_ARR) AADD(PRICE_ARR, {'J', J_ARR}) ELSE AADD(PRICE_ARR, {'J', PRODUCT->DI_BASEFAC}) ENDIF IF !EMPTY(I_ARR) AADD(PRICE_ARR, {'I', I_ARR}) ELSE AADD(PRICE_ARR, {'I', PRODUCT->IN_BASEFAC}) ENDIF // LOAD UP THE OPTIONS FOR EACH ATTRIBUTE IF ELEM = 0 // no options in stored allget_arr FOR L = 1 TO LEN(GET_ARR) IF GET_ARR[L,2]$'PT' // ONLY DO PICKS & TABLES OPT_ARR := {} // START WITH LOWEST LEVEL FIRST! IF !EMPTY(PR_CUSTID) CHK_BLOCK = {|| CUST_ID + PROD_CODE + ATT_CODE} SELECT CUST_OPTS FILE2 = 'CUST_OPTS' SEEKKEY = PR_CUSTID + MPROD_CODE + GET_ARR[L,1] SEEK SEEKKEY ENDIF IF EMPTY(PR_CUSTID) .OR. !FOUND() CHK_BLOCK = {|| PROD_CODE + ATT_CODE} SELECT PROD_OPTS FILE2 = 'PROD_OPTS' SEEKKEY = MPROD_CODE + GET_ARR[L,1] SEEK SEEKKEY IF !FOUND() SELECT CAT_OPTS FILE2 = 'CAT_OPTS' SEEKKEY = PRODUCT->CAT_CODE + GET_ARR[L,1] // CAT ATTT + ATTRIBUTE SEEK SEEKKEY DBNAME = 'CAT_CODE' CHK_BLOCK = {|| CAT_CODE + ATT_CODE} ENDIF ENDIF IF !FOUND() SELECT ATT_OPTS FILE2 = 'ATT_OPTS' SEEKKEY = GET_ARR[L,1] // ATTRIBUTE SEEK SEEKKEY CHK_BLOCK = {|| ATT_CODE} ENDIF DO WHILE SEEKKEY == EVAL(CHK_BLOCK) .AND. !EOF() // ADD THE OPT VALUE, AND THE DEFAULT FLAG AADD(OPT_ARR, {OPT_VALUE, OPT_TYPE, RULE_PACK, {}, SEQ_NUM, ; // 1-5 PRINT_IND, PRINT_VAL, WIDTH_ADJ, HEIGHT_ADJ, ; // 6-9 LINK_PROD, PAR_PROD, ADJ_INVSZ, ; // 10-12 RND_TTW_TO, RND_TTW_RULE, ; // 13-14 RND_TTH_TO, RND_TTH_RULE, ADJ_TTSZ, ; // 15-17 INCL_RULE, ICPRT_RULE } ) // 18-19 // IF YOU ADD MORE, UPDATE EMPTY ARRAY BELOW! // GET ASSOCIATED PRICING VALUES OPT_ARRAMT := {} AADD(OPT_ARRAMT, LIST_PRICE ) AADD(OPT_ARRAMT, LIST_UI ) AADD(OPT_ARRAMT, LIST_SQFT ) OPT_ARR[LEN(OPT_ARR),4] = OPT_ARRAMT SKIP 1 ENDDO IF EMPTY(OPT_ARR) //* THE OPT_ARR NEEDS TO BE 19 ELEMENTS //* 1 , 2 , 3 , 4, 5, 6 , 7, 8 , 9 , 10 , 11 , 12, 13 , 14 , 15 , 16 , 17 , 18 19 AADD(OPT_ARR, {'NO OPTIONS FOUND!! ', ' ', '', {},0,' ',"",0.0000,0.0000," "," "," ",0.0000, " " ,0.0000," "," ", ' ', ' ' }) ENDIF OPT_ARR := ASORT(OPT_ARR, ,, {|X,Y| X[5] < Y[5] } ) GET_ARR[L,3] = OPT_ARR // PUT OPTION INFO INTO GET ARRAY GET_ARR[L,8] = FILE2 // WHERE THE OPTIONS CAME FROM ENDIF NEXT ENDIF IF ELEM = 0 TEMP_ARR := ACLONE(GET_ARR) AADD(ALLGET_ARR, {MPROD_CODE, MHOW_MEAS, ADDL_MODE, TEMP_ARR, MSTD_OPTS, PR_CUSTID}) TEMP_ARR := ACLONE(PRICE_ARR) AADD(ALLPRI_ARR, {MPROD_CODE, MHOW_MEAS, ADDL_MODE, TEMP_ARR, MSTD_OPTS, FILE1, PR_CUSTID }) ENDIF ENDIF // AT THIS POINT, HAVE A BLANK ARRAY EITHER FROM STATIC HOLD ARR OR FILE FOR L = 1 TO LEN(GET_ARR) IF ACTION = 1 // ?? LOAD USER CHOICES IF USE_TMP LINEFILE := 'USERFILE2' OPTFILE := 'USERFILE8' ELSE LINEFILE := CUR_OL OPTFILE := CUR_OO ENDIF // // LOAD USER RESPONSES OR DEFAULTS IF ADDL_MODE LINEFILE := CUR_XL //** P3N - 11/26/01 OPTFILE := CUR_XO //** P3N - 11/26/01 SEEKKEY = MORDER_NUM + (LINEFILE)->PROD_CODE + MLINE_NUM + GET_ARR[L,1] ELSE SEEKKEY = MORDER_NUM + MLINE_NUM + GET_ARR[L,1] ENDIF SELECT (OPTFILE) SEEK SEEKKEY IF FOUND() NEW_GET_ARR := .F. GET_ARR[L,4] = USER_RESP // HAS OWN OPTS ELSE // NO OPTIONS FOUND. FIRST, SEE IF PIRATE FROM LINE PREVIOUS. // IF NOT, THEN SEE IF PIRATE FROM THE PARENT ITEM IF ADDL_MODE // IF IT'S THE SAME AS THE MODEL BEFORE, GET THOSE OPTIONS SELECT (LINEFILE) IF USE_TMP .AND. RECNO() > 1 .AND. PIRATE_VAR = 'PIRATE_OPTS' SKIP -1 SELECT (OPTFILE) IF ADDL_MODE SEEKKEY = MORDER_NUM + (LINEFILE)->PROD_CODE + STR(&LINEFILE->LINE_NUM,3) + GET_ARR[L,1] ELSE SEEKKEY = MORDER_NUM + STR(&LINEFILE->LINE_NUM,3) + GET_ARR[L,1] ENDIF SEEK SEEKKEY IF FOUND() IF GET_ARR[L,1] = 'ORIEL TOP' .OR. GET_ARR[L,1] = 'ORIEL BOTT' // DON'T PIRATE ORIEL MEASUREMENTS. ELSE IF USER_RESP <> 'N/A' // 7-3-95 DON-SIZE PROBLEMS WHEN PIRATING OPTS FROM GET_ARR[L,4] = USER_RESP // PREVIOUS LINE'S VALUES. ENDIF ENDIF ENDIF SELECT (LINEFILE) SKIP 1 ELSE // SEEK ON THE PARENT OPTIONS FILE FOR THIS ATTRIBUTE IF ADDL_MODE SEEKKEY = MORDER_NUM + STR(&LINEFILE->LINE_NUM,3) + GET_ARR[L,1] SELECT (CUR_OO) SEEK SEEKKEY IF FOUND() GET_ARR[L,4] = USER_RESP ENDIF SELECT (OPTFILE) ENDIF ENDIF //// IF * WAS IN DATABASE, ONLY DO IF DURING SET OPTIONS. IF EMPTY(GET_ARR[L,4]) .AND. GET_ARR[L,2]$'PT' // LOOK FOR THE DEFAULT VALUE GET_ARR[L,4] = GET_DEFAULT(L, GET_ARR) IF EMPTY(GET_ARR[L,4]) GET_ARR[L,4] = 'No DEFAULT Options!!' GET_ARR[L,9] = ' ' SGACTION = 'GET' ELSE GET_ARR[L,9] = '*' // SET ANOTHER ELEMENT IN THE OPTIONS PART OF THE GETARR // WHICH SIGNIFIES THAT THIS VALUE WAS A CALCULATED DEFAULT. // THEN, DURING THE PRINT PROCESS, DON'T HAVE TO MESS WITH 'GET_DEFAULT' ENDIF ENDIF ENDIF ENDIF NEXT RESTSCREEN(,,,,SAVESCRN) SELECT(SV_SEL) RETURN {GET_ARR, PRICE_ARR, FILE1} ********************************************************* // MOVES THE TEMPORARY ORDER LINES INTO THE PERMANENT FILE (ADDL_LINES) ********************************************************* FUNCTION UPDATE_LINES LOCAL SAVESEL := SELECT(), MORDER_NUM, L := 0 LOCAL DELFLAG := .F., DEL_ARR := {}, MPROD_CODE MORDER_NUM = &CUR_MAST->ORDER_NUM SELECT USERFILE6 GOTO TOP DO WHILE !EOF() IF UPDATED = 'P' SKIP 1 LOOP ENDIF MLINE_NUM = LINE_NUM MPROD_CODE = PROD_CODE SELECT (CUR_XL) SEEK MORDER_NUM + MPROD_CODE + STR(MLINE_NUM,3) IF !FOUND() ADD_ONEREC('USERFILE6', CUR_XL) ELSE REC_LOCK(1) REP_ONEREC('USERFILE6', CUR_XL) REPLACE (CUR_XL)->GL311_AMT WITH ; ( SET_GL311( (CUR_XL)->PROD_CODE ) * (CUR_XL)->QUANTITY ) REPLACE UPDATED WITH ' ' // INDICATE THAT THIS IS NO LONGER PENDING UNLOCK ENDIF SELECT USERFILE6 SKIP 1 ENDDO SELECT (CUR_XL) SEEK MORDER_NUM DO WHILE ORDER_NUM == MORDER_NUM .AND. !EOF() IF UPDATED = 'P' AADD(DEL_ARR, RECNO() ) DELFLAG := .T. ENDIF SKIP 1 ENDDO IF DELFLAG FOR L = 1 TO LEN(DEL_ARR) GOTO DEL_ARR[L] REC_LOCK(1) REPLACE ORDER_NUM WITH '' REPLACE LINE_NUM WITH 0 REPLACE PROD_CODE WITH '' DELETE UNLOCK NEXT ENDIF RETURN .T. ********************************************************* // MOVES THE TEMPORARY ORDER OPTIONS INTO THE PERMANENT FILE ********************************************************* FUNCTION UPDATE_ORDS(MUSERFILE) LOCAL MORDER_NUM, MLINE_NUM, MATT_CODE, MUSER_RESP LOCAL SAVESEL := SELECT(), DELFLAG := .F., SAVESCR LOCAL DEL_ARR := {}, REALFILE, SEEKKEY LOCAL ADDL_MODE := .F. LOCAL REAL_PARENT LOCAL M1 := 'Do you want to CONTINUE? ' + ; 'Order ' +(CUR_MAST)->ORDER_NUM + ' shippped on ' + ; DTOC((CUR_MAST)->SHIP_DATE) LOCAL M2 := 'If you do continue it is IMPERATIVE to RECREATE ' LOCAL M3 := 'Order Control Shipping Information to reflect any changes.' LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') //** P3N - 10/15/98 IF CUR_MAST == 'ORD_MAST' .AND. MUSERFILE = 'USERFILE8' //** P3N - 10/15/98 IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' //** P3N - 10/15/98 IF SELECT('ORD_SHIP') > 0 //** P3N - 10/15/98 ELSE //** P3N - 10/15/98 DBOPEN('ORD_SHIP') //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 IF ORD_SHIP->(DBSEEK((CUR_MAST)->ORDER_NUM)) //** P3N - 10/15/98 ? CHR(7) //** P3N - 10/15/98 IF PROMPT_BOX(M1, M2, M3) //** P3N - 10/15/98 // USER REQUESTED TO CONTINUE WITH THE UPDATE SEND INFO MSG ERR_BOX('ANY Order changes will TAINT EXISTING Shipping Information. ' , ; 'IF YOU CONTINUE - To ENSURE ACCURATE shipping information: ' , ; ' 1) REMOVE ALL current Shipping Information.', ' and', ; ' 2) RE-SHIP this Order. ' , ; 'Press to ABORT. ' ) IF LASTKEY() = 27 //** P3N - 10/15/98 RETURN .F. //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 ELSE //** P3N - 10/15/98 KEYBOARD CHR(27) //** P3N - 11/19/98 RETURN .F. //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 ENDIF //** P3N - 10/15/98 IF MUSERFILE == 'USERFILE8' //* REALFILE = 'ORDER_OPTS' //* REAL_PARENT := 'ORD_LINES' * REALFILE = ['] + &CUR_OO + ['] * REAL_PARENT := ['] + &CUR_OL + ['] REALFILE = CUR_OO REAL_PARENT := CUR_OL ELSE IF MUSERFILE == 'USERFILE9' //* REALFILE = 'ADDL_OPTS' //* REAL_PARENT := 'ADDL_LINES' * REALFILE = ['] + &CUR_XO + ['] * REAL_PARENT := ['] + &CUR_XL + ['] REALFILE = CUR_XO REAL_PARENT := CUR_XL ADDL_MODE := .T. ELSE IF MUSERFILE == 'FILE8FILE9' MUSERFILE = 'USERFILE8' //* REALFILE = "ADDL_OPTS" //* REAL_PARENT := 'ADDL_LINES' * REALFILE = ['] + &CUR_XO + ['] * REAL_PARENT := ['] + &CUR_XL + ['] REALFILE = CUR_XO REAL_PARENT := CUR_XL ADDL_MODE := .T. ENDIF ENDIF ENDIF SELECT (MUSERFILE) GO TOP MORDER_NUM = ORDER_NUM DO WHILE !EOF() MLINE_NUM = LINE_NUM MATT_CODE = ATT_CODE MUSER_RESP = USER_RESP SELECT (REALFILE) IF ADDL_MODE SEEKKEY := MORDER_NUM + (MUSERFILE)->PROD_CODE + STR(MLINE_NUM,3) ELSE SEEKKEY := MORDER_NUM + STR(MLINE_NUM,3) ENDIF IF !( (REAL_PARENT)->(DBSEEK(SEEKKEY)) ) SELECT (MUSERFILE) SKIP 1 LOOP ENDIF SELECT (REALFILE) SEEKKEY := SEEKKEY + MATT_CODE // SEEKKEY ON OPT_FILE HAS ATT_CODE AT END SEEK SEEKKEY IF !FOUND() ADD_REC(3) REPLACE ORDER_NUM WITH MORDER_NUM REPLACE LINE_NUM WITH MLINE_NUM REPLACE ATT_CODE WITH MATT_CODE IF ADDL_MODE REPLACE PROD_CODE WITH (MUSERFILE)->PROD_CODE ENDIF ELSE REC_LOCK(3) ENDIF REPLACE USER_RESP WITH MUSER_RESP REPLACE UPDATED WITH ' ' UNLOCK SELECT (MUSERFILE) SKIP 1 ENDDO SELECT (REALFILE) SEEKKEY = MORDER_NUM SEEK SEEKKEY DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF() IF UPDATED = 'P' AADD(DEL_ARR, RECNO() ) DELFLAG := .T. ENDIF SKIP 1 ENDDO IF DELFLAG FOR L = 1 TO LEN(DEL_ARR) GOTO DEL_ARR[L] REC_LOCK(1) REPLACE ORDER_NUM WITH '' REPLACE LINE_NUM WITH 0 REPLACE ATT_CODE WITH '' IF ADDL_MODE REPLACE PROD_CODE WITH '' ENDIF DELETE UNLOCK NEXT ENDIF SELECT (SAVESEL) RETURN .T. ********************************************************* // MAKE SURE THE PICKS HAVE A VALID RESPONSE ********************************************************* FUNCTION VALID_PICK(GET_ARR, POINTER) LOCAL L, CHECK_VAR IF GET_ARR[POINTER,2]$'PT' CHECK_VAR = GET_ARR[POINTER,4] IF ALLTRIM(CHECK_VAR) = 'N/A' .OR. EMPTY(CHECK_VAR) RETURN .T. ENDIF FOR L = 1 TO LEN(GET_ARR[POINTER,3]) // LIST OF GOOD OPTS IF CHECK_VAR == GET_ARR[POINTER,3,L,1] RETURN .T. ENDIF NEXT RETURN .F. ENDIF RETURN .T. ********************************************************* // RENAME ATTRIBUTES ********************************************************* FUNCTION REN_ATT // RENAME ATTRIBUTES LOCAL ATT_PARM := DBOPEN('ATTRIBUTES', .T.) , CUR_ATT, NEW_ATT LOCAL MSG1, MSG2 CLS SAYTITLE('Rename Attributes', 'PRPO' ) DBOPEN('ATT_OPTS', .T.) DBOPEN('CAT_ATTS', .T.) DBOPEN('CAT_OPTS', .T.) DBOPEN('PROD_ATTS', .T.) DBOPEN('PROD_OPTS', .T.) DBOPEN('ORDER_OPTS', .T.) DBOPEN('ADDL_OPTS', .T.) DBOPEN('MATHPACK', .T.) DBOPEN('RULEPACK', .T.) // ADD NEW FILES TO THIS LIST FOR QUOTE OPTS DBOPEN('QUOTE_OPTS', .T.) DBOPEN('ADDL_QOPT', .T.) DO WHILE .T. CUR_ATT = GET_KEY(ATT_PARM) IF EMPTY(CUR_ATT) .OR. LASTKEY() = 27 CLOSE DATABASES RETURN ENDIF NEW_ATT = SPACE(10) @ 05,19 SAY ' Enter New Attribute' GET NEW_ATT PICTURE '@!' @ 06,19 SAY ' (Press to Quit)' READ() IF EMPTY(NEW_ATT) LOOP ENDIF MSG1 := 'About to CHANGE Attributes' MSG2 := 'Do You Wish to Continue?' IF !PROMPT_BOX(MSG1,MSG2,'') // ASKS YES/NO, YES = .T., NO = .F. @ 5,0 CLEAR LOOP ENDIF @ 6,0 CLEAR @ 10,10 SAY 'Changing ATTRIBUTES in the Attribute File' SELECT ATTRIBUTES DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Attribute Options File' SELECT ATT_OPTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Category File' SELECT CAT_ATTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Category Options File' SELECT CAT_OPTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Model File' SELECT PROD_ATTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Model Options File' SELECT PROD_OPTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Order Options File' SELECT ORDER_OPTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Additional Order Options File' SELECT ADDL_OPTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Quote Options File' SELECT QUOTE_OPTS DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Additional Quote Options File' SELECT ADDL_QOPT DONSETORD(0) REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Math Pack File' SELECT MATHPACK DONSETORD(0) DO WHILE !EOF() IF TRIM(FIELD1) == TRIM(CUR_ATT) REPLACE FIELD1 WITH NEW_ATT ENDIF IF TRIM(FIELD2) == TRIM(CUR_ATT) REPLACE FIELD2 WITH NEW_ATT ENDIF IF TRIM(ATT_CODE) == TRIM(CUR_ATT) REPLACE ATT_CODE WITH NEW_ATT ENDIF SKIP 1 ENDDO DONSETORD(1) @ 10,0 @ 10,10 SAY 'Changing ATTRIBUTES in the Rule Pack File' SELECT RULEPACK DONSETORD(0) DO WHILE !EOF() IF TRIM(FIELD1) == TRIM(CUR_ATT) REPLACE FIELD1 WITH NEW_ATT ENDIF IF TRIM(FIELD2) == TRIM(CUR_ATT) REPLACE FIELD2 WITH NEW_ATT ENDIF IF TRIM(ALIAS1) == TRIM(CUR_ATT) REPLACE ALIAS1 WITH NEW_ATT ENDIF IF TRIM(ALIAS2) == TRIM(CUR_ATT) REPLACE ALIAS2 WITH NEW_ATT ENDIF SKIP 1 ENDDO DONSETORD(1) @ 5,0 CLEAR ENDDO CLOSE DATABASES RETURN ********************************************************* * CALCULATE THE ITEM DISCOUNTS ********************************************************* FUNCTION ITEMDISC( PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) LOCAL THIS_DISC, THIS_LINE LOCAL ALT_PRICE_IND := .F. //** P3N - 9/1/98 LOCAL QTYARR := {} //** P3N -12/4/98 LOCAL INV_QTY := 0 //** P3N -12/4/98 //DEFAULT PARTIAL_INVOICE := .F. //DEFAULT REPRINT_INVOICE := .F. If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) IF EMPTY(PARTIAL_INVOICE) //** P3N -11/24/98 PARTIAL_INVOICE := .F. //** P3N -11/24/98 ENDIF //** P3N -11/24/98 IF EMPTY(REPRINT_INVOICE) //** P3N -12/4/98 REPRINT_INVOICE := .F. //** P3N -12/4/98 ENDIF //** P3N -12/4/98 IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N -12/4/98 QTYARR := GET_OSTQTY(SELFILE) //** P3N -12/4/98 IF EMPTY(QTYARR) //** P3N - 12/4/98 SHP_QTY := 0 //** P3N - 12/4/98 INV_QTY := 0 //** P3N - 12/4/98 ELSE //** P3N - 12/4/98 SHP_QTY := QTYARR[1] //** P3N - 12/4/98 INV_QTY := QTYARR[2] //** P3N - 12/4/98 ENDIF //** P3N - 12/4/98 ENDIF //** P3N - 12/4/98 IF ALT_SPRICE <> 0 IF PARTIAL_INVOICE //** P3N - 11/24/98 //**THIS_LINE := (ALT_SPRICE * SHIP_QTY) //** P3N - 11/24/98 THIS_LINE := (ALT_SPRICE * SHP_QTY) //** P3N - 11/24/98 ELSEIF REPRINT_INVOICE //** P3N - 12/07/98 THIS_LINE := (ALT_SPRICE * INV_QTY) //** P3N - 12/07/98 ELSE THIS_LINE := (ALT_SPRICE * QUANTITY) ENDIF ALT_PRICE_IND := .T. //** P3N - 9/1/98 ELSE IF PARTIAL_INVOICE //** P3N - 11/24/98 //**THIS_LINE := (SALE_PRICE * SHIP_QTY) //** P3N - 11/24/98 THIS_LINE := (SALE_PRICE * SHP_QTY) //** P3N - 11/24/98 ELSEIF REPRINT_INVOICE //** P3N - 12/07/98 THIS_LINE := (SALE_PRICE * INV_QTY) //** P3N - 12/07/98 ELSE THIS_LINE := (SALE_PRICE * QUANTITY) ENDIF ENDIF //** P3N - 11/23/98 PARTIAL INVOICE PROCESSING IF EMPTY(THIS_LINE) THIS_DISC := 0 //** P3N - 11/23/98 ELSEIF DISCOUNT <> 0 THIS_DISC := (DISCOUNT * .01 * THIS_LINE) ELSEIF EMPTY(DISC_S_AMT) //** IF NO LINE ITEM DISC. USE SYS/CUST DISC THIS_DISC := (SYS_DISC * .01 * THIS_LINE) ELSEIF PARTIAL_INVOICE //** P3N - 12/4/98 //** THIS_DISC := DISC_S_AMT * SHIP_QTY THIS_DISC := DISC_S_AMT * SHP_QTY ELSEIF REPRINT_INVOICE //** P3N - 12/4/98 THIS_DISC := DISC_S_AMT * INV_QTY ELSE //** P3N - 12/4/98 THIS_DISC := DISC_S_AMT * QUANTITY ENDIF **IF EMPTY(ALT_SPRICE) // P3N - PER ELLEN - 6/3/98 **ELSE // DO NOT APPLY A DISCOUNT ON ALT PRICE! ** THIS_DISC := 0 **ENDIF THIS_DISC := VAL(STR(THIS_DISC,12,2)) //** P3N - 4/3/98 IS THIS ALT_SPRICE A CREDIT? //** P3N - IF A CREDIT SET THE DISCOUNT NEGATIVE //** P3N - CGWPRINT FUNC PRNT_DISCOUNTS() WILL TREAT A NEGATIVE DISCOUNT //** P3N - AS A POSITIVE CHARGE BACK. IF ALT_SPRICE <> 0 IF ALT_SPRICE + SALE_PRICE = 0 IF THIS_DISC < 0 // DISCOUNT IS ALREADY NEGATIVE ELSE THIS_DISC := THIS_DISC * -1 ENDIF ENDIF ELSEIF (CUR_MAST)->TERMS = '98' //CREDIT MEMO IF THIS_DISC < 0 // DISCOUNT IS ALREADY NEGATIVE ELSE THIS_DISC := THIS_DISC * -1 ENDIF ENDIF RETURN {THIS_LINE, THIS_DISC, ALT_PRICE_IND} //** P3N - 9/1/98 ****RETURN {THIS_LINE, THIS_DISC} //** P3N - 9/1/98 ********************************************************* ** UPDATE MISC TOTAL IN ORDER MASTER ** P3N - 2/20/98 ** PER ELLENS REQUEST - ADDED AN ALTERNATE PRICE ** USED TO OVERRIDE THE SYSTEM GENERATED PRICE! ********************************************************* FUNCTION UP_MISCTOT(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) //**LOCAL SUBTOT:=0, SAVESEL := SELECT() LOCAL SUBTOT := 0, QTYARR := {} LOCAL WKQTY := 0, MISCKEY //** P3N - 11/25/98 LOCAL MISCITMS := CUR_MISC //** P3N - 11/25/98 //DEFAULT PARTIAL_INVOICE := .F. //DEFAULT REPRINT_INVOICE := .F. If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/25/98 PARTIAL_INVOICE := .F. //** P3N - 11/25/98 ENDIF IF EMPTY(REPRINT_INVOICE) //** P3N - 12/4/98 REPRINT_INVOICE := .F. //** P3N - 12/4/98 ENDIF IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N - 12/4/98 MISCITMS := 'TORD_LINES' //** P3N - 11/25/98 IF SELECT('TORD_LINES') > 0 //** TORD_LINES ALREADY EXISTS IF (MISCITMS)->ORDER_NUM == (CUR_MAST)->ORDER_NUM //** TORD_LINES ALREADY EXISTS WITH THE SAME ORDER - PROCESS ELSE CLOSE TORD_LINES BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) ENDIF ELSE BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) ENDIF (MISCITMS)->(DBGOTOP()) ELSE (MISCITMS)->(DBSEEK(MORDER_NUM)) ENDIF DO WHILE (MISCITMS)->(!EOF()) .AND. (MISCITMS)->ORDER_NUM == MORDER_NUM WKQTY := (MISCITMS)->QUANTITY IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N - 12/4/98 IF (MISCITMS)->PROD_CODE == 'MISCITM' MISCKEY := (MISCITMS)->ORDER_NUM MISCKEY := MISCKEY + STR((MISCITMS)->LINE_NUM, 3) MISCKEY := MISCKEY + (MISCITMS)->PROD_CODE QTYARR := GET_OSTQTY('TORD_LINES', MISCKEY) IF EMPTY(QTYARR) //** P3N - 12/4/98 WKQTY := 0 //** P3N - 12/4/98 ELSEIF PARTIAL_INVOICE //** P3N - 12/4/98 WKQTY := QTYARR[1] //** SHIP QTY ELSEIF REPRINT_INVOICE //** P3N - 12/4/98 WKQTY := QTYARR[2] //** INVOICE QTY ENDIF //** P3N - 12/4/98 ELSE WKQTY := 0 ENDIF ENDIF IF EMPTY((MISCITMS)->ALT_SPRICE) //** P3N - 2/20/98 SUBTOT := SUBTOT + ( (MISCITMS)->SALE_PRICE * WKQTY ) ELSE SUBTOT := SUBTOT + ((MISCITMS)->ALT_SPRICE * WKQTY ) //**P3N-2/20/98 ENDIF (MISCITMS)->(DBSKIP(+1)) ENDDO //**(MISCITMS)->(DBGOTOP()) IF SUBTOT > 99999.99 ERR_BOX('** Calculated total - ' + ALLTRIM(STR(SUBTOT,16,4)) + ; ' is larger Than allowable! **', ; ' The Max. allowable MISC. Order Items total is - $99,999.99', ; ' The Order INVOICE TOTAL may be INCORRECT!') ELSE //** SELECT (CUR_MAST) REC_LOCK(1, CUR_MAST) REPLACE (CUR_MAST)->ORD_M_TTL WITH SUBTOT (CUR_MAST)->(DBUNLOCK()) ENDIF //**SELECT (SAVESEL) RETURN .T. ********************************************************* ****PAINT SCREEN BEFORE 2115 EXECUTES ********************************************************* FUNCTION MISCP_PAINT(NOPAINT, PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) LOCAL SAVESEL := SELECT() LOCAL LINE_TOTAL := 0, SUBTOTL := 0, SEEKKEY := &CUR_MAST->ORDER_NUM LOCAL DISC_TOTAL := 0, _DISC_INFO LOCAL MISC_TOTAL, L1 := 0, L2 := 0, L3 := 0 LOCAL THIS_LINE := 0, THIS_DISC := 0 LOCAL M1 := 0, M2 := 0, M3 := 0, NTX1 := 0, NTX2 := 0, NTX3 := 0 LOCAL T1 := 0, T2 := 0, T3 := 0 //** P3N - 11/25/98 LOCAL ALT_PRICE_IND := .F. //** P3N - 9/1/98 LOCAL ALT_PR_ARR := {} //** P3N - 9/1/98 LOCAL MISC_ARR := {} //** P3N - 11/25/98 LOCAL DISC_ARR := {} //** P3N - 12/07/98 LOCAL DISC_PCT := 0, ELM := 0, TOT_AMT := 0 //** P3N - 12/07/98 LOCAL DISP_PCT := 0 LOCAL FSC_PCT := SHIPMETH->FUEL_CHRG / 100 //** P3N - 09/21/06 //DEFAULT PARTIAL_INVOICE := .F. //DEFAULT REPRINT_INVOICE := .F. If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) IF SHIPMETH->(DBSEEK( (CUR_MAST)->SHP_METHOD )) //** P3N - 11/13/06 FSC_PCT := SHIPMETH->FUEL_CHRG / 100 //** P3N - 11/13/06 ENDIF //** P3N - 11/13/06 //** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS IF EMPTY(NOPAINT) //** P3N - 11/23/98 NOPAINT := .F. //** P3N - 11/23/98 ENDIF //** P3N - 11/23/98 IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/23/98 PARTIAL_INVOICE := .F. //** P3N - 11/23/98 ENDIF //** P3N - 11/23/98 IF EMPTY( REPRINT_INVOICE ) //** P3N - 12/4/98 REPRINT_INVOICE := .F. //** P3N - 12/4/98 ENDIF //** P3N - 12/4/98 IF LASTKEY() = 27 RETURN ENDIF // DO ORDER LINES FIRST, THEN ADDL PRODUCTS SECOND IF &CUR_MAST->QUOTE_PRIC > 0 LINE_TOTAL := &CUR_MAST->QUOTE_PRIC ELSE SELECT (CUR_OL) SEEK SEEKKEY DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF() _DISC_INFO := ITEMDISC(PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) THIS_LINE := _DISC_INFO[1] THIS_DISC := _DISC_INFO[2] ALT_PRICE_IND := _DISC_INFO[3] //** P3N - 9/1/98 IF ALT_PRICE_IND //** P3N - 9/1/98 AADD(ALT_PR_ARR, {LINE_NUM, PROD_CODE } ) //** P3N - 9/1/98 ENDIF //** P3N - 9/1/98 LINE_TOTAL := LINE_TOTAL + THIS_LINE // CHECK FOR USER LINE DISCOUNTS OR SYSTEM CALC DISCOUNTS DISC_TOTAL := DISC_TOTAL + THIS_DISC SKIP 1 ENDDO SELECT (CUR_XL) SEEK SEEKKEY DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF() IF ALT_SPRICE <> 0 THIS_LINE := (ALT_SPRICE * QUANTITY) ELSE THIS_LINE := (SALE_PRICE * QUANTITY) ENDIF //** P3N - 9/1/98 DO NOT INCLUDE THE ADDL LINE PRICE IN THE TOTAL //** P3N - 9/1/98 ORDER AMOUNT IF AN ALT. PRICE HAS BEEN ENTERED. IF EMPTY(ALT_PR_ARR) .OR. ; //** P3N - 9/1/98 EMPTY(ASCAN(ALT_PR_ARR, {|X| X[1] == LINE_NUM .AND. ; X[2] == PAR_PROD } ) ) LINE_TOTAL := LINE_TOTAL + THIS_LINE //** P3N - 9/1/98 ENDIF //** P3N - 9/1/98 // CHECK FOR USER LINE DISCOUNTS OR SYSTEM CALC DISCOUNTS IF DISCOUNT <> 0 THIS_DISC := (DISCOUNT * .01 * THIS_LINE) ELSE THIS_DISC := DISC_S_AMT * QUANTITY ENDIF DISC_TOTAL := DISC_TOTAL + THIS_DISC SKIP 1 ENDDO ENDIF //* CALC SUBTOTAL UP_MISCTOT((CUR_MAST)->ORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) //** P3N - 11/25/98 SELECT (CUR_MAST) MISC_TOTAL := &CUR_MAST->ORD_M_TTL //* F8-MISC TOTALS IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N - 11/24/98 MISC_ARR := GETQTYMISC( (CUR_MAST)->ORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE ) FOR I := 1 TO LEN(MISC_ARR[1]) IF MISC_ARR[1,I,5] == 'ORDMISC1' IF REPRINT_INVOICE //** P3N - 12/4/98 M1 := MISC_ARR[1,I,6] //** INV QTY ELSE M1 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L1 := MISC_ARR[1,I,4] //** ITEM PRICE M1 := M1 * L1 ELSEIF MISC_ARR[1,I,5] == 'ORDMISC2' IF REPRINT_INVOICE //** P3N - 12/4/98 M2 := MISC_ARR[1,I,6] //** INV QTY ELSE M2 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L2 := MISC_ARR[1,I,4] //** ITEM PRICE M2 := M2 * L2 ELSEIF MISC_ARR[1,I,5] == 'ORDMISC3' IF REPRINT_INVOICE //** P3N - 12/4/98 M3 := MISC_ARR[1,I,6] //** INV QTY ELSE M3 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L3 := MISC_ARR[1,I,4] //** ITEM PRICE M3 := M3 * L3 ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX1' IF REPRINT_INVOICE //** P3N - 12/4/98 T1 := MISC_ARR[1,I,6] //** INV QTY ELSE T1 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L1 := MISC_ARR[1,I,4] //** ITEM PRICE NTX1 := T1 * L1 ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX2' IF REPRINT_INVOICE //** P3N - 12/4/98 T2 := MISC_ARR[1,I,6] //** INV QTY ELSE T2 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L2 := MISC_ARR[1,I,4] //** ITEM PRICE NTX2 := T2 * L2 ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX3' IF REPRINT_INVOICE //** P3N - 12/4/98 T3 := MISC_ARR[1,I,6] //** INV QTY ELSE T3 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L3 := MISC_ARR[1,I,4] //** ITEM PRICE NTX3 := T3 * L3 ENDIF NEXT ELSE //* - SCREEN 2115 MISC ITEMS M1 := &CUR_MAST->MISC_AMT1 * &CUR_MAST->MISC_QTY1 M2 := &CUR_MAST->MISC_AMT2 * &CUR_MAST->MISC_QTY2 M3 := &CUR_MAST->MISC_AMT3 * &CUR_MAST->MISC_QTY3 //* 7-30-97 NON-TAXABLE AMOUNTS ADDED - Perry Nichols NTX1 := &CUR_MAST->NOTX_AMT1 * &CUR_MAST->NOTX_QTY1 NTX2 := &CUR_MAST->NOTX_AMT2 * &CUR_MAST->NOTX_QTY2 NTX3 := &CUR_MAST->NOTX_AMT3 * &CUR_MAST->NOTX_QTY3 ENDIF SUBTOTL := (CUR_MAST)->ORD_L_TTL + (CUR_MAST)->ORD_M_TTL + M1 + M2 + M3 SUBTOTL := SUBTOTL - (CUR_MAST)->ORD_D_TTL IF _OC_CAPABLE REC_LOCK(1) REPLACE (CUR_MAST)->ORD_L_TTL WITH LINE_TOTAL IF DISC_TOTAL > 9999.99 ERR_BOX('** The Calculated Discount is - ' + STR(DISC_TOTAL, 15,2) + ' **' , ; '** The system can store a discount up to $9999.99 **') ELSE REPLACE (CUR_MAST)->ORD_D_TTL WITH DISC_TOTAL ENDIF IF M->OE_TYPE == 'ADD' .AND. ; //** P3N - 09/22/06 HAPPY BDAY CINDY #47 EMPTY((CUR_MAST)->FUEL_CHRG) //** ADD ORDER TIME-CALC BASED ON THE ORDER TOTAL * SHIPMETH->FUEL_CHRG % SUBTOTL := (CUR_MAST)->ORD_L_TTL + (CUR_MAST)->ORD_M_TTL + M1 + M2 + M3 SUBTOTL := SUBTOTL - (CUR_MAST)->ORD_D_TTL REPLACE (CUR_MAST)->FUEL_CHRG WITH SUBTOTL * FSC_PCT ENDIF SUBTOTL += (CUR_MAST)->FUEL_CHRG //** P3N - 09/22/06 HAPPY BDAY CINDY #47 REPLACE (CUR_MAST)->SALES_TAX WITH ( (CUR_MAST)->SLS_TX_PCT * SUBTOTL ) /100 //* 7-30-97 NON-TAXABLE AMOUNTS ADDED - Perry Nichols TOT_AMT := SUBTOTL +(CUR_MAST)->SALES_TAX + NTX1 + NTX2 + NTX3 //** P3N - 09/21/06 ADDED THE FUEL SURCHARGE TO ORDER ENTRY REPLACE (CUR_MAST)->TOTAL_AMT WITH TOT_AMT IF ZERO_ORDER() //** NO CHARGE P3N-3/5/99 REPLACE (CUR_MAST)->TOTAL_AMT WITH 0 REPLACE (CUR_MAST)->SALES_TAX WITH 0 //** P3N - 02/20/07 ENDIF (CUR_MAST)->(DBUNLOCK()) ENDIF //** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS IF NOPAINT //** DO NOT PAINT ANYTHING ON THE SCREEN ELSE @ 02,33 SAY ' Line Item Totals ' + STR(&CUR_MAST->ORD_L_TTL,9,2) @ 03,33 SAY ' Less Discounts ' @ 04,33 SAY ' Misc Item Lines ' @ 06,06 SAY 'Misc. Items' @ 06,36 SAY 'Qty' @ 06,45 SAY 'Cost' @ 10,53 SAY '----------' @ 11,43 SAY 'Subtotal ' //* 7-30-97 NON-TAXABLE AMOUNTS ADDED - Perry Nichols //* lines 16-20 are used for the NON-TAXABLE items //** P3N - 09/21/06 ADD FUEL SURCHARGE TO ORDER ENTRY @ 14,53 SAY '----------' @ 15,06 SAY 'Non-Taxable Items' @ 15,36 SAY 'Qty' @ 15,45 SAY 'Cost' @ 19,53 SAY '----------' IF EMPTY((CUR_MAST)->FUEL_CHRG) ELSE DISP_PCT := VAL (STR((CUR_MAST)->FUEL_CHRG / SUBTOTL,15,2)) ENDIF @ 12,65 SAY STR(DISP_PCT*100, 3,0) + '%' //** P3N - 09/21/06 @ 13,65 SAY STR((CUR_MAST)->SLS_TX_PCT, 8,4) + '%' //** P3N - 09/22/06 - HAPPY BDAY CINDY #47 @ 21,33 SAY 'Order ' + ALLTRIM((CUR_MAST)->ORDER_NUM) + ' TOTAL' @ 22,53 SAY '==========' ENDIF UP_ORD_TTL(NOPAINT, MISC_ARR, PARTIAL_INVOICE, REPRINT_INVOICE ) SELECT(SAVESEL) RETURN .T. ********************************************************* * THIS FUNCTION PROVIDES THE PROCESSING FOR THE MISC PRICING SCREEN ********************************************************* FUNCTION MISC_PRICING( ) LOCAL SV_SEL := SELECT() LOCAL SV_COLOR := SETCOLOR(BLACK) LOCAL I_DESC := SPACE(30), I_AMT := 0, FR_AMT := 0 LOCAL SLS_TAX := 0 LOCAL MTITLE := 'ADD Misc Items / Close Order - ' + &CUR_MAST->ORDER_NUM LOCAL ASR_ARR, OPT LOCAL ACTION_CODE := GETAVAR( 'ACTION_CODE' ) IF LASTKEY() = 27 RETURN ENDIF IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' OPT := 1 MTITLE := 'ADD Misc Items / Close Order - ' + &CUR_MAST->ORDER_NUM IF CUR_MAST = 'QUOTE_MAST' MTITLE := 'ADD Misc Items / Close Quote - ' + &CUR_MAST->ORDER_NUM ENDIF ELSE OPT := 3 MTITLE := 'ORDER Misc Items - ' + &CUR_MAST->ORDER_NUM IF CUR_MAST = 'QUOTE_MAST' MTITLE := 'QUOTE Misc Items - ' + &CUR_MAST->ORDER_NUM ENDIF ENDIF ASR_ARR := {'&CUR_MAST',.F., , , , , ACTION_CODE , '2115', .F.} NEWREC := .F. ADD_SING_REC(OPT, MTITLE, ASR_ARR) UP_OM_NEED_CALC() // INDICATE THE THE ORDER IS COMPLETE. SETCOLOR(SV_COLOR) SELECT(SV_SEL) RETURN .T. ********************************************************* * THIS FUNCTION UPDATES THE ORDER TOTALS ********************************************************* FUNCTION UP_ORD_TTL(NOPAINT, MISC_ARR, PARTIAL_INVOICE, REPRINT_INVOICE) LOCAL SAVECOLOR := SETCOLOR(HNOR), LINE_TOTAL := 0 LOCAL PRNTVAR, SAVESEL := SELECT() LOCAL M1 := 0, M2 := 0, M3 := 0, NTX1 := 0, NTX2 := 0, NTX3 := 0 LOCAL T1 := 0, T2 := 0, T3 := 0 //** P3N - 11/25/98 LOCAL MISC_TOTAL := 0, M_FSC := 0, MFUEL_CHRG := 0 LOCAL DISC_TOTAL := 0, SUB1 := 0 LOCAL STX_AMT := 0, TOT_AMT := 0 LOCAL M_AMT1 := 0, M_AMT2 := 0, M_AMT3 := 0, M_STAX := 0 LOCAL M_QTY1 := 0, M_QTY2 := 0, M_QTY3 := 0, M_OTTL := 0 LOCAL DISP_PCT := 0 //7-30-97 NO more FREIGHT - per Ellen ****STATIC M_TTL ****STATIC M_FRT //7-30-97 NON-TAX MODIFICATIONS - Perry Nichols LOCAL NOTX_AMT1,NOTX_AMT2,NOTX_AMT3,NOTX_QTY1,NOTX_QTY2,NOTX_QTY3 //** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS IF EMPTY(NOPAINT) NOPAINT := .F. ENDIF IF NOPAINT //** DO NOT PAINT ANYTHING ON THE SCREEN - JUST CALC TOTALS //** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS IF EMPTY(MISC_ARR) //** USE ORDER QTYS TO CALC TOTALS M1 := (CUR_MAST)->MISC_AMT1 * (CUR_MAST)->MISC_QTY1 M2 := (CUR_MAST)->MISC_AMT2 * (CUR_MAST)->MISC_QTY2 M3 := (CUR_MAST)->MISC_AMT3 * (CUR_MAST)->MISC_QTY3 NTX1 := (CUR_MAST)->NOTX_AMT1 * (CUR_MAST)->NOTX_QTY1 NTX2 := (CUR_MAST)->NOTX_AMT2 * (CUR_MAST)->NOTX_QTY2 NTX3 := (CUR_MAST)->NOTX_AMT3 * (CUR_MAST)->NOTX_QTY3 ELSE //** USE SHIP QTYS TO CALC TOTALS FOR I := 1 TO LEN(MISC_ARR[1]) IF MISC_ARR[1,I,5] == 'ORDMISC1' IF REPRINT_INVOICE M1 := MISC_ARR[1,I,6] //** INV QTY ELSE M1 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L1 := MISC_ARR[1,I,4] //** ITEM PRICE M1 := M1 * L1 ELSEIF MISC_ARR[1,I,5] == 'ORDMISC2' IF REPRINT_INVOICE M2 := MISC_ARR[1,I,6] //** INV QTY ELSE M2 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L2 := MISC_ARR[1,I,4] //** ITEM PRICE M2 := M2 * L2 ELSEIF MISC_ARR[1,I,5] == 'ORDMISC3' IF REPRINT_INVOICE M3 := MISC_ARR[1,I,6] //** INV QTY ELSE M3 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L3 := MISC_ARR[1,I,4] //** ITEM PRICE M3 := M3 * L3 ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX1' IF REPRINT_INVOICE T1 := MISC_ARR[1,I,6] //** INV QTY ELSE T1 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L1 := MISC_ARR[1,I,4] //** ITEM PRICE NTX1 := T1 * L1 ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX2' IF REPRINT_INVOICE T2 := MISC_ARR[1,I,6] //** INV QTY ELSE T2 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L2 := MISC_ARR[1,I,4] //** ITEM PRICE NTX2 := T2 * L2 ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX3' IF REPRINT_INVOICE T3 := MISC_ARR[1,I,6] //** INV QTY ELSE T3 := MISC_ARR[1,I,3] //** SHIP QTY ENDIF L3 := MISC_ARR[1,I,4] //** ITEM PRICE NTX3 := T3 * L3 ENDIF NEXT ENDIF SUB1 := M1 + M2 + M3 ; + &CUR_MAST->ORD_L_TTL - &CUR_MAST->ORD_D_TTL ; + &CUR_MAST->ORD_M_TTL MFUEL_CHRG := (CUR_MAST)->FUEL_CHRG //** P3N - 09/22/06 HAPPY BDAY CINDY #47 SUB1 += MFUEL_CHRG //** P3N - 09/22/06 HAPPY BDAY CINDY #47 STX_AMT := (SUB1 * (&CUR_MAST->SLS_TX_PCT / 100)) STX_AMT := VAL( STR( STX_AMT, 8, 2 ) ) //** IF (CUR_MAST)->TERMS = '90' .OR. ; //NO CHARGE //** (CUR_MAST)->TERMS = '96' //CANCELLED IF ZERO_ORDER() //** NO CHARGE P3N-3/5/99 TOT_AMT := 0.00 //** TOTAL ORDER IS ZERO ELSE TOT_AMT := SUB1 + STX_AMT + NTX1 + NTX2 + NTX3 ENDIF ELSE IF !EMPTY(GETVARS) //7-30-97 NON-TAX MODIFICATIONS - Perry Nichols NOTX_AMT1 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_AMT1'}) NOTX_AMT2 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_AMT2'}) NOTX_AMT3 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_AMT3'}) NOTX_QTY1 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_QTY1'}) NOTX_QTY2 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_QTY2'}) NOTX_QTY3 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_QTY3'}) M_AMT1 := ASCAN(GETVARS, {|X| X[3] = 'MISC_AMT1'}) M_AMT2 := ASCAN(GETVARS, {|X| X[3] = 'MISC_AMT2'}) M_AMT3 := ASCAN(GETVARS, {|X| X[3] = 'MISC_AMT3'}) M_QTY1 := ASCAN(GETVARS, {|X| X[3] = 'MISC_QTY1'}) M_QTY2 := ASCAN(GETVARS, {|X| X[3] = 'MISC_QTY2'}) M_QTY3 := ASCAN(GETVARS, {|X| X[3] = 'MISC_QTY3'}) M_STAX := ASCAN(GETVARS, {|X| X[3] = 'SALES_TAX'}) M_OTTL := ASCAN(GETVARS, {|X| X[3] = 'TOTAL_AMT'}) //7-30-97 NO more FREIGHT - per Ellen ****M_FRT := ASCAN(GETVARS, {|X| X[3] = 'FREIGHT'}) // WRITE DISCOUNTS TO SCREEN LINE_TOTAL := (CUR_MAST)->ORD_L_TTL DISC_TOTAL := (CUR_MAST)->ORD_D_TTL * -1 MISC_TOTAL := (CUR_MAST)->ORD_M_TTL @ 02,53 SAY VAL(STR(LINE_TOTAL,10,2)) PICTURE '9999999.99' //*ORDER LINE ITEM TOTALS //**@ 02,52 SAY VAL(STR(LINE_TOTAL,10,2)) PICTURE '9999999.99' //*ORDER LINE ITEM TOTALS **@ 02,53 SAY VAL(STR(LINE_TOTAL,9,2)) PICTURE '999999.99' //*ORDER LINE ITEM TOTALS //**@ 03,53 SAY VAL(STR(DISC_TOTAL,9,2)) PICTURE '999999.99' //*DISC TAX AMT @ 03,54 SAY VAL(STR(DISC_TOTAL,9,2)) PICTURE '999999.99' //*DISC TAX AMT //**@ 04,53 SAY VAL(STR(MISC_TOTAL,9,2)) PICTURE '999999.99' //*MISC AMT @ 04,54 SAY VAL(STR(MISC_TOTAL,9,2)) PICTURE '999999.99' //*MISC AMT IF EMPTY(M_AMT1) //** GET OUT - DO NOT CONTINUE DUE TO NO SETCOLOR(SAVECOLOR) //** GETVARS ARR TO USE FOR UPDATE RETURN .T. ENDIF //* CALC SUB TOTAL OF MISC ITEMS // misc_amt1,2,3 M1 := (GETVARS[M_AMT1,4] * GETVARS[M_QTY1,4]) M2 := (GETVARS[M_AMT2,4] * GETVARS[M_QTY2,4]) M3 := (GETVARS[M_AMT3,4] * GETVARS[M_QTY3,4]) SUB1 := M1 + M2 + M3 ; + &CUR_MAST->ORD_L_TTL - &CUR_MAST->ORD_D_TTL ; + &CUR_MAST->ORD_M_TTL M_FSC := ASCAN(GETVARS, {|X| X[3] = 'FUEL_CHRG'}) //** P3N - 09/21/06 IF EMPTY(M_FSC) //** P3N - 09/21/06 MFUEL_CHRG := (CUR_MAST)->FUEL_CHRG //** P3N - 09/21/06 ELSE //** P3N - 09/21/06 MFUEL_CHRG := GETVARS[M_FSC,4] //** P3N - 09/21/06 ENDIF //** P3N - 09/21/06 //**@ 07,53 SAY STR(M1, 9, 2) @ 07,54 SAY STR(M1, 9, 2) //**@ 08,53 SAY STR(M2, 9, 2) @ 08,54 SAY STR(M2, 9, 2) //**@ 09,53 SAY STR(M3, 9, 2) @ 09,54 SAY STR(M3, 9, 2) IF M->OE_TYPE = 'ADD' //** P3N - 10/16/06 @ 12, 54 SAY MFUEL_CHRG PICTURE '999999.99' //** P3N - 10/16/06 ENDIF //** P3N - 10/16/06 @ 11,54 SAY VAL(STR(SUB1,9,2)) PICTURE '999999.99' //*SUBTOTAL //* CALC THE SALES TAX AMT STX_AMT := ( (SUB1+ MFUEL_CHRG) * (&CUR_MAST->SLS_TX_PCT / 100)) STX_AMT := VAL( STR( STX_AMT, 8, 2 ) ) PRNTVAR := STX_AMT // sales tax amt GETVARS[M_STAX,4] := STX_AMT // @ 12,53 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*SALES TAX AMT // @ 13,53 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*SALES TAX AMT @ 13,54 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*SALES TAX AMT //7-30-97 NON-TAX MODIFICATIONS - Perry Nichols //* DISPLAY THE NON - TAXABLE ITEMS - SCREEN 2115 NTX1 := (GETVARS[NOTX_AMT1,4] * GETVARS[NOTX_QTY1,4]) NTX2 := (GETVARS[NOTX_AMT2,4] * GETVARS[NOTX_QTY2,4]) NTX3 := (GETVARS[NOTX_AMT3,4] * GETVARS[NOTX_QTY3,4]) //**@ 15,53 SAY STR(NTX1, 9, 2) @ 16,54 SAY STR(NTX1, 9, 2) //**@ 16,53 SAY STR(NTX2, 9, 2) @ 17,54 SAY STR(NTX2, 9, 2) //**@ 17,53 SAY STR(NTX3, 9, 2) @ 18,54 SAY STR(NTX3, 9, 2) //* DISPLAY THE TOTAL ORDER AMT //** P3N - 4/3/98 //**IF (CUR_MAST)->TERMS = '90' .OR. ; //NO CHARGE //** (CUR_MAST)->TERMS = '96' //CANCELLED IF ZERO_ORDER() //** NO CHARGE P3N-3/5/99 TOT_AMT := 0.00 //** TOTAL ORDER IS ZERO ELSE TOT_AMT := SUB1 + MFUEL_CHRG + STX_AMT + NTX1 + NTX2 + NTX3 ENDIF GETVARS[M_OTTL,4] := TOT_AMT PRNTVAR := TOT_AMT //** P3N - 09/21/06 - ADDED FUEL SURCHARGE TO ORDER ENTRY IF EMPTY(MFUEL_CHRG) ELSE DISP_PCT := MFUEL_CHRG / SUB1 //** P3N - 09/22/06 HAPPY BDAY CINDY #47 ENDIF @ 12,65 SAY STR(DISP_PCT*100, 3,0) + '%' //** P3N - 09/22/06 HAPPY BDAY CINDY #47 @ 13,65 SAY STR((CUR_MAST)->SLS_TX_PCT, 8,4) + '%' //** P3N - 09/22/06 HAPPY BDAY CINDY #47 @ 21,52 SAY VAL(STR(PRNTVAR,10,2)) PICTURE '99999999.99' //*TOTAL ORDER AMT //**@ 20,52 SAY VAL(STR(PRNTVAR,10,2)) PICTURE '99999999.99' //*TOTAL ORDER AMT **@ 20,53 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*TOTAL ORDER AMT ENDIF ENDIF IF (CUR_MAST)->SALES_TAX <> VAL(STR(STX_AMT, 9,2)) .OR. ; (CUR_MAST)->TOTAL_AMT <> VAL(STR(TOT_AMT, 10,2)) IF _OC_CAPABLE (CUR_MAST)->(REC_LOCK(1)) REPLACE (CUR_MAST)->SALES_TAX WITH STX_AMT REPLACE (CUR_MAST)->TOTAL_AMT WITH TOT_AMT (CUR_MAST)->(DBUNLOCK()) ENDIF ENDIF SETCOLOR(SAVECOLOR) RETURN .T. ********************************************************* * THIS FUNCTION VALIDATES THE PRINT IND VALUE ********************************************************* FUNCTION PRTIND_VAL() LOCAL SV_SEL := SELECT(), RETVAL IF PRINT_IND$' ANDE' RETVAL := .T. ELSE ERR_BOX('VALID Values are the following:', ; '"A" - ALWAYS Print Option Value', ; '"N" - NEVER Print the Option Value', ; '"D" - PRINT Print if Option is DEFAULT ', ; '"E" - PRINT Print if Option is NOT Default-EXCEPTION') RETVAL := .F. ENDIF SELECT(SV_SEL) RETURN RETVAL ************************************************************** FUNCTION NOSORT() // called by acdcargo for lineitems ERR_BOX('*** SORT OPTION Not AVAILABLE ***', ; '*** In This Process ***', ; ' ') RETURN .T. ************************************************************** * NOTES EDIT FOR THE LINE ITEM ************************************************************** FUNCTION LINENOTE() // called by acdcargo for lineitems LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') LOCAL SAVESCRN := SAVESCREEN(), LI_NOTES := 3, SV_IND := PRT_NOTES LOCAL MTITLE := 'Line Item ' + ALLTRIM(STR(USERFILE2->LINE_NUM)) ; + ' (' + ALLTRIM(USERFILE2->PROD_CODE) + ')' IF _OC_CAPABLE NOTES('LINE_NOTES', NOTEREV_EDIT(), MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS REMOVE_XLNOTE(ORDER_NUM, LINE_NUM) //** P3N - 2/8/99 ****// 5-7-97 ************** **** Ask where to PRINT the line item NOTE? IF EMPTY(LINE_NOTES) REPLACE PRT_NOTES WITH 'U' //Print notes under the line item - DEFAULT ELSE IF PRT_NOTES = 'A' LI_NOTES := 1 ELSEIF PRT_NOTES = 'B' LI_NOTES := 2 ELSE LI_NOTES := 3 ENDIF LI_NOTES := PICKLIST({'ABOVE Line Item', 'BESIDE Line Item', 'UNDER Line Item'}, 5, 31, 'PRINT Notes', LI_NOTES) IF LI_NOTES = 1 REPLACE PRT_NOTES WITH 'A' //Print notes above the line item ELSEIF LI_NOTES = 2 REPLACE PRT_NOTES WITH 'B' //Print notes beside the line item ELSE // = 3 REPLACE PRT_NOTES WITH 'U' //Print notes under the line item - DEFAULT ENDIF IF LASTKEY() == 27 REPLACE PRT_NOTES WITH SV_IND // RETURN TO ORIGINAL VALUE IF ESCAPE ENDIF ENDIF ELSE NOTES('LINE_NOTES', NOTEREV_EDIT(),'Review '+MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS ENDIF RESTSCREEN(,,,,SAVESCRN) RETURN .T. ************************************************************** //** P3N - 2/08/99 * //** REMOVE THE XL NOTE * ************************************************************** FUNCTION REMOVE_XLNOTE(MORD_NUM, MLINE) LOCAL SEEKKEY := MORD_NUM + STR(MLINE, 3) LOCAL SVSEL := SELECT() LOCAL SVORD, SVREC LOCAL LINEFILE := 'ADDL_LINES' IF CUR_MAST = 'QUOTE_MAST' LINEFILE := 'QUOTE_ADDL' ENDIF SVREC := (LINEFILE)->(RECNO()) SVORD := (LINEFILE)->(INDEXORD()) SVREC := (LINEFILE)->(RECNO()) SELECT(LINEFILE) DONSETORD(3) //** ORDER_NUM + STR(LINE_NUM, 3) IF (LINEFILE)->(DBSEEK(SEEKKEY)) REC_LOCK(3, LINEFILE) (LINEFILE)->LINE_NOTES := ' ' (LINEFILE)->(DBUNLOCK()) ENDIF DONSETORD(SVORD) (LINEFILE)->(DBGOTO(SVREC)) SELECT(SVSEL) RETURN .T. ************************************************************** FUNCTION TAXNOTE() // called by acdcargo for lineitems LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') LOCAL SAVESCRN := SAVESCREEN() LOCAL MTITLE := 'Tax Table Notes ' + USERFILE2->STAXSCH IF _OC_CAPABLE NOTES('NOTES', NOTEREV_EDIT(), MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS ELSE NOTES('NOTES', NOTEREV_EDIT(),'Review '+MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS ENDIF RESTSCREEN(,,,,SAVESCRN) RETURN .T. ************************************************************** FUNCTION GET_PRICEARR(MPRICE_ARR, MPRICE_TYPE, PPR_CUSTID) // GET THE PRICE ARRAY FOR THIS MPRICE TYPE LOCAL ELEM, PR_CUSTID := PPR_CUSTID **ELEM = ASCAN(MPRICE_ARR, {|X| X[1] == MPRICE_TYPE .AND. X[6] == PR_CUSTID} ) ELEM = ASCAN(MPRICE_ARR, {|X| X[1] == MPRICE_TYPE} ) IF ELEM > 0 RETURN MPRICE_ARR[ELEM,2] ELSE RETURN {} ENDIF ************************************************************** * VALIDATE THE DECIMAL VALUES AT ORDER ENTRY TIME ************************************************************** FUNCTION VALID_DECIMAL(VAL2CHEK) LOCAL DECIMAL_VAL := VAL2CHEK - INT(VAL2CHEK) LOCAL NCHOICE LOCAL SV_COLOR := SETCOLOR(LNOR) LOCAL NTOP := 03, NLEFT := 50, NBOTTOM := 20, NRIGHT := 65 LOCAL DEC_ARR := {}, I, ELM, NEG_SW := .F. IF DECIMAL_VAL == 0 RETURN .T. ELSEIF DECIMAL_VAL < 0 DECIMAL_VAL := DECIMAL_VAL * -1 NEG_SW := .T. ENDIF ELM := ASCAN( FRACTION_ARR , {|X| X[2] == DECIMAL_VAL } ) IF ELM == 0 ERR_BOX( ' *** INVALID DECIMAL ENTERED ', ; ' *** Check the FRACTION VALUE ', ; ' *** Must be a Multiple of 1/' + ALLTRIM(STR(MBASE_NUM,2) ) ) RETURN .F. ELSE RETURN .T. ENDIF ************************************************************** FUNCTION CHK_ADDITIONAL(MPROD_CODE, MADDL_PROD, MOPTION, MRESPONSE) // CHECK THE ADDITIONAL PRODUCT LOCAL ELEM, SAVESEL := SELECT() LOCAL MSTD_OPTS := ' ', MSG1, RESULT, MSG2, MSG3 LOCAL SAVESCR := SAVESCREEN(), SAVEREC LOCAL SAVECOLOR := SETCOLOR() SELECT PRODUCT SAVEREC = RECNO() SEEK MADDL_PROD MDESC = DESC // PRODUCT DESCRIPTION MSG1 = 'Additional Product, ' + MDESC MSG2 = 'For Option, ' + TRIM(MOPTION) + ': ' + MRESPONSE MSG3 = 'Do You Want to use Standard Options' bTOP = 10 bBOTM = 16 bLEFT = 10 bRIGHT = 70 * SETCOLOR(DARK) @ bTOP+1,bLEFT+1 CLEAR TO bBOTM+1,bRIGHT+1 // DRAW SHADOW BOX SETCOLOR(HREV) @ bTOP,bLEFT CLEAR TO bBOTM,bRIGHT // DRAW BACKROUND COLOR @ bTOP,bLEFT TO bBOTM,bRIGHT // DRAW DOUBLE LINE IF EMPTY(MSTD_OPTS) MSTD_OPTS = 'Y' ENDIF @ BTOP+1, BLEFT+2 SAY MSG1 @ BTOP+2, BLEFT+2 SAY MSG2 @ BTOP+4, BLEFT+2 SAY MSG3 GET MSTD_OPTS PICTURE '!' VALID MSTD_OPTS$'YN' READ() GOTO SAVEREC SELECT(SAVESEL) RESTSCREEN(,,,,SAVESCR) SETCOLOR(SAVECOLOR) RETURN MSTD_OPTS ************************************************************** FUNCTION ADD_ADDITIONAL(MADDL_PROD, MSTD_OPTS, GET_ARR) // CHECK THE ADDITIONAL PRODUCT IN ADDL_LINE FILE LOCAL ELEM, SAVESEL := SELECT(), MLINE_NUM := USERFILE2->LINE_NUM LOCAL MPROD_CODE LOCAL CLR_ELM := ASCAN(GET_ARR, { |X| X[1] = 'FR COLOR'}) //** P3N - 10/17/06 LOCAL MCOLOR := GET_ARR[CLR_ELM,4] //** P3N - 10/17/06 MPROD_CODE = USERFILE2->PROD_CODE SELECT PRODUCT SAVEREC = RECNO() SEEK MADDL_PROD SELECT USERFILE6 LOCATE FOR PROD_CODE == MADDL_PROD .AND. LINE_NUM == MLINE_NUM IF !FOUND() ADD_ONEREC('USERFILE2', 'USERFILE6') ENDIF // IF EXTRA WINDOWS (TWIN, TRIPLE, QUAD, ETC) // INCREASE THE QUANTITY OF THE ADDITIONAL PRODUCT // BY THE NUMBER OF ADDITIONAL WINDOWS ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'XTRA WIND'}) IF ELEM > 0 REPLACE QUANTITY WITH USERFILE2->QUANTITY * ( VAL( GET_ARR[ELEM,4] ) + 1 ) ENDIF REPLACE ORDER_NUM WITH &CUR_MAST->ORDER_NUM REPLACE PROD_CODE WITH MADDL_PROD REPLACE PAR_PROD WITH MPROD_CODE REPLACE PAR_COLOR WITH DISPCOLOR(.F.) IF PAR_COLOR = 'N/A' //** P3N - 10/17/06 REPLACE PAR_COLOR WITH MCOLOR //** P3N - 10/17/06 ENDIF //** P3N - 10/17/06 REPLACE LINE_NUM WITH MLINE_NUM REPLACE STD_OPTS WITH MSTD_OPTS REPLACE ALT_SPRICE WITH 0 REPLACE UPDATED WITH ' ' REPLACE LINE_NOTES WITH ' ' //** P3N - 2/8/99 RETURN NIL ******************************************************* FUNCTION DO_ADDL_LINES // GO DO AN ACD UPDATE FOR THE ADDITIONAL PRODUCTS AND OPTION LOCAL TITLE, SAVESEL := SELECT() LOCAL MORDER_NUM := &CUR_MAST->ORDER_NUM SELECT USERFILE6 IF LASTREC() > 0 IF SELECT('USERFILE8') > 0 SELECT USERFILE8 USE ENDIF SELECT USERFILE9 COPY TO (USERFILE8) FOR GOOD_AO('USERFILE9') NET_USE('&USERFILE8', .T., 3, 'USERFILE8') SELECT (CUR_XO) DONSETORD(1) NDX_EXP = INDEXKEY() SELECT USERFILE8 INDEX ON &NDX_EXP TO &USERFILE8 IF __DBDRIVER = 'CDX' TAGNAME := 'T1' INDEX ON &NDX_EXP TAG &TAGNAME TO &USERFILE8 ELSE INDEX ON &NDX_EXP TO &USERFILE8 ENDIF IF _OC_CAPABLE .AND. GETAVAR('ACTION_CODE') = 'ADD' TITLE = 'Update Additional Line Items' ACD_PAR_CHILD(1, TITLE, {NIL, CUR_XL, .F., 3, 'ADD NOAPPEND',,,,,,.F. }) // don't close dbfs ELSE TITLE = 'Review Additional Line Items' ACD_PAR_CHILD(3, TITLE, {NIL, CUR_XL, .F., 3, 'REV',,,,,,.F. }) // don't close dbfs ENDIF ELSE IF SELECT('USERFILE8') > 0 SELECT USERFILE8 ZAP ENDIF ENDIF SELECT(SAVESEL) RETURN NIL ******************************************************** FUNCTION GOOD_AO(SELFILE) LOCAL SEEKKEY := (SELFILE)->ORDER_NUM + (SELFILE)->PROD_CODE + STR( (SELFILE)->LINE_NUM,3) //*IF ADDL_LINES->(DBSEEK(SEEKKEY)) IF (CUR_XL)->(DBSEEK(SEEKKEY)) RETURN .T. ELSE RETURN .F. ENDIF ******************************************************** FUNCTION GET_CM_VALU(FLD_NAM,FLD_VALU) LOCAL SAVESEL := SELECT(), EVALVAL IF EMPTY(&FLD_VALU) SELECT CUST_MAST &FLD_VALU := &FLD_NAM ENDIF SELECT (SAVESEL) RETURN .T. ******************************************************** FUNCTION CUST_CSZ(FLDLEN) RETURN PADR(ALLTRIM(CUST_CITY) + ' ' + ALLTRIM(CUST_STATE) + ' ' + CUST_ZIP, FLDLEN) ******************************************************** FUNCTION SHIP_CSZ(FLDLEN) RETURN PADR(ALLTRIM(SHIPADD2) + ' ' + ALLTRIM(SHIPST) + ' ' + SHIPZIP, FLDLEN) ******************************************************** FUNCTION ADDL_KEY() RETURN {&CUR_MAST->ORDER_NUM} ******************************************************** FUNCTION STUFF_ENTER_KEY() KEYBOARD CHR(13) RETURN ******************************************************** FUNCTION CK_DELSIZE(MWIDTH) IF MWIDTH >= 999 DELETE PACK IF RECCOUNT() = 0 ADD_REC(3) ELSE GOTO TOP ENDIF ENDIF RETURN .T. ********************************************************** * ********************************************************** FUNCTION CGWBASEPRICE(WHICHFILE, NCHOICE) LOCAL TABLE_ARR IF WHICHFILE = 'PRODUCT' SELECT PRODUCT //* - ONLY CALL LOAD UP FOR THIS PRODUCT RECORD TABLE_ARR := CGWPRICE(,,NCHOICE) CGWBP_LOAD(TABLE_ARR) // READ TABLE_ARR AND CREATE USERFILE7 RECS. RETURN ELSE SELECT PRODUCT DONSETORD(3) SEEK CATEGORY->CAT_CODE DO WHILE PRODUCT->CAT_CODE == CATEGORY->CAT_CODE .AND. !EOF() TABLE_ARR := CGWPRICE(,,NCHOICE) CGWBP_LOAD(TABLE_ARR) // ASSUMES SITTING ON CORRECT PRODUCT RECORD SELECT PRODUCT SKIP 1 ENDDO ENDIF RETURN ********************************************************** * LOAD THE USER FILE WITH THE BASE PRICE INFORMATION FOR PRINT/DISPL ********************************************************** FUNCTION CGWBP_LOAD(BP_ARR) // READ TABLE_ARR AND CREATE USERFILE7 RECS. LOCAL REP_VAR, AMT, DESC, II, I LOCAL FHEAD1, FHEAD2, FHEAD3 LOCAL HEAD1 := ' ' , HEAD2 := ' ' , HEAD3 := ' ' //PRICE_DBF, DLR_DBF, PRICE_SHT LOCAL PRT_ARR := BLDPRICE_ARR(BP_ARR[1], BP_ARR[2], BP_ARR[3]) LOCAL FRZ_ARR := PRT_ARR[1] // FIXED COL - IE: ROW HEADINGS/COL HEADINGS LOCAL DTL_ARR := PRT_ARR[2] // ROW DETAIL - COL HEADING/AMTS LOCAL DTL_LINE, TOTL_PRT := 0 LOCAL FRST_COL := 1 LOCAL COL_LIMIT := 7-1 // 7 TO LEN(FRZ_ARR) TO CONTROL THE NUMBER OF VARIABLE COLS LOCAL LAST_COL := COL_LIMIT DTL_LINE := ' ' DO WHILE .T. FOR II := 1 TO LEN(FRZ_ARR) DTL_LINE := FRZ_ARR[II] + SPACE(3) FOR I := FRST_COL TO MIN( LAST_COL, LEN(DTL_ARR) ) IF II <= LEN(DTL_ARR[I]) DTL_LINE := DTL_LINE + DTL_ARR[I, II] + SPACE(3) ENDIF NEXT ADD_U7(DTL_LINE) NEXT ADD_U7(' ') ADD_U7(' ') IF PAGE_BREAK = 'Y' ADD_U7(' ') // CATEGORY PAGE BREAK ???????????????????? ENDIF FRST_COL := FRST_COL + COL_LIMIT LAST_COL := LAST_COL + COL_LIMIT IF FRST_COL > LEN(DTL_ARR) EXIT ENDIF ENDDO RETURN ******************************************************** ******************************************************** ******************************************************** FUNCTION BLDPRICE_ARR(PRICE_DBF, DLR_FILE, PRICE_SHEET) LOCAL FLD_ARR := {}, HEAD1, FLD_TYPE LOCAL VAL_ARR := {} LOCAL WK_VAL LOCAL PR_ARR := {}, COL_VAL LOCAL LEFT_COL_ARR := {} LOCAL SV_SEL := SELECT(), I LOCAL FLD_NAME, PRICE_FACTOR, HEAD_TYP SELECT PRODUCT // UI SIZE IF PRICE_SHEET == 'L' PRICE_FACTOR := PRODUCT->LU_BASEFAC / 100 ELSEIF PRICE_SHEET == 'J' PRICE_FACTOR := PRODUCT->DI_BASEFAC / 100 ELSEIF PRICE_SHEET == 'B' PRICE_FACTOR := PRODUCT->BU_BASEFAC / 100 ELSEIF PRICE_SHEET == 'S' PRICE_FACTOR := PRODUCT->SD_BASEFAC / 100 ELSEIF PRICE_SHEET == 'I' PRICE_FACTOR := PRODUCT->IN_BASEFAC / 100 ELSE PRICE_FACTOR := 1 ENDIF IF PRICE_FACTOR = 0 PRICE_FACTOR := 1 ENDIF IF SELECT('PRICE_DBF') > 0 SELECT PRICE_DBF USE ENDIF IF PRICE_FACTOR > 0 .AND. PRICE_FACTOR < 1 IF !FILE(DLR_FILE + '.DBF') ERR_BOX('*** PRICE TABLE ' + DLR_FILE + '.DBF Was NOT FOUND!', ; '*** It must be SETUP under the OPEN MODEL BASE PRICES TABLES') RETURN { {} , {} } ENDIF NET_USE(DLR_FILE, .F., 5, 'PRICE_DBF') ELSE IF !FILE(PRICE_DBF + '.DBF') ERR_BOX('*** PRICE TABLE ' + PRICE_DBF + '.DBF Was NOT FOUND!', ; '*** It must be SETUP under the OPEN MODEL BASE PRICES TABLES') RETURN { {} , {} } ENDIF NET_USE(PRICE_DBF, .F., 5, 'PRICE_DBF') ENDIF // PRICE BREAK HEAD1 := 'Model - ' + ALLTRIM(PRODUCT->PROD_CODE) + ' / ' + ALLTRIM(PRODUCT->DESC) AADD(LEFT_COL_ARR, HEAD1) AADD(LEFT_COL_ARR, ' ') AADD(LEFT_COL_ARR, SPACE(15)) AADD(LEFT_COL_ARR, SPACE(15)) AADD(LEFT_COL_ARR, SPACE(15)) DO CASE CASE !EMPTY(PRODUCT->COL_HEAD3) LEFT_COL_ARR[5] := PRODUCT->COL_HEAD3 LEFT_COL_ARR[4] := PRODUCT->COL_HEAD2 LEFT_COL_ARR[3] := PRODUCT->COL_HEAD1 CASE !EMPTY(PRODUCT->COL_HEAD2) LEFT_COL_ARR[5] := PRODUCT->COL_HEAD2 LEFT_COL_ARR[4] := PRODUCT->COL_HEAD1 OTHERWISE LEFT_COL_ARR[5] := PRODUCT->COL_HEAD1 ENDCASE AADD(LEFT_COL_ARR, REPLICATE('-',15) ) FLD_ARR := DBSTRUCT() FOR I := 1 TO LEN(FLD_ARR) IF FLD_ARR[I,1] = 'COL_HEAD' .OR. FLD_ARR[I,1] = 'DESC' ; .OR. FLD_ARR[I,1] = 'CUST_ID' .OR. FLD_ARR[I,1] = 'UPDATED' LOOP ELSE *** COL_VAL := PADR( FLD_ARR[I,1] , 15 ) COL_VAL := COLVAL( FLD_ARR[I,1] , 'TEXT', 15 ) AADD( LEFT_COL_ARR, COL_VAL ) ENDIF NEXT DO WHILE !EOF() WK_ARR := {} AADD (WK_ARR, SPACE(15)) AADD (WK_ARR, SPACE(15)) AADD (WK_ARR, SPACE(15)) AADD (WK_ARR, SPACE(15)) AADD (WK_ARR, SPACE(15)) DO CASE CASE !EMPTY(COL_HEAD3) WK_ARR[5] := PADL(TRIM(COL_HEAD3),15) WK_ARR[4] := PADL(TRIM(COL_HEAD2),15) WK_ARR[3] := PADL(TRIM(COL_HEAD1),15) CASE !EMPTY(COL_HEAD2) WK_ARR[5] := PADL(TRIM(COL_HEAD2),15) WK_ARR[4] := PADL(TRIM(COL_HEAD1),15) OTHERWISE WK_ARR[5] := PADL(TRIM(COL_HEAD1),15) ENDCASE AADD (WK_ARR, REPLICATE('-',15) ) FOR I := 1 TO LEN(FLD_ARR) FLD_NAME := FLD_ARR[I,1] FLD_TYPE := FLD_ARR[I,2] IF FLD_NAME = 'DESC' .OR. FLD_NAME = 'COL_HEAD' ; // DESCRIPTION IN COL HEAD 1/2/3 .OR. FLD_NAME = 'CUST_ID' .OR. FLD_NAME = 'UPDATED' LOOP ELSE IF FLD_TYPE == 'N' // ROUND TO NEAREST NICHOLS AADD(WK_ARR, STR(ROUND_IT(&FLD_NAME * PRICE_FACTOR, .05) ,15,2)) ENDIF ENDIF NEXT AADD (PR_ARR, WK_ARR ) SKIP 1 ENDDO SELECT PRICE_DBF USE SELECT(SV_SEL) RETURN { LEFT_COL_ARR, PR_ARR } ********************************************************** FUNCTION COLVAL(WORKVAL, TYPE, LEN) LOCAL I, CKCHAR IF TYPE = NIL TYPE = 'TEXT' ENDIF // system generated "V9" VARIABLE IF LEFT(WORKVAL,1)$'V' .AND. SUBS(WORKVAL,2,1)$'0123456789' RETURN FORM_WORKVAL(SUBS(WORKVAL,2 ), TYPE, LEN) ELSE RETURN FORM_WORKVAL(WORKVAL, TYPE, LEN) ENDIF ********************************************************** FUNCTION FORM_WORKVAL(WORKVAL, TYPE, LEN) LOCAL WK_LEN IF LEN = NIL WK_LEN := 18 ELSE WK_LEN := LEN ENDIF WORKVAL := STRTRAN(WORKVAL, '_', ' ') IF TYPE = 'TEXT' RETURN PADR(WORKVAL, WK_LEN) ELSE RETURN PADL(WORKVAL, WK_LEN) ENDIF **************************************************************** * //** P3N - 12/10/98 * DO WE PRINT LINE ITEM DISCOUNTS **************************************************************** FUNCTION PRT_ITMDISC(PRN_ARR, PRODCODE) LOCAL RETVAL := .F., I, DISC_AMT := 0, DISC_PCT := 0 LOCAL STRT := ASCAN( PRN_ARR, { |X| X[10] == PRODCODE } ) FOR I := STRT TO LEN(PRN_ARR) IF PRODCODE = PRN_ARR[I,10] IF EMPTY(DISC_PCT) DISC_PCT := PRN_ARR[I, 5, 1] // LINE ITEM DISCOUNT PCT DISC_AMT := PRN_ARR[I, 5, 2] // LINE ITEM DISCOUNT AMT ENDIF IF DISC_PCT == PRN_ARR[I, 5, 1] // LINE ITEM DISCOUNT PCT ELSE RETVAL := .T. ENDIF ELSE EXIT ENDIF NEXT RETURN RETVAL **************************************************************** * P3N -11/24/98 * GET THE ORDER MASTER (CGW0OM) MISC ITEMS (SCREEN 2115) * ORDER QTYS FOR INVOICING PURPOSES **************************************************************** FUNCTION GETQTYMISC(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) LOCAL MTOT := 0, QTY := 0, AMT := 0, MAMTS := {}, INVQTY := 0 LOCAL SHPQTY := 0, BKO_QTY := 0, MISCKEY, SVPROD, SVLINE, MAMTS_ARR := {} LOCAL SVREC := 1, QTYARR := {}, SVSEL := SELECT() IF SELECT('TORD_LINES') > 0 SVREC := TORD_LINES->(RECNO()) TORD_LINES->(DBGOTOP()) IF MORDER_NUM == TORD_LINES->ORDER_NUM ELSE CLOSE TORD_LINES BLD_TORD_LINES(MORDER_NUM) ENDIF ELSE BLD_TORD_LINES(MORDER_NUM) ENDIF TORD_LINES->(DBGOTOP()) SVPROD := TORD_LINES->PROD_CODE SVLINE := TORD_LINES->LINE_NUM DO WHILE TORD_LINES->(!EOF()) IF TORD_LINES->PROD_CODE = 'ORD' IF TORD_LINES->LINE_NUM == SVLINE .AND. ; TORD_LINES->PROD_CODE == SVPROD ELSE IF EMPTY(MAMTS) ELSE AADD(MAMTS_ARR, MAMTS ) MAMTS := {} ENDIF SVPROD := TORD_LINES->PROD_CODE SVLINE := TORD_LINES->LINE_NUM ENDIF MISCKEY := TORD_LINES->ORDER_NUM MISCKEY := MISCKEY + STR(TORD_LINES->LINE_NUM, 3) MISCKEY := MISCKEY + TORD_LINES->PROD_CODE QTYARR := GET_OSTQTY('TORD_LINES', MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE ) IF EMPTY(QTYARR) //** P3N - 12/3/98 SHPQTY := 0 //** P3N - 12/3/98 INVQTY := 0 //** P3N - 12/3/98 ELSE //** P3N - 12/3/98 SHPQTY := QTYARR[1] //** P3N - 12/3/98 INVQTY := QTYARR[2] //** P3N - 12/3/98 ENDIF //** P3N - 12/3/98 BKO_QTY := TORD_LINES->QUANTITY - SHPQTY MTOT := MTOT + ( TORD_LINES->QUANTITY * TORD_LINES->SALE_PRICE ) MAMTS := { TORD_LINES->QUANTITY, BKO_QTY, SHPQTY, TORD_LINES->SALE_PRICE, ; TORD_LINES->PROD_CODE+STR(TORD_LINES->LINE_NUM,1), INVQTY } ENDIF TORD_LINES->(DBSKIP(+1)) ENDDO IF EMPTY(MAMTS) ELSE AADD(MAMTS_ARR, MAMTS ) ENDIF TORD_LINES->(DBGOTO(SVREC)) SELECT(SVSEL) RETURN { MAMTS_ARR } **************************************************************** * P3N - 7/29/98 * BLD THE ORDER MASTER (CGW0OM) MISC ITEMS (SCREEN 2115) * FOR BACK ORDER PRINTING PURPOSES **************************************************************** FUNCTION BLD_ORDMISC( PBODY_ARR, PAMTS_ARR, LI_TOTALS, PRT_AMT, PRT_BO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE ) LOCAL MTOT := 0, QTY := 0, AMT := 0, PAMTS := {}, INVQTY := 0, QTYARR := {} LOCAL SHPQTY := 0 , BKO_QTY := 0, MISCKEY, SVPROD, ORD_QTY := 0 LOCAL SVREC := TORD_LINES->(RECNO()) //DEFAULT PARTIAL_INVOICE := .F. //DEFAULT REPRINT_INVOICE := .F. If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) IF EMPTY(PARTIAL_INVOICE) PARTIAL_INVOICE := .F. ENDIF IF REPRINT_INVOICE = NIL //IF EMPTY( REPRINT_INVOICE ) REPRINT_INVOICE := .F. ELSE ENDIF TORD_LINES->(DBGOTOP()) SVPROD := TORD_LINES->PROD_CODE DO WHILE TORD_LINES->(!EOF()) IF TORD_LINES->PROD_CODE = 'ORD' IF TORD_LINES->PROD_CODE == SVPROD ELSE // double space ORDER misc items for now. IF EMPTY(PBODY_ARR) //** P3N 1/6/99 ELSE AADD(PBODY_ARR, ' ' ) AADD(PAMTS_ARR, NIL ) // nil pamts_arr will line up in body ENDIF SVPROD := TORD_LINES->PROD_CODE ENDIF MISCKEY := TORD_LINES->ORDER_NUM MISCKEY := MISCKEY + STR(TORD_LINES->LINE_NUM, 3) MISCKEY := MISCKEY + TORD_LINES->PROD_CODE QTYARR := GET_OSTQTY('TORD_LINES', MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE) IF EMPTY(QTYARR) //** P3N - 12/3/98 SHPQTY := 0 //** P3N - 12/3/98 INVQTY := 0 //** P3N - 12/3/98 ELSE //** P3N - 12/3/98 SHPQTY := QTYARR[1] //** P3N - 12/3/98 INVQTY := QTYARR[2] //** P3N - 12/3/98 ENDIF //** P3N - 12/3/98 BKO_QTY := TORD_LINES->QUANTITY - SHPQTY ORD_QTY := TORD_LINES->QUANTITY MTOT := MTOT + ( TORD_LINES->QUANTITY * TORD_LINES->SALE_PRICE ) IF WHCHORDER == 'BACKORD' PAMTS := { 0, 0 , BKO_QTY, TORD_LINES->SALE_PRICE, PRT_AMT, PRT_BO, 0, , INVQTY } ELSE PAMTS := { ORD_QTY, BKO_QTY , SHPQTY , TORD_LINES->SALE_PRICE, PRT_AMT, PRT_BO, 0, , INVQTY } ENDIF IF EMPTY(BKO_QTY) ELSE AADD(PBODY_ARR, '^' + SUBS(TORD_LINES->LINE_DESC, 1, 30) ) AADD(PAMTS_ARR, PAMTS ) ENDIF ENDIF TORD_LINES->(DBSKIP(+1)) ENDDO LI_TOTALS := LI_TOTALS + MTOT TORD_LINES->(DBGOTO(SVREC)) RETURN { PBODY_ARR, PAMTS_ARR, LI_TOTALS } **************************************************************** * P3N - 7/7/98 * BLD THE MISC ORDER LINE ITEMS FOR PRINTING PURPOSES **************************************************************** FUNCTION BLD_MISCORD(CUR_MISC, PBODY_ARR, PAMTS_ARR, LI_TOTALS, PRT_AMT, ; DIDFST, PRT_BO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE, ORDSHIPD, SUBTYPE) LOCAL M1 := 0, M_UOM := '', M_QTY_UOM := '', WORKVAR := '', WORKPRICE := 0 LOCAL MISCITMS := CUR_MISC, WRKQTY := 0, QTYARR := {}, PAMTS, WRK1, TOTBKO := 0 LOCAL BKO_QTY := 0, MISCKEY, SHPQTY := 0, INVQTY := 0, SVSEL := SELECT() IF EMPTY(ORDSHIPD) //** P3N - 1/7/99 ORDSHIPD := .F. ENDIF //DEFAULT PARTIAL_INVOICE := .F. //DEFAULT REPRINT_INVOICE := .F. If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) IF REPRINT_INVOICE = NIL // 1/20/20 //IF EMPTY(REPRINT_INVOICE) //** P3N - 12/3/98 REPRINT_INVOICE := .F. ENDIF IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/24/98 PARTIAL_INVOICE := .F. ENDIF IF MISCITMS == 'TORD_LINES' IF SELECT('TORD_LINES') > 0 //** TORD_LINES ALREADY EXISTS IF (MISCITMS)->ORDER_NUM == (CUR_MAST)->ORDER_NUM //** TORD_LINES ALREADY EXISTS WITH THE SAME ORDER - PROCESS ELSE CLOSE TORD_LINES BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) ENDIF ELSE BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) ENDIF (MISCITMS)->(DBGOTOP()) ELSE (MISCITMS)->(DBSEEK((CUR_MAST)->ORDER_NUM)) ENDIF DO WHILE (MISCITMS)->ORDER_NUM == (CUR_MAST)->ORDER_NUM .AND. (MISCITMS)->(!EOF()) //** IF WHCHORDER == 'BACKORD' //** P3N - 1/14/99 IF WHCHORDER == 'BACKORD' .OR. ORDSHIPD //** P3N - 1/14/99 IF (MISCITMS)->PROD_CODE == 'MISCITM' //** PROCESS ONLY MISC ITEMS ELSE (MISCITMS)->(DBSKIP(+1)) LOOP ENDIF ENDIF MISCKEY := (MISCITMS)->ORDER_NUM IF VALTYPE((MISCITMS)->LINE_NUM)== 'N' MISCKEY := MISCKEY + STR((MISCITMS)->LINE_NUM, 3) ELSE MISCKEY := MISCKEY + (MISCITMS)->LINE_NUM ENDIF MISCKEY := MISCKEY + 'MISCITM' QTYARR := GET_OSTQTY(CUR_OL, MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE ) IF EMPTY(QTYARR) //** P3N - 12/3/98 SHPQTY := 0 //** P3N - 12/3/98 INVQTY := 0 //** P3N - 12/3/98 ELSE //** P3N - 12/3/98 SHPQTY := QTYARR[1] //** P3N - 12/3/98 INVQTY := QTYARR[2] //** P3N - 12/3/98 ENDIF //** P3N - 12/3/98 BKO_QTY := (MISCITMS)->QUANTITY - SHPQTY TOTBKO := TOTBKO + BKO_QTY //** P3N - 1/14/99 IF WHCHORDER == 'BACKORD' .AND. EMPTY(BKO_QTY) (MISCITMS)->(DBSKIP(+1)) //** DO NOT INCLUDE 0 QTY'S ON BACKORDERS LOOP ENDIF MISC_ITEMS->(DBSEEK ( (MISCITMS)->PARTNUM )) IF (MISCITMS)->UOM = 'N/A' M_UOM := '' ELSE UOMFILE->(DBSEEK ( (MISCITMS)->UOM )) IF UOMFILE->PRINT_FLAG$'N' M_UOM := '' ELSE M_UOM := (MISCITMS)->UOM ENDIF M_QTY_UOM := UOMFILE->PRINT_QTY ENDIF WORKVAR := '^' //** P3N - 12/16/98 IF (MISCITMS)->COLOR <> 'N/A' WORKVAR := WORKVAR + ALLTRIM( (MISCITMS)->COLOR ) + ' ' ENDIF WORKVAR:= WORKVAR + ALLTRIM( MISC_ITEMS->DESC ) + ' ' //** P3N - 1/7/99 IS THIS CHECKING FOR ORDER ENTIRELY SHIPPED ?? IF ORDSHIPD .AND. EMPTY(SHPQTY) //** DO NOT ADD PRICES BECAUSE WE ARE ONLY BUILDING THIS ARRAY //** TO DETERMINE IF THE ENTIRE ORDER HAS BEEN SHIPPED!!! //** NOT TO PRINT ON ANY DOCUMENT ELSE //** P3N - 2/20/98 PER ELLEN-KC IF EMPTY( (MISCITMS)->ALT_SPRICE) WORKPRICE := (MISCITMS)->SALE_PRICE ELSE WORKPRICE := (MISCITMS)->ALT_SPRICE ENDIF ENDIF IF M_QTY_UOM $'N' WRK1 := { (MISCITMS)->QUANTITY, (MISCITMS)->ENTRY_SIZE } IF WHCHORDER == 'BACKORD' WRK1 := { 0 , (MISCITMS)->ENTRY_SIZE } PAMTS := {WRK1, 0 ,BKO_QTY, WORKPRICE, PRT_AMT,PRT_BO ,0, M_UOM, INVQTY } ELSE PAMTS := { WRK1 ,BKO_QTY, SHPQTY, WORKPRICE, PRT_AMT,PRT_BO ,0, M_UOM, INVQTY } ENDIF ELSEIF WHCHORDER == 'BACKORD' PAMTS := { 0, 0, BKO_QTY, WORKPRICE , PRT_AMT, PRT_BO, 0, M_UOM , INVQTY } ELSE PAMTS := { (MISCITMS)->QUANTITY, BKO_QTY,SHPQTY, WORKPRICE, PRT_AMT, PRT_BO, 0, M_UOM , INVQTY } ENDIF IF PARTIAL_INVOICE //** P3N - 11/25/98 LI_TOTALS := LI_TOTALS + ( SHPQTY * WORKPRICE ) ELSEIF REPRINT_INVOICE //** P3N - 12/4/98 LI_TOTALS := LI_TOTALS + ( INVQTY * WORKPRICE ) ELSE //** P3N - 11/25/98 LI_TOTALS := LI_TOTALS + ( (MISCITMS)->QUANTITY * WORKPRICE ) ENDIF //** P3N - 11/25/98 // start order below last detail printed IF !DIDFST IF !EMPTY(PBODY_ARR) // SEPERATE FROM DATA ABOVE IF WHCHORDER == 'BACKORD' AADD(PBODY_ARR, ' -----' ) ELSE AADD(PBODY_ARR, '-------------' ) ENDIF AADD(PAMTS_ARR, {}) // empty array will left justify AADD(PBODY_ARR, ' ' ) AADD(PAMTS_ARR, NIL ) // nil pamts_arr will line up in body ENDIF DIDFST := .T. ENDIF AADD(PBODY_ARR, WORKVAR ) AADD(PAMTS_ARR, PAMTS ) IF !EMPTY( (MISCITMS)->ENTRY_SIZE ) IF M_QTY_UOM $'N' // Print size IN THE QTY AREA ELSE // Print size below desc AADD(PBODY_ARR, 'Size: ' + ALLTRIM((MISCITMS)->ENTRY_SIZE ) + ' ' + ALLTRIM( M_UOM ) ) AADD(PAMTS_ARR, NIL ) ENDIF ENDIF //** P3N - 04/30/03 - MOVED FROM ABOVE - WAS ONLY PRINTING IF !EMPTY(ENTRY_SIZE) PER LINDA LINDS //** P3N - 11/18/02 - ADDED THE KEYWORD FOR PRINTING - PER LINDA LINDS IF EMPTY(SUBTYPE) //** P3N - 11/18/02 //** DO NOT PRINT KEYWORDS ON EMPTY SUBTYPES ELSEIF SUBTYPE = 'DELIVERY' .OR. ; //** DELIVERY COPY SUBTYPE = 'GOLDEN' .OR. ; //** GOLDEN ROD COPY SUBTYPE = 'PREBILL' //** PREBILL COPY AADD(PBODY_ARR, MISC_ITEMS->KEYWORD ) //** P3N - 11/18/02 AADD(PAMTS_ARR, NIL ) //** P3N - 11/18/02 ENDIF //** P3N - 11/18/02 // double space the cur_misc items for now. AADD(PBODY_ARR, ' ' ) AADD(PAMTS_ARR, NIL ) // nil pamts_arr will line up in body (MISCITMS)->(DBSKIP(+1)) ENDDO RETURN { PBODY_ARR, PAMTS_ARR, LI_TOTALS, TOTBKO } **************************************************************** * DO WE WANT TO PRINT A PRODUCTION FRAME COPY OR * A PRODUCTION STD FRAME COPY ? * 'STD' - STORM DOOR **************************************************************** FUNCTION PRT_FRAME(WHICH_TYPE, PROD) LOCAL RETVAL := .F. DO CASE CASE WHICH_TYPE = 'FRAME' IF PROD_STD(PROD) RETVAL := .F. ELSE RETVAL := .T. ENDIF CASE WHICH_TYPE = 'STDFRAME' IF PROD_STD(PROD) // STORM DOOR FRAME COPY RETVAL := .T. ENDIF ENDCASE RETURN RETVAL **************************************************************** * IS THIS PRODUCT A 'STD' * 'STD' - STORM DOOR **************************************************************** FUNCTION PROD_STD(PROD) LOCAL RETVAL := .F. IF PRODUCT->(DBSEEK(PROD)) IF PRODUCT->CAT_CODE = 'STD' RETVAL := .T. ENDIF ENDIF RETURN RETVAL **************************************************************** * SHOULD WE PRINT A DISCOUNT TOTAL **************************************************************** FUNCTION PRINT_DISC(PRN_ARR, PRODCODE) //PRINT A DISCOUNT% LOCAL STRT := ASCAN(PRN_ARR, {|X| X[10] == PRODCODE}), I, RETVAL := .F. IF EMPTY(STRT) RETVAL := .F. ELSE FOR I := STRT TO LEN(PRN_ARR) IF PRN_ARR[I,10] == PRODCODE IF EMPTY(PRN_ARR[I,5,1]) RETVAL := .F. ELSE RETVAL := .T. EXIT ENDIF ENDIF NEXT ENDIF RETURN RETVAL **************************************************************** * GET THE PRODUCT DISCOUNT TOTAL ( IE: ALL LINE ITEMS FOR A PRODUCT) **************************************************************** FUNCTION GETDISCTOT(PRN_ARR, STRT) LOCAL PRODCODE := PRN_ARR[STRT, 10], ELM, DISC_PCT, I, RETARR := {} //**LOCAL DISC_AMT := 0,ITMDISC := PRT_ITMDISC(PRN_ARR, PRODCODE) LOCAL DISC_AMT := 0,ITMDISC := .F. FOR I := STRT TO 1 STEP -1 IF PRODCODE = PRN_ARR[I,10] DISC_AMT := PRN_ARR[I, 5, 2] // LINE ITEM DISCOUNT AMT DISC_PCT := PRN_ARR[I, 5, 1] // LINE ITEM DISCOUNT PCT DISC_SIZE := PRN_ARR[I, 5, 3] // LINE ITEM ENTRY SIZE IF EMPTY(DISC_AMT) ELSE IF EMPTY(RETARR) AADD(RETARR, {PRODCODE, DISC_PCT, DISC_AMT, DISC_SIZE}) ELSE ELM := ASCAN(RETARR, {|X| X[1] == PRODCODE .AND. X[2] == DISC_PCT}) IF EMPTY(ELM) AADD(RETARR, {PRODCODE, DISC_PCT, DISC_AMT, DISC_SIZE}) ELSEIF ITMDISC AADD(RETARR, {PRODCODE, DISC_PCT, DISC_AMT, DISC_SIZE}) ELSE RETARR[ELM,3] := RETARR[ELM,3] + DISC_AMT ENDIF ENDIF ENDIF ENDIF NEXT RETURN RETARR ***************************************************************** //** P3N - 3/5/99 - NEW FUNCTION TO IDENTIFY ZERO ORDERS //** IN ONE PLACE. ( NO PRICING ) //** P3N- 3/5/99 ADDED '93' TO THE NO PRICING TERMS LIST. ***************************************************************** FUNCTION ZERO_ORDER() LOCAL RETVAL := .F. IF (CUR_MAST)->TERMS = '90' .OR. ; //** NO CHARGE //**P3N - 6/16/98 (CUR_MAST)->TERMS = '91' .OR. ; //** EVEN EXCHANGE//**P3N - 3/10/99 (CUR_MAST)->TERMS = '93' .OR. ; //** MEMO BILLING //**P3N - 3/05/99 (CUR_MAST)->TERMS = '96' //** CANCELLATION //**P3N - 6/16/98 RETVAL := .T. ENDIF RETURN RETVAL ***************************************************************** //** P3N - 2/1/00 - NEW FUNCTION TO PAINT THE KEY VALUES AS NEEDED //** IN A PREPROC SITUATION ***************************************************************** FUNCTION PAINT_KEYS(KEYFLD,DISPROW, DISPCOL) LOCAL SVCOLOR := SETCOLOR(HNOR) MGET_KEY := &KEYFLD IF EMPTY(DISPROW) DISPROW := 3 ENDIF IF EMPTY(DISPCOL) DISPCOL := 40 ENDIF @ DISPROW, 0 CLEAR @ DISPROW, DISPCOL SAY MGET_KEY SETCOLOR(SVCOLOR) RETURN .T. ********************************************************* // VALIDATE A PRODUCT CODE FUNCTION VAL_PRODUCT(PASSKEY, ELEM, DISPNAME, DOPACK) LOCAL SAVESCR := SAVESCREEN() LOCAL SAVESEL := SELECT() LOCAL SAVEREC := RECNO() LOCAL RETVAL := .F., A_ELEM LOCAL SAVECOL := SETCOLOR() LOCAL SAYMSG := "PRODUCT->DESC" LOCAL SAVEGETLIST := SAVEGETS() LOCAL SEEKKEY IF PASSKEY = NIL SEEKKEY := PROD_CODE ELEM := NIL DISPNAME := .F. ELSE SEEKKEY := &PASSKEY ENDIF IF DISPNAME = NIL DISPNAME := .T. ENDIF IF DOPACK = NIL DOPACK := .T. ENDIF SETCOLOR(SAVECOL) IF EMPTY(SEEKKEY) .AND. DOPACK DELETE PACK RETURN .T. ENDIF IF EMPTY(SEEKKEY) .OR. GOOD_PROD(SEEKKEY) IF DISPNAME A_ELEM := DISP_GETVAR(ELEM, SAYMSG) ENDIF RETURN .T. ENDIF GBROWSE(3,'Product Lookup', 'PRODUCT') SELECT (SAVESEL) GOTO SAVEREC SETCOLOR(SAVECOL) RESTSCREEN(,,,,SAVESCR) IF LASTKEY() = 13 DO CASE CASE ELEM = NIL // DBROWSE TYPE PROC ***** REPLACE USERFILE2->CLUBID WITH CLUB_MAST->CLUBID REPLACE (SAVESEL)->PROD_CODE WITH PRODUCT->PROD_CODE REPLACE UPDATED WITH 'Y' CASE VALTYPE(ELEM)$'A' // EXECUTE SOMETHING NILVAR := &ELEM[1] CASE DISPNAME // GET_ONE_REC TYPE PROC A_ELEM := DISP_GETVAR(ELEM, SAYMSG) GETVARS[A_ELEM,4] := CLUB_MAST->CLUBID ENDCASE RETVAL := .T. ELSE RETVAL := .F. ENDIF SETCOLOR(SAVECOL) RETURN RETVAL **************************************************************** * VALIDATE THE INPUT FIELD TO CONTAIN A VALID SET OF CHARACTARS* **************************************************************** FUNCTION VALID_CHR(PARM) LOCAL I, RETVAL, FLD := &PARM FOR I := 1 TO LEN(FLD) IF SUBS(FLD,I,1)$'ABCDEFGHIJKLMNOPQRSTUVWXYZ 1234567890_' RETVAL := .T. ELSE ERR_BOX('** Invalid Option Value **', ; '** Remove the - ' + ALLTRIM(SUBS(FLD,I,1)) ) RETVAL := .F. EXIT ENDIF NEXT RETURN RETVAL **************************************************************** FUNCTION GOOD_PROD(SEEKKEY) LOCAL SAVESEL := SELECT(), RECNUM := RECNO(), RETVAL IF PRODUCT->(DBSEEK(SEEKKEY)) RETVAL := .T. ELSE RETVAL := .F. ENDIF SELECT (SAVESEL) GOTO RECNUM RETURN RETVAL ******************************************************************* //** P3N - 1/15/99 //** THIS FUNCTION WILL BUILD USERFILE2 WITH ORD_SHIP TRANS. //** THIS IS A PREPROC 'I' FOR SCREEN 21350 - SELECTIVE SHIPPING //** (F7-ORDER CONTROL / SHIPPING INFORMATION - SCREEN 3220) ******************************************************************* FUNCTION BLD_TMP_OST() LOCAL ORDNUM := TORD_LINES->ORDER_NUM LOCAL LINENUM := TORD_LINES->LINE_NUM LOCAL PROD := TORD_LINES->PROD_CODE LOCAL PARPROD := TORD_LINES->PAR_PROD LOCAL TRANNUM := TORD_LINES->(STR(RECNO(), 3) ) LOCAL SVSEL := SELECT() SELECT USERFILE2 ZAP IF ORD_SHIP->(DBSEEK(ORDNUM+STR(LINENUM,3)+ PROD +PARPROD+TRANNUM)) DO WHILE ORD_SHIP->(!EOF()) .AND. ; ORD_SHIP->ORDER_NUM == ORDNUM .AND. ; ORD_SHIP->LINE_NUM == LINENUM .AND. ; ORD_SHIP->PROD_CODE == PROD .AND. ; ORD_SHIP->PAR_PROD == PARPROD .AND. ; ORD_SHIP->TRAN_NUM == TRANNUM SELECT USERFILE2 ADD_REC(1) REC_LOCK(1, 'USERFILE2') REP_ONEREC('ORD_SHIP', 'USERFILE2' ) ORD_SHIP->(DBSKIP(+1)) ENDDO ENDIF SELECT(SVSEL) RETURN .T. ******************************************************************* //** P3N - 1/15/02 //** THIS FUNCTION WILL BUILD USERFILE2 WITH ORD_PROD TRANS. //** THIS IS A PREPROC 'I' FOR SCREEN 22350 - SELECTIVE PRODUCTION //** (F7-PRODUCTION CONTROL / PRODUCTION INFORMATION - SCREEN ????) ******************************************************************* FUNCTION BLD_TMPOPT() LOCAL ORDNUM := TORD_LINES->ORDER_NUM LOCAL LINENUM := TORD_LINES->LINE_NUM LOCAL PROD := TORD_LINES->PROD_CODE LOCAL PARPROD := TORD_LINES->PAR_PROD LOCAL TRANNUM := TORD_LINES->(STR(RECNO(), 3) ) LOCAL SVSEL := SELECT() SELECT USERFILE2 //**ZAP USERFILE2->(__DBZAP()) IF ORD_PROD->(DBSEEK(ORDNUM+STR(LINENUM,3)+ PROD +PARPROD+TRANNUM)) DO WHILE ORD_PROD->(!EOF()) .AND. ; ORD_PROD->ORDER_NUM == ORDNUM .AND. ; ORD_PROD->LINE_NUM == LINENUM .AND. ; ORD_PROD->PROD_CODE == PROD .AND. ; ORD_PROD->PAR_PROD == PARPROD .AND. ; ORD_PROD->TRAN_NUM == TRANNUM SELECT USERFILE2 ADD_REC(1) REC_LOCK(1, 'USERFILE2') REP_ONEREC('ORD_PROD', 'USERFILE2' ) ORD_PROD->(DBSKIP(+1)) ENDDO ENDIF SELECT(SVSEL) RETURN .T. //******************************************************************* //** P3N - 08/08/11 //** Allow ONLY the AMOUNT OR PCT for Freight calc //******************************************************************* FUNCTION VAL_FRT(FLD) LOCAL G_ACT_LIST := GETACTIVE() LOCAL RETVAL := .T. STATIC SVAMT, SVPCT IF EMPTY(FLD) FLD := '' ENDIF IF FLD = 'FRT_AMT' IF EMPTY(G_ACT_LIST) //** NO GET OBJ - CONTINUE ELSE SVAMT := G_ACT_LIST:BUFFER ENDIF ELSE IF EMPTY(G_ACT_LIST) //** NO GET OBJ - CONTINUE ELSE SVPCT := G_ACT_LIST:BUFFER IF VAL(SVAMT) <> 0 .AND. VAL(SVPCT) <> 0 ERR_BOX( ' Freight Amount = '+ SVAMT , ; ' Freight PCT = ' + SVPCT , ; ' ', ; ' Please - enter ONLY Amount OR PCT - NOT BOTH!') RETVAL := .F. ENDIF ENDIF ENDIF RETURN RETVAL