397 lines
12 KiB
Plaintext
Executable File
397 lines
12 KiB
Plaintext
Executable File
*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 <return> :":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 <return> ":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<PML$SORT.GROUP>:"*":REC.CNT
|
|
IF PML.REC<PML$SHIP1>='' THEN
|
|
PML.REC<PML$SHIP1>=PML.REC<PML$SOLD1>
|
|
PML.REC<PML$SHIP2>=PML.REC<PML$SOLD2>
|
|
PML.REC<PML$SHIP3>=PML.REC<PML$SOLD3>
|
|
PML.REC<PML$SHIP4>=PML.REC<PML$SOLD4>
|
|
PML.REC<PML$SHIP5>=PML.REC<PML$SOLD5>
|
|
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<PML$SHIP.MODE,2>'R#40'
|
|
IF PML.REC<PML$SHIP.MODE,2>='' THEN ADDRESS<7>=PML.REC<PML$SHIP.MODE,1>'R#40'
|
|
PN.CLT=TRIM(PML.REC<PML$PARTNER>:"-":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<PML$SORT.GROUP>:"*":REC.CNT)
|
|
ADDRESS<11>=SEQ.CNT'R#40'
|
|
FOR X=13 TO 17
|
|
IF X=13 THEN
|
|
IF PML.REC<PML$SHIP1>#'' THEN
|
|
ADDRESS<X>="TO:":SPACE(6):PML.REC<X+21>
|
|
END ELSE
|
|
ADDRESS<X>="TO:":SPACE(6):PML.REC<X-12>
|
|
END
|
|
END ELSE
|
|
IF PML.REC<PML$SHIP1>#'' THEN
|
|
ADDRESS<X>=SPACE(9):PML.REC<X+21>
|
|
END ELSE
|
|
ADDRESS<X>=SPACE(9):PML.REC<X-12>
|
|
END
|
|
END
|
|
NEXT X
|
|
FOR X=1 TO 18
|
|
PRINT ADDRESS<X>'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<PML$PARTNER>
|
|
TODAY=OCONV(DATE(),'D2/')
|
|
ORDER=OCONV(ID,"G0*1")
|
|
ORDER.DATE=OCONV(PML.REC<PML$BATCH.DT>,'D2/')
|
|
PO.NUM=PML.REC<PML$PO.NUMBER>
|
|
IDATE=ICONV(TODAY,"D") ; RUN.NUMBER=OCONV(ID,"G1*1")
|
|
OLS.KEY=ORDER:"*":RUN.NUMBER
|
|
EVENT=PML.REC<PML$EVENT>
|
|
*
|
|
TERMS=OCONV(PML.REC<PML$TERMS>,"MCU")
|
|
*
|
|
SHIP.VIA=PML.REC<PML$SHIP.MODE,1>
|
|
*
|
|
RETURN
|
|
*
|
|
2000 *
|
|
TOTAL.ORDER=PML.REC<PML$BALANCE>
|
|
PG=1
|
|
PRINTER ON
|
|
GOSUB 2100 ;* PRINT TOP PART OF FORM
|
|
TT=DCOUNT(PML.REC<PML$REL.ITEM>,VM)
|
|
FOR I=1 TO TT
|
|
ITEM=PML.REC<PML$REL.ITEM,I>
|
|
READ INV.REC FROM INV,ITEM THEN
|
|
SHELF.LOC=INV.REC<INV$PRIMARY.LOCATION>
|
|
END ELSE
|
|
SHELF.LOC=""
|
|
END
|
|
QTY=PML.REC<PML$REL.QTY,I>
|
|
DESC=PML.REC<PML$REL.DESC,I>
|
|
XAMT=PML.REC<PML$REL.AMOUNT,I>
|
|
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<PML$PK.ITEM,I>#'' THEN
|
|
CI.CNT=DCOUNT(PML.REC<PML$PK.ITEM,I>,SVM)
|
|
FOR CI=1 TO CI.CNT
|
|
LN="-----PK ITEM----- ":PML.REC<PML$PK.ITEM,I,CI>'L#10'
|
|
LN=LN:PML.REC<PML$PK.DESC,I,CI>'L#30'
|
|
CI.QTY="(":PML.REC<PML$PK.QTY,I,CI>:")"
|
|
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<B>=PML.REC<B+22>
|
|
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<PML$BO.ITEM>,VM)
|
|
* ------ DJL - ADDED BACKORDER PRINT LOGIC ------ *
|
|
FOR B=1 TO BCT
|
|
BO.SWITCH=1
|
|
ITEM=PML.REC<PML$BO.ITEM,B>
|
|
QTY=PML.REC<PML$BO.QTY,B>
|
|
DESC=PML.REC<PML$BO.DESC,B>
|
|
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<PML$COMMENTS>,VM)
|
|
FOR O=1 TO OCT
|
|
IF PML.REC<PML$COMMENTS,O> # '' THEN
|
|
LN=SPACE(29):PML.REC<PML$COMMENTS,O>'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<PML$CC.BO.FLAG>='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<PML$SHIP1>'L#38':SP5:"Batch Date: ":ORDER.DATE'L#15'
|
|
PRINT SP2:PML.REC<PML$SHIP2>'L#38':SP5:"Ship Via: ":SHIP.VIA'L#15'
|
|
PRINT SP2:PML.REC<PML$SHIP3>'L#38':SP5:"Terms: ":TERMS'L#15'
|
|
PRINT SP2:PML.REC<PML$SHIP4>'L#38':SP5:"PO Number: ":PO.NUM'L#15'
|
|
PRINT SP2:PML.REC<PML$SHIP5>'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
|
|
*
|