added CMS folder
This commit is contained in:
John Paul Wohlscheid
396
CMS/BP.CUSTOM/Copy of TLD.PICKING.PRINT
Normal file
396
CMS/BP.CUSTOM/Copy of TLD.PICKING.PRINT
Normal file
@@ -0,0 +1,396 @@
|
||||
*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
|
||||
*
|
||||
Reference in New Issue
Block a user