844 lines
27 KiB
Plaintext
844 lines
27 KiB
Plaintext
|
SUBROUTINE CMSD.INV.MASTER(IMA.DATA)
|
||
|
|
*----------------------------------------------------------------------
|
||
|
|
*PGM NAME: CMSD.INV.MASTER
|
||
|
|
*PURPOSE: PERFORM ALL INVENTORY UPDATES - RETURN PASS/FAIL RESULT
|
||
|
|
*AUTHOR: BARKSDALE
|
||
|
|
*CREATED: 08/12/94
|
||
|
|
*----------------------------------------------------------------------
|
||
|
|
*
|
||
|
|
* BEWARE!!! This program performs all updates which affect quantity
|
||
|
|
* available and physical quantity to inventory including transaction
|
||
|
|
* detail and summarized activity (historical record-keeping) for any
|
||
|
|
* inventory item. It is called from a significant number of programs
|
||
|
|
* system-wide as well as from itself (recursive). Please exercise
|
||
|
|
* EXTREME CAUTION when making additions or changes to code contained
|
||
|
|
* herein!
|
||
|
|
*
|
||
|
|
*--explanation of reject reason codes:
|
||
|
|
* 1 - quantity is zero or null
|
||
|
|
* 2 - invalid date
|
||
|
|
* 3 - cannot assemble non-assembled items
|
||
|
|
* 4 - transactions not valid against assembled items
|
||
|
|
* 5 - invalid warehouse
|
||
|
|
* 6 - transfers must be reductions to FROM warehouse (negative qty)
|
||
|
|
* 7 - transfers must have valid TO warehouse
|
||
|
|
* 8 - inventory item not on file
|
||
|
|
* 9 - insufficient quantity available
|
||
|
|
* 10 - item has backorders waiting for release
|
||
|
|
* 11 - cannot assemble sufficient quantity
|
||
|
|
*
|
||
|
|
*--include data
|
||
|
|
$INCLUDE GEN.COMMON
|
||
|
|
$INCLUDE IMA
|
||
|
|
$INCLUDE IVT
|
||
|
|
$INCLUDE INV
|
||
|
|
$INCLUDE IA
|
||
|
|
$INCLUDE IC
|
||
|
|
*
|
||
|
|
*--initialize tables
|
||
|
|
READ WHSE.CODES FROM GEN.KEYS,"WAREHOUSE.CODES" ELSE WHSE.CODES=""
|
||
|
|
READ TYPE.CODES FROM GEN.KEYS,"INVTRANS.TYPE" ELSE TYPE.CODES=""
|
||
|
|
*
|
||
|
|
*--initialize other variables
|
||
|
|
READU NEXT.JRNL FROM GEN.KEYS,"NEXT.INV.JOURNAL" THEN
|
||
|
|
NEXT.JRNL=NEXT.JRNL+1
|
||
|
|
END ELSE
|
||
|
|
NEXT.JRNL=1
|
||
|
|
END
|
||
|
|
WRITE NEXT.JRNL ON GEN.KEYS,"NEXT.INV.JOURNAL"
|
||
|
|
EQU TRUE TO 1
|
||
|
|
EQU FALSE TO 0
|
||
|
|
*
|
||
|
|
*----
|
||
|
|
* Check to see if IMA.DATA contains all the necessary data to
|
||
|
|
* perform update to inventory and verify validity of several
|
||
|
|
* of the fields.
|
||
|
|
*----
|
||
|
|
REJECT=FALSE
|
||
|
|
REJECT.REASON=""
|
||
|
|
CHANGED.FIELDS=""
|
||
|
|
*----
|
||
|
|
* Log error in case of ultimate failure to update in any capacity
|
||
|
|
* by the calling program. For example:
|
||
|
|
* - this program was unable to read the inventory item
|
||
|
|
* - the calling program is not defining IMA.DATA properly
|
||
|
|
*----
|
||
|
|
IF IMA.DATA<IMA$FUNCTION>="REPORT.ERROR" THEN GO 100000
|
||
|
|
READ IREC FROM INVENTORY,IMA.DATA<IMA$ITEM> THEN
|
||
|
|
IF IREC<INV$ORDER.CODE>="N" THEN
|
||
|
|
INXFLAG=TRUE
|
||
|
|
END ELSE
|
||
|
|
INXFLAG=FALSE
|
||
|
|
END
|
||
|
|
IF IREC<INV$ASSEMBLED>="Y" THEN
|
||
|
|
ASMFLAG=TRUE
|
||
|
|
END ELSE
|
||
|
|
ASMFLAG=FALSE
|
||
|
|
END
|
||
|
|
IF IMA.DATA<IMA$QUANTITY>="" OR IMA.DATA<IMA$QUANTITY>=0 THEN
|
||
|
|
IF IMA.DATA<IMA$FUNCTION>="PO.ADD" OR IMA.DATA<IMA$FUNCTION>="PO.DELETE" ELSE
|
||
|
|
*--zero or null would be valid only if change PO E.T.A.
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IF IMA.DATA<IMA$DATE>="" THEN
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=2
|
||
|
|
END
|
||
|
|
*----
|
||
|
|
* check to see if valid function
|
||
|
|
*----
|
||
|
|
BEGIN CASE
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="CHECK.AVAILABLE"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="COMMIT"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="UNCOMMIT"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="ADD.BACKORDER"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="DELETE.BACKORDER"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="RELEASE.BACKORDER"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="ASSEMBLE"
|
||
|
|
IF ASMFLAG ELSE
|
||
|
|
REJECT=TRUE;*--may only assemble assembled items
|
||
|
|
REJECT.REASON=3
|
||
|
|
END
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="ASM.ADD"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="PO.ADD"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="PO.DELETE"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="PO.RECEIVE"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="COST.UPDATE"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="RETURN.GOOD"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="RETURN.DAMAGED"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="RETURN.DEFECTIVE"
|
||
|
|
CASE IMA.DATA<IMA$FUNCTION>="REPORT.ERROR"
|
||
|
|
CASE 1
|
||
|
|
LOCATE(IMA.DATA<IMA$FUNCTION>,TYPE.CODES,1;FND) ELSE REJECT=1
|
||
|
|
IF ASMFLAG THEN
|
||
|
|
IF IMA.DATA<IMA$PROCESS>="CMSD.INVTRANS" OR IMA.DATA<IMA$PROCESS>="CMSD.IVT.MULTI" THEN
|
||
|
|
REJECT=TRUE;*--transactions invalid for assembled item
|
||
|
|
REJECT.REASON=4
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END CASE
|
||
|
|
IF IMA.DATA<IMA$WAREHOUSE>="" THEN
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=5
|
||
|
|
END
|
||
|
|
LOCATE(IMA.DATA<IMA$WAREHOUSE>,WHSE.CODES,1;FND) ELSE
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=5
|
||
|
|
END
|
||
|
|
IF IMA.DATA<IMA$FUNCTION>="TRF" THEN
|
||
|
|
IF IMA.DATA<IMA$QUANTITY> > 0 THEN
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=6
|
||
|
|
END
|
||
|
|
IF IMA.DATA<IMA$TO.WHSE>="" THEN
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=7
|
||
|
|
END
|
||
|
|
LOCATE(IMA.DATA<IMA$TO.WHSE>,WHSE.CODES,1;FND) ELSE
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=7
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
REJECT=TRUE
|
||
|
|
REJECT.REASON=8
|
||
|
|
END
|
||
|
|
IF REJECT THEN GO 100000
|
||
|
|
*
|
||
|
|
*--initialize variables
|
||
|
|
MINUS=-1
|
||
|
|
ITEM=IMA.DATA<IMA$ITEM>
|
||
|
|
QTY=IMA.DATA<IMA$QUANTITY>
|
||
|
|
YEAR=OCONV(IMA.DATA<IMA$DATE>,"DY")
|
||
|
|
MONTH=OCONV(IMA.DATA<IMA$DATE>,"DM")'R%2'
|
||
|
|
ACTION=IMA.DATA<IMA$FUNCTION>
|
||
|
|
IF ACTION="ASM.ADD" THEN ACTION="ASM"
|
||
|
|
TYPE=ACTION
|
||
|
|
TDATE=IMA.DATA<IMA$DATE>
|
||
|
|
USER=IMA.DATA<IMA$USER>
|
||
|
|
TREF=IMA.DATA<IMA$REFERENCE>
|
||
|
|
FLOC=IMA.DATA<IMA$WAREHOUSE>
|
||
|
|
TLOC=IMA.DATA<IMA$TO.WHSE>
|
||
|
|
CMNT=IMA.DATA<IMA$COMMENT>
|
||
|
|
WHSE=IMA.DATA<IMA$WAREHOUSE>
|
||
|
|
ENTRY.DATE=DATE()
|
||
|
|
EFFPD=YEAR[3,2]:"-":MONTH
|
||
|
|
TREC=''; IREC=''; AREC=''
|
||
|
|
IKEY=ITEM
|
||
|
|
TKEY=EFFPD:'|':ITEM
|
||
|
|
AKEY=YEAR:"|":WHSE:"|":ITEM
|
||
|
|
TYPWHS=TYPE:"|":WHSE:"|":TDATE
|
||
|
|
*
|
||
|
|
*--------------------main program section-----------------------------
|
||
|
|
BEGIN CASE
|
||
|
|
CASE ACTION="CHECK.AVAILABLE"
|
||
|
|
*----
|
||
|
|
* This is a request to see if sufficient quantity is available to
|
||
|
|
* fulfill a request for an item. It returns a pass/fail result
|
||
|
|
* and is informational only - ABSOLUTELY NO UPDATE to inventory
|
||
|
|
* will occur as a result of this requested action. The purpose for
|
||
|
|
* using this program to simply check availability of an item is to
|
||
|
|
* insure that the verification of availability follows the same
|
||
|
|
* procedural steps as an actual update to inventory and thereby
|
||
|
|
* yields more consistent results.
|
||
|
|
*----
|
||
|
|
IF QTY < 0 ELSE
|
||
|
|
*--if negative quantity then result is always "PASS"
|
||
|
|
IF INXFLAG ELSE
|
||
|
|
*--if inexhaustible supply then result is always "PASS"
|
||
|
|
IF ASMFLAG THEN
|
||
|
|
GOSUB 7000
|
||
|
|
IF REJECT THEN REJECT.REASON=11
|
||
|
|
END ELSE
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 1000
|
||
|
|
IF REJECT THEN REJECT.REASON=9
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
CASE ACTION="COMMIT"
|
||
|
|
*----
|
||
|
|
* This is a request to commit inventory. Quantity should always be
|
||
|
|
* a positive number. An attempt will be made to reduce
|
||
|
|
* INV$QTY.AVAILABLE for item. If quantity available is insufficient
|
||
|
|
* to commit inventory the following other actions will be attempted:
|
||
|
|
* - If INV$ORDER.CODE = "N" then item has an inexhaustible supply
|
||
|
|
* and sufficient quantity will be added to fulfill request.
|
||
|
|
* - If INV$ASSEMBLED = "Y" then item is assembled from components.
|
||
|
|
* An attempt will be made to assemble enough to cover requested
|
||
|
|
* quantity.
|
||
|
|
* If quantity remains insufficient to fulfill request or backorders
|
||
|
|
* already exist for this item then request will be rejected and
|
||
|
|
* the result "FAIL" will be returned to calling program.
|
||
|
|
* "PHYSICAL" quantity remains unaffected regardless of result.
|
||
|
|
*----
|
||
|
|
IF INXFLAG THEN GOSUB 6000 ;*--inexhaustible supply
|
||
|
|
IF ASMFLAG THEN GOSUB 7000 ;*--assembled item
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 1000;*--deduct from available quantity
|
||
|
|
CASE ACTION="UNCOMMIT"
|
||
|
|
*----
|
||
|
|
* This is a request to release inventory which has previously been
|
||
|
|
* committed. Quantity should always be a positive number.
|
||
|
|
* INV$QTY.AVAILABLE will be increased. No attempt will be made to
|
||
|
|
* undo updates resulting from inexhaustible supply or assembled
|
||
|
|
* inventory processes.
|
||
|
|
* Result is always "PASS" to a request to uncommit.
|
||
|
|
* "PHYSICAL" quantity remains unaffected.
|
||
|
|
*----
|
||
|
|
GOSUB 1000;*--add back to available quantity
|
||
|
|
CASE ACTION="ADD.BACKORDER"
|
||
|
|
*----
|
||
|
|
* This is a request to backorder inventory. Quantity should always
|
||
|
|
* be a positive number. INV$QTY.BACKORDERED will be increased.
|
||
|
|
* Result is always "PASS" to a request to backorder.
|
||
|
|
* "PHYSICAL" quantity remains unaffected.
|
||
|
|
*----
|
||
|
|
GOSUB 2000;*--add to backorder quantity
|
||
|
|
CASE ACTION="DELETE.BACKORDER"
|
||
|
|
*----
|
||
|
|
* This is a request to reduce quantity on backorder. Quantity should
|
||
|
|
* always be a positive number. INV$QTY.BACKORDERED will be reduced.
|
||
|
|
* Result is always "PASS" to a request to delete a backorder.
|
||
|
|
* "PHYSICAL" quantity remains unaffected.
|
||
|
|
*----
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 2000;*--reduce backorder quantity
|
||
|
|
CASE ACTION="RELEASE.BACKORDER"
|
||
|
|
*----
|
||
|
|
* This indicates backorder is being released to ship. Quantity should
|
||
|
|
* always be a positive number. Both INV$QTY.AVAILABLE and
|
||
|
|
* INV$QTY.BACKORDERED will be reduced.
|
||
|
|
* "PHYSICAL" quantity remains unaffected.
|
||
|
|
*----
|
||
|
|
IF INXFLAG THEN GOSUB 6000;*--inexhaustible supply
|
||
|
|
IF ASMFLAG THEN GOSUB 7000;*--assembled item
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 1000;*--reduce quantity available
|
||
|
|
IF NOT(REJECT) THEN GOSUB 2000;*--reduce backorder quantity
|
||
|
|
CASE ACTION="ASSEMBLE"
|
||
|
|
*----
|
||
|
|
* This is a request to assemble a specified quantity of an item
|
||
|
|
* from its component parts. A "PASS" result indicates a reduction
|
||
|
|
* to "PHYSICAL" and "AVAILABLE" quantity for each of the component
|
||
|
|
* items and an offsetting increase to the assembled item itself.
|
||
|
|
* A "FAIL" result indicates at least one of the component items
|
||
|
|
* was on backorder or had insufficient supply to fulfill request.
|
||
|
|
*----
|
||
|
|
GOSUB 7000
|
||
|
|
CASE ACTION="PO.ADD"
|
||
|
|
*----
|
||
|
|
* This is a request to add to the ON ORDER quantity of an item.
|
||
|
|
* Sub-valued data relevant to PO within WHSE will be updated.
|
||
|
|
* All other quantity fields will be unaffected.
|
||
|
|
*----
|
||
|
|
GOSUB 8000
|
||
|
|
CASE ACTION="PO.DELETE"
|
||
|
|
*----
|
||
|
|
* This action will do exactly the same as above except the quantity
|
||
|
|
* will be subtracted from the ON ORDER number for this PO
|
||
|
|
*----
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 8000
|
||
|
|
CASE ACTION="PO.RECEIVE"
|
||
|
|
*----
|
||
|
|
* This action is similar to PO.DELETE accept that ETA will not be
|
||
|
|
* updated.
|
||
|
|
*----
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 9000
|
||
|
|
CASE ACTION="COST.UPDATE"
|
||
|
|
*----
|
||
|
|
* This action signifies an update to the INV.COST file which is
|
||
|
|
* used to calculate unit cost. No quantity fields on the inventory
|
||
|
|
* record are updated
|
||
|
|
*----
|
||
|
|
GOSUB 10000
|
||
|
|
CASE ACTION="RETURN.GOOD"
|
||
|
|
CASE ACTION="RETURN.DAMAGED"
|
||
|
|
CASE ACTION="RETURN.DEFECTIVE"
|
||
|
|
CASE ACTION="SLS"
|
||
|
|
*----
|
||
|
|
* This is a request to record the actual shipment of product to a
|
||
|
|
* customer. INV$QTY.REDUCTIONS will be increased, and appropriate
|
||
|
|
* entries will be recorded in INV.TRANS and INV.ACTIVITY files to
|
||
|
|
* reflect change in "PHYSICAL" quantity.
|
||
|
|
* INV$QTY.AVAILABLE is unaffected by this action.
|
||
|
|
*----
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
GOSUB 3000;*--create transaction
|
||
|
|
GOSUB 4000;*--reduce physical quantity
|
||
|
|
GOSUB 5000;*--update activity (summary)
|
||
|
|
CASE ACTION="TRF"
|
||
|
|
*----
|
||
|
|
* This is a request to transfer quantity from one warehouse to
|
||
|
|
* another. It requires that the quantity to be transferred MUST
|
||
|
|
* be available in the FROM warehouse. No attempt is made to
|
||
|
|
* assemble sufficient quantity or to add quantity due to the
|
||
|
|
* inexhaustibility of the item being transferred.
|
||
|
|
* A quantity adjustment will be made to 2 (two) warehouses.
|
||
|
|
* Both "PHYSICAL" and "AVAILABLE" quantity will be updated.
|
||
|
|
*----
|
||
|
|
GOSUB 1000;*--reduce available quantity - FROM warehouse
|
||
|
|
IF NOT(REJECT) THEN GOSUB 3000;*--create transaction - FROM warehouse
|
||
|
|
IF NOT(REJECT) THEN GOSUB 4000;*--reduce physical - FROM warehouse
|
||
|
|
IF NOT(REJECT) THEN GOSUB 5000;*--update activity - FROM warehouse
|
||
|
|
WHSE=TLOC
|
||
|
|
AKEY=YEAR:"|":WHSE:"|":ITEM
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
IF NOT(REJECT) THEN GOSUB 1000;*--increase available - TO warehouse
|
||
|
|
IF NOT(REJECT) THEN GOSUB 3000;*--create transaction - TO warehouse
|
||
|
|
IF NOT(REJECT) THEN GOSUB 4000;*--increase physical - TO warehouse
|
||
|
|
IF NOT(REJECT) THEN GOSUB 5000;*--update activity - TO warehouse
|
||
|
|
CASE 1
|
||
|
|
*----
|
||
|
|
* All other actions are valid inventory transactions which
|
||
|
|
* will affect both the physical and available quantities.
|
||
|
|
*----
|
||
|
|
IF QTY < 0 AND INXFLAG THEN GOSUB 6000 ;*--inexhaustible supply
|
||
|
|
GOSUB 1000;*--update available quantity
|
||
|
|
IF NOT(REJECT) THEN GOSUB 3000;*--create transaction
|
||
|
|
IF NOT(REJECT) THEN GOSUB 4000;*--update physical quantity
|
||
|
|
IF NOT(REJECT) THEN GOSUB 5000;*--update activity (summary)
|
||
|
|
END CASE
|
||
|
|
GO 100000 ;*--end of program
|
||
|
|
*---------------------------------------------------------------------
|
||
|
|
*
|
||
|
|
1000 *---update inventory quantity available
|
||
|
|
READU IREC FROM INVENTORY,ITEM THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;"AR") ELSE
|
||
|
|
IREC=INSERT(IREC,INV$WAREHOUSE,FND;WHSE)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.INCREASES,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.REDUCTIONS,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.AVAILABLE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.BACKORDERED,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.ON.ORDER,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$EST.TIME.ARRIVAL,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PO.NUMBER,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ACTIVITY.YEARS,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$LEAD.TIME,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$REORDER.POINT,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$SAFETY.STOCK,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$EST.MONTHLY.USAGE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$PROJECTED.OS.DATE,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PRIMARY.LOCATION,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION1,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION2,FND;"")
|
||
|
|
END
|
||
|
|
IF QTY < 0 THEN
|
||
|
|
LOCATE(ACTION,TYPE.CODES,1;IDX) ELSE
|
||
|
|
IF IREC<INV$QTY.AVAILABLE,FND> >= ABS(QTY) ELSE
|
||
|
|
REJECT=TRUE;*--insufficient quantity to fulfill request
|
||
|
|
REJECT.REASON=9
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
QOB=IREC<INV$QTY.BACKORDERED,FND>
|
||
|
|
IF QOB > 0 AND ACTION#"RELEASE.BACKORDER" THEN
|
||
|
|
REJECT=TRUE;*--waiting backorders take priority over new orders
|
||
|
|
REJECT.REASON=10
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
IREC<INV$QTY.AVAILABLE,FND>=IREC<INV$QTY.AVAILABLE,FND>+QTY
|
||
|
|
IF ACTION="CHECK.AVAILABLE" ELSE
|
||
|
|
*--do not WRITE if only checking availability
|
||
|
|
IF IREC<INV$QTY.AVAILABLE,FND> < 0 THEN
|
||
|
|
CRT @(0,22):CL:BEEP:"Warning! Quantity available for ":ITEM:" is negative - <return>":
|
||
|
|
*ANY=""; INPUT ANY
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"-A"
|
||
|
|
END ELSE
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"A"
|
||
|
|
END
|
||
|
|
WRITE IREC ON INVENTORY,ITEM
|
||
|
|
IF ACTION="COMMIT" OR ACTION="UNCOMMIT" THEN
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"U"
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
2000 *---update backorder quantity (INVENTORY)
|
||
|
|
READU IREC FROM INVENTORY,ITEM THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;"AR") THEN
|
||
|
|
IREC<INV$QTY.BACKORDERED,FND>=IREC<INV$QTY.BACKORDERED,FND>+QTY
|
||
|
|
END ELSE
|
||
|
|
IREC=INSERT(IREC,INV$WAREHOUSE,FND;WHSE)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.INCREASES,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.REDUCTIONS,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.AVAILABLE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.BACKORDERED,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.ON.ORDER,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$EST.TIME.ARRIVAL,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PO.NUMBER,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ACTIVITY.YEARS,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$LEAD.TIME,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$REORDER.POINT,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$SAFETY.STOCK,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$EST.MONTHLY.USAGE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$PROJECTED.OS.DATE,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PRIMARY.LOCATION,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION1,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION2,FND;"")
|
||
|
|
IREC<INV$QTY.BACKORDERED,FND>=QTY
|
||
|
|
END
|
||
|
|
IF IREC<INV$QTY.BACKORDERED,FND> < 0 THEN
|
||
|
|
CRT @(0,22):CL:BEEP:"Warning! Quantity backordered for ":ITEM:" is negative - <return>":
|
||
|
|
*ANY=""; INPUT ANY
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"-B"
|
||
|
|
END ELSE
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"B"
|
||
|
|
END
|
||
|
|
WRITE IREC ON INVENTORY,ITEM
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
3000 *---update inventory transactions (INV.TRANS)
|
||
|
|
READU TREC FROM INV.TRANS,TKEY THEN
|
||
|
|
BEGIN CASE
|
||
|
|
CASE TYPE='SLS'
|
||
|
|
LOCATE(TYPWHS,TREC,IVT$SORT.KEY;WH) THEN
|
||
|
|
TREC<IVT$QUANTITY,WH>=TREC<IVT$QUANTITY,WH>+QTY
|
||
|
|
TREC<IVT$TIME,WH>=TIME()
|
||
|
|
END ELSE
|
||
|
|
GOSUB 3100
|
||
|
|
END
|
||
|
|
CASE TYPE='RTS'
|
||
|
|
LOCATE(TYPWHS,TREC,IVT$SORT.KEY;WH) THEN
|
||
|
|
IF TREC<IVT$DATE,WH>=TDATE THEN
|
||
|
|
TREC<IVT$QUANTITY,WH>=TREC<IVT$QUANTITY,WH>+QTY
|
||
|
|
TREC<IVT$TIME,WH>=TIME()
|
||
|
|
END ELSE
|
||
|
|
GOSUB 3100
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
GOSUB 3100
|
||
|
|
END
|
||
|
|
CASE TYPE='INX'
|
||
|
|
LOCATE(TYPWHS,TREC,IVT$SORT.KEY;WH) THEN
|
||
|
|
TREC<IVT$QUANTITY,WH>=TREC<IVT$QUANTITY,WH>+QTY
|
||
|
|
TREC<IVT$TIME,WH>=TIME()
|
||
|
|
END ELSE
|
||
|
|
GOSUB 3100
|
||
|
|
END
|
||
|
|
CASE TYPE='ASM'
|
||
|
|
FOUND=FALSE
|
||
|
|
LOCATE(TYPWHS,TREC,IVT$SORT.KEY;WH) THEN
|
||
|
|
LOOP
|
||
|
|
UNTIL TREC<IVT$SORT.KEY,WH>#TYPWHS OR FOUND DO
|
||
|
|
IF TREC<IVT$COMMENT,WH>=CMNT THEN
|
||
|
|
TREC<IVT$QUANTITY,WH>=TREC<IVT$QUANTITY,WH>+QTY
|
||
|
|
TREC<IVT$TIME,WH>=TIME()
|
||
|
|
FOUND=TRUE
|
||
|
|
END
|
||
|
|
WH=WH+1
|
||
|
|
REPEAT
|
||
|
|
IF NOT(FOUND) THEN GOSUB 3100
|
||
|
|
END ELSE
|
||
|
|
GOSUB 3100
|
||
|
|
END
|
||
|
|
CASE 1
|
||
|
|
GOSUB 3100
|
||
|
|
END CASE
|
||
|
|
END ELSE
|
||
|
|
TREC<IVT$TYPE>=TYPE
|
||
|
|
TREC<IVT$QUANTITY>=QTY
|
||
|
|
TREC<IVT$DATE>=TDATE
|
||
|
|
TREC<IVT$TIME>=TIME()
|
||
|
|
TREC<IVT$OPERATOR>=USER
|
||
|
|
TREC<IVT$REFERENCE.NUMBER>=TREF
|
||
|
|
TREC<IVT$FROM.LOCATION>=FLOC
|
||
|
|
TREC<IVT$TO.LOCATION>=TLOC
|
||
|
|
TREC<IVT$COMMENT>=CMNT
|
||
|
|
TREC<IVT$ENTRY.DATE>=ENTRY.DATE
|
||
|
|
TREC<IVT$SORT.KEY>=TYPWHS
|
||
|
|
END
|
||
|
|
WRITE TREC ON INV.TRANS,TKEY
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
3100 *----insert new transaction----
|
||
|
|
LOCATE(TDATE,TREC,IVT$DATE;WH;'DR') THEN NULL
|
||
|
|
TREC=INSERT(TREC,IVT$TYPE,WH;TYPE)
|
||
|
|
TREC=INSERT(TREC,IVT$QUANTITY,WH;QTY)
|
||
|
|
TREC=INSERT(TREC,IVT$DATE,WH;TDATE)
|
||
|
|
TREC=INSERT(TREC,IVT$TIME,WH;TIME())
|
||
|
|
TREC=INSERT(TREC,IVT$OPERATOR,WH;USER)
|
||
|
|
TREC=INSERT(TREC,IVT$REFERENCE.NUMBER,WH;TREF)
|
||
|
|
TREC=INSERT(TREC,IVT$FROM.LOCATION,WH;FLOC)
|
||
|
|
TREC=INSERT(TREC,IVT$TO.LOCATION,WH;TLOC)
|
||
|
|
TREC=INSERT(TREC,IVT$COMMENT,WH;CMNT)
|
||
|
|
TREC=INSERT(TREC,IVT$ENTRY.DATE,WH;ENTRY.DATE)
|
||
|
|
TREC=INSERT(TREC,IVT$SORT.KEY,WH;TYPWHS)
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
4000 *---update shelf quantity (INVENTORY)
|
||
|
|
IF QTY > 0 THEN
|
||
|
|
IATTR=INV$QTY.INCREASES
|
||
|
|
END ELSE
|
||
|
|
IATTR=INV$QTY.REDUCTIONS
|
||
|
|
END
|
||
|
|
READU IREC FROM INVENTORY,IKEY THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;'AR') THEN
|
||
|
|
IREC<IATTR,FND>=IREC<IATTR,FND>+ABS(QTY)
|
||
|
|
LOCATE(YEAR,IREC,INV$ACTIVITY.YEARS,FND;WH;'DR') ELSE
|
||
|
|
IREC=INSERT(IREC,INV$ACTIVITY.YEARS,FND,WH;YEAR)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IREC=INSERT(IREC,INV$WAREHOUSE,FND;WHSE)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.INCREASES,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.REDUCTIONS,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.AVAILABLE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.BACKORDERED,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.ON.ORDER,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$EST.TIME.ARRIVAL,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PO.NUMBER,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ACTIVITY.YEARS,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$LEAD.TIME,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$REORDER.POINT,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$SAFETY.STOCK,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$EST.MONTHLY.USAGE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$PROJECTED.OS.DATE,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PRIMARY.LOCATION,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION1,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION2,FND;"")
|
||
|
|
IREC<IATTR,FND>=ABS(QTY)
|
||
|
|
END
|
||
|
|
PHYSICAL=IREC<INV$QTY.INCREASES,FND>-IREC<INV$QTY.REDUCTIONS,FND>
|
||
|
|
IF PHYSICAL < 0 THEN
|
||
|
|
CRT @(0,22):CL:BEEP:"Warning! Physical quantity for ":ITEM:" is negative - <return>":
|
||
|
|
*ANY=""; INPUT ANY
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"-P"
|
||
|
|
END ELSE
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"P"
|
||
|
|
END
|
||
|
|
WRITE IREC ON INVENTORY,IKEY
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
5000 *---update INV.ACTIVITY
|
||
|
|
HOLD.QTY=QTY ;*--save original value because we might change its sign
|
||
|
|
BEGIN CASE
|
||
|
|
CASE TYPE='SLS'
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
ATTR=IA$SALES
|
||
|
|
CASE TYPE='RTS'
|
||
|
|
ATTR=IA$RETURNS
|
||
|
|
CASE QTY > 0
|
||
|
|
ATTR=IA$INCREASES
|
||
|
|
CASE QTY < 0
|
||
|
|
QTY=QTY*MINUS
|
||
|
|
ATTR=IA$REDUCTIONS
|
||
|
|
END CASE
|
||
|
|
READU AREC FROM INV.ACTIVITY,AKEY THEN
|
||
|
|
LOCATE(EFFPD,AREC,IA$PERIOD;WH;'DL') THEN
|
||
|
|
AREC<ATTR,WH>=AREC<ATTR,WH>+QTY
|
||
|
|
END ELSE
|
||
|
|
AREC=INSERT(AREC,IA$PERIOD,WH;EFFPD)
|
||
|
|
AREC=INSERT(AREC,IA$SALES,WH;0)
|
||
|
|
AREC=INSERT(AREC,IA$RETURNS,WH;0)
|
||
|
|
AREC=INSERT(AREC,IA$INCREASES,WH;0)
|
||
|
|
AREC=INSERT(AREC,IA$REDUCTIONS,WH;0)
|
||
|
|
AREC<ATTR,WH>=AREC<ATTR,WH>+QTY
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
GOSUB 5100 ;*--determine beginning qty
|
||
|
|
AREC<IA$PERIOD>=EFFPD
|
||
|
|
AREC<IA$BEGIN.QTY>=BEGQTY
|
||
|
|
AREC<IA$SALES>=0
|
||
|
|
AREC<IA$RETURNS>=0
|
||
|
|
AREC<IA$INCREASES>=0
|
||
|
|
AREC<IA$REDUCTIONS>=0
|
||
|
|
AREC<ATTR>=AREC<ATTR>+QTY
|
||
|
|
END
|
||
|
|
WRITE AREC ON INV.ACTIVITY,AKEY
|
||
|
|
QTY=HOLD.QTY ;*--restore qty variable to original value
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
5100 *---determine warehouse beginning quantity for new year
|
||
|
|
BEGQTY=0
|
||
|
|
DONE=FALSE
|
||
|
|
CHECK.YEAR=YEAR
|
||
|
|
LOOP
|
||
|
|
UNTIL DONE DO
|
||
|
|
KEY=CHECK.YEAR:"|":WHSE:"|":ITEM
|
||
|
|
READ REC FROM INV.ACTIVITY,KEY THEN
|
||
|
|
BEGQTY=REC<IA$BEGIN.QTY>-SUM(REC<IA$SALES>)+SUM(REC<IA$RETURNS>)+SUM(REC<IA$INCREASES>)-SUM(REC<IA$REDUCTIONS>)
|
||
|
|
DONE=TRUE
|
||
|
|
END ELSE
|
||
|
|
IF CHECK.YEAR > 1970 THEN
|
||
|
|
CHECK.YEAR=CHECK.YEAR-1
|
||
|
|
END ELSE
|
||
|
|
BEGQTY=0
|
||
|
|
DONE=TRUE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
REPEAT
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
6000 *--inexhaustible supply update
|
||
|
|
READU IREC FROM INVENTORY,ITEM THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;"AR") THEN
|
||
|
|
QOH=IREC<INV$QTY.AVAILABLE,FND>
|
||
|
|
END ELSE
|
||
|
|
QOH=0
|
||
|
|
END
|
||
|
|
IF QTY > 0 THEN
|
||
|
|
QOH=QOH-QTY
|
||
|
|
END ELSE
|
||
|
|
QOH=QOH+QTY
|
||
|
|
END
|
||
|
|
IF QOH < 0 THEN
|
||
|
|
QTY.NEEDED=ABS(QOH)
|
||
|
|
PASS.DATA=IMA.DATA
|
||
|
|
PASS.DATA<IMA$FUNCTION>="INX"
|
||
|
|
PASS.DATA<IMA$QUANTITY>=QTY.NEEDED
|
||
|
|
PASS.DATA<IMA$COMMENT>="Automatic Supply Increase"
|
||
|
|
CALL CMSD.INV.MASTER(PASS.DATA) ;*--recursive call
|
||
|
|
END
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
7000 *--assembled item update
|
||
|
|
READU IREC FROM INVENTORY,ITEM THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;"AR") THEN
|
||
|
|
QOH=IREC<INV$QTY.AVAILABLE,FND>
|
||
|
|
END ELSE
|
||
|
|
QOH=0
|
||
|
|
END
|
||
|
|
*----
|
||
|
|
* The following lines of code are designed to insure the correct
|
||
|
|
* quantity is assembled. If action is ASSEMBLE then we are talking
|
||
|
|
* about the manual process (from CMSD.ASSEMBLE.ITEMS) otherwise
|
||
|
|
* we are simply doing an ASM transaction for the difference
|
||
|
|
* between what is already available and what has been requested.
|
||
|
|
*----
|
||
|
|
IF ACTION="ASSEMBLE" THEN
|
||
|
|
QOH=0
|
||
|
|
END
|
||
|
|
QOH=QOH-QTY
|
||
|
|
IF QOH < 0 THEN
|
||
|
|
QTY.NEEDED=ABS(QOH)
|
||
|
|
MAX.AVAIL=999999999999
|
||
|
|
CCT=DCOUNT(IREC<INV$COMPONENT.ITEMS>,VM)
|
||
|
|
FOR C=1 TO CCT UNTIL MAX.AVAIL=0
|
||
|
|
CKEY=IREC<INV$COMPONENT.ITEMS,C>
|
||
|
|
CQTY=IREC<INV$COMPONENT.QTY,C>
|
||
|
|
READU CREC FROM INVENTORY,CKEY THEN
|
||
|
|
IF CREC<INV$ASSEMBLED>="Y" THEN MAX.AVAIL=0
|
||
|
|
IF CREC<INV$ORDER.CODE>#"N" THEN
|
||
|
|
LOCATE(WHSE,CREC,INV$WAREHOUSE;FND;"AR") THEN
|
||
|
|
MAX.QTY=INT(CREC<INV$QTY.AVAILABLE,FND>/CQTY)
|
||
|
|
IF MAX.QTY < MAX.AVAIL THEN MAX.AVAIL=MAX.QTY
|
||
|
|
END ELSE
|
||
|
|
MAX.AVAIL=0
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
MAX.AVAIL=0
|
||
|
|
END
|
||
|
|
NEXT C
|
||
|
|
IF ACTION="CHECK.AVAILABLE" THEN
|
||
|
|
*--no updates will be performed
|
||
|
|
FOR C=1 TO CCT
|
||
|
|
*--release component items which have been locked
|
||
|
|
RELEASE INVENTORY,IREC<INV$COMPONENT.ITEMS,C>
|
||
|
|
NEXT C
|
||
|
|
IF MAX.AVAIL < QTY.NEEDED THEN REJECT=1
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
IF MAX.AVAIL >= QTY.NEEDED THEN
|
||
|
|
PASS.DATA=IMA.DATA
|
||
|
|
PASS.DATA<IMA$FUNCTION>="ASM"
|
||
|
|
PASS.DATA<IMA$COMMENT>="Assembled into ":ITEM
|
||
|
|
FOR C=1 TO CCT
|
||
|
|
*----
|
||
|
|
* Loop through component items and call CMSD.INV.MASTER
|
||
|
|
* to perform updates to inventory. As items remain locked
|
||
|
|
* (preventing any updates) as a result of above evaluation,
|
||
|
|
* and sufficient quantity has already been verified,
|
||
|
|
* PASS.DATA will always return a "PASS" result back to this
|
||
|
|
* program so IMA$RESULT does not need to be checked.
|
||
|
|
* SPECIAL NOTE!!! This is a recursive call of a program
|
||
|
|
* from within itself. Exercise EXTREME CAUTION when changing!
|
||
|
|
*----
|
||
|
|
CITEM=IREC<INV$COMPONENT.ITEMS,C>
|
||
|
|
CQTY=IREC<INV$COMPONENT.QTY,C>
|
||
|
|
PASS.DATA<IMA$ITEM>=CITEM
|
||
|
|
PASS.DATA<IMA$QUANTITY>=QTY.NEEDED*CQTY*MINUS
|
||
|
|
CALL CMSD.INV.MASTER(PASS.DATA) ;*--recursive call
|
||
|
|
NEXT C
|
||
|
|
PASS.DATA=IMA.DATA
|
||
|
|
PASS.DATA<IMA$FUNCTION>="ASM.ADD"
|
||
|
|
PASS.DATA<IMA$QUANTITY>=QTY.NEEDED
|
||
|
|
PASS.DATA<IMA$COMMENT>="Assembled from Components"
|
||
|
|
CALL CMSD.INV.MASTER(PASS.DATA) ;*--recursive call
|
||
|
|
END ELSE
|
||
|
|
FOR C=1 TO CCT
|
||
|
|
*--release component items which have been locked
|
||
|
|
RELEASE INVENTORY,IREC<INV$COMPONENT.ITEMS,C>
|
||
|
|
NEXT C
|
||
|
|
REJECT=TRUE;*--cannot assemble enough to fulfill request
|
||
|
|
REJECT.REASON=11
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
*----
|
||
|
|
* there is no need to assemble any items - sufficient
|
||
|
|
* quantity is already available
|
||
|
|
*----
|
||
|
|
END
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
8000 *--update PO related fields (PO.ADD & PO.DELETE)
|
||
|
|
READU IREC FROM INVENTORY,ITEM THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;'AR') THEN
|
||
|
|
LOCATE(TREF,IREC,INV$PO.NUMBER,FND;WH;'AR') THEN
|
||
|
|
IREC<INV$QTY.ON.ORDER,FND,WH>=IREC<INV$QTY.ON.ORDER,FND,WH>+QTY
|
||
|
|
IREC<INV$EST.TIME.ARRIVAL,FND,WH>=TDATE
|
||
|
|
*--verify ON ORDER is not zero else delete
|
||
|
|
IF IREC<INV$QTY.ON.ORDER,FND,WH>=0 THEN
|
||
|
|
IREC=DELETE(IREC,INV$PO.NUMBER,FND,WH)
|
||
|
|
IREC=DELETE(IREC,INV$QTY.ON.ORDER,FND,WH)
|
||
|
|
IREC=DELETE(IREC,INV$EST.TIME.ARRIVAL,FND,WH)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IREC=INSERT(IREC,INV$PO.NUMBER,FND,WH;TREF)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.ON.ORDER,FND,WH;QTY)
|
||
|
|
IREC=INSERT(IREC,INV$EST.TIME.ARRIVAL,FND,WH;TDATE)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IREC=INSERT(IREC,INV$WAREHOUSE,FND;WHSE)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.INCREASES,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.REDUCTIONS,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.AVAILABLE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.BACKORDERED,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$QTY.ON.ORDER,FND;QTY)
|
||
|
|
IREC=INSERT(IREC,INV$EST.TIME.ARRIVAL,FND;TDATE)
|
||
|
|
IREC=INSERT(IREC,INV$PO.NUMBER,FND;TREF)
|
||
|
|
IREC=INSERT(IREC,INV$ACTIVITY.YEARS,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$LEAD.TIME,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$REORDER.POINT,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$SAFETY.STOCK,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$EST.MONTHLY.USAGE,FND;0)
|
||
|
|
IREC=INSERT(IREC,INV$PROJECTED.OS.DATE,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$PRIMARY.LOCATION,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION1,FND;"")
|
||
|
|
IREC=INSERT(IREC,INV$ALTERNATE.LOCATION2,FND;"")
|
||
|
|
END
|
||
|
|
WRITE IREC ON INVENTORY,ITEM
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"O"
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
9000 *--update PO related fields (PO.RECEIVE)
|
||
|
|
READU IREC FROM INVENTORY,ITEM THEN
|
||
|
|
LOCATE(WHSE,IREC,INV$WAREHOUSE;FND;'AR') THEN
|
||
|
|
LOCATE(TREF,IREC,INV$PO.NUMBER,FND;WH;'AR') THEN
|
||
|
|
IREC<INV$QTY.ON.ORDER,FND,WH>=IREC<INV$QTY.ON.ORDER,FND,WH>+QTY
|
||
|
|
* Verify ON ORDER is greater than zero else delete
|
||
|
|
* NOTE: PO.RECEIVE of more than ordered quantity (overruns)
|
||
|
|
* will leave nothing on order for specified PO.
|
||
|
|
*----
|
||
|
|
IF IREC<INV$QTY.ON.ORDER,FND,WH> LE 0 THEN
|
||
|
|
IREC=DELETE(IREC,INV$PO.NUMBER,FND,WH)
|
||
|
|
IREC=DELETE(IREC,INV$QTY.ON.ORDER,FND,WH)
|
||
|
|
IREC=DELETE(IREC,INV$EST.TIME.ARRIVAL,FND,WH)
|
||
|
|
END
|
||
|
|
WRITE IREC ON INVENTORY,ITEM
|
||
|
|
CHANGED.FIELDS=CHANGED.FIELDS:"O"
|
||
|
|
END ELSE
|
||
|
|
*--nothing on order so nothing to do
|
||
|
|
REJECT=TRUE
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
*--nothing on order so nothing to do
|
||
|
|
REJECT=TRUE
|
||
|
|
END
|
||
|
|
END
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
10000 *--update INV.COST record
|
||
|
|
COST=FIELD(CMNT,"|",2)
|
||
|
|
SOURCE=FIELD(CMNT,"|",1)
|
||
|
|
CKEY=WHSE:"|":ITEM
|
||
|
|
CREC=""
|
||
|
|
READU CREC FROM INV.COST,CKEY THEN
|
||
|
|
IF CREC<IC$UNIT.COST,1>=COST THEN
|
||
|
|
CREC<IC$DATE.RECEIVED,1>=TDATE
|
||
|
|
CREC<IC$QTY.RECEIVED,1>=CREC<IC$QTY.RECEIVED,1>+QTY
|
||
|
|
CREC<IC$SOURCE,1>=SOURCE
|
||
|
|
CREC<IC$REFERENCE,1>=TREF
|
||
|
|
END ELSE
|
||
|
|
CREC=INSERT(CREC,IC$DATE.RECEIVED,1;TDATE)
|
||
|
|
CREC=INSERT(CREC,IC$QTY.RECEIVED,1;QTY)
|
||
|
|
CREC=INSERT(CREC,IC$UNIT.COST,1;COST)
|
||
|
|
CREC=INSERT(CREC,IC$SOURCE,1;SOURCE)
|
||
|
|
CREC=INSERT(CREC,IC$REFERENCE,1;TREF)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
CREC<IC$DATE.RECEIVED>=TDATE
|
||
|
|
CREC<IC$QTY.RECEIVED>=QTY
|
||
|
|
CREC<IC$UNIT.COST>=COST
|
||
|
|
CREC<IC$SOURCE>=SOURCE
|
||
|
|
CREC<IC$REFERENCE>=TREF
|
||
|
|
END
|
||
|
|
WRITE CREC ON INV.COST,CKEY
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
100000 *--return to calling program
|
||
|
|
IF REJECT THEN
|
||
|
|
IMA.DATA<IMA$RESULT>="FAIL"
|
||
|
|
END ELSE
|
||
|
|
IMA.DATA<IMA$RESULT>="PASS"
|
||
|
|
END
|
||
|
|
IMA.DATA<IMA$PROCESS.DATE>=DATE()
|
||
|
|
IMA.DATA<IMA$PROCESS.TIME>=TIME()
|
||
|
|
IMA.DATA<IMA$FAIL.REASON>=REJECT.REASON
|
||
|
|
IMA.DATA<IMA$CHANGES>=CHANGED.FIELDS
|
||
|
|
WRITE IMA.DATA ON INV.JOURNAL,NEXT.JRNL
|
||
|
|
RELEASE INVENTORY,IMA.DATA<IMA$ITEM>
|
||
|
|
RETURN
|