* Program: WHE101
* Inventory Receipt/Disbursement/Adjustment Entry
* Copyright ALP Systems LLC
*
$INSERT SYS.BP STANDARD.VALUES
PASS.INFO=SENTENCE()
PROGTYPE=FIELD(PASS.INFO,' ',4)
BEGIN CASE
CASE PROGTYPE='RECEIPT' ; OTHERACTS='C'
CASE PROGTYPE='DISBURSEMENT' ; OTHERACTS='S':AM:'C'
CASE PROGTYPE='ADJUSTMENT' ; OTHERACTS=''
CASE 1 ; STOP
END CASE
CUSTCODE=''
CALL WHOWH(USERS,USERID,DUSERS,DWAREHOUSE)
PROGRAM='WHE101' ; TITLE='Inventory ':PROGTYPE:' Entry'
TITLE=BON:DWAREHOUSE<10>:BOF:' ':TITLE ; VALIDS=''
DIM SROW(21) ; REDISPLAY=0 ; REDO=0 ; UPFLAG=0 ; MODIFY.FLAG=0
**************
* Open Files *
**************
SCR=CLR:'<':PROGRAM:'>':@(40-INT(LEN(TITLE)/2)):TITLE
SCR:=@(66):BON:'User ':BOF:SYSTEM(19)
OPEN '','ACTIONS,WHE101' TO ACTIONS ELSE ABORT=1
CTRL.FILE='CTRL,':DUSERS<15>
OPEN CTRL.FILE TO CTRL ELSE ABORT=2
CUSTOMERS.FILE='CUSTOMERS,':DUSERS<15>
OPEN CUSTOMERS.FILE TO CUSTOMERS ELSE ABORT=3
INVENTORY.FILE='INVENTORY,':DUSERS<15>
OPEN INVENTORY.FILE TO INVENTORY ELSE ABORT=4
HISTORY.FILE='HISTORY,':DUSERS<15>
OPEN HISTORY.FILE TO HISTORY ELSE ABORT=5
SHIPTOS.FILE='SHIPTOS,':DUSERS<15>
OPEN SHIPTOS.FILE TO SHIPTOS ELSE ABORT=6
CARRIERS.FILE='CARRIERS,':DUSERS<15>
OPEN CARRIERS.FILE TO CARRIERS ELSE ABORT=7
READV BAY.MAX.LENGTH FROM CTRL, 'BAY.MAX.LENGTH', 1 ELSE ABORT=8
READV BAY.NULL.ID FROM CTRL, 'BAY.NULL.ID', 1 ELSE ABORT=9
READ BAY.VALID.LIST FROM CTRL, 'BAY.VALID.LIST' ELSE ABORT=10
READ BAY.ELEMENT.NAME FROM CTRL, 'BAY.ELEMENT.NAME' ELSE ABORT=11
READV STREAMLINE FROM CTRL, 'BOL', 16 ELSE STREAMLINE=''
BAY.FILE='BAY,':DUSERS<15>
OPEN BAY.FILE TO BAY ELSE ABORT=12
WIP.FILE='WIP,':DUSERS<15>
OPEN WIP.FILE TO WIP ELSE ABORT=13
IF ABORT THEN
CRT SCR:PR:'Program Abort Code=':ABORT:' (enter) ':
INPUT QAZ: ; STOP
END
IF CUSTCODE='' THEN CUSTCODE=DUSERS<17> ; * customer working with
*********************
* Screen Definition *
*********************
SCR:=BON
SCR:=@(0,2):'Customer:':@(32):'Transaction:'
IF OTHERACTS#'' THEN
SCR:=@(33,3):' Carrier:'
SCR:=@(33,4):' Reference:'
END
IF OTHERACTS<1>='S' THEN SCR:=@(36,5):'Ship To:'
SCR:=@(0,6):STR('-',80):@(0,9):STR('-',80)
SCR:=BOF
SCR4=@(0,10):EOP:@(0,10):BON
SCR4:=' ## Item.Number':@(20):'Description':@(50):'Quantity'
SCR4:=@(59):'Bay.Area':@(71):'Comment':BOF
IN.ITEM=16 ; IN.QTY=19 ; IN.BAY=17 ; IN.COM=20
IF CUSTCODE#'' THEN
READV CUSTNAME FROM CUSTOMERS, CUSTCODE, 1 ELSE CUSTNAME=''
IF CUSTNAME#'' THEN FOUNDID=CUSTCODE ; GO 20
CUSTCODE=''
END
************
* Top Loop *
************
10 CRT SCR:
RELEASE
VALIDACTS='G':AM:'F':AM:'L':AM:'E'
PARAMETER=''
PARAMETER<1>=8 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,OPT,PROGRAM,PARAMETER)
BEGIN CASE
CASE OPT='E' ; * Exit Program
STOP
CASE OPT='F' OR OPT='G' ; * Find or Get Item
IF OPT='F' THEN TYPE='RECORD'
IF OPT='G' THEN TYPE='ID'
CRT PR:'Input Search Value for ':TYPE:': ':
INPUT VALUE:
CONVERT BADS TO '' IN VALUE
* IF VALUE='' THEN GO 10
COMD1='0 1T 4 5 6 12'
CALL FIND.REC(CUSTOMERS,CUSTOMERS.FILE,PROGRAM,TYPE,VALUE,FOUNDID,COMD1)
IF FOUNDID#'' THEN GO 20
CASE OPT='L' ; * List File
COMD1='0 1T 4 5 6 12'
CALL LIST.REC(CUSTOMERS.FILE,PROGRAM,'80',COMD1)
CASE 1
END CASE
GO 10
***********************
* Read/Display Record *
***********************
20 DCUSTOMERS=''
READ DCUSTOMERS FROM CUSTOMERS, FOUNDID ELSE DCUSTOMERS='' ; GO 10
IF DCUSTOMERS<20>="YES" THEN UNIQUEINV=1 ELSE UNIQUEINV=0
*****************
* Call SORTFILE *
*****************
25 PREFIX=FOUNDID:'*' ; MAT SROW = ''
IF NOT(UNIQUEINV) THEN
CALL SORTFILE(INVENTORY,INVENTORY.FILE,PREFIX,MAT SROW)
END
IF REDO THEN RETURN
*******************
* Get Transaction * (or new)
*******************
30 CRT SCR:@(10,2):FOUNDID:@(0,3):DCUSTOMERS<1>[1,30]:
CRT @(0,8):'Select Transaction':
RELEASE
VALIDACTS='W':AM:'T':AM:'F':AM:'L':AM:'E'
PARAMETER=''
PARAMETER<1>=8 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,OPT,PROGRAM,PARAMETER)
BEGIN CASE
CASE OPT='E' ; * Exit Program
STOP
CASE OPT='W' ; * Add New Transaction
DINREC='' ; OLDREC='' ; TRANSID='NEW'
GO 40
CASE OPT='F' OR OPT='T' ; * Find or (geT)(Get) Item
IF OPT='F' THEN TYPE='RECORD'
IF OPT='T' THEN TYPE='ID'
CRT PR:'Input Search Value for ':TYPE:': ':
INPUT VALUE:
CONVERT BADS TO '' IN VALUE
BEGIN CASE
CASE VALUE='' OR VALUE='*'
VALUE=FOUNDID:'*'
CASE OPT='T'
VALUE=FOUNDID:'*':VALUE
END CASE
COMD1='TRANSNO 1 2 3 4 13 14 15 ID-SUPP'
COMD1<2>=FOUNDID ; * prefix (customer id)
COMD1<3>=PROGTYPE ; * REC... DIS... ADJ..
CALL FIND.REC(HISTORY,HISTORY.FILE,PROGRAM,TYPE,VALUE,TRANSID,COMD1)
IF TRANSID#'' THEN GO 35
CASE OPT='L' ; * List File
COMD='SORT ':HISTORY.FILE
COMD:=' WITH CUSTID = "':FOUNDID:'"'
COMD:=' AND WITH 13 = "PENDING"'
COMD:=' AND WITH 5 = "':PROGTYPE:'"'
COMD:=' TRANSNO 1 2 3 4 13 14 15 ID-SUPP'
COMD:=' HEADING "<':PROGRAM:'> ':PROGTYPE:' Pending Tranactions'
COMD:=' for Customer ':FOUNDID
COMD:=" Page 'PL'":'"'
COMD:=' FOOTING " or (enter) "'
EXECUTE COMD
CASE 1
END CASE
GO 30
*********************
* Read History Item *
*********************
35 LOC=0 ; DINREC=''
READU DINREC FROM HISTORY, FOUNDID:'*':TRANSID LOCKED LOC=1 ELSE DINREC=''
IF LOC THEN
CRT ER:PR:'Record locked by another user. (enter) ':
INPUT QAZ: ; GO 30
END
IF DINREC='' THEN GO 30 ; * new record...
OLDREC=DINREC
*+
WIPUSER=FOUNDID:'*':TRANSID ; WIPTYPE='TRAN' ; WIPTYPE<-1>='MINUS'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
*+
IF PROGTYPE='ADJUSTMENT' THEN
D18=DINREC<18> ; D19=DINREC<19> ; DINREC<18>='' ; DINREC<19>=''
LOOP
UNTIL D18='' DO
ACODE=D18<1,1> ; QUANTITY=D19<1,1>
IF ACODE='-' THEN QUANTITY=QUANTITY * (-1)
DINREC<18,-1>=ACODE ; DINREC<19,-1>=QUANTITY
D18=DELETE(D18,1,1,0) ; D19=DELETE(D19,1,1,0)
REPEAT
END
*+
WIPUSER='USER':SYSTEM(18):'_':PROGRAM ; WIPTYPE='USER' ; WIPTYPE<-1>='ADD'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
****************
* Paint Screen *
****************
40 CRT SCR:
GG=@(10,2):FOUNDID:@(45,2):TRANSID
GG:=@(0,3):DCUSTOMERS<1>[1,30]
IF OTHERACTS#'' THEN ; * Carrier
READV CARRIERNAME FROM CARRIERS, DINREC<15>, 1 ELSE CARRIERNAME=''
DMY=DINREC<15>:' ':CARRIERNAME
GG:=@(45,3):DMY[1,35]
END
IF OTHERACTS<1>='S' THEN ; * Shipto
READ DSHIPTOS FROM SHIPTOS, FOUNDID:'*':DINREC<14> ELSE DSHIPTOS=''
SHIPNAME=DSHIPTOS<1> ; CUSTSHIPNO=DSHIPTOS<28>
* DMY=DINREC<14>:' ':SHIPNAME
* GG:=@(20,5):CUSTSHIPNO'R#15':@(45,5):DMY[1,35]
DMY=CUSTSHIPNO:' ':SHIPNAME
GG:=@(45,5):DMY[1,35]
END
GG:=@(45,4):DINREC<4> ; * reference number
CRT GG:
IF REDISPLAY THEN RETURN
GOSUB 6000
GO 30
*****************
* Entry Routine *
*****************
6000 CRT SCR4:
MNE=DCOUNT(DINREC,VM)
IF DINREC='' THEN ADDING=1 ELSE ADDING=0
BE=1 ; EE=10
IF ADDING THEN
EN=1 ; GO 6100
END
*+
6050 GOSUB 6400
*+
6060 VALIDACTS='A':AM:'U':AM:'X'
IF DINREC#'' THEN VALIDACTS:=AM:'M':AM:'I'
IF MNE GE 10 THEN VALIDACTS:=AM:'N'
IF OTHERACTS#'' THEN VALIDACTS<-1>=OTHERACTS:AM:'R'
VALIDACTS<-1>='O' ; * other data entry
PARAMETER=''
PARAMETER<1>=8 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,ANS2,PROGRAM,PARAMETER)
BEGIN CASE
CASE ANS2='O' ; * Other Data Entry
CRT PR:'... Option to entry more data here ... incomplete ... (enter) ':
INPUT QAZ:
CASE ANS2='R' ; * Reference Number
CRT @(45,4):
INPUT REFERNO,30_:
IF REFERNO='' THEN REFERNO=DINREC<4>
CONVERT BADS TO '' IN REFERNO
REFERNO=TRIM(REFERNO)
DINREC<4>=REFERNO
CRT @(45,4):EOL:@(45):REFERNO:
CASE ANS2='S' ; * Shipto Entry
IF DINREC<14>#'' THEN
CRT @(0,21):'Delete Shipto Code':EOL:
VALIDACTS='Y':AM:'V'
PARAMETER=''
PARAMETER<1>=9 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,ANS3,PROGRAM,PARAMETER)
IF ANS3='Y' THEN
DINREC<14>=''
CRT @(45,5):EOL:
GO 6060
END
END
CTRLID=SYSTEM(18):'_WHC003'
WRITE PROGRAM ON CTRL, CTRLID
EXECUTE 'RUN BP WHC003 ':FOUNDID
READ VALUE FROM CTRL, CTRLID ELSE VALUE=''
IF VALUE#'' THEN
READ DSHIPTOS FROM SHIPTOS, FOUNDID:'*':VALUE ELSE DSHIPTOS=''
IF DSHIPTOS#'' THEN DINREC<14>=VALUE
END
REDISPLAY=1
GOSUB 40
CRT SCR4:
REDISPLAY=0
CASE ANS2='C' ; * Carrier Entry
IF DINREC<15>#'' THEN
CRT @(0,21):'Delete Carrier Code':EOL:
VALIDACTS='Y':AM:'V'
PARAMETER=''
PARAMETER<1>=9 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,ANS3,PROGRAM,PARAMETER)
IF ANS3='Y' THEN
DINREC<15>=''
CRT @(45,3):EOL:
GO 6060
END
END
CTRLID=SYSTEM(18):'_WHC002'
WRITE PROGRAM ON CTRL, CTRLID
EXECUTE 'RUN BP WHC002'
READ VALUE FROM CTRL, CTRLID ELSE VALUE=''
IF VALUE#'' THEN
READ DCARRIERS FROM CARRIERS, VALUE ELSE DCARRIERS=''
IF DCARRIERS#'' THEN DINREC<15>=VALUE
END
REDISPLAY=1
GOSUB 40
CRT SCR4:
REDISPLAY=0
CASE ANS2='X' ; * eXit
WIPUSER='USER':SYSTEM(18):'_':PROGRAM ; WIPTYPE='USER' ; WIPTYPE<-1>='MINUS'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
*+
IF TRANSID#'NEW' THEN
WIPUSER=FOUNDID:'*':TRANSID ; WIPTYPE='TRAN' ; WIPTYPE<-1>='ADD'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,OLDREC,WIPTYPE,PROGTYPE)
END
RETURN
CASE ANS2='U' ; * Update
WIPUSER='USER':SYSTEM(18):'_':PROGRAM ; WIPTYPE='USER' ; WIPTYPE<-1>='MINUS'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
IF TRANSID='NEW' THEN
IF DINREC<16>='' THEN
RETURN ; * nothing to post
END
CALL ASSIGN.ID(HISTORY,HISTORY.FILE,DINREC,TRANSID,CTRL)
END
IF DINREC<1>='' THEN DINREC<1>=SYSTEM(19)
IF DINREC<2>='' THEN DINREC<2>=DATE()
IF DINREC<3>='' THEN DINREC<3>=TIME()
IF DINREC<5>='' THEN DINREC<5>=PROGTYPE
IF DINREC<13>='' THEN DINREC<13>='PENDING'
DMY=DINREC<19> ; DINREC<18>='' ; DINREC<19>=''
LOOP
UNTIL DMY='' DO
QUANTITY=DMY<1,1>
BEGIN CASE
CASE PROGTYPE='RECEIPT' ; ACODE='+'
CASE PROGTYPE='DISBURSEMENT' ; ACODE='-'
CASE 1
IF QUANTITY GE 0 THEN ACODE='+' ELSE ACODE='-'
END CASE
DINREC<18,-1>=ACODE
DINREC<19,-1>=ABS(QUANTITY)
DMY=DELETE(DMY,1,1,0)
REPEAT
IF DINREC<16>='' THEN DINREC<13>='DELETED'
WRITE DINREC ON HISTORY, PREFIX:TRANSID
*+
WIPUSER=PREFIX:TRANSID ; WIPTYPE='TRAN' ; WIPTYPE<-1>='ADD'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
*+
BEGIN CASE
CASE PROGTYPE='RECEIPT'
PRINTLIST='Print Receiving List' ; PPROG='WHR201'
CASE PROGTYPE='DISBURSEMENT'
PRINTLIST='Print Pick List' ; PPROG='WHP201'
CASE 1
PRINTLIST='' ; PPROG=''
END CASE
IF PRINTLIST#'' THEN
CRT @(0,21):EOL:@(0):PRINTLIST:
VALIDACTS='Y':AM:'Q'
PARAMETER=''
PARAMETER<1>=6 ; * Spacing of action words
PARAMETER<2>=22 ; * y coordinate
CALL USER.ACTION(ACTIONS,VALIDACTS,POPT,PROGRAM,PARAMETER)
IF POPT='Y' THEN
COMD='RUN BP ':PPROG:' ':PREFIX:TRANSID
EXECUTE COMD
**********************************
* Start Streamline Disbursements *
**********************************
IF PPROG='WHP201' AND STREAMLINE='YES' THEN
* print pack list
COMD='RUN BP WHP201 ':PREFIX:TRANSID:' PACKLIST'
EXECUTE COMD
*
* post disbursement
COMD='RUN BP WHPOST DISBURSEMENT ':PREFIX:TRANSID
EXECUTE COMD
*
* create bol
COMD='RUN BP BL100 ':PREFIX:TRANSID
EXECUTE COMD
*
* print bol
READV BOLNO FROM CTRL, SYSTEM(18):'_BL100', 1 ELSE BOLNO=''
IF BOLNO#'' THEN
COMD='RUN BP BL200 ':PREFIX:BOLNO
EXECUTE COMD
END
END
********************************
* End Streamline Disbursements *
********************************
END
END
***
RETURN
CASE ANS2='I' AND DINREC#''
CRT PR:'Enter Line Number to Insert BEFORE ':
INPUT LINENO:
IF NUM(LINENO)=0 THEN LINENO=0
LINENO=INT(LINENO)
IF LINENO L 1 OR LINENO G MNE THEN
CRT ER:'Invalid Line Number.': ; GO 6060
END
DINREC=INSERT(DINREC,IN.ITEM,LINENO,0,'*')
DINREC=INSERT(DINREC,IN.QTY,LINENO,0,'0')
DINREC=INSERT(DINREC,IN.BAY,LINENO,0,BAY.NULL.ID)
DINREC=INSERT(DINREC,IN.COM,LINENO,0,'*')
DATA LINENO
GO 6000
CASE ANS2='A'
EN=MNE+1
IF EN GE BE AND EN LE EE THEN GO 6100
BE=(INT((EN-1)/10)*10)+1 ; EE=BE+9 ; GOSUB 6400 ; GO 6100
CASE ANS2='N'
IF MNE L 11 THEN BE=1 ; EE=10 ; GO 6050
IF MNE GE EE+1 THEN BE=BE+10 ; EE=EE+10 ELSE BE=1 ; EE=10
CASE ANS2='M' ; * modify
LOOP
UNTIL NUM(ANS2)=1 DO
CRT PR:'Enter Line Number (##) to modify ':
INPUT ANS2:
REPEAT
IF NOT(ANS2 GT 0 AND ANS2 LE MNE) THEN CRT ER:"Not valid, must be between 1 and ":MNE:BELL: ; GO 6060
IF NOT(ANS2 GE BE AND ANS2 LE EE) THEN CRT ER:"Not on this page.":BELL: ; GO 6060
EN=ANS2
MODIFY.FLAG=1 ; CRT PR:
GO 6100
END CASE
GO 6050
****************
* GET AN ENTRY *
****************
6100 R=(EN-BE+11) ; CRT @(1,R):BOF:EN'R%2':BOF:
IF DINREC='' THEN ADDING=1 ELSE ADDING=0
X1=DINREC ; X2=DINREC ; X3=DINREC
X4=DINREC
IF MODIFY.FLAG THEN MODIFY.FLAG=0 ; GO 6160
***************
* Item Number *
***************
6120 XXX=X1 ; MSK='L#15' ; DL=15 ; C=4 ; MAX=0 ; CV=''
INSTRUCT=BON:'<':BOF:'Esc':BON:'> key to exit entry; '
INSTRUCT:=BON:'<':BOF:'enter':BON:'> to choose from list'
IF XXX#'' THEN INSTRUCT:='; <':BOF:'F9':BON:'> key to Delete Line'
INSTRUCT:=BOF
CRT @(0,7):EOL:INSTRUCT:
CNT=DCOUNT(SROW(21),AM) ; ILEN=0
GOSUB 8000 ; * item counter (ala) added 07-24-2002
IF NOT(UNIQUEINV) THEN CRT @(0,8):CNT:' inventory items':EOL:
CRT @(25,8):BON:'<':BOF:'F2':BON:'> last item':BOF:
IF ITEMCOUNT#'' THEN CRT @(45,8):ITEMCOUNT:
IF XXX='' THEN CRT @(C,R):STR("_",DL):@(C,R): ELSE CRT @(C,R):
RESP=''
LOOP
INPUT Q,0: ; S=SEQ(Q)
UNTIL S=10 OR S=13 OR S=255 DO
BEGIN CASE
CASE S=27 ; * escape (exit entry)
RESP='' ; GO 6135
CASE S=9 ; * tab (delete line)
IF RESP='' AND DINREC#'' THEN
DEL DINREC ; DEL DINREC
DEL DINREC ; DEL DINREC
WIPUSER='USER':SYSTEM(18):'_':PROGRAM ; WIPTYPE='USER' ; WIPTYPE<-1>='ADD'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
END
GO 6050
CASE S=8 ; * backspace
IF LEN(RESP)>1 THEN RESP=RESP[1,LEN(RESP)-1] ELSE RESP=''
CRT @(C,R):STR("_",DL):@(C,R):RESP:
CASE S LE 31 ; * special characters (ignore)
CASE 1
RESP:=Q
END CASE
IF LEN(RESP)=0 THEN
CNT=DCOUNT(SROW(21),AM)
END ELSE
ILEN=LEN(RESP) ; CNT=0
IF ILEN GE 20 THEN ILEN=20
LOCATE RESP IN SROW(ILEN)<1>, 1 SETTING PPP ELSE PPP=0
IF PPP THEN CNT=DCOUNT(SROW(ILEN)<2,PPP>,SVM)
END
IF NOT(UNIQUEINV) THEN CRT @(0,8):CNT:' inventory items':EOL:
CRT @(25,8):BON:'<':BOF:'F2':BON:'> last item':BOF:
IF ITEMCOUNT#'' THEN CRT @(45,8):ITEMCOUNT:
CRT @(C,R):STR("_",DL):@(C,R):RESP:
REPEAT
RESP=RESP[1,DL]
**
IF UNIQUEINV THEN
READ DTEST FROM INVENTORY, PREFIX:RESP ELSE DTEST=''
IF DTEST='' THEN CNT=0 ELSE CNT=1
END
**
BEGIN CASE
CASE RESP='' AND XXX#''
RESP=XXX
CASE CNT=0 AND RESP#'' ; * new item
CRT PR:'Is this a new item? (Y)es (N)o ':
INPUT QUIP: ; QUIP=OCONV(QUIP,'MCU')
IF QUIP[1,1]#'Y' THEN CRT PR: ; GO 6120
**
IF UNIQUEINV THEN
GOSUB 8200 ; * write new inventory item
ITEMNO=RESP
GO 6125
END
**
CTRLID=SYSTEM(18):'_WHC004' ; ITEMNO=''
WRITE '' ON CTRL, CTRLID
EXECUTE 'RUN BP WHC004 ':FOUNDID:' ':RESP
READ VALUE FROM CTRL, CTRLID ELSE VALUE=''
IF VALUE#'' THEN
READ DINVENTORY FROM INVENTORY, FOUNDID:'*':VALUE ELSE DINVENTORY=''
IF DINVENTORY#'' THEN ITEMNO=VALUE ; REDO=1
END
IF REDO THEN
GOSUB 25 ; REDO=0 ; * added inventory item, reselect
END
**
6125 REDISPLAY=1
GOSUB 40
CRT SCR4:
GOSUB 6400
REDISPLAY=0
CRT @(1,R):BOF:EN'R%2':BOF:
IF ITEMNO#'' THEN RESP=ITEMNO ; GO 6135
GO 6120
CASE CNT=1 ; * got item
IF NOT(UNIQUEINV) THEN
IF ILEN THEN RESP=SROW(ILEN)<2,PPP,1> ELSE RESP=SROW(21)<1>
END
CASE 1 ; * pick item from list
IF ILEN THEN ALIST=SROW(ILEN)<2,PPP> ELSE ALIST=SROW(21)
ITEMNO=''
CALL WHE101.2(PREFIX,INVENTORY,ALIST,ITEMNO,WIP)
REDISPLAY=1
GOSUB 40
CRT SCR4:
GOSUB 6400
REDISPLAY=0
CRT @(1,R):BOF:EN'R%2':BOF:
IF ITEMNO#'' THEN RESP=ITEMNO ; GO 6135
GO 6120
END CASE
6135 CRT @(0,7):EOL:@(0,8):EOL:
CRT @(C,R):RESP MSK:
READV ITEMNAME FROM INVENTORY, PREFIX:RESP, 1 ELSE ITEMNAME=''
CRT @(20,R):ITEMNAME[1,29]'L#30':
****
IF RESP='' AND ADDING THEN CRT @(0,R):EOL: ; GOSUB 6440 ; GO 6060
X1=RESP ; CRT @(C,R):RESP MSK:
*************************
* SET F2 TO Item Number *
*************************
LN=CHAR(27):CHAR(2):'F':'NU1':RESP:'^M':CHAR(13)
PRINT LN
************
* Quantity *
************
6140 XXX=X2 ; MSK='R#8' ; DL=8 ; C=50 ; MAX=0 ; CV='MR0' ; VALIDS=''
INSTRUCT=BON:'<':BOF:'Esc':BON:'> view QOH for item; '
INSTRUCT:=BON:'<':BOF:'F4':BON:'> to list entire warehouse':BOF
INSTRUCT1=''
IF FOUNDID='BRYLA' THEN INSTRUCT1=BON:'<':BOF:'C':BON:'>hange Description':BOF
CRT @(0,7):EOL:INSTRUCT:@(0,8):EOL:INSTRUCT1
GOSUB 7500
BEGIN CASE
CASE SEQ(RESP)=67 AND FOUNDID='BRYLA' ; * change description
RESP=X1
CRT PR:'Enter New Description ':
INPUT NEWDESC:
CONVERT BADS TO '' IN NEWDESC
IF NEWDESC#'' THEN
WRITEV NEWDESC ON INVENTORY, PREFIX:RESP, 1
END
CRT ER:PR:
GO 6135
CASE SEQ(RESP)=27 ; * escape (view Inventory QOH)
CRT @(40,6):'( ':PROGTYPE:' Quantity=':X2:' )'
READV INVBAY FROM INVENTORY, PREFIX:X1, 7 ELSE INVBAY=''
IF INVBAY='' THEN
CRT ER:'There is no inventory on hand for this item.':
GO 6140
END
BAYNO='' ; INVENTORYID=PREFIX:X1
CALL WHE101.3(WIP,INVENTORY,BAY,BAY.FILE,INVENTORYID,BAYNO,CHAR(27))
IF BAYNO#'' THEN X3=BAYNO
REDISPLAY=1
GOSUB 40
CRT SCR4:
GOSUB 6400
REDISPLAY=0
CRT @(1,R):BOF:EN'R%2':BOF:
CRT @(4,R):X1'L#15':@(20):ITEMNAME[1,29]'L#30':@(50):OCONV(X2,'MR0')'R#8':
CRT @(59):X3:
GO 6140
CASE SEQ(RESP)=63 ; * "?" entered
BAYNO='' ; RESP='' ; INVENTORYID=PREFIX:X1
CALL WHE101.3(WIP,INVENTORY,BAY,BAY.FILE,INVENTORYID,BAYNO,RESP)
IF BAYNO#'' THEN X3=BAYNO
REDISPLAY=1
GOSUB 40
CRT SCR4:
GOSUB 6400
REDISPLAY=0
CRT @(1,R):BOF:EN'R%2':BOF:
CRT @(4,R):X1'L#15':@(20):ITEMNAME[1,29]'L#30':@(50):OCONV(X2,'MR0')'R#8':
CRT @(59):X3:
GO 6140
CASE UPFLAG
UPFLAG=0 ; GO 6120
END CASE
X2=RESP
**************
* Bay Number *
**************
*6160 XXX=X3 ; MSK='L#':BAY.MAX.LENGTH ; DL=BAY.MAX.LENGTH
* C=59 ; MAX=0 ; CV='' ; VALIDS=BAY.VALID.LIST
* GOSUB 7500
* IF UPFLAG THEN UPFLAG=0 ; GO 6140
* X3=RESP
**************
* Bay Number *
**************
6160 XXX=X3 ; MSK='L#':BAY.MAX.LENGTH ; DL=BAY.MAX.LENGTH
C=59 ; MAX=0 ; CV='' ; VALIDS=BAY.VALID.LIST
INSTRUCT=BON:'<':BOF:'Esc':BON:'> view QOH for item; '
INSTRUCT:=BON:'<':BOF:'F4':BON:'> to list entire warehouse':BOF
INSTRUCT0=BON:'<':BOF:'F3':BON:'> last Bay Number;':BOF
INSTRUCT1=BON:'<':BOF:'enter':BON:'> for default, general/unknown bay area':BOF
CRT @(0,7):EOL:INSTRUCT:@(0,8):INSTRUCT0:@(25,8):INSTRUCT1:
IF XXX='' THEN CRT @(C,R):STR("_",DL):@(C,R): ELSE CRT @(C,R):
RESP=''
LOOP
INPUT Q,0: ; S=SEQ(Q)
UNTIL S=10 OR S=13 OR S=255 OR LEN(RESP) GE DL DO
BEGIN CASE
CASE S=27 ; * escape (view Inventory QOH)
CRT @(40,6):'( ':PROGTYPE:' Quantity=':X2:' )'
READV INVBAY FROM INVENTORY, PREFIX:X1, 7 ELSE INVBAY=''
IF INVBAY='' THEN
CRT ER:'There is no inventory on hand for this item.':
GO 6160
END
BAYNO='' ; INVENTORYID=PREFIX:X1
CALL WHE101.3(WIP,INVENTORY,BAY,BAY.FILE,INVENTORYID,BAYNO,CHAR(27))
REDISPLAY=1
GOSUB 40
CRT SCR4:
GOSUB 6400
REDISPLAY=0
CRT @(1,R):BOF:EN'R%2':BOF:
CRT @(4,R):X1'L#15':@(20):ITEMNAME[1,29]'L#30':@(50):OCONV(X2,'MR0')'R#8'
IF BAYNO#'' THEN RESP=BAYNO ; GO 6170
GO 6160
CASE S=63 AND RESP='' ; * "?" entered
RESP=Q
GO 6165
CASE S=8 ; * backspace
IF LEN(RESP)>1 THEN RESP=RESP[1,LEN(RESP)-1] ELSE RESP=''
CRT @(C,R):STR("_",DL):@(C,R):RESP:
CASE S=26 OR S=21; * up arrow / left arrow
CRT @(C,R):XXX MSK:
CRT @(0,7):EOL:@(0,8):EOL:
GO 6140
CASE S LE 31 ; * special characters (ignore)
CASE 1
RESP:=Q
END CASE
REPEAT
6165 RESP=RESP[1,DL] ; RESP=OCONV(RESP,'MCU')
BEGIN CASE
CASE RESP='' AND XXX#''
RESP=XXX
CASE RESP='' AND XXX=''
RESP=BAY.NULL.ID ; * default (floor)
CASE 1 ; * pick item from list
IF RESP='?' THEN RESP=''
OKAY=0
CONVERT '.,' TO '--' IN RESP ; * Oliver/Speedway Modification
READ DBAY FROM BAY, RESP ELSE DBAY=''
IF DBAY#'' THEN OKAY=1
IF NOT(OKAY) THEN
BAYNO='' ; INVENTORYID=PREFIX:X1
CALL WHE101.3(WIP,INVENTORY,BAY,BAY.FILE,INVENTORYID,BAYNO,RESP)
REDISPLAY=1
GOSUB 40
CRT SCR4:
GOSUB 6400
REDISPLAY=0
CRT @(1,R):BOF:EN'R%2':BOF:
CRT @(4,R):X1'L#15':@(20):ITEMNAME[1,29]'L#30':@(50):OCONV(X2,'MR0')'R#8'
IF BAYNO#'' THEN RESP=BAYNO ; GO 6170
GO 6160
END
END CASE
**************************
* Check Quantity on Hand *
**************************
6170 FAIL=0 ; QTY.ENTERED=X2 ; BAYNO.ENTERED=RESP
CALL CHECK.QTY(PREFIX:X1,QTY.ENTERED,BAYNO.ENTERED,BAY,WIP,PROGTYPE,FAIL)
IF FAIL THEN
CRT ER:'This Quantity is ':FAIL:' MORE than currently in Bay=':RESP:
CRT ' (enter) ': ; INPUT QAZ: ; CRT ER: ; GO 6160
END
***
CRT @(0,7):EOL:@(0,8):EOL:
CRT @(C,R):RESP MSK:
X3=RESP
************************
* SET F3 TO Bay Number *
************************
LN=CHAR(27):CHAR(2):'F':'NU2':RESP:'^M':CHAR(13)
PRINT LN
***********
* Comment *
***********
6220 XXX=X4 ; MSK='L#9' ; DL=9 ; C=71 ; MAX=0 ; CV=''
GOSUB 7500
IF UPFLAG THEN UPFLAG=0 ; GO 6160
X4=RESP
**************
* Update WIP *
**************
DINREC=X1
DINREC=X2
DINREC=X3
DINREC=X4
WIPUSER='USER':SYSTEM(18):'_':PROGRAM ; WIPTYPE='USER' ; WIPTYPE<-1>='ADD'
CALL UPDATE.WIP(WIP.FILE,WIP,FOUNDID,WIPUSER,DINREC,WIPTYPE,PROGTYPE)
*+
IF ADDING THEN
CRT @(1,R):BON:EN'R%2':BOF:
EN=EN+1
IF EN > EE THEN
BE+=10 ; EE+=10 ; GOSUB 6400
END
GO 6100
END ELSE
GOSUB 6440
GO 6060
END
***********************
* Display 'up a page' *
***********************
6400 JJ=@(0,11):EOP
FOR XX = BE TO EE WHILE DINREC#''
JJ:=@(1,11+XX-BE):BON:XX'R%2':BOF:' ':DINREC'L#16'
READV IDESC FROM INVENTORY, PREFIX:DINREC, 1 ELSE IDESC=''
JJ:=@(20):IDESC[1,29]'L#30'
JJ:=@(50):DINREC'R#8'
JJ:=@(59):DINREC'L#12'
JJ:=@(71):DINREC[1,9]'L#9'
NEXT XX
CRT JJ:
6440 MNE=DCOUNT(DINREC,VM)
RETURN
********************
* Input Subroutine *
********************
7500 *** start special one character input ***
* SEQ values *
* 13 or 255 - enter
* 10 - down arrow
* 26 - up arrow
* 21 - left arrow
* 6 - right arrow
* 9 - tab
* 27 - escape
* 8 - backspace
**************
IF XXX='' THEN CRT @(C,R):STR("_",DL):@(C,R): ELSE CRT @(C,R):
RESP=''
LOOP
INPUT Q,0: ; S=SEQ(Q)
UNTIL S=10 OR S=13 OR S=255 OR S=6 DO
BEGIN CASE
CASE S=8 ; * backspace
IF LEN(RESP)>1 THEN RESP=RESP[1,LEN(RESP)-1] ELSE RESP=''
CRT @(C,R):STR("_",DL):@(C,R):RESP:
CASE S=27 AND C=50 AND RESP='' ; * escape to see QOH
RESP=CHAR(27)
RETURN
CASE S=63 AND C=50 AND RESP='' ; * "?" to view BAY QOH's
RESP=CHAR(63)
RETURN
CASE S=26 OR S=21; * up arrow / left arrow
UPFLAG=1
RETURN
CASE S LE 31 ; * special characters (ignore)
CASE 1
RESP:=Q
END CASE
* CRT @(C,R):STR("_",DL):@(C,R):RESP:
REPEAT
RESP=RESP[1,DL]
CONVERT BADS TO '' IN RESP
IF RESP='' AND XXX#'' THEN RESP=XXX
7520 RESP=TRIM(RESP)
BEGIN CASE
CASE RESP='C' AND FOUNDID='BRYLA'
* change description during quantity prompt
CV=''
CASE RESP='' AND XXX=''
RESP='*'
IF CV[1,1]='M' THEN RESP=0
IF C=59 THEN RESP=BAY.NULL.ID ; * Bay Area Default
CASE C=59 AND VALIDS#'' AND RESP#BAY.NULL.ID; * Bay Area Format Validation
OKAY=0
* CALL WHE101.BAY(RESP,VALIDS,OKAY)
* IF NOT(OKAY) THEN CRT ER:'Invalid Bay Format.': ; GO 7500
* Oliver/Speedway checks against BAY File *
CONVERT '.,' TO '--' IN RESP ; * Oliver/Speedway Modification
READ DBAY FROM BAY, RESP ELSE DBAY=''
IF DBAY#'' THEN OKAY=1
IF NOT(OKAY) THEN CRT ER:'Invalid Bay Number.': ; GO 7500
CASE CV#''
RESP=ICONV(RESP,CV)
IF CV[1,1]='M' AND NUM(RESP)=0 THEN
CRT ER:'Invalid Entry.':BELL: ; GO 7500
END
IF PROGTYPE='RECEIPT' OR PROGTYPE='DISBURSEMENT' THEN
RESP=ABS(RESP) ; * (always set to 'positive' value)
END
END CASE
BEGIN CASE
CASE CV#''
CRT @(C,R):SPACE(DL):@(C,R):OCONV(RESP,CV) MSK:
CASE 1
CRT @(C,R):SPACE(DL):@(C,R):RESP[1,DL] MSK:
END CASE
RETURN
****************
* Item Counter * (ala) Added 07-24-2002
****************
8000 ITEMCOUNT=''
BEGIN CASE
CASE PROGTYPE#'DISBURSEMENT' ; GO 8100
CASE DINREC<16>='' ; GO 8100
CASE 1
XX=DCOUNT(DINREC<16>,VM) ; LAST=DINREC<16,XX>
FOR MM=XX TO 1 STEP -1
IF LAST#DINREC<16,MM> THEN MM=1 ; GO 8050
ITEMCOUNT+=DINREC<19,MM>
8050 NEXT MM
END CASE
ITEMCOUNT='Item=':LAST:' Count=':OCONV(ITEMCOUNT,'MR0,')
8100 RETURN
****************************
* Write New Inventory Item *
****************************
8200 DINVENTORY=''
CRT PR:'Enter Item Description: ':
INPUT ITEMDESC:
ITEMDESC=TRIM(ITEMDESC)
ITEMDESC=OCONV(ITEMDESC,'MCU')
CONVERT BADS TO '' IN ITEMDESC
**
DINVENTORY<1>=ITEMDESC[1,40]
DINVENTORY<2>='EA'
DINVENTORY<13>=DATE() ; * Created
DINVENTORY<14>=USERID
DINVENTORY<15>=DATE()
DINVENTORY<16>=TIME()
WRITE DINVENTORY ON INVENTORY, PREFIX:RESP
RETURN