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

8964 lines
272 KiB
Plaintext
Raw Permalink Blame History

// CGWPRPO0 - DON LOWENSTEIN - 4-25-94 (OTHER PRPO GOT TOO BIG!!)
//
#INCLUDE 'CGWINCLD.PRG'
#INCLUDE 'inkey.ch'
************************************************************
* CONTROL MENU (PRODUCTION / ORDER)
************************************************************
FUNCTION CNTRL_FUNC(OPT, TITLE,WHATFUNC, SEEKKEY)
LOCAL FLD_INFO:={}, M1ST_DATE, SAVESEL := SELECT(), SHIPBROWSE := .F.
LOCAL PTITLE := 'Shipping / Back Orders', NOLINESMSG, SCREEN
PRIVATE PRNTSOURCE := 'OE' //** P3N - 11/24/98
PRIVATE MODE:=0
PRIVATE XFERARR := {}
PRIVATE ALLOWTRANS := .T.
PRIVATE CUR_MAST := NIL
PRIVATE CUR_OL := NIL
PRIVATE CUR_XL := NIL
PRIVATE CUR_OO := NIL
PRIVATE CUR_XO := NIL
PRIVATE CUR_MISC := NIL
IF EMPTY(SEEKKEY) //** P3N - 1/26/00
SHIPBROWSE := .F. //** P3N - 1/26/00
ELSE //** P3N - 1/26/00
SHIPBROWSE := .T. //** P3N - 1/26/00
ENDIF //** P3N - 1/26/00
SET_ALIAS( 'ORDER' )
OPEN_BASEFILES()
ORD_OPEN()
DO WHILE .T.
IF WHATFUNC == 'SHIP' // ORDER SHIPPING/CONTROL
SCREEN := '3220'
PTITLE := 'Shipping Information - Order #: '
NOLINESMSG := '** Nothing FOUND to Ship! **'
DBOPEN('ORD_SHIP')
IF SELECT('USERFILE2') > 0
CLOSE USERFILE2
ENDIF
ELSE // PROD CONTROL
SCREEN := '3230'
PTITLE := 'Production Control - Order #: '
NOLINESMSG := '** Nothing FOUND to Produce! **'
DBOPEN('ORD_PROD')
IF SELECT('USERFILE2') > 0
CLOSE USERFILE2
ENDIF
ENDIF
IF SHIPBROWSE //** P3N - 1/26/00
SCREEN := '3210' //** P3N - 1/26/00
ENDIF //** P3N - 1/26/00
CLS
SAYTITLE(PTITLE, SCREEN)
COPY STRUCTURE TO (USERFILE2)
NET_USE(USERFILE2, .T. , 3 ,'USERFILE2')
ORD_PARMS := DBOPEN( 'ORD_MAST' )
IF SHIPBROWSE //** P3N - 1/26/00
ELSE //** P3N - 1/26/00
SEEKKEY := GET_KEY(ORD_PARMS)
ENDIF //** P3N - 1/26/00
IF LASTKEY() = 27
EXIT
ENDIF
WAIT_BOX('** Preparing System Files! **', ;
'** Please Wait! **')
BLD_TORD_LINES(SEEKKEY, WHATFUNC) //** P3N - 02/17/04
//** BLD_TORD_LINES(SEEKKEY) //** P3N - 02/17/04
IF WHATFUNC == 'SHIP' // ORDER SHIPPING/CONTROL
UPD_BO_TOTAL('ORD_LINES') //** P3N - 11/19/98
UPD_BO_TOTAL('ADDL_LINES') //** P3N - 11/23/98
ENDIF
SELECT TORD_LINES
IF LASTREC() = 0
ERR_BOX (NOLINESMSG)
CLOSE TORD_LINES
ERASE &USERFILE4+'.DB*'
LOOP
ENDIF
ACD_PAR_CHILD( 1, PTITLE+TORD_LINES->ORDER_NUM , ;
{ NIL , 'TORD_LINES', .F., 3, ;
'REV',,,, .F. ,SCREEN ,.F., 'TORD_LINES' })
CLOSE TORD_LINES
ERASE &USERFILE4+'.DB*'
ENDDO
IF SHIPBROWSE //** P3N - 1/26/00
//** DO NOT CLOSE DATA BASES //** P3N - 1/26/00
//** WHEN BROWSING SHIPPING //** P3N - 1/26/00
//** FROM ORDER ENTRY //** P3N - 1/26/00
ELSE //** P3N - 1/26/00
CLOSE DATABASES
ENDIF //** P3N - 1/26/00
RETURN .T.
************************************************************
* CREATE THE TORD_LINES FILE (USERFILE4)
* USED IN SHIPPING PROCESS.
************************************************************
//**FUNCTION BLD_TORD_LINES(SEEKKEY) //** P3N - 02/17/04
FUNCTION BLD_TORD_LINES(SEEKKEY, WHATFUNC) //** P3N - 02/17/04
LOCAL CUT_SPEC_ARR := {}, OLQTY, NUM_IN_SPEC, XFACTOR, CALCQTY, ADDLKEY
LOCAL WKARR := {}, GETARR := {}, SV_ORD_REC := 1, FLANKCNT := 0, SVLINE
LOCAL MPROD_CODE, MORDER_NUM, MLINE_NUM, USE_TEMP, ADDL_MODE, PPR_CUSTID
LOCAL DISP_WAIT, SELFILE, FR_COLOR := '', ELM, FLANKERS := '', ADDL_CNTR
LOCAL VENTPOS := '' //** P3N - 11/26/01
LOCAL SVPROD := PRODUCT->(RECNO()), PREVQTY := 0 //** P3N - 9/23/98
LOCAL SCR_RULE1 := .F., SCR_RULE2 := .F. //** P3N -11/2/98 - HAPPY B-DAY MATT
LOCAL RESULT := .F., RESULT1 := .F., RESULT2 := .F., WIDTH_SPEC := .F.
LOCAL BACKORDER_SPEC := .F. //** P3N - 11/6/98
LOCAL SCRDESC := '', PRNT_DESARR //** P3N - 7/21/99 - HAPPY BDAY DANIEL
LOCAL ITEM_CAT_CODE //** P3N - 7/21/99 - HAPPY BDAY DANIEL
DBOPEN( 'TORD_LINES' )
COPY STRUCTURE TO &USERFILE4
CLOSE TORD_LINES
NET_USE( USERFILE4, .T., 3, 'TORD_LINES' )
DBOPEN( 'ORDER_OPTS' ) //** P3N - 01/14/02 - FIX LINDA ABEND ON QUOTES??
DBOPEN( 'ORD_LINES' )
SV_ORDREC := ORD_LINES->(RECNO())
SEEK SEEKKEY
SVLINE := ORD_LINES->LINE_NUM
DO WHILE ORD_LINES->ORDER_NUM == SEEKKEY .AND. !EOF()
IF EMPTY(ORD_LINES->PROD_CODE) .AND. EMPTY(ORD_LINES->QUANTITY)
ELSE
ADD_ONEREC( 'ORD_LINES', 'TORD_LINES' )
ENDIF
ADDLKEY := ORD_LINES->ORDER_NUM + STR(ORD_LINES->LINE_NUM, 3)
XFACTOR := CK_XTRAWIND( 'ORD_LINES', 'ORDER_OPTS', .F. )
MPROD_CODE := ORD_LINES->PROD_CODE
MORDER_NUM := ORD_LINES->ORDER_NUM
MLINE_NUM := STR(ORD_LINES->LINE_NUM, 3)
USE_TEMP := .F.
ADDL_MODE := .F.
PPR_CUSTID := NIL
DISP_WAIT := .F.
SELFILE := 'ORD_LINES'
WKARR := BUILD_GETARR( MPROD_CODE, 1, MORDER_NUM, MLINE_NUM, '', ;
USE_TEMP, ADDL_MODE, PPR_CUSTID, DISP_WAIT, SELFILE)
GETARR := WKARR[1]
ELM := ASCAN(GETARR, {|X| X[1] = 'FR COLOR'} ) //** P3N - 9/23/98
IF EMPTY(ELM) //** P3N - 9/23/98
FR_COLOR := '' //** P3N - 9/23/98
ELSE //** P3N - 9/23/98
FR_COLOR := ' ' + ALLTRIM(GETARR[ELM,4]) + ' ' //** P3N - 9/23/98
ENDIF //** P3N - 9/23/98
ELM := ASCAN(GETARR, {|X| X[1] = 'VENT POS'} ) //** P3N -11/26/01
IF EMPTY(ELM) //** P3N -11/26/01
VENTPOS := '' //** P3N -11/26/01
ELSE //** P3N -11/26/01
VENTPOS := ALLTRIM(GETARR[ELM,4]) //** P3N -11/26/01
ENDIF //** P3N -11/26/01
ELM := ASCAN(GETARR, {|X| X[1] = 'FLANKERS'} ) //** P3N -11/2/98 HAPPY B-DAY MATT
IF EMPTY(ELM) //** P3N -11/2/98 HAPPY B-DAY MATT
FLANKERS := '' //** P3N -11/2/98 HAPPY B-DAY MATT
ELSE //** P3N -11/2/98 HAPPY B-DAY MATT
FLANKERS := ALLTRIM(GETARR[ELM,4]) //** P3N -11/2/98 HAPPY B-DAY MATT
ELM := ASCAN(GETARR, {|X| X[1] = 'FLANK SCRN'}) //** P3N -11/2/98 HAPPY B-DAY MATT
IF EMPTY(ELM) //** P3N - 11/12/98
FLANKERS := '' //** P3N -11/12/98
ELSEIF ALLTRIM(GETARR[ELM,4]) == 'YES' //** P3N - 11/3/98
ELSE
FLANKERS := '' //** P3N -11/2/98 HAPPY B-DAY MATT
ENDIF //** P3N -11/2/98 HAPPY B-DAY MATT
ENDIF //** P3N -11/2/98 HAPPY B-DAY MATT
CUT_SPEC_ARR := {}
//** IF EMPTY(FLANKERS) // DO NOT GET THE ADDL LINE STUFF FOR FLANKERS
ADDL_CNTR := GET_ADDL(ADDLKEY, VENTPOS) //GET THE ADDL LINES STUFF
//**ADDL_CNTR := GET_ADDL(ADDLKEY, GETARR, SELFILE ) //GET THE ADDL LINES STUFF
//** IF EMPTY(ADDL_CNTR)
CUT_SPEC_ARR := GET_CUT_SPEC( ORD_LINES->PROD_CODE, 'ORD_LINES' ,ORD_LINES->QUANTITY, XFACTOR, GETARR )
//** ENDIF
//** ELSE
//** CUT_SPEC_ARR := GET_CUT_SPEC( ORD_LINES->PROD_CODE, 'ORD_LINES' ,ORD_LINES->QUANTITY, XFACTOR, GETARR )
//** ENDIF
//**ELM := ASCAN(CUT_SPEC_ARR, {|X| AT('N', X[9]) > 0 }) // IS THIS A SCREEN SPEC?
//** IS THIS A SCREEN OR A BACKORDER SPEC?
ELM := ASCAN(CUT_SPEC_ARR, ; //**P3N - 11/6/98
{|X| AT('N', X[9]) > 0 .OR. AT('B', X[9]) > 0 }) //**P3N - 11/6/98
IF EMPTY(ELM)
// NO SCREEN CUTTING SPECS - NO EXTRA REC BASED ON CUTTING SPECS
ELSEIF SCREEN_OPTS(GETARR) //SCREEN OPTIONS ENTERED - FIND SCREEN CUTTING SPECS
FOR ELM := ELM TO LEN(CUT_SPEC_ARR)
BACKORDER_SPEC := .F. //** P3N - 11/6/98
IF AT('N', CUT_SPEC_ARR[ELM, 9]) > 0 //**SCREEN CUTTING SPECS ONLY
ELSEIF AT('B', CUT_SPEC_ARR[ELM, 9]) > 0 //**BACKORDER SPECS ONLY
BACKORDER_SPEC := .T. //** P3N - 11/6/98
ELSE
LOOP
ENDIF
//** IF CUT_SPEC_ARR[ELM, 11] == 'W' //** WIDTH CUTTING SPEC
IF CUT_SPEC_ARR[ELM, 11] $'W ' //** WIDTH OR " "-DESC CUTTING SPEC
WIDTH_SPEC := .T. //** USE ONLY ONE SPEC OUT OF
ELSE //** WIDTH / HEIGHT PAIR
WIDTH_SPEC := .F.
LOOP
ENDIF
RESULT := .F.
SCR_RULE1 := CUT_SPEC_ARR[ELM,8] //** RULE TO CHECK!!
SCR_RULE2 := CUT_SPEC_ARR[ELM,16] //** RULE TO CHECK!!
IF EMPTY(SCR_RULE1) .AND. EMPTY(SCR_RULE2) //** P3N - 11/2/98 - HAPPY B-DAY MATT
RESULT := .T. //** P3N - 11/2/98 - HAPPY B-DAY MATT
ELSE //** P3N - 11/2/98
RESULT1 := CHK_RULE(SCR_RULE1, GETARR, , SELFILE)
IF RESULT1
IF EMPTY(SCR_RULE2)
RESULT2 := .T.
ELSE
RESULT2 := CHK_RULE(SCR_RULE2, GETARR, , SELFILE)
ENDIF
IF RESULT2
RESULT := .T.
ENDIF
ENDIF
ENDIF
OLQTY := CUT_SPEC_ARR[ELM, 3]
IF ( RESULT .AND. !EMPTY(OLQTY) .AND. WIDTH_SPEC ) .OR. ;
BACKORDER_SPEC
NUM_IN_SPEC := CUT_SPEC_ARR[ELM, 13]
XFACTOR := CK_XTRAWIND( 'ORD_LINES', 'ORDER_OPTS', .F. )
CALCQTY := OLQTY * NUM_IN_SPEC * ( 1 + XFACTOR )
ITEM_CAT_CODE := GET_CATCODE( TORD_LINES->PROD_CODE) //** P3N - 7/21/99 HAPPY BDAY DANIEL
//** IF ADDSCREEN() //** P3N - 7/21/99 HAPPY BDAY DANIEL
IF (EMPTY(ADDL_CNTR) .AND. ADDSCREEN()) .OR. ; //** P3N - 7/21/99 HAPPY BDAY DANIEL
(!EMPTY(ADDL_CNTR) .AND. ADDSCREEN() .AND. ITEM_CAT_CODE <> 'SCREENS')
ADD_ONEREC( 'ORD_LINES', 'TORD_LINES' )
REC_LOCK( 3, 'TORD_LINES' )
REPLACE TORD_LINES->PAR_PROD WITH PROD_CODE
REPLACE TORD_LINES->PROD_CODE WITH 'SCREENS'
REPLACE TORD_LINES->QUANTITY WITH CALCQTY
IF PRODUCT->PROD_CODE == TORD_LINES->PAR_PROD
ELSE
PRODUCT->(DBSEEK(TORD_LINES->PAR_PROD))
ENDIF
//** P3N - 7/21/99 HAPPY BDAY DANIEL
//** CHANGED TO ADDRESS BACKORDER SCREEN DESCR. PRINTING
//** REPLACE TORD_LINES->ITEM_DESC WITH 'SCREENS FOR'+FR_COLOR+PRODUCT->DESC
PRNT_DESARR := BLD_DESC(GETARR, SELFILE, 'BACKORD', , 'SCREENS')
SCRDESC := PRNT_DESARR[1] //** P3N - 7/21/99 - HAPPY BDAY DANIEL
REPLACE TORD_LINES->ITEM_DESC WITH 'SCREENS FOR '+SCRDESC
ENDIF //** P3N - 7/21/99 - HAPPY B-DAY DANIEL
IF EMPTY(FLANKERS) //** P3N - 11/2/98 - HAPPY B-DAY MATT
SVLINE := ORD_LINES->LINE_NUM
FLANKCNT := 0
ELSEIF ORD_LINES->LINE_NUM = SVLINE
REPLACE TORD_LINES->LINE_DESC WITH ' ' //** P3N - 1/26/99
FLANKCNT := FLANKCNT + 1
IF FLANKCNT = 1
PREVQTY := TORD_LINES->QUANTITY
ELSEIF PREVQTY = TORD_LINES->QUANTITY
ELSE
//** REPLACE TORD_LINES->ENTRY_SIZE WITH FLANKERS
ENDIF
ELSE
SVLINE := ORD_LINES->LINE_NUM
FLANKCNT := 1 //** P3N - 1/27/99
REPLACE TORD_LINES->LINE_DESC WITH ' ' //** P3N - 1/27/99
ENDIF
ENDIF
NEXT
IF EMPTY(FLANKCNT) //** UPDATE PENDING FLANKER SIZE
ELSE
//** P3N - 1/26/99
//** REPLACE TORD_LINES->ENTRY_SIZE WITH FLANKERS
ADD_ONEREC( 'ORD_LINES', 'TORD_LINES' )
REC_LOCK( 3, 'TORD_LINES' )
REPLACE TORD_LINES->PAR_PROD WITH PROD_CODE
//** REPLACE TORD_LINES->PROD_CODE WITH 'SCREENS'
REPLACE TORD_LINES->PROD_CODE WITH 'SCRFLNK'
REPLACE TORD_LINES->QUANTITY WITH CALCQTY
IF TORD_LINES->HOW_MEAS == 'NS' //** P3N - 2/02/99
REPLACE TORD_LINES->ENTRY_SIZE WITH SUBST(FLANKERS, 1, 4)
ELSE
REPLACE TORD_LINES->ENTRY_SIZE WITH FLANKERS
ENDIF
//** P3N - 7/21/99 HAPPY BDAY DANIEL
//** CHANGED TO ADDRESS BACKORDER SCREEN DESCR. PRINTING
//** REPLACE TORD_LINES->ITEM_DESC WITH 'SCREENS FOR'+FR_COLOR+PRODUCT->DESC
PRNT_DESARR := BLD_DESC(GETARR, SELFILE, 'BACKORD', , 'SCREENS')
SCRDESC := PRNT_DESARR[1] //** P3N - 7/21/99 - HAPPY BDAY DANIEL
REPLACE TORD_LINES->ITEM_DESC WITH 'SCREENS FOR '+ SCRDESC
FLANKERS := ' '
FLANKCNT := 0
ENDIF
ENDIF
IF WHATFUNC == 'SHIP' // ORDER SHIPPING/CONTROL //** P3N - 02/17/04
//** DO NOT CREATE A GLASS ORDER SHIPPING ITEM //** P3N - 02/17/04
ELSE //** P3N - 02/17/04
ELM := ASCAN(CUT_SPEC_ARR, {|X| AT('G', X[9]) > 0 }) //** P3N - 02/16/04
IF EMPTY(ELM) //** P3N - 02/16/04
//** NO GLASS CUTTING SPECS - CONTINUE
ELSE
//** GLASS CUTTING SPECS //** P3N - 02/16/04
//** CREATE A CONTROL REC FOR THE GLASS PARTS
OLQTY := CUT_SPEC_ARR[ELM, 3]
NUM_IN_SPEC := CUT_SPEC_ARR[ELM, 13]
XFACTOR := CK_XTRAWIND( 'ORD_LINES', 'ORDER_OPTS', .F. )
CALCQTY := OLQTY * NUM_IN_SPEC * ( 1 + XFACTOR )
ADD_ONEREC( 'ORD_LINES', 'TORD_LINES' )
REC_LOCK( 3, 'TORD_LINES' )
REPLACE TORD_LINES->PAR_PROD WITH PROD_CODE
REPLACE TORD_LINES->PROD_CODE WITH 'GLASS'
REPLACE TORD_LINES->QUANTITY WITH CALCQTY
IF PRODUCT->PROD_CODE == TORD_LINES->PAR_PROD
ELSE
PRODUCT->(DBSEEK(TORD_LINES->PAR_PROD))
ENDIF
PRNT_DESARR := BLD_DESC(GETARR, SELFILE, 'BACKORD', , 'GLASS')
SCRDESC := PRNT_DESARR[1]
REPLACE TORD_LINES->ITEM_DESC WITH 'GLASS FOR '+SCRDESC
ENDIF //** P3N - 02/16/04
ENDIF //** P3N - 02/17/04
ORD_LINES->(DBSKIP(+1))
ENDDO
GET_MISC(SEEKKEY) // CHK FOR MISC. ORDER LINES (CGW0OMI)
GET_ORDMISC(SEEKKEY, 'MISC') //CHK FOR ORDER MISC ITEMS (CGW0OM->MISC_ITEM1...)
GET_ORDMISC(SEEKKEY, 'NOTX') //CHK FOR ORDER NON TAX ITEMS (CGW0OM->NOTX_ITEM1...)
TORD_LINES->(DBGOTOP()) //** P3N - 9/2/98
ORD_LINES->(DBGOTO(SV_ORDREC)) //** P3N - 9/16/98
PRODUCT->(DBGOTO(SVPROD)) //** P3N - 9/23/98
RETURN .T.
************************************************************
* P3N - 11/9/98
* DOES THIS SCREEN ALREADY EXIST ON THIS ORDER?
************************************************************
FUNCTION ADDSCREEN()
LOCAL RETVAL := .T.
LOCAL TORDREC := TORD_LINES->(RECNO())
TORD_LINES->(DBGOTOP())
DO WHILE TORD_LINES->(!EOF())
IF ORD_LINES->ORDER_NUM == TORD_LINES->ORDER_NUM
IF ORD_LINES->LINE_NUM == TORD_LINES->LINE_NUM
IF ORD_LINES->PROD_CODE == TORD_LINES->PAR_PROD
IF TORD_LINES->PROD_CODE == 'SCREENS'
RETVAL := .F.
ENDIF
ENDIF
ENDIF
ENDIF
TORD_LINES->(DBSKIP(+1))
ENDDO
TORD_LINES->(DBGOTO(TORDREC))
RETURN RETVAL
************************************************************
* P3N - 7/7/98
* WAS THIS WINDOW ORDERED WITH A SCREEN?
************************************************************
FUNCTION SCREEN_OPTS(GETARR)
LOCAL RETVAL := .F.
LOCAL ELM := ASCAN(GETARR, {|X| AT('SCRN', X[1]) > 0 .OR. ;
AT('WITH SCREN', X[1]) > 0 .OR. ;
AT('SCREEN', X[1]) > 0 } )
IF ELM > 0 // IS THIS A SCREEN ATT ?
IF AT('SCREEN ONLY', GETARR[ELM, 4] ) > 0 .OR. ;
AT('WITH SCR', GETARR[ELM, 4]) > 0 .OR. ;
AT('VIEW SCREEN', GETARR[ELM, 4] ) > 0 .OR. ;
AT('W/SCR', GETARR[ELM, 4]) > 0
//** ACCEPT SCREEN ONLY OPTION AND W/SCR OPTION
RETVAL := .T.
ENDIF
ENDIF
RETURN RETVAL
************************************************************
* P3N - 8/17/98
* WAS THIS WINDOW ORDERED WITH A STORM?
************************************************************
FUNCTION STORM_OPTS(GETARR)
LOCAL RETVAL := .F.
LOCAL ELM := ASCAN(GETARR, {|X| AT('STORM', X[1]) > 0 } )
IF ELM > 0 // IS THIS A STORM ATT ?
IF AT('STORM', GETARR[ELM, 4] ) > 0
RETVAL := .T.
ENDIF
ENDIF
RETURN RETVAL
************************************************************
* ADDL LINES FOR TORD_LINES SHIP ORDERS -
************************************************************
//**FUNCTION GET_ADDL(SEEKKEY, GETARR, SELFILE )
FUNCTION GET_ADDL(SEEKKEY, VENTPOS)
LOCAL ADDLCTR := 0, ADDLORD
LOCAL SVSEL := SELECT()
LOCAL PRNT_DESARR, SCRDESC //** P3N - 8/26/99 - HAPPY ANNIV. DON & RUTH #21
LOCAL MPROD_CODE := '' //** P3N - 11/26/01
LOCAL MORDER_NUM := ORD_LINES->ORDER_NUM //** P3N - 11/26/01
LOCAL MLINE_NUM := STR(ORD_LINES->LINE_NUM, 3) //** P3N - 11/26/01
LOCAL USE_TEMP := .F. //** P3N - 11/26/01
LOCAL ADDL_MODE := .T. //** P3N - 11/26/01
LOCAL PPR_CUSTID := NIL //** P3N - 11/26/01
LOCAL DISP_WAIT := .F. //** P3N - 11/26/01
LOCAL SELFILE := 'ADDL_LINES' //** P3N - 11/26/01
LOCAL WKARR := {} //** P3N - 11/26/01
DBOPEN( 'ADDL_LINES' )
ADDLORD := INDEXORD()
SET ORDER TO 3
ADDL_LINES->(DBSEEK(SEEKKEY))
DO WHILE !EOF() .AND. ADDL_LINES->ORDER_NUM == ORD_LINES->ORDER_NUM ;
.AND. ADDL_LINES->LINE_NUM == ORD_LINES->LINE_NUM
ADDLCTR := ADDLCTR + 1
ADD_ONEREC( 'ADDL_LINES', 'TORD_LINES' )
MPROD_CODE := ADDL_LINES->PROD_CODE //** P3N - 11/26/01
WKARR := BUILD_GETARR( MPROD_CODE, 1, MORDER_NUM, MLINE_NUM, '', ; //**P3N - 11/26/01
USE_TEMP, ADDL_MODE, PPR_CUSTID, DISP_WAIT, SELFILE) //**P3N - 11/26/01
//** GETARR := WKARR[1]
PRNT_DESARR := BLD_DESC(WKARR[1], 'ADDL_LINES', 'BACKORD', , 'SCREENS')
SCRDESC := PRNT_DESARR[1] //** P3N - 8/26/99 - HAPPY ANNIV. DON & RUTH #21
IF EMPTY(VENTPOS) //** P3N - 11/26/01
ELSE //** P3N - 11/26/01
SCRDESC := SCRDESC + ' - ' + VENTPOS //** P3N - 11/26/01
ENDIF //** P3N - 11/26/01
REPLACE TORD_LINES->ITEM_DESC WITH SCRDESC
//** REPLACE TORD_LINES->ITEM_DESC WITH 'SCREENS FOR '+ SCRDESC
SKIP 1
ENDDO
SET ORDER TO ADDLORD
SELECT(SVSEL)
RETURN ADDLCTR
************************************************************
* P3N - 7/7/98
* MISC ORDER LINES (CGW0OMI)
************************************************************
FUNCTION GET_MISC(SEEKKEY)
LOCAL SVSEL := SELECT()
DBOPEN( 'ORD_MISC' )
ORD_MISC->(DBSEEK(SEEKKEY))
DO WHILE !EOF() .AND. ORD_MISC->ORDER_NUM == SEEKKEY
TORD_LINES->(DBAPPEND())
REPLACE TORD_LINES->ORDER_NUM WITH ORD_MISC->ORDER_NUM
REPLACE TORD_LINES->LINE_NUM WITH VAL(ORD_MISC->LINE_NUM)
REPLACE TORD_LINES->QUANTITY WITH ORD_MISC->QUANTITY
REPLACE TORD_LINES->ENTRY_SIZE WITH ORD_MISC->ENTRY_SIZE
REPLACE TORD_LINES->WIDTH WITH ORD_MISC->WIDTH
REPLACE TORD_LINES->HEIGHT WITH ORD_MISC->HEIGHT
REPLACE TORD_LINES->PRICE_SHT WITH ORD_MISC->PRICE_SHT
REPLACE TORD_LINES->SALE_PRICE WITH ORD_MISC->SALE_PRICE
REPLACE TORD_LINES->ALT_SPRICE WITH ORD_MISC->ALT_SPRICE
REPLACE TORD_LINES->HOW_MEAS WITH ORD_MISC->HOW_MEAS
REPLACE TORD_LINES->COLOR WITH ORD_MISC->COLOR
REPLACE TORD_LINES->PARTNUM WITH ORD_MISC->PARTNUM
REPLACE TORD_LINES->LINE_DESC WITH ORD_MISC->PARTNUM
REPLACE TORD_LINES->UOM WITH ORD_MISC->UOM
REPLACE TORD_LINES->UPDATED WITH ORD_MISC->UPDATED
REPLACE TORD_LINES->PROD_CODE WITH 'MISCITM'
SKIP 1
ENDDO
SELECT(SVSEL)
RETURN .T.
************************************************************
* P3N - 7/28/98
* ORDER MISC. ITEMS (CGW0OM->MISC_ITEM1...)
* OR
* ORDER NON TAX ITEMS (CGW0OM->NOTX_ITEM1...)
************************************************************
FUNCTION GET_ORDMISC(SEEKKEY, WHATFLDS)
LOCAL I, ITM_NAME, QTY_NAME, AMT_NAME, CONT := .T., TOL_PROD, WK_QTY
IF WHATFLDS == 'MISC'
ITM_NAME := 'MISC_ITEM'
QTY_NAME := 'MISC_QTY'
AMT_NAME := 'MISC_AMT'
TOL_PROD := 'ORDMISC'
ELSEIF WHATFLDS == 'NOTX'
ITM_NAME := 'NOTX_ITEM'
QTY_NAME := 'NOTX_QTY'
AMT_NAME := 'NOTX_AMT'
TOL_PROD := 'ORDNOTX'
ELSE
ERR_BOX ('Invalid call to GET_ORDMISC()!', ;
'All items from Order Entry Screen (2115) may not be present.', ;
'ORDER SHIPPING Information MAY NOT be ACCURATE and/or COMPLETE.')
CONT := .F.
ENDIF
IF CONT
FOR I := 1 TO 3
ITM_NAME := SUBS(ITM_NAME,1,9) + STR(I, 1)
QTY_NAME := SUBS(QTY_NAME,1,8) + STR(I, 1)
AMT_NAME := SUBS(AMT_NAME,1,8) + STR(I, 1)
IF EMPTY( (CUR_MAST)->&ITM_NAME)
LOOP
ENDIF
TORD_LINES->(DBAPPEND())
REPLACE TORD_LINES->ORDER_NUM WITH (CUR_MAST)->ORDER_NUM
REPLACE TORD_LINES->LINE_NUM WITH I
REPLACE TORD_LINES->QUANTITY WITH (CUR_MAST)->&QTY_NAME
REPLACE TORD_LINES->SALE_PRICE WITH (CUR_MAST)->&AMT_NAME
REPLACE TORD_LINES->LINE_DESC WITH (CUR_MAST)->&ITM_NAME
REPLACE TORD_LINES->PROD_CODE WITH TOL_PROD
REPLACE TORD_LINES->LOC_CODE WITH MHOME_LOC_CODE
NEXT
ENDIF
RETURN .T.
************************************************************
* ADD CHANGE ORDERS -
************************************************************
FUNCTION ACD_ORDERS ( OPT,TITLE, PARM, WHEREORD )
LOCAL OPTION := OPT, MTITLE := TITLE
LOCAL SAVESEL := SELECT(), RETVAL
LOCAL SAVESCR := SAVESCREEN()
LOCAL ACTION_CODE
** LOCAL OLDF8 := SETKEY( -7, OLDF8 ) //** P3N - 4/30/98
PRIVATE PRNTSOURCE := 'OE' //** P3N - 11/24/98
//**(CUR_MAST)->(DONSETORD(1)) //** P3N - 1/28/00
IF PARM[5] <> NIL
SETAVAR( 'SET', 'ACTION_CODE', PARM[5] )
ELSE
DO CASE
CASE OPT = 1
SETAVAR( 'SET', 'ACTION_CODE', 'ADD' )
PARM[5] := 'ADD'
CASE OPT = 2
SETAVAR( 'SET', 'ACTION_CODE', 'DEL' )
PARM[5] := 'DEL'
CASE OPT = 3
SETAVAR( 'SET', 'ACTION_CODE', 'REV' )
PARM[5] := 'REV'
ENDCASE
ENDIF
IF WHEREORD = NIL
_WHEREORD := '1'
ELSE
_WHEREORD := WHEREORD
SELECT( CUR_MAST )
ENDIF
M->OE_TYPE := 'CHG' //** P3N - 9/20/06
IF OPT = 1 //** P3N - 11/01/06
M->OE_TYPE := 'ADD' //** P3N - 11/01/06
ENDIF //** P3N - 11/01/06
//**IF OPT = 1 //** P3N - 3/03/00
IF TITLE = 'ADD ' //** P3N - 4/17/01
IF SELECT( CUR_MAST ) > 0 //** ADD ORDER TIME
(CUR_MAST)->(DONSETORD(1)) //** ENSURE YOU ARE ON THE
(CUR_MAST)->(DBGOTOP()) //** P3N - 03/30/01 HAPPY B-DAY CHRISTY
ENDIF //** ORDER_NUM INDEX
ENDIF //** P3N - 3/03/00
RETVAL := ACD_PAR_CHILD (OPT,MTITLE, PARM )
**IF LASTKEY() == 27 //ESCAPE FROM THE ADD CHANGE ORDERS
** // do NOT refresh the output array if ESCAPE is used
**ELSE
**IF OPT = 1 .AND. _WHEREORD = '2' // ADD/CHANGE
OUT_ARR := BLD_ORDER( (CUR_MAST)->ORDER_NUM )
**ENDIF
** //** P3N - 5/8/98
**OLDF8 := SETKEY( -7, {||SHIPINFO('ORD_MAST')} ) //ORDER SHIPPING INFORMATION
SELECT (SAVESEL)
RESTSCREEN(,,,, SAVESCR)
IF SELECT('TORD_LINES') > 0 //** P3N - 1/26/00
CLOSE TORD_LINES //** P3N - 1/26/00
ENDIF //** P3N - 1/26/00
RETURN RETVAL
****************************************************************
* Initialize the INSTALL (GL361) Amount in the active line item file.
* (ie: ORDER_LINES, or QUOTE_LINES)
//** AS OF 02/01/07 GL311 is GL361
****************************************************************
FUNCTION SET_GL311(SEEKKEY)
LOCAL SAVESEL := SELECT(), RECNUM := RECNO(), RETVAL := 0.00
IF (CUR_MAST)->PICK_DEL$'I' // Install ORDER
IF PRODUCT->(DBSEEK(SEEKKEY))
RETVAL := PRODUCT->INSTALLAMT
ENDIF
ENDIF
SELECT (SAVESEL)
RETURN RETVAL
*********************************************************
// INITIALIZE NEW FIELDS FOR A PARTNUMBER
FUNCTION NEED_DATA( MPARTNUM, FLD_NAME )
LOCAL SAVESEL := SELECT(), I:=0, WORKUOM, WORKCOLOR
LOCAL WORKARR := {}, CHOICE := 0, STRT, RETVAL := .F.
IF FLD_NAME = 'UOM'
SELECT MISC_PUOM
DONSETORD(2)
ELSE
SELECT MISC_COLOR
DONSETORD(2)
ENDIF
SEEK MPARTNUM
DO WHILE PARTNUM == MPARTNUM .AND. !EOF()
AADD(WORKARR, &FLD_NAME )
SKIP 1
ENDDO
SELECT (SAVESEL)
STRT := 1
IF !EMPTY(&FLD_NAME)
FOR I := 1 TO LEN(WORKARR)
IF WORKARR[I] == &FLD_NAME
STRT := I
EXIT
ENDIF
NEXT
ENDIF
IF EMPTY(WORKARR)
REPLACE &FLD_NAME WITH 'N/A'
RETVAL := .T.
KEYBOARD CHR(13)
ELSE
DO WHILE CHOICE = 0
IF LEN(WORKARR) = 1
CHOICE := 1
ELSE
CHOICE = PICKLIST(WORKARR, MIN(ROW()+1,8) , MIN(COL()+5,40), 'Select' + FLD_NAME, STRT )
ENDIF
ENDDO
REPLACE &FLD_NAME WITH WORKARR[CHOICE]
RETVAL := .T.
KEYBOARD CHR(13)
ENDIF
IF FLD_NAME = 'UOM'
SELECT MISC_PUOM
DONSETORD(1)
ELSE
SELECT MISC_COLOR
DONSETORD(1)
ENDIF
SELECT (SAVESEL)
RETURN RETVAL
*********************************************************
// INITIALIZE NEW FIELDS FOR A PARTNUMBER
FUNCTION SET_OMI_DATA( MPARTNUM )
LOCAL SAVESEL := SELECT(), I:=0, WORKUOM, WORKCOLOR
SELECT MISC_PUOM
SEEK MPARTNUM
DO WHILE PARTNUM == MPARTNUM .AND. !EOF()
I ++
WORKUOM := UOM
SKIP 1
ENDDO
SELECT (SAVESEL)
IF I = 1
REPLACE UOM WITH WORKUOM
ENDIF
SELECT MISC_COLOR
SEEK MPARTNUM
I := 0
DO WHILE PARTNUM == MPARTNUM .AND. !EOF()
I ++
WORKCOLOR := COLOR
SKIP 1
ENDDO
SELECT (SAVESEL)
IF I = 1
REPLACE COLOR WITH WORKCOLOR
ENDIF
REPLACE LINE_NUM WITH STR(RECNO(), 3)
RETURN .T.
*********************************************************
FUNCTION ACD_PARTS( )
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
LOCAL SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
****LOCAL OPTION := 1
LOCAL TITLE := 'MISC PARTS Setup'
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
TITLE := 'MISC PARTS Setup'
MISC_WHATWAY( 1, TITLE, .F., ACTION_CODE )
ELSE
ERR_BOX('You CAN NOT Update Parts in REVIEW mode!')
**TITLE := 'MISC PARTS Review'
**MISC_WHATWAY( 3, TITLE, .F., 'REV' )
ENDIF
SELECT(SAVESEL)
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
*********************************************************
FUNCTION MISC_ITEM( )
LOCAL SAVESEL := SELECT(), REARANGE_FILES := .F.
LOCAL SAVESCR := SAVESCREEN()
LOCAL OPTION := 1
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
LOCAL TITLE
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV' //REVIEW OPTION
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPTION := 3
ENDIF
IF CUR_MAST = 'ORD_MAST'
TITLE := 'MISC Items for Order ' + ALLTRIM( (SAVESEL)->ORDER_NUM )
ELSE
TITLE := 'MISC Items for Quote ' + ALLTRIM( (SAVESEL)->ORDER_NUM )
ENDIF
IF SELECT( 'SALESMEN' ) > 0
REARANGE_FILES := .T.
CLOSE SALESMEN
CLOSE MFG_LOC
CLOSE TERMS
CLOSE SHIPMETH
CLOSE TAX_DETAIL
CLOSE TAX_SCHED
CLOSE WORKSTAT
IF SELECT( 'MISC_ITEMS' ) > 0
CLOSE MISC_ITEMS
ENDIF
DBOPEN('MISC_ITEMS')
DBOPEN('MISC_PUOM')
DBOPEN('MISC_COLOR')
**DBOPEN('UOMFILE')
ENDIF
ACD_PAR_CHILD(OPTION, TITLE, {NIL, CUR_MISC, .F., 3, ACTION_CODE, , , , , , .F., "USERFILEI"})
UP_MISCTOT((CUR_MAST)->ORDER_NUM ) //** P3N - 11/25/98
CLOSE USERFILEI
IF REARANGE_FILES
CLOSE MISC_PUOM
CLOSE MISC_COLOR
CLOSE MISC_ITEMS
//** P3N - 12/29/98
DBOPEN("MISC_ITEMS")
DBOPEN("SALESMEN")
DBOPEN("MFG_LOC")
//** DBOPEN("MISC_ITEMS",,, {1})
//** DBOPEN("SALESMEN",,, {1})
//** DBOPEN("MFG_LOC",,, {1})
DBOPEN("TERMS")
DBOPEN("SHIPMETH")
DBOPEN("TAX_DETAIL")
DBOPEN("TAX_SCHED")
DBOPEN("WORKSTAT")
ENDIF
RESTSCREEN(,,,,SAVESCR)
SELECT(SAVESEL)
RETURN .T.
*********************************************************
FUNCTION MASTER_LIST(ACTION)
LOCAL SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
LOCAL OPTION := 1
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
LOCAL TITLE
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV'
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPTION := 3
ENDIF
IF ACTION = 'UOM'
TITLE := 'UOM Master List'
ACD_PAR_CHILD(OPTION, TITLE, {NIL, 'UOMFILE', .F., 3, ACTION_CODE, , , , , , .F., "USERFILEX"})
ELSE
IF ACTION = 'COLOR'
TITLE := 'COLOR Master List'
ACD_PAR_CHILD(OPTION, TITLE, {NIL, 'COLOR_LIST', .F., 3, ACTION_CODE, , , , , , .F., "USERFILEX"})
ENDIF
ENDIF
RESTSCREEN(,,,,SAVESCR)
CLOSE USERFILEX
SELECT(SAVESEL)
RETURN .T.
*********************************************************
** F7 - Hot key to Change or Review ORDERS from the PRINT menu
*********************************************************
FUNCTION CHG_REV_HOTKEY(REVONLY, ORDCONTROL )
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
LOCAL SAVESEL := SELECT(), OLDBLOCK, SCRNUM
LOCAL SAVESCR := SAVESCREEN()
LOCAL OPT := 1
LOCAL TITLE
// SAVE CURRENT HOTKEYS
LOCAL OLDF5 := SETKEY( K_F5, NIL ) //** P3N - 8/18/99
LOCAL OLDF10 := SETKEY( K_F10, NIL )
LOCAL OLDPGDN := SETKEY( K_PGDN, NIL )
LOCAL OLDPGUP := SETKEY( K_PGUP, NIL )
LOCAL OLDPGLEFT := SETKEY( K_LEFT, NIL )
LOCAL OLDPGRITE := SETKEY( K_RIGHT, NIL )
LOCAL OLDF7 := SETKEY( K_F7, OLDF7 )
//**LOCAL OLDF7 := SETKEY( -6, OLDF7 )
LOCAL OLDCURSOR := SETCURSOR()
LOCAL BLDTORD := .F., SEEKKEY //** P3N - 6/29/98
IF EMPTY(ORDCONTROL) //** P3N - 6/29/98
BLDTORD := .F.
ELSE
BLDTORD := ORDCONTROL
ENDIF
IF EMPTY(REVONLY)
REVONLY := ' '
ENDIF
IF CUR_MAST == 'ORD_MAST'
SCRNUM := '2120' // ORDER PROCESSING SCREEN
ELSE
SCRNUM := '2220' // QUOTE PROCESSING SCREEN
ENDIF
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
TITLE := 'CHANGE Sales Orders'
IF SCRNUM = '2220'
TITLE := 'CHANGE Quote'
ENDIF
CMD := 'ADD'
OPT := 2 //** P3N - 02/02/07
//**OPT := 1 //** P3N - 02/02/07
ELSE
TITLE := 'Review Sales Orders'
IF SCRNUM = '2220'
TITLE := 'Review Quote'
ENDIF
CMD := 'REV'
OPT := 3
ENDIF
CLEAR GETS
IF REVONLY == 'REV'
CMD := 'REV'
ENDIF
ACD_ORDERS (OPT, TITLE, { CUR_MAST, CUR_OL, .T., 2, CMD ,,,,,, .F.,,SCRNUM,.F.,, }, '2')
// RESTORE SAVED HOTKEYS
OLDF10 := SETKEY( K_F10, OLDF10 )
OLDPGDN := SETKEY( K_PGDN, OLDPGDN )
OLDPGUP := SETKEY( K_PGUP, OLDPGUP )
OLDPGLEFT := SETKEY( K_LEFT, OLDPGLEFT )
OLDPGRITE := SETKEY( K_RIGHT, OLDPGRITE )
//**OLDF7 := SETKEY( -6, OLDF7 )
OLDF7 := SETKEY( K_F7, OLDF7 )
OLDF5 := SETKEY( K_F5, OLDF5 ) //** P3N - 8/18/99
//**IF BLDTORD //** P3N - 6/29/98
IF BLDTORD .OR. SELECT('TORD_LINES') = 0 //** P3N -01/15/02
WAIT_BOX('** Preparing System Files! **', ;
'** Please Wait! **')
IF SELECT('TORD_LINES') > 0 //** P3N - 1/29/00
CLOSE TORD_LINES
ENDIF //** P3N - 1/29/00
SEEKKEY := (CUR_MAST)->ORDER_NUM //** P3N - 6/29/98
BLD_TORD_LINES(SEEKKEY) //** P3N - 6/29/98
DBOPEN('TORD_LINES')
ENDIF
// RESTORE SAVED ENVIRONMENT SETTINGS
SETCURSOR(OLDCURSOR)
IF SELECT(SAVESEL) > 0 //** 9/15/98 - HAPPY BDAY MOM
SELECT(SAVESEL)
ENDIF
RESTSCREEN(,,,,SAVESCR)
RETURN
*********************************************************
FUNCTION MISC_P_HOTKEY(ACTION)
LOCAL SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
LOCAL OPTION := 1
LOCAL TITLE
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
LOCAL CALLEDFROM := ACD_CALLED_BY(), CK_DESC, CK_COL
STATIC D_ELEM, C_ELEM
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV' //REVIEW OPTION
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPTION := 3
ENDIF
IF CALLEDFROM = 'MYBROWSE'
CK_DESC := (SAVESEL)->DESC
ELSE
IF D_ELEM = NIL
D_ELEM = ASCAN(GETVARS, {|X| X[3]=='DESC'})
ENDIF
CK_DESC := GETVARS[D_ELEM,4]
ENDIF
//** P3N - 5/26/99 __VAL_ALL_RECS := .T. IN CGW0000.PRG NO NEED TO EXEC HERE
//** __VAL_ALL_REC := .T. //** P3N - 5/26/99
IF ACTION = 'UOM'
TITLE := 'PRICING / UOM for ' + CK_DESC
ACD_PAR_CHILD(OPTION, TITLE, {NIL, 'MISC_PUOM', .F., 3, ACTION_CODE, , , , , , .F., "USERFILE3"})
ELSE
IF ACTION = 'COLOR'
TITLE := 'COLORS for ' + CK_DESC
ACD_PAR_CHILD(OPTION, TITLE, {NIL, 'MISC_COLOR', .F., 3, ACTION_CODE, , , , , , .F., "USERFILE3"})
ENDIF
ENDIF
//** __VAL_ALL_REC := .F. //** P3N - 5/26/99
RESTSCREEN(,,,,SAVESCR)
CLOSE USERFILE3
SELECT(SAVESEL)
RETURN .T.
*********************************************************
FUNCTION VAL_CAT_CODE( FLD_NAME )
LOCAL X := GETACTIVE(), I, SEEKKEY, SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
IF EMPTY(X) // NOT IN A READ!
RETURN .T.
ENDIF
IF EMPTY(X:BUFFER) // EMPTY CAT_CODE IS OK
RETURN .T.
ENDIF
SEEKKEY := X:BUFFER
IF CATEGORY->(DBSEEK(SEEKKEY))
RETURN .T.
ENDIF
GBROWSE(,"Category LOOKUP", {"CATEGORY", , .T.} )
SELECT(SAVESEL)
IF LASTKEY() = 27
RETURN .F.
ENDIF
IF X:NAME = 'GETVARS'
I := X:SUBSCRIPT[1]
GETVARS[I,4] := CATEGORY->CAT_CODE
ELSE
REC_LOCK(1)
REPLACE &FLD_NAME WITH CATEGORY->CAT_CODE
ENDIF
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
*********************************************************
FUNCTION VAL_CODE( FLD_NAME )
LOCAL X := GETACTIVE(), I, SEEKKEY, SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN(), STUFFVAR
LOCAL CALLEDFROM := ACD_CALLED_BY(), CK_DESC, CK_COL
IF CALLEDFROM = 'MYBROWSE' .AND. EMPTY(X) .AND. LASTKEY() = K_F10
RETURN .T.
ENDIF
IF CALLEDFROM = 'MYBROWSE'
SEEKKEY := &FLD_NAME
ELSE
IF EMPTY(X) // NOT IN A READ!
RETURN .T.
ENDIF
SEEKKEY := X:BUFFER
IF EMPTY(SEEKKEY)
RETURN .T. // END OF DEL_BLANK
ENDIF
ENDIF
DO CASE
CASE FLD_NAME = 'UOM'
IF UOMFILE->(DBSEEK(SEEKKEY))
RETURN .T.
ELSE
GBROWSE(,"Unit of Measure LOOKUP", {"UOMFILE", , .T.} )
STUFFVAR := 'UOMFILE->UOM'
ENDIF
CASE FLD_NAME = 'COLOR'
IF COLOR_LIST->(DBSEEK(SEEKKEY))
RETURN .T.
ELSE
GBROWSE(,"Master Color List LOOKUP", {"COLOR_LIST", , .T.} )
STUFFVAR := 'COLOR_LIST->COLOR'
ENDIF
CASE FLD_NAME = 'PARTNUM'
IF MISC_ITEMS->(DBSEEK(SEEKKEY))
RETURN .T.
ELSE
GBROWSE(,"Misc PARTS List LOOKUP", {"MISC_ITEMS", , .T.} )
STUFFVAR := 'MISC_ITEMS->PARTNUM'
ENDIF
ENDCASE
SELECT(SAVESEL)
RESTSCREEN(,,,,SAVESCR)
IF LASTKEY() = 27
RETURN .F.
ENDIF
IF X:NAME = 'GETVARS'
// ASSUMES NO DISPLAY ONLY ITEMS IN GETLIST
I := X:SUBSCRIPT[1]
//** IF EMPTY(I) //** P3N - 11/12/98
IF EMPTY(I) .OR. EMPTY(GETVARS) //** P3N - 01/06/99
RETURN .F. //** P3N - 11/12/98
ELSE //** P3N - 11/12/98
GETVARS[I,4] := &STUFFVAR
ENDIF //** P3N - 11/12/98
ELSE
REC_LOCK(1)
REPLACE &FLD_NAME WITH &STUFFVAR
ENDIF
RETURN .T.
*********************************************************
FUNCTION VAL_YN( FLD_NAME )
LOCAL X := GETACTIVE(), I, SEEKKEY, SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
IF EMPTY(X) // NOT IN A READ!
RETURN .T.
ENDIF
IF EMPTY(X:BUFFER) // EMPTY CAT_CODE IS OK
RETURN .T.
ENDIF
IF X:BUFFER$'YN ' // BLANK = NO
RETURN .T.
ELSE
ERR_BOX('*** INVALID Response for ' + FLD_NAME ,;
'*** Y = Yes N = No ')
RETURN .F.
ENDIF
RETURN .T.
*********************************************************
FUNCTION MISC_WHATWAY(OPTION, TITLE, CLOSEDBFS, ACTION_CODE)
LOCAL SAVESEL := SELECT()
LOCAL MARR := {'1 Record at a Time', 'Browse Format'}
LOCAL NCHOICE
LOCAL SAVESCR := SAVESCREEN()
CLS
SAYTITLE( TITLE, 'MITEMS')
NCHOICE = PICKLIST(MARR,10,, 'Update FORMAT')
IF LASTKEY() = 27
RESTSCREEN(,,,,SAVESCR)
RETURN {{}}
ENDIF
IF CLOSEDBFS = NIL
CLOSEDBFS := .T.
ENDIF
IF EMPTY(ACTION_CODE)
IF _OC_CAPABLE
ACTION_CODE := 'ADD'
ELSE
ACTION_CODE := 'REV'
ENDIF
ENDIF
IF NCHOICE = 1
ADD_SING_REC(OPTION, TITLE, {'MISC_ITEMS', .T.,,,,, ACTION_CODE,,CLOSEDBFS})
ELSEIF NCHOICE = 2
DBOPEN('MISC_ITEMS')
DONSETORD(0)
DBOPEN('MISC_PUOM')
__VAL_ALL_REC := .F.
ACD_PAR_CHILD(OPTION, TITLE, {NIL, 'MISC_ITEMS', .F., 3, ACTION_CODE,,,,.F.,,CLOSEDBFS,'MISC_ITEMS' })
__VAL_ALL_REC := .T.
IF !CLOSEDBFS
SELECT MISC_ITEMS
DONSETORD(1)
ENDIF
ENDIF
IF !CLOSEDBFS
SELECT (SAVESEL)
ENDIF
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
*********************************************************
FUNCTION CK_PRINT_ON(STR2CK, ALLOW_EMPTY)
LOCAL CK_STR, I, SAVESEL := SELECT()
LOCAL M1 := '*** INDICATE the DOCUMENT to PRINT ON. ***'
LOCAL M2 := '*** VALID CHOICES ARE "FIGSENCVXB" '
LOCAL M3 := '*** C=Control E=Expander F=Frame '
LOCAL M4 := '*** G=Glass I=Insert/Sash N=Screen '
LOCAL M5 := '*** S=Storm V=Invoice/Delivery X=Exclude Print'
LOCAL M6 := '*** B=BackOrder '
IF ALLOW_EMPTY = NIL
ALLOW_EMPTY := .F.
ENDIF
CK_STR := ALLTRIM(&STR2CK)
IF EMPTY(CK_STR)
IF ALLOW_EMPTY
RETURN .T.
ELSE
ERR_BOX(M1, M2, M3, M4, M5, M6) //** P3N - 11/6/98
RETURN .F.
ENDIF
ELSE
// which copy to print on
FOR I = 1 TO LEN(CK_STR)
//** - P3N*4/1/98 - ADDED "X" - EXCLUDE PRINT
//** - P3N*11/6/98 - ADDED "B" - BACKORDR PRINT
IF !SUBS(CK_STR,I,1)$'FIGSENCVXB'
ERR_BOX(M1, M2, M3, M4, M5, M6) //** P3N - 11/6/98
RETURN .F.
ENDIF
NEXT
ENDIF
RETURN .T.
*************************************************************
FUNCTION CK_OTN( CKVAR ) // CHECK FOR "OTN"
LOCAL I
FOR I := 1 TO LEN(ALLTRIM(CKVAR))
IF !SUBS(CKVAR,I,1)$'OTNWB12'
RETURN .F.
ENDIF
NEXT
RETURN .T.
*************************************************************
FUNCTION ACD_TAX_DETAIL()
// DEFINE DEATIL FROM TAX SCHEDULE HOT KEY
LOCAL SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE'), OPT := 1
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV' //REVIEW OPTION
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPT := 3
ENDIF
ACD_PAR_CHILD(OPT, 'Tax Details',{NIL, 'TAX_DETAIL', .F., 3, ACTION_CODE,,,,,'TX210',.F.,'USERFILEI'} )
CLOSE USERFILEI
SELECT (SAVESEL)
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
*************************************************************
FUNCTION RULE_DEF()
// DEFINE RULES FROM ACD HOT KEY
LOCAL SAVESEL := SELECT()
LOCAL SAVESCR := SAVESCREEN()
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE'), OPT := 1
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV' //REVIEW OPTION
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPT := 3
ENDIF
ACD_PAR_CHILD(OPT, 'Rule Definitions',{'RULES', 'RULEPACK', .T., 6, ACTION_CODE,,,,,,.F.,'USERFILEI'} )
IF SELECT('USERFILEI') > 0
CLOSE USERFILEI
ENDIF
SELECT (SAVESEL)
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
******************************************************************
FUNCTION NON_USER_PRICING( PASSVALUE )
// CHECK FOR USER PRICING CODE IN THE DSBJL FIELD IN PRI_EXTRA DBROWSE
IF PASSVALUE = NIL
PASSVALUE := PRICE_SHT
ENDIF
IF ALLTRIM(PRICE_SHT)$'U'
CLEAR TYPEAHEAD
RETURN .F.
ELSE
RETURN .T.
ENDIF
******************************************************************
FUNCTION STD_SASH_EDIT( EDITVALUE )
// CHECK FOR VALID 99 X 99 SIZE
LOCAL EDITVAL
LOCAL RETVAL
RETVAL := &EDITVALUE
RETVAL := CHK_FRACTION(RETVAL, 'VALUE')
IF DECVAL( RETVAL ) > 0
REPLACE &EDITVALUE WITH RETVAL
RETURN .T.
ENDIF
ERR_BOX('*** Please Specify Valid Height ***')
RETURN .F.
**********************************************************************
FUNCTION ACD_STD_SASH()
LOCAL SAVESCR := SAVESCREEN(), SAVESEL := SELECT()
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE'), OPT := 1
STATIC MELEM
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV' //REVIEW OPTION
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPT := 3
ENDIF
IF MELEM = NIL
MELEM := ASCAN(GETVARS, {|X| X[3] = 'SS_BOTSASH'})
ENDIF
IF GETVARS[MELEM, 4] $'Y'
ELSE
ERR_BOX('*** Indicate "Y" for STANDARD BOTTOM SASH ' , ;
'*** to Access the STANDARD SASH DEFINITION TABLE')
RETURN .F.
ENDIF
CLS
IF OPT = 1
MTITLE := 'Standard Sashes for ' + PRODUCT->PROD_CODE
ELSE
MTITLE := 'Review Standard Sashes for ' + PRODUCT->PROD_CODE
ENDIF
SAYTITLE( MTITLE, 'STDSASH')
ACD_PAR_CHILD(OPT, MTITLE, {NIL, 'STD_SASH', .F., NIL, ACTION_CODE, NIL,;
NIL, NIL, NIL, NIL, .F., 'USERFILE3'})
CLOSE USERFILE3
SELECT (SAVESEL)
CLS
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
**********************************************************************
FUNCTION ACD_CUT_SPEC()
LOCAL SAVESCR := SAVESCREEN(), SAVESEL := SELECT()
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE'), OPT := 1
IF EMPTY(ACTION_CODE)
ACTION_CODE := 'REV' //REVIEW OPTION
ENDIF
IF ACTION_CODE = 'REV' //REVIEW OPTION
OPT := 3
ENDIF
CLS
IF OPT = 1
MTITLE := 'Cutting Specs for ' + PRODUCT->PROD_CODE
IF ACTION_CODE = 'REV'
ELSEIF DEL_CAPABLE
MTITLE := MTITLE + SPACE(05) + 'F12-Del'
ENDIF
ELSE
MTITLE := 'Review Cutting Specs for ' + PRODUCT->PROD_CODE
ENDIF
SAYTITLE( MTITLE, 'CUT_SPEC')
ACD_PAR_CHILD(OPT, MTITLE, {NIL, 'CUT_SPEC', .F., NIL, ACTION_CODE, NIL,;
NIL, NIL, NIL, NIL, .F., 'USERFILE3'})
CLOSE USERFILE3
SELECT (SAVESEL)
CLS
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
*******************************************************
//** P3N - 9/22/00 HAPPY BDAY CINDY 41
//** DELETE ALL MATHPACKS FOR A GIVEN PRODUCT IF PRODUCT REC DELETED.
*******************************************************
FUNCTION CHK_PRODDEL()
LOCAL SVSEL := SELECT()
LOCAL RETVAL := .T., DELCNTR := 0
LOCAL CUR_PROD := PRODUCT->PROD_CODE
IF DEL_CAPABLE //** P3N - 9/25/00
IF _CUROPT = 2 //** DELETE PRODUCT - REMOVE
DBOPEN('MATHPACK', .T.) //** ALL MATHPACK RECS FOR PRODUCT
MATHPACK->(DBSEEK(CUR_PROD + ' ', .T.))
DO WHILE MATHPACK->(!EOF()) .AND. MATHPACK->CAT_CODE == CUR_PROD
REC_LOCK(1,'MATHPACK')
MATHPACK->(DBDELETE())
DELCNTR := DELCNTR + 1
MATHPACK->(DBSKIP(+1))
ENDDO
IF EMPTY(DELCNTR)
ELSE
SELECT('MATHPACK')
FIL_LOCK(3)
MATHPACK->(__DBPACK())
ENDIF
CLOSE MATHPACK
ENDIF
ENDIF //** P3N - 9/25/00
SELECT(SVSEL)
RETURN RETVAL
*******************************************************
//** P3N - 9/21/00
//** DELETE ALL CUTTING SPECS AND MATHPACKS FOR A GIVEN PRODUCT
//** INITIATED FROM THE CUTTING SPEC SCREEN BY PRESSING - F12
*******************************************************
FUNCTION DEL_CS()
LOCAL SVSEL := SELECT()
LOCAL CUR_PROD := PRODUCT->PROD_CODE, DELCNTR := 0
LOCAL M1 := 'You have selected to remove ALL cutting information'
LOCAL M2 := 'for the model - ' + CUR_PROD
LOCAL M3 := 'Are you sure you want to continue?'
LOCAL RETVAL := .T., OPENMP := .F.
IF DEL_CAPABLE //** P3N - 9/25/00
IF PROMPT_BOX(M1, M2, M3 )
IF CUT_SPEC->(DBSEEK( CUR_PROD + ' ' ))
DO WHILE CUT_SPEC->(!EOF()) .AND. CUT_SPEC->PROD_CODE == CUR_PROD
REC_LOCK(1,'CUT_SPEC')
CUT_SPEC->PROD_CODE := ' '
CUT_SPEC->ATT_CODE := ' '
CUT_SPEC->(DBDELETE())
CUT_SPEC->(DBSKIP(+1))
ENDDO
ENDIF
MATHPACK->(DBSEEK(CUR_PROD + ' ', .T.))
DO WHILE MATHPACK->(!EOF()) .AND. MATHPACK->CAT_CODE == CUR_PROD
REC_LOCK(1,'MATHPACK')
MATHPACK->(DBDELETE())
MATHPACK->(DBSKIP(+1))
ENDDO
IF EMPTY(DELCNTR)
IF SELECT('MATHPACK') > 0
CLOSE MATHPACK
OPENMP := .T.
ENDIF
DBOPEN('MATHPACK', .T.)
MATHPACK->(__DBPACK())
CLOSE MATHPACK
IF OPENMP
DBOPEN('MATHPACK')
ENDIF
ENDIF
ENDIF
USERFILE5->(__DBZAP()) //** CUT_SPEC USERFILE
USERFILE3->(__DBZAP()) //** MATHPACK USERFILE
KEYBOARD K_F10 //** P3N - 9/25/00
ENDIF //** P3N - 9/25/00
SELECT(SVSEL)
RETURN RETVAL
*******************************************************
//** P3N - 2/24/99
//** COPY A CURRENT CUSTOMER FROM AN EXISTING CUSTOMER
//** F2 - FROM CUSTOMER PRICING SETUP (SCREEN - 11720B)
*******************************************************
FUNCTION COPY_CUSTBP( )
LOCAL SVSEL := SELECT()
LOCAL NEWCUST := CUST_MAST->CUST_ID, ORIGCUST, SVREC
LOCAL MTITLE := 'Select CUSTOMER to Copy Setup for NEW Customer ' + ALLTRIM(NEWCUST)
LOCAL SVSCRN := SAVESCREEN()
LOCAL M1 := 'You are about to copy ALL Attributes & Options'
LOCAL M2 := 'from Customer - '
LOCAL M3 := 'Are You Sure you want to ALL Customer setup info?'
IF EMPTY( GETAVAR ('TPATH') )
SETAVAR('SET', 'TPATH', 'TEMP\')
ENDIF
IF CUST_BP->(DBSEEK(NEWCUST)) .OR. USERFILE2->(RECNO()) > 1
ERR_BOX('Customer Pricing ALREADY exists')
ELSE
@ 00, 00 CLEAR TO 24, 80
SAYTITLE( MTITLE, 'CUSTMA')
GET_THE_CUST(' ')
RESTSCREEN(,,,,SVSCRN)
ORIGCUST := CUST_MAST->CUST_ID
M2 := 'from Customer - ' + ORIGCUST
IF CUST_BP->(DBSEEK( ORIGCUST ) )
REC_LOCK(1,'USERFILE2')
USERFILE2->(DBDELETE())
USERFILE2->(DBUNLOCK())
DO WHILE CUST_BP->CUST_ID == ORIGCUST .AND. CUST_BP->(!EOF())
ADD_ONEREC('CUST_BP','USERFILE2')
REC_LOCK(1,'USERFILE2')
USERFILE2->CUST_ID := NEWCUST
USERFILE2->(DBUNLOCK())
CUST_BP->(DBSKIP(+1))
ENDDO
IF PROMPT_BOX(M1,M2,M3)
DBOPEN('CUST_ATTS')
IF CUST_ATTS->(DBSEEK(ORIGCUST))
DO WHILE CUST_ATTS->CUST_ID == ORIGCUST .AND. CUST_ATTS->(!EOF())
@ 22,10 SAY 'COPYING ATTS FROM- ' + ORIGCUST + ' PROD- '+ CUST_ATTS->PROD_CODE
SVREC := CUST_ATTS->(RECNO())
QADD_ONEREC('CUST_ATTS','CUST_ATTS')
CUST_ATTS->(DBGOTO(CUST_ATTS->(LASTREC())))
REC_LOCK(1,'CUST_ATTS')
CUST_ATTS->CUST_ID := NEWCUST
CUST_ATTS->(DBUNLOCK())
CUST_ATTS->(DBGOTO(SVREC))
CUST_ATTS->(DBSKIP(+1))
ENDDO
ENDIF
CLOSE CUST_ATTS
DBOPEN('CUST_OPTS')
IF CUST_OPTS->(DBSEEK(ORIGCUST))
DO WHILE CUST_OPTS->CUST_ID == ORIGCUST .AND. CUST_OPTS->(!EOF())
@ 22,10 SAY 'COPYING ATTS FROM- ' + ORIGCUST + ' PROD- '+ CUST_OPTS->PROD_CODE
SVREC := CUST_OPTS->(RECNO())
QADD_ONEREC('CUST_OPTS','CUST_OPTS')
CUST_OPTS->(DBGOTO(CUST_OPTS->(LASTREC())))
REC_LOCK(1,'CUST_OPTS')
CUST_OPTS->CUST_ID := NEWCUST
CUST_OPTS->(DBUNLOCK())
CUST_OPTS->(DBGOTO(SVREC))
CUST_OPTS->(DBSKIP(+1))
ENDDO
ENDIF
CLOSE CUST_OPTS
ENDIF
ENDIF
USERFILE2->(DBGOTOP())
DO WHILE USERFILE2->(!EOF())
ADD_ONEREC('USERFILE2', 'CUST_BP')
USERFILE2->(DBSKIP(+1))
ENDDO
ENDIF
USERFILE2->(DBGOTOP())
CUST_MAST->(DBSEEK(NEWCUST))
KEYBOARD CHR(13)
SELECT(SVSEL)
RETURN .T.
*******************************************************
FUNCTION BLD_CUSTATTS( PARFILE, NEWFILE )
LOCAL SVFILT := CUST_ATTS->(DBFILTER()) //** P3N - 2/23/99
LOCAL SVREC := CUST_ATTS->(RECNO()) //** P3N - 2/23/99
LOCAL NEWCUST := CUST_MAST->(RECNO()) //** P3N - 2/23/99
LOCAL SAVESEL := SELECT()
LOCAL MAC, FROMFILE, SVCUST
SETAVAR('SET','CPYCUST','') //** P3N - 12/27/01
PRIVATE SEEKKEY
SEEKKEY := (PARFILE)->PROD_CODE
SELECT PROD_ATTS
IF LASTKEY() = K_F2 //** P3N - 2/23/99
GET_THE_CUST(' ') //** P3N - 2/23/99
SVCUST := CUST_MAST->CUST_ID //** P3N - 2/23/99
SETAVAR('SET','CPYCUST',SVCUST) //** P3N - 12/27/01
SEEKKEY := SVCUST+(PARFILE)->PROD_CODE //** P3N - 2/23/99
SELECT CUST_ATTS //** P3N - 2/23/99
SET FILTER TO //** P3N - 2/23/99
SEEK SEEKKEY //** P3N - 2/25/99
IF FOUND() //** P3N - 2/25/99
ELSE //** P3N - 2/25/99
SEEKKEY := (PARFILE)->PROD_CODE //** P3N - 2/25/99
SELECT PROD_ATTS //** P3N - 2/25/99
SVCUST := '' //** P3N - 2/25/99
ENDIF //** P3N - 2/25/99
ENDIF //** P3N - 2/23/99
SEEK SEEKKEY
IF FOUND()
IF EMPTY(SVCUST) //** P3N - 2/23/99
MAC := 'PROD_CODE == SEEKKEY .AND. !EOF() '
FROMFILE := 'PROD_ATTS'
ELSE // F2-CUST_ATTS //** P3N - 2/23/99
MAC := 'CUST_ID+PROD_CODE == SEEKKEY .AND. !EOF() '
FROMFILE := 'CUST_ATTS' //** P3N - 2/23/99
ENDIF //** P3N - 2/23/99
ELSE
SEEKKEY := GET_CATCODE( SEEKKEY )
SELECT CAT_ATTS
SEEK SEEKKEY
MAC := 'CAT_CODE == SEEKKEY .AND. !EOF() '
FROMFILE := 'CAT_ATTS'
ENDIF
DO WHILE &MAC
ADD_ONEREC( FROMFILE, NEWFILE )
SELECT (NEWFILE)
REC_LOCK(1)
REPLACE UPDATED WITH 'M'
REPLACE CUST_ID WITH (PARFILE)->CUST_ID
REPLACE PROD_CODE WITH (PARFILE)->PROD_CODE
SELECT (FROMFILE)
SKIP 1
ENDDO
SELECT CUST_ATTS //** P3N - 2/23/99
SET FILTER TO (SVFILT) //** P3N - 2/23/99
CUST_ATTS->(DBGOTO(SVREC)) //** P3N - 2/23/99
CUST_MAST->(DBGOTO(NEWCUST)) //** P3N - 2/23/99
SELECT (SAVESEL)
KEYBOARD CHR(13) //** P3N - 2/26/99
RETURN .T.
**********************************************************************
FUNCTION CUSTPRICELEVELS()
LOCAL SAVESCR := SAVESCREEN()
LOCAL PRE_KEY_VALU := {USERFILE2->CUST_ID}
LOCAL MCUSTID := USERFILE2->CUST_ID
LOCAL MMODEL := ALLTRIM(USERFILE2->PROD_CODE)
LOCAL MGET_KEY := USERFILE2->PROD_CODE, MTITLE
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
LOCAL SEEKKEY := USERFILE2->CUST_ID + USERFILE2->PROD_CODE
LOCAL SVCAFILTER := '', SVCAFLBLK //** P3N - 5/26/99
DBOPEN('PROD_ATTS')
DBOPEN('CAT_ATTS')
DBOPEN('CUST_ATTS')
SVCAFILTER := CUST_ATTS->(DBFILTER()) //** P3N - 5/26/99
SVCAFLBLK := '{||'+SVCAFILTER+'}' //** P3N - 5/26/99
CLS
MTITLE := 'CUSTOMER ' + CUST_MAST->CUST_ID + ' ATTRIBUTES FOR ' + ALLTRIM(USERFILE2->PROD_CODE)
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
CUST_ATTS->(DBSEEK(SEEKKEY))
IF CUST_ATTS->(FOUND())
ELSE
ERR_BOX('Pricing Attributes NOT FOUND for CUSTOMER '+MCUSTID+' / MODEL '+MMODEL, ;
'*** If you press F2 ATTRIBUTES for CUSTOMER '+MCUSTID + ' / MODEL '+ MMODEL, ;
'*** WILL be copied from the CUSTOMER of your choice - OTHERWISE ' , ;
'*** ATTRIBUTES WILL be copied from MODEL - ' + MMODEL, ;
'*** You MUST save (F10) these CUSTOMER attributes to ensure ' , ;
'*** accurate Customer Pricing! ')
ENDIF
ACD_PAR_CHILD(1, MTITLE, {NIL, 'CUST_ATTS', .F., NIL, 'ADD', NIL,;
'CUST_ID == USERFILE2->CUST_ID', ;
NIL, NIL, NIL, .F., 'USERFILE3'})
ELSE
ACD_PAR_CHILD(3,'Review '+MTITLE, {NIL, 'CUST_ATTS', .F., NIL, 'REV', NIL,;
'CUST_ID == USERFILE2->CUST_ID', ;
NIL, NIL, NIL, .F., 'USERFILE3'})
ENDIF
IF SELECT('USERFILE3') > 0
CLOSE USERFILE3
ENDIF
SELECT USERFILE2
CLS
RESTSCREEN(,,,,SAVESCR)
IF EMPTY(SVCAFILTER)
CUST_ATTS->(DBSETFILTER())
ELSE
CUST_ATTS->(DBSETFILTER(&SVCAFLBLK, SVCAFILTER ))
ENDIF
RETURN .T.
**********************************************************************
* SPECIAL CUSTOMER PRICING SCREENS SET CUSTOMER ID
**********************************************************************
FUNCTION UPDTE_CUSTID(CK_DEL)
REPLACE CUST_ID WITH CUST_MAST->CUST_ID
IF EMPTY(CK_DEL) //** P3N - 3/12/99
ELSEIF CK_DEL = 'CUSTPRICE' //** P3N - 3/12/99
CUST_PRICEDEL() //** P3N - 3/12/99
ENDIF //** P3N - 3/12/99
RETURN .T.
**********************************************************************
FUNCTION UPDTE_PRODCODE()
REPLACE PROD_CODE WITH USERFILE2->PROD_CODE
RETURN .T.
**********************************************************************
* SPECIAL CUSTOMER PRICING SCREENS SET CUSTOMER ID,CAT_CODE,PROD_CODE
**********************************************************************
FUNCTION UPDTE_LVLPRI()
REPLACE CUST_ID WITH USERFILE2->CUST_ID
REPLACE PROD_CODE WITH USERFILE2->PROD_CODE
RETURN .T.
**********************************************************************
* SPECIAL CUSTOMER PRICING MENU
**********************************************************************
FUNCTION SPEC_PRICING( OPTION, TITLE, CLOSEDBFS )
LOCAL NCHOICE, SAVESEL := SELECT()
LOCAL OPTARR:= {}, SAVESCR, CUSTKEY
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
STATIC CUSTPARMS
IF CUSTPARMS = NIL
CUSTPARMS := GET_FILEPARMS( 'CUST_MAST' )
ENDIF
IF CLOSEDBFS = NIL // HOTKEY CALL
CLOSEDBFS := .F.
ENDIF
CLS
IF OPTION <> NIL // CALLED FROM MENU - OPEN DATABASES
DBOPEN( 'CUST_MAST' )
SAYTITLE('Customer Pricing Options ' , 'CPRICE')
CUST_KEY = GET_KEY(CUSTPARMS)
IF LASTKEY() = 27 .OR. EMPTY(CUST_KEY)
CLOSE DATABASES
RETURN
ENDIF
DBOPEN( 'TAX_SCHED' )
DBOPEN( 'TAX_DETAIL' )
ELSE
SAYTITLE('Special Pricing Options - #' + CUST_MAST->CUST_ID, '1172')
ENDIF
AADD(OPTARR, 'CUSTOMER DISCOUNTS (DSLJBI)')
AADD(OPTARR, 'CUSTOMER Pricing Setup')
SAVESCR := SAVESCREEN()
DO WHILE .T.
RESTSCREEN(,,,,SAVESCR)
NCHOICE = LISTBOX(OPTARR,NCHOICE,'Select Choice', 8)
IF LASTKEY() = 27
SELECT (SAVESEL)
IF CLOSEDBFS
CLOSE DATABASES
ENDIF
RETURN .F.
ENDIF
TITLE := OPTARR[NCHOICE] + ' - #' + CUST_MAST->CUST_ID
IF NCHOICE=1
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
ACD_PAR_CHILD(1, TITLE, {NIL, 'CUST_PRICE', .F., 3, 'ADD', ,;
, , , ,.F. })
ELSE
ACD_PAR_CHILD(3,'Review '+TITLE, {NIL, 'CUST_PRICE', .F., 3, 'REV', ,;
, , , ,.F. })
ENDIF
ELSE
IF NCHOICE=2
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
ACD_PAR_CHILD(1, TITLE, {NIL, 'CUST_BP', .F., 3, 'ADD', ,;
, , , ,.F. })
ELSE
ACD_PAR_CHILD(3,'Review '+TITLE, {NIL, 'CUST_BP', .F., 3, 'REV', ,;
, , , ,.F. })
ENDIF
ENDIF
ENDIF
ENDDO
RETURN
*****************************************************************
* P3N - 3/12/99 CUST PRICING - CONFIRM DELETE OPERATION *
*****************************************************************
FUNCTION CUST_PRICEDEL()
LOCAL SVSEL := SELECT()
LOCAL X := GETACTIVE(), ORIGPROD
LOCAL M1 := ' ', M2 := ' '
LOCAL M3 := 'Are you sure you want to delete this CUSTOMER SETUP information ?'
LOCAL RETVAL
IF EMPTY(X)
ELSE
ORIGPROD := X:ORIGINAL()
M1 := 'About to DELETE CUSTOMER '+ CUST_MAST->CUST_ID +' / '+ TRIM(ORIGPROD) + ' information ! '
IF EMPTY(PROD_CODE)
IF EMPTY(ORIGPROD)
ELSEIF PROMPT_BOX(M1, M2, M3)
DEL_CUSTSETUP(CUST_MAST->CUST_ID, ORIGPROD)
ELSE
REPLACE PROD_CODE WITH ORIGPROD
ENDIF
ENDIF
ENDIF
SELECT(SVSEL)
RETURN .T.
*****************************************************************
* P3N - 3/12/99 CUST PRICING - REMOVE CHILD FILES INFO ON DEL*
*****************************************************************
FUNCTION DEL_CUSTSETUP(CUST, PROD)
LOCAL SEEKKEY := CUST+PROD, OPEN_ATTS := .F., OPEN_OPTS := .F.
LOCAL KEYFLDS := 'CUST_ID+PROD_CODE', DELOPTS := {}, DELATTS := {}
LOCAL DEL_ARRAY := {KEYFLDS,{ { 'CUST_ATTS', 1 }, {'CUST_OPTS', 1} } }
LOCAL SVSCRN := SAVESCREEN()
WAIT_BOX('Removing Customer setup information', ;
'*** Please Wait! ***')
IF SELECT('CUST_ATTS') > 0
CLOSE CUST_ATTS
OPEN_ATTS := .T.
ENDIF
IF SELECT('CUST_OPTS') > 0
CLOSE CUST_OPTS
OPEN_OPTS := .T.
ENDIF
DEL_RELATED_DBF(DEL_ARRAY, SEEKKEY)
SET DELETED OFF
DBOPEN('CUST_ATTS')
CUST_ATTS->(DBSEEK(CUST+PROD))
DO WHILE CUST_ATTS->(!EOF()) .AND. ;
CUST_ATTS->CUST_ID + CUST_ATTS->PROD_CODE == CUST + PROD
IF CUST_ATTS->(DELETED())
AADD(DELATTS, CUST_ATTS->(RECNO()) )
ENDIF
CUST_ATTS->(DBSKIP(+1))
ENDDO
DBOPEN('CUST_OPTS')
CUST_OPTS->(DBSEEK(CUST+PROD))
DO WHILE CUST_OPTS->(!EOF()) .AND. ;
CUST_OPTS->CUST_ID + CUST_OPTS->PROD_CODE == CUST + PROD
IF CUST_OPTS->(DELETED())
AADD(DELOPTS, CUST_OPTS->(RECNO()) )
ENDIF
CUST_OPTS->(DBSKIP(+1))
ENDDO
DELCUSTAO(DELATTS, 'CUST_ATTS')
DELCUSTAO(DELOPTS, 'CUST_OPTS')
CLOSE CUST_OPTS
CLOSE CUST_ATTS
SET DELETED ON
IF OPEN_ATTS
DBOPEN('CUST_ATTS')
ENDIF
IF OPEN_OPTS
DBOPEN('CUST_OPTS')
ENDIF
RESTSCREEN(,,,, SVSCRN )
RETURN .T.
*****************************************************************
* P3N - 3/12/99 CUST PRICING - REMOVE CHILD FILES INFO ON DEL*
*****************************************************************
FUNCTION DELCUSTAO(DELARR, FILENAME)
LOCAL I
FOR I := 1 TO LEN(DELARR)
(FILENAME)->(DBGOTO(DELARR[I]))
REC_LOCK( 3, FILENAME )
REPLACE (FILENAME)->CUST_ID WITH ' '
REPLACE (FILENAME)->PROD_CODE WITH ' '
(FILENAME)->(DBUNLOCK())
NEXT
RETURN
*****************************************************************
* CGW0GL / ACD_CARGO - CALC AND DISPLAY THE GL ALLOC BALANCE. *
*****************************************************************
FUNCTION GLBAL()
LOCAL RETVAL
RETVAL := AMOUNT + ADJ_AMT
RETURN STR(RETVAL, 9,2)
*******************************************************
FUNCTION CUST_HOTKEYS(WHICHONE, WHICHSCREEN)
LOCAL RETVAL := {}, NOTEVAR, NEEDVAR, SEEKKEY
LOCAL MTITLE := ' + CUST_ID'
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
NOTEVAR := 'NOTES("CUST_NOTES", NOTEREV_EDIT(), "Notes - CUST #" + CUST_ID , , .T.)'
AADD(RETVAL, { 'F4-Customer Notes ', -3, NOTEVAR } )
RETURN RETVAL
*******************************************************
//// 1/20/20 - 10-BYTE FUNCTION NAMES.
FUNCTION ORD_HOTKEY(WHICHONE, WHICHSCREEN)
//
RETURN ORD_HOTKEYS(WHICHONE, WHICHSCREEN)
*******************************************************
FUNCTION ORD_HOTKEYS(WHICHONE, WHICHSCREEN)
LOCAL RETVAL := {}, NOTEVAR, NEEDVAR, SEEKKEY
LOCAL MTITLE := ' + ORDER_NUM '
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
IF RIGHT( WHICHSCREEN, 1 ) = '0'
NOTEVAR := 'NOTES("NOTES", NOTEREV_EDIT(), "Notes - ORDER #" + ORDER_NUM , , .F.)'
AADD(RETVAL, { 'F4-Order Notes ', -3, NOTEVAR } )
AADD(RETVAL, { 'F6-Customer Update', -5, 'UPDT_CUST()' } )
IF WHICHONE == 'ORDERS' //** P3N - 1/27/00
AADD(RETVAL, { 'F8-Shipping Info', K_F8, 'SHIPINFO()' })
ENDIF //** P3N - 1/27/00
AADD(RETVAL, { 'F9-Customer Browse', K_F9, 'UPDT_CUST("BROWSE")' } ) //** P3N - 3/20/00
ELSEIF WHICHSCREEN = '2115'
AADD(RETVAL, { 'F8-Misc Items Entry', -7, 'MISC_ITEM()' } )
ENDIF
RETURN RETVAL
*******************************************************
FUNCTION NOTEREV_EDIT()
IF _OC_CAPABLE .AND. GETAVAR('ACTION_CODE') = 'ADD'
RETURN 'EDIT'
ELSE
RETURN 'REVIEW'
ENDIF
*******************************************************
FUNCTION GET_OR_REVU()
IF _OC_CAPABLE .AND. GETAVAR('ACTION_CODE') = 'ADD'
RETURN 'GET'
ELSE
RETURN 'REV'
ENDIF
*********************************************************************
//** P3N 1/26/00 BROWSE THE SHIPPING INFORMATION FROM ORDER ENTRY
*********************************************************************
FUNCTION SHIPINFO()
LOCAL SVSEL := SELECT()
LOCAL SEEKKEY := (CUR_MAST)->ORDER_NUM
LOCAL WHATFUNC := 'SHIP'
IF _CUROPT == 2 //** ORDER CHANGE / UPDATE ONLY
CNTRL_FUNC(,,WHATFUNC, SEEKKEY)
ENDIF
SELECT(SVSEL)
RETURN .T.
*******************************************************
FUNCTION OL_HOTKEYS(WHICHONE, WHICHSCREEN)
LOCAL RETVAL := {}
AADD(RETVAL, {'F3-DELETE Lines ',-2,'DEL_LINEDETAIL(.F.)'} )
AADD(RETVAL, {'F4-Special Notes ',-3,'LINENOTE()'} )
AADD(RETVAL, {'F6-UPDATE Options ',-5,'GET_LINEOPTS(USERFILE2->PROD_CODE,GET_OR_REVU(),,.F.)'} )
AADD(RETVAL, {'F7-Calculate Price',-6,'GET_LINEOPTS(USERFILE2->PROD_CODE,"PRICE")'} )
AADD(RETVAL, {'F8-Misc Items Entry', -7, 'MISC_ITEM()' } )
AADD(RETVAL, {'',-4,'NOSORT()'} )
RETURN RETVAL
*******************************************************
* SOLICITATION NOTES EDIT/REV ( ORD_MAST->SOLNOTES )
* //** P3N -12/14/98
*******************************************************
FUNCTION EDIT_INVNOTES()
LOCAL SV_SEL := SELECT(), CLOSECTRL := .F.
LOCAL MARR := { '1. DEFAULT Invoice Message (ALL Orders)', '2. SPECIAL Invoice Message (This Order Only)'}
LOCAL ACTION := 'REVIEW'
LOCAL NCHOICE := PICKLIST(MARR,10,, 'Select a Note to Edit/Modify')
IF FUN6 == 'X' //** INVOICE PRINT FUNCTIONALITY
ACTION := 'EDIT'
ENDIF
IF LASTKEY() == 27
ELSEIF NCHOICE == 1
IF SELECT('CONTROL') > 0
CLOSECTRL := .F.
ELSE
CLOSECTRL := .T.
DBOPEN('CONTROL')
ENDIF
SELECT('CONTROL')
IF FIELDPOS('INVNOTES') > 0
//** NOTES("INVNOTES", NOTEREV_EDIT(), "Default Invoice Note - ALL Orders", , .F.)
NOTES("INVNOTES", ACTION, "Default Invoice Note - ALL Orders", , .F.)
ELSE
ERR_BOX(' ** Control File does not contian the field - INVNOTES.', ;
' ** If you want to use this feature you must modify ', ;
' ** the CONTROL FILE (CGW0KA)!' )
ENDIF
ELSEIF NCHOICE == 2
SELECT (CUR_MAST)
IF FIELDPOS('INVNOTES') > 0
//** NOTES("INVNOTES", NOTEREV_EDIT(), "Invoice Order Note - Order #"+ORDER_NUM, ,.F.)
NOTES("INVNOTES", ACTION , "Invoice Order Note - Order #"+ORDER_NUM, ,.F.)
ELSE
ERR_BOX(' ** Order File does not contian the field - INVNOTES.', ;
' ** If you want to use this feature you must modify ', ;
' ** the Order Master FILE (CGW0OM)!' )
ENDIF
ELSE
ERR_BOX(' ** Invalid Option ! **')
ENDIF
IF FIELDPOS('INVNOTES') > 0
IF LEN(ALLTRIM(INVNOTES)) > 240
ERR_BOX(' ** This Invoice Note will NOT fit at the bottom of the Order.', ;
' ** This note is limited to three lines of 80 positions.', ;
' ** A total size of 240 characters. ' )
ENDIF
ENDIF
IF CLOSECTRL
CLOSE CONTROL
ENDIF
SELECT(SV_SEL)
RETURN
*******************************************************
* BACKORDER NOTES EDIT/REV ( ORD_MAST )
* //** P3N - 9/2/98
*******************************************************
FUNCTION BONOTES()
LOCAL SV_SEL := SELECT()
LOCAL MARR := { '1. Back Order Notes', '2. Common Notes'}
LOCAL NARR := { '1. PRIMARY Back Order', '2. SCREEN Back Order'}
LOCAL NCHOICE := PICKLIST(MARR,10,, 'Select a Note Option')
IF LASTKEY() == 27
ELSEIF NCHOICE == 1
SELECT (CUR_MAST)
NCHOICE := PICKLIST(NARR,10,, 'Select a Note Type')
IF NCHOICE == 1
NOTES("BO_NOTES", NOTEREV_EDIT(), "Notes - BACKORDER #"+ORDER_NUM, ,.F.)
ELSEIF NCHOICE == 2
NOTES("BONOTESCRN", NOTEREV_EDIT(), "Notes - SCREEN BACKORDER #"+ORDER_NUM, ,.F.)
ENDIF
SELECT(SV_SEL)
ELSEIF NCHOICE == 2
COMMON_NOTES()
ENDIF
RETURN
*******************************************************
* ORDER SHIPPING HOTKEYS ( TORD_LINES )
*******************************************************
FUNCTION TOL_HOTKEYS(WHICHONE, WHICHSCREEN)
LOCAL RETVAL := {}
IF WHICHONE == 'SHIP'
**AADD(RETVAL, {'F4-Review Order ', K_F4,'CHG_REV_HOTKEY("REV")'})
AADD(RETVAL, {'F4-Review Order ', K_F4,'CHG_REV_HOTKEY(, .T.)'})
AADD(RETVAL, {'F6-Ship Remaining ', K_F6,"SHIP_TOTQTY(,,'ORD_MAST',.F.)" })
AADD(RETVAL, {'F7-Ship Selected ', K_F7,'SHP_SEL()' } )
AADD(RETVAL, {'F8-Review Shipping', K_F8,'SHP_REV()' } )
AADD(RETVAL, {'F9-Print Documents', K_F9, 'CTL_ORDPR()' } )
AADD(RETVAL, {'' , K_F3,'UPD_SHIPADDR()'})
**AADD(RETVAL, {'' , K_F2,'COMMON_NOTES()'})
AADD(RETVAL, {'' , K_F2,'BONOTES()'})
**AADD(RETVAL, {'' , K_F1,'BONOTES()' })
AADD(RETVAL, {'' , K_F1,'REMOVE_ORD_SHIP()' })
ELSEIF WHICHONE == 'OE' //** SHIPPING INFO BROWSE FROM ORDER ENTRY
AADD(RETVAL, {'F3-Shipping Addr.', K_F3,'UPD_SHIPADDR(.T.)'})
AADD(RETVAL, {'F8-Review Shipping', K_F8,'SHP_REV()' } )
ELSE
AADD(RETVAL, {'F4-Review Order ', K_F4,'CHG_REV_HOTKEY("REV")'})
AADD(RETVAL, {'F6-Produce ALL ', K_F6,"PROD_ALL()" }) //** P3N 01/15/02
AADD(RETVAL, {'F7-Produce Selected', K_F7,'PROD_SEL()' } )
AADD(RETVAL, {'F8-Review Production', K_F8,'PROD_REV()' } )
AADD(RETVAL, {'F9-Print Documents', K_F9, 'CTL_ORDPR()' } )
ENDIF
RETURN RETVAL
*******************************************************
* // P3N - 5/21/98
* SHIP SELECTED LINE ITEMS OPTION (F7 - ORDER CONTROL SCREEN-3220)
*******************************************************
FUNCTION PROD_SEL()
LOCAL SVSEL := SELECT()
LOCAL SVSCRN := SAVESCREEN()
ACD_PAR_CHILD( 1 ,'Order Production - Line Item(s) / Order #: '+ ALLTRIM(TORD_LINES->ORDER_NUM), + ;
{ , 'ORD_PROD', .F., 3, 'ADD',,,,, ,.F.,'USERFILE2'})
RESTSCREEN(,,,,SVSCRN)
SELECT(SVSEL)
RETURN
*******************************************************
* // P3N -01/15/02
* PRODUCE ALL LINE ITEMS OPTION (F6 - PRODUCTION CONTROL SCREEN-????)
*******************************************************
FUNCTION PROD_ALL()
LOCAL SVREC := TORD_LINES->(RECNO()), SEEKKEY, DOAUDIT := .T., RETVAL := .T.
LOCAL M1 := 'Production Transactions already exist for Order - ' + TORD_LINES->ORDER_NUM
LOCAL M2 := 'If you continue you will change existing production info!'
LOCAL M3 := SPACE(20)+ 'DO YOU WANT TO CONTINUE?', SEEKOL := ''
TORD_LINES->(DBGOTOP())
DO WHILE TORD_LINES->(!EOF())
SEEKOL := TORD_LINES->ORDER_NUM
SEEKOL := SEEKOL + STR(TORD_LINES->LINE_NUM,3)
SEEKKEY := TORD_LINES->ORDER_NUM
SEEKKEY := SEEKKEY + STR(TORD_LINES->LINE_NUM,3)
SEEKKEY := SEEKKEY + TORD_LINES->PROD_CODE
SEEKKEY := SEEKKEY + TORD_LINES->PAR_PROD
SEEKKEY := SEEKKEY + STR(TORD_LINES->(RECNO()),3)
IF ORD_LINES->(DBSEEK(SEEKOL)) .AND. ORD_LINES->PROD_CODE == TORD_LINES->PROD_CODE
IF ORD_PROD->(DBSEEK(SEEKKEY))
//** REC_LOCK(3, 'ORD_SHIP')
IF PROMPT_BOX(M1, M2, M3)
ELSE
EXIT
ENDIF
ORD_PROD->(REC_LOCK(3))
ELSE
ADD_ONEREC('TORD_LINES', 'ORD_PROD' , DOAUDIT)
ORD_PROD->(REC_LOCK(3))
//**REC_LOCK(3, 'ORD_PROD')
ORD_PROD->TRAN_NUM := STR(TORD_LINES->(RECNO()),3)
ENDIF
ORD_PROD->COMPL_DATE := M->CURDATE
ORD_PROD->COMPL_QTY := TORD_LINES->QUANTITY
ORD_PROD->(DBUNLOCK())
ENDIF
TORD_LINES->(DBSKIP(+1))
ENDDO
TORD_LINES->(DBGOTO(SVREC))
ERR_BOX('The Production has been Updated with Order Quantities',;
' ', 'You MUST now enter the Time for each Item Produced')
RETURN RETVAL
*******************************************************
* // P3N - 5/18/98
* SHIP SELECTED LINE ITEMS OPTION (F7 - ORDER CONTROL SCREEN-3220)
*******************************************************
FUNCTION SHP_SEL()
LOCAL TITLE := 'ORDER SHIPPING' //** P3N - 12/9/98
LOCAL ACTION := GETAVAR('ACTION') //** P3N - 12/9/98
LOCAL SVSEL := SELECT()
LOCAL SVSCRN := SAVESCREEN(), INVSCRN
IF EMPTY((CUR_MAST)->SHIP_DATE) //** P3N - 12/9/98
INVSCRN := SAVESCREEN() //** P3N - 12/9/98
@ 00, 00 CLEAR TO 24,80 //** P3N - 12/9/98
SAYTITLE(TITLE, 'SHIPDT') //** P3N - 12/9/98
GET_INV_SHPDT() //** P3N - 12/9/98
RESTSCREEN(,,,,INVSCRN) //** P3N - 12/9/98
ENDIF //** P3N - 12/9/98
IF EMPTY((CUR_MAST)->ORDER_NEW) //** P3N - 12/9/98
ACTION := 'ADD' //** P3N - 12/9/98
ELSE //** P3N - 12/9/98
ACTION := 'REV' //** P3N - 12/9/98
ENDIF //** P3N - 12/9/98
ACD_PAR_CHILD( 1 ,'Order Shipping - Line Item(s) / Order #: '+ ALLTRIM(TORD_LINES->ORDER_NUM), + ;
{ , 'ORD_SHIP', .F., 3, ACTION,,,,, ,.F.,'USERFILE2'})
//**{ , 'ORD_SHIP', .F., 3, 'ADD' ,,,,, ,.F.,'USERFILE2'})
RESTSCREEN(,,,,SVSCRN)
SELECT(SVSEL)
RETURN
*******************************************************
* // P3N - 5/18/98
* REVIEW SHIPPED ITEMS OPTION (F8 - ORDER CONTROL SCREEN-3220)
*******************************************************
FUNCTION SHP_REV()
LOCAL SVSEL := SELECT()
LOCAL SVSCRN := SAVESCREEN()
ACD_PAR_CHILD( 1 ,'Review Shipping - Order #: ' +ALLTRIM(TORD_LINES->ORDER_NUM), + ;
{ , 'ORD_SHIP', .F., 3, 'REV',,,,,'21360' ,.F.,'USERFILE2'})
RESTSCREEN(,,,,SVSCRN)
SELECT(SVSEL)
RETURN
*******************************************************
* // P3N - 5/22/98
* REVIEW PRODUCED ITEMS OPTION (F8 - ORDER CONTROL SCREEN-3220)
*******************************************************
FUNCTION PROD_REV()
LOCAL SVSEL := SELECT()
LOCAL SVSCRN := SAVESCREEN()
ACD_PAR_CHILD( 1 ,'Review Production - Order #: ' +ALLTRIM(TORD_LINES->ORDER_NUM), + ;
{ , 'ORD_PROD', .F., 3, 'REV',,,,,'22360' ,.F.,'USERFILE2'})
RESTSCREEN(,,,,SVSCRN)
SELECT(SVSEL)
RETURN
*******************************************************
* // P3N - 5/18/98
* SHIPPING PRINT OPTION (F9 - ORDER CONTROL SCREEN-3220)
*******************************************************
FUNCTION CTL_ORDPR()
LOCAL SVSEL := SELECT()
LOCAL SVSCRN := SAVESCREEN()
LOCAL SVREC := (SVSEL)->(RECNO())
LOCAL ORDNUM := (SVSEL)->ORDER_NUM //** P3N - 2/28/00
UPD_BO_TOTAL('ORD_LINES') //** P3N - 11/23/98
UPD_BO_TOTAL('ADDL_LINES') //** P3N - 11/23/98
ALL_ORDPR(,,'OE')
RESTSCREEN(,,,,SVSCRN)
IF (SVSEL)->(USED()) //** P3N - 2/28/00
SELECT(SVSEL)
DBGOTO(SVREC)
ELSE //** P3N - 2/28/00
BLD_TORD_LINES(ORDNUM) //** P3N - 2/28/00
SELECT(SVSEL) //** P3N - 2/28/00
DBGOTO(SVREC) //** P3N - 2/28/00
//** TORD_LINES->(DBGOTOP()) //** P3N - 2/28/00
ENDIF //** P3N - 2/28/00
RETURN
*******************************************************
FUNCTION UPDT_CUST(PACTION)
LOCAL SAVESEL := SELECT()
LOCAL MELEM, CKVAR, MTITLE := 'Browse Customers'
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
MELEM := ASCAN(GETVARS, {|X| X[3] = 'CUST_ID'})
IF MELEM <> 0
**KEYBOARD (SAVESEL)->CUST_ID
**KEYBOARD GETVARS[MELEM, 4]
CKVAR := GETVARS[MELEM, 4]
ELSE
**KEYBOARD (CUR_MAST)->CUST_ID
CKVAR := (CUR_MAST)->CUST_ID
ENDIF
IF EMPTY(CKVAR)
ERR_BOX('*** Specify Customer Number before UPDATE')
ELSEIF EMPTY(PACTION) //** P3N - 3/20/00
KEYBOARD CKVAR
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
ADD_SING_REC(1,'Update CUSTOMER' ,{'CUST_MAST', .F.,,,,,'ADD',,.F.,.F. })
ELSE
ADD_SING_REC(3,'Review CUSTOMER' ,{'CUST_MAST', .F.,,,,,'REV',,.F.,.F. })
ENDIF
ELSEIF PACTION == 'BROWSE' //** P3N - 3/20/00
GBROWSE(,MTITLE,{'CUST_MAST', {'CUST_PRICE'}, .F., }) //** P3N - 3/20/00
F5ORD := 1 //** P3N - 3/20/00
(CUR_MAST)->(DONSETORD(1)) //** P3N - 3/20/00
ENDIF
IF SELECT('USERFILE2') > 0 //P3N 2-5-98 CLOSE USERFILE2 IF LEFT OPEN
SELECT USERFILE2
USE
ENDIF
SELECT (SAVESEL)
RETURN .T.
**********************************************************************
* // P3N - 8/10/98
* SELECT COMMON NOTES (F2 - ORDER CONTROL SCREEN-3220)
**********************************************************************
FUNCTION COMMON_NOTES()
LOCAL NCHOICE := 0
LOCAL MARR := { '1. BILLED SCREENS', ;
'2. PAID SCREENS', ;
'3. BILLED ITEMS ', ;
'4. PAID ITEMS '}
LOCAL MARR2 := { '1. OUR DELIVERY WHEN AVAILABLE' , ;
'2. OUR DELIVERY WHEN NOTIFIED ' , ;
'3. OUR INSTALLATION WHEN NOTIFIED', ;
'4. CUSTOMER PICK UP WHEN AVAILABLE'}
LOCAL MNOTES := { 'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'OUR DELIVERY WHEN AVAILABLE.' , ;
; //** ELM 2
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'OUR DELIVERY WHEN NOTIFIED.' , ;
; //** ELM 3
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'OUR INSTALLATION WHEN NOTIFIED. ' , ;
; //** ELM 4
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'CUSTOMER PICK UP WHEN AVAILABLE. ' , ;
; //** ELM 5
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'OUR DELIVERY WHEN AVAILABLE.' , ;
; //** ELM 6
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'OUR DELIVERY WHEN NOTIFIED.' , ;
; //** ELM 7
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'OUR INSTALLATION WHEN NOTIFIED.' , ;
; //** ELM 8
'SCREENS ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'CUSTOMER PICK UP WHEN AVAILABLE.' , ;
; //** ELM 9
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'OUR DELIVERY WHEN AVAILABLE.' , ;
; //** ELM 10
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'OUR DELIVERY WHEN NOTIFIED.' , ;
; //** ELM 11
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'OUR INSTALLATION WHEN NOTIFIED.' , ;
; //** ELM 12
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE ABOVE BILLING; ' + ;
'CUSTOMER PICK UP WHEN AVAILABLE.', ;
; //** ELM 13
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'OUR DELIVERY WHEN AVAILABLE.' , ;
; //** ELM 14
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'OUR DELIVERY WHEN NOTIFIED.' , ;
; //** ELM 15
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'OUR INSTALLATION WHEN NOTIFIED.' , ;
; //** ELM 16
'ITEMS INDICATED ARE ON BACK ORDER AND ' + ;
'INCLUDED IN THE PAID AMOUNT; ' + ;
'CUSTOMER PICK UP WHEN AVAILABLE.' }
IF CUR_MAST == 'ORD_MAST'
IF EMPTY((CUR_MAST)->NOTES)
NCHOICE = PICKLIST(MARR,10,, 'Select a Note Type')
IF LASTKEY() == 27
ELSEIF NCHOICE == 1
NCHOICE = PICKLIST(MARR2,10,, 'BILLED SCREENS Notes')
IF LASTKEY() == 27
ELSEIF NCHOICE = 1
UPD_COMMON_NOTES(MNOTES[1])
ELSEIF NCHOICE = 2
UPD_COMMON_NOTES(MNOTES[2])
ELSEIF NCHOICE = 3
UPD_COMMON_NOTES(MNOTES[3])
ELSEIF NCHOICE = 4
UPD_COMMON_NOTES(MNOTES[4])
ENDIF
ELSEIF NCHOICE == 2
NCHOICE = PICKLIST(MARR2,10,, 'PAID SCREENS Notes')
IF LASTKEY() == 27
ELSEIF NCHOICE = 1
UPD_COMMON_NOTES(MNOTES[5])
ELSEIF NCHOICE = 2
UPD_COMMON_NOTES(MNOTES[6])
ELSEIF NCHOICE = 3
UPD_COMMON_NOTES(MNOTES[7])
ELSEIF NCHOICE = 4
UPD_COMMON_NOTES(MNOTES[8])
ENDIF
ELSEIF NCHOICE == 3
NCHOICE = PICKLIST(MARR2,10,, 'BILLED ITEMS Notes')
IF LASTKEY() == 27
ELSEIF NCHOICE = 1
UPD_COMMON_NOTES(MNOTES[9])
ELSEIF NCHOICE = 2
UPD_COMMON_NOTES(MNOTES[10])
ELSEIF NCHOICE = 3
UPD_COMMON_NOTES(MNOTES[11])
ELSEIF NCHOICE = 4
UPD_COMMON_NOTES(MNOTES[12])
ENDIF
ELSEIF NCHOICE == 4 //** P3N - 2/23/99
NCHOICE = PICKLIST(MARR2,10,, 'PAID ITEMS Notes')
IF LASTKEY() == 27
ELSEIF NCHOICE = 1
UPD_COMMON_NOTES(MNOTES[13])
ELSEIF NCHOICE = 2
UPD_COMMON_NOTES(MNOTES[14])
ELSEIF NCHOICE = 3
UPD_COMMON_NOTES(MNOTES[15])
ELSEIF NCHOICE = 4
UPD_COMMON_NOTES(MNOTES[16])
ENDIF
ENDIF
ELSE
ERR_BOX(' Notes already exist on this ORDER !' , ;
' USE F4 to Review the Order; ' , ;
' Then F4 again to review the Order Notes.')
ENDIF
ENDIF
RETURN .T.
**********************************************************************
* // P3N - 8/10/98
* UPDATE COMMON NOTES ON THE ORDER MASTER ( CGW0OM->NOTES )
**********************************************************************
FUNCTION UPD_COMMON_NOTES(NOTEVAL)
REC_LOCK(5,CUR_MAST)
(CUR_MAST)->NOTES := '.'+CR_LF(10) + NOTEVAL
(CUR_MAST)->(DBUNLOCK())
RETURN .T.
**********************************************************************
FUNCTION CUST_PE_KEY()
RETURN { CATEGORY->CAT_CODE, USERFILE2->OPTION }
**********************************************************************
// call CUSTOMER ID FOR PRICING EXTRAS
FUNCTION ACD_CUST_PE( )
LOCAL MTITLE
LOCAL SAVESCR := SAVESCREEN(), ACDFILE
LOCAL SAVESEL := SELECT()
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
IF AT('U',(SAVESEL)->PRICE_SHT) = 0
ERR_BOX('*** You Must Include a "U" Option ***', ;
'*** To Access The Customer Price Extras ***')
RETURN .T.
ENDIF
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
MTITLE := 'Price Extras ' + ALLTRIM(CATEGORY->DESC) + ' ' + (SAVESEL)->OPTION
ACD_PAR_CHILD(1, MTITLE, ;
{NIL, 'CUST_PE', .F., , 'ADD',,,,,,.F. , 'USERFILE1'})
ELSE
MTITLE := 'Review Price Extras ' + ALLTRIM(CATEGORY->DESC) + ' ' + (SAVESEL)->OPTION
ACD_PAR_CHILD(3, MTITLE, ;
{NIL, 'CUST_PE', .F., , 'REV',,,,,,.F. , 'USERFILE1'})
ENDIF
SELECT USERFILE1
USE
SELECT (SAVESEL)
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
**********************************************************************
// call catagory option acd
FUNCTION ACD_OPTS( SEEKKEY )
LOCAL MTITLE, MCUSTID := CUST_MAST->CUST_ID
LOCAL SAVESCR := SAVESCREEN(), ACDFILE
LOCAL SAVESEL := SELECT()
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
PRIVATE __SVSEL := SAVESEL //** P3N - 2/19/98
**IF USERFILE2->FIELD_TYPE$'UC'
IF (SAVESEL)->FIELD_TYPE$'UC'
ERR_BOX('*** No Options Available For ***', ;
'*** USER or Math CALCULATION Fields ***')
RETURN .T.
ENDIF
IF SEEKKEY = 'CATEGORY'
ACDFILE := 'CAT_OPTS'
MTITLE := 'CATEORY OPTIONS for ' + (SAVESEL)->ATT_CODE
ELSE
IF SEEKKEY = 'MODEL'
ACDFILE := 'PROD_OPTS'
MTITLE := 'PRODUCT OPTIONS for ' + (SAVESEL)->ATT_CODE
ELSE
IF SEEKKEY = 'CUSTOMER'
ACDFILE := 'CUST_OPTS'
MTITLE := 'CUSTOMER '+MCUSTID+'/'+PROD_CODE+' OPTIONS for ' + (SAVESEL)->ATT_CODE
ENDIF
ENDIF
ENDIF
IF SELECT( ACDFILE ) = 0
**DBOPEN( ACDFILE, .T. )
DBOPEN( ACDFILE )
ENDIF
PRIVATE __WHEREFROM := WHATLVL(SEEKKEY) //** P3N - 4/9/98
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
ACD_PAR_CHILD(1, MTITLE, ;
{NIL, ACDFILE, .T., , 'ADD',,,,,,.F. , 'USERFILE1'})
ELSE
ACD_PAR_CHILD(3, 'Review '+MTITLE, ;
{NIL, ACDFILE, .T., , 'REV',,,,,,.F. , 'USERFILE1'})
ENDIF
SELECT USERFILE1
USE
SELECT (SAVESEL)
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
**********************************************************************
// DISPLAY THE WHEREFROM MESSAGE BASED ON PRIVATE VARIABLE INITIALIZED ABOVE
**********************************************************************
FUNCTION WHEREMSG(CMD)
LOCAL RETVAL := '' //** P3N - 2/19/98
IF EMPTY(CMD) //** P3N - 2/19/98
RETVAL := 'These Options Are From the ' + __WHEREFROM + ' Level '
ELSEIF CMD = 'SET' //** P3N - 2/19/98
SETCOLOR(HREV) //** P3N - 2/19/98
RETVAL := 'NOSAY' //** P3N - 2/19/98
ELSEIF CMD = 'RESET' //** P3N - 2/19/98
SETCOLOR(LNOR) //** P3N - 2/19/98
ENDIF //** P3N - 2/19/98
RETURN RETVAL //** P3N - 2/19/98
**********************************************************************
//** P3N - 4/9/98
// DETERMINE THE LEVEL OF THE ATTRIBUTE OPTIONS.
// (IE: PRODUCT/MODEL LVL OR CATEGORY LVL OR SYSTEM/ATTRIBUTE LVL)
**********************************************************************
FUNCTION WHATLVL(LVL) //** P3N - 4/9/98
LOCAL RETVAL := 'SYSTEM' // DEFAULT - IF NOT FOUND ANYWHERE ELSE THIS APPLIES!
LOCAL PRODKEY, CATKEY, CUSTKEY
IF LVL = 'CUSTOMER' // START AT THE CUSTOMER LVL AND WORK UP!
CUSTKEY := CUST_MAST->CUST_ID + USERFILE3->PROD_CODE + ATT_CODE
PRODKEY := USERFILE3->PROD_CODE + ATT_CODE
CATKEY := PRODUCT->CAT_CODE + ATT_CODE
IF CUST_OPTS->(DBSEEK(CUSTKEY))
RETVAL := 'CUSTOMER'
ELSEIF PROD_OPTS->(DBSEEK(PRODKEY))
RETVAL := 'PRODUCT'
ELSEIF CAT_OPTS->(DBSEEK(CATKEY))
RETVAL := 'CATEGORY'
ENDIF
ELSEIF LVL = 'MODEL' // START AT THE MODEL/PROD LVL AND WORK UP!
PRODKEY := PROD_CODE + ATT_CODE
CATKEY := PRODUCT->CAT_CODE + ATT_CODE
IF PROD_OPTS->(DBSEEK(PRODKEY))
RETVAL := 'PRODUCT'
ELSEIF CAT_OPTS->(DBSEEK(CATKEY))
RETVAL := 'CATEGORY'
ENDIF
ELSEIF LVL = 'CATEGORY' // START AT THE CATEGORY LEVEL AND WORK UP!
CATKEY := CAT_CODE + ATT_CODE
IF CAT_OPTS->(DBSEEK(CATKEY))
RETVAL := 'CATEGORY'
ENDIF
ENDIF
RETURN RETVAL
**********************************************************************
// SET THE PICKUP, DELIVERY, INSTALLATION FLAG FROM THE SHIP CODE
**********************************************************************
FUNCTION SET_PICKDEL( SEEKKEY )
LOCAL I
LOCAL MVAL := ASCAN(GETVARS, {|X| X[3] = 'PICK_DEL'})
LOCAL CUR_SHIP_CODE := GET_PDI_CODE(SEEKKEY)
GETVARS[MVAL,4] := CUR_SHIP_CODE
RETURN .T.
**************************************************************
FUNCTION GET_PDI_CODE(SEEKKEY) //PICKUP/DEL/INSTALL CODE?
**************************************************************
IF ASCAN(MDEL_SHIP, {|X| X == SEEKKEY } ) > 0 //SHIP CODE DELIVERY
RETURN 'D'
ELSE
IF ASCAN(MPU_SHIP, {|X| X == SEEKKEY } ) > 0 //SHIP CODE PICKUP
RETURN 'P'
ELSE
IF ASCAN(MINST_SHIP, {|X| X == SEEKKEY } ) > 0 //SHIP CODE INSTALLED
RETURN 'I'
ELSE
RETURN '?'
ENDIF
ENDIF
ENDIF
**********************************************************************
//* VERIFY THAT THE CUSTOMER IS NOT A PRE-PAY CUSTOMER
**********************************************************************
FUNCTION PRE_PAY_CUST( SEEKKEY )
LOCAL RETVAL
****IF !NEWREC // CHANGE ON A CONVERTED QUOTE
***** RETURN .F. // NOT A PREPAY PERSON WHEN THIS HAPPENS
****ENDIF
IF EMPTY((CUR_MAST)->QUOTE_NUM) // CHANGE ON A CONVERTED QUOTE
ELSE
RETVAL := .F. // NOT A PREPAY PERSON WHEN THIS HAPPENS
ENDIF
IF EMPTY(ORD_MAST->TERMS)
CUST_MAST->(DBSEEK( SEEKKEY ) )
IF ASCAN(MPREPAYCODE, {|X| X == CUST_MAST->TERMS } ) = 0 // TERMS CODE NOT IN LIST
RETVAL := .F.
ELSE
ERR_BOX('*** This Customer has been assigned a ***', ;
'*** TERMS CODE of PRE-PAY ORDERS ONLY; ***', ;
'*** PRESS F12 to Override the TERMS! ***')
IF LASTKEY() = K_F12
IF MHOME_LOC_CODE = 'IOLA' // PER DARLENES REQUEST - 4/21/98
RETVAL := .T. // DO NOT ALLOW OVERRIDE - P3N
ELSE
PRE_PAY_TERMS()
RETVAL := .F.
ENDIF
ENDIF
RETVAL := .T.
ENDIF
ELSE
RETVAL := .F.
ENDIF
IF RETVAL //** P3N - 12/22/00
ELSE //** P3N - 12/22/00
RETVAL := CK_CRLIMIT() //** P3N - 12/22/00
ENDIF //** P3N - 12/22/00
RETURN RETVAL
**********************************************************************
//* P3N - 12/22/00
//* CHECK TO SEE IF THIS CUSTOMER HAS EXCEEDED HIS CREDIT LIMIT???
**********************************************************************
FUNCTION CK_CRLIMIT()
LOCAL RETVAL := .F.
LOCAL WKLIMIT := CUST_MAST->CREDIT_LIM, WKAMT := 0
IF EMPTY(WKLIMIT)
ELSE
WKAMT := UNSHIPPED_ORDAMT()
IF WKAMT >= WKLIMIT
RETVAL := .T.
ERR_BOX('*** Customer Credit Limit is - ' + STR(WKLIMIT,12,2), ;
'*** ALL Unshipped Orders total - ' + STR(WKAMT, 12,2), ;
'*** Press F12 to Make this Order! ***')
IF LASTKEY() == K_F12
RETVAL := .F.
ENDIF
ENDIF
ENDIF
RETURN RETVAL
**********************************************************************
//* P3N - 12/26/00 - MERRY X-MAS 2000
//* SUM ALL ORDERS FOR THIS CUSTOMER WHICH HAVE BEEN INVOICED
//* AND HAVE NOT BEEN SHIPPED
**********************************************************************
FUNCTION UNSHIPPED_ORDAMT()
LOCAL SVREC := (CUR_MAST)->(RECNO()), SVSEL := SELECT()
LOCAL SVORD := (CUR_MAST)->(DONSETORD(2)) //** CUST# ORDER
LOCAL SEEKKEY := CUST_MAST->CUST_ID
LOCAL RETVAL := 0
DBOPEN('ORD_SHIP')
IF (CUR_MAST)->(DBSEEK(SEEKKEY))
DO WHILE (CUR_MAST)->(!EOF()) .AND. ;
(CUR_MAST)->CUST_ID == SEEKKEY
IF EMPTY( (CUR_MAST)->IDATE_FST ) //** ORDER HAS BEEN INVOICED
IF ORD_SHIP->(DBSEEK( (CUR_MAST)->ORDER_NUM ) )
IF EMPTY(ORD_SHIP->SHIP_DATE)
RETVAL := RETVAL + (CUR_MAST)->TOTAL_AMT
ELSEIF ORD_SHIP->SHIP_DATE >= M->CURDATE
RETVAL := RETVAL + (CUR_MAST)->TOTAL_AMT
ENDIF
ELSE
RETVAL := RETVAL + (CUR_MAST)->TOTAL_AMT
ENDIF
ENDIF
(CUR_MAST)->(DBSKIP(+1))
ENDDO
ENDIF
CLOSE ORD_SHIP
(CUR_MAST)->(DONSETORD(SVORD))
(CUR_MAST)->(DBGOTO(SVREC))
SELECT(SVSEL)
RETURN RETVAL
**********************************************************************
//* IF THE CUSTOMER IS PRE-PAY CUSTOMER - F12 TO OVERRIDE THE TERMS!
**********************************************************************
FUNCTION PRE_PAY_TERMS()
LOCAL I := ASCAN(GETVARS, {|X| X[3] == 'TERMS'})
LOCAL OGET, DROW, DCOL, SVCOLOR
VAL_LOOKUP( GETVARS[I,4], 'TERMS', I, {'Code','Desc'}, 'N', .T.)
IF EMPTY(GETLIST)
RETURN .F.
ENDIF
OGET := GETLIST[I]
DROW := OGET:ROW
DCOL := OGET:COL
**SVCOLOR := SETCOLOR(NEWCOLOR)
@DROW, DCOL SAY GETVARS[I,4]
@DROW, DCOL-1 GET GETVARS[I,4]
**SETCOLOR(SVCOLOR)
REC_LOCK()
REPLACE TERMS WITH GETVARS[I,4]
UNLOCK
RETURN .T.
**********************************************************************
// send data to another location for model setups, etc.
**********************************************************************
FUNCTION SEND_RECV(OPTION, TITLE, WHICH_FILE, ACTION)
LOCAL FILELIST := {}
CLS
SAYTITLE(TITLE, 'SENDDATA')
ERR_BOX('*** ALL PROCESSING ASSUMES That the TRANSFER DATA',;
'*** Will Be READ From and WRITTEN to the ', ;
'*** "DATA" Sub-directory Below This Directory')
DO CASE
CASE WHICH_FILE = 'ATT'
AADD(FILELIST,'ATTRIBUTES')
AADD(FILELIST,'ATT_OPTS')
CASE WHICH_FILE = 'CUT'
AADD(FILELIST,'ATTRIB_CUT')
CASE WHICH_FILE = 'CAT'
AADD(FILELIST,'CATEGORY')
AADD(FILELIST,'CAT_ATTS')
AADD(FILELIST,'CAT_OPTS')
AADD(FILELIST,'PRI_EXTRAS')
AADD(FILELIST,'MATHPACK')
CASE WHICH_FILE = 'MODEL'
AADD(FILELIST,'PRODUCT')
AADD(FILELIST,'PROD_ATTS')
AADD(FILELIST,'PROD_OPTS')
AADD(FILELIST,'STD_SIZES')
AADD(FILELIST,'CUT_SPEC')
AADD(FILELIST,'MATHPACKP')
CASE WHICH_FILE = 'RULE'
AADD(FILELIST,'RULES')
AADD(FILELIST,'RULEPACK')
OTHERWISE
RETURN
ENDCASE
DO CASE
CASE ACTION = "SEND"
PRO_SEND(WHICH_FILE, FILELIST)
CASE ACTION = "ZAP"
PRO_ZAP(WHICH_FILE, FILELIST)
CASE ACTION = "REVU"
PRO_REVU(WHICH_FILE, FILELIST, NIL , 'TEMP')
CASE ACTION = "RECV"
PRO_RECV(WHICH_FILE, FILELIST)
ENDCASE
CLOSE DATABASES
RETURN
**********************************************************************
**********************************************************************
**********************************************************************
FUNCTION PRO_RECV(WHICH_FILE, FILELIST)
LOCAL DRIVEFILE := FILELIST[1]
LOCAL TOFILE
LOCAL I, FILEOPEN := .F.
LOCAL DRIVEPARM
LOCAL FILEPARMS, DATAFILE, FILEKEY, PERMKEY, MGET_KEY, PTABLE_ARR
LOCAL PICKARR := {'Receive SELECTED ' + FILELIST[1], 'Receive ALL ' + FILELIST[1]}
LOCAL NCHOICE := PICKLIST(PICKARR, 8, , 'Select Your Choice')
LOCAL OVERWRITE
LOCAL M1 := '*** ABOUT TO UPDATE Your Setup Data '
LOCAL M2, SAVEREC
LOCAL M3 := '*** Do You WISH TO CONTINUE? '
LOCAL SELARR := {}, SELCHOICE := 0
LOCAL CORR
IF LASTKEY() = 27
RETURN
ENDIF
M1 := '*** If Data EXISTS on THIS COMPUTER '
M2 := '*** Should It Be UPDATED WITH NEW DATA???'
M3 := ' '
IF PROMPT_BOX(M1,M2,M3)
OVERWRITE := .T.
ELSE
OVERWRITE := .F.
ENDIF
IF LASTKEY() = 27
RETURN
ENDIF
CORR := CORRCHEK()
IF CORR <> 'Y'
RETURN
ENDIF
FILEPARMS := GET_FILEPARMS(DRIVEFILE)
DATAFILE := 'DATA\' + STRTRAN(ALLTRIM(FILEPARMS[8]), '0', '_')
FILEKEY := FILEPARMS[4,1]
PERMKEY := MAKE_BLOCK(FILEKEY)
IF FILE(DATAFILE + '.DBF')
NET_USE( DATAFILE, .T., 3, 'DATAFILE')
GOTO TOP
DO WHILE !EOF()
AADD(SELARR, EVAL(PERMKEY) )
SKIP 1
ENDDO
ENDIF
IF LEN(SELARR) = 0
ERR_BOX('*** NO RECORDS FOUND TO RECEIVE ***')
RETURN NIL
ENDIF
IF NCHOICE = 1 // SELECTED UPDATES
DO WHILE .T.
@ 2,0 CLEAR
// OPEN TEMPORARY FILE UNDER REAL FILE ALIAS
SELCHOICE := PICKLIST(SELARR, 8, , 'Select Item to Receive',,,.T.)
IF LASTKEY() = 27
RETURN NIL
ENDIF
MGET_KEY := SELARR[SELCHOICE]
USE
RECV_DATA(MGET_KEY, FILELIST, OVERWRITE, PERMKEY, WHICH_FILE)
RETURN
ENDDO
ELSE
SELECT DATAFILE
GOTO TOP
DO WHILE !EOF() // DATAFILE
IF NEXTKEY() = 27
EXIT
ELSE
CLEAR TYPEAHEAD
ENDIF
SAVEREC := RECNO()
MGET_KEY := EVAL(PERMKEY)
@ 10,10 SAY 'PROCESSING : ' + MGET_KEY + SPACE(10)
RECV_DATA(MGET_KEY, FILELIST, OVERWRITE, PERMKEY, WHICH_FILE)
NET_USE( DATAFILE, .T., 3, 'DATAFILE')
GOTO SAVEREC
SKIP 1
ENDDO
RETURN
ENDIF
**************************************************************
**************************************************************
**************************************************************
FUNCTION RECV_DATA(MGET_KEY, FILELIST, OVERWRITE, PERMKEY, WHICH_FILE)
LOCAL DATAFILE, FILEPARMS
LOCAL I, SEEKKEY, OLDLOC, OLDGL
LOCAL OLDPERMKEY := PERMKEY
LOCAL DRIVEFILE
FOR I := 1 TO LEN(FILELIST)
IF FILELIST[I] = 'MATHPACKP'
DRIVEFILE := 'MATHPACK'
ELSE
DRIVEFILE := FILELIST[I]
ENDIF
FILEPARMS := DBOPEN(DRIVEFILE, .T.)
FILEKEY := FILEPARMS[9,1]
PERMKEY := MAKE_BLOCK(FILEKEY)
DATAFILE := 'DATA\' + STRTRAN(ALLTRIM(FILEPARMS[8]), '0', '_')
IF FILE(DATAFILE+'.DBF') //** P3N- 2/19/98
//FILE FOUND CONTINUE
ELSE
LOOP // BYPASS - NO FILE TO PROCESS
ENDIF
NET_USE( DATAFILE, .T., 3, 'DATAFILE')
WAIT_BOX('*** Processing File ' + DRIVEFILE , ;
' ' , ;
'*** Please Wait')
SELECT DATAFILE
SET FILTER TO EVAL(PERMKEY) = MGET_KEY
GOTO TOP
DO WHILE !EOF()
SEEKKEY := EVAL(PERMKEY)
SELECT (DRIVEFILE)
SEEK SEEKKEY
IF !FOUND()
ADD_ONEREC( 'DATAFILE', DRIVEFILE )
ELSE
IF OVERWRITE
IF DRIVEFILE = 'PRODUCT'
OLDLOC := LOC_CODE
OLDGL := GL_NUM
ENDIF
REP_ONEREC( 'DATAFILE', DRIVEFILE )
IF DRIVEFILE = 'PRODUCT'
REPLACE PRODUCT->LOC_CODE WITH OLDLOC
REPLACE PRODUCT->GL_NUM WITH OLDGL
ENDIF
ELSE
// GET OUT - DON'T UPDATE ANY SUBORDINATE RECORDS
IF I = 1
I := LEN(FILELIST)
SELECT DATAFILE
GOTO BOTTOM
ENDIF
ENDIF
ENDIF
SELECT DATAFILE
SKIP 1
ENDDO
SELECT (DRIVEFILE)
USE
SELECT DATAFILE
USE
NEXT
IF WHICH_FILE = 'MODEL'
PTABLE_ARR := DIRECTORY( 'DATA\?' + ALLTRIM(MGET_KEY) + '.DB_')
FOR I := 1 TO LEN(PTABLE_ARR)
FRFILE := ALLTRIM(PTABLE_ARR[I,1])
TOFILE := FRFILE
TOFILE := SUBS(TOFILE, 1, LEN(TOFILE) - 4) + '.DBF'
FRFILE := 'DATA\' + ALLTRIM(PTABLE_ARR[I,1])
IF !FILE(TOFILE) .OR. OVERWRITE
COPY FILE (FRFILE) TO (TOFILE)
ENDIF
NEXT
ENDIF
RETURN
**********************************************************************
FUNCTION PRO_SEND(WHICH_FILE, FILELIST)
LOCAL DRIVEFILE := FILELIST[1]
LOCAL FILEPARMS, TOFILE
LOCAL MGET_KEY, FILEKEY
LOCAL DATAFILE
LOCAL M1, M2, M3, I
LOCAL PERMKEY, DRIVEPARM, PTABLE_ARR
LOCAL PICKARR := {'Send SELECTED ' + FILELIST[1], 'Send ALL ' + FILELIST[1]}
LOCAL NCHOICE := PICKLIST(PICKARR, 8, , 'Select Your Choice')
IF NCHOICE = NIL .OR. LASTKEY() = 27
RETURN NIL
ENDIF
FILEPARMS := DBOPEN(DRIVEFILE, .T.)
FILEKEY := FILEPARMS[4,1]
PERMKEY := MAKE_BLOCK(FILEKEY)
IF NCHOICE = 1
DO WHILE .T.
@ 2,0 CLEAR
// OPEN TEMPORARY FILE UNDER REAL FILE ALIAS
MGET_KEY := GET_KEY(FILEPARMS)
IF LASTKEY() = 27 .OR. MGET_KEY = NIL
RETURN NIL
ENDIF
USE
SEND_DATA(MGET_KEY, FILELIST, PERMKEY, WHICH_FILE)
DBOPEN(DRIVEFILE, .T.)
ENDDO
ELSE
DO WHILE !EOF() // DATAFILE
IF NEXTKEY() = 27
EXIT
ELSE
CLEAR TYPEAHEAD
ENDIF
SAVEREC := RECNO()
MGET_KEY := EVAL(PERMKEY)
@ 10,10 SAY 'PROCESSING : ' + MGET_KEY + SPACE(10)
SEND_DATA(MGET_KEY, FILELIST, PERMKEY, WHICH_FILE)
FILEPARMS := DBOPEN(DRIVEFILE, .T.)
GOTO SAVEREC
SKIP 1
ENDDO
ENDIF
****************************************************************
FUNCTION SEND_DATA(MGET_KEY, FILELIST, PERMKEY, WHICH_FILE)
LOCAL I, SEEKKEY
LOCAL FILEPARMS := DBOPEN(FILELIST[1], .T.)
LOCAL DATAFILE := 'DATA\' + STRTRAN(ALLTRIM(FILEPARMS[8]), '0', '_')
LOCAL OLDPERMKEY := PERMKEY
IF !FILE(DATAFILE + '.DBF')
**COPY STRUCT TO &DATAFILE
COPYSTRUCT(DATAFILE, .T. ) // DELETE CDX
ELSE
IF SELECT(DATAFILE) > 0
SELECT (DATAFILE)
USE
ENDIF
ENDIF
NET_USE( DATAFILE, .T., 3, 'DATAFILE')
LOCATE FOR EVAL(PERMKEY) == MGET_KEY
IF FOUND()
M1 := '*** This Record is ALREADY IN THE SEND FILE.'
M2 := '*** The NEW DATA will OVERWRITE the OLD DATA.'
M3 := '*** Do You WISH TO CONTINUE FOR ' + MGET_KEY
IF !PROMPT_BOX(M1,M2,M3)
RETURN
ENDIF
ENDIF
FOR I := 1 TO LEN(FILELIST)
WAIT_BOX('*** Processing File ' + FILELIST[I] , ;
' ' , ;
'*** Please Wait')
DRIVEFILE := FILELIST[I]
IF DRIVEFILE = 'MATHPACKP' // PRODUCT MATH CUTTING PACKS
DRIVEFILE := 'MATHPACK'
PERMKEY := MAKE_BLOCK( 'CAT_CODE' )
ELSE
PERMKEY := OLDPERMKEY
ENDIF
DRIVEPARM := DBOPEN(DRIVEFILE)
DATAFILE := 'DATA\' + STRTRAN(ALLTRIM(DRIVEPARM[8]), '0', '_')
IF !FILE(DATAFILE + '.DBF')
COPYSTRUCT(DATAFILE) // DEL CDX
ENDIF
IF SELECT('DATAFILE') > 0
SELECT ('DATAFILE')
USE
ENDIF
NET_USE( DATAFILE, .T., 3, 'DATAFILE')
LOCATE FOR EVAL(PERMKEY) == MGET_KEY
IF FOUND()
DELETE ALL FOR EVAL(PERMKEY) == MGET_KEY
PACK
ENDIF
SELECT (DRIVEFILE)
SEEK MGET_KEY
DO WHILE EVAL(PERMKEY) == MGET_KEY .AND. !EOF()
ADD_ONEREC( DRIVEFILE, 'DATAFILE' )
SELECT (DRIVEFILE)
SKIP 1
ENDDO
SELECT DATAFILE
USE
SELECT (DRIVEFILE)
USE
NEXT
IF WHICH_FILE = 'MODEL'
WAIT_BOX('*** Processing Price Files ', ;
'*** For Model ' + MGET_KEY , ;
'*** Please Wait')
PTABLE_ARR := DIRECTORY( '?' + ALLTRIM(MGET_KEY) + '.DBF')
FOR I := 1 TO LEN(PTABLE_ARR)
FRFILE := ALLTRIM(PTABLE_ARR[I,1])
TOFILE := 'DATA\' + FRFILE
TOFILE := SUBS(TOFILE, 1, LEN(TOFILE) - 4) + '.db_'
COPY FILE (FRFILE) TO (TOFILE)
NEXT
ENDIF
RETURN
**********************************************************************
FUNCTION PRO_ZAP(WHICH_FILE, FILELIST)
LOCAL DRIVEFILE, DRIVEPARM, DATAFILE1, DATAFILE2
LOCAL FILEPARMS, TOFILE
LOCAL I, PTABLE_ARR, RETCODE
LOCAL M1 := '*** ABOUT TO ERASE Transfer Data for ' + FILELIST[1]
LOCAL M2 := ' '
LOCAL M3 := '*** Do You WISH TO CONTINUE? '
IF !PROMPT_BOX(M1,M2,M3)
RETURN
ENDIF
FOR I := 1 TO LEN(FILELIST)
WAIT_BOX('*** Processing File ' + FILELIST[I] , ;
' ' , ;
'*** Please Wait')
DRIVEFILE := FILELIST[I]
IF DRIVEFILE = 'MATHPACKP'
DRIVEFILE := 'MATHPACK'
ENDIF
DRIVEPARM := DBOPEN(DRIVEFILE)
DATAFILE1 := 'DATA\' + STRTRAN(ALLTRIM(DRIVEPARM[8]),'0', '_') + '.DBF'
IF FILE(DATAFILE1)
RETCODE := FERASE( DATAFILE1 )
IF RETCODE = -1
ERR_BOX('*** ERASE ERROR ON ' + DATAFILE1)
ELSE
// CHECK FOR DBT
DATAFILE2 := 'DATA\' + STRTRAN(ALLTRIM(DRIVEPARM[8]),'0', '_') + '.DBT'
IF FILE( DATAFILE2 )
RETCODE := FERASE( DATAFILE2 )
IF RETCODE = -1
ERR_BOX('*** ERASE ERROR ON ' + DATAFILE2)
ENDIF
ENDIF
ENDIF
ENDIF
NEXT
IF WHICH_FILE = 'MODEL'
PTABLE_ARR := DIRECTORY( 'DATA\*.db_')
FOR I := 1 TO LEN(PTABLE_ARR)
TOFILE := ALLTRIM(PTABLE_ARR[I,1])
RETCODE := FERASE( 'DATA\' + TOFILE )
IF RETCODE = -1
ERR_BOX('*** ERASE ERROR ON ' + TOFILE )
ENDIF
NEXT
ENDIF
RETURN
**********************************************************************
FUNCTION PRO_REVU(WHICH_FILE, FILELIST, PERMKEY, REAL_TEMP)
LOCAL RETVAL
LOCAL DRIVEFILE := FILELIST[1]
LOCAL FILEPARMS := GET_FILEPARM(DRIVEFILE)
LOCAL DATAFILE
IF REAL_TEMP = 'TEMP'
DATAFILE := 'DATA\' + STRTRAN(ALLTRIM(FILEPARMS[8]), '0', '_')
ELSE
DATAFILE := ALLTRIM(FILEPARMS[8])
ENDIF
IF !FILE(DATAFILE + '.DBF' )
ERR_BOX( '*** No Data To REVIEW ***', ' ', ' ')
ELSE
NET_USE( DATAFILE, .T., 3, DRIVEFILE )
GBROWSE(1, 'Review Transfer ' + DRIVEFILE, DRIVEFILE)
IF LASTKEY() = 13 .AND. PERMKEY <> NIL
RETVAL := EVAL(PERMKEY)
ENDIF
SELECT (DRIVEFILE)
USE
ENDIF
RETURN RETVAL
**********************************************************************
* ONLY 1 PRICING METHOD ALLOWED
**********************************************************************
FUNCTION DEL_ATT_OPTS(PASSVAL, MALIAS, ACTION)
LOCAL SAVESEL := SELECT(), SEEKNAME, I
LOCAL DELREC := .F., DELARR := {}
STATIC SEEKKEY
IF ACTION = 'SET'
SEEKKEY := ATT_CODE
RETURN .T.
ENDIF
IF !EMPTY(PASSVAL) // DELETED RECORD
RETURN .T.
ENDIF
IF MALIAS = 'PROD_OPTS'
SEEKNAME = 'PROD_CODE + ATT_CODE'
SEEKKEY := PRODUCT->PROD_CODE + SEEKKEY
ELSE
IF MALIAS = 'CAT_OPTS'
SEEKNAME = 'CAT_CODE + ATT_CODE'
SEEKKEY := CATEGORY->CAT_CODE + SEEKKEY
ELSE
IF MALIAS = 'CUST_OPTS'
SEEKNAME = 'CUST_ID + PROD_CODE + ATT_CODE'
SEEKKEY := CUST_MAST->CUST_ID + USERFILE3->PROD_CODE + SEEKKEY
ENDIF
ENDIF
ENDIF
IF SELECT( MALIAS ) = 0
DBOPEN(MALIAS, .T.)
ENDIF
SELECT (MALIAS)
SEEK SEEKKEY
DO WHILE &SEEKNAME == SEEKKEY .AND. !EOF()
REC_LOCK(1)
DELETE
DELREC := .T.
AADD(DELARR, RECNO() )
SKIP 1
ENDDO
IF DELREC
WAIT_BOX('*** COMPRESSING OPTION FILE ***', ;
'*** Please Wait ***')
FOR I := 1 TO LEN(DELARR)
GOTO DELARR[I]
REC_LOCK(1)
REPLACE ATT_CODE WITH ' '
NEXT
**PACK
ENDIF
SELECT (SAVESEL)
RETURN .T.
**********************************************************************
* ONLY 1 PRICING METHOD ALLOWED
**********************************************************************
FUNCTION CK_PRICE_METH()
LOCAL NUMX := 0
IF UNIT_PR = 'X'
NUMX ++
ENDIF
IF UI_PR = 'X'
NUMX ++
ENDIF
IF SQFT_PR = 'X'
NUMX ++
ENDIF
IF !UNIT_PR$'X '
RETURN .F.
ENDIF
IF !UI_PR$'X '
RETURN .F.
ENDIF
IF !SQFT_PR$'X '
RETURN .F.
ENDIF
IF NUMX > 1
ERR_BOX('*** You May Select ONLY 1 PRICE METHOD ***')
RETURN .F.
ELSE
RETURN .T.
ENDIF
**********************************************************************
* SPECIAL CUSTOMER PRICING SCREENS SET CUSTOMER ID
**********************************************************************
* DETERMINE IF ALT MFG LOCATION WAS ENTERED ELSE GET RULE
**********************************************************************
FUNCTION CK_ALTMFG_LOC(ALTMFGLOC)
IF EMPTY(ALTMFGLOC)
KEYBOARD SPACE(6) + CHR(13)
ENDIF
RETURN .T.
**********************************************************************
* GET THE SALES TAX RATE
**********************************************************************
FUNCTION CALC_STAX(RATETABLE, ASSGN_VALU )
LOCAL TAXPCT := 00.0000
LOCAL MVAL
IF ASSGN_VALU = NIL
ASSGN_VALU := .T.
ENDIF
IF MVAL = NIL .AND. ASSGN_VALU
MVAL := ASCAN(GETVARS, {|X| X[3] = 'SLS_TX_PCT'})
ENDIF
**TAXPCT := VAL(STR(STAX_RATE(NIL, 2 ),7,4))
TAXPCT := VAL( STR ( STAX_RATE ( RATETABLE, 2 ) , 7, 4 ) )
IF ASSGN_VALU
GETVARS[MVAL,4] := TAXPCT
RETURN .T.
ELSE
RETURN TAXPCT
ENDIF
**********************************************************************
* GET THE SALES TAX RATE
**********************************************************************
FUNCTION STAX_RATE( RATETABLE, RETELEM, USEARRAY, RECVALS )
LOCAL SEEKKEY, TAXPCT := 0, SAVESEL := SELECT()
LOCAL I, VAR, DETARR, ADDVAR, II, SEQVAR, NEXTSEEK, CURRATE := 0.00
LOCAL ELEM, DET_LINE, RETVAL, CURDESC := '', MPD
LOCAL MBILL_STATE, MSHIP_STATE, MVAL, MSTATE
LOCAL DETAILARR := {}, SELFILE
// RATE ARR[SCH_NAME, SCH_PERCENT, SCH_DESC, DETAILARR ]
STATIC RATE_ARR := {}
IF RECVALS = NIL
RECVALS := .F.
ENDIF
IF USEARRAY = NIL
USEARRAY := .T.
SELFILE := 'TAX_SCHED'
ELSE
SELFILE := SELECT()
ENDIF
IF !USEARRAY
RATE_ARR := {}
ENDIF
// WHAT IS RATE TABLE DURING PRINT ORDER TIME??
IF RATETABLE = NIL // ORDER ENTRY TIME AND REPORT TIME
SEEKKEY := ALLTRIM(CUST_MAST->TAXSCH)
// DON'T MESS WITH TAX EXEMPT
IF SEEKKEY == 'EXTAX'
ELSE
IF RECVALS
MPD = (CUR_MAST)->PICK_DEL
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'PICK_DEL'})
MPD := GETVARS[MVAL, 4]
ENDIF
****IF GETVARS[MVAL,4]$'P'
IF MPD$'P' // Pickup Order
SEEKKEY := MPICKUPTAX
ELSE
IF RECVALS
MSTATE:= CNV_ADDR((CUR_MAST)->SHIP_CSZ, 'STATE')
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'SHIP_CSZ'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
IF MSTATE = NIL
IF RECVALS
MSTATE:= CNV_ADDR((CUR_MAST)->SHIP_ADD2, 'STATE')
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'SHIP_ADD2'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
IF MSTATE = NIL
IF RECVALS
MSTATE:= CNV_ADDR((CUR_MAST)->SHIP_ADD1, 'STATE')
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'SHIP_ADD1'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
IF MSTATE = NIL
IF RECVALS
MSTATE:= CNV_ADDR((CUR_MAST)->SHIP_ADD1, 'STATE' )
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'SHIP_NAME'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
ENDIF
ENDIF
IF MSTATE == NIL // NO VALID ADDRESS FOR SHIPPING ADDRESS
IF RECVALS // CHECK THE BILLING ADDRESS
MSTATE:= CNV_ADDR((CUR_MAST)->BILL_CSZ, 'STATE')
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'BILL_CSZ'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
IF MSTATE == NIL
IF RECVALS
MSTATE:= CNV_ADDR((CUR_MAST)->BILL_ADD2, 'STATE' )
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'BILL_ADD2'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
ENDIF
IF MSTATE == NIL
IF RECVALS
MSTATE:= CNV_ADDR((CUR_MAST)->BILL_ADD1, 'STATE' )
ELSE
MVAL := ASCAN(GETVARS, {|X| X[3] = 'BILL_ADD1'})
IF MVAL > 0
MSTATE := CNV_ADDR(GETVARS[MVAL,4] , 'STATE' )
ENDIF
ENDIF
ENDIF
ENDIF
// THIS COULD COME FROM ORDER MASTER???
IF MSTATE <> NIL .AND. MSTATE <> CUST_MAST->CUST_STATE
SEEKKEY := MSTATE + 'TAX'
ENDIF
ENDIF
ENDIF
ENDIF
ELSE
SEEKKEY := RATETABLE
ENDIF
SEEKKEY := ALLTRIM(SEEKKEY)
ELEM := ASCAN( RATE_ARR, { |X| X[1] == SEEKKEY } )
IF ELEM > 0
IF RETELEM = NIL
RETURN RATE_ARR[ELEM]
ELSE
RETURN RATE_ARR[ELEM, RETELEM]
ENDIF
ENDIF
SELECT (SELFILE)
IF USEARRAY
SEEKKEY := ALLTRIM(SEEKKEY)
**LOCATE FOR ALLTRIM(STAXSCH) == SEEKKEY
SEEK SEEKKEY
ENDIF
IF !USEARRAY .OR. FOUND()
CURDESC := (SELFILE)->DESC
FOR II := 1 TO 10
SEQVAR := 'SEQ' + ALLTRIM(STR(II))
NEXTSEEK := &SEQVAR
IF NEXTSEEK <> 0
SELECT TAX_DETAIL
SEEK STR(NEXTSEEK,3)
IF FOUND()
CURRATE := CURRATE + (STAXAMT * 100)
AADD(DETAILARR, { STAXAMT, ' ', GL_NUM, SSTAXSEQ }) //** P3N - 01/24/07
//** AADD(DETAILARR, { STAXAMT, ' ', GL_NUM })
ENDIF
SELECT (SELFILE)
ENDIF
NEXT
ADDVAR := { ALLTRIM(TAX_SCHED->STAXSCH), CURRATE, CURDESC, DETAILARR }
AADD(RATE_ARR, ADDVAR )
RETVAL := ADDVAR
ELSE
IF RATETABLE = NIL
ENDIF
RETVAL := { SPACE(6), 0, SPACE(10), {} }
ENDIF
SELECT (SAVESEL)
IF RETELEM = NIL
RETURN RETVAL
ELSE
RETURN RETVAL[RETELEM]
ENDIF
**********************************************************************
* DETERMINE IF A MODEL AFTER PRODUCT IS REQUESTED
**********************************************************************
FUNCTION NEW_ITEM(WHICHITEM, UFILENAME)
// ASSUMES THE PRODUCT FILE IS OPEN
LOCAL SAVESEL := SELECT()
LOCAL SAVEREC := RECNO()
LOCAL NEWREC, I, II, III, APFROM, PROG
LOCAL MODREC
LOCAL CURMOD, CURREC
LOCAL SAVESCR := SAVESCREEN()
LOCAL SELFILE, ATTFILE, OPTFILE, MAC, XTRAFILE, MACC, DOMAC
LOCAL XFILEARR := {}, DIRARR, DIRSPEC
LOCAL COPYCS := .F. //** P3N - 9/21/00
PRIVATE MOD_MODEL
M1 := '** You have Entered a NEW ' + WHICHITEM + '!'
M2 := '** Do You Wish To'
M3 := '** COPY From ANOTHER ' + WHICHITEM + '?'
IF !PROMPT_BOX(M1,M2,M3)
RETURN .T.
ENDIF
M1 := ' '
M2 := '** Do You want to copy existing Cutting Information for this Model?'
M3 := ' '
IF WHICHITEM == 'MODEL' //** P3N - 9/21/00
IF PROMPT_BOX(M1,M2,M3) //** P3N - 9/21/00
COPYCS := .T. //** P3N - 9/21/00
ENDIF //** P3N - 9/21/00
ENDIF //** P3N - 9/21/00
IF UFILENAME = NIL
UFILENAME := 'USERFILE3'
ENDIF
IF WHICHITEM = 'MODEL'
SELFILE := 'PRODUCT'
CURMOD := (SELFILE)->PROD_CODE
ELSE
IF WHICHITEM = 'CUTTING SPEC'
SELFILE := 'PRODUCT'
CURMOD := (SELFILE)->PROD_CODE
ELSE
SELFILE := 'CATEGORY'
CURMOD := (SELFILE)->CAT_CODE
ENDIF
ENDIF
SELECT (SELFILE)
NEWREC := RECNO()
KEYPARMS := GET_FILEPARM(SELFILE)
DO WHILE .T.
MOD_MODEL := GET_KEY(KEYPARMS,,,6)
IF MOD_MODEL = CURMOD
ERR_BOX('*** You May NOT Select the Same ' + SELFILE + ' CODE ***',;
'*** Please SELECT A DIFFERENT One to COPY ***')
LOOP
ENDIF
IF LASTKEY() = 27
GOTO NEWREC
SELECT (SAVESEL)
GOTO SAVEREC
RESTSCREEN(,,,,SAVESCR)
RETURN .T.
ENDIF
WAIT_BOX('*** Copying SETUP Information ***',;
'*** ' + ALLTRIM(MOD_MODEL) + ' To ' + CURMOD ,;
'*** Please Wait ***')
MODREC := RECNO()
IF WHICHITEM <> 'CUTTING SPEC'
MODEL_ONE_REC( MODREC, NEWREC, SELFILE , 'USERFILE3' )
SELECT (SELFILE)
GOTO NEWREC
REC_LOCK(3)
IF SELFILE = 'PRODUCT'
REPLACE PROD_CODE WITH CURMOD
ELSE
REPLACE CAT_CODE WITH CURMOD
ENDIF
IF SELFILE = 'PRODUCT'
ATTFILE = 'PROD_ATTS'
OPTFILE = 'PROD_OPTS'
MACC := 'CAT_CODE == MOD_MODEL .AND. !EOF()'
MAC := 'PROD_CODE == MOD_MODEL .AND. !EOF()'
IF COPYCS //** P3N - 9/21/00
XFILEARR := {'STD_SIZES', 'CUT_SPEC', {'MATHPACK', MACC} , '__PRICES' }
ELSE
XFILEARR := {'STD_SIZES', '__PRICES' }
ENDIF
ELSE
ATTFILE = 'CAT_ATTS'
OPTFILE = 'CAT_OPTS'
XFILEARR := {'PRI_EXTRAS', 'MATHPACK'}
MAC := 'CAT_CODE == MOD_MODEL .AND. !EOF()'
ENDIF
SELECT (ATTFILE)
COPYSTRUCT(USERFILE3) // DEL CDX
DBOPEN('USERFILE3',.T.)
//// GET THE ATTRIBUTES
SELECT (ATTFILE)
SEEK MOD_MODEL
DO WHILE &MAC
SELECT USERFILE3
ADD_ONEREC( ATTFILE, 'USERFILE3')
SELECT USERFILE3
IF SELFILE = 'PRODUCT'
REPLACE PROD_CODE WITH CURMOD
ELSE
REPLACE CAT_CODE WITH CURMOD
ENDIF
SELECT (ATTFILE)
SKIP 1
ENDDO
SELECT USERFILE3
USE
SELECT (ATTFILE)
FIL_LOCK(3)
APPEND FROM &USERFILE3
UNLOCK
//// GET THE OPTIONS
DBOPEN(OPTFILE)
COPYSTRUCT(USERFILE3, .T. ) // DEL CDX
DBOPEN('USERFILE3',.T.)
SELECT (OPTFILE)
SEEK MOD_MODEL
DO WHILE &MAC
SELECT USERFILE3
ADD_ONEREC( OPTFILE, 'USERFILE3')
SELECT USERFILE3
IF SELFILE = 'PRODUCT'
REPLACE PROD_CODE WITH CURMOD
ELSE
REPLACE CAT_CODE WITH CURMOD
ENDIF
SELECT (OPTFILE)
SKIP 1
ENDDO
SELECT USERFILE3
USE
SELECT (OPTFILE)
FIL_LOCK(3)
APPEND FROM &USERFILE3
UNLOCK
ELSE
// CUTTING SPECS ARE ONLY SUBORDINATE ITEMS
MAC := 'PROD_CODE == MOD_MODEL .AND. !EOF()'
MACC := 'CAT_CODE == MOD_MODEL .AND. !EOF()'
XFILEARR := {'CUT_SPEC', {'MATHPACK', MACC} }
ENDIF
//// GET THE EXTRAS / STD_SIZES / CUTTING SPECS
FOR I := 1 TO LEN(XFILEARR)
IF VALTYPE(XFILEARR[I])$'C'
XTRAFILE := XFILEARR[I]
DOMAC := MAC
ELSE
XTRAFILE := XFILEARR[I,1]
DOMAC := XFILEARR[I,2]
ENDIF
IF XTRAFILE = '__PRICES'
// PROG := 'COPY ?' + ALLTRIM( MOD_MODEL ) + '.DB* ?' + ALLTRIM( CURMOD ) + '.* '
// DONWAITRUN( PROG )
// CALL_OLAY( , , PROG )
DIRSPEC := '?' + ALLTRIM( MOD_MODEL ) + '.DB*'
DIRARR := DIRECTORY( DIRSPEC )
FOR II := 1 TO LEN( DIRARR )
FROMFILE := DIRARR[ II, 1 ]
TOFILE := SUBS( FROMFILE, 1,1 ) + ALLTRIM( CURMOD ) + RIGHT( DIRARR[1][1], 4 )
COPY FILE ( FROMFILE ) TO ( TOFILE )
NEXT
ELSE
DBOPEN(XTRAFILE)
APFROM := &UFILENAME
COPYSTRUCT(APFROM, .T. ) // DEL CDX
DBOPEN(UFILENAME,.T.)
IF XTRAFILE = 'MATHPACK'
SELECT (UFILENAME)
DELETE ALL
PACK
ENDIF
SELECT (XTRAFILE)
SEEK MOD_MODEL
DO WHILE &DOMAC
SELECT (UFILENAME)
ADD_ONEREC( XTRAFILE, UFILENAME )
SELECT (UFILENAME)
IF SELFILE = 'PRODUCT'
IF XTRAFILE = 'MATHPACK'
REPLACE CAT_CODE WITH CURMOD
ELSE
REPLACE PROD_CODE WITH CURMOD
ENDIF
ELSE
REPLACE CAT_CODE WITH CURMOD
ENDIF
SELECT (XTRAFILE)
SKIP 1
ENDDO
SELECT (UFILENAME)
USE
SELECT (XTRAFILE)
FIL_LOCK(3)
APFROM := ALLTRIM( &UFILENAME )
APPEND FROM &APFROM
UNLOCK
ENDIF
NEXT
SELECT (SAVESEL)
GOTO SAVEREC
IF WHICHITEM = 'CUTTING SPEC' //** P3N - 9/21/00
FIL_LOCK(3) //** P3N - 9/21/00
// APFROM := CUT_SPEC //** P3N - 9/21/00
APFROM := ALLTRIM( CUT_SPEC ) //** P3N - 9/21/00
APPEND FROM &APFROM FOR PROD_CODE = PRODUCT->PROD_CODE //** P3N - 9/21/00
UNLOCK //** P3N - 9/21/00
DBGOTOP() //** P3N - 9/21/00
ELSE //** P3N - 9/21/00
RESTSCREEN(,,,,SAVESCR)
ENDIF //** P3N - 9/21/00
IF WHICHITEM = 'CUTTING SPEC'
RETURN .F.
ENDIF
RETURN .T.
ENDDO
*****************************************************************
// ASSUMES CALLING PROC WILL PUT THE PROPER KEY INTO THE NEW RECORD
FUNCTION MODEL_ONE_REC( OLDREC, NEWREC, UPDATEFILE, WORKFILE)
LOCAL COPYTOFILE
GOTO OLDREC
COPYTOFILE := (WORKFILE) // IE USERFILE3 IS T0BCED03.DBF ETC.
COPYTOFILE := &COPYTOFILE // IE USERFILE3 IS T0BCED03.DBF ETC.
**IF SELECT(COPYTOFILE) > 0
** CLOSE &COPYTOFILE
IF SELECT( WORKFILE ) > 0
CLOSE &WORKFILE
ENDIF
COPY NEXT 1 TO (COPYTOFILE)
DBOPEN(WORKFILE, .T. )
SELECT (UPDATEFILE)
GOTO NEWREC
REC_LOCK(1)
REP_ONEREC(WORKFILE, UPDATEFILE )
SELECT (WORKFILE)
USE
SELECT (UPDATEFILE)
UNLOCK
GOTO NEWREC
RETURN
**********************************************************
FUNCTION CK_PRICE_SHT(CKVAR)
IF &CKVAR$'DSBLJI'
RETURN .T.
ELSE
ERR_BOX('"D" = Dealer , "S" = Special Dealer' , ;
'"B" = Builder/Build to Stock, "I" = Intercompany ', ;
'"J" = Distributor ( Jobber ), "L" = Lumberman ')
RETURN .F.
ENDIF
**********************************************************
// IF THE ORDER IS FOR INSTALLATION, THE PRICE SHEET WILL ALWAYS BE 'B'
// WHEN FUNCTION TO SEE IF WE GET THE PRICE SHEET VARIABLE AT LINE LEVEL
FUNCTION INIT_PRICESHT()
IF (CUR_MAST)->PICK_DEL$'I'
RETURN 'B'
ELSE
RETURN ' '
ENDIF
**********************************************************
// IF THE ORDER IS FOR INSTALLATION, THE PRICE SHEET WILL ALWAYS BE 'B'
// WHEN FUNCTION TO SEE IF WE GET THE PRICE SHEET VARIABLE AT LINE LEVEL
FUNCTION IS_INSTALL()
IF (CUR_MAST)->PICK_DEL$'I'
REPLACE USERFILE2->PRICE_SHT WITH 'B'
RETURN .F.
ELSE
RETURN .T.
ENDIF
**********************************************************
FUNCTION OPEN2100(OPTION, TITLE, REQ_ALIAS, CALL_MENU, WHCHORDER, ARCHIVE)
LOCAL NDX_EXP, SAVESCR := SAVESCREEN()
STATIC CUR_ALIAS := NIL
IF EMPTY(ARCHIVE)
ARCHIVE := .F.
ENDIF
IF WHCHORDER = NIL
WHCHORDER = 'SEL'
ENDIF
IF REQ_ALIAS = NIL
ERR_BOX('NO ALIAS PASSED TO OPEN2100')
? ABEND
ENDIF
WAIT_BOX('*** OPENING ORDER DATABASES ***' , ;
'*** Please Wait ***' )
DO CASE
// "NEWOPEN" MEANS SELECTED OFF MAIN MENU - OPEN COMMON FILES HERE.
CASE REQ_ALIAS = 'CONV_QUOTE'
CLOSE DATABASES
DBOPEN('IMPCUST')
DBOPEN('ORD_MAST')
DBOPEN('ORD_LINES')
DBOPEN('ORDER_OPTS')
DBOPEN('ORD_MISC')
DBOPEN('ADDL_LINES')
DBOPEN('ADDL_OPTS')
DBOPEN('QUOTE_MAST')
DBOPEN('QUOTE_LINE')
DBOPEN('QUOTE_OPTS')
DBOPEN('QUOTE_ADDL')
DBOPEN('ADDL_QOPT')
DBOPEN('QUOTE_MISC')
CONV_QUOTE(TITLE)
CUR_ALIAS := NIL
WAIT_BOX('*** Closing Temporary Conversion Files *** ', ;
'*** Please Wait ***')
CLOSE DATABASES
OPEN_BASEFILES()
RETURN
CASE REQ_ALIAS = 'NEWOPEN'
IF SELECT('ORD_MAST') = 0 .AND. SELECT('QUOTE_MAST') = 0
PRIVATE CUR_MAST := NIL
PRIVATE CUR_OL := NIL
PRIVATE CUR_XL := NIL
PRIVATE CUR_OO := NIL
PRIVATE CUR_XO := NIL
PRIVATE CUR_MISC := NIL
OPEN_BASEFILES(ARCHIVE)
ENDIF
IF REQ_ALIAS = 'NEWOPEN-RETURN'
RETURN
ENDIF
// NEED THE REAL ORDER DATABASES OPEN IF NOT ALREADY OPEN.
CASE REQ_ALIAS = 'ORDER' .OR. REQ_ALIAS = 'PRT ORD'
IF CUR_ALIAS = 'QUOTE'
ORD_SHUTDOWN()
ENDIF
IF CUR_ALIAS <> 'ORDER' // COULD BE NIL (1ST TIME) OR QUOTE
SET_ALIAS("ORDER")
CUR_ALIAS := 'ORDER'
ORD_OPEN()
ENDIF
IF REQ_ALIAS = 'ORDER'
CALL_MENU := 'CGW2110'
ELSEIF REQ_ALIAS = 'PRT ORD'
IF WHCHORDER = "SEL"
ORD_PRINT(,,"MM", '1')
ELSE
ALL_ORDPR(,,"ALL")
ENDIF
RETURN
ENDIF
CASE REQ_ALIAS = 'QUOTE' .OR. REQ_ALIAS = 'PRT QUOTE'
IF CUR_ALIAS = 'ORDER'
ORD_SHUTDOWN()
ENDIF
IF CUR_ALIAS <> 'QUOTE' // COULD BE NIL (1ST TIME) OR QUOTE
SET_ALIAS("QUOTE")
CUR_ALIAS := 'QUOTE'
ORD_OPEN()
ENDIF
IF REQ_ALIAS = 'QUOTE'
CALL_MENU := 'CGW2112'
ELSEIF REQ_ALIAS = 'PRT QUOTE'
ORD_PRINT(,,"MM", '1')
RETURN
ENDIF
ENDCASE
RESTSCREEN(,,,,SAVESCR)
DO WHILE .T.
CALLMENU(CALL_MENU, OPTION)
IF LASTKEY() = 27
IF CALL_MENU = 'CGW2100' .OR. CALL_MENU = 'CGW2200'
CUR_ALIAS := NIL
CLOSE DATABASES
ENDIF
RETURN
ENDIF
ENDDO
RETURN .T.
*******************************************************************
FUNCTION OPEN_BASEFILES(ARCHIVE)
IF EMPTY(ARCHIVE)
ARCHIVE := .F.
ENDIF
IF ARCHIVE
DBOPEN('IMPCUST')
DBOPEN('RULES')
DBOPEN('RULEPACK')
DBOPEN('CUST_MAST')
DBOPEN('CUST_ATTS')
DBOPEN('CUST_OPTS')
DBOPEN('PROD_ATTS')
DBOPEN('PROD_OPTS')
DBOPEN('CATEGORY')
DBOPEN('CAT_ATTS')
DBOPEN('CAT_OPTS')
DBOPEN('CUST_PRICE')
DBOPEN('ATTRIBUTES')
DBOPEN('ATT_OPTS')
DBOPEN('MATHPACK')
DBOPEN('STD_SIZES')
DBOPEN('PRI_EXTRAS')
DBOPEN("PRODUCT")
DBOPEN("SALESMEN")
DBOPEN("MFG_LOC")
DBOPEN("TERMS")
DBOPEN("SHIPMETH")
DBOPEN("TAX_DETAIL")
DBOPEN("TAX_SCHED")
DBOPEN("WORKSTAT")
DBOPEN('CUST_BP')
DBOPEN('CUST_PE')
DBOPEN('STD_SASH')
DBOPEN('ATTRIB_CUT')
DBOPEN('CUT_SPEC')
DBOPEN('IPO_FILE')
DBOPEN('MISC_ITEMS')
DBOPEN('UOMFILE')
DBOPEN('SALEHIST')
NET_USE('&PRINTERS', .F., 5, 'PRINTERS')
ELSE
DBOPEN('IMPCUST')
DBOPEN('RULES',,,{1})
DBOPEN('RULEPACK')
DBOPEN('CUST_MAST')
DBOPEN('CUST_ATTS',,,{2})
DBOPEN('CUST_OPTS',,,{1})
DBOPEN('PROD_ATTS',,,{2})
DBOPEN('PROD_OPTS',,,{1})
DBOPEN('CATEGORY',,,{1})
DBOPEN('CAT_ATTS',,,{2})
DBOPEN('CAT_OPTS',,,{1})
DBOPEN('CUST_PRICE',,,{1})
DBOPEN('ATTRIBUTES',,,{1})
DBOPEN('ATT_OPTS',,,{1})
DBOPEN('MATHPACK',,,{1})
DBOPEN('STD_SIZES')
DBOPEN('PRI_EXTRAS')
DBOPEN("PRODUCT",,, {1}) // OPEN PRODUCT FILE FO SINGLE INDEX
DBOPEN("SALESMEN",,, {1})
DBOPEN("MFG_LOC",,, {1})
DBOPEN("TERMS")
DBOPEN("SHIPMETH")
DBOPEN("TAX_DETAIL",,, {1} )
DBOPEN("TAX_SCHED",,, {1} )
DBOPEN("WORKSTAT")
DBOPEN('CUST_BP')
DBOPEN('CUST_PE')
DBOPEN('STD_SASH')
DBOPEN('ATTRIB_CUT',,, {1})
DBOPEN('CUT_SPEC',,, {1})
DBOPEN('IPO_FILE')
DBOPEN('MISC_ITEMS',,,{1})
DBOPEN('UOMFILE')
** DBOPEN('SALEHIST') //** P3N - 8/13/98 - ADDRESS POSTING LOCKOUT
NET_USE('&PRINTERS', .F., 5, 'PRINTERS')
ENDIF
RETURN
************************************************************
FUNCTION ORD_OPEN()
LOCAL TAGNAME
DBOPEN(CUR_MISC)
DBOPEN(CUR_OO)
IF SELECT('USERFILE8') > 0
SELECT USERFILE8
USE
ENDIF
SELECT (CUR_OO)
**COPY STRUCTURE TO &USERFILE8
COPYSTRUCT(USERFILE8, .T. ) // DEL CDX
NET_USE('&USERFILE8', .T., 3, 'USERFILE8')
SELECT (CUR_OO)
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
// NEED TO HAVE THIS ONE READY TO ADD TO / DELETE / RENUMBER
DBOPEN(CUR_XL)
IF SELECT('USERFILE6') > 0
SELECT USERFILE6
USE
ENDIF
SELECT (CUR_XL)
COPYSTRUCT( USERFILE6 ) // DEL CDX
NET_USE('&USERFILE6', .T., 3, 'USERFILE6')
SELECT (CUR_XL)
SAVEORD := INDEXORD()
DONSETORD(1)
NDX_EXP1= INDEXKEY()
DONSETORD(2)
NDX_EXP2= INDEXKEY()
SELECT USERFILE6
*INDEX ON &NDX_EXP1 TO &USERFILE6
*INDEX ON &NDX_EXP2 TO &USERFILET
IF __DBDRIVER = 'CDX'
TAGNAME := 'T1'
INDEX ON &NDX_EXP1 TAG &TAGNAME TO &USERFILE6
TAGNAME := 'T2'
INDEX ON &NDX_EXP2 TAG &TAGNAME TO &USERFILE6
ELSE
INDEX ON &NDX_EXP1 TO &USERFILE6
INDEX ON &NDX_EXP2 TO &USERFILET
// 1-20-20
ORDLISTCLEAR()
ORDLISTADD( USERFILE6 )
ORDLISTADD( USERFILET )
ENDIF
SELECT (CUR_XL)
DONSETORD(SAVEORD)
DBOPEN(CUR_XO)
// NEED TO HAVE THIS ONE READY TO DELETE / RENUMBER LINE_NUM'S
IF SELECT('USERFILE9') > 0
SELECT USERFILE9
USE
ENDIF
SELECT (CUR_XO)
**COPY STRUCTURE TO &USERFILE9
COPYSTRUCT( USERFILE9 ) // DEL CDX
NET_USE('&USERFILE9', .T., 3, 'USERFILE9')
SELECT (CUR_XO)
NDX_EXP = INDEXKEY()
SELECT USERFILE9
**INDEX ON &NDX_EXP TO &USERFILE9
IF __DBDRIVER = 'CDX'
TAGNAME := 'T1'
INDEX ON &NDX_EXP TAG &TAGNAME TO &USERFILE9
ELSE
INDEX ON &NDX_EXP TO &USERFILE9
ENDIF
RETURN
*********************************************************************
FUNCTION ORD_SHUTDOWN()
IF SELECT(CUR_MAST) > 0
SELECT(CUR_MAST)
USE
ENDIF
IF SELECT(CUR_OL) > 0
SELECT(CUR_OL)
USE
ENDIF
IF SELECT(CUR_MISC) > 0
SELECT(CUR_MISC)
USE
ENDIF
SELECT(CUR_XL)
USE
SELECT(CUR_OO)
USE
SELECT(CUR_XO)
USE
IF SELECT('USERFILE9') > 0
SELECT USERFILE9
USE
ENDIF
IF SELECT('USERFILE8') > 0
SELECT USERFILE8
USE
ENDIF
IF SELECT('USERFILE6') > 0
SELECT USERFILE6
USE
ENDIF
RETURN
*********************************************************************
***********************************************************************
FUNCTION SET_ALIAS(WHICH_ALIAS)
IF WHICH_ALIAS = 'ORDER'
CUR_MAST := 'ORD_MAST'
CUR_OL := 'ORD_LINES'
CUR_XL := 'ADDL_LINES'
CUR_OO := 'ORDER_OPTS'
CUR_XO := 'ADDL_OPTS'
CUR_MISC := 'ORD_MISC'
ELSE
IF WHICH_ALIAS = 'QUOTE'
CUR_MAST := 'QUOTE_MAST'
CUR_OL := 'QUOTE_LINE'
CUR_XL := 'QUOTE_ADDL'
CUR_OO := 'QUOTE_OPTS'
CUR_XO := 'ADDL_QOPT'
CUR_MISC := 'QUOTE_MISC'
ENDIF
ENDIF
RETURN
**********************************************
FUNCTION ORD_PAINT(RA, C1, RB, C2, COLORSPEC, SCRNUM)
LOCAL SAVECOL
IF SELECT('USERFILE8') = 0
RETURN .T.
ENDIF
SAVECOL := SETCOLOR(&COLORSPEC)
@ RA,C1 SAY 'BILL TO'
@ RA+1,C1 SAY '-------'
@ RB,C2 SAY 'SHIP TO'
@ RB+1,C2 SAY '-------'
SETCOLOR(SAVECOL)
RETURN .T.
**********************************************
FUNCTION ZAP_FILE689(SCRNUM)
LOCAL SAVESEL := SELECT()
IF SELECT('USERFILE8') = 0
RETURN .T.
ENDIF
SELECT USERFILE8
ZAP
SELECT USERFILE6
ZAP
SELECT USERFILE9
ZAP
SELECT (SAVESEL)
RETURN .T.
**********************************************
FUNCTION ORD_USER()
IF SELECT('USERFILE8') = 0
RETURN .T.
ENDIF
REC_LOCK(3)
* DOPROC := 'ADD_SING_REC(1, "Order Close", {"ORD_MAST", '+ ;
* '.F., 'ORD_NUM = ??'
* CALL ADD_SING_REC WITH PRICE LINE MISC ITEMS DESC/COST
* SALES TAX % AND TOTAL OF ORDER
//* REPLACE ORD_MAST->USER_ID WITH USER
IF EMPTY(USER_ID)
REPLACE USER_ID WITH USER
ENDIF
IF EMPTY(NEED_CALC)
REPLACE NEED_CALC WITH 'V' // VIRGIN ORDER
ENDIF
// REMOVE TAX SCHED UPDATE 7-24-97
**IF EMPTY( TAXSCH )
** REPLACE TAXSCH WITH CUST_MAST->TAXSCH
**ENDIF
UNLOCK
RETURN .T.
**********************************************
FUNCTION DISP_ATTACH_PROD()
// DISPLAY THE COLOR OF PRODUCT ON THE LINE ITEM SCREEN FOR EACH MODEL
RETURN ALLTRIM(USERFILE2->PAR_PROD) + ' ' + ALLTRIM(USERFILE2->PAR_COLOR)
**********************************************
* VALIDATE THE TAX SCHEDULE ON ENTRY *
* Perry Nichols 7-24-97 *
**********************************************
FUNCTION VALID_TAXSCH( )
LOCAL SAVESEL := SELECT(), NEW_TAXSCH
LOCAL MSG1 := "Tax Schedule Lookup"
LOCAL OLDGETS := ACLONE(GETLIST)
LOCAL OLDACTIVE := ACTIVE_GET()
LOCAL ELEM := ASCAN(GETVARS, {|X| TRIM(X[3]) == 'TAXSCH' })
LOCAL OLD_TAXSCH := GETVARS[ELEM,4] // GET ORIGINAL VALUE OF GET BEFORE GET
LOCAL SAVESCR := SAVESCREEN()
SELECT TAX_SCHED
SEEK OLD_TAXSCH
IF !FOUND()
@ 2,0 CLEAR
GETLIST := {} // CLEAR THE CURRENT GETS
GBROWSE(,MSG1,{"TAX_SCHED", , .T.} )
IF LASTKEY() = 27
NEW_TAXSCH := OLD_TAXSCH
ELSE
NEW_TAXSCH := TAX_SCHED->STAXSCH
ENDIF
GETVARS[ELEM,4] := NEW_TAXSCH
ENDIF
RESTSCREEN(,,,,SAVESCR)
SELECT (SAVESEL)
GETLIST := RESTGETS(OLDGETS, OLDACTIVE)
RETURN .T.
**********************************************
FUNCTION GET_THE_CUST(WHCHCUST, ACTION, REPVAR )
LOCAL SAVESEL := SELECT(), NCHOICE, GOODCUST := NIL
LOCAL MSG1 := "CUSTOMER Lookup", BROW_CUST
LOCAL MSG2 := "ADD/CHANGE Customers"
LOCAL PICKARR := {MSG1, MSG2}
LOCAL OLDGETS := ACLONE(GETLIST)
LOCAL OLDACTIVE := ACTIVE_GET()
LOCAL SAVESCR, MARR := {}, SVCUSTORD := 1
LOCAL NEW_CUSTID, ELEM
STATIC OLD_CUSTID
STATIC BEEN_HERE := NIL
IF ACTION = 'RESET'
OLD_CUSTID = NIL
BEEN_HERE = NIL
RETURN .T.
ENDIF
IF ACTION = 'PREBLOCK'
ELEM = ASCAN(GETVARS, {|X| TRIM(X[3]) == 'CUST_ID' })
OLD_CUSTID := GETVARS[ELEM,4] // GET ORIGINAL VALUE OF GET BEFORE GET
RETURN .T.
ENDIF
IF ACTION = 'EDIT' .AND. BEEN_HERE = NIL
BEEN_HERE := 'FIRST TIME IN'
ELSE
IF ACTION = 'EDIT' .AND. BEEN_HERE <> NIL
BEEN_HERE := 'BEEN HERE BEFORE'
ENDIF
ENDIF
SELECT CUST_MAST
SEEK WHCHCUST
NCHOICE := 1
BROW_CUST := .F.
IF !FOUND()
SAVESCR = SAVESCREEN()
@ 2,0 CLEAR
GETLIST := {} // CLEAR THE CURRENT GETS
IF ALPHACUST(WHCHCUST) //** P3N - 8/4/99
IF GETCUSTNAME(WHCHCUST) //** P3N - 8/4/99
SVCUSTORD := CUST_MAST->(INDEXORD()) //** P3N - 8/4/99
CUST_MAST->(DBSETORDER(2)) //** P3N - 8/4/99
GBROWSE(,"Customer LOOKUP", {"CUST_MAST" } )
DONSETORD(SVCUSTORD) //** P3N - 8/4/99
ELSE //** P3N - 8/4/99
GBROWSE(,"Customer LOOKUP", {"CUST_MAST", , .T. } )
ENDIF //** P3N - 8/4/99
GOODCUST := CUST_MAST->CUST_ID //** P3N - 8/4/99
RESTSCREEN(,,,,SAVESCR) //** P3N - 8/4/99
BROW_CUST := .T. //** P3N - 8/4/99
ELSE
DO WHILE .T.
NCHOICE = LISTBOX(PICKARR,NCHOICE,'Select Choice')
IF LASTKEY() = 27
RESTSCREEN(,,,,SAVESCR)
SELECT (SAVESEL)
GETLIST := RESTGETS(OLDGETS, OLDACTIVE) // RESTORE OLD GETLIST!
RETURN .F.
ENDIF
IF NCHOICE = 1
GBROWSE(,"Customer LOOKUP", {"CUST_MAST", , .T.} )
IF LASTKEY() <> 27
GOODCUST := CUST_MAST->CUST_ID
RESTSCREEN(,,,,SAVESCR)
BROW_CUST := .T.
EXIT
ENDIF
ELSE
IF NCHOICE = 2
GOTO BOTTOM
SKIP 1
ADD_SING_REC(1,"CUSTOMER Maintenance", {"CUST_MAST", .T., , , , 3, 'ADD', , .F.} )
IF EOF() .OR. BOF()
ELSE
GOODCUST := CUST_MAST->CUST_ID
ENDIF
ENDIF
ENDIF
ENDDO
RESTSCREEN(,,,,SAVESCR)
ENDIF
ELSE
GOODCUST = WHCHCUST
ENDIF
SELECT (SAVESEL)
GETLIST := RESTGETS(OLDGETS, OLDACTIVE)
IF BROW_CUST
IF REPVAR <> NIL .AND. LASTKEY() = 13
REPLACE &REPVAR WITH CUST_MAST->CUST_ID
DISP_CUST_STAR()
RETURN .T.
ELSE
CLEAR TYPEAHEAD
KEYBOARD CUST_MAST->CUST_ID
RETURN .F.
ENDIF
ENDIF
// ONLY VALID CUST_ID'S FROM INPUT SCREEN GOT THIS FAR
IF GOODCUST <> NIL
GETVARS[1,4] := GOODCUST
// MSL 5-4-94
SELECT CUST_MAST
// LAYOUT FOR MARR
// 1 = FIELD NAME OR FUNCTION THAT HAS THE VALUE TO DISPLAY
// 2 = IF ELEMENT 1 ISN'T THE FIELD NAME THAT IS IN THE 'GETVARS'
// ARRAY, THEN ELEMENT 2 MUST BE USED!
IF OLD_CUSTID <> GOODCUST
OLD_CUST = GOODCUST
AADD(MARR, {'NOTE_FIELD', 'NOTE_FIELD'})
AADD(MARR, {'NOTE_FLD2', 'NOTE_FLD2'}) //** P3N - 12/27/00
AADD(MARR, {'PRNT_NOTES', 'PRNT_NOTES'})
AADD(MARR, {'COMP_NAME', 'BILL_NAME'})
AADD(MARR, {'CUST_ADDR', 'BILL_ADD1'})
AADD(MARR, {'CUST_ADDR2', 'BILL_ADD2'})
AADD(MARR, {'CUST_CSZ(30)', 'BILL_CSZ'})
AADD(MARR, {'PHONE'})
AADD(MARR, {'FAX'}) //** P3N - 08/09/01
AADD(MARR, {'SHIPNAME', 'SHIP_NAME'})
AADD(MARR, {'SHIPADD1', 'SHIP_ADD1'})
AADD(MARR, {'SHIP_CSZ(30)', 'SHIP_CSZ'})
AADD(MARR, {'SHIPPHN'})
AADD(MARR, {'SHIPFAX'}) //** P3N - 08/09/01
AADD(MARR, {'SLSMAN'})
AADD(MARR, {'TAXSCH'})
IF (CUR_MAST)->(FIELDPOS('CONT_FNAME'))> 0 //** P3N - 12/26/01
AADD(MARR, {'CONT_FNAME'}) //** P3N - 12/26/01
ENDIF //** P3N - 12/26/01
IF EMPTY((CUR_MAST)->TERMS)
AADD(MARR, {'TERMS'})
ELSE
AADD(MARR, {'TERMS', '(CUR_MAST)->TERMS'})
ENDIF
AADD(MARR, {'PICK_DEL'})
AADD(MARR, {'SHP_METHOD'})
AADD(MARR, {'DEL_ROUTE'})
AADD(MARR, {'PRICE_SHT'})
AADD(MARR, {'DISCOUNT'})
AADD(MARR, {'VAL(STR(STAX_RATE(NIL, 2 ),7,4))','SLS_TX_PCT'})
AADD(MARR, {'ORIEL_CHRG'})
// DISPLAY ALL THESE FIELD VALUES ON THE SCREEN (VIA THE GETLIST)
UPDATE_GETS(MARR)
ENDIF
DISP_CUST_STAR()
SELECT (SAVESEL)
RETURN .T.
ELSE
SELECT (SAVESEL)
RETURN .F.
ENDIF
***********************************************************************
//** P3N - 8/4/99
//** CHECK FOR ALPHA ENTRY ON CUSTOMER NUMBER
***********************************************************************
FUNCTION ALPHACUST(WHCHCUST) //** P3N - 8/4/99
LOCAL RETVAL := .F.
IF SUBST(WHCHCUST, 1,1)$'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
RETVAL := .T.
ENDIF
RETURN RETVAL //** P3N - 8/4/99
***********************************************************************
//** P3N - 8/4/99
//** CHECK FOR NAME ENTRY, AND LOOKUP ON CUSTOMER NAME IF ALPHA ENTRY
***********************************************************************
FUNCTION GETCUSTNAME(WHCHCUST) //** P3N - 8/4/99
LOCAL RETVAL := .F. //** P3N - 8/4/99
LOCAL SVCUSTORD := CUST_MAST->(INDEXORD()) //** P3N - 8/4/99
LOCAL SEEKKEY := REMOVENUM(WHCHCUST) //** P3N - 8/4/99
CUST_MAST->(DBSETORDER(2)) //** P3N - 8/4/99
IF CUST_MAST->(DBSEEK(SEEKKEY, .T.)) //** P3N - 8/4/99
RETVAL := .T. //** P3N - 8/4/99
ENDIF //** P3N - 8/4/99
DONSETORD(SVCUSTORD) //** P3N - 8/4/99
RETURN RETVAL //** P3N - 8/4/99
***********************************************************************
//** P3N - 8/4/99
//** REMOVE FOR NUMERIC CHARS FROM CUSTOMER KEY
***********************************************************************
FUNCTION REMOVENUM(WHCHCUST) //** P3N - 8/4/99
LOCAL RETVAL := '', I
FOR I := 1 TO LEN(WHCHCUST)
IF SUBST(WHCHCUST, I,1)$'1234567890'
ELSE
RETVAL := RETVAL + SUBSTR(WHCHCUST,I,1)
ENDIF
NEXT
RETURN RETVAL //** P3N - 8/4/99
***********************************************************************
* Display message to identify CUSTOMER notes existance !
***********************************************************************
FUNCTION DISP_CUST_STAR()
LOCAL SAVECOLOR := SETCOLOR()
IF !EMPTY( CUST_MAST->CUST_NOTES )
SETCOLOR(BLOW)
@ 3,0 SAY '* Customer NOTES *'
SETCOLOR(SAVECOLOR)
ELSE
@ 3,0 SAY ' '
ENDIF
RETURN .T.
***********************************************************************
* Display message to identify ORDER/QUOTE notes existance !
***********************************************************************
FUNCTION NOTES_MSG(WHAT_NOTES)
LOCAL SAVECOLOR := SETCOLOR()
IF WHAT_NOTES == 'O' // Order Processing
IF !EMPTY( ORD_MAST->NOTES )
SETCOLOR(BLOW)
@ 4,0 SAY '** Order NOTES **'
SETCOLOR(SAVECOLOR)
ELSE
@ 4,0 SAY ' '
ENDIF
ELSEIF WHAT_NOTES == 'Q' // Quote processing
IF !EMPTY( QUOTE_MAST->NOTES )
SETCOLOR(BLOW)
@ 4,0 SAY '** Quote NOTES **'
SETCOLOR(SAVECOLOR)
ELSE
@ 4,0 SAY ' '
ENDIF
ELSE
@ 4,0 SAY ' '
ENDIF
RETURN
**********************************************
FUNCTION FIND_CP_REC(MPROD_CODE)
LOCAL SAVESEL := SELECT()
LOCAL MCAT_CODE := GET_CATCODE(USERFILE2->PROD_CODE)
LOCAL SEEKKEY, RETVAL := .F.
LOCAL CAT_RECORD := 0
LOCAL PROD_RECORD := 0
SELECT CUST_PRICE
SEEKKEY := (CUR_MAST)->CUST_ID + MCAT_CODE
SEEK SEEKKEY
DO WHILE CUST_PRICE->CUST_ID + CUST_PRICE->CAT_CODE == SEEKKEY
IF EMPTY(CUST_PRICE->PROD_CODE)
CAT_RECORD := RECNO()
ELSE
IF CUST_PRICE->PROD_CODE == MPROD_CODE
PROD_RECORD := RECNO()
GOTO BOTTOM
ENDIF
ENDIF
SKIP 1
ENDDO
IF PROD_RECORD = 0 .AND. CAT_RECORD = 0
ELSE
RETVAL := .T.
// MODEL LEVEL OVERRIDES CATEGORY LEVEL
IF PROD_RECORD > 0
GOTO PROD_RECORD
ELSE
IF CAT_RECORD > 0
GOTO CAT_RECORD
ENDIF
ENDIF
ENDIF
RETURN RETVAL
**********************************************
// CALCS THE DISCOUNT % AS FOLLOWS:
// IF THE DISCOUNT IS 0
// 1. IF CUST_PRICE CATEGORY DISCOUNT RULE APPLIES, USE THAT DISC.
// 2. IF ORD_MAST->DISCOUNT <> 0, USE THAT DISC.
FUNCTION CALC_DISC(MPROD_CODE)
LOCAL SAVESEL := SELECT()
LOCAL SEEKKEY, RETVAL := 0
LOCAL CAT_RECORD := 0
LOCAL PROD_RECORD := 0, BP:=0, OP:=0, EP:=0
LOCAL CP_STUFF := FIND_CP_REC(MPROD_CODE), RETPS := ' '
IF CP_STUFF
SELECT CUST_PRICE
IF IN_STOCK = 'Y' .AND. USERFILE2->IN_STOCK <> 'Y'
ELSEIF STD_SIZE = 'Y' .AND. USERFILE2->STD_SIZE <> 'Y'
// SO FAR WE ARE IN BUSINESS!
ELSE
RETVAL := DISCOUNT
RETPS := PRICE_SHT
BP := CUST_PRICE->BASE_PRICE
EP := CUST_PRICE->EXT_PRICE
OP := CUST_PRICE->OPT_PRICE
ENDIF
SELECT (SAVESEL)
ENDIF
RETURN {RETVAL, RETPS, BP, OP, EP}
*****************************************************************
FUNCTION VALID_CP_PROD(MCAT_CODE, MPROD_CODE)
LOCAL SAVESEL := SELECT(), RETVAL := .F.
LOCAL THISREC := RECNO(), NEW_PROD
LOCATE FOR DUP_PRODUCT(MCAT_CODE, MPROD_CODE, THISREC)
IF FOUND()
ERR_BOX('*** ERROR - You have entered ****', ;
'*** DUPLICATE Category/Product Codes ****', ;
'*** PLEASE Re-enter OR "?" to Browse ****')
GOTO THISREC
RETURN .F.
ENDIF
GOTO THISREC
IF EMPTY(MPROD_CODE)
RETVAL := .T.
ELSE
SELECT PRODUCT
SEEK MPROD_CODE
IF FOUND()
SELECT USERFILE2
IF MCAT_CODE <> NIL
REPLACE USERFILE2->CAT_CODE WITH PRODUCT->CAT_CODE
ENDIF
RETVAL := .T.
ELSE
SELECT USERFILE2
****VAL_LOOKUP(MPROD_CODE, 'PRODUCT', '@_@', {'PROD_CODE', 'DESC'} , 'Y' ,.F., 'USERFILE2->PROD_CODE',{4,20})
RETVAL := VAL_PRODUCT( '"' + MPROD_CODE + '"', , .F., .F. )
** KEYBOARD CHR(13)
ENDIF
SELECT (SAVESEL)
ENDIF
RETURN RETVAL
**************************************************************
FUNCTION DUP_PRODUCT(MCAT_CODE, MPROD_CODE, THISREC)
LOCAL BIG_KEY
IF MCAT_CODE <> NIL
BIG_KEY := MCAT_CODE + MPROD_CODE
ELSE
BIG_KEY := MPROD_CODE
ENDIF
IF RECNO() = THISREC
RETURN .F.
ENDIF
IF MCAT_CODE <> NIL
IF USERFILE2->CAT_CODE + USERFILE2->PROD_CODE == BIG_KEY
RETURN .T.
ENDIF
ENDIF
IF !EMPTY(USERFILE2->PROD_CODE)
IF USERFILE2->PROD_CODE == MPROD_CODE
RETURN .T.
ENDIF
ENDIF
RETURN .F.
*********************************************************
FUNCTION EDIT_PS(MPROD_CODE)
LOCAL CP_STUFF := FIND_CP_REC(MPROD_CODE)
IF CP_STUFF
REPLACE USERFILE2->PRICE_SHT WITH CUST_PRICE->PRICE_SHT
ENDIF
RETURN .T.
*
*********************************************************
FUNCTION VAL_PR_STR(STR2CK)
LOCAL CK_STR, I, SAVESEL := SELECT()
LOCAL M1 := '*** You MUST INDICATE the PRICE SHEET ***'
LOCAL M2 := ' To Apply this EXTRA CALCULATION. '
LOCAL M3 := ' '
LOCAL M4 := ' VALID CHOICES ARE "DSBLJIU" '
LOCAL M5 := ' (U = ALL USER DEFINED Special Pricing)'
CK_STR := ALLTRIM(&STR2CK)
IF EMPTY(CK_STR)
ERR_BOX(M1, M2, M3, M4, M5)
RETURN .F.
ELSE
// CUSTOMER SPECIAL PRICING ITEM
FOR I = 1 TO LEN(CK_STR)
IF !SUBS(CK_STR,I,1)$'DSBLJIU'
ERR_BOX(M1, M2, M3, M4, M5)
RETURN .F.
ENDIF
NEXT
ENDIF
RETURN .T.
*****************************************************************
FUNCTION VAL_CUSTPE_ID(PASSKEY)
LOCAL M1 := '*** Invalid Customer ID'
LOCAL M2 := '*** ? to Browse '
LOCAL M3 := '*** Blank to Delete '
LOCAL SAVESEL := SELECT(), RETVAL := .T.
IF EMPTY(CUST_ID)
// - DELETED RECORD - USER CLEARED THE CUST_ID! PERRY 2-13-98
RETVAL := .T.
ELSE
IF !CUST_MAST->(DBSEEK(PASSKEY))
IF GET_THE_CUST( PASSKEY, "EDIT", 'CUST_ID')
SELECT (SAVESEL)
RETVAL := .T.
ELSE
ERR_BOX(M1, M2, M3)
RETURN .F.
ENDIF
ENDIF
ENDIF
*REPLACE CAT_CODE WITH CATEGORY->CAT_CODE
*REPLACE OPTION WITH USERFILE2->OPTION
*REPLACE UPDATED WITH 'Y'
RETURN RETVAL
*********************************************************
* FUNCTION VAL_PR_STR(STR2CK)
*
* LOCAL CK_STR, I, SAVESEL := SELECT()
* LOCAL M1 := '*** You MUST INDICATE the PRICE SHEET ***'
* LOCAL M2 := ' To Apply this EXTRA CALCULATION. '
* LOCAL M3 := ' '
* LOCAL M4 := ' VALID CHOICES ARE "DSBLJIU" '
* LOCAL M5 := ' (U = ALL USER DEFINED Special Pricing)'
* LOCAL M6 := ' or Input a VALID CUSTOMER ID (? to Browse)'
*
* CK_STR := ALLTRIM(&STR2CK)
* IF EMPTY(CK_STR)
* ERR_BOX(M1, M2, M3, M4, M5, M6)
* RETURN .F.
* ELSE
* // CUSTOMER SPECIAL PRICING ITEM
* FOR I = 1 TO LEN(CK_STR)
* IF !SUBS(CK_STR,I,1)$'DSBLJIU'
* I := 9999
* ENDIF
* NEXT
* IF I < 9999
* RETURN .T.
* ENDIF
* IF !CUST_MAST->(DBSEEK(CK_STR))
* IF GET_THE_CUST( CK_STR, "EDIT", 'PRICE_SHT')
* SELECT (SAVESEL)
* RETURN .T.
* ENDIF
* ERR_BOX(M1, M2, M3, M4, M5, M6)
* RETURN .F.
* ENDIF
* ENDIF
* RETURN .T.
*
*
*
* * * * * * * * * * * * * * * * * * * **
FUNCTION CALL_GP
// GO THRU OVERLAY AND CALL THE GREAT PLAINS SYSTEM
LOCAL MGP_CALL
DBOPEN('CONTROL')
MGP_CALL := ALLTRIM(GP_CALL)
USE
CALL_OLAY(,, MGP_CALL)
RETURN
* * * * * * * * * * * * * * * * * * * **
FUNCTION CALL_BTREV
// GO THRU OVERLAY AND CALL THE BTRIEVE BROWSE & IMPORT
LOCAL PROG := 'CGWB'
CALL_OLAY(,, 'CGWBTRV.BAT')
RETURN
* * * * * * * * * * * * * * * * * * * **
FUNCTION CHK_GPCUST(MGP_CUSTID)
// MAKE SURE THAT THEY DON'T ENTER A GP NUMBER THAT IS ALREADY
// IN USE (DURING ADDREC)
LOCAL SAVESEL := SELECT(), SAVEORD
LOCAL SAVEREC := RECNO()
IF NEWREC .AND. !EMPTY(MGP_CUSTID)
SELECT CUST_MAST
SAVEORD = INDEXORD() // SAVE THE ORDER
DONSETORD(4) // GP_CUSTID KEY
SEEK MGP_CUSTID
IF FOUND()
DONSETORD(SAVEORD)
SELECT(SAVESEL)
GOTO SAVEREC
?? CHR(7)
ERR_BOX('That GP CUST ID is already being used' , ;
'by ' + TRIM(COMP_NAME))
RETURN .F.
ENDIF
DONSETORD(SAVEORD)
SELECT(SAVESEL)
GOTO SAVEREC
ENDIF
RETURN .T.
***************************************************************
**********************************************************************
* CONVERT A QUOTE TO AN ORDER
**********************************************************************
FUNCTION CONV_QUOTE(TITLE)
LOCAL SV_SCREEN
LOCAL SV_SEL := SELECT()
LOCAL QMAST_PARMS := GET_FILEPARMS('QUOTE_MAST')
LOCAL MGET_KEY
LOCAL NEW_ORDR, DEL_QUOTE := .F.
LOCAL SVREC := RECNO()
LOCAL ACDPARMS := GETACD_PARM('QUOTE_MAST')
LOCAL UPDATE_CHILD := GETACD_PARM('QUOTE_LINE')
LOCAL GETVARARR := GET_ONE_PARMS(QMAST_PARMS, ACDPARMS)
PRIVATE _CUROPT := 1 // USED FOR GET ORDER NUMBER ????
CLS
SAYTITLE(TITLE, '2300')
SELECT QUOTE_MAST
DO WHILE .T.
MGET_KEY := GET_KEY(QMAST_PARMS)
IF EMPTY(MGET_KEY) .OR. LASTKEY() = 27
EXIT
ENDIF
SV_SCREEN := SAVESCREEN()
IF !DBSEEK(MGET_KEY)
LOOP
ENDIF
NEW_ORDR := GET_ORD_NUM('QCNV')
IF !PROMPT_BOX('*** About to CONVERT QUOTE ' + ALLTRIM(MGET_KEY) + ' to ORDER ' + ALLTRIM(NEW_ORDR), ;
'*** DO YOU WISH TO CONTINE? ', ' ' )
RESET_CNTL('ORDER')
LOOP
ENDIF
IF PROMPT_BOX('DELETE the Quote after Conversion?', ;
' ', ' ' )
DEL_QUOTE := .T.
ELSE
DEL_QUOTE := .F.
ENDIF
IF LASTKEY() = 27
RESET_CNTL('ORDER')
LOOP
ENDIF
IF ALREADY_CONV(MGET_KEY) // HAS this quote already been converted???
ELSE
RESET_CNTL('ORDER')
EXIT // ABORT THE CONVERSION
ENDIF
WAIT_BOX('*** CONVERTING QUOTE - ' + ALLTRIM(MGET_KEY) + ' TO ORDER - ' + ALLTRIM(NEW_ORDR), ;
'*** Please Wait' )
//* MODEL QUOTE MASTER FILE FROM AN ORDER MASTER FILE
****5-8-97
* COPY NEXT 1 TO &USERFILE3
* DBOPEN('USERFILE3', .T.)
SELECT ORD_MAST
****5-8-97
**FIL_LOCK(3)
**APPEND FROM &USERFILE3
ADD_ONEREC( 'QUOTE_MAST', 'ORD_MAST' )
SELECT('QUOTE_MAST') //** P3N - 5/24/99
REC_LOCK(3) //** P3N - 5/24/99
REPLACE QUOTE_NUM WITH NEW_ORDR //** P3N - 5/24/99
REPLACE ORDER_DATE WITH DATE() //** P3N - 5/24/99
DBUNLOCK() //** P3N - 5/24/99
SELECT ORD_MAST
REPLACE QUOTE_NUM WITH QUOTE_MAST->ORDER_NUM
REPLACE ORDER_NUM WITH NEW_ORDR
REPLACE IDATE_FST WITH CTOD(' / / ')
REPLACE ITIME_FST WITH ' '
REPLACE IDATE_LAST WITH CTOD(' / / ')
REPLACE ITIME_LAST WITH ' '
SELECT ORD_MAST
UNLOCK
//* MODEL QUOTE DETAIL FILES FROM ORDER DETAIL FILES
QUOTECOPY(MGET_KEY, NEW_ORDR, 'QUOTE_LINE', 'ORD_LINES')
QUOTECOPY(MGET_KEY, NEW_ORDR, 'QUOTE_OPTS', 'ORDER_OPTS')
QUOTECOPY(MGET_KEY, NEW_ORDR, 'QUOTE_ADDL', 'ADDL_LINES')
QUOTECOPY(MGET_KEY, NEW_ORDR,'ADDL_QOPT', 'ADDL_OPTS')
QUOTECOPY(MGET_KEY, NEW_ORDR, 'QUOTE_MISC', 'ORD_MISC')
IF DEL_QUOTE
DEL_ARR := {}
CORR = GET_ONE_REC(2, QMAST_PARMS, MGET_KEY, ACDPARMS, NIL, NIL, {'QUOTE_LINE','QUOTE_ADDL', 'QUOTE_OPTS', 'ADDL_QOPT'}, GETVARARR, , .F., , , , .F.) // NO AUDIT PROC OR CONFIRM DELETE!
ENDIF
ENDDO
RESTSCREEN(,,,, SV_SCREEN)
SELECT(SV_SEL)
RETURN
****************************************************************
//** DETERMINE WHAT TO DISPLAY AS THE QUOTE CONVERTION DATE?
****************************************************************
FUNCTION QO_CONV_DATE()
LOCAL RETVAL := ' / / '
IF EMPTY(QUOTE_MAST->QUOTE_NUM)
ELSE
RETVAL := DTOC(QUOTE_MAST->ORDER_DATE)
ENDIF
RETURN RETVAL
****************************************************************
** DETERMINE IF this quote HAS already been converted???
****************************************************************
FUNCTION ALREADY_CONV(QUOTE_NUM)
LOCAL RETVAL, M1, M2, M3
LOCAL SVSEL := SELECT()
LOCAL SVORD := INDEXORD()
SELECT ORD_MAST
SET ORDER TO 3 // QUOTE NUMBER INDEX
IF DBSEEK(QUOTE_NUM)
CLEAR TYPEAHEAD
M1 := 'Quote number - ' + QUOTE_NUM + ' has ALREADY been converted.'
M2 := ' '
M3 := ' CONTACT SUPERVISOR TO RE-CONVERT THIS QUOTE '
ERR_BOX(M1,M2,M3)
IF LASTKEY() == 126 // "~"
RETVAL := .T. //Quote ALREADY converted, allow conversion - OVERRIDE
ELSE
RETVAL := .F. //Quote ALREADY converted, DO NOT allow conversion
ENDIF
ELSE
RETVAL := .T. //Quote NEVER converted, allow conversion
ENDIF
SET ORDER TO SVORD
SELECT(SVSEL)
RETURN RETVAL
****************************************************************
FUNCTION QUOTECOPY(Q_NUM, NEW_ORDR, DATAFROM, FINALFILE)
LOCAL APP_FROM
LOCAL DATATO := 'USERFILE3'
LOCAL COPYTO := &DATATO
SELECT (DATAFROM)
**COPY STRUCT TO &COPYTO
COPYSTRUCT( COPYTO , .T. )
DBOPEN(FINALFILE)
SELECT (DATAFROM)
SEEK Q_NUM
DO WHILE ORDER_NUM == Q_NUM .AND. !EOF()
ADD_ONEREC( DATAFROM, FINALFILE )
SELECT (FINALFILE)
REPLACE ORDER_NUM WITH NEW_ORDR
UNLOCK
SELECT (DATAFROM)
SKIP 1
ENDDO
*****05-7-97
** SELECT (DATAFROM)
** **COPY STRUCT TO &COPYTO
** COPYSTRUCT( COPYTO , .T. )
**
** DBOPEN(DATATO,.T.)
**
** SELECT (DATAFROM)
** SEEK Q_NUM
** DO WHILE ORDER_NUM == Q_NUM .AND. !EOF()
** ADD_ONEREC( DATAFROM, DATATO )
** SELECT (DATAFROM)
** SKIP 1
** ENDDO
**
** SELECT (DATATO)
** REPLACE ALL ORDER_NUM WITH NEW_ORDR
** USE
**
** SELECT (FINALFILE)
** FIL_LOCK(3)
** APP_FROM := &DATATO
** APPEND ALL FROM &APP_FROM
** UNLOCK
**
RETURN
**********************************************************************
FUNCTION CNV_ADDR(CSZ, EXTR_FLD)
LOCAL POS, POS2, ZIP_FND := .F., RET_VAL
CSZ := ALLTRIM(CSZ)
IF EMPTY(CSZ)
ELSE
POS := RAT(' ', CSZ)
IF POS > 0
IF EXTR_FLD == 'CITY'
CSZ := ALLTRIM(SUBSTR(CSZ, 1, POS))
POS := RAT(' ', CSZ)
IF POS > 0
RET_VAL := ALLTRIM(SUBSTR(CSZ, 1, POS))
ELSE
POS := RAT(',', CSZ)
IF POS > 0
RET_VAL := ALLTRIM(SUBSTR(CSZ, 1, POS-1))
ENDIF
ENDIF
ELSEIF EXTR_FLD == 'STATE'
ZIP_FND := FIND_ZIP(CSZ)
IF ZIP_FND
CSZ := ALLTRIM(SUBSTR(CSZ, 1, POS))
POS2 := RAT(' ', CSZ)
IF POS2 > 0
RET_VAL := ALLTRIM(SUBSTR(CSZ, POS2, POS-POS2))
ELSE
POS2 := RAT(',', CSZ)
IF POS2 > 0
POS2++
RET_VAL := ALLTRIM(SUBSTR(CSZ, POS2, POS-POS2))
ENDIF
ENDIF
ENDIF
IF EMPTY(RET_VAL)
ELSE
IF LEN(RET_VAL) == 2
ELSE
RET_VAL := NIL //STATE S/B AT LEAST 2 POSITIONS
ENDIF
ENDIF
ELSEIF EXTR_FLD == 'ZIP'
ZIP_FND := FIND_ZIP(CSZ)
IF ZIP_FND
RET_VAL := ALLTRIM(SUBSTR(CSZ, POS+1, LEN(CSZ)-POS))
ENDIF
ENDIF
ENDIF
ENDIF
IF RET_VAL <> NIL
RET_VAL := STRTRAN(RET_VAL, ',') // GET RID OF COMMA'S
ENDIF
RETURN RET_VAL
*****************************************************************
FUNCTION FIND_ZIP(CSZ)
LOCAL I, NUM_CTR := 0
FOR I := 1 TO LEN(CSZ)
IF SUBSTR(CSZ, I, 1)$'1234567890'
NUM_CTR++
ENDIF
NEXT
IF NUM_CTR > 4
RETURN .T.
ELSE
RETURN .F.
ENDIF
******************************************************************
FUNCTION CUT_SALEHIST( MORDER_NUM, MGL_ARR, MAPIXCODE )
//** P3N - 01/22/07 ADDED THE TAX ARRAY TO GET DETAILS
//** FOR THE ABW INTERFACE
LOCAL TAX_ARR := STAX_RATE( (CUR_MAST)->TAXSCH ) // GET THE TAX ARRAY
LOCAL TAX_DESC := TAX_ARR[3] // DESCRIPTION
LOCAL TAX_DET := TAX_ARR[4] // ALL COMPONENTS {RATE, DESC, GL_NUM}
LOCAL TAXCODE := 0
LOCAL I, SEEKKEY, SAVESEL := SELECT()
LOCAL RECARR := {}
LOCAL WORKARR
SEEKKEY := MORDER_NUM
SELECT SALEHIST
SEEK SEEKKEY
DO WHILE ORDER_NUM = SEEKKEY .AND. !EOF()
AADD( RECARR, RECNO() )
REC_LOCK(1)
REPLACE UPDATED WITH 'P'
SKIP 1
ENDDO
IF EMPTY(MGL_ARR)
UPD_SALEHIST(MORDER_NUM, ' ' , MAPIXCODE, (CUR_MAST)->TOTAL_AMT, 0,' ')
//**UPD_SALEHIST(MORDER_NUM, ' ' , MAPIXCODE, (CUR_MAST)->TOTAL_AMT)
ELSE
FOR I := 1 TO LEN(MGL_ARR)
TAXCODE := ASCAN( TAX_DET, {| X | ALLTRIM(MGL_ARR[I,1]) == ALLTRIM(X[3])} )
IF EMPTY(TAXCODE)
//** NO TAX DETAIL FOUND
UPD_SALEHIST(MORDER_NUM, MGL_ARR[I,1], MAPIXCODE, MGL_ARR[ I, 2 ], 0 , ' ' )
ELSE
// order # gl acct # GL AMT TAX PERCENT TAX AUTH CODE
UPD_SALEHIST(MORDER_NUM, MGL_ARR[I,1], MAPIXCODE, MGL_ARR[ I, 2 ], TAX_DET[TAXCODE,1], TAX_DET[TAXCODE,4] )
****UPD_SALEHIST(MORDER_NUM, GL_ARR[I,1], MAPIXCODE, GL_ARR[ I, 2 ])
ENDIF
NEXT
ENDIF
FOR I := 1 TO LEN( RECARR )
GOTO RECARR[I]
IF UPDATED$'P'
REC_LOCK(1)
REPLACE ORDER_NUM WITH ' '
REPLACE GL_NUM WITH ' '
DELETE
ENDIF
NEXT
SELECT (SAVESEL)
RETURN .T.
******************************************************************
* UPDATE THE SALE HISTORY RECORD APPROPRIATELY
******************************************************************
//**FUNCTION UPD_SALEHIST(MORDER_NUM, GL_NUM, MAPIXCODE, GL_AMT )
FUNCTION UPD_SALEHIST(MORDER_NUM, GL_NUM, MAPIXCODE, GL_AMT, PTXPCT, PTXCODE)
LOCAL SEEKKEY := MORDER_NUM + GL_NUM
SEEK SEEKKEY
IF !FOUND()
ADD_REC()
REPLACE ORDER_NUM WITH MORDER_NUM
REPLACE GL_NUM WITH GL_NUM
ELSE
REC_LOCK(1)
ENDIF
REPLACE UPDATED WITH ' '
REPLACE COMP_CODE WITH MAPIXCODE
REPLACE CUST_ID WITH (CUR_MAST)->CUST_ID
REPLACE IDATE_FST WITH (CUR_MAST)->IDATE_FST
REPLACE IDATE_LAST WITH (CUR_MAST)->IDATE_LAST
REPLACE SLSMAN WITH ( CUR_MAST )->SLSMAN
REPLACE AMOUNT WITH GL_AMT
IF FIELDPOS('TXPCT') > 0
REPLACE TXPCT WITH PTXPCT
ENDIF
IF FIELDPOS('TXCODE') > 0
IF EMPTY(PTXCODE)
//** NOT A TAX GL ACCOUNT - DO NOT UPDATE RECORD
ELSE
REPLACE TXCODE WITH PTXCODE
ENDIF
ENDIF
IF EMPTY(PTXCODE)
//** THIS IS NOT A TAX GL - DO NOT INCLUDE THE TAX SCHEDULE HERE
ELSE
//** THIS IS A TAX GL - INCLUDE THE TAX SCHEDULE HERE
REPLACE TAXSCHED WITH ( CUR_MAST )->TAXSCH
ENDIF
RETURN
******************************************************************
FUNCTION CUT_BILLTRAN( MORDER_NUM, MGL_ARR, PARTIAL_INVOICE )
LOCAL I, SEEKKEY, SAVESEL := SELECT(), TXBL := 0
LOCAL RECARR := {}
LOCAL WORKARR, RCODE := ''
STATIC MAPIXCODE
IF CUR_MAST <> 'ORD_MAST'
RETURN .T.
ENDIF
IF MAPIXCODE = NIL
MFG_LOC->(DBSEEK( MHOME_LOC_CODE ))
MAPIXCODE := MFG_LOC->MAPIX_CODE
ENDIF
SEEKKEY := MORDER_NUM
IF SELECT('BILLTRAN') > 0
SELECT BILLTRAN
ELSE
DBOPEN('BILLTRAN')
ENDIF
SEEK SEEKKEY
DO WHILE ORDER_NUM = SEEKKEY .AND. !EOF()
AADD( RECARR, RECNO() )
REC_LOCK(1)
REPLACE UPDATED WITH 'P'
SKIP 1
ENDDO
FOR I := 1 TO 2
// order #
IF I = 1
RCODE := 'RE'
ELSE
RCODE := 'RF'
ENDIF
SEEKKEY := MORDER_NUM + RCODE
SEEK SEEKKEY
IF !FOUND()
ADD_REC()
REPLACE ORDER_NUM WITH MORDER_NUM
REPLACE RCDCD WITH RCODE
REPLACE ACREC WITH 'A'
REPLACE COMNO WITH MAPIXCODE
REPLACE AGECD WITH '0'
ELSE
REC_LOCK(1)
ENDIF
REPLACE UPDATED WITH ' '
REPLACE CUSNR WITH (CUR_MAST)->CUST_ID
REPLACE INVNR WITH PADINDEX( VAL( (CUR_MAST)->INVOICENUM ), 6 )
REPLACE CLTCR WITH '0'
REPLACE MATCH WITH '00000'
IF I = 1
REPLACE CRMNR WITH '000000'
WORKDATE := DTOC( (CUR_MAST)->IDATE_FST )
*** REPLACE TRNDT WITH SUBS( WORKDATE,7,2) + SUBS(WORKDATE,1,2) + SUBS(WORKDATE,4,2)
REPLACE TRNDT WITH SUBS( WORKDATE,1,2) + SUBS(WORKDATE,4,2) + SUBS(WORKDATE,7,2)
REPLACE SALCD WITH 'R'
REPLACE INVAM WITH ( CUR_MAST )->TOTAL_AMT
REPLACE TXAM1 WITH ( CUR_MAST )->SALES_TAX //** P3N - 01/26/07
IF ZERO_ORDER() //** P3N - 02/20/07
REPLACE TXAM1 WITH 0 //** P3N - 02/20/07
ENDIF //** P3N - 02/20/07
REPLACE SLSNR WITH ( CUR_MAST )->SLSMAN
IF FIELDPOS('TXBLAMT') > 0
//** P3N - 01/22/07 - ABW INTERFACE
TXBL := (CUR_MAST)->ORD_L_TTL - (CUR_MAST)->ORD_D_TTL + (CUR_MAST)->ORD_M_TTL
TXBL += (CUR_MAST)->MISC_QTY1 * (CUR_MAST)->MISC_AMT1
TXBL += (CUR_MAST)->MISC_QTY2 * (CUR_MAST)->MISC_AMT2
TXBL += (CUR_MAST)->MISC_QTY3 * (CUR_MAST)->MISC_AMT3
TXBL += (CUR_MAST)->FUEL_CHRG
//**REPLACE TXBLAMT WITH TXBL //** P3N - 02/20/07
IF ZERO_ORDER() //** P3N - 02/20/07
REPLACE TXBLAMT WITH 0 //** P3N - 02/20/07
ELSE //** P3N - 02/20/07
REPLACE TXBLAMT WITH TXBL //** P3N - 02/20/07
ENDIF //** P3N - 02/20/07
ENDIF
IF FIELDPOS('TXSCHED') > 0
//** P3N - 01/22/07 - ABW INTERFACE
REPLACE TXSCHED WITH ( CUR_MAST )->TAXSCH
ENDIF
ELSE
// NOTHING TO DO?
ENDIF
NEXT
FOR I := 1 TO LEN( RECARR )
GOTO RECARR[1]
IF UPDATED$'P'
REC_LOCK(1)
REPLACE ORDER_NUM WITH ' '
REPLACE RCDCD WITH ' '
DELETE
ENDIF
NEXT
CUT_SALEHIST( MORDER_NUM, MGL_ARR, MAPIXCODE )
SELECT BILLTRAN
USE
SELECT (SAVESEL)
IF PARTIAL_INVOICE //** P3N - 12/01/98
INVOICE_SHIPPED(MORDER_NUM) //** MARK ALL SHIPPED ITEMS AS INVOICED
ELSE
INVOICE_ALL(MORDER_NUM) //** MARK ALL ITEMS AS INVOICED
ENDIF
RETURN .T.
*****************************************************************
* Create the BILLING transaction file to be sent to the AS/400
*****************************************************************
FUNCTION POST_BILLTRAN(OPTION, TITLE)
LOCAL COPYFILE := '', WORKFILE := USERFILE1 + '.TXT', CREATECODE := 0
LOCAL M1 := '', M2 := '', M3 := '', BATCH_APPEND := .T. , OUTVAR := ''
LOCAL SV_COLOR := SETCOLOR(), SVCLR, PROG := '', RPT_DONE := .F.
LOCAL ABWFILE := '', RETVAL := .T., CONT := .T.
LOCAL SVSCRN := SAVESCREEN()
//**L SV_COLOR := SETCOLOR(), SVCLR, PROG, BKUPFILE, BKUPDIR
DBOPEN('CONTROL')
ABWFILE := ALLTRIM(CONTROL->ABWSENDFIL)
SETCOLOR(SV_COLOR)
IF EMPTY(ABWFILE)
//** DO NOT CUT THE ABW FILE
//** - NOT REQUESTED (IE: VALID FILE NAME IN CONTROLFILE)
ELSE
CLS
SAYTITLE( TITLE, 'POST' )
@ 10,10 SAY ' *** About to Create the ABW transaction file '
@ 12,10 SAY SPACE(5)+'file name is - ' + ABWFILE
CORR := CORRCHEK()
IF CORR$'Y'
IF CUT_ABWTRANS(ABWFILE)
DBOPEN('BILLTRAN')
DBOPEN('CONTROL')
// PRINT BILLTRAN IF ANY ENTRIES
IF LASTREC() > 0
SVSCRN := SAVESCREEN()
PRNTDISP( 1, 'Billing Transaction Recap', 'BILLTRAN RECAP-F',.F., .F.,.T. ) // DON'T CLOSE DBFS
PRNT_DAYSALES()
RESTSCREEN(,,,,SVSCRN)
SETCOLOR(SV_COLOR)
ENDIF
RPT_DONE := .T.
ENDIF
ENDIF
ENDIF
CLS
SAYTITLE( TITLE, 'POST' )
@ 10,10 SAY ' *** About to Post Invoices to History '
@ 11,10 SAY ' *** and Send Transactions to AS/400 '
CORR := CORRCHEK()
IF CORR$'Y'
IF FILE(WORKFILE)
SVCLR := SETCOLOR(HREV)
@ 08,10 SAY ' ***** W A R N I N G W A R N I N G ***** '
SETCOLOR(SVCLR)
@ 10,10 SAY ' Billing DATA for transfer ALREADY EXISTS '
@ 11,10 SAY ' DO you want to: '
@ 14,10 SAY ' YES - ADD this batch to the EXISTING batch.'
@ 16,10 SAY ' NO - DELETE the EXISTING batch sending this batch ONLY.'
CORR := CORRCHEK(,,,,2)
IF CORR$'Y'
BATCH_APPEND := .T.
ELSEIF CORR$'N'
BATCH_APPEND := .F.
ELSE
//**RETURN .T.
RETVAL := .T.
CONT := .F.
ENDIF
ENDIF
IF CONT
@ 10,0 CLEAR
WAIT_BOX( '*** Posting Invoice Transactions to ', ;
'*** History and Creating MAPIX Transfer File')
DBOPEN('BILLTRAN')
DBOPEN('CONTROL')
IF RPT_DONE
//** REPORT ALREADY PRINTED DURING ABW PROCESS - DO NO PRINT AGAIN
ELSE
// PRINT BILLTRAN IF ANY ENTRIES AND NOT ALREADY DONE
IF LASTREC() > 0
PRNTDISP( 1, 'Billing Transaction Recap', 'BILLTRAN RECAP-F',.F., .F.,.T. ) // DON'T CLOSE DBFS
PRNT_DAYSALES()
ENDIF
ENDIF
COPYFILE := CONTROL->BT_SENDFIL
IF CPYTRFILE(@COPYFILE , WORKFILE, @CREATECODE )
//** TRANS FILE SUCCESSFULY COPIED TO RUNTIME FOLDER
SELECT BILLTRAN
SET FILTER TO
BILLTRAN->(DBGOTOP())
IF BILLTRAN->(EOF())
// NO DATA TO POST
ELSE
DO WHILE BILLTRAN->(!EOF())
IF RCDCD = 'RE'
OUTVAR := RCDCD + ACREC + COMNO + CUSNR + AGECD + INVNR ;
+ CRMNR + TRNDT + SALCD + CLTCR ;
+ PADINDEX( DON_INT( INVAM * 100 ), 13 ) ;
+ PADINDEX( DON_INT( CDSAL * 100 ), 13 ) ;
+ SLSNR ;
+ PADINDEX( DON_INT( INSCA * 100 ), 13 ) ;
+ PADINDEX( DON_INT( INVFR * 100 ), 13 ) ;
+ PADINDEX( DON_INT( 0 * 100 ), 13 ) ; //** send 0 to mapix for tax
+ SPACE(19) ;
+ MATCH
//** p3n 01/26/07 + PADINDEX( DON_INT( TXAM1 * 100 ), 13 ) ; //** txam1 now contains total sales tax for report
ELSE
OUTVAR := RCDCD + ACREC + COMNO + CUSNR + AGECD + INVNR ;
+ PADINDEX( DON_INT( INCST * 100 ), 13 ) ;
+ SHPWT ;
+ PADINDEX( DON_INT( DAINT * 100 ), 13 ) ;
+ PADINDEX( DON_INT( VAL(AGEDT) ), 6 ) ;
+ SPACE(62) ;
+ MATCH
//*********** + PADINDEX( DON_INT( SHPWT * 10 ), 9 ) ;
ENDIF
WRITEOUT( CREATECODE, OUTVAR )
BILLTRAN->(DBSKIP(+1))
ENDDO
FCLOSE(CREATECODE) // CLOSE REPORT FILE
RETVAL := BATCH_POSTED(BATCH_APPEND, COPYFILE, WORKFILE, 'MAPIX')
ENDIF
ENDIF
ENDIF
ENDIF
CLOSE DATABASES
RETURN RETVAL
//***************************************************************
//** P3N - 01/23/07
//** ASK THE USER IF THE BATCH POSTED SUCCESSFULLY
//** IF SO - CLEAR OUT FOR NEXT BATCH
//** ELSE - LEAVE ALONE
//***************************************************************
FUNCTION BATCH_POSTED(PBATCH_APPEND, PCPYFILE, PWKFILE, CMD)
LOCAL RETVAL := .T., M1 := '', M2 := '', M3 := ''
LOCAL PROG := ''
LOCAL COPYFILE := PCPYFILE, WORKFILE := PWKFILE, BATCH_APPEND := PBATCH_APPEND
LOCAL BKUPFILE := ''
LOCAL COPYFROM
LOCAL DATA1, DATA2, DATA3
COPYFILE := ALLTRIM( COPYFILE ) // 10-12-2020
WORKFILE := ALLTRIM( WORKFILE ) // 10-12-2020
DATA1 := MEMOREAD( COPYFILE )
DATA2 := MEMOREAD( WORKFILE )
IF BATCH_APPEND
//DATA1 := MEMOREAD( COPYFILE )
//DATA2 := MEMOREAD( WORKFILE )
LL_MEMOWRIT( COPYFILE, DATA1 + DATA2 ) // APPEND 1/20/20
// PROG := 'COPY ' + COPYFILE + ' + ' + WORKFILE + ' ' + COPYFILE
ELSE
LL_MEMOWRIT( COPYFILE, DATA2 ) // JUST NEW DATA 1/20/20
//PROG := 'COPY ' + WORKFILE + ' ' + COPYFILE
ENDIF
//CALL_OLAY( ,, PROG )
SETCOLOR(LNOR)
@ 10,0 CLEAR
M1 := ' *** DID the '+CMD+ ' Batch Transfer to ABW Properly? '
M2 := ' '
M3 := ' '
IF EMPTY(CMD) .OR. CMD = 'MAPIX'
M1 := ' *** DID the '+CMD+ ' Batch Transfer to the AS/400 Properly? '
//** M1 := ' *** DID the Batch Transfer to the AS/400 Properly? '
M2 := ' '
M3 := ' '
ENDIF
CLOSE DATABASES
IF CMD = 'MAPIX'
//** AT THIS TIME ONLY ASK FOR THE MAPX FILE
IF PROMPT_BOX(M1,M2,M3, 1) //Default to YES - transfered properly!
DBOPEN('BILLPOST', .T.)
// APPEND FROM &BILLTRAN
COPYFROM := ALLTRIM( BILLTRAN )
// APPEND FROM &BILLTRAN
APPEND FROM &COPYFROM
CLOSE BILLPOST
WAIT_BOX('** Performing CleanUp **', ;
'** Please Wait **')
BKUPFILE := ALLTRIM(SUBST(BILLTRAN, 3,8)) + '.DBF'
PROG := 'GDG.BAT BILLTRAN BAK'
CALL_OLAY( ,, PROG )
PROG := 'GDG.BAT SALEHIST BAK'
CALL_OLAY( ,, PROG )
PROG := 'COPY ' + BKUPFILE + ' ' + 'BILLTRAN.BAK'
//CALL_OLAY( ,, PROG )
COPYFILE ( BKUPFILE, 'BILLTRAN.BAK' ) // 1/20/20
BKUPFILE := ALLTRIM(SUBST(SALEHIST, 3,8)) + '.DBF'
PROG := 'COPY ' + BKUPFILE + ' ' + 'SALEHIST.BAK'
// CALL_OLAY( ,, PROG )
COPYFILE ( BKUPFILE, 'SALESHIST.BAK' )
DBOPEN('SALEHIST')
DBOPEN('BILLTRAN', .T.)
DO WHILE BILLTRAN->(!EOF())
IF SALEHIST->(DBSEEK(BILLTRAN->ORDER_NUM))
DO WHILE BILLTRAN->ORDER_NUM == SALEHIST->ORDER_NUM
SELECT SALEHIST
REC_LOCK(5)
REPLACE POST_DATE WITH DATE()
REPLACE POST_TIME WITH TIME()
UNLOCK
SALEHIST->(DBSKIP(+1))
ENDDO
SELECT BILLTRAN
REC_LOCK(5)
DELETE
UNLOCK
BILLTRAN->(DBSKIP(+1))
REC_LOCK(5)
DELETE
UNLOCK
ENDIF
BILLTRAN->(DBSKIP(+1))
ENDDO
SELECT BILLTRAN
PACK
ENDIF
ENDIF
RETURN RETVAL
//***************************************************************
//** P3N - 01/23/07 **
//** COPY THE TRANSACTION FILE TO THE RUNTIME FOLDER FOR BKUP **
//***************************************************************
FUNCTION CPYTRFILE(PCPYFILE, WORKFILE, CREATECODE)
LOCAL RETVAL := .T.
LOCAL COPYFILE := ALLTRIM(PCPYFILE), BKUPDIR := '', BKUPFILE := '', COPYEXT := '.TXT'
LOCAL FILSTRT := AT('\', COPYFILE), PROG
LOCAL EXTSTRT := AT('.', COPYFILE)
EXTSTRT := EXTSTRT+1
IF EMPTY(FILSTRT)
BKUPDIR := 'DATA'
BKUPFILE:= 'TRANS01'
ELSE
BKUPDIR := ALLTRIM(SUBST(COPYFILE,1,FILSTRT-1))
BKUPFILE := ALLTRIM(SUBST(COPYFILE,FILSTRT+1,((EXTSTRT-1)-FILSTRT-1)))
ENDIF
IF EMPTY(EXTSTRT)
COPYEXT := 'TXT'
ELSE
//**COPYEXT := ALLTRIM(SUBSTR(COPYFILE,EXTSTRT,LEN(COPYFILE)-EXTSTRT) )
COPYEXT := SUBSTR(COPYFILE,EXTSTRT )
ENDIF
//PROG := 'COPY '+ COPYFILE
// CALL_OLAY( ,, PROG )
TOFILE := SUBS( COPYFILE, AT( '\', COPYFILE )+1 )
COPYFILE( COPYFILE, TOFILE )
PROG := 'GDG.BAT '+BKUPFILE+' '+COPYEXT
CALL_OLAY( ,, PROG )
CREATECODE := FCREATE(WORKFILE)
IF CREATECODE < 0
?? ' ' + CHR(7)
ERR_BOX('** Trans file CREATE ERROR **', ;
' file name - ' + WORKFILE )
//**? 'TRANS FILE CREATE ERROR' + CHR(7)
//**WAIT
?? ' ' + CHR(7)
RETVAL := .F.
ENDIF
RETURN RETVAL
*****************************************************************
//** P3N - 01/23/07
//** Create the ABW INTERFACE
*****************************************************************
FUNCTION CUT_ABWTRANS(ABWFILE)
LOCAL RETVAL := .T., CORR := '', BATCH_APPEND := .T., CONT := .T., ASH := {}, I := 0
LOCAL WKABW := USERFILE3+'.TXT', OUTVAR := '', CREATECODE := 0, AREC := {}, BREC := {}
IF FILE(WKABW)
SVCLR := SETCOLOR(HREV)
@ 08,05 SAY ' ***** ABW W A R N I N G ABW W A R N I N G ABW ***** '
SETCOLOR(SVCLR)
@ 10,10 SAY ' ABW Transactions ALREADY EXIST '+SPACE(30)
@ 11,10 SAY ' DO you want to: '
@ 14,10 SAY ' YES - ADD this batch to the EXISTING ABW Transactions.'
@ 16,10 SAY ' NO - DELETE EXISTING batch sending ONLY this batch to ABW.'
CORR := CORRCHEK(,,,,2)
IF CORR$'Y'
BATCH_APPEND := .T.
ELSEIF CORR$'N'
BATCH_APPEND := .F.
ELSE
RETVAL := .F.
CONT := .F.
ENDIF
ENDIF
IF CONT
IF CPYTRFILE(@ABWFILE, WKABW, @CREATECODE)
//**READY TO GO
DBOPEN('BILLTRAN')
DBOPEN('SALEHIST')
DBOPEN('BILLPOST', .T.)
//**
@ 10,0 CLEAR
WAIT_BOX( '*** Creating the ABW Transaction ', ;
'*** Transfer File - ' + ABWFILE )
SELECT BILLTRAN
SET FILTER TO
//**GOTO TOP
BILLTRAN->(DBGOTOP())
IF BILLTRAN->(EOF())
// NO DATA TO POST
ELSE
DO WHILE BILLTRAN->(!EOF())
ASH := GET_SH()
AREC := ASH[1]
BREC := ASH[2]
IF BILLTRAN->RCDCD = 'RE'
OUTVAR := 'A' + BILLTRAN->COMNO + BILLTRAN->INVNR
OUTVAR += BILLTRAN->CUSNR + BILLTRAN->TRNDT
OUTVAR += PADINDEX( DON_INT( BILLTRAN->INVAM * 100 ), 13, 'ABW' )
OUTVAR += BILLTRAN->SLSNR
OUTVAR += PADINDEX( DON_INT( BILLTRAN->TXBLAMT*100 ), 13, 'ABW' )
OUTVAR += BILLTRAN->TXSCHED
FOR I := 1 TO 9
IF I <= LEN(AREC)
OUTVAR += AREC[I,1] //** TAX AUTH CODE
OUTVAR += PADINDEX( DON_INT( AREC[I,3]*100000), 7, 'ABW' ) //**TAX PCT
OUTVAR += PADINDEX( DON_INT( AREC[I,2]*100 ), 13, 'ABW' ) //**TAX AMT
ELSE
OUTVAR += ' '
OUTVAR += PADINDEX( DON_INT( 0 ), 7 , 'ABW' )
OUTVAR += PADINDEX( DON_INT( 0 ), 13, 'ABW' )
ENDIF
NEXT
WRITEOUT( CREATECODE, OUTVAR )
FOR I := 1 TO LEN(BREC)
OUTVAR := 'B' + BILLTRAN->COMNO + BILLTRAN->INVNR
OUTVAR += BREC[I,1]
OUTVAR += PADINDEX( DON_INT( BREC[I,2]*100 ), 13, 'ABW' )
WRITEOUT( CREATECODE, OUTVAR )
NEXT
ENDIF
BILLTRAN->(DBSKIP(+1))
ENDDO
ENDIF
FCLOSE(CREATECODE) // CLOSE REPORT FILE
RETVAL := BATCH_POSTED(BATCH_APPEND, ABWFILE, WKABW, 'ABW')
IF FILE('CGW2ABW.BAT') //** P3N - 02/21/07
CALL_OLAY( ,, 'CGW2ABW.BAT') //** P3N - 02/21/07
ENDIF
ENDIF
ENDIF
CLOSE DATABASES
RETURN RETVAL
*****************************************************************
//** P3N - 01/24/07
//** ABW INTERFACE FILE
//** GET ALL SALEHIST INFO FOR A BILLTRAN RECORD
*****************************************************************
FUNCTION GET_SH()
LOCAL AREC := {}, BREC := {}
LOCAL SEEKKEY := BILLTRAN->ORDER_NUM
IF SALEHIST->(DBSEEK(SEEKKEY))
DO WHILE SALEHIST->ORDER_NUM == SEEKKEY .AND. ;
SALEHIST->(!EOF())
AADD(BREC, {SALEHIST->GL_NUM, SALEHIST->AMOUNT})
IF EMPTY(SALEHIST->TXCODE)
ELSE
AADD(AREC, {SALEHIST->TXCODE, SALEHIST->AMOUNT, SALEHIST->TXPCT})
ENDIF
SALEHIST->(DBSKIP(+1))
ENDDO
ENDIF
RETURN {AREC,BREC}
*****************************************************************
* Clear the current billing transaction file.
*****************************************************************
FUNCTION ZAP_BILLTRAN(OPTION, TITLE)
LOCAL COPYFILE, WORKFILE := USERFILE1 + '.TXT', CREATECODE, OUTVAR
LOCAL M1, M2, M3
CLS
SAYTITLE( TITLE, 'BZAP' )
M1 := ' *** DO You Wish to ZAP the Current File'
M2 := ' *** Without going thru the AS/400 Post'
M3 := ' '
IF PROMPT_BOX(M1,M2,M3)
DBOPEN('BILLTRAN', .T.)
SELECT BILLTRAN
ZAP
ENDIF
IF LASTKEY() = 27
RETURN
ENDIF
CLOSE DATABASES
RETURN
*****************************************************************
* Review the billing transaction files which have been posted.
*****************************************************************
FUNCTION REV_BILLTRAN(OPTION ,TITLE )
LOCAL SVSCRN := SAVESCREEN(), PROG := ''
LOCAL CHOICE := 0, DISPFILE := 'SEND*.0*'
LOCAL WORKARR, FILSTRT, EXTSTRT, CURFILE
LOCAL DISPLARR := {}, STRT := 1, FILNM, FILSZ, FILDT, FILTM
DBOPEN('CONTROL')
DISPFILE := CONTROL->BT_SENDFIL
USE
WORKARR := DIRECTORY(DISPFILE)
//**IF EMPTY(WORKARR)
//** ERR_BOX('** NO file(s) found to review! **')
//**ELSE
CURFILE := ALLTRIM(DISPFILE)
IF FILE(CURFILE)
DISPLARR := BLD_DISPLARR(WORKARR, DISPLARR)
ELSE
DISPLARR := { CURFILE }
ENDIF
FILSTRT := AT('\', DISPFILE)
EXTSTRT := AT('.', DISPFILE)
EXTSTRT := EXTSTRT+1
IF EMPTY(FILSTRT)
DISPFILE:= 'TRANS'
ELSE
DISPFILE := ALLTRIM(SUBST(DISPFILE,FILSTRT+1,((EXTSTRT-1)-FILSTRT-1)))
ENDIF
WORKARR := DIRECTORY(DISPFILE+'*.0*')
//** SORT IN DATE/TIME ORDER
WORKARR := ASORT(WORKARR,,,{|X,Y| DTOS(X[3])+X[4] > DTOS(Y[3])+Y[4] })
CLS
SAYTITLE( TITLE, 'REVBT' )
DISPLARR := BLD_DISPLARR(WORKARR, DISPLARR)
**DISPLARR := ASORT(DISPLARR,,,{|X,Y| SUBST(X,1,12) < SUBST(Y,1,12) })
IF EMPTY(WORKARR)
ERR_BOX('** NO file(s) found to review! **')
ELSE
DO WHILE .T.
CHOICE = PICKLIST(DISPLARR, 05, 20, 'Select File to Review', STRT, .F., .T.)
IF LASTKEY() = 27
EXIT
ENDIF
PROG := ''
IF CHOICE = 1
IF FILE(CURFILE)
PROG := 'BROWSE ' + CURFILE
PROG := 'NOTEPAD.EXE ' + CURFILE
ELSE
ERR_BOX('** File '+ CURFILE + ' NOT found to review! **')
ENDIF
ELSE
// PROG := 'BROWSE ' + WORKARR[CHOICE-1,1]
PROG := 'NOTEPAD.EXE ' + WORKARR[CHOICE-1,1]
ENDIF
IF EMPTY(PROG)
//** NO BROWSE - CONTINUE
ELSE
CALL_OLAY(,,PROG, 0, '', '')
ENDIF
ENDDO
ENDIF
//**ENDIF
RESTSCREEN(,,,,SVSCRN)
RETURN
//****************************************************
//** P3N 01/25/07 - ABW TRANSACTION INTERFACE
//****************************************************
FUNCTION REV_ABWTRAN(OPTION ,TITLE )
LOCAL SVSCRN := SAVESCREEN(), PROG := ''
LOCAL CHOICE := 0, DISPFILE := 'ABWT*.0*'
LOCAL WORKARR, FILSTRT, EXTSTRT, CURFILE
LOCAL DISPLARR := {}, STRT := 1, FILNM, FILSZ, FILDT, FILTM
DBOPEN('CONTROL')
DISPFILE := CONTROL->ABWSENDFIL
USE
WORKARR := DIRECTORY(DISPFILE)
CURFILE := ALLTRIM(DISPFILE)
IF FILE(CURFILE)
DISPLARR := BLD_DISPLARR(WORKARR, DISPLARR)
ELSE
DISPLARR := { CURFILE }
ENDIF
FILSTRT := AT('\', DISPFILE)
EXTSTRT := AT('.', DISPFILE)
EXTSTRT := EXTSTRT+1
IF EMPTY(FILSTRT)
DISPFILE:= 'ABWTR'
ELSE
DISPFILE := ALLTRIM(SUBST(DISPFILE,FILSTRT+1,((EXTSTRT-1)-FILSTRT-1)))
ENDIF
WORKARR := DIRECTORY(DISPFILE+'*.0*')
//** SORT IN DATE/TIME ORDER
WORKARR := ASORT(WORKARR,,,{|X,Y| DTOS(X[3])+X[4] > DTOS(Y[3])+Y[4] })
CLS
SAYTITLE( TITLE, 'REVABW')
DISPLARR := BLD_DISPLARR(WORKARR, DISPLARR)
IF EMPTY(WORKARR)
ERR_BOX('** NO file(s) found to review! **')
ELSE
DO WHILE .T.
CHOICE = PICKLIST(DISPLARR, 05, 20, 'Select File to Review', STRT, .F., .T.)
IF LASTKEY() = 27
EXIT
ENDIF
PROG := ''
IF CHOICE = 1
IF FILE(CURFILE)
// PROG := 'BROWSE ' + CURFILE
PROG := 'NOTEPAD ' + CURFILE
ELSE
ERR_BOX('** File '+ CURFILE + ' NOT found to review! **')
ENDIF
ELSE
// PROG := 'BROWSE ' + WORKARR[CHOICE-1,1]
PROG := 'NOTEPAD.EXE ' + WORKARR[CHOICE-1,1]
ENDIF
IF EMPTY(PROG)
//** NO BROWSE - CONTINUE
ELSE
CALL_OLAY(,,PROG, 0, '', '')
ENDIF
ENDDO
ENDIF
RESTSCREEN(,,,,SVSCRN)
RETURN
**************************************************************
*
**************************************************************
FUNCTION BLD_DISPLARR(WORKARR, DISPLARR, NOSIZE)
IF EMPTY(NOSIZE)
NOSIZE := .F.
ENDIF
FOR I := 1 TO LEN(WORKARR)
FILNM := WORKARR[I,1]
FILSZ := STR(WORKARR[I,2], 12)
FILDT := DTOC(WORKARR[I,3])
FILTM := WORKARR[I,4]
IF NOSIZE
AADD(DISPLARR, FILNM + ' ' + FILDT + ' ' + FILTM)
ELSE
AADD(DISPLARR, FILNM + ' ' + FILSZ + ' '+ FILDT + ' ' + FILTM)
ENDIF
NEXT
RETURN DISPLARR
**************************************************************
FUNCTION PRNT_DAYSALES()
LOCAL SEEKKEY, SAVESEL := SELECT()
IF SELECT('SALEHIST') > 0 //** P3N - 7/22/98 ENSURE ALL TRANS.
SELECT(SALEHIST) //** WRITTEN TO DISK PRIOR TO CREATING
USE //** THE SALES HISTORY RECAP RPT.
ENDIF
DBOPEN( 'SALEHIST',.T. )
COPY STRUCT TO &USERFILE1
NET_USE( USERFILE1, .T., 3, 'USERFILE1')
SELECT BILLTRAN
GOTO TOP
DO WHILE !EOF()
SEEKKEY := BILLTRAN->ORDER_NUM
SELECT SALEHIST
SEEK SEEKKEY
DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF()
ADD_ONEREC( 'SALEHIST', 'USERFILE1' )
SELECT SALEHIST
SKIP 1
ENDDO
SELECT BILLTRAN
SKIP 1
ENDDO
CLOSE USERFILE1
CLOSE SALEHIST
NET_USE( USERFILE1, .F. , 3, 'SALEHIST')
PRNTDISP( 1, 'Daily Sales History Recap', 'SALEHIST RECAP-F',.F., .F.,.T. ) // DON'T CLOSE DBFS
CLOSE SALEHIST
SELECT(SAVESEL)
RETURN .T.
*******************************************************************
* REPLACE ALL (LAST) PRINT DATES WITH EMPTY VALUES
*******************************************************************
FUNCTION REPL_PRNTDT(KEY, FLD_DATE, FLD_TIME, FLD)
LOCAL SV_SCRN := SAVESCREEN()
LOCAL OGET := GETACTIVE()
LOCAL SV_SEL := SELECT()
LOCAL MSG, CORR
IF EMPTY(OGET) .OR. KEY = OGET:BUFFER
// NO CHANGES
ELSE
KEY := OGET:BUFFER
IF FLD_DATE = 'DDATE'
MSG := 'Delivery Tickets '
ELSEIF FLD_DATE = 'IDATE'
MSG := 'Customer Invoices '
ELSEIF FLD_DATE = 'PDATE'
MSG := 'Production Orders '
ELSEIF FLD_DATE = 'ODATE'
MSG := 'Order Desk Copies '
ELSEIF FLD_DATE = 'XDATE'
MSG := 'Intercompany POs '
ELSEIF FLD_DATE = 'BDATE'
MSG := 'PreBill Invoices '
ELSEIF FLD_DATE = 'CDATE'
MSG := 'PreCost Invoices '
ELSEIF FLD_DATE = 'GDATE'
MSG := 'Golden Rod Copies '
ELSEIF FLD_DATE = 'BODATE' //** P3N - 4/30/98
MSG := 'Backorder Copies '
ELSE
MSG := ' '
ENDIF
CORR := PROMPT_BOX('Do you want to REPRINT ALL ' + MSG , ' ', ;
'From Order# - ' + ALLTRIM(KEY) ,1)
IF LASTKEY() == 27
ELSE
IF CORR
REC_LOCK()
REPLACE &FLD WITH KEY
UNLOCK
WAIT_BOX('Reseting ALL ' + MSG )
DBOPEN('ORD_MAST')
SET SOFTSEEK ON
IF FLD_DATE = 'BODATE' //** P3N - 4/30/98
UPD_DT := FLD_DATE + '_LST'
ELSE
UPD_DT := FLD_DATE + '_LAST'
ENDIF
IF FLD_TIME = 'BOTIME' //** P3N - 4/30/98
UPD_TM := FLD_TIME + '_LST'
ELSE
UPD_TM := FLD_TIME + '_LAST'
ENDIF
IF DBSEEK(KEY)
DBSKIP(+1)
ENDIF
SET SOFTSEEK OFF
DO WHILE !EOF()
REC_LOCK()
REPLACE &UPD_DT WITH CTOD(' / / ')
REPLACE &UPD_TM WITH SPACE(LEN(&UPD_TM))
UNLOCK
DBSKIP(+1)
ENDDO
USE
SELECT(SV_SEL)
ENDIF
ENDIF
ENDIF
RESTSCREEN(,,,,SV_SCRN)
RETURN .T.
**************************************************************
* STRIP THE DECIMAL OUT OF THE DOLLAR AMOUNT
**************************************************************
FUNCTION DON_INT(PASS_VAL)
LOCAL STRVAR, RETVAL, DECPT
STRVAR := STR(PASS_VAL)
DECPT = AT('.', STRVAR)
IF DECPT = 0
RETVAL = VAL(STRVAR)
ELSE
RETVAL = VAL(SUBSTR(STRVAR,1,DECPT-1) )
ENDIF
RETURN INT(RETVAL)
**************************************************************
* Validate the line notes print indicator
**************************************************************
FUNCTION LNOTES_VALID()
IF PRT_NOTES$' ABU'
RETURN .T.
ELSE
ERR_BOX(' *** Invalid value for Prt Notes Indicator ***', ;
' *** "A" - print notes ABOVE line item ***' ,;
' *** "B" - print notes BESIDE line item ***' ,;
' *** "U" - print notes UNDER line item ***' )
RETURN .F.
ENDIF
**************************************************************
* LEFT PAD A NUMBER TO ? POSITIONS WITH '0', AND RETURN A CHAR STRING
**************************************************************
FUNCTION PADINDEX(VAR2PAD, PADPOS, CMD)
LOCAL ZEROS := REPLICATE ( '0', PADPOS )
IF AT('-', STR(VAR2PAD)) > 0 // IS THIS NUMBER NEGATIVE??
IF EMPTY(CMD) //** P3N - 02/15/07
//** MAIPX - CONVERT THE NEGATIVE - OTHERWISE = ABW LEAVE AS NEGATIVE NUMBER
VAR2PAD := CNV_NEG(ALLTRIM(STR(VAR2PAD)))
VAR2PAD := STRTRAN(VAR2PAD,'-', '0')
ELSE //** P3N - 02/15/07
VAR2PAD := STR( VAR2PAD, PADPOS, 0 ) //** P3N - 02/15/07
ENDIF //** P3N - 02/15/07
RETURN RIGHT(ZEROS + ALLTRIM(VAR2PAD), PADPOS)
ELSE
RETURN RIGHT(ZEROS + ALLTRIM(STR(VAR2PAD)), PADPOS)
ENDIF
**************************************************************
* CONVERT THE NUMBER TO A NEGATIVE VALUE TO BE PASSED TO THE AS/400
**************************************************************
FUNCTION CNV_NEG(NUM)
LOCAL WKLEN := LEN(NUM)
LOCAL CNV_BYTE := SUBS(NUM,WKLEN,1)
IF CNV_BYTE = '0'
CNV_BYTE := '}'
ELSEIF CNV_BYTE = '1'
CNV_BYTE := 'J'
ELSEIF CNV_BYTE = '2'
CNV_BYTE := 'K'
ELSEIF CNV_BYTE = '3'
CNV_BYTE := 'L'
ELSEIF CNV_BYTE = '4'
CNV_BYTE := 'M'
ELSEIF CNV_BYTE = '5'
CNV_BYTE := 'N'
ELSEIF CNV_BYTE = '6'
CNV_BYTE := 'O'
ELSEIF CNV_BYTE = '7'
CNV_BYTE := 'P'
ELSEIF CNV_BYTE = '8'
CNV_BYTE := 'Q'
ELSEIF CNV_BYTE = '9'
CNV_BYTE := 'R'
ENDIF
RETURN SUBS(NUM,1,WKLEN-1) + CNV_BYTE
************************************************************************
FUNCTION WRITEOUT( CREATECODE, OUTVAR )
LOCAL NUMWRITTEN
OUTVAR = OUTVAR + CHR(13) + CHR(10)
NUMWRITTEN := FWRITE(CREATECODE, OUTVAR, LEN(OUTVAR) )
IF NUMWRITTEN <> LEN(OUTVAR)
? 'WRITE ERROR - TEXT FILE' + CHR(7)
WAIT
RETURN -1
ENDIF
RETURN 0
************************************************************
* GET THE ORDER NUMBER INTO THE GL ALLOC RECORD!!! *
************************************************************
FUNCTION UPD_GLORD(MORDER_NUM)
REPLACE ORDER_NUM WITH MORDER_NUM
RETURN .T.
************************************************************
* UPDATE/OVERRIDE THE GL ALLOCATIONS PER USER REQUEST!!! *
************************************************************
FUNCTION UPD_GLALLOC(MORDER_NUM, PGL_ARR)
LOCAL SV_SCREEN := SAVESCREEN(), I, NOBEG_RECS := .F.
LOCAL SV_SEL := SELECT(), RET_ARR
LOCAL ACTION_CODE := GETAVAR('ACTION_CODE')
DBOPEN('GL_ALLOC')
SET FILTER TO ORDER_NUM == MORDER_NUM
GO TOP
IF GL_ALLOC->(EOF())
NOBEG_RECS := .T.
SAV_GLALLOC(MORDER_NUM, PGL_ARR)
ENDIF
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
ACD_PAR_CHILD(1, 'GL Allocation Override', {NIL, 'GL_ALLOC', .F. ,,'ADD',,,,,,.F., 'USERFILET'})
ELSE
ACD_PAR_CHILD(3, 'GL Allocation Override', {NIL, 'GL_ALLOC', .F. ,,'REV',,,,,,.F., 'USERFILET'})
ENDIF
IF SELECT('USERFILET') > 0
SELECT USERFILET
USE
ENDIF
IF LASTKEY() == 27 .AND. NOBEG_RECS
RET_ARR := {}
DEL_GLALLOC(MORDER_NUM)
ELSE
RET_ARR := GET_GLALLOC(MORDER_NUM)
ENDIF
IF SELECT('GL_ALLOC') > 0
SELECT GL_ALLOC
USE
ENDIF
SELECT(SV_SEL)
RESTSCREEN(,,,,SV_SCREEN)
RETURN RET_ARR
************************************************************
* BALANCE/VALIDATE THE GL ALLOC. FROM MGL_ARRAY(ARRAY) OR GL_ALLOC(DBF)
************************************************************
FUNCTION BAL_GLALLOC(MORDER_NUM, MGL_ARR)
LOCAL SV_SCRN := SAVESCREEN(), I
LOCAL SV_REC, GL_TOTAL := 0, RETVAL := .T.
LOCAL SV_SEL := SELECT()
LOCAL ORDTOTAL := (CUR_MAST)->TOTAL_AMT
IF EMPTY(MGL_ARR)
// BALANCE THE OVERRIDES TO THE ORDER TOTAL @ GL OVERRIDE ENTRY TIME!!
IF SELECT('USERFILET') > 0
SELECT USERFILET
SV_REC := RECNO()
DBSKIP(+1)
IF EOF()
GO TOP
DO WHILE !EOF() .AND. ORDER_NUM == MORDER_NUM
IF EMPTY(AMOUNT) .AND. EMPTY(ADJ_AMT)
REC_LOCK(5)
DELETE
UNLOCK
ENDIF
GL_TOTAL := GL_TOTAL + (AMOUNT + ADJ_AMT)
DBSKIP(+1)
ENDDO
RETVAL := BAL_ERROR(GL_TOTAL, ORDTOTAL)
ENDIF
GOTO SV_REC
SELECT(SV_SEL)
ENDIF
ELSE
// BALANCE THE MGL_ARR TO THE ORDER TOTAL @ ORDER PRINT TIME!!!
FOR I := 1 TO LEN(MGL_ARR)
GL_TOTAL := GL_TOTAL + MGL_ARR[I,2]
NEXT
RETVAL := BAL_ERROR(GL_TOTAL, ORDTOTAL)
ENDIF
RESTSCREEN(,,,,SV_SCRN)
RETURN RETVAL
************************************************************
* TOTAL ALL LINES FOR AN ORDER IN GL_ALLOC(DBF)
************************************************************
FUNCTION TOT_GLALLOC(MORDER_NUM, FILE2USE, SAY)
LOCAL GL_TOTAL := 0, RETVAL
LOCAL SV_REC := RECNO()
LOCAL SV_SEL := SELECT()
LOCAL SV_COLR := SETCOLOR(HNOR)
// TOTAL OVERRIDES FOR THE ORDER
IF EMPTY(FILE2USE)
SELECT USERFILET
GO TOP
ELSEIF FILE2USE = 'GL_ALLOC'
SELECT GL_ALLOC
DBSEEK(MORDER_NUM)
ELSE
SELECT USERFILET
GO TOP
ENDIF
DO WHILE !EOF() .AND. ORDER_NUM == MORDER_NUM
GL_TOTAL := GL_TOTAL + (AMOUNT + ADJ_AMT)
DBSKIP(+1)
ENDDO
SELECT(SV_SEL)
GOTO SV_REC
IF SAY
@ 03, 45 CLEAR TO 03, 70
@ 03, 45 SAY 'Total GL Alloc = ' + ALLTRIM(PADR(LTRIM(STR(GL_TOTAL, 9,2)),11))
RETVAL := .T.
ELSE
RETVAL := 'Total GL Alloc = ' + ALLTRIM(PADR(LTRIM(STR(GL_TOTAL, 9,2)),11))
ENDIF
SETCOLOR(SV_COLR)
RETURN RETVAL
************************************************************
* DETERMINE IF THE GL ALLOCATION IS EQUAL TO THE ORDER TOTAL
* IF NOT DISPLAY AN ERROR MESSAGE!!!
************************************************************
FUNCTION BAL_ERROR(GL_TOTAL, ORDTOTAL)
LOCAL DIFFAMT, DIFFVAL, RETVAL
IF VAL(STR(GL_TOTAL,9,2)) == ORDTOTAL
RETVAL := .T.
ELSE
DIFFAMT := ORDTOTAL - GL_TOTAL
IF ORDTOTAL > GL_TOTAL
DIFFVAL := SPACE(10) + 'ORDER TOTAL > GL ALLOC. by '
ELSE
DIFFVAL := SPACE(10) + 'GL ALLOC. > ORDER TOTAL by '
ENDIF
ERR_BOX('** Order Total and GL Allocations DO NOT Balance! **' ,;
' Order Total = '+ ALLTRIM(STR(ORDTOTAL,9,2)) + ;
' GL Alloc Total = ' + ALLTRIM(STR(GL_TOTAL, 9,2)), ;
DIFFVAL + ALLTRIM(STR(DIFFAMT , 9,2)) )
RETVAL := .F.
ENDIF
RETURN RETVAL
************************************************************
*****************************************************************
* SAVE THE GL ALLOCATIONS FOR A GIVEN ORDER IN THE GL_ALLOC DBF.
*****************************************************************
FUNCTION SAV_GLALLOC(MORDER_NUM, GL_ARR)
//** GL_ARR-1 = GL_NUM
//** GL_ARR-2 = GL_AMT
//** GL_ARR-3 = GL_TAX_DESC
//** GL_ARR-4 = GL_TAX_IND - "X" EXCLUDE FROM TAX ALLOC
//** "I" INCLUDE IN TAX ALLOC
//** "P" PRODUCT ALLOCATION
LOCAL I, GL
LOCAL SV_SEL := SELECT()
DBOPEN('GL_ALLOC')
FOR I := 1 TO LEN(GL_ARR)
IF !DBSEEK(MORDER_NUM+GL_ARR[I,1]) //ORDER_NUM + GL_NUM
ADD_REC(5)
ELSE
REC_LOCK(5)
ENDIF
REPLACE ORDER_NUM WITH MORDER_NUM
REPLACE GL_NUM WITH GL_ARR[I,1]
REPLACE AMOUNT WITH GL_ARR[I,2]
IF LEN(GL_ARR[I]) >= 3 // SOMETIMES ONLY 2 ELM'S IN GL_ARR
IF EMPTY(GL_ARR[I,3])
ELSE
REPLACE TAX_DESC WITH GL_ARR[I,3]
ENDIF
ENDIF
IF LEN(GL_ARR[I]) >= 4 //SOMETIMES ONLY 2 OR 3 ELM'S IN GL_ARR
IF EMPTY(GL_ARR[I,4])
ELSE
REPLACE TAX_ALLOC WITH GL_ARR[I,4]
ENDIF
ENDIF
UNLOCK
NEXT
USE
SELECT(SV_SEL)
RETURN
************************************************************
************************************************************
FUNCTION GET_PO_NUM( MORDER_NUM, MLOC_CODE, ADD_NEW )
LOCAL SAVESEL := SELECT(), MPO_NUM
SELECT IPO_FILE
DONSETORD(3) // ORDER# + LOC_CODE
IF IPO_FILE->(DBSEEK ( MORDER_NUM + MLOC_CODE ) )
MPO_NUM := IPO_FILE->PO_NUM
ELSE
IF ADD_NEW
MPO_NUM := NEW_PO_NUM()
SELECT IPO_FILE
ADD_REC(1)
REPLACE PO_NUM WITH MPO_NUM
REPLACE LOC_CODE WITH MLOC_CODE
REPLACE ORDER_NUM WITH MORDER_NUM
REPLACE PO_DATE WITH CURDATE
ELSE
MPO_NUM := SPACE( LEN( IPO_FILE->PO_NUM ) )
ENDIF
ENDIF
SELECT (SAVESEL)
RETURN MPO_NUM
************************************************************
* DELETE THE GL ALLOCATION RECS FOR A GIVEN ORDER NUMBER-GL_ALLOC(DBF)
************************************************************
FUNCTION DEL_GLALLOC(MORDER_NUM)
LOCAL SV_SEL := SELECT(), DEL_CNTR := 0
DBOPEN('GL_ALLOC')
IF DBSEEK(MORDER_NUM)
DO WHILE !EOF() .OR. ORDER_NUM == MORDER_NUM
REC_LOCK(5)
DELETE
UNLOCK
DBSKIP(+1)
ENDDO
ENDIF
GOTO 1
DO WHILE !EOF()
IF DELETED()
DEL_CNTR := DEL_CNTR + 1
ENDIF
DBSKIP(+1)
ENDDO
IF EMPTY(DEL_CNTR)
USE
ELSE
DBOPEN('GL_ALLOC', .T.)
PACK
USE
ENDIF
SELECT(SV_SEL)
RETURN
*********************************************************
*********************************************************
*********************************************************
FUNCTION NEW_PO_NUM( )
LOCAL OPENCNTL := .F., SAVESEL := SELECT(), RETVAL
IF SELECT('CONTROL') = 0
OPENCNTL := .T.
DBOPEN( 'CONTROL')
ENDIF
REC_LOCK(1)
RETVAL := VAL(CONTROL->PO_NUM) + 1
RETVAL := STR( RETVAL, 6 )
REPLACE CONTROL->PO_NUM WITH RETVAL
UNLOCK
IF OPENCNTL
CLOSE CONTROL
ENDIF
SELECT (SAVESEL)
RETURN RETVAL
************************************************************************
* IS THERE A CUSTOMER PO WITH THE SAME PO NUMBER??
************************************************************************
FUNCTION DUPL_CUST_PO(MORDER_NUM)
//**LOCAL SVORD := (CUR_MAST)->(INDEXORD())
LOCAL SVREC := (CUR_MAST)->(RECNO()), ORGORD
LOCAL SVSEL := SELECT(), RETVAL := .T., DUPL_PO := .F.
LOCAL ELM := ASCAN(GETVARS,{|X| X[3] == 'CUST_PO'})
LOCAL ELMID := ASCAN(GETVARS,{|X| X[3] == 'CUST_ID'})
LOCAL MSG_PO, MSG_CUST, MSG_ORD, KEYPO, KEYID, MSG1, MSG2, MSG3
IF (EMPTY(ELM) .OR. EMPTY(ELMID) .OR. EMPTY(GETVARS[ELM, 4])) .AND. ;
(GETVARS[ELM, 2] == GETVARS[ELM,4] .OR. ; // CUST_PO CHANGED???
GETVARS[ELMID, 2] == GETVARS[ELMID,4]) // CUST_ID CHANGED???
ELSE
//** SET SOFTSEEK ON //PARTIAL KEY READ
//** SET ORDER TO 4 //CUST_PO + CUST_ID + ORDER_NUM
ORGORD := DONSETORD(4) //CUST_PO + CUST_ID + ORDER_NUM
KEYPO := GETVARS[ELM, 4] //CUST_PO ENTERED
KEYID := GETVARS[ELMID, 4] //CUST_ID ENTERED
(CUR_MAST)->(DBSEEK(KEYPO+KEYID), .T.)
DUPL_PO := .F.
DO WHILE (CUR_MAST)->(!EOF())
IF ((CUR_MAST)->CUST_PO == KEYPO .AND. (CUR_MAST)->CUST_ID == KEYID)
IF (CUR_MAST)->ORDER_NUM == MORDER_NUM
DUPL_PO := .F.
(CUR_MAST)->(DBSKIP(+1))
ELSE
DUPL_PO := .T.
EXIT
ENDIF
ELSE
DUPL_PO := .F.
EXIT
ENDIF
ENDDO
//** SET SOFTSEEK OFF // RETURN TO ORIGINAL SETTING
SELECT (CUR_MAST)
//** SET ORDER TO SVORD // ORIGINAL INDEX ORDER!!!
DONSETORD(ORGORD) //ORIGINAL INDEX ORDER
ENDIF
MSG_ORD := ALLTRIM((CUR_MAST)->ORDER_NUM)
SELECT(SVSEL) // ORIGINAL SELECT
GOTO(SVREC) // ORIGINAL RECORD
IF DUPL_PO
RETVAL := DUPL_PO_MSG(MSG_PO, MSG_CUST, MSG_ORD, MSG1, MSG2, MSG3)
ELSE
RETVAL := .T.
ENDIF
RETURN RETVAL
************************************************************************
* SEND THE USER THE DUPLICATE CUSTOMER PO MESSAGE
************************************************************************
FUNCTION DUPL_PO_MSG(MSG_PO, MSG_CUST, MSG_ORD, MSG1, MSG2, MSG3)
LOCAL SVSEL := SELECT(), SVSCREEN //** P3N - 8/18/99
LOCAL SVREC := (CUR_MAST)->(RECNO()) //** P3N - 8/18/99
LOCAL ORD_PARMS, SEEKKEY, SVGETLIST //** P3N - 8/18/99
LOCAL RETVAL := .T., PREVKEY, ESCKEY
LOCAL oGET := GETACTIVE() //** P3N - 8/26/99
IF EMPTY( OGET )
ELSE
MSG_PO := ALLTRIM(oGET:BUFFER) //** P3N - 8/26/99
//**MSG_PO := ALLTRIM((CUR_MAST)->CUST_PO)
MSG_CUST := ALLTRIM((CUR_MAST)->CUST_ID)
//**MSG_ORD := ALLTRIM((CUR_MAST)->ORDER_NUM)
MSG1 := 'Customer - '+MSG_CUST+' P. O. - '+MSG_PO+' Already EXISTS!'
MSG2 := 'Check ORDER Number - '+MSG_ORD
MSG3 := 'Do you want to continue?'
ERR_BOX (MSG1, MSG2, 'Press Enter to continue or F5 to review orders!')
//** 'Check ORDER Number - '+MSG_ORD )
//**CONT := PROMPT_BOX(MSG1, MSG2, MSG3)
IF LASTKEY() == 13
//**ELSEIF CONT
ELSEIF LASTKEY() == K_F5 //** P3N - 8/18/99
SVSCRN := SAVESCREEN() //** P3N - 8/18/99
SVGETLIST := SAVEGETS() //** P3N - 8/18/99
ORD_PARMS := DBOPEN( CUR_MAST ) //** P3N - 8/18/99
(CUR_MAST)->(DBSEEK(MSG_ORD), .T.) //** P3N - 8/18/99
DO WHILE .T. //** P3N - 8/18/99
SEEKKEY := GET_KEY(ORD_PARMS) //** P3N - 8/18/99
IF LASTKEY() = 27 //** P3N - 8/18/99
EXIT //** P3N - 8/18/99
ELSE //** P3N - 8/18/99
ESCKEY := CHG_REV_HOTKEY('REV') //** P3N - 8/18/99
ENDIF //** P3N - 8/18/99
ENDDO //** P3N - 8/18/99
CLEAR TYPEAHEAD //** P3N - 8/18/99
KEYBOARD CHR(0) //** P3N - 8/18/99
DO WHILE .T. //** P3N - 8/26/99
PREVKEY := INKEY() //** P3N - 8/26/99
IF PREVKEY = 0 //** P3N - 8/26/99
EXIT //** P3N - 8/26/99
ENDIF //** P3N - 8/26/99
ENDDO //** P3N - 8/26/99
//**KEYBOARD CHR(4)+CHR(78) // "N" NO for corrcheck() //** P3N - 8/18/99
RETVAL := .F. //** P3N - 8/18/99
RESTSCREEN(,,,,SVSCRN) //** P3N - 8/18/99
//** RESET ELEM 5 (CUSTID AS THE ACTIVE GET)
RESTGETS(SVGETLIST, 5) //** P3N - 8/18/99
ELSE
RETVAL := .F.
ENDIF
SELECT(SVSEL) // ORIGINAL SELECT //** P3N - 8/18/99
(CUR_MAST)->(DBGOTO(SVREC)) //** P3N - 8/18/99
ENDIF
RETURN RETVAL
****************************************************************
****************************************************************
* ARCHIVE ORDERS - INTO A SUB DIRECTORY
****************************************************************
FUNCTION ORD_ARCHIVE()
LOCAL SVSCRN := SAVESCREEN()
LOCAL ARCH_DATE := DATE(), ARCHIVE_DIR := 'ARCH'+DTOC(DATE())
LOCAL TITLE := 'Order Archive', CORR
ARCH_DATE := ARCH_DATE - 365
DO WHILE .T.
@ 2,0 CLEAR
SAYTITLE(TITLE, 'AS000')
//@ 11,11 SAY 'Enter Archive CUTOFF Date ' + DTOC(ARCH_DATE)
@ 11,11 SAY 'Enter Archive CUTOFF Date ' + DTOC(ARCH_DATE)
@ 11,37 GET ARCH_DATE
READ
IF LASTKEY() = 27
EXIT
ENDIF
IF EMPTY(ARCH_DATE)
ERR_BOX('Invalid Date')
LOOP
ELSEIF ARCH_DATE <= DATE() - 365
// GOOD DATE
ELSE
ERR_BOX('Date MUST be at least 1 year prior to ' + DTOC(DATE()))
LOOP
ENDIF
CORR := CORRCHEK()
IF CORR == 'Y'
@ 2,0 CLEAR
ARCHIVE_DIR := CHK_ARCHDIR(DTOS(ARCH_DATE))
IF ARCHIVE_DIR[1]
IF PROMPT_BOX(' ARCHIVE ALREADY EXISTS FOR ' + ARCHIVE_DIR[2]+SPACE(7) , ;
' This Archive will be OVERLAYED!', ;
' Do you want to continue? ')
*************** ' Do you want to continue? ', 1)
ARCH_ORDER('Archive CLOSED Orders prior to ', ARCH_DATE, ARCHIVE_DIR )
ELSE
EXIT
ENDIF
ELSE
ARCH_ORDER('Archive CLOSED Orders prior to ', ARCH_DATE, ARCHIVE_DIR )
ENDIF
EXIT
ELSEIF CORR == 'N'
LOOP
ELSE
EXIT
ENDIF
ENDDO
RESTSCREEN(,,,, SVSCRN)
RETURN
****************************************************************
* DETERMINE IF THE ARCHIVE DIRECTORY EXISTS.
****************************************************************
FUNCTION CHK_ARCHDIR(ARCH_DIR)
LOCAL CURDIR := DIRECTORY(SUBS(ARCH_DIR,1,7)+"*", 'D')
LOCAL ARCH_EXISTS := .F.
IF EMPTY(CURDIR)
ARCH_EXISTS := .F.
ELSE
IF ASCAN(CURDIR, {|X| X[1] == ARCH_DIR} ) > 0
ARCH_EXISTS := .T.
ELSE
ARCH_EXISTS := .F.
ENDIF
ENDIF
RETURN {ARCH_EXISTS, ARCH_DIR}
****************************************************************
* SELECT ALL ORDERS TO BE ARCHIVED & COPY TO ARCHIVE DIRECTORY
****************************************************************
FUNCTION ARCH_ORDER(TITLE, ARCH_DATE, ARCHIVE_ARR)
LOCAL ARCHDIR_EXISTS := ARCHIVE_ARR[1], TOTMAST, TOTQUOT
LOCAL ARCHIVE_DIR := ARCHIVE_ARR[2], ARCHFILE
LOCAL SVSCRN := SAVESCREEN()
LOCAL III
//**LOCAL MASTFILTER := {|ARCH_DATE|!EMPTY(ORD_MAST->IDATE_LAST).AND. ORD_MAST->IDATE_LAST < ARCH_DATE}
//** P3N - CHANGED TO ARCHIVE BASED ON THE ORDER SHIPPING DATE AS OPPOSED TO THE INVOICE DATE
//** THIS CHANGE WAS REQUESTED BY ELLEN AT KANSAS CITY ON 3/30/01
//** THIS CHANGE WILL ONLY EFFECT THE ORDERS
LOCAL MASTFILTER := {|ARCH_DATE|!EMPTY(ORD_MAST->SHIP_DATE).AND. ORD_MAST->SHIP_DATE < ARCH_DATE}
LOCAL QUOTFILTER := {|ARCH_DATE|!EMPTY(QUOTE_MAST->IDATE_LAST).AND. QUOTE_MAST->IDATE_LAST < ARCH_DATE}
LOCAL SVDATADICT := DATADICT, SVCOLOR
LOCAL COPYFROM
LOCAL COPYTO
LOCAL RETCOPYVAL
LOCAL DIRARR
@ 2,0 CLEAR
SAYTITLE(TITLE+DTOC(ARCH_DATE) , 'AO000')
WAIT_BOX('*** Selecting Orders & Quotes ***', ;
'*** Please Wait ***')
DBOPEN('QUOTE_MAST')
SET FILTER TO EVAL(QUOTFILTER, ARCH_DATE)
GO TOP
COUNT TO TOTQUOT WHILE AMSGMETER()
AMSGMETER(.T.)
DBOPEN('ORD_MAST')
SET FILTER TO EVAL(MASTFILTER, ARCH_DATE)
GO TOP
COUNT TO TOTMAST WHILE AMSGMETER()
CLOSE DATABASES
IF EMPTY(TOTQUOT) .AND. EMPTY(TOTMAST)
ERR_BOX('** No Orders / Quotes selected to Archive! **')
ELSE
WAIT_BOX('*** Preparing to Archive the following *** ', ;
'*** Orders - ' + ALLTRIM(STR(TOTMAST)) + ;
' Quotes - ' + ALLTRIM(STR(TOTQUOT)) , ;
'*** Copying files - Please Wait ***')
// COPY ALL DATABASE files TO THE ARCHIVE DIRECTORY
// CALL_OLAY(,,PROG, 0, '', '')
// **CPYTOFILES := ARCHIVE_DIR+'\*.*'
// **COPY FILE ('*.DB*') TO ('&CPYTOFILES')
// PROG := 'COPY *.DB* '+ ARCHIVE_DIR + ' >NUL'
@ 20,20 SAY 'Copying Files to Archive '
RETCOPYVAL := LMKDIR( ARCHIVE_DIR )
RETCOPYVAL := LMKDIR( ARCHIVE_DIR + '\BKUP' )
DIRARR := DIRECTORY( '*.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
@ 4,0 CLEAR
WAIT_BOX('*** Copying files *** ', ;
'*** Please Wait ***')
****************************************************************
* COPY ALL SPECIAL PRICING DATABASE files TO THE ARCHIVE DIRECTORY
****************************************************************
//**COLOR := SETCOLOR(HREV)
@ 20,20 SAY 'Processing Special Pricing Files'
//PROG := 'COPY *.0* '+ ARCHIVE_DIR + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( '*.0*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
****************************************************************
* COPY THE ORDER/QUOTE DATABASES TO BKUP\*.* IN THE ARCHIVE DIRECTORY
* THIS WILL ALLOW A RESTORE TO CURRENT STATE IF ANY PROBLEMS.
* TO RESTORE:
*
* USE RESTORE OPTION FROM UTILITY MENU OR MANUALLY
* COPY CGW*.DB* FROM ARCHIVE\BKUP DIRECTORY TO CURRENT DIRECTORY
* ( ENSURE YOU DO A REINDEX!!!)
****************************************************************
@ 20,20 SAY 'Processing Order Files '
//PROG := 'COPY CGW0O*.DB* '+ ARCHIVE_DIR + '\BKUP' + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( 'CGW0O*.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\BKUP' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
//PROG := 'COPY CGW0X*.DB* '+ ARCHIVE_DIR + '\BKUP' + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( 'CGW0X*.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\BKUP' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
@ 20,20 SAY 'Processing Quote Files '
//PROG := 'COPY CGW0Q*.DB* '+ ARCHIVE_DIR + '\BKUP' + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( 'CGW0Q*.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\BKUP' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
@ 20,20 SAY 'Processing Sales History '
//PROG := 'COPY CGW0SH.DB* '+ ARCHIVE_DIR + '\BKUP' + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( 'CGW0SH.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\BKUP' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
****************************************************************
* REMOVE ALL BACKUP (BAK*.DB* FILES)
****************************************************************
@ 20,20 SAY 'Removing All Temporary Work Files '
//PROG := 'DEL ' + ARCHIVE_DIR + '\BAK*.DB* '
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( ARCHIVE_DIR + '\BAK.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
//COPYTO := ARCHIVE_DIR + '\BKUP' + COPYFROM
RETCOPYVAL := FERASE( COPYFROM )
NEXT
****************************************************************
* COPY ALL DATADICT INDEX FILES FOR USE ON THE REINDEX FUNCTION
****************************************************************
//PROG := 'COPY CGW?DD.* '+ ARCHIVE_DIR + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( 'CGW?DD.*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
//** P3N - 4/8/98 COPY THE WORKSTATION INDEX INTO THE ARCHIVE!
//PROG := 'COPY CGW?WS.* '+ ARCHIVE_DIR + ' >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( 'CGW?WS.*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := ARCHIVE_DIR + '\' + COPYFROM
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
ARCHIVE_DIR := ARCHIVE_DIR + '\'
SETCOLOR(SVCOLOR)
@ 4,0 CLEAR
WAIT_BOX('*** Opening files *** ', ;
'*** Please Wait ***')
OPEN_ARCHIVE(ARCHIVE_DIR)
CLOSE ORD_MAST
CLOSE QUOTE_MAST
@ 4,0 CLEAR
WAIT_BOX('*** Archiving Orders/Quotes *** ', ;
'*** Please Wait ***')
SEL_ARCHIVE('ORD_MAST', 'AOMAST', ARCH_DATE)
SELECT AOMAST
INDEX ON ORDER_NUM TO AOMAST
CHILD_ARCH('ORDERS')
ERASE 'AOMAST.+INDEXEXT()'
SEL_ARCHIVE('QUOTE_MAST', 'AQMAST', ARCH_DATE)
SELECT AQMAST
INDEX ON ORDER_NUM TO AQMAST
CHILD_ARCH('QUOTES')
ERASE 'AQMAST.+INDEXEXT()'
@ 4,0 CLEAR
WAIT_BOX('*** Please wait while we cleanup! *** ')
DEL_OLD()
UTIL_OQFILES(,,'COMPRESSED', .F.)
CLOSE DATABASES
SVDATADICT := DATADICT
DBOPEN('DATADICT')
DBFARR := REASSIGN_DBFARR(ARCHIVE_DIR)
SETAVAR('SET', 'DBFARR', DBFARR) //** P3N -08/31/01 ADDRESS CHG IN DBOPEN
CLEAR TYPEAHEAD
KEYBOARD 'Y'
IND_PACK(,,,'REINDEXED',ARCHIVE_DIR) //REINDEX ALL - archive directory
/*
reindex all DATABASES:
WORKSTAT CGW0WS , Workstation File
CONTROL CGW0KA , Control File
PASSWORD CGW0PA , Password File
DATADICT CGW0DD , DATA DICTIONARY
IMPORT , CGW0IM , Import Files
IMPCUST , CGW0IC , Field Definitions
STDCUST , CGW0SC , SYSTEM STD CUST FILE
MATHPACK CGW0MP , Mathpack File
ERRFILE , CGW0EF , SYSTEM ERROR FILE
AUDITFILE CGW0AU , SYSTEM AUDIT FILE
CATEGORY CGW0PC , PRODUCT CATEGORIES
ATTRIBUTES CGW0AT , PRODUCT ATTRIBUTES
STD_SIZES CGW0SS , PROD STD/STK SIZE TABLE
PRI_EXTRAS CGW0PE , PRICE EXTRAS - CATEGORY
CAT_ATTS CGW0CA , CATEGORY ATTRIBUTES
CAT_OPTS , CGW0CO , CATEGORY ATTRIBUTE OPTS
PRODUCT , CGW0PR , COLUMBIA WINDOW PRODUCTS
PROD_ATTS , CGW0PT , MODEL ATTRIBUTES
PROD_OPTS , CGW0PO , MODEL ATTRIBUTE OPTS
RULEPACK , CGW0RP , RULE PACK
RULES , CGW0RU , RULES FILE
ORD_MAST , CGW0OM , ORDER MASTER
ORD_LINES , CGW0OL , Order Lines
ORDER_OPTS CGW0OO , Sales Order Options
ATT_OPTS , CGW0AO , Attribute Options
ADDL_LINES, CGW0XL , Additional Order Lines
ADDL_OPTS , CGW0XO , Additional Order Options
CUST_MAST , CGW0CM , Customer Master
CUST_PRICE, CGW0CP , CUSTOMER PRICING TABLE
QUOTE_MAST, CGW0QM , QUOTE MASTER
QUOTE_LINE, CGW0QL , QUOTE LINE ITEMS
QUOTE_ADDL, CGW0QX , QUOTE ADDL LINES
QUOTE_OPTS, CGW0QO , QUOTE OPTIONS
ADDL_QOPT , CGW0QXO , QUOTE ADDL LINE OPTIONS
TAX_DETAIL, CGW0TD , SALES TAX DETAIL
TAX_SCHED , CGW0TS , SALES TAX SCHEDULE
AR_INFO , CGW0AR , ACCNT RECIEVABLE INFO
SHIPMETH , CGW0SV , SHIP VIA METHODS
CUST_BP , CGW0CB , CUSTOMER BASE PRICE TABLE
CUST_BPLVL CGW0CBL , CUST BASE PRICE LEVELS
MFG_LOC , CGW0ML , Manufacturing Location
CUST_ATTS , CGW0CPT , CUSTOMER PROD ATTRIBUTES
CUST_OPTS , CGW0CPO , CUSTOMER PRODUCT OPTIONS
CUST_PE , CGW0CPE , CUST PRICE EXTRAS
STD_SASH , CGW0SBS , STD BOTTOM SASH TABLE
GLASS_BOX , CGW0GB , GLASS BOX SIZES
ATTRIB_CUT, CGW0AC , ATTRIBUTES CUTTING SPEC
CUT_SPEC , CGW0CS , CUTTING SEPECIFICATIONS
IPO_FILE , CGW0IPO , INTERCOMPANY PO'S
MISC_ITEMS CGW0MI , MISC ITEMS
MISC_PUOM , CGW0MIP , MISC ITEM PRICING / UOM'S
MISC_COLOR, CGW0MIC , MISC ITEMS COLORS
UOMFILE , CGW0MU , MASTER LIST UOM
COLOR_LIST CGW0MC , MASTER COLOR LIST
ORD_MISC , CGW0OMI , ORDER MISC ITEMS
QUOTE_MISC, CGW0QMI , Quote Misc Line Items
BILLTRAN , CGW0BT , Billing Transactions
SALEHIST , CGW0SH , SALES HISTORY
BILLPOST , CGW0BP , POSTED BILLING TRANS
SALESMEN , CGW0SM , SALESMEN TABLE
TERMS , CGW0TR , REPAYMENT TERMS
GL_ALLOC , CGW0GL , GL ALLOCATION OVERRIDES
*/
DATADICT := SVDATADICT
DBOPEN('DATADICT')
DBFARR := REASSIGN_DBFARR("") // RESET THE DBFARR FOR THE CGW DIRECTORY
SETAVAR('SET', 'DBFARR', DBFARR) //** P3N -08/31/01 ADDRESS CHG IN DBOPEN
RESTSCREEN(,,,, SVSCRN)
@ 2,0 CLEAR
ERR_BOX ('** Archive Process Completed Successfully! **' )
ENDIF
RETURN
****************************************************************
* PROGRESS METER USED FOR THE ARCHIVE PROCESS
****************************************************************
FUNCTION AMSGMETER(RESET)
LOCAL SVCOLOR := SETCOLOR(HREV)
LOCAL MSG := ALIAS()
STATIC CNT := 0
IF EMPTY(RESET)
CNT := CNT + 1
@ 16,20 SAY ' '
@ 17,20 SAY ' '
@ 16,20 SAY 'Processing '+MSG+' record:'
@ 17,25 SAY STR(CNT,9)+' of '+STR(LASTREC(),9)
ELSE
CNT := 0
ENDIF
SETCOLOR(SVCOLOR)
RETURN .T.
****************************************************************
* OPEN ALL FILES USED FOR THE ARCHIVE PROCESS
****************************************************************
FUNCTION OPEN_ARCHIVE(ARCHIVE_DIR)
LOCAL SVSEL := SELECT()
LOCAL ARCHFILE
DBOPEN('ORD_LINES', .F.)
DBOPEN('ORDER_OPTS', .F.)
DBOPEN('ORD_MISC', .F.)
DBOPEN('ADDL_LINES', .F.)
DBOPEN('ADDL_OPTS', .F.)
DBOPEN('QUOTE_LINE', .F.)
DBOPEN('QUOTE_MAST', .F.)
DBOPEN('QUOTE_ADDL', .F.)
DBOPEN('QUOTE_OPTS', .F.)
DBOPEN('QUOTE_MISC', .F.)
DBOPEN('ADDL_QOPT', .F.)
DBOPEN('ORD_SHIP', .F.) //** P3N - 8/6/98
DBOPEN('SALEHIST', .F.)
DBOPEN('QUOTE_MAST', .F. )
DBOPEN('ORD_MAST', .F.)
SELECT ORD_MAST
ARCHFILE := ARCHIVE_DIR+SUBS(ORD_MAST,3)
COPY STRUCTURE TO &ARCHFILE
USE &ARCHFILE NEW ALIAS AOMAST
ARCHFILE := ARCHIVE_DIR+SUBS(ORD_LINES,3)
USE &ARCHFILE NEW ALIAS AOLINES EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(ORDER_OPTS,3)
USE &ARCHFILE NEW ALIAS AOOPTS EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(ORD_MISC,3)
USE &ARCHFILE NEW ALIAS AOMISC EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(ADDL_LINES,3)
USE &ARCHFILE NEW ALIAS AOALINES EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(ADDL_OPTS,3)
USE &ARCHFILE NEW ALIAS AOAOPTS EXCLUSIVE
SELECT QUOTE_MAST
ARCHFILE := ARCHIVE_DIR+SUBS(QUOTE_MAST,3)
COPY STRUCTURE TO &ARCHFILE
USE &ARCHFILE NEW ALIAS AQMAST
ARCHFILE := ARCHIVE_DIR+SUBS(QUOTE_LINE,3)
USE &ARCHFILE NEW ALIAS AQLINES EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(QUOTE_OPTS,3)
USE &ARCHFILE NEW ALIAS AQOPTS EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(QUOTE_ADDL,3)
USE &ARCHFILE NEW ALIAS AQADDL EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(ADDL_QOPT,3)
USE &ARCHFILE NEW ALIAS AQAOPTS EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(QUOTE_MISC,3)
USE &ARCHFILE NEW ALIAS AQMISC EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(SALEHIST,3)
USE &ARCHFILE NEW ALIAS ASALEHST EXCLUSIVE
ARCHFILE := ARCHIVE_DIR+SUBS(ORD_SHIP,3) //** P3N - 8/6/98
USE &ARCHFILE NEW ALIAS AORDSHIP EXCLUSIVE //** P3N - 8/6/98
SELECT (SVSEL)
RETURN
****************************************************************
* ADD NEW ORDER RECORDS TO THE ARCHIVE DIRECTORY
* (ONE MASTER TO MANY LINES, OPTS, MISC, ...)
*
* SELECT ALL ORDERS TO BE ARCHIVED!!
****************************************************************
FUNCTION SEL_ARCHIVE( FROMFILE, TOFILE, ARCH_DATE)
LOCAL FILTER, MASTER := &FROMFILE
LOCAL COPYFROM
SELECT &TOFILE
//** P3N - CHANGED TO ARCHIVE BASED ON THE ORDER SHIPPING DATE AS OPPOSED TO THE INVOICE DATE
//** THIS CHANGE WAS REQUESTED BY ELLEN AT KANSAS CITY ON 3/30/01
//** THIS CHANGE WILL ONLY EFFECT THE ORDERS
IF FROMFILE == 'ORD_MAST' //** P3N - 03/30/01 HAPPY B-DAY CHRISTY
FILTER := '!EMPTY(SHIP_DATE) .AND. SHIP_DATE < CTOD("' //** P3N - 03/30/01 HAPPY B-DAY CHRISTY
ELSE //** P3N - 03/30/01 HAPPY B-DAY CHRISTY
FILTER := '!EMPTY(IDATE_LAST) .AND. IDATE_LAST < CTOD("'
ENDIF //** P3N - 03/30/01 HAPPY B-DAY CHRISTY
FILTER := FILTER + DTOC(ARCH_DATE) + '")'
// APPEND FROM (MASTER) FOR &FILTER
COPYFROM := ALLTRIM( MASTER )
APPEND FROM &COPYFROM FOR &FILTER
RETURN
****************************************************************
*
* REMOVE ALL CHILD FILE RECORDS FOR ARCHIVED ORDERS (IN ARCHIVE DIR.)
*
****************************************************************
FUNCTION CHILD_ARCH(WHATARCH)
IF WHATARCH = 'ORDERS'
DEL_CHILD('AOLINES', 'AOMAST')
DEL_CHILD('AOOPTS' , 'AOMAST')
DEL_CHILD('AOMISC' , 'AOMAST')
DEL_CHILD('AOALINES','AOMAST')
DEL_CHILD('AOAOPTS' ,'AOMAST')
DEL_CHILD('ASALEHST','AOMAST')
DEL_CHILD('AORDSHIP','AOMAST') //** P3N - 8/6/98
ELSEIF WHATARCH = 'QUOTES'
DEL_CHILD('AQLINES' , 'AQMAST')
DEL_CHILD('AQOPTS' , 'AQMAST')
DEL_CHILD('AQADDL' , 'AQMAST')
DEL_CHILD('AQAOPTS' , 'AQMAST')
DEL_CHILD('AQMISC' , 'AQMAST')
ENDIF
RETURN
****************************************************************
* DELETE EACH CHILD FILE RECORDS FROM THE ARCHIVE FILES
****************************************************************
FUNCTION DEL_CHILD(FILE, MASTER)
AMSGMETER(.T.)
SELECT &FILE
DELETE ALL FOR NOT_ON_ARCHIVE(FILE, MASTER) WHILE AMSGMETER()
PACK
RETURN
****************************************************************
* IS THE RECORD ON THE MASTER FILE? - NO DELETE THIS ROW!
****************************************************************
FUNCTION NOT_ON_ARCHIVE(FILE, MASTER)
IF (MASTER)->(DBSEEK(&FILE->ORDER_NUM))
RETURN .F.
ELSE
RETURN .T.
ENDIF
****************************************************************
* DELETE ALL ARCHIVED ORDERS FROM THE REAL DBF'S
****************************************************************
FUNCTION DEL_OLD()
DBOPEN('QUOTE_MAST', .F. )
DBOPEN('ORD_MAST', .F.)
SELECT AOMAST
GO TOP
DO WHILE !EOF()
DEL_ONEORD('ORD_MAST' , ORDER_NUM)
DEL_ONEORD('ORD_LINES', ORDER_NUM)
DEL_ONEORD('ORDER_OPTS',ORDER_NUM)
DEL_ONEORD('ORD_MISC' , ORDER_NUM)
DEL_ONEORD('ADDL_LINES',ORDER_NUM)
DEL_ONEORD('ADDL_OPTS', ORDER_NUM)
DEL_ONEORD('SALEHIST', ORDER_NUM)
DEL_ONEORD('ORD_SHIP', ORDER_NUM) //** P3N - 8/6/98
AOMAST->(DBSKIP(+1))
ENDDO
SELECT AQMAST
GO TOP
DO WHILE !EOF()
DEL_ONEORD('QUOTE_MAST', ORDER_NUM)
DEL_ONEORD('QUOTE_LINE', ORDER_NUM)
DEL_ONEORD('QUOTE_OPTS', ORDER_NUM)
DEL_ONEORD('QUOTE_ADDL', ORDER_NUM)
DEL_ONEORD('ADDL_QOPT' , ORDER_NUM)
DEL_ONEORD('QUOTE_MISC', ORDER_NUM)
AQMAST->(DBSKIP(+1))
ENDDO
@ 20,01 CLEAR TO 20,80
RETURN
****************************************************************
* DELETE ONE ORDER AFTER COPYING TO THE ARCHIVE
****************************************************************
FUNCTION DEL_ONEORD(FILE, ARCH_ORDER_NUM)
LOCAL SVREC := (FILE)->(RECNO())
(FILE)->(DBSEEK(ARCH_ORDER_NUM))
@ 20,01 CLEAR TO 20,80
@ 20,20 SAY 'Removing Archived Order ' + ARCH_ORDER_NUM + ' From '+FILE
DO WHILE (FILE)->(!EOF()) .AND. (FILE)->ORDER_NUM == ARCH_ORDER_NUM
IF (FILE)->(RLOCK())
(FILE)->(DBDELETE())
ENDIF
(FILE)->(DBSKIP(+1))
ENDDO
(FILE)->(DBGOTO(SVREC))
RETURN
****************************************************************
* ARCHIVE PROCESSING
****************************************************************
FUNCTION SET_ARCHIVE()
LOCAL ARCHIVE := .T., ARCH_YR := STR(YEAR(DATE())-1,4,0)
LOCAL SAVESCR := SAVESCREEN(), ARCH_MENU := 'CGWARCH'
LOCAL TITLE := 'Archive Selection', STRT := 3
LOCAL SV_OC := _OC_CAPABLE, ARCH_DIR
LOCAL CHOICE, DIR_ARR, DISPLARR := {}, NOSIZE := .T.
LOCAL SVDATADICT := DATADICT, WORKARR, I
_OC_CAPABLE := .F.
@ 2,0 CLEAR
SAYTITLE(TITLE, 'AS000')
DO WHILE .T.
@ 12,15 SAY 'Enter Retreival Year (CCYY) ' + ARCH_YR
@ 12,44 GET ARCH_YR
@ 13,15 SAY ' "?" to Browse Archive(s) '
READ
IF LASTKEY() = 27
EXIT
ENDIF
IF EMPTY(ARCH_YR) .OR. AT('?', ARCH_YR) > 0
DIR_ARR := DIRECTORY(SUBS(DTOS(DATE()),1,3)+'*', 'D')
ELSE
DIR_ARR := DIRECTORY( ARCH_YR +'*', 'D')
ENDIF
IF EMPTY(DIR_ARR)
ERR_BOX('** No Archive(s) Found for the year ' + ARCH_YR )
LOOP
ELSE
@ 03,00 CLEAR
DISPLARR := {'Archive Date Time' }
AADD(DISPLARR, '-------- -------- --------' )
WORKARR := {}
WORKARR := BLD_DISPLARR(DIR_ARR, WORKARR, NOSIZE)
WORKARR := ASORT(WORKARR,,,{|X,Y| X > Y })
FOR I := 1 TO LEN(WORKARR)
AADD(DISPLARR, WORKARR[I])
NEXT
DO WHILE .T.
CHOICE = PICKLIST(DISPLARR, 05, 20, ' Archive(s) Found', STRT, .F., .T.)
IF LASTKEY() = 27
EXIT
ENDIF
IF EMPTY(CHOICE) .OR. CHOICE < 3
LOOP
ENDIF
ARCH_DIR := SUBS(DISPLARR[CHOICE],1,8)
IF FILE(ARCH_DIR+'\CGW0OM.DBF')
@ 03,00 CLEAR
IF PROMPT_BOX(' About to Retreive Archived Orders for ' + ARCH_DIR , ' ', ;
' Do you want to continue? ', 1)
ARCH_DIR := ARCH_DIR+'\'
DBOPEN('DATADICT')
DBFARR := REASSIGN_DBFARR(ARCH_DIR)
SETAVAR('SET', 'DBFARR', DBFARR) //** P3N -08/31/01 ADDRESS CHG IN DBOPEN
BUILDMENUS(INIT, ARCHIVE)
TITLE := 'Archive Retrieval for ' + STRTRAN(ARCH_DIR, '\', '')
SAYTITLE(TITLE, 'AS010')
@ 2,0 CLEAR
CLEAR TYPEAHEAD
@ 22,05 SAY TITLE
DO WHILE .T.
CALLMENU(ARCH_MENU) //DISPLAY ARCHIVE MENU OPTIONS - MENU SYSTEM
IF LASTKEY() = 27
EXIT
ENDIF
ENDDO
ELSE
LOOP
ENDIF
ELSE
ERR_BOX('** No Archive Files Found in directory: ' + ARCH_DIR )
LOOP
ENDIF
ENDDO
IF LASTKEY() = 27
EXIT
ENDIF
ENDIF
ENDDO
BUILDMENUS(INIT)
DATADICT := SVDATADICT
DBOPEN('DATADICT')
DBFARR := REASSIGN_DBFARR("") // RESET THE DBFARR FOR THE CGW DIRECTORY
SETAVAR('SET', 'DBFARR', DBFARR) //** P3N -08/31/01 ADDRESS CHG IN DBOPEN
_OC_CAPABLE := SV_OC
RESTSCREEN(,,,,SAVESCR)
RETURN
****************************************************************
* RE-INDEX OR COMPRESS/PACK ARCHIVE FILES
****************************************************************
FUNCTION UTIL_OQFILES(OPT,TITLE,ACTN,DISPMSG)
LOCAL SVSCRN := SAVESCREEN(), ARCH_YR := STR(YEAR(DATE())-1,4,0)
LOCAL PROG, DISPLARR, NOSIZE := .T., STRT := 3, DIR_ARR, WORKARR, I
LOCAL ARCH_DIR
LOCAL DIRARR, III, COPYFROM, COPYTO, RETCOPYVAL
IF EMPTY(DISPMSG)
DISPMSG := .F.
ENDIF
IF ACTN == 'RESTORE'
@ 00,00 CLEAR
SAYTITLE(TITLE, 'RA000')
DO WHILE .T.
@ 12,15 SAY 'Enter RESTORE Year (CCYY) ' + ARCH_YR
@ 12,44 GET ARCH_YR
@ 13,15 SAY ' "?" to Browse Archive(s) '
READ
IF LASTKEY() = 27
EXIT
ENDIF
IF EMPTY(ARCH_YR) .OR. AT('?', ARCH_YR) > 0
DIR_ARR := DIRECTORY(SUBS(DTOS(DATE()),1,3)+'*', 'D')
ELSE
DIR_ARR := DIRECTORY( ARCH_YR +'*', 'D')
ENDIF
IF EMPTY(DIR_ARR)
ERR_BOX('** No Archive(s) Found for the year ' + ARCH_YR )
LOOP
ENDIF
DIR_ARR := DIRECTORY( ARCH_YR +'*', 'D')
DISPLARR := {'Archive Date Time' }
AADD(DISPLARR, '-------- -------- --------' )
WORKARR := {}
WORKARR := BLD_DISPLARR(DIR_ARR, WORKARR, NOSIZE)
WORKARR := ASORT(WORKARR,,,{|X,Y| X > Y })
FOR I := 1 TO LEN(WORKARR)
AADD(DISPLARR, WORKARR[I])
NEXT
@ 03,00 CLEAR
DO WHILE .T.
CHOICE = PICKLIST(DISPLARR, 05, 20, ' Archive(s) Found', STRT, .F., .T.)
IF LASTKEY() = 27
EXIT
ENDIF
IF EMPTY(CHOICE) .OR. CHOICE < 3
LOOP
ENDIF
ARCH_DIR := SUBS(DISPLARR[CHOICE],1,8)
@ 03,00 CLEAR
IF PROMPT_BOX(' About to RESTORE Archived Orders for ' + ARCH_DIR , ' ', ;
' Do you want to continue? ', 1)
@ 4,0 CLEAR
WAIT_BOX('*** Restoring Selected Archive *** ', ;
'*** Please Wait ***')
//PROG := 'COPY ' + ARCH_DIR + '\BKUP\*.DB* CGW*.* >NUL'
//CALL_OLAY(,,PROG, 0, '', '')
DIRARR := DIRECTORY( ARCH_DIR + '\BKUP\*.DB*' )
FOR III := 1 TO LEN( DIRARR )
COPYFROM := DIRARR[ III, 1 ]
COPYTO := 'CGW' + SUBS( COPYFROM, 4 )
RETCOPYVAL := COPYFILE ( COPYFROM, COPYTO )
NEXT
ACTN := 'REINDEXED'
EXIT
ENDIF
ENDDO
EXIT
ENDDO
ENDIF
IF LASTKEY() = 27
// EXIT
ELSE
WAIT_BOX('*** Re-Indexing files *** ', ;
'*** Please Wait ***')
IF SELECT('ORD_SHIP') > 0 //** P3N - 8/6/98
ELSE //** P3N - 8/6/98
DBOPEN('ORD_SHIP') //** P3N - 8/6/98
ENDIF //** P3N - 8/6/98
INDEX_FILE('ORD_SHIP',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('SALEHIST') > 0
ELSE
DBOPEN('SALEHIST')
ENDIF
INDEX_FILE('SALEHIST',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ORD_MAST') > 0
ELSE
DBOPEN('ORD_MAST')
ENDIF
INDEX_FILE('ORD_MAST',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ORD_LINES') > 0
ELSE
DBOPEN('ORD_LINES')
ENDIF
INDEX_FILE('ORD_LINES',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ORDER_OPTS') > 0
ELSE
DBOPEN('ORDER_OPTS')
ENDIF
INDEX_FILE('ORDER_OPTS',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ORD_MISC') > 0
ELSE
DBOPEN('ORD_MISC')
ENDIF
INDEX_FILE('ORD_MISC',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ADDL_LINES') > 0
ELSE
DBOPEN('ADDL_LINES')
ENDIF
INDEX_FILE('ADDL_LINES',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ADDL_OPTS') > 0
ELSE
DBOPEN('ADDL_OPTS')
ENDIF
INDEX_FILE('ADDL_OPTS',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('QUOTE_MAST') > 0
ELSE
DBOPEN('QUOTE_MAST')
ENDIF
INDEX_FILE('QUOTE_MAST',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('QUOTE_LINE') > 0
ELSE
DBOPEN('QUOTE_LINE')
ENDIF
INDEX_FILE('QUOTE_LINE',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('QUOTE_ADDL') > 0
ELSE
DBOPEN('QUOTE_ADDL')
ENDIF
INDEX_FILE('QUOTE_ADDL',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('QUOTE_OPTS') > 0
ELSE
DBOPEN('QUOTE_OPTS')
ENDIF
INDEX_FILE('QUOTE_OPTS',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('QUOTE_MISC') > 0
ELSE
DBOPEN('QUOTE_MISC')
ENDIF
INDEX_FILE('QUOTE_MISC',ACTN, DISPMSG) // PACK / REINDEX DBF
IF SELECT('ADDL_QOPT') > 0
ELSE
DBOPEN('ADDL_QOPT')
ENDIF
INDEX_FILE('ADDL_QOPT',ACTN, DISPMSG) // PACK / REINDEX DBF
ENDIF
IF EMPTY(ARCH_DIR)
ELSE
ENDIF
RESTSCREEN(,,,,SVSCRN)
RETURN
*****************************************************************
* THIS FUNCTION IS INITIATED FROM THE IMPORT CUST VALID_FUNC FOR*
* THE FIELD PARTNUM IN THE CGW0MI DATABASE. *
*****************************************************************
FUNCTION DEL_MISCPUOM(DEL_KEY) //** P3N - 3/10/98
LOCAL SVSEL := SELECT()
LOCAL OGET := GETACTIVE(), MORIGINAL
IF EMPTY(OGET)
ELSEIF SELECT('MISC_PUOM') > 0
IF EMPTY(DEL_KEY)
MORIGINAL := OGET:ORIGINAL
SELECT MISC_PUOM
DBSEEK(MORIGINAL)
DO WHILE MISC_PUOM->PARTNUM == MORIGINAL .AND. MISC_PUOM->(FOUND())
REC_LOCK(1)
REPLACE PARTNUM WITH SPACE(LEN(PARTNUM))
DELETE
UNLOCK
DBSEEK(MORIGINAL)
ENDDO
ENDIF
SELECT(SVSEL)
ENDIF
RETURN .T.
*****************************************************************
*****************************************************************
* THIS FUNCTION IS INITIATED FROM THE IMPORT CUST VALID_FUNC FOR*
* THE FIELD PROD_CODE IN THE CGW0PR DATABASE. *
*****************************************************************
FUNCTION VALID_PRODCODE() //** P3N - 3/27/98
LOCAL OGET := GETACTIVE(), I
LOCAL INVCHRS := {'"','`','~','!','@','#','$','%','^','&','*','(',')','+', ;
'=','<','>',',','.','/','|','\','{','}','[',']',';',':'}
LOCAL WKFLD := ALLTRIM(OGET:BUFFER), RETVAL := .T.
IF AT('?',WKFLD) > 0
RETVAL := .T.
ELSEIF AT(' ',WKFLD) > 0 .OR. AT("'", WKFLD) > 0
ERR_BOX('** Invalid PRODUCT/MODEL - '+WKFLD+' **', ;
' Should NOT have embedded SPACE(s)!')
RETVAL := .F.
ELSE
FOR I := 1 TO LEN(INVCHRS)
IF INVALID_CHR(WKFLD, INVCHRS[I])
ERR_BOX('** Invalid PRODUCT/MODEL - '+WKFLD+' **', ;
' Should NOT have embedded CHAR('+ INVCHRS[I] +')!' )
RETVAL := .F.
EXIT
ENDIF
NEXT
ENDIF
RETURN RETVAL
*****************************************************************
FUNCTION INVALID_CHR(FLD,CHR) //** P3N - 4/1/98
LOCAL RETVAL := .F.
IF AT(CHR, FLD) > 0
RETVAL := .T.
ENDIF
RETURN RETVAL
*****************************************************************
* //** P3N - 5/19/98 (IS THIS A NEW RECORD? INITIALIZE THE KEY)
*****************************************************************
FUNCTION SHPKEY()
LOCAL SVSEL := SELECT()
SELECT USERFILE2
IF EMPTY(ORDER_NUM) .OR. EMPTY(TRAN_NUM)
REC_LOCK(3)
REPLACE ORDER_NUM WITH TORD_LINES->ORDER_NUM
REPLACE LINE_NUM WITH TORD_LINES->LINE_NUM
REPLACE PROD_CODE WITH TORD_LINES->PROD_CODE
REPLACE PAR_PROD WITH TORD_LINES->PAR_PROD
REPLACE TRAN_NUM WITH STR( TORD_LINES->(RECNO()), 3 )
IF FIELDPOS('SHIP_DATE') > 0 //** P3N - 01/15/02
IF EMPTY(SHIP_DATE)
REPLACE SHIP_DATE WITH (CUR_MAST)->SHIP_DATE //** P3N - 10/14/98
ENDIF
ENDIF //** P3N - 01/15/02
**REPLACE SHIP_DATE WITH CURDATE
UNLOCK
ENDIF
SELECT(SVSEL)
RETURN .T.
*****************************************************************
* //** P3N - 4/16/98 (YES - I survived tax day!) Barely
*****************************************************************
FUNCTION VALID_CTRL(EDITWHAT) //** P3N - 4/16/98
LOCAL RETVAL := .T., WKFLD := ALLTRIM(STR(LINE_NUM, 3)) + '/' + ALLTRIM(PROD_CODE)
LOCAL CURFILE := ALIAS(), CMPRQTY, MQTY, MDATE
IF FIELDPOS('SHIP_QTY') > 0
MQTY := 'SHIP_QTY'
ENDIF
IF FIELDPOS('COMPL_QTY') > 0
MQTY := 'COMPL_QTY'
ENDIF
IF FIELDPOS('SHIP_DATE') > 0
MDATE := 'SHIP_DATE'
ENDIF
IF FIELDPOS('COMPL_DATE') > 0
MDATE := 'COMPL_DATE'
ENDIF
IF EDITWHAT == 'QTY' //** DOES THE SHIP_QTY EXCEED THE TOTAL QTY?
CMPRQTY := (CURFILE)->&MQTY // NEW QTY IN THE CURRENT DBF
IF CMPRQTY > TORD_LINES->QUANTITY
ERR_BOX('** Invalid QTY on line - '+WKFLD+' **', ;
' The TOTAL line quantity is - ' + ALLTRIM(STR(TORD_LINES->QUANTITY, 3)) , ;
' The QTY can NOT EXCEED TOTAL line QTY! ')
RETVAL := .F.
ELSEIF CHK_QTY(MQTY)
RETVAL := .T.
ELSE
RETVAL := .F.
ENDIF
DSPLBO_QTY()
ELSEIF EDITWHAT == 'DATE'
IF !EMPTY((CURFILE)->&MQTY) .AND. EMPTY((CURFILE)->&MDATE)
ERR_BOX('** Invalid DATE/QTY on line - '+WKFLD+' **', ;
' CAN NOT have a QTY without a DATE!')
RETVAL := .F.
ELSEIF EDT_TMP_OST() //** P3N - 1/15/99
ELSE //** P3N - 1/15/99
RETVAL := .F. //** P3N - 1/15/99
ENDIF //** P3N - 1/15/99
ENDIF
RETURN RETVAL
*****************************************************************
* //** P3N - 5/20/98 DISPLAY CURRENT BACKORDER QTY - USERFILE
*****************************************************************
FUNCTION DSPLBO_QTY()
LOCAL BOQTY := UBO_QTY()
LOCAL RETVAL := 'NOSAY' //** P3N - 12/7/98
IF USERFILE2->(FIELDPOS('SHIP_QTY')) > 0 //** P3N - 01/15/02
@ 05, 06 CLEAR TO 05,75
@ 05, 19 SAY 'Order Qty: '+ STR(TORD_LINES->QUANTITY,6)
**@ 05, 20 SAY 'Order Qty: '+ STR(TORD_LINES->QUANTITY,3) //** P3N - 8/25/98
@ 05, 45 SAY 'Backorder: '+ BOQTY
ELSEIF USERFILE2->(FIELDPOS('COMPL_QTY')) > 0 //** P3N - 01/15/02
//** @ 04, 05 CLEAR TO 05,75
@ 04, 15 SAY 'Order Qty: '+ STR(TORD_LINES->QUANTITY,6)
ENDIF
//**RETVAL := 'Order Qty: '+ STR(TORD_LINES->QUANTITY,6)
//**RETVAL := RETVAL + SPACE(10)+ 'Backorder: '+ BOQTY
RETURN RETVAL
*****************************************************************
* //** P3N - 5/12/98 CALC THE CURRENT BACKORDER QTY - USERFILE
*****************************************************************
FUNCTION UBO_QTY()
LOCAL OLQTY := TORD_LINES->QUANTITY, BOQTY := 0, SHPQTY := 0
LOCAL RETVAL, SVREC := RECNO(), SVSEL := SELECT(), USERREC
SELECT USERFILE2
USERREC := RECNO()
GO TOP
DO WHILE !EOF()
IF FIELDPOS('SHIP_QTY') > 0 //** P3N - 01/15/02
SHPQTY := SHPQTY + SHIP_QTY
//**ELSEIF FIELDPOS('COMPL_QTY') > 0 //** P3N - 01/15/02
//**SHPQTY := SHPQTY + COMPL_QTY
ENDIF
DBSKIP(+1)
ENDDO
GOTO USERREC
SELECT(SVSEL)
GOTO SVREC
BOQTY := OLQTY - SHPQTY
RETURN STR(BOQTY, 6)
**RETURN STR(BOQTY, 3) //** P3N - 8/25/98
*****************************************************************
* //** P3N - 5/12/98 CALC THE CURRENT BACKORDER QTY - ORD_SHIP
*****************************************************************
FUNCTION BO_QTY(RETWHAT)
LOCAL OLQTY := TORD_LINES->QUANTITY, BOQTY := 0, SHPQTY := 0
LOCAL RETVAL, SVREC := RECNO(), SVSEL := SELECT()
LOCAL SVTRAN := STR(TORD_LINES->(RECNO()), 3) //** P3N - 11/4/98
LOCAL CMPRKEY //** P3N - 11/4/98
LOCAL SVKEY := TORD_LINES->ORDER_NUM + STR(TORD_LINES->LINE_NUM, 3)
SVKEY := SVKEY + TORD_LINES->PROD_CODE + TORD_LINES->PAR_PROD
CMPRKEY := SVKEY //** P3N - 11/4/98
IF EMPTY(RETWHAT)
RETWHAT := ' '
ENDIF
DBOPEN('ORD_SHIP')
IF DBSEEK(SVKEY)
DO WHILE !EOF() .AND. CMPRKEY == SVKEY
IF EMPTY(BOQTY)
BOQTY := OLQTY - SHIP_QTY
ELSE
BOQTY := BOQTY - SHIP_QTY
ENDIF
SHPQTY := SHPQTY + SHIP_QTY
DBSKIP(+1)
CMPRKEY := ORDER_NUM+STR(LINE_NUM, 3)+PROD_CODE+PAR_PROD
****IF EMPTY(ORD_SHIP->TRAN_NUM)
****ELSE
******SVKEY := SVKEY + SVTRAN
**** CMPRKEY := CMPRKEY + SVTRAN
****ENDIF
ENDDO
ELSE
BOQTY := OLQTY
ENDIF
SELECT(SVSEL)
GOTO SVREC
IF RETWHAT == 'SHPQTY'
RETVAL := SHPQTY
ELSE
RETVAL := BOQTY
ENDIF
RETURN STR(RETVAL, 6)
*********************************************************************
***** //** P3N - 5/5/98 RETRIEVE THE ORDER LINE QTY
*********************************************************************
FUNCTION CUROL_QTY(OLKEY, ADDL)
LOCAL RETVAL := 0, SEEKKEY, CUR_OL
LOCAL CURFILE := ALIAS()
IF EMPTY(OLKEY)
IF EMPTY(USERFILE2->PAR_PROD)
SEEKKEY := (CURFILE)->ORDER_NUM + STR((CURFILE)->LINE_NUM, 3)
CUR_OL := 'ORD_LINES'
ELSE
SEEKKEY := (CURFILE)->ORDER_NUM + (CURFILE)->PROD_CODE + ;
STR((CURFILE)->LINE_NUM, 3)
CUR_OL := 'ADDL_LINES'
ENDIF
ELSE
SEEKKEY := OLKEY
CUR_OL := 'ORD_LINES'
IF ADDL
CUR_OL := 'ADDL_LINES'
ENDIF
ENDIF
IF (CUR_OL)->(DBSEEK(SEEKKEY))
RETVAL := (CUR_OL)->QUANTITY
ENDIF
RETURN RETVAL
*****************************************************************
* //** P3N - 5/20/98 RETREIVE THE TORD_LINES QTY FOR A GIVEN KEY
*****************************************************************
FUNCTION TOL_QTY(TOLKEY)
LOCAL SVREC := TORD_LINES->(RECNO()), TOL_QTY := 0
TORD_LINES->(DBGOTO(1))
DO WHILE TORD_LINES->(!EOF())
IF TORD_LINES->ORDER_NUM + STR(TORD_LINES->LINE_NUM, 3) + ;
TORD_LINES->PROD_CODE + TORD_LINES->PAR_PROD + ;
STR(TORD_LINES->(RECNO()),3) == TOLKEY
TOL_QTY := TOL_QTY + TORD_LINES->QUANTITY
ENDIF
TORD_LINES->(DBSKIP(+1))
ENDDO
TORD_LINES->(DBGOTO(SVREC))
RETURN TOL_QTY
*****************************************************************
* //** P3N - 5/20/98 DISPLAY TORD_LINES BROWSE FIELDS
*****************************************************************
FUNCTION TOL_BROWSE_DSPL()
LOCAL INSTK, RETVAL, PROD_SHIP := ' ', SVLINE, SVREC := (ALIAS())->(RECNO())
STATIC PREVLINE, PREVRETVAL
IF SELECT('ORD_SHIP') > 0 //** P3N - 02/17/04
PROD_SHIP := 'SHIP' //** P3N - 02/17/04
ELSE //** P3N - 02/17/04
PROD_SHIP := 'PROD' //** P3N - 02/17/04
ENDIF //** P3N - 02/17/04
IF IN_STOCK == 'Y'
INSTK := ' (S)'
ELSE
INSTK := ' '
ENDIF
RETVAL := STR(LINE_NUM, 3) + '/' + PROD_CODE + '-' + ;
PAR_PROD + ' ' +HOW_MEAS + ' ' + ENTRY_SIZE + INSTK
/*
//** SUPPRESS THE LINE_NUM FOR READABILITY
*IF PROD_SHIP == 'PROD' //** P3N - 02/17/04
IF LASTKEY() = 24 //** DOWN ARROW SKIP(-1)
SVLINE := (ALIAS())->LINE_NUM
(ALIAS())->(DBSKIP(-1))
IF (ALIAS())->(BOF())
PREVLINE := 0
ELSEIF SVLINE == (ALIAS())->LINE_NUM
PREVLINE := SVLINE
ENDIF
(ALIAS())->(DBGOTO(SVREC))
ELSEIF LASTKEY() = 5 //** UP ARROW SKIP(+1)
SVLINE := (ALIAS())->LINE_NUM
(ALIAS())->(DBSKIP(+1))
IF (ALIAS())->(EOF())
PREVLINE := 0
ELSEIF SVLINE == (ALIAS())->LINE_NUM
PREVLINE := SVLINE
ENDIF
(ALIAS())->(DBGOTO(SVREC))
ENDIF
IF (ALIAS())->(RECNO()) = 1 //** P3N - 02/17/04
//** CONTINUE WITH THE CURRENT RETVAL AND SET THE PREVLINE VAR
PREVLINE := (ALIAS())->LINE_NUM //** P3N - 02/17/04
ELSEIF (ALIAS())->LINE_NUM == PREVLINE //** P3N - 02/17/04
RETVAL := SPACE(4) + PROD_CODE + '-' + ;
PAR_PROD + ' ' +HOW_MEAS + ' ' + ENTRY_SIZE + INSTK
ELSE //** P3N - 02/17/04
//** CONTINUE WITH THE CURRENT RETVAL AND SET THE PREVLINE VAR
PREVLINE := (ALIAS())->LINE_NUM //** P3N - 02/17/04
ENDIF //** P3N - 02/17/04
*ENDIF //** P3N - 02/17/04
PREVRETVAL := RETVAL
*/
RETURN RETVAL
*****************************************************************
* //** P3N - 5/20/98 DISPLAY ORD_SHIP BROWSE FIELDS
*****************************************************************
FUNCTION OS_BROWSE_DSPL()
LOCAL RETVAL := STR(LINE_NUM, 3) + '/' + PROD_CODE + ' - ' + PAR_PROD
//**IF USERFILE2->(FIELDPOS('COMPL_DATE')) > 0 //** P3N - 01/15/02
//** RETVAL := ORDER_NUM + '/'+STR(LINE_NUM, 3) + '/' + PROD_CODE + ' - ' + PAR_PROD
//**ENDIF //** P3N - 01/15/02
RETURN RETVAL
********************************************************************
//** P3N - EDIT THE SHIP QTY TO THE TOTAL QTY
//** 4/20/98
********************************************************************
FUNCTION CHK_QTY(QTY)
LOCAL SV_SEL := SELECT(), SVREC
LOCAL SEEKORD, USERKEY, TOTQTY := 0, LINEQTY := 0
LOCAL RETVAL := .T., WKFLD := ALLTRIM(STR(LINE_NUM, 3)) + '/' + ALLTRIM(PROD_CODE)
SELECT('USERFILE2')
SVREC := USERFILE2->(RECNO())
SEEKORD := USERFILE2->ORDER_NUM + STR(USERFILE2->LINE_NUM, 3) + ;
USERFILE2->PROD_CODE + USERFILE2->PAR_PROD
GO TOP
DO WHILE USERFILE2->(!EOF())
USERKEY := USERFILE2->ORDER_NUM + STR(USERFILE2->LINE_NUM, 3) + ;
USERFILE2->PROD_CODE + USERFILE2->PAR_PROD
IF USERKEY == SEEKORD
IF EMPTY(TOTQTY)
LINEQTY := TORD_LINES->QUANTITY
ENDIF
TOTQTY := TOTQTY + USERFILE2->&QTY
ENDIF
USERFILE2->(DBSKIP(+1))
ENDDO
IF TOTQTY <= LINEQTY
RETVAL := .T.
ELSE
RETVAL := .F.
ERR_BOX('** Invalid LINE / QTY for - '+ WKFLD + ' **', ;
' The LINE Quantity is - ' + ALLTRIM(STR(LINEQTY, 3)) , ;
' The TOTAL QTY - ' + ALLTRIM(STR(TOTQTY, 3)) + ' can NOT EXCEED LINE QTY! ')
ENDIF
GOTO SVREC
SELECT(SV_SEL)
RETURN RETVAL
********************************************************************
FUNCTION GET_CTL_KEY( NUM_KEYS )
IF NUM_KEYS = NIL
RETURN { TORD_LINES->ORDER_NUM, TORD_LINES->LINE_NUM , ;
TORD_LINES->PROD_CODE, TORD_LINES->PAR_PROD, ;
STR(TORD_LINES->(RECNO()),3) }
ELSEIF NUM_KEYS = 1
RETURN { TORD_LINES->ORDER_NUM }
ELSE
? ABEND
ENDIF
********************************************************************
//** P3N - 11/13/98 FRIDAY THE 13TH
********************************************************************
FUNCTION GET_ASA_KEY( )
RETURN { ORD_MAST->ORDER_NUM }
********************************************************************
//** P3N - UPDATE THE SHIPPING ADDRESS INFORMATION 'CUST_MAST'
//** 4/22/98 - F3 FROM SCREEN 3220(SCREEN-3245)
********************************************************************
FUNCTION UPD_SHIPADDR(BROW_ONLY)
LOCAL SVSCRN:= SAVESCREEN(), WK_FLD
LOCAL SVSEL := SELECT(), DOAUDIT := .T.
LOCAL ACTION_CODE := GETAVAR( 'ACTION_CODE' )
LOCAL PARENTFIL := NIL, ASR_ARR, OPT
LOCAL MTITLE := 'Alt. Ship Info. - ' + ALLTRIM(ORD_MAST->ORDER_NUM)+'/'
LOCAL USERKEY := ORD_MAST->CUST_ID, ADD_REC := .F.
IF EMPTY(BROW_ONLY) //** P3N - 1/27/00
BROW_ONLY := .F. //** P3N - 1/27/00
ENDIF //** P3N - 1/27/00
IF SELECT(CUST_MAST) > 0
ELSE
DBOPEN('CUST_MAST')
ENDIF
IF SELECT(ALTSHIPADR) > 0 //** P3N - 11/13/98
ELSE //** P3N - 11/13/98
DBOPEN('ALTSHIPADR') //** P3N - 11/13/98
ENDIF //** P3N - 11/13/98
IF CUST_MAST->(DBSEEK(USERKEY))
MTITLE := MTITLE + ALLTRIM(CUST_MAST->COMP_NAME)
IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD'
OPT := 1
ELSE
OPT := 3
ENDIF
IF ALTSHIPADR->(DBSEEK(ORD_MAST->ORDER_NUM))
ELSE
ALTSHIPADR->(DBAPPEND()) //**PN3 -11/13/98
REC_LOCK( 3, 'ALTSHIPADR' ) //**P3N -11/13/98
ALTSHIPADR->ORDER_NUM := ORD_MAST->ORDER_NUM //**P3N -11/13/98
ALTSHIPADR->BOSHP_METH := CUST_MAST->BOSHP_METH //**P3N -11/13/98
ALTSHIPADR->BOSHP_SCRN := CUST_MAST->BOSHP_METH //**P3N -11/13/98
ALTSHIPADR->BOSHP_STRM := CUST_MAST->BOSHP_METH //**P3N -11/13/98
ALTSHIPADR->(DBUNLOCK()) //**P3N -11/13/98
ENDIF //**P3N -11/13/98
IF BROW_ONLY //**P3N - 1/27/00
ACTION_CODE := 'REV' //**P3N - 1/27/00
OPT := 3 //**P3N - 1/27/00
ENDIF //**P3N -11/13/98
ASR_ARR := {'ALTSHIPADR',ADD_REC, , , , , ACTION_CODE , '3245', .F.}
ADD_SING_REC(OPT, MTITLE, ASR_ARR)
ELSE
ERR_BOX('** Customer -' + ALLTRIM(USERKEY) + ' NOT Found! **')
ENDIF
CLOSE ALTSHIPADR //** P3N - 11/13/98
SELECT(SVSEL)
RESTSCREEN(,,,,SVSCRN)
RETURN .T.
********************************************************************
//** P3N - WILL WE SHIP THE ENTIRE ORDER?
//** 5/11/98 ( HAPPY BIRTHDAY DON-DON)
********************************************************************
FUNCTION SHIP_TOTQTY(OPT, TITLE, CURMST, GBROWSE)
LOCAL CUR_MAST := CURMST, SHIPORD, SHIPREST
LOCAL MTITLE := TITLE
LOCAL SEEKORD, CHOICE := 0, SVCOLOR
LOCAL PARR := { 'Entire Order Shipment', ;
'Ship Everything EXCEPT SCREENS'}
LOCAL SVSEL := SELECT()
LOCAL SVSCRN := SAVESCREEN()
DBOPEN('PRODUCT')
DBOPEN('ORD_SHIP')
DBOPEN('ADDL_LINES')
DBOPEN(CUR_MAST)
DBOPEN('ORD_LINES')
DO WHILE .T.
CLS
IF EMPTY(MTITLE)
MTITLE := 'Order Shipping'
ENDIF
SAYTITLE(MTITLE, '3220')
IF GBROWSE
GBROWSE(, 'ORDER SHIPPING SELECTION', CUR_MAST)
IF LASTKEY() = 27
EXIT
ENDIF
ENDIF
SEEKORD := (CUR_MAST)->ORDER_NUM
IF EMPTY((CUR_MAST)->ORDER_NEW) //** P3N - 12/9/98
IF ALL_SHIPPED(SEEKORD, 'OL') .AND. ALL_SHIPPED(SEEKORD, 'XL') .AND. ;
ALL_SHIPPED(SEEKORD, 'SCREENS') .AND. ALL_SHIPPED(SEEKORD, 'MISC')
ERR_BOX ('** The ENTIRE order is already shipped! **')
SHIPORD := .F.
ELSEIF ORD_SHIP->(DBSEEK(SEEKORD))
M1 := '*** You are about to COMPLETE Order - ' + ALLTRIM(SEEKORD)
M2 := '*** Do you want to SHIP remaining Items, '
M3 := ' and CLOSE this ORDER? '
SHIPORD := PROMPT_BOX(M1,M2,M3)
SHIPREST := .T.
ELSE
SHIPORD := .T.
SHIPREST := .F.
ENDIF
ELSE //** P3N - 12/9/98
//** PARTIAL INVOICE - THIS ORDER SHOULD BE FILLED BY ORDER_NEW
ERR_BOX ('** The ENTIRE order is already shipped! **')
SHIPORD := .F.
ENDIF
IF SHIPORD
IF GET_INV_SHPDT() //** P3N - 5/12/98
@ 2,0 CLEAR
SVCOLOR := SETCOLOR(HREV)
@ 8,20 SAY 'Select Shipment activity for ORDER - ' + SEEKORD
SETCOLOR(SVCOLOR)
DO WHILE .T.
CHOICE := PICKLIST(PARR,10,25) //Select what ACTION to take?????
IF LASTKEY() = 27
EXIT
ELSEIF EMPTY(CHOICE)
ELSEIF CHOICE = 2
SHIP_ALL(SEEKORD, 'NOSCREENS', CUR_MAST, SHIPREST )
EXIT
ELSEIF CHOICE = 1
SHIP_ALL(SEEKORD, 'SCREENS', CUR_MAST, SHIPREST)
EXIT
ENDIF
ENDDO
ENDIF
ENDIF
IF GBROWSE
ELSE
EXIT
ENDIF
ENDDO
RESTSCREEN(,,,,SVSCRN)
SELECT(SVSEL)
RETURN .T.
********************************************************************
//** P3N - SHIP THE ENTIRE ORDER!
//** 5/11/98 ( HAPPY BIRTHDAY DON-DON)
********************************************************************
FUNCTION SHIP_ALL(SEEKORD, SHIPSCREENS, CUR_MAST, SHIPREST)
LOCAL SVSEL := SELECT(), OLKEY, ADDL, ITEM_CAT_CODE, DOAUDIT := .T.
LOCAL CUR_OL := 'ORD_LINES', TORDREC := 1
WAIT_BOX('** Processing your SHIPPING request! **', ;
'** Please Wait! **')
IF SELECT('TORD_LINES') > 0
TORDREC := TORD_LINES->(RECNO())
ELSEIF SHIPSCREENS == 'SCREENS'
DBOPEN('TORD_LINES')
TORDREC := TORD_LINES->(RECNO())
IF TORD_LINES->(DBSEEK(SEEKORD))
//** ALREADY HAVE THE TORD_LINES BUILT
ELSE
CLOSE TORD_LINES
BLD_TORD_LINES(SEEKORD)
ENDIF
ENDIF
IF SHIPREST // SHIP THE REST OF THE ORDER!
SHIP_REST(SEEKORD, SHIPSCREENS)
ELSEIF (CUR_OL)->(DBSEEK(SEEKORD)) // FIND THE FIRST ORDER LINE RECORD!
SELECT TORD_LINES
GO TOP
DO WHILE TORD_LINES->(!EOF())
ADD_ONEREC('TORD_LINES', 'ORD_SHIP' , DOAUDIT)
REC_LOCK(3, 'ORD_SHIP')
ORD_SHIP->TRAN_NUM := STR(TORD_LINES->(RECNO()),3)
//**ORD_SHIP->(DBUNLOCK())
**** IF SHIPSCREENS == 'NOSCREENS' ?CATEGORY SCREENS?
**** SHIP EVERYTHING EXCEPT SCREENS ?
ITEM_CAT_CODE := GET_CATCODE(PROD_CODE)
//** P3N - 1/28/99
//** (ITEM_CAT_CODE = 'SCREENS' .OR. ORD_SHIP->PROD_CODE == 'SCREENS')
IF SHIPSCREENS == 'NOSCREENS' .AND. ;
(ITEM_CAT_CODE = 'SCREENS' .OR. TORD_LINES->PROD_CODE == 'SCREENS' ;
.OR. TORD_LINES->PROD_CODE == 'SCRFLNK')
****BYPASS SCREENS - DO NOT SHIP
REPLACE ORD_SHIP->SHIP_DATE WITH CTOD(' / / ') //** P3N - 1/29/99
REPLACE ORD_SHIP->SHIP_QTY WITH 0 //** P3N - 1/29/99
ELSE
//** REC_LOCK(3, 'ORD_SHIP')
REPLACE ORD_SHIP->SHIP_DATE WITH (CUR_MAST)->SHIP_DATE //** P3N - 10/14/98
IF ORD_SHIP->PROD_CODE == 'MISCITM'
REPLACE ORD_SHIP->SHIP_QTY WITH ;
CURMISC_QTY(ORD_SHIP->ORDER_NUM, ORD_SHIP->PROD_CODE, STR(ORD_SHIP->LINE_NUM,3) )
ELSEIF ORD_SHIP->PROD_CODE = 'ORD'
REPLACE ORD_SHIP->SHIP_QTY WITH ;
CURMISC_QTY(ORD_SHIP->ORDER_NUM, ORD_SHIP->PROD_CODE, STR(ORD_SHIP->LINE_NUM,3) )
ELSE
//** REPLACE ORD_SHIP->SHIP_QTY WITH CUROL_QTY(OLKEY, ADDL)
REPLACE ORD_SHIP->SHIP_QTY WITH TORD_LINES->QUANTITY
ENDIF
ENDIF
ORD_SHIP->(DBUNLOCK())
TORD_LINES->(DBSKIP(+1))
ENDDO
SELECT(SVSEL)
ELSE
ERR_BOX('NO lines to Ship!')
ENDIF
DEL_ORD_SHIP(SEEKORD)
TORD_LINES->(DBGOTO(TORDREC))
SELECT(SVSEL)
RETURN .T.
********************************************************************
//** P3N - GET THE MISC QTYS FOR SHIPPING PURPOSES
//** 7/29/98
********************************************************************
FUNCTION CURMISC_QTY(ORDNUM, PRODCODE, LNUM )
LOCAL RETVAL := 0, SVSEL := SELECT(), OMIKEY := ORDNUM + LNUM
IF PRODCODE == 'MISCITM'
DBOPEN('ORD_MISC')
IF ORD_MISC->(DBSEEK(OMIKEY))
RETVAL := ORD_MISC->QUANTITY
ENDIF
ELSEIF PRODCODE = 'ORD'
IF PRODCODE == 'ORDMISC'
IF ALLTRIM(LNUM) == '1'
RETVAL := (CUR_MAST)->MISC_QTY1
ELSEIF ALLTRIM(LNUM) == '2'
RETVAL := (CUR_MAST)->MISC_QTY2
ELSEIF ALLTRIM(LNUM) == '3'
RETVAL := (CUR_MAST)->MISC_QTY3
ENDIF
ELSEIF PRODCODE == 'ORDNOTX'
IF ALLTRIM(LNUM) == '1'
RETVAL := (CUR_MAST)->NOTX_QTY1
ELSEIF ALLTRIM(LNUM) == '2'
RETVAL := (CUR_MAST)->NOTX_QTY2
ELSEIF ALLTRIM(LNUM) == '3'
RETVAL := (CUR_MAST)->NOTX_QTY3
ENDIF
ENDIF
ENDIF
SELECT(SVSEL)
RETURN RETVAL
********************************************************************
//** P3N - DELETE THE ORDER SHIP REC IF EMPTY SHIP AND INVOICE QTYS
//** 5/20/98
********************************************************************
FUNCTION DEL_ORD_SHIP(SEEKORD)
LOCAL DELARR := {}, I
IF ORD_SHIP->(DBSEEK(SEEKORD)) // FIND THE FIRST ORDER SHIP RECORD!
DO WHILE ORD_SHIP->(!EOF()) .AND. ORD_SHIP->ORDER_NUM == SEEKORD
IF EMPTY(ORD_SHIP->SHIP_QTY) .AND. EMPTY(ORD_SHIP->INV_QTY)
AADD(DELARR, ORD_SHIP->(RECNO()) )
ENDIF
ORD_SHIP->(DBSKIP(+1))
ENDDO
FOR I := 1 TO LEN(DELARR)
ORD_SHIP->(DBGOTO(DELARR[I]))
REC_LOCK(3, 'ORD_SHIP')
REPLACE ORD_SHIP->ORDER_NUM WITH ' '
REPLACE ORD_SHIP->LINE_NUM WITH 0
REPLACE ORD_SHIP->PROD_CODE WITH ' '
REPLACE ORD_SHIP->PAR_PROD WITH ' '
REPLACE ORD_SHIP->SHIP_DATE WITH CTOD(' / / ')
ORD_SHIP->(DBDELETE())
ORD_SHIP->(DBUNLOCK())
NEXT
ENDIF
RETURN .T.
********************************************************************
//** P3N - ZERO ALL ORDER SHIP REC SHIP AND INVOICE QTYS
//** 10/15/98
********************************************************************
FUNCTION REMOVE_ORD_SHIP()
LOCAL SVSEL := SELECT()
LOCAL M1 := '*** Are you sure you want to DELETE / REMOVE '
LOCAL M2 := '*** ALL existing Shipping Information ???'
LOCAL M3 := ' ', RETVAL := .F., I, DELARR := {}
LOCAL SEEKORD := (CUR_MAST)->ORDER_NUM
LOCAL REMOVE_INV := .F., CLOSEBT := .F. //** P3N - 12/22/98
LOCAL DONOTREMOVE := .T., CLOSESH := .F. //** P3N - 12/22/98
IF EMPTY(ORD_MAST->IDATE_FST)
DONOTREMOVE := .F.
ELSE
M1 := 'THIS ORDER HAS ALREADY BEEN INVOICED!!! '
M2 := '*** Are you sure you want to DELETE / REMOVE '
M3 := '*** ALL existing Shipping Information ???'
REMOVE_INV := .T. //** P3N -12/22/98
ENDIF
IF PROMPT_BOX(M1,M2,M3)
IF POSTED_ORDER(SEEKORD)
ERR_BOX('** Order already INVOICED and POSTED to the A/S 400! **', ;
'** You CAN NOT remove these Shipping records !')
DONOTREMOVE := .T. //** P3N - 12/22/98
ELSEIF REMOVE_INV //** P3N - 12/22/98
M1 := 'IF YOU PROCEED YOU WILL ERASE THE FIRST INVOICE!!'
M2 := ' '
M3 := 'CONTACT SUPERVISOR TO PROCEED !'
ERR_BOX(M1, M2, M3) //** P3N - 12/22/98
DONOTREMOVE := .T. //** P3N - 12/22/98
IF LASTKEY() == 126 //SHIFT + "~" //** P3N - 12/22/98
DONOTREMOVE := .F. //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
IF DONOTREMOVE //** P3N - 12/22/98
ELSEIF ORD_SHIP->(DBSEEK(SEEKORD)) // FIND THE FIRST ORDER SHIP RECORD!
DO WHILE ORD_SHIP->(!EOF()) .AND. ORD_SHIP->ORDER_NUM == SEEKORD
REC_LOCK(3, 'ORD_SHIP')
REPLACE ORD_SHIP->SHIP_QTY WITH 0
REPLACE ORD_SHIP->INV_QTY WITH 0
ORD_SHIP->(DBUNLOCK())
ORD_SHIP->(DBSKIP(+1))
ENDDO
DEL_ORD_SHIP(SEEKORD)
REC_LOCK(3, CUR_MAST) //** P3N - 1/15/99
REPLACE (CUR_MAST)->SHIP_DATE WITH CTOD(' / / ') //** P3N - 1/15/99
IF REMOVE_INV //** P3N - 12/22/98
REPLACE (CUR_MAST)->IDATE_FST WITH CTOD(' / / ') //** P3N - 12/22/98
REPLACE (CUR_MAST)->ITIME_FST WITH SPACE(5) //** P3N - 12/22/98
REPLACE (CUR_MAST)->IDATE_LAST WITH CTOD(' / / ') //** P3N - 12/22/98
REPLACE (CUR_MAST)->ITIME_LAST WITH SPACE(5) //** P3N - 12/22/98
IF SELECT('BILLTRAN') > 0 //** P3N - 12/22/98
ELSE //** P3N - 12/22/98
DBOPEN('BILLTRAN') //** P3N - 12/22/98
CLOSEBT := .T. //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
IF BILLTRAN->(DBSEEK((CUR_MAST)->ORDER_NUM)) //** P3N - 12/22/98
DELARR := {}
DO WHILE BILLTRAN->(!EOF()) .AND. ;
BILLTRAN->ORDER_NUM == (CUR_MAST)->ORDER_NUM
AADD(DELARR, BILLTRAN->(RECNO()) )
BILLTRAN->(DBSKIP(+1)) //** P3N - 1/15/98
ENDDO
FOR I := 1 TO LEN(DELARR)
BILLTRAN->(DBGOTO(DELARR[I])) //** P3N - 1/15/99
REC_LOCK(3, 'BILLTRAN') //** P3N - 1/15/99
BILLTRAN->ORDER_NUM := SPACE(LEN(BILLTRAN->ORDER_NUM))
BILLTRAN->INVAM := 0 //** P3N - 1/15/99
BILLTRAN->(DBDELETE()) //** P3N - 1/15/99
BILLTRAN->(DBUNLOCK()) //** P3N - 1/15/98
NEXT //** P3N - 1/15/99
ENDIF //** P3N - 12/22/98
IF CLOSEBT //** P3N - 12/22/98
CLOSE BILLTRAN //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
IF SELECT('SALEHIST') > 0 //** P3N - 12/22/98
ELSE //** P3N - 12/22/98
DBOPEN('SALEHIST') //** P3N - 12/22/98
CLOSESH := .T. //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
IF SALEHIST->(DBSEEK((CUR_MAST)->ORDER_NUM)) //** P3N - 12/22/98
DELARR := {}
DO WHILE SALEHIST->(!EOF()) .AND. ;
SALEHIST->ORDER_NUM == (CUR_MAST)->ORDER_NUM
AADD(DELARR, SALEHIST->(RECNO()) )
SALEHIST->(DBSKIP(+1)) //** P3N - 1/15/99
ENDDO
FOR I := 1 TO LEN(DELARR)
SALEHIST->(DBGOTO(DELARR[I])) //** P3N - 1/15/99
REC_LOCK(3, 'SALEHIST') //** P3N - 1/15/99
SALEHIST->ORDER_NUM := SPACE(LEN(SALEHIST->ORDER_NUM))
SALEHIST->AMOUNT := 0 //** P3N - 1/15/99
SALEHIST->(DBDELETE()) //** P3N - 1/15/99
SALEHIST->(DBUNLOCK()) //** P3N - 1/15/99
NEXT //** P3N - 1/15/99
ENDIF //** P3N - 12/22/98
IF CLOSESH //** P3N - 12/22/98
CLOSE SALEHIST //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
ENDIF //** P3N - 12/22/98
(CUR_MAST)->(DBUNLOCK()) //** P3N - 1/15/99
RETVAL := .T.
ENDIF
ENDIF
SELECT(SVSEL)
RETURN RETVAL
********************************************************************
//** P3N - SHIP THE REST OF THE ORDER
//** 5/15/98
********************************************************************
FUNCTION SHIP_REST(SEEKORD, SHIPSCREENS)
LOCAL DOAUDIT := .T., ADDL, OLKEY, TOTQTY, OSKEY, SHPQTY, ITEM_CAT_CODE
LOCAL SVSEL := SELECT(), NEWORD, NEWLINE, NEWPROD, NEWPAR, NEWQTY, SVREC
LOCAL TOLKEY
ADDZEROSHIP(SEEKORD, SHIPSCREENS) //** ADD ALL ZERO SHIP RECS TO ORD_SHIP
SELECT ORD_SHIP
IF ORD_SHIP->(DBSEEK(SEEKORD)) // FIND THE FIRST ORDER SHIP RECORD!
DO WHILE ORD_SHIP->(!EOF()) .AND. SEEKORD == ORD_SHIP->ORDER_NUM
IF EMPTY(ORD_SHIP->PAR_PROD)
OLKEY := ORD_SHIP->ORDER_NUM + STR(ORD_SHIP->LINE_NUM,3)
ADDL := .F.
ELSE
OLKEY := ORD_SHIP->ORDER_NUM + ORD_SHIP->PROD_CODE + STR(ORD_SHIP->LINE_NUM,3)
ADDL := .T. //** ADDL LINES FILE
ENDIF
//** P3N - 11/04/98
OSKEY := ORD_SHIP->ORDER_NUM + STR(ORD_SHIP->LINE_NUM,3)+ ;
ORD_SHIP->PROD_CODE+ORD_SHIP->PAR_PROD+ORD_SHIP->TRAN_NUM
IF ORD_SHIP->PROD_CODE = 'MISCITM' .OR. ORD_SHIP->PROD_CODE = 'ORD'
TOTQTY := CURMISC_QTY(ORD_SHIP->ORDER_NUM, ORD_SHIP->PROD_CODE, STR(ORD_SHIP->LINE_NUM,3) )
ELSE
TOLKEY := ORD_SHIP->ORDER_NUM + STR(ORD_SHIP->LINE_NUM, 3) + ;
ORD_SHIP->PROD_CODE + ORD_SHIP->PAR_PROD + ORD_SHIP->TRAN_NUM
TOTQTY := TOL_QTY(TOLKEY)
ENDIF
SHPQTY := LINESHPQTY(OSKEY)
DO WHILE ORD_SHIP->(!EOF()) .AND. ;
OSKEY == ORD_SHIP->ORDER_NUM + STR(ORD_SHIP->LINE_NUM,3) + ;
ORD_SHIP->PROD_CODE + ORD_SHIP->PAR_PROD + ORD_SHIP->TRAN_NUM
NEWORD := ORD_SHIP->ORDER_NUM
NEWLINE := ORD_SHIP->LINE_NUM
NEWPROD := ORD_SHIP->PROD_CODE
NEWPAR := ORD_SHIP->PAR_PROD
ORD_SHIP->(DBSKIP(+1))
ENDDO
ITEM_CAT_CODE := GET_CATCODE(PROD_CODE)
//** P3N - 1/28/99
//** (ITEM_CAT_CODE = 'SCREENS' .OR. ORD_SHIP->PROD_CODE == 'SCREENS')
IF SHIPSCREENS == 'NOSCREENS' .AND. ;
(ITEM_CAT_CODE = 'SCREENS' .OR. ORD_SHIP->PROD_CODE == 'SCREENS' ;
.OR. ORD_SHIP->PROD_CODE == 'SCRFLNK')
// BYPASS THE SCREENS FOR SHIPMENT
ELSE
IF TOTQTY == SHPQTY
// EVERYTHING IS ALREADY SHIPPED - CONTINUE
ELSE
SVREC := ORD_SHIP->(RECNO())
ADD_ONEREC('ORD_SHIP', 'ORD_SHIP' , DOAUDIT)
NEWQTY := TOTQTY - SHPQTY
REC_LOCK(3)
REPLACE ORD_SHIP->ORDER_NUM WITH NEWORD
REPLACE ORD_SHIP->LINE_NUM WITH NEWLINE
REPLACE ORD_SHIP->PROD_CODE WITH NEWPROD
REPLACE ORD_SHIP->PAR_PROD WITH NEWPAR
REPLACE ORD_SHIP->SHIP_DATE WITH (CUR_MAST)->SHIP_DATE //** P3N - 10/14/98
REPLACE ORD_SHIP->SHIP_QTY WITH NEWQTY
UNLOCK
GOTO SVREC
ENDIF
ENDIF
ENDDO
ENDIF
SELECT(SVSEL)
RETURN
********************************************************************
//** P3N - GET THE TOTAL SHIP QTY FOR A GIVEN LINE
//** 5/15/98
********************************************************************
FUNCTION LINESHPQTY(OSKEY, TRANKEY)
LOCAL SVSEL := SELECT(), SHPQTY := 0
LOCAL SVREC := ORD_SHIP->(RECNO()), CMPRKEY
SELECT(SVSEL)
SELECT ORD_SHIP
IF DBSEEK(OSKEY)
//** P3N - 11/04/98
DO WHILE !EOF() .AND. ORD_SHIP->ORDER_NUM == (CUR_MAST)->ORDER_NUM
CMPRKEY := ORDER_NUM + STR(LINE_NUM, 3)+PROD_CODE+PAR_PROD+TRAN_NUM
IF TRANKEY == 'NOTRAN'
CMPRKEY := ORDER_NUM + STR(LINE_NUM, 3)+PROD_CODE+PAR_PROD
ENDIF
IF CMPRKEY == OSKEY
SHPQTY := SHPQTY + SHIP_QTY
ENDIF
DBSKIP(+1)
ENDDO
ENDIF
GOTO SVREC
SELECT(SVSEL)
RETURN SHPQTY
********************************************************************
//** P3N - ADD ALL KEYS WITH ZERO SHIP QTY FOR A GIVEN LINE
//** 5/15/98
********************************************************************
FUNCTION ADDZEROSHIP(SEEKORD, SHIPSCREENS, NOSHIPQTY)
LOCAL SVSEL := SELECT()
LOCAL OSKEY, DOAUDIT := .T., ITEM_CAT_CODE
LOCAL TORDREC := TORD_LINES->(RECNO())
SELECT TORD_LINES
GO TOP
DO WHILE TORD_LINES->(!EOF())
IF TORD_LINES->PROD_CODE = 'MISCITM' .OR. ;
TORD_LINES->PROD_CODE = 'ORD'
//** SHIP SYSTEM GENERATED (MISCITM), (ORDMISC) OR (ORDNOTX) RECORDS
ELSEIF SHIPSCREENS = 'NOSCREENS'
ITEM_CAT_CODE := GET_CATCODE(TORD_LINES->PROD_CODE)
IF TORD_LINES->PROD_CODE == 'SCREENS' .OR. ;
TORD_LINES->PROD_CODE == 'SCRFLNK' .OR. ; //** P3N - 1/28/99
ITEM_CAT_CODE = 'SCREENS'
****BYPASS SCREENS
TORD_LINES->(DBSKIP(+1))
LOOP
ENDIF
ENDIF
//** P3N - 11/4/98
//**OSKEY := TORD_LINES->ORDER_NUM + STR(TORD_LINES->LINE_NUM, 3) + TORD_LINES->PROD_CODE + TORD_LINES->PAR_PROD
OSKEY := TORD_LINES->ORDER_NUM + STR(TORD_LINES->LINE_NUM, 3) + ;
TORD_LINES->PROD_CODE + TORD_LINES->PAR_PROD + STR(TORD_LINES->(RECNO()), 3)
IF ORD_SHIP->(DBSEEK(OSKEY))
IF EMPTY(ORD_SHIP->SHIP_DATE) .AND. EMPTY(ORD_SHIP->SHIP_QTY)
IF EMPTY(NOSHIPQTY) //** DO NOT UPDATE SHIP QTY WHEN INVOICING
SELECT ORD_SHIP
REC_LOCK(3)
REPLACE ORD_SHIP->SHIP_DATE WITH (CUR_MAST)->SHIP_DATE //** P3N - 10/14/98
******REPLACE ORD_SHIP->SHIP_QTY WITH ORD_LINES->QUANTITY
REPLACE ORD_SHIP->SHIP_QTY WITH TORD_LINES->QUANTITY
UNLOCK
ENDIF
ENDIF
ELSE
ADD_ONEREC('TORD_LINES', 'ORD_SHIP' , DOAUDIT)
SELECT ORD_SHIP
REC_LOCK(3)
IF EMPTY(NOSHIPQTY) //** DO NOT UPDATE SHIP QTY WHEN INVOICING
REPLACE ORD_SHIP->SHIP_DATE WITH (CUR_MAST)->SHIP_DATE //** P3N - 10/14/98
REPLACE ORD_SHIP->SHIP_QTY WITH TORD_LINES->QUANTITY
ELSEIF NOSHIPQTY //** P3N - 1/11/99
REPLACE ORD_SHIP->SHIP_QTY WITH 0 //** P3N - 1/11/99
ENDIF
REPLACE ORD_SHIP->TRAN_NUM WITH STR(TORD_LINES->(RECNO()),3) //** P3N - 11/4/98
ORD_SHIP->(DBUNLOCK())
ENDIF
TORD_LINES->(DBSKIP(+1))
ENDDO
TORD_LINES->(DBGOTO(TORDREC))
SELECT(SVSEL)
RETURN
********************************************************************
//** P3N - IS THE ENTIRE ORDER ALREADY SHIPPED?
//** 5/15/98
********************************************************************
FUNCTION ALL_SHIPPED(SEEKORD, WHATLINE )
LOCAL OSKEY, RETVAL := .T.
LOCAL OSREC := ORD_SHIP->(RECNO()), TORDREC
LOCAL SVSEL := SELECT()
IF SELECT('TORD_LINES') > 0
TORDREC := TORD_LINES->(RECNO())
ELSEIF WHATLINE == 'SCREENS'
DBOPEN('TORD_LINES')
IF TORD_LINES->(DBSEEK(SEEKORD))
//** ALREADY HAVE THE TORD_LINES BUILT
ELSE
CLOSE TORD_LINES
BLD_TORD_LINES(SEEKORD)
ENDIF
ENDIF
IF WHATLINE == 'OL'
IF ORD_LINES->(DBSEEK(SEEKORD))
DO WHILE ORD_LINES->(!EOF()) .AND. ORD_LINES->ORDER_NUM == SEEKORD
OSKEY := ORD_LINES->ORDER_NUM + STR(ORD_LINES->LINE_NUM,3)+ORD_LINES->PROD_CODE+ORD_LINES->PAR_PROD
IF ORD_SHIP->(DBSEEK(OSKEY))
TOTQTY := ORD_LINES->QUANTITY
IF ORD_SHIP->PROD_CODE = 'MISCITM' .OR. ORD_SHIP->PROD_CODE = 'ORD'
SHPQTY := CURMISC_QTY(ORD_SHIP->ORDER_NUM, ORD_SHIP->PROD_CODE, STR(ORD_SHIP->LINE_NUM,3) )
ELSE
//** P3N - 11/4/98
SHPQTY := LINESHPQTY(OSKEY,'NOTRAN')
ENDIF
IF TOTQTY == SHPQTY
RETVAL := .T.
ELSE
RETVAL := .F.
EXIT
ENDIF
ELSE
RETVAL := .F.
EXIT
ENDIF
ORD_LINES->(DBSKIP(+1))
ENDDO
ENDIF
ELSEIF WHATLINE == 'XL' .AND. ADDL_LINES->(DBSEEK(SEEKORD))
DO WHILE ADDL_LINES->(!EOF()) .AND. ADDL_LINES->ORDER_NUM == SEEKORD
OSKEY := ADDL_LINES->ORDER_NUM + STR(ADDL_LINES->LINE_NUM,3)+ADDL_LINES->PROD_CODE+ADDL_LINES->PAR_PROD
IF ORD_SHIP->(DBSEEK(OSKEY))
TOTQTY := ADDL_LINES->QUANTITY
//** P3N - 11/4/98
SHPQTY := LINESHPQTY(OSKEY, 'NOTRAN')
IF TOTQTY == SHPQTY
ELSE
RETVAL := .F.
EXIT
ENDIF
ELSE
RETVAL := .F.
EXIT
ENDIF
ADDL_LINES->(DBSKIP(+1))
ENDDO
ELSEIF WHATLINE == 'SCREENS' .OR. WHATLINE == 'MISC'
SELECT TORD_LINES
GO TOP
DO WHILE TORD_LINES->(!EOF())
OSKEY := TORD_LINES->ORDER_NUM + STR(TORD_LINES->LINE_NUM, 3)
OSKEY := OSKEY + TORD_LINES->PROD_CODE + TORD_LINES->PAR_PROD
IF ORD_SHIP->(DBSEEK(OSKEY))
//** IF PROD_CODE == 'SCREENS' .OR. ; //** P3N - 1/28/99
IF PROD_CODE == 'SCREENS' .OR. PROD_CODE == 'SCRFLNK' .OR. ;
PROD_CODE = 'MISCITM' .OR. PROD_CODE = 'ORD'
TOTQTY := TORD_LINES->QUANTITY
SHPQTY := LINESHPQTY(OSKEY, 'NOTRAN')
//** SHPQTY := LINESHPQTY(OSKEY)
IF TOTQTY == SHPQTY
RETVAL := .T.
ELSE
RETVAL := .F.
EXIT
ENDIF
ENDIF
ELSE
RETVAL := .F.
EXIT
ENDIF
DBSKIP(+1)
ENDDO
TORD_LINES->(DBGOTO(TORDREC))
ENDIF
ORD_SHIP->(DBGOTO(OSREC))
SELECT(SVSEL)
RETURN RETVAL
********************************************************************
//** P3N - EDIT THE ORD_MAST->TERMS
//** 7/28/98
//** IF IOLA AND F6-FUN6(INVOICING AUTH.) ALLOW ORD_MAST->TERMS UPDATE
//** IF NOT IOLA ALLOW ORD_MAST->TERMS UPDATE REGARDLESS
********************************************************************
FUNCTION EDIT_OM_TERM()
LOCAL RETVAL := .T.
IF MHOME_LOC_CODE = 'IOLA'
IF FUN6 == 'X'
RETVAL := .T.
ELSE
RETVAL := .F.
ENDIF
ENDIF
RETURN RETVAL
********************************************************************
//** P3N - INITIALIZE THE ORDER SHIPPING RECORD WITH A DATE
//** 11/24/98
********************************************************************
FUNCTION OSTDATEINIT()
LOCAL RETVAL
IF EMPTY(ORD_MAST->SHIP_DATE)
RETVAL := DATE()
ELSE
RETVAL := ORD_MAST->SHIP_DATE
ENDIF
RETURN RETVAL
********************************************************************
//** P3N - UPDATE THE ORD_MAST->ORD_BO_TTL
//**11/19/98
********************************************************************
FUNCTION UPD_BO_TOTAL(LINEFILE)
LOCAL RETVAL := .T., BO_TOTAL := 0, BO_AMT := 0, BO_QTY := 0, SHPQTY := 0
IF (CUR_MAST)->(FIELDPOS('ORD_BO_TTL')) > 0
IF (LINEFILE)->(DBSEEK( (CUR_MAST)->ORDER_NUM ) )
DO WHILE (LINEFILE)->(!EOF()) .AND. (LINEFILE)->ORDER_NUM == (CUR_MAST)->ORDER_NUM
IF ORD_SHIP->(DBSEEK( (CUR_MAST)->ORDER_NUM ) )
SHPQTY := 0
OSKEY := (LINEFILE)->ORDER_NUM + STR((LINEFILE)->LINE_NUM, 3) + ;
(LINEFILE)->PROD_CODE + (LINEFILE)->PAR_PROD
IF ORD_SHIP->(DBSEEK(OSKEY))
DO WHILE (LINEFILE)->LINE_NUM == ORD_SHIP->LINE_NUM .AND. ;
(LINEFILE)->PROD_CODE == ORD_SHIP->PROD_CODE .AND. ;
(LINEFILE)->PAR_PROD == ORD_SHIP->PAR_PROD
SHPQTY := SHPQTY + ORD_SHIP->SHIP_QTY
BO_QTY := (LINEFILE)->QUANTITY - ORD_SHIP->SHIP_QTY
IF EMPTY(ALT_SPRICE)
BO_AMT := (LINEFILE)->SALE_PRICE * BO_QTY
ELSE
BO_AMT := (LINEFILE)->ALT_SPRICE * BO_QTY
ENDIF
BO_TOTAL := BO_TOTAL + BO_AMT
ORD_SHIP->(DBSKIP(+1))
ENDDO
ELSE
BO_QTY := (LINEFILE)->QUANTITY
IF EMPTY(ALT_SPRICE)
BO_AMT := (LINEFILE)->SALE_PRICE * BO_QTY
ELSE
BO_AMT := (LINEFILE)->ALT_SPRICE * BO_QTY
ENDIF
BO_TOTAL := BO_TOTAL + BO_AMT
ENDIF
ENDIF
REC_LOCK(3, LINEFILE)
(LINEFILE)->BO_AMOUNT := BO_AMT
(LINEFILE)->SHIP_QTY := SHPQTY
(LINEFILE)->(DBUNLOCK())
(LINEFILE)->(DBSKIP(+1))
ENDDO
ENDIF
REC_LOCK(3, CUR_MAST)
(CUR_MAST)->ORD_BO_TTL := BO_TOTAL
(CUR_MAST)->(DBUNLOCK())
MISCP_PAINT(.T.) //** USED TO UPDATE ORDER TOTALS BASED ON BO AMT
ENDIF
RETURN RETVAL
********************************************************************
//** P3N - UPDATE THE ORDER SHIP REC WITH INVOICED ITEMS
//** P3N - ONLY ITEMS SHIPPED WILL BE INVOICED.
//**12/1/98
********************************************************************
FUNCTION INVOICE_SHIPPED(SEEKORD)
IF ORD_SHIP->(DBSEEK(SEEKORD)) // FIND THE FIRST ORDER SHIP RECORD!
DO WHILE ORD_SHIP->(!EOF()) .AND. ORD_SHIP->ORDER_NUM == SEEKORD
REC_LOCK(3, 'ORD_SHIP')
REPLACE ORD_SHIP->INV_DATE WITH CURDATE
REPLACE ORD_SHIP->INV_QTY WITH ORD_SHIP->SHIP_QTY
ORD_SHIP->(DBUNLOCK())
ORD_SHIP->(DBSKIP(+1))
ENDDO
ENDIF
RETURN .T.
********************************************************************
//** P3N - UPDATE THE ORDER SHIP REC WITH INVOICED ITEMS
//** P3N - ALL ITEMS WILL BE INVOICED (TOTAL LINE QUANTITY)
//**12/1/98
********************************************************************
FUNCTION INVOICE_ALL(SEEKORD)
LOCAL SVSEL := SELECT(), OSTKEY := ' '
LOCAL SVORD := ' '
LOCAL SVLIN := 0
LOCAL SVPROD := ' '
LOCAL SVPAR := ' '
LOCAL NOSHIPQTY := .T.
IF SELECT('ORD_SHIP') > 0
ELSE
DBOPEN('ORD_SHIP')
ENDIF
IF SELECT('TORD_LINES') > 0
TORD_LINES->(DBGOTOP())
IF TORD_LINES->ORDER_NUM == SEEKORD
ELSE
CLOSE TORD_LINES
BLD_TORD_LINES(SEEKORD)
ENDIF
ELSE
BLD_TORD_LINES(SEEKORD)
ENDIF
ADDZEROSHIP( (CUR_MAST)->ORDER_NUM, 'SCREENS', NOSHIPQTY)
TORD_LINES->(DBGOTOP())
IF ORD_SHIP->(DBSEEK(SEEKORD))
SVORD := TORD_LINES->ORDER_NUM
SVLIN := TORD_LINES->LINE_NUM
SVPROD := TORD_LINES->PROD_CODE
SVPAR := TORD_LINES->PAR_PROD
OSTKEY := TORD_LINES->ORDER_NUM
OSTKEY := OSTKEY + STR(TORD_LINES->LINE_NUM, 3)
OSTKEY := OSTKEY + TORD_LINES->PROD_CODE
OSTKEY := OSTKEY + TORD_LINES->PAR_PROD
DO WHILE TORD_LINES->(!EOF())
IF ORD_SHIP->(DBSEEK(OSTKEY))
DO WHILE SVORD == ORD_SHIP->ORDER_NUM .AND. ;
SVLIN == ORD_SHIP->LINE_NUM .AND. ;
SVPROD == ORD_SHIP->PROD_CODE .AND. ;
SVPAR == ORD_SHIP->PAR_PROD
REC_LOCK(3, 'ORD_SHIP')
REPLACE ORD_SHIP->INV_DATE WITH CURDATE
REPLACE ORD_SHIP->INV_QTY WITH TORD_LINES->QUANTITY
ORD_SHIP->(DBUNLOCK())
ORD_SHIP->(DBSKIP(+1))
ENDDO
ENDIF
TORD_LINES->(DBSKIP(+1))
SVORD := TORD_LINES->ORDER_NUM
SVLIN := TORD_LINES->LINE_NUM
SVPROD := TORD_LINES->PROD_CODE
SVPAR := TORD_LINES->PAR_PROD
OSTKEY := TORD_LINES->ORDER_NUM
OSTKEY := OSTKEY + STR(TORD_LINES->LINE_NUM, 3)
OSTKEY := OSTKEY + TORD_LINES->PROD_CODE
OSTKEY := OSTKEY + TORD_LINES->PAR_PROD
ENDDO
ENDIF
SELECT(SVSEL)
RETURN .T.
*******************************************************************
* THIS FUNCTION WILL BUILD THE ORDER DESCRIPTION TO BE PRINTED
*******************************************************************
//* PRINT_IND VALUES: A-ALWAYS PRINT
//* N-NEVER PRINT
//* D-PRINT IF DEFAULT
//* E-PRINT EXCEPTION (IF NOT DEFAULT)
FUNCTION BLD_DESC(G_ARR, SELFILE, WHCHORDER, BKOPROD, SUBTYPE)
LOCAL SV_SEL := SELECT(), PRNT_DESC := '', IRULE := '', PRT_IC := .T.
LOCAL O_DESC := '', I, II, L_DESC := '', G_DESC := '', IRULEOPT := ' '
LOCAL OPTARR, ELEM, DESC2USE, PRNTDESC, GLASS_ORDER := .F., IC_DESC
LOCAL MLOC_CODE, RESULT, CKVAR, WORKVAR, LASTBREAK, LASTSTRT
LOCAL L_DESC_COPY := '', WHATCOPY, MWCOPY, X //** P3N - 5/4/99
LOCAL PRTOPT := '' //** P3N - 8/17/98
LOCAL BACKORDER := .F. //** P3N - 8/17/98
IF EMPTY(WHCHORDER) //** P3N - 8/17/98
BACKORDER := .F. //** P3N - 8/17/98
ELSEIF WHCHORDER == 'BACKORD' //** P3N - 8/17/98
BACKORDER := .T. //** P3N - 8/17/98
ENDIF //** P3N - 8/17/98
IF EMPTY(SUBTYPE) //** P3N - 7/21/99 - HAPPY BDAY DANIEL
SUBTYPE := '' //** P3N - 7/21/99
ENDIF //** P3N - 7/21/99
IF EMPTY(BKOPROD) //** P3N - 5/26/99
PRODUCT->(DBSEEK(&SELFILE->PROD_CODE))
ELSE //** P3N - 5/26/99
PRODUCT->(DBSEEK(BKOPROD)) //** P3N - 5/26/99
ENDIF //** P3N - 5/26/99
O_DESC := ALLTRIM(PRODUCT->DESC)
IC_DESC := O_DESC //** P3N - 02/22/02
FOR I := 1 TO LEN(G_ARR)
IF EMPTY( G_ARR[I,4] ) // NO USER RESPONSE
LOOP
ELSEIF G_ARR[I,1] = 'ORIEL TOP' // BYPASS ORIEL MEASUREMENTS
LOOP
ELSEIF G_ARR[I,1] = 'ORIEL BOTT' // BYPASS ORIEL MEASUREMENTS
LOOP
ELSEIF G_ARR[I,1] = 'GL TYPE'
IF G_ARR[I,4] = 'UNGLAZED' // DO NOT PRINT A GLASS ORDER
GLASS_ORDER := .F.
ELSE
GLASS_ORDER := .T.
ENDIF
ENDIF
PRNTDESC := ''
DO CASE
CASE G_ARR[I,OPT_TYP]$'U' // USER ENTERED FIELD
PRNTDESC := ALLTRIM(G_ARR[I,ATRB]) + ' ' + ALLTRIM(G_ARR[I,4])
CASE G_ARR[I,OPT_TYP]$'PT' // PICK/TABLE LIST
// FIND OPT_ARR RECORD FOR THE USER_RESPONSE IN G_ARR[I,4]
OPTARR := G_ARR[I,OPT_ARR]
ELEM := ASCAN(OPTARR, {|X| X[1] == G_ARR[I,4]})
IF ELEM=0 .OR. OPTARR[ELEM,1] = 'NO OPTIONS FOUND!!'
LOOP
ENDIF
// WHICH DESCRIPTION TO PRINT?
IF !EMPTY(OPTARR[ELEM,OPT_PVAL])
// ALTERNATE PRINT VALUE
//** ALLOW THE USER TO CONTROL OPTION SPACING ON ORDER PRINTING
//** DESC2USE := ALLTRIM(OPTARR[ELEM,OPT_PVAL]) //** P3N - 2/28/00
DESC2USE := TRIM(OPTARR[ELEM,OPT_PVAL]) //** P3N - 2/28/00
ELSE
//** ALLOW THE USER TO CONTROL OPTION SPACING ON ORDER PRINTING
// OPTION DESCRIPTION
//** DESC2USE := ALLTRIM(OPTARR[ELEM,OPT_DESC]) //** P3N - 2/28/00
DESC2USE := TRIM(OPTARR[ELEM,OPT_DESC]) //** P3N - 2/28/00
ENDIF
PRTOPT := OPTARR[ELEM, OPT_PIND] //** P3N - 8/17/98
IRULE := OPTARR[ELEM,19] //** P3N - 02/21/02
IF EMPTY(IRULE) //** P3N - 02/21/02
IRULEOPT := 'Y' //** P3N - 02/21/02
ELSE //** P3N - 02/21/02
PRT_IC := CHK_RULE(IRULE, G_ARR, , SELFILE)
IF PRT_IC //** P3N - 02/21/02
IRULEOPT := 'Y' //** P3N - 02/21/02
ELSE //** P3N - 02/21/02
IRULEOPT := 'N' //** P3N - 02/21/02
ENDIF //** P3N - 02/21/02
ENDIF //** P3N - 02/21/02
//** DO NOT PRINT THE ORDER OPTION "W/SCREEN", "W/STORM" ...
//** ON THE PRIMARY BACKORDER - PER PAT 8/17/98
IF BACKORDER //** P3N - 8/17/98
IF SUBTYPE == 'SCREENS' //** P3N - 7/21/99 - HAPPY BDAY DANIEL
IF AT('COLOR', G_ARR[I,1]) > 0 //** P3N - 8/9/99
ELSEIF AT('SCREEN', G_ARR[I,1]) > 0 //** P3N - 8/26/99
//**P3N112601 PRTOPT := 'N' //** P3N - 5/17/01
//**P3N082302 PRTOPT := 'N' //** P3N - 02/25/02 - DO NOT PRINT W/SCREEN FOR BACKORDER SCREENS-JET&2500
ELSE //** P3N - 8/9/99
PRTOPT := 'N' //** P3N - 8/9/99
ENDIF //** P3N - 8/9/99
ELSEIF G_ARR[I,1] = 'SCRN' .OR. ; //** P3N - 8/17/98
G_ARR[I,1] = 'WITH SCREN' .OR. ; //** P3N - 8/17/98
G_ARR[I,1] = 'SCREEN' //** P3N - 8/17/98
IF AT('SCREEN', G_ARR[I,4]) > 0 //** P3N - 8/17/98
IF SCREEN_OPTS(G_ARR) //** P3N - 8/17/98
PRTOPT := 'N' //** P3N - 8/17/98
ENDIF //** P3N - 8/17/98
ELSEIF AT('SCREEN', UPPER(G_ARR[I,5])) > 0 //** P3N - 5/25/99
PRTOPT := 'N' //** P3N - 5/25/99
ELSEIF AT('STORM', G_ARR[I,4]) > 0 //** P3N - 8/17/98
IF STORM_OPTS(G_ARR) //** P3N - 8/17/98
PRTOPT := 'N' //** P3N - 8/17/98
ENDIF //** P3N - 8/17/98
ENDIF //** P3N - 8/17/98
ELSEIF SUBTYPE == 'STORMS' //** P3N - 7/21/99
ELSEIF G_ARR[I,1] = 'STORM' //** P3N - 8/17/98
IF STORM_OPTS(G_ARR) //** P3N - 8/17/98
PRTOPT := 'N' //** P3N - 8/17/98
ENDIF //** P3N - 8/17/98
ENDIF //** P3N - 8/17/98
IF PRTOPT == 'N' //** P3N - 10/15/98
LOOP //** P3N - 10/15/98
ENDIF //** P3N - 10/15/98
ENDIF //** P3N - 8/17/98
DO CASE
CASE OPTARR[ELEM, OPT_PIND] == 'A' // ALWAYS PRINT DESCRIPTION
PRNTDESC := DESC2USE
CASE OPTARR[ELEM, OPT_PIND] == 'N' // NEVER PRINT DESCRIPTION
LOOP
CASE OPTARR[ELEM, OPT_PIND] == 'D' ; // PRINT IF DEFAULT
.AND. G_ARR[I,DEFAULT]$'*'
PRNTDESC := DESC2USE
CASE OPTARR[ELEM, OPT_PIND] == 'E' ; // PRINT IF NOT DEFAULT
.AND. !G_ARR[I,DEFAULT]$'*'
PRNTDESC := DESC2USE
OTHERWISE
LOOP
ENDCASE
OTHERWISE // 'C' VALUES SHOULD BE ONLY ONES TO FALL THRU!
LOOP
ENDCASE
PRNTDESC := STRTRAN(PRNTDESC, ' ' , '~')
IF LEN(PRNTDESC) > 35 // MUST SPLIT THE ALTERNATE VALUE
WORKVAR := PRNTDESC
LASTBREAK := 0
LASTSTRT := 0
FOR II := 1 TO LEN(WORKVAR)
CKVAR := SUBS(WORKVAR,II,1)
IF II < 35 .AND. CKVAR = '~' // 1ST BREAK < 30TH POSITION
LASTBREAK := LASTSTRT + II
ELSE
IF II >= 35
PRNTDESC := SUBS(PRNTDESC,1,LASTBREAK-1) + ;
' ' + SUBS(PRNTDESC,LASTBREAK+1)
WORKVAR := SUBS(PRNTDESC, LASTBREAK + 1)
LASTSTRT := LASTBREAK
II := 0
LOOP
ENDIF
ENDIF
NEXT
ENDIF
ATTRIBUTES->(DBSEEK(G_ARR[I,1]) )
IF ATTRIBUTES->PRNT_WHERE$'L' // PRINT ON THE LINE ITEM
IF EMPTY(L_DESC_COPY) //** P3N - 5/4/99
L_DESC_COPY := TRIM(ATTRIBUTES->WHICH_COPY) //** P3N - 5/4/99
ELSE //** P3N - 5/4/99
MWCOPY := ATTRIBUTES->WHICH_COPY //** P3N - 5/4/99
FOR X := 1 TO LEN(MWCOPY) //** P3N - 5/4/99
WHATCOPY := SUBST(MWCOPY, X,1) //** P3N - 5/4/99
IF EMPTY(WHATCOPY) //** P3N - 5/4/99
ELSEIF AT(WHATCOPY, L_DESC_COPY) > 0 //** P3N - 5/4/99
ELSE //** P3N - 5/4/99
L_DESC_COPY := L_DESC_COPY + WHATCOPY //** P3N - 5/4/99
ENDIF //** P3N - 5/4/99
NEXT //** P3N - 5/4/99
ENDIF //** P3N - 5/4/99
//**IF AT('G', L_DESC_COPY) > 0 //** P3N - 6/7/99
IF AT('G', ATTRIBUTES->WHICH_COPY) > 0 //** P3N - 5/2/00
IF EMPTY(G_DESC) //** P3N - 6/7/99
G_DESC := PRNTDESC //** P3N - 6/7/99
ELSE //** P3N - 6/7/99
G_DESC := G_DESC + ' - ' + PRNTDESC //** P3N - 6/7/99
ENDIF //** P3N - 6/7/99
ELSEIF EMPTY(L_DESC)
L_DESC := PRNTDESC
ELSE
L_DESC := L_DESC + ' - ' + PRNTDESC
ENDIF
ELSE
O_DESC := O_DESC + ' - ' + PRNTDESC //** P3N - 02/22/02
IF IRULEOPT == 'N' //** P3N - 02/22/02
ELSE //** P3N - 02/22/02
IC_DESC := IC_DESC + ' - ' + PRNTDESC //** P3N - 02/22/02
ENDIF //** P3N - 02/22/02
ENDIF
NEXT
IF EMPTY(WHCHORDER) //** P3N - 02/22/02
ELSEIF WHCHORDER == 'PO' //** P3N - 02/22/02
O_DESC := IC_DESC //** P3N - 02/22/02
ENDIF //** P3N - 02/22/02
// ALT MFG LOCATION used it exists and the rule is true
IF !EMPTY(PRODUCT->ALT_MFGRUL)
RESULT = CHK_RULE(PRODUCT->ALT_MFGRUL, G_ARR , , SELFILE)
IF RESULT
MLOC_CODE := PRODUCT->ALT_MFGLOC
ELSE
MLOC_CODE := PRODUCT->LOC_CODE
ENDIF
ELSE
MLOC_CODE := PRODUCT->LOC_CODE
ENDIF
SELECT(SV_SEL)
RETURN {O_DESC, MLOC_CODE, GLASS_ORDER, L_DESC, L_DESC_COPY, G_DESC} //** P3N - 6/7/99
//**RETURN {O_DESC, MLOC_CODE, GLASS_ORDER, L_DESC} //** P3N - 5/4/99
*************************************************************
* P3N - 11/12/98 DO PARTIAL INVOICE PROCESSING *
*************************************************************
FUNCTION PARTIALINVOICE()
LOCAL SV_SCREEN, KEYARR
LOCAL SV_SEL := SELECT()
LOCAL MGET_KEY
LOCAL NEW_ORDR := GET_ORD_NUM('QCNV')
LOCAL SVREC := RECNO()
LOCAL ORG_MSTREC := ORD_MAST->(RECNO())
LOCAL ORG_ORD := ORD_MAST->ORDER_NUM
LOCAL ORDMISCQTYS := GETORDMISCQTYS(), SHPQTY := 0
LOCAL OMISC := ' ', OMNUM := ' ', OMTYP := ' '
LOCAL M1 := '*** This Order has Unshipped Screens! ', M3 := ' '
LOCAL M2 := '*** Should these SCREENS remain BACKORDERED?'
PRIVATE REPFLD := ' '
PRIVATE _CUROPT := 1 // USED FOR GET ORDER NUMBER ????
WAIT_BOX('*** CREATING NEW ORDER - ' + ALLTRIM(NEW_ORDR) + ' From - ' + ORG_ORD, ;
'*** Please Wait' )
SELECT ORD_MAST
REC_LOCK(3, 'ORD_MAST')
REPLACE ORD_MAST->ORDER_NEW WITH NEW_ORDR
ORD_MAST->(DBUNLOCK())
COPY NEXT 1 TO &USERFILE3
NET_USE(USERFILE3, .T. , 3 ,'USERFILE3')
ORD_MAST->(DBGOTO(ORG_MSTREC) )
ADD_ONEREC( 'USERFILE3', 'ORD_MAST' )
SELECT ORD_MAST
REPLACE ORD_MAST->ORDER_ORG WITH ORG_ORD
REPLACE ORD_MAST->ORDER_NUM WITH NEW_ORDR
//** CLEAR THE INVOICE DATE AND BO DATE ON THE NEW ORDER
REPLACE ORD_MAST->IDATE_FST WITH CTOD(' / / ')
REPLACE ORD_MAST->ITIME_FST WITH ' '
REPLACE ORD_MAST->IDATE_LAST WITH CTOD(' / / ')
REPLACE ORD_MAST->ITIME_LAST WITH ' '
REPLACE ORD_MAST->BODATE_FST WITH CTOD(' / / ')
REPLACE ORD_MAST->BOTIME_FST WITH ' '
REPLACE ORD_MAST->BODATE_LST WITH CTOD(' / / ')
REPLACE ORD_MAST->BOTIME_LST WITH ' '
REPLACE ORD_MAST->INVOICENUM WITH ' '
REPLACE ORD_MAST->ORDER_NEW WITH ' '
REPLACE ORD_MAST->SHIP_DATE WITH CTOD(' / / ')
FOR I := 1 TO LEN(ORDMISCQTYS) //** UPDATE THE NEW ORDER MASTER
OMISC := ORDMISCQTYS[I,1] //** WITH THE NEW QTYS
OMNUM := SUBSTR(OMISC, 7, 3) //** NUMBER OF MISC/ NOTX ITEM
OMTYP := SUBSTR(OMISC, 10,7) //** ORDMISC OR ORDNOTX
SHPQTY := ORDMISCQTYS[I,2,1] //** ORDMISC OR ORDNOTX SHIP QTY
IF OMTYP == 'ORDMISC'
REPFLD := 'MISC_QTY' + STR(VAL(OMNUM),1)
ELSEIF OMTYP == 'ORDNOTX'
REPFLD := 'NOTX_QTY' + STR(VAL(OMNUM),1)
ENDIF
REPLACE ORD_MAST->&REPFLD WITH (ORD_MAST->&REPFLD - SHPQTY)
NEXT
ORD_MAST->(DBUNLOCK())
//* MODEL NEW ORDER DETAIL FILES FROM CURRENT ORDER DETAIL FILES
CLOSE USERFILE3
SELECT('ORD_LINES')
COPY STRUCTURE TO &USERFILE3
NET_USE(USERFILE3, .f. , 3 ,'USERFILE3')
KEYARR := ORDCOPY(ORG_ORD, NEW_ORDR, 'ORD_LINES', 'USERFILE3')
CLOSE USERFILE3
SELECT('ORD_LINES')
APPEND FROM (USERFILE3)
SELECT('ORDER_OPTS')
COPY STRUCTURE TO &USERFILE3
NET_USE(USERFILE3, .f. , 3 ,'USERFILE3')
ORDCOPY(ORG_ORD, NEW_ORDR, 'ORDER_OPTS', 'USERFILE3', KEYARR)
CLOSE USERFILE3
SELECT('ORDER_OPTS')
APPEND FROM (USERFILE3)
SELECT('ADDL_LINES')
COPY STRUCTURE TO &USERFILE3
NET_USE(USERFILE3, .f. , 3 ,'USERFILE3')
ORDCOPY(ORG_ORD, NEW_ORDR, 'ADDL_LINES', 'USERFILE3', KEYARR)
CLOSE USERFILE3
SELECT('ADDL_LINES')
APPEND FROM (USERFILE3)
SELECT('ADDL_OPTS')
COPY STRUCTURE TO &USERFILE3
NET_USE(USERFILE3, .f. , 3 ,'USERFILE3')
ORDCOPY(ORG_ORD, NEW_ORDR, 'ADDL_OPTS', 'USERFILE3', KEYARR)
CLOSE USERFILE3
SELECT('ADDL_OPTS')
APPEND FROM (USERFILE3)
SELECT('ORD_MISC')
COPY STRUCTURE TO &USERFILE3
NET_USE(USERFILE3, .f. , 3 ,'USERFILE3')
ORDCOPY(ORG_ORD, NEW_ORDR, 'ORD_MISC', 'USERFILE3', KEYARR)
CLOSE USERFILE3
SELECT('ORD_MISC')
APPEND FROM (USERFILE3)
ORD_MAST->(DBGOTO(ORG_MSTREC) )
SELECT(SV_SEL)
//**SHIP_REST(ORG_ORD, 'SCREENS' ) //** SHIP ALL REMAINING ITEMS ON ORDER
ERR_BOX('*** NEW ORDER - ' + ALLTRIM(NEW_ORDR) , ;
'*** CREATED From - ' + ORG_ORD )
RETURN .T.
*************************************************************
* P3N - 11/13/98 COPY ALL ORDER FILES *
*************************************************************
FUNCTION ORDCOPY(O_NUM, NEW_ORDR, DATAFROM, FINALFILE, KEYARR)
LOCAL CMPRKEY, I, MISCKEY := ' ', QTYARR := {}, QTY := 0, SHP := 0
IF EMPTY(KEYARR)
KEYARR := {}
ENDIF
SELECT (DATAFROM)
DBSEEK(O_NUM)
DO WHILE ORDER_NUM == O_NUM .AND. !EOF()
IF DATAFROM == 'ORD_LINES' .OR. DATAFROM == 'ORD_MISC'
IF FIELDPOS('QUANTITY') > 0 .AND. FIELDPOS('SHIP_QTY') > 0
QTY := QUANTITY
SHP := SHIP_QTY
ELSE
QTY := QUANTITY
MISCKEY := (DATAFROM)->ORDER_NUM
MISCKEY := MISCKEY + (DATAFROM)->LINE_NUM
MISCKEY := MISCKEY + 'MISCITM'
QTYARR := GET_OSTQTY('ORD_LINES', MISCKEY)
IF EMPTY(QTYARR) //** P3N - 12/9/98
SHP := 0 //** P3N - 12/9/98
ELSE //** P3N - 12/9/98
SHP := QTYARR[1] //** P3N - 12/9/98
//** INVQTY := QTYARR[2] //** P3N - 12/9/98
ENDIF //** P3N - 12/9/98
ENDIF //** P3N - 12/9/98
//**IF QUANTITY == SHIP_QTY
IF QTY == SHP
//** ENTIRE LINE SHIPPED DO NOT CARRY OVER TO NEW ORDER
ELSE
ADD_ONEREC( DATAFROM, FINALFILE )
SELECT (FINALFILE)
REC_LOCK(3)
REPCORR(DATAFROM, FINALFILE)
REPLACE ORDER_NUM WITH NEW_ORDR
REPLACE QUANTITY WITH (DATAFROM)->QUANTITY - SHP
//** REPLACE QUANTITY WITH (DATAFROM)->QUANTITY - (DATAFROM)->SHIP_QTY
IF FIELDPOS('SHIP_QTY') > 0
REPLACE SHIP_QTY WITH 0
ENDIF
DBUNLOCK()
SELECT (DATAFROM)
IF DATAFROM == 'ORD_LINES'
AADD(KEYARR, ORDER_NUM + STR(LINE_NUM, 3) )
ENDIF
ENDIF
ELSE
FOR I := 1 TO LEN(KEYARR)
IF VALTYPE(LINE_NUM) = 'N' //** ORD_MISC FILE CONTAINS A CHAR LINE_NUM
CMPRKEY := ORDER_NUM + STR(LINE_NUM, 3)
ELSE
CMPRKEY := ORDER_NUM + LINE_NUM
ENDIF
IF CMPRKEY == KEYARR[I]
IF FIELDPOS('QUANTITY') > 0 .AND. FIELDPOS('SHIP_QTY') > 0
IF QUANTITY == SHIP_QTY
//** ENTIRE LINE SHIPPED DO NOT CARRY OVER TO NEW ORDER
LOOP
ENDIF
ENDIF
ADD_ONEREC( DATAFROM, FINALFILE )
SELECT (FINALFILE)
REC_LOCK(3)
REPCORR(DATAFROM, FINALFILE)
REPLACE ORDER_NUM WITH NEW_ORDR
IF FIELDPOS('QUANTITY') > 0 .AND. FIELDPOS('SHIP_QTY') > 0
REPLACE QUANTITY WITH (DATAFROM)->QUANTITY - (DATAFROM)->SHIP_QTY
REPLACE SHIP_QTY WITH 0
ENDIF
DBUNLOCK()
SELECT (DATAFROM)
ENDIF
NEXT
ENDIF
DBSKIP(+1)
ENDDO
RETURN KEYARR
*************************************************************
* P3N - 12/10/98 GET THE ORDER MASTER MISC QTYS *
*************************************************************
FUNCTION GETORDMISCQTYS()
LOCAL I := 0, WRKARR := {}
LOCAL MISCKEY := ' '
LOCAL QTYARR := {}
FOR I := 1 TO 6
MISCKEY := ORD_MAST->ORDER_NUM
IF I <= 3
MISCKEY := MISCKEY + STR(I,3) + 'ORDMISC'
ELSE
MISCKEY := MISCKEY + STR(I-3,3) + 'ORDNOTX'
ENDIF
WRKARR := GET_OSTQTY('ORD_LINES', MISCKEY)
AADD(QTYARR,{MISCKEY, WRKARR} )
NEXT
RETURN QTYARR
*************************************************************
* P3N - 12/07/98 DETERMINE IF THERE ARE ANY ITEMS *
* TO BE INVOICED ( IE: NOT SHIPPED. ) *
*************************************************************
FUNCTION ORDER_SHIPPED(INV_ARR, MORDER_NUM, WHCHORDER)
LOCAL RETVAL := .F. , I := 0, WKORDQTY := 0, WKSHPDQTY := 0
LOCAL CNTR := 0, MISC_ARR := {}
FOR I := 1 TO LEN(INV_ARR)
WKORDQTY := INV_ARR[I,7] //** ORDER QTY
WKSHPDQTY := INV_ARR[I,11] //** SHIPPED QTY
IF WKORDQTY - WKSHPDQTY <= 0
ELSE
CNTR := CNTR + 1
ENDIF
NEXT
IF EMPTY(CNTR)
IF LEN(INV_ARR) = 1 .AND. EMPTY(INV_ARR[1,10]) // EMPTY INV ARR
ELSE
RETVAL := .T.
ENDIF
//** P3N - 1/5/99 CHECK FOR MISC ORDER LINES ITEMS
MISC_ARR := BLD_MISCORD('TORD_LINES', {}, {}, 0, ;
.F., .F., .F., WHCHORDER, , , .T. )
IF EMPTY(MISC_ARR[4]) //**P3N - 1/5/99 NO ORDMISC LINE ITEMS ON BACKORDER
RETVAL := .T.
//** P3N - 1/5/99 CHECK FOR MISC ORDER ITEMS / MISC & NOTX ITEMS (SCREEN 2115)
IF MISCSHIPPED(MORDER_NUM)
RETVAL := .T.
ELSE
RETVAL := .F.
ENDIF
ELSE
RETVAL := .F.
ENDIF
ELSE
RETVAL := .F.
ENDIF
RETURN RETVAL
*********************************************************************
* P3N - 12/09/98 DETERMINE IF THERE ARE ANY MISC ITEMS *
* TO BE INVOICED ( IE: NOT SHIPPED. ) *
*********************************************************************
FUNCTION MISCSHIPPED(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE)
LOCAL RETVAL := .F., SHPQTY := 0, TOTQTY := 0, CNTR := 0
LOCAL MISC_ARR := GETQTYMISC(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE)
FOR I := 1 TO LEN(MISC_ARR[1])
TOTQTY := MISC_ARR[1,I,1] //** SHIP QTY
SHPQTY := MISC_ARR[1,I,3] //** SHIP QTY
IF TOTQTY - SHPQTY <= 0
ELSE
CNTR := CNTR + 1
ENDIF
NEXT
IF EMPTY(CNTR)
RETVAL := .T.
ELSE
RETVAL := .F.
ENDIF
RETURN RETVAL
*********************************************************************
* GET THE TERMS CODE DESCRIPTION
*********************************************************************
FUNCTION GP_TERMS(TERMS_CODE)
LOCAL RET_VAL
TERMS->(DBSEEK (TERMS_CODE) )
RETURN TERMS->DESC
*********************************************************************
* GET THE SHIP VIA CODE DESCRIPTION
*********************************************************************
FUNCTION GP_SHIP(SHIP_CODE)
SHIPMETH->(DBSEEK (SHIP_CODE) )
RETURN SHIPMETH->DESC
*********************************************************************
* GET CUTTING SPECS FOR A PRODUCTION COPY
*********************************************************************
// STYPE$'FIGSNPEC'
FUNCTION GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, STYPE, SELFILE )
LOCAL I, RETARR := {}, CKVAR
FOR I := 1 TO LEN(CUT_SPEC_ARR)
CKVAR := ALLTRIM(CUT_SPEC_ARR[I,9])
IF STYPE$CKVAR
IF EMPTY( CUT_SPEC_ARR[I,8]) ; // 1st rule
.OR. CHK_RULE( CUT_SPEC_ARR[I,8], G_ARR , , SELFILE)
IF EMPTY( CUT_SPEC_ARR[I,16]) ; // 2nd rule
.OR. CHK_RULE( CUT_SPEC_ARR[I,16], G_ARR , , SELFILE)
AADD(RETARR, CUT_SPEC_ARR[I] )
ENDIF
ENDIF
ENDIF
NEXT
IF EMPTY(RETARR)
RETURN NIL
ELSE
RETURN ACLONE(RETARR)
ENDIF
*********************************************************************
* GET CUTTING SPECS FOR A MODEL
*********************************************************************
FUNCTION GET_CUT_SPEC( MPROD_CODE, SELFILE, ORD_QTY, XFACTOR, G_ARR )
LOCAL ELEM, SAVESEL := SELECT(), SPECWORK := {}, CURSPECARR := {}
LOCAL MATHARR, SEEKKEY, MATHWORK, NEWMATHARR := {}
LOCAL MATHRESULT := {}, I
STATIC CUTARR := {}
// SEE IF IT'S IN THE ARRAY OR BUILD IT
ELEM := ASCAN(CUTARR, {|X| X[1] == MPROD_CODE} )
IF ELEM > 0
CURSPECARR := CUTARR[ELEM,2]
ELSE
SELECT CUT_SPEC
SEEK MPROD_CODE
DO WHILE CUT_SPEC->PROD_CODE = MPROD_CODE .AND. !EOF()
SEEKKEY = MPROD_CODE + CUT_SPEC->ATT_CODE
SELECT MATHPACK
SEEK SEEKKEY
MATHWORK:={}
DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF()
IF MATHPACK->TYPE$'C'
AADD(MATHWORK, {FIELD1, OPERATOR, FIELD2} )
ENDIF
SKIP 1
ENDDO
ATTRIB_CUT->(DBSEEK(CUT_SPEC->ATT_CODE))
SPECWORK := { CUT_SPEC->ATT_CODE, ;
CUT_SPEC->SEQ_NUM, CUT_SPEC->QUANTITY, ; //2-3
ATTRIB_CUT->PRINT_DESC, CUT_SPEC->PROFILE , ; //4-5
MATHWORK, 0 , ; // 0 = RESULT OF MATH INITIALIZED //6-7
CUT_SPEC->RULE_PACK, CUT_SPEC->WHICH_COPY,; // 8-9
ATTRIB_CUT->DESC, CUT_SPEC->WID_OR_HT ,; // 10-11
CUT_SPEC->FRAC_DEC, 0, 0, CUT_SPEC->WH_DESC, ; // 12-15 (13 = SELFILE->QTY, 14=SELFILE->XFACTOR)
CUT_SPEC->RULE_PACK2 , CUT_SPEC->PRNT_ID } // 16-17
AADD( CURSPECARR, SPECWORK )
SELECT CUT_SPEC
SKIP 1
ENDDO
CURSPECARR := ASORT(CURSPECARR,,, {|X,Y| STR(X[2],3)+DESCEND(X[11]) < STR(Y[2],3)+DESCEND(Y[11]) }) // SORT BY SEQUENCE NUMBER
AADD( CUTARR, { MPROD_CODE, CURSPECARR } )
ENDIF
FOR I := 1 TO LEN(CURSPECARR)
IF SELFILE <> NIL
MATHRESULT := EVAL_MATH( CURSPECARR[I,6], G_ARR, '_CUT_SP', CURSPECARR[I,1], SELFILE, 'CUT' )
CURSPECARR[I,7] := MATHRESULT
CURSPECARR[I,13] := ORD_QTY
CURSPECARR[I,14] := XFACTOR
ENDIF
NEXT
SELECT (SAVESEL)
RETURN CURSPECARR

Reference in New Issue View Git Blame Copy Permalink