*CMSD.PICKING.PRINT *-------------------------------------------------------------------- *PGM NAME: CMSD.PICKING.PRINT *PURPOSE: GENERIC OUTPUT SUBROUTINE FOR REL8 PICKING SLIPS/LABELS *AUTHOR: AL SURLES *CREATED: 06-16-94 (Copied from CMSD.PICKING.SUB.P). *ABS 03-08-95 : Added logic to print SHIP MODE on labels. *ABS 03-13-95 : Added logic to print order number and run.number * on picking labels. *ABS 03-25-95 : Added logic to abbreviate some ship.modes. *STR 05-25-95 : Modified program to retreive shipping address from * GEN.KEYS. *SPA 06-05-95 : Modified program to retrieve client name from GEN.KEYS. *ABS 06-05-95 : Modified program to distinguish and print SOLD address * and SHIP address. The layout for the file PM.LABELS did * change. *ABS 06-15-95 : Modified program to safeguard from updating the * ORDER.LABEL.SUMMARY file more than once. *ABS 07-24-95 : Modified program to print ship mode CODE on labels * instead of ship mode DESCRIPTION. *ABS 08-14-95 : Modified program to print 40 characters instead of 38 for * COMMENTS. *SPA 08-22-95 : Modified to print SHIP TO address instead of SOLD TO * address, and to correctly wrap the paragraph regarding * CC charges from MICAHTEK. * *-------------------------------------------------------------------- $INCLUDE GEN.COMMON $INCLUDE PM $INCLUDE CMSD.IVD $INCLUDE INV $INCLUDE PM.LABELS * OPEN 'INVENTORY' TO INV ELSE STOP 201,'INV' OPEN 'PM.LABELS' TO PML ELSE ABORT 201,"PM.LABELS" OPEN 'PM.LABELS.HOLD' TO PML.HOLD ELSE ABORT 201,"PM.LABELS.HOLD" OPEN 'ORDER.LABEL.SUMMARY' TO OLS ELSE STOP 201,"ORDER.LABEL.SUMMARY" OPEN 'FUND.FILE' TO FUND.FILE ELSE ABORT 201,"FUND.FILE" OPEN 'GEN.KEYS' TO GEN.KEYS ELSE ABORT 201, 'GEN.KEYS' * * READ COMPANY.ADDRESS FROM GEN.KEYS,"COMPANY.SHIPPING.ADDRESS" ELSE CRT @(0,22):CL:BEEP:RV:" ERROR - MISSING GK COMPANY.SHIPPING.ADDRESS :":ERV: INPUT ANY,3 STOP END READ COMPANY.NAME FROM GEN.KEYS,"COMPANY.NAME" ELSE CRT @(0,22):CL:BEEP:RV:" ERROR - MISSING GK COMPANY.NAME ":ERV: INPUT ANY,3 STOP END * CRT @(0,0):CS * CRT @(0,1):"CMSD.PICKING.PRINT" 10 * ANS='' CRT @(5,3):" ":RV:" (P) ":ERV:" icking slips, ":RV:" (L) ":ERV:" abels, or ":RV:" (B) ":ERV:" oth" CRT @(5,5):CL:"Choose ONE of the above option : ": INPUT ANS IF ANS=PF3 OR ANS =PF1 THEN STOP IF ANS="P" OR ANS="L" OR ANS="B" ELSE GO 10 * 20 * *IF ANS="P" OR ANS="B" THEN * EXECUTE \SP-ASSIGN HS\ * EXECUTE \SETPTR ,,,,,,AT LJ3SI,FORM 52,NFMT,RETAIN,INFORM,BRIEF,NHEAD,NOKEEP\ *END *IF ANS="L" THEN * EXECUTE \SP-ASSIGN HS\ * EXECUTE \SETPTR ,,,,,,AT OTC,FORM 32,NFMT,RETAIN,INFORM,BRIEF,NHEAD,NOKEEP\ *END IF ANS="L" THEN CRT @(5,10):CL:RV:" Now select printer for LABELS ":ERV EXECUTE \EX PRINTER\ END ELSE CRT @(5,10):CL:RV:" Now select printer for PICKING SLIPS ":ERV EXECUTE \EX PRINTER\ END * CHANNEL=OCONV(0, 'U50BB') ACCT.NAME=TRIM(FIELD(CHANNEL," ",2)) STARS=STR("_",41) EOF=0 ; REC.CNT=0 ; SEQ.CNT=0 ; PICKING.SLIP.FLAG=0 CMND=\SSELECT PM.LABELS BY SORT.GROUP BY PRODUCT BY ZIP \ EXECUTE CMND * BEGIN CASE CASE ANS="P" OR ANS="B" PICKING.SLIP.FLAG=1 LOOP READNEXT ID ELSE EOF=1 UNTIL EOF DO READ PML.REC FROM PML,ID THEN REC.CNT=REC.CNT+1 ; OLS.REC='' SEQ.CNT=PML.REC:"*":REC.CNT IF PML.REC='' THEN PML.REC=PML.REC PML.REC=PML.REC PML.REC=PML.REC PML.REC=PML.REC PML.REC=PML.REC END GOSUB 1000 ;*---define variables GOSUB 2000 ;*---print picking slips PRINT CHAR(12) READ PMLH.REC FROM PML.HOLD,ID ELSE IF OLS.REC#'' THEN WRITE OLS.REC ON OLS,OLS.KEY WRITE PML.REC ON PML.HOLD,ID END IF ANS="P" THEN DELETE PML,ID END REPEAT PRINT CHAR(12) PRINTER OFF IF ANS="B" THEN ANS="L" ; EXECUTE "SP.CLOSE" ; GO 20 CASE ANS="L" PRINTER ON GOSUB 7500 ;* format gen.keys shipping name ADDRESS<6>=STARS LOOP READNEXT ID ELSE EOF=1 UNTIL EOF DO READ PML.REC FROM PML,ID THEN ADDRESS<7>=PML.REC'R#40' IF PML.REC='' THEN ADDRESS<7>=PML.REC'R#40' PN.CLT=TRIM(PML.REC:"-":ACCT.NAME) ADDRESS<8>=PN.CLT'R#40' INV.NUM=OCONV(ID,"G0*1") ; RUN.NUM=OCONV(ID,"G1*1") CLT.INV.RUN=TRIM(ACCT.NAME:"-":INV.NUM:"-":RUN.NUM) ADDRESS<9>=CLT.INV.RUN'R#40' ADDRESS<10>=ACCT.NAME'R#40' REC.CNT=REC.CNT+1 SEQ.CNT=TRIM(PML.REC:"*":REC.CNT) ADDRESS<11>=SEQ.CNT'R#40' FOR X=13 TO 17 IF X=13 THEN IF PML.REC#'' THEN ADDRESS="TO:":SPACE(6):PML.REC END ELSE ADDRESS="TO:":SPACE(6):PML.REC END END ELSE IF PML.REC#'' THEN ADDRESS=SPACE(9):PML.REC END ELSE ADDRESS=SPACE(9):PML.REC END END NEXT X FOR X=1 TO 18 PRINT ADDRESS'L#40' NEXT X IF NOT(PICKING.SLIP.FLAG) THEN WRITE PML.REC ON PML.HOLD,ID DELETE PML,ID END REPEAT PRINT CHAR(12) * CASE 1 END CASE * PRINTER OFF EXECUTE \SETPTR ,,,,,,BRIEF\ CRT @(0,22):CL:"PROCESS IS COMPLETE" : INPUT DUMMY ENTER MSD.PICKING.RPT * STOP * * 1000 *---define variables and build output arrays ROW=0 BO.SWITCH='' B=999 SP1=SPACE(1); SP2=SPACE(2) ; SP3=SPACE(3) ; SP5=SPACE(5); SP10=SPACE(10) PARTNER=PML.REC TODAY=OCONV(DATE(),'D2/') ORDER=OCONV(ID,"G0*1") ORDER.DATE=OCONV(PML.REC,'D2/') PO.NUM=PML.REC IDATE=ICONV(TODAY,"D") ; RUN.NUMBER=OCONV(ID,"G1*1") OLS.KEY=ORDER:"*":RUN.NUMBER EVENT=PML.REC * TERMS=OCONV(PML.REC,"MCU") * SHIP.VIA=PML.REC * RETURN * 2000 * TOTAL.ORDER=PML.REC PG=1 PRINTER ON GOSUB 2100 ;* PRINT TOP PART OF FORM TT=DCOUNT(PML.REC,VM) FOR I=1 TO TT ITEM=PML.REC READ INV.REC FROM INV,ITEM THEN SHELF.LOC=INV.REC END ELSE SHELF.LOC="" END QTY=PML.REC DESC=PML.REC XAMT=PML.REC LN=SP1:QTY'R#4':SP2:QTY'R#4':SPACE(3):SHELF.LOC'L#5':ITEM'L#7' LN=LN:SP3:DESC'L#30':SP10:XAMT'R26(#7)' GOSUB 2200 ;* PRINT A LINE IF PML.REC#'' THEN CI.CNT=DCOUNT(PML.REC,SVM) FOR CI=1 TO CI.CNT LN="-----PK ITEM----- ":PML.REC'L#10' LN=LN:PML.REC'L#30' CI.QTY="(":PML.REC:")" LN=LN:CI.QTY'R#6' GOSUB 2200 ; * PRINT A LINE NEXT CI LN='' ; GOSUB 2200 END *-- build record for ORDER.LABEL.SUMMARY file -- IF OLS.REC='' THEN OLS.REC<1>=PARTNER:VM:ORDER OLS.REC<2>=ITEM OLS.REC<3>=QTY OLS.REC<4>="P1" OLS.REC<5>=IDATE END ELSE OLS.REC<2>=OLS.REC<2>:VM:ITEM OLS.REC<3>=OLS.REC<3>:VM:QTY END NEXT I * MISC.ARRAY='' FOR B=1 TO 5 MISC.ARRAY=PML.REC NEXT B MCT=DCOUNT(MISC.ARRAY,VM) FOR M=1 TO MCT MTYPE=MISC.ARRAY<1,M> MITEM=MISC.ARRAY<2,M> MAMOUNT=MISC.ARRAY<3,M> BEGIN CASE CASE MTYPE='SHIPG' LN=SPACE(29):"SHIPPING AND HANDLING":SPACE(17):MISC.ARRAY<3,M>'R26,(#9)' GOSUB 2200 CASE MTYPE='HANDG' LN=SPACE(29):"C.O.D. CHARGE":SPACE(27):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 CASE MTYPE='COD' LN=SPACE(29):"COD CHARGE":SPACE(30):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 CASE MTYPE='PLG' LN=SPACE(29):"PLEDGE PAYMENT":SPACE(26):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 CASE MTYPE='FUND' READV FDESC FROM FUND.FILE,MISC.ARRAY<2,M>,1 ELSE FDESC="FUND PAYMENT" LN=SPACE(29):FDESC'L#30':SPACE(10):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 CASE MTYPE='SUBS' LN=SPACE(29):"SUBSCRIPTION PAYMENT":SPACE(20):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 CASE MTYPE='APPLY' LN=SPACE(29):"CREDIT MEMO APPLIED":SPACE(21):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 CASE MTYPE='CRMEM' LN=SPACE(29):"CREDIT MEMO CREATED":SPACE(21):MISC.ARRAY<3,M>'R26,(#7)' GOSUB 2200 END CASE NEXT M LN='' GOSUB 2200 BCT=DCOUNT(PML.REC,VM) * ------ DJL - ADDED BACKORDER PRINT LOGIC ------ * FOR B=1 TO BCT BO.SWITCH=1 ITEM=PML.REC QTY=PML.REC DESC=PML.REC LN=SPACE(13):QTY'R#4':SP2:ITEM'L#7' LN=LN:SP3:DESC'L#30' GOSUB 2200 ;* PRINT A LINE NEXT B LN='' GOSUB 2200 OCT=DCOUNT(PML.REC,VM) FOR O=1 TO OCT IF PML.REC # '' THEN LN=SPACE(29):PML.REC'L#40' GOSUB 2200 END NEXT O LN='' GOSUB 2200 LN=SPACE(43):'AMOUNT DUE THIS INVOICE':TOTAL.ORDER'R26,$(#10)' GOSUB 2200 IF PML.REC='Y' THEN ;* balance on order to be charged! GOSUB 2200 GOSUB 2200 LN=SPACE(5):"**Credit card charges will be made when back-ordered products are shipped." GOSUB 2200 END IF TERMS='CREDIT CARD' THEN GOSUB 2200 GOSUB 2200 LN="Dear ":PML.REC<1>:":" GOSUB 2200 GOSUB 2200 * FOR THE WORD WRAP LOGIC TO WORK, THERE MUST BE A BLANK LINE AT THE END * OF LN1 BELOW! LN1="Please notice when your credit card statement arrives that the order you have received will reflect a charge under the name 'MICAHTEK' rather than ":OCONV(COMPANY.NAME,"MCT"):". MICAHTEK is a 1-800 number fulfillment center responsible for shipping our products to you. " LOOP LNLEN=LEN(LN1) UNTIL LNLEN=0 DO NUM.SPACES=COUNT(LN1," ") IDX=99 FOR XX=NUM.SPACES TO 1 STEP -1 UNTIL IDX LE 80 IDX=INDEX(LN1," ",XX) NEXT XX LN=LN1[1,IDX-1] GOSUB 2200 LN1=LN1[IDX+1,LNLEN] REPEAT GOSUB 2200 GOSUB 2200 LN="Thank You and may God Bless You!" GOSUB 2200 END RETURN * 2100 *---print top part of form---- *PRINT; PRINT; PRINT; PRINT PRINT PRINT SP2:COMPANY.NAME PRINT SP2:COMPANY.ADDRESS<1,1>'L#38':SP5:"Order Number: ":ORDER'L#10' PRINT SP2:COMPANY.ADDRESS<1,2>'L#38':SP5:"Print Date: ":IDATE'L#8' PRINT SP2:COMPANY.ADDRESS<1,3>'L#38':SP5:"Print Run #: ":RUN.NUMBER'L#5':SEQ.CNT'R#8' PRINT SP2:COMPANY.ADDRESS<1,4>'L#38' PRINT SP2:COMPANY.ADDRESS<1,5>'L#38':SP5:"Partner Number: ":PARTNER'L#10' PRINT PRINT SP2:"SHIP TO:" PRINT PRINT SP2:PML.REC'L#38':SP5:"Batch Date: ":ORDER.DATE'L#15' PRINT SP2:PML.REC'L#38':SP5:"Ship Via: ":SHIP.VIA'L#15' PRINT SP2:PML.REC'L#38':SP5:"Terms: ":TERMS'L#15' PRINT SP2:PML.REC'L#38':SP5:"PO Number: ":PO.NUM'L#15' PRINT SP2:PML.REC'L#38':SP5:"Event: ":EVENT'L#15' PRINT ; PRINT PRINT PRINT STR('-',79) PRINT " QTY QTY SLF ITEM DESCRIPTION AMOUNT" PRINT " ORD SHP LOC" PRINT STR('-',79) ROW=26 RETURN * 2200 *---print a detail line---- IF ROW=60 THEN PRINT CHAR(12); GOSUB 2100 ; ROW=26 * ------ DJL - ADDED BACKORDER PRINTOUT LOGIC ------ * IF BO.SWITCH AND B LE 1 THEN PRINT PRINT BO.LN=SPACE(28):"BACKORDERED PRODUCT(S):" PRINT BO.LN PRINT PRINT LN ROW=ROW+5 LN='' BO.SWITCH='' END ELSE PRINT LN ROW=ROW+1 LN='' BO.SWITCH='' END RETURN * * 7500 *------------ format company address to print on label ---------* *--- center address on label -------------* LADD1=(40 - LEN(COMPANY.ADDRESS<1,1>)) / 2 LADD2=(40 - LEN(COMPANY.ADDRESS<1,2>)) / 2 LADD3=(40 - LEN(COMPANY.ADDRESS<1,3>)) / 2 LADD4=(40 - LEN(COMPANY.ADDRESS<1,4>)) / 2 ADDRESS='' *ADDRESS<2>='FROM:':SPACE(LADD1-1):COMPANY.ADDRESS<1,1> *ADDRESS<3>=SPACE(LADD2+3):COMPANY.ADDRESS<1,2> *ADDRESS<4>=SPACE(LADD3+3):COMPANY.ADDRESS<1,3> *ADDRESS<5>=SPACE(LADD4+3):COMPANY.ADDRESS<1,4> ADDRESS<2>='' ADDRESS<3>='' ADDRESS<4>='' ADDRESS<5>='' RETURN *