commit 7905c43278d1ccefaaeae03b75a1a37b3be896ea Author: Jason Soltys <17367223+jsoltys@users.noreply.github.com> Date: Tue Jul 14 00:41:31 2026 -0500 first commit diff --git a/AOMAST.NTX b/AOMAST.NTX new file mode 100644 index 0000000..98bed46 Binary files /dev/null and b/AOMAST.NTX differ diff --git a/AQMAST.NTX b/AQMAST.NTX new file mode 100644 index 0000000..1d091b8 Binary files /dev/null and b/AQMAST.NTX differ diff --git a/CGW0000.PRG b/CGW0000.PRG new file mode 100644 index 0000000..159ed4e --- /dev/null +++ b/CGW0000.PRG @@ -0,0 +1,372 @@ +# include 'inkey.ch' +// #INCLUDE 'FIVEWIN.CH' + + + +/* + + +DON'S NOTES FOR CONVERSION 1/20/20 +************************************ + +MAX TTH / TTW RULES ????? +DIDN'T SEE ANY REFERENCE TO SET THESE. + + + +//PRINTING? +//PAINT5 ABEND +LPT2 SET - TRY SETTING A PRINTER VIA WINDOWS PRINTERS +RUN THRU THE VARIOUS REPORTS. + + + +BIG WHITE SPACE IN THE REVIEW / SELECT QUOTES FOR CONVERSION TO ORDERS. + + +ACCOUNTING RECAP ERRORS - FILES DON'T COPY PROPERLY + + +BROWSE REPORTS SHOULD CALL NOTEPAD LIKE THE OTHER PRINT - REPORT TO FILE +COPY REPORT TO DIFFERENT FILE ERRORS ON DONWAITRUN + + +*/ + + +FUNCTION CGW0000(INITRUN, DBDRIVER) +LOCAL TITLEMSG, EXITPROC, USEPASS, BLD_MENU +LOCAL NILVAR + + +PRIVATE _THISUSER_TEMP // 6/3/2020 FOR PRINTING +PRIVATE OE_TYPE := ' ' //** P3N - 09/20/06 +PRIVATE ACTION +PRIVATE SYSCODE := 'CGW' +PRIVATE FRACTION_ARR := {} +PRIVATE __DEVELYR := 1993 +PRIVATE __VAL_ALL_REC := .T. +PRIVATE __VAL_ALL_RECS := .T. +PRIVATE CURVER := '3.50' +PRIVATE PRODTIME := 0 //** P3N - 01/16/02 +IF DBDRIVER = 'CDX' + CURVER := '3.50' +ELSE + // CURVER := '4.10' // 1-20-20 + CURVER := '3.40' +ENDIF + + +// PRINTER STUFF +PRIVATE _REPORT +PRIVATE _PRODUCTION +PRIVATE _ORDERDESK +PRIVATE _INVOICE +PRIVATE _QUOTE +PRIVATE _PREBILL +PRIVATE _DELIVERY +PRIVATE _GOLDEN +PRIVATE _LBLPRN +PRIVATE _ICPRN +PRIVATE _BOPRN //** P3N - 4/30/98 + +PRIVATE _RPTPORT +PRIVATE _PORT_PROD +PRIVATE _PORT_ORDER +PRIVATE _PORT_INVOICE +PRIVATE _PORT_QUOTE +PRIVATE _PORT_PREBILL +PRIVATE _PORT_DELIVERY +PRIVATE _PORT_GOLDEN +PRIVATE _PORT_LABEL +PRIVATE _PORT_IC +PRIVATE _PORT_BO //** P3N - 4/30/98 + +PRIVATE _GRAPHAPP := .F. +PRIVATE _MSHOWPARM +PRIVATE _OC_CAPABLE := .F. + +// COMPILER RESOLVE 1-20-20 +NILVAR := IIF( 1 = 2, .T., .F. ) + +#IFDEF CGWB + IF INITRUN = 'ADDREC' + ACTION = INITRUN + ENDIF + TITLEMSG := " GREAT PLAINS Customer Interface " + EXITPROC := 'CGWB0100()' + USEPASS := .F. + BLD_MENU := .F. +#ELSE + TITLEMSG := "Order Entry System (32-BIT) - " + EXITPROC := 'CGW0100()' + USEPASS := .T. + BLD_MENU := .T. +#ENDIF + + +IF DBDRIVER = NIL + DBDRIVER = 'NTX' +ENDIF + + +// msginfo( 'got to start' ) + + + +START(INITRUN, CURVER, SYSCODE, TITLEMSG, EXITPROC, USEPASS, BLD_MENU, , DBDRIVER) + +RETURN //** P3N - 4/21/00 + + +************************************************************************ + +// 1-20-20 +FUNCTION CALL_OLAY(OPTION, TITLE, PROG, NUM_MEM, PATHNAME, ENVIR_VARS) + +RETURN DONWAITRUN( PROG ) + +*********************************************************************** + +******************************************************** +* CALL A PROGRAM! * +******************************************************** + + +// 1-20-20 +FUNCTION DONWAITRUN( PROG, SWITCH , ODLG, MSGARR) // PASS A WAIT DIALOG ? + + +#INCLUDE 'FIVEWIN.CH' + + +LOCAL RETVAL, RETCODE, WORKPROG, PROGCMD, PROGPARM, POS +LOCAL EVALBLOCK // 2/26/15 DON + +************************************************************* +* DETERMINE THE VALIDITY OF THE PROGRAM TO BE CALLED! * +************************************************************* +// Perry - 2-11-98 +PROG := ALLTRIM( PROG ) +WORKPROG := ALLTRIM( UPPER(PROG) ) + + +IF ISCODEBLOCK( WORKPROG ) + EVALBLOCK := &( WORKPROG ) + RETVAL := EVAL( EVALBLOCK ) + +// IF AT('.BAT', WORKPROG ) > 0 .OR. ; + +ELSEIF .T. .OR. ; + AT('.BAT', WORKPROG ) > 0 .OR. ; + AT('.EXE', WORKPROG ) > 0 .OR. ; + AT('.COM', WORKPROG ) > 0 .OR. ; + SUBS( PROG, 1, 4 ) = 'DEL ' .OR. ; + SUBS( PROG, 1, 4 ) = 'REN ' .OR. ; + SUBS( PROG, 1, 6 ) = 'XCOPY ' .OR. ; + SUBS( PROG, 1, 5 ) = 'COPY ' + + //EXECUTABLE FILE TYPE FOUND - OK + + IF !EMPTY( ODLG ) .AND. !EMPTY(MSGARR) + WAIT_REFRESH( ODLG, MSGARR ) + ENDIF + + //IF EMPTY(SWITCH) + // SWITCH := SW_MINIMIZE + //ENDIF + + // RETCODE := WINEXEC( PROG ) + RETCODE := WAITRUN( PROG ) + + // RETCODE := WAITRUN ( PROG ) + // ** IF RETCODE > 0 .AND. RETCODE < 32 // changed to >1 8-31-007 + // call to our exe returns 1 + IF RETCODE > 1 .AND. RETCODE < 32 + MSGALERT( 'Return Code From External DonWaitRun ' +CR_LF(2)+; + 'The External command is - "' + PROG +'"', ; + 'Execution Return Code - "' + alltrim( STR( RETCODE , 10 ) )+'"' ) + RETVAL := .F. + ELSE + RETVAL := .T. + ENDIF + + // IF >= 32, THIS IS THE INSTANCE(?) HANDLE RETURNED FROM WINAPI + // OTHERWISE SOME ERROR MESSAGE - SEE WINEXEC() DOCUMENTATION + // IN FIVEWIN / TURBO C++ HELP ON WINDOWS API. +ELSE + + // ERRORDIALOG( , .T., ,'INVALID COMMAND During WINRUN!' ) //** force error log to be written + MSGSTOP( 'Bad COMMAND - '+ALLTRIM(PROG)+' Invalid file extention!' + CR_LF() ; + + 'MUST have an extention of - ".BAT", ".EXE", OR ".COM", ' + CR_LF() ; + + 'OR You May Invoke the "COPY", "REN" or "DEL" Commands.' + CR_LF() ; + , 'INVALID COMMAND During WINRUN!' ) + RETVAL := .F. + +ENDIF + +SYSREFRESH() + +RETURN RETVAL + + +****************************************************** + + +//FUNCTION GET_FILEPARM(MALIAS) +//RETURN GET_FILEPA(MALIAS) + +************************************************************ + +******************************************************** + +FUNCTION WAIT_REFRESH( ODLG, MSGARR ) +LOCAL I + +PAINTDLG( ODLG, MSGARR ) + +RETURN .T. + +*************************************************************** + + +// DETERMINES IS A STRING IS IN CODE BLOCK FORMAT +FUNCTION ISCODEBLOCK( PASSVAR ) +LOCAL RETVAL := .F. + +PASSVAR := ALLTRIM( PASSVAR ) +IF LEFT( PASSVAR,1 ) = '{' + IF RIGHT( PASSVAR,1 ) = '}' + IF AT( '|', PASSVAR ) > 0 ; + .OR. AT( '\\', PASSVAR ) > 0 // DON 10-01-10 + RETVAL := .T. + ENDIF + ENDIF +ENDIF +RETURN RETVAL + + +************************************************************** + + +//** P3N - 4/21/00 +//** ADDED THE FOLLOWING REFERENCES TO GET RID OF ANY +//** BLINKER UNRESOLVED MESSAGES - FROM DOSWIN.PRG +FUNCTION WNETGETUSE() //** P3N - 4/21/00 +RETURN //** P3N - 4/21/00 + +FUNCTION GETMODULEF() //** P3N - 4/21/00 +RETURN //** P3N - 4/21/00 + +FUNCTION GETINSTANC() //** P3N - 4/21/00 +RETURN //** P3N - 4/21/00 + +FUNCTION GETPVPROFS() //** P3N - 4/21/00 +RETURN //** P3N - 4/21/00 + +************************************************************************ + +**************************** + +function d_altd( SETCMD ) // don't have to code altd twice 11-11-007 don + + +IF !EMPTY( SETCMD ) + M->DEBUG_SWITCH := UPPER( SETCMD ) +ENDIF + + +// comment out for production +altd(1) +altd() + +return nil + +*********************************************************************** + +// moved to winutil next to d_altd() function 7/8/2019 + +//** comment out these 2 requests for Production Make/Link +//** p3n - 03/22/13 these requests are required harb v3.2 for debug console mode + +#ifdef __FWH13__ + + +// comment out to supress extra window for debug. +// activate if you WANT the console window for debug. + + + REQUEST HB_GT_WIN + REQUEST HB_GT_WIN_DEFAULT + + + // Harbour requirement for console debug mode comment out for Production Make/Link Windows + // But always required for console mode PROGRAM EXECUTION, LIKE CGW is. + procedure hb_gt_gui_default + return + +#ENDIF + + + +*************************************** +********************************************************************** +//** P3N - 03/14/14 +//** USE IN LIEU OF LL_MEMOWRIT() +********************************************************************** +FUNCTION LL_MEMOWRIT( MFILE, MDATA ) + +LOCAL SUCCESS := .T. +LOCAL RETVAL := 0 +LOCAL CREATECD + +MFILE := ALLTRIM( MFILE ) // 10-12-2020 +CREATECD := FCREATE( MFILE,0 ) //** NORMAL - READ/WRITE + +IF CREATECD < 0 + MSGSTOP('LL_MEMOWRIT() - FCreate() File Name - "'+MFILE+'"', ; + 'File CREATE Error - '+STR(CREATECD) ) + SUCCESS := .F. + + //DISP_STACK() // 3/12/19 + +ENDIF + +// d_altd() + +IF VALTYPE( MDATA )$'C' .AND. LEN( MDATA ) > 0 // 10-5-2020 - WHY WOULD MDATA <> 'C' ??? + // GOOD DATA TO WRITE +ELSE + SUCCESS := .F. + MSGSTOP( 'Bad Data to Write' + cr_lf() ; + + "MDATA's DATA TYPE was: " + VALTYPE( MDATA ) + CR_LF() ; + + "MDATA's LENGTH was: " + IF( VALTYPE( MDATA )$'C', STR( LEN( MDATA )) , '??' ) , ; + 'Can Not Write Data File' ) +ENDIF + +IF SUCCESS + RETVAL := FWRITE( CREATECD, MDATA ) // write REQUEST to TXT fil + IF RETVAL = LEN( MDATA ) + //** FWRITE SUCCESSFULL - CONTINUE + ELSE + MSGSTOP('FWrite() Error - "' + MFILE + '"' + CR_LF() ; + + 'Length of Message: ' + ALLTRIM( STR( LEN( MDATA ) ) ) , ; + 'File WRITE Error - '+STR(CREATECD) ) + SUCCESS := .F. + ENDIF + + IF SUCCESS + IF FCLOSE( CREATECD ) + //** FILE SUCCESSFULLY CLOSED - CONTINUE + ELSE + MSGSTOP('FClose() Error - "'+MFILE+'"', ; + 'File CLOSE Error - '+STR(CREATECD) ) + SUCCESS := .F. + ENDIF + ENDIF + +ENDIF + +RETURN SUCCESS + +********************************************************************** diff --git a/CGW0100.PRG b/CGW0100.PRG new file mode 100644 index 0000000..10ba062 --- /dev/null +++ b/CGW0100.PRG @@ -0,0 +1,1062 @@ + + + +#include 'fivewin.ch' + +PROCEDURE CGW0100(INIT) +****************************************************** +** MIKE LEWIS - MAIN MENU 09-10-93 - CGW0100 +****************************************************** +CLS +PRIVATE COLVAR := HNOR + ',N/W,,,' + LNOR + +************************** +// LOAD UP PRIVATE VARIABLES FROM THE CONTROL FILE TO MEMORY + + + +// ? m->abend + +// 3/18/2020 - CLEAN UP LLINK64.LOG FILES +IF FILE( 'CGW64.LOG' ) + FErase( 'CGW64.LOG' ) +ENDIF + +// 9/02/2020 - CLEAN UP LLINK64.LOG FILES +IF FILE( 'CS.LOG' ) + FErase( 'CS.LOG' ) +ENDIF + + + + + +DBOPEN('IMPCUST') +DBOPEN('CONTROL') +MLMAR := SPACE(LMAR) //* CONTROL FILE FIELDS FOR TOP MARGIN +MTMAR := TMAR //* USED IN CGWPRINT +MBODY_LEN := BODY_LEN +MHEAD_LEN := HEAD_LEN +MSING_SHEET := UPPER(SING_SHEET) + //* +//** OBSOLETE 01/22/07 +**MSLS_TAX_PCT := SLS_TX_PCT + //* +MHOME_LOC_CODE := LOC_CODE +MBASE_NUM = BASE_NUM +MMULL_SASH := MULL_SASH +MMULL_GLASS := MULL_GLASS +MPICKUPTAX := PICKUPTAX +MPICKUPDISC := PICKUPDISC +MPREPAYCODE := PREPAY_COD + //** P3N - 07/09/01 +IF AT('{',MPREPAYCODE ) > 0 .AND. AT('}',MPREPAYCODE ) > 0 + MPREPAYCODE := &MPREPAYCODE +ELSE + ERR_BOX(' "CONTROL" file PRE PAY CODE ARRAY is INVALID ', ; + ' go to the FILE menu - TABLES AND CODE Definitions ', ; + ' SYSTEM CONTROL file and fix the ARRAY!', ; + ' Order entry will NOT be correct until this is fixed!') +ENDIF +MDEL_SHIP := DEL_SHIP + //** P3N - 07/09/01 +IF AT('{',MDEL_SHIP ) > 0 .AND. AT('}',MDEL_SHIP ) > 0 + MDEL_SHIP := &MDEL_SHIP +ELSE + ERR_BOX(' "CONTROL" file DELIVER ARRAY is INVALID ', ; + ' go to the FILE menu - TABLES AND CODE Definitions ', ; + ' SYSTEM CONTROL file and fix the ARRAY!', ; + ' Order entry will NOT be correct until this is fixed!') +ENDIF +MPU_SHIP := PU_SHIP + //** P3N - 07/09/01 +IF AT('{',MPU_SHIP ) > 0 .AND. AT('}',MPU_SHIP ) > 0 + MPU_SHIP := &MPU_SHIP +ELSE + ERR_BOX(' "CONTROL" file PU ARRAY is INVALID ', ; + ' go to the FILE menu - TABLES AND CODE Definitions ', ; + ' SYSTEM CONTROL file and fix the ARRAY!', ; + ' Order entry will NOT be correct until this is fixed!') +ENDIF +MINST_SHIP := INST_SHIP + //** P3N - 07/09/01 +IF AT('{',MINST_SHIP ) > 0 .AND. AT('}',MINST_SHIP ) > 0 + MINST_SHIP := &MINST_SHIP +ELSE + ERR_BOX(' "CONTROL" file INSTALLER ARRAY is INVALID ', ; + ' go to the FILE menu - TABLES AND CODE Definitions ', ; + ' SYSTEM CONTROL file and fix the ARRAY!', ; + ' Order entry will NOT be correct until this is fixed!') +ENDIF +MGL521_AMT := GL521_AMT +MCOD_ARR := COD_CODE + //** P3N - 07/09/01 +IF AT('{',MCOD_ARR ) > 0 .AND. AT('}',MCOD_ARR ) > 0 + MCOD_ARR := &MCOD_ARR +ELSE + ERR_BOX(' "CONTROL" file COD code array is INVALID ', ; + ' go to the FILE menu - TABLES AND CODE Definitions ', ; + ' SYSTEM CONTROL file and fix the ARRAY!', ; + ' Order entry will NOT be correct until this is fixed!') +ENDIF + +FRACTION_ARR := MAKE_FRACTARR() + +SELECT CONTROL +USE + +************************** +// INVOKE THE MAIN MENU FROM HERE + +*** +*** THIS LOOP INVOKES THE MAIN MENU +*** +OPTION := 0 +CLS +DO WHILE .T. + CALLMENU(SYSCODE + '0000', OPTION) +ENDDO + + + +**************************************************** + +PROCEDURE BUILDMENUS(INIT, ARCHIVE) +LOCAL SYSTITLE, REVVAR, REVVARARR, TITLE1, TITLE2, TITLE3 +LOCAL EXTRA_UTIL := {} +LOCAL LSTART := 0 + +PRIVATE LONGITEM, TROW, BROW, LCOL, RCOL, MENUTYPE +PRIVATE ITEMARR, MENUPARM + +MENUARR := {} + +IF EMPTY(ARCHIVE) + ARCHIVE := .F. + BLDPRNTMENU(5,42) + BLDMASTMENU(ARCHIVE) + BLDIMPORTMENU(INIT, FUN1, FUN4, 0, 5) // MENUPOS = 0, LSTART = 5 +ELSE + ARCHIVE := .T. + BLDMASTMENU(ARCHIVE) + BLDARCHMENU() + RETURN //** EXIT BUILDMENUS PROCEDURE!!! +ENDIF + +// THE UTILITY MENU IS CALLED FROM BELOW + + +// IS THE USER PROPERLY SIGNED ON??? +IF EMPTY(USER) + // NO KICK THEM OUT!!!!!!! + ERR_BOX(' Invalid User - Sign ON to USE the System! ' ) + QUITPROC() +ENDIF + +// SEE IF ORDER CONTROL CAPABLE! + +DBOPEN('PASSWORD') +SEEK USER +IF O_CONTROL = 'X' .OR. INIT = '_FMAINT' + SETAVAR( 'SET', 'ACTION_CODE', 'ADD' ) + _OC_CAPABLE = .T. +ELSE + _OC_CAPABLE = .F. +ENDIF +USE + + +IF INIT = '_FMAINT' + M->_THISUSER_TEMP := ALLTRIM( INIT ) +ELSE + M->_THISUSER_TEMP := ALLTRIM( USER ) +ENDIF +// 6/3/2020 +M->_THISUSER_TEMP := GETENV( 'APPDATA' ) + '\LAAPC\' + M->_THISUSER_TEMP + '.TXT' + +MENU_POS := {} // HOLDS LCOL POSITION OF MAIN MENU OPTION NAMES +AADD(MENU_POS, 0) +AADD(MENU_POS, 10) +AADD(MENU_POS, 22) +AADD(MENU_POS, 34) +AADD(MENU_POS, 44) +AADD(MENU_POS, 54) + +OFFSET = 5 // AMOUNT TO STAGGER SUB MENUS +X = 0 // ARRAY POINTER + + +*********************************** +** FILE MENU +*********************************** + +IF FUN1 = 'X' //////////////// F I L E \\\\\\\\\\\\\\\\\\\ + + X++ + LSTART = MENU_POS[X] + + ITEMARR := {} + MENUID := 'FILE000' + MENUTYPE := 'V' + TROW := 2 + LCOL := LSTART + AADD(ITEMARR, {'OPEN', 'CGW1100', 'M', .T.}) + AADD(ITEMARR, {'---------------------', , 'M', .F.}) + AADD(ITEMARR, {'SYSTEM ADMINSTRATION', 'IMP1200', 'M', .T.}) + AADD(ITEMARR, {'---------------------', , 'M', .F.}) +**AADD(ITEMARR, {'PRINT / REVIEW Setup Data', 'PRNTDISP', 'M', .T.}) + AADD(ITEMARR, {'ARCHIVE Processing', 'ARCHMENU', 'M', .T.}) + AADD(ITEMARR, {'---------------------', , 'M', .F.}) + AADD(ITEMARR, {'EXIT (Alt-E) ', 'ALTEPROC', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CGW1100' + MENUTYPE := 'V' + TROW := 4 + LCOL := LSTART + OFFSET + AADD(ITEMARR, {'MODEL/PRODUCT Setup', 'CGW1111', 'M', .T.}) + AADD(ITEMARR, {'CATEGORY Setup', 'CGW1121', 'M', .T.}) + AADD(ITEMARR, {'ATTRIBUTE Definitions', 'CGW1140', 'M', .T.}) + AADD(ITEMARR, {'FRAME CUTTING Attributes', 'CGW1130', 'M', .T.}) + AADD(ITEMARR, {'CUSTOMER Maintenance', 'CGW1170', 'M', .T.}) + AADD(ITEMARR, {'RULE BASE (System Wide)', 'CGW1150', 'M', .T.}) + AADD(ITEMARR, {'TABLES and CODE Definitions', 'TABLECODE', 'M', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ///////////////// PRODUCTS \\\\\\\\\\\\\\\\\\\\\\\\\\\ + ITEMARR := {} + MENUID := 'CGW1111' + MENUTYPE := 'V' + TROW = 6 + LCOL := LSTART + (OFFSET*2) + TITLE1 = 'DEFINE Models' + TITLE2 := 'DEFAULT CHOICES for MODEL Attributes' + TITLE3 = 'DELETE Model from System' + TITLE4 = 'REVIEW Model Setup Definitions' + AADD(ITEMARR, {TITLE1, "CGWACD('PRODUCTS')" , 'P', .T.}) + AADD(ITEMARR, {TITLE3, "ACD_PAR_CHILD({'PRODUCT', 'PROD_ATTS', .T., 3, 'DEL' })", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {'BASE PRICES for Model', "CGWPRICE", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'STANDARD SIZE Definitions', "ACD_PAR_CHILD({'PRODUCT', 'STD_SIZES', .F., 6, 'ADD' })", 'P', ADD_CAPABLE}) +**AADD(ITEMARR, {'MISCELEANOUS PARTS Setup', "ACD_PAR_CHILD({NIL, 'MISC_ITEMS', .F., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'MISCELEANOUS PARTS Setup', "MISC_WHATWAY()" ,'P', ADD_CAPABLE}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ///////////////// CATEGORY \\\\\\\\\\\\\\\\\\\\\\\\\\\ + ITEMARR := {} + MENUID := 'CGW1121' + MENUTYPE := 'V' + TROW = 7 + LCOL := LSTART + (OFFSET*2) + TITLE1 = 'DEFINE Categories' + TITLE2 := 'PRICING EXTRAS for Category' + TITLE3 = 'DELETE Categories from System' + TITLE4 = 'REVIEW Category Setup Definitions' + AADD(ITEMARR, {TITLE1, "CGWACD('CATEGORY')" , 'P', .T.}) + AADD(ITEMARR, {TITLE3, "ADD_SING_REC({'CATEGORY', .T.,,,,,'DEL' })", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ACD_PAR_CHILD({'CATEGORY', 'PRI_EXTRAS', .F., 6, 'ADD' })", 'P', ADD_CAPABLE}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ///////////////// ATTRIBUTES \\\\\\\\\\\\\\\\\\\\\\ + ITEMARR := {} + MENUID := 'CGW1140' + MENUTYPE := 'V' + TROW = 8 + LCOL := LSTART + (OFFSET*2) + TITLE1 = 'ADD/CHANGE SYSTEM ATTRIBUTE Codes' + TITLE2 = 'DELETE Attributes from System' + TITLE3 = 'REVIEW Attribute Code Tables' + TITLE4 = 'RENAME Attributes' + AADD(ITEMARR, {TITLE1, "ACD_PAR_CHILD({'ATTRIBUTES','ATT_OPTS', .T., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ACD_PAR_CHILD({'ATTRIBUTES','ATT_OPTS', .T., 3, 'DEL' })", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE4, "REN_ATT()", 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CGW1130' + MENUTYPE := 'V' + TROW = 9 + LCOL := LSTART + (OFFSET*2) + TITLE1 = 'ADD/CHANGE SYSTEM CUTTING ATTRIBUTE Codes' + TITLE2 = 'DELETE Cutting Attributes from System' + TITLE3 = 'REVIEW Cutting Attribute Code Tables' + + + AADD(ITEMARR, {TITLE1, "ACD_PAR_CHILD({NIL, 'ATTRIB_CUT', .T. })", 'P', ADD_CAPABLE}) +**AADD(ITEMARR, {TITLE1, "ADD_SING_REC({'ATTRIB_CUT', .T. })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ADD_SING_REC({'ATTRIB_CUT', .T.})", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE3, "GBROWSE({'ATTRIB_CUT', {}, .F., })", 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ///////////////// CUSTOMER MASTER \\\\\\\\\\\\\\\\\\\ + ITEMARR := {} + MENUID := 'CGW1170' + MENUTYPE := 'V' + TROW := 10 + LCOL := LSTART + (OFFSET*2) + TITLE1 = 'ADD/CHANGE Customers' + TITLE2 = 'DELETE Customers ' + TITLE3 = 'REVIEW Customers ' + + AADD(ITEMARR, {TITLE1, "ADD_SING_REC({'CUST_MAST', .T.,,,,,'ADD',,.T.})", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {"SPECIAL CUSTOMER PRICING", "SPEC_PRICING(.T.)", 'P', .T.}) + AADD(ITEMARR, {TITLE2, "ADD_SING_REC({'CUST_MAST', .T.,,,,,'DEL',,.T.})", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE3, "GBROWSE({'CUST_MAST', {'CUST_PRICE'}, .F., })", 'P', .T.}) + AADD(ITEMARR, {'UPDATE/REVIEW GREAT PLAINS Files', "CALL_BTREV()", 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ///////////////// RULE BASE \\\\\\\\\\\\\\\\\\\\\\ + ITEMARR := {} + MENUID := 'CGW1150' + MENUTYPE := 'V' + TROW = 11 + LCOL := LSTART + (OFFSET*2) + TITLE1 = 'ADD/CHANGE System Rules' + TITLE2 = 'DELETE Rules from System' + TITLE3 = 'REVIEW Rules' + + AADD(ITEMARR, {TITLE1, "ACD_PAR_CHILD({'RULES', 'RULEPACK', .T., 6, 'ADD',,,,,,.T.,'USERFILEI' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ACD_PAR_CHILD({'RULES', 'RULEPACK', .T., 6, 'DEL',,,,,,.T.,'USERFILEI' })", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {"VERIFY RULES Report", 'PRNTDISP("RULE REPORT")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ITEMARR := {} + MENUID := 'TABLECODE' + MENUTYPE := 'V' + TROW := 12 + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {'TAX TABLE Maintenance', "TAXMENU", 'M', .T.}) + AADD(ITEMARR, {'MANUFACTURING LOCATIONS ', 'MGFMENU', 'M', .T.}) + AADD(ITEMARR, {'GLASS BOX Sizes', "ACD_PAR_CHILD({NIL, 'GLASS_BOX', .T., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'UOM Master List', "ACD_PAR_CHILD({NIL, 'UOMFILE', .T., 3, 'ADD' ,,,,,,.T.,'USERFILEX' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'COLOR Master List', "ACD_PAR_CHILD({NIL, 'COLOR_LIST', .T., 3, 'ADD',,,,,,.T.,'USERFILEX' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'REPAYMENT TERMS List', "ACD_PAR_CHILD({NIL, 'TERMS', .T., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'SALES MEN Master List', "ACD_PAR_CHILD({NIL, 'SALESMEN', .T., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'SHIPPING Methods', "ACD_PAR_CHILD({NIL, 'SHIPMETH', .T., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {'SYSTEM CONTROL File', "ADD_SING_REC({'CONTROL', .T., , , , ,'ADD', , ,.F. })", 'P', ADD_CAPABLE}) // DO_MANYGETS = .F. + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'TAXMENU' + MENUTYPE := 'V' + TROW = 14 + LCOL := LSTART + (OFFSET*3) + TITLE3 = 'TAX SCHEDULE Update' + TITLE4 = 'TAX DETAIL Update' + AADD(ITEMARR, {TITLE3, "ACD_PAR_CHILD({NIL, 'TAX_SCHED', .T., 3, 'ADD' })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE4, "ACD_PAR_CHILD({NIL, 'TAX_DETAIL', .F., 3, 'ADD',,,,.T.,,, })", 'P', ADD_CAPABLE}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ///////////////// MFG LOCATION \\\\\\\\\\\\\\\\\\\ + ITEMARR := {} + MENUID := 'MGFMENU' + MENUTYPE := 'V' + TROW := 15 + LCOL := LSTART + (OFFSET*3) + TITLE1 = 'ADD/CHANGE Manufacturing Locations' + TITLE2 = 'DELETE Manufacturing Locations from System' + TITLE3 = 'REVIEW Manufacturing Locations' + + AADD(ITEMARR, {TITLE1, "ADD_SING_REC({'MFG_LOC', .T. })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ADD_SING_REC({'MFG_LOC', .T.})", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE3, "GBROWSE({'MFG_LOC', {}, .F., })", 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ENDIF + +*********************************** +** ARCHIVE MENU +*********************************** + + +ITEMARR := {} +MENUID := 'ARCHMENU' +MENUTYPE := 'V' +TROW := 8 +LCOL := LSTART + OFFSET +AADD(ITEMARR, {'Select ARCHIVE', 'SET_ARCHIVE()', 'P', .T.}) +**IF _OC_CAPABLE +IF INIT = '_FMAINT' .OR. FUN6 = 'X' + AADD(ITEMARR, {'ARCHIVE Orders ', 'ORD_ARCHIVE()', 'P', .T.}) +ENDIF +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + +*********************************** +** PROCESS MENU +*********************************** + +IF FUN2 = 'X' + X++ + LSTART = MENU_POS[X] + + ITEMARR := {} + MENUID := 'PROCESS000' + MENUTYPE := 'V' + TROW := 2 + LCOL := LSTART + AADD(ITEMARR, {'ORDER ENTRY', 'OPEN2100("NEWOPEN", "CGW2100")', 'P', .T.}) + AADD(ITEMARR, {'PRINT ORDERS', 'OPEN2100("NEWOPEN", "CGW2200")', 'P', .T.}) + IF _OC_CAPABLE + AADD(ITEMARR, {'CONTROL', 'CONTROL000', 'M', .T. }) + IF INIT = '_FMAINT' .OR. FUN6 = 'X' + AADD(ITEMARR, {'POST To Accounting', "POST_ACCT", 'M', .T. }) + ENDIF + ENDIF + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ITEMARR := {} + MENUID := 'CONTROL000' + MENUTYPE := 'V' + TROW := 6 + LCOL := LSTART + OFFSET + AADD(ITEMARR, {'PRODUCTION CONTROL', "CNTRL_FUNC('PROD')", 'P', .T. }) + IF INIT = '_FMAINT' .OR. FUN6 = 'X' + AADD(ITEMARR, {'ORDER CONTROL', "CNTRL_FUNC('SHIP')", 'P', .T. }) + ENDIF + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +//** P3N - COMMENTED OUT 1/15/99 - I DO NOT THINK IT IS USED!!!! +//**ITEMARR := {} +//**MENUID := 'CONTROL030' //P3N - 5/12/98 - PRINT MENU BACKORDER +//**MENUTYPE := 'V' +//**TROW := 19 +//**LCOL := LSTART + (OFFSET*3) +//**AADD(ITEMARR, {'SHIP ENTIRE ORDER', "SHIP_TOTQTY('ORD_MAST',.F.)", 'P', .T. }) +//**AADD(ITEMARR, {'ORDER SHIPPING (LINE ITEMS)', "ACD_PAR_CHILD({ , 'OS_WORK', .F., 3, 'ADD NOAPPEND',,,,,'2135',.F.,'USERFILE2'})", 'P', .T. }) +//**AADD(ITEMARR, {'ORDER SHIPPING (LINE ITEMS)', "ACD_PAR_CHILD({ , 'ORD_SHIP', .F., 3, 'ADD NOAPPEND',,,,,'2135',.F.,'USERFILE2'})", 'P', .T. }) +//**ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +//** P3N - COMMENTED OUT 1/15/99 - I DO NOT THINK IT IS USED!!!! + + + ITEMARR := {} + MENUID := 'CGW2100' + MENUTYPE := 'V' + TROW := 4 + LCOL := LSTART + OFFSET + IF _OC_CAPABLE + AADD(ITEMARR, {'SALES ORDER Processing', 'OPEN2100("ORDER")', 'P', _OC_CAPABLE }) + ENDIF + AADD(ITEMARR, {'QUOTE Processing', 'OPEN2100("QUOTE")', 'P', .T.}) + IF _OC_CAPABLE + AADD(ITEMARR, {'CONVERT Quotes to Orders', 'OPEN2100("CONV_QUOTE")', 'P', ADD_CAPABLE}) + ENDIF + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CGW2110' + MENUTYPE := 'V' + TROW := 6 + LCOL := LSTART + (OFFSET*2) + TITLE1 := 'ADD Sales Orders' + TITLE2 := 'DELETE Sales Orders' + TITLE3 := 'CHANGE Sales Orders' + TITLE4 := 'REVIEW Sales Orders' + TITLE5 := 'REVIEW Customers ' +**SCRNUM := '2110' + AADD(ITEMARR, {TITLE1, "ACD_ORDERS({'ORD_MAST', 'ORD_LINES' , .T., 3, 'ADD',,,,,, .F. })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE3, "ACD_ORDERS({'ORD_MAST', 'ORD_LINES', .T., 3, 'ADD',,,,,, .F.,,'2110',,.T. })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ACD_ORDERS({'ORD_MAST', 'ORD_LINES', .T., 3, 'DEL',,,,,, .F. })", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE4, "ACD_ORDERS({'ORD_MAST', 'ORD_LINES', .T., 3, 'REV',,,,,, .F.,,'2110',,.T. })", 'P', .T.}) + AADD(ITEMARR, {TITLE5, "GBROWSE({'CUST_MAST', {'CUST_PRICE'}, .F., })", 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CGW2112' + MENUTYPE := 'V' + TROW := 7 + LCOL := LSTART + (OFFSET*2) + TITLE1 := 'ADD Quote' + TITLE2 := 'DELETE Quote' + TITLE3 := 'CHANGE Quote' + TITLE4 := 'REVIEW Quotes' +**SCRNUM := '2210' + AADD(ITEMARR, {TITLE1, "ACD_ORDERS({'QUOTE_MAST', 'QUOTE_LINE', .T., 3, 'ADD',,,,,, .F. })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE3, "ACD_ORDERS({'QUOTE_MAST', 'QUOTE_LINE', .T., 3, 'ADD',,,,,, .F.,,'2210',,.T. })", 'P', ADD_CAPABLE}) + AADD(ITEMARR, {TITLE2, "ACD_ORDERS({'QUOTE_MAST', 'QUOTE_LINE', .T., 3, 'DEL',,,,,, .F. })", 'P', DEL_CAPABLE}) + AADD(ITEMARR, {TITLE4, "ACD_ORDERS({'QUOTE_MAST', 'QUOTE_LINE', .T., 3, 'REV',,,,,, .F.,,'2210',,.T. })", 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CGW2200' + MENUTYPE := 'V' + TROW := 5 + LCOL := LSTART + (OFFSET*1) + AADD(ITEMARR, {'ORDER Print', 'CGW2210', 'M', .T.}) + AADD(ITEMARR, {'QUOTE Print', 'OPEN2100("PRT QUOTE")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CGW2210' + MENUTYPE := 'V' + TROW := 7 + LCOL := LSTART + (OFFSET * 2) + AADD(ITEMARR, {'SELECTED Orders', 'OPEN2100("PRT ORD", , "SEL")', 'P', .T.}) + AADD(ITEMARR, {'ALL UNPRINTED Orders', 'OPEN2100("PRT ORD", , "ALL")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ITEMARR := {} + MENUID := 'ORDERS020' + MENUTYPE := 'V' + TROW := 10 + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {'PRODUCTION Orders', 'PRODORDER', 'M', .T.}) + AADD(ITEMARR, {'DELIVERY Tickets', 'PRNT_ORDER("DEL")', 'P', .T.}) + AADD(ITEMARR, {'ORDER DESK SPINDLE Copy', 'PRNT_ORDER("OD")', 'P', .T.}) + AADD(ITEMARR, {'INTERCOMPANY Purchase Order', 'PRNT_ORDER("PO")', 'P', .T.}) + IF _OC_CAPABLE + IF INIT = '_FMAINT' .OR. FUN6 = 'X' + AADD(ITEMARR, {'CUSTOMER Invoice', 'PRNT_ORDER("INV")', 'P', .T.}) + ENDIF + ENDIF + AADD(ITEMARR, {'PRE-BILL Invoice', 'PRNT_ORDER("PREBILL")', 'P', .T.}) + AADD(ITEMARR, {'PRE-COST Copy', 'PRNT_ORDER("PRECOST")', 'P', .T.}) + AADD(ITEMARR, {'BACKORDER Copy', 'PRNT_ORDER("BACKORD")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'PRODORDER' + MENUTYPE := 'V' + TROW := 12 + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {'PRODUCTION Orders', 'PRNT_ORDER("PROD")', 'P', .T.}) + AADD(ITEMARR, {'GOLDEN ROD CONTROL Copies', 'PRNT_ORDER("GOLDEN")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'ORDERS022' + MENUTYPE := 'V' + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {'Print CUSTOMER QUOTE', 'PRNT_ORDER("INV")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'ORDERS024' + MENUTYPE := 'V' + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {'CUSTOMER Invoice', 'PRNT_ORDER("INV")', 'P', .T.}) + AADD(ITEMARR, {'BACKORDER Copy', 'PRNT_ORDER("BACKORD")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'POST_ACCT' + MENUTYPE := 'V' + TROW := 7 + LCOL := LSTART + OFFSET + AADD(ITEMARR, {'Pre-Post Control Report', 'PRNTDISP("BILLTRAN RECAP")', 'P', .T.}) + AADD(ITEMARR, {'POST INVOICES to Accounting', 'POST_BILLTRAN', 'P', .T.}) + AADD(ITEMARR, {'REVIEW Posted MAPIX Transaction Files', 'REV_BILLTRAN', 'P', .T.}) + AADD(ITEMARR, {'REVIEW Posted ABW Transaction Files', 'REV_ABWTRAN', 'P', .T.}) + AADD(ITEMARR, {'Manual ZAP of Unposted File', 'ZAP_BILLTRAN', 'P', .T.}) + + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ENDIF + +*********************************** +** REPORTS MENU +*********************************** + + +IF FUN3 = 'X' + X++ + LSTART = MENU_POS[X] + + ITEMARR := {} + MENUID := 'OUTPUT000' + MENUTYPE := 'V' + TROW := 2 + LCOL := LSTART + AADD(ITEMARR, {"REPORTS", 'REPORTS', 'M', .T.}) + AADD(ITEMARR, {"LABELS", 'LABELS', 'M', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +******* +// REPORTS OUTPUT OPTION + ITEMARR := {} + MENUID := 'REPORTS' + MENUTYPE := 'V' + TROW := 4 + LCOL := LSTART + OFFSET + AADD(ITEMARR, {"SALES History", 'PRNTDISP("SALEHIST RECAP")', 'P', .T.}) + AADD(ITEMARR, {"CUSTOMER Information", 'CUSTINFO', 'M', .T.}) + AADD(ITEMARR, {"ORDER Reports", 'PRNTDISP("ORDER MASTER")', 'P', .T.}) + AADD(ITEMARR, {"ORDER Fulfillment", 'PRNTDISP("ORDER FULFILLMENT")', 'P', .T.}) + AADD(ITEMARR, {"PRODUCTION Reports", 'PRNTDISP("MONTHLY PRODUCTION")', 'P', .T.}) + AADD(ITEMARR, {"PRICING Reports", 'PRICEMENU', 'M', .T.}) + AADD(ITEMARR, {"CUTTING Reports", 'CUTMENU', 'M', .T.}) + AADD(ITEMARR, {"SETUP REFERENCE Files", 'PRDIMENU', 'M', .T.}) + AADD(ITEMARR, {"VERIFY RULES Report", 'PRNTDISP("RULE REPORT")', 'P', .T.}) + // AADD(ITEMARR, {"Printer Setup", 'PRINTERSETUP()', 'P', .T. , .T. }) // 1-20-20 CALL AS_IS - NO ADDITIONAL MENU / RUN PARMS + //**AADD(ITEMARR, {"UNPOSTED BILLING Transactions", 'PRNTDISP("BILLTRAN RECAP")', 'P', .T.}) + + + + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CUSTINFO' + MENUTYPE := 'V' + TROW := 6 + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {"DELIVERY / SETUP", 'DELTERM', 'M', .T.}) + AADD(ITEMARR, {"SPECIAL PRICING", 'SPECPRICE', 'M', .T.}) + AADD(ITEMARR, {'CUSTOMER MASTER', 'PRNTDISP( [CUSTOMER MASTER] )', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'DELTERM' + MENUTYPE := 'V' + TROW := 8 + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {'DELIVERY Information', 'PRNTDISP("CUSTDEL")', 'P', .T.}) + AADD(ITEMARR, {'SETUP Information', 'PRNTDISP("CUSTSETUP")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'SPECPRICE' + MENUTYPE := 'V' + TROW := 9 + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {"Special Pricing LIST", 'PRNTDISP("SPEC PRICE")', 'P', .T.}) + AADD(ITEMARR, {"Special Pricing SETUP Report", 'PRNTDISP("PRICING REPORT-CUST")', 'P', .T.}) + AADD(ITEMARR, {"DISCOUNTS Report", 'PRNTDISP("DISCOUNTS")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'PRICEMENU' + MENUTYPE := 'V' + TROW := 9 + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {"MODEL Pricing Reports", 'PRNTDISP("PRICING REPORT-MODEL")', 'P', .T.}) + AADD(ITEMARR, {"BASE PRICE TABLE Report", 'PRICERPT', 'M', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'PRICERPT' + MENUTYPE := 'V' + TROW := 12 + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {'SPECIFIC Product', 'CGWPRINT("MODEL BASE PRICE")', 'P', .T.}) + AADD(ITEMARR, {'ALL PRODUCTS in a CATEGORY', 'CGWPRINT("CATEGORY BASE PRICE")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'CUTMENU' + MENUTYPE := 'V' + TROW := 10 + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {"MODEL PRODUCTION CUTTING Report", 'PRNTDISP("PRODUCT REPORT-MODEL")', 'P', .T.}) + AADD(ITEMARR, {"CUSTOMER PRODUCTION CUTTING Report", 'PRNTDISP("PRODUCT REPORT-CUST")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +******* +// LABEL OUTPUT OPTION + ITEMARR := {} + MENUID := 'LABELS' + MENUTYPE := 'V' + TROW := 5 + LCOL := LSTART + OFFSET + AADD(ITEMARR, {"CUSTOMER Mailing Labels", 'MAILLABEL', 'M', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'MAILLABEL' + MENUTYPE := 'V' + TROW := 7 + LCOL := LSTART + (OFFSET * 2) + AADD(ITEMARR, {"ONE Customer", 'LABEL_RUN("CUSTOMER-ONE")', 'P', .T.}) + AADD(ITEMARR, {"MANY Customers", 'LABEL_RUN("CUSTOMER-MANY")', 'P', .T.}) + AADD(ITEMARR, {"ONE Customer - Shipping Address", 'LABEL_RUN("CUSTOMER-ONE-SHIP")', 'P', .T.}) + AADD(ITEMARR, {"MANY Customers - Shipping Address", 'LABEL_RUN("CUSTOMER-MANY-SHIP")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + //// PRINT / REVIEW \\\\\\ + ITEMARR := {} + MENUID := 'PRDIMENU' + MENUTYPE := 'V' + TROW := 11 + LCOL := LSTART + (OFFSET*2) + AADD(ITEMARR, {'MODEL Definitions', 'PRNTMODL', 'M', .T.}) + AADD(ITEMARR, {'CATEGORY Definitions', 'PRNTCAT', 'M', .T.}) + AADD(ITEMARR, {'System Wide ATTRIBUTE Definitions', 'PRNTATT', 'M', .T.}) + AADD(ITEMARR, {'MANUFACTURING LOCATIONS', 'PRNTDISP( [MANUFACTURING LOCATIONS] )', 'P', .T.}) + AADD(ITEMARR, {'STANDARD SIZES', 'PRNTDISP("STD_SIZES")', 'P', .T.}) + AADD(ITEMARR, {'PRICING EXTRAS', 'PRNTDISP("PRICING EXTRAS")', 'P', .T.}) + AADD(ITEMARR, {'RULES', 'PRNTDISP("RULES")', 'P', .T.}) + AADD(ITEMARR, {'TAX Information', 'TAXDISP', 'M', .T.}) + + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'PRNTMODL' + MENUTYPE := 'V' + TROW++ + TROW++ + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {'DEFAULT CHOICES - Model Attributes', 'CGWPRINT("MODEL OPTIONS")', 'P', .T.}) + AADD(ITEMARR, {'ATTRIBUTES Assigned to Models', 'PRNTDISP("MODEL ATTRIBUTES")', 'P', .T.}) + AADD(ITEMARR, {'LIST of Models', 'PRNTDISP("MODEL")', 'P', .T.}) + AADD(ITEMARR, {'MISCELLEANOUS Items List', 'PRNTDISP("MISC ITEMS")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'PRNTCAT' + MENUTYPE := 'V' + TROW++ + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {'DEFAULT CHOICES - Category Attributes', 'CGWPRINT("CATEGORY OPTIONS")', 'P', .T.}) + AADD(ITEMARR, {'ATTRIBUTES Assigned to Categories', 'PRNTDISP("CATEGORY ATTRIBUTES")', 'P', .T.}) + AADD(ITEMARR, {'LIST of Categories', 'PRNTDISP("CATEGORY")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + ITEMARR := {} + MENUID := 'PRNTATT' + MENUTYPE := 'V' + TROW++ + LCOL := LSTART + (OFFSET*3) + AADD(ITEMARR, {'System Wide Attribute CHOICES', 'PRNTDISP("ATTRIBUTE OPTIONS")', 'P', .T.}) + AADD(ITEMARR, {'LIST of System Wide Attributes', 'PRNTDISP("ATTRIBUTES")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + ITEMARR := {} + MENUID := 'TAXDISP' + MENUTYPE := 'V' + TROW := 20 + LCOL := LSTART + (OFFSET*4) + AADD(ITEMARR, {'SUMMARY SCHEDULES', 'PRNTDISP("TAX SUMMARY SCHEDULES")', 'P', .T.}) + AADD(ITEMARR, {'DETAIL COMPONENTS', 'PRNTDISP("TAX DETAIL COMPONENTS")', 'P', .T.}) + ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + + + + + +* ITEMARR := {} +* MENUID := 'REPORTS' +* MENUTYPE := 'V' +* TROW := 4 +* LCOL := LSTART + OFFSET +* AADD(ITEMARR, {"PRICING Report", 'PRICEMENU', 'M', .T.}) +* AADD(ITEMARR, {"PRODUCTION CUTTING Report", 'CUTMENU', 'M', .T.}) +* AADD(ITEMARR, {"CUSTOMER Listings", 'CUSTLIST', 'M', .T.}) +* AADD(ITEMARR, {"MONTHLY PRODCTION Report", 'PRNTDISP("MONTHLY PRODUCTION")', 'P', .T.}) +* AADD(ITEMARR, {"ORDER MASTER Report", 'PRNTDISP("ORDER MASTER")', 'P', .T.}) +* ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +* +* ITEMARR := {} +* MENUID := 'PRICEMENU' +* MENUTYPE := 'V' +* TROW := 6 +* LCOL := LSTART + (OFFSET*2) +* AADD(ITEMARR, {"MODEL Pricing Reports", 'PRNTDISP("PRICING REPORT-MODEL")', 'P', .T.}) +* AADD(ITEMARR, {"BASE PRICE TABLE Report", 'PRICERPT', 'M', .T.}) +* AADD(ITEMARR, {"CUSTOMER Pricing Reports", 'CUSTPRICE', 'M', .T.}) +* ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +* +* ITEMARR := {} +* MENUID := 'CUSTPRICE' +* MENUTYPE := 'V' +* TROW := 10 +* LCOL := LSTART + (OFFSET*3) +* AADD(ITEMARR, {"DISCOUNTS Report", 'PRNTDISP("DISCOUNTS")', 'P', .T.}) +* AADD(ITEMARR, {"SPECIAL PRICING List", 'PRNTDISP("SPEC PRICE")', 'P', .T.}) +* AADD(ITEMARR, {"CUSTOMER Pricing SETUP Report", 'PRNTDISP("PRICING REPORT-CUST")', 'P', .T.}) +* ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +* +* ITEMARR := {} +* MENUID := 'CUTMENU' +* MENUTYPE := 'V' +* TROW := 7 +* LCOL := LSTART + (OFFSET*2) +* AADD(ITEMARR, {"MODEL PRODUCTION CUTTING Report", 'PRNTDISP("PRODUCT REPORT-MODEL")', 'P', .T.}) +* AADD(ITEMARR, {"CUSTOMER PRODUCTION CUTTING Report", 'PRNTDISP("PRODUCT REPORT-CUST")', 'P', .T.}) +* ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +* +* ITEMARR := {} +* MENUID := 'PRICERPT' +* MENUTYPE := 'V' +* TROW := 9 +* LCOL := LSTART + (OFFSET*3) +* AADD(ITEMARR, {'SPECIFIC Product', 'CGWPRINT("MODEL BASE PRICE")', 'P', .T.}) +* AADD(ITEMARR, {'ALL PRODUCTS in a Category', 'CGWPRINT("CATEGORY BASE PRICE")', 'P', .T.}) +* ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +* +* ITEMARR := {} +* MENUID := 'CUSTLIST' +* MENUTYPE := 'V' +* TROW := 10 +* LCOL := LSTART + (OFFSET*2) +* AADD(ITEMARR, {'DELIVERY Information', 'PRNTDISP("CUSTDEL")', 'P', .T.}) +* AADD(ITEMARR, {'CUSTOMER SALES TERMS/SETUP', 'PRNTDISP("CUSTSETUP")', 'P', .T.}) +* ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +ENDIF + + +*********************************** +** UTILITY MENU +*********************************** + +X++ +LSTART = MENU_POS[X] + +AADD(EXTRA_UTIL, {'SEND/RECEIVE Setup Data', 'SEND/RECV', 'M', .T.}) +** IF _OC_CAPABLE +IF INIT = '_FMAINT' .OR. FUN6 = 'X' + AADD(EXTRA_UTIL, {'RESTORE Order/Quote Archive files', 'UTIL_OQFILES("RESTORE",.F.)', 'P', .T.}) +ENDIF +**AADD(EXTRA_UTIL, {'POST INVOICE to History', 'POST_BILLTRAN', 'P', .T.}) +BLDUTILMENU(LSTART, OFFSET, EXTRA_UTIL ) + +ITEMARR := {} +MENUID := 'SEND/RECV' +MENUTYPE := 'V' +TROW := 9 +LCOL := LSTART + OFFSET +AADD(ITEMARR, {'SEND Setup Data', 'SENDOPT', 'M', .T.}) +AADD(ITEMARR, {'RECEIVE Setup Data', 'RECVOPT', 'M', .T.}) +AADD(ITEMARR, {'BROWSE Transfer Data', 'REVUOPT', 'M', .T.}) +AADD(ITEMARR, {'ZAP Transfer Data', 'ZAPOPT', 'M', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'REVUOPT' +MENUTYPE := 'V' +TROW := 13 +LCOL := LSTART + (OFFSET*2) +AADD(ITEMARR, {'ATTRIBUTE Transfer Review', 'SEND_RECV("ATT", "REVU")', 'P', .T.}) +AADD(ITEMARR, {'CUTTING ATTS Transfer Review', 'SEND_RECV("CUT", "REVU")', 'P', .T.}) +AADD(ITEMARR, {'CATEGORY Transfer Review', 'SEND_RECV("CAT", "REVU")', 'P', .T.}) +AADD(ITEMARR, {'MODEL Transfer Review', 'SEND_RECV("MODEL", "REVU")', 'P', .T.}) +AADD(ITEMARR, {'RULE Transfer Review', 'SEND_RECV("RULE", "REVU")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'SENDOPT' +MENUTYPE := 'V' +TROW := 11 +LCOL := LSTART + (OFFSET*2) +AADD(ITEMARR, {'ATTRIBUTE Send', 'SEND_RECV("ATT", "SEND")', 'P', .T.}) +AADD(ITEMARR, {'CUTTING ATTS Send', 'SEND_RECV("CUT", "SEND")', 'P', .T.}) +AADD(ITEMARR, {'CATEGORY Send', 'SEND_RECV("CAT", "SEND")', 'P', .T.}) +AADD(ITEMARR, {'MODEL Send', 'SEND_RECV("MODEL", "SEND")', 'P', .T.}) +AADD(ITEMARR, {'RULE Send', 'SEND_RECV("RULE", "SEND")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'ZAPOPT' +MENUTYPE := 'V' +TROW := 14 +LCOL := LSTART + (OFFSET*2) +AADD(ITEMARR, {'ATTRIBUTE Zap', 'SEND_RECV("ATT", "ZAP")', 'P', .T.}) +AADD(ITEMARR, {'CUTTING ATTS Zap', 'SEND_RECV("CUT", "ZAP")', 'P', .T.}) +AADD(ITEMARR, {'CATEGORY Zap', 'SEND_RECV("CAT", "ZAP")', 'P', .T.}) +AADD(ITEMARR, {'MODEL Zap', 'SEND_RECV("MODEL", "ZAP")', 'P', .T.}) +AADD(ITEMARR, {'RULE Zap', 'SEND_RECV("RULE", "ZAP")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'RECVOPT' +MENUTYPE := 'V' +TROW := 12 +LCOL := LSTART + (OFFSET*2) +AADD(ITEMARR, {'ATTRIBUTE Receive', 'SEND_RECV("ATT", "RECV")', 'P', .T.}) +AADD(ITEMARR, {'CUTTING ATTS Receive', 'SEND_RECV("CUT", "RECV")', 'P', .T.}) +AADD(ITEMARR, {'CATEGORY Receive', 'SEND_RECV("CAT", "RECV")', 'P', .T.}) +AADD(ITEMARR, {'MODEL Receive', 'SEND_RECV("MODEL", "RECV")', 'P', .T.}) +AADD(ITEMARR, {'RULE Receive', 'SEND_RECV("RULE","RECV")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + +RETURN + +****************************************************************** +****************************************************************** +****************************************************************** +PROCEDURE BLDMASTMENU(ARCHIVE) +LOCAL PD_MENU1 := ' File ' +LOCAL PD_MENU2 := ' Process ' +LOCAL AR_MENU2 := ' Process Archive' +LOCAL PD_MENU3 := ' Output ' +LOCAL PD_MENU4 := ' Utility' +LOCAL PD_MENU5 := ' Passwords ' + +ITEMARR := {} +IF EMPTY(ARCHIVE) + ARCHIVE := .F. + MENUID := 'CGW0000' +ELSE + ARCHIVE := .T. + MENUID := 'CGWARCH' +ENDIF +MENUTYPE := 'H' +TROW := 0 +LCOL := 0 + +IF ARCHIVE + AADD(ITEMARR, {AR_MENU2, ALLTRIM(UPPER(PD_MENU2))+'000', 'M', .T.}) +**AADD(ITEMARR, {PD_MENU3, ALLTRIM(UPPER(PD_MENU3))+'000', 'M', .T.}) +ELSE + IF FUN1 = 'X' + AADD(ITEMARR, {PD_MENU1, ALLTRIM(UPPER(PD_MENU1))+'000', 'M', .T.}) + ENDIF + IF FUN2 = 'X' + **AADD(ITEMARR, {PD_MENU2, ALLTRIM(UPPER(PD_MENU2))+'000', 'M', .T.}) + AADD(ITEMARR, {PD_MENU2, ALLTRIM(UPPER(PD_MENU2))+'000', 'M', .T.}) + ENDIF + IF FUN3 = 'X' + AADD(ITEMARR, {PD_MENU3, ALLTRIM(UPPER(PD_MENU3))+'000', 'M', .T.}) + ENDIF + AADD(ITEMARR, {PD_MENU4, ALLTRIM(UPPER(PD_MENU4))+'000', 'M', .T.}) + IF FUN5 = 'X' + AADD(ITEMARR, {PD_MENU5, ALLTRIM(UPPER(PD_MENU5))+'000', 'M', .T.}) + ENDIF +ENDIF +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) +RETURN +************************************************************* +* BUILD THE ARCHIVE MENU +************************************************************* +FUNCTION BLDARCHMENU() +LOCAL LSTART := 5 +LOCAL OFFSET := 5 +LOCAL TITLE1 := 'REVIEW Archived Orders' +LOCAL TITL1Q := 'REVIEW Archived Quotes' +LOCAL TITLE2 := 'PRINT Archived Orders' +LOCAL TITL2Q := 'PRINT Archived Quotes' + +ITEMARR := {} +MENUID := 'PROCESS000' +MENUTYPE := 'V' +TROW := 2 +LCOL := LSTART +AADD(ITEMARR, {'REVIEW ARCHIVE', 'OPEN2100("NEWOPEN", "CGW2100",,.T.)', 'P', .T.}) +AADD(ITEMARR, {'PRINT ARCHIVE', 'OPEN2100("NEWOPEN", "CGW2200",,.T.)', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'CGW2100' +MENUTYPE := 'V' +TROW := TROW+2 +LCOL := LSTART + (OFFSET*1) +AADD(ITEMARR, {'ORDER Processing', 'OPEN2100("ORDER",,,.T.)', 'P', .T.}) +AADD(ITEMARR, {'QUOTE Processing', 'OPEN2100("QUOTE",,,.T.)', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'CGW2110' +MENUTYPE := 'V' +TROW := TROW+2 +LCOL := LSTART + (OFFSET*2) +**SCRNUM := '2130' +AADD(ITEMARR, {TITLE1, "ACD_ORDERS({'ORD_MAST', 'ORD_LINES', .T., 3, 'REV',,,,,, .F.,,'2130',,.T. } )", 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +TROW := TROW+1 +ITEMARR := {} +MENUID := 'CGW2112' +MENUTYPE := 'V' +**SCRNUM := '2230' +AADD(ITEMARR, {TITL1Q, "ACD_ORDERS({'QUOTE_MAST', 'QUOTE_LINE', .T., 3, 'REV',,,,,, .F.,,'2230',,.T. })", 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'CGW2200' +MENUTYPE := 'V' +TROW := 5 +LCOL := LSTART + (OFFSET*1) +AADD(ITEMARR, {'PRINT ORDERS', 'OPEN2100("PRT ORD", "ORDERS020")', 'P', .T.}) +AADD(ITEMARR, {'QUOTE Print', 'OPEN2100("PRT QUOTE", "ORDERS022")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + + +ITEMARR := {} +MENUID := 'ORDERS020' +MENUTYPE := 'V' +TROW := TROW+1 +LCOL := LSTART + (OFFSET*2) +AADD(ITEMARR, {'PRODUCTION Orders', 'PRODORDER', 'M', .T.}) +AADD(ITEMARR, {'DELIVERY Tickets', 'PRNT_ORDER("DEL_ARCH")', 'P', .T.}) +AADD(ITEMARR, {'ORDER DESK SPINDLE Copy', 'PRNT_ORDER("OD_ARCH")', 'P', .T.}) +AADD(ITEMARR, {'INTERCOMPANY Purchase Order', 'PRNT_ORDER("PO_ARCH")', 'P', .T.}) +AADD(ITEMARR, {'CUSTOMER Invoice', 'PRNT_ORDER("INV_ARCH")', 'P', .T.}) +AADD(ITEMARR, {'PRE-BILL Invoice', 'PRNT_ORDER("PREBILL_ARCH")', 'P', .T.}) +AADD(ITEMARR, {'PRE-COST Copy', 'PRNT_ORDER("PRECOST_ARCH")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'PRODORDER' +MENUTYPE := 'V' +TROW := TROW+2 +LCOL := LSTART + (OFFSET*3) +AADD(ITEMARR, {'PRODUCTION Orders', 'PRNT_ORDER("PROD_ARCH")', 'P', .T.}) +AADD(ITEMARR, {'GOLDEN ROD CONTROL Copies', 'PRNT_ORDER("GOLDEN_ARCH")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +ITEMARR := {} +MENUID := 'ORDERS022' +MENUTYPE := 'V' +LCOL := LSTART + (OFFSET*2) +TROW := 6 +AADD(ITEMARR, {'Print CUSTOMER QUOTE', 'PRNT_ORDER("INV_ARCH")', 'P', .T.}) +ADDMENU(MENUARR, ITEMARR, TROW, LCOL) + +RETURN +**************************************************************** +**************************************************************** +**************************************************************** + +FUNCTION MAKE_FRACTARR() +LOCAL L, MTOP, MBOTT, LAST_TOP, LAST_BOTT, MDECIMAL +LOCAL FRACTION_ARR := {}, MFRACTION + + +SET DECIMALS TO 5 +FOR L = 1 TO MBASE_NUM - 1 + MTOP = L + MBOTT = MBASE_NUM + IF L > 1 + LAST_TOP = MTOP + LAST_BOTT = MBOTT + MDECIMAL = MTOP / MBOTT // TURN FRACTION INTO DECIMAL NUMBER + // FIND REDUCED FRACTION VALUE + DO WHILE .T. + + + MTOP = MDECIMAL * MBOTT + IF MTOP - INT(MDECIMAL*MBOTT) <> 0 + // CAN'T REDUCE ANY FARTHER, SO EXIT + MTOP = LAST_TOP + MBOTT = LAST_BOTT + EXIT + ENDIF + LAST_TOP = MTOP + LAST_BOTT = MBOTT + MBOTT = MBOTT / 2 // CUT DENIMINATOR IN HALF FOR NEXT REDUCTION TEST! + IF MBOTT-INT(MBOTT) <> 0 + // CAN'T REDUCE ANY FARTHER, SO EXIT + MTOP = LAST_TOP + MBOTT = LAST_BOTT + EXIT + ENDIF + ENDDO + ELSE + MDECIMAL = MTOP / MBOTT // TURN FRACTION INTO DECIMAL NUMBER + ENDIF + + MFRACTION = STR(MTOP,2) + '/' + LTRIM(STR(INT(MBOTT))) + AADD(FRACTION_ARR, {MFRACTION, MDECIMAL} ) +NEXT +SET DECIMALS TO 2 +RETURN FRACTION_ARR + \ No newline at end of file diff --git a/CGW0200.PRG b/CGW0200.PRG new file mode 100644 index 0000000..d821209 --- /dev/null +++ b/CGW0200.PRG @@ -0,0 +1,714 @@ +* MIKE LEWIS -BUILD ADD, CHANGE, DELETE ARRAY- CGW0200 4-08-93 +PROCEDURE BUILDACD(MALIAS, SCR_NUM) + +PRIVATE ACDARR := {} +PRIVATE SCRNUM +PRIVATE FILELIST := {} +PRIVATE PREPROC := {} +PRIVATE POSTPROC := '' +PRIVATE OFFSET := 0 +PRIVATE EDITPROC := '' +PRIVATE COMPLETEKEY := NIL +PRIVATE CONVERT_KEY := '' +PRIVATE RELATED_DBF := '' +PRIVATE DOPROC +PRIVATE XTRA_HEADING +PRIVATE XTRA_CARGO +PRIVATE ESC_PROC + +IF SELECT('IMPCUST') = 0 + IC_PARMS = DBOPEN('IMPCUST') +ENDIF + //**** ACDARR LAYOUT ****\\ + // 1 = FILE ALIAS + // 2 = SCREEN NUMBER + // 3 = ARRAY OF FILES THAT NEED TO BE OPEN + // 4 = PROC TO EXECUTE BEFORE THE SAYS AND GETS + // ie TO PAINT ADDITIONAL INFO ON SCREEN, etc..... + // 5 = PROC TO EXECUTE AFTER THE GETS + // ie TO UPDATE ANY NON RELATED VARIABLES ...... + // 6 = HORIZONTAL OFFSET FOR SCREEN GETS + // 7 = PROC TO EDIT THE GET FIELDS + // 8 = ARRAY OF PARTIAL KEYS WHICH MAKE RECORD UNIQUE. + // IF ARRAY IS EMPTY, THEN ONLY ONE COMPONENT OF THE KEY + // 9 = KEY CONVERSION PROC - IE PAD WITH LEADING ZEROS, ETC. + // 10 = LIST OF DBF'S THAT SHOULD BE CONSIDERED WHEN DELETING INFO + // 1 ARRAY FOR EACH DBF. ELEMENT 1 = DBF ALIAS NAME, ELEM 2 = INDEX SEEK ORDER + // 11 = OPTIONAL TOP HEADING FOR ACD_BROWSE + // 12 = OPTIONAL ACD CARGO FOR HOT KEYS USED IN ACD_BROWSE + +DO CASE + + // DATA DICTIONARY + CASE MALIAS = 'DATADICT' + SCRNUM = '0950' + ACDARR := LOAD_ACDARR(MALIAS) + + // CONTROL FILE + CASE MALIAS = 'CONTROL' + SCRNUM = '9990' + PREPROC = { { 'CURVER' , 'G'},{'OPN_MFG()', 'I' } } +******PREPROC = { { 'CURVER' , 'G'},{'SVPRNTDTS()', 'I'} } // GETKEY PREPROC TO STUFF CURVER +***** POSTPROC = {'CLOSE_MFG()'} + ACDARR := LOAD_ACDARR(MALIAS) + + // GL ALLOC FILE + CASE MALIAS = 'GL_ALLOC' + SCRNUM = '8880' + AADD(PREPROC,{'ADDL_KEY()', 'K'} ) // KEY PREPROC +******AADD(PREPROC,{'TOT_GLALLOC(MORDER_NUM)', 'P'} ) //PAINT PREPROC +******PREPROC = { { 'CURVER' , 'G'} } +******PREPROC = { { 'CURVER' , 'G'},{'SVPRNTDTS()', 'I'} } // GETKEY PREPROC TO STUFF CURVER +******POSTPROC = {'RESET_PRNTDTS()'} + ACDARR := LOAD_ACDARR(MALIAS) + + // PRODUCTS + CASE MALIAS = 'PRODUCT' + SCRNUM = '1110' + PREPROC = { {'SET_NOTES("PRODUCT->NOTES", "Product")','P'} } // SETS HOT KEY FOR NOTE UPDATE + AADD(PREPROC, {'NEW_ITEM("MODEL")', 'M'}) + AADD(PREPROC, {'PAINT_KEYS("PROD_CODE",,41)','P'} ) // PAINT KEY FIELD + AADD(PREPROC, {'CAT_PAINT()', 'P'}) + POSTPROC = {'RESET_NOTES()', 'CONT_PROC("Are the MODEL ATTRIBUTES",'; + + '"DIFFERENT from the STANDARD",'; + + '"CATEGORY ATTRIBUTES?")'} + AADD(POSTPROC, {'CHK_PRODDEL()','D'} ) //** P3N - 9/22/00 + RELATED_DBF := { {'PROD_ATTS',1}, {'PROD_OPTS',1} } + AADD(RELATED_DBF, {'STD_SIZES', 1} ) + AADD(RELATED_DBF, {'STD_SASH', 1} ) + AADD(RELATED_DBF, {'CUT_SPEC', 1} ) +//** AADD(RELATED_DBF, {'MATHPACK', 1} ) + + + ACDARR := LOAD_ACDARR(MALIAS) + + + // PRODUCT CATEGORY + CASE MALIAS = 'CATEGORY' + SCRNUM = '1120' + AADD(PREPROC, {'NEW_ITEM("CATEGORY")', 'M'}) + AADD(PREPROC, {'PAINT_KEYS("CAT_CODE",,41)','P'} ) // PAINT KEY FIELD + AADD(PREPROC, {'CATPAINT2()', 'P'}) //** P3N - 02/13/04 + RELATED_DBF := { {'CAT_ATTS',1}, {'CAT_OPTS',1}, {'MATHPACK',1}} + ACDARR := LOAD_ACDARR(MALIAS) + + // RULES + CASE MALIAS = 'RULES' + SCRNUM = '1150' + AADD(PREPROC, {'PAINT_KEYS("RULE_CODE",,41)','P'} ) // PAINT KEY FIELD + ACDARR := LOAD_ACDARR(MALIAS) + + // MANUFACTURING LOACTION + CASE MALIAS = 'MFG_LOC' + SCRNUM := '1160' + AADD(PREPROC, {'PAINT_KEYS("LOC_CODE",,41)','P'} ) // PAINT KEY FIELD + ACDARR := LOAD_ACDARR(MALIAS) + + // SHIPPING METHODS + CASE MALIAS = 'SHIPMETH' + SCRNUM := '1180' + ACDARR := LOAD_ACDARR(MALIAS) + + // SHIPPING TERMS CODES + CASE MALIAS = 'TERMS' + SCRNUM := '1190' + ACDARR := LOAD_ACDARR(MALIAS) + + // SALES MEN MASTER LIST + CASE MALIAS = 'SALESMEN' + SCRNUM := '1100' + ACDARR := LOAD_ACDARR(MALIAS) + + // CUTTING SPEC ATTRIBUTES + CASE MALIAS = 'ATTRIB_CUT' + SCRNUM := '1130' + RELATED_DBF := { {'CUT_SPEC',3},{'MATHPACK',2} } + AADD(PREPROC, {'PAINT_KEYS("ATT_CODE",,41)','P'} ) // PAINT KEY FIELD + ACDARR := LOAD_ACDARR(MALIAS) + + // RULE PACKS + CASE MALIAS = 'RULEPACK' + FILELIST := {'ATTRIBUTES', 'ATT_OPTS', 'CAT_OPTS', 'PROD_OPTS'} + SCRNUM = '11150' + + RELATED_DBF := { {'RULE_PACK',1} } + ACDARR := LOAD_ACDARR(MALIAS) + + + // ATTRIBUTES + CASE MALIAS = 'ATTRIBUTES' + SCRNUM = '1130' + + AADD(PREPROC, {'PAINT_KEYS("ATT_CODE",,41)','P'} ) // PAINT KEY FIELD + RELATED_DBF := { {'ATT_OPTS',1} } + ACDARR := LOAD_ACDARR(MALIAS) + + // ATTRIBUTES OPTIONS + CASE MALIAS = 'ATT_OPTS' + SCRNUM = '11350' + ACDARR := LOAD_ACDARR(MALIAS) + + // CATEGORY ATTRIBUTES + CASE MALIAS = 'CAT_ATTS' + SCRNUM = '112B0' + FILELIST = {"ATTRIBUTES"} // OPEN ATTRIBUTE FILE + // INITIAL PREPROC + PREPROC = { {"MAKE_MATH('5')", 'I'},{ 'COPYSTD()', 'M'} } // MODEL AFTER / KEY PROC + ACDARR := LOAD_ACDARR(MALIAS) + + // CATEGORY SIZE TABLES + CASE MALIAS = 'STD_SIZES' + SCRNUM = '1140' + ACDARR := LOAD_ACDARR(MALIAS) + + // CATEGORY PRICING EXTRAS + CASE MALIAS = 'PRI_EXTRAS' + SCRNUM = '1250' + FILELIST = {"CUST_MAST"} + RELATED_DBF := { {'CUST_ATTS',1}, {'CUST_OPTS',1} } + ACDARR := LOAD_ACDARR(MALIAS) + + // CATEGORY OPTIONS + CASE MALIAS = 'CAT_OPTS' + SCRNUM = '11210' + FILELIST = {"ATT_OPTS"} + AADD(FILELIST, 'RULES') + AADD(FILELIST, 'RULEPACK') + PREPROC = { {'CGW11PRE("CATEGORY", 2)', 'K'} , ; // KEY PREPROC + {'COPY_OPTS("ATT_OPTS", "CAT_OPTS")', 'M'} } // MODEL AFTER + + XTRA_HEADING := SETUP_XHEAD('CAT_OPTS') + + ACDARR := LOAD_ACDARR(MALIAS) + + // CUSTOMER MASTER + CASE MALIAS = 'CUST_MAST' + IF SCR_NUM = NIL .OR. SCR_NUM = '1170' + SCRNUM := '1170' + FILELIST := {'TAX_SCHED', 'TAX_DETAIL'} + RELATED_DBF := { {'CUST_PRICE',1}, {'CUST_BP',1} } + PREPROC := { {'ORD_PAINT(9,14,9,47, "LNOR")','P'} } // paint bill to/ship to + AADD(PREPROC, {'PAINT_KEYS("CUST_ID",,41)','P'} ) // PAINT KEY FIELD + POSTPROC = {'SPEC_PRICING()'} + XTRA_CARGO := CUST_HOTKEYS() +//** COMMENTED OUT - WHY HERE??????? //** P3N - 5/26/98 +//** ELSE //** P3N - 5/26/98 +//** SCRNUM := '3245' //** P3N - 5/26/98 + ENDIF + ACDARR := LOAD_ACDARR(MALIAS) + + // CUSTOMER PRICING DISCOUNT TABLE + CASE MALIAS = 'CUST_PRICE' + SCRNUM := '11710' + AADD(PREPROC,{'{CUST_MAST->CUST_ID}', 'K'} ) // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + CASE MALIAS = 'CUST_BP' + SCRNUM := '11720' + AADD(PREPROC,{'{CUST_MAST->CUST_ID}', 'K'} ) // KEY PREPROC + RELATED_DBF := { {'CUST_OPTS',1}, {'CUST_ATTS',1} } //** P3N - 3/12/99 + ACDARR := LOAD_ACDARR(MALIAS) + + // TAX TABLE SCHEDULE + CASE MALIAS = 'TAX_SCHED' + SCRNUM := 'TX10' + FILELIST := {'TAX_DETAIL'} + ACDARR := LOAD_ACDARR(MALIAS) + + // TAX TABLE detail gl acct numbers + CASE MALIAS = 'TAX_DETAIL' + IF SCR_NUM = NIL + SCRNUM := 'TX20' + ELSE + SCRNUM := SCR_NUM + ENDIF + ACDARR := LOAD_ACDARR(MALIAS) + + // PRODUCT ATTRIBUTES + CASE MALIAS = 'PROD_ATTS' + SCRNUM = '11110' + FILELIST = {"CAT_ATTS",'CATEGORY'} // OPEN ATTRIBUTE FILE + // INITIAL PREPROC + PREPROC = { {"MAKE_MATH('5')", 'I'}, ; + {'MODELAFTER("CAT_ATTS", "USERFILE2", "PROD_ATTS", "PRODUCT", 1 )', 'M'} } // MODEL AFTER + ACDARR := LOAD_ACDARR(MALIAS) + + // PRODUCT ATTRIBUTE OPTIONS + CASE MALIAS = 'PROD_OPTS' + SCRNUM = '11120' + FILELIST = {"ATT_OPTS","CAT_OPTS",'CATEGORY'} // OPEN category level files for model after + AADD(FILELIST, 'RULES') + AADD(FILELIST, 'RULEPACK') + PREPROC = { {'CGW11PRE("PRODUCT", 2)', 'K'} ,; // KEY PREPROC + {'COPY_OPTS("CAT_OPTS", "PROD_OPTS")', 'M'} , ; // MODEL AFTER + {'COPY_OPTS("ATT_OPTS", "PROD_OPTS")', 'M'} } // MODEL AFTER + + XTRA_HEADING := SETUP_XHEAD('PROD_OPTS') + + ACDARR := LOAD_ACDARR(MALIAS) + + // PASSWORDS + CASE MALIAS = 'PASSWORD' + SCRNUM = '6100' + PREPROC = { {'XXXPASSP()','P'} } // PAINTS INSTRUCTION BOX ON SCREEN + POSTPROC = 'XXXPASSS()' // UPDATE PASSWORD AND AUTHORIZATION VARIABLES + // IF THE CURRENT USER CHANGES HIS OPTIONS + OFFSET = -5 + + ACDARR := LOAD_ACDARR(MALIAS) + + // ORDER MASTER + CASE MALIAS = 'ORD_MAST' + CONVERT_KEY = 'KEY_CONV(C_MKEY)' +******IF SCR_NUM = NIL .OR. SCR_NUM = '2110' .OR. SCR_NUM = '2310' + IF SCR_NUM = NIL .OR. RIGHT( SCR_NUM, 1 )$'0' + IF SCR_NUM = NIL + // called from menu - nothing open + SCR_NUM = '2110' + PREPROC = { {'GET_ORD_NUM()','G'} } // GET ORDER NUMBER + ELSE + // screen num IS AVAILABLE - NOT SCREEN 2115 (SUMMARY) + IF SCR_NUM = '2130' + // ARCHIVE PROCESS +*********** PREPROC = { {'GET_ORD_NUM(,"MANUAL")','G'} } // GET ORDER NUMBER + ELSE + IF SCR_NUM = '2120' + // RECURSIVE ORDER PROCESSING FROM PRINT SCREEN + PREPROC = { { 'ORD_MAST->ORDER_NUM','G'} } // CHANGE ORDER + ENDIF + ENDIF + ENDIF + AADD(PREPROC, {'GET_THE_CUST( , "RESET")','I'}) // RESET STATIC VARIABLES + AADD(PREPROC, {'ZAP_FILE689()','I'}) // ZAP THE USERFILES + AADD(PREPROC, {'PAINT_KEYS("ORDER_NUM",,41)','P'} ) // PAINT KEY FIELD + AADD(PREPROC, {'ORD_PAINT(10,12,10,49, "LNOR" )','P'} ) // paint bill to/ship to + AADD(PREPROC, {'NOTES_MSG("O")','P'}) //Are notes present on order???? + POSTPROC = 'ORD_USER()' + ESC_PROC := 'RESET_CNTL()' + ELSEIF SCR_NUM = '2115' + PREPROC := { {'MISCP_PAINT()','P'} } // PAINT PREPROC + ENDIF + + SCRNUM := SCR_NUM + + RELATED_DBF := { {'ORD_LINES',1}, {'ORDER_OPTS',1},; + {'ORD_MISC',1}, {'ORD_SHIP',1} ,; + {'ADDL_LINES',1}, {'ADDL_OPTS',1},; + {'ALTSHIPADR',1} } + + XTRA_CARGO := ORD_HOTKEY("ORDERS", SCRNUM) + ACDARR := LOAD_ACDARR(MALIAS) + + + // ORDER LINES + CASE MALIAS = 'ORD_LINES' + // OPEN DBF'S + IF SCR_NUM = NIL + // extra files opened in cgwprpo0 + SCRNUM = '2110' + PREPROC = { {'SET_TCALC()', 'I'}, ; + {'SEEKFUNC("ORD_LINES", "ORD_MAST->ORDER_NUM")', 'I'},; // INITIALIZE PROC + {'MODELAFTER("ORDER_OPTS", "USERFILE8", "ORDER_OPTS", "ORD_MAST",{"ORDER_OPTS->ORDER_NUM","ORD_MAST->ORDER_NUM"} )', 'I'},; // INITIALIZE PROC + {'MODELAFTER("ADDL_OPTS", "USERFILE9", "ADDL_OPTS", "ORD_MAST",{"ADDL_OPTS->ORDER_NUM", "ORD_MAST->ORDER_NUM"} )', 'I'}, ; // INITIALIZE PROC + {'MODELAFTER("ADDL_LINES", "USERFILE6", "ADDL_LINES", "ORD_MAST",{"ADDL_LINES->ORDER_NUM","ORD_MAST->ORDER_NUM"} )', 'I'}} // INITIALIZE PROC + + POSTPROC = {'UPDATE_ORDS("USERFILE8")', ; // UPDATE ORDER OPTIONS FROM USERFILE8 + 'UPDATE_ORDS("USERFILE9")', ; // UPDATE ADDITIONAL OPTIONS FROM USERFILE9 + 'UPDATE_LINES("USERFILE6")', ; // UPDATE ADDITIONAL ORDER LINES FROM USERFILE6 + 'DO_ADDL_LINES()',; // UPDATE ADDITIONAL LINES + 'UPDATE_ORDS("FILE8FILE9")', ; // UPDATE ADDITIONAL ORDER OPTIONS FROM USERFILE8 + 'MISC_PRICING( )' ,; // UPDATE TAX/ETC + 'ORD_PRINT(NIL, "Print Order", "OE" )' } // PRINT ORDER (IN CGWPRINT) + ENDIF + + ACDARR := LOAD_ACDARR(MALIAS) + + // TEMP ORDER LINES + CASE MALIAS = 'TORD_LINES' + IF SCR_NUM = NIL .OR. SCR_NUM = '322' + SCRNUM = '3220' //** ORDER CONTROL SCREEN + XTRA_CARGO := TOL_HOTKEYS('SHIP') + XTRA_HEADING := {SPACE(55)+'F1-Delete ALL Shipping', ; + SPACE(23)+'Select Product(s) to Ship'+ ; + SPACE(7) +'F2-NOTES (BO / Common)', ; + SPACE(55)+'F3-Alt. Shipping Info.', ' ' } + POSTPROC := { {'DEL_ORD_SHIP(ORD_MAST->ORDER_NUM)', 'A' } } + ELSEIF SCR_NUM = '321' //** ORDER ENTRY - BROWSE SHIPPING INFO + SCRNUM = '3210' //** BROWSE ONLY SCREEN + XTRA_HEADING := {} //** P3N - 1/27/00 + XTRA_CARGO := TOL_HOTKEYS('OE') //** P3N - 1/27/00 + ELSEIF SCR_NUM = '323' + SCRNUM = '3230' //** PRODUCTION CONTROL SCREEN + XTRA_CARGO := TOL_HOTKEYS('PROD') + XTRA_HEADING := {' ', SPACE(23)+'Select Product(s) Completed' , ; + ' ', ' ' } +//*** POSTPROC := { {'DEL_ORD_SHIP(ORD_MAST->ORDER_NUM)', 'A' } } + ENDIF + + ACDARR := LOAD_ACDARR(MALIAS) + + // ORDER LINES PRODUCED - P3N - 5/13/98 + CASE MALIAS = 'ORD_PROD' + IF SCR_NUM = NIL .OR. SCR_NUM = '22350' + PREPROC := {} + AADD( PREPROC, { 'GET_CTL_KEY()' , 'K' } ) + AADD( PREPROC, { 'BLD_TMPOPT()' , 'I' } ) //** P3N - 1/15/02 + XTRA_HEADING := {' Enter Date to INDICATE COMPLETED' , ; + ' ZERO Qty to REMOVE Transaction', ' ' } + ELSEIF SCR_NUM = '22360' + AADD( PREPROC, { 'GET_CTL_KEY(1)' , 'K' } ) + ELSEIF SCR_NUM = '223' + SCRNUM := SCR_NUM + ENDIF + SCRNUM = '22350' + ACDARR := LOAD_ACDARR(MALIAS) + // ORDER LINES SHIPPED - P3N - 5/13/98 + CASE MALIAS = 'ORD_SHIP' + PREPROC := {} + IF SCR_NUM = NIL .OR. SCR_NUM = '21350' + AADD( PREPROC, { 'GET_CTL_KEY()' , 'K' } ) + AADD( PREPROC, { 'BLD_TMP_OST()' , 'I' } ) //** P3N - 1/15/99 + //UPDATE ORDER SHIPPING TRANSACTIONS + POSTPROC := { {'DEL_ORD_SHIP(TORD_LINES->ORDER_NUM)', 'A' } } + XTRA_HEADING := {' Enter Date to INDICATE SHIPPED', ; + ' ZERO Qty to REMOVE Transaction', ' ',{||DSPLBO_QTY()},' ' } + ELSEIF SCR_NUM = '21360' + AADD( PREPROC, { 'GET_CTL_KEY(1)' , 'K' } ) + ENDIF + SCRNUM = '21350' + ACDARR := LOAD_ACDARR(MALIAS) + // ADDITIONAL ORDER LINES + CASE MALIAS = 'ADDL_LINES' + // OPEN DBF'S + + SCRNUM = '21120' + PREPROC = { {'ADDL_KEY()', 'K'} } // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + //** P3N - 11/13/98 (FRIDAY THE 13TH-OMINUS) + // ALTERNATE SHIPPING ADDRESS INFO + CASE MALIAS = 'ALTSHIPADR' + SCRNUM := '3245' + AADD( PREPROC, { 'GET_ASA_KEY()' , 'K' } ) +******PREPROC := { {'??MODELAFTER("ORDER_OPTS", "USERFILE2", "ORDER_OPTS", "ORD_MAST")', 'I'} } // INITIALIZE PROC + ACDARR := LOAD_ACDARR(MALIAS) + + // ORDER OPTIONS + CASE MALIAS = 'ORDER_OPTS' + SCRNUM := '2120' + PREPROC := { {'??MODELAFTER("ORDER_OPTS", "USERFILE2", "ORDER_OPTS", "ORD_MAST")', 'I'} } // INITIALIZE PROC + ACDARR := LOAD_ACDARR(MALIAS) + + // ADDITIONAL ORDER OPTIONS + CASE MALIAS = 'ADDL_OPTS' + SCRNUM := '2122' + PREPROC := { {'??MODELAFTER("ORDER_OPTS", "USERFILE2", "ORDER_OPTS", "ORD_MAST")', 'I'} } // INITIALIZE PROC + POSTPROC = { 'STUFF_ENTER_KEY()' } // FORCE ENTER ON BLANK GET + ACDARR := LOAD_ACDARR(MALIAS) + + + // QUOTE MASTER + CASE MALIAS = 'QUOTE_MAST' + CONVERT_KEY = 'KEY_CONV(C_MKEY)' + + IF SCR_NUM = NIL .OR. RIGHT( SCR_NUM, 1 )$'0' + IF SCR_NUM = NIL + SCR_NUM := '2210' + PREPROC := { {'GET_ORD_NUM()','G'}, ; // GET ORDER NUMBER + {'GET_THE_CUST( , "RESET")','I'}, ; // RESET STATIC VARIABLES + {'ZAP_FILE689()','I'}, ; // ZAP THE USERFILES + {'ORD_PAINT(8,12,8,49, "LNOR" )','P'} } // paint bill to/ship to + AADD(PREPROC, {'NOTES_MSG("Q")','P'}) //Are notes present on quote???? + POSTPROC := 'ORD_USER()' + ESC_PROC := 'RESET_CNTL()' + ELSEIF SCR_NUM = '2220' + PREPROC := { { 'QUOTE_MAST->ORDER_NUM','G'}, ; // CHANGE ORDER + {'GET_THE_CUST( , "RESET")','I'}, ; // RESET STATIC VARIABLES + {'ZAP_FILE689()','I'}, ; // ZAP THE USERFILES + {'ORD_PAINT(8,12,8,49, "LNOR" )','P'} } // paint bill to/ship to + AADD(PREPROC, {'PAINT_KEYS("ORDER_NUM",,41)','P'} ) // PAINT KEY FIELD +//** AADD(PREPROC, {'PAINT_KEYS("QUOTE_NUM",,41)','P'} ) // PAINT KEY FIELD + AADD(PREPROC, {'NOTES_MSG("Q")','P'}) //Are notes present on quote???? + ELSEIF SCR_NUM = '2230' + PREPROC := { {'GET_THE_CUST( , "RESET")','I'}, ; // RESET STATIC VARIABLES + {'ZAP_FILE689()','I'}, ; // ZAP THE USERFILES + {'ORD_PAINT(8,12,8,49, "LNOR" )','P'} } // paint bill to/ship to + AADD(PREPROC, {'NOTES_MSG("Q")','P'}) //Are notes present on quote???? + ENDIF + ELSEIF SCR_NUM = '2115' + PREPROC := { {'MISCP_PAINT()','P'} } // PAINT PREPROC + ENDIF + + SCRNUM := SCR_NUM + + RELATED_DBF := { {'QUOTE_OPTS',1},; + {'QUOTE_ADDL',1}, {'ADDL_QOPT',1} } + + XTRA_CARGO := ORD_HOTKEY("QUOTE", SCRNUM) + ACDARR := LOAD_ACDARR(MALIAS) + + // QUOTE LINES + CASE MALIAS = 'QUOTE_LINE' + // OPEN DBF'S + IF SCR_NUM = NIL + // extra files opened in cgwprpo0 + SCRNUM = '2210' + PREPROC = { {'SET_TCALC()', 'I'}, ; + {'SEEKFUNC("QUOTE_LINE", "QUOTE_MAST->ORDER_NUM")', 'I'},; // INITIALIZE PROC + {'MODELAFTER("QUOTE_OPTS", "USERFILE8", "QUOTE_OPTS", "QUOTE_LINE",{"QUOTE_OPTS->ORDER_NUM","QUOTE_MAST->ORDER_NUM"} )', 'I'},; // INITIALIZE PROC + {'MODELAFTER("ADDL_QOPT", "USERFILE9", "ADDL_QOPT", "QUOTE_LINE", {"ADDL_QOPT->ORDER_NUM", "QUOTE_MAST->ORDER_NUM"} )', 'I'}, ; // INITIALIZE PROC + {'MODELAFTER("QUOTE_ADDL", "USERFILE6", "QUOTE_ADDL", "QUOTE_LINE",{"QUOTE_ADDL->ORDER_NUM","QUOTE_MAST->ORDER_NUM"} )', 'I'}} // INITIALIZE PROC + + POSTPROC = {'UPDATE_ORDS("USERFILE8")', ; // UPDATE ORDER OPTIONS FROM USERFILE8 + 'UPDATE_ORDS("USERFILE9")', ; // UPDATE ADDITIONAL OPTIONS FROM USERFILE9 + 'UPDATE_LINES("USERFILE6")', ; // UPDATE ADDITIONAL ORDER LINES FROM USERFILE6 + 'DO_ADDL_LINES()',; // UPDATE ADDITIONAL LINES + 'UPDATE_ORDS("FILE8FILE9")', ; // UPDATE ADDITIONAL ORDER OPTIONS FROM USERFILE8 + 'MISC_PRICING()',; // UPDATE TAX/ETC + 'ORD_PRINT(NIL, "Print Quote", "OE")' } // PRINT ORDER (IN CGWPRINT) + + + ELSEIF SCR_NUM = '2225' + SCRNUM := SCR_NUM + XTRA_HEADING := {'Enter Date to INDICATE COMPLETED PROCESS'} + XTRA_CARGO := { {'CTRL + T = Current Date', 20, 'GET_CURDATE()'} , ; + {'CTRL + Q = Total Qty', 17, 'GET_TOTQTY()'} } + ENDIF + + ACDARR := LOAD_ACDARR(MALIAS) + + // ADDITIONAL QUOTE LINES + CASE MALIAS = 'QUOTE_ADDL' + // OPEN DBF'S + + SCRNUM = '2220' + PREPROC = { {'ADDL_KEY()', 'K'} } // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + + // QUOTE OPTIONS + CASE MALIAS = 'QUOTE_OPTS' + SCRNUM := '2230' + PREPROC := { {'?MODELAFTER("QUOTE_OPTS", "USERFILE2", "QUOTE_OPTS", "QUOTE_MAST")', 'I'} } // INITIALIZE PROC + ACDARR := LOAD_ACDARR(MALIAS) + + // ADDITIONAL QUOTE OPTIONS + CASE MALIAS = 'ADDL_QOPT' + SCRNUM := '2232' + PREPROC := { {'?MODELAFTER("QUOTE_OPTS", "USERFILE2", "QUOTE_OPTS", "QUOTE_MAST")', 'I'} } // INITIALIZE PROC + POSTPROC = { 'STUFF_ENTER_KEY()' } // FORCE ENTER ON BLANK GET + ACDARR := LOAD_ACDARR(MALIAS) + + + // CUST ATTRIBUTES + CASE MALIAS = 'CUST_ATTS' + + SCRNUM = '3110' + FILELIST = {"CAT_ATTS",'CATEGORY'} // OPEN ATTRIBUTE FILE + + // INITIAL PREPROC + PREPROC = { {"MAKE_MATH('5')", 'I'} } + AADD(PREPROC, {'{USERFILE2->CUST_ID, USERFILE2->PROD_CODE}', 'K'} ) // KEY FOR CUST_ID + AADD(PREPROC, {'BLD_CUSTATTS("USERFILE2", "USERFILE3")', 'M'} ) // MODEL AFTER + ACDARR := LOAD_ACDARR(MALIAS) + + + // CUST ATTRIBUTE OPTIONS + CASE MALIAS = 'CUST_OPTS' + SCRNUM = '3120' + FILELIST = {"ATT_OPTS","CAT_OPTS",'CATEGORY'} // OPEN category level files for model after + PREPROC = { {'CGW11PRE("CUST")', 'K'} ,; // KEY PREPROC + {'COPY_OPTS("PROD_OPTS", "CUST_OPTS")', 'M'} , ; // MODEL AFTER + {'COPY_OPTS("CAT_OPTS", "CUST_OPTS")', 'M'} , ; // MODEL AFTER + {'COPY_OPTS("ATT_OPTS", "CUST_OPTS")', 'M'} } // MODEL AFTER + + XTRA_HEADING := SETUP_XHEAD('CUST_OPTS') + + ACDARR := LOAD_ACDARR(MALIAS) + + // CUSTOMER PRICING EXTRAS + CASE MALIAS = 'CUST_PE' + SCRNUM = '3130' + PREPROC = { {'CUST_PE_KEY() ', 'K'} } // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + // PRODUCT STD SASH MEASUREMENTS + CASE MALIAS = 'STD_SASH' + SCRNUM = '3140' + PREPROC = { {'{PRODUCT->PROD_CODE}', 'K'} } // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + // CLEAR SS GLASS BOX STORAGE + CASE MALIAS = 'GLASS_BOX' + SCRNUM = '3150' + ACDARR := LOAD_ACDARR(MALIAS) + + // CUTTING SPECS + CASE MALIAS = 'CUT_SPEC' + SCRNUM = '3160' + AADD(FILELIST, 'MATHPACK') + AADD(FILELIST, 'ATTRIB_CUT') + AADD(FILELIST, 'ATTRIBUTES') + AADD(PREPROC, {'{PRODUCT->PROD_CODE}', 'K'} ) // KEY PREPROC + AADD(PREPROC, {"MAKE_MATH('5')", 'I'} ) // MODEL AFTER / KEY PROC + AADD(PREPROC, {'NEW_ITEM("CUTTING SPEC","USERFILET")', 'M'}) // COPY A DIFFERENT ONE + ACDARR := LOAD_ACDARR(MALIAS) + + // INTER COMPANY PURCHASE ORDERS + CASE MALIAS = 'IPO_FILE' + SCRNUM = '2160' + ACDARR := LOAD_ACDARR(MALIAS) + + // MISC ITEMS MASTER FILE + CASE MALIAS = 'MISC_ITEMS' + AADD(FILELIST, 'CATEGORY') + AADD(FILELIST, 'COLOR_LIST') + AADD(FILELIST, 'UOMFILE') + AADD(PREPROC, {'PAINT_KEYS("PARTNUM",,41)','P'} ) // PAINT KEY FIELD + SCRNUM = '2170' + ACDARR := LOAD_ACDARR(MALIAS) + + // MISC ITEMS MASTER FILE PRICING/UNIT OF MEASURE + CASE MALIAS = 'MISC_PUOM' + SCRNUM = '2180' +** PREPROC = { {"MAKE_MATH('5')", 'I'} } + AADD(PREPROC,{'{MISC_ITEMS->PARTNUM}', 'K'} ) // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + // MISC ITEMS MASTER FILE COLORS + CASE MALIAS = 'MISC_COLOR' + SCRNUM = '2190' + AADD(PREPROC,{'{MISC_ITEMS->PARTNUM}', 'K'} ) // KEY PREPROC + ACDARR := LOAD_ACDARR(MALIAS) + + // MASTER UOM FILE + CASE MALIAS = 'UOMFILE' +//** SCRNUM = '3210' //** P3N - 1/26/00 + SCRNUM = '4210' //** P3N - 1/26/00 + PREPROC = { {"MAKE_MATH('5')", 'I'} } + AADD(FILELIST, 'MISC_ITEMS') + ACDARR := LOAD_ACDARR(MALIAS) + + // MASTER COLOR FILE + CASE MALIAS = 'COLOR_LIST' +//** SCRNUM = '3220' //** P3N - 5/26/98 + SCRNUM = '4220' //** P3N - 5/26/98 + ACDARR := LOAD_ACDARR(MALIAS) + + // ORDER MISC ITEMS + CASE MALIAS = 'ORD_MISC' +//** SCRNUM = '3230' //** P3N - 5/26/98 + SCRNUM = '4230' //** P3N - 5/26/98 + AADD(PREPROC,{'{ ORD_MAST->ORDER_NUM }', 'K'} ) // KEY PREPROC +//** P3N - 11/25/98 - MOVED TO MISC_ITEM()-CGWPRPO0.PRG +//** POSTPROC = { {'UP_MISCTOT(USERFILE2->ORDER_NUM)', 'B' } } + ACDARR := LOAD_ACDARR(MALIAS) + + // QUOTE MISC ITEMS + CASE MALIAS = 'QUOTE_MISC' + SCRNUM = '2270' + AADD(PREPROC,{'{QUOTE_MAST->ORDER_NUM }', 'K'} ) // KEY PREPROC +//** P3N - 11/25/98 - MOVED TO MISC_ITEM()-CGWPRPO0.PRG +//** POSTPROC = { {'UP_MISCTOT(USERFILE2->ORDER_NUM)', 'B' } } + ACDARR := LOAD_ACDARR(MALIAS) + +ENDCASE + +RETURN ACDARR + + + +CLOSE DATABASES +RETURN ACDARR + +********************************************************************* +* RETURN AN ARRAY USED AS THE HEADING FOR A DBROWSE! * +* //** P3N - 2/19/98 * +********************************************************************* +FUNCTION SETUP_XHEAD(TYPE) +LOCAL RETARR +RETARR := ; + { {||FRST_XHEAD()}, '(BLANK Value to DELETE)', ; + 'PI*-Print Ind / Alt Print-Alternate Print Value', ; + 'HT ADJ-Prod Height Adj / WD ADJ-Prod Width Adj', ; + {||WHEREMSG("SET")}, {||WHEREMSG()}, {|| WHEREMSG("RESET")} } +RETURN RETARR +FUNCTION FRST_XHEAD() +RETURN 'Add Options for "'+ ALLTRIM(ATT_CODE) +'" Attribute' +********************************************************************* +********************************************************************* +********************************************************************* +FUNCTION OPN_MFG() +LOCAL SVSEL := SELECT() +DBOPEN('MFG_LOC') +SELECT(SVSEL) +RETURN +**FUNCTION CLOSE_MFG() +**LOCAL SVSEL := SELECT() +**SELECT('MFG_LOC') +**USE +**SELECT(SVSEL) +**RETURN +********************************************************************* +********************************************************************* +********************************************************************* +FUNCTION COPYCUT() +LOCAL SAVESEL := SELECT(), SAVEFILT +LOCAL COPYFROM := ALLTRIM( ATTRIB_CUT ) + +SELECT ATTRIB_CUT +USE +SELECT USERFILE3 + +// APPEND ALL FROM &ATTRIB_CUT +APPEND ALL FROM ©FROM +DBOPEN('ATTRIB_CUT') +SELECT (SAVESEL) + +RETURN .T. + +********************************************************************* +********************************************************************* +********************************************************************* +FUNCTION COPYSTD() +LOCAL SAVESEL := SELECT(), SAVEFILT +LOCAL COPYFROM := ALLTRIM( ATTRIBUTES ) + +SELECT ATTRIBUTES +USE +SELECT USERFILE2 +// APPEND ALL FROM &ATTRIBUTES FOR ATT_TYPE = 'S' +APPEND ALL FROM ©FROM FOR ATT_TYPE = 'S' +DBOPEN('ATTRIBUTES') +SELECT (SAVESEL) + +RETURN .T. + +********************************************** +FUNCTION FILL_PRODCODE +// FILL THE USERFILE (PROD_OPTS) RECORDS WITH THE PROD_ATTS->PROD_CODE + +LOCAL SAVESEL := SELECT() + +SELECT USERFILE2 +GOTO TOP +DO WHILE !EOF() + REC_LOCK(3) + REPLACE PROD_CODE WITH PROD_ATTS->PROD_CODE + UNLOCK + SKIP 1 +ENDDO +SELECT(SAVESEL) +RETURN .T. + + +***************************************************************** + +FUNCTION SEEKFUNC(SEEK_ALIAS, SEEKKEY) +LOCAL SAVESEL := SELECT() +SELECT (SEEK_ALIAS) +SEEK &SEEKKEY +SELECT (SAVESEL) +**(&SEEK_ALIAS)->(DBSEEK(&SEEKKEY)) +RETURN .T. + \ No newline at end of file diff --git a/CGW0300.PRG b/CGW0300.PRG new file mode 100644 index 0000000..10d5cec --- /dev/null +++ b/CGW0300.PRG @@ -0,0 +1,1862 @@ +* DON LOWENSTEIN -BUILD PRINT FILE ARRAY- CGW0300 5-28-93 +PROCEDURE BUILDPRNT(CALLPARM) + +****CONVKEYX := MAKE_BLOCK('CONV_RANGE(RANGE1, RANGE2)') +****AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF,,, CONVKEYX}) +LOCAL ATRB_SOURCE, NCHOICE, PT_PARM, NDX_EXP +LOCAL DEL_ADD_ARR := {'DA(1)', 'DA(2)', 'DA(3)', 'DA(4)', 'DA(5)'} +LOCAL GET_PARMS1, GET_PARMS2, PARR:={}, CHOICE, TAGNAME +* * * * * * * * * * * * * * * * * * * + +PRIVATE PRNTARR := {}, PARENTFILE, CHILDFILE, MDESC, CUTOFF, PIC, FILEFILTER +PRIVATE PRNTNAME, KEYVAR, RANGETYPE, NDXEXP, RANGEARR := {}, LVLBRK, SORTARR := {} +PRIVATE PARENTFILTER := NIL, REPTHEAD, DEFINEPROC:= NIL +PRIVATE DET_SUMM := .F., DET_LINE_EXTRA := {}, FOOTERLINES := {} +PRIVATE LBRK_FOOTER := {} +PRIVATE REPTONLY := .F., BLD_PROC // 13-15 +PRIVATE DBF_FLD_INFO := {} +PRIVATE MAXLINES := 55 +PRIVATE OUTPORT := NIL +PRIVATE SYSNTX := NIL + + +* * * * * * * * * * * * * * * * * * * + +DO CASE + + + * * * * * * * * * * * * * * * * * * * + + CASE ALLTRIM(CALLPARM) = 'BILLTRAN RECAP' + PRNTNAME = 'Billing Transaction Recap' + PARENTFILE = 'BILLTRAN' + CHILDFILE = NIL + FILEFILTER = 'RCDCD = "RE"' + REPTHEAD = PRNTNAME + DET_SUMM := .T. + + //** P3N - 3/18/99 ADDED DEF_BILLTRAN TO LIMIT THE REPORT FIELDS + DEFINEPROC = {|| DEF_BILLTRAN() } // FOUND IN 0350 + + MDESC = 'Order #' + KEYVAR = 'ORDER_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ORDER_NUM + RCDCD ' + SYSNTX = 1 + LVLBRK = {} + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + IF ALLTRIM(CALLPARM) = 'BILLTRAN RECAP-F' + ELSE + + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + + MDESC = 'Company' + KEYVAR = 'COMNO' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'COMNO + ORDER_NUM + RCDCD' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'COMNO', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer' + KEYVAR = 'CUSNR' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUSNR + ORDER_NUM + RCDCD' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'CUSNR', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Sales Rep' + KEYVAR = 'SLSNR' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SLSNR + ORDER_NUM + RCDCD' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'SLSNR', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Tran Date (YYMMDD)' + KEYVAR = 'TRNDT' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'TRNDT + ORDER_NUM + RCDCD ' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'TRNDT', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + + + ENDIF + PRNTARR := LOAD_PRNTARR() + +*********************************************** +* + CASE ALLTRIM(CALLPARM) = 'SALEHIST RECAP' + PRNTNAME := 'Sales History Recap' + PARENTFILE := 'SALEHIST' + CHILDFILE := NIL + FILEFILTER := NIL + REPTHEAD := PRNTNAME + DET_SUMM := .T. + + + + IF ALLTRIM(CALLPARM) = 'SALEHIST RECAP-F' + MDESC = 'GL Acct #' + KEYVAR = 'GL_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'GL_NUM + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'GL_NUM', MDESC } ) + AADD(LVLBRK, { 'COMP_CODE', 'Company' } ) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + + ELSE + + MDESC = 'GL Acct #' + KEYVAR = 'GL_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'GL_NUM + ORDER_NUM' + SYSNTX = 2 + LVLBRK = {} + AADD(LVLBRK, { 'GL_NUM', MDESC } ) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + + MDESC = 'Company' + KEYVAR = 'COMP_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'COMP_CODE + ORDER_NUM' + SYSNTX = 5 + LVLBRK = {} + AADD(LVLBRK, { 'COMP_CODE', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID + GL_NUM + ORDER_NUM' +******SYSNTX = 3 + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'CUST_ID', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Order #' + KEYVAR = 'ORDER_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ORDER_NUM + GL_NUM' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Sales Rep' + KEYVAR = 'SLSMAN' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SLSMAN + GL_NUM + ORDER_NUM ' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'SLSMAN', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Invoice Date' + KEYVAR = 'IDATE_FST' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(IDATE_FST) + GL_NUM + ORDER_NUM ' +******SYSNTX = 4 + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'DTOC(IDATE_FST)', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Post Date' + KEYVAR = 'POST_DATE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(POST_DATE) + POST_TIME + ORDER_NUM + GL_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, { 'DTOC(POST_DATE)', MDESC } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + + + ENDIF + PRNTARR := LOAD_PRNTARR() + + **************************************************** + + CASE ALLTRIM(CALLPARM) == 'ORDER FULFILLMENT' + PRNTNAME = 'ORDERS WHICH NEED FULFILLMENT / CLOSURE' + PARENTFILE = 'ORD_MAST' + FILEFILTER = 'EMPTY(SHIP_DATE)' //** P3N - 08/29/01 +//**FILEFILTER = 'EMPTY(IDATE_FST)' //** CHANGED PER ELLEN + CHILDFILE = NIL +*** DEFINEPROC = {|| DEF_FULFILL() } // FOUND IN 0350 + DEFINEPROC = {|| DEF_ORDERS('FULFILLMENT') } // FOUND IN 0350 + + DBOPEN('CUST_MAST') + + MDESC = 'Cust #' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID + ORDER_NUM' + SYSNTX = 2 + LVLBRK = {} + AADD(LVLBRK, {'GET_NAME(CUST_ID)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + +//** MDESC = 'Order #' +//** KEYVAR = 'ORDER_NUM' +//** PIC = '' +//** RANGETYPE = 'R' +//** CUTOFF = .F. +//** NDXEXP = 'ORDER_NUM' +//** SYSNTX = 1 +//** LVLBRK = {} +//** AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) +//** AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + +//** MDESC = 'Customer PO #' +//** KEYVAR = 'CUST_PO' +//** PIC = '' +//** RANGETYPE = 'R' +//** CUTOFF = .F. +//** NDXEXP = 'CUST_PO + ORDER_NUM' +//** SYSNTX = NIL +//** LVLBRK = {} +//** AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) +//** AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Invoice #' + KEYVAR = 'INVOICENUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'INVOICENUM + GL_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Order Date' + KEYVAR = 'ORDER_DATE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(ORDER_DATE) + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DTOC(ORDER_DATE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + +//** MDESC = 'Call Date' +//** KEYVAR = 'CALL_DATE' +//** PIC = '' +//** RANGETYPE = 'R' +//** CUTOFF = .F. +//** NDXEXP = 'DTOS(CALL_DATE) + ORDER_NUM' +//** SYSNTX = NIL +//** LVLBRK = {} +//** AADD(LVLBRK, {'DTOC(CALL_DATE)', ' ' } ) +//** AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) +//** AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + +//** MDESC = 'Production Date' +//** KEYVAR = 'PDATE_LAST' +//** PIC = '' +//** RANGETYPE = 'R' +//** CUTOFF = .F. +//** NDXEXP = 'DTOS(PDATE_LAST) + ORDER_NUM' +//** SYSNTX = NIL +//** LVLBRK = {} +//** AADD(LVLBRK, {'DTOC(PDATE_LAST)', ' ' } ) +//** AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) +//** AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + **************************************************** + + CASE ALLTRIM(CALLPARM) == 'ORDER MASTER' + PRNTNAME = 'ORDER MASTER REPORT' + PARENTFILE = 'ORD_MAST' + CHILDFILE = NIL + DEFINEPROC = {|| DEF_ORDERS() } // FOUND IN 0350 + + MDESC = 'Cust #' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID + ORDER_NUM' + SYSNTX = 2 + LVLBRK = {} + AADD(LVLBRK, {'GET_NAME(CUST_ID)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Order #' + KEYVAR = 'ORDER_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ORDER_NUM' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer PO #' + KEYVAR = 'CUST_PO' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_PO + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Invoice #' + KEYVAR = 'INVOICENUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. +****NDXEXP = 'INVOICENUM + GL_NUM' + NDXEXP = 'INVOICENUM ' //** P3N - 4/27/98 + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Order Date' + KEYVAR = 'ORDER_DATE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(ORDER_DATE) + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DTOC(ORDER_DATE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Call Date' + KEYVAR = 'CALL_DATE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(CALL_DATE) + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DTOC(CALL_DATE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Production Date' + KEYVAR = 'PDATE_LAST' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(PDATE_LAST) + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DTOC(PDATE_LAST)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Delivery Date' + KEYVAR = 'DDATE_LAST' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(DDATE_LAST) + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DTOC(DDATE_LAST)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Sales Person' + KEYVAR = 'SLSMAN' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SLSMAN + CUST_ID + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'SLSMAN', ' ' } ) + AADD(LVLBRK, {'CUST_ID', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Terms' + KEYVAR = 'TERMS' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'TERMS + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'TERMS', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Shipping Method' + KEYVAR = 'SHP_METHOD' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SHP_METHOD + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'SHP_METHOD', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Price Sheet' + KEYVAR = 'PRICE_SHT' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PRICE_SHT + CUST_ID + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'PRICE_SHT', ' ' } ) + AADD(LVLBRK, {'CUST_ID', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Tax Schedule' + KEYVAR = 'TAXSCH' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'TAXSCH + ORDER_NUM' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'TAXSCH', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + + **************************************************** + + CASE ALLTRIM(CALLPARM) == 'MISC ITEMS' + PRNTNAME = 'MISCELLEANOUS ITEMS REPORT' + PARENTFILE = 'MISC_PUOM' + CHILDFILE = NIL + DEFINEPROC = {|| DEF_MITEMS() } // FOUND IN 0350 + DBOPEN('MISC_ITEMS') + + MDESC = 'Part #' + KEYVAR = 'PARTNUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PARTNUM' + SYSNTX = 1 + LVLBRK = {} +****AADD(LVLBRK, {'GET_NAME(CUST_ID)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Description' +****KEYVAR = 'DESC' + KEYVAR = {{'MISC_ITEMS','DESC'} , 'DISPVALUE(PARTNUM,"MISC_ITEMS",{"DESC"}) '} //DATABASE VARIABLE USED FOR RANGE + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. +****NDXEXP = 'DESC' + NDXEXP = 'DISPVALUE(PARTNUM,"MISC_ITEMS",{"DESC"})' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'GL Num' + KEYVAR = {{'MISC_ITEMS','GL_NUM'} , 'DISPVALUE(PARTNUM,"MISC_ITEMS",{"GL_NUM"}) '} //DATABASE VARIABLE USED FOR RANGE + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DISPVALUE(PARTNUM,"MISC_ITEMS",{"GL_NUM"})' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'UOM' + KEYVAR = 'UOM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UOM + PARTNUM' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Dealer Amounts' + KEYVAR = 'DLR_AMT' + PIC = '9999999.9999' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + MDESC = 'Sp Dealer Amounts' + KEYVAR = 'SD_AMT' + PIC = '9999999.9999' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + MDESC = 'Builder Amounts' + KEYVAR = 'BU_AMT' + PIC = '9999999.9999' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + MDESC = 'Distributor Amounts' + KEYVAR = 'DIST_AMT' + PIC = '9999999.9999' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + MDESC = 'Lumbermen Amounts' + KEYVAR = 'LUMB_AMT' + PIC = '9999999.9999' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + MDESC = 'Intercompany Amounts' + KEYVAR = 'IC_AMT' + PIC = '9999999.9999' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + + + PRNTARR := LOAD_PRNTARR() + + + CASE ALLTRIM(CALLPARM) == 'CATEGORY OPTIONS' + // PRODUCT CATEGORY OPTIONS + PRNTNAME = 'PRODUCT CATEGORY OPTIONS' + PARENTFILE = 'CAT_OPTS' + CHILDFILE = NIL + FILEFILTER = 'CAT_OPTS->CAT_CODE == CATEGORY->CAT_CODE' + REPTHEAD = {['UNIQUE CATEGORY CHOICES for "' + ALLTRIM(CATEGORY->CAT_CODE) + '" - ' + CATEGORY->DESC],; + 'DTOC(CURDATE) '} + + MDESC = 'Attribute' + KEYVAR = 'ATT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_CODE + STR(SEQ_NUM,2)' + SYSNTX = 1 + LVLBRK = {} + AADD(LVLBRK, {'SEEKATTDESC(ATT_CODE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF, , , }) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'TAX SUMMARY SCHEDULES' + // TAX_SCHED + PRNTNAME = CALLPARM + PARENTFILE = 'TAX_SCHED' + REPTHEAD = PRNTNAME + DBOPEN('TAX_DETAIL') + + MDESC = 'Schedule Code' + KEYVAR = 'STAXSCH' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STAXSCH' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Description' + KEYVAR = 'DESC' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DESC' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + + CASE ALLTRIM(CALLPARM) == 'TAX DETAIL COMPONENTS' + // TAX_SCHED + PRNTNAME = CALLPARM + PARENTFILE = 'TAX_DETAIL' + REPTHEAD = PRNTNAME + + MDESC = 'Sequence Code' + KEYVAR = 'SSTAXSEQ' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SSTAXSEQ' + SYSNTX = 1 + LVLBRK = {} + CONVKEYX := MAKE_BLOCK('CONV_RANGE(RANGE1, RANGE2)') + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF,,, CONVKEYX}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Description' + KEYVAR = 'SDETDESC' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SDETDESC' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + + + CASE ALLTRIM(CALLPARM) == 'CATEGORY ATTRIBUTES' + // PRODUCT CATEGORY OPTIONS + PRNTNAME = 'PRODUCT CATEGORY ATTRIBUTES' + PARENTFILE = 'CATEGORY' + CHILDFILE = 'CAT_ATTS' + FILEFILTER = 'CAT_ATTS->CAT_CODE == CATEGORY->CAT_CODE' + REPTHEAD = {"'UNIQUE ATTRIBUTES for CATEGORY ' + ALLTRIM(CATEGORY->DESC)",; + 'DTOC(CURDATE) '} + + MDESC = 'Screen Order' + KEYVAR = 'ORDER' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STR(ORDER,2)' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Attribute' + KEYVAR = 'ATT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_CODE + STR(ORDER,2)' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'CATEGORY' + // PRODUCT CATEGORYS + PRNTNAME = 'List of System CATEGORIES' + PARENTFILE = 'CATEGORY' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + + MDESC = 'Category CODE' + KEYVAR = 'CAT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CAT_CODE' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Description' + KEYVAR = 'DESC' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DESC + CAT_CODE' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'MODEL' + // PRODUCT FILE + DBOPEN('CATEGORY') + PRNTNAME = 'List of MODELS' + PARENTFILE = 'PRODUCT' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + + MDESC = 'Model' + KEYVAR = 'PROD_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PROD_CODE' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Description' + KEYVAR = 'DESC' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DESC + PROD_CODE' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Category' + KEYVAR = 'CAT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CAT_CODE + PROD_CODE' + SYSNTX = 3 + LVLBRK = {} + AADD(LVLBRK, {'SEEKCATDESC(CAT_CODE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Mgf Location' + KEYVAR = 'LOC_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'LOC_CODE + PROD_CODE' + SYSNTX = 4 + LVLBRK = {} + AADD(LVLBRK, {'LOC_CODE', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'MODEL ATTRIBUTES' + // PRODUCT ATTRIBUTES + DBOPEN('CATEGORY') + PRNTNAME = CALLPARM + PARENTFILE = 'PRODUCT' + CHILDFILE = 'PROD_ATTS' + FILEFILTER = 'PROD_ATTS->PROD_CODE == PRODUCT->PROD_CODE' + REPTHEAD = {"'UNIQUE ATTRIBUTES for MODEL/PRODUCT ' + ALLTRIM(PRODUCT->DESC)",; + 'DTOC(CURDATE) '} + + + MDESC = 'Screen Order' + KEYVAR = 'ORDER' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STR(ORDER,2)' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Attribute' + KEYVAR = 'ATT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_CODE + STR(ORDER,2)' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'MODEL OPTIONS' + // PRODUCT OPTIONS + PRNTNAME = 'MODELS' + PARENTFILE = 'PROD_OPTS' + CHILDFILE = NIL + FILEFILTER = 'PROD_OPTS->PROD_CODE == PRODUCT->PROD_CODE' + REPTHEAD = {['UNIQUE CHOICES for MODEL/PRODUCT "' + ALLTRIM(PRODUCT->PROD_CODE) + '" - ' + PRODUCT->DESC],; + 'DTOC(CURDATE) '} + + MDESC = 'Attribute' + KEYVAR = 'ATT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_CODE + STR(SEQ_NUM,2)' + SYSNTX = 1 + LVLBRK = {} + AADD(LVLBRK, {'SEEKATTDESC(ATT_CODE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'ATTRIBUTES' + // ATTRIBUTES + PRNTNAME = 'List of SYSTEM ATTRIBUTES' + PARENTFILE = 'ATTRIBUTES' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + + MDESC = 'Attribute' + KEYVAR = 'ATT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_CODE' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Description' + KEYVAR = 'DESC' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DESC + ATT_CODE' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Attribute Type' + KEYVAR = 'ATT_TYPE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_TYPE + ATT_CODE' + SYSNTX = 3 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'ATTRIBUTE OPTIONS' + // ATTRIBUTE OPTIONS + DBOPEN('ATTRIBUTES') + PRNTNAME = CALLPARM + PARENTFILE = 'ATT_OPTS' + CHILDFILE = NIL + REPTHEAD = {"'OPTION CHOICES for System ATTRIBUTES '",; + 'DTOC(CURDATE) '} + + + MDESC = 'Attribute' + KEYVAR = 'ATT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'ATT_CODE + STR(SEQ_NUM,2)' + SYSNTX = 1 + LVLBRK = {} + AADD(LVLBRK, {'SEEKATTDESC(ATT_CODE)', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'STD_SIZES' + // SIZES TABLES + PRNTNAME = 'STOCKSIZE' + PARENTFILE = 'STD_SIZES' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + + MDESC = 'Product' + KEYVAR = 'PROD_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PROD_CODE' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'PROD_CODE', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'PRICING REPORT-MODEL' + + // IDENTIFY ALL OPTIONS USED TO PRICE A PRODUCT/MODEL + SAYTITLE('Select Model to Report', '0300') + GET_PARMS1 := DBOPEN('PRODUCT') + @2,0 CLEAR + PRINT_KEY := GET_KEY(GET_PARMS1, .T., , , .T.) + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'DATA', 130, 'C', 0} ) + CREATE_U7() + PRNTNAME = 'MODEL PRICE REPORT' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER = '.T.' + DET_SUMM = .F. + REPTHEAD = PRNTNAME + DEFINEPROC = {|| FLD_PRICERPT('PRICE', 'MODEL') } // FOUND IN 0350 + ** + LVLBRK = {} + ** + PRNTARR := LOAD_PRNTARR() + + + CASE ALLTRIM(CALLPARM) == 'PRICING REPORT-CUST' + + // IDENTIFY ALL OPTIONS USED TO PRICE A PRODUCT/MODEL WITH SPECIAL PRICING CONSIDERATIONS + SAYTITLE('Select Customer/Model', '0300') + GET_PARMS1 := DBOPEN('CUST_MAST') + GET_PARMS2 := DBOPEN('PRODUCT') + @2,0 CLEAR + PRINT_KEY := GET_KEY(GET_PARMS1, .T.,,,.T. ) + @4,0 CLEAR + PRINT_KEY := PRINT_KEY + GET_KEY(GET_PARMS2, .T.,,5,.T.) + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'DATA', 130, 'C', 0} ) + CREATE_U7() + + PRNTNAME = 'CUSTOMER PRICE REPORT' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER = '.T.' + DET_SUMM = .F. + REPTHEAD = PRNTNAME + DEFINEPROC = {|| FLD_PRICERPT('PRICE', 'CUST') } // FOUND IN 0350 + ** + LVLBRK = {} + ** + PRNTARR := LOAD_PRNTARR() + + + CASE ALLTRIM(CALLPARM) == 'PRODUCT REPORT-MODEL' + + // IDENTIFY ALL OPTIONS USED TO PRICE A PRODUCT/MODEL + SAYTITLE('Select Model for Production', '0300') + GET_PARMS1 := DBOPEN('PRODUCT') + @2,0 CLEAR + PRINT_KEY := GET_KEY(GET_PARMS1, .T.) + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'DATA', 130, 'C', 0} ) + CREATE_U7() + + PRNTNAME = 'MODEL PRODUCTION CUTTING SPECIFICATIONS' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER = '.T.' + DET_SUMM = .F. + REPTHEAD = PRNTNAME + DEFINEPROC = {|| FLD_PRICERPT('PROD', 'MODEL') } // FOUND IN 0350 + ** + LVLBRK = {} + ** + PRNTARR := LOAD_PRNTARR() + + + CASE ALLTRIM(CALLPARM) == 'PRODUCT REPORT-CUST' + + // IDENTIFY ALL OPTIONS USED TO PRICE A PRODUCT/MODEL +* SAYTITLE('Select Model for Production', '0300') +* GET_PARMS := DBOPEN('PRODUCT') +* PRINT_KEY := GET_KEY(GET_PARMS, .T.) + SAYTITLE('Select Customer/Model', '0300') + GET_PARMS1 := DBOPEN('CUST_MAST') + GET_PARMS2 := DBOPEN('PRODUCT') + @2,0 CLEAR + PRINT_KEY := GET_KEY(GET_PARMS1, .T.,,,.T. ) + @4,0 CLEAR + PRINT_KEY := PRINT_KEY + GET_KEY(GET_PARMS2, .T.,,5,.T.) + + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'DATA', 130, 'C', 0} ) + CREATE_U7() + + PRNTNAME = 'CUSTOMER PRODUCTION CUTTING SPECIFICATIONS' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER = '.T.' + DET_SUMM = .F. + REPTHEAD = PRNTNAME + DEFINEPROC = {|| FLD_PRICERPT('PROD', 'CUST') } // FOUND IN 0350 + ** + LVLBRK = {} + ** + PRNTARR := LOAD_PRNTARR() + + + + CASE ALLTRIM(CALLPARM) == 'MONTHLY PRODUCTION' + + CLS + SAYTITLE('Monthly Production Report', '0300') + DBOPEN('ORD_MAST') + DBOPEN('ORD_LINES') + DBOPEN('ORD_PROD') //** P3N - 01/16/02 + DBOPEN('ORDER_OPTS') //** P3N - 01/16/02 + DBOPEN('ADDL_OPTS') //** P3N - 01/16/02 + DBOPEN('ADDL_LINES') + DBOPEN('PRODUCT') + DET_SUMM := .T. + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'PROD_YEAR', 4, 'C', 0} ) + AADD(DBF_FLD_INFO, {'PROD_CODE', 7, 'C', 0} ) + AADD(DBF_FLD_INFO, {'PROD_COLOR',10, 'C', 0} ) //** P3N - 01/16/02 + AADD(DBF_FLD_INFO, {'PROD_HOURS',10, 'N', 2} ) //** P3N - 01/16/02 + AADD(DBF_FLD_INFO, {'CAT_CODE', 7, 'C', 0} ) + AADD(DBF_FLD_INFO, {'LOC_CODE', 6, 'C', 0} ) + AADD(DBF_FLD_INFO, {'ORDER_NUM', 6, 'C', 0} ) + AADD(DBF_FLD_INFO, {'THIS_DATE', 8, 'D', 0} ) + AADD(DBF_FLD_INFO, {'ORDER_DATE', 8, 'D', 0} ) + AADD(DBF_FLD_INFO, {'PDATE_LAST', 8, 'D', 0} ) + AADD(DBF_FLD_INFO, {'IDATE_LAST', 8, 'D', 0} ) + AADD(DBF_FLD_INFO, {'DDATE_LAST', 8, 'D', 0} ) + AADD(DBF_FLD_INFO, {'JAN', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'FEB', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'MAR', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'APR', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'MAY', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'JUN', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'JUL', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'AUG', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'SEP', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'OCT', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'NOV', 5, 'N', 0} ) + AADD(DBF_FLD_INFO, {'DEC', 5, 'N', 0} ) + + CREATE_U7() + **INDEX ON PROD_YEAR + PROD_CODE + LOC_CODE TO &USERFILE7 + NDX_EXP := 'PROD_YEAR + PROD_CODE + LOC_CODE' + IF __DBDRIVER = 'CDX' + TAGNAME := 'T1' + INDEX ON &NDX_EXP TAG &TAGNAME TO &USERFILE7 + ELSE + INDEX ON &NDX_EXP TO &USERFILE7 + ENDIF + + + // GET DRIVER DATE + AADD(PARR, 'ORDER Totals Report') + AADD(PARR, 'PRODUCTION Totals Report') + AADD(PARR, 'INVOICING Totals Report') + AADD(PARR, 'DELIVERY Totals Report') + CHOICE = PICKLIST(PARR) + IF LASTKEY() = 27 + RETURN NIL + ENDIF + M->PRODTIME := CHOICE //** P3N - 01/16/02 + +****PRNTNAME = 'MONTHLY PRODUCTION TOTALS' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER = '.T.' + DET_SUMM = .T. + DEFINEPROC = {|| DEF_MOPROD() } // FOUND IN 0350 + + + DO CASE + CASE CHOICE = 1 + PRNTNAME = 'MONTHLY ORDER TOTALS' + BLD_PROC = "BLD_MOPROD('ORDER')" + + CASE CHOICE = 2 + PRNTNAME = 'MONTHLY PRODUCTION TOTALS' + BLD_PROC = "BLD_MOPROD('PRODUCTION')" + + CASE CHOICE = 3 + PRNTNAME = 'MONTHLY INVOICING TOTALS' + BLD_PROC = "BLD_MOPROD('INVOICING')" + + CASE CHOICE = 4 + PRNTNAME = 'MONTHLY DELIVERY TOTALS' + BLD_PROC = "BLD_MOPROD('DELIVER')" + + END CASE + REPTHEAD = PRNTNAME + ** + LVLBRK = {} + ** + + MDESC = 'Product' + KEYVAR = 'PROD_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CAT_CODE + PROD_CODE + LOC_CODE + PROD_YEAR' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'CAT_CODE', ' ' } ) +****AADD(LVLBRK, {'PROD_CODE', ' ' } ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Order #' + KEYVAR = 'ORDER_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + IF CHOICE = 1 + MDESC = 'Order Date' + *** KEYVAR = 'ORDER_DATE' + KEYVAR = {{'ORD_MAST','ORDER_DATE'}, ' ORD_MAST_DATA("ORDER_DATE") ' } + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + ELSE + IF CHOICE = 2 + MDESC = 'Production Date' + KEYVAR = 'PDATE_LAST' + KEYVAR = {{'ORD_MAST','ORDER_DATE'}, ' ORD_MAST_DATA("PDATE_LAST") ' } + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + ELSE + IF CHOICE = 3 + MDESC = 'Invoice Date' +** KEYVAR = 'IDATE_LAST' + KEYVAR = {{'ORD_MAST','ORDER_DATE'}, ' ORD_MAST_DATA("IDATE_LAST") ' } + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + ELSE + IF CHOICE = 4 + MDESC = 'Delivery Date' +**** KEYVAR = 'DDATE_LAST' + KEYVAR = {{'ORD_MAST','ORDER_DATE'}, ' ORD_MAST_DATA("DDATE_LAST") ' } + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + ENDIF + ENDIF + ENDIF + ENDIF + + MDESC = 'Category' +//**KEYVAR = 'CAT_CODE' +//** P3N - 11/22/99 + KEYVAR = {{'USERFILE7','CAT_CODE'},'GET_CATCODE(PROD_CODE)'} + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Location' + KEYVAR = 'LOC_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC := 'Color' //** P3N - 01/16/02 +//**KEYVAR := 'PROD_COLOR' //** P3N - 01/16/02 + KEYVAR := {{'USERFILE7','PROD_COLOR'},'GETCOLOR("PROD_COLOR")'} //** P3N - 01/16/02 + PIC := '' //** P3N - 01/16/02 + RANGETYPE := 'R' //** P3N - 01/16/02 + CUTOFF := .F. //** P3N - 01/16/02 + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + PRNTARR := LOAD_PRNTARR() + + + CASE ALLTRIM(CALLPARM) == 'RULE REPORT' + + // VERIFY ALL RULES USED AND NOT IN USE + SAYTITLE('Verifying Rules Report', '0300') + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'DATA', 100, 'C', 0} ) + CREATE_U7() + + PRNTNAME = 'RULE VERIFICATION REPORT' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER = '.T.' + DET_SUMM = .F. + REPTHEAD = PRNTNAME + DEFINEPROC = {|| BLD_RULERPT() } // FOUND IN 0350 + ** + LVLBRK = {} + ** + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'RULES' + + // VERIFY ALL RULES USED AND NOT IN USE + SAYTITLE('Print / Display Rules', '0300') + + PRNTNAME = 'RULES REPORT' + PARENTFILE = 'RULES' + CHILDFILE = 'RULEPACK' + FILEFILTER = 'RULE_CODE == RULES->RULE_CODE' + DET_SUMM = .F. + REPTHEAD = {"{'RULE DEFINITIONS - ' + RULES->RULE_DESC , DTOC(CURDATE) }"} + ** + LVLBRK = {} + ** + + MDESC = 'Line Number' + KEYVAR = 'LINE_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STR(LINE_NUM,3)' + SYSNTX = 1 + LVLBRK = {} +****AADD(LVLBRK, {'SEEKATTDESC(ATT_CODE)', ' ' } ) +****AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'PRICING EXTRAS' + + // VERIFY ALL RULES USED AND NOT IN USE + SAYTITLE('Print / Display Pricing Extras', '0300') + + PRNTNAME = 'PRICING EXTRAS REPORT' + PARENTFILE = 'CATEGORY' + CHILDFILE = 'PRI_EXTRAS' + FILEFILTER = 'CAT_CODE == CATEGORY->CAT_CODE' + DET_SUMM = .F. + REPTHEAD = PRNTNAME + REPTHEAD = {"{'PRICING EXTRAS - ' + CATEGORY->DESC , DTOC(CURDATE) }"} + ** + LVLBRK = {} + ** + + MDESC = 'Sequence Order' + KEYVAR = 'SEQ_NUM' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STR(SEQ_NUM,3)' + SYSNTX = 1 + LVLBRK = {} +****AADD(LVLBRK, {'SEEKATTDESC(ATT_CODE)', ' ' } ) +****AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'MANUFACTURING LOCATIONS' + // MANUFACTURING LOCATION + PRNTNAME = 'MANUFACTURING LOCATIONS' + PARENTFILE = 'MFG_LOC' + CHILDFILE = NIL + FILEFILTER = '.T.' + REPTHEAD = PRNTNAME + + MDESC = 'Location Code' + KEYVAR = 'LOC_CODE' + PIC = '!!!!!!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'LOC_CODE' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'CUSTOMER MASTER' + // CUSTOMER MASTER + DBOPEN('TERMS') //** P3N - 02/27/02 + PRNTNAME = 'CUSTOMER MASTER' + PARENTFILE = 'CUST_MAST' + CHILDFILE = NIL + FILEFILTER = '.T.' + REPTHEAD = PRNTNAME + DEFINEPROC = {|| DEF_CMRPT() } // FOUND IN 0350 + + MDESC = 'Customer Number' + KEYVAR = 'CUST_ID' + PIC = '!!!!!!!!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID' + SYSNTX = 1 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer Name' + KEYVAR = 'COMP_NAME' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(COMP_NAME)' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'City' + KEYVAR = 'CUST_CITY' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(CUST_CITY + CUST_STATE + COMP_NAME)' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'State' + KEYVAR = 'CUST_STATE' + PIC = '!!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(CUST_STATE + COMP_NAME)' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'CUST_STATE', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'ZIP Code' + KEYVAR = 'CUST_ZIP' + PIC = '99999' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ZIP + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'CUST_ZIP',MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Delivery Route' + KEYVAR = 'DEL_ROUTE' + PIC = '!!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DEL_ROUTE + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DEL_ROUTE',MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Price Sheet' + KEYVAR = 'PRICE_SHT' + PIC = '!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PRICE_SHT + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'PRICE_SHT',MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + + CASE ALLTRIM(CALLPARM) == 'MODEL BASE PRICE' .OR. ; + ALLTRIM(CALLPARM) == 'CATEGORY BASE PRICE' + + // IDENTIFY ALL OPTIONS USED TO PRICE A PRODUCT/MODEL + TITLE := 'Select Price Table to Print' + @2,0 CLEAR TO 9,80 + + DBF_FLD_INFO := {} + AADD(DBF_FLD_INFO, {'DATA', 131, 'C', 0} ) + CREATE_U7() + + NCHOICE := WHCHPRICE(1) + IF LASTKEY() = 27 + PRNTARR := NIL + RETURN PRNTARR + ENDIF + + PT_PARM := CURPTBL(NCHOICE) + + PRNTNAME = 'BASE PRICE TABLES' + PARENTFILE = 'USERFILE7' + CHILDFILE = NIL + FILEFILTER := '.T.' + DET_SUMM = .F. + REPTHEAD = {" { '" + PT_PARM + "', DTOC(CURDATE) }"} + IF CALLPARM = 'CATEGORY' + BLD_PROC = "CGWBASEPRICE('CATEGORY'," + STR(NCHOICE,1) + ")" + ELSE + BLD_PROC = "CGWBASEPRICE('PRODUCT', " + STR(NCHOICE,1) + ")" + ENDIF + DEFINEPROC = {|| BASEPRICE() } // FOUND IN 0350 + ** + LVLBRK = {} + ** + PRNTARR := LOAD_PRNTARR() + +********** + + CASE CALLPARM == 'CUSTDEL' + // + PRNTNAME = 'CUSTOMER LIST - DELIVERY INFORMATION' + PARENTFILE = 'CUST_MAST' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + DET_SUMM := .T. + DEFINEPROC := {|| BLD_CUSTDEL() } + DET_LINE_EXTRA := DEL_ADD_ARR // DELIVERY ADDRESS ARRARY + + MDESC = 'Customer ID' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID' + SYSNTX = 1 + LVLBRK = {} + CONVKEYX := MAKE_BLOCK('CONV_RANGE(RANGE1, RANGE2)') + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF,,, CONVKEYX}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer Name' + KEYVAR = 'COMP_NAME' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(COMP_NAME)' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'City' + KEYVAR = 'CUST_CITY' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(CUST_CITY + CUST_STATE + COMP_NAME)' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'State' + KEYVAR = 'CUST_STATE' + PIC = '!!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(CUST_STATE + COMP_NAME)' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'CUST_STATE', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'ZIP Code' + KEYVAR = 'CUST_ZIP' + PIC = '99999' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ZIP + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'CUST_ZIP',MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Delivery Route' + KEYVAR = 'DEL_ROUTE' + PIC = '!!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DEL_ROUTE + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DEL_ROUTE',MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + +********** + + CASE CALLPARM == 'CUSTSETUP' + // + PRNTNAME = 'CUSTOMER LIST - TERMS and SETUP Information' + PARENTFILE = 'CUST_MAST' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + DET_SUMM := .T. + DEFINEPROC := {|| BLD_CUSTSETUP() } + DBOPEN('TAX_SCHED') + DBOPEN('TAX_DETAIL') + + MDESC = 'Customer ID' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID' + SYSNTX = 1 + LVLBRK = {} + CONVKEYX := MAKE_BLOCK('CONV_RANGE(RANGE1, RANGE2)') + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF,,, CONVKEYX}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer Name' + KEYVAR = 'COMP_NAME' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(COMP_NAME)' + SYSNTX = 2 + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Salesman' + KEYVAR = 'SLSMAN' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'SLSMAN + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'SLSMAN', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Price Sheet' + KEYVAR = 'PRICE_SHT' + PIC = '!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PRICE_SHT + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'PRICE_SHT', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Tax Schedule' + KEYVAR = 'TAXSCH' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'TAXSCH + COMP_NAME' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'TAXSCH',MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + +********** + + CASE CALLPARM == 'DISCOUNTS' + // + PRNTNAME = 'CUSTOMER DISCOUNTS LIST' + PARENTFILE = 'CUST_PRICE' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + DET_SUMM := .T. + DBOPEN('CUST_MAST') + + MDESC = 'Customer ID' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID' + SYSNTX = 1 + LVLBRK = {} + AADD(LVLBRK, {'CUST_ID', MDESC} ) + CONVKEYX := MAKE_BLOCK('CONV_RANGE(RANGE1, RANGE2)') + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF,,, CONVKEYX}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer Name' + KEYVAR = {{'CUST_MAST','COMP_NAME'}, 'UPPER(DISPVALUE(CLUBID,"CLUB_MAST",{"NAME"}))'} //DATABASE VARIABLE USED FOR RANGE + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(DISPVALUE(CUST_ID,"CUST_MAST",{"COMP_NAME"}))' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DISPVALUE(CUST_ID,"CUST_MAST",{"COMP_NAME"})', ' '} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Category' + KEYVAR = 'CAT_CODE' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CAT_CODE + PROD_CODE + CUST_ID' + SYSNTX = 2 + LVLBRK = {} + AADD(LVLBRK, {'CAT_CODE', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Product' + KEYVAR = 'PROD_CODE' + PIC = '!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PROD_CODE + CAT_CODE + CUST_ID' + SYSNTX = 3 + LVLBRK = {} + AADD(LVLBRK, {'PROD_CODE', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Disc %' + KEYVAR = 'DISCOUNT' + PIC = '999.99' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STR(DISCOUNT,6,2) + CUST_ID' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Price Sheet' + KEYVAR = 'PRICE_SHT' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PRICE_SHT + CUST_ID' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + +***************** + CASE CALLPARM == 'SPEC PRICE' + // + PRNTNAME = 'CUSTOMER SPECIAL PRICE SHEET LISTING' + PARENTFILE = 'CUST_BP' + CHILDFILE = NIL + REPTHEAD = PRNTNAME + DET_SUMM := .T. + DBOPEN('CUST_MAST') + + MDESC = 'Customer ID' + KEYVAR = 'CUST_ID' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'CUST_ID' + SYSNTX = 1 + LVLBRK = {} + AADD(LVLBRK, {'CUST_ID', MDESC} ) + CONVKEYX := MAKE_BLOCK('CONV_RANGE(RANGE1, RANGE2)') + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF,,, CONVKEYX}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Customer Name' + KEYVAR = {{'CUST_MAST','COMP_NAME'}, 'UPPER(DISPVALUE(CLUBID,"CLUB_MAST",{"NAME"}))'} //DATABASE VARIABLE USED FOR RANGE + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'UPPER(DISPVALUE(CUST_ID,"CUST_MAST",{"COMP_NAME"}))' + SYSNTX = NIL + LVLBRK = {} + AADD(LVLBRK, {'DISPVALUE(CUST_ID,"CUST_MAST",{"COMP_NAME"})', ' '} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Product' + KEYVAR = 'PROD_CODE' + PIC = '!' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'PROD_CODE + CAT_CODE + CUST_ID' + SYSNTX = 2 + LVLBRK = {} + AADD(LVLBRK, {'PROD_CODE', MDESC} ) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Base %' + KEYVAR = 'BASEFAC' + PIC = '99999.99' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'STR(BASEFAC,8,2) + CUST_ID' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'Begin Date' + KEYVAR = 'DATE1' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(DATE1) + CUST_ID' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + MDESC = 'End Date' + KEYVAR = 'DATE2' + PIC = '' + RANGETYPE = 'R' + CUTOFF = .F. + NDXEXP = 'DTOS(DATE2) + CUST_ID' + SYSNTX = NIL + LVLBRK = {} + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + PRNTARR := LOAD_PRNTARR() + +***************** + +OTHERWISE + PRNTARR := NIL +ENDCASE + +RETURN PRNTARR +******************************************************************* +FUNCTION CURPTBL(WHCHTBL) +DO CASE + CASE WHCHTBL = 1 + RETURN 'DEALER PRICE SHEET' + CASE WHCHTBL = 2 + RETURN 'SPECIAL DEALER PRICE SHEET' + CASE WHCHTBL = 3 + RETURN 'BUILDER PRICE SHEET' + CASE WHCHTBL = 4 + RETURN 'LUMBERMEN PRICE SHEET' + CASE WHCHTBL = 5 + RETURN 'DISTRIBUTOR PRICE SHEET' + CASE WHCHTBL = 6 + RETURN 'INTERCOMPANY PRICE SHEET' + OTHERWISE + ? ABEND + +ENDCASE + + +******************************************************************* +// PRINT THE DELIVERY ADDRESS AS DETAIL EXTRA LINE +FUNCTION DA(PARM) +LOCAL NUMSP1 := SPACE(09) , NUMSP2 := SPACE(48) +DO CASE + CASE PARM = 1 + RETURN NUMSP1 + PADR(CUST_MAST->CUST_ADDR,30) ; + + NUMSP2 + CUST_MAST->SHIPADD1 + CASE PARM = 2 + RETURN NUMSP1 + PADR(CUST_MAST->CUST_ADDR2,30) ; + + NUMSP2 + ALLTRIM(CUST_MAST->SHIPADD2) + ' ' ; + + CUST_MAST->SHIPST + ' ' + CUST_MAST->SHIPZIP + CASE PARM = 3 + RETURN NUMSP1 + PADR( ALLTRIM(CUST_MAST->CUST_CITY) + ' ' ; + + CUST_MAST->CUST_STATE + ' ' + CUST_MAST->CUST_ZIP, 30) ; + + NUMSP2 + 'Phone: ' + ALLTRIM(CUST_MAST->SHIPPHN) + ' FAX: ' + CUST_MAST->SHIPFAX + CASE PARM = 4 + RETURN NUMSP1 + 'Phone: ' + ALLTRIM(CUST_MAST->PHONE) + ' FAX: ' + CUST_MAST->FAX + CASE PARM = 5 + RETURN REPLICATE('-', LEN(DATA) ) +ENDCASE + + +*********************************************************** +FUNCTION GET_NAME(MCUST_ID) +// RETURN THE CUST_ID NAME + +RETURN ORD_MAST->BILL_NAME +*********************************************************** +* CREATE THE USERFILE7 FOR REPORT PROCESSING +*********************************************************** +FUNCTION CREATE_U7() +IF SELECT('USERFILE7') > 0 + SELECT USERFILE7 + USE +ENDIF +IF FILE(USERFILE7 + '.DBF') + ERASE (USERFILE7+'.DBF') +ENDIF +CREATE_DBF(USERFILE7, DBF_FLD_INFO) +NET_USE(USERFILE7, .T., 3, 'USERFILE7') +RETURN + \ No newline at end of file diff --git a/CGW0350.PRG b/CGW0350.PRG new file mode 100644 index 0000000..57b714c --- /dev/null +++ b/CGW0350.PRG @@ -0,0 +1,1864 @@ +// CGW0350 - don and mike - 08-06-94 +************************************************* + +#INCLUDE 'CGWINCLD.PRG' + + +************************************************* +FUNCTION DEF_MITEMS() +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 + +FIELDNAME := 'PARTNUM' +COLHEAD := {'Part #'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + +FIELDNAME := 'DISPVALUE(PARTNUM,"MISC_ITEMS",{"DESC"})' +COLHEAD := {'Description'} +TOTALFLD := .F. +DISPLEN := 25 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'DISPVALUE(PARTNUM,"MISC_ITEMS",{"GL_NUM"})' +COLHEAD := {'GL Num'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'UOM' +COLHEAD := {'Unit','Of', 'Measure'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(DLR_AMT, 10,4) ' +COLHEAD := {'Dealer'} +TOTALFLD := .F. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(SD_AMT, 10,4) ' +COLHEAD := {'Special','Dealer'} +TOTALFLD := .F. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(BU_AMT, 10,4) ' +COLHEAD := {'Builder'} +TOTALFLD := .F. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(DIST_AMT, 10,4) ' +COLHEAD := {'Distributor'} +TOTALFLD := .F. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(LUMB_AMT, 10,4) ' +COLHEAD := {'Lumbermen'} +TOTALFLD := .F. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(IC_AMT, 10,4) ' +COLHEAD := {'Intercompany'} +TOTALFLD := .F. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + + +RETURN FIELDARR + + + +******************************************************************** +//** P3N - 3/18/99 - LIMIT THE NUMBER OF FIELDS PRINTING ON REPORT +******************************************************************** +FUNCTION DEF_BILLTRAN() +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 + +FIELDNAME := 'ORDER_NUM' +COLHEAD := {'Order #'} +TOTALFLD := .F. +DISPLEN := 6 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'SPACE(1) + INVNR' +COLHEAD := {'Invoice#'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'CRMNR' +COLHEAD := {' Ref #'} +TOTALFLD := .F. +DISPLEN := 6 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +* FIELDNAME := 'GL_NUM' +* COLHEAD := {'GL Acct #'} +* TOTALFLD := .F. +* DISPLEN := 10 +* DISPDEC := 0 +* AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'SPACE(2) + SALCD' +COLHEAD := {'Sale','Code'} +TOTALFLD := .F. +DISPLEN := 4 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'SLSNR' +COLHEAD := {'Sales',' Rep'} +TOTALFLD := .F. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'SPACE(3) + ACREC' +COLHEAD := {'Active',' Code'} +TOTALFLD := .F. +DISPLEN := 6 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'SPACE(1) + COMNO' +COLHEAD := {'Comp#'} +TOTALFLD := .F. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'CUSNR' +COLHEAD := {'Customer#'} +TOTALFLD := .F. +DISPLEN := 9 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'TRNDT' +COLHEAD := {'Trans','Date'} +TOTALFLD := .F. +DISPLEN := 6 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(INVAM,13,2)' +COLHEAD := {' Invoice ',' Amount '} +TOTALFLD := .T. +DISPLEN := 13 +DISPDEC := 2 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(TXBLAMT,13,2)' +COLHEAD := {' Taxable ',' Amount '} +TOTALFLD := .T. +DISPLEN := 13 +DISPDEC := 2 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(TXAM1,13,2)' +COLHEAD := {'Sales Tax Amt'} +TOTALFLD := .T. +DISPLEN := 13 +DISPDEC := 2 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'TXSCHED' +COLHEAD := {' Tax ',' Sched'} +TOTALFLD := .F. +DISPLEN := 6 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +RETURN FIELDARR + +************************************************* +FUNCTION DEF_ORDERS(WHATRPT) +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 +LOCAL PRTCUSTNAME := .F. +IF EMPTY(WHATRPT) +ELSEIF WHATRPT = 'FULFILLMENT' + PRTCUSTNAME := .T. +ENDIF +FIELDNAME := 'CUST_ID' +COLHEAD := {'Cust ID'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +IF PRTCUSTNAME +//**IF EMPTY(CUST_ID) //** P3N - 08/29/01 +//** FIELDNAME := 'No Customer Found' //** P3N - 08/29/01 +//**ELSE //** P3N - 08/29/01 +//** FIELDNAME := 'GET_COMPNAME(CUST_ID)' //** P3N - 08/29/01 +//**ENDIF //** P3N - 08/29/01 + FIELDNAME := 'GET_COMPNAME(CUST_ID)' //** P3N - 08/29/01 + COLHEAD := {'Company Name'} + TOTALFLD := .F. + DISPLEN := 30 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) +ENDIF + +IF EMPTY(WHATRPT) //** P3N - 08/30/01 + FIELDNAME := 'ORDER_NUM' + COLHEAD := {'Order#'} + TOTALFLD := .F. + DISPLEN := 6 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'CUST_PO' + COLHEAD := {'PO #'} + TOTALFLD := .F. + DISPLEN := 10 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +ENDIF //** P3N - 08/30/01 + +FIELDNAME := 'INVOICENUM' +COLHEAD := {'Invoice'} +TOTALFLD := .F. +DISPLEN := 7 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'DTOC(ORDER_DATE)' +COLHEAD := {'Order','Date'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +IF EMPTY(WHATRPT) //** P3N - 08/30/01 + FIELDNAME := 'DTOC(CALL_DATE)' + COLHEAD := {'Call','Date'} + TOTALFLD := .F. + DISPLEN := 8 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'DTOC(PDATE_LAST)' + COLHEAD := {'Prod','Date'} + TOTALFLD := .F. + DISPLEN := 8 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'DTOC(DDATE_LAST)' + COLHEAD := {'Delivery','Date'} + TOTALFLD := .F. + DISPLEN := 8 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'SLSMAN' + COLHEAD := {'Sold','By'} + TOTALFLD := .F. + DISPLEN := 5 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'TERMS' + COLHEAD := {'Terms'} + TOTALFLD := .F. + DISPLEN := 5 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +ENDIF //** P3N - 08/30/01 + +FIELDNAME := 'SHP_METHOD' +COLHEAD := {'Shp','Mthd'} +TOTALFLD := .F. +DISPLEN := 4 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +IF EMPTY(WHATRPT) //** P3N - 08/30/01 + FIELDNAME := 'DEL_ROUTE' + COLHEAD := {'Rte'} + TOTALFLD := .F. + DISPLEN := 3 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'PRICE_SHT' + COLHEAD := {'Price','Sheet'} + TOTALFLD := .F. + DISPLEN := 5 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'TAXSCH' + COLHEAD := {'Tax','Sch'} + TOTALFLD := .F. + DISPLEN := 6 + DISPDEC := 0 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'STR(ORD_L_TTL,10,2)' + COLHEAD := {' Items',' Total'} + TOTALFLD := .T. + DISPLEN := 10 + DISPDEC := 2 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'STR(ORD_D_TTL,8,2)' + COLHEAD := {' Misc.',' Total'} + TOTALFLD := .T. + DISPLEN := 8 + DISPDEC := 2 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'STR(SALES_TAX,9,2)' + COLHEAD := {' Tax'} + TOTALFLD := .T. + DISPLEN := 9 + DISPDEC := 2 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + **FIELDNAME := 'STR(FREIGHT,8,2)' + **COLHEAD := {' Freight'} + **TOTALFLD := .T. + **DISPLEN := 8 + **DISPDEC := 2 + **AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + FIELDNAME := 'STR(DISCOUNT,6,2)' + COLHEAD := {'Discnt'} + TOTALFLD := .T. + DISPLEN := 6 + DISPDEC := 2 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +ENDIF //** P3N - 08/30/01 + +FIELDNAME := 'STR(TOTAL_AMT,9,2)' +COLHEAD := {' Total',' Amount'} +TOTALFLD := .T. +DISPLEN := 10 +DISPDEC := 2 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + + + +RETURN FIELDARR + +************************************************* +FUNCTION GET_COMPNAME(SEEKKEY) +LOCAL RETVAL +IF CUST_MAST->(DBSEEK(SEEKKEY)) + RETVAL := CUST_MAST->COMP_NAME +ELSEIF EMPTY(SEEKKEY) //** P3N - 08/29/01 + RETVAL := 'NO Customer Found' //** P3N - 08/29/01 +ELSE + RETVAL := 'Cust. ID - ' + TRIM(SEEKKEY) + ' NOT Found!' +ENDIF +RETURN TRIM(RETVAL) +************************************************* +FUNCTION BLD_MOPROD(ACTION) + +LOCAL MORDER_NUM, SEEKKEY, MYEAR, MMONTH, MQUANTITY +LOCAL RANGEBLOCK, MPROD_CODE, M_DATE +LOCAL BARM_FACTOR, XXX := 0,I, SELFILE + + +SELECT ORD_LINES +IF LASTREC() = 1 .OR. EMPTY(RANGEARR) .OR. EMPTY(RANGEARR[1]) + RANGEBLOCK := MAKE_BLOCK( '.T.' ) +ELSE + RANGEBLOCK := MAKE_BLOCK( RANGEARR[1] ) +ENDIF + +DO CASE + CASE ACTION = 'ORDER' + M_DATE = 'ORDER_DATE' + + CASE ACTION = 'PRODUCTION' + M_DATE = 'PDATE_LAST' + + CASE ACTION = 'INVOICING' + M_DATE = 'IDATE_LAST' + + CASE ACTION = 'DELIVER' + M_DATE = 'DDATE_LAST' +END CASE + +FOR I := 1 TO 2 + IF I = 1 + SELFILE := 'ORD_LINES' + ELSE + SELFILE := 'ADDL_LINES' + ENDIF + SELECT (SELFILE) + GOTO TOP + BARM_FACTOR = SETBARM(,, 20, RECCOUNT() ) + XXX = 0 + DO WHILE !EOF() + + XXX++ + BARM_UPDATE(,,XXX, BARM_FACTOR) + IF NEXTKEY() = 27 + INKEY() // GET RID OF ESCAPE KEY + CLOSE DATABASES + RETURN NIL + ENDIF + + IF EMPTY(PROD_CODE) + SKIP 1 + LOOP + ENDIF + + IF !EVAL(RANGEBLOCK) + SKIP 1 + LOOP + ENDIF + + PROD_RPTLINE( SELFILE, M_DATE ) + SKIP 1 + ENDDO +NEXT +RETURN .T. + +******************************************************** +FUNCTION ORD_MAST_DATA( FLDNAME ) + +LOCAL SEEKKEY := ORDER_NUM +ORD_MAST->(DBSEEK(SEEKKEY )) +RETURN ORD_MAST->&FLDNAME + +******************************************************** +FUNCTION PROD_RPTLINE( SELFILE, MDATE ) + +LOCAL SAVESEL := SELECT(), M_DATE, MYEAR, MMONTH, MQUANTITY, MPROD_CODE +LOCAL MLOC_CODE +LOCAL MCOLOR := ' ' //** P3N - 01/16/02 +LOCAL PRODTIME := LEFT(MDATE,1) //** P3N - 01/16/02 +LOCAL MPRODHRS := 0 //** P3N - 01/16/02 + +ORD_MAST->(DBSEEK( (SAVESEL)->ORDER_NUM )) +M_DATE := ORD_MAST->&MDATE +MYEAR = STR(YEAR(M_DATE),4) +MMONTH = LEFT(CMONTH(M_DATE),3) +IF EMPTY(MMONTH) .OR. QUANTITY = 0 + RETURN .F. +ENDIF +MCOLOR := GETCOLOR() //** P3N - 01/16/02 +MPROD_CODE = PROD_CODE +IF PRODTIME == 'P' //** P3N - 01/16/02 + MQUANTITY := GETPRODQTY('QTY') //** P3N - 01/16/02 + MPRODHRS := GETPRODQTY('HRS') //** P3N - 01/16/02 +ELSE //** P3N - 01/16/02 + MQUANTITY := QUANTITY //** P3N - 01/16/02 +ENDIF //** P3N - 01/16/02 +MLOC_CODE = LOC_CODE + +SEEKKEY = MYEAR + MPROD_CODE + MLOC_CODE +SELECT USERFILE7 +SEEK SEEKKEY +IF !FOUND() + ADD_REC() + REPLACE PROD_YEAR WITH MYEAR + REPLACE PROD_CODE WITH MPROD_CODE + REPLACE LOC_CODE WITH MLOC_CODE +ELSE + REC_LOCK() +ENDIF + +REPLACE PROD_COLOR WITH MCOLOR //** P3N - 01/16/02 +REPLACE PROD_HOURS WITH PROD_HOURS + MPRODHRS //** P3N - 01/16/02 +REPLACE &MMONTH WITH &MMONTH + MQUANTITY +REPLACE CAT_CODE WITH GET_CATCODE(MPROD_CODE) +REPLACE ORDER_NUM WITH ORD_MAST->ORDER_NUM +REPLACE THIS_DATE WITH M_DATE + +REPLACE PDATE_LAST WITH ORD_MAST->PDATE_LAST +REPLACE IDATE_LAST WITH ORD_MAST->IDATE_LAST +REPLACE DDATE_LAST WITH ORD_MAST->DDATE_LAST + +UNLOCK + +SELECT (SAVESEL) +RETURN .T. + +******************************************************************** +//** P3N - 01/16/02 ** +//** GET THE PRODUCTION QTY FOR A GIVEN LINE ITEM ** +******************************************************************** +FUNCTION GETPRODQTY(CMD) +LOCAL RETVAL := 0 +LOCAL CURFILE := 'ORD_PROD' +LOCAL SVSEL := ALIAS() +LOCAL SEEKKEY := (SVSEL)->ORDER_NUM + STR((SVSEL)->LINE_NUM,3) +IF (CURFILE)->(DBSEEK(SEEKKEY)) + DO WHILE (CURFILE)->(!EOF()) .AND. ; + (CURFILE)->ORDER_NUM == ORD_LINES->ORDER_NUM .AND. ; + (CURFILE)->LINE_NUM == ORD_LINES->LINE_NUM + IF EMPTY((CURFILE)->COMPL_DATE) + ELSEIF EMPTY(M->RANGE5) .AND. EMPTY(M->RANGE6) + IF CMD == 'QTY' + RETVAL := RETVAL + (CURFILE)->COMPL_QTY + ELSEIF CMD == 'HRS' + RETVAL := RETVAL + (CURFILE)->HOURS + ENDIF + ELSEIF (CURFILE)->COMPL_DATE >= M->RANGE5 .AND. ; + (CURFILE)->COMPL_DATE <= M->RANGE6 + IF CMD == 'QTY' + RETVAL := RETVAL + (CURFILE)->COMPL_QTY + ELSEIF CMD == 'HRS' + RETVAL := RETVAL + (CURFILE)->COMPL_HOURS + ENDIF + ENDIF + (CURFILE)->(DBSKIP(+1)) + ENDDO +ENDIF + +RETURN RETVAL +******************************************************************** +//** P3N - 01/16/02 ** +//** GET THE COLOR FOR A GIVEN LINE ITEM ** +******************************************************************** +FUNCTION GETCOLOR(CMD) +LOCAL RETVAL := '' +LOCAL SVSEL := ALIAS(), CURFILE +LOCAL SEEKKEY := '' +IF ALLTRIM( SVSEL ) == 'ORD_LINES' + CURFILE := 'ORDER_OPTS' +ELSEIF ALLTRIM( SVSEL ) == 'ADDL_LINES' + CURFILE := 'ADDL_OPTS' +ENDIF +IF EMPTY(CMD) .OR. ALLTRIM( SVSEL )$'ORD_LINES ADDL_LINES' + SEEKKEY := ORD_LINES->ORDER_NUM + STR(ORD_LINES->LINE_NUM,3) + IF (CURFILE)->(DBSEEK(SEEKKEY)) + DO WHILE (CURFILE)->(!EOF()) .AND. ; + (CURFILE)->ORDER_NUM == ORD_LINES->ORDER_NUM .AND. ; + (CURFILE)->LINE_NUM == ORD_LINES->LINE_NUM + IF AT('COLOR',(CURFILE)->ATT_CODE) > 0 + RETVAL := (CURFILE)->USER_RESP + ENDIF + (CURFILE)->(DBSKIP(+1)) + ENDDO + ENDIF +ELSEIF CMD == 'PROD_COLOR' + RETVAL := (SVSEL)->PROD_COLOR +ENDIF +RETURN RETVAL +******************************************************************** +// SELECT ORD_MAST +// +// IF LASTREC() = 1 .OR. EMPTY(RANGEARR) .OR. EMPTY(RANGEARR[1]) +// RANGEBLOCK := MAKE_BLOCK( '.T.' ) +// ELSE +// RANGEBLOCK := MAKE_BLOCK( RANGEARR[1] ) +// ENDIF +// +// GO TOP +// BARM_FACTOR = SETBARM(,, 20, RECCOUNT() ) +// DO WHILE EVAL(RANGEBLOCK) .AND. !EOF() +// +// XXX++ +// BARM_UPDATE(,,XXX, BARM_FACTOR) +// +// DO CASE +// CASE ACTION = 'ORDER' +// M_DATE = ORDER_DATE +// +// CASE ACTION = 'PRODUCTION' +// M_DATE = PDATE_LAST +// +// CASE ACTION = 'INVOICING' +// M_DATE = IDATE_LAST +// +// CASE ACTION = 'DELIVER' +// M_DATE = DDATE_LAST +// END CASE +// +// MORDER_NUM = ORDER_NUM +// +// SELECT ORD_LINES +// SEEK MORDER_NUM +// DO WHILE MORDER_NUM = ORDER_NUM .AND. !EOF() +// IF EMPTY(PROD_CODE) +// SKIP 1 +// LOOP +// ENDIF +// +// MYEAR = STR(YEAR(M_DATE),4) +// MMONTH = LEFT(CMONTH(M_DATE),3) +// IF EMPTY(MMONTH) +// SKIP 1 +// LOOP +// ENDIF +// +// MPROD_CODE = PROD_CODE +// MQUANTITY = QUANTITY +// +// SEEKKEY = MYEAR + MPROD_CODE +// SELECT USERFILE7 +// SEEK SEEKKEY +// IF !FOUND() +// ADD_REC() +// REPLACE PROD_YEAR WITH MYEAR +// REPLACE PROD_CODE WITH MPROD_CODE +// ELSE +// REC_LOCK() +// ENDIF +// +// REPLACE &MMONTH WITH &MMONTH + MQUANTITY +// REPLACE CAT_CODE WITH GET_CATCODE(MPROD_CODE) +// REPLACE CAT_CODE WITH GET_CATCODE(MPROD_CODE) +// REPLACE ORDER_NUM WITH ORD_MAST->ORDER_NUM +// REPLACE ORDER_DATE WITH ORD_MAST->ORDER_DATE +// REPLACE PDATE_LAST WITH ORD_MAST->PDATE_LAST +// REPLACE IDATE_LAST WITH ORD_MAST->IDATE_LAST +// REPLACE DDATE_LAST WITH ORD_MAST->DDATE_LAST +// +// UNLOCK +// SELECT ORD_LINES +// SKIP 1 +// ENDDO +// SELECT ORD_MAST +// SKIP 1 +// ENDDO +// RETURN NIL +// +************************************************* +FUNCTION DEF_MOPROD() +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 + +FIELDNAME := 'PROD_YEAR' +COLHEAD := {'Year'} +TOTALFLD := .F. +DISPLEN := 6 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'PROD_CODE' +COLHEAD := {'Product'} +TOTALFLD := .F. +DISPLEN := 9 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'PROD_COLOR' //** P3N - 01/16/02 +COLHEAD := {'Product',' Color'} //** P3N - 01/16/02 +TOTALFLD := .F. //** P3N - 01/16/02 +DISPLEN := 10 //** P3N - 01/16/02 +DISPDEC := 0 //** P3N - 01/16/02 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +IF M->PRODTIME = 2 //** P3N - 01/16/02 + FIELDNAME := 'STR(PROD_HOURS,10,2)' //** P3N - 01/16/02 + COLHEAD := {'Total Prod',' Hours'} //** P3N - 01/16/02 + TOTALFLD := .T. //** P3N - 01/16/02 + DISPLEN := 10 //** P3N - 01/16/02 + DISPDEC := 2 //** P3N - 01/16/02 + AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) +ENDIF //** P3N - 01/16/02 + +FIELDNAME := 'LOC_CODE' +COLHEAD := {'Location'} +TOTALFLD := .F. +DISPLEN := 14 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(JAN,5)' +COLHEAD := {' JAN'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(FEB,5)' +COLHEAD := {' FEB'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(MAR,5)' +COLHEAD := {' MAR'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(APR,5)' +COLHEAD := {' APR'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(MAY,5)' +COLHEAD := {' MAY'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(JUN,5)' +COLHEAD := {' JUN'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(JUL,5)' +COLHEAD := {' JUL'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(AUG,5)' +COLHEAD := {' AUG'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(SEP,5)' +COLHEAD := {' SEP'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(OCT,5)' +COLHEAD := {' OCT'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(NOV,5)' +COLHEAD := {' NOV'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(DEC,5)' +COLHEAD := {' DEC'} +TOTALFLD := .T. +DISPLEN := 5 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'STR(YEAR_END(),10)' +COLHEAD := {' TOTAL'} +TOTALFLD := .T. +DISPLEN := 10 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +RETURN FIELDARR + + +************************************************* +//** P3N - 02/27/02 ** +//** PER LINDAS REQUEST FROM DATADICT PRNT_POS** +************************************************* +FUNCTION DEF_CMRPT() +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 + +FIELDNAME := 'CUST_ID' +COLHEAD := {'Customer','Number'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'COMP_NAME' +COLHEAD := {'Customer','Name'} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +//**FIELDNAME := 'ALLTRIM(CONT_FNAME) + " " + CONT_LNAME' +//**COLHEAD := {'Contact','Name'} +//**TOTALFLD := .F. +//**DISPLEN := 40 +//**AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'CUST_ADDR' +COLHEAD := {'Address '} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'CUST_ADDR2' +COLHEAD := {'Address '} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'CUST_CITY' +COLHEAD := {'City'} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'CUST_STATE' +COLHEAD := {'ST'} +TOTALFLD := .F. +DISPLEN := 2 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'CUST_ZIP' +COLHEAD := {' Zip'} +TOTALFLD := .F. +DISPLEN := 5 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'PHONE' +COLHEAD := {'Phone'} +TOTALFLD := .F. +DISPLEN := 12 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'FAX' +COLHEAD := {'FAX'} +TOTALFLD := .F. +DISPLEN := 12 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'TERMS +"/"+ GETTERMS()' +COLHEAD := {'Terms'} +TOTALFLD := .F. +DISPLEN := 25 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'STR(CREDIT_LIM,12,2)' +COLHEAD := {'Credit Limit'} +TOTALFLD := .F. +DISPLEN := 12 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'SPACE(3)+PRE_BILL' +COLHEAD := {'PreBill'} +TOTALFLD := .F. +DISPLEN := 7 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'SPACE(1)+PICK_DEL' +COLHEAD := {'PU','Del','Ins'} +TOTALFLD := .F. +DISPLEN := 3 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + DEL_ROUTE' +COLHEAD := {'Del', 'Rte'} +TOTALFLD := .F. +DISPLEN := 3 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + GL_CODE' +COLHEAD := {'GL', 'Code'} +TOTALFLD := .F. +DISPLEN := 4 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + + +RETURN FIELDARR +************************************************* +//** P3N - 02/27/02 +************************************************* +FUNCTION GETTERMS() +LOCAL SEEKKEY := CUST_MAST->TERMS +LOCAL RETVAL := 'No TERM ' + ALLTRIM(SEEKKEY) + ' FOUND' +IF TERMS->(DBSEEK(SEEKKEY)) + RETVAL := TERMS->DESC +ENDIF +RETURN RETVAL +************************************************* +FUNCTION BLD_CUSTDEL() +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 + +FIELDNAME := 'CUST_ID' +COLHEAD := {'Customer',' ID'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'COMP_NAME' +COLHEAD := {'Customer','Name'} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'ALLTRIM(CONT_FNAME) + " " + CONT_LNAME' +COLHEAD := {'Contact','Name'} +TOTALFLD := .F. +DISPLEN := 15 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + DEL_ROUTE' +COLHEAD := {'Delivery', ' Route'} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'SHIPNAME' +COLHEAD := {'Shipping', 'Information'} +TOTALFLD := .F. +DISPLEN := 40 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + + +RETURN FIELDARR + + +************************************************* +FUNCTION BLD_CUSTSETUP() +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 + +FIELDNAME := 'CUST_ID' +COLHEAD := {'Customer',' ID'} +TOTALFLD := .F. +DISPLEN := 8 +DISPDEC := 0 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC} ) + +FIELDNAME := 'COMP_NAME' +COLHEAD := {'Customer','Name'} +TOTALFLD := .F. +DISPLEN := 30 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + PICK_DEL' +COLHEAD := {'PU/DEL','Install'} +TOTALFLD := .F. +DISPLEN := 7 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + SHP_METHOD' +COLHEAD := {'Shipping', ' Code'} +TOTALFLD := .F. +DISPLEN := 8 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + SLSMAN' +COLHEAD := {'Salesman'} +TOTALFLD := .F. +DISPLEN := 8 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + TERMS' +COLHEAD := {'Terms'} +TOTALFLD := .F. +DISPLEN := 5 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + PRICE_SHT' +COLHEAD := {'Price', 'Sheet'} +TOTALFLD := .F. +DISPLEN := 5 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := 'TAXSCH' +COLHEAD := {'Sales', ' Tax','Sched'} +TOTALFLD := .F. +DISPLEN := 6 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +**FIELDNAME := 'STR(SLS_TX_PCT,7,4)' +FIELDNAME := 'STR( CALC_STAX( TAXSCH, .F. ),7,4)' +COLHEAD := {'Sales', ' Tax',' %'} +TOTALFLD := .F. +DISPLEN := 6 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +FIELDNAME := '" " + RND_PRICE' +COLHEAD := {'Round', 'Price'} +TOTALFLD := .F. +DISPLEN := 5 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + + + +RETURN FIELDARR + + +************************************************* + + +********************************************************* +FUNCTION SEEKCATDESC(SEEKKEY) +LOCAL SAVESEL := SELECT() +SELECT CATEGORY +DBSEEK(SEEKKEY) +SELECT (SAVESEL) +RETURN ALLTRIM(CATEGORY->DESC) + +************************************************** + +FUNCTION SEEKATTDESC(SEEKKEY) +LOCAL SAVESEL := SELECT() +SELECT ATTRIBUTES +DBSEEK(SEEKKEY) +SELECT (SAVESEL) +RETURN '"' + ALLTRIM(ATTRIBUTES->ATT_CODE) + '"/' + ALLTRIM(ATTRIBUTES->DESC) + +************************************************** +* BUILD THE PRICING REPORT IN A USER FILE +************************************************** + +FUNCTION BLD_PRICERPT(DATAFILE, PKEY, RPT_TYPE, LEVEL ) + +LOCAL PROD_ARR := {}, P_ARR := {}, G_ARR := {}, I, ELM, II +LOCAL ROW_CNT := 0, COL_CNT := 0, CNT_ARR := {}, AS_FILE, P_SOURCE +LOCAL MP_KEY, MP_SK_BLK, MP_FOUND := .F., PCT_STR +LOCAL PE_KEY, PE_SK_BLK, PE_FOUND := .F., P_ARRAY := {}, SEEKKEY +LOCAL CUT_SPEC_ARR, L, L2, MP_ARR + +//* +//* OPEN ALL DBFS TO BE USED TO BUILD THE REPORT +//* +DBOPEN('RULES') +DBOPEN('RULEPACK') +DBOPEN('CUST_ATTS',,,{2}) +DBOPEN('CUST_OPTS',,,{3}) +DBOPEN('PROD_ATTS',,,{2}) +DBOPEN('PROD_OPTS',,,{3}) +DBOPEN('CAT_ATTS',,,{2}) +DBOPEN('CAT_OPTS',,,{3}) +DBOPEN('ATTRIBUTES',,,{1}) +DBOPEN('ATT_OPTS',,,{3}) +DBOPEN('MATHPACK',,,{1}) +DBOPEN('PRI_EXTRAS',,,{2}) +DBOPEN('CUST_PE',,,{1}) +DBOPEN("PRODUCT",,, {1}) // OPEN PRODUCT FILE FO SINGLE INDEX +DBOPEN("CATEGORY",,, {1}) // OPEN CATEGORY FILE FO SINGLE INDEX +DBOPEN("CUT_SPEC") +DBOPEN("ATTRIB_CUT") + +IF LEVEL = 'MODEL' + PR_CUSTID := SPACE(8) +ELSE + PR_CUSTID := CUST_MAST->CUST_ID +ENDIF +PROD_ARR := BUILD_GETARR(PKEY, 2,,,,,,PR_CUSTID) //* GET ALL INFO FOR THE PRICING RPT +P_ARRAY := PROD_ARR[PRICE_ARR] +G_ARR := PROD_ARR[GET_ARR] +AS_FILE := PROD_ARR[ATRB_SRC] +IF SUBS(PROD_ARR[ATRB_SRC], 1, 3) == 'PRO' //PRODUCT LEVEL + P_SOURCE := 'MODEL Level' +ELSEIF SUBS(PROD_ARR[ATRB_SRC], 1, 3) == 'CAT' //CATEGORY LEVEL + P_SOURCE := 'CATEGORY Level' +ELSEIF SUBS(PROD_ARR[ATRB_SRC], 1, 3) == 'CUS' //CATEGORY LEVEL + P_SOURCE := 'CUSTOMER Level' +ELSE + P_SOURCE := 'SYSTEM Level' // SYSTEM LEVEL +ENDIF + +// ADDED BY DON 2-21-94 TO GET DEALER PICKUP DISCOUNT +SELECT CATEGORY +DBSEEK(PRODUCT->CAT_CODE) + +SELECT USERFILE7 +GO TOP +IF RPT_TYPE == 'PRICE' //PRICING REPORT + FOR II := 1 TO LEN(P_ARRAY) + IF LEVEL = 'CUST' .AND. P_ARRAY[II,1] <> CUST_MAST->PRICE_SHT + LOOP + ENDIF + P_ARR := GET_PRICEARR(P_ARRAY, P_ARRAY[II, 1]) + IF EMPTY(P_ARR) + LOOP + ENDIF + IF LEVEL = 'CUST' + REP_VAR := 'Normal Base Price for CUSTOMER ' + PR_CUSTID + ' - (Pick up Discount = ' ; + + STR(CATEGORY->D_PICKDISC, 5,2) + ')' +* ADD_U7(REP_VAR) +* REP_VAR := ' ' +* ADD_U7(REP_VAR) +* LOOP + ELSE + IF P_ARRAY[II, 1] == 'D' //DEALER PRICING + REP_VAR := 'Base Price - DEALER PRICING - (Pick up Discount = ' ; + + STR(CATEGORY->D_PICKDISC, 5,2) + ')' + ELSE + IF VALTYPE(P_ARR) != 'A' // IS THIS AN ARRAY OF ROWS / COLS + // NO - IT IS THE % OF DEALER PRICE + PCT_STR := STR(P_ARR,6,2) + '% ' + ' of Dealer Price' + IF P_ARRAY[II, 1] == 'J' //DISTIBUTER PRICING + REP_VAR := 'Base Price - DISTRIBUTER PRICING - ' + PCT_STR + ELSEIF P_ARRAY[II, 1] == 'L' //LUMBER MAN PRICING + REP_VAR := 'Base Price - LUMBER MAN PRICING - ' + PCT_STR + ELSEIF P_ARRAY[II, 1] == 'B' //BUILDER PRICING + REP_VAR := 'Base Price - BUILDER PRICING - ' + PCT_STR + ELSEIF P_ARRAY[II, 1] == 'S' //SPECIAL DEALER PRICING + REP_VAR := 'Base Price - SPECIAL DEALER PRICING - ' + PCT_STR + ELSEIF P_ARRAY[II, 1] == 'I' //INTERCOMPANY PRICING + REP_VAR := 'Base Price - INTERCOMPANY PRICING - ' + PCT_STR + ELSE //PRICING OPTION NOT FOUND + REP_VAR := 'OPTION NOT FOUND - ' + P_ARR[II, 1] + ENDIF + + ADD_U7(REP_VAR) + REP_VAR := ' ' + ADD_U7(REP_VAR) + LOOP + ELSE + IF P_ARRAY[II, 1] == 'J' //DISTIBUTER PRICING + REP_VAR := 'Base Price - DISTRIBUTER PRICING ' + ELSEIF P_ARRAY[II, 1] == 'L' //LUMBER MAN PRICING + REP_VAR := 'Base Price - LUMBER MAN PRICING ' + ELSEIF P_ARRAY[II, 1] == 'B' //BUILDER PRICING + REP_VAR := 'Base Price - BUILDER PRICING ' + ELSEIF P_ARRAY[II, 1] == 'S' //SPECIAL DEALER PRICING + REP_VAR := 'Base Price - SPECIAL DEALER PRICING ' + ELSEIF P_ARRAY[II, 1] == 'I' //SPECIAL DEALER PRICING + REP_VAR := 'Base Price - INTERCOMPANY PRICING ' + ELSE //PRICING OPTION NOT FOUND + REP_VAR := 'OPTION NOT FOUND - ' + P_ARR[II, 1] + ENDIF + ENDIF + ENDIF + ENDIF + + ADD_U7(REP_VAR) + REP_VAR := SPACE(15) + ' Attributes' + SPACE(5) + ' Options' + SPACE(15) + 'Default Rule' + ADD_U7(REP_VAR) + REP_VAR := SPACE(15) + ' ----------' + SPACE(5) + ' -------' + SPACE(15) + '------- ----' + ADD_U7(REP_VAR) + + FOR I := 1 TO LEN(P_ARR) + IF P_ARR[I, ROW_COL] == 'R' // PROCESS ROWS + ELM := ASCAN(G_ARR, { |X| X[ATRB] == P_ARR[I, ATRB] } ) + IF ELM > 0 + CNT_ARR := BLD_BASE( G_ARR[ELM], P_ARR[I], ROW_CNT, COL_CNT ) + ROW_CNT := CNT_ARR[1] + COL_CNT := CNT_ARR[2] + ENDIF + ENDIF + NEXT + + ROW_CNT := 0 + COL_CNT := 0 + + FOR I := 1 TO LEN(P_ARR) + IF P_ARR[I, ROW_COL] == 'C' // PROCESS COLUMNS + ELM := ASCAN(G_ARR, { |X| X[ATRB] == P_ARR[I, ATRB] } ) + IF ELM > 0 + CNT_ARR := BLD_BASE( G_ARR[ELM], P_ARR[I], ROW_CNT, COL_CNT ) + ROW_CNT := CNT_ARR[1] + COL_CNT := CNT_ARR[2] + ENDIF + ENDIF + NEXT + + ROW_CNT := 0 + COL_CNT := 0 + + NEXT + + BLD_LEGND('1') + +ELSE //PRODUCTION REPORT + + REP_VAR := 'Production Information:' + ADD_U7(REP_VAR) + ADD_U7(' ') + REP_VAR := 'Adjustments:' + ADD_U7(REP_VAR) + REP_VAR := 'SAW Width' + SPACE(5) + 'SAW Height' + SPACE(5) + ; + ' TT Width' + SPACE(5) + ' TT Height' + SPACE(5) + ; + ' NS Width' + SPACE(5) + ' NS Height' + SPACE(5) + ; + ' OS Width' + SPACE(5) + ' OS Height' + SPACE(5) + ADD_U7(REP_VAR) + REP_VAR := '---------' + SPACE(5) + '----------' + SPACE(5) + ; + '---------' + SPACE(5) + '----------' + SPACE(5) + ; + '---------' + SPACE(5) + '----------' + SPACE(5) + ; + '---------' + SPACE(5) + '----------' + SPACE(5) + ADD_U7(REP_VAR) + REP_VAR := STR(PRODUCT->SAW_WIDTH,9,4) + SPACE(5) + STR(PRODUCT->SAW_HEIGHT,10,4) + SPACE(5) + ; + STR(PRODUCT->TT_WIDTH,9,4) + SPACE(5) + STR(PRODUCT->TT_HEIGHT,10,4) + SPACE(5) + ; + STR(PRODUCT->NS_WIDTH,9,4) + SPACE(5) + STR(PRODUCT->NS_HEIGHT,10,4) + SPACE(5) + ; + STR(PRODUCT->OS_WIDTH,9,4) + SPACE(5) + STR(PRODUCT->OS_HEIGHT,10,4) + ADD_U7(REP_VAR) + ADD_U7(' ') + REP_VAR := 'Sizes:' + ADD_U7(REP_VAR) + REP_VAR := 'Storm Width ' + SPACE(2) + 'Storm Hght ' + SPACE(5) + ; + 'Screen Width' + SPACE(2) + 'Screen Hght' + SPACE(5) + ; + 'Glass Width ' + SPACE(2) + 'Glass Hght ' + SPACE(5) + ; + 'Sash Width ' + SPACE(2) + 'Sash Hght ' + ADD_U7(REP_VAR) + REP_VAR := '----------- ' + SPACE(2) + '---------- ' + SPACE(5) + ; + '------------' + SPACE(2) + '-----------' + SPACE(5) + ; + '----------- ' + SPACE(2) + '---------- ' + SPACE(5) + ; + '---------- ' + SPACE(2) + '--------- ' + ADD_U7(REP_VAR) + REP_VAR := SPACE(3) + ; + STR(PRODUCT->STR_WIDTH,8,4) + SPACE(5) + STR(PRODUCT->STR_HEIGHT,8,4) + SPACE(10) + ; + STR(PRODUCT->MACH_SCRNW,8,4) + SPACE(5) + STR(PRODUCT->MACH_SCRNW,8,4) + SPACE(8) + ; + STR(PRODUCT->MACH_GLASW,8,4) + SPACE(5) + STR(PRODUCT->MACH_GLASW,8,4) + SPACE(8) + ; + STR(PRODUCT->MACH_SASHW,8,4) + SPACE(5) + STR(PRODUCT->MACH_SASHW,8,4) + ADD_U7(REP_VAR) +ENDIF + +************************************************** +* BUILD THE PRODUCT OPTIONS PRICING INFO +************************************************** + +REP_VAR := REPLICATE('-', LEN(USERFILE7->DATA) ) +ADD_U7(REP_VAR) +IF RPT_TYPE == 'PRICE' //PRICING REPORT + REP_VAR := 'Product Option Pricing - Attributes are Defined at the ' +ELSE + REP_VAR := 'Product Option Cutting - Attributes are Defined at the ' +ENDIF +REP_VAR := REP_VAR + ALLTRIM(P_SOURCE) +ADD_U7(REP_VAR) +REP_VAR := ' ' +ADD_U7(REP_VAR) + +IF RPT_TYPE == 'PRICE' //PRICING REPORT + REP_VAR := ' Attributes' + ' B/A' + ' Options' + ; + SPACE(21) + '$/Unit ' + SPACE(6) + ' $/UI' + SPACE(5) + ; + ' $/SqFt' + SPACE(5) + ' Default Rule' + SPACE(5) + 'Print Options' + ADD_U7(REP_VAR) + REP_VAR := ' ----------' + ' ---' + ' -------' + ; + SPACE(21) + '------ ' + SPACE(6) + '------' + SPACE(5) + ; + '--------' + SPACE(5) + '------- ----' + SPACE(5) + '-------------' + +ELSE //PRODUCTION REPORT + + REP_VAR := ' Attributes' + ' B/A' + ' Options' + ; + SPACE(17) + 'Width Adj.' + SPACE(2) + 'Height Adj.' + SPACE(3) + ; + 'Default' + SPACE(3) + 'Rule' + SPACE(5) + 'Print Options' + ADD_U7(REP_VAR) + REP_VAR := ' ----------' + ' ---' + ' -------' + ; + SPACE(17) + '----------' + SPACE(2) + '-----------' + SPACE(3) + ; + '-------' + SPACE(3) + '----' + SPACE(5) + '-------------' +ENDIF +ADD_U7(REP_VAR) + +FOR I := 1 TO LEN(G_ARR) + IF EMPTY(G_ARR[I]) + ELSE + REP_VAR := SPACE(1) + BLD_OPT(G_ARR[I], REP_VAR, 'PO', RPT_TYPE) + ENDIF +NEXT + +BLD_LEGND('2') + +************************************************** +* BUILD THE USER NUMERIC INPUT FIELDS +************************************************** + +REP_VAR := REPLICATE('-', LEN(USERFILE7->DATA) ) +ADD_U7(REP_VAR) +REP_VAR := 'User Numeric Input Fields - Attributes are Defined at the ' +REP_VAR := REP_VAR + ALLTRIM(P_SOURCE) +ADD_U7(REP_VAR) +REP_VAR := SPACE(10) + 'User Input Attributes' +ADD_U7(REP_VAR) +REP_VAR := SPACE(10) + '---------------------' +ADD_U7(REP_VAR) + +FOR I := 1 TO LEN(G_ARR) + IF EMPTY( G_ARR[I] ) + ELSE + IF G_ARR[I, OPT_TYP] == 'U' + REP_VAR := SPACE(15) + G_ARR[I, ATRB] + ADD_U7(REP_VAR) + ENDIF + ENDIF +NEXT + + +************************************************** +* BUILD THE SYSTEM CALC FIELDS - MATHPACK +************************************************** +REP_VAR := REPLICATE('-', LEN(USERFILE7->DATA) ) +ADD_U7(REP_VAR) +REP_VAR := 'System Calc. Fields - These Apply to ALL UI Excess Attributes for entire CATEGORY - ' +REP_VAR := REP_VAR + SEEKCATDESC(PRODUCT->CAT_CODE) +ADD_U7(REP_VAR) +REP_VAR := SPACE(15) + 'Calc Attribute' + SPACE(4) + ' Field 1 ' + SPACE(6) + 'Oper' + SPACE(10) + ' Field 2 ' +ADD_U7(REP_VAR) +REP_VAR := SPACE(15) + '--------------' + SPACE(4) + '---------' + SPACE(6) + '----' + SPACE(10) + '---------' +ADD_U7(REP_VAR) + +FOR I := 1 TO LEN(G_ARR) + IF EMPTY( G_ARR[I] ) + ELSE + IF G_ARR[I, OPT_TYP] == 'C' + REP_VAR := SPACE(19) + G_ARR[I, ATRB] + MP_KEY := PRODUCT->CAT_CODE + G_ARR[I, ATRB] + MP_SK_BLK := {|| MATHPACK->CAT_CODE + MATHPACK->ATT_CODE} + MP_FOUND := MATHPACK->(DBSEEK (MP_KEY) ) + IF MP_FOUND + DO WHILE MP_KEY == EVAL(MP_SK_BLK) + REP_VAR := REP_VAR + SPACE(5) + MATHPACK->FIELD1 + SPACE(6) + MATHPACK->OPERATOR + SPACE(15) + MATHPACK->FIELD2 + ADD_U7(REP_VAR) + MATHPACK->(DBSKIP(1)) + REP_VAR := SPACE(29) + ENDDO + ELSE + REP_VAR := REP_VAR + 'NO Calc. Values FOUND' + ADD_U7(REP_VAR) + ENDIF + ENDIF + ENDIF +NEXT + + +IF RPT_TYPE == 'PRICE' //PRICING REPORT +************************************************** +* BUILD THE PRICING EXTRA FIELDS - PRI_EXTRAS +************************************************** + REP_VAR := REPLICATE('-', LEN(USERFILE7->DATA) ) + ADD_U7(REP_VAR) + REP_VAR := 'Pricing Extra Fields Defined for CATEGORY - ' + REP_VAR := REP_VAR + SEEKCATDESC(PRODUCT->CAT_CODE) + ADD_U7(REP_VAR) + REP_VAR := SPACE(5) + ' Extra Option ' + SPACE(5) + ' Rule ' + REP_VAR := REP_VAR + SPACE(5) + 'Price Sheet' + REP_VAR := REP_VAR + SPACE(5) + 'True Value' + SPACE(5) + 'False Value' + REP_VAR := REP_VAR + SPACE(5) + ' $ / Unit ' + SPACE(5) + ' $ / UI ' + REP_VAR := REP_VAR + SPACE(5) + ' $ / SqFt ' + ADD_U7(REP_VAR) + REP_VAR := SPACE(5) + '---------------- ' + SPACE(5) + ' ---- ' + REP_VAR := REP_VAR + SPACE(5) + '-----------' + REP_VAR := REP_VAR + SPACE(5) + '----------' + SPACE(5) + '-----------' + REP_VAR := REP_VAR + SPACE(5) + ' -------- ' + SPACE(5) + ' ------- ' + REP_VAR := REP_VAR + SPACE(5) + ' -------- ' + ADD_U7(REP_VAR) + + + PE_KEY := PRODUCT->CAT_CODE + PE_SK_BLK := {|| PRI_EXTRAS->CAT_CODE } + PE_FOUND := PRI_EXTRAS->(DBSEEK (PE_KEY) ) + IF PE_FOUND + DO WHILE PE_KEY == EVAL(PE_SK_BLK) + REP_VAR := STR(PRI_EXTRAS->SEQ_NUM,2) + '. '+ PRI_EXTRAS->OPTION + SPACE(5) + REP_VAR := REP_VAR + PRI_EXTRAS->RULE_PACK + SPACE(5) + REP_VAR := REP_VAR + PRI_EXTRAS->PRICE_SHT + SPACE(7) + REP_VAR := REP_VAR + PRI_EXTRAS->TRUE_VAL + SPACE(5) + REP_VAR := REP_VAR + PRI_EXTRAS->FALSE_VAL + SPACE(6) + REP_VAR := REP_VAR + TRANSFORM(PRI_EXTRAS->UNIT_SALE, '99,999.99') + SPACE(6) + //** P3N - 6/9/98 UPDATED TO ALLOW UI/SQFT PRICING @ .01 CENT + REP_VAR := REP_VAR + TRANSFORM(PRI_EXTRAS->UI_SALE, '99,999.9999') + SPACE(4) + REP_VAR := REP_VAR + TRANSFORM(PRI_EXTRAS->SQFT_SALE, '99,999.9999') +******REP_VAR := REP_VAR + TRANSFORM(PRI_EXTRAS->UI_SALE, '99,999.99') + SPACE(6) +******REP_VAR := REP_VAR + TRANSFORM(PRI_EXTRAS->SQFT_SALE, '99,999.99') + ADD_U7(REP_VAR) + + SEEKKEY := PRI_EXTRAS->CAT_CODE + PRI_EXTRAS->OPTION + CUST_PE->(DBSEEK(SEEKKEY) ) + DO WHILE CUST_PE->CAT_CODE + CUST_PE->OPTION == SEEKKEY .AND. !EOF() + IF EMPTY(PR_CUSTID) .OR. CUST_PE->CUST_ID == PR_CUSTID + REP_VAR := SPACE(41) + '* ' + CUST_PE->CUST_ID + ' *' + ADD_U7(REP_VAR) + ENDIF + CUST_PE->(DBSKIP(1)) + ENDDO + PRI_EXTRAS->(DBSKIP(1)) + ENDDO + ELSE + REP_VAR := 'NO Pricing Extras FOUND' + ADD_U7(REP_VAR) + ENDIF + +ENDIF + + +************************************************** +* BUILD THE CUTTING SPEC ARRAY AND PRINT IT +************************************************** +IF LEVEL == 'MODEL' //MODEL CUTTING REPT + REP_VAR := REPLICATE('-', LEN(USERFILE7->DATA) ) + ADD_U7(REP_VAR) + REP_VAR = 'Cutting Specifications' + ADD_U7(REP_VAR) + + REP_VAR = 'ATTRIBUTE DESC' + SPACE(22) + 'CODE PROFILE SEQ# QTY RULE PRINT ON' + REP_VAR = REP_VAR + ' Field 1 ' + SPACE(2) + 'Oper' + SPACE(1) + 'Field 2' + ADD_U7(REP_VAR) + REP_VAR = '---------- ------------------------- ------ ------- ---- --- ------- --------' + REP_VAR = REP_VAR + ' ---------' + SPACE(1) + '----' + SPACE(1) + '---------' + ADD_U7(REP_VAR) + + CUT_SPEC_ARR := GET_CUT_SPEC( PKEY ) + FOR L = 1 TO LEN(CUT_SPEC_ARR) + REP_VAR = CUT_SPEC_ARR[L,1] + ' ' // ATT_CODE + REP_VAR = REP_VAR + CUT_SPEC_ARR[L,10] + ' ' // DESC + REP_VAR = REP_VAR + CUT_SPEC_ARR[L,4] + ' ' // PRNT CODE + REP_VAR = REP_VAR + CUT_SPEC_ARR[L,5] + ' ' // PROFILE + REP_VAR = REP_VAR + STR(CUT_SPEC_ARR[L,2],4) + ' ' // SEQ # + REP_VAR = REP_VAR + STR(CUT_SPEC_ARR[L,3],3) + ' ' // QTY + REP_VAR = REP_VAR + CUT_SPEC_ARR[L,8] + ' ' // RULE + REP_VAR = REP_VAR + CUT_SPEC_ARR[L,9] + ' ' // PRINT ON + + MP_ARR := {} + SEEKKEY = PRODUCT->PROD_CODE + CUT_SPEC_ARR[L,1] // MATH PACK + SELECT MATHPACK + SEEK SEEKKEY + DO WHILE SEEKKEY == CAT_CODE + ATT_CODE + IF TYPE = 'C' // CUTTING SPEC MATH PATH + AADD(MP_ARR, FIELD1 + SPACE(2) + OPERATOR + SPACE(2) + FIELD2) + ENDIF + SKIP 1 + ENDDO + IF !EMPTY(MP_ARR) + FOR L2 = 1 TO LEN(MP_ARR) + IF L2 = 1 // IF IT'S THE FIRST LINE + REP_VAR = REP_VAR + SPACE(1) + MP_ARR[L2] + ELSE + REP_VAR = SPACE(78) + MP_ARR[L2] + ENDIF + ADD_U7(REP_VAR) + NEXT + ELSE + ADD_U7(REP_VAR) + ENDIF + NEXT + +ENDIF + +REP_VAR := REPLICATE('-', LEN(USERFILE7->DATA) ) +ADD_U7(REP_VAR) +RETURN P_SOURCE + +************************************************** +* BUILD THE BASE PRICING REPORT INFO +************************************************** + +PROCEDURE BLD_BASE(G_ARR, P_ARR, ROW_CNT, COL_CNT) +LOCAL REP_VAR := ' ', I + +IF P_ARR[ROW_COL] == 'R' .AND. ROW_CNT < 1 + ROW_CNT ++ + REP_VAR := SPACE(2) + 'ROWS ' +ELSEIF P_ARR[ROW_COL] == 'C' .AND. COL_CNT < 1 + COL_CNT ++ + REP_VAR := SPACE(2) + 'COLUMNS ' +ELSE + REP_VAR := SPACE(10) +ENDIF + +BLD_OPT(G_ARR, REP_VAR, 'BP') + +RETURN {ROW_CNT, COL_CNT} + + +************************************************** +* FIND ALL OPTIONS IN THE OPT_ARR - G_ARR[3] +************************************************** +PROCEDURE BLD_OPT ( G_ARR, REP_VAR, TYP, RPT_TYPE ) +*-LOCAL I, OPT_SOURCE +LOCAL I, OPT_SOURCE, MSEQUENCE +IF EMPTY( G_ARR[OPT_ARR] ) .OR. G_ARR[OPT_TYP]$'CU' +ELSE + + // MSL +*-REP_VAR := REP_VAR + SPACE(9) + G_ARR[ATRB] + + + + //// MIKE LEWIS CHANGE 2/21/94 + // MOVED THE FOLLOWING TO END OF ATTRIBUTE + + IF SUBS(G_ARR[OPT_SRC], 1, 3) == 'PRO' + OPT_SOURCE := '(M) ' + ELSEIF SUBS(G_ARR[OPT_SRC], 1, 3) == 'CAT' + OPT_SOURCE := '(C) ' + ELSEIF SUBS(G_ARR[OPT_SRC], 1, 3) == 'CUS' + OPT_SOURCE := '(U) ' + ELSE + OPT_SOURCE := '(S) ' + ENDIF + + IF TYP == 'BP' + REP_VAR := REP_VAR + SPACE(5) + OPT_SOURCE + G_ARR[ATRB] + ELSEIF TYP == 'PO' + REP_VAR := REP_VAR + OPT_SOURCE + G_ARR[ATRB] + ' (' + G_ARR[BAFLAG] + ')' + ENDIF + + + FOR I := 1 TO LEN(G_ARR[OPT_ARR]) + //// MIKE LEWIS CHANGE 2/21/94 + // PUTTING THE SEQUENCE NUMBER OF OPTION WHERE THE SOURCE WAS! + MSEQUENCE = STR(G_ARR[OPT_ARR,I,5],2) + '. ' // SEQUENCE OF OPTIONS + IF TYP == 'BP' // BASE PRICE + REP_VAR := REP_VAR + SPACE(5) + MSEQUENCE + G_ARR[OPT_ARR, I, OPT_DESC] + REP_VAR := REP_VAR + SPACE(4) + G_ARR[OPT_ARR, I, OPT_DEF] + REP_VAR := REP_VAR + SPACE(5) + G_ARR[OPT_ARR, I, OPT_RULE] + ADD_U7(REP_VAR) + REP_VAR := SPACE(29) + ELSEIF TYP == 'PO' // PRICING OPTIONS + REP_VAR := REP_VAR + SPACE(3) + MSEQUENCE + G_ARR[OPT_ARR, I, OPT_DESC] + + IF RPT_TYPE == 'PRICE' //PRICING REPORT + REP_VAR := REP_VAR + SPACE(3) + TRANSFORM(G_ARR[OPT_ARR, I, OPT_AMTS, OA_PRICE], '9,999.99') + REP_VAR := REP_VAR + SPACE(3) + TRANSFORM(G_ARR[OPT_ARR, I, OPT_AMTS, OA_UI], '9,999.9999') + REP_VAR := REP_VAR + SPACE(3) + TRANSFORM(G_ARR[OPT_ARR, I, OPT_AMTS, OA_SQFT], '9,999.9999') + ELSE //PRODUCT REPORT + REP_VAR := REP_VAR + SPACE(3) + TRANSFORM(G_ARR[OPT_ARR, I, OPT_WADJ], '999.9999') + REP_VAR := REP_VAR + SPACE(3) + TRANSFORM(G_ARR[OPT_ARR, I, OPT_HADJ], '999.9999') + ENDIF + + REP_VAR := REP_VAR + SPACE(8) + G_ARR[OPT_ARR, I, OPT_DEF] + REP_VAR := REP_VAR + SPACE(6) + G_ARR[OPT_ARR, I, OPT_RULE] + IF EMPTY( G_ARR[OPT_ARR, I, OPT_PIND] ) + ELSE + REP_VAR := REP_VAR + SPACE(3) + '(' + G_ARR[OPT_ARR, I, OPT_PIND] + ')' + REP_VAR := REP_VAR + SPACE(1) + G_ARR[OPT_ARR, I, OPT_PVAL] + ENDIF + ADD_U7(REP_VAR) + REP_VAR := SPACE(20) + ENDIF + + NEXT + ADD_U7(REP_VAR) +ENDIF +RETURN +************************************************** +* CREATE THE LEGEND FOR THE REPORTS +************************************************** +PROCEDURE BLD_LEGND(OPT) +LOCAL REP_VAR +IF OPT == '1' + REP_VAR := SPACE(15) + '(S) - SYSTEM Option ' +ELSE + REP_VAR := SPACE(1) + '(S) - SYSTEM Option ' + SPACE(76) + '(A) - ALWAYS Print' +ENDIF +ADD_U7(REP_VAR) + +IF OPT == '1' + REP_VAR := SPACE(15) + '(C) - CATEGORY Option ' +ELSE + REP_VAR := SPACE(1) + '(C) - CATEGORY Option ' + SPACE(76) + '(N) - NEVER Print' +ENDIF +ADD_U7(REP_VAR) + +IF OPT == '1' + REP_VAR := SPACE(15) + '(M) - MODEL Option ' +ELSE + REP_VAR := SPACE(1) + '(M) - MODEL Option ' + SPACE(76) + '(D) - Print If DEFAULT' +ENDIF +ADD_U7(REP_VAR) + +IF OPT == '1' + REP_VAR := SPACE(15) + '(U) - USER DEFINED Special Pricing Option' +ELSE + REP_VAR := SPACE(1) + '(U) - USER DEFINED Special Pricing Option ' + SPACE(56) + '(E) - Print If NOT DEFAULT' +ENDIF +ADD_U7(REP_VAR) + +* IF OPT == '1' +* ELSE +* REP_VAR := SPACE(99) + '(E) - Print If NOT Default' +* ADD_U7(REP_VAR) +* ENDIF +RETURN +************************************************** +* ADD THE INFORMATION INTO THE USER FILE +************************************************** +PROCEDURE ADD_U7(REP_VAR) +LOCAL SAVESEL := SELECT() +SELECT USERFILE7 +ADD_REC(5) +REPLACE DATA WITH REP_VAR +SELECT(SAVESEL) +RETURN +************************************************** +* DEFINE THE PRICING REPORT USERFILE LAYOUT AND HEADINGS FOR RPRIN-REPORT GENERATOR +************************************************** +FUNCTION FLD_PRICERPT(RPT_TYPE, LEVEL) +//* FUNCTION FLD_PRICERPT(ATRB_SOURCE) +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 +LOCAL HEAD1, HEAD2, HEAD3, HEAD4, HEAD5 +LOCAL DBF_FLD_INFO := {} + +WAIT_BOX(' *** Retreiving Model Definitions *** ',; + ' *** PLEASE WAIT ***') + +// THIS IS REALLY A BLD_PROC PARAMETER ?? +ATRB_SOURCE := BLD_PRICERPT('USERFILE7', PRODUCT->PROD_CODE, RPT_TYPE, LEVEL) + +FIELDNAME := 'DATA' +HEAD1 := [ 'Category - ' + ALLTRIM(PRODUCT->CAT_CODE) + ' / ' + SEEKCATDESC(PRODUCT->CAT_CODE) ] +HEAD2 := [ 'Model - ' + ALLTRIM(PRODUCT->PROD_CODE) + ' / ' + ALLTRIM(PRODUCT->DESC) ] +HEAD3 := 'Attributes are Defined at the ' + ATRB_SOURCE +IF LEVEL = 'CUST' + HEAD4 := 'Customer - ' + ALLTRIM(CUST_MAST->COMP_NAME) + ' Phone - ' + CUST_MAST->PHONE + ' Fax - ' + CUST_MAST->FAX +ELSE + HEAD4 := ' ' +ENDIF +IF LEVEL = 'CUST' + HEAD5 := ' ' + ALLTRIM(CUST_MAST->CUST_CITY) + ' ' + ALLTRIM(CUST_MAST->CUST_STATE) + ' ' + CUST_MAST->CUST_ZIP +ELSE + HEAD5 := ' ' +ENDIF +COLHEAD := {&HEAD1, &HEAD2, HEAD3, HEAD4, HEAD5} +TOTALFLD := .F. +DISPLEN := 130 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +RETURN FIELDARR + +************************************************** +* DEFINE THE PRODUCT PRICING REPORT USERFILE LAYOUT +* AND HEADINGS FOR RPRIN-REPORT GENERATOR +************************************************** +FUNCTION BASEPRICE() +//* FUNCTION FLD_PRICERPT(ATRB_SOURCE) +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 +LOCAL HEAD1, HEAD2, HEAD3 +LOCAL DBF_FLD_INFO := {} + +WAIT_BOX(' *** Retreiving Model Definitions *** ',; + ' *** PLEASE WAIT ***') + + +FIELDNAME := 'DATA' +HEAD1 := [ 'Category - "' + ALLTRIM(PRODUCT->CAT_CODE) + '" / ' + SEEKCATDESC(PRODUCT->CAT_CODE) ] +HEAD2 := ' ' +COLHEAD := {&HEAD1, HEAD2} +TOTALFLD := .F. +DISPLEN := 131 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +RETURN FIELDARR + + + +*********************************** +FUNCTION BLD_RULERPT +// BUILD REPORT FOR RULE VERIFICATION AND ASSIGNMENT + +LOCAL FIELDARR := {} +LOCAL FIELDNAME, COLHEAD, TOTALFLD, DISPLEN, DISPDEC := 0 +LOCAL HEAD1, HEAD2, HEAD3 +LOCAL DBF_FLD_INFO := {} +LOCAL FLD_ARR := {}, MSG + +WAIT_BOX(' *** Verifying Rule Definitions *** ',; + ' *** PLEASE WAIT ***') + +FIELDNAME := 'DATA' +HEAD1 := 'RULE VERIFICATION' +HEAD2 := '' +HEAD3 := '' +COLHEAD := {HEAD1, HEAD2, HEAD3} +TOTALFLD := .F. +DISPLEN := 120 +AADD(FIELDARR, {FIELDNAME, COLHEAD, TOTALFLD, DISPLEN} ) + +//* +//* OPEN ALL DBFS TO BE USED TO BUILD THE REPORT +//* +DBOPEN('RULES') +DBOPEN('RULEPACK') +DBOPEN('PROD_ATTS',,,{2}) +DBOPEN('PROD_OPTS',,,{3}) +DBOPEN('CAT_ATTS',,,{2}) +DBOPEN('CAT_OPTS',,,{3}) +DBOPEN('ATT_OPTS',,,{3}) +DBOPEN('PRI_EXTRAS',,,{2}) +DBOPEN("PRODUCT",,, {1}) // OPEN PRODUCT FILE FO SINGLE INDEX +DBOPEN("CATEGORY",,, {1}) // OPEN CATEGORY FILE FO SINGLE INDEX +DBOPEN("STD_SIZES",,, {1}) + + +// RESET THE UPDATED FLAGS IN BOTH RULE FILES +SELECT RULES +FIL_LOCK(1) +REPLACE ALL UPDATED WITH ' ' +UNLOCK + +SELECT RULEPACK +FIL_LOCK(1) +REPLACE ALL UPDATED WITH ' ' +UNLOCK + + +// CHECK THE PRODUCT FILE +AADD(FLD_ARR, {'Stock Product ', 'PROD_CODE'}) +VERIFY_RULE('PRODUCT', FLD_ARR) //** PERRY 2-17-98 +** VERIFY_RULE('PRI_EXTRAS', FLD_ARR) + +// CHECK THE PRICING EXTRA FILE +FLD_ARR := {} //** PERRY 2-17-98 +AADD(FLD_ARR, {'Category ', 'CAT_CODE'}) +AADD(FLD_ARR, {'Option ', 'OPTION'}) +VERIFY_RULE('PRI_EXTRAS', FLD_ARR) + +// CHECK THE PRODUCT ATTRIBUTES +FLD_ARR := {} +AADD(FLD_ARR, {'Model', 'PROD_CODE'}) +AADD(FLD_ARR, {'Attribute', 'ATT_CODE'}) +VERIFY_RULE('PROD_ATTS', FLD_ARR) + + +// CHECK THE CATEGORY ATTRIBUTES +FLD_ARR := {} +AADD(FLD_ARR, {'Category ', 'CAT_CODE'}) +AADD(FLD_ARR, {'Attribute', 'ATT_CODE'}) +VERIFY_RULE('CAT_ATTS', FLD_ARR) + + +// CHECK THE ATTRIBUTE OPTIONS +FLD_ARR := {} +AADD(FLD_ARR, {'Attribute ', 'ATT_CODE'}) +AADD(FLD_ARR, {'Option ', 'OPT_VALUE'}) +VERIFY_RULE('ATT_OPTS', FLD_ARR) + + +// CHECK THE PRODUCT OPTIONS +FLD_ARR := {} +AADD(FLD_ARR, {'Model ', 'PROD_CODE'}) +AADD(FLD_ARR, {'Attribute ', 'ATT_CODE'}) +AADD(FLD_ARR, {'Option ', 'OPT_VALUE'}) +VERIFY_RULE('PROD_OPTS', FLD_ARR) + + +// CHECK THE CATEGORY OPTIONS +FLD_ARR := {} +AADD(FLD_ARR, {'Category ', 'CAT_CODE'}) +AADD(FLD_ARR, {'Attribute ', 'ATT_CODE'}) +AADD(FLD_ARR, {'Option ', 'OPT_VALUE'}) +VERIFY_RULE('CAT_OPTS', FLD_ARR) + +// SEE IF ALL RULES ARE BEING USED +SELECT RULES +GOTO TOP +DO WHILE !EOF() + IF UPDATED <> 'Y' + MSG = 'Rule ' + ALLTRIM(RULE_CODE) + ' in the Rule File is not assigned' + ADD_U7(MSG) + ENDIF + SKIP 1 +ENDDO + +// SEE IF ALL RULES HAVE A RULEPACK +SELECT RULEPACK +GOTO TOP +DO WHILE !EOF() + IF UPDATED <> 'Y' + MSG = 'Rule ' + ALLTRIM(RULE_CODE) + ' in the Rule PACK File is not assigned' + ADD_U7(MSG) + ENDIF + SKIP 1 +ENDDO + + +RETURN FIELDARR + +************************************************ +FUNCTION VERIFY_RULE(MFILE, FLD_ARR, FLD2CHECK) +// CHECK RULES FOR FOR MFILE + +LOCAL MRULE_PACK + +IF FLD2CHECK = NIL + FLD2CHECK := 'RULE_PACK' +ENDIF + +SELECT &MFILE +DO WHILE !EOF() + IF !EMPTY(&FLD2CHECK) + MRULE_PACK = &FLD2CHECK + SELECT RULES + SEEK MRULE_PACK + IF !FOUND() + REPORT_IT(MFILE, 'RULES', FLD_ARR, FLD2CHECK) + ELSE + REC_LOCK(1) + REPLACE UPDATED WITH 'Y' + UNLOCK + + SELECT RULEPACK + SEEK MRULE_PACK + IF !FOUND() + REPORT_IT(MFILE, 'RULEPACK', FLD_ARR, FLD2CHECK) + ELSE + DO WHILE RULE_CODE == MRULE_PACK .AND. !EOF() + REC_LOCK(1) + REPLACE UPDATED WITH 'Y' + UNLOCK + SKIP 1 + ENDDO + ENDIF + ENDIF + ENDIF + SELECT &MFILE + SKIP 1 +ENDDO +RETURN + + +************************************************ +FUNCTION REPORT_IT(MFILE1, MFILE2, FLD_ARR, FLD2CHECK) +// ADD A RECORD TO THE REPORT FILE + +LOCAL SAVESEL := SELECT(), REPTLINE, MSG:= ' ', MFIELD + +SELECT USERFILE7 +ADD_REC(1) + +FOR L = 1 TO LEN(FLD_ARR) + MFIELD = FLD_ARR[L,2] + MSG = MSG + FLD_ARR[L,1] + ALLTRIM(&MFILE1->&MFIELD) + ', ' +NEXT + +**REPTLINE = 'Rule ' + ALLTRIM(&MFILE1->RULE_PACK) + ',' + MSG +REPTLINE = 'Rule ' + ALLTRIM(&MFILE1->&FLD2CHECK) + ',' + MSG +REPTLINE = REPTLINE + ' in the ' + MFILE1 + " wasn't Found in the " + MFILE2 + ' File' + +REPLACE DATA WITH REPTLINE +SELECT(SAVESEL) +RETURN + +********************************************************** +FUNCTION YEAR_END +// RETURN TOTAL OF ALL THE MONTHLY BUCKETS FOR 'MONTHLY PRODUCTION REPORT' + +LOCAL RETVAL + +RETVAL = USERFILE7->JAN + USERFILE7->FEB + USERFILE7->MAR + USERFILE7->APR +RETVAL = RETVAL + USERFILE7->MAY + USERFILE7->JUN + USERFILE7->JUL + USERFILE7->AUG +RETVAL = RETVAL + USERFILE7->SEP + USERFILE7->OCT + USERFILE7->NOV + USERFILE7->DEC + +RETURN RETVAL + \ No newline at end of file diff --git a/CGW0400.PRG b/CGW0400.PRG new file mode 100644 index 0000000..b565e12 --- /dev/null +++ b/CGW0400.PRG @@ -0,0 +1,210 @@ +* DON LOWENSTEIN -BUILD LABEL FILE ARRAY- CGW0400 9-5-95 + +PROCEDURE BUILDLBL(CALLPARM) + +LOCAL CONVKEYX, FILEPARMS, LGET_KEY, FLD_INFO:={}, SAVESEL := SELECT() +LOCAL WORKVAR, SAVESCR, MARR, NEW_OLD, ONE_MANY, PRES_TREAS + + +PRIVATE PRNTARR := {}, PARENTFILE, CHILDFILE, MDESC, CUTOFF, PIC, FILEFILTER +PRIVATE PRNTNAME, KEYVAR, RANGETYPE, NDXEXP, RANGEARR := {}, LVLBRK, SORTARR := {} +PRIVATE PARENTFILTER := NIL, REPTHEAD, DEFINEPROC:= NIL +**PRIVATE DET_SUMM := .F., DET_LINE_EXTRA := {}, FOOTERLINES := {} +PRIVATE _TOFILE := .F., DET_LINE_EXTRA := {}, FOOTERLINES := {} +PRIVATE LBRK_FOOTER := {} +PRIVATE REPTONLY := .F., BLD_PROC // 13-15 +PRIVATE DBF_FLD_INFO := {} +PRIVATE LABELFILE := NIL +PRIVATE OUTPORT := NIL +PRIVATE NUMLBLS := 1 +PRIVATE NUMBATCH := 1 +PRIVATE MGET_KEY +PUBLIC LBL_DATA := CALLPARM + +CALLPARM = UPPER(ALLTRIM(CALLPARM)) + +DO CASE + +******************************************************************* + + CASE CALLPARM = 'CUSTOMER' + // + + PRNTNAME = 'CUSTOMER LABELS' + IF CALLPARM = 'CUSTOMER-MANY' + PARENTFILE = 'CUST_MAST' + ELSE + FILEPARMS := DBOPEN('CUST_MAST') + CLS + SAYTITLE(PRNTNAME, 'LABEL') + LGET_KEY := GET_KEY(FILEPARMS) + IF LASTKEY() = 27 .OR. EMPTY(LGET_KEY) + RETURN NIL + ENDIF + IF SELECT('USERFILEX') > 0 + CLOSE USERFILEX + ENDIF + COPY NEXT 1 TO &USERFILEX + PARENTFILE := 'USERFILEX' + ENDIF + IF CALLPARM == "CUSTOMER-MANY-SHIP" .OR. ; + CALLPARM == "CUSTOMER-ONE-SHIP" + DEFINEPROC := {|| SHP_CUSTLBL() } + ELSE + DEFINEPROC := {|| BLD_CUSTLBL() } + ENDIF + LABELFILE := WHICH_LABEL() + IF LABELFILE = NIL + RETURN NIL + ENDIF + + + IF CALLPARM = 'CUSTOMER-MANY' + + MDESC = 'Cust#' + PIC = '' + KEYVAR = 'CUST_ID' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = 1 + NDXEXP = 'CUST_ID' + LVLBRK = {} + AADD(SORTARR, {'Cust#', KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Name' + PIC = '' + KEYVAR = 'COMP_NAME' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = 2 + NDXEXP = 'COMP_NAME' + LVLBRK = {} + AADD(SORTARR, {'Name', KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + + MDESC = 'ZIP Code' + PIC = '' + KEYVAR = 'CUST_ZIP' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + NDXEXP = 'CUST_ZIP+COMP_NAME' + LVLBRK = {} + AADD(SORTARR, {'ZIP Code', KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'State' + PIC = '!!' + KEYVAR = 'CUST_STATE' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Salesman' + PIC = '' + KEYVAR = 'SLSMAN' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Terms Code' + PIC = '' + KEYVAR = 'TERMS' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Delivery Route' + PIC = '' + KEYVAR = 'DEL_ROUTE' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Price Sheet' + PIC = '' + KEYVAR = 'PRICE_SHT' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + MDESC = 'Tax Schedule' + PIC = '' + KEYVAR = 'TAXSCH' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + AADD(RANGEARR, {MDESC, KEYVAR, PIC, RANGETYPE, CUTOFF}) + + ELSE + + MDESC = 'One LABEL for Customer - ' + CUST_MAST->CUST_ID + PIC = '' + KEYVAR = 'CUST_ID' + RANGETYPE = 'R' + CUTOFF = .F. + SYSNTX = NIL + NDXEXP = 'CUST_ID' + LVLBRK = {} + AADD(SORTARR, {MDESC, KEYVAR, NDXEXP, SYSNTX, LVLBRK}) + + ENDIF + + PRNTARR := LOAD_LBLARR() + +************************************************************************ + + + OTHERWISE + PRNTARR := NIL +ENDCASE + +RETURN PRNTARR + +********************************************************** + +FUNCTION WHICH_LABEL() + +// GET WHICH LABELS +LOCAL SAVESCR := SAVESCREEN() +LOCAL MARR := {}, WORKVAR, LABELFILE + +@ 02,0 CLEAR +AADD(MARR,'Standard labels, 3 across, 5 Lines ( 15/16")') +AADD(MARR,'Laser labels, 3 across, 5 Lines') +AADD(MARR,'Standard labels, 1 across, 8 Lines (1 7/16")') +AADD(MARR,'Standard labels, 1 across, 5 Lines ( 15/16") ') +// +WORKVAR = PICKLIST(MARR,10,, 'Which Labels?') +IF LASTKEY() = 27 + RETURN NIL +ENDIF + +IF WORKVAR = 1 + LABELFILE = 'LBL3X1' // { 'LBL3X1', LBL_SIZE } // LBL_TYPE 9 IS A MESSAGE '1 ACROSS, 2 X 3 +ELSE + IF WORKVAR = 2 + LABELFILE = 'CGWLBL7' // laser labels + ELSE // 8 lines + IF WORKVAR = 3 + LABELFILE = 'CGWLBL9' // 5 lines - BIG + ELSE + IF WORKVAR = 4 + LABELFILE = 'CGWLBL2' // 5 lines - LITTLE + ELSE + LABELFILE := NIL + ENDIF + ENDIF + ENDIF +ENDIF +RESTSCREEN(,,,,SAVESCR) +RETURN LABELFILE + + \ No newline at end of file diff --git a/CGW0450.PRG b/CGW0450.PRG new file mode 100644 index 0000000..bb54293 --- /dev/null +++ b/CGW0450.PRG @@ -0,0 +1,50 @@ +// ufd0450 - don and mike - 03-02-95 LABEL LINE DEFINITIONS +************************************************* + +********************************************************* +* Customer Mailing lables - Cusomter BILLING address. * +********************************************************* +FUNCTION BLD_CUSTLBL() + +LOCAL LBL_LINEARR := {} +LOCAL EVALLINE + +EVALLINE := 'COMP_NAME' +AADD(LBL_LINEARR, EVALLINE) + +EVALLINE := 'CUST_ADDR' +AADD(LBL_LINEARR, EVALLINE) + +EVALLINE := 'CUST_ADDR2' +AADD(LBL_LINEARR, EVALLINE) + +EVALLINE := 'TRIM(CUST_CITY)+" "+ CUST_STATE +" " + CUST_ZIP' +AADD(LBL_LINEARR, EVALLINE) + +RETURN LBL_LINEARR + + +********************************************************** +* Customer Mailing lables - Cusomter SHIPPING address. * +********************************************************** +FUNCTION SHP_CUSTLBL() + +LOCAL LBL_LINEARR := {} +LOCAL EVALLINE + +EVALLINE := 'COMP_NAME' +AADD(LBL_LINEARR, EVALLINE) + +EVALLINE := 'SHIPADD1' +AADD(LBL_LINEARR, EVALLINE) + +**EVALLINE := 'SHIPADD2' +**AADD(LBL_LINEARR, EVALLINE) + +EVALLINE := 'TRIM(SHIPADD2)+" "+ SHIPST +" " + SHIPZIP' +AADD(LBL_LINEARR, EVALLINE) + +RETURN LBL_LINEARR + + + \ No newline at end of file diff --git a/CGW0AC.NTX b/CGW0AC.NTX new file mode 100644 index 0000000..54c7ab1 Binary files /dev/null and b/CGW0AC.NTX differ diff --git a/CGW0AO.NTX b/CGW0AO.NTX new file mode 100644 index 0000000..14d9230 Binary files /dev/null and b/CGW0AO.NTX differ diff --git a/CGW0AR.NTX b/CGW0AR.NTX new file mode 100644 index 0000000..f6c8f6c Binary files /dev/null and b/CGW0AR.NTX differ diff --git a/CGW0AT.NTX b/CGW0AT.NTX new file mode 100644 index 0000000..682ea3d Binary files /dev/null and b/CGW0AT.NTX differ diff --git a/CGW0BP.NTX b/CGW0BP.NTX new file mode 100644 index 0000000..385d1a5 Binary files /dev/null and b/CGW0BP.NTX differ diff --git a/CGW0CA.NTX b/CGW0CA.NTX new file mode 100644 index 0000000..dc9ecba Binary files /dev/null and b/CGW0CA.NTX differ diff --git a/CGW0CB.NTX b/CGW0CB.NTX new file mode 100644 index 0000000..4affd74 Binary files /dev/null and b/CGW0CB.NTX differ diff --git a/CGW0CBL.NTX b/CGW0CBL.NTX new file mode 100644 index 0000000..c7be330 Binary files /dev/null and b/CGW0CBL.NTX differ diff --git a/CGW0CM.NTX b/CGW0CM.NTX new file mode 100644 index 0000000..210d141 Binary files /dev/null and b/CGW0CM.NTX differ diff --git a/CGW0CO.NTX b/CGW0CO.NTX new file mode 100644 index 0000000..017c101 Binary files /dev/null and b/CGW0CO.NTX differ diff --git a/CGW0CP.NTX b/CGW0CP.NTX new file mode 100644 index 0000000..ab4bfa6 Binary files /dev/null and b/CGW0CP.NTX differ diff --git a/CGW0CPE.NTX b/CGW0CPE.NTX new file mode 100644 index 0000000..341e19c Binary files /dev/null and b/CGW0CPE.NTX differ diff --git a/CGW0CPO.NTX b/CGW0CPO.NTX new file mode 100644 index 0000000..56f6bd1 Binary files /dev/null and b/CGW0CPO.NTX differ diff --git a/CGW0CPT.NTX b/CGW0CPT.NTX new file mode 100644 index 0000000..5f2ded9 Binary files /dev/null and b/CGW0CPT.NTX differ diff --git a/CGW0CS.NTX b/CGW0CS.NTX new file mode 100644 index 0000000..88b1ce0 Binary files /dev/null and b/CGW0CS.NTX differ diff --git a/CGW0GB.NTX b/CGW0GB.NTX new file mode 100644 index 0000000..8142981 Binary files /dev/null and b/CGW0GB.NTX differ diff --git a/CGW0IM.NTX b/CGW0IM.NTX new file mode 100644 index 0000000..b9555b2 Binary files /dev/null and b/CGW0IM.NTX differ diff --git a/CGW0IPO.NTX b/CGW0IPO.NTX new file mode 100644 index 0000000..502f2a3 Binary files /dev/null and b/CGW0IPO.NTX differ diff --git a/CGW0KA.NTX b/CGW0KA.NTX new file mode 100644 index 0000000..13505e8 Binary files /dev/null and b/CGW0KA.NTX differ diff --git a/CGW0MC.NTX b/CGW0MC.NTX new file mode 100644 index 0000000..03551eb Binary files /dev/null and b/CGW0MC.NTX differ diff --git a/CGW0MI.NTX b/CGW0MI.NTX new file mode 100644 index 0000000..7f1e45d Binary files /dev/null and b/CGW0MI.NTX differ diff --git a/CGW0MIC.NTX b/CGW0MIC.NTX new file mode 100644 index 0000000..224f6c0 Binary files /dev/null and b/CGW0MIC.NTX differ diff --git a/CGW0MIP.NTX b/CGW0MIP.NTX new file mode 100644 index 0000000..7317cd2 Binary files /dev/null and b/CGW0MIP.NTX differ diff --git a/CGW0ML.NTX b/CGW0ML.NTX new file mode 100644 index 0000000..0ace3ee Binary files /dev/null and b/CGW0ML.NTX differ diff --git a/CGW0MP.NTX b/CGW0MP.NTX new file mode 100644 index 0000000..f83797b Binary files /dev/null and b/CGW0MP.NTX differ diff --git a/CGW0MU.NTX b/CGW0MU.NTX new file mode 100644 index 0000000..a6558d9 Binary files /dev/null and b/CGW0MU.NTX differ diff --git a/CGW0OL.NTX b/CGW0OL.NTX new file mode 100644 index 0000000..1f33056 Binary files /dev/null and b/CGW0OL.NTX differ diff --git a/CGW0OMI.NTX b/CGW0OMI.NTX new file mode 100644 index 0000000..6293f01 Binary files /dev/null and b/CGW0OMI.NTX differ diff --git a/CGW0OO.NTX b/CGW0OO.NTX new file mode 100644 index 0000000..a4af0c1 Binary files /dev/null and b/CGW0OO.NTX differ diff --git a/CGW0PA.NTX b/CGW0PA.NTX new file mode 100644 index 0000000..a51534a Binary files /dev/null and b/CGW0PA.NTX differ diff --git a/CGW0PC.NTX b/CGW0PC.NTX new file mode 100644 index 0000000..f4ff8ec Binary files /dev/null and b/CGW0PC.NTX differ diff --git a/CGW0PE.NTX b/CGW0PE.NTX new file mode 100644 index 0000000..b5efe16 Binary files /dev/null and b/CGW0PE.NTX differ diff --git a/CGW0PO.NTX b/CGW0PO.NTX new file mode 100644 index 0000000..1721cb3 Binary files /dev/null and b/CGW0PO.NTX differ diff --git a/CGW0PR.NTX b/CGW0PR.NTX new file mode 100644 index 0000000..ceb82d2 Binary files /dev/null and b/CGW0PR.NTX differ diff --git a/CGW0PT.NTX b/CGW0PT.NTX new file mode 100644 index 0000000..b87a5c8 Binary files /dev/null and b/CGW0PT.NTX differ diff --git a/CGW0QL.NTX b/CGW0QL.NTX new file mode 100644 index 0000000..5814a9f Binary files /dev/null and b/CGW0QL.NTX differ diff --git a/CGW0QM.NTX b/CGW0QM.NTX new file mode 100644 index 0000000..6cfaeb3 Binary files /dev/null and b/CGW0QM.NTX differ diff --git a/CGW0QMI.NTX b/CGW0QMI.NTX new file mode 100644 index 0000000..ed66c42 Binary files /dev/null and b/CGW0QMI.NTX differ diff --git a/CGW0QO.NTX b/CGW0QO.NTX new file mode 100644 index 0000000..032d18b Binary files /dev/null and b/CGW0QO.NTX differ diff --git a/CGW0QX.NTX b/CGW0QX.NTX new file mode 100644 index 0000000..0bdc7a9 Binary files /dev/null and b/CGW0QX.NTX differ diff --git a/CGW0QXO.NTX b/CGW0QXO.NTX new file mode 100644 index 0000000..9a7c451 Binary files /dev/null and b/CGW0QXO.NTX differ diff --git a/CGW0RP.NTX b/CGW0RP.NTX new file mode 100644 index 0000000..74c2c68 Binary files /dev/null and b/CGW0RP.NTX differ diff --git a/CGW0RU.NTX b/CGW0RU.NTX new file mode 100644 index 0000000..54bc482 Binary files /dev/null and b/CGW0RU.NTX differ diff --git a/CGW0SBS.NTX b/CGW0SBS.NTX new file mode 100644 index 0000000..6afb328 Binary files /dev/null and b/CGW0SBS.NTX differ diff --git a/CGW0SC.NTX b/CGW0SC.NTX new file mode 100644 index 0000000..ca0dded Binary files /dev/null and b/CGW0SC.NTX differ diff --git a/CGW0SM.NTX b/CGW0SM.NTX new file mode 100644 index 0000000..3c0beae Binary files /dev/null and b/CGW0SM.NTX differ diff --git a/CGW0SS.NTX b/CGW0SS.NTX new file mode 100644 index 0000000..dc1e8bd Binary files /dev/null and b/CGW0SS.NTX differ diff --git a/CGW0SV.NTX b/CGW0SV.NTX new file mode 100644 index 0000000..8c7b4dc Binary files /dev/null and b/CGW0SV.NTX differ diff --git a/CGW0TD.NTX b/CGW0TD.NTX new file mode 100644 index 0000000..e0c41e2 Binary files /dev/null and b/CGW0TD.NTX differ diff --git a/CGW0TR.NTX b/CGW0TR.NTX new file mode 100644 index 0000000..bc91346 Binary files /dev/null and b/CGW0TR.NTX differ diff --git a/CGW0TS.NTX b/CGW0TS.NTX new file mode 100644 index 0000000..f6238a3 Binary files /dev/null and b/CGW0TS.NTX differ diff --git a/CGW0XL.NTX b/CGW0XL.NTX new file mode 100644 index 0000000..743eae8 Binary files /dev/null and b/CGW0XL.NTX differ diff --git a/CGW0XO.NTX b/CGW0XO.NTX new file mode 100644 index 0000000..17e4633 Binary files /dev/null and b/CGW0XO.NTX differ diff --git a/CGW1170.PRG b/CGW1170.PRG new file mode 100644 index 0000000..13e5a12 --- /dev/null +++ b/CGW1170.PRG @@ -0,0 +1,160 @@ +* MIKE LEWIS - UPDATE CUSTMAST FROM GREAT PLAINS DBF - CGW1170 04-26-94 + +#INCLUDE 'F:\CLIP52\RASQLB\52\RQB.CH' +#include "F:\CLIP52\RASQLB\52\RASQLB.CH" +#INCLUDE 'INKEY.CH' + +// CONSTANTS +#define T_CM_CUSNO 1 // 1ST Index order for CUSMAS.DAT (customer #) +#define T_CM_NAME 2 // 2nd Index order for CUSMAS.DAT (customer name) +#define A_CUSNO 2 // 2nd Element in CUSMAS Field Array (customer #) +#define A_NAME 4 // 4TH Element in CUSMAS Field Array (customer name) + + +EXTERNAL N_XVIA +***************************************************** +FUNCTION CGW1170 +// UPDATE CUSTOMER DBF WITH GREAT PLAINS INFO + +LOCAL MSTRUCT, MFLD_NAMES +LOCAL FLDS_TO_GET := {}, GP_FLD, CGW_FLD, MVAL +LOCAL BARM_FACTOR, XXX, OPT, MWORK_AREA + + +CLS +@ 10,15 SAY 'About to UPDATE the CUSTOMER File from the' +@ 11,15 SAY 'Great Plains File. This process may take ' +@ 12,15 SAY 'several minutes to complete.' +OPT = ' ' +@ 14,20 SAY 'Do you wish to continue? (Y/N)' GET OPT PICTURE '!' VALID OPT$'YN' +READ() +IF LASTKEY() = 27 .OR. OPT$'N' + RETURN +ENDIF + +CLS +WAIT_BOX(' *** UPDATING CUSTOMER FILE *** ',; + ' *** PLEASE WAIT *** ') + +N_XLOGIN() +N_XERRLVL(3) + +MSTRUCT := {} +MFLD_NAMES := {} +SELECT 0 +USE CUSTMAST ALIAS DEFINITIONS +NET_USE('CUSTMAST', .F., 5, 'DEFINITIONS') && CUSTOMER CHANGE FLAG +DO WHILE !EOF() + AADD(MSTRUCT, FNAME + TYPE + LENGTH + DECIMAL_PT + NUM_DECS + FILLER + SEMI_COLON) + AADD(MFLD_NAMES, FNAME) + SKIP 1 +ENDDO +USE + + +DBOPEN('CUST_MAST') +DONSETORD(4) // INDEXED ON GP_CUST +DBOPEN('CONTROL', .F.) +*-NET_USE('&CONTROL', .F., 5, 'CONTROL') && CUSTOMER CHANGE FLAG +MPATH = ALLTRIM(CONTROL->BTR_PATH) +MTABLE = MPATH + 'CUSMAS.DAT' +USE + +SET DEFAULT FILETYPE TO '.DAT' +SET RDD TO 'RQBRDD' +NEW_STRUCT := RQBSTRUCT('CUSMAS') + +N_XSELECT(0) // SELECT NEXT EMPTY BTRIEVE WORK AREA +N_XUSE(MTABLE, MSTRUCT) +MWORK_AREA = N_XSELECT() + +*-N_XORDER(MORDER) // SET TO CORRECT INDEX ORDER + +N_XSRECSIZ() +N_XRECSIZ() +SET DEFAULT FILETYPE TO +SET RDD TO + +// BUILD LIST OF FIELDS TO GET INFO FROM +*-AADD(FLDS_TO_GET, {'CUSNO', 'GP_CUST'}) +AADD(FLDS_TO_GET, {'NAME', 'COMP_NAME'}) +AADD(FLDS_TO_GET, {'SLSMAN', 'SLSMAN'}) +AADD(FLDS_TO_GET, {'DSHP', 'SHP_METHOD'}) +AADD(FLDS_TO_GET, {'DTRM', 'TERMS'}) +AADD(FLDS_TO_GET, {'CUSDSC', 'DISCOUNT'}) +AADD(FLDS_TO_GET, {'DAYSTOPAY', 'DAYSTOPAY'}) +AADD(FLDS_TO_GET, {'ADD1', 'CUST_ADDR'}) +AADD(FLDS_TO_GET, {'ADD2', 'CUST_ADDR2'}) +AADD(FLDS_TO_GET, {'CONTACT', 'CONT_LNAME'}) +AADD(FLDS_TO_GET, {'COMMENT', 'COMMENT'}) +AADD(FLDS_TO_GET, {'TAXNUM', 'TAXNUM'}) +AADD(FLDS_TO_GET, {'CITY', 'CUST_CITY'}) +AADD(FLDS_TO_GET, {'CUSTYP', 'CUSTYP'}) +AADD(FLDS_TO_GET, {'STATE', 'CUST_STATE'}) +AADD(FLDS_TO_GET, {'UPSZONE', 'UPSZONE'}) +AADD(FLDS_TO_GET, {'ZIP', 'CUST_ZIP'}) +AADD(FLDS_TO_GET, {'PHONE', 'PHONE'}) +AADD(FLDS_TO_GET, {'TAXSCH', 'TAXSCH'}) +AADD(FLDS_TO_GET, {'SHIPNAME', 'SHIPNAME'}) +AADD(FLDS_TO_GET, {'SHIPADD1', 'SHIPADD1'}) +AADD(FLDS_TO_GET, {'SHIPADD2', 'SHIPADD2'}) +AADD(FLDS_TO_GET, {'SHIPST', 'SHIPST'}) +AADD(FLDS_TO_GET, {'SHIPZIP', 'SHIPZIP'}) +AADD(FLDS_TO_GET, {'SHIPPHN', 'SHIPPHN'}) +AADD(FLDS_TO_GET, {'SHIPFAX', 'SHIPFAX'}) +AADD(FLDS_TO_GET, {'FAX', 'FAX'}) +AADD(FLDS_TO_GET, {'TAXRGST', 'TAXRGST'}) +AADD(FLDS_TO_GET, {'CURRID', 'CURRID'}) + + + + +*-QBROWSE(2,2,20,79) + + +BARM_FACTOR = SETBARM(,, 20, N_XLASTREC() ) + +XXX = 0 +N_XGOTOTOP() // TOP OF BTRIVE FILE +DO WHILE !N_XEOF() + XXX++ + BARM_UPDATE(,,XXX, BARM_FACTOR) + MCUSNO = N_XFETCH(A_CUSNO) // GET CURRENT CUSTOMER ID + + SELECT CUST_MAST + SEEK MCUSNO + IF !FOUND() + ADD_REC(1) + REPLACE GP_CUST WITH MCUSNO + + /////////////////////////////////////////////////// + // TEMPORARY FOR NOW + REPLACE CUST_ID WITH MCUSNO + + + + ELSE + REC_LOCK(1) + ENDIF + N_XSELECT(MWORK_AREA) // SELECT BTRIEVE FILE + + FOR L = 1 TO LEN(FLDS_TO_GET) + GP_FLD = FLDS_TO_GET[L,1] + CGW_FLD = FLDS_TO_GET[L,2] + + IF GP_FLD == 'DTRM' + MVAL = STR(N_XFETCH(GP_FLD),12) + ELSE + MVAL = N_XFETCH(GP_FLD) + ENDIF + + REPLACE CUST_MAST->&CGW_FLD WITH MVAL + + NEXT + + + N_XSKIP(1) +ENDDO +CLOSE DATABASES +RETURN + \ No newline at end of file diff --git a/CGW1AC.NTX b/CGW1AC.NTX new file mode 100644 index 0000000..7d2221b Binary files /dev/null and b/CGW1AC.NTX differ diff --git a/CGW1AO.NTX b/CGW1AO.NTX new file mode 100644 index 0000000..fd173ce Binary files /dev/null and b/CGW1AO.NTX differ diff --git a/CGW1AR.NTX b/CGW1AR.NTX new file mode 100644 index 0000000..d0ae558 Binary files /dev/null and b/CGW1AR.NTX differ diff --git a/CGW1ASA.NTX b/CGW1ASA.NTX new file mode 100644 index 0000000..59e2857 Binary files /dev/null and b/CGW1ASA.NTX differ diff --git a/CGW1AT.NTX b/CGW1AT.NTX new file mode 100644 index 0000000..74cfaaf Binary files /dev/null and b/CGW1AT.NTX differ diff --git a/CGW1BP.NTX b/CGW1BP.NTX new file mode 100644 index 0000000..cf85a5e Binary files /dev/null and b/CGW1BP.NTX differ diff --git a/CGW1BT.NTX b/CGW1BT.NTX new file mode 100644 index 0000000..62b2161 Binary files /dev/null and b/CGW1BT.NTX differ diff --git a/CGW1CA.NTX b/CGW1CA.NTX new file mode 100644 index 0000000..54206bb Binary files /dev/null and b/CGW1CA.NTX differ diff --git a/CGW1CB.NTX b/CGW1CB.NTX new file mode 100644 index 0000000..0528818 Binary files /dev/null and b/CGW1CB.NTX differ diff --git a/CGW1CBL.NTX b/CGW1CBL.NTX new file mode 100644 index 0000000..4c5e90b Binary files /dev/null and b/CGW1CBL.NTX differ diff --git a/CGW1CM.NTX b/CGW1CM.NTX new file mode 100644 index 0000000..3f7ba88 Binary files /dev/null and b/CGW1CM.NTX differ diff --git a/CGW1CO.NTX b/CGW1CO.NTX new file mode 100644 index 0000000..2e4dc66 Binary files /dev/null and b/CGW1CO.NTX differ diff --git a/CGW1CP.NTX b/CGW1CP.NTX new file mode 100644 index 0000000..22fde0e Binary files /dev/null and b/CGW1CP.NTX differ diff --git a/CGW1CPE.NTX b/CGW1CPE.NTX new file mode 100644 index 0000000..c689cee Binary files /dev/null and b/CGW1CPE.NTX differ diff --git a/CGW1CPO.NTX b/CGW1CPO.NTX new file mode 100644 index 0000000..1110062 Binary files /dev/null and b/CGW1CPO.NTX differ diff --git a/CGW1CPT.NTX b/CGW1CPT.NTX new file mode 100644 index 0000000..c9f1e9f Binary files /dev/null and b/CGW1CPT.NTX differ diff --git a/CGW1CS.NTX b/CGW1CS.NTX new file mode 100644 index 0000000..23bb35f Binary files /dev/null and b/CGW1CS.NTX differ diff --git a/CGW1DD.NTX b/CGW1DD.NTX new file mode 100644 index 0000000..3254131 Binary files /dev/null and b/CGW1DD.NTX differ diff --git a/CGW1GB.NTX b/CGW1GB.NTX new file mode 100644 index 0000000..d576675 Binary files /dev/null and b/CGW1GB.NTX differ diff --git a/CGW1GL.NTX b/CGW1GL.NTX new file mode 100644 index 0000000..ca8f966 Binary files /dev/null and b/CGW1GL.NTX differ diff --git a/CGW1IC.NTX b/CGW1IC.NTX new file mode 100644 index 0000000..992c503 Binary files /dev/null and b/CGW1IC.NTX differ diff --git a/CGW1IM.NTX b/CGW1IM.NTX new file mode 100644 index 0000000..79d3db8 Binary files /dev/null and b/CGW1IM.NTX differ diff --git a/CGW1IPO.NTX b/CGW1IPO.NTX new file mode 100644 index 0000000..9b66067 Binary files /dev/null and b/CGW1IPO.NTX differ diff --git a/CGW1KA.NTX b/CGW1KA.NTX new file mode 100644 index 0000000..ce329f9 Binary files /dev/null and b/CGW1KA.NTX differ diff --git a/CGW1MC.NTX b/CGW1MC.NTX new file mode 100644 index 0000000..e1f58a9 Binary files /dev/null and b/CGW1MC.NTX differ diff --git a/CGW1MI.NTX b/CGW1MI.NTX new file mode 100644 index 0000000..215e08b Binary files /dev/null and b/CGW1MI.NTX differ diff --git a/CGW1MIC.NTX b/CGW1MIC.NTX new file mode 100644 index 0000000..0983e02 Binary files /dev/null and b/CGW1MIC.NTX differ diff --git a/CGW1MIP.NTX b/CGW1MIP.NTX new file mode 100644 index 0000000..54a360f Binary files /dev/null and b/CGW1MIP.NTX differ diff --git a/CGW1ML.NTX b/CGW1ML.NTX new file mode 100644 index 0000000..6525fbf Binary files /dev/null and b/CGW1ML.NTX differ diff --git a/CGW1MP.NTX b/CGW1MP.NTX new file mode 100644 index 0000000..6476960 Binary files /dev/null and b/CGW1MP.NTX differ diff --git a/CGW1MU.NTX b/CGW1MU.NTX new file mode 100644 index 0000000..488ddbc Binary files /dev/null and b/CGW1MU.NTX differ diff --git a/CGW1OL.NTX b/CGW1OL.NTX new file mode 100644 index 0000000..8f6107e Binary files /dev/null and b/CGW1OL.NTX differ diff --git a/CGW1OM.NTX b/CGW1OM.NTX new file mode 100644 index 0000000..5554a51 Binary files /dev/null and b/CGW1OM.NTX differ diff --git a/CGW1OMI.NTX b/CGW1OMI.NTX new file mode 100644 index 0000000..8f719c7 Binary files /dev/null and b/CGW1OMI.NTX differ diff --git a/CGW1OO.NTX b/CGW1OO.NTX new file mode 100644 index 0000000..6c7901b Binary files /dev/null and b/CGW1OO.NTX differ diff --git a/CGW1OPT.NTX b/CGW1OPT.NTX new file mode 100644 index 0000000..29ebbb9 Binary files /dev/null and b/CGW1OPT.NTX differ diff --git a/CGW1OPW.NTX b/CGW1OPW.NTX new file mode 100644 index 0000000..7d49e9d Binary files /dev/null and b/CGW1OPW.NTX differ diff --git a/CGW1OSA.NTX b/CGW1OSA.NTX new file mode 100644 index 0000000..83400e9 Binary files /dev/null and b/CGW1OSA.NTX differ diff --git a/CGW1OST.NTX b/CGW1OST.NTX new file mode 100644 index 0000000..cb31ada Binary files /dev/null and b/CGW1OST.NTX differ diff --git a/CGW1OSW.NTX b/CGW1OSW.NTX new file mode 100644 index 0000000..9d4b294 Binary files /dev/null and b/CGW1OSW.NTX differ diff --git a/CGW1PA.NTX b/CGW1PA.NTX new file mode 100644 index 0000000..29c7886 Binary files /dev/null and b/CGW1PA.NTX differ diff --git a/CGW1PC.NTX b/CGW1PC.NTX new file mode 100644 index 0000000..933b6fa Binary files /dev/null and b/CGW1PC.NTX differ diff --git a/CGW1PE.NTX b/CGW1PE.NTX new file mode 100644 index 0000000..5956fc6 Binary files /dev/null and b/CGW1PE.NTX differ diff --git a/CGW1PO.NTX b/CGW1PO.NTX new file mode 100644 index 0000000..bc951b8 Binary files /dev/null and b/CGW1PO.NTX differ diff --git a/CGW1PR.NTX b/CGW1PR.NTX new file mode 100644 index 0000000..2ec80cd Binary files /dev/null and b/CGW1PR.NTX differ diff --git a/CGW1PT.NTX b/CGW1PT.NTX new file mode 100644 index 0000000..7c2949d Binary files /dev/null and b/CGW1PT.NTX differ diff --git a/CGW1QL.NTX b/CGW1QL.NTX new file mode 100644 index 0000000..57c4077 Binary files /dev/null and b/CGW1QL.NTX differ diff --git a/CGW1QM.NTX b/CGW1QM.NTX new file mode 100644 index 0000000..df044dc Binary files /dev/null and b/CGW1QM.NTX differ diff --git a/CGW1QMI.NTX b/CGW1QMI.NTX new file mode 100644 index 0000000..9f72d5f Binary files /dev/null and b/CGW1QMI.NTX differ diff --git a/CGW1QO.NTX b/CGW1QO.NTX new file mode 100644 index 0000000..16a0773 Binary files /dev/null and b/CGW1QO.NTX differ diff --git a/CGW1QX.NTX b/CGW1QX.NTX new file mode 100644 index 0000000..8cb10a9 Binary files /dev/null and b/CGW1QX.NTX differ diff --git a/CGW1QXO.NTX b/CGW1QXO.NTX new file mode 100644 index 0000000..599a2b8 Binary files /dev/null and b/CGW1QXO.NTX differ diff --git a/CGW1RP.NTX b/CGW1RP.NTX new file mode 100644 index 0000000..4fe873c Binary files /dev/null and b/CGW1RP.NTX differ diff --git a/CGW1RU.NTX b/CGW1RU.NTX new file mode 100644 index 0000000..473346f Binary files /dev/null and b/CGW1RU.NTX differ diff --git a/CGW1SBS.NTX b/CGW1SBS.NTX new file mode 100644 index 0000000..abee366 Binary files /dev/null and b/CGW1SBS.NTX differ diff --git a/CGW1SC.NTX b/CGW1SC.NTX new file mode 100644 index 0000000..cc8300d Binary files /dev/null and b/CGW1SC.NTX differ diff --git a/CGW1SH.NTX b/CGW1SH.NTX new file mode 100644 index 0000000..a51d04a Binary files /dev/null and b/CGW1SH.NTX differ diff --git a/CGW1SM.NTX b/CGW1SM.NTX new file mode 100644 index 0000000..abd3736 Binary files /dev/null and b/CGW1SM.NTX differ diff --git a/CGW1SS.NTX b/CGW1SS.NTX new file mode 100644 index 0000000..4992220 Binary files /dev/null and b/CGW1SS.NTX differ diff --git a/CGW1SV.NTX b/CGW1SV.NTX new file mode 100644 index 0000000..8d73a63 Binary files /dev/null and b/CGW1SV.NTX differ diff --git a/CGW1TD.NTX b/CGW1TD.NTX new file mode 100644 index 0000000..cdceff8 Binary files /dev/null and b/CGW1TD.NTX differ diff --git a/CGW1TOL.NTX b/CGW1TOL.NTX new file mode 100644 index 0000000..cd7b2a2 Binary files /dev/null and b/CGW1TOL.NTX differ diff --git a/CGW1TR.NTX b/CGW1TR.NTX new file mode 100644 index 0000000..121eb5a Binary files /dev/null and b/CGW1TR.NTX differ diff --git a/CGW1TS.NTX b/CGW1TS.NTX new file mode 100644 index 0000000..81fba83 Binary files /dev/null and b/CGW1TS.NTX differ diff --git a/CGW1WS.NTX b/CGW1WS.NTX new file mode 100644 index 0000000..eefa9c6 Binary files /dev/null and b/CGW1WS.NTX differ diff --git a/CGW1XL.NTX b/CGW1XL.NTX new file mode 100644 index 0000000..02d556d Binary files /dev/null and b/CGW1XL.NTX differ diff --git a/CGW1XO.NTX b/CGW1XO.NTX new file mode 100644 index 0000000..4fd45d8 Binary files /dev/null and b/CGW1XO.NTX differ diff --git a/CGW2ABW.PRG b/CGW2ABW.PRG new file mode 100644 index 0000000..5c9103f --- /dev/null +++ b/CGW2ABW.PRG @@ -0,0 +1,292 @@ +/************************************************************ +** ** +** File: CGW2ABW.prg - modified by P3N 3/5/07 ** +** ** +** Moves FILE FROM CGW TO ABW ** +** ** +** ** +************************************************************/ + +#include "fivewin.ch" + +#include "FILEIO.ch" + +*********************************************************** +//** CALL AS: +//** +//** CGW2ABW.EXE INfile OUTfile + + +FUNCTION Main( TRANFILEIN, TRANFILEOUT) +LOCAL RETVAL + +SET CENTURY ON +DEFAULT TRANFILEIN := '' +DEFAULT TRANFILEOUT := '' +IF EMPTY( TRANFILEIN ) ; + .OR. EMPTY( TRANFILEOUT ) + + //** .OR. EMPTY( TTRPTIN ) ; + //** .OR. EMPTY( TTRPTOUT ) + MSGSTOP( 'CGW2ABW.EXE Copy of Posting Data Error' + CR_LF(2 ) ; + + 'Calling Parms are:' + CR_LF() ; + + ' PARM 1 IS - "'+ TRANFILEIN + '"' + CR_LF() ; + + ' PARM 2 IS - "'+ TRANFILEOUT + '"' + CR_LF(2) ; + + 'Should be as follows: ' + CR_LF() ; + + 'CGW2ABW fileIn fileOut ' , ; + 'Program Parameter Error' ) + RETURN -1 +ENDIF + + +RETVAL := MOVE_FILES( TRANFILEIN, TRANFILEOUT ) + + //**IF RETVAL = 0 + //** RETVAL := MOVE_FILES( TTRPTIN, TTRPTOUT ) + //**ENDIF + +IF RETVAL = 0 + //** GOOD COPY +ELSEIF RETVAL = 1 + MSGSTOP('CGW2ABW.EXE - COPY NOT SUCCESSFUL'+CR_LF(2) ; + + ' INFILE / PARM 1 IS - "'+ TRANFILEIN + '"' + CR_LF() ; + , 'FILE NOT FOUND!') +ELSE + MSGSTOP('CGW2ABW.EXE - COPY NOT SUCCESSFUL'+CR_LF(2) ; + + 'Calling Parms are:' + CR_LF() ; + + ' PARM 1 IS - "'+ TRANFILEIN + '"' + CR_LF() ; + + ' PARM 2 IS - "'+ TRANFILEOUT + '"' + CR_LF(2) ; + , 'Invalid file names?') +ENDIF +RETURN RETVAL + + +***************************************************** +FUNCTION MOVE_FILES( ORIGFILE, OUTFILE ) + +// setup the output file specification - file lenderlink is looking for + + +LOCAL FILE_ARR := DIRECTORY( ORIGFILE ) +LOCAL ORIGDIR, ORIGEXT, I, POS, HFILE_OUT, ERASE_RETVAL +LOCAL WORKDATA := '', RETVAL := 0, GDGFILE, HFILEIN + +IF EMPTY( FILE_ARR ) + RETURN 1 +ENDIF + +POS := RAT( '\', ORIGFILE ) +IF POS > 0 + ORIGDIR := SUBS( ORIGFILE, 1, POS ) +ENDIF + +POS := RAT( '.', ORIGFILE ) +IF POS > 0 + ORIGEXT := SUBS( ORIGFILE, POS+1 ) +ENDIF + +OUTFILE := EVAL_ATSIGNS( OUTFILE ) +IF FILE( OUTFILE ) + hFile_OUT := FOPEN( OUTFILE , FO_READWRITE + FO_EXCLUSIVE ) // open the ASCII file EXCLUSIVE +ELSE + hFile_OUT := FCREATE( OUTFILE , FC_NORMAL ) // CREATE/open the ASCII file +ENDIF + +IF hFile_OUT = -1 // CAN'T OPEN + MSGSTOP( 'Can not open OUTPUT file - ' +CR_LF()+'"'+OUTFILE +'"' , ; + 'File Open Error - Invalid File Name?' ) + RETURN -1 +ENDIF + +FOR I := 1 TO LEN( FILE_ARR ) + ORIGFILE := FILE_ARR[ I,1 ] + WORKDATA := MEMOREAD( ORIGDIR + FILE_ARR[ I,1 ] ) + IF LEN( WORKDATA ) > 0 + WORKDATA := STRTRAN( WORKDATA, CHR(26), '' ) // REMOVE EOF CHAR + + RETVAL := ADD_TO_TEXTFILE( HFILE_OUT, WORKDATA, OUTFILE ) + IF RETVAL < 0 + FClose( hFile_OUT ) // close the file + RETURN RETVAL // BAD OPEN OR BAD WRITE + ENDIF + ENDIF +NEXT + +RETVAL := FClose( hFile_OUT ) // close the file +IF RETVAL + RETVAL := 0 // GOOD CLOSE +ELSE + RETVAL := -3 // BAD CLOSE + RETURN RETVAL // BAD OPEN OR BAD WRITE +ENDIF + +// ALL OK TO HERE +FOR I := 1 TO LEN( FILE_ARR ) + GDGFILE := ORIGDIR + FILE_ARR[ I,1 ] + BLD_GDG( GDGFILE, 60 ) + ERASE_RETVAL := FERASE( GDGFILE ) +NEXT + +RETURN RETVAL + +***************************************************** + +FUNCTION ADD_TO_TEXTFILE( HFILE_OUT, WORKDATA, OUTFILE ) +LOCAL RETVAL := 0, NEOF + +NEOF := FSeek( hFile_OUT, 0, FS_END) // what is the length of the file +RETVAL := FWrite( hFile_OUT, WORKDATA ) // write HEADER to TXT file +IF RETVAL = LEN( WORKDATA ) // GOOD WRITE +ELSE + RETVAL := -2 // NOT A COMPLETE WRITE +ENDIF + +RETURN RETVAL + +******************************************************* + +********************************************************************* +FUNCTION CR_LF( NUM_CRLF ) +LOCAL I, RETVAL := '' + + +IF NUM_CRLF = NIL + NUM_CRLF := 1 +ENDIF + +FOR I := 1 TO NUM_CRLF + RETVAL := RETVAL + CHR(13) + CHR(10) +NEXT + +RETURN RETVAL + + +******************************************************************** +*BUILD A GDG BACKUP OF A GIVEN FILE +* !!!!!!! NOTE: INPUT FILE CAN NOT BE OPEN EXCLUSIVE !!!!!!! +******************************************************************** +// 32-BIT VERSION MOVED HERE 10-10-03 BY DON +FUNCTION BLD_GDG(GDG_FILE, GDG_LMT) // FILE(G:LIP0DT), GDG LIMIT +LOCAL RETVAL := .T. +LOCAL I, PER_POS, TO_FILE, TO_FIL2 +LOCAL FIL_NAME, FN_LEN, ORG_FILE +LOCAL TO_EXT, TO_EXT2 +LOCAL DBTFILE +LOCAL FILEMAJOR, TO_MEMO, TO_MEMO2 + + +GDG_FILE := ALLTRIM( GDG_FILE ) // DON - TRAILING SPACES ARE VALID 32-BIT FILE NAMES 9-2-02 + +IF GDG_LMT > 99 + MSGSTOP( 'GDG Limit is 99 - ' + STR( GDG_LMT , 3 ) + ' Was Passed' + CR_LF(2) ; + + 'Limit Changed to 99 Generations' , ; + 'GDG Limit Too Large' ) + GDG_LMT := 99 +ENDIF + +PER_POS := RAT('.', GDG_FILE) +IF PER_POS = 2 //** THIS IS A ..\ CONVENTION IN THE PATH NAME W/O AN EXTENTION PASSED + PER_POS := 0 //** DEFAULT THE PERIOD POSITION TO 0 +ENDIF +IF PER_POS > 0 + FN_LEN := PER_POS-1 + FIL_NAME := SUBS(GDG_FILE, 1, PER_POS-1) + ORG_FILE := GDG_FILE +ELSE + FN_LEN := LEN(GDG_FILE) + FIL_NAME := GDG_FILE + ORG_FILE := GDG_FILE + '.DBF' +ENDIF + +IF !FILE( ORG_FILE ) + RETURN NIL +ENDIF + +IF RIGHT( ORG_FILE , 3 ) = 'DBF' + FILEMAJOR := SUBS( ORG_FILE, 1, LEN( ORG_FILE )-3 ) + IF FILE( FILEMAJOR + 'DBT' ) + DBTFILE := FILEMAJOR + 'DBT' + ELSEIF FILE( FILEMAJOR + 'FPT' ) + DBTFILE := FILEMAJOR + 'FPT' + ELSE + DBTFILE := '' + ENDIF +ENDIF + +FOR I := GDG_LMT TO 1 STEP -1 + TO_EXT := ALLTRIM( STR(I-1, 3 ) ) + TO_EXT := PADL( TO_EXT, 3, '0' ) + TO_EXT2 := ALLTRIM( STR(I, 3 ) ) + TO_EXT2 := PADL( TO_EXT2, 3, '0' ) + TO_FILE := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT + TO_FIL2 := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT2 + IF FILE(TO_FILE) // IE. IF EXIST FILE7, ERASE FILE8 + IF FILE(TO_FIL2) + ERASE (TO_FIL2) // ONLY EXECUTES IF FILE8 EXISTS + ENDIF + RENAME (TO_FILE) TO (TO_FIL2) // RENAME FILE7 TO FILE8 + ENDIF + IF !EMPTY( DBTFILE ) + TO_EXT := ALLTRIM( STR(I + 100 - 1, 3 ) ) + TO_EXT := PADL( TO_EXT, 3, '0' ) + TO_EXT2 := ALLTRIM( STR(I + 100 , 3 ) ) + TO_EXT2 := PADL( TO_EXT2, 3, '0' ) + TO_MEMO := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT + TO_FIL2 := SUBS(FIL_NAME, 1, FN_LEN) + '.' + TO_EXT2 + IF FILE(TO_MEMO) // IE. IF EXIST FILE7, ERASE FILE8 + IF FILE(TO_FIL2) + ERASE (TO_FIL2) // ONLY EXECUTES IF FILE8 EXISTS + ENDIF + RENAME (TO_MEMO) TO (TO_FIL2) // RENAME FILE7 TO FILE8 + ENDIF + ENDIF +NEXT + +COPY FILE (ORG_FILE) TO (TO_FILE) +IF !EMPTY( DBTFILE ) // DON 10/10/03 + COPY FILE (DBTFILE) TO (TO_MEMO) +ENDIF + +RETURN NIL + + +******************************************* + +************************************************************** +FUNCTION EVAL_ATSIGNS( CMDLINE ) +LOCAL STRT := AT('@', CMDLINE) +LOCAL M_END := RAT('@', CMDLINE) +LOCAL WORKVAR := SUBS( CMDLINE, STRT+1, M_END-STRT-1 ) +LOCAL EFILE, NEWCMDLINE := CMDLINE, REPVAR + +IF M_END > STRT + NEWCMDLINE := SUBST(CMDLINE, 1, STRT-1) + + REPVAR := &WORKVAR + IF VALTYPE( REPVAR )$'C' + NEWCMDLINE := NEWCMDLINE + REPVAR + ELSE + IF VALTYPE( REPVAR )$'B' + NEWCMDLINE := NEWCMDLINE + EVAL( REPVAR ) + ELSE + MSGSTOP( 'Outfile @-sign error: ' + CMDLINE ) + RETURN CMDLINE + ENDIF + ENDIF + + NEWCMDLINE += '.'+TIME() //** P3N - 03/05/07 ADD TIME TO DATE IN FILE NAME + NEWCMDLINE := STRTRAN(NEWCMDLINE,":", '') //** P3N - STRIP THE ":" FROM THE TIME + + NEWCMDLINE := NEWCMDLINE + SUBS(CMDLINE, M_END+1) +ENDIF + + +RETURN NEWCMDLINE + + +****************************************** + +************************************************** + +************************************************** + \ No newline at end of file diff --git a/CGW2AC.NTX b/CGW2AC.NTX new file mode 100644 index 0000000..a9349d7 Binary files /dev/null and b/CGW2AC.NTX differ diff --git a/CGW2AO.NTX b/CGW2AO.NTX new file mode 100644 index 0000000..cf8d579 Binary files /dev/null and b/CGW2AO.NTX differ diff --git a/CGW2AT.NTX b/CGW2AT.NTX new file mode 100644 index 0000000..98c1e81 Binary files /dev/null and b/CGW2AT.NTX differ diff --git a/CGW2CA.NTX b/CGW2CA.NTX new file mode 100644 index 0000000..6b12742 Binary files /dev/null and b/CGW2CA.NTX differ diff --git a/CGW2CB.NTX b/CGW2CB.NTX new file mode 100644 index 0000000..85a630f Binary files /dev/null and b/CGW2CB.NTX differ diff --git a/CGW2CM.NTX b/CGW2CM.NTX new file mode 100644 index 0000000..5b9e790 Binary files /dev/null and b/CGW2CM.NTX differ diff --git a/CGW2CO.NTX b/CGW2CO.NTX new file mode 100644 index 0000000..5d6c1f5 Binary files /dev/null and b/CGW2CO.NTX differ diff --git a/CGW2CP.NTX b/CGW2CP.NTX new file mode 100644 index 0000000..c4e17d4 Binary files /dev/null and b/CGW2CP.NTX differ diff --git a/CGW2CPE.NTX b/CGW2CPE.NTX new file mode 100644 index 0000000..c3ba808 Binary files /dev/null and b/CGW2CPE.NTX differ diff --git a/CGW2CPO.NTX b/CGW2CPO.NTX new file mode 100644 index 0000000..bf54bbe Binary files /dev/null and b/CGW2CPO.NTX differ diff --git a/CGW2CPT.NTX b/CGW2CPT.NTX new file mode 100644 index 0000000..adde63d Binary files /dev/null and b/CGW2CPT.NTX differ diff --git a/CGW2CS.NTX b/CGW2CS.NTX new file mode 100644 index 0000000..131fd63 Binary files /dev/null and b/CGW2CS.NTX differ diff --git a/CGW2DD.NTX b/CGW2DD.NTX new file mode 100644 index 0000000..cb16911 Binary files /dev/null and b/CGW2DD.NTX differ diff --git a/CGW2IC.NTX b/CGW2IC.NTX new file mode 100644 index 0000000..b17219a Binary files /dev/null and b/CGW2IC.NTX differ diff --git a/CGW2IPO.NTX b/CGW2IPO.NTX new file mode 100644 index 0000000..d48ffd7 Binary files /dev/null and b/CGW2IPO.NTX differ diff --git a/CGW2MC.NTX b/CGW2MC.NTX new file mode 100644 index 0000000..8c0421c Binary files /dev/null and b/CGW2MC.NTX differ diff --git a/CGW2MI.NTX b/CGW2MI.NTX new file mode 100644 index 0000000..4cbb4d5 Binary files /dev/null and b/CGW2MI.NTX differ diff --git a/CGW2MIC.NTX b/CGW2MIC.NTX new file mode 100644 index 0000000..1a99368 Binary files /dev/null and b/CGW2MIC.NTX differ diff --git a/CGW2MIP.NTX b/CGW2MIP.NTX new file mode 100644 index 0000000..e2fa807 Binary files /dev/null and b/CGW2MIP.NTX differ diff --git a/CGW2ML.NTX b/CGW2ML.NTX new file mode 100644 index 0000000..4f03ed5 Binary files /dev/null and b/CGW2ML.NTX differ diff --git a/CGW2MP.NTX b/CGW2MP.NTX new file mode 100644 index 0000000..53bcec6 Binary files /dev/null and b/CGW2MP.NTX differ diff --git a/CGW2MU.NTX b/CGW2MU.NTX new file mode 100644 index 0000000..996206e Binary files /dev/null and b/CGW2MU.NTX differ diff --git a/CGW2OM.NTX b/CGW2OM.NTX new file mode 100644 index 0000000..2543b33 Binary files /dev/null and b/CGW2OM.NTX differ diff --git a/CGW2OPT.NTX b/CGW2OPT.NTX new file mode 100644 index 0000000..45ea1a8 Binary files /dev/null and b/CGW2OPT.NTX differ diff --git a/CGW2OPW.NTX b/CGW2OPW.NTX new file mode 100644 index 0000000..74194db Binary files /dev/null and b/CGW2OPW.NTX differ diff --git a/CGW2OST.NTX b/CGW2OST.NTX new file mode 100644 index 0000000..0b98687 Binary files /dev/null and b/CGW2OST.NTX differ diff --git a/CGW2OSW.NTX b/CGW2OSW.NTX new file mode 100644 index 0000000..2ed9870 Binary files /dev/null and b/CGW2OSW.NTX differ diff --git a/CGW2PC.NTX b/CGW2PC.NTX new file mode 100644 index 0000000..18811af Binary files /dev/null and b/CGW2PC.NTX differ diff --git a/CGW2PE.NTX b/CGW2PE.NTX new file mode 100644 index 0000000..628746a Binary files /dev/null and b/CGW2PE.NTX differ diff --git a/CGW2PO.NTX b/CGW2PO.NTX new file mode 100644 index 0000000..8a6673e Binary files /dev/null and b/CGW2PO.NTX differ diff --git a/CGW2PR.NTX b/CGW2PR.NTX new file mode 100644 index 0000000..811ac14 Binary files /dev/null and b/CGW2PR.NTX differ diff --git a/CGW2PT.NTX b/CGW2PT.NTX new file mode 100644 index 0000000..54ef215 Binary files /dev/null and b/CGW2PT.NTX differ diff --git a/CGW2QM.NTX b/CGW2QM.NTX new file mode 100644 index 0000000..5b4a0fb Binary files /dev/null and b/CGW2QM.NTX differ diff --git a/CGW2QX.NTX b/CGW2QX.NTX new file mode 100644 index 0000000..5adb9a8 Binary files /dev/null and b/CGW2QX.NTX differ diff --git a/CGW2RU.NTX b/CGW2RU.NTX new file mode 100644 index 0000000..8814061 Binary files /dev/null and b/CGW2RU.NTX differ diff --git a/CGW2SH.NTX b/CGW2SH.NTX new file mode 100644 index 0000000..3f8e5e8 Binary files /dev/null and b/CGW2SH.NTX differ diff --git a/CGW2SM.NTX b/CGW2SM.NTX new file mode 100644 index 0000000..c7c2534 Binary files /dev/null and b/CGW2SM.NTX differ diff --git a/CGW2SS.NTX b/CGW2SS.NTX new file mode 100644 index 0000000..ad28335 Binary files /dev/null and b/CGW2SS.NTX differ diff --git a/CGW2SV.NTX b/CGW2SV.NTX new file mode 100644 index 0000000..1b08145 Binary files /dev/null and b/CGW2SV.NTX differ diff --git a/CGW2TD.NTX b/CGW2TD.NTX new file mode 100644 index 0000000..36c77c1 Binary files /dev/null and b/CGW2TD.NTX differ diff --git a/CGW2TOL.NTX b/CGW2TOL.NTX new file mode 100644 index 0000000..2db6739 Binary files /dev/null and b/CGW2TOL.NTX differ diff --git a/CGW2TR.NTX b/CGW2TR.NTX new file mode 100644 index 0000000..a21d017 Binary files /dev/null and b/CGW2TR.NTX differ diff --git a/CGW2TS.NTX b/CGW2TS.NTX new file mode 100644 index 0000000..5e54936 Binary files /dev/null and b/CGW2TS.NTX differ diff --git a/CGW2XL.NTX b/CGW2XL.NTX new file mode 100644 index 0000000..c8d52aa Binary files /dev/null and b/CGW2XL.NTX differ diff --git a/CGW3AC.NTX b/CGW3AC.NTX new file mode 100644 index 0000000..ba8564d Binary files /dev/null and b/CGW3AC.NTX differ diff --git a/CGW3AO.NTX b/CGW3AO.NTX new file mode 100644 index 0000000..f7e6ef0 Binary files /dev/null and b/CGW3AO.NTX differ diff --git a/CGW3AT.NTX b/CGW3AT.NTX new file mode 100644 index 0000000..87b3674 Binary files /dev/null and b/CGW3AT.NTX differ diff --git a/CGW3CM.NTX b/CGW3CM.NTX new file mode 100644 index 0000000..e8bbf72 Binary files /dev/null and b/CGW3CM.NTX differ diff --git a/CGW3CO.NTX b/CGW3CO.NTX new file mode 100644 index 0000000..1e47e01 Binary files /dev/null and b/CGW3CO.NTX differ diff --git a/CGW3CP.NTX b/CGW3CP.NTX new file mode 100644 index 0000000..a2cda5f Binary files /dev/null and b/CGW3CP.NTX differ diff --git a/CGW3CPO.NTX b/CGW3CPO.NTX new file mode 100644 index 0000000..5af104f Binary files /dev/null and b/CGW3CPO.NTX differ diff --git a/CGW3CS.NTX b/CGW3CS.NTX new file mode 100644 index 0000000..40c5f24 Binary files /dev/null and b/CGW3CS.NTX differ diff --git a/CGW3DD.NTX b/CGW3DD.NTX new file mode 100644 index 0000000..e997461 Binary files /dev/null and b/CGW3DD.NTX differ diff --git a/CGW3IC.NTX b/CGW3IC.NTX new file mode 100644 index 0000000..ab51458 Binary files /dev/null and b/CGW3IC.NTX differ diff --git a/CGW3IPO.NTX b/CGW3IPO.NTX new file mode 100644 index 0000000..855d8d5 Binary files /dev/null and b/CGW3IPO.NTX differ diff --git a/CGW3MI.NTX b/CGW3MI.NTX new file mode 100644 index 0000000..31007ce Binary files /dev/null and b/CGW3MI.NTX differ diff --git a/CGW3MIP.NTX b/CGW3MIP.NTX new file mode 100644 index 0000000..836093a Binary files /dev/null and b/CGW3MIP.NTX differ diff --git a/CGW3MP.NTX b/CGW3MP.NTX new file mode 100644 index 0000000..62eeaca Binary files /dev/null and b/CGW3MP.NTX differ diff --git a/CGW3OM.NTX b/CGW3OM.NTX new file mode 100644 index 0000000..635b4e0 Binary files /dev/null and b/CGW3OM.NTX differ diff --git a/CGW3OST.NTX b/CGW3OST.NTX new file mode 100644 index 0000000..a3bd542 Binary files /dev/null and b/CGW3OST.NTX differ diff --git a/CGW3PO.NTX b/CGW3PO.NTX new file mode 100644 index 0000000..9cb3252 Binary files /dev/null and b/CGW3PO.NTX differ diff --git a/CGW3PR.NTX b/CGW3PR.NTX new file mode 100644 index 0000000..2707e5e Binary files /dev/null and b/CGW3PR.NTX differ diff --git a/CGW3QM.NTX b/CGW3QM.NTX new file mode 100644 index 0000000..53ff7ab Binary files /dev/null and b/CGW3QM.NTX differ diff --git a/CGW3QX.NTX b/CGW3QX.NTX new file mode 100644 index 0000000..125b741 Binary files /dev/null and b/CGW3QX.NTX differ diff --git a/CGW3SH.NTX b/CGW3SH.NTX new file mode 100644 index 0000000..94d3a70 Binary files /dev/null and b/CGW3SH.NTX differ diff --git a/CGW3TD.NTX b/CGW3TD.NTX new file mode 100644 index 0000000..d0eb424 Binary files /dev/null and b/CGW3TD.NTX differ diff --git a/CGW3XL.NTX b/CGW3XL.NTX new file mode 100644 index 0000000..720ef54 Binary files /dev/null and b/CGW3XL.NTX differ diff --git a/CGW4CM.NTX b/CGW4CM.NTX new file mode 100644 index 0000000..b1ec306 Binary files /dev/null and b/CGW4CM.NTX differ diff --git a/CGW4IC.NTX b/CGW4IC.NTX new file mode 100644 index 0000000..d21e943 Binary files /dev/null and b/CGW4IC.NTX differ diff --git a/CGW4IPO.NTX b/CGW4IPO.NTX new file mode 100644 index 0000000..cb62568 Binary files /dev/null and b/CGW4IPO.NTX differ diff --git a/CGW4MI.NTX b/CGW4MI.NTX new file mode 100644 index 0000000..5d23f95 Binary files /dev/null and b/CGW4MI.NTX differ diff --git a/CGW4OM.NTX b/CGW4OM.NTX new file mode 100644 index 0000000..d5fe87e Binary files /dev/null and b/CGW4OM.NTX differ diff --git a/CGW4PR.NTX b/CGW4PR.NTX new file mode 100644 index 0000000..8a07e53 Binary files /dev/null and b/CGW4PR.NTX differ diff --git a/CGW4QM.NTX b/CGW4QM.NTX new file mode 100644 index 0000000..4f56ece Binary files /dev/null and b/CGW4QM.NTX differ diff --git a/CGW4SH.NTX b/CGW4SH.NTX new file mode 100644 index 0000000..fbcf370 Binary files /dev/null and b/CGW4SH.NTX differ diff --git a/CGW4TD.NTX b/CGW4TD.NTX new file mode 100644 index 0000000..d939522 Binary files /dev/null and b/CGW4TD.NTX differ diff --git a/CGW5MI.NTX b/CGW5MI.NTX new file mode 100644 index 0000000..d2a47d4 Binary files /dev/null and b/CGW5MI.NTX differ diff --git a/CGW5OM.NTX b/CGW5OM.NTX new file mode 100644 index 0000000..2d07ab2 Binary files /dev/null and b/CGW5OM.NTX differ diff --git a/CGW5QM.NTX b/CGW5QM.NTX new file mode 100644 index 0000000..9349933 Binary files /dev/null and b/CGW5QM.NTX differ diff --git a/CGW5SH.NTX b/CGW5SH.NTX new file mode 100644 index 0000000..a308584 Binary files /dev/null and b/CGW5SH.NTX differ diff --git a/CGWASCNV.PRG b/CGWASCNV.PRG new file mode 100644 index 0000000..6c3f56b --- /dev/null +++ b/CGWASCNV.PRG @@ -0,0 +1,29 @@ +PROCEDURE CGWASCNV() +SELECT 0 +USE CGW0OM +SET FILTER TO !EMPTY(ALTSHPNAME) .OR. ; + !EMPTY(ALTSHPADDR) .OR. ; + !EMPTY(ALTSHPADD2) .OR. ; + !EMPTY(ALTSHPADD3) .OR. ; + !EMPTY(ALTSHPCITY) .OR. ; + !EMPTY(ALTSHPSTATE) .OR. ; + !EMPTY(ALTSHPZIP) .OR. ; + !EMPTY(ASNAMESCRN) .OR. ; + !EMPTY(ASADDRSCRN) .OR. ; + !EMPTY(ASADD2SCRN) .OR. ; + !EMPTY(ASADD3SCRN) .OR. ; + !EMPTY(ASCITYSCRN) .OR. ; + !EMPTY(ASSTATSCRN) .OR. ; + !EMPTY(ASZIPSCRN) .OR. ; + !EMPTY(ASNAMESTRM) .OR. ; + !EMPTY(ASADDRSTRM) .OR. ; + !EMPTY(ASADD2STRM) .OR. ; + !EMPTY(ASADD3STRM) .OR. ; + !EMPTY(ASCITYSTRM) .OR. ; + !EMPTY(ASSTATSTRM) .OR. ; + !EMPTY(ASZIPSTRM) + +GO TOP +COPY TO ALTSHIP +RETURN + \ No newline at end of file diff --git a/CGWB0000.PRG b/CGWB0000.PRG new file mode 100644 index 0000000..d04f86a --- /dev/null +++ b/CGWB0000.PRG @@ -0,0 +1,41 @@ +PROCEDURE CGWB0000(INITRUN) + +LOCAL NCHOICE, MARR := {}, SAVESCR + +SETCOLOR(LNOR) + +CLS +@ 0,30 SAY ' Customer File Maintenance ' +@ 1,0 SAY DOUBLE + + +AADD(MARR, 'UPDATE/BROWSE From Great Plains Customer File') +AADD(MARR, 'IMPORT From Great Plains Customer File') +AADD(MARR, 'UPDATE Great Plains Tables') + +DO WHILE .T. + SAVESCR = SAVESCREEN() + NCHOICE = PICKLIST(MARR, 10) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + IF NCHOICE = 1 + CGWBBROW() + ELSE + IF NCHOICE = 2 + CGWB1170() + ELSE + IF NCHOICE = 3 + CGWB1300() + ELSE + IF NCHOICE = 3 + CGWB1100() + ENDIF + ENDIF + ENDIF + ENDIF + RESTSCREEN(,,,,SAVESCR) +ENDDO + + \ No newline at end of file diff --git a/CGWB0100.PRG b/CGWB0100.PRG new file mode 100644 index 0000000..e0ce790 --- /dev/null +++ b/CGWB0100.PRG @@ -0,0 +1,727 @@ +PROCEDURE CGWB0100() +****************************************************** +** MIKE LEWIS - MAIN MENU 09-10-93 - CGWB0100 +****************************************************** + +LOCAL NCHOICE, MARR := {}, SAVESCR + + + +SETCOLOR(LNOR) + +CLS +@ 0,30 SAY ' Great Plains File Maintenance ' +@ 1,0 SAY DOUBLE +// IF WE WANT TO ADD A RECORD TO GREAT PLAINS FILES +IF ACTION = 'ADDREC' + CGWB1100() // GO ADD RECORD + RETURN +ENDIF + + +AADD(MARR, 'BROWSE Great Plains Files') +AADD(MARR, 'UPDATE From Great Plains Files') + +DO WHILE .T. + SAVESCR = SAVESCREEN() + NCHOICE = PICKLIST(MARR, 10) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + IF NCHOICE = 1 + CGWB1210() + ELSE + IF NCHOICE = 2 + CGWB1220() + ENDIF + ENDIF + RESTSCREEN(,,,,SAVESCR) +ENDDO + + + +* ******************************************************** +* FUNCTION PICKLIST(PASS_ARR, ROW, COL, PICKMSG, INITVAL, CLR_SCREEN) +* * +* *===== PICK BOX FOR LIST SELECTION =====* +* * +* * PASS_ARR = ARRAY HOLDING LINES OF LIST TO SELECT FROM +* * ROW = STARTING ROW OF LIST BOX +* * COL = STARTING COLUMN OF LIST BOX +* * pickmsg = MESSAGE FOR TOP OF LIST BOX +* * INITVAL = INITIAL VALUE OF CHOICE +* * +* +* LOCAL NUM_LINES, MAX_LENGTH, XX, FUNCBOX, MKEY_DESC, DOFUNC +* LOCAL bTOP, bBOTM, bLEFT, bRIGHT, BCENTER, OFFSET, I, MKEYDESC, MARR:={} +* LOCAL SAVECOLOR := SETCOLOR(), SAME_ONE := .F., NUM_TRUE := 0 +* LOCAL MCHOICE +* +* STATIC FIRST_ELEM, LAST_ELEM, PICKED_ELEM, LAST_CHOICE +* +* +* IF FIRST_ELEM == PASS_ARR[1] +* NUM_TRUE++ +* ENDIF +* +* IF LAST_ELEM == PASS_ARR[LEN(PASS_ARR)] +* NUM_TRUE++ +* ENDIF +* +* IF LAST_CHOICE == NIL .OR. LAST_CHOICE > LEN(PASS_ARR) .OR. LAST_CHOICE < 1 +* ELSE +* IF PICKED_ELEM == PASS_ARR[LAST_CHOICE] +* NUM_TRUE++ +* ENDIF +* ENDIF +* IF NUM_TRUE = 3 +* SAME_ONE = .T. +* ENDIF +* +* +* +* +* IF !SAME_ONE +* IF INITVAL = NIL +* MCHOICE = 1 +* ELSE +* MCHOICE = INITVAL +* ENDIF +* ELSE +* MCHOICE = LAST_CHOICE +* ENDIF +* +* IF PICKMSG = NIL +* PICKMSG = '' +* ELSE +* PICKMSG = ' ' + PICKMSG + ' ' +* ENDIF +* +* IF CLR_SCREEN = NIL +* CLR_SCREEN := .T. +* ENDIF +* +* NUM_LINES = LEN(PASS_ARR) // GET NUMBER OF ARRAY ELEMENTS +* IF NUM_LINES = 0 +* RETURN +* ENDIF +* * +* MAX_LENGTH = LEN(PICKMSG) +* FOR XX = 1 TO NUM_LINES +* IF VALTYPE(PASS_ARR[XX]) = 'A' // PASSED A FUNCTION(S) INSTEAD +* MKEYDESC = '' // OF A CHARACTER DESCRIPTION +* FOR I = 1 TO LEN(PASS_ARR[XX]) +* DOFUNC = PASS_ARR[XX,I] +* MKEYDESC = MKEYDESC + &DOFUNC +* NEXT +* AADD(MARR, MKEYDESC) +* ELSE +* AADD(MARR, PASS_ARR[XX]) +* ENDIF +* +* IF LEN(MARR[XX]) > MAX_LENGTH // FIND LONGEST LINE LENGTH +* MAX_LENGTH = LEN(MARR[XX]) +* ENDIF +* NEXT +* * +* +* MAX_LENGTH++ +* +* bTOP = ROW +* bBOTM = bTOP + NUM_LINES + 1 +* IF bBOTM > 23 +* bBOTM = 23 +* ENDIF +* +* IF COL = NIL .OR. COL = 0 +* // CENTER THE BOX +* bLEFT = ((80 - MAX_LENGTH)/2) - 2 +* bRIGHT = 80 - bLEFT +* ELSE +* bLEFT = COL - 1 +* bRIGHT = bLEFT + MAX_LENGTH +* ENDIF +* +* FUNCBOX = SAVESCREEN(BTOP,BLEFT,BBOTM+1,BRIGHT+1) +* * +* SETCOLOR(BLACK) +* @ bTOP+1,bLEFT+1 CLEAR TO bBOTM+1,bRIGHT+1 // DRAW SHADOW BOX +* SETCOLOR(HNOR) +* @ bTOP,bLEFT CLEAR TO bBOTM,bRIGHT // DRAW BACKROUND COLOR +* @ bTOP,bLEFT TO bBOTM,bRIGHT // DRAW DOUBLE LINE +* +* +* +* IF LEN(PICKMSG) > 0 +* // FIND THE CENTER OF THE BOX +* BCENTER = INT( (BRIGHT - BLEFT) / 2) +* OFFSET = INT(LEN(PICKMSG) / 2) +* SETCOLOR(HREV) +* @ BTOP,BLEFT+(BCENTER-OFFSET) SAY PICKMSG +* ENDIF +* +* SETCOLOR(LNOR) +* DO WHILE .T. +* MCHOICE := ACHOICE(bTOP+1,bLEFT+1,bBOTM-1,bRIGHT-1,MARR,,,MCHOICE) +* // DON'T LEAVE UNLESS VALID INPUT OR ESCAPE KEY IS PRESSED!!! +* IF MCHOICE <> 0 .OR. LASTKEY() = 27 +* EXIT +* ENDIF +* ENDDO +* IF CLR_SCREEN +* RESTSCREEN(bTOP,bLEFT,bBOTM+1,BRIGHT+1,FUNCBOX) +* ENDIF +* SETCOLOR(SAVECOLOR) // RESET COLOR IN CASE OF AN ESCAPE +* +* // IF ONE WAS PICKED, DO THIS +* IF MCHOICE > 0 +* FIRST_ELEM = PASS_ARR[1] +* LAST_ELEM = PASS_ARR[LEN(PASS_ARR)] +* PICKED_ELEM = PASS_ARR[MCHOICE] +* LAST_CHOICE = MCHOICE +* RETURN MCHOICE +* ELSE +* RETURN 0 +* ENDIF +* +* ****************************************************************** +* +* FUNCTION NET_USE +* PARAMETERS file, ex_use, wait, Falias, SETNDX +* PRIVATE forever, NUMTIMES, LOCKVAR +* +* IF WAIT = NIL .OR. WAIT > 1 +* WAIT = 1 +* ENDIF +* +* IF EX_USE = NIL +* EX_USE = .F. +* ENDIF +* +* IF WAIT > 1 +* WAIT := 1 +* ENDIF +* NUMTIMES = 0 +* DO WHILE .T. +* IF PCOUNT() > 3 +* IF SELECT(FALIAS) != 0 // IS FILE ALREADY OPENED? +* ///////////////////////////////// +* // CHECK TO SEE IF FILE NEEDS TO CHANGE EXCLUSIVE STATUS!!!!! +* ///////////////////////////////// +* SELECT &FALIAS +* RETURN .T. +* ENDIF +* ENDIF +* +* forever = (wait = 0) +* DO WHILE (forever .OR. wait > 0) +* +* SELECT 0 +* IF ex_use && exclusive +* IF PCOUNT() = 3 +* USE &file EXCLUSIVE +* ELSE +* USE &file EXCLUSIVE ALIAS &FALIAS +* ENDIF +* ELSE +* IF PCOUNT() = 3 +* USE &file +* ELSE +* USE &file ALIAS &FALIAS && shared +* ENDIF +* ENDIF +* +* IF !NETERR() +* IF PCOUNT() > 4 +* NDXFILE := {} +* DO WHILE .T. +* STOP := AT(',', SETNDX) +* IF STOP = 0 +* AADD(NDXFILE, SETNDX) +* EXIT +* ELSE +* NDX1 := SUBSTR(SETNDX,1,STOP-1) +* AADD(NDXFILE, NDX1) +* SETNDX := SUBSTR(SETNDX,STOP+1, LEN(SETNDX)-STOP) +* ENDIF +* ENDDO +* +* IF LEN(NDXFILE) = 1 +* SET INDEX TO (NDXFILE[1]) +* ELSE +* IF LEN(NDXFILE) = 2 +* SET INDEX TO (NDXFILE[1]), (NDXFILE[2]) +* ELSE +* IF LEN(NDXFILE) = 3 +* SET INDEX TO (NDXFILE[1]), (NDXFILE[2]), (NDXFILE[3]) +* ELSE +* IF LEN(NDXFILE) = 4 +* SET INDEX TO (NDXFILE[1]), (NDXFILE[2]), (NDXFILE[3]), (NDXFILE[4]) +* ELSE +* IF LEN(NDXFILE) = 5 +* SET INDEX TO (NDXFILE[1]), (NDXFILE[2]), (NDXFILE[3]), (NDXFILE[4]), (NDXFILE[5]) +* ENDIF +* ENDIF +* ENDIF +* ENDIF +* ENDIF +* ENDIF +* ENDIF +* +* IF .NOT. NETERR() && USE succeeds +* RETURN (.T.) +* ENDIF +* +* INKEY(1) && wait 1 second +* wait = wait - 1 +* ENDDO +* LOCKVAR = 'FILE ' + TRIM(FILE) + ' COULD NOT BE OPENED' +* LOCK_ERR() && USE fails +* NUMTIMES = NUMTIMES + 1 +* WAIT = 3 +* IF NUMTIMES > 5 +* WHATSGOINGON() +* NUMTIMES = 0 +* ENDIF +* ENDDO +* * End - NET_USE +* +* ****************************************************************** +* +* FUNCTION FIL_LOCK +* PARAMETERS wait, OKABORT +* PRIVATE forever, NUMTIMES, LOCKVAR +* +* IF WAIT > 1 +* WAIT := 1 +* ENDIF +* NUMTIMES = 0 +* DO WHILE .T. +* IF FLOCK() +* RETURN (.T.) && locked +* ENDIF +* +* forever = (wait = 0) +* DO WHILE (forever .OR. wait > 0) +* +* INKEY(.5) && wait 1/2 second +* wait = wait - .5 +* +* IF FLOCK() +* RETURN (.T.) && locked +* ENDIF +* +* ENDDO +* LOCKVAR = 'FILE ' + TRIM(FILE) + ' COULD NOT BE OPENED' +* LOCK_ERR() && not locked +* NUMTIMES = NUMTIMES + 1 +* WAIT = 3 +* IF NUMTIMES > 5 +* WHATSGOINGON() +* NUMTIMES = 0 +* ENDIF +* ENDDO +* * End - FIL_LOCK +* +* +* FUNCTION REC_LOCK +* PARAMETERS wait, OKABORT +* PRIVATE forever, NUMTIMES, LOCKVAR +* +* IF WAIT = NIL .OR. WAIT > 1 +* WAIT := 1 +* ENDIF +* NUMTIMES = 0 +* DO WHILE .T. +* IF RLOCK() +* RETURN (.T.) && locked +* ENDIF +* +* forever = (wait = 0) +* DO WHILE (forever .OR. wait > 0) +* +* IF RLOCK() +* RETURN (.T.) && locked +* ENDIF +* +* INKEY(.5) && wait 1/2 second +* wait = wait - .5 +* +* ENDDO +* LOCKVAR = 'THE RECORD YOU REQUESTED IS IN USE BY SOMEONE ELSE' +* LOCK_ERR() && not locked +* NUMTIMES = NUMTIMES + 1 +* WAIT = 3 +* IF NUMTIMES > 5 +* WHATSGOINGON() +* NUMTIMES = 0 +* ENDIF +* ENDDO +* * End - REC_LOCK +* +* +* FUNCTION ADD_REC +* PARAMETERS wait, OKABORT +* PRIVATE forever, NUMTIMES, LOCKVAR +* +* IF WAIT > 3 +* WAIT := 3 +* ENDIF +* APPEND BLANK +* IF .NOT. NETERR() +* RETURN (.T.) +* ENDIF +* +* NUMTIMES = 0 +* DO WHILE .T. +* forever = (wait = 0) +* DO WHILE (forever .OR. wait > 0) +* +* APPEND BLANK +* IF .NOT. NETERR() +* RETURN .T. +* ENDIF +* +* INKEY(.5) && wait 1/2 second +* wait = wait - .5 +* +* ENDDO +* LOCKVAR = 'THE RECORD COULD NOT BE ADDED - FILE IN USE BY SOMEONE ELSE' +* LOCK_ERR() && not locked +* NUMTIMES = NUMTIMES + 1 +* WAIT = 3 +* IF NUMTIMES > 5 +* WHATSGOINGON() +* NUMTIMES = 0 +* ENDIF +* ENDDO +* +* ************************************************************* +* +* PROCEDURE LOCK_ERR +* PARAMETERS OKABORT +* LOCAL XXX, SAVESCR := SAVESCREEN() +* +* SETCOLOR(HREV) +* @ 22,0 +* @ 23,0 +* @ 22,0 SAY LOCKVAR +* XXX = ' ' +* @ 23,17 SAY " Enter 'Y' To Try Again " +* DO WHILE .NOT. XXX$'Y' +* @ 23,42 GET XXX PICTURE '!' +* READ +* ENDDO +* SETCOLOR(LNOR) +* RESTSCREEN(,,,,SAVESCR) +* RETURN +* +* +* +* STATIC PROCEDURE WHATSGOINGON +* PRIVATE WHATGIVES +* ?? CHR(7) +* SAVE SCREEN TO WHATGIVES +* @ 07,10 CLEAR TO 19,70 +* @ 07,10 TO 19,70 +* @ 09,15 SAY 'YOU HAVE TRIED TO GRAB THAT FILE OR RECORD ' +* @ 10,15 SAY 'OVER 5 TIMES NOW. SOMEBODY HAS LOCKED THAT ' +* @ 11,15 SAY 'FILE/RECORD UP TIGHTER THAN A DRUM!!!!! ' +* @ 13,15 SAY 'First, find out who has the file/record locked.' +* @ 14,15 SAY 'Let them finish their process if possible. ' +* @ 16,15 SAY 'You May Keep RETRYING or PRESS ALT-C as a ' +* @ 17,15 SAY 'LAST RESORT Option to ABORT YOUR APPLICATION.' +* @ 21,14 SAY ' ' +* WAIT +* RESTORE SCREEN FROM WHATGIVES +* RETURN +* +* * * * * * * * * * * * * * * * * * * * * * * * * * +* FUNCTION WAIT_BOX(LINE1, LINE2, LINE3, LINE4, V ) +* LOCAL SCRN1, I, LONGEST, H, SAVECOL +* PRIVATE LINEVAR, MSG1, MSG2, MSG3, MSG4 +* IF V = NIL +* V := 11 +* ENDIF +* DO CASE +* CASE MSG2 = NIL +* NUMMSG := 1 +* CASE MSG3 = NIL +* NUMMSG := 2 +* CASE MSG4 = NIL +* NUMMSG := 3 +* OTHERWISE +* NUMMSG := 4 +* ENDCASE +* SET CURSOR OFF +* MSG1 := LINE1 +* MSG2 := LINE2 +* MSG3 := LINE3 +* MSG4 := LINE4 +* SAVECOL := SETCOLOR() +* SETCOLOR(HREV) +* LONGEST := 0 +* FOR I = 1 TO NUMMSG +* LINEVAR := 'MSG' + STR(I,1) +* IF &LINEVAR = NIL +* ELSE +* IF LEN(&LINEVAR) > LONGEST +* LONGEST := LEN(&LINEVAR) +* ENDIF +* ENDIF +* NEXT +* +* H = ((80 - LONGEST) / 2) +* @ V,H-5 CLEAR TO V+7,H+5+LONGEST +* @ V,H-5 TO V+7,H+5+LONGEST DOUBLE +* @ V+2,H SAY LINE1 +* IF PCOUNT() > 1 +* @ V+3,H SAY LINE2 +* ENDIF +* IF PCOUNT() > 2 +* @ V+4,H SAY LINE3 +* ENDIF +* IF PCOUNT() > 3 +* @ V+5,H SAY LINE4 +* ENDIF +* SETCOLOR(SAVECOL) +* SET CURSOR ON +* RETURN (.T.) +* +* *************************************************************** +* +* FUNCTION SETBARM(ROW, COL, LEN, TOTRECS) +* LOCAL SAVECOL := SETCOLOR(LNOR) +* IF ROW = NIL +* ROW := 16 +* LEN = 20 +* COL := 40 - (LEN / 2) +* ENDIF +* @ ROW,COL SAY REPLICATE('Û', LEN ) +* SETCOLOR(HREV) +* @ ROW+1,COL SAY '0' +* @ ROW+1,COL+LEN-1 SAY ALLTRIM(STR(TOTRECS)) +* SETCOLOR(SAVECOL) +* RETURN LEN/TOTRECS +* +* *************************************************************** +* +* PROCEDURE BARM_UPDATE(ROW, COL, CURREC, BARMFACT) +* LOCAL SAVECOL := SETCOLOR(HREV), MID +* IF ROW = NIL +* ROW := 16 +* COL := 30 +* MID := 38 +* ELSE +* MID := COL + (RECCOUNT() * BARMFACTOR / 2) - 2 +* ENDIF +* @ ROW,COL SAY REPLICATE('Û', INT(CURREC*BARMFACT) ) +* @ ROW+1,MID SAY '(' + ALLTRIM(STR(CURREC)) + ')' +* SETCOLOR(SAVECOL) +* RETURN .T. +* +* ********************************************************************** +* +FUNCTION GPFLDLIST(MSYSNAME) + +LOCAL FLDS_TO_GET := {} + + // FLDS_TO_GET LAYOUT + // 1 = GREAT PLAINS FIELD NAME + // 2 = CGW0CM FIELD NAME + +IF MSYSNAME = NIL + MSYSNAME = 'CUSMAS' +ENDIF + + +// BUILD LIST OF FIELDS TO GET INFO FROM +DO CASE + CASE MSYSNAME = 'CUSMAS' + AADD(FLDS_TO_GET, {'CUSNO', 'GP_CUST'}) + AADD(FLDS_TO_GET, {'NAME', 'COMP_NAME'}) + AADD(FLDS_TO_GET, {'SLSMAN', 'SLSMAN'}) + AADD(FLDS_TO_GET, {'SHP_METHOD', 'SHP_METHOD'}) + AADD(FLDS_TO_GET, {'TERMS', 'TERMS'}) + AADD(FLDS_TO_GET, {'CUSDSC', 'DISCOUNT'}) + AADD(FLDS_TO_GET, {'DAYSTOPAY', 'DAYSTOPAY'}) + AADD(FLDS_TO_GET, {'ADD1', 'CUST_ADDR'}) + AADD(FLDS_TO_GET, {'ADD2', 'CUST_ADDR2'}) + AADD(FLDS_TO_GET, {'CONTACT', 'CONT_LNAME'}) + AADD(FLDS_TO_GET, {'COMMENT', 'COMMENT'}) + AADD(FLDS_TO_GET, {'TAXNUM', 'TAXNUM'}) + AADD(FLDS_TO_GET, {'CITY', 'CUST_CITY'}) + AADD(FLDS_TO_GET, {'CUSTYP', 'CUSTYP'}) + AADD(FLDS_TO_GET, {'STATE', 'CUST_STATE'}) + AADD(FLDS_TO_GET, {'UPSZONE', 'UPSZONE'}) + AADD(FLDS_TO_GET, {'ZIP', 'CUST_ZIP'}) + AADD(FLDS_TO_GET, {'PHONE', 'PHONE'}) + AADD(FLDS_TO_GET, {'TAXSCH', 'TAXSCH'}) + AADD(FLDS_TO_GET, {'SHIPNAME', 'SHIPNAME'}) + AADD(FLDS_TO_GET, {'SHIPADD1', 'SHIPADD1'}) + AADD(FLDS_TO_GET, {'SHIPCITY', 'SHIPADD2'}) + AADD(FLDS_TO_GET, {'SHIPST', 'SHIPST'}) + AADD(FLDS_TO_GET, {'SHIPZIP', 'SHIPZIP'}) + AADD(FLDS_TO_GET, {'SHIPPHN', 'SHIPPHN'}) + AADD(FLDS_TO_GET, {'SHIPFAX', 'SHIPFAX'}) + AADD(FLDS_TO_GET, {'FAX', 'FAX'}) + AADD(FLDS_TO_GET, {'TAXRGST', 'TAXRGST'}) + AADD(FLDS_TO_GET, {'CURRID', 'CURRID'}) + AADD(FLDS_TO_GET, {'BANK', 'CUST_ID'}) + + + CASE MSYSNAME = 'SLSMAS' + AADD(FLDS_TO_GET, {'SLSMAN', 'SLSMAN'}) + AADD(FLDS_TO_GET, {'LST_NME', 'LST_NME'}) + AADD(FLDS_TO_GET, {'FST_NME', 'FST_NME'}) + AADD(FLDS_TO_GET, {'MID_NME', 'MID_NME'}) + + + CASE MSYSNAME = 'STXDET' + AADD(FLDS_TO_GET, {'SSTAXDET', 'SSTAXDET'}) + AADD(FLDS_TO_GET, {'SSTAXSEQ', 'SSTAXSEQ'}) + AADD(FLDS_TO_GET, {'SDETDESC', 'SDETDESC'}) + AADD(FLDS_TO_GET, {'STAXON', 'STAXON'}) + AADD(FLDS_TO_GET, {'STAXINCL', 'STAXINCL'}) + AADD(FLDS_TO_GET, {'STAXAMT', 'STAXAMT'}) + AADD(FLDS_TO_GET, {'STAXRND', 'STAXRND'}) + AADD(FLDS_TO_GET, {'SAPMNMX', 'SAPMNMX'}) + AADD(FLDS_TO_GET, {'SMINAMT', 'SMINAMT'}) + AADD(FLDS_TO_GET, {'SMAXAMT', 'SMAXAMT'}) + + + CASE MSYSNAME = 'STXSCH' + AADD(FLDS_TO_GET, {'STAXSCH', 'STAXSCH'}) + AADD(FLDS_TO_GET, {'SEQ1', 'SEQ1'}) + AADD(FLDS_TO_GET, {'SEQ2', 'SEQ2'}) + AADD(FLDS_TO_GET, {'SEQ3', 'SEQ3'}) + AADD(FLDS_TO_GET, {'SEQ4', 'SEQ4'}) + AADD(FLDS_TO_GET, {'SEQ5', 'SEQ5'}) + AADD(FLDS_TO_GET, {'SEQ6', 'SEQ6'}) + AADD(FLDS_TO_GET, {'SEQ7', 'SEQ7'}) + AADD(FLDS_TO_GET, {'SEQ8', 'SEQ8'}) + AADD(FLDS_TO_GET, {'SEQ9', 'SEQ9'}) + AADD(FLDS_TO_GET, {'SEQ10', 'SEQ10'}) + + + CASE MSYSNAME = 'ARARAM' + AADD(FLDS_TO_GET, {'SHIP0', 'SHIP0'}) + AADD(FLDS_TO_GET, {'SHIP1', 'SHIP1'}) + AADD(FLDS_TO_GET, {'SHIP2', 'SHIP2'}) + AADD(FLDS_TO_GET, {'SHIP3', 'SHIP3'}) + AADD(FLDS_TO_GET, {'SHIP4', 'SHIP4'}) + AADD(FLDS_TO_GET, {'SHIP5', 'SHIP5'}) + AADD(FLDS_TO_GET, {'SHIP6', 'SHIP6'}) + AADD(FLDS_TO_GET, {'SHIP7', 'SHIP7'}) + AADD(FLDS_TO_GET, {'SHIP8', 'SHIP8'}) + AADD(FLDS_TO_GET, {'SHIP9', 'SHIP9'}) + + AADD(FLDS_TO_GET, {'TRMDSC1', 'TRMDSC1'}) + AADD(FLDS_TO_GET, {'PERCNT1', 'PERCNT1'}) + AADD(FLDS_TO_GET, {'DSCDAY1', 'DSCDAY1'}) + AADD(FLDS_TO_GET, {'NETDAY1', 'NETDAY1'}) + AADD(FLDS_TO_GET, {'DAYMON1', 'DAYMON1'}) + AADD(FLDS_TO_GET, {'DTEDUE1', 'DTEDUE1'}) + + AADD(FLDS_TO_GET, {'TRMDSC2', 'TRMDSC2'}) + AADD(FLDS_TO_GET, {'PERCNT2', 'PERCNT2'}) + AADD(FLDS_TO_GET, {'DSCDAY2', 'DSCDAY2'}) + AADD(FLDS_TO_GET, {'NETDAY2', 'NETDAY2'}) + AADD(FLDS_TO_GET, {'DAYMON2', 'DAYMON2'}) + AADD(FLDS_TO_GET, {'DTEDUE2', 'DTEDUE2'}) + + AADD(FLDS_TO_GET, {'TRMDSC3', 'TRMDSC3'}) + AADD(FLDS_TO_GET, {'PERCNT3', 'PERCNT3'}) + AADD(FLDS_TO_GET, {'DSCDAY3', 'DSCDAY3'}) + AADD(FLDS_TO_GET, {'NETDAY3', 'NETDAY3'}) + AADD(FLDS_TO_GET, {'DAYMON3', 'DAYMON3'}) + AADD(FLDS_TO_GET, {'DTEDUE3', 'DTEDUE3'}) + + AADD(FLDS_TO_GET, {'TRMDSC4', 'TRMDSC4'}) + AADD(FLDS_TO_GET, {'PERCNT4', 'PERCNT4'}) + AADD(FLDS_TO_GET, {'DSCDAY4', 'DSCDAY4'}) + AADD(FLDS_TO_GET, {'NETDAY4', 'NETDAY4'}) + AADD(FLDS_TO_GET, {'DAYMON4', 'DAYMON4'}) + AADD(FLDS_TO_GET, {'DTEDUE4', 'DTEDUE4'}) + + AADD(FLDS_TO_GET, {'TRMDSC5', 'TRMDSC5'}) + AADD(FLDS_TO_GET, {'PERCNT5', 'PERCNT5'}) + AADD(FLDS_TO_GET, {'DSCDAY5', 'DSCDAY5'}) + AADD(FLDS_TO_GET, {'NETDAY5', 'NETDAY5'}) + AADD(FLDS_TO_GET, {'DAYMON5', 'DAYMON5'}) + AADD(FLDS_TO_GET, {'DTEDUE5', 'DTEDUE5'}) + + AADD(FLDS_TO_GET, {'TRMDSC6', 'TRMDSC6'}) + AADD(FLDS_TO_GET, {'PERCNT6', 'PERCNT6'}) + AADD(FLDS_TO_GET, {'DSCDAY6', 'DSCDAY6'}) + AADD(FLDS_TO_GET, {'NETDAY6', 'NETDAY6'}) + AADD(FLDS_TO_GET, {'DAYMON6', 'DAYMON6'}) + AADD(FLDS_TO_GET, {'DTEDUE6', 'DTEDUE6'}) + + AADD(FLDS_TO_GET, {'TRMDSC7', 'TRMDSC7'}) + AADD(FLDS_TO_GET, {'PERCNT7', 'PERCNT7'}) + AADD(FLDS_TO_GET, {'DSCDAY7', 'DSCDAY7'}) + AADD(FLDS_TO_GET, {'NETDAY7', 'NETDAY7'}) + AADD(FLDS_TO_GET, {'DAYMON7', 'DAYMON7'}) + AADD(FLDS_TO_GET, {'DTEDUE7', 'DTEDUE7'}) + + AADD(FLDS_TO_GET, {'TRMDSC8', 'TRMDSC8'}) + AADD(FLDS_TO_GET, {'PERCNT8', 'PERCNT8'}) + AADD(FLDS_TO_GET, {'DSCDAY8', 'DSCDAY8'}) + AADD(FLDS_TO_GET, {'NETDAY8', 'NETDAY8'}) + AADD(FLDS_TO_GET, {'DAYMON8', 'DAYMON8'}) + AADD(FLDS_TO_GET, {'DTEDUE8', 'DTEDUE8'}) + + AADD(FLDS_TO_GET, {'TRMDSC9', 'TRMDSC9'}) + AADD(FLDS_TO_GET, {'PERCNT9', 'PERCNT9'}) + AADD(FLDS_TO_GET, {'DSCDAY9', 'DSCDAY9'}) + AADD(FLDS_TO_GET, {'NETDAY9', 'NETDAY9'}) + AADD(FLDS_TO_GET, {'DAYMON9', 'DAYMON9'}) + AADD(FLDS_TO_GET, {'DTEDUE9', 'DTEDUE9'}) + + AADD(FLDS_TO_GET, {'TRMDSC10', 'TRMDSC10'}) + AADD(FLDS_TO_GET, {'PERCNT10', 'PERCNT10'}) + AADD(FLDS_TO_GET, {'DSCDAY10', 'DSCDAY10'}) + AADD(FLDS_TO_GET, {'NETDAY10', 'NETDAY10'}) + AADD(FLDS_TO_GET, {'DAYMON10', 'DAYMON10'}) + AADD(FLDS_TO_GET, {'DTEDUE10', 'DTEDUE10'}) + + +END CASE + +RETURN FLDS_TO_GET +* +* +******************************************************* + +FUNCTION ORD_HOTKEYS(WHICHONE) + +LOCAL RETVAL := {}, NOTEVAR, NEEDVAR, SEEKKEY +LOCAL MTITLE := ' + "Reg: " + CURCONVREG->REGID + [-] + TRIM(CURCONVREG->FNAME) + [ ] + CURCONVREG->LNAME ' + +AADD(RETVAL, { 'F6-Customer Update', -5, 'UPDT_CUST()' } ) + +RETURN RETVAL + + +******************************************************* +FUNCTION UPDT_CUST() +LOCAL SAVESEL := SELECT() +STATIC MELEM + +IF MELEM = NIL + MELEM := ASCAN(GETVARS, {|X| X[3] = 'CUST_ID'}) +ENDIF + +**KEYBOARD (SAVESEL)->CUST_ID +KEYBOARD GETVARS[MELEM, 4] + +ADD_SING_REC(1,'Update CUSTOMER' ,{'CUST_MAST', .F.,,,,,'ADD',,.F.,.F. }) + +SELECT (SAVESEL) +RETURN .T. + + + + \ No newline at end of file diff --git a/CGWB0200.PRG b/CGWB0200.PRG new file mode 100644 index 0000000..5866c11 --- /dev/null +++ b/CGWB0200.PRG @@ -0,0 +1,137 @@ +* MIKE LEWIS -BUILD ADD, CHANGE, DELETE ARRAY- CGW0200 4-08-93 +PROCEDURE BUILDACD(MALIAS, SCR_NUM) + +LOCAL ACDARR := {} +LOCAL SCRNUM +LOCAL FILELIST := {} +LOCAL PREPROC := {} +LOCAL POSTPROC := '' +LOCAL OFFSET := 0 +LOCAL EDITPROC := '' +LOCAL COMPLETEKEY := NIL +LOCAL CONVERT_KEY := '' +LOCAL RELATED_DBF := '' +LOCAL DOPROC +LOCAL XTRA_HEADING +LOCAL XTRA_CARGO + +IF SELECT('IMPCUST') = 0 + IC_PARMS = DBOPEN('IMPCUST') +ENDIF + //**** ACDARR LAYOUT ****\\ + // 1 = FILE ALIAS + // 2 = SCREEN NUMBER + // 3 = ARRAY OF FILES THAT NEED TO BE OPEN + // 4 = PROC TO EXECUTE BEFORE THE SAYS AND GETS + // ie TO PAINT ADDITIONAL INFO ON SCREEN, etc..... + // 5 = PROC TO EXECUTE AFTER THE GETS + // ie TO UPDATE ANY NON RELATED VARIABLES ...... + // 6 = HORIZONTAL OFFSET FOR SCREEN GETS + // 7 = PROC TO EDIT THE GET FIELDS + // 8 = ARRAY OF PARTIAL KEYS WHICH MAKE RECORD UNIQUE. + // IF ARRAY IS EMPTY, THEN ONLY ONE COMPONENT OF THE KEY + // 9 = KEY CONVERSION PROC - IE PAD WITH LEADING ZEROS, ETC. + // 10 = LIST OF DBF'S THAT SHOULD BE CONSIDERED WHEN DELETING INFO + // 1 ARRAY FOR EACH DBF. ELEMENT 1 = DBF ALIAS NAME, ELEM 2 = INDEX SEEK ORDER + // 11 = OPTIONAL TOP HEADING FOR ACD_BROWSE + // 12 = OPTIONAL ACD CARGO FOR HOT KEYS USED IN ACD_BROWSE + +DO CASE + + // DATA DICTIONARY + CASE MALIAS = 'DATADICT' + SCRNUM = '0950' + AADD(ACDARR, {MALIAS, SCRNUM, FILELIST, PREPROC, ; // 1-4 + POSTPROC, OFFSET, EDITPROC, COMPLETEKEY, ; // 5-8 + CONVERT_KEY, RELATED_DBF}) // 9-10 + + + + // CUSTOMER MASTER + CASE MALIAS = 'CUST_MAST' + SCRNUM := '1170' + RELATED_DBF := { {'CUST_PRICE',1} } + PREPROC := { {'ORD_PAINT(9,14,9,47, "LNOR")','P'} } // paint bill to/ship to + AADD(ACDARR, {MALIAS, SCRNUM, FILELIST, PREPROC, ; // 1-4 + POSTPROC, OFFSET, EDITPROC, COMPLETEKEY, ; // 5-8 + CONVERT_KEY, RELATED_DBF}) // 9-10 + + + + // PASSWORDS + CASE MALIAS = 'PASSWORD' + SCRNUM = '6100' + PREPROC = { {'XXXPASSP()','P'} } // PAINTS INSTRUCTION BOX ON SCREEN + POSTPROC = 'XXXPASSS()' // UPDATE PASSWORD AND AUTHORIZATION VARIABLES + // IF THE CURRENT USER CHANGES HIS OPTIONS + OFFSET = -5 + + AADD(ACDARR, {MALIAS, SCRNUM, FILELIST, PREPROC, ; // 1-4 + POSTPROC, OFFSET, EDITPROC, COMPLETEKEY, ; // 5-8 + CONVERT_KEY, RELATED_DBF}) // 9-10 + + + +ENDCASE + +RETURN ACDARR + + + +CLOSE DATABASES +RETURN ACDARR + +********************************************************************* +********************************************************************* +********************************************************************* + +********************************************************************* +********************************************************************* +********************************************************************* +FUNCTION COPYSTD() +LOCAL SAVESEL := SELECT(), SAVEFILT +LOCAL COPYFROM := ALLTRIM( ATTRIBUTES ) + +SELECT ATTRIBUTES +USE +SELECT USERFILE2 +// APPEND ALL FROM &ATTRIBUTES FOR ATT_TYPE = 'S' +APPEND ALL FROM ©FROM FOR ATT_TYPE = 'S' +DBOPEN('ATTRIBUTES') +SELECT (SAVESEL) +RETURN .T. + +********************************************** +FUNCTION KEY_CONV(ENTERED_KEY, PTYPE) // PUT LEADING SPACES IN ORDER_NUM +LOCAL MSPACES, RETVAL := .T., REPVAR, REPVARNAME +LOCAL MLEN + + +IF EMPTY(ENTERED_KEY) + RETURN '' +ENDIF + + +IF AT('?', ENTERED_KEY) > 0 + DO CASE + CASE PTYPE = NIL + RETURN ENTERED_KEY + CASE PTYPE = 'RM' // R = REPLACE DATABASE / M = SET MEMORY VARIABLE + RETURN .T. + ENDCASE +ENDIF + +MLEN = LEN(ENTERED_KEY) +MSPACES = SPACE(MLEN) +IF EMPTY(ENTERED_KEY) // AND RETURN THE RESULT + RETURN '' +ELSE + ENTERED_KEY = ALLTRIM(ENTERED_KEY) + RETVAL = RIGHT(MSPACES+ENTERED_KEY, MLEN) +ENDIF + + +RETURN RETVAL + + + \ No newline at end of file diff --git a/CGWB1100.PRG b/CGWB1100.PRG new file mode 100644 index 0000000..429f359 --- /dev/null +++ b/CGWB1100.PRG @@ -0,0 +1,89 @@ +*MIKE LEWIS - ADD NEW REC TO BTRIEVE FILE - 05-17-94 + +FUNCTION CGWB1100 + +LOCAL MSTRUCT, MFLD_NAMES +LOCAL FLDS_TO_GET := {}, GP_FLD, CGW_FLD, MVAL +LOCAL BARM_FACTOR, XXX, OPT, MWORK_AREA +LOCAL MBANK, NEWREC := .F. + +// GO OPEN AND SETUP BTRIEVE FILE +RESULT = SET_BTREV('CUSMAS', 'CUST_MAST') +MTABLE = RESULT[1] +MSTRUCT = RESULT[2] +MWORK_AREA = N_XSELECT() + +NET_USE('&USERFILEX', .F., 5, 'CUST_MAST') && CUSTOMER CHANGE FLAG +*-NET_USE('CGW0CM', .F., 5, 'CUST_MAST') && CUSTOMER CHANGE FLAG +*-SET INDEX TO CGW1CM,CGW2CM,CGW3CM,CGW4CM + + +FLDS_TO_GET = GPFLDLIST() + + +SELECT CUST_MAST +DO WHILE !EOF() + MCUST_ID = GP_CUST // GET GREAT PLAINS CUST ID TO ADD + IF !N_XSEEK(MCUST_ID) // SEEK THE RECORD KEY + NEWREC = .T. + + // CLEAR THE RECORD BUFFER WORK AREA + N_XSELECT(MWORK_AREA) // SELECT BTRIEVE FILE + N_XCLRBUF() + ENDIF + + FOR L = 1 TO LEN(FLDS_TO_GET) + GP_FLD = FLDS_TO_GET[L,1] + CGW_FLD = FLDS_TO_GET[L,2] + + DO CASE + + CASE GP_FLD == 'PHONE' + MVAL = STRIPDASH(CGW_FLD) + + CASE GP_FLD == 'FAX' + MVAL = STRIPDASH(CGW_FLD) + + CASE GP_FLD == 'SHIPPHN' + MVAL = STRIPDASH(CGW_FLD) + + CASE GP_FLD == 'SHIPFAX' + MVAL = STRIPDASH(CGW_FLD) + + CASE GP_FLD == 'TERMS' + MVAL = VAL(CUST_MAST->&CGW_FLD) + + CASE GP_FLD == 'SHP_METHOD' + MVAL = VAL(CUST_MAST->&CGW_FLD) + + + OTHERWISE + MVAL = CUST_MAST->&CGW_FLD + + ENDCASE + + + N_XREPLACE( GP_FLD, MVAL) // UPDATE RECORD BUFFER + + NEXT + IF NEWREC + N_XINSERT() // ADD NEW RECORD WITH BUFFER INFO + ELSE + N_XUPDATE() // UPDATE OLD RECORD + ENDIF + SKIP 1 +ENDDO + +CLOSE DATABASES +RETURN + +* * * * * * * * * * * * * * * * * * +FUNCTION STRIPDASH(MFIELD) +// TAKE OUT THE DASHES IN &MFILD + +LOCAL MVAL + +MVAL = &MFIELD +MVAL = STRTRAN(MVAL, '-', '') +RETURN MVAL + \ No newline at end of file diff --git a/CGWB1170.PRG b/CGWB1170.PRG new file mode 100644 index 0000000..ccaf06c --- /dev/null +++ b/CGWB1170.PRG @@ -0,0 +1,193 @@ +* MIKE LEWIS - UPDATE CUSTMAST FROM GREAT PLAINS DBF - CGW1170 04-26-94 + +#INCLUDE 'RQB.CH' +#include "RASQLB.CH" +* #INCLUDE 'F:\CLIP52\RASQLB\52\RQB.CH' +* #include "F:\CLIP52\RASQLB\52\RASQLB.CH" +#INCLUDE 'INKEY.CH' + +// CONSTANTS +#define T_CM_CUSNO 1 // 1ST Index order for CUSMAS.DAT (customer #) +#define T_CM_NAME 2 // 2nd Index order for CUSMAS.DAT (customer name) +#define A_CUSNO 2 // 2nd Element in CUSMAS Field Array (customer #) +#define A_NAME 4 // 4TH Element in CUSMAS Field Array (customer name) + + +EXTERNAL N_XVIA +***************************************************** +FUNCTION CGWB1170 +// UPDATE CUSTOMER DBF WITH GREAT PLAINS INFO + +LOCAL MSTRUCT, MFLD_NAMES +LOCAL FLDS_TO_GET := {}, GP_FLD, CGW_FLD, MVAL +LOCAL BARM_FACTOR, XXX, OPT, MWORK_AREA +LOCAL MBANK + + +CLS +@ 10,15 SAY 'About to UPDATE the CUSTOMER File from the' +@ 11,15 SAY 'Great Plains File. This process may take ' +@ 12,15 SAY 'several minutes to complete.' +OPT = ' ' +@ 14,20 SAY 'Do you wish to continue? (Y/N)' GET OPT PICTURE '!' VALID OPT$'YN' +READ +IF LASTKEY() = 27 .OR. OPT$'N' + RETURN +ENDIF + +// GO OPEN AND SETUP BTRIEVR FILE +RESULT = SET_BTREV() +MTABLE = RESULT[1] +MSTRUCT = RESULT[2] + + +MWORK_AREA = N_XSELECT() + +// OPEN UP CGW MASTER FILE +DBOPEN('CUST_MAST') +*-NET_USE('CGW0CM', .F., 5, 'CUST_MAST') && CUSTOMER CHANGE FLAG +*-SET INDEX TO CGW1CM,CGW2CM,CGW3CM,CGW4CM + + + +FLDS_TO_GET = GPFLDLIST() + +*-QBROWSE(2,2,20,79) + + +BARM_FACTOR = SETBARM(,, 20, N_XLASTREC() ) + +XXX = 0 +N_XGOTOTOP() // TOP OF BTRIVE FILE +DO WHILE !N_XEOF() + XXX++ + BARM_UPDATE(,,XXX, BARM_FACTOR) + MCUSNO = N_XFETCH(A_CUSNO) // GET CURRENT GREAT PLAINS CUSTOMER ID + MBANK = N_XFETCH('BANK') // GET CURRENT CUSTOMER ID + + SELECT CUST_MAST +*-SEEK MCUSNO + SEEK MBANK // CGW CUST ID + IF !FOUND() + ADD_REC(1) + REPLACE GP_CUST WITH MCUSNO + + /////////////////////////////////////////////////// + // TEMPORARY FOR NOW +*- REPLACE CUST_ID WITH MCUSNO + REPLACE CUST_ID WITH MBANK + + + + ELSE + REC_LOCK(1) + ENDIF + N_XSELECT(MWORK_AREA) // SELECT BTRIEVE FILE + + FOR L = 1 TO LEN(FLDS_TO_GET) + GP_FLD = FLDS_TO_GET[L,1] + CGW_FLD = FLDS_TO_GET[L,2] + + DO CASE + + CASE GP_FLD == 'PHONE' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'FAX' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'SHIPPHN' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'SHIPFAX' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'TERMS' + MVAL = STR(N_XFETCH(GP_FLD),12) + + CASE GP_FLD == 'SHP_METHOD' + MVAL = STR(N_XFETCH(GP_FLD),5) + + CASE GP_FLD = 'SHIP' + // ONLY GET SHIPPING INFO FOR CUSTOMERS WITH '01' OR '02' + // IN THE LAST 2 DIGITS IN THE CUST ID + IF RIGHT(MBANK,2) = '01' .OR. RIGHT(MBANK,2) = '02' + MVAL = N_XFETCH(GP_FLD) + ELSE + MVAL = '' + ENDIF + + + + OTHERWISE + MVAL = N_XFETCH(GP_FLD) + + ENDCASE + + +*- IF EMPTY(CUST_MAST->&CGW_FLD) + REPLACE CUST_MAST->&CGW_FLD WITH MVAL +*- ENDIF + + NEXT + + + N_XSKIP(1) +ENDDO +CLOSE DATABASES +RETURN + +* * * * * * * * * * * * * * * * * * * * * * * * +*- FUNCTION SET_BTREV +*- // OPEN UP THE BTRIEVE FILE +*- +*- CLS +*- WAIT_BOX(' *** UPDATING CUSTOMER FILE *** ',; +*- ' *** PLEASE WAIT *** ') +*- +*- N_XLOGIN() +*- N_XERRLVL(3) +*- +*- MSTRUCT := {} +*- MFLD_NAMES := {} +*- SELECT 0 +*- +*- NET_USE('CGWBTREV', .F., 5, 'DEFINITIONS') && CUSTOMER CHANGE FLAG +*- DO WHILE !EOF() +*- AADD(MSTRUCT, FNAME + TYPE + LENGTH + DECIMAL_PT + NUM_DECS + FILLER + SEMI_COLON) +*- AADD(MFLD_NAMES, FNAME) +*- SKIP 1 +*- ENDDO +*- USE +*- +*- +*- NET_USE('&CONTROL', .F., 5, 'CONTROL') && CUSTOMER CHANGE FLAG +*- MPATH = ALLTRIM(CONTROL->BTR_PATH) +*- MTABLE = MPATH + 'CUSMAS.DAT' +*- USE +*- +*- SET DEFAULT FILETYPE TO '.DAT' +*- SET RDD TO 'RQBRDD' +*- +*- N_XSELECT(0) // SELECT NEXT EMPTY BTRIEVE WORK AREA +*- N_XUSE(MTABLE, MSTRUCT) +*- +*- +*- SET DEFAULT FILETYPE TO +*- SET RDD TO +*- +*- RETURN {MTABLE, MSTRUCT} +*- +* * * * * * * * * * * * * * * * * * +FUNCTION SETDASH(MFIELD) +// PUT IN DASHES FOR THE PHONE NUMBER IN &MFILD + +LOCAL MVAL + +MVAL = TRIM(N_XFETCH(MFIELD)) // GET PHONE NUMBER +MVAL = LEFT(MVAL,3) + '-' + SUBSTR(MVAL,4,3) + '-' + RIGHT(MVAL,4) +RETURN MVAL + + + + \ No newline at end of file diff --git a/CGWB1210.PRG b/CGWB1210.PRG new file mode 100644 index 0000000..82b4c6c --- /dev/null +++ b/CGWB1210.PRG @@ -0,0 +1,51 @@ +PROCEDURE CGWB1210() +****************************************************** +** MIKE LEWIS - BROWSE MENU 09-28-94 - CGWB1200 +****************************************************** + +LOCAL NCHOICE, MARR := {}, SAVESCR, XARR := {} + + + +SETCOLOR(LNOR) + +CLS +@ 0,30 SAY ' Great Plains File Maintenance ' +@ 1,0 SAY DOUBLE + +AADD(XARR, 'BROWSE Customer File') +AADD(XARR, 'BROWSE Salesmen File') +AADD(XARR, 'BROWSE Shipping Terms File') +AADD(XARR, 'BROWSE Tax Schedule File') +AADD(XARR, 'BROWSE Tax Detail File') + +DO WHILE .T. + SAVESCR = SAVESCREEN() + NCHOICE = PICKLIST(XARR, 10) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + IF NCHOICE = 1 + CGWBBROW('CUSMAS') + ELSE + IF NCHOICE = 2 + CGWBBROW('SLSMAS') + ELSE + IF NCHOICE = 3 + CGWBBROW('ARARAM') + ELSE + IF NCHOICE = 4 + CGWBBROW('STXSCH') + ELSE + IF NCHOICE = 5 + CGWBBROW('STXDET') + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + RESTSCREEN(,,,,SAVESCR) +ENDDO + + \ No newline at end of file diff --git a/CGWB1220.PRG b/CGWB1220.PRG new file mode 100644 index 0000000..21638d7 --- /dev/null +++ b/CGWB1220.PRG @@ -0,0 +1,103 @@ +PROCEDURE CGWB1220() +****************************************************** +** MIKE LEWIS - UPDATE MENU 09-28-94 - CGWB1200 +****************************************************** + +LOCAL NCHOICE, MARR := {}, SAVESCR, XARR := {} + + + +SETCOLOR(LNOR) + +CLS +@ 0,30 SAY ' Great Plains File Maintenance ' +@ 1,0 SAY DOUBLE + +AADD(XARR, 'UPDATE Customer File') +AADD(XARR, 'UPDATE Salesmen File') +AADD(XARR, 'UPDATE Shipping Terms File') +AADD(XARR, 'UPDATE Tax Schedule File') +AADD(XARR, 'UPDATE Tax Detail File') + +DO WHILE .T. + SAVESCR = SAVESCREEN() + NCHOICE = PICKLIST(XARR, 10) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + IF NCHOICE = 1 + CGWB1300('CUST_MAST', 'CUSMAS', {'CUSNO'}) + ELSE + IF NCHOICE = 2 + CGWB1300('SALESMEN', 'SLSMAS', {'SLSMAN'}, .T.) + ELSE + IF NCHOICE = 3 + CGWB1300('AR_INFO', 'ARARAM', {'CAGE1'}, .T.) + ELSE + IF NCHOICE = 4 + CGWB1300('TAX_SCHED', 'STXSCH', {'STAXSCH'}, .T.) + + + // SETUP THE SHIP VIA FILE + MARR := {} + AADD(MARR, {'10', 'SHIP0'}) + AADD(MARR, {'20', 'SHIP1'}) + AADD(MARR, {'30', 'SHIP2'}) + AADD(MARR, {'40', 'SHIP3'}) + AADD(MARR, {'50', 'SHIP4'}) + AADD(MARR, {'60', 'SHIP5'}) + AADD(MARR, {'70', 'SHIP6'}) + AADD(MARR, {'80', 'SHIP7'}) + AADD(MARR, {'90', 'SHIP8'}) + AADD(MARR, {' 0', 'SHIP9'}) + + DO_UPDATE('SHIPMETH', MARR) + ELSE + IF NCHOICE = 5 + CGWB1300('TAX_DETAIL', 'STXDET', {'SSTAXDET', 'SSTAXSEQ'}, .T.) + + // SETUP THE TERMS FILE + MARR := {} + AADD(MARR, {'10', 'TRMDSC1'}) + AADD(MARR, {'20', 'TRMDSC2'}) + AADD(MARR, {'30', 'TRMDSC3'}) + AADD(MARR, {'40', 'TRMDSC4'}) + AADD(MARR, {'50', 'TRMDSC5'}) + AADD(MARR, {'60', 'TRMDSC6'}) + DO_UPDATE('TERMS', MARR) + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + RESTSCREEN(,,,,SAVESCR) +ENDDO + +******************************************************* +FUNCTION DO_UPDATE(MFILE, MARR) +// +DBOPEN('AR_INFO') +DBOPEN(MFILE) + +FOR L2 = 1 TO LEN(MARR) + SEEK MARR[L2,1] + IF !FOUND() + ADD_REC(1) + ELSE + REC_LOCK(1) + ENDIF + + REPLACE CODE WITH MARR[L2,1] + MFLD = MARR[L2,2] + REPLACE DESC WITH AR_INFO->&MFLD + UNLOCK + + SKIP 1 +NEXT + +CLOSE DATABASES +RETURN + + + \ No newline at end of file diff --git a/CGWB1300.PRG b/CGWB1300.PRG new file mode 100644 index 0000000..419fe8d --- /dev/null +++ b/CGWB1300.PRG @@ -0,0 +1,233 @@ +* MIKE LEWIS - UPDATE TABLES FROM GREAT PLAINS DBF - CGW1300 09-22-94 + +#INCLUDE 'RQB.CH' +#include "RASQLB.CH" +** #INCLUDE 'F:\CLIP52\RASQLB\52\RQB.CH' +** #include "F:\CLIP52\RASQLB\52\RASQLB.CH" +#INCLUDE 'INKEY.CH' + +// CONSTANTS +#define A_CUSNO 2 // 2nd Element in CUSMAS Field Array (customer #) + +EXTERNAL N_XVIA + +***************************************************** +FUNCTION CGWB1300(MFILE, BFILE, BKEY_FLD, DO_MSG) +// UPDATE TABLE DBFs WITH GREAT PLAINS INFO + + // MFILE = CGW FILE NAME + // BFILE = BTRIEVE FILE NAME + // BKEY_FLD = AN ARRAY OF BTRIEVE KEY FIELDS NEEDE TO LOOKUP CGW RECORDS + // DO_MSG = LOGICAL FLAG TO DISPLAY MESSAGE BELOW + +LOCAL MSTRUCT, MFLD_NAMES +LOCAL FLDS_TO_GET := {}, GP_FLD, CGW_FLD, MVAL +LOCAL BARM_FACTOR, XXX, OPT, MWORK_AREA, ALL := .T. +LOCAL DO_IT := .F. + +IF DO_MSG = NIL + DO_MSG = .T. +ENDIF + +IF DO_MSG + CLS + @ 10,15 SAY 'About to UPDATE the TABLE Files from the' + @ 11,15 SAY 'Great Plains File. This process may take ' + @ 12,15 SAY 'several minutes to complete.' + OPT = ' ' + @ 14,20 SAY 'Do you wish to continue? (Y/N)' GET OPT PICTURE '!' VALID OPT$'YN' + READ + IF LASTKEY() = 27 .OR. OPT$'N' + RETURN + ENDIF +ENDIF + +// GO OPEN AND SETUP BTRIEVR FILE +RESULT = SET_BTREV(BFILE, MFILE) +MTABLE = RESULT[1] +MSTRUCT = RESULT[2] + + +MWORK_AREA = N_XSELECT() + +// OPEN UP CGW MASTER FILE +DBOPEN(MFILE) + + + +FLDS_TO_GET = GPFLDLIST(BFILE) + +IF DO_IT + QBROWSE(2,2,20,79) +ENDIF + + +BARM_FACTOR = SETBARM(,, 20, N_XLASTREC() ) + +XXX = 0 +N_XGOTOTOP() // TOP OF BTRIVE FILE +DO WHILE !N_XEOF() + XXX++ + BARM_UPDATE(,,XXX, BARM_FACTOR) + + IF MFILE = 'CUST_MAST' + MCUSNO = N_XFETCH(A_CUSNO) // GET CURRENT GREAT PLAINS CUSTOMER ID + MKEY = N_XFETCH('BANK') // GET CURRENT CUSTOMER ID + ELSE + MKEY = '' + FOR L = 1 TO LEN(BKEY_FLD) + XKEY = N_XFETCH(BKEY_FLD[L]) // GET CURRENT GREAT PLAINS KEY VALUE + IF VALTYPE(XKEY) = 'N' + MKEY = MKEY + LTRIM(STR(XKEY)) + ELSE + IF VALTYPE(XKEY) = 'D' + MKEY = MKEY + DTOS(XKEY) + ELSE + MKEY = MKEY + XKEY + ENDIF + ENDIF + NEXT + ENDIF + + // WATCH OUT FOR NULL CHARACTERS!!! + FOR L2 = 1 TO LEN(MKEY) + X = SUBSTR(MKEY,1,L2) + IF ASC(X) = 0 + X = ' ' + MKEY = LEFT(MKEY,L2-1) + X + RIGHT(MKEY, LEN(MKEY)-L2) + ENDIF + NEXT + + SELECT &MFILE + SEEK MKEY // CGW CUST ID OR FILE KEY + IF !FOUND() + ADD_REC(1) + ELSE + REC_LOCK(1) + ENDIF + + N_XSELECT(MWORK_AREA) // SELECT BTRIEVE FILE + + FOR L = 1 TO LEN(FLDS_TO_GET) + GP_FLD = FLDS_TO_GET[L,1] + CGW_FLD = FLDS_TO_GET[L,2] + + + + IF MFILE = 'CUST_MAST' + + DO CASE + + CASE GP_FLD == 'PHONE' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'FAX' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'SHIPPHN' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'SHIPFAX' + MVAL = SETDASH(GP_FLD) + + CASE GP_FLD == 'TERMS' + MVAL = STR(N_XFETCH(GP_FLD),2) + + CASE GP_FLD == 'SHP_METHOD' + MVAL = STR(N_XFETCH(GP_FLD),2) + + CASE GP_FLD == 'SLSMAN' + MVAL = STR(VAL(N_XFETCH(GP_FLD)),5) + + CASE GP_FLD = 'SHIP' + // ONLY GET SHIPPING INFO FOR CUSTOMERS WITH '01' OR '02' + // IN THE LAST 2 DIGITS IN THE CUST ID + IF RIGHT(MKEY,2) = '01' .OR. RIGHT(MKEY,2) = '02' + MVAL = N_XFETCH(GP_FLD) + ELSE + MVAL = '' + ENDIF + + OTHERWISE + MVAL = N_XFETCH(GP_FLD) + + ENDCASE + ELSE + MVAL = N_XFETCH(GP_FLD) + ENDIF + + REPLACE &MFILE->&CGW_FLD WITH MVAL + NEXT + + + N_XSKIP(1) +ENDDO + +N_XCLOSE(ALL) + +CLOSE DATABASES +RETURN + + + + + + + +* * * * * * * * * * * * * * * * * * * * * * * * +FUNCTION SET_BTREV(MFILE, MDESC) +// OPEN UP THE BTRIEVE FILE + +CLS +WAIT_BOX(' *** UPDATING ' + MDESC + ' FILE *** ',; + ' *** PLEASE WAIT *** ') + +N_XLOGIN() +N_XERRLVL(3) + +MSTRUCT := {} +MFLD_NAMES := {} +SELECT 0 + +NET_USE('CGWBTREV', .F., 1, 'DEFINITIONS') && CUSTOMER CHANGE FLAG +GO TOP +DO WHILE !EOF() + IF TRIM(SYSNAME) == MFILE + AADD(MSTRUCT, FNAME + TYPE + LENGTH + DECIMAL_PT + NUM_DECS + FILLER + SEMI_COLON) + AADD(MFLD_NAMES, FNAME) + ENDIF + SKIP 1 +ENDDO +USE + + +NET_USE('&CONTROL', .F., 5, 'CONTROL') && CUSTOMER CHANGE FLAG +MPATH = ALLTRIM(CONTROL->BTR_PATH) +MTABLE = MPATH + MFILE + '.DAT' +USE + +SET DEFAULT FILETYPE TO '.DAT' +SET RDD TO 'RQBRDD' + +N_XSELECT(0) // SELECT NEXT EMPTY BTRIEVE WORK AREA +N_XUSE(MTABLE, MSTRUCT) + + +SET DEFAULT FILETYPE TO +SET RDD TO + +RETURN {MTABLE, MSTRUCT} + +* * * * * * * * * * * * * * * * * * +FUNCTION SETDASH(MFIELD) +// PUT IN DASHES FOR THE PHONE NUMBER IN &MFILD + +LOCAL MVAL + +MVAL = TRIM(N_XFETCH(MFIELD)) // GET PHONE NUMBER +MVAL = LEFT(MVAL,3) + '-' + SUBSTR(MVAL,4,3) + '-' + RIGHT(MVAL,4) +RETURN MVAL + + + + \ No newline at end of file diff --git a/CGWB1310.PRG b/CGWB1310.PRG new file mode 100644 index 0000000..f613246 --- /dev/null +++ b/CGWB1310.PRG @@ -0,0 +1,62 @@ +*MIKE LEWIS +PROCEDURE CGWB1310 + +LOCAL MARR := {}, ARR1 := {}, ARR2 := {}, L, L2, MFLD + +// UPDATE ALL OF THE FOLLING TABLES +CGWB1300('AR_INFO', 'ARARAM', {'CAGE1'}, .T.) +CGWB1300('SALESMEN', 'SLSMAS', {'SLSMAN'}, .F.) +CGWB1300('TAX_DETAIL', 'STXDET', {'SSTAXDET', 'SSTAXSEQ'}, .F.) +CGWB1300('TAX_SCHED', 'STXSCH', {'STAXSCH'}, .F.) + +// SETUP THE SHIP VIA AND TERMS FILES +AADD(ARR1, {'10', 'SHIP0'}) +AADD(ARR1, {'20', 'SHIP1'}) +AADD(ARR1, {'30', 'SHIP2'}) +AADD(ARR1, {'40', 'SHIP3'}) +AADD(ARR1, {'50', 'SHIP4'}) +AADD(ARR1, {'60', 'SHIP5'}) +AADD(ARR1, {'70', 'SHIP6'}) +AADD(ARR1, {'80', 'SHIP7'}) +AADD(ARR1, {'90', 'SHIP8'}) +AADD(ARR1, {' 0', 'SHIP9'}) + +AADD(ARR2, {'10', 'TRMDSC1'}) +AADD(ARR2, {'20', 'TRMDSC2'}) +AADD(ARR2, {'30', 'TRMDSC3'}) +AADD(ARR2, {'40', 'TRMDSC4'}) +AADD(ARR2, {'50', 'TRMDSC5'}) +AADD(ARR2, {'60', 'TRMDSC6'}) + +DBOPEN('AR_INFO') + +FOR L = 1 TO 2 + IF L = 1 + MARR = ACLONE(ARR1) + DBOPEN('SHIPMETH') + ELSE + MARR = ACLONE(ARR2) + DBOPEN('TERMS') + ENDIF + FOR L2 = 1 TO LEN(MARR) + SEEK MARR[L2,1] + IF !FOUND() + ADD_REC(1) + ELSE + REC_LOCK(1) + ENDIF + + REPLACE CODE WITH MARR[L2,1] + MFLD = MARR[L2,2] + REPLACE DESC WITH AR_INFO->&MFLD + UNLOCK + + SKIP 1 + NEXT +NEXT + +CLOSE DATABASES +RETURN + + + \ No newline at end of file diff --git a/CGWBTREV.PRG b/CGWBTREV.PRG new file mode 100644 index 0000000..882a7ba --- /dev/null +++ b/CGWBTREV.PRG @@ -0,0 +1,156 @@ +#INCLUDE 'RQB.CH' +#include "RASQLB.CH" +#INCLUDE 'INKEY.CH' + +// CONSTANTS +#define T_CM_CUSNO 1 // 1ST Index order for CUSMAS.DAT (customer #) +#define T_CM_NAME 2 // 2nd Index order for CUSMAS.DAT (customer name) +#define A_CUSNO 2 // 2nd Element in CUSMAS Field Array (customer #) +#define A_NAME 4 // 4TH Element in CUSMAS Field Array (customer name) + + +EXTERNAL N_XVIA + +// BTRIEVE + +/////////////////////////// +FUNCTION BROWSE_TABLE(MFILE, MFIELD_ARR, MHEADER) +// BROWSE THE MFILE + +LOCAL NTOP, NLEFT, NBOTT, NRIGHT +LOCAL MPROC, MPIC, SAVESEL := N_XSELECT() + +N_XSELECT(MFILE) // SELECT THE BROWSE FILE WORK AREA + +NTOP = 3 +NBOTT = 20 +NLEFT = 1 +NRIGHT = 79 + +//PARAMETER p_row1,p_col1,p_row2,p_col2,MFIELD_ARR,p_proc,p_pic,MHEADER +QBROWSE(NTOP, NLEFT, NBOTT, NRIGHT, MFIELD_ARR, MPROC, MPIC, MHEADER) + +N_XSELECT(SAVESEL) // RESTORE SAVED WORK AREA +RETURN + + + + +* * * * * * * * * * * * * * * * * * +FUNCTION CGWBBROW(MFILE) +// BROWSE THE GREAT PLAINS FILE THRU BTRIEVE + +LOCAL MPATH, MTABLE, MHEADER, MFIELD_ARR:= {}, MHEAD_ARR := {} +LOCAL MLEN + +N_XLOGIN() +N_XERRLVL(3) + +NET_USE('&CONTROL', .F., 5, 'CONTROL') && CUSTOMER CHANGE FLAG +MPATH = ALLTRIM(CONTROL->BTR_PATH) +MTABLE = MPATH + MFILE + '.DAT' +USE + + +MSTRUCT := {} +MFLD_NAMES := {} +SELECT 0 +NET_USE('CGWBTREV', .F., 5, 'DEFINITIONS') && CUSTOMER CHANGE FLAG +DO WHILE !EOF() + IF TRIM(SYSNAME) == MFILE + AADD(MSTRUCT, FNAME + TYPE + LENGTH + DECIMAL_PT + NUM_DECS + FILLER + SEMI_COLON) + IF FNAME <> 'FILL' .AND. AT('ARCM', FNAME) = 0 + AADD(MFLD_NAMES, FNAME) + MLEN = MAX( VAL(LENGTH), LEN(ALLTRIM(FNAME)) ) + AADD(MHEAD_ARR, SUBS(FNAME,1,MLEN) ) + ENDIF + ENDIF + SKIP 1 +ENDDO +USE + + +SET DEFAULT FILETYPE TO '.DAT' +SET RDD TO 'RQBRDD' +NEW_STRUCT := RQBSTRUCT(MFILE) + +N_XSELECT(0) // SELECT NEXT EMPTY BTRIEVE WORK AREA +N_XUSE(MTABLE, MSTRUCT) +N_XORDER(1) // SET TO CORRECT INDEX ORDER + + + +N_XSRECSIZ() +N_XRECSIZ() +SET DEFAULT FILETYPE TO +SET RDD TO + + +CLS +MHEADER := {} +MFIELD_ARR := {} + +AADD(MFIELD_ARR, 'CUSNO') +AADD(MHEADER, 'GP CUST#') + +AADD(MFIELD_ARR, 'BANK') +AADD(MHEADER, 'CGW CUST#') + +AADD(MFIELD_ARR, 'NAME') +AADD(MHEADER, 'CUST NAME') + +AADD(MFIELD_ARR, 'ADD1') +AADD(MHEADER, 'ADDRESS') + +AADD(MFIELD_ARR, 'CITY') +AADD(MHEADER, 'CITY') + +AADD(MFIELD_ARR, 'STATE') +AADD(MHEADER, 'STATE') + +AADD(MFIELD_ARR, 'ZIP') +AADD(MHEADER, 'ZIP') + +AADD(MFIELD_ARR, 'PHONE') +AADD(MHEADER, 'PHONE') + +AADD(MFIELD_ARR, 'FAX') +AADD(MHEADER, 'FAX') + +AADD(MFIELD_ARR, 'TAXSCH') +AADD(MHEADER, 'TAX SCH.') + +AADD(MFIELD_ARR, 'SHIPNAME') +AADD(MHEADER, 'SHIPPING NAME') + +AADD(MFIELD_ARR, 'SHIPADD1') +AADD(MHEADER, 'SHIPPING ADDR1') + +AADD(MFIELD_ARR, 'SHIPADD2') +AADD(MHEADER, 'SHIPPING ADDR2') + +AADD(MFIELD_ARR, 'SHIPCITY') +AADD(MHEADER, 'SHIPPING CITY') + +AADD(MFIELD_ARR, 'SHIPST') +AADD(MHEADER, 'SHIPPING STATE') + +AADD(MFIELD_ARR, 'SHIPZIP') +AADD(MHEADER, 'SHIPPING ZIP') + +AADD(MFIELD_ARR, 'SHP_METHOD') +AADD(MHEADER, 'SHP_METHOD') + +AADD(MFIELD_ARR, 'TERMS') +AADD(MHEADER, 'TERMS') + +AADD(MFIELD_ARR, 'SLSMAN') +AADD(MHEADER, 'SALESMAN') + +AADD(MFIELD_ARR, 'CLIMIT') +AADD(MHEADER, 'CREDIT LIMIT') + +BROWSE_TABLE(MTABLE, MFLD_NAMES, MHEAD_ARR) +N_XCLOSE(.T.) // CLOSE ALL BTRIVE FILES! +RETURN + \ No newline at end of file diff --git a/CGWFIELD.PRG b/CGWFIELD.PRG new file mode 100644 index 0000000..2b42d0c --- /dev/null +++ b/CGWFIELD.PRG @@ -0,0 +1,44 @@ +FUNCTION CK_IF_NUMERIC(CKFLD) +LOCAL GOODVAR := '', I, CKCHAR +LOCAL REPVAR := ALLTRIM(CKFLD) // -- FIELD TO VALIDATE +LOCAL NUMDEC := 0 + +** CHECK FOR ALPHA FIELD (!NUMERIC) +FOR I = 1 TO LEN(REPVAR) + CKCHAR := SUBSTR(REPVAR,I,1) + IF !(CKCHAR$'0123456789-.') + I := 999 + ELSE + IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) + GOODVAR := GOODVAR + CKCHAR + ELSE + IF CKCHAR = '-' + IF I = 1 + GOODVAR := GOODVAR + CKCHAR + ELSE + I := 999 + ENDIF + ELSE + IF CKCHAR = '.' + NUMDEC ++ + IF NUMDEC = 1 + GOODVAR := GOODVAR + CKCHAR + ELSE + I := 999 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +NEXT + +***IF >= 999, THEN IT WAS AN ALPHA LITERAL STRING +***IF < 999, THEN IT WAS A NUMERIC VALUE + +IF I < 999 + RETURN .T. +ELSE + RETURN .F. +ENDIF + + \ No newline at end of file diff --git a/CGWFUNC.PRG b/CGWFUNC.PRG new file mode 100644 index 0000000..604af2e --- /dev/null +++ b/CGWFUNC.PRG @@ -0,0 +1,117 @@ +FUNCTION SAVEGETS +// PRESERVE ALL THE GETS GENERATED + +LOCAL SAVELIST + +SAVELIST := ACLONE(GETLIST) +RETURN SAVELIST + +*************************** +FUNCTION RESTGETS(SAVELIST, ACTIVE_ELEM) +// RESTORE ALL THE SAVED GETS +// AND SET THE FOCUS ON ACTIVE ELEM + + +LOCAL L + +GETLIST := ACLONE(SAVELIST) +IF ACTIVE_ELEM = NIL +ELSE + IF ACTIVE_ELEM > 0 .AND. ACTIVE_ELEM <= LEN(GETLIST) + FOR L = 1 TO LEN(GETLIST) + IF L = ACTIVE_ELEM + GETLIST[L]:SETFOCUS() + ELSE + GETLIST[L]:KILLFOCUS() // TERMINATE THE GET IF ACTIVE + ENDIF + NEXT + ENDIF +ENDIF + +RETURN GETLIST + +*************************** +FUNCTION FIND_GETELEM(VAR_NAME) +// GET THE ELEMENT FOR VAR_NAME IN THE GETLIST + +LOCAL ELEM +ELEM = ASCAN(GETLIST, {|XX| XX[7] == VAR_NAME}) +RETURN ELEM + + + +*************************** +FUNCTION ACTIVE_GET +// GET THE ELEMENT FOR THE ACTIVE GET IN THE GETLIST + +LOCAL ELEM, X, SEARCH_VAL, MSUBSCRIPT + +X := GETACTIVE() // GET CURRENT ACTIVE GET +IF EMPTY(X) // NOT IN A READ! + RETURN 0 +ENDIF + +MSUBSCRIPT = X:SUBSCRIPT +SEARCH_VAL = X[7] // VARIABLE NAME TO SEARCH FOR IN GETLIST + + +IF EMPTY(MSUBSCRIPT) + ELEM = ASCAN(GETLIST, {|XX| XX[7] == SEARCH_VAL}) +ELSE + SS1 = MSUBSCRIPT[1] + SS2 = MSUBSCRIPT[2] + ELEM = ASCAN(GETLIST, {|XX| (XX[7] == SEARCH_VAL .AND. SS1==XX[2,1] .AND. SS2==XX[2,2]) }) +ENDIF + +RETURN ELEM + + + + +******************************************************** +FUNCTION UPDATE_GETS(MARR) +// UPDATE THE GET INFO ON THE SCREEN + +LOCAL SAVESEL := SELECT(), EVALVAL +LOCAL NCOLOR, NPOS, VAR, VALU +LOCAL ELEM, SEARCH_VAR + +ELEM = ACTIVE_GET() // GET ELEMENT OF ACTIVE GET IN THE GETLIST +IF ELEM > 0 + + GETLIST[ELEM]:KILLFOCUS() // TERMINATE THE CURRENT GET + FOR L = 1 TO LEN(MARR) + VAR = TRIM(MARR[L,1]) + SEARCH_VAR = VAR + IF LEN(MARR[L]) = 2 + SEARCH_VAR = TRIM(MARR[L,2]) + ENDIF + VALU = &VAR + + // READMODAL WILL ONLY DISPLAY() CHARACTER VALUES! + DO CASE + CASE VALTYPE(VALU) = 'N' + VALU = STR(VALU) + + CASE VALTYPE(VALU) = 'D' + VALU = DTOC(VALU) + + ENDCASE + + + + ELEM = ASCAN(GETVARS, {|X| TRIM(X[3]) == SEARCH_VAR}) + IF ELEM > 0 .AND. !EMPTY(GETLIST[ELEM]:BUFFER) + GETLIST[ELEM]:SETFOCUS() // MUST SET FOCUS TO DO THE FOLLOWING + NCOLOR = GETLIST[ELEM]:COLORSPEC() // GET THE CURRENT COLORS + GETLIST[ELEM]:BUFFER = VALU // STUFF THE BUFFER + GETLIST[ELEM]:ASSIGN() // UPDATE THE GET VAR + GETLIST[ELEM]:DISPLAY() // PUT VALUE ON THE SCREEN (DUMPS BUFFER) + GETLIST[ELEM]:KILLFOCUS() // TERMINATE THE GET + ENDIF + NEXT +ENDIF + +SELECT(SAVESEL) +RETURN .T. + \ No newline at end of file diff --git a/CGWINCLD.PRG b/CGWINCLD.PRG new file mode 100644 index 0000000..7d43f79 --- /dev/null +++ b/CGWINCLD.PRG @@ -0,0 +1,30 @@ +#DEFINE GET_ARR 1 // PROD_ARR +#DEFINE PRICE_ARR 2 // PROD_ARR +#DEFINE ATRB_SRC 3 // PROD_ARR + +#DEFINE ATRB 1 // G_ARR & P_ARR +#DEFINE OPT_TYP 2 // G_ARR +#DEFINE ROW_COL 2 // P_ARR +#DEFINE OPT_ARR 3 // G_ARR +#DEFINE USR_RSP 4 // G_ARR +#DEFINE ATRB_DESC 5 // G_ARR +#DEFINE RULE 6 // G_ARR +#DEFINE OPT_SRC 8 // G_ARR +#DEFINE DEFAULT 9 // G_ARR +#DEFINE BAFLAG 10 // G_ARR + +#DEFINE OPT_DESC 1 // OPT_ARR - G_ARR[3] +#DEFINE OPT_DEF 2 // OPT_ARR - G_ARR[3] +#DEFINE OPT_RULE 3 // OPT_ARR - G_ARR[3] +#DEFINE OPT_AMTS 4 // OPT_ARR - G_ARR[3] + +#DEFINE OA_PRICE 1 // OPT_AMTS -OPT_ARR - G_ARR[3] +#DEFINE OA_UI 2 // OPT_AMTS -OPT_ARR - G_ARR[3] +#DEFINE OA_SQFT 3 // OPT_AMTS -OPT_ARR - G_ARR[3] + +#DEFINE OPT_PIND 6 // OPT_ARR - G_ARR[3] - PRINT INDICATOR +#DEFINE OPT_PVAL 7 // OPT_ARR - G_ARR[3] - OPTIONAL PRINT VALUE +#DEFINE OPT_WADJ 8 // OPT_ARR - G_ARR[3] - OPTION WIDTH ADJUSTMENT +#DEFINE OPT_HADJ 9 // OPT_ARR - G_ARR[3] - OPTION HEIGHT ADJUSTMENT + + \ No newline at end of file diff --git a/CGWMATH.PRG b/CGWMATH.PRG new file mode 100644 index 0000000..6b8df24 --- /dev/null +++ b/CGWMATH.PRG @@ -0,0 +1,1256 @@ +** PCM1122 - MATHPACK CALCULATION MIKE LEWIS 4-07-92 +******************************************************* + +FUNCTION DEL_MP( MATT_CODE, MPROD_CODE ) + +LOCAL SAVESEL := SELECT(), DELARR := {}, I +LOCAL XXX := GETACTIVE(), SEEKKEY + +IF EMPTY(XXX) //** P3N - 8/25/98 + RETURN .T. //** P3N - 8/25/98 +ELSEIF !EMPTY(MATT_CODE) .OR. EMPTY(XXX:ORIGINAL()) + RETURN .T. +ENDIF + +SELECT MATHPACK +SEEKKEY := MPROD_CODE + XXX:ORIGINAL() +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + AADD(DELARR, RECNO() ) + SKIP 1 +ENDDO +FOR I := 1 TO LEN(DELARR) + GOTO DELARR[I] + REC_LOCK(1) + REPLACE CAT_CODE WITH ' ' + DELETE +NEXT +SELECT (SAVESEL) +RETURN .T. + + + + + + +******************************************************* +FUNCTION CK_MATH(F_TYPE, CAT_NAME, ATT_NAME, WHEREFROM , SELFILE) + +LOCAL SCR1122 := SAVESCREEN(), SAVESEL := SELECT() +LOCAL MATHSCR, FREEZE_COL, TOPHEADING +PRIVATE CUR_CATEGORY := CAT_NAME + +IF WHEREFROM = NIL + *** BUILD THE TEMP MATHPACK FILE + IF !F_TYPE$'C' + RETURN .T. + ENDIF +ENDIF + +IF WHEREFROM = '_SP_CUT' + FROM = WHEREFROM + CAT_NAME = PRODUCT->PROD_CODE +ELSE + IF WHEREFROM = '_MISCITEM' + FROM = WHEREFROM +****CAT_NAME = (SAVESEL)->UOM + ELSE + FROM := ' ' + ENDIF +ENDIF + +BLDNEWMATH(CAT_NAME, ATT_NAME) +DEFINE_MATH(CAT_NAME, ATT_NAME, SELFILE, WHEREFROM ) + +RESTSCREEN(,,,,SCR1122) +RETURN .T. + +*********************************************************************** + +PROCEDURE DEFINE_MATH(CAT_NAME, ATT_NAME, SELFILE, WHEREFROM) +LOCAL SAVESEL := SELECT(), SAVEORD +LOCAL P1,P2,P3,P4,P5,P6,P7,P8,P9,P10 +LOCAL ALLOW_APPEND := .T. +LOCAL FREEZE_COL := 1 +LOCAL LOOKUP := .F. +LOCAL SORTPROC := NIL +LOCAL SCRNUM := 'CALC' +LOCAL CORRECT := .F. +LOCAL FINALEDIT +LOCAL ALLOK, CORR + + + +SELECT MATHPACK +DONSETORD(1) + +SELECT USERFILE5 +DONSETORD(0) + +PRIVATE TBARR := {} +* +* SET UP 3d ARRAY TO SEND TO DBROWSE +* +* * + + +IF ATT_NAME = '_MISCITEM' + TOPHEADING := {' Define the MATH CALCULATION FOR UOM ' + TRIM(CAT_NAME), ; + ' FIELD or Operator FIELD or Command ', ; + ' VALUE or (+)/(-) VALUE or (Insert) '} +ELSE + TOPHEADING := {' Define the MATH CALCULATION FOR FIELD ' + TRIM(ATT_NAME), ; + ' FIELD or Operator FIELD or Command ', ; + ' VALUE or (+,-,%) VALUE or (Insert) '} +ENDIF +P1 = 'Line # ' +P2 = 'MATH_DISPLINE()' +AADD(TBARR, {P1, P2, NIL}) + +P1 = 'Prior Line ' +P2 = 'FIELD1' +P3 = 'USERFILE5' +P4 = NIL +IF EMPTY(SELFILE) + P5 = 'CK_M_FIELD(FIELD1, 1,,.T.)' // .T. = CK DECIMAL +ELSE + P5 = 'CK_M_FIELD(FIELD1, 1,' + '"' + SELFILE +'"' + ',.T.)' +ENDIF +P6 = '@!' +AADD(TBARR, {P1, P2, P3, P4, P5, P6}) + +P1 = '(*,/) ' +P2 = 'OPERATOR' +P3 = 'USERFILE5' +P4 = NIL +P5 = 'CK_M_OPER()' +P6 = '!' +AADD(TBARR, {P1, P2, P3, P4, P5, P6}) + +P1 = 'Prior Line ' +P2 = 'FIELD2' +P3 = 'USERFILE5' +P4 = NIL +*-P5 = 'CK_M_FIELD(FIELD2, 2)' +IF EMPTY(SELFILE) + P5 = 'CK_M_FIELD(FIELD2, 2,,.T.)' +ELSE + P5 = 'CK_M_FIELD(FIELD2, 2,' + '"' + SELFILE +'"' + ',.T.)' +ENDIF +P6 = '@!' +AADD(TBARR, {P1, P2, P3, P4, P5, P6}) + + +P1 = '(Delete) ' +P2 = 'M_COMMAND' +P3 = 'USERFILE5' +P4 = NIL +IF EMPTY(SELFILE) + P5 = 'CK_M_COMMAND()' +ELSE + P5 = 'CK_M_COMMAND(' + '"' + SELFILE + '")' +ENDIF +P6 = '@!' +AADD(TBARR, {P1, P2, P3, P4, P5, P6}) + +* +* +* +SELECT USERFILE5 +GOTO TOP +* +DO WHILE .NOT. CORRECT + SELECT USERFILE5 + DONSETORD(0) + SETCOLOR(LNOR) + FINALEDIT := .F. + CLEAR TYPEAHEAD + DBROWSE(10, 15, MAXROW()-5, 70, ALLOW_APPEND, TBARR, FREEZE_COL, LOOKUP, TOPHEADING, SORTPROC) + + // CHECK FOR ESCAPE KEY + IF LASTKEY() = 27 + M1 = ' You have ELECTED TO ESCAPE ' + M2 = ' Do you which to DISCARD ' + M3 = ' ALL CHANGES??? ' + IF !PROMPT_BOX(M1,M2,M3) .AND. LASTKEY() <> 27 // NOT OK TO DISCARD CHANGES + LOOP + ENDIF + + CORRECT = .T. + ABORTKEY = .T. + RESETMP(CAT_NAME, ATT_NAME) + LOOP + ENDIF + * + * + SETCOLOR(LNOR) + FINALEDIT := .T. + IF RECCOUNT() = 1 + GOTO 1 + IF EMPTY(FIELD1) .AND. EMPTY(FIELD2) + SELECT USERFILE5 + ZAP + RESETMP(CAT_NAME, ATT_NAME) + CORRECT := .T. + LOOP + ENDIF + ENDIF + + ALLOK := EDITMATH(CAT_NAME, ATT_NAME, SELFILE, .T.) // .T. = CK VALID DECIMAL + IF !ALLOK + IF RECNO() <> 1 + SKIP -1 + ENDIF + LOOP + ENDIF + @ 23,0 + CORR := CORRCHEK() + IF CORR = 'N' + SELECT USERFILE5 + IF !ALLOK + IF RECNO() <> 1 + SKIP -1 + ENDIF + ENDIF + LOOP + ELSE + CORRECT := .T. + IF CORR = 'X' + SELECT USERFILE5 + ZAP + RESETMP(CAT_NAME, ATT_NAME) + CORRECT := .T. + LOOP + ELSE + SELECT MATHPACK + DONSETORD(1) + SELECT USERFILE5 + GOTO TOP + DO WHILE !EOF() + SELECT USERFILE5 + MLINE := RECNO() + SEEKKEY := CAT_NAME + ATT_NAME + STR(MLINE,4) + SELECT MATHPACK + SEEK SEEKKEY + IF !FOUND() + ADD_REC(3) + REPLACE CAT_CODE WITH CAT_NAME + REPLACE ATT_CODE WITH ATT_NAME + REPLACE LINE_NUM WITH MLINE + ELSE + REC_LOCK(3) + REPLACE UPDATED WITH ' ' + ENDIF + REPLACE FIELD1 WITH UPPER(USERFILE5->FIELD1) + REPLACE FIELD1TYPE WITH UPPER(USERFILE5->FIELD1TYPE) + REPLACE OPERATOR WITH USERFILE5->OPERATOR + REPLACE FIELD2 WITH UPPER(USERFILE5->FIELD2) + REPLACE FIELD2TYPE WITH UPPER(USERFILE5->FIELD2TYPE) + IF WHEREFROM = '_SP_CUT' + REPLACE TYPE WITH 'C' // CUTTING SPEC MATH PACK! + ELSE + IF WHEREFROM = '_MISCITEM' + REPLACE TYPE WITH 'M' // MISC ITEM MATH PACK! + ELSE + REPLACE TYPE WITH ' ' // CATEGORY CALC FIELD MATH PACK + ENDIF + ENDIF + UNLOCK + SELECT USERFILE5 + SKIP 1 + ENDDO + ENDIF + ENDIF +ENDDO +SELECT USERFILE5 +ZAP +SELECT MATHPACK +DELMATHPACK(CAT_NAME, ATT_NAME) +DONSETORD(1) +IF EMPTY(SELFILE) + SELECT USERFILE2 // ATTRIBUTE FILE WHERE YOU WERE! +ELSE + SELECT &SELFILE +ENDIF +RETURN + + +************************************************************ + +STATIC PROCEDURE DELMATHPACK(CAT_NAME, ATT_NAME) + +LOCAL DELMATHPK := .F., DELARR := {} +LOCAL I, MAC + +PRIVATE SEEKKEY + +SEEKKEY := CAT_NAME + ATT_NAME +SELECT MATHPACK +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + IF UPDATED <> ' ' + REC_LOCK(3) + AADD(DELARR, RECNO() ) + DELETE + DELMATHPK := .T. + UNLOCK + ENDIF + SKIP 1 +ENDDO +IF DELMATHPK + FOR I = 1 TO LEN(DELARR) + GOTO DELARR[I] + REC_LOCK(1) + REPLACE CAT_CODE WITH '' + REPLACE ATT_CODE WITH '' + UNLOCK + NEXT +* PACK +ENDIF +RETURN + + +******************************************************************* + +PROCEDURE BLDNEWMATH(CAT_NAME , ATT_NAME) +LOCAL SAVESEL := SELECT(), SAVEORD, MAC + +PRIVATE SEEKKEY + +SELECT USERFILE5 +ZAP +SELECT MATHPACK +SEEKKEY = CAT_NAME + ATT_NAME + +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + REC_LOCK(3) + REPLACE UPDATED WITH 'P' + UNLOCK + SELECT USERFILE5 + ADD_ONEREC('MATHPACK','USERFILE5') +* APPEND BLANK +* REPLACE CAT_CODE WITH MATHPACK->CAT_CODE +* REPLACE ATT_CODE WITH MATHPACK->ATT_CODE +* REPLACE LINE_NUM WITH MATHPACK->LINE_NUM +* REPLACE FIELD1 WITH MATHPACK->FIELD1 +* REPLACE FIELD1TYPE WITH MATHPACK->FIELD1TYPE +* REPLACE FIELD2 WITH MATHPACK->FIELD2 +* REPLACE FIELD2TYPE WITH MATHPACK->FIELD2TYPE +* REPLACE OPERATOR WITH MATHPACK->OPERATOR + SELECT MATHPACK + SKIP 1 +ENDDO +SELECT USERFILE5 +IF RECCOUNT() = 0 + APPEND BLANK + REPLACE CAT_CODE WITH CAT_NAME + REPLACE ATT_CODE WITH ATT_NAME + REPLACE LINE_NUM WITH 1 +ENDIF + +SELECT MATHPACK +DONSETORD(SAVEORD) +SELECT(SAVESEL) + +RETURN .T. + +****************************************************************** +STATIC PROCEDURE RESETMP(CAT_NAME, ATT_NAME) +LOCAL MAC + +PRIVATE SEEKKEY + +SEEKKEY := CAT_NAME + ATT_NAME +SELECT MATHPACK +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + IF UPDATED <> ' ' + REC_LOCK(3) + REPLACE UPDATED WITH ' ' + UNLOCK + ENDIF + SKIP 1 +ENDDO +RETURN + +****************************************************************** +****** +****** + +FUNCTION CK_MCOMMAND(SELFILE) +SELECT USERFILE5 +IF !M_COMMAND$'ID ' + ERR_BOX( 'VALID COMMANDS ARE: I = Insert',; + ' D = Delete') + RETURN .F. +ENDIF + +IF M_COMMAND=' ' + RETURN .T. +ENDIF + +IF M_COMMAND = 'D' + IF RECNO() = 1 + GOTOREC := RECNO() - 1 + ELSE + GOTOREC := 1 + ENDIF + DELETE + PACK + GOTO GOTOREC +* KEYBOARD CHR(19) + RETURN .T. +ENDIF + +IF M_COMMAND = 'I' + GOTOREC := RECNO() + APPEND BLANK + GOTO BOTTOM + DO WHILE RECNO() <> GOTOREC + SKIP -1 + P_SYSNAME := SYSNAME + P_FTYPE := FILETYPE + P_FNAME := FNAME + P_FIELD1 := FIELD1 + P_FIELD1TYPE := FIELD1TYPE + P_OPERATOR := OPERATOR + P_FIELD2 := FIELD2 + P_FIELD2TYPE := FIELD2TYPE + SKIP 1 + REPLACE SYSNAME WITH P_SYSNAME + REPLACE FILETYPE WITH P_FTYPE + REPLACE FNAME WITH P_FNAME + REPLACE FIELD1 WITH P_FIELD1 + REPLACE FIELD1TYPE WITH P_FIELD1TYPE + REPLACE FIELD2 WITH P_FIELD2 + REPLACE FIELD2TYPE WITH P_FIELD2TYPE + REPLACE OPERATOR WITH P_OPERATOR + REPLACE LINE_NUM WITH RECNO() + SKIP -1 + ENDDO + REPLACE SYSNAME WITH USERFILE->SYSNAME + REPLACE FILETYPE WITH MFILETYPE + REPLACE FNAME WITH USERFNAME + REPLACE FIELD1 WITH SPACE(10) + REPLACE FIELD1TYPE WITH SPACE(1) + REPLACE FIELD2 WITH SPACE(10) + REPLACE FIELD2TYPE WITH SPACE(1) + REPLACE OPERATOR WITH ' ' + REPLACE LINE_NUM WITH RECNO() + REPLACE M_COMMAND WITH ' ' + RETURN .T. +ENDIF + + +********************************************************** + + +* +FUNCTION CK_M_OPER +SELECT USERFILE5 +IF OPERATOR$'+-*/%' + RETURN .T. +ELSE + ERR_BOX( '*** INVALID FIELD OPERATOR ***' ,; + ' + = Addition, - = Subtraction ' ,; + ' * = Multiplication % = Modulus Calc ' ,; + ' / = Division') + + RETURN .F. +ENDIF + +*************************************************************** +*- +STATIC FUNCTION EDITMATH(CAT_NAME, ATT_NAME, SELFILE, CK_VALDEC) + +IF CK_VALDEC = NIL + CK_VALDEC = .F. +ENDIF + +SELECT USERFILE5 +DONSETORD(0) +GOTO TOP +DO WHILE .NOT. EOF() + IF !CK_M_FIELD(USERFILE5->FIELD1, 1, SELFILE, CK_VALDEC) + RETURN .F. + ENDIF + IF !CK_M_OPER() + RETURN .F. + ENDIF + IF !CK_M_FIELD(USERFILE5->FIELD2, 2, SELFILE, CK_VALDEC) + RETURN .F. + ENDIF + SKIP 1 +ENDDO +DONSETORD(0) +RETURN .T. +*- +*************************************************************** +*- +FUNCTION MATH_DISPLINE +LOCAL RETVAL, CURREC +SELECT USERFILE5 +CURREC := STR(RECNO(),4 ) +RETVAL := 'L' + ALLTRIM(CURREC) + SPACE(10) +RETVAL := SUBSTR(RETVAL,1,6) +RETURN RETVAL + +************************************************************ + +FUNCTION CK_M_FIELD(CKFLD,FIELDNUM, SELFILE , CK_VALDEC) +IF PCOUNT() > 1 +ELSE + FIELDNUM = 1 +ENDIF +IF CK_VALDEC = NIL + CK_VALDEC = .F. +ENDIF + +IF !CKTHEFIELD(CKFLD,FIELDNUM, SELFILE, CK_VALDEC) + RETURN .F. +ENDIF + +RETURN .T. + + +* * * * * * * * * * * * * * * * * * * * * +STATIC FUNCTION CKTHEFIELD(CKFLD,FIELDNUM, P_SELFILE, CK_VALDEC) // IE. "WIDTH" ATTRIBUTE + "LENGTH" ATTRIBUTE +LOCAL CURREC, SCRNVAR, GOTOREC:=RECNO(), BROW_PICK, SAVESEL := SELECT() +LOCAL RESULT, MVALID_FUNC, VFUNC2DO, SAVEFILT +LOCAL M_ARR := {}, LOOKUP, ACTION, GOODREC := .F. + +PRIVATE SELFILE := P_SELFILE + +IF CK_VALDEC = NIL + CK_VALDEC = .F. +ENDIF + +LOOKUP = .F. + +IF EMPTY(P_SELFILE) + SELFILE = 'USERFILE2' + ACTION = 'MATH' +ELSE +**IF SELECT('MISC_ITEMS') > 0 // MISC ITEM DEFINITIONS + IF SELFILE = 'USERFILE4' // MISC ITEM DEFINITIONS + ACTION = 'MISC' + ELSE + IF SELFILE = 'USERFILE3' + ACTION = 'CUT' + ENDIF + ENDIF +ENDIF +M_ARR = SPECIAL_FIELDS(LOOKUP, ACTION) + +*-M_ARR = SPECIAL_FIELDS(LOOKUP, 'MATH') + + +BROW_PICK = .F. +STUFFALIAS = ' ' +IF SUBSTR(CKFLD,1,1) = '?' + SCRNVAR := SAVESCREEN() + LOOKUP = .T. + CKFLD = SPECIAL_FIELDS(LOOKUP, ACTION) + + IF CKFLD <> 'OTHER FIELD LIST' + IF FIELDNUM = 1 + REPLACE USERFILE5->FIELD1 WITH CKFLD + ELSE + REPLACE USERFILE5->FIELD2 WITH CKFLD + ENDIF + ELSE + //* don comment out 9-4-97 +****IF ACTION = 'MATH' .OR. ACTION = 'CUT' + IF ACTION = 'MATH' + SELECT &SELFILE // CURRENT LIST OF ATTRIBUTES TO EDIT + SAVEFILT = DBFILTER() + SET FILTER TO FIELD_TYPE$'UC' + GOTOREC := RECNO() + CURFNAME := ATT_CODE + IF FIELDNUM = 1 + MVALID_FUNC = "VAL_LOOKUP(USERFILE5->FIELD1, SELFILE, @_@, {'ATT_CODE','ATT_DESC(ATT_CODE)'}," + MVALID_FUNC=MVALID_FUNC + " 'Y' ,.F., 'USERFILE5->FIELD1'," + ELSE + MVALID_FUNC = "VAL_LOOKUP(USERFILE5->FIELD2, SELFILE, @_@, {'ATT_CODE','ATT_DESC(ATT_CODE)'}," + MVALID_FUNC=MVALID_FUNC + " 'Y' ,.F., 'USERFILE5->FIELD2'," + ENDIF + MVALID_FUNC=MVALID_FUNC + " {10,20})" + VFUNC2DO = SET_VALID(MVALID_FUNC,1) + RESULT= &VFUNC2DO + IF LASTKEY() = 13 + CKFLD = TFILE->ATT_CODE // FORCE CKFLD TO WHAT WAS SELECTED! + ENDIF + ELSE // ACTION = CUT + IF ACTION = 'CUT' + ENDIF + ENDIF + ENDIF + RESTSCREEN(,,,,SCRNVAR) + + KEYBOARD CHR(21) // CONTROL 'U' TO CLEAR THE CURRENT GET FIELD + IF ACTION = 'MATH' + SELECT &SELFILE // LIST OF ATTRIBUTES UNDER EDIT + SET FILTER TO &SAVEFILT + GOTO GOTOREC + ENDIF + SELECT (SAVESEL) // CURRENT MATHPACK UNDER EDIT + BROW_PICK = .T. + IF LASTKEY() = 27 + RETURN .F. + ENDIF +ENDIF + + +SELECT (SAVESEL) // CURRENT MATHPACK +GOODVAR := '' +REPVAR := ALLTRIM(CKFLD) +NUMDEC := 0 +IF LEN(REPVAR) = 0 + MATH_FLDERROR() + SELECT (SAVESEL) // CURRENT MATHPACK + RETURN .F. +ENDIF + +// CHECK FOR ALPHA FIELD (!NUMERIC) +FOR I = 1 TO LEN(REPVAR) + CKCHAR := SUBSTR(REPVAR,I,1) + IF !(CKCHAR$'0123456789-.') + I := 999 // NOT A NUMERIC VALUE!!! + ELSE + IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) + GOODVAR := GOODVAR + CKCHAR + ELSE + IF CKCHAR = '-' + IF I = 1 + GOODVAR := GOODVAR + CKCHAR + ELSE + I := 999 // NOT A NUMERIC VALUE!! + ENDIF + ELSE + IF CKCHAR = '.' + NUMDEC ++ + IF NUMDEC = 1 + GOODVAR := GOODVAR + CKCHAR + ELSE + I := 999 // NOT A NUMERIC VALUE + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +NEXT +// IF < 999, THEN PASSED THE NUMERIC TEST +IF I < 999 + + SELECT (SAVESEL) + IF FIELDNUM = 1 + REPLACE FIELD1TYPE WITH 'N' + ELSE + IF FIELDNUM = 2 + REPLACE FIELD2TYPE WITH 'N' + ENDIF + ENDIF + IF CK_VALDEC + IF VALID_DECIMAL(VAL(CKFLD)) + RETURN .T. + ELSE + RETURN .F. + ENDIF + ELSE + RETURN .T. + ENDIF +ENDIF + +//IF REPVAR = 'WIDTH, HEIGHT, UI SIZE, SQFT' // CHECK RESERVED WORD FUNCTION + +// CHECK FOR PRIOR LINE +GOODVAR := '' +REPVAR := ALLTRIM(CKFLD) +FOR I = 1 TO LEN(REPVAR) + CKCHAR := SUBSTR(REPVAR,I,1) + IF I = 1 .AND. CKCHAR <> 'L' + I := 999 + ELSE + GOODVAR := GOODVAR + CKCHAR + II := I + NUMPART := '' + DO WHILE II < LEN(REPVAR) + II++ + CKCHAR := SUBSTR(REPVAR,II,1) + IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) + GOODVAR := GOODVAR + CKCHAR + NUMPART := NUMPART + CKCHAR + ELSE + II := 999 + I := 999 + ENDIF + ENDDO + IF LEN(NUMPART) > 0 + IF VAL(NUMPART) >= RECNO() + I := 999 + ENDIF + ENDIF + ENDIF +NEXT + +** IF 1ST CHAR <> L OR OTHER ALPHA, FAILED ABOVE +** ELSE IT WAS A PRIOR LINE AND RETURN .T. +IF I < 999 +**SELECT USERFILE5 // CURRENT MATHPACK + SELECT (SAVESEL) // CURRENT MATHPACK + IF FIELDNUM = 1 + REPLACE FIELD1TYPE WITH 'P' + ELSE + IF FIELDNUM = 2 + REPLACE FIELD2TYPE WITH 'P' + ENDIF + ENDIF + RETURN .T. +ENDIF + +// CHECK FOR VALID ATTRIBUTE NAME +CURREC2 = 1 +IF ACTION = 'MATH' + SELECT &SELFILE // CURRENT ATTRIBUTE FILE UNDER EDIT + CURREC2 := RECNO() + LOCATE FOR ALLTRIM(ATT_CODE) == ALLTRIM(CKFLD) .AND. FIELD_TYPE$'UC' + IF FOUND() + GOODREC = .T. + ELSE + // SEE IF IT'S A SPECIAL FIELD! + IF ASCAN(M_ARR, {|X| X==ALLTRIM(CKFLD) }) > 0 + GOODREC = .T. + ENDIF + ENDIF +ELSE + IF ACTION = 'CUT' + // SEE IF IT'S A SPECIAL FIELD! + SELECT ATTRIBUTES + SEEK CKFLD + IF FOUND() + GOODREC := .T. + ELSE + IF ASCAN(M_ARR, {|X| X==ALLTRIM(CKFLD) }) > 0 + GOODREC = .T. + ENDIF + ENDIF + ELSE + IF ASCAN(M_ARR, {|X| X==ALLTRIM(CKFLD) }) > 0 + GOODREC = .T. + ENDIF + ENDIF +ENDIF + +IF !GOODREC + SELECT &SELFILE // CURRENT ATTRIBUTES UNDER EDIT + GOTO CURREC2 + SELECT (SAVESEL) // CURRENT MATHPACK + MATH_FLDERROR() + RETURN .F. +ELSE // VALID ATTRIBUTE NAME ENTERED + SELECT (SAVESEL) // CURRENT MATHPACK + IF FIELDNUM = 1 + REPLACE FIELD1TYPE WITH 'F' // DATATYPE OF FIELD + ELSE + IF FIELDNUM = 2 + REPLACE FIELD2TYPE WITH 'F' + ENDIF + ENDIF + IF ACTION = 'MATH' + SELECT &SELFILE // CURRENT ATTRIBUTE FILE + GOTO CURREC2 + ENDIF + SELECT (SAVESEL) // CURRENT MATHPACK + RETURN .T. +ENDIF + +****************************************************** + +PROCEDURE MATH_FLDERROR +ERR_BOX( ' Enter an ATTRIBUTE CODE which is ', ; + ' "USER ENTERED" or "CALCULATED", ',; + ' or L1, L2, etc. for PRIOR LINES.',; + ' (Press "?" to Browse Field Names)') +KEYBOARD CHR(19) +RETURN + + +******************************************* +FUNCTION CK_M_COMMAND(SELFILE) +SELECT USERFILE5 +IF !M_COMMAND$'IDR ' + ERR_BOX( 'VALID COMMANDS ARE: I = Insert',; + ' R = Repeat', ; + ' D = Delete') + RETURN .F. +ENDIF + +IF M_COMMAND=' ' + RETURN .T. +ENDIF + +IF SELFILE = NIL + SELFILE := 'USERFILE2' +ENDIF + +IF M_COMMAND = 'D' + IF RECNO() = 1 + GOTOREC := RECNO() - 1 + ELSE + GOTOREC := 1 + ENDIF + DELETE + PACK + GOTO GOTOREC + RETURN .T. +ENDIF + +IF M_COMMAND = 'I' + GOTOREC := RECNO() + APPEND BLANK + GOTO BOTTOM + DO WHILE RECNO() <> GOTOREC + SKIP -1 + P_CAT_CODE := CAT_CODE + P_ATT_CODE := ATT_CODE + P_FIELD1 := FIELD1 + P_FIELD1TYPE := FIELD1TYPE + P_OPERATOR := OPERATOR + P_FIELD2 := FIELD2 + P_FIELD2TYPE := FIELD2TYPE + SKIP 1 + REPLACE CAT_CODE WITH P_CAT_CODE + REPLACE ATT_CODE WITH P_ATT_CODE + REPLACE FIELD1 WITH P_FIELD1 + REPLACE FIELD1TYPE WITH P_FIELD1TYPE + REPLACE FIELD2 WITH P_FIELD2 + REPLACE FIELD2TYPE WITH P_FIELD2TYPE + REPLACE OPERATOR WITH P_OPERATOR + REPLACE LINE_NUM WITH RECNO() + SKIP -1 + ENDDO + REPLACE CAT_CODE WITH CUR_CATEGORY +**REPLACE ATT_CODE WITH USERFILE2->ATT_CODE + REPLACE ATT_CODE WITH (SELFILE)->ATT_CODE + REPLACE FIELD1 WITH SPACE(10) + REPLACE FIELD1TYPE WITH SPACE(1) + REPLACE FIELD2 WITH SPACE(10) + REPLACE FIELD2TYPE WITH SPACE(1) + REPLACE OPERATOR WITH ' ' + REPLACE LINE_NUM WITH RECNO() + REPLACE M_COMMAND WITH ' ' + RETURN .T. +ENDIF + +IF M_COMMAND = 'R' // REPLICATE + GOTOREC := RECNO() + APPEND BLANK + GOTO BOTTOM + DO WHILE RECNO() <> GOTOREC + SKIP -1 + P_CAT_CODE := CAT_CODE + P_ATT_CODE := ATT_CODE + P_FIELD1 := FIELD1 + P_FIELD1TYPE := FIELD1TYPE + P_OPERATOR := OPERATOR + P_FIELD2 := FIELD2 + P_FIELD2TYPE := FIELD2TYPE + SKIP 1 + REPLACE CAT_CODE WITH P_CAT_CODE + REPLACE ATT_CODE WITH P_ATT_CODE + REPLACE FIELD1 WITH P_FIELD1 + REPLACE FIELD1TYPE WITH P_FIELD1TYPE + REPLACE FIELD2 WITH P_FIELD2 + REPLACE FIELD2TYPE WITH P_FIELD2TYPE + REPLACE OPERATOR WITH P_OPERATOR + REPLACE LINE_NUM WITH RECNO() + SKIP -1 + ENDDO + REPLACE M_COMMAND WITH ' ' + RETURN .T. +ENDIF +RETURN .T. /// ?????? + + + +******************************************* +FUNCTION ATT_DESC(MATT_CODE) +// RETURN THE DESCRIPTION FOR MATT_CODE + +LOCAL SAVESEL := SELECT(), RETVAL + +SELECT ATTRIBUTES +SEEK MATT_CODE +RETVAL = DESC +SELECT(SAVESEL) +RETURN RETVAL + + + + + +* * * * * * * * * * * * * * * * * +FUNCTION EVAL_MATH(PACKMATH, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) +LOCAL X, LASTVAL, I, ELEM +PACK2MATH := PACKMATH +MATHVALUE := {} + +FOR I = 1 TO LEN(PACK2MATH) + + REPVAR1 := ALLTRIM(PACK2MATH[I,1]) + OPER := PACK2MATH[I,2] + REPVAR2 := ALLTRIM(PACK2MATH[I,3]) + + LVAR1 := EVAL_FLD(REPVAR1, I, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) + LVAR2 := EVAL_FLD(REPVAR2, I, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) + + CALCSTR := 'LVAR1 ' + OPER + ' LVAR2' + AADD(MATHVALUE, &CALCSTR) + LASTVAL := MATHVALUE[I] +NEXT +RETURN LASTVAL + + +* * * * * * * * * * * * * * * * * +STATIC FUNCTION EVAL_FLD(REPVAR, ELEM, GET_ARR, MCAT_CODE, MATT_CODE, SELFILE, WHEREFROM) + +LOCAL MELEM + +REPVAR = ALLTRIM(REPVAR) + +NUMPART := '' + + +DO CASE + + CASE SPEC_FLD(REPVAR, WHEREFROM) // IS IT A SPECIAL FIELD + RETURN SPECFLD_VALUE(REPVAR,SELFILE,WHEREFROM) + + CASE CKNUM(REPVAR) + RETURN VAL(REPVAR) + + CASE CKPRIOR(REPVAR) + RETURN MATHVALUE[VAL(NUMPART)] + +ENDCASE + +// CHECK FOR ATTRIBUTE VALUE +MELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == REPVAR}) +IF MELEM > 0 + RETURN DECVAL(GET_ARR[MELEM,4]) +ENDIF + +ERR_BOX( 'INVALID REFERENCE IN MATH PACK!!!',; + 'CATEGORY -' + ALLTRIM(MCAT_CODE) + ' ATTRIBUTE ' + MATT_CODE,; + 'VARIABLE IN ERROR - ' + REPVAR) + +RETURN 0 + +************************************************* +FUNCTION SPECFLD_VALUE(MSPEC_FLD, SELFILE) +LOCAL LINEFILE := 'ORD_LINES', OR_ARR +LOCAL SEEKKEY, RAN_SLID, ADDL_MODE, ITEM_CAT_CODE, IS_ALWAYS_SLID + +********************************************************* +***** YOU MUST ALSO UPDATE THE STUFF IN ****** +***** THE "EVAL SPECIAL FIELDS FUNCTION " ****** +***** SPECIAL_FIELDS(LOOK_UP,FROM) LOCATED BELOW. **** +***** ****** +********************************************************* + +// RETURN THE VALUE OF THE MSPEC_FLD +IF SELFILE <> NIL + LINEFILE := SELFILE +ELSE + ? ABEND + IF SELECT('USERFILE2') > 0 + LINEFILE := 'USERFILE2' + ENDIF +ENDIF + + +DO CASE + + CASE MSPEC_FLD = 'WIDTH' + RETURN DECVAL(&LINEFILE->WIDTH) + + CASE MSPEC_FLD = 'HEIGHT' + RETURN DECVAL(&LINEFILE->HEIGHT) + + CASE MSPEC_FLD = "TT WIDTH'" + RETURN (LINEFILE)->ACT_WIDTH / 12 + + CASE MSPEC_FLD = 'TT WIDTH' + RETURN (LINEFILE)->ACT_WIDTH + + CASE MSPEC_FLD = "TT HEIGHT'" + RETURN (LINEFILE)->ACT_HEIGHT / 12 + + CASE MSPEC_FLD = 'TT HEIGHT' + RETURN (LINEFILE)->ACT_HEIGHT + + CASE MSPEC_FLD = 'NOM WIDTH' + RETURN (LINEFILE)->NOM_WIDTH + + CASE MSPEC_FLD = 'NOM HEIGHT' + RETURN (LINEFILE)->NOM_HEIGHT + + CASE MSPEC_FLD = 'UI SIZE' + RETURN (LINEFILE)->UI_SIZE + + CASE MSPEC_FLD = 'SIZE' + RETURN (LINEFILE)->ENTRY_SIZE + + CASE MSPEC_FLD = 'SQFT' + RETURN (LINEFILE)->SQFT + + CASE MSPEC_FLD = 'IN STOCK' + RETURN (LINEFILE)->IN_STOCK + + CASE MSPEC_FLD = 'STD SIZE' + RETURN (LINEFILE)->STD_SIZE + + CASE MSPEC_FLD = 'ORIEL SIZE' + RETURN (LINEFILE)->ORIEL_SIZE + + CASE MSPEC_FLD = 'CMR' + IF (LINEFILE)->ORIEL_SIZE$'N' + RETURN (LINEFILE)->ACT_HEIGHT / 2 + ELSE + IF CUR_OO = 'ADDL_OPTS' + ADDL_MODE := .T. + ELSE + ADDL_MODE := .T. + ENDIF + RAN_SLID := CK_SLIDER(SELFILE, CUR_OO, ADDL_MODE) + ITEM_CAT_CODE = GET_CATCODE( (SELFILE)->PROD_CODE) + OR_ARR := CK_ORIEL(ITEM_CAT_CODE, SELFILE, CUR_OO, ADDL_MODE, RAN_SLID ) + RETURN (LINEFILE)->ACT_HEIGHT - OR_ARR[2] // TOTAL - BOTTOM + ENDIF + + CASE MSPEC_FLD = 'BAL SIZE' .OR. ; //**P3N - 3/24/99 + MSPEC_FLD = 'HTLESSBAL' //**P3N - 6/29/01 + IF CUR_OO = 'ADDL_OPTS' //**P3N - 3/24/99 + ADDL_MODE := .T. //**P3N - 3/24/99 + ELSE //**P3N - 3/24/99 + ADDL_MODE := .F. //**P3N - 3/24/99 + ENDIF //**P3N - 3/24/99 + ITEM_CAT_CODE := GET_CATCODE((SELFILE)->PROD_CODE) //**P3N - 3/24/99 + RAN_SLID := CK_SLIDER(SELFILE, CUR_OO, ADDL_MODE) //**P3N - 3/24/99 + IS_ALWAYS_SLID := ALWAYS_SLIDER(SELFILE, CUR_OO, ADDL_MODE) + OR_ARR := CK_ORIEL(ITEM_CAT_CODE, SELFILE, CUR_OO, ADDL_MODE, RAN_SLID, IS_ALWAYS_SLID ) + IF MSPEC_FLD = 'BAL SIZE' //**P3N - 6/29/01 + IF EMPTY(OR_ARR[3]) //**P3N - 3/24/99 + RETURN 0 //**P3N - 3/24/99 + ELSE //**P3N - 3/24/99 + RETURN VAL(OR_ARR[3]) // BALANCE SIZE //**P3N - 3/24/99 + ENDIF + ELSE //**P3N - 6/29/01 + IF EMPTY(OR_ARR[9]) //**P3N - 6/29/01 + RETURN 0 //**P3N - 6/29/01 + ELSE //**P3N - 6/29/01 + RETURN OR_ARR[9] // DIFF BETWEEN HT AND BAL //**P3N - 6/29/01 + ENDIF //**P3N - 6/29/01 + ENDIF //**P3N - 6/29/01 + + CASE MSPEC_FLD = 'SALE PRICE' + RETURN (LINEFILE)->SALE_PRICE + + CASE MSPEC_FLD = 'MODEL' + RETURN (LINEFILE)->PROD_CODE + + CASE MSPEC_FLD = 'ATTACH TO' + RETURN (LINEFILE)->PAR_PROD + + CASE MSPEC_FLD = 'DELIVERY' + RETURN (CUR_MAST)->PICK_DEL + + CASE MSPEC_FLD = 'HOW MEAS' + RETURN (LINEFILE)->HOW_MEAS + + CASE MSPEC_FLD = 'PRICING' + RETURN (LINEFILE)->PRICE_SHT + + CASE MSPEC_FLD = 'QUANTITY' + RETURN (LINEFILE)->QUANTITY + + CASE MSPEC_FLD = 'CATEGORY' + RETURN = GET_CATCODE( (LINEFILE)->PROD_CODE ) + + CASE MSPEC_FLD = 'CUSTOMER' + RETURN (CUR_MAST)->CUST_ID + + CASE MSPEC_FLD = 'ITEM PRICE' + RETURN (LINEFILE)->BASE_PRI + ; + (LINEFILE)->OPT_PRI + ; + (LINEFILE)->EXT_PRICE // ADD ALL PRICE COMPONENTS SO FAR + + CASE MSPEC_FLD = 'BASE PRICE' + RETURN (LINEFILE)->BASE_PRI + + OTHERWISE + ERR_BOX('*** INVALID CALL TO SPEC FIELDS ' , ; + '*** Lookup Value was ' + MSPEC_FLD ) + RETURN NIL +END CASE + + + + + +********************************************************* +***** YOU MUST ALSO UPDATE THE STUFF IN ****** +***** THE "EVAL SPECIAL FIELDS FUNCTION " ****** +***** SPECFLD_VALUE(MSPEC_FLD) LOCATED ABOVE. ****** +***** ****** +********************************************************* + +FUNCTION SPECIAL_FIELDS(LOOKUP, FROM) +// IF NOT A LOOKUP, RETURN THE SPECIAL FIELD ARRAY +// ELSE, CHECK THE FIELD NAME FOR SPECIAL NAME IN RULE OR MATHPACK +// M_ARR HOLDS A LIST OF SPECIAL FIELDS PLUS 'OTHER FIELD LIST' +// FROM = RULE OR MATH + +LOCAL M_ARR := {}, NCHOICE := 0, SCRNVAR + +STATIC MARRMATH +STATIC MARROTHER +STATIC MARR_CUT +STATIC MARR_MISC + +IF MARR_CUT = NIL + MARR_CUT = {} + AADD(MARR_CUT, 'BAL SIZE') //** P3N - 3/24/99 + AADD(MARR_CUT, 'CMR') + AADD(MARR_CUT, 'HTLESSBAL') //** P3N - 6/29/01 + AADD(MARR_CUT, 'NOM HEIGHT') + AADD(MARR_CUT, 'NOM WIDTH') + AADD(MARR_CUT, 'TT HEIGHT') + AADD(MARR_CUT, 'TT WIDTH') + //* don comment out 9-4-97 +**AADD(MARR_CUT, 'OTHER FIELD LIST') +ENDIF + +IF MARR_MISC= NIL + MARR_MISC= {} + AADD(MARR_MISC, 'HEIGHT') + AADD(MARR_MISC, 'WIDTH') +ENDIF + +IF MARRMATH = NIL .OR. MARROTHER = NIL + AADD(M_ARR, 'ATTACH TO') + AADD(M_ARR, 'BASE PRICE') + AADD(M_ARR, 'BAL SIZE') //** P3N - 3/24/99 + AADD(M_ARR, 'CATEGORY') + AADD(M_ARR, 'CUSTOMER') + AADD(M_ARR, 'DELIVERY') + AADD(M_ARR, 'HEIGHT') + AADD(M_ARR, 'HTLESSBAL') //** P3N - 6/29/01 + AADD(M_ARR, 'HOW MEAS') + AADD(M_ARR, 'IN STOCK') + AADD(M_ARR, 'ITEM PRICE') + AADD(M_ARR, 'MODEL') + AADD(M_ARR, 'NOM HEIGHT') + AADD(M_ARR, 'NOM WIDTH') + AADD(M_ARR, 'ORIEL SIZE') + AADD(M_ARR, 'PRICING') + AADD(M_ARR, 'QUANTITY') + AADD(M_ARR, 'SALE PRICE') + AADD(M_ARR, 'SIZE') + AADD(M_ARR, 'SQFT') + AADD(M_ARR, 'STD SIZE') + AADD(M_ARR, 'TT HEIGHT') + AADD(M_ARR, "TT HEIGHT'") + AADD(M_ARR, 'TT WIDTH') + AADD(M_ARR, "TT WIDTH'") + AADD(M_ARR, 'UI SIZE') + AADD(M_ARR, 'WIDTH') + MARROTHER := ACLONE(M_ARR) + + AADD(M_ARR, 'OTHER FIELD LIST') + MARRMATH := ACLONE(M_ARR) +ENDIF +IF FROM = 'MATH' + M_ARR := MARRMATH +ELSE + IF FROM = 'CUT' + M_ARR = MARR_CUT + ELSE + IF FROM = 'MISC' + M_ARR := MARR_MISC + ELSE + M_ARR := MARROTHER + ENDIF + ENDIF +ENDIF + +IF !LOOKUP + RETURN M_ARR +ENDIF + +SCRNVAR := SAVESCREEN() +// MSG, SELECT "SQFT", "UI SIZE", "HEIGHT" "WIDTH" OR ITEM FROM THE FOLLOWING LIST + +DO WHILE .T. + NCHOICE = LISTBOX(M_ARR,1,'Select One') + IF LASTKEY() = 27 + RESTSCREEN(,,,,SCRNVAR) + RETURN '' + ENDIF + IF LASTKEY() = 13 + RESTSCREEN(,,,,SCRNVAR) + RETURN M_ARR[NCHOICE] + ENDIF +ENDDO + + + + +**************************************************** +FUNCTION DECVAL(C_NUM) +// CONVERT THE CHARACTER STRING M_NUM INTO A DECIMAL VALUE +// +// FRACTIONS ARE REPRESENTED AS 3/4, 1/8 ........ + +LOCAL SLASH_POS, SPACE_POS, WHOLE_NUM, FRACTION +LOCAL TOP_FRACTION, BOTT_FRACTION, DECIMAL_NUM := 0.0000, SAVE_DEC +LOCAL FTPOS, NUMFT, NUMIN + +FTPOS := AT("'", C_NUM) +IF FTPOS = 0 + NUMFT := 0 +ELSE + NUMFT := VAL( SUBS( C_NUM,1,FTPOS ) ) + C_NUM := ALLTRIM( SUBS( C_NUM, FTPOS + 1 ) ) +ENDIF + +SLASH_POS = AT('/', C_NUM) +IF SLASH_POS = 0 + RETURN (NUMFT * 12) + VAL(C_NUM) +ENDIF + +SPACE_POS = AT(' ', C_NUM) +IF SPACE_POS > SLASH_POS // NO WHOLE NUMBER! + WHOLE_NUM = 0 + SPACE_POS = 1 +ELSE + WHOLE_NUM = VAL(LEFT(C_NUM, SPACE_POS-1)) + SPACE_POS++ // POINT TO FIRST FRACTION DIGIT! +ENDIF + +IF SLASH_POS = 0 // NO FRACTION! + TOP_FRACTION = 0 +ELSE + TOP_FRACTION = VAL(SUBSTR(C_NUM, SPACE_POS, SLASH_POS-SPACE_POS)) + BOTT_FRACTION = VAL(SUBSTR(C_NUM, SLASH_POS+1)) + SET DECIMALS TO 4 + DECIMAL_NUM = (TOP_FRACTION * 100) / (BOTT_FRACTION * 100) + SET DECIMALS TO 2 +ENDIF +RETVAL = ( NUMFT * 12 ) + WHOLE_NUM + DECIMAL_NUM +RETURN RETVAL + + +**************************************************** + \ No newline at end of file diff --git a/CGWPDEF.PRG b/CGWPDEF.PRG new file mode 100644 index 0000000..00f6dc1 --- /dev/null +++ b/CGWPDEF.PRG @@ -0,0 +1,1230 @@ + +#Include "MyStd.ch" +#INCLUDE "INKEY.CH" +#INCLUDE "FIVEWIN.CH" +#INCLUDE "DBINFO.CH" +#INCLUDE "COMMON.CH" + + +********** +// THIS PRG IS A print port manager for lib programs +// needing multiple output routings. +// will be called IF FILE('PRINTERS.DBF') + +FUNCTION CUSTOMPRINT_WINDOWS( ) + +LOCAL CLOSE_ARR := {}, PRN_LIST := {} +LOCAL RETVAL := .T., oDIALOG + +LOCAL OSAY101A, OSAY101B +LOCAL OSAY102A, OSAY102B +LOCAL OSAY103A, OSAY103B +LOCAL OSAY104A, OSAY104B +LOCAL OSAY105A, OSAY105B +LOCAL OSAY106A, OSAY106B +LOCAL OSAY107A, OSAY107B +LOCAL OSAY108A, OSAY108B +LOCAL OSAY109A, OSAY109B +LOCAL OSAY110A, OSAY110B +LOCAL OSAY111A, OSAY111B +LOCAL OSAY112A, OSAY112B + +LOCAL MRPTPRTR := GETPRINTER('ReportPrinter') +LOCAL MRPTPORT := GETPRINTER('ReportPort') +LOCAL MRPTDEV := GETPRINTER('ReportDevice') + +LOCAL MPRODPRTR := GETPRINTER('ProdPrinter') +LOCAL MPRODPORT := GETPRINTER('ProdPort') +LOCAL MPRODDEV := GETPRINTER('ProdDevice') + +LOCAL MORDPRTR := GETPRINTER('OrdDeskPrinter') +LOCAL MORDPORT := GETPRINTER('OrdDeskPort') +LOCAL MORDDEV := GETPRINTER('OrdDeskDevice') + +LOCAL MINVPRTR := GETPRINTER('InvPrinter') +LOCAL MINVPORT := GETPRINTER('InvPort') +LOCAL MINVDEV := GETPRINTER('InvDevice') + +LOCAL MDELPRTR := GETPRINTER('DelPrinter') +LOCAL MDELPORT := GETPRINTER('DelPort') +LOCAL MDELDEV := GETPRINTER('DelDevice') + +LOCAL MGOLDPRTR := GETPRINTER('GoldenPrinter') +LOCAL MGOLDPORT := GETPRINTER('GoldenPort') +LOCAL MGOLDDEV := GETPRINTER('GoldenDevice' ) + +LOCAL MMAILPRTR := GETPRINTER('MailLblPrinter') +LOCAL MMAILPORT := GETPRINTER('MailLblPort') +LOCAL MMAILDEV := GETPRINTER('MailLblDevice') + +LOCAL MICOMPPRTR := GETPRINTER('InterCompPrinter') +LOCAL MICOMPPORT := GETPRINTER('InterCompPort') +LOCAL MICOMPDEV := GETPRINTER('InterCompDevice') + +LOCAL MBACKOPRTR := GETPRINTER('BackOrdPrinter') +LOCAL MBACKOPORT := GETPRINTER('BackOrdPort') +LOCAL MBACKODEV := GETPRINTER('BackOrdDevice') + +LOCAL MQUOTEPRTR := GETPRINTER('QuotePrinter') +LOCAL MQUOTEPORT := GETPRINTER('QuotePort') +LOCAL MQUOTEDEV := GETPRINTER('QuoteDevice') + +LOCAL MPREBPRTR := GETPRINTER('PreBillPrinter') +LOCAL MPREBPORT := GETPRINTER('PreBillPort') +LOCAL MPREBDEV := GETPRINTER('PreBillDevice') + +LOCAL MPRECPRTR := GETPRINTER('PreCostPrinter') +LOCAL MPRECPORT := GETPRINTER('PreCostPort') +LOCAL MPRECDEV := GETPRINTER('PreCostDevice') + +SET RESOURCES TO //** GET RESOURCES FROM THE ".EXE" +DEFINE DIALOG oDIALOG RESOURCE "DLG_PRNTR9" //** P3N - 09/13/04 NEW PRINTER DIALOG - HARBOUR/FWH UPGRADE + + REDEFINE SAY oSAY101A VAR MRPTPRTR ID 101 OF oDIALOG + REDEFINE SAY oSAY101B VAR MRPTPORT ID 102 OF oDIALOG + + REDEFINE SAY oSAY102A VAR MPRODPRTR ID 103 OF oDIALOG + REDEFINE SAY oSAY102B VAR MPRODPORT ID 104 OF oDIALOG + + REDEFINE SAY oSAY103A VAR MORDPRTR ID 105 OF oDIALOG + REDEFINE SAY oSAY103B VAR MORDPORT ID 106 OF oDIALOG + + REDEFINE SAY oSAY104A VAR MINVPRTR ID 107 OF oDIALOG + REDEFINE SAY oSAY104B VAR MINVPORT ID 108 OF oDIALOG + + REDEFINE SAY oSAY105A VAR MDELPRTR ID 109 OF oDIALOG + REDEFINE SAY oSAY105B VAR MDELPORT ID 110 OF oDIALOG + + REDEFINE SAY oSAY106A VAR MGOLDPRTR ID 111 OF oDIALOG + REDEFINE SAY oSAY106B VAR MGOLDPORT ID 112 OF oDIALOG + + REDEFINE SAY oSAY107A VAR MMAILPRTR ID 113 OF oDIALOG + REDEFINE SAY oSAY107B VAR MMAILPORT ID 114 OF oDIALOG + + REDEFINE SAY oSAY108A VAR MICOMPPRTR ID 115 OF oDIALOG + REDEFINE SAY oSAY108B VAR MICOMPPORT ID 116 OF oDIALOG + + REDEFINE SAY oSAY109A VAR MBACKOPRTR ID 117 OF oDIALOG + REDEFINE SAY oSAY109B VAR MBACKOPORT ID 118 OF oDIALOG + + REDEFINE SAY oSAY110A VAR MQUOTEPRTR ID 119 OF oDIALOG + REDEFINE SAY oSAY110B VAR MQUOTEPORT ID 120 OF oDIALOG + + REDEFINE SAY oSAY111A VAR MPREBPRTR ID 121 OF oDIALOG + REDEFINE SAY oSAY111B VAR MPREBPORT ID 122 OF oDIALOG + + REDEFINE SAY oSAY112A VAR MPRECPRTR ID 123 OF oDIALOG + REDEFINE SAY oSAY112B VAR MPRECPORT ID 124 OF oDIALOG + + + REDEFINE BUTTON ID 9901 OF oDIALOG ; + ACTION ( SETPRNTR('Report'), ; + MRPTPRTR := GETPRINTER('ReportPrinter'), ; + MRPTPORT := GETPRINTER('ReportPort'), ; + oSAY101a:REFRESH(), ; + oSAY101b:REFRESH() ) + + + REDEFINE BUTTON ID 9902 OF oDIALOG ; + ACTION ( SETPRNTR('Prod'), ; + MPRODPRTR := GETPRINTER('ProdPrinter'),; + MPRODPORT := GETPRINTER('ProdPort'), ; + oSAY102a:REFRESH(), ; + oSAY102b:REFRESH() ) + + + REDEFINE BUTTON ID 9903 OF oDIALOG ; + ACTION ( SETPRNTR('OrdDesk'), ; + MORDPRTR := GETPRINTER('OrdDeskPrinter'),; + MORDPORT := GETPRINTER('OrdDeskPort'), ; + oSAY103A:REFRESH(), ; + oSAY103B:REFRESH() ) + + REDEFINE BUTTON ID 9904 OF oDIALOG ; + ACTION ( SETPRNTR('Inv'), ; + MINVPRTR := GETPRINTER('InvPrinter'), ; + MINVPORT := GETPRINTER('InvPort'), ; + oSAY104A:REFRESH(), ; + oSAY104B:REFRESH() ) + + + REDEFINE BUTTON ID 9905 OF oDIALOG ; + ACTION ( SETPRNTR('Del'), ; + MDELPRTR := GETPRINTER('DelPrinter'),; + MDELPORT := GETPRINTER('DelPort'), ; + oSAY105A:REFRESH(), ; + oSAY105B:REFRESH() ) + + + REDEFINE BUTTON ID 9906 OF oDIALOG ; + ACTION ( SETPRNTR('Golden'), ; + MPRODPRTR := GETPRINTER('GoldenPrinter'),; + MPRODPORT := GETPRINTER('GoldenPort'), ; + oSAY106A:REFRESH(), ; + oSAY106B:REFRESH() ) + + REDEFINE BUTTON ID 9907 OF oDIALOG ; + ACTION ( SETPRNTR('MailLbl'), ; + MMAILPRTR := GETPRINTER('MailLblPrinter'),; + MMAILPORT := GETPRINTER('MailLblPort'), ; + oSAY107A:REFRESH(), ; + oSAY107B:REFRESH() ) + + REDEFINE BUTTON ID 9908 OF oDIALOG ; + ACTION ( SETPRNTR('InterComp'), ; + MICOMPPRTR := GETPRINTER('InterCompPrinter'), ; + MICOMPPORT := GETPRINTER('InterCompPort'), ; + oSAY108A:REFRESH(), ; + oSAY108B:REFRESH() ) + + + REDEFINE BUTTON ID 9909 OF oDIALOG ; + ACTION ( SETPRNTR('BackOrd'), ; + MBACKOPRTR := GETPRINTER('BackOrdPrinter'),; + MBACKOPORT := GETPRINTER('BackOrdPort'), ; + oSAY109A:REFRESH(), ; + oSAY109B:REFRESH() ) + + + REDEFINE BUTTON ID 9910 OF oDIALOG ; + ACTION ( SETPRNTR('Quote'), ; + MQUOTEPRTR := GETPRINTER('QuotePrinter'),; + MQUOTEPORT := GETPRINTER('QuotePort'), ; + oSAY110A:REFRESH(), ; + oSAY110B:REFRESH() ) + + REDEFINE BUTTON ID 9911 OF oDIALOG ; + ACTION ( SETPRNTR('PreBill'), ; + MPREBPRTR := GETPRINTER('PreBillPrinter'), ; + MPREBPORT := GETPRINTER('PreBillPort'), ; + oSAY111A:REFRESH(), ; + oSAY111B:REFRESH() ) + + REDEFINE BUTTON ID 9912 OF oDIALOG ; + ACTION ( SETPRNTR('PreCost'), ; + MPRECPRTR := GETPRINTER('PreCostPrinter'), ; + MPRECPORT := GETPRINTER('PreCostPort'), ; + oSAY112A:REFRESH(), ; + oSAY112B:REFRESH() ) + + + REDEFINE BUTTON ID 9999 OF oDIALOG ; + CANCEL ; + ACTION odialog:end() + + ACTIVATE DIALOG oDIALOG CENTERED ; + VALID(MRPTPRTR := GETPRINTER('ReportPrinter'), ; + MPRODPRTR := GETPRINTER('ProdPrinter'), ; + MORDPRTR := GETPRINTER('OrdDeskPrinter'),; + MINVPRTR := GETPRINTER('InvPrinter'), ; + MDELPRTR := GETPRINTER('DelPrinter'), ; + MGOLDPRTR := GETPRINTER('GoldenPrinter'), ; + MMAILPRTR := GETPRINTER('MailLblPrinter'), ; + MICOMPPRTR := GETPRINTER('InterCompPrinter'), ; + MBACKOPRTR := GETPRINTER('BackOrdPrinter'), ; + MQUOTEPRTR := GETPRINTER('QuotePrinter'), ; + MPREBPRTR := GETPRINTER('PreBillPrinter'), ; + MPRECPRTR := GETPRINTER('PreCostPrinter'), ; + RETVAL := VALIDPRTRS( MRPTPRTR, MPRODPRTR, MORDPRTR, MINVPRTR, ; + MDELPRTR, MGOLDPRTR, MMAILPRTR, MICOMPPRTR, ; + MBACKOPRTR, MQUOTEPRTR, MPREBPRTR, MPRECPRTR ) ) + + + + +RETURN RETVAL + + + + + + +********************************************************* + + + + +/* + + + + + +//* - SELECT A PRINTER FROM THE TABLE BELOW +//* +//* draw input screen +//* +/* +AADD(PRN_LIST , 'OKI') +AADD(PRN_LIST , 'EPS') +AADD(PRN_LIST , 'PRW') +AADD(PRN_LIST , 'PRN') +AADD(PRN_LIST , 'P90') +AADD(PRN_LIST , 'HPJ') +AADD(PRN_LIST , 'HPD') +AADD(PRN_LIST , 'HP4') + + + +_REPTPRNT := STR(ASCAN(PRN_LIST, {|X| X = REPT_PRN}),1) +_BOPRNT := STR(ASCAN(PRN_LIST, {|X| X = BO_PRN}),1) //** P3N - 4/30/98 +_PRODPRNT := STR(ASCAN(PRN_LIST, {|X| X = PROD_PRN}),1) +_ODPRNT := STR(ASCAN(PRN_LIST, {|X| X = OD_PRN}),1) +_INVPRNT := STR(ASCAN(PRN_LIST, {|X| X = INV_PRN}),1) +_DELPRNT := STR(ASCAN(PRN_LIST, {|X| X = DEL_PRN}),1) +_GRPRNT := STR(ASCAN(PRN_LIST, {|X| X = GR_PRN}),1) +_ICPRNT := STR(ASCAN(PRN_LIST, {|X| X = IC_PRN}),1) +_LBLPRNT := STR(ASCAN(PRN_LIST, {|X| X = LBL_PRN}),1) +_QTEPRNT := STR(ASCAN(PRN_LIST, {|X| X = INV_PRN}),1) +_PREPRNT := STR(ASCAN(PRN_LIST, {|X| X = INV_PRN}),1) +IF FIELDPOS('QTE_PRN') > 0 //** P3N - 4/13/98 + _QTEPRNT := STR(ASCAN(PRN_LIST, {|X| X = QTE_PRN}),1) +ENDIF +IF FIELDPOS('PRE_PRN') > 0 //** P3N - 4/13/98 + _PREPRNT := STR(ASCAN(PRN_LIST, {|X| X = PRE_PRN}),1) +ENDIF +M_LPTR := REPT_PORT +M_LPTP := PROD_PORT +M_LPTO := OD_PORT +M_LPTI := INV_PORT +M_LPTD := DEL_PORT +M_LPTG := GR_PORT +M_LPTL := LBL_PORT +M_LPTIC := IC_PORT +M_LPTBO := BO_PORT //** P3N - 4/30/98 +M_LPTQ := INV_PORT //** P3N - 4/13/98 +M_LPTPRE := INV_PORT //** P3N - 4/13/98 +IF FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + M_LPTQ := QTE_PORT //** P3N - 4/13/98 +ENDIF +IF FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + M_LPTPRE := PRE_PORT //** P3N - 4/13/98 +ENDIF + +SELECT WORKSTAT + +DO WHILE .T. + CLEAR + TITLE = 'SELECT PRINTER' + H = ((80 - LEN(TITLE)) / 2) + @ 0,H SAY TITLE + @ 0,74 SAY 'PDEF' + @ 1,0 SAY DOUBLE + @ 3,72 SAY DTOC(DATE()) + @ 5,28 SAY " AVAILABLE PRINTERS " + @ 6,28 SAY " ================== " + @ 7,26 SAY "1. Okidata Microline 84" + @ 8,26 SAY "2. Epson (All Models)" + @ 9,26 SAY "3. HP LaserJet " +**@ 9,26 SAY "3. IBM Proprinter - Wide Carriage" +**@ 10,26 SAY "4. IBM Proprinter - Narrow Carriage" +**@ 11,26 SAY "5. IBM Proprinter - Model 2390 Narrow" +**@ 13,26 SAY "7. HP LaserJet IIID (Duplex printer)" +**@ 14,26 SAY "8. HP LaserJet 4SI (Duplex printer)" +**@ 10,26 SAY "X. RETURN " + LOOP4100 := .T. + DO WHILE LOOP4100 + SET CONFIRM OFF + @ 4,72 SAY TIME() + + @ 12,10 SAY " Select REPORTS Printer : : LPT Port : :" + @ 13,10 SAY " Select PRODUCTION Printer : : LPT Port : :" + @ 14,10 SAY " Select ORDER DESK Printer : : LPT Port : :" + @ 15,10 SAY " Select INVOICE Printer : : LPT Port : :" + @ 16,10 SAY " Select DELIVERY Printer : : LPT Port : :" + @ 17,10 SAY " Select GOLDEN ROD Printer : : LPT Port : :" + @ 18,10 SAY "Select MAILING LABEL Printer : : LPT Port : :" + @ 19,10 SAY " Select INTERCOMPANY Printer : : LPT Port : :" + @ 20,10 SAY " Select BACKORDER Printer : : LPT Port : :" //** P3N 4/30/98 + IF FIELDPOS('QTE_PRN') > 0 .AND. FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + @ 21,10 SAY " Select QUOTE Printer : : LPT Port : :" + ENDIF + IF FIELDPOS('PRE_PRN') > 0 .AND. FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + @ 22,10 SAY " Select PREBILL Printer : : LPT Port : :" + ENDIF + + DO WHILE .T. +//** P3N 4/16/99 ADDED LPT4 OPTION + @ 12,39 GET _REPTPRNT PICTURE '9' VALID CHK_PRN(_REPTPRNT) +//** @ 12,54 GET M_LPTR PICTURE '9' VALID M_LPTR$'123' + @ 12,54 GET M_LPTR PICTURE '9' VALID M_LPTR$'1234' + @ 13,39 GET _PRODPRNT PICTURE '9' VALID CHK_PRN(_PRODPRNT) +//** @ 13,54 GET M_LPTP PICTURE '9' VALID M_LPTP$'123' + @ 13,54 GET M_LPTP PICTURE '9' VALID M_LPTP$'1234' + @ 14,39 GET _ODPRNT PICTURE '9' VALID CHK_PRN(_ODPRNT) +//** @ 14,54 GET M_LPTO PICTURE '9' VALID M_LPTO$'123' + @ 14,54 GET M_LPTO PICTURE '9' VALID M_LPTO$'1234' + @ 15,39 GET _INVPRNT PICTURE '9' VALID CHK_PRN(_INVPRNT) +//** @ 15,54 GET M_LPTI PICTURE '9' VALID M_LPTI$'123' + @ 15,54 GET M_LPTI PICTURE '9' VALID M_LPTI$'1234' + @ 16,39 GET _DELPRNT PICTURE '9' VALID CHK_PRN(_DELPRNT) +//** @ 16,54 GET M_LPTD PICTURE '9' VALID M_LPTD$'123' + @ 16,54 GET M_LPTD PICTURE '9' VALID M_LPTD$'1234' + @ 17,39 GET _GRPRNT PICTURE '9' VALID CHK_PRN(_GRPRNT) +//** @ 17,54 GET M_LPTG PICTURE '9' VALID M_LPTG$'123' + @ 17,54 GET M_LPTG PICTURE '9' VALID M_LPTG$'1234' + @ 18,39 GET _LBLPRNT PICTURE '9' VALID CHK_PRN(_LBLPRNT) +//** @ 18,54 GET M_LPTL PICTURE '9' VALID M_LPTL$'123' + @ 18,54 GET M_LPTL PICTURE '9' VALID M_LPTL$'1234' + @ 19,39 GET _ICPRNT PICTURE '9' VALID CHK_PRN(_ICPRNT) +//** @ 19,54 GET M_LPTIC PICTURE '9' VALID M_LPTIC$'123' + @ 19,54 GET M_LPTIC PICTURE '9' VALID M_LPTIC$'1234' + @ 20,39 GET _BOPRNT PICTURE '9' VALID CHK_PRN(_BOPRNT) //** P3N - 4/30/98 +//** @ 20,54 GET M_LPTBO PICTURE '9' VALID M_LPTBO$'123' + @ 20,54 GET M_LPTBO PICTURE '9' VALID M_LPTBO$'1234' + IF FIELDPOS('QTE_PRN') > 0 .AND. FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + @ 21,39 GET _QTEPRNT PICTURE '9' VALID CHK_PRN(_QTEPRNT) +//** @ 21,54 GET M_LPTQ PICTURE '9' VALID M_LPTQ$'123' + @ 21,54 GET M_LPTQ PICTURE '9' VALID M_LPTQ$'1234' + ENDIF + IF FIELDPOS('PRE_PRN') > 0 .AND. FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + @ 22,39 GET _PREPRNT PICTURE '9' VALID CHK_PRN(_PREPRNT) +//** @ 22,54 GET M_LPTPRE PICTURE '9' VALID M_LPTPRE$'123' + @ 22,54 GET M_LPTPRE PICTURE '9' VALID M_LPTPRE$'1234' + ENDIF + + READ + IF LASTKEY() == 27 .AND. PROCNAME(1) <> 'SET_PRNT_P' + CLS + FOR L = 1 TO LEN(CLOSE_ARR) + MFILE = CLOSE_ARR[L] + SELECT(MFILE) + USE + NEXT + RETURN + ENDIF + + IF EMPTY(M_LPTR) .OR. EMPTY(M_LPTP) .OR. EMPTY(M_LPTO); + .OR. EMPTY(M_LPTI) .OR. EMPTY(M_LPTD) .OR. EMPTY(M_LPTG) + LOOP + ENDIF + CORR = CORRCHEK() + IF CORR = 'Y' + LOOP4100 := .F. + EXIT + ENDIF + IF LASTKEY() == 27 .AND. PROCNAME(1) <> 'SET_PRNT_P' + CLEAR + FOR L = 1 TO LEN(CLOSE_ARR) + MFILE = CLOSE_ARR[L] + SELECT(MFILE) + USE + NEXT + RETURN + ENDIF + ENDDO + ENDDO + SETCOLOR(LNOR) + SELECT WORKSTAT + REC_LOCK(1) + REPLACE REPT_PRN WITH PRN_LIST[VAL(_REPTPRNT)] + REPLACE PROD_PRN WITH PRN_LIST[VAL(_PRODPRNT)] + REPLACE OD_PRN WITH PRN_LIST[VAL(_ODPRNT)] + REPLACE INV_PRN WITH PRN_LIST[VAL(_INVPRNT)] + REPLACE DEL_PRN WITH PRN_LIST[VAL(_DELPRNT)] + REPLACE GR_PRN WITH PRN_LIST[VAL(_GRPRNT)] + REPLACE LBL_PRN WITH PRN_LIST[VAL(_LBLPRNT)] + REPLACE IC_PRN WITH PRN_LIST[VAL(_ICPRNT)] + REPLACE BO_PRN WITH PRN_LIST[VAL(_BOPRNT)] //** P3N - 4/30/98 + IF FIELDPOS('QTE_PRN') > 0 //** P3N - 4/13/98 + REPLACE QTE_PRN WITH PRN_LIST[VAL(_QTEPRNT)] //** P3N - 4/13/98 + ENDIF + IF FIELDPOS('PRE_PRN') > 0 //** P3N - 4/13/98 + REPLACE PRE_PRN WITH PRN_LIST[VAL(_PREPRNT)] //** P3N - 4/13/98 + ENDIF + REPLACE REPT_PORT WITH M_LPTR + REPLACE PROD_PORT WITH M_LPTP + REPLACE OD_PORT WITH M_LPTO + REPLACE INV_PORT WITH M_LPTI + REPLACE DEL_PORT WITH M_LPTD + REPLACE GR_PORT WITH M_LPTG + REPLACE LBL_PORT WITH M_LPTL + REPLACE IC_PORT WITH M_LPTIC + REPLACE BO_PORT WITH M_LPTBO //** P3N - 4/30/98 + IF FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + REPLACE QTE_PORT WITH M_LPTQ //** P3N - 4/13/98 + ENDIF + IF FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + REPLACE PRE_PORT WITH M_LPTPRE //** P3N - 4/13/98 + ENDIF + // RESET THE SYSTEM VARIABLES TOO!!! + **SET_PRNT_PARMS(.F.) //p3n - 2-6-98 + + FOR L = 1 TO LEN(CLOSE_ARR) + MFILE = CLOSE_ARR[L] + SELECT(MFILE) + USE + NEXT + + CLEAR SCREEN + RETURN +ENDDO WHILE .T. + +*/ + + +* * * * * * * * * * * * * * * * * +PROCEDURE SET_PRNT_PARMS(NO_SET_PORT) +// THIS WILL SET UP THE PRINTER VARIABLES +// FOR FORMS, REPORTS, AND ANY LOCAL PRINTING + +LOCAL SEEKKEY, CLOSE_IT, SAVESEL := SELECT(), SVREC + +IF NO_SET_PORT = NIL + NO_SET_PORT := .T. +ENDIF + +TOFILE := SYSCODE + '1WS' + +IF SELECT('WORKSTAT') = 0 + NET_USE('&WORKSTAT', .F., 5, 'WORKSTAT') + CLOSE_IT = .T. +ELSE + SELECT WORKSTAT + CLOSE_IT = .F. +ENDIF + + + +*****SEEKKEY = NETNAME() +SEEKKEY := WSID +IF LEN(TRIM(SEEKKEY)) = 0 + SEEKKEY = 'SINGLE' +ENDIF + +LOCATE FOR ALLTRIM( WS_ID ) == ALLTRIM ( SEEKKEY ) +IF !FOUND() +**ADD_REC(3) +**REPLACE WS_ID WITH NETNAME() + SVREC := RECNO() + INITWS() // NEW WORKSTATION REC - SET DEFAULTS - + INDEX_WS() +**SELECT WORKSTAT + GOTO SVREC + REC_LOCK(1) + REPLACE LNOR_VAR WITH LNOR + REPLACE HNOR_VAR WITH HNOR + REPLACE UNDR_VAR WITH UNDR + REPLACE HREV_VAR WITH HREV + REPLACE BLOW_VAR WITH BLOW + REPLACE BREV_VAR WITH BREV + SELPRINT() // GO GET PRINTER SELECTION INFO +ELSE + _REPORT := WORKSTAT->REPT_PRN + _PRODUCTION := WORKSTAT->PROD_PRN + _ORDERDESK := WORKSTAT->OD_PRN + _INVOICE := WORKSTAT->INV_PRN + _BOPRN := WORKSTAT->BO_PRN //** P3N - 4/30/98 + _QUOTE := WORKSTAT->INV_PRN //** P3N - 4/13/98 + IF FIELDPOS('QTE_PRN') > 0 //** P3N - 4/13/98 + _QUOTE := WORKSTAT->QTE_PRN //** P3N - 4/13/98 + ENDIF + _PREBILL := WORKSTAT->INV_PRN //** P3N - 4/13/98 + IF FIELDPOS('PRE_PRN') > 0 //** P3N - 4/13/98 + _PREBILL := WORKSTAT->PRE_PRN //** P3N - 4/13/98 + ENDIF + _DELIVERY := WORKSTAT->DEL_PRN + _GOLDEN := WORKSTAT->GR_PRN + _LBLPRN := WORKSTAT->LBL_PRN + _ICPRN := WORKSTAT->IC_PRN + _PRECOST := WORKSTAT->INV_PRN //** P3N - 4/13/98 + + IF !EMPTY(REPT_PORT) + _RPTPORT = 'LPT' + REPT_PORT + ELSE + _RPTPORT = 'LPT1' + ENDIF + + IF !EMPTY(PROD_PORT) + _PORT_PROD = 'LPT' + PROD_PORT + ELSE + _PORT_PROD = 'LPT1' + ENDIF + + IF !EMPTY(OD_PORT) + _PORT_ORDER = 'LPT' + OD_PORT + ELSE + _PORT_ORDER = 'LPT1' + ENDIF + + IF !EMPTY(INV_PORT) + _PORT_INVOICE = 'LPT' + INV_PORT + ELSE + _PORT_INVOICE = 'LPT1' + ENDIF + + IF !EMPTY(BO_PORT) //** P3N - 4/30/98 + _PORT_BO := 'LPT' + BO_PORT //** P3N - 4/30/98 + ELSE //** P3N - 4/30/98 + _PORT_BO := 'LPT1' //** P3N - 4/30/98 + ENDIF //** P3N - 4/30/98 + + _PORT_QUOTE := 'LPT1' //** P3N - 4/13/98 + IF FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + IF !EMPTY(QTE_PORT) //** P3N - 4/13/98 + _PORT_QUOTE := 'LPT' + QTE_PORT //** P3N - 4/13/98 + ENDIF + ENDIF + + _PORT_PREBILL := 'LPT1' //** P3N - 4/13/98 + IF FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + IF !EMPTY(PRE_PORT) //** P3N - 4/13/98 + _PORT_PREBILL := 'LPT' + PRE_PORT //** P3N - 4/13/98 + ENDIF + ENDIF + + IF !EMPTY(DEL_PORT) + _PORT_DELIVERY = 'LPT' + DEL_PORT + ELSE + _PORT_DELIVERY = 'LPT1' + ENDIF + + IF !EMPTY(GR_PORT) + _PORT_GOLDEN = 'LPT' + GR_PORT + ELSE + _PORT_GOLDEN = 'LPT1' + ENDIF + + IF !EMPTY(IC_PORT) + _PORT_IC = 'LPT' + IC_PORT + ELSE + _PORT_IC = 'LPT1' + ENDIF + + IF !EMPTY(LBL_PORT) + _PORT_LABEL = 'LPT' + LBL_PORT + ELSE + _PORT_LABEL = 'LPT1' + ENDIF + +ENDIF + +IF NO_SET_PORT + // CALLED FROM SET_PORT() AVOID RECURSIVE CALL - ENDLESS LOOP! +ELSE + SET_PORT('_RPTPORT', .F.) +ENDIF + +IF CLOSE_IT + USE +ENDIF + +SELECT(SAVESEL) +RETURN +************************************* +* INDEX WORKSTAT FILE +************************************* +FUNCTION INDEX_WS() +USE +DBOPEN('WORKSTAT', .T.) // DOESN'T EXIST MEANS 1ST TIME IN APP +IF __DBDRIVER = 'NTX' // SHOULDN'T BE ANYBODY USING WS FILE! + INDEX ON WS_ID TO &TOFILE +ELSE + INDEX ON WS_ID TAG '1' TO &TOFILE +ENDIF +USE +NET_USE('&WORKSTAT', .F., 5, 'WORKSTAT') +RETURN + +************************************************************ + +FUNCTION SET_PORT(MPORT_NAME, SET_THE_PRINT, OUTFILE) +// SET THE PRINTER PORT AND LOOKS UP THE PRINTER NAME TO GET +// THE COMPRESS & WIDTH VALUES + +LOCAL SAVESEL := SELECT(), CLOSE_ARR := {}, MPRINTER, L, MPORT, SEEKKEY +LOCAL SAVESCR + + +IF EMPTY(OUTFILE) + OUTFILE := ' ' +ENDIF + +IF SET_THE_PRINT = NIL + SET_THE_PRINT := .T. +ENDIF + +// LOOKUP THE PRINTER +IF SELECT('PRINTERS') = 0 + NET_USE('&PRINTERS', .F., 5, 'PRINTERS') + AADD(CLOSE_ARR, 'PRINTERS') +ENDIF + +IF SELECT('WORKSTAT') = 0 + NET_USE('&WORKSTAT', .F., 5, 'WORKSTAT') + AADD(CLOSE_ARR, 'WORKSTAT') +ELSE + SELECT WORKSTAT +ENDIF + +SEEKKEY := WSID +IF LEN(TRIM(SEEKKEY)) = 0 + SEEKKEY = 'SINGLE' +ENDIF + +DO WHILE .T. + LOCATE FOR ALLTRIM (WS_ID ) == ALLTRIM ( SEEKKEY ) // FIND WORK STATION RECORD + IF !FOUND() .OR. EMPTY(REPT_PRN) .OR. EMPTY(PROD_PRN) .OR. EMPTY(OD_PRN) ; + .OR. EMPTY(INV_PRN) .OR. EMPTY(DEL_PRN) + SET_P_OFF() + ?? CHR(7) + ?? CHR(7) + SAVESCR = SAVESCREEN() + SET_PRNT_PARMS(.T.) // GO SET UP PRINTER INFO + RESTSCREEN(,,,,SAVESCR) + SET_P_ON() + IF SET_THE_PRINT + // OUTPUT TO THE PRINTER + ELSE + // OUTPUT TO A TEXT FILE + IF FILE(OUTFILE) + //PROG := 'DEL ' + OUTFILE + //CALL_OLAY(,,PROG, 0, '', '') + FERASE( OUTFILE ) + ENDIF + SET PRINTER TO (OUTFILE) + ENDIF + ELSE + EXIT + ENDIF +ENDDO + +/* + + MRPTPRTR := GETPRINTER('ReportPrinter') + MRPTPORT := GETPRINTER('ReportPort') + MRPTDEV := GETPRINTER('ReportDevice') + + MPRODPRTR := GETPRINTER('ProdPrinter') + MPRODPORT := GETPRINTER('ProdPort') + MPRODDEV := GETPRINTER('ProdDevice') + + MORDPRTR := GETPRINTER('OrdDeskPrinter') + MORDPORT := GETPRINTER('OrdDeskPort') + MORDDEV := GETPRINTER('OrdDeskDevice') + + MINVPRTR := GETPRINTER('InvPrinter') + MINVPORT := GETPRINTER('InvPort') + MINVDEV := GETPRINTER('InvDevice') + + MDELPRTR := GETPRINTER('DelPrinter') + MDELPORT := GETPRINTER('DelPort') + MDELDEV := GETPRINTER('DelDevice') + + MGOLDPRTR := GETPRINTER('GoldenPrinter') + MGOLDPORT := GETPRINTER('GoldenPort') + MGOLDDEV := GETPRINTER('GoldenDevice' ) + + MMAILPRTR := GETPRINTER('MailLblPrinter') + MMAILPORT := GETPRINTER('MailLblPort') + MMAILDEV := GETPRINTER('MailLblDevice') + + MICOMPPRTR := GETPRINTER('InterCompPrinter') + MICOMPPORT := GETPRINTER('InterCompPort') + MICOMPDEV := GETPRINTER('InterCompDevice') + + MBACKOPRTR := GETPRINTER('BackOrdPrinter') + MBACKOPORT := GETPRINTER('BackOrdPort') + MBACKODEV := GETPRINTER('BackOrdDevice') + + MQUOTEPRTR := GETPRINTER('QuotePrinter') + MQUOTEPORT := GETPRINTER('QuotePort') + MQUOTEDEV := GETPRINTER('QuoteDevice') + + MPREBPRTR := GETPRINTER('PreBillPrinter') + MPREBPORT := GETPRINTER('PreBillPort') + MPREBDEV := GETPRINTER('PreBillDevice') + + MPRECPRTR := GETPRINTER('PreCostPrinter') + MPRECPORT := GETPRINTER('PreCostPort') + MPRECDEV := GETPRINTER('PreCostDevice') + +*/ + +DO CASE + CASE MPORT_NAME = '_RPTPORT' + MPRINTER = REPT_PRN + MPORT := 'LPT' + REPT_PORT + MPORT := GETPRINTER('ReportPrinter') + + CASE MPORT_NAME = '_PORT_PROD' + MPRINTER = PROD_PRN + MPORT := 'LPT' + PROD_PORT + MPORT := GETPRINTER('ProdPrinter') + + //** P3N - 04/08/03 CHANGED TO ALLOW THE ORDER DESK & LABEL PRINTERS TO BE DIFFERENT + //** CASE MPORT_NAME = '_PORT_ORDER' .OR. MPORT_NAME = '_PORT_LABEL' + CASE MPORT_NAME = '_PORT_ORDER' + MPRINTER = OD_PRN + MPORT := 'LPT' + OD_PORT + MPORT := GETPRINTER('OrdDeskPrinter') + + CASE MPORT_NAME = '_PORT_LABEL' //** P3N - 04/08/03 + MPRINTER = LBL_PRN //** P3N - 04/08/03 + MPORT := 'LPT' + LBL_PORT //** P3N - 04/08/03 + + CASE MPORT_NAME = '_PORT_INVOICE' + MPRINTER = INV_PRN + MPORT := 'LPT' + INV_PORT + + CASE MPORT_NAME = '_PORT_QUOTE' //** P3N - 4/13/98 + MPRINTER := INV_PRN //** P3N - 4/13/98 + MPORT := 'LPT' + INV_PORT //** P3N - 4/13/98 + IF FIELDPOS('QTE_PRN') > 0 //** P3N - 4/13/98 + MPRINTER = QTE_PRN //** P3N - 4/13/98 + ENDIF //** P3N - 4/13/98 + IF FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + MPORT := 'LPT' + QTE_PORT //** P3N - 4/13/98 + ENDIF + + CASE MPORT_NAME = '_PORT_PREBILL' //** P3N - 4/13/98 + MPRINTER := INV_PRN //** P3N - 4/13/98 + MPORT := 'LPT' + INV_PORT //** P3N - 4/13/98 + IF FIELDPOS('PRE_PRN') > 0 //** P3N - 4/13/98 + MPRINTER = PRE_PRN //** P3N - 4/13/98 + ENDIF //** P3N - 4/13/98 + IF FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + MPORT := 'LPT' + PRE_PORT //** P3N - 4/13/98 + ENDIF + + CASE MPORT_NAME = '_PORT_DELIVERY' + MPRINTER = DEL_PRN + MPORT := 'LPT' + DEL_PORT + + CASE MPORT_NAME = '_PORT_GOLDEN' + MPRINTER = GR_PRN + MPORT := 'LPT' + GR_PORT + + CASE MPORT_NAME = '_PORT_LABEL' + MPRINTER = LBL_PRN + MPORT := 'LPT' + LBL_PORT + + CASE MPORT_NAME = '_PORT_IC' + MPRINTER = IC_PRN + MPORT := 'LPT' + IC_PORT + + CASE MPORT_NAME = '_PORT_BO' //** P3N - 4/30/98 + MPRINTER = BO_PRN //** P3N - 4/30/98 + MPORT := 'LPT' + BO_PORT //** P3N - 4/30/98 + +END CASE + +SELECT PRINTERS +LOCATE FOR PRINTER == MPRINTER + + +/* +NARROW = "''" +COMPRESS := "''" +WIDE = "''" +NORMAL := "''" +COMPRESSL = "''" +LMAR15 = "''" +LMAR18 = "''" +TMAR = "''" +WIDEON = "''" +WIDEOFF = "''" +SP4 := "''" +SP6 := "''" +SP10 := "''" +SP12 := "''" +SP16 := "''" +LF := "''" +FL7 := "''" +FL11 := "''" +FL14 := "''" +FEED := "''" +FEED2 := "''" +PICA := "''" +ELITE := "''" +SEN_ON = "''" +SEN_OFF = "''" +*/ + + + +NARROW = PCOMPRESS +COMPRESS := NARROW +WIDE = PNORMAL +NORMAL := WIDE +COMPRESSL = PCOMPRESSL +LMAR15 = LEFT_MAR15 +LMAR18 = LEFT_MAR18 +TMAR = TOP_MAR +WIDEON = PWIDEON +WIDEOFF = PWIDEOFF +SP4 := SP_4 +SP6 := SP_6 +SP10 := SP_10 +SP12 := SP_12 +SP16 := SP_16 +LF := ILF +FL7 := FL_7 +FL11 := FL_11 +FL14 := FL_14 +FEED := SMALL_FEED +FEED2 := TINY_FEED +PICA := P_PICA +ELITE := P_ELITE +SEN_ON = SENSOR_ON +SEN_OFF = SENSOR_OFF + +// SET THE PORT +//*MPORT = &MPORT_NAME +//*SET PRINT TO (MPORT) +IF SET_THE_PRINT + IF USER = '_FMAINT' + BLD_GDG('ORDER.TXT', 8) //CREATE GDG(limit of 8) OF ORDERS PRINTED! + SET PRINTER TO ORDER.TXT + ELSE + // SET PRINTER TO (MPORT) + //Set( 24, M->_THISUSER_TEMP, .F. ) + SET PRINTER TO ( M->_THISUSER_TEMP ) // APPDATA FOLDER + ENDIF +ENDIF + +// CLOSE FILES +FOR L = 1 TO LEN(CLOSE_ARR) + MALIAS = CLOSE_ARR[L] + SELECT(MALIAS) + USE +NEXT + +SELECT(SAVESEL) + +RETURN MPORT + +******************************************** +FUNCTION CHK_PRN(MVAR) +// CHECK FOR CORRECT PRINTER SELECTION + +*** *IF MVAR$'12345678' +IF MVAR$'123' + RETURN .T. +ELSE + RETURN .F. +ENDIF + +***************************** +//***************************************************************** +//***************************************************************** +//** P3N 11/20/02 SET THE PRINTERS SECTION IN THE INI FILE *** +//***************************************************************** +//***************************************************************** +FUNCTION SETPRNTR(PCMD) +LOCAL SYSCODE := M->SYSCODE, lEXIT := .F. + +LOCAL MHDC +LOCAL SYSINI +LOCAL CMD +LOCAL PRPORT +LOCAL PRNAME +LOCAL PRDEV +LOCAL INIPORT +LOCAL ININAME +LOCAL INIDEV +local cPrinter + +SYSINI := GETSYSINI(SYSCODE) +CMD := UPPER(PCMD) +PRPORT := PCMD+'Port' +PRNAME := PCMD+'Printer' +PRDEV := PCMD+'Device' +INIPORT := ALLTRIM(GETPVPROFSTR('PRINTERS', PRPORT, '', SYSINI)) // ** P3N - 3/14/00 +ININAME := ALLTRIM(GETPVPROFSTR('PRINTERS', PRNAME, '', SYSINI)) // ** P3N - 3/14/00 +INIDEV := ALLTRIM(GETPVPROFSTR('PRINTERS', PRDEV, '', SYSINI)) // ** P3N - 10/16/03 +cPrinter := GetProfString( "windows", "device" , "" ) //** WINDOWS DEFAULT PRINTER + + + + +//**DO WHILE .T. + //IF GET_PERDATA()[3] = '_FMAINT' .OR. GET_PERDATA()[3] = 'MASTER' + // MSGINFO('Windows DEFAULT printer device is "' +cPrinter+'"', 'Default printer') + //ENDIF + + CKSYSPRTR(ININAME, PCMD, 'NOCALL') + PRINTERSETUP() + //** IS THE WINDOWS DEFAULT PRINTER AVAILABLE? + //** WriteProfString( "windows", "device", cPrinter ) + //** SysRefresh() + //** PrinterInit() + MhDC := GetPrintDefault( GetActiveWindow() ) + SysRefresh() + //** WriteProfString( "windows", "device", cPrinter ) + +//** CHECK FOR THE WINDOWS DEFAULT PRINTER + IF MhDC = 0 .OR. EMPTY(cPrinter) + MSGSTOP('Windows Default Printer "' + cPrinter +'"' + CR_LF(2) + ; + 'NOT Found or is NOT Available', 'Printer NOT Available' ) + + ELSE + + ININAME := PRNGETNAME() + //** P3N - 10/06/09 ADDRESS THE "NO PRINTERS INSTALLED!" message(from fwhx v2.6 Sept-2005) in vista + SETINIVALS(@ININAME, @INIPORT, @INIDEV) //** P3N - 10/06/09 - Address Vista issue + INIPORT := STRTRAN(PRNGETPORT(),':','') + INIDEV := PRNGETDRIVE() + + IF EMPTY(ININAME) .OR. EMPTY(INIPORT) + MSGSTOP( 'Invalid or Incomplete Printer Information:' + CR_LF(2) + ; + 'Printer Name - ' + ININAME + CR_LF() + ; + 'Printer Port - ' + INIPORT,'Incomplete Printer Stetup' ) + + ELSE + + WRITEPPROS('PRINTERS', PRNAME, ININAME, SYSINI ) + WRITEPPROS('PRINTERS', PRPORT, INIPORT, SYSINI ) + WRITEPPROS('PRINTERS', PRDEV, INIDEV, SYSINI ) + + ENDIF + ENDIF +//**ENDDO + +RETURN .T. + +********************************************* + + +FUNCTION GETPRINTER(CMD) //** P3N - 12/31/02 + ** THIS WILL AVOID A CONFLICT WITH THE FIVEWIN GETPRINTER() FUNCTION + **FUNCTION INIPRINTER(CMD) //** P3N - 12/31/02 + +LOCAL WININI := GETWINDIR() + '\WIN.INI' + +LOCAL PRINTDEV := GETPVPROFSTRING( 'WINDOWS', 'DEVICE', 'NODEFAULT ', WININI ) + +LOCAL SYSINI := GETSYSINI( M->SYSCODE ) + +IF EMPTY(CMD) //** P3N - 11/12/02 + //** RETURN THE DEFAULT WINDOWS SYSTEM PRINTER //** P3N - 11/12/02 +ELSE +//** RETURN THE XXX.INI SECTION [PRINTERS] INFO BASED ON CMD PASSED +//** cmd = 'ReportPrinter' //** P3N - 12/30/02 +//** cmd = 'ReportPort' //** P3N - 12/30/02 +//** cmd = 'CheckPrinter' //** P3N - 12/30/02 +//** cmd = 'CheckPort' //** P3N - 12/30/02 +//** cmd = 'FormPrinter' //** P3N - 12/30/02 +//** cmd = 'FormPort' //** P3N - 12/30/02 + PRINTDEV := GETPVPROFSTRING( 'PRINTERS', CMD, ' ', SYSINI ) +ENDIF //** P3N - 11/12/02 + +RETURN PRINTDEV + + +********************************** + + + + + + + +//***************************************************************** +//***************************************************************** +//** P3N 11/20/02 SET THE PRINTERS SECTION IN THE INI FILE *** +//***************************************************************** +//***************************************************************** +//**FUNCTION VALIDPRTRS( MRPTPRTR, MPRODPRTR, MORDPRTR, MINVPRTR, MDELPRTR, MGOLDPRTR, MMAILPRTR, MICOMPPRTR, MBACKOPRTR, MQUOTEPRTR, MPREBPRTR ) + +FUNCTION VALIDPRTRS(MRPTPRTR, MCHECKPRTR) + +LOCAL RETVAL := .F. + +RETVAL := CKSYSPRTR( MRPTPRTR, 'Report' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'Prod' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'OrdDesk' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'Inv' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'Del' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'Golden' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'MailLbl' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'InterComp' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'BackOrd' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'Quote' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'PreBill' ) +RETVAL := CKSYSPRTR( MRPTPRTR, 'PreCost' ) + +//IF RETVAL +// IF RETVAL +// RETVAL := CKSYSPRTR(MRPTPRTR, 'REPORT', 'NOCALL') +// ENDIF +//ENDIF +//**IF RETVAL +//**ELSE +//** IF ISWINNT() +//** IF MSGYESNO('Printer Information is Incomplete'+CR_LF()+; +//** 'Do you want to continue with incomplete printer information?') +//** RETVAL := .T. +//** ENDIF +//** ENDIF +//**ENDIF + +RETURN RETVAL + +//********************************************************* +//** P3N - 03/07/03 +//** IS THE PRINTER NAME A VALID PRINTER NAME? +//********************************************************* +FUNCTION CKSYSPRTR( PRTRNAME, WHATPRTR ) + +LOCAL SYSINI := GETSYSINI(M->SYSCODE) +LOCAL PRPORT := WHATPRTR + 'Port', PRDEV := WHATPRTR + 'Device', PRNAME := WHATPRTR + 'Printer' +LOCAL INIPORT := ALLTRIM(GETPVPROFSTR('PRINTERS', PRPORT, '', SYSINI)) +LOCAL ININAME := ALLTRIM(GETPVPROFSTR('PRINTERS', PRNAME, '', SYSINI)) +LOCAL INIDEV := ALLTRIM(GETPVPROFSTR('PRINTERS', PRDEV, '', SYSINI)) +local MhDC := 0, RETVAL := .T. +local cPrinter := GetProfString( "windows", "device" , "" ) +LOCAL cWinName := WINDFLT(cPrinter,'NAME'), cWinPort := WINDFLT(cPrinter, 'PORT') +local cWindev := WINDFLT(cPrinter, 'DEVICE') + +WriteProfString( "windows", "device", PRTRNAME ) +SysRefresh() +PrinterInit() +MhDC := GetPrintDefault( GetActiveWindow() ) +SysRefresh() +WriteProfString( "windows", "device", cPrinter ) + +/* +commented out on 10/02/09 +address vista issues +IF MhDC = 0 .OR. EMPTY(PRTRNAME) + MSGINFO('Invalid "' +WHATPRTR+ '" Printer Name - ' + PRTRNAME + CR_LF(2) + ; + 'Windows default printer used - ' + cWinName ) + WRITEPPROS('PRINTERS', PRNAME, cWinName, SYSINI ) + WRITEPPROS('PRINTERS', PRPORT, cWinPort, SYSINI ) + IF EMPTY(CMD) + SYSPRNTRS(, 'INIT') + ENDIF + RETVAL := .T. +ENDIF +*/ + +RETURN RETVAL + +//******************************************************************************** +//** P3N - 10/06/09 +//** ADDRESS THE "NO PRINTERS INSTALLED!" message(from fwhx v2.6 Sept-2005) in vista +//******************************************************************************** +FUNCTION SETINIVALS(ININAME,INIPORT,INIDEV) +//** EXAMPLE OF ALLPRNTRS ARRAY VALUES: +//** ALLPRNTRS[1] "Xerox DocuPrint N2125 PS (by server 138),winspool,Ne00:" +//** ALLPRNTRS[2] "Xerox DocuPrint N2125 PS,winspool,Ne01:" +//** ALLPRNTRS[3] "pdfFactory Pro,winspool,FPP3:" +//** ALLPRNTRS[4] "Microsoft XPS Document Writer,winspool,Ne02:" +//** ALLPRNTRS[5] "\\LAAPCSV1\HP LaserJet 2420 PCL 6,winspool,Ne03:" +//** ALLPRNTRS[6] "WebEx Document Loader,winspool,Ne04:" +LOCAL ALLPRNTRS := GETALLPRNTRS(), I := 0 +LOCAL CKNAME := '' + +FOR I := 1 TO LEN(ALLPRNTRS) + CKNAME := SUBST(ALLPRNTRS[I], 1, AT(',',ALLPRNTRS[I]) -1 ) + IF CKNAME == ININAME + //**IF ALLPRNTRS[I] = ININAME + ININAME := ALLPRNTRS[I] + EXIT + ENDIF +NEXT +RETURN .T. + + +//********************************************************* +//** P3N - 10/06/09 +//** GET ALL PRINTERS FOR THIS WINDOWS SESSION +//********************************************************* +FUNCTION GETALLPRNTRS() +LOCAl cEntry := '', I := 0, cName := '', cPrn := '', cPort := '', J := 0 +LOCAL aDevices := {} +//** EXAMPLE OF aDevices ARRAY VALUES returned: +//** ALLPRNTRS[1] "Xerox DocuPrint N2125 PS (by server 138),winspool,Ne00:" +//** ALLPRNTRS[2] "Xerox DocuPrint N2125 PS,winspool,Ne01:" +//** ALLPRNTRS[3] "pdfFactory Pro,winspool,FPP3:" +//** ALLPRNTRS[4] "Microsoft XPS Document Writer,winspool,Ne02:" +//** ALLPRNTRS[5] "\\LAAPCSV1\HP LaserJet 2420 PCL 6,winspool,Ne03:" +//** ALLPRNTRS[6] "WebEx Document Loader,winspool,Ne04:" +LOCAL cAllEntries := STRTRAN( GetProfString( "Devices" ), Chr( 0 ), CRLF ) +FOR I:= 1 TO MlCount( cAllEntries ) + cName := MemoLine( cAllEntries,,I) + cEntry := GetProfString( "Devices",cName,"") + J := 2 + DO WHILE ! EMPTY(cPort := StrToken(cEntry,J++,",")) + AADD(aDevices,TRIM(cName) + "," + CENTRY) + ENDDO +NEXT +RETURN aDevices + +**************************************************** +FUNCTION WINDFLT(cPrinter, CMD) +LOCAL SPLITNAME := AT(',', cPrinter), RETVAL := '' +LOCAL SPLITPORT := RAT(',', cPrinter) +LOCAL RETNAME := SUBST(cPrinter,1, SPLITNAME-1) +LOCAL RETPORT := SUBST(cPrinter, SPLITPORT+1,LEN(cPrinter) ) +IF ISWINNT() + //**MSGINFO('THIS IS THE WINNT DEFAULT PRINTER - '+CPRINTER) + RETPORT := RETNAME +ENDIF +IF CMD = 'NAME' + RETVAL := RETNAME +ELSEIF CMD = 'PORT' + RETVAL := STRTRAN(RETPORT, ':', '') +ENDIF +RETURN RETVAL + + +*************************************************** + + FUNCTION WRITEPPROS( P1, P2, P3, P4 ) + RETURN WRITEPPROSTRING( P1, P2, P3, P4 ) + +********************************************** + + // FUNCTION GETPVPROFSTR( P1, P2, P3, P4 ) + // RETURN GETPVPROFSTRING( P1, P2, P3, P4 ) + + + ******************************************************** + + FUNCTION GETPVPROFI( P1, P2, P3, P4 ) + RETURN GETPVPROFINT( P1, P2, P3, P4 ) + + **************************************************************** + +************************************************ + + +FUNCTION DON_REPDATE(VAR2) +LOCAL WORKDATE + +// DATE - SQL LIMITATION - DON 4-27-9 +//IF M->SQLDRIVER = 'MEDNTX' // DONE ONLY IF MS/SQL DataBase +// MYEAR := YEAR( VAR2 ) +// IF MYEAR > 0 .AND. MYEAR < 1800 // 01/23/1754 +// +// WORKDATE := DTOC( VAR2 ) +// WORKDATE := SUBS( WORKDATE, 1 , 6 ) ; // 01/23/1854 - MAKE 1800 CENTURY +// + '18' + SUBS( WORKDATE, 9 ) +// VAR2 := CTOD( WORKDATE ) +// ENDIF +//ENDIF + +RETURN VAR2 + + +***************************** + + FUNCTION GETPVPROFSTR( P1, P2, P3, P4 ) + RETURN GETPVPROFSTRING( P1, P2, P3, P4 ) + + +******************************** + +function ReadVar() + +LOCAL NWND + +// MODIFIED IN CASE NO CONTROLS ALIVE. 6-3-2020 +nWnd := AScan( GetAllWin(),; + { | oWnd | IF ( VALTYPE(OWND)$'N', .F., oWnd:lFocused .and. oWnd:ClassName() == "TGET" )} ) + +return If( nWnd != 0, GetAllWin()[ nWnd ], nil ) + + diff --git a/CGWPRINT.PRG b/CGWPRINT.PRG new file mode 100644 index 0000000..5cdbe98 --- /dev/null +++ b/CGWPRINT.PRG @@ -0,0 +1,5578 @@ +#INCLUDE 'CGWINCLD.PRG' +//#INCLUDE 'FIVEWIN.CH' +//#INCLUDE 'REPORT.CH' + + +//#INCLUDE 'FIVEWIN.CH' +// #include "report.ch" + +#DEFINE SW_SHOW 5 + + +* MIKE LEWIS - PRINT ORDERS - CGWPRINT 02/01/94 +******************************************************************* +PROCEDURE ALL_ORDPR(OPTION, TITLE, ACTION) +DBOPEN("CONTROL") +PRIVATE MD_ALLPRNT := D_ALLPRNT +PRIVATE MP_ALLPRNT := P_ALLPRNT +PRIVATE MI_ALLPRNT := I_ALLPRNT +PRIVATE MO_ALLPRNT := O_ALLPRNT +PRIVATE MPO_ALLPRNT := PO_ALLPRNT +PRIVATE MPB_ALLPRNT := PB_ALLPRNT +PRIVATE MPC_ALLPRNT := PC_ALLPRNT +PRIVATE MGR_ALLPRNT := GR_ALLPRNT +PRIVATE MBO_ALLPRNT := BO_ALLPRNT //** P3N - 4/30/98 +PRIVATE _WHEREORD := '1' +PRIVATE MPRTBYINIT := ' ' //** P3N - 01/07/02 +IF CONTROL->(FIELDPOS( 'ALLPRTINIT' ) ) > 0 //** P3N - 01/07/02 + MPRTBYINIT := CONTROL->ALLPRTINIT //** P3N - 01/07/02 +ENDIF //** P3N - 01/07/02 +USE +ORD_PRINT(OPTION, TITLE, ACTION) +RETURN +******************************************************************* +PROCEDURE ORD_PRINT(OPTION, TITLE, ACTION, WHEREORD) +LOCAL SAVESEL := SELECT() //** P3N - 7/12/00 +LOCAL SAVESCR, MTITLE, SVORD := 1, M1, M2, M3, OPT, MARR := {} +PRIVATE ORD_PARMS, GL_ARR, GL_OVR, GLALLOC_OVR := .F. +PRIVATE PRNTSOURCE := ACTION, MCUST_ID, MUSER_ID, OUT_ARR +//** ADDRESS LINDS DELIVERY TICKET PRINT ANOMALY //** P3N - 7/12/00 +IF SELECT(CONTROL) = 0 //** P3N - 7/12/00 + DBOPEN('CONTROL') //** P3N - 7/12/00 +ENDIF //** P3N - 7/12/00 +MLMAR := SPACE(LMAR) //** P3N - 7/12/00 +MTMAR := TMAR //** P3N - 7/12/00 +MBODY_LEN := BODY_LEN //** P3N - 7/12/00 +MHEAD_LEN := HEAD_LEN //** P3N - 7/12/00 +MSING_SHEET := UPPER(SING_SHEET) //** P3N - 7/12/00 +CLOSE CONTROL //** P3N - 7/12/00 +SELECT(SAVESEL) //** P3N - 7/12/00 + +IF !EMPTY(WHEREORD) //SELECTIVE PRINT FROM THE MENU SYSTEM(FUNC-OPEN2100) + _WHEREORD := WHEREORD +ENDIF +IF _WHEREORD = '2' // SECOND TIME THRU - END RECURSIVE CALLS + _WHEREORD := '1' // RESET TO be first time thru + RETURN .T. +ENDIF +IF LASTKEY() == 27 // ABORT ORDER ENTRY - PRINT MENU + RETURN +ENDIF + + *************************************************************** + * THIS IS THE MENU AT THE END OF ORDER ENTRY PROCESS + * DETERMINE WHAT COPY OF THE ORDER TO PRINT + *************************************************************** +IF TITLE = NIL + IF CUR_MAST = 'QUOTE' + TITLE = 'PRINT Quotes' + ELSE + TITLE = 'PRINT Orders' + ENDIF +ENDIF +CLS +IF ACTION == 'OE' // ACTION OE = FROM ORDER ENTRY + TITLE := TITLE + ' ' + ALLTRIM( (CUR_MAST)->ORDER_NUM) + SAYTITLE(TITLE, 'PR020') + MORDER_NUM := (CUR_MAST)->ORDER_NUM + ORD_PROCESS(MORDER_NUM) +ELSE // MAIN MENU + DBOPEN(CUR_OL) + DBOPEN(CUR_MISC) + DBOPEN('MISC_ITEMS',,,{1}) + ORD_PARMS := DBOPEN(CUR_MAST) + SAYTITLE(TITLE, 'PR020') + @ 2,0 CLEAR + SAVESCR := SAVESCREEN() + // INDIVIDUALLY SELECTED FROM GET_KEY + IF ACTION = 'MM' + DO WHILE .T. + RESTSCREEN(,,,,SAVESCR) + MORDER_NUM := GET_KEY(ORD_PARMS) + IF EMPTY(MORDER_NUM) + SELECT(CUR_OL) + USE + RETURN + ENDIF + MTITLE := TITLE + ' ' + ALLTRIM( (CUR_MAST)->ORDER_NUM) + SAYTITLE(MTITLE, 'PR020') + IF !NEED_CALC$'N' + ERR_BOX(' *** THIS ORDER MUST BE RECALCULATED ***', ; + ' Because SOMETHING HAS CHANGED.',; + ' Go to the ORDER ENTRY SCREEN and ',; + ' SAVE THE ORDER AGAIN (F10 key)') + LOOP + ENDIF + MCUST_ID = CUST_ID + MUSER_ID = USER_ID + ORD_PROCESS(MORDER_NUM) + ENDDO + ELSE + // PRINT ALL ORDERS UNPRINTED + MTITLE := TITLE + ' - ALL UNPRINTED' + SAYTITLE(MTITLE, 'PR020') + ??CHR(7) + IF MPRTBYINIT == 'Y' //** P3N - 01/07/02 + OPT := PICKLIST({'ALL Unprinted', 'All Unprinted by User('+TRIM(M->USER)+')'}, 13, 25, ' Print Unprinted Orders' ) + IF LASTKEY() = 27 //** P3N - 01/07/02 + ELSE //** P3N - 01/07/02 + IF OPT = 1 //** P3N - 01/07/02 + MPRTBYINIT := '' //** P3N - 01/07/02 + M1 := 'About to Print ALL Unprinted Orders' //** P3N - 01/07/02 + M2 := 'Do You Want to Continue?' //** P3N - 01/07/02 + M3 := '' //** P3N - 01/07/02 + ELSEIF OPT = 2 //** P3N - 01/07/02 + M1 := 'About to Print ALL Unprinted Orders' //** P3N - 01/07/02 + M2 := 'For User - '+ M->USER //** P3N - 01/07/02 + M3 := 'Do You Want to Continue?' //** P3N - 01/07/02 + MTITLE := MTITLE + ' for - '+M->USER //** P3N - 01/07/02 + SAYTITLE(MTITLE, 'PR020') //** P3N - 01/07/02 + ENDIF //** P3N - 01/07/02 + IF PROMPT_BOX(M1, M2, M3) //** P3N - 01/07/02 + MORDER_NUM := NIL //** P3N - 01/07/02 + MCUST_ID = NIL //** P3N - 01/07/02 + MUSER_ID = M->USER //** P3N - 01/07/02 + ORD_PROCESS(MORDER_NUM) //** P3N - 01/07/02 + ENDIF //** P3N - 01/07/02 + ENDIF //** P3N - 01/07/02 + ELSE //** P3N - 01/07/02 + IF PROMPT_BOX('About to Print ALL Unprinted Orders' , ; + 'Do You Want to Continue?', ' ' ) + MORDER_NUM := NIL + MCUST_ID = NIL + MUSER_ID = NIL + ORD_PROCESS(MORDER_NUM) + ENDIF + ENDIF //** P3N - 01/07/02 + ENDIF +ENDIF +RETURN //** P3N - 3/7/00 +*************************************************************** +** PRINT menu +*************************************************************** +FUNCTION ORD_PROCESS(MORDER_NUM) +LOCAL SAVESCR := SAVESCREEN(),CALL_MENU, SVCOLOR, WHATHOTKEY := {' ', ' '} + //** P3N - 3/8/00 +IF SELECT( CUR_MAST ) > 0 //** AT PRINT ORDER TIME + SVORD := (CUR_MAST)->(DONSETORD(1)) //** ENSURE YOU ARE ON THE +ENDIF //** ORDER_NUM ( INDEX ORDER1 ) + + + //** P3N - 3/8/00 +DBOPEN('ALTSHIPADR') //** P3N - 11/13/98 +IF CUR_MAST = 'QUOTE' + CALL_MENU := 'ORDERS022' + WHATHOTKEY:= {'F7 - Quote Entry', 'F12- Invoice Msg'} +ELSE +//** IF EMPTY( (CUR_MAST)->ORDER_ORG ) //** P3N - 10/21/99 + IF EMPTY( (CUR_MAST)->ORDER_ORG ) .OR. EMPTY(MORDER_NUM) //** P3N - 10/21/99 + CALL_MENU := 'ORDERS020' + ELSE + CALL_MENU := 'ORDERS024' + ENDIF + WHATHOTKEY:= {'F7 - Order Entry', 'F12- Invoice Msg'} +ENDIF +@ 2,0 CLEAR +IF MORDER_NUM <> NIL + OUT_ARR := BLD_ORDER(MORDER_NUM) +ENDIF +IF EMPTY(OUT_ARR) .AND. MORDER_NUM <> NIL + @ 2,0 CLEAR + ERR_BOX('NO Line Items for Order - ' + ALLTRIM(MORDER_NUM)) +ELSE + + SVCOLOR := SETCOLOR(HREV) + @ 0,0 SAY WHATHOTKEY[1] // Order or Quote entry????? + @ 1,0 SAY WHATHOTKEY[2] // Invoice Solicitation msg. entry????? + SETCOLOR(SVCOLOR) + SETKEY( -6, {||CHG_REV_HOTKEY( )} ) //ORDER CHG/REV + SETKEY( -41,{||EDIT_INVNOTES( )} ) //EDIT INVOICE/SOLICITATION MSG + DO WHILE .T. + @ 2,0 CLEAR + CLEAR TYPEAHEAD + CALLMENU(CALL_MENU) //DISPLAY ORDER/QUOTE PRINT MENU-MENU SYSTEM + IF LASTKEY() = 27 + EXIT + ENDIF + ENDDO + SETKEY( -6 , NIL) + SETKEY( -41, NIL) +ENDIF +CLOSE ALTSHIPADR //** P3N - 11/13/98 +RETURN +******************************************************************** +******************************************************************** +******************************************************************** + +FUNCTION PRNT_ORDER(OPTION, TITLE, WHCHORDER) + +LOCAL XLAST, LASTDATEX, LASTDATE, SEEKKEY, LASTONEPRNT, PARR,CHOICE +LOCAL OUTMODE := 'BROWSE', CHG_WHAT, CMD, WORKTXT, GL_INBAL +LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') +LOCAL SV_SCREEN, ITEMIZE, OPT, SCRNUM, P1, P2, P3, SVSCRN +LOCAL COD_CNTR := 0, PRINT_ORDER := .T., PRTORDER := .T. +LOCAL PRTCNTR := 0 //** P3N - 01/07/02 +LOCAL PRT_COD_ONLY := .F., DEL_COD := 0, ESCKEY := .F. //** P3N - 7/20/98 +LOCAL MPORT + + +DBOPEN('ORD_SHIP') //** P3N - 5/13/98 +PRIVATE BKOSCRNS := 0 //** P3N - 8/12/98 (HAPPY B-DAY JEFF) +IF MORDER_NUM = NIL // PRINT ALL UNPRINTED ORDERS + SELECT (CUR_MAST) + DO CASE + CASE WHCHORDER = 'PROD' + SEEKKEY := MP_ALLPRNT + XLAST := 'PDATE_LAST' + CASE WHCHORDER = 'DEL' + DEL_COD := PICKLIST({'ALL Tickets', 'COD Tickets'}, 13, 55, ' Print Delivery' ) + IF DEL_COD == 1 //** P3N - 7/20/98 + PRT_COD_ONLY := .F. //** P3N - 7/20/98 + ELSEIF DEL_COD == 2 //** P3N - 7/20/98 + PRT_COD_ONLY := .T. //** P3N - 7/20/98 + ELSE + ESCKEY := .T. + ENDIF //** P3N - 7/20/98 + SEEKKEY := MD_ALLPRNT + XLAST := 'DDATE_LAST' + IF ESCKEY + ELSE + P1 := '*** Are you sure you want to Print Delivery tickets? *** ' + P2 := ' ' + P3 := ' ' + IF PROMPT_BOX(P1,P2,P3,1) //Default to YES - print + ELSE + ESCKEY := .T. + ENDIF + ENDIF + CASE WHCHORDER = 'INV' + SEEKKEY := MI_ALLPRNT + XLAST := 'IDATE_LAST' + CASE WHCHORDER = 'OD' + SEEKKEY := MO_ALLPRNT + XLAST := 'ODATE_LAST' + CASE WHCHORDER = 'PO' + SEEKKEY := MPO_ALLPRNT + XLAST := 'XDATE_LAST' + CASE WHCHORDER = 'PREBILL' + SEEKKEY := MPB_ALLPRNT + XLAST := 'BDATE_LAST' + CASE WHCHORDER = 'PRECOST' + SEEKKEY := MPC_ALLPRNT + XLAST := 'CDATE_LAST' + CASE WHCHORDER = 'GOLDEN' + SEEKKEY := MGR_ALLPRNT + XLAST := 'GDATE_LAST' + CASE WHCHORDER = 'BACKORD' //** P3N - 4/30/98 + SEEKKEY := MBO_ALLPRNT + XLAST := 'BODATE_LST' + ENDCASE + + SET SOFTSEEK ON + SEEK SEEKKEY + SET SOFTSEEK OFF + + IF (CUR_MAST)->ORDER_NUM = SEEKKEY // THE "LAST" ORDER PRINTED + SKIP 1 // SO GO TO THE NEXT ONE + ENDIF + + IF EOF() + IF ESCKEY + ELSE + ERR_BOX('** NO DOCUMENTS TO PRINT ** ') + ENDIF + ELSEIF ESCKEY //** P3N - 7/20/98 ESCAPE ON DELIVERY PRINT + + ELSE + LASTDATEX := MAKE_BLOCK( XLAST ) + PRTCNTR := 0 //** P3N - 01/07/02 + DO WHILE !EOF() + PRTORDER := .T. //** P3N - 01/07/02 + IF MPRTBYINIT == 'Y' //** P3N - 01/07/02 + IF ALLTRIM((CUR_MAST)->USER_ID) == ALLTRIM(M->USER) //** P3N - 01/07/02 + ELSE //** P3N - 01/07/02 + PRTORDER := .F. //** P3N - 01/07/02 + ENDIF //** P3N - 01/07/02 + ENDIF //** P3N - 01/07/02 + LASTDATE := EVAL(LASTDATEX) + //** IF EMPTY(LASTDATE) + IF EMPTY(LASTDATE) .AND. PRTORDER //** P3N - 01/07/02 + PRTCNTR := PRTCNTR + 1 //** P3N - 01/07/02 + MCUST_ID := CUST_ID + MUSER_ID := USER_ID + MORDER_NUM := ORDER_NUM + PRINT_ORDER := .T. //** P3N - 4/14/98 + IF (CUR_MAST)->TERMS = '98' // CREDIT MEMO //** P3N - 4/14/98 + //** P3N 4/14/98 DO NOT PRINT CREDIT MEMOS FOR PROD OR IC! + PRINT_ORDER := PRT_ORDER(WHCHORDER) //** P3N - 4/14/98 + ENDIF + IF PRINT_ORDER //** P3N - 4/14/98 + IF WHCHORDER = 'PREBILL' + CUST_MAST->(DBSEEK(MCUST_ID)) + IF CUST_MAST->PRE_BILL$'Y' + OUT_ARR := BLD_ORDER(MORDER_NUM) + MPORT := PRNT_THIS_ORDER( OPTION, TITLE, WHCHORDER, 1) + ENDIF + ELSEIF PRT_COD_ONLY //** P3N - 7/20/98 + IF (CUR_MAST)->TERMS = '30' // C.O.D. //** P3N - 7/20/98 + OUT_ARR := BLD_ORDER(MORDER_NUM) //** P3N - 7/20/98 + MPORT := PRNT_THIS_ORDER( OPTION, TITLE, WHCHORDER, 1) + COD_CNTR := COD_CNTR + 1 + ENDIF + ELSEIF WHCHORDER == 'DEL' //** P3N - 7/20/98 + IF EMPTY((CUR_MAST)->DDATE_LAST) + OUT_ARR := BLD_ORDER(MORDER_NUM) + MPORT := PRNT_THIS_ORDER( OPTION, TITLE, WHCHORDER, 1) + ENDIF + ELSE + OUT_ARR := BLD_ORDER(MORDER_NUM) + MPORT := PRNT_THIS_ORDER( OPTION, TITLE, WHCHORDER, 1) + ENDIF + ENDIF + ENDIF + SELECT (CUR_MAST) + SKIP 1 + ENDDO + GOTO BOTTOM + IF MPRTBYINIT == 'Y' //** P3N - 01/07/02 + IF EMPTY(PRTCNTR) //** P3N - 01/07/02 + ERR_BOX('** NO DOCUMENTS TO PRINT ** ') //** P3N - 01/07/02 + ENDIF //** P3N - 01/07/02 + //** DO NOT UPDATE THE LAST ORDER PRINTED WHEN PRINTING BY INITIALS + ELSE //** P3N - 01/07/02 + DBOPEN('CONTROL') + REC_LOCK(1) + DO CASE + CASE WHCHORDER = 'PROD' + REPLACE P_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MP_ALLPRNT := P_ALLPRNT + CASE WHCHORDER = 'DEL' + IF PRT_COD_ONLY //** P3N - 7/20/98 + IF EMPTY(COD_CNTR) //** P3N - 7/20/98 + ERR_BOX('** NO DOCUMENTS TO PRINT ** ') //** P3N - 7/20/98 + ENDIF //** P3N - 7/20/98 + ELSE //** P3N - 7/20/98 + REPLACE D_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MD_ALLPRNT := D_ALLPRNT + ENDIF + CASE WHCHORDER = 'INV' + REPLACE I_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MI_ALLPRNT := I_ALLPRNT + CASE WHCHORDER = 'OD' + REPLACE O_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MO_ALLPRNT := O_ALLPRNT + CASE WHCHORDER = 'PO' + REPLACE PO_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MPO_ALLPRNT := PO_ALLPRNT + CASE WHCHORDER = 'PREBILL' + REPLACE PB_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MPB_ALLPRNT := PB_ALLPRNT + CASE WHCHORDER = 'PRECOST' + REPLACE PC_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MPC_ALLPRNT := PC_ALLPRNT + CASE WHCHORDER = 'GOLDEN' + REPLACE GR_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MGR_ALLPRNT := GR_ALLPRNT + CASE WHCHORDER = 'BACKORD' //** P3N - 4/30/98 + REPLACE BO_ALLPRNT WITH (CUR_MAST)->ORDER_NUM + MBO_ALLPRNT := BO_ALLPRNT + ENDCASE + ENDIF //** P3N - 01/07/02 + ENDIF + MCUST_ID = NIL + MUSER_ID = NIL + MORDER_NUM := NIL +ELSE // PRINT SELECTED ORDERS + GLALLOC_OVR := .F. //USE THE GL ARRAY ALLOCATIONS - NOT THE OVERRIDES! + // INVOICE PRINTING???? + IF WHCHORDER == 'INV' .OR. WHCHORDER = 'PREBILL' .OR. WHCHORDER = 'PRECOST' + ITEMIZE := PICKLIST({'Itemize Amounts', 'NO Amount Itemization'}, 16, 55, '' ) + IF LASTKEY() = 27 + RETURN + ENDIF + IF EMPTY(GL_OVR) + //** NO GL OVERRIDES EXIST FOR THIS ORDER - USE GL_ARR FOR ALLOC. + ELSE + P1 := '*** GL Allocation Overrides exist for this order! *** ' + P2 := ' YES - Use GL Allocation Overrides! ' + P3 := ' NO - RE-ALLOCATE GL and DELETE GL Overrides!' + IF PROMPT_BOX(P1,P2,P3, 1) //Default to YES - Use GL OVERRIDES! + GLALLOC_OVR := .T. //USE THE GL OVERRIDES FOR THIS ORDER + ELSE + IF LASTKEY() = 27 + // ABORT THE USE OF THE EITHER ALLOCATION + RETURN + ELSE + SVSCRN := SAVESCREEN() + OUT_ARR := BLD_ORDER(MORDER_NUM) // EXEC. TO REALLOC GL ARR + RESTSCREEN(,,,,SVSCRN) + GLALLOC_OVR := .F. //USE THE GL ARRAY ALLOCATIONS + DEL_GLALLOC(MORDER_NUM) + ENDIF + ENDIF + ENDIF + ELSE + ITEMIZE := 1 + ENDIF + SV_SCREEN := SAVESCREEN() + DO WHILE .T. + // ONLY THIS GUY GETS THE PREVIEW / CHANGE OPTION + IF CUR_MAST == 'ORD_MAST' + IF _OC_CAPABLE + WORKTXT := 'CHANGE Order' + ELSE + WORKTXT := 'REVIEW Order Screens' + ENDIF + PARR = {'BROWSE Order Form', WORKTXT , 'PRINT Order'} + CHG_WHAT := 'ORDER' + SCRNUM := '2120' // ORDER PROCESSING SCREEN + ELSE + IF _OC_CAPABLE + WORKTXT := 'CHANGE Quote' + ELSE + WORKTXT := 'REVIEW Quote Screens' + ENDIF + PARR = {'BROWSE Quote Form', WORKTXT , 'PRINT Quote'} + CHG_WHAT := 'QUOTE' + SCRNUM := '2220' // QUOTE PROCESSING SCREEN + ENDIF + IF WHCHORDER == 'INV' .OR. WHCHORDER = 'PREBILL' .OR. WHCHORDER = 'PRECOST' + AADD(PARR, 'OVERRIDE GL Alloc.') + ENDIF + CHOICE := PICKLIST(PARR,18,55) //Select what ACTION to take????? + IF LASTKEY() == 27 .OR. CHOICE == 0 + EXIT + ELSEIF CHOICE == 1 //BROWSE THE ORDER + OUTMODE := 'BROWSE' + ELSEIF CHOICE == 2 //CHANGE THE ORDER + IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' +//** OPT := 2 //** P3N - 02/02/07 +//** OPT := 1 //** P3N - 02/02/07 + //** Changed back - per Darlene + OPT := 1 //** P3N - 02/20/07 + CMD := 'ADD' + ELSE + OPT := 3 + CMD := 'REV' + ENDIF + IF CUR_MAST = 'QUOTE_MAST' + ACD_ORDERS (OPT,'CHANGE Quote',{ CUR_MAST, CUR_OL, .T., 2, CMD ,,,,,, .F.,,SCRNUM,.F.,, }, '2') + ELSE + ACD_ORDERS (OPT,'CHANGE Sales Order',{ CUR_MAST, CUR_OL, .T., 2, CMD ,,,,,, .F.,,SCRNUM,.F.,, }, '2') + ENDIF + SVSCRN := SAVESCREEN() + OUT_ARR := BLD_ORDER(MORDER_NUM) // EXEC. TO REBUILD OUT_ARR + //AFTER UPDATES!! + RESTSCREEN(,,,,SVSCRN) + LOOP + ELSEIF CHOICE == 3 //PRINT THE ORDER + IF WHCHORDER = 'INV' .OR. WHCHORDER = 'PRE' + // ONLY CHECK FOR GL OVERRIDES FOR INVOICE OR PREBILL/PRECOST + IF AT('_ARCH', WHCHORDER) > 0 // ARCHIVE COPIES - DO NOT UPDATE + // BYPASS GL OVERRIDE EDIT FOR ARCHIVED INVOICE OR PREBILL/PRECOST + ELSE + IF GLALLOC_OVR //USE THE GL OVERRIDES FOR THIS ORDER + GL_INBAL := BAL_GLALLOC(MORDER_NUM, GL_OVR) + ELSE + GL_INBAL := BAL_GLALLOC(MORDER_NUM, GL_ARR) + DEL_GLALLOC(MORDER_NUM) + ENDIF + IF GL_INBAL + //THE ORDER AND GL ARE IN BALANCE ALLOW INVOICE PRINT TO OCCUR!!! + ELSE + RETURN // RETURN DO NOT ALLOW PRINT WHEN OUT OF BALANCE!!! + ENDIF + ENDIF + ENDIF + IF WHCHORDER == 'INV' //** CHECK SHIPPING AT INVOICE PRINT TIME! + //** P3N - 11/24/98 + IF CUR_MAST = 'ORD_MAST' //** ONLY CHECK SHIPPING FOR ORDERS + IF EMPTY((CUR_MAST)->SHIP_DATE) + CLEAR TYPEAHEAD //** P3N - 12/22/98 + ERR_BOX('**** This Order has NOT been Shipped! ****', ; + 'CONTACT SUPERVISOR TO PRINT THIS INVOICE!!') + IF LASTKEY() <> 126 //SHIFT + "~" //** P3N - 12/22/98 + LOOP //** P3N - 12/22/98 + ENDIF //** P3N - 12/22/98 + ENDIF + IF ORD_SHIP->(DBSEEK(MORDER_NUM)) + // ORDER ALREADY SHIPPED DO NOT SHIP @ INV TIME **P3N 5/14/98 + ELSE + SHIP_TOTQTY(,,CUR_MAST ,.F.) + SVSCRN := SAVESCREEN() + OUT_ARR := BLD_ORDER(MORDER_NUM) // EXEC. TO APPLY UPDATES FROM ORDER CONTROL + RESTSCREEN(,,,,SVSCRN) + ENDIF + ENDIF + ENDIF + OUTMODE := 'PRINT' + ELSEIF CHOICE == 4 //UPDATE \ OVERRIDE GL ALLOCATIONS + GL_OVR := UPD_GLALLOC(MORDER_NUM, GL_ARR) + IF LASTKEY() = 27 + IF EMPTY(GL_OVR) + GLALLOC_OVR := .F. //USE THE GL_ARR VALUES AT PRINT TIME!!! + ELSE + GLALLOC_OVR := .T. //USE THE OVERRIDE VALUES AT PRINT TIME!!! + ENDIF + ELSE + GLALLOC_OVR := .T. //USE THE OVERRIDE VALUES AT PRINT TIME!!! + ENDIF + LOOP + ENDIF + MPORT := PRNT_THIS_ORDER( OPTION, TITLE, WHCHORDER, ITEMIZE , OUTMODE) + +****IF WHCHORDER == 'INV' //** P3N - 6/9/98 IF BO NOT PRINTED +**** //** FORCE BACKORDER AFTER INVOICE +**** IF OUTMODE == 'PRINT' //** WHEN PRINTING +**** IF (CUR_MAST)->(FIELDPOS('BODATE_FST')) > 0 +**** IF EMPTY((CUR_MAST)->BODATE_FST) .AND. ; +**** EMPTY((CUR_MAST)->BODATE_LST) +**** //** TURNED OFF UNTIL PRINTER AVAILABLE - PER ELLEN 6/11/98 P3N +**********PRNT_THIS_ORDER( OPTION, TITLE, 'BACKORD', ITEMIZE , OUTMODE) +**** ENDIF +**** ENDIF +**** ENDIF +****ENDIF + + RESTSCREEN(,,,,SV_SCREEN) + ENDDO +ENDIF + +RETURN MPORT + +************************************************************** +* P3N - 4/14/98 +* IF THE ORDER IS A PRODUCTION OR INTERCOMPANY ORDER +* DO NOT PRINT +************************************************************** +FUNCTION PRT_ORDER(WHCHORDER) +LOCAL RETVAL := .T. +IF WHCHORDER = 'PROD' .OR. WHCHORDER = 'PO' .OR. ; + WHCHORDER = 'GOLDEN' + RETVAL := .F. +ENDIF +RETURN RETVAL +************************************************************** +************************************************************** +************************************************************** + +FUNCTION PRNT_THIS_ORDER(OPTION, TITLE, WHCHORDER, ITEMPARM, OUTMODE) + +LOCAL MPORT +LOCAL OL_ARR := {}, I, SAVESEL := SELECT() +LOCAL SS2, CORR, CUSTNAME:='', OUTFILE +LOCAL MORDER_NUM := (CUR_MAST)->ORDER_NUM +LOCAL M1, M2, M3, MSG, PARR, CHOICE, PROG, QUOTE_PROCESS := .F. +LOCAL PIM1 := 'Order '+ (CUR_MAST)->ORDER_NUM +' is NOT entirely SHIPPED! Do you want to: ' +LOCAL PIM2 := ' NO - Invoice Entire Order? - (ALL Items will be Billed.)' +LOCAL PIM3 := ' YES - PARTIAL Invoice? - (ONLY Shipped items will be Billed.)' +LOCAL MINVOICENUM, MPO_ARR := {} +LOCAL MSHIP_DATE, MIDATE_FST, PROD_CODE, ELM, PRTBOCOPY := '1' +LOCAL BKOARR, ABKOSCR //** P3N - 6/30/98 +LOCAL IPOARR //** P3N - 7/8/98 +LOCAL TOLKEY := '', SCRNINFO := {}, SVDESC //** P3N - 9/16/98 +LOCAL WKORDQTY := 0, WKSHPDQTY := 0 //** P3N -11/4/98 +LOCAL ENTIRE_ORDSHIPPED := .F. //** P3N - 11/13/98 +LOCAL PARTIAL_INVOICE := .F. //** P3N - 11/13/98 +LOCAL REPRINT_INVOICE := .F. //** P3N - 12/3/98 +LOCAL INV_ARR := {} //** P3N - 12/7/98 + +STATIC BKOASCR := {} //** P3N - 8/25/98 + +PRIVATE ITEMIZE := ITEMPARM, SAVE_DESC, SAVE_TYPE, SAVE_DESC1, SAVE_BKOPROD + + +OUTFILE := M->_THISUSER_TEMP + + +IF OUTMODE = NIL + OUTMODE = 'PRINT' // VS. 'REVU' +ENDIF +IF CUR_MAST == 'ORD_MAST' + MSG := 'Order # ' + ALLTRIM(MORDER_NUM) +ELSEIF CUR_MAST == 'QUOTE_MAST' + MSG := 'Quote # ' + ALLTRIM(MORDER_NUM) + QUOTE_PROCESS := .T. //** P3N - 4/13/98 +ENDIF +IF WHCHORDER == 'INV' // INVOICE COPIES + M1 := ' INVOICE FOR ' + MSG + ' Was Printed on ' + DTOC((CUR_MAST)->IDATE_LAST) + ' ' + (CUR_MAST)->ITIME_LAST + M2 := ' It was ORIGINALLY PRINTED on ' + DTOC((CUR_MAST)->IDATE_FST) + ' ' + (CUR_MAST)->ITIME_FST + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'PREBILL' // PRODUCTION COPIES + M1 := MSG + ' Was Printed on ' + DTOC((CUR_MAST)->BDATE_FST) + ' ' + (CUR_MAST)->BTIME_LAST + M2 := ' ' + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'PRECOST' // PRODUCTION COPIES + M1 := MSG + ' Was Printed on ' + DTOC((CUR_MAST)->CDATE_FST) + ' ' + (CUR_MAST)->CTIME_LAST + M2 := ' ' + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'GOLDEN' // PRODUCTION COPIES + M1 := 'Golden Rod for ' + MORDER_NUM + ' Was Printed on ' + DTOC((CUR_MAST)->GDATE_FST) + ' ' + (CUR_MAST)->GTIME_LAST + M2 := ' ' + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'PROD' // PRODUCTION COPIES + M1 := MSG + ' Was Printed on ' + DTOC((CUR_MAST)->PDATE_LAST) + ' ' + (CUR_MAST)->PTIME_LAST + M2 := 'It was ORIGINALLY PRINTED on ' + DTOC((CUR_MAST)->PDATE_FST) + ' ' + (CUR_MAST)->PTIME_FST + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'DEL' // PRODUCTION COPIES + M1 := MSG + ' Was Printed on ' + DTOC((CUR_MAST)->DDATE_LAST) + ' ' + (CUR_MAST)->DTIME_LAST + M2 := 'It was ORIGINALLY PRINTED on ' + DTOC((CUR_MAST)->DDATE_FST) + ' ' + (CUR_MAST)->DTIME_FST + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'OD' // ORDER DESK COPIES + M1 := MSG + ' Was Printed on ' + DTOC((CUR_MAST)->ODATE_LAST) + ' ' + (CUR_MAST)->OTIME_LAST + M2 := 'It was ORIGINALLY PRINTED on ' + DTOC((CUR_MAST)->ODATE_FST) + ' ' + (CUR_MAST)->OTIME_FST + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'PO' // PURCHASE ORDERS + M1 := MSG + ' Was Printed on ' + DTOC((CUR_MAST)->XDATE_LAST) + ' ' + (CUR_MAST)->XTIME_LAST + M2 := 'It was ORIGINALLY PRINTED on ' + DTOC((CUR_MAST)->XDATE_FST) + ' ' + (CUR_MAST)->XTIME_FST + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ELSEIF WHCHORDER == 'BACKORD' // BACK ORDERS - **P3N - 4/30/98 + M1 := 'BACK' + MSG + ' Was Printed on ' + DTOC((CUR_MAST)->BODATE_LST) + ' ' + (CUR_MAST)->BOTIME_LST + M2 := 'It was ORIGINALLY PRINTED on ' + DTOC((CUR_MAST)->BODATE_FST) + ' ' + (CUR_MAST)->BOTIME_FST + M3 := ' CONTACT SUPERVISOR TO REPRINT THIS ITEM ' +ENDIF + +CLS +SAYTITLE(TITLE, 'PR010') +IF OUTMODE = 'PRINT' + IF WHCHORDER == 'PROD' + IF !EMPTY((CUR_MAST)->PDATE_LAST) // PRODUCTION + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ELSEIF WHCHORDER == 'INV' .OR. WHCHORDER = 'PREBILL' .OR. WHCHORDER = 'PRECOST' + IF !EMPTY((CUR_MAST)->IDATE_LAST) .AND. WHCHORDER = 'INV' // INVOICE + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + IF !EMPTY((CUR_MAST)->BDATE_FST) .AND. WHCHORDER = 'PREBILL' // INVOICE + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + IF !EMPTY((CUR_MAST)->CDATE_FST) .AND. WHCHORDER = 'PRECOST' + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ELSEIF WHCHORDER == 'OD' + IF !EMPTY((CUR_MAST)->ODATE_LAST) // ORDER DESK + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ELSEIF WHCHORDER == 'GOLDEN' + IF !EMPTY((CUR_MAST)->GDATE_LAST) // GOLDEN ROD + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ELSEIF WHCHORDER == 'DEL' + IF !EMPTY((CUR_MAST)->DDATE_LAST) // DELIVERY COPY + CLEAR TYPEAHEAD + M3 := 'Delivery Tickets can NOT be REPRINTED - ' + ERR_BOX(M1,M2, ' ',M3,'they MUST be TYPED to be recreated!') + IF MHOME_LOC_CODE = 'KC' //** P3N - 6/17/99 + RETURN //** P3N - 6/2/99 DO NOT ALLOW THE DELIVERY + //** TICKET TO BE RE-PRINTED - PER ARNIE + ELSE //** P3N - 6/17/99 + IF LASTKEY() <> 126 // "~" //** PER LAURA MAE @ PAWNEE + RETURN //** ALLOW DELIVERY TO BE + ENDIF //** REPRINTED + ENDIF //** P3N - 6/17/99 + ENDIF + ELSEIF WHCHORDER == 'GOLDEN' + IF !EMPTY((CUR_MAST)->GDATE_LAST) + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ELSEIF WHCHORDER == 'PO' + IF !EMPTY((CUR_MAST)->XDATE_LAST) // ORDER DESK + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ELSEIF WHCHORDER == 'BACKORD' //** P3N - 4/30/98 + IF !EMPTY((CUR_MAST)->BODATE_LST) // BACKORDER + CLEAR TYPEAHEAD + ERR_BOX(M1,M2,M3) + IF LASTKEY() <> 126 // "~" + RETURN + ENDIF + ENDIF + ENDIF +ENDIF +WAIT_BOX('*** Processing ' + MSG , ; + '*** Please Wait ****' ) + +IF PRNTSOURCE = 'OE' // END OF ORDER ENTRY ALREADY HAVE KEY +ELSE + SELECT(CUR_MAST) + MCUST_ID = CUST_ID + MUSER_ID = USER_ID +ENDIF + +//** P3N - 11/13/98 CHECK FOR A PARTIAL INVOICE HERE +IF WHCHORDER = 'INV' .AND. CUR_MAST == 'ORD_MAST' //** P3N - 11/13/98 + IF POSTED_ORDER(MORDER_NUM) + //** ORDER HAS BEEN POSTED - REPRINT INVOICE + REPRINT_INVOICE := .T. + + ELSEIF ( EMPTY( (CUR_MAST)->IDATE_FST) .AND. EMPTY( (CUR_MAST)->ITIME_FST) ) ; + .OR. (CUR_MAST)->IDATE_FST >= CURDATE + IF (CUR_MAST)->IDATE_FST == CURDATE //** P3N - 12/9/98 + REPRINT_INVOICE := .T. //** P3N - 12/9/98 + ELSEIF ORDER_SHIPPED(OUT_ARR[2,1], MORDER_NUM, WHCHORDER) //** P3N - 12/7/98 + ENTIRE_ORDSHIPPED := .T. + ELSE + PARTIAL_INVOICE := PROMPT_BOX(PIM1, PIM2, PIM3) + IF LASTKEY() == 27 + //** USER REQUESTED TO ABORT THE INVOICE PROCESS + RETURN + ENDIF + ENDIF + + ELSE + //** ORDER HAS BEEN PRINTED - REPRINT INVOICE + REPRINT_INVOICE := .T. + ENDIF +ENDIF + +//** THIS LOGIC WILL ENSURE THAT ALL INVOICES CREATED PRIOR TO +//** THE PARTIAL INVOICE INSTALL WILL BE RECALLED AS IS - WITHOUT +//** ANY PARTIAL INVOICE LOGIC. +IF EMPTY((CUR_MAST)->IDATE_FST) //** P3N - 12/10/98 +ELSEIF DTOC((CUR_MAST)->IDATE_FST) < '12/21/98' .AND. MHOME_LOC_CODE = 'KC' //** P3N - 12/10/98 + PARTIAL_INVOICE := .F. //** P3N - 12/10/98 + REPRINT_INVOICE := .F. //** P3N - 12/10/98 +ELSEIF DTOC((CUR_MAST)->IDATE_FST) < '01/20/99' .AND. MHOME_LOC_CODE = 'IOLA' //** P3N - 1/20/99 + PARTIAL_INVOICE := .F. //** P3N - 12/10/98 + REPRINT_INVOICE := .F. //** P3N - 12/10/98 +ELSEIF DTOC((CUR_MAST)->IDATE_FST) < '06/14/99' .AND. MHOME_LOC_CODE = 'LINDS' //** P3N - 1/20/99 + PARTIAL_INVOICE := .F. //** P3N - 12/10/98 + REPRINT_INVOICE := .F. //** P3N - 12/10/98 +ELSEIF DTOC((CUR_MAST)->IDATE_FST) < '02/04/99' .AND. MHOME_LOC_CODE = 'PAWNEE' //** P3N - 1/20/99 + PARTIAL_INVOICE := .F. //** P3N - 12/10/98 + REPRINT_INVOICE := .F. //** P3N - 12/10/98 +ENDIF +IF QUOTE_PROCESS //** P3N -12/7/98 +//** P3N - 11/18/02 - USE THE ACTUAL SIZE ON THE QUOTES - PER LINDA LINDS + INV_ARR := ACLONE(OUT_ARR[1,8]) //** P3N - 11/18/02 +ELSEIF WHCHORDER = 'INV' .OR. WHCHORDER = 'PREBILL' .OR. ; + WHCHORDER = 'PRECOST' .OR. DO_WE_PRT_AMT(WHCHORDER, ' ' ) + //** FOR INVOICE / PREBILL / PRECOST + //** CALC ORDER TOTALS, AND ITEM DISCOUNTS - AND REBUILD OUT_ARR / GL_ARR + MISCP_PAINT(.T., PARTIAL_INVOICE, REPRINT_INVOICE, CUR_OL) + OUT_ARR := BLD_ORDER(MORDER_NUM, ,PARTIAL_INVOICE, REPRINT_INVOICE) //** P3N -12/7/98 + INV_ARR := ACLONE(OUT_ARR[2,1]) //** P3N - 12/7/98 +ENDIF +PRTBOCOPY := '1' //** P3N - 12/21/98 +IF WHCHORDER = 'BACKORD' //** P3N - 12/21/98 + OUT_ARR := BLD_ORDER(MORDER_NUM, ,PARTIAL_INVOICE, REPRINT_INVOICE) //** P3N -12/7/98 + IF (CUR_MAST)->(FIELDPOS('BODATE_FST')) > 0 //** P3N - 12/21/98 + IF EMPTY((CUR_MAST)->BODATE_FST) //** P3N - 12/21/98 + //** FIRST TIME BO PRINTED - PRINT ALL BO COPIES + PRTBOCOPY := '1' + ELSE //** P3N - 12/21/98 + PRTBOCOPY := PICKLIST({'1. ALL Backorders ', '2. Primary','3. Screen', '4. Storm'}, 4, 30, 'Select Backorder' ) + IF LASTKEY() = 27 //** P3N - 12/21/98 + PRTBOCOPY := '0' //** P3N - 12/21/98 + ELSEIF PRTBOCOPY = 1 //** P3N - 12/21/98 + PRTBOCOPY := '1' //** P3N - 12/21/98 + ELSEIF PRTBOCOPY = 2 //** P3N - 12/21/98 + PRTBOCOPY := '2' //** P3N - 12/21/98 + ELSEIF PRTBOCOPY = 3 //** P3N - 12/21/98 + PRTBOCOPY := '3' //** P3N - 12/21/98 + ELSEIF PRTBOCOPY = 4 //** P3N - 12/21/98 + PRTBOCOPY := '4' //** P3N - 12/21/98 + ENDIF //** P3N - 12/21/98 + ENDIF //** P3N - 12/21/98 + ENDIF //** P3N - 12/21/98 +ENDIF //** P3N - 12/21/98 +//** P3N - 6/4/99 MOVED HERE FROM BELOW +IF OUTMODE == 'PRINT' //** IF PRINT TIME-CHECK FOR PARTIAL INVOICE? + IF WHCHORDER = 'INV' .AND. CUR_MAST == 'ORD_MAST' //** P3N - 6/4/99 + IF PARTIAL_INVOICE //** P3N - 6/4/99 + IF EMPTY(ORD_MAST->ORDER_NEW) //** NO PARTIAL INVOICE EXISTS ! + PARTIALINVOICE() //** CREATE A NEW INVOICE ONE TIME! + SHIP_REST(ORD_MAST->ORDER_NUM, 'SCREENS' ) //** SHIP ALL REMAINING ITEMS ON ORDER + ENDIF + ENDIF + ENDIF +ENDIF + +// SETUP THE PRINTER INFO + + +SET_P_ON() +IF OUTMODE = 'PRINT' // Print the ORDER + PORTFLAG := .T. +ELSE // Browse the ORDER in a userfile + IF FILE(OUTFILE) + //PROG := 'DEL ' + OUTFILE + //CALL_OLAY(,,PROG, 0, '', '') + FERASE( OUTFILE ) + ENDIF + SET PRINTER TO (OUTFILE) + PORTFLAG := .F. +ENDIF +IF WHCHORDER = 'INV' .OR. WHCHORDER = 'PREBILL' .OR. WHCHORDER = 'PRECOST' + IF QUOTE_PROCESS //** P3N - 4/13/98 + MPORT := SET_PORT('_PORT_QUOTE', PORTFLAG, OUTFILE ) + ELSEIF WHCHORDER = 'PREBILL' //** P3N - 4/13/98 + MPORT := SET_PORT('_PORT_PREBILL', PORTFLAG, OUTFILE ) + ELSE + MPORT := SET_PORT('_PORT_INVOICE', PORTFLAG, OUTFILE ) + ENDIF + IF WHCHORDER = 'INV' .AND. CUR_MAST == 'ORD_MAST' //** P3N - 11/24/98 + IF PARTIAL_INVOICE //** P3N - 11/24/98 + PRNT_THE_ORDER('INV', INV_ARR, 'INV', 'ALL' , , .T., ; + PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) //** P3N -12/3/98 + ELSE + PRNT_THE_ORDER('INV', INV_ARR, 'INV', 'ALL' , , .T., ; + PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) //** P3N -12/3/98 + ENDIF + //** FOR LINDS PRINT THE PREBILL INVOICE WITH EXACT SIZE INFORMATION - PER LINDA - P3N 7/19/00 + ELSEIF WHCHORDER == 'PREBILL' //** P3N - 7/19/00 + IF MHOME_LOC_CODE = 'LINDS' //** P3N - 7/19/00 + PRNT_THE_ORDER('INV', OUT_ARR[1,8], 'INV', 'ALL' , WHCHORDER, .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ELSE //** P3N - 7/19/00 + PRNT_THE_ORDER('INV', OUT_ARR[2,1], 'INV', 'ALL' , WHCHORDER, .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF //** P3N - 7/19/00 + ELSEIF QUOTE_PROCESS ; //** P3N -11/18/02 + .AND. MHOME_LOC_CODE = 'LINDS' //** P3N -11/18/02 + //** P3N - 11/18/02 - USE INV_ARR FOR QUOTES - SHOULD BE SET TO PROPER VALUE + //** P3N - 11/18/02 THIS WILL PRINT THE ACTUAL SIZE ON THE QUOTES - PER LINDA @ LINDS + PRNT_THE_ORDER('INV', INV_ARR, 'INV', 'ALL' , WHCHORDER, .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ELSE + PRNT_THE_ORDER('INV', OUT_ARR[2,1], 'INV', 'ALL' , WHCHORDER, .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF +ELSEIF WHCHORDER = 'PROD' .AND. !EMPTY(OUT_ARR) + // IT IS A PRODUCTION REQUEST + MPORT := SET_PORT('_PORT_PROD', PORTFLAG, OUTFILE) + FOR I = 1 TO LEN(OUT_ARR[1]) + DO CASE + CASE I = 2 // PRODUCTION FRAME MADE AT HOME LOCATION + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'FRAME', MHOME_LOC_CODE, , .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) // TRUE FOR PRINT THE CUTTING SPECS + ENDIF + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'STDFRAME', MHOME_LOC_CODE, , .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) // TRUE FOR PRINT THE CUTTING SPECS + ENDIF + CASE I = 3 // PRODUCTION SASH MADE AT HOME LOCATION + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'SASH', MHOME_LOC_CODE, , .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF + CASE I = 4 // PRODUCTION GLASS MADE AT HOME LOCATION + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'GLASS', MHOME_LOC_CODE, , .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF + CASE I = 5 // PRODUCTION SCREEN MADE AT HOME LOCATION + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'SCREEN', MHOME_LOC_CODE, , .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF + CASE I = 6 // PRODUCTION STORM MADE AT HOME LOCATION + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'STORM', MHOME_LOC_CODE, ,.T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) + ENDIF + CASE I = 7 // EXPANDERS MADE AT HOME LOCATION (SEVENTH ELEMENT IN PROD ARRARY) + IF LEN(OUT_ARR[1,I]) > 0 + PRNT_THE_ORDER('PROD', OUT_ARR[1,I], 'EXPANDER', MHOME_LOC_CODE, , .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF + ENDCASE + NEXT +ELSEIF WHCHORDER = 'OD' + // ORDER DESK CONTROL COPY + MPORT := SET_PORT('_PORT_ORDER', PORTFLAG, OUTFILE) + // USE 2,1(INVOICE) FORMAT-NO ADDL PRODUCTS ON ORDER DESK COPY + // 8-21-95 - PRINT THE CONTROL COPY AND CALL IT A SPINDLE COPY FOR ALL + PRNT_THE_ORDER('OD', OUT_ARR[2,1], 'CTRL', MHOME_LOC_CODE, 'ORDERDESK', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) +ELSEIF WHCHORDER = 'PO' + // PRINT INTERCOMPANY PO'S IF APPLICABLE + MPORT := SET_PORT('_PORT_IC', PORTFLAG, OUTFILE) + SAVESEL := SELECT() + IPOARR := {} //** P3N - 7/8/98 + FOR I := 1 TO LEN(OUT_ARR[2,1]) //** P3N - 7/8/98 + AADD(IPOARR, OUT_ARR[2,1,I]) //** P3N - 7/8/98 + NEXT //** P3N - 7/8/98 + FOR I := 1 TO LEN(OUT_ARR[1,10]) //** P3N - 7/8/98 + IPO_PROD := OUT_ARR[1,10,I,10] //** P3N - 9/14/98 + IPO_LINE := OUT_ARR[1,10,I,9] //** P3N - 9/14/98 + IF ASCAN(IPOARR, {|X| X[10] + X[9] == IPO_PROD + IPO_LINE }) > 0 + ELSE + AADD(IPOARR, OUT_ARR[1,10,I]) //** P3N - 7/8/98 + ENDIF + NEXT //** P3N - 7/8/98 + SELECT MFG_LOC + GOTO TOP + DO WHILE !EOF() + IF LOC_CODE == MHOME_LOC_CODE + SKIP 1 + LOOP + ENDIF // CONTENTS OF THE "CTRL" COPY + PRNT_THE_ORDER('OD', IPOARR, 'PO', MFG_LOC->LOC_CODE, 'PO', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + SELECT MFG_LOC + SKIP 1 + ENDDO +ELSEIF WHCHORDER = 'DEL' + SELECT(SAVESEL) + SAVE_DESC := NIL + MPORT := SET_PORT('_PORT_DELIVERY', PORTFLAG, OUTFILE) + IF MHOME_LOC_CODE = 'LINDS' + PRNT_THE_ORDER('OD', OUT_ARR[1,8], 'CTRL', MHOME_LOC_CODE, 'DELIVERY', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ELSE // INVOICE INFO + PRNT_THE_ORDER('OD', OUT_ARR[2,1], 'CTRL', MHOME_LOC_CODE, 'DELIVERY', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF +ELSEIF WHCHORDER = 'GOLDEN' + SELECT(SAVESEL) + SAVE_DESC := NIL + MPORT := SET_PORT('_PORT_GOLDEN', PORTFLAG, OUTFILE) + PRNT_THE_ORDER('PROD', OUT_ARR[1,8], 'CTRL', MHOME_LOC_CODE, WHCHORDER, .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) +ELSEIF WHCHORDER = 'BACKORD' //** P3N - 4/30/98 + SELECT(SAVESEL) + SAVE_DESC := NIL + MPORT := SET_PORT('_PORT_BO', PORTFLAG, OUTFILE) + //** PRINT PRIMARY PRODUCT BACKORDERS - (IE: C500 SINGLE HUNG...) + BKOARR := {} + IF PRTBOCOPY $ '12' //** PRINT PRIMARY BACKORDER COPY + FOR I := 1 TO LEN(OUT_ARR[2,1]) + IF GET_CATCODE(OUT_ARR[2,1,I,10]) == 'SCREENS' + //** BYPASS SCREENS ON THIS PASS OF THE BACKORDER PRINTING + ELSEIF GET_CATCODE(OUT_ARR[2,1,I,10]) == 'STORMS ' + //** BYPASS STORMS ON THIS PASS OF THE BACKORDER PRINTING + ELSE + WKORDQTY := OUT_ARR[2,1,I,7] //** P3N -11/4/98 + WKSHPDQTY := OUT_ARR[2,1,I,11] //** P3N -11/4/98 + IF WKORDQTY - WKSHPDQTY <= 0 //** P3N -11/4/98 + ELSEIF EMPTY((CUR_MAST)->ORDER_NEW) //** NO PARTIAL INVOICE EXISTS ! + AADD(BKOARR, OUT_ARR[2,1,I]) + ENDIF + ENDIF + NEXT + ENDIF + IF PRTBOCOPY $ '13' //** PRINT SCREEN BACKORDER COPY + //** PRINT SCREEN BACKORDERS - COMBINE SCREENS AT ALL LOC'S. + ABKOSCR := {} //* SCREENS NOT AT MFG. LOC. + FOR I := 1 TO LEN(OUT_ARR[1,9]) //* SCREENS NOT AT MFG. LOC. + WKORDQTY := OUT_ARR[1,9,I,7] //** P3N -11/4/98 + WKSHPDQTY := OUT_ARR[1,9,I,11] //** P3N -11/4/98 + IF WKORDQTY - WKSHPDQTY <= 0 //** P3N -11/4/98 + ELSEIF EMPTY((CUR_MAST)->ORDER_NEW) //** NO PARTIAL INVOICE EXISTS ! + AADD(ABKOSCR, OUT_ARR[1,9,I]) + ENDIF + NEXT + FOR I := 1 TO LEN(OUT_ARR[1,5]) //*SCREENS AT MFG. LOC. + WKORDQTY := OUT_ARR[1,5,I,7] //** P3N -11/4/98 + WKSHPDQTY := OUT_ARR[1,5,I,11] //** P3N -11/4/98 + IF WKORDQTY - WKSHPDQTY <= 0 //** P3N -11/4/98 + ELSEIF EMPTY((CUR_MAST)->ORDER_NEW) //** NO PARTIAL INVOICE EXISTS ! + AADD(ABKOSCR, OUT_ARR[1,5,I]) + ENDIF + IF OUT_ARR[1,5,I,8] == 'OL' + //** LINE_NUM PROD_CODE + TOLKEY := MORDER_NUM + OUT_ARR[1,5,I,9] + OUT_ARR[1,5,I,10] + 'SCREENS' + SCRNINFO := TOL_SCREENS(, TOLKEY) + IF EMPTY(SCRNINFO[2]) + ELSEIF EMPTY(ABKOSCR) + ELSE + ABKOSCR[LEN(ABKOSCR),2] := SCRNINFO[2] //**TOL LINE DESC FOR SCREEN + ENDIF + ENDIF + NEXT + SAVE_DESC := NIL + ENDIF + IF PRTBOCOPY $ '14' //** PRINT STORM BACKORDER COPY + //** PRINT STORM BACKORDERS - COMBINE STORMS AT ALL LOC'S. + SAVE_DESC := NIL + //**BKOARR := {} + FOR I := 1 TO LEN(OUT_ARR[1,6]) //** STORMS @ MFG. LOC. + IF OUT_ARR[1,6,I,10] = 'PWS' //** DO NOT PRINT A BACKORDER FOR + ELSE //** PWS STORMS + WKORDQTY := OUT_ARR[1,6,I,7] //** P3N -11/4/98 + WKSHPDQTY := OUT_ARR[1,6,I,11] //** P3N -11/4/98 + IF WKORDQTY - WKSHPDQTY <= 0 //** P3N -11/4/98 + ELSEIF EMPTY((CUR_MAST)->ORDER_NEW) //** NO PARTIAL INVOICE EXISTS ! + AADD(BKOARR, OUT_ARR[1,6,I]) + ENDIF + ENDIF + NEXT + FOR I := 1 TO LEN(OUT_ARR[1,10]) //** STORMS NOT @ MFG. LOC. + IF OUT_ARR[1,10,I,10] = 'PWS' //** DO NOT PRINT A BACKORDER FOR + ELSE //** PWS STORMS + WKORDQTY := OUT_ARR[1,10,I,7] //** P3N -11/4/98 + WKSHPDQTY := OUT_ARR[1,10,I,11] //** P3N -11/4/98 + IF WKORDQTY - WKSHPDQTY <= 0 //** P3N -11/4/98 + ELSEIF EMPTY((CUR_MAST)->ORDER_NEW) //** NO PARTIAL INVOICE EXISTS ! + AADD(BKOARR, OUT_ARR[1,10,I]) + ENDIF + ENDIF + NEXT + ENDIF + IF EMPTY(BKOARR) + //** P3N - 12/3/98 - PRINT BACKORDER IF ONLY MISC/NONTX ITEMS + SAVE_BKOPROD := ' ' //** P3N - 2/2/99 + PRNT_THE_ORDER('BACKORD', {} , 'BACKORD', 'ALL','BACKORD', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ELSE + BKOARR := ASORT(BKOARR,,, {|X,Y| X[2] + X[9] < Y[2] + Y[9] }) + SAVE_BKOPROD := ' ' //** P3N - 2/2/99 + PRNT_THE_ORDER('BACKORD', BKOARR, 'BACKORD', 'ALL','BACKORD', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + ENDIF + IF EMPTY(ABKOSCR) + BKOASCR := {} //** P3N - 5/25/99 + BKOSCRNS := 0 //** P3N - 5/25/99 + ELSEIF EMPTY(BKOSCRNS) //** ONLY SUMMARIZE SCREENS THE FIRST TIME + BKOASCR := SUM_BKO_SCREENS(ABKOSCR) + BKOASCR := ASORT(BKOASCR,,, {|X,Y| STR(X[7],5)+X[2]+X[9] < STR(Y[7],5)+Y[2]+Y[9] }) + //** //** P3N - 9/22/98 + //** SORT BACKORDER SCREENS BY THE PRODUCT & DESCR & QTY + BKOASCR := ASORT(BKOASCR,,, {|X,Y| X[10]+X[2]+STR(X[7],5) < Y[10]+Y[2]+STR(Y[7],5) }) + ENDIF + SAVE_BKOPROD := ' ' //** P3N - 2/2/99 + PRNT_THE_ORDER('BACKORD', BKOASCR, 'BACKORD', 'ALL','SCREENS', .T., PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE ) +ENDIF + +SET_P_OFF() +IF EMPTY(WIDEON) //PRINTER SELECTION INVALID - GET OUT!!! + RETURN +ENDIF + +IF OUTMODE = 'PRINT' //IF the user requests to PRINT + // .OR. OUTMODE = 'BROWSE' + + IF OUTMODE = 'PRINT' + LPREVIEW := .F. + ELSE + LPREVIEW := .T. + ENDIF + + IF QUOTE_PROCESS + CGW_PRNT_FROM_FILE( 'QUOTE', OUTFILE, LPREVIEW ) // 9-10-20 + ELSE + CGW_PRNT_FROM_FILE( WHCHORDER, OUTFILE, LPREVIEW ) + ENDIF + + + (CUR_MAST)->(DBSEEK(MORDER_NUM)) // 6/9/20 + + IF OUTMODE = 'PRINT' + //* SELECT ORD_MAST //UPDATE dates to indicate a PRINT has occured + IF AT('_ARCH', WHCHORDER) > 0 // ARCHIVE COPIES - DO NOT UPDATE + // CONTINUE FOR PRINTING ARCHIVED ORDERS + ELSE + SELECT(CUR_MAST) + REC_LOCK(1) + IF WHCHORDER == 'INV' // INVOICE COPIES + //** P3N - 11/24/98 - PARTIAL INVOICING + CUTINVOICE(MORDER_NUM, GL_ARR, PARTIAL_INVOICE) + //** P3N - 6/4/99 MOVED ABOVE - TIMING ISSUES REGARDING INVOICE PRINT + //** P3N - THE 'BACKORDER TO' WAS NOT PRINTING ON INVOICE-FIRST PRINT + ELSEIF WHCHORDER == 'PREBILL' // PREBILL + IF EMPTY(BDATE_FST) + REPLACE BDATE_FST WITH CURDATE + REPLACE BTIME_FST WITH TIME() + ENDIF + REPLACE BDATE_LAST WITH CURDATE + REPLACE BTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'PRECOST' // PRECOST + IF EMPTY(CDATE_FST) + REPLACE CDATE_FST WITH CURDATE + REPLACE CTIME_FST WITH TIME() + ENDIF + REPLACE CDATE_LAST WITH CURDATE + REPLACE CTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'GOLDEN' // GOLDEN ROD + IF EMPTY(GDATE_FST) + REPLACE GDATE_FST WITH CURDATE + REPLACE GTIME_FST WITH TIME() + ENDIF + REPLACE GDATE_LAST WITH CURDATE + REPLACE GTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'PROD' // PRODUCTION COPIES + IF EMPTY(PDATE_FST) + REPLACE PDATE_FST WITH CURDATE + REPLACE PTIME_FST WITH TIME() + ENDIF + REPLACE PDATE_LAST WITH CURDATE + REPLACE PTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'DEL' // DELIVERY COPIES + IF EMPTY(DDATE_FST) + REPLACE DDATE_FST WITH CURDATE + REPLACE DTIME_FST WITH TIME() + ENDIF + REPLACE DDATE_LAST WITH CURDATE + REPLACE DTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'OD' // ORDER DESK COPIES + IF EMPTY(ODATE_FST) + REPLACE ODATE_FST WITH CURDATE + REPLACE OTIME_FST WITH TIME() + ENDIF + REPLACE ODATE_LAST WITH CURDATE + REPLACE OTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'PO' // ORDER DESK COPIES + IF EMPTY(XDATE_FST) + REPLACE XDATE_FST WITH CURDATE + REPLACE XTIME_FST WITH TIME() + ENDIF + REPLACE XDATE_LAST WITH CURDATE + REPLACE XTIME_LAST WITH TIME() + ELSEIF WHCHORDER == 'BACKORD' //BACKORDER //** P3N - 4/30/98 + IF EMPTY(BODATE_FST) + REPLACE BODATE_FST WITH CURDATE + REPLACE BOTIME_FST WITH TIME() + ENDIF + REPLACE BODATE_LST WITH CURDATE + REPLACE BOTIME_LST WITH TIME() + ELSE + ? ABENDPRNT_THIS + ENDIF + ENDIF + ENDIF +ELSE // BROWSE ORDER and do not UPDATE dates + + SHELLEXECUTE(,'OPEN', OUTFILE,'',, SW_SHOW) + // WAITRUN( 'NOTEPAD ' + OUTFILE ) // 1/20/20 + //PROG := 'BROWSE ' + OUTFILE + //CALL_OLAY(,,PROG, 0, '', '') +ENDIF + + +UNLOCK + +RETURN MPORT + +************************************************************* +* P3N - 11/12/98 CUT AN INVOICE AND APPROPRIATE BILLING * +* TRANSACTIONS AS NECESSARY. * +************************************************************* +FUNCTION CUTINVOICE(MORDER_NUM, GL_ARR, PARTIAL_INVOICE) +DBOPEN('SALEHIST') //** P3N - 8/13/98 - ADDRESS POSTING LOCKOUT +SELECT(CUR_MAST) +REC_LOCK(3) +REPLACE IDATE_LAST WITH CURDATE //** P3N - 11/11/98 +REPLACE ITIME_LAST WITH TIME() //** P3N - 11/11/98 +IF EMPTY(IDATE_FST) + REPLACE IDATE_FST WITH CURDATE + REPLACE ITIME_FST WITH TIME() + CUT_BILLTRAN( (CUR_MAST)->ORDER_NUM , GL_ARR, PARTIAL_INVOICE ) +ELSE + IF POSTED_ORDER(MORDER_NUM) + //** ORDER HAS BEEN POSTED TO THE AS/400 - CAN NOT SEND AGAIN!!! + ERR_BOX('** Order - ' + ALLTRIM(MORDER_NUM) + ; + ' has already been POSTED to the AS/400! **', ; + ' To ENSURE both Systems are in BALANCE ALL CHANGES ' , ; + ' MUST be made to BOTH Systems!!!') + ELSE + //** P3N - 11/11/98 PER ELLEN - REPRINT ORDER WITH EARLIER DATE + //** P3N - ALLOW THE INVOICE TO SHOW ON THE SALES REPORT IN THE + //** P3N - PROPER PERIOD. + IF IDATE_FST > CURDATE //** P3N - 11/11/98 + REPLACE IDATE_FST WITH CURDATE //** P3N - 11/11/98 + REPLACE ITIME_FST WITH TIME() //** P3N - 11/11/98 + ENDIF //** P3N - 11/11/98 + CUT_BILLTRAN( (CUR_MAST)->ORDER_NUM , GL_ARR, PARTIAL_INVOICE ) + ENDIF +ENDIF +(CUR_MAST)->(DBUNLOCK()) +CLOSE SALEHIST //** P3N - 8/13/98 - ADDRESS POSTING LOCKOUT +RETURN .T. +******************************************************************** +* //** P3N - 8/5/98 +* SUMMARIZE THE BACKORDER SCREENS FOR PRINTING PURPOSES +* TO THE ( PRODUCT / ENTRY SIZE ) LEVEL +* (IE: ALL C500 / 3050'S) +******************************************************************** +FUNCTION SUM_BKO_SCREENS(PASSARR) +LOCAL RETARR := {}, I, MSIZE, MPROD, MHOWMEAS, DUPLSCRNS := {}, RARR := {} +LOCAL WKARR := {}, SUMQTY := 0, SVARR := {}, SVPRD, SVSIZ, REMOVSCRN := .F. +LOCAL BKOARR := ACLONE(PASSARR), SVLINE := '', SVQTY := 0, ELM := 0, SCRTYP := '' +FOR I := 1 TO LEN(BKOARR) //** P3N - 1/28/99 + SVLINE := BKOARR[I,9] //** P3N - 1/28/99 + SVQTY := BKOARR[I,7] //** P3N - 1/28/99 + IF AT('UNIT', BKOARR[I,10] ) > 0 .OR. ; //** P3N - 1/28/99 + AT('UNT' , BKOARR[I,10] ) > 0 //** P3N - 1/28/99 + IF BKOARR[I,8] == 'OL' //** P3N - 1/28/99 + SVLINE := BKOARR[I,9] //** P3N - 1/28/99 + SVQTY := BKOARR[I,7] //** P3N - 1/28/99 + AADD(DUPLSCRNS,{ SVLINE, SVQTY } ) //** P3N - 1/28/99 + ENDIF //** P3N - 1/28/99 + ENDIF //** P3N - 1/28/99 +NEXT //** P3N - 1/28/99 +FOR I := 1 TO LEN(BKOARR) + //** ORDER QTY SHIPPED QTY + IF EMPTY( BKOARR[I,7] - BKOARR[I,11] ) + //** NO BACKORDER STUFF TO SUMMARIZE + ELSE + //** P3N - 1/28/99 - REMOVE DUPLICATE SCREENS FROM BACKORDERS + //** P3N - FOR 'UNIT' MODELS WITH FLANKERS + REMOVSCRN := .F. //** P3N - 1/28/99 + IF BKOARR[I,8] == 'XL' //** P3N - 1/28/99 + SVLINE := BKOARR[I,9] //** P3N - 1/28/99 + SVQTY := BKOARR[I,7] //** P3N - 1/28/99 + ELM := ASCAN(DUPLSCRNS, {|X| X[1] == SVLINE .AND. ; + X[2] = SVQTY }) + IF EMPTY(ELM) //** P3N - 1/28/99 + ELSE //** P3N - 1/28/99 + REMOVSCRN := .T. //** P3N - 1/28/99 + ENDIF //** P3N - 1/28/99 + ENDIF //** P3N - 1/28/99 + IF REMOVSCRN //** P3N - 1/28/99 + ELSE //** P3N - 1/28/99 + MPROD := MPROD_SUMMARY(BKOARR[I,10]) //** PRODUCT CODE + MSIZE := BKOARR[I,5,3] //** ENTRY SIZE + MHOWMEAS := BKOARR[I,5,4] //** HOW MEASURE + IF MHOWMEAS == 'NS' //** P3N - 2/02/99 + MSIZE := SUBSTR(MSIZE, 1, 5) //** P3N - 2/02/99 + ENDIF //** P3N - 2/02/99 + AADD(WKARR, {MPROD,MHOWMEAS+MSIZE, BKOARR[I] } ) + ENDIF //** P3N - 1/28/99 + ENDIF +NEXT +IF EMPTY(WKARR) +ELSE + WKARR := ASORT(WKARR,,, {|X,Y| X[1] + X[2] < Y[1] + Y[2] }) + MPROD := WKARR[1,1] + MSIZE := WKARR[1,2] + SVPRD := MPROD + SVSIZ := MSIZE + SVARR := {MPROD+MSIZE, WKARR[1,3]} + FOR I := 1 TO LEN(WKARR) + SCRTYP := WKARR[I,3,8] //** OL/XL - TYPE OF SCREEN + MPROD := WKARR[I,1] + MSIZE := WKARR[I,2] + //**P3N - SUMMARIZE SCREENS TO MODEL LEVEL + //** (IE: 500 AND 500SCR (XL) ARE SUMMARIZED TOGETHER) +//**IF (SVPRD = MPROD) .AND. (SVSIZ = MSIZE) //** P3N - 1/28/99 + IF ((SVPRD = MPROD) .OR. (SCRTYP == 'XL' .AND. AT(SVPRD, MPROD)>0 )) ; //** P3N - 1/28/99 + .AND. (SVSIZ = MSIZE) //** P3N - 1/28/99 + SUMQTY := SUMQTY + WKARR[I,3,7] + LOOP + ELSE + BKOSCRNS := BKOSCRNS + SUMQTY //** P3N - 8/12/98 (HAPPY BDAY JEFF) + ELM := ASCAN(RETARR,{|X| X[1] = MPROD+MSIZE } ) + IF EMPTY(ELM) + SVARR[2,7] := SUMQTY + AADD( RETARR, SVARR) + ELSE + RETARR[ELM, 2,7] := RETARR[ELM, 2,7] + SUMQTY + ENDIF + SUMQTY := WKARR[I,3,7] + SVPRD := MPROD + SVSIZ := MSIZE + SVARR := {MPROD+MSIZE, WKARR[I,3]} + ENDIF + NEXT + BKOSCRNS := BKOSCRNS + SUMQTY //** P3N - 8/12/98 (HAPPY BDAY JEFF) + ELM := ASCAN(RETARR,{|X| X[1] = MPROD+MSIZE } ) + IF EMPTY(ELM) + SVARR[2,7] := SUMQTY + AADD( RETARR, SVARR) + ELSE + RETARR[ELM, 2,7] := RETARR[ELM, 2,7] + SUMQTY + ENDIF +ENDIF +FOR I := 1 TO LEN(RETARR) + AADD( RARR, RETARR[I, 2]) +NEXT +RETURN RARR +******************************************************************** +//** P3N - 1/29/99 - GET THE SUMMARY CODE FOR SCREEN BACKORDERS +//** SUMMARIZE SCREENS TO MODEL LEVEL +//** (IE: 500, 500UNIT AND 500SCR ARE ALL SUMMARIZED TOGETHER) +******************************************************************** +FUNCTION MPROD_SUMMARY(PPROD) +LOCAL MPROD := PPROD, ENDPROD, I +LOCAL SUMARR := { 'UNIT', 'UNT', 'SCR', 'SCP','SCF', 'SCA' } +FOR I := 1 TO LEN(SUMARR) + ENDPROD := AT(SUMARR[I], MPROD) + IF EMPTY(ENDPROD) + ELSE + MPROD := SUBSTR(MPROD,1, ENDPROD-1) + EXIT + ENDIF +NEXT +RETURN MPROD +******************************************************************** +* HAS THE ORDER BEEN POSTED TO THE AS/400?? +* (IE: IS ORDER HISTORY REC POST DATE EMPTY??) +******************************************************************** +FUNCTION POSTED_ORDER(MORDER_NUM) +LOCAL RETVAL, CLOSEHST := .T., SVSEL := SELECT() +IF SELECT('SALEHIST') > 0 //** P3N - 12/3/98 + CLOSEHST := .F. //** P3N - 12/3/98 +ELSE + DBOPEN('SALEHIST') //** P3N - 8/13/98 - ADDRESS POSTING LOCKOUT + CLOSEHST := .T. //** P3N - 12/3/98 +ENDIF +IF SALEHIST->(DBSEEK(MORDER_NUM)) + IF EMPTY(SALEHIST->POST_DATE) .AND. EMPTY(SALEHIST->POST_TIME) + RETVAL := .F. + ELSE + RETVAL := .T. + ENDIF +ELSE + RETVAL := .F. +ENDIF +IF CLOSEHST //** P3N - 12/3/98 + CLOSE SALEHIST //** P3N - 12/3/98 +ENDIF //** P3N - 12/3/98 +SELECT(SVSEL) //** P3N - 12/3/98 +RETURN RETVAL +******************************************************************** +* GET THE INVOICE SHIP DATE +******************************************************************** +FUNCTION GET_INV_SHPDT() +LOCAL SV_SCREEN := SAVESCREEN(), SAVESEL := SELECT() +SELECT (CUR_MAST) +IF EMPTY(INVOICENUM) + REC_LOCK(1) + REPLACE INVOICENUM WITH ORDER_NUM + UNLOCK +ENDIF +MINVOICENUM := (CUR_MAST)->INVOICENUM +MSHIP_DATE := (CUR_MAST)->SHIP_DATE +MIDATE_FST := (CUR_MAST)->IDATE_FST +IF EMPTY(MIDATE_FST) + MIDATE_FST := CURDATE +ENDIF +@ 5,01 CLEAR TO 22,80 +// print all unprinted - ignore ship date pauses +// if invoice only +DO WHILE .T. + @ 11,17 SAY ' Customer :' + SETCOLOR(HNOR) + @ 11,32 SAY (CUR_MAST)->CUST_ID ; + + '-' + (CUR_MAST)->BILL_NAME + SETCOLOR(LNOR) + @ 13,17 SAY 'Invoice Date :' + SETCOLOR(HNOR) + @ 13,32 SAY DTOC(MIDATE_FST) + SETCOLOR(LNOR) + IF MHOME_LOC_CODE = 'IOLA' + @ 15,20 SAY 'Invoice # :' + MINVOICENUM + ':' + ELSE + @ 15,20 SAY 'Invoice # :' + MINVOICENUM + ':' + ENDIF + @ 17,20 SAY 'Ship Date ' GET MSHIP_DATE + READ() + IF LASTKEY() = 27 + SELECT (SAVESEL) + RESTSCREEN(,,,,SV_SCREEN) + RETURN .F. + ENDIF + IF EMPTY(MSHIP_DATE) + ERR_BOX('You can NOT ship an Order without a Ship Date !') + LOOP + ENDIF + CORR := CORRCHEK() + IF CORR$'N' + LOOP + ENDIF + IF CORR$'X' .OR. LASTKEY() = 27 + SELECT (SAVESEL) + RESTSCREEN(,,,,SV_SCREEN) + RETURN .F. + ENDIF + SELECT (CUR_MAST) + REC_LOCK(3) + REPLACE (CUR_MAST)->SHIP_DATE WITH MSHIP_DATE + UNLOCK + EXIT +ENDDO +SELECT(SAVESEL) +RESTSCREEN(,,,,SV_SCREEN) +RETURN .T. + +******************************************************************** +* GET ALL DATA FOR THE SELECTED ORDER INTO AN ARRAY AND FORMAT THE +* ARRAY INTO A FORMAT USABLE FOR PRINTING +******************************************************************** + +FUNCTION BLD_ORDER( MORDER_NUM, POSTGL, PARTIAL_INVOICE, REPRINT_INVOICE ) +LOCAL I, II, OL_ARR := {}, XL_ARR, P1, P2, P3 +LOCAL OUT_ARR := { {}, {} }, NUM_ELEM := 8 // FOR NOW! +LOCAL M1, M2, M3, NOTAX1, NOTAX2, NOTAX3, SVSEL := SELECT() +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 TOTTAX := 0, CURTAX := 0, PLUG := 0, SAVESEL := SELECT() +LOCAL GL312AMT, SHIP_STATE, BILL_STATE, WK_STATE, POST_ORDER := .F. +LOCAL SM1 := 0, SM2 := 0, SM3 := 0, IM1 := 0, IM2 := 0, IM3 := 0 +LOCAL ST1 := 0, ST2 := 0, ST3 := 0, IT1 := 0, IT2 := 0, IT3 := 0 +LOCAL MISC_ARR := {}, MSALE := 0, MISCKEY := '' //** P3N - 12/9/98 +LOCAL QTYARR := {}, SHPQTY := 0, INVQTY := 0 //** P3N - 12/9/98 + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + +IF PARTIAL_INVOICE = NIL + PARTIAL_INOICE := .F. //** P3N -12/7/98 +ENDIF //** P3N -12/7/98 + +IF REPRINT_INVOICE = NIL + REPRINT_INVOICE := .F. //** P3N -12/7/98 +ENDIF //** P3N -12/7/98 + +DBOPEN('ORD_SHIP') //** P3N - 5/1/98 +IF _WHEREORD == '2' //ORDER ENTRY FROM THE HOTKEY - F7 + CLS //CLEAR THE MISC. ITEMS SCREEN BEFORE PRINT MSG'S + TITLE := 'Print Order ' + ALLTRIM( (CUR_MAST)->ORDER_NUM) + SAYTITLE(TITLE, 'PR020') +ENDIF +IF EMPTY(POSTGL) //** P3N - 6/5/98 + POST_ORDER := .F. //** P3N - 6/5/98 +ELSE //** P3N - 6/5/98 + POST_ORDER := POSTGL //** P3N - 6/5/98 +ENDIF //** P3N - 6/5/98 +WAIT_BOX( '*** Processing Order # ' + ALLTRIM(MORDER_NUM), ; + '*** Please Wait ****' ) + +// EXPECTING A 8 ELEMENT ARRAY BACK +// 1. entire set of data for a particular line +// 1. LOCATION CODE +// 2. DESCRIPTION FOR THAT LINE +// 3. 60 BYTE ITEM PRINT LINE +// 4. SALE PRICE +// 5. DISCOUNT AMOUNT +// 6. MEMO +// 7. QUANTITY +// 8. WHERE_FROM (IE: 'OL' / 'XL') +// 9. LINE_NUM +// 10. PROD_CODE +// 11. SHP_QTY //** ORDER SHIPPING TRANSACTION QTY + +//INITIALIZE THE GL ARRAY +GL_ARR := {} +//LOAD THE GL ALLOCATION OVERRIDE ARRAY FROM THE GL_ALLOC DBF +GL_OVR := GET_GLALLOC(MORDER_NUM) +SELECT (CUR_MISC) +SEEK MORDER_NUM +MTOT := 0 +// PRODUCT SALES FROM (CUR_MISC) +DO WHILE ORDER_NUM == MORDER_NUM .AND. !EOF() + IF EMPTY( (CUR_MISC)->ALT_SPRICE) //** P3N - 2/20/98 + MSALE := (CUR_MISC)->SALE_PRICE + ELSE + M1 := MSALE := (CUR_MISC)->ALT_SPRICE //** P3N-2/20/98 + ENDIF + MISCKEY := (CUR_MISC)->ORDER_NUM + MISCKEY := MISCKEY + (CUR_MISC)->LINE_NUM + MISCKEY := MISCKEY + 'MISCITM' + QTYARR := GET_OSTQTY(CUR_OL, MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE) + IF EMPTY(QTYARR) //** P3N - 12/9/98 + SHPQTY := 0 //** P3N - 12/9/98 + INVQTY := 0 //** P3N - 12/9/98 + ELSE //** P3N - 12/9/98 + SHPQTY := QTYARR[1] //** P3N - 12/9/98 + INVQTY := QTYARR[2] //** P3N - 12/9/98 + ENDIF //** P3N - 12/9/98 + IF PARTIAL_INVOICE //** P3N - 12/9/98 + M1 := SHPQTY * MSALE //** P3N - 12/9/98 + ELSEIF REPRINT_INVOICE //** P3N - 12/9/98 + M1 := INVQTY * MSALE //** P3N - 12/9/98 + ELSE //** P3N - 12/9/98 + M1 := (CUR_MISC)->QUANTITY * MSALE + ENDIF + MISC_ITEMS->(DBSEEK ( (CUR_MISC)->PARTNUM )) + ELEM := ASCAN(GL_ARR, {|X| X[1] = MISC_ITEMS->GL_NUM } ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( M1 ) + ELSE + AADD(GL_ARR, { MISC_ITEMS->GL_NUM , M1 } ) + ENDIF + MTOT := MTOT + M1 + SKIP 1 +ENDDO + +SELECT (CUR_MAST) + +************************************************************* +* Capture the Installation amount paid per order +************************************************************* +GL312AMT := (CUR_MAST)->INST_PAID +IF GL312AMT <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = '312 '} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+ GL312AMT + ELSE // EXCLUDE FROM TAX ALLOC + AADD(GL_ARR, {'312 ', GL312AMT, ,'X' } ) + ENDIF +ENDIF +************************************************************* +* Capture the MISC ITEMS FROM SCREEN 2115 +************************************************************* +MISC_ARR := GETQTYMISC(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) +FOR I := 1 TO LEN(MISC_ARR[1]) + IF MISC_ARR[1,I,5] == 'ORDMISC1' + SM1 := MISC_ARR[1,I,3] //** SHIP QTY + IM1 := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC2' + SM2 := MISC_ARR[1,I,3] //** SHIP QTY + IM2 := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC3' + SM3 := MISC_ARR[1,I,3] //** SHIP QTY + IM3 := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX1' + ST1 := MISC_ARR[1,I,3] //** SHIP QTY + IT1 := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX2' + ST2 := MISC_ARR[1,I,3] //** SHIP OR INV QTY + IT2 := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX3' + ST3 := MISC_ARR[1,I,3] //** SHIP OR INV QTY + IT3 := MISC_ARR[1,I,6] //** INV QTY + ENDIF +NEXT + + +IF PARTIAL_INVOICE //** SHIPPED QTYS + M1 := SM1 * (CUR_MAST)->MISC_AMT1 + M2 := SM2 * (CUR_MAST)->MISC_AMT2 + M3 := SM3 * (CUR_MAST)->MISC_AMT3 +ELSEIF REPRINT_INVOICE //** INVOICED QTYS + M1 := IM1 * (CUR_MAST)->MISC_AMT1 + M2 := IM2 * (CUR_MAST)->MISC_AMT2 + M3 := IM3 * (CUR_MAST)->MISC_AMT3 +ELSE + M1 := (CUR_MAST)->MISC_QTY1 * (CUR_MAST)->MISC_AMT1 + M2 := (CUR_MAST)->MISC_QTY2 * (CUR_MAST)->MISC_AMT2 + M3 := (CUR_MAST)->MISC_QTY3 * (CUR_MAST)->MISC_AMT3 +ENDIF + +MTOT := MTOT + M1 + M2 + M3 + +IF M1 <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = MISC_GL1} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( M1 ) + ELSE + AADD(GL_ARR, { MISC_GL1, M1 } ) + ENDIF +ENDIF +IF M2 <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = MISC_GL2} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( M2 ) + ELSE + AADD(GL_ARR, { MISC_GL2, M2 } ) + ENDIF +ENDIF +IF M3 <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = MISC_GL3} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( M3 ) + ELSE + AADD(GL_ARR, { MISC_GL3, M3 } ) + ENDIF +ENDIF +************************************************************* +* Capture the NON-TAX ITEMS FROM SCREEN 2115 +* Perry Nichols 7/31/97 +************************************************************* +IF PARTIAL_INVOICE //** SHIPPED QTYS + NOTAX1 := ST1 * (CUR_MAST)->NOTX_AMT1 + NOTAX2 := ST2 * (CUR_MAST)->NOTX_AMT2 + NOTAX3 := ST3 * (CUR_MAST)->NOTX_AMT3 +ELSEIF REPRINT_INVOICE //** INVOICED QTYS + NOTAX1 := IT1 * (CUR_MAST)->NOTX_AMT1 + NOTAX2 := IT2 * (CUR_MAST)->NOTX_AMT2 + NOTAX3 := IT3 * (CUR_MAST)->NOTX_AMT3 +ELSE + NOTAX1 := (CUR_MAST)->NOTX_QTY1 * (CUR_MAST)->NOTX_AMT1 + NOTAX2 := (CUR_MAST)->NOTX_QTY2 * (CUR_MAST)->NOTX_AMT2 + NOTAX3 := (CUR_MAST)->NOTX_QTY3 * (CUR_MAST)->NOTX_AMT3 +ENDIF + +IF NOTAX1 <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = NOTX_GL1} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( NOTAX1 ) + ELSE // EXCLUDE FROM TAX ALLOC + AADD(GL_ARR, { NOTX_GL1, NOTAX1,,'X' } ) + ENDIF +ENDIF +IF NOTAX2 <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = NOTX_GL2} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( NOTAX2 ) + ELSE // EXCLUDE FROM TAX ALLOC + AADD(GL_ARR, { NOTX_GL2, NOTAX2,,'X' } ) + ENDIF +ENDIF +IF NOTAX3 <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = NOTX_GL3} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+( NOTAX3 ) + ELSE // EXCLUDE FROM TAX ALLOC + AADD(GL_ARR, { NOTX_GL3, NOTAX3,,'X' } ) + ENDIF +ENDIF +SELECT (SAVESEL) + +IF TAX_ARR[2] <> 0 // TOTAL RATE + FOR I := 1 TO LEN(TAX_DET) + CURTAX := VAL(STR(TAX_DET[I,1] * ; + ( (CUR_MAST)->ORD_L_TTL - ; + (CUR_MAST)->ORD_BO_TTL - ; //** P3N - 11/19/98 + (CUR_MAST)->ORD_D_TTL + MTOT), 9, 2)) + CURTAX := MIN( (CUR_MAST)->SALES_TAX - TOTTAX, CURTAX) + IF CURTAX <> 0 + // GL ACCT# TAXAMT TAX DESC EXCLUDE FROM ALLOC. + AADD(GL_ARR, { TAX_DET[I,3] + ' ', CURTAX, TAX_DET[I,2], 'X' } ) + TOTTAX := TOTTAX + CURTAX + ENDIF + NEXT + // IS THE PLUG AMOUNT BASED ON THE total or the quote? + IF TOTTAX <> (CUR_MAST)->SALES_TAX + PLUG := (CUR_MAST)->SALES_TAX - TOTTAX + IF LEN(GL_ARR) > 0 //** P3N - 01/14/09 + GL_ARR[LEN(GL_ARR),2] := GL_ARR[LEN(GL_ARR),2] + PLUG + ENDIF + ENDIF +ENDIF +IF (CUR_MAST)->( FIELDPOS('FREIGHT') ) > 0 + IF (CUR_MAST)->FREIGHT <> 0 //EXCLUDE FROM TAX - ALLOC. + AADD(GL_ARR, { 'FREIGHT', (CUR_MAST)->FREIGHT, , 'X' } ) + ENDIF +ENDIF +IF POST_ORDER + //** BUILD THE GL_ARR FOR POSTING - NO NEED TO GET_ORD_DATA()! +ELSE + OL_ARR := GET_ORD_DATA(MORDER_NUM, CUR_OL, PARTIAL_INVOICE, REPRINT_INVOICE) + SELECT (CUR_XL) + DONSETORD(3) // ORDER + LINE# + XL_ARR := GET_ORD_DATA(MORDER_NUM, CUR_XL, PARTIAL_INVOICE, REPRINT_INVOICE) + SELECT (CUR_XL) + DONSETORD(1) + * DISECT THE OL_ARR AND PUT THE CTRL, FRAME, GLASS, SASH, INV + * STUFF INTO THE OUT_ARR IN THE PROPER HIERARCHY + * NOTICE, EACH ELEMENT OF THE OL_ARR IS SIMPLY AN 80 BYTE TEXT PRINT LINE + + FOR I = 1 TO LEN(OL_ARR) + IF I = 7 // customer invoice copy + AADD(OUT_ARR[2], OL_ARR[I]) // 8 ELEMENT ARRAY WITH LOC_CODE, HEADING, ITEM, + ELSE // GROSS SALE PRICE, DISCOUNT AMT + AADD(OUT_ARR[1], OL_ARR[I]) + ENDIF + NEXT + FOR I = 1 TO LEN(XL_ARR) + IF I = 7 // customer invoice copy + // NO XL ITEMS ON CUSTOMER COPIES // 8 ELEMENT ARRAY WITH LOC_CODE, HEADING, ITEM, + ELSE // GROSS SALE PRICE, DISCOUNT AMT + FOR II := 1 TO LEN(XL_ARR[I]) + IF I < 7 + AADD(OUT_ARR[1,I], XL_ARR[I, II]) + ELSE + AADD(OUT_ARR[1,I-1], XL_ARR[I, II]) + ENDIF + NEXT + ENDIF + NEXT + //* SORT SUB ARRAY'S IN LINE_NUM + OL/XL + PROD_CODE FOR PRINTING + //* (IE: SUB ARRAY'S ARE - CTRL, FRAME, SASH, GLASS, SCREEN, STORM) + // IF A SEQUENCE NUMBER, PUT THAT ONE AT THE BOTTOM OR SOMETHING + ///***///***///***\\\***\\\***\\\ + FOR I := 1 TO LEN(OUT_ARR[1]) + * OUT_ARR[1,I] := ASORT(OUT_ARR[1,I],,, {|X,Y| X[9] + X[8] + X[10] < Y[9] + Y[8] + Y[10] }) + IF EMPTY(OUT_ARR[1,I]) //** P3N - 5/17/99 + ELSE //** P3N - 5/17/99 + OUT_ARR[1,I] := ASORT(OUT_ARR[1,I],,, {|X,Y| X[2] + X[9] < Y[2] + Y[9] }) + ENDIF //** P3N - 5/17/99 + NEXT + // INVOICE PARTS + OUT_ARR[2,1] := ASORT(OUT_ARR[2,1],,, {|X,Y| X[2] + X[9] < Y[2] + Y[9] }) +ENDIF +//**IF (CUR_MAST)->TERMS = '90' .OR. ; //** NO CHARGE //**P3N - 6/16/98 +//** (CUR_MAST)->TERMS = '96' //** CANCELLATION //**P3N - 6/16/98 +IF ZERO_ORDER() //** NO CHARGE //**P3N - 3/05/99 + GL_ARR := {} //** P3N - 6/16/98 FORCE GL ALLOC. TO ZERO + GL_OVR := {} //** P3N - 6/16/98 FORCE GL ALLOC. TO ZERO +ENDIF +IF EMPTY(OUT_ARR[1]) .AND. EMPTY(OUT_ARR[2]) + RETURN {} +ELSE + RETURN OUT_ARR +ENDIF + + +***************************************************************** +* CALC TOTAL MISC ITEMS / NOTX ITEMS +***************************************************************** +FUNCTION CALC_TOTMISC( CUR_MAST , MORDER_NUM, INCLD_NOTX) +LOCAL RETVAL := ( (CUR_MAST)->MISC_QTY1 * (CUR_MAST)->MISC_AMT1 ) ; + + ( (CUR_MAST)->MISC_QTY2 * (CUR_MAST)->MISC_AMT2 ) ; + + ( (CUR_MAST)->MISC_QTY3 * (CUR_MAST)->MISC_AMT3 ) ; + + (CUR_MAST)->ORD_M_TTL +IF EMPTY(INCLD_NOTX) //** P3N - 1/11/99 +ELSEIF INCLD_NOTX //** P3N - 1/11/99 + RETVAL := RETVAL + ( (CUR_MAST)->NOTX_QTY1 * (CUR_MAST)->NOTX_AMT1 ) ; + + ( (CUR_MAST)->NOTX_QTY2 * (CUR_MAST)->NOTX_AMT2 ) ; + + ( (CUR_MAST)->NOTX_QTY3 * (CUR_MAST)->NOTX_AMT3 ) +ENDIF //** P3N - 1/11/99 +RETURN RETVAL //** P3N - 1/11/99 +***************************************************************** +* GET THE GL ALLOCATIONS FOR A GIVEN ORDER! IF NONE EXIST RET EMPTY ARRAY +***************************************************************** +FUNCTION GET_GLALLOC(MORDER_NUM) +//** 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 RET_ARR := {}, GL_AMT +LOCAL SV_SEL := SELECT() +DBOPEN('GL_ALLOC') + +IF DBSEEK(MORDER_NUM) + DO WHILE .T. + IF GL_ALLOC->(EOF()) + EXIT + ENDIF + IF GL_ALLOC->ORDER_NUM == MORDER_NUM + GL_AMT := AMOUNT + ADJ_AMT + AADD(RET_ARR, {GL_NUM, GL_AMT, TAX_DESC, TAX_ALLOC}) + ELSE + EXIT + ENDIF + DBSKIP(+1) + ENDDO +ENDIF +USE +SELECT(SV_SEL) +RETURN RET_ARR + +***************************************************************** +* PRINT COMPLETE ORDER-(IE: PROD CTRL, OR PROD FRAME, OR PROD SASH...) +***************************************************************** +FUNCTION PRNT_THE_ORDER(WHCHORDER, PRN_ARR, WHICH_TYPE, WHCH_LOCATION, ; + SUBTYPE, DO_CUT_SPECS, PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + +LOCAL MORDER_NUM := (CUR_MAST)->ORDER_NUM, I, LI_TOTALS := 0, ELM +LOCAL DO_LINES := .T., PAMTS := {}, III, WORKARR := {} +LOCAL LI_AMTDON, LASTDESC, TOTPRNT := 0, SUBPRNT := 0, NUMPRNT := 0 +LOCAL NUMBRK := 0, THESE_ITEMS := 0, LAST_PAMT, THIS_NUM, DIDFST := .F. +LOCAL PHEAD_ARR := {}, PRT_AMT := .F., BKOMODEL, LASTBKOM +LOCAL PBODY_ARR := {}, LASTMODEL, DISC_ARR, PAMTS_ARR := {}, PTAIL_ARR := {} +LOCAL RETARR := {}, NUMX := 0, PRT_GL_INFO +LOCAL L1:=0, L2:=0, L3:=0, M1:=0, M2:=0, M3:=0, MTOT:=0, PRINTFRAME := .F. +LOCAL B1:=0, B2:=0, B3:=0, S1:=0, S2:=0, S3:=0, A1:=0, A2:=0, A3:=0, STOT := 0 +LOCAL I1:=0, I2:=0, I3:=0, ITOT := 0, INCL_ALL_LINES, RET_ARR, PRT_DISC_ARR +LOCAL CNT_LI_DISC := 0, LI_DISC_PRNT := .F., WORKPRICE := 0 +LOCAL MISCITM_OSTQTY := 0, MISC_ARR := {}, PRT_BO := .F., SUPPRESS_TOT := .F. +LOCAL MPORT + +PRIVATE FORMTYPE := GET_FORMTYPE(WHCHORDER, WHICH_TYPE, SUBTYPE) + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF EMPTY(REPRINT_INVOICE) //** P3N - 12/3/98 + REPRINT_INVOICE := .F. //** P3N - 12/3/98 +ENDIF //** P3N - 12/3/98 +IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/13/98 + PARTIAL_INVOICE := .F. //** P3N - 11/13/98 +ENDIF //** P3N - 11/13/98 +IF DO_CUT_SPECS = NIL + DO_CUT_SPECS := .F. +ENDIF + +/* +************************************************************ + 1. WHCHORDER - TELLS WHETHER INVOICE/PRODUCTION/ORDER DESK (DEFINES WHAT COPIES TO PRINT) + 2. PRN_ARR - TELLS WHAT IS AVAIL TO PRINT IN THE LINE ITEM BODY + 3. WHICH_TYPE- TELLS WHAT HEADING TO PRINT ON THE ORDER HEADING + 4. WHCH_LOCAT- TELLS WHICH LOCATION WE ARE CONCERNED WITH + 1. "ALL" MEANS PRINT EVERYTHING IN THE PRN_ARR + THIS IS SENT FOR "ORDER CONTROL COPY" AND "CUSTOMER INVOICES" + 2. IF NOT "ALL", IT WILL REPRESENT A SPECIFIC LOCATION CODE + -IF THE CODE IS THE MHOME_LOC_CODE, THE ORDER WILL FILTER OUT + ONLY ITEMS TO BE PRODUCED ON THE FRAME, SASH, GLASS,STORMS COPY + -IF THE CODE IS !MHOME_LOC_CODE, THE ORDER WILL PRINT AS + A "INTERCOMPANY PURCHASE ORDER" CTRL DATA. DON'T WORRY ABOUT + IT, JUST FYI. WHICH_TYPE WILL BE "PO" OR "MANIFEST", ETC. + THE PRN_ARR WILL ALREADY CONTAIN THE "CTRL" INFO SINCE THAT + DATA CAN ALSO BE USED AS PURCHASE ORDER LINE DATA. + 5. SUBTYPE - TELLS IF IT IS AN ORDER DESK DELIVERY COPY + 6. DO_CUT_SPECS - TELLS IF WE SHOULD PRINT ITEMS FROM THE CUT_SPEC_ARR + ( CURRENTLY ONLY DONE ON FRAME COPY ) + ************************************************************ +*/ + + +(CUR_MAST)->(DBSEEK(MORDER_NUM)) +//**IF EMPTY(PRN_ARR) .AND. EMPTY( (CUR_MAST)->NOTES ) +IF EMPTY(PRN_ARR) + //** P3N - 12/2/98 CHECK FOR MISC ITEMS BACKORDERED + IF ( WHCHORDER == 'BACKORD' .AND. SUBTYPE == 'BACKORD' ) + IF EMPTY((CUR_MAST)->ORDER_NEW) //** P3N - 12/9/98 + ELSE + RETURN //** PARTIAL INVOICE - NO BACKORDER + ENDIF + IF EMPTY( CALC_TOTMISC( CUR_MAST, MORDER_NUM,.T.) ) //** P3N - 1/11/99 + RETURN //** P3N - 1/11/99 + ENDIF //** P3N - 1/11/99 + ELSEIF WHCHORDER == 'INV' + IF MISCSHIPPED(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) + RETURN + ENDIF + ELSEIF EMPTY( (CUR_MAST)->NOTES ) + RETURN + ENDIF +ENDIF +IF EMPTY(WIDEON) + SET_P_OFF() + ERR_BOX('Printer is NOT properly set!',' ', ; + 'Please SETUP Printer through Utility MENU - PRINTER Selection!' ) + RETURN +ENDIF +IF WHCH_LOCATION = NIL + ? ABEND +ENDIF +// SCAN THE BODY OF THE ORDER TO ENSURE THAT A LOCATION ITEM EXISTS HERE +// IF NOT 'ALL' ITEMS +IF WHCHORDER = 'PROD' .OR. WHCHORDER = 'OD' + DO CASE + CASE WHICH_TYPE = 'CTRL' + DO_LINES := .T. + OTHERWISE + DO_LINES := SCAN_PRNARR(PRN_ARR, WHCH_LOCATION) + ENDCASE + IF WHICH_TYPE == 'SCREEN' + DO_LINES := .T. // DO SCREEN regardless of the MFG. location. + ENDIF +ELSE + DO_LINES := .T. +ENDIF +// SO FAR, HAVE DATA FOR THIS LOCATION +// SCAN THE BODY OF THE ORDER TO ENSURE THAT QTY > 0 (NOT CREDIT MEMO) +// IF NOT 'ALL' ITEMS +//**TOTMISC := CALC_TOTMISC( CUR_MAST, MORDER_NUM ) +TOTMISC := CALC_TOTMISC( CUR_MAST, MORDER_NUM , .T.) //** P3N - 1/11/99 +IF !EMPTY( (CUR_MAST)->NOTES ) + DO_LINES := .T. +ENDIF +IF WHCHORDER <> 'INV' .AND. DO_LINES + IF TOTMISC <> 0 .AND. ; + (SUBTYPE = 'DELIVERY' .OR. SUBTYPE = 'ORDERDESK' ) //** P3N - 1/15/99 +//** (SUBTYPE = 'DELIVERY' .OR. SUBTYPE = 'ORDERDESK' .OR. SUBTYPE = 'BACKORD') + ELSEIF !EMPTY(TOTMISC) .AND. SUBTYPE = 'BACKORD' //** P3N - 1/15/99 + IF MISCSHIPPED(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) + //** P3N - 1/15/99 CHECK FOR MISC ORDER LINES ITEMS ON BACKORDER + MISC_ARR := BLD_MISCORD('TORD_LINES', {}, {}, 0, ; + .F., .F., .F., WHCHORDER, , , .T., SUBTYPE ) + IF EMPTY(MISC_ARR[4]) //** P3N - 1/15/99 + DO_LINES := .F. //** P3N - 12/04/01 + FOR I := 1 TO LEN(PRN_ARR) //** P3N - 12/04/01 + // DO BKO COPY IF NO MISC BUT BKO QTY > 0 + IF PRN_ARR[I,7] > 0 .OR. !EMPTY(PRN_ARR[I,13]) //** ONLY PRINT BKO IF QTY > 0 + DO_LINES := .T. //** OR CUT SPECS + EXIT //** P3N - 12/04/01 + ENDIF //** P3N - 12/04/01 + NEXT //** P3N - 12/04/01 + IF DO_LINES //** P3N - 12/04/01 + //** NO MISC BKO ITMS BUT WE HAVE OTHER BKO ITEMS TO PROCESS + ELSE //** P3N - 12/04/01 + RETURN //** P3N - 12/04/01 + ENDIF //** P3N - 12/04/01 + ENDIF //** P3N - 1/15/99 + ENDIF //** P3N - 1/15/99 + ELSE //** P3N - 1/15/99 + DO_LINES := .F. + FOR I := 1 TO LEN(PRN_ARR) + // ONLY PRINT PRODUCTION,ETC IF QTY > 0 + IF PRN_ARR[I,7] > 0 .OR. !EMPTY(PRN_ARR[I,13]) // ONLY PRINT PRODUCTION,ETC IF QTY > 0 + DO_LINES := .T. // NOT A CREDIT MEMO OR CUT SPECS + EXIT + ENDIF + NEXT + ENDIF +ENDIF +IF !DO_LINES + RETURN +ENDIF +// INVOICE SHOULD NOT PRINT ANY ITEMS +// WHICH CAME FROM THE 'ADDL_LINES' FILE. + // ARE THERE ANY PRODUCTION ITEMS TO PRINT AT THIS LOCATION ??? +IF WHCHORDER == 'PROD' .AND. WHICH_TYPE <> 'CTRL' + IF EMPTY(ASCAN(PRN_ARR,{|X| X[1] == WHCH_LOCATION })) + RETURN + ENDIF +ENDIF + // ARE THERE ANY IC ORDER ITEMS TO PRINT AT THIS LOCATION ??? +IF WHCHORDER == 'OD' .AND. WHICH_TYPE == 'PO' + IF EMPTY(ASCAN(PRN_ARR,{|X| X[1] == WHCH_LOCATION })) + RETURN + ENDIF +ENDIF +// ARE THERE ANY PRODUCTION FRAME ITEMS TO PRINT ??? +IF AT('FRAME', WHICH_TYPE) > 0 + FOR I := 1 TO LEN(PRN_ARR) + IF PRT_FRAME(WHICH_TYPE, PRN_ARR[I,10]) + PRINTFRAME := .T. + ENDIF + NEXT + IF PRINTFRAME + // FRAME COPY FOUND TO PRINT - CONTINUE PROCESSING! + ELSE + RETURN + ENDIF +ENDIF +PHEAD_ARR := BLD_HEAD(MORDER_NUM, WHICH_TYPE, WHCH_LOCATION, ; + WHCHORDER, SUBTYPE ) +IF (WHICH_TYPE == 'INV' .AND. CUR_MAST == 'ORD_MAST') .OR. ; //**P3N - 11/24/98 + WHICH_TYPE == 'BACKORD' //**P3N - 2/23/99 + //** P3N -11/19/98 - INVOICE PROCESSING? + IF EMPTY((CUR_MAST)->ORDER_ORG) + //** P3N -11/19/98 THIS ORDER WAS NOT CREATED FROM A PARTIAL INVOICE? + ELSE + DIDFST := .T. + //** THIS ORDER WAS CREATED FROM A PARTIAL INVOICE? + AADD(PBODY_ARR, '^' + SPACE(14) + 'BACKORDER FROM ORDER# ' + (CUR_MAST)->ORDER_ORG ) + AADD(PAMTS_ARR, NIL) + ENDIF + IF EMPTY((CUR_MAST)->ORDER_NEW) + //** P3N -11/19/98 THIS ORDER IS NOT A PARTIAL INVOICE? + ELSE + DIDFST := .T. + //** THIS ORDER IS A PARTIAL INVOICE? + AADD(PBODY_ARR, '^' + SPACE(14) + 'BACKORDERED ITEMS ON ORDER# ' + (CUR_MAST)->ORDER_NEW ) + AADD(PAMTS_ARR, NIL) + ENDIF +ENDIF +// ONCE FOR EACH LINE ITEM RECORD +LAST_PAMT := 0 +FOR I := 1 TO LEN(PRN_ARR) + IF EMPTY(PRN_ARR[I,2]) + LOOP + ENDIF +//** IF THIS IS A FRAME COPY ARE THERE ANY STORM DOORS(STD) OR PIN-ONS(PWS)? + IF AT('FRAME', WHICH_TYPE) > 0 + IF PRT_FRAME(WHICH_TYPE, PRN_ARR[I,10]) + ELSE + LOOP + ENDIF + ENDIF + INCL_ALL_LINES := .T. + IF (WHICH_TYPE == 'INV' .OR. WHICH_TYPE == 'CTRL') .AND. WHCHORDER <> 'PROD' + //** LET INVOICE AND CTRL COPIES PRINT REGARDLESS OF MFG. LOC + ELSEIF WHCHORDER == 'BACKORD' + //** P3N - 5/1/98 - LET BACKORDERS PRINT REGARDLESS OF MFG. LOC + ELSEIF PRN_ARR[I,1] == WHCH_LOCATION + // FOR ALL COPIES EXCEPT "INV" & "CTRL" + // ONLY PRINT ITEMS FOR GIVEN LOCATION + ELSEIF PRN_ARR[I,15] //DO_SCRNS_ONLY regardless of the MFG location + IF MHOME_LOC_CODE = 'KC' //FOR KANSAS CITY(KC) ONLY !!!!!!! 6-18-97 + LOOP + ENDIF + ELSEIF WHICH_TYPE == 'CTRL' .AND. WHCHORDER == 'PROD' + INCL_ALL_LINES := .T. + ELSE + LOOP + ENDIF + IF LASTDESC = NIL + LASTDESC := PRN_ARR[I,2] + ENDIF + IF EMPTY(LASTMODEL) + LASTMODEL := PRN_ARR[I,10] //SAVE THE PRODUCT MODEL + LASTBKOM := MPROD_SUMMARY(LASTMODEL) //** P3N - 2/02/99 + ENDIF + BKOMODEL := MPROD_SUMMARY(PRN_ARR[I,10]) //** P3N - 2/02/99 +//** DISCOUNT MODIFICATIONS - 10-7-97 + IF (WHICH_TYPE == 'INV' .OR. WHICH_TYPE == 'CTRL') + IF LASTMODEL == PRN_ARR[I,10] + ELSEIF PRINT_DISC(PRN_ARR, LASTMODEL) //PRINT A DISCOUNT% + DISC_ARR := GETDISCTOT(PRN_ARR, I-1) + PRT_DISC_ARR := PRNT_DISCOUNTS( DISC_ARR, WHCHORDER, SUBTYPE) + FOR ELM := 1 TO LEN(PRT_DISC_ARR) + AADD(PBODY_ARR, PRT_DISC_ARR[ELM] ) + AADD(PAMTS_ARR, {}) + CNT_LI_DISC := CNT_LI_DISC + 1 + NEXT + ENDIF + ENDIF + //** P3N - 2/02/99 + IF ( INCL_ALL_LINES .AND. !(LASTBKOM == BKOMODEL) .AND. ; //** P3N - 2/02/99 + WHCHORDER == 'BACKORD' .AND. SUBTYPE == 'SCREENS' ) //** P3N - 2/02/99 + NUMBRK ++ + IF NUMPRNT > 1 .AND. MHOME_LOC_CODE <> 'IOLA' ; // DARLENE 8-21-96 + .AND. MHOME_LOC_CODE <> 'LINDS' // LINDA 8-23-96 + IF WHCHORDER == 'BACKORD' //** P3N - 9/22/98 HAPPY BDAY CINDY + IF MHOME_LOC_CODE = 'PAWNEE' //** P3N 2-23-99 + AADD(PBODY_ARR,SPACE(5)+'-----') //** P3N - 2/23/99 + AADD(PAMTS_ARR, {}) //** P3N - 2/23/99 + AADD(PBODY_ARR,SPACE(5)+STR(SUBPRNT,4)) + AADD(PAMTS_ARR, {}) //** P3N - 2/23/99 + ELSE //** P3N - 2/23/99 + AADD(PBODY_ARR,SPACE(9)+'-----') //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PAMTS_ARR, {}) //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PBODY_ARR,SPACE(9)+STR(SUBPRNT,4)) + AADD(PAMTS_ARR, {}) //** P3N - 9/22/98 HAPPY BDAY CINDY + ENDIF //** P3N - 2/23/99 + ELSE //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PBODY_ARR, '-----' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, STR(SUBPRNT,4) ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, '-----' ) + AADD(PAMTS_ARR, {}) + ENDIF //** P3N - 9/22/98 HAPPY BDAY CINDY + ENDIF + SUBPRNT := 0 + NUMPRNT := 0 +//**IF !(LASTDESC == PRN_ARR[I,2]) .AND. INCL_ALL_LINES + ELSEIF ( INCL_ALL_LINES .AND. !(LASTDESC == PRN_ARR[I,2]) .AND. ; + (WHCHORDER == 'BACKORD' .AND. SUBTYPE <> 'SCREENS' .OR. ; //** P3N - 2/02/99 + WHCHORDER <> 'BACKORD' ) ) //** P3N - 2/02/99 + NUMBRK ++ + IF NUMPRNT > 1 .AND. MHOME_LOC_CODE <> 'IOLA' ; // DARLENE 8-21-96 + .AND. MHOME_LOC_CODE <> 'LINDS' // LINDA 8-23-96 + IF WHCHORDER == 'BACKORD' //** P3N - 9/22/98 HAPPY BDAY CINDY + IF MHOME_LOC_CODE = 'PAWNEE' //** P3N 2-23-99 + AADD(PBODY_ARR,SPACE(5)+'-----') //** P3N - 2/23/99 + AADD(PAMTS_ARR, {}) //** P3N - 2/23/99 + AADD(PBODY_ARR,SPACE(5)+STR(SUBPRNT,4)) + AADD(PAMTS_ARR, {}) //** P3N - 2/23/99 + ELSE //** P3N - 2/23/99 + AADD(PBODY_ARR,SPACE(9)+'-----') //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PAMTS_ARR, {}) //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PBODY_ARR,SPACE(9)+STR(SUBPRNT,4)) + AADD(PAMTS_ARR, {}) //** P3N - 9/22/98 HAPPY BDAY CINDY + ENDIF //** P3N - 2/23/99 + ELSE //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PBODY_ARR, '-----' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, STR(SUBPRNT,4) ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, '-----' ) + AADD(PAMTS_ARR, {}) + ENDIF //** P3N - 9/22/98 HAPPY BDAY CINDY + ENDIF + SUBPRNT := 0 + NUMPRNT := 0 + ENDIF + RETARR := BLD_BODY(PRN_ARR[I], WHICH_TYPE, WHCH_LOCATION, ; + PBODY_ARR, PAMTS_ARR, WHCHORDER, SUBTYPE, ; + INCL_ALL_LINES, DO_CUT_SPECS, PARTIAL_INVOICE, REPRINT_INVOICE ) + LI_AMTDON := RETARR[1] + PBODY_ARR := RETARR[2] + PAMTS_ARR := RETARR[3] + IF INCL_ALL_LINES + LI_TOTALS := LI_TOTALS + LI_AMTDON + NUMX := PRN_ARR[I,12] + 1 // TOTAL WINDOWS PER UNIT (XTRA WIND + 1) + // LINE ITEM QUANTITY + LAST_PAMT ++ + THIS_NUM := 0 + FOR III := LAST_PAMT TO LEN(PAMTS_ARR) + IF WHCHORDER == 'BACKORD' //** P3N - 9/22/98 HAPPY BDAY CINDY + IF EMPTY(PAMTS_ARR[III]) //** P3N - 9/22/98 HAPPY BDAY CINDY + ELSEIF EMPTY(PAMTS_ARR[III,3]) + ELSE + THIS_NUM := THIS_NUM + (PAMTS_ARR[III,3]) + ENDIF + ELSE + IF EMPTY(PAMTS_ARR[III]) + ELSEIF EMPTY(PAMTS_ARR[III,1]) + ELSE + THIS_NUM := THIS_NUM + (PAMTS_ARR[III,1]) + ENDIF + ENDIF + NEXT + LAST_PAMT := LEN(PAMTS_ARR) + NUMPRNT := NUMPRNT + THIS_NUM + // ACTUAL WINDOWS QUANTITY ( 1 TWIN = 2 WINDOWS TOTAL ) + SUBPRNT := SUBPRNT + (THIS_NUM * NUMX) + TOTPRNT := TOTPRNT + (THIS_NUM * NUMX) + ENDIF + LASTDESC := PRN_ARR[I,2] + LASTMODEL := PRN_ARR[I,10] //SAVE THE PRODUCT MODEL - 10-7-97 + LASTBKOM := BKOMODEL //** P3N - 2/02/99 +NEXT +//** DISCOUNT MODIFICATIONS - 10-7-97 +IF (WHICH_TYPE == 'INV' .OR. WHICH_TYPE == 'CTRL') + IF PRINT_DISC(PRN_ARR, LASTMODEL) //PRINT A DISCOUNT% + DISC_ARR := GETDISCTOT(PRN_ARR, I-1) + PRT_DISC_ARR := PRNT_DISCOUNTS( DISC_ARR, WHCHORDER, SUBTYPE) + FOR ELM := 1 TO LEN(PRT_DISC_ARR) + AADD(PBODY_ARR, PRT_DISC_ARR[ELM] ) + AADD(PAMTS_ARR, {}) + CNT_LI_DISC := CNT_LI_DISC + 1 + NEXT + ENDIF +ENDIF +IF NUMPRNT > 1 .AND. SUBPRNT <> 0 .AND. MHOME_LOC_CODE <> 'IOLA' ; // DARLENE 8-21-96 + .AND. MHOME_LOC_CODE <> 'LINDS' // LINDA 8-23-96 + IF WHCHORDER == 'BACKORD' //** P3N - 9/22/98 HAPPY BDAY CINDY + IF MHOME_LOC_CODE = 'PAWNEE' //** P3N 2-23-99 + AADD(PBODY_ARR,SPACE(5)+'-----') //** P3N - 2/23/99 + AADD(PAMTS_ARR, {}) //** P3N - 2/23/99 + AADD(PBODY_ARR,SPACE(5)+STR(SUBPRNT,4)) + AADD(PAMTS_ARR, {}) //** P3N - 2/23/99 + ELSE //** P3N - 2/23/99 + AADD(PBODY_ARR,SPACE(9)+'-----') //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PAMTS_ARR, {}) //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PBODY_ARR,SPACE(9)+STR(SUBPRNT,4)) + AADD(PAMTS_ARR, {}) //** P3N - 9/22/98 HAPPY BDAY CINDY + ENDIF //** P3N - 2/23/99 + ELSE //** P3N - 9/22/98 HAPPY BDAY CINDY + AADD(PBODY_ARR, '-----' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, STR(SUBPRNT,4) ) + AADD(PAMTS_ARR, {}) + ENDIF //** P3N - 9/22/98 HAPPY BDAY CINDY + NUMBRK ++ +ENDIF +// MISC PRINTING +IF WHCHORDER = 'BACKORD' .AND. SUBTYPE == 'BACKORD' //** P3N - 7/7/98 + PRT_BO := .T. //** P3N - 9/24/98 + //** ORDER MISC(CGW0OMI) MISC ORDER LINE ITEMS BO PRINT + MISC_ARR := BLD_MISCORD('TORD_LINES', PBODY_ARR, PAMTS_ARR, LI_TOTALS, ; + PRT_AMT, DIDFST, PRT_BO, WHCHORDER, ; + PARTIAL_INVOICE, REPRINT_INVOICE, ,SUBTYPE ) + PBODY_ARR := MISC_ARR[1] + PAMTS_ARR := MISC_ARR[2] + LI_TOTALS := MISC_ARR[3] + //** ORDER MASTER(CGW0OM) MISC ITEMS (SCREEN 2115) BO PRINT + MISC_ARR := BLD_ORDMISC( PBODY_ARR, PAMTS_ARR, LI_TOTALS, PRT_AMT, PRT_BO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE ) + PBODY_ARR := MISC_ARR[1] + PAMTS_ARR := MISC_ARR[2] + LI_TOTALS := MISC_ARR[3] + MISC_ARR := {{}} //** P3N - 12/2/98 +ELSEIF WHCHORDER = 'INV' ; //INVOICE + .OR. (WHCHORDER = 'OD' .AND. WHICH_TYPE = 'CTRL'); //OD CTRL & DELIVERY + .OR. (WHCHORDER = 'PROD' .AND. WHICH_TYPE = 'CTRL') //GOLDEN ROD + PRT_BO := .F. //** P3N - 9/24/98 + IF WHCHORDER = 'INV' .AND. CUR_MAST = 'ORD_MAST' //** P3N - 9/24/98 + PRT_BO := .T. //** P3N - 9/24/98 + ENDIF //** P3N - 9/24/98 + PRT_AMT := DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) + MISC_ARR := BLD_MISCORD(CUR_MISC, PBODY_ARR, PAMTS_ARR, LI_TOTALS, ; + PRT_AMT, DIDFST, PRT_BO, WHCHORDER, ; + PARTIAL_INVOICE, REPRINT_INVOICE, ,SUBTYPE ) + PBODY_ARR := MISC_ARR[1] + PAMTS_ARR := MISC_ARR[2] + LI_TOTALS := MISC_ARR[3] + //** P3N -11/25/98 - INVOICE PROCESSING + M1 := (CUR_MAST)->MISC_QTY1 + M2 := (CUR_MAST)->MISC_QTY2 + M3 := (CUR_MAST)->MISC_QTY3 + L1 := (CUR_MAST)->MISC_AMT1 + L2 := (CUR_MAST)->MISC_AMT2 + L3 := (CUR_MAST)->MISC_AMT3 + MTOT := (M1*L1) + (M2*L2) + (M3*L3) +//** PARTIAL / REPRINT INVOICE +//** IF PARTIAL INVOICE S1, S2, S3 ARE SHIP QTYS +//** IF REPRINT INVOICE I1, I2, I3 ARE INV QTYS + MISC_ARR := GETQTYMISC(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) + FOR I := 1 TO LEN(MISC_ARR[1]) + IF MISC_ARR[1,I,5] == 'ORDMISC1' + S1 := MISC_ARR[1,I,3] //** SHIP QTY + I1 := MISC_ARR[1,I,6] //** INV QTY + A1 := MISC_ARR[1,I,4] //** ITEM PRICE + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC2' + S2 := MISC_ARR[1,I,3] //** SHIP QTY + I2 := MISC_ARR[1,I,6] //** INV QTY + A2 := MISC_ARR[1,I,4] //** ITEM PRICE + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC3' + S3 := MISC_ARR[1,I,3] //** SHIP QTY + I3 := MISC_ARR[1,I,6] //** INV QTY + A3 := MISC_ARR[1,I,4] //** ITEM PRICE + ENDIF + NEXT +//** STOT CONTAINS THE TOTAL AMOUNT OF SHIPPED ITEMS + STOT := (S1*A1) + (S2*A2) + (S3*A3) +//** ITOT CONTAINS THE TOTAL AMOUNT OF INVOICED ITEMS + ITOT := (I1*A1) + (I2*A2) + (I3*A3) + //** CALC BO AMTS + B1 := M1 - S1 //** P3N - 11/25/98 + B2 := M2 - S2 //** P3N - 11/25/98 + B3 := M3 - S3 //** P3N - 11/25/98 + IF (CUR_MAST)->MISC_QTY1 <> 0 .OR. ; + (CUR_MAST)->MISC_QTY2 <> 0 .OR. ; + (CUR_MAST)->MISC_QTY3 <> 0 + IF PARTIAL_INVOICE + LI_TOTALS := LI_TOTALS + STOT + ELSEIF REPRINT_INVOICE + LI_TOTALS := LI_TOTALS + ITOT + ELSE + LI_TOTALS := LI_TOTALS + MTOT + ENDIF + IF NUMPRNT > 1 .AND. SUBPRNT <> 0 .AND. MHOME_LOC_CODE <> 'IOLA' ; // PER DARLENE 8-22-96 + .AND. MHOME_LOC_CODE <> 'LINDS' // PER LINDA 8-23-96 + AADD(PBODY_ARR, '-----' ) + AADD(PAMTS_ARR, {}) + ENDIF +//**P3N - 11/24/98 ALREADY EXECUTED ABOVE - 40 or 45 LINES +//**PRT_AMT := DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) +//** P3N - 11/25/98 + IF (CUR_MAST)->MISC_QTY1 <> 0 + PAMTS := { M1,B1,S1, L1, PRT_AMT, PRT_BO, 0, , I1 } + AADD(PBODY_ARR, '^' + (CUR_MAST)->MISC_ITEM1) + AADD(PAMTS_ARR, PAMTS ) + ENDIF + IF (CUR_MAST)->MISC_QTY2 <> 0 + AADD(PBODY_ARR, ' ' ) //*DBL SPACE MISC ITEMS ON ORDER - PER ELLEN 7-31-97 + AADD(PAMTS_ARR, {}) + PAMTS := { M2,B2,S2, L2, PRT_AMT, PRT_BO, 0, , I2 } + AADD(PBODY_ARR, '^' + (CUR_MAST)->MISC_ITEM2 ) + AADD(PAMTS_ARR, PAMTS ) + ENDIF + IF (CUR_MAST)->MISC_QTY3 <> 0 + AADD(PBODY_ARR, ' ' ) //*DBL SPACE MISC ITEMS ON ORDER - PER ELLEN 7-31-97 + AADD(PAMTS_ARR, {}) + PAMTS := { M3,B3,S3, L3, PRT_AMT, PRT_BO, 0, , I3 } + AADD(PBODY_ARR, '^' + (CUR_MAST)->MISC_ITEM3 ) + AADD(PAMTS_ARR, PAMTS ) + ENDIF + ENDIF +ENDIF +IF TOTPRNT <> 0 .AND. MHOME_LOC_CODE <> 'XXXX' ; // darlene 8-22-96 + .AND. MHOME_LOC_CODE <> 'KC' // EDNA on 3-28-96 + IF PRODUCT->(FIELDPOS('ORD_TOTALS')) > 0 //** P3N - 4/7/99 + IF AT('S', PRODUCT->ORD_TOTALS) > 0 .AND. ; //** P3N - 4/7/99 + WHICH_TYPE == 'STORM' //** P3N - 4/7/99 + SUPPRESS_TOT := .T. //** P3N - 4/7/99 + ENDIF //** P3N - 4/7/99 + ENDIF //** P3N - 4/7/99 + IF SUPPRESS_TOT //** P3N - 4/7/99 + ELSEIF INT(TOTPRNT) = TOTPRNT + AADD(PBODY_ARR, '=====' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, STR(TOTPRNT,4) + ' Total' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, '=====' ) + ELSE + AADD(PBODY_ARR, '========' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, STR(TOTPRNT,7,2) + ' Total' ) + AADD(PAMTS_ARR, {}) + AADD(PBODY_ARR, '========' ) + ENDIF + AADD(PAMTS_ARR, {}) +ENDIF +IF EMPTY(CNT_LI_DISC) + LI_DISC_PRNT := .F. +ELSE + LI_DISC_PRNT := .T. +ENDIF +PTAIL_ARR := BLD_TAIL(MORDER_NUM, WHCHORDER, LI_TOTALS, WHICH_TYPE, ; + SUBTYPE, LI_DISC_PRNT, PARTIAL_INVOICE, MISC_ARR, ; + PRT_BO, REPRINT_INVOICE ) +//** PAMTS_ARR := RETVARARR[2] +IF WHCHORDER = 'BACKORD' //** P3N - 9/2/98 +//** PRINT THE TAIL(ORD_MAST->BO_NOTES) INFO FOR BACKORDERS +ELSEIF PRT_AMT +ELSE //DO NOT PRINT AMOUNTS NO PTAIL_ARR - EXEC BLD_TAIL TO UPD GL_ARR + IF (CUR_MAST)->QUOTE_PRIC = 0 //NOT A QUOTED ORDER!! + IF WHCHORDER = 'INV' .OR. WHCHORDER = 'OD' .OR. ; + (WHCHORDER = 'PROD' .AND. WHICH_TYPE = 'CTRL') //** P3N - 12/3/98 + **//** ADDED THE "OD" CHECK 9-30-97 + // ON AN INVOICE / OD / DEL / GOLDEN ROD PRINT + // TOTALS OR NONTX ITEMS - IF PRESENT. + ELSE + PTAIL_ARR := {} + ENDIF + ENDIF +ENDIF +IF EMPTY(PBODY_ARR) + AADD(PBODY_ARR, '^' ) + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + AADD(PAMTS_ARR, NIL) +ENDIF +PRT_GL_INFO := PRNT_ACCT_INFO( WHCHORDER, WHICH_TYPE, SUBTYPE ) +PROCESS_OO(PHEAD_ARR, PBODY_ARR, PTAIL_ARR, PAMTS_ARR, SUBTYPE, ; + PRT_GL_INFO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) + + +RETURN + + + + +**************************************************************** +* Format the line item discount pct and amount +**************************************************************** +//** DISCOUNT MODIFICATIONS - 10-7-97 +FUNCTION PRNT_DISCOUNTS(DISC_ARR , WHCHORDER, SUBTYPE) +LOCAL DISC_PCT, I, DISC_TOTAL, RETARR := {}, RETVAL +LOCAL SP4 := SPACE(07)+'(', SP5 := SPACE(06)+'(' +LOCAL SP6 := SPACE(05)+'(', SP7 := SPACE(04)+'(' +LOCAL SP9 := SPACE(02)+'(', SP8 := SPACE(03)+'(' +FOR I := 1 TO LEN(DISC_ARR) + DISC_PCT := DISC_ARR[I,2] + //** RETVAL := SPACE(10) + STR(DISC_PCT, 3,0) + '% ' //** P3N - 09/27/11 + RETVAL := SPACE(08) + STR(DISC_PCT, 5,2) + '% ' //** P3N - 09/27/11 + IF LEN(DISC_ARR) = 1 + RETVAL := RETVAL + 'Total Discount' + SPACE(19) + ELSE + RETVAL := RETVAL + 'Discount for ' + DISC_ARR[I,4] //ENTRY SIZE + ENDIF + RETVAL := PADL(TRIM(RETVAL), 48, ' ') + DISC_TOTAL := DISC_ARR[I,3] + IF DISC_TOTAL < 0 //** P3N - 4/3/98 DISCOUNT CHARGE BACK + RETVAL := RETVAL + STR(DISC_TOTAL * -1, 12, 2) + ELSEIF DISC_TOTAL > 99999.99 + RETVAL := RETVAL + SP9 + STR(DISC_TOTAL, 9,2) + ')' + ELSEIF DISC_TOTAL > 9999.99 + RETVAL := RETVAL + SP8 + STR(DISC_TOTAL, 8,2) + ')' + ELSEIF DISC_TOTAL > 999.99 + RETVAL := RETVAL + SP7 + STR(DISC_TOTAL, 7,2) + ')' + ELSEIF DISC_TOTAL > 99.99 + RETVAL := RETVAL + SP6 + STR(DISC_TOTAL, 6,2) + ')' + ELSEIF DISC_TOTAL > 9.99 + RETVAL := RETVAL + SP5 + STR(DISC_TOTAL, 5,2) + ')' + ELSE + RETVAL := RETVAL + SP4 + STR(DISC_TOTAL, 4,2) + ')' + ENDIF + IF MHOME_LOC_CODE = 'KC' + RETVAL := SPACE(22) + RETVAL + ELSEIF MHOME_LOC_CODE = 'IOLA' + RETVAL := SPACE(19) + RETVAL + ELSEIF MHOME_LOC_CODE = 'LINDS' + RETVAL := SPACE(21) + RETVAL + ELSEIF MHOME_LOC_CODE = 'PAWNEE' + RETVAL := SPACE(19) + RETVAL + ENDIF + AADD(RETARR, RETVAL) +NEXT +IF DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) + // IF AMOUNTS TO PRINT; RETURN THE DISCOUNT ARRAY! +ELSE + RETARR := {} +ENDIF +RETURN RETARR +**************************************************************** +**************************************************************** +**************************************************************** +FUNCTION IS_COD( TERMCODE ) +IF ASCAN( MCOD_ARR, { |X| ALLTRIM( X ) == ALLTRIM( TERMCODE ) } ) > 0 + RETURN .T. +ELSE + RETURN .F. +ENDIF + +**************************************************************** +* FIND IF ANY ELEMENTS FOR LOCATION TO PRINT +**************************************************************** +FUNCTION SCAN_PRNARR(PRN_ARR, WHCH_LOCATION) +LOCAL ELEM := ASCAN (PRN_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(WHCH_LOCATION) } ) +IF ELEM > 0 + RETURN .T. +ELSE + RETURN .F. +ENDIF + +**************************************************************** +* READ THE LINE FILE( ORD_LINES/ADDL_LINES) AND PUT ALL APPLICABLE +* DATA INTO AN ARRAY FOR LATER USE AND PRINTING +**************************************************************** + +FUNCTION GET_ORD_DATA( MORDER_NUM, SELFILE, PARTIAL_INVOICE, REPRINT_INVOICE ) +LOCAL DATA_ARR := {}, DISC_ARR, ITEM_LINE, MLOC_CODE, PRNT_ARR, DISC_PCT +LOCAL PRNT_DESARR, PRNT_DESC, PROD_MEMO, RAN_SLID := .F., MGL_LINE_DESC := '' +LOCAL ITEM_CAT_CODE, CALC_VAR, AMTVAR, GLASS_COPY, ADDL_MODE +LOCAL PAR_CAT_CODE, SCRNSIZE,I, WHERE_FROM, PROD_CAT_CODE, EQL_PRNT +LOCAL SV_SEL := SELECT(), MLINE, MLOC_FILE, SEEKKEY, OPTFILE +LOCAL FULL_HT, FULL_WD, HALF_HT, HALF_WD, FULL_ITEM, HALF_ITEM +LOCAL PROD_LINE, GLASS_LINE, EXP_LINE, PO_LINE, SASH_LINE, SCREEN_LINE +LOCAL FACT, HS_PRNT, PRNT_EXP, GLASS_PRNT, STORM_PRNT, FSARR := {} +LOCAL OR_TOP := 0, OR_BOT := 0, OR_ARR := {}, OR_VAL, OR_DEC := 0 +LOCAL OR_SCR := 0, EX_DESC:= '', DEFAULT_ORIEL := .F., BALANCE_SIZE +LOCAL OR_DESC:= '', ODD_ORIEL, ELEM, OR_GLASS := 0, O_GLASS_DESC := '' +LOCAL MGL_NUM, MGL_AMT, EXP_REQ, ADDIT, SEEKPROD, SIZE_ARR, MNUM_GLASS +LOCAL MULL_REQ := .F., MULL_TYPE, MULL_ARR, S_REC, NUMMULLS, WKL_AMT := 0 +LOCAL EXP_WK_WIDTH := 0, ADJ_WK_WIDTH := 0, ADJ_WK_HEIGHT := 0 +LOCAL DEL_CHG := 0, WORKVAR, IS_ALWAYS_SLID := .F., STDADJ := 0 +LOCAL XFACTOR := 0, _DISC_INFO, THIS_DISC, FLANKSCR := {.F., ''} +LOCAL GB_CHUNK := '', GLT_WD, GLT_HT, DO_GLASS_PRNT, GLB_WD, GLB_HT +LOCAL GLT_QTY, GLB_QTY, WK_QTY, OR_REASON, PR_CUSTID, MLINE_DESC +LOCAL BAL_INFO, TOTWIND, CUT_SPEC_ARR, WORKSPECS, RETVAL := {} +LOCAL G_ARR := {}, MCODE, MLINE_NUM, MNUM_SCREEN, PAR_LOC_CODE +LOCAL MWORK_DESC := '', GL311AMT, FRENCHDOOR, ADJ_HT, GETFLANK +LOCAL DO_SCRNS_ONLY := .F., BYPASS_SCREEN_PAR := .F., WKSPRICE := 0 +LOCAL MPWHERE := 'U' //DEFAULT Line Notes to print UNDER the line item! +LOCAL SHP_QTY := 0, INV_QTY := 0, QTYARR := {}, BO_ITEM := '' +LOCAL CK_BKO_SCRNS := .F., SCRNINFO := {} //** P3N - 6/30/98 +LOCAL FLNKSPECS := {}, PARORD, PARLINE //** P3N - 7/21/99 HAPPY BDAY DANIEL +STATIC PARGARR := {}, PARPROD, PARELM //** P3N - 7/21/99 HAPPY BDAY DANIEL +IF SELFILE == CUR_OL + WHERE_FROM := 'OL' + ADDL_MODE := .F. + OPTFILE := CUR_OO +ELSEIF SELFILE == CUR_XL + WHERE_FROM := 'XL' + ADDL_MODE := .T. + OPTFILE := CUR_XO +ENDIF +FOR I := 1 TO 11 // 11 TYPES OF OUTPUT FORMS + AADD(DATA_ARR, {}) // 1-Production +NEXT // 2-frame + // 3-sash + // 4-glass + // 5-screen + // 6-storms + // 7-invoice (customer) + // 8-expander + // 9-control desk + //10-SCREENS(when NOT at mfg. loc) + //11-storms (when NOT at mfg. loc) +// FILL ARRAY WITH 14-ELEMENTS CONTAINING +// 1. LOC CODE MLOC_CODE +// 2. DESCRIPTION PRNT_DESC +// 3. ITEM LINE PRINT VALUE - NO $ AMOUNTS ITEM_LINE +// 4. SALE PRICE +// 5. DISCOUNT PCT/AMOUNT ARRAY +// 6. MEMO NOTES PROD_MEMO +// 7. QUANTITY +// 8. WHERE DID ALL THE INFO COME FROM (IE: "OL" OR "XL") +// 9. LINE_NUM +//10. PROD_CODE +//11. SHP_QTY // ORDER SHIP QTY +//12. EXTRA WINDOWS +//13. cut spec array +//14. line_desc FOR USE ON GLASS / SCREEN COPIES at kansas city +//15. flag indicating print SCREEN ONLY regardless of the MFG Location +//16. flag indicating print notes above size prod_line(item_line) +// Print-'U ' = UNDER LINE, 'A' = ABOVE LINE, 'B' = Beside the LINE +//17. INV_QTY // ORDER INVOICE QTY +// +SELECT (SELFILE) +SEEK MORDER_NUM +DO WHILE ORDER_NUM = MORDER_NUM .AND. !EOF() + IF ADDL_MODE + // POINT TO PARENT ORDER LINE RECORD + (CUR_OL)->(DBSEEK( (SELFILE)->ORDER_NUM + STR((SELFILE)->LINE_NUM,3) ) ) + PAR_LOC_CODE := (CUR_OL)->LOC_CODE + ELSE + PAR_LOC_CODE := NIL + IF EMPTY(PRT_NOTES) + MPWHERE := 'U' // DEFAULT - print the notes under the line item + ELSE + MPWHERE := PRT_NOTES // Print the Line Item notes where ????? + // "A" print ABOVE line item + // "B" print BESIDE line item + // "U" print UNDER line item + ENDIF + ENDIF + MLINE := STR(LINE_NUM,3) + MLINE := TRIM(MLINE) + // NUMBER OF XTRA WINDOWS MULLED + IF ADDL_MODE + XFACTOR := 0 + ELSE + XFACTOR := CK_XTRAWIND( SELFILE, OPTFILE, ADDL_MODE ) + QTYARR := GET_OSTQTY(SELFILE, , PARTIAL_INVOICE, REPRINT_INVOICE) //** P3N - 5/1/98 + IF EMPTY(QTYARR) //** P3N - 12/3/98 + SHP_QTY := 0 //** P3N - 12/3/98 + INV_QTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + SHP_QTY := QTYARR[1] //** P3N - 12/3/98 + INV_QTY := QTYARR[2] //** P3N - 12/3/98 + ENDIF //** P3N - 12/3/98 + ENDIF + IF !EMPTY(ALT_SPRICE) // WAS ALTERNATE PRICE USED? + AMTVAR := ALT_SPRICE + WKSPRICE := (SELFILE)->ALT_SPRICE //** P3N -08/17/11 + ELSE + WKSPRICE := (SELFILE)->SALE_PRICE //** P3N -08/17/11 + AMTVAR := SALE_PRICE + IF !ADDL_MODE // GET ANY AMTS DUE FOR NON STD ADDL ITEMS + SELECT (CUR_XL) + DONSETORD(3) + SEEK (SELFILE)->ORDER_NUM + STR((SELFILE)->LINE_NUM,3) + IF FOUND() +//** P3N - 11/24/98 ADDRESS ADDL LINE PRICING FOR MULTI QTY PRODS +//** AMTVAR := AMTVAR + SALE_PRICE + AMTVAR := AMTVAR + ( SALE_PRICE * XFACTOR ) + ENDIF + DONSETORD(1) + SELECT (CUR_OL) + ENDIF + ENDIF + + //** USE THE QUOTED PRICE FOR DEL CHARG CALCS BELOW + IF EMPTY((CUR_MAST)->QUOTE_PRIC) //** P3N - 08/17/11 + //** NO QUOTED PRICE - CONTINUE W/LINE ITEM AMT IN WKSPRICE + ELSE //** P3N - 08/17/11 + WKSPRICE := (CUR_MAST)->QUOTE_PRIC //** P3N - 08/17/11 + ENDIF + + _DISC_INFO := ITEMDISC(PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) + // P3N - PER ELLEN - 6/3/98 +**IF EMPTY( (SELFILE)->ALT_SPRICE ) // DO NOT APPLY A DISCOUNT ON ALT PRICE! + DISC_PCT := (SELFILE)->DISCOUNT //LINE ITEM DISCOUNT PCT - USER ENTERED + IF EMPTY(DISC_PCT) + DISC_PCT := (SELFILE)->SYS_DISC //LINE ITEM DISCOUNT PCT - SYSTEM GENERATED + ENDIF +**ELSE +** DISC_PCT := 0 +** _DISC_INFO[2] := 0 +**ENDIF + DISC_ARR := {DISC_PCT, ; //LINE ITEM DISCOUNT PCT + _DISC_INFO[2], ; //LINE ITEM DISCOUNT AMT + (SELFILE)->ENTRY_SIZE, ; //ENTRY SIZE OF DISCOUNT ITEM + (SELFILE)->HOW_MEAS } //HOW MEASURE + SELECT PRODUCT + SEEK (SELFILE)->PROD_CODE + MGL_NUM := GL_NUM + MLOC_CODE := (SELFILE)->LOC_CODE + CUST_MAST->(DBSEEK((CUR_MAST)->CUST_ID )) + IF !EMPTY(CUST_MAST->GL_CODE) + MGL_NUM := ALLTRIM(MGL_NUM)+CUST_MAST->GL_CODE //** P3N - 02/01/07 ABW GL FOR INTER COMPANY + //**MGL_NUM := SUBS(MGL_NUM,1,2) + TRIM(SUBS(MGL_NUM,4)) + ' '+ CUST_MAST->GL_CODE + ENDIF + ITEM_CAT_CODE = GET_CATCODE( (SELFILE)->PROD_CODE) + PAR_CAT_CODE = GET_CATCODE( (SELFILE)->PAR_PROD) + SELECT (SELFILE) + PRNT_DESC := ALLTRIM((SELFILE)->ITEM_DESC) + IF AT('EXPANDER' , PRNT_DESC) > 0 ; + .AND. AT('NO~EXPANDER' , PRNT_DESC) = 0 ; + .AND. ( ITEM_CAT_CODE = 'STORMS' .OR. ITEM_CAT_CODE = 'STPW' .OR. ITEM_CAT_CODE = 'EXPANDR' ) //** P3N - 9/29/99 +//**.AND. ( ITEM_CAT_CODE = 'STORMS' .OR. ITEM_CAT_CODE = 'STPW' ) //** P3N - 9/29/99 + EXP_REQ := .T. + ELSE + EXP_REQ := .F. + ENDIF + // HEADER LINE FROM OPTIONS SELECTED + IF SELFILE = CUR_XL + (CUR_OL)->(DBSEEK( (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) ) ) + ELSE // IF ORDER LINES, CHECK IF ANY NON-STD OPTION ADDL_LINES +//** P3N - 5/17/99 REDUNDANT OPTION INFORMATION PRINTING WHEN NOT NEEDED +//** COMMENTED OUT PER SCOTT IN KC +//**SELECT (CUR_XL) +//**SEEKKEY = (SELFILE)->ORDER_NUM +//**SEEK SEEKKEY +//**DO WHILE ORDER_NUM == (SELFILE)->ORDER_NUM .AND. !EOF() +//** IF LINE_NUM == (SELFILE)->LINE_NUM .AND. STD_OPTS$'N' +//** PRNT_DESC := PRNT_DESC + CHR(13) + CHR(10) +//** PRNT_DESC := PRNT_DESC + '**~(' + ; +//** ALLTRIM(ITEM_DESC) + ')~**' +//** ENDIF +//** SKIP 1 +//**ENDDO +//**SELECT (SELFILE) + ENDIF + GLASS_COPY := IF( (SELFILE)->GLASSORDER='Y', .T., .F.) + SELECT (SELFILE) + ITEM_LINE := '' + IF ( (SELFILE)->HOW_MEAS = 'NS' .AND. EMPTY((SELFILE)->PAR_PROD)); + .OR. (SELFILE)->HOW_MEAS = 'BW' .OR. ; + (SELFILE)->HOW_MEAS = 'WO' .OR. (SELFILE)->IN_STOCK$'Y' + ITEM_LINE := ITEM_LINE + ' ' + STRTRAN( ALLTRIM( (SELFILE)->ENTRY_SIZE ), ' ','~') + ELSE + ITEM_LINE := ITEM_LINE + SPACE(11) + ENDIF + IF (SELFILE)->(FIELDPOS('GLINE_DESC')) > 0 //** P3N - 6/7/99 + MGL_LINE_DESC := TRIM((SELFILE)->GLINE_DESC) //** P3N - 6/7/99 + ENDIF //** P3N - 6/7/99 + SASH_LINE := ' ' //** P3N - 5/25/00 + IF !EMPTY( (SELFILE)->LINE_DESC ) + MLINE_DESC := ALLTRIM( (SELFILE)->LINE_DESC ) //** P3N - 5/2/00 CHANGED BACK FOR LINE ATTRIB OPTS + IF AT('I', (SELFILE)->LDESC_COPY ) > 0 //** P3N - 5/2/00 SASH COPY DESC + SASH_LINE := MLINE_DESC //** P3N - 5/2/00 + ENDIF //** P3N - 5/2/00 +//**MLINE_DESC := ALLTRIM( (SELFILE)->LINE_DESC )+' '+MGL_LINE_DESC //** P3N - 6/7/99 + ITEM_LINE := ITEM_LINE + ' ' + // 12-4-96 - SAVE LINE_DESC UNTIL LATER PER LINDA AT LINDS ?? + ITEM_LINE := ITEM_LINE + '~' + MLINE_DESC + ' ' + MLINE_DESC := '' + ELSE //** P3N - 6/7/99 + IF EMPTY(ITEM_LINE) //** P3N - 6/9/99 + ITEM_LINE := MGL_LINE_DESC //** P3N - 6/7/99 + ELSE //** P3N - 6/9/99 +//** ITEM_LINE := ITEM_LINE + MGL_LINE_DESC //** P3N - 6/9/99 + ITEM_LINE := ITEM_LINE +'~~'+ MGL_LINE_DESC //** P3N -10/19/99 + ENDIF //** P3N - 6/9/99 + ENDIF + IF EMPTY( (SELFILE)->LINE_NOTES) + PROD_MEMO := NIL + ELSE + PROD_MEMO := (SELFILE)->LINE_NOTES + ENDIF + IF AMTVAR = 0 .AND. (CUR_MAST)->QUOTE_PRIC <> 0 + //** P3N - 7/28/98 - PRINT THE CODING ON QUOTED ORDERS + //**MGL_AMT := (SELFILE)->QUANTITY * (SELFILE)->CALC_PRICE + MGL_AMT := (CUR_MAST)->QUOTE_PRIC +//** P3N - 12/7/98 PARTIAL INVOICE PROCESSING + ELSEIF PARTIAL_INVOICE //** P3N - 12/7/98 + MGL_AMT := SHP_QTY * AMTVAR //** P3N - 12/7/98 + ELSEIF REPRINT_INVOICE //** P3N - 12/7/98 + MGL_AMT := INV_QTY * AMTVAR //** P3N - 12/7/98 + ELSE + MGL_AMT := (SELFILE)->QUANTITY * AMTVAR + ENDIF + // CALC THE SYSTEM DEALER PICKUP DISCOUNT + // FILL THE GL_ARR WITH ALLOCATION INFORMATION + // 09-5-95 - EXCLUDE INTERCOMPANY LINES FROM DELIVERY CHARGE + // 09-5-95 - SHOULD ANY OTHERS BE EXCLUDED? + // 03-31-97 - EXCLUDE KC BUILD TO STOCK ITEMS. + IF MHOME_LOC_CODE = 'IOLA' + IF (CUR_MAST)->PICK_DEL$'D' ; + .AND. !(SELFILE)->PRICE_SHT$'I' ; + .AND. (CUR_MAST)->CUST_ID <> '20187000' //** KC LOCATION + CATEGORY->(DBSEEK( ITEM_CAT_CODE )) + IF EMPTY(CATEGORY->FRT_AMT) //** P3N - 08/08/11 + //** USE THE CATEGORY PCT TO CALC DELIVERY CHARGE ON ORDER SUBTOTAL + //**DEL_CHG := (CATEGORY->FRT_PCT / 100 ) * (SELFILE)->SALE_PRICE + //**WKL_AMT := (SELFILE)->SALE_PRICE / (1+(CATEGORY->FRT_PCT / 100 )) + //**WKL_AMT := (SELFILE)->SALE_PRICE - WKL_AMT //** SINGLE ITEM DEL CHG + WKL_AMT := WKSPRICE / (1+(CATEGORY->FRT_PCT / 100 )) //** P3N - 08/17/11 + WKL_AMT := WKSPRICE - WKL_AMT //** SINGLE ITEM DEL CHG //** P3N - 08/17/11 + DEL_CHG := WKL_AMT * (SELFILE)->QUANTITY + ELSE + DEL_CHG := CATEGORY->FRT_AMT * (XFACTOR+1) * (SELFILE)->QUANTITY + ENDIF + ELSE + DEL_CHG := 0 + ENDIF + ELSEIF MHOME_LOC_CODE = 'KC' + IF (CUR_MAST)->PICK_DEL$'D' ; + .AND. !(SELFILE)->PRICE_SHT$'I' ; + .AND. IS_DELIVERED() //IS THIS ORDER ASSESSED A DELIVERY CHARGE??? + CATEGORY->(DBSEEK( ITEM_CAT_CODE )) + IF EMPTY(CATEGORY->FRT_AMT) //** P3N - 08/08/11 + //** USE THE CATEGORY PCT TO CALC DELIVERY CHARGE ON ORDER SUBTOTAL + //** DEL_CHG := (CATEGORY->FRT_PCT / 100 ) * (SELFILE)->SALE_PRICE + //**WKL_AMT := (SELFILE)->SALE_PRICE / (1+(CATEGORY->FRT_PCT / 100 )) + //**WKL_AMT := (SELFILE)->SALE_PRICE - WKL_AMT //** SINGLE ITEM DEL CHG + WKL_AMT := WKSPRICE / (1+(CATEGORY->FRT_PCT / 100 )) //** P3N - 08/17/11 + WKL_AMT := WKSPRICE - WKL_AMT //** SINGLE ITEM DEL CHG //** P3N - 08/17/11 + DEL_CHG := WKL_AMT * (SELFILE)->QUANTITY + ELSE + DEL_CHG := CATEGORY->FRT_AMT * (XFACTOR+1) * (SELFILE)->QUANTITY + ENDIF + ELSE + DEL_CHG := 0 + ENDIF + ELSEIF (CUR_MAST)->PICK_DEL$'D' ; + .AND. !(SELFILE)->PRICE_SHT$'I' + CATEGORY->(DBSEEK( ITEM_CAT_CODE )) + IF EMPTY(CATEGORY->FRT_AMT) //** P3N - 08/08/11 + //** USE THE CATEGORY PCT TO CALC DELIVERY CHARGE ON ORDER SUBTOTAL + //**DEL_CHG := (CATEGORY->FRT_PCT / 100 ) * (SELFILE)->SALE_PRICE + //**WKL_AMT := (SELFILE)->SALE_PRICE / (1+(CATEGORY->FRT_PCT / 100 )) + //**WKL_AMT := (SELFILE)->SALE_PRICE - WKL_AMT //** SINGLE ITEM DEL CHG + WKL_AMT := WKSPRICE / (1+(CATEGORY->FRT_PCT / 100 )) //** P3N - 08/17/11 + WKL_AMT := WKSPRICE - WKL_AMT //** SINGLE ITEM DEL CHG //** P3N - 08/17/11 + DEL_CHG := WKL_AMT * (SELFILE)->QUANTITY + ELSE + DEL_CHG := CATEGORY->FRT_AMT * (XFACTOR+1) * (SELFILE)->QUANTITY + ENDIF + ELSE + DEL_CHG := 0 + ENDIF + ********************************************************** + * GL 521 IS THE DELIVERY CHARGE - LineItem category calc [$ frt_amt or % frt_pct] + ********************************************************** + + IF ADDL_MODE + // NO DELIVERY CHARGE ON ADDL LINE ITEM (XL) + ELSEIF EMPTY( (CUR_MAST)->FUEL_CHRG ) //** P3N - 08/08/11 + IF DEL_CHG <> 0 .AND. MGL_AMT <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = '521 '} ) + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+ DEL_CHG + ELSE //INCLUDE FOR ALLOC. + AADD(GL_ARR, { '521 ', DEL_CHG, , 'I' } ) + ENDIF + ENDIF + ELSE + DEL_CHG := 0 //** P3N - 08/08/11 + ENDIF + + ********************************************************** + * GL 311 IS THE INSTALLATION ADJ. + * GL 361 IS THE INSTALLATION ADJ (as of 02/01/07) + ********************************************************** + GL311AMT := (SELFILE)->GL311_AMT + (SELFILE)->GL311_ADJ + IF GL311AMT <> 0 .AND. MGL_AMT <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = '361 '} ) //** P3N - 01/30/07 +//**ELEM := ASCAN(GL_ARR, {|X| X[1] = '311 '} ) //** P3N - 01/30/07 + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2]+ GL311AMT + ELSE //INCLUDE FOR ALLOC. + AADD(GL_ARR, { '361 ', GL311AMT, , 'I' } ) //** P3N - 01/30/07 +//** AADD(GL_ARR, { '311 ', GL311AMT, , 'I' } ) //** P3N - 01/30/07 + ENDIF + ENDIF + //* AMOUNT ALREADY ALLOCATED TO THE GL ACCT. FOR THE PRIMARY LINE ITEM! + IF ADDL_MODE + MGL_AMT := 0 + ENDIF + //* AMOUNT ALLOCATED TO THE GL ACCT. FOR THE LINE ITEM + IF MGL_AMT <> 0 + ELEM := ASCAN(GL_ARR, {|X| X[1] = MGL_NUM} ) + // CHECK FOR USER LINE DISCOUNTS OR SYSTEM CALC DISCOUNTS + //** P3N - 11/24/98 - COMMENTED OUT BECAUSE IT IS ALREADY + //** EXECUTED ABOVE +//**_DISC_INFO := ITEMDISC() + THIS_DISC := _DISC_INFO[2] + IF ELEM > 0 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2] + MGL_AMT - THIS_DISC - DEL_CHG - GL311AMT + ELSE // PRODUCT ALLOC. + AADD(GL_ARR, { MGL_NUM + ' ' , MGL_AMT - THIS_DISC - DEL_CHG - GL311AMT , , 'P'} ) + ENDIF + ENDIF + + **** CHECK IF RANCH SLIDER, BECAUSE THE WIDTH/HEIGHT WILL BE REVERSED + **** FOR PRODUCTION PROCESSING + **** IF ALWAYS SLIDER (C900) THEN DON'T REVERSE, BUT HALF SIZE WIDTH + **** MAYBE don't check screens for sliders per darlene 6-23-95?? + RAN_SLID := CK_SLIDER(SELFILE, OPTFILE, ADDL_MODE) + IS_ALWAYS_SLID := ALWAYS_SLIDER(SELFILE, OPTFILE, ADDL_MODE) + + ***** SPECIAL ORIEL PROCESSING HERE + + ODD_ORIEL := .T. + OR_DESC := '' + O_GLASS_DESC := '' + OR_SCR := 0 + OR_ARR := CK_ORIEL(ITEM_CAT_CODE, SELFILE, OPTFILE, ADDL_MODE, RAN_SLID, IS_ALWAYS_SLID ) + OR_TOP := OR_ARR[1] + OR_BOT := OR_ARR[2] + BALANCE_SIZE := OR_ARR[3] + OR_REASON := OR_ARR[4] + OR_SCR := OR_ARR[5] + OR_GLASS := OR_ARR[6] + ODD_ORIEL := OR_ARR[7] + DEFAULT_ORIEL := OR_ARR[8] + STDADJ := 0 //** P3N - 07/05/01 + IF (SELFILE)->HOW_MEAS == 'NS' //** P3N - 07/05/01 + //** STD SIZE ADJ FOR NOM SIZE - PAWNEE RE: DARYL //** P3N - 07/05/01 + STDADJ := OR_ARR[9] //** STD SIZE ADJ - NOM SIZE ONLY + ENDIF //** P3N - 07/05/01 + // OR_REASON RESULTS + // 'BAL ADJ' + // 'NO ORIEL' + // 'ATT CODE' + // 'BAL ADJ' + // 'DEFAULT' +// EMPTY CUTTING SPECS FOR THIS LINE ITEM + IF !ADDL_MODE + CUT_SPEC_ARR := ACLONE(GET_CUT_SPEC( (SELFILE)->PROD_CODE ) ) + CATEGORY->(DBSEEK( ITEM_CAT_CODE ) ) + MCODE := (SELFILE)->PROD_CODE + ELSE + IF ITEM_CAT_CODE = 'EXPANDR' //** P3N - 9/29/99 + CUT_SPEC_ARR := ACLONE(GET_CUT_SPEC( (SELFILE)->PROD_CODE, SELFILE, (SELFILE)->QUANTITY, XFACTOR, G_ARR)) //** P3N - 9/29/99 + ELSE //** P3N - 9/29/99 + CUT_SPEC_ARR := ACLONE(GET_CUT_SPEC( (SELFILE)->PAR_PROD ) ) + ENDIF //** P3N - 9/29/99 + CATEGORY->(DBSEEK( PAR_CAT_CODE ) ) + MCODE := (SELFILE)->PAR_PROD + ENDIF + IF !EMPTY(CUT_SPEC_ARR) .OR. !EMPTY(CATEGORY->HS_RULE) // NEED GET_ARRAY FOR CUTTING SPEC RULE AND HALF SIZE RULE EVALUATION + MLINE_NUM := STR((SELFILE)->LINE_NUM,3) + RETVAL = BUILD_GETARR( MCODE, 1, MORDER_NUM, MLINE_NUM, , .F., ADDL_MODE, PR_CUSTID, .F., SELFILE ) + G_ARR = RETVAL[1] + // EVALUATED CUTTING SPECS FOR THIS LINE ITEM + IF ITEM_CAT_CODE = 'EXPANDR' //** P3N - 9/30/99 + ELSE //** P3N - 9/30/99 + CUT_SPEC_ARR := ACLONE(GET_CUT_SPEC( MCODE, SELFILE, (SELFILE)->QUANTITY, XFACTOR, G_ARR )) + ENDIF //** P3N - 9/30/99 + IF ADDL_MODE //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSE //** P3N - 7/21/99 HAPPY BDAY DANIEL + PARORD := (SELFILE)->ORDER_NUM //** P3N - 7/22/99 + PARPROD := (SELFILE)->PROD_CODE //** P3N - 7/22/99 + PARLINE := STR((SELFILE)->LINE_NUM) //** P3N - 7/22/99 + IF EMPTY(PARGARR) //** P3N - 7/21/99 HAPPY BDAY DANIEL + AADD(PARGARR, {PARORD, PARPROD, PARLINE, ACLONE(G_ARR)}) //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSEIF PARORD == PARGARR[1,1] //** P3N - 7/21/99 HAPPY BDAY DANIEL + IF ASCAN(PARGARR,{|X| X[1] == PARORD .AND. ; + X[2] == PARPROD .AND. ; + X[3] == PARLINE } ) > 0 + ELSE //** P3N - 7/21/99 HAPPY BDAY DANIEL + AADD(PARGARR, {PARORD, PARPROD, PARLINE, ACLONE(G_ARR)}) //** P3N - 7/21/99 HAPPY BDAY DANIEL + ENDIF //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSE //** P3N - 7/21/99 HAPPY BDAY DANIEL + PARGARR := {} //** P3N - 7/21/99 HAPPY BDAY DANIEL + AADD(PARGARR, {PARORD, PARPROD, PARLINE, ACLONE(G_ARR)}) //** P3N - 7/21/99 HAPPY BDAY DANIEL + ENDIF //** P3N - 7/21/99 HAPPY BDAY DANIEL + ENDIF //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSE + PARORD := (SELFILE)->ORDER_NUM //** P3N - 7/22/99 + G_ARR := {} + IF EMPTY(PARGARR) //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSEIF PARORD == PARGARR[1,1] //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSE //** P3N - 7/21/99 HAPPY BDAY DANIEL + PARGARR := {} //** P3N - 7/21/99 HAPPY BDAY DANIEL + ENDIF //** P3N - 7/21/99 HAPPY BDAY DANIEL + ENDIF +// CHECK THE PRINTING OF HALF SIZE INFORMATION +// (IN STOCK ITEMS - NO PRINT, EQUAL LITE MSG IF NORMALLY AN ORIEL.) + WK_WIDTH := (SELFILE)->PRD_WIDTH + WK_HEIGHT := (SELFILE)->PRD_HEIGHT + EQL_PRNT := '' //** P3N - 6/7/99 + HS_PRNT := '' + PROD_LINE := '' + IF (SELFILE)->ORIEL_SIZE$'Y' .AND. ; + OR_TOP = 1 .AND. OR_BOT = 1 + HS_PRNT := CK_HALF_SIZE(ITEM_CAT_CODE, SELFILE, OPTFILE, {0,0}, RAN_SLID, WK_WIDTH, WK_HEIGHT, EXP_REQ, IS_ALWAYS_SLID, G_ARR ) + EQL_PRNT := TRIM(PROD_LINE) + ' ** Equal Lites ** ' + ELSE + HS_PRNT := CK_HALF_SIZE(ITEM_CAT_CODE, SELFILE, OPTFILE, OR_ARR, RAN_SLID, WK_WIDTH, WK_HEIGHT, EXP_REQ, IS_ALWAYS_SLID, G_ARR) + IF OR_TOP <> OR_BOT + HS_PRNT := CK_HALF_SIZE(ITEM_CAT_CODE, SELFILE, OPTFILE, OR_ARR, RAN_SLID, WK_WIDTH, WK_HEIGHT, EXP_REQ, IS_ALWAYS_SLID, G_ARR) + ENDIF + ENDIF + IF (SELFILE)->HOW_MEAS = 'BW' .OR. ; + (SELFILE)->HOW_MEAS = 'WO' .OR. ; + ((SELFILE)->HOW_MEAS = 'NS' .AND. EMPTY((SELFILE)->PAR_PROD)).OR. ; + (SELFILE)->IN_STOCK$'Y' + PROD_LINE := TRIM(ITEM_LINE) + //** P3N 11/27/01 - IOLA PRINT ENTRY SIZE FOR PRODUCTION FRAME FOR CATEGORY TRAP (TRAPEZOID) + IF ALLTRIM( ITEM_CAT_CODE ) == 'TRAP' //** P3N - 11/27/01 + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM((SELFILE)->ENTRY_SIZE) //** P3N - 11/27/01 + PROD_LINE := PROD_LINE + ' ' + ALLTRIM((SELFILE)->LINE_DESC) //** P3N - 11/27/01 + ELSE + //** 6/7/99 - P3N - IOLA HALF SIZE PRINT ON NOMINAL SIZE PRODUCTION FRAME + IF MHOME_LOC_CODE = 'IOLA' + PROD_LINE := TRIM(PROD_LINE) + ' ' + PRNT_SIZE(WK_WIDTH, WK_HEIGHT) + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM(HS_PRNT) + PROD_LINE := TRIM(PROD_LINE) + ' ' + MGL_LINE_DESC //** P3N - 12/13/01 + ENDIF + ENDIF //** P3N - 11/27/01 + ELSE +//** P3N - 11/23/98 ADDRESS EXPANDER WIDTH FOR SLIDERS - IOLA + EXP_WK_WIDTH := (SELFILE)->ACT_WIDTH + IF RAN_SLID +//** P3N - 12/11/98 ADDRESS PAWNEE REQUEST TO PRINT SIZE BEFORE ITEM +//** PROD_LINE := TRIM(ITEM_LINE) + ' ' + PRNT_SIZE(WK_HEIGHT, WK_WIDTH) + PROD_LINE := PRNT_SIZE(WK_HEIGHT, WK_WIDTH) +//** P3N - 5/26/99 ADDRESS 1/2 SIZE PRINT FOR LINE DESC - IOLA + IF !EMPTY(HS_PRNT) .AND. (SELFILE)->IN_STOCK = 'N' + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM(HS_PRNT) + ENDIF + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM(ITEM_LINE) + //** P3N 11/27/01 - IOLA PRINT ENTRY SIZE FOR PRODUCTION FRAME FOR CATEGORY TRAP (TRAPEZOID) + ELSEIF ALLTRIM( ITEM_CAT_CODE ) == 'TRAP' //** P3N - 11/27/01 + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM((SELFILE)->ENTRY_SIZE) //** P3N - 11/27/01 + PROD_LINE := PROD_LINE + ' ' + ALLTRIM((SELFILE)->LINE_DESC) //** P3N - 11/27/01 + ELSE +//** P3N - 12/11/98 ADDRESS PAWNEE REQUEST TO PRINT SIZE BEFORE ITEM +//** PROD_LINE := TRIM(ITEM_LINE) + ' ' + PRNT_SIZE(WK_WIDTH, WK_HEIGHT) + PROD_LINE := PRNT_SIZE(WK_WIDTH, WK_HEIGHT) +//** P3N - 5/26/99 ADDRESS 1/2 SIZE PRINT FOR LINE DESC - IOLA + IF !EMPTY(HS_PRNT) .AND. (SELFILE)->IN_STOCK = 'N' + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM(HS_PRNT) + ENDIF + //** P3N - 12/13/01 ADDRESS DARLENE'S PRODUCTION + IF MHOME_LOC_CODE = 'IOLA' + IF AT(ALLTRIM(MGL_LINE_DESC),ALLTRIM(ITEM_LINE)) > 0 //** P3N - 01/25/02 - ADDRESS DARLENE'S FRAME PRINTING + PROD_LINE := TRIM(PROD_LINE)+'~'+ALLTRIM(ITEM_LINE) //** P3N - 01/25/02 + ELSE //** P3N - 01/25/02 + PROD_LINE := TRIM(PROD_LINE)+'~'+MGL_LINE_DESC+ '~' + ALLTRIM(ITEM_LINE) + ENDIF //** P3N - 01/25/02 + ELSE + PROD_LINE := TRIM(PROD_LINE) + ' ' + ALLTRIM(ITEM_LINE) + ENDIF + ENDIF + ENDIF + //* PERRY - 2-11-98 + FRENCHDOOR := CK_FRENCH(SELFILE, OPTFILE, ADDL_MODE) + IF (SELFILE)->IN_STOCK$'N' + IF FRENCHDOOR + //* PERRY - 2-11-98 + // DO NOT PRINT THE (OS) SIZE FOR FRENCH DOORS - + // IT WILL BE ENTERED BY THE USER IN THE OPTIONS, OR LINE MEMO + ELSEIF ALLTRIM(ITEM_CAT_CODE) == 'STD'; // STORM DOORS + .AND. (SELFILE)->HOW_MEAS = 'OS' + PROD_LINE := TRIM(PROD_LINE) + ; + STRTRAN(' (OS=' + ALLTRIM( (SELFILE)->ENTRY_SIZE) + ') ', ' ','~') + ENDIF + ELSE + // ONLY IN_STOCK WINDOWS FIT HERE! + PROD_LINE := TRIM(PROD_LINE) + ' (S)' + ITEM_LINE := TRIM(ITEM_LINE) + ' (S)' + ENDIF + **** CHECK IF ANY MULLS - CENTER VERTICAL WILL CALC BREAKDOWN, AND + **** WILL 2 PIECES GLASS / SASH + **** ANY OTHER 'MULL LOC' WILL HAVE NO SASH/GLASS + IF ITEM_CAT_CODE = 'STPW' .OR. PAR_CAT_CODE = 'STPW' + MULL_ARR := CK_MULLS(SELFILE, OPTFILE) + MULL_REQ := MULL_ARR[1] + MULL_TYPE := MULL_ARR[2] + ENDIF + // PRINT THE ORIEL BANNER + PROD_LINE := PROD_LINE + EQL_PRNT //** P3N - 6/7/99 + IF (SELFILE)->ORIEL_SIZE$'Y' ; + .AND. !(OR_TOP = 1 .AND. OR_BOT = 1) + PROD_LINE := TRIM(PROD_LINE) + ' **~Oriel~** ' + ENDIF + IF BALANCE_SIZE <> NIL +//**BAL_INFO := ' USE~' + ALLTRIM(BALANCE_SIZE) + '"~BALANCE ' +//** P3N - 11/19/99 ADDRESSED BALANCE INFO AT PAWNEE + IF MHOME_LOC_CODE = 'PAWNEE' + BAL_INFO := '~' + ALLTRIM(BALANCE_SIZE) + '"~BAL ' + ELSE + BAL_INFO := ' USE~' + ALLTRIM(BALANCE_SIZE) + '"~BALANCE ' + ENDIF + ELSE + BAL_INFO := '' + ENDIF + PROD_LINE := TRIM(PROD_LINE) + BAL_INFO + IF CK_SPEC_PRICE( (CUR_MAST)->CUST_ID, (SELFILE)->PROD_CODE, (CUR_MAST)->ORDER_DATE, 'CUST_BP' ) + PR_CUSTID := (CUR_MAST)->CUST_ID + ELSE + PR_CUSTID := NIL + ENDIF + // 1. SET UP THE PRODUCTION CONTROL CHUNK + // IF MANUFACTURED IN HOUSE, OTHER "CHUNKS" WILL UTILIZE THIS INFO. + // IF MADE IN LINDSBORG BUT STOCKED IN KC AND ORDERED IN KC, TREAT AS STOCK + IF MLOC_CODE = MHOME_LOC_CODE + ELSEIF IN_STOCK$'N' + PROD_LINE := TRIM(PROD_LINE) + ' (' + (SELFILE)->HOW_MEAS + ')~' ; + + STRTRAN( TRIM( (SELFILE)->ENTRY_SIZE), ' ','~' ) + ENDIF + // IF NOT ADDL MODE PUT INTO DATA_ARR[1] + // IF ADDL_MODE AND MADE HERE, BUT PARENT IS MADE ELSEWHERE + // PUT IT IN DATA_ARR[1] + ADDIT := .F. + IF !ADDL_MODE + IF MLOC_CODE = MHOME_LOC_CODE + ADDIT := .T. + ENDIF + ELSE // ADDL_MODE + IF MLOC_CODE = MHOME_LOC_CODE ; + .AND. PAR_LOC_CODE <> MHOME_LOC_CODE + ADDIT := .T. + ENDIF + // IF IN STOCK ITEM BUT NEED SCREEN, ADD_IT SHOULD BE TRUE FOR SCEEN COPY + IF ITEM_CAT_CODE = 'SCREENS' + //Create a screen copy regardless of MFG. Loc & stock item + IF (MLOC_CODE = MHOME_LOC_CODE .AND. (SELFILE)->IN_STOCK <> 'Y') + ELSE + DO_SCRNS_ONLY:=.T. + ADDIT := .T. + ENDIF + ENDIF + ENDIF + // 1. DATA_ARR[1] IS THE PRODUCTION PART + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'C', SELFILE ) + IF ADDIT + AADD(DATA_ARR[1], {MLOC_CODE, PRNT_DESC, PROD_LINE, ; + AMTVAR, DISC_ARR, PROD_MEMO, QUANTITY ,WHERE_FROM, MLINE, ; + PROD_CODE, SHP_QTY, XFACTOR, WORKSPECS, NIL , ; + DO_SCRNS_ONLY, MPWHERE, INV_QTY }) + ENDIF + // 9. DATA_ARR[9] IS THE PRODUCTION REPRESENTATION OF ALL DELIVERY/INVOICE ITEMS/CONTROL DESK + IF !ADDL_MODE + AADD(DATA_ARR[9], {MLOC_CODE, PRNT_DESC, PROD_LINE, ; + AMTVAR, DISC_ARR, PROD_MEMO, QUANTITY ,WHERE_FROM, MLINE, ; + PROD_CODE, SHP_QTY, XFACTOR, WORKSPECS, NIL, ; + DO_SCRNS_ONLY, MPWHERE, INV_QTY }) + ENDIF + // 7. INV (CUSOMER INVOICE) PRINT LINES + IF WHERE_FROM = 'OL' + SELECT (SELFILE) + ITEMPRNT1 := PRNT_SIZE(DECVAL(WIDTH), DECVAL(HEIGHT)) + ITEMPRNTX := ALLTRIM( (SELFILE)->ENTRY_SIZE) + ITEM_LINE := '' + ITEM_LINE := ITEM_LINE + ' (' + (SELFILE)->HOW_MEAS + ') ' + //** P3N - 3/5/99 REQUESTED BY LAURA @ PAWNEE + IF ITEM_CAT_CODE = 'HYLIT' //** P3N - 3/5/99 + IF (SELFILE)->HOW_MEAS == 'NS' //** P3N - 3/5/99 + ITEM_LINE := ' Model# ' //** P3N - 3/5/99 + ENDIF //** P3N - 3/5/99 + ENDIF //** P3N - 3/5/99 + ITEM_LINE := ITEM_LINE + ITEMPRNTX + IF FRENCHDOOR + // DO NOT PRINT THE OPENING SIZE ON FRENCH DOORS - PERRY 2-11-98 + ITEM_LINE := '' + ENDIF + //** P3N - 6/17/99 ADD LINE ITEM GLASS DESC TO INV/DEL... FOR IOLA + IF AT(MGL_LINE_DESC, ITEM_LINE) = 0 //** P3N - 6/17/99 + ITEM_LINE := ITEM_LINE + ' ' + TRIM(MGL_LINE_DESC) //** P3N - 6/17/99 + ENDIF + IF !EMPTY( (SELFILE)->LINE_DESC ) + ITEM_LINE := ITEM_LINE + '~' + TRIM( (SELFILE)->LINE_DESC) + ' ' + //** P3N - 4/2/98 + //** MOVED TO DENOTE '(S)' REGARDLESS OF THE ACTUAL SIZE! + IF (SELFILE)->IN_STOCK$'Y' // ONLY IN_STOCK WINDOWS FIT HERE! + ITEM_LINE := TRIM(ITEM_LINE) + '~(S)' + ENDIF + ENDIF + ITEMPRNT2 := ALLTRIM(PRNT_SIZE(ACT_WIDTH, ACT_HEIGHT)) + IF ALLTRIM(ITEMPRNT1) == ALLTRIM(ITEMPRNT2) + ELSEIF (SELFILE)->IN_STOCK$'Y' // ONLY IN_STOCK WINDOWS FIT HERE! + //** P3N - 4/9/98 IS '(S)' ALREADY DENOTED FOR STOCK WINDOWS! + IF AT( '(S)', ITEM_LINE) = 0 + //** P3N - 4/9/98 NO - INCLUDE THE '(S)' TO DENOTE STOCK! + ITEM_LINE := TRIM(ITEM_LINE) + '~(S)' + ENDIF + ELSEIF ITEM_CAT_CODE = 'STD' + IF MHOME_LOC_CODE = 'KC' + // DO NOT PRINT DOOR SIZE ON THE ORDER FOR KC - 10-01-97 + ELSE + ITEM_LINE := TRIM(ITEM_LINE) + ' (DOOR~SIZE=~' + ITEMPRNT2 + ')' + ENDIF + ENDIF + ITEM_LINE := ITEM_LINE + BAL_INFO + // PRINT THE ORIEL BANNER + IF (SELFILE)->ORIEL_SIZE$'Y' ; + .AND. !(OR_TOP = 1 .AND. OR_BOT = 1) + WORKVAR := HS_PRNT + IF WORKVAR = NIL + WORKVAR := '' + ENDIF + //** - P3N 2/26/98 REMOVED THE HALF-SIZE PRINTING PER SCOTT - KC + //** - P3N 7/7/98 REINSTATED THE HALF-SIZE PRINTING LINDS/IOLA IC POS + //** - P3N 7/24/98 REMOVED THE HALF-SIZE PRINTING PER SCOTT/ellen - KC + IF MHOME_LOC_CODE = 'KC' + //** - P3N 11/11/98 REINSTATED THE HALF-SIZE PRINTING AT KC FOR + //** - EVERYTHING NOT PRODUCED AT KC + IF AT('**Oriel**', ITEM_LINE) > 0 + ELSE + ITEM_LINE := TRIM(ITEM_LINE) + ' ' + ' **~Oriel~** ' + ENDIF + IF MHOME_LOC_CODE == MLOC_CODE + ELSE + ITEM_LINE := TRIM(ITEM_LINE) + ' ' + WORKVAR + ENDIF + ELSEIF AT('**Oriel**', ITEM_LINE) > 0 + ITEM_LINE := TRIM(ITEM_LINE) + ' ' + WORKVAR + ELSE + ITEM_LINE := TRIM(ITEM_LINE) + ' ' + ' **~Oriel~** ' + WORKVAR + ENDIF + ENDIF + ITEM_LINE := ITEM_LINE + SPACE( 60 - LEN(ITEM_LINE) ) + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'V' , SELFILE ) + AADD(DATA_ARR[7], {MLOC_CODE, PRNT_DESC, ; + ITEM_LINE, AMTVAR, DISC_ARR, PROD_MEMO, ; + QUANTITY, WHERE_FROM, MLINE, PROD_CODE, ; + SHP_QTY, XFACTOR, WORKSPECS, NIL, ; + DO_SCRNS_ONLY, MPWHERE, INV_QTY}) + ENDIF + // THE FOLLOWING "CHUNKS" ONLY APPLY TO IN-HOUSE PRODUCTION ITEMS + // WHICH ARE NOT IN STOCK - EXCEPT for the screens. ALL screens + // will get a SCREEN copy regardless of the MFG. location or whether + // it is a STOCK item. + // THE SIZE AND SPECS ON HERE ARE THE PRODUCTION FRAME SAW SETTINGS + // 2. SET UP THE FRAME COPY CHUNK + IF ADDL_MODE + ELSE + // Get the cutting specs for the screen. + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'N', SELFILE ) + IF EMPTY(WORKSPECS) + //Create ONLY a screen copy when NOT same MFG. Loc & stock item! 7-30-97 + IF (MLOC_CODE = MHOME_LOC_CODE .AND. (SELFILE)->IN_STOCK <> 'Y') + ELSE + DO_SCRNS_ONLY:=.T. + ENDIF + ENDIF + ENDIF + IF (MLOC_CODE = MHOME_LOC_CODE .AND. (SELFILE)->IN_STOCK <> 'Y') .OR. ; + DO_SCRNS_ONLY + DO CASE + CASE ITEM_CAT_CODE = 'SCREENS' + CASE ITEM_CAT_CODE = 'STORMS' + CASE ITEM_CAT_CODE = 'EXPAND' + CASE ITEM_CAT_CODE = 'STPW' + OTHERWISE + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'F', SELFILE ) + IF DO_SCRNS_ONLY + ELSE // BYPASS THE FRAME COPY + AADD(DATA_ARR[2], {MLOC_CODE, PRNT_DESC, PROD_LINE, AMTVAR, ; + DISC_ARR , PROD_MEMO, QUANTITY ,WHERE_FROM, MLINE, ; + PROD_CODE, SHP_QTY, XFACTOR, WORKSPECS, NIL, ; + DO_SCRNS_ONLY, MPWHERE, INV_QTY }) + ENDIF + ENDCASE + // 3. SET UP THE SASH COPY CHUNK + // DON'T WORRY ABOUT RANCH SLIDERS - STORMS ONLY (NO SASH ON STROMS) + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'I', SELFILE ) + IF (PRODUCT->MACH_SASHW = 0 .AND. PRODUCT->MACH_SASHH == 0) ; + .AND. WORKSPECS = NIL + // NO SASH ADJUSTMENT -- NO SASH COPY PRINTED + ELSEIF !MULL_REQ .OR. (MULL_REQ .AND. MULL_TYPE = 'CENTER VERTICAL') + WK_QTY := (SELFILE)->QUANTITY + IF RAN_SLID + WK_HEIGHT := PRODUCT->MACH_SASHW + (SELFILE)->ACT_WIDTH + WK_WIDTH := PRODUCT->MACH_SASHH + (SELFILE)->ACT_HEIGHT + ELSE + WK_WIDTH := PRODUCT->MACH_SASHW + (SELFILE)->ACT_WIDTH + WK_HEIGHT := PRODUCT->MACH_SASHH + (SELFILE)->ACT_HEIGHT + ENDIF + IF MULL_REQ // ONLY CENTER VERTICAL TYPE MULLS GOT THIS FAR + WK_QTY := WK_QTY * 2 + WK_WIDTH := WK_WIDTH - MMULL_SASH + ITEM_LINE := PRNT_SIZE(WK_WIDTH/2, WK_HEIGHT) + ELSE + ITEM_LINE := PRNT_SIZE(WK_WIDTH, WK_HEIGHT) + ENDIF + //** SET SASH LINE DESCR. PRINTING FOR ATTRIBUTES - LINDS + IF EMPTY(SASH_LINE) //** P3N - 5/2/00 + SASH_LINE := ITEM_LINE //** P3N - 5/2/00 + ENDIF //** P3N - 5/2/00 + + IF DO_SCRNS_ONLY + ELSE // BYPASS THE SASH COPY +//**P3N5200 AADD(DATA_ARR[3], {MLOC_CODE, PRNT_DESC, ITEM_LINE, AMTVAR,; + AADD(DATA_ARR[3], {MLOC_CODE, PRNT_DESC, SASH_LINE, AMTVAR, ; + DISC_ARR, PROD_MEMO, (SELFILE)->QUANTITY, WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, WORKSPECS, ; + NIL, DO_SCRNS_ONLY, MPWHERE, INV_QTY}) + ENDIF + ENDIF + // 4. SET UP THE GLASS COPY CHUNK + // NO RANCH SLIDER CONCERNS BECAUSE ONLY APPLICABLE TO STORMS + // HOWEVER, IF ALWAYS A SLIDER, SPECIAL PROCESSING IS REQUIRED + // NOTE THAT THE QUANTITY IS CHANGED TO REFLECT XTRA WINDOWS HERE + // SO WE PRINT THE TOTAL REQUIRED. NO REFERENCE TO TWIN, ETC IN GLASS DESC! + IF MHOME_LOC_CODE = 'KC' + MWORK_DESC := MLINE_DESC + ELSE + MWORK_DESC := ' ' + ENDIF + TOTWIND := XFACTOR + 1 + SELECT CATEGORY + S_REC := RECNO() + IF !EMPTY(PAR_CAT_CODE) + SEEK PAR_CAT_CODE + ELSE + SEEK ITEM_CAT_CODE + ENDIF + MNUM_GLASS := CATEGORY->NUM_GLASS + GOTO S_REC + SELECT (SELFILE) + GLT_WD = NIL + GLT_HT = NIL + GLT_QTY = 0 + GLB_WD = NIL + GLB_HT = NIL + GLB_QTY = 0 + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'G', SELFILE ) + IF (PRODUCT->MACH_GLASW = 0 .AND. PRODUCT->MACH_GLASH == 0 ; + .AND. WORKSPECS = NIL) ; + .OR. ( ALLTRIM(ITEM_CAT_CODE) = 'STORMS' .AND. ; + MHOME_LOC_CODE <> 'IOLA' ) + // NO GLASS ADJUSTMENT -- NO GLASS COPY PRINTED + // STORM WINDOWS DON'T GET A GLASS ADJUSTMENT - BOXES USED IN + // THE STORM COPY. FORCE TO LOGIC BELOW + ELSE + IF ITEM_CAT_CODE = 'STORMS' .AND. MHOME_LOC_CODE = 'IOLA' + DO_GLASS_PRNT := .F. + ELSE + DO_GLASS_PRNT := .T. + ENDIF + WK_QTY := (SELFILE)->QUANTITY * TOTWIND + IF !MULL_REQ .OR. (MULL_REQ .AND. MULL_TYPE = 'CENTER VERTICAL') + MNUM_GLASS := CATEGORY->NUM_GLASS + IF MULL_REQ .AND. MULL_TYPE = 'CENTER VERTICAL' + MNUM_GLASS := MNUM_GLASS * 2 // SINCE A MULL, EXTRA GLASS REQUIRED + ENDIF + IF (GLASS_COPY .AND. CATEGORY->(DBSEEK(ITEM_CAT_CODE)) ; + .AND. MNUM_GLASS > 0) .OR. ; + (ALLTRIM(ITEM_CAT_CODE) == 'STORMS' ; + .OR. ALLTRIM(ITEM_CAT_CODE) == 'STPW' ) + WK_ADJ_WIDTH := PRODUCT->MACH_GLASW + WK_ADJ_HEIGHT := PRODUCT->MACH_GLASH + // WK_WIDTH/WK_HEIGHT REPRESENT ENTIRE "GLASS AREA REQUIRED" + // ALL AREAS ARE 'NON SLIDER SPECIFIC NOW' +//** IF RAN_SLID + IF RAN_SLID .OR. IS_ALWAYS_SLID //** P3N - 2/8/99 + WK_HEIGHT := WK_ADJ_WIDTH + (SELFILE)->ACT_WIDTH + WK_WIDTH := WK_ADJ_HEIGHT + (SELFILE)->ACT_HEIGHT + ELSE + WK_WIDTH := WK_ADJ_WIDTH + (SELFILE)->ACT_WIDTH + WK_HEIGHT := WK_ADJ_HEIGHT + (SELFILE)->ACT_HEIGHT + ENDIF + IF MULL_REQ + WK_WIDTH := WK_WIDTH - MMULL_GLASS + ENDIF + IF (OR_TOP = 0 .AND. OR_BOT = 0) .OR. ; // EQUAL LITE WINDOW + (OR_TOP = 1 .AND. OR_BOT = 1) + // 2 PIECES OF GLASS AT 1/2 SIZE EACH + IF MULL_REQ .OR. IS_ALWAYS_SLID + WK_WIDTH := WK_WIDTH / MNUM_GLASS + ELSE + WK_HEIGHT := WK_HEIGHT / MNUM_GLASS + ENDIF + WK_QTY := WK_QTY * MNUM_GLASS + GLT_QTY := WK_QTY + GLB_QTY := 0 + GLT_WD = WK_WIDTH + GLT_HT = WK_HEIGHT + GLB_WD = WK_WIDTH + GLB_HT = WK_HEIGHT + IF (PRODUCT->MACH_GLASW = 0 .AND. PRODUCT->MACH_GLASH == 0) + GLASS_PRNT = '' + IF EMPTY(BAL_INFO) + // NO BALANCE SIZE INFO - NOT A STD_SASH + // DETERMINE THE GLASS SIZES FOR STD_SASH + ELSE + GLASS_PRNT := PRNT_SIZE(GLT_WD, GLT_HT, ' x ') + ENDIF + ELSE + GLASS_PRNT := PRNT_SIZE(WK_WIDTH, WK_HEIGHT) + ENDIF + IF (SELFILE)->(FIELDPOS('LDESC_COPY')) > 0 //** P3N - 5/4/99 + IF AT('G', (SELFILE)->LDESC_COPY) > 0 //** P3N - 5/4/99 + IF EMPTY(GLASS_PRNT) //** P3N - 5/10/99 + WK_QTY := 0 //** P3N - 5/10/99 + ENDIF //** P3N - 5/10/99 + GLASS_PRNT := GLASS_PRNT +' '+ MGL_LINE_DESC //** P3N - 6/7/99 + ENDIF //** P3N - 5/4/99 + ENDIF //** P3N - 5/4/99 + IF DO_SCRNS_ONLY + ELSE // BYPASS THE GLASS COPY + IF DO_GLASS_PRNT + AADD(DATA_ARR[4], {MLOC_CODE, PRNT_DESC, GLASS_PRNT, ; + AMTVAR, DISC_ARR , PROD_MEMO, ; + WK_QTY ,WHERE_FROM, ; + STR(VAL(MLINE)+.00,7,2), PROD_CODE, ; + SHP_QTY, 0, WORKSPECS, MWORK_DESC, ; + DO_SCRNS_ONLY, MPWHERE, INV_QTY }) + ENDIF + ENDIF + ELSE // ORIEL WINDOW + GLASS_LINE := '' + GLT_QTY := QUANTITY + GLB_QTY := QUANTITY + GLT_WD = WK_WIDTH + GLT_HT = WK_HEIGHT + GLB_WD = WK_WIDTH + GLB_HT = WK_HEIGHT + IF OR_TOP > 0 + // DO TOP GLASS FIRST (OR LEFT GLASS ON SLIDER) + IF OR_GLASS <> 0 // PREDETERMINED SIZE FOR TOP + IF IS_ALWAYS_SLID + GLT_WD = OR_GLASS + GLT_HT = WK_HEIGHT // ADJUSTED ABOVE FOR CUT + ELSE + GLT_WD = WK_WIDTH // ADJUSTED ABOVE FOR CUT + GLT_HT = OR_GLASS + ENDIF + ELSE + IF IS_ALWAYS_SLID + GLT_WD = (SELFILE)->ACT_WIDTH - OR_BOT + ( WK_ADJ_WIDTH / 2 ) + GLT_HT = WK_HEIGHT // ADJUSTED ABOVE FOR CUT + ELSE + GLT_WD = WK_WIDTH // ADJUSTED ABOVE FOR CUT + GLT_HT = (SELFILE)->ACT_HEIGHT - OR_BOT + ( WK_ADJ_HEIGHT / 2 ) + ENDIF + IF EMPTY(BAL_INFO) //** P3N - 03/30/98 + // NO BALANCE SIZE INFO - NOT A STD_SASH + ELSEIF EMPTY(WORKSPECS) + // NO CUTTING SPEC INFO + ELSE // DETERMINE THE GLASS TOP SIZE FOR STD_SASH + IF LEN(WORKSPECS) < 2 .OR. EMPTY(WORKSPECS[1,6]) .OR. EMPTY(WORKSPECS[2,6]) + ERR_BOX(' Order line - ' + STR( (SELFILE)->LINE_NUM, 3) + ; + ' / Model - ' + (SELFILE)->PROD_CODE + ' Contains', ; + ' Invalid or missing GLASS Cutting Specs! ', ' ', ; + ' PRODUCTION GLASS COPY may NOT be accurate!') + ELSE + GLT_WD := EVAL_MATH( WORKSPECS[1,6], G_ARR, '_CUT_SP', ; + WORKSPECS[1,1], SELFILE,'CUT') + ADJ_HT := EVAL_MATH( WORKSPECS[2,6], G_ARR, '_CUT_SP', ; + WORKSPECS[2,1], SELFILE,'CUT') +//** GLT_HT := ADJ_HT - OR_BOT //** P3N - 07/05/01 + GLT_HT := ADJ_HT - OR_BOT - STDADJ //** P3N - 07/05/01 + WORKSPECS[2,7] := GLT_HT + ENDIF + ENDIF + ENDIF + IF (PRODUCT->MACH_GLASW = 0 .AND. PRODUCT->MACH_GLASH == 0) + GLASS_PRNT := '' + IF EMPTY(BAL_INFO) //** P3N - 03/30/98 + // NO BALANCE SIZE INFO - NOT A STD_SASH + // DETERMINE THE GLASS SIZES FOR STD_SASH + IF RAN_SLID //** P3N - 02/01/99 + GLASS_PRNT := PRNT_SIZE(GLT_WD, GLT_HT, ' x ') + ELSEIF IS_ALWAYS_SLID //** P3N - 02/02/99 + GLASS_PRNT := PRNT_SIZE(GLT_WD, GLT_HT, ' x ') + ENDIF + ELSE + GLASS_PRNT := PRNT_SIZE(GLT_WD, GLT_HT, ' x ') + ENDIF + ELSE + GLASS_PRNT := GLASS_LINE + PRNT_SIZE(GLT_WD, GLT_HT) + EX_DESC + ENDIF + IF (SELFILE)->(FIELDPOS('LDESC_COPY')) > 0 //** P3N - 5/4/99 + IF AT('G', (SELFILE)->LDESC_COPY) > 0 //** P3N - 5/4/99 + IF EMPTY(GLASS_PRNT) //** P3N - 5/10/99 + WK_QTY := 0 //** P3N - 5/10/99 + ENDIF //** P3N - 5/10/99 + //** GLASS_PRNT := GLASS_PRNT + MLINE_DESC //** P3N - 5/4/99 + GLASS_PRNT := GLASS_PRNT+' '+ MGL_LINE_DESC //** P3N - 6/7/99 + ENDIF //** P3N - 5/4/99 + ENDIF //** P3N - 5/4/99 + IF DO_SCRNS_ONLY + ELSE // BYPASS THE GLASS COPY + IF DO_GLASS_PRNT + AADD(DATA_ARR[4], {MLOC_CODE, PRNT_DESC, GLASS_PRNT, ; + AMTVAR, DISC_ARR , PROD_MEMO, ; + WK_QTY ,WHERE_FROM, ; + STR(VAL(MLINE)+.00,7,2), PROD_CODE, ; + SHP_QTY, 0, WORKSPECS, MWORK_DESC, ; + DO_SCRNS_ONLY, MPWHERE, INV_QTY}) + ENDIF + ENDIF + // DO BOTTOM PART NEXT. + IF OR_GLASS <> 0 + IF IS_ALWAYS_SLID + GLB_WD = WK_WIDTH - OR_GLASS + GLB_HT = WK_HEIGHT + ELSE + GLB_WD = WK_WIDTH + GLB_HT = WK_HEIGHT - OR_GLASS + ENDIF + ELSE + IF IS_ALWAYS_SLID + GLB_WD = (SELFILE)->ACT_WIDTH - OR_TOP + ( WK_ADJ_WIDTH / 2 ) + GLB_HT = WK_HEIGHT // ADJUSTED ABOVE FOR CUT + ELSE + GLB_WD = WK_WIDTH // ADJUSTED ABOVE FOR CUT + GLB_HT = (SELFILE)->ACT_HEIGHT - OR_TOP + ( WK_ADJ_HEIGHT / 2 ) + ENDIF + ENDIF + IF EMPTY(BAL_INFO) //** P3N - 03/30/98 + // NO BALANCE SIZE INFO - NOT A STD_SASH + ELSEIF EMPTY(WORKSPECS) + // NO CUTTING SPEC INFO + ELSE // DETERMINE THE GLASS BOTT SIZE FOR STD_SASH + IF LEN(WORKSPECS) < 2 .OR. EMPTY(WORKSPECS[1,6]) .OR. EMPTY(WORKSPECS[2,6]) + ELSE + GLB_WD := EVAL_MATH( WORKSPECS[1,6], G_ARR, '_CUT_SP', ; + WORKSPECS[1,1], SELFILE,'CUT') + ADJ_HT := EVAL_MATH( WORKSPECS[2,6], G_ARR, '_CUT_SP', ; + WORKSPECS[2,1], SELFILE,'CUT') + GLB_HT := ADJ_HT - OR_TOP + WORKSPECS[2,7] := GLB_HT + ENDIF + ENDIF + IF (PRODUCT->MACH_GLASW = 0 .AND. PRODUCT->MACH_GLASH == 0) + GLASS_PRNT := '' + IF EMPTY(BAL_INFO) //** P3N - 03/30/98 + // NO BALANCE SIZE INFO - NOT A STD_SASH + ELSE // DETERMINE THE GLASS SIZES FOR STD_SASH + GLASS_PRNT := PRNT_SIZE(GLB_WD, GLB_HT, ' x ') + ENDIF + ELSE + GLASS_PRNT := GLASS_LINE + PRNT_SIZE(GLB_WD, GLB_HT) + EX_DESC + ENDIF + IF (SELFILE)->(FIELDPOS('LDESC_COPY')) > 0 //** P3N - 5/4/99 + IF AT('G', (SELFILE)->LDESC_COPY) > 0 //** P3N - 5/4/99 + IF EMPTY(GLASS_PRNT) //** P3N - 5/10/99 + WK_QTY := 0 //** P3N - 5/10/99 + ENDIF //** P3N - 5/10/99 + //** GLASS_PRNT := GLASS_PRNT + MLINE_DESC //** P3N - 5/4/99 + GLASS_PRNT := GLASS_PRNT+' '+ MGL_LINE_DESC //** P3N - 6/7/99 + ENDIF //** P3N - 5/4/99 + ENDIF //** P3N - 5/4/99 + IF DO_SCRNS_ONLY + ELSE // BYPASS THE GLASS COPY + // DON'T DO SECOND LINE IF ALL SPECS COME FROM CUT_SPEC_ARR + IF DO_GLASS_PRNT .AND. ; + WK_ADJ_WIDTH <> 0 .AND. ; + WK_ADJ_HEIGHT <> 0 + AADD(DATA_ARR[4], {MLOC_CODE, PRNT_DESC, GLASS_PRNT, ; + AMTVAR, DISC_ARR , PROD_MEMO, ; + WK_QTY ,WHERE_FROM, ; + STR(VAL(MLINE)+.00,7,2), PROD_CODE,; + SHP_QTY, 0, WORKSPECS, MWORK_DESC,; + DO_SCRNS_ONLY, MPWHERE, INV_QTY }) + ENDIF + ENDIF + + ELSE // ORIEL BOTTOM IS > 0 AND ORIEL TOP = 0 + // SHOULDN'T EVER GET TO HERE-ADJUSTED IN CK_ORIEL() + //** P3N - 9/29/98 + ERR_BOX(' Order line - ' + STR( (SELFILE)->LINE_NUM, 3) + ; + ' / Model - ' + (SELFILE)->PROD_CODE + ' Contains', ; + ' Invalid ORIEL Measurements - Oriel Top can NOT be 0 !', ' ', ; + ' PRODUCTION BREAKDOWNS may NOT be accurate!') + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF + // 5. PROD SCREEN PRINT LINES + IF ADDL_MODE + ELSE + IF XL_EXISTS('SCREENS') + BYPASS_SCREEN_PAR := .T. + ELSE + BYPASS_SCREEN_PAR := .F. + ENDIF + ENDIF + BO_ITEM := '(' + (SELFILE)->HOW_MEAS + ') ' + BO_ITEM := BO_ITEM + (SELFILE)->ENTRY_SIZE + IF BYPASS_SCREEN_PAR + ELSE + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'N', SELFILE ) + MNUM_SCREEN := CATEGORY->NUM_SCREEN + IF MNUM_SCREEN = 0 + MNUM_SCREEN := 1 + ENDIF + IF ALLTRIM(ITEM_CAT_CODE) == 'SCREENS' ; + .OR. WORKSPECS <> NIL + AADD(DATA_ARR[5], SCREEN_CHUNK( SELFILE, ADDL_MODE, WORKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, DISC_ARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .F., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR) ) + //** P3N - 7/21/99 ARE THERE FLANKERS TO PROCESS FOR BACKORDER + IF ADDL_MODE + PARORD := (SELFILE)->ORDER_NUM //** P3N - 7/22/99 + PARPROD := (SELFILE)->PAR_PROD //** P3N - 7/22/99 + PARLINE := STR((SELFILE)->LINE_NUM) //** P3N - 7/22/99 + PARELM := ASCAN(PARGARR,{|X| X[1] == PARORD .AND. ; + X[2] == PARPROD .AND. ; + X[3] == PARLINE } ) + IF PARELM > 0 + FLNKSPECS := GET_THESE_SPECS( PARGARR[PARELM,4], CUT_SPEC_ARR, 'N', 'ORD_LINES') + GETFLANK := PARGARR[PARELM,4] + ELSE + FLNKSPECS := {} + GETFLANK := {} + ENDIF + FLANKSCR := BKO_FLANKSCR(GETFLANK) + IF FLANKSCR[1] //**FLANKER SCREENS TO CONSIDER ON BACKORDER + FSARR := ACLONE(DISC_ARR) + FSARR[3] := FLANKSCR[2] + //** AADD(DATA_ARR[10], SCREEN_CHUNK( SELFILE, .F., WORKSPECS, ; + AADD(DATA_ARR[10], SCREEN_CHUNK( SELFILE, .F., FLNKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, FSARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .T., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR, FLANKSCR) ) + ENDIF //** P3N - 1/27/99 + ENDIF //** P3N - 7/22/99 + ELSE + SCRNINFO := TOL_SCREENS(SELFILE) //** P3N - 9/16/98 + IF EMPTY(SCRNINFO) //** P3N - 9/16/98 + ELSE //** P3N - 9/16/98 + IF EMPTY(SCRNINFO[1]) //TOL SCREEN QTY //** P3N - 9/16/98 + ELSE //** P3N - 9/16/98 + //** P3N BACKORDER SCREEN COPIES WHEN NO CUTTING SPECS + AADD(DATA_ARR[10], SCREEN_CHUNK( SELFILE, ADDL_MODE, WORKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, DISC_ARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .T., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR) ) + //** P3N - 1/27/99 ARE THERE FLANKERS TO PROCESS FOR BACKORDER + FLANKSCR := BKO_FLANKSCR(G_ARR) + IF FLANKSCR[1] //**FLANKER SCREENS TO CONSIDER ON BACKORDER + FSARR := ACLONE(DISC_ARR) + FSARR[3] := FLANKSCR[2] + AADD(DATA_ARR[10], SCREEN_CHUNK( SELFILE, ADDL_MODE, WORKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, FSARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .T., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR, FLANKSCR) ) + ENDIF //** P3N - 1/27/99 + ENDIF //** P3N - 9/16/98 + ENDIF //** P3N - 9/16/98 + ENDIF + ENDIF + // 6. PROD STORMS PRINT LINES + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'S', SELFILE ) + IF (ALLTRIM(ITEM_CAT_CODE) == 'STORMS' ; + .OR. ALLTRIM(ITEM_CAT_CODE) == 'STPW') ; + .OR. WORKSPECS <> NIL + IF ADDL_MODE .AND. ALLTRIM(ITEM_CAT_CODE) == 'SCREENS' + //** P3N - 3/24/99 + //** DO NOT PRODUCE STORM COPY WHEN ADDL SCREEN PRODUCT + ELSE + WK_QTY := (SELFILE)->QUANTITY + IF (SELFILE)->CLEAR_SS$'Y' .AND. MHOME_LOC_CODE = 'IOLA' + GLASS_PRNT := BEST_BOX(GLT_QTY, GLT_WD, GLT_HT, GLB_QTY, GLB_WD, GLB_HT) + ELSE + GLASS_PRNT := '' + ENDIF + IF ALLTRIM(ITEM_CAT_CODE) == 'STORMS' ; + .OR. ALLTRIM(ITEM_CAT_CODE) == 'STPW' + STORM_PRNT := PROD_LINE + ' ' + GLASS_PRNT + ELSE + STORM_PRNT := '' + ENDIF + IF DO_SCRNS_ONLY + //** P3N - 9/11/98 + //** THIS IS FOR BACKORDER STORMS NOT AT THE MFG. LOC +//** AADD(DATA_ARR[11], {MLOC_CODE, PRNT_DESC, STORM_PRNT, AMTVAR, ; + AADD(DATA_ARR[11], {MLOC_CODE, PRNT_DESC, ITEM_LINE, AMTVAR, ; + DISC_ARR, PROD_MEMO, WK_QTY ,WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, ; + WORKSPECS, NIL, DO_SCRNS_ONLY, MPWHERE, INV_QTY} ) + ELSE + IF !MULL_REQ .OR. (MULL_REQ .AND. MULL_TYPE = 'CENTER VERTICAL') + AADD(DATA_ARR[6], {MLOC_CODE, PRNT_DESC, STORM_PRNT, AMTVAR, ; + DISC_ARR, PROD_MEMO, WK_QTY ,WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, ; + WORKSPECS, NIL, DO_SCRNS_ONLY, MPWHERE, INV_QTY} ) + ELSE + AADD(DATA_ARR[6], {MLOC_CODE, PRNT_DESC, ; + PROD_LINE + ' ** MANUAL BREAKDOWN REQUIRED Due to MULLS **', ; + AMTVAR, DISC_ARR, PROD_MEMO, WK_QTY ,WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, ; + WORKSPECS, NIL, DO_SCRNS_ONLY , MPWHERE, INV_QTY}) + ENDIF + ENDIF + ENDIF + ENDIF + // 8. EXPANDERS REQUIRED SECTION + // ONLY INCLUDE THE ORDER LINE ITEMS (EXTRAS APPEAR IN THE DESCRIPTION) + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'E', SELFILE ) + IF MHOME_LOC_CODE <> 'LINDS' ; + .AND. ( EXP_REQ .OR. WORKSPECS <> NIL ) + // EXPANDER SIZES ARE STORED AS ACTUAL CALLED IN SIZES + WK_QTY := (SELFILE)->QUANTITY + IF ITEM_CAT_CODE = 'EXPANDR' //** P3N - 9/30/99 + //** IF CATEGORY EXPANDER THE SIZE WILL //** P3N - 9/30/99 + //** BE DEFINED IN THE CUTTING SPECS. //** P3N - 9/30/99 + PRNT_EXP := '' //** P3N - 9/30/99 + ELSE //** P3N - 9/30/99 + PRNT_EXP := PRNT_SIZE( EXP_WK_WIDTH, NIL) + ENDIF //** P3N - 9/30/99 + IF DO_SCRNS_ONLY + ELSE // BYPASS THE EXPANDER COPY + AADD(DATA_ARR[8], {MLOC_CODE, PRNT_DESC, PRNT_EXP, AMTVAR, ; + DISC_ARR, PROD_MEMO, WK_QTY ,WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, ; + WORKSPECS, NIL, DO_SCRNS_ONLY, MPWHERE, INV_QTY}) + ENDIF + ENDIF + ELSE //** P3N BACKORDER SCREEN COPIES WHEN MFG. LOC IS NOT THE SAME + BO_ITEM := '(' + (SELFILE)->HOW_MEAS + ') ' + BO_ITEM := BO_ITEM + (SELFILE)->ENTRY_SIZE + CK_BKO_SCRNS := .F. + IF ALLTRIM(ITEM_CAT_CODE) == 'SCREENS' //** P3N 9/15/98 - HAPY BDAY MOM! + IF EMPTY(DATA_ARR[5]) + CK_BKO_SCRNS := .T. + ELSEIF EMPTY( ASCAN(DATA_ARR[5], {|X| X[9] + X[10] == ; + STR((SELFILE)->LINE_NUM, 3) + (SELFILE)->PROD_CODE}) ) + CK_BKO_SCRNS := .T. + ELSE + CK_BKO_SCRNS := .F. + ENDIF + ELSE + SCRNINFO := TOL_SCREENS(SELFILE) //** P3N - 9/16/98 + IF EMPTY(SCRNINFO) //** P3N - 9/16/98 + ELSE //** P3N - 9/16/98 + IF EMPTY(SCRNINFO[1]) //TOL SCREEN QTY //** P3N - 9/16/98 + ELSE //** P3N - 9/16/98 + //** P3N BACKORDER SCREEN COPIES WHEN NO CUTTING SPECS + AADD(DATA_ARR[10], SCREEN_CHUNK( SELFILE, ADDL_MODE, WORKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, DISC_ARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .T., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR) ) + //** P3N - 1/27/99 ARE THERE FLANKERS TO PROCESS FOR BACKORDER + FLANKSCR := BKO_FLANKSCR(G_ARR) + IF FLANKSCR[1] //**FLANKER SCREENS TO CONSIDER ON BACKORDER + FSARR := ACLONE(DISC_ARR) + FSARR[3] := FLANKSCR[2] + AADD(DATA_ARR[10], SCREEN_CHUNK( SELFILE, ADDL_MODE, WORKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, FSARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .T., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR, FLANKSCR) ) + ENDIF //** P3N - 1/27/99 + ENDIF //** P3N - 9/16/98 + ENDIF //** P3N - 9/16/98 + ENDIF //** 9/15/98 - HAPPY BDAY MOM + IF XL_EXISTS('SCREENS') + //** USE THE ADDL_LINES FOR SCREEN BACKORDER STUFF! + ELSEIF CK_BKO_SCRNS +//** WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'N', SELFILE ) + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'B', SELFILE ) + IF ALLTRIM(ITEM_CAT_CODE) == 'SCREENS' .OR. !EMPTY(WORKSPECS) + AADD( DATA_ARR[10], SCREEN_CHUNK(SELFILE, ADDL_MODE, WORKSPECS, ; + MULL_REQ, MULL_TYPE, IS_ALWAYS_SLID, OR_TOP, OR_BOT, ; + OR_SCR, BO_ITEM, BAL_INFO, RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, DISC_ARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + .T., XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, MNUM_GLASS, G_ARR) ) + ENDIF + ENDIF + //** P3N BACKORDER STORM COPIES WHEN MFG. LOC IS NOT THE SAME + // 11. PROD STORMS PRINT LINES FOR BACKORDERS + WORKSPECS := GET_THESE_SPECS( G_ARR, CUT_SPEC_ARR, 'S', SELFILE ) + IF ALLTRIM(ITEM_CAT_CODE) == 'STORMS' ; + .OR. ALLTRIM(ITEM_CAT_CODE) == 'STPW' ; + .OR. WORKSPECS <> NIL + WK_QTY := (SELFILE)->QUANTITY + IF (SELFILE)->CLEAR_SS$'Y' .AND. MHOME_LOC_CODE = 'IOLA' + GLASS_PRNT := BEST_BOX(GLT_QTY, GLT_WD, GLT_HT, GLB_QTY, GLB_WD, GLB_HT) + ELSE + GLASS_PRNT := '' + ENDIF + IF ALLTRIM(ITEM_CAT_CODE) == 'STORMS' ; + .OR. ALLTRIM(ITEM_CAT_CODE) == 'STPW' + STORM_PRNT := PROD_LINE + ' ' + GLASS_PRNT + ELSE + STORM_PRNT := '' + ENDIF + IF !MULL_REQ .OR. (MULL_REQ .AND. MULL_TYPE = 'CENTER VERTICAL') + AADD(DATA_ARR[11], {MLOC_CODE, PRNT_DESC, STORM_PRNT, AMTVAR, ; + DISC_ARR, PROD_MEMO, WK_QTY ,WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, ; + WORKSPECS, NIL, DO_SCRNS_ONLY, MPWHERE, INV_QTY} ) + ELSE + AADD(DATA_ARR[11], {MLOC_CODE, PRNT_DESC, ; + PROD_LINE + ' ** MANUAL BREAKDOWN REQUIRED Due to MULLS **', ; + AMTVAR, DISC_ARR, PROD_MEMO, WK_QTY ,WHERE_FROM, ; + MLINE, PROD_CODE, SHP_QTY, XFACTOR, ; + WORKSPECS, NIL, DO_SCRNS_ONLY , MPWHERE, INV_QTY}) + ENDIF + ENDIF // END STORMS + ENDIF // ENDIF (MLOC_CODE = MHOME_LOC_CODE) + DO_SCRNS_ONLY := .F. //7-30-97 + SELECT (SELFILE) + SKIP 1 +ENDDO +//** (CUR_MAST)->ORD_L_TTL and (CUR_MAST)->QUOTE_PRIC ( QUOTED PRICE ) +//** P3N - 09/26/06 ADD THE FULE SURCHARGE INTO THE GL_ARR AS NECESSARY + +IF ADDL_MODE + // NO FUEL SURCHARGE ON ADDL LINE ITEM (XL) - ONLY ON OL PASS +ELSEIF EMPTY( (CUR_MAST)->FUEL_CHRG ) //** P3N - 09/26/06 + //** No Fuel Surcharge - Continue + //** may be a del_chg (gl-521 amt) from category [$frt_amt or %frt_pct]? +ELSE //** P3N - 09/26/06 + ELEM := ASCAN(GL_ARR, {|X| X[1] = '521 '} ) //** P3N - 09/26/06 + IF ELEM > 0 //** P3N - 09/26/06 + GL_ARR[ELEM, 2] := GL_ARR[ELEM, 2] + (CUR_MAST)->FUEL_CHRG + ELSE //** P3N - 09/26/06 + AADD(GL_ARR, { '521 ', (CUR_MAST)->FUEL_CHRG, , 'I' } ) + ENDIF //** P3N - 09/26/06 +ENDIF //** P3N - 09/26/06 + +SELECT(SV_SEL) +RETURN DATA_ARR +//********************************************************** +// P3N - 1/27/99 ARE THERE FLANKER SCREENS FOR BACKORDER PRINTING??? +//********************************************************** +FUNCTION BKO_FLANKSCR(GETARR) +LOCAL ELM := 0, RETVAL := .F., FLANKERS := '' +ELM := ASCAN(GETARR, {|X| X[1] = 'FLANKERS'} ) +IF EMPTY(ELM) + //** NO FLANKERS +ELSE + FLANKERS := ALLTRIM(GETARR[ELM,4]) + ELM := ASCAN(GETARR, {|X| X[1] = 'FLANK SCRN'}) + IF EMPTY(ELM) + RETVAL := .F. + FLANKERS := '' + ELSEIF ALLTRIM(GETARR[ELM,4]) == 'YES' + RETVAL := .T. + ELSE + RETVAL := .F. + FLANKERS := '' + ENDIF +ENDIF +RETURN {RETVAL, FLANKERS} +//********************************************************** +// P3N - BUILD THE SCREEN CHUNK FOR ORDER / BACKORDER PRINTING +//********************************************************** +FUNCTION SCREEN_CHUNK(SELFILE, ADDL_MODE, WORKSPECS, MULL_REQ, MULL_TYPE, ; + IS_ALWAYS_SLID, OR_TOP, OR_BOT, OR_SCR, BO_ITEM, BAL_INFO, ; + RAN_SLID, MLOC_CODE, PRNT_DESC, ; + AMTVAR, DISC_ARR, PROD_MEMO, WHERE_FROM, MLINE, PROD_CODE, ; + BACKORD, XFACTOR, DO_SCRNS_ONLY, MPWHERE, MWORK_DESC, MNUM_SCREEN, ; + MNUM_GLASS, G_ARR, FLANKSCR) + // NEW LOGIC TO ADD ADJUSTMENT HERE AND NOT IN CGWPRPO. +LOCAL PASSARR := {} , OR_DESC := '' ,SHP_QTY := 0 , SCRINFO := {} +LOCAL WK_WIDTH := (SELFILE)->PRD_WIDTH +LOCAL WK_HEIGHT := (SELFILE)->PRD_HEIGHT +LOCAL WK_ADJ_WIDTH := 0, WK_QTY := 0, INV_QTY := 0 +LOCAL WK_ADJ_HEIGHT := 0, WORKVAR, SCREEN_LINE, ELM3 +LOCAL ITEM_CAT_CODE := GET_CATCODE( (SELFILE)->PROD_CODE) +LOCAL OLQTY := 0 , NUM_IN_SPEC := 0 //**P3N - 9/22/98 HAPPY BDAY CINDY +LOCAL ELM := 0, FLANKERS := '', TOLKEY //** P3N -11/3/98 +LOCAL OSTKEY := (SELFILE)->ORDER_NUM + STR((SELFILE)->LINE_NUM, 3) + 'SCREENS' +LOCAL OSTFSK := (SELFILE)->ORDER_NUM + STR((SELFILE)->LINE_NUM, 3) + 'SCRFLNK' +LOCAL QTYARR := GET_OSTQTY(SELFILE), BKOFLNKSCR := .F. +IF EMPTY(FLANKSCR) //** P3N - 1/27/99 + IF EMPTY(QTYARR) //** P3N - 12/3/98 + SHP_QTY := 0 //** P3N - 12/3/98 + INV_QTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + SHP_QTY := QTYARR[1] //** P3N - 12/3/98 + INV_QTY := QTYARR[2] //** P3N - 12/3/98 + ENDIF //** P3N - 12/3/98 + IF EMPTY(SHP_QTY) .OR. ITEM_CAT_CODE <> 'SCREENS' + QTYARR := GET_OSTQTY(SELFILE, OSTKEY ) + IF EMPTY(QTYARR) //** P3N - 12/3/98 + SHP_QTY := 0 //** P3N - 12/3/98 + INV_QTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + SHP_QTY := QTYARR[1] //** P3N - 12/3/98 + INV_QTY := QTYARR[2] //** P3N - 12/3/98 + ENDIF //** P3N - 12/3/98 + ENDIF +ELSEIF FLANKSCR[1] //** P3N - 1/27/99 + BKOFLNKSCR := .T. //** P3N - 1/27/99 + QTYARR := GET_OSTQTY(SELFILE, OSTFSK ) + IF EMPTY(QTYARR) //** P3N - 1/27/99 + SHP_QTY := 0 //** P3N - 1/27/99 + INV_QTY := 0 //** P3N - 1/27/99 + ELSE //** P3N - 1/27/99 + SHP_QTY := QTYARR[1] //** P3N - 1/27/99 + INV_QTY := QTYARR[2] //** P3N - 1/27/99 + ENDIF //** P3N - 1/27/99 +ENDIF //** P3N - 1/27/99 +IF EMPTY(MNUM_SCREEN) + MNUM_SCREEN := CATEGORY->NUM_SCREEN + IF MNUM_SCREEN = 0 + MNUM_SCREEN := 1 + ENDIF +ENDIF +IF EMPTY(MNUM_GLASS) + MNUM_GLASS := CATEGORY->NUM_GLASS +ENDIF +IF ADDL_MODE + PRODUCT->(DBSEEK( (SELFILE)->PAR_PROD)) + IF PRODUCT->MACH_SCRNW <> 0 .AND. PRODUCT->MACH_SCRNH <> 0 + WK_ADJ_WIDTH := PRODUCT->MACH_SCRNW + WK_ADJ_HEIGHT := PRODUCT->MACH_SCRNH + WK_WIDTH := (CUR_OL)->ACT_WIDTH + WK_HEIGHT := (CUR_OL)->ACT_HEIGHT + WORKSPECS := NIL + ENDIF + PRODUCT->(DBSEEK( (SELFILE)->PROD_CODE )) +ELSE + WK_WIDTH := (SELFILE)->ACT_WIDTH + WK_HEIGHT := (SELFILE)->ACT_HEIGHT +ENDIF +IF ADDL_MODE // GET FROM PARENT STUFF + IF EMPTY(WORKSPECS) + WK_QTY := (SELFILE)->QUANTITY * MNUM_SCREEN + ELSE + WK_QTY := (SELFILE)->QUANTITY // (*)FACTOR FROM WORKSPECS + ENDIF +ELSEIF BACKORD + IF BKOFLNKSCR //** P3N - 1/28/99 + TOLKEY := ORDER_NUM + STR(LINE_NUM) + PROD_CODE + 'SCRFLNK' + IF SELFILE == 'ADDL_LINES' //** P3N - 7/21/99 HAPPY BDAY DANIEL + TOLKEY := ORDER_NUM + STR(LINE_NUM) + PAR_PROD + 'SCRFLNK' + ENDIF //** P3N - 7/21/99 HAPPY BDAY DANIEL + ELSEIF GET_CATCODE(PROD_CODE) == 'SCREENS' //** P3N - 5/20/99 + TOLKEY := ORDER_NUM + STR(LINE_NUM) + SPACE(7) + PROD_CODE + ELSE //** P3N - 1/28/99 + TOLKEY := ORDER_NUM + STR(LINE_NUM) + PROD_CODE + 'SCREENS' + ENDIF //** P3N - 1/28/99 + IF GET_CATCODE(PROD_CODE) == 'SCREENS' //** P3N - 5/20/99 + SCRINFO := TOL_SCREENS( ,TOLKEY, BKOFLNKSCR) //** P3N -11/3/98 + ELSE + SCRINFO := TOL_SCREENS(SELFILE,TOLKEY, BKOFLNKSCR) //** P3N -11/3/98 + ENDIF + IF LEN(SCRINFO) > 2 //** P3N -11/3/98 + BO_ITEM := SCRINFO[3] //** P3N -11/3/98 + ENDIF //** P3N -11/3/98 + WK_QTY := SCRINFO[1] //** P3N - 9/9/98 + PRNT_DESC := SCRINFO[2] //** P3N - 9/9/98 +ELSEIF !ADDL_MODE + IF EMPTY(WORKSPECS) + WK_QTY := (SELFILE)->QUANTITY * MNUM_SCREEN + ELSE + OLQTY := WORKSPECS[1, 3] + NUM_IN_SPEC := WORKSPECS[1, 13] + WK_QTY := OLQTY * NUM_IN_SPEC * ( 1 + XFACTOR ) +//**WK_QTY := (SELFILE)->QUANTITY // (*)FACTOR FROM WORKSPECS + ENDIF +ENDIF +// NORMAL WIDTH WINDOWS / NOT ODD WIDTHS MULLED TOGETHER. +IF !MULL_REQ .OR. (MULL_REQ .AND. MULL_TYPE = 'CENTER VERTICAL') + // STPW ONLY?? + IF MULL_REQ + MNUM_GLASS ++ // SINCE A MULL, EXTRA GLASS REQUIRED (ONLY CENTER VERTICAL ONES GOT TO HERE! + SELECT PRODUCT + IF RAN_SLID // REVERSE HT/WIDTH + WORKVAR := WK_HEIGHT // ADDL_MODE PART ADDED + WK_HEIGHT := WK_WIDTH // 6-05-95 BY DON + WK_WIDTH := WORKVAR + WORKVAR := WK_ADJ_HEIGHT // ADDL_MODE PART ADDED + WK_ADJ_HEIGHT := WK_ADJ_WIDTH // 6-05-95 BY DON + WK_ADJ_WIDTH := WORKVAR + ENDIF + WK_WIDTH := WK_WIDTH + WK_ADJ_WIDTH + WK_HEIGHT := WK_HEIGHT + WK_ADJ_HEIGHT + + WK_QTY := WK_QTY * 2 + WK_WIDTH := WK_WIDTH - MMULL_SASH + SCREEN_LINE := '' + IF ITEM_CAT_CODE = 'SCREENS' .AND. EMPTY(WORKSPECS) + SCREEN_LINE := SET_SCREEN_LINE(MULL_REQ, WK_WIDTH, WK_HEIGHT, ' ', PROD_CODE, PRNT_DESC) + ENDIF + ELM3 := {SCREEN_LINE, BO_ITEM} //** P3N = 6/26/98 + PASSARR := {MLOC_CODE, PRNT_DESC, ELM3 , AMTVAR,; + DISC_ARR, PROD_MEMO, WK_QTY, WHERE_FROM, MLINE, ; + PROD_CODE, SHP_QTY, 0 , WORKSPECS, MWORK_DESC, ; + DO_SCRNS_ONLY , MPWHERE, INV_QTY } + ELSE + // NO WINDOWS MULLED TOGETHER. + // SCREEN HEIGHT WILL BE WK_HEIGHT / NUM_GLASS UNLESS ORIEL + // OR WE ARE USING A STANDARD SIZE SASH ON THE BOTTOM + IF (OR_TOP = 0 .AND. OR_BOT = 0) .OR. ; + (OR_TOP = 1 .AND. OR_BOT = 1) .OR. MNUM_GLASS = 1 + // 2 PIECES OF GLASS AT 1/2 SIZE EACH + IF IS_ALWAYS_SLID + WK_WIDTH := WK_WIDTH / MNUM_GLASS + ELSE + WK_HEIGHT := WK_HEIGHT / MNUM_GLASS + ENDIF + ELSE + // oriel processing here. + IF OR_SCR > 0 // FROM STD SIZE TABLE + IF IS_ALWAYS_SLID + WK_WIDTH := OR_SCR + WK_ADJ_HEIGHT := 0 // is this true?? + ELSE + WK_HEIGHT := OR_SCR + WK_ADJ_HEIGHT := 0 // is this true?? + ENDIF + ELSE + IF OR_TOP > 0 + IF IS_ALWAYS_SLID + WK_WIDTH := WK_WIDTH - OR_TOP // SCREEN GOES ON BOTTOM + ELSE + WK_HEIGHT := WK_HEIGHT - OR_TOP // SCREEN GOES ON BOTTOM + ENDIF + ELSE + IF IS_ALWAYS_SLID + WK_WIDTH := OR_BOT // SCREEN GOES ON BOTTOM + ELSE + WK_HEIGHT := OR_BOT // SCREEN GOES ON BOTTOM + ENDIF + ENDIF + ENDIF + ENDIF + WK_HEIGHT := WK_HEIGHT + WK_ADJ_HEIGHT + WK_WIDTH := WK_WIDTH + WK_ADJ_WIDTH + IF RAN_SLID .AND. !ADDL_MODE // REVERSE HT/WIDTH (IF !ADDL_MODE 6-5-95) + WORKVAR := WK_HEIGHT + WK_HEIGHT := WK_WIDTH + WK_WIDTH := WORKVAR + ENDIF + IF EMPTY(BAL_INFO) //** P3N - 03/30/98 + // NO BALANCE SIZE INFO - NOT A STD_SASH + ELSEIF EMPTY(WORKSPECS) + // NO CUTTING SPEC INFO + ELSE // DETERMINE THE SCREEN SIZE FOR STD_SASH + IF LEN(WORKSPECS) < 2 .OR. EMPTY(WORKSPECS[1,6]) .OR. EMPTY(WORKSPECS[2,6]) + ERR_BOX(' Order line - ' + STR( (SELFILE)->LINE_NUM, 3) + ; + ' / Model - ' + (SELFILE)->PROD_CODE + ' Contains', ; + ' Invalid or missing SCREEN Cutting Specs! ', ' ', ; + ' PRODUCTION SCREEN COPY may NOT be accurate!') + ELSE + ADJ_HT := EVAL_MATH( WORKSPECS[2,6], G_ARR, '_CUT_SP', ; + WORKSPECS[2,1], SELFILE,'CUT') + WK_HEIGHT := ADJ_HT - OR_TOP + WORKSPECS[2,7] := WK_HEIGHT + ENDIF + ENDIF + IF ITEM_CAT_CODE = 'SCREENS' .AND. EMPTY(WORKSPECS) + SCREEN_LINE := SET_SCREEN_LINE(MULL_REQ, WK_WIDTH, WK_HEIGHT, OR_DESC, PROD_CODE, PRNT_DESC) + ELSE + SCREEN_LINE := '' + ENDIF + SELECT (SELFILE) + ELM3 := {SCREEN_LINE, BO_ITEM} //** P3N = 6/26/98 + PASSARR := {MLOC_CODE, PRNT_DESC, ELM3 , AMTVAR,; + DISC_ARR, PROD_MEMO, WK_QTY, WHERE_FROM, MLINE, ; + PROD_CODE, SHP_QTY, 0 , WORKSPECS, MWORK_DESC, ; + DO_SCRNS_ONLY , MPWHERE, INV_QTY } + ENDIF +ENDIF +RETURN PASSARR +****************************************************************** +* GET THE BACKORDER QTY FOR SCREENS - FROM THE TORD_LINES DATABASE +* //** P3N - 9/9/98 +****************************************************************** +FUNCTION TOL_SCREENS(SELFILE, PASSKEY, FLANKERS) +LOCAL SVREC := 1, TOLKEY, FLANKCNT := 0, RETVAL := { 0 , '' }, BO_ITEM +IF EMPTY(FLANKERS) //** P3N - 1/27/99 + FLANKERS := .F. //** P3N - 1/27/99 +ENDIF //** P3N - 1/27/99 +IF SELECT('TORD_LINES') > 0 + SVREC := TORD_LINES->(RECNO()) + TORD_LINES->(DBGOTOP()) + IF (CUR_MAST)->ORDER_NUM == TORD_LINES->ORDER_NUM + ELSE + CLOSE TORD_LINES + BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) + ENDIF +ELSE + BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) +ENDIF +TORD_LINES->(DBGOTOP()) +DO WHILE TORD_LINES->(!EOF()) + IF EMPTY(SELFILE) + TOLKEY := TORD_LINES->ORDER_NUM + STR(TORD_LINES->LINE_NUM, 3) + TOLKEY := TOLKEY + TORD_LINES->PAR_PROD + TORD_LINES->PROD_CODE + IF TOLKEY == PASSKEY + RETVAL := { TORD_LINES->QUANTITY, TORD_LINES->ITEM_DESC } + IF FLANKERS //** P3N - 7/21/99 + IF TORD_LINES->PROD_CODE == 'SCRFLNK' //** P3N - 7/21/99 + BO_ITEM := '(' + TORD_LINES->HOW_MEAS + ') ' + BO_ITEM := BO_ITEM + TORD_LINES->ENTRY_SIZE + RETVAL := { TORD_LINES->QUANTITY, TORD_LINES->ITEM_DESC, BO_ITEM} + ENDIF + ENDIF + EXIT + ENDIF + ELSEIF TORD_LINES->ORDER_NUM == (SELFILE)->ORDER_NUM + IF TORD_LINES->LINE_NUM == (SELFILE)->LINE_NUM + IF TORD_LINES->PAR_PROD == (SELFILE)->PROD_CODE + IF FLANKERS //** P3N - 1/27/99 + IF TORD_LINES->PROD_CODE == 'SCRFLNK' //** P3N - 1/27/99 + BO_ITEM := '(' + TORD_LINES->HOW_MEAS + ') ' + BO_ITEM := BO_ITEM + TORD_LINES->ENTRY_SIZE + RETVAL := { TORD_LINES->QUANTITY, TORD_LINES->ITEM_DESC, BO_ITEM} + EXIT + ENDIF + ELSEIF TORD_LINES->PROD_CODE == 'SCREENS' + RETVAL := { TORD_LINES->QUANTITY, TORD_LINES->ITEM_DESC } + EXIT + ENDIF + ENDIF + ENDIF + ENDIF + TORD_LINES->(DBSKIP(+1) ) +ENDDO +TORD_LINES->(DBGOTO(SVREC) ) +RETURN RETVAL +****************************************************************** +* GET THE ORDER SHIPPING TRANS IN ORDER TO CALC BACKORDERS! +* //** P3N - 5/1/98 +****************************************************************** +FUNCTION GET_OSTQTY(CUR_OL, MISCKEY , PARTIAL_INVOICE, REPRINT_INVOICE) +LOCAL RETVAL := {}, RETSHP := 0, RETINV := 0, SVSEL := SELECT() + +PRIVATE SEEKKEY := (CUR_OL)->ORDER_NUM + STR((CUR_OL)->LINE_NUM, 3) + ; + (CUR_OL)->PROD_CODE + (CUR_OL)->PAR_PROD +PRIVATE SAMELIN := 'ORDER_NUM + STR(LINE_NUM, 3)+PROD_CODE+PAR_PROD == SEEKKEY' + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF EMPTY(PARTIAL_INVOICE) //** P3N - 12/9/98 + PARTIAL_INVOICE := .F. //** P3N - 12/9/98 +ENDIF //** P3N - 12/9/98 +IF EMPTY(REPRINT_INVOICE) //** P3N - 12/9/98 + REPRINT_INVOICE := .F. //** P3N - 12/9/98 +ENDIF //** P3N - 12/9/98 +IF EMPTY(MISCKEY) +ELSE + SEEKKEY := MISCKEY + SAMELIN := 'ORDER_NUM + STR(LINE_NUM, 3)+PROD_CODE == SEEKKEY' +ENDIF +SELECT ORD_SHIP +IF ORD_SHIP->(DBSEEK(SEEKKEY)) + DO WHILE !EOF() .AND. &SAMELIN + IF REPRINT_INVOICE .AND. EMPTY(INV_QTY) //** P3N - 12/9/98 + //** PARTIAL INVOICE SHIPPED TO NEW ORDER + ELSE + RETSHP := RETSHP + ORD_SHIP->SHIP_QTY + ENDIF + RETINV := RETINV + ORD_SHIP->INV_QTY + ORD_SHIP->(DBSKIP(+1)) + ENDDO +ENDIF +SELECT(SVSEL) +RETURN {RETSHP, RETINV} +****************************************************************** +* IS THERE A STOCK SCREEN AND HOW WERE THE MEASUREMENTS ENTERED +****************************************************************** +FUNCTION SET_SCREEN_LINE(MULL_REQ, WK_WIDTH, WK_HEIGHT, OR_DESC, PROD_CODE, PRNT_DESC) +LOCAL SCREEN_LINE := '' +IF (IN_STOCK == 'Y' .AND. HOW_MEAS == 'NS') .AND. ; + (PROD_CODE = '500' .AND. AT('WHITE', PRNT_DESC) > 0) + SCREEN_LINE := ENTRY_SIZE +ELSEIF MULL_REQ + SCREEN_LINE := PRNT_SIZE(WK_WIDTH/2, WK_HEIGHT) +ELSE + SCREEN_LINE := PRNT_SIZE(WK_WIDTH, WK_HEIGHT) + OR_DESC +ENDIF +IF IN_STOCK == 'Y' + SCREEN_LINE := TRIM(SCREEN_LINE) + ' (S)' +ENDIF +RETURN SCREEN_LINE +************************************************************ +* IS THERE AN ADDITIONAL LINE ITEM +* FOR THE TYPE PASSED ??? (IE: 'SCREEN') +************************************************************ +FUNCTION XL_EXISTS(WHAT_TYPE) +LOCAL SV_SEL := SELECT() +LOCAL SV_REC := (SV_SEL)->(RECNO()) //** P3N - 7/20/98 +LOCAL SV_ORD := INDEXORD(), RETVAL := .F. +LOCAL SEEKKEY := (CUR_OL)->ORDER_NUM+(CUR_OL)->PROD_CODE +SELECT (CUR_XL) +DONSETORD(2) // ORDER + PAR_PROD +SEEK SEEKKEY +IF FOUND() + IF GET_CATCODE(PROD_CODE) == WHAT_TYPE + RETVAL := .T. + ELSE + RETVAL := .F. + ENDIF +ENDIF +SET ORDER TO SV_ORD +SELECT(SV_SEL) +(SV_SEL)->(DBGOTO(SV_REC)) //** P3N - 7/20/98 +RETURN RETVAL +************************************************************ +* IS THIS ORDER ASSESSED A DELIVERY CHARGE ??? +************************************************************ +FUNCTION IS_DELIVERED() +LOCAL SEEKKEY := (CUR_MAST)->SHP_METHOD, SV_SEL := SELECT(), RET_VAL := .F. +IF SHIPMETH->(DBSEEK(SEEKKEY)) + IF SHIPMETH->DEL_CHG$'Y' //DELIVERY CHARGE ???? + RET_VAL := .T. + ENDIF +ENDIF +SELECT(SV_SEL) +RETURN RET_VAL +************************************************************ +************************************************************ +************************************************************ +FUNCTION BEST_BOX(GLT_QTY, GLT_WD, GLT_HT, GLB_QTY, GLB_WD, GLB_HT) +LOCAL RETARR := {}, SAVESEL := SELECT(), I +LOCAL PRNTLINE, BESTWASTE:=9999, THISWASTE, THISSIZE +LOCAL BEST_BOX1, BEST_BOX2, ORIEL, WASTE1, RETVAL:='' +STATIC GLASS_ARR +IF GLT_WD = NIL + RETURN RETVAL +ENDIF +// IF ORIEL, 1 BOX FOR EACH PIECE OF GLASS +// OTHERWISE, GIVE BEST 1 AND BEST 2 SITUATION +IF GLB_QTY = 0 + ORIEL := .F. +ELSE + ORIEL := .T. +ENDIF +// LOOK ON 'GLASS_BOX' FILE TO FIND BEST SIZE WITH LEAST WASTE +IF GLASS_ARR = NIL + GLASS_ARR := {} + DBOPEN('GLASS_BOX') + GOTO TOP + DO WHILE !EOF() + AADD(GLASS_ARR, { BOX_NUM, WIDTH, HEIGHT } ) + SKIP 1 + ENDDO + CLOSE GLASS_BOX + SELECT (SAVESEL) +ENDIF +THISSIZE := GLT_WD * GLT_HT +BESTWASTE := 9999 +FOR I := 1 TO LEN(GLASS_ARR) + IF (GLT_WD <= GLASS_ARR[I,2] .AND. GLT_HT <= GLASS_ARR[I,3]) .OR. ; + (GLT_WD <= GLASS_ARR[I,3] .AND. GLT_HT <= GLASS_ARR[I,2]) + THISWASTE := (GLASS_ARR[I,2] * GLASS_ARR[I,3]) - THISSIZE + IF THISWASTE < BESTWASTE + BESTWASTE := THISWASTE + BEST_BOX1 := GLASS_ARR[I,1] + ENDIF + ENDIF +NEXT +WASTE1 := BESTWASTE +IF ORIEL + THISSIZE := GLB_WD * GLB_HT + BESTWASTE := 9999 + FOR I := 1 TO LEN(GLASS_ARR) + IF (GLB_WD <= GLASS_ARR[I,2] .AND. GLB_HT <= GLASS_ARR[I,3]) .OR. ; + (GLB_WD <= GLASS_ARR[I,3] .AND. GLB_HT <= GLASS_ARR[I,2]) + THISWASTE := (GLASS_ARR[I,2] * GLASS_ARR[I,3]) - THISSIZE + IF THISWASTE < BESTWASTE + BESTWASTE := THISWASTE + BEST_BOX2 := GLASS_ARR[I,1] + ENDIF + ENDIF + NEXT +ELSE + THISSIZE := GLB_WD * GLB_HT * 2 + FOR I := 1 TO LEN(GLASS_ARR) + IF ((GLB_WD * 2) <= GLASS_ARR[I,2] .AND. GLB_HT <= GLASS_ARR[I,3]) .OR. ; + ((GLB_WD * 2) <= GLASS_ARR[I,3] .AND. GLB_HT <= GLASS_ARR[I,2]) .OR. ; + (GLB_WD <= GLASS_ARR[I,2] .AND. (GLB_HT * 2) <= GLASS_ARR[I,3]) .OR. ; + (GLB_WD <= GLASS_ARR[I,3] .AND. (GLB_HT * 2) <= GLASS_ARR[I,2]) + THISWASTE := (GLASS_ARR[I,2] * GLASS_ARR[I,3]) - THISSIZE + IF THISWASTE < BESTWASTE + BESTWASTE := THISWASTE + BEST_BOX2 := GLASS_ARR[I,1] + ENDIF + ENDIF + NEXT +ENDIF +IF BEST_BOX1 = NIL + BEST_BOX1 := '??' +ENDIF +IF BEST_BOX2 = NIL + BEST_BOX2 := '??' +ENDIF +IF ORIEL + RETURN 'Top~-~BOX~' + ALLTRIM(BEST_BOX1) + ' Bottom~-~BOX~' + ALLTRIM(BEST_BOX2) +ELSE + SQFT_SAVED := (WASTE1 - BESTWASTE) / 144 + IF BEST_BOX1 <> '??' + RETVAL := ' BOX~' + ALLTRIM(BEST_BOX1) + ENDIF + IF BEST_BOX2 <> '??' + RETVAL := RETVAL + ' -or- 2/1~use~BOX~'; + + ALLTRIM(BEST_BOX2) + ' (~' + ALLTRIM(STR(SQFT_SAVED,7,2)) ; + + '~Saved~)' + ENDIF +ENDIF +RETVAL := ALLTRIM(RETVAL) +RETURN ' ' + RETVAL +************************************************************ +************************************************************ +************************************************************ +FUNCTION CK_HALF_SIZE(ITEM_CAT_CODE, SELFILE, OPTFILE, OR_ARR, RAN_SLID, P_WIDTH, P_HEIGHT, EXP_REQ, IS_ALWAYS_SLID, G_ARR) +LOCAL SEEKKEY, FACT, CALC_VAR, PRNT_VAR := '', ORI_SIZE +LOCAL OR_TOP := OR_ARR[1], OR_BOT := OR_ARR[2], IS_SLIDER := .F. +LOCAL WK_HEIGHT, WK_WIDTH, SAVESEL := SELECT() +// NORMALLY, HALF SIZE IS HEIGHT / 2 UNLESS RANCH SLIDER +// WINDOW ROTATED 90 DEGREES (HT BECOMES WIDTH, WD BECOMES HT) +IF RAN_SLID .OR. IS_ALWAYS_SLID + WK_WIDTH := P_HEIGHT + WK_HEIGHT := P_WIDTH +ELSE + WK_WIDTH := P_WIDTH + WK_HEIGHT := P_HEIGHT +ENDIF +IF CATEGORY->(DBSEEK(ITEM_CAT_CODE)) + IF CATEGORY->PRNT_HS = 'Y' .AND. ; + ( EMPTY(CATEGORY->HS_RULE) .OR. CHK_RULE(CATEGORY->HS_RULE, G_ARR , , SELFILE) ) + // PRINT CALC_VAR DIVIDED BY 2 INCLUDING FRACTIONS + FACT := 2 + ELSE + SELECT (SAVESEL) + RETURN '' //** P3N - 6/17/99 +//**RETURN NIL //** P3N - 6/17/99 + ENDIF + IF OR_TOP <> 0 + IF (SELFILE)->IN_STOCK$'Y' + PRNT_VAR := ' ' + ELSE + // ADDED IOLA CONDITION 6-6-95 - DON + IF EXP_REQ .AND. MHOME_LOC_CODE = 'KC' + TOPNUM := OR_TOP + .5 + ELSE + TOPNUM := OR_TOP + ENDIF + TOPPART := TOPNUM + BOTPART := WK_HEIGHT - TOPPART + PRNT_VAR := ' ( ' + PRNT_SIZE(TOPPART, BOTPART, '/') + ' )' + ENDIF + ELSEIF OR_BOT <> 0 + IF (SELFILE)->IN_STOCK$'Y' + PRNT_VAR := ' ' + ELSE + IF EXP_REQ .AND. MHOME_LOC_CODE = 'KC' + BOTNUM := OR_BOT - .5 + ELSE + BOTNUM := OR_BOT + ENDIF + TOPPART := WK_HEIGHT - BOTNUM + BOTPART := BOTNUM + PRNT_VAR := ' ( ' + PRNT_SIZE(TOPPART, BOTPART, '/') + ' )' + ENDIF + ELSE + CALC_VAR := WK_HEIGHT / FACT + // PRINT THIS AS THE HALF SIZE + PRNT_VAR := ' ( ' + PRNT_SIZE(CALC_VAR, NIL) + ' )' + ENDIF +ENDIF +SELECT (SAVESEL) +RETURN STRTRAN(PRNT_VAR, ' ', '~') +********************************************** +********************************************** +********************************************** +FUNCTION CK_XTRAWIND(SELFILE, OPTFILE, ADDL_MODE) +// IS IT AN EXTRA WINDOW SITUATION? +LOCAL SAVESEL := SELECT(), RETVAL := 0, I +LOCAL SEEKKEY := '' //** P3N - 05/24/02 +SELECT (SELFILE) +FOR I := 1 TO 2 + IF I = 1 + SEEKKEY := BLD_OPT_SEEK(SELFILE, 'XTRA WIND') + ELSE + SEEKKEY := BLD_OPT_SEEK(SELFILE, 'FRENCH STY') + ENDIF + // DIRECT SEEK ON THIS ATTRIBUTE + SELECT (OPTFILE) // EITHER ORDER_OPTS OR ADDL_OPTS + SEEK SEEKKEY + IF FOUND() + IF I = 1 + RETVAL := VAL(USER_RESP) + ELSE + RETVAL := 1 + ENDIF + ENDIF + // IF ADDL_MODE AND CHECK IF XTRA PARENT WINDOWS. IF SO, + // THE ADD-ON PRODUCT MUST GET EXTRAS ALSO + IF ADDL_MODE + SEEKKEY := (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + 'XTRA WIND' + // DIRECT SEEK ON THIS ATTRIBUTE + SELECT (CUR_OO) // PARENT OPTIONS + SEEK SEEKKEY + IF FOUND() + IF I = 1 + RETVAL := VAL(USER_RESP) + ELSE + RETVAL := 1 + ENDIF + ENDIF + ENDIF + IF RETVAL <> 0 + EXIT + ENDIF +NEXT +SELECT (SELFILE) +RETURN RETVAL +********************************************** +********************************************** +********************************************** +FUNCTION ALWAYS_SLIDER(SELFILE, OPTFILE, ADDL_MODE) +// IS IT ALWAYS A RANCH SLIDER? +LOCAL SAVESEL := SELECT(), RAN_SLID := .F. +SELECT (SELFILE) +SEEKKEY := BLD_OPT_SEEK(SELFILE, 'RANCH SLID') +// DIRECT SEEK ON THIS ATTRIBUTE +SELECT (OPTFILE) // EITHER ORDER_OPTS OR ADDL_OPTS +SEEK SEEKKEY +IF FOUND() + IF ALLTRIM(USER_RESP) == 'ALWAYS SLIDER' + RAN_SLID = .T. + ENDIF +ENDIF +// IF ADDL_MODE AND PARENT IS A SLIDER +// THE ADD-ON PRODUCT MUST BE A SLIDER ALSO +IF !RAN_SLID .AND. ADDL_MODE + SEEKKEY := (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + 'RANCH SLID' + // DIRECT SEEK ON THIS ATTRIBUTE + SELECT (CUR_OO) // PARENT OPTIONS + SEEK SEEKKEY + IF FOUND() + IF ALLTRIM(USER_RESP) == 'ALWAYS SLIDER' + RAN_SLID = .T. + ENDIF + ENDIF +ENDIF +SELECT (SELFILE) +RETURN RAN_SLID +********************************************** +********************************************** +********************************************** +FUNCTION CK_SLIDER(SELFILE, OPTFILE, ADDL_MODE) +// IS IT A RANCH SLIDER? +LOCAL SAVESEL := SELECT(), RAN_SLID := .F. +SELECT (SELFILE) +SEEKKEY := BLD_OPT_SEEK(SELFILE, 'RANCH SLID') +// DIRECT SEEK ON THIS ATTRIBUTE +SELECT (OPTFILE) // EITHER ORDER_OPTS OR ADDL_OPTS +SEEK SEEKKEY +IF FOUND() + IF ALLTRIM(USER_RESP) == 'RANCH SLIDER' + RAN_SLID = .T. + ENDIF +ENDIF +// IF ADDL_MODE AND PARENT IS A SLIDER +// THE ADD-ON PRODUCT MUST BE A SLIDER ALSO +IF !RAN_SLID .AND. ADDL_MODE + SEEKKEY := (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + 'RANCH SLID' + // DIRECT SEEK ON THIS ATTRIBUTE + SELECT (CUR_OO) // PARENT OPTIONS + SEEK SEEKKEY + IF FOUND() + IF ALLTRIM(USER_RESP) == 'RANCH SLIDER' + RAN_SLID = .T. + ENDIF + ENDIF +ENDIF +SELECT (SELFILE) +RETURN RAN_SLID +********************************************** +* CHECK FOR A FRENCH DOOR ATTRIBUTE ! +* PERRY - 2-11-98 +********************************************** +FUNCTION CK_FRENCH(SELFILE, OPTFILE, ADDL_MODE) +// IS IT A FRENCH STYLE DOOR KIT? +LOCAL SAVESEL := SELECT(), FRENCHDOOR := .F. +SELECT (SELFILE) +SEEKKEY := BLD_OPT_SEEK(SELFILE, 'FRENCH STY') +// DIRECT SEEK ON THIS ATTRIBUTE +SELECT (OPTFILE) // EITHER ORDER_OPTS OR ADDL_OPTS +SEEK SEEKKEY +IF FOUND() + IF ALLTRIM(USER_RESP) == 'FRENCH STYLE KIT' + FRENCHDOOR := .T. + ENDIF +ENDIF +SELECT (SELFILE) +RETURN FRENCHDOOR +********************************************** +********************************************** +********************************************** +FUNCTION CK_MULLS(SELFILE, OPTFILE) +// IS MULL REQUIRED? +LOCAL SAVESEL := SELECT(), MULL_REQ := .F., MULL_TYPE := NIL +SELECT (SELFILE) +SEEKKEY := BLD_OPT_SEEK(SELFILE, 'MULL LOC ') +// DIRECT SEEK ON THIS ATTRIBUTE +SELECT (OPTFILE) // EITHER ORDER_OPTS OR ADDL_OPTS +SEEK SEEKKEY +IF FOUND() + IF !EMPTY(USER_RESP) .AND. ALLTRIM(USER_RESP) <> 'N/A' + MULL_REQ = .T. + ENDIF + IF ALLTRIM(USER_RESP) == 'CENTER VERTICAL' + MULL_TYPE = ALLTRIM(USER_RESP) + ENDIF +ENDIF +SELECT (SELFILE) +RETURN {MULL_REQ, MULL_TYPE} +****************************************************************** +****************************************************************** +****************************************************************** +FUNCTION BLD_OPT_SEEK(SELFILE, MATT_CODE) +//BUILD THE SEEKKEY FOR OPTIONS FILE +//**LOCAL SEEKKEY //** P3N - 07/19/13 - ABEND LINDA @ LINDS - +LOCAL SEEKKEY := '' //** P3N - 07/19/13 - ABEND LINDA @ LINDS - JUST IN CASE NOT FOUND ASSIGN TO EMPTY +IF SELFILE == CUR_OL + SEEKKEY = (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + MATT_CODE +ELSEIF SELFILE == CUR_XL + SEEKKEY = (SELFILE)->ORDER_NUM + (SELFILE)->PROD_CODE + STR( (SELFILE)->LINE_NUM,3) + MATT_CODE +ENDIF +RETURN SEEKKEY +****************************************************************** +****************************************************************** +****************************************************************** +FUNCTION CK_ORIEL(ITEM_CAT_CODE, SELFILE, OPTFILE, ADDL_MODE, RAN_SLID, IS_ALWAYS_SLID ) +LOCAL SAVESEL := SELECT() +LOCAL SEEKKEY, BALANCE_SIZE, WORKVAL1, WORKVAL2, WORKVAL3 +LOCAL OR_TOP := 0, OR_BOT := 0, OR_ARR := {}, STDBOTTSASH := .F. +LOCAL SCRNSIZE, WORKDIFF, OR_REASON := 'NO ORIEL' +LOCAL OR_SCR := 0 ,OR_GLASS := 0, ODD_ORIEL := .F., DEFAULT_ORIEL := .F. +LOCAL SIZEARR := {}, MWIDTH, MHEIGHT +IF EMPTY(IS_ALWAYS_SLID) //** P3N - 3/24/99 + IS_ALWAYS_SLID := .F. //** P3N - 3/24/99 +ENDIF //** P3N - 3/24/99 +// ORIEL SPECIFICATIONS APPEAR IN PARENT SPECS ONLY +SEEKKEY = (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + 'ORIEL TOP' +SELECT(CUR_OO) +SEEK SEEKKEY +IF FOUND() + OR_TOP := DECVAL(USER_RESP) + OR_REASON := 'ATT CODE' +ENDIF +SEEKKEY = (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + 'ORIEL BOTT' +SELECT(CUR_OO) +SEEK SEEKKEY +IF FOUND() + OR_BOT := DECVAL(USER_RESP) + OR_REASON := 'ATT CODE' +ENDIF +SEEKKEY = (SELFILE)->ORDER_NUM + STR( (SELFILE)->LINE_NUM,3) + 'ORIEL BOTT' +SELECT(CUR_OO) +SEEK SEEKKEY +IF FOUND() + OR_BOT := DECVAL(USER_RESP) + OR_REASON := 'ATT CODE' +ENDIF +IF !ADDL_MODE .AND. PRODUCT->SS_BOTSASH$'Y' + STDBOTTSASH := .T. +ENDIF +SELECT PRODUCT +SAVEREC := RECNO() +IF ADDL_MODE + SEEK (CUR_XL)->PAR_PROD + IF FOUND() .AND. PRODUCT->SS_BOTSASH$'Y' + STDBOTTSASH := .T. + ENDIF +ENDIF +// CHECK THE STDSASH FILE AND FORCE TO OR_BOT +IF OR_TOP = 0 .AND. OR_BOT = 0 + IF STDBOTTSASH + SEEKKEY := PRODUCT->PROD_CODE + SELECT STD_SASH + SEEK SEEKKEY + WORKVAL1 := (SELFILE)->ACT_HEIGHT + DO WHILE PROD_CODE == SEEKKEY .AND. !EOF() + WORKVAL2 := DECVAL( UP_TO_SIZE ) + IF WORKVAL1 <= WORKVAL2 + BALANCE_SIZE := BOTT_SASH + IF BOTT_SIZE = 0 + WORKVAL3 := DECVAL( BOTT_SASH ) + ELSE + WORKVAL3 := BOTT_SIZE * 2 // WILL DIVIDE BY 2 BELOW! + ENDIF + WORKDIFF = ABS( WORKVAL1 - WORKVAL3 ) + IF ADDL_MODE .AND. ALLTRIM(ITEM_CAT_CODE) = 'STORMS' ; + .AND. WORKDIFF <= 1.5 // DON'T ADDJUST ADD ON STORMS WITHIN 1.5 INCHES OF BALANCE SIZE + ELSE + IF (SELFILE)->HOW_MEAS == 'NS' //** P3N - 07/05/01 + //** STD SASH/NOM SIZE ADJUSTMENT //** P3N - 07/05/01 + //** RE: PAWNEE - DARYL //** P3N - 07/05/01 +//** OR_BOT := (WORKVAL3 / 2) + WORKDIFF // UNEQUAL ORIEL LITES + ELSE + WORKDIFF := WORKVAL1 - VAL(BALANCE_SIZE) //** P3N - 06/29/01 +//** OR_BOT := WORKVAL3 / 2 // UNEQUAL ORIEL LITES + ENDIF + OR_BOT := WORKVAL3 / 2 // UNEQUAL ORIEL LITES //P3N-07/05/01 + OR_REASON := 'BAL ADJ' + ENDIF + EXIT + ENDIF + SKIP 1 + ENDDO + ENDIF +ENDIF +IF (!ADDL_MODE .AND. (SELFILE)->ORIEL_SIZE = 'Y') .OR. ; + (ADDL_MODE .AND. (CUR_OL)->ORIEL_SIZE = 'Y') + // CONVERT EVERY THING TO ACTUAL SIZE AND SEEK FOR STD_SIZE TABLE + SELECT STD_SIZES // CHECK IF NORMAL ORIEL SIZE + DONSETORD(2) + IF EMPTY( (SELFILE)->PAR_PROD ) + MWIDTH := DECVAL( (SELFILE)->WIDTH ) + MHEIGHT:= DECVAL( (SELFILE)->HEIGHT) + SIZE_ARR := CONV_SIZE( (SELFILE)->PROD_CODE, MWIDTH,; + MHEIGHT, (SELFILE )->HOW_MEAS, .T.) + SEEK (SELFILE)->PROD_CODE + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) + ELSE + MWIDTH := DECVAL( (CUR_OL)->WIDTH ) + MHEIGHT:= DECVAL( (CUR_OL)->HEIGHT ) + SIZE_ARR := CONV_SIZE( (SELFILE)->PAR_PROD, MWIDTH,; + MHEIGHT, (SELFILE)->HOW_MEAS, .T.) + SEEK (SELFILE)->PAR_PROD + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) + ENDIF + IF FOUND() .AND. ORIEL_SIZE$'X' // NORMALLY AN ORIEL + IF (OR_TOP = 0 .AND. OR_BOT = 0) ; + .OR. OR_REASON = 'BAL ADJ' // NO OVERRIDES - USE STD TABLE DEFAULT + IF ALLTRIM(ITEM_CAT_CODE) == 'STORMS' ; + .AND. (ADDL_MODE .OR. !EMPTY( (SELFILE)->PAR_PROD) ) + OR_TOP := TOP_STORM + ELSE + OR_TOP := ORIEL_TOP + ENDIF + OR_BOT := 0 + OR_REASON := 'DEFAULT' + OR_SCR := ORIEL_SCRN + OR_GLASS := TOP_GLASS + ODD_ORIEL := .F. + DEFAULT_ORIEL := .T. + ELSE + ODD_ORIEL := .T. + ENDIF + ENDIF +ENDIF +SELECT PRODUCT +GOTO SAVEREC +IF OR_TOP <> 0 .AND. OR_BOT = 0 +//** IF !RAN_SLID +//** OR_BOT := (SELFILE)->ACT_HEIGHT - OR_TOP +//** ELSE +//** OR_BOT := (SELFILE)->ACT_WIDTH - OR_TOP +//** ENDIF + IF RAN_SLID //** P3N - 02/01/99 + OR_BOT := (SELFILE)->ACT_WIDTH - OR_TOP //** P3N - 02/01/99 + ELSEIF IS_ALWAYS_SLID //** P3N - 02/01/99 + OR_BOT := (SELFILE)->ACT_WIDTH - OR_TOP //** P3N - 02/01/99 + ELSE //** P3N - 02/01/99 + OR_BOT := (SELFILE)->ACT_HEIGHT - OR_TOP //** P3N - 02/01/99 + ENDIF +ENDIF +IF OR_BOT <> 0 .AND. OR_TOP = 0 +//** IF !RAN_SLID +//** OR_TOP := (SELFILE)->ACT_HEIGHT - OR_BOT +//** ELSE +//** OR_TOP := (SELFILE)->ACT_WIDTH - OR_BOT +//** ENDIF + IF RAN_SLID //** P3N - 02/01/99 + OR_TOP := (SELFILE)->ACT_WIDTH - OR_BOT //** P3N - 02/01/99 + ELSEIF IS_ALWAYS_SLID //** P3N - 02/01/99 + OR_TOP := (SELFILE)->ACT_WIDTH - OR_BOT //** P3N - 02/01/99 + ELSE //** P3N - 02/01/99 + OR_TOP := (SELFILE)->ACT_HEIGHT - OR_BOT //** P3N - 02/01/99 + ENDIF //** P3N - 02/01/99 +ENDIF +SELECT (SAVESEL) +RETURN {OR_TOP, OR_BOT, BALANCE_SIZE, OR_REASON, OR_SCR, OR_GLASS, ODD_ORIEL, DEFAULT_ORIEL, WORKDIFF } +//**RETURN {OR_TOP, OR_BOT, BALANCE_SIZE, OR_REASON, OR_SCR, OR_GLASS, ODD_ORIEL, DEFAULT_ORIEL } + +********************************************************************* +* BUILD THE BODY OF THE ORDER +********************************************************************* + +FUNCTION BLD_BODY(OL_ARR, WHICH_TYPE, WHCH_LOCATION, PBODY_ARR, ; + PAMTS_ARR, WHCHORDER, SUBTYPE, INCL_ALL_LINES,; + DO_CUT_SPECS, PARTIAL_INVOICE, REPRINT_INVOICE) + +LOCAL PRNT_DESC, PRNT_LEN := 42, PRNTOUTVAR, PRNT_VAL +LOCAL PRNT_PRICE, PRNT_QTY, XX, I, II, WAMTS_ARR +LOCAL PAMTS := NIL, MLINE_DESC, X1, X2 +LOCAL LI_TTL := 0, LI_QTY := 0, CUT_SPEC_ARR, VENTPOS := '' +LOCAL BK_ORD := 0, WORKOUT, WORKQTY := 0, OPT := 0, PRTOPT := '' +LOCAL PRT_AMT := .T., WORKVAR, SPEC_CHAR, WORKDESC +LOCAL PRT_BO := .T., RETVARVARR := {}, XFACTOR, WORKARR, OPTARR := {} +LOCAL WORKDESC1, WORKDESC2, RETVARARR := {}, MGL_LINE_DESC := '' +LOCAL MWHEREFROM := OL_ARR[8] //** P3N - 5/26/99 +LOCAL SHIP_QTY := 0, QTYARR := {} //** P3N - 5/1/98 +LOCAL GETARR := {}, WKARR := {} //** P3N - 8/17/98 +LOCAL MPROD_CODE := OL_ARR[10] //** P3N - 8/17/98 +LOCAL MLINE_NUM := OL_ARR[9] //** P3N - 8/17/98 +LOCAL USE_TEMP := .F. //** P3N - 8/17/98 +LOCAL ADDL_MODE := .F. //** P3N - 8/17/98 +LOCAL PPR_CUSTID := NIL //** P3N - 8/17/98 +LOCAL DISP_WAIT := .F. //** P3N - 8/17/98 +LOCAL PRNT_DESARR := {} //** P3N - 8/17/98 +LOCAL INV_QTY := OL_ARR[17] //** P3N - 12/3/98 +LOCAL BKOPROD := MPROD_SUMMARY(MPROD_CODE) //** P3N - 2/2/99 + +STATIC VPARR := {} //** P3N - 11/26/01 +//**STATIC PRIORPROD := '' //** P3N - 11/26/01 +//**STATIC PRIORLINE := '' //** P3N - 11/26/01 + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF EMPTY(REPRINT_INVOICE) //** P3N - 12/3/98 + REPRINT_INVOICE := .F. //** P3N - 12/3/98 +ENDIF //** P3N - 12/3/98 +IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/16/98 + PARTIAL_INVOICE := .F. //** P3N - 11/16/98 +ENDIF //** P3N - 11/16/98 +IF FORMTYPE <> 'PREPRINT' .AND. !DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) + PRNT_LEN := 60 +ENDIF +PRNT_DESC := ALLTRIM(OL_ARR[2]) +IF MHOME_LOC_CODE = 'IOLA' //** P3N - 08/26/02 - FIX DARLENES SPECIAL CUSTOMER IC/PO DESC PRINTING +//**IF WHICH_TYPE == 'PO' //** P3N - 2/22/02 +ELSEIF WHICH_TYPE == 'PO' //** P3N - 08/26/02 + (CUR_OL)->(DBSEEK(MORDER_NUM+MLINE_NUM)) //** P3N - 2/22/02 + (CUR_XL)->(DBSEEK(MORDER_NUM+MPROD_CODE+MLINE_NUM)) //** P3N - 2/22/02 + IF MWHEREFROM = 'XL' //** P3N - 2/22/02 + ADDL_MODE := .T. //** P3N - 2/22/02 + ENDIF //** P3N - 2/22/02 + WKARR := BUILD_GETARR( MPROD_CODE, 1, MORDER_NUM, MLINE_NUM, '', ; + USE_TEMP, ADDL_MODE, PPR_CUSTID, DISP_WAIT, CUR_OL) + GETARR := WKARR[1] //** P3N - 2/22/02 + PRNT_DESARR := BLD_DESC(GETARR, CUR_OL, WHICH_TYPE, MPROD_CODE, SUBTYPE) //** P3N - 02/22/02 + PRNT_DESC := PRNT_DESARR[1] //** P3N - 2/22/02 +ENDIF +IF WHCHORDER == 'BACKORD' //** P3N - 8/17/98 +//** COMMENTED OUT P3N - 5/26/99 +//** IF SUBTYPE == 'BACKORD' //** P3N - 5/26/99 +//** IF EMPTY(PRIORPROD) //** P3N - 11/26/01 +//** PRIORPROD := MPROD_CODE //** P3N - 11/26/01 +//** ENDIF //** P3N - 11/26/01 +//** IF EMPTY(PRIORLINE) //** P3N - 11/26/01 +//** PRIORLINE := MLINE_NUM //** P3N - 11/26/01 +//** ENDIF //** P3N - 11/26/01 + IF MWHEREFROM = 'XL' //** P3N - 11/26/01 + ADDL_MODE := .T. //** P3N - 11/26/01 +//** ELSEIF PRIORPROD == MPROD_CODE .AND. ; //** P3N - 11/26/01 +//** PRIORLINE == MLINE_NUM //** P3N - 11/26/01 + ELSEIF EMPTY(PBODY_ARR) //** P3N - 11/26/01 +//** PRIORPROD := MPROD_CODE //** P3N - 11/26/01 +//** PRIORLINE := MLINE_NUM //** P3N - 11/26/01 + + VPARR := {} //** P3N - 11/26/01 + VENTPOS := '' //** P3N - 11/26/01 + ENDIF //** P3N - 11/26/01 + IF SUBTYPE == 'SCREENS' .AND. MWHEREFROM = 'OL' //** P3N - 5/26/99 + ELSE + (CUR_OL)->(DBSEEK(MORDER_NUM+MLINE_NUM)) //** P3N - 8/17/98 + (CUR_XL)->(DBSEEK(MORDER_NUM+MPROD_CODE+MLINE_NUM)) //**P3N-11/26/01 + WKARR := BUILD_GETARR( MPROD_CODE, 1, MORDER_NUM, MLINE_NUM, '', ; + USE_TEMP, ADDL_MODE, PPR_CUSTID, DISP_WAIT, CUR_OL) + GETARR := WKARR[1] + IF ADDL_MODE //** P3N -11/26/01 + ELSE //** P3N -11/26/01 + ELM := ASCAN(GETARR, {|X| X[1] = 'VENT POS'} ) //** P3N -11/26/01 + IF EMPTY(ELM) //** P3N -11/26/01 +//** VENTPOS := '' //** P3N -11/26/01 + PRTOPT := 'N' //** P3N -11/26/01 + ELSE //** P3N -11/26/01 + OPTARR := GETARR[ELM,OPT_ARR] //** P3N -11/26/01 + OPT := ASCAN(OPTARR, {|X| X[1] = GETARR[ELM,4]} ) //** P3N -11/26/01 + IF EMPTY(OPT) //** P3N -11/26/01 + PRTOPT := 'N' //** P3N -11/26/01 + ELSE //** P3N -11/26/01 + PRTOPT := OPTARR[OPT,OPT_PIND] //** P3N -11/26/01 + ENDIF //** P3N -11/26/01 + IF PRTOPT == 'N' // NEVER PRINT DESCRIPTION + VENTPOS := '' //** P3N -11/26/01 + ELSE //** P3N -11/26/01 + VENTPOS := ALLTRIM(GETARR[ELM,4]) //** P3N -11/26/01 + AADD(VPARR,{TRIM(MPROD_CODE), MLINE_NUM, VENTPOS}) + ENDIF //** P3N -11/26/01 + ENDIF //** P3N -11/26/01 + ENDIF //** P3N -11/26/01 + + PRNT_DESARR := BLD_DESC(GETARR, CUR_OL, WHCHORDER, MPROD_CODE, SUBTYPE) + PRNT_DESC := PRNT_DESARR[1] //** P3N - 8/17/98 + IF EMPTY(VPARR) //** P3N -11/26/01 + ELSEIF ADDL_MODE //** P3N -11/26/01 + VELM := ASCAN(VPARR, {|X| X[1] == BKOPROD .AND. X[2] == MLINE_NUM }) + IF EMPTY(VELM) //** P3N -11/26/01 + VENTPOS := '' //** P3N -11/26/01 + ELSE //** P3N -11/26/01 + VENTPOS := VPARR[VELM,3] //** P3N -11/26/01 + ENDIF //** P3N -11/26/01 + PRNT_DESC := PRNT_DESC + ' - '+STRTRAN(VENTPOS,' ','~') //** P3N -11/26/01 + ENDIF //** P3N -11/26/01 + ENDIF +ENDIF //** P3N - 8/17/98 +IF WHICH_TYPE == 'CTRL' .AND. !(OL_ARR[1] == MHOME_LOC_CODE) ; + .AND. MHOME_LOC_CODE <> 'KC' + PRNT_DESC := ALLTRIM(PRNT_DESC) + ' (' ; + + ALLTRIM(OL_ARR[1]) + '~PO#' + ')' +ENDIF +//** P3N - 5/13/98 +//** PRINT BACKORDERED ITEMS +QTYARR := ORD_QTYS(WHCHORDER, OL_ARR) +PRNT_QTY := QTYARR[1] // LINE ITEM QTY +SHIP_QTY := QTYARR[2] // ITEMS SHIPPED +BK_ORD := QTYARR[3] // ITEMS BACKORDERD +IF EMPTY(BK_ORD) .AND. WHCHORDER == 'BACKORD' + //** ONLY PRINT THE BACKORDERED ITEMS + INCL_ALL_LINES := .F. //** P3N - 9/9/98 +//** P3N - 2/2/99 - SUMMARIZE SCREENS ON BACKORDERS TO MODEL LEVEL +ELSEIF WHICH_TYPE == 'BACKORD' .AND. SUBTYPE == 'SCREENS' //** P3N - 2/02/99 + IF !(BKOPROD == SAVE_BKOPROD) //** P3N - 2/02/99 PRINT BACKORDER + SPEC_CHAR := '^' //** P3N - 2/02/99 SCREENS SUMMARIZED + + IF LEN(PRNT_DESC) <= PRNT_LEN //** P3N - 2/02/99 TO THE MODEL LVL + IF !EMPTY(PBODY_ARR) .AND. !EMPTY(PBODY_ARR[LEN(PBODY_ARR)]) + IF PBODY_ARR[LEN(PBODY_ARR)] == '-----' + // ONLY double space when one line item for a given product + ELSE + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + ENDIF + ENDIF + AADD(PBODY_ARR, SPEC_CHAR + STRTRAN(PRNT_DESC, '~', ' ' ) ) + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + AADD(PAMTS_ARR, NIL) + SAVE_DESC1 := ALLTRIM(PRNT_DESC) + ELSE + MEMOCNT := MLCOUNT(PRNT_DESC, PRNT_LEN, 0, .T.) + PRNTOUTVAR = STRTRAN(PRNT_DESC, CHR(248), CHR(179)) + FOR II = 1 TO MEMOCNT + PRNT_VAL := MEMOTRAN(MEMOLINE(PRNTOUTVAR, PRNT_LEN, II, 0, .T.), '') + IF II = 1 + IF !EMPTY(PBODY_ARR) .AND. !EMPTY(PBODY_ARR[LEN(PBODY_ARR)]) + IF PBODY_ARR[LEN(PBODY_ARR)] == '-----' + // ONLY double space when one line item for a given product + ELSE + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + ENDIF + ENDIF + AADD(PBODY_ARR, SPEC_CHAR + STRTRAN(PRNT_VAL, '~', ' ') ) + AADD(PAMTS_ARR, NIL) + SAVE_DESC1 := ALLTRIM(PRNT_VAL) + ELSE + AADD(PBODY_ARR, STRTRAN(PRNT_VAL, '~', ' ') ) + AADD(PAMTS_ARR, NIL) + ENDIF + NEXT + AADD(PBODY_ARR, ' ' ) // OK - LEAVE HERE! + AADD(PAMTS_ARR, NIL) + ENDIF //** P3N - 2/02/99 + //** P3N - 2/02/99 + SAVE_BKOPROD := BKOPROD //** P3N - 2/02/99 + ENDIF +ELSEIF !(PRNT_DESC == SAVE_DESC) .OR. !(WHICH_TYPE == SAVE_TYPE) + SPEC_CHAR := '^' + IF WHICH_TYPE = 'STORM' .AND. !(PRNT_DESC = SAVE_DESC1) + SPEC_CHAR := '^' + CHR(1) + ENDIF + // IF SPEC_CHAR = '^' + CHR(1) THEN A NEW PAGE WILL BE FORCED + IF WHICH_TYPE = 'EXPANDER' .AND. !(PRNT_DESC = SAVE_DESC1) ; + .AND. MHOME_LOC_CODE = 'KC' + SPEC_CHAR := '^' + CHR(1) + ENDIF + IF LEN(PRNT_DESC) <= PRNT_LEN + IF !EMPTY(PBODY_ARR) .AND. !EMPTY(PBODY_ARR[LEN(PBODY_ARR)]) + IF PBODY_ARR[LEN(PBODY_ARR)] == '-----' + // ONLY double space when one line item for a given product + ELSE + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + ENDIF + ENDIF + AADD(PBODY_ARR, SPEC_CHAR + STRTRAN(PRNT_DESC, '~', ' ' ) ) + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + AADD(PAMTS_ARR, NIL) + SAVE_DESC1 := ALLTRIM(PRNT_DESC) + ELSE + MEMOCNT := MLCOUNT(PRNT_DESC, PRNT_LEN, 0, .T.) + PRNTOUTVAR = STRTRAN(PRNT_DESC, CHR(248), CHR(179)) + FOR II = 1 TO MEMOCNT + PRNT_VAL := MEMOTRAN(MEMOLINE(PRNTOUTVAR, PRNT_LEN, II, 0, .T.), '') + IF II = 1 + IF !EMPTY(PBODY_ARR) .AND. !EMPTY(PBODY_ARR[LEN(PBODY_ARR)]) + IF PBODY_ARR[LEN(PBODY_ARR)] == '-----' + // ONLY double space when one line item for a given product + ELSE + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL) + ENDIF + ENDIF + AADD(PBODY_ARR, SPEC_CHAR + STRTRAN(PRNT_VAL, '~', ' ') ) + AADD(PAMTS_ARR, NIL) + SAVE_DESC1 := ALLTRIM(PRNT_VAL) + ELSE + AADD(PBODY_ARR, STRTRAN(PRNT_VAL, '~', ' ') ) + AADD(PAMTS_ARR, NIL) + ENDIF + NEXT + AADD(PBODY_ARR, ' ' ) // OK - LEAVE HERE! + AADD(PAMTS_ARR, NIL) + ENDIF + SAVE_DESC := PRNT_DESC + SAVE_BKOPROD := BKOPROD //** P3N - 2/02/99 +ENDIF +IF INCL_ALL_LINES + IF VALTYPE(OL_ARR[3]) = 'A' //** ARRAY -SCREEN COPY + IF WHCHORDER == 'BACKORD' + DO_CUT_SPECS := .F. + PRNT_VAL := ALLTRIM(OL_ARR[3,2]) //* 2 - BO SCREEN DESC + ELSE + PRNT_VAL := ALLTRIM(OL_ARR[3,1]) //* 1 - SCREEN DESC + ENDIF + ELSE + PRNT_VAL := ALLTRIM(OL_ARR[3]) // ITEM LINE DESC + ENDIF + IF !EMPTY( OL_ARR[14]) + MLINE_DESC := ALLTRIM(OL_ARR[14]) + ELSE + MLINE_DESC := NIL + ENDIF + PRNT_PRICE := OL_ARR[4] // ITEM PRICE + XFACTOR := OL_ARR[12] // XTRA WINDOWS + PRT_AMT := DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) + IF WHCHORDER $ 'INV BACKORD' .AND. CUR_MAST = 'ORD_MAST' //** P3N - 5/12/98 + PRT_BO := .T. + ELSE + PRT_BO := .F. + ENDIF + IF EMPTY(OL_ARR[6]) // LINE ITEM NOTES - LINE_NOTES IN LINE DBF + ELSEIF OL_ARR[16] == 'A' // PRINT THE NOTES ABOVE THE LINE ITEM + RETVARARR := PRT_MEMO(PBODY_ARR, PAMTS_ARR, OL_ARR[6], PRNT_LEN) // PRINT THE LINE ITEM NOTES + PBODY_ARR := RETVARARR[1] + PAMTS_ARR := RETVARARR[2] + ENDIF + // ALL LINE ITEM DETAIL AMOUNTS + IF EMPTY(PRNT_VAL) // NO LINE ITEM DESC. - NO AMOUNTS + PAMTS := NIL + ELSEIF WHCHORDER == 'BACKORD' //** P3N - 5/14/98 + PAMTS := { 0 , 0 , BK_ORD , PRNT_PRICE, PRT_AMT, PRT_BO, XFACTOR, , INV_QTY } + ELSE + PAMTS := { PRNT_QTY, BK_ORD, SHIP_QTY, PRNT_PRICE, PRT_AMT, PRT_BO, XFACTOR, , INV_QTY } + ENDIF + IF WHICH_TYPE == 'INV' .OR. WHICH_TYPE == 'CTRL' // CUSTOMER INVOICE OR PROD CONTROL COPY + IF OL_ARR[4] == NIL // LINE ITEM TOTAL + ELSEIF PARTIAL_INVOICE + //** P3N - 11/23/98 - PARTIAL INVOICE MODIFICATIONS + LI_TTL := LI_TTL + (PRNT_PRICE * SHIP_QTY) // TALLY THE LINE TOTALS + ELSEIF REPRINT_INVOICE + //** P3N - 12/3/98 - REPRINT INVOICE MODIFICATIONS + LI_TTL := LI_TTL + (PRNT_PRICE * INV_QTY) // TALLY THE LINE TOTALS + ELSE + LI_TTL := LI_TTL + (PRNT_PRICE * PRNT_QTY) // TALLY THE LINE TOTALS + ENDIF + ENDIF + IF EMPTY(OL_ARR[6]) //LINE ITEM NOTES - LINE_NOTES IN LINE DBF + ELSEIF OL_ARR[16] == 'B' //PRINT THE NOTES BESIDE THE LINE ITEM + WORKVAR := STRTRAN( ALLTRIM( OL_ARR[6] ), CHR(13), '' ) + WORKVAR := STRTRAN( WORKVAR, CHR(10), ' ' ) + PRNT_VAL := PRNT_VAL + ' ' + WORKVAR + ENDIF +//** P3N - 5/13/98 +//** ONLY PRINT BACKORDERED ITEMS + IF EMPTY(BK_ORD) .AND. WHCHORDER == 'BACKORD' + PRNT_VAL := ' ' + DO_CUT_SPECS := .F. + ENDIF + IF !EMPTY(PRNT_VAL) +//**IF DO_CUT_SPECS .AND. !EMPTY(OL_ARR[13]) // LINE ITEM CUTTING SPECS +//** PAMTS := NIL //** P3N - 5/4/99 +//**ENDIF //** P3N - 5/4/99 + IF LEN(PRNT_VAL) <= PRNT_LEN + IF WHCHORDER == 'PROD' .AND. WHICH_TYPE == 'GLASS' .AND. ; //** P3N - 10/19/99 + EMPTY(PRNT_QTY) .AND. EMPTY(SHIP_QTY) .AND. EMPTY(BK_ORD) //** P3N - 10/19/99 + MGL_LINE_DESC := PRNT_VAL //** P3N - 10/19/99 + ELSE //** P3N - 10/19/99 + AADD(PBODY_ARR, STRTRAN(PRNT_VAL,'~',' ') ) // ITEM LINE FOR ALL PRODUCTION ORDERS + AADD(PAMTS_ARR, PAMTS) // ITEM LINE FOR ALL PRODUCTION ORDERS + ENDIF + ELSE + MEMOCNT := MLCOUNT(PRNT_VAL, PRNT_LEN, 0, .T.) + PRNTOUTVAR = STRTRAN(PRNT_VAL, CHR(248), CHR(179)) + FOR II = 1 TO MEMOCNT + PRNT_VAL := MEMOTRAN(MEMOLINE(PRNTOUTVAR, PRNT_LEN, II, 0, .T.), '') + AADD(PBODY_ARR, STRTRAN(PRNT_VAL,'~', ' ') ) + IF II < MEMOCNT + AADD(PAMTS_ARR, NIL) + ELSE + AADD(PAMTS_ARR, PAMTS) + ENDIF + NEXT +//** REMOVED DUE TO MULIT SPACING AT PAWNEE - P3N - 11/19/99 +//** AADD(PBODY_ARR, ' ' ) // GET RID OF THIS BLANK BETWEEN ?? +//** AADD(PAMTS_ARR, NIL) + ENDIF + ENDIF +//** P3N*4/1/98 - EXCLUDE PRINT OF CUTTING SPECS +//** P3N*4/1/98 - DOUBLE SPACE ! + IF ASCAN(OL_ARR[13], {|X| AT('X', X[9]) > 0 }) > 0 + DO_CUT_SPECS := .F. + AADD(PBODY_ARR, ' ' ) + AADD( PAMTS_ARR, NIL ) + ENDIF + IF DO_CUT_SPECS .AND. !EMPTY(OL_ARR[13]) // LINE ITEM CUTTING SPECS + CUT_SPEC_ARR := OL_ARR[13] + PRNTOUTVAR := {} + FOR I := 1 TO LEN(CUT_SPEC_ARR) + WORKVAR := '' + IF CUT_SPEC_ARR[I,7] <> NIL // CALCULATED RESULT + WORKVAR := WORKVAR + CUT_SPEC_ARR[I,4] + ' ' // PRINT DESC + WORKVAR := WORKVAR + CUT_SPEC_ARR[I,5] + ' ' // PROFILE + WORKVAR := WORKVAR + ': ' + AADD(PRNTOUTVAR, {WORKVAR, CUT_SPEC_ARR[I,7], ; + CUT_SPEC_ARR[I,11], CUT_SPEC_ARR[I,12], CUT_SPEC_ARR[I,3], ; + CUT_SPEC_ARR[I,13] , CUT_SPEC_ARR[I,14] , ; // 6-7 + CUT_SPEC_ARR[I,15] , CUT_SPEC_ARR[I,16] , ; // 8-9 + CUT_SPEC_ARR[I,17] } ) // 10 + ENDIF + NEXT + II := 0 + WAMTS_ARR := NIL + FOR I := 1 TO LEN(PRNTOUTVAR) + II ++ + // DUMP DATA IN "BUFFER" TO START FRESH LINE ON WIDTH/HEIGHT VARS. + IF PRNTOUTVAR[I,3]$'W' .AND. II = 2 // WIDTH/HEIGHT/NOTHING + AADD(PBODY_ARR, STRTRAN(WORKVAR,'~',' ') ) // WAITING TO FILL LINE - DUMP LINE FOR CLEAN WID HT + AADD(PAMTS_ARR, WAMTS_ARR) + WAMTS_ARR := NIL + II := 1 + ENDIF + IF II = 1 // 1ST ITEM IN A LINE + WORKVAR := '' + ELSE + WORKVAR := WORKVAR + ' ' + ENDIF + IF !PRNTOUTVAR[I,3]$'H' // SINCE A PAIR, TAKE QTY FROM THE WIDTH + // NUM IN SPEC ORD QTY XFACTOR + WORKQTY := PRNTOUTVAR[I,5] * (PRNTOUTVAR[I,6] * (1 + PRNTOUTVAR[I,7]) ) + ELSE + WORKQTY := 0 + ENDIF + IF !PRNTOUTVAR[I,3]$'WH' // WIDTH/HEIGHT/NOTHING + IF PRNTOUTVAR[I,5] <> 0 + WORKVAR := WORKVAR + PADR( ALLTRIM(STR( WORKQTY, 2 )),3) + ELSE + WORKVAR := WORKVAR + CHR(255) + ' ' + ENDIF + WORKVAR := WORKVAR + PRNTOUTVAR[I,1] + IF PRNTOUTVAR[I,4]$'D' // FRACTION / DECIMAL + WORKOUT := STR(PRNTOUTVAR[I,2],8,4) + ELSE + WORKOUT := PADR(PRNT_SIZE( PRNTOUTVAR[I,2] ),8) + ENDIF + WORKVAR := WORKVAR + WORKOUT +//** ELSEIF II = 1 + ELSEIF II = 1 .OR. II = 3 //** P3N - 4/6/99 + // IT IS A WIDTH OR HEIGHT CUT SPEC + IF !EMPTY(PRNTOUTVAR[I,8]) // WIDTH/HEIGHT DESCRIPTION + AADD(PBODY_ARR, PRNTOUTVAR[I,8] ) + AADD(PAMTS_ARR, NIL ) + ENDIF + WORKVAR := WORKVAR + ' ' + ALLTRIM(PRNT_SIZE( PRNTOUTVAR[I,2] )) + '~~x' + IF WORKQTY = 0 + WAMTS_ARR := NIL + ELSEIF WHCHORDER == 'BACKORD' + WAMTS_ARR := { 0 , 0 , BK_ORD , 0, .F., .T., 0 } +************WAMTS_ARR := { SHIP_QTY, BK_ORD, PRNT_QTY , 0, .F., .T., 0 } + ELSE + WAMTS_ARR := { WORKQTY, 0, 0, 0, .F., .F., 0 } + ENDIF + // WIDTH/HEIGHT/NOTHING + ELSE // ASSUME PREVIOUS ONE WAS A WIDTH + WORKVAR := ALLTRIM(WORKVAR) + ' ' + WORKVAR := WORKVAR + ALLTRIM(PRNT_SIZE( PRNTOUTVAR[I,2] )) + ENDIF + // LAST ONE ON LINE OR IN ARRAY +//** IF I = LEN(PRNTOUTVAR) .OR. II = 2 + //** PRINT STORM COPY COLUMN FORMAT (IE: C200007 @ IOLA) + IF I = LEN(PRNTOUTVAR) .OR. II >= 2 //** P3N - 4/6/99 + IF PRNTOUTVAR[I,10] == 'S' //** P3N - 4/6/99 + IF II = 2 //** P3N - 4/6/99 + WORKVAR := PADR(WORKVAR , 20, ' ') //** P3N - 4/6/99 + ELSEIF II = 4 //** P3N - 4/6/99 + AADD(PBODY_ARR, STRTRAN(WORKVAR,'~',' ') ) + AADD( PAMTS_ARR, WAMTS_ARR ) //** P3N - 4/6/99 + WAMTS_ARR := NIL //** P3N - 4/6/99 + ENDIF //** P3N - 4/6/99 + ELSE + WORKVAR := WORKVAR+' '+MGL_LINE_DESC //** P3N - 10/19/99 + AADD(PBODY_ARR, STRTRAN(WORKVAR,'~',' ')) + AADD( PAMTS_ARR, WAMTS_ARR ) + IF PRNTOUTVAR[I,3]$'WH' + // EXTRA LINE DESCRIPTION + IF !EMPTY(OL_ARR[14]) .AND. PRNTOUTVAR[I,10]$'Y ' // PRINT ITEM DESC + AADD(PBODY_ARR, STRTRAN(OL_ARR[14],'~',' ') ) + AADD( PAMTS_ARR, NIL ) + ENDIF + ENDIF + WAMTS_ARR := NIL + ENDIF + ENDIF +//** IF II = 2 +//** II := 0 +//** ENDIF + IF II >= 2 //** P3N - 4/6/99 + //** PRINT STORM COPY COLUMN FORMAT (IE: C200007 @ IOLA) + IF PRNTOUTVAR[I,10] == 'S' //** P3N - 4/6/99 + IF II > 3 //** P3N - 4/6/99 + II := 0 //** P3N - 4/6/99 + ENDIF //** P3N - 4/6/99 + ELSE //** P3N - 4/6/99 + II := 0 //** P3N - 4/6/99 + ENDIF //** P3N - 4/6/99 + ENDIF //** P3N - 4/6/99 + NEXT + IF EMPTY(OL_ARR[6]) // LINE ITEM NOTES - LINE_NOTES IN LINE DBF + ELSEIF OL_ARR[16] == 'U' // PRINT THE NOTES UNDER THE LINE ITEM + RETVARARR := PRT_MEMO(PBODY_ARR, PAMTS_ARR, OL_ARR[6], PRNT_LEN) // PRINT THE LINE ITEM NOTES + PBODY_ARR := RETVARARR[1] + PAMTS_ARR := RETVARARR[2] + ENDIF + IF LEN(PRNTOUTVAR) > 0 + AADD(PBODY_ARR, ' ' ) // DOUBLE SPACE + AADD(PAMTS_ARR, WAMTS_ARR) + WAMTS_ARR := NIL + ENDIF + ELSE + IF EMPTY(OL_ARR[6]) // LINE ITEM NOTES - LINE_NOTES IN LINE DBF + ELSEIF OL_ARR[16] == 'U' // PRINT THE NOTES UNDER THE LINE ITEM + RETVARARR := PRT_MEMO(PBODY_ARR, PAMTS_ARR, OL_ARR[6], PRNT_LEN) // PRINT THE LINE ITEM NOTES + PBODY_ARR := RETVARARR[1] + PAMTS_ARR := RETVARARR[2] + ENDIF + ENDIF +ENDIF +SAVE_TYPE := WHICH_TYPE +IF DBLSPACE(WHICH_TYPE, WHCHORDER, SUBTYPE, MPROD_CODE) //** P3N - 02/12/04 + AADD(PBODY_ARR, ' ' ) //** P3N - 02/12/04 + AADD( PAMTS_ARR, NIL ) //** P3N - 02/12/04 +ENDIF //** P3N - 02/12/04 +RETURN {LI_TTL, PBODY_ARR, PAMTS_ARR} +*************************************************************** +* P3N - 2/12/04 SHOULD WE DOUBLE SPACE THIS ORDER? +*************************************************************** +FUNCTION DBLSPACE(WHICH_TYPE, WHCHORDER, SUBTYPE, P_PROD) //** P3N - 02/12/04 +LOCAL RETVAL := .F. +LOCAL ITEM_CAT_CODE := GET_CATCODE( P_PROD ) +IF EMPTY(SUBTYPE) + SUBTYPE := '' +ENDIF +IF CATEGORY->(DBSEEK( ITEM_CAT_CODE )) + IF WHCHORDER = 'PROD' + IF WHICH_TYPE = 'FRAME'.AND.AT('F', UPPER(CATEGORY->DBLSP_PROD)) >0 + RETVAL := .T. + ENDIF + IF WHICH_TYPE = 'STORM'.AND.AT('F', UPPER(CATEGORY->DBLSP_PROD)) >0 + RETVAL := .T. + ENDIF + IF WHICH_TYPE = 'GLASS'.AND.AT('G', UPPER(CATEGORY->DBLSP_PROD)) >0 + RETVAL := .T. + ENDIF + IF WHICH_TYPE = 'SCREEN'.AND.AT('S', UPPER(CATEGORY->DBLSP_PROD)) >0 + RETVAL := .T. + ENDIF + IF WHICH_TYPE = 'CTRL'.AND.AT('R', UPPER(CATEGORY->DBLSP_PROD)) >0 + //** SUBTYPE = 'GOLDEN' + RETVAL := .T. + ENDIF + ELSEIF WHCHORDER = 'OD' + IF SUBTYPE = 'DELIVERY'.AND.AT('D', UPPER(CATEGORY->DBLSP_OD)) >0 + //** DELIVERY COPY + RETVAL := .T. + ENDIF + IF SUBTYPE = 'ORDERDESK'.AND.AT('O', UPPER(CATEGORY->DBLSP_OD)) >0 + //** ORDERDESK COPY + RETVAL := .T. + ENDIF + IF SUBTYPE = 'PO'.AND.AT('I', UPPER(CATEGORY->DBLSP_OD)) >0 + //** INTERCOMPANY PURCHASE ORDER + RETVAL := .T. + ENDIF + ELSEIF WHCHORDER = 'INV' + IF EMPTY(SUBTYPE).AND.AT('I', UPPER(CATEGORY->DBLSP_INV)) >0 + //** CUSTOMER INVOICE COPY + RETVAL := .T. + ENDIF + IF SUBTYPE = 'PREBILL'.AND.AT('B', UPPER(CATEGORY->DBLSP_INV)) >0 + //** PREBILL INVOICE COPY + RETVAL := .T. + ENDIF + IF SUBTYPE = 'PRECOST'.AND.AT('C', UPPER(CATEGORY->DBLSP_INV)) >0 + //** PRECOST INVOICE COPY + RETVAL := .T. + ENDIF + ELSEIF WHCHORDER = 'BACKORD' + IF CATEGORY->DBLSP_BO = 'Y' + RETVAL := .T. + ENDIF + ENDIF +**ERR_BOX('FOUND ITEM_CAT_CODE = ' + ITEM_CAT_CODE, ; +** 'PROD CODE = ' + P_PROD, 'SUBTYPE = '+ SUBTYPE, ; +** 'WHCHORDER = ' + WHCHORDER, 'WHICH_TYPE = '+ WHICH_TYPE) +ENDIF +RETURN RETVAL +*************************************************************** +* P3N - 2/12/04 VALIDATE THE CATEGROY DOUBLE SPACE CODES +*************************************************************** +FUNCTION VAL_DBLSP(CMD) +//** CMD - "PROD" PRODUCTION ORDER COPIES +//** CMD - "OD" ORDERDESK ORDER COPIES +//** CMD - "INV" INVOICE ORDER COPIES +//** CMD - "BO" BACKORDER ORDER COPIES +LOCAL RETVAL := .T. +IF CMD = 'PROD' +* ERR_BOX('Prodction double spaceing opts: "F", "G", "S" are valid') +* RETVAL := .F. +ELSEIF CMD = 'OD' +* IF CATEGORY->DBLSP_OD +ELSEIF CMD = 'INV' +* IF CATEGORY->DBLSP_INV +ELSEIF CMD = 'BO' +* IF CATEGORY->DBLSP_BO +ELSE +* ERR_BOX('Invalid CMD in VAL_DBLSP() function') +ENDIF +RETURN RETVAL +*************************************************************** +* P3N - 5/22/98 ARE THERE ANY BACKORDER ITEMS TO PRINT? +*************************************************************** +FUNCTION ORD_QTYS(WHCHORDER, OL_ARR) +LOCAL ELM, OLQTY, NUM_IN_SPEC, XFACTOR, CALCQTY, SCRNKEY, ADDLKEY +LOCAL PRNT_QTY := OL_ARR[7] // ITEM QUANTITY +LOCAL SHIP_QTY := OL_ARR[11] // ITEM SHIPPED QTY +LOCAL CUT_SPEC_ARR := OL_ARR[13] // CUTTING SPECS ARR +LOCAL LINE_NUM := OL_ARR[9] // ORDER LINE_NUM +LOCAL PAR_PROD := OL_ARR[10] //ORDER PROD_CODE-PAR_PROD FOR SCREENS +LOCAL BK_ORD := 0 //** P3N - 11/12/98 +IF EMPTY(PRNT_QTY) //** P3N - 11/12/98 + PRNT_QTY := 0 //** P3N - 11/12/98 +ENDIF //** P3N - 11/12/98 +IF EMPTY(SHIP_QTY) //** P3N - 11/12/98 + SHIP_QTY := 0 //** P3N - 11/12/98 +ENDIF //** P3N - 11/12/98 +BK_ORD := PRNT_QTY - SHIP_QTY // BACK ORDER QTY +IF WHCHORDER == 'BACKORD' + IF EMPTY(PRNT_QTY) + ADDLKEY := MORDER_NUM + PAR_PROD + LINE_NUM + IF ADDL_LINES->(DBSEEK(ADDLKEY)) + OLQTY := ADDL_LINES->QUANTITY + ADDLKEY := MORDER_NUM + LINE_NUM + PAR_PROD + SHIP_QTY := SCRN_SHPQTY(ADDLKEY) + BK_ORD := OLQTY - SHIP_QTY + ELSE + ELM := ASCAN(CUT_SPEC_ARR, {|X| AT('N', X[9]) > 0 }) // IS THIS A SCREEN SPEC? + IF EMPTY(ELM) + ELSE + 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 ) + PRNT_QTY := CALCQTY //** LINE ITEM QTY + SCRNKEY := MORDER_NUM + LINE_NUM + 'SCREENS' + PAR_PROD + SHIP_QTY := SCRN_SHPQTY(SCRNKEY) + BK_ORD := CALCQTY - SHIP_QTY + ENDIF + ENDIF + ENDIF +ENDIF +RETURN { PRNT_QTY, SHIP_QTY, BK_ORD } +*************************************************************** +* P3N - 5/22/98 GET THE SHIPPED SCREENS TO PRINT ON BACK ORDER! +*************************************************************** +FUNCTION SCRN_SHPQTY(SCRNKEY) +RETVAL := 0 +IF ORD_SHIP->(DBSEEK(SCRNKEY)) + DO WHILE ORD_SHIP->(!EOF()) .AND. ; + ( ORD_SHIP->ORDER_NUM + STR(ORD_SHIP->LINE_NUM, 3) + ; + ORD_SHIP->PROD_CODE + ORD_SHIP->PAR_PROD == SCRNKEY ) + RETVAL := RETVAL + ORD_SHIP->SHIP_QTY + ORD_SHIP->(DBSKIP(+1)) + ENDDO +ENDIF +RETURN RETVAL +*************************************************************** +*************************************************************** +*************************************************************** +FUNCTION DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) +LOCAL PRT_AMT := .F. +//**IF (CUR_MAST)->TERMS = '90' .OR. ; //** NO CHARGE //**P3N - 4/27/98 +//** (CUR_MAST)->TERMS = '96' //** CANCELLATION //**P3N - 4/27/98 +IF ZERO_ORDER() //** NO CHARGE //**P3N - 3/05/99 + //** FOR A NO CHARGE OR CANCELLATION FORCE TO NOT PRINT AMTS +ELSEIF WHCHORDER == 'INV' + IF ITEMIZE = 1 + PRT_AMT := .T. + ENDIF +ELSEIF WHCHORDER == 'OD' // ORDER DESK + PRT_AMT := .T. + IF MHOME_LOC_CODE = 'LINDS' .AND. SUBTYPE == 'ORDERDESK' + //PER LINDA @ LINDSBOURG 11-10-97 + //PRINT GL ALLOCATIONS / ORDER AMOUNTS ON ORDERDESK - GOLDEN ROD +****ELSEIF MHOME_LOC_CODE = 'KC' .AND. SUBTYPE == 'ORDERDESK' +**** //PER ELLEN @ KC 10-26-98 +**** //DO NOT PRINT GL ALLOCATIONS / ORDER AMOUNTS ON ORDERDESK - GOLDEN ROD +**** PRT_AMT := .F. + ELSEIF SUBTYPE == 'DELIVERY' .AND. !IS_COD( (CUR_MAST)->TERMS ) + PRT_AMT := .F. + ELSEIF SUBTYPE == 'PO' // DO NOT PRINT AMTS ON THE INTERCOMPANY COPY + PRT_AMT := .F. + ELSEIF (CUR_MAST)->PRICE_SHT$'I' //** P3N - 01/30/06 + //** P3N - 01/30/06 PER PAT PRINT PRICING ON ODERDESK COPY FOR SPECIAL DEALERS + //**ELSEIF (CUR_MAST)->PRICE_SHT$'IS' //** P3N - 01/30/06 + //DO NOT PRINT AMTS ON OD COPY WHEN INTERCOMPANY OR SPECIAL DEALER PRICING! + PRT_AMT := .F. + ENDIF +ELSEIF WHCHORDER == 'BACKORD' //** P3N - 5/1/98 + PRT_AMT := .F. //** P3N - 5/1/98 +ENDIF +RETURN PRT_AMT +******************************************************************** +// PRINT THE PRODUCTION LINE MEMOS +******************************************************************** +FUNCTION PRT_MEMO(PBODY_ARR, PAMTS_ARR, PROD_MEMO, PRNT_LEN) +LOCAL MEMOCNT, PRNTOUTVAR, PRNT_VAL, I +MEMOCNT := MLCOUNT(PROD_MEMO, PRNT_LEN, 0, .T.) +PRNTOUTVAR = STRTRAN(PROD_MEMO, CHR(248), CHR(179)) +FOR I = 1 TO MEMOCNT + PRNT_VAL := MEMOTRAN(MEMOLINE(PRNTOUTVAR, PRNT_LEN, I, 0, .T.), '') + AADD(PBODY_ARR, PRNT_VAL ) + AADD(PAMTS_ARR, NIL) +NEXT +RETURN { PBODY_ARR, PAMTS_ARR } + +********** +// THIS PRG IS A print port manager for lib programs +// needing multiple output routings. +// will be called IF FILE('PRINTERS.DBF') + +PROCEDURE CUSTOMPRINT() + +LOCAL CLOSE_ARR := {}, PRN_LIST := {} + +* - SELECT A PRINTER FROM THE TABLE BELOW +* +* draw input screen +* + + +AADD(PRN_LIST , 'OKI') +AADD(PRN_LIST , 'EPS') +AADD(PRN_LIST , 'HPJ') // MOVED HERE 6-10-20 +AADD(PRN_LIST , 'PRW') +AADD(PRN_LIST , 'PRN') +AADD(PRN_LIST , 'P90') +AADD(PRN_LIST , 'HPD') +AADD(PRN_LIST , 'HP4') + + +_REPTPRNT := STR(ASCAN(PRN_LIST, {|X| X = REPT_PRN}),1) +_BOPRNT := STR(ASCAN(PRN_LIST, {|X| X = BO_PRN}),1) //** P3N - 4/30/98 +_PRODPRNT := STR(ASCAN(PRN_LIST, {|X| X = PROD_PRN}),1) +_ODPRNT := STR(ASCAN(PRN_LIST, {|X| X = OD_PRN}),1) +_INVPRNT := STR(ASCAN(PRN_LIST, {|X| X = INV_PRN}),1) +_DELPRNT := STR(ASCAN(PRN_LIST, {|X| X = DEL_PRN}),1) +_GRPRNT := STR(ASCAN(PRN_LIST, {|X| X = GR_PRN}),1) +_ICPRNT := STR(ASCAN(PRN_LIST, {|X| X = IC_PRN}),1) +_LBLPRNT := STR(ASCAN(PRN_LIST, {|X| X = LBL_PRN}),1) +_QTEPRNT := STR(ASCAN(PRN_LIST, {|X| X = INV_PRN}),1) +_PREPRNT := STR(ASCAN(PRN_LIST, {|X| X = INV_PRN}),1) + +// 3/31/2021 - ADJUSTMENT FACTOR FOR WIDTH/HEIGHT OF PRINT +_REPTFACW := REPT_FACW +_REPTFACH := REPT_FACH +IF _REPTFACW = 0 + _REPTFACW := 100 +ENDIF +IF _REPTFACH = 0 + _REPTFACH := 100 +ENDIF + +_PRODFACW := PROD_FACW +_PRODFACH := PROD_FACH +IF _PRODFACW = 0 + _PRODFACW := 100 +ENDIF +IF _PRODFACH = 0 + _PRODFACH := 100 +ENDIF + +_ODFACW := OD_FACW +_ODFACH := OD_FACH +IF _ODFACW = 0 + _ODFACW := 100 +ENDIF +IF _ODFACH = 0 + _ODFACH := 100 +ENDIF + +_INVFACW := INV_FACW +_INVFACH := INV_FACH +IF _INVFACW = 0 + _INVFACW := 100 +ENDIF +IF _INVFACH = 0 + _INVFACH := 100 +ENDIF + +_DELFACW := DEL_FACW +_DELFACH := DEL_FACH +IF _DELFACW = 0 + _DELFACW := 100 +ENDIF +IF _DELFACH = 0 + _DELFACH := 100 +ENDIF + +_GRFACW := GR_FACW +_GRFACH := GR_FACH +IF _GRFACW = 0 + _GRFACW := 100 +ENDIF +IF _GRFACH = 0 + _GRFACH := 100 +ENDIF + +_LBLFACW := LBL_FACW +_LBLFACH := LBL_FACH +IF _LBLFACW = 0 + _LBLFACW := 100 +ENDIF +IF _LBLFACH = 0 + _LBLFACH := 100 +ENDIF + +_ICFACW := IC_FACW +_ICFACH := IC_FACH +IF _ICFACW = 0 + _ICFACW := 100 +ENDIF +IF _ICFACH = 0 + _ICFACH := 100 +ENDIF + +_BOFACW := BO_FACW +_BOFACH := BO_FACH +IF _BOFACW = 0 + _BOFACW := 100 +ENDIF +IF _BOFACH = 0 + _BOFACH := 100 +ENDIF + +_QTEFACW := QTE_FACW +_QTEFACH := QTE_FACH +IF _QTEFACW = 0 + _QTEFACW := 100 +ENDIF +IF _QTEFACH = 0 + _QTEFACH := 100 +ENDIF + +_PREFACW := PRE_FACW +_PREFACH := PRE_FACH +IF _PREFACW = 0 + _PREFACW := 100 +ENDIF +IF _PREFACH = 0 + _PREFACH := 100 +ENDIF + +M_LPTR := REPT_PORT +M_LPTP := PROD_PORT +M_LPTO := OD_PORT +M_LPTI := INV_PORT +M_LPTD := DEL_PORT +M_LPTG := GR_PORT +M_LPTL := LBL_PORT +M_LPTIC := IC_PORT +M_LPTBO := BO_PORT //** P3N - 4/30/98 +M_LPTQ := INV_PORT //** P3N - 4/13/98 +M_LPTPRE := INV_PORT //** P3N - 4/13/98 +IF FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + M_LPTQ := QTE_PORT //** P3N - 4/13/98 +ENDIF +IF FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + M_LPTPRE := PRE_PORT //** P3N - 4/13/98 +ENDIF + +SELECT WORKSTAT + +DO WHILE .T. + CLEAR + TITLE = 'SELECT PRINTER' + H = ((80 - LEN(TITLE)) / 2) + @ 0,H SAY TITLE + @ 0,74 SAY 'PDEF' + @ 1,0 SAY DOUBLE + @ 3,72 SAY DTOC(DATE()) + @ 5,28 SAY " AVAILABLE PRINTERS " + @ 6,28 SAY " ================== " + @ 7,26 SAY "1. Okidata Microline 84" + @ 8,26 SAY "2. Epson (All Models)" + @ 9,26 SAY "3. HP LaserJet " + LOOP4100 := .T. + DO WHILE LOOP4100 + SET CONFIRM OFF + @ 4,72 SAY TIME() + + // 3/31/2021 - Set ZOOM Factor for each one. + @ 11,09 SAY " Set ZOOM Resize Factor from 100% ------>Width Height" + @ 12,09 SAY " Select REPORTS Printer : : LPT Port : : : : : :" + @ 13,09 SAY " Select PRODUCTION Printer : : LPT Port : : : : : :" + @ 14,09 SAY " Select ORDER DESK Printer : : LPT Port : : : : : :" + @ 15,09 SAY " Select INVOICE Printer : : LPT Port : : : : : :" + @ 16,09 SAY " Select DELIVERY Printer : : LPT Port : : : : : :" + @ 17,09 SAY " Select GOLDEN ROD Printer : : LPT Port : : : : : :" + @ 18,09 SAY "Select MAILING LABEL Printer : : LPT Port : : : : : :" + @ 19,09 SAY " Select INTERCOMPANY Printer : : LPT Port : : : : : :" + @ 20,09 SAY " Select BACKORDER Printer : : LPT Port : : : : : :" + IF FIELDPOS('QTE_PRN') > 0 .AND. FIELDPOS('QTE_PORT') > 0 + @ 21,09 SAY " Select QUOTE Printer : : LPT Port : : : : : :" + ENDIF + IF FIELDPOS('PRE_PRN') > 0 .AND. FIELDPOS('PRE_PORT') > 0 + @ 22,09 SAY " Select PREBILL Printer : : LPT Port : : : : : :" + ENDIF + + DO WHILE .T. + @ 12,39 GET _REPTPRNT PICTURE '9' VALID CHK_PRN(_REPTPRNT) + @ 12,54 GET M_LPTR PICTURE '9' VALID M_LPTR$'1234' + @ 12,60 GET _REPTFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 12,66 GET _REPTFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 13,39 GET _PRODPRNT PICTURE '9' VALID CHK_PRN(_PRODPRNT) + @ 13,54 GET M_LPTP PICTURE '9' VALID M_LPTP$'1234' + @ 13,60 GET _PRODFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 13,66 GET _PRODFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 14,39 GET _ODPRNT PICTURE '9' VALID CHK_PRN(_ODPRNT) + @ 14,54 GET M_LPTO PICTURE '9' VALID M_LPTO$'1234' + @ 14,60 GET _ODFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 14,66 GET _ODFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 15,39 GET _INVPRNT PICTURE '9' VALID CHK_PRN(_INVPRNT) + @ 15,54 GET M_LPTI PICTURE '9' VALID M_LPTI$'1234' + @ 15,60 GET _INVFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 15,66 GET _INVFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 16,39 GET _DELPRNT PICTURE '9' VALID CHK_PRN(_DELPRNT) + @ 16,54 GET M_LPTD PICTURE '9' VALID M_LPTD$'1234' + @ 16,60 GET _DELFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 16,66 GET _DELFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 17,39 GET _GRPRNT PICTURE '9' VALID CHK_PRN(_GRPRNT) + @ 17,54 GET M_LPTG PICTURE '9' VALID M_LPTG$'1234' + @ 17,60 GET _GRFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 17,66 GET _GRFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 18,39 GET _LBLPRNT PICTURE '9' VALID CHK_PRN(_LBLPRNT) + @ 18,54 GET M_LPTL PICTURE '9' VALID M_LPTL$'1234' + @ 18,60 GET _LBLFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 18,66 GET _LBLFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 19,39 GET _ICPRNT PICTURE '9' VALID CHK_PRN(_ICPRNT) + @ 19,54 GET M_LPTIC PICTURE '9' VALID M_LPTIC$'1234' + @ 19,60 GET _ICFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 19,66 GET _ICFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + @ 20,39 GET _BOPRNT PICTURE '9' VALID CHK_PRN(_BOPRNT) //** P3N - 4/30/98 + @ 20,54 GET M_LPTBO PICTURE '9' VALID M_LPTBO$'1234' + @ 20,60 GET _BOFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 20,66 GET _BOFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + + IF FIELDPOS('QTE_PRN') > 0 .AND. FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + @ 21,39 GET _QTEPRNT PICTURE '9' VALID CHK_PRN(_QTEPRNT) + @ 21,54 GET M_LPTQ PICTURE '9' VALID M_LPTQ$'1234' + @ 21,60 GET _QTEFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 21,66 GET _QTEFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + ENDIF + + IF FIELDPOS('PRE_PRN') > 0 .AND. FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + @ 22,39 GET _PREPRNT PICTURE '9' VALID CHK_PRN(_PREPRNT) + @ 22,54 GET M_LPTPRE PICTURE '9' VALID M_LPTPRE$'1234' + @ 22,60 GET _PREFACW PICTURE '999' // 3/31/2021 - WIDTH FACTOR + @ 22,66 GET _PREFACH PICTURE '999' // 3/31/2021 - HEIGHT FACTOR + ENDIF + + READ + IF LASTKEY() == 27 .AND. PROCNAME(1) <> 'SET_PRNT_P' + CLS + FOR L = 1 TO LEN(CLOSE_ARR) + MFILE = CLOSE_ARR[L] + SELECT(MFILE) + USE + NEXT + RETURN + ENDIF + + IF EMPTY(M_LPTR) .OR. EMPTY(M_LPTP) .OR. EMPTY(M_LPTO); + .OR. EMPTY(M_LPTI) .OR. EMPTY(M_LPTD) .OR. EMPTY(M_LPTG) + LOOP + ENDIF + CORR = CORRCHEK() + IF CORR = 'Y' + LOOP4100 := .F. + EXIT + ENDIF + IF LASTKEY() == 27 .AND. PROCNAME(1) <> 'SET_PRNT_P' + CLEAR + FOR L = 1 TO LEN(CLOSE_ARR) + MFILE = CLOSE_ARR[L] + SELECT(MFILE) + USE + NEXT + RETURN + ENDIF + ENDDO + ENDDO + SETCOLOR(LNOR) + SELECT WORKSTAT + REC_LOCK(1) + REPLACE REPT_PRN WITH PRN_LIST[VAL(_REPTPRNT)] + REPLACE PROD_PRN WITH PRN_LIST[VAL(_PRODPRNT)] + REPLACE OD_PRN WITH PRN_LIST[VAL(_ODPRNT)] + REPLACE INV_PRN WITH PRN_LIST[VAL(_INVPRNT)] + REPLACE DEL_PRN WITH PRN_LIST[VAL(_DELPRNT)] + REPLACE GR_PRN WITH PRN_LIST[VAL(_GRPRNT)] + REPLACE LBL_PRN WITH PRN_LIST[VAL(_LBLPRNT)] + REPLACE IC_PRN WITH PRN_LIST[VAL(_ICPRNT)] + REPLACE BO_PRN WITH PRN_LIST[VAL(_BOPRNT)] //** P3N - 4/30/98 + IF FIELDPOS('QTE_PRN') > 0 //** P3N - 4/13/98 + REPLACE QTE_PRN WITH PRN_LIST[VAL(_QTEPRNT)] //** P3N - 4/13/98 + ENDIF + IF FIELDPOS('PRE_PRN') > 0 //** P3N - 4/13/98 + REPLACE PRE_PRN WITH PRN_LIST[VAL(_PREPRNT)] //** P3N - 4/13/98 + ENDIF + REPLACE REPT_PORT WITH M_LPTR + REPLACE PROD_PORT WITH M_LPTP + REPLACE OD_PORT WITH M_LPTO + REPLACE INV_PORT WITH M_LPTI + REPLACE DEL_PORT WITH M_LPTD + REPLACE GR_PORT WITH M_LPTG + REPLACE LBL_PORT WITH M_LPTL + REPLACE IC_PORT WITH M_LPTIC + REPLACE BO_PORT WITH M_LPTBO //** P3N - 4/30/98 + IF FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 + REPLACE QTE_PORT WITH M_LPTQ //** P3N - 4/13/98 + ENDIF + IF FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 + REPLACE PRE_PORT WITH M_LPTPRE //** P3N - 4/13/98 + ENDIF + + // 3/31/2021 - ADJUSTMENT FACTOR FOR WIDTH/HEIGHT OF PRINT + REPLACE REPT_FACW WITH _REPTFACW + REPLACE REPT_FACH WITH _REPTFACH + + REPLACE PROD_FACW WITH _PRODFACW + REPLACE PROD_FACH WITH _PRODFACH + + REPLACE OD_FACW WITH _ODFACW + REPLACE OD_FACH WITH _ODFACH + + REPLACE INV_FACW WITH _INVFACW + REPLACE INV_FACH WITH _INVFACH + + REPLACE DEL_FACW WITH _DELFACW + REPLACE DEL_FACH WITH _DELFACH + + REPLACE GR_FACW WITH _GRFACW + REPLACE GR_FACH WITH _GRFACH + + REPLACE LBL_FACW WITH _LBLFACW + REPLACE LBL_FACH WITH _LBLFACH + + REPLACE IC_FACW WITH _ICFACW + REPLACE IC_FACH WITH _ICFACH + + REPLACE BO_FACW WITH _BOFACW + REPLACE BO_FACH WITH _BOFACH + + REPLACE QTE_FACW WITH _QTEFACW + REPLACE QTE_FACH WITH _QTEFACH + + REPLACE PRE_FACW WITH _PREFACW + REPLACE PRE_FACH WITH _PREFACH + + // RESET THE SYSTEM VARIABLES TOO!!! + FOR L = 1 TO LEN(CLOSE_ARR) + MFILE = CLOSE_ARR[L] + SELECT(MFILE) + USE + NEXT + + CLEAR SCREEN + RETURN +ENDDO WHILE .T. + +RETURN + +* * * * * * * * * * * * * * * * * + +// @ 12,10 SAY " Select REPORTS Printer : : LPT Port : :" +// @ 13,10 SAY " Select PRODUCTION Printer : : LPT Port : :" +// @ 14,10 SAY " Select ORDER DESK Printer : : LPT Port : :" +// @ 15,10 SAY " Select INVOICE Printer : : LPT Port : :" +// @ 16,10 SAY " Select DELIVERY Printer : : LPT Port : :" +// @ 17,10 SAY " Select GOLDEN ROD Printer : : LPT Port : :" +// @ 18,10 SAY "Select MAILING LABEL Printer : : LPT Port : :" +// @ 19,10 SAY " Select INTERCOMPANY Printer : : LPT Port : :" +// @ 20,10 SAY " Select BACKORDER Printer : : LPT Port : :" //** P3N 4/30/98 +// IF FIELDPOS('QTE_PRN') > 0 .AND. FIELDPOS('QTE_PORT') > 0 //** P3N - 4/13/98 +// @ 21,10 SAY " Select QUOTE Printer : : LPT Port : :" +// ENDIF +// IF FIELDPOS('PRE_PRN') > 0 .AND. FIELDPOS('PRE_PORT') > 0 //** P3N - 4/13/98 +// @ 22,10 SAY " Select PREBILL Printer : : LPT Port : :" +// ENDIF + + +********************************************************************** \ No newline at end of file diff --git a/CGWPRNT2.PRG b/CGWPRNT2.PRG new file mode 100644 index 0000000..f30b62c --- /dev/null +++ b/CGWPRNT2.PRG @@ -0,0 +1,2365 @@ +***************************************************************** +//** P3N - 8/20/99 - MOVED FROM CGWPRINT.PRG +//** P3N - 8/20/99 - CGWPRINT.PRG WAS TOOO BIG FOR THE DBUGER +***************************************************************** +FUNCTION FORMAT_PRT(BODY_DESC, PAMTS_ARR, PADSZ, SUBTYPE, WHCHORDER, ; + PARTIAL_INVOICE, REPRINT_INVOICE ) +LOCAL PRT_VAL, NEGAMT, NEGTOT, PRT_AMTS := PAMTS_ARR[5], PRT_BO := PAMTS_ARR[6] +LOCAL BOQTY := PAMTS_ARR[2], SHPQTY := PAMTS_ARR[3], INVQTY := 0 +LOCAL OQTY := PAMTS_ARR[1], XQTY := PAMTS_ARR[7], XUOM := ' ', MIENTRYSZ := 0 +LOCAL PRT_QTY := 0, TOTWINDOWS := XQTY + 1, WORKVAR +IF WHCHORDER == 'BACKORD' //** P3N -12/2/98 + BOQTY := PAMTS_ARR[3] //** P3N -12/2/98 + SHPQTY := 0 //** P3N -12/2/98 +ENDIF +IF LEN(PAMTS_ARR) >= 8 + IF EMPTY(PAMTS_ARR[8]) //** P3N - 12/3/98 + XUOM := ' ' + ELSE + XUOM := ALLTRIM(PAMTS_ARR[8]) + ' ' //** P3N - 12/01/98 + ENDIF +ENDIF +IF LEN(PAMTS_ARR) >= 9 //** P3N - 12/3/98 + IF EMPTY(PAMTS_ARR[9]) //** P3N - 12/3/98 + INVQTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + INVQTY := PAMTS_ARR[9] //** P3N - 12/3/98 + ENDIF +ENDIF +/////////////*****************\\\\\\\\\\\\\\\\\\\\\\\ +//** IF THE OQTY IS AN ARRAY - IT CONTAINS THE QTY AND THE +//** MISC_ITEMS ENTRY SIZE WHICH WILL PRINT IN THE PLACE OF THE QTY. +/////////////*****************\\\\\\\\\\\\\\\\\\\\\\\ +IF VALTYPE(OQTY) = 'A' + PAMTS_ARR[1] := OQTY[1] + MIENTRYSZ := FORMAT_MISCSIZE( OQTY[2] ) + OQTY := PAMTS_ARR[1] //** NUMERIC MISC ITEM ORDER QTY +ELSEIF EMPTY(OQTY) // NUMERIC QUANTITY //** P3N - 6/5/98 + OQTY := 0 //** P3N - 12/2/98 +ENDIF +IF VALTYPE(MIENTRYSZ) = 'N' //** P3N -12/3/98 + IF EMPTY(MIENTRYSZ) //** P3N -12/3/98 + ELSE //** P3N -12/3/98 + XUOM := STR(MIENTRYSZ) + ' ' + XUOM //** P3N -12/3/98 + OQTY := 0 //** P3N - 5/26/98 + BOQTY := 0 //** P3N - 5/26/98 + SHPQTY := 0 //** P3N - 5/26/98 + ENDIF //** P3N -12/3/98 + IF WHCHORDER == 'BACKORD' //** P3N -12/3/98 + IF EMPTY(BOQTY) //** P3N - 5/26/99 + PRT_VAL := SPACE(13) //** P3N - 5/26/99 + //** IOLA AND PAWNEE USE DELIVERY COPIES FOR BACKORDERS + ELSEIF MHOME_LOC_CODE = 'PAWNEE' //** P3N - 2/23/99 + IF BOQTY <= 999 //** P3N - 2/23/99 + PRT_VAL := SPACE(5) + STR(BOQTY, 4,0)+SPACE(4) + ELSE //** P3N - 2/23/99 + PRT_VAL := SPACE(3) + STR(BOQTY, 6,0)+SPACE(4) + ENDIF //** P3N - 2/23/99 + ELSEIF MHOME_LOC_CODE = 'IOLA' //** P3N - 3/09/99 + IF BOQTY <= 999 //** P3N - 3/09/99 + PRT_VAL := SPACE(4) + STR(BOQTY, 4,0)+SPACE(5) + ELSE //** P3N - 3/09/99 + PRT_VAL := SPACE(3) + STR(BOQTY, 6,0)+SPACE(4) + ENDIF //** P3N - 3/09/99 + ELSE //** P3N - 3/09/99 + IF BOQTY <= 999 //** P3N -12/3/98 + PRT_VAL := SPACE(9) + STR(BOQTY, 4,0) //** P3N -12/3/98 + ELSE //** P3N -12/3/98 + PRT_VAL := SPACE(7) + STR(BOQTY, 6,0) //** P3N -12/3/98 + ENDIF //** P3N -12/3/98 + ENDIF //** P3N - 2/23/99 + ELSE + //** MISC ITEMS CAN HAVE A QTY OF 999999 + IF OQTY <= 999 //** P3N -12/3/98 + IF EMPTY(OQTY) //** P3N - 5/10/99 + PRT_VAL := SPACE(4) // ORDER QTY //** P3N - 5/10/99 + ELSE //** P3N - 5/10/99 + PRT_VAL := STR(OQTY,4,0) // ORDER QTY //** P3N -12/3/98 + ENDIF //** P3N - 5/10/99 + IF PRT_BO .AND. !EMPTY(BOQTY) // DO NOT PRINT 0 BACK ORDER QTY + PRT_VAL := PRT_VAL + SPACE(1) + STR(BOQTY,3,0) //BACK ORDER QTY + ELSE + PRT_VAL := PRT_VAL + SPACE(4) + ENDIF + IF PRT_BO .AND. !EMPTY( SHPQTY ) .AND. ; // DO NOT PRINT 0 SHIP QTY + PAMTS_ARR[1] <> SHPQTY // IS THE ORDER QTY = SHIP QTY + PRT_VAL := PRT_VAL + SPACE(2) + STR(SHPQTY,3,0) //SHIP QTY + ELSE + PRT_VAL := PRT_VAL + SPACE(5) + ENDIF + ELSEIF EMPTY(OQTY) //** P3N - 5/10/99 + PRT_VAL := SPACE(6) //MISC ITEM ORDER QTY //** P3N - 5/10/99 + ELSE //** P3N - 5/10/99 + PRT_VAL := STR(OQTY,6,0) //MISC ITEM ORDER QTY //** P3N -12/3/98 + ENDIF //** P3N - 5/10/99 + PRT_VAL := PADR(PRT_VAL, 13,' ') //** P3N -12/3/98 + ENDIF + PRT_VAL := PRT_VAL + SPACE(2) + IF PRT_AMTS .AND. !EMPTY(PAMTS_ARR[4]) + IF EMPTY(XUOM) + PRT_VAL := PRT_VAL + PADR(ALLTRIM(BODY_DESC), PADSZ, ' ') //ITEM DESC + ELSE + PRT_VAL := PRT_VAL + PADR(XUOM + ALLTRIM(BODY_DESC), PADSZ, ' ') //ITEM DESC + ENDIF + IF CUR_MAST == 'ORD_MAST' .AND. WHCHORDER == 'INV' .AND. PARTIAL_INVOICE + PRTQTY := SHPQTY + ELSEIF CUR_MAST == 'ORD_MAST' .AND. WHCHORDER == 'INV' .AND. REPRINT_INVOICE + PRTQTY := INVQTY + ELSE + PRTQTY := PAMTS_ARR[1] + ENDIF + IF PAMTS_ARR[4] < 0 .OR. PAMTS_ARR[1] < 0 + //** P3N - 11/23/98 PARTIAL INVOICE MODIFICATIONS + //**NEGTOT := TRANSFORM(PAMTS_ARR[1] * PAMTS_ARR[4],'(9999999999.99)') + NEGTOT := TRANSFORM(PRTQTY * PAMTS_ARR[4],'(9999999999.99)') + NEGAMT := TRANSFORM(PAMTS_ARR[4],'(99999.99)') + NEGAMT := STRTRAN(NEGAMT, ' ', '') + NEGAMT := STRTRAN(NEGAMT, '-', '') + NEGTOT := STRTRAN(NEGTOT, ' ', '') + NEGTOT := STRTRAN(NEGTOT, '-', '') + NEGAMT := PADL(NEGAMT, 9, ' ') + NEGTOT := PADL(NEGTOT,13, ' ') + ELSE + NEGAMT := 0 + NEGTOT := 0 + ENDIF + WORKVAR := STR(PAMTS_ARR[4],12,4) +//**IF MHOME_LOC_CODE = 'KC' .OR. MHOME_LOC_CODE = 'LINDS' //PER LINDA - 6/16/97 +//** PRT_VAL := PRT_VAL + ' ' +//**ENDIF +//**IF MHOME_LOC_CODE = 'KC' //** P3N - 7/18/00 remove spaces for kc +//** PRT_VAL := PRT_VAL + ' ' +//**ENDIF + IF MHOME_LOC_CODE = 'LINDS' //** P3N - 7/17/00 ADDRESS THE DELIVERY TICKET PRINT ISSUES + IF SUBTYPE = 'DELIVERY' //** P3N - 7/17/00 + PRT_VAL := PRT_VAL + ' ' //** P3N - 7/17/00 + ELSE //** P3N - 7/17/00 + PRT_VAL := PRT_VAL + ' ' //** P3N - 7/17/00 LEAVE THE SAME FOR ALL OTHER COPIES AT LINDS + ENDIF //** P3N - 7/17/00 + ELSEIF MHOME_LOC_CODE = 'KC' //** P3N - 7/18/00 LEAVE THE SAME FOR KC COPIES + PRT_VAL := PRT_VAL + ' ' //** P3N - 7/18/00 + ENDIF + IF RIGHT(WORKVAR,2) = '00' + IF EMPTY(NEGAMT) + PRT_VAL := PRT_VAL + STR(PAMTS_ARR[4], 8, 2) //POSITIVE ITEM AMT + ELSE + PRT_VAL := PRT_VAL + NEGAMT //(NEGATIVE) ITEM AMT + ENDIF + IF MHOME_LOC_CODE = 'KC' + PRT_VAL := PRT_VAL + ' ' + ENDIF + IF EMPTY(NEGTOT) //POSITIVE TOTAL AMT + IF CUR_MAST == 'ORD_MAST' .AND. WHCHORDER == 'INV' .AND. PARTIAL_INVOICE + PRT_VAL := PRT_VAL + STR( SHPQTY * PAMTS_ARR[4], 13, 2 ) + ELSEIF CUR_MAST == 'ORD_MAST' .AND. WHCHORDER == 'INV' .AND. REPRINT_INVOICE + PRT_VAL := PRT_VAL + STR( INVQTY * PAMTS_ARR[4], 13, 2 ) + ELSE + PRT_VAL := PRT_VAL + STR( PAMTS_ARR[1] * PAMTS_ARR[4], 13, 2 ) + ENDIF + ELSE + PRT_VAL := PRT_VAL + NEGTOT //(NEGATIVE) TOTAL AMT + ENDIF + ELSE + IF EMPTY(NEGAMT) //POSITIVE AMT + PRT_VAL := PRT_VAL + STR(PAMTS_ARR[4], 9, 4) //MISC 9.9999 ITEM AMT + ELSE + PRT_VAL := PRT_VAL + NEGAMT //MISC 9.9999 ITEM AMT + ENDIF + IF MHOME_LOC_CODE = 'KC' + PRT_VAL := PRT_VAL + ' ' + ENDIF + IF EMPTY(NEGTOT) //POSITIVE TOTAL AMT + IF CUR_MAST == 'ORD_MAST' .AND. WHCHORDER == 'INV' .AND. PARTIAL_INVOICE + PRT_VAL := PRT_VAL + STR( SHPQTY * PAMTS_ARR[4], 12, 2 ) + ELSEIF CUR_MAST == 'ORD_MAST' .AND. WHCHORDER == 'INV' .AND. REPRINT_INVOICE + PRT_VAL := PRT_VAL + STR( INVQTY * PAMTS_ARR[4], 12, 2 ) + ELSE + PRT_VAL := PRT_VAL + STR( PAMTS_ARR[1] * PAMTS_ARR[4], 12, 2 ) + ENDIF + ELSE + PRT_VAL := PRT_VAL + NEGTOT //(NEGATIVE) TOTAL + ENDIF + ENDIF + ELSEIF EMPTY(XUOM) + PRT_VAL := PRT_VAL + PADR(ALLTRIM(BODY_DESC), PADSZ, ' ') //ITEM DESC + ELSE + PRT_VAL := PRT_VAL + PADR(XUOM + ALLTRIM(BODY_DESC), PADSZ, ' ') //ITEM DESC + ENDIF +ELSE +//** INVALID MISC ITEM ENTRY SIZE + PRT_VAL := MIENTRYSZ+' '+ PADR(XUOM + ALLTRIM(BODY_DESC), PADSZ, ' ') //ITEM DESC +ENDIF +RETURN PRT_VAL +************************************************** +************************************************** +************************************************** +*************************************************************** +//* PRINT THE ORDER AS DEFINED IN THE PASSED ARRAYS +*************************************************************** +FUNCTION PROCESS_OO(PHEAD_ARR, PBODY_ARR, PTAIL_ARR, PAMTS_ARR, SUBTYPE, ; + PRT_GL_INFO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE, OUTMODE) +LOCAL I:= 0, PG_NUM := 0, LINE_CNT := 0, LINES_DONE := 0, PASSHEAD := {} +LOCAL SV_LI_DESC := {}, TAILERR, WKNOTEARR, N := 0 +LOCAL PG_DEF_ARR := CALC_PAGES(PBODY_ARR, PTAIL_ARR) +LOCAL TOTL_PAGES := LEN(PG_DEF_ARR) +LOCAL WKNOTES := '', PRNTLEN := 55 //** P3N - 12/22/00 +LOCAL RETVARARR := {}, II := 0 //** P3N - 12/22/00 +//** ADDRESS LINDS DELIVERY COPY PRINT ANOMALLY //** P3N - 7/12/00 +LOCAL SVLMAR := MLMAR //** P3N - 7/12/00 + + +IF EMPTY(PRINTERS->SP10) //** P3N - 05/16/01 + TSTPRT := '' //** P3N - 05/16/01 +ELSE //** FOR TESTING WITH EPSON LQ-500 //** P3N - 05/16/01 + TSTPRT := ALLTRIM(PRINTERS->SP10) //** P3N - 05/16/01 + TSTPRT := &TSTPRT //** P3N - 05/16/01 + ?? TSTPRT //** P3N - 05/16/01 +ENDIF //** P3N - 05/16/01 +IF MHOME_LOC_CODE == 'LINDS ' //** P3N - 7/12/00 + IF SUBTYPE == 'DELIVERY' //** P3N - 7/12/00 + MLMAR := SPACE( LEN(MLMAR) - 5 ) //** P3N - 7/12/00 + ENDIF //** P3N - 7/12/00 +ENDIF //** P3N - 7/12/00 +IF TOTL_PAGES = 0 + RETURN +ENDIF +IF PG_DEF_ARR[TOTL_PAGES, 2] + LEN(PTAIL_ARR) > MBODY_LEN + TOTL_PAGES := TOTL_PAGES + 1 +ENDIF +FOR I := 1 TO LEN(PG_DEF_ARR) + IF OUTMODE == 'PRINT' //** P3N - 12/14/98 + IF !EJECT_MSG() + RETURN + ENDIF + ENDIF + FOR II := 1 TO MTMAR + ? // PRINT THE TOP MARGIN LINES AS DEFINED IN + NEXT // THE CONTROL FILE FIELD TMAR + PG_NUM := PG_NUM + 1 + + //* THE CUSTOMER INVOICE MUST FIT ON THE EXISTING ORDER FORM + PRT_HEAD(PHEAD_ARR, PG_NUM, TOTL_PAGES, SUBTYPE ) + IF I <= LEN(PG_DEF_ARR) + LINE_CNT := PG_DEF_ARR[I,2] + IF EMPTY(SV_LI_DESC) .OR. EMPTY(LINES_DONE) + SV_LI_DESC := ; + PRT_BODY(PBODY_ARR, PG_DEF_ARR[I, 2], LINES_DONE, PAMTS_ARR, , ; + SUBTYPE, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE) + ELSE + SV_LI_DESC := ; + PRT_BODY(PBODY_ARR, PG_DEF_ARR[I, 2], LINES_DONE, PAMTS_ARR, ; + SV_LI_DESC, SUBTYPE, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE ) + IF PG_NUM == TOTL_PAGES + SV_LI_DESC := {} // CLEAR LINE ITEM DESC FOR NEXT PRODUCT + ENDIF + ENDIF + LINES_DONE := LINES_DONE + PG_DEF_ARR[I,2] + ENDIF + //** FIXED NOTE FIELD ON ORDER SCREEN + IF !EMPTY( (CUR_MAST)->NOTE_FIELD ) .AND. (CUR_MAST)->PRNT_NOTES$'Y' + //PRT ORDER MASTER ONE LINE NOTE - UP TO 5 LINES OF 55 BYTES / 254 CHARS. TOTAL +//**? SPACE(15) + ALLTRIM((CUR_MAST)->NOTE_FIELD) //** P3N - 12/22/00 + WKNOTES := (CUR_MAST)->NOTE_FIELD //** P3N - 12/22/00 + RETVARARR := PRT_MEMO({}, {}, WKNOTES, PRNTLEN) // PRINT THE ORDER MASTER NOTES + IF EMPTY(RETVARARR) //** P3N - 12/22/00 + ELSE //** P3N - 12/22/00 + WKNOTES := RETVARARR[1] //** P3N - 12/22/00 + FOR II := 1 TO LEN(WKNOTES) //** P3N - 12/22/00 + IF EMPTY(WKNOTES[II]) //** P3N - 05/15/01 + ELSE //** P3N - 05/15/01 + ? SPACE(15) + WKNOTES[II] //** P3N - 12/22/00 + ENDIF //** P3N - 05/15/01 + NEXT //** P3N - 12/22/00 + ENDIF //** P3N - 12/22/00 + ENDIF + IF LEN(PG_DEF_ARR) < TOTL_PAGES .OR. I < LEN(PG_DEF_ARR) + ?? CHR(13) + CHR(10) + EJECT + ENDIF +NEXT +IF LEN(PG_DEF_ARR) < TOTL_PAGES + IF OUTMODE == 'PRINT' //** P3N - 12/14/98 + IF !EJECT_MSG() + RETURN + ENDIF + ENDIF + PG_NUM := PG_NUM + 1 + PRT_HEAD(PHEAD_ARR, PG_NUM, TOTL_PAGES, SUBTYPE ) + LINES_DONE := 0 +ELSE + LINES_DONE := PG_DEF_ARR[TOTL_PAGES,2] +ENDIF +TAILERR := PRT_TAIL(PTAIL_ARR, LINES_DONE, PRT_GL_INFO, WHCHORDER, SUBTYPE, PG_DEF_ARR ) +?? CHR(13) + CHR(10) +EJECT +IF EMPTY(TSTPRT) //** P3N - 05/16/01 +ELSE //** SET BACK TO 10 PITCH (CPI) //** P3N - 05/16/01 + TSTPRT := SP10 //** P3N - 05/16/01 +ENDIF //** P3N - 05/16/01 +IF EMPTY(TAILERR) +ELSE + SET_P_OFF() + IF PRT_GL_INFO .AND. TAILERR < 3 + ERR_BOX('** Can NOT print GL entries on bottom of this Order! **') + ELSE + ERR_BOX('** Can NOT print ENTIRE Invoice Msg on the bottom of this Order! **') + ENDIF +ENDIF +MLMAR := SVLMAR //** P3N - 7/12/00 +RETURN +************************************************************* +************************************************************* +************************************************************* +FUNCTION EJECT_MSG() +// NOTE THAT FORMTYPE MAY = 'PREPRINT-TRACTOR' - THUS BYPASS THIS LOGIC +IF FORMTYPE == 'PREPRINT' // PRE-PRINTED FORMS + IF MSING_SHEET == 'Y' // SINGLE SHEET FEED + //SEND MSG FOR PAUSE + SET_P_OFF(.F.) // DON'T CHANGE PRINTER PORT ASSIGNMENT + ?? CHR(7) + @ 23,0 SAY 'Place PRE-PRINTED ORDER FORM in PRINTER - Then Any Key to CONTINUE.' + @ 24,0 SAY ' OR Press to CANCEL.' + CLEAR TYPEAHEAD + INKEY(0) //PAUSE + @23, 0 + @24, 0 + IF LASTKEY() = 27 + RETURN .F. + ENDIF + SET_P_ON() + ENDIF +ENDIF +RETURN .T. +*************************************************************** +//* PRINT THE ORDER HEADING +*************************************************************** +FUNCTION PRT_HEAD(PHEAD_ARR, PG_NUM, TOT_PAGES, SUBTYPE ) +LOCAL PG_HD := 'Page' + STR(PG_NUM,2) + ' OF ' + STR(TOT_PAGES,2), I_NUMPRT, I_LINE, I + +// I_NUMPRT := INVOICE NUMBER TO PRINT IN BOLD LETTERS +IF SUBTYPE <> 'PREBILL' ; + .AND. SUBTYPE <> 'PO' // SUPRESS ORDER NUMBER ON INTER-COMPANY PO'S PER DARLENE 6-26-20 + I_NUMPRT := &WIDEON + (CUR_MAST)->ORDER_NUM + &WIDEOFF +ELSE + I_NUMPRT := '' +ENDIF +IF MHOME_LOC_CODE = 'IOLA' + ? + ? +ENDIF +IF MHOME_LOC_CODE = 'LINDS' + I_LINE := 3 //NEW FORMS - ADJUST BASED ON THE LP_HEADING() FUNCTION! +ELSEIF MHOME_LOC_CODE = 'PAWNEE' //** P3N - 2/04/99 + IF FORMTYPE = 'PREPRINT' // PRE-PRINTED FORMS //** P3N - 2/04/99 + ? //** P3N - 2/04/99 + I_LINE := 5 //PAWNEE FORMS - ADJUST BASED ON THE LP_HEADING() FUNCTION! + ELSE + I_LINE := 1 + ENDIF +ELSE + I_LINE := 1 +ENDIF +FOR I := 1 TO LEN(PHEAD_ARR) + IF I = I_LINE + IF MHOME_LOC_CODE = 'IOLA' + ? PADR(MLMAR + PHEAD_ARR[I], 60) + I_NUMPRT + ELSEIF MHOME_LOC_CODE = 'KC' + IF AT('DUPLICATE', PHEAD_ARR[I]) > 0 //DUPLICATE INVOICE MSG + ? PADR(MLMAR + PHEAD_ARR[I], 63) + I_NUMPRT + ELSE + ? PADR(MLMAR + PHEAD_ARR[I], 70) + I_NUMPRT + ENDIF + ELSE + ? PADR(MLMAR + PHEAD_ARR[I], 66) + I_NUMPRT + ENDIF + ELSEIF I = I_LINE + 1 + IF MHOME_LOC_CODE = 'KC' + ? PADR(MLMAR + PHEAD_ARR[I], 70) + PG_HD + ELSEIF MHOME_LOC_CODE = 'PAWNEE' + IF SUBTYPE = 'DELIVERY' + ? PADR(MLMAR + PHEAD_ARR[I], 63) + PG_HD + ELSE + ? PADR(MLMAR + PHEAD_ARR[I], 66) + PG_HD + ENDIF + ELSEIF MHOME_LOC_CODE = 'LINDS' //** P3N - 7/12/00 + IF SUBTYPE = 'DELIVERY' .AND. ; //** P3N - 7/12/00 + AT('DUPLICATE', PHEAD_ARR[I]) > 0 //DUPLICATE INVOICE MSG + ? PADR(MLMAR + PHEAD_ARR[I], 59) + PG_HD //** P3N - 7/12/00 + ELSE //** P3N - 7/12/00 + ? PADR(MLMAR + PHEAD_ARR[I], 66) + PG_HD //** P3N - 7/12/00 + ENDIF //** P3N - 7/12/00 + ELSE + ? PADR(MLMAR + PHEAD_ARR[I], 66) + PG_HD + ENDIF + ELSE + ? MLMAR + PHEAD_ARR[I] + ENDIF +NEXT +RETURN +*************************************************************** +//* PRINT THE ORDER BODY +*************************************************************** +FUNCTION PRT_BODY(PBODY_ARR, LINE_CNT, LINES_DONE, PAMTS_ARR , SV_LI_DESC, ; + SUBTYPE, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE) +LOCAL I, CUR_LINE := LINES_DONE + 1, PRT_VAL +LOCAL PADSZ := 43, IOLAMAR := '', STRTPOS, II := 0, RET_VAL := SV_LI_DESC +IF FORMTYPE <> 'PREPRINT' .AND. !DO_WE_PRT_AMT( WHCHORDER, SUBTYPE ) //** P3N - 10/13/98 + PADSZ := 60 //** P3N - 10/13/98 +ENDIF //** P3N - 10/13/98 +FOR I := 1 TO LINE_CNT + IF LEFT(PBODY_ARR[CUR_LINE], 1) == '^' + SV_LI_DESC := {} //CLEAR LINE ITEM HEADING + IF EMPTY(SUBS(PBODY_ARR[CUR_LINE],2)) + ELSE + RET_VAL := SV_DESC_LINE_ITEM(PBODY_ARR, CUR_LINE) //FIND LINE ITEM HEADING + ENDIF + IF SUBS(PBODY_ARR[CUR_LINE], 2,1)$CHR(1) + STRTPOS := 3 + ELSE + STRTPOS := 2 + ENDIF + IF PAMTS_ARR[CUR_LINE] = NIL + // use entire line - no amounts will print + PRT_VAL := SPACE(15) + ALLTRIM(SUBS(PBODY_ARR[CUR_LINE], STRTPOS )) + ELSEIF EMPTY( PAMTS_ARR[CUR_LINE] ) + PRT_VAL := PBODY_ARR[CUR_LINE] // ITEM TOTAL LINE + ELSE + PRT_VAL := ALLTRIM(SUBS(PBODY_ARR[CUR_LINE], STRTPOS )) + PRT_VAL := FORMAT_PRT(PRT_VAL, PAMTS_ARR[CUR_LINE], PADSZ, SUBTYPE, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE ) + ENDIF + ELSE + IF !EMPTY(SV_LI_DESC) //PRINT LINE ITEM HEADING FOR MULTIPLE PAGES + IF EMPTY(II) // ONLY PRINT ONCE + FOR II := 1 TO LEN(SV_LI_DESC) + IF SUBS(SV_LI_DESC[II], 2,1)$CHR(1) + STRTPOS := 3 + ELSEIF SUBS(SV_LI_DESC[II], 1,1)$'^' + STRTPOS := 2 + ELSE + STRTPOS := 1 + ENDIF + PRT_VAL := SPACE(15) + ALLTRIM(SUBS(SV_LI_DESC[II], STRTPOS) ) + PRINT_BODY_LINE(IOLAMAR, MLMAR, PRT_VAL, 0) + NEXT + ENDIF + ENDIF + IF PAMTS_ARR[CUR_LINE] = NIL + PRT_VAL := SPACE(15) + ALLTRIM(PBODY_ARR[CUR_LINE]) + ELSEIF EMPTY( PAMTS_ARR[CUR_LINE] ) + PRT_VAL := PBODY_ARR[CUR_LINE] // ITEM TOTAL LINE + ELSE + PRT_VAL := FORMAT_PRT(PBODY_ARR[CUR_LINE], PAMTS_ARR[CUR_LINE], PADSZ, SUBTYPE, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE ) + ENDIF + ENDIF + CUR_LINE := PRINT_BODY_LINE(IOLAMAR, MLMAR, PRT_VAL, CUR_LINE) +NEXT +RETURN RET_VAL //LINE ITEM HEADING +*************************************************************** +* PRINT THE LINE ITEM LINE +*************************************************************** +FUNCTION PRINT_BODY_LINE(IOLAMAR, MLMAR, PRT_VAL, CUR_LINE) +? IOLAMAR + MLMAR + PRT_VAL +CUR_LINE++ +RETURN CUR_LINE +*************************************************************** +* SAVE THE LINE ITEM DESCRIPTION FOR PRINTING ON MULTIPLE PAGES +*************************************************************** +FUNCTION SV_DESC_LINE_ITEM(PBODY_ARR, CUR_LINE) +LOCAL RET_VAL := {}, I := CUR_LINE +DO WHILE I <= LEN(PBODY_ARR) .AND. !EMPTY(PBODY_ARR[I]) + IF SUBS(PBODY_ARR[I], 1,1)$'^' +//**AADD(RET_VAL, PBODY_ARR[I]) + FOR I := I TO LEN(PBODY_ARR) + IF EMPTY(PBODY_ARR[I]) + I := LEN(PBODY_ARR) + EXIT + ELSE + AADD(RET_VAL, PBODY_ARR[I]) + ENDIF + NEXT + ENDIF + I++ +ENDDO +IF EMPTY(RET_VAL) +ELSE + AADD(RET_VAL, ' ') // BLANK LINE BETWEEN LINE ITEM DESC AND THE +ENDIF +RETURN RET_VAL // LINE ITEM DETAIL +*************************************************************** +* FORMAT THE ORDER ITEM LINES +*************************************************************** +*************************************************************** +//* PRINT THE ORDER TAIL +*************************************************************** +FUNCTION PRT_TAIL (PTAIL_ARR, LINES_DONE, PRNT_GL_INFO, WHCHORDER, SUBTYPE, PG_DEF_ARR ) +LOCAL I, STOPVAR, X, WKI, WKGLAMT, NEGTOT, WKTAIL, WORKARR, TAILERR := 0 +LOCAL RETVARARR := {}, PRNT_LEN := 80, WINV_NOTE := ' ', MSGCNT := 0 +LOCAL DEFAULT_NOTE := DEFAULTNOTE() +LOCAL INVNOTEPOS := DEFAULT_NOTE[2] +LOCAL NOTE_LEN := 0 //** P3N - 05/15/01 +IF EMPTY(PTAIL_ARR) + RETURN TAILERR +ENDIF +IF EMPTY( (CUR_MAST)->NOTE_FIELD ) //** P3N - 05/15/01 +ELSEIF (CUR_MAST)->PRNT_NOTES$'Y' //** P3N - 05/15/01 + //** TAKE INTO ACCOUNT THE ORDER MASTER->NOTE_FIELD (UP TO 5 LINES OF 50 CHARS) + NOTE_LEN := INT (LEN(ALLTRIM( (CUR_MAST)->NOTE_FIELD) ) / 50 ) + LINES_DONE := LINES_DONE + NOTE_LEN + 1 //** P3N - 05/15/01 +ENDIF //** P3N - 05/15/01 +WORKARR := {} +//** THE QUOTE HEADING IS LONGER THAN THE ORDER HEADING +//** INCREASE THE LINES_DONE TO ACCOUNT FOR THIS DIFF. +IF CUR_MAST = 'QUOTE' //** P3N - 1/6/99 + LINES_DONE := LINES_DONE + 8 //** P3N - 1/6/99 +ENDIF //** P3N - 1/6/99 +FOR I := LINES_DONE + 1 TO MAX(MBODY_LEN, LEN(PTAIL_ARR) ) + AADD(WORKARR, '') +NEXT +IF LEN(WORKARR) < LEN(PTAIL_ARR) + FOR I := 1 TO LEN(PTAIL_ARR) + //** P3N - 4/20/98 NONTAX ITEM + IF AT(' ~ ',PTAIL_ARR[I]) > 0 + //** P3N - 6/8/98 ADJ NONTAX ITEM FORMATING + WKTAIL := STRTRAN(PTAIL_ARR[I], '~', ' ' ) + ? MLMAR + WKTAIL + ELSE + ? MLMAR + SPACE(5) + PTAIL_ARR[I] + ENDIF + NEXT + TAILERR := 1 +ELSE + FOR I := 1 TO LEN(PTAIL_ARR) + WORKARR[I] := PTAIL_ARR[I] + NEXT + IF PRNT_GL_INFO + STOPVAR := LEN(WORKARR) - LEN(GL_ARR) + X := LEN(GL_ARR) + FOR I := LEN(WORKARR) TO MAX(STOPVAR, 1) STEP -1 + IF X > 0 .AND. X <= LEN(GL_ARR) + IF GL_ARR[X,2] < 0 //** P3N - 4/28/98 + NEGTOT := TRANSFORM(GL_ARR[X,2],'(9999999999999999.99)') //**P3N 4/28/98 + NEGTOT := STRTRAN(NEGTOT, ' ', '') //** P3N - 4/28/98 + NEGTOT := STRTRAN(NEGTOT, '-', '') //** P3N - 4/28/98 + NEGTOT := PADL(NEGTOT,11, ' ') //** P3N - 4/28/98 + ELSE + NEGTOT := '' //** P3N - 6/3/98 + ENDIF + + IF EMPTY(NEGTOT) //** P3N - 4/28/98 + IF GL_ARR[X,2] <= 999999.99 //** P3N - 4/28/98 + WKGLAMT := STR(GL_ARR[X,2],10,2) //** P3N - 4/28/98 + ELSE //** P3N - 4/28/98 + WKGLAMT := STR(GL_ARR[X,2],16,2) //** P3N - 4/28/98 + ENDIF //** P3N - 4/28/98 + ELSE //** P3N - 4/28/98 + WKGLAMT := NEGTOT //** P3N - 4/28/98 + ENDIF //** P3N - 4/28/98 + + IF EMPTY(SUBST(WORKARR[I], 1, 40) ) //** P3N - 11/25/98 + WORKARR[I] := PADR(GL_ARR[X,1],10) + WKGLAMT ; + + SUBS(WORKARR[I],21) //** P3N - 12/10/98 +//** + SUBS(WORKARR[I],19) //** P3N - 12/10/98 + ELSE //** P3N - 11/25/98 + WKI := LEN(WORKARR) + WORKARR[WKI] := 'GL ALLOCATIONS WILL NOT FIT ON ORDER' + WORKARR[WKI-1] := 'GL ALLOCATIONS WILL NOT FIT ON ORDER' + WORKARR[WKI-2] := 'GL ALLOCATIONS WILL NOT FIT ON ORDER' + WORKARR[WKI-3] := 'GL ALLOCATIONS WILL NOT FIT ON ORDER' + //** P3N - 11/25/98 + //** P3N - 11/25/98 + TAILERR := 2 //** P3N - 11/25/98 + EXIT //** P3N - 11/25/98 + ENDIF + ELSE + EXIT + ENDIF + X -- + NEXT + ENDIF + FOR I := 1 TO LEN(WORKARR) + //** P3N - 4/20/98 NONTAX ITEM + IF AT(' ~ ',WORKARR[I]) > 0 + //** P3N - 6/8/98 ADJ NONTAX ITEM FORMATING + WKTAIL := STRTRAN(WORKARR[I], '~', ' ' ) + ? MLMAR + WKTAIL + ELSE + ? MLMAR + SPACE(5) + WORKARR[I] + ENDIF + NEXT +ENDIF + +IF WHCHORDER = 'INV' .AND. EMPTY(SUBTYPE) //** P3N - 12/15/98 + FOR I := 1 TO INVNOTEPOS //** P3N - 12/16/98 + ? MLMAR + SPACE(5) //** P3N - 12/16/98 + NEXT //** P3N - 12/16/98 + //** PRINT THE TAIL(ORD_MAST->INVNOTES) INVOICE/SOLICITATION INFO FOR ORDERS + IF EMPTY( (CUR_MAST)->INVNOTES ) //** P3N - 12/15/98 + WINV_NOTE := DEFAULT_NOTE[1] //** P3N - 12/16/98 + ELSE + WINV_NOTE := (CUR_MAST)->INVNOTES //** P3N - 12/15/98 + ENDIF + RETVARARR := PRT_MEMO({}, {}, WINV_NOTE, PRNT_LEN) // PRINT THE LINE ITEM NOTES + IF EMPTY(RETVARARR) //** P3N - 12/15/98 + ELSE //** P3N - 12/15/98 + FOR I := 1 TO LEN(RETVARARR[1]) //** P3N - 12/15/98 + IF EMPTY(RETVARARR[1,I]) //** P3N - 12/15/98 + LOOP //** P3N - 12/15/98 + ENDIF //** P3N - 12/15/98 + MSGCNT := MSGCNT + 1 //** P3N - 12/15/98 + IF MSGCNT <= 3 //** P3N - 12/15/98 + ? MLMAR + RETVARARR[1,I] //** P3N - 12/15/98 + PTAIL_ARR := RETVARARR[1,I] //** P3N - 12/15/98 + ELSE //** P3N - 12/15/98 + TAILERR := 3 //** P3N - 12/15/98 + EXIT //** P3N - 12/15/98 + ENDIF //** P3N - 12/15/98 + NEXT //** P3N - 12/15/98 + ENDIF //** P3N - 12/15/98 +ENDIF //** P3N - 12/15/98 +RETURN TAILERR +*********************************************************** +* BUILD THE HEADING OF THE ORDER +*********************************************************** +PROCEDURE BLD_HEAD(MORDER_NUM, ORD_TYPE, OLOC_CODE, WHCHORDER, SUBTYPE) +LOCAL PHEAD_ARR := {}, PV := ' ', I := 0 ,HD1ARR := {}, III +LOCAL HD2ARR := {}, WORKVAR, MPO_NUM, HD3ARR := {} +LOCAL DUPL_MSG := {' ', ' ' , ' ' } , HD_LINES := 0 +LOCAL MTIME, MDATE, MAXLEN := 0 +ALTSHIPADR->(DBSEEK( (CUR_MAST)->ORDER_NUM) ) //** P3N - 1/6/99 +HD1ARR := HD1_PART(ORD_TYPE, OLOC_CODE, WHCHORDER, SUBTYPE) +HD2ARR := HD2_PART(ORD_TYPE, OLOC_CODE) +IF ORD_TYPE == 'BACKORD' //** P3N - 9/14/98 + HD2ARR := HD2_PART(ORD_TYPE, OLOC_CODE, SUBTYPE) //** P3N - 9/14/98 +ENDIF //** P3N - 9/14/98 +HD3ARR := HD3_PART(ORD_TYPE, SUBTYPE) +DO CASE //** P3N - 4/30/98 CHGD TO CASE STMT! + CASE WHCHORDER = 'INV' + IF !EMPTY((CUR_MAST)->IDATE_LAST) + IF SUBTYPE <> 'PREBILL' + DUPL_MSG := DUPL_MSG(ORD_TYPE, (CUR_MAST)->IDATE_LAST, (CUR_MAST)->ITIME_LAST ) + ENDIF + ENDIF + CASE WHCHORDER = 'PROD' + IF !EMPTY((CUR_MAST)->PDATE_LAST) + DUPL_MSG := DUPL_MSG(ORD_TYPE, (CUR_MAST)->PDATE_LAST, (CUR_MAST)->PTIME_LAST ) + ENDIF + CASE WHCHORDER = 'OD' + IF SUBTYPE = 'DELIVERY' .AND. !EMPTY( (CUR_MAST)->DDATE_LAST ) + DUPL_MSG := DUPL_MSG(SUBTYPE, (CUR_MAST)->DDATE_LAST, (CUR_MAST)->DTIME_LAST ) + ELSEIF SUBTYPE = 'ORDERDESK' .AND. !EMPTY((CUR_MAST)->ODATE_LAST) + DUPL_MSG := DUPL_MSG(ORD_TYPE, (CUR_MAST)->ODATE_LAST, (CUR_MAST)->OTIME_LAST ) + ENDIF + CASE WHCHORDER = 'BACKORD' //* P3N - 4/30/98 + IF !EMPTY((CUR_MAST)->BODATE_LST) + DUPL_MSG := DUPL_MSG(ORD_TYPE, (CUR_MAST)->BODATE_LST, (CUR_MAST)->BOTIME_LST ) + ENDIF +ENDCASE +DO CASE + CASE FORMTYPE = 'PREPRINT' //PRE-PRINTED ORDER FORM + **** LINDSBORG TOP HEADING +//**IF MHOME_LOC_CODE = 'LINDS' //** P3N - 2/04/99 + IF MHOME_LOC_CODE = 'LINDS' .OR. MHOME_LOC_CODE = 'PAWNEE' +//** PHEAD_ARR := LINDS_HEADING(MORDER_NUM, DUPL_MSG, WHCHORDER, SUBTYPE ) + PHEAD_ARR := LP_HEADING(MORDER_NUM, DUPL_MSG, WHCHORDER, SUBTYPE ) + ELSE + FOR III := 1 TO LEN(DUPL_MSG) + AADD(PHEAD_ARR, SPACE(25) + DUPL_MSG[III]) + NEXT + PV := SUBS( (CUR_MAST)->CUST_ID,1,2) + ' ' + PV := PV + SUBS( (CUR_MAST)->CUST_ID,3,4) + ' ' + PV := PV + SUBS( (CUR_MAST)->CUST_ID,7,2) + IF WHCHORDER = 'BACKORD' //* P3N - 8/12/98 + AADD(PHEAD_ARR, ' ' ) + AADD(PHEAD_ARR, ' ' ) + IF MHOME_LOC_CODE <> 'IOLA' + AADD(PHEAD_ARR, ' ') + AADD(PHEAD_ARR, ' ') + ENDIF + ELSE + IF MHOME_LOC_CODE = 'KC' + AADD(PHEAD_ARR, PADL( PV, 81, ' ' ) ) + ELSE + AADD(PHEAD_ARR, PADL( PV, 78, ' ' ) ) + ENDIF + IF MHOME_LOC_CODE <> 'IOLA' + AADD(PHEAD_ARR, TRIM(MORDER_NUM) ) + ENDIF + IF MHOME_LOC_CODE <> 'IOLA' + AADD(PHEAD_ARR, ' ') + ENDIF + AADD(PHEAD_ARR, (CUR_MAST)->USER_ID ) + ENDIF + IF MHOME_LOC_CODE = 'KC' + AADD(PHEAD_ARR, ' ') + AADD(PHEAD_ARR, ' ') + ENDIF + ENDIF + IF MHOME_LOC_CODE = 'IOLA' + AADD(PHEAD_ARR, ' ') + ENDIF + FOR I := 1 TO LEN(HD2ARR) + AADD(PHEAD_ARR, HD2ARR[I]) + NEXT + ** MAXLEN := 4 // 1-31-97 - EXTRA LINE FOR IOLA ABOVE HEAD2 + IF MHOME_LOC_CODE = 'KC' + MAXLEN := 5 + ELSE + MAXLEN := 4 + ENDIF + FOR I := LEN(HD2ARR)+1 TO MAXLEN + AADD(PHEAD_ARR, ' ') + NEXT + FOR I := 1 TO LEN(HD3ARR) + AADD(PHEAD_ARR, HD3ARR[I]) + NEXT + IF LEN(PHEAD_ARR) < MHEAD_LEN + HD_LINES := MHEAD_LEN - LEN(PHEAD_ARR) + FOR I := 1 TO HD_LINES + AADD(PHEAD_ARR, ' ' ) + NEXT + ENDIF + OTHERWISE // BLANK PAPER DOCUMENT + FOR I := 1 TO LEN(HD1ARR) + AADD(PHEAD_ARR, HD1ARR[I]) + NEXT + FOR III := 1 TO LEN(DUPL_MSG) + AADD(PHEAD_ARR, DUPL_MSG[III]) + NEXT + IF ORD_TYPE = 'PO' +//** MPO_NUM := GET_PO_NUM( MORDER_NUM, OLOC_CODE , .T. ) +//** AADD(PHEAD_ARR, PADL('PO #: ' + ALLTRIM(MPO_NUM), 78, ' ') ) + AADD(PHEAD_ARR, ' ' ) //** P3N - 04/06/10 - PER ELLEN - REMOVE PO #: PRINT + AADD(PHEAD_ARR, ' ' ) + AADD(PHEAD_ARR, PADL('Order #: ' + ALLTRIM(MORDER_NUM), 78, ' ') ) + AADD(PHEAD_ARR, ' ' ) + PV := 'Customer : ' + PV := PV + ALLTRIM((CUR_MAST)->BILL_NAME) + AADD(PHEAD_ARR, PADL( PV, 78, ' ' ) ) + ELSE + AADD(PHEAD_ARR, PADL('Order #: ' + ALLTRIM(MORDER_NUM), 78, ' ') ) + AADD(PHEAD_ARR, ' ' ) + IF WHCHORDER = 'BACKORD' //* P3N - 6/5/98 + ELSE + PV := 'Customer #: ' + PV := PV + SUBS( (CUR_MAST)->CUST_ID,1,2) + ' ' + PV := PV + SUBS( (CUR_MAST)->CUST_ID,3,4) + ' ' + PV := PV + SUBS( (CUR_MAST)->CUST_ID,7,2) + AADD(PHEAD_ARR, PADL( PV, 78, ' ' ) ) + ENDIF + ENDIF + IF WHCHORDER = 'BACKORD' //* P3N - 6/5/98 + ELSE + AADD(PHEAD_ARR, (CUR_MAST)->USER_ID ) + ENDIF + FOR I := 1 TO LEN(HD2ARR) + AADD(PHEAD_ARR, HD2ARR[I]) + NEXT + FOR I := 1 TO LEN(HD3ARR) + AADD(PHEAD_ARR, HD3ARR[I]) + NEXT + IF LEN(PHEAD_ARR) < MHEAD_LEN .AND. FORMTYPE = 'PREPRINT' + HD_LINES := MHEAD_LEN - LEN(PHEAD_ARR) + FOR I := 1 TO HD_LINES + AADD(PHEAD_ARR, ' ' ) + NEXT + ENDIF +ENDCASE +RETURN PHEAD_ARR +************************************************************* +//** LP_HEADING IS USED FOR BOTH LINDSBOURG AND PAWNEE * +//** LOCATIONS * +************************************************************* +FUNCTION LP_HEADING( MORDER_NUM, DUPL_MSG, WHCHORDER, SUBTYPE ) +LOCAL PHEAD_ARR := {}, PV, I , III +//** DUPL_MSG := {' ',' ',' '} //** P3N - 6/17/99 +** 6-16-97 - USE OLD FORMS UNTIL FURTHER NOTICE - PER LINDA!!!!! +** FOR I := 1 TO 3 +** 1-23-98 - USE NEW FORMS PER LINDA!!!!! +IF WHCHORDER == 'INV' // NEW INVOICE ORDER FORM + FOR I := 1 TO 1 // FORM HEADING IS 2 LINES LESS THAN OLD + AADD(PHEAD_ARR, ' ') + NEXT + IF MHOME_LOC_CODE = 'PAWNEE' //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + ENDIF //** P3N - 2/04/99 +//**ELSEIF SUBTYPE = 'DELIVERY' .AND. ; // DELIVERY ORDER FORM +ELSEIF (SUBTYPE = 'DELIVERY' .OR. WHCHORDER = 'BACKORD') .AND. ; // DELIVERY/BACKORDER ORDER FORM + MHOME_LOC_CODE = 'PAWNEE' //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 + AADD(PHEAD_ARR, ' ') //** P3N - 2/04/99 +ELSE + FOR I := 1 TO 3 // ALL OTHER LINDS FORMS + AADD(PHEAD_ARR, ' ') + NEXT +ENDIF +FOR III := 1 TO LEN(DUPL_MSG) + IF III = 1 .OR. III = 3 + AADD(PHEAD_ARR, SPACE(25) + DUPL_MSG[III]) + ELSE + AADD(PHEAD_ARR, MORDER_NUM + SPACE(19) + DUPL_MSG[III]) + ENDIF +NEXT +PV := SUBS( (CUR_MAST)->CUST_ID,1,2) + ' ' +PV := PV + SUBS( (CUR_MAST)->CUST_ID,3,4) + ' ' +PV := PV + SUBS( (CUR_MAST)->CUST_ID,7,2) +AADD(PHEAD_ARR, (CUR_MAST)->USER_ID + SPACE(60) + PV ) +AADD(PHEAD_ARR, ' ') +RETURN PHEAD_ARR +*********************************************************** +*********************************************************** +*********************************************************** +FUNCTION HD1_PART( ORD_TYPE, OLOC_CODE, WHCHORDER, SUBTYPE ) +LOCAL PHEAD_ARR := {' ', ' ', ' '} +LOCAL FROM_LOC, PADLEN, Q_PHONE, QUOTE_LOC, QUOTE_LOC1, QUOTE_LOC2, QUOTE_LOC3 + +MFG_LOC->(DBSEEK(MHOME_LOC_CODE)) +FROM_LOC := 'From: ' + ALLTRIM(UPPER(MFG_LOC->LOC_DESC)) + ' ' ; + + ALLTRIM(UPPER(MFG_LOC->LOC_CITY)) + ' ' + MFG_LOC->LOC_STATE ; + + ' ' + ALLTRIM(MFG_LOC->LOC_ZIP) +QUOTE_LOC := 'From: ' + ALLTRIM(UPPER(MFG_LOC->LOC_DESC)) +QUOTE_LOC1 := ' ' + ALLTRIM(UPPER(MFG_LOC->LOC_ADDR1)) +QUOTE_LOC2 := ' ' + ALLTRIM(UPPER(MFG_LOC->LOC_ADDR2)) +QUOTE_LOC3 := ' ' + ALLTRIM(UPPER(MFG_LOC->LOC_CITY)) + ' ' + MFG_LOC->LOC_STATE ; + + ' ' + ALLTRIM(MFG_LOC->LOC_ZIP) +DO CASE + CASE FORMTYPE = 'PREPRINT' // PRE-PRINTED ORDER FORM + PHEAD_ARR := {} + IF MHOME_LOC_CODE <> 'KC' + AADD(PHEAD_ARR, ' ') + ENDIF + IF MHOME_LOC_CODE = 'IOLA' + AADD(PHEAD_ARR, ' ') + ENDIF + CASE ORD_TYPE = 'BACKORD' //** 4-30-98 + IF SUBTYPE == 'SCREENS' + AADD(PHEAD_ARR, PADC('B A C K O R D E R S C R E E N S', 80 ) ) + AADD(PHEAD_ARR, PADC('----------------------------------', 80 ) ) + ELSEIF SUBTYPE == 'STORMS' + AADD(PHEAD_ARR, PADC('B A C K O R D E R S T O R M S', 80 ) ) + AADD(PHEAD_ARR, PADC('--------------------------------', 80 ) ) + ELSE + AADD(PHEAD_ARR, PADC('B A C K O R D E R', 80 ) ) + AADD(PHEAD_ARR, PADC('------------------', 80 ) ) + ENDIF + CASE ORD_TYPE = 'PO' + AADD(PHEAD_ARR, PADC('I N T E R C O M P A N Y P U R C H A S E O R D E R', 80 ) ) + AADD(PHEAD_ARR, PADC('-----------------------------------------------------', 80 ) ) + CASE ORD_TYPE == 'CTRL' // PRINT PRODUCTION ORDER + IF WHCHORDER == 'OD' + IF SUBTYPE == 'DELIVERY' + AADD(PHEAD_ARR, PADC('D E L I V E R Y C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-------------------------', 80) ) + ELSE + AADD(PHEAD_ARR, PADC('O R D E R D E S K - C O N T R O L C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('---------------------------------------------', 80) ) + ENDIF + ELSE + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - C O N T R O L C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('---------------------------------------------------------', 80) ) + ENDIF + CASE ORD_TYPE == 'INV' // PRINT CUSTOMER ORDER + IF CUR_MAST = 'QUOTE' + AADD(PHEAD_ARR, PADC( 'C U S T O M E R Q U O T E' , 80) ) + AADD(PHEAD_ARR, PADC(QUOTE_LOC , 80 ) ) + AADD(PHEAD_ARR, PADC(QUOTE_LOC1, 80 ) ) + IF EMPTY(QUOTE_LOC2) + ELSE + AADD(PHEAD_ARR, PADC(QUOTE_LOC2, 80 ) ) + ENDIF + AADD(PHEAD_ARR, PADC(QUOTE_LOC3, 80 ) ) + Q_PHONE := 'Phone: ' + MFG_LOC->PHONE_NUM + Q_PHONE := Q_PHONE + ' Fax: '+ MFG_LOC->FAX_NUMBER + AADD(PHEAD_ARR, ' ' + PADC( Q_PHONE, 80 ) ) + PADLEN := MAX( LEN(FROM_LOC), LEN(Q_PHONE) ) + AADD(PHEAD_ARR, ' ' + PADC( REPLICATE('-', PADLEN) , 80 ) ) + //** P3N - 01/16/02 PER LINDA @ LINDS - ADDED THE CONT_FNAME TO PRINT ON THE QUOTE + IF EMPTY( (CUR_MAST)->CONT_FNAME ) //** P3N - 01/16/02 + ELSE //** P3N - 01/16/02 + AADD(PHEAD_ARR,' '+PADL('Ordered By: '+(CUR_MAST)->CONT_FNAME,77,' ')) //** P3N - 01/16/02 + ENDIF //** P3N - 01/16/02 + ELSEIF SUBTYPE = 'PREBILL' + AADD(PHEAD_ARR, PADC( 'C U S T O M E R P R E B I L L', 80 ) ) + AADD(PHEAD_ARR, PADC( FROM_LOC , 80 ) ) + PADLEN := MAX( LEN(FROM_LOC), 31 ) + AADD(PHEAD_ARR, PADC( REPLICATE('-', PADLEN) , 80 ) ) + ELSEIF SUBTYPE = 'PRECOST' + AADD(PHEAD_ARR, PADC( 'P R E - C O S T C O P Y ', 80 ) ) + AADD(PHEAD_ARR, PADC( FROM_LOC , 80 ) ) + PADLEN := MAX( LEN(FROM_LOC), 31 ) + AADD(PHEAD_ARR, PADC( REPLICATE('-', PADLEN) , 80 ) ) + ELSE + AADD(PHEAD_ARR, SPACE(25) + 'C U S T O M E R I N V O I C E' ) + AADD(PHEAD_ARR, SPACE(25) + '-------------------------------' ) + ENDIF + CASE ORD_TYPE == 'FRAME' // PRINT FRAME ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - F R A M E C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-----------------------------------------------------', 80 ) ) + CASE ORD_TYPE == 'STDFRAME' // PRINT STD FRAME ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - S T D F R A M E C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-------------------------------------------------------------', 80 ) ) + CASE ORD_TYPE == 'SASH' // PRINT SASH ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - S A S H C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('---------------------------------------------------', 80 ) ) + CASE ORD_TYPE == 'GLASS' // PRINT GLASS ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - G L A S S C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-----------------------------------------------------', 80 ) ) + CASE ORD_TYPE == 'SCREEN' // PRINT SCREEN ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - S C R E E N C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-------------------------------------------------------', 80 )) + CASE ORD_TYPE == 'STORM' // PRINT STORM ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - S T O R M C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-----------------------------------------------------', 80 ) ) + CASE ORD_TYPE == 'EXPANDER' // PRINT EXPANDER ORDER + AADD(PHEAD_ARR, OLOC_CODE ) + AADD(PHEAD_ARR, PADC('P R O D U C T I O N O R D E R - E X P A N D E R C O P Y', 80 ) ) + AADD(PHEAD_ARR, PADC('-----------------------------------------------------------', 80 ) ) + OTHERWISE + AADD(PHEAD_ARR, 'UNDEFINED Order' ) + AADD(PHEAD_ARR, ' ') +ENDCASE + +RETURN PHEAD_ARR +*********************************************************** +* BUILD THE BILL TO/SHIP TO PART OF THE ORDER +*********************************************************** +FUNCTION HD2_PART(ORD_TYPE, OLOC_CODE, SUBTYPE ) +LOCAL PHEAD_ARR := {},FROM_LOC, PDESC, PPHONE, PFAXC, PMODM, OLOC +LOCAL BIL_ARR := {}, SHP_ARR := {}, I, II , PADLEN, AS_ARR := {} +IF ORD_TYPE == 'PO' + PADLEN := 40 +ELSE + PADLEN := 48 +ENDIF +MFG_LOC->(DBSEEK(MHOME_LOC_CODE)) +FROM_LOC := MFG_LOC->LOC_DESC +PDESC := MFG_LOC->LOC_DESC +PPHONE := MFG_LOC->PHONE_NUM +PFAX := MFG_LOC->FAX_NUMBER +PMODM := MFG_LOC->MODEM_NUM +MFG_LOC->(DBSEEK(OLOC_CODE)) +OLOC := ALLTRIM(MFG_LOC->LOC_DESC) +DO CASE + CASE ORD_TYPE == 'PO' + PADLEN := 40 + AADD(BIL_ARR, 'Taken: ' + DTOC( (CUR_MAST)->CALL_DATE ) ) + AADD(BIL_ARR, 'From: ' + PDESC ) + + AADD(SHP_ARR, ' To: ' + MFG_LOC->LOC_DESC) + AADD(SHP_ARR, ' ' + TRIM(MFG_LOC->LOC_ADDR1) ) + IF !EMPTY(MFG_LOC->LOC_ADDR2) + AADD(SHP_ARR, ' ' + TRIM(MFG_LOC->LOC_ADDR2) ) + ENDIF + AADD(SHP_ARR, ' ' + TRIM(MFG_LOC->LOC_CITY) + SPACE(2) + ; + TRIM(MFG_LOC->LOC_STATE) + ' ' + MFG_LOC->LOC_ZIP ) + OTHERWISE + IF EMPTY( (CUR_MAST)->CALL_DATE) .OR. ORD_TYPE == 'BACKORD' + AADD(BIL_ARR, SPACE(12) + (CUR_MAST)->BILL_NAME + SPACE(6)) + ELSE + AADD(BIL_ARR, DTOC( (CUR_MAST)->CALL_DATE ) + SPACE(4) + (CUR_MAST)->BILL_NAME ) + ENDIF + + IF ORD_TYPE == 'BACKORD' .AND. ; //** P3N - 6/5/98 + MHOME_LOC_CODE = 'KC' //** P3N - 03/09/99 + SHP_ARR := ALTSHP(SHP_ARR, SUBTYPE) //** P3N - 03/09/99 + IF EMPTY(SHP_ARR) + AADD(SHP_ARR, (CUR_MAST)->BILL_ADD1 ) //** P3N - 11/11/98 + AADD(SHP_ARR, (CUR_MAST)->BILL_ADD2 ) //** P3N - 11/11/98 + AADD(SHP_ARR, (CUR_MAST)->BILL_CSZ ) //** P3N - 11/11/98 + AADD(SHP_ARR, (CUR_MAST)->PHONE ) //** P3N - 11/11/98 + ENDIF + //** END BACKORDER + ELSE + AADD(BIL_ARR, SPACE(12) + (CUR_MAST)->BILL_ADD1 + SPACE(6) ) + IF !EMPTY( (CUR_MAST)->BILL_ADD2 ) + AADD(BIL_ARR, SPACE(12) + (CUR_MAST)->BILL_ADD2 + SPACE(6) ) + ENDIF + AADD(BIL_ARR, SPACE(12) + (CUR_MAST)->BILL_CSZ + SPACE(6) ) + + IF (CUR_MAST)->BILL_NAME == (CUR_MAST)->SHIP_NAME + ELSEIF !EMPTY( (CUR_MAST)->SHIP_NAME ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_NAME ) + ENDIF + IF (CUR_MAST)->BILL_ADD1 == (CUR_MAST)->SHIP_ADD1 + ELSEIF !EMPTY( (CUR_MAST)->SHIP_ADD1 ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_ADD1 ) + ENDIF + IF !EMPTY( (CUR_MAST)->SHIP_ADD2 ) + IF (CUR_MAST)->BILL_ADD2 == (CUR_MAST)->SHIP_ADD2 + ELSEIF !EMPTY( (CUR_MAST)->SHIP_ADD2 ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_ADD2 ) + ENDIF + ENDIF + IF (CUR_MAST)->BILL_CSZ == (CUR_MAST)->SHIP_CSZ + ELSEIF !EMPTY( (CUR_MAST)->SHIP_CSZ ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_CSZ ) + ENDIF + IF (CUR_MAST)->PHONE == (CUR_MAST)->SHIPPHN + AADD(SHP_ARR, (CUR_MAST)->PHONE ) + ELSE + AADD(SHP_ARR, (CUR_MAST)->PHONE + ' / ' + (CUR_MAST)->SHIPPHN ) + ENDIF + ENDIF + //** P3N - 03/09/99 + IF ORD_TYPE == 'BACKORD' //** P3N - 03/09/99 + IF MHOME_LOC_CODE = 'KC' //** P3N - 03/09/99 + //** ALREADY FORMATED FOR THE BACK ORDER FORMS IN KC + ELSE //** P3N - 03/09/99 + AS_ARR := ALTSHP(AS_ARR, SUBTYPE) //** P3N - 03/09/99 + IF EMPTY(AS_ARR) //** P3N - 03/09/99 + ELSE //** P3N - 03/09/99 + SHP_ARR := AS_ARR //** P3N - 03/09/99 + ENDIF //** P3N - 03/09/99 + ENDIF //** P3N - 03/09/99 + ENDIF //** P3N - 03/09/99 +ENDCASE +FOR I := 1 TO MIN( LEN(BIL_ARR), LEN(SHP_ARR) ) + BIL_ARR[I] := PADR( BIL_ARR[I], PADLEN ) + AADD(PHEAD_ARR, BIL_ARR[I] + SHP_ARR[I] ) +NEXT +IF LEN(BIL_ARR) <> LEN(SHP_ARR) + IF I > LEN(BIL_ARR) + FOR I := I TO LEN(SHP_ARR) + AADD(PHEAD_ARR, SPACE(PADLEN) + SHP_ARR[I] ) + NEXT + ELSE + FOR I := I TO LEN(BIL_ARR) + BIL_ARR[I] := PADR( BIL_ARR[I], PADLEN ) + AADD(PHEAD_ARR, BIL_ARR[I] ) + NEXT + ENDIF +ENDIF +//** PER LINDA @ LINDS PRINT THE DELIVERY ROUTE INFORMATION - LINDS ONLY +//**IF MHOME_LOC_CODE = 'LINDS' //** P3N - 08/26/99 +//** AADD(PHEAD_ARR, SPACE(35)+ 'Del Route: ' + (CUR_MAST)->DEL_ROUTE) +//**ENDIF //** P3N - 08/26/99 +RETURN PHEAD_ARR +******************************************************************** +//** P3N-03/09/99 MADE A FUNCTION FOR MULTI USE +//** USE ORDER ALTERNATE SHIPPING +//** INFO FOR BACKORDERS IF PRESENT! +******************************************************************** +FUNCTION ALTSHP(SHP_ARR, SUBTYPE) +LOCAL WKALTSHPZIP +IF EMPTY(SUBTYPE) .OR. SUBTYPE == 'BACKORD' + IF !EMPTY( ALTSHIPADR->ALTSHPNAME ) + AADD(SHP_ARR, ALTSHIPADR->ALTSHPNAME ) + ENDIF + IF !EMPTY( ALTSHIPADR->ALTSHPADDR ) + AADD(SHP_ARR, ALTSHIPADR->ALTSHPADDR ) + ENDIF + IF !EMPTY( ALTSHIPADR->ALTSHPADD2 ) + AADD(SHP_ARR, ALTSHIPADR->ALTSHPADD2 ) + ENDIF + IF !EMPTY( ALTSHIPADR->ALTSHPADD3 ) + AADD(SHP_ARR, ALTSHIPADR->ALTSHPADD3 ) + ENDIF + WKALTSHPZIP := ALTSHIPADR->ALTSHPZIP + IF EMPTY(SUBST(WKALTSHPZIP, 7, 4)) + WKALTSHPZIP := SUBST(WKALTSHPZIP, 1,5) + ENDIF + IF !EMPTY( ALTSHIPADR->ALTSHPCITY ) .AND. ; + !EMPTY( ALTSHIPADR->ALTSHPSTAT ) .AND. ; + !EMPTY( ALTSHIPADR->ALTSHPZIP ) + IF LEN(ALLTRIM(ALTSHIPADR->ALTSHPCITY)) > 20 + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ALTSHPCITY) ) + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ALTSHPSTAT) + ' ' + ; + WKALTSHPZIP ) + ELSE + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ALTSHPCITY) + ' ' + ; + ALLTRIM( ALTSHIPADR->ALTSHPSTAT) + ' ' + ; + WKALTSHPZIP ) + ENDIF + ELSEIF !EMPTY( ALTSHIPADR->ALTSHPCITY ) + AADD(SHP_ARR, ALTSHIPADR->ALTSHPCITY ) + ENDIF +ELSEIF SUBTYPE == 'SCREENS' //** P3N - 9/23/98 + //** USE ORDER ALTERNATE SHIPPING + //** INFO FOR SCREEN BACKORDERS IF PRESENT! + IF !EMPTY( ALTSHIPADR->ASNAMESCRN ) + AADD(SHP_ARR, ALTSHIPADR->ASNAMESCRN ) + ENDIF + IF !EMPTY( ALTSHIPADR->ASADDRSCRN ) + AADD(SHP_ARR, ALTSHIPADR->ASADDRSCRN ) + ENDIF + IF !EMPTY( ALTSHIPADR->ASADD2SCRN ) + AADD(SHP_ARR, ALTSHIPADR->ASADD2SCRN ) + ENDIF + IF !EMPTY( ALTSHIPADR->ASADD3SCRN ) + AADD(SHP_ARR, ALTSHIPADR->ASADD3SCRN ) + ENDIF + WKALTSHPZIP := ALTSHIPADR->ASZIPSCRN + IF EMPTY(SUBST(WKALTSHPZIP, 7, 4)) + WKALTSHPZIP := SUBST(WKALTSHPZIP, 1,5) + ENDIF + IF !EMPTY( ALTSHIPADR->ASCITYSCRN ) .AND. ; + !EMPTY( ALTSHIPADR->ASSTATSCRN ) .AND. ; + !EMPTY( ALTSHIPADR->ASZIPSCRN ) + IF LEN(ALLTRIM(ALTSHIPADR->ASCITYSCRN)) > 20 + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ASCITYSCRN) ) + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ASCITYSCRN) + ' ' + ; + WKALTSHPZIP ) + ELSE + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ASCITYSCRN) + ' ' + ; + ALLTRIM( ALTSHIPADR->ASSTATSCRN) + ' ' + ; + WKALTSHPZIP ) + ENDIF + ELSEIF !EMPTY( ALTSHIPADR->ASCITYSCRN ) + AADD(SHP_ARR, ALTSHIPADR->ASCITYSCRN ) + ENDIF +ELSEIF SUBTYPE == 'STORMS' //** P3N - 9/23/98 + //** USE ORDER ALTERNATE SHIPPING + //** INFO FOR STORM BACKORDERS IF PRESENT! + IF !EMPTY( ALTSHIPADR->ASNAMESTRM ) + AADD(SHP_ARR, ALTSHIPADR->ASNAMESTRM ) + ENDIF + IF !EMPTY( ALTSHIPADR->ASADDRSTRM ) + AADD(SHP_ARR, ALTSHIPADR->ASADDRSTRM ) + ENDIF + IF !EMPTY( ALTSHIPADR->ASADD2STRM ) + AADD(SHP_ARR, ALTSHIPADR->ASADD2STRM ) + ENDIF + IF !EMPTY( ALTSHIPADR->ASADD3STRM ) + AADD(SHP_ARR, ALTSHIPADR->ASADD3STRM ) + ENDIF + WKALTSHPZIP := ALTSHIPADR->ASZIPSTRM + IF EMPTY(SUBST(WKALTSHPZIP, 7, 4)) + WKALTSHPZIP := SUBST(WKALTSHPZIP, 1,5) + ENDIF + IF !EMPTY( ALTSHIPADR->ASCITYSTRM ) .AND. ; + !EMPTY( ALTSHIPADR->ASSTATSTRM ) .AND. ; + !EMPTY( ALTSHIPADR->ASZIPSTRM ) + IF LEN(ALLTRIM(ALTSHIPADR->ASCITYSTRM)) > 20 + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ASCITYSTRM) ) + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ASCITYSTRM) + ' ' + ; + WKALTSHPZIP ) + ELSE + AADD(SHP_ARR, ALLTRIM( ALTSHIPADR->ASCITYSTRM) + ' ' + ; + ALLTRIM( ALTSHIPADR->ASSTATSTRM) + ' ' + ; + WKALTSHPZIP ) + ENDIF + ELSEIF !EMPTY( ALTSHIPADR->ASCITYSTRM ) + AADD(SHP_ARR, ALTSHIPADR->ASCITYSTRM ) + ENDIF +ENDIF + //** USE ORDER SHIPPING INFO FOR BACK ORDERS IF NO ALT SHIPINFO! +IF EMPTY(SHP_ARR) + IF !EMPTY( (CUR_MAST)->SHIP_NAME ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_NAME ) + ENDIF + IF !EMPTY( (CUR_MAST)->SHIP_ADD1 ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_ADD1 ) + ENDIF + IF !EMPTY( (CUR_MAST)->SHIP_ADD2 ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_ADD2 ) + ENDIF + IF !EMPTY( (CUR_MAST)->SHIP_CSZ ) + AADD(SHP_ARR, (CUR_MAST)->SHIP_CSZ ) + ENDIF +ENDIF + //** USE ORDER BILLING INFO FOR BACK ORDERS IF NO ALT SHIPINFO AND SHIPPING +IF EMPTY(SHP_ARR) //** P3N - 10/01/99 + IF (CUR_MAST)->BILL_NAME = (CUR_MAST)->SHIP_NAME; //** P3N - 10/01/99 + .OR. EMPTY((CUR_MAST)->SHIP_NAME) //** P3N - 10/01/99 + ELSE //** P3N - 10/01/99 + AADD(SHP_ARR, (CUR_MAST)->BILL_NAME ) //** P3N - 10/01/99 + ENDIF //** P3N - 10/01/99 + AADD(SHP_ARR, (CUR_MAST)->BILL_ADD1 ) //** P3N - 10/01/99 + IF EMPTY((CUR_MAST)->BILL_ADD2 ) //** P3N - 10/01/99 + ELSE //** P3N - 10/01/99 + AADD(SHP_ARR, (CUR_MAST)->BILL_ADD2 ) //** P3N - 10/01/99 + ENDIF //** P3N - 10/01/99 + AADD(SHP_ARR, (CUR_MAST)->BILL_CSZ ) //** P3N - 10/01/99 +ENDIF //** P3N - 10/01/99 +IF EMPTY ( (CUR_MAST)->SHIPPHN) + AADD(SHP_ARR, (CUR_MAST)->PHONE ) //** P3N - 9/29/99 +ELSEIF (CUR_MAST)->SHIPPHN = ' - - ' + AADD(SHP_ARR, (CUR_MAST)->PHONE ) //** P3N - 9/29/99 +ELSE + AADD(SHP_ARR, (CUR_MAST)->SHIPPHN ) +ENDIF +RETURN SHP_ARR +*********************************************************** +* BUILD THE TERMS PART OF THE ORDER +********************************************************** +FUNCTION HD3_PART(ORD_TYPE, SUBTYPE) +LOCAL PHEAD_ARR := {}, I, COL_HD_ARR := {}, SM_FRST, SM_LAST, WORKDATE +LOCAL TERMS_DESC := GP_TERMS( (CUR_MAST)->TERMS ), SM_ALL, SPACEPOS := 0 +LOCAL SHIP_DESC := GP_SHIP( (CUR_MAST)->SHP_METHOD) +LOCAL BOSHIP_DESC := '' //** P3N - 8/12/98 - HAPPY 40TH JEFF +LOCAL BOSHIP_SCRNS := '', BOSHIP_STORM := '' //** P3N - 8/17/98 +IF ORD_TYPE == 'BACKORD' //** P3N - 8/17/98 + BOSHIP_DESC := GP_SHIP( ALTSHIPADR->BOSHP_METH) //** P3N -11/13/98 + IF EMPTY(BOSHIP_DESC) //** P3N - 1/6/99 + BOSHIP_DESC := SHIP_DESC //** P3N - 1/6/99 + ENDIF + BOSHIP_SCRNS := GP_SHIP( ALTSHIPADR->BOSHP_SCRN) //** P3N -11/13/98 + IF EMPTY(BOSHIP_SCRNS) //** P3N - 1/6/99 + BOSHIP_DESC := SHIP_DESC //** P3N - 1/6/99 + ENDIF //** P3N - 1/6/99 + BOSHIP_STORM := GP_SHIP( ALTSHIPADR->BOSHP_STRM) //** P3N -11/13/98 + IF EMPTY(BOSHIP_STORM) //** P3N - 1/6/99 + BOSHIP_DESC := SHIP_DESC //** P3N - 1/6/99 + ENDIF //** P3N - 1/6/99 + IF SUBTYPE == 'SCREENS' //** P3N - 8/17/98 + BOSHIP_DESC := BOSHIP_SCRNS //** P3N - 8/17/98 + ELSEIF SUBTYPE == 'STORMS' //** P3N - 8/17/98 + BOSHIP_DESC := BOSHIP_STORM //** P3N - 8/17/98 + ENDIF +ENDIF +SALESMEN->(DBSEEK( (CUR_MAST)->SLSMAN ) ) +IF SALESMEN->(FOUND()) + SM_FRST := SALESMEN->FST_NME + SM_LAST := SALESMEN->LST_NME +ELSE + SM_FRST := ' ' + SM_LAST := (CUR_MAST)->SLSMAN +ENDIF +SM_ALL := ALLTRIM(TRIM(SM_FRST) + ' ' + TRIM(SM_LAST)) +SPACEPOS := AT(' ', SM_ALL) +SM_FRST := SUBS(SM_ALL, 1, SPACEPOS - 1 ) +SM_LAST := SUBS(SM_ALL, SPACEPOS + 1 ) +IF ORD_TYPE == 'INV' + WORKDATE := MAX( (CUR_MAST)->IDATE_FST, CURDATE ) +ELSEIF ORD_TYPE == 'BACKORD' //** P3N - 05/18/06 - IF BACKORDER USE CURRENT DATE + WORKDATE := CURDATE //** P3N - 05/18/06 - PER DARLENE-IOLA +ELSE + WORKDATE := (CUR_MAST)->IDATE_FST +ENDIF +IF FORMTYPE = 'PREPRINT' + AADD(PHEAD_ARR, SPACE(70) + TRIM(SM_FRST) ) + IF ORD_TYPE == 'BACKORD' //** P3N - 8/12/98 + AADD(PHEAD_ARR, SPACE(6)+ DTOC(WORKDATE) + SPACE(22)+; + BOSHIP_DESC + SPACE(19) + TRIM(SM_LAST) ) + AADD(PHEAD_ARR, ' ') + AADD(PHEAD_ARR, SPACE(68) + (CUR_MAST)->CUST_PO ) + ELSE + AADD(PHEAD_ARR, SPACE(12) + DTOC(WORKDATE) + SPACE(16) + SHIP_DESC + SPACE(19) + TRIM(SM_LAST) ) + AADD(PHEAD_ARR, ' ') + AADD(PHEAD_ARR, DTOC((CUR_MAST)->ORDER_DATE) ; + + SPACE(9) + DTOC( (CUR_MAST)->SHIP_DATE ) + SPACE(10) ; + + TERMS_DESC + SPACE(07) ; + + (CUR_MAST)->CUST_PO ) + ENDIF + AADD(PHEAD_ARR, ' ') + AADD(PHEAD_ARR, ' ') +ELSE //FORMTYPE == 'BLANK' + IF EMPTY(SUBTYPE) // Condensed PRODUCTION headings + //** P3N - 8/4/98 (HAPPY BIRTHDAY TO ME!!!) + //** ADDED TERMS TO QUOTE HEADING - PER ELLEN + IF CUR_MAST = 'ORD_MAST' + AADD(PHEAD_ARR, 'Entered: ' + DTOC((CUR_MAST)->ORDER_DATE) + ; + ' Shipped Via: ' + SHIP_DESC + ; + ' Cust PO#: ' + (CUR_MAST)->CUST_PO ) + ELSE + AADD(PHEAD_ARR, 'Entered: ' + DTOC((CUR_MAST)->ORDER_DATE) + ; + ' ' + SPACE(LEN(SHIP_DESC))+ ; + ' Cust PO#: ' + (CUR_MAST)->CUST_PO ) + AADD(PHEAD_ARR, 'Terms: ' + TERMS_DESC + ; + + SPACE(LEN(SHIP_DESC))+ ; + ' Shipped Via: ' + SHIP_DESC ) + ENDIF + AADD(PHEAD_ARR, REPLICATE('-', 80 ) ) + ELSE + AADD(PHEAD_ARR, ' ') + IF SUBTYPE = 'PREBILL' + AADD(PHEAD_ARR, 'Prebill Date: ' + DTOC(WORKDATE) + ' Shipped Via: ' + SHIP_DESC + ' Sold By: '+ ALLTRIM(SM_FRST) + ' ' + ALLTRIM(SM_LAST) ) + ELSE + IF SUBTYPE = 'PREBILL' + AADD(PHEAD_ARR, ' Print Date: ' + DTOC(WORKDATE) + ' Shipped Via: ' + SHIP_DESC + ' Sold By: '+ ALLTRIM(SM_FRST) + ' ' + ALLTRIM(SM_LAST) ) + ELSEIF SUBTYPE == 'BACKORD' + IF EMPTY((CUR_MAST)->BOSHP_METH) + REC_LOCK(3, CUR_MAST) + (CUR_MAST)->BOSHP_METH := CUST_MAST->BOSHP_METH + (CUR_MAST)->(DBUNLOCK()) + ENDIF + SHIP_DESC := GP_SHIP( (CUR_MAST)->BOSHP_METH) + AADD(PHEAD_ARR, SPACE(22) + ' Shipped Via: ' + SHIP_DESC) + ELSE + AADD(PHEAD_ARR, 'Invoice Date: ' + DTOC(WORKDATE) + ' Shipped Via: ' + SHIP_DESC + ' Sold By: '+ ALLTRIM(SM_FRST) + ' ' + ALLTRIM(SM_LAST) ) + ENDIF + ENDIF + AADD(PHEAD_ARR, ' ') + IF SUBTYPE == 'BACKORD' + AADD(PHEAD_ARR, SPACE(34) + SPACE(LEN(SHIP_DESC)) + ; + ' Cust PO#: ' + (CUR_MAST)->CUST_PO ) + ELSE + AADD(PHEAD_ARR, 'Entered: ' + DTOC((CUR_MAST)->ORDER_DATE) + ' Shipped: ' + DTOC((CUR_MAST)->SHIP_DATE) + ; + ' Terms: ' + SUBS(TERMS_DESC,1,15) + ' Cust PO#: ' + (CUR_MAST)->CUST_PO ) + ENDIF + AADD(PHEAD_ARR, REPLICATE('-', 80 ) ) + DO CASE + CASE ORD_TYPE == 'BACKORD' //** P3N - 5/1/98 + COL_HD_ARR := BO_HEAD() //** P3N - 5/1/98 + CASE ORD_TYPE == 'INV' + COL_HD_ARR := FULL_HEAD() + CASE ORD_TYPE == 'CTRL' + IF SUBTYPE = NIL + COL_HD_ARR := PART_HDQTY() + ELSEIF SUBTYPE = 'DELIVERY' + COL_HD_ARR := FULL_HEAD() + ELSEIF SUBTYPE = 'ORDERDESK' + COL_HD_ARR := PART_HEAD() + ENDIF + OTHERWISE + COL_HD_ARR := PART_HEAD() + ENDCASE + FOR I := 1 TO LEN(COL_HD_ARR) + AADD(PHEAD_ARR, COL_HD_ARR[I]) + NEXT + IF EMPTY(COL_HD_ARR) + ELSE + AADD(PHEAD_ARR, REPLICATE('-', 80 ) ) + ENDIF + ENDIF +ENDIF +RETURN PHEAD_ARR +*********************************************************** +* BUILD THE PARTIAL HEADING LINE FOR FREE FORM PRINT +* (IE: FRAME/GLASS/SASH/EXPANDER, ... COPIES) +*********************************************************** +FUNCTION PART_HEAD() +LOCAL COL_HEAD := SPACE(1) + 'Ord' + SPACE(25) + ' ' + SPACE(23) + ' ' + SPACE(5) + ' ' +LOCAL PHEAD_ARR := {} +AADD(PHEAD_ARR, COL_HEAD) +COL_HEAD := SPACE(1) + 'Qty' + SPACE(25) + 'Description' + SPACE(23) + ' ' + SPACE(5) + ' ' +AADD(PHEAD_ARR, COL_HEAD) +RETURN PHEAD_ARR +*********************************************************** +* BUILD THE FULL HEADING LINE FOR FREE FORM PRINT +* (IE: PRODUCTION CTRL / DELIVERY COPIES) +*********************************************************** +FUNCTION PART_HDQTY() +LOCAL COL_HEAD := SPACE(1) + 'Ord' + ' Back' + ' Ship' + SPACE(13) + ' ' + SPACE(23) + ' ' + SPACE(5) + ' ' +LOCAL PHEAD_ARR := {} +AADD(PHEAD_ARR, COL_HEAD) +COL_HEAD := SPACE(1) + 'Qty' + ' Ord.' + ' Qty ' + SPACE(13) + 'Description' + SPACE(23) + ' ' + SPACE(5) + ' ' +AADD(PHEAD_ARR, COL_HEAD) +RETURN PHEAD_ARR +*********************************************************** +* BUILD THE FULL HEADING LINE FOR FREE FORM PRINT +* (IE: ORDER DESK COPY) +*********************************************************** +FUNCTION FULL_HEAD() +LOCAL COL_HEAD := SPACE(1) + 'Ord' + ' Back' + ' Ship' + SPACE(13) + ' ' + SPACE(23) + ' ' + SPACE(5) + ' ' +LOCAL PHEAD_ARR := {} +AADD(PHEAD_ARR, COL_HEAD) +COL_HEAD := SPACE(1) + 'Qty' + ' Ord.' + ' Qty ' + SPACE(13) + 'Description' + SPACE(23) + ' Unit ' + SPACE(5) + 'Amount' +AADD(PHEAD_ARR, COL_HEAD) +RETURN PHEAD_ARR +*********************************************************** +* BUILD THE BACKORDER HEADING LINE FOR FREE FORM PRINT +* (IE: ORDER DESK COPY) +*********************************************************** +FUNCTION BO_HEAD() +LOCAL COL_HEAD := SPACE(10) + 'Ord.' +LOCAL PHEAD_ARR := {} +AADD(PHEAD_ARR, COL_HEAD) +COL_HEAD := SPACE(10) + 'Qty ' + SPACE(13) + 'Description' +AADD(PHEAD_ARR, COL_HEAD) +RETURN PHEAD_ARR +*********************************************************** +* BUILD THE DUPLICATE ORDER MSG. LINE +*********************************************************** +FUNCTION DUPL_MSG( ORD_TYPE, MDATE, MTIME ) +LOCAL PV1, PV2, RET_VAL, DUP_MSG_TYPE := SUBS(ORD_TYPE,1,3) +PV1 := &WIDEON ; + + 'DUPLICATE ' + DUP_MSG_TYPE ; + + &WIDEOFF +PV2 := + '(Last Printed ' ; + + DTOC(MDATE) + ' ' ; + + SUBS(MTIME,1,5) + ')' +RET_VAL := { PV1, PV2, ' ' } +RETURN RET_VAL +*********************************************************** +// PRINTS THE SIZE AS 23 15/16 X 23 1/4 +*********************************************************** +FUNCTION PRNT_SIZE(PRNTWIDTH, PRNTHEIGHT, DELIMCHAR, MAX_DENOMINATOR, VALUESONLY) +LOCAL MDEC, ELM, W_FRACT, H_FRACT, ADDVAL, ITEM_LINE := '', WIDVAL, HTVAL +IF VALUESONLY = NIL + VALUESONLY := .F. +ENDIF +IF MAX_DENOMINATOR = NIL + MAX_DENOMINATOR := 16 +ENDIF +IF DELIMCHAR = NIL + DELIMCHAR := ' x ' +ELSE + DELIMCHAR := ' ' + DELIMCHAR + ' ' +ENDIF +MDEC := PRNTWIDTH - INT(PRNTWIDTH) +IF MDEC = 0 + ELM = 0 +ELSE + ELM := ASCAN( FRACTION_ARR , {|X| X[2] == MDEC } ) +ENDIF +IF ELM == 0 // DECIMAL - FRACTION NOT FOUND IN ARRAY + W_FRACT := '' +ELSE + W_FRACT := FRACTION_ARR[ELM, 1] // WIDTH FRACTION VALUE TO PRT + IF RIGHT(ALLTRIM(W_FRACT),2) = '32' + IF ELM = 1 + W_FRACT := ' ' + ELSE + W_FRACT := FRACTION_ARR[ELM-1,1] + ENDIF + ENDIF +ENDIF +ADDVAL := LTRIM(STR(INT(PRNTWIDTH),3)) +ITEM_LINE := ITEM_LINE + ADDVAL +WIDVAL := ADDVAL +IF LEN(W_FRACT) > 0 + ADDVAL := ALLTRIM(W_FRACT) + ITEM_LINE := ITEM_LINE + ' ' + ADDVAL + WIDVAL := WIDVAL + ' ' + ADDVAL +ENDIF +IF PRNTHEIGHT <> NIL .AND. PRNTHEIGHT <> 0 + MDEC := PRNTHEIGHT - INT(PRNTHEIGHT) + IF MDEC = 0 + ELM = 0 + ELSE + ELM := ASCAN( FRACTION_ARR , {|X| X[2] == MDEC } ) + ENDIF + IF ELM == 0 // DECIMAL - FRACTION NOT FOUND IN ARRAY + H_FRACT := '' + ELSE + H_FRACT := FRACTION_ARR[ELM, 1] + ' ' // HEIGHT FRACTION VALUE TO PRT + ENDIF + ADDVAL := LTRIM(STR(INT(PRNTHEIGHT),3)) + ITEM_LINE := ITEM_LINE + DELIMCHAR + ADDVAL + HTVAL := ADDVAL + IF LEN(H_FRACT) > 0 + ADDVAL := ALLTRIM(H_FRACT) + ITEM_LINE := TRIM(ITEM_LINE + ' ' + ADDVAL ) + HTVAL := HTVAL + ' ' + ADDVAL + ENDIF +ENDIF +IF VALUESONLY + RETURN { WIDVAL, HTVAL } +ELSE + RETURN STRTRAN(ITEM_LINE, ' ', '~') +ENDIF +******************************************************************* +* THIS FUNCTION WILL CALCULATE THE UNIT PRICE FOR PRINTING PURPOSES +******************************************************************* +FUNCTION CALC_UNIT(PRICE, QTY) +RETURN TRANSFORM(PRICE / QTY,'99999.99') + +******************************************************************* +* THIS FUNCTION PRINT THE MISC. ITEMS ON THE INVOICE COPY OF THE ORDER +******************************************************************* +FUNCTION PRT_MISC(P_DESC, P_AMT) +LOCAL RET_VAL := PADL(ALLTRIM(P_DESC), LEN(P_DESC)+8 ) + ': ' + STR(P_AMT,10,2) +RETURN +********************************************************** +* BUILD BOTTOM OF ORDER (IE: CUSTOMER ORDER MISC ITEMS/TAX/TOTALS) +********************************************************** +FUNCTION BLD_TAIL(MORDER_NUM, ORD_TYPE, LINE_TOTAL, WHICHCOPY, SUBTYPE,; + LI_DISC_PRNT, PARTIAL_INVOICE, MISC_ARR, PRT_BO, REPRINT_INVOICE ) +LOCAL MISCPRNT, I, ELEM, PRT_AMT, NEGTOT, TAXPRNTARR := {} +LOCAL NUMGL_LINES := LEN(GL_ARR), NUMPRNT := 0, DIFF, QUOT_FACTOR +LOCAL PV1, PV2, PVCNT := 0, TOTAL_GL := 0, WK_TOTAL, PTAIL_ARR := {} +LOCAL DP_DESC := 'Downpmt - ' + DTOC( (CUR_MAST)->DP_DATE) + ':' +LOCAL TAX_ARR := STAX_RATE( (CUR_MAST)->TAXSCH ) // WHOLE TAX ARRAY +LOCAL TAX_DESC := TAX_ARR[3] // DESCRIPTION +LOCAL TAX_DET := TAX_ARR[4] // ALL COMPONENTS {RATE, DESC, GL_NUM} +LOCAL NOTEVAL := '', RETVALARR := {}, RETVARARR := {},DID_NOTES := .F. +LOCAL NOTEARR := {}, ARR2 := {}, WORKSPACE := 56, NOTELEN := 32 +LOCAL TEMPSPACE := 23, GL_TOTAL := 0, SV_TOTAL := 0, ELM, WKPCT := 0 +LOCAL WORKARR, BILL_STATE, SHIP_STATE, WK_STATE, SVARR_LEN := 0, SUBTOTL := 0 +LOCAL WKNOTES := '',NONTX_ARR := {} //** P3N-11/2/98 -HAPPY B-DAY MATT +LOCAL ORDTOT := (CUR_MAST)->TOTAL_AMT //** P3N - 11/19/98 +STATIC SV_GLARR := {} +//**ORDTOT := ORDTOT - (CUR_MAST)->ORD_BO_TTL //** P3N - 11/19/98 + +FOR I := 1 TO LEN(GL_ARR) + GL_TOTAL := GL_TOTAL + GL_ARR[I,2] +NEXT +FOR I := 1 TO LEN(SV_GLARR) + IF VALTYPE(SV_GLARR[I]) == 'C' + ELSE + SV_TOTAL := SV_TOTAL + SV_GLARR[I,2] + SVARR_LEN := SVARR_LEN + 1 + ENDIF +NEXT + +IF EMPTY(SV_GLARR) + SV_GLARR:= ACLONE(GL_ARR) + AADD(SV_GLARR, MORDER_NUM) +ELSE + // IS IT THE SAME ORDER NUMBER USE THE SAVE GL_ARR + ELM := ASCAN(SV_GLARR, {|X| VALTYPE(X) == 'C'}) + IF EMPTY(ELM) + SV_GLARR:= ACLONE(GL_ARR) + AADD(SV_GLARR,MORDER_NUM) + ELSEIF MORDER_NUM == SV_GLARR[ELM] + // THE SAME ORDER NUMBER HAS THE GL_ARR CHANGED + IF LEN(GL_ARR) <> SVARR_LEN .OR. SV_TOTAL <> GL_TOTAL + SV_GLARR:= ACLONE(GL_ARR) + AADD(SV_GLARR,MORDER_NUM) + ENDIF + ELSE + SV_GLARR:= ACLONE(GL_ARR) + AADD(SV_GLARR,MORDER_NUM) + ENDIF +ENDIF +IF GLALLOC_OVR + GL_ARR := ASORT(GL_OVR,,, {|X,Y| X[1] < Y[1] }) +ELSE + GL_ARR := {} + FOR I := 1 TO LEN(SV_GLARR) + IF VALTYPE(SV_GLARR[I]) == 'C' + //THIS IS THE ORDER NUMBER-USED TO DETERMINE WHEN TO RESET THE ARRAY + ELSE + AADD(GL_ARR, SV_GLARR[I]) + ENDIF + NEXT + GL_ARR := ASORT(GL_ARR,,, {|X,Y| X[1] < Y[1] }) +ENDIF +WORKSPACE := 46 +TEMPSPACE := 21 +IF MHOME_LOC_CODE = 'KC' + WORKSPACE := 49 +ELSEIF MHOME_LOC_CODE = 'LINDS' + WORKSPACE := 48 + //** ADDRESS LINDS DELIVERY TICKET PRINT ANOMALIES //** P3N -07/17/00 + IF SUBTYPE = 'DELIVERY' + WORKSPACE := 47 + ENDIF +ENDIF + + +FOR I := 1 TO LEN(GL_ARR) + IF LEN(GL_ARR[I]) > 2 // TAX SCHEDULE NAME + AADD(TAXPRNTARR, GL_ARR[I]) // GL NUM, TAX AMT, DESC + ENDIF +NEXT + +// MEMO NOTE FIELD FROM ORDER SCREEN +IF !EMPTY( (CUR_MAST)->NOTES ) + RETVARARR := PRT_MEMO( {} , {} , ALLTRIM((CUR_MAST)->NOTES), NOTELEN) // PRINT THE ORDER MASTER NOTES + WORKARR := ACLONE( RETVARARR[1] ) + FOR I := 1 TO LEN( WORKARR ) + AADD(NOTEARR, WORKARR[I] ) + NEXT + AADD(NOTEARR, ' ' ) +ENDIF + +// TAX NOTES ON INVOICE +IF ORD_TYPE = 'INV' .AND. TAX_SCHED->(DBSEEK ( (CUR_MAST)->TAXSCH ) ) ; + .AND. !EMPTY( TAX_SCHED->NOTES ) + RETVARARR := PRT_MEMO( {}, {}, TAX_SCHED->NOTES, NOTELEN) // PRINT THE TAX SCHEDULE NOTES + WORKARR := ACLONE( RETVARARR[1] ) + FOR I := 1 TO LEN( WORKARR ) + AADD(NOTEARR, WORKARR[I] ) + NEXT +ENDIF + +// 9-6-95 - just say "Sales Tax" +IF EMPTY(TAX_DESC) .OR. MHOME_LOC_CODE <> 'KC' + TAX_DESC := PADL( TRIM("Sales Tax") + ': ', TEMPSPACE-3, ' ' ) +ELSE + TAX_DESC := PADL( TRIM(TAX_DESC) + ': ', TEMPSPACE-3, ' ' ) +ENDIF + +PRT_AMT := DO_WE_PRT_AMT( ORD_TYPE, SUBTYPE ) +IF PRT_AMT .OR. ITEMIZE = 2 + DID_NOTES := .T. + IF (CUR_MAST)->ORDER_NUM == MORDER_NUM + ELSE + (CUR_MAST)->(DBSEEK(MORDER_NUM)) + ENDIF + + // PRINT SUBTOTAL SO FAR + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + PV2 := SPACE(18) + '----------' + AADD(PTAIL_ARR, PV1 + PV2) + + IF (CUR_MAST)->ORD_D_TTL <> 0 .AND. LI_DISC_PRNT + LINE_TOTAL := LINE_TOTAL - (CUR_MAST)->ORD_D_TTL + ENDIF + + IF LINE_TOTAL < 0 + NEGTOT := TRANSFORM(LINE_TOTAL, '(9999999999999999.99)') //**P3N 4/28/98 +****NEGTOT := TRANSFORM(LINE_TOTAL, '(9999999999.99)') + NEGTOT := STRTRAN(NEGTOT, ' ', '') + NEGTOT := STRTRAN(NEGTOT, '-', '') + NEGTOT := PADL(NEGTOT,17, ' ') //** P3N - 4/28/98 +****NEGTOT := PADL(NEGTOT,11, ' ') + ELSE + NEGTOT := 0 + ENDIF + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + IF (CUR_MAST)->QUOTE_PRIC = 0 + IF EMPTY(NEGTOT) + PV2 = ' ' + STR(LINE_TOTAL,16,2) //** P3N - 4/28/98 + ELSE + PV2 = ' ' + NEGTOT // NEGATIVE TOTAL //** P3N - 4/28/98 + ENDIF + ELSE + PV2 = ' Quoted Amount: ' + STR( (CUR_MAST)->QUOTE_PRIC,10,2) + ENDIF + AADD(PTAIL_ARR, PV1 + PV2) + + MISCPRNT := .F. + IF (CUR_MAST)->ORD_D_TTL <> 0 + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE-8), NOTEARR ) + IF LI_DISC_PRNT + IF EMPTY(PV1) + ELSE + AADD(PTAIL_ARR, PV1 ) + ENDIF + ELSEIF EMPTY((CUR_MAST)->ORD_D_TTL) + ELSE + IF EMPTY((CUR_MAST)->DISCOUNT) + PV2 := ' Less ORDER Discount:' + ELSE + PV2 := 'Less ORDER Discount ' + PV2 := PV2+ STR((CUR_MAST)->DISCOUNT,3,0) + '%:' + ENDIF + PV2 := PV2+ STR((CUR_MAST)->ORD_D_TTL*-1,11,2) //** P3N - 12/10/98 + PV2 := STRTRAN( PV2, '-','(' ) + ')' //** P3N - 12/10/98 +//** PV2 := STRTRAN(((CUR_MAST)->ORD_D_TTL*-1,11,2) //** P3N - 12/10/98 + AADD(PTAIL_ARR, PV1 + PV2) + LINE_TOTAL := LINE_TOTAL - (CUR_MAST)->ORD_D_TTL + ENDIF + ENDIF + + IF (CUR_MAST)->( FIELDPOS('FREIGHT') ) > 0 + IF (CUR_MAST)->FREIGHT <> 0 + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + AADD(PTAIL_ARR, PV1 + ' Freight Charges: ' + STR((CUR_MAST)->FREIGHT,10,2) ) + MISCPRNT := .T. + ENDIF + ENDIF + + NEGTOT := 0 //** P3N - 12/4/98 + + //** P3N - 09/21/06 - ADDED THE FUEL SURCHARGE TO ORDER ENTRY + IF (CUR_MAST)->FUEL_CHRG <> 0 + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE-30), NOTEARR ) + SUBTOTL := (CUR_MAST)->ORD_L_TTL - (CUR_MAST)->ORD_D_TTL + (CUR_MAST)->ORD_M_TTL //**P3N - 11/13/06 +//**SUBTOTL := (CUR_MAST)->ORD_L_TTL - (CUR_MAST)->ORD_D_TTL //** P3N - 11/13/06 + SUBTOTL += (CUR_MAST)->MISC_QTY1 * (CUR_MAST)->MISC_AMT1 + SUBTOTL += (CUR_MAST)->MISC_QTY2 * (CUR_MAST)->MISC_AMT2 + SUBTOTL += (CUR_MAST)->MISC_QTY3 * (CUR_MAST)->MISC_AMT3 +//**WKPCT := VAL(STR(((CUR_MAST)->FUEL_CHRG / SUBTOTL) * 100,15,2) ) //** P3N - 04/22/09 - per Darlene - remove % + AADD(PTAIL_ARR, PV1 +SPACE(31)+ ; //** P3N - 04/22/09 - per Darlene - remove % + 'Delivery Charge:'+ STR((CUR_MAST)->FUEL_CHRG,11,2)) //** P3N - 04/22/09 +//**AADD(PTAIL_ARR, PV1 +SPACE(8)+ STR( WKPCT,3,0) + ; //** P3N - 04/13/09 +//** '% Delivery Charge:'+ STR((CUR_MAST)->FUEL_CHRG,28,2)) //** P3N - 04/13/09 + //** P3N - 04/13/09 - PER DARLENE - REMOVE "Fuel Sur" from description + //** '% Delivery Fuel SurCharge:'+ STR((CUR_MAST)->FUEL_CHRG,28,2)) + MISCPRNT := .T. + ENDIF + + IF (CUR_MAST)->SALES_TAX <> 0 + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE ), NOTEARR ) + IF (CUR_MAST)->SALES_TAX < 0 //** P3N - 10/14/98 + NEGTOT := TRANSFORM((CUR_MAST)->SALES_TAX, '(9999999999.99)') + NEGTOT := STRTRAN(NEGTOT, ' ', '') //** P3N - 10/14/98 + NEGTOT := STRTRAN(NEGTOT, '-', '') //** P3N - 10/14/98 + NEGTOT := PADL(NEGTOT,11, ' ') //** P3N - 10/14/98 + ENDIF //** P3N - 10/14/98 + IF EMPTY(NEGTOT) //** P3N - 10/14/98 + AADD(PTAIL_ARR, PV1 + TAX_DESC + STR((CUR_MAST)->SALES_TAX,10,2) ) + ELSE //** P3N - 10/14/98 + AADD(PTAIL_ARR, PV1 + TAX_DESC + NEGTOT ) //** P3N - 10/14/98 + ENDIF + MISCPRNT := .T. + ENDIF + + //** P3N - 12/3/98 DO NOT PRINT NONTAX ITEMS FOR INTER COMPANY PO'S + IF WHICHCOPY == 'PO' .AND. SUBTYPE == 'PO' + //** P3N - 12/2/98 PREPARE NONTAX ITEMS FOR PRINTING + ELSE + NONTX_ARR := PRT_NONTX(MISC_ARR, PARTIAL_INVOICE, .T., PRT_BO, REPRINT_INVOICE) + FOR I := 1 TO LEN(NONTX_ARR) + PV1 := NONTX_ARR[I] + PVCNT ++ + AADD(PTAIL_ARR, PV1) + MISCPRNT := .T. + NEXT + ENDIF + + NEGTOT := 0 //** P3N - 12/4/98 + + IF MISCPRNT .OR. PRT_AMT //** P3N - 4/8/98 + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + PV2 := SPACE(18) + '----------' + AADD(PTAIL_ARR, PV1 + PV2) + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + IF ORDTOT < 0 +//** NEGTOT := TRANSFORM((CUR_MAST)->TOTAL_AMT, '(9999999999.99)') + NEGTOT := TRANSFORM(ORDTOT, '(9999999999.99)') + NEGTOT := STRTRAN(NEGTOT, ' ', '') + NEGTOT := STRTRAN(NEGTOT, '-', '') + NEGTOT := PADL(NEGTOT,11, ' ') +//** P3N - 11/19/98 +//**ELSEIF (CUR_MAST)->TOTAL_AMT = 0.00 // ** P3N - 4/8/98 + ELSEIF ORDTOT = 0.00 + GL_ARR := {} // ** NO GL ALLOCATIONS + NEGTOT := 0 // ** FOR A ORDER TOTAL OF 0! + ELSE + NEGTOT := 0 + ENDIF + IF EMPTY(NEGTOT) +//** P3N - 11/19/98 +//** AADD(PTAIL_ARR, PV1 + ' Order Total: ' + STR((CUR_MAST)->TOTAL_AMT,10,2) ) + AADD(PTAIL_ARR, PV1 + ' Order Total: ' + STR(ORDTOT,10,2) ) + ELSE + AADD(PTAIL_ARR, PV1 + ' Order Total: ' + NEGTOT ) + ENDIF + ENDIF + + NEGTOT := 0 //** P3N - 12/4/98 + + IF (CUR_MAST)->DOWN_PMT <> 0 + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE-2), NOTEARR ) + NEGTOT := TRANSFORM((CUR_MAST)->DOWN_PMT*-1 , '(9999999999.99)') + NEGTOT := STRTRAN(NEGTOT, ' ', '') + NEGTOT := STRTRAN(NEGTOT, '-', '') + NEGTOT := PADL(NEGTOT,12, ' ') + AADD(PTAIL_ARR, PV1 + DP_DESC + NEGTOT ) + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + AADD(PTAIL_ARR, PV1 + SPACE(18) + '----------' ) + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + + NEGTOT := 0 //** P3N - 12/4/98 + +//** P3N - 11/19/98 +//**IF (CUR_MAST)->TOTAL_AMT < 0 + IF ORDTOT < 0 +//** IF (CUR_MAST)->TOTAL_AMT + (CUR_MAST)->DOWN_PMT < 0 + IF ORDTOT + (CUR_MAST)->DOWN_PMT < 0 +//** NEGTOT := TRANSFORM((CUR_MAST)->TOTAL_AMT-(CUR_MAST)->DOWN_PMT , '(9999999999.99)') + NEGTOT := TRANSFORM(ORDTOT-(CUR_MAST)->DOWN_PMT , '(9999999999.99)') + NEGTOT := STRTRAN(NEGTOT, ' ', '') + NEGTOT := STRTRAN(NEGTOT, '-', '') + NEGTOT := PADL(NEGTOT,11, ' ') + ELSE + NEGTOT := 0 + ENDIF + ELSE + NEGTOT := 0 + ENDIF + IF EMPTY(NEGTOT) +//** P3N - 11/19/98 +//** AADD(PTAIL_ARR, PV1 + 'Total Amount Due: ' + STR((CUR_MAST)->TOTAL_AMT - (CUR_MAST)->DOWN_PMT,10,2) ) + AADD(PTAIL_ARR, PV1 + 'Total Amount Due: ' + STR(ORDTOT - (CUR_MAST)->DOWN_PMT,10,2) ) + ELSE + AADD(PTAIL_ARR, PV1 + 'Total Amount Due: ' + NEGTOT ) + ENDIF + ENDIF + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + IF MHOME_LOC_CODE <> 'IOLA' // DARLENE 8-22-96 + AADD(PTAIL_ARR, PV1 + SPACE(18) + '----------' ) + ENDIF + + FOR I := PVCNT TO MAX(LEN(GL_ARR), LEN(NOTEARR) ) + PVCNT ++ + PV1 := GETPV1(GL_ARR, PVCNT, SPACE(WORKSPACE), NOTEARR ) + AADD(PTAIL_ARR, PV1 ) + NEXT +ELSE + //** P3N - 12/3/98 DO NOT PRINT NONTAX ITEMS FOR INTER COMPANY PO'S + IF WHICHCOPY == 'PO' .AND. SUBTYPE == 'PO' + //** P3N - 12/2/98 PREPARE NONTAX ITEMS FOR PRINTING + ELSE + NONTX_ARR := PRT_NONTX(MISC_ARR, PARTIAL_INVOICE, .F., PRT_BO, REPRINT_INVOICE) + FOR I := 1 TO LEN(NONTX_ARR) + PV1 := NONTX_ARR[I] + PVCNT ++ + AADD(PTAIL_ARR, PV1) + MISCPRNT := .T. + NEXT + ENDIF +ENDIF +IF !DID_NOTES .AND. LEN(NOTEARR) > 0 + //** P3N 9/2/98 + //** ONLY INCLUDE THE SPECIAL BACKORDER NOTES ON THE INVOICE COPIES + IF AT(' ARE ON BACK ORDER AND INCLUDED IN THE ', (CUR_MAST)->NOTES) > 0 + IF ORD_TYPE == 'INV' + FOR I := 1 TO LEN(NOTEARR) + AADD(PTAIL_ARR, SPACE(15) + NOTEARR[I]) + NEXT + ENDIF + ELSE + FOR I := 1 TO LEN(NOTEARR) + AADD(PTAIL_ARR, SPACE(15) + NOTEARR[I]) + NEXT + ENDIF +ENDIF +//** P3N 9/2/98 +//** BO MEMO NOTE FIELD FROM ORDER MASTER(CGW0OM) +//** ORDER CONTROL SCREEN (3220B/F1) +IF ORD_TYPE == 'BACKORD' + PTAIL_ARR := {} + IF SUBTYPE == 'BACKORD' //** P3N - 11/2/98 HAPPY B-DAY MATT + WKNOTES := (CUR_MAST)->BO_NOTES //** P3N - 11/2/98 HAPPY B-DAY MATT + ELSEIF SUBTYPE == 'SCREENS' //** P3N - 11/2/98 HAPPY B-DAY MATT + IF (CUR_MAST)->(FIELDPOS('BONOTESCRN')) > 0 + WKNOTES := (CUR_MAST)->BONOTESCRN //** 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 + IF !EMPTY( WKNOTES ) + RETVARARR := PRT_MEMO( {} , {} , ALLTRIM(WKNOTES), NOTELEN) // PRINT THE ORDER MASTER BO_NOTES + WORKARR := ACLONE( RETVARARR[1] ) + FOR I := 1 TO LEN( WORKARR ) + AADD(PTAIL_ARR, SPACE(12) + WORKARR[I] ) + NEXT + AADD(PTAIL_ARR, ' ' ) + ENDIF +ENDIF +RETURN PTAIL_ARR +*************************************************************** +* P3N - 12/02/98 * +* PREPARE NONTAX ITEMS FOR PRINTING * +*************************************************************** +FUNCTION PRT_NONTX(MISC_ARR, PARTIAL_INVOICE, PRT_AMT, PRT_BO, REPRINT_INVOICE) +LOCAL TX1SHP := 0, TX2SHP := 0, TX3SHP := 0, TX1INV := 0, TX2INV := 0, TX3INV := 0 +LOCAL TX1BO := 0, TX2BO := 0, TX3BO := 0, TX1A := 0, TX2A := 0, TX3A := 0 +LOCAL TX1Q := 0 , TX2Q := 0, TX3Q := 0, I := 0, WK_TOTAL := 0, PV1 +LOCAL PTAXAMT := PRT_AMT, PTAIL_ARR := { } +IF ITEMIZE = 2 + PTAXAMT := .F. +ENDIF +TX1A := (CUR_MAST)->NOTX_AMT1 +TX1Q := (CUR_MAST)->NOTX_QTY1 +TX2A := (CUR_MAST)->NOTX_AMT2 +TX2Q := (CUR_MAST)->NOTX_QTY2 +TX3A := (CUR_MAST)->NOTX_AMT3 +TX3Q := (CUR_MAST)->NOTX_QTY3 +IF PRT_BO + FOR I := 1 TO LEN(MISC_ARR[1]) + IF MISC_ARR[1,I,5] == 'ORDNOTX1' + TX1SHP := MISC_ARR[1,I,3] //** SHIP QTY + TX1INV := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX2' + TX2SHP := MISC_ARR[1,I,3] //** SHIP QTY + TX2INV := MISC_ARR[1,I,6] //** INV QTY + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX3' + TX3SHP := MISC_ARR[1,I,3] //** SHIP QTY + TX3INV := MISC_ARR[1,I,6] //** INV QTY + ENDIF + NEXT + TX1BO := TX1Q - TX1SHP + TX2BO := TX2Q - TX2SHP + TX3BO := TX3Q - TX3SHP +ENDIF +IF (CUR_MAST)->NOTX_QTY1 <> 0 + IF PARTIAL_INVOICE + WK_TOTAL := TX1A * TX1SHP + ELSEIF REPRINT_INVOICE + WK_TOTAL := TX1A * TX1INV + ELSE + WK_TOTAL := TX1A * TX1Q + ENDIF + IF EMPTY(TX1BO) + TX1BO := SPACE(4) + ELSE + TX1BO := STR(TX1BO,4,0) + ENDIF + IF EMPTY(TX1SHP) + TX1SHP := SPACE(5) + ELSEIF TX1Q = TX1SHP //** P3N - 12/28/98 + TX1SHP := SPACE(5) //** DO NOT PRINT SHIP QTY IF SAME AS + ELSE //** ORDER QTY + TX1SHP := STR(TX1SHP,5,0) + ENDIF + PV1 := STR(TX1Q,4,0) + TX1BO + TX1SHP + SPACE(2) + IF MHOME_LOC_CODE = 'KC' + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM1 + ' ~ ' + SPACE(13) + IF PTAXAMT + PV1 := PV1 + STR(TX1A,7,2) + ' ' + ENDIF + ELSEIF MHOME_LOC_CODE = 'LINDS' + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM1 + ' ~ ' + SPACE(13) + IF PTAXAMT + PV1 := PV1 + STR(TX1A,7,2) + ' ' + ENDIF + ELSE // IOLA AND PAWNEE + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM1 + ' ~ ' + SPACE(11) + IF PTAXAMT + PV1 := PV1 + STR(TX1A,7,2) + ' ' + ENDIF + ENDIF + IF PTAXAMT + PV1 := PV1 + STR(WK_TOTAL,10,2) + ELSE + AADD(PTAIL_ARR, ' ') + ENDIF + AADD(PTAIL_ARR, PV1) +ENDIF +IF (CUR_MAST)->NOTX_QTY2 <> 0 + IF PARTIAL_INVOICE + WK_TOTAL := TX2A * TX2SHP + ELSEIF REPRINT_INVOICE + WK_TOTAL := TX2A * TX2INV + ELSE + WK_TOTAL := TX2A * TX2Q + ENDIF + IF EMPTY(TX2BO) + TX2BO := SPACE(4) + ELSE + TX2BO := STR(TX2BO,4,0) + ENDIF + IF EMPTY(TX2SHP) + TX2SHP := SPACE(5) + ELSEIF TX2Q = TX2SHP //** P3N - 12/28/98 + TX2SHP := SPACE(5) //** DO NOT PRINT SHIP QTY IF SAME AS + ELSE //** ORDER QTY + TX2SHP := STR(TX2SHP,5,0) + ENDIF + PV1 := STR(TX2Q,4,0) + TX2BO + TX2SHP + SPACE(2) + IF MHOME_LOC_CODE = 'KC' + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM2 + ' ~ ' + SPACE(13) + IF PTAXAMT + PV1 := PV1 + STR(TX2A,7,2) + ' ' + ENDIF + ELSEIF MHOME_LOC_CODE = 'LINDS' + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM2 + ' ~ ' + SPACE(13) + IF PTAXAMT + PV1 := PV1 + STR(TX2A,7,2) + ' ' + ENDIF + ELSE // IOLA AND PAWNEE + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM2 + ' ~ ' + SPACE(11) + IF PTAXAMT + PV1 := PV1 + STR(TX2A,7,2) + ' ' + ENDIF + ENDIF + IF PTAXAMT + PV1 := PV1 + STR(WK_TOTAL,10,2) + ELSE + AADD(PTAIL_ARR, ' ') + ENDIF + AADD(PTAIL_ARR, PV1) +ENDIF +IF (CUR_MAST)->NOTX_QTY3 <> 0 + IF PARTIAL_INVOICE + WK_TOTAL := TX3A * TX3SHP + ELSEIF REPRINT_INVOICE + WK_TOTAL := TX3A * TX3INV + ELSE + WK_TOTAL := TX3A * TX3Q + ENDIF + IF EMPTY(TX3BO) + TX3BO := SPACE(4) + ELSE + TX3BO := STR(TX3BO,4,0) + ENDIF + IF EMPTY(TX3SHP) + TX3SHP := SPACE(5) + ELSEIF TX3Q = TX3SHP //** P3N - 12/28/98 + TX3SHP := SPACE(5) //** DO NOT PRINT SHIP QTY IF SAME AS + ELSE //** ORDER QTY + TX3SHP := STR(TX3SHP,5,0) + ENDIF + PV1 := STR(TX3Q,4,0) + TX3BO + TX3SHP + SPACE(2) + IF MHOME_LOC_CODE = 'KC' + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM3 + ' ~ ' + SPACE(13) + IF PTAXAMT + PV1 := PV1 + STR(TX3A,7,2) + ' ' + ENDIF + ELSEIF MHOME_LOC_CODE = 'LINDS' + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM3 + ' ~ ' + SPACE(13) + IF PTAXAMT + PV1 := PV1 + STR(TX3A,7,2) + ' ' + ENDIF + ELSE // IOLA AND PAWNEE + PV1 := PV1 + (CUR_MAST)->NOTX_ITEM3 + ' ~ ' + SPACE(11) + IF PTAXAMT + PV1 := PV1 + STR(TX3A,7,2) + ' ' + ENDIF + ENDIF + IF PTAXAMT + PV1 := PV1 + STR(WK_TOTAL,10,2) + ELSE + AADD(PTAIL_ARR, ' ') + ENDIF + AADD(PTAIL_ARR, PV1) +ENDIF +RETURN PTAIL_ARR +*************************************************************** +*************************************************************** +*************************************************************** +// PRINT THE ACCOUNTING TOTALS / GL ALLOCATIONS? +FUNCTION PRNT_ACCT_INFO( ORD_TYPE, WHICHCOPY, SUBTYPE ) +LOCAL RETVAL +//**IF (CUR_MAST)->TERMS = '90' .OR. ; //** NO CHARGE //**P3N - 6/4/98 +//** (CUR_MAST)->TERMS = '96' //** CANCELLATION //**P3N - 6/4/98 +IF ZERO_ORDER() //** NO CHARGE //**P3N - 3/5/99 + //** FOR A NO CHARGE OR CANCELLATION FORCE TO NOT PRINT GL AMTS + RETVAL := .F. +ELSEIF ORD_TYPE == 'INV' // PRINT CUSTOMER INVOICE + RETVAL := .T. +ELSEIF (ORD_TYPE == 'OD' .AND. WHICHCOPY == 'CTRL' ) + RETVAL := .T. + IF MHOME_LOC_CODE = 'LINDS' .AND. SUBTYPE == 'ORDERDESK' + //PER LINDA @ LINDSBOURG 11-10-97 + //PRINT GL ALLOCATIONS / ORDER AMOUNTS ON ORDERDESK - GOLDEN ROD + ELSEIF SUBTYPE = 'DELIVERY' .AND. IS_COD( (CUR_MAST)->TERMS ) + RETVAL := .T. + ELSE + RETVAL := .F. + ENDIF +ELSE + RETVAL := .F. +ENDIF +RETURN RETVAL +************************************************************ +************************************************************ +************************************************************ +FUNCTION GETPV1(GL_ARR, ELEM, ALTVALU, NOTEARR) +LOCAL RETVAL := SPACE(10) // FILL OUT 1ST "COLUMN" +IF LEN(NOTEARR) >= ELEM + RETVAL := RETVAL + ' ' + NOTEARR[ELEM] +ENDIF +IF LEN(RETVAL) < LEN(ALTVALU) + RETVAL := PADR(RETVAL, LEN(ALTVALU) ) +ELSE + IF LEN(RETVAL) > LEN(ALTVALU) + RETVAL := SUBS(RETVAL, 1, LEN(ALTVALU) ) + ENDIF +ENDIF +RETURN RETVAL +*************************************************************** +//* CALCULATE THE NUMBER OF LINES THAT WILL FIT ON EACH PAGE OF THE ORDER +//* AND THE NUMBER OF PAGES ON THE ORDER +*************************************************************** +FUNCTION CALC_PAGES(PBODY_ARR, PTAIL_ARR) +LOCAL STRT := 1, PG_NUM := 0, I +LOCAL NEW_PROD, PG_LINES := 0 +LOCAL LINES_LEFT := MBODY_LEN +LOCAL PG_ARR := {}, THIS_PG, WKPG +LOCAL NEWSTRT := 1, WK_LI_DESC + +IF LEN(PBODY_ARR) = 1 + AADD (PG_ARR, {1, 1}) + RETURN PG_ARR +ENDIF + +DO WHILE STRT < LEN(PBODY_ARR) + PG_LINES := 0 + // START ON FIRST PRODUCT + // WON'T FIND ANY IF ONLY MISC LINE ITEMS + FOR I := STRT TO LEN(PBODY_ARR) + IF SUBS(PBODY_ARR[I], 1,1)$'^' + STRT = I + EXIT + ENDIF + NEXT + THIS_PG := CNT_PAGE_LINES(STRT, PBODY_ARR, PTAIL_ARR) //** P3N - 05/15/01 +//** THIS_PG := CNT_PAGE_LINES(STRT, PBODY_ARR) //** P3N - 05/15/01 + STRT := STRT + THIS_PG +//** IF THIS_PG > MBODY_LEN //** P3N - 9/8/99 +//** DO WHILE THIS_PG > MBODY_LEN //** P3N - 9/8/99 + IF THIS_PG >= MBODY_LEN //** P3N - 9/8/99 + DO WHILE THIS_PG >= MBODY_LEN //** P3N - 9/8/99 + PG_NUM ++ + IF PG_NUM == 1 + SV_LI_DESC := SV_DESC_LINE_ITEM(PBODY_ARR, 1) //FIND LINE ITEM HEADING + ELSE + WK_LI_DESC := SV_DESC_LINE_ITEM(PBODY_ARR, (PG_NUM*MBODY_LEN)) //FIND LINE ITEM HEADING + IF EMPTY(WK_LI_DESC) + ELSE + SV_LI_DESC := WK_LI_DESC + ENDIF + ENDIF + + IF LEN(PBODY_ARR) > (PG_NUM*MBODY_LEN) + IF SUBS(PBODY_ARR[PG_NUM*MBODY_LEN], 1,1)$'^' + AADD (PG_ARR, {PG_NUM, MBODY_LEN-1 }) + THIS_PG := THIS_PG - MBODY_LEN+1 + ELSEIF THIS_PG = MBODY_LEN //** P3N 12/07/99 PAGE BRK + ELSE + //7-24-97 FIX PAGE BREAK LOGIC! + AADD (PG_ARR, {PG_NUM, PAGEBRK(PBODY_ARR, PG_ARR, PG_NUM) }) + THIS_PG := THIS_PG - PAGEBRK(PBODY_ARR, PG_ARR, PG_NUM) + ENDIF + ELSE + WKPG := MIN( LEN(PBODY_ARR)-(PG_NUM-1*MBODY_LEN),MBODY_LEN) + AADD (PG_ARR, {PG_NUM, WKPG }) + THIS_PG := THIS_PG - WKPG + ENDIF + ENDDO + ENDIF + PG_NUM ++ + IF PG_NUM == 1 //** P3N - 9/9/99 NO THE EARTH DID NOT COME TO AN END TODAY + SV_LI_DESC := SV_DESC_LINE_ITEM(PBODY_ARR, 1) //FIND LINE ITEM HEADING + ENDIF //** P3N - 9/9/99 NO THE EARCH DID NOT COME TO AN END TODAY + IF EMPTY(THIS_PG) //** P3N - 12/7/99 PAGE BRK + ELSE //** P3N - 12/7/99 PAGE BRK + AADD (PG_ARR, {PG_NUM, THIS_PG }) + ENDIF //** P3N - 12/7/99 PAGE BRK +ENDDO + +// PRINT NOTES AT BOTTOM OF EVERY PAGE. ALTER LINE COUNT ACCORDINGLY +IF !EMPTY((CUR_MAST)->NOTE_FIELD) .AND. (CUR_MAST)->PRNT_NOTES$'Y' + FOR I := 1 TO LEN(PG_ARR) + IF MBODY_LEN < PG_ARR[I,2] + PG_ARR[I,2] -- + ENDIF + NEXT +ENDIF + +RETURN PG_ARR +*************************************************************** +* FIND THE SPOT TO BREAK A PAGE CLEANLY!!! +*************************************************************** +FUNCTION PAGEBRK(PBODY_ARR, PG_ARR, PG_NUM) +LOCAL LOOPSTRT := 0 +LOCAL PG_BRK, I +IF EMPTY(PG_ARR) //** P3N - 8/20/99 + LOOPSTRT := LEN(PBODY_ARR) //** P3N - 8/20/99 +ELSE //** P3N - 8/20/99 + FOR I := 1 TO LEN(PG_ARR) //** P3N - 8/20/99 + LOOPSTRT := LOOPSTRT + PG_ARR[I,2] //** P3N - 8/20/99 + NEXT //** P3N - 8/20/99 + LOOPSTRT := LEN(PBODY_ARR) - LOOPSTRT //** P3N - 8/20/99 +ENDIF //** P3N - 8/20/99 +DO WHILE .T. + FOR I := LOOPSTRT TO 1 STEP -1 +//** IF SUBS(PBODY_ARR[I], 1,1)$'^' //** P3N - 3/20/98 + IF SUBS(PBODY_ARR[I], 1,1)$'^' .OR. ; + SUBS(PBODY_ARR[I], 1,1)$' ' + PG_BRK := I - 1 + EXIT + ENDIF + NEXT + IF PG_BRK > MBODY_LEN + LOOPSTRT := PG_BRK + LOOP + ELSE //** P3N - 8/20/99 + PG_BRK := ( MBODY_LEN - LEN(SV_LI_DESC) ) //** NO CLEAN BREAK FOUND - BREAK BASED + EXIT //** ON MBODY_LEN FROM CONTROL FILE + ENDIF +ENDDO +RETURN PG_BRK +*************************************************************** +* BLD A PAGE OF ORDER LINES FOR A GIVEN PRODUCT +*************************************************************** +//**FUNCTION CNT_PAGE_LINES( STRT, PBODY_ARR ) //** P3N - 05/15/01 +FUNCTION CNT_PAGE_LINES( STRT, PBODY_ARR, PTAIL_ARR) //** P3N - 05/15/01 +LOCAL I, ENDLINE := 0, NEW_PROD, RET_ARR := {} +LOCAL INLOOP := .F., WORKVAR +LOCAL NOTE_LEN := 0 //** P3N - 05/15/01 +IF EMPTY( (CUR_MAST)->NOTE_FIELD ) //** P3N - 05/15/01 +ELSEIF (CUR_MAST)->PRNT_NOTES$'Y' //** P3N - 05/15/01 + //** TAKE INTO ACCOUNT THE ORDER MASTER->NOTE_FIELD (UP TO 5 LINES OF 50 CHARS) + NOTE_LEN := INT (LEN(ALLTRIM( (CUR_MAST)->NOTE_FIELD) ) / 50 ) + NOTE_LEN := NOTE_LEN + 1 + LEN(PTAIL_ARR) //** P3N - 05/15/01 +ENDIF //** P3N - 05/15/01 +LINE_CNTR := 0 +DO WHILE .T. + THIS_PROD := CNT_PROD_LINES(STRT, PBODY_ARR ) + + // STORM COPY - ONLY ONE PRODUCT PER PAGE + IF SUBS( PBODY_ARR[STRT],2,1 ) = CHR(1) + WORKVAR := ENDLINE + THIS_PROD + IF WORKVAR < LEN(PBODY_ARR) .AND. SUBS( PBODY_ARR[WORKVAR + 1],2,1) = CHR(1) + ENDLINE := ENDLINE + THIS_PROD + RETURN ENDLINE + ELSEIF WORKVAR = LEN(PBODY_ARR) //** P3N - 4/8/98 + IF EMPTY(ENDLINE) //** P3N - 4/9/98 + RETURN THIS_PROD //** ONLY ONE STORM COPY - ONE PAGE! + ELSE + RETURN ENDLINE //** LAST ITEM ON STORM S/B ON OWN PAGE! + ENDIF + ENDIF + ENDIF + +//** IF ENDLINE + THIS_PROD <= MBODY_LEN //**P3N - 05/15/01 + IF ENDLINE + THIS_PROD <= ( MBODY_LEN - NOTE_LEN ) //**P3N - 05/15/01 + ENDLINE := ENDLINE + THIS_PROD + STRT := STRT + THIS_PROD + ELSE + IF ENDLINE > 0 + RETURN ENDLINE + ELSE // IF ENDLINE IS ZERO THIS MEANS THE PRODUCT + // WON'T FIT ON THE PAGE ( > 36 LINES [BODYLINES] ) + RETURN THIS_PROD + ENDIF + ENDIF + IF STRT > LEN(PBODY_ARR) + RETURN ENDLINE + ENDIF +ENDDO +********************************************************************* +* COUNT THE NUMBER OF LINES ON THE +********************************************************************* +FUNCTION CNT_PROD_LINES(STRT, PBODY_ARR) +LOCAL LAST_ROW := 1 +STRT ++ +DO WHILE STRT <= LEN(PBODY_ARR) + IF SUBS(PBODY_ARR[STRT], 1, 1 )$'^' //COUNT PRODUCT LINES + EXIT + ENDIF + IF SUBS(PBODY_ARR[STRT], 1, 2 )$'^'+CHR(1) //STORMPAGE EACH ITEM ON OWN PAGE + EXIT + ENDIF + LAST_ROW ++ + STRT ++ +ENDDO +RETURN LAST_ROW +******************************************************************* +* THIS FUNCTION WILL DETERMINE THE FORM TYPE USED FOR PRINTING +******************************************************************* +FUNCTION GET_FORMTYPE(WHCHORDER, WHICH_TYPE, SUBTYPE) +LOCAL RET_VAL := ' ', ORD_TYPE := WHCHORDER, PP_LOC := {'IOLA', 'LINDS', 'KC', 'PAWNEE' } +DO CASE + CASE SUBTYPE = 'PREBILL' .OR. SUBTYPE = 'PRECOST' + MLMAR := '' // DO NOT ADJUST THE LMAR/TMAR FOR FREE FORM PRT + MTMAR := 0 // FORCE TO '' / 0 RESPECTIVELY + RET_VAL := 'BLANK' + CASE SUBTYPE = 'DELIVERY' .AND. ; + ASCAN( PP_LOC, {|X| X = ALLTRIM(MHOME_LOC_CODE) } ) > 0 + RET_VAL := 'PREPRINT-TRACTOR' + CASE ORD_TYPE = 'INV' .AND. CUR_MAST = 'ORD_MAST' ; + .AND. ASCAN( PP_LOC, {|X| X = ALLTRIM(MHOME_LOC_CODE) } ) > 0 + RET_VAL := 'PREPRINT-TRACTOR' // NO EJECT MESSAGE + CASE ORD_TYPE == 'INV' .AND. CUR_MAST = 'ORD_MAST' + RET_VAL := 'PREPRINT' + CASE ORD_TYPE == 'BACKORD' .AND. CUR_MAST = 'ORD_MAST' ; //** P3N - 9/11/98 + .AND. ASCAN( PP_LOC, {|X| X = ALLTRIM(MHOME_LOC_CODE) } ) > 0 + RET_VAL := 'PREPRINT-TRACTOR' + OTHERWISE + MLMAR := '' // DO NOT ADJUST THE LMAR/TMAR FOR FREE FORM PRT + MTMAR := 0 // FORCE TO '' / 0 RESPECTIVELY + RET_VAL := 'BLANK' +ENDCASE +RETURN RET_VAL +******************************************************************* +* THIS FUNCTION WILL FORMAT THE MISC SIZE FOR PRINTING +******************************************************************* +FUNCTION FORMAT_MISCSIZE(P_SIZE) +LOCAL RETVAL, I +FOR I := 1 TO LEN(P_SIZE) + IF SUBST(P_SIZE,I,1)$'0123456789' + IF EMPTY(RETVAL) + RETVAL := SUBST(P_SIZE,I,1) + ELSE + RETVAL := RETVAL + SUBST(P_SIZE,I,1) + ENDIF + ENDIF +NEXT +IF EMPTY(RETVAL) .OR. LEN(RETVAL) > 4 + RETVAL := 'INV MISC SIZE' +ELSE +//** RETVAL := PADL(RETVAL, 4, ' ') + RETVAL := VAL(RETVAL) +ENDIF + +RETURN RETVAL +******************************************************************* +//** P3N - 12/15/98 +//** THIS FUNCTION WILL GET THE DEFUALT SOLICITATION NOTE +//** FROM THE CONTROL FILE (CGW0KA) +******************************************************************* +FUNCTION DEFAULTNOTE() +LOCAL SVSEL := SELECT(), RETNOTE := ' ', RETPOS := 0 +DBOPEN('CONTROL') +IF FIELDPOS('INVNOTES') > 0 + RETNOTE := CONTROL->INVNOTES +ENDIF +IF FIELDPOS('INVNOTEPOS') > 0 + RETPOS := CONTROL->INVNOTEPOS +ENDIF +CLOSE CONTROL +SELECT(SVSEL) +RETURN {RETNOTE, RETPOS} +******************************************************************* +//** P3N - 1/15/99 +//** THIS IS A POSTPROC FOR SCREEN 21350 - SELECTIVE SHIPPING +******************************************************************* +FUNCTION EDT_TMP_OST() +LOCAL SVREC := USERFILE2->(RECNO()) +LOCAL RETVAL := .T. +USERFILE2->(DBGOTOP()) +DO WHILE USERFILE2->(!EOF()) + IF USERFILE2->(FIELDPOS('SHIP_DATE') ) > 0 //** P3N - 01/15/02 + IF DUPOSTDATE(USERFILE2->SHIP_DATE, 'SHIP') + ERR_BOX('** Can NOT have the Same SHIP date on TWO shipment transactions! **') + RETVAL := .F. + EXIT + ENDIF + ELSEIF USERFILE2->(FIELDPOS('COMPL_DATE') ) > 0 //** P3N - 01/15/02 + IF DUPOSTDATE(USERFILE2->COMPL_DATE, 'COMPL') + ERR_BOX('** Can NOT have the Same COMPLETION date on TWO production Transactions! **') + RETVAL := .F. + EXIT + ENDIF + ENDIF //** P3N - 01/15/02 + USERFILE2->(DBSKIP(+1)) +ENDDO +USERFILE2->(DBGOTO(SVREC)) +RETURN RETVAL +******************************************************************* +//** P3N - 1/15/99 +//** THIS FUNCTION WILL ENSURE THERE ARE NO DUPLICATE ORD_SHIP TRANS. +******************************************************************* +FUNCTION DUPOSTDATE(CHKDATE, WHATDATE) +LOCAL SVREC := USERFILE2->(RECNO()) +LOCAL RETVAL := .F. , CNTR := 0 +USERFILE2->(DBGOTOP()) +DO WHILE USERFILE2->(!EOF()) + IF WHATDATE == 'SHIP' //** P3N - 01/15/02 + IF USERFILE2->SHIP_DATE == CHKDATE + CNTR := CNTR + 1 + ENDIF + ELSEIF WHATDATE == 'COMPL' //** P3N - 01/15/02 + IF USERFILE2->COMPL_DATE == CHKDATE + CNTR := CNTR + 1 + ENDIF + ENDIF + USERFILE2->(DBSKIP(+1)) +ENDDO +USERFILE2->(DBGOTO(SVREC)) +IF CNTR > 1 + RETVAL := .T. +ENDIF +RETURN RETVAL +***************************************************************** +* THIS FUNCTION IS INITIATED FROM THE IMPORT CUST VALID_FUNC FOR* +* THE FIELD PRNT_ID IN THE CGW0CS DATABASE. * +***************************************************************** +FUNCTION VALID_CS_PRNT_ID() //** P3N - 4/07/99 +LOCAL WKFLD := PRNT_ID, RETVAL := .F. +IF WKFLD$' YNS' + RETVAL := .T. +ELSEIF AT('?',WKFLD) > 0 + ERR_BOX(' Valid Print ID(PID) values:', ; + ' " " - Do NOT Print Extra(line) Description on Production', ; + ' "N" - Do NOT Print Extra(line) Description on Production', ; + ' "Y" - Print Extra(line) Description on Production Glass/Screen', ; + ' "S" - Print Column Format on Production Storm (ie: C200007)') +ELSE + ERR_BOX('** Invalid Print ID (PID) - "'+ WKFLD + '" **', ; + ' ','Valid Values Are: " ", "Y", "N" or "S" ', ; + ' ','Key a "?" for more information. ') +ENDIF +RETURN RETVAL + \ No newline at end of file diff --git a/CGWPRNT3.PRG b/CGWPRNT3.PRG new file mode 100644 index 0000000..1d4815d --- /dev/null +++ b/CGWPRNT3.PRG @@ -0,0 +1,428 @@ + +#include "FiveWin.ch" +#include "report.ch" + +#define MPAPDER_LETTER 1 // Letter 8 1/2 x 11 in +#define DMPAPER_LEGAL 5 // Legal 8 1/2 x 14 in + + +************************************************************************* + +FUNCTION CGW_PRNT_FROM_FILE( WHCHORDER, OUTFILE, LPREVIEW, RPTNAME, ; + LINELIMIT, COL_LEN, PAPER, ORIENTATION, MYFONT ) + +LOCAL CFILE := M->_THISUSER_TEMP +LOCAL MHDC +LOCAL OPRINTER1, OPRINTER2, OPRINTER3 +LOCAL CMODEL, CDOCUMENT, LUSER, LMODAL, LSELECTION +LOCAL MPRNTR +LOCAL OPRINTER, ODEVICE +LOCAL OREPORT +LOCAL RETVAL +LOCAL MDESC +LOCAL CKNAME, DATA2PRINT := '' +LOCAL FONTARR, OFONTWIDE, OFONT, OFONTBOLD, CTEXT +LOCAL FACT_W := 100, FACT_H := 100, SAVESEL := ALIAS() + + +DEFAULT LPREVIEW := .F. +// DEFAULT LINELIMIT := 54 +DEFAULT LINELIMIT := 64 +DEFAULT COL_LEN := 80 +DEFAULT MYFONT := 'NORMAL' +DEFAULT ORIENTATION := 'PORTRAIT' // 3/4/2021 + +NET_USE('&WORKSTAT',.F.,5,'WORKSTAT') +SELECT( SAVESEL ) + +MDESC := WHCHORDER + ' ' + +IF WHCHORDER = 'REPORT' + MDESC := ALLTRIM( RPTNAME ) +ELSEIF SELECT( 'ORD_MAST' ) > 0 + MDESC += 'Order ' + ALLTRIM( ORD_MAST->ORDER_NUM ) +ELSEIF SELECT( 'QUOTE_MAST' ) > 0 + MDESC += 'Quote ' + ALLTRIM( QUOTE_MAST->ORDER_NUM ) +ENDIF + +DO CASE + CASE WHCHORDER = 'REPORT' + CKNAME := GETPRINTER('ReportPrinter') + FACT_W := WORKSTAT->REPT_FACW + FACT_H := WORKSTAT->REPT_FACH + + PAPER := 'LETTER' // PER DARLENE 7-30-2020 + ORIENTATION := 'LANDSCAPE' // PER DARLENE 7-30-2020 + LINELIMIT := 36 // really no effect because the eject char is present. + // LINELIMIT := 40 + // LINELIMIT := 42 + + CASE WHCHORDER = 'PROD' + CKNAME := GETPRINTER('ProdPrinter') + FACT_W := WORKSTAT->PROD_FACW + FACT_H := WORKSTAT->PROD_FACH + + CASE WHCHORDER = 'GOLDEN' + CKNAME := GETPRINTER('GoldenPrinter') + FACT_W := WORKSTAT->GR_FACW + FACT_H := WORKSTAT->GR_FACH + + CASE WHCHORDER = 'DEL' + CKNAME := GETPRINTER('DelPrinter') + FACT_W := WORKSTAT->DEL_FACW + FACT_H := WORKSTAT->DEL_FACH + + CASE WHCHORDER = 'OD' + CKNAME := GETPRINTER('OrdDeskPrinter') + FACT_W := WORKSTAT->OD_FACW + FACT_H := WORKSTAT->OD_FACH + + CASE WHCHORDER = 'PO' + CKNAME := GETPRINTER('InterCompPrinter') + FACT_W := WORKSTAT->IC_FACW + FACT_H := WORKSTAT->IC_FACH + + CASE WHCHORDER = 'INV' + CKNAME := GETPRINTER('InvPrinter') + FACT_W := WORKSTAT->INV_FACW + FACT_H := WORKSTAT->INV_FACH + + CASE WHCHORDER = 'PREBILL' + CKNAME := GETPRINTER('PreBillPrinter') + FACT_W := WORKSTAT->PRE_FACW + FACT_H := WORKSTAT->PRE_FACH + + CASE WHCHORDER = 'BACKORD' + CKNAME := GETPRINTER('BackOrdPrinter') + FACT_W := WORKSTAT->BO_FACW + FACT_H := WORKSTAT->BO_FACH + + CASE WHCHORDER = 'PREBILL' + CKNAME := GETPRINTER('PreBillPrinter') + FACT_W := WORKSTAT->PRE_FACW + FACT_H := WORKSTAT->PRE_FACH + + CASE WHCHORDER = 'PRECOST' + CKNAME := GETPRINTER('PreCostPrinter') + FACT_W := WORKSTAT->PRE_FACW + FACT_H := WORKSTAT->PRE_FACH + + CASE WHCHORDER = 'QUOTE' + CKNAME := GETPRINTER('QuotePrinter') + FACT_W := WORKSTAT->QTE_FACW + FACT_H := WORKSTAT->QTE_FACH + +ENDCASE + +IF FACT_W = 0 + FACT_W := 100 +ENDIF + +IF FACT_H = 0 + FACT_H := 100 +ENDIF + + +// this is a redirected printer if it has a comma - leave it alone. 3-18-2021 +// CKNAME := SUBS( CKNAME, 1, AT( ',', CKNAME )-1 ) + + +IF FILE( CFILE ) + DATA2PRINT := ALLTRIM( MEMOREAD( CFILE ) ) + IF EMPTY( DATA2PRINT ) + // MSGSTOP( 'No Information to Print', 'Document NOT printed' ) + ELSE + + ODEVICE := TPRINTER():NEW( MDESC, .F., NIL, CKNAME ) + // DEFAULT IS LETTER + IF PAPER = 'LEGAL' + ODEVICE:SETPAGE( DMPAPER_LEGAL ) + ELSE + // INCLUDING PAPER = 'LETTER' + ODEVICE:SETPAGE( MPAPDER_LETTER ) + ENDIF + + // DEFAULT IS PORTRAIT + IF ORIENTATION = 'LANDSCAPE' + ODEVICE:setlandscape() + ELSE + ODEVICE:setportrait() + ENDIF + + FONTARR := CGW_SETFONT( @ODEVICE, WHCHORDER, @OREPORT, COL_LEN, NIL, FACT_W, FACT_H ) + OFONT := FONTARR[1] + OFONTBOLD := FONTARR[2] + OFONTWIDE := FONTARR[3] + + REPORT oReport ; + CAPTION MDESC ; + TO DEVICE ODEVICE ; + FONT oFont, OFONTBOLD, OFONTWIDE + + COLUMN DATA " " SIZE COL_LEN // * Trick "Data" - we're fooling Mother + + END REPORT + + OREPORT:LSCREEN := LPREVIEW + oreport:cname := MDESC + oReport:nTitleUpLine := RPT_NOLINE + oReport:nTitleDnLine := RPT_NOLINE + + // HALF INCH MARGINS + // oReport:Margin(.00, RPT_LEFT, RPT_INCHES) + // oReport:Margin(-.100, RPT_LEFT, RPT_INCHES) + + + CTEXT := MEMOREAD( ( ALLTRIM( OUTFILE ) ) ) + + + IF WHCHORDER = 'REPORT' + oReport:Margin( 0.500, RPT_LEFT, RPT_INCHES ) + oReport:Margin( 0.500, RPT_TOP, RPT_INCHES) + IF SUBS( CTEXT, 1, 2 ) = CR_LF() + CTEXT := SUBS( CTEXT, 2 ) + ENDIF + + ELSE + IF AT( CHR(27) + CHR(77), CTEXT ) > 0 // SET TO PICA - NOT NEEDED - THIS IS AN IMPACT PRINTER + oReport:Margin(-0.400, RPT_LEFT, RPT_INCHES) + ELSE + oReport:Margin(0.100, RPT_LEFT, RPT_INCHES) + ENDIF + // oReport:Margin(.56, RPT_TOP, RPT_INCHES) + oReport:Margin(.00, RPT_TOP, RPT_INCHES) + oReport:Margin(.00, RPT_BOTTOM, RPT_INCHES) + ENDIF + + + + + +// IF AT( CHR(27) + CHR(77), CTEXT ) > 0 // SET TO PICA - NOT NEEDED - THIS IS AN IMPACT PRINTER +// oReport:Margin(-0.400, RPT_LEFT, RPT_INCHES) +// ELSE +// oReport:Margin(0.100, RPT_LEFT, RPT_INCHES) +// ENDIF +// // oReport:Margin(.56, RPT_TOP, RPT_INCHES) +// oReport:Margin(.00, RPT_TOP, RPT_INCHES) +// oReport:Margin(.00, RPT_BOTTOM, RPT_INCHES) + + + + + + ACTIVATE REPORT oReport ; + ON INIT ( SayMemo(OREPORT, CTEXT, COL_LEN, LINELIMIT ), ; + OREPORT:LBREAK := .T. ) + + oFont:End() + OREPORT:END() + + ODEVICE:setportrait() + ODEVICE:SETPAGE( MPAPDER_LETTER ) + + ENDIF +ENDIF + +RETURN NIL + +******************************************************************************************** + +STATIC Function SayMemo(OREPORT, cText, COL_LEN, MAXLEN ) + +LOCAL cLine +LOCAL nFor, nLines, nPageln +LOCAL POS1, POS2, WIDE_DATA, CLINE1, CLINE2, CLINE_WORK + +IF LEN( OREPORT:ACOLS ) = 1 // 1ST TIME IN - SET COLUMN POSITIONS + AADD( OREPORT:ACOLS, 400 ) // 2 + AADD( OREPORT:ACOLS, 750 ) // 3 dup delivery - 4th one + AADD( OREPORT:ACOLS, 1200 ) // 4 + AADD( OREPORT:ACOLS, 1600 ) // 5 + AADD( OREPORT:ACOLS, 2000 ) // 6 + AADD( OREPORT:ACOLS, 2400 ) // 7 + AADD( OREPORT:ACOLS, 2800 ) // 8 + AADD( OREPORT:ACOLS, 3200 ) // 9 + AADD( OREPORT:ACOLS, 3600 ) // 10 + AADD( OREPORT:ACOLS, 4100 ) // 11 + AADD( OREPORT:ACOLS, 4400 ) // 12 + AADD( OREPORT:ACOLS, 4800 ) // 13 + AADD( OREPORT:ACOLS, 5200 ) // 14 + AADD( OREPORT:ACOLS, 5600 ) // 15 + +ENDIF + +// cText := MEMOREAD( ( cTextfile ) ) + +nLines := MlCount( cText, COL_LEN ) // Original text has up to 76 chars. per line. +nPageln := 0 + +FOR nFor := 1 TO nLines + cLine := MemoLine( cText, COL_LEN, nFor ) + + + IF AT( CHR(27) + CHR(77), CLINE ) > 0 // SET TO PICA - NOT NEEDED - THIS IS AN IMPACT PRINTER + CLINE := STRTRAN( CLINE, CHR(27) + CHR(77), '' ) + ENDIF + + + // this overrides the actual line-limit - calculated in the report building. + IF AT( CHR(12), CLINE ) > 0 // EJECT + + IF NFOR = NLINES ; // LAST LINE + .or. NFOR = NLINES-1 // LAST LINE + ELSE + CLINE := SUBS( CLINE, 1, AT( CHR(12), CLINE )-1 ) + OUTPUT_LINE( OREPORT, CLINE ) + nPageln := nPageln + 1 + OREPORT:EndPage() + NPAGELN := 0 + ENDIF + + ELSE + + OUTPUT_LINE( OREPORT, CLINE ) + + ENDIF + +NEXT + +RETURN NIL + +********************************************************* + +FUNCTION OUTPUT_LINE( OREPORT, CLINE ) +LOCAL POS1, CLINE1, CLINE2, POS2, WIDE_DATA, CLINE_WORK + + +oReport:StartLine() + +POS1 := AT( CHR(27) + 'W1', CLINE ) // WE FOUND AN ESCAPE SEQUENCE FOR WIDE PRINT +IF POS1 > 0 + + CLINE_WORK := CLINE + DO WHILE .T. + CLINE1 := SUBS( CLINE_WORK, 1, POS1-1 ) // EVERYTHING LEADING UP TO THE WIDE PRINT + CLINE2 := SUBS( CLINE_WORK, POS1+3 ) + POS2 := AT( CHR(27) + 'W0', CLINE2 ) + WIDE_DATA := ALLTRIM( SUBS( CLINE2, 1, POS2 - 1 ) ) + // CLINE2 := ALLTRIM( SUBS( CLINE2, POS2+3 ) ) + CLINE2 := SUBS( CLINE2, POS2+3 ) + + IF !EMPTY( CLINE1 ) + OREPORT:SAY( 1, CLINE1, 1 ) // 1ST COLUMN NORMAL FONT + ENDIF + + IF AT( 'DUPLICATE DEL', WIDE_DATA) > 0 + OREPORT:SAY( 5, WIDE_DATA, 3 ) + ELSEIF AT( 'DUPLICATE', WIDE_DATA) > 0 + OREPORT:SAY( 1, WIDE_DATA, 3 ) + ELSEIF VAL( WIDE_DATA ) > 0 // ORDER NUMBER + OREPORT:SAY( 3, WIDE_DATA, 3 ) + ELSE + MSGSTOP( 'WIDE VALUE NOT DEFINED' ) + OREPORT:SAY( 1, WIDE_DATA, 3 ) + ENDIF + + POS1 := AT( CHR(27) + 'W1', CLINE2 ) // WE FOUND AN ESCAPE SEQUENCE FOR WIDE PRINT + IF POS1 > 0 + CLINE_WORK := CLINE2 // REMAINDER OF DATA + ELSE + IF !EMPTY( CLINE2 ) + OREPORT:SAY( 11, CLINE2, 1 ) + ENDIF + EXIT + ENDIF + ENDDO + +ELSE + oReport:Say( 1, cLine, 1 ) // NORMAL font +ENDIF +oReport:EndLine() + + +RETURN NIL + + + + /* + OREPORT:SAY( 1, '111111', 1 ) + OREPORT:SAY( 2, '22222', 3 ) + OREPORT:SAY( 3, '33333' , 1 ) + OREPORT:SAY( 4, '44444' , 3 ) + OREPORT:SAY( 5, '55555' , 1 ) // DUPLICATE DEL + OREPORT:SAY( 6, '66666' , 3 ) + OREPORT:SAY( 7, '77777', 3 ) + OREPORT:SAY( 8, '88888' , 1 ) + OREPORT:SAY( 9, '99999' , 3 ) + OREPORT:SAY( 10, 'aaaaa' , 1 ) + OREPORT:SAY( 11, 'BBBBB' , 3 ) // + 20% = ORDER NUMBER AND Page 1 of 1 + OREPORT:SAY( 12, 'CCCCC' , 1 ) + OREPORT:SAY( 13, 'DDDDD' , 3 ) + OREPORT:SAY( 14, 'EEEEE' , 1 ) + OREPORT:SAY( 15, 'FFFFF' , 3 ) + */ + + +*********************************************************************** + +FUNCTION CGW_SETFONT( ODEVICE, WHCHORDER, OREPORT, COL_LEN, PASS_MYFONT, FACT_W, FACT_H ) + +LOCAL MYFONT, OFONT, OFONTB, OFONTW // REGULAR, BOLD, WIDE +LOCAL FORCEBOLD := .F., MALTFONT + +//MYFONT := 'Courier New' //** don - 01/11/02 - reactivated 4/21/2021 + MYFONT := 'Lucida Sans Typewriter' + +// 3-31-2021 +FACT_W := FACT_W / 100 +FACT_H := FACT_H / 100 + + +DEFINE FONT oFont NAME MYFONT +DEFINE FONT oFontB NAME MYFONT BOLD +DEFINE FONT oFontW NAME MYFONT BOLD + + +// adjust the bold font height/width slightly. +IF WHCHORDER = 'REPORT' + // myfont is hard coded above depending on the data's width + OFONT:NCLIPPRECISION := 2 + OFONT:NPITCHFAMILY := 49 + + OFONT:NWIDTH := 4.00 + OFONT:NHEIGHT:= 12 + + +ELSEIF MYFONT = 'Courier New' + // tiny bit too wide + oFont:nWIDTH := 6.90 + oFont:nHEIGHT:= 14.00 + + // OK TALL / TOO WIDE + oFontW:nWIDTH := 15.00 + oFontW:nHEIGHT:= 18.00 + +ELSE + // this is the default - MyFont is 'Lucida Sans Typewriter' + // OK TALL / TOO WIDE + oFont:nWIDTH := 7.25 + oFont:nHEIGHT:= 12.00 + +// test logic begin + // oFont:nWIDTH := 17.25 + // oFont:nHEIGHT:= 22.00 +// test logic end + + +ENDIF + +// 03/31/2021 +OFONT:NWIDTH *= FACT_W +OFONT:NHEIGHT *= FACT_H + + +RETURN { OFONT, OFONTB, OFONTW } + + +*********************************************** \ No newline at end of file diff --git a/CGWPRPO.PRG b/CGWPRPO.PRG new file mode 100644 index 0000000..9543d1b --- /dev/null +++ b/CGWPRPO.PRG @@ -0,0 +1,8149 @@ +// don lowenstein - June 1993 -(preproc) for acd on screen 2100 +// all unique procs for the CGW SYSTEM + +//** #INCLUDE 'CGWINCLD.PRG' +// #INCLUDE 'FIVEWIN.CH' + +#INCLUDE 'INKEY.CH' +#INCLUDE 'BOX.CH' + + +****************************************************************** + +FUNCTION ACD_ATTRIB_CUT() + +LOCAL SAVESEL := SELECT() +LOCAL SAVESCR := SAVESCREEN() +LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') + +IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' + ACD_PAR_CHILD(1, 'Cutting Attribute Definitions', {NIL, 'ATTRIB_CUT', .F. ,,'ADD',,,,,,.F., 'USERFILET'}) +ELSE + ACD_PAR_CHILD(3, 'Cutting Attribute Definitions', {NIL, 'ATTRIB_CUT', .F. ,,'REV',,,,,,.F., 'USERFILET'}) +ENDIF + +SELECT (SAVESEL) +RESTSCREEN(,,,,SAVESCR) +RETURN .T. + +****************************************************************** +FUNCTION CUT_SPEC_DISP(ACTION) +// DISPLAYS GB_EXTRA FOR SEQ_NUM IN CUT SPEC FILE + +LOCAL RETVAL := '' + +IF !EMPTY(ATT_CODE) + IF ACTION = 'PROFILE' + RETVAL := DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"PROFILE"}) + ELSE + RETVAL := DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"PRINT_DESC"}) +** RETVAL := RETVAL + ' ' + DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"DESC"}) + RETVAL := DISPVALUE(ATT_CODE,"ATTRIB_CUT",{"DESC"}) + ENDIF +ENDIF + +RETURN RETVAL + + +****************************************************************** + +FUNCTION SIZE_ERR( ) +ERR_BOX( ' Entry Sizes MUST Be HHHWWW ', ; + ' For NOMINAL SIZES or 99 X 99 ',; + " or 99G Basement or 9'9 Width Only",; + ' PLEASE RE-ENTER ') +RETURN .T. + +****************************************************************** +FUNCTION BLANK_1ST( ALLOW, FIELD, ALTPRICE ) +// CHECK TO SEE IF BLANK RECORD IS OK IF F10 ON EMPTY 1ST RECORD +LOCAL ALLOW_ENTER := .F. //** P3N - 6/30/98 +IF EMPTY(ALTPRICE) //** P3N - 6/30/98 + ALLOW_ENTER := .F. //** P3N - 6/30/98 +ELSEIF ALTPRICE == 'ALT_SPRICE' //** P3N - 6/30/98 + ALLOW_ENTER := .T. //** P3N - 6/30/98 +ENDIF //** P3N - 6/30/98 +IF ALLOW_ENTER //** ALLOW ENTER ON ALT_SPRICE EDIT - P3N - 6/30/98 + IF ALLOW .AND. EMPTY(&FIELD) .AND. RECNO() = 1 + REPLACE ORDER_NUM WITH ' ' + ENDIF + RETURN .T. +ELSE + IF LASTKEY() <> K_F10 + RETURN .F. + ELSE + IF ALLOW .AND. EMPTY(&FIELD) .AND. RECNO() = 1 + REPLACE ORDER_NUM WITH ' ' + RETURN .T. + ELSE + RETURN .F. + ENDIF + ENDIF +ENDIF + +****************************************************************** +FUNCTION DISPCOLOR(ADDL_MODE, REALFILE) +// DISPLAY THE COLOR OF PRODUCT ON THE LINE ITEM SCREEN FOR EACH MODEL + +LOCAL RETVAL, SEEKKEY +LOCAL SAVESEL := SELECT() + +IF REALFILE = NIL + REALFILE := 'USERFILE8' // USER ORDER_OPTS / ADDL_OPTS , NOT USERFILE8 +ENDIF + + +IF ADDL_MODE = NIL + ADDL_MODE := .F. +ENDIF + +IF ADDL_MODE + SEEKKEY := &CUR_MAST->ORDER_NUM + PROD_CODE + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' +ELSE + SEEKKEY := &CUR_MAST->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' +ENDIF + +SELECT (REALFILE) +SEEK SEEKKEY +IF FOUND() + RETVAL := TRIM( (REALFILE)->USER_RESP) +ELSE + RETVAL := 'N/A' +ENDIF +SELECT (SAVESEL) + +RETURN RETVAL + +****************************************************************** +FUNCTION NEED_CALC(ACTIONCODE, FLD_NAME, UP_RECNO) +LOCAL SAVESEL := SELECT(), ADDL_MODE, SEEKKEY +STATIC LASTVAL := NIL + +IF UP_RECNO = NIL + UP_RECNO := .F. +ENDIF + +ADDL_MODE := UP_RECNO + +IF UP_RECNO + REPLACE LINE_NUM WITH RECNO() +ENDIF + +IF PROCNAME(1) = 'EDITGBROW' // F10 KEY PRESSED + RETURN .T. +ENDIF + +IF ACTIONCODE = 'W' // A BU_WHEN CONDITION + LASTVAL := USERFILE2->&FLD_NAME +ELSE + IF ACTIONCODE = 'V' // VALID_FUNC + IF !EMPTY(LASTVAL) // CAN'T CHANGE CERTAIN ITEMS + IF LASTVAL == USERFILE2->&FLD_NAME + // LEAVE THE NEEDCALC FLAG ALONE! + ELSE // DIFFERENT VALUES + SELECT USERFILE8 + IF ADDL_MODE + SEEKKEY := &CUR_MAST->ORDER_NUM + USERFILE2->PROD_CODE + STR(USERFILE2->LINE_NUM,3) + ELSE + SEEKKEY := &CUR_MAST->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + ENDIF + SEEK SEEKKEY + IF FOUND() + SELECT (SAVESEL) + DO CASE + // IF SPECIAL PROTECTED FIELD, REVERT TO OLD VALUE - LEAVE CALC FLAG ALONE + CASE FLD_NAME == 'PROD_CODE' // CAN'T CHANGE MODEL NUMBER + REPLACE USERFILE2->PROD_CODE WITH LASTVAL + ERR_BOX( ' You Can NOT Change the MODEL ', ; + ' You may DELETE incorrect Line Items ', ; + ' Model Changed to Original Value ') + CASE FLD_NAME == 'STD_OPTS' // CAN'T CHANGE STD OPTS + REPLACE USERFILE2->STD_OPTS WITH LASTVAL + ERR_BOX( ' You Can NOT Change the STANDARD OPTIONS FLAG ', ; + ' You may DELETE incorrect Line Items ', ; + ' SO Changed to Original Value ') + OTHERWISE // DIFFERENT VALUE/NON PROTECTED/SET NEEDCALC + REPLACE USERFILE2->NEED_CALC WITH 'Y' + ENDCASE + ELSE /// NO USERFILE8 OPTS FOUND + SELECT (SAVESEL) + REPLACE USERFILE2->NEED_CALC WITH 'Y' + ENDIF + ENDIF + ELSE // WAS EMPTY LASTVAL - NEED A CALC + REPLACE USERFILE2->NEED_CALC WITH 'Y' + ENDIF + LASTVAL := NIL + REPLACE USERFILE2->GL311_AMT WITH ; + ( SET_GL311(USERFILE2->PROD_CODE) * USERFILE2->QUANTITY ) + ENDIF +ENDIF +RETURN .T. + +****************************************************************** +FUNCTION SET_TCALC() +LOCAL SAVESEL := SELECT(), SEEKKEY := &CUR_MAST->ORDER_NUM +LOCAL SAVEORD, TAGNAME + +IF &CUR_MAST->NEED_CALC$'Y' .AND. SELECT('USERFILE2') > 0 + SELECT USERFILE2 + IF FIELDPOS('NEED_CALC') > 0 + REPLACE ALL NEED_CALC WITH 'Y' + ENDIF +ENDIF +IF SELECT('USERFILE8') > 0 //** P3N - 5/18/98 + SELECT USERFILE8 + ZAP +ELSE + SELECT (CUR_OO) //** P3N - 5/18/98 + COPY STRUCTURE TO &USERFILE8 + NET_USE( USERFILE8, .T., 3, 'USERFILE8' ) +ENDIF +//*SELECT ORDER_OPTS +SELECT (CUR_OO) +SAVEORD := INDEXORD() +DONSETORD(1) +NDX_EXP = INDEXKEY() +SELECT USERFILE8 +**INDEX ON &NDX_EXP TO &USERFILE8 +IF __DBDRIVER = 'CDX' + TAGNAME := 'T1' + INDEX ON &NDX_EXP TAG &TAGNAME TO &USERFILE8 +ELSE + INDEX ON &NDX_EXP TO &USERFILE8 +ENDIF + + +//*SELECT ORDER_OPTS +SELECT (CUR_OO) +DONSETORD(SAVEORD) + +SELECT (SAVESEL) +RETURN .T. + +****************************************************************** +FUNCTION NEED_TCALC() +LOCAL SAVESEL := SELECT() +LOCAL LOOKARR, ELEM, I +LOCAL DBFVAR, G_ACT_LIST, GA_DBFVAR + +G_ACT_LIST := GETACTIVE() +IF EMPTY(G_ACT_LIST) .OR. EMPTY(GETLIST) + RETURN .T. +ENDIF + +I := G_ACT_LIST[2,1] +GA_DBFVAR := GETVARS[I,3] +DBFVAR := &GA_DBFVAR +MEMVAR := GETVARS[I,4] + +IF EMPTY(&CUR_MAST->NEED_CALC) + RETURN .T. +ENDIF + +IF DBFVAR == MEMVAR +ELSE + REC_LOCK(3) + REPLACE &CUR_MAST->NEED_CALC WITH 'Y' + UNLOCK +ENDIF +RETURN .T. + +****************************************************************** + +FUNCTION CGWACD(OPTION, TITLE, WHICHFILE) + + +// OPEN CUST_MAST FILE FOR CUSTOMER SPECIFIC OPTIONS +DBOPEN('CUST_MAST', .F.) //** P3N - 3/2/99 +// OPEN MATHPACK FILE FOR 'C' FIELDS +DBOPEN('MATHPACK', .F.) +DO CASE + CASE WHICHFILE = 'PRODUCTS' + ACD_PAR_CHILD(OPTION, TITLE, {'PRODUCT', 'PROD_ATTS', .T., 3, 'ADD' }) + + CASE WHICHFILE = 'CATEGORY' + ACD_PAR_CHILD(OPTION, TITLE, {'CATEGORY', 'CAT_ATTS', .T., 3, 'ADD' }) + +ENDCASE + +RETURN + +****************************************************************** + +FUNCTION CGWPRINT(OPTION, TITLE, WHICHFILE) +LOCAL GET_PARMS, PRNT_KEY, CORR_MSG, CORR +PRIVATE PAGE_BREAK + +CLS + +DO CASE + CASE WHICHFILE = 'MODEL OPTIONS' + SAYTITLE('Select Model to PRINT', 'PRDI' ) + DBOPEN('ATTRIBUTES') + GET_PARMS := DBOPEN('PRODUCT') + PRNT_KEY = GET_KEY(GET_PARMS, .T.) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + PRNTDISP(OPTION, TITLE, "MODEL OPTIONS") + + CASE WHICHFILE = 'CATEGORY OPTIONS' + SAYTITLE('Select CATEGORY to PRINT', 'PRDI' ) + DBOPEN('ATTRIBUTES') + GET_PARMS := DBOPEN('CATEGORY') + PRNT_KEY = GET_KEY(GET_PARMS, .T.) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + PRNTDISP(OPTION, TITLE, "CATEGORY OPTIONS") + + CASE WHICHFILE = 'MODEL BASE PRICE' + SAYTITLE('Select Model to PRINT', 'PRDI' ) + DBOPEN('CATEGORY') + GET_PARMS := DBOPEN('PRODUCT') + PRNT_KEY = GET_KEY(GET_PARMS, .T.) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + PRNTDISP(OPTION, TITLE, WHICHFILE) + + CASE WHICHFILE = 'CATEGORY BASE PRICE' + SAYTITLE('Select CATEGORY to PRINT', 'PRDI' ) + DBOPEN('PRODUCT') + GET_PARMS := DBOPEN('CATEGORY') + PRNT_KEY = GET_KEY(GET_PARMS, .T.) + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + SELECT PRODUCT + DONSETORD(3) + SEEK CATEGORY->CAT_CODE + DONSETORD(1) + CORR_MSG := 'PAGE BREAK BETWEEN PRODUCTS? ' + PAGE_BREAK := CORRCHEK( 10, CORR_MSG, , 2 ) +*- READ() + IF LASTKEY() = 27 .OR. PAGE_BREAK$'X' + CLOSE DATABASES + RETURN + ENDIF + PRNTDISP(OPTION, TITLE, WHICHFILE) + +ENDCASE + +RETURN + +****************************************************************** +FUNCTION SIZE_CONVERT( MPROD_CODE, IN_HM, OUT_HM, IN_WIDTH, IN_HEIGHT ) +LOCAL SAVESEL := SELECT(), RETVAL +LOCAL WORKVAR1, WORKVAR2 + +IF PRODUCT->(DBSEEK(MPROD_CODE)) + + DO CASE + CASE IN_HM = 'OS' + IF OUT_HM = 'TT' + WORKVAR1 := IN_WIDTH + PRODUCT->OS_WIDTH + PRODUCT->SAW_WIDTH + WORKVAR2 := IN_HEIGHT + PRODUCT->OS_HEIGHT + PRODUCT->SAW_HEIGHT + RETVAL := {WORKVAR1, WORKVAR2} + ELSEIF OUT_HM = 'NS' + WAIT_BOX('** NOT ACTIVE FOR "FROM" TT "TO" NS CONVERSIONS YET') + ENDIF + + CASE IN_HM = 'TT' + WAIT_BOX('** NOT ACTIVE FOR "FROM" TT CONVERSIONS YET') + IF OUT_HM = 'OS' + ELSEIF OUT_HM = 'NS' + ENDIF + + CASE IN_HM = 'NS' + WAIT_BOX('** NOT ACTIVE FOR "FROM" OS CONVERSIONS YET') + IF OUT_HM = 'TT' + ELSEIF OUT_HM = 'OS' + ENDIF + + ENDCASE +ENDIF +RETURN RETVAL + +* * * * * * * * * * +FUNCTION CGW11PRE(WHICHFILE) +// GET KEY --- PRODUCT ATTRIBUTE, FOR UPDATING OPTIONS + +LOCAL RETVAL +IF WHICHFILE = 'CATEGORY' + RETVAL := { USERFILE2->CAT_CODE, USERFILE2->ATT_CODE } +ELSE + IF WHICHFILE = 'PRODUCT' + RETVAL := { USERFILE2->PROD_CODE, USERFILE2->ATT_CODE } + ELSE + IF WHICHFILE = 'CUST' + RETVAL := { USERFILE3->CUST_ID, USERFILE3->PROD_CODE, USERFILE3->ATT_CODE } + ENDIF + ENDIF +ENDIF +RETURN RETVAL + +********************************************************** +FUNCTION CONT_PROC(M1, M2, M3) + +/// the system is pointing to the product parent record! +LOCAL SEEKKEY := PRODUCT->PROD_CODE +IF ( PROD_ATTS->(DBSEEK( SEEKKEY ) ) ) +ELSE + IF !PROMPT_BOX(M1,M2,M3) + CLEAR TYPEAHEAD + KEYBOARD CHR(27) + INKEY() + ENDIF +ENDIF +RETURN NIL + +****************************************************** +FUNCTION MAKE_MATH(FILENUM) +LOCAL USERFILE := 'USERFILE' + FILENUM +LOCAL SAVESEL := SELECT() +DBOPEN('PROD_OPTS') +DBOPEN('CAT_OPTS') +DBOPEN('MATHPACK') +IF SELECT('USERFILE5') > 0 + SELECT USERFILE5 + USE +ENDIF +SELECT MATHPACK +**COPY STRUCT TO &USERFILE5 +COPYSTRUCT(USERFILE5, .T.) +NET_USE('&USERFILE5', .T., 3, 'USERFILE5') +IF SAVESEL > 0 + SELECT (SAVESEL) +ENDIF +RETURN .T. + +*************************************************************** +FUNCTION WHCHPRICE(NCHOICE) +STATIC M_ARR + +@2,0 CLEAR TO 20,80 + +IF M_ARR = NIL + M_ARR := BLD_M_ARR() +ENDIF + +NCHOICE = LISTBOX(M_ARR, NCHOICE, 'Price Sheet') + +RETURN NCHOICE + + +************************************************** +FUNCTION BLD_M_ARR() +LOCAL M_ARR := {} +AADD(M_ARR, 'Dealer Price') +AADD(M_ARR, 'Special Dealer Price') +AADD(M_ARR, 'Builder/Build Stock Price') +AADD(M_ARR, 'Lumbermen Price') +AADD(M_ARR, 'Distributor Price') +AADD(M_ARR, 'Intercompany Price') +RETURN M_ARR + + +*************************************************************** +PROCEDURE CUSTP_TABLE( ) +LOCAL SAVESEL := SELECT(), SAVESCR := SAVESCREEN() +LOCAL CUSTID := USERFILE2->CUST_ID +LOCAL MPROD := USERFILE2->PROD_CODE +LOCAL MTITLE := 'Select CUSTOMER to Copy Pricing for Customer ' + ALLTRIM(CUSTID) + '/'+ALLTRIM(MPROD) +LOCAL FILE_CP := 'U'+ ALLTRIM(USERFILE2->PROD_CODE) //** P3N - 2/25/99 +LOCAL FILE_CP_SFX := '', PRICEFL := '', ORIGPRFL := '' //** P3N - 2/25/99 +LOCAL M1 := 'Customer pricing does not exist for this customer.' +LOCAL M2 := ' ' +LOCAL M3 := 'Do you want to copy pricing from an existing customer?' +LOCAL CPRICENUM := CUST_MAST->CPRICE_NUM + +IF USERFILE2->BASEFAC <> 0 + ERR_BOX('*** Price for this Product ' + MPROD + ' Customer # ' + CUSTID , ; + '*** Is Set Up as ' + STR(USERFILE2->BASEFAC,8,4) + '% of DEALER PRICE' ,; + '*** NO PRICE TABLE AVAILABLE ') + RETURN +ENDIF + +IF !CK_SPEC_PRICE( CUSTID, MPROD, CURDATE, 'USERFILE2' ) + ERR_BOX('*** NO SPECIAL Pricing Attributes FOUND', ; + '*** or SPECIAL Pricing Is EXPIRED', ; + '*** FOR This CUSTOMER - Set ATTS/OPTS 1st') + RETURN +ENDIF + +WAIT_BOX('*** Retrieving CUSTOMER PRICE TABLE ***', ; + '*** Please Wait ***') + +IF EMPTY(CPRICENUM) + DBOPEN('CONTROL') + IF CPRICE_NUM = 999 + ERR_BOX('*** 999 Customer Price Tables Defined', ; + '*** No More May Be Added - Call Don') + USE + SELECT(SAVESEL) + RETURN + ELSE + REC_LOCK(1) + REPLACE CPRICE_NUM WITH CPRICE_NUM + 1 + SELECT CUST_MAST + REC_LOCK(1) + REPLACE CUST_MAST->CPRICE_NUM WITH CONTROL->CPRICE_NUM + UNLOCK + CPRICENUM := CUST_MAST->CPRICE_NUM + SELECT CONTROL + USE + ENDIF + SELECT (SAVESEL) +ENDIF +FILE_CP_SFX := STR(CPRICENUM,3) //** P3N - 2/25/99 +FILE_CP_SFX := STRTRAN(FILE_CP_SFX, ' ', '0') //** P3N - 2/25/99 +PRICEFL := FILE_CP +'.'+FILE_CP_SFX //** P3N - 2/25/99 +IF FILE(PRICEFL) //** P3N - 2/26/99 +ELSEIF PROMPT_BOX(M1, M2, M3) //** P3N - 2/26/99 + @ 00, 00 CLEAR TO 24, 80 //** P3N - 2/26/99 + SAYTITLE( MTITLE, 'CUSTPR') //** P3N - 2/26/99 + GET_THE_CUST(' ') //** P3N - 2/26/99 + FILE_CP_SFX := STR(CUST_MAST->CPRICE_NUM,3) //** P3N - 2/26/99 + FILE_CP_SFX := STRTRAN(FILE_CP_SFX, ' ', '0') //** P3N - 2/26/99 + ORIGPRFL := FILE_CP +'.'+FILE_CP_SFX //** P3N - 2/25/99 + IF FILE(ORIGPRFL) //** P3N - 2/26/99 + COPY FILE (ORIGPRFL) TO (PRICEFL) //** P3N - 2/26/99 + ENDIF //** P3N - 2/26/99 +ENDIF //** P3N - 2/26/99 +CUST_MAST->(DBSEEK(CUSTID)) //** P3N - 2/26/99 + +CGWPRICE( NIL, 'CUSTOMER PRICING - ' + CUSTID + '/' + ALLTRIM(MPROD), ; + 99, CUSTID, MPROD, PADL(ALLTRIM(STR(CPRICENUM,3)),3,'0') ) + +SELECT (SAVESEL) +RESTSCREEN(,,,,SAVESCR) + +RETURN .T. + +*************************************************************** +PROCEDURE CGWPRICE(OPTION, TITLE, PNCHOICE, PPR_CUSTID, PPRODCODE, P_CPRICENUM ) + +LOCAL MODELPARMS := DBOPEN("PRODUCT"), CORRECT, SAVESCR2 +LOCAL MPROD_CODE, L, L2, POINTER, OFFSET, I , II, NUMVARS +LOCAL CURVAL, VARYPOS, FLD_ARR, PREFIX +LOCAL C_ARR := {}, R_ARR := {}, NEWFILE, NCHOICE +LOCAL COL_ARR := {}, ROW_ARR := {}, FILE1, FILE2 +LOCAL SEEKKEY, MFILE, DESC_ARR := {}, CHK_BLOCK, DBNAME +LOCAL CNTR, COUNT_ARR := {}, NUM_2_DO, MCODE +LOCAL NTOP, NLEFT, NRIGHT, NBOTTOM, TBARR := {} +LOCAL NUM_DONE, SAVESCR, LOOPKEY, MPRICE_SHEET +LOCAL REAL_FILE, OLDDESC_ARR := {}, MSG +LOCAL OLDDBF_ARR, NEWDBF_ARR, DIFFERENT, OLD_MFILE := '' +LOCAL MPERCENT, MCHOICE, OLD_PRICE_CD := '', CORR +LOCAL SV_SEL, SV_ORD, DLR_FILE, SV_REAL_FILE +LOCAL DESC_SIZE := 50, ELEM +LOCAL P1, P2, P3, P4, COPYTO +LOCAL PR_CUSTID := PPR_CUSTID +LOCAL CPRICENUM := P_CPRICENUM + +STATIC FILESOPEN, M_ARR, ALL_PR_ARR := {} + +IF PR_CUSTID = NIL + PR_CUSTID := SPACE(8) +ENDIF +//** P3N - 01/02/02 HAPPY NEW YEAR - LINDA +//**IF FILESOPEN = NIL .OR. SELECT('CAT_OPTS') = 0 + DBOPEN('ATTRIBUTES') + DBOPEN('ATT_OPTS') + + DBOPEN('CUST_ATTS') + DONSETORD(2) // CUSTID + PROD_CODE + ORDER + DBOPEN('CUST_OPTS') + DBOPEN('PROD_ATTS') + DONSETORD(2) // PROD_CODE + ORDER + DBOPEN('PROD_OPTS') + DBOPEN('CAT_ATTS') + DONSETORD(2) // CAT_CODE + ORDER + DBOPEN('CAT_OPTS') + FILESOPEN = .T. +//**ENDIF + +IF EMPTY(M_ARR) + M_ARR := BLD_M_ARR() +ENDIF + +SAVESCR = SAVESCREEN() +DO WHILE .T. + IF PNCHOICE = NIL .OR. PNCHOICE = 99 // MENU OPTION FOR UPDATE PRICE TABLES - PRODUCT OR CUSTOMER + CLS + SAYTITLE(TITLE,'PRPO') + IF PNCHOICE = NIL + MPROD_CODE := {GET_KEY( GET_FILEPARM("PRODUCT") )} + IF LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + ELSE + MPROD_CODE := {PPRODCODE} + ENDIF + ELSE + RESTSCREEN(,,,,SAVESCR) + ENDIF + DO WHILE .T. + IF PNCHOICE = NIL + NCHOICE := WHCHPRICE(1) + IF LASTKEY() = 27 + EXIT + ENDIF + ELSE + NCHOICE := PNCHOICE + ENDIF + + IF NCHOICE = 99 + MPRICE_SHEET = 'U' // USER SPECIFIC CUSTOMER PRICING + ELSE + MPRICE_SHEET = LEFT(M_ARR[NCHOICE],1) + ENDIF + + IF NCHOICE = 5 // IF IT'S DISTRIBUTOR + MPRICE_SHEET = 'J' // USE 'J' FOR THE CODE! (JOBBER) + ENDIF + + IF PNCHOICE <> NIL .AND. PNCHOICE <> 99 //PRINT THE BASE PRICE RPT + MFILE := PRODUCT->PROD_CODE + REAL_FILE := STRTRAN(ALLTRIM(MFILE), ' ', '_') + REAL_FILE := STRTRAN(REAL_FILE, '-', '_') + SV_REAL_FILE := REAL_FILE + REAL_FILE := MPRICE_SHEET + REAL_FILE + DLR_FILE := 'D' + SV_REAL_FILE + RETURN {REAL_FILE, DLR_FILE, MPRICE_SHEET} + ELSE // CALLED FROM A MENU / UPDATE SCREEN + IF PNCHOICE = NIL // REGULAR PRICING BUILD TABLE FROMMENU + MSG = M_ARR[NCHOICE] + ELSE + MSG = '' // CUSTOMER SPECIFIC PRICING + ENDIF + MFILE = MPROD_CODE[1] + MCODE = MFILE + REAL_FILE = STRTRAN(ALLTRIM(MFILE), ' ', '_') + REAL_FILE = STRTRAN(REAL_FILE, '-', '_') + REAL_FILE = MPRICE_SHEET + REAL_FILE + PREFIX := REAL_FILE + IF PNCHOICE = NIL + REAL_FILE = REAL_FILE + '.DBF' + ELSE + REAL_FILE = REAL_FILE + '.' + CPRICENUM + ENDIF + ENDIF + + // SEE IF IT'S THE SAME ONE TO DO, IF NOT BUILD THE STUFF FROM SCRATCH + ELEM := ASCAN(ALL_PR_ARR, {|X| X[1] == REAL_FILE .AND. X[5] == PR_CUSTID} ) + IF ELEM > 0 + FLD_ARR := ALL_PR_ARR[ELEM,2] + MFILE := ALL_PR_ARR[ELEM,3] + DESC_ARR := ALL_PR_ARR[ELEM,4] + ELSE + + SEEKKEY = MCODE // SEEK SO THE PERCENT OF DEALER STUFF IS ALWAYS VISIBLE + + IF !EMPTY(PR_CUSTID) + SELECT CUST_ATTS + FILE1 = 'CUST_ATTS' + FILE2 = 'CUST_OPTS' + DBNAME = 'CUST_ID + PROD_CODE' + SEEKKEY := PR_CUSTID + MCODE + CUST_ATTS->(DBSEEK(SEEKKEY)) + IF CUST_ATTS->(FOUND()) + ELSE +**********ERR_BOX('*** Customer Price table NOT FOUND! Pricing table/attributes', ; +********** '*** will be copied from the MODEL. You MUST save (F10) these', ; +********** '*** table/attributes to ensure accurate Price table creation!') + ENDIF + ENDIF + IF EMPTY(PR_CUSTID) .OR. !FOUND() + SEEKKEY = MCODE + SELECT PROD_ATTS + FILE1 = 'PROD_ATTS' + FILE2 = 'PROD_OPTS' + DBNAME = 'PROD_CODE' + SEEK SEEKKEY + IF !FOUND() + SELECT CAT_ATTS + SEEK SEEKKEY + FILE1 = 'CAT_ATTS' + FILE2 = 'CAT_OPTS' + DBNAME = 'CAT_CODE' + ENDIF + ENDIF + * SEEKKEY = MCODE + * + * SELECT PROD_ATTS + * FILE1 = 'PROD_ATTS' + * FILE2 = 'PROD_OPTS' + * DBNAME = 'PROD_CODE' + * SEEK SEEKKEY + * IF !FOUND() + ** SELECT PRODUCT + ** SEEK SEEKKEY + ** MCODE = CAT_CODE + ** SEEKKEY = MCODE + * + * SELECT CAT_ATTS + * SEEK SEEKKEY + * /// IF STILL NOT FOUND, DO MESSAGE THEN RETURN! + * FILE1 = 'CAT_ATTS' + * FILE2 = 'CAT_OPTS' + * DBNAME = 'CAT_CODE' + * ENDIF + // SITTING ON FILE1, EITHER PRODUCTS OR CATEGORY FILE OR CUST_ATTS FILE + // SHOULD HAVE FOUND AN APPROPRIATE RECORD + C_ARR := {} + R_ARR := {} + DO WHILE SEEKKEY == &DBNAME .AND. !EOF() + IF !EMPTY(PR_CUSTID) + IF LINK_CODE$'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_CODE$'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + ELSE + + DO CASE + CASE NCHOICE = 1 + IF LINK_CODE = 'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_CODE = 'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + + CASE NCHOICE = 2 + IF LINK_SD = 'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_SD = 'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + + CASE NCHOICE = 3 + IF LINK_BU = 'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_BU = 'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + + CASE NCHOICE = 4 + IF LINK_LU = 'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_LU = 'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + + CASE NCHOICE = 5 + IF LINK_DI = 'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_DI = 'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + + CASE NCHOICE = 6 + IF LINK_IN = 'C' + AADD(C_ARR, ATT_CODE) + ELSE + IF LINK_IN = 'R' + AADD(R_ARR, ATT_CODE) + ENDIF + ENDIF + + END CASE + ENDIF + + SKIP 1 + ENDDO + + // IF EMPTY C_ARR OR R_ARR, DO MESSAGE THEN RETURN + LOOPKEY = .F. + IF EMPTY(C_ARR) .OR. EMPTY(R_ARR) + IF MPRICE_SHEET$'D' + ERR_BOX( ' CANNOT find all ROW or COLUMN Information ', ; + ' for the ' + TRIM(MFILE) + ' Model! ', ; + ' Please Set them up in MODEL DEFINITIONS') + LOOPKEY = .T. + LOOP + ELSE + IF NCHOICE = 99 // CUSTOMER PRICING + MPERCENT = USERFILE2->BASEFAC + IF MPERCENT = 0 + ERR_BOX( ' CANNOT find all ROW or COLUMN Information ', ; + ' for Model ' + TRIM(MFILE) + ' Customer ' + PR_CUSTID, ; + ' and the % of DEALER was 0.00 ', ; + ' Please Set them up in CUSTOMER PRICING') + RETURN + ENDIF + ELSE + SELECT PRODUCT + DO CASE + CASE NCHOICE = 2 + MPERCENT = SD_BASEFAC + + CASE NCHOICE = 3 + MPERCENT = BU_BASEFAC + + CASE NCHOICE = 4 + MPERCENT = LU_BASEFAC + + CASE NCHOICE = 5 + MPERCENT = DI_BASEFAC + + CASE NCHOICE = 6 + MPERCENT = IN_BASEFAC + + ENDCASE + CORRECT := .F. + DO WHILE !CORRECT + @ 10,10 SAY 'Dealer Price Percentage' GET MPERCENT PICTURE '999.9999' + READ() + IF LASTKEY() = 27 + CORRECT := .T. + EXIT + ENDIF + CORR := CORRCHEK() + IF CORR = 'N' + LOOP + ELSE + CORRECT := .T. + IF CORR = 'Y' + SELECT PRODUCT + REC_LOCK(1) + DO CASE + CASE NCHOICE = 2 + REPLACE SD_BASEFAC WITH MPERCENT + CASE NCHOICE = 3 + REPLACE BU_BASEFAC WITH MPERCENT + CASE NCHOICE = 4 + REPLACE LU_BASEFAC WITH MPERCENT + CASE NCHOICE = 5 + REPLACE DI_BASEFAC WITH MPERCENT + CASE NCHOICE = 6 + REPLACE IN_BASEFAC WITH MPERCENT + END CASE + UNLOCK + ENDIF + ENDIF + ENDDO + ENDIF + LOOP + ENDIF + ENDIF + // IF IT GOT THIS FAR THEN IT'S GOING TO BE A PRICE TABLE + // NEED TO ZERO OUT ANY OLD PERCENTAGE AMOUNT FOR THIS TYPE + SELECT PRODUCT + REC_LOCK(1) + DO CASE + CASE NCHOICE = 2 + REPLACE SD_BASEFAC WITH 0 + + CASE NCHOICE = 3 + REPLACE BU_BASEFAC WITH 0 + + CASE NCHOICE = 4 + REPLACE LU_BASEFAC WITH 0 + + CASE NCHOICE = 5 + REPLACE DI_BASEFAC WITH 0 + + CASE NCHOICE = 6 + REPLACE IN_BASEFAC WITH 0 + + END CASE + UNLOCK + + SELECT (FILE2) + COL_ARR := {} + + FOR L = 1 TO LEN(C_ARR) + AADD(COL_ARR, {}) // MAKE ARRAY BUCKET FOR CURRENT ATTRIBUTE + + IF !EMPTY(PR_CUSTID) + CHK_BLOCK = {|| CUST_ID + PROD_CODE + ATT_CODE} + SELECT CUST_OPTS + FILE2 = 'CUST_OPTS' + SEEKKEY = PR_CUSTID + MPROD_CODE[1] + C_ARR[L] + SEEK SEEKKEY + ENDIF + IF EMPTY(PR_CUSTID) .OR. !FOUND() + // CHECK PRODUCT LEVEL NEXT + SELECT PROD_OPTS + CHK_BLOCK = {|| PROD_OPTS->PROD_CODE + PROD_OPTS->ATT_CODE} + + SEEKKEY = MPROD_CODE[1] + C_ARR[L] // MODEL + ATTRIBUTE + SEEK SEEKKEY + + IF !FOUND() + // CHECK CATEGORY LEVEL NEXT + SELECT CAT_OPTS + SEEKKEY = PRODUCT->CAT_CODE + C_ARR[L] // CAT CODE + ATTRIBUTE + SEEK SEEKKEY + CHK_BLOCK = {|| CAT_OPTS->CAT_CODE + CAT_OPTS->ATT_CODE} + ENDIF + + IF !FOUND() + // CHECK ATTRIBUTE LEVEL NEXT + SELECT ATT_OPTS + SEEKKEY = C_ARR[L] // ATTRIBUTE + SEEK SEEKKEY + CHK_BLOCK = {|| ATT_OPTS->ATT_CODE} + ENDIF + ENDIF + DO WHILE SEEKKEY == EVAL(CHK_BLOCK) .AND. !EOF() + AADD(COL_ARR[L], ALLTRIM(OPT_VALUE) ) + SKIP 1 + ENDDO + NEXT + // IF EMPTY COL_ARR, DO MESSAGE THEN RETURN + LOOPKEY = .F. + FOR L = 1 TO LEN(COL_ARR) + IF EMPTY(COL_ARR[L]) + ERR_BOX( ' CANNOT find COLUMN OPTION Info' , ; + ' for the ' + TRIM(MFILE) + ' Model! ', ; + ' Please Set them up in DEFAULT OPTIONS') + LOOPKEY = .T. + IF EMPTY(PR_CUSTID) + LOOP + ELSE + RETURN + ENDIF + ENDIF + NEXT + IF LOOPKEY + LOOP + ENDIF + + ROW_ARR := {} + FOR L = 1 TO LEN(R_ARR) + AADD(ROW_ARR, {}) // MAKE ARRAY BUCKET FOR CURRENT ATTRIBUTE + + IF !EMPTY(PR_CUSTID) + CHK_BLOCK = {|| CUST_ID + PROD_CODE + ATT_CODE} + SELECT CUST_OPTS + FILE2 = 'CUST_OPTS' + SEEKKEY = PR_CUSTID + MPROD_CODE[1] + R_ARR[L] + SEEK SEEKKEY + ENDIF + IF EMPTY(PR_CUSTID) .OR. !FOUND() + // CHECK IT AT THE PRODUCT LEVEL + SELECT PROD_OPTS + DONSETORD(1) // PROD_CODE + ATT_CODE + CHK_BLOCK = {|| PROD_OPTS->PROD_CODE + PROD_OPTS->ATT_CODE} + + SEEKKEY = MPROD_CODE[1] + R_ARR[L] + SEEK SEEKKEY + IF !FOUND() + // CHECK IT AT THE CATEGORY LEVEL + SELECT CAT_OPTS + DONSETORD(1) // CAT_CODE + ATT_CODE + SEEKKEY = PRODUCT->CAT_CODE + R_ARR[L] // CAT ATTT + ATTRIBUTE + SEEK SEEKKEY + CHK_BLOCK = {|| CAT_OPTS->CAT_CODE + CAT_OPTS->ATT_CODE} + ENDIF + IF !FOUND() + // CHECK ATTRIBUTE LEVEL NEXT + SELECT ATT_OPTS + SEEKKEY = R_ARR[L] // ATTRIBUTE + SEEK SEEKKEY + CHK_BLOCK = {|| ATT_OPTS->ATT_CODE} + ENDIF + ENDIF + + DO WHILE SEEKKEY == EVAL(CHK_BLOCK) .AND. !EOF() + AADD(ROW_ARR[L], ALLTRIM(OPT_VALUE) ) + SKIP 1 + ENDDO + NEXT + // IF EMPTY ROW_ARR, DO MESSAGE THEN RETURN + LOOPKEY = .F. + FOR L = 1 TO LEN(ROW_ARR) + IF EMPTY(ROW_ARR[L]) + ERR_BOX( ' CANNOT find ROW OPTION Info' , ; + ' for the ' + TRIM(MFILE) + ' Model! ', ; + ' Please Set them up in DEFAULT OPTIONS') + LOOPKEY = .T. + LOOP + ENDIF + NEXT + IF LOOPKEY + LOOP + ENDIF + + // BUILD FIELD LIST + FLD_ARR := {} + AADD(FLD_ARR, {'DESC', DESC_SIZE, 'C', 0}) // ADD REQUIRED FIELD FIRST! + FOR L = 1 TO LEN(COL_ARR) + FOR L2 = 1 TO LEN(COL_ARR[L]) + VAR = COL_ARR[L,L2] + VAR = STRTRAN(ALLTRIM(VAR), ' ', '_') + VAR = STRTRAN(VAR, '-', '_') + + // NO NUMERICS IN FIRST CHARACTER! + IF ISDIGIT(LEFT(VAR,1)) + VAR = 'V' + VAR + ENDIF + + // VAR CAN'T BE LONGER THAN 10 BYTES!!! + VAR = LEFT(VAR+SPACE(10), 10) + + AADD(FLD_ARR, {VAR, 7, 'N', 2 } ) + NEXT + NEXT + AADD(FLD_ARR, {'COL_HEAD1', 15, 'C', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'COL_HEAD2', 15, 'C', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'COL_HEAD3', 15, 'C', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'CUST_ID', 8, 'C', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'DATE_STAMP', 8, 'D', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'TIME_STAMP', 5, 'C', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'USER_STAMP', 8, 'C', 0}) // ADD REQUIRED FIELD FIRST! + AADD(FLD_ARR, {'UPDATED', 1, 'C', 0}) // ADD REQUIRED FIELD FIRST! + + NUMVARS := LEN(ROW_ARR) + + // SET UP THE 'DESC' FIELD VALUES + DESC_ARR := {} + ROWVARS := {} + CURVAL := {} + NUM_2_DO = 1 + FOR I = 1 TO NUMVARS // IE 3 ROW VARIABLES + NUM_2_DO = NUM_2_DO * LEN(ROW_ARR[I]) // IE 2 VALUES OF EACH VARIABLE + AADD(ROWVARS, LEN(ROW_ARR[I]) ) // IE # VALUES FOR THIS ATTRIBUTE + AADD(CURVAL, 1) // IE CURRENT VALUE POINTER FOR THIS ATTRIBUTE + NEXT + + FOR L = 1 TO NUM_2_DO // CREATE EMPTY ARRAY + AADD(DESC_ARR, '') + NEXT + + // MAKE ONE DESCVAR FOR EACH COMBINATION OF ALL ELEMENTS + // IE. FACTORIAL(ROW_ARR) + + VARYPOS := NUMVARS + POINTER := 0 + FOR I := 1 TO NUM_2_DO / ROWVARS[NUMVARS] // IE 3 ATTRIBUTES + FOR II := 1 TO ROWVARS[NUMVARS] // IE 2 CHOICES EACH ATTRIB + POINTER ++ + CURVAL[NUMVARS] := II + DESC_ARR[POINTER] := BLD_PRICE_LINE(ROW_ARR, CURVAL ) + NEXT + FOR III := NUMVARS-1 TO 1 STEP -1 + IF CURVAL[III] < ROWVARS[III] + CURVAL[III] ++ + EXIT + ELSE + CURVAL[III] := 1 + ENDIF + NEXT + NEXT + AADD(ALL_PR_ARR, {REAL_FILE, FLD_ARR, MFILE, DESC_ARR, PR_CUSTID} ) + ENDIF + + DIFFERENT = .F. + REAL_FILE = STRTRAN(ALLTRIM(MFILE), ' ', '_') + REAL_FILE = STRTRAN(REAL_FILE, '-', '_') + REAL_FILE = MPRICE_SHEET + REAL_FILE + IF CPRICENUM = NIL + REAL_FILE = REAL_FILE + '.DBF' + ELSE + REAL_FILE = REAL_FILE + '.' + CPRICENUM + ENDIF +** IF !FILE(REAL_FILE + '.DBF') + IF !FILE(REAL_FILE ) + NEWFILE = .T. + ELSE + // SEE IF STRUCTURE HAS CHANGED + NEWFILE = .F. + DIFFERENT = .F. + SET EXACT ON + NET_USE(REAL_FILE, .T., 5, 'REAL_FILE') + OLDDBF_ARR = ASORT(DBSTRUCT(),,, {|X,Y| X[1] < Y[1]}) // GET OLD STRUCTURE + NEWDBF_ARR = ASORT(ACLONE(FLD_ARR),,, {|X,Y| X[1] < Y[1]}) + IF LEN(OLDDBF_ARR) <> LEN(NEWDBF_ARR) + DIFFERENT = .T. + ELSE + FOR L = 1 TO LEN(OLDDBF_ARR) + IF OLDDBF_ARR[L,1] <> NEWDBF_ARR[L,1] + DIFFERENT = .T. + EXIT + ENDIF + NEXT + ENDIF + + // SEE IF THE 'DESC' FIELD VALUES HAVE CHANGED! + OLDDESC_ARR := {} + DO WHILE !EOF() + AADD(OLDDESC_ARR, ALLTRIM(DESC) ) + SKIP 1 + ENDDO + + IF LEN(OLDDESC_ARR) <> LEN(DESC_ARR) + DIFFERENT = .T. + ELSE + FOR L = 1 TO LEN(OLDDESC_ARR) + IF PADR(OLDDESC_ARR[L],DESC_SIZE) = PADR(DESC_ARR[L],DESC_SIZE) + ELSE + DIFFERENT = .T. + EXIT + ENDIF + NEXT + ENDIF + SET EXACT OFF + + IF DIFFERENT + IF PROMPT_BOX ('PRICE TABLE &/or OPTS for - ' + ALLTRIM(MFILE) + ' '+ ; + 'Have Possibly Changed!', ; //** P3N - 3/08/00 + '"YES" TO USE THE EXISTING ' + REAL_FILE, ; //** P3N - 3/08/00 + 'To RESTORE ORIGINAL FILE - copy '+ ; //** P3N - 3/08/00 + ALLTRIM(PREFIX) + '.OLD to ' + REAL_FILE, 1) //** P3N - 3/08/00 + SELECT REAL_FILE //** P3N - 3/08/00 + DIFFERENT := .F. //** P3N - 3/08/00 + FLD_ARR := DBSTRUCT() //** GET CURRENT STRUCTURE INFO + IF FILE(PREFIX+'.OLD') //** P3N - 12/27/01 + ERASE(PREFIX+'.OLD') //** P3N - 12/27/01 + ENDIF //** P3N - 12/27/01 + ALL_PR_ARR := {} //** P3N - 12/27/01 + ELSE //** P3N - 03/08/00 + SELECT REAL_FILE + USE + ?? CHR(7) + ERR_BOX( ' WARNING! The Pricing File for the ' + MFILE +' ', ; + ' Model has Changed! Some PRICES May Be LOST!', ; + ' Press to QUIT, or any other to continue.') + IF LASTKEY() = 27 + RETURN + ENDIF + ENDIF //** P3N - 03/08/00 + ENDIF + ENDIF + + IF NEWFILE .OR. DIFFERENT + IF DIFFERENT + NET_USE(REAL_FILE, .T., 5, 'REAL_FILE') + COPY TO &USERFILEX + COPYTO := ALLTRIM(PREFIX) + '.OLD' + COPY TO ©TO + USE + NET_USE(USERFILEX, .T., 5, 'TEMP_FILE') + ENDIF + + CREATE_DBF(REAL_FILE, FLD_ARR) + NET_USE(REAL_FILE, .T., 5, 'REAL_FILE') + + // LOAD THE ROW DESC RECORDS + NUM_ELEMS = LEN(DESC_ARR) + FOR L = 1 TO NUM_ELEMS + ADD_REC(3) + REPLACE DESC WITH DESC_ARR[L] + NEXT + + IF DIFFERENT + SELECT REAL_FILE + GOTO TOP + DO WHILE !EOF() + SELECT TEMP_FILE + LOCATE FOR ALLTRIM(DESC) == ALLTRIM(REAL_FILE->DESC) + IF FOUND() + REP_ONEREC('TEMP_FILE', 'REAL_FILE') + ENDIF + SELECT REAL_FILE + SKIP 1 + ENDDO + SELECT TEMP_FILE + USE + SELECT REAL_FILE + GOTO TOP + ENDIF + + ENDIF + + // DBROWSE WITH UPDATE ON CURRENT FILE + TBARR := {} + NTOP = 5 + NLEFT = 1 + NRIGHT = 78 + NBOTTOM = 20 + + P1 = 'Description' + P2 = 'DESC' + P3 = NIL + P4 = 30 + AADD(TBARR, {P1, P2, P3, P4}) + + FOR L = 2 TO LEN(FLD_ARR) + IF FLD_ARR[L,1] <> 'UPDATED' .AND. FLD_ARR[L,1] <> 'CUST_ID' + P1 = ALLTRIM(FLD_ARR[L,1]) + P2 = FLD_ARR[L,1] + P3 = 'REAL_FILE' + P5 = 'CK_PR_CHG()' + IF RIGHT(FLD_ARR[L,1],5) = 'STAMP' // AUDIT STAMPS + P7 = '.F.' + ELSE + P7 = NIL + ENDIF + AADD(TBARR, {P1, P2, P3, NIL, P5}) + ENDIF + NEXT + + //////////////////////////////////////////////////////////// + OLD_MFILE = MFILE // SAVE IT IN CASE WE HAVE TO DO IT AGAIN + OLD_PRICE_CD = MPRICE_SHEET + + @ 0,0 + TOPHEADING := {} + GOTO TOP + IF EMPTY(CPRICENUM) //P3N - 2-5-98 + XTITLE := TITLE + ' ' + PRODUCT->PROD_CODE + ELSE + XTITLE := TITLE + ' ' + CPRICENUM + ENDIF + DO WHILE .T. + BROWINST(XTITLE + ' ' + MSG, 'PRPO') + DBROWSE(NTOP,NLEFT,NBOTTOM,NRIGHT,.F.,TBARR,1,.F.,TOPHEADING) + @ 21,0 CLEAR + CORR = CORRCHEK() + IF CORR <> 'N' .OR. LASTKEY() = 27 + EXIT + ENDIF + ENDDO + SELECT REAL_FILE + IF !EMPTY(PR_CUSTID) // ONE TIME THRU FOR SPEC CUST PRICING + REPLACE ALL CUST_ID WITH PR_CUSTID + USE + RETURN + ELSE + USE // CLOSE THE MFILE + ENDIF + ENDDO +ENDDO + +RETURN +//******************************************************************* +//** P3N - 2/26/99 +//** F2-CUST PRICE HOTKEY TO REMOVE PRICE TABLE +//******************************************************************* +FUNCTION REMOVE_CUSTPR() +LOCAL CUSTID := USERFILE2->CUST_ID +LOCAL MPROD := USERFILE2->PROD_CODE +LOCAL MTITLE := 'Select CUSTOMER to Copy Pricing for Customer ' + ALLTRIM(CUSTID) + '/'+ALLTRIM(MPROD) +LOCAL FILE_CP := 'U'+ ALLTRIM(USERFILE2->PROD_CODE) +LOCAL FILE_CP_SFX := '', PRICEFL := '', ORIGPRFL := '' +LOCAL M1 := 'Are you sure you want to remove pricing for this Customer/Model?' +LOCAL M2 := ' ' +LOCAL M3 := 'Customer - ' + CUSTID + '/' +LOCAL CPRICENUM := CUST_MAST->CPRICE_NUM +FILE_CP_SFX := STR(CPRICENUM,3) +FILE_CP_SFX := STRTRAN(FILE_CP_SFX, ' ', '0') +PRICEFL := FILE_CP +'.'+FILE_CP_SFX +IF FILE(PRICEFL) + M3 := M3 + PRICEFL + IF PROMPT_BOX(M1, M2, M3) + ERASE(PRICEFL) + ENDIF +ENDIF +RETURN +*************************************************************** +FUNCTION CK_PR_CHG() +LOCAL GETO := GETACTIVE() + +IF GETO:CHANGED + AUDIT_STAMP( "PRICETABLE" ) +ENDIF +RETURN .T. + +*************************************************************** +FUNCTION BLD_PRICE_LINE(ROWARR, CURVARS) +LOCAL I, RETVAL + +FOR I = 1 TO LEN(ROWARR) + IF RETVAL = NIL + RETVAL := '' + ELSE + RETVAL := RETVAL + '-' + ENDIF + RETVAL := RETVAL + ALLTRIM(ROWARR[I,CURVARS[I]]) +NEXT + +RETURN RETVAL + +*************************************************************** +FUNCTION COPY_OPTS(WHICH_OPT_FILE, WHICH_FILE) +LOCAL SAVESEL := SELECT(), SAVEFILT +LOCAL SAVEORD, MAC, FILTEXP, SEEKKEY, MACX, NEWMSG +LOCAL FILTX +LOCAL NEWCUST := .F. //** P3N - 12/27/01 +PRIVATE CPYCUST := GETAVAR('CPYCUST') //** P3N - 12/27/01 +PRIVATE ITEMCATCODE + +IF EMPTY(CPYCUST) //** P3N - 12/27/01 + CPYCUST := '' //** P3N - 12/27/01 +ENDIF //** P3N - 12/27/01 +SELECT USERFILE1 +IF RECCOUNT() > 0 + RETURN .T. +ENDIF + +SELECT (WHICH_OPT_FILE) //CAT_OPTS OR ATT_OPTS +SAVEORD := INDEXORD() +SAVEFILT := DBFILTER() + // CALLED FROM PRODUCT SETUP +IF WHICH_FILE = 'PROD_OPTS' // 1ST, LOOK AT CATEGORY OPTS - 2ND TIME THRU + SEEKKEY := 'USERFILE2->ATT_CODE' + IF WHICH_OPT_FILE = 'CAT_OPTS' // CATEGORY OPTS TO PRODUCT OPTS +****SET FILTER TO CAT_CODE = PRODUCT->CAT_CODE + FILTEXP := 'CAT_CODE = PRODUCT->CAT_CODE' + DONSETORD(2) // ATT_CODE + OPTION + NEWMSG := 'CATEGORY' + ELSE + IF WHICH_OPT_FILE = 'ATT_OPTS' // ATTRIBUTE OPTS TO PRODUCT OPTS + ** SET FILTER TO ATT_CODE = USERFILE2->ATT_CODE + FILTEXP := 'ATT_CODE = USERFILE2->ATT_CODE' + DONSETORD(1) // ATT_CODE + OPTION + NEWMSG := 'SYSTEM ATTRIBUTE' + ENDIF + ENDIF +ELSE + IF WHICH_FILE = 'CAT_OPTS' // ATTRIBUTE OPTS TO CATEGOTY OPTS + SEEKKEY := 'USERFILE2->ATT_CODE' +** SET FILTER TO ATT_CODE = USERFILE2->ATT_CODE + FILTEXP := 'ATT_CODE = USERFILE2->ATT_CODE' + DONSETORD(1) // ATT_CODE + OPTION + NEWMSG := 'ATTRIBUTE' + ELSE + IF WHICH_FILE = 'CUST_OPTS' // CALLED FROM CUSTOMER PRICING SETUP + NEWCUST := .F. //** P3N - 12/27/01 + FILTEXP := '' //** P3N - 12/27/01 + SEEKKEY := CPYCUST + USERFILE3->PROD_CODE + USERFILE3->ATT_CODE + IF (WHICH_FILE)->(DBSEEK(SEEKKEY)) //** P3N - 12/27/01 + SELECT(WHICH_FILE) //** P3N - 12/27/01 + NEWCUST := .T. //** P3N - 12/27/01 + ENDIF //** P3N - 12/27/01 + SEEKKEY := 'USERFILE3->ATT_CODE' + IF WHICH_OPT_FILE = 'PROD_OPTS' // CATEGORY OPTS TO CUST_OPTS + ** SET FILTER TO PROD_CODE = USERFILE3->PROD_CODE + NEWMSG := 'PRODUCT' + IF NEWCUST //** P3N - 12/27/01 + NEWMSG := 'CUSTOMER' //** P3N - 12/27/01 + FILTEXP := 'CUST_ID == CPYCUST .AND. ' //** P3N - 12/27/01 + ENDIF //** P3N - 12/27/01 + FILTEXP := FILTEXP + 'PROD_CODE = USERFILE3->PROD_CODE' +//** FILTEXP := 'PROD_CODE = USERFILE3->PROD_CODE' + DONSETORD(2) // ATT_CODE + OPTION + ELSEIF WHICH_OPT_FILE = 'CAT_OPTS' // CATEGORY OPTS TO CUST_OPTS +********* SET FILTER TO CAT_CODE = ITEMCATCODE + ITEMCATCODE := GET_CATCODE(USERFILE3->PROD_CODE) + NEWMSG := 'CATEGORY' + IF NEWCUST //** P3N - 12/27/01 + NEWMSG := 'CUSTOMER' //** P3N - 12/27/01 + FILTEXP := 'CUST_ID == CPYCUST .AND. ' //** P3N - 12/27/01 + ENDIF //** P3N - 12/27/01 + FILTEXP := FILTEXP + 'CAT_CODE = ITEMCATCODE' //** P3N - 12/27/01 +//** FILTEXP := 'CAT_CODE = ITEMCATCODE' + DONSETORD(2) // ATT_CODE + OPTION + ELSEIF WHICH_OPT_FILE = 'ATT_OPTS' // ATTRIBUTE OPTS TO CUST_OPTS + **********SET FILTER TO ATT_CODE = USERFILE3->ATT_CODE + NEWMSG := 'SYSTEM ATTRIBUTE' + IF NEWCUST //** P3N - 12/27/01 + NEWMSG := 'CUSTOMER' //** P3N - 12/27/01 + FILTEXP := 'CUST_ID == CPYCUST .AND. ' //** P3N - 12/27/01 + ENDIF //** P3N - 12/27/01 + FILTEXP := FILTEXP + 'ATT_CODE = USERFILE3->ATT_CODE' + DONSETORD(1) // ATT_CODE + OPTION + ENDIF + ENDIF + ENDIF +ENDIF + +MAC := 'ATT_CODE == ' + SEEKKEY +SEEKKEY := &SEEKKEY +SEEK SEEKKEY + +** MACX := &('{|| ' + MAC + '}') + +MACX := MAKE_BLOCK(MAC) +FILTX := MAKE_BLOCK(FILTEXP) +DO WHILE EVAL(MACX) + IF EVAL( FILTX ) + __WHEREFROM := NEWMSG + SELECT USERFILE1 + IF NEWCUST //** P3N - 12/27/01 + ADD_ONEREC(WHICH_FILE, 'USERFILE1' ) //** CUST_OPTS + ELSE //** P3N -12/27/01 + ADD_ONEREC(WHICH_OPT_FILE, 'USERFILE1' ) + ENDIF //** P3N -12/27/01 + ENDIF + SELECT (WHICH_OPT_FILE) //CAT_OPTS OR ATT_OPTS + IF NEWCUST //** P3N - 12/27/01 + SELECT(WHICH_FILE) //** P3N - 12/27/01 CUST_OPTS + ENDIF //** P3N - 12/27/01 + SKIP 1 +ENDDO + +DONSETORD(SAVEORD) +SET FILTER TO &SAVEFILT +SELECT (SAVESEL) +RETURN .T. + +**************************************************** +**************************************************** +FUNCTION CAT_PAINT +// PUT COLUMN HEADING ON SCREEN FOR PRODUCTION INFO + +LOCAL SAVECOLOR := SETCOLOR(HNOR) +@ 11,1 SAY 'Conversion' +@ 12,1 SAY '--------------------' +@ 11,23 SAY 'Width' +@ 12,23 SAY '--------' +@ 11,34 SAY 'Height' +@ 12,34 SAY '--------' +SETCOLOR(SAVECOLOR) +RETURN NIL + +**************************************************** +** P3N - 02/13/04 ** +**************************************************** +FUNCTION CATPAINT2() +// PUT DOUBLE SPACING ORDER OPTIONS INFO ON SCREEN FOR CATEGORY SETUP + +LOCAL SAVECOLOR := SETCOLOR(HNOR) +@ 13,25 SAY '(Select Order Double Spacing Options)' +@ 14,07 SAY '-----------------------------------------------------------------------' +@ 15,34 SAY '( "F" Frame/"G" Glass/"S" Screen/"R" GoldRod )' +@ 16,34 SAY '( "D" Delivery/"O" OrderDesk /"I" ICO )' +@ 17,34 SAY '( "I" Invoice/"B" PreBill/"C" PreCost )' +@ 18,34 SAY '( "Y" Yes )' +SETCOLOR(SAVECOLOR) +RETURN NIL + +**************************************************** +FUNCTION GET_ORD_NUM(SCRNUM, CHGTYPE) +// GENERATE A NUMBER FOR A NEW ORDER + +LOCAL SAVESEL, MSG1, MORDER_NUM, NKEY +LOCAL LAST_GOOD_ORD, OLDCOLOR +LOCAL CLOSECTL := .T. //** P3N - 6/25/98 + +F5ORD := 0 //** P3N - 3/9/00 + +IF CHGTYPE <> NIL .AND. CHGTYPE = 'MANUAL' +**IF _CUROPT = 2 // CHANGE + RETURN '?' +ENDIF + +IF SELECT('USERFILE8') = 0 .AND. SCRNUM <> 'QCNV' + RETURN .T. +ENDIF +SAVESEL := SELECT() + +NKEY = NEXTKEY() +IF NKEY = ASC('Y') .OR. NKEY = ASC('y') .OR. NKEY = 19 // LEFT ARROW KEY +ELSE + CLEAR TYPEAHEAD +ENDIF + +IF CUR_MAST = 'ORD_MAST' + MSG1 := ' ADD New Sales ORDER? ' +ELSE + OLDCOLOR := SETCOLOR(BLOW) + @ 05,13 SAY ' ' + @ 06,13 SAY ' * * * * Q U O T E P R O C E S S I N G * * * * ' + @ 07,13 SAY ' ' + SETCOLOR(OLDCOLOR) + MSG1 := ' ADD New Sales QUOTE? ' +ENDIF +IF SELECT('CONTROL') > 0 //** P3N - 6/25/98 + CLOSE CONTROL + CLOSECTL := .F. +ENDIF +IF SCRNUM == 'QCNV' + DBOPEN('CONTROL') + REC_LOCK() + MORDER_NUM = STR( (VAL(ORDER_NUM) + 1),6) // GET NEW ORDER NUMBER + REPLACE ORDER_NUM WITH MORDER_NUM + USE +ELSE + IF PROMPT_BOX(MSG1,'','',1) // ASKS YES/NO, YES = .T., NO = .F. + DBOPEN('CONTROL') + REC_LOCK() + IF CUR_MAST = 'ORD_MAST' + MORDER_NUM = STR( (VAL(ORDER_NUM) + 1),6) // GET NEW ORDER NUMBER + REPLACE ORDER_NUM WITH MORDER_NUM + ELSE + MORDER_NUM = STR( (VAL(QUOTE_NUM) + 1),6) // GET NEW QUOTE NUMBER + REPLACE QUOTE_NUM WITH MORDER_NUM + ENDIF + USE + ELSE + MORDER_NUM = SPACE(6) // MAKE IT EMPTY + ENDIF +ENDIF +IF CLOSECTL //** P3N - 6/25/98 + //** SHOULD ALREADY BE CLOSED +ELSE + DBOPEN('CONTROL') +ENDIF +SELECT(SAVESEL) +@ 10,0 +RETURN MORDER_NUM + +************************************************************ +// RESET CONTROL FILE IF SOMEONE ESCAPED SOMEWHERE FROM NEW ORDER +FUNCTION RESET_CNTL(WHICHNUM) +LOCAL SAVESEL := SELECT() + +IF WHICHNUM = 'ORDER' + DBOPEN('CONTROL') + REC_LOCK(1) + REPLACE ORDER_NUM WITH STR( VAL(ORDER_NUM) - 1, 6) + USE +ELSE + IF NEWREC + IF CUR_MAST = 'ORD_MAST' + DBOPEN('CONTROL') + REC_LOCK(1) + IF (CUR_MAST)->ORDER_NUM = ORDER_NUM + REPLACE ORDER_NUM WITH STR( VAL(ORDER_NUM) - 1, 6) + ENDIF + USE + ELSE + DBOPEN('CONTROL') + REC_LOCK(1) + IF (CUR_MAST)->ORDER_NUM = QUOTE_NUM + REPLACE QUOTE_NUM WITH STR( VAL(QUOTE_NUM) - 1, 6) + ENDIF + USE + ENDIF + ENDIF +ENDIF + +SELECT (SAVESEL) + +RETURN +* +**************************************************** +FUNCTION UP_OM_NEED_CALC() +SELECT (CUR_MAST) +REC_LOCK(3) +REPLACE NEED_CALC WITH 'N' +UNLOCK +SELECT USERFILE2 +RETURN .T. + +**************************************************** +FUNCTION GET_LINEOPTS(MCODE, PACTION, UP_RECNO, ADDL_MODE) +// GET LINE OPTIONS FOR MODEL MCODE + + +LOCAL FILE1, FILE2, DBNAME, GET_ARR := {}, OPT_ARR := {}, WORKVAR +LOCAL SAVESEL := SELECT(), NCURSOR := SETCURSOR(1) +LOCAL ROW, SAVESCRN1 := SAVESCREEN(), SAVESCRN +LOCAL MORDER_NUM := &CUR_MAST->ORDER_NUM, EXITKEY, THISTITLE +LOCAL MLINE_NUM, MPROD_CODE +LOCAL SAVEDELIM := SET(_SET_DELIMITERS, .F.) +LOCAL MSTD_OPTS := USERFILE2->STD_OPTS, MTYPE, GET_IT +LOCAL SAVEREC, PRICE_ARR := {} +LOCAL SAVECURSOR := SETCURSOR(), PACK_FLAG +LOCAL CUR_PRICE_VALU := USERFILE2->SALE_PRICE +LOCAL RETVAL, NDX_EXP, FOUND_FLAG +LOCAL PIRATE_VAR, INFINAL := .F., TTEDIT +LOCAL CUR_USER_REC, MIDDLE, XSTD_OPTS, REPLINE +LOCAL DISC_ARR := {}, F7CALC_PRICE := 0 +LOCAL THIS_DISC_AMT := 0 +LOCAL PR_CUSTID := SPACE(8), RETARR := {}, M_MODEL +LOCAL HM_VAR, HMERR := .F., HM_VAROUT:="" + +STATIC P_CHGLIST := '' +STATIC O_CHGLIST := '' +STATIC STOP_SHOW := .F. + +PRIVATE SGACTION := PACTION +PRIVATE _SELFILE := SELECT() + +IF UP_RECNO = NIL + UP_RECNO := .F. +ENDIF + +IF ADDL_MODE = NIL + ADDL_MODE := .F. +ENDIF + +IF UP_RECNO + SELECT USERFILE2 + REPLACE LINE_NUM WITH RECNO() +ENDIF +MLINE_NUM = STR(USERFILE2->LINE_NUM,3) + +IF PROCNAME(1) = 'EDITGBROW' // F10 FINAL EDIT + INFINAL := .T. +ENDIF + +IF RECNO() = 1 + O_CHGLIST := '' // RESET CHANGED OPTION ITEMS + P_CHGLIST := '' // RESET CHANGED PRICE LINE ITEMS + STOP_SHOW := .F. // BE SURE STOP_SHOW ALWAYS FALSE +ENDIF // WHEN ENTERING THE PRICE FINAL EDIT + // ON 1ST RECORD + +IF SGACTION = NIL + IF !_OC_CAPABLE .OR. GETAVAR('ACTION_CODE') <> 'ADD' + SGACTION = 'REV' + ENDIF + + IF SGACTION = NIL + SGACTION = 'GET' + ENDIF + +**SGACTION = 'GET' +ENDIF + +IF PROCNAME(1) = 'EDITGBROW' .AND. USERFILE2->NEED_CALC = 'N' // DONT DO THE SYSTEM EDITS! + SET(_SET_DELIMITERS, SAVEDELIM) + IF RECNO() = LASTREC() .AND. STOP_SHOW + DISP_CHANGES(P_CHGLIST, O_CHGLIST) + + KEYBOARD CHR(1) // HOME KEY + RETURN .F. + ELSE + RETURN .T. + ENDIF +ENDIF + +CUR_USER_REC := RECNO() +PIRATE_VAR := FILL_EMPTY(MCODE, SGACTION, ADDL_MODE) +SELECT USERFILE2 +GOTO CUR_USER_REC +MCODE = USERFILE2->PROD_CODE +MPROD_CODE := MCODE +PRODUCT->(DBSEEK(MCODE)) +IF EMPTY(PRODUCT->ALLOW_SIZE) + HM_VAR := 'OTN' // ALLOW OS / TT / NS +ELSE + HM_VAR := PRODUCT->ALLOW_SIZE +ENDIF + +IF PIRATE_VAR == 'NO CONT' + IF RECNO() == 1 .AND. BLANK_1ST( .T.,'PROD_CODE') + SET(_SET_DELIMITERS, SAVEDELIM) + RETURN .T. + ELSE + ?? CHR(7) + ERR_BOX( ' MUST supply Missing Line Item Fields! ') + IF PROCNAME(1) = 'EDITGBROW' + RETURN .F. + ELSE + RETURN .T. + ENDIF + ENDIF +ENDIF + +// DO SPECIAL FIELD EDITS HERE! +// DO SPECIAL FIELD EDITS HERE! +// DO SPECIAL FIELD EDITS HERE! +// DO SPECIAL FIELD EDITS HERE! + +IF EMPTY(ENTRY_SIZE) // ONLY NEED TO CHECK IF EMPTY + // IF ! EMPTY, THE SIZE ALREADY VALIDATED + RETURN .F. +ENDIF + +IF !USERFILE2->STD_OPTS$'YN' + ERR_BOX( ' Invalid STANDARD OPTIONS CODE ' , ; + ' "Y" = Use Std Options ' ,; + ' "N" = Special Options ' ,; + ' PLEASE RE-ENTER') + RETURN .F. +ENDIF + +TTEDIT := CK_ENTRY_SIZE( HM_VAR, USERFILE2->ENTRY_SIZE, USERFILE2->HOW_MEAS ) + +IF TTEDIT == 'OK' + RND_WID_HT(MPROD_CODE, GET_ARR ) //CALC THE BILLING SIZE + BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE +ELSE + IF TTEDIT = 'INVALID' .OR. TTEDIT = 'MU' + RETURN .F. + ELSE + ERR_BOX( ' UNKNOWN TTEDIT CODE IN CGWPRPO ' , ; + ' ') + RETURN .F. + ENDIF +ENDIF + +// IN CASE OF AN EMPTY PRICE_SHEET +IF EMPTY(USERFILE2->PRICE_SHT) + DISC_ARR := CALC_DISC(USERFILE2->PROD_CODE) + IF !EMPTY(DISC_ARR[2]) + REPLACE USERFILE2->PRICE_SHT WITH DISC_ARR[2] + ELSE + REPLACE USERFILE2->PRICE_SHT WITH &CUR_MAST->PRICE_SHT + ENDIF +ENDIF + +IF PROCNAME(1) = 'EDITGBROW' + DO CASE + CASE PIRATE_VAR = 'NO_OPTS_NO_PIRATE' + SGACTION = 'GET' + + OTHERWISE + SGACTION = 'PRICE' + + END CASE +ENDIF + + +**IF LASTKEY() = -6 // F7 KEY - GET PRICE +IF LASTKEY() = K_F7 // F7 KEY - GET PRICE + DO CASE + CASE PIRATE_VAR = 'NO_OPTS_NO_PIRATE' + SGACTION = 'GET' + + OTHERWISE + SGACTION = 'PRICE' + + END CASE +ENDIF + + +IF SGACTION == 'PRICE' + WAIT_BOX(' *** Calculating Price *** ',; + ' *** PLEASE WAIT ***') +ENDIF + +M_MODEL = MCODE // SAVE MODEL NAME FOR PRICING LOOKUP, MCODE MIGHT BE CATEGORY LATER ON! + +IF CK_SPEC_PRICE( (CUR_MAST)->CUST_ID, MCODE, (CUR_MAST)->ORDER_DATE, 'CUST_BP' ) + PR_CUSTID := (CUR_MAST)->CUST_ID +ENDIF + +// GO GET THE GET_ARR AND PRICE_ARR FOR THIS MODEL +RETVAL = BUILD_GETARR(MCODE, 1, MORDER_NUM, MLINE_NUM, PIRATE_VAR, , ADDL_MODE, PR_CUSTID, , 'USERFILE2') +GET_ARR = RETVAL[1] +PRICE_ARR = RETVAL[2] + +RND_WID_HT(MPROD_CODE, GET_ARR ) //ROUND THE WIDTH AND HEIGHT BASED ON OPTIONS +BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE +PROD_SIZE(GET_ARR,MPROD_CODE, ADDL_MODE) // MAKE SURE CURRENT PROD SIZE INFO IS IN THERE + +LAST_CODE = MCODE // SAVE LAST MCODE + + +// SET THE INSTOCK, STDSIZE, ORIELSIZE FIELDS IN THE USERFILE RECORD +CK_STD_STOCK_SIZE(MPROD_CODE, GET_ARR, 'ALL', ADDL_MODE) + +IF SGACTION = 'GET' .OR. SGACTION = 'REV' + @ 0,0 CLEAR + THISTITLE := 'Line Item Options For Model '+ ALLTRIM(MCODE) + IF ADDL_MODE + THISTITLE := THISTITLE + '(Attach to ' + ALLTRIM(USERFILE2->PAR_COLOR) + ' '+ ALLTRIM(USERFILE2->PAR_PROD) + ')' + ENDIF + SAYTITLE(THISTITLE, 'PRPO') + @ 2,0 CLEAR +ENDIF + +//** P3N - 3/18/98 +F7CALC_PRICE := LASTKEY() + +RETARR := PROCESS_GETVALS( GET_ARR, ADDL_MODE, SGACTION, ; + STOP_SHOW, O_CHGLIST, P_CHGLIST, ; + MORDER_NUM, MLINE_NUM, MPROD_CODE, ; + M_MODEL, PR_CUSTID, PRICE_ARR, THISTITLE) +STOP_SHOW := RETARR[1] +O_CHGLIST := RETARR[2] +P_CHGLIST := RETARR[3] + +SETCURSOR(SAVECURSOR) +SELECT USERFILE2 +IF (CUR_PRICE_VALU <> USERFILE2->SALE_PRICE) ; + .AND. PROCNAME(1) = 'EDITGBROW' + STOP_SHOW := .T. + P_CHGLIST := P_CHGLIST + STR(RECNO() ,3) +ENDIF + +SELECT USERFILE2 + +//** P3N - 3/18/98 - F7 CALC PRICE DISPLAY ALL PRICING COMPONENTS +IF F7CALC_PRICE = K_F7 + DISP_PRICE_COMP() +ENDIF + +IF RECNO() = LASTREC() .AND. STOP_SHOW .AND. SGACTION = "PRICE" + DISP_CHANGES(P_CHGLIST, O_CHGLIST) + KEYBOARD CHR(1) // HOME KEY + RETVAL := .F. +ELSE + RETVAL := .T. +ENDIF + +SET(_SET_DELIMITERS, SAVEDELIM) +RESTSCREEN(,,,,SAVESCRN1) +SELECT(SAVESEL) + +RETURN RETVAL + +*************************************************************** +* //** P3N - 3/18/98 +* IF F7 KEY DEPRESSED - DISPLAY ALL PRICE COMPONENTS +* (IE: LINE ITEM - BASE_PRICE, OPT_PRICE, AND EXT_PRICE) +*************************************************************** +FUNCTION DISP_PRICE_COMP() +LOCAL L1 := 'Base Price - ' + STR(BASE_PRI,7,2) +LOCAL L2 := 'Opt. Price - ' + STR(OPT_PRI,7,2) +LOCAL L3 := 'Ext. Price - ' + STR(EXTRA_PRI,7,2) +LOCAL L4 := 'Sale Price - ' + STR(SALE_PRICE,7,2) +LOCAL L5 := 'SPECIAL CUSTOMER PRICING EXISTS' //** P3N - 07/17/02 +IF EMPTY(CUST_MAST->CPRICE_NUM) + L5 := '' +ENDIF +PRICEBOX( L5, L1, L2, L3, ; + ' --------', ; + L4, ; + ' ========') +RETURN .T. +//**************************************************************** +//** p3n - 05/01/03 *** +//** ADDRESS MSG LINES PASSED *** +//** (IE: MSG7 VARIABLE DOES NOT EXIST ABEND) *** +//**************************************************************** +FUNCTION PRICEBOX(LINE1, LINE2, LINE3, LINE4, LINE5, LINE6, LINE7) +LOCAL SCRN1, I, LONGEST, H, SAVECOL, SAVESCR +//**ATE LINEVAR, MSG1, MSG2, MSG3 +PRIVATE LINEVAR, MSG1, MSG2, MSG3, MSG4, MSG5, MSG6, MSG7 +CLEAR TYPEAHEAD +MSG1 := LINE1 +MSG2 := LINE2 +MSG3 := LINE3 +MSG4 := LINE4 +MSG5 := LINE5 +MSG6 := LINE6 +MSG7 := LINE7 +SAVECOL := SETCOLOR() +SETCOLOR(HREV) +SAVE SCREEN TO SAVESCR +LONGEST := 25 +FOR I = 1 TO PCOUNT() + LINEVAR := 'MSG' + STR(I,1) + IF &LINEVAR = NIL + ELSE + IF LEN(&LINEVAR) > LONGEST + LONGEST := LEN(&LINEVAR) + ENDIF + ENDIF +NEXT + +H = ((80 - LONGEST) / 2) +@ 12,H-5 CLEAR TO 17 + PCOUNT(),H+5+LONGEST +@ 12,H-5 TO 17 + PCOUNT(),H+5+LONGEST DOUBLE +V = 14 +@ V,H SAY LINE1 +IF PCOUNT() > 1 + V++ + @ V ,H SAY LINE2 +ENDIF +IF PCOUNT() > 2 + V++ + @ V,H SAY LINE3 +ENDIF +IF PCOUNT() > 3 + V++ + @ V,H SAY LINE4 +ENDIF +IF PCOUNT() > 4 + V++ + @ V,H SAY LINE5 +ENDIF +IF PCOUNT() > 5 + V++ + @ V,H SAY LINE6 +ENDIF +IF PCOUNT() > 6 + V++ + @ V,H SAY LINE7 +ENDIF +V++ +V++ +@ V,H SAY "Press Any Key to Continue" +INKEY(0) +RESTORE SCREEN FROM SCRN1 +SETCOLOR(SAVECOL) +RESTORE SCREEN FROM SAVESCR +RETURN (.T.) + + +*************************************************************** +* +*************************************************************** +FUNCTION CK_ENTRY_SIZE( HM_VAR, ENTSIZE, HOWMEAS ) + +LOCAL MIDDLE := AT('X', ENTSIZE) +LOCAL GPOS := AT('G', ENTSIZE) +LOCAL WOVAR := AT("'", ENTSIZE) +LOCAL FTVAR := 0 , I +LOCAL INVAR := 0 +LOCAL HMERR := .F., HM_VAROUT := '' + +FOR I := 1 TO LEN( ENTSIZE ) + IF SUBS(ENTSIZE,I,1)$"'" + FTVAR ++ + ENDIF +NEXT + +FOR I := 1 TO LEN( ENTSIZE ) + IF SUBS(ENTSIZE,I,1)$'"' + INVAR ++ + ENDIF +NEXT + +IF !EMPTY(HM_VAR) + DO CASE + CASE HOWMEAS=='TT' .AND. AT( 'T', HM_VAR ) = 0 + HMERR := .T. + CASE HOWMEAS=='OS' .AND. AT( 'O', HM_VAR ) = 0 + HMERR := .T. + CASE HOWMEAS=='NS' .AND. AT( 'N', HM_VAR ) = 0 + HMERR := .T. + CASE HOWMEAS=='WO' .AND. AT( 'W', HM_VAR ) = 0 + HMERR := .T. + CASE HOWMEAS=='BW' .AND. AT( 'B', HM_VAR ) = 0 + HMERR := .T. + CASE HOWMEAS=='OT' .AND. AT( '1', HM_VAR ) = 0 + HMERR := .T. + CASE HOWMEAS=='TO' .AND. AT( '2', HM_VAR ) = 0 + HMERR := .T. + ENDCASE + IF HMERR + IF AT('O', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"OS" ' + ENDIF + IF AT('T', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"TT" ' + ENDIF + IF AT('N', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"NS" ' + ENDIF + IF AT('W', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"WO" ' + ENDIF + IF AT('B', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"BW" ' + ENDIF + IF AT('1', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"OT" ' + ENDIF + IF AT('2', HM_VAR) > 0 + HM_VAROUT := HM_VAROUT + '"TO" ' + ENDIF + ERR_BOX('*** Invalid HOW MEASURE ', ; + '*** Valid Method(s) - ' + HM_VAROUT ) + RETURN 'INVALID' + ENDIF +ENDIF + + +WORKVAR := VAL_WD( 'USERFILE2', ENTSIZE) +DO CASE + CASE HOWMEAS=='TT' .AND. MIDDLE > 0 + TTEDIT := 'OK' + CASE HOWMEAS=='OS' .AND. MIDDLE > 0 + TTEDIT := 'OK' + CASE ( HOWMEAS=='NS' .AND. MIDDLE = 0 ) .OR. FTVAR = 2 + TTEDIT := 'OK' + CASE HOWMEAS=='WO' .AND. WORKVAR[2] = 'WO' + TTEDIT := 'OK' +* CASE HOWMEAS=='WO' .AND. WOVAR > 0 .AND. FTVAR = 1 +* TTEDIT := 'OK' +* CASE HOWMEAS=='WO' .AND. INVAR = 1 +* TTEDIT := 'OK' +* CASE HOWMEAS=='WO' .AND. VAL_WD('USERFILE2', ENTSIZE ) +* TTEDIT := 'OK' + CASE HOWMEAS=='BW' .AND. GPOS > 0 + TTEDIT := 'OK' + CASE HOWMEAS=='TO' .AND. MIDDLE > 0 + TTEDIT := 'OK' + CASE HOWMEAS=='OT' .AND. MIDDLE > 0 + TTEDIT := 'OK' + OTHERWISE + DO CASE + CASE HOWMEAS=='TT' + TTEDIT := 'MU' + CASE HOWMEAS=='OS' + TTEDIT := 'MU' + CASE HOWMEAS=='NS' + TTEDIT := 'MU' + CASE HOWMEAS=='WO' + TTEDIT := 'MU' + CASE HOWMEAS=='BW' + TTEDIT := 'MU' + CASE HOWMEAS=='TO' + TTEDIT := 'MU' + CASE HOWMEAS=='OT' + TTEDIT := 'MU' + OTHERWISE + TTEDIT := 'INVALID' + ENDCASE +ENDCASE + +IF TTEDIT = 'MU' // MIXED - UP + ERR_BOX( ' Size and HOW MEASURE are ILLOGICAL ' , ; + ' "TT/OS/TO/OT" = 99 X 99' , ; + ' "NS" = 9999 ' , ; + [ "WO" = 99'99 ] , ; + ' "BW" = 99G99 ') + REPLACE USERFILE2->HOW_MEAS WITH ' ' + TTEDIT := 'INVALID' +**RETURN .F. +ENDIF + +IF TTEDIT = 'INVALID' + ERR_BOX( ' Invalid HOW MEASURE CODE ' , ; + '"TT" = Tip to Tip "BW" = Basement Window ' , ; + '"OS" = Opening Size "WO" = Width Only ' , ; + '"TO" = TT WD - OS HT "OT" = OS WD - TT WD ' , ; + '"NS" = Nominal Size ') +**RETURN .F. +ENDIF + +RETURN TTEDIT +***************************************************************** + +FUNCTION PROCESS_GETVALS( GET_ARR, ADDL_MODE, SGACTION, ; + STOP_SHOW, O_CHGLIST, P_CHGLIST, ; + MORDER_NUM, MLINE_NUM, MPROD_CODE, ; + M_MODEL, PR_CUSTID, PRICE_ARR, THISTITLE) + +LOCAL PAGENUM := 0, STRTROW, ENDROW, FULLPAGE, FSTPAGE, GET_COL +LOCAL L, NUM2GET, L2, MTYPE, GET_IT, ROW, SAY_COL, DESCVAR +LOCAL CORRECT, EXITKEY, CORR, SAVEL, FSTGET, LASTGET +LOCAL REPLINE, PACK_FLAG, MOPT_VALUE, ELEM, XSTD_OPTS, SEEKKEY +LOCAL DISC_ARR, MSALE_PRICE, BPD, OPD, EPD +LOCAL PRNT_DESARR +LOCAL ASALE // P3N - 2/18/98 +LOCAL BASEPRICE_CUST // P3N - 2/18/98 + +// PUT GET ARRAY ON SCREEN +SETCOLOR(LNOR) +STRTROW = 2 +ENDROW := MAXROW() - 3 +FULLPAGE := ENDROW - STRTROW +FSTPAGE := .T. +PAGENUM := 0 +GET_COL = 35 + + +FOR L = 1 TO LEN(GET_ARR) + PAGENUM ++ + ROW := STRTROW + NUM2GET = 0 + NUMGOT := 0 + FSTGET := 0 + LASTGET := 0 + GOTFST := .F. +* IF SGACTION <> 'PRICE' +* @ 2,0 CLEAR +* ENDIF + DO WHILE ROW < ENDROW .AND. L <= LEN(GET_ARR) + NUM2GET++ + IF FSTGET = 0 + FSTGET := L + ENDIF + LASTGET := L + MTYPE = GET_ARR[L,2] + GET_IT = .F. + IF MTYPE$'UP' + GET_IT = .T. + ENDIF + + IF MTYPE = 'P' .AND. USERFILE2->STD_OPTS = 'Y' + GET_IT = .F. + + // MAKE SURE THERE ARE DEFAULTS IN THE PICK LIST + // LOOK FOR THE DEFAULT VALUE + IF GET_ARR[L,7] .OR. EMPTY(GET_DEFAULT(L,GET_ARR, ADDL_MODE)) + GET_IT = .T. + ENDIF + ENDIF + + GET_ARR[L,7] = GET_IT // LET ARR KNOW TO GET/SAY OR NOT! + + IF GET_IT .AND. (SGACTION = 'GET' .OR. SGACTION = 'REV') + IF !GOTFST + GOTFST := .T. + CLS + IF SGACTION = 'GET' .OR. SGACTION = 'REV' + IF SGACTION <> 'PRICE' + SAYTITLE(THISTITLE, 'PRPO') + @ 2,0 CLEAR + ENDIF + // PUT UP MSG FOR SECOND GET_ARR COLUMN +* IF CUR_OO = 'ACT_OPTS' +* PMSG = 'Actual # Before ' + DTOC(MDISP_DATE) +* @ 2,55 SAY PMSG +* ENDIF + ENDIF + ENDIF + ROW++ + NUMGOT ++ + DESCVAR := ALLTRIM(GET_ARR[L,5]) + SAY_COL = GET_COL - LEN(DESCVAR) -1 + @ ROW, SAY_COL SAY DESCVAR + + ENDIF + L++ // SET LOOP COUNTER TO NEXT ELEMENT + ENDDO + L-- // RESET LOOP COUNTER TO CORRECT ELEMENT + + IF SGACTION = 'GET' .OR. SGACTION = 'REV' + SAY_GET('SAY',GET_COL, L, NUM2GET, GET_ARR, USERFILE2->STD_OPTS, ADDL_MODE, STRTROW) + ENDIF + + * + * GET USER'S INPUT + * + CORRECT := .F. + EXITKEY = .F. + DO WHILE !CORRECT // AND IT IS EDIT MODE + IF SGACTION = 'GET' + SAY_GET( 'GET', GET_COL, L, NUM2GET, GET_ARR, USERFILE2->STD_OPTS, ADDL_MODE, STRTROW) + ENDIF + + IF LASTKEY() = 27 + CORRECT := .T. + EXITKEY = .T. + CORR := 'X' + L := LEN(GET_ARR) + 1 + SETKEY(-4,{|| ' '}) //** TURN OFF F5-PICKLIST HOTKEY - P3N - 6/18/98 + RETURN {STOP_SHOW, O_CHGLIST, P_CHGLIST} +******EXIT + ENDIF + IF EXITKEY + L := LEN(GET_ARR) + 1 + RETURN {STOP_SHOW, O_CHGLIST, P_CHGLIST} + ENDIF + CORR = ' ' + IF SGACTION = 'GET' .OR. SGACTION = 'REV' + SAY_GET('SAY',GET_COL, L, NUM2GET, GET_ARR, USERFILE2->STD_OPTS, ADDL_MODE, STRTROW) + FOR L2 = FSTGET TO LASTGET + IF GET_ARR[L2,7] // DID WE 'GET' THIS ONE? + IF GET_ARR[L2,4] = 'No DEFAULT' .OR. !VALID_PICK(GET_ARR, L2) + + ERR_BOX( 'INVALID Response for the ', ; + ALLTRIM(GET_ARR[L2,5]) + ' Option!', ; + ' PLEASE RE-ENTER ') + + CORR = 'N' + EXIT + ENDIF + ENDIF + NEXT + IF CORR = 'N' + LOOP + ENDIF + + IF NUMGOT > 0 + CORR := CORRCHEK( MAXROW()-1) + @ MAXROW()-1,0 CLEAR // ERASE CORRCHEK LINE + ENDIF + ELSE + CORR = 'Y' + ENDIF + + + IF CORR = 'N' + LOOP + ELSE + CORRECT := .T. + IF CORR = 'X' + CORRECT := .T. + EXITKEY = .T. + L = LEN(GET_ARR) // EXIT ENTIRE LOOP + EXIT + ELSE // ASSUMES CORR = 'Y' // good record - do the update + ENDIF + ENDIF + + ENDDO + +NEXT + +// CALCULATE/UPDATE BILLING/PRODUCTION SIZE BASED ON OPTIONS +// ALSO WILL CALC THE ACTUAL FINISHED PRODUCTION SIZE + +RND_WID_HT(MPROD_CODE, GET_ARR) //ROUND WID/HT ENTRY SIZE +BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE +PROD_SIZE(GET_ARR,MPROD_CODE, ADDL_MODE) + + +REPLINE := USERFILE2->LINE_NUM +SELECT USERFILE6 +REPLACE ALL UPDATED WITH 'X' FOR LINE_NUM = REPLINE +SELECT USERFILE2 +PACK_FLAG = .F. +SAVEL := L +FOR L2 = 1 TO LEN(GET_ARR) + + // SEE IF THERE IS A PARENT PRODUCT FOR THIS OPTION + // OR IF THERE IS AN ADDITIONAL PRODUCT FOR THIS OPTION + MOPT_VALUE = GET_ARR[L2,4] + IF !EMPTY(MOPT_VALUE) + ELEM = ASCAN(GET_ARR[L2,3], {|X| X[1] == MOPT_VALUE}) + IF ELEM > 0 + IF !EMPTY(GET_ARR[L2,3,ELEM,11]) // PARENT PRODUCT CODE + REPLACE USERFILE2->PAR_PROD WITH GET_ARR[L2,3,ELEM,11] + ENDIF + IF !EMPTY(GET_ARR[L2,3,ELEM,10]) // addl product code + IF USERFILE2->STD_OPTS <> 'Y' // USE USERFILE2 BECAUSE IT GETS UPDATED ON THE FLY IN + // PIRATE OPTS / FILL_EMPTY PROCESSING + XSTD_OPTS = CHK_ADDITIONAL(GET_ARR[L2,1],; + GET_ARR[L2,3,ELEM,10], GET_ARR[L2,5], GET_ARR[L2,4]) + ELSE + XSTD_OPTS = 'Y' + ENDIF + // SEE IF WE NEED TO ADDIT TO LINEITEM FILE + ADD_ADDITIONAL(GET_ARR[L2,3,ELEM,10], XSTD_OPTS, GET_ARR) + ENDIF + ENDIF + ENDIF + + + + // REEVALUATE ALL ITEMS SELECT FOR DEFAULT INCASE + // THE DEFAULT IS NOW DIFFERENT DUE TO USER RESPONSES + IF GET_ARR[L2,9] == '*' // DEFAULT + GET_ARR[L2,4] = GET_DEFAULT(L2, GET_ARR, ADDL_MODE) + ENDIF + + // UPDATE THE DATA FILE + IF GET_ARR[L2,2] = 'C' // CALC FIELD + UPDATE_MATH(L2, GET_ARR) // GO DO MATH CALCULATIONS + ENDIF + + // DON'T PUT DEFAULT OR EMPTY VALUES INTO THE ORDER OPTION FILE + IF ( EMPTY(GET_ARR[L2,4]) .OR. ; + GET_ARR[L2,9] == '*' ) .AND. ; + TRIM(GET_ARR[L2,1]) <> 'RANCH SLID' // ALWAYS WRITE RANCH SLIDER ATTRIBUTES + + SELECT USERFILE8 + IF ADDL_MODE + SEEKKEY = MORDER_NUM + MPROD_CODE + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE + ELSE + SEEKKEY = MORDER_NUM + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE + ENDIF + SEEK SEEKKEY + IF FOUND() + REC_LOCK(1) + DELETE + PACK_FLAG = .T. + ENDIF + ELSE // NOT DEFAULT OR EMPTY CHOICE OR N/A + SELECT USERFILE8 + IF ADDL_MODE + SEEKKEY = MORDER_NUM + MPROD_CODE + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE + ELSE + SEEKKEY = MORDER_NUM + MLINE_NUM + GET_ARR[L2,1] // ATT_CODE + ENDIF + SEEK SEEKKEY + IF !FOUND() + ADD_REC(3) + ELSE + REC_LOCK(3) + ENDIF + // SET KEY ON ORDER OPTS FILE + REPLACE ORDER_NUM WITH MORDER_NUM + REPLACE LINE_NUM WITH VAL(MLINE_NUM) + REPLACE ATT_CODE WITH GET_ARR[L2,1] + REPLACE USER_RESP WITH GET_ARR[L2,4] + IF ADDL_MODE + REPLACE PROD_CODE WITH MPROD_CODE + ENDIF + UNLOCK + ENDIF +NEXT +L := SAVEL + +// REMOVE RECORDS NO LONGER NEEDED! +SELECT USERFILE6 +DELETE ALL FOR UPDATED = 'X' +PACK + +IF PACK_FLAG + SELECT USERFILE8 + PACK +ENDIF + +// BUILD PRINT DESCRIPTION +// MSG TO SHOW PROCESSING IS OCCURING!! + +// CALCULATE/UPDATE BILLING/PRODUCTION SIZE BASED ON OPTIONS +// ALSO WILL CALC THE ACTUAL FINISHED PRODUCTION SIZE + +RND_WID_HT(MPROD_CODE, GET_ARR) //ROUND WID/HT ENTRY SIZE +BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) //CALC THE BILLING SIZE +PROD_SIZE(GET_ARR,MPROD_CODE, ADDL_MODE) + + +// SS CLEAR GLASS? USED IN GLASS BOX PROCESSING DURING PRINT. +CLR_SS_GLASS(GET_ARR, 'USERFILE2') + +// standard size edit +CK_STD_STOCK_SIZE(MPROD_CODE, GET_ARR, 'ALL', ADDL_MODE) + +// DO WE HAVE ANY SYSTEM LEVEL/PRODUCT LINE DISCOUNTS? +// THIS DISC% / PRICE_SHT COMES FROM CUST_PRICE OR (CUR_MAST) +DISC_ARR := CALC_DISC(USERFILE2->PROD_CODE) + +// GO GET PRICING +//**MSALE_PRICE = GET_SALEPRICE(M_MODEL, USERFILE2->PRICE_SHT, PRICE_ARR, GET_ARR, ADDL_MODE, PR_CUSTID) +ASALE := GET_SALEPRICE(M_MODEL, USERFILE2->PRICE_SHT, PRICE_ARR, GET_ARR, ADDL_MODE, PR_CUSTID) +MSALE_PRICE := ASALE[1] //* P3N - 2/18/98 +BASEPRICE_CUST := ASALE[2] //* P3N - 2/18/98 +IF &CUR_MAST->QUOTE_PRIC = 0 + // CALC THE SYSTEM DISCOUNT IF REQUIRED + IF USERFILE2->PRICE_SHT == DISC_ARR[2] .AND. EMPTY(USERFILE2->ALT_SPRICE) + REPLACE USERFILE2->SYS_DISC WITH DISC_ARR[1] + BPD:=0 + OPD:=0 + EPD:=0 + IF DISC_ARR[3] = 'Y' + BPD := (USERFILE2->SYS_DISC * USERFILE2->BASE_PRI * .01) + ENDIF + IF DISC_ARR[4] = 'Y' + OPD := (USERFILE2->SYS_DISC * USERFILE2->OPT_PRI * .01) + ENDIF + IF DISC_ARR[5] = 'Y' + EPD := (USERFILE2->SYS_DISC * USERFILE2->EXTRA_PRI * .01) + ENDIF + REPLACE USERFILE2->DISC_S_AMT WITH BPD + OPD + EPD + ELSE + IF (CUR_MAST)->DISCOUNT <> 0 + REPLACE USERFILE2->SYS_DISC WITH (CUR_MAST)->DISCOUNT + IF EMPTY(USERFILE2->ALT_SPRICE) .AND. EMPTY(USERFILE2->DISCOUNT) + REPLACE USERFILE2->DISC_S_AMT WITH MSALE_PRICE * ((CUR_MAST)->DISCOUNT*.01) + ELSEIF !EMPTY(USERFILE2->ALT_SPRICE) .AND. !EMPTY(USERFILE2->DISCOUNT) + REPLACE USERFILE2->DISC_S_AMT WITH USERFILE2->ALT_SPRICE * (USERFILE2->DISCOUNT*.01) + ELSEIF EMPTY(USERFILE2->ALT_SPRICE) + REPLACE USERFILE2->DISC_S_AMT WITH MSALE_PRICE * (USERFILE2->DISCOUNT*.01) + ELSE + REPLACE USERFILE2->DISC_S_AMT WITH 0 + REPLACE USERFILE2->SYS_DISC WITH 0 +******ELSE +****** REPLACE USERFILE2->DISC_S_AMT WITH USERFILE2->ALT_SPRICE * (USERFILE2->DISCOUNT*.01) + ENDIF + ELSE + REPLACE USERFILE2->SYS_DISC WITH 0 + REPLACE USERFILE2->DISC_S_AMT WITH 0 + ENDIF + ENDIF +ELSE // QUOTED PRICE + REPLACE USERFILE2->CALC_PRICE WITH MSALE_PRICE + MSALE_PRICE := 0 + REPLACE USERFILE2->DISCOUNT WITH 0 + REPLACE USERFILE2->SYS_DISC WITH 0 + REPLACE USERFILE2->DISC_S_AMT WITH 0 +ENDIF + +IF BASEPRICE_CUST //* P3N - 2/18/98 - PER ELLEN + REPLACE USERFILE2->DISCOUNT WITH 0 + REPLACE USERFILE2->SYS_DISC WITH 0 + REPLACE USERFILE2->DISC_S_AMT WITH 0 +ENDIF + +SELECT USERFILE2 +REPLACE SALE_PRICE WITH MSALE_PRICE + +IF USERFILE2->NEED_CALC <> 'N' + STOP_SHOW := .T. + O_CHGLIST := O_CHGLIST + STR( RECNO(), 3) +ENDIF +IF EMPTY(USERFILE2->ALT_SPRICE) //** P3N - 6/30/98 + //** ALLOW AN ALT PRICE TO BE ENTERED - NO STOP_SHOW +ELSE + STOP_SHOW := .F. //** P3N - 6/30/98 +ENDIF + +REPLACE USERFILE2->NEED_CALC WITH 'N' + +// BUILD PRINT DESCRIPTION +PRNT_DESARR := BLD_DESC(GET_ARR, 'USERFILE2') + +REPLACE USERFILE2->ITEM_DESC WITH PRNT_DESARR[1] +REPLACE USERFILE2->LINE_DESC WITH PRNT_DESARR[4] +IF USERFILE2->(FIELDPOS('LDESC_COPY')) > 0 + REPLACE USERFILE2->LDESC_COPY WITH PRNT_DESARR[5] +ENDIF +IF USERFILE2->(FIELDPOS('GLINE_DESC')) > 0 + REPLACE USERFILE2->GLINE_DESC WITH PRNT_DESARR[6] +ENDIF +REPLACE USERFILE2->LINE_DESC WITH PRNT_DESARR[4] +REPLACE USERFILE2->LOC_CODE WITH PRNT_DESARR[2] +REPLACE USERFILE2->GLASSORDER WITH IF(PRNT_DESARR[3], 'Y', 'N') + +RETURN { STOP_SHOW, O_CHGLIST, P_CHGLIST } + +*************************************************** + +FUNCTION DISP_CHANGES(P_CHGLIST, O_CHGLIST) + +LOCAL M1:= '' , M2 := '' +IF LEN(P_CHGLIST) > 0 + M1 = ' PRICE CHANGES on Lines ' + P_CHGLIST +ENDIF +IF LEN(O_CHGLIST) > 0 + M2 = ' OPTION CHANGES on Lines ' + O_CHGLIST +ENDIF + ERR_BOX( M1, ; + M2, ; + ' PLEASE REVIEW Each Line ') +RETURN .T. + +*************************************************** +FUNCTION CK_STOCK_SIZE(MPROD_CODE, GET_ARR) +// STOCK ITEM edit (proper stock rule and std_size) +LOCAL RESULT, SAVESEL := SELECT(), RETVAL := .T. + +// ONLY ITEMS WITH IN_STOCK$'X' GOT TO HERE. +// FIRST CHECK IF THERE IS A RULE AT THE SS FILE LEVEL +// THEN CHECK IF THERE IS A RULE AT THE PRODUCT FILE LEVEL +// IF NO RULES, RETURN .T. + +IF !EMPTY(STD_SIZES->RULE_PACK) + RESULT = CHK_RULE(STD_SIZES->RULE_PACK, GET_ARR, , _SELFILE) + IF RESULT + RETVAL := .T. + ELSE + RETVAL := .F. + ENDIF +ELSE + + SELECT PRODUCT + SEEK MPROD_CODE + + // stock item rule stored in the product file + IF !EMPTY(PRODUCT->RULE_PACK) + RESULT = CHK_RULE(PRODUCT->RULE_PACK, GET_ARR, , _SELFILE) + IF RESULT + RETVAL := .T. + ELSE + RETVAL := .F. + ENDIF + ENDIF + SELECT (SAVESEL) +ENDIF +RETURN RETVAL + +****************************************************************** +FUNCTION CK_STD_STOCK_SIZE(MPROD_CODE, GET_ARR, ACTION, ADDL_MODE) +LOCAL SAVESEL := SELECT(), RETVAL := .T. +LOCAL SAVEORD, ELEM1, ELEM2, PARENT_ARR +LOCAL POTENTIAL_STOCK:=.F., SEEKPROD +LOCAL OR_TOP := 0, OR_BOT := 0 +LOCAL OR_RES := 'N' +LOCAL SS_RES := 'N', SIZE_ARR +LOCAL SK_RES := 'N', MWIDTH := 0, MHEIGHT := 0 +LOCAL I, WK_TOP //P3N - 2/20/98 + +IF ACTION = NIL + ACTION = 'ALL' +ENDIF + +FILE2USE := 'USERFILE2' + + +MWIDTH := DECVAL( (FILE2USE)->WIDTH ) +MHEIGHT:= DECVAL( (FILE2USE)->HEIGHT) + + + +SELECT STD_SIZES +DONSETORD(2) + +ELEM1 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'ORIEL TOP'}) +ELEM2 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'ORIEL BOTT'}) +IF ELEM2 > 0 + OR_BOT := DECVAL(GET_ARR[ELEM2, 4]) +ENDIF +IF ELEM1 > 0 + OR_TOP := DECVAL(GET_ARR[ELEM1, 4]) +ENDIF + + + +IF EMPTY(USERFILE2->PAR_PROD) // NOT ADDL MODE +**SEEK MPROD_CODE + STR( (FILE2USE)->ACT_WIDTH,10,6) + STR( (FILE2USE)->ACT_HEIGHT,10,6) + SIZE_ARR := CONV_SIZE( MPROD_CODE, MWIDTH,; + MHEIGHT, (FILE2USE)->HOW_MEAS, .T.) + SEEK MPROD_CODE + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) +ELSE +* SIZE_ARR := CONV_SIZE(USERFILE2->PAR_PROD, DECVAL(USERFILE2->WIDTH),; +* DECVAL(USERFILE2->HEIGHT), USERFILE2->HOW_MEAS) +* SIZE_ARR := CONV_SIZE(USERFILE2->PAR_PROD, USERFILE2->ACT_WIDTH,; +* USERFILE2->ACT_HEIGHT, USERFILE2->HOW_MEAS) + SIZE_ARR := CONV_SIZE(USERFILE2->PAR_PROD, MWIDTH,; + MHEIGHT, USERFILE2->HOW_MEAS, .T.) +**SEEK USERFILE2->PAR_PROD + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) + SEEK MPROD_CODE + STR(SIZE_ARR[1],10,6) + STR(SIZE_ARR[2],10,6) +ENDIF +IF ADDL_MODE + PARENT_ARR := SET_PARENT(USERFILE2->ORDER_NUM+STR(USERFILE2->LINE_NUM) ) + SS_RES := PARENT_ARR[1] //STD_SIZE + SK_RES := PARENT_ARR[2] //IN_STOCK + OR_RES := PARENT_ARR[3] //ORIEL_SIZE +** SS_RES = PARENT SS +** SK_RES = PARENT SK +** OR_RES = PARENT OR +ELSE + IF FOUND() // POTENTIAL STD/STOCK/STOCK_ORIEL + SS_RES := 'Y' + IF STD_SIZES->ORIEL_SIZE$'X' .OR. OR_TOP <> OR_BOT + OR_RES := 'Y' + ELSE //** P3N - 2/20/98 -( KC ONLY SITE W\"IS ORIEL") + //** NON STANDARD ORIEL + I := ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'IS ORIEL'}) + IF EMPTY(I) + // NO IS ORIEL OPTION + ELSEIF ALLTRIM(GET_ARR[I,4]) == 'ORIEL' //USER OPT RESPONSE + OR_RES := 'Y' //SET AS AN ORIEL + I := ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'ORIEL TOP'}) + IF EMPTY(I) + // NO ORIEL TOP + ELSEIF EMPTY(GET_ARR[I,4]) //NO USER OPT RESPONSE FOR ORIEL TOP + //DEFAULT TO STD SIZE ORIEL TOP + IF EMPTY(STD_SIZES->ORIEL_TOP) + ELSE + WK_TOP := STR(STD_SIZES->ORIEL_TOP,7,4) + GET_ARR[I,4] := PADR(WK_TOP, 20, ' ') + ENDIF + ENDIF + ENDIF + ENDIF + + // NO ATTACHMENTS TO BE CONSIDERED IN STOCK + // 4-2-97 CHECK ATTACHMENTS FOR STOCK / PRODUCE ITEMS + **IF STD_SIZES->STOCK_SIZE$'X' .AND. EMPTY( (FILE2USE)->PAR_PROD ) + IF STD_SIZES->STOCK_SIZE$'X' + POTENTIAL_STOCK := CK_STOCK_SIZE(MPROD_CODE, GET_ARR) + ENDIF + + IF POTENTIAL_STOCK .AND. (FILE2USE)->STD_OPTS$'Y' + // NO ORIEL ATTRIBUTES FOUND .OR. SPECIFIED + IF (FILE2USE)->STD_OPTS$'Y' + IF OR_TOP = 0 .AND. OR_BOT = 0 + SK_RES := 'Y' + ENDIF + ENDIF + ENDIF + ELSE + IF OR_TOP <> OR_BOT + OR_RES := 'Y' + ENDIF + ENDIF +ENDIF + +REPLACE (FILE2USE)->STD_SIZE WITH SS_RES +REPLACE (FILE2USE)->IN_STOCK WITH SK_RES +REPLACE (FILE2USE)->ORIEL_SIZE WITH OR_RES + +DONSETORD(SAVEORD) + +SELECT (SAVESEL) +RETURN RETVAL + +****************************************************************** +* GET THE PARENT STOCK, STD_SIZE, ORIEL_SIZE * +****************************************************************** +FUNCTION SET_PARENT(KEY) +LOCAL RET_ARR := {'N', 'N', 'N'} +IF (CUR_OL)->(DBSEEK(KEY)) + RET_ARR[1] := (CUR_OL)->STD_SIZE + RET_ARR[2] := (CUR_OL)->IN_STOCK + RET_ARR[3] := (CUR_OL)->ORIEL_SIZE +ENDIF +RETURN RET_ARR +****************************************************************** +FUNCTION CONV_SIZE(PROD, MWIDTH, MHEIGHT, HM, USE_SAW) +// CONVERTS WIDTH,HEIGHT TO TIP TO TIP MEASUREMENT FOR PROD_CODE + +LOCAL SAVESEL := SELECT(), SAVEREC, ES_WD := 0, ES_HT := 0 +SELECT PRODUCT +SAVEREC := RECNO() +SEEK PROD + +IF USE_SAW = NIL + USE_SAW := .F. +ENDIF + +DO CASE + // THE FINAL SIZE IS THE CONVERTED ENTRY SIZE + CATEGORY ADJS + // AND ADJUSTMENTS BASED ON HOW MEASURED + + // THIS IS THE CONVERTED ENTRY SIZE OF EITHER STAND-ALONE PRODUCT + // OR THE PRODUCT IT IS TO BE ATTACHED TO. + CASE UPPER( HM ) == 'OS' //* OPENING SIZE + ES_WD := PRODUCT->OS_WIDTH + MWIDTH + ES_HT := PRODUCT->OS_HEIGHT + MHEIGHT + + CASE UPPER( HM ) == 'TO' //* TT WIDTH OS HEIGHT + ES_WD := PRODUCT->TT_WIDTH + MWIDTH + ES_HT := PRODUCT->OS_HEIGHT + MHEIGHT + + CASE UPPER( HM ) == 'OT' //* OS WIDTH TT HEIGHT + ES_WD := PRODUCT->OS_WIDTH + MWIDTH + ES_HT := PRODUCT->TT_HEIGHT + MHEIGHT + + CASE UPPER( HM ) == 'WO' //* WIDTH ONLY + ES_WD := PRODUCT->NS_WIDTH + MWIDTH + ES_HT := 0 + + CASE UPPER( HM ) == 'BW' //* BASEMENT WINDOW + ES_WD := PRODUCT->TT_WIDTH + MWIDTH + ES_HT := 0 + + CASE UPPER( HM ) == 'TT' //* TIP-TIP + ES_WD := PRODUCT->TT_WIDTH + MWIDTH + ES_HT := PRODUCT->TT_HEIGHT + MHEIGHT + + CASE UPPER( HM ) == 'NS' //* NOMINAL SIZE + ES_WD := PRODUCT->NS_WIDTH + MWIDTH + ES_HT := PRODUCT->NS_HEIGHT + MHEIGHT + +ENDCASE + +IF USE_SAW + ES_WD := ES_WD + PRODUCT->SAW_WIDTH + ES_HT := ES_HT + PRODUCT->SAW_HEIGHT +ENDIF + + +GOTO SAVEREC +SELECT (SAVESEL) + +RETURN {ES_WD, ES_HT} + +****************************************************************** +FUNCTION STD_SIZE_EDIT(MPROD_CODE) +LOCAL LEFTPART, RITEPART, TT_ARR := {} +LOCAL MIDDLE := AT(' X ', OPT_VALUE) +LOCAL NOM_SIZE := .F., MENTRY_SIZE := ALLTRIM(OPT_VALUE) +LOCAL REG_SIZE := .T. +LOCAL WDFEET, WDINCH, HTFEET, HTINCH +LOCAL LEFTVAL, RITEVAL, WONLY_OK := .F. +* +// CHECK FOR VALID 99 X 99 SIZE + +PRODUCT->(DBSEEK(MPROD_CODE)) +IF EMPTY(PRODUCT->ALLOW_SIZE) .OR. 'W'$PRODUCT->ALLOW_SIZE + WONLY_OK := .T. +ENDIF + +IF MIDDLE = 0 + REG_SIZE := .F. +ELSE + // GOT ?? X ??, NOW CHECK FOR VALID ITEMS BOTH SIDES OF "X" + LEFTPART = ALLTRIM(LEFT(OPT_VALUE, MIDDLE-1)) + RITEPART = ALLTRIM(SUBS(OPT_VALUE, MIDDLE+3)) + LEFTVAL := DECVAL(LEFTPART) + RITEVAL := DECVAL(RITEPART) + + IF !CHK_FRACTION(LEFTPART, 'EDIT') .OR. !CHK_FRACTION(RITEPART,'EDIT') + REG_SIZE := .F. + ELSEIF DECVAL(LEFTPART) = 0 + REG_SIZE := .F. + ELSEIF DECVAL(RITEPART) = 0 .AND. !WONLY_OK + REG_SIZE := .F. + ENDIF + +ENDIF + +IF !REG_SIZE .AND. !NOM_SIZE + IF EMPTY(OPT_VALUE) //** P3N - 4/2/98 + RETURN .T. //** ALLOW THE DELETION OF STD SIZES + ELSE + SS_ERROR() + RETURN .F. + ENDIF +ELSE + REPLACE OS_WIDTH WITH LEFTVAL + REPLACE OS_HEIGHT WITH RITEVAL + REPLACE OPT_VALUE WITH LEFTPART + ' X ' + RITEPART + TT_ARR := SIZE_CONVERT(MPROD_CODE, 'OS', 'TT', OS_WIDTH, OS_HEIGHT) + REPLACE TT_WIDTH WITH TT_ARR[1] + REPLACE TT_HEIGHT WITH TT_ARR[2] + +ENDIF + +RETURN .T. + +*********************************** + +FUNCTION SS_ERROR() +ERR_BOX( ' Standard Opening Sizes MUST Be in Format ', ; + ' 99 X 99 (With Fractions) ', ; + ' PLEASE RE-ENTER ') +RETURN .T. + + +* * * * * * * * * * * * * +STATIC PROCEDURE SAY_GET(CMD, GET_COL, LAST_GETVAR, NUM2GET, GET_ARR, MSTD_OPTS, ADDL_MODE, ROW) +LOCAL I, STRT_INLIST, L2, NUMGET := 0 +**LOCAL ROW + +SETCOLOR(HNOR) +**ROW = 4 + +STRT_INLIST = LAST_GETVAR - NUM2GET + 1 +FOR I := STRT_INLIST TO LAST_GETVAR + + IF GET_ARR[I,7] // PROCESS THIS ONE? + ROW++ +*** NUMGET++ + NUMGET := NUMGET + 1 + IF CMD = 'SAY' + @ ROW,GET_COL SAY ':' + @ ROW,GET_COL+1 SAY GET_ARR[I,4] + @ROW(), COL() SAY ':' + ELSE // GETLOOP + @ ROW,GET_COL+1 GET GET_ARR[I,4] WHEN WHEN_GET(GET_ARR, ADDL_MODE) ; + VALID VALID_GET(GET_ARR, ADDL_MODE) + ENDIF + ENDIF +NEXT +IF CMD = 'GET' .AND. NUMGET > 0 + READ() +ENDIF +SETCOLOR(LNOR) + +RETURN + + +* * * * * * * * * * * * * +FUNCTION VALID_GET(GET_ARR, ADDL_MODE) +// THIS IS THE VALID CONDITION ON THE GETS IN SAY_GET +// NEED TO VALIDATE THE PICK LIST INPUT + +LOCAL X, ELEM, NEW_VAL, MTYPE, ELEM2, RESULT +LOCAL DEF_VALU, OPT_ARR, CUROPT + +// IF IT'S A CURSOR MOVEMENT, DON'T DO THE VALID +IF LASTKEY() = K_UP .OR. LASTKEY() = K_DOWN .OR. LASTKEY() = K_PGUP ; + .OR. LASTKEY() = K_PGDN + @ 0,0 SAY SPACE(12) + SETKEY(-4,{|| ''}) + RETURN .T. +ENDIF + +X = GETACTIVE() +ELEM = X[2,1] +*****NEW_VAL = X[12] +NEW_VAL = X:BUFFER +MTYPE = GET_ARR[ELEM,2] + //** P3N - 10/13/06 - PER ELLEN IF ADDL OPT USE PARENT FRAME COLOR +CUROPT := GET_ARR[ELEM,1] //** P3N - 10/13/06 + +DO CASE + CASE MTYPE$'PT' // PICK LIST OR TABLE LIST??? + IF ADDL_MODE //** P3N - 10/13/06 + IF CUROPT = 'FR COLOR' //** P3N - 10/13/06 + IF EMPTY(NEW_VAL) //** P3N - 10/13/06 + NEW_VAL := USERFILE2->PAR_COLOR //** P3N - 10/13/06 + ENDIF //** P3N - 10/13/06 + ENDIF //** P3N - 10/13/06 + ENDIF //** P3N - 10/13/06 + ELEM2 = ASCAN(GET_ARR[ELEM,3], {|XX| ALLTRIM(XX[1]) == ALLTRIM(NEW_VAL)}) +//**IF ELEM2 = 0 //** P3N - 10/13/06 + IF ELEM2 = 0 .OR. ADDL_MODE //** P3N - 10/13/06 + IF ADDL_MODE .AND. NEW_VAL = 'N/A' //** P3N - 10/13/06 + RESULT := .T. + ELSE + RESULT = SET_PICK(GET_ARR, NEW_VAL) // GET INPUT FROM PICKLIST + ENDIF +//** RESULT = SET_PICK(GET_ARR) // GET INPUT FROM PICKLIST + IF !RESULT + RETURN .F. + ENDIF + ENDIF + + IF ELEM2 > 0 + OPT_ARR := GET_ARR[ELEM,3] + GET_ARR[ELEM,11] := OPT_ARR[ELEM2,11] // UPDATE CURRENT PAR_PROD + ENDIF + + IF X:CHANGED + X:KILLFOCUS() // TERMINATE THE GET + // CHECK TO SEE IF THE "NEW" VALUE IS THE DEFAULT OR NOT. + DEF_VALU := GET_DEFAULT(ELEM, GET_ARR, ADDL_MODE) + IF GET_ARR[ELEM,4] == DEF_VALU + GET_ARR[ELEM,9] := '*' + ELSE + GET_ARR[ELEM,9] := ' ' + ENDIF + ELSE + X:KILLFOCUS() // TERMINATE THE GET + ENDIF + + + CASE MTYPE$'U' + IF X:CHANGED + IF GET_ARR[ELEM,1] = 'ORIEL TOP' .OR. GET_ARR[ELEM,1] = 'ORIEL BOTT' + CK_STD_STOCK_SIZE(USERFILE2->PROD_CODE, GET_ARR, 'ALL', ADDL_MODE) + ENDIF + ENDIF + + +ENDCASE +@ 0,0 SAY SPACE(12) +SETKEY(-4,{|| ''}) +RETURN .T. + + + + +* * * * * * * * * * * * * +FUNCTION WHEN_GET(GET_ARR, ADDL_MODE) +// THIS IS THE WHEN CONDITION ON THE GETS IN SAY_GET + +LOCAL X, ELEM, ELEM2, MTYPE, ARR := {}, NCHOICE +LOCAL CUR_VAL, NTOP, NLEFT, NRIGHT, NBOTTOM, SAVEBOX +LOCAL L, BCENTER, OFFSET, HEADER, RESULT, NCOLOR, NPOS +LOCAL RULE_ARR := {}, MELEM, SAVESEL := SELECT(), DEF_VALU, GET_LEN +LOCAL CHG_2_DEF := .F., MRULE, ADDIT + +@ 0,0 SAY SPACE(12) + +X = GETACTIVE() +ELEM = X[2,1] +MTYPE = GET_ARR[ELEM,2] + +// CHECK INCLUDE RULE AT THE ATTRIBUTE LEVEL +RESULT = CHK_RULE(GET_ARR[ELEM,6], GET_ARR, , _SELFILE) +IF !RESULT + // SEE IF THERE IS AN OPTION RECORD OUT THERE & DELETE IT! + SELECT USERFILE8 + IF ADDL_MODE + SEEKKEY = USERFILE2->ORDER_NUM + USERFILE2->PROD_CODE + STR(USERFILE2->LINE_NUM,3) + GET_ARR[ELEM,1] // ATT_CODE + ELSE + SEEKKEY = USERFILE2->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + GET_ARR[ELEM,1] // ATT_CODE + ENDIF + + SEEK SEEKKEY + IF FOUND() + REC_LOCK(3) + REPLACE ORDER_NUM WITH '' + REPLACE LINE_NUM WITH 0 + REPLACE ATT_CODE WITH '' + REPLACE USER_RESP WITH '' + IF ADDL_MODE + REPLACE PROD_CODE WITH '' + ENDIF + DELETE + UNLOCK + ENDIF + SELECT(SAVESEL) + + // MAKE VALUE = "N/A" AND REDISPLAY IT + IF MTYPE$'U' + GET_ARR[ELEM,4] = ' ' + SPACE( LEN(GET_ARR[ELEM,4]) -3 ) + ELSE + GET_ARR[ELEM,4] = 'N/A' + SPACE( LEN(GET_ARR[ELEM,4]) -3 ) + ENDIF + X:DISPLAY(GET_ARR[ELEM,4]) // PUT VALUE ON THE SCREEN + RETURN .F. // RULES DIDN'T PASS! +ENDIF + +// IF NO DEFAULT OPTIONS OR (STD_OPTS AND PICKED DEFAULT) +// REEVALUATE THE DEFAULT JUST IN CASE OTHER CHANGES RESULT +// IN A NEW DEFAULT +GET_LEN := LEN(GET_ARR[ELEM,4]) +IF GET_ARR[ELEM,2]$'PT' + // LOOK FOR THE DEFAULT VALUE + DEF_VALU := GET_DEFAULT(ELEM, GET_ARR, ADDL_MODE) + IF !EMPTY(DEF_VALU) + IF GET_ARR[ELEM,9] = '*' ; + .AND. GET_ARR[ELEM,4] <> DEF_VALU + CHG_2_DEF := .T. + ELSE + IF USERFILE2->STD_OPTS$'Y' ; + .AND. GET_ARR[ELEM,4] <> DEF_VALU + CHG_2_DEF := .T. + ELSE + IF !USERFILE2->STD_OPTS$'Y' ; // NON STANDARD OPTIONS-INVALID OPTION + .AND. !VALID_OPTION(GET_ARR[ELEM]) + CHG_2_DEF := .T. + ENDIF + ENDIF + ENDIF + ENDIF + + IF CHG_2_DEF .AND. GET_ARR[ELEM,4] <> DEF_VALU + GET_ARR[ELEM,4] = DEF_VALU + GET_ARR[ELEM,9] := '*' + // IF THE CALCULATED DEFAULT DON'T GET IT! + X:DISPLAY(GET_ARR[ELEM,4]) // PUT VALUE ON THE SCREEN + RETURN .F. + ENDIF +ENDIF + +// HILITE THE CURRENT GET +CUR_VAL = GET_ARR[X[2,1], X[2,2] ] +X:SETFOCUS() // MUST SET FOCUS TO DO THE FOLLOWING +NCOLOR = X:COLORSPEC() // GET THE CURRENT COLORS +NPOS = AT(',', NCOLOR) +NCOLOR = LEFT(NCOLOR,NPOS) + 'W+/R' +X:COLORDISP(NCOLOR) // SET THE SELECTED COLOR +X:DISPLAY(CUR_VAL) // PUT VALUE ON THE SCREEN +X:KILLFOCUS() // TERMINATE THE GET + +DO CASE + CASE MTYPE = 'U' // USER INPUT + @ 0,0 SAY SPACE(12) + SETKEY(-4,{|| ''}) + RETURN .T. + CASE MTYPE = 'C' // CALCULATION TYPE - SHOULD NEVER GET HERE! + @ 0,0 SAY SPACE(12) + SETKEY(-4,{|| ''}) // MAKE SURE HOT KEY IS OFF + RETURN .F. // DONT DO A GET! + + CASE MTYPE$'P' // PICK LIST + + FOR L = 1 TO LEN(GET_ARR[ELEM,3]) // LOAD UP THE AVAILABLE OPTIONS!! +******AADD(ARR, GET_ARR[ELEM,3,L,1]) +******MRULE := GET_ARR[ELEM,3,L,3] + MRULE := GET_ARR[ELEM,3,L,18] + ADDIT := .T. + IF !EMPTY(MRULE) // DON'T INCLUDE IF RULE ISN'T TRUE + ADDIT := CHK_RULE(MRULE, GET_ARR, , _SELFILE) // SINCE NOT A DEFAULT SITUATION + ENDIF + IF ADDIT + AADD(ARR, GET_ARR[ELEM,3,L,1]) + ENDIF + NEXT + IF LEN(ARR) > 1 + // SET UP HOT KEY + SETKEY(-4, {|| SET_PICK(GET_ARR)}) + SETCOLOR(HREV) + @ 0,0 SAY 'F5 for List' + SETCOLOR(LNOR) + // CHECK IF CURRENT VALUE IS IN VALID LIST + IF ASCAN(ARR, {|X| X == GET_ARR[ELEM,4] }) = 0 + GET_ARR[ELEM,4] := SPACE(LEN(GET_ARR[ELEM,4])) + KEYBOARD CHR(13) // FORCE IT INTO THE PICKLIST!!! + ENDIF + ELSE + // IF 1 ELEMENT AND GOING DOWN THRU LIST, STUFF IT INTO KEYBOARD + IF LEN(ARR) = 1 .AND. ; + !(LASTKEY() = K_UP .OR. LASTKEY() = K_PGUP ) + KEYBOARD ARR[1] + ENDIF + ENDIF + IF GET_ARR[ELEM,4] = 'No DEFAULT Options!!' ; + .OR. ALLTRIM(GET_ARR[ELEM,4]) = 'N/A' + KEYBOARD CHR(13) // FORCE IT INTO THE PICKLIST!!! + ENDIF + + RETURN .T. + + + +ENDCASE + + +@ 0,0 SAY SPACE(12) +SETKEY(-4,{|| ''}) +RETURN .T. + + +*************************************************************** + +FUNCTION VALID_OPTION(VAL_ARR) +LOCAL OPTARR := VAL_ARR[3] +LOCAL ELEM := ASCAN(OPTARR, {|X| X[1] == VAL_ARR[4]}) +IF ELEM > 0 + RETURN .T. +ELSE + RETURN .F. +ENDIF + +*************************************************************** +* * * * * * * * * * * * * +FUNCTION SET_ORDKEY +// SET A HOT KEY TO UPDATE THE ORDER OPTIONS FROM THE ORDER LINE SCREEN + +LOCAL SAVECOLOR := SETCOLOR(HREV) + +SET KEY -3 TO GET_LINEOPTS(USERFILE2->PROD_CODE) +@ 0,0 SAY 'F4 to Update Options' +SETCOLOR(SAVECOLOR) +RETURN NIL + +* * * * * * * * * * * * * +FUNCTION RESET_ORDKEY +// RESET A HOT KEY TO UPDATE THE ORDER OPTIONS FROM THE ORDER LINE SCREEN + +SET KEY -3 +RETURN NIL +* * * * * * * * * * * * * +* * * * * * * * * * * * * +//** P3N - 4/16/98 (YES I survived tax day!) - BARELY +**FUNCTION GET_TOTQTY() +**LOCAL WKFLD := ALLTRIM(STR(LINE_NUM, 3)) + '/' + ALLTRIM(PROD_CODE) +**LOCAL SHIPQTY := CHK_SHIPQTY('SHIPQTY') +**ERR_BOX ('** Order Quantity for '+WKFLD+' is - ' + ALLTRIM(STR(QUANTITY,3)) + ' **', ; +** '** Quantity Shipped '+SPACE(LEN(WKFLD))+' is - ' + ALLTRIM(STR(SHIPQTY,3)) + ' **' ) +**RETURN .T. +* * * * * * * * * * * * * +* * * * * * * * * * * * * +//HOTKEY CTRL+T RETURNS THE CURRENT DATE FOR THE ORDER CONTROL SCREEN +//** P3N - 4/16/98 (YES I survived tax day!) - BARELY +* * * * * * * * * * * * * +//** NOTE: IF THE IMPORTCUST DEFINITION FOR THE ORD_SHIP (CGW0OSW/CGW0OST) +//** NOTE: OR THE IMPORTCUST DEFINITION FOR THE ORD_PROD (CGW0OPW/CGW0OPT) +//** NOTE: CHANGES FOR THE FIELDS COMPL_DATE, SHIP_DATE, OR CONFIRM_DATE +//** NOTE: THIS LOGIC IS SUBJECT TO CHANGE ACCORDING TO THE ORDER OF THE +//** NOTE: THE FIELDS IN THE IMPORT CUST AND THE COLUMN HEADINGS. +* * * * * * * * * * * * * +**FUNCTION GET_CURDATE(REMOVEDT) +**LOCAL OCURR_COL := OBROW:GETCOLUMN(OBROW:COLPOS) +**LOCAL FLD, COL_HEADING := UPPER( OCURR_COL:HEADING ) +**LOCAL RETVAL := .T., REPLVAL +**IF EMPTY(REMOVEDT) +** REPLVAL := CURDATE +**ELSEIF REMOVEDT == 'REMOVEDT' +** REPLVAL := CTOD(' / / ') +**ENDIF +**REC_LOCK(3) +**IF COL_HEADING = 'PROD DATE' +** FLD := COLARR[3,2] //** COMPL_DATE-ORD_PROD +** REPLACE &FLD WITH REPLVAL //** COMPL_DATE-ORD_PROD +**ELSEIF COL_HEADING = 'SHIP ' +** FLD := COLARR[5,2] //** SHIP_DATE-ORD_SHIP +** IF EMPTY(&FLD) //** SHIP_DATE-ORD_SHIP +** REPLACE &FLD WITH REPLVAL //** SHIP_DATE-ORD_SHIP +** ENDIF +****ELSEIF COL_HEADING = 'DELIV' +**** FLD := COLARR[6,2] //** CONFIRM_DT-ORD_SHIP +**** REPLACE &FLD WITH REPLVAL //** CONFIRM_DT-ORD_SHIP +**ENDIF +**IF DUPL_CTRLDT() +** REPLACE &FLD WITH CTOD(' / / ') //** DUPL DATE RESET TO EMPTY +**ENDIF +**UNLOCK +**RETURN RETVAL +** +* * * * * * * * * * * * * +*********************************** + +//**FUNCTION SET_PICK(GET_ARR) //** P3N 10/13/06 +FUNCTION SET_PICK(GET_ARR, NEW_VAL) //** P3N - 10/13/06 +// USE PICKLIST FOR CURRENT GET - CONTAINS LIST OF OPTIONS AVAILABLE + +LOCAL X, ELEM, L, ARR := {}, ELEM2, CUR_VAL, MIRULE +LOCAL NTOP, NLEFT, NRIGHT, NBOTTOM, SAVEBOX +LOCAL BCENTER, OFFSET, HEADER, RESULT, MRULE, MDEF, ADDIT := .F. +LOCAL SVSCRN := SAVESCREEN() +SET KEY -4 TO // TURN OFF HOT KEY + +X = GETACTIVE() +ELEM = X[2,1] + + +// DON'T ADD TO ARRAY IF THE RULE IF FALSE AND NO DEFAULT FLAG +FOR L = 1 TO LEN(GET_ARR[ELEM,3]) + // IF NO ASTERICK AND A RULE IS PRESENT + // THEN ONLY AN OPTION IF THE RULE IS TRUE. + MRULE := GET_ARR[ELEM,3,L,3] + MIRULE := GET_ARR[ELEM,3,L,18] + MDEF := GET_ARR[ELEM,3,L,2] + ADDIT := .T. + + IF !EMPTY(MIRULE) // DON'T INCLUDE IF RULE ISN'T TRUE + ADDIT := CHK_RULE(MIRULE, GET_ARR, , _SELFILE) + ELSE + IF MDEF = ' ' .AND. !EMPTY(MRULE) // DON'T INCLUDE IF RULE ISN'T TRUE + ADDIT := CHK_RULE(MRULE, GET_ARR, , _SELFILE) // SINCE NOT A DEFAULT SITUATION + ENDIF + ENDIF + IF EMPTY(NEW_VAL) //** P3N - 10/13/06 + //** USE CUR_VAL //** P3N - 10/13/06 + ELSE //** P3N - 10/13/06 + //** P3N - 10/13/06 - PER ELLEN IF ADDL OPT USE PARENT FRAME COLOR + ADDIT := .F. //** P3N - 10/13/06 + IF GET_ARR[ELEM,3,L,1] = NEW_VAL //** P3N - 10/13/06 + ADDIT := .T. //** P3N - 10/13/06 + ENDIF //** P3N - 10/13/06 + ENDIF //** P3N - 10/13/06 + IF ADDIT + AADD(ARR, GET_ARR[ELEM,3,L,1]) + ENDIF +NEXT + +IF LEN(ARR) > 1 + CUR_VAL = GET_ARR[X[2,1], X[2,2] ] + HEADER = GET_ARR[ELEM,1] + ELEM2 = ASCAN(ARR, {|X| X == CUR_VAL}) + + NTOP = X:ROW - 1 + NLEFT = X:COL + LEN(CUR_VAL) + NRIGHT = NLEFT + LEN(CUR_VAL) + NBOTTOM = NTOP + LEN(ARR) + 1 + IF NBOTTOM > MAXROW() -2 + NBOTTOM = MAXROW() -2 + ENDIF + + + SAVEBOX = SAVESCREEN(NTOP,NLEFT,NBOTTOM+1,NRIGHT+1) + * + SETCOLOR(BLACK) + @ NTOP+1,NLEFT+1 CLEAR TO NBOTTOM+1,NRIGHT+1 // DRAW SHADOW BOX + SETCOLOR(HNOR) + @ NTOP,NLEFT CLEAR TO NBOTTOM,NRIGHT // DRAW BACKROUND COLOR + @ NTOP,NLEFT TO NBOTTOM,NRIGHT // DRAW DOUBLE LINE + // FIND THE CENTER OF THE BOX + BCENTER = INT( (NRIGHT - NLEFT) / 2) + OFFSET = INT(LEN(HEADER) / 2) + SETCOLOR(HREV) + @ NTOP,NLEFT+(BCENTER-OFFSET) SAY HEADER + + SETCOLOR(LNOR) + DO WHILE .T. + NCHOICE := ACHOICE(NTOP+1,NLEFT+1,NBOTTOM-1,NRIGHT-1,ARR,,,ELEM2) + // DON'T LEAVE UNLESS VALID INPUT OR ESCAPE KEY IS PRESSED!!! + IF NCHOICE <> 0 + EXIT + ELSE + IF LASTKEY() = 27 + RESTSCREEN(NTOP,NLEFT,NBOTTOM+1,NRIGHT+1,SAVEBOX) + SETKEY(-4, {|| SET_PICK(GET_ARR)}) // TURN HOT KEY BACK ON + RETURN .F. + ENDIF + ENDIF + ENDDO +ELSE + NCHOICE = 1 +ENDIF + +IF EMPTY(NCHOICE) .OR. NCHOICE > LEN(ARR) + RESTSCREEN(,,,,SVSCRN) + SETKEY(-4, {|| SET_PICK(GET_ARR)}) // TURN HOT KEY BACK ON + RETURN .F. +ELSE + X:BUFFER = ARR[NCHOICE] // STUFF THE BUFFER + X:ASSIGN() // UPDATE THE GET VAR + IF LEN(ARR) > 1 + RESTSCREEN(NTOP,NLEFT,NBOTTOM+1,NRIGHT+1,SAVEBOX) + ENDIF + IF PROCNAME(1) = '(b)WHEN_GET' + KEYBOARD ARR[NCHOICE] + ENDIF + SETKEY(-4, {|| SET_PICK(GET_ARR)}) // TURN HOT KEY BACK ON! + RETURN .T. +ENDIF +************************************************* +FUNCTION CHK_RULE(MRULE, GET_ARR, MTYPE, SELFILE, GETELM) +// CHECK THE RULE FOR MRULE +// MTYPE = 'M' FOR MATH PACKS + +LOCAL MELEM, L, RULE_ARR := {}, RESULT := .T. +STATIC ALL_RULES + +IF ALL_RULES = NIL + ALL_RULES := {} +ENDIF + +IF !EMPTY(MRULE) // RULE PACK NAME + MELEM = 0 + FOR L = 1 TO LEN(ALL_RULES) + IF ALLTRIM(ALL_RULES[L,1]) == ALLTRIM(MRULE) + MELEM = L + EXIT + ENDIF + NEXT + + IF MELEM = 0 + RULE_ARR = GETRULES(MRULE, SELFILE, GET_ARR, GETELM) // RULE PACK NAME + IF !EMPTY(RULE_ARR) + AADD(ALL_RULES, {MRULE , RULE_ARR}) + MELEM = LEN(ALL_RULES) + ELSE + //////////////////////////////////////////////////////////// + // A RULE NAME WAS PASSED BUT NO RULE PACKET INFO WAS FOUND!!!! + //////////////////////////////////////////////////////////// + IF MTYPE = 'M' + RETURN RULE_ARR + ELSE + RETURN .T. + ENDIF + ENDIF + ELSE + RULE_ARR = ALL_RULES[MELEM,2] + ENDIF + IF MTYPE = 'M' + RETURN RULE_ARR + ELSE + RESULT = EVALCLRULES({RULE_ARR},,GET_ARR, SELFILE) // RULE ARRAY + ENDIF +ENDIF +RETURN RESULT + + +******************************************************************** +FUNCTION GET_DEFAULT(ELEM, GET_ARR, ADDL_MODE) +// GET DEFAULT VALUE OPTION + +LOCAL RETVAL := '', L2, RESULT, I, GOODNUM +LOCAL RETVALLEN, NUM_AVAIL, CK_ARR:= {} + +IF !EMPTY(GET_ARR[ELEM,3]) // HAS OPTIONS + ** CHECK TO SEE IF THE ATTRIBUTE IS RULE DEPENDENT. + IF !CHK_RULE(GET_ARR[ELEM,6], GET_ARR, , _SELFILE) // THE RULE NAME AT ATTRIBUTE LEVEL + RETURN RETVAL + ENDIF + + FOR L2 = 1 TO LEN(GET_ARR[ELEM,3]) + IF EMPTY(GET_ARR[ELEM,3,L2,18]) ; // IF OPTION HAS AN INCLUDE RULE + .OR. CHK_RULE(GET_ARR[ELEM,3,L2,18], GET_ARR, , _SELFILE) // THE RULE NAME + AADD(CK_ARR, GET_ARR[ELEM,3,L2]) + ENDIF + NEXT + +**FOR L2 = 1 TO LEN(GET_ARR[ELEM,3]) + FOR L2 = 1 TO LEN(CK_ARR) +** IF GET_ARR[ELEM,3,L2,2] = '*' .OR. LEN(GET_ARR[ELEM,3]) = 1 + IF CK_ARR[L2,2] = '*' .OR. LEN(CK_ARR) = 1 + ** CHECK TO SEE IF THE DEFAULT OPTION IS RULE DEPENDENT. + RESULT = .T. + // CHECK FOR OPTION RULE! +**** IF !EMPTY(GET_ARR[ELEM,3,L2,3]) // IF OPTION HAS A DEFAULT RULE + IF !EMPTY(CK_ARR[L2,3]) // IF OPTION HAS A DEFAULT RULE +***** RESULT = CHK_RULE(GET_ARR[ELEM,3,L2,3], GET_ARR, , _SELFILE) // THE RULE NAME + RESULT = CHK_RULE(CK_ARR[L2,3], GET_ARR, , _SELFILE) // THE RULE NAME + ENDIF + IF RESULT // GOOD RESULT +****** RETVAL = GET_ARR[ELEM,3,L2,1] // DEFAULT VALUE + RETVAL = CK_ARR[L2,1] // DEFAULT VALUE + RETVALLEN := LEN(RETVAL) + IF GET_ARR[ELEM,2] = 'T' // IF TABLE TYPE + IF ISDIGIT(LEFT(LTRIM(RETVAL),1)) + RETVAL = 'V' + LTRIM(RETVAL) + ELSE + RETVAL = SUBS(LTRIM(RETVAL)+SPACE(RETVALLEN), 1, RETVALLEN) + ENDIF + ENDIF + + EXIT // NO NEED TO DO ANYMORE! + ENDIF + ENDIF + NEXT +ENDIF +RETURN RETVAL + + +****************************************************************** +FUNCTION PAR_ATT_VALU(ADDL_MODE, REALFILE) +// DISPLAY THE COLOR OF PRODUCT ON THE LINE ITEM SCREEN FOR EACH MODEL + +LOCAL RETVAL, SEEKKEY +LOCAL SAVESEL := SELECT() + +IF REALFILE = NIL + REALFILE := 'USERFILE8' // USER ORDER_OPTS / ADDL_OPTS , NOT USERFILE8 +ENDIF + + +IF ADDL_MODE = NIL + ADDL_MODE := .F. +ENDIF + +IF ADDL_MODE + SEEKKEY := &CUR_MAST->ORDER_NUM + PROD_CODE + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' +ELSE + SEEKKEY := &CUR_MAST->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + 'FR COLOR' +ENDIF + +SELECT (REALFILE) +SEEK SEEKKEY +IF FOUND() + RETVAL := TRIM( (REALFILE)->USER_RESP) +ELSE + RETVAL := 'N/A' +ENDIF +SELECT (SAVESEL) + +RETURN RETVAL + + +******************************************************************** +FUNCTION UPDATE_MATH(ELEM, GET_ARR) +// UPDATE THE CALCULATION FIELDS + +LOCAL RESULT, MATH_ARR := {}, MCAT_CODE, MATT_CODE, SAVESEL := SELECT() + +MCAT_CODE = GET_CATCODE(USERFILE2->PROD_CODE) +MATT_CODE = GET_ARR[ELEM,1] +SEEKKEY = MCAT_CODE + MATT_CODE +SELECT MATHPACK +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + IF MATHPACK->TYPE$' ' + AADD(MATH_ARR, {FIELD1, OPERATOR, FIELD2}) + ENDIF + SKIP 1 +ENDDO + +IF !EMPTY(MATH_ARR) + RESULT = EVAL_MATH(MATH_ARR, GET_ARR, MCAT_CODE, MATT_CODE, _SELFILE ) + + DO CASE + CASE VALTYPE(RESULT) = 'C' + GET_ARR[ELEM,4] = RESULT + CASE VALTYPE(RESULT) = 'N' + GET_ARR[ELEM,4] = STR(RESULT) + END CASE +ENDIF +SELECT (SAVESEL) +RETURN NIL + +******************************************************************** +FUNCTION SIZE_NEEDED( SELFILE ) + +LOCAL RESULT, MATH_ARR := {}, MCAT_CODE, MATT_CODE +LOCAL SAVESEL := SELECT(), SEEKKEY + +MCAT_CODE = (SELFILE)->UOM +MATT_CODE = '_MISCITEM ' +SEEKKEY = MCAT_CODE + MATT_CODE +SELECT MATHPACK +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + IF MATHPACK->TYPE$'M' // MISC ITEM + AADD(MATH_ARR, {FIELD1, OPERATOR, FIELD2}) + ENDIF + SKIP 1 +ENDDO + +SELECT (SAVESEL) + +IF EMPTY(MATH_ARR) + REPLACE ENTRY_SIZE WITH '' + RETURN .F. +ELSE + RETURN .T. +ENDIF + +******************************************************************** +FUNCTION MISC_PRICE( SELFILE ) + +LOCAL RESULT, MATH_ARR := {}, MCAT_CODE, MATT_CODE +LOCAL SAVESEL := SELECT(), UOMVAR := 1, SEEKKEY +LOCAL PRICEUOM:=0, PRICECOL:=0 + +MCAT_CODE = (SELFILE)->UOM +MATT_CODE = '_MISCITEM ' +SEEKKEY = MCAT_CODE + MATT_CODE +SELECT MATHPACK +SEEK SEEKKEY +DO WHILE CAT_CODE + ATT_CODE == SEEKKEY .AND. !EOF() + IF MATHPACK->TYPE$'M' // MISC ITEM + AADD(MATH_ARR, {FIELD1, OPERATOR, FIELD2}) + ENDIF + SKIP 1 +ENDDO + +SELECT (SAVESEL) + +IF !EMPTY(MATH_ARR) .AND. EMPTY( (SELFILE)->ENTRY_SIZE ) + IF LASTKEY() = K_F10 + ERR_BOX( '*** Size Information is REQUIRED ') + RETURN .F. + ELSE + UOMVAR := 0 + ENDIF +ELSE + IF !EMPTY(MATH_ARR) + UOMVAR = EVAL_MATH(MATH_ARR, {}, MCAT_CODE, MATT_CODE, SELFILE, 'MISC' ) + IF VALTYPE(RESULT) = 'C' + UOMVAR = VAL(RESULT) + ENDIF + ENDIF + + + SEEKKEY := (SELFILE)->PARTNUM + (SELFILE)->UOM + MISC_PUOM->(DBSEEK ( SEEKKEY )) + DO CASE + CASE (SELFILE)->PRICE_SHT$'D' + PRICEUOM := MISC_PUOM->DLR_AMT + CASE (SELFILE)->PRICE_SHT$'S' + PRICEUOM := MISC_PUOM->SD_AMT + CASE (SELFILE)->PRICE_SHT$'B' + PRICEUOM := MISC_PUOM->BU_AMT + CASE (SELFILE)->PRICE_SHT$'J' + PRICEUOM := MISC_PUOM->DIST_AMT + CASE (SELFILE)->PRICE_SHT$'L' + PRICEUOM := MISC_PUOM->LUMB_AMT + CASE (SELFILE)->PRICE_SHT$'I' + PRICEUOM := MISC_PUOM->IC_AMT + OTHERWISE + PRICEUOM := 0 + ENDCASE + +ENDIF + +IF PRICEUOM * UOMVAR > 9999.99 //** P3N - 2/23/99 + ERR_BOX('** ERROR in SALE PRICE calculation! **', ' ', ; + ' SALE PRICE should be less than 9999.99 / calc. = ' + ; + STR(PRICEUOM * UOMVAR , 12,4) ) +ELSE + REPLACE (SELFILE)->SALE_PRICE WITH (PRICEUOM * UOMVAR) +ENDIF //** P3N - 2/23/99 + +RETURN .T. + + + +******************************************************************** +FUNCTION GET_CATCODE(MPROD_CODE) +// RETURN THE ASSOCIATED CATEGORY CODE FOR MPROD_CODE + +LOCAL SAVESEL := SELECT(), RETVAL, SAVEREC + +SELECT PRODUCT +SAVEREC := RECNO() +SEEK MPROD_CODE +RETVAL = CAT_CODE +GOTO SAVEREC +SELECT(SAVESEL) +RETURN RETVAL + +******************************************************************** +FUNCTION CHK_SIZE( PUFILENAME, ALLOW_EMPTY ) +// VALIDATE THE VALUE IN THE ENTRY_SIZE FIELD FOR LINE ITEMS +// MUST BE FOUR DIGITS IF HOW MEASURED = 'NS' +// MUST BE DELIMITED WITH AN 'X' IF NOT! +// IF ANY ENTRY SIZE ADJUSTMENTS REQUIRED THEN MAKE THEM HERE + +LOCAL DO_ERR := .F., MLEN, MHOW_MEAS, SEEKKEY, I +LOCAL LEFTNUM, RITENUM, MIDDLE, RESULT1, RESULT2, SAVEORD +LOCAL SAVESEL := SELECT() +LOCAL M1:= ' ', ERRFLAG, LEFTPART, RITEPART +LOCAL M2:= ' ', WORKVAR +LOCAL M3:= ' ', UFILENAME +LOCAL XWIDTH, XHEIGHT, ISNOMINAL := .F. +LOCAL GPOS, WOPOS, ADD_QUOTE2 := .F., ADD_QUOTE1 := .F. +LOCAL MHEIGHT, MWIDTH, WWIDTH, WHEIGHT, WHOWMEAS, RETVAL := .F. + + /* + IF NOMINAL SIZE --> OK + IF 99 X 99 SIZE --> OK + + IF 4/5/6 DIGIT SIZE --> REPLACE HOW_MEAS WITH 'NS' + IF 99 X 99 SIZE --> AND HOW_MEAS <> 'TT' .OR. 'OS' - REPLACE HOW_MEAS WITH ' ' + */ + +IF PUFILENAME = NIL + UFILENAME := 'USERFILE2' +ELSE + UFILENAME := PUFILENAME +ENDIF + +IF ALLOW_EMPTY = NIL + ALLOW_EMPTY := .F. +ENDIF + +IF EMPTY((UFILENAME)->ENTRY_SIZE) .AND. !ALLOW_EMPTY + SIZE_ERR() + + RETURN .F. +ENDIF + +IF PROCNAME(1) = 'EDITGBROW' // F10 - SIZE WAS VALIDATED AT DATA ENTRY TIME + RETURN .T. +ENDIF + +MENTRY_SIZE = ALLTRIM((UFILENAME)->ENTRY_SIZE) + +WORKVAR := NIL +// SOMETHING X SOMETHING +XPOS := AT('X', MENTRY_SIZE) +IF XPOS > 0 + LEFTNUM := ALLTRIM(SUBS(MENTRY_SIZE,1,XPOS -1)) + IF RIGHT(LEFTNUM,1)$'"' + LEFTNUM := ALLTRIM( STRTRAN( LEFTNUM, '"', ' ' )) + ADD_QUOTE1 := .T. + ENDIF + WORKVAR := VAL_WD( UFILENAME, LEFTNUM ) + + IF !EMPTY(WORKVAR) + WWIDTH := LEFTNUM + WHOWMEASE := WORKVAR[2] + + RITENUM := ALLTRIM(SUBS(MENTRY_SIZE,XPOS +1)) + IF RIGHT(RITENUM,1)$'"' + RITENUM := ALLTRIM( STRTRAN( RITENUM, '"', ' ' )) + ADD_QUOTE2 := .T. + ENDIF + WORKVAR := VAL_WD( UFILENAME, RITENUM ) + IF !EMPTY(WORKVAR) + WORKVAR[1] := WWIDTH + WORKVAR[2] := RITENUM // CURRENT ONE RETURNED +******WORKVAR[3] := '' + WORKVAR := { WORKVAR[1], WORKVAR[2], '' } + MENTRY_SIZE := ALLTRIM(WORKVAR[1]) + ' X ' + WORKVAR[2] + ENDIF + ENDIF + +ELSE + // BASEMENT WINDOWS + IF AT('G', MENTRY_SIZE) > 0 + WORKVAR := VAL_BW( UFILENAME, MENTRY_SIZE ) // BASEMENT WINDOW + ELSE + + // NS ENTRY WWWHHH + WORKVAR := VAL_NS( UFILENAME, MENTRY_SIZE ) + IF EMPTY(WORKVAR) + // SINGLE NUMBER PROCESSING + LEFTNUM := ALLTRIM(MENTRY_SIZE) + IF RIGHT(LEFTNUM,1)$'"' + LEFTNUM := ALLTRIM( STRTRAN( LEFTNUM, '"', ' ' )) + ADD_QUOTE2 := .T. + ENDIF + + WORKVAR := VAL_WD( UFILENAME, LEFTNUM ) + IF !EMPTY(WORKVAR) + WORKVAR := {LEFTNUM, '', 'WO'} + MENTRY_SIZE := ALLTRIM(LEFTNUM) + ENDIF + ENDIF + ENDIF +ENDIF + +// GOOD SIZE / HOW MEAS COMBO, NOW TEST FOR REASONABLE ENTRY SIZES + +IF EMPTY(WORKVAR) + SIZE_ERR() + RETURN .F. +ENDIF + +MWIDTH := WORKVAR[1] +MHEIGHT := WORKVAR[2] +MHOW_MEAS := WORKVAR[3] + +XWIDTH := DECVAL(MWIDTH) +XHEIGHT := DECVAL(MHEIGHT) + +IF PUFILENAME = NIL // NOT MISC LINE ITEMS + + SEEKKEY := (UFILENAME)->PROD_CODE + PRODUCT->(DBSEEK(SEEKKEY)) + M1 := ' MAX WIDTH IS ' + STR(PRODUCT->MAXWIDTH) + M2 := ' MAX HEIGHT IS ' + STR(PRODUCT->MAXHEIGHT) + M3 := ' MAX SQFT IS ' + STR(PRODUCT->MAXSQFT) + M4 := ' Press Any Key to Continue . . .' + ERRFLAG := .F. + IF PRODUCT->MAXWIDTH > 0 + IF XWIDTH > PRODUCT->MAXWIDTH + ERRFLAG := .T. + ENDIF + ENDIF + IF PRODUCT->MAXHEIGHT > 0 + IF XHEIGHT > PRODUCT->MAXHEIGHT + ERRFLAG := .T. + ENDIF + ENDIF + IF PRODUCT->MAXSQFT > 0 + IF (XWIDTH * XHEIGHT) / 144 > PRODUCT->MAXSQFT + ERRFLAG := .T. + ENDIF + ENDIF + + IF ERRFLAG + ERR_BOX('*** WARNING - MAXIMUM SIZE WAS EXCEEDED!', M1, M2, M3, M4) + ENDIF +ENDIF + + +// IT'S A GOOD ENTRY, SO UPDATE HEIGHT & WIDTH +SELECT (UFILENAME) +REPLACE WIDTH WITH MWIDTH +REPLACE HEIGHT WITH MHEIGHT +IF !EMPTY(MHOW_MEAS) + REPLACE HOW_MEAS WITH MHOW_MEAS +ENDIF +IF ADD_QUOTE1 .OR. ADD_QUOTE2 + IF AT('X', MENTRY_SIZE)>0 + WORKVAR := SUBS(MENTRY_SIZE,1, AT('X', MENTRY_SIZE) -1 ) + IF ADD_QUOTE1 + WORKVAR := WORKVAR + '"' + ENDIF + IF AT('X', MENTRY_SIZE ) > 0 + WORKVAR := WORKVAR + ' X ' + ENDIF + WORKVAR := WORKVAR + SUBS(MENTRY_SIZE, AT('X', MENTRY_SIZE)+1 ) + IF ADD_QUOTE2 + WORKVAR := WORKVAR + '"' + ENDIF + MENTRY_SIZE := ALLTRIM(WORKVAR) + ELSE + IF ADD_QUOTE2 + MENTRY_SIZE := ALLTRIM(MENTRY_SIZE) + '"' + ENDIF + ENDIF +ENDIF +REPLACE (UFILENAME)->ENTRY_SIZE WITH MENTRY_SIZE +** REPLACE (UFILENAME)->ENTRY_SIZE WITH ALLTRIM(MENTRY_SIZE) + ' "' +**ENDIF + +IF PUFILENAME = NIL // NOT MISC LINE ITEMS + + // SET ADDL LINE ENTRY SIZES IF CHANGING PREVIOUS ORDER + SEEKKEY := ORDER_NUM + PROD_CODE + STR(LINE_NUM,3) + SELECT USERFILE6 + SAVEORD := INDEXORD() + + DONSETORD(2) // ORDER + PAR_PROD + LINE_NUM + SEEK SEEKKEY + IF FOUND() .AND. ENTRY_SIZE <> (UFILENAME)->ENTRY_SIZE + REPLACE ENTRY_SIZE WITH (UFILENAME)->ENTRY_SIZE + REPLACE WIDTH WITH (UFILENAME)->WIDTH + REPLACE HEIGHT WITH (UFILENAME)->HEIGHT + REPLACE HOW_MEAS WITH (UFILENAME)->HOW_MEAS + REPLACE PRICE_SHT WITH (UFILENAME)->PRICE_SHT + REPLACE NEED_CALC WITH 'Y' + ENDIF + DONSETORD(SAVEORD) +ENDIF + +SELECT(SAVESEL) + +IF MHOME_LOC_CODE == 'LINDS ' //** P3N - 5/02/00 + //** LINDA DOES NOT LIKE THIS EDIT + RETVAL := .T. //** P3N - 5/02/00 +ELSEIF CK_ENTRYSZ() //** P3N - 4/21/00 + RETVAL := .T. //** P3N - 4/21/00 +ELSE //** P3N - 4/21/00 + RETVAL := .F. //** P3N - 4/21/00 + ERR_BOX( ' You can NOT change the entry size!', ; //** P3N - 4/21/00 + ' ', ; //** P3N - 4/21/00 + ' DELETE line item(F3) and Re-Enter.') //** P3N - 4/21/00 +ENDIF +RETURN RETVAL +//**RETURN .T. + +*********************************************************** +FUNCTION VAL_BW( UFILENAME, MENTRY_SIZE ) // BASEMENT WINDOW + +// TEST FOR BASEMENT WINDOW 12G, ETC +LOCAL GPOS := AT( 'G', MENTRY_SIZE ) +LOCAL LEFT_NUM, RIGHT_NUM, MWIDTH, MHEIGHT + +IF GPOS > 0 + IF LEN(MENTRY_SIZE) = 3 .AND. ; + ISDIGIT( SUBS(MENTRY_SIZE,1,1) ) .AND. ; + ISDIGIT( SUBS(MENTRY_SIZE,2,1) ) .AND. ; + GPOS = 3 + // GOOD BASEMENT WINDOW + // ONLY GOOD SIZES GOT THIS FAR + // GET HEIGHT & WIDTH + LEFT_NUM = LEFT(MENTRY_SIZE,2) + + // NOW GET THE STRING OF IT + MWIDTH = VAL(LEFT_NUM) + MWIDTH = LTRIM(STR( MWIDTH )) + MHEIGHT = '0' +** REPLACE (UFILENAME)->HOW_MEAS WITH 'BW' + RETURN {MWIDTH, MHEIGHT, 'BW'} + ENDIF +ENDIF +RETURN NIL + + + + +* ELSE +* RETURN NIL +* ERR_BOX( ' BASEMENT WINDOWS Must be ', ; +* ' WINDOW SIZE "G" ', ; +* ' ie: "20G" ' , ; +* ' PLEASE RE-ENTER ') +* +* RETURN .F. +* ENDIF +* RETURN .T. +*ELSE +* RETURN .F. +*ENDIF + + +*********************************************************** + +FUNCTION VAL_FI( UFILENAME, MENTRY_SIZE , DOMSG) // FEET'INCHES + +// CHECK FOR WIDTH ONLY MEASUREMENT IE 3'6 FI - FEET'INCHES +LOCAL WOPOS := AT( "'", MENTRY_SIZE) +LOCAL LEFTPART, RITEPART, WORKVAR, I +LOCAL LEFT_NUM, RIGHT_NUM, DO_ERR := .F. +LOCAL STARTFRAC := 0 + +IF DOMSG = NIL + DOMSG := .T. +ENDIF + +IF WOPOS > 1 // AT LEAST IN SECOND POSTION + LEFTPART = SUBS(MENTRY_SIZE,1, WOPOS-1) + // COULD HAVE FRACTIONS OR NOT? + RITEPART = ALLTRIM(SUBS(MENTRY_SIZE,WOPOS+1)) + STARTFRAC := AT( " ", RITEPART) + IF STARTFRAC = 0 + STARTFRAC := LEN(RITEPART) + ENDIF + IF VAL(LEFTPART ) > 0 + WORKVAR := '' + FOR I := 1 TO LEN(RITEPART) + IF !ISDIGIT(SUBS(RITEPART,I,1)) + DO_ERR := .T. + EXIT + ELSE + WORKVAR := WORKVAR + SUBS(RITEPART,I,1) + ENDIF + NEXT + IF LEN(WORKVAR) = 0 + DO_ERR := .T. + ENDIF + ELSE + DO_ERR := .T. + ENDIF + IF DO_ERR + IF DO_MSG + ERR_BOX( ' WIDTH ONLY WINDOWS Must be', ; + ' Width in FEET and INCHES ', ; + [ ie: "3'6" ] , ; + ' PLEASE RE-ENTER ') + + ENDIF + RETURN .F. + ELSE + // GOOD WIDTH ONLY WINDOW + // ONLY GOOD SIZES GOT THIS FAR + // GET HEIGHT & WIDTH + LEFT_NUM = LEFTPART + RIGHT_NUM = RITEPART + + // NOW GET THE STRING OF IT + MWIDTH = ( VAL(LEFT_NUM) * 12 ) + VAL(RIGHT_NUM) + MWIDTH = LTRIM(STR( MWIDTH )) + MHEIGHT = '0' + REPLACE (UFILENAME)->HOW_MEAS WITH 'WO' + ENDIF + RETURN .T. +ELSE + RETURN .F. +ENDIF + + +*********************************************************** + +FUNCTION VAL_WD( UFILENAME, MENTRY_SIZE , DOMSG) // FEET'INCHES + +// CHECK FOR WIDTH ONLY MEASUREMENT IE 3'6 1/4 FI - FEET'INCHES +LOCAL WOPOS := AT( "'", MENTRY_SIZE) +LOCAL FRPOS := AT( "/", MENTRY_SIZE) +LOCAL PEPOS := AT( ".", MENTRY_SIZE) +LOCAL LEFTPART, RITEPART, WORKVAR, I +LOCAL FT_NUM:='', IN_NUM:='', DO_ERR := .F. +LOCAL FTPART:=0, INPART:=0, FRPART:=0 +LOCAL STARTFRAC := 0 + +IF DOMSG = NIL + DOMSG := .T. +ENDIF + +IF WOPOS > 1 // HAVE THE FEET PART + FT_NUM = SUBS(MENTRY_SIZE,1, WOPOS-1) +ENDIF +RITEPART := ALLTRIM(SUBS(MENTRY_SIZE,WOPOS+1)) +IF FRPOS = 0 ; // NO "/" FRACTION + .OR. PEPOS > 0 .AND. FRPOS = 0 // DECIMAL IE 10' 6.5 + IN_NUM := RITEPART +ELSE + IF FRPOS > 0 + IN_NUM := CHK_FRACTION(RITEPART, 'VALUE') + ENDIF +ENDIF + +IF EMPTY(IN_NUM) .AND. EMPTY(FT_NUM) + RETURN NIL +ELSE + // GOOD WIDTH ONLY WINDOW + // ONLY GOOD SIZES GOT THIS FAR + // GET HEIGHT & WIDTH + // NOW GET THE STRING OF IT + MWIDTH = ( VAL(FT_NUM) * 12 ) + DECVAL(IN_NUM) + MWIDTH = LTRIM(STR( MWIDTH,10,4 )) +**MHEIGHT = '0' +**REPLACE (UFILENAME)->HOW_MEAS WITH 'WO' +**RETURN { MWIDTH, MHEIGHT, 'WO' } + RETURN { MWIDTH, 'WO' } +ENDIF + + +*********************************************************** + +FUNCTION VAL_NS( UFILENAME, MENTRY_SIZE ) // NOMINAL SIZE + +LOCAL MLEN := LEN(ALLTRIM(MENTRY_SIZE)) +LOCAL DO_ERR:=.F., L, LEFT_NUM, RIGHT_NUM +LOCAL MWIDTH, MHEIGHT + +MENTRY_SIZE := ALLTRIM(MENTRY_SIZE) +// SEE IF A NOMINAL VALID SIZE +IF MLEN < 4 .OR. MLEN > 6 + RETURN NIL +**DO_ERR := .T. +ELSE + FOR L = 1 TO LEN(MENTRY_SIZE) + IF !ISDIGIT(SUBSTR(MENTRY_SIZE,L,1)) + RETURN NIL +******EXIT + ENDIF + NEXT +ENDIF + +* IF DO_ERR +* RETURN .F. +* ELSE +// ONLY GOOD SIZES GOT THIS FAR +// GET HEIGHT & WIDTH +DO CASE + CASE MLEN = 4 + LEFT_NUM = '0' + LEFT(MENTRY_SIZE,2) + RIGHT_NUM = '0' + RIGHT(MENTRY_SIZE,2) + CASE MLEN = 5 + LEFT_NUM = LEFT(MENTRY_SIZE,3) + RIGHT_NUM = '0' + RIGHT(MENTRY_SIZE,2) + CASE MLEN = 6 + LEFT_NUM = LEFT(MENTRY_SIZE,3) + RIGHT_NUM = RIGHT(MENTRY_SIZE,3) +ENDCASE + +// NOW GET THE STRING OF IT +MWIDTH = (VAL(LEFT(LEFT_NUM,2)) * 12) + VAL(RIGHT(LEFT_NUM,1)) +MWIDTH = LTRIM(STR( MWIDTH )) +MHEIGHT = (VAL(LEFT(RIGHT_NUM,2)) * 12) + VAL(RIGHT(RIGHT_NUM,1)) +MHEIGHT = LTRIM(STR( MHEIGHT)) +// UPDATE NS HOW MEAS FOR NOMINAL SIZES +// OR REMOVE NS IF 'X' TYPE ENTRY SIZE +**REPLACE (UFILENAME)->HOW_MEAS WITH 'NS' +RETURN { MWIDTH, MHEIGHT, 'NS' } + +** ENDIF + +RETURN .T. + +**************************************************************** +// ROUND THE WIDTH / HEIGHT IF ADJUST ENTRY SIZE INFO FOUND + +FUNCTION RND_WID_HT(MPROD_CODE, GET_ARR) + +//* SPIN THRU GET_ARR FOR ALL WIDTH/HT ADJUSTMENTS AND KEEP RUNNING TOTAL +LOCAL WK_WIDTH := DECVAL(USERFILE2->WIDTH) +LOCAL WORKVAL, WK_HEIGHT := DECVAL(USERFILE2->HEIGHT) + +LOCAL ADJ_ARR, STRARR + +IF EMPTY(GET_ARR) + RETURN .T. +ENDIF + +ADJ_ARR := FIND_OPTS(GET_ARR) + +// UPDATE PRD SIZE FIRST +IF ADJ_ARR[5] <> 0 // ROUND WIDTH TO + WORKVAL := ROUNDUP(WK_WIDTH, ADJ_ARR[5]) + STR_ARR := PRNT_SIZE( WORKVAL, , , , .T. ) + REPLACE USERFILE2->WIDTH WITH ALLTRIM( STR_ARR[1] ) +ENDIF +IF ADJ_ARR[6] <> 0 // ROUND HEIGHT TO + WORKVAL := ROUNDUP(WK_HEIGHT, ADJ_ARR[6]) + STR_ARR := PRNT_SIZE( WORKVAL, , , , .T. ) + REPLACE USERFILE2->HEIGHT WITH ALLTRIM( STR_ARR[1] ) +ENDIF + +RETURN .T. + + +**************************************************************** +//* CALCULATE THE BILLING HEIGHT/WIDTH +**************************************************************** + +FUNCTION BILL_SIZE(MPROD_CODE, ADDL_MODE, GET_ARR) + +// ENTRY SIZE IS THE SIZE USER ENTERED +// BIL_SIZE IS THE SIZE TO BILL ON BASED ON CONVERSION +// FROM HOW_MEASURED AND CUTTING ADJUSTMENTS +**// ACT_SIZE IS THE ACTUAL TIP TO TIP MEASURMENT OF WINDOW / PARENT PRODUCT + +LOCAL MWIDTH, SEEKKEY +LOCAL MHEIGHT, ADDL_CATCODE, SIZE_ARR +LOCAL ACT_PAR_WD +LOCAL ACT_PAR_HT +LOCAL SEEKPROD +LOCAL ES_WD:=0, ES_HT:=0 +LOCAL ADJ_ARR + +IF EMPTY(GET_ARR) + RETURN .T. +ENDIF + +ADJ_ARR := FIND_OPTS(GET_ARR) +// RETURNS {WIDTH, HEIGHT, BWIDTH, BHEIGHT, WID_RND, HT_RND, WID_BRND, HT_BRND } + +MWIDTH := DECVAL(USERFILE2->WIDTH) +MHEIGHT := DECVAL(USERFILE2->HEIGHT) + +IF EMPTY( USERFILE2->PAR_PROD ) + SEEKPROD := USERFILE2->PROD_CODE +ELSE + SEEKPROD := USERFILE2->PAR_PROD +ENDIF +IF PRODUCT->(DBSEEK(SEEKPROD)) +ELSE + ? 'ERROR IN SEEK ON PRODUCT IN BILL_SIZE IN CGWPRPO! ' + WAIT +ENDIF + +SIZE_ARR := CONV_SIZE(SEEKPROD, MWIDTH, MHEIGHT, USERFILE2->HOW_MEAS) +IF EMPTY(SIZE_ARR[1]) .AND. EMPTY(ADJ_ARR[3]) + ES_WD := 0 +ELSEIF EMPTY(ADJ_ARR[3]) + ES_WD := SIZE_ARR[1] +ELSEIF EMPTY(SIZE_ARR[1]) + ES_WD := ADJ_ARR[3] +ELSE + ES_WD := SIZE_ARR[1] + ADJ_ARR[3] +ENDIF +IF EMPTY(SIZE_ARR[2]) .AND. EMPTY(ADJ_ARR[4]) + ES_HT := 0 +ELSEIF EMPTY(ADJ_ARR[4]) + ES_HT := SIZE_ARR[2] +ELSEIF EMPTY(SIZE_ARR[2]) + ES_HT := ADJ_ARR[4] +ELSE + ES_HT := SIZE_ARR[2] + ADJ_ARR[4] +ENDIF + +// NOW, ES_HT AND ES_WIDTH ARE THE TIP TO TIP MEASURMENTS OF +// PRODUCT OR ATTACH TO PARENT PRODUCT + +// ADDITIONAL MODE OR PARENT PRODUCT- GET SIZE SPECS FROM PARENT DEFINITION +// WHICH WILL FURTHER ADJUST THE "ATTACH ON" PRODUCT +IF !EMPTY( USERFILE2->PAR_PROD ) + ADDL_CATCODE := GET_CATCODE(USERFILE2->PROD_CODE) + + // GET THE TIP TO TIP MEASUREMENT OF PARENT WINDOW + + SELECT USERFILE2 + DO CASE + CASE TRIM(ADDL_CATCODE) == 'SCREENS' + + CASE TRIM(ADDL_CATCODE) == 'STORMS' + ES_WD := PRODUCT->STR_WIDTH + ES_WD + ES_HT := PRODUCT->STR_HEIGHT + ES_HT + + OTHERWISE + ? 'NEW/UNDEFINED ADDITIONAL PRODUCT APPEARED IN BILL_SIZE-CGWPRPO' + WAIT + ENDCASE +ENDIF + +IF ES_WD > 999.9999 + ERR_BOX('** ERROR in Billing Width calculation! **', ' ', ; + ' Billing Width should be less than 999.9999 / calc. = ' + ; + STR(ES_WD, 12,4) ) +ELSE + REPLACE USERFILE2->BIL_WIDTH WITH ES_WD +ENDIF +IF ES_HT > 999.9999 + ERR_BOX('** ERROR in Billing Height calculation! **', ' ', ; + ' Billing Height should be less than 999.9999 / calc. = ' + ; + STR(ES_HT, 12,4) ) +ELSE + REPLACE USERFILE2->BIL_HEIGHT WITH ES_HT +ENDIF + +// UI SIZE USED FOR BILLING ONLY WHEN PRICED BY THE UNITED INCH +IF (USERFILE2->BIL_WIDTH+USERFILE2->BIL_HEIGHT) > 999.99 + ERR_BOX('** ERROR in UI SIZE calculation! **', ' ', ; + ' UI SIZE should be less than 999.99 / calc. = ' + ; + STR(USERFILE2->BIL_WIDTH+USERFILE2->BIL_HEIGHT, 8,2) ) +ELSE + REPLACE USERFILE2->UI_SIZE WITH ; + ROUNDUP(USERFILE2->BIL_WIDTH) + ROUNDUP(USERFILE2->BIL_HEIGHT) +ENDIF +// UPDATE ACTUAL SIZE FOR SAW HERE BASED ON SIZE BEFORE OPTIONS ADJUSTMENTS. +IF ADDL_MODE .OR. !EMPTY(USERFILE2->PAR_PROD) + SELECT PRODUCT + SEEK USERFILE2->PROD_CODE // GO BACK TO ADDL_PRODUCT DEFINITION +ENDIF + +RETURN + +**************************************************************** +**************************************************************** +//* CALCULATE THE PRODUCTION HEIGHT/WIDTH +**************************************************************** +**************************************************************** +FUNCTION CLR_SS_GLASS(GET_ARR, FILE2USE) + +LOCAL SAVESEL := SELECT() +LOCAL ELEM1, ELEM2 + +//* SPIN THRU GET_ARR AND LOOK FOR GL TYPE = 'CLEAR' .AND. GL STRENG = 'SINGLE' +ELEM1 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'GL STREN'}) +IF ELEM1 > 0 .AND. ALLTRIM(GET_ARR[ELEM1, 4]) == 'SINGLE STRENGTH' + ELEM2 = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'GL TYPE'}) + IF ELEM2 > 0 .AND. ALLTRIM(GET_ARR[ELEM2, 4]) == 'CLEAR' + REPLACE (FILE2USE)->CLEAR_SS WITH 'Y' + RETURN + ENDIF +ENDIF + +REPLACE (FILE2USE)->CLEAR_SS WITH 'N' +RETURN + +**************************************************************** +FUNCTION PROD_SIZE(GET_ARR,SEEKPROD, ADDL_MODE) + +//* SPIN THRU GET_ARR FOR ALL WIDTH/HT ADJUSTMENTS AND KEEP RUNNING TOTAL + +// PRODUCTION SIZE USED TO PRINT ON ORDERS +// THE PRODUCTION SIZE IS THE (ENTRY SIZE + CATEGORY ADJUSTMENTS) +// -OR- THE BILLING SIZE ABOVE + THE OPTION SIZE ADJUSTMENTS +// ALSO WILL CALC THE ACTUAL FINISHED PRODUCTION SIZE + +LOCAL ADJ_ARR, SIZE_ARR := {} +LOCAL MWIDTH := DECVAL(USERFILE2->WIDTH) +LOCAL MHEIGHT := DECVAL(USERFILE2->HEIGHT) +LOCAL ES_WD := 0, EW_HT := 0, WK := 0 +LOCAL AES_WD := 0, AEW_HT := 0 + +IF EMPTY(GET_ARR) + RETURN .T. +ENDIF + +ADJ_ARR := FIND_OPTS(GET_ARR) +// ADJ ADJ ADJ BILL SIZE? RND_TT_WD RND_TT_H RND_BI_WD RND_BI_HT ADJ_TTSZ? +// RETURNS {WIDTH, HEIGHT, BWIDTH, BHEIGHT, WID_RND, HT_RND, WID_BRND, HT_BRND, ADJ_ACT_WD, ADJ_ACT_HT } + + +IF EMPTY( USERFILE2->PAR_PROD ) + SEEKPROD := USERFILE2->PROD_CODE +ELSE + SEEKPROD := USERFILE2->PAR_PROD +ENDIF +PRODUCT->(DBSEEK(SEEKPROD)) + +SIZE_ARR := CONV_SIZE(SEEKPROD, MWIDTH, MHEIGHT, USERFILE2->HOW_MEAS) + +ES_WD := SIZE_ARR[1] + ADJ_ARR[1] +ES_HT := SIZE_ARR[2] + ADJ_ARR[2] +AES_WD := ES_WD - ADJ_ARR[9] +AES_HT := ES_HT - ADJ_ARR[10] +**AES_WD := SIZE_ARR[1] + ADJ_ARR[9] +**AES_HT := SIZE_ARR[2] + ADJ_ARR[10] + +// UPDATE PRD SIZE FIRST +**IF AES_WD > 999.9999 // PERRY - 2/18/98 +IF AES_WD > 999.9999 // PERRY - 2/18/98 + ERR_BOX('** ERROR in Production Width calculation! **', ' ', ; + ' Production Width should be less than 999.9999 / calc. = ' + ; + STR(ES_WD, 12,4) ) +ELSE +**REPLACE USERFILE2->PRD_WIDTH WITH ES_WD // AES??? PERRY - 2/18/98 + REPLACE USERFILE2->PRD_WIDTH WITH AES_WD // PERRY - 2/18/98 +ENDIF +**IF ES_HT > 999.9999 // PERRY - 2/18/98 +IF AES_HT > 999.9999 // PERRY - 2/18/98 + ERR_BOX('** ERROR in Production Height calculation! **', ' ', ; + ' Production Height should be less than 999.9999 / calc. = ' + ; + STR(ES_HT, 12,4) ) +ELSE +**REPLACE USERFILE2->PRD_HEIGHT WITH ES_HT + REPLACE USERFILE2->PRD_HEIGHT WITH AES_HT // PERRY - 2/18/98 +ENDIF + +**REPLACE USERFILE2->PRD_WIDTH WITH USERFILE2->BIL_WIDTH + ADJ_ARR[1] +**REPLACE USERFILE2->PRD_HEIGHT WITH USERFILE2->BIL_HEIGHT + ADJ_ARR[2] +* IF ADJ_ARR[5] <> 0 // ROUND WIDTH TO +* REPLACE USERFILE2->PRD_WIDTH WITH ROUNDUP(USERFILE2->PRD_WIDTH, ADJ_ARR[5]) +* ENDIF +* IF ADJ_ARR[6] <> 0 // ROUND HEIGHT TO +* REPLACE USERFILE2->PRD_HEIGHT WITH ROUNDUP(USERFILE2->PRD_HEIGHT, ADJ_ARR[6]) +* ENDIF + +// UPDATE ACTUAL SIZE NEXT +// ALWAYS ADJUST FOR SAW CUTTING ?? +IF AES_WD+PRODUCT->SAW_WIDTH > 999.9999 // PERRY - 4/8/98 + ERR_BOX('** ERROR in ACTUAL Width calculation! **', ' ', ; + ' Actual Width should be less than 999.9999 / calc. = ' + ; + STR(AES_WD + PRODUCT->SAW_WIDTH, 12,4) ) +ELSE + REPLACE USERFILE2->ACT_WIDTH WITH AES_WD ; + + PRODUCT->SAW_WIDTH +ENDIF +IF AES_HT+PRODUCT->SAW_HEIGHT > 999.9999 // PERRY - 4/8/98 + ERR_BOX('** ERROR in ACTUAL Height calculation! **', ' ', ; + ' Actual Height should be less than 999.9999 / calc. = ' + ; + STR(AES_HT + PRODUCT->SAW_HEIGHT, 12,4) ) +ELSE + REPLACE USERFILE2->ACT_HEIGHT WITH AES_HT ; + + PRODUCT->SAW_HEIGHT +ENDIF + +**REPLACE USERFILE2->ACT_WIDTH WITH USERFILE2->PRD_WIDTH + PRODUCT->SAW_WIDTH +**REPLACE USERFILE2->ACT_HEIGHT WITH USERFILE2->PRD_HEIGHT + PRODUCT->SAW_HEIGHT + +* REPLACE USERFILE2->ACT_WIDTH WITH USERFILE2->ACT_WIDTH + ADJ_ARR[3] +* REPLACE USERFILE2->ACT_HEIGHT WITH USERFILE2->ACT_HEIGHT + ADJ_ARR[4] +* IF ADJ_ARR[7] <> 0 // ROUND WIDTH TO ON TT SIZE +* REPLACE USERFILE2->ACT_WIDTH WITH ROUNDUP(USERFILE2->ACT_WIDTH, ADJ_ARR[7]) +* ENDIF +* IF ADJ_ARR[8] <> 0 // ROUND HEIGHT TO ON TT SIZE +* REPLACE USERFILE2->ACT_HEIGHT WITH ROUNDUP(USERFILE2->ACT_HEIGHT, ADJ_ARR[8]) +* ENDIF + +// UPDATE ACTUAL NOMINAL WIDTH, HEIGHT +// ADJUSTED FOR TT ROUNDING ABOVE IN THE ACT_HEIGHT PART +WK := USERFILE2->ACT_WIDTH - PRODUCT->SAW_WIDTH - PRODUCT->NS_WIDTH +IF WK > 999.9999 .OR. WK < -999.9999 //** P3N - 4/8/98 + ERR_BOX('** ERROR in ACTUAL NOM Width calculation! **', ' ', ; + ' Actual NOM Width should be less than 999.9999 / calc. = ' + ; + STR(WK, 12,4) ) +ELSE + REPLACE USERFILE2->NOM_WIDTH WITH USERFILE2->ACT_WIDTH ; + - PRODUCT->SAW_WIDTH - PRODUCT->NS_WIDTH +ENDIF +WK := USERFILE2->ACT_HEIGHT - PRODUCT->SAW_HEIGHT - PRODUCT->NS_HEIGHT +IF WK > 999.9999 .OR. WK < -999.9999 //** P3N - 4/8/98 + ERR_BOX('** ERROR in ACTUAL NOM Height calculation! **', ' ', ; + ' Actual NOM Height should be less than 999.9999 / calc. = ' + ; + STR(WK, 12,4) ) +ELSE + REPLACE USERFILE2->NOM_HEIGHT WITH USERFILE2->ACT_HEIGHT ; + - PRODUCT->SAW_HEIGHT - PRODUCT->NS_HEIGHT +ENDIF + +RETURN .T. + + +******************************************************************** +* THIS FUNC ROUNDS NUMBERS UP IF NEEDED (THE OLD ROUND FUNC) +******************************************************************** +FUNCTION ROUNDUP(VAL2ROUND, ROUND2) +LOCAL WORKVAL, DECVAL + +IF ROUND2 = NIL + ROUND2 := 0 +ENDIF + +IF ROUND2 > 1 .OR. ROUND2 < 0 + ERR_BOX('*** INVALID ROUND TO VALUE ' + STR(ROUND2,8,4) , ; + '*** Value NOT ROUNDED!' , ; + '*** CHECK THE MODEL SETUP') + RETURN VAL2ROUND +ENDIF + +IF ROUND2 = 0 // ROUND TO INTEGER + IF VAL2ROUND - INT(VAL2ROUND) = 0 + RETURN VAL2ROUND + ELSE + RETURN INT(VAL2ROUND) + 1 + ENDIF +ELSE + DECVAL := VAL2ROUND - INT(VAL2ROUND) // DECIMAL PORTION + IF DECVAL = 0 + RETURN VAL2ROUND + ELSE + WORKVAL := DECVAL + DO WHILE WORKVAL > ROUND2 + WORKVAL := WORKVAL - ROUND2 + ENDDO + RETURN VAL2ROUND + (ROUND2 - WORKVAL) // ORIG AMT + (DIFF BETWEEN DECVAL AND ROUND2) + ENDIF +ENDIF + +******************************************************************** +* THIS FUNC FINDS ALL OPTIONS IN ORDER TO CALC THE HEIGHT/WIDTH ADJS. +* AT ALL LEVELS +******************************************************************** +FUNCTION FIND_OPTS(GET_ARR) +LOCAL M_HEIGHT := 0, M_WIDTH := 0, MADJ_INVSZ +LOCAL BHEIGHT := 0, BWIDTH := 0 +LOCAL OO_KEY, I, II, USER_CHOICE, MRULE, WID_RND := 0, HT_RND := 0 +LOCAL WID_BADJ := 0 +LOCAL HT_BADJ := 0, H_ADJAMT:= 0, W_ADJAMT:= 0 +LOCAL WID_AADJ := 0 +LOCAL HT_AADJ := 0 + +//* SEARCH ALL SELECTED OPTIONS IN THE GET_ARR, AND MAKE ADJUSTMENTS ON +//* ALL OPTIONS FOUND IN THE ORDER OPTIONS FILE SELECTED AT ORDER ENTRY TIME +FOR I := 1 TO LEN(GET_ARR) + USER_CHOICE := GET_ARR[I,4] + FOR II := 1 TO LEN(GET_ARR[I, 3]) // OPTION ARRAY + IF ALLTRIM(USER_CHOICE) == ALLTRIM(GET_ARR[I, 3, II, 1]) // OPT DESC + MRULE := GET_ARR[I,3,II,14] // ROUND WIDTH RULE + // ALWAYS ADJUST THE WIDTH - NO RULE + // CHECK IF THERE IS A WIDTH ROUND RULE + IF EMPTY(MRULE) .OR. CHK_RULE(MRULE, GET_ARR, , _SELFILE) + WID_RND := WID_RND + GET_ARR[I,3,II,13] // ROUND WIDTH AMOUNT + ENDIF + + MRULE := GET_ARR[I,3,II,16] // ROUND HEIGHT RULE + // ALWAYS ADJUST THE HEIGHT - NO RULE + // CHECK IF THERE IS A HEIGHT ROUND RULE + IF EMPTY(MRULE) .OR. CHK_RULE(MRULE, GET_ARR, , _SELFILE) + HT_RND := HT_RND + GET_ARR[I,3,II,15] // ROUND HEIGHT AMOUNT + ENDIF + + // AMT TO ADJUST PRODUCTION WIDTHS AND HEIGHTS (PRD AND ACTUAL) + W_ADJAMT := GET_ARR[I,3,II,8] // ADJ WD AMT + H_ADJAMT := GET_ARR[I,3,II,9] // ADJ HT AMT + IF W_ADJAMT <> 0 .OR. H_ADJAMT <> 0 +//// IF MADJ_TTSZ$'Y' + M_WIDTH := M_WIDTH + W_ADJAMT // OPT WIDTH ADJ + M_HEIGHT := M_HEIGHT + H_ADJAMT // OPT HEIGHT ADJ + * M_WIDTH := M_WIDTH + GET_ARR[I, 3, II, 8] // OPT WIDTH ADJ + * M_HEIGHT := M_HEIGHT + GET_ARR[I, 3, II, 9] // OPT HEIGHT ADJ + MADJ_INVSZ := GET_ARR[I, 3, II, 12] // OPT ADJ BILL? + IF MADJ_INVSZ$'Y' + // AMT TO ADJUST BILLING WIDTHS AND HEIGHTS + BWIDTH := BWIDTH + W_ADJAMT // OPT WIDTH ADJ + BHEIGHT := BHEIGHT + H_ADJAMT // OPT HEIGHT ADJ + ** BWIDTH := BWIDTH + GET_ARR[I, 3, II, 8] // OPT WIDTH ADJ + ** BHEIGHT := BHEIGHT + GET_ARR[I, 3, II, 9] // OPT HEIGHT ADJ + WID_BADJ := WID_BADJ + W_ADJAMT + HT_BADJ := HT_BADJ + H_ADJAMT + ENDIF + IF GET_ARR[I,3,II,17]$'N' // ADJ_TTSZ BLANK DEFAULTS TO YES + WID_AADJ := WID_AADJ + W_ADJAMT // THIS IS AMT TO ADD BACK IF NO ADJ + HT_AADJ := HT_AADJ + H_ADJAMT + ENDIF + ENDIF + ENDIF + NEXT +NEXT + //PRD/ACT ADJ BILL ADJ ROUND TO PRD/ACT ADJ ROUND TO BILL ADJ? ADJ TT SIZE? +RETURN {M_WIDTH, M_HEIGHT, BWIDTH, BHEIGHT, WID_RND, HT_RND , WID_BADJ, HT_BADJ , WID_AADJ, HT_AADJ } + +******************************************************************** +//** P3N - 4/21/00 DO NOT ALLOW UPDATE OF A LINE ITEM ENTRY SIZE +//** PER SCOTT IN KC +******************************************************************** +FUNCTION CK_ENTRYSZ() +LOCAL SVREC := (CUR_OL)->(RECNO()) +LOCAL CURFILE := ALIAS(), RETVAL := .T. +//**LOCAL SEEKKEY := (CURFILE)->ORDER_NUM + STR( (CURFILE)->LINE_NUM, 3) //** P3N - 07/10/02 +LOCAL SEEKKEY := (CURFILE)->ORDER_NUM //** P3N - 07/10/02 ADDRESS ABEND FOR DARLENE - IOLA +IF VALTYPE( (CURFILE)->LINE_NUM ) $'N' //** P3N - 07/10/02 + SEEKKEY := SEEKKEY + STR( (CURFILE)->LINE_NUM, 3) //** P3N - 07/10/02 +ELSE //** P3N - 07/10/02 + SEEKKEY := SEEKKEY + (CURFILE)->LINE_NUM //** P3N - 07/10/02 +ENDIF //** P3N - 07/10/02 +IF (CUR_OL)->(DBSEEK(SEEKKEY)) + IF (CUR_OL)->ENTRY_SIZE == (CURFILE)->ENTRY_SIZE + RETVAL := .T. + ELSE + RETVAL := .F. + ENDIF +ENDIF +(CUR_OL)->(DBGOTO(SVREC)) +RETURN RETVAL +******************************************************************** + +FUNCTION UPDATE_SQFT() +// CALCULATE AND UPDATE THE UI SIZE FIELD + +LOCAL MHEIGHT, MWIDTH, MCALC + +IF !EMPTY(USERFILE2->HEIGHT) .AND. !EMPTY(USERFILE2->WIDTH) + MHEIGHT = DECVAL(USERFILE2->HEIGHT) // CONVERT CHARACTER FRACTIONS + MWIDTH = DECVAL(USERFILE2->WIDTH) + MCALC := (MHEIGHT * MWIDTH) / 144 + IF MCALC > 999.99 + ERR_BOX('** ERROR in Square Ft. Calculation! **' ,' ', ; + '** Sqft. MUST BE LESS THAN 999.99 / calc. = ' + STR(MCALC,9,2) ) + ELSE + REPLACE USERFILE2->SQFT WITH (MHEIGHT * MWIDTH) / 144 + ENDIF +ENDIF +RETURN .T. + + +******************************************************************** +FUNCTION CHK_FRACTION(C_NUM, ACTION) +// MAKE SURE C_NUM IS A CHARACTER STRING OF DIGITS AND/OR FRACTIONS +// FRACTIONS MUST BE IN THIS FORM 1/2, 3/8, WITH NO DECIMALS OR LETTERS +// IF ACTION = 'VALUE' THEN JUST RETURN THE VALUE, DON'T UPDATE GET FIELD + +LOCAL SLASH_POS, SPACE1_POS, SPACE2_POS, WHOLE_NUM, FRACTION +LOCAL TOP_FRACTION, BOTT_FRACTION, DECIMAL_NUM +LOCAL N_CHOICE, L, X, I, FRACT_PARR := {} , RETVAL + +IF ACTION = NIL + ACTION = 'UPDATE' +ENDIF + +IF EMPTY(C_NUM) + + IF ACTION = 'VALUE' + RETURN C_NUM + ELSE + RETURN .T. + ENDIF +ELSE + C_NUM = ALLTRIM(C_NUM) + ' ' +ENDIF + +IF AT('.', C_NUM) > 0 + IF ACTION = 'VALUE' + RETURN C_NUM + ELSE + RETURN .F. + ENDIF +ENDIF + +FOR L = 1 TO LEN(C_NUM) + X = UPPER(SUBSTR(C_NUM,L,1)) + IF !X$"0123456789/ '" + IF X$["'X] + ELSE + ERR_BOX( X + ' is an INVALID Character',; + 'Please Re-Enter!') + ENDIF + IF ACTION = 'VALUE' + RETURN C_NUM + ELSE + RETURN .F. + ENDIF + ENDIF +NEXT + +// CHECK THE SYNTAX +SLASH_POS = AT('/', C_NUM) + +**SPACE1_POS = AT(' ', C_NUM) +SPACE1_POS := LEN(C_NUM) +FOR I := LEN(C_NUM) - 1 TO 1 STEP -1 + IF SUBS(C_NUM,I,1)$' ' + SPACE1_POS := I + EXIT + ENDIF +NEXT + +IF SPACE1_POS > SLASH_POS .AND. SLASH_POS <> 0 // NO WHOLE NUMBER! + WHOLE_NUM = 0 + SPACE1_POS = 1 +ELSE + WHOLE_NUM = VAL(LEFT(C_NUM, SPACE1_POS-1)) + SPACE1_POS++ // POINT TO FIRST FRACTION DIGIT! +ENDIF + +// FIND END OF FRACTION EXPRESSION +SPACE2_POS = LEN(C_NUM) +FOR L = SLASH_POS TO LEN(C_NUM) + X = SUBSTR(C_NUM,L,1) + IF X = ' ' + SPACE2_POS = L-1 // NEED ACTUAL END OF FRACTION EXPRESSION + EXIT + ENDIF +NEXT +// MAKE SURE NOTHING COMES AFTER THE FRACTION +IF !EMPTY(RIGHT(C_NUM, LEN(C_NUM)-SPACE2_POS) ) + ERR_BOX( 'ERRONEOUS Characters Detected after number',; + 'Please Re-Enter!') + IF ACTION = 'VALUE' + RETURN C_NUM + ELSE + RETURN .F. + ENDIF +ENDIF + + +IF SLASH_POS = 0 // NO FRACTION! + // CHECK FOR REALISTIC VALUE + IF WHOLE_NUM > 300 + ERR_BOX( 'That Value is too LARGE',; + 'Please Re-Enter!') + ** RETURN .F. + IF ACTION = 'VALUE' + RETURN ALLTRIM(STR(WHOLE_NUM,3)) + ELSE + RETURN .F. + ENDIF + ELSE +****RETURN .T. + IF ACTION = 'VALUE' + RETURN ALLTRIM(STR(WHOLE_NUM,3)) + ELSE + RETURN .T. + ENDIF + ENDIF +ELSE + // VALIDATE FRACTION EXPRESSION + FRACTION = ALLTRIM(SUBSTR(C_NUM, SPACE1_POS, SPACE2_POS)) + IF ASCAN(FRACTION_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(FRACTION)}) = 0 + IF ACTION = 'EDIT' + ERR_BOX( 'Invalid FRACTION Entered' ,; + 'Please Reenter!') + RETURN .F. + ENDIF + DO WHILE .T. + FOR I := 1 TO LEN(FRACTION_ARR) + AADD(FRACT_PARR, FRACTION_ARR[I,1]) + NEXT + NCHOICE = LISTBOX(FRACT_PARR,1,'Choose A Fraction') + IF LASTKEY() = 27 + IF ACTION = 'VALUE' + RETURN '0' + ELSE + RETURN .F. + ENDIF + ENDIF + IF NCHOICE <> 0 + FRACTION = FRACTION_ARR[ NCHOICE, 1 ] + EXIT + ENDIF + ENDDO + + IF ACTION = 'VALUE' + IF WHOLE_NUM = 0 + RETURN FRACTION + ELSE + RETURN LTRIM(STR(WHOLE_NUM)) + ' ' + FRACTION + ENDIF + ELSE + // UPDATE THE GET VARIABLE IF IT'S A GET + X = GETACTIVE() // GET CURRENT GET INFO + IF X:HASFOCUS + IF WHOLE_NUM = 0 + X:BUFFER := PADR(ALLTRIM(FRACTION), LEN(X[13]), ' ') // X[13] = OLD VALUE OF GET VAR + ELSE + X:BUFFER := PADR(LTRIM(STR(WHOLE_NUM)) + ' ' + ALLTRIM(FRACTION) ,LEN(X[13]), ' ') + ENDIF + X:ASSIGN() + ENDIF + ENDIF + + + ENDIF + + +ENDIF + +IF ACTION = 'VALUE' + IF WHOLE_NUM = 0 + RETURN FRACTION + ELSE + RETURN LTRIM(STR(WHOLE_NUM)) + ' ' + FRACTION + ENDIF +ELSE + RETURN .T. +ENDIF + +******************************************************************** +FUNCTION GET_SALEPRICE(MMODEL, MPRICE_TYPE, XPRICE_ARR, GET_ARR, ADDL_MODE, PR_CUSTID) +// GET THE WHOLE PRICE + +LOCAL BASE_AMT, OPT_AMT, MEXT_AMT, MSALE_PRICE +LOCAL DISC_AMT := 0 +LOCAL SAVESEL := SELECT() +LOCAL MCAT_CODE +LOCAL MSYS_DISC := 0 +LOCAL MDISC_AMT := 0 +LOCAL MSYS_PCT := (USERFILE2->SYS_DISC * .01) +LOCAL BASEPRICE_CUST := .F. //P3N - 2/18/98 +LOCAL ABASEPRICE //P3N - 2/18/98 + +// GET THE PRICE ARRAY FOR THIS MPRICE TYPE +MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, MPRICE_TYPE, PR_CUSTID) + +// GET BASE PRICE +IF ADDL_MODE .AND. USERFILE2->STD_OPTS$'Y' + BASE_AMT := 0 +ELSE + ABASEPRICE := GET_BASEPRICE(MMODEL, MPRICE_TYPE, XPRICE_ARR, GET_ARR, PR_CUSTID) + BASE_AMT := ABASEPRICE[1] //* P3N - 2/18/98 + BASEPRICE_CUST := ABASEPRICE[2] //* P3N - 2/18/98 +ENDIF +IF BASE_AMT > 9999.99 + ERR_BOX('** ERROR in BASE Price Calculation! **' , ' ', ; + ' Base Price should be less than 9999.99 / calc = ' + ; + STR(BASE_AMT, 9,2) ) +ELSE + REPLACE USERFILE2->BASE_PRI WITH BASE_AMT +ENDIF +// GET ANY OPTION PRICING BEFORE EXTRAS +OPT_AMT = GET_OPTPRICE(MMODEL, MPRICE_ARR, GET_ARR, 'B') +IF OPT_AMT > 9999.99 + ERR_BOX('** ERROR in OPTION Pricing Calculation! **' , ' ', ' Option Price should be less than 9999.99 / calc = ' + STR(OPT_AMT, 9,2) ) +ELSE + REPLACE USERFILE2->OPT_PRI WITH OPT_AMT +ENDIF +// GET EXTRA PRICING +MEXT_AMT = GET_EXTPRICE(GET_ARR, PR_CUSTID) +IF MEXT_AMT > 9999.99 + ERR_BOX('** ERROR in EXTRA Pricing Calculation! **' , ' ', ; + ' Extra Price should be less than 9999.99 / calc = ' + ; + STR(MEXT_AMT, 9,2) ) +ELSE + REPLACE USERFILE2->EXTRA_PRI WITH MEXT_AMT +ENDIF + +// GET ANY OPTION PRICING AFTER EXTRAS +OPT_AMT = GET_OPTPRICE(MMODEL, MPRICE_ARR, GET_ARR, 'A') +IF OPT_AMT > 9999.99 + ERR_BOX('** ERROR in EXTRA OPTION Pricing Calculation - GET_OPTPRICE()! **' , ' ', ; + ' Option Price should be less than 9999.99 / calc = ' + ; + STR(OPT_AMT, 9,2) ) +ELSE + IF OPT_AMT+USERFILE2->OPT_PRI > 9999.99 + ERR_BOX('** ERROR in EXTRA OPTION Pricing Calculation! **' , ' ', ; + ' Option Price should be less than 9999.99 / calc = ' + ; + STR(OPT_AMT+USERFILE2->OPT_PRI, 9,2) ) + ELSE + REPLACE USERFILE2->OPT_PRI WITH USERFILE2->OPT_PRI + OPT_AMT + ENDIF +ENDIF + +// ADD COMPONENTS TOGETHER TO GET FINAL PRICE +MSALE_PRICE = USERFILE2->BASE_PRI + ; + USERFILE2->OPT_PRI + ; + USERFILE2->EXTRA_PRI +IF MSALE_PRICE > 9999.99 + ERR_BOX('** ERROR in SALE Price Calculation! **' , ; + ' Sale Price should be less than 9999.99 / calc = ' + ; + STR(MSALE_PRICE, 9,2), ' ', ; + ' Sale Price can NOT be calculated!' ) + MSALE_PRICE := 0 +ENDIF + +// ROUND TO NEAREST NICKEL +MSALE_PRICE = ROUND_IT(MSALE_PRICE, .05) + + +SELECT (SAVESEL) +RETURN { MSALE_PRICE, BASEPRICE_CUST } + +//** MSALE_PRICE // THIS IS THE PER UNIT PRICE +//** BASEPRICE_CUST // TELLS IF THE BASE PRICE IS FROM THE CUST LVL + +******************************************************************** +FUNCTION GET_BASEPRICE(MMODEL, MPRICE_TYPE, XPRICE_ARR, GET_ARR, PR_CUSTID) +// LOOKUP AND CALCULATE PRICING FOR MMODEL ACCORDING TO PRICE TYPE +// PRICE TYPE: D = DEALER, S = SPECIAL DEALER, B = BUILDER/BUILD TO STOCK +// PRICE TYPE: J = JOBBER(DISTRUBUTER), L = LUMBERMAN +// PRICE ARRAY = LIST OF ROW AND COLUMNS +// GET ARRAY HOLDS THE USER RESPONSES (SEE GET_LINEOPTS FOR ARRAY LAYOUT) + +LOCAL L, SEEKKEY, MATT_CODE, ELEM, DB_ARR := {} +LOCAL M_NUM, MUI_SIZE, MFIELD := '', BASE_PRICE:=0, SAVESEL := SELECT() +LOCAL MCOL_VAR, RETVAL, ELEM2, SCANVAR +LOCAL MPERCENT, SPECPRICE, FLD_ARR +LOCAL XFILE, YFILE := ' ',DFILE := ' ' //P3N 2-5-98-CUST.PRICING UPGRD +LOCAL BASEPRICE_CUST := .F. +IF MPRICE_TYPE = NIL + MPRICE_TYPE = '' +ENDIF + +**SPECPRICE := CUST_SPEC_BP(MMODEL) + +**IF SPECPRICE <> NIL +** RETURN SPECPRICE +**ENDIF + +SELECT PRODUCT +SEEK MMODEL + +MPERCENT = 0 +IF !EMPTY(PR_CUSTID) + CUST_BP->(DBSEEK( PR_CUSTID + MMODEL )) + MPERCENT := CUST_BP->BASEFAC +ELSE + DO CASE + CASE MPRICE_TYPE = 'S' + IF SD_BASEFAC <> 0 + MPERCENT = SD_BASEFAC + ENDIF + + CASE MPRICE_TYPE = 'B' + IF BU_BASEFAC <> 0 + MPERCENT = BU_BASEFAC + ENDIF + + CASE MPRICE_TYPE = 'L' + IF LU_BASEFAC <> 0 + MPERCENT = LU_BASEFAC + ENDIF + + CASE MPRICE_TYPE = 'J' + IF DI_BASEFAC <> 0 + MPERCENT = DI_BASEFAC + ENDIF + + CASE MPRICE_TYPE = 'I' + IF IN_BASEFAC <> 0 + MPERCENT = IN_BASEFAC + ENDIF + + END CASE +ENDIF + +// SELECT THE PRICE TABLE +IF MPERCENT <> 0 + // FORCE IT TO USE DEALER PRICE TABLE + XFILE = 'D' + ALLTRIM(MMODEL) + '.DBF' + // NEED TO GET THE DEALER PRICE ARRAY!!! + MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, 'D', PR_CUSTID) +ELSE + MPERCENT = 100 // SET THIS TO 100, FOR NO CHANGE IN PRICE CALC (BELOW) + IF EMPTY(PR_CUSTID) + XFILE = MPRICE_TYPE + ALLTRIM(MMODEL) + '.DBF' +****XFILE := XFILE + '.DBF' +//** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS + // GET THE PRICE ARRAY FOR THIS MPRICE TYPE + MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, MPRICE_TYPE, PR_CUSTID) + ELSE + DFILE := 'D' + ALLTRIM(MMODEL) + '.DBF' + YFILE := MPRICE_TYPE + ALLTRIM(MMODEL) + '.DBF' + // UXXXXXXX.001 PRICE DBF + XFILE := 'U' + ALLTRIM(MMODEL) + XFILE := XFILE + '.' + PADL( ALLTRIM(STR( CUST_MAST->CPRICE_NUM )),3,'0') +//** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS +// GET THE PRICE ARRAY FOR THIS CUSTOMER TYPE 'D'-DEALER + MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, 'D', PR_CUSTID) + ENDIF +//** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS +// GET THE PRICE ARRAY FOR THIS MPRICE TYPE +**MPRICE_ARR = GET_PRICEARR(XPRICE_ARR, MPRICE_TYPE, PR_CUSTID) +ENDIF + +//** P3N - 4/1/98 - CHANGED TO ADDRESS PRICING CONCERNS (APRIL FOOLS) +//** (IE: PRICE TABLE '*PWS-O.DBF' - S/B '*PWS_O.DBF' ) +XFILE := STRTRAN(XFILE, '-', '_') +YFILE := STRTRAN(YFILE, '-', '_') +DFILE := STRTRAN(DFILE, '-', '_') + +IF VALTYPE(MPRICE_ARR) = 'N' // NO PRICE TABLE, NO PERCENT + BASE_PRICE := 0 +**RETURN BASE_PRICE + PICKUP_DISC(MMODEL) + RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } +ENDIF + +**IF !FILE(XFILE + '.DBF') +IF !FILE(XFILE) + BASE_PRICE = 0.00 +**RETURN BASE_PRICE + PICKUP_DISC(MMODEL) + RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } +ELSE + IF SELECT('XMFILE') > 0 + SELECT XMFILE + USE + ENDIF + NET_USE(XFILE, .F., 5, 'XMFILE') +ENDIF + +SEEKKEY = '' + +FOR L = 1 TO LEN(MPRICE_ARR) + IF MPRICE_ARR[L,2] = 'R' // ROW? + MATT_CODE = MPRICE_ARR[L,1] + ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(MATT_CODE)}) + IF ELEM <> 0 + IF !EMPTY(SEEKKEY) + SEEKKEY = SEEKKEY + '-' + ENDIF + SEEKKEY = SEEKKEY + TRIM(GET_ARR[ELEM,4]) + ENDIF + ELSE + IF MPRICE_ARR[L,2] = 'C' + MCOL_VAR = MPRICE_ARR[L,1] + ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(MCOL_VAR)}) + IF ELEM > 0 + MFIELD = ALLTRIM(GET_ARR[ELEM,4]) + ENDIF + ENDIF + ENDIF +NEXT + +// CHECK THAT OPTION RESPONSE IS A VALID FIELD NAME!!! +FLD_ARR = DBSTRUCT() // GET FIELD LIST +SCANVAR := LEFT( STRTRAN(MFIELD, ' ', '_') + SPACE(10), 10) +ELEM2 = ASCAN(FLD_ARR, {|X| LEFT(X[1]+SPACE(10),10) == SCANVAR}) +IF ELEM2 = 0 .OR. ELEM = NIL .OR. ELEM = 0 + IF EMPTY(PR_CUSTID) + IF ELEM = NIL .OR. ELEM = 0 + ERR_BOX( ' CANNOT Calculate Base Price! ', ; + ' The ' + TRIM(MMODEL) + ' Price Table ',; + ' May NOT Be Set Up Correctly ') + ELSE + ERR_BOX( ' CANNOT Calculate Base Price! ', ; + ' Field ' + MFIELD + ' for Option ' + ALLTRIM(GET_ARR[ELEM,1]) ,; + ' Does NOT Exist. Check the Option Responses ', ; + ' Or The ' + TRIM(MMODEL) + ' Price Table ') + ENDIF + ENDIF + IF EMPTY(PR_CUSTID) + BASE_PRICE = GET_ALTPRICE(MMODEL) + ELSE + BASE_PRICE = 0 + ENDIF +**RETURN BASE_PRICE + PICKUP_DISC(MMODEL) + RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } +ENDIF + +LOCATE FOR TRIM(DESC) == SEEKKEY +**IF !EMPTY(SCANVAR) +IF !EMPTY(SCANVAR) .AND. FIELDPOS(SCANVAR) > 0 + BASE_PRICE = &SCANVAR + BASE_PRICE = BASE_PRICE * (MPERCENT*.01) +ENDIF + +USE + +//** P3N - 2-5-98 - CHANGED TO ADDRESS CUSTOMER PRICING MODIFICATIONS +***IF EMPTY(PR_CUSTID) .AND. BASE_PRICE = 0 +*** BASE_PRICE = GET_ALTPRICE(MMODEL) +***ENDIF +IF EMPTY(PR_CUSTID) + IF BASE_PRICE = 0 + BASE_PRICE := GET_ALTPRICE(MMODEL) + ELSE + // BASE PRICE CALCULATED ABOVE! + ENDIF +ELSE + // CUST. BASE PRICE NOT CALCULATED ABOVE - GET FROM REAL BASE PRICE TABLE! + IF BASE_PRICE = 0 + BASE_PRICE := GET_REALBASE(YFILE, SEEKKEY, SCANVAR, MPERCENT, DFILE) + ELSE + // CUSTOMER BASE PRICE CALCULATED ABOVE! + // DO NOT APPLY A DISCOUNT FOR CUSTOMER BASE PRICE ITEMS! + BASEPRICE_CUST := .T. //* P3N - 2/18/98 + ENDIF +ENDIF + + +SELECT(SAVESEL) +RETURN { BASE_PRICE + PICKUP_DISC(MMODEL) , BASEPRICE_CUST } +** RETURN BASE_PRICE + PICKUP_DISC(MMODEL) + +********************************************************** +* CUSTOMER BASE PRICE WAS ZERO GET THE REAL BASE PRICE +* FROM THE ORIGINAL BASE PRICE TABLE - PRICE SHEET OR DEALER +* // P3N 2-5-98 - CUSTOMER PRICING UPGRADE +********************************************************** +FUNCTION GET_REALBASE(YFILE, SEEKKEY, SCANVAR, MPERCENT, DFILE) +LOCAL BASE_PRICE := 0.00 +IF FILE(YFILE) // IF PRICE SHEET TABLE EXISTS GET THE + // BASE_PRICE FROM PRICE SHEET PRICE TABLE! + BASE_PRICE := SEEK_BASE(SEEKKEY, YFILE, SCANVAR, MPERCENT) +ENDIF +IF EMPTY(BASE_PRICE) // NO PRICE @ PRICE SHEET TABLE + IF FILE(DFILE) // DEFAULT IS THE DEALER PRICE TABLE + BASE_PRICE := SEEK_BASE(SEEKKEY, DFILE, SCANVAR, MPERCENT) + ENDIF +ENDIF +RETURN BASE_PRICE + + +********************************************************** +* SEEK AND RETIREVE THE BASE PRICE FROM THE PRICE SHEET OR DEALER TABLE +* // P3N 2-5-98 - CUSTOMER PRICING UPGRADE +********************************************************** +FUNCTION SEEK_BASE(SEEKKEY, PFILE, SCANVAR, MPERCENT) +LOCAL SVSEL := SELECT(), BASE_PRICE := 0.00 +IF SELECT('XMFILE') > 0 + SELECT XMFILE + USE +ENDIF +NET_USE(PFILE, .F., 5, 'PFILE') +LOCATE FOR TRIM(DESC) == SEEKKEY +IF !EMPTY(SCANVAR) .AND. FIELDPOS(SCANVAR) > 0 + BASE_PRICE = &SCANVAR + IF EMPTY(MPERCENT) + ELSE + BASE_PRICE = BASE_PRICE * (MPERCENT*.01) + ENDIF +ENDIF +USE + +SELECT(SVSEL) +RETURN BASE_PRICE +********************************************************************** +* ARE THERE ANY SPECIAL CUSTOMER BASE PRICE TABLES ACTIVE? +********************************************************************** +FUNCTION CK_SPEC_PRICE( CUSTID, MMODEL, CKDATE, LOOKFILE ) +LOCAL SEEKKEY := CUSTID + MMODEL +LOCAL MDATE1, MDATE2, SAVESEL := SELECT(), RETVAL := .F. + +IF LOOKFILE = 'CUST_BP' + SELECT CUST_BP + CUST_BP->(DBSEEK(SEEKKEY)) +ELSE + SELECT (LOOKFILE) + LOCATE FOR PROD_CODE == MMODEL +ENDIF + +IF FOUND() + IF EMPTY(DATE1) + MDATE1 := CTOD('01/01/1960') + ELSE + MDATE1 := DATE1 + ENDIF + + IF EMPTY(DATE2) + MDATE2 := CTOD('01/01/2050') + ELSE + MDATE2 := DATE2 + ENDIF + + IF CKDATE >= MDATE1 .AND. CKDATE <= MDATE2 + RETVAL := .T. + ENDIF +ENDIF +SELECT (SAVESEL) +RETURN RETVAL + +******************************************************************** +** FUNCTION CUST_SPEC_BP(MMODEL) +** LOCAL SEEKKEY, RETVAL, MDATE1, MDATE2 +** LOCAL SPEC_PRICE +** +** SEEKKEY := (CUR_MAST)->CUST_ID + MMODEL +** SELECT CUST_BP +** SEEK SEEKKEY +** IF !FOUND() +** RETURN NIL +** ENDIF +** +** IF EMPTY(DATE1) +** MDATE1 := CTOD('01/01/1960') +** ELSE +** MDATE1 := DATE1 +** ENDIF +** +** IF EMPTY(DATE2) +** MDATE2 := CTOD('01/01/2050') +** ELSE +** MDATE2 := DATE2 +** ENDIF +** +** **IF !(USERFILE2->ORDER_DATE >= MDATE1 .AND. USERFILE2->ORDER_DATE <= MDATE2) +** +** IF !( (CUR_MAST)->ORDER_DATE >= MDATE1 .AND. (CUR_MAST)->ORDER_DATE <= MDATE2 ) +** RETURN NIL +** ENDIF +** +** SPEC_PRICE := CALC_CUST_PR( MMODEL, USERFILE2->UI_SIZE ) +** +** RETURN SPEC_PRICE +** +** +** ******************************************************************** +** FUNCTION CALC_CUST_PR(MMODEL, SIZEVAL) +** LOCAL SEEKKEY +** +** SELECT CUST_BPLVL +** SEEKKEY := (CUR_MAST)->CUST_ID + MMODEL +** SEEK SEEKKEY +** IF !FOUND() +** RETURN NIL +** ENDIF +** +** DO WHILE CUST_ID + PROD_CODE == SEEKKEY .AND. !EOF() +** IF SIZEVAL <= VAL(UI_BREAK) +** // RETURN THE (UI PRICE * SIZE) + THE "EACH" PRICE +** RETURN (SIZEVAL * PRICE) + UNIT_PRICE +** ENDIF +** SKIP 1 +** ENDDO +** +** RETURN NIL +** +******************************************************************** +FUNCTION PICKUP_DISC(MMODEL, SELFILE) +// LOOKUP AND CALCULATE DISCOUNT FOR DEALER PICKUPS +// PICKUP DELIVERY DISCOUNT FOR DEALERS +LOCAL RETVAL := 0, SAVESEL := SELECT() + +IF SELFILE = NIL + SELFILE := 'USERFILE2' +ENDIF + +**IF (SELFILE)->PRICE_SHT$'D' ; // DEALER PRICING +**IF ((MHOME_LOC_CODE = 'KC' .AND. (SELFILE)->PRICE_SHT$'D') ; +** .OR. MHOME_LOC_CODE <> 'KC' ) ; +// IF THIS PRICE SHEET CODE IS IN THE CONTROL FILE PICKUPDISC LIST +// AND THE ORDER IS TO BE PICKED UP +IF (SELFILE)->PRICE_SHT$MPICKUPDISC ; + .AND. &CUR_MAST->PICK_DEL == 'P' // PICKUP + SELECT PRODUCT + SEEK MMODEL + SELECT CATEGORY + SEEK PRODUCT->CAT_CODE + RETVAL := D_PICKDISC * -1 +ENDIF + +SELECT (SAVESEL) + +RETURN RETVAL + + +******************************************************************** +FUNCTION GET_OPTPRICE(MMODEL, MPRICE_ARR, GET_ARR, WHCHOPTS) +// LOOKUP AND CALCULATE PRICING FOR MMODEL OPTIONS + + +LOCAL L, SAVESEL := SELECT(), MOPT_PRICE := 0 +LOCAL SEEKKEY, MCAT_CODE +LOCAL II, CUR_ATTSTUFF, CUR_ATTOPTS, CUR_OPTPRICES, CUR_OPTOPTS +LOCAL CUR_ELEM, M1, M2, M3, M4, M5, M6 + +FOR L = 1 TO LEN(GET_ARR) + IF WHCHOPTS <> GET_ARR[L,10] // BAFLAG FOR OPTIONS + LOOP + ENDIF + CUR_ATTSTUFF := GET_ARR[L] + MUSER_RESP := CUR_ATTSTUFF[4] + IF ASCAN(MPRICE_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(MUSER_RESP)} ) > 0 + LOOP // DON'T PROCESS BASE PRICE STUFF + ENDIF + IF !GET_ARR[L,2]$'P' + LOOP // ONLY PROCESS THE P TYPE ATTRIBUTES + ENDIF + IF !EMPTY(MUSER_RESP) .AND. TRIM(MUSER_RESP) <> 'N/A' ; + .AND. TRIM(MUSER_RESP) <> 'NO OPTIONS FOUND!!' + CUR_ATTOPTS := CUR_ATTSTUFF[3] + CUR_ELEM := ASCAN(CUR_ATTOPTS, {|X| ALLTRIM(X[1]) == ALLTRIM(MUSER_RESP)} ) + IF EMPTY(CUR_ELEM) //NO attribute OPTIONS + M1 := '**************************************************' + M2 := '** NO attribute OPTIONS found for ' + ALLTRIM(CUR_ATTSTUFF[5]) + M3 := '**' + M4 := '** In the MODEL/PRODUCT setup function enter the ' + M5 := '** attribute OPTIONS for ' + ALLTRIM(CUR_ATTSTUFF[1]) + M6 := '**************************************************' + ERR_BOX( M1, M2, M3, M4, M5, M6) + ELSE + CUR_OPTOPTS := CUR_ATTOPTS[CUR_ELEM] + CUR_OPTPRICES := CUR_OPTOPTS[4] + + // WHICH COLUMN TO DO!? + DO CASE + CASE CUR_OPTPRICES[1] <> 0 // LIST PER UNIT + MOPT_PRICE = MOPT_PRICE + CUR_OPTPRICES[1] + CASE CUR_OPTPRICES[2] <> 0 // TIMES UNITED INCHES + MOPT_PRICE = MOPT_PRICE + (CUR_OPTPRICES[2]*USERFILE2->UI_SIZE) + CASE CUR_OPTPRICES[3] <> 0 // TIMES SQFT PRICE + MOPT_PRICE = MOPT_PRICE + (CUR_OPTPRICES[3]*USERFILE2->SQFT) + ENDCASE + ENDIF + ENDIF +NEXT + +SELECT(SAVESEL) +RETURN MOPT_PRICE + +******************************************************************** +FUNCTION GET_EXTPRICE(GET_ARR, PR_CUSTID) +// LOOKUP AND CALCULATE EXTRA PRICING FOR OPTION +// AT THE CATEGORY LEVEL ONLY + +LOCAL SAVESEL := SELECT(), MEXT_PRICE := 0 +LOCAL RULE_ARR := {}, GOOD_RESULT, M_AMT := 0, MULTIPLIER := 0 +LOCAL TFVALUE := 0.0000, RESULT, TVVALUE +LOCAL SAVEORD +LOCAL TVSTRTRAN +LOCAL OPT_VAL_TYPE, WHCHCHOICE, CHOICEARR, CHOICEPRICES +LOCAL MROUND_UP +LOCAL WORKVAL1, WORKVAL2 +LOCAL GET_PRICE + + + +SELECT PRI_EXTRAS +SAVEORD := INDEXORD() +DONSETORD(2) +MCAT_CODE = GET_CATCODE(USERFILE2->PROD_CODE) +SEEK MCAT_CODE +DO WHILE CAT_CODE == MCAT_CODE .AND. !EOF() + IF AT('U', PRI_EXTRAS->PRICE_SHT) > 0 ; // USER PRICING + .AND. CUST_PE->(DBSEEK(PRI_EXTRAS->CAT_CODE + PRI_EXTRAS->OPTION + (CUR_MAST)->CUST_ID)) + // USE THIS OPTION + GET_PRICE := 'CUST_PE' + ELSE + GET_PRICE := 'PRI_EXTRAS' + // NO SPECIAL USER PRICING - CHECK PRICE SHEET FROM ORDER LINE + IF EMPTY(PR_CUSTID) .AND. AT(USERFILE2->PRICE_SHT, PRI_EXTRAS->PRICE_SHT) = 0 + SKIP 1 + LOOP + ENDIF + // IF A 'U' IS NOT IN THE PRI_EXTRAS->PRICE_SHT - EXIT + // ELSE SPECIAL CUSTOMERS WILL HAVE ACCESS BASED ON PRI_EXTRAS PRICE VALUES + IF !EMPTY(PR_CUSTID) .AND. AT(USERFILE2->PRICE_SHT, 'U') = 0 + SKIP 1 + LOOP + ENDIF + ENDIF + + IF !EMPTY(RULE_PACK) + IF ALLTRIM(RULE_PACK) = 'ORIEL' + IF USERFILE2->ORIEL_SIZE$'N' .OR. (CUR_MAST)->ORIEL_CHRG$'N' + SKIP 1 + LOOP + ENDIF + ENDIF + + DO CASE + CASE !EMPTY( (GET_PRICE)->UNIT_SALE) + M_AMT = (GET_PRICE)->UNIT_SALE + + CASE !EMPTY( (GET_PRICE)->UI_SALE) // TIMES NUMBER OF UNITED INCHES + M_AMT = (GET_PRICE)->UI_SALE * USERFILE2->UI_SIZE + + CASE !EMPTY( (GET_PRICE)->SQFT_SALE) // TIMES NUMBER OF SQUARE FEET + M_AMT = (GET_PRICE)->SQFT_SALE * USERFILE2->SQFT + + ENDCASE + + MROUND_UP := ROUND_UP // SHOULD TRUE/FALSE VALUE BE ROUNDED UP? + + /* STEP 1. TEST RULE + STEP 2. IF TRUE, EVAL(TRUE VAL) + IF FALSE, USE FALSE VAL + STEP 3. TAKE EVAL FROM STEP 2 * M_AMT + */ + +** RULE_ARR = GETRULES(RULE_PACK) // RULE PACK NAME +** GOOD_RESULT = EVALCLRULES({RULE_ARR},,GET_ARR) // RULE ARRAY + GOOD_RESULT = CHK_RULE(RULE_PACK, GET_ARR, , _SELFILE ) // RULE ARRAY + + IF GOOD_RESULT + TRUE_FALSE = ALLTRIM(TRUE_VAL) + ELSE + TRUE_FALSE = ALLTRIM(FALSE_VAL) + ENDIF + + ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == TRUE_FALSE}) + // IT'S AN OPTION VALUE + TFVALUE := 0 + DO CASE + CASE ELEM > 0 + // DECVAL() (IN CGWMATH) EXPECTS A CHARACTER, AND RETURNS A NUMERIC + + OPT_VAL_TYPE = GET_ARR[ELEM,2] + DO CASE + CASE OPT_VAL_TYPE$'UC' + TFVALUE = DECVAL(GET_ARR[ELEM,4]) // * USER_RESP + + CASE OPT_VAL_TYPE$'P' + // IF PICK LIST, GET THE PRICES FROM THE SELECTED OPTION + // THEN EVALUATE THE TRUE FALSE ON THAT LIKE A NUMERIC ONE + CHOICEARR = GET_ARR[ELEM,3] + WHCHCHOICE = ASCAN(CHOICEARR, {|X| ALLTRIM(X[1]) == ALLTRIM(GET_ARR[ELEM,4])}) + IF WHCHCHOICE = 0 + TFVALUE := 0 + ELSE + CHOICEPRICES = CHOICEARR[WHCHCHOICE,4] + DO CASE + CASE CHOICEPRICES[1] <> 0 + TFVALUE := CHOICEPRICES[1] + CASE CHOICEPRICES[2] <> 0 + TFVALUE := CHOICEPRICES[2] + CASE CHOICEPRICES[3] <> 0 + TFVALUE := CHOICEPRICES[3] + ENDCASE + ENDIF + ENDCASE + CASE ALLTRIM(TRUE_FALSE) == 'ITEM PRICE' + TFVALUE := USERFILE2->BASE_PRI + USERFILE2->OPT_PRI ; + + MEXT_PRICE // ADD ALL PRICE COMPONENTS SO FAR + // DON'T USE "SPECIAL_FIELDS()" BECAUSE IT RETURNS STORED VALUE + // OF THE EXT_PRICE IN DBF VS. THE CURRENT CALCULATED VALUE + TFVALUE = ROUND_IT(TFVALUE, .05) + CASE ALLTRIM(TRUE_FALSE) == 'BASE PRICE' + TFVALUE := USERFILE2->BASE_PRI + CASE ALLTRIM(TRUE_FALSE) == "TT WIDTH'" + TFVALUE := USERFILE2->ACT_WIDTH / 12 + CASE ALLTRIM(TRUE_FALSE) == 'TT WIDTH' + TFVALUE := USERFILE2->ACT_WIDTH + CASE ALLTRIM(TRUE_FALSE) == "TT HEIGHT'" + TFVALUE := USERFILE2->ACT_HEIGHT / 12 + CASE ALLTRIM(TRUE_FALSE) == 'TT HEIGHT' + TFVALUE := USERFILE2->ACT_HEIGHT + CASE SPEC_FLD(TRUE_FALSE) // IS IT A SPECIAL FIELD? + TVSTRTRAN:= STRTRAN(ALLTRIM(TRUE_FALSE),' ', '_') // INCASE BLANKS + TFVALUE := USERFILE2->&TVSTRTRAN + IF VALTYPE(TFVALUE)$'C' + TFVALUE := VAL(TFVALUE) + ENDIF + CASE VALTYPE(TRUE_FALSE) = 'C' + TFVALUE = VAL(TRUE_FALSE) // IS IT ALWAYS A CHARACTER? + OTHERWISE + TFVALUE = TRUE_FALSE // IS IT ALWAYS A NUMERIC? + ENDCASE + + IF MROUND_UP = 'Y' + WORKVAL1 := TFVALUE - INT(TFVALUE) + IF WORKVAL1 > 0 + TFVALUE := INT(TFVALUE) + 1 + ENDIF + ENDIF + MEXT_PRICE = MEXT_PRICE + (TFVALUE * M_AMT) + + ENDIF + SKIP 1 +ENDDO + +DONSETORD(SAVEORD) + +SELECT(SAVESEL) +RETURN MEXT_PRICE + +******************************************************************** +* BASE PRICE COULD NOT BE CALCULATED ALLOW USER TO ENTER A PRICE! +******************************************************************** +FUNCTION GET_ALTPRICE(MODEL_NUM) +// ASK USER FOR A BASE_PRICE + +LOCAL BASE_PRICE := USERFILE2->ALT_BPRICE, SAVESCR := SAVESCREEN() +LOCAL NTOP, NBOTT, NLEFT, NRIGHT + +NTOP = 10 +NBOTT = 17 +NLEFT = 20 +NRIGHT = 61 + +SETCOLOR(BLACK) +@ NTOP+1,NLEFT+1 CLEAR TO NBOTT+1,NRIGHT+1 // DRAW SHADOW BOX +SETCOLOR(HREV) +@ NTOP,NLEFT CLEAR TO NBOTT,NRIGHT // DRAW BACKROUND COLOR +@ NTOP,NLEFT TO NBOTT,NRIGHT // DRAW DOUBLE LINE + +@ NTOP+2,NLEFT+3 SAY ' Base Price for LINE #' + STR(USERFILE2->LINE_NUM,3) + ' Was Zero' +@ NTOP+4,NLEFT+3 SAY ' Enter Price for this ' + ALLTRIM(MODEL_NUM) GET BASE_PRICE; + PICTURE '9999.99' +READ() +SETCOLOR(LNOR) +RESTSCREEN(,,,,SAVESCR) + +REPLACE USERFILE2->ALT_BPRICE WITH BASE_PRICE + +RETURN BASE_PRICE + +************************************************************** +//* DELETE THE CURRENT LINE IN THE TEMP ORDER LINES FILE +************************************************************** +FUNCTION DEL_LINEDETAIL(ADDL_MODE) + +LOCAL SAVEREC, CORR, MSG, DEL_LINE, SEEKKEY, MORDER_NUM, CUR_LINE, DONE := .F. +LOCAL SAVESCR := SAVESCREEN(), SAVEORD +LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') + +LOCAL SVSEL := SELECT() //** P3N - 8/4/98 + +LOCAL M1 := 'Order ' + (CUR_MAST)->ORDER_NUM + ' shippped on ' + ; + DTOC((CUR_MAST)->SHIP_DATE) + '. ' +LOCAL M2 := 'If you continue Shipping Information will be REMOVED!' +LOCAL M3 := 'DO YOU WANT TO CONTINUE?' + +IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' + @ 23,0 CLEAR + ? CHR(7) + IF SELECT('ORD_SHIP') > 0 //** P3N - 8/4/98 + ELSE //** P3N - 8/4/98 + DBOPEN('ORD_SHIP') //** P3N - 8/4/98 + ENDIF //** P3N - 8/4/98 + IF ORD_SHIP->(DBSEEK( (SVSEL)->ORDER_NUM )) //** P3N - 8/4/98 + ERR_BOX ('Order ' + (SVSEL)->ORDER_NUM + ' shippped on ' + ; + DTOC((CUR_MAST)->SHIP_DATE) + '!' , ; + 'Contact Supervisor to DELETE this Line !!' ) + IF LASTKEY() <> 126 //** '~' //** P3N - 8/4/98 + RESTSCREEN(,,,,SAVESCR) //** P3N - 8/4/98 + RETURN .F. //** P3N - 8/4/98 + ENDIF //** P3N - 8/4/98 + ENDIF //** P3N - 8/4/98 + SELECT(SVSEL) //** P3N - 8/4/98 + MSG = ' DELETE Line ' + LTRIM(STR(RECNO())) + ' --- Are You Sure?' + CORR = CORRCHEK(23, MSG) + IF CORR <> 'Y' + RESTSCREEN(,,,,SAVESCR) + RETURN .F. + ENDIF +//** P3N - 10/15/98 + IF EMPTY( (CUR_MAST)->SHIP_DATE ) + ELSEIF PROMPT_BOX(M1, M2, M3) //** P3N - 10/15/98 + IF REMOVE_ORD_SHIP() //** P3N - 10/15/98 + // USER REQUESTED TO CONTINUE WITH THE DELETE - SEND INFO MSG + ERR_BOX('Order Control Shipping Information has been REMOVED. ', ' ', ; + 'This Order MUST be RE-SHIPPED!! ', ' ',; + 'INFORM Order Control to RE-SHIP this Order!! ') + ELSE + RETURN .F. //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 + ELSE //** P3N - 10/15/98 + RETURN .F. //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 + MORDER_NUM = ORDER_NUM + DEL_LINE = RECNO() // LINE ITEM NUMBER TO DELETE IN ODER_OPTS + + SAVEREC := DEL_LINE - 1 + DELETE + PACK + IF LASTREC() = 0 + ADD_REC(3) + ELSE + SAVEORD := INDEXORD() + DONSETORD(0) + REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE + DONSETORD(SAVEORD) + ENDIF + + + // UPDATE THE ORDER OPTIONS STUFF! + SELECT USERFILE8 // ORDER OPTIONS (ORD_OPTS-CGW0OO) + IF ADDL_MODE + SEEKKEY = MORDER_NUM + USERFILE2->PROD_CODE + STR(DEL_LINE,3) + ELSE + SEEKKEY = MORDER_NUM + STR(DEL_LINE,3) + ENDIF + DO WHILE .T. + SEEK SEEKKEY + IF !FOUND() + EXIT + ENDIF + REC_LOCK(3) + REPLACE ORDER_NUM WITH '' + REPLACE LINE_NUM WITH 0 + DELETE + ENDDO + + CUR_LINE = DEL_LINE + + // ADJUST ALL ORDER OPTS WITH LINE NUMBER GREATER THAN DEL_LINE + SELECT USERFILE8 //** ORDER OPTS(ORD_OPTS-CGW0OO) + SAVEORD := INDEXORD() + DONSETORD(0) + REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE + DONSETORD(SAVEORD) + PACK + + *-// ADJUST ALL ORDER OPTS WITH LINE NUMBER GREATER THAN DEL_LINE + *-DELETE ALL RECS IN ADDL_LINES WHICH HAVE THIS ORDER NUMBER + *-AND THIS LINE NUMBER. THEN DELETE ALL ADDL_OPTS RECORDS FOR + *-THIS ORDER NUMBER AND THIS LINE NUMBER. + *- + *-AFTER YOU DELETE THE RECORDS, THEN RENUMBER SUBSEQUENT RECORDS + *-SO THEIR LINE NUMBERS MATCH WHAT THEY ARE SUPPOSED TO BE! + + SELECT USERFILE6 //** ADDL LINES (CGW0XL) + SAVEORD := INDEXORD() + DONSETORD(0) + DELETE ALL FOR LINE_NUM = DEL_LINE + REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE + DONSETORD(SAVEORD) + PACK + + // ADJUST ALL ADDL OPTS WITH LINE NUMBER GREATER THAN DEL_LINE + SELECT USERFILE9 //** ADDL OPTS (CGW0XO) + SAVEORD := INDEXORD() + DONSETORD(0) + DELETE ALL FOR LINE_NUM = DEL_LINE + REPLACE ALL LINE_NUM WITH LINE_NUM - 1 FOR LINE_NUM > DEL_LINE + DONSETORD(SAVEORD) + PACK + + SELECT USERFILE2 + GOTO MAX(SAVEREC,1) + KEYBOARD CHR(5) + CHR(19) +ELSEIF ACTION_CODE = 'REV' + ERR_BOX('You CAN NOT Delete line Items in REVIEW mode!') +ELSE + ERR_BOX('You DO NOT have Authorization to Delete line Items!') +ENDIF + +RETURN .T. + +*********************************************** +FUNCTION F5_NOTACTIVE() +LOCAL M1 := 'The SORT OPTON is NOT ACTIVE' +LOCAL M2 := 'While Entering Line Items.' +LOCAL M3 := 'Request for SORT was IGNORED.' +ERR_BOX( M1, M2, M3) +RETURN .T. + + +*********************************************** +FUNCTION ROUND_IT(M_AMT, ROUNDER) +// ROUND OFF M_AMT TO THE NEXT ROUNDER AMOUNT +// IN CENTS ONLY + +LOCAL CENTS, ROUND_CENTS, DIFFERENCE, RESULT, DO_ROUND := 'N' + +IF SELECT('CUST_MAST') > 0 + DO_ROUND := CUST_MAST->RND_PRICE +ENDIF + +IF M_AMT = 0 .OR. DO_ROUND$'N' + RETURN M_AMT +ENDIF + +SET DECIMALS TO 2 // ONLY WANT 2 DECIMALS! + +CENTS = M_AMT - INT(M_AMT) +RESULT = CENTS / ROUNDER +REMAINDER = RESULT - INT(RESULT) +///// HAVE TO DO THIS BULLSHIT BECAUSE CLIPPER DOESN'T THINK 0 = 0 !!!??? +IF STR(REMAINDER) = STR(0.00) // IS IT DIVISIBLE BY 5, EVENLY? + SET DECIMALS TO + RETURN M_AMT +ENDIF + +ROUND_CENTS = ( INT( CENTS / ROUNDER ) + 1) * ROUNDER +DIFFERENCE = ROUND_CENTS - CENTS + +SET DECIMALS TO +RETURN M_AMT + DIFFERENCE + + +*********************************************** +FUNCTION FILL_EMPTY(MCODE, ACTION, ADDL_MODE) +// THIS WILL FILL THE EMPTY LINE ITEM FIELDS (CURRENT RECORD) +// WITH THE VALUES OF THE PREVIOUS RECORD + +LOCAL SAVESEL := SELECT(), RETVAL := .T., SEEKKEY, NEWSEEK +LOCAL MPROD_CODE := '', MDISCOUNT, MHOW_MEAS +LOCAL MSTD_OPTS := '', MPAR_COLOR := '' + +SELECT USERFILE2 // ORDER LINE ITEMS RECORD + +IF RECNO() > 1 + SKIP -1 // POINT TO PREVIOUS RECORD + + MPROD_CODE := PROD_CODE + MDISCOUNT := DISCOUNT + MHOW_MEAS := HOW_MEAS + MSTD_OPTS := STD_OPTS + IF EMPTY(FIELDPOS('PAR_COLOR')) + MPAR_COLOR := ' ' + ELSE + MPAR_COLOR := PAR_COLOR + ENDIF + SKIP 1 // POINT BACK TO ORIGINAL RECORD +ENDIF + + +IF RECNO() = 1 ; // MUST FILL EVERYTHING MANUALLY +.OR. ( !EMPTY(PROD_CODE) .AND. (PROD_CODE <> MPROD_CODE)) + IF EMPTY(PROD_CODE) + RETVAL := .F. + ENDIF + + IF EMPTY(HOW_MEAS) + RETVAL := .F. + ENDIF + + IF EMPTY(STD_OPTS) + RETVAL := .F. + ENDIF + + IF RETVAL = .F. + SELECT (SAVESEL) + RETURN 'NO CONT' // NEED TO GET USERFILE2 INFO FROM USER + ELSE + SELECT USERFILE8 + IF ADDL_MODE + SEEKKEY := (CUR_MAST)->ORDER_NUM + USERFILE2->PROD_CODE + STR(USERFILE2->LINE_NUM,3) + ELSE + SEEKKEY := (CUR_MAST)->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) + ENDIF + SEEK SEEKKEY + IF !FOUND() // MEANS OPTS NOT THERE + SELECT(SAVESEL) + RETURN 'NO_OPTS_NO_PIRATE' + ELSE + SELECT(SAVESEL) + RETURN 'HAS_OWN_OPTS' + ENDIF + ENDIF +ENDIF + + +// ALL ITEMS HAD SAME PRODUCT CODE AS ITEM ABOVE IT. +// PIRATE ANY MISSING ITEMS FROM THE GUY ABOVE. +IF EMPTY(PROD_CODE) + REPLACE PROD_CODE WITH MPROD_CODE +ENDIF + +IF EMPTY(HOW_MEAS) + REPLACE HOW_MEAS WITH MHOW_MEAS +ENDIF + +IF EMPTY(STD_OPTS) + REPLACE STD_OPTS WITH MSTD_OPTS +ENDIF + +//FILL ANY EMPTY LINE_OPTS WHICH ARE MISSING + +SELECT USERFILE8 +IF ADDL_MODE + SEEKKEY := (CUR_MAST)->ORDER_NUM + MPROD_CODE + STR(USERFILE2->LINE_NUM,3) +ELSE + SEEKKEY := (CUR_MAST)->ORDER_NUM + STR(USERFILE2->LINE_NUM,3) +ENDIF +SEEK SEEKKEY +IF !FOUND() // MEANS OPTS NOT THERE + IF USERFILE2->STD_OPTS == MSTD_OPTS .AND. CK_PAR_COLOR(MPAR_COLOR) + RETVAL := 'PIRATE_OPTS' //COPY ORDER_OPTS FOR LINE PREVIOUS + ELSE + RETVAL = 'NO_OPTS_NO_PIRATE' + ENDIF +ELSE + RETVAL := 'HAS_OWN_OPTS' //DON'T COPY ORDER_OPTS FOR LINE PREVIOUS +ENDIF + +SELECT(SAVESEL) +RETURN RETVAL + +***************************************************** +* IS THERE A PARENT COLOR FOR THIS LINE ITEM? * +* IF SO IS IT THE SAME AS THE PREV LINE ITEM? * +***************************************************** +FUNCTION CK_PAR_COLOR(MPAR_COLOR) +LOCAL RET_VAL +IF EMPTY(USERFILE2->(FIELDPOS('PAR_COLOR'))) + RETVAL := .T. +ELSEIF USERFILE2->PAR_COLOR == MPAR_COLOR + RETVAL := .T. +ELSE + RETVAL := .F. +ENDIF +RETURN RETVAL +***************************************************** +FUNCTION BUILD_GETARR(MPROD_CODE, ACTION, MORDER_NUM, MLINE_NUM, PIRATE_VAR, USE_TMP, ADDL_MODE, PPR_CUSTID, DISP_WAIT, SELFILE) +// BUILDS A GET ARRAY AND A PRICING ARRAY FOR MPROD_CODE +// ACTION = 1, GET THE OPTIONS FROM THE ORDER OPTION FILE +// ACTION = 2, JUST BUILD THE GET_ARR & PRICING ARRAY + + +// LAYOUT FOR THE PRICE_ARR +// 1 = PRICE TABLE TYPE (DEALER, SPEC DEALER, INSTALLER, LUMBERMAN, DISTRIBUTOR) +// 1 = ATTRIBUTE NAME +// 2 = PRICE TYPE (R=ROW, C=COLUMN) + +// LAYOUT FOR THE GET_ARR +// 1 = ATTRIBUTE NAME +// 2 = FIELD TYPE (P=PICK, U=USER INPUT, C=CALCULATE, T=PRICE TABLE) +// 3 = ARRAY OF ALL THE POSSIBLE ATTRIBUTE OPTIONS (FOR THE PICK TYPE) +// 1 = OPTION VALUE +// 2 = HOLDS THE DEFAULT FLAG (IF IT'S AN ASTERISK, IT'S THE DEFAULT) +// 3 = HOLDS THE DEFAULT FLAG RULE +// 4 = ARRAY OF PRICES +// 1 = UNIT SALE PRICE +// 2 = UNITED INCH SALE PRICE +// 3 = SQUARE FEET SALE PRICE +// 5 = SEQUENCE NUMBER FOR OPTIONS +// 6 = PRINT INDICATOR USED FOR OPTIONAL PRINT VALUES +// 7 = OPTIONAL PRINT VALUE - USED WITH PRINT INDICATOR +// 8 = OPTION ADJUSTMENT WIDTH +// 9 = OPTION ADJUSTMENT HEIGHT +// 10 = (ADDITIONAL) LINK PRODUCT CODE (ie A STORM WINDOW FOR A 404) +// 11 = (PARENT PRODUCT LINK CODE (ie A STORM WINDOW FOR A 404) +// 12 = RND_TTW_TO - ROUND TT WID TO SIZE (AND PROD SIZE) +// 13 = RND_TTW_RU - ROUND TT WID TO SIZE RULE +// 14 = RND_TTH_TO - ROUND TT HT TO SIZE (AND PROD SIZE) +// 15 = RND_TTH_RU - ROUND TT HT TO SIZE RULE +// 4 = THE VALUE THAT THE USER CHOOSES, TO GO IN THE FILE (USER RESPONSE) +// 5 = ATTRIBUTE DESCRIPTION +// 6 = RULE TO EXECUTE +// 7 = LOGIC VAR, WHETHER TO GET/SAY IT OR NOT +// 8 = HOLDS THE FILE NAME WHERE THE OPTIONS WERE FOUND +// 9 = TELLS IF THE OPTION WAS A DEFAULT SELECTION +// 10 = IS THE ATTRIBUTE CALCULATED BEFORE/AFTER CATEGORY EXTRAS? +// 11 = CURRENT PARENT PRODUCT + +// PIRATE_VAR TELLS WHETHER OR NOT TO PIRATE THE LINE_OPT RECORDS +***************************************************** + +LOCAL MCODE := MPROD_CODE, L, CHK_BLOCK +LOCAL SEEKKEY, FILE1, FILE2, DBNAME, MATT_CODE, MDESC +LOCAL GET_ARR := {}, PRICE_ARR := {}, OPT_ARR, OPT_ARRAMT +LOCAL NEW_PCODE, NEW_STD_OPTS, ELEM := 0 +LOCAL SV_SEL := SELECT(), SAVESCRN := SAVESCREEN() +LOCAL LINEFILE, OPTFILE, MSTD_OPTS +LOCAL D_ARR := {}, S_ARR := {}, B_ARR := {}, L_ARR := {}, J_ARR := {} +LOCAL CUST_PARR := {} +LOCAL TEMP_ARR := {}, NEW_GET_ARR := .T., I_ARR := {} +LOCAL MHOW_MEAS, PR_CUSTID := SPACE(8) + +LOCAL RND_TTW_RULE := '' +LOCAL RND_TTH_RULE := '' + + +STATIC ALLGET_ARR := {} +STATIC ALLPRI_ARR := {} + +PRIVATE _SELFILE := SELFILE + +IF DISP_WAIT = NIL + DISP_WAIT := .T. +ENDIF + +//**IF SELECT('USERFILE2') > 0 //** P3N-4/22/98 +//** MSTD_OPTS := USERFILE2->STD_OPTS +//** MHOW_MEAS := USERFILE2->HOW_MEAS +//**ELSE +//** MSTD_OPTS := NIL +//** MHOW_MEAS := NIL +//**ENDIF +IF FIELDPOS('STD_OPTS') > 0 //** P3N - 4/22/98 + MSTD_OPTS := STD_OPTS +ELSE + MSTD_OPTS := NIL +ENDIF +IF FIELDPOS('HOW_MEAS') > 0 //** P3N - 4/22/98 + MHOW_MEAS := HOW_MEAS +ELSE + MHOW_MEAS := NIL +ENDIF + +IF DISP_WAIT + WAIT_BOX('*** Retrieving Product Options ***' , ; + ' ', ; + '*** Please Wait ***') +ENDIF + +IF USE_TMP == NIL + USE_TMP := .T. +ENDIF + +IF PPR_CUSTID = NIL + PR_CUSTID := SPACE(8) +ELSE + PR_CUSTID := PPR_CUSTID +ENDIF + +ELEM := ASCAN(ALLGET_ARR, {|X| X[1] == MPROD_CODE ; + .AND. X[2] == MHOW_MEAS ; + .AND. X[5] == MSTD_OPTS ; + .AND. X[6] == PR_CUSTID } ) + +IF ELEM > 0 + GET_ARR := ACLONE(ALLGET_ARR[ELEM, 4]) + PRICE_ARR := ACLONE(ALLPRI_ARR[ELEM, 4]) + FILE1 := ALLPRI_ARR[ELEM,6] +ELSE + + SEEKKEY = MCODE // SEEK SO THE PERCENT OF DEALER STUFF IS ALWAYS VISIBLE + SELECT PRODUCT + SEEK SEEKKEY + + IF !EMPTY(PR_CUSTID) + SELECT CUST_ATTS + FILE1 = 'CUST_ATTS' + FILE2 = 'CUST_OPTS' + DBNAME = 'CUST_ID + PROD_CODE' + SEEKKEY := PR_CUSTID + MCODE + SEEK SEEKKEY + ENDIF + IF EMPTY(PR_CUSTID) .OR. !FOUND() + SEEKKEY = MCODE + SELECT PROD_ATTS + FILE1 = 'PROD_ATTS' + FILE2 = 'PROD_OPTS' + DBNAME = 'PROD_CODE' + SEEK SEEKKEY + IF !FOUND() + SELECT CAT_ATTS + SEEKKEY := PRODUCT->CAT_CODE + SEEK SEEKKEY + FILE1 = 'CAT_ATTS' + FILE2 = 'CAT_OPTS' + DBNAME = 'CAT_CODE' + ENDIF + ENDIF + + // SITTING ON FILE1, EITHER CUST_ATTS OR PRODUCTS OR CATEGORY FILE + // GET LIST OF ATTRIBUTES + + GET_ARR := {} + DO WHILE SEEKKEY == &DBNAME .AND. !EOF() + MATT_CODE = ATT_CODE + SELECT ATTRIBUTES + SEEK MATT_CODE + MDESC = DESC + SELECT &FILE1 + AADD(GET_ARR, {ATT_CODE, FIELD_TYPE, {}, SPACE(20), MDESC, ; + RULE_PACK, .F., '', '', BEF_AFT_X, ''}) + + //////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\ + // SET UP THE PRICING ARRAY TOO + // ALL CUSTOMER ROWS/COLS ARE IN LINK_CODE + IF !EMPTY(PR_CUSTID) + IF LINK_CODE$'RC' + AADD(D_ARR, {ATT_CODE, LINK_CODE}) + ENDIF + ELSE + + IF LINK_CODE$'RC' + AADD(D_ARR, {ATT_CODE, LINK_CODE}) + ENDIF + + IF LINK_SD$'RC' + AADD(S_ARR, {ATT_CODE, LINK_SD}) + ENDIF + + IF LINK_BU$'RC' + AADD(B_ARR, {ATT_CODE, LINK_BU}) + ENDIF + + IF LINK_LU$'RC' + AADD(L_ARR, {ATT_CODE, LINK_LU}) + ENDIF + + IF LINK_DI$'RC' + AADD(J_ARR, {ATT_CODE, LINK_DI}) + ENDIF + + IF LINK_IN$'RC' + AADD(I_ARR, {ATT_CODE, LINK_IN}) + ENDIF + ENDIF + + SKIP 1 + ENDDO + + IF !EMPTY(D_ARR) + AADD(PRICE_ARR, {'D', D_ARR}) + ENDIF + + IF !EMPTY(B_ARR) + AADD(PRICE_ARR, {'B', B_ARR}) + ELSE + AADD(PRICE_ARR, {'B', PRODUCT->BU_BASEFAC}) + ENDIF + + IF !EMPTY(S_ARR) + AADD(PRICE_ARR, {'S', S_ARR}) + ELSE + AADD(PRICE_ARR, {'S', PRODUCT->SD_BASEFAC}) + ENDIF + + IF !EMPTY(L_ARR) + AADD(PRICE_ARR, {'L', L_ARR}) + ELSE + AADD(PRICE_ARR, {'L', PRODUCT->LU_BASEFAC}) + ENDIF + + IF !EMPTY(J_ARR) + AADD(PRICE_ARR, {'J', J_ARR}) + ELSE + AADD(PRICE_ARR, {'J', PRODUCT->DI_BASEFAC}) + ENDIF + + IF !EMPTY(I_ARR) + AADD(PRICE_ARR, {'I', I_ARR}) + ELSE + AADD(PRICE_ARR, {'I', PRODUCT->IN_BASEFAC}) + ENDIF + + // LOAD UP THE OPTIONS FOR EACH ATTRIBUTE + IF ELEM = 0 // no options in stored allget_arr + FOR L = 1 TO LEN(GET_ARR) + IF GET_ARR[L,2]$'PT' // ONLY DO PICKS & TABLES + OPT_ARR := {} + // START WITH LOWEST LEVEL FIRST! + + IF !EMPTY(PR_CUSTID) + CHK_BLOCK = {|| CUST_ID + PROD_CODE + ATT_CODE} + SELECT CUST_OPTS + FILE2 = 'CUST_OPTS' + SEEKKEY = PR_CUSTID + MPROD_CODE + GET_ARR[L,1] + SEEK SEEKKEY + ENDIF + IF EMPTY(PR_CUSTID) .OR. !FOUND() + CHK_BLOCK = {|| PROD_CODE + ATT_CODE} + + SELECT PROD_OPTS + FILE2 = 'PROD_OPTS' + SEEKKEY = MPROD_CODE + GET_ARR[L,1] + SEEK SEEKKEY + + IF !FOUND() + SELECT CAT_OPTS + FILE2 = 'CAT_OPTS' + SEEKKEY = PRODUCT->CAT_CODE + GET_ARR[L,1] // CAT ATTT + ATTRIBUTE + SEEK SEEKKEY + DBNAME = 'CAT_CODE' + CHK_BLOCK = {|| CAT_CODE + ATT_CODE} + ENDIF + ENDIF + + IF !FOUND() + SELECT ATT_OPTS + FILE2 = 'ATT_OPTS' + SEEKKEY = GET_ARR[L,1] // ATTRIBUTE + SEEK SEEKKEY + CHK_BLOCK = {|| ATT_CODE} + ENDIF + + DO WHILE SEEKKEY == EVAL(CHK_BLOCK) .AND. !EOF() + // ADD THE OPT VALUE, AND THE DEFAULT FLAG + AADD(OPT_ARR, {OPT_VALUE, OPT_TYPE, RULE_PACK, {}, SEQ_NUM, ; // 1-5 + PRINT_IND, PRINT_VAL, WIDTH_ADJ, HEIGHT_ADJ, ; // 6-9 + LINK_PROD, PAR_PROD, ADJ_INVSZ, ; // 10-12 + RND_TTW_TO, RND_TTW_RULE, ; // 13-14 + RND_TTH_TO, RND_TTH_RULE, ADJ_TTSZ, ; // 15-17 + INCL_RULE, ICPRT_RULE } ) // 18-19 + // IF YOU ADD MORE, UPDATE EMPTY ARRAY BELOW! + + // GET ASSOCIATED PRICING VALUES + OPT_ARRAMT := {} + AADD(OPT_ARRAMT, LIST_PRICE ) + AADD(OPT_ARRAMT, LIST_UI ) + AADD(OPT_ARRAMT, LIST_SQFT ) + + OPT_ARR[LEN(OPT_ARR),4] = OPT_ARRAMT + SKIP 1 + ENDDO + IF EMPTY(OPT_ARR) + //* THE OPT_ARR NEEDS TO BE 19 ELEMENTS + //* 1 , 2 , 3 , 4, 5, 6 , 7, 8 , 9 , 10 , 11 , 12, 13 , 14 , 15 , 16 , 17 , 18 19 + AADD(OPT_ARR, {'NO OPTIONS FOUND!! ', ' ', '', {},0,' ',"",0.0000,0.0000," "," "," ",0.0000, " " ,0.0000," "," ", ' ', ' ' }) + ENDIF + OPT_ARR := ASORT(OPT_ARR, ,, {|X,Y| X[5] < Y[5] } ) + + GET_ARR[L,3] = OPT_ARR // PUT OPTION INFO INTO GET ARRAY + GET_ARR[L,8] = FILE2 // WHERE THE OPTIONS CAME FROM + ENDIF + NEXT + ENDIF + IF ELEM = 0 + TEMP_ARR := ACLONE(GET_ARR) + AADD(ALLGET_ARR, {MPROD_CODE, MHOW_MEAS, ADDL_MODE, TEMP_ARR, MSTD_OPTS, PR_CUSTID}) + TEMP_ARR := ACLONE(PRICE_ARR) + AADD(ALLPRI_ARR, {MPROD_CODE, MHOW_MEAS, ADDL_MODE, TEMP_ARR, MSTD_OPTS, FILE1, PR_CUSTID }) + ENDIF + +ENDIF + + + +// AT THIS POINT, HAVE A BLANK ARRAY EITHER FROM STATIC HOLD ARR OR FILE + +FOR L = 1 TO LEN(GET_ARR) + IF ACTION = 1 // ?? LOAD USER CHOICES + IF USE_TMP + LINEFILE := 'USERFILE2' + OPTFILE := 'USERFILE8' + ELSE + LINEFILE := CUR_OL + OPTFILE := CUR_OO + ENDIF + // + // LOAD USER RESPONSES OR DEFAULTS + IF ADDL_MODE + LINEFILE := CUR_XL //** P3N - 11/26/01 + OPTFILE := CUR_XO //** P3N - 11/26/01 + SEEKKEY = MORDER_NUM + (LINEFILE)->PROD_CODE + MLINE_NUM + GET_ARR[L,1] + ELSE + SEEKKEY = MORDER_NUM + MLINE_NUM + GET_ARR[L,1] + ENDIF + SELECT (OPTFILE) + SEEK SEEKKEY + IF FOUND() + NEW_GET_ARR := .F. + GET_ARR[L,4] = USER_RESP // HAS OWN OPTS + ELSE + // NO OPTIONS FOUND. FIRST, SEE IF PIRATE FROM LINE PREVIOUS. + // IF NOT, THEN SEE IF PIRATE FROM THE PARENT ITEM IF ADDL_MODE + // IF IT'S THE SAME AS THE MODEL BEFORE, GET THOSE OPTIONS + SELECT (LINEFILE) + IF USE_TMP .AND. RECNO() > 1 .AND. PIRATE_VAR = 'PIRATE_OPTS' + SKIP -1 + SELECT (OPTFILE) + IF ADDL_MODE + SEEKKEY = MORDER_NUM + (LINEFILE)->PROD_CODE + STR(&LINEFILE->LINE_NUM,3) + GET_ARR[L,1] + ELSE + SEEKKEY = MORDER_NUM + STR(&LINEFILE->LINE_NUM,3) + GET_ARR[L,1] + ENDIF + SEEK SEEKKEY + IF FOUND() + IF GET_ARR[L,1] = 'ORIEL TOP' .OR. GET_ARR[L,1] = 'ORIEL BOTT' + // DON'T PIRATE ORIEL MEASUREMENTS. + ELSE + IF USER_RESP <> 'N/A' // 7-3-95 DON-SIZE PROBLEMS WHEN PIRATING OPTS FROM + GET_ARR[L,4] = USER_RESP // PREVIOUS LINE'S VALUES. + ENDIF + ENDIF + ENDIF + SELECT (LINEFILE) + SKIP 1 + ELSE + // SEEK ON THE PARENT OPTIONS FILE FOR THIS ATTRIBUTE + IF ADDL_MODE + SEEKKEY = MORDER_NUM + STR(&LINEFILE->LINE_NUM,3) + GET_ARR[L,1] + SELECT (CUR_OO) + SEEK SEEKKEY + IF FOUND() + GET_ARR[L,4] = USER_RESP + ENDIF + SELECT (OPTFILE) + ENDIF + ENDIF + +//// IF * WAS IN DATABASE, ONLY DO IF DURING SET OPTIONS. + + IF EMPTY(GET_ARR[L,4]) .AND. GET_ARR[L,2]$'PT' + // LOOK FOR THE DEFAULT VALUE + GET_ARR[L,4] = GET_DEFAULT(L, GET_ARR) + IF EMPTY(GET_ARR[L,4]) + GET_ARR[L,4] = 'No DEFAULT Options!!' + GET_ARR[L,9] = ' ' + SGACTION = 'GET' + ELSE + GET_ARR[L,9] = '*' + // SET ANOTHER ELEMENT IN THE OPTIONS PART OF THE GETARR + // WHICH SIGNIFIES THAT THIS VALUE WAS A CALCULATED DEFAULT. + // THEN, DURING THE PRINT PROCESS, DON'T HAVE TO MESS WITH 'GET_DEFAULT' + ENDIF + ENDIF + ENDIF + + ENDIF + +NEXT + +RESTSCREEN(,,,,SAVESCRN) +SELECT(SV_SEL) +RETURN {GET_ARR, PRICE_ARR, FILE1} +********************************************************* +// MOVES THE TEMPORARY ORDER LINES INTO THE PERMANENT FILE (ADDL_LINES) +********************************************************* +FUNCTION UPDATE_LINES +LOCAL SAVESEL := SELECT(), MORDER_NUM, L := 0 +LOCAL DELFLAG := .F., DEL_ARR := {}, MPROD_CODE + +MORDER_NUM = &CUR_MAST->ORDER_NUM + +SELECT USERFILE6 +GOTO TOP +DO WHILE !EOF() + IF UPDATED = 'P' + SKIP 1 + LOOP + ENDIF + MLINE_NUM = LINE_NUM + MPROD_CODE = PROD_CODE + SELECT (CUR_XL) + SEEK MORDER_NUM + MPROD_CODE + STR(MLINE_NUM,3) + IF !FOUND() + ADD_ONEREC('USERFILE6', CUR_XL) + ELSE + REC_LOCK(1) + REP_ONEREC('USERFILE6', CUR_XL) + REPLACE (CUR_XL)->GL311_AMT WITH ; + ( SET_GL311( (CUR_XL)->PROD_CODE ) * (CUR_XL)->QUANTITY ) + REPLACE UPDATED WITH ' ' // INDICATE THAT THIS IS NO LONGER PENDING + UNLOCK + ENDIF + SELECT USERFILE6 + SKIP 1 +ENDDO + +SELECT (CUR_XL) +SEEK MORDER_NUM +DO WHILE ORDER_NUM == MORDER_NUM .AND. !EOF() + IF UPDATED = 'P' + AADD(DEL_ARR, RECNO() ) + DELFLAG := .T. + ENDIF + SKIP 1 +ENDDO + +IF DELFLAG + FOR L = 1 TO LEN(DEL_ARR) + GOTO DEL_ARR[L] + REC_LOCK(1) + REPLACE ORDER_NUM WITH '' + REPLACE LINE_NUM WITH 0 + REPLACE PROD_CODE WITH '' + DELETE + UNLOCK + NEXT +ENDIF + +RETURN .T. +********************************************************* +// MOVES THE TEMPORARY ORDER OPTIONS INTO THE PERMANENT FILE +********************************************************* +FUNCTION UPDATE_ORDS(MUSERFILE) +LOCAL MORDER_NUM, MLINE_NUM, MATT_CODE, MUSER_RESP +LOCAL SAVESEL := SELECT(), DELFLAG := .F., SAVESCR +LOCAL DEL_ARR := {}, REALFILE, SEEKKEY +LOCAL ADDL_MODE := .F. +LOCAL REAL_PARENT +LOCAL M1 := 'Do you want to CONTINUE? ' + ; + 'Order ' +(CUR_MAST)->ORDER_NUM + ' shippped on ' + ; + DTOC((CUR_MAST)->SHIP_DATE) +LOCAL M2 := 'If you do continue it is IMPERATIVE to RECREATE ' +LOCAL M3 := 'Order Control Shipping Information to reflect any changes.' +LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') //** P3N - 10/15/98 +IF CUR_MAST == 'ORD_MAST' .AND. MUSERFILE = 'USERFILE8' //** P3N - 10/15/98 + IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' //** P3N - 10/15/98 + IF SELECT('ORD_SHIP') > 0 //** P3N - 10/15/98 + ELSE //** P3N - 10/15/98 + DBOPEN('ORD_SHIP') //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 + IF ORD_SHIP->(DBSEEK((CUR_MAST)->ORDER_NUM)) //** P3N - 10/15/98 + ? CHR(7) //** P3N - 10/15/98 + IF PROMPT_BOX(M1, M2, M3) //** P3N - 10/15/98 + // USER REQUESTED TO CONTINUE WITH THE UPDATE SEND INFO MSG + ERR_BOX('ANY Order changes will TAINT EXISTING Shipping Information. ' , ; + 'IF YOU CONTINUE - To ENSURE ACCURATE shipping information: ' , ; + ' 1) REMOVE ALL current Shipping Information.', ' and', ; + ' 2) RE-SHIP this Order. ' , ; + 'Press to ABORT. ' ) + IF LASTKEY() = 27 //** P3N - 10/15/98 + RETURN .F. //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 + ELSE //** P3N - 10/15/98 + KEYBOARD CHR(27) //** P3N - 11/19/98 + RETURN .F. //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 + ENDIF //** P3N - 10/15/98 +ENDIF //** P3N - 10/15/98 + +IF MUSERFILE == 'USERFILE8' +//* REALFILE = 'ORDER_OPTS' +//* REAL_PARENT := 'ORD_LINES' +* REALFILE = ['] + &CUR_OO + ['] +* REAL_PARENT := ['] + &CUR_OL + ['] + REALFILE = CUR_OO + REAL_PARENT := CUR_OL +ELSE + IF MUSERFILE == 'USERFILE9' +//* REALFILE = 'ADDL_OPTS' +//* REAL_PARENT := 'ADDL_LINES' +* REALFILE = ['] + &CUR_XO + ['] +* REAL_PARENT := ['] + &CUR_XL + ['] + REALFILE = CUR_XO + REAL_PARENT := CUR_XL + ADDL_MODE := .T. + ELSE + IF MUSERFILE == 'FILE8FILE9' + MUSERFILE = 'USERFILE8' +//* REALFILE = "ADDL_OPTS" +//* REAL_PARENT := 'ADDL_LINES' +* REALFILE = ['] + &CUR_XO + ['] +* REAL_PARENT := ['] + &CUR_XL + ['] + REALFILE = CUR_XO + REAL_PARENT := CUR_XL + ADDL_MODE := .T. + ENDIF + ENDIF +ENDIF + +SELECT (MUSERFILE) +GO TOP +MORDER_NUM = ORDER_NUM + +DO WHILE !EOF() + MLINE_NUM = LINE_NUM + MATT_CODE = ATT_CODE + MUSER_RESP = USER_RESP + + SELECT (REALFILE) + IF ADDL_MODE + SEEKKEY := MORDER_NUM + (MUSERFILE)->PROD_CODE + STR(MLINE_NUM,3) + ELSE + SEEKKEY := MORDER_NUM + STR(MLINE_NUM,3) + ENDIF + + IF !( (REAL_PARENT)->(DBSEEK(SEEKKEY)) ) + SELECT (MUSERFILE) + SKIP 1 + LOOP + ENDIF + + SELECT (REALFILE) + SEEKKEY := SEEKKEY + MATT_CODE // SEEKKEY ON OPT_FILE HAS ATT_CODE AT END + SEEK SEEKKEY + IF !FOUND() + ADD_REC(3) + REPLACE ORDER_NUM WITH MORDER_NUM + REPLACE LINE_NUM WITH MLINE_NUM + REPLACE ATT_CODE WITH MATT_CODE + IF ADDL_MODE + REPLACE PROD_CODE WITH (MUSERFILE)->PROD_CODE + ENDIF + ELSE + REC_LOCK(3) + ENDIF + REPLACE USER_RESP WITH MUSER_RESP + REPLACE UPDATED WITH ' ' + UNLOCK + + SELECT (MUSERFILE) + SKIP 1 +ENDDO + +SELECT (REALFILE) +SEEKKEY = MORDER_NUM +SEEK SEEKKEY +DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF() + IF UPDATED = 'P' + AADD(DEL_ARR, RECNO() ) + DELFLAG := .T. + ENDIF + SKIP 1 +ENDDO + +IF DELFLAG + FOR L = 1 TO LEN(DEL_ARR) + GOTO DEL_ARR[L] + REC_LOCK(1) + REPLACE ORDER_NUM WITH '' + REPLACE LINE_NUM WITH 0 + REPLACE ATT_CODE WITH '' + IF ADDL_MODE + REPLACE PROD_CODE WITH '' + ENDIF + DELETE + UNLOCK + NEXT +ENDIF + +SELECT (SAVESEL) +RETURN .T. + +********************************************************* +// MAKE SURE THE PICKS HAVE A VALID RESPONSE +********************************************************* +FUNCTION VALID_PICK(GET_ARR, POINTER) +LOCAL L, CHECK_VAR +IF GET_ARR[POINTER,2]$'PT' + CHECK_VAR = GET_ARR[POINTER,4] + IF ALLTRIM(CHECK_VAR) = 'N/A' .OR. EMPTY(CHECK_VAR) + RETURN .T. + ENDIF + FOR L = 1 TO LEN(GET_ARR[POINTER,3]) // LIST OF GOOD OPTS + IF CHECK_VAR == GET_ARR[POINTER,3,L,1] + RETURN .T. + ENDIF + NEXT + RETURN .F. +ENDIF +RETURN .T. + +********************************************************* +// RENAME ATTRIBUTES +********************************************************* +FUNCTION REN_ATT +// RENAME ATTRIBUTES + +LOCAL ATT_PARM := DBOPEN('ATTRIBUTES', .T.) , CUR_ATT, NEW_ATT +LOCAL MSG1, MSG2 + +CLS +SAYTITLE('Rename Attributes', 'PRPO' ) + +DBOPEN('ATT_OPTS', .T.) +DBOPEN('CAT_ATTS', .T.) +DBOPEN('CAT_OPTS', .T.) +DBOPEN('PROD_ATTS', .T.) +DBOPEN('PROD_OPTS', .T.) +DBOPEN('ORDER_OPTS', .T.) +DBOPEN('ADDL_OPTS', .T.) +DBOPEN('MATHPACK', .T.) +DBOPEN('RULEPACK', .T.) +// ADD NEW FILES TO THIS LIST FOR QUOTE OPTS +DBOPEN('QUOTE_OPTS', .T.) +DBOPEN('ADDL_QOPT', .T.) + +DO WHILE .T. + CUR_ATT = GET_KEY(ATT_PARM) + IF EMPTY(CUR_ATT) .OR. LASTKEY() = 27 + CLOSE DATABASES + RETURN + ENDIF + NEW_ATT = SPACE(10) + @ 05,19 SAY ' Enter New Attribute' GET NEW_ATT PICTURE '@!' + @ 06,19 SAY ' (Press to Quit)' + READ() + IF EMPTY(NEW_ATT) + LOOP + ENDIF + + MSG1 := 'About to CHANGE Attributes' + MSG2 := 'Do You Wish to Continue?' + IF !PROMPT_BOX(MSG1,MSG2,'') // ASKS YES/NO, YES = .T., NO = .F. + @ 5,0 CLEAR + LOOP + ENDIF + + @ 6,0 CLEAR + @ 10,10 SAY 'Changing ATTRIBUTES in the Attribute File' + SELECT ATTRIBUTES + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Attribute Options File' + SELECT ATT_OPTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Category File' + SELECT CAT_ATTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Category Options File' + SELECT CAT_OPTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Model File' + SELECT PROD_ATTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Model Options File' + SELECT PROD_OPTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Order Options File' + SELECT ORDER_OPTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Additional Order Options File' + SELECT ADDL_OPTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Quote Options File' + SELECT QUOTE_OPTS + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Additional Quote Options File' + SELECT ADDL_QOPT + DONSETORD(0) + REPLACE ALL ATT_CODE WITH NEW_ATT FOR TRIM(ATT_CODE) == TRIM(CUR_ATT) + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Math Pack File' + SELECT MATHPACK + DONSETORD(0) + DO WHILE !EOF() + IF TRIM(FIELD1) == TRIM(CUR_ATT) + REPLACE FIELD1 WITH NEW_ATT + ENDIF + IF TRIM(FIELD2) == TRIM(CUR_ATT) + REPLACE FIELD2 WITH NEW_ATT + ENDIF + IF TRIM(ATT_CODE) == TRIM(CUR_ATT) + REPLACE ATT_CODE WITH NEW_ATT + ENDIF + SKIP 1 + ENDDO + DONSETORD(1) + + @ 10,0 + @ 10,10 SAY 'Changing ATTRIBUTES in the Rule Pack File' + SELECT RULEPACK + DONSETORD(0) + DO WHILE !EOF() + IF TRIM(FIELD1) == TRIM(CUR_ATT) + REPLACE FIELD1 WITH NEW_ATT + ENDIF + IF TRIM(FIELD2) == TRIM(CUR_ATT) + REPLACE FIELD2 WITH NEW_ATT + ENDIF + IF TRIM(ALIAS1) == TRIM(CUR_ATT) + REPLACE ALIAS1 WITH NEW_ATT + ENDIF + IF TRIM(ALIAS2) == TRIM(CUR_ATT) + REPLACE ALIAS2 WITH NEW_ATT + ENDIF + SKIP 1 + ENDDO + DONSETORD(1) + @ 5,0 CLEAR + +ENDDO +CLOSE DATABASES +RETURN +********************************************************* +* CALCULATE THE ITEM DISCOUNTS +********************************************************* +FUNCTION ITEMDISC( PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) +LOCAL THIS_DISC, THIS_LINE +LOCAL ALT_PRICE_IND := .F. //** P3N - 9/1/98 +LOCAL QTYARR := {} //** P3N -12/4/98 +LOCAL INV_QTY := 0 //** P3N -12/4/98 + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF EMPTY(PARTIAL_INVOICE) //** P3N -11/24/98 + PARTIAL_INVOICE := .F. //** P3N -11/24/98 +ENDIF //** P3N -11/24/98 + +IF EMPTY(REPRINT_INVOICE) //** P3N -12/4/98 + REPRINT_INVOICE := .F. //** P3N -12/4/98 +ENDIF //** P3N -12/4/98 + +IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N -12/4/98 + QTYARR := GET_OSTQTY(SELFILE) //** P3N -12/4/98 + IF EMPTY(QTYARR) //** P3N - 12/4/98 + SHP_QTY := 0 //** P3N - 12/4/98 + INV_QTY := 0 //** P3N - 12/4/98 + ELSE //** P3N - 12/4/98 + SHP_QTY := QTYARR[1] //** P3N - 12/4/98 + INV_QTY := QTYARR[2] //** P3N - 12/4/98 + ENDIF //** P3N - 12/4/98 +ENDIF //** P3N - 12/4/98 + +IF ALT_SPRICE <> 0 + IF PARTIAL_INVOICE //** P3N - 11/24/98 +//**THIS_LINE := (ALT_SPRICE * SHIP_QTY) //** P3N - 11/24/98 + THIS_LINE := (ALT_SPRICE * SHP_QTY) //** P3N - 11/24/98 + ELSEIF REPRINT_INVOICE //** P3N - 12/07/98 + THIS_LINE := (ALT_SPRICE * INV_QTY) //** P3N - 12/07/98 + ELSE + THIS_LINE := (ALT_SPRICE * QUANTITY) + ENDIF + ALT_PRICE_IND := .T. //** P3N - 9/1/98 +ELSE + IF PARTIAL_INVOICE //** P3N - 11/24/98 +//**THIS_LINE := (SALE_PRICE * SHIP_QTY) //** P3N - 11/24/98 + THIS_LINE := (SALE_PRICE * SHP_QTY) //** P3N - 11/24/98 + ELSEIF REPRINT_INVOICE //** P3N - 12/07/98 + THIS_LINE := (SALE_PRICE * INV_QTY) //** P3N - 12/07/98 + ELSE + THIS_LINE := (SALE_PRICE * QUANTITY) + ENDIF +ENDIF + +//** P3N - 11/23/98 PARTIAL INVOICE PROCESSING +IF EMPTY(THIS_LINE) + THIS_DISC := 0 //** P3N - 11/23/98 +ELSEIF DISCOUNT <> 0 + THIS_DISC := (DISCOUNT * .01 * THIS_LINE) +ELSEIF EMPTY(DISC_S_AMT) //** IF NO LINE ITEM DISC. USE SYS/CUST DISC + THIS_DISC := (SYS_DISC * .01 * THIS_LINE) +ELSEIF PARTIAL_INVOICE //** P3N - 12/4/98 +//** THIS_DISC := DISC_S_AMT * SHIP_QTY + THIS_DISC := DISC_S_AMT * SHP_QTY +ELSEIF REPRINT_INVOICE //** P3N - 12/4/98 + THIS_DISC := DISC_S_AMT * INV_QTY +ELSE //** P3N - 12/4/98 + THIS_DISC := DISC_S_AMT * QUANTITY +ENDIF + +**IF EMPTY(ALT_SPRICE) // P3N - PER ELLEN - 6/3/98 +**ELSE // DO NOT APPLY A DISCOUNT ON ALT PRICE! +** THIS_DISC := 0 +**ENDIF +THIS_DISC := VAL(STR(THIS_DISC,12,2)) + +//** P3N - 4/3/98 IS THIS ALT_SPRICE A CREDIT? +//** P3N - IF A CREDIT SET THE DISCOUNT NEGATIVE +//** P3N - CGWPRINT FUNC PRNT_DISCOUNTS() WILL TREAT A NEGATIVE DISCOUNT +//** P3N - AS A POSITIVE CHARGE BACK. +IF ALT_SPRICE <> 0 + IF ALT_SPRICE + SALE_PRICE = 0 + IF THIS_DISC < 0 + // DISCOUNT IS ALREADY NEGATIVE + ELSE + THIS_DISC := THIS_DISC * -1 + ENDIF + ENDIF +ELSEIF (CUR_MAST)->TERMS = '98' //CREDIT MEMO + IF THIS_DISC < 0 + // DISCOUNT IS ALREADY NEGATIVE + ELSE + THIS_DISC := THIS_DISC * -1 + ENDIF +ENDIF + +RETURN {THIS_LINE, THIS_DISC, ALT_PRICE_IND} //** P3N - 9/1/98 +****RETURN {THIS_LINE, THIS_DISC} //** P3N - 9/1/98 + + +********************************************************* +** UPDATE MISC TOTAL IN ORDER MASTER +** P3N - 2/20/98 +** PER ELLENS REQUEST - ADDED AN ALTERNATE PRICE +** USED TO OVERRIDE THE SYSTEM GENERATED PRICE! +********************************************************* +FUNCTION UP_MISCTOT(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) +//**LOCAL SUBTOT:=0, SAVESEL := SELECT() +LOCAL SUBTOT := 0, QTYARR := {} +LOCAL WKQTY := 0, MISCKEY //** P3N - 11/25/98 +LOCAL MISCITMS := CUR_MISC //** P3N - 11/25/98 + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/25/98 + PARTIAL_INVOICE := .F. //** P3N - 11/25/98 +ENDIF + +IF EMPTY(REPRINT_INVOICE) //** P3N - 12/4/98 + REPRINT_INVOICE := .F. //** P3N - 12/4/98 +ENDIF + +IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N - 12/4/98 + MISCITMS := 'TORD_LINES' //** P3N - 11/25/98 + IF SELECT('TORD_LINES') > 0 + //** TORD_LINES ALREADY EXISTS + IF (MISCITMS)->ORDER_NUM == (CUR_MAST)->ORDER_NUM + //** TORD_LINES ALREADY EXISTS WITH THE SAME ORDER - PROCESS + ELSE + CLOSE TORD_LINES + BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) + ENDIF + ELSE + BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) + ENDIF + (MISCITMS)->(DBGOTOP()) +ELSE + (MISCITMS)->(DBSEEK(MORDER_NUM)) +ENDIF +DO WHILE (MISCITMS)->(!EOF()) .AND. (MISCITMS)->ORDER_NUM == MORDER_NUM + WKQTY := (MISCITMS)->QUANTITY + IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N - 12/4/98 + IF (MISCITMS)->PROD_CODE == 'MISCITM' + MISCKEY := (MISCITMS)->ORDER_NUM + MISCKEY := MISCKEY + STR((MISCITMS)->LINE_NUM, 3) + MISCKEY := MISCKEY + (MISCITMS)->PROD_CODE + QTYARR := GET_OSTQTY('TORD_LINES', MISCKEY) + IF EMPTY(QTYARR) //** P3N - 12/4/98 + WKQTY := 0 //** P3N - 12/4/98 + ELSEIF PARTIAL_INVOICE //** P3N - 12/4/98 + WKQTY := QTYARR[1] //** SHIP QTY + ELSEIF REPRINT_INVOICE //** P3N - 12/4/98 + WKQTY := QTYARR[2] //** INVOICE QTY + ENDIF //** P3N - 12/4/98 + ELSE + WKQTY := 0 + ENDIF + ENDIF + IF EMPTY((MISCITMS)->ALT_SPRICE) //** P3N - 2/20/98 + SUBTOT := SUBTOT + ( (MISCITMS)->SALE_PRICE * WKQTY ) + ELSE + SUBTOT := SUBTOT + ((MISCITMS)->ALT_SPRICE * WKQTY ) //**P3N-2/20/98 + ENDIF + (MISCITMS)->(DBSKIP(+1)) +ENDDO +//**(MISCITMS)->(DBGOTOP()) + +IF SUBTOT > 99999.99 + ERR_BOX('** Calculated total - ' + ALLTRIM(STR(SUBTOT,16,4)) + ; + ' is larger Than allowable! **', ; + ' The Max. allowable MISC. Order Items total is - $99,999.99', ; + ' The Order INVOICE TOTAL may be INCORRECT!') +ELSE +//** SELECT (CUR_MAST) + REC_LOCK(1, CUR_MAST) + REPLACE (CUR_MAST)->ORD_M_TTL WITH SUBTOT + (CUR_MAST)->(DBUNLOCK()) +ENDIF + +//**SELECT (SAVESEL) +RETURN .T. + + +********************************************************* +****PAINT SCREEN BEFORE 2115 EXECUTES +********************************************************* +FUNCTION MISCP_PAINT(NOPAINT, PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) + +LOCAL SAVESEL := SELECT() +LOCAL LINE_TOTAL := 0, SUBTOTL := 0, SEEKKEY := &CUR_MAST->ORDER_NUM +LOCAL DISC_TOTAL := 0, _DISC_INFO +LOCAL MISC_TOTAL, L1 := 0, L2 := 0, L3 := 0 +LOCAL THIS_LINE := 0, THIS_DISC := 0 +LOCAL M1 := 0, M2 := 0, M3 := 0, NTX1 := 0, NTX2 := 0, NTX3 := 0 +LOCAL T1 := 0, T2 := 0, T3 := 0 //** P3N - 11/25/98 +LOCAL ALT_PRICE_IND := .F. //** P3N - 9/1/98 +LOCAL ALT_PR_ARR := {} //** P3N - 9/1/98 +LOCAL MISC_ARR := {} //** P3N - 11/25/98 +LOCAL DISC_ARR := {} //** P3N - 12/07/98 +LOCAL DISC_PCT := 0, ELM := 0, TOT_AMT := 0 //** P3N - 12/07/98 +LOCAL DISP_PCT := 0 +LOCAL FSC_PCT := SHIPMETH->FUEL_CHRG / 100 //** P3N - 09/21/06 + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF SHIPMETH->(DBSEEK( (CUR_MAST)->SHP_METHOD )) //** P3N - 11/13/06 + FSC_PCT := SHIPMETH->FUEL_CHRG / 100 //** P3N - 11/13/06 +ENDIF //** P3N - 11/13/06 +//** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS + +IF EMPTY(NOPAINT) //** P3N - 11/23/98 + NOPAINT := .F. //** P3N - 11/23/98 +ENDIF //** P3N - 11/23/98 + +IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/23/98 + PARTIAL_INVOICE := .F. //** P3N - 11/23/98 +ENDIF //** P3N - 11/23/98 + +IF EMPTY( REPRINT_INVOICE ) //** P3N - 12/4/98 + REPRINT_INVOICE := .F. //** P3N - 12/4/98 +ENDIF //** P3N - 12/4/98 + +IF LASTKEY() = 27 + RETURN +ENDIF + +// DO ORDER LINES FIRST, THEN ADDL PRODUCTS SECOND +IF &CUR_MAST->QUOTE_PRIC > 0 + LINE_TOTAL := &CUR_MAST->QUOTE_PRIC +ELSE + SELECT (CUR_OL) + SEEK SEEKKEY + DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF() + _DISC_INFO := ITEMDISC(PARTIAL_INVOICE, REPRINT_INVOICE, SELFILE) + THIS_LINE := _DISC_INFO[1] + THIS_DISC := _DISC_INFO[2] + ALT_PRICE_IND := _DISC_INFO[3] //** P3N - 9/1/98 + IF ALT_PRICE_IND //** P3N - 9/1/98 + AADD(ALT_PR_ARR, {LINE_NUM, PROD_CODE } ) //** P3N - 9/1/98 + ENDIF //** P3N - 9/1/98 + LINE_TOTAL := LINE_TOTAL + THIS_LINE + // CHECK FOR USER LINE DISCOUNTS OR SYSTEM CALC DISCOUNTS + DISC_TOTAL := DISC_TOTAL + THIS_DISC + + SKIP 1 + ENDDO + + SELECT (CUR_XL) + SEEK SEEKKEY + DO WHILE ORDER_NUM == SEEKKEY .AND. !EOF() + IF ALT_SPRICE <> 0 + THIS_LINE := (ALT_SPRICE * QUANTITY) + ELSE + THIS_LINE := (SALE_PRICE * QUANTITY) + ENDIF + //** P3N - 9/1/98 DO NOT INCLUDE THE ADDL LINE PRICE IN THE TOTAL + //** P3N - 9/1/98 ORDER AMOUNT IF AN ALT. PRICE HAS BEEN ENTERED. + IF EMPTY(ALT_PR_ARR) .OR. ; //** P3N - 9/1/98 + EMPTY(ASCAN(ALT_PR_ARR, {|X| X[1] == LINE_NUM .AND. ; + X[2] == PAR_PROD } ) ) + LINE_TOTAL := LINE_TOTAL + THIS_LINE //** P3N - 9/1/98 + ENDIF //** P3N - 9/1/98 + + + // CHECK FOR USER LINE DISCOUNTS OR SYSTEM CALC DISCOUNTS + IF DISCOUNT <> 0 + THIS_DISC := (DISCOUNT * .01 * THIS_LINE) + ELSE + THIS_DISC := DISC_S_AMT * QUANTITY + ENDIF + DISC_TOTAL := DISC_TOTAL + THIS_DISC + SKIP 1 + ENDDO +ENDIF + +//* CALC SUBTOTAL +UP_MISCTOT((CUR_MAST)->ORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) //** P3N - 11/25/98 + +SELECT (CUR_MAST) +MISC_TOTAL := &CUR_MAST->ORD_M_TTL //* F8-MISC TOTALS +IF PARTIAL_INVOICE .OR. REPRINT_INVOICE //** P3N - 11/24/98 + MISC_ARR := GETQTYMISC( (CUR_MAST)->ORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE ) + FOR I := 1 TO LEN(MISC_ARR[1]) + IF MISC_ARR[1,I,5] == 'ORDMISC1' + IF REPRINT_INVOICE //** P3N - 12/4/98 + M1 := MISC_ARR[1,I,6] //** INV QTY + ELSE + M1 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L1 := MISC_ARR[1,I,4] //** ITEM PRICE + M1 := M1 * L1 + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC2' + IF REPRINT_INVOICE //** P3N - 12/4/98 + M2 := MISC_ARR[1,I,6] //** INV QTY + ELSE + M2 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L2 := MISC_ARR[1,I,4] //** ITEM PRICE + M2 := M2 * L2 + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC3' + IF REPRINT_INVOICE //** P3N - 12/4/98 + M3 := MISC_ARR[1,I,6] //** INV QTY + ELSE + M3 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L3 := MISC_ARR[1,I,4] //** ITEM PRICE + M3 := M3 * L3 + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX1' + IF REPRINT_INVOICE //** P3N - 12/4/98 + T1 := MISC_ARR[1,I,6] //** INV QTY + ELSE + T1 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L1 := MISC_ARR[1,I,4] //** ITEM PRICE + NTX1 := T1 * L1 + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX2' + IF REPRINT_INVOICE //** P3N - 12/4/98 + T2 := MISC_ARR[1,I,6] //** INV QTY + ELSE + T2 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L2 := MISC_ARR[1,I,4] //** ITEM PRICE + NTX2 := T2 * L2 + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX3' + IF REPRINT_INVOICE //** P3N - 12/4/98 + T3 := MISC_ARR[1,I,6] //** INV QTY + ELSE + T3 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L3 := MISC_ARR[1,I,4] //** ITEM PRICE + NTX3 := T3 * L3 + ENDIF + NEXT +ELSE +//* - SCREEN 2115 MISC ITEMS + M1 := &CUR_MAST->MISC_AMT1 * &CUR_MAST->MISC_QTY1 + M2 := &CUR_MAST->MISC_AMT2 * &CUR_MAST->MISC_QTY2 + M3 := &CUR_MAST->MISC_AMT3 * &CUR_MAST->MISC_QTY3 + +//* 7-30-97 NON-TAXABLE AMOUNTS ADDED - Perry Nichols + NTX1 := &CUR_MAST->NOTX_AMT1 * &CUR_MAST->NOTX_QTY1 + NTX2 := &CUR_MAST->NOTX_AMT2 * &CUR_MAST->NOTX_QTY2 + NTX3 := &CUR_MAST->NOTX_AMT3 * &CUR_MAST->NOTX_QTY3 +ENDIF +SUBTOTL := (CUR_MAST)->ORD_L_TTL + (CUR_MAST)->ORD_M_TTL + M1 + M2 + M3 +SUBTOTL := SUBTOTL - (CUR_MAST)->ORD_D_TTL +IF _OC_CAPABLE + REC_LOCK(1) + REPLACE (CUR_MAST)->ORD_L_TTL WITH LINE_TOTAL + IF DISC_TOTAL > 9999.99 + ERR_BOX('** The Calculated Discount is - ' + STR(DISC_TOTAL, 15,2) + ' **' , ; + '** The system can store a discount up to $9999.99 **') + ELSE + REPLACE (CUR_MAST)->ORD_D_TTL WITH DISC_TOTAL + ENDIF + IF M->OE_TYPE == 'ADD' .AND. ; //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + EMPTY((CUR_MAST)->FUEL_CHRG) + //** ADD ORDER TIME-CALC BASED ON THE ORDER TOTAL * SHIPMETH->FUEL_CHRG % + SUBTOTL := (CUR_MAST)->ORD_L_TTL + (CUR_MAST)->ORD_M_TTL + M1 + M2 + M3 + SUBTOTL := SUBTOTL - (CUR_MAST)->ORD_D_TTL + REPLACE (CUR_MAST)->FUEL_CHRG WITH SUBTOTL * FSC_PCT + ENDIF + SUBTOTL += (CUR_MAST)->FUEL_CHRG //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + REPLACE (CUR_MAST)->SALES_TAX WITH ( (CUR_MAST)->SLS_TX_PCT * SUBTOTL ) /100 + +//* 7-30-97 NON-TAXABLE AMOUNTS ADDED - Perry Nichols + TOT_AMT := SUBTOTL +(CUR_MAST)->SALES_TAX + NTX1 + NTX2 + NTX3 + //** P3N - 09/21/06 ADDED THE FUEL SURCHARGE TO ORDER ENTRY + REPLACE (CUR_MAST)->TOTAL_AMT WITH TOT_AMT + + IF ZERO_ORDER() //** NO CHARGE P3N-3/5/99 + REPLACE (CUR_MAST)->TOTAL_AMT WITH 0 + REPLACE (CUR_MAST)->SALES_TAX WITH 0 //** P3N - 02/20/07 + ENDIF + (CUR_MAST)->(DBUNLOCK()) +ENDIF + +//** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS +IF NOPAINT + //** DO NOT PAINT ANYTHING ON THE SCREEN + +ELSE + + @ 02,33 SAY ' Line Item Totals ' + STR(&CUR_MAST->ORD_L_TTL,9,2) + @ 03,33 SAY ' Less Discounts ' + @ 04,33 SAY ' Misc Item Lines ' + @ 06,06 SAY 'Misc. Items' + @ 06,36 SAY 'Qty' + @ 06,45 SAY 'Cost' + @ 10,53 SAY '----------' + @ 11,43 SAY 'Subtotal ' + + //* 7-30-97 NON-TAXABLE AMOUNTS ADDED - Perry Nichols + //* lines 16-20 are used for the NON-TAXABLE items + //** P3N - 09/21/06 ADD FUEL SURCHARGE TO ORDER ENTRY + @ 14,53 SAY '----------' + @ 15,06 SAY 'Non-Taxable Items' + @ 15,36 SAY 'Qty' + @ 15,45 SAY 'Cost' + @ 19,53 SAY '----------' + + IF EMPTY((CUR_MAST)->FUEL_CHRG) + + ELSE + DISP_PCT := VAL (STR((CUR_MAST)->FUEL_CHRG / SUBTOTL,15,2)) + ENDIF + + @ 12,65 SAY STR(DISP_PCT*100, 3,0) + '%' //** P3N - 09/21/06 + @ 13,65 SAY STR((CUR_MAST)->SLS_TX_PCT, 8,4) + '%' //** P3N - 09/22/06 - HAPPY BDAY CINDY #47 + @ 21,33 SAY 'Order ' + ALLTRIM((CUR_MAST)->ORDER_NUM) + ' TOTAL' + @ 22,53 SAY '==========' + +ENDIF + + +UP_ORD_TTL(NOPAINT, MISC_ARR, PARTIAL_INVOICE, REPRINT_INVOICE ) + +SELECT(SAVESEL) + +RETURN .T. + + + +********************************************************* +* THIS FUNCTION PROVIDES THE PROCESSING FOR THE MISC PRICING SCREEN +********************************************************* + +FUNCTION MISC_PRICING( ) + +LOCAL SV_SEL := SELECT() +LOCAL SV_COLOR := SETCOLOR(BLACK) +LOCAL I_DESC := SPACE(30), I_AMT := 0, FR_AMT := 0 +LOCAL SLS_TAX := 0 +LOCAL MTITLE := 'ADD Misc Items / Close Order - ' + &CUR_MAST->ORDER_NUM +LOCAL ASR_ARR, OPT +LOCAL ACTION_CODE := GETAVAR( 'ACTION_CODE' ) + +IF LASTKEY() = 27 + RETURN +ENDIF + +IF _OC_CAPABLE .AND. ACTION_CODE = 'ADD' + OPT := 1 + MTITLE := 'ADD Misc Items / Close Order - ' + &CUR_MAST->ORDER_NUM + IF CUR_MAST = 'QUOTE_MAST' + MTITLE := 'ADD Misc Items / Close Quote - ' + &CUR_MAST->ORDER_NUM + ENDIF +ELSE + OPT := 3 + MTITLE := 'ORDER Misc Items - ' + &CUR_MAST->ORDER_NUM + IF CUR_MAST = 'QUOTE_MAST' + MTITLE := 'QUOTE Misc Items - ' + &CUR_MAST->ORDER_NUM + ENDIF +ENDIF + +ASR_ARR := {'&CUR_MAST',.F., , , , , ACTION_CODE , '2115', .F.} + +NEWREC := .F. +ADD_SING_REC(OPT, MTITLE, ASR_ARR) + +UP_OM_NEED_CALC() // INDICATE THE THE ORDER IS COMPLETE. + +SETCOLOR(SV_COLOR) +SELECT(SV_SEL) +RETURN .T. + +********************************************************* +* THIS FUNCTION UPDATES THE ORDER TOTALS +********************************************************* + +FUNCTION UP_ORD_TTL(NOPAINT, MISC_ARR, PARTIAL_INVOICE, REPRINT_INVOICE) + +LOCAL SAVECOLOR := SETCOLOR(HNOR), LINE_TOTAL := 0 +LOCAL PRNTVAR, SAVESEL := SELECT() +LOCAL M1 := 0, M2 := 0, M3 := 0, NTX1 := 0, NTX2 := 0, NTX3 := 0 +LOCAL T1 := 0, T2 := 0, T3 := 0 //** P3N - 11/25/98 +LOCAL MISC_TOTAL := 0, M_FSC := 0, MFUEL_CHRG := 0 +LOCAL DISC_TOTAL := 0, SUB1 := 0 +LOCAL STX_AMT := 0, TOT_AMT := 0 +LOCAL M_AMT1 := 0, M_AMT2 := 0, M_AMT3 := 0, M_STAX := 0 +LOCAL M_QTY1 := 0, M_QTY2 := 0, M_QTY3 := 0, M_OTTL := 0 +LOCAL DISP_PCT := 0 + +//7-30-97 NO more FREIGHT - per Ellen +****STATIC M_TTL +****STATIC M_FRT + +//7-30-97 NON-TAX MODIFICATIONS - Perry Nichols +LOCAL NOTX_AMT1,NOTX_AMT2,NOTX_AMT3,NOTX_QTY1,NOTX_QTY2,NOTX_QTY3 + +//** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS +IF EMPTY(NOPAINT) + NOPAINT := .F. +ENDIF +IF NOPAINT +//** DO NOT PAINT ANYTHING ON THE SCREEN - JUST CALC TOTALS +//** P3N - 11/23/98 PARTIAL INVOICE PROCESSING MODIFICATIONS + IF EMPTY(MISC_ARR) //** USE ORDER QTYS TO CALC TOTALS + M1 := (CUR_MAST)->MISC_AMT1 * (CUR_MAST)->MISC_QTY1 + M2 := (CUR_MAST)->MISC_AMT2 * (CUR_MAST)->MISC_QTY2 + M3 := (CUR_MAST)->MISC_AMT3 * (CUR_MAST)->MISC_QTY3 + NTX1 := (CUR_MAST)->NOTX_AMT1 * (CUR_MAST)->NOTX_QTY1 + NTX2 := (CUR_MAST)->NOTX_AMT2 * (CUR_MAST)->NOTX_QTY2 + NTX3 := (CUR_MAST)->NOTX_AMT3 * (CUR_MAST)->NOTX_QTY3 + ELSE //** USE SHIP QTYS TO CALC TOTALS + FOR I := 1 TO LEN(MISC_ARR[1]) + IF MISC_ARR[1,I,5] == 'ORDMISC1' + IF REPRINT_INVOICE + M1 := MISC_ARR[1,I,6] //** INV QTY + ELSE + M1 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L1 := MISC_ARR[1,I,4] //** ITEM PRICE + M1 := M1 * L1 + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC2' + IF REPRINT_INVOICE + M2 := MISC_ARR[1,I,6] //** INV QTY + ELSE + M2 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L2 := MISC_ARR[1,I,4] //** ITEM PRICE + M2 := M2 * L2 + ELSEIF MISC_ARR[1,I,5] == 'ORDMISC3' + IF REPRINT_INVOICE + M3 := MISC_ARR[1,I,6] //** INV QTY + ELSE + M3 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L3 := MISC_ARR[1,I,4] //** ITEM PRICE + M3 := M3 * L3 + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX1' + IF REPRINT_INVOICE + T1 := MISC_ARR[1,I,6] //** INV QTY + ELSE + T1 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L1 := MISC_ARR[1,I,4] //** ITEM PRICE + NTX1 := T1 * L1 + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX2' + IF REPRINT_INVOICE + T2 := MISC_ARR[1,I,6] //** INV QTY + ELSE + T2 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L2 := MISC_ARR[1,I,4] //** ITEM PRICE + NTX2 := T2 * L2 + ELSEIF MISC_ARR[1,I,5] == 'ORDNOTX3' + IF REPRINT_INVOICE + T3 := MISC_ARR[1,I,6] //** INV QTY + ELSE + T3 := MISC_ARR[1,I,3] //** SHIP QTY + ENDIF + L3 := MISC_ARR[1,I,4] //** ITEM PRICE + NTX3 := T3 * L3 + ENDIF + NEXT + ENDIF + SUB1 := M1 + M2 + M3 ; + + &CUR_MAST->ORD_L_TTL - &CUR_MAST->ORD_D_TTL ; + + &CUR_MAST->ORD_M_TTL + MFUEL_CHRG := (CUR_MAST)->FUEL_CHRG //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + SUB1 += MFUEL_CHRG //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + STX_AMT := (SUB1 * (&CUR_MAST->SLS_TX_PCT / 100)) + STX_AMT := VAL( STR( STX_AMT, 8, 2 ) ) + //** IF (CUR_MAST)->TERMS = '90' .OR. ; //NO CHARGE + //** (CUR_MAST)->TERMS = '96' //CANCELLED + IF ZERO_ORDER() //** NO CHARGE P3N-3/5/99 + TOT_AMT := 0.00 //** TOTAL ORDER IS ZERO + ELSE + TOT_AMT := SUB1 + STX_AMT + NTX1 + NTX2 + NTX3 + ENDIF +ELSE + IF !EMPTY(GETVARS) + //7-30-97 NON-TAX MODIFICATIONS - Perry Nichols + NOTX_AMT1 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_AMT1'}) + NOTX_AMT2 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_AMT2'}) + NOTX_AMT3 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_AMT3'}) + NOTX_QTY1 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_QTY1'}) + NOTX_QTY2 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_QTY2'}) + NOTX_QTY3 := ASCAN(GETVARS, {|X| X[3] = 'NOTX_QTY3'}) + + M_AMT1 := ASCAN(GETVARS, {|X| X[3] = 'MISC_AMT1'}) + M_AMT2 := ASCAN(GETVARS, {|X| X[3] = 'MISC_AMT2'}) + M_AMT3 := ASCAN(GETVARS, {|X| X[3] = 'MISC_AMT3'}) + M_QTY1 := ASCAN(GETVARS, {|X| X[3] = 'MISC_QTY1'}) + M_QTY2 := ASCAN(GETVARS, {|X| X[3] = 'MISC_QTY2'}) + M_QTY3 := ASCAN(GETVARS, {|X| X[3] = 'MISC_QTY3'}) + M_STAX := ASCAN(GETVARS, {|X| X[3] = 'SALES_TAX'}) + M_OTTL := ASCAN(GETVARS, {|X| X[3] = 'TOTAL_AMT'}) + //7-30-97 NO more FREIGHT - per Ellen + ****M_FRT := ASCAN(GETVARS, {|X| X[3] = 'FREIGHT'}) + + + // WRITE DISCOUNTS TO SCREEN + LINE_TOTAL := (CUR_MAST)->ORD_L_TTL + DISC_TOTAL := (CUR_MAST)->ORD_D_TTL * -1 + MISC_TOTAL := (CUR_MAST)->ORD_M_TTL + @ 02,53 SAY VAL(STR(LINE_TOTAL,10,2)) PICTURE '9999999.99' //*ORDER LINE ITEM TOTALS +//**@ 02,52 SAY VAL(STR(LINE_TOTAL,10,2)) PICTURE '9999999.99' //*ORDER LINE ITEM TOTALS + **@ 02,53 SAY VAL(STR(LINE_TOTAL,9,2)) PICTURE '999999.99' //*ORDER LINE ITEM TOTALS +//**@ 03,53 SAY VAL(STR(DISC_TOTAL,9,2)) PICTURE '999999.99' //*DISC TAX AMT + @ 03,54 SAY VAL(STR(DISC_TOTAL,9,2)) PICTURE '999999.99' //*DISC TAX AMT +//**@ 04,53 SAY VAL(STR(MISC_TOTAL,9,2)) PICTURE '999999.99' //*MISC AMT + @ 04,54 SAY VAL(STR(MISC_TOTAL,9,2)) PICTURE '999999.99' //*MISC AMT + + IF EMPTY(M_AMT1) //** GET OUT - DO NOT CONTINUE DUE TO NO + SETCOLOR(SAVECOLOR) //** GETVARS ARR TO USE FOR UPDATE + RETURN .T. + ENDIF + + //* CALC SUB TOTAL OF MISC ITEMS + // misc_amt1,2,3 + M1 := (GETVARS[M_AMT1,4] * GETVARS[M_QTY1,4]) + M2 := (GETVARS[M_AMT2,4] * GETVARS[M_QTY2,4]) + M3 := (GETVARS[M_AMT3,4] * GETVARS[M_QTY3,4]) + SUB1 := M1 + M2 + M3 ; + + &CUR_MAST->ORD_L_TTL - &CUR_MAST->ORD_D_TTL ; + + &CUR_MAST->ORD_M_TTL + + M_FSC := ASCAN(GETVARS, {|X| X[3] = 'FUEL_CHRG'}) //** P3N - 09/21/06 + IF EMPTY(M_FSC) //** P3N - 09/21/06 + MFUEL_CHRG := (CUR_MAST)->FUEL_CHRG //** P3N - 09/21/06 + ELSE //** P3N - 09/21/06 + MFUEL_CHRG := GETVARS[M_FSC,4] //** P3N - 09/21/06 + ENDIF //** P3N - 09/21/06 +//**@ 07,53 SAY STR(M1, 9, 2) + @ 07,54 SAY STR(M1, 9, 2) +//**@ 08,53 SAY STR(M2, 9, 2) + @ 08,54 SAY STR(M2, 9, 2) +//**@ 09,53 SAY STR(M3, 9, 2) + @ 09,54 SAY STR(M3, 9, 2) + IF M->OE_TYPE = 'ADD' //** P3N - 10/16/06 + @ 12, 54 SAY MFUEL_CHRG PICTURE '999999.99' //** P3N - 10/16/06 + ENDIF //** P3N - 10/16/06 + @ 11,54 SAY VAL(STR(SUB1,9,2)) PICTURE '999999.99' //*SUBTOTAL + + //* CALC THE SALES TAX AMT + STX_AMT := ( (SUB1+ MFUEL_CHRG) * (&CUR_MAST->SLS_TX_PCT / 100)) + STX_AMT := VAL( STR( STX_AMT, 8, 2 ) ) + PRNTVAR := STX_AMT + + // sales tax amt + GETVARS[M_STAX,4] := STX_AMT + // @ 12,53 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*SALES TAX AMT + // @ 13,53 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*SALES TAX AMT + @ 13,54 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*SALES TAX AMT + + //7-30-97 NON-TAX MODIFICATIONS - Perry Nichols + //* DISPLAY THE NON - TAXABLE ITEMS - SCREEN 2115 + NTX1 := (GETVARS[NOTX_AMT1,4] * GETVARS[NOTX_QTY1,4]) + NTX2 := (GETVARS[NOTX_AMT2,4] * GETVARS[NOTX_QTY2,4]) + NTX3 := (GETVARS[NOTX_AMT3,4] * GETVARS[NOTX_QTY3,4]) +//**@ 15,53 SAY STR(NTX1, 9, 2) + @ 16,54 SAY STR(NTX1, 9, 2) +//**@ 16,53 SAY STR(NTX2, 9, 2) + @ 17,54 SAY STR(NTX2, 9, 2) +//**@ 17,53 SAY STR(NTX3, 9, 2) + @ 18,54 SAY STR(NTX3, 9, 2) + + //* DISPLAY THE TOTAL ORDER AMT + + //** P3N - 4/3/98 +//**IF (CUR_MAST)->TERMS = '90' .OR. ; //NO CHARGE +//** (CUR_MAST)->TERMS = '96' //CANCELLED + IF ZERO_ORDER() //** NO CHARGE P3N-3/5/99 + TOT_AMT := 0.00 //** TOTAL ORDER IS ZERO + ELSE + TOT_AMT := SUB1 + MFUEL_CHRG + STX_AMT + NTX1 + NTX2 + NTX3 + ENDIF + + GETVARS[M_OTTL,4] := TOT_AMT + PRNTVAR := TOT_AMT + //** P3N - 09/21/06 - ADDED FUEL SURCHARGE TO ORDER ENTRY + IF EMPTY(MFUEL_CHRG) + ELSE + DISP_PCT := MFUEL_CHRG / SUB1 //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + ENDIF + @ 12,65 SAY STR(DISP_PCT*100, 3,0) + '%' //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + @ 13,65 SAY STR((CUR_MAST)->SLS_TX_PCT, 8,4) + '%' //** P3N - 09/22/06 HAPPY BDAY CINDY #47 + @ 21,52 SAY VAL(STR(PRNTVAR,10,2)) PICTURE '99999999.99' //*TOTAL ORDER AMT +//**@ 20,52 SAY VAL(STR(PRNTVAR,10,2)) PICTURE '99999999.99' //*TOTAL ORDER AMT + **@ 20,53 SAY VAL(STR(PRNTVAR,9,2)) PICTURE '999999.99' //*TOTAL ORDER AMT + ENDIF +ENDIF + +IF (CUR_MAST)->SALES_TAX <> VAL(STR(STX_AMT, 9,2)) .OR. ; + (CUR_MAST)->TOTAL_AMT <> VAL(STR(TOT_AMT, 10,2)) + IF _OC_CAPABLE + (CUR_MAST)->(REC_LOCK(1)) + REPLACE (CUR_MAST)->SALES_TAX WITH STX_AMT + REPLACE (CUR_MAST)->TOTAL_AMT WITH TOT_AMT + (CUR_MAST)->(DBUNLOCK()) + ENDIF +ENDIF + +SETCOLOR(SAVECOLOR) + +RETURN .T. + +********************************************************* +* THIS FUNCTION VALIDATES THE PRINT IND VALUE +********************************************************* +FUNCTION PRTIND_VAL() +LOCAL SV_SEL := SELECT(), RETVAL +IF PRINT_IND$' ANDE' + RETVAL := .T. +ELSE + ERR_BOX('VALID Values are the following:', ; + '"A" - ALWAYS Print Option Value', ; + '"N" - NEVER Print the Option Value', ; + '"D" - PRINT Print if Option is DEFAULT ', ; + '"E" - PRINT Print if Option is NOT Default-EXCEPTION') + RETVAL := .F. +ENDIF +SELECT(SV_SEL) +RETURN RETVAL + +************************************************************** +FUNCTION NOSORT() // called by acdcargo for lineitems +ERR_BOX('*** SORT OPTION Not AVAILABLE ***', ; + '*** In This Process ***', ; + ' ') +RETURN .T. + +************************************************************** +* NOTES EDIT FOR THE LINE ITEM +************************************************************** +FUNCTION LINENOTE() // called by acdcargo for lineitems +LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') +LOCAL SAVESCRN := SAVESCREEN(), LI_NOTES := 3, SV_IND := PRT_NOTES +LOCAL MTITLE := 'Line Item ' + ALLTRIM(STR(USERFILE2->LINE_NUM)) ; + + ' (' + ALLTRIM(USERFILE2->PROD_CODE) + ')' +IF _OC_CAPABLE + NOTES('LINE_NOTES', NOTEREV_EDIT(), MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS + REMOVE_XLNOTE(ORDER_NUM, LINE_NUM) //** P3N - 2/8/99 + ****// 5-7-97 ************** + **** Ask where to PRINT the line item NOTE? + IF EMPTY(LINE_NOTES) + REPLACE PRT_NOTES WITH 'U' //Print notes under the line item - DEFAULT + ELSE + IF PRT_NOTES = 'A' + LI_NOTES := 1 + ELSEIF PRT_NOTES = 'B' + LI_NOTES := 2 + ELSE + LI_NOTES := 3 + ENDIF + + LI_NOTES := PICKLIST({'ABOVE Line Item', 'BESIDE Line Item', 'UNDER Line Item'}, 5, 31, 'PRINT Notes', LI_NOTES) + IF LI_NOTES = 1 + REPLACE PRT_NOTES WITH 'A' //Print notes above the line item + ELSEIF LI_NOTES = 2 + REPLACE PRT_NOTES WITH 'B' //Print notes beside the line item + ELSE // = 3 + REPLACE PRT_NOTES WITH 'U' //Print notes under the line item - DEFAULT + ENDIF + IF LASTKEY() == 27 + REPLACE PRT_NOTES WITH SV_IND // RETURN TO ORIGINAL VALUE IF ESCAPE + ENDIF + ENDIF +ELSE + NOTES('LINE_NOTES', NOTEREV_EDIT(),'Review '+MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS +ENDIF +RESTSCREEN(,,,,SAVESCRN) +RETURN .T. +************************************************************** +//** P3N - 2/08/99 * +//** REMOVE THE XL NOTE * +************************************************************** +FUNCTION REMOVE_XLNOTE(MORD_NUM, MLINE) +LOCAL SEEKKEY := MORD_NUM + STR(MLINE, 3) +LOCAL SVSEL := SELECT() +LOCAL SVORD, SVREC +LOCAL LINEFILE := 'ADDL_LINES' +IF CUR_MAST = 'QUOTE_MAST' + LINEFILE := 'QUOTE_ADDL' +ENDIF +SVREC := (LINEFILE)->(RECNO()) +SVORD := (LINEFILE)->(INDEXORD()) +SVREC := (LINEFILE)->(RECNO()) +SELECT(LINEFILE) +DONSETORD(3) //** ORDER_NUM + STR(LINE_NUM, 3) +IF (LINEFILE)->(DBSEEK(SEEKKEY)) + REC_LOCK(3, LINEFILE) + (LINEFILE)->LINE_NOTES := ' ' + (LINEFILE)->(DBUNLOCK()) +ENDIF +DONSETORD(SVORD) +(LINEFILE)->(DBGOTO(SVREC)) +SELECT(SVSEL) +RETURN .T. +************************************************************** +FUNCTION TAXNOTE() // called by acdcargo for lineitems +LOCAL ACTION_CODE := GETAVAR('ACTION_CODE') +LOCAL SAVESCRN := SAVESCREEN() +LOCAL MTITLE := 'Tax Table Notes ' + USERFILE2->STAXSCH +IF _OC_CAPABLE + NOTES('NOTES', NOTEREV_EDIT(), MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS +ELSE + NOTES('NOTES', NOTEREV_EDIT(),'Review '+MTITLE, 3, .F.,.F.) // NO AUDIT_PROC AND DON'T MESS WITH SETTING HOT KEYS +ENDIF +RESTSCREEN(,,,,SAVESCRN) +RETURN .T. + + +************************************************************** +FUNCTION GET_PRICEARR(MPRICE_ARR, MPRICE_TYPE, PPR_CUSTID) +// GET THE PRICE ARRAY FOR THIS MPRICE TYPE + +LOCAL ELEM, PR_CUSTID := PPR_CUSTID + +**ELEM = ASCAN(MPRICE_ARR, {|X| X[1] == MPRICE_TYPE .AND. X[6] == PR_CUSTID} ) +ELEM = ASCAN(MPRICE_ARR, {|X| X[1] == MPRICE_TYPE} ) +IF ELEM > 0 + RETURN MPRICE_ARR[ELEM,2] +ELSE + RETURN {} +ENDIF + + +************************************************************** +* VALIDATE THE DECIMAL VALUES AT ORDER ENTRY TIME +************************************************************** + +FUNCTION VALID_DECIMAL(VAL2CHEK) +LOCAL DECIMAL_VAL := VAL2CHEK - INT(VAL2CHEK) +LOCAL NCHOICE +LOCAL SV_COLOR := SETCOLOR(LNOR) +LOCAL NTOP := 03, NLEFT := 50, NBOTTOM := 20, NRIGHT := 65 +LOCAL DEC_ARR := {}, I, ELM, NEG_SW := .F. + +IF DECIMAL_VAL == 0 + RETURN .T. +ELSEIF DECIMAL_VAL < 0 + DECIMAL_VAL := DECIMAL_VAL * -1 + NEG_SW := .T. +ENDIF + +ELM := ASCAN( FRACTION_ARR , {|X| X[2] == DECIMAL_VAL } ) +IF ELM == 0 + ERR_BOX( ' *** INVALID DECIMAL ENTERED ', ; + ' *** Check the FRACTION VALUE ', ; + ' *** Must be a Multiple of 1/' + ALLTRIM(STR(MBASE_NUM,2) ) ) + RETURN .F. +ELSE + RETURN .T. +ENDIF + + +************************************************************** +FUNCTION CHK_ADDITIONAL(MPROD_CODE, MADDL_PROD, MOPTION, MRESPONSE) +// CHECK THE ADDITIONAL PRODUCT + +LOCAL ELEM, SAVESEL := SELECT() +LOCAL MSTD_OPTS := ' ', MSG1, RESULT, MSG2, MSG3 +LOCAL SAVESCR := SAVESCREEN(), SAVEREC +LOCAL SAVECOLOR := SETCOLOR() + + + +SELECT PRODUCT +SAVEREC = RECNO() + +SEEK MADDL_PROD +MDESC = DESC // PRODUCT DESCRIPTION +MSG1 = 'Additional Product, ' + MDESC +MSG2 = 'For Option, ' + TRIM(MOPTION) + ': ' + MRESPONSE +MSG3 = 'Do You Want to use Standard Options' + + +bTOP = 10 +bBOTM = 16 +bLEFT = 10 +bRIGHT = 70 +* +SETCOLOR(DARK) +@ bTOP+1,bLEFT+1 CLEAR TO bBOTM+1,bRIGHT+1 // DRAW SHADOW BOX +SETCOLOR(HREV) +@ bTOP,bLEFT CLEAR TO bBOTM,bRIGHT // DRAW BACKROUND COLOR +@ bTOP,bLEFT TO bBOTM,bRIGHT // DRAW DOUBLE LINE + +IF EMPTY(MSTD_OPTS) + MSTD_OPTS = 'Y' +ENDIF +@ BTOP+1, BLEFT+2 SAY MSG1 +@ BTOP+2, BLEFT+2 SAY MSG2 +@ BTOP+4, BLEFT+2 SAY MSG3 GET MSTD_OPTS PICTURE '!' VALID MSTD_OPTS$'YN' +READ() + +GOTO SAVEREC +SELECT(SAVESEL) +RESTSCREEN(,,,,SAVESCR) +SETCOLOR(SAVECOLOR) +RETURN MSTD_OPTS + + +************************************************************** +FUNCTION ADD_ADDITIONAL(MADDL_PROD, MSTD_OPTS, GET_ARR) +// CHECK THE ADDITIONAL PRODUCT IN ADDL_LINE FILE + +LOCAL ELEM, SAVESEL := SELECT(), MLINE_NUM := USERFILE2->LINE_NUM +LOCAL MPROD_CODE +LOCAL CLR_ELM := ASCAN(GET_ARR, { |X| X[1] = 'FR COLOR'}) //** P3N - 10/17/06 +LOCAL MCOLOR := GET_ARR[CLR_ELM,4] //** P3N - 10/17/06 +MPROD_CODE = USERFILE2->PROD_CODE + +SELECT PRODUCT +SAVEREC = RECNO() + +SEEK MADDL_PROD +SELECT USERFILE6 +LOCATE FOR PROD_CODE == MADDL_PROD .AND. LINE_NUM == MLINE_NUM +IF !FOUND() + ADD_ONEREC('USERFILE2', 'USERFILE6') +ENDIF + +// IF EXTRA WINDOWS (TWIN, TRIPLE, QUAD, ETC) +// INCREASE THE QUANTITY OF THE ADDITIONAL PRODUCT +// BY THE NUMBER OF ADDITIONAL WINDOWS +ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'XTRA WIND'}) +IF ELEM > 0 + REPLACE QUANTITY WITH USERFILE2->QUANTITY * ( VAL( GET_ARR[ELEM,4] ) + 1 ) +ENDIF + +REPLACE ORDER_NUM WITH &CUR_MAST->ORDER_NUM +REPLACE PROD_CODE WITH MADDL_PROD +REPLACE PAR_PROD WITH MPROD_CODE +REPLACE PAR_COLOR WITH DISPCOLOR(.F.) +IF PAR_COLOR = 'N/A' //** P3N - 10/17/06 + REPLACE PAR_COLOR WITH MCOLOR //** P3N - 10/17/06 +ENDIF //** P3N - 10/17/06 +REPLACE LINE_NUM WITH MLINE_NUM +REPLACE STD_OPTS WITH MSTD_OPTS +REPLACE ALT_SPRICE WITH 0 +REPLACE UPDATED WITH ' ' + +REPLACE LINE_NOTES WITH ' ' //** P3N - 2/8/99 + +RETURN NIL + + +******************************************************* +FUNCTION DO_ADDL_LINES +// GO DO AN ACD UPDATE FOR THE ADDITIONAL PRODUCTS AND OPTION + +LOCAL TITLE, SAVESEL := SELECT() +LOCAL MORDER_NUM := &CUR_MAST->ORDER_NUM + +SELECT USERFILE6 +IF LASTREC() > 0 + IF SELECT('USERFILE8') > 0 + SELECT USERFILE8 + USE + ENDIF + + SELECT USERFILE9 + COPY TO (USERFILE8) FOR GOOD_AO('USERFILE9') + + NET_USE('&USERFILE8', .T., 3, 'USERFILE8') + SELECT (CUR_XO) + DONSETORD(1) + NDX_EXP = INDEXKEY() + SELECT USERFILE8 + INDEX ON &NDX_EXP TO &USERFILE8 + IF __DBDRIVER = 'CDX' + TAGNAME := 'T1' + INDEX ON &NDX_EXP TAG &TAGNAME TO &USERFILE8 + ELSE + INDEX ON &NDX_EXP TO &USERFILE8 + ENDIF + + + + IF _OC_CAPABLE .AND. GETAVAR('ACTION_CODE') = 'ADD' + TITLE = 'Update Additional Line Items' + ACD_PAR_CHILD(1, TITLE, {NIL, CUR_XL, .F., 3, 'ADD NOAPPEND',,,,,,.F. }) // don't close dbfs + ELSE + TITLE = 'Review Additional Line Items' + ACD_PAR_CHILD(3, TITLE, {NIL, CUR_XL, .F., 3, 'REV',,,,,,.F. }) // don't close dbfs + ENDIF +ELSE + IF SELECT('USERFILE8') > 0 + SELECT USERFILE8 + ZAP + ENDIF +ENDIF + +SELECT(SAVESEL) + +RETURN NIL + + +******************************************************** +FUNCTION GOOD_AO(SELFILE) +LOCAL SEEKKEY := (SELFILE)->ORDER_NUM + (SELFILE)->PROD_CODE + STR( (SELFILE)->LINE_NUM,3) +//*IF ADDL_LINES->(DBSEEK(SEEKKEY)) +IF (CUR_XL)->(DBSEEK(SEEKKEY)) + RETURN .T. +ELSE + RETURN .F. +ENDIF +******************************************************** +FUNCTION GET_CM_VALU(FLD_NAM,FLD_VALU) +LOCAL SAVESEL := SELECT(), EVALVAL +IF EMPTY(&FLD_VALU) + SELECT CUST_MAST + &FLD_VALU := &FLD_NAM +ENDIF +SELECT (SAVESEL) +RETURN .T. + + +******************************************************** +FUNCTION CUST_CSZ(FLDLEN) +RETURN PADR(ALLTRIM(CUST_CITY) + ' ' + ALLTRIM(CUST_STATE) + ' ' + CUST_ZIP, FLDLEN) + +******************************************************** +FUNCTION SHIP_CSZ(FLDLEN) +RETURN PADR(ALLTRIM(SHIPADD2) + ' ' + ALLTRIM(SHIPST) + ' ' + SHIPZIP, FLDLEN) + + + +******************************************************** +FUNCTION ADDL_KEY() +RETURN {&CUR_MAST->ORDER_NUM} + + +******************************************************** +FUNCTION STUFF_ENTER_KEY() +KEYBOARD CHR(13) +RETURN + + +******************************************************** +FUNCTION CK_DELSIZE(MWIDTH) +IF MWIDTH >= 999 + DELETE + PACK + IF RECCOUNT() = 0 + ADD_REC(3) + ELSE + GOTO TOP + ENDIF +ENDIF +RETURN .T. +********************************************************** +* +********************************************************** +FUNCTION CGWBASEPRICE(WHICHFILE, NCHOICE) +LOCAL TABLE_ARR + +IF WHICHFILE = 'PRODUCT' + SELECT PRODUCT //* - ONLY CALL LOAD UP FOR THIS PRODUCT RECORD + TABLE_ARR := CGWPRICE(,,NCHOICE) + CGWBP_LOAD(TABLE_ARR) // READ TABLE_ARR AND CREATE USERFILE7 RECS. + RETURN +ELSE + SELECT PRODUCT + DONSETORD(3) + SEEK CATEGORY->CAT_CODE + DO WHILE PRODUCT->CAT_CODE == CATEGORY->CAT_CODE .AND. !EOF() + TABLE_ARR := CGWPRICE(,,NCHOICE) + CGWBP_LOAD(TABLE_ARR) // ASSUMES SITTING ON CORRECT PRODUCT RECORD + SELECT PRODUCT + SKIP 1 + ENDDO +ENDIF +RETURN +********************************************************** +* LOAD THE USER FILE WITH THE BASE PRICE INFORMATION FOR PRINT/DISPL +********************************************************** +FUNCTION CGWBP_LOAD(BP_ARR) // READ TABLE_ARR AND CREATE USERFILE7 RECS. +LOCAL REP_VAR, AMT, DESC, II, I +LOCAL FHEAD1, FHEAD2, FHEAD3 +LOCAL HEAD1 := ' ' , HEAD2 := ' ' , HEAD3 := ' ' + + //PRICE_DBF, DLR_DBF, PRICE_SHT +LOCAL PRT_ARR := BLDPRICE_ARR(BP_ARR[1], BP_ARR[2], BP_ARR[3]) +LOCAL FRZ_ARR := PRT_ARR[1] // FIXED COL - IE: ROW HEADINGS/COL HEADINGS +LOCAL DTL_ARR := PRT_ARR[2] // ROW DETAIL - COL HEADING/AMTS +LOCAL DTL_LINE, TOTL_PRT := 0 +LOCAL FRST_COL := 1 +LOCAL COL_LIMIT := 7-1 // 7 TO LEN(FRZ_ARR) TO CONTROL THE NUMBER OF VARIABLE COLS +LOCAL LAST_COL := COL_LIMIT + +DTL_LINE := ' ' + +DO WHILE .T. + FOR II := 1 TO LEN(FRZ_ARR) + DTL_LINE := FRZ_ARR[II] + SPACE(3) + + FOR I := FRST_COL TO MIN( LAST_COL, LEN(DTL_ARR) ) + IF II <= LEN(DTL_ARR[I]) + DTL_LINE := DTL_LINE + DTL_ARR[I, II] + SPACE(3) + ENDIF + NEXT + + ADD_U7(DTL_LINE) + NEXT + + ADD_U7(' ') + ADD_U7(' ') + IF PAGE_BREAK = 'Y' + ADD_U7(' ') // CATEGORY PAGE BREAK ???????????????????? + ENDIF + + FRST_COL := FRST_COL + COL_LIMIT + LAST_COL := LAST_COL + COL_LIMIT + IF FRST_COL > LEN(DTL_ARR) + EXIT + ENDIF + +ENDDO + + +RETURN +******************************************************** +******************************************************** +******************************************************** +FUNCTION BLDPRICE_ARR(PRICE_DBF, DLR_FILE, PRICE_SHEET) +LOCAL FLD_ARR := {}, HEAD1, FLD_TYPE +LOCAL VAL_ARR := {} +LOCAL WK_VAL +LOCAL PR_ARR := {}, COL_VAL +LOCAL LEFT_COL_ARR := {} +LOCAL SV_SEL := SELECT(), I +LOCAL FLD_NAME, PRICE_FACTOR, HEAD_TYP + +SELECT PRODUCT + // UI SIZE + +IF PRICE_SHEET == 'L' + PRICE_FACTOR := PRODUCT->LU_BASEFAC / 100 +ELSEIF PRICE_SHEET == 'J' + PRICE_FACTOR := PRODUCT->DI_BASEFAC / 100 +ELSEIF PRICE_SHEET == 'B' + PRICE_FACTOR := PRODUCT->BU_BASEFAC / 100 +ELSEIF PRICE_SHEET == 'S' + PRICE_FACTOR := PRODUCT->SD_BASEFAC / 100 +ELSEIF PRICE_SHEET == 'I' + PRICE_FACTOR := PRODUCT->IN_BASEFAC / 100 +ELSE + PRICE_FACTOR := 1 +ENDIF + +IF PRICE_FACTOR = 0 + PRICE_FACTOR := 1 +ENDIF + +IF SELECT('PRICE_DBF') > 0 + SELECT PRICE_DBF + USE +ENDIF + +IF PRICE_FACTOR > 0 .AND. PRICE_FACTOR < 1 + IF !FILE(DLR_FILE + '.DBF') + ERR_BOX('*** PRICE TABLE ' + DLR_FILE + '.DBF Was NOT FOUND!', ; + '*** It must be SETUP under the OPEN MODEL BASE PRICES TABLES') + RETURN { {} , {} } + ENDIF + NET_USE(DLR_FILE, .F., 5, 'PRICE_DBF') +ELSE + IF !FILE(PRICE_DBF + '.DBF') + ERR_BOX('*** PRICE TABLE ' + PRICE_DBF + '.DBF Was NOT FOUND!', ; + '*** It must be SETUP under the OPEN MODEL BASE PRICES TABLES') + RETURN { {} , {} } + ENDIF + NET_USE(PRICE_DBF, .F., 5, 'PRICE_DBF') +ENDIF + + // PRICE BREAK +HEAD1 := 'Model - ' + ALLTRIM(PRODUCT->PROD_CODE) + ' / ' + ALLTRIM(PRODUCT->DESC) +AADD(LEFT_COL_ARR, HEAD1) +AADD(LEFT_COL_ARR, ' ') +AADD(LEFT_COL_ARR, SPACE(15)) +AADD(LEFT_COL_ARR, SPACE(15)) +AADD(LEFT_COL_ARR, SPACE(15)) + +DO CASE + CASE !EMPTY(PRODUCT->COL_HEAD3) + LEFT_COL_ARR[5] := PRODUCT->COL_HEAD3 + LEFT_COL_ARR[4] := PRODUCT->COL_HEAD2 + LEFT_COL_ARR[3] := PRODUCT->COL_HEAD1 + CASE !EMPTY(PRODUCT->COL_HEAD2) + LEFT_COL_ARR[5] := PRODUCT->COL_HEAD2 + LEFT_COL_ARR[4] := PRODUCT->COL_HEAD1 + OTHERWISE + LEFT_COL_ARR[5] := PRODUCT->COL_HEAD1 +ENDCASE + +AADD(LEFT_COL_ARR, REPLICATE('-',15) ) + +FLD_ARR := DBSTRUCT() +FOR I := 1 TO LEN(FLD_ARR) + IF FLD_ARR[I,1] = 'COL_HEAD' .OR. FLD_ARR[I,1] = 'DESC' ; + .OR. FLD_ARR[I,1] = 'CUST_ID' .OR. FLD_ARR[I,1] = 'UPDATED' + LOOP + ELSE +*** COL_VAL := PADR( FLD_ARR[I,1] , 15 ) + COL_VAL := COLVAL( FLD_ARR[I,1] , 'TEXT', 15 ) + AADD( LEFT_COL_ARR, COL_VAL ) + ENDIF +NEXT + +DO WHILE !EOF() + WK_ARR := {} + AADD (WK_ARR, SPACE(15)) + AADD (WK_ARR, SPACE(15)) + AADD (WK_ARR, SPACE(15)) + AADD (WK_ARR, SPACE(15)) + AADD (WK_ARR, SPACE(15)) + + DO CASE + CASE !EMPTY(COL_HEAD3) + WK_ARR[5] := PADL(TRIM(COL_HEAD3),15) + WK_ARR[4] := PADL(TRIM(COL_HEAD2),15) + WK_ARR[3] := PADL(TRIM(COL_HEAD1),15) + CASE !EMPTY(COL_HEAD2) + WK_ARR[5] := PADL(TRIM(COL_HEAD2),15) + WK_ARR[4] := PADL(TRIM(COL_HEAD1),15) + OTHERWISE + WK_ARR[5] := PADL(TRIM(COL_HEAD1),15) + ENDCASE + AADD (WK_ARR, REPLICATE('-',15) ) + + FOR I := 1 TO LEN(FLD_ARR) + FLD_NAME := FLD_ARR[I,1] + FLD_TYPE := FLD_ARR[I,2] + IF FLD_NAME = 'DESC' .OR. FLD_NAME = 'COL_HEAD' ; // DESCRIPTION IN COL HEAD 1/2/3 + .OR. FLD_NAME = 'CUST_ID' .OR. FLD_NAME = 'UPDATED' + LOOP + ELSE + IF FLD_TYPE == 'N' + // ROUND TO NEAREST NICHOLS + AADD(WK_ARR, STR(ROUND_IT(&FLD_NAME * PRICE_FACTOR, .05) ,15,2)) + ENDIF + ENDIF + NEXT + AADD (PR_ARR, WK_ARR ) + SKIP 1 +ENDDO +SELECT PRICE_DBF +USE +SELECT(SV_SEL) +RETURN { LEFT_COL_ARR, PR_ARR } + +********************************************************** +FUNCTION COLVAL(WORKVAL, TYPE, LEN) +LOCAL I, CKCHAR + +IF TYPE = NIL + TYPE = 'TEXT' +ENDIF + +// system generated "V9" VARIABLE +IF LEFT(WORKVAL,1)$'V' .AND. SUBS(WORKVAL,2,1)$'0123456789' + RETURN FORM_WORKVAL(SUBS(WORKVAL,2 ), TYPE, LEN) +ELSE + RETURN FORM_WORKVAL(WORKVAL, TYPE, LEN) +ENDIF +********************************************************** +FUNCTION FORM_WORKVAL(WORKVAL, TYPE, LEN) +LOCAL WK_LEN +IF LEN = NIL + WK_LEN := 18 +ELSE + WK_LEN := LEN +ENDIF +WORKVAL := STRTRAN(WORKVAL, '_', ' ') + +IF TYPE = 'TEXT' + RETURN PADR(WORKVAL, WK_LEN) +ELSE + RETURN PADL(WORKVAL, WK_LEN) +ENDIF +**************************************************************** +* //** P3N - 12/10/98 +* DO WE PRINT LINE ITEM DISCOUNTS +**************************************************************** +FUNCTION PRT_ITMDISC(PRN_ARR, PRODCODE) +LOCAL RETVAL := .F., I, DISC_AMT := 0, DISC_PCT := 0 +LOCAL STRT := ASCAN( PRN_ARR, { |X| X[10] == PRODCODE } ) +FOR I := STRT TO LEN(PRN_ARR) + IF PRODCODE = PRN_ARR[I,10] + IF EMPTY(DISC_PCT) + DISC_PCT := PRN_ARR[I, 5, 1] // LINE ITEM DISCOUNT PCT + DISC_AMT := PRN_ARR[I, 5, 2] // LINE ITEM DISCOUNT AMT + ENDIF + IF DISC_PCT == PRN_ARR[I, 5, 1] // LINE ITEM DISCOUNT PCT + ELSE + RETVAL := .T. + ENDIF + ELSE + EXIT + ENDIF +NEXT +RETURN RETVAL +**************************************************************** +* P3N -11/24/98 +* GET THE ORDER MASTER (CGW0OM) MISC ITEMS (SCREEN 2115) +* ORDER QTYS FOR INVOICING PURPOSES +**************************************************************** +FUNCTION GETQTYMISC(MORDER_NUM, PARTIAL_INVOICE, REPRINT_INVOICE) +LOCAL MTOT := 0, QTY := 0, AMT := 0, MAMTS := {}, INVQTY := 0 +LOCAL SHPQTY := 0, BKO_QTY := 0, MISCKEY, SVPROD, SVLINE, MAMTS_ARR := {} +LOCAL SVREC := 1, QTYARR := {}, SVSEL := SELECT() + + + +IF SELECT('TORD_LINES') > 0 + SVREC := TORD_LINES->(RECNO()) + TORD_LINES->(DBGOTOP()) + IF MORDER_NUM == TORD_LINES->ORDER_NUM + ELSE + CLOSE TORD_LINES + BLD_TORD_LINES(MORDER_NUM) + ENDIF +ELSE + BLD_TORD_LINES(MORDER_NUM) +ENDIF + +TORD_LINES->(DBGOTOP()) +SVPROD := TORD_LINES->PROD_CODE +SVLINE := TORD_LINES->LINE_NUM +DO WHILE TORD_LINES->(!EOF()) + IF TORD_LINES->PROD_CODE = 'ORD' + IF TORD_LINES->LINE_NUM == SVLINE .AND. ; + TORD_LINES->PROD_CODE == SVPROD + ELSE + IF EMPTY(MAMTS) + ELSE + AADD(MAMTS_ARR, MAMTS ) + MAMTS := {} + ENDIF + SVPROD := TORD_LINES->PROD_CODE + SVLINE := TORD_LINES->LINE_NUM + ENDIF + MISCKEY := TORD_LINES->ORDER_NUM + MISCKEY := MISCKEY + STR(TORD_LINES->LINE_NUM, 3) + MISCKEY := MISCKEY + TORD_LINES->PROD_CODE + QTYARR := GET_OSTQTY('TORD_LINES', MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE ) + IF EMPTY(QTYARR) //** P3N - 12/3/98 + SHPQTY := 0 //** P3N - 12/3/98 + INVQTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + SHPQTY := QTYARR[1] //** P3N - 12/3/98 + INVQTY := QTYARR[2] //** P3N - 12/3/98 + ENDIF //** P3N - 12/3/98 + BKO_QTY := TORD_LINES->QUANTITY - SHPQTY + MTOT := MTOT + ( TORD_LINES->QUANTITY * TORD_LINES->SALE_PRICE ) + MAMTS := { TORD_LINES->QUANTITY, BKO_QTY, SHPQTY, TORD_LINES->SALE_PRICE, ; + TORD_LINES->PROD_CODE+STR(TORD_LINES->LINE_NUM,1), INVQTY } + ENDIF + TORD_LINES->(DBSKIP(+1)) +ENDDO +IF EMPTY(MAMTS) +ELSE + AADD(MAMTS_ARR, MAMTS ) +ENDIF +TORD_LINES->(DBGOTO(SVREC)) +SELECT(SVSEL) +RETURN { MAMTS_ARR } +**************************************************************** +* P3N - 7/29/98 +* BLD THE ORDER MASTER (CGW0OM) MISC ITEMS (SCREEN 2115) +* FOR BACK ORDER PRINTING PURPOSES +**************************************************************** + +FUNCTION BLD_ORDMISC( PBODY_ARR, PAMTS_ARR, LI_TOTALS, PRT_AMT, PRT_BO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE ) + +LOCAL MTOT := 0, QTY := 0, AMT := 0, PAMTS := {}, INVQTY := 0, QTYARR := {} +LOCAL SHPQTY := 0 , BKO_QTY := 0, MISCKEY, SVPROD, ORD_QTY := 0 +LOCAL SVREC := TORD_LINES->(RECNO()) + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + + +IF EMPTY(PARTIAL_INVOICE) + PARTIAL_INVOICE := .F. +ENDIF + +IF REPRINT_INVOICE = NIL +//IF EMPTY( REPRINT_INVOICE ) + REPRINT_INVOICE := .F. +ELSE + +ENDIF + +TORD_LINES->(DBGOTOP()) +SVPROD := TORD_LINES->PROD_CODE +DO WHILE TORD_LINES->(!EOF()) + IF TORD_LINES->PROD_CODE = 'ORD' + IF TORD_LINES->PROD_CODE == SVPROD + ELSE + // double space ORDER misc items for now. + IF EMPTY(PBODY_ARR) //** P3N 1/6/99 + ELSE + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL ) // nil pamts_arr will line up in body + ENDIF + SVPROD := TORD_LINES->PROD_CODE + ENDIF + MISCKEY := TORD_LINES->ORDER_NUM + MISCKEY := MISCKEY + STR(TORD_LINES->LINE_NUM, 3) + MISCKEY := MISCKEY + TORD_LINES->PROD_CODE + QTYARR := GET_OSTQTY('TORD_LINES', MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE) + IF EMPTY(QTYARR) //** P3N - 12/3/98 + SHPQTY := 0 //** P3N - 12/3/98 + INVQTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + SHPQTY := QTYARR[1] //** P3N - 12/3/98 + INVQTY := QTYARR[2] //** P3N - 12/3/98 + ENDIF //** P3N - 12/3/98 + BKO_QTY := TORD_LINES->QUANTITY - SHPQTY + ORD_QTY := TORD_LINES->QUANTITY + MTOT := MTOT + ( TORD_LINES->QUANTITY * TORD_LINES->SALE_PRICE ) + IF WHCHORDER == 'BACKORD' + PAMTS := { 0, 0 , BKO_QTY, TORD_LINES->SALE_PRICE, PRT_AMT, PRT_BO, 0, , INVQTY } + ELSE + PAMTS := { ORD_QTY, BKO_QTY , SHPQTY , TORD_LINES->SALE_PRICE, PRT_AMT, PRT_BO, 0, , INVQTY } + ENDIF + IF EMPTY(BKO_QTY) + ELSE + AADD(PBODY_ARR, '^' + SUBS(TORD_LINES->LINE_DESC, 1, 30) ) + AADD(PAMTS_ARR, PAMTS ) + ENDIF + ENDIF + TORD_LINES->(DBSKIP(+1)) +ENDDO +LI_TOTALS := LI_TOTALS + MTOT +TORD_LINES->(DBGOTO(SVREC)) + +RETURN { PBODY_ARR, PAMTS_ARR, LI_TOTALS } + +**************************************************************** +* P3N - 7/7/98 +* BLD THE MISC ORDER LINE ITEMS FOR PRINTING PURPOSES +**************************************************************** +FUNCTION BLD_MISCORD(CUR_MISC, PBODY_ARR, PAMTS_ARR, LI_TOTALS, PRT_AMT, ; + DIDFST, PRT_BO, WHCHORDER, PARTIAL_INVOICE, REPRINT_INVOICE, ORDSHIPD, SUBTYPE) +LOCAL M1 := 0, M_UOM := '', M_QTY_UOM := '', WORKVAR := '', WORKPRICE := 0 +LOCAL MISCITMS := CUR_MISC, WRKQTY := 0, QTYARR := {}, PAMTS, WRK1, TOTBKO := 0 +LOCAL BKO_QTY := 0, MISCKEY, SHPQTY := 0, INVQTY := 0, SVSEL := SELECT() + +IF EMPTY(ORDSHIPD) //** P3N - 1/7/99 + ORDSHIPD := .F. +ENDIF + + +//DEFAULT PARTIAL_INVOICE := .F. +//DEFAULT REPRINT_INVOICE := .F. + + +If( PARTIAL_INVOICE == nil, PARTIAL_INVOICE := .F., ) +If( REPRINT_INVOICE == nil, REPRINT_INVOICE := .F., ) + +IF REPRINT_INVOICE = NIL // 1/20/20 + //IF EMPTY(REPRINT_INVOICE) //** P3N - 12/3/98 + REPRINT_INVOICE := .F. +ENDIF +IF EMPTY(PARTIAL_INVOICE) //** P3N - 11/24/98 + PARTIAL_INVOICE := .F. +ENDIF +IF MISCITMS == 'TORD_LINES' + IF SELECT('TORD_LINES') > 0 + //** TORD_LINES ALREADY EXISTS + IF (MISCITMS)->ORDER_NUM == (CUR_MAST)->ORDER_NUM + //** TORD_LINES ALREADY EXISTS WITH THE SAME ORDER - PROCESS + ELSE + CLOSE TORD_LINES + BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) + ENDIF + ELSE + BLD_TORD_LINES((CUR_MAST)->ORDER_NUM) + ENDIF + (MISCITMS)->(DBGOTOP()) +ELSE + (MISCITMS)->(DBSEEK((CUR_MAST)->ORDER_NUM)) +ENDIF +DO WHILE (MISCITMS)->ORDER_NUM == (CUR_MAST)->ORDER_NUM .AND. (MISCITMS)->(!EOF()) +//** IF WHCHORDER == 'BACKORD' //** P3N - 1/14/99 + IF WHCHORDER == 'BACKORD' .OR. ORDSHIPD //** P3N - 1/14/99 + IF (MISCITMS)->PROD_CODE == 'MISCITM' + //** PROCESS ONLY MISC ITEMS + ELSE + (MISCITMS)->(DBSKIP(+1)) + LOOP + ENDIF + ENDIF + MISCKEY := (MISCITMS)->ORDER_NUM + IF VALTYPE((MISCITMS)->LINE_NUM)== 'N' + MISCKEY := MISCKEY + STR((MISCITMS)->LINE_NUM, 3) + ELSE + MISCKEY := MISCKEY + (MISCITMS)->LINE_NUM + ENDIF + MISCKEY := MISCKEY + 'MISCITM' + QTYARR := GET_OSTQTY(CUR_OL, MISCKEY, PARTIAL_INVOICE, REPRINT_INVOICE ) + IF EMPTY(QTYARR) //** P3N - 12/3/98 + SHPQTY := 0 //** P3N - 12/3/98 + INVQTY := 0 //** P3N - 12/3/98 + ELSE //** P3N - 12/3/98 + SHPQTY := QTYARR[1] //** P3N - 12/3/98 + INVQTY := QTYARR[2] //** P3N - 12/3/98 + ENDIF //** P3N - 12/3/98 + BKO_QTY := (MISCITMS)->QUANTITY - SHPQTY + TOTBKO := TOTBKO + BKO_QTY //** P3N - 1/14/99 + IF WHCHORDER == 'BACKORD' .AND. EMPTY(BKO_QTY) + (MISCITMS)->(DBSKIP(+1)) //** DO NOT INCLUDE 0 QTY'S ON BACKORDERS + LOOP + ENDIF + MISC_ITEMS->(DBSEEK ( (MISCITMS)->PARTNUM )) + IF (MISCITMS)->UOM = 'N/A' + M_UOM := '' + ELSE + UOMFILE->(DBSEEK ( (MISCITMS)->UOM )) + IF UOMFILE->PRINT_FLAG$'N' + M_UOM := '' + ELSE + M_UOM := (MISCITMS)->UOM + ENDIF + M_QTY_UOM := UOMFILE->PRINT_QTY + ENDIF + WORKVAR := '^' //** P3N - 12/16/98 + IF (MISCITMS)->COLOR <> 'N/A' + WORKVAR := WORKVAR + ALLTRIM( (MISCITMS)->COLOR ) + ' ' + ENDIF + WORKVAR:= WORKVAR + ALLTRIM( MISC_ITEMS->DESC ) + ' ' + //** P3N - 1/7/99 IS THIS CHECKING FOR ORDER ENTIRELY SHIPPED ?? + IF ORDSHIPD .AND. EMPTY(SHPQTY) + //** DO NOT ADD PRICES BECAUSE WE ARE ONLY BUILDING THIS ARRAY + //** TO DETERMINE IF THE ENTIRE ORDER HAS BEEN SHIPPED!!! + //** NOT TO PRINT ON ANY DOCUMENT + ELSE + //** P3N - 2/20/98 PER ELLEN-KC + IF EMPTY( (MISCITMS)->ALT_SPRICE) + WORKPRICE := (MISCITMS)->SALE_PRICE + ELSE + WORKPRICE := (MISCITMS)->ALT_SPRICE + ENDIF + ENDIF + IF M_QTY_UOM $'N' + WRK1 := { (MISCITMS)->QUANTITY, (MISCITMS)->ENTRY_SIZE } + IF WHCHORDER == 'BACKORD' + WRK1 := { 0 , (MISCITMS)->ENTRY_SIZE } + PAMTS := {WRK1, 0 ,BKO_QTY, WORKPRICE, PRT_AMT,PRT_BO ,0, M_UOM, INVQTY } + ELSE + PAMTS := { WRK1 ,BKO_QTY, SHPQTY, WORKPRICE, PRT_AMT,PRT_BO ,0, M_UOM, INVQTY } + ENDIF + ELSEIF WHCHORDER == 'BACKORD' + PAMTS := { 0, 0, BKO_QTY, WORKPRICE , PRT_AMT, PRT_BO, 0, M_UOM , INVQTY } + ELSE + PAMTS := { (MISCITMS)->QUANTITY, BKO_QTY,SHPQTY, WORKPRICE, PRT_AMT, PRT_BO, 0, M_UOM , INVQTY } + ENDIF + IF PARTIAL_INVOICE //** P3N - 11/25/98 + LI_TOTALS := LI_TOTALS + ( SHPQTY * WORKPRICE ) + ELSEIF REPRINT_INVOICE //** P3N - 12/4/98 + LI_TOTALS := LI_TOTALS + ( INVQTY * WORKPRICE ) + ELSE //** P3N - 11/25/98 + LI_TOTALS := LI_TOTALS + ( (MISCITMS)->QUANTITY * WORKPRICE ) + ENDIF //** P3N - 11/25/98 + // start order below last detail printed + IF !DIDFST + IF !EMPTY(PBODY_ARR) // SEPERATE FROM DATA ABOVE + IF WHCHORDER == 'BACKORD' + AADD(PBODY_ARR, ' -----' ) + ELSE + AADD(PBODY_ARR, '-------------' ) + ENDIF + AADD(PAMTS_ARR, {}) // empty array will left justify + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL ) // nil pamts_arr will line up in body + ENDIF + DIDFST := .T. + ENDIF + AADD(PBODY_ARR, WORKVAR ) + AADD(PAMTS_ARR, PAMTS ) + IF !EMPTY( (MISCITMS)->ENTRY_SIZE ) + IF M_QTY_UOM $'N' + // Print size IN THE QTY AREA + ELSE + // Print size below desc + AADD(PBODY_ARR, 'Size: ' + ALLTRIM((MISCITMS)->ENTRY_SIZE ) + ' ' + ALLTRIM( M_UOM ) ) + AADD(PAMTS_ARR, NIL ) + ENDIF + ENDIF + //** P3N - 04/30/03 - MOVED FROM ABOVE - WAS ONLY PRINTING IF !EMPTY(ENTRY_SIZE) PER LINDA LINDS + //** P3N - 11/18/02 - ADDED THE KEYWORD FOR PRINTING - PER LINDA LINDS + IF EMPTY(SUBTYPE) //** P3N - 11/18/02 + //** DO NOT PRINT KEYWORDS ON EMPTY SUBTYPES + ELSEIF SUBTYPE = 'DELIVERY' .OR. ; //** DELIVERY COPY + SUBTYPE = 'GOLDEN' .OR. ; //** GOLDEN ROD COPY + SUBTYPE = 'PREBILL' //** PREBILL COPY + AADD(PBODY_ARR, MISC_ITEMS->KEYWORD ) //** P3N - 11/18/02 + AADD(PAMTS_ARR, NIL ) //** P3N - 11/18/02 + ENDIF //** P3N - 11/18/02 + // double space the cur_misc items for now. + AADD(PBODY_ARR, ' ' ) + AADD(PAMTS_ARR, NIL ) // nil pamts_arr will line up in body + (MISCITMS)->(DBSKIP(+1)) +ENDDO +RETURN { PBODY_ARR, PAMTS_ARR, LI_TOTALS, TOTBKO } +**************************************************************** +* DO WE WANT TO PRINT A PRODUCTION FRAME COPY OR +* A PRODUCTION STD FRAME COPY ? +* 'STD' - STORM DOOR +**************************************************************** +FUNCTION PRT_FRAME(WHICH_TYPE, PROD) +LOCAL RETVAL := .F. +DO CASE + CASE WHICH_TYPE = 'FRAME' + IF PROD_STD(PROD) + RETVAL := .F. + ELSE + RETVAL := .T. + ENDIF + CASE WHICH_TYPE = 'STDFRAME' + IF PROD_STD(PROD) + // STORM DOOR FRAME COPY + RETVAL := .T. + ENDIF +ENDCASE +RETURN RETVAL +**************************************************************** +* IS THIS PRODUCT A 'STD' +* 'STD' - STORM DOOR +**************************************************************** +FUNCTION PROD_STD(PROD) +LOCAL RETVAL := .F. +IF PRODUCT->(DBSEEK(PROD)) + IF PRODUCT->CAT_CODE = 'STD' + RETVAL := .T. + ENDIF +ENDIF +RETURN RETVAL +**************************************************************** +* SHOULD WE PRINT A DISCOUNT TOTAL +**************************************************************** +FUNCTION PRINT_DISC(PRN_ARR, PRODCODE) //PRINT A DISCOUNT% +LOCAL STRT := ASCAN(PRN_ARR, {|X| X[10] == PRODCODE}), I, RETVAL := .F. +IF EMPTY(STRT) + RETVAL := .F. +ELSE + FOR I := STRT TO LEN(PRN_ARR) + IF PRN_ARR[I,10] == PRODCODE + IF EMPTY(PRN_ARR[I,5,1]) + RETVAL := .F. + ELSE + RETVAL := .T. + EXIT + ENDIF + ENDIF + NEXT +ENDIF +RETURN RETVAL +**************************************************************** +* GET THE PRODUCT DISCOUNT TOTAL ( IE: ALL LINE ITEMS FOR A PRODUCT) +**************************************************************** +FUNCTION GETDISCTOT(PRN_ARR, STRT) +LOCAL PRODCODE := PRN_ARR[STRT, 10], ELM, DISC_PCT, I, RETARR := {} +//**LOCAL DISC_AMT := 0,ITMDISC := PRT_ITMDISC(PRN_ARR, PRODCODE) +LOCAL DISC_AMT := 0,ITMDISC := .F. +FOR I := STRT TO 1 STEP -1 + IF PRODCODE = PRN_ARR[I,10] + DISC_AMT := PRN_ARR[I, 5, 2] // LINE ITEM DISCOUNT AMT + DISC_PCT := PRN_ARR[I, 5, 1] // LINE ITEM DISCOUNT PCT + DISC_SIZE := PRN_ARR[I, 5, 3] // LINE ITEM ENTRY SIZE + IF EMPTY(DISC_AMT) + ELSE + IF EMPTY(RETARR) + AADD(RETARR, {PRODCODE, DISC_PCT, DISC_AMT, DISC_SIZE}) + ELSE + ELM := ASCAN(RETARR, {|X| X[1] == PRODCODE .AND. X[2] == DISC_PCT}) + IF EMPTY(ELM) + AADD(RETARR, {PRODCODE, DISC_PCT, DISC_AMT, DISC_SIZE}) + ELSEIF ITMDISC + AADD(RETARR, {PRODCODE, DISC_PCT, DISC_AMT, DISC_SIZE}) + ELSE + RETARR[ELM,3] := RETARR[ELM,3] + DISC_AMT + ENDIF + ENDIF + ENDIF + ENDIF +NEXT +RETURN RETARR +***************************************************************** +//** P3N - 3/5/99 - NEW FUNCTION TO IDENTIFY ZERO ORDERS +//** IN ONE PLACE. ( NO PRICING ) +//** P3N- 3/5/99 ADDED '93' TO THE NO PRICING TERMS LIST. +***************************************************************** +FUNCTION ZERO_ORDER() +LOCAL RETVAL := .F. +IF (CUR_MAST)->TERMS = '90' .OR. ; //** NO CHARGE //**P3N - 6/16/98 + (CUR_MAST)->TERMS = '91' .OR. ; //** EVEN EXCHANGE//**P3N - 3/10/99 + (CUR_MAST)->TERMS = '93' .OR. ; //** MEMO BILLING //**P3N - 3/05/99 + (CUR_MAST)->TERMS = '96' //** CANCELLATION //**P3N - 6/16/98 + RETVAL := .T. +ENDIF +RETURN RETVAL +***************************************************************** +//** P3N - 2/1/00 - NEW FUNCTION TO PAINT THE KEY VALUES AS NEEDED +//** IN A PREPROC SITUATION +***************************************************************** +FUNCTION PAINT_KEYS(KEYFLD,DISPROW, DISPCOL) +LOCAL SVCOLOR := SETCOLOR(HNOR) +MGET_KEY := &KEYFLD +IF EMPTY(DISPROW) + DISPROW := 3 +ENDIF +IF EMPTY(DISPCOL) + DISPCOL := 40 +ENDIF +@ DISPROW, 0 CLEAR +@ DISPROW, DISPCOL SAY MGET_KEY +SETCOLOR(SVCOLOR) +RETURN .T. +********************************************************* +// VALIDATE A PRODUCT CODE + +FUNCTION VAL_PRODUCT(PASSKEY, ELEM, DISPNAME, DOPACK) +LOCAL SAVESCR := SAVESCREEN() +LOCAL SAVESEL := SELECT() +LOCAL SAVEREC := RECNO() +LOCAL RETVAL := .F., A_ELEM +LOCAL SAVECOL := SETCOLOR() +LOCAL SAYMSG := "PRODUCT->DESC" + +LOCAL SAVEGETLIST := SAVEGETS() +LOCAL SEEKKEY + +IF PASSKEY = NIL + SEEKKEY := PROD_CODE + ELEM := NIL + DISPNAME := .F. +ELSE + SEEKKEY := &PASSKEY +ENDIF + +IF DISPNAME = NIL + DISPNAME := .T. +ENDIF + +IF DOPACK = NIL + DOPACK := .T. +ENDIF + +SETCOLOR(SAVECOL) +IF EMPTY(SEEKKEY) .AND. DOPACK + DELETE + PACK + RETURN .T. +ENDIF + +IF EMPTY(SEEKKEY) .OR. GOOD_PROD(SEEKKEY) + IF DISPNAME + A_ELEM := DISP_GETVAR(ELEM, SAYMSG) + ENDIF + RETURN .T. +ENDIF + +GBROWSE(3,'Product Lookup', 'PRODUCT') +SELECT (SAVESEL) +GOTO SAVEREC +SETCOLOR(SAVECOL) +RESTSCREEN(,,,,SAVESCR) +IF LASTKEY() = 13 + DO CASE + CASE ELEM = NIL // DBROWSE TYPE PROC +***** REPLACE USERFILE2->CLUBID WITH CLUB_MAST->CLUBID + REPLACE (SAVESEL)->PROD_CODE WITH PRODUCT->PROD_CODE + REPLACE UPDATED WITH 'Y' + + CASE VALTYPE(ELEM)$'A' // EXECUTE SOMETHING + NILVAR := &ELEM[1] + + CASE DISPNAME // GET_ONE_REC TYPE PROC + A_ELEM := DISP_GETVAR(ELEM, SAYMSG) + GETVARS[A_ELEM,4] := CLUB_MAST->CLUBID + ENDCASE + RETVAL := .T. +ELSE + RETVAL := .F. +ENDIF + +SETCOLOR(SAVECOL) +RETURN RETVAL + + + +**************************************************************** +* VALIDATE THE INPUT FIELD TO CONTAIN A VALID SET OF CHARACTARS* +**************************************************************** +FUNCTION VALID_CHR(PARM) +LOCAL I, RETVAL, FLD := &PARM +FOR I := 1 TO LEN(FLD) + IF SUBS(FLD,I,1)$'ABCDEFGHIJKLMNOPQRSTUVWXYZ 1234567890_' + RETVAL := .T. + ELSE + ERR_BOX('** Invalid Option Value **', ; + '** Remove the - ' + ALLTRIM(SUBS(FLD,I,1)) ) + RETVAL := .F. + EXIT + ENDIF +NEXT +RETURN RETVAL + + +**************************************************************** +FUNCTION GOOD_PROD(SEEKKEY) +LOCAL SAVESEL := SELECT(), RECNUM := RECNO(), RETVAL +IF PRODUCT->(DBSEEK(SEEKKEY)) + RETVAL := .T. +ELSE + RETVAL := .F. +ENDIF +SELECT (SAVESEL) +GOTO RECNUM +RETURN RETVAL + +******************************************************************* +//** P3N - 1/15/99 +//** THIS FUNCTION WILL BUILD USERFILE2 WITH ORD_SHIP TRANS. +//** THIS IS A PREPROC 'I' FOR SCREEN 21350 - SELECTIVE SHIPPING +//** (F7-ORDER CONTROL / SHIPPING INFORMATION - SCREEN 3220) +******************************************************************* +FUNCTION BLD_TMP_OST() +LOCAL ORDNUM := TORD_LINES->ORDER_NUM +LOCAL LINENUM := TORD_LINES->LINE_NUM +LOCAL PROD := TORD_LINES->PROD_CODE +LOCAL PARPROD := TORD_LINES->PAR_PROD +LOCAL TRANNUM := TORD_LINES->(STR(RECNO(), 3) ) +LOCAL SVSEL := SELECT() +SELECT USERFILE2 +ZAP +IF ORD_SHIP->(DBSEEK(ORDNUM+STR(LINENUM,3)+ PROD +PARPROD+TRANNUM)) + DO WHILE ORD_SHIP->(!EOF()) .AND. ; + ORD_SHIP->ORDER_NUM == ORDNUM .AND. ; + ORD_SHIP->LINE_NUM == LINENUM .AND. ; + ORD_SHIP->PROD_CODE == PROD .AND. ; + ORD_SHIP->PAR_PROD == PARPROD .AND. ; + ORD_SHIP->TRAN_NUM == TRANNUM + SELECT USERFILE2 + ADD_REC(1) + REC_LOCK(1, 'USERFILE2') + REP_ONEREC('ORD_SHIP', 'USERFILE2' ) + ORD_SHIP->(DBSKIP(+1)) + ENDDO +ENDIF +SELECT(SVSEL) +RETURN .T. + +******************************************************************* +//** P3N - 1/15/02 +//** THIS FUNCTION WILL BUILD USERFILE2 WITH ORD_PROD TRANS. +//** THIS IS A PREPROC 'I' FOR SCREEN 22350 - SELECTIVE PRODUCTION +//** (F7-PRODUCTION CONTROL / PRODUCTION INFORMATION - SCREEN ????) +******************************************************************* +FUNCTION BLD_TMPOPT() +LOCAL ORDNUM := TORD_LINES->ORDER_NUM +LOCAL LINENUM := TORD_LINES->LINE_NUM +LOCAL PROD := TORD_LINES->PROD_CODE +LOCAL PARPROD := TORD_LINES->PAR_PROD +LOCAL TRANNUM := TORD_LINES->(STR(RECNO(), 3) ) +LOCAL SVSEL := SELECT() +SELECT USERFILE2 +//**ZAP +USERFILE2->(__DBZAP()) +IF ORD_PROD->(DBSEEK(ORDNUM+STR(LINENUM,3)+ PROD +PARPROD+TRANNUM)) + DO WHILE ORD_PROD->(!EOF()) .AND. ; + ORD_PROD->ORDER_NUM == ORDNUM .AND. ; + ORD_PROD->LINE_NUM == LINENUM .AND. ; + ORD_PROD->PROD_CODE == PROD .AND. ; + ORD_PROD->PAR_PROD == PARPROD .AND. ; + ORD_PROD->TRAN_NUM == TRANNUM + SELECT USERFILE2 + ADD_REC(1) + REC_LOCK(1, 'USERFILE2') + REP_ONEREC('ORD_PROD', 'USERFILE2' ) + ORD_PROD->(DBSKIP(+1)) + ENDDO +ENDIF +SELECT(SVSEL) +RETURN .T. +//******************************************************************* +//** P3N - 08/08/11 +//** Allow ONLY the AMOUNT OR PCT for Freight calc +//******************************************************************* +FUNCTION VAL_FRT(FLD) +LOCAL G_ACT_LIST := GETACTIVE() +LOCAL RETVAL := .T. +STATIC SVAMT, SVPCT +IF EMPTY(FLD) + FLD := '' +ENDIF +IF FLD = 'FRT_AMT' + IF EMPTY(G_ACT_LIST) + //** NO GET OBJ - CONTINUE + ELSE + SVAMT := G_ACT_LIST:BUFFER + ENDIF +ELSE + IF EMPTY(G_ACT_LIST) + //** NO GET OBJ - CONTINUE + ELSE + SVPCT := G_ACT_LIST:BUFFER + + IF VAL(SVAMT) <> 0 .AND. VAL(SVPCT) <> 0 + ERR_BOX( ' Freight Amount = '+ SVAMT , ; + ' Freight PCT = ' + SVPCT , ; + ' ', ; + ' Please - enter ONLY Amount OR PCT - NOT BOTH!') + RETVAL := .F. + ENDIF + ENDIF +ENDIF +RETURN RETVAL + \ No newline at end of file diff --git a/CGWPRPO0.PRG b/CGWPRPO0.PRG new file mode 100644 index 0000000..71ef2d1 --- /dev/null +++ b/CGWPRPO0.PRG @@ -0,0 +1,8964 @@ +// 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 + \ No newline at end of file diff --git a/CGWRULE.PRG b/CGWRULE.PRG new file mode 100644 index 0000000..b8f9cf2 --- /dev/null +++ b/CGWRULE.PRG @@ -0,0 +1,1137 @@ +** CGWRULE - ADD/CHG/DEL ATTRIBUTE RULES +** DON LOWENSTEIN 10-25-93 +* * * * * * * * * * * * * * * + + +#INCLUDE 'INKEY.CH' + +*************************************************************** + +FUNCTION REP_RECNO() +REPLACE LINE_NUM WITH RECNO() +RETURN .T. + +*************************************************************** + +FUNCTION RULE_DISPLINE +LOCAL RETVAL, CURREC +CURREC := STR(RECNO(),4 ) +RETVAL := SUBS( 'L' + ALLTRIM(CURREC) + SPACE(10) , 1, 6) +RETURN RETVAL + +********************************************************* +FUNCTION CK_OPERRULE +LOCAL GOODOPER := .F. +DO CASE + CASE OPERATOR = '==' + RETURN .T. + CASE OPERATOR = 'LT' + RETURN .T. + CASE OPERATOR = 'GT' + RETURN .T. + CASE OPERATOR = 'EQ' + RETURN .T. + CASE OPERATOR = 'LE' + RETURN .T. + CASE OPERATOR = 'GE' + RETURN .T. + CASE OPERATOR = 'NE' + RETURN .T. + CASE ALLTRIM(OPERATOR) == '<' + REPLACE OPERATOR WITH '< ' + RETURN .T. + CASE ALLTRIM(OPERATOR) == '>' + REPLACE OPERATOR WITH '> ' + RETURN .T. + CASE ALLTRIM(OPERATOR) == '=' + REPLACE OPERATOR WITH '= ' + RETURN .T. + CASE OPERATOR == '<=' + RETURN .T. + CASE OPERATOR == '>=' + RETURN .T. + CASE OPERATOR == '<>' + RETURN .T. + OTHERWISE + ERR_BOX( ' *** INVALID FIELD OPERATOR ***' ,; + ' "LT" or "<" is LESS THAN ³ "GT" or ">" is MORE THAN ',; + ' "LE" or "<=" is LESS THAN or = ³ "GE" or ">=" is GR. or = ',; + ' "EQ" or "=" is EQUAL ³ "NE" or "<>" is NOT EQUAL') + + RETURN .F. +ENDCASE +****************************************************************** + +FUNCTION CK_COMMRULE() +IF !LCOMMAND$'ID ' + ERR_BOX( 'VALID COMMANDS ARE: I = Insert',; + ' D = Delete') + RETURN .F. +ENDIF + +IF LCOMMAND=' ' + RETURN .T. +ENDIF + +IF LCOMMAND = 'D' + IF RECNO() = 1 + GOTOREC := RECNO() - 1 + ELSE + GOTOREC := 1 + ENDIF + DELETE + PACK + GOTO GOTOREC + RETURN .T. +ENDIF + +IF LCOMMAND = 'I' + GOTOREC := RECNO() + APPEND BLANK + GOTO BOTTOM + DO WHILE RECNO() <> GOTOREC + SKIP -1 + PLINE_NUM := LINE_NUM + PLOGIC_GR := LOGIC_GR + P_FIELD1 := FIELD1 + P_FIELD1TYPE := FIELD1TYPE + P_FIELD2TYPE := FIELD2TYPE + P_ALIAS1 := ALIAS1 + P_OPERATOR := OPERATOR + P_FIELD2 := FIELD2 + P_ALIAS2 := ALIAS2 + PCONT_COND := CONT_COND + SKIP 1 + REPLACE RULE_CODE WITH RULES->RULE_CODE + REPLACE LOGIC_GR WITH PLOGIC_GR + REPLACE FIELD1 WITH P_FIELD1 + REPLACE FIELD1TYPE WITH P_FIELD1TYPE + REPLACE ALIAS1 WITH P_ALIAS1 + REPLACE FIELD2 WITH P_FIELD2 + REPLACE FIELD2TYPE WITH P_FIELD2TYPE + REPLACE ALIAS2 WITH P_ALIAS2 + REPLACE OPERATOR WITH P_OPERATOR + REPLACE CONT_COND WITH PCONT_COND + REPLACE LINE_NUM WITH RECNO() + SKIP -1 + ENDDO + REPLACE RULE_CODE WITH RULES->RULE_CODE + REPLACE LOGIC_GR WITH ' ' + REPLACE FIELD1 WITH SPACE(10) + REPLACE FIELD1TYPE WITH SPACE(1) + REPLACE FIELD2 WITH SPACE(10) + REPLACE FIELD2TYPE WITH SPACE(1) + REPLACE ALIAS1 WITH ' ' + REPLACE ALIAS2 WITH ' ' + REPLACE OPERATOR WITH ' ' + REPLACE CONT_COND WITH ' ' + REPLACE LINE_NUM WITH RECNO() + REPLACE LCOMMAND WITH ' ' + RETURN .T. +ENDIF + +*********************************************************** +FUNCTION CK_CONTCOND +LOCAL CC1 +CC1 := SUBSTR(CONT_COND,1,1) +IF CC1 = ' ' + REPLACE CONT_COND WITH ' ' + RETURN .T. +ENDIF + +IF !CC1$'OA' + ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' + ERR_BOX( 'VALID CONTINUE CONDITIONS ARE: "A" = "AND" ',; + ' (Blank is Also "AND") ',; + ' "O" = "OR" ',; + ' (See ' + ERRLINE + ') ') + RETURN .F. +ENDIF + +CURREC := RECNO() +SKIP 1 +ERRFLAG := .F. +** LOOK AT THE NEXT RECORD +IF EOF() +ELSE + IF !EMPTY(LOGIC_GR) + ERRFLAG := .T. + ENDIF +ENDIF + +GOTO CURREC + +IF ERRFLAG + ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' + ERR_BOX( ' You May NOT Place a CONTINUATION (And/Or) ',; + ' Immediately Preceding a NEW LOGIC GROUP ',; + ' or OR" on the LAST LINE. ',; + ' (See ' + ERRLINE + ') ') + RETURN .F. +ENDIF + +IF CC1 = 'O' + REPLACE CONT_COND WITH 'OR ' +ELSE + IF CC1 = 'A' + REPLACE CONT_COND WITH 'AND' + ELSE + REPLACE CONT_COND WITH ' ' + ENDIF +ENDIF + +KEYBOARD CHR(13) +RETURN .T. + +*********************************************************** +FUNCTION CK_LOGICGR +IF RECNO() = 1 + REPLACE LOGIC_GR WITH ' 1' +ENDIF + +IF EMPTY(LOGIC_GR) + RETURN .T. +ELSE + IF LOGIC_GR == 'OR' + RETURN .T. + ELSE + IF VAL(LOGIC_GR) > 0 + REPLACE LOGIC_GR WITH STR(VAL(LOGIC_GR),2) + RETURN .T. + ELSE + ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' + ERR_BOX( 'VALID LOGIC GROUPS ARE: ',; + ' - Numeric Sequence Numbers ',; + ' - "OR" (Which Will Combine Logic Groups) ',; + ' (See ' + ERRLINE + ') ') + RETURN .F. + ENDIF + ENDIF +ENDIF +RETURN .T. + +*********************************************************** +PROCEDURE LOGICERR +ERRLINE := 'Line ' + STR(RECNO(),3) + ' ' +ERR_BOX( 'LOGIC GROUPS (' + ERRLINE + ') ARE OUT OF SEQUENCE ',; + ' Please Re-enter with Consecutive ',; + ' LOGIC GROUPS or NO LOGIC GROUPS AT ALL! ') +RETURN + + +********************************************************* +FUNCTION OPT_VAL_LOOK() // CALLED FROM THE ALIAS2 FIELD +LOCAL NCHOICE := 0 +LOCAL HEADER := 'Select File' +LOCAL CHOICE_ARR := {}, SAVESEL := SELECT() +LOCAL SAVESCR := SAVESCREEN(), SAVEORD +LOCAL SAVECURSOR := SETCURSOR(), SAVEFILT +LOCAL STRT_ROW := 10 +LOCAL RETVAL := 10 +PRIVATE DISPVAL, FILTERVAL + +IF FIELD2 == '"SYSTEM "' + NCHOICE = 1 +ELSE + IF FIELD2 == '"CATEGORY"' + NCHOICE = 2 + ELSE + IF FIELD2 == '"MODEL "' + NCHOICE = 3 + ELSE + AADD(CHOICE_ARR, 'SYSTEM ATTRIBUTE Options') + AADD(CHOICE_ARR, 'CATEGORY ATTRIBUTE Options') + AADD(CHOICE_ARR, 'MODEL ATTRIBUTE Options') + + NCHOICE = LISTBOX(CHOICE_ARR,1,HEADER, STRT_ROW) + IF LASTKEY() = 27 + RESTSCREEN(,,,,SAVESCR) + SETCURSOR(SAVECURSOR) + RETURN .F. + ENDIF + ENDIF + ENDIF +ENDIF + + +IF NCHOICE = 1 + SELFILE = 'ATT_OPTS' + DISPVAL := '"-" + ATT_CODE + " " + OPT_VALUE ' +ELSE + IF NCHOICE = 2 + SELFILE = 'CAT_OPTS' + DISPVAL := '"-" + CAT_CODE + " " + OPT_VALUE ' + ELSE + IF NCHOICE = 3 + SELFILE = 'PROD_OPTS' + DISPVAL := '"-" + PROD_CODE + " " + OPT_VALUE ' + ENDIF + ENDIF +ENDIF + +SELECT (SELFILE) +SAVEORD := INDEXORD() +SAVEFILT := DBFILTER() +IF NCHOICE <> 1 + DONSETORD(2) +ENDIF +**SET FILTER TO ATT_CODE == (SAVESEL)->FIELD1 + + +FILTERVAL := 'ATT_CODE == ' + STR(SAVESEL,2) + '->FIELD1' +SET FILTER TO &FILTERVAL + +***********************GBROWSE( SELFILE ) + +RETVAL := VAL_LOOKUP((SAVESEL)->FIELD1 + (SAVESEL)->ALIAS2, ; + SELFILE, 5, {'ATT_CODE', DISPVAL} , 'Y' ,.F., ; + STR(SAVESEL,2) + '->ALIAS2') +******************* SELFILE, 5, {'ATT_CODE', DISPVAL} , 'Y' ,.F., '(SAVESEL)->ALIAS2') + +SELECT (SELFILE) +SET FILTER TO &SAVEFILT +DONSETORD(SAVEORD) +SELECT (SAVESEL) +//** CHECK FOR ENTER OR F10 +IF (LASTKEY() = 13 .OR. LASTKEY() = -9 ) .AND. RETVAL + IF NCHOICE = 1 + REPLACE (SAVESEL)->FIELD2 WITH '"SYSTEM "' + ELSEIF NCHOICE = 2 + REPLACE (SAVESEL)->FIELD2 WITH '"CATEGORY"' + ELSE + REPLACE (SAVESEL)->FIELD2 WITH '"MODEL "' + ENDIF + IF SELECT('TFILE') > 0 + REPLACE (SAVESEL)->ALIAS2 WITH TFILE->OPT_VALUE + SELECT TFILE + USE + SELECT (SAVESEL) + ELSE + REPLACE (SAVESEL)->ALIAS2 WITH (SELFILE)->OPT_VALUE + ENDIF + REPLACE (SAVESEL)->FIELD2TYPE WITH 'C' +ENDIF + +RETURN RETVAL + +**************************************************** +FUNCTION CK_CAT_MOD() +IF FIELD2 = '"CATEGORY"' .OR. FIELD2 = '"MODEL "' ; + .OR. FIELD2 = '"SYSTEM "' + RETURN .T. +ELSE + RETURN .F. +ENDIF + +**************************************************** +FUNCTION RULE_LINE1() +RETURN ' Att Code ' + +**************************************************** +FUNCTION RULE_LINE2() +RETURN ' Logic Att. /Option Attribute Cont Line' + + + + +*********************************************************** +***FUNCTION GETRULES(MRULE_CODE ) // GET ALL RULES THAT APPLY TO THIS ITEM +FUNCTION GETRULES(MRULE_CODE, SELFILE, GET_ARR, GET_ELM) +** RETURNS AN ARRAY WITH FIVE ELEMENTS, ONE ELEMENT FOR EACH SET +** OF RULES OF THAT TYPE +LOCAL RULEARR, SAVESCR, I, II, CUSTRULES := {}, LOANRULES := {} +LOCAL FSRULES := {}, TRRULES := {}, RETVAL, SAVESEL +LOCAL LVRULES := {} +SAVE SCREEN TO SAVESCR + +SAVESEL := SELECT() +RULEARR := {} +SELECT RULES + +SEEKKEY := MRULE_CODE +SEEK SEEKKEY +IF !FOUND() + ERR_BOX('PRODUCT ' + ALLTRIM((SELFILE)->PROD_CODE) + ' contains the ' + ; + 'RULE CODE ' + MRULE_CODE + '! ', ; + 'The RULE was NOT FOUND IN the RULES File!', ; + 'Define the RULE "' + ALLTRIM(MRULE_CODE) + '" and try again!') +ENDIF +DO WHILE RULE_CODE == MRULE_CODE .AND. !EOF() + + RETVAL := FILLRULE() + IF !EMPTY(RETVAL) + AADD(CUSTRULES, RETVAL) // RETARR ELE 1 + ENDIF + SELECT RULES + SKIP 1 +ENDDO +SELECT RULES + +SELECT &SAVESEL +RULEARR := CUSTRULES +RESTORE SCREEN FROM SAVESCR +RETURN RULEARR + +****************************************************************** + +STATIC FUNCTION FILLRULE() +LOCAL SEEKKEY, CURRULEPACK := {}, RULEPARMS := {}, LOGICARR := {} +LOCAL SUBGRARR := {}, SAVESEL +LOCAL TEMPADD := {} +SAVESEL := SELECT() +SEEKKEY := RULE_CODE +SELECT RULEPACK +SEEK SEEKKEY +FSTREC := .T. +LASTSUBGR := 1 +CURLG := 0 +IF FOUND() + ** IF THE LOGIC GROUP IS NOT EMPTY, EITHER NEW LOGIC OR SUBLOGIC GR. + ** THE RETURNED ARRAY MUST CONTAIN 1 ELEMENT PER LOGIC GROUP + RULEPARMS := {, RULES->RULE_CODE,; + RULES->RULE_LT, RULES->AUTO_GRADE,; + RULES->RULE_DESC, RULES->SETUP_ID} + LASTLG := LOGIC_GR + DO WHILE RULE_CODE == SEEKKEY .AND. !EOF() + IF !EMPTY(LOGIC_GR) .OR. FSTREC + FSTREC := .F. + IF LOGIC_GR = 'OR' + SUBGR ++ + ELSE + IF CURLG <> 0 + ** ADD THE RULE PACK FOR THE CURRENT SUBGROUP BEFORE ADDING LG + AADD(SUBGRARR, {CURRULEPACK, LASTLG}) + CURRULEPACK := {} + ** LOGICARR CONTAINS 1 ELEMENT FOR EACH ACTUAL LOGIC GROUP + AADD(LOGICARR, SUBGRARR) + SUBGRARR := {} + ENDIF + CURLG := VAL(LOGIC_GR) + SUBGR := 1 + LASTSUBGR := 1 + LASTLG := LOGIC_GR + ENDIF + ENDIF + IF SUBGR <> LASTSUBGR + ** CONTAINS 1 ELEMENT FOR EACH SUB GROUP (1 OR MORE PER LOGIC GR) + ** EACH SUBGROUP ELEMENT WILL CONTAIN ALL RULES FOR THAT SUBGR + AADD(SUBGRARR, {CURRULEPACK, LASTLG} ) + CURRULEPACK := {} + LASTSUBGR := SUBGR + LASTLG := LOGIC_GR + ENDIF + + AADD(CURRULEPACK, {FIELD1, OPERATOR, FIELD2, CONT_COND, FIELD1TYPE, FIELD2TYPE, ALIAS1, ALIAS2}) + SKIP 1 + + ENDDO + AADD(SUBGRARR, {CURRULEPACK, LASTLG} ) + AADD(LOGICARR, SUBGRARR) + SELECT &SAVESEL + RETURN {RULEPARMS,LOGICARR} +ELSE + ERR_BOX('RULE CODE ' + SEEKKEY + ' was called for ', ; + 'evaluation, but the RULE had NO RULE PACK ', ; + 'LINE DEFINITIONS - PRESS ANY KEY TO CONTINUE ') + SELECT &SAVESEL + RETURN NIL +ENDIF + +********************************************************************* +** ALL RULES PASSED HERE. +** EVALUATE THE CUST RULES FIRST, THEN THE LOAN RULES +** IF ANY HIT, RETURN .T. TO CALLING PROC (FOR ANCILLARY PROCESS) +** THE NEXT STEP WILL RECEIVE ALL RULES OF A GIVEN TYPE + +FUNCTION EVALCLRULES(CLRULEARR, WHENFAIL, G_ARR, SELFILE) +LOCAL I, RESULT := {}, THISRESULT := .F., HITCUST := .F. +PRIVATE CURFILE, FIELDARR +PRIVATE FAILFUNC := WHENFAIL +PRIVATE GET_ARR := G_ARR +PRIVATE RULE_SELFILE := SELFILE + +*PRIVATE SEEKVAL := SEEKKEY +CURFILE := 'C' +IF LEN(CLRULEARR[1]) > 0 // PASS WHOLE (L/C) RULE SET TO NEXT + HITCUST := EVALRULESET(CLRULEARR[1]) +ENDIF // STEP (ALL CUST RULES OR ALL +IF HITCUST + RETURN .T. +ELSE + RETURN .F. +ENDIF + + + +********************************************************************* +** ALL RULES PASSED HERE. (1ST CUST, THEN LOAN-WILL PROCESS 2 TIMES) +** EVALUATE EACH RULE SEPERATELY AND STORE RESULT IN RESULT ARRAY +** IF THE TOTAL EVALUATION IS TRUE, RETURN .T. TO CALLING FUNCTION +** THE NEXT STEP WILL EVALUATE EACH RULE AND WRITE THE GRADE RECS AS NEEDED + +FUNCTION EVALRULESET(THISRULEARR) +LOCAL I, RESULT := {}, THISRESULT +FOR I := 1 TO LEN(THISRULEARR) + THISRESULT := EVAL1RULE(THISRULEARR[I]) // PASS THE WHOLE RULE TO NEXT + AADD(RESULT, THISRESULT) // STEP + IF !THISRESULT + EXIT + ENDIF +NEXT // RESULT ARR 1 ELEMENT FOR EACH +*** STRING RESULTS TOGETHER AND // RULE IN THE SET PASSED +*** EVALUATE AS A HIT OR NOT + +** NOW, EVALUATE THE COMBINED RULES TO SEE IF ANY HITS +RETURNVAL := .T. +FOR I := 1 TO LEN(RESULT) + IF !RESULT[I] // THIS IS A MASSIVE "OR" (ANY FALSE => ALL FALSE) + RETURNVAL := .F. + ENDIF +NEXT +RETURN RETURNVAL // RETURNS T/F FOR ALL RULES EVALUATED + // IF ANY ONE WAS TRUE, RETURNS TRUE + + + + + +********************************************************************* +** EACH RULE PASSED HERE (REGARDLESS OF TYPE) +** EVALUATE THIS ONE RULE SINGLELY AND STORE RESULT IN RESULT ARRAY +** IF THIS RULE IS A HIT, WRITE OUT THE GRADE RECORD +** THE NEXT STEP WILL EVALUATE EACH LOGIC GROUP AS REQUIRED + +STATIC FUNCTION EVAL1RULE(WHOLERULE) +LOCAL I, RESULT := {}, THISRESULT, STRVAL := '' +LOCAL BAL, COLL, FACT +PRIVATE MFILE_TYPE +PRIVATE MRULE_LT +PRIVATE MAUTOGRADE +PRIVATE MRULE_DESC +PRIVATE ML2VFACTOR +MRULE_CODE := WHOLERULE[1][2] +MRULE_DESC := WHOLERULE[1][5] + + +RULE2CK := WHOLERULE[2] +FOR I := 1 TO LEN(RULE2CK) // ONE ELEMENT FOR EACH LOGIC GR. + THISRESULT := EVALLGGRP(RULE2CK[I]) // ONE LOGIC GROUP + AADD(RESULT, THISRESULT) + IF !THISRESULT // IF ANY LOGIC GROUP IN THE RULE IS FALSE, + RETURN .F. // THE WHOLE RULE IS A NON-HIT + ENDIF +NEXT + +** NOW, EVALUATE THE COMBINED LOGIC GROUPS IN THE RULE +EVALSTR := '' +STRVAL := '' +FOR I := 1 TO LEN(RESULT) + IF RESULT[I] + STRVAL := '.T.' + ELSE + STRVAL := '.F.' + ENDIF + + IF I = LEN(RESULT) + EVALSTR := EVALSTR + STRVAL + ELSE + JOINER := '.AND.' + EVALSTR := EVALSTR + STRVAL + JOINER + ENDIF +NEXT +IF EVALSTR == '' + RETURN .F. +ELSE + IF &EVALSTR .AND. FAILFUNC <> NIL + WRITEFRREC() + ENDIF + RETURN &EVALSTR // RETURNS T/F FOR ALL LOGIC GROUPS IN THE RULE +ENDIF + + + + +********************************************************************* +** EACH LOGIC GROUP PASSED HERE. +** EVALUATE LOGIC GROUP SINGLELY AND STORE RESULT IN RESULT ARRAY +** IF COMBINATION OF LOGIC GROUPS HITS, RETURN .T. TO CALLING FUNCTION +** THE NEXT STEP WILL EVALUATE EACH SUB GROUP AS REQUIRED + +STATIC FUNCTION EVALLGGRP(LGGROUP) +LOCAL I, RESULT := {}, THISRESULT +LOCAL EVALSTR, JOINER, STRVAL +FOR I := 1 TO LEN(LGGROUP) // ONE ELEMENT FOR EACH LOGIC GROUP + THISRESULT := EVALSUB(LGGROUP[I]) // PASS EACH SUBGROUP + AADD(RESULT, THISRESULT) +NEXT + +** NOW, EVALUATE THE COMBINED SUB GROUPS IN THE LOGIC GROUP +EVALSTR := '' +STRVAL := '' +FOR I := 1 TO LEN(RESULT) + IF RESULT[I] + STRVAL := '.T.' + ELSE + STRVAL := '.F.' + ENDIF + + IF I = 1 + EVALSTR := EVALSTR + STRVAL + ELSE + IF ALLTRIM(LGGROUP[I,2]) = 'OR' // THE LOGIC GROUP VALUE + JOINER := '.OR.' + ELSE + JOINER := '.AND.' + ENDIF + EVALSTR := EVALSTR + JOINER + STRVAL + ENDIF +NEXT +RETURN &EVALSTR // RETURNS T/F FOR ALL SUBGROUPS IN THE LOGIC GR. + + + + + +********************************************************************* +** EACH SUB-LOGIC-GROUP PASSED HERE. +** EVALUATE SUB-GROUP SINGLELY AND STORE RESULT IN RESULT ARRAY +** IF COMBINATION OF SUB-LOGIC GROUPS HITS, RETURN .T. TO CALLING FUNCTION +** THE NEXT STEP WILL EVALUATE EACH LINE ITEM AS REQUIRED + +STATIC FUNCTION EVALSUB(TOTSUBGROUP) +LOCAL I, RESULT := {}, THISRESULT +LOCAL EVALSTR, JOINER, STRVAL := '', CURLGVAL +SUBGROUP := TOTSUBGROUP[1] +CURLGVAL := TOTSUBGROUP[2] +FOR I := 1 TO LEN(SUBGROUP) // ONE ELEMENT FOR EACH LINE ITEM + THISRESULT := EVALLINE(SUBGROUP[I]) // PASS EACH LINE ITEM + AADD(RESULT, {THISRESULT, SUBGROUP[I,4]}) // STORE THE CONT_COND W/LINE LI +NEXT + +** NOW, EVALUATE THE SUB LOGIC GROUP +EVALSTR := '' +FOR I := 1 TO LEN(RESULT) + IF RESULT[I,1] + STRVAL := '.T.' + ELSE + STRVAL := '.F.' + ENDIF + + IF I = LEN(RESULT) + EVALSTR := EVALSTR + STRVAL + ELSE + IF ALLTRIM(RESULT[I,2]) = 'OR' + JOINER := '.OR.' + ELSE + JOINER := '.AND.' + ENDIF + EVALSTR := EVALSTR + STRVAL + JOINER + ENDIF +NEXT +RETURN &EVALSTR // RETURNS T/F FOR ALL LINES IN SUBGROUP + + + + +********************************************************************* +** EACH LINE OF THE FIELD COMPARISON RULE MADE IT TO HERE. +** EVALUATE THE LINE TO THE ACTUAL DATA IN THE PERMCUST/PERMLOAN +** THEN EVALUATE THE RESULT AND RETURN .T. IF THE RULE IS TRUE FOR DATA + +** THIS FUNCTION EVALUATES DATA IN THE RECORD AND CALCULATES THE T/F +** VALUE BASED ON THE RULE DEFINITION. + + +********************************** +STATIC FUNCTION EVALLINE(LINEITEM) +LOCAL I, RESULT := {}, THISRESULT, REPVAR1, REPVAR2, OPER, CC, ELEM +LOCAL MFIELD, SAVESEL := SELECT() + +PRIVATE AL1 // ALIAS1 := ALLTRIM(LINEITEM[7] +PRIVATE AL2 // ALIAS2 := ALLTRIM(LINEITEM[8] +PRIVATE LVAR1 := '' + +** THIS VERSION KNOWS WHICH DATABASES TO LOOK AT BASED ON THE FILETYPE +** THE SURVEY VERSION WILL HAVE TO SELECT AND SEEK ON THE FLY! +REPVAR1 := ALLTRIM(LINEITEM[1]) +REPTYPE1 := ALLTRIM(LINEITEM[5]) +IF REPTYPE1 = 'C' + REPVAR1 = ALLTRIM( STRTRAN(REPVAR1, '"', '') ) +ENDIF +OPER := LINEITEM[2] +REPVAR2 := ALLTRIM(LINEITEM[3]) +REPTYPE2 := ALLTRIM(LINEITEM[6]) +REPALIAS1 := ALLTRIM(LINEITEM[7]) +REPALIAS2 := ALLTRIM(LINEITEM[8]) +LVAR1 = '' +LVAR2 = '' +CC := LINEITEM[4] +IF EMPTY(REPTYPE1) .OR. EMPTY(REPTYPE2) + ERR_BOX('ERROR DURING RULE EVALUATION - EMPTY FIELDTYPE ' , ; + ' The line in error reads as follows ', ; + REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; + ' PLEASE CORRECT AND RE-RUN THIS PROCESS') + RETURN .F. +ENDIF + +// determine value of 1st field to compare +// IF IT IS A RANCH SLIDER, THEN REVERSE THE HEIGHT AND WIDTH +IF REPVAR1 = 'WIDTH' .OR. REPVAR1 = 'HEIGHT' + ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == 'RANCH SLID' }) + IF ELEM > 0 .AND. ALLTRIM(GET_ARR[ELEM,4]) == 'RANCH SLIDER' + IF REPVAR1 = 'WIDTH' + REPVAR1 = 'HEIGHT' + ELSE + REPVAR1 = 'WIDTH' + ENDIF + ENDIF +ENDIF + +IF REPTYPE1 = 'S' + LVAR1 = SPECFLD_VALUE( REPVAR1, RULE_SELFILE ) +ELSE + IF REPTYPE1 = 'A' + ELEM = ASCAN(GET_ARR, {|X| ALLTRIM(X[1]) == ALLTRIM(REPVAR1) }) + IF ELEM > 0 + LVAR1 = GET_ARR[ELEM,4] //USER_RESP + + IF GET_ARR[ELEM,2]$'T' + REPTYPE1 := 'C' + // STRIP THE "V" OFF THE 1ST BYTE OF THE RESULT + IF SUBS(LVAR1,1,1)$'V' .AND. ISDIGIT(SUBS(LVAR1,2,1)) + LVAR1 := SUBS(LVAR1,2) + ENDIF + ELSE + IF GET_ARR[ELEM,2]$'UC' + REPTYPE1 := 'N' + LVAR1 := VAL(LVAR1) + ELSE + REPTYPE1 := 'C' + ENDIF + ENDIF + ELSE + ERR_BOX('ERROR DURING EVALUATION OF RULE - (' + MRULE_CODE + ')',; + ' ATT_CODE SPECIFIED - NOT FOUND' , ; + ' The ATT CODE WAS "' + REPVAR1 + '"' , ; + ' The line in error reads as follows ' , ; + REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; + ' PLEASE CORRECT LINE ITEM - '+STR((CUR_OL)->LINE_NUM)+'/'+(CUR_OL)->PROD_CODE) + ENDIF + ELSE + LVAR1 = '' + ERR_BOX('ERROR DURING RULE EVALUATION - INVALID FIELDTYPE1 ' , ; + ' The VALUE TO LOOK FOR was ' + REPVAR1 , ; + ' The line in error reads as follows ', ; + REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; + ' PLEASE CORRECT AND RE-RUN THIS PROCESS') + RETURN .F. + ENDIF +ENDIF + +IF EMPTY(REPTYPE1) .OR. EMPTY(REPTYPE2) + ERR_BOX('ERROR DURING RULE EVALUATION - EMPTY FIELDTYPE ' , ; + ' The ATT CODE WAS ' + REPVAR1 + ' or ' + REPVAR2 , ; + ' The line in error reads as follows ', ; + REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; + ' PLEASE CORRECT AND RE-RUN THIS PROCESS') + RETURN .F. +ENDIF + +IF REPVAR2 = '"CATEGORY"' .OR. REPVAR2 = '"MODEL"' .OR. REPVAR2 = '"SYSTEM"' ; + .OR. REPVAR2 = '"MODEL "' .OR. REPVAR2 = '"SYSTEM "' + LVAR2 = ALLTRIM(REPALIAS2) + REPTYPE2 := 'C' +ELSE + LVAR2 := REPVAR2 + // CHECK FOR NUMERIC + DO CASE + CASE REPTYPE2 = 'S' //** P3N - 6/29/01 + LVAR2 := SPECFLD_VALUE(REPVAR2, RULE_SELFILE) //** P3N - 6/29/01 + CASE REPTYPE2 = 'N' + LVAR2 = VAL(LVAR2) + CASE REPTYPE2 = 'C' + LVAR2 = ALLTRIM(STRTRAN(LVAR2,'"', ' ')) + CASE REPTYPE2 = 'A' + FOR I = 1 TO LEN(GET_ARR) + IF ALLTRIM(GET_ARR[I,1]) == REPVAR2 + LVAR2 = GET_ARR[I,4] //USER_RESP + + IF GET_ARR[ELEM,2]$'T' + REPTYPE1 := 'C' + // STRIP THE "V" OFF THE 1ST BYTE OF THE RESULT + IF SUBS(LVAR2,1,1)$'V' .AND. ISDIGIT(SUBS(LVAR2,2,1)) + LVAR2 := SUBS(LVAR2,2) + ENDIF + ELSE + IF GET_ARR[I,2]$'UC' + REPTYPE2 := 'N' + LVAR2 := VAL(LVAR2) + ELSE + REPTYPE2 := 'C' + ENDIF + ENDIF + EXIT + ENDIF + NEXT + OTHERWISE + ERR_BOX('ERROR DURING RULE EVALUATION - INVALID FIELDTYPE2 ' , ; + ' The line in error reads as follows ', ; + REPVAR1 + ' ' + OPER + ' ' + REPALIAS2 + ' '+ REPVAR2 , ; + ' PLEASE CORRECT AND RE-RUN THIS PROCESS') + RETURN .F. + ENDCASE +ENDIF + +// LVAR2 IS SET TO EITHER CHARSTR RESPONSE, NUMERIC OR A BLANK +// MAKE LVAR/REPTYPE1 THE SAME AS TYPE2 +IF VALTYPE(LVAR1) = 'C' + DO CASE + CASE REPTYPE2 = 'N' + LVAR1 := VAL(LVAR1) // FORCE TO NUMERIC VALUE IN LVAR1 + REPTYPE1 := 'N' + CASE REPTYPE2 = 'C' // KEEP AS CHAR TO MATCH LVAR2 + REPTYPE1 := 'C' + CASE REPTYPE2 = ' ' // MAKE BOTH CHARACTER SINCE LVAR1 WAS CHAR + REPTYPE1 := 'C' + REPTYPE2 := 'C' + ENDCASE +ELSE + IF VALTYPE(LVAR1) = 'N' + DO CASE + CASE REPTYPE2 = 'N' // KEEP AS NUMERIC SAME AS LVAR1 TYPE + REPTYPE1 := 'N' + CASE REPTYPE2 = 'C' // FORCE LVAR2 TO NUMERIC TO MATCH LVAR1 + LVAR2 := VAL(LVAR2) + REPTYPE1 := 'N' + REPTYPE2 := 'N' + CASE REPTYPE2 = ' ' + LVAR2 := 0 + REPTYPE1 := 'N' // MAKE BOTH NUMERIC TO MATCH LVAR1 TYPE + REPTYPE2 := 'N' + ENDCASE + ENDIF +ENDIF + +IF REPTYPE1 = 'C' + LVAR1 = ALLTRIM( STRTRAN(LVAR1, '"', '') ) +ENDIF + +IF REPTYPE2 = 'C' + LVAR2 = ALLTRIM( STRTRAN(LVAR2, '"', '') ) +ENDIF + +VTYPE1 := VALTYPE(LVAR1) +VTYPE2 := VALTYPE(LVAR2) + +** WHEN COMPARING CHARACTER FIELDS, FORCE TO UPPER CASE + +IF VTYPE1 = 'C' + LVAR1 := UPPER(ALLTRIM(LVAR1)) + IF LEN(LVAR1) = 0 + LVAR1 := ' ' + ENDIF +ENDIF +IF VTYPE2 = 'C' + LVAR2 := UPPER(ALLTRIM(LVAR2)) + IF LEN(LVAR2) = 0 + LVAR2 := ' ' + ENDIF +ENDIF + +IF LEN(TRIM(OPER)) > 1 + DO CASE + CASE OPER = 'LT' + OPER := '< ' + CASE OPER = 'GT' + OPER := '> ' + CASE OPER = 'EQ' + OPER := '= ' + CASE OPER = 'LE' + OPER := '<=' + CASE OPER = 'GE' + OPER := '>=' + CASE OPER = 'NE' + OPER := '<>' + ENDCASE +ENDIF +CALCSTR := 'LVAR1 ' + OPER + ' LVAR2' +SELECT (SAVESEL) +RETURN &CALCSTR + + + + +******************************************************* +************************************************** +STATIC FUNCTION EVALFLD(REPVAR, REPTYPE, REPALIAS) +IF SUBSTR(REPVAR,1) = '"' + REPVAR := ALLTRIM(STRTRAN(REPVAR, '"', '')) + RETURN ALLTRIM(REPVAR) +ELSE + IF REPTYPE$'N' + RETURN VAL(REPVAR) + ELSE + IF REPVAR = 'CURDATE' + RETURN CURDATE + ELSE + IF REPTYPE$'F' + *-***************************** + *-HERE, YOU HAVE TO BE SURE THAT THE ALIAS IS OPEN AND SEEKED + *-ON THE PROPER RECORD. THEN RETSTR := TRIM(AL1 OR AL2) + '->' + REPVAR + +///////CHECK FOR CUSTOMER RECORD EXIST IN ALIAS, + FOR L = 1 TO LEN(ALIAS_LIST) + IF TRIM(ALIAS_LIST[L,1]) = TRIM(REPALIAS) .AND. ALIAS_LIST[L,2] + REPVAR := REPALIAS + '->' + REPVAR + RETURN &REPVAR + ENDIF + NEXT + RETURN NIL + ELSE + IF REPTYPE$'D' + RETURN CTOD(REPVAR) + ELSE + IF REPTYPE$'C' + RETURN ALLTRIM( STRTRAN(REPVAR, '"', '') ) + ELSE + RETURN NIL + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +ENDIF + + + + + +******************************************************* + + +STATIC PROCEDURE UPDATENUMFAIL(MRULE_CODE) +LOCAL I, X, SEEKKEY +SELECT SURV_HIT +SEEKKEY := MRULE_CODE +SEEK SEEKKEY +DO WHILE RULE_CODE = MRULE_CODE .AND. !EOF() + X := 0 + SEEKKEY := RULE_CODE + LOCATION + SELECT RULEHIT + SEEK SEEKKEY + DO WHILE RULE_CODE + LOCATION == SEEKKEY + X ++ + SKIP 1 + ENDDO + SELECT SURV_HIT + REPLACE NUM_FAIL WITH X + SKIP 1 +ENDDO + +RETURN + +******************************************************* + +STATIC PROCEDURE WRITEFRREC +*** WRITE THE GRADE FAIL RECORD HERE + +SAVESEL := SELECT() +SELECT RULEHIT +CLNUM := MASTER->LOCATION +SEEKKEY := STR(DESCEND(CURDATE)) + MRULE_CODE ; + + SUBSTR(CLNUM+SPACE(20), 1, 20) ; + + MRULE_CODE +SEEK SEEKKEY +IF !FOUND() + ADD_REC(3) + REPLACE FAIL_DATE WITH CURDATE + REPLACE RULE_CODE WITH MRULE_CODE + REPLACE LOCATION WITH CLNUM +* REPLACE FAIL_RFILE WITH MFILE_TYPE + REPLACE FAIL_RCODE WITH MRULE_CODE +ENDIF +SELECT &SAVESEL +RETURN + + +*************************************** +FUNCTION CK_IF_NUMERIC(CKFLD) +LOCAL GOODVAR := '', I, CKCHAR +LOCAL REPVAR := ALLTRIM(CKFLD) // -- FIELD TO VALIDATE +LOCAL NUMDEC := 0 + +** CHECK FOR ALPHA FIELD (!NUMERIC) +FOR I = 1 TO LEN(REPVAR) + CKCHAR := SUBSTR(REPVAR,I,1) + IF !(CKCHAR$'0123456789-.') + I := 999 + ELSE + IF (CKCHAR >= CHR(48) .AND. CKCHAR <= CHR(57)) + GOODVAR := GOODVAR + CKCHAR + ELSE + IF CKCHAR = '-' + IF I = 1 + GOODVAR := GOODVAR + CKCHAR + ELSE + I := 999 + ENDIF + ELSE + IF CKCHAR = '.' + NUMDEC ++ + IF NUMDEC = 1 + GOODVAR := GOODVAR + CKCHAR + ELSE + I := 999 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +NEXT + +***IF >= 999, THEN IT WAS AN ALPHA LITERAL STRING +***IF < 999, THEN IT WAS A NUMERIC VALUE + +IF I < 999 + RETURN .T. +ELSE + RETURN .F. +ENDIF + +*********************************************** +****THIS FUNCTION WILL CHECK FOR THE VALUE **** +** IN THE SPECIAL FIELDS LIST. IF PASSED A UPDATE +** FIELDNAME, THE SPEC_FLDS LOOKUP WILL UPDATE USERFILE2 +** +*********************************************** +FUNCTION SPEC_FLD(MNAME, WHEREFROM) +// CHECK FOR MNAME IN SPECIAL FIELD LIST + +STATIC SPEC_R_FLDARR +STATIC SPEC_C_FLDARR +STATIC SPEC_M_FLDARR + +IF WHEREFROM = NIL + WHEREFROM := 'RULE' +ENDIF + +IF SPEC_R_FLDARR = NIL + SPEC_R_FLDARR := SPECIAL_FIELDS(.F., 'RULE') // NO LOOKUP, BUT GET ARRAY +ENDIF + +IF SPEC_C_FLDARR = NIL + SPEC_C_FLDARR := SPECIAL_FIELDS(.F., 'CUT') // NO LOOKUP, BUT GET ARRAY +ENDIF + +IF SPEC_M_FLDARR = NIL + SPEC_M_FLDARR := SPECIAL_FIELDS(.F., 'MISC') // NO LOOKUP, BUT GET ARRAY +ENDIF + +IF WHEREFROM = 'RULE' .AND. ASCAN(SPEC_R_FLDARR, {|X| TRIM(X)==TRIM(MNAME)}) > 0 + RETURN .T. +ELSE + IF WHEREFROM = 'CUT' .AND. ASCAN(SPEC_C_FLDARR, {|X| TRIM(X)==TRIM(MNAME)}) > 0 + RETURN .T. + ELSE + IF WHEREFROM = 'MISC' .AND. ASCAN(SPEC_M_FLDARR, {|X| TRIM(X)==TRIM(MNAME)}) > 0 + RETURN .T. + ELSE + RETURN .F. + ENDIF + ENDIF +ENDIF + + +*********************************************** +// CHECKS TO SEE IF THE FIELD IS A SPECIAL FIELD +*********************************************** +FUNCTION RULE_FIELD(UPDATE_FIELDNAME) +**FUNCTION FLD_ERR1(MNAME) +// CALLED DURING RULE PACK SETUP + +LOCAL RESULT, VERIFY_VAL, M2 +LOCAL WHCHFLD := RIGHT( ALLTRIM(UPDATE_FIELDNAME) ,1) +LOCAL REPTYPEFLD := 'FIELD' + WHCHFLD + 'TYPE' +LOCAL SAVESEL := SELECT() + +VERIFY_VAL := &UPDATE_FIELDNAME +IF LASTKEY() = -9 // F10 KEY - NO NEED TO CHECK THIS AGAIN! + RETURN .T. +ENDIF + +// CHECK SPECIAL FIELD LIST 1ST + +IF EMPTY(VERIFY_VAL) .AND. WHCHFLD = '1' + ERR_BOX('You MUST Specify an ATTRIBUTE') + RETURN .F. +ENDIF + +IF SPEC_FLD(VERIFY_VAL) + REPTYPEFLD := 'FIELD' + WHCHFLD + 'TYPE' + REPLACE &REPTYPEFLD WITH 'S' + RETURN .T. +ELSE + // BRING UP THE SPECIAL FIELD LIST + IF UPDATE_FIELDNAME = NIL + ? 'ERROR IN RULE_FIELD IN CGWRULE ' + WAIT + RETURN .F. + ENDIF + RESULT = SPECIAL_FIELDS(.T., 'RULE') // LOOK IT UP + IF !EMPTY(RESULT) +** SAVESEL = SELECT() +** SELECT USERFILE2 + SELECT (SAVESEL) +****REPLACE FIELD1 WITH RESULT + REPLACE &UPDATE_FIELD WITH RESULT + REPLACE &REPTYPEFLD WITH 'S' +** SELECT(SAVESEL) + RETURN .T. + ELSE + IF VAL_LOOKUP(FIELD1, 'ATTRIBUTES', , {'ATT_CODE', 'DESC'} , 'Y',; + .F., STR(SAVESEL,2) + '->FIELD1' ,{4,20,17,52}) +***** .F., 'USERFILE2->FIELD1' ,{4,20,17,52}) + REPLACE &REPTYPEFLD WITH 'A' + RETURN .T. + ELSE + IF WHCHFLD = '1' + M2 = '' + ELSE + M2 = 'or a CHARACTER STRING, VALUE, or BLANK' + ENDIF + ERR_BOX('INVALID ENTRY - SPECIFY AN ATTRIBUTE ', ; + M2,; + ' PLEASE RE-ENTER') + ENDIF + ENDIF +ENDIF +? 'ERROR IN RULE_FIELD IN CGWRULE ' +WAIT +RETURN .F. + +********************************************************** +FUNCTION PE_SPECFLD(FLD2CK) +LOCAL SAVESEL := SELECT() +LOCAL VERIFY_VAL, RESULT +VERIFY_VAL := &FLD2CK + +IF LASTKEY() = K_F10 + RETURN .T. +ENDIF + +IF SPEC_FLD(VERIFY_VAL) + RETURN .T. +ELSE + RESULT = SPECIAL_FIELDS(.T., 'RULE') // LOOK IT UP + IF !EMPTY(RESULT) + SELECT USERFILE2 + REPLACE &FLD2CK WITH RESULT + SELECT(SAVESEL) + RETURN .T. + ENDIF +ENDIF +RETURN .F. + +****************************************************************** +********************************************************************* + \ No newline at end of file diff --git a/CGWUGRAD.PRG b/CGWUGRAD.PRG new file mode 100644 index 0000000..1812797 --- /dev/null +++ b/CGWUGRAD.PRG @@ -0,0 +1,214 @@ +* UPGRADE - build the user manual for now! +* +* +PROCEDURE UPGRADE(CURVER) +CLEAR +@ 10,10 SAY '*** Upgrading Data Files - One Moment Please ***' +* +SELECT CONTROL +OLDVERSION = VERSION +FROMFILE = 'OLD0KA.DBF' +IF FILE(FROMFILE) + DBOPEN('CONTROL',.T.) + FIL_LOCK(5) + APPEND FROM &FROMFILE + GOTO BOTTOM + REPLACE VERSION WITH CURVER + REPLACE INSTALLED WITH .F. + UNLOCK +ELSE + FIL_LOCK(5) + REPLACE VERSION WITH CURVER + REPLACE INSTALLED WITH .F. + UNLOCK + * +* NET_USE ('GRA0UM',.T.,5, 'USERMAN') +* FROMFILE = 'USER.MAN' +* SELECT USERMAN +* ZAP +* APPEND FROM &FROMFILE SDF +* USE + * + RETURN +ENDIF +* +* WORKSTAT = M_DATA + ':' + SYSCODE + '0WS' +DBOPEN('WORKSTAT',.T.) +FROMFILE = 'OLD0WS.DBF' +IF FILE(FROMFILE) + APPEND FROM &FROMFILE + USE +ENDIF + +* PASSWORD = M_DATA + ':' + SYSCODE + '0PA' +DBOPEN('PASSWORD',.T.) +FROMFILE = 'OLD0PA.DBF' +IF FILE(FROMFILE) + SELECT PASSWORD + ZAP + APPEND FROM &FROMFILE +ENDIF +USE +* +* +*THIS IS COMMENTED OUT BECAUSE I DO NOT KNOW WHAT THE USER.MAN FILE IS? +* +* +DBOPEN('DATADICT') +GOTO TOP +DO WHILE !EOF() + + IF ALIAS = 'DATADICT' .OR. ALIAS = 'CONTROL' ; + .OR. ALIAS = 'WORKSTAT' .OR. ALIAS = 'PASSWORD' ; + .OR. ALIAS = 'IMPCUST' .OR. ALIAS = 'STDCUST' + SKIP 1 + LOOP + ENDIF + + @ 12,10 SAY '*** Current file is ' + ALIAS + + NET_USE (FILE_NAME,.T.,5, 'CURFILE') + SELECT CURFILE + ZAP +* IF __DBDRIVER = 'CDX' +* ORDLISTCLEAR() +* ENDIF + FROMFILE = 'OLD' + SUBS( DATADICT->FILE_NAME,4) + + IF OLDVERSION < '3.40' .AND. __DBDRIVER = 'CDX' + SELECT 0 + USE (FROMFILE) EXCLUSIVE ALIAS 'FROMFILE' VIA 'DBFNTX' + ELSE + NET_USE( FROMFILE, .T., 5, 'FROMFILE' ) + ENDIF + + SELECT FROMFILE + GOTO TOP + DO WHILE !EOF() + ADD_ONEREC('FROMFILE', 'CURFILE', .F., .T.) // NO AUDITPROC / ASSUME EXACT SAME STRUCTURE + SELECT FROMFILE + SKIP 1 + ENDDO +** APPEND FROM &FROMFILE + CLOSE FROMFILE + CLOSE CURFILE + + SELECT DATADICT + SKIP 1 +ENDDO + + + +/* +NET_USE ('FSB0UM',.T.,5) +FROMFILE = 'USER.MAN' +SELECT FSB0UM +ZAP +APPEND FROM &FROMFILE SDF +USE +*/ +* +** THE REST IF FOR EXAMPLE SAKE ONLY! +* +* NET_USE ('FSB0LA',.T.,5) +* FROMFILE = 'OLD0LA' +* APPEND FROM &FROMFILE +* NULLDATE = CTOD(' / / ') +* GOTO TOP +* DO WHILE .NOT. EOF() +* IF ACC_METH = ' ' +* REPLACE ACC_METH WITH '1' +* ENDIF +* IF ORIG_INDEX = ' ' +* REPLACE ORIG_PM WITH ORIG_RATE +* REPLACE ORIG_INDEX WITH 'F' +* ENDIF +* IF REPAY_NDX = ' ' +* REPLACE REPAY_PM WITH REPAY_RATE +* REPLACE REPAY_NDX WITH 'F' +* ENDIF +* IF CO_DATE = NULLDATE +* REPLACE CO_DATE WITH BB_DATE +* ENDIF +* IF REPAY_METH = ' ' +* REPLACE REPAY_METH WITH '1' +* ENDIF +* SKIP 1 +* ENDDO +* USE +* * +* +* +* NET_USE ('FSB0MA',.T.,5) +* FROMFILE = 'OLD0MA' +* APPEND FROM &FROMFILE +* REPLACE ALL CO_DATE WITH BB_DATE FOR CO_DATE = CTOD(' / / ') +* USE +* * +* +* NET_USE ('FSB0RA',.T.,5) +* FROMFILE = 'OLD0RA' +* APPEND FROM &FROMFILE +* REPLACE ALL REPAY_METH WITH '1' FOR REPAY_METH = ' ' +* +* USE +* * +* +* NET_USE ('FSB0CA',.T.,5) +* FROMFILE = 'OLD0CA' +* APPEND FROM &FROMFILE +* USE +* * +* NET_USE ('FSB0LT',.T.,5) +* FROMFILE = 'OLD0LT.DBF' +* IF FILE(FROMFILE) +* SELECT FSB0LT +* ZAP +* APPEND FROM &FROMFILE +* ENDIF +* REPLACE ALL TYPE_ACC WITH '1' FOR TYPE_ACC = ' ' +* LOCATE FOR TYPE_CODE = 'O ' +* REPLACE TYPE_ACC WITH '3' +* USE +* * +* +* NET_USE ('FSB0OI',.T.,5) +* FROMFILE = 'OLD0OI.DBF' +* IF FILE(FROMFILE) +* SELECT FSB0OI +* ZAP +* APPEND FROM &FROMFILE +* ENDIF +* USE +* * +* NET_USE ('FSB0TA',.T.,5) +* FROMFILE = 'OLD0TA' +* APPEND FROM &FROMFILE +* IF OLDVERSION < '4.10' +* REPLACE ALL TRANS_DESC WITH 'PAYMENT' FOR TRANS_TYPE = 'P'; +* .AND. TRANS_DESC = SPACE(30) +* REPLACE ALL TRANS_DESC WITH 'ADJUSTMENT' FOR TRANS_TYPE = 'D'; +* .AND. TRANS_DESC = SPACE(30) +* ENDIF +* REPLACE ALL TRANS_TYPE WITH 'Y' FOR TRANS_TYPE = 'D' +* USE +* * +* COPY FILE OLD0CN.DBF TO FSB0CN.DBF +* COPY FILE OLD0LN.DBF TO FSB0LN.DBF +* COPY FILE OLD0TN.DBF TO FSB0TN.DBF + +* +* NET_USE ('FSB0RI',.T.,5) +* FROMFILE = 'OLD0RI.DBF' +* SELECT FSB0RI +* IF FILE(FROMFILE) +* ZAP +* APPEND FROM &FROMFILE +* ENDIF +* USE + * +* +* +RETURN + + \ No newline at end of file diff --git a/FMASTER.NTX b/FMASTER.NTX new file mode 100644 index 0000000..3f86e62 Binary files /dev/null and b/FMASTER.NTX differ diff --git a/GL.NTX b/GL.NTX new file mode 100644 index 0000000..bdf6e05 Binary files /dev/null and b/GL.NTX differ diff --git a/GRA1CS.NTX b/GRA1CS.NTX new file mode 100644 index 0000000..b6f37e3 Binary files /dev/null and b/GRA1CS.NTX differ diff --git a/GRA1MP.NTX b/GRA1MP.NTX new file mode 100644 index 0000000..0016ce6 Binary files /dev/null and b/GRA1MP.NTX differ diff --git a/GRA2CS.NTX b/GRA2CS.NTX new file mode 100644 index 0000000..a592f7f Binary files /dev/null and b/GRA2CS.NTX differ diff --git a/GRA2MP.NTX b/GRA2MP.NTX new file mode 100644 index 0000000..4cdb7ce Binary files /dev/null and b/GRA2MP.NTX differ diff --git a/GRA3CS.NTX b/GRA3CS.NTX new file mode 100644 index 0000000..375dbe6 Binary files /dev/null and b/GRA3CS.NTX differ diff --git a/OL.NTX b/OL.NTX new file mode 100644 index 0000000..4ec244a Binary files /dev/null and b/OL.NTX differ diff --git a/OST.NTX b/OST.NTX new file mode 100644 index 0000000..a06625e Binary files /dev/null and b/OST.NTX differ diff --git a/README.md b/README.md new file mode 100644 index 0000000..e69de29 diff --git a/TEMP.NTX b/TEMP.NTX new file mode 100644 index 0000000..3a6a6e7 Binary files /dev/null and b/TEMP.NTX differ diff --git a/TMP.NTX b/TMP.NTX new file mode 100644 index 0000000..8cb0c57 Binary files /dev/null and b/TMP.NTX differ diff --git a/mh32.bat b/mh32.bat new file mode 100644 index 0000000..9039917 --- /dev/null +++ b/mh32.bat @@ -0,0 +1,63 @@ +@echo off +CLS + +set bcc=f:\prod\BCC582 +set fwh=fwh1302 +set harb=harb32 +set sys=CGW32 + +rem ************************************************************** + rem harbour v3.0 with fwh 11.07 and Borland v5.82 +rem ************************************************************** + +echo Compile step > out.txt +CALL f:\utility\RMAKE32 %sys%.RMK 3 +call f:\utility\RMAKE32 %sys%.RMK + + rem call brow out.txt + +rem PAUSE + +rem CD.. +IF NOT ERRORLEVEL 1 GOTO PHASE2 + +rem call brow out.txt + +rem BEEP not available on WIN2000 +rem BEEP +rem BEEP +ECHO Error????????????? +GOTO END + +:PHASE2 + +echo Link Step > out.txt + rem CALL LNK + + +rem no -aa switch USED TO CREATE A CONSOLE MODE VERSION for debugger and gtwin.lib for debug console mode +rem // test - debug for xp / winnt ( NO -aa switch for console debugger) +rem ( -ap switch for console debugger) +rem pause + rem %bcc%\BIN\ilink32.exe -Gn -Tpe -s -Iobj32 -L%bcc% @%sys%.lnk + f:\prod\bcc582\BIN\ilink32.exe -Gn -Tpe -s -Iobj32 -Lf:\prod\bcc582 @%sys%.lnk + + +rem pause + + + +rem gtgui - no debug - production +rem // prod - no debug for xp / winnt + + REM %bcc%\BIN\ilink32.exe -Gn -aa -Tpe -s -Iobj32 -L%bcc% @%sys%.lnk +rem f:\prod\bcc582\BIN\ilink32.exe -Gn -aa -Tpe -s -Iobj32 -Lf:\prod\bcc582 @%sys%.lnk + + +ECHO Done! + +:END + + + + diff --git a/mh64.bat b/mh64.bat new file mode 100644 index 0000000..a4660da --- /dev/null +++ b/mh64.bat @@ -0,0 +1,86 @@ +@echo oFF + +@set oldpath=%path% +@set oldinclude=%include% +@set oldlib=%lib% +@set oldlibpath=%libpath% + +rem rem Visual C++ 2017 - as of 1/6/2019 +if exist "%ProgramFiles%\Microsoft Visual Studio\2019\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" call "%ProgramFiles%\Microsoft Visual Studio\2019\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" x86_amd64 +if exist "%ProgramFiles%\Microsoft Visual Studio\2019\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" GOTO CONTINUEPROCESS + +if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2019\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" call "%ProgramFiles(x86)%\Microsoft Visual Studio\2019\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" x86_amd64 +if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2019\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" GOTO CONTINUEPROCESS + +rem rem Visual C++ 2017 - as of 3/14/2019 +if exist "%ProgramFiles%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" call "%ProgramFiles%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" x86_amd64 +if exist "%ProgramFiles%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" GOTO CONTINUEPROCESS + +if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" call "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" x86_amd64 +if exist "%ProgramFiles(x86)%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build\vcvarsall.bat" GOTO CONTINUEPROCESS + +rem ********************* + +REM Visual C++ 2015 +if exist "%ProgramFiles%\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" call "%ProgramFiles%\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64 +if exist "%ProgramFiles%\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" GOTO CONTINUEPROCESS + +if exist "%ProgramFiles(x86)%\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" call "%ProgramFiles(x86)%\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" x86_amd64 +if exist "%ProgramFiles(x86)%\Microsoft Visual Studio 14.0\VC\vcvarsall.bat" GOTO CONTINUEPROCESS + + +:CONTINUEPROCESS + + +set sys=CGW64VC + +rem ************************************************************** +rem make resource vcCGW.RES for MicroSoft / VC +rem ************************************************************** + + + + +rem ************************************************************** +rem harbour v3.2 with fwh64-1903 16.05 and MicroSoft / VC +rem ************************************************************** + + +echo Compile step > out.txt + +DEL CGW64.EXE + + +:MAKE + +CALL f:\utility\RMAKE32 %sys%.RMK 3 + + + +IF NOT ERRORLEVEL 1 GOTO PHASE2 + + +ECHO Error????????????? +GOTO END + +:PHASE2 + +echo Link Step > out.txt + +link @%sys%.lnk /nologo /subsystem:windows /force:multiple /OUT:CGW64.EXE + + +IF NOT EXIST CGW64.EXE GOTO MAKE + +ECHO Done! + +:END + + + +@set path=%oldpath% +@set include=%oldinclude% +@set lib=%oldlib% +@set libpath=%oldlibpath% + +