0001 SETERR GENERROR
0010 REM 0 "SOENTHDR - 10/28/2020 - ENTER INVOICE HEADING - PART 1 "
0011 REM "AUTHOR - PES, DJB"
0012 REM PTS : 9580,*9444,10105,*10111,*10139,*10949,11168,11380,11497,*11906,*12305,12258,11966,*12419,*12482,12500,*12511,12512,12532,12704,12734
0015 REM 0 - (COPYRIGHT) 0015-0022
0016 REM  Standards 8.0
0019 REM  OPEN SYSTEMS (R) Accounting Software
0020 REM  Copyright (c)1982 - 2013 Open Systems Holdings Corp.
0021 REM  All Rights Reserved
0022 REM  OPEN SYSTEMS is a registered trademark of Open Systems Holdings Corp.
0024 LET INHOUSE=0,INHOUSE=NUM(STBL("INHOUSE",ERR=0025),ERR=0025)
0025 PRECISION NUM(STBL("-DOLL"))
0080 IF HDR2 THEN LET HDR2=0; ON POS(Y$="XSU") GOTO ABANDON,ABANDON,PAGEUP,HDR2UP
0081 GOTO 0090
0085 HDR2UP: IF TH0=8 THEN IF TH8$(2,25)=FILL(25) THEN GOTO 2070 ELSE GOTO 2120 FI FI; IF TH1$(17,8)=FILL(8) THEN GOTO 2155 ELSE GOTO 2200
0090 LET YDISABLE$="",Y$="",NOGEN=0,CODHOLD=0
0100 GOSUB PROMPTS
0205 IF TASK$="UH" THEN GOSUB SAVEHDR; GOSUB ENABLE_FIELDS; GOTO PAGEUP
0310 DEF FND$(D)=DATE(D:STBL("DATEMASK"))
0320 DEF FNQ(Q)=POS(STBL("QUICK")="ON")
0898 GOTO 1000
0899 REM 0 - (SOFIL) 0899-0969
0900 XXTB: IOLIST T0$,T1,T1$,T2$,T3$,T4$,T2; REM "all application tables"
0902 OSCN: IOLIST CN0$,CN1$,CN2$,CN3$
0911 ARCRXXX: IOLIST CR0$,CR1$,CR1[ALL],CR2$,CR3$,CR2[ALL],CR4$,CR5$,CR6$,CRCFF$,CRCFV$
0913 ALTGLMAXXX: IOLIST G0$,G1$,G0; REM "GLMAx SHORT FORM FOR EDITING"
0920 ARHIXXX: IOLIST H0$,H1$,H2$,H3$,H4$,H1,H2,H3,H4,H5,H6,H7,H8,H9,H0,H5$,H6$,H9[ALL],H7$,H10,H8$,HCFF$,HCFV$
0921 ARCTXXX: IOLIST CTKEY$,CTSEQ$,CTORD$,CTBAT$
0922 ARSAXXX: IOLIST S0$,S1$,S2$,S3$,S4$,SCFF$,SCFV$
0923 ARINXXX: IOLIST N0$,N1$,N1[ALL],N2$,N3$,NCFF$,NCFV$
0925 SOTDXXX: IOLIST TD0$,TD0,TD1$,TD1[ALL],TD2$,TD3$,TD2[ALL],TD3,TD4$,TD5$,TD4,TD5[ALL],TD6$,TD7$,TD8$,TD9$,TD10$,TD11$,TD12$,TD6[ALL],TD13$,TD14$,TDCFF$,TDCFV$
0926 ARCUXXX: IOLIST C0$,C1$,C2$,C3$,C4$,C5$,C1[ALL],C2[ALL],C3,C4,C8$,C5[ALL],C6,C9$,C7,C6$,C7$,C10$[ALL],C11$,C12$,C8,CCFF$,CCFV$
0927 RMGCXXX: IOLIST GC0$,GC1$,GC2$,GC3$,GC4$,GC5$,GC6$,GC7$,GC8$[ALL],GC9$[ALL],GC10$[ALL],GC11$[ALL],GCCFF$,GCCFV$
0928 ARBTXXX: IOLIST BC0$,BC1$,BC2$,BC3$[ALL],BC4$,BC1,BC2,BC3
0929 SOSLXXX: IOLIST WW$,W0,W0$
0931 ARSRXXX: IOLIST SR0$,SR1$,SR2$,SR3$,SR4$,SR0[ALL],SR1[ALL],SR2[ALL],SR3,SR4[ALL],SR5$,SRCFF$,SRCFV$
0932 SODEXXX: IOLIST DKEY$,DDESC$
0933 RMCDXXX: IOLIST RCD0$,RCD1$,RCD1[ALL],RCDCFF$,RCDCFV$
0934 ARPYXXX: IOLIST P0$,P1$,P1,P2$,P2[ALL],P3$,P3,P4,P4$,P5$,PCFF$,PCFV$
0935 ARDCXXX: IOLIST DC0$,DC1$,DC2$,DCCFF$,DCCFV$
0936 ARDEXXX: IOLIST DKEY$,DDESC$
0937 ARFCXXX: IOLIST FC0$,FC1$,FC1[ALL],FCCFF$,FCCFV$
0938 ARGLXXX: IOLIST GL0$,GL1$,GL2$,GLCFF$,GLCFV$
0939 ARSHXXX: IOLIST SH0$,SH1$,SH2$,SH3$,SH4$,SHCFF$,SHCFV$
0940 ARHSXXX: IOLIST HS0$,HS1[ALL],HS2[ALL],HS1$,HS2$,HSCFF$,HSCFV$
0941 ARHDXXX: IOLIST HD0$,HD1$
0942 ARTCXXX: IOLIST TC0$,TC1$,TC2$,TC1[ALL],TCCFF$,TCCFV$
0943 SOLSXXX: IOLIST LS0$,LS1$,LS2$,LS3$,LS4$,LS1[ALL],LS5$,LS6$,LS7$,LSCFF$,LSCFV$
0948 SOKTXXX: IOLIST KT0$,KT1$,KT2$,KT3$,KT4$,KT5$,KT1[ALL],KT6$,KT2[ALL],KTCFF$,KTCFV$
0949 SOKHXXX: IOLIST KH0$,KH1$,KH2$,KH3$,KH4$,KH5$,KH6$,KH1[ALL],KH2,KH7$,KH3[ALL],KH8$,KHCFF$,KHCFV$
0955 SORLXXX: IOLIST RL0$,RL0,RL1$,RL1[ALL],RL2$,RL3$,RL2[ALL],RL3,RL4$,RL5$,RL4,RL5[ALL],RL6$,RL7$,RL8$,RL9$,RL10$,RL11$,RL12$,RL6[ALL],RLCFF$,RLCFV$
0956 SOTHXXX: IOLIST TH0$,TH0,TH1$,TH1[ALL],TH2$,TH3$,TH2[ALL],TH3,TH4$,TH5$,TH4,TH5[ALL],TH6$,TH7$,TH8$,TH9$,TH10$,TH11$,TH12$,TH13$,TH6[ALL],TH14$,TH15$,TH7,THCFF$,THCFV$
0957 SORHXXX: IOLIST RH0$,RH0,RH1$,RH1[ALL],RH2$,RH3$,RH2[ALL],RH3,RH4$,RH5$,RH4,RH5[ALL],RH6$,RH7$,RH8$,RH9$,RH10$,RH11$,RH12$,RH6[ALL],RHCFF$,RHCFV$
0959 JOBSXXX: IOLIST B0$,B1$,B2$,B3$,B0[ALL],B4$,B5$,B1[ALL],B2[ALL],B6$,B3,B4,B7$,B5[ALL],B6[ALL],B7[ALL],B8[ALL],B8$,B9$,B10$,B11$,B12$,BCFF$,BCFV$; REM "JOBS FILE"
0960 ARCMXXX: IOLIST CM0$,CM1$,CM2$,CM3$,CM4$,CM5$,CMCFF$,CMCFV$
0962 SOBDXXX: IOLIST BD0$,BD1$
0964 SOBHXXX: IOLIST BH0$,BH0,BH1$,BH1[ALL],BH2$,BH3$,BH2[ALL],BH3,BH4$,BH5$,BH4,BH5[ALL],BH6$,BH7$,BH8$,BH9$,BH10$,BH11$,BH12$,BH13$,BH6[ALL],BH7[ALL],BH8[ALL],BH14$,BHCFF$,BHCFV$
0966 SOBKXXX: IOLIST BK0$,BK1$,BK2$,BK3$,BK4$,BK5$,BK1[ALL],BK6$,BK2[ALL],BKCFF$,BKCFV$
0968 SOBLXXX: IOLIST BL0$,BL0,BL1$,BL1[ALL],BL2$,BL3$,BL2[ALL],BL3,BL4$,BL5$,BL4,BL5[ALL],BL6$,BL7$,BL8$,BL9$,BL10$,BL11$,BL12$,BL6[ALL],BLCFF$,BLCFV$
0969 SOBSXXX: IOLIST BS0$,BS1$,BS2$,BS1,BS2[ALL],BSCFF$,BSCFV$
1000 REM 1000,5 "----- Entry Control"
1005 ABANDON:
1010 LET MENU=1,DEFAULTED=0; IF S=1 THEN LET MENU=0,S=0
1015 LET X8$=" "; GOSUB GENERROR
1020 GOSUB CLEAR_GLOBAL; GOSUB DISABLE_FIELDS
1025 DIM_ARCU: DIM C0$(6),C1$(30),C2$(172),C3$(40),C4$(27),C5$(12),C8$(16),C1[7],C2[27],C5[3],C9$(12),C6$(20),C7$(62),C10$[1:3](27),CCFF$:FATTR(CCFF$),CCFV$:FATTR(CCFV$)
1030 DIM_SOTH: DIM TH1$(44),TH1[4],TH2$(6),TH3$(16),TH2[2],TH5[10],TH5$(36),TH6$(26),TH7$(13),TH8$(192),TH9$(1),TH10$(1),TH11$(152),TH12$(20),TH13$(6),TH6[1:5,1:4],TH14$(16),TH15$(25),THCFF$:FATTR(THCFF$),THCFV$:FATTR(THCFV$); LET TH4$=FNNUM$(G1,"00"),TH5$(1,4)=STR(GLYR:"0000")
1040 DIM E9$(3),S9$(6),S91$(7),TOT[10],TOT2[1:5,1:4],TYPE$(4),BC3$[3],TC1$(1),TC2$(13),TC1[3],TCCFF$:FATTR(TCCFF$),TCCFV$:FATTR(TCCFV$),GC1$(20)
1045 DIM TD8$(26); IF TASK$<>"EH" THEN DIM SAVE_LEV$(6)
1048 DIM_ARCR: DIM CR0$(10),CR1$(14),CR1[2],CR2$(6),CR3$(12),CR2[2],CR4$(6),CR5$(20),CR6$(74),CRCFF$:FATTR(CRCFF$),CRCFV$:FATTR(CRCFV$)
1049 CALL "SOENTHDR.HOOKS"+"::INITIALIZE_ORDER",ERR=*NEXT;REM RRW/RCG
1050 IF NOGEN=0 THEN DIM TH0$(14),TRAN$(14)
1055 GOSUB SAVEHDR
1060 IF CVS(LO0$,2)="" THEN LET LO0$=STBL("WHSE")
1065 IF TH0$(1,6)=FILL(6) THEN LET TH0$(1,6)=BATCH$
1070 LET TH4=0,TH0=E1,Y$="J",SHIPTONUM=0,TH1[3]=E5,TOT[8]=0,TH3$(4,5)=FNNUM$(100,"###.0"),TH1[1]=-1,TH1[2]=-1,TH1[0]=-1,TH1[4]=-1,TH7=-1,TH6$(1,26)=FILL(20)+LO0$,NOCHG=0
1071 spshipto$="";rem RRW/RCG SP007
1075 IF O2$(2,1)="1" AND TH6$(21,6)=FILL(6) THEN LET INFO=0 ELSE LET INFO=1
1080 LET CHECK$="",X1$=""
1085 GOSUB DATA; GOSUB CLEAR_MAPINFO
1090 IF X0$="D" THEN LET E0=2,E1=3 ELSE IF X0$="S" THEN LET E0=2,E1=9; REM "reset after verify, done in case user was using verify, but order was locked on another terminal"; REM "****************
1095 IF MENU=0 THEN GOTO BATCH
1100 LET SAVIT=E0; CALL "SOENTSEL.PUB",ORDTYPE,X0$,X2,TH0,E0,E1,ORD_CRED_FLAG,E1$,E2$,TITLE$,SELCHG,ORDTYPECHG,QE,QTAB$,FLD[ALL],HDR[ALL],FILE[ALL],O2$,TASK$,OSGUI$,SOENT_SEL_CONTEXT,MENU1$,MENUHLP$,SOENT_HEADER_CONTEXT,GENINPUT$; IF SELCHG=99 THEN GOTO QUIT
1105 IF ORDTYPE=2 AND TASK$="NH" THEN IF O2$(56,1)="1" THEN GOSUB GET_RMA_NO
1110 IF POS(STR(E0)="14") AND O2$(6,1)="1" THEN LET AUTO_GENERATE_FLAG=1 ELSE LET AUTO_GENERATE_FLAG=0; REM "Sys Gen Ord #"
1115 IF POS(X0$="WXYZ") THEN CALL "SOENBINI.PUB",FILE[ALL],O2$,UO2$,INUPD1$,INUPD2$,INUPD3$,INGET$,ARCM$,INVE$,INLO$,INLD$,INAI$,INQT$,INUM$,INXT$,INCJ$,INLP$,INLT$,INPP$,INPS$,INQL$,INUP$,INCL$,INCA$,INGL$,INLS$,BKMD$,BKMH$,BKMH2$,OSGUI$,BLANKET_CONTEXT[ALL],X0$,GENINPUT$; GOTO 1100
1120 GOSUB DISABLE_FIELDS
1122 GOSUB TAKEN_BY; REM "CWE/RCG"
1125 IF SELCHG THEN IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(0,TITLE$), ELSE GOSUB BOX2 FI; GOSUB DATE_RESET; IF SAVIT>1 AND SAVIT<4 THEN IF E0=1 THEN LET NOGEN=0
1130 IF ORDTYPECHG THEN GOSUB REDRAW_RMA_PROMPTS
1135 IF NOGEN=0 OR POS(STR(E0)="23") THEN LET TH0$(7,8)=FILL(8),TRAN$(7,8)=FILL(8)
1140 IF (E0=2 OR E0=4 OR (E0=1 AND (E1>=1 AND E1<8))) AND TH1[1]<0 THEN LET TH1[1]=WKSDATE,X$=FND$(TH1[1]); IF E1=1 THEN LET TH1[1]=-1 FI; GOSUB GENPC1; LET G1=X,GLYR=YEAR; IF LOCKFLAG OR INVALIDYEAR THEN G1=0,GLYR=0 FI; LET TH4$=STR(G1:"00"),TH5$(1,4)=STR(GLYR:"0000"),O9$=""
1200 REM 1200,5 "----- Batch #"
1202 LET LOADORD$="",LOADORD$=STBL("LOADORD",ERR=*NEXT); REM RRW/RCG SP000 LOADORD$ WILL ALLOW JUMPING BACK INTO ORDER AFTER ONLINE, OR JUMPING IN FROM OTHER PLACES
1203 sharedNS!.removeValue("LOADORD",ERR=*NEXT); REM RRW/RCG SP000
1205 BATCH:
1206 CALL"SOENTHDR.HOOKS::SETBATCH",ERR=*NEXT;REM RRW/RCG SP019
1210 LET YDISABLE$="D"
1215 IF O2$(10,1)<>"1" THEN GOTO 1260
1220 LET X0=1,X1=16,X3=0,X4=6,X$=TH0$(1,6),P0=3,WINDID$="ARACB W1",SELVAL$="NKEY  ",PROGID$="RMACBFM.PUB",YDISABLE$="D",GUI_ID=4000
1225 IF CVS(X$,2)="" THEN LET Y$=""
1227 IF CVS(LOADORD$,3)<>"" THEN LET X$=LOADORD$(1,6); GOTO 1231; REM RRW/RCG SP000 AUTO-LOAD OF ORDER
1230 IF ORDENTERED=0 THEN GOSUB GENINPUT; REM "batch #"
1235 IF Y$="U" THEN GOTO BATCH
1240 LET TH0$(1,6)=X$
1242 IF TH0$(1,6)=FILL(6) AND E0=3 THEN GOTO 1300
1245 IF CVS(X$,2)<>"" THEN LET TH0$(1,6)=STR(NUM(TH0$(1,6),ERR=1250):"000000") ELSE IF (E0<>3 AND POS(X0$="DS")=0) AND TH0$(1,6)=FILL(6) THEN LET X9$="A valid batch number is required."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO BATCH
1250 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,TH0$(1,6)), ELSE PRINT @(X1,X0),STBL("FTXT2"),'SF',TH0$(1,6)
1255 LET BATCH$=TH0$(1,6),TRAN$(1,6)=TH0$(1,6)
1260 IF POS(X0$="FR") THEN LET FLAG=1 ELSE LET FLAG=0
1265 IF E0=3 OR POS(X0$="DS") THEN LET SKIPRPT=1
1270 GOSUB FLAG; IF OK<>1 THEN GOTO BATCH
1275 IF O2$(10,1)="1" THEN LET BTEST=1; GOSUB ORDERNUM
1280 LET P0=0; IF TRAN$(7,8)<>FILL(8) AND BTEST=0 AND ALLBATCH=0 THEN GOTO LOCATION
1300 REM 1300,5
1305 IF NOGEN AND E0=1 THEN LET NOGEN=0; GOTO PAGEUP FI; LET NOGEN=0
1310 IF AUTO_GENERATE_FLAG=1 THEN GOSUB ORDERNUM; IF ORDERR THEN GOTO ABANDON ELSE GOTO 1405; REM "generate order #"
1315 REM "-----   Our Order #"
1317 IF (E0=2 OR E0=3) AND Y$="J" AND TH0$(7,8)=FILL(8) THEN LET Y$=""
1320 LET X0=2,X1=16,X3=0,X4=8,X$=TH0$(7,8),WINDID$="SOENT W1",SELVAL$=BATCH$+FILL(8),PROGID$="",ORDERR=0,O7=0,GUI_ID=4010
1325 IF ALLBATCH THEN LET ALLBATCH=0,ORDENTERED=0; GOTO 1340
1330 IF O2$(10,1)="1" AND TH0$(1,6)=FILL(6) THEN LET ALLBATCH=1,WINDID$="SOENT W9" ELSE LET ALLBATCH=0
1332 IF CVS(LOADORD$,3)<>"" THEN LET X$=LOADORD$(7,8),Y$="P"; GOTO 1336; REM RRW/RCG SP000 AUTO-LOAD OF ORDER
1335 LET GENINPUT.NOSPECIAL=1; GOSUB GENINPUT; LET GENINPUT.NOSPECIAL=0; REM "Ord #"
1340 IF Y$="U" THEN LET ALLBATCH=0; GOTO BATCH
1345 IF GUI THEN LET TMP=0,TMP=NUM(STBL("DESTID2",ERR=1350))
1350 IF CVS(X$,3)="" THEN IF TMP=4000 THEN LET Y$="U"; GOTO BATCH
1355 LET TH0$(7,8)=X$; IF CVS(X$,2)="" THEN LET Y$="",ALLBATCH=0; GOSUB CLEAR_GLOBAL; IF POS(X0$="EDSM") THEN GOSUB FIND_ORDER; IF CVS(ORDER_NUM$,3)<>"" THEN LET X$=ORDER_NUM$,TH0$(7,8)=X$,ALLBATCH=1 ELSE GOTO 1320 FI ELSE GOTO 1320
1360 IF POS("E"=X$) THEN GOTO 1370
1365 LET TH0$(7,8)=STR(NUM(X$,ERR=1370):"00000000"); IF NUM(X$)=0 THEN LET Y$=""; GOSUB CLEAR_GLOBAL; GOTO 1320
1370 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,TH0$(7,8)), ELSE PRINT STBL("FTXT2"),'SF',@(X1,X0),TH0$(7,8)
1375 IF ALLBATCH=0 THEN GOTO 1395
1380 READ (FILE[37],KEY=TH0$(7,8),KNUM=6,ERR=1385)
1385 LET X$=FILL(8); LET X$=KEY(FILE[37],ERR=1390)
1390 IF X$(1,8)=TH0$(7,8) THEN LET X$=X$(9,6),TH0$(1,6)=X$; READ (FILE[37],KNUM=0); LET ORDENTERED=1; GOTO 1220
1395 GOSUB ORDERNUM; IF ORDERR=1 THEN GOTO ABANDON
1400 IF SPO2$(39,1)="0" THEN IF (E0=2 AND ORDTYPE=1) THEN IF CODHOLD=0 OR (CODHOLD AND TC1[1]+TC1[2]+TC1[3]<>0) THEN IF C4$(7,1)="Y" THEN GOSUB DATA; GOSUB SET_MAPINFO; LET O7=0,X9$="",X8$=""; CALL "SOENTHDR.HOOKS"+"::EXTRA_HOLD_CHECK",ERR=*NEXT; IF X9$<>"" THEN LET YDISABLE$="DS"; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO ABANDON
1401 IF (E0=2 AND ORDTYPE=1) THEN IF CODHOLD=0 OR (CODHOLD AND TC1[1]+TC1[2]+TC1[3]<>0) THEN IF C4$(7,1)="Y" THEN GOSUB DATA; GOSUB SET_MAPINFO; LET X9$="Customer is on credit hold.",YDISABLE$="DS"; GOSUB GENERROR; IF INHOUSE=0 THEN GOTO ABANDON
1405 IF E0=2 AND POS(STR(TH0)="345") AND X9$="" THEN LET X9$="Order '"+CVS(TH0$(7,8),2)+"' already verified.  Use Change Orders for changes.",YDISABLE$="SD"; LET O7=0; GOSUB GENERROR; GOTO ABANDON
1406 IF E0=2 THEN X9$="",X8$="";CALL "SOENTHDR.HOOKS"+"::CHECK_BEFORE_VERIFY",ERR=*NEXT; IF X9$<>"" THEN YDISABLE$="SD",O7=0;GOSUB GENERROR;GOTO ABANDON;REM RRW/RCG 120515
1410 IF E0=2 AND TH0=9 AND X9$="" THEN LET X9$="Order '"+CVS(TH0$(7,8),2)+"' already received. Use Change RMA for changes.",YDISABLE$="SD"; LET O7=0; GOSUB GENERROR; GOTO ABANDON
1415 LET X1$=""
1420 IF E0=3 THEN IF POS(STR(TH0)="123568") AND ORDTYPE=2 THEN LET X9$="Use Order menu to edit all order type transactions.",YDISABLE$="SD",O7=0; GOSUB GENERROR; GOTO ABANDON
1425 IF E0=3 THEN IF POS(STR(TH0)="79") AND ORDTYPE=1 THEN LET X9$="Use RMA menu to edit all return type transactions.",YDISABLE$="SD",O7=0; GOSUB GENERROR; GOTO ABANDON
1430 IF E0=3 OR E0=4 THEN IF POS(STR(TH0)="479")=0 THEN LET FLAG=0 ELSE LET FLAG=1 FI; GOSUB FLAG; IF OK<>1 THEN GOSUB GENERROR
1435 IF GUI AND TRAN$(7,8)<>FILL(8) AND BTEST=0 AND ALLBATCH=0 THEN PRINT (OSGUI.CHAN)'DISABLE'(4010,14010)
1440 GOSUB REDRAW_RMA_PROMPTS
1445 PAGEUP:
1450 IF GUI AND X0$="E" THEN GOSUB ENABLE_FIELDS
1455 LET BTEST=0
1460 IF TASK$="NH" THEN LET YDISABLE$="D" ELSE LET YDISABLE$=""
1465 GOSUB ORDERDATE; GOSUB DISABLE_ADDRESS_FIELDS; IF Y$="U" THEN IF TASK$="NH" THEN GOTO BATCH ELSE GOTO PAGEUP
1466 IF (DO2$(66,1)="1" AND ORDTYPE=1) THEN IF TH0=4 THEN GOTO LOCATION ELSE IF TH0>=1 AND TH0<=6 THEN  GOSUB SET_DEFAULT_VALUES
1470 REM "-----   Location ID"
1475 LOCATION:
1480 GOSUB ENABLE_FIELDS; REM "----- Added gosub to data intentionally"
1485 IF Y$="J" THEN LET Y$=""
1490 LET X0=3,X1=16,X3=0,X4=6,X$=LO0$,GUI_ID=4030
1495 IF O2$(2,1)="1" THEN LET WINDID$="INLOCAW1",PROGID$="INACLFM.PUB" ELSE LET WINDID$="",PROGID$=""
1499 IF CVS(LOADORD$,3)<>"" AND Y$="P" GOTO 1501;REM RRW/RCG SP000
1500 IF STBL("QUICK")="OFF" AND CVS(X$,3)<>"" AND UPFLAG=0 THEN GOTO 1520
1505 IF FNQ(Q) AND CVS(LO0$,3)<>"" THEN LET FLDNUM=0; GOSUB QUICK
1510 GOSUB GENINPUT; REM "Loc ID"
1515 IF Y$="U" THEN GOTO PAGEUP
1520 IF O2$(2,1)<>"1" THEN LET LO0$=X$+FILL(X4-LEN(X$)); GOTO 1560
1525 IF CVS(X$,3)="" THEN GOSUB CLEAR_GLOBAL; LET Y$=""; GOTO 1490
1530 LET INLO.LOCA$=X$+FILL(6-LEN(X$))
1535 LET F0=40; READ RECORD(FILE[F0],KEY=INLO.LOCA$,DOM=1540,ERR=GENERROR)INLO$; GOTO 1550
1540 IF INLO.LOCA$=STBL("WHSE") THEN LET X9$="Default location is not on file. "; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1510
1545 LET X$=CVS(INLO.LOCA$,3),O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1490
1550 LET LO0$=INLO.LOCA$,W1$=INLO.DESC$
1555 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(2010,W1$), ELSE PRINT 'SF',STBL("FTXT2"),@(29,3),W1$(1,20),
1560 LET TH6$(21,6)=LO0$,INFO=1
1561 INT_ORDNO: LET X0=3,X1=58,X3=0,X4=8,X$=THCFF.INT_ORDNO$,GUI_ID=4032,WINDID$="",SELVAL$=""; IF CVS(X$,3)="" AND E0=1 AND E1=1 THEN LET X9=1
1562 GOSUB GENINPUT; REM "SWI Order No"
1563 IF Y$="U" THEN LET UPFLAG=1; GOTO LOCATION
1564 LET THCFF.INT_ORDNO$=X$+FILL(X4-LEN(X$)); IF E0=1 AND THCFF.INT_ORDNO$<>FILL(X4) THEN CALL "SOENTHDR.HOOKS::CHECK_INTERNAL_ORDER",ERR=*NEXT,FILE[ALL],THCFF$,X9$; IF X9$<>"" THEN GOSUB CLEAR_GLOBAL; GOSUB GENERROR
1565 REM "-----   Customer ID"
1570 CUST:
1575 IF FNQ(Q) THEN LET FLDNUM=1; GOSUB QUICK ELSE IF Y$="J" THEN LET Y$=""
1580 LET C0$=TH2$,SAVECUST$=TH2$; GOSUB DISABLE_ADDRESS_FIELDS
1585 IF POS(STR(E0)="14")=0 AND POS(STR(E1)="34569") THEN LET NOCHG=1,F0=6; READ (FILE[F0],KEY=C0$,DOM=1800,ERR=GENERROR)IOL=ARCUXXX; GOTO 1765
1590 LET X0=5,X1=13,X3=0,X4=6,X$=C0$,WINDID$="ARENTAW2",INFO=1,NOCHG=0,GUI_ID=4040
1595 LET UPFLAG=0
1600 LET PROGID$="ARACCFM.PUB",TEMP$=STBL("TABLE","SOTB")
1601 CALL"SPCUST.PUB",ERR=*NEXT;IF POS(Y$="SXM") THEN GOTO 8420 ELSE IF Y$="D" GOSUB 9200;GOTO CUST FI;GOTO 1606;REM RRW/RCG QUICK CUSTOMER LOOKUP
1605 GOSUB GENINPUT; REM "cust"
1610 LET PROGID$="",TEMP$=STBL("!CLEAR","TABLE")
1615 IF Y$="U" THEN LET UPFLAG=1; GOTO INT_ORDNO
1620 LET C0$(1,6)=X$
1625 IF C0$=FILL(6) THEN LET Y$=""; GOSUB CLEAR_GLOBAL; GOTO 1590
1630 IF TASK$="NH" THEN LET NOCHG=0,CUSTCHANGE=0; GOTO 1640
1635 IF C0$=TH2$ OR TASK$="NH" THEN LET NOCHG=1,CUSTCHANGE=0; GOTO 1650 ELSE LET CUSTCHANGE=1
1640 IF TH2$<>C0$ THEN LET SHIPTONUM=0; DIM TH3$(16); LET TH3$(4,5)="100.0"; IF TASK$="NH" THEN DIM TH11$(152); REM "CWE/RCG - Retain ShipTo Address on Customer change"
1641 CALL"SOENTHDR.HOOKS::"+"CHECK_CUSTOMER_CHANGE",ERR=*NEXT;REM SP007
1645 IF ABS(TOT[6])+ABS(TOT[7])<>0 THEN LET X9$="Prepayments must be cleared before customer ID can be changed."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1590
1650 DIM C1[7],C2[27],C5[3],C4$(27); IF NOCHG=0 THEN DIM TH12$(20)
1655 LET F0=6; READ (FILE[F0],KEY=C0$,DOM=1660,ERR=GENERROR)IOL=ARCUXXX; GOTO 1665
1660 LET X$=CVS(C0$(1,6),2),O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1590
1665 IF C7$(13,1)="I" THEN IF TASK$="NH" OR C0$<>SAVECUST$ OR CVS(SAVECUST$,3)="" THEN LET X9$="Cannot assign an inactive customer to this transaction."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1590
1667 IF CVS(LOADORD$,3)="" THEN CALL "SPPOS.PUB",ERR=*NEXT,"ARCC",C0$," Customer Comments ","POS",OSGUI$;REM SP013 RRW/RCG Display customer comments with reference "POS"
1670 IF C7$(13,1)="I" AND C0$=SAVECUST$ THEN LET X9$="Warning: Customer is flagged as inactive."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR
1675 IF C0$<>TH2$ THEN GOTO 1680 ELSE GOTO 1705
1680 DIM TC1$(1),TC2$(13),TC1[1:3]; LET TC0$=C4$(16,6),TH1$(1,6)=C4$(16,6)
1685 READ (FILE[24],KEY=TC0$,DOM=1690,ERR=GENERROR)IOL=ARTCXXX
1690 LET TYPE$=TERMS$(POS(TC1$(1,1)="RP")*4+1,4),PROXTYPE$=TYPE$,TH2[0]=TC1[1],TH2[1]=TC1[2],TH2[2]=TC1[3]
1695 IF O2$(51,1)<>"1" THEN GOTO 1705 ELSE READ (FILE[64],KNUM=3,KEY=C0$,DOM=1700)
1700 LET A$=KEY(FILE[64],END=1705); IF A$(1,6)=C0$ THEN LET X9$="Warning: Customer has blanket orders on file."; GOSUB GENERROR
1705 IF TH1$(25,6)=FILL(6) OR C0$<>TH2$ THEN LET TH1$(25,6)=C10$[1](1,6)
1710 GOSUB GETTAX; LET X9$=""
1715 IF C4$(7,1)="N" THEN GOTO 1735
1716 O7=0,X9$="",X8$="";CALL "SOENTHDR.HOOKS"+"::EXTRA_HOLD_CHECK",ERR=*NEXT;IF X9$<>"" THEN GOSUB CLEAR_GLOBAL;GOSUB GENERROR; GOTO 1590 ELSE IF X8$<>"" X9$=X8$,X8$="";GOSUB GENERROR;REM RRW/RCG FOR MORE STRINGENT CREDIT HOLD;101216 RRW/RCG ADDED O7=0
1720 IF CODHOLD=0 THEN IF E0=2 OR (E0<4 AND POS(STR(E1)="14789")=0) THEN GOTO 1730
1725 LET X9$="WARNING: Customer is on credit hold."; GOSUB GENERROR; GOTO 1735
1730 IF CODHOLD=0 THEN LET X9$="Customer is on credit hold."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; IF INHOUSE AND (TH0=1 OR TH0=4) THEN GOTO 1735 ELSE GOTO 1590
1735 IF C3=0 THEN LET C3=99999999
1740 LET CREDLIM=C3-C1[1]-C1[2]-C1[3]-C1[4]-C1[5]-C1[6]-C1[7],CRED_LIM=0; REM "credit left"
1741 IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN CALL "SOENT.HOOKS"+STBL("RCMOD")+"::GET_OTHER_COMPANY_BALANCE",ERR=*NEXT,FILE[222],C0$,CREDLIM
1745 CALL "SOCRLCK1.PUB",C0$,CREDLIM,(37),(19),FILE[ALL],TH0$(1,14),SOTH$,ARCR$
1747 IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN CALL "SOCRLCK1.PUB",C0$,CREDLIM,(220),(221),FILE[ALL],FILL(14),SOTH$,ARCR$; REM "Check other Location"
1750 IF NOCHG THEN GOTO 1765
1755 LET TH3$(1,3)=C5$(1,3),TH3$(4,5)="100.0",TH3$(9,3)=C5$(4,3),TH3$(12,5)="   .0",TH2$=C0$,S6=POS(C10$[1](7,1)="Y"),TH13$=C4$(22,6),TH1$(43,2)=C4$(3,2),TH1$(7,1)=C10$[1](7,1)
1759 CALL "SOENTHDR.HOOKS::"+"LOAD_SHIPTO",ERR=*NEXT;GOSUB GET_SHIPTO;GOTO 1761;REM SP007
1760 LET TH4=NUM(C7$(7,6)); GOSUB GET_SHIPTO
1765 LET S9$=TH13$; IF NOCHG=0 THEN LET S91$=C10$[1](1,6); REM "CUST level/tax id"
1768 IF POS("GE100"=STBL("RCMOD",ERR=*NEXT)) OR POS("SERV50"=STBL("RCMOD",ERR=*NEXT)) THEN IF TH2$=STBL("SP_CASH_CUST",ERR=*NEXT) THEN IF E0=1 AND E1=1 THEN LET X0$="B",E0=1,E1=3,ORD_CRED_FLAG=1,E1$=" Orders ",TH0=3; IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(2000,E2$(1+(TH0-1)*8,8)) ELSE PRINT 'SF',@(57,2),E2$(1+(TH0-1)*8,8); REM "G&E100 - If Cash customer then force verified"
1770 GOSUB GETDIST; IF NOTFOUND THEN GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1565 ELSE LET MOPACCT$=DC2$(1,12)
1780 LET NOCUSTCHG=NOCHG,NOCHG=0
1785 GOSUB DATA; GOSUB SET_MAPINFO
1787 IF CREDLIM<0 AND SPO2$(39,1)<>"1" THEN CALL "SOENTHDR.HOOKS"+"::EXTRA_CREDIT_LIMIT",ERR=*NEXT; IF SP039_OK=0 THEN LET Y$="X"; GOTO 8452 ELSE GOTO 1791
1788 IF CREDLIM<0 THEN CALL "SOTATTLE.HOOKS"+"::CREDIT_LIM",ERR=*NEXT;REM RRW/RCG SP001
1790 IF CREDLIM<0 THEN LET CRED_LIM=1,O7=0,X9$="Credit limit exceeded."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; LET CREDLIM=9999999
1795 IF TASK$<>"E" THEN GOSUB ENABLE_FIELDS
1800 SHIPTO_ID: REM "-----   Ship To #"
1805 IF FNQ(Q) THEN LET FLDNUM=12; GOSUB QUICK ELSE IF Y$="J" THEN LET Y$=""
1810 LET SAVETAX_SHIPTO$=TH1$(25,6); REM GOSUB DISABLE_FIELDS
1815 LET X0=5,X1=52,X3=1,X1$="######",X4=LEN(X1$),X=SHIPTONUM,WINDID$="ARACS W3",SELVAL$=TH2$+FILL(6),GUI_ID=4050
1818 CALL"SOENTHDR.HOOKS"+"::BEFORE_SHIPTO_GENINPUT",ERR=*NEXT;REM RRW/RCG SP007 CHECK FOR ALPHA SHIP TO MOD. ON RETURN IF SP007_ALPHA_SHIPTO=1, X VALUES CHANGED FOR ALPHA SHIPTO;IF SP007_ALPHA_SHIPTO=0 STANDARD NUMERIC SHIPTO BEHAVIOR
1820 LET PROGID$="ARACS",CUST$=STBL("CUSTOMER",TH2$); REM "set maint vars."
1822 CALL "SPSHIPTO.PUB",ERR=*NEXT; IF POS(Y$="SXM") THEN GOTO 8420 ELSE IF Y$="D" THEN GOSUB 9200; GOTO SHIPTO_ID FI; GOTO 1826
1825 GOSUB GENINPUT; REM "Ship to #"
1830 LET PROGID$="",CUST$=STBL("!CLEAR","CUSTOMER")
1835 REM IF Y$="U" THEN IF E0<>1 AND POS(STR(E1)="34569") THEN GOSUB CLEAR_GLOBAL; GOTO PAGEUP ELSE GOTO CUST
1836 IF Y$="U" THEN IF E0<>1 AND TOT[6] THEN GOSUB CLEAR_GLOBAL; GOTO PAGEUP ELSE GOTO 1590
1840 DIM S1$(152),S2$(26)
1844 IF SP007_ALPHA_SHIPTO THEN GOTO VALDATE_ALPHA_SHIPTO
1845 LET ADDRESS_EDIT=1; LET F0=11; READ (FILE[F0],KEY=TH2$+STR(X:"000000"),DOM=1850,ERR=GENERROR)IOL=ARSAXXX; GOTO 1857
1850 IF X>0 THEN LET O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1815
1855 IF X=0 THEN IF C7$(16,1)="N" THEN GOSUB ENABLE_ADDRESS_FIELDS; IF SHIPTONUM<>X THEN LET TH11$(1,152)="",TH3$(1,3)=C5$(1,3),TH3$(9,3)=C5$(4,3) FI; LET SHIPTONUM=X; GOTO 1895 ELSE LET O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1815
1857 IF C7$(16,1)="N" THEN GOSUB ENABLE_ADDRESS_FIELDS
1860 IF X=SHIPTONUM AND (NOCUSTCHG OR TASK$="NH") THEN GOTO 1885
1865 LET TH11$(1,152)=S1$,TH12$=S2$(1,20),SHIPTONUM=X,S1$=""; IF CVS(S4$(1,3),3)<>"" THEN LET TH3$(1,3)=S4$(1,3) ELSE LET TH3$(1,3)=C5$(1,3) FI; IF CVS(S4$(4,3),3)<>"" THEN LET TH3$(9,3)=S4$(4,3) ELSE TH3$(9,3)=C5$(4,3) FI; IF TH3$(1,3)=TH3$(9,3) THEN LET TH3$(9,3)=FILL(3)
1870 IF S2$(21,6)=FILL(6) THEN GOTO 1885 ELSE LET S91$(1,6)=S2$(21,6),TH1$(25,6)=S91$(1,6),TX1$=FILL(25)
1875 GOSUB GETTAX; LET X9$=""
1880 IF SAVETAX_SHIPTO$<>TH1$(25,6) THEN LET SHIPTO_TAX_CHANGED=1 ELSE LET SHIPTO_TAX_CHANGED=0
1885 LET ADDRESS_EDIT=0; GOSUB DATA; GOSUB SET_MAPINFO2; IF C7$(16,1)="Y" THEN GOSUB DISABLE_ADDRESS_FIELDS; GOTO 2130
1890 LET S2$=""
1895 IF SHIPTONUM=0 THEN LET SHIP$=FILL(6),TMPMASK$="######" ELSE LET SHIP$=FNNUM$(SHIPTONUM,"000000"),TMPMASK$="000000" FI; GOSUB DATA
1900 ADDRESS: REM "-----   Ship To Name/Addr"
1905 FOR I=0 TO 3
1910 IF Y$="U" THEN LET I=3,X4=30
1915 LET X4=30
1920 IF I=0 THEN LET X4=30
1925 IF FNQ(Q) THEN LET FLDNUM=I+13; GOSUB QUICK
1930 LET X0=6+I,X1=42,X3=0,X$=TH11$(31-X4+I*30,X4),GUI_ID=4060+I*10
1935 GOSUB GENINPUT; REM "Ship to Name/Addr"
1940 IF Y$<>"U" THEN GOTO 1950
1945 LET I=I-1; IF I<0 THEN GOTO SHIPTO_ID ELSE GOTO 1915
1950 LET TH11$(31-X4+I*30,X4)=X$,X4=30
1955 IF I>0 THEN GOSUB SET_MAPINFO2
1960 NEXT I
1965 CITY: REM "-----   City"
1970 LET X0=10,X1=42,X3=0,X4=15,X$=TH11$(121,15),GUI_ID=4100
1975 IF FNQ(Q) THEN LET FLDNUM=17; GOSUB QUICK
1980 GOSUB GENINPUT; REM "City"
1985 IF Y$="U" THEN GOTO ADDRESS
1990 LET TH11$(121,15)=X$
1995 GOSUB SET_MAPINFO2
2000 STATE: REM "-----   State"
2005 LET X0=10,X1=58,X3=0,X4=3,X$=TH11$(136,3),GUI_ID=4110,WINDID$="RMOSST  "
2010 IF FNQ(Q) THEN LET FLDNUM=18; GOSUB QUICK
2015 GOSUB GENINPUT; REM "State"
2020 IF Y$="U" THEN GOTO CITY
2025 LET TH11$(136,3)=X$; IF TH11$(136,3)=FILL(3) THEN GOTO 2040
2030 READ (FILE[13],KEY=TH11$(136,3),DOM=2035); GOTO 2040
2035 LET O7=8; GOSUB GENERROR; GOTO STATE
2040 GOSUB SET_MAPINFO2
2045 ZIP: REM "-----   Zip Code"
2050 LET X0=10,X1=62,X3=0,X4=12,X$=TH11$(139,12),GUI_ID=4120
2055 IF FNQ(Q) THEN LET FLDNUM=19; GOSUB QUICK
2060 GOSUB GENINPUT; REM "Zip"
2065 IF Y$="U" THEN GOTO STATE
2070 LET TH11$(139,12)=X$
2075 GOSUB SET_MAPINFO2
2080 COUNTRY: REM "----   Country Code
2085 LET X0=10,X1=75,X3=3,X4=2,X$=TH11$(151,2),WINDID$="ARENTAW5",GUI_ID=4130
2090 IF FNQ(Q) THEN LET FLDNUM=20; GOSUB QUICK
2095 GOSUB GENINPUT; REM "Country Code"
2100 IF Y$="U" THEN GOTO ZIP
2105 IF X$=FILL(2) OR X$="" THEN GOTO 2120
2110 READ (FILE[OSCN],KEY=X$,ERR=GENERROR,DOM=2115)IOL=OSCN; GOTO 2120
2115 LET X$=CVS(X$,3),O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO COUNTRY
2120 LET TH11$(151,2)=X$+FILL(2-LEN(X$))
2125 GOSUB SET_MAPINFO2
2130 REM "----- Sales Rep"
2135 LET SR=1
2140 REP:
2142 LET RCSKIPPEDSR=0; CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"SR",SPACCESS;IF SPACCESS THEN GOTO 2145 ELSE IF E0<>1 AND E0<>4 THEN LET RCSKIPPEDSR=1; GOSUB CLEAR_GLOBAL;GOTO LEVEL; REM RRW/RCG SP017
2143 CALL "SOENTHDR.HOOKS"+"::AUTO_LOAD_SR_PCT",ERR=*NEXT;IF RCSKIPPEDSR GOSUB DATA;GOTO LEVEL; REM RRW/RCG
2145 LET ZZ=8*(SR-1)+1
2150 LET X0=11+SR,X1=15,X3=0,X4=3,X$=TH3$(ZZ,3),WINDID$="SOENTAW4",X9=0,GUI_ID=4140+((SR-1)*20),PROGID$="ARACRFM.PUB"
2152 IF SR=2 THEN IF TASK$<>"NH" AND CVS(X$,3)="" THEN IF LEN(SAVE_REP$)>10 LET X$=SAVE_REP$(9,3); REM "CWE/RCG - IF Cust or Ship-To changes, rep 2 gets cleared"
2153 IF SR=2 THEN IF TASK$="NH" OR CVS(X$,3)="" THEN LET X$=STBL("SP_TAKEN_BY",ERR=*NEXT); IF NUM(TH3$(4,5))+NUM(TH3$(12,5))=0 THEN LET TH3$(12,5)="100.0"
2155 IF INHOUSE THEN IF SR=2 AND X$=FILL(X4) THEN LET X9=1
2160 IF FNQ(Q) THEN LET FLDNUM=ROUND(SR*2,0); GOSUB QUICK ELSE IF SR=1 AND Y$="J" THEN LET Y$=""
2164 IF CVS(X$,3)<>"" CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"SR",SPACCESS;IF SPACCESS=0 GOSUB CLEAR_GLOBAL;GOTO 2166;REM RRW/RCG SP017
2165 GOSUB GENINPUT; REM "Rep"
2170 IF Y$="U" AND SR=1 THEN IF ADDRESS_EDIT THEN GOTO COUNTRY ELSE GOTO SHIPTO_ID
2174 IF Y$="U" AND SR=2 AND CVS(TH3$(1,3),3)<>"" CALL "SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"SR",SPACCESS;IF SPACCESS=0 GOSUB CLEAR_GLOBAL;IF ADDRESS_EDIT THEN GOTO COUNTRY ELSE GOTO SHIPTO_ID;REM RRW/RCG SP017
2175 IF Y$="U" AND SR=2 THEN LET SR=1; IF TH3$(1,3)=FILL(3) THEN GOTO REP ELSE GOTO SRPCT
2176 IF SR=2 THEN IF CVS(X$,3)="" THEN LET TEST$=STBL("SP_TAKEN_BY",ERR=*NEXT),X9$="Sales Rep 2 is required"; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO REP
2180 LET TH3$(ZZ,3)=X$
2185 IF SR=2 AND CVS(TH3$(1,3),3)<>"" AND TH3$(1,3)=TH3$(9,3) THEN LET X9$="You must enter a different Sales Rep than Sales Rep 1."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO REP
2190 IF TH3$(ZZ,3)=FILL(3) AND GUI AND STBL("DESTID",ERR=2195)=STR(4150+((SR-1)*20)) THEN GOSUB CLEAR_GLOBAL
2195 IF TH3$(ZZ,3)=FILL(3) THEN LET TH3$(ZZ+3,5)=FNNUM$(0,"###.0"); IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(4150+(SR-1)*20,TH3$(ZZ+3,5)),'DISABLE'(4150+((SR-1)*20)) ELSE PRINT 'SF',STBL("FTXT2"),@(28,X0),TH3$(ZZ+3,5), FI; IF SR=1 THEN LET SR=2,RATE1=0; GOTO REP ELSE GOTO LEVEL
2200 LET F0=17; READ (FILE[F0],KEY=TH3$(ZZ,3),DOM=2205,ERR=GENERROR)SR0$; GOTO SRPCT
2205 LET X$=CVS(TH3$(ZZ,3),2),O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 2150
2210 SRPCT:
2215 IF GUI THEN PRINT (OSGUI.CHAN)'ENABLE'(4150+((SR-1)*20))
2220 LET ZZ=8*(SR-1)+1
2225 LET X0=11+SR,X1=28,X3=1,X1$="###.0",X4=LEN(X1$),X=NUM(TH3$(ZZ+3,5)),GUI_ID=4150+((SR-1)*20)
2230 IF FNQ(Q) THEN LET FLDNUM=ROUND(SR*2+1,0); GOSUB QUICK
2235 GOSUB GENINPUT
2240 IF Y$="U" THEN GOTO 2150
2245 LET TH3$(ZZ+3,5)=FNNUM$(X,"###.0"); IF SR=1 THEN LET RATE1=X
2250 IF X<0 THEN LET X9$="Percentages cannot be negative."; GOTO 2270
2255 IF X>100 THEN LET X9$=" Percentages cannot total more than 100. "; GOTO 2270
2260 IF SR=2 THEN IF RATE1+X>100 THEN LET X9$="Percentages cannot total more than 100."; GOTO 2270
2262 IF SR=2 THEN IF RATE1+X<>100 THEN LET X9$="Percentages must equal 100."; goto 2270
2265 GOTO 2275
2270 GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO SRPCT
2275 IF SR=1 THEN LET SR=2; GOTO REP
2280 LEVEL: REM "-----  Cust Level"
2285 IF O2$(28,1)<>"1" THEN IF Y$<>"U" THEN GOTO TERMS ELSE LET SR=2; IF TH3$(9,3)<>FILL(3) THEN GOTO SRPCT ELSE GOTO REP
2288 IF POS("GE100"=STBL("RCMOD",ERR=*NEXT)) THEN IF TH2$<>STBL("SP_CASH_CUST",ERR=*NEXT) THEN GOTO TERMS; REM "G&E100"
2290 LET X0=14,X1=15,X3=0,X4=6,X$=TH13$,GUI_ID=4180; IF O2$(2,1)="1" THEN LET WINDID$="INCLVLW1",SELVAL$="",PROGID$="INACCLFM.PUB"
2295 IF FNQ(Q) THEN LET FLDNUM=6; GOSUB QUICK
2300 GOSUB GENINPUT; REM "Cust Level"
2301 IF Y$="U" AND RCSKIPPEDSR GOSUB CLEAR_GLOBAL;GOTO COUNTRY;REM RRW/RCG SP017
2305 LET PROGID$="",SR=2; IF Y$="U" THEN IF TH3$(9,3)<>FILL(3) THEN GOTO SRPCT ELSE GOTO REP
2310 LET TH13$=X$+FILL(6-LEN(X$))
2315 IF TH13$=FILL(6) OR O2$(2,1)<>"1" THEN GOTO 2330
2320 LET F0=58; FIND (FILE[F0],KEY=TH13$,DOM=2325,ERR=GENERROR); GOTO 2330
2325 LET X$=TH13$,O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO LEVEL
2330 IF S9$<>TH13$ THEN IF POS(STR(TH0)="4579")=0 AND E0<>1 OR (E0=1 AND TASK$="UH") THEN GOSUB RECALC
2335 LET S9$=TH13$
2340 TERMS: REM "-----   Terms"
2345 LET X0=15,X1=15,X3=0,X1$="",X4=6,X$=TH1$(1,6),WINDID$="ARTERMW1",SELVAL$="TERMS-"+FILL(6),PROGID$="ARACTCFM.PUB",GUI_ID=4190
2350 IF FNQ(Q) THEN LET FLDNUM=7; GOSUB QUICK
2355 IF CVS(X$,2)="" THEN LET Y$=""
2359 CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"TC",SPACCESS;IF SPACCESS=0 GOSUB CLEAR_GLOBAL;GOTO 2361;REM RRW/RCG SP017
2360 GOSUB GENINPUT; REM "Terms Code"
2365 LET PROGID$="",SR=2
2370 IF Y$="U" THEN GOTO LEVEL
2375 LET TH1$(1,6)=X$
2380 LET F0=24; READ (FILE[F0],KEY=TH1$(1,6),DOM=2385,ERR=GENERROR)IOL=ARTCXXX; GOTO 2390
2385 LET X$=TH1$(1,6),O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO TERMS
2390 IF CODHOLD THEN IF C4$(7,1)<>"N" AND TC1[1]+TC1[2]+TC1[3]<>0 THEN LET X9$="Customer on credit hold - Must use C.O.D. terms."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO TERMS
2395 LET TYPE$=TERMS$(POS(TC1$(1,1)="RP")*4+1,4),PROXTYPE$=TYPE$,TH2[0]=TC1[1],TH2[1]=TC1[2],TH2[2]=TC1[3]
2400 LET NC=1; GOSUB DATA
2405 ORDNUM_ENTRY: REM "-----   Their Order Number"
2410 LET X0=18,X1=14,X3=0,X4=25,X$=TH8$(2,25),X9=0,GUI_ID=4200
2415 IF POS(STR(TH0)="479") THEN LET X$=TH15$
2420 IF INHOUSE AND X$=FILL(25) THEN LET X9=1
2425 IF FNQ(Q) THEN LET FLDNUM=8; GOSUB QUICK
2430 GOSUB GENINPUT; REM "Their Ord #"
2434 IF Y$="U" CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"TC",SPACCESS;IF SPACCESS=0 GOSUB CLEAR_GLOBAL;GOTO LEVEL;REM RRW/RCG SP017
2435 IF Y$="U" THEN GOTO TERMS
2440 LET X1=0; IF POS(STR(TH0)="479") THEN LET TH15$=X$+FILL(X4-LEN(X$)) ELSE LET TH8$(2,25)=X$
2444 REM
2445 IF POS(STR(TH0)="479") THEN COMPARE$=TH15$ ELSE LET COMPARE$=TH8$(2,25)
2450 IF GUI THEN IF COMPARE$=FILL(25) THEN PRINT (OSGUI.CHAN)'DISABLE'(4210) ELSE PRINT (OSGUI.CHAN)'ENABLE'(4210) FI; IF STBL("INTTYPE",ERR=2455)="BBJ" THEN IF COMPARE$=FILL(25) THEN PRINT (OSGUI.CHAN)'DISABLE'(15210) ELSE PRINT (OSGUI.CHAN)'ENABLE'(15210)
2455 IF GUI THEN IF COMPARE$=FILL(25) AND STBL("DESTID",ERR=2460)="4120" THEN GOSUB CLEAR_GLOBAL
2460 IF CVS(TH8$(2,25),3)<>"" THEN GOSUB CHECK_ORDER
2462 HOOK_REJECT_PONUM=0,X9$="",X8$="";CALL "SOENTHDR.HOOKS"+"::EXTRA_CHECK_PO",ERR=*NEXT; IF X9$<>"" THEN GOSUB CLEAR_GLOBAL;GOSUB GENERROR; GOTO ORDNUM_ENTRY ELSE IF X8$<>"" X9$=X8$,X8$="";GOSUB GENERROR ELSE IF HOOK_REJECT_PONUM GOSUB CLEAR_GLOBAL;Y$="";GOTO ORDNUM_ENTRY;REM RRW/RCG VALIDATE PO NUMBER
2465 ORDDATE_ENTRY: REM "-----   Order Date"
2470 LET X0=19,X1=14,X3=6,X=TH1[0],X$=FND$(X),GUI_ID=4210
2475 IF FNQ(Q) THEN LET FLDNUM=9; GOSUB QUICK
2480 IF POS(STR(TH0)="479") THEN LET X=TH7,X$=FND$(X); IF CVS(TH15$,3)="" THEN LET X=-1; GOTO 2510 FI; GOTO 2490
2485 IF TH8$(2,25)=FILL(25) THEN LET X=-1; GOTO 2510
2487 IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN IF X=-1 THEN LET X=NUM(STBL("JULDATE")),X$=FND$(X); GOTO 2495
2490 IF X=-1 THEN LET X9=1
2495 GOSUB GENINPUT; REM "Order Date"
2500 IF Y$="U" THEN GOTO ORDNUM_ENTRY
2505 IF X=-1 THEN LET X9$="Must enter a valid date."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO ORDDATE_ENTRY
2510 IF POS(STR(TH0)="479") THEN LET TH7=X ELSE LET TH1[0]=X
2515 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,FND$(X)), ELSE PRINT 'SF',STBL("FTXT2"),@(X1,X0),FILL(10),@(14),FND$(X)
2520 INV_NUM: REM "-----   Invoice Number"
2525 IF TH0=8 THEN GOTO SHIP_METHOD
2530 LET X0=20,X1=14,X3=0,X4=8,X$=TH1$(17,8),GUI_ID=4220,GENINPUT.NOSPECIAL=1
2535 IF FNQ(Q) THEN LET FLDNUM=10; GOSUB QUICK
2539 CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"I#",SPACCESS;IF SPACCESS=0 GOSUB CLEAR_GLOBAL;GOTO 2541;REM RRW/RCG SP017
2540 GOSUB GENINPUT; LET GENINPUT.NOSPECIAL=0; REM "Inv #"
2545 IF Y$="U" AND TH8$(2,25)<>FILL(25) THEN GOTO ORDDATE_ENTRY ELSE IF Y$="U" THEN GOTO ORDNUM_ENTRY
2550 LET TH1$(17,8)=X$,X1=0
2552 IF POS("SERV50"=STBL("RCMOD",ERR=*NEXT)) OR POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN LET X=1; IF TH1$(17,8)=FILL(8) THEN LET TH1$(17,8)=TH0$(7,8),TH1[2]=TH1[3]; IF POS("DUKE"=STBL("RCMOD")) THEN LET TH1$(17,1)=STBL("CID") FI; GOSUB DATA
2555 IF GUI THEN IF TH1$(17,8)=FILL(8) THEN PRINT (OSGUI.CHAN)'DISABLE'(4230) ELSE PRINT (OSGUI.CHAN)'ENABLE'(4230) FI; IF STBL("INTTYPE",ERR=2560)="BBJ" THEN IF TH1$(17,8)=FILL(8) THEN PRINT (OSGUI.CHAN)'DISABLE'(15230) ELSE PRINT (OSGUI.CHAN)'ENABLE'(15230)
2560 INV_DATE: REM "-----   Invoice Date"
2565 LET X0=20,X1=28,X3=6,X=TH1[2],X$=FND$(X),GUI_ID=4230
2570 IF FNQ(Q) THEN LET FLDNUM=11; GOSUB QUICK
2575 LET DESTTEST$="",DESTTEST$=STBL("DESTID",ERR=2580)
2580 IF TH1$(17,8)=FILL(8) THEN LET X=-1; IF DESTTEST$=STR(GUI_ID) THEN GOSUB CLEAR_GLOBAL FI; GOTO 2605
2585 IF TH1[2]=-1 THEN LET X9=1
2589 CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"I#",SPACCESS;IF SPACCESS=0 GOTO 2591;REM RRW/RCG SP017
2590 GOSUB GENINPUT; REM "Inv Date"
2595 IF Y$="U" THEN GOTO INV_NUM
2600 IF X=-1 THEN LET X9$="Must enter a valid date."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO INV_DATE
2605 LET TH1[2]=X
2610 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,FND$(X)), ELSE PRINT 'SF',STBL("FTXT2"),@(X1,X0),FILL(10),@(28),FND$(X)
2615 SHIP_METHOD: REM "-----   Ship Method"
2620 LET X0=12,X1=56,X3=0,X4=6,X$=TH7$(1,6),WINDID$="ARSHIPW1",SELVAL$="SHPVIA"+FILL(6),PROGID$="ARACSVFM.PUB",X9=0,GUI_ID=4240
2625 IF INHOUSE AND CVS(X$,2)="" AND CVS(TH12$(1,20),2)="" THEN LET X9=1
2630 IF FNQ(Q) THEN LET FLDNUM=21; GOSUB QUICK ELSE IF Y$="J" THEN LET Y$=""
2635 GOSUB GENINPUT; REM "Ship Method
2639 IF Y$="U" AND TH0<>8 CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"I#",SPACCESS;IF SPACCESS=0 GOSUB CLEAR_GLOBAL;GOTO ORDNUM_ENTRY;REM RRW/RCG SP017
2640 IF Y$="U" THEN IF TH0=8 THEN IF CVS(TH8$(2,25),3)="" THEN GOTO ORDNUM_ENTRY ELSE GOTO ORDDATE_ENTRY FI ELSE IF TH1$(17,8)=FILL(8) THEN GOTO INV_NUM ELSE GOTO INV_DATE
2645 LET TH7$(1,6)=X$+FILL(6-LEN(X$))
2650 IF INHOUSE THEN IF TH7$(1,6)=FILL(6) AND CVS(TH12$(1,20),2)="" THEN LET X9$="Must enter ship method"; GOSUB GENERROR; GOTO SHIP_METHOD
2655 READ (FILE[22],KEY=TH7$(1,6),DOM=SHIP_VIA,ERR=GENERROR)*,XX$
2660 LET TH12$(1,20)=XX$,XX$=""
2665 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(4250,TH12$(1,20)), ELSE PRINT @(56,13),'SF',STBL("FTXT2"),TH12$(1,20),
2670 SHIP_VIA: REM "-----   Ship Via"
2675 LET X0=13,X1=56,X3=0,X4=20,X$=TH12$,X9=0,GUI_ID=4250
2680 IF FNQ(Q) THEN LET FLDNUM=22; GOSUB QUICK
2685 GOSUB GENINPUT; REM "Ship Via"
2690 IF Y$="U" THEN GOTO SHIP_METHOD
2695 LET X$=X$+FILL(20-LEN(X$))
2700 LET TH12$(1,20)=X$
2705 SLIP_NUM: REM "-----   Picking Slip Number"
2710 LET X0=14,X1=65,X3=1,X4=6,X=NUM(TH1$(11,6)),X1$="######",GUI_ID=4260
2715 IF FNQ(Q) THEN LET FLDNUM=23; GOSUB QUICK
2720 GOSUB GENINPUT; REM "Ship #"
2725 IF Y$="U" THEN GOTO SHIP_VIA
2730 LET TH1$(11,6)=FNNUM$(X,"000000"),X$="",X1$=""
2735 IF TH1$(11,6)=FILL(6,"0") THEN LET TH1$(11,6)=FILL(6),TMPMASK$="######" ELSE LET TMPMASK$="000000"
2740 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,FNGUINUM$(NUM(TH1$(11,6)),TMPMASK$,4260)), ELSE PRINT @(X1,X0),'SF',TH1$(11,6),; LET X1=0
2745 REQ_SHIP_DATE: REM "-----   Requested Ship Date"
2750 IF TASK$="EH" OR TASK$="UH" THEN LET SAVEDATE=TH1[4]
2755 LET X0=15,X1=65,X3=6,X=TH1[4],X$=FND$(TH1[4]),GUI_ID=4270
2760 IF FNQ(Q) THEN LET FLDNUM=24; GOSUB QUICK
2765 GOSUB GENINPUT; REM "Req Date"
2770 IF Y$="U" THEN GOTO SLIP_NUM
2775 LET TH1[4]=X
2780 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,FND$(TH1[4])), ELSE PRINT 'SF',STBL("FTXT2"),@(X1,X0),FND$(TH1[4]),
2785 IF TASK$="NH" OR SAVEDATE=TH1[4] THEN LET CHANGE_SHIP_DATE$=""; GOTO ACT_SHIP_DATE
2790 IF GUI THEN LET O7=10,X9$="Do you want to change requested ship dates on all line items?"; GOSUB GENERROR; IF Y$="E" THEN LET X$="YES" ELSE LET X$="NO " FI; GOTO 2815
2795 PRINT 'BACKGR',STBL("FBKG"),'SB',STBL("FTXT"),@(2,22),FILL(75),@(5),"Do you want to change requested ship dates on all line items?",
2800 LET X0=22,X1=72,X3=5,X4=3,X1$="",X$="NO ",SAVEYDIS$=YDISABLE$,YDISABLE$="DMSXU",Y$=""
2805 GOSUB GENINPUT
2810 LET X8$=" "; GOSUB GENERROR; PRINT 'BACKGR',STBL("FBKG2"),'DEFAULT','SF',STBL("FTXT2"),
2815 LET CHANGE_SHIP_DATE$=X$(1,1),YDISABLE$=SAVEYDIS$,SAVEYDIS$=""
2820 ACT_SHIP_DATE: REM "-----   Actual Ship Date"
2825 LET X0=16,X1=65,X3=6,X=TH1[1],X$=FND$(TH1[1]),SR11=TH1[1],GUI_ID=4280
2830 IF FNQ(Q) THEN LET FLDNUM=25; GOSUB QUICK
2835 GOSUB GENINPUT; REM "Act Date"
2840 IF Y$="U" THEN GOTO REQ_SHIP_DATE
2845 LET TH1[1]=X
2850 IF X>0 AND SR11<>TH1[1] THEN GOSUB GENPC1; LET G1=X,GLYR=YEAR; IF LOCKFLAG OR INVALIDYEAR THEN LET G1=0,GLYR=0 FI; LET TH4$=STR(G1:"00"),TH5$(1,4)=STR(GLYR:"0000"),O9$=""
2855 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,FND$(TH1[1])),'TITLE'(4290,TH4$+TH5$(1,4)), ELSE PRINT 'SF',STBL("FTXT2"),@(65,16),FND$(TH1[1]),@(56,17),TH4$+"/"+TH5$(1,4),
2860 GLPD: REM "-----   GL Period/Year"
2862 LET YEAR=NUM(TH5$(1,4)),X=NUM(TH4$),DATE$=""; IF X<>0 THEN GOSUB GENPC; GOSUB GENPC2
2865 IF LOCKFLAG OR INVALIDYEAR THEN LET Y$=""; GOSUB CLEAR_GLOBAL
2870 LET X0=17,X1=56,X3=16,X$=TH4$+"/"+TH5$(1,4),GUI_ID=4290
2872 IF LOCKFLAG OR INVALIDYEAR THEN GOTO 2880; REM "----- Skip Quick Entry if GL Pd/Year is invalid or locked."
2875 IF FNQ(Q) THEN LET FLDNUM=26; GOSUB QUICK
2880 GOSUB GENINPUT; REM "GL Pd/Year"
2885 IF Y$="U" THEN GOTO ACT_SHIP_DATE
2890 LET TH4$=X$(1,2),TH5$(1,4)=X$(4,4),G1=NUM(X$(1,2)),GLYR=NUM(X$(4,4))
2895 IF CVS(TH4$,3)="" OR CVS(TH5$(1,4),3)="" THEN LET Y$=""; GOSUB CLEAR_GLOBAL; GOTO GLPD
2900 TAX: REM "----- Taxable?"
2905 IF FNQ(Q) THEN LET FLDNUM=27; GOSUB QUICK
2910 IF S6=0 THEN LET YN$="NO " ELSE LET YN$="YES"
2915 LET X0=18,X1=56,X3=5,X4=3,X1$="",X$=YN$,SAVES6=S6,GUI_ID=4300
2920 GOSUB GENINPUT; REM "TAXABLE?"
2925 IF Y$="U" THEN GOTO GLPD
2930 LET YN$=X$; IF YN$(1,1)="N" THEN LET S6=0 ELSE LET S6=1
2935 TAXGP: REM "----- Tax Group"
2940 IF FNQ(Q) THEN LET FLDNUM=28; GOSUB QUICK
2945 LET X0=19,X1=56,X3=0,X4=6,X$=TH1$(25,6),WINDID$="RMGRPCOD",PROGID$="RMACGCFM.PUB",SAVETAXLOC$=TH1$(25,6),GUI_ID=4310
2950 GOSUB GENINPUT; REM "TAX GROUP"
2955 IF Y$="U" THEN GOTO TAX
2960 IF CVS(X$,3)="" THEN LET Y$=""; GOTO 2945
2965 LET TH1$(25,6)=X$,F0=18,S91$(1,6)=TH1$(25,6)
2970 GOSUB GETTAX; IF X9$<>"" OR O7=8 THEN GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO TAXGP
2975 IF TH1$(25,6)<>SAVEHDR$(1,6) AND SAVEHDR$(1,6)<>FILL(6) THEN LET X9$="Changing tax group will recalculate taxes and set tax adjustment to zero."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; IF SHIPTO_TAX_CHANGED THEN LET SAVETAXLOC$=SAVEHDR$(1,6),SHIPTO_TAX_CHANGED=0
3000 REM 3000,5 "-----   All Done"
3005 IF X8=1 THEN GOSUB DATA
3007 CALL "SOENTHDR.HOOKS"+"::BEFORE_FINAL_PAGEDOWN",ERR=*NEXT; IF Y$="U" AND INQONLY=0 AND INHIST=0 THEN GOSUB CLEAR_GLOBAL; GOTO TAXGP ELSE IF POS(Y$="XMSLR") THEN GOTO 8420
3009 LET A$=STBL("LOADORD",ERR=3010);IF CVS(A$,3)<>"" A$=STBL("!CLEAR","LOADORD");Y$="P";GOTO 3020;REM RRW/RCG SP000 AUTO-LOAD OF ORDER
3010 LET O7=2; GOSUB GENERROR
3015 IF Y$="U" THEN GOTO TAXGP
3020 IF Y$<>"P" THEN GOTO 3010
3025 IF GUI THEN GOSUB DESTROY_GUI_WINDOW ELSE PRINT 'POP',
3030 LET INVOICE$=TH1$(17,8)
3035 GOSUB WRITETOT
3040 GOSUB UPDATE_ORDER_HEADER
3045 IF TASK$<>"UH" THEN GOSUB RESTART
3050 GOSUB CLEAR_MAPINFO; RUN "SOENTCON"
3055 RESTART:
3060 LET PARAM=3,STATUS=-1; IF TH0=4 THEN LET STATUS=-2
3065 CALL "ARRESTRT.PUB",FILE[15],F1,BATCH$,TERM$,MSG$,PICKS$,PARAM,STATUS
3070 RETURN
3075 REM "-----   Write Totals Record"
3080 WRITETOT:
3085 DIM TD0$(17)
3090 LET TD0$(1,14)=TRAN$,TH0$=TRAN$,TH5$(5,32)=FILL(32,"}"),TH6$(1,26)=FILL(20,"}")+LO0$,TH5[ALL]=TOT[ALL],TH4=SHIPTONUM,TH1$(25,6)=S91$(1,6),SHIPTONAME$=TH11$(1,30),TH5[6]=0,TH5[7]=0
3092 SPTST$=FIELD(THCFF$,"SHIPTO_ID",ERR=*NEXT);THCFF.SHIPTO_ID$=SPSHIPTO$;REM SP007
3095 IF S6 THEN LET TH1$(7,1)="Y" ELSE LET TH1$(7,1)="N"
3100 PRECISION MXPR
3105 RETURN
3110 GETTAX:
3115 DIM GC2$(6),GC3$(6),GC4$(6),GC5$(6),GC6$(6),GC7$(8),GC8$[1:1],GC9$[1:2],GC10$[1:3],GC11$[1:4]
3120 LET X9$="",O7=0
3125 READ (FILE[18],KEY=TH1$(25,6),DOM=3127,ERR=GENERROR)IOL=RMGCXXX; GOTO 3130
3127 LET O7=8
3130 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(4310,TH1$(25,6)),'TITLE'(2150,GC1$) ELSE PRINT 'SF',@(56,19),TH1$(25,6),@(56,20),GC1$,
3135 DIM GC2$(0),GC3$(0),GC4$(0),GC5$(0),GC6$(0),GC7$(0),GC8$[1:1],GC9$[1:2],GC10$[1:3],GC11$[1:4]
3140 RETURN
3145 QUICK:
3150 IF Y$="P" THEN RETURN
3155 IF FLDERR THEN LET Y$="",FLDERR=0; RETURN
3160 IF HDR[FLDNUM]=0 AND (Y$="E" OR Y$="") THEN LET Y$="Q"; RETURN
3165 IF Y$="U" THEN LET Y$=""; RETURN
3170 IF HDR[FLDNUM]=1 AND Y$="Q" THEN LET Y$=""; RETURN
3175 IF HDR[FLDNUM]=2 AND (Y$="J" OR Y$="Q") THEN LET Y$=""; RETURN
3180 RETURN
3185 GETDIST: REM "----- Get Distribution Code"
3190 DIM DCCFF$:FATTR(DCCFF$),DCCFV$:FATTR(DCCFV$); LET NOTFOUND=0
3195 READ (FILE[26],KEY=C4$(3,2),DOM=3200,ERR=GENERROR)IOL=ARDCXXX; GOTO 3205
3200 LET X$=CVS(C4$(3,2),2),X9$="Distribution Code "+C4$(3,2)+" is not on file.",NOTFOUND=1
3205 RETURN
3400 REM 3400,5 "-----   Enter Order Date"
3405 ORDERDATE:
3410 IF E0<>2 THEN GOTO 3560; REM "Skip Verify Stuff"
3415 IF TH1[1]<1 THEN LET TH1[1]=WKSDATE
3420 LET X$=STBL("DATE"); GOSUB GENPC1; LET VR33$=FNNUM$(X,"00")+STR(YEAR),O9$=""
3425 GOSUB DATA
3430 IF GUI=0 THEN PRINT 'BACKGR'+STBL("FBKG"),STBL("FTXT"),
3435 IF VR33$=TH4$+TH5$(1,4) THEN LET VPD$=TH4$+TH5$(1,4); GOTO 3475
3440 IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN LET X$="YES"; GOTO 3465
3441 LET X8$="Order Period Is Not Current.  Use Period "+VR33$(1,2)+"/"+VR33$(3,4)+"?  "; IF GUI=0 THEN GOSUB GENERROR ELSE LET X9$=X8$,O7=10; GOSUB GENERROR; IF Y$="E" THEN LET X$="YES" ELSE LET X$="NO " FI; GOTO 3465
3445 LET X0=22,X1=65,X3=5,X4=3,X1$="",X$="",Y$=""
3450 PRINT 'BACKGR'+STBL("FBKG2"),STBL("FTXT2"),
3455 GOSUB GENINPUT
3460 IF Y$="U" THEN GOTO 3455
3465 IF X$="YES" THEN LET VPD$=VR33$ ELSE LET VPD$=TH4$+TH5$(1,4)
3470 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(4290,VPD$), ELSE PRINT 'BACKGR'+STBL("FBKG2"),'SF',STBL("FTXT2"),@(56,17),FNNUM$(NUM(VPD$(1,2)),"##")+"/"+VPD$(3,4),'BACKGR'+STBL("FBKG"),STBL("FTXT"),
3475 REM "-----   Ask Ship All?"
3480 IF TH0=7 THEN LET X8$="Return All? (Y/N)" ELSE LET X8$="Ship All?  (Y/N)"
3485 LET O7=0; IF GUI=0 THEN GOSUB GENERROR ELSE LET X9$=X8$,O7=10; GOSUB GENERROR; IF Y$="E" THEN LET X$="YES" ELSE LET X$="NO " FI; GOTO 3510
3490 LET X0=22,X1=51,X3=5,X4=3,X1$="",X$="",Y$=""
3495 PRINT 'BACKGR'+STBL("FBKG2"),STBL("FTXT2"),
3500 GOSUB GENINPUT
3505 IF Y$="U" THEN IF VR33$<>TH4$ THEN GOTO 3440 ELSE GOTO 3500
3510 LET X8$=" "; GOSUB GENERROR
3515 DIM VTOT[10]; LET P8$="SOENTVER",SHIPALL=0,X1$="UPDATE",VTOT[3]=TH5[3],VTOT[4]=TH5[4],VTOT[6]=TH5[6]+TH5[7]
3520 IF X$="YES" THEN LET SHIPALL=1; GOTO 3545
3525 IF TH0=7 OR C4$(8,1)="Y" THEN GOTO 3545
3530 LET X8$="Customer Does Not Accept Partial Shipments.  Verify Anyway? (Y/N)"; GOSUB CLEAR_GLOBAL; IF GUI=0 THEN GOSUB GENERROR ELSE LET X9$=X8$,O7=10; GOSUB GENERROR; IF Y$="E" THEN LET X$="Y" ELSE LET X$="N" FI; GOTO 3540
3535 LET X0=22,X1=76,X3=9,X4=1,X1$=" ",X$=" ",X9=1; GOSUB GENINPUT; LET X$=CVS(X$,4)
3540 IF X$="Y" THEN GOTO 3545 ELSE IF X$="N" THEN LET PROGID$=""; GOTO ABANDON ELSE GOTO 3535
3545 GOSUB RESTART; GOSUB GETTAX
3550 IF GUI THEN GOSUB DESTROY_GUI_WINDOW ELSE PRINT 'POP',
3555 GOSUB CLEAR_MAPINFO; RUN "SOENTCON"; REM "Verify"
3560 REM "-----   Our Order Date"
3562 IF TH0=6 THEN IF DO2$(66,1)="1" THEN IF TH1$(17,8)=FILL(8) THEN LET TH1$(17,8)=TH0$(7,8) FI; IF TH1[2]=-1 THEN LET TH1[2]=TH1[3] FI; IF GUI THEN PRINT (OSGUI.CHAN)'ENABLE'(4230)
3563 IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN IF TH0=6 THEN IF DO2$(66,1)="1" THEN IF TH1$(17,8)<>FILL(8) THEN LET TH1$(17,1)=STBL("CID")
3565 GOSUB DATA; GOSUB SET_MAPINFO
3570 LET X0=2,X1=34,X3=6,X=TH1[3],X$=FND$(TH1[3]),GUI_ID=4020
3575 IF POS(STR(E0)="14") THEN IF Y$<>"U" AND UPFLAG=0 THEN LET Y$="J"
3580 GOSUB GENINPUT; REM "ord dt"
3585 IF Y$="U" THEN IF TASK$="NH" THEN GOTO 3605 ELSE GOSUB CLEAR_GLOBAL; GOTO 3570
3590 IF X=-1 THEN LET X9$="Must enter a valid date."; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 3570
3595 LET TH1[3]=X,E5=X
3600 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(GUI_ID,FND$(TH1[3])), ELSE PRINT 'SF',STBL("FTXT2"),@(X1,X0),FND$(TH1[3]),
3605 RETURN
3610 REM "-----   Generate/Validate/Reserve Order Numbers"
3615 ORDERNUM: REM "get control rec"
3620 LET X9$="",ORDERR=0,Y$=""
3625 IF E0=1 OR E0=4 THEN IF Y$<>"U" AND UPFLAG=0 THEN LET Y$="J"
3630 CALL "SOENTHDR.PUB",FILE[ALL],TH0$,TH0,TH1$,TH1[ALL],TH2$,TH3$,TH2[ALL],TH3,TH4$,TH5$,TH4,TH5[ALL],TH6$,TH7$,TH8$,TH9$,TH10$,TH11$,TH12$,TH13$,TH6[ALL],TH14$,TH15$,TH7,THCFF$,THCFV$,X1$,X9$,TRAN$,CTKEY$,CTORD$,S,E0,E1,ORD_CRED_FLAG,AUTO_GENERATE_FLAG,SHIPTONUM,SHIPTONAME$,LO0$,S91$,TOT[ALL],TOT2[ALL],S6,CREDLIM,C1$,C2$,C4$,C7$,TC0$,TC1$,TC2$,TC1[ALL],TYPE$,FRTAX,ORDERR,TERMS$,BTEST,Y$,CRCFF$,CRCFV$,HCFF$,HCFV$,CCFF$,CCFV$,TCCFF$,TCCFV$,SOTH$,ARCR$,OSGUI$,SPSHIPTO$;REM RRW/RCG SP007
3635 IF Y$="M" THEN LET O7=-3; GOTO QUIT
3640 REM "IF ORDERR THEN LET X9$="",X$=CVS(TH0$(7,8),2),O7=8; GOSUB GENERROR; LET O7=0,X$="""
3645 IF ORDERR THEN GOSUB GENERROR
3650 IF ORDERR=1 THEN GOTO 3685 ELSE LET ORDERR=0
3652 IF E0<>1 AND E0<>4 AND POS(STR(TH0:"00")="030405",2) AND TH0$(7,8)<>FILL(8) CALL "SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"CV",SPACCESS;IF SPACCESS=0 X9$="Not authorized to change verified orders; use inquiry";o7=4;gosub generror;REM SP017 RRW/RCG
3653 IF CVS(STBL("LOADORD",ERR=*NEXT),3)<>"" Y$="P";REM RRW/RCG SP000 AUTO-LOAD OF ORDER
3655 IF O2$(2,1)="1" THEN IF POS(X0$="DS") THEN READ RECORD(FILE[40],KEY=LO0$,ERR=3685)INLO$
3660 IF POS(X0$="DS") THEN GOSUB GETDIST; IF NOTFOUND THEN LET ORDERR=1,X9$=""; GOTO 3685 ELSE LET MOPACCT$=DC2$(1,12),S9$=C4$(22,6)
3665 LET C0$=TH2$
3670 IF BTEST THEN GOTO 3685
3675 IF E0=3 THEN GOSUB GETTAX; LET O7=0
3680 IF X0$="E" THEN GOSUB SAVEHDR
3685 LET BTEST=0
3690 RETURN
3700 RECALC: REM 3700,5 "---- Ask for Recalc
3705 IF O2$(2,1)<>"1" THEN GOTO RECALC_DONE
3710 LET X8$="Customer Level changed, recalculate prices?"
3715 IF GUI THEN LET X9$=X8$,X8$="",O7=10; GOSUB GENERROR; IF Y$="E" THEN LET X$="YES" ELSE LET X$="NO " FI; GOTO 3740
3720 GOSUB GENERROR
3725 LET X0=22,X1=63,X3=5,X1$="",X4=3,X$="NO ",Y$=""
3730 GOSUB GENINPUT
3735 IF Y$="U" THEN GOTO RECALC_DONE
3740 IF X$(1,1)="N" THEN GOTO RECALC_DONE
3745 CALL "SOENTCPR.PUB"
3750 RECALC_DONE:
3755 LET X8$=" "; GOSUB GENERROR
3760 RETURN
3800 REM 3800 "----- Read Default Ship-to "
3810 GET_SHIPTO:
3820 IF TH11$(1,152)<>FILL(152) THEN GOTO 3910
3830 DIM S1$(152),S2$(38)
3840 IF INHOUSE THEN LET KEY$=TH2$+STR(1:"000000") ELSE LET KEY$=TH2$+STR(TH4:"000000")
3849 IF SP007_ALPHA_SHIPTO KEY$=TH2$+THCFF.SHIPTO_ID$;REM RRW/RCG SP007
3850 READ (FILE[11],KEY=KEY$,DOM=3890,ERR=GENERROR)IOL=ARSAXXX
3860 LET TH11$(1,152)=S1$,TH12$=S2$(1,20),S1$="",S2$=""; IF INHOUSE THEN LET SHIPTONUM=1 ELSE LET SHIPTONUM=TH4
3861 IF SP007_ALPHA_SHIPTO SPSHIPTO$=THCFF.SHIPTO_ID$
3870 IF CVS(S4$(1,3),3)<>"" THEN LET TH3$(1,3)=S4$(1,3) FI; IF CVS(S4$(4,3),3)<>"" THEN LET TH3$(9,3)=S4$(4,3); IF TH3$(1,3)=TH3$(9,3) THEN LET TH3$(9,3)=FILL(3)
3880 GOTO 3910
3890 REM "----- Ship-to 000001 Not Found, Use Customer Address"
3900 IF INHOUSE THEN LET TH11$(1,152)=C1$+FILL(30-LEN(C1$))+C2$(1,122),TH12$=FILL(20)
3910 RETURN
4000 REM 4000,5 "----- check for duplicate order number"
4005 CHECK_ORDER:
4006 DUP_PO_FOUND=0;REM RRW/RCG
4010 READ (FILE[81],KEY=C0$+TH8$(2,25),KNUM=8,DOM=NEXT_ORDER_READ,ERR=GENERROR)
4015 NEXT_ORDER_READ:
4020 LET CHECK_PO_KEY$=KEY(FILE[81],END=CHECK_PO_HIST)
4025 IF CHECK_PO_KEY$(1,31)=C0$+TH8$(2,25) THEN IF CHECK_PO_KEY$(32)=TH0$ THEN READ(FILE[81],END=CHECK_PO_HIST); GOTO NEXT_ORDER_READ ELSE GOTO CHECK_PO_MSG
4030 CHECK_PO_HIST:
4035 IF O2$(7,1)<>"1" THEN GOTO CHECK_ORDER_DONE
4040 READ (FILE[82],KEY=C0$+TH8$(2,25),KNUM=14,DOM=NEXT_HIST_READ,ERR=GENERROR)
4045 NEXT_HIST_READ:
4050 LET CHECK_PO_KEY$=KEY(FILE[82],END=CHECK_ORDER_DONE)
4055 IF CHECK_PO_KEY$(1,31)=C0$+TH8$(2,25) THEN GOTO CHECK_PO_MSG
4060 CHECK_ORDER_DONE:
4065 RETURN
4070 CHECK_PO_MSG:
4071 DUP_PO_FOUND=1;REM RRW/RCG
4075 LET X9$="This Customer PO number has already been used.",O7=0; GOSUB GENERROR; GOTO CHECK_ORDER_DONE
4080 REM "Save Header Info"
4085 SAVEHDR:
4090 LET SAVEHDR$=TH1$(25,6)+FNNUM$(S6,"0")+STR(TH0)+TH1$(11,14)+STR(TH1[0])+STR(TH1[1])+STR(TH1[2])+STR(TH1[3])+STR(TH1[4])+TH2$+TH3$+TH1$(1,6)+TH4$+TH5$(1,4)+TH9$+TH10$+TH8$(2,25)+TH13$+FNNUM$(TH4,"000000")+TH11$+TH12$+TH6$(21,6)+TH15$+STR(TH7)
4092 CALL "SOTATTLE.HOOKS"+"::SAVE_HDR",ERR=*NEXT; REM HIH/RCG SP001
4095 LET SAVE_CUST_LEV$=TH13$,SAVE_REP$=TH3$
4100 RETURN
4200 REM 4200 "----- Verify Defaault option and set new values"
4205 SET_DEFAULT_VALUES:
4210 IF TASK$="UH" OR DEFAULTED=1 THEN GOTO 4220
4214 LET TEMP$=TH0$(7,8); IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN LET TEMP$(1,1)=STBL("CID")
4215 IF (E0=1 AND E1<=3) THEN LET TH1$(17,8)=TEMP$,TH1[2]=TH1[3],DEFAULTED=1; IF GUI THEN PRINT (OSGUI.CHAN)'ENABLE'(4230),'TITLE'(4220,TH1$(17,8)),'TITLE'(4230,FND$(TH1[2])) ELSE PRINT @(14,20),TH1$(17,8),@(28),FND$(TH1[2]) FI; GOTO 4275 FI ; REM New and Shipped Orders; REM "CWE/RCG - Changed TH0$(7,8) to TEMP$ assigned in 4214
4220 IF POS("DUKE"=STBL("RCMOD",ERR=*NEXT)) THEN LET TEMP$=TH0$(7,8),TEMP$(1,1)=STBL("CID"); IF TH1$(17,8)=TEMP$ THEN GOTO 4275 ELSE GOTO 4222
4221 IF TH1$(17,8)=TH0$(7,8) AND TH1[2]=TH1[3] THEN GOTO 4275
4225 LET X8$="Default Order No and Date into Invoice No and Date? (Y/N)"
4230 IF GUI THEN LET X9$=X8$,X8$="",O7=10; GOSUB GENERROR; IF Y$="E" THEN LET X$="YES" ELSE LET X$="NO " FI; GOTO 4260
4235 IF GUI=0 THEN PRINT @(1,22),FILL(77),@(1,22),FILL(77)
4240 GOSUB GENERROR
4250 LET X0=22,X1=70,X3=5,X1$="",X4=3,X$="NO ",Y$=""
4255 GOSUB GENINPUT
4259 LET MSG$=FILL(72); GOSUB DISMSG
4260 IF X$(1,1)="Y" THEN LET TH1$(17,8)=TH0$(7,8),TH1[2]=TH1[3]; IF GUI THEN PRINT (OSGUI.CHAN)'ENABLE'(4230),'TITLE'(4220,TH1$(17,8)),'TITLE'(4230,FND$(TH1[2])) ELSE PRINT @(14,20),TH1$(17,8),@(28),FND$(TH1[2]) FI
4261 IF POS("DUKE"=STBL("RCMOD")) THEN IF X$(1,1)="Y" THEN LET TH1$(17,1)=STBL("CID"); IF GUI THEN PRINT (OSGUI.CHAN)'ENABLE'(4230),'TITLE'(4220,TH1$(17,8)),'TITLE'(4230,FND$(TH1[2])) ELSE PRINT @(14,20),TH1$(17,8),@(28),FND$(TH1[2]) FI
4275 RETURN
4300 REM 4300 "----- Update order header info for Verify and Change"
4310 UPDATE_ORDER_HEADER:
4320 IF TASK$="NH" THEN LET F0=37; WRITE (FILE[37],ERR=GENERROR)IOL=SOTHXXX; GOTO 4340
4325 LET SAVETOT6=TOT[6],SAVETOT7=TOT[7]
4327 CALL "SOTATTLE.HOOKS"+"::HEADER_CHANGE",ERR=*NEXT; REM HIH/RCG SP001
4330 CALL "SOENTHD2.PUB",FILE[ALL],TH0$,TH0,TH1$,TH1[ALL],TH2$,TH3$,TH2[ALL],TH3,TH4$,TH5$,TH4,TH5[ALL],TH6$,TH7$,TH8$,TH9$,TH10$,TH11$,TH12$,TH13$,TH6[ALL],TH14$,TH15$,TH7,THCFF$,THCFV$,TRAN$,S6,S6[ALL],TAX,TOT[ALL],TOT2[ALL],SAVEHDR$,GC1$,RMGC,RMTH,RMTD,SAVES6,SAVETAXLOC$,CHANGE_SHIP_DATE$,TDCFF$,TDCFV$,OSGUI$
4335 LET TOT[6]=SAVETOT6,TOT[7]=SAVETOT7
4340 LET SAVEHDR$=""
4342 CALL"SOENTHDR.HOOKS"+"::EXTRA_UPDATE_HEADER",ERR=*NEXT;REM RRW/RCG
4345 IF TASK$<>"UH" AND CVS(LOADORD$,3)="" THEN CALL "SOTATTLE.HOOKS"+"::ORD_ADD_CHANGE",ERR=*NEXT;REM HIH/RCG SP001;REM RRW/RCG NOT WHEN JUMPING IN
4350 RETURN
4400 REM 4400
4410 FIND_ORDER:
4420 IF GUI=0 THEN PRINT 'PUSH','CS',
4430 CALL "SOINQINI",O2$,OSGUI$,BATCH$,ORDER_NUM$,GENINPUT$
4432 TH0$(1,6)=BATCH$;REM RRW/RCG BUG FIX 090811
4440 IF GUI=0 THEN PRINT 'POP',
4450 RETURN
4580 DISMSG:
4585 IF GUI THEN GOTO 4600
4590 IF GUI=0 THEN PRINT 'BACKGR'+STBL("FBKG"),'SF',STBL("FTXT2"),@(2,22),MSG$,
4595 IF GUI=0 THEN PRINT 'BACKGR'+STBL("FBKG2"),'SF',STBL("FTXT2")
4600 LET X8$=""
4605 RETURN
4800 REM 4800,5 "----- Set up Map Address Information"
4805 SET_MAPINFO:
4807 IF GUI THEN IF CVS(C2$(1,30),3)+CVS(C2$(31,30),3)+CVS(C2$(61,30),3)+CVS(C2$(91,15),3)+CVS(C2$(106,3),3)+CVS(C2$(109,12),3)+CVS(C2$(121,2),3)<>"" THEN PRINT (OSGUI.CHAN)'ENABLE'(34000) ELSE PRINT (OSGUI.CHAN)'DISABLE'(34000)
4810 IF C2$(121,2)="  " THEN LET COUNTRY$=STBL("COUNTRY") ELSE LET COUNTRY$=C2$(121,2)
4815 LET ADDRESS$="[address]="+CVS(C2$(1,30),3)+" "+CVS(C2$(31,30),3)+" "+CVS(C2$(61,30),3)+":\[city]="+CVS(C2$(91,15),3)+":\[state]="+CVS(C2$(106,3),3)+":\[zip]="+CVS(C2$(109,12),3)+":\[country]="+CVS(COUNTRY$,3)+":\"
4820 LET DUMMY$=STBL("MAPINFO1",ADDRESS$)
4825 SET_MAPINFO2:
4827 IF GUI THEN IF CVS(TH11$(31,30),3)+CVS(TH11$(61,30),3)+CVS(TH11$(91,30),3)+CVS(TH11$(121,15),3)+CVS(TH11$(136,3),3)+CVS(TH11$(139,12),3)+CVS(TH11$(151,2),3)<>"" THEN PRINT (OSGUI.CHAN)'ENABLE'(34010) ELSE PRINT (OSGUI.CHAN)'DISABLE'(34010)
4830 IF TH11$(151,2)="  " THEN LET COUNTRY$=STBL("COUNTRY") ELSE LET COUNTRY$=TH11$(151,2)
4835 LET ADDRESS$="[address]="+CVS(TH11$(31,30),3)+" "+CVS(TH11$(61,30),3)+" "+CVS(TH11$(91,30),3)+":\[city]="+CVS(TH11$(121,15),3)+":\[state]="+CVS(TH11$(136,3),3)+":\[zip]="+CVS(TH11$(139,12),3)+":\[country]="+CVS(COUNTRY$,3)+":\"
4840 LET DUMMY$=STBL("MAPINFO2",ADDRESS$)
4845 RETURN
4900 REM 4900,5 "----- Clear Map Address Information"
4905 CLEAR_MAPINFO:
4910 LET DUMMY$=STBL("!CLEAR","MAPINFO1",ERR=4920)
4915 CLEAR_MAPINFO2:
4920 LET DUMMY$=STBL("!CLEAR","MAPINFO2",ERR=4925)
4925 RETURN
5300 REM 5300,5 "----- Get RMA Number"
5305 GET_RMA_NO:
5310 DIM XXTB$:FATTR(XXTB$); LET XXTB.TBID$="FRMA"+STBL("CID")+FILL(4-LEN(STBL("CID")))
5315 EXTRACT RECORD (FILE[30],KEY=XXTB.TBID$,DOM=5320)XXTB$; GOTO GOT_FRMA
5320 DIM XXTB$:FATTR(XXTB$); LET XXTB.TBID$="FRMA    "
5325 EXTRACT RECORD (FILE[30],KEY=XXTB.TBID$,DOM=5330)XXTB$; GOTO GOT_FRMA
5330 LET XXTB.TBID$="FRMA"+STBL("CID")+FILL(4-LEN(STBL("CID"))),XXTB.COLS=2,XXTB.TYPE$="A",XXTB.HEAD$=FILL(77),XXTB.HEAD$(1,9)="Form Type",XXTB.HEAD$(27,6)="Number",XXTB.ENT$=FILL(504),XXTB.ENT$(1,3)="RMA",XXTB.ENT$(26,8)="00000001",XXTB.DESCR$="RMA Number Table",XXTB.WIDTH=25
5335 WRITE RECORD(FILE[30],KEY=XXTB.TBID$)XXTB$
5340 GOTO GET_RMA_NO
5345 GOT_FRMA:
5350 LET CARRY=1,RMANO$=CVS(XXTB.ENT$(26,25),3),SAVERMANO$=RMANO$
5355 LET TMP=NUM(RMANO$,ERR=5360),TMP=TMP+1; IF TMP>NUM(FILL(LEN(RMANO$),"9")) THEN LET TMP=1 FI; LET RMANO$=STR(TMP:FILL(LEN(RMANO$),"0")); GOTO DONE_RMA
5360 FOR X=LEN(RMANO$) TO 1 STEP -1
5365 LET TMP=NUM(RMANO$(X,1),ERR=NEXTX); IF CARRY THEN LET TMP=TMP+1; IF TMP=10 THEN LET TMP=0 ELSE LET CARRY=0 FI; LET RMANO$(X,1)=STR(TMP:"0"); IF CARRY=0 THEN EXITTO DONE_RMA
5370 NEXTX: NEXT X
5375 DONE_RMA:
5380 LET TH15$=SAVERMANO$,TH7=NUM(STBL("JULDATE"))
5385 LET XXTB.ENT$(26,25)=RMANO$
5390 WRITE RECORD(FILE[30],KEY=XXTB.TBID$)XXTB$
5395 GOSUB DATA
5400 RETURN
5500 REM 0 - (BATCHVER3-FIX) 5500-5650
5510 FLAG: REM "Verify That Batch Is Ready to Print"
5520 LET OK=1,PARAM=2,X1$=""
5530 IF O2$(10,1)="1" THEN LET X1$=CVS(X$,3),X2$="Batch Has" ELSE LET X1$="Transactions Are",X2$="Transactions Have"
5540 EXTRACT (FILE[15],KEY=BATCH$,KNUM=0,DOM=NOTFD,TIM=0,ERR=5550)IOL=ARBTXXX; GOTO 5560
5550 IF ERR<>0 THEN GOTO GENERROR ELSE LET X9$="Batch '"+CURRENT$+"' is in use.",OK=0; GOTO MESSAGE
5560 IF BC4$="H" THEN LET X9$=X1$+" on hold.",OK=0; GOTO MESSAGE
5570 IF SKIPRPT THEN LET SKIPRPT=0; GOTO 5590
5580 IF POS(BC3$[FLAG]="P")=1 THEN LET X9$="CAUTION: "+X2$+" already been printed",BATCH_PRINTED=1; GOTO MESSAGE; REM "Check if Already Printed"
5590 CALL "ARRESTRT.PUB",FILE[15],FILE[12],BATCH$,TERMID$,MSG$,PICKS$,PARAM,STATUS
5600 ON STATUS GOTO OK,NOTOK,NOTOK,OK,NOTOK,NOTFD
5620 NOTFD: LET X$=X1$,O7=8,OK=0; GOTO MESSAGE
5630 MESSAGE: IF O2$(10,1)<>"1" AND OK<>1 AND O7<>8 THEN LET O7=1
5635 GOSUB GENERROR; LET X1$="",X2$=""; IF BATCH_PRINTED THEN LET BATCH_PRINTED=0; GOTO 5590 FI; RETURN
5640 OK: LET X1$="",X2$=""; RETURN
5650 NOTOK: LET X9$=MSG$,OK=0; GOTO MESSAGE
5900 REM "Reset Date"
5910 DATE_RESET:
5920 LET E5=NUM(STBL("JULDATE"))
5930 LET TH1[3]=E5
5940 IF GUI THEN PRINT (OSGUI.CHAN)'TITLE'(4020,DATE(E5:STBL("DATEMASK"))), ELSE PRINT @(34,2),'SF',DATE(E5:STBL("DATEMASK")),
5950 RETURN
6000 REM 0 - (GENINPUT) 6000-6190
6001 GENINPUT: REM "08/10/2007 - General Input Routine Interface"
6005 LET WIND$=WINDID$,SEL$=SELVAL$,PRO$=PROGID$
6010 IF X9<>0 THEN GOTO 6100
6090 IF POS(Y$="PJQ") THEN LET WINDID$="",SELVAL$="",PROGID$=""; RETURN
6100 IF GUI=0 THEN CALL "GENINPUT.PUB",ERR=GENERROR,Z9$,Y$,(X0),(X1),(X2),(X3),(X4),X9,X1$(1),X,X$,INFO,WINDID$,SELVAL$,COMPID$,PROGID$,FILE[ALL],YDISABLE$,PGM(-2),FLD_HLP$,GENINPUT$; GOTO 6120
6110 CALL "GENGUINP.PUB",ERR=GENERROR,Z9$,Y$,(X0),(X1),(X2),(X3),(X4),X9,X1$(1),X,X$,INFO,WINDID$,SELVAL$,COMPID$,PROGID$,FILE[ALL],YDISABLE$,PGM(-2),FLD_HLP$,GUI_ID,BUTTON_KEYS$[ALL],OSGUI$,GUI_RADIO$,GENINPUT$
6120 ON POS(Y$="DIB PJCEU") GOTO 6180,6185,6183,6184,6190
6180 IF STBL("VERSW")="OFF" THEN GOSUB 8420 ELSE GOSUB 8410; REM "check other commands"
6182 GOTO 6100
6183 GOSUB INFO; LET Y$="E",WINDID$=WIND$,SELVAL$=SEL$,PROGID$=PRO$; GOTO 6100
6184 GOSUB DRILL; LET Y$="E",WINDID$=WIND$,SELVAL$=SEL$,PROGID$=PRO$; GOTO 6100
6185 GOSUB 9200
6187 GOTO 6100
6190 RETURN
6200 REM 0 - (SOINFO) 6200-6290
6201 INFO: REM "04/30/91 - Sales Order INFO Routine"
6210 DIM APPKEY$(30),KEYNAME$[1:15]
6220 LET APPKEY$="ARSOIN"
6230 LET KEYNAME$[1]=C0$
6240 LET KEYNAME$[2]=C0$
6250 IF TH6$(1,1)<>"}" THEN LET KEYNAME$[3]=TH6$(1,26) ELSE LET KEYNAME$[3]=FILL(20)+TH6$(21,6)
6260 CALL "GENINFO.PUB",APPKEY$,KEYNAME$[ALL],FILE[ALL],O2$,OSGUI$
6290 RETURN
6300 REM 0 - (DRILL) 6300-6310
6301 DRILL:
6310 RETURN
7500 REM 7500,4 "----- Display Prompts"
7504 PROMPTS:
7508 IF GUI THEN GOTO GUI_PROMPTS
7512 PRINT 'PUSH','SCROLL'(1,0,78,22),'SCROLL'("ON"),
7516 LET STITLE$=" Header Information "; GOSUB BOX
7520 PRINT 'SB',STBL("FTXT2"),
7524 IF O2$(10,1)="1" THEN PRINT @(2,1),"Batch ID",
7528 PRINT @(2,2),"Our Order No",@(28,2),"Date",@(50,2),"Status",
7532 PRINT @(2,3),"Loc ID",@(50),"Dukes#",
7536 PRINT @(2,5),"Sold to:",@(41),"Ship to:",
7540 PRINT @(2,12),"Sales Rep 1",@(19),"Percent",@(41),"Ship Method",
7544 PRINT @(2,13),"Sales Rep 2",@(19),"Percent",@(41),"Ship Via",
7548 PRINT @(2,14),"Cust Level",@(41),"Pick Slip No.",
7552 PRINT @(2,15),"Terms Code",@(41),"Requested Ship Date",
7556 PRINT @(2,16),"Terms Desc",@(28),"Type",@(41),"Actual Ship Date",
7560 PRINT @(2,17),"Terms%",@(15),"Days",@(24),"Net Days",@(41),"GL Pd/Year",
7564 LET ORDER$="Cust PO No",ORDDATE$="PO Date"; IF ORDTYPE=2 THEN LET ORDER$="RMA No    ",ORDDATE$="RMA Date"
7568 PRINT @(2,18),ORDER$,@(41),"Taxable?",
7572 PRINT @(2,19),ORDDATE$,@(41),"Tax Group",
7576 PRINT @(2,20),"Inv No",@(22),"Date",@(41),"Description",
7580 PRINT 'SCROLL'("RESET")
7584 LET X8=0
7588 RETURN
7600 REM 7600,5 "----- Redraw RMA and Order Prompts"
7605 REDRAW_RMA_PROMPTS:
7610 IF GUI THEN GOTO REDRAW_GUI_RMA_PROMPTS
7615 PRINT 'SB',STBL("FTXT2"),
7620 LET ORDER$="Cust PO No",ORDDATE$="PO Date"; IF ORDTYPE=2 THEN LET ORDER$="RMA No    ",ORDDATE$="RMA Date  "
7625 PRINT @(3,18),ORDER$,
7630 PRINT @(3,19),ORDDATE$,
7635 RETURN
7640 DATA:
7645 IF GUI THEN GOTO GUI_DATA
7650 PRINT 'SCROLL'(1,0,77,22),'SCROLL'("ON"),
7655 IF NC=0 THEN PRINT 'CF', ELSE LET NC=0
7660 PRINT 'BACKGR'+STBL("FBKG2"),'SF',STBL("FTXT2"),
7665 IF O2$(10,1)="1" THEN PRINT @(15,1),BATCH$,
7670 PRINT @(15,2),TRAN$(7,8),@(33,2),FND$(TH1[3]),@(57,2),E2$(1+(TH0-1)*8,8),
7675 LET TEMP$=W1$+FILL(20),TEMP$=TEMP$(1,20); PRINT @(15,3),LO0$,; PRINT @(28,3),TEMP$,@(57),THCFF.INT_ORDNO$,
7679 IF SP007_ALPHA_SHIPTO SHIP$=SPSHIPTO$;GOTO 7681;REM SP007 ALPHA SHIP TO FIELD RRW/RCG
7680 IF SHIPTONUM=0 THEN LET SHIP$=FILL(6) ELSE LET SHIP$=FNNUM$(SHIPTONUM,"000000")
7685 PRINT @(12,5),TH2$,@(51),SHIP$,
7690 PRINT @(2,6),C1$,@(41),TH11$(1,30),
7695 PRINT @(2,7),C2$(1,30),@(41),TH11$(31,30),
7700 PRINT @(2,8),C2$(31,30),@(41),TH11$(61,30),
7705 PRINT @(2,9),C2$(61,30),@(41),TH11$(91,30),
7710 PRINT @(2,10),C2$(91,15),@(18),C2$(106,3),@(22),C2$(109,12),@(35),C2$(121,2),@(41),TH11$(121,15),@(57),TH11$(136,3),@(61),TH11$(139,12),@(74),TH11$(151,2),
7715 PRINT @(14,12),TH3$(1,3),@(27),TH3$(4,5),@(55),TH7$(1,6),
7720 PRINT @(14,13),TH3$(9,3),@(27),TH3$(12,5),@(55),TH12$,
7725 PRINT @(14,14),TH13$,@(64),TH1$(11,6),
7730 PRINT @(14,15),TH1$(1,6),@(64),FND$(TH1[4]),
7735 PRINT @(14,16),TC2$,@(33),PROXTYPE$,@(64),FND$(TH1[1]),
7740 REM PRINT @(9,17),FNNUM$(TC1[1],"##.00"),@(20),FNNUM$(TC1[2],"###"),@(33),FNNUM$(TC1[3],"###"),@(55),FNNUM$(NUM(TH4$),"##"),
7745 PRINT @(9,17),FNNUM$(TC1[1],"##.00"),@(20),FNNUM$(TC1[2],"###"),@(33),FNNUM$(TC1[3],"###"),@(55),STR(TH4$)+"/"+STR(TH5$(1,4)),
7750 IF S6=0 THEN LET YN$="NO " ELSE LET YN$="YES"
7755 PRINT @(13,18),; IF POS(STR(TH0)="479") THEN PRINT TH15$, ELSE PRINT TH8$(2,25), FI; PRINT @(55),YN$,
7760 PRINT @(13,19),; IF POS(STR(TH0)="479") THEN PRINT FND$(TH7), ELSE PRINT FND$(TH1[0]), FI; PRINT @(55),TH1$(25,6),
7765 PRINT @(13,20),TH1$(17,8),@(27),FND$(TH1[2]),@(55),GC1$,
7770 PRINT 'SCROLL'("RESET")
7775 RETURN
7900 REM 7900,5 "----- Display Box"
7905 BOX:
7910 PRINT 'BACKGR',STBL("FBKG2"),STBL("FBX2"),'DEFAULT','CS','SB',
7915 PRINT 'BOX'(0,0,78,22),'GS',
7920 PRINT @(0,4),"6",'BOX'(1,4,76,0),@(77,4),"7",
7925 PRINT @(0,11),"6",'BOX'(1,11,76,0),@(77,11),"7",
7930 PRINT @(39,4),"9",'BOX'(39,5,0,16),@(39,21),"8",@(39,11),":",'GE',
7935 PRINT 'SB',STBL("FTTL2"),@(INT((77-LEN(STITLE$))/2),0),STITLE$,
7940 RETURN
7945 BOX2:
7950 LET FIN$=FIN(0),FIN$=FIN$(13,2)
7955 LET TITLE$=TITLE$+" - "+STITLE$; PRINT 'BACKGR'+STBL("FBKG2"),STBL("FBX2"),'DEFAULT','SB',
7960 PRINT 'BOX'(14,0,50,0),
7965 PRINT 'SB',STBL("FTTL2"),@(INT((77-LEN(TITLE$))/2),0),TITLE$,
7970 PRINT 'RGB'(FIN$),'DEFAULT',
7975 GOSUB DATA
7980 RETURN
8400 REM 0 - (GENERROR) 8400-8452
8401 GENERROR: REM "02/21/89 - GENERAL ERROR ROUTINE"
8402 IF CVS(LOADORD$,3)<>"" AND Y$="P" AND CVS(X9$,3)<>"" X9$="";RETURN;REM RRW/RCG JUMPING INTO ORDER SKIP NAGS SP000
8405 IF O7=0 AND X9$="" AND X8$="" THEN LET O7=-3
8410 CALL "GENERROR.PUB",X9$,X8$,ERR,TCB(5),O7,Y$,TCB(10),X1$(1),F$(1),PROGID$,FILE[ALL],YDISABLE$,PGM(-2),X$,X4,MX8,MX9,OSGUI$
8420 ON POS(Y$="XMSLR") GOTO 8450,8452,9990,8452,8490,8499
8450 RETURN
8452 LET SPREC=TCB(14); RESET; PRECISION SPREC; SETERR GENERROR
8454 IF Y$="X" THEN GOTO 8470
8456 IF Y$="S" THEN GOTO 8480
8460 REM "8470=BR ON X, 8480=BR ON S, 8490=L "
8470 IF TASK$="UH" THEN LET ABORT=1,Y$=""; IF GUI THEN GOSUB DESTROY_GUI_WINDOW ELSE PRINT 'POP', FI; GOSUB CLEAR_MAPINFO; RUN "SOENTCON"
8474 IF AUTO_GENERATE_FLAG=1 AND E0<>3 THEN IF TH0$(7,8)<>FILL(8) THEN LET NOGEN=1
8475 LET PROGID$=""; GOTO ABANDON
8480 LET Z9=0; LET PROGID$=""
8481 IF TH0$(7,8)=FILL(8) OR S=1 THEN GOTO ABANDON
8482 IF P0=3 THEN GOTO BATCH
8483 GOTO PAGEUP
8490 REM 0 - (GENERROR2) 8490-8499
8491 CALL "GENPSCR.PUB"
8492 LET Y$=""
8495 RETURN
8499 RETRY
9200 REM "Delete routine"
9201 X9$="";CALL"SOACCESS.HOOKS",ERR=*NEXT,FILE[ALL],"DO",SPACCESS;IF SPACCESS=0 X9$="Access Denied";gosub generror;return;rem RRW/RCG SP017
9202 IF POS(STR(TH0)="479") AND O2$(54,1)="1" THEN GOSUB CHECK_RETURNS; IF RTN_OK=0 THEN LET X9$="Cannot delete orders with approved or posted returned items."; GOSUB GENERROR; RETURN
9203 X9$="",X8$="";CALL "SOENTHDR.HOOKS"+"::CHECK_DELETE_ORDER",ERR=*NEXT; IF X9$<>"" THEN GOSUB GENERROR; RETURN ELSE IF X8$<>"" THEN LET X9$=X8$,X8$=""; GOSUB GENERROR; REM RRW/RCG DELETE ORDER CHECK: PASS BACK X9$ WITH ERROR MESSAGE TO DENY DELETION,PASS X8$ BACK JUST TO WARN AND GO ON; USE THIS FOR EXTRA ORDER CHECKS REQUIRED FOR DELETION
9204 LET X8$="Entire Order",O7=3; GOSUB GENERROR
9205 IF Y$<>"D" THEN GOTO 9285
9208 CALL "SOENTHDR.HOOKS::DELETE_REASON",ERR=*NEXT,FILE[ALL],TH0$,OSGUI$,GENINPUT$,OK; IF OK=0 THEN LET X9$="Reason is required to delete ticket",Y$=""; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 9285
9210 IF GUI THEN GOSUB DESTROY_GUI_WINDOW ELSE PRINT 'POP','CF',
9215 IF TASK$<>"NH" THEN GOSUB RESTART
9220 LET TASK$="DO"
9222 DIM TD1[4],TD2[2],TD5[10],TD6[1:5,1:4],TDCFF$:FATTR(TDCFF$),TDCFV$:FATTR(TDCFV$)
9225 GOSUB CLEAR_MAPINFO; RUN "SOENTUPD"
9285 RETURN
9300 REM 9300,5 "----- Check Returns for Approved or Posted Items"
9305 CHECK_RETURNS:
9310 LET RTN_OK=1
9315 READ (FILE[27],KNUM=1,KEY=TH0$,DOM=NEXT_LINE_ITEM)
9320 NEXT_LINE_ITEM:
9325 READ RECORD(FILE[27],END=DONE_CHECK_RETURNS)SORI$; IF SORI.BATCH$+SORI.ORD$<>TH0$ THEN GOTO DONE_CHECK_RETURNS
9330 IF SORI.STAT$="N" THEN GOTO NEXT_LINE_ITEM
9335 LET RTN_OK=0
9340 DONE_CHECK_RETURNS:
9345 RETURN
9400 REM 0 - (GENPC) 9400-9448
9401 GENPC: REM "04/31/2009 - Read Period Conversion Table"
9410 LET SELECTION=0; GOTO 9440
9420 GENPC1: REM "9500 Section does Conversion - Date to Period"
9427 LET SELECTION=1,DATE$=X$,LOCKFLAG=0,INVALIDYEAR=0; GOTO 9440
9430 GENPC2: REM "This Section does Conversion - Period to Dates"
9435 LET SELECTION=2,PERIOD=X,BEGDATE=-1,ENDDATE=-1,LOCKFLAG=0,INVALIDYEAR=0
9440 CALL "GENPC.PUB",FILE[ALL],SELECTION,DATE$,O9$,BEGDATE,ENDDATE,PERIOD,PPY,YEAR,APP$,LOCKFLAG,INVALIDYEAR,RMPH$,RMPL$,MSG$
9442 IF SELECTION=1 THEN LET X=PERIOD
9444 IF CVS(MSG$,3)<>"" THEN LET X9$=MSG$,MSG$=""; GOSUB GENERROR
9448 RETURN
9990 QUIT:
9991 GOSUB CLEAR_MAPINFO; IF O7=-3 THEN LET P8$=O1$; RUN "ARVER"
9992 IF TASK$="UH" THEN LET ABORT=1,Y$=""; IF GUI THEN GOSUB DESTROY_GUI_WINDOW ELSE PRINT 'POP', FI; RUN "SOENTCON"; REM "abort Update Header"
9995 CALL "SOENTCON.HOOKS"+"::F7_EXIT_ORDER",ERR=*NEXT;REM RRW/RCG
9996 LET P8$=O1$,P7$=""; IF O2$(13,1)="1" THEN RUN "SOENTOIT" ELSE RUN "ARVER";REM RRW/RCG MOVED DOWN FROM 9995
9997 RUN O1$
9999 END
10000 REM 0 - (GENNUM) 10000-10099
10002 DEF FNNUM$(XX,XX1$)
10003 LET XX$=STR(XX:XX1$,ERR=10005); GOTO 10006
10005 LET XX1=LEN(XX1$); IF POS(XX1$(XX1,1)="-)") THEN LET XX1=XX1-1 FI; LET XX$=FILL(XX1,"*"),XX$=XX$+FILL(LEN(XX1$)-LEN(XX$))
10006 RETURN XX$
10008 FNEND
10010 DEF FNGUINUM$(XX,XX1$,ID)
10015 LET XX$=STR(XX:XX1$,ERR=10020); GOTO 10025
10020 LET XX1=LEN(XX1$); IF POS(XX1$(XX1,1)="-)") THEN LET XX1=XX1-1 FI; LET XX$=FILL(XX1,"*"),XX$=XX$+FILL(LEN(XX1$)-LEN(XX$))
10025 LET TF$=SENDMSG(OSGUI.CHAN,ID,23,0,XX1$)
10030 RETURN CVS(XX$,3)
10035 FNEND
17500 REM 17500,5 "----- GUI Prompts"
17505 GUI_PROMPTS:
17510 IF SOENT_HEADER_CONTEXT THEN PRINT (OSGUI.CHAN)'CONTEXT'(OSGUI.CUR_CONTEXT[SOENT_HEADER_CONTEXT]); LET OSGUI.CONTEXT_POINTER=SOENT_HEADER_CONTEXT; GOTO 17535
17515 LET OSGUI.SCRNID$="SOENT.BRC"; FOR I=1 TO NUM(STBL("GUIWIND")); IF OSGUI.WIND_ID[I]=0 THEN LET OSGUI.CONTEXT_POINTER=I,SOENT_HEADER_CONTEXT=I,OSGUI.WIND_ID[I]=2,OSGUI.BASE_CONTEXT[I]=-1; EXITTO 17520 FI; NEXT I
17520 REM MOVED TO 17522 LET MSG$=""; CALL "GENGURES.PUB",FILE[ALL],OSGUI$,MSG$; IF CVS(MSG$,3)<>"" THEN LET X9$=MSG$,O7=1; GOSUB GENERROR; GOTO QUIT
17521 CALL "SOENTHDR.HOOKS"+"::REPLACE_ARC_2",ERR=*NEXT;REM SP007 alternate arc file for alpha shipto entry
17522 LET MSG$=""; CALL "GENGURES.PUB",FILE[ALL],OSGUI$,MSG$; IF CVS(MSG$,3)<>"" THEN LET X9$=MSG$,O7=1; GOSUB GENERROR; GOTO QUIT;REM RRW/RCG MOVED DOWN FROM 17520
17525 LET MENU$=MENU1$+MENUINFO$+MENUHLP$; PRINT (OSGUI.CHAN)'SETMENU',MENU$
17530 LET OSGUI.BASE_CONTEXT[I]=OSGUI.BASE_CONTEXT[1]
17535 LET ORDER$="Cust PO No",ORDDATE$="PO Date"; IF INHOUSE THEN LET ORDER$="P.O. No" FI; IF ORDTYPE=2 THEN LET ORDER$="RMA No   ",ORDDATE$="RMA Date  "
17540 PRINT (OSGUI.CHAN)'TITLE'(1220,ORDER$),'TITLE'(1240,ORDDATE$)
17545 IF O2$(2,1)<>"1" THEN PRINT (OSGUI.CHAN)'HIDE'(14030,14180)
17550 IF O2$(10,1)="1" THEN PRINT (OSGUI.CHAN)'SHOW'(1000,4000,14000) ELSE PRINT (OSGUI.CHAN)'HIDE'(1000,4000,14000)
17555 PRINT (OSGUI.CHAN)'SHOW'(0); LET GUI_POP=1
17560 RETURN
17600 REM 17600,5 "----- Redraw RMA and Order Prompts in GUI"
17605 REDRAW_GUI_RMA_PROMPTS:
17610 LET ORDER$="Cust PO No",ORDDATE$="PO Date"; IF ORDTYPE=2 THEN LET ORDER$="RMA No   ",ORDDATE$="RMA Date  "
17615 PRINT (OSGUI.CHAN)'TITLE'(1220,ORDER$)
17620 PRINT (OSGUI.CHAN)'TITLE'(1240,ORDDATE$)
17625 RETURN
17650 REM "--------- GUI Prompts for Taken By"
17655 GUI_PROMPTS_TAKEN_BY:
17660 LET SAVE_POINTER=OSGUI.CONTEXT_POINTER
17662 IF SOENT_TAKEN_BY_CONTEXT THEN PRINT (OSGUI.CHAN)'CONTEXT'(OSGUI.CUR_CONTEXT[SOENT_TAKEN_BY_CONTEXT]); LET OSGUI.CONTEXT_POINTER=SOENT_TAKEN_BY_CONTEXT; GOTO 17672
17664 LET OSGUI.SCRNID$="SOENTHDR.HOOKS.BRC"; FOR I=1 TO NUM(STBL("GUIWIND")); IF OSGUI.WIND_ID[I]=0 THEN LET OSGUI.CONTEXT_POINTER=I,SOENT_TAKEN_BY_CONTEXT=I,OSGUI.WIND_ID[I]=1,OSGUI.BASE_CONTEXT[I]=-1; EXITTO 17666 FI; NEXT I
17666 LET MSG$=""; CALL "GENGURES.PUB",FILE[ALL],OSGUI$,MSG$; IF CVS(MSG$,3)<>"" THEN LET X9$=MSG$,O7=1; GOSUB GENERROR; GOTO QUIT
17668 LET MENU$=MENU1$+MENUHLP$; PRINT (OSGUI.CHAN)'SETMENU',MENU$
17669 LET OSGUI.BASE_CONTEXT[I]=OSGUI.BASE_CONTEXT[1]
17670 GOSUB CENTER_FORM
17672 PRINT (OSGUI.CHAN)'SHOW'(0)
17675 RETURN
17700 REM 17700,5 "----- GUI Data"
17705 GUI_DATA:
17710 IF O2$(10,1)="1" THEN PRINT (OSGUI.CHAN)'TITLE'(4000,BATCH$)
17715 PRINT (OSGUI.CHAN)'TITLE'(4010,TRAN$(7)),'TITLE'(4020,FND$(TH1[3])),'TITLE'(2000,E2$(1+(TH0-1)*8,8))
17720 PRINT (OSGUI.CHAN)'TITLE'(4030,LO0$),'TITLE'(2010,W1$)
17722 PRINT (OSGUI.CHAN)'TITLE'(4032,THCFF.INT_ORDNO$)
17724 IF SP007_ALPHA_SHIPTO SHIP$=SPSHIPTO$;GOTO 17726;REM SP007 RRW/RCG ALPHA SHIP TO IF IT'S THERE
17725 IF SHIPTONUM=0 THEN LET SHIP$=FNGUINUM$(SHIPTONUM,"######",4050),SHIP$=FILL(6) ELSE LET SHIP$=FNGUINUM$(SHIPTONUM,"000000",4050)
17730 PRINT (OSGUI.CHAN)'TITLE'(4040,TH2$),'TITLE'(4050,SHIP$)
17735 PRINT (OSGUI.CHAN)'TITLE'(2020,C1$),'TITLE'(4060,TH11$(1,30)); REM "NAME"
17740 PRINT (OSGUI.CHAN)'TITLE'(2030,C2$(1,30)),'TITLE'(4070,TH11$(31,30)); REM "ADDRESS LINE 1"
17745 PRINT (OSGUI.CHAN)'TITLE'(2040,C2$(31,30)),'TITLE'(4080,TH11$(61,30)); REM "ADDRESS LINE 2"
17750 PRINT (OSGUI.CHAN)'TITLE'(2050,C2$(61,30)),'TITLE'(4090,TH11$(91,30)); REM "ADDRESS LINE 3"
17755 PRINT (OSGUI.CHAN)'TITLE'(2060,C2$(91,15)),'TITLE'(2070,C2$(106,3)),'TITLE'(2080,C2$(109,12)),'TITLE'(2090,C2$(121,2)),'TITLE'(4100,TH11$(121,15)),'TITLE'(4110,TH11$(136,3)),'TITLE'(4120,TH11$(139,12)),'TITLE'(4130,TH11$(151,2))
17760 PRINT (OSGUI.CHAN)'TITLE'(4140,TH3$(1,3)),'TITLE'(4150,TH3$(4,5)),'TITLE'(4240,TH7$(1,6))
17765 PRINT (OSGUI.CHAN)'TITLE'(4160,TH3$(9,3)),'TITLE'(4170,TH3$(12,5)),'TITLE'(4250,TH12$)
17770 IF NUM(TH1$(11,6))=0 THEN LET PICKNO$=FNGUINUM$(0,"######",4260),PICKNO$=FILL(6) ELSE LET PICKNO$=FNGUINUM$(NUM(TH1$(11,6)),"000000",4260)
17775 PRINT (OSGUI.CHAN)'TITLE'(4180,TH13$),'TITLE'(4260,PICKNO$)
17780 PRINT (OSGUI.CHAN)'TITLE'(4190,TH1$(1,6)),'TITLE'(4270,FND$(TH1[4]))
17785 PRINT (OSGUI.CHAN)'TITLE'(2100,TC2$),'TITLE'(2110,PROXTYPE$),'TITLE'(4280,FND$(TH1[1]))
17790 PRINT (OSGUI.CHAN)'TITLE'(2120,FNNUM$(TC1[1],"##.00")),'TITLE'(2130,FNNUM$(TC1[2],"###")),'TITLE'(2140,FNNUM$(TC1[3],"###")),'TITLE'(4290,TH4$+TH5$(1,4))
17795 IF S6=0 THEN LET YN1$="NO " ELSE LET YN1$="YES"
17800 IF POS(STR(TH0)="479") THEN LET PRTFLD$=TH15$ ELSE LET PRTFLD$=TH8$(2,25) FI; PRINT (OSGUI.CHAN)'TITLE'(4200,PRTFLD$); LET TMP=FNCHECK(4300,YN1$)
17805 IF POS(STR(TH0)="479") THEN LET PRTFLD$=FND$(TH7) ELSE LET PRTFLD$=FND$(TH1[0]) FI; PRINT (OSGUI.CHAN)'TITLE'(4210,PRTFLD$),'TITLE'(4310,TH1$(25,6))
17810 PRINT (OSGUI.CHAN)'TITLE'(4220,TH1$(17,8)),'TITLE'(4230,FND$(TH1[2])),'TITLE'(2150,GC1$)
17815 RETURN
18000 REM 18000,5 "----- Disable Fields"
18005 DISABLE_FIELDS:
18010 IF GUI=0 THEN GOTO 18030
18015 IF TASK$<>"UH" THEN IF POS(X0$="EDS") THEN PRINT (OSGUI.CHAN)'ENABLE'(4000,4010,14000,14010),'DISABLE'(4020,4040,14040) ELSE PRINT (OSGUI.CHAN)'ENABLE'(4000,4040,14000,14040,4020),'DISABLE'(4190,14190) FI; FOR I=4050 TO 4310 STEP 10; PRINT (OSGUI.CHAN)'DISABLE'(I); NEXT I; PRINT (OSGUI.CHAN)'DISABLE'(4032,14050,14110,14130,14140,14160,14190,14240,14310,34000,34010)
18020 IF STBL("INTTYPE",ERR=18025)="BBJ" THEN IF TASK$<>"UH" THEN IF POS(X0$="EDS") THEN PRINT (OSGUI.CHAN)'DISABLE'(15020) ELSE PRINT (OSGUI.CHAN)'ENABLE'(15020) FI; PRINT (OSGUI.CHAN)'DISABLE'(15210,15230,15270,15280)
18025 IF POS(X0$="EDS")=0 THEN IF AUTO_GENERATE_FLAG=1 THEN PRINT (OSGUI.CHAN)'DISABLE'(4010,14010) ELSE PRINT (OSGUI.CHAN)'ENABLE'(4010,14010)
18030 RETURN
18035 DISABLE_ADDRESS_FIELDS:
18040 IF GUI THEN PRINT (OSGUI.CHAN)'DISABLE'(4060,4070,4080,4090,4100,4110,14110,4120,4130,14130)
18045 RETURN
18100 REM 18100,5 "----- Enable Fields"
18105 ENABLE_FIELDS:
18110 IF GUI=0 THEN RETURN
18115 IF X0$="E" THEN PRINT (OSGUI.CHAN)'DISABLE'(4000,4010,14000,14010),'ENABLE'(4020),; IF STBL("INTTYPE",ERR=18120)="BBJ" THEN PRINT (OSGUI.CHAN)'ENABLE'(15020)
18120 IF POS(X0$="DS") OR TASK$="UH" THEN PRINT (OSGUI.CHAN)'DISABLE'(4000,4010,14000,14010),'ENABLE'(4020); IF STBL("INTTYPE",ERR=18125)="BBJ" THEN PRINT (OSGUI.CHAN)'ENABLE'(15020)
18125 IF TASK$="NH" OR (TH0=3 OR TH0=5)=0 OR E0=1 THEN PRINT (OSGUI.CHAN)'ENABLE'(4040,14040) ELSE PRINT (OSGUI.CHAN)'DISABLE'(4040,14040) FI; FOR I=4140 TO 4310 STEP 10; PRINT (OSGUI.CHAN)'ENABLE'(I); NEXT I; PRINT (OSGUI.CHAN)'ENABLE'(4032,4050,14050,14140,14160,14190,14240,14310)
18130 IF STBL("INTTYPE",ERR=18135)="BBJ" THEN PRINT (OSGUI.CHAN)'ENABLE'(15210,15230,15270,15280)
18135 IF TASK$="NH" THEN PRINT (OSGUI.CHAN)'ENABLE'(4000,14000)
18140 IF POS(STR(TH0)="479") THEN COMPARE$=TH15$ ELSE LET COMPARE$=TH8$(2,25)
18145 IF COMPARE$=FILL(25) THEN PRINT (OSGUI.CHAN)'DISABLE'(4210); IF STBL("INTTYPE",ERR=18150)="BBJ" THEN PRINT (OSGUI.CHAN)'DISABLE'(15210) FI ELSE PRINT (OSGUI.CHAN)'ENABLE'(4210); IF STBL("INTTYPE",ERR=18150)="BBJ" THEN PRINT (OSGUI.CHAN)'ENABLE'(15210)
18150 IF TH1$(17,8)=FILL(8) THEN PRINT (OSGUI.CHAN)'DISABLE'(4230); IF STBL("INTTYPE",ERR=18155)="BBJ" THEN PRINT (OSGUI.CHAN)'DISABLE'(15230)
18155 IF TH3$(1,3)=FILL(3) THEN PRINT (OSGUI.CHAN)'DISABLE'(4150)
18160 IF TH3$(9,3)=FILL(3) THEN PRINT (OSGUI.CHAN)'DISABLE'(4170)
18165 IF O2$(28,1)<>"1" THEN PRINT (OSGUI.CHAN)'DISABLE'(4180,14180)
18170 IF (E0<>1 AND E0<>3 AND E0<>4) AND (TH0<>1 AND TH0<>2 AND TH0<>4 AND TH0<>8) THEN PRINT (OSGUI.CHAN)'DISABLE'(4030,14030) ELSE PRINT (OSGUI.CHAN)'ENABLE'(4030,14030)
18175 IF TH0=8 THEN PRINT (OSGUI.CHAN)'DISABLE'(4220) ELSE PRINT (OSGUI.CHAN)'ENABLE'(4220)
18180 RETURN
18185 ENABLE_ADDRESS_FIELDS:
18190 IF GUI THEN PRINT (OSGUI.CHAN)'ENABLE'(4060,4070,4080,4090,4100,4110,14110,4120,4130,14130)
18195 RETURN
18200 REM 18200,5 "----- Clear GUI Global"
18205 CLEAR_GLOBAL:
18210 IF GUI THEN LET DUMMY$=STBL("!CLEAR","DESTID",ERR=18215)
18215 RETURN
18400 REM 18400,5 "----- Destroy Window"
18405 DESTROY_GUI_WINDOW:
18410 PRINT (OSGUI.CHAN)'HIDE'(0),'CONTEXT'(OSGUI.CUR_CONTEXT[1]); LET OSGUI.CONTEXT_POINTER=1
18415 RETURN
18420 REM 18420,5 "----- Destroy Window, Taken By"
18425 DESTROY_GUI_WINDOW2:
18430 PRINT (OSGUI.CHAN)'HIDE'(0),'CONTEXT'(OSGUI.CUR_CONTEXT[SAVE_POINTER]);LET OSGUI.CONTEXT_POINTER=SAVE_POINTER
18435 RETURN
18800 REM 0 - (GENCHECK) 18800-18850
18810 DEF FNCHECK(ID,PARAM$)
18820 IF LEN(PARAM$)<1 THEN PRINT (OSGUI.CHAN)'UNCHECK'(ID) ELSE IF PARAM$(1,1)="Y" THEN PRINT (OSGUI.CHAN)'CHECK'(ID) ELSE PRINT (OSGUI.CHAN)'UNCHECK'(ID)
18830 RETURN 1
18840 FNEND
19110 CENTER_FORM:
19120 PRINT (OSGUI.CHAN)'CONTEXT'(OSGUI.CUR_CONTEXT[SOENT_HEADER_CONTEXT])
19130 LET TMP$=CTRL(OSGUI.CHAN,0,0),TMPXPOS=DEC(TMP$(1,2)),TMPYPOS=DEC(TMP$(3,2)),TMPWT=DEC(TMP$(5,2)),TMPHT=DEC(TMP$(7,2))
19140 PRINT (OSGUI.CHAN)'CONTEXT'(OSGUI.CUR_CONTEXT[OSGUI.CONTEXT_POINTER])
19150 LET TMP$=CTRL(OSGUI.CHAN,0,0),TMPWTPOP=DEC(TMP$(5,2)),TMPHTPOP=DEC(TMP$(7,2))
19160 LET TMPXPOP=TMPXPOS+INT((TMPWT-TMPWTPOP)/2),TMPYPOP=TMPYPOS+INT((TMPHT-TMPHTPOP)/2)
19170 PRINT (OSGUI.CHAN)'MOVE'(0,TMPXPOP,TMPYPOP)
19180 RETURN
20000 REM "-------- Taken By - SWI"
20005 TAKEN_BY:
20010 LET SAVEYDISABLE$=YDISABLE$,YDISABLE$="DSX",SAVEY$=Y$
20015 IF GUI THEN GOSUB GUI_PROMPTS_TAKEN_BY; GOTO 20030
20020 PRINT 'BACKGR',STBL("FBKG"),STBL("FTXT"),'DEFAULT',@(2,22),FILL(77),@(2,22),'SB',"Taken By",
20030 LET X0=22,X1=12,X3=0,X4=3,X$="",X9=1,WINDID$="SOENTAW4",GUI_ID=4000
20035 GOSUB GENINPUT
20040 IF Y$="U" THEN GOTO 20030
20050 LET X$=X$+FILL(X4-LEN(X$))
20055 IF X$=FILL(X4) THEN LET X9$="Taken By is required"; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 20030
20060 FIND (FILE[17],KEY=X$,DOM=*NEXT); GOTO 20070
20065 LET O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 20030
20070 LET DUMMY$=STBL("SP_TAKEN_BY",X$),YDISABLE$=SAVEYDISABLE$,SAVEYDISABLE$="",Y$=SAVEY$,SAVEY$=""
20075 IF GUI THEN GOSUB DESTROY_GUI_WINDOW2 ELSE PRINT @(2,22),FILL(77),'BACKGR',STBL("FBKG2"),STBL("FTXT2"),'DEFAULT',
20080 RETURN
31800 VALDATE_ALPHA_SHIPTO:
31805 IF CVS(X$,3)="" GOTO 31840
31810 X=NUM(X$,ERR=31840)
31820 X$=STR(X:FILL(X4,"0"),ERR=31840)
31830 GOTO 31841
31840 X$=X$+FILL(X4-LEN(X$))
31845 LET ADDRESS_EDIT=1; LET F0=11; READ (FILE[F0],KEY=TH2$+X$,DOM=31850,ERR=GENERROR)IOL=ARSAXXX; GOTO 31857
31850 IF CVS(X$,3)<>"" THEN LET O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1815
31855 IF CVS(X$,3)="" THEN IF C7$(16,1)="N" THEN GOSUB ENABLE_ADDRESS_FIELDS; IF SPSHIPTO$<>X$ THEN IF CVS(X$,3)<>"" LET TH11$(1,152)="" FI;LET TH3$(1,3)=C5$(1,3),TH3$(9,3)=C5$(4,3) FI; LET SPSHIPTO$=X$; GOTO 31895 ELSE LET O7=8; GOSUB CLEAR_GLOBAL; GOSUB GENERROR; GOTO 1815
31857 IF SAVEX$<>X$ THEN CALL "SOENTHDR.HOOKS"+"::AFTER_SHIPTO",ERR=*NEXT,FILE[ALL],TH0$,TH2$+X$,OK; IF OK=0 THEN GOTO 1815
31858 IF C7$(16,1)="N" THEN GOSUB ENABLE_ADDRESS_FIELDS
31860 IF X$=SPSHIPTO$ AND (NOCUSTCHG OR TASK$="NH") THEN GOTO 31885
31865 LET TH11$(1,152)=S1$,TH12$=S2$(1,20),SPSHIPTO$=X$,S1$=""; IF CVS(S4$(1,3),3)<>"" THEN LET TH3$(1,3)=S4$(1,3) ELSE LET TH3$(1,3)=C5$(1,3) FI; IF CVS(S4$(4,3),3)<>"" THEN LET TH3$(9,3)=S4$(4,3) ELSE TH3$(9,3)=C5$(4,3) FI; IF TH3$(1,3)=TH3$(9,3) THEN LET TH3$(9,3)=FILL(3)
31870 IF S2$(21,6)=FILL(6) THEN GOTO 31885 ELSE LET S91$(1,6)=S2$(21,6),TH1$(25,6)=S91$(1,6),TX1$=FILL(25)
31875 GOSUB GETTAX; LET X9$=""
31880 IF SAVETAX_SHIPTO$<>TH1$(25,6) THEN LET SHIPTO_TAX_CHANGED=1 ELSE LET SHIPTO_TAX_CHANGED=0
31885 LET ADDRESS_EDIT=0; GOSUB DATA; GOSUB SET_MAPINFO2; IF C7$(16,1)="Y" THEN IF GUI THEN GOSUB DISABLE_ADDRESS_FIELDS; GOTO 2130 ELSE LET ADDRESS_EDIT=1; REM "CWE/RCG - Allow editing ship-to address if force - CHAR only"
31890 LET S2$=""
31895 IF CVS(SPSHIPTO$,3)="" THEN LET SHIP$=FILL(6) ELSE LET SHIP$=SPSHIPTO$ FI; GOSUB DATA
31899 GOTO ADDRESS