404 lines
14 KiB
Plaintext
404 lines
14 KiB
Plaintext
|
*--------------------------------------------------------------------
|
||
|
|
*PGM NAME: CMSD.PICKING
|
||
|
|
*PURPOSE: PICKING SLIP QUALIFY ROUTINE FOR REL8
|
||
|
|
*AUTHOR: BARKSDALE
|
||
|
|
*CREATED: 01-06-93
|
||
|
|
*UPDATES:
|
||
|
|
*
|
||
|
|
*08/21/95 - DJL - :Changed logic so GEN KEYS "ORDER.RUN" will not be
|
||
|
|
* update when there are no records selected to print
|
||
|
|
* also no SHIPPER.INDEX file will be created.
|
||
|
|
*--------------------------------------------------------------------
|
||
|
|
$INCLUDE GEN.COMMON
|
||
|
|
$INCLUDE PM
|
||
|
|
$INCLUDE CMSD.IVD
|
||
|
|
*
|
||
|
|
OPEN 'PM' TO PM ELSE ABORT
|
||
|
|
OPEN 'PM.TRANS' TO PM.TRANS ELSE ABORT
|
||
|
|
OPEN 'PM.ORDERS' TO PMO ELSE ABORT
|
||
|
|
OPEN 'PM.ORDERS.INDEX.RELEASED' TO RINDEX ELSE ABORT
|
||
|
|
OPEN 'PM.LABELS' TO PM.LABELS ELSE ABORT
|
||
|
|
OPEN 'INVENTORY' TO INVENTORY ELSE ABORT
|
||
|
|
OPEN 'GEN.KEYS' TO GEN.KEYS ELSE ABORT
|
||
|
|
OPEN 'PT' TO PT ELSE ABORT
|
||
|
|
OPEN 'CM' TO CM ELSE ABORT
|
||
|
|
OPEN 'BATCH.XREF' TO BATCH.XREF ELSE ABORT
|
||
|
|
OPEN 'BA' TO BA ELSE ABORT
|
||
|
|
*
|
||
|
|
CHECK.FILE.FLAG=1
|
||
|
|
CALL SYSTEM.SETUP
|
||
|
|
MAX.SHIPMENTS=SYSTEM.SETUP<39>
|
||
|
|
*
|
||
|
|
PORT=FIELD(ICONV('','U50BB'),' ',1)
|
||
|
|
READV USER FROM PT,PORT,1 ELSE USER='19999'
|
||
|
|
*
|
||
|
|
5 *
|
||
|
|
READU DUMMY FROM GEN.KEYS,"DUMMY.VAR" LOCKED
|
||
|
|
OTHER.PORT=STATUS()
|
||
|
|
READV OTHER.USER FROM PT,OTHER.PORT,1 ELSE OTHER.USER='19999'
|
||
|
|
READ CMREC FROM CM,OTHER.USER ELSE CMREC='unknown user'
|
||
|
|
OTHER.NAME=TRIM(CMREC<1>:" ":CMREC<2>)
|
||
|
|
CRT CS
|
||
|
|
CRT @(0,0):RV:" CMSD.PICKING PICKING SHEET PRINT PROCESSOR":SPACE(10):TIMEDATE():" ":ERV
|
||
|
|
CRT BEEP
|
||
|
|
CRT 'This program is currently being run by ':RV:OTHER.NAME:ERV:'. Only one instance may'
|
||
|
|
CRT 'run at any time. When the other user has finished, Press any key to continue:':
|
||
|
|
ANY='' ; INPUT ANY,1 ; IF ANY=PF3 THEN STOP ELSE GO 5
|
||
|
|
END ELSE NULL
|
||
|
|
*
|
||
|
|
POS=0; MSG=''
|
||
|
|
MSG=MSG:@(POS,3):CR:"Enter " ; POS=POS+6
|
||
|
|
MSG=MSG:@(POS,3):RV:"B":ERV:"atch, " ; POS=POS+7
|
||
|
|
MSG=MSG:@(POS,3):RV:"A":ERV:"ll unprinted, " ; POS=POS+15
|
||
|
|
MSG=MSG:@(POS,3):RV:"I":ERV:"ndividual, " ; POS=POS+12
|
||
|
|
MSG=MSG:@(POS,3):RV:"F":ERV:"orce Item, " ; POS=POS+12
|
||
|
|
MSG=MSG:@(POS,3):RV:"R":ERV:"eprint or " ; POS=POS+11
|
||
|
|
MSG=MSG:@(POS,3):"Re":RV:"G":ERV:"enerate-->"
|
||
|
|
*
|
||
|
|
10 *
|
||
|
|
CRT CS
|
||
|
|
CRT @(0,0):RV:" CMSD.PICKING PICKING SHEET PRINT PROCESSOR":SPACE(10):TIMEDATE():" ":ERV:
|
||
|
|
CRT MSG:
|
||
|
|
ANSWER=''; INPUT ANSWER
|
||
|
|
IF CHECK.FILE.FLAG THEN
|
||
|
|
IF ANSWER="R" OR ANSWER="A" THEN GOSUB 3000
|
||
|
|
END
|
||
|
|
IF ANSWER='' OR ANSWER='/' THEN STOP
|
||
|
|
11 *
|
||
|
|
IF ANSWER#'R' AND ANSWER#'G' AND ANSWER#'' AND ANSWER#'/' THEN
|
||
|
|
READU RUN.NUMBER FROM GEN.KEYS,"ORDER.RUN" ELSE
|
||
|
|
CRT 'ORDER.RUN not found in the GEN.KEYS file'; RQM; STOP
|
||
|
|
END
|
||
|
|
RUN.NUMBER=RUN.NUMBER+1
|
||
|
|
WRITE RUN.NUMBER ON GEN.KEYS,"ORDER.RUN"
|
||
|
|
CURRENT.RUN=DATE():"*":RUN.NUMBER
|
||
|
|
REPRINT.FLAG=0
|
||
|
|
FILENAME="SHIPPER.INDEX,":CURRENT.RUN
|
||
|
|
OPEN FILENAME TO SINDEX ELSE
|
||
|
|
EXECUTE "CREATE-FILE DATA ":FILENAME:" 17" CAPTURING JUNK
|
||
|
|
OPEN FILENAME TO SINDEX ELSE ABORT
|
||
|
|
END
|
||
|
|
END
|
||
|
|
*
|
||
|
|
15 *
|
||
|
|
BEGIN CASE
|
||
|
|
CASE ANSWER='B'
|
||
|
|
RUN='N'
|
||
|
|
CRT @(0,5):"Enter Batch Date to be printed-->":
|
||
|
|
BATCH.DATE=''; INPUT BATCH.DATE
|
||
|
|
BATCH.DATE=ICONV(BATCH.DATE,"D")
|
||
|
|
BDATE=OCONV(BATCH.DATE,"D2/")
|
||
|
|
READ XREF.REC FROM BATCH.XREF,BATCH.DATE ELSE
|
||
|
|
CRT @(0,22):"Invalid batch date was entered!!"; RQM; GO 10
|
||
|
|
END
|
||
|
|
CRT @(0,7):"Enter Batch Number to be printed or 'ALL'-->":
|
||
|
|
BATCH.NUMBER=''; INPUT BATCH.NUMBER
|
||
|
|
IF BATCH.NUMBER="ALL" THEN
|
||
|
|
CRT @(0,9):"Selecting orders with items not printed for batch date: ":BDATE:
|
||
|
|
CRT
|
||
|
|
DATA \SSELECT PM.ORDERS WITH BATCH.DATE "\:BDATE:\" AND WITH BSTAT "C" BY ITEM BY ZIP.SORT\
|
||
|
|
EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\
|
||
|
|
END ELSE
|
||
|
|
BATCH.KEY=BATCH.DATE:"*":BATCH.NUMBER
|
||
|
|
READ BA.REC FROM BA,BATCH.KEY ELSE
|
||
|
|
CRT @(0,22):"Invalid batch number was entered!!"; RQM; GO 10
|
||
|
|
END
|
||
|
|
CRT @(0,9):"Selecting orders with items not printed from batch: ":BDATE:"*":BATCH.NUMBER:
|
||
|
|
CRT
|
||
|
|
DATA \SSELECT PM.ORDERS WITH BATCH "\:BATCH.KEY:\" AND WITH BSTAT "C" BY ITEM BY ZIP.SORT \
|
||
|
|
EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\
|
||
|
|
END
|
||
|
|
CASE ANSWER='F'
|
||
|
|
CRT @(0,5):"Enter item number to be force shipped--->":
|
||
|
|
FORCE.ITEM=''; INPUT FORCE.ITEM
|
||
|
|
READ ANY FROM INVENTORY,FORCE.ITEM ELSE
|
||
|
|
CRT @(0,22):BEEP:"Invalid Item Entered! Press <return> and try again...":
|
||
|
|
INPUT DUMMY
|
||
|
|
GO 15
|
||
|
|
END
|
||
|
|
RUN='N'
|
||
|
|
CRT @(0,5):"Selecting Orders with items not printed - please wait....":
|
||
|
|
CRT
|
||
|
|
DATA \SSELECT PM.ORDERS WITH BSTAT "C" BY ITEM BY ZIP.SORT\
|
||
|
|
EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\
|
||
|
|
CASE ANSWER='A'
|
||
|
|
RUN='N'
|
||
|
|
CRT @(0,5):"Selecting Orders with items not printed - please wait....":
|
||
|
|
CRT
|
||
|
|
DATA \SSELECT PM.ORDERS WITH BSTAT "C" BY ITEM BY ZIP.SORT\
|
||
|
|
EXECUTE \SELECT PM.ORDERS.INDEX.RELEASED\
|
||
|
|
CASE ANSWER='I'
|
||
|
|
CRT @(0,5):CR:"Enter Order ## to be printed-->":
|
||
|
|
ORDER=''; INPUT ORDER
|
||
|
|
IF ORDER="" OR ORDER="/" THEN GO 10
|
||
|
|
READ OREC FROM PMO,ORDER ELSE
|
||
|
|
CRT @(0,22):"Invalid Order ## entered"; RQM; GO 10
|
||
|
|
END
|
||
|
|
OCT=DCOUNT(OREC<IVD$ITEM>,VM)
|
||
|
|
FOR O=1 TO OCT
|
||
|
|
CRT @(0,6+O):"ITEM: ":OREC<IVD$ITEM,O>:SPACE(5):"RUN: ":OREC<IVD$LINE.PRINT.ORDER,O>
|
||
|
|
NEXT O
|
||
|
|
CRT @(0,7+O):"Enter Run ##'s for items to reprint, 'N' for new separated by commas":
|
||
|
|
CRT @(15,8+O):"Example: ":RV:"9050*3221,9055*3227,N":ERV:" -->":
|
||
|
|
RUN=''; INPUT RUN
|
||
|
|
EXECUTE \SELECT PM.ORDERS "\:ORDER:\"\
|
||
|
|
CASE ANSWER='G'
|
||
|
|
CRT @(0,5):"Enter Run ## to be regenerated-->":
|
||
|
|
RUN=''; INPUT RUN
|
||
|
|
FILENAME="SHIPPER.INDEX,":RUN
|
||
|
|
OPEN FILENAME TO SINDEX ELSE
|
||
|
|
CRT @(0,22):"Invalid Run ## was entered"; RQM; GO 10
|
||
|
|
END
|
||
|
|
CURRENT.RUN=RUN
|
||
|
|
REPRINT.FLAG=1
|
||
|
|
DATA \SSELECT PM.ORDERS BY ITEM BY ZIP.SORT \
|
||
|
|
EXECUTE \SELECT \:FILENAME
|
||
|
|
CASE ANSWER='R'
|
||
|
|
RUN='' ; ORDER='' ; REC.WRT=0
|
||
|
|
CRT @(0,5):"Enter Run ## to be reprinted--> ":
|
||
|
|
INPUT RUN
|
||
|
|
CRT @(0,7):"Enter ORDER ## to be reprinted or (A)ll for entire run--> ":
|
||
|
|
INPUT ORDER
|
||
|
|
IF ORDER=PF1 OR ORDER=PF3 OR ORDER='' THEN GO 10
|
||
|
|
*
|
||
|
|
CALL CMSD.PICKING.REPRINT(RUN,ORDER,REC.WRT)
|
||
|
|
*
|
||
|
|
IF REC.WRT GT 0 THEN CHAIN "CMSD.PICKING.PRT.CONTROL"
|
||
|
|
GO 10
|
||
|
|
CASE 1
|
||
|
|
GO 20
|
||
|
|
END CASE
|
||
|
|
*
|
||
|
|
EOF=0; NUM.READ=0; NUM.DONE=0; NUM.PRINT=0
|
||
|
|
LOOP
|
||
|
|
READNEXT ID ELSE EOF=1
|
||
|
|
UNTIL EOF DO
|
||
|
|
GOSUB 1000
|
||
|
|
IF REM(NUM.READ,10)=0 THEN GOSUB 2000
|
||
|
|
REPEAT
|
||
|
|
GOSUB 2000
|
||
|
|
CRT @(0,21):"Picking Slip Print Run ## ":RV:" ":CURRENT.RUN:" ":ERV:" is complete"
|
||
|
|
LOOP
|
||
|
|
CRT @(0,22):BEEP:"Note the Run Number above, then enter 'Y' to continue: ":
|
||
|
|
ANY=''; INPUT ANY
|
||
|
|
UNTIL ANY='Y' DO REPEAT
|
||
|
|
20 *
|
||
|
|
IF ANSWER='I' THEN GO 15
|
||
|
|
999 *
|
||
|
|
SELECT SINDEX
|
||
|
|
READNEXT ID ELSE
|
||
|
|
* FILE IS EMPTY - DELETE IT
|
||
|
|
EXECUTE \DELETE-FILE DATA \:FILENAME CAPTURING JUNK
|
||
|
|
END
|
||
|
|
STOP
|
||
|
|
*
|
||
|
|
1000 *---qualify selected orders - build needed arrays for print routine
|
||
|
|
PREC=''; IREC=''; BO.ARRAY=''; REL.ARRAY=''; PRT.ARRAY=''
|
||
|
|
MISC.ARRAY=''; MPRT.ARRAY=''; TOTAL.ORDER=''; AUTH.ARRAY=''
|
||
|
|
RUN.ARRAY=''
|
||
|
|
READU IREC FROM PMO,ID ELSE GO 1100
|
||
|
|
NUM.READ=NUM.READ+1
|
||
|
|
IF ANSWER#'R' AND ANSWER#'G' THEN
|
||
|
|
IF IREC<IVD$STATUS>[1,1]#'A' AND IREC<IVD$STATUS>[1,1]#'C' THEN GO 1100
|
||
|
|
END
|
||
|
|
LOCATE("RET",IREC,IVD$TRACK.ACTION;FNDIT) THEN
|
||
|
|
RET.ORD=1
|
||
|
|
END ELSE
|
||
|
|
RET.ORD=0
|
||
|
|
END
|
||
|
|
TERMS=IREC<IVD$TERMS>
|
||
|
|
BALANCE=IREC<IVD$BALANCE>
|
||
|
|
READ PREC FROM PM,IREC<IVD$PARTNER,1> ELSE
|
||
|
|
OPEN 'CHANGE.PARTNERS' TO CHANGE.PARTNERS THEN
|
||
|
|
READ CHG.REC FROM CHANGE.PARTNERS,IREC<IVD$PARTNER,1> THEN
|
||
|
|
CHG.KEY=CHG.REC<1>
|
||
|
|
READ PREC FROM PM,CHG.KEY ELSE
|
||
|
|
CRT @(0,22):BEEP:"THERE IS A SERIOUS PROBLEM WITH ORDER##:":ID:" <RETURN>":
|
||
|
|
ANY=''; INPUT ANY
|
||
|
|
GO 1100
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
ICT=DCOUNT(IREC<IVD$ITEM>,VM)
|
||
|
|
FOR I=1 TO ICT
|
||
|
|
ITEM=IREC<IVD$ITEM,I>
|
||
|
|
QTY=IREC<IVD$QTY,I>
|
||
|
|
GROSS=IREC<IVD$LINE.GROSS.AMT,I>
|
||
|
|
DISC=IREC<IVD$LINE.DISC.AMOUNT,I>
|
||
|
|
TAX=IREC<IVD$LINE.SALES.TAX.AMT,I>
|
||
|
|
STAT=IREC<IVD$ITEM.STATUS,I>
|
||
|
|
IAUTH=IREC<IVD$LINE.CC.AUTH,I>
|
||
|
|
PRT=IREC<IVD$LINE.PRINT.ORDER,I>
|
||
|
|
LN.NET.AMT=IREC<IVD$LINE.NET.AMOUNT,I>
|
||
|
|
IF PRT # "" THEN
|
||
|
|
LOCATE(PRT,RUN.ARRAY,1;FNDRUN) ELSE
|
||
|
|
RUN.ARRAY=INSERT(RUN.ARRAY,1,FNDRUN;PRT)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
*
|
||
|
|
IF TERMS="CC" AND STAT[1,1]="R" AND IAUTH="" AND LN.NET.AMT#0 THEN
|
||
|
|
ANY=""
|
||
|
|
CRT @(0,20):CR:BEEP:"Order number ":RV:" ":ID:" ":ERV:" is a credit card order and is in an ambiguous state."
|
||
|
|
CRT @(0,21):"Please write down the order number and give to the account manager <RETURN>.":
|
||
|
|
INPUT ANY
|
||
|
|
CRT @(0,20):CR
|
||
|
|
STAT="B"
|
||
|
|
END
|
||
|
|
*
|
||
|
|
BEGIN CASE
|
||
|
|
CASE STAT[1,1]='R' OR STAT[1,1]='G' OR STAT[1,1]='D' OR STAT[1,1]='F'
|
||
|
|
IF PRT="" THEN PRT="N"
|
||
|
|
OKAY=INDEX(RUN,PRT,1)
|
||
|
|
IF OKAY THEN
|
||
|
|
LOCATE(ITEM,REL.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
REL.ARRAY=INSERT(REL.ARRAY,1,NDX;ITEM)
|
||
|
|
REL.ARRAY=INSERT(REL.ARRAY,2,NDX;QTY)
|
||
|
|
REL.ARRAY=INSERT(REL.ARRAY,3,NDX;GROSS)
|
||
|
|
REL.ARRAY=INSERT(REL.ARRAY,4,NDX;DISC)
|
||
|
|
REL.ARRAY=INSERT(REL.ARRAY,5,NDX;TAX)
|
||
|
|
REL.ARRAY=INSERT(REL.ARRAY,6,NDX;STAT)
|
||
|
|
IREC<IVD$LINE.PRINT.ORDER,I>=CURRENT.RUN
|
||
|
|
IF IAUTH # "" AND IAUTH#'*' THEN
|
||
|
|
LOCATE(IAUTH,AUTH.ARRAY,1;WH;'AL') THEN
|
||
|
|
AUTH.ARRAY<2,WH>=AUTH.ARRAY<2,WH>+GROSS-DISC+TAX
|
||
|
|
END ELSE
|
||
|
|
AUTH.ARRAY=INSERT(AUTH.ARRAY,1,WH;IAUTH)
|
||
|
|
AUTH.ARRAY=INSERT(AUTH.ARRAY,2,WH;GROSS-DISC+TAX)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
LOCATE(ITEM,PRT.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
PRT.ARRAY=INSERT(PRT.ARRAY,1,NDX;ITEM)
|
||
|
|
PRT.ARRAY=INSERT(PRT.ARRAY,2,NDX;QTY)
|
||
|
|
PRT.ARRAY=INSERT(PRT.ARRAY,3,NDX;GROSS)
|
||
|
|
PRT.ARRAY=INSERT(PRT.ARRAY,4,NDX;DISC)
|
||
|
|
PRT.ARRAY=INSERT(PRT.ARRAY,5,NDX;TAX)
|
||
|
|
PRT.ARRAY=INSERT(PRT.ARRAY,6,NDX;STAT)
|
||
|
|
END
|
||
|
|
CASE STAT[1,1]='B' OR STAT[1,1]='C'
|
||
|
|
LOCATE(ITEM,BO.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
BO.ARRAY=INSERT(BO.ARRAY,1,NDX;ITEM)
|
||
|
|
BO.ARRAY=INSERT(BO.ARRAY,2,NDX;QTY)
|
||
|
|
BO.ARRAY=INSERT(BO.ARRAY,3,NDX;GROSS)
|
||
|
|
BO.ARRAY=INSERT(BO.ARRAY,4,NDX;DISC)
|
||
|
|
BO.ARRAY=INSERT(BO.ARRAY,5,NDX;TAX)
|
||
|
|
BO.ARRAY=INSERT(BO.ARRAY,6,NDX;STAT)
|
||
|
|
END CASE
|
||
|
|
NEXT I
|
||
|
|
IF REL.ARRAY#'' THEN
|
||
|
|
MCT=DCOUNT(IREC<IVD$MISC.CHARGE.TYPE>,VM)
|
||
|
|
FOR M=1 TO MCT
|
||
|
|
MTYPE=IREC<IVD$MISC.CHARGE.TYPE,M>
|
||
|
|
MITEM=IREC<IVD$MISC.CHARGE.ITEM,M>
|
||
|
|
MAMOUNT=IREC<IVD$MISC.CHARGE.AMOUNT,M>
|
||
|
|
MPRT=IREC<IVD$MISC.CHARGE.PRINT,M>
|
||
|
|
MAUTH=IREC<IVD$MISC.CHARGE.AUTH,M>
|
||
|
|
IF MPRT="" THEN MPRT="N"
|
||
|
|
OKAY=INDEX(RUN,MPRT,1)
|
||
|
|
IF TERMS='CC' THEN
|
||
|
|
IF OKAY AND MAUTH#'' AND MAUTH#'*' THEN
|
||
|
|
LOCATE(MTYPE,MISC.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
MISC.ARRAY=INSERT(MISC.ARRAY,1,NDX;MTYPE)
|
||
|
|
MISC.ARRAY=INSERT(MISC.ARRAY,2,NDX;MITEM)
|
||
|
|
MISC.ARRAY=INSERT(MISC.ARRAY,3,NDX;MAMOUNT)
|
||
|
|
IREC<IVD$MISC.CHARGE.PRINT,M>=CURRENT.RUN
|
||
|
|
LOCATE(MAUTH,AUTH.ARRAY,1;WH;'AL') THEN
|
||
|
|
AUTH.ARRAY<2,WH>=AUTH.ARRAY<2,WH>+MAMOUNT
|
||
|
|
END ELSE
|
||
|
|
AUTH.ARRAY=INSERT(AUTH.ARRAY,1,WH;MAUTH)
|
||
|
|
AUTH.ARRAY=INSERT(AUTH.ARRAY,2,WH;MAMOUNT)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
LOCATE(MTYPE,MPRT.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
MPRT.ARRAY=INSERT(MPRT.ARRAY,1,NDX;MTYPE)
|
||
|
|
MPRT.ARRAY=INSERT(MPRT.ARRAY,2,NDX;MITEM)
|
||
|
|
MPRT.ARRAY=INSERT(MPRT.ARRAY,3,NDX;MAMOUNT)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
IF OKAY THEN
|
||
|
|
LOCATE(MTYPE,MISC.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
MISC.ARRAY=INSERT(MISC.ARRAY,1,NDX;MTYPE)
|
||
|
|
MISC.ARRAY=INSERT(MISC.ARRAY,2,NDX;MITEM)
|
||
|
|
MISC.ARRAY=INSERT(MISC.ARRAY,3,NDX;MAMOUNT)
|
||
|
|
IREC<IVD$MISC.CHARGE.PRINT,M>=CURRENT.RUN
|
||
|
|
END ELSE
|
||
|
|
LOCATE(MTYPE,MPRT.ARRAY,1;NDX;'AL') THEN NULL
|
||
|
|
MPRT.ARRAY=INSERT(MPRT.ARRAY,1,NDX;MTYPE)
|
||
|
|
MPRT.ARRAY=INSERT(MPRT.ARRAY,2,NDX;MITEM)
|
||
|
|
MPRT.ARRAY=INSERT(MPRT.ARRAY,3,NDX;MAMOUNT)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
NEXT M
|
||
|
|
END
|
||
|
|
IF REL.ARRAY#'' THEN
|
||
|
|
NOT.PRINTED=0
|
||
|
|
BEGIN CASE
|
||
|
|
CASE ANSWER='A'
|
||
|
|
RUN.CT=DCOUNT(RUN.ARRAY<1>,VM)
|
||
|
|
IF BO.ARRAY#'' AND RUN.CT+1 GE MAX.SHIPMENTS THEN
|
||
|
|
NOT.PRINTED=1
|
||
|
|
END ELSE
|
||
|
|
IF RET.ORD ELSE ;*returns
|
||
|
|
CALL CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG)
|
||
|
|
END
|
||
|
|
END
|
||
|
|
CASE ANSWER="F"
|
||
|
|
LOCATE(FORCE.ITEM,REL.ARRAY,1;FNDIT) THEN
|
||
|
|
IF RET.ORD ELSE ;*returns
|
||
|
|
CALL CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG)
|
||
|
|
END
|
||
|
|
END ELSE
|
||
|
|
NOT.PRINTED=1
|
||
|
|
END
|
||
|
|
CASE 1
|
||
|
|
IF RET.ORD ELSE ;*returns
|
||
|
|
CALL CMSD.PICKING.SUB.BUILD(PREC,IREC,BO.ARRAY,REL.ARRAY,PRT.ARRAY,MISC.ARRAY,MPRT.ARRAY,TOTAL.ORDER,AUTH.ARRAY,CURRENT.RUN,REPRINT.FLAG)
|
||
|
|
END
|
||
|
|
END CASE
|
||
|
|
IF NOT.PRINTED ELSE
|
||
|
|
IF ANSWER#'R' AND ANSWER#'G' THEN
|
||
|
|
IREC=INSERT(IREC,IVD$TRACK.ACTION,1;"PRT")
|
||
|
|
IREC=INSERT(IREC,IVD$TRACK.OPERATOR,1;USER)
|
||
|
|
IREC=INSERT(IREC,IVD$TRACK.DATE,1;DATE())
|
||
|
|
IREC=INSERT(IREC,IVD$TRACK.TIME,1;TIME())
|
||
|
|
WRITE IREC ON PMO,ID
|
||
|
|
IF IREC<IVD$TERMS>="COD" THEN
|
||
|
|
WRITE TOTAL.ORDER ON SINDEX,ID
|
||
|
|
END ELSE
|
||
|
|
WRITE "" ON SINDEX,ID
|
||
|
|
END
|
||
|
|
NUM.PRINT=NUM.PRINT+1
|
||
|
|
END
|
||
|
|
END
|
||
|
|
END
|
||
|
|
NUM.DONE=NUM.DONE+1
|
||
|
|
1100 *
|
||
|
|
RELEASE PMO,ID
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
2000 *---refresh total display---
|
||
|
|
CRT @(0,15):CR
|
||
|
|
CRT @(0,15):'NUMBER RECORDS READ: ':NUM.READ
|
||
|
|
CRT @(0,16):'NUMBER RECORDS PROCESSED: ':NUM.DONE
|
||
|
|
CRT @(0,17):'NUMBER RECORDS SELECTED: ':NUM.PRINT
|
||
|
|
RETURN
|
||
|
|
*
|
||
|
|
3000 *-check PM.LABELS file for records--*
|
||
|
|
CHECK.FILE.FLAG=0 ; EOF=0
|
||
|
|
SELECT PM.LABELS
|
||
|
|
*
|
||
|
|
LOOP
|
||
|
|
READNEXT ID ELSE EOF=1
|
||
|
|
UNTIL EOF DO
|
||
|
|
3100 *
|
||
|
|
CRT @(0,20):CR:BEEP:"The PM.LABELS file has data in it, would you like to continue(Y/N) : ":
|
||
|
|
INPUT ANS
|
||
|
|
IF ANS[1,1]="Y" THEN GO 3200
|
||
|
|
IF ANS[1,1]="N" THEN STOP
|
||
|
|
IF ANS[1,1]="N" OR ANS[1,1]="Y" ELSE GO 3100
|
||
|
|
REPEAT
|
||
|
|
3200 *
|
||
|
|
RETURN
|
||
|
|
*
|