*-------------------------------------------------------------------- *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 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,VM) FOR O=1 TO OCT CRT @(0,6+O):"ITEM: ":OREC:SPACE(5):"RUN: ":OREC 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[1,1]#'A' AND IREC[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 BALANCE=IREC READ PREC FROM PM,IREC ELSE OPEN 'CHANGE.PARTNERS' TO CHANGE.PARTNERS THEN READ CHG.REC FROM CHANGE.PARTNERS,IREC 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:" ": ANY=''; INPUT ANY GO 1100 END END END END ICT=DCOUNT(IREC,VM) FOR I=1 TO ICT ITEM=IREC QTY=IREC GROSS=IREC DISC=IREC TAX=IREC STAT=IREC IAUTH=IREC PRT=IREC LN.NET.AMT=IREC 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 .": 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=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,VM) FOR M=1 TO MCT MTYPE=IREC MITEM=IREC MAMOUNT=IREC MPRT=IREC MAUTH=IREC 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=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=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="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 *