tild-pick/CMSD.PICKING.TLD.txt

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