000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID.    B0100XPA IS INITIAL.
000030 AUTHOR.        SKI  .
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000060     COPY "EXCEL.CS".
000090*REMARKS.
000100*****************************************************************
000110*                                                               *
000120* B0100XPA - APPAREL Invoices                                   *
000130* VERSION 4.5                                                   *
110510* FIX KWS V4.5.3- NOT SHOWING THE COMPANY NAME WHEN NO LOGO     *
110510* UPD KWS V4.5.3- CHANGE LOCATION OF COLOR/CATEGORY FIELDS      *
110510* MOD KWS V4.5.3- LIBERTYU - PRINT 'LENGTH' INSTEAD OF CATEGORY *
000100*****************************************************************

001030 INPUT-OUTPUT SECTION.
001040 FILE-CONTROL.
001120     COPY "USERF.SL".
           COPY "PFPRNTR.SL".
001120     COPY "CNTLF.SL".
001120     COPY "EXCNF.SL".
001120     COPY "ORDHF.SL".
001120     COPY "ORDLF.SL".
001140     COPY "SCATF.SL".
001140     COPY "STYLF.SL".
001140     COPY "COLRF.SL".
001050
001180 DATA DIVISION.
001190 BASED-STORAGE SECTION.
001210 FILE SECTION.
001370     COPY "USERF.FD".
121908     COPY "PFPRNTR.FD".
121908     COPY INVAPP  OF XMDLIB. 
001370     COPY "CNTLF.FD".
001370     COPY "EXCNF.FD".
001370     COPY "ORDHF.FD".
001370     COPY "ORDLF.FD".
001370     COPY "SCATF.FD".
001370     COPY "STYLF.FD".
001370     COPY "COLRF.FD".

001420 WORKING-STORAGE SECTION.
001430 01  PROG-NAME    PIC X(9) VALUE    "B0100XPA".
       01 MODE-SWITCHES.
001450    05  OPEN-ORDERS-FLAG    PIC X.
001460     88  OPEN-ORDERS     VALUE "1".
001460     88  NOT-OPEN-ORDERS VALUE "0".
001470    05  SINGLE-INVOICE-FLAG PIC X.
001480     88  SINGLE-INVOICE  VALUE "1".
001490    05  ACCUM-TOTALS-FLAG   PIC X.
001500     88  NO-ACCUM-TOTALS VALUE "0".
001500     88  ACCUM-TOTALS    VALUE "1".
002890    05  PROCESS-HISTORY-FLAG PIC X.
002900     88 PROCESS-HISTORY-YES VALUE "1".
006390    05  FORM-TYPE-FLAG        PIC X.
006400     88 INVOICE-FORM       VALUE "0".
006410     88 ACK-FORM           VALUE "2".
          05  ESCAPABLE           PIC X.
002700     88  ESC-FLAG        VALUE "1".
          05 PIC X.
           88  HEADER-AT-TOP  VALUE "0".
           88  HEADER-AT-BODY VALUE "1".
       01  FORMATTING-PRINT.
            05 FMT-STYLE-TOTAL-QTY PIC X(8).
            05 PR-STYLE-TOTAL-QTY REDEFINES FMT-STYLE-TOTAL-QTY 
                                  PIC Z(7)- VALUE ZEROES BLANK ZERO.
005500      05 PR-STYLE-TOTAL-QTY-1 REDEFINES PR-STYLE-TOTAL-QTY
005510                            PIC ZZZZZ.9-           BLANK ZERO.
005520      05 PR-STYLE-TOTAL-QTY-2 REDEFINES PR-STYLE-TOTAL-QTY
005530                            PIC ZZZZ.99-           BLANK ZERO.
005540      05 PR-STYLE-TOTAL-QTY-3 REDEFINES PR-STYLE-TOTAL-QTY
005550                            PIC ZZZ.999-           BLANK ZERO.
005560      05 PR-STYLE-TOTAL-QTY-4 REDEFINES PR-STYLE-TOTAL-QTY
005570                            PIC ZZ.9999-           BLANK ZERO.
005580      05 PR-STYLE-TOTAL-QTY-5 REDEFINES PR-STYLE-TOTAL-QTY
005590                            PIC Z.99999-           BLANK ZERO.
            05 FMT-PR-QTY PIC X(8).
            05 F-PR-QTY REDEFINES FMT-PR-QTY 
                                  PIC Z(7)- VALUE ZEROES BLANK ZERO.
004450      05 F-PR-QTY-1 REDEFINES F-PR-QTY PIC ZZZZZ.9- BLANK ZERO.
004460      05 F-PR-QTY-2 REDEFINES F-PR-QTY PIC ZZZZ.99- BLANK ZERO.
004470      05 F-PR-QTY-3 REDEFINES F-PR-QTY PIC ZZZ.999- BLANK ZERO.
004480      05 F-PR-QTY-4 REDEFINES F-PR-QTY PIC ZZ.9999- BLANK ZERO.
004490      05 F-PR-QTY-5 REDEFINES F-PR-QTY PIC Z.99999- BLANK ZERO.
            05 FMT-PR-ORD-QTY PIC X(8).
            05 F-PR-ORD-QTY REDEFINES FMT-PR-ORD-QTY 
                                  PIC Z(7)- VALUE ZEROES BLANK ZERO.
004450      05 F-PR-ORD-QTY-1 REDEFINES F-PR-ORD-QTY 
                                  PIC ZZZZZ.9- BLANK ZERO.
004460      05 F-PR-ORD-QTY-2 REDEFINES F-PR-ORD-QTY 
                                  PIC ZZZZ.99- BLANK ZERO.
004470      05 F-PR-ORD-QTY-3 REDEFINES F-PR-ORD-QTY 
                                  PIC ZZZ.999- BLANK ZERO.
004480      05 F-PR-ORD-QTY-4 REDEFINES F-PR-ORD-QTY 
                                  PIC ZZ.9999- BLANK ZERO.
004490      05 F-PR-ORD-QTY-5 REDEFINES F-PR-ORD-QTY 
                                  PIC Z.99999- BLANK ZERO.
            05 FMT-PR-SHIP-QTY PIC X(8).
            05 F-PR-SHIP-QTY REDEFINES FMT-PR-SHIP-QTY 
                                  PIC Z(7)- VALUE ZEROES BLANK ZERO.
004450      05 F-PR-SHIP-QTY-1 REDEFINES F-PR-SHIP-QTY 
                                  PIC ZZZZZ.9- BLANK ZERO.
004460      05 F-PR-SHIP-QTY-2 REDEFINES F-PR-SHIP-QTY 
                                  PIC ZZZZ.99- BLANK ZERO.
004470      05 F-PR-SHIP-QTY-3 REDEFINES F-PR-SHIP-QTY 
                                  PIC ZZZ.999- BLANK ZERO.
004480      05 F-PR-SHIP-QTY-4 REDEFINES F-PR-SHIP-QTY 
                                  PIC ZZ.9999- BLANK ZERO.
004490      05 F-PR-SHIP-QTY-5 REDEFINES F-PR-SHIP-QTY 
                                  PIC Z.99999- BLANK ZERO.
            05 FMT-PR-BO-QTY PIC X(8).
            05 F-PR-BO-QTY REDEFINES FMT-PR-BO-QTY 
                                  PIC Z(7)- VALUE ZEROES BLANK ZERO.
004450      05 F-PR-BO-QTY-1 REDEFINES F-PR-BO-QTY 
                                  PIC ZZZZZ.9- BLANK ZERO.
004460      05 F-PR-BO-QTY-2 REDEFINES F-PR-BO-QTY 
                                  PIC ZZZZ.99- BLANK ZERO.
004470      05 F-PR-BO-QTY-3 REDEFINES F-PR-BO-QTY 
                                  PIC ZZZ.999- BLANK ZERO.
004480      05 F-PR-BO-QTY-4 REDEFINES F-PR-BO-QTY 
                                  PIC ZZ.9999- BLANK ZERO.
004490      05 F-PR-BO-QTY-5 REDEFINES F-PR-BO-QTY 
                                  PIC Z.99999- BLANK ZERO.
006250 01  ORDER-COMPLETE-FLAG PIC X.
006260     88 ORDER-COMPLETE   VALUE "0".
006260     88 ORDER-NOT-COMPLETE  VALUE "1".
       01  M-USERS PIC 9(5).
           88 M-USER VALUES 00114, 00258, 00167.
006470 01  CLASSICH-VARIABLES.
006480     05 DOZ-SHIPPED         PIC S9(6)V9(2)  VALUE ZERO.
006490     05 DOZ-ORDERED         PIC S9(6)V9(2)  VALUE ZERO.
006500     05 WS-DOZEN-MSG.
006510        10 PR-DOZ-SHIPPED      PIC Z(5)9.9(2)-  VALUE ZERO.
006520        10 PR-DOZ-SLASH        PIC X(03)       VALUE " / ".
006530        10 PR-DOZ-ORDERED      PIC Z(5)9.9(2)-  VALUE ZERO.
006540
006550 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
006570     88 LIBERTYU            VALUE 00258.
006580     88 CLASSICH            VALUE 00167.
001910 01  LINE-NO             PIC 9(2).
001920 01  PAGE-NO             PIC 9(4).
001930 01  PAGE-SIZE           PIC 99.
       01  GROUPS-AT-HEADER    PIC 99.
001980 01  TERMS-DESC.
001990     05 TERMS-PCT        PIC 99   VALUE ZEROES.
002000     05 FILLER           PIC XX   VALUE "% ".
002010     05 TERMS-DAYS       PIC 999  VALUE ZEROES.
002020     05 FILLER           PIC X(5) VALUE " NET ".
002030     05 TERMS-DUE-DAYS   PIC 999  VALUE ZEROES.
002740 01  DISPLAY-MESSAGES.
002790     05 PRINTING-REPORT  PIC X(30).

005600 01  WS-STYLE-TOTAL-QTY PIC S9(8)V9(5)  VALUE 0.
005610 01  WS-STYLE-TOTAL-QTY-TOT PIC S9(8)V9(5) VALUE 0.
       01  WS-INV-DATE PIC X(11).
005630 01  TOTALS VALUE ZERO.
005640     05 TOT-PROFIT-AMT   PIC S9(9)V99.
005650 01  COMM-AMT            PIC S9(7)V99 VALUE ZERO.
005660 01  TAX-TOTALS VALUE ZERO.
005670     05  TAXABLE         PIC S9(7)V99 OCCURS 3 TIMES.
005680     05  NON-TAXABLE     PIC S9(7)V99 OCCURS 3 TIMES.
005690     05  TAX-AMT         PIC S9(7)V99 OCCURS 3 TIMES.
005700     05  TAX-RND         PIC S9(7)V9999 OCCURS 3 TIMES.
005710     05  TEMP-TAXABLE    PIC S9(7)V99 OCCURS 3 TIMES.
005720 01  TOT-TAX-AMT         PIC S9(9)V99 VALUE ZERO.
005730 01  DIFF-TAX            PIC S9(9)V99 VALUE ZERO.
005740 01  PROFIT                 PIC S9(9)V99.
005750 01  PROFIT-PCT             PIC 999V9.
005760 01  INV-DATE               PIC 9(6).
005770 01  ORDER-NUMBER           PIC 9(6) VALUE 0.
005780 01  SUB-ORDER-NO           PIC 9(2) VALUE ZERO.
005790 01  SUB-LINES              PIC 9 VALUE 0.

005620 01  WS-OLD-STYLE        PIC X(8)     VALUE LOW-VALUES.
002120 01  LOW-KEY             PIC X(6) VALUE LOW-VALUES.
002130 01  HIGH-KEY            PIC X(6) VALUE HIGH-VALUES.
006430 01  WS-SAVE-GROUP PIC 999 VALUE 999.
            88 WS-SAVE-GROUP-L VALUE 999.
002140 01  COLOR-QUANTITIES.
002150        05 COLOR-QTY-L   PIC S9(6)V9(5) COMP-3 VALUE ZEROES
002160                                        OCCURS 255.
002170        05 TOTAL-QTY     PIC S9(7)V9(5) COMP-3 VALUE ZERO.
002150        05 WS-COLOR-QTY  PIC S9(6)V9(5) COMP-3.
002670 01  WS-HOLD-EXT-AMT  PIC S9(7)V99  COMP-3 VALUE 0.

006270*01  WS-IC.
006280*    05 WS-ICA PIC 9(765).
      *        88 WS-ITEMS-CLEAN VALUE 0.
006290*    05 WS-ITEM-CAT REDEFINES WS-ICA PIC 999 OCCURS 255 TIMES.
      *        88 EMPTY-ITEM-CAT VALUE 0.
       01  WS-SCAN-INVOICE.
006320     05 WS-GROUPS-FOUND PIC 999 VALUE 0.
           05 OCCURS 255 TIMES.
               10 WS-SCAN-GROUP PIC 999.
               10 WS-GROUP-IDX PIC 999.
               10 WS-SCAN-SIZES PIC 999.
               10 WS-SCAN-SIZES-LIST PIC 9999 OCCURS 255 TIMES.
               10 WS-SCAN-SIZES-IDX PIC 999 OCCURS 255 TIMES.
006330 01  WS-PASS-NO PIC 99.

002180 01  HOLD-DATA1.
002190         05 HOLD-ITEM-NO                 PIC X(12).
002200         05 HOLD-APPAREL REDEFINES HOLD-ITEM-NO.
002210            10 HOLD-STYLE                PIC X(08).
                        88 HOLD-STYLE-COMMENT VALUE "C       ", 
                                                    "c       ".
002220            10 HOLD-CATEGORY             PIC X.
100209                  88 HOLD-CAT-NOTAPPAREL VALUES "0", " ".
002230            10 HOLD-COLOR                PIC X(2).
002240            10 HOLD-SIZE                 PIC X.
100209                  88 HOLD-SZ-NOTAPPAREL VALUES "0", " ".
002250         05 HOLD-ITEM-DESC               PIC X(512).
002260         05 HOLD-ORDER-QTY               PIC S9(7)V9(5) COMP-3.
002270         05 HOLD-SHIP-QTY                PIC S9(7)V9(5) COMP-3.
002280         05 HOLD-BO-QTY                  PIC S9(7)V9(5) COMP-3.
002290         05 HOLD-PREVSHIP-QTY            PIC S9(7)V9(5) COMP-3.
002300         05 HOLD-ITEM-PRICE              PIC S9(6)V999  COMP-3.
002310         05 HOLD-ITEM-COST               PIC S9(6)V999  COMP-3.
002320         05 HOLD-EXT-AMT                 PIC S9(7)V99   COMP-3.
002330         05 HOLD-EXT-COST                PIC S9(7)V99   COMP-3.
002340         05 HOLD-DISC-AMT                PIC S9(6)V999  COMP-3.
002350         05 HOLD-DISC-PCT                PIC S999V99    COMP-3.
002360         05 HOLD-COMM-PCT                PIC S999V99    COMP-3.
002370         05 HOLD-ITEM-UOM                PIC XXX.
002380         05 HOLD-ITEM-WEIGHT             PIC 9(6)V999   COMP-3.
002390         05 HOLD-ITEM-BIN                PIC X(6).
002400         05 HOLD-TAX-CD                  PIC 9  OCCURS 003 TIMES.
002410         05 HOLD-DISC-CD                 PIC 9.
002420         05 HOLD-PRICE-CD                PIC 9.
002430         05 HOLD-OVRD-CD                 PIC 9.
002440         05 HOLD-GLACCT                  PIC 9(7)       COMP-3.
002450         05 HOLD-COMPLETE-CD             PIC 9.
002460         05 HOLD-DROPSHIP-CD             PIC 9.
002470         05 HOLD-CONV-CD                 PIC 9.
002480*        05 HOLD-CONV-FACTOR             PIC 9(4).
072208         05 HOLD-CONV-FACTOR    PIC S9(4)V9(5) COMP-3.
002490         05 HOLD-ITEM-CLASS              PIC 99.
002500*        05 HOLD-GROUP-NAME              PIC 9.
002500         05 HOLD-GROUP-NAME              PIC 999.
002510         05 HOLD-GLACCT-2       PIC 9(7)       COMP-3.
002520         05 HOLD-VENDOR             PIC X(8).
002530*        05 HOLD-WHSE-NO        PIC 99.
100807         05  HOLD-WHSE-NO-KEY.
100807             10 HOLD-WHSE-NO     PIC X(04).
002540         05 HOLD-GENERATE-PO-CD PIC 9.
002550         05 HOLD-SQ-FT          PIC 9(5)V99.
002560         05 HOLD-QTY-CONTRACT   PIC 9.
002570         05 HOLD-MARKUP-PCT         PIC S9(3)V99   COMP-3.
002580         05 HOLD-MARKUP-PCT-ALPH REDEFINES HOLD-MARKUP-PCT.
002590             10 FILLER PIC X(3).
002600         05 HOLD-ADDED-COST         PIC S9(9)V99   COMP-3.
002610         05 HOLD-ADDED-SELLING      PIC S9(9)V99   COMP-3.
002620         05 HOLD-PICKED-QTY     PIC S9(7)V9(5) COMP-3.
002630         05 HOLD-LOT-NO         PIC X(15).
002640         05 HOLD-COPIES         PIC S9(9)      COMP-3.
002650         05 HOLD-PARENT-SEQ-NO  PIC 9(6).

002710 01  INPUT-SPECS-1.
002720     05  FILLER      PIC X(14)  VALUE "1380O01011IE  ".
003310 01  DATE-SPEC       PIC X(14)  VALUE "1154D06060E   ".
002730 77  INVIS-OPTION    PIC X(1)   VALUE "X".

005810 01  POS-SCRN.
005820     05  POS-1.
005830         10  FILLER       PIC X(17)  VALUE "Net Sales Amount".
005840         10  PR-NET-AMT   PIC Z,ZZZ,ZZZ.99-.
005850         10  FILLER       PIC X(9)   VALUE SPACES.
005860         10  FILLER       PIC X(12)  VALUE "Payment Type".
005870     05  POS-2.
005880         10  FILLER       PIC X(17)  VALUE "Freight".
005890         10  PR-FREIGHT-AMT PIC Z,ZZZ,ZZZ.99-.
005900     05  POS-3.
005910         10  FILLER       PIC X(17)  VALUE "Special Charges".
005920         10  PR-SPCHG-AMT PIC Z,ZZZ,ZZZ.99-.
005930     05  POS-4.
005940         10  FILLER       PIC X(17)  VALUE "Sub-Total".
005950         10  PR-SUB-AMT   PIC Z,ZZZ,ZZZ.99-.
005960     05  POS-5.
005970         10  FILLER       PIC X(17)  VALUE "Taxes".
005980         10  PR-TAX-AMT   PIC Z,ZZZ,ZZZ.99-.
005990     05  POS-6.
006000         10  FILLER       PIC X(17)  VALUE "Invoice Total:".
006010         10  PR-INV-AMT   PIC Z,ZZZ,ZZZ.99-.
006020 01  PMT-CODES.
006030     05  FILLER     PIC X(17) VALUE "On Account".
006040     05  FILLER     PIC X(17) VALUE "Cash".
006050     05  FILLER     PIC X(17) VALUE "Check".
006060     05  FILLER     PIC X(17) VALUE "MasterCard".
006070     05  FILLER     PIC X(17) VALUE "VISA".
006080     05  FILLER     PIC X(17) VALUE "American Express".
006090     05  FILLER     PIC X(17) VALUE "Other Credit Card".
006100 01  TYPE-SPEC.
006110     05  FILLER      PIC X(9)   VALUE "1057O0717".
006120     05  OPTION      PIC 9      VALUE 1.
006130     05  FILLER      PIC X(9)   VALUE "E   ".
006140 01  PMT-SPEC.
006150     05  FILLER      PIC X(14)  VALUE "1261P05102EN  ".
006160 01  PMT-AMT            PIC S9(7)V99 COMP-3 VALUE 0.
006170 01  POS-7.
006180     10  FILLER         PIC X(15)  VALUE "Amount Tendered".
006190 01  POS-8.
006200     05  PR-CHANGE-MSG  PIC X(15) VALUE SPACES.
006210     05  PR-CHANGE-AMT  PIC Z,ZZZ,ZZZ.99-.
006240
002910 01  RANGE-DATA.
002930     05  RANGE-CODES.
002940         10  FILLER     PIC X(17) VALUE "All Unprinted".
002950         10  FILLER     PIC X(17) VALUE "A range of Orders".
002960         10  FILLER     PIC X(17) VALUE "Selective Orders".
002970     05  RANGE-SPECS-1.
002980         10  FILLER     PIC X(9)  VALUE "1143O0317".
002990         10  OPTION     PIC 9     VALUE 1.
003000         10  FILLER     PIC X(4)  VALUE "E   ".
003030     05  RANGE-SPECS-2.
003040         10  FILLER     PIC X(14) VALUE "1343D06060    ".
003050         10  FILLER     PIC X(14) VALUE "1443D06060    ".
003080     05  RANGE-SPECS-3.
003090         10  FILLER     PIC X(14) VALUE "1350D06060E   ".
003100         10  FILLER     PIC X(14) VALUE "1357D02020IP  ".
003110     05  RANGE-SPECS-3-REDEF REDEFINES RANGE-SPECS-3.
003120         10  RANGE-SPEC-3  OCCURS 2 TIMES.
003130             15  FILLER     PIC X(9).
003140             15  OPTION     PIC 9   .
003150             15  ATTR1      PIC X(2).
003160             15  ATTR2      PIC X(2).
003270
           COPY "B0100.HLP".
        
           COPY "USERF.DTA".
           COPY "CNTLF.DTA".
           COPY "EXCNF.DTA".
           COPY "ORDHF.DTA".
           COPY "ORDLF.DTA".
           COPY "SCATF.DTA".
           COPY "STYLF.DTA".
           COPY "COLRF.DTA".
005570     COPY "LASRFORM.DTA".
004880     COPY "FAX.DTA".

           COPY "NCONSTANT.DTA".
           COPY "SCREEN.DTA".
           COPY "DATE.DTA".
           COPY "ERROR.DTA".
           COPY "STATUS.DTA".
121908     COPY "PRINT.DTA".
           COPY "LFPRF.DTA".
           COPY "PAUSE.DTA".
           COPY "SPCITEM.DTA".
110510     COPY "CENTER.DTA".

002040
006810 SCREEN SECTION.
006820     COPY "CONSTANT.SCR".
006830     COPY "SCRNINIT.SCR".
006840     COPY "ERRORFIL.SCR".
006850     COPY "PRINT.SCR".   
006850     COPY "PAUSE.SCR".   
       01 SCR-GET-DATE-QUES 
            VALUE "Enter date to print on invoices: " 
            CONTROL DSPL--CONTROL LINE 11 COLUMN 20.                 
007430 01 SCR-BAD-DATE PIC IS X(29) 
            FROM DATE-ERROR 
            CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
007390 01 SCR-PRINTING-MODE PIC IS X(30) FROM PRINTING-REPORT 
007440      CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-GET-PAYMENT-1 CONTROL DSPL--CONTROL.
            05 LINE  3 COLUMN  1 VALUE "Order".
            05 LINE  3 COLUMN 10 PIC IS X(6) FROM ORDH-ORDER-NO.
            05 LINE  5 COLUMN  1 VALUE "Customer".
            05 LINE  5 COLUMN 10 PIC IS X(30) FROM ORDH-CUST-NAME.
            05 LINE  6 COLUMN 10 PIC IS X(30) FROM ORDH-CUST-ADDR1.
            05 LINE  7 COLUMN 10 PIC IS X(30) FROM ORDH-CUST-ADDR2.
            05 LINE  8 COLUMN 10 PIC IS X(18) FROM ORDH-CUST-CITY.
            05 LINE  8 COLUMN 29 PIC IS X(02) FROM ORDH-CUST-STATE.
            05 LINE  8 COLUMN 32 PIC IS X(10) FROM ORDH-CUST-ZIP.
       01 SCR-GET-PAYMENT-2 CONTROL DSPL--CONTROL.
            05 LINE 10 COLUMN  5 PIC IS X(51) FROM POS-1.
            05 LINE 11 COLUMN  5 PIC IS X(30) FROM POS-2.
            05 LINE 12 COLUMN  5 PIC IS X(30) FROM POS-3.
            05 LINE 13 COLUMN  5 PIC IS X(30) FROM POS-4.
            05 LINE 14 COLUMN  5 PIC IS X(30) FROM POS-5.
            05 LINE 15 COLUMN  5 PIC IS X(30) FROM POS-6.
       01 SCR-GET-PAYMENT-3 CONTROL DSPL--CONTROL.
            05 LINE 12 COLUMN 44 PIC IS X(15) FROM POS-7.
       01 SCR-GET-PAYMENT-4 CONTROL DSPL--CONTROL.
            05 LINE 12 COLUMN 41 VALUE " " SIZE IS 40.
       01 SCR-GET-PAYMENT-5 CONTROL DSPL--CONTROL.
            05 LINE 13 COLUMN 44 PIC IS X(28) FROM POS-8.
            05 LINE 21 COLUMN 20 SIZE IS 33 
               VALUE "Press ENTER to print the invoice.".
       01 SCR-GET-PAYMENT-6 CONTROL DSPL--CONTROL.
            05 LINE 13 COLUMN 41 SIZE IS 40 VALUE IS " ".
            05 LINE 21 COLUMN  1 SIZE IS 80 VALUE IS " ".
       01 SCR-RANGE-MSG CONTROL DSPL--CONTROL 
            LINE 11 COLUMN 20 SIZE IS 21 VALUE "Do you want to print?".
       01 SCR-RANGE-LIMITS CONTROL DSPL--CONTROL. 
            05 LINE 13 COLUMN 20 SIZE IS 16 VALUE "First to print -".
            05 LINE 14 COLUMN 20 SIZE IS 16 VALUE "Last  to print -".
       01 SCR-RANGE-ERR-1 CONTROL DSPL--CONTROL
            LINE 21 COLUMN 1 REVERSE-VIDEO VALUE 
            " That is an invalid range, please try another. ".
       01 SCR-RANGE-ERR-2 CONTROL DSPL--CONTROL
            LINE 21 COLUMN 1 REVERSE-VIDEO VALUE
            " There are none in this range, please try another. ".
       01 SCR-RANGE-ERR-3 CONTROL DSPL--CONTROL
            LINE 21 COLUMN 1 REVERSE-VIDEO VALUE
            " This order does not exist, please try another. ".
       01 SCR-RANGE-ERR-4 CONTROL DSPL--CONTROL
            LINE 21 COLUMN 1 REVERSE-VIDEO VALUE
       " This order is not released to be billed, please try another. ".
       01 SCR-NOT-OPEN-ORDER-MSG CONTROL DSPL--CONTROL
            LINE 21 COLUMN 1 REVERSE-VIDEO VALUE
            " This is not an Open Order, please try another. ".
       01 SCR-SELECT-QUES LINE 13 COLUMN 25 SIZE IS 30 VALUE
            "Order Number to print:".
       01 SCR-SELECT-QUES-DASH LINE 13 COLUMN 56 SIZE IS 1 VALUE
            "-".

008220 PROCEDURE DIVISION.
008230 DECLARATIVES.
008360     COPY "USERF.DS".
008360     COPY "CNTLF.DS".
008360     COPY "EXCNF.DS".
008360     COPY "ORDHF.DS".
008360     COPY "ORDLF.DS".
008360     COPY "SCATF.DS".
008360     COPY "STYLF.DS".
008360     COPY "COLRF.DS".
008240
008400     GO TO STATUS-EXIT.
008410
008420     COPY "ERRORFIL.SR".
008440 STATUS-EXIT. EXIT.
008450
008460 END DECLARATIVES.
008470
008480 MAIN-PROG SECTION.
008500     PERFORM String-USERF-Path.
008510     PERFORM PGM-INIT.
           COMPUTE GROUPS-AT-HEADER = FUNCTION LENG (GROUP-HEADER) /
               FUNCTION LENG (GROUP-HEADER-LINE) - 1.
           COMPUTE PAGE-SIZE = FUNCTION LENG (APP-ITEMS) /
               FUNCTION LENG (APP-ITEMS-LINE).
           MOVE USER-SN TO M-USERS.
008520     IF M-USER
008530        MOVE USER-SN TO WS-CUSTOMIZED-FLAG
008550        MOVE "B0100XPAM" TO PROG-NAME
           END-IF.
008560     IF PROCESS-HISTORY-YES
008570        MOVE "ORDHSTH.FIL" TO ORDHF--NAME
008580        MOVE "ORDHSTL.FIL" TO ORDLF--NAME
026050        PERFORM String-ORDHF-Path
026050        PERFORM String-ORDLF-Path
           END-IF.
           PERFORM OPEN-FILES.
           PERFORM LFPRF-INIT.
           MOVE "INVOICE" TO LFPR-FORM-TO-PRINT.
008690     PERFORM SCREEN-INIT.
           PERFORM ASK-COPIES THRU ASK-COPIES-EXIT.
011870     IF FLAG = 4 OR 3
011880        GO TO EXIT-RUN.
      *    PERFORM LFPR-START-COPY-4-FORM.

       BEGIN-REPORT.
008710     MOVE ZERO TO ORDH-SUB-ORDER-NO.

008720     IF SINGLE-INVOICE
008730         PERFORM SINGLE-INVOICING
008740         GO TO END-REPORT
           END-IF.

008760     MOVE ZERO TO INV-DATE, DATE-IN.
008780     IF INVOICE-FORM
008790        PERFORM GET-INV-DATE
008800     ELSE
              PERFORM GET-TODAY-DATE
           END-IF.
008840     IF FLAG = 4 GO TO EXIT-RUN.

008850     PERFORM RANGE-SELECT.
008860     IF FLAG = 3
008870        IF ACK-FORM
008880           GO TO EXIT-RUN
008890        ELSE
008900           GO TO BEGIN-REPORT
              END-IF
           END-IF.

009110     MOVE SPACES TO ORDHF-REC, ORDLF-REC.
009120     PERFORM SCREEN-INIT.
           DISPLAY SCR-PRINTING-MODE.
009140     IF ESC-FLAG     MOVE "0010000000" TO FKEYS
009150                ELSE MOVE "0000000000" TO FKEYS.
009160     MOVE 1 TO FLAG.
009170     CALL "KBDCHK" USING FLAG, FKEYS.
009180     MOVE 0 TO FLAG.
009190     IF OPTION OF RANGE-SPECS-1 = 3
009200       PERFORM SELECTIVE-ORDER UNTIL FLAG = 3
009230       MOVE ZERO TO FLAG
009240       GO TO BEGIN-REPORT
           ELSE
009250       PERFORM PROCESS-REPORT
           END-IF.
009280 END-REPORT.
009320     PERFORM CLOSE-FILES.
009270
009340 EXIT-RUN.
009350     IF SINGLE-INVOICE
009360         MOVE "B0000" TO NEXT-PROG.
009390     IF LAST-OPTION = 020401
009400        MOVE "SM030" TO NEXT-PROG
009410     ELSE
009420     IF LAST-OPTION = 040103
009430        MOVE "B0025" TO NEXT-PROG.
009440     COPY "FINISH.SR".
009450     COPY "CONTROL.SR".
009460     COPY "DATECVT.SR".
009470     COPY "DATECHK.SR".
009480     COPY "CLRUSERF.SR".
010180     COPY "SCRNINIT.SR".
010180     COPY "PRINT.SR".
           COPY "ASKCOPY.SR".
           COPY "PAUSE.SR".
110510     COPY "CENTER.SR".
009490
009500 SUBROUTINE SECTION.
009510 PGM-INIT.
           MOVE ALL "0" TO MODE-SWITCHES.
009520     PERFORM CONTROL-INIT.
009550     CLOSE CNTLF.
009560     OPEN I-O CNTLF.
009590     READ CNTLF NO LOCK.
           PERFORM SET-INVOICE-FORM-MODE.
           EVALUATE LAST-OPTION
           WHEN 020101
              MOVE USER-POS-ORDER TO ORDER-NUMBER
              SET SINGLE-INVOICE TO TRUE
           WHEN 020102
              PERFORM SET-ACK-FORM-MODE
           WHEN 020103
              SET NOT-OPEN-ORDERS TO TRUE
           WHEN 020204
              MOVE USER-POS-ORDER TO ORDER-NUMBER
              SET OPEN-ORDERS TO TRUE
              SET SINGLE-INVOICE TO TRUE
           WHEN 020401
009640        MOVE USER-POS-ORDER TO ORDER-NUMBER
009650        IF NOT USER-INVOICING
                  SET OPEN-ORDERS TO TRUE
              END-IF
              SET SINGLE-INVOICE TO TRUE
           WHEN 020602
              SET PROCESS-HISTORY-YES TO TRUE
009750        MOVE NORM-ATTR TO ATTR1 OF RANGE-SPEC-3(1),
009760                          ATTR1 OF RANGE-SPEC-3(2)
              SET OPEN-ORDERS TO TRUE
           WHEN OTHER
              SET OPEN-ORDERS TO TRUE
           END-EVALUATE.
110510     MOVE 40 TO SOURCE-LEN.
110510     MOVE CNTL-CONAME TO SOURCE-FIELD.
110510     PERFORM LEFT-JUST-FIELD THRU LEFT-JUST-FIELD-EXIT.
110510     MOVE DEST-FIELD TO PR-CONAME-LEFT.
009770     OPEN INPUT EXCNF.
009780     READ EXCNF.
009790     CLOSE EXCNF.
           SET ESC-FLAG TO TRUE.
008560     IF OPEN-ORDERS
008570        MOVE "OPENHDR.FIL" TO ORDHF--NAME
008580        MOVE "OPENLINE.FIL" TO ORDLF--NAME
026050        PERFORM String-ORDHF-Path
026050        PERFORM String-ORDLF-Path
           END-IF.
              
       SET-ACK-FORM-MODE.
              SET ACK-FORM TO TRUE
009720        MOVE "Printing Acknowledgements" TO PRINTING-REPORT.

       SET-INVOICE-FORM-MODE.
              SET INVOICE-FORM TO TRUE
002790        MOVE "Printing Invoices." TO PRINTING-REPORT.

023140 SINGLE-INVOICING SECTION.
023150 SINGLE-INVOICING-START.
023280     MOVE TODAYS-DATE TO INV-DATE.
023290     MOVE INV-DATE TO DATE-IN.
023300     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
023310     MOVE DATE-OUT-11 TO WS-INV-DATE.
023320     PERFORM SCREEN-INIT.
023330     MOVE ORDER-NUMBER TO ORDH-ORDER-NO.
023340     PERFORM READ-ORDHF.
023350     IF ORDHF-STATUS = NOT-FOUND
023360         DISPLAY SCR-RANGE-ERR-3   
023370         GO TO SINGLE-INVOICING-EXIT
           END-IF.
023380     IF NOT POS-INVOICING OR ACK-FORM
023390         DISPLAY SCR-PRINTING-MODE  
           ELSE
               SET ACCUM-TOTALS TO TRUE
023410         PERFORM PRINT-INVOICE
023420         PERFORM GET-PAYMENT
023430         IF FLAG = 3
023440             GO TO SINGLE-INVOICING-EXIT
               END-IF
           END-IF.
           SET NO-ACCUM-TOTALS TO TRUE.
023460     MOVE LOW-VALUES TO WS-OLD-STYLE.
023470     MOVE SPACES TO HOLD-DATA1.
023480     PERFORM PRINT-INVOICE.
023490 SINGLE-INVOICING-EXIT. EXIT.
023500
023510 GET-PAYMENT SECTION.
023520 GET-PAYMENT-START.
023530     PERFORM SCREEN-INIT.
023540     DISPLAY SCR-GET-PAYMENT-1. 
023640     MOVE ORDH-NET-AMT TO PR-NET-AMT.
023650     MOVE ORDH-FREIGHT-AMT TO PR-FREIGHT-AMT.
023660     MOVE ORDH-SPCHG-AMT TO PR-SPCHG-AMT.
023670     COMPUTE PR-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT.
023680     MOVE ORDH-TAX-AMT TO PR-TAX-AMT.
023690     MOVE ORDH-INV-AMT TO PR-INV-AMT.
023540     DISPLAY SCR-GET-PAYMENT-2. 
023770     MOVE ORDH-PMT-CD TO OPTION OF TYPE-SPEC.
023780 GET-PAYMENT-TYPE.
023790     MOVE "1010000000" TO FKEYS.
023800     MOVE 0 TO FLAG.
023820     CALL "SCRN01" USING FLAG, FKEYS, TYPE-SPEC, TYPE-HELP, 
                               PMT-CODES.
023850     IF FLAG = 3
023860         GO TO GET-PAYMENT-EXIT
           END-IF.
023870     MOVE OPTION OF TYPE-SPEC TO ORDH-POS-CD.
023880     IF ORDH-POS-CD = 1
023890         GO TO GET-PAYMENT-EXIT
           END-IF.
           DISPLAY SCR-GET-PAYMENT-3.
023910     IF ORDH-DEP-AMT NOT = 0
023920         MOVE ORDH-DEP-AMT TO PMT-AMT
023930     ELSE 
               MOVE ORDH-INV-AMT TO PMT-AMT
           END-IF.
023940 GET-PAYMENT-AMOUNT.
023950     MOVE "1010000000" TO FKEYS.
023960     MOVE 0 TO FLAG.
023980     CALL "SCRN01" USING FLAG, FKEYS, PMT-SPEC, PMT-HELP,
023990       PMT-AMT.
024010     IF FLAG = 3
024020         DISPLAY SCR-GET-PAYMENT-4   
024030         GO TO GET-PAYMENT-TYPE
           END-IF.
024040     IF ORDH-POS-CD NOT = 2
024050         GO TO GET-PAYMENT-DONE
           END-IF.
024060     IF PMT-AMT > ORDH-INV-AMT
024070         MOVE "Change" TO PR-CHANGE-MSG
024080         COMPUTE PR-CHANGE-AMT = PMT-AMT - ORDH-INV-AMT
024090     ELSE 
               MOVE "Balance Due" TO PR-CHANGE-MSG
024100         COMPUTE PR-CHANGE-AMT = ORDH-INV-AMT - PMT-AMT
           END-IF.

           DISPLAY SCR-GET-PAYMENT-5.
024140     MOVE "1010000000" TO FKEYS.
024150     MOVE 0 TO FLAG.
024170     CALL "SCRN01" USING FLAG, FKEYS, INPUT-SPECS-1,
024180       PRINT-HELP, INVIS-OPTION.
024200     IF FLAG = 3
               DISPLAY SCR-GET-PAYMENT-6
024240         GO TO GET-PAYMENT-AMOUNT
           END-IF.
024250 GET-PAYMENT-DONE.
024260     IF PMT-AMT > ORDH-INV-AMT
024270         MOVE ORDH-INV-AMT TO ORDH-DEP-AMT
024280     ELSE 
               MOVE PMT-AMT TO ORDH-DEP-AMT
           END-IF.
024290 GET-PAYMENT-EXIT. EXIT.
024300

012100 RANGE-SELECT SECTION.
012110 GET-RANGE.
012120     PERFORM SCREEN-INIT.
012130     MOVE "1010000000" TO FKEYS.
012140     MOVE 0 TO FLAG.
012150     IF PROCESS-HISTORY-YES
012160        MOVE 3 TO OPTION OF RANGE-SPECS-1
012170     ELSE
              DISPlAY SCR-RANGE-MSG
012200        CALL "SCRN01" USING FLAG, FKEYS, RANGE-SPECS-1,
012210          HELP1, RANGE-CODES
           END-IF.
012230     IF FLAG = 3 GO TO RANGE-SELECT-EXIT.
012240     IF OPTION OF RANGE-SPECS-1 = 1
012250          MOVE LOW-VALUES TO LOW-KEY
012260          MOVE HIGH-VALUES TO HIGH-KEY
012270          GO TO RANGE-SELECT-EXIT
           END-IF.
012280     IF OPTION OF RANGE-SPECS-1 = 3
012290          GO TO RANGE-SELECT-EXIT
           END-IF.
           DISPLAY SCR-RANGE-LIMITS.
012350 GET-LOW-HIGH.
012360     MOVE "1010000000" TO FKEYS.
012370     MOVE 0 TO FLAG.
012390     CALL "SCRN02" USING FLAG, FKEYS, RANGE-SPECS-2,
012400       HELP2, LOW-KEY, HIGH-KEY.
012420     IF FLAG = 3 GO TO GET-RANGE.
012430     IF LOW-KEY > HIGH-KEY
012440         DISPLAY SCR-RANGE-ERR-1   
012450         GO TO GET-LOW-HIGH
           END-IF.
012460     PERFORM START-ORDHF.
012470     IF C-AT-END OF ORDHF-STATUS
012480         DISPLAY SCR-RANGE-ERR-2   
012490         GO TO GET-LOW-HIGH.
012500     GO TO RANGE-SELECT-EXIT.
012520 RANGE-SELECT-EXIT. EXIT.

012540 SELECTIVE-ORDER SECTION.
012550 SELECTIVE-ORDERS.
           DISPLAY SCR-SELECT-QUES.
012570     IF PROCESS-HISTORY-YES
012580        MOVE 1 TO SUB-ORDER-NO
012590        DISPLAY SCR-SELECT-QUES-DASH
           END-IF.
012600     MOVE "1010000010" TO FKEYS.
012610     MOVE 0 TO FLAG.
012630     CALL "SCRN02" USING FLAG, FKEYS, RANGE-SPECS-3,
012640       HELP3, ORDER-NUMBER, SUB-ORDER-NO.
012670     IF FLAG = 3 GO TO SELECTIVE-ORDER-EXIT.
012680     IF FLAG = 9 GO TO END-REPORT.
012690     IF ORDER-NUMBER = 0 GO TO SELECTIVE-ORDERS.
012700     MOVE ORDER-NUMBER TO ORDH-ORDER-NO.
012710     MOVE SUB-ORDER-NO TO ORDH-SUB-ORDER-NO.
012720     PERFORM READ-ORDHF.
012730     IF ORDHF-STATUS = NOT-FOUND
               DISPLAY SCR-RANGE-ERR-3
               GO TO SELECTIVE-ORDER-EXIT
           END-IF.
012750     IF OPEN-ORDER
012760        IF ACK-FORM
012770            PERFORM PRINT-INVOICE
012780        ELSE
012790            DISPLAY SCR-RANGE-ERR-4   
              END-IF
012800     ELSE
012810        IF ACK-FORM
012820            DISPLAY SCR-NOT-OPEN-ORDER-MSG   
012830        ELSE 
                  PERFORM PRINT-INVOICE
              END-IF
           END-IF.
012860 SELECTIVE-ORDER-EXIT. EXIT.

012880 PROCESS-REPORT SECTION.
012890 PROCESS-REPORT-BEGIN.
012900     PERFORM START-ORDHF.
012910     IF NOT C-AT-END OF ORDHF-STATUS
012920         PERFORM  READ-ORDHF-NEXT.
012930
012940 PROCESS-REPORT-NEXT.
012950     IF C-AT-END OF ORDHF-STATUS
012960         GO TO PROCESS-REPORT-EXIT.
012970     IF ORDH-ORDER-NO > HIGH-KEY
012980         GO TO PROCESS-REPORT-EXIT.
012990     IF (OPEN-ORDER AND NOT ACK-FORM) OR
013000        (INVOICE    AND ACK-FORM) OR
013010        ORDH-POS-CD NOT = ZERO
013020         GO TO PROCESS-REPORT-READ.
013030     IF PROCESS-HISTORY-YES
013040        MOVE ORDH-INV-DATE TO DATE-IN
013050        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
013060        MOVE DATE-OUT-11 TO WS-INV-DATE.
013070     IF OPTION OF RANGE-SPECS-1 = 1
013090        IF ORDH-PRINT-CD = 1
013100           GO TO PROCESS-REPORT-READ.
013110     PERFORM PRINT-INVOICE.
013120 PROCESS-REPORT-READ.
013130     IF ESC-FLAG
013140         CALL "KBDCHK" USING FLAG, FKEYS
013150         IF FLAG = 3
013160            PERFORM ACCEPT-PAUSE
013170            IF PAUSE-CANCEL
013180               MOVE 3 TO FLAG
013190               GO TO PROCESS-REPORT-EXIT
           END-IF.
013200     PERFORM  READ-ORDHF-NEXT.
013210     GO TO PROCESS-REPORT-NEXT.
013220
013230 PROCESS-REPORT-EXIT. EXIT.

013250 PRINT-REPORT SECTION.
       INC-LINE-NO.
           ADD 1 TO LINE-NO.
013310     PERFORM PAGE-CHECK.
013320**   IF LINE-NO = 0 AND HEADERS-AT-BODY
               PERFORM STYLE-PRT-TEST
      **   END-IF.

013260 PRINT-DETAIL.
           PERFORM INC-LINE-NO.

       PRINT-REPORT-DETAIL.
           PERFORM INC-LINE-NO.
013380
013390 PRINT-SUB-TOTALS.
013450     MOVE 1 TO SUB-LINES.
013470     IF ORDH-TAX-AMT NOT = 0
013480         ADD 2 TO SUB-LINES
           END-IF.
013490     IF ORDH-DEP-AMT NOT = 0
013500         ADD 2 TO SUB-LINES
           END-IF.
013510     IF LINE-NO + SUB-LINES > PAGE-SIZE
               PERFORM PAGE-EJECT
           END-IF.
013580     PERFORM UNTIL LINE-NO + SUB-LINES + 1 >= PAGE-SIZE
               PERFORM INC-LINE-NO
           END-PERFORM. 
013830     IF ORDH-TAX-AMT NOT = 0
013840         MOVE "SUB-TOTAL:" TO PR-SB-DESC(LINE-NO)
013850         COMPUTE PR-SB-AMT(LINE-NO)= ORDH-INV-AMT - ORDH-TAX-AMT
               PERFORM INC-LINE-NO
013930         MOVE "TAXES:" TO PR-SB-DESC(LINE-NO)
013940         MOVE ORDH-TAX-AMT TO PR-SB-AMT(LINE-NO)
               PERFORM INC-LINE-NO
           END-IF.
014020     IF ORDH-DEP-AMT NOT = 0
014030         MOVE "INVOICE AMT:" TO PR-SB-DESC(LINE-NO)
014040         MOVE ORDH-INV-AMT TO PR-SB-AMT(LINE-NO)
               PERFORM INC-LINE-NO
014120         MOVE "LESS DEPOSIT:" TO PR-SB-DESC(LINE-NO)
014130         MOVE ORDH-DEP-AMT TO PR-SB-AMT(LINE-NO)
               PERFORM INC-LINE-NO
           END-IF.
013610     IF ORDER-COMPLETE
013620       MOVE CNTL-ORD-COMPLETE-MSG TO PR-COMPLETE-MSG(LINE-NO)
013630     ELSE 
             MOVE CNTL-ORD-NOT-COMPLETE-MSG TO PR-COMPLETE-MSG(LINE-NO)
           END-IF.
013640     IF CLASSICH
013650        IF DOZ-ORDERED = ZERO AND DOZ-SHIPPED = ZERO
013660           MOVE SPACES TO PR-DOZEN-MSG(LINE-NO)
013670        ELSE
013680           MOVE DOZ-SHIPPED  TO PR-DOZ-SHIPPED
013690           MOVE " / "        TO PR-DOZ-SLASH
013700           MOVE DOZ-ORDERED  TO PR-DOZ-ORDERED
013710           MOVE WS-DOZEN-MSG TO PR-DOZEN-MSG(LINE-NO)
           END-IF.
           PERFORM INC-LINE-NO.
014210*    MOVE PAGE-SIZE TO LINE-NO.

014290 PRINT-TOTALS.
014310     IF ORDH-DEP-AMT NOT = 0 OR ORDH-TAX-AMT NOT = 0
014320        OR CNTL-ORD-COMPLETE-MSG NOT = SPACES
014330        OR CNTL-ORD-NOT-COMPLETE-MSG NOT = SPACES
014340         PERFORM PRINT-SUB-TOTALS
           END-IF.

014850 PAGE-CHECK.
014860     IF LINE-NO > PAGE-SIZE
               PERFORM PAGE-EJECT
           END-IF.
       
015000 PAGE-EJECT.
           MOVE "PAGE" TO PFRPT-GROUP.
      *    IF LINE-NO > 1 AND APP-ITEMS
           MOVE 0 TO I.
           INSPECT APP-ITEMS TALLYING I FOR
               ALL SPACE ALL LOW-VALUE ALL "@" ALL "0".
           IF  FUNCTION LENG (APP-ITEMS) NOT = I
              WRITE INVAPP
           END-IF.
           INITIALIZE INVAPP.
           PERFORM INIT-LINE-NO.
           PERFORM PRINT-REPORT-HEADERS.

       INIT-LINE-NO.
           MOVE 1 TO LINE-NO.

015070 PRINT-REPORT-EXIT. EXIT.

015090 PRINT-INVOICE SECTION.
015100 PRINT-INVOICE-START.
015110     IF NOT PROCESS-HISTORY-YES 
            IF ORDH-INV-NO = 0 AND NOT (SINGLE-INVOICE AND ACCUM-TOTALS)
015130          PERFORM GET-INV-NUMBER
            END-IF
015150      IF NOT (SINGLE-INVOICE AND ACCUM-TOTALS) AND
015160         ORDH-PRINT-ONCE-CD = 1 AND REPRINT-INVOICE
015170         ADD 1 TO ORDH-REPRINT-SEQ
015180         PERFORM REWRITE-ORDHF
            END-IF
015200      IF INVOICE-FORM
015210          MOVE 1 TO ORDH-PRINT-CD
015220          MOVE INV-DATE TO ORDH-INV-DATE
            END-IF
           END-IF.
015250     PERFORM SCAN-INVOICE.
           PERFORM LFPR-START-COPY-4-FORM.
       COPY-LOOP.
           IF NO-ACCUM-TOTALS
               PERFORM BEFORELOOPEN
               IF LFPR-NO-MORE-COPY
                   GO TO PRINT-INVOICE-EXIT
               END-IF
009000         PERFORM OPEN-LO-LASER
               INITIALIZE INVAPP
               MOVE "PAGE" TO PFRPT-GROUP
           END-IF.
015260     IF NOT (SINGLE-INVOICE AND ACCUM-TOTALS)
015270         PERFORM PRINT-REPORT-HEADERS
           END-IF.
015280     MOVE 0 TO ORDH-NET-AMT, ORDH-COST-AMT, ORDH-FREIGHT-AMT,
015290       ORDH-SPCHG-AMT, ORDH-DISC-AMT, ORDH-COMM-AMT.
015300     MOVE SPACES TO SPC-ITEM-NO.
015310     PERFORM INIT-LINE-NO.
015320 PASS-LOOP.
015330     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
015340     MOVE 0 TO ORDL-SEQ-NO.
015350     PERFORM START-ORDLF-GREATER.
015360     IF NOT C-AT-END OF ORDLF-STATUS
015370         PERFORM READ-ORDLF-NEXT-SCAN
           END-IF.
015380     IF NOT C-AT-END OF ORDLF-STATUS
015390        MOVE ORDLF-DATA1 TO HOLD-DATA1
015400     ELSE 
              MOVE SPACES TO HOLD-DATA1
           END-IF.
           PERFORM VARYING I FROM 1 BY 1 UNTIL I>255
               MOVE ZERO TO COLOR-QTY-L(I)
           END-PERFORM.
015410     MOVE ZERO TO TOTAL-QTY.
015450     MOVE ZERO TO DOZ-SHIPPED, DOZ-ORDERED.
015460     MOVE 0 TO WS-HOLD-EXT-AMT.
015470     PERFORM MOVE-DETAIL THRU MOVE-DETAIL-END
015480         UNTIL C-AT-END OF ORDLF-STATUS.
015490     IF NOT HOLD-SZ-NOTAPPAREL
015500        PERFORM STYLE-BREAK
           END-IF.
015510*    IF (INVOICE-APP-80-NO-STYLE OR INVOICE-APP-132-NO-STYLE)
015520*       GO TO SKIP-MULT-PASSES
      *    END-IF.
015530     IF NOT ACCUM-TOTALS
             IF WS-GROUPS-FOUND > WS-PASS-NO * GROUPS-AT-HEADER
               ADD 1 TO WS-PASS-NO
               PERFORM PAGE-EJECT
               GO TO PASS-LOOP
             END-IF
           END-IF. 
015650 SKIP-MULT-PASSES.
015660     IF MARK-DOWNS
015670         COMPUTE ORDH-GROSS-AMT = ORDH-NET-AMT + ORDH-DISC-AMT
015680     ELSE 
               COMPUTE ORDH-GROSS-AMT = ORDH-NET-AMT - ORDH-DISC-AMT
           END-IF.
015690     MOVE ZEROES TO TOT-TAX-AMT, DIFF-TAX.
015700     PERFORM CALC-TAX-TOTALS
015710         VARYING I FROM 1 BY 1 UNTIL I > 3.
015720     IF NOT MANUAL-TAX-ENTRY
015730         COMPUTE ORDH-TAX-AMT ROUNDED =
015740             TAX-RND(1) + TAX-RND(2) + TAX-RND(3)
015750     ELSE
015760         IF ORDH-TAX-AMT = 0
015770             COMPUTE ORDH-TAX-AMT ROUNDED =
015780                 TAX-RND(1) + TAX-RND(2) + TAX-RND(3)
               END-IF
           END-IF.
015790     COMPUTE TOT-TAX-AMT = TAX-AMT(1) + TAX-AMT(2) + TAX-AMT(3).
015800     COMPUTE DIFF-TAX = ORDH-TAX-AMT - TOT-TAX-AMT.
015700     PERFORM VARYING I FROM 1 BY 1 UNTIL I > 3
015810       IF TEMP-TAXABLE(I) NOT = ZEROES
015880         ADD DIFF-TAX TO TAX-AMT(I)
015890         MOVE ZEROES TO DIFF-TAX, TEMP-TAXABLE(I)
             END-IF
           END-PERFORM.
015900     COMPUTE ORDH-INV-AMT = ORDH-NET-AMT + ORDH-SPCHG-AMT +
015910       ORDH-FREIGHT-AMT + ORDH-TAX-AMT.
015920     IF ORDH-POS-CD = 0
015930         IF ORDH-DEP-AMT = 0 AND ORDH-PMT-CD = 2
015940             MOVE ORDH-INV-AMT TO ORDH-DEP-AMT
               END-IF
           END-IF.
015950     IF CREDIT-MEMO
015960         MOVE 0 TO ORDH-CSHDISC-AMT
015970     ELSE 
               COMPUTE ORDH-CSHDISC-AMT ROUNDED =
015980            ORDH-NET-AMT * EXCN-TERM-PCT(ORDH-TERM-CD) / 100.00000
015990             ON SIZE ERROR MOVE ZERO TO ORDH-CSHDISC-AMT 
016000          END-COMPUTE
           END-IF.
016010     IF NOT (SINGLE-INVOICE AND ACCUM-TOTALS)
016020         MOVE 1 TO ORDH-PRINT-ONCE-CD
016030         PERFORM MOVE-TOTALS
016040         IF INVOICE-FORM
016050            PERFORM REWRITE-ORDHF
               END-IF
           END-IF.
016060     GO TO PRINT-INVOICE-EXIT.
016070
016080 CALC-TAX-TOTALS.
016090     COMPUTE TAX-AMT(I) ROUNDED, TAX-RND(I) ROUNDED =
016100         TAXABLE(I) * ORDH-TAX-PCT(I) / 100.00000 ON SIZE ERROR 
016110         MOVE ZERO TO TAX-AMT(I) TAX-RND(I) END-COMPUTE.
016120     MOVE TAXABLE(I) TO TEMP-TAXABLE(I).
016130     MOVE 0 TO TAXABLE(I).
016140
016150 PRINT-INVOICE-EXIT. 
           IF LO-OPENED
               WRITE INVAPP
009210         PERFORM CLOSE-LO
               GO TO COPY-LOOP
           END-IF.
           EXIT.
016160

016170 SCAN-INVOICE SECTION.
016180 SIS.
016190     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
016200     MOVE 0 TO ORDL-SEQ-NO.
016210     PERFORM START-ORDLF-GREATER.
           MOVE 0 TO WS-GROUPS-FOUND
016230     MOVE 1 TO WS-PASS-NO.
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > 255
              MOVE 0 TO WS-GROUP-IDX(I)
           END-PERFORM.
016240 SCAN-LOOP.
016250     IF NOT C-AT-END OF ORDLF-STATUS
016260         PERFORM READ-ORDLF-NEXT
           END-IF.
016270     IF NOT C-AT-END OF ORDLF-STATUS
016280         MOVE ORDL-STYLE TO STYLE-NUMBER
016290         PERFORM READ-STYLF
016300         IF NOT C-RECORD-OK OF STYLF-STATUS
016310             GO TO SCAN-LOOP
               END-IF
           END-IF.
016320     IF NOT C-AT-END OF ORDLF-STATUS
               IF WS-GROUP-IDX(STYLE-GROUP-NAME) = 0
                   ADD 1 TO WS-GROUPS-FOUND
                   MOVE STYLE-GROUP-NAME TO 
                      WS-SCAN-GROUP(WS-GROUPS-FOUND)
                   MOVE WS-GROUPS-FOUND TO 
                      WS-GROUP-IDX(STYLE-GROUP-NAME)
                   MOVE 0 TO WS-SCAN-SIZES(WS-GROUPS-FOUND)
                   PERFORM VARYING I FROM 1 BY 1 UNTIL I>255
                      MOVE 0 TO WS-SCAN-SIZES-LIST(WS-GROUPS-FOUND,I)
                      MOVE 0 TO WS-SCAN-SIZES-IDX (WS-GROUPS-FOUND,I)
                   END-PERFORM
               END-IF
               MOVE WS-GROUP-IDX(STYLE-GROUP-NAME) TO I
               MOVE ORDL-SIZE TO LOPT-X
               IF WS-SCAN-SIZES-LIST(I,LOPT-BIN) = 0
                   ADD 1 TO WS-SCAN-SIZES(I)
                   MOVE LOPT-BIN TO WS-SCAN-SIZES-IDX(
                      I,WS-SCAN-SIZES(I))
               END-IF
               ADD 1 TO WS-SCAN-SIZES-LIST(I,LOPT-BIN)
           END-IF.
016360     IF NOT C-AT-END OF ORDLF-STATUS
016370         GO TO SCAN-LOOP
016380     ELSE 
               GO TO END-SCAN
           END-IF.
016470 END-SCAN.
016510 SCAN-INVOICE-EXIT. EXIT.

016530 B0100-REPORT SECTION.
016540 MOVE-DETAIL.
016550     IF WS-OLD-STYLE = LOW-VALUES AND NOT HOLD-STYLE-COMMENT
016580           MOVE HOLD-STYLE TO WS-OLD-STYLE
           END-IF.
016590     IF C-AT-END OF ORDLF-STATUS
016600         PERFORM STYLE-BREAK
016610         GO TO MOVE-DETAIL-END
           END-IF.
016620     IF HOLD-STYLE NOT = ORDL-STYLE
016630        PERFORM STYLE-BREAK
           END-IF.
016640     IF NOT ACCUM-TOTALS AND NOT HOLD-STYLE-COMMENT AND 
                WS-OLD-STYLE NOT = HOLD-STYLE
016680             MOVE "TOTAL     " TO PR-STYLE-MSG(LINE-NO)
016690             MOVE HOLD-STYLE TO WS-OLD-STYLE
016700             PERFORM PRINT-STYLE-TOTALS
           END-IF.
016710     IF HOLD-CATEGORY NOT = ORDL-CATEGORY
016720        PERFORM CATEGORY-BREAK
           END-IF.
016730     IF HOLD-COLOR NOT = ORDL-COLOR OR
016740        HOLD-ITEM-PRICE NOT = ORDL-ITEM-PRICE
016750        PERFORM COLOR-BREAK
           END-IF.
016760     MOVE ORDLF-DATA1 TO HOLD-DATA1.
016770     IF CREDIT-MEMO
016780         COMPUTE HOLD-ORDER-QTY = HOLD-ORDER-QTY * -1
016790         COMPUTE HOLD-SHIP-QTY = HOLD-SHIP-QTY * -1
016800         COMPUTE HOLD-EXT-AMT = HOLD-EXT-AMT * -1
016810         COMPUTE HOLD-EXT-COST = HOLD-EXT-COST * -1
016820         COMPUTE ORDL-ORDER-QTY = ORDL-ORDER-QTY * -1
016830         COMPUTE ORDL-SHIP-QTY  = ORDL-SHIP-QTY * -1
016840         COMPUTE ORDL-EXT-AMT   = ORDL-EXT-AMT * -1
016850         COMPUTE ORDL-EXT-COST  = ORDL-EXT-COST * -1
           END-IF.
016860     IF NOT HOLD-SZ-NOTAPPAREL
016870        PERFORM ADD-SIZE
016880     ELSE
016890        PERFORM PROCESS-STD-ITEM
           END-IF.
016900     IF ORDL-BO-QTY > 0 
               SET ORDER-NOT-COMPLETE TO TRUE
           END-IF.
016910 MOVE-DETAIL-END.
016920     IF NOT C-AT-END OF ORDLF-STATUS
016930         PERFORM READ-ORDLF-NEXT-SCAN
           END-IF.
016940     IF NOT C-AT-END OF ORDLF-STATUS
016950        IF NOT HOLD-SZ-NOTAPPAREL
016960           NEXT SENTENCE
016970        ELSE
016980           MOVE ORDLF-DATA1 TO HOLD-DATA1
              END-IF
           END-IF.
016990
017000 ADD-SIZE.
           MOVE HOLD-SIZE TO LOPT-X
017010     IF ACK-FORM
017020        MOVE HOLD-ORDER-QTY TO COLOR-QTY-L(LOPT-BIN)
017030     ELSE
017040        ADD HOLD-SHIP-QTY TO COLOR-QTY-L(LOPT-BIN)
           END-IF.
017050     IF CLASSICH
017060        ADD HOLD-ORDER-QTY   TO DOZ-ORDERED
017070        ADD HOLD-SHIP-QTY    TO DOZ-SHIPPED
           END-IF.
017080     PERFORM CALC-HOLD-EXT-AMT.
017100     MOVE HOLD-ITEM-DESC  TO PR-ITEM-DESC(LINE-NO).
             
017120 COLOR-BREAK.
017130     MOVE HOLD-STYLE TO PR-STYLE(LINE-NO).
017140     MOVE HOLD-COLOR TO PR-COLOR(LINE-NO).
017150     MOVE HOLD-STYLE TO STYLF-KEY.
017160     PERFORM READ-STYLF.
017170     IF C-RECORD-OK OF STYLF-STATUS
071409        MOVE STYLE-GROUP-NAME TO SCAT-GROUP-NBR
071409        MOVE HOLD-CATEGORY TO SCAT-CAT-NUM
071409        PERFORM READ-SCAT-GC
              MOVE SCAT-CAT TO PR-CATEGORY(LINE-NO)
017200        MOVE STYLE-GROUP-NAME TO PR-GROUP(LINE-NO)
017210        PERFORM STYLE-PRT-TEST
              MOVE ZERO TO TOTAL-QTY
              PERFORM VARYING I FROM 1 BY 1 UNTIL I>255
                 ADD COLOR-QTY-L(I) TO TOTAL-QTY
              END-PERFORM
017260        IF NOT ACCUM-TOTALS
017270          ADD TOTAL-QTY TO WS-STYLE-TOTAL-QTY,
017280            WS-STYLE-TOTAL-QTY-TOT
              END-IF
           END-IF.
           MOVE WS-GROUP-IDX(STYLE-GROUP-NAME) TO CNT.
           PERFORM VARYING I FROM 1 BY 1 UNTIL I>9
                OR I > WS-SCAN-SIZES(CNT)
              MOVE COLOR-QTY-L(WS-SCAN-SIZES-IDX(CNT,I)) TO
                WS-COLOR-QTY
              EVALUATE TRUE
              WHEN NO-DECIMALS
                 MOVE WS-COLOR-QTY TO F-PR-QTY
              WHEN ONE-DECIMAL
                 MOVE WS-COLOR-QTY TO F-PR-QTY-1
              WHEN TWO-DECIMALS
                 MOVE WS-COLOR-QTY TO F-PR-QTY-2
              WHEN THREE-DECIMALS
                 MOVE WS-COLOR-QTY TO F-PR-QTY-3
              WHEN FOUR-DECIMALS
                 MOVE WS-COLOR-QTY TO F-PR-QTY-4
              WHEN OTHER
                 MOVE WS-COLOR-QTY TO F-PR-QTY-5
              END-EVALUATE
              MOVE FMT-PR-QTY TO PR-QTY(LINE-NO,I)
           END-PERFORM.
017930     PERFORM PROCESS-STYLE.
017940     MOVE ORDLF-DATA1 TO HOLD-DATA1.
           MOVE ZERO TO TOTAL-QTY.
           PERFORM VARYING I FROM 1 BY 1 UNTIL I>255
              MOVE ZERO TO COLOR-QTY-L(I)
           END-PERFORM.

017970 STYLE-PRT-TEST.
018000     IF NOT ACCUM-TOTALS AND HEADER-AT-BODY AND
               (STYLE-GROUP-NAME NOT = WS-SAVE-GROUP OR LINE-NO = 0)
018000* do nothing todo todo        todo todo
           END-IF.

018100 CATEGORY-BREAK.
018110     PERFORM COLOR-BREAK.
018120     MOVE ORDL-CATEGORY TO HOLD-CATEGORY.
018130
018140 STYLE-BREAK.
018150     PERFORM CATEGORY-BREAK.
018160     MOVE ORDL-STYLE TO HOLD-STYLE.
018170
018180     IF NOT ACCUM-TOTALS AND C-AT-END OF ORDLF-STATUS
              IF WS-STYLE-TOTAL-QTY NOT = 0
                 MOVE "TOTAL     " TO PR-STYLE-MSG(LINE-NO)
                 PERFORM PRINT-STYLE-TOTALS
              END-IF
018260        MOVE WS-STYLE-TOTAL-QTY-TOT TO WS-STYLE-TOTAL-QTY
018270        MOVE "ALL STYLES" TO PR-STYLE-MSG(LINE-NO)
018280        PERFORM PRINT-STYLE-TOTALS
018290        MOVE LOW-VALUES TO WS-OLD-STYLE
018300        MOVE 0 TO WS-STYLE-TOTAL-QTY,
018310             WS-STYLE-TOTAL-QTY-TOT
           END-IF.

010200 PRINT-STYLE-TOTALS.
           EVALUATE TRUE
           WHEN NO-DECIMALS
010220           MOVE WS-STYLE-TOTAL-QTY TO PR-STYLE-TOTAL-QTY
010240     WHEN ONE-DECIMAL
010250           MOVE WS-STYLE-TOTAL-QTY TO PR-STYLE-TOTAL-QTY-1
010270     WHEN TWO-DECIMALS
010280           MOVE WS-STYLE-TOTAL-QTY TO PR-STYLE-TOTAL-QTY-2
010300     WHEN THREE-DECIMALS
010310           MOVE WS-STYLE-TOTAL-QTY TO PR-STYLE-TOTAL-QTY-3
010330     WHEN FOUR-DECIMALS
010340           MOVE WS-STYLE-TOTAL-QTY TO PR-STYLE-TOTAL-QTY-4
           WHEN OTHER
010360           MOVE WS-STYLE-TOTAL-QTY TO PR-STYLE-TOTAL-QTY-5
           END-EVALUATE.
           MOVE FMT-STYLE-TOTAL-QTY TO PR-STYLE-MSG(LINE-NO)(12:).
010410     IF WS-STYLE-TOTAL-QTY NOT = 0 AND STYLE-SUBTOTAL
               PERFORM INC-LINE-NO
           ELSE
               MOVE SPACES TO PR-STYLE-MSG(LINE-NO)
           END-IF.
010430     MOVE 0 TO WS-STYLE-TOTAL-QTY.
018320
018330 PROCESS-STD-ITEM.
018000     IF NOT ACCUM-TOTALS AND HEADER-AT-BODY AND
                 WS-SAVE-GROUP NOT = 0
      * todo todo
           END-IF.
              
018450     MOVE ORDL-STYLE        TO SPC-ITEM-NO.
018460     IF NOT SPC-ITEM
018470         MOVE ORDL-STYLE TO PR-STYLE(LINE-NO)
018480     ELSE 
               MOVE NOT-FOUND TO STYLF-STATUS
           END-IF.
018490     MOVE ORDL-ITEM-DESC TO PR-STD-ITEM-DESC(LINE-NO).
           EVALUATE TRUE
           WHEN NO-DECIMALS
018510        MOVE ORDL-ORDER-QTY TO F-PR-ORD-QTY
018520        MOVE ORDL-SHIP-QTY  TO F-PR-SHIP-QTY
018530        MOVE ORDL-BO-QTY    TO F-PR-BO-QTY
018550     WHEN ONE-DECIMAL
018560        MOVE ORDL-ORDER-QTY TO F-PR-ORD-QTY-1
018570        MOVE ORDL-SHIP-QTY  TO F-PR-SHIP-QTY-1
018580        MOVE ORDL-BO-QTY    TO F-PR-BO-QTY-1
018600     WHEN TWO-DECIMALS
018610        MOVE ORDL-ORDER-QTY TO F-PR-ORD-QTY-2
018620        MOVE ORDL-SHIP-QTY  TO F-PR-SHIP-QTY-2
018630        MOVE ORDL-BO-QTY    TO F-PR-BO-QTY-2
018650     WHEN THREE-DECIMALS
018660        MOVE ORDL-ORDER-QTY TO F-PR-ORD-QTY-3
018670        MOVE ORDL-SHIP-QTY  TO F-PR-SHIP-QTY-3
018680        MOVE ORDL-BO-QTY    TO F-PR-BO-QTY-3
018700     WHEN FOUR-DECIMALS
018710        MOVE ORDL-ORDER-QTY TO F-PR-ORD-QTY-4
018720        MOVE ORDL-SHIP-QTY  TO F-PR-SHIP-QTY-4
018730        MOVE ORDL-BO-QTY    TO F-PR-BO-QTY-4
018740     WHEN OTHER
018750        MOVE ORDL-ORDER-QTY TO F-PR-ORD-QTY-5
018760        MOVE ORDL-SHIP-QTY  TO F-PR-SHIP-QTY-5
018770        MOVE ORDL-BO-QTY    TO F-PR-BO-QTY-5
           END-EVALUATE.
           MOVE FMT-PR-ORD-QTY TO PR-QTY(LINE-NO,1)
           MOVE FMT-PR-SHIP-QTY TO PR-QTY(LINE-NO,2)
           MOVE FMT-PR-BO-QTY TO PR-QTY(LINE-NO,3)
018780     MOVE ORDL-ITEM-PRICE   TO PR-ITEM-PRICE(LINE-NO).
018790     MOVE ORDL-EXT-AMT      TO PR-EXT-AMT(LINE-NO).
019320     MOVE ORDL-ITEM-UOM     TO PR-UOM(LINE-NO).
018800     MOVE ORDL-STYLE        TO SPC-ITEM-NO.
018810     PERFORM ADD-TOTALS.
018970     MOVE SPACES            TO SPC-ITEM-NO.
018950     IF NOT ACCUM-TOTALS
               PERFORM PRINT-DETAIL
           END-IF.

018990 PROCESS-STYLE.
019000* DON'T PRINT 'LOST' QUANTITIES
019010     MOVE 0 TO HOLD-BO-QTY.
019020     MOVE HOLD-ITEM-NO TO SPC-ITEM-NO.
019030     IF SINGLE-INVOICE AND ACCUM-TOTALS
019040       AND NOT C-AT-END OF ORDLF-STATUS
      *  bad bad bad
019050        GO TO MOVE-DETAIL-END
           END-IF.
019060     IF NOT SPC-ITEM
              EVALUATE TRUE
019070        WHEN NO-DECIMALS
019080           MOVE TOTAL-QTY TO F-PR-QTY
019100        WHEN ONE-DECIMAL
019110           MOVE TOTAL-QTY TO F-PR-QTY-1
019130        WHEN TWO-DECIMALS
019140           MOVE TOTAL-QTY TO F-PR-QTY-2
019160        WHEN THREE-DECIMALS
019170           MOVE TOTAL-QTY TO F-PR-QTY-3
019190        WHEN FOUR-DECIMALS
019200           MOVE TOTAL-QTY TO F-PR-QTY-4
              WHEN OTHER
019220           MOVE TOTAL-QTY TO F-PR-QTY-5
              END-EVALUATE
              MOVE FMT-PR-QTY TO PR-TOTAL-QTY(LINE-NO)
019290        MOVE WS-HOLD-EXT-AMT TO PR-EXT-AMT(LINE-NO)
019300        MOVE 0 TO WS-HOLD-EXT-AMT
019310        MOVE HOLD-ITEM-PRICE TO PR-ITEM-PRICE(LINE-NO)
019320        MOVE HOLD-ITEM-UOM   TO PR-UOM(LINE-NO)
           END-IF.
019350     IF USER-SN = 00285
      * ??? ??? 00285 or 00258 ??? ???
019360        MOVE HOLD-ITEM-DESC TO PR-APP-DESC(LINE-NO)
           END-IF.
019390*    MOVE PR-COLOR TO COLRF-KEY.
019400*    PERFORM READ-COLRF.
019430*    MOVE COLR-NAME TO PR-COLR-NAME.
019490     IF NOT ACCUM-TOTALS
019500        PERFORM PRINT-DETAIL.

019520 CALC-HOLD-EXT-AMT.
019530        COMPUTE WS-HOLD-EXT-AMT = WS-HOLD-EXT-AMT
019540          + HOLD-EXT-AMT.
019550        PERFORM ADD-TOTALS.
019560
019580 ADD-TOTALS.
019590     IF NOT SPC-ITEM
019600         ADD HOLD-EXT-AMT TO ORDH-NET-AMT
019610         ADD HOLD-EXT-COST TO ORDH-COST-AMT.
019620     IF FREIGHT
019630         ADD HOLD-EXT-AMT TO ORDH-FREIGHT-AMT.
019640     IF SPC-CHG
019650         ADD HOLD-EXT-AMT TO ORDH-SPCHG-AMT.
019660     IF DISCOUNT
019670         ADD HOLD-EXT-AMT TO ORDH-NET-AMT.
019680     COMPUTE ORDH-DISC-AMT ROUNDED = ORDH-DISC-AMT +
019690       (HOLD-DISC-AMT * TOTAL-QTY).
019700     IF COMM-ON-GROSS
019710         COMPUTE COMM-AMT ROUNDED =
019720           HOLD-EXT-AMT * HOLD-COMM-PCT / 100.00000 ON SIZE ERROR 
019730           MOVE ZERO TO COMM-AMT END-COMPUTE
019740     ELSE COMPUTE COMM-AMT ROUNDED =
019750           (HOLD-EXT-AMT - HOLD-EXT-COST) * HOLD-COMM-PCT / 
019760           100.00000 ON SIZE ERROR MOVE ZERO TO COMM-AMT 
019770           END-COMPUTE.
019780     ADD COMM-AMT TO ORDH-COMM-AMT.
019790     PERFORM ADD-TAXES
019800         VARYING I FROM 1 BY 1 UNTIL I > 3.
019810
019820 ADD-TAXES.
019830     IF HOLD-TAX-CD(I) = 1 AND ORDH-TAX-PCT(I) NOT = 0
019840         ADD HOLD-EXT-AMT TO TAXABLE(I)
019850     ELSE 
               ADD HOLD-EXT-AMT TO NON-TAXABLE(I)
           END-IF.
019860
019870 MOVE-TOTALS.
019880     MOVE TAX-AMT(3) TO PR-TAX-3.
019890     MOVE TAX-AMT(2) TO PR-TAX-2.
019900     MOVE TAX-AMT(1) TO PR-TAX-1.
019910     COMPUTE PR-INV-AMT-F = ORDH-INV-AMT - ORDH-DEP-AMT.
019920     MOVE ORDH-CSHDISC-AMT TO PR-CASH-DISC.
019940     PERFORM PRINT-TOTALS.
019950
019960 PRINT-REPORT-HEADERS.
110510     IF LIBERTYU 
110510        MOVE "LENGTH"     TO HDR-CATEGORY OF INVAPP
110510     ELSE
110510     IF CLASSICH
110510        MOVE "CAT."       TO HDR-CATEGORY OF INVAPP
110510     ELSE
110510        MOVE "CAT."       TO HDR-CATEGORY OF INVAPP.

009430     IF WS-LOGO-FILENAME NOT = SPACES
009440        MOVE WS-LOGO-FILENAME TO PR-COMPANY-LOGO
009450        MOVE WS-LOGO-IMAGE-TYPE TO 
009460             EDIT-MODE OF PR-COMPANY-LOGO 
009470     ELSE
              MOVE "X" TO EDIT-MODE OF PR-COMPANY-LOGO
009480        PERFORM PRINT-COMPANY-INFO.
009490     IF WS-WMARK-FILENAME NOT = SPACES
009500        MOVE WS-WMARK-FILENAME TO PR-WATERMARK
009510        MOVE WS-WMARK-IMAGE-TYPE TO
009520             EDIT-MODE OF PR-WATERMARK 
           ELSE
              MOVE "X" TO EDIT-MODE OF PR-WATERMARK.

019980     IF PROCESS-HISTORY-YES
019990        MOVE ORDH-INV-DATE TO DATE-IN
020000        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
020010        MOVE DATE-OUT-11 TO PR-INV-DATE
           END-IF.
020020     IF CREDIT-MEMO
020030         MOVE "CREDIT MEMO" TO PR-CREDIT-MEMO
020040     ELSE 
               MOVE SPACES TO PR-CREDIT-MEMO
           END-IF.
020050     MOVE ORDH-CUST-NO TO PR-CUST-NO.
020060     IF NOT ACK-FORM
              IF ORDH-REPRINT-SEQ > 0
                  STRING ORDH-INV-NO "-" ORDH-REPRINT-SEQ
                      DELIMITED BY SIZE INTO PR-INV-NO
              ELSE
020090            MOVE ORDH-INV-NO TO PR-INV-NO
              END-IF
           END-IF.
           MOVE WS-INV-DATE TO PR-INV-DATE.
020320     MOVE ORDH-CUST-NAME TO PR-CUST-NAME.
020330     MOVE ORDH-SHIP-NAME TO PR-SHIP-NAME.
020340     MOVE ORDH-SLSMN-NO TO PR-SLSMN.
020470     MOVE ORDH-CUST-ADDR1 TO PR-CUST-ADDR1.
020480     MOVE ORDH-SHIP-ADDR1 TO PR-SHIP-ADDR1.
020590     MOVE ORDH-CUST-ADDR2 TO PR-CUST-ADDR2.
020600     MOVE ORDH-SHIP-ADDR2 TO PR-SHIP-ADDR2.
018290     STRING 
018300            ORDH-CUST-CITY   DELIMITED BY "  ",
018310            ", "             DELIMITED BY SIZE,
018320            ORDH-CUST-STATE  DELIMITED BY SIZE,
018330            "  "            DELIMITED BY SIZE,
018340            ORDH-CUST-ZIP    DELIMITED BY SIZE
018360            INTO PR-CUST-CSZ.
018490     IF ORDH-SHIP-CITY = SPACES
018510        MOVE SPACES TO PR-SHIP-CSZ
           ELSE
018410        STRING 
018420            ORDH-SHIP-CITY   DELIMITED BY "  ",
018430            ", "             DELIMITED BY SIZE,
018440            ORDH-SHIP-STATE  DELIMITED BY SIZE,
018450            "  "             DELIMITED BY SIZE,
018460            ORDH-SHIP-ZIP    DELIMITED BY SIZE
018480            INTO PR-SHIP-CSZ
           END-IF.
020980     MOVE ORDH-PO-NUM TO PR-PO-NUM.
020990     MOVE ORDH-ORDER-NO TO PR-ORDER-NO.
021000     MOVE ORDH-ORD-DATE TO DATE-IN.
021010     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
021020     MOVE DATE-OUT-11 TO PR-ORD-DATE.
021030     MOVE ORDH-SHIP-DATE TO DATE-IN.
021040     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
021050     MOVE DATE-OUT-11 TO PR-SHIP-DATE.
021280     IF (ORDH-DUE-DAYS = ZEROES ) AND
021290        (ORDH-DISC-PCT = ZEROES ) AND
021300        (ORDH-DISC-DAYS = ZEROES) 
021310        MOVE EXCN-TERM-DESC(ORDH-TERM-CD) TO PR-TERMS
021320     ELSE 
021330        MOVE ORDH-DUE-DAYS  TO TERMS-DUE-DAYS
021340        MOVE ORDH-DISC-PCT  TO TERMS-PCT
021350        MOVE ORDH-DISC-DAYS TO TERMS-DAYS
021360        MOVE TERMS-DESC     TO PR-TERMS
           END-IF.
021370     MOVE ORDH-SHIP-INST TO PR-SHIP-INST.
021380     MOVE ORDH-VENDOR TO PR-VENDOR.
021390     MOVE ORDH-CLASS  TO PR-CLASS.
021400     MOVE ORDH-DEPT   TO PR-DEPT.
           IF HEADER-AT-TOP 
               PERFORM PRINT-GROUP-HEADINGS
           END-IF.
019970     PERFORM INIT-LINE-NO.

021990 PRINT-GROUP-HEADINGS.
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > GROUPS-AT-HEADER
               COMPUTE CNT = I + (WS-PASS-NO - 1) * GROUPS-AT-HEADER
               IF CNT NOT > WS-GROUPS-FOUND
                   MOVE WS-SCAN-GROUP(CNT) TO PR-GROUP-HEADER(I)
                   PERFORM VARYING CNT2 FROM 1 BY 1 UNTIL CNT2 > 
                            9 OR CNT2 > WS-SCAN-SIZES(CNT)
                     MOVE WS-SCAN-GROUP(CNT) TO SCAT-GROUP-NBR
                     SET SCAT-REC-SIZE TO TRUE
                     MOVE WS-SCAN-SIZES-IDX(CNT,CNT2) TO LOPT-BIN
                     MOVE LOPT-X TO SCAT-SIZE-NUM
                     PERFORM READ-SCAT-GS
                     MOVE SCAT-SIZE TO PR-GROUP-HEADER-SIZE (I,CNT2)
                   END-PERFORM
               END-IF
           END-PERFORM.
           IF WS-PASS-NO = 1
              COMPUTE I = GROUPS-AT-HEADER + 1
022760        MOVE "ORDR" TO PR-GROUP-HEADER-SIZE(I,1)
022770        MOVE "SHIP" TO PR-GROUP-HEADER-SIZE(I,2)
022780        MOVE "B/O"  TO PR-GROUP-HEADER-SIZE(I,3)
           END-IF.
               
010530 GET-INV-NUMBER SECTION.
010540 GET-INV-NUMBER-START.
010550     IF FORCE-INVOICE-NO-YES
010560        MOVE ORDH-ORDER-NO TO ORDH-INV-NO
010570        GO TO GET-INV-NUMBER-EXIT.
010580
010590     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
010600      CNTLF-STATUS OR IO-WAIT-OFF 
010610     READ CNTLF
010620     END-READ END-PERFORM.
010630     MOVE CNTL-NEXT-INVNO TO ORDH-INV-NO.
010640     IF CNTL-NEXT-INVNO < 999990
010650         ADD 1 TO CNTL-NEXT-INVNO
010660     ELSE 
               MOVE 1 TO CNTL-NEXT-INVNO
           END-IF.
010670     REWRITE CNTLF-REC.
010680*??? IF (INVOICE-APP-80-NO-STYLE OR INVOICE-APP-132-NO-STYLE)
010690*???    MOVE 2 TO CNTL-APPAREL-GROUP-CD.
010700
010710 GET-INV-NUMBER-EXIT. EXIT.
010720
010730 GET-INV-DATE SECTION.
010740 GET-INV-DATE-START.
010750     PERFORM SCREEN-INIT.
010760     DISPLAY SCR-GET-DATE-QUES.
010770     MOVE TODAYS-DATE TO INV-DATE.
010780 ACCEPT-DATE.
010790     MOVE "1001000000" TO FKEYS.
010800     MOVE 0 TO FLAG.
010820     CALL "SCRN01" USING FLAG, FKEYS, DATE-SPEC, DATE-HELP,
010830         INV-DATE.
010850     IF FLAG = 4 GO TO GET-INV-DATE-EXIT.
010860     MOVE INV-DATE TO DATE-IN.
010870     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
010880     MOVE DATE-IN TO INV-DATE.
010890     IF BAD-DATE OR INV-DATE = 0
010900         DISPLAY SCR-BAD-DATE   
010910         GO TO ACCEPT-DATE.
010920     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
010930     MOVE DATE-OUT-11 TO WS-INV-DATE.
010940 GET-INV-DATE-EXIT. EXIT.
010950
       GET-TODAY-DATE SECTION.
008810        MOVE TODAYS-DATE TO INV-DATE, DATE-IN
008820        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
008830        MOVE DATE-OUT-11 TO WS-INV-DATE.
010940 GET-TODAY-DATE-EXIT. EXIT.


       IOS SECTION.
       OPEN-FILES.
008630     PERFORM  OPEN-ORDLF.
008640     PERFORM  OPEN-ORDHF.
008660     PERFORM  OPEN-STYLF.
008660     PERFORM  OPEN-SCATF.
024760 OPEN-ORDHF.
024770     OPEN I-O    ORDHF.
024780 OPEN-ORDLF.
024790     OPEN INPUT  ORDLF.
024780 OPEN-STYLF.
024790     OPEN INPUT  STYLF.
025930 CLOSE-FILES.
025940     CLOSE ORDHF.
025950     CLOSE ORDLF.
           CLOSE STYLF, SCATF. 

025030 READ-STYLF.
025040     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025050      STYLF-STATUS OR IO-WAIT-OFF 
025060     READ STYLF NO LOCK INVALID KEY
025070         MOVE STYLF-STATUS TO STYLF-STATUS, FILE-STATUS
025080     END-READ END-PERFORM.

025730 REWRITE-ORDHF.
025740     IF NOT PROCESS-HISTORY-YES
025750        REWRITE ORDHF-REC.

025170 START-ORDHF.
025180     MOVE LOW-KEY TO ORDHF-KEY.
025190     START ORDHF KEY NOT < ORDHF-KEY
025200         INVALID KEY MOVE AT-END TO ORDHF-STATUS.

025210 START-ORDLF-GREATER.
025220     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
025230     MOVE ORDH-SUB-ORDER-NO TO ORDL-SUB-ORDER-NO.
025240     START ORDLF KEY > ORDLF-KEY
025250         INVALID KEY MOVE AT-END TO ORDLF-STATUS.

025450 READ-ORDHF.
025460     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025470      ORDHF-STATUS OR IO-WAIT-OFF 
025480     READ ORDHF INVALID KEY
025490         MOVE SPACES TO ORDHF-REC
025500     END-READ END-PERFORM.
025510     IF NOT C-AT-END OF ORDHF-STATUS 
              SET ORDER-COMPLETE TO TRUE
           END-IF. 
025530     IF LAST-OPTION = 020103 OR 020207
025550        PERFORM SET-INVOICE-FORM-MODE
025560     ELSE
025570        IF OPEN-ORDER
025580          IF LAST-OPTION NOT = 020103 AND LAST-OPTION NOT = 020206
                   PERFORM SET-ACK-FORM-MODE
025610          ELSE
025620             PERFORM SET-INVOICE-FORM-MODE
                END-IF
              END-IF
           END-IF.
025630     SET WS-SAVE-GROUP-L TO TRUE.

025260 READ-ORDHF-NEXT.
025270     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025280      ORDHF-STATUS OR IO-WAIT-OFF 
025290     READ ORDHF NEXT
025300         AT END MOVE AT-END TO ORDHF-STATUS
025310     END-READ END-PERFORM.
025320     IF NOT C-AT-END OF ORDHF-STATUS 
               SET ORDER-COMPLETE TO TRUE
           END-IF.                                        
025340     SET WS-SAVE-GROUP-L TO TRUE.

025350 READ-ORDLF-NEXT.
025360     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025370      ORDLF-STATUS OR IO-WAIT-OFF 
025380     READ ORDLF NEXT
025390         AT END MOVE AT-END TO ORDLF-STATUS
025400     END-READ END-PERFORM.
025410     IF NOT C-AT-END OF ORDLF-STATUS
025420         IF ORDL-ORDER-NO NOT = ORDH-ORDER-NO  OR
025430            ORDL-SUB-ORDER-NO NOT = ORDH-SUB-ORDER-NO
025440             MOVE AT-END TO ORDLF-STATUS
           END-IF.

024310 READ-ORDLF-NEXT-SCAN SECTION.
024320 RONS.
024350     PERFORM READ-ORDLF-NEXT.
024360     IF NOT C-AT-END OF ORDLF-STATUS
024370         IF ORDL-ORDER-NO NOT = ORDH-ORDER-NO
024380             MOVE AT-END TO ORDLF-STATUS
               END-IF
           END-IF.
           IF HEADER-AT-BODY
               GO TO READ-ORDLF-NEXT-SCAN-EXIT
           END-IF.
024410     IF NOT C-AT-END OF ORDLF-STATUS
024420         MOVE ORDL-STYLE TO STYLE-NUMBER
024430         PERFORM READ-STYLF
024440         IF C-RECORD-OK OF STYLF-STATUS
024450             PERFORM PASS-TEST
024460             IF ORDLF-STATUS = NOT-FOUND
024470                 GO TO RONS
                   END-IF
               END-IF
           END-IF.
024480     IF NOT C-AT-END OF ORDLF-STATUS
024490         IF WS-PASS-NO > 1 AND ORDL-SZ-NOTAPPAREL
                   GO TO RONS
               END-IF
           END-IF.
024540 READ-ORDLF-NEXT-SCAN-EXIT. EXIT.

       WSS SECTION.
024560 PASS-TEST.
           COMPUTE I = GROUPS-AT-HEADER * (WS-PASS-NO - 1).
           SET C-NOT-FOUND OF ORDLF-STATUS TO TRUE.
           PERFORM VARYING CNT FROM 1 BY 1 UNTIL CNT > GROUPS-AT-HEADER
              IF WS-SCAN-GROUP(I+CNT) = STYLE-GROUP-NAME
                  SET C-FOUND OF ORDLF-STATUS TO TRUE
              END-IF
           END-PERFORM.

025640 READ-COLRF.
025650     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025660      COLRF-STATUS OR IO-WAIT-OFF 
025670     READ COLRF KEY IS COLRF-KEY
025680          INVALID KEY MOVE COLRF-STATUS TO COLRF-STATUS
025690     END-READ END-PERFORM.
025710     IF NOT C-RECORD-OK OF COLRF-STATUS
025720        MOVE SPACES TO COLR-NAME
           END-IF.

025990 FILENAMES SECTION.
026000 FILL-PATHS.
039320      MOVE SPACES TO TEMP-SUB-DIR.
039330      STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
            MOVE USER-SUB-DIR TO PROFITS-DATA-LOC.
026050      PERFORM String-CNTLF-Path.
026050      PERFORM String-EXCNF-Path.
           Move "ORDERH.FIL" To ORDHF--Name.
026050      PERFORM String-ORDHF-Path.
      * due to this move commented out at ordlf.sr
           Move "ORDERL.FIL" To ORDLF--Name.
           Move "ORDERH.FIL" To ORDHF--Name.
026050      PERFORM String-ORDLF-Path.
026050      PERFORM String-SCATF-Path.
026050      PERFORM String-STYLF-Path.
026050      PERFORM String-COLRF-Path.
           
           COPY "USERF.SR".
           COPY "CNTLF.SR".
           COPY "EXCNF.SR".
           COPY "ORDHF.SR".
           COPY "ORDLF.SR".
           COPY "SCATF.SR".
           COPY "STYLF.SR".
           COPY "COLRF.SR".
           COPY "APPARELD.SR".
026500 CHAINCALLS SECTION.
026510 CHN--PARM-BLOCK.
026520      COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
026530      .
026540
026550 CHN--PARM-BLK.
026560      COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.
026570
026580 CHNR--WS-PASSED.
026590      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==WS-PASSED==
026600      .
026610
           COPY "LASRHDR.SR" REPLACING LASER-IO-FORM BY INVAPP.
       BEFORELOOPEN.
026960     STRING 
026970          "SO" DELIMITED BY SIZE
026980          ORDH-ORDER-NO DELIMITED BY SIZE
026990          INTO PF-DOCU-ID.
           PERFORM LFPR-PREPARE-PRINT-NEXT.
           IF NOT LFPR-NO-MORE-COPY AND LFPR-DONTPRINT-THIS-COPY
               GO TO BEFORELOOPEN
           END-IF.
              
015370 LOAD-LFPR-DATA .
