:***********************************************************************: : TAMSII Interstore Stock Check - Remote Site : :=======================================================================: : : : COM210_T2.BA - Program Name : : : : Sybase Input - INVENTORY : : INVENTORY_STOCK : : SUPERSEDE : : SUPERSEDE_PART : : COMMUNICATION_DIRECTORY : : COMMUNICATION_USAGE : : END_OF_DAY_MONITOR : : STORE_PROFILE : : : : Output - MESSAGE to hold the Stock Checks, Item Orders, & : : Interstore Messages. : : : : Files/Tables - MESSAGE_HEADER : : Updated MESSAGE_PART : : MESSAGE_TEXT : : COMMUNICATION_DIRECTORY : : COMMUNICATION_USAGE : : ISLOG.PF : : ERROR_LOG : : : : Description : This program is the 'remote' or called up side of : : InterStore Communications. It responds to : : Inventory Queries from the Host machine and allows : : items to be put on 'order' in the message Tables. : : The Inventory Query responds with quantities and : : sheet pricing (and cost) for the item. It also : : accepts messages from the Host site (up to 55 : : characters per message). The message is allowed to : : be 'stand-alone' or associated with an item : : lookup/request. : : : : Notes : : : This program is accessed through a login of 'COMMS' : : at the "ACCOUNT-ID:" prompt in the HELLO program. : : : : The 'NO INPUT' Standard Error Routine is used in this : : program because it is attached to a modem port and : : there is no person to type BYE when the error : : message displays. : : : :***********************************************************************: : : : This is a description of the non-Unigen variables used in this : : program. : : : : CLASS$ - The uncrammed class of the Item being processed. : : EPART$ - The Extended Part Number of the Item being processed. : : CUST_ID - This is the customer number of the Host : : system. It is used in calculating prices & allowing the message : : to be invoiced. : : DESC$ - The Uncrammed Description of the Item being processed. : : ER - This is a flag that is used to state that the host timed out on : : the Interstore Session. : : I - Generic Loop Control Variable. : : LPART$ - This is the Line and Part Number of the last : : Item processed. : : LST - This is the List price of the Item (including Installer : : Pricing Calculations). : : PART - This is a flag that is used to determine if anything needs to : : be written to the MESSAGE_PART Table. : : MESS$ - This is the Message Text from the Host. : : NSW - This is the count of the number of 'inputs' accepted (with no : : timeout) between valid inputs. It is an attempt to strip line : : noise out of the input stream. : : OLDLN$ - This is the Uncrammed Line of the last Item processed. : : OUT$ - This is the string used to build output (going to the Host). : : PART$ - This is the Part Number requested by the Host. It is also : : used to create Message records. : : PRICE - This is the price selected for the item. : : PWRD$ - This is the Password that the Host uses in attempting to : : log onto the system. : : QTY - This is the numeric value of the quantity requested by the : : host. : : QTY$ - This is the string from the host that is meant to represent : : the quantity requested. : : STNO$ - This is the Store Number of the Host (calling) store. This : : is gotten from the COMM table, and the Host response has to match : : this value in order to login to do Interstore. : : SUPBUF$ - This is the string used to build the supersede information : : to the host. : : SUPER$ - This is a string (Y/N) that is sent to the host stating if : : there is Supersede information following the Item information. : : TIM - Time (in Seconds Past midnight) that the program starts. : : TOTTIM - Total connect time (in seconds) for the Interstore Session. : : X - Temporary Numeric Work Variable. : : X$ - Temporary String Work Variable. : : : :***********************************************************************: : Modification History : : : : 04/16/2024 : SOW : SDK - Disable/remove COM210.BA : : 03/27/2009 : DCS : [36659] : : Modified to use the shared procedure GET_PUT.SP to get : : the TEXT for the different languages. : : : : 03/23/2007 : RJF : [26294] : : The program created a messagePart record for the part viewed : : as well as the part ordered. For whatever reason, the program : : used to remember that it had found a part, and then when the : : next command came along, it saved the previous part in a : : message. If the 1st part is a query only, and the 2nd part is : : actually ordered (as in the superseded of the 1st part), the : : program was saving BOTH. I removed the save-last-part-found. : : Any partMessage that needs to be saved should be done when it : : is processed, not later! : : : : 01/16/2007 : RJF : [26302] : : If the part is not found, then clear the PART flag in the : : @PART_NOT_FOUND routine (when clearing PART$) so that an : : empty part is not written to the MESSAGE_PART table. : : : : 09/01/2006 : DCS : [27721] : : Replaced the T2_ERR.SL : : : : 07/14/2005 : RIM : Bug-20960 : : Corrected the skipping of logging just a message without a part : : This was caused by bug 16185 skipping if mode$ was first or : : last. I changed the mode$ to QUERY to force the write to the : : log. : : : : 04/29/2005 : RIM : [16291] : : Corrected prices for being called by a TAMS 5.0 system. Legacy : : expects 3330 and TAMSII sends 33300. : : : RIM : Bug [20142] : : Corrected the M_TYPE to be a O not a M. : : : : 09/16/2004 : JCF : [16185] : : Corrected problem with writing extra messages into the message : : files when doing the initial First and Last. : : : : : JCF : [13585] : : Removed unused variables. : : : : 02/03/2004 : JCF : : : Removed code that was preventing this program from sending a : : response to the calling system if the part did not have a : : supersede. Removed code that we had placed in the program : : to test a problem we had previously. : : : : 01/26/2004 : JCF : [12050] : : Modified program to not force an error when an entry in : : the translation file is not found. The missing label is : : returned as the text to be displayed. : : : : 09/11/2003 : JCF : [9532][9533][9534][9535] : : Corrected problems with files and fields not being : : updated when part queries or messages are sent to : : this program. (QAI fixes) : : : : 07/02/2003 : JCF : [7422] : : Modified to correct problem with sending a NULL in : : the INVOICE_QUANTITY field. We are now setting this : : field to be the same as the ORDER_QTY field. : : : : 12/12/2002 : JDS : [22721] : : Modified for db v0.23b MESSAGE table changes : : Modified for proper language usage : : : : 10/23/2002 : WOD : [22721] : : Write Program : : : :***********************************************************************: :.SL HISTORY Date Notes : : : : sp_getprice 05/23/2002 SQL routine. : : T2_ERROR.SP 10/04/2002 Silent. : : _t2_dbenv.sp 10/05/2002 entry point get_ipaddr : : T2_ERR.SL 08/31/2006 *** Modified ** : : fn_inventory_top_count 10/18/2002 SQL routine. : : : :***********************************************************************: 00010 REM : COM210 : Interstore Stock Check - Remote Site : 04/16/2024 : SOW : : Written : 10/23/2002 : WOD : 00020 REM - Copyright (c) 2024 By Genuine Parts Company (GPC) : 00030 DIR "/usr/tams/database" 00040 STMA 6,5 :Disable IKEY 00050 STMA 6,0 :no echo 00060 STMA 6,3 :Disable Column Counter 00070 ON ERR THEN GOSUB @UBL_ERR 00080 STMA 4,0,255 :deattach unenterable. 00090 STMA 4,1,255 :line cancel not enterable 00100 STMA 4,3,255 :delete character not enterable 00110 STMA 4,5,255 :secondary unpend not enterable 00120 STMA 4,4,13 :primary unpend to cr : : Dims for Standard Subroutines : : Dims for SQL Commands 00200 DIM CURNAM$[15],SQL$[1000],BUFF$[500],IFMT$[80],OFMT$[200] 00210 DIM PROG_ID$[14] :[13585] removed unused 00220 DIM TABLE_NAME$[128],TABLE_CD_ENT$[10] 00230 DIM TIMESTAMP$[26],IPADDR$[30] : : Dims for _GETPRICE servlet 00240 DIM PART$[22],PRCDCN$[1],CALCDS$[20],UNTRBT$[1] :[13585] removed unused : : Dims for Localized Language Text 00250 DIM LABEL$[80],TEXT$[254],JUST$[1],PRE_TEXT$[80],POST_TEXT$[80] 00260 DIM LANGUAGE$[2],RET$[512] : : Dims for Working Variables 00270 DIM T9$[616],BLANK$[80] :[13585] removed unused : : Dims for this program : 00400 DIM LN$[3],EPART$[26],DESC$[40],STNO$[9],MODE$[6] 00410 DIM X$[512],CLASS$[2],MESS$[55],OLDLN$[3],LPART$[25] 00420 DIM PWRD$[14],SUPER$[1],OUT$[512],QTY$[10] :[13585] removed unused 00430 DIM SUPBUF$[512],SED_BUF$[132],TAMSII$[1],M_TYPE$[1],MNT_IN_PROG$[1] 00440 DIM ST_RETAIL[3],DATE_STOCKED$[26],DATE_LAST_RCPT$[26] 00450 DIM REPORTABLE$[1],MSG_PART_STATUS$[1],IPPS[10] 00460 DIM FIRST_LN$[3],FIRST_PART$[22],LAST_LN$[3],LAST_PART$[22] 00461 DIM T10$[512],T11$[512] :[13585] Removed unused. : : : ***** Initialize Program Variables ***** 00500 LET T9$=FILL$(0) 00510 LET BLANK$=FILL$(ASC(" ")) 00520 LET QTY,PART,ER=0 00530 LET MESS$="" :message text 00540 LET LPART$=FILL$(0) :line & part 00550 LET PWRD$="" :password 00560 LET REF_COMM_TYPE=2 :interstore : 00600 LET LANGUAGE$="EN" :set default to English 00610 LET LOC=1 :set default Location 00620 LET ERR_FLG=0 :set error display off 00630 STMA 9,2,PROG_ID$ :get this program id 00640 STMA 14,PROG_ID$,0 :make upper case : : Setup Database Enviornment 00650 _t2_dbenv(LANGUAGE$,ERR_FLG,IER) :reset sybase 00660 _get_ipaddr(LANGUAGE$,ERR_FLG,IPADDR$) :get ip address 00670 LET PROG_ID$=TRUN$(PROG_ID$,1) : 00680 LET TABLE_NAME$="REF_FILE_ACTIVITY_PROGRAM_SOURCE",BLANK$ 00690 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 00700 LET CURNAM$="REF_PGM_SRC" \ SQL$="SELECT" :get id for this prog 00710 LET SQL$[0]=" id FROM ref_file_activity_program_source" 00720 LET SQL$[0]=" WHERE program_source = '",PROG_ID$,"'" : 00730 LET OFMT$="S4.0" \ IFMT$="" \ BUFF$="" 00740 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 00750 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 00760 IF NROWS=1 THEN 00770 LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR 00780 LET REF_FAPS_ID=ASC(BUFF$[1,4]) 00790 ELSE 00800 STMA 19,37 :program is missing 00810 END IF 00820 DELCUR("REF_PGM_SRC",IER) : 00830 LET T9$=FILL$(0) \ IER=0 00840 LET TIM=SYS(0) 00850 LET PRICE,LST,IDSW,IDTO=0 \ LENGTH=80 : : : ********************** : * MAIN Program Logic * : ********************** : :******* Get the language code ***** (old Status read) : 01000 LET TABLE_NAME$="STORE_PROFILE",BLANK$ 01010 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 01020 LET CURNAM$="GET_STORE" \ SQL$="SELECT" 01030 LET SQL$[0]=" loc, ref_language_cd" 01040 LET SQL$[0]=" FROM store_profile" : 01050 LET OFMT$="S4.0A2" 01060 LET IFMT$="" : 01070 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 01080 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 01090 IF NROWS=1 THEN 01100 LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR 01110 UNPACK "LA2",BUFF$,LOC,LANGUAGE$ 01120 ELSE 01130 LET LABEL$="COMM.COM210.STORE_PROFILE_MISSING" \ JUST$="L" 01140 GOSUB @GET_TEXT 01150 STMA 19,64 :Invalid Data Record 01160 END IF 01170 DELCUR ("GET_STORE",IER) : : Read System Files (old MONITOR file) : note: if maintenance is started after this program is in progress : it will NOT be detected. As of 10/04/2002 this is OK. : 01180 LET TABLE_NAME$="END_OF_DAY_MONITOR",BLANK$ 01190 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 01200 LET CURNAM$="GET_MONITOR" \ SQL$="SELECT" 01210 LET SQL$[0]=" maintenance_in_progress FROM end_of_day_monitor" 01220 LET SQL$[0]=" WHERE loc = ?" : 01230 LET OFMT$="A1" 01240 LET IFMT$="S4.0" 01250 PACK "ZL",BUFF$,LOC : 01260 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 01270 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 01280 IF NROWS THEN 01290 LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR 01300 UNPACK "A1",BUFF$,MNT_IN_PROG$ 01310 LET MNT_IN_PROG$=TRUN$(MNT_IN_PROG$,1) 01320 ELSE 01330 LET LABEL$="COMM.COM210.EOD_MONITOR_MISSING" \ JUST$="L" 01340 GOSUB @GET_TEXT 01350 STMA 19,64 : Invalid Data Record 01360 END IF 01370 DELCUR ("GET_MONITOR",IER) : :**** REQUEST ID FROM HOST **** : 01380 STMA 8,4 : flush input buffer 01390 FOR I=1 TO 40 01400 TINPUT 10,USING "","",X$; : gobble up input 01410 IF SYS(22)=0 THEN LET I=40 : got it all 01420 NEXT I 01430 STMA 8,1 : reset stack : :------------ @GET_PASSWORD :------------ 02000 PRINT "ID" 02010 LET NSW=0 \ PWRD$="" : noise input counter : 02020 $DO_WHILE NSW<10 AND LEN(PWRD$)=0 AND IDTO<2 02030 TINPUT 160,USING "","",PWRD$; : get from host 02040 IF SYS(22)=0 THEN : timed out 02050 LET IDTO=IDTO+1 : count num of timeouts 02060 ELSE 02070 NSW=NSW+1 : try 10 times 02080 END IF 02090 $END_DO : 02100 IF LEN(PWRD$)=0 AND IDTO<2 THEN GOTO @GET_PASSWORD : get two timeout trys : 02110 IF LEN(PWRD$)=0 THEN 02120 LET TEXT$,OUT$="ACCESS DENIED" 02130 GOTO @ERROR_OUT : TIME OUT WAITING FOR PASSWORD 02140 END IF : :**** VERIFY THE ID AGAINST THE COMMUNICATION DIRECTORY ***** : 02150 LET PWRD$[0]=BLANK$ 02160 IF POS(PWRD$,"AN ERROR H",1) THEN GOTO @HARD_EXIT : quit, the host system errored 02170 LET IDSW=IDSW+1 : times you look for id : 02180 LET TABLE_NAME$="COMMUNICATION_DIRECTORY",BLANK$ 02190 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 02200 LET CURNAM$="GET_PWD" \ SQL$="SELECT" 02210 LET SQL$[0]=" id, invoice_to_customer_id, store_using_tamsii" 02220 LET SQL$[0]=" FROM communication_directory" 02230 LET SQL$[0]=" WHERE loc = ? AND password = rtrim(?)" 02240 LET SQL$[0]=" AND ref_communication_type_id='2'" : 02250 LET OFMT$="S4.0S4.0A1" 02260 LET IFMT$="S4.0A14" 02270 PACK "ZLA14",BUFF$,LOC,PWRD$ : 02280 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 02290 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 02300 IF NROWS THEN 02310 LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR 02320 UNPACK "LLA1",BUFF$,CD_ID,CUST_ID,TAMSII$ 02330 ELSE 02340 IF IDSW>1 THEN : only get two trys 02350 LET TEXT$,OUT$="ACCESS DENIED" 02360 GOTO @ERROR_OUT 02370 END IF 02380 END IF 02390 DELCUR ("GET_PWD",IER) : 02400 IF NROWS=0 THEN GOTO @GET_PASSWORD : try one more time : : :***** ID IS RIGHT! GET THE STORE NUMBER OF THE HOST **** 02410 LET STNO$=PWRD$[1,6] : store number : 02420 IF LEN(MNT_IN_PROG$) THEN : remote system not available 02430 TEXT$,OUT$="SYSTEM NOT AVAILABLE" 02440 GOTO @ERROR_OUT 02450 END IF : :***** SET UP MESSAGE TO SHOW LOG ON ***** : :***** Verify Customer ID is valid or Customer zero is valid 02500 IF CUST_ID THEN 02510 LET TABLE_NAME$="CUSTOMER",BLANK$ 02520 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 02530 LET CURNAM$="GET_CUST" \ SQL$="SELECT" 02540 LET SQL$[0]=" customer_num FROM customer 02550 LET SQL$[0]=" WHERE loc = ? AND id = ?" : 02560 LET OFMT$="S4.0" 02570 LET IFMT$="S4.0S4.0 02580 PACK "ZLL",BUFF$,LOC,CUST_ID : 02590 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 02600 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 02610 IF NROWS THEN 02620 LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR 02630 UNPACK "L",BUFF$,CUST_NUM 02640 ELSE 02650 LET CUST_ID,CUST_NUM=0 02660 END IF 02670 DELCUR ("GET_CUST",IER) 02680 END IF : 02700 IF NOT CUST_ID THEN 02710 LET CUST_NUM=0 02720 LET TABLE_NAME$="COMMUNICATION_DIRECTORY",BLANK$ 02730 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 02750 LET CURNAM$="GET_CUST" \ SQL$="SELECT" 02760 LET SQL$[0]=" id FROM customer 02770 LET SQL$[0]=" WHERE loc = ? AND customer_num = ?" : 02780 LET OFMT$="S4.0" 02790 LET IFMT$="S4.0S4.0 02800 PACK "ZLL",BUFF$,LOC,CUST_NUM : 02810 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 02820 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 02830 IF NROWS THEN 02840 LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR 02850 UNPACK "L",BUFF$,CUST_ID 02860 END IF 02870 DELCUR ("GET_CUST",IER) 02880 END IF : 02900 IF CUST_ID = 0 THEN : Could not validate customer 02910 LET TEXT$,OUT$="ACCESS DENIED" 02920 GOTO @ERROR_OUT 02930 END IF : 02940 PRINT "OK" : tell host id was OK : : Now, mark the last_login_date in COMMUNICATION_DIRECTORY to the : current timestamp. 02950 LET TABLE_NAME$="COMMUNICATION_DIRECTORY",BLANK$ 02960 LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : 02970 LET CURNAM$="UPD_COMM" \ SQL$="UPDATE communication_directory" 02980 LET SQL$[0]=" SET last_login_date = CURRENT TIMESTAMP" 02990 LET SQL$[0]=" WHERE loc = ? AND password = rtrim(?)" 03000 LET SQL$[0]=" AND ref_communication_type_id='2'" : 03010 LET OFMT$="S4.0S4.0A1" 03020 LET IFMT$="S4.0A14" 03030 PACK "ZLA14",BUFF$,LOC,PWRD$ : 03040 LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR 03050 LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : 03060 DELCUR ("UPD_COMM",IER) : 03070 LET M_TYPE$="M" : record for logon 03080 LET PART$="" 03090 GOSUB @GET_SERVER_TIMESTAMP 03100 LET LABEL$="COMM.COM210.LOGON_OK_DATE_TIME" 03110 GOSUB @GET_TEXT 03120 MESS$=TEXT$," ",TIMESTAMP$ 03130 GOSUB @LOG_MESSAGE : log message : : Find Boundaries in Inventory 03140 LET MODE$="FIRST" 03150 GOSUB @GET_INVENTORY 03160 LET FIRST_LN$=LN$,BLANK$ 03170 LET FIRST_PART$=PART$,BLANK$ : save first part in DB : 03180 LET MODE$="LAST" 03190 GOSUB @GET_INVENTORY 03200 LET LAST_LN$=LN$,BLANK$ 03210 LET LAST_PART$=PART$ : save last part in DB : 03220 LET LN$=BLANK$ \ PART$=BLANK$ : :--------------- @INPUT_FROM_HOST :--------------- STMA 8,3 : clear IKEY Flag NSW=0 : noise retry counter $DO_WHILE NSW<100 NSW=NSW+1 TINPUT 1800,USING "","",X$; IF SYS(22)=0 OR NSW=99 THEN : timed out LET ER=1 : pgm error flag GOTO @LOGOFF : drop the line and log off END IF IF LEN(TRUN$(X$,1)) THEN LET NSW=100 $END_DO : LET X$[0]=BLANK$ : X$ needs 10 char or more IF X$[1,4]="#BYE" THEN GOTO @LOGOFF : drop the line and log off IF X$[1,4]="#MSG" THEN GOTO @PARSE_MSG : set up message IF X$[1,13]="AN ERROR HAS " THEN ER=1 \ GOTO @LOGOFF : Quit, Host Errored Out :[26294] the next line removed as it was saving the valid part, even if it was a query-only. : IF PART THEN LET M_TYPE$="O" \ GOSUB @LOG_MESSAGE : write to message [20142] IF POS(X$,"(FIRST)",1) THEN GOTO @GET_FIRST_PART : first part IF POS(X$,"(PREV)",1) THEN GOTO @GET_PREV_PART : previous part IF POS(X$,"(LAST)",1) THEN GOTO @GET_LAST_PART : last part IF POS(X$,"(NEXT)",1) THEN GOTO @GET_NEXT_PART : next part IF TRUN$(X$[4],1)="" THEN GOTO @GET_NEXT_PART : next select legacy : :***** Look up part in inventory **** LET LN$=X$[1,3] : line_abbrev IF TRUN$(LN$,1)="" THEN LET LN$=OLDLN$ : default line_abbrev LET PART$=TRUN$(X$[4],1) : part_number LET MODE$="QUERY" GOSUB @GET_INVENTORY : select inventory IF INV_ROWS=0 THEN GOTO @PART_NOT_FOUND GOTO @SET_DEFAULTS : :-------------- @GET_FIRST_PART :-------------- LET LN$=BLANK$[1,3] : line_abbrev LET PART$="" : force 1st part in line LET MODE$="FIRST" GOSUB @GET_INVENTORY : select inventory IF INV_ROWS=0 THEN GOTO @PART_NOT_FOUND GOTO @SET_DEFAULTS : :-------------- @GET_NEXT_PART :-------------- LET LN$=X$[1,3] IF LN$=LAST_LN$ AND PART$=LAST_PART$ THEN GOTO @PART_NOT_FOUND IF LN$<>OLDLN$ THEN LET PART$=BLANK$ LET MODE$="NEXT" GOSUB @GET_INVENTORY : select inventory IF INV_ROWS=0 THEN GOTO @PART_NOT_FOUND GOTO @SET_DEFAULTS : :-------------- @GET_PREV_PART :-------------- LET LN$=X$[1,3] : line_abbrev IF LN$=FIRST_LN$ AND PART$=FIRST_PART$ THEN GOTO @PART_NOT_FOUND IF LN$<>OLDLN$ OR TRUN$(PART$,1)="" THEN LET PART$="ZZZZZZZZZZZZZZZZZZZZZZ" LET MODE$="PREV" GOSUB @GET_INVENTORY : select inventory IF INV_ROWS=0 THEN GOTO @PART_NOT_FOUND GOTO @SET_DEFAULTS : :-------------- @GET_LAST_PART :-------------- LET LN$="ZZZ" : line_abbrev LET MODE$="LAST" GOSUB @GET_INVENTORY IF INV_ROWS=0 THEN GOTO @PART_NOT_FOUND : :------------ @SET_DEFAULTS :------------ LET DESC$=TRUN$(DESC$,1) : shorten it LET CLASS$=TRUN$(CLASS$,1) : shorten it too LET OLDLN$=LN$ : hold the line LET LPART$=LN$,PART$,FILL$(0) : save this for later : : message to be written LET PART=1 \ MSG_PART_STATUS$="" : this means that if the : : #MSG then write the : : part reviewed message. : : IPPS[9] = COST IPPS[1] = LIST IPPS[2] = RED IPPS[10]=CORE COST : IPPS[3] = YELLOW IPPS[4] = GREEN IPPS[5] = PINK : IPPS[6] = MINSTALLr IPPS[7] = BLUE IPPS[8] = CORE PRICE : GOSUB @GET_STOCK : read inventory_stock : GOSUB @GET_PRICE : LET HOLD_PRICE=PRICE : supersede uses these LET HOLD_LST=LST : hold until after super- LET HOLD_CORPRC=CORPRC : sede routine : :**** FORMAT RESPONSE TO HOST **** : IF TAMSII$="Y" THEN : remote is TAMSII LET OUT$="!",",",ON_HAND,",",WIP,",",CLASS$,",",GROUP_CODE,",",DESC$,"," LET OUT$[0]=SUPPLIER,",",ST_GROUP,",",DEPT,",",SUB_DEPT,"," LET OUT$[0]=IPPS[1],",",IPPS[2],",",IPPS[3],",",IPPS[4],",",IPPS[5],"," LET OUT$[0]=IPPS[6],",",IPPS[7],",",IPPS[8],",",IPPS[9],",",IPPS[10],"," LET OUT$[0]=ST_RETAIL[1],",",ST_RETAIL[2],",",ST_RETAIL[3],",",MIN_QTY,"," LET OUT$[0]=MAX_QTY,",",ON_ORDER,",",ON_BO,",",ON_FORDER,"," LET OUT$[0]=TRUN$(DATE_STOCKED$,1),",",TRUN$(DATE_LAST_RCPT$,1),",",LN$,"," LET OUT$[0]=TRUN$(EPART$,1),"," ELSE :remote is a legacy system TAMS 5.0 LET OUT$="!",",",ON_HAND,",",WIP,",",CLASS$,",",GROUP_CODE,",",DESC$,"," LET OUT$[0]=IPPS[1]/10,",",IPPS[2]/10,",",IPPS[3]/10,",",IPPS[4]/10,",",IPPS[5]/10,"," LET OUT$[0]=IPPS[6]/10,",",IPPS[7]/10,",",IPPS[8]/10,"," LET OUT$[0]=IPPS[9]/10,",",IPPS[10]/10,",",LN$,",",TRUN$(EPART$,1),"," END IF : :***** SUPERSEDE **** LET LN$[0]=BLANK$ \ PART$[0]=BLANK$ : LET TABLE_NAME$="SUPERSEDE_PART",BLANK$ LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : LET CURNAM$="GET_SEDE" \ SQL$="SELECT" LET SQL$[0]=" supersede_part.ref_supersede_type_id," LET SQL$[0]=" supersede_part.superseding_line_abbrev, LET SQL$[0]=" supersede_part.superseding_part_number," LET SQL$[0]=" inventory.description," LET SQL$[0]=" inventory_stock.minimum_stock_qty," LET SQL$[0]=" inventory_stock.maximum_stock_qty," LET SQL$[0]=" inventory_stock.on_hand," LET SQL$[0]=" inventory_stock.work_in_progress," LET SQL$[0]=" inventory_stock.on_order," LET SQL$[0]=" inventory_stock.on_backorder," LET SQL$[0]=" inventory_stock.on_factory_order" LET SQL$[0]=" FROM supersede_part, supersede, inventory, inventory_stock" LET SQL$[0]=" WHERE supersede_part.loc = ?" LET SQL$[0]=" AND supersede.line_abbrev = rtrim(?)" LET SQL$[0]=" AND supersede.part_number = rtrim(?)" LET SQL$[0]=" AND supersede_part.supersede_id = supersede.id" LET SQL$[0]=" AND supersede_part.loc = supersede.loc" LET SQL$[0]=" AND ISNULL(effective_start_date,CURRENT DATE) <= CURRENT DATE" LET SQL$[0]=" AND ISNULL(effective_until_date,CURRENT DATE) >= CURRENT DATE" LET SQL$[0]=" AND supersede_part.loc = inventory.loc" LET SQL$[0]=" AND superseding_line_abbrev = inventory.line_abbrev" LET SQL$[0]=" AND superseding_part_number = inventory.part_number" LET SQL$[0]=" AND inventory_stock.loc = inventory.loc" LET SQL$[0]=" AND inventory_stock.inventory_id = inventory.id" : LET OFMT$="S4.0 A3 A22 A40 S4.0 S4.0 S4.2 S4.2 S4.0 S4.0 S4.0" LET IFMT$="S4.0 A3 A22" PACK "ZLA3A22",BUFF$,LOC,LN$,PART$ : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : LET SEDE_ROWS=NROWS \ SENT_OUT,ROW=0 \ SUPBUF$="" \ SUPER$="N" : $DO_WHILE SEDE_ROWS>0 LET SUPER$="Y" LET CURNAM$="GET_SEDE" : reset after sp_getprice LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "LA3A22A40LLLLLLL",BUFF$,SS_TYPE,LN$,PART$,DESC$,MIN_QTY,MAX_QTY,OH_QTY,WIP_QTY,ON_ORDER,ON_BO,ON_FORDER LET ON_ORDER=ON_ORDER+ON_BO+ON_FORDER : total on order GOSUB @GET_PRICE : call sp_getprice IF TAMSII$="Y" THEN LET SED_BUF$=SS_TYPE,",",LN$,",",TRUN$(PART$,1),",",TRUN$(DESC$,1),"," LET SED_BUF$[0]=OH_QTY,",",WIP_QTY,",",PRICE,",",MIN_QTY,",",MAX_QTY,"," LET SED_BUF$[0]=ON_ORDER LET SUP_BUF_LEN=SUP_BUF_LEN+LEN(TRUN$(SED_BUF$,1)) IF SUP_BUF_LEN>125 THEN : send what we have LET SUPBUF$[0]="|" : more to send IF NOT SENT_OUT THEN : has OUT$ been sent WRITE OUT$,SUPER$,"<13><10>" : send to host LET SENT_OUT=1 : OUT$ has been sent END IF WRITE SUPBUF$,"<13><10>" : send to host LET SUPBUF$="" END IF IF SUPBUF$>"" THEN LET SUPBUF$[0]="|" : multiple supersede separator END IF LET SUPBUF$[0]=TRUN$(SED_BUF$,1) : build Supersede buffer LET SUP_BUF_LEN=LEN(SUPBUF$) : keep track of length ELSE LET ROW=ROW+1 : tams 5 only gets 2 IF ROW=1 THEN LET SUPBUF$=SS_TYPE,",",LN$,",",TRUN$(PART$,1) ELSE LET SUPBUF$[0]=",",LN$,",",TRUN$(PART$,1) LET SEDE_ROWS=1 : tams 5 stop after 2 END IF END IF LET SEDE_ROWS=SEDE_ROWS-1 : fetch count $END_DO : DELCUR ("GET_SEDE",IER) : : :**** FORMAT RESPONSE TO HOST **** : LET OUT$[0]=SUPER$ LET LN$=LPART$[1,3] : replace line abbrev LET PART$=LPART$[4] : replace part num LET PRICE=HOLD_PRICE LET LST=HOLD_LST LET CORPRC=HOLD_CORPRC : :----------- @SEND_OUTPUT :----------- IF SENT_OUT=0 THEN :[16185] WRITE OUT$,"<13><10>" :[16185] send to host END IF :[16185] : IF SUPER$="Y" THEN : if supersede WRITE SUPBUF$,"<13><10>" : print straight END IF LET QTY=0 GOTO @INPUT_FROM_HOST : get next request from host : :****** PART NOT ON FILE (EXACT PART WAS WANTED) ***** :-------------- @PART_NOT_FOUND :-------------- LET TEXT$,OUT$="PART NOT ON FILE" LET M_TYPE$="M" \ MSG_PART_STATUS$="N" \ PART$=BLANK$ \ SUPER$="N" LET REPORTABLE$="N" \ PART,PRICE,LST,CORPRC,QTY=0 GOSUB @LOG_MESSAGE GOTO @SEND_OUTPUT : send to the host : :***** PASSWORD NOT ON FILE OR TIME OUT ON LOG-ON **** :--------- @ERROR_OUT :--------- LET OUT$=TEXT$ PRINT OUT$ :--------- @HARD_EXIT :--------- CHAIN "HELLO1" : :***** DROP THE LINE AND FINISH UP **** :------ @LOGOFF :------ IF PART THEN LET M_TYPE$="M" GOSUB @LOG_MESSAGE : write to message END IF : LET UPDATE_HEADER=1 \ M_TYPE$="M" : log-off message to file IF SET_ORDER THEN LET M_TYPE$="O" : update header to Order GOSUB @GET_SERVER_TIMESTAMP LET LABEL$="COMM.COM210.LOGOFF_OK_DATE_TIME" GOSUB @GET_TEXT LET MESS$=TEXT$," ",TIMESTAMP$ IF ER THEN LET LABEL$="COMM.COM210.LOGOFF_TIMEOUT_DATE_TIME" GOSUB @GET_TEXT LET MESS$=TEXT$," ",TIMESTAMP$ END IF : GOSUB @LOG_MESSAGE : log message GOTO @UPDATE_PHONE_INFO : with time online : : :****** SEPARATE THE QTY AND MESSAGE **** :--------- @PARSE_MSG :--------- LET QTY$="" \ QTY=0 LET I=POS(X$,",",5) LET QTY$=X$[5,I-1] IF LEN(X$)>I+1 THEN LET MESS$=X$[I+1,LEN(X$)] : remainder of the string END IF : is the message : LET QTY=VAL(QTY$,IER) IF IER<>0 THEN LET QTY=0 : if err qty=0 IF QTY>ON_HAND THEN LET MSG_PART_STATUS$="Q" : questionable ELSE LET MSG_PART_STATUS$="Y" : yes END IF LET M_TYPE$="O" : assume order IF NOT PART THEN : if no message LET M_TYPE$="M" \ MODE$="QUERY" : set to message END IF PRINT "OK" : handshake to host : GOSUB @LOG_MESSAGE : log message GOTO @INPUT_FROM_HOST : get another part : :----------------- @UPDATE_PHONE_INFO :----------------- LET TOTTIM=(SYS(0)-TIM) IF TOTTIM<0 THEN LET TOTTIM=TOTTIM+86400 : connected past midnight IF TOTTIM=0 THEN TOTTIM=1 : less than a minute is a minute LET TABLE_NAME$="COMMUNICATION_USAGE",BLANK$ LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR : LET CURNAM$="UPDATE_USAGE" \ SQL$="UPDATE communication_usage" LET SQL$[0]=" SET total_calls = total_calls + 1," LET SQL$[0]=" total_seconds = total_seconds + ?" LET SQL$[0]=" WHERE communication_usage.loc = ?" LET SQL$[0]=" AND communication_usage.communication_directory_id = ?" LET SQL$[0]=" AND communication_usage.year_month =" LET SQL$[0]=" (SELECT store_profile.current_sales_year_month" LET SQL$[0]=" FROM store_profile" LET SQL$[0]=" WHERE store_profile.loc = ?)" : LET IFMT$="S4.0 S4.0 S4.0 S4.0" \ OFMT$="" PACK "ZLLLL",BUFF$,TOTTIM,LOC,CD_ID,LOC : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : IF NOT NROWS THEN : add new record LET TABLE_NAME$="COMMUNICATION_USAGE",BLANK$ \ GOSUB @REF_FILE_ACTIVITY LET TABLE_ID_ENT=0 \ TABLE_CD_ENT$="" LET TABLE_I2_ENT=LOC GOSUB @GET_SEQ_ID : LET TABLE_ID_ENT=ID LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR : LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" LET CURNAM$="INSERT_USAGE" \ SQL$="INSERT INTO communication_usage" LET SQL$[0]=" (id, loc, communication_directory_id, year_month," LET SQL$[0]=" total_calls, total_seconds)" LET SQL$[0]=" VALUES (?,?,?," LET SQL$[0]=" (SELECT current_sales_year_month" LET SQL$[0]=" FROM store_profile" LET SQL$[0]=" WHERE store_profile.loc = ?)" LET SQL$[0]=" ,'1',?)" : LET IFMT$="S4.0 S4.0 S4.0 S4.0 S4.0" \ OFMT$="" PACK "ZLLLLL",BUFF$,ID,LOC,CD_ID,LOC,TOTTIM : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : DELCUR ("INSERT_USAGE",IER) END IF LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN LET SQL_LINE=SYS(201) \ ROLLBACK (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR GOTO @SQL_FILE END IF DELCUR ("UPDATE_USAGE",IER) : :**** Log out **** : CHAIN "HELLO1" : :*****************************************************************************: : Subroutines for this Program *: :*****************************************************************************: :============= @GET_INVENTORY :============= LET LN$[0]=BLANK$ \ PART$[0]=BLANK$ INV_ROWS=0 : next : IF MODE$="QUERY" THEN GOTO @BYPASS_COUNT :bypass for exact part : : Count first to avoid error - because SELECT FIRST or SELECT TOP 1 : will always be true even if no rows qualified : LET CURNAM$="COUNT_INV" \ SQL$="SELECT COUNT(*)" LET SQL$[0]=" FROM inventory" LET SQL$[0]=" WHERE loc = ?" LET IFMT$="S4.0" : IF MODE$="NEXT" THEN LET SQL$[0]=" AND (line_abbrev = rtrim(?) AND part_number > rtrim(?))" LET SQL$[0]=" OR line_abbrev > rtrim(?)" LET IFMT$[0]="A3A22A3" END IF IF MODE$="PREV" THEN LET SQL$[0]=" AND (line_abbrev = rtrim(?) AND part_number < rtrim(?))" LET SQL$[0]=" OR line_abbrev < rtrim(?)" LET IFMT$[0]="A3A22A3" END IF : PACK "ZLA3A22A3",BUFF$,LOC,LN$,PART$,LN$ : safe for all modes : LET OFMT$="S4.0" : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "L",BUFF$,INV_ROWS DELCUR ("COUNT_INV") END IF :[16185] : IF INV_ROWS=0 THEN GOTO @BYPASS_GET : @BYPASS_COUNT : LET TABLE_NAME$="INVENTORY",BLANK$ LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : LET CURNAM$="GET_INV" \ SQL$="SELECT" IF MODE$<>"QUERY" THEN LET SQL$[0]=" FIRST" LET SQL$[0]=" id,line_abbrev,part_number,expanded_part_number,description," LET SQL$[0]=" store_group_id, department_id, sub_department_id," LET SQL$[0]=" current_year_ref_class_cd,group_code,supplier_id,reportable," LET SQL$[0]=" list, red, yellow, green, pink, master_installer, blue," LET SQL$[0]=" core_price, cost, core_cost, store_retail_price1," LET SQL$[0]=" store_retail_price2, store_retail_price3 FROM inventory" LET SQL$[0]=" WHERE loc = ?" LET IFMT$="S4.0" : IF MODE$="QUERY" THEN LET SQL$[0]=" AND line_abbrev = rtrim(?)" LET SQL$[0]=" AND part_number = rtrim(?)" LET IFMT$[0]="A3A22" END IF IF MODE$="NEXT" THEN LET SQL$[0]=" AND (line_abbrev = rtrim(?) AND part_number > rtrim(?))" LET SQL$[0]=" OR line_abbrev > rtrim(?)" LET IFMT$[0]="A3A22A3" END IF IF MODE$="PREV" THEN LET SQL$[0]=" AND (line_abbrev = rtrim(?) AND part_number < rtrim(?))" LET SQL$[0]=" OR line_abbrev < rtrim(?)" LET IFMT$[0]="A3A22A3" END IF : IF MODE$="PREV" OR MODE$="LAST" THEN LET SQL$[0]=" ORDER BY line_abbrev DESC, part_number DESC" ELSE LET SQL$[0]=" ORDER BY line_abbrev, part_number" END IF : PACK "ZLA3A22A3",BUFF$,LOC,LN$,PART$,LN$ :safe for all modes : LET OFMT$="S4.0 A3 A22 A26 A40 S4.0 S4.0 S4.0 A2 S4.0 S4.0 A1 S6.4 S6.4" LET OFMT$[0]="S6.4 S6.4 S6.4 S6.4 S6.4 S6.4 S6.4 S6.4 S6.4 S6.4 S6.4" : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : IF MODE$="QUERY" THEN LET INV_ROWS=NROWS IF INV_ROWS THEN LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "LA3A22A26A40LLLA2LLA1N*10N*3",BUFF$,INVENTORY_ID,LN$,PART$,EPART$,DESC$,ST_GROUP,DEPT,SUB_DEPT,CLASS$,GROUP_CODE,SUPPLIER,REPORTABLE$,IPPS[1],ST_RETAIL[1] END IF DELCUR ("GET_INV") : @BYPASS_GET : RETURN : :-----------------------------------------------------------------------------: :========= @GET_STOCK :========= LET TABLE_NAME$="INVENTORY_STOCK",BLANK$ LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : LET CURNAM$="GET_STK" \ SQL$="SELECT" LET SQL$[0]=" initial_stocking_date, last_receipt_date," LET SQL$[0]=" minimum_stock_qty, maximum_stock_qty," LET SQL$[0]=" on_hand, work_in_progress, on_order," LET SQL$[0]=" on_backorder, on_factory_order FROM inventory_stock" LET SQL$[0]=" WHERE inventory_id = ? AND loc = ?" : LET OFMT$="A26 A26 S4.0 S4.0 S6.2 S6.2 S4.0 S4.0 S4.0" LET IFMT$="S4.0 S4.0" PACK "ZLL",BUFF$,INVENTORY_ID,LOC : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : IF NROWS THEN LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "A26A26LLNNLLL",BUFF$,DATE_STOCKED$,DATE_LAST_RCPT$,MIN_QTY,MAX_QTY,ON_HAND,WIP,ON_ORDER,ON_BO,ON_FORDER ELSE LET DATE_STOCKED$,DATE_LAST_RCPT$="" \ MIN_QTY,MAX_QTY,ON_HAND,WIP=0 LET ON_ORDER,ON_BO,ON_FORDER=0 END IF DELCUR ("GET_STK",IER) : RETURN : :-----------------------------------------------------------------------------: :***** WRITE TO MESSAGE Tables ***** :=========== @LOG_MESSAGE:1 :=========== :[16185] Don't process the first and last messages... IF MODE$="FIRST" OR MODE$="LAST" THEN RETURN :[16185] : LET PART_SEQ=0 IF M_TYPE$="O" THEN :order message LET SET_ORDER=1 :set header type to 'O' END IF :when logoff : : Message header. IF NOT MSG_HEADER_ID THEN LET TABLE_NAME$="MESSAGE_HEADER",BLANK$ \ GOSUB @REF_FILE_ACTIVITY LET TABLE_ID_ENT=0 \ TABLE_CD_ENT$="" LET TABLE_I2_ENT=LOC GOSUB @GET_SEQ_ID : LET TABLE_ID_ENT=ID LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR : LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" LET CURNAM$="INSERT_MESSH" \ SQL$="INSERT INTO message_header" LET SQL$[0]=" (id,loc,ref_communication_type_id,store_number," LET SQL$[0]=" customer_number, logon_date,logoff_date," LET SQL$[0]=" acknowledged_by_employee_id, acknowledged_date, message_type)" LET SQL$[0]=" VALUES (?,?,?,rtrim(?),?,CURRENT TIMESTAMP,NULL,NULL,NULL,?)" : LET IFMT$="S4.0 S4.0 S4.0 A6 S4.0 A1" \ OFMT$="" PACK "ZLLLA6LA1",BUFF$,ID,LOC,REF_COMM_TYPE,STNO$,CUST_NUM,M_TYPE$ : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : DELCUR ("INSERT_MESSH",IER) LET MSG_HEADER_ID=ID \ UPDATE_HEADER=0 : LET TABLE_NAME$="BEEP_MONITOR",BLANK$ \ GOSUB @REF_FILE_ACTIVITY LET TABLE_ID_ENT=0 \ TABLE_CD_ENT$="" LET TABLE_I2_ENT=LOC : LET CURNAM$="UPDATE_BEEP" \ SQL$="UPDATE beep_monitor" LET SQL$[0]=" SET interstore = 'Y'" LET SQL$[0]=" WHERE loc = ?" : LET IFMT$="S4.0" \ OFMT$="" PACK "ZL",BUFF$,LOC : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : DELCUR ("UPDATE_BEEP",IER) : END IF : : Message part. IF PART THEN LET TABLE_NAME$="MESSAGE_PART",BLANK$ \ GOSUB @REF_FILE_ACTIVITY LET TABLE_ID_ENT=0 \ TABLE_CD_ENT$="" LET TABLE_I2_ENT=0 LET SEQ=SEQ+1 \ PART_SEQ=SEQ : LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR : LET CURNAM$="INSERT_MESSP" \ SQL$="INSERT INTO message_part" LET SQL$[0]=" (message_header_id, sequence, loc, line_abbrev," LET SQL$[0]=" part_number, order_qty, ref_message_part_status_cd," LET SQL$[0]=" invoice_quantity, invoice_number, quoted_price, list_price," LET SQL$[0]=" core_price, reportable, process_method, processed_date," LET SQL$[0]=" processed_by_employee_id)" : IF MSG_PART_STATUS$="" THEN LET SQL$[0]=" VALUES (?,?,?,rtrim(?),rtrim(?),?,NULL," LET IFMT$="S4.0 S4.0 S4.0 A3 A22 S4.2 S 4.2 S6.4 S6.4 S6.4 A1" PACK "ZLLLA3A22LLNNNA1",BUFF$,MSG_HEADER_ID,SEQ,LOC,LN$,PART$,QTY,QTY,PRICE,LST,CORPRC,REPORTABLE$ ELSE LET SQL$[0]=" VALUES (?,?,?,rtrim(?),rtrim(?),?,rtrim(?)," LET IFMT$="S4.0 S4.0 S4.0 A3 A22 S4.2 A1 S4.2 S6.4 S6.4 S6.4 A1" PACK "ZLLLA3A22LA1LNNNA1",BUFF$,MSG_HEADER_ID,SEQ,LOC,LN$,PART$,QTY,MSG_PART_STATUS$,QTY,PRICE,LST,CORPRC,REPORTABLE$ END IF LET SQL$[0]=" ?,NULL,?,?,?,rtrim(?),NULL,NULL,NULL)" : LET OFMT$="" LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : IF SQL_STAT<>0 THEN GOTO @SQL_ERR DELCUR ("INSERT_MESSP",IER) END IF : : Message text. IF TRUN$(MESS$,1)<>"" THEN :[16185] make sure we have a message LET TABLE_NAME$="MESSAGE_TEXT",BLANK$ \ GOSUB @REF_FILE_ACTIVITY LET TABLE_ID_ENT=0 \ TABLE_CD_ENT$="" LET TABLE_I2_ENT=0 LET SEQ=SEQ+1 \ PART_SEQ=0 \ MESS$[0]=BLANK$ : LET CURNAM$="INSERT_MESST" \ SQL$="INSERT INTO message_text" LET SQL$[0]=" (message_header_id, sequence, loc," LET SQL$[0]=" attached_to_message_part_sequence, text)" LET SQL$[0]=" VALUES (?,?,?,rtrim(?),rtrim(?))" : LET IFMT$="S4.0 S4.0 S4.0 S4.0 A55" \ OFMT$="" PACK "ZLLLLA55",BUFF$,MSG_HEADER_ID,SEQ,LOC,PART_SEQ,MESS$ : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : IF SQL_STAT<>0 THEN GOTO @SQL_ERR : DELCUR ("INSERT_MESST",IER) END IF LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN LET SQL_LINE=SYS(201) \ ROLLBACK (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR GOTO @SQL_FILE END IF : LET MESS$="" \ QTY,PART=0 IF UPDATE_HEADER THEN LET TABLE_NAME$="MESSAGE_HEADER",BLANK$ LET TABLE_ID_ENT=0 \ TABLE_CD_ENT$="" LET TABLE_I2_ENT=0 : LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR : LET CURNAM$="UPDATE_MESSH" \ SQL$="UPDATE message_header" LET SQL$[0]=" SET logoff_date = CURRENT TIMESTAMP, message_type = rtrim(?)" LET SQL$[0]=" WHERE id = ? AND loc = ?" : LET IFMT$="A1 S4.0 S4.0" \ OFMT$="" PACK "ZA1LL",BUFF$,M_TYPE$,MSG_HEADER_ID,LOC : LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : DELCUR ("UPDATE_MESSH",IER) LET SQL_LINE=SYS(201) \ COMMIT (SQL_STAT) IF SQL_STAT THEN LET SQL_LINE=SYS(201) \ ROLLBACK (SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR GOTO @SQL_FILE END IF END IF RETURN : :----------------------------------------------------------------------------- :========= @GET_PRICE :========= LET LN$[0]=BLANK$ \ PART$[0]=BLANK$ : LET PRCDCN$,CALCDS$,UNTRBT$="" :[13585] removed unused LET RETCD,LSTPRC,UNTPRC,MARKUP,UNTCST,UNTRBT,CORCST,CORPRC=0 LET USUAL,CUSTOM,SPECIL=0 QTYBLL=QTY IF QTYBLL=0 THEN LET QTYBLL = 100 : :LET TABLE_NAME$="sp_getprice",BLANK$ :LET TABLE_ID_ENT,TABLE_I2_ENT=0 \ TABLE_CD_ENT$="" : :LET CURNAM$="GET_PRICE" \ SQL$="CALL sp_getprice" :LET SQL$[0]=" (?, ?, ?, rtrim(?), rtrim(?), ?," :LET SQL$[0]="'','','','','','','','','','','','','','','','','','','','',''," :LET SQL$[0]="'','','','')" : :route to servlet call [SPP-47] : LET T10$="wget -q -O'com210http' 'http://localhost:8080/TAMSII/Servlets/getPrice" LET T10$[0]="?CUSTOMER_NUMBER=0" LET T10$[0]="&PART_NUMBER=",TRUN$(PART$,1) LET T10$[0]="&LINE_ABBREV=",TRUN$(LINE$,1) LET T10$[0]="&LOC=",LOC LET T10$[0]="' 2>/dev/null" $EXECUTE T10$,T11$,IER T10$="cat com210http" $EXECUTE T10$,T11$,IER LET T11$=TRUN$(T11$,1) DELETE IER,"com210http" : :LET OFMT$="S6.4 S6.4 A1 A20 S4.2 S6.4 A1 S6.4 S6.4 S6.4 S6.4 S6.4 " :LET OFMT$[0]="S6.4 A2 A15 S6.4 S6.4 A1 A2" :LET IFMT$="S4.0 S4.0 S4.4 A3 A22 A1" :PACK "ZLLLA3A22A1",BUFF$,LOC,CUST_ID,QTYBLL,LN$,PART$,"N" : :LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR :LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR : :LET SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR : : LET UNTPRC,CORPRC,USUAL,CUSTOM,SPECIL=0 :zero prices IF LEN(T11$)<20 OR T11$="ERR" THEN :bad response from servlet LET IER=-1 ELSE LET POS1,POS2=0 POS1=POS(T11$,"|",1) IF POS1=0 THEN GOTO @Reset_values LET LSTPRC=VAL(T11$[1,POS1-1],IER) : 1ST - LSTPRC IF IER=-1 THEN GOTO @Reset_values POS2=POS(T11$,"|",POS1+1) IF POS2=0 THEN GOTO @Reset_values IF POS1+1-1 THEN :UNPACK "NNA1A20LNA1NN",BUFF$,LSTPRC,UNTPRC,PRCDCN$,CALCDS$,MARKUP,UNTCST,UNTRBT$,CORCST,CORPRC LET PRICE=UNTPRC \ LST=LSTPRC \ IPPS[8]=CORPRC ELSE PRICE,LST=0 END IF : RETURN : :*****************************************************************************: : Standard Subroutines : :*****************************************************************************: : :============= @GET_TEXT :============= : 14000 LET ERR_FLG=0 \ DEFAULT_TEXT=0 14010 _GET_TEXT(LANGUAGE$,JUST$,LABEL$,PRE_TEXT$,POST_TEXT$,TEXT$,ERR_FLG,DEFAULT_TEXT,LENGTH,TEXT_LENGTH) 14020 LET P=TEXT_LENGTH \ RET$=TEXT$ : 14030 RETURN : :----------------------------------------------------------------------------- :=============== @REF_FILE_ACTIVITY :=============== GOSUB @GET_SERVER_TIMESTAMP :if not tracking file STMA 14,TABLE_NAME$,0 LET TABLE_NAME$=TRUN$(TABLE_NAME$,1),BLANK$ LET T9$=PROG_ID$,BLANK$ LET CURNAM$="REF_FILE_CHK" \ SQL$="SELECT" LET SQL$[0]=" id FROM ref_file_activity_table_name" LET SQL$[0]=" WHERE table_name = rtrim(?)" LET OFMT$="S4.0" \ IFMT$="A128" PACK "ZA128",BUFF$,TABLE_NAME$ LET SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR LET SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR IF NROWS>0 THEN LET CURNAM$="REF_FILE_MK" \ SQL$="SELECT" LET SQL$[0]=" fn_init_log_transaction" LET SQL$[0]="(?,?,rtrim(?),rtrim(?))" LET OFMT$="A26" \ IFMT$="S4.0S4.0A30A254" PACK "ZLLA30A254",BUFF$,EMPLOYEE_ID,LOC,IPADDR$,T9$ SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "A26",BUFF$,TIMESTAMP$ DELCUR ("REF_FILE_MK",IER) END IF DELCUR ("REF_FILE_CHK",IER) RETURN :---------------------------------------------------------------------------- :================= @GET_SERVER_TIMESTAMP :get server's timestamp :================= LET CURNAM$="GET_TIME" \ SQL$="SELECT CURRENT TIMESTAMP" LET IFMT$="" \ OFMT$="A26" \ BUFF$="" SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "A26",BUFF$,TIMESTAMP$ DELCUR ("GET_TIME",IER) RETURN :----------------------------------------------------------------------------- :========== @GET_SEQ_ID :get sequence for next ID :========== LET CURNAM$="GET_SEQ_ID" \ SQL$="SELECT sp_get_seq('",TRUN$(TABLE_NAME$,1),"',?)" LET IFMT$="S4.0" \ OFMT$="S4.0" SQL_LINE=SYS(201) \ GOSUB @DEFINE_CURSOR PACK "ZL",BUFF$,LOC SQL_LINE=SYS(201) \ GOSUB @EXECUTE_CURSOR SQL_LINE=SYS(201) \ GOSUB @FETCH_CURSOR UNPACK "ZL",BUFF$,ID DELCUR ("GET_SEQ_ID",IER) RETURN :----------------------------------------------------------------------------- :=============== @DEFINE_CURSOR :=============== : SQL(CURNAM$, SQL$, OFMT$, IFMT$, SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR RETURN : :---------------------------------------------------------------------------- :=============== @EXECUTE_CURSOR :=============== : EXEC (CURNAM$, BUFF$, SQL_STAT, NROWS) IF SQL_STAT THEN GOTO @SQL_ERR RETURN : :---------------------------------------------------------------------------- :============== @FETCH_CURSOR :============== : FETCH (CURNAM$,BUFF$,SQL_STAT) IF SQL_STAT THEN GOTO @SQL_ERR RETURN : :---------------------------------------------------------------------------- : :***********************************************************************: : TAMS II Revision 1.0 - Error Routine : :***********************************************************************: : : : STANDARDSLCHECK T2_ERR.SL - Standard Error Routine : DCS : 08/28/2006 : : : : Written: JDS 04/01/02 : : : :=======================================================================: : Modification History: : : : : 08/31/2006 : DCS : [19809] : : Redefine the ON ERR so that if we get an error here the : : program will BYE off instead of building a huge break file: : : : Also renumbered the routine. : : : :=======================================================================: : Format(s): : : _ubl_error(language$,sys200,sys7,ref_faps_id,err_flg) : : : : _sql_error(language$,sql_line,sql_stat,ref_faps_id,table_name$,... : : table_id_ent, table_i2_ent, table_cd_ent$, err_flg) : : : : _sql_file(language$,sql_line,ref_faps_id,table_name$,... : : table_id_ent, table_i2_ent, table_cd_ent$, err_flg) : : : : language$ - 2 Character Language Code (e.g. EN, ES, FR) : : sys200 - Physical line number of last error : : sys7 - error code of last error : : ref_faps_id - ref_file_activity_program_source_id number : : err_flg - error_flag determines display/input no display/input : : sql_line - Physical line number where sql failed : : sql_stat - original stat code returned from failed sql command : : table_name$ - table name where the sql command failed : : table_id_ent - primary num value for the record where sql failed : : table_i2_ent - secondary num value for the record where sql failed : : table_cd_ent$ - primary string value for the record where sql failed : : : : Output - Break file : : : : if err_flg = 0 (can be used by any program requiring silent errors) : : Description : Subroutine writes break file for UBL type errors. : : Transfer control to a module defined within T2_ERROR.SP: : Attempt to record error in error log : : _RETURN back to calling program. : : : : if err_flg = 1 (used by SCANNER PROGRAMS due to screen size) : : Description : Subroutine writes break file for UBL type errors. : : Transfer control to a module defined within T2_ERROR.SP: : Announce error has occured, display PLEASE WAIT : : Attempt to record error in error log : : Display Error Message on display : : Bye off from UBL. : : : : if err_flg = 2 (used by any PROGRAMS with 24x80 screen size) : : Description : Subroutine writes break file for UBL type errors. : : Transfer control to a module defined within T2_ERROR.SP: : Announce error has occured, display PLEASE WAIT : : Attempt to record error in error log : : Display Error Message on display : : _RETURN back to calling program. : : : :***********************************************************************: : 32000 REM ***** TAMS II Revision 1.0 Error Handler @UBL_ERR : UBL Error Routine 32010 ON ERR THEN CHAIN "HELLO1" : if anything else fails then bye off 32015 PRINT "AN ERROR HAS OCCURRED" : Send to Remote 32020 LET SYS200=SYS(200) : Err Line Number 32030 LET SYS7=SYS(7) : Err Code 32040 $D : Create .brk file 32050 _ubl_error(language$,sys200,sys7,ref_faps_id,err_flg) : Error Handler 32060 CHAIN "HELLO1" : @SQL_ERR : SQL Error Routine 32100 PRINT "AN ERROR HAS OCCURRED" : Send to Remote 32105 $D : Create .brk file 32110 _sql_error(language$,sql_line,sql_stat,ref_faps_id,table_name$,table_id_ent, table_i2_ent, table_cd_ent$, err_flg) 32120 CHAIN "HELLO1" : @SQL_FILE : SQL Rollback Condition 32200 PRINT "AN ERROR HAS OCCURRED" : Send to Remote 32205 $D : Create .brk file 32210 _sql_file(language$,sql_line,ref_faps_id,table_name$,table_id_ent, table_i2_ent, table_cd_ent$, err_flg) 32220 CHAIN "HELLO1" : : *** END OF PROGRAM ***