tldm-universe/CMS/BP.CUSTOM/TLD.PICKING.PRINT.VER2

*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>
          SHIPTO=0
        END ELSE
          SHIPTO=1
        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':SP5:"Partner Number: ":PARTNER'L#10'
PRINT SP2:COMPANY.ADDRESS<1,5>'L#38'
PRINT SPACE(43):"Batch Date: ":ORDER.DATE'L#15'
PRINT SP2:"SOLD TO:"'L#38':SP5:"Ship Via:   ":SHIP.VIA'L#15'
PRINT SPACE(43):"Terms:     ":TERMS'L#15'
PRINT SP2:PML.REC<PML$SOLD1>'L#38':SP5:"PO Number:  ":PO.NUM'L#15'
PRINT SP2:PML.REC<PML$SOLD2>'L#38':SP5:"Event:      ":EVENT'L#15'
PRINT SP2:PML.REC<PML$SOLD3>'L#38':SP5:"SHIPPED TO:"
IF SHIPTO THEN
  PRINT SP2:PML.REC<PML$SOLD4>'L#38':SP5:PML.REC<PML$SHIP1>'L#35'
  PRINT SP2:PML.REC<PML$SOLD5>'L#38':SP5:PML.REC<PML$SHIP2>'L#35'
  SPACE(45):PML.REC<PML$SHIP3>'L#35'
  SPACE(45):PML.REC<PML$SHIP4>'L#35'
  SPACE(45):PML.REC<PML$SHIP5>'L#35'
END ELSE
  PRINT SP2:PML.REC<PML$SOLD4>'L#38'
  PRINT SP2:PML.REC<PML$SOLD5>'L#38'
  PRINT
  PRINT
  PRINT
END
*
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
*