// 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 := ©TOFILE // IE USERFILE3 IS T0BCED03.DBF ETC. **IF SELECT(COPYTOFILE) > 0 ** CLOSE ©TOFILE 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 ©TO 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 ©TO ** 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 ©FROM 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 ©FROM 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