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

8149 lines
239 KiB
Plaintext
Raw Blame History

// 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 <ESC> 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 &COPYTO
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 <Esc> 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 <ESC> 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

Reference in New Issue View Git Blame Copy Permalink