000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID.    B0100XHP IS INITIAL.                         
000030 AUTHOR.        KWS.
000040 ENVIRONMENT DIVISION.
000050 CONFIGURATION SECTION.
000060 SOURCE-COMPUTER. IBM-PC-XT.
000070 OBJECT-COMPUTER. IBM-PC-XT.
000080 Repository.
000090 Class COM AS "*COM".
000100*REMARKS.
000110******************************************************************
000120* B0100XHP  - LASER PICK/PACK FORMS  (REWRITE AT V2.9A) 1/6/03   *
000130*                                                                *
000140* FIX KWS V3.0 - PCS - FIX FOR POS RECAP, AMOUNTS WRONG          *
000150* UPD KWS V3.0 - ALLOW PRINT WITH ALL COPIES 'NO'                *
000160* KWS - LOOSING TAXES ON COPIES PAST FIRST ONE                  *
000170* UPD KWS V3.0 - BETTER ALIGN OF SUB-TOT ON RETAIL PRICE FORM    *
000180* UPD KWS V3.0 - POS 'SUB-TOTAL' AMOUNT OFF THE FIRST TIME       *
000190* KWS - FIX ORDH-INV-AMT ON NON-POS PRINT                        *
000200* FIX KWS V3.0 - ZERO TAXES BEFORE EACH INVOICE                  *
000210* KWS - INV DATE FROM HISTORY PRINTING TODAYS DATE               *
000220* UPD KWS V3.0 - CREDIT MEMO TAX NOT CORRECT                     *
000230* MOD KWS V3.0 - PCS - ON THIRD COPY PRINT COMM INFO             *
000240* KWS      - NOT PRINTING DETAIL ON HISTORY ORDERS               *
000250* FIX      KWS - MULTIPAGE FAX EACH PAGE LAYED ON TOP OF PREVIOUS*
000260* MOD KWS V3.0 - ATHENS -                                        *
000270* UPD KWS V3.0 - FORCE ORDH-DEP-AMT IF CASH SALE                 *
000280* FIX KWS V3.0 - ONLY CALC TAXES IF NOT FROM HISTORY             *
000290* FIX KWS V3.0 - POS PRINT FROM HISTORY CAUSES BAD TOTAL         *
000300* UPD KWS V3.0 - USE .PCX WHEN FAXING INVOICE                    *
000310* MOD KWS V3.0 - PCS - PUT LOGO IN MACRO FILE                    *
000320* UPD KWS V3.0 - ADD LOGIC FOR PDF COPY                          *
000330* UPD KWS V3.0 - SHOW QTY ON COMMENTS IF NOT ZERO                *
000340* MOD KWS V3.0 - JEREMIE - HIDE STRUCTURE ITEMS                  *
000350* MOD KWS V3.0 - JEREMIE - PRINT CREDIT CARD INFO AT BOTTOM      *
000360* MOD KWS V3.0 - JEREMIE - ALL UNPRINTED, CHECK FOR PACKER       *
000370* FIX KWS V3.0 - ALLIED - BLANK PAGE AFTER EACH COPY             *
000380* MOD KWS V3.0C- JEREMIE - IF ALL UNPRINTED, JUST CHECK 4 PACKER *
000390* MOD KWS V3.0C- JEREMIE - PRINT COMMENTS FOR FREIGHT LINES      *
000400* UPD KWS V3.1 - PDF IN WINXP                                    *
000410* UPD TMS V3.1 - CHANGE TERMS DESC TO REFLECT NEW ORDH FIELDS    *
000420* UPD KWS V3.1 - CHANGES FOR TERMS (USE ORDH NOT EXCN)           *
000430* UPD KWS V3.1 - NOT SHOWING SHIPPING COMMENTS                   *
000440* UPD KWS V3.1 - REPLACE CC INFO AT BOTTOM WITH ORDER COMMENTS   *
000450* FIX KWS V3.1 - DO NOT ASK PAYMENT SCREEN IF FROM HISTORY       *
000460* FIX KWS V3.1 - PDF COPY SHOWING FAX INFO '@@'                  *
000470* FIX KWS V3.1 - ADJ VERT POSITION OF PAGE NO AND COPYNAME INV104* 
000480* UPD KWS V3.1 - SHRINK BODY TO 35 LINES IF INV104.MAC           *
000490* FIX KWS V3.1 - POS NOT WORKING FROM CUST BAL INQ 3.2.2         *
000500* FIX KWS V3.1 - LOOSING COMMENT LINES                           *
000510* MOD KWS V3.1 - JEREMIE - DO NOT PRINT 'IF PAID BY' MSG @ BOTTOM*
000520* FIX KWS V3.1 - TOTALS WRONG WHEN PRINTED FROM MENU OPTION      *
000530* UPD KWS V4.0 - REPLACE CGTIMES WITH TIMESNEWROMAN 4110>1690    *
000540* UPD KWS V3.2 - CHANGE THE WAY INV102 SHOWS DATE/INV# ALLIED    *
000550* UPD KWS V3.2 - PROFIT-TEAR-SLIP VERSION PRITING BLANK PAGE     *
000560* MOD KWS V3.2 - ALLIED - DO NOT PRINT 'INVOICE DUE ON' MSG      *
000570* FIX KWS V3.2 - PROFIT TEAR STRIP, TOTALS PRINTING TO HIGH      *
000580* MOD KWS V4.1 - ALLIED - PRINT EXCN-TERMS-DESC INSTEAD          *
000590* FIX KWS V4.1 - CHANGE ON 071406 CAUSED TERMS 2 PRINT UNDER CLAS*
000600* UDP KWS V4.2 - USER-BATCH IS NOW 2 DIGITS                      *
000610* MOD KWS V4.2 - BARBER, TREAT "E" AS SPC-CHG ITEM               *
000620* UPD KWS V4.2 - ASK INV-DATE ON POS INVOICES                    *
000630* UPD KWS V4.2 - NOT CLEARING SPC-CHG/EVAC ON FORM 107           *
000640* FIX KWS V4.2 - REPRINT (2.1.3) WITH FRT, TOTAL REDUCES BY FRT  *
000650* UPD KWS V4.4 - DO NOT PRINT DUE DATE ON CREDIT-MEMO            *
000660* UPD SKI V4.2 - POWERFORM                                       *
000670* UPD KWS V4.4 - TEMP CHANGE UNTIL LFPR FINISHED                 *
000680* UPD KWS V4.4 - DUMMY PARAGRAPH NEEDED FOR LFPR FORM PRINTING   *
000690* UPD KWS V4.4 - LOGIC FOR PDFCREATOR                            *
000700* UPD KWS V4.4 - MULTIPAGE INVOICE PRINTS PREVIOUS INV-TOTAL     *
000710* UPD KWS V4.4 - ADD LOGIC TO EMAIL PDF OF INVOICE               *
000720* UPD KWS V4.4.1- CUTTING OFF ZIP ON LONG CITY NAMES             *
000730* UPD KWS V4.4.2- ADD PRINT ORDERS FROM AN ASCII TEXT FILE       *
000740* FIX SKI V4.4 - CLOSE LO                                        *
041409* UPD KWS V4.4.2- Add Terms-Msg to bottom of Inv104 (PCS)        *
042009* UPD KWS V4.4.2- FORM TYPE OVERLAYING INVOICE & ACKNOWLEDGEMENT *
042009* UPD KWS V4.4.3- CITY-STATE-ZIP WAS NOT CLEARING PREVIOUS DATA  *
042709* FIX KWS V4.4.3- MULTIPAGE ORDER SHOWS TOTALS ON ALL PAGES      *
042809* MOD KWS V4.4.3- PACA - PRINT ALL 3 LINES OF ITEM DESC          *
050109* FIX KWS V4.4.3- PACA MOD CAUSES CRASH IN 2.6.2                 *
050109* MOD KWS V4.4.3- PACA - PRINT S/O BELOW "WORK ORDER"            * 
060809* FIX KWS V4.4.3- PROMPTING PDF SAVE LOCATION FOR EVERY INVOICE  *
060809* MOD KWS V4.4.3- SUNBELTS-USE A DIFFERNT OVERLAY FOR INVOICE    *
061109* FIX KWS V4.4.4- INV104 NOT CLEARING FRT AMOUNT BETWEEN INVOICES*
061109* FIX KWS V4.4.4- NOT RESETTING ORDER-COMPLETE FLAG              *
061109* MOD KWS V4.4.4- SUNBELTS- LAST-OPT 2.2.7, FORCE TO INVOICE     *
062909* FIX KWS V4.4.4- 104 INVOICE WAS ADDING FRT TWICE ON HIST ORDERS*
080509* FIX SKI V4.5  - FIX MESSED LINE-CNT+1 WHEN PRINT ITEM LINE     *
092609* MOD SKI V4.5  - EMPTY OVERLAY FOR NON PDF PRINTING FOR DIAZO   *
100109* FIX KWS V4.5  - BLANK OUT DUE-ON BEFORE EACH PRINT             *
010810* UPD KWS V4.5  - PR-DETAIL-HDR ON FORM INV101 FOR APPAREL       *
010810* MOD KWS V4.5  - JEREMIE MODS - VEND/CLASS/DEPT/PACKER          *
011110* MOD KWS V4.5  - PROTECTI - USE INVNOTAX OVERLAY FOR FORM       *
011110* MOD KWS V4.5  - PROTECTI - MOVE REMIT MSG TO HEADER            *
011910* FIX KWS V4.5  - FORM 107 NOT PRINTING TOTALS ("s") CORRECTLY   *
020210* MOD KWS V4.5.0- DIAZO - MERGE MODS INTO STD PROGRAM            *
020510* FIX KWS V4.5.0- IF NOT DETAIL ON INV101, 38 BLANK PAGES        *
051510* FIX KWS V4.5.1- TOTALS STILL NOT RIGHT ON MULTIPAGE INVOICES   *
031610* MOD KWS V4.5.1- ALLIED - PRINT RATE 3/CITY RATE 4 COUNTY       *
032110* UPD KWS V4.5.1- FORM HEADER/LABEL CHANGES                      *
032210* MOD KWS V4.5.A- DIAZO- IF ELECTRONIC INVOICE FORCE PROFITSPDF  *
032910* FIX KWS V4.5.1- DIAZO- RETAIL PRICE NOT WORKING ON CREDIT MEMO *
032910* FIX KWS V4.5.1- DIAZO- FIX A PROBLEM WITH TAX ROUNDING         *
032910* UPD KWS V4.5.1- IF CONTACT-1-EMAIL BLACK SKIP EMAIL, PRINT IT  *
042710* MOD KWS V4.5.1- DIAZO- MOVED RECALC PRICE MOD FROM B0100CU     *
060810* MOD SKI V4.5.2- ADD PRINT OF ORDH-DEP-AMT                      *
082410* UPD KWS V4.5.2- ADD RETAIL PRICE FORM FOR TOMLIN CORP (TARGETS)*
090310* FIX KWS V4.5.2- GARBAGE PRINTING ABOVE ADDRESS AREA IN RED     *
090810* FIX KWS V4.5.2- DONT PRINT DESC-2/3 UNLESS PACA                *
091410* MOD KWS V4.5.3- AGRIBUS - "S" SHOW IN DETAIL NOT TOTAL SECTION *
100110* FIX KWS V4.5.3- PREVENT ERROR IF BAD INVALID ORDER REQUESTED   *
102110* MOD KWS V4.5.3- SUNBELT - ONLY ALLOW [ON ACCOUNT]              *
112310* MOD KWS V4.5.3- DIAZO - ALWAYS USE FORM                        *
031511* UPD KWS V4.5.3- ADD APPAREL FORM                               *
032011* FIX KWS V4.5.3- APPAREL, DO NOT PRINT C, F, D, S UNDER STYLE   *
040811* FIX KWS V4.5.3- INV102, NOT BLOCKING TEAR-SLIP DATA CORRECTLY  *
000750******************************************************************
000760 INPUT-OUTPUT SECTION.
000770 FILE-CONTROL.
000780
000790     COPY "ORDHF.SL".
000800     COPY "ORDLF.SL".
000810     COPY "SALEF.SL".
000820     COPY "CUSTF.SL".
042809     COPY "ITEMF.SL".
000840     COPY "CNTLF.SL".
000850     COPY "USERF.SL".
000870     COPY "PFPRNTR.SL".
000880     COPY "ORAUF.SL".
000890     COPY "EXCNF.SL".
000900     COPY "STEST.SL".
000910     COPY "EMALF.SL".
000930     COPY "ASCII.SL".
010810     COPY "SCATF.SL".
031610     COPY "TAXMF.SL".
042710     COPY "CONTF.SL".
031511     COPY "STYLF.SL".
031511     COPY "COLRF.SL".
000940
000950 DATA DIVISION.
000960 BASED-STORAGE SECTION.
000970     COPY "STEST.BS".
000980 FILE SECTION.
000990
001000
001010*FD  LO
001020*    LABEL RECORDS ARE OMITTED.
001030
001040*01  PRINT-REC           PIC X(140).
001050*--- INV102 FORMAT NEEDS X(200) TO PREVENT BLANK PAGE ---*
001060*01  PRINT-REC           PIC X(200).
001070     COPY "PFPRNTR.FD".
001110     COPY INV101  OF XMDLIB.      *> STANDARD OLD PROFITS LOOK
001120     COPY INV102  OF XMDLIB. 	*> LANDSCAPE WITH TEAR-OFF
001130     COPY INV104  OF XMDLIB.      *> MODERN VERSION ROUNDED CORNERS
001130     COPY INV105  OF XMDLIB.	*> RETAIL PRICE FORM
001140     COPY INV106  OF XMDLIB.      *> ???? LOOKS LIKE INV101
001100     COPY INV107  OF XMDLIB. 	*> ???? LOOKS LIKE INV104
020210     COPY DIAZO101  OF XMDLIB.
031511     COPY INV110  OF XMDLIB.      *> APPAREL WITH SIZE MATRIX
001150
001160     COPY "ORDHF.FD".
001170     COPY "ORDLF.FD".
001180     COPY "SALEF.FD".
001190     COPY "CUSTF.FD".
042809     COPY "ITEMF.FD".
001210     COPY "CNTLF.FD".
001230     COPY "USERF.FD".
001240     COPY "ORAUF.FD".
001250     COPY "EXCNF.FD".
001260     COPY "EMALF.FD".
001270     COPY "STEST.FD".
010810     COPY "SCATF.FD".
031610     COPY "TAXMF.FD".
042710     COPY "CONTF.FD".
031511     COPY "STYLF.FD".
031511     COPY "COLRF.FD".

001290     COPY "ASCII.FD".
001300 01  ASCII-REC.
001310     05  ASCII-ORDER-NO               PIC 9(6).
001320     05  ASCII-SUB-ORDER-NO           PIC 9(2).
001330     05  FILLER                       PIC X(500).
001340
001350
001360 WORKING-STORAGE SECTION.
001370     COPY INVFRM OF XMDLIB.

001380 01  PROG-NAME.
001390     05 FILLER           PIC X(9) VALUE "B0100XHP".
001400
001410 01  SYSTEM-TIME.
001420     03 SYSTEM-HOUR          PIC 99.
001430     03 SYSTEM-MINUTE        PIC 99.
001440     03 SYSTEM-SECONDS       PIC 99.
001450     03 FILLER               PIC 99.
001460
001470 01  PR-CNDSE            PIC X(9)  VALUE SPACES.
001480*01  LINE-NO             PIC 9(2)  VALUE ZERO.
001490 01  PAGE-NO             PIC 9(4)  VALUE ZERO.
001500 01  PR-PAGE-NO          PIC Z(2)  VALUE ZERO.
001510 01  SKIP                PIC 99    VALUE ZERO.
001520 01  LO-STATUS           PIC XX    VALUE SPACES.
001530 01  CNTLF-STATUS        PIC XX    VALUE SPACES.
001540 01  USERF-STATUS        PIC XX    VALUE SPACES.
001550 01  SALEF-STATUS        PIC XX    VALUE SPACES.
001560 01  CUSTF-STATUS        PIC XX    VALUE SPACES.
001570     COPY "FSTATUS88.DTA".
001580     COPY "ASCII.DTA".
001590*    COPY "FSTATUS88.DTA".
001600
031610     COPY "TAXMF.DTA".

001610 01  ORAUF-STATUS        PIC XX    VALUE SPACES.
001620     88 C-RECORD-OK VALUES "00", "02".
001630     88 C-FOUND VALUES "00", "02".
001640     88 C-AT-END VALUES "10", "14".
001650     88 C-END-OF-FILE VALUES "10", "14".
001660*01  SERLF-STATUS        PIC XX    VALUE SPACES.
001670 01  EXCNF-STATUS        PIC XX    VALUE SPACES.
042809 77  ITEMF--NAME PIC X(15) VALUE "ITEM.FIL" .
042809 77  ITEMF-FULLPATH PIC X(35) VALUE SPACES .
042809 01  ITEMF-STATUS        PIC XX    VALUE SPACES.
042809     88 C-RECORD-OK VALUES "00", "02".
042809     88 C-FOUND VALUES "00", "02".
042809     88 C-AT-END VALUES "10", "14".
042809     88 C-END-OF-FILE VALUES "10", "14".
001690 01  ORDHF-STATUS        PIC XX    VALUE SPACES.
001700     88 C-RECORD-OK VALUES "00", "02".
001710     88 C-FOUND VALUES "00", "02".
001720     88 C-AT-END VALUES "10", "14".
001730     88 C-END-OF-FILE VALUES "10", "14".
001740 01  ORDLF-STATUS        PIC XX    VALUE SPACES.
001750     88 C-RECORD-OK VALUES "00", "02".
001760     88 C-FOUND VALUES "00", "02".
001770     88 C-AT-END VALUES "10", "14".
001780     88 C-END-OF-FILE VALUES "10", "14".
001790 01  ORDHF-NAME          PIC X(5)  VALUE "ORDHF".
001800 01  ORDLF-NAME          PIC X(5)  VALUE "ORDLF".
001810 01  EXT-HDR-FILE        PIC X(12) VALUE SPACES.
001820 01  EXT-LIN-FILE        PIC X(12) VALUE SPACES.
001830
042710 01  CONTF-STATUS        PIC XX    VALUE SPACES.
042710     COPY "FSTATUS88.DTA".
CLNUP1 77  CONTF--NAME PIC X(15) VALUE "CONTRACT.FIL" .
CLNUP1 77  CONTF-FULLPATH PIC X(35) VALUE SPACES .
042710 01  CLASS-TABLE.
042710     05 CLASS-ARR PIC X(22) OCCURS 10 TIMES.
042710 01  SQ-FT-TABLE.
042710     05 SQ-FT-ARR PIC 9(6)V99 OCCURS  10 TIMES.
042710 01  BEST-PRICE-TABLE.
042710     05 BEST-PRICE PIC 9(6)V999 OCCURS  10 TIMES.
042710 01  FOUND-CONTRACT-FLAG PIC X.
042710     88 FOUND-CONTRACT VALUE "Y".
042710 01  CC PIC 99 VALUE 1.
042710 01  DD PIC 99 VALUE 1.
042710
001840
001850 01  ESC-FLAG            PIC 9    VALUE ZERO.
001860 01  PROFIT                 PIC S9(9)V99.
001870 01  PROFIT-PCT             PIC 999V9.
001880 01  INV-DATE            PIC 9(6) VALUE ZERO.
001890 01  LOW-ORDHF-KEY.
001900     05  LOW-ORDER.
001910         10 LOW-SLSMN    PIC 9(3) VALUE ZERO.
001920         10 FILLER       PIC 9(3) VALUE ZERO.
001930     05  LOW-SUB-ORDER   PIC 9(2) VALUE ZERO.
001940 01  HIGH-ORDHF-KEY.
001950     05  HIGH-ORDER.
001960         10 HIGH-SLSMN   PIC 9(3) VALUE ZERO.
001970         10 FILLER       PIC 9(3) VALUE ZERO.
001980     05  HIGH-SUB-ORDER   PIC 9(2) VALUE ZERO.
001990 77  NUMBER-DECIMALS     PIC 9 VALUE ZERO.
002000 77  NEXT-PROG2          PIC    X(20)           VALUE SPACES.
002010 01  TERMS-DESC.
           05 TERMS-PCT        PIC Z9   VALUE ZEROES.
002030     05 FILLER           PIC XX   VALUE "% ".
002040     05 TERMS-DAYS       PIC ZZ9  VALUE ZEROES.
002060     05 FILLER           PIC X(10) VALUE " DAYS/NET ".
002070     05 TERMS-DUE-DAYS   PIC ZZ9  VALUE ZEROES.
002160
002170 01  PROCESS-ORDERS-FLAG    PIC X VALUE "O".
002180     88  PROCESS-OPEN-ORDERS      VALUE "O".
002190     88  PROCESS-INVOICES         VALUE "I".
002200     88  PROCESS-HISTORY          VALUE "H".
002210 01  RANGE-TYPE-FLAG        PIC X VALUE "1".
002220     88  POS-PRINTING             VALUE "P".
002230     88  PRINT-ALL-ORDERS         VALUE "1".
002240     88  RANGE-PRINTING           VALUE "2".
002250     88  SELECTIVE-PRINTING       VALUE "3".
002260     88  BY-BATCH-NO              VALUE "4".
002270     88  BY-SALESMAN-PRINTING     VALUE "5".
002280 01  FORM-TYPE-FLAG         PIC 9 VALUE 1.
002290     88 PRINT-INVOICES-ONLY       VALUE 1.
002300     88 PRINT-ACK-ONLY            VALUE 2.
002310     88 PRINT-BOTH                VALUE 1, 2.
002320 01  BULK-PRINT-FLAG       PIC 9  VALUE 2.
002330     88 BULK-PRINT-YES            VALUE 1.
002340     88 BLUK-PRINT-NO             VALUE 2.

010810 01  PRINT-BARCODE-FLAG    PIC 9  VALUE 1.
010810     88 PRINT-BARCODE-YES         VALUE 1.
010810     88 PRINT-BARCODE-NO          VALUE 2.
002350 77  WS-BAD-ORDERS         PIC 9(6)  VALUE ZERO.
002360 77  DEL-NAME              PIC X(13) VALUE SPACES.
002370                   
002380 01  DATE-QUES     PIC X(33)
002390     VALUE "Enter date to print on invoices: ".
002400*01  DATE-SPEC      PIC X(14) VALUE "1154D06060E   ".
002410 01  DATE-SPECS.
002420     05  FILLER      PIC X(14)  VALUE "0754D06060    ".
002430     05  FILLER      PIC X(14)  VALUE "1020X40400    ".
002440     05  FILLER      PIC X(14)  VALUE "1120X40400    ".
002450     05  FILLER      PIC X(14)  VALUE "1220X40400    ".
002460     05  FILLER      PIC X(14)  VALUE "1505X70700    ".
002470     05  FILLER      PIC X(14)  VALUE "1605X70700    ".
002480     05  FILLER      PIC X(14)  VALUE "1705X70700    ".
002490 01  DATE-SPECS-REDEF REDEFINES DATE-SPECS.
002500     05  DATE-SPEC    OCCURS 7 TIMES.
002510          15  FILLER     PIC X(9).
002520          15  OPTION     PIC 9   .
002530          15  ATTR1      PIC X(2).
002540          15  ATTR2      PIC X(2).
002550 01  DATE-HELP.
002560     05  FILLER PIC X(120)   VALUE " 6 digit numeric field.  The d
002570-    "isplayed date is the date you entered when you     powered o
002580-    "n your computer.  The date sho".
002590     05  FILLER PIC X(029) VALUE "uld be in the format MMDDYY.$".
002600     05  FILLER PIC X(40) VALUE 
002610         " This message will print on the invoice ".
002620     05  FILLER PIC X(40) VALUE 
002630         "below the ShipTo Address.  It will be   ".
002640     05  FILLER PIC X(40) VALUE 
002650         " saved and re-used for all invoice print".
002660     05  FILLER PIC X(40) VALUE 
002670         " requests until blanked out here.      $".
002680     05  FILLER PIC X(05) VALUE " $  $".
002690
002700     05  FILLER PIC X(40) VALUE 
002710         " This message will print on the invoice ".
002720     05  FILLER PIC X(40) VALUE 
002730         "at the bottom just above the taxes and  ".
002740     05  FILLER PIC X(40) VALUE 
002750         " total line.  It will be saved and re-us".
002760     05  FILLER PIC X(40) VALUE 
002770         "ed for all invoice print requests until ".
002780     05  FILLER PIC X(40) VALUE 
002790         " blanked out here.                     $".
002800     05  FILLER PIC X(05) VALUE " $  $".
002810 01  INV-MSG-LINES.
002820     05  SHORT-MSG-LINES.
002830         10 SHORT-MSG-1          PIC X(40).
002840         10 SHORT-MSG-2          PIC X(40).
002850         10 SHORT-MSG-3          PIC X(40).
002860*    05  LONG-MSG-LINES.
002870*        10 LONG-MSG-1           PIC X(70).
002880*        10 LONG-MSG-2           PIC X(70).
002890*        10 LONG-MSG-3           PIC X(70).
002900 01  BOX-VARIABLES.
002910     05  POS-X           PIC 9(4)  VALUE ZERO.
002920     05  POS-Y           PIC 9(4)  VALUE ZERO.
002930     05  SIZE-X          PIC 9(4)  VALUE ZERO.
002940     05  SIZE-Y          PIC 9(4)  VALUE ZERO.
002950 01  HP-BOX.
002960     05  FILLER          PIC X(03) VALUE X"1B2661".
002970     05  HP-BOX-PX       PIC 9(04) VALUE ZERO.
002980     05  FILLER          PIC X     VALUE "h".
002990     05  HP-BOX-PY       PIC 9(04) VALUE ZERO.
003000     05  FILLER          PIC X(04) VALUE X"561B2A63".
003010     05  HP-BOX-SX       PIC 9(04) VALUE ZERO.
003020     05  FILLER          PIC X     VALUE "a".
003030     05  HP-BOX-SY       PIC 9(04) VALUE ZERO.
003040     05  FILLER          PIC X(04) VALUE X"421B2A63".
003050     05  HP-BOX-FILL     PIC 9(03) VALUE 0.
003060     05  FILLER          PIC X(01) VALUE "P".
003070
003080 01  RANGE-DATA.
003090     05  RANGE-MSG      PIC X(21) VALUE "Do you want to print?".
003100     05  RANGE-CODES.
003110         10  FILLER     PIC X(17) VALUE "All Unprinted".
003120         10  FILLER     PIC X(17) VALUE "A Range of Orders".
003130         10  FILLER     PIC X(17) VALUE "Selective Orders".
003140         10  BY-BATCH   PIC X(17) VALUE "By Batch Number  ".
003150         10  FILLER     PIC X(17) VALUE "A Range of Slsmn ".
003160     05  ORDER-CODES.
003170         10  FILLER     PIC X(13) VALUE "Order Number".
003180         10  FILLER     PIC X(13) VALUE "Customer Name".
003190     05  FORM-CODES.
003200         10  FILLER     PIC X(16) VALUE "Invoices     ".
003210         10  FILLER     PIC X(16) VALUE "Acknowledgements".
003220         10  FILLER     PIC X(16) VALUE "Both         ".
003230
003240     05  RANGE-SPECS-1.
003250         10  FILLER     PIC X(14) VALUE "1143O05171    ".
003260         10  FILLER     PIC X(14) VALUE "1243O03163    ".
003270         10  FILLER     PIC X(14) VALUE "1043O02131    ".
003280     05  RANGE-SPECS-1-REDEF REDEFINES RANGE-SPECS-1.
003290         10  RANGE-SPEC-1  OCCURS 3 TIMES.
003300             15  ROW         PIC 99.
003310             15  COL         PIC 99.
003320             15  TYP         PIC X.
003330             15  FLEN        PIC 99.
003340             15  SLEN        PIC 99.
003350             15  OPTION      PIC 9   .
003360             15  ATTR1       PIC X(2).
003370             15  ATTR2       PIC X(2).
003380     05  RANGE-LOW-MSG  PIC X(16) VALUE "First to print -".
003390     05  RANGE-HIGH-MSG PIC X(16) VALUE "Last  to print -".
003400     05  RANGE-SPECS-2.
003410         10  FILLER     PIC X(14) VALUE "1243D06060    ".
003420         10  FILLER     PIC X(14) VALUE "1343D06060    ".
003430     05  RANGE-SPECS-2-REDEF REDEFINES RANGE-SPECS-2.
003440         10  RANGE-SPEC-2  OCCURS 2 TIMES.
003450             15  ROW         PIC 99.
003460             15  COL         PIC 99.
003470             15  TYP         PIC X.
003480             15  FLEN        PIC 99.
003490             15  SLEN        PIC 99.
003500             15  OPTION      PIC 9   .
003510             15  ATTR1       PIC X(2).
003520             15  ATTR2       PIC X(2).
003530     05  SELECT-QUES    PIC X(35)
003540         VALUE "Order Number to print:             ".
003550     05  RANGE-SPECS-3.
003560         10  FILLER     PIC X(14) VALUE "1243D06060E   ".
003570         10  FILLER     PIC X(14) VALUE "1250D02020IP  ".
003580     05  RANGE-SPECS-3-REDEF REDEFINES RANGE-SPECS-3.
003590         10  RANGE-SPEC-3  OCCURS 2 TIMES.
003600             15  FILLER     PIC X(9).
003610             15  OPTION     PIC 9   .
003620             15  ATTR1      PIC X(2).
003630             15  ATTR2      PIC X(2).
003640 01  WS-ORDER-FLAG PIC 9 VALUE 2.
003650     88 PRINT-IN-ORDER-SEQUENCE    VALUE 1.
003660     88 PRINT-IN-NAME-SEQUENCE     VALUE 2.
003670 01  TYPE-HELP.
003680     05  FILLER PIC X(120)   VALUE " Select the type of payment to
003690-    " be applied to this invoice.  If the invoice is    not on ac
003700-    "count, the payment amount must".
003710     05  FILLER PIC X(011) VALUE " be keyed.$".
003720 01  PMT-HELP.
003730     05  FILLER PIC X(095)   VALUE " 9 digit numeric field with 2 
003740-    "decimal positions.  Key the payment amount for     this invo
003750-    "ice.$".
003760 01  PRINT-HELP.
003770     05  FILLER PIC X(077)   VALUE " Press enter to print the invo
003780-    "ice after you have entered the payment amount.$".
003790 01  HELP1.
003800     05  FILLER PIC X(120)   VALUE " To print the forms  for all o
003810-    "rders, press <ENTER>.  You may also print for [A   Range of 
003820-    "Orders] or [Selective Orders].".
003830     05  FILLER PIC X(083)   VALUE "  For an explanation of these 
003840-    "choices,   refer to the reference guide.            $".
003850     05 FILLER PIC X(40) VALUE
003860     " Select which type of forms you wish to ".
003870     05 FILLER PIC X(40) VALUE
003880     "print.                                 $".
003890     05 FILLER PIC X(40) VALUE
003900     " This report may be printed in Order num".
003910     05 FILLER PIC X(40) VALUE
003920     "ber sequence or customer name sequence.$".
003930 01  HELP2.
003940     05  FILLER PIC X(120)   VALUE " Enter the number of the first
003950-    " and last order to print.  If you want to print    one order
003960-    ", enter it's number as the fir".
003970     05  FILLER PIC X(021) VALUE "st and last number.$$".
003980 01  HELP3.
003990     05  RANGE-ERR-1    PIC X(47) VALUE
004000         " That is an invalid range, please try another. ".
004010     05  RANGE-ERR-2    PIC X(51) VALUE
004020         " There are none in this range, please try another. ".
004030     05  RANGE-ERR-3    PIC X(48) VALUE
004040         " This order does not exist, please try another. ".
004050     05  RANGE-ERR-4    PIC X(62) VALUE " This order is not releas
004060-        "ed to be billed, please try another. ".
004070 01  POS-SCRN.
004080     05  POS-1.
004090         10  FILLER       PIC X(17)  VALUE "Net Sales Amount".
004100         10  PR-NET-AMT   PIC Z,ZZZ,ZZZ.99-.
004110         10  FILLER       PIC X(9)   VALUE SPACES.
004120         10  FILLER       PIC X(12)  VALUE "Payment Type".
004130     05  POS-2.
004140         10  FILLER       PIC X(17)  VALUE "Freight".
004150         10  PR-FREIGHT-AMT PIC Z,ZZZ,ZZZ.99-.
004160     05  POS-3.
004170         10  FILLER       PIC X(17)  VALUE "Special Charges".
004180         10  PR-SPCHG-AMT PIC Z,ZZZ,ZZZ.99-.
004190     05  POS-4.
004200         10  FILLER       PIC X(17)  VALUE "Sub-Total".
004210         10  PR-SUB-AMT   PIC Z,ZZZ,ZZZ.99-.
004220     05  POS-5.
004230         10  FILLER       PIC X(17)  VALUE "Taxes".
004240         10  PR-TAX-AMT   PIC Z,ZZZ,ZZZ.99-.
004250     05  POS-6.
004260         10  FILLER       PIC X(17)  VALUE "Invoice Total:".
004270         10  PR-INV-AMT   PIC Z,ZZZ,ZZZ.99-.
004280 01  PMT-CODES.
004290     05  FILLER     PIC X(17) VALUE "On Account".
004300     05  FILLER     PIC X(17) VALUE "Cash".
004310     05  FILLER     PIC X(17) VALUE "Check".
004320     05  FILLER     PIC X(17) VALUE "MasterCard".
004330     05  FILLER     PIC X(17) VALUE "VISA".
004340     05  FILLER     PIC X(17) VALUE "American Express".
004350     05  FILLER     PIC X(17) VALUE "Other Credit Card".
004360 01  TYPE-SPEC.
004370     05  FILLER      PIC X(9)   VALUE "1057O0717".
004380     05  OPTION      PIC 9      VALUE 1.
004390     05  FILLER      PIC X(9)   VALUE "E   ".
004400 01  PMT-SPEC.
004410     05  FILLER      PIC X(14)  VALUE "1261P05102EN  ".
004420 01  PMT-AMT            PIC S9(7)V99 COMP-3 VALUE 0.
004430 01  POS-7.
004440     10  FILLER         PIC X(15)  VALUE "Amount Tendered".
004450 01  POS-8.
004460     05  PR-CHANGE-MSG  PIC X(15) VALUE SPACES.
004470     05  PR-CHANGE-AMT  PIC Z,ZZZ,ZZZ.99-.
004480 01  PRINT-INV-MSG      PIC X(33)
004490     VALUE "Press ENTER to print the invoice.".
004500 01  INPUT-SPECS-1.
004510     05  FILLER      PIC X(14)  VALUE "1380O01011IE  ".
004520 77  INVIS-OPTION    PIC X(1)   VALUE "X".
004530
004540*--- BATCH NO VARIABLES ---*
004550 01  BATCH-SPECS.
004560         10  FILLER     PIC X(5)  VALUE "1645D".
004570*        10  FILLER     PIC 99    VALUE 01.
004580*        10  FILLER     PIC 99    VALUE 01.
004590         10  FILLER     PIC 99    VALUE 02.
004600         10  FILLER     PIC 99    VALUE 02.
004610         10  FILLER     PIC 9     VALUE 0.
004620         10  FILLER     PIC X(4)  VALUE "E   ".
004630 01  BATCH-HELP.
004640     05 FILLER          PIC X(40) VALUE
004650        " Enter the batch number that you want to".
004660     05 FILLER          PIC X(40) VALUE
004670        " print.  It must be from 1 to 9.        ".
004680     05 FILLER          PIC X(40) VALUE
004690        "                                       $".
004700 01  DISPLAY-MESSAGES.
004710     05 PRINTING-REPORT  PIC X(30) VALUE "Printing Forms...".
004720     05 NO-ORDERS-MSG    PIC X(37) VALUE
004730        " No Orders were found in this range! ".
004740
004750     COPY "CONSTANT.DTA".
004760     COPY "SCREEN.DTA".
004770     COPY "STATUS.DTA".
004780     COPY "ERROR.DTA".
004790     COPY "ERRORP.DTA".
004800     COPY "DATE.DTA".
004810     COPY "DAYWEEK.DTA".
004820*    COPY "PRINT2.DTA".
004830     COPY "LFPRF.DTA".
004840     COPY "PRINT.DTA".
004850     COPY "PAUSE.DTA".
004860     COPY "CENTER.DTA".
004870     COPY "SPCITEM.DTA".
004880     COPY "FAX.DTA".
004890     COPY "CHAINR.DTA".
004900     COPY "AUTHNO.DTA".
004910     COPY "B0750.DTA".
004920     COPY "BOX.DTA".
004930     COPY "EMALF.DTA".
004940     COPY "SENDMAIL.DTA".
040609     COPY "MSGBOX.DTA".
004950     COPY "PC_FILEROUTINES.DTA".
004960
004970 01  TOTALS.
004980     05 TOT-PROFIT-AMT   PIC S9(9)V99.
004990     05  TAXABLE         PIC S9(7)V99 OCCURS 3 TIMES.
005000     05  NON-TAXABLE     PIC S9(7)V99 OCCURS 3 TIMES.
005010     05  TAX-AMT         PIC S9(7)V99 OCCURS 3 TIMES.
020210     05  TAXABLE-RETAIL  PIC S9(7)V99 OCCURS 3 TIMES.
020210     05  TAX-AMT-RETAIL  PIC S9(7)V99 OCCURS 3 TIMES.
005020     05  TAX-RND         PIC S9(7)V9999 OCCURS 3 TIMES.
005030     05  TEMP-TAXABLE    PIC S9(7)V99 OCCURS 3 TIMES.
005040     05  TOT-TAX-PCT     PIC S99V999  COMP-3.
005050 77  TOT-TAX-AMT         PIC S9(9)V99 VALUE ZERO.
020210 01  TOT-TAX-AMT-RETAIL  PIC S9(9)V99 VALUE ZERO.
005060 77  DIFF-TAX            PIC S9(9)V99 VALUE ZERO.
031610 77  TAX-RATE3           PIC S9(9)V99 VALUE ZERO.
031610 77  TAX-RATE4           PIC S9(9)V99 VALUE ZERO.

005070 01  WS-INPUT-FIELD.
005080     05 WS-INPUT.
005090        10 WS-FIRST-2     PIC X(02) VALUE "*1".
005100        10 WS-ITEM-CLASS  PIC 9(02) VALUE 0.
005110        10 WS-ITEM-DESC   PIC X(25) VALUE SPACES.
005120        10 WS-ITEM-NO     PIC X(12) VALUE SPACES.
005130        10 WS-ITEM-NO-R REDEFINES WS-ITEM-NO.
005140           15 FILLER           PIC X(10).
005150           15 WS-ITEM-WHSE-NO  PIC 99.
005160        10 WS-ITEM-PRICE  PIC S9(6)V999 COMP-3 VALUE 0.
005170        10 WS-PRICE-CD    PIC 9 VALUE 1.
005180        10 FILLER         PIC X(13) VALUE SPACES.
005190
005200 01  WS-DETAIL-CD           PIC X        VALUE "N".
005210 01  COMM-AMT               PIC S9(7)V99 VALUE ZERO.
005220
005230 01  PR-SUB-TOTALS.
005240     03 SUB-FILLER        PIC X(95)           VALUE SPACES.
005250     03 TS-SUB-DESC       PIC X(13)           VALUE SPACES.
031810*    03 FILLER            PIC X(12)           VALUE SPACES.
031810     03 FILLER            PIC X(14)           VALUE SPACES.
005270     03 TS-SUB-AMT                            PIC ZZZZZZ.99-.
005280 01  PR-TOTALS.
005290     03 TS-TOT-WEIGHT     PIC ZZZ,ZZZ.999-    BLANK ZERO.
005300     03 TS-CASH-DISC      PIC ZZZ,ZZZ.99-     BLANK ZERO.
005310     03 TS-TAX-3          PIC ZZZZZZ.99-      BLANK ZERO.
005320     03 TS-TAX-2          PIC ZZZZZZ.99-      BLANK ZERO.
005330     03 TS-TAX-1          PIC ZZZZZZ.99-      BLANK ZERO.
005340     03 TS-INV-AMT        PIC Z,ZZZ,ZZZ.99-   VALUE ZERO.
010702     03 TS-INV-AMT2       PIC Z,ZZZ,ZZZ.99-   VALUE ZERO.
005350 01  PR-TEAR-TOTALS.
005360        05 PR-COST-AMT                       PIC Z,ZZZ,ZZZ.99-.
005370        05 PR-PROFIT-AMT                     PIC Z,ZZZ,ZZZ.99-.
005380        05 PR-PROFIT-PCT                     PIC ZZ9.9.
005390        05 TS-COST-AMT                       PIC Z,ZZZ,ZZZ.99-.
005400        05 TS-PROFIT-AMT                     PIC Z,ZZZ,ZZZ.99-.
005410        05 TS-PROFIT-PCT                     PIC ZZ9.9.
005420
005430
005440 77  HOLD-PARENT-SEQ-NO          PIC 9(6)       VALUE ZERO.
005450 01  WEIGHT                      PIC S9(7)V999  VALUE ZERO.
060810 01  WS-TEMP-AMT                 PIC S9(7)v99   VALUE ZERO.

005460 01  PR-TOTALS.
005470     05 TS-WEIGHT                PIC S9(9)V9(3) VALUE ZERO.
005480*01  HP-CTRL-CODES.
005490*    05 HP-RESET         PIC X(02) VALUE X"1B45".
005500*-- FOLLOWING LINES ADDED TO ALLOW DOWNLOAD OF MACRO TO PRINTER --
005510*    05 HP-DEFINE-MACRO.
005520*       10  FILLER       PIC X(03) VALUE X"1B2666".
005530*       10  MACRO-NUMBER PIC 9(5)  VALUE 00101.
005540*       10  FILLER       PIC X(3)  VALUE X"793058".
005550
005560*    05 HP-STOP-DEFINE   PIC X(05) VALUE X"1B26663158".
005570     COPY "LASRFORM.DTA".
005580
005590*    03 PR-SYS-DATE-11         PIC X(11)  VALUE SPACES.
005600     03 PR-ORDER-NUMBER.
005610        05 PR-ORDER-NO         PIC 9(6)  VALUE ZERO.
005620        05 FILLER              PIC X     VALUE "-".
005630        05 PR-SUB-ORDER-NO     PIC 99    VALUE ZERO.
005640*    03 PR-FORM-TYPE           PIC X(19) VALUE SPACES.
005650     03 PR-INV-DATE-11         PIC X(11) VALUE SPACES.
005660     03 PR-INVOICE-NO.
005670        05 PR-INVNO            PIC 9(6)  VALUE ZERO BLANK ZERO.
005680        05 PR-INVNO-DASH       PIC X     VALUE "-".
005690        05 PR-INVNO-SEQ        PIC 9(2)  VALUE ZERO BLANK ZERO.
005700     03 PR-SALESMAN.
005710        05 PR-SLSMN-NO         PIC 9(3)  VALUE ZERO.
005720        05 FILLER              PIC X     VALUE "-".
005730        05 PR-SLSMN-NAME       PIC X(25) VALUE SPACES.
005740*    03 PR-TERMS               PIC X(15) VALUE SPACES.
005750     03 PR-TERMS               PIC X(20) VALUE SPACES.
005760     03 PR-TOT-WEIGHT            PIC ZZZ,ZZZ,ZZZ.999- BLANK ZERO.
005770
005780*01  DSP-HEADER.
005790*    05  FILLER          PIC X(25)  VALUE "Copy Name".
005800*    05  FILLER          PIC X(04)  VALUE "Tray".
005810*    05  FILLER          PIC X(01)       VALUE SPACES.
005820*    05  FILLER          PIC X(23)  VALUE "Device Name".
005830*    05  FILLER          PIC X(01)       VALUE SPACES.
005840*    05  FILLER          PIC X(08)  VALUE "Knockout".
005850*    05  FILLER          PIC X(02)       VALUE SPACES.
005860*    05  FILLER          PIC X(05)  VALUE "Print".
005870*01  DSP-HEADER2.
005880*    05  FILLER          PIC X(73)  VALUE ALL "Ä".
005890*01  DSP-LINE.
005900*    05  DSP-CNT         PIC ZZ          VALUE ZERO.
005910*    05  FILLER          PIC X(01)       VALUE SPACES.
005920*    05  DSP-COPY-MSG    PIC X(25)       VALUE SPACES.
005930*    05  FILLER          PIC X(01)       VALUE SPACES.
005940*    05  DSP-TRAY        PIC 9           VALUE ZERO.
005950*    05  DSP-TRAY        PIC 99          VALUE ZERO.
005960*    05  FILLER          PIC X(02)       VALUE SPACES.
005970*    05  DSP-DEVICE-NAME PIC X(25)       VALUE SPACES.
005980*    05  FILLER          PIC X(02)       VALUE SPACES.
005990*    05  DSP-KNOCKOUT    PIC X(3)        VALUE SPACES.
006000     
006010
006020 77  LINE-CNT                  COMP-1    VALUE 1.
006030 77  BODY-LINES                PIC 99    VALUE 39.
006040 01  DETAIL-LINE-RETAIL.
006050     05 DR-FIRST-PART          PIC X(88) VALUE SPACES.
006060     05 DR-F-P2 REDEFINES DR-FIRST-PART.
006070        10 FILLER         PIC X(59).
006080        10 DR-ITEM-DESC   PIC X(29).
006090     05 FILLER                 PIC X(1)  VALUE SPACES.
006100     05 DR-ITEM-UOM            PIC X(3)  VALUE SPACES.
006110     05 FILLER                 PIC X(1)  VALUE SPACES.
006120     05 DR-KNOCKOUT.
006130        10 DR-ITEM-PRICE          PIC ZZZ,ZZZ.999-.
006140        10 DR-DISC-PRICE          PIC ZZZ,ZZZ.999-.
006150        10 FILLER                 PIC X(2) VALUE SPACES.
006160        10 DR-EXT-AMT             PIC ZZZ,ZZZ.999-.
006170
006180 01  DETAIL-LINE           VALUE SPACES.
010810    03 DETAIL-LINE-QTYS.
006190       05 PR-ORDER-QTY           PIC ZZ,ZZZ,ZZ9-.
006200       05 PR-ORDER-QTY-1 REDEFINES PR-ORDER-QTY
006210                                 PIC ZZZZ,ZZZ.9-.
006220       05 PR-ORDER-QTY-2 REDEFINES PR-ORDER-QTY
006230                                 PIC ZZZ,ZZZ.99-.
006240       05 PR-ORDER-QTY-3 REDEFINES PR-ORDER-QTY
006250                                 PIC ZZ,ZZZ.999-.
006260       05 PR-ORDER-QTY-4 REDEFINES PR-ORDER-QTY
006270                                 PIC Z,ZZZ.9999-.
006280       05 PR-ORDER-QTY-5 REDEFINES PR-ORDER-QTY
006290                                 PIC ZZZZ.99999-.
006300    
006310       05  FILLER                PIC X(02).
006320       05 PR-SHIP-QTY            PIC ZZ,ZZZ,ZZ9- BLANK ZERO.
006330       05 PR-SHIP-QTY-1 REDEFINES PR-SHIP-QTY
006340                                 PIC ZZZZ,ZZZ.9- BLANK ZERO.
006350       05 PR-SHIP-QTY-2 REDEFINES PR-SHIP-QTY
006360                                 PIC ZZZ,ZZZ.99- BLANK ZERO.
006370       05 PR-SHIP-QTY-3 REDEFINES PR-SHIP-QTY
006380                                 PIC ZZ,ZZZ.999- BLANK ZERO.
006390       05 PR-SHIP-QTY-4 REDEFINES PR-SHIP-QTY
006400                                 PIC Z,ZZZ.9999- BLANK ZERO.
006410       05 PR-SHIP-QTY-5 REDEFINES PR-SHIP-QTY
006420                                 PIC ZZZZ.99999- BLANK ZERO.
006430       05 FILLER                 PIC X(02).
006440       05 PR-BO-QTY              PIC ZZ,ZZZ,ZZ9-.
006450       05 PR-BO-QTY-1 REDEFINES PR-BO-QTY
006460                                 PIC ZZZZ,ZZZ.9-.
006470       05 PR-BO-QTY-2 REDEFINES PR-BO-QTY
006480                                 PIC ZZZ,ZZZ.99-.
006490       05 PR-BO-QTY-3 REDEFINES PR-BO-QTY
006500                                 PIC ZZ,ZZZ.999-.
006510       05 PR-BO-QTY-4 REDEFINES PR-BO-QTY
006520                                 PIC Z,ZZZ.9999-.
006530       05 PR-BO-QTY-5 REDEFINES PR-BO-QTY
006540                                  PIC ZZZZ.99999-.
006550       05  FILLER                PIC X(01).
010810     03  DETAIL-LINE-PART2.
006560       05  PR-SERIAL-NUMBERS.
006570           10  PR-ITEM-NO            PIC X(12).
006580           10  FILLER                PIC X(09).
006590           10  PR-ITEM-DESC          PIC X(28).
006600           10  FILLER                PIC X(09).
010810           10  FILLER                PIC X(3).
010810       05 PR-APPAREL-INFO REDEFINES PR-SERIAL-NUMBERS.
010810          10 PR-STYLE                  PIC X(08).
010810          10 FILLER                    PIC X(02) VALUE SPACES.
010810          10 PR-COLOR                  PIC X(02).
010810          10 FILLER                    PIC X(02) VALUE SPACES.
010810          10 PR-SIZE                   PIC X(05).
010810          10 FILLER                    PIC X(02) VALUE SPACES.
010810          10 PR-CATEGORY               PIC X(10).
010810          10 FILLER                    PIC X(02) VALUE SPACES.
010810          10 PR-APPRL-DESC             PIC X(28).           
006610       05  PR-KNOCKOUT.
006620          10  PR-ITEM-PRICE         PIC ZZZ,ZZZ.999- BLANK ZERO.
006630          10  FILLER                PIC X(01).
006640          10  PR-ITEM-UOM           PIC X(03).
012510*          10  FILLER                PIC X(05).
012510          10  FILLER                PIC X(04).
006660          10  PR-EXT-AMT            PIC Z,ZZZ,ZZZ.99-.
006670          10  PR-EXT-AMT-ALPHA-REDEF REDEFINES PR-EXT-AMT.
006680              15 PR-EXT-AMT-ALPHA   PIC X(13).

020210 01  PR-DETAIL-LINE-DIAZO.
020210     05   FILLER                    PIC X(06)    VALUE SPACES.
020210     05   PR-ORDER-QTY-DIAZO        PIC ZZ,ZZZ,ZZ9-
                                              VALUE ZERO BLANK ZERO.
020210     05   FILLER                    PIC X(14)    VALUE SPACES.
020210     05   PR-SHIP-QTY-DIAZO         PIC ZZ,ZZZ,ZZ9-
                                              VALUE ZERO BLANK ZERO.
020210     05   FILLER                    PIC X(05)    VALUE SPACES.
020210     05   PR-ITEM-DESC-DIAZO        PIC X(28)    VALUE SPACES.
020210     05   FILLER                    PIC X(10)    VALUE SPACES.
020210     05   PR-ITEM-PRICE-DIAZO       PIC BZZ,ZZZ.99- BLANK ZERO.
020210     05   FILLER                    PIC X(03)    VALUE SPACES.
020210     05   PR-DISC-DIAZO             PIC BZ,ZZZ.99- BLANK ZERO.
020210     05   FILLER                    PIC X(06)    VALUE SPACES.
020210     05   PR-EXT-AMT-DIAZO          PIC BBZZ,ZZZ.99- BLANK ZERO.
020210 01  PR-SUB-TOTAL-DETAIL-DIAZO.
020210     05   FILLER                    PIC X(47)  VALUE SPACES.
020210     05   PR-SUB-TOT-DESC           PIC X(28)  VALUE SPACES.
020210     05   FILLER                    PIC X(10)    VALUE SPACES.
020210     05   PR-DISC-COLUMN            PIC BZZ,ZZZ.99- VALUE ZERO
020210                                                    BLANK ZERO.
020210     05   FILLER                    PIC X(03)    VALUE SPACES.
020210     05   FILLER                    PIC X(11)       VALUE SPACES.
020210     05   FILLER                    PIC X(06)    VALUE SPACES.
020210     05   PR-NET-COLUMN             PIC BZZ,ZZZ.99- VALUE ZERO
020210                                                    BLANK ZERO.

020210 01  WS-PO-JOB                      PIC X(60)  VALUE SPACES.
020210 01  WS-SQ-IN PIC 9(7).
032910*01  WS-SQ-FT PIC 9(6)V99.
032910*01  WS-SQ-RED REDEFINES WS-SQ-FT.
032910*    05 WS-FT-PART   PIC 9(6).
032910*    05 WS-DEC-PART  PIC 9(2).
032910 01  WS-SQ-FT PIC S9(6)V99.
032910 01  WS-SQ-RED REDEFINES WS-SQ-FT.
032910     05 WS-FT-PART   PIC S9(6).
032910     05 WS-DEC-PART  PIC 9(2).
020210 01  WS-INV-AMT2     PIC S9(7)V9(3) COMP-3 VALUE ZERO.
020210 01  WS-TIME.
020210     05 WS-TIME-HH          PIC Z9    VALUE ZERO.
020210     05 FILLER              PIC X     VALUE ":".
020210     05 WS-TIME-MM          PIC 99    VALUE ZERO.

006850 77  HOLD-ORDLF-KEY         PIC X(14) VALUE SPACES.
007030
007040 01  FORMATTED-TIME.
007050     05  FMT-HOUR    PIC 99 VALUE ZERO.
007060     05  FILLER      PIC X  VALUE ":".
007070     05  FMT-MIN     PIC 99 VALUE ZERO.
007080     05  FILLER      PIC X  VALUE ":".
007090     05  FMT-SEC     PIC 99 VALUE ZERO.
007100 77  PR-CLASS        PIC X(8) VALUE SPACES.
007110 77  PR-DEPT         PIC X(8) VALUE SPACES.
007120
007130 01  CHAINED-FROM-CD      PIC 9 VALUE ZERO.
007140     88 FROM-B0750        VALUE 1.
007150 77  LASER-COPY-CD        PIC 9 VALUE 2.
007160
007430 01  WS-PRINT-COPY-CODES.
007440     05  WS-PRINT-COPY-CD          PIC 9 OCCURS 10 TIMES.
007450
007460 01  WS-PRINT-ENVELOPE-CD PIC 9    VALUE 2.
007470     88 PRINT-ENVELOPE-YES         VALUE 1.
007480
007490 01  HELP5.
007500     05  FILLER PIC X(080)   VALUE " Select  [Accept Copies]  to p
007510-    "rint the copies set to YES above.  If you want to ".
007520     05  FILLER PIC X(080)   VALUE " change what copies will print
007530-    " press ESC or the Spacebar and Ctrl-Enter        $".
007540     05  FILLER PIC X(080)   VALUE " Select [Yes] if you want to f
007550-    "ax a copy of this form in addition to printing    ".
007560     05  FILLER PIC X(080)   VALUE " whatever copies are set to [Y
007570-    "es].  You will be prompted for the Phone Number. $".
007580
007590 01  SPECS-5.
007600     05  FILLER      PIC X(14)  VALUE "2032O02151    ".
007610     05  FILLER      PIC X(14)  VALUE "2063D06060    ".
007620     05  FILLER      PIC X(14)  VALUE "1672O02031    ".
007630 01  SPECS-5-REDEF REDEFINES SPECS-5.
007640     05  SPEC-5    OCCURS 03 TIMES.
007650          15  FILLER     PIC X(9).
007660          15  OPTION     PIC 9   .
007670          15  ATTR1      PIC X(2).
007680          15  ATTR2      PIC X(2).
007690
007700 01  ACCEPT-OPTS.
007710     05  FILLER          PIC X(15)   VALUE "Accept Copies".
007720     05  FILLER          PIC X(15)   VALUE "Change Copies".
007730
007740 01  PR-DETAIL-MSG.
007750     03 FILLER            PIC X(61)           VALUE SPACES.
007760     03 PR-COMPLETE-MSG   PIC X(30)           VALUE SPACES.
007770 01  ORDER-COMPLETE-FLAG PIC X VALUE "Y".
007780     88 ORDER-COMPLETE         VALUE "Y".
007790*01  CC-CARD-LINE.
007800*    05 FILLER           PIC X(04) VALUE SPACES.
007810*    05 CC-CARD-TYPE     PIC X(22) VALUE SPACES.
007820*    05 FILLER           PIC X(02) VALUE SPACES.
007830*01  CC-DESC.
007840*    05 FILLER           PIC X(08) VALUE SPACES.
007850*    05  CC-NO.
007860*       10  CC-NO-BLANK     PIC X(12).
007870*       10  FILLER          PIC X(04).
007880*    05 FILLER           PIC X(04) VALUE SPACES.
007890*01  CC-VCODE-LINE.
007900*    05 FILLER           PIC X(11) VALUE SPACES.
007910*    05 CC-VCODE         PIC X(15) VALUE SPACES.
007920*    05 FILLER           PIC X(02) VALUE SPACES.
007930*01  CC-EXPIRE-LINE.
007940*    05 FILLER           PIC X(15) VALUE SPACES.
007950*    05 CC-EXPIRE        PIC X(04) VALUE SPACES.
007960*    05 FILLER           PIC X(09) VALUE SPACES. 
007970
007980 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
007990     88 STARPROD            VALUE 00335.
008000     88 JEREMIE             VALUE 00112.
008010     88 PCS                 VALUE 00003.
031511     88 LIBERTYU            VALUE 00117.
008030     88 ALLIED              VALUE 00238.
008040     88 PROTECTI            VALUE 00196.
060809     88 SUNBELTS            VALUE 00010, 00011.
060809     88 DIAZO               VALUE 00191.
091410     88 AGRIBUS             VALUE 00242.
008050
010810     COPY "SCATF.DTA".
031511     COPY "STYLF.DTA".
031511     COPY "COLRF.DTA".
031511 01  PROFITS-PROGRAMS-LOC        PIC X(256)  VALUE SPACES.
031511 01  PROFITS-DATA-LOC            PIC X(256)  VALUE SPACES.

008060 77  CUSTF--NAME PIC X(15) VALUE "CUSTOMER.FIL" .
008070 77  CUSTF-FULLPATH PIC X(35) VALUE SPACES .
008080 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
008090 77  TEMP-SUB-DIR PIC X(14) VALUE SPACES .
008100 77  ORDHF--NAME PIC X(15) VALUE "ORDERH.FIL" .
008110 77  ORDHF-FULLPATH PIC X(35) VALUE SPACES .
008120 77  ORDLF--NAME PIC X(15) VALUE "ORDERL.FIL" .
008130 77  ORDLF-FULLPATH PIC X(35) VALUE SPACES .
008140 77  CNTLF--NAME PIC X(15) VALUE "CONTROL.FIL" .
008150 77  CNTLF-FULLPATH PIC X(35) VALUE SPACES .
008160 77  EXCNF--NAME PIC X(15) VALUE "CONTROL2.FIL" .
008170 77  EXCNF-FULLPATH PIC X(35) VALUE SPACES .
008180 77  USERF--NAME PIC X(15) VALUE "USER.FIL" .
008190 77  USERF-FULLPATH PIC X(35) VALUE SPACES .
008200 01  IO-WAIT-CD  PIC X VALUE "1"                                  
008210     88 IO-WAIT-ON VALUE IS "1".
008220     88 IO-WAIT-OFF VALUE IS "0".
008230      COPY "STEST.DTA".
008240 77  SALEF--NAME PIC X(15) VALUE "SALESMAN.FIL" .
008250 77  SALEF-FULLPATH PIC X(35) VALUE SPACES .
008260 77  ORAUF--NAME PIC X(15) VALUE "ORDRAUTH.FIL" .
008270 77  ORAUF-FULLPATH PIC X(35) VALUE SPACES .
008280 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
008290 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
008300 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.
008310*01  PIC X VALUE "S".       
008320*    88 INVOICE-STANDARD VALUE "S".
008330*    88 INVOICE-107 VALUE "4".
008340*01 HORZ-POS-HDR-107 PIC 9999 VALUE 4770.
008350*01 HORZ-POS-BTM-107 PIC 9999 VALUE 4960.
008360*01 HORZ-POS-BTM-107 PIC 9999 VALUE 4940.
008370*01 VERT-POS-BTM-107 PIC 9999 VALUE 6810.
008380*01 VERT-ADD-BTM-107 PIC 9999 VALUE 0180.
008390 01 WS-TOT-Freight        PIC S9(7)V99.
008400 01 WS-TOT-Spc-Chg        PIC S9(7)V99.
008410 01 WS-TOT-EVACUATION-AMT PIC S9(7)V99.
008420 01 WS-TMP PIC X(20).
008430 01 WS-I PIC 999.
008440 01 WS-PRINT-NUM PIC Z,ZZZ,ZZZ.99-.
008450 01 WS-FORM-ID PIC XXXXXXXX.
008480     88 WS-FORM-ID-101 VALUE "INV101".
008490     88 WS-FORM-ID-102 VALUE "INV102".
008500     88 WS-FORM-ID-104 VALUE "INV104".
008510     88 WS-FORM-ID-106 VALUE "INV106".
082410     88 WS-FORM-ID-105 VALUE "INV105".
008530     88 WS-FORM-ID-107 VALUE "INV107".
031511     88 WS-FORM-ID-110 VALUE "INV110".
020210     88 WS-FORM-ID-DIAZO VALUE "DIAZO101".
008540     88 WS-FORM-ID-107-104 VALUE "INV107","INV104".
020210     88 BODY-LINES-25 VALUE "DIAZO101".
008550     88 BODY-LINES-24 VALUE "INV102".
082410     88 BODY-LINES-39 VALUE "INV101", "INV104",
                                  "INV106", "INV105", "INV110".

008570 SCREEN SECTION.
008580     COPY "CONSTANT.SCR".
008590     COPY "SCRNINIT.SCR".
008600     COPY "ERRORFIL.SCR".
008610*    COPY "PRINT.SCR".   
008620     COPY "CHAINR.SCR".  
008630     COPY "PAUSE.SCR".
008640     COPY "SENDMAIL.SCR".  
008650                         
008660*01 SCR-errorfil-sr-14-20 PIC IS X(51) FROM BOX-TOP CONTROL 
008670*     DSPL--CONTROL LINE 08 COLUMN 14 REVERSE-VIDEO.
008680*01 SCR-errorfil-sr-15-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
008690*     DSPL--CONTROL LINE 09 COLUMN 14 REVERSE-VIDEO.
008700*01 SCR-errorfil-sr-16-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
008710*     DSPL--CONTROL LINE 10 COLUMN 14 REVERSE-VIDEO.
008720*01 SCR-errorfil-sr-17-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
008730*     DSPL--CONTROL LINE 11 COLUMN 14 REVERSE-VIDEO.
008740*01 SCR-errorfil-sr-18-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
008750*     DSPL--CONTROL LINE 12 COLUMN 14 REVERSE-VIDEO.
008760*01 SCR-errorfil-sr-19-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
008770*     DSPL--CONTROL LINE 13 COLUMN 14 REVERSE-VIDEO.
008780*01 SCR-errorfil-sr-20-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
008790*     DSPL--CONTROL LINE 14 COLUMN 14 REVERSE-VIDEO.
008800*01 SCR-errorfil-sr-21-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
008810*     DSPL--CONTROL LINE 15 COLUMN 14 REVERSE-VIDEO.
008820*01 SCR-errorfil-sr-35-20 PIC IS X(40) FROM ERROR-MSG CONTROL 
008830*     DSPL--CONTROL LINE 10 COLUMN 17 REVERSE-VIDEO.
008840*01 SCR-errorfil-sr-36-20 PIC IS X(35) FROM ERROR-LINE-1 CONTROL 
008850*     DSPL--CONTROL LINE 11 COLUMN 17 REVERSE-VIDEO.
008860*01 SCR-errorfil-sr-37-20 PIC IS X(41) FROM ERROR-LINE-2 CONTROL 
008870*     DSPL--CONTROL LINE 12 COLUMN 17 REVERSE-VIDEO.
008880*01 SCR-errorfil-sr-38-20 PIC IS X(40) FROM ERROR-CONTACT CONTROL 
008890*     DSPL--CONTROL LINE 13 COLUMN 17 REVERSE-VIDEO.
008900*01 SCR-errorfil-sr-39-20 PIC IS X(40) FROM ERROR-RESUME CONTROL 
008910*     DSPL--CONTROL LINE 14 COLUMN 17 REVERSE-VIDEO.
008920*01 SCR-errorfil-sr-40-20 VALUE IS "Program Name = " CONTROL 
008930*     DSPL--CONTROL LINE 09 COLUMN 17 REVERSE-VIDEO.
008940*01 SCR-errorfil-sr-41-20 PIC IS X(6) FROM PROG-NAME CONTROL 
008950*     DSPL--CONTROL LINE 09 COLUMN 32 REVERSE-VIDEO.
008960*01 SCR-datechk-sr-35-23 PIC IS X(29) FROM DATE-ERROR CONTROL 
008970*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
008980*01 SCR-scrninit-sr-13-20 PIC IS X(80) FROM SCRN-TITLE-1 CONTROL 
008990*     DSPL--CONTROL LINE 01 COLUMN 01.
009000*01 SCR-scrninit-sr-14-20 PIC IS X(80) FROM SCRN-TITLE-2 CONTROL 
009010*     DSPL--CONTROL LINE 02 COLUMN 01.
009020*01 SCR-scrninit-sr-15-20 VALUE IS " PGM=" CONTROL DSPL--CONTROL 
009030*     LINE 02 COLUMN 04.
009040*01 SCR-scrninit-sr-16-20 PIC IS X(6) FROM PROG-NAME CONTROL 
009050*     DSPL--CONTROL LINE 02 COLUMN 09.
009060*01 SCR-scrninit-sr-17-20 VALUE IS " Station " CONTROL 
009070*     DSPL--CONTROL LINE 02 COLUMN 19.
009080*01 SCR-scrninit-sr-18-20 PIC IS X(2) FROM USER-TERMID CONTROL 
009090*     DSPL--CONTROL LINE 02 COLUMN 28.
009100*01 SCR-scrninit-sr-21-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 
009110*     TIMER-CNT COLUMN 1 SIZE IS 80.
009120*01 SCR-print-sr-100-20 PIC IS X(6) FROM PROG-NAME CONTROL 
009130*     DSPL--CONTROL LINE 2 COLUMN 9.
009140*01 SCR-print-sr-114-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
009150*     DSPL--CONTROL LINE CNT COLUMN 2.
009160*01 SCR-print-sr-145-20 PIC IS X(80) FROM PAUSE-SCRN-2 CONTROL 
009170*     DSPL--CONTROL LINE 19 COLUMN 1.
009180*01 SCR-chainr-sr-15-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 21
009190*      COLUMN 1.
009200*01 SCR-chainr-sr-28-23 PIC IS X(2) FROM DOS-RET-CODE CONTROL 
009210*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
009220*01 SCR-chainr-sr-29-23 VALUE IS " COULD NOT LOAD COMMAND.COM OR P
009230*01 SCR-chainr-sr-29-23 VALUE IS " COULD NOT LOAD COMMA
009240*     REVERSE-VIDEO.
009250*01 SCR-chainr-sr-31-23 CONTROL DSPL--CONTROL LOWLIGHT.
009260*01 SCR-chainr-sr-31-23 CONTROL DSPL--CONTROL LOWLIG
009270* 02 PIC X(80) FROM DOS-CALL-81-160 LINE 23 COLUMN 1 .
009280*01 SCR-chainr-sr-34-23 VALUE IS " E3 - INSUFFICIENT MEMORY " 
009290*     CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
009300*01 SCR-chainr-sr-38-23 VALUE IS "COPY FAILED - " CONTROL 
009310*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
009320*01 SCR-chainr-sr-39-26 PIC IS X(2) FROM DOS-RET-CODE CONTROL 
009330*     DSPL--CONTROL LINE 21 COLUMN 15.
009340 01 SCR-authno-sr-52-20 PIC IS X(51) FROM BOX-TOP CONTROL 
009350      DSPL--CONTROL LINE 8 COLUMN 14.
009360 01 SCR-authno-sr-53-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009370      DSPL--CONTROL LINE 9 COLUMN 14.
009380 01 SCR-authno-sr-54-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009390      DSPL--CONTROL LINE 10 COLUMN 14.
009400 01 SCR-authno-sr-55-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009410      DSPL--CONTROL LINE 11 COLUMN 14.
009420 01 SCR-authno-sr-56-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009430      DSPL--CONTROL LINE 12 COLUMN 14.
009440 01 SCR-authno-sr-57-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009450      DSPL--CONTROL LINE 13 COLUMN 14.
009460 01 SCR-authno-sr-58-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009470      DSPL--CONTROL LINE 14 COLUMN 14.
009480 01 SCR-authno-sr-59-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
009490      DSPL--CONTROL LINE 15 COLUMN 14.
009500 01 SCR-authno-sr-60-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
009510      DSPL--CONTROL LINE 16 COLUMN 14.
009520 01 SCR-authno-sr-61-20 VALUE IS "Authorization Required" CONTROL 
009530      DSPL--CONTROL LINE 9 COLUMN 28.
009540 01 SCR-authno-sr-62-20 VALUE IS "Customer # " CONTROL 
009550      DSPL--CONTROL LINE 12 COLUMN 16.
009560 01 SCR-authno-sr-63-20 VALUE IS "Customer Name" CONTROL 
009570      DSPL--CONTROL LINE 13 COLUMN 16.
009580 01 SCR-authno-sr-64-20 VALUE IS "Order #" CONTROL DSPL--CONTROL 
009590      LINE 14 COLUMN 16.
009600 01 SCR-authno-sr-65-20 VALUE IS "Amount " CONTROL DSPL--CONTROL 
009610      LINE 14 COLUMN 32.
009620 01 SCR-authno-sr-69-20 PIC IS X(8) FROM ORDH-CUST-NO CONTROL 
009630      DSPL--CONTROL LINE 12 COLUMN 27.
009640 01 SCR-authno-sr-70-20 PIC IS X(30) FROM ORDH-CUST-NAME CONTROL 
009650      DSPL--CONTROL LINE 13 COLUMN 30.
009660 01 SCR-authno-sr-71-20 PIC IS X(6) FROM ORDH-ORDER-NO CONTROL 
009670      DSPL--CONTROL LINE 14 COLUMN 24.
009680 01 SCR-authno-sr-73-20 PIC IS X(13) FROM WS-GROSS-AMT CONTROL 
009690      DSPL--CONTROL LINE 14 COLUMN 39.
009700 01 SCR-authno-sr-74-20 PIC IS X(25) FROM WS-AUTH-REASON CONTROL 
009710      DSPL--CONTROL BLINK LINE 11 COLUMN 27.
009720 01 SCR-authno-sr-79-20 VALUE IS "Action " CONTROL DSPL--CONTROL 
009730      LINE 15 COLUMN 16.
009740 01 SCR-authno-sr-93-20 VALUE IS "Enter Code  " CONTROL 
009750      DSPL--CONTROL LINE 15 COLUMN 45.
009760 01 SCR-authno-sr-104-23 VALUE IS " This number is not valid! " 
009770      CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
009780 01 SCR-authno-sr-108-23 VALUE IS " This number has already been u
009790-     "sed! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO
009800      .
009810 01 SCR-b0100xhp-cbl-757-20 PIC IS X(9) FROM PROG-NAME CONTROL 
009820      DSPL--CONTROL LINE 2 COLUMN 9.
009830 01 SCR-b0100xhp-cbl-987-20 VALUE IS "Enter Batch Number" CONTROL 
009840      DSPL--CONTROL LINE 16 COLUMN 25.
009850 01 SCR-b0100xhp-cbl-993-23 VALUE IS " Batch Number must be greate
009860-     "r than zero! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 
009870      REVERSE-VIDEO.
009880 01 SCR-b0100xhp-cbl-2011-23 PIC IS X(37) FROM NO-ORDERS-MSG 
009890      CONTROL DSPL--CONTROL LINE 21 REVERSE-VIDEO.
009900 01 SCR-b0100xhp-cbl-2066-26 VALUE IS " Cannot print Ack for RELEA
009910-     "SED Order! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 
009920      REVERSE-VIDEO.
009930 01 SCR-b0100xhp-cbl-2071-26 VALUE IS " Cannot print Invoices for 
009940-     "OPEN Order! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 
009950      REVERSE-VIDEO.
009960 01 SCR-b0100xhp-cbl-2094-24 VALUE IS " Must Reprint using POS (F2
009970-     ")! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
009980 01 SCR-b0100xhp-cbl-2111-28 VALUE IS "INVOICE REPRINT NOT ALLOWED
009990-     "." CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
010000 01 SCR-b0100xhp-cbl-2182-23 VALUE IS "Printing Order #: " CONTROL
010010       DSPL--CONTROL LINE 13 COLUMN 28.
010020 01 SCR-b0100xhp-cbl-2233-29 PIC IS X(48) FROM RANGE-ERR-3 CONTROL
010030       DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
010040*01 SCR-b0100xhp-cbl-2576-23 PIC IS X(69) FROM DSP-HEADER CONTROL 
010050*     DSPL--CONTROL LINE 5 COLUMN 8.
010060*01 SCR-b0100xhp-cbl-2577-23 PIC IS X(73) FROM DSP-HEADER2 CONTROL
010070*      DSPL--CONTROL LINE 6 COLUMN 5.
010080*01 SCR-b0100xhp-cbl-2584-23 PIC IS X(63) FROM DSP-LINE CONTROL 
010090*     DSPL--CONTROL LINE 17 COLUMN 5.
010100 01 SCR-b0100xhp-cbl-2608-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
010110      DSPL--CONTROL LINE 20 COLUMN 1.
010120 01 SCR-b0100xhp-cbl-2616-23 PIC IS X(80) FROM CLEAR-21 CONTROL 
010130      DSPL--CONTROL LINE 20 COLUMN 1.
010140*01 SCR-b0100xhp-cbl-2656-20 PIC IS X(63) FROM DSP-LINE CONTROL 
010150*     DSPL--CONTROL LINE CNT2 COLUMN 5.
010160 01 SCR-b0100xhp-cbl-2691-20 VALUE IS "Order" CONTROL 
010170      DSPL--CONTROL LINE 3 COLUMN 1.
010180 01 SCR-b0100xhp-cbl-2692-20 PIC IS X(6) FROM ORDH-ORDER-NO 
010190      CONTROL DSPL--CONTROL LINE 3 COLUMN 10.
010200 01 SCR-b0100xhp-cbl-2693-20 VALUE IS "Customer" CONTROL 
010210      DSPL--CONTROL LINE 5 COLUMN 1.
010220 01 SCR-b0100xhp-cbl-2694-20 PIC IS X(30) FROM ORDH-CUST-NAME 
010230      CONTROL DSPL--CONTROL LINE 5 COLUMN 10.
010240 01 SCR-b0100xhp-cbl-2695-20 PIC IS X(30) FROM ORDH-CUST-ADDR1 
010250      CONTROL DSPL--CONTROL LINE 6 COLUMN 10.
010260 01 SCR-b0100xhp-cbl-2696-20 PIC IS X(30) FROM ORDH-CUST-ADDR2 
010270      CONTROL DSPL--CONTROL LINE 7 COLUMN 10.
010280 01 SCR-b0100xhp-cbl-2697-20 PIC IS X(18) FROM ORDH-CUST-CITY 
010290      CONTROL DSPL--CONTROL LINE 8 COLUMN 10.
010300 01 SCR-b0100xhp-cbl-2698-20 PIC IS X(2) FROM ORDH-CUST-STATE 
010310      CONTROL DSPL--CONTROL LINE 8 COLUMN 29.
010320 01 SCR-b0100xhp-cbl-2699-20 PIC IS X(10) FROM ORDH-CUST-ZIP 
010330      CONTROL DSPL--CONTROL LINE 8 COLUMN 32.
010340 01 SCR-b0100xhp-cbl-2700-20 PIC IS X(51) FROM POS-1 CONTROL 
010350      DSPL--CONTROL LINE 10 COLUMN 5.
010360 01 SCR-b0100xhp-cbl-2701-20 PIC IS X(30) FROM POS-2 CONTROL 
010370      DSPL--CONTROL LINE 11 COLUMN 5.
010380 01 SCR-b0100xhp-cbl-2702-20 PIC IS X(30) FROM POS-3 CONTROL 
010390      DSPL--CONTROL LINE 12 COLUMN 5.
010400 01 SCR-b0100xhp-cbl-2703-20 PIC IS X(30) FROM POS-4 CONTROL 
010410      DSPL--CONTROL LINE 13 COLUMN 5.
010420 01 SCR-b0100xhp-cbl-2704-20 PIC IS X(30) FROM POS-5 CONTROL 
010430      DSPL--CONTROL LINE 14 COLUMN 5.
010440 01 SCR-b0100xhp-cbl-2705-20 PIC IS X(30) FROM POS-6 CONTROL 
010450      DSPL--CONTROL LINE 15 COLUMN 5.
010460 01 SCR-b0100xhp-cbl-2717-20 PIC IS X(15) FROM POS-7 CONTROL 
010470      DSPL--CONTROL LINE 12 COLUMN 44.
010480 01 SCR-b0100xhp-cbl-2729-24 VALUE IS " " CONTROL DSPL--CONTROL 
010490      LINE 12 COLUMN 41 SIZE IS 40.
010500 01 SCR-b0100xhp-cbl-2738-20 PIC IS X(28) FROM POS-8 CONTROL 
010510      DSPL--CONTROL LINE 13 COLUMN 44.
010520 01 SCR-b0100xhp-cbl-2739-20 PIC IS X(33) FROM PRINT-INV-MSG 
010530      CONTROL DSPL--CONTROL LINE 21 COLUMN 20.
010540 01 SCR-b0100xhp-cbl-2745-24 VALUE IS " " CONTROL DSPL--CONTROL 
010550      LINE 13 COLUMN 41 SIZE IS 40.
010560 01 SCR-b0100xhp-cbl-2746-24 VALUE IS " " CONTROL DSPL--CONTROL 
010570      LINE 21 COLUMN 1 SIZE IS 80.
010580 01 SCR-b0100xhp-cbl-2759-20 PIC IS X(33) FROM DATE-QUES CONTROL 
010590      DSPL--CONTROL LINE 07 COLUMN 20.
010600 01 SCR-b0100xhp-cbl-2760-20 VALUE IS "Short Message" CONTROL 
010610      DSPL--CONTROL LINE 09 COLUMN 32.
010620 01 SCR-b0100xhp-cbl-2778-24 PIC IS X(29) FROM DATE-ERROR CONTROL 
010630      DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
010640 01 SCR-b0100xhp-cbl-2820-23 PIC IS X(21) FROM RANGE-MSG CONTROL 
010650      DSPL--CONTROL LINE 11 COLUMN 20.
010660 01 SCR-b0100xhp-cbl-2821-23 VALUE IS "Print Forms by:   " CONTROL
010670       DSPL--CONTROL LINE 10 COLUMN 20.
010680 01 SCR-b0100xhp-cbl-2822-23 VALUE IS "Include:          " CONTROL
010690       DSPL--CONTROL LINE 12 COLUMN 20.
010700 01 SCR-b0100xhp-cbl-2833-25 PIC IS X(30) FROM PRINTING-REPORT 
010710      CONTROL DSPL--CONTROL LINE 12 COLUMN 30.
010720 01 SCR-b0100xhp-cbl-2841-23 PIC IS X(30) FROM PRINTING-REPORT 
010730      CONTROL DSPL--CONTROL LINE 12 COLUMN 30.
010740 01 SCR-b0100xhp-cbl-2850-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
010750      DSPL--CONTROL LINE 12 COLUMN 1.
010760 01 SCR-b0100xhp-cbl-2851-20 PIC IS X(16) FROM RANGE-LOW-MSG 
010770      CONTROL DSPL--CONTROL LINE 12 COLUMN 20.
010780 01 SCR-b0100xhp-cbl-2852-20 PIC IS X(16) FROM RANGE-HIGH-MSG 
010790      CONTROL DSPL--CONTROL LINE 13 COLUMN 20.
010800 01 SCR-b0100xhp-cbl-2864-24 PIC IS X(47) FROM RANGE-ERR-1 CONTROL
010810       DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
010820 01 SCR-b0100xhp-cbl-2868-23 PIC IS X(30) FROM PRINTING-REPORT 
010830      CONTROL DSPL--CONTROL LINE 12 COLUMN 30.
010840 01 SCR-b0100xhp-cbl-2873-24 PIC IS X(51) FROM RANGE-ERR-2 CONTROL
010850       DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
010860 01 SCR-b0100xhp-cbl-2876-20 PIC IS X(30) FROM PRINTING-REPORT 
010870      CONTROL DSPL--CONTROL LINE 12 COLUMN 30.
010880 01 SCR-b0100xhp-cbl-2886-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
010890      DSPL--CONTROL LINE 12 COLUMN 1.
010900 01 SCR-b0100xhp-cbl-2887-20 PIC IS X(35) FROM SELECT-QUES CONTROL
010910       DSPL--CONTROL LINE 12 COLUMN 20.
010920 01 SCR-b0100xhp-cbl-2890-23 VALUE IS "-" CONTROL DSPL--CONTROL 
010930      LINE 12 COLUMN 50.
010940 01 SCR-b0100xhp-cbl-2993-20 PIC IS X(9) FROM PROG-NAME CONTROL 
010950      DSPL--CONTROL LINE 2 COLUMN 9.
010960 01 SCR-b0100xhp-cbl-3074-20 VALUE IS "Checking Order #: " CONTROL
010970       DSPL--CONTROL LINE 13 COLUMN 28.
010980 01 SCR-b0100xhp-cbl-3075-20 PIC IS X(6) FROM ORDH-ORDER-NO 
010990      CONTROL DSPL--CONTROL LINE 13 COLUMN 46.
011000
011010 01 SCR-INV-DATE  VALUE IS "Invoice Date" CONTROL DSPL--CONTROL
011020       LINE 20 COLUMN 50.
011030
011040 PROCEDURE DIVISION.
011050 DECLARATIVES.
011060
011070
011080*    PRNTR.DS   PRINTER DECLARATIVES PROCEDURE.
011090
011100 Z-PRNTR SECTION.
011110     USE AFTER ERROR PROCEDURE ON LO.
011120 Z-PRNTR-D.
011130     COPY "ERRORPRT.SR".
011140     GO TO STATUS-EXIT.
011150     COPY "ORDHF.DS".
011160     COPY "ORDLF.DS".
011170     COPY "SALEF.DS".
011180     COPY "CUSTF.DS".
042809     COPY "ITEMF.DS".
011200     COPY "CNTLF.DS".
011210     COPY "USERF.DS".
011220     COPY "ORAUF.DS".
011230     COPY "EXCNF.DS".
011240*    COPY "SERLF.DS".
011250     COPY "LFPRF.DS".
011260     COPY "EMALF.DS".
010810     COPY "SCATF.DS".
031610     COPY "TAXMF.DS".
042710     COPY "CONTF.DS".
031511     COPY "STYLF.DS".
031511     COPY "COLRF.DS".
011270     GO TO STATUS-EXIT.
011280
011290     COPY "ERRORFIL.SR".
011300
011310 STATUS-EXIT. EXIT.
011320
011330 END DECLARATIVES.
011340
011350 MAIN-PROG SECTION.
011360 OPEN-FILES.
      *     MOVE "SIZECAT.FIL"      TO  SCATF--NAME.
011370     PERFORM USERF-FILL-FULLPATH.
011380     PERFORM PGM-INIT.
011390     PERFORM SCREEN-INIT.
011400     IF NOT LF-YES
011410        GO TO EXIT-RUN.
011420     IF USER-SN = 00335 OR 00112 OR 00196 OR 00238 OR 00003
060809        OR 00010 OR 00011 OR 00191 OR 00242 OR 00117
011430           MOVE USER-SN TO WS-CUSTOMIZED-FLAG
011440           MOVE "B0100XHPM" TO PROG-NAME.
011450     DISPLAY SCR-b0100xhp-cbl-757-20  .
011460     COMPUTE NUMBER-DECIMALS = CNTL-DECIMAL-POS - 1.
011470     PERFORM  OPEN-ORDHF.
011480     PERFORM  OPEN-ORDLF.
011490     PERFORM  OPEN-SALEF.
011500     PERFORM  OPEN-EXCNF.
011510     PERFORM  OPEN-CUSTF.
042809     PERFORM  OPEN-ITEMF.
031610     IF ALLIED 
031610        PERFORM OPEN-TAXMF.
042710     IF DIAZO
042710        PERFORM  OPEN-CONTF.

011530     PERFORM  GET-EMAIL-SETTINGS.
011540     PERFORM LFPRF-INIT.
010810     IF PROFITS-APPAREL-YES
010810        OPEN INPUT SCATF
010810     END-IF.
011550     IF PROFIT-TEAR-SLIP
011560        MOVE "INVOICEH" TO LFPR-FORM-TO-PRINT
011570     ELSE
011580        MOVE "INVOICEV" TO LFPR-FORM-TO-PRINT
011590     END-IF.
011600     MOVE "INVOICE" TO LFPR-FORM-TO-PRINT.
011610
010810     PERFORM STRING-DETAIL-HDR.
032011*     IF JEREMIE
032011      IF JEREMIE OR LIBERTYU
010810        SET PRINT-BARCODE-NO  TO TRUE.
102110     IF SUNBELTS
102110        MOVE "On Account" TO PMT-CODES.

011620 BEGIN-REPORT.
011630*     PERFORM PDFCR-BEGIN-MERGE.
011640     MOVE TODAYS-DATE TO DATE-IN, INV-DATE.
011650     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
011660     MOVE DATE-OUT-11 TO PR-INV-DATE-11.
011670     IF POS-PRINTING
011680        MOVE USER-POS-ORDER TO LOW-ORDHF-KEY
011690        MOVE USER-POS-SUB-ORDER TO LOW-SUB-ORDER
011700     ELSE
011710     IF PROCESS-HISTORY
011720        MOVE ZERO TO INV-DATE, DATE-IN
011730     ELSE
011740     IF NOT PRINT-ACK-ONLY
011750        PERFORM SCREEN-INIT
011760        PERFORM GET-INV-DATE THRU GET-INV-DATE-EXIT
011770        IF FLAG = 4
011780           GO TO EXIT-RUN.
011790     PERFORM SCREEN-INIT.
011800     MOVE "1001000000" TO FKEYS
011810
011820     IF PROCESS-HISTORY
011830        MOVE "IP" TO SPEC-5(2).
011840
011850*-- INSERT LOGIC TO ASK Y/N FOR EACH COPY --*
011860     PERFORM ASK-COPIES THRU ASK-COPIES-EXIT.
011870     IF FLAG = 4 OR 3
011880        GO TO EXIT-RUN.
011890
011900* setup per form settings
011910     EVALUATE LFPR-I-FORM-PMD-NAME
011920        WHEN "INV101"
011930           SET WS-FORM-ID-101 TO TRUE
011940        WHEN "INV102"
011950           SET WS-FORM-ID-102 TO TRUE
011960        WHEN "INV104"
011970           SET WS-FORM-ID-104 TO TRUE
082410        WHEN "INV105"
081410           SET WS-FORM-ID-105 TO TRUE
011980        WHEN "INV106"
011990           SET WS-FORM-ID-106 TO TRUE
011980        WHEN "INV107"
011990           SET WS-FORM-ID-107 TO TRUE
020210        WHEN "DIAZO101"
020210           SET WS-FORM-ID-DIAZO TO TRUE
031511        WHEN "INV110"
031511           SET WS-FORM-ID-110 TO TRUE
012140     END-EVALUATE.
012150     EVALUATE TRUE 
020210        WHEN BODY-LINES-25
020210            MOVE 25 TO BODY-LINES
012160        WHEN BODY-LINES-24
012170            MOVE 24 TO BODY-LINES
012180        WHEN BODY-LINES-39
012190            MOVE 39 TO BODY-LINES
012200        WHEN OTHER
012210            MOVE 35 TO BODY-LINES
012220     END-EVALUATE.

060809     IF SUNBELTS AND WS-FORM-ID-104
060809        MOVE "INVSNBLT" TO WS-OVERLAY-NAME
060809     ELSE
010810     IF JEREMIE AND WS-FORM-ID-101
010810        MOVE "INVNOTAX"   TO WS-OVERLAY-NAME
010810     ELSE
011110     IF PROTECTI AND WS-FORM-ID-101
011110        MOVE "INVNOTAX"   TO WS-OVERLAY-NAME
011110     ELSE
060809        MOVE LFPR-I-FORM-PMD-NAME TO WS-OVERLAY-NAME.

012230
012240     PERFORM PROCESS-REPORT THRU PROCESS-REPORT-EXIT.
012250
012260 END-REPORT.
012270     PERFORM CLOSE-FILES.
012280*     PERFORM PDFCR-END-MERGE.
012290     MOVE "PMENU" TO NEXT-PROG.
012300
012310 EXIT-RUN.
012320     IF POS-PRINTING
012330        IF LAST-OPTION = 020702
012340           MOVE "B0025" TO NEXT-PROG
012350        ELSE
012360        IF LAST-OPTION = 020303
012370           MOVE "B0600" TO NEXT-PROG
012380        ELSE
012390           MOVE "B0000" TO NEXT-PROG.
012400
012410*-- RETURN TO SHIPPING MANAGER --*
012420     IF LAST-OPTION = 020401
012430        MOVE "SM030" TO NEXT-PROG
012440     ELSE
012450*-- RETURN TO WHSE CONTROL --*
012460     IF LAST-OPTION = 020702
012470        MOVE "B0025" TO NEXT-PROG
012480     ELSE
012490     IF USER-LAST-OPTION = 020303
012500        MOVE "B0600" TO NEXT-PROG.
060809*-- JUST IN CASE USERF GETS REWRITTEN THIS WILL RESET THE USERS DEFAULT --* 
060809     IF LAST-OPTION = 020103 OR 020207
060809        SET USER-PDF-INFO-NOT-PROMPTED TO TRUE
060809        REWRITE USERF-REC.
012510     COPY "FINISH.SR".
012520
012530     COPY "CONTROL.SR".
012540     COPY "DATECVT.SR".
012550     COPY "DATECHK.SR".
012560     COPY "DAYWEEK.SR".
012570     COPY "CENTER.SR".
012580
012590******************************************************************
012600 SUBROUTINE SECTION.
012610******************************************************************
012620 PGM-INIT.
012630     PERFORM CONTROL-INIT.
012640     MOVE "Y" TO FORM-STOCK-FLAG.
012650*    0 = NO ESCAPE, 1 = ESCAPABLE
012660     MOVE 1 TO ESC-FLAG.
012670     MOVE 40 TO SOURCE-LEN.
012680     MOVE CNTL-CONAME TO SOURCE-FIELD.
012690     PERFORM LEFT-JUST-FIELD THRU LEFT-JUST-FIELD-EXIT.
012700     MOVE DEST-FIELD TO PR-CONAME-LEFT.
012710
012720     IF LAST-OPTION = 030205
012730        PERFORM GETCP-B0750-PASS-DATA
012740        MOVE 1      TO CHAINED-FROM-CD
012750        MOVE 020101 TO LAST-OPTION
012760        MOVE 1      TO WS-RESET-CD.
012770
012780     MOVE "O" TO PROCESS-ORDERS-FLAG.                            
012790     IF LAST-OPTION = 020101 OR 020103 OR 020303
012800        MOVE "I" TO PROCESS-ORDERS-FLAG
012810     ELSE
012820     IF LAST-OPTION = 020601 OR 020602 OR 020603 OR 030202
012830        MOVE "H" TO PROCESS-ORDERS-FLAG
012840        MOVE NORM-ATTR TO ATTR1 OF RANGE-SPEC-3(1),
012850                          ATTR1 OF RANGE-SPEC-3(2).
012860
012870     IF LAST-OPTION = 020101 OR 020204 OR 020601 OR 
012880*       020303 OR 020608
012890        020303 OR 020608 OR 030202
012900        MOVE "P" TO RANGE-TYPE-FLAG.
012910
012920*- IF UPS SM, TREAT AS POS --*
012930     IF LAST-OPTION = 020702
012940        MOVE "P" TO RANGE-TYPE-FLAG
012950*-- USER-ORDER-TYPE-FLAG TELLS WHICH FILE ORDER IS IN --*
012960        IF USER-INVOICING
012970           MOVE "I" TO PROCESS-ORDERS-FLAG
012980        ELSE
012990           MOVE "O" TO PROCESS-ORDERS-FLAG.
013000
013010     IF PRINT-ACK-ONLY
013020        MOVE "ACKNOWLDGE" TO QUEUE-DEFAULT-NAME
013030     ELSE
013040        MOVE "INVOICE " TO QUEUE-DEFAULT-NAME.
013050
013060
013070     IF PROCESS-OPEN-ORDERS
013080         MOVE 8 TO FLEN OF RANGE-SPEC-1(1)
013090         MOVE "OPENHDR.FIL" TO EXT-HDR-FILE
013100         MOVE "OPENLINE.FIL" TO EXT-LIN-FILE
013110     ELSE
013120     IF PROCESS-INVOICES
013130         MOVE "ORDERH.FIL" TO EXT-HDR-FILE
013140         MOVE "ORDERL.FIL" TO EXT-LIN-FILE
013150     ELSE
013160     IF PROCESS-HISTORY
013170         MOVE "ORDHSTH.FIL" TO EXT-HDR-FILE
013180         MOVE "ORDHSTL.FIL" TO EXT-LIN-FILE.
013190
013200     MOVE EXT-LIN-FILE TO ORDLF--NAME
013210      PERFORM ORDLF-FILL-FULLPATH.
013220     PERFORM CALL-ASSIGN-HDR.
013230     IF POST-BY-BATCH-BOTH OR
013240        (POST-BY-BATCH-NEW AND PROCESS-INVOICES) OR
013250        (POST-BY-BATCH-OPEN AND PROCESS-OPEN-ORDERS)
013260           NEXT SENTENCE
013270     ELSE
013280        MOVE SPACES TO BY-BATCH.
013290
013300*    MOVE SPACES  TO ON-SCREEN.
013310*    MOVE "FaxWare" TO EZFAX. 
013320*    MOVE 4    TO WS-DEFAULT-CODES.
013330     MOVE ZERO TO COPIES-PRINTED.
013340
013350*- Read Msg  Control Record --*
013360     MOVE 3 TO CNTLF-KEY.
013370     PERFORM READ-CNTLF.
013380     MOVE CNTL3-SHORT-MSG TO SHORT-MSG-LINES.
013390*    MOVE CNTL3-LONG-MSG  TO LONG-MSG-LINES.
013400
013410*- Read Form Control Record --*
013420*    MOVE 13 TO CNTLF-KEY.
013430*    PERFORM READ-LASER-CNTLF-REC.
013440
013450
013460*-- NEEDED UNTIL LFPR FINISHED --*
013470*    MOVE 13 TO CNTLF-KEY.
013480*    PERFORM READ-LASER-CNTLF-REC.
013490
013500
013510     CLOSE CNTLF.
013520     OPEN I-O CNTLF.
013530     MOVE 1 TO CNTLF-KEY.
013540     PERFORM READ-CNTLF.
013550
013560     COPY "SCRNINIT.SR".
013570     COPY "STRGFAX.SR".
013580     COPY "SENDMAIL.SR".
040609     COPY "MSGBOX.SR".
013590
013600 CALL-ASSIGN-HDR.
013610     MOVE EXT-HDR-FILE TO ORDHF--NAME
013620      PERFORM ORDHF-FILL-FULLPATH.
013630
013640 MOVE-TOTALS.
013650*-- GET HEADER READY FOR REWRITE --*
013660     IF MARK-DOWNS
013670         COMPUTE ORDH-GROSS-AMT = ORDH-NET-AMT + ORDH-DISC-AMT
013680     ELSE COMPUTE ORDH-GROSS-AMT = ORDH-NET-AMT - ORDH-DISC-AMT.
013690
013700     IF PROCESS-HISTORY
013710        NEXT SENTENCE
013720     ELSE
013730        PERFORM COMPUTE-TAXES.  
013740
013750     IF PROCESS-HISTORY
013760        NEXT SENTENCE
013770     ELSE
013780     IF ORDH-POS-CD = 0
013790        COMPUTE ORDH-INV-AMT = ORDH-NET-AMT + ORDH-SPCHG-AMT +
013800                ORDH-FREIGHT-AMT + ORDH-TAX-AMT. 
013810
013820     IF PROCESS-HISTORY
013830        NEXT SENTENCE
013840     ELSE
013850     IF ORDH-POS-CD = 0
013860        IF ORDH-CASH-ORDER
013870           MOVE ORDH-INV-AMT TO ORDH-DEP-AMT.
013880     IF CREDIT-MEMO
013890         MOVE 0 TO ORDH-CSHDISC-AMT
013900     ELSE COMPUTE ORDH-CSHDISC-AMT ROUNDED =
013910*           ORDH-NET-AMT * EXCN-TERM-PCT(ORDH-TERM-CD) / 100.
013920            ORDH-NET-AMT * ORDH-DISC-PCT / 100.00000 ON SIZE ERROR
013930             MOVE ZERO TO ORDH-CSHDISC-AMT END-COMPUTE.
013940     MOVE 1 TO ORDH-PRINT-ONCE-CD.
013950
013960     COMPUTE TOT-PROFIT-AMT = ORDH-NET-AMT - ORDH-COST-AMT.
013970     IF ORDH-NET-AMT NOT = 0
013980         COMPUTE TS-PROFIT-PCT ROUNDED =
013990           TOT-PROFIT-AMT / ORDH-NET-AMT * 100.00000 ON SIZE ERROR
014000            MOVE ZERO TO TS-PROFIT-PCT END-COMPUTE
014010     ELSE MOVE 0 TO TS-PROFIT-PCT.
014020     MOVE ORDH-COST-AMT TO TS-COST-AMT.
014030     MOVE TOT-PROFIT-AMT TO TS-PROFIT-AMT.
014040     MOVE TAX-AMT(3) TO TS-TAX-3.
014050     MOVE TAX-AMT(2) TO TS-TAX-2.
014060     MOVE TAX-AMT(1) TO TS-TAX-1.
031610     IF ALLIED
031610        MOVE TAX-RATE3 TO TS-TAX-3
031610        MOVE TAX-RATE4 TO TS-TAX-2.
014070     IF PROCESS-HISTORY
014080        COMPUTE TS-INV-AMT = ORDH-INV-AMT - ORDH-DEP-AMT
014090     ELSE
014100     IF ORDH-POS-CD = 0
014110        COMPUTE TS-INV-AMT = ORDH-INV-AMT 
014120                - ORDH-DEP-AMT
014130     ELSE
014140        COMPUTE TS-INV-AMT = ORDH-INV-AMT - ORDH-DEP-AMT.
014150     MOVE ORDH-CSHDISC-AMT TO TS-CASH-DISC.
020210     IF DIAZO
020210        IF COPIES-PRINTED = 2
020210           MOVE ZERO TO PR-DISC-TOTAL OF DIAZO101
020210        ELSE
020210           MOVE TS-INV-AMT  TO PR-DISC-TOTAL OF DIAZO101
020210        END-IF
020210        COMPUTE TS-INV-AMT2 = WS-INV-AMT2 + TOT-TAX-AMT-RETAIL
020210        MOVE TS-INV-AMT2  TO PR-NET-TOTAL OF DIAZO101.
014160
014170 ADD-TAXES.
014180     IF ORDL-TAX-CD(I) = 1 AND ORDH-TAX-PCT(I) NOT = 0
014190         ADD ORDL-EXT-AMT TO TAXABLE(I)
020210         ADD WS-ITEM-PRICE TO TAXABLE-RETAIL(I)
020210     ELSE
020210         ADD ORDL-EXT-AMT TO NON-TAXABLE(I).
014200
014210 CALC-TAX-TOTALS.
014220     COMPUTE TAX-AMT(I) ROUNDED, TAX-RND(I) ROUNDED =
014230         TAXABLE(I) * ORDH-TAX-PCT(I) / 100.00000 ON SIZE ERROR 
014240         MOVE ZERO TO TAX-AMT(I) TAX-RND(I) END-COMPUTE.
014250     MOVE TAXABLE(I) TO TEMP-TAXABLE(I).
020210     COMPUTE TAX-AMT-RETAIL(I) ROUNDED =
020210         TAXABLE-RETAIL(I) * ORDH-TAX-PCT(I) / 100.00000
020210         ON SIZE ERROR MOVE ZERO TO TAX-AMT-RETAIL(I) END-COMPUTE.
020210*****     MOVE ZERO TO TAXABLE-RETAIL(I).
031610     IF I = 3
031610        MOVE TAX-AMT(3) TO TAX-RATE3
031610     ELSE
031610     IF I > 3
031610        ADD TAX-AMT(I)  TO TAX-RATE4.
014270
014280 GET-BATCH-NO.
014290     DISPLAY SCR-b0100xhp-cbl-987-20  .
014300     MOVE "1010000000" TO FKEYS.
014310     MOVE 0 TO FLAG.
014320     PERFORM STEST-b0100xhp-cbl-990
014330     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
014340      BATCH-HELP,
014350          USER-BATCH-NO
014360     PERFORM STEST-AFTER-CALL.
014370     IF USER-BATCH-NO = ZERO AND FLAG NOT = 3
014380        DISPLAY SCR-b0100xhp-cbl-993-23
014390              
014400        GO TO GET-BATCH-NO.
014410
014420*PRINT-3OF9-ORDER-NO.
014430*    ADD 60 TO VERT-POS.
014440*    PERFORM MOVE-SPACES-TO-PRINT-REC.
014450*    STRING HP-VERT-HORZ     DELIMITED BY SIZE
014460*           SET-BARCODE-ON          DELIMITED BY SIZE,
014470*           "{"                     DELIMITED BY SIZE,
014480*           ORDH-ORDER-NO           DELIMITED BY SIZE,
014490*           "}"                     DELIMITED BY SIZE,
014500*           INTO PRINT-REC.
014510*********           PERFORM WRITE-PRINT-REC-B4-ZERO.
014520
014530*GET-CLASS.
014540*    MOVE ZERO TO FLAG.
014550*    CALL "CHGDIR" USING MASTER-DIR, RETURN-CD.
014560*    MOVE "B0108" TO NEXT-PROG.
014570*    CLOSE CNTLF, USERF.
014580*    MOVE ORDL-ITEM-CLASS TO WS-ITEM-CLASS.
014590*    MOVE ORDL-ITEM-NO TO WS-ITEM-NO.
014600*    IF MULTI-WHSE
014610*       MOVE ORDH-WHSE-NO TO WS-ITEM-WHSE-NO.
014620*    MOVE ORDL-ITEM-PRICE TO WS-ITEM-PRICE.
014630*    MOVE ORDL-PRICE-CD TO WS-PRICE-CD.
014640*    CALL "CHAINR" USING NEXT-PROG, WS-INPUT, RETURN-CD.
014650*    OPEN I-O USERF.
014660*    OPEN I-O CNTLF.
014670*    MOVE "PMENU" TO NEXT-PROG.
014680*    DISPLAY PROG-NAME LINE 2 POSITION 9.
014690
014700 CHAINR-PROG.
014710     PERFORM CHNR--PARM-BLOCK-DOS-RET-CODE.
014720
014730*    COPY "COPYFILE.SR".
014740     COPY "COPYFIL2.SR".
014750
014760 PREPARE-PRINT-FILE.
014770     ADD 1 TO COPIES-PRINTED.
014780     PERFORM LFPR-PREPARE-PRINT-NEXT.
014790     IF NOT LFPR-NO-MORE-COPY
014800        IF LFPR-DONTPRINT-THIS-COPY
014810           GO TO PREPARE-PRINT-FILE.
014820     IF NOT LFPR-NO-MORE-COPY
014830        MOVE 9 TO USER-PTR-CHN
014840        PERFORM CHECK-ELECTRONIC-FORMAT
040609        SET EMAIL-RESEND-YES TO TRUE
040609        IF EMAIL-PDF-YES AND INVOICE-PRINTED-YES
040609           MOVE SPACES TO EMAIL-RESEND-COMMENT
                 COMPUTE I = FUNCTION 
                       STORED-CHAR-LENGTH(CUST-NAME-KEY) 
040609           STRING
                     "Invoice " DELIMITED BY SIZE
                     ORDH-ORDER-NO DELIMITED BY SIZE
                     " ALREADY SENT TO " DELIMITED BY SIZE
                     CUST-NAME-KEY(1:I) DELIMITED BY SIZE
                     ". RESEND? " DELIMITED BY SIZE
                     INTO EMAIL-RESEND-COMMENT
040609           PERFORM ASK-EMAIL-RESEND
040609           IF EMAIL-RESEND-NO
040609               GO TO PREPARE-PRINT-FILE
040609           END-IF
040609        END-IF  
092609        MOVE LFPR-PRINTER-NAME-TO-PRINT TO PDFCR-PRINTER-NAME 
092609        IF DIAZO
112310*          IF NOT WIN-PRINTER-PDF
112310*             MOVE "EMPTY" TO WS-OVERLAY-NAME
112310*          ELSE
020210              MOVE LFPR-I-FORM-PMD-NAME TO WS-OVERLAY-NAME
112310*          END-IF
020210        END-IF
014850        PERFORM OPEN-LO-LASER
014860     END-IF.
014870
014880 COMPUTE-TAXES.
014890     MOVE ZEROES TO TOT-TAX-AMT, DIFF-TAX.
020210     MOVE ZEROES TO TOT-TAX-AMT-RETAIL.
020210     MOVE ZEROES TO TAX-AMT-RETAIL(1), TAX-AMT-RETAIL(2),
020210                    TAX-AMT-RETAIL(3).
031610     MOVE ZEROES TO TAX-RATE3, TAX-RATE4.
014900     PERFORM CALC-TAX-TOTALS
014910         VARYING I FROM 1 BY 1 UNTIL I > 3.
014920     COMPUTE ORDH-TAX-AMT ROUNDED =
014930           TAX-RND(1) + TAX-RND(2) + TAX-RND(3).
014940     COMPUTE TOT-TAX-AMT = TAX-AMT(1) + TAX-AMT(2) + TAX-AMT(3).
020210     COMPUTE TOT-TAX-AMT-RETAIL =
020210        TAX-AMT-RETAIL(1) + TAX-AMT-RETAIL(2) + TAX-AMT-RETAIL(3).

031610     IF ALLIED
031610        PERFORM COMPUTE-CITY-COUNTY-TAXES.

014950     COMPUTE DIFF-TAX = ORDH-TAX-AMT - TOT-TAX-AMT.
032910     ADD DIFF-TAX TO TOT-TAX-AMT.
014960     IF TEMP-TAXABLE(1) NOT = ZEROES
014970         ADD DIFF-TAX TO TAX-AMT(1)
014980         MOVE ZEROES TO DIFF-TAX, TEMP-TAXABLE(1).
014990     IF TEMP-TAXABLE(2) NOT = ZEROES
015000         ADD DIFF-TAX TO TAX-AMT(2)
015010         MOVE ZEROES TO DIFF-TAX, TEMP-TAXABLE(2).
015020     IF TEMP-TAXABLE(3) NOT = ZEROES
015030         ADD DIFF-TAX TO TAX-AMT(3)
015040         MOVE ZEROES TO DIFF-TAX, TEMP-TAXABLE(3).
015050

031610 COMPUTE-CITY-COUNTY-TAXES.
031610     IF ORDH-SHIP-STATE = SPACES
031610        MOVE ORDH-CUST-STATE TO TAX-ST
031610     ELSE
031610        MOVE ORDH-SHIP-STATE TO TAX-ST.
031610     MOVE ORDH-TAX-AREA   TO TAX-AREA.
031610     IF TAX-ST NOT = "GA"
031610        PERFORM READ-TAXMF
031610        IF C-FOUND OF TAXMF-STATUS
031610           COMPUTE TAX-PCT(3) = TAX-PCT(3) - TAX-PCT(4)
031610           COMPUTE TAX-RATE3 ROUNDED = 
                         (TAX-PCT(3) / 100) * TEMP-TAXABLE(3) 
031610           COMPUTE TAX-RATE4 ROUNDED =
                         (TAX-PCT(4) / 100) * TEMP-TAXABLE(3) 
031610           COMPUTE DIFF-TAX = TAX-AMT(3) - (TAX-RATE3 + TAX-RATE4)
031610           IF DIFF-TAX NOT = ZERO
031610              ADD DIFF-TAX TO TAX-RATE4
031610           END-IF 
031610        ELSE
031610           MOVE ZERO TO TAX-RATE3, TAX-RATE4.

015060 PRINT-CASH-DISC-MSG.
015070     SUBTRACT ORDH-DUE-DAYS FROM JULIAN-DAYS.
015080     ADD ORDH-DISC-DAYS     TO   JULIAN-DAYS.
015090     PERFORM JULIAN-TO-MMDDYYYY THRU JULIAN-TO-MMDDYYYY-EXIT.
015100     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
015110*    MOVE 7400 TO VERT-POS.
015120*    IF PROFIT-TEAR-SLIP
015130*       SUBTRACT 1770 FROM VERT-POS.
015140*    MOVE 0100 TO HORZ-POS.
015150*    MOVE 11 TO POINT-SIZE.
015160*    STRING HP-VERT-HORZ           DELIMITED BY SIZE,
015170*           HP-POINT-SIZE          DELIMITED BY SIZE,
015180*           HP-ITALIC              DELIMITED BY SIZE
015190     MOVE SPACES TO PR-CASH-DISC-MSG2 OF INVFRM.
015200     MOVE SPACES TO PR-CASH-DISC-MSG  OF INVFRM.
015210     IF PR-FORM-TYPE-LESS OF INVFRM = "ACKNOWLEDGEMENT"
015220        NEXT SENTENCE
015230     ELSE
015240     IF PROTECTI
015250        MOVE SPACES TO PR-CASH-DISC-MSG OF INVFRM
015260                       PR-CASH-DISC-MSG2 OF INVFRM
015270                       PR-TS-CASH-DISC  OF INVFRM
015280     ELSE
015290        STRING
015300               "If paid by "          DELIMITED BY SIZE
015310               DATE-OUT-11            DELIMITED BY SIZE
015320               INTO PR-CASH-DISC-MSG OF INVFRM
015330        STRING "Deduct this amount"   DELIMITED BY SIZE
015340               INTO PR-CASH-DISC-MSG2 OF INVFRM.
015350
015360
015370 LOAD-LFPR-DATA .
015380*- needed for lfpr login -*
015390
015400 CHECK-ELECTRONIC-FORMAT.   
015410     IF LFPR-CURR-COPYSEQ = 2
015420        MOVE ORDH-CUST-NO   TO CUST-NUMBER
015430        PERFORM READ-CUSTF
015440        IF C-FOUND OF CUSTF-STATUS
015450           IF PDF-INVOICE-YES
032910              AND CUST-CONTACT-1-EMAIL NOT = SPACES
015460                SET EMAIL-PDF-YES    TO TRUE
015470                MOVE CUST-CONTACT-1-EMAIL TO WS-TO-ADDR 
015480           ELSE
015490              SET EMAIL-PDF-NO     TO TRUE
015500              MOVE SPACES          TO WS-TO-ADDR
015510        ELSE
015520           SET EMAIL-PDF-NO    TO TRUE
015530           MOVE SPACES         TO WS-TO-ADDR
015540     ELSE
015550        SET EMAIL-PDF-NO    TO TRUE
015560        MOVE SPACES         TO WS-TO-ADDR.
015570
032210     IF DIAZO
032210        IF EMAIL-PDF-YES
032210           MOVE "ProfitsPDF" to LFPR-PRINTER-NAME-TO-PRINT.
015580
015590 WRITE-NOTFOUND-TEXT.
100110     IF BULK-PRINT-YES
015600        MOVE SPACES TO DOS-COMMAND
015610        STRING "ECHO "          DELIMITED BY SIZE
015620               ASCII-ORDER-NO    DELIMITED BY SIZE
015630               ASCII-SUB-ORDER-NO DELIMITED BY SIZE
015640               " >> ORDERS.BAD" DELIMITED BY SIZE
015650               INTO DOS-COMMAND
015660        PERFORM CALL-CHAINR THRU CALL-CHAINR-EXIT
015670        ADD 1 TO WS-BAD-ORDERS.
015680
050109 MOVE-TO-BOTTOM.
021810     IF BODY-LINES NOT < LINE-CNT - 2
021810        MOVE ZERO TO CNT
021810     ELSE
050109        COMPUTE CNT = BODY-LINES - LINE-CNT - 2.
050109     IF CNT > ZERO
050109        MOVE SPACES TO PR-DETAIL-LINE OF INVFRM,
020210                       PR-DETAIL-LINE OF DIAZO101
050109        PERFORM WITH TEST BEFORE VARYING CNT FROM CNT
05019           BY -1 UNTIL CNT = ZERO
050109           PERFORM WRITE-INVFRM
050109           ADD 1 TO LINE-CNT
050109        END-PERFORM
050109     END-IF.

010810 STRING-DETAIL-HDR.
010810      MOVE SPACES TO PR-DETAIL-HDR OF INVFRM.
010810      IF PROFITS-APPAREL-YES
010810         STRING " ORDER"          DELIMITED BY SIZE
010810                "    SHIP"        DELIMITED BY SIZE
010810                "    B/O "        DELIMITED BY SIZE
010810                "STYLE CLR"       DELIMITED BY SIZE
010810                " SZ "            DELIMITED BY SIZE
010810                "CAT."            DELIMITED BY SIZE
010810                "   DESCRIPTION"  DELIMITED BY SIZE
010810                "     "           DELIMITED BY SIZE
010810                " UNIT PRICE "    DELIMITED BY SIZE
010810                " EXT. AMT"     DELIMITED BY SIZE
010810                INTO PR-DETAIL-HDR OF INVFRM
031511         MOVE "ORDER"           TO PR-ORDER-LABEL OF INV110
031511         MOVE "SHIP"            TO PR-SHIP-LABEL  OF INV110
031511         MOVE "B/O"             TO PR-BACKORD-LABEL OF INV110
031511         MOVE "DESCRIPTION"     TO PR-DESC-LABEL  OF INV110
031511         IF LIBERTYU
031511            MOVE "STYLE          SIZE    LENGTH" 
031511                 TO PR-ITEM-NBR-LABEL  OF INV110
031511         ELSE
031511            MOVE "STYLE   CLR  SIZE  CATEGORY" 
                       TO PR-ITEM-NBR-LABEL  OF INV110
031511         END-IF
031511         MOVE "UNIT PRICE"      TO PR-UNIT-PRICE-LABEL OF INV110
031511         MOVE "EXT. AMT "       TO PR-EXT-AMT-LABEL  OF INV110

010810      ELSE
032110        MOVE "ORDER"            TO PR-ORDER-LABEL OF INVFRM
032110        MOVE "SHIP"             TO PR-SHIP-LABEL OF INVFRM
032110        MOVE "B/O"              TO PR-BACKORD-LABEL OF INVFRM
032110        MOVE "ITEM NUMBER"      TO PR-ITEM-NBR-LABEL OF INVFRM
032110        MOVE "DESCRIPTION"      TO PR-DESC-LABEL OF INVFRM
032110        MOVE "UNIT PRICE"       TO PR-UNIT-PRICE-LABEL OF INVFRM
082410        MOVE "      UNIT"       TO PR-UNIT-PRICE-LABEL OF INV105
032110        MOVE "EXT. AMT."        TO PR-EXT-AMT-LABEL OF INVFRM
082410        MOVE   "      NET"      TO PR-NET-PRICE-LABEL OF INV105.

020210 GET-RETAIL-PRICE.
020210     COMPUTE WS-SQ-FT ROUNDED = ORDL-SQ-FT * ORDL-SHIP-QTY.
020210     IF WS-DEC-PART > 1
020210         MOVE 0 TO WS-DEC-PART
020210         ADD 1 TO WS-FT-PART.
020210     IF ORDL-MARKUP-PCT-ALPH = SPACES
020210         MOVE 0 TO ORDL-MARKUP-PCT.
020210
020210     IF ORDL-SQ-FT = 0
020210             COMPUTE WS-ITEM-PRICE ROUNDED =
020210               (ORDL-ITEM-PRICE * ORDL-SHIP-QTY) +
020210               (ORDL-ITEM-PRICE * ORDL-SHIP-QTY *
020210               ORDL-MARKUP-PCT / 100.00000) ON SIZE ERROR
020210               MOVE ZERO TO WS-ITEM-PRICE END-COMPUTE
020200     ELSE
020210             COMPUTE WS-ITEM-PRICE ROUNDED =
020210               (ORDL-ITEM-PRICE * WS-SQ-FT) +
020210               (ORDL-ITEM-PRICE * WS-SQ-FT *
020210               ORDL-MARKUP-PCT / 100.00000) ON SIZE ERROR
020210               MOVE ZERO TO WS-ITEM-PRICE END-COMPUTE.

020210     MOVE WS-ITEM-PRICE  TO PR-EXT-AMT-DIAZO.
020210     IF COPIES-PRINTED = 2
020210        MOVE ZEROES   TO  PR-DISC-DIAZO, PR-ITEM-PRICE-DIAZO,
020210     ELSE
020210        MOVE ORDL-ITEM-PRICE TO PR-DISC-DIAZO
020210        MOVE ORDL-EXT-AMT  TO PR-ITEM-PRICE-DIAZO.

020210     IF SPC-ITEM
020210        MOVE ORDL-EXT-AMT TO PR-EXT-AMT-DIAZO.
010710
015690 SUBROUTINE-EXIT. EXIT.
015700
015710 GET-TAXABLE SECTION.
015720 G-T-B.
015730     MOVE ZERO TO TAXABLE(1), NON-TAXABLE(1), TAX-AMT(1)
015740                  TAXABLE(2), NON-TAXABLE(2), TAX-AMT(2)
015750                  TAXABLE(3), NON-TAXABLE(3), TAX-AMT(3).
020210     MOVE ZERO TO TAXABLE-RETAIL(1), TAXABLE-RETAIL(2),
020210                  TAXABLE-RETAIL(3).
015760     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
015770     MOVE 0 TO ORDL-SEQ-NO.
015780     PERFORM START-ORDLF-GREATER.
015790     IF NOT C-AT-END OF ORDLF-STATUS
015800         PERFORM READ-ORDLF-NEXT.
015810
015820 G-T-LOOP.
015830     IF C-AT-END OF ORDLF-STATUS
015840        GO TO GET-TAXABLE-EXIT.
015850     IF CREDIT-MEMO
032910         COMPUTE ORDL-SHIP-QTY = ORDL-SHIP-QTY * -1
015860         COMPUTE ORDL-EXT-AMT = ORDL-EXT-AMT * -1
015870         COMPUTE ORDL-EXT-COST = ORDL-EXT-COST * -1.
015880     MOVE ORDL-ITEM-NO TO SPC-ITEM-NO.
015890
020210     PERFORM GET-RETAIL-PRICE.
015900     IF NOT COMMENT
015910        PERFORM ADD-TAXES VARYING I FROM 1 BY 1 UNTIL I > 3.
015930     IF WS-FORM-ID-107-104 AND FREIGHT
015940        ADD ORDL-EXT-AMT  TO WS-TOT-Freight
015950     END-IF.
015970     IF WS-FORM-ID-107-104 AND  SPC-CHG
091410        IF NOT AGRIBUS
015980           ADD ORDL-EXT-AMT  TO WS-TOT-Spc-Chg
091410        END-IF        
015990     END-IF.
016010     IF WS-FORM-ID-107-104 AND ORDL-ITEM-NO = "E"
016020        ADD ORDL-EXT-AMT TO WS-TOT-EVACUATION-AMT.
016030
016040     PERFORM READ-ORDLF-NEXT.
016050     GO TO G-T-LOOP.
016060
016070 GET-TAXABLE-EXIT. EXIT.
016080
016090 SHORT-MSG SECTION.
016100 SHORT-MSG-BEGIN.
016110*    IF SHORT-MSG-LINES = SPACES
016120*       GO TO SHORT-MSG-EXIT.
016130*    MOVE 3000     TO POS-X,  HP-BOX-PX.
016140*    MOVE 1975     TO POS-Y,  HP-BOX-PY.
016150*    MOVE 1100     TO SIZE-X, HP-BOX-SX.
016160*    MOVE 0200     TO SIZE-Y, HP-BOX-SY.
016170*    IF PROFIT-TEAR-SLIP
016180*       COMPUTE HP-BOX-PY, POS-Y = POS-Y - 1000
016190*       COMPUTE HP-BOX-PX, POS-X = POS-X + 1700.
016200*    IF INVOICE-107
016210*       MOVE 0175     TO POS-X,  HP-BOX-PX
016220*       MOVE 0800     TO POS-Y,  HP-BOX-PY
016230*    END-IF.
016240*    PERFORM DRAW-BOX THRU DRAW-BOX-EXIT.
016250*    MOVE 2125 TO VERT-POS.
016260*    MOVE 3100 TO HORZ-POS.
016270*    MOVE 1400 TO HORZ-POS.
016280*    IF PROFIT-TEAR-SLIP
016290*       COMPUTE VERT-POS = VERT-POS - 1000.
016300*       COMPUTE HORZ-POS = HORZ-POS + 1700.
016310*    IF INVOICE-107
016320*       MOVE 0225 TO HORZ-POS
016330*       MOVE 0950 TO VERT-POS
016340*    END-IF.
016350*    MOVE 10   TO POINT-SIZE.
016360*    PERFORM MOVE-SPACES-TO-PRINT-REC.
016370*    STRING HP-VERT-HORZ-POINT DELIMITED BY SIZE,
016380*           SHORT-MSG-1        DELIMITED BY SIZE,
016390*           INTO PRINT-REC.
016400*    PERFORM WRITE-PRINT-REC-B4-ONE.
016410*    PERFORM MOVE-SPACES-TO-PRINT-REC.
016420*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
016430*           SHORT-MSG-2           DELIMITED BY SIZE,
016440*           INTO PRINT-REC.
016450*    PERFORM WRITE-PRINT-REC-B4-ONE.
016460*    PERFORM MOVE-SPACES-TO-PRINT-REC.
016470*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
016480*           SHORT-MSG-3           DELIMITED BY SIZE,
016490*           INTO PRINT-REC.
016500*    PERFORM WRITE-PRINT-REC-B4-ONE.
020210     IF DIAZO
020210        MOVE SHORT-MSG-1 TO PR-SHORT-MSG-1 OF DIAZO101
020210        MOVE SHORT-MSG-2 TO PR-SHORT-MSG-2 OF DIAZO101
020210        MOVE SHORT-MSG-3 TO PR-SHORT-MSG-3 OF DIAZO101
020210        ACCEPT TIME-ACCP FROM TIME
020210        MOVE A-HOUR      TO WS-TIME-HH
020210        MOVE A-MINUTE    TO WS-TIME-MM
020210        MOVE WS-TIME     TO PR-PRINT-TIME
020210     ELSE
016510        MOVE SHORT-MSG-1 TO PR-SHORT-MSG-1 OF INVFRM
016520        MOVE SHORT-MSG-2 TO PR-SHORT-MSG-2 OF INVFRM
016530        MOVE SHORT-MSG-3 TO PR-SHORT-MSG-3 OF INVFRM.
016540     
016550 SHORT-MSG-EXIT. EXIT.
016560 
016570*DRAW-BOX SECTION.
016580*DRAW-BOX-START.
016590*    MOVE 0        TO HP-BOX-FILL.
016600*    WRITE PRINT-REC FROM HP-BOX BEFORE ADVANCING 1.
016610*    COMPUTE HP-BOX-PX = POS-X + 10.
016620*    COMPUTE HP-BOX-PY = POS-Y + 10.
016630*    COMPUTE HP-BOX-SX = SIZE-X - 20.
016640*    COMPUTE HP-BOX-SY = SIZE-Y - 20.
016650*    MOVE 1        TO HP-BOX-FILL.
016660*    WRITE PRINT-REC FROM HP-BOX BEFORE ADVANCING 1.
016670*DRAW-BOX-EXIT. EXIT.
016680
016690******************************************************************
016700 COMPUTE-DUE-DATE SECTION.
016710******************************************************************
016720 COMPUTE-DUE-DATE-START.
016730     IF ORDH-AGE-DATE NOT = ZERO
016740        MOVE ORDH-AGE-DATE TO DATE-IN
016750     ELSE
016760        MOVE ORDH-INV-DATE TO DATE-IN.
016770     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
016780     IF JULIAN-DAYS = ZERO
016790        MOVE SPACES TO DATE-OUT
016800        GO TO COMPUTE-DUE-DATE-EXIT.
016810*    ADD EXCN-TERM-DUE-DAY(ORDH-TERM-CD) TO JULIAN-DAYS.
016820     ADD ORDH-DUE-DAYS                   TO JULIAN-DAYS.
016830     PERFORM JULIAN-TO-MMDDYYYY THRU JULIAN-TO-MMDDYYYY-EXIT.
016840     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
016850
016860 COMPUTE-DUE-DATE-EXIT. EXIT.
016870
016880******************************************************************
016890 PRINT-FORM SECTION.
016900******************************************************************
016910
016920     COPY "LASRHDR.SR" REPLACING LASER-IO-FORM BY INVFRM.
016930
016940 PRINT-HEADER-INFO.
016950*-- SET CAP (CURRENT ACTIVE POSITION) TO 0,0 --*
016960*    WRITE PRINT-REC FROM HP-SET-MARGIN BEFORE ZERO.
016970
031511*--- WITHOUT THIS IF, WE LOOSE THE RIGHT HALF OF THE BODY HEADER LINE
031511*     IF LIBERTYU OR JEREMIE
031511*        NEXT SENTENCE
031511*     ELSE
016980      IF PROTECTI
011101         MOVE SPACES TO PR-HDR-MSG-1 OF INVFRM
017000         STRING "Mail Payment To: "  DELIMITED BY SIZE
017010                "5021 Paysphere Circle, " DELIMITED BY SIZE
017020                "Chicago, IL 60674"  DELIMITED BY SIZE
011110                INTO PR-HDR-MSG-1 OF INVFRM
017050         MOVE "NO RETURNS WITHOUT AUTHORIZATION" TO
                    PR-HDR-MSG-2 OF INVFRM
090310       ELSE
090310          MOVE SPACES TO PR-HDR-MSG-1 OF INVFRM,
                               PR-HDR-MSG-2 OF INVFRM,
                               PR-HDR-MSG-1 OF INVFRM,
                               PR-HDR-MSG-2 OF INVFRM.
.
017060
017070     IF PROCESS-HISTORY
017080        MOVE ORDH-INV-DATE TO DATE-IN
017090        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
017100        MOVE DATE-OUT-11 TO PR-INV-DATE-11.
017110*-- Print ORDER Date and ORDER NO. --*
017120     MOVE PR-INV-DATE-11 TO PR-DATE-11 OF INVFRM.
017130
017140     IF NOT OPEN-ORDER AND NOT PROCESS-HISTORY
017150        MOVE 1 TO ORDH-PRINT-CD
017160        MOVE INV-DATE TO ORDH-INV-DATE.
017170
017180     IF ORDH-INV-NO = 0 AND NOT OPEN-ORDER
017190        PERFORM GET-INV-NUMBER THRU GET-INV-NUMBER-EXIT.
017200
017210     IF OPEN-ORDER
017220        MOVE ZERO TO PR-INVNO
017230     ELSE
017240        MOVE ORDH-INV-NO TO PR-INVNO
017250        IF ORDH-REPRINT-SEQ > 0
017260           MOVE "-" TO PR-INVNO-DASH
017270           MOVE ORDH-REPRINT-SEQ TO PR-INVNO-SEQ
017280        ELSE
017290           MOVE " "  TO PR-INVNO-DASH
017300           MOVE ZERO TO PR-INVNO-SEQ.
017310
017320     IF NOT OPEN-ORDER
017330        MOVE PR-INVOICE-NO TO PR-INV-NO OF INVFRM.
017340
017350*-- Print Name of Form --*
042009     MOVE SPACES TO PR-FORM-TYPE-LESS OF INVFRM.
042009     MOVE SPACES TO PR-FORM-TYPE      OF INVFRM.
017360     IF PROCESS-INVOICES OR PROCESS-HISTORY
017370        IF OPEN-ORDER
017380           MOVE "ACKNOWLEDGEMENT"  TO PR-FORM-TYPE-LESS OF INVFRM
017390        ELSE
017400        IF CREDIT-MEMO
017410           MOVE "CREDIT MEMO  "  TO PR-FORM-TYPE OF INVFRM
017420        ELSE
017460           MOVE "    INVOICE    "  TO PR-FORM-TYPE OF INVFRM
017470     ELSE
017480     IF PROCESS-OPEN-ORDERS
017490        IF RELEASED-ORDER
017500           MOVE "    INVOICE    "  TO PR-FORM-TYPE OF INVFRM
017510        ELSE
017540           MOVE "ACKNOWLEDGEMENT"  TO PR-FORM-TYPE-LESS OF INVFRM.
017550
042809     IF PROTECTI 
042809        IF PR-FORM-TYPE-LESS OF INVFRM = "ACKNOWLEDGEMENT"
042809           MOVE "WORK ORDER   " TO PR-FORM-TYPE-LESS OF INVFRM
050109           MOVE ORDH-ORDER-NO     TO PR-WO-NBR
050109        ELSE
050109           MOVE SPACES TO PR-WO-NBR
050109     ELSE
050109        MOVE SPACES TO PR-WO-NBR.

017750*-- Print Sold To/Ship To Address LInes --*
017860     MOVE ORDH-CUST-NAME TO PR-CUST-NAME OF INVFRM.
017940     MOVE ORDH-SHIP-NAME TO PR-SHIP-NAME OF INVFRM.
018020     MOVE ORDH-CUST-ADDR1 TO PR-CUST-ADDR1 OF INVFRM.
018090     MOVE ORDH-SHIP-ADDR1 TO PR-SHIP-ADDR1 OF INVFRM.
018170     MOVE ORDH-CUST-ADDR2 TO PR-CUST-ADDR2 OF INVFRM.
018240     MOVE ORDH-SHIP-ADDR2 TO PR-SHIP-ADDR2 OF INVFRM.
018250
042009     MOVE SPACES TO PR-CUST-CSZ OF INVFRM.
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 OF INVFRM.

042009     MOVE SPACES TO PR-SHIP-CSZ OF INVFRM.
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 OF INVFRM
018490     IF ORDH-SHIP-CITY = SPACES
018510        MOVE SPACES TO PR-SHIP-CSZ OF INVFRM.
018530
020210     IF DIAZO
020210        MOVE ORDH-CUST-NO TO PR-CUST-NO OF DIAZO101
020210        MOVE PR-CUST-NAME OF INVFRM  TO PR-CUST-NAME OF DIAZO101
020210        MOVE PR-CUST-ADDR1 OF INVFRM TO PR-CUST-ADDR1 OF DIAZO101
020210        MOVE PR-CUST-ADDR2 OF INVFRM TO PR-CUST-ADDR2 OF DIAZO101
020210        MOVE PR-CUST-CSZ OF INVFRM TO PR-CUST-CSZ OF DIAZO101
      
020210        MOVE PR-SHIP-NAME OF INVFRM  TO PR-SHIP-NAME OF DIAZO101
020210        MOVE PR-SHIP-ADDR1 OF INVFRM TO PR-SHIP-ADDR1 OF DIAZO101
020210        MOVE PR-SHIP-ADDR2 OF INVFRM TO PR-SHIP-ADDR2 OF DIAZO101
020210        MOVE PR-SHIP-CSZ OF INVFRM TO PR-SHIP-CSZ OF DIAZO101
019650        MOVE ORDH-ORD-DATE      TO DATE-IN
019660        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
019730        MOVE DATE-OUT-11        TO PR-ORDER-DATE OF DIAZO101
020210**        MOVE ORDH-ORDER-NO      TO PR-OUR-ORDER-NO OF DIAZO101
020210        MOVE SPACES             TO PR-PO-NO OF DIAZO101
020210        STRING ORDH-SHIP-INST   DELIMITED BY "  "
020210               "/"              DELIMITED BY SIZE
                     ORDH-PO-NUM      DELIMITED BY "  "
020210               "/"              DELIMITED BY SIZE
020210               ORDH-JOB-NUM     DELIMITED BY "  "
020210               INTO WS-PO-JOB
020210        MOVE WS-PO-JOB          TO PR-PO-NO OF DIAZO101
020210        MOVE ORDH-SLSMN         TO PR-SALESPERSON OF DIAZO101
019650        MOVE ORDH-INV-DATE      TO DATE-IN
019660        PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT
020210        MOVE DATE-OUT-11        TO PR-INVOICE-DATE OF DIAZO101
020210        MOVE ORDH-INV-NO  TO PR-INVOICE-NO-DIAZO OF DIAZO101.

018720
018730     PERFORM SHORT-MSG THRU SHORT-MSG-EXIT.
018760
018770*-- Print Payment Due Date Line --*
100109     MOVE SPACES TO PR-DUE-ON OF INVFRM.
018780     PERFORM COMPUTE-DUE-DATE.
018870     IF CREDIT-MEMO OR ORDH-DUE-DAYS = ZERO
018880        MOVE ZERO TO DATE-IN.
018890     IF DATE-IN NOT = ZERO
018930        STRING
018940               "Invoice Due on " DELIMITED BY SIZE,
018950               DATE-OUT-11      DELIMITED BY SIZE
018970               INTO PR-DUE-ON OF INVFRM
018990       IF ALLIED OR CREDIT-MEMO
019010           MOVE SPACES TO PR-DUE-ON OF INVFRM
019040       END-IF.
019050
019060*-- Print CODE 3OF9 BARCODE - ORDER NO. --*
019170     MOVE ORDH-ORDER-NO TO PR-ORDER-BAR OF INVFRM.
010810     IF PRINT-BARCODE-YES
010810        MOVE " "  TO EDIT-MODE OF PR-ORDER-BAR OF INVFRM
010810     ELSE
010810**      MOVE "X"  TO EDIT-MODE OF PR-ORDER-BAR OF INV101
010810        MOVE "X"  TO EDIT-MODE OF PR-ORDER-BAR OF INVFRM.


020210     IF NOT DIAZO
019190        PERFORM PRINT-FORM2 THRU PRINT-FORM2-EXIT.           
019200     IF WS-FORM-ID-107-104
019210        MOVE PAGE-NO TO PR-PAGE-NO
019220        MOVE PR-PAGE-NO TO PR-PAGE OF INVFRM
019230     END-IF.
010810     IF JEREMIE
010810        MOVE "C/S"        TO HDR-VENDOR OF INVFRM
010810        MOVE "PULLER"     TO HDR-CLASS  OF INVFRM
010810        MOVE "INSPECTOR"  TO HDR-DEPT   OF INVFRM
010810         
010810     ELSE
              MOVE "CLASS" TO HDR-CLASS OF INVFRM
              MOVE "VENDOR" TO HDR-VENDOR OF INVFRM
              MOVE "DEPT" TO HDR-DEPT OF INVFRM.

019240     MOVE "HEAD" TO PFRPT-GROUP.
019250     PERFORM WRITE-INVFRM.
019260 PRINT-FORM-EXIT. EXIT.
019270
019280 PRINT-FORM2 SECTION.
019290 PRINT-FORM2-BEGIN.
019300*-- Print First Line of Header Info --*
019520     MOVE ORDH-PO-NUM  TO PR-PO-NUM  OF INVFRM.
019530     MOVE ORDH-CUST-NO TO PR-CUST-NO OF INVFRM.
019540
019550     MOVE ORDH-ORDER-NO TO PR-ORDER-NO.
019560     MOVE ORDH-SUB-ORDER-NO TO PR-SUB-ORDER-NO.
019630     MOVE PR-ORDER-NUMBER TO PR-OUR-ORDER-NO OF INVFRM.           
019640
019650     MOVE ORDH-ORD-DATE TO DATE-IN.
019660     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
019730     MOVE DATE-OUT-11 TO PR-ORD-DATE OF INVFRM.
019740
019750     MOVE ORDH-SHIP-DATE TO DATE-IN.
019760     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
019830     MOVE DATE-OUT-11 TO PR-SHIP-DATE OF INVFRM.
019840
019850     IF ORDH-SLSMN-NO NOT = SLSMN-NUMBER
019860        MOVE ORDH-SLSMN-NO TO SLSMN-NUMBER
019870        PERFORM READ-SALEF.
019880     MOVE ORDH-SLSMN-NO TO PR-SLSMN-NO.
019890     MOVE SLSMN-NAME    TO PR-SLSMN-NAME.
020020     MOVE PR-SALESMAN TO PR-SALESPERSON OF INVFRM.
020030
020040*-- Print Second Line of Header Info --*
020060     IF (ORDH-DUE-DAYS = ZEROES ) AND
020070        (ORDH-DISC-PCT = ZEROES ) AND
020080        (ORDH-DISC-DAYS = ZEROES) 
020090        MOVE EXCN-TERM-DESC(ORDH-TERM-CD) TO PR-TERMS
020100     ELSE 
020110        MOVE ORDH-DUE-DAYS  TO TERMS-DUE-DAYS
020120        MOVE ORDH-DISC-PCT  TO TERMS-PCT
020130        MOVE ORDH-DISC-DAYS TO TERMS-DAYS
020140        MOVE TERMS-DESC     TO PR-TERMS.
020150     IF ALLIED
020160        MOVE EXCN-TERM-DESC(ORDH-TERM-CD) TO PR-TERMS.
020170*    MOVE 0090 TO HORZ-POS.
020180*    IF PROFIT-TEAR-SLIP
020190*       ADD 270 TO VERT-POS
020200*    ELSE
020210*       ADD 240 TO VERT-POS.
020220
020230*    PERFORM MOVE-SPACES-TO-PRINT-REC.
020240*       STRING HP-VERT-HORZ     DELIMITED BY SIZE
020250*           PR-TERMS         DELIMITED BY SIZE,
020260*           INTO PRINT-REC.
020270*    PERFORM WRITE-PRINT-REC-B4-ZERO.
020280     MOVE PR-TERMS TO PR-TRMS OF INVFRM.
020290
020300*    IF INVOICE-107
020310*      MOVE ORDH-SLSMN-NO TO PR-SLSMN-NO
020320*      MOVE 5000 TO HORZ-POS
020330*      PERFORM MOVE-SPACES-TO-PRINT-REC
020340*         STRING HP-VERT-HORZ     DELIMITED BY SIZE
020350*             PR-SLSMN-NO      DELIMITED BY SIZE,
020360*             INTO PRINT-REC
020370*      PERFORM WRITE-PRINT-REC-B4-ZERO
020380*`   END-IF.
020390
020400
020410*    MOVE 1350 TO HORZ-POS.
020420*    PERFORM MOVE-SPACES-TO-PRINT-REC.
020430*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020440*           ORDH-SHIP-INST   DELIMITED BY SIZE,
020450*           INTO PRINT-REC.
020460*    PERFORM WRITE-PRINT-REC-B4-ZERO.
020470     MOVE ORDH-SHIP-INST TO PR-SHIP-INST OF INVFRM.
020480
020490*    IF JEREMIE
020500*       MOVE 3350 TO HORZ-POS
020510*       MOVE SPACES TO PRINT-REC
020520*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020530*              ORDH-VENDOR      DELIMITED BY SIZE,
020540*              INTO PRINT-REC
020550*       WRITE PRINT-REC BEFORE 0
020560*       MOVE 4000 TO HORZ-POS
020570*       MOVE SPACES TO PRINT-REC
020580*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020590*              ORDH-CLASS       DELIMITED BY SIZE,
020600*              INTO PRINT-REC
020610*       WRITE PRINT-REC BEFORE 0
020620*       MOVE 4450 TO HORZ-POS
020630*       MOVE SPACES TO PRINT-REC
020640*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020650*              ORDH-DEPT        DELIMITED BY SIZE,
020660*              INTO PRINT-REC
020670*       WRITE PRINT-REC BEFORE 0
020680*       MOVE 5250 TO HORZ-POS
020690*       MOVE SPACES TO PRINT-REC
020700*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020710*              ORDH-PACKER-NO   DELIMITED BY SIZE,
020720*              INTO PRINT-REC
020730*       WRITE PRINT-REC BEFORE 1
020740*       GO TO JEREMIE-SKIP.
020750
020760*        
020770*    MOVE 3500 TO HORZ-POS.
020780*    PERFORM MOVE-SPACES-TO-PRINT-REC.
020790*    IF INVOICE-107
020800*       ADD -200 TO HORZ-POS
020810*    END-IF.
020820*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020830*           ORDH-VENDOR      DELIMITED BY SIZE,
020840*           INTO PRINT-REC.
020850*    PERFORM WRITE-PRINT-REC-B4-ZERO.
020860
020870*    MOVE ORDH-CLASS TO PR-CLASS.
020880*    MOVE ORDH-DEPT  TO PR-DEPT.
020890
020900*    MOVE 4400 TO HORZ-POS.
020910*    IF INVOICE-107
020920*       ADD -200 TO HORZ-POS
020930*    END-IF.
020940*    PERFORM MOVE-SPACES-TO-PRINT-REC.
020950*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
020960*           PR-CLASS         DELIMITED BY SIZE,
020970*           INTO PRINT-REC.
020980*    PERFORM WRITE-PRINT-REC-B4-ZERO.
020990
021000*    MOVE 5125 TO HORZ-POS.
021010*    IF INVOICE-107
021020*       ADD -200 TO HORZ-POS
021030*    END-IF.
021040*    PERFORM MOVE-SPACES-TO-PRINT-REC.
021050*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
021060*           PR-DEPT          DELIMITED BY SIZE,
021070*           INTO PRINT-REC.
021080*    PERFORM WRITE-PRINT-REC-B4-ONE.
021090     MOVE ORDH-VENDOR TO PR-VENDOR OF INVFRM.
021100     MOVE ORDH-CLASS TO PR-CLASS OF INVFRM.
021110     MOVE ORDH-DEPT TO PR-DEPT OF INVFRM.
021120     MOVE ORDH-PACKER-NO TO PR-PACKER-NO OF INVFRM.
021130
021140*JEREMIE-SKIP.
021150*    IF PROFIT-TEAR-SLIP
021160*     IF COPIES-PRINTED = 1
021170*       MOVE 2400 TO VERT-POS
021180*       MOVE 6100 TO HORZ-POS
021190*       MOVE 24   TO POINT-SIZE
021200*    PERFORM MOVE-SPACES-TO-PRINT-REC
021210*    STRING HP-VERT-HORZ-POINT DELIMITED BY SIZE
021220*              HP-BOLD          DELIMITED BY SIZE,
021230*              "Internal"       DELIMITED BY SIZE,
021240*              INTO PRINT-REC
021250*       PERFORM WRITE-PRINT-REC-B4-ZERO
021260*       MOVE 2600 TO VERT-POS
021270*       PERFORM MOVE-SPACES-TO-PRINT-REC
021280*       STRING HP-VERT-HORZ     DELIMITED BY SIZE
021290*              "Use Only"       DELIMITED BY SIZE,
021300*              INTO PRINT-REC
021310*       PERFORM WRITE-PRINT-REC-B4-ZERO
021320*     ELSE
021330*       MOVE 12   TO POINT-SIZE
021340*       MOVE 2300 TO VERT-POS
021350*       MOVE 6000 TO HORZ-POS
021360*       PERFORM MOVE-SPACES-TO-PRINT-REC
021370*    STRING HP-VERT-HORZ-POINT DELIMITED BY SIZE
021380*         " Cost         Profit          Pct" DELIMITED BY SIZE,
021390*              INTO PRINT-REC
021400*       PERFORM WRITE-PRINT-REC-B4-ZERO.
021410     IF PROFIT-TEAR-SLIP
021420        IF COPIES-PRINTED = 1
021430            MOVE "Internal Use Only" TO 
021440                 PR-INTL-USE-ONLY OF INVFRM
021450            MOVE SPACES TO PR-COST-PROFIT-PCT OF INVFRM
021460        ELSE
021470            MOVE SPACES TO PR-INTL-USE-ONLY OF INVFRM
021480            MOVE "Cost        Profit         Pct" TO 
021490                 PR-COST-PROFIT-PCT OF INVFRM
021500        END-IF
021510     END-IF.
021520
021530 SETUP-FOR-DETAIL-LINES.
021540*    MOVE 3230 TO VERT-POS.
021550*    MOVE 0090 TO HORZ-POS.
021560*    IF PROFIT-TEAR-SLIP
021570*       SUBTRACT 310 FROM VERT-POS.
021580*       SUBTRACT 210 FROM VERT-POS.
021590*-- FORM 105 REQUIRES HP5 OR GREATER, USES SCALEABLE COURIER FONT --*
021600*    IF WS-FORM-ID = 105 OR WS-FORM-FILENAME = "INV105.MAC"
021610*       MOVE 4099 TO FONT-NUMBER
021620*       MOVE 12.00 TO PITCH-SIZE
021630*       MOVE 8.5  TO POINT-SIZE
021640*    ELSE
021650*       MOVE 0    TO FONT-NUMBER
021660*       MOVE 8.5  TO POINT-SIZE
021670*       MOVE 16.67 TO PITCH-SIZE.
021680*       PERFORM MOVE-SPACES-TO-PRINT-REC  .
021690*       STRING HP-VERT-HORZ     DELIMITED BY SIZE
021700*           HP-SYMBOL-SET    DELIMITED BY SIZE,
021710*           HP-FONT          DELIMITED BY SIZE,
021720*           HP-UPRIGHT       DELIMITED BY SIZE,
021730*           HP-FIXED         DELIMITED BY SIZE,
021740*           HP-PITCH-SIZE    DELIMITED BY SIZE
021750*           HP-POINT-SIZE    DELIMITED BY SIZE
021760*           HP-MEDIUM        DELIMITED BY SIZE
021770*           HP-8-LPI         DELIMITED BY SIZE
021780*           INTO PRINT-REC
021790*    PERFORM WRITE-PRINT-REC-B4-ZERO.
021800 PRINT-FORM2-EXIT. EXIT.
021810
021820 PRINT-TOTALS SECTION.
021830 PRINT-TOTALS-START.
021840     PERFORM MOVE-TOTALS.
021850     IF WS-FORM-ID-107-104 
021860        PERFORM 107-TOTALS
021870        GO TO PRINT-TOTALS-EXIT.
021880     IF PROCESS-HISTORY
021890        COMPUTE TS-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT
021900     ELSE
021910        COMPUTE TS-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT.
020210     MOVE SPACES TO PR-DETAIL-LINE OF INVFRM
020210                    PR-DETAIL-LINE OF DIAZO101.
020210     PERFORM WRITE-INVFRM.
020210     ADD 1 TO LINE-CNT.
021920     IF ORDH-TAX-AMT NOT = ZERO AND
021930        LFPR-NOT-KNOCKOUT
021940          MOVE "SUB-TOTAL:" TO TS-SUB-DESC
021950          MOVE PR-SUB-TOTALS TO PR-DETAIL-LINE OF INVFRM
020210          MOVE TS-SUB-DESC        TO PR-SUB-TOT-DESC
020210          MOVE TS-SUB-AMT  TO PR-DISC-COLUMN
020210          MOVE ZERO TO PR-NET-COLUMN
020210          IF DIAZO AND COPIES-PRINTED NOT = 2
020210             MOVE PR-SUB-TOTAL-DETAIL-DIAZO TO 
020210                  PR-DETAIL-LINE OF DIAZO101
020210          END-IF
021960          PERFORM WRITE-INVFRM
080509          ADD 1 TO LINE-CNT
021970          MOVE "TAXES:"     TO TS-SUB-DESC
021980          MOVE ORDH-TAX-AMT TO TS-SUB-AMT
021990          MOVE PR-SUB-TOTALS TO PR-DETAIL-LINE OF INVFRM
020210          MOVE TS-SUB-DESC        TO PR-SUB-TOT-DESC
020210          MOVE TOT-TAX-AMT        TO PR-DISC-COLUMN
020210          MOVE TOT-TAX-AMT-RETAIL TO PR-NET-COLUMN
020210          IF DIAZO AND COPIES-PRINTED = 2
020210             MOVE ZERO TO PR-DISC-COLUMN
020210          END-IF
020210          MOVE PR-SUB-TOTAL-DETAIL-DIAZO TO 
020210               PR-DETAIL-LINE OF DIAZO101
022000          PERFORM WRITE-INVFRM
021810          MOVE SPACES TO PR-DETAIL-LINE OF DIAZO101
080509          ADD 1 TO LINE-CNT
022010     END-IF.
022020
022030     IF PROCESS-HISTORY
022040        MOVE ORDH-INV-AMT TO TS-SUB-AMT
022050     ELSE
022060     IF ORDH-POS-CD = 0
022070        COMPUTE TS-SUB-AMT = ORDH-NET-AMT + ORDH-TAX-AMT
022080                + ORDH-FREIGHT-AMT
022090     ELSE
022100        MOVE ORDH-INV-AMT TO TS-SUB-AMT.
022110*    IF ORDH-DEP-AMT NOT = ZERO AND NOT ATHENS 
022120     IF ORDH-DEP-AMT NOT = ZERO 
022130        IF LFPR-NOT-KNOCKOUT
022140           MOVE "INVOICE AMT:" TO TS-SUB-DESC
022150           MOVE PR-SUB-TOTALS TO PR-DETAIL-LINE OF INVFRM
020210           MOVE TS-SUB-DESC   TO PR-SUB-TOT-DESC
020210           MOVE PR-SUB-TOTAL-DETAIL-DIAZO TO 
020210                PR-DETAIL-LINE OF DIAZO101
022160           PERFORM WRITE-INVFRM
080509           ADD 1 TO LINE-CNT
022170           MOVE "LESS DEPOSIT:" TO TS-SUB-DESC
022180           MOVE ORDH-DEP-AMT    TO TS-SUB-AMT
022190           MOVE PR-SUB-TOTALS TO PR-DETAIL-LINE OF INVFRM
020210           MOVE TS-SUB-DESC   TO PR-SUB-TOT-DESC
020210           MOVE PR-SUB-TOTAL-DETAIL-DIAZO TO 
020210                PR-DETAIL-LINE OF DIAZO101
022200           PERFORM WRITE-INVFRM
080509           ADD 1 TO LINE-CNT
022210     END-IF.
022220
020510     IF LINE-CNT NOT = 1
050109        PERFORM MOVE-TO-BOTTOM.
022230     IF ORDER-COMPLETE
022240         MOVE CNTL-ORD-COMPLETE-MSG TO PR-COMPLETE-MSG
022250     ELSE MOVE CNTL-ORD-NOT-COMPLETE-MSG TO PR-COMPLETE-MSG.
022270     MOVE PR-DETAIL-MSG TO PR-DETAIL-LINE OF INVFRM.
022280     PERFORM WRITE-INVFRM.
080509     ADD 1 TO LINE-CNT
022290
022300*-- PRINT DISC MSG AREA --*
022310*121501     IF PROFIT-TEAR-SLIP
022320*110801        SUBTRACT 1770 FROM VERT-POS.
022330*           PERFORM SETUP-NON-DETAIL-PRINT-LINE.
022340*063650
022350     IF ORDH-CSHDISC-AMT NOT = ZERO AND
022360        LFPR-NOT-KNOCKOUT
022370        MOVE TS-CASH-DISC TO PR-TS-CASH-DISC OF INVFRM
022380     END-IF.
022390     IF  PR-FORM-TYPE-LESS OF INVFRM = "ACKNOWLEDGEMENT"
022400        MOVE SPACES TO PR-TS-CASH-DISC OF INVFRM
022410     END-IF.
022420
022430     IF LFPR-NOT-KNOCKOUT
022440        MOVE TS-TAX-3 TO PR-TS-TAX-3 OF INVFRM
022450     END-IF.
022460     IF LFPR-NOT-KNOCKOUT
022470        MOVE TS-TAX-2 TO PR-TS-TAX-2 OF INVFRM
022480     END-IF.
022490     IF LFPR-NOT-KNOCKOUT
022500        MOVE TS-TAX-1 TO PR-TS-TAX-1 OF INVFRM
022510     END-IF.
022520     IF LFPR-NOT-KNOCKOUT
022530        MOVE TS-INV-AMT TO PR-TS-INV-AMT OF INVFRM
022540     END-IF.
022550*
022560     IF ORDH-CSHDISC-AMT NOT = ZERO AND
022570        LFPR-NOT-KNOCKOUT
022580          IF NOT JEREMIE
022590             PERFORM PRINT-CASH-DISC-MSG.
022600   
022610     STRING 
022620            ORDH-ORDER-COMMENT-1   DELIMITED BY SIZE
022630            " / "                  DELIMITED BY SIZE
022640            ORDH-ORDER-COMMENT-2   DELIMITED BY SIZE
022650            " / "                  DELIMITED BY SIZE
022660            ORDH-ORDER-COMMENT-3   DELIMITED BY SIZE
022670            INTO PR-TAIL-COMMENT-LINE OF INVFRM.
042809     IF ORDH-ORDER-COMMENT-1 = SPACES AND
              ORDH-ORDER-COMMENT-2 = SPACES AND
              ORDH-ORDER-COMMENT-3 = SPACES 
                   MOVE SPACES TO PR-TAIL-COMMENT-LINE OF INVFRM.

022680     IF PROFIT-TEAR-SLIP
022690        IF COPIES-PRINTED = 1
022700           NEXT SENTENCE
022710        ELSE
022720        IF  LFPR-NOT-KNOCKOUT 
022730           MOVE TS-COST-AMT TO PR-TS-COST-AMT OF INVFRM 
022740           MOVE TS-PROFIT-AMT TO PR-TS-PROFIT-AMT OF INVFRM
022750           MOVE TS-PROFIT-PCT TO PR-TS-PROFIT-PCT OF INVFRM
022760        END-IF.
022770
                    
022780 PRINT-TOTALS-EXIT. EXIT.
022790   
022800 107-TTLS SECTION.
022810 107-TOTALS.
022960     IF ORDH-TAX-AMT NOT = ZERO
022990       MOVE ORDH-TAX-AMT TO WS-PRINT-NUM
023040       MOVE WS-PRINT-NUM TO PR-TOT-INV107-3 OF INVFRM
023050     END-IF.

091410     IF AGRIBUS
091410        COMPUTE TS-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT -
091410                             ORDH-FREIGHT-AMT - 
091410                             WS-TOT-EVACUATION-AMT
091410     ELSE    
023070        COMPUTE TS-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT -
023080                             ORDH-FREIGHT-AMT - ORDH-SPCHG-AMT -
023090                             WS-TOT-EVACUATION-AMT.
023120     MOVE TS-SUB-AMT   TO WS-PRINT-NUM
023180     MOVE WS-PRINT-NUM TO PR-TOT-INV107-0 OF INVFRM.


062909     IF PROCESS-HISTORY
062909        MOVE ORDH-INV-AMT TO TS-SUB-AMT
062909     ELSE
023200     IF ORDH-POS-CD = 0
023210       COMPUTE TS-SUB-AMT = ORDH-NET-AMT + ORDH-TAX-AMT
011910                         + ORDH-FREIGHT-AMT + ORDH-SPCHG-AMT
023230     ELSE
             MOVE ORDH-INV-AMT TO TS-SUB-AMT
023250     END-IF.

060810     IF ORDH-DEP-AMT NOT = ZERO
060810        MOVE TS-SUB-AMT TO WS-TEMP-AMT
060810        COMPUTE WS-TEMP-AMT = WS-TEMP-AMT - ORDH-DEP-AMT
060810        MOVE WS-TEMP-AMT TO TS-SUB-AMT.
023280     MOVE TS-SUB-AMT   TO WS-PRINT-NUM
023350     MOVE WS-PRINT-NUM TO PR-TOT-INV107-4 OF INVFRM
080410                          PR-TOT-DEP-AMT  OF INV104.

060810     COMPUTE WS-TEMP-AMT = ORDH-DEP-AMT * -1.
060810     MOVE    WS-TEMP-AMT TO WS-PRINT-NUM.
060810     MOVE WS-PRINT-NUM TO PR-TOT-DEP-AMT OF INVFRM.
023360*
023370     IF WS-TOT-Freight NOT = ZERO
023400       MOVE WS-TOT-Freight TO WS-PRINT-NUM
023410       MOVE ORDH-FREIGHT-AMT TO WS-PRINT-NUM
023460       MOVE WS-PRINT-NUM TO PR-TOT-INV107-2 OF INVFRM
023470     END-IF.
023480*
023490     ADD WS-TOT-EVACUATION-AMT TO WS-TOT-SPC-CHG.
023500     IF WS-TOT-Spc-Chg NOT = ZERO
023530       MOVE WS-TOT-Spc-Chg TO WS-PRINT-NUM
023590       MOVE WS-PRINT-NUM TO PR-TOT-INV107-1 OF INVFRM
023600     END-IF.

101110     IF LFPR-KNOCKOUT
101110        MOVE SPACES TO PR-TOT-INV107-0 OF INVFRM,
                           PR-TOT-INV107-1 OF INVFRM,
                           PR-TOT-INV107-2 OF INVFRM, 
                           PR-TOT-INV107-3 OF INVFRM,
                           PR-TOT-INV107-4 OF INVFRM
                           PR-TOT-DEP-AMT  OF INVFRM.

023610*
023620     SUBTRACT WS-TOT-EVACUATION-AMT FROM WS-TOT-Spc-Chg.
023780     STRING
023790            ORDH-ORDER-COMMENT-1   DELIMITED BY SIZE
023800            " "                  DELIMITED BY SIZE
023810            ORDH-ORDER-COMMENT-2   DELIMITED BY SIZE
023820            " "                  DELIMITED BY SIZE
023830            ORDH-ORDER-COMMENT-3   DELIMITED BY SIZE
023840*071904            HP-UPRIGHT             DELIMITED BY SIZE
023850*071904            INTO PRINT-REC.
023860            INTO PR-TAIL-COMMENT-LINE OF INVFRM.
023870*071904     WRITE PRINT-REC BEFORE ADVANCING 1.
023880*
023890     IF ORDER-COMPLETE
023900         MOVE CNTL-ORD-COMPLETE-MSG TO PR-COMPLETE-MSG
023910     ELSE MOVE CNTL-ORD-NOT-COMPLETE-MSG TO PR-COMPLETE-MSG.
024070     MOVE PR-COMPLETE-MSG TO PR-INV107-COMPLETE-MSG OF INVFRM.

041409    IF PCS
041409       MOVE SPACES TO PR-INV-TERMS-MSG OF INV104
041409       STRING "Each past due invoice is subject to a $45.00 "
                    "late fee AND an interest charge of 1 1/2% per "
                    "month which equals 18% annually.  Past due "
                    "accounts will be placed on a cash or non-ship "
                    "status." DELIMITED BY SIZE
                    INTO PR-INV-TERMS-MSG OF INV104.
062411*    IF SUNBELTS
062411*       MOVE SPACES TO PR-INV-TERMS-MSG OF INV104
062411*       STRING "Effective July 7 2011, our new remit address "
062411*              "will be:"
      *              X"0A"
      *              "         Sunbelt Sales and Marketing, Inc. "
      *              X"0A"
062411*              "         P.O. Box 890908"
      *              X"0A"
062411*              "         Charlotte, NC  28289-0908"
      *              DELIMITED BY SIZE
062411*              INTO PR-INV-TERMS-MSG OF INV104.
041409 107-TOTALS-EXIT. EXIT.
024080
024090
024100******************************************************************
024110 104-TOTALS SECTION.
024120******************************************************************
024130 104-TOTALS-BEGIN.
024200     IF PROCESS-HISTORY
024210        MOVE ORDH-NET-AMT TO PR-SUB-AMT
024220     ELSE
024230     IF ORDH-POS-CD = 0
024240        COMPUTE PR-SUB-AMT = ORDH-NET-AMT - ORDH-TAX-AMT
024250                - ORDH-FREIGHT-AMT - ORDH-SPCHG-AMT
024260     ELSE
024270        COMPUTE PR-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT
024280                - ORDH-FREIGHT-AMT - ORDH-SPCHG-AMT.
024340     MOVE PR-SUB-AMT TO PR-TAIL-TOTAL-1 OF INVFRM.
024350
024370     MOVE ORDH-SPCHG-AMT  TO PR-SPCHG-AMT.
024430     MOVE PR-SPCHG-AMT TO PR-TAIL-TOTAL-2 OF INVFRM.
024440
024450     MOVE ORDH-FREIGHT-AMT TO PR-FREIGHT-AMT.
024510     MOVE PR-SPCHG-AMT TO PR-TAIL-TOTAL-3 OF INVFRM.
024520
024530     MOVE ORDH-TAX-AMT TO PR-TAX-AMT.
024590     MOVE PR-TAX-AMT TO PR-TAIL-TOTAL-4 OF INVFRM.
024600
024610     MOVE ORDH-INV-AMT TO PR-TAX-AMT.
024670     MOVE PR-TAX-AMT TO PR-TAIL-TOTAL-5 OF INVFRM.
024680
024690     MOVE ORDH-DEP-AMT TO PR-TAX-AMT.
024750     MOVE PR-TAX-AMT TO PR-TAIL-TOTAL-6 OF INVFRM.
024760
024770     IF PROCESS-HISTORY
024780        MOVE ORDH-INV-AMT TO TS-INV-AMT
024790     ELSE
024800     IF ORDH-POS-CD = 0
024810        MOVE ORDH-NET-AMT TO TS-INV-AMT
024820     ELSE
024830        MOVE ORDH-INV-AMT TO TS-INV-AMT.
024840*    PERFORM MOVE-SPACES-TO-PRINT-REC  .
024850*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
024860*           TS-INV-AMT       DELIMITED BY SIZE,
024870*           INTO PRINT-REC.
024880*    PERFORM WRITE-PRINT-REC-B4-ZERO.
024890     MOVE TS-INV-AMT TO PR-TAIL-TOTAL-6 OF INVFRM.

024900
024910 104-TOTALS-EXIT. EXIT.
024920
024930******************************************************************
024940 PROCESS-REPORT SECTION.
024950******************************************************************
024960 PROCESS-REPORT-BEGIN.
024970     PERFORM RANGE-SELECT THRU RANGE-SELECT-EXIT.
024980     MOVE 1 TO FLAG.
024990     CALL "KBDCHK" USING FLAG, FKEYS.
025000     MOVE 0 TO FLAG.
025010     MOVE LOW-ORDHF-KEY TO ORDHF-KEY.
025130
025140     IF SELECTIVE-PRINTING
025150        MOVE 2  TO PRINT-TYPE-FLAG
025160        GO TO PROCESS-REPORT-READ
025170     ELSE
025180     IF POS-PRINTING
025190        MOVE 2  TO PRINT-TYPE-FLAG
025200        PERFORM READ-ORDHF
025210        GO TO PROCESS-REPORT-NEXT
025220     ELSE
025230     IF PRINT-IN-NAME-SEQUENCE
025240        PERFORM START-ORDHF-NAME
025250     ELSE
025260     IF BY-SALESMAN-PRINTING
025270        MOVE LOW-VALUES TO ORDHF-KEY
025280        PERFORM START-ORDHF
025290     ELSE
025300        MOVE LOW-ORDHF-KEY TO ORDHF-KEY
025310        PERFORM START-ORDHF.
025320
025330     IF C-AT-END OF ORDHF-STATUS
025340        PERFORM SET-ERROR-COLORS
025350        DISPLAY SCR-b0100xhp-cbl-2011-23  
025360        PERFORM SET-NORM-COLORS
025370        GO TO PROCESS-REPORT-EXIT
025380     ELSE
025390        PERFORM READ-ORDHF-NEXT.
025400
025410
025420 PROCESS-REPORT-NEXT.
025430     IF C-AT-END OF ORDHF-STATUS
025440        GO TO PROCESS-REPORT-EXIT.
025450
025460*-- Check for Needed Authorization --* 
025470     IF POS-PRINTING
025480        IF AUTH-REQ-IF-OVER-CRLIM OR AUTH-REQ-AR
025490           PERFORM CUST-CR-LIM-CHK
025500           PERFORM SCREEN-INIT
025510           IF CUST-AUTH-OK
025520              NEXT SENTENCE
025530           ELSE
025540           IF SUBMIT-REQUEST
025550              MOVE 1 TO PASS-FORM-TYPE
025560              PERFORM SUBMIT-AUTH-REQUEST THRU 
025570                      SUBMIT-AUTH-REQUEST-EXIT
025580              GO TO PROCESS-REPORT-EXIT
025590           ELSE
025600              GO TO PROCESS-REPORT-EXIT.
025610        
025620     IF SELECTIVE-PRINTING OR POS-PRINTING
025630        NEXT SENTENCE
025640     ELSE
025650     IF BY-SALESMAN-PRINTING
025660        IF ORDH-SLSMN-NO > HIGH-SLSMN OR
025670           ORDH-SLSMN-NO < LOW-SLSMN
025680              GO TO PROCESS-REPORT-READ
025690        ELSE NEXT SENTENCE
025700     ELSE
025710     IF PRINT-IN-ORDER-SEQUENCE
025720       IF ORDHF-KEY > HIGH-ORDHF-KEY
025730         GO TO PROCESS-REPORT-EXIT
025740       ELSE NEXT SENTENCE
025750     ELSE
025760     IF PRINT-IN-NAME-SEQUENCE
025770       IF ORDHF-KEY > HIGH-ORDHF-KEY OR ORDHF-KEY < LOW-ORDHF-KEY
025780         GO TO PROCESS-REPORT-READ.
025790
025800     IF BY-BATCH-NO
025810        IF USER-BATCH-NO NOT = ORDH-BATCH-NO
025820           GO TO PROCESS-REPORT-READ.
025830
025840*-- IF 2-1-2, SKIP OPEN ORDERS --*
025850     IF POS-PRINTING
025860        NEXT SENTENCE
025870     ELSE
025880     IF SELECTIVE-PRINTING
025890        IF PRINT-ACK-ONLY AND NOT OPEN-ORDER
025900           DISPLAY SCR-b0100xhp-cbl-2066-26
025910               
025920           GO TO PROCESS-REPORT-READ
025930        ELSE
025940        IF PRINT-INVOICES-ONLY AND OPEN-ORDER
025950           DISPLAY SCR-b0100xhp-cbl-2071-26
025960               
025970           GO TO PROCESS-REPORT-READ
025980        ELSE
025990           NEXT SENTENCE
026000     ELSE
026010     IF PRINT-ACK-ONLY
026020        IF OPEN-ORDER
026030           NEXT SENTENCE
026040        ELSE
026050           GO TO PROCESS-REPORT-READ
026060     ELSE
026070     IF PRINT-INVOICES-ONLY
026080        IF NOT OPEN-ORDER
026090           NEXT SENTENCE
026100        ELSE
026110           GO TO PROCESS-REPORT-READ.
026120
026130*-- IF PRINTED USING F2, CAN ONLY BE PRINTED BY F2 --*
026140     IF PROCESS-HISTORY
026150        NEXT SENTENCE
026160     ELSE
026170     IF ORDH-POS-CD NOT = 0 AND NOT POS-PRINTING
026180         DISPLAY SCR-b0100xhp-cbl-2094-24
026190                   
026200         GO TO PROCESS-REPORT-READ.
026210
026220*-- ONLY PRINT ALL unprinted ORDERS --*
026230*    IF PRINT-ALL-ORDERS
026240     IF PRINT-ALL-ORDERS AND NOT JEREMIE
026250           IF ORDH-PRINT-CD = 1
026260              GO TO PROCESS-REPORT-READ.
026270
026280     IF JEREMIE AND PRINT-ALL-ORDERS
026290        IF ORDH-PACKER-NO = SPACES
026300           GO TO PROCESS-REPORT-READ.
026310
026320     MOVE 1 TO USER-REPRINT-INVOICE.
026330     IF C-RECORD-OK OF ORDHF-STATUS AND ORDH-PRINT-ONCE-CD = 1
026340*        AND NOT USER-REPRINT-INVOICE
026350         AND NOT      REPRINT-INVOICE
026360             DISPLAY SCR-b0100xhp-cbl-2111-28 
026370                  
026380             GO TO PROCESS-REPORT-READ.
026390
026400*    IF NOT INDMETALS
026410     IF NOT PROCESS-HISTORY
026420        IF ORDH-PRINT-ONCE-CD = 1 AND REPRINT-INVOICE
026430              ADD 1 TO ORDH-REPRINT-SEQ.
026440
042710     MOVE SPACES TO CLASS-TABLE.
042710     MOVE ALL "0" TO SQ-FT-TABLE, BEST-PRICE-TABLE.
042710     IF DIAZO
042710        PERFORM COMBINE-CONTRACT-QTYS.
026450     PERFORM RECALC-HEADERS THRU RECALC-HEADERS-EXIT.

026480     IF PROCESS-HISTORY
026490        NEXT SENTENCE
026500     ELSE
026510     IF POS-PRINTING
026520         PERFORM GET-PAYMENT THRU GET-PAYMENT-EXIT
026530         IF FLAG = 3 
026540            GO TO PROCESS-REPORT-EXIT
026550         ELSE
026560            NEXT SENTENCE
026570     ELSE
026580        COMPUTE ORDH-NET-AMT = ORDH-NET-AMT - ORDH-FREIGHT-AMT -
026590                ORDH-SPCHG-AMT
026600        MOVE ORDH-NET-AMT TO ORDH-GROSS-AMT   
026610        COMPUTE ORDH-INV-AMT = ORDH-NET-AMT + ORDH-FREIGHT-AMT +
026620          ORDH-SPCHG-AMT + ORDH-TAX-AMT.
026630
026640     MOVE 1         TO PAGE-NO.
026650     MOVE SPACES TO DETAIL-LINE.
026660     MOVE ORDHF-KEY TO ORDLF-KEY.
026670     MOVE ZERO      TO ORDL-SEQ-NO.
026680     MOVE ZERO TO WS-TOT-Freight, WS-TOT-Spc-Chg.
026690     MOVE ZERO TO WS-TOT-EVACUATION-AMT.
026700     PERFORM START-ORDLF-GREATER.
026710     IF NOT C-AT-END OF ORDLF-STATUS
026720        PERFORM READ-ORDLF-NEXT.
026730
026870     PERFORM GET-TAXABLE THRU GET-TAXABLE-EXIT.
026880     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
026890     MOVE ORDH-SUB-ORDER-NO TO ORDL-SUB-ORDER-NO.
026900     MOVE 0 TO ORDL-SEQ-NO.
026910     PERFORM START-ORDLF-GREATER.
026920     IF NOT C-AT-END OF ORDLF-STATUS
026930        PERFORM READ-ORDLF-NEXT.
026940     PERFORM LFPR-START-COPY-4-FORM.
026950     MOVE SPACES TO PF-DOCU-ID.
026960     STRING 
026970          "SO" DELIMITED BY SIZE
026980          ORDH-ORDER-NO DELIMITED BY SIZE
026990          INTO PF-DOCU-ID.
027000     PERFORM PREPARE-PRINT-FILE.
027010     IF LFPR-NO-MORE-COPY
027020        GO TO PROCESS-REPORT-EXIT
027030     END-IF.
027040
027050 DETAIL-LOOP.
027060     IF NOT POS-PRINTING AND NOT SELECTIVE-PRINTING
027070        DISPLAY SCR-b0100xhp-cbl-2182-23  .
042709     MOVE SPACES TO PR-TS-TAX-1 OF INVFRM,
                        PR-TS-TAX-2 OF INVFRM,
                        PR-TS-TAX-3 OF INVFRM,
                        PR-TS-INV-AMT OF INVFRM.
061109     MOVE SPACES  TO PR-TOT-INV107-0 OF INVFRM, 
                           PR-TOT-INV107-1 OF INVFRM,
061109                     PR-TOT-INV107-2 OF INVFRM, 
                           PR-TOT-INV107-3 OF INVFRM,
061109                     PR-TOT-INV107-4 OF INVFRM.
060810     MOVE SPACES  TO PR-TOT-DEP-AMT OF INVFRM.
031510     MOVE ZEROES  TO PR-NET-TOTAL   OF DIAZO101
                           PR-DISC-TOTAL  OF DIAZO101. 
061109     SET ORDER-COMPLETE TO TRUE.
027130     PERFORM PRINT-FORM-AND-HEADER THRU 
027140             PRINT-FORM-AND-HEADER-EXIT.
027150     PERFORM SETUP-FOR-DETAIL-LINES.
027160*    MOVE SPACES TO CC-CARD-LINE, CC-VCODE-LINE, CC-EXPIRE-LINE,
027170*         CC-DESC.
027180     PERFORM MOVE-DETAIL THRU MOVE-DETAIL-EXIT.
027190     PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT
027200
027210*-- Used in CopyFil2.SR for PDF filename --*
027220*    MOVE SPACES      TO PCL-FILENAME.
027230*    STRING "SO"          DELIMITED BY SIZE
027240*           ORDH-ORDER-NO DELIMITED BY SIZE
027250*           ".PCL"        DELIMITED BY SIZE
027260*           INTO PCL-FILENAME.
027270*-- Done Printing an entire Copy, Send to Print Device --*
027280     PERFORM COPY-FILE.
027290     IF LFPR-CURR-COPYSEQ = 2 AND EMAIL-PDF-YES
027300        MOVE PDFCR-FULLPATH TO SENDMAIL-ATTACHMENT
027310        COMPUTE I = FUNCTION STORED-CHAR-LENGTH(CNTL-CONAME) 
027320        MOVE SPACES               TO SENDMAIL-SUBJECT
027330        MOVE CNTL-CONAME(1:I)     TO SENDMAIL-SUBJECT
027340        MOVE " - "                TO SENDMAIL-SUBJECT(I + 1:3)
027350        MOVE PDFCR-FILENAME(1:8)  TO SENDMAIL-SUBJECT(I + 4:8)
027360        MOVE EMAL-INV-HTML-MSG-FILE TO WS-HTML-MSG-FILE
027370        MOVE EMAL-INV-TEXT-MSG-FILE TO WS-TEXT-MSG-FILE
027380        MOVE EMAL-INV-CC-ADDR      TO WS-CC-ADDR
027390        MOVE EMAL-INV-BCC-ADDR     TO WS-BCC-ADDR
027400        MOVE EMAL-INV-FROM-ADDR    TO WS-FROM-ADDR
027410        PERFORM SEND-EMAIL
027420        SET EMAIL-PDF-NO TO TRUE.
027430
027440     IF NOT LFPR-NO-MORE-COPY
027450        MOVE ORDHF-KEY TO ORDLF-KEY
027460        MOVE ZERO TO ORDL-SEQ-NO, LINE-CNT
027470        MOVE 1         TO PAGE-NO
027480        PERFORM START-ORDLF-GREATER
020510        IF C-FOUND OF ORDLF-STATUS 
027490           PERFORM READ-ORDLF-NEXT
020510        END-IF  
027500        PERFORM PREPARE-PRINT-FILE
027520        IF NOT LFPR-NO-MORE-COPY
027530           GO TO DETAIL-LOOP.
027540     PERFORM REWRITE-ORDHF.
027550
027560 PROCESS-REPORT-READ.
027570     IF POS-PRINTING
027580        GO TO PROCESS-REPORT-EXIT.
027590     MOVE SPACES TO PR-TS-INV-AMT OF INVFRM,
027600                  PR-TS-CASH-DISC OF INVFRM,
027610                  PR-TS-TAX-3     OF INVFRM,
027620                  PR-TS-TAX-2     OF INVFRM,
027630                  PR-TS-TAX-1     OF INVFRM,
027640                  PR-CASH-DISC-MSG OF INVFRM,
027650                  PR-TAIL-TOTAL-1 OF INVFRM,
027660          PR-TAIL-TOTAL-2 OF INVFRM, PR-TAIL-TOTAL-3 OF INVFRM,
027670          PR-TAIL-TOTAL-4 OF INVFRM, PR-TAIL-TOTAL-5 OF INVFRM,
027680          PR-TAIL-TOTAL-6 OF INVFRM, PR-TAIL-TOTAL-7 OF INVFRM,  
027690          PR-TS-COST-AMT OF INVFRM, PR-TS-PROFIT-AMT OF INVFRM,
027700          PR-TS-PROFIT-PCT OF INVFRM.
031510     MOVE ZERO TO WS-INV-AMT2.
027710
027720     IF BULK-PRINT-YES AND PROCESS-HISTORY
027730        IF ASCII-SUB-ORDER-NO = ZERO
027740           PERFORM READ-ORDHF-NEXT
027750           IF C-AT-END OF ORDHF-STATUS
027760              NEXT SENTENCE
027770           ELSE
027780           IF ASCII-ORDER-NO NOT = ORDH-ORDER-NO
027790              MOVE AT-END TO ORDHF-STATUS
027800           ELSE
027810              GO TO PROCESS-REPORT-NEXT.
027820
027830     IF SELECTIVE-PRINTING
027840        PERFORM SELECTIVE-ORDER THRU SELECTIVE-ORDER-EXIT
027850        IF FLAG = 9
027860           GO TO PROCESS-REPORT-EXIT
027870        ELSE
027880           PERFORM FIND-ORDER THRU FIND-ORDER-EXIT
027890           IF C-AT-END OF ORDHF-STATUS
027900              DISPLAY SCR-b0100xhp-cbl-2233-29
027910              PERFORM WRITE-NOTFOUND-TEXT   
027920              GO TO PROCESS-REPORT-READ
027930           ELSE
027940              NEXT SENTENCE
027950      ELSE
027960         PERFORM READ-ORDHF-NEXT.
027970     IF ESC-FLAG = 1
027980        CALL "KBDCHK" USING FLAG, FKEYS.
027990     IF FLAG = 3
028000        PERFORM ACCEPT-PAUSE
028010        IF OPTION OF PAUSE-SPEC(1) = 1
028020           MOVE 3 TO FLAG
028030           GO TO PROCESS-REPORT-EXIT.
028040
028050**** MOVE ZERO TO COPIES-PRINTED.
028060**** PERFORM PREPARE-PRINT-FILE.
040811     MOVE ZERO TO COPIES-PRINTED.
028070     GO TO PROCESS-REPORT-NEXT.
028080
028090 PROCESS-REPORT-EXIT. EXIT.
028100
028110 PRINT-FORM-AND-HEADER SECTION.
028120 PRINT-FORM-AND-HDR-BEGIN.
028130*-- EXECUTE OVERLAY --*
028140*    MOVE WS-FORM-ID TO FORM-NUMBER.
028150*    IF FORM-NUMBER = ZERO
028160*       MOVE 00101 TO FORM-NUMBER.
028170*    PERFORM MOVE-SPACES-TO-PRINT-REC.
028180*    STRING HP-FORM-MACRO DELIMITED BY SIZE,
028190*           INTO PRINT-REC.
028200*    PERFORM WRITE-PRINT-REC-B4-ZERO.
028210
028220*    MOVE 320  TO VERT-POS.
028230*    MOVE 090  TO HORZ-POS.
009430     IF WS-LOGO-FILENAME NOT = SPACES
009440        MOVE WS-LOGO-FILENAME TO PR-COMPANY-LOGO OF INVFRM
009450        MOVE WS-LOGO-IMAGE-TYPE TO 
009460             EDIT-MODE OF PR-COMPANY-LOGO  OF INVFRM
009470     ELSE
              MOVE "X" TO EDIT-MODE OF PR-COMPANY-LOGO OF INVFRM
009480        PERFORM PRINT-COMPANY-INFO.
009490     IF WS-WMARK-FILENAME NOT = SPACES
009500        MOVE WS-WMARK-FILENAME TO PR-WATERMARK OF INVFRM
009510        MOVE WS-WMARK-IMAGE-TYPE TO
009520             EDIT-MODE OF PR-WATERMARK  OF INVFRM
           ELSE
              MOVE "X" TO EDIT-MODE OF PR-WATERMARK OF INVFRM.
028450     PERFORM PRINT-HEADER-INFO.
028460 PRINT-FORM-AND-HEADER-EXIT. EXIT.
028470
028480******************************************************************
028490 MOVE-DETAIL SECTION.
028500******************************************************************
028510 MOVE-DETAIL-START.
028520     IF C-AT-END OF ORDLF-STATUS
028530        GO TO MOVE-DETAIL-EXIT.
028540
028550     IF CREDIT-MEMO
028560         COMPUTE ORDL-ORDER-QTY = ORDL-ORDER-QTY * -1
028570         COMPUTE ORDL-SHIP-QTY = ORDL-SHIP-QTY * -1
028580         COMPUTE ORDL-EXT-AMT = ORDL-EXT-AMT * -1
028590         COMPUTE ORDL-EXT-COST = ORDL-EXT-COST * -1
028600* DON'T PRINT 'LOST' QUANTITIES
028610         MOVE 0 TO ORDL-BO-QTY.
028620     MOVE ORDL-ITEM-NO TO SPC-ITEM-NO.
028630
028640     MOVE SPACES TO DETAIL-LINE, DETAIL-LINE-RETAIL.
028800        
028850     IF WS-FORM-ID-107-104 AND FREIGHT
028870        GO TO MOVE-DETAIL-END
028880     END-IF.
028910     IF WS-FORM-ID-107-104 AND (SPC-CHG OR ORDL-ITEM-NO = "E")
091410        IF NOT AGRIBUS
028930           GO TO MOVE-DETAIL-END
091410        END-IF
028940     END-IF.
028950     IF NOT SPC-ITEM
028960       IF NO-DECIMALS
028970             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY
028980             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY
028990             MOVE ORDL-BO-QTY TO PR-BO-QTY
029000       ELSE
029010         IF ONE-DECIMAL
029020             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-1
029030             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY-1
029040             MOVE ORDL-BO-QTY TO PR-BO-QTY-1
029050         ELSE
029060         IF TWO-DECIMALS
029070             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-2
029080             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY-2
029090             MOVE ORDL-BO-QTY TO PR-BO-QTY-2
029100         ELSE
029110         IF THREE-DECIMALS
029120             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-3
029130             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY-3
029140             MOVE ORDL-BO-QTY TO PR-BO-QTY-3
029150         ELSE
029160         IF FOUR-DECIMALS
029170             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-4
029180             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY-4
029190             MOVE ORDL-BO-QTY TO PR-BO-QTY-4
029200         ELSE
029210         IF FIVE-DECIMALS
029220             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-5
029230             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY-5
029240             MOVE ORDL-BO-QTY TO PR-BO-QTY-5.
029250
029260     IF COMMENT
029270         IF NO-DECIMALS
029280             MOVE ORDL-ORDER-QTY TO PR-SHIP-QTY
029290         ELSE
029300         IF ONE-DECIMAL
029310             MOVE ORDL-ORDER-QTY TO PR-SHIP-QTY-1
029320         ELSE
029330         IF TWO-DECIMALS
029340             MOVE ORDL-ORDER-QTY TO PR-SHIP-QTY-2
029350         ELSE
029360         IF THREE-DECIMALS
029370             MOVE ORDL-ORDER-QTY TO PR-SHIP-QTY-3
029380         ELSE
029390         IF FOUR-DECIMALS
029400             MOVE ORDL-ORDER-QTY TO PR-SHIP-QTY-4
029410         ELSE
029420         IF FIVE-DECIMALS
029430             MOVE ORDL-ORDER-QTY TO PR-SHIP-QTY-5.
029440
029450     IF SPC-ITEM
029460        MOVE SPACES TO PR-ITEM-NO
029470     ELSE
029480        MOVE ORDL-ITEM-NO TO PR-ITEM-NO.
029490     MOVE ORDL-ITEM-DESC TO PR-ITEM-DESC.
029500
010810     IF PROFITS-APPAREL-YES
010810        MOVE SPACES TO PR-APPAREL-INFO 
031511*       IF WS-FORM-ID-101       
031511        IF WS-FORM-ID-110 
032011           IF SPC-ITEM
032011              MOVE SPACES TO PR-STYLE
032011           ELSE      
010810              MOVE ORDL-STYLE   TO PR-STYLE
032011           END-IF
010810           MOVE ORDL-COLOR   TO PR-COLOR
010810           MOVE ORDL-ITEM-DESC TO PR-APPRL-DESC
010810        END-IF
010810        IF NOT ORDL-CAT-NOTAPPAREL
010810           MOVE ORDL-GROUP-NAME TO SCAT-GROUP-NBR
010810           MOVE ORDL-CATEGORY TO SCAT-CAT-NUM
010810           PERFORM READ-SCAT-GC
010810           MOVE SCAT-CAT
010810             TO PR-CATEGORY
010810           MOVE ORDL-SIZE TO SCAT-SIZE-NUM
010810           MOVE ORDL-GROUP-NAME TO SCAT-GROUP-NBR
010810           PERFORM READ-SCAT-GS
010810           MOVE SCAT-SIZE TO PR-SIZE
010810        ELSE
010810           MOVE SPACES TO PR-SIZE, PR-CATEGORY.
029810
031511     IF LIBERTYU
031511        MOVE SPACES TO PR-COLOR.
029520     MOVE ORDL-ITEM-UOM TO PR-ITEM-UOM.
029530
029540     IF NOT COMMENT
029550        MOVE ORDL-EXT-AMT TO PR-EXT-AMT
029560     ELSE
029570        MOVE SPACES TO PR-EXT-AMT-ALPHA.
029580
029590
029600     IF NOT SPC-ITEM
029610         MOVE ORDL-ITEM-PRICE TO PR-ITEM-PRICE
029620         MOVE ORDL-EXT-COST TO PR-COST-AMT
029630         COMPUTE PROFIT = ORDL-EXT-AMT - ORDL-EXT-COST
029640         MOVE PROFIT TO PR-PROFIT-AMT
029650         IF ORDL-EXT-AMT NOT = 0
029660             COMPUTE PROFIT-PCT ROUNDED =
029670               PROFIT / ORDL-EXT-AMT * 100.00000 ON SIZE ERROR 
029680               MOVE ZERO TO PROFIT-PCT END-COMPUTE
029690         ELSE MOVE 0 TO PROFIT-PCT.
029700         MOVE PROFIT-PCT TO PR-PROFIT-PCT.
029710*     IF NOT SPC-ITEM AND INDMETALS AND ORDL-ITEM-UOM = "LB."
029720*        MOVE ORDL-ITEM-PRICE TO IM-CWT-ITEM-PRICE
029730*        MOVE "CWT"           TO PR-ITEM-UOM.
029740
029750     IF NOT SPC-ITEM
029760        IF RETAIL-PRICE-FORM
029770           MOVE DETAIL-LINE TO DR-FIRST-PART
029780           MOVE ORDL-ITEM-UOM TO DR-ITEM-UOM
029790           COMPUTE DR-ITEM-PRICE ROUNDED =
029800              ORDL-ITEM-PRICE + ORDL-DISC-AMT
029810           MOVE ORDL-ITEM-PRICE TO DR-DISC-PRICE
029820           MOVE ORDL-EXT-AMT TO DR-EXT-AMT.
029830     IF NOT COMMENT
029840        IF RETAIL-PRICE-FORM
029850           MOVE DETAIL-LINE TO DR-FIRST-PART
029860           MOVE ORDL-EXT-AMT TO DR-EXT-AMT.
029870
031511*-- NOT SURE WHAT THIS DOES, CAUSES COMMENT LINES TO LOOSE CHARACTERS ON THE RIGHT --*
031511*    IF COMMENT
031511*       IF RETAIL-PRICE-FORM
031511*          MOVE SPACES TO DETAIL-LINE-RETAIL
031511*          MOVE PR-ITEM-DESC TO DR-ITEM-DESC
031511*       ELSE
031511*       IF ORDL-SHIP-QTY NOT = ZERO OR ORDL-ORDER-QTY NOT = ZERO
031511*          NEXT SENTENCE
031511*       ELSE
031511*          MOVE PR-ITEM-DESC TO DR-ITEM-DESC
031511*          MOVE SPACES TO DETAIL-LINE
031511*          MOVE DR-ITEM-DESC TO PR-ITEM-DESC.
029990
030000     IF SPC-ITEM
030010        GO TO SKIP-STARPROD.
030020*    IF STARPROD
030030*       PERFORM GET-CLASS
030040*       MOVE WS-ITEM-PRICE TO DR-ITEM-PRICE
030050*       IF WS-ITEM-DESC NOT = SPACES
030060*          MOVE WS-ITEM-DESC TO PR-ITEM-DESC, DR-ITEM-DESC.
030070 SKIP-STARPROD.
030080*    IF WS-KNOCKOUT-CD(COPIES-PRINTED) = 1
030090     IF LFPR-KNOCKOUT
030100        MOVE SPACES TO DR-KNOCKOUT, PR-KNOCKOUT.
030110
030120     MOVE SPACES TO PR-DETAIL-LINE OF INVFRM.
030130     MOVE "ITEM" TO PFRPT-GROUP.
030140     IF NOT SPC-ITEM
030150*       IF PROFIT-TEAR-SLIP 
030160        IF PROFIT-TEAR-SLIP AND COPIES-PRINTED NOT = 1
030170*          MOVE 5900 TO HORZ-POS
030180*          PERFORM MOVE-SPACES-TO-PRINT-REC
030190*          STRING HP-HORZ-POSITION DELIMITED BY SIZE,
030200           STRING
030210                  PR-COST-AMT      DELIMITED BY SIZE
030220                  "  "             DELIMITED BY SIZE
030230                  PR-PROFIT-AMT    DELIMITED BY SIZE
030240                  "  "             DELIMITED BY SIZE
030250                  PR-PROFIT-PCT    DELIMITED BY SIZE
030260*                 INTO PRINT-REC
030270                  INTO PR-DETAIL-LINE OF INVFRM
030280           MOVE PR-DETAIL-LINE OF INVFRM(1:35) TO 
030290                PR-DETAIL-LINE OF INVFRM(135:35)
030300           MOVE SPACES TO PR-DETAIL-LINE OF INVFRM(1:35)
030310*          PERFORM WRITE-PRINT-REC-B4-ZERO.
030320        END-IF
030330     END-IF.
030340
030350     IF PROFIT-TEAR-SLIP
030360*       MOVE 0120 TO HORZ-POS
030370*       PERFORM MOVE-SPACES-TO-PRINT-REC
030380*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
030390        STRING
030400               PR-ORDER-QTY     DELIMITED BY SIZE
030410               "   "            DELIMITED BY SIZE
030420               PR-SHIP-QTY      DELIMITED BY SIZE
030430               "   "            DELIMITED BY SIZE
030440               PR-BO-QTY        DELIMITED BY SIZE
030450               "    "           DELIMITED BY SIZE
030460               PR-ITEM-NO       DELIMITED BY SIZE
030470               "       "        DELIMITED BY SIZE
030480               PR-ITEM-DESC     DELIMITED BY SIZE
030490               "    "           DELIMITED BY SIZE
030500               PR-ITEM-PRICE    DELIMITED BY SIZE
030510               "  "             DELIMITED BY SIZE
030520               PR-ITEM-UOM      DELIMITED BY SIZE
030530               "    "           DELIMITED BY SIZE
030540               PR-EXT-AMT       DELIMITED BY SIZE
030550*              INTO PRINT-REC
030560               INTO PR-DETAIL-LINE OF INVFRM
030570*       PERFORM WRITE-PRINT-REC-B4-ONE.
030580*       PERFORM WRITE-INVFRM
030590     END-IF.
030600
030660     IF PROFIT-TEAR-SLIP 
030670           NEXT SENTENCE
030680     ELSE
030690     IF RETAIL-PRICE-FORM
030710        MOVE DETAIL-LINE-RETAIL TO PR-DETAIL-LINE OF INVFRM
030730     ELSE
030750        MOVE DETAIL-LINE TO PR-DETAIL-LINE OF INVFRM
030770     END-IF.
020210     IF DIAZO
020210        MOVE ORDL-ORDER-QTY    TO PR-ORDER-QTY-DIAZO
020210        MOVE ORDL-SHIP-QTY     TO PR-SHIP-QTY-DIAZO
020210        MOVE ORDL-ITEM-DESC    TO PR-ITEM-DESC-DIAZO
020210        PERFORM GET-RETAIL-PRICE
020210        MOVE PR-DETAIL-LINE-DIAZO TO PR-DETAIL-LINE OF DIAZO101.
030780     ADD 1 TO LINE-CNT.
030790     PERFORM WRITE-INVFRM.
030800
030810     IF SPC-ITEM
030820        GO TO MOVE-DETAIL-END.
030830

042809*-- ADDED FOR PACA --*
042809     MOVE ORDL-ITEM-NO TO ITEMF-KEY.
042710     MOVE ORDL-WHSE-NO TO ITEM-WHSE-NO.
042809     PERFORM READ-ITEMF.
042809     IF ITEMF-STATUS NOT = RECORD-OK
042809        MOVE SPACES TO ITEM-DESC-2, ITEM-DESC-3.

090810     IF PROTECTI
042809       IF ITEM-DESC-2 NOT = SPACES
042809        MOVE SPACES TO DETAIL-LINE
042809        MOVE ITEM-DESC-2 TO PR-ITEM-DESC
042809        MOVE DETAIL-LINE TO PR-DETAIL-LINE OF INVFRM
042809        PERFORM WRITE-INVFRM
042809        ADD 1 TO LINE-CNT.
042809
090810     IF PROTECTI
042809       IF ITEM-DESC-3 NOT = SPACES
042809        MOVE SPACES TO DETAIL-LINE
042809        MOVE ITEM-DESC-3 TO PR-ITEM-DESC
042809        MOVE DETAIL-LINE TO PR-DETAIL-LINE OF INVFRM
042809        PERFORM WRITE-INVFRM
042809        ADD 1 TO LINE-CNT.

031030     IF ORDL-BO-QTY > 0 MOVE "N" TO ORDER-COMPLETE-FLAG.
031040
031050
031060 MOVE-DETAIL-END.
031080     PERFORM READ-ORDLF-NEXT .
031090     IF C-AT-END OF ORDLF-STATUS
031100        GO TO MOVE-DETAIL-EXIT.
031110     IF LINE-CNT < BODY-LINES
031120        GO TO MOVE-DETAIL-START
031130     ELSE
031140        PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT
031150        PERFORM PRINT-FORM-AND-HEADER THRU 
031160                PRINT-FORM-AND-HEADER-EXIT
031170        MOVE ZERO TO LINE-CNT
031180        PERFORM SETUP-FOR-DETAIL-LINES
031190        GO TO MOVE-DETAIL-START.
031200
031210 MOVE-DETAIL-EXIT. EXIT.
031220
031230******************************************************************
031240 PRINT-THE-PAGE SECTION.
031250******************************************************************
031260 PRINT-THE-PAGE-START.
031270     IF C-AT-END OF ORDLF-STATUS
031280        PERFORM PRINT-TOTALS.
031290
031300*-- PRINT COPY-MSG LINE --*
031530     MOVE LFPR-COPY-TO-PRINT TO PR-COPY-MSG OF INVFRM.
031540
031550     MOVE PAGE-NO TO PR-PAGE-NO.
031670     STRING
031680            "Page No. "      DELIMITED BY SIZE,
031690            PR-PAGE-NO       DELIMITED BY SIZE
031700*           INTO PRINT-REC.
031710            INTO PR-PAGE OF INVFRM.
020210     IF DIAZO
020210        MOVE PR-COPY-MSG OF INVFRM TO PR-COPY-MSG OF DIAZO101
020210        MOVE PR-PAGE OF INVFRM     TO PR-PAGE OF DIAZO101.

031820     ADD 1 TO PAGE-NO.

010810     MOVE SPACES TO PR-PACKER-NO OF INVFRM.
040511*    MOVE SPACES TO PR-JEREMIE-TERMS OF INV101.
010810     IF JEREMIE
040511        MOVE SPACES TO PR-JEREMIE-TERMS OF INVFRM
010810        STRING  "Packer No. "    DELIMITED BY SIZE
010810                ORDH-PACKER-NO   DELIMITED BY SIZE
                      INTO PR-PACKER-NO OF INVFRM
010810         STRING "Items not shipped, totaling less than $50, "
                      "will not be backordered.  Defective or "
                      "short-shipped orders must be reported to "
                      "Customer Service within ten (10) days of "
                      "receipt of shipment or credit will not be "
                      "honored." DELIMITED BY SIZE
                      INTO PR-JEREMIE-TERMS OF INVFRM. 

031830     MOVE "TAIL" TO PFRPT-GROUP.
031840     PERFORM WRITE-INVFRM.
031850
031930 PRINT-THE-PAGE-EXIT. EXIT.
031940
032140
032150     COPY "ASKCOPY.SR".
032170******************************************************************
032180 GET-PAYMENT SECTION.
032190******************************************************************
032200 GET-PAYMENT-START.
032210     PERFORM SCREEN-INIT.
032220     IF PROCESS-HISTORY
032230        NEXT SENTENCE
032240     ELSE
032250        COMPUTE ORDH-NET-AMT = ORDH-NET-AMT - ORDH-FREIGHT-AMT -
032260                ORDH-SPCHG-AMT.
032270     MOVE ORDH-NET-AMT TO PR-NET-AMT.
032280     MOVE ORDH-FREIGHT-AMT TO PR-FREIGHT-AMT.
032290     MOVE ORDH-SPCHG-AMT TO PR-SPCHG-AMT.
032300     MOVE ORDH-TAX-AMT TO PR-TAX-AMT.
032310     COMPUTE ORDH-INV-AMT = ORDH-NET-AMT + ORDH-FREIGHT-AMT +
032320          ORDH-SPCHG-AMT + ORDH-TAX-AMT.
032330     MOVE ORDH-INV-AMT TO PR-INV-AMT.
032340     COMPUTE PR-SUB-AMT = ORDH-INV-AMT - ORDH-TAX-AMT.
032350     
032360      DISPLAY SCR-b0100xhp-cbl-2691-20
032370      DISPLAY SCR-b0100xhp-cbl-2692-20
032380      DISPLAY SCR-b0100xhp-cbl-2693-20
032390      DISPLAY SCR-b0100xhp-cbl-2694-20
032400      DISPLAY SCR-b0100xhp-cbl-2695-20
032410      DISPLAY SCR-b0100xhp-cbl-2696-20
032420      DISPLAY SCR-b0100xhp-cbl-2697-20
032430      DISPLAY SCR-b0100xhp-cbl-2698-20
032440      DISPLAY SCR-b0100xhp-cbl-2699-20
032450      DISPLAY SCR-b0100xhp-cbl-2700-20
032460      DISPLAY SCR-b0100xhp-cbl-2701-20
032470      DISPLAY SCR-b0100xhp-cbl-2702-20
032480      DISPLAY SCR-b0100xhp-cbl-2703-20
032490      DISPLAY SCR-b0100xhp-cbl-2704-20
032500      DISPLAY SCR-b0100xhp-cbl-2705-20.
032510     MOVE ORDH-PMT-CD TO OPTION OF TYPE-SPEC.
032520 GET-PAYMENT-TYPE.
032530     MOVE "1010000000" TO FKEYS.
032540     MOVE 0 TO FLAG.
032550     PERFORM STEST-b0100xhp-cbl-2710
032560     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, TYPE-HELP,
032570       PMT-CODES
032580     PERFORM STEST-AFTER-CALL.
032590     IF FLAG = 3
032600         GO TO GET-PAYMENT-EXIT.
032610     MOVE OPTION OF TYPE-SPEC TO ORDH-POS-CD.
032620     IF ORDH-POS-CD = 1
032630         GO TO GET-PAYMENT-EXIT.
032640     DISPLAY SCR-b0100xhp-cbl-2717-20  .
032650     IF ORDH-DEP-AMT NOT = 0
032660         MOVE ORDH-DEP-AMT TO PMT-AMT
032670     ELSE MOVE ORDH-INV-AMT TO PMT-AMT.
032680*    IF ATHENS   
032690*       MOVE ORDH-INV-AMT TO PMT-AMT.
032700 GET-PAYMENT-AMOUNT.
032710     MOVE "1010000000" TO FKEYS.
032720     MOVE 0 TO FLAG.
032730     PERFORM STEST-b0100xhp-cbl-2726
032740     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, PMT-HELP,
032750       PMT-AMT
032760     PERFORM STEST-AFTER-CALL.
032770     IF FLAG = 3
032780         DISPLAY SCR-b0100xhp-cbl-2729-24   
032790         GO TO GET-PAYMENT-TYPE.
032800     IF ORDH-POS-CD NOT = 2
032810         GO TO GET-PAYMENT-DONE.
032820     IF PMT-AMT > ORDH-INV-AMT
032830         MOVE "Change" TO PR-CHANGE-MSG
032840         COMPUTE PR-CHANGE-AMT = PMT-AMT - ORDH-INV-AMT
032850     ELSE MOVE "Balance Due" TO PR-CHANGE-MSG
032860         COMPUTE PR-CHANGE-AMT = ORDH-INV-AMT - PMT-AMT.
032870     
032880      DISPLAY SCR-b0100xhp-cbl-2738-20
032890      DISPLAY SCR-b0100xhp-cbl-2739-20.
032900     MOVE "1010000000" TO FKEYS.
032910     MOVE 0 TO FLAG.
032920     PERFORM STEST-b0100xhp-cbl-2742
032930     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS,
032940       PRINT-HELP, INVIS-OPTION
032950     PERFORM STEST-AFTER-CALL.
032960     IF FLAG = 3
032970         
032980      DISPLAY SCR-b0100xhp-cbl-2745-24
032990      DISPLAY SCR-b0100xhp-cbl-2746-24
033000         GO TO GET-PAYMENT-AMOUNT.
033010 GET-PAYMENT-DONE.
033020     IF PMT-AMT > ORDH-INV-AMT
033030         MOVE ORDH-INV-AMT TO ORDH-DEP-AMT
033040     ELSE MOVE PMT-AMT TO ORDH-DEP-AMT.
033050 GET-PAYMENT-EXIT. EXIT.
033060
033070******************************************************************
033080 GET-INV-DATE SECTION.
033090******************************************************************
033100 GET-INV-DATE-START.
033110     PERFORM SCREEN-INIT.
033120     DISPLAY SCR-b0100xhp-cbl-2759-20  .
033130     DISPLAY SCR-b0100xhp-cbl-2760-20  .
033140*    DISPLAY "Long  Message" LINE 14 POSITION 32.
033150     MOVE 3 TO CNTLF-KEY.
033160     PERFORM READ-CNTLF-LOCK.
033170 ACCEPT-DATE.
033180     MOVE "1001000000" TO FKEYS
033190     MOVE 0 TO FLAG.
033200     PERFORM STEST-b0100xhp-cbl-2767
033210     CALL "SCRN04" USING FLAG, FKEYS, STEST-SCRN-SPECS, DATE-HELP,
033220         INV-DATE
033230         CNTL3-SHORT-MSG-1, CNTL3-SHORT-MSG-2, CNTL3-SHORT-MSG-3
033240     PERFORM STEST-AFTER-CALL.
033250*        CNTL3-LONG-MSG-1, CNTL3-LONG-MSG-2, CNTL3-LONG-MSG-3.
033260*    IF FLAG = 4 GO TO GET-INV-DATE-EXIT.
033270     IF FLAG = 4
033280        GO TO GET-INV-DATE-CNTLF.
033290     MOVE INV-DATE TO DATE-IN.
033300     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
033310     MOVE DATE-IN TO INV-DATE.
033320     IF BAD-DATE OR INV-DATE = 0
033330         DISPLAY SCR-b0100xhp-cbl-2778-24   
033340         GO TO ACCEPT-DATE.
033350     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
033360     MOVE DATE-OUT-11 TO PR-INV-DATE-11.
033370     MOVE CNTL3-SHORT-MSG TO SHORT-MSG-LINES.
033380*    MOVE CNTL3-LONG-MSG  TO LONG-MSG-LINES.
033390     REWRITE CNTLF-REC.
033400 GET-INV-DATE-CNTLF.
033410     MOVE 1 TO CNTLF-KEY.
033420     PERFORM READ-CNTLF.
033430 GET-INV-DATE-EXIT. EXIT.
033440
033450******************************************************************
033460 GET-INV-NUMBER SECTION.
033470******************************************************************
033480 GET-INV-NUMBER-START.
033490     IF FORCE-INVOICE-NO-YES
033500        MOVE ORDH-ORDER-NO TO ORDH-INV-NO
033510        GO TO GET-INV-NUMBER-EXIT.
033520
033530     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
033540      CNTLF-STATUS OR IO-WAIT-OFF 
033550     READ CNTLF
033560     END-READ END-PERFORM.
033570     MOVE CNTL-NEXT-INVNO TO ORDH-INV-NO.
033580     IF CNTL-NEXT-INVNO < 999990
033590         ADD 1 TO CNTL-NEXT-INVNO
033600     ELSE MOVE 1 TO CNTL-NEXT-INVNO.
033610     REWRITE CNTLF-REC.
033620
033630 GET-INV-NUMBER-EXIT. EXIT.
033640
033650******************************************************************
033660 RANGE-SELECT SECTION.
033670******************************************************************
033680 GET-RANGE.
033690     IF POS-PRINTING OR LAST-OPTION = 020704
033700        GO TO RANGE-SELECT-EXIT.
033710     PERFORM SCREEN-INIT.
033720     MOVE "1010000000" TO FKEYS.
033730     MOVE 0 TO FLAG.
061109     IF SUNBELTS AND LAST-OPTION = 020207
061109        MOVE 1 TO OPTION OF RANGE-SPEC-1(2).
033740     IF PROCESS-HISTORY
033750        MOVE 3 TO OPTION OF RANGE-SPEC-1(1)
033760        MOVE 1 TO OPTION OF RANGE-SPEC-1(3)
033770     ELSE
033780        DISPLAY SCR-b0100xhp-cbl-2820-23             
033790        DISPLAY SCR-b0100xhp-cbl-2821-23  
033800        DISPLAY SCR-b0100xhp-cbl-2822-23  
033810        PERFORM STEST-b0100xhp-cbl-2823
033820        CALL "SCRN03" USING FLAG, FKEYS, STEST-SCRN-SPECS,
033830          HELP1, RANGE-CODES, FORM-CODES, ORDER-CODES
033840        PERFORM STEST-AFTER-CALL.
033850     MOVE OPTION OF RANGE-SPEC-1(1) TO RANGE-TYPE-FLAG.
033860     MOVE OPTION OF RANGE-SPEC-1(3) TO WS-ORDER-FLAG.
033870     MOVE OPTION OF RANGE-SPEC-1(2) TO FORM-TYPE-FLAG.
033880     IF FLAG = 3 GO TO RANGE-SELECT-EXIT.
033890     IF PRINT-ALL-ORDERS
033900          MOVE LOW-VALUES TO LOW-ORDHF-KEY
033910          MOVE HIGH-VALUES TO HIGH-ORDHF-KEY
033920          PERFORM SCREEN-INIT
033930          DISPLAY SCR-b0100xhp-cbl-2833-25  
033940          GO TO RANGE-SELECT-EXIT.
033950     IF SELECTIVE-PRINTING
033960          GO TO RANGE-SELECT-EXIT.
033970     IF BY-BATCH-NO
033980        MOVE LOW-VALUES TO LOW-ORDHF-KEY
033990        MOVE HIGH-VALUES TO HIGH-ORDHF-KEY
034000        PERFORM SCREEN-INIT
034010        DISPLAY SCR-b0100xhp-cbl-2841-23  
034020        PERFORM GET-BATCH-NO
034030        GO TO RANGE-SELECT-EXIT.
034040     IF BY-SALESMAN-PRINTING
034050      MOVE 03 TO FLEN OF RANGE-SPEC-2(1), FLEN OF RANGE-SPEC-2(2)
034060                 SLEN OF RANGE-SPEC-2(1), SLEN OF RANGE-SPEC-2(2)
034070     ELSE
034080      MOVE 06 TO FLEN OF RANGE-SPEC-2(1), FLEN OF RANGE-SPEC-2(1)
034090                 SLEN OF RANGE-SPEC-2(1), SLEN OF RANGE-SPEC-2(1).
034100     DISPLAY SCR-b0100xhp-cbl-2850-20  .
034110     DISPLAY SCR-b0100xhp-cbl-2851-20  .
034120     DISPLAY SCR-b0100xhp-cbl-2852-20  .
034130     MOVE SPACES TO LOW-ORDHF-KEY, HIGH-ORDHF-KEY.
034140 GET-LOW-HIGH.
034150     MOVE "1010000000" TO FKEYS.
034160     MOVE 0 TO FLAG.
034170     PERFORM STEST-b0100xhp-cbl-2857
034180     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
034190       HELP2, LOW-ORDER, HIGH-ORDER
034200     PERFORM STEST-AFTER-CALL.
034210     IF FLAG = 3
034220        GO TO GET-RANGE.
034230     MOVE ZERO TO LOW-SUB-ORDER.
034240     MOVE 99   TO HIGH-SUB-ORDER.
034250     IF LOW-ORDHF-KEY > HIGH-ORDHF-KEY
034260         DISPLAY SCR-b0100xhp-cbl-2864-24   
034270         GO TO GET-LOW-HIGH.
034280     IF BY-SALESMAN-PRINTING
034290        PERFORM SCREEN-INIT
034300        DISPLAY SCR-b0100xhp-cbl-2868-23  
034310        GO TO RANGE-SELECT-EXIT.
034320     MOVE LOW-ORDHF-KEY TO ORDHF-KEY.
034330     PERFORM START-ORDHF.
034340     IF C-AT-END OF ORDHF-STATUS
034350         DISPLAY SCR-b0100xhp-cbl-2873-24   
034360         GO TO GET-LOW-HIGH.
034370     PERFORM SCREEN-INIT.
034380     DISPLAY SCR-b0100xhp-cbl-2876-20  .
034390     GO TO RANGE-SELECT-EXIT.
034400
034410 RANGE-SELECT-EXIT. EXIT.
034420
034430
034440******************************************************************
034450 SELECTIVE-ORDER SECTION.
034460******************************************************************
034470 SELECTIVE-ORDERS.
034480     DISPLAY SCR-b0100xhp-cbl-2886-20  .
034490     DISPLAY SCR-b0100xhp-cbl-2887-20  .
034500     IF PROCESS-HISTORY
034510        MOVE 1 TO ORDH-SUB-ORDER-NO
034520        DISPLAY SCR-b0100xhp-cbl-2890-23  .
034530     IF BULK-PRINT-YES
034540        MOVE "0010000000" TO FKEYS
034550        MOVE 1            TO FLAG
034560        PERFORM READ-ASCII-NEXT
034570        IF C-AT-END OF ASCII-STATUS
034580           MOVE 9 TO FLAG
034590           GO TO SELECTIVE-ORDER-EXIT
034600        ELSE
034610           MOVE ASCII-ORDER-NO      TO ORDH-ORDER-NO
034620           MOVE ASCII-SUB-ORDER-NO  TO ORDH-SUB-ORDER-NO
034630           PERFORM START-ORDHF
034640     ELSE
034650*       MOVE "1000000010" TO FKEYS
034660        MOVE "1000001010" TO FKEYS
034670        MOVE 0 TO FLAG.
034680     PERFORM STEST-b0100xhp-cbl-2893
034690     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
034700       HELP3, ORDH-ORDER-NO, ORDH-SUB-ORDER-NO
034710     PERFORM STEST-AFTER-CALL.
034720     IF FLAG = 9
034730        GO TO SELECTIVE-ORDER-EXIT.
034740     IF FLAG = 7
034750        PERFORM GET-BULK-FILE THRU GET-BULK-FILE-EXIT
034760        IF FLAG = 9
034770           GO TO SELECTIVE-ORDER-EXIT
034780        ELSE
034790           SET BULK-PRINT-YES TO TRUE
034800           GO TO SELECTIVE-ORDERS.
034810     IF ORDH-ORDER-NO = ZERO
034820        GO TO SELECTIVE-ORDERS.
034830
034840 SELECTIVE-ORDER-EXIT. EXIT.
034850
034860 GET-BULK-FILE SECTION.
034870 GET-BULK-FILE-BEGIN.
034880     MOVE SPACES    TO WS-FILENAME.
034890     MOVE "Select Input File" TO WS-FILE-DIALOG-TITLE.
034900     MOVE "Text Files|*.TXT|Print Files|*.PRN|All Files|*.*" 
034910          TO WS-FILE-MASK-LIST.
034920     MOVE POW-CDOPEN          TO WS-FILE-DIALOG-STYLE.
034930     ADD  POW-CDNOCHANGEDIR   TO WS-FILE-DIALOG-STYLE.
034940
034950 GET-BULK-CALL-POWCBL.
034960     COPY "PC_GETFILENAME.SR".
034970     IF WS-FILE-RETURNVALUE = POW-FALSE
034980        MOVE 9 TO FLAG
034990        MOVE SPACES   TO ASCII-FULLPATH
035000     ELSE
035010        MOVE 0 TO FLAG
035020        MOVE WS-FILENAME TO ASCII-FULLPATH
035030        OPEN INPUT ASCII
035040        MOVE "ORDERS.BAD" TO DEL-NAME
035050        CALL "DELETE" USING DEL-NAME.
035060
035070 GET-BULK-FILE-EXIT. EXIT.
035080
035090******************************************************************
035100 FIND-ORDER SECTION.
035110******************************************************************
035120 FIND-ORDER-START.
050109     IF BULK-PRINT-YES 
035130        IF PROCESS-HISTORY AND ASCII-SUB-ORDER-NO = ZERO
035140           PERFORM READ-ORDHF-NEXT
035150           IF C-AT-END OF ORDHF-STATUS
035160             GO TO FIND-ORDER-EXIT
035170           ELSE 
035180           IF ASCII-ORDER-NO NOT = ORDH-ORDER-NO
035190              MOVE AT-END TO ORDHF-STATUS
035200              GO TO FIND-ORDER-EXIT
035210           ELSE
035220              GO TO FIND-ORDER-EXIT
050109        ELSE
050109           GO TO FIND-ORDER-EXIT
035230     ELSE
035240        PERFORM READ-ORDHF
035250        GO TO FIND-ORDER-EXIT.
035260
035270     IF LAST-OPTION NOT = 020704
035280        PERFORM READ-ORDHF
035290        GO TO FIND-ORDER-EXIT.
035300     CLOSE ORDHF.
035310     CALL "CHGDIR" USING MASTER-DIR, RETURN-CD.
035320     CALL "CHGDIR" USING SUB-DIR, RETURN-CD.
035330
035340*-- CHECK BILLING FILE --*
035350     MOVE "ORDERH.FIL" TO EXT-HDR-FILE.
035360     PERFORM CALL-ASSIGN-HDR.
035370     PERFORM OPEN-ORDHF.
035380     PERFORM READ-ORDHF.
035390     IF C-FOUND OF ORDHF-STATUS
035400        MOVE "I" TO PROCESS-ORDERS-FLAG
035410        MOVE "ORDERL.FIL" TO EXT-LIN-FILE
035420        GO TO FIND-ORDER-CLEANUP.
035430
035440*-- CHECK OPEN ORDERS FILE --*
035450     CLOSE ORDHF.
035460     MOVE "OPENHDR.FIL" TO EXT-HDR-FILE.
035470     PERFORM CALL-ASSIGN-HDR.
035480     PERFORM OPEN-ORDHF.
035490     PERFORM READ-ORDHF.
035500     IF C-FOUND OF ORDHF-STATUS
035510        MOVE "O" TO PROCESS-ORDERS-FLAG
035520        MOVE "OPENLINE.FIL" TO EXT-LIN-FILE
035530        GO TO FIND-ORDER-CLEANUP.
035540
035550     GO TO FIND-ORDER-EXIT.
035560
035570 FIND-ORDER-CLEANUP.
035580     CLOSE ORDLF.
035590     MOVE EXT-LIN-FILE TO ORDLF--NAME
035600      PERFORM ORDLF-FILL-FULLPATH.
035610     PERFORM OPEN-ORDLF.
035620
035630 FIND-ORDER-EXIT. EXIT.
035640
035650
035660******************************************************************
035670*PROCESS-SERIAL-NUMBERS SECTION.
035680******************************************************************
035690*PROCESS-SERIAL-NUMBERS-START.
035700*
035710*    IF SERLF-STATUS = RECORD-OK
035720*       PERFORM READ-SERLF-NEXT.
035730*
035740*SERIAL-NUMBER-LOOP.
035750*    IF SERLF-STATUS = AT-END
035760*       GO TO PROCESS-SERIAL-NUMBERS-EXIT.
035770*    IF SERL-SO-NUMBER-KEY NOT = ORDLF-KEY
035780*         GO TO PROCESS-SERIAL-NUMBERS-EXIT.
035790*
035800*    IF PR-SERL-NO-A = SPACES
035810*       MOVE SERL-NUMBER TO PR-SERL-NO-A
035820*    ELSE
035830*       MOVE SERL-NUMBER TO PR-SERL-NO-B
035840*          GO TO PROCESS-SERIAL-NUMBERS-EXIT.
035850*
035860*    PERFORM READ-SERLF-NEXT.
035870*    GO TO SERIAL-NUMBER-LOOP.
035880*
035890*PROCESS-SERIAL-NUMBERS-EXIT. EXIT.
035900
035910
042710 COMBINE-CONTRACT-QTYS SECTION.
042710 CCQS.
042710* MAKE A PASS THRU ALL LINES, FIND ALL USING CONTRACT QTY TABLE
042710* (SET IN B0000), BUILD AN ARRAY OF CONTRACTS USED & TOTAL SQ FT
042710* NEXT - USING THE COMBINED TOTAL SQ FT FOR EACH CONTRACT, FIND
042710* THE BEST PRICE FROM THE CONTRACT TABLE
042710* NOW - REWRITE THAT BEST PRICE INTO THE ORDL FILE (2ND PASS)
042710* COMBINE NON-CONTRACT ITEMS FOR BEST PRICE
042710* IN CLASS-ARR, IF NON-CONTRACT ITEM, BLANK OUT CUST-NO
042710* IN FINDING PRICE, IF CUST-NO = SPACES, LOOK IN THE ITEM FILE
042710     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
042710     MOVE ZERO          TO ORDL-SUB-ORDER-NO.
042710     MOVE 0 TO ORDL-SEQ-NO.
042710     PERFORM START-ORDLF-GREATER.
042710 COMBINE-LOOP.
042710     IF NOT C-AT-END OF ORDLF-STATUS
042710         PERFORM READ-ORDLF-NEXT.
042710     IF C-AT-END OF ORDLF-STATUS GO TO FIND-BEST-PRICE.
042710      PERFORM 4220-GET-CONTRACT-PRICE.
042710     GO TO COMBINE-LOOP.
042710
042710 FIND-BEST-PRICE.
042710     PERFORM SET-BEST-PRICE VARYING CC FROM 1 BY 1
042710             UNTIL CC > 9 OR CLASS-ARR(CC) = SPACES.
042710     PERFORM RESET-LINE-PRICE.
042710     GO TO COMBINE-EXIT.
042710
042710 SET-BEST-PRICE.
042710     IF CLASS-ARR(CC) NOT = SPACES
042710      MOVE CLASS-ARR(CC) TO CONTF-KEY
042710      IF CONT-CUST-NO NOT = SPACES
042710       PERFORM READ-CONTF
042710       PERFORM CALC-DIAZO-2 VARYING DD FROM 5 BY -1
042710         UNTIL (DD < 1) OR ((CONT-QTY-BRK(DD) NOT = 0)
042710           AND (SQ-FT-ARR(CC) NOT < CONT-QTY-BRK(DD))).
042710     IF CONT-CUST-NO = SPACES
042710       MOVE CONT-ITEM-NO TO ITEM-NUMBER
042710       MOVE ORDL-WHSE-NO TO ITEM-WHSE-NO
042710       PERFORM READ-ITEMF
CLNUP1       IF C-RECORD-OK OF ITEMF-STATUS
042710          PERFORM CALC-DIAZO-2 VARYING DD FROM 5 BY -1
042710             UNTIL (DD < 1) OR ((ITEM-QTY-BRK(DD) NOT = 0)
042710                  AND (SQ-FT-ARR(CC) NOT < ITEM-QTY-BRK(DD))).
042710
042710     IF CONT-CUST-NO NOT = SPACES
042710      IF DD > 0 AND DD NOT > 5
042710         MOVE CONT-PRICES(DD) TO BEST-PRICE(CC).
042710     IF CONT-CUST-NO = SPACES
042710      IF DD > 0 AND DD NOT > 5
042710         MOVE ITEM-QTY-DISC(DD) TO BEST-PRICE(CC).
042710
042710 4220-GET-CONTRACT-PRICE.
042710     MOVE ORDH-CUST-NO TO CONT-CUST-NO.
042710     MOVE ORDL-ITEM-NO TO CONT-ITEM-NO.
042710     MOVE 0 TO CONT-ITEM-CLASS.
042710     PERFORM      READ-CONTF.
CLNUP1     IF (C-RECORD-OK OF CONTF-STATUS)
042710        PERFORM CALC-DIAZO-PRICE.
042710     IF CONTF-STATUS = NOT-FOUND
042710         MOVE ORDH-CUST-NO TO CONT-CUST-NO
042710         MOVE SPACES TO CONT-ITEM-NO
042710         MOVE ORDL-ITEM-CLASS TO CONT-ITEM-CLASS
042710         PERFORM      READ-CONTF
CLNUP1         IF (C-RECORD-OK OF CONTF-STATUS)
042710           PERFORM CALC-DIAZO-PRICE.
042710     IF CONTF-STATUS = NOT-FOUND
042710         MOVE ORDL-ITEM-NO TO ITEM-NUMBER
042710         MOVE ORDL-WHSE-NO TO ITEM-WHSE-NO
042710         PERFORM READ-ITEMF
CLNUP1         IF C-RECORD-OK OF ITEMF-STATUS
042710           PERFORM CALC-DIAZO-PRICE-NONCONTRACT.
042710
042710 CALC-DIAZO-PRICE.
042710     COMPUTE WS-SQ-FT ROUNDED = ORDL-SQ-FT * ORDL-ORDER-QTY.
042710     IF WS-DEC-PART > 1
042710         MOVE 0 TO WS-DEC-PART
042710         ADD 1 TO WS-FT-PART.
042710     IF ORDL-SQ-FT > 0
042710       PERFORM CALC-DIAZO-2 VARYING DD FROM 5 BY -1
042710         UNTIL (DD < 1) OR ((CONT-QTY-BRK(DD) NOT = 0)
042710           AND (WS-SQ-FT NOT < CONT-QTY-BRK(DD))).
090302*    IF ORDL-SQ-FT > ZERO
090302*       IF DD > 0 AND DD NOT > 5
090302*          MOVE CONT-PRICES(DD) TO ORDL-ITEM-PRICE
081002     IF ORDL-SQ-FT > ZERO
042710       MOVE "N" TO FOUND-CONTRACT-FLAG
042710       PERFORM ADD-TO-CONTRACT-TABLE
042710         VARYING DD FROM 1 BY 1 UNTIL (DD > 9)
042710             OR FOUND-CONTRACT.
042710
042710 CALC-DIAZO-PRICE-NONCONTRACT.
042710     COMPUTE WS-SQ-FT ROUNDED = ORDL-SQ-FT * ORDL-ORDER-QTY.
042710     IF WS-DEC-PART > 1
042710         MOVE 0 TO WS-DEC-PART
042710         ADD 1 TO WS-FT-PART.
042710     IF ORDL-SQ-FT > 0
042710       PERFORM CALC-DIAZO-2 VARYING DD FROM 5 BY -1
042710         UNTIL (DD < 1) OR ((ITEM-QTY-BRK(DD) NOT = 0)
042710           AND (WS-SQ-FT NOT < ITEM-QTY-BRK(DD))).
090302*    IF ORDL-SQ-FT > 0 AND DD > 0 AND DD NOT > 5
042710***** AND ITEM-QTY-DISC(DD) < ORDL-ITEM-PRICE
090302*      MOVE ITEM-QTY-DISC(DD) TO ORDL-ITEM-PRICE.
081002     IF ORDL-SQ-FT > ZERO
042710       MOVE "N" TO FOUND-CONTRACT-FLAG
042710       MOVE SPACES TO CONT-CUST-NO
042710       MOVE ORDL-ITEM-NO TO CONT-ITEM-NO
042710       MOVE 0 TO CONT-ITEM-CLASS
042710       PERFORM ADD-TO-CONTRACT-TABLE
042710         VARYING DD FROM 1 BY 1 UNTIL (DD > 9)
042710             OR FOUND-CONTRACT.
042710
042710 CALC-DIAZO-2.
042710
042710 ADD-TO-CONTRACT-TABLE.
042710     IF CLASS-ARR(DD) = CONTF-KEY
042710       ADD  WS-SQ-FT  TO SQ-FT-ARR(DD)
042710       MOVE "Y" TO FOUND-CONTRACT-FLAG
042710     ELSE
042710     IF CLASS-ARR(DD) = SPACES
042710       MOVE CONTF-KEY TO CLASS-ARR(DD)
042710       MOVE WS-SQ-FT  TO SQ-FT-ARR(DD)
042710       MOVE "Y" TO FOUND-CONTRACT-FLAG.
042710
042710 COMBINE-EXIT. EXIT.
042710
042710 RESET-LINE-PRICE SECTION.
042710 RLPS.
042710* RESET THE BEST CONTRACT PRICE FOUND INTO THE LINE FILE
042710*  AFTER COMBINING ALL LIKE CONTRACTS
042710     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
042710     MOVE ZERO          TO ORDL-SUB-ORDER-NO.
042710     MOVE 0 TO ORDL-SEQ-NO.
042710     PERFORM START-ORDLF-GREATER.
042710 LOOP2.
042710     IF NOT C-AT-END OF ORDLF-STATUS
042710         PERFORM READ-ORDLF-NEXT.
042710     IF NOT C-AT-END OF ORDLF-STATUS
042710**     IF QTY-CONTRACT
090302       IF NOT PRICE-OVERRIDE-YES
042710          PERFORM RELOAD-ORDL-PRICE.
042710     IF NOT C-AT-END OF ORDLF-STATUS
042710         GO TO LOOP2.
042710     GO TO RESET-EXIT.
042710
042710 RELOAD-ORDL-PRICE.
042710     PERFORM FIND-ARRAY-ELEMENT.
042710     COMPUTE WS-SQ-FT ROUNDED = ORDL-SQ-FT * ORDL-SHIP-QTY.
042710     IF WS-DEC-PART > 1
042710         MOVE 0 TO WS-DEC-PART
042710         ADD 1 TO WS-FT-PART.
042710     IF DD NOT > 9
042710       IF BEST-PRICE(DD) NOT = 0
090302         MOVE 5 TO ORDL-DISC-CD
042710         MOVE BEST-PRICE(DD) TO ORDL-ITEM-PRICE
042710         COMPUTE ORDL-EXT-AMT ROUNDED = ORDL-ITEM-PRICE
042710           * WS-SQ-FT.
042710     PERFORM REWRITE-ORDLF.
042710
042710 FIND-ARRAY-ELEMENT.
042710     IF QTY-CONTRACT
042710       MOVE ORDH-CUST-NO TO CONT-CUST-NO
042710     ELSE MOVE SPACES TO CONT-CUST-NO.
042710     MOVE ORDL-ITEM-NO TO CONT-ITEM-NO.
042710     MOVE 0 TO CONT-ITEM-CLASS.
042710     PERFORM CALC-DIAZO-2 VARYING DD FROM 1 BY 1
042710       UNTIL DD > 9 OR CONTF-KEY = CLASS-ARR(DD).
042710     IF DD > 9
042710         MOVE ORDH-CUST-NO TO CONT-CUST-NO
042710         MOVE SPACES TO CONT-ITEM-NO
042710         MOVE ORDL-ITEM-CLASS TO CONT-ITEM-CLASS
042710         PERFORM CALC-DIAZO-2 VARYING DD FROM 1 BY 1
042710           UNTIL DD > 9 OR CONTF-KEY = CLASS-ARR(DD).
042710 RESET-EXIT. EXIT.

035920*-- Subroutines --*
035930     COPY "CHAINR.SR".
035940     COPY "PRINT.SR".
035950     COPY "PAUSE.SR".
035960     COPY "FAXMSG.SR".
035970     COPY "AUTHNO.SR".
035980******************************************************************
035990 GET-FAX-INFO SECTION.
036000******************************************************************
036010 GET-FAX-INFO-START.
036020     PERFORM SCREEN-INIT.    
036030     MOVE ZERO TO FLAG.
036040     MOVE "\PROFITS\FAXINFO" TO NEXT-PROG2.
036050     REWRITE USERF-REC.
036060*    CLOSE USERF, CNTLF, CLOSE LO.
036070     CLOSE USERF, CNTLF.
036080     MOVE 1                  TO CHAINED-FLAG.
036090     MOVE ORDH-CUST-NO       TO WS-RECORD-KEY.
036100     MOVE CUST-PHONE         TO TEMP2-PHONE.
036110     PERFORM CHNR-NEXT-PROG2-WS-FAX-SHARED.
036120     OPEN I-O USERF.
036130     OPEN I-O CNTLF.
036140*    MOVE 1  TO USER-PTR-CHN.
036150*    PERFORM OPEN-LO-LASER.
036160     MOVE "PMENU" TO NEXT-PROG.
036170     DISPLAY SCR-b0100xhp-cbl-2993-20  .
036180     MOVE SPACES TO WS-FAX-SUBJECT.
036190     STRING "Invoice No: "      DELIMITED BY SIZE
036200            ORDH-ORDER-NO       DELIMITED BY SIZE
036210            INTO WS-FAX-SUBJECT.
036220*    IF RETURN-FLAG = 0
036230*       PERFORM STRING-FAX-TAG-LINE
036240*       IF COPIES-PRINTED = 10
036250*          WRITE PRINT-REC BEFORE ADVANCING 1. 
036260 GET-FAX-INFO-EXIT. EXIT.
036270
036280 RECALC-HEADERS SECTION.
036290 RECALC-BEGIN.
036300     MOVE ZERO TO ORDH-GROSS-AMT, ORDH-NET-AMT.
036310     MOVE ZERO TO ORDH-SPCHG-AMT, ORDH-FREIGHT-AMT, ORDH-COST-AMT.
036320     MOVE ZERO TO ORDH-DISC-AMT, ORDH-COMM-AMT.
036330     MOVE ORDH-ORDER-NO TO ORDL-ORDER-NO.
036340     MOVE ORDH-SUB-ORDER-NO TO ORDL-SUB-ORDER-NO.
036350     MOVE 0 TO ORDL-SEQ-NO.
036360     MOVE "N" TO WS-DETAIL-CD.
036370     PERFORM START-ORDLF-GREATER.
036380     IF NOT C-AT-END OF ORDLF-STATUS
036390         PERFORM READ-ORDLF-NEXT.
036400
036410 RECALC-ORDLF-LOOP.
036420     IF C-AT-END OF ORDLF-STATUS
036430        GO TO RECALC-ALL-DONE.
036440
036450     IF CREDIT-MEMO
032910         COMPUTE ORDL-SHIP-QTY = ORDL-SHIP-QTY * -1
036460         COMPUTE ORDL-EXT-AMT = ORDL-EXT-AMT * -1
036470         COMPUTE ORDL-EXT-COST = ORDL-EXT-COST * -1.
036480     MOVE "Y" TO WS-DETAIL-CD.
036490     MOVE ORDL-ITEM-NO TO SPC-ITEM-NO.
036500     ADD ORDL-EXT-AMT  TO ORDH-NET-AMT.
036510     ADD ORDL-EXT-COST TO ORDH-COST-AMT.
036520     IF SPC-CHG
036530        ADD ORDL-EXT-AMT  TO ORDH-SPCHG-AMT.
036540
036550     IF FREIGHT
036560        ADD ORDL-EXT-AMT  TO ORDH-FREIGHT-AMT.

020210     PERFORM GET-RETAIL-PRICE.
020210     IF FREIGHT
020210         ADD ORDL-EXT-AMT TO WS-INV-AMT2
020210     ELSE IF SPC-CHG
020210         ADD ORDL-EXT-AMT TO WS-INV-AMT2
020210     ELSE IF NOT SPC-ITEM
020210         ADD WS-ITEM-PRICE TO WS-INV-AMT2.
  
036570     COMPUTE ORDH-DISC-AMT ROUNDED = ORDH-DISC-AMT +
036580       (ORDL-DISC-AMT * ORDL-SHIP-QTY).
036590     IF COMM-ON-GROSS
036600         COMPUTE COMM-AMT ROUNDED =
036610           ORDL-EXT-AMT * ORDL-COMM-PCT / 100.00000 ON SIZE ERROR 
036620           MOVE ZERO TO COMM-AMT END-COMPUTE
036630     ELSE COMPUTE COMM-AMT ROUNDED =
036640           (ORDL-EXT-AMT - ORDL-EXT-COST) * ORDL-COMM-PCT / 
036650           100.00000 ON SIZE ERROR MOVE ZERO TO COMM-AMT 
036660           END-COMPUTE.
036670     ADD COMM-AMT TO ORDH-COMM-AMT.
036680     IF NOT COMMENT
036690        PERFORM ADD-TAXES VARYING I FROM 1 BY 1 UNTIL I > 3.
036700     PERFORM READ-ORDLF-NEXT.
036710     GO TO RECALC-ORDLF-LOOP.
036720
036730 RECALC-ALL-DONE.
036740     MOVE ORDH-NET-AMT TO ORDH-GROSS-AMT.
036750     IF ORDH-PRINT-CD = 2
036760        MOVE ZERO TO ORDH-INV-AMT.
036770     IF ORDH-PRINT-CD = 1 
036780        COMPUTE ORDH-GROSS-AMT = ORDH-NET-AMT -
036790                                 ORDH-FREIGHT-AMT - ORDH-SPCHG-AMT
036800        IF CREDIT-MEMO
036810           COMPUTE ORDH-GROSS-AMT = ORDH-GROSS-AMT * -1.
036820     PERFORM COMPUTE-TAXES.
036830
036840     PERFORM REWRITE-ORDHF.
036850 RECALC-HEADERS-EXIT. EXIT.
036860
036870*SCREEN-ACCEPT SECTION.
036880*ACCEPT-DATA-4.
036890*    MOVE "1001000000" TO FKEYS.
036900*    PERFORM STEST-b0100xhp-cbl-3006
036910*    CALL "SCRN11" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP4,
036920*         YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
036930*         YES-NO-PDF, YES-NO, YES-NO, YES-NO, YES-NO,
036940*         YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
036950*         YES-NO
036960*    PERFORM STEST-AFTER-CALL.
036970*    
036980*ACCEPT-DATA-5.
036990*    MOVE ZERO TO FLAG.
037000*    MOVE "1010000000" TO FKEYS.
037010*    PERFORM STEST-b0100xhp-cbl-3015
037020*    CALL "SCRN03" USING FLAG, FKEYS, SPECS-5, HELP5,
037030*         ACCEPT-OPTS, YES-NO,
037040*         ACCEPT-OPTS, INV-DATE, YES-NO.
037050*    PERFORM STEST-AFTER-CALL.
037060*    
037070*SCREEN-ACCEPT-EXIT. EXIT.
037080
037090 IN-OUT SECTION.
037100 OPEN-ORDHF.
037110     OPEN I-O    ORDHF.
037120 OPEN-ORDLF.
042710*    OPEN INPUT  ORDLF.
042710     IF DIAZO
042710        OPEN I-O ORDLF
942719     ELSE
042710        OPEN INPUT ORDLF.
037140 OPEN-SALEF.
037150     OPEN INPUT SALEF.
037160 OPEN-CUSTF.
037170     OPEN INPUT CUSTF.
037180 OPEN-EXCNF.
037190     OPEN INPUT EXCNF.
037200     READ EXCNF.
037210     CLOSE EXCNF.
042809 OPEN-ITEMF.
042809     OPEN INPUT  ITEMF.
037240 OPEN-ORAUF.
037250     OPEN I-O ORAUF.
031510 OPEN-TAXMF.
031510     OPEN INPUT TAXMF.
042710 OPEN-CONTF.
042710     OPEN INPUT  CONTF.
037260 START-ORDHF.
037270     START ORDHF KEY NOT < ORDHF-KEY
037280         INVALID KEY MOVE AT-END TO ORDHF-STATUS.
037290 START-ORDHF-NAME.
037300     MOVE LOW-VALUES TO ORDH-CUST-NAME-KEY.
037310     START ORDHF KEY NOT < ORDH-CUST-NAME-KEY
037320            INVALID KEY MOVE AT-END TO ORDHF-STATUS.
037330 START-ORDLF-GREATER.
037340     START ORDLF KEY > ORDLF-KEY
037350            INVALID KEY MOVE AT-END TO ORDLF-STATUS.
037360*START-SERLF.
037370*    IF CREDIT-MEMO
037380*       MOVE ORDL-ORDER-NO  TO SERL-SOLD-RA-NO
037390*       START SERLF KEY NOT < SERL-SOLD-RA-NO-KEY
037400*           INVALID KEY MOVE AT-END TO SERLF-STATUS
037410*    ELSE
037420*       MOVE ORDLF-KEY     TO SERL-SO-NUMBER-KEY
037430*       START SERLF KEY NOT < SERL-SO-NUMBER-KEY
037440*           INVALID KEY MOVE AT-END TO SERLF-STATUS.
037450 READ-CNTLF.
037460     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
037470      CNTLF-STATUS OR IO-WAIT-OFF 
037480     READ CNTLF NO LOCK
037490        INVALID KEY MOVE CNTLF-STATUS TO CNTLF-STATUS
037500     END-READ END-PERFORM.
037510 READ-CNTLF-LOCK.
037520     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
037530      CNTLF-STATUS OR IO-WAIT-OFF 
037540     READ CNTLF 
037550        INVALID KEY MOVE CNTLF-STATUS TO CNTLF-STATUS
037560     END-READ END-PERFORM.
037570 READ-ORDHF.
037580     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
037590      ORDHF-STATUS OR IO-WAIT-OFF 
037600     READ ORDHF KEY IS ORDHF-KEY
037610         INVALID KEY MOVE AT-END TO ORDHF-STATUS
037620     END-READ END-PERFORM.
037630 READ-ORDHF-NEXT.
037640     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
037650      ORDHF-STATUS OR IO-WAIT-OFF 
037660     READ ORDHF NEXT
037670         AT END MOVE AT-END TO ORDHF-STATUS
037680     END-READ END-PERFORM.
037690     IF C-AT-END OF ORDHF-STATUS
037700         MOVE AT-END TO ORDHF-STATUS.
037710     IF RANGE-PRINTING
037720        IF ORDHF-KEY < LOW-ORDHF-KEY OR
037730           ORDHF-KEY > HIGH-ORDHF-KEY
037740              MOVE AT-END TO ORDHF-STATUS.
037750     DISPLAY SCR-b0100xhp-cbl-3074-20  .
037760     DISPLAY SCR-b0100xhp-cbl-3075-20         .
037770 READ-ORDLF-NEXT.
037780     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
037790      ORDLF-STATUS OR IO-WAIT-OFF 
037800     READ ORDLF NEXT
037810          AT END MOVE AT-END TO ORDLF-STATUS
037820     END-READ END-PERFORM.
037830
037840     IF NOT C-AT-END OF ORDLF-STATUS
037850         IF ORDL-ORDER-NO NOT = ORDH-ORDER-NO OR
037860            ORDL-SUB-ORDER-NO NOT = ORDH-SUB-ORDER-NO
037870             MOVE AT-END TO ORDLF-STATUS.
037880*    IF ORDL-SEQ-NO = 35
037890*       MOVE ORDL-ITEM-DESC TO CC-DESC
037900*       MOVE "xxxxxxxxxxxx" TO CC-NO-BLANK
037910*       MOVE CC-DESC  TO ORDL-ITEM-DESC.
037920*    IF ORDL-SEQ-NO = 34
037930*       MOVE ORDL-ITEM-DESC TO CC-CARD-LINE.
037940*    IF ORDL-SEQ-NO = 36
037950*       MOVE ORDL-ITEM-DESC TO CC-VCODE-LINE.
037960*    IF ORDL-SEQ-NO = 37
037970*       MOVE ORDL-ITEM-DESC TO CC-EXPIRE-LINE.
037980
037990 READ-SALEF.
038000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
038010      SALEF-STATUS OR IO-WAIT-OFF 
038020     READ SALEF KEY IS SALEF-KEY
038030         INVALID KEY MOVE SALEF-STATUS TO SALEF-STATUS
038040     END-READ END-PERFORM.
038050     IF SALEF-STATUS = NOT-FOUND
038060        MOVE SPACES TO SLSMN-NAME.
038070 READ-CUSTF.
038080     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
038090      CUSTF-STATUS OR IO-WAIT-OFF 
038100     READ CUSTF INVALID KEY
038110         MOVE 0 TO CUST-CREDIT-LIMIT
038120         MOVE NOT-FOUND TO CUSTF-STATUS
038130     END-READ END-PERFORM.
042809 READ-ITEMF.
042809     READ ITEMF INVALID KEY
042809         MOVE NOT-FOUND TO ITEMF-STATUS
042809         MOVE SPACES TO ITEMF-REC.
031610 READ-TAXMF.
031610     READ TAXMF INVALID KEY
031610         MOVE NOT-FOUND TO TAXMF-STATUS
031610         MOVE SPACES TO TAXMF-REC.
038180 READ-ORAUF.
038190     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
038200      ORAUF-STATUS OR IO-WAIT-OFF 
038210     READ ORAUF INVALID KEY
038220         MOVE NOT-FOUND TO ORAUF-STATUS
038230     END-READ END-PERFORM.
038240*READ-SERLF-NEXT.
038250*    READ SERLF NEXT
038260*        AT END MOVE AT-END TO SERLF-STATUS.
038270*    IF SERLF-STATUS NOT = AT-END
038280*        IF CREDIT-MEMO
038290*           IF SERL-SOLD-RA-NO NOT = ORDL-ORDER-NO
038300*              MOVE AT-END TO SERLF-STATUS
038310*           ELSE
038320*              IF SERL-SOLD-RA-CLOSED-JULIAN NOT = ZERO
038330*                 GO TO READ-SERLF-NEXT
038340*              ELSE
038350*                 NEXT SENTENCE
038360*        ELSE
038370*           IF SERL-SO-NUMBER NOT = ORDL-ORDER-NO
038380*               MOVE AT-END TO SERLF-STATUS
038390*           ELSE
038400*               IF SERL-INVOICE-NO NOT = ZEROES
038410*                  GO TO READ-SERLF-NEXT.
038420*    IF SERLF-STATUS = FOUND AND
038430*       SERL-SO-SUB-ORDER-NO NOT = ORDL-SUB-ORDER-NO
038440*            GO TO READ-SERLF-NEXT.
038450 READ-ASCII-NEXT.
038460     READ ASCII NEXT
038470          AT END MOVE ASCII-STATUS TO ASCII-STATUS.
038480
038490
042710 READ-CONTF.
042710     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL
042710      CONTF-STATUS OR IO-WAIT-OFF
042710     READ CONTF INVALID KEY
042710         MOVE NOT-FOUND TO CONTF-STATUS
042710     END-READ END-PERFORM.
038500 REWRITE-ORDHF.
038510     IF PROCESS-HISTORY
038520        NEXT SENTENCE
038530     ELSE
038540        REWRITE ORDHF-REC.
038550 REWRITE-ORAUF.
038560     REWRITE ORAUF-REC.
038570
042710 REWRITE-ORDLF.
042710     REWRITE ORDLF-REC.
038580 CLOSE-ORAUF.
038590     CLOSE ORAUF.
038600
038610 CLOSE-FILES.
038620     CLOSE ORDHF.
038630     CLOSE ORDLF.
042809     CLOSE ITEMF.
038640     PERFORM LFPRF-CLOSE.
038650     IF BULK-PRINT-YES
038660        CLOSE ASCII.
010810     IF PROFITS-APPAREL-YES
010810        CLOSE SCATF
010810     END-IF.
031610     IF ALLIED
031610        CLOSE TAXMF.
042710     IF DIAZO
042710        CLOSE CONTF.
038720 WRITE-INVFRM.
020210     IF DIAZO
020210        WRITE DIAZO101
020210     ELSE
038730     EVALUATE TRUE
038740     WHEN WS-FORM-ID-101
038750        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV101.
038760     WHEN WS-FORM-ID-102
038770        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV102.
038780     WHEN WS-FORM-ID-104
038790        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV104.
082410     WHEN WS-FORM-ID-105
082410        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV105.
038800     WHEN WS-FORM-ID-106
038810        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV106.
038800     WHEN WS-FORM-ID-107
038810        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV107.
031511     WHEN WS-FORM-ID-110
031511        COPY "B0100XHPCP.SR" REPLACING DEST-FORM BY INV110.
039270     END-EVALUATE.

039290 IN-OUT-EXIT. EXIT.
010810     COPY "APPARELD.SR".
039300 FILENAMES SECTION.
039310 FILL-PATHS.
039320     MOVE SPACES TO TEMP-SUB-DIR.
039330     STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
031511     MOVE TEMP-MASTER-DIR  TO PROFITS-PROGRAMS-LOC.
031511     MOVE TEMP-SUB-DIR     TO PROFITS-DATA-LOC.
039340     PERFORM CUSTF-FILL-FULLPATH.
039350     PERFORM ORDHF-FILL-FULLPATH.
039360     PERFORM ORDLF-FILL-FULLPATH.
039370     PERFORM CNTLF-FILL-FULLPATH.
039380     PERFORM EXCNF-FILL-FULLPATH.
039390     PERFORM SALEF-FILL-FULLPATH.
039400     PERFORM ORAUF-FILL-FULLPATH.
039410     PERFORM EMALF-FILL-FULLPATH.
042809     PERFORM ITEMF-FILL-FULLPATH.
031610     PERFORM TAXMF-FILL-FULLPATH.
042710     PERFORM CONTF-FILL-FULLPATH.
031511     PERFORM String-SCATF-Path.
031511     PERFORM String-STYLF-Path.
031511     PERFORM String-COLRF-Path.

039420 CUSTF-FILL-FULLPATH.
039430      MOVE SPACES TO TEMP-MASTER-DIR.
039440      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039450      TEMP-MASTER-DIR.
039460      MOVE SPACES TO CUSTF-FULLPATH.
039470      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CUSTF--NAME 
039480      DELIMITED BY SPACES INTO CUSTF-FULLPATH.
039490 ORDHF-FILL-FULLPATH.
039500      MOVE SPACES TO TEMP-MASTER-DIR.
039510      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039520      TEMP-MASTER-DIR.
039530      MOVE SPACES TO ORDHF-FULLPATH.
039540      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORDHF--NAME 
039550      DELIMITED BY SPACES INTO ORDHF-FULLPATH.
039560 ORDLF-FILL-FULLPATH.
039570      MOVE SPACES TO TEMP-MASTER-DIR.
039580      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039590      TEMP-MASTER-DIR.
039600      MOVE SPACES TO ORDLF-FULLPATH.
039610      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORDLF--NAME 
039620      DELIMITED BY SPACES INTO ORDLF-FULLPATH.
039630 CNTLF-FILL-FULLPATH.
039640      MOVE SPACES TO TEMP-MASTER-DIR.
039650      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039660      TEMP-MASTER-DIR.
039670      MOVE SPACES TO CNTLF-FULLPATH.
039680      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
039690      DELIMITED BY SPACES INTO CNTLF-FULLPATH.
039700 EXCNF-FILL-FULLPATH.
039710      MOVE SPACES TO TEMP-MASTER-DIR.
039720      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039730      TEMP-MASTER-DIR.
039740      MOVE SPACES TO EXCNF-FULLPATH.
039750      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EXCNF--NAME 
039760      DELIMITED BY SPACES INTO EXCNF-FULLPATH.
039770 USERF-FILL-FULLPATH.
039780      MOVE SPACES TO TEMP-MASTER-DIR.
039790      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039800      TEMP-MASTER-DIR.
039810      MOVE SPACES TO USERF-FULLPATH.
039820      STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
039830      INTO USERF-FULLPATH.
039840 SALEF-FILL-FULLPATH.
039850      MOVE SPACES TO TEMP-MASTER-DIR.
039860      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039870      TEMP-MASTER-DIR.
039880      MOVE SPACES TO SALEF-FULLPATH.
039890      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" SALEF--NAME 
039900      DELIMITED BY SPACES INTO SALEF-FULLPATH.
039910 ORAUF-FILL-FULLPATH.
039920      MOVE SPACES TO TEMP-MASTER-DIR.
039930      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
039940      TEMP-MASTER-DIR.
039950      MOVE SPACES TO ORAUF-FULLPATH.
039960      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORAUF--NAME 
039970      DELIMITED BY SPACES INTO ORAUF-FULLPATH.
039980 EMALF-FILL-FULLPATH.
039990      MOVE "EMAIL.FIL"  TO EMALF--NAME.
040000      MOVE SPACES TO TEMP-MASTER-DIR.
040010      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
040020      TEMP-MASTER-DIR.
040030      MOVE SPACES TO EMALF-FULLPATH.
040040      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EMALF--NAME 
040050      DELIMITED BY SPACES INTO EMALF-FULLPATH.
042809 ITEMF-FILL-FULLPATH.
042809      MOVE SPACES TO TEMP-MASTER-DIR.
042809      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
042809      TEMP-MASTER-DIR.
042809      MOVE SPACES TO ITEMF-FULLPATH.
042809      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ITEMF--NAME 
042809      DELIMITED BY SPACES INTO ITEMF-FULLPATH.
031610 TAXMF-FILL-FULLPATH.
031610      MOVE "TAX.FIL" TO TAXMF--NAME.
031610      MOVE SPACES TO TEMP-MASTER-DIR.
031610      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
031610      TEMP-MASTER-DIR.
031610      MOVE SPACES TO TAXMF-FULLPATH.
031610      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" TAXMF--NAME 
031610      DELIMITED BY SPACES INTO TAXMF-FULLPATH.
042710 CONTF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO
            TEMP-MASTER-DIR.
            MOVE SPACES TO CONTF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CONTF--NAME
            DELIMITED BY SPACES INTO CONTF-FULLPATH.

031511     COPY "SCATF.SR".
031511     COPY "STYLF.SR".
031511     COPY "COLRF.SR".

040060 CHAINCALLS SECTION.
040070 CHN--PARM-BLOCK.
040080      COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
040090      .
040100
040110 CHN--PARM-BLK.
040120      COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.
040130
040140 CHNR--WS-PASSED.
040150      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==WS-PASSED==
040160      .
040170
040180 CHNR-DOS-CALL-PARAM-BLOCK-DOS.
040190      COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==DOS-CALL== 
040200      ==RETURN-CD== BY ==DOS-RET-CODE==.
040210
040220 CHNR--PASS-REC-DOS-RET-CODE.
040230      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==PASS-REC== 
040240      ==RETURN-CD== BY ==DOS-RET-CODE==.
040250
040260 CHNR--PARM-BLOCK-DOS-RET-CODE.
040270      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY 
040280      ==PARM-BLOCK== ==RETURN-CD== BY ==DOS-RET-CODE==.
040290
040300 CHNR-NEXT-PROG2-WS-FAX-SHARED.
040310      COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==NEXT-PROG2== 
040320      ==PARAM-BLOCK== BY ==WS-FAX-SHARED==.
040330
040340 GETCP-B0750-PASS-DATA.
040350      COPY "GETCP.CBL" REPLACING ==PARAM-BLOCK== BY 
040360      ==B0750-PASS-DATA==.
040370
040380 SCRN-TEST SECTION.
040390      COPY "STEST.SR".
040400*STEST-errorfil-sr-46.
040410*     MOVE "b0100xhp.cbl  errorfil.sr   46" TO STEST-KEY.
040420*     MOVE ERROR-FIELD TO STEST-SCRN-SPECS.
040430*     MOVE FUNCTION ADDR(ERROR-FIELD) TO STEST-PTR.
040440*     PERFORM STEST-BEGIN.
040450*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040460*     = FUNCTION LENG (FLAG).
040470*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
040480*     STEST-PARAMS (STEST-PARAM-NUM).
040490*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
040500*     STEST-PARAMS (STEST-PARAM-NUM).
040510*     PERFORM STEST-PARAM-CHECK.
040520*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040530*     = FUNCTION LENG (FKEYS).
040540*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
040550*     STEST-PARAMS (STEST-PARAM-NUM).
040560*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
040570*     STEST-PARAMS (STEST-PARAM-NUM).
040580*     PERFORM STEST-PARAM-CHECK.
040590*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040600*     = FUNCTION LENG (ERROR-FIELD).
040610*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
040620*     STEST-PARAMS (STEST-PARAM-NUM).
040630*     MOVE "ERROR-FIELD" TO STEST-PARAM-NAME OF 
040640*     STEST-PARAMS (STEST-PARAM-NUM).
040650*     PERFORM STEST-PARAM-CHECK.
040660*     PERFORM STEST-SKIP.
040670*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040680*     = FUNCTION LENG (ERROR-ANSWER).
040690*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
040700*     STEST-PARAMS (STEST-PARAM-NUM).
040710*     MOVE "ERROR-ANSWER" TO STEST-PARAM-NAME OF 
040720*     STEST-PARAMS (STEST-PARAM-NUM).
040730*     PERFORM STEST-PARAM-CHECK.
040740*     PERFORM STEST-FINAL.
040750*STEST-print-sr-148.
040760*     MOVE "b0100xhp.cbl     print.sr  148" TO STEST-KEY.
040770*     MOVE PAUSE-SPECS TO STEST-SCRN-SPECS.
040780*     MOVE FUNCTION ADDR(PAUSE-SPECS) TO STEST-PTR.
040790*     PERFORM STEST-BEGIN.
040800*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040810*     = FUNCTION LENG (FLAG).
040820*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
040830*     STEST-PARAMS (STEST-PARAM-NUM).
040840*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
040850*     STEST-PARAMS (STEST-PARAM-NUM).
040860*     PERFORM STEST-PARAM-CHECK.
040870*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040880*     = FUNCTION LENG (FKEYS).
040890*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
040900*     STEST-PARAMS (STEST-PARAM-NUM).
040910*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
040920*     STEST-PARAMS (STEST-PARAM-NUM).
040930*     PERFORM STEST-PARAM-CHECK.
040940*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
040950*     = FUNCTION LENG (PAUSE-SPECS).
040960*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
040970*     STEST-PARAMS (STEST-PARAM-NUM).
040980*     MOVE "PAUSE-SPECS" TO STEST-PARAM-NAME OF 
040990*     STEST-PARAMS (STEST-PARAM-NUM).
041000*     PERFORM STEST-PARAM-CHECK.
041010*     PERFORM STEST-SKIP.
041020*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041030*     = FUNCTION LENG (ABORT-CONTINUE).
041040*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
041050*     STEST-PARAMS (STEST-PARAM-NUM).
041060*     MOVE "ABORT-CONTINUE" TO STEST-PARAM-NAME OF 
041070*     STEST-PARAMS (STEST-PARAM-NUM).
041080*     PERFORM STEST-PARAM-CHECK.
041090*     PERFORM STEST-FINAL.
041100 STEST-authno-sr-82.
041110      MOVE "b0100xhp.cbl    authno.sr   82" TO STEST-KEY.
041120      MOVE CR-SPECS TO STEST-SCRN-SPECS.
041130      MOVE FUNCTION ADDR(CR-SPECS) TO STEST-PTR.
041140      PERFORM STEST-BEGIN.
041150      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041160      = FUNCTION LENG (FLAG).
041170      MOVE 4 TO STEST-PARAM-W-SIZE OF 
041180      STEST-PARAMS (STEST-PARAM-NUM).
041190      MOVE "FLAG" TO STEST-PARAM-NAME OF 
041200      STEST-PARAMS (STEST-PARAM-NUM).
041210      PERFORM STEST-PARAM-CHECK.
041220      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041230      = FUNCTION LENG (FKEYS).
041240      MOVE 10 TO STEST-PARAM-W-SIZE OF 
041250      STEST-PARAMS (STEST-PARAM-NUM).
041260      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
041270      STEST-PARAMS (STEST-PARAM-NUM).
041280      PERFORM STEST-PARAM-CHECK.
041290      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041300      = FUNCTION LENG (CR-SPECS).
041310      MOVE 14 TO STEST-PARAM-W-SIZE OF 
041320      STEST-PARAMS (STEST-PARAM-NUM).
041330      MOVE "CR-SPECS" TO STEST-PARAM-NAME OF 
041340      STEST-PARAMS (STEST-PARAM-NUM).
041350      PERFORM STEST-PARAM-CHECK.
041360      PERFORM STEST-SKIP.
041370      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041380      = FUNCTION LENG (CR-OPTS).
041390      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
041400      STEST-PARAMS (STEST-PARAM-NUM).
041410      MOVE "CR-OPTS" TO STEST-PARAM-NAME OF 
041420      STEST-PARAMS (STEST-PARAM-NUM).
041430      PERFORM STEST-PARAM-CHECK.
041440      PERFORM STEST-FINAL.
041450 STEST-authno-sr-96.
041460      MOVE "b0100xhp.cbl    authno.sr   96" TO STEST-KEY.
041470      MOVE AUTH-SPECS TO STEST-SCRN-SPECS.
041480      MOVE FUNCTION ADDR(AUTH-SPECS) TO STEST-PTR.
041490      PERFORM STEST-BEGIN.
041500      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041510      = FUNCTION LENG (FLAG).
041520      MOVE 4 TO STEST-PARAM-W-SIZE OF 
041530      STEST-PARAMS (STEST-PARAM-NUM).
041540      MOVE "FLAG" TO STEST-PARAM-NAME OF 
041550      STEST-PARAMS (STEST-PARAM-NUM).
041560      PERFORM STEST-PARAM-CHECK.
041570      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041580      = FUNCTION LENG (FKEYS).
041590      MOVE 10 TO STEST-PARAM-W-SIZE OF 
041600      STEST-PARAMS (STEST-PARAM-NUM).
041610      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
041620      STEST-PARAMS (STEST-PARAM-NUM).
041630      PERFORM STEST-PARAM-CHECK.
041640      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041650      = FUNCTION LENG (AUTH-SPECS).
041660      MOVE 14 TO STEST-PARAM-W-SIZE OF 
041670      STEST-PARAMS (STEST-PARAM-NUM).
041680      MOVE "AUTH-SPECS" TO STEST-PARAM-NAME OF 
041690      STEST-PARAMS (STEST-PARAM-NUM).
041700      PERFORM STEST-PARAM-CHECK.
041710      PERFORM STEST-SKIP.
041720      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041730      = FUNCTION LENG (ORAU-AUTH-NO).
041740      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
041750      STEST-PARAMS (STEST-PARAM-NUM).
041760      MOVE "ORAU-AUTH-NO" TO STEST-PARAM-NAME OF 
041770      STEST-PARAMS (STEST-PARAM-NUM).
041780      PERFORM STEST-PARAM-CHECK.
041790      PERFORM STEST-FINAL.
041800 STEST-b0100xhp-cbl-990.
041810      MOVE "b0100xhp.cbl               990" TO STEST-KEY.
041820      MOVE BATCH-SPECS TO STEST-SCRN-SPECS.
041830      MOVE FUNCTION ADDR(BATCH-SPECS) TO STEST-PTR.
041840      PERFORM STEST-BEGIN.
041850      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041860      = FUNCTION LENG (FLAG).
041870      MOVE 4 TO STEST-PARAM-W-SIZE OF 
041880      STEST-PARAMS (STEST-PARAM-NUM).
041890      MOVE "FLAG" TO STEST-PARAM-NAME OF 
041900      STEST-PARAMS (STEST-PARAM-NUM).
041910      PERFORM STEST-PARAM-CHECK.
041920      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
041930      = FUNCTION LENG (FKEYS).
041940      MOVE 10 TO STEST-PARAM-W-SIZE OF 
041950      STEST-PARAMS (STEST-PARAM-NUM).
041960      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
041970      STEST-PARAMS (STEST-PARAM-NUM).
041980      PERFORM STEST-PARAM-CHECK.
041990      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042000      = FUNCTION LENG (BATCH-SPECS).
042010      MOVE 14 TO STEST-PARAM-W-SIZE OF 
042020      STEST-PARAMS (STEST-PARAM-NUM).
042030      MOVE "BATCH-SPECS" TO STEST-PARAM-NAME OF 
042040      STEST-PARAMS (STEST-PARAM-NUM).
042050      PERFORM STEST-PARAM-CHECK.
042060      PERFORM STEST-SKIP.
042070      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042080      = FUNCTION LENG (USER-BATCH-NO).
042090      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
042100      STEST-PARAMS (STEST-PARAM-NUM).
042110      MOVE "USER-BATCH-NO" TO STEST-PARAM-NAME OF 
042120      STEST-PARAMS (STEST-PARAM-NUM).
042130      PERFORM STEST-PARAM-CHECK.
042140      PERFORM STEST-FINAL.
042150 STEST-b0100xhp-cbl-2710.
042160      MOVE "b0100xhp.cbl              2710" TO STEST-KEY.
042170      MOVE TYPE-SPEC TO STEST-SCRN-SPECS.
042180      MOVE FUNCTION ADDR(TYPE-SPEC) TO STEST-PTR.
042190      PERFORM STEST-BEGIN.
042200      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042210      = FUNCTION LENG (FLAG).
042220      MOVE 4 TO STEST-PARAM-W-SIZE OF 
042230      STEST-PARAMS (STEST-PARAM-NUM).
042240      MOVE "FLAG" TO STEST-PARAM-NAME OF 
042250      STEST-PARAMS (STEST-PARAM-NUM).
042260      PERFORM STEST-PARAM-CHECK.
042270      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042280      = FUNCTION LENG (FKEYS).
042290      MOVE 10 TO STEST-PARAM-W-SIZE OF 
042300      STEST-PARAMS (STEST-PARAM-NUM).
042310      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
042320      STEST-PARAMS (STEST-PARAM-NUM).
042330      PERFORM STEST-PARAM-CHECK.
042340      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042350      = FUNCTION LENG (TYPE-SPEC).
042360      MOVE 14 TO STEST-PARAM-W-SIZE OF 
042370      STEST-PARAMS (STEST-PARAM-NUM).
042380      MOVE "TYPE-SPEC" TO STEST-PARAM-NAME OF 
042390      STEST-PARAMS (STEST-PARAM-NUM).
042400      PERFORM STEST-PARAM-CHECK.
042410      PERFORM STEST-SKIP.
042420      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042430      = FUNCTION LENG (PMT-CODES).
042440      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
042450      STEST-PARAMS (STEST-PARAM-NUM).
042460      MOVE "PMT-CODES" TO STEST-PARAM-NAME OF 
042470      STEST-PARAMS (STEST-PARAM-NUM).
042480      PERFORM STEST-PARAM-CHECK.
042490      PERFORM STEST-FINAL.
042500 STEST-b0100xhp-cbl-2726.
042510      MOVE "b0100xhp.cbl              2726" TO STEST-KEY.
042520      MOVE PMT-SPEC TO STEST-SCRN-SPECS.
042530      MOVE FUNCTION ADDR(PMT-SPEC) TO STEST-PTR.
042540      PERFORM STEST-BEGIN.
042550      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042560      = FUNCTION LENG (FLAG).
042570      MOVE 4 TO STEST-PARAM-W-SIZE OF 
042580      STEST-PARAMS (STEST-PARAM-NUM).
042590      MOVE "FLAG" TO STEST-PARAM-NAME OF 
042600      STEST-PARAMS (STEST-PARAM-NUM).
042610      PERFORM STEST-PARAM-CHECK.
042620      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042630      = FUNCTION LENG (FKEYS).
042640      MOVE 10 TO STEST-PARAM-W-SIZE OF 
042650      STEST-PARAMS (STEST-PARAM-NUM).
042660      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
042670      STEST-PARAMS (STEST-PARAM-NUM).
042680      PERFORM STEST-PARAM-CHECK.
042690      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042700      = FUNCTION LENG (PMT-SPEC).
042710      MOVE 14 TO STEST-PARAM-W-SIZE OF 
042720      STEST-PARAMS (STEST-PARAM-NUM).
042730      MOVE "PMT-SPEC" TO STEST-PARAM-NAME OF 
042740      STEST-PARAMS (STEST-PARAM-NUM).
042750      PERFORM STEST-PARAM-CHECK.
042760      PERFORM STEST-SKIP.
042770      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042780      = FUNCTION LENG (PMT-AMT).
042790      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
042800      STEST-PARAMS (STEST-PARAM-NUM).
042810      MOVE "PMT-AMT" TO STEST-PARAM-NAME OF 
042820      STEST-PARAMS (STEST-PARAM-NUM).
042830      PERFORM STEST-PARAM-CHECK.
042840      PERFORM STEST-FINAL.
042850 STEST-b0100xhp-cbl-2742.
042860      MOVE "b0100xhp.cbl              2742" TO STEST-KEY.
042870      MOVE INPUT-SPECS-1 TO STEST-SCRN-SPECS.
042880      MOVE FUNCTION ADDR(INPUT-SPECS-1) TO STEST-PTR.
042890      PERFORM STEST-BEGIN.
042900      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042910      = FUNCTION LENG (FLAG).
042920      MOVE 4 TO STEST-PARAM-W-SIZE OF 
042930      STEST-PARAMS (STEST-PARAM-NUM).
042940      MOVE "FLAG" TO STEST-PARAM-NAME OF 
042950      STEST-PARAMS (STEST-PARAM-NUM).
042960      PERFORM STEST-PARAM-CHECK.
042970      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
042980      = FUNCTION LENG (FKEYS).
042990      MOVE 10 TO STEST-PARAM-W-SIZE OF 
043000      STEST-PARAMS (STEST-PARAM-NUM).
043010      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
043020      STEST-PARAMS (STEST-PARAM-NUM).
043030      PERFORM STEST-PARAM-CHECK.
043040      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043050      = FUNCTION LENG (INPUT-SPECS-1).
043060      MOVE 14 TO STEST-PARAM-W-SIZE OF 
043070      STEST-PARAMS (STEST-PARAM-NUM).
043080      MOVE "INPUT-SPECS-1" TO STEST-PARAM-NAME OF 
043090      STEST-PARAMS (STEST-PARAM-NUM).
043100      PERFORM STEST-PARAM-CHECK.
043110      PERFORM STEST-SKIP.
043120      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043130      = FUNCTION LENG (INVIS-OPTION).
043140      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
043150      STEST-PARAMS (STEST-PARAM-NUM).
043160      MOVE "INVIS-OPTION" TO STEST-PARAM-NAME OF 
043170      STEST-PARAMS (STEST-PARAM-NUM).
043180      PERFORM STEST-PARAM-CHECK.
043190      PERFORM STEST-FINAL.
043200 STEST-b0100xhp-cbl-2767.
043210      MOVE "b0100xhp.cbl              2767" TO STEST-KEY.
043220      MOVE DATE-SPECS TO STEST-SCRN-SPECS.
043230      MOVE FUNCTION ADDR(DATE-SPECS) TO STEST-PTR.
043240      PERFORM STEST-BEGIN.
043250      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043260      = FUNCTION LENG (FLAG).
043270      MOVE 4 TO STEST-PARAM-W-SIZE OF 
043280      STEST-PARAMS (STEST-PARAM-NUM).
043290      MOVE "FLAG" TO STEST-PARAM-NAME OF 
043300      STEST-PARAMS (STEST-PARAM-NUM).
043310      PERFORM STEST-PARAM-CHECK.
043320      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043330      = FUNCTION LENG (FKEYS).
043340      MOVE 10 TO STEST-PARAM-W-SIZE OF 
043350      STEST-PARAMS (STEST-PARAM-NUM).
043360      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
043370      STEST-PARAMS (STEST-PARAM-NUM).
043380      PERFORM STEST-PARAM-CHECK.
043390      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043400      = FUNCTION LENG (DATE-SPECS).
043410      MOVE 56 TO STEST-PARAM-W-SIZE OF 
043420      STEST-PARAMS (STEST-PARAM-NUM).
043430      MOVE "DATE-SPECS" TO STEST-PARAM-NAME OF 
043440      STEST-PARAMS (STEST-PARAM-NUM).
043450      PERFORM STEST-PARAM-CHECK.
043460      PERFORM STEST-SKIP.
043470      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043480      = FUNCTION LENG (INV-DATE).
043490      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
043500      STEST-PARAMS (STEST-PARAM-NUM).
043510      MOVE "INV-DATE" TO STEST-PARAM-NAME OF 
043520      STEST-PARAMS (STEST-PARAM-NUM).
043530      PERFORM STEST-PARAM-CHECK.
043540      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043550      = FUNCTION LENG (CNTL3-SHORT-MSG-1).
043560      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
043570      STEST-PARAMS (STEST-PARAM-NUM).
043580      MOVE "CNTL3-SHORT-MSG-1" TO STEST-PARAM-NAME OF 
043590      STEST-PARAMS (STEST-PARAM-NUM).
043600      PERFORM STEST-PARAM-CHECK.
043610      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043620      = FUNCTION LENG (CNTL3-SHORT-MSG-2).
043630      MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
043640      STEST-PARAMS (STEST-PARAM-NUM).
043650      MOVE "CNTL3-SHORT-MSG-2" TO STEST-PARAM-NAME OF 
043660      STEST-PARAMS (STEST-PARAM-NUM).
043670      PERFORM STEST-PARAM-CHECK.
043680      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043690      = FUNCTION LENG (CNTL3-SHORT-MSG-3).
043700      MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
043710      STEST-PARAMS (STEST-PARAM-NUM).
043720      MOVE "CNTL3-SHORT-MSG-3" TO STEST-PARAM-NAME OF 
043730      STEST-PARAMS (STEST-PARAM-NUM).
043740      PERFORM STEST-PARAM-CHECK.
043750      PERFORM STEST-FINAL.
043760 STEST-b0100xhp-cbl-2823.
043770      MOVE "b0100xhp.cbl              2823" TO STEST-KEY.
043780      MOVE RANGE-SPECS-1 TO STEST-SCRN-SPECS.
043790      MOVE FUNCTION ADDR(RANGE-SPECS-1) TO STEST-PTR.
043800      PERFORM STEST-BEGIN.
043810      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043820      = FUNCTION LENG (FLAG).
043830      MOVE 4 TO STEST-PARAM-W-SIZE OF 
043840      STEST-PARAMS (STEST-PARAM-NUM).
043850      MOVE "FLAG" TO STEST-PARAM-NAME OF 
043860      STEST-PARAMS (STEST-PARAM-NUM).
043870      PERFORM STEST-PARAM-CHECK.
043880      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043890      = FUNCTION LENG (FKEYS).
043900      MOVE 10 TO STEST-PARAM-W-SIZE OF 
043910      STEST-PARAMS (STEST-PARAM-NUM).
043920      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
043930      STEST-PARAMS (STEST-PARAM-NUM).
043940      PERFORM STEST-PARAM-CHECK.
043950      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
043960      = FUNCTION LENG (RANGE-SPECS-1).
043970      MOVE 42 TO STEST-PARAM-W-SIZE OF 
043980      STEST-PARAMS (STEST-PARAM-NUM).
043990      MOVE "RANGE-SPECS-1" TO STEST-PARAM-NAME OF 
044000      STEST-PARAMS (STEST-PARAM-NUM).
044010      PERFORM STEST-PARAM-CHECK.
044020      PERFORM STEST-SKIP.
044030      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044040      = FUNCTION LENG (RANGE-CODES).
044050      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
044060      STEST-PARAMS (STEST-PARAM-NUM).
044070      MOVE "RANGE-CODES" TO STEST-PARAM-NAME OF 
044080      STEST-PARAMS (STEST-PARAM-NUM).
044090      PERFORM STEST-PARAM-CHECK.
044100      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044110      = FUNCTION LENG (FORM-CODES).
044120      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
044130      STEST-PARAMS (STEST-PARAM-NUM).
044140      MOVE "FORM-CODES" TO STEST-PARAM-NAME OF 
044150      STEST-PARAMS (STEST-PARAM-NUM).
044160      PERFORM STEST-PARAM-CHECK.
044170      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044180      = FUNCTION LENG (ORDER-CODES).
044190      MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
044200      STEST-PARAMS (STEST-PARAM-NUM).
044210      MOVE "ORDER-CODES" TO STEST-PARAM-NAME OF 
044220      STEST-PARAMS (STEST-PARAM-NUM).
044230      PERFORM STEST-PARAM-CHECK.
044240      PERFORM STEST-FINAL.
044250 STEST-b0100xhp-cbl-2857.
044260      MOVE "b0100xhp.cbl              2857" TO STEST-KEY.
044270      MOVE RANGE-SPECS-2 TO STEST-SCRN-SPECS.
044280      MOVE FUNCTION ADDR(RANGE-SPECS-2) TO STEST-PTR.
044290      PERFORM STEST-BEGIN.
044300      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044310      = FUNCTION LENG (FLAG).
044320      MOVE 4 TO STEST-PARAM-W-SIZE OF 
044330      STEST-PARAMS (STEST-PARAM-NUM).
044340      MOVE "FLAG" TO STEST-PARAM-NAME OF 
044350      STEST-PARAMS (STEST-PARAM-NUM).
044360      PERFORM STEST-PARAM-CHECK.
044370      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044380      = FUNCTION LENG (FKEYS).
044390      MOVE 10 TO STEST-PARAM-W-SIZE OF 
044400      STEST-PARAMS (STEST-PARAM-NUM).
044410      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
044420      STEST-PARAMS (STEST-PARAM-NUM).
044430      PERFORM STEST-PARAM-CHECK.
044440      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044450      = FUNCTION LENG (RANGE-SPECS-2).
044460      MOVE 28 TO STEST-PARAM-W-SIZE OF 
044470      STEST-PARAMS (STEST-PARAM-NUM).
044480      MOVE "RANGE-SPECS-2" TO STEST-PARAM-NAME OF 
044490      STEST-PARAMS (STEST-PARAM-NUM).
044500      PERFORM STEST-PARAM-CHECK.
044510      PERFORM STEST-SKIP.
044520      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044530      = FUNCTION LENG (LOW-ORDER).
044540      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
044550      STEST-PARAMS (STEST-PARAM-NUM).
044560      MOVE "LOW-ORDER" TO STEST-PARAM-NAME OF 
044570      STEST-PARAMS (STEST-PARAM-NUM).
044580      PERFORM STEST-PARAM-CHECK.
044590      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044600      = FUNCTION LENG (HIGH-ORDER).
044610      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
044620      STEST-PARAMS (STEST-PARAM-NUM).
044630      MOVE "HIGH-ORDER" TO STEST-PARAM-NAME OF 
044640      STEST-PARAMS (STEST-PARAM-NUM).
044650      PERFORM STEST-PARAM-CHECK.
044660      PERFORM STEST-FINAL.
044670 STEST-b0100xhp-cbl-2893.
044680      MOVE "b0100xhp.cbl              2893" TO STEST-KEY.
044690      MOVE RANGE-SPECS-3 TO STEST-SCRN-SPECS.
044700      MOVE FUNCTION ADDR(RANGE-SPECS-3) TO STEST-PTR.
044710      PERFORM STEST-BEGIN.
044720      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044730      = FUNCTION LENG (FLAG).
044740      MOVE 4 TO STEST-PARAM-W-SIZE OF 
044750      STEST-PARAMS (STEST-PARAM-NUM).
044760      MOVE "FLAG" TO STEST-PARAM-NAME OF 
044770      STEST-PARAMS (STEST-PARAM-NUM).
044780      PERFORM STEST-PARAM-CHECK.
044790      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044800      = FUNCTION LENG (FKEYS).
044810      MOVE 10 TO STEST-PARAM-W-SIZE OF 
044820      STEST-PARAMS (STEST-PARAM-NUM).
044830      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
044840      STEST-PARAMS (STEST-PARAM-NUM).
044850      PERFORM STEST-PARAM-CHECK.
044860      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044870      = FUNCTION LENG (RANGE-SPECS-3).
044880      MOVE 28 TO STEST-PARAM-W-SIZE OF 
044890      STEST-PARAMS (STEST-PARAM-NUM).
044900      MOVE "RANGE-SPECS-3" TO STEST-PARAM-NAME OF 
044910      STEST-PARAMS (STEST-PARAM-NUM).
044920      PERFORM STEST-PARAM-CHECK.
044930      PERFORM STEST-SKIP.
044940      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
044950      = FUNCTION LENG (ORDH-ORDER-NO).
044960      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
044970      STEST-PARAMS (STEST-PARAM-NUM).
044980      MOVE "ORDH-ORDER-NO" TO STEST-PARAM-NAME OF 
044990      STEST-PARAMS (STEST-PARAM-NUM).
045000      PERFORM STEST-PARAM-CHECK.
045010      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045020      = FUNCTION LENG (ORDH-SUB-ORDER-NO).
045030      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
045040      STEST-PARAMS (STEST-PARAM-NUM).
045050      MOVE "ORDH-SUB-ORDER-NO" TO STEST-PARAM-NAME OF 
045060      STEST-PARAMS (STEST-PARAM-NUM).
045070      PERFORM STEST-PARAM-CHECK.
045080      PERFORM STEST-FINAL.
045090*STEST-b0100xhp-cbl-3006.
045100*     MOVE "b0100xhp.cbl              3006" TO STEST-KEY.
045110*     MOVE SPECS-4 TO STEST-SCRN-SPECS.
045120*     MOVE FUNCTION ADDR(SPECS-4) TO STEST-PTR.
045130*     PERFORM STEST-BEGIN.
045140*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045150*     = FUNCTION LENG (FLAG).
045160*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
045170*     STEST-PARAMS (STEST-PARAM-NUM).
045180*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
045190*     STEST-PARAMS (STEST-PARAM-NUM).
045200*     PERFORM STEST-PARAM-CHECK.
045210*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045220*     = FUNCTION LENG (FKEYS).
045230*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
045240*     STEST-PARAMS (STEST-PARAM-NUM).
045250*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
045260*     STEST-PARAMS (STEST-PARAM-NUM).
045270*     PERFORM STEST-PARAM-CHECK.
045280*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045290*     = FUNCTION LENG (SPECS-4).
045300*     MOVE 154 TO STEST-PARAM-W-SIZE OF 
045310*     STEST-PARAMS (STEST-PARAM-NUM).
045320*     MOVE "SPECS-4" TO STEST-PARAM-NAME OF 
045330*     STEST-PARAMS (STEST-PARAM-NUM).
045340*     PERFORM STEST-PARAM-CHECK.
045350*     PERFORM STEST-SKIP.
045360*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045370*     = FUNCTION LENG (YES-NO-PDF).
045380*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
045390*     STEST-PARAMS (STEST-PARAM-NUM).
045400*     MOVE "YES-NO-PDF" TO STEST-PARAM-NAME OF 
045410*     STEST-PARAMS (STEST-PARAM-NUM).
045420*     PERFORM STEST-PARAM-CHECK.
045430*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045440*     = FUNCTION LENG (YES-NO).
045450*     MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
045460*     STEST-PARAMS (STEST-PARAM-NUM).
045470*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045480*     STEST-PARAMS (STEST-PARAM-NUM).
045490*     PERFORM STEST-PARAM-CHECK.
045500*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045510*     = FUNCTION LENG (YES-NO).
045520*     MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
045530*     STEST-PARAMS (STEST-PARAM-NUM).
045540*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045550*     STEST-PARAMS (STEST-PARAM-NUM).
045560*     PERFORM STEST-PARAM-CHECK.
045570*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045580*     = FUNCTION LENG (YES-NO).
045590*     MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
045600*     STEST-PARAMS (STEST-PARAM-NUM).
045610*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045620*     STEST-PARAMS (STEST-PARAM-NUM).
045630*     PERFORM STEST-PARAM-CHECK.
045640*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045650*     = FUNCTION LENG (YES-NO).
045660*     MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
045670*     STEST-PARAMS (STEST-PARAM-NUM).
045680*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045690*     STEST-PARAMS (STEST-PARAM-NUM).
045700*     PERFORM STEST-PARAM-CHECK.
045710*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045720*     = FUNCTION LENG (YES-NO).
045730*     MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
045740*     STEST-PARAMS (STEST-PARAM-NUM).
045750*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045760*     STEST-PARAMS (STEST-PARAM-NUM).
045770*     PERFORM STEST-PARAM-CHECK.
045780*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045790*     = FUNCTION LENG (YES-NO).
045800*     MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
045810*     STEST-PARAMS (STEST-PARAM-NUM).
045820*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045830*     STEST-PARAMS (STEST-PARAM-NUM).
045840*     PERFORM STEST-PARAM-CHECK.
045850*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045860*     = FUNCTION LENG (YES-NO).
045870*     MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
045880*     STEST-PARAMS (STEST-PARAM-NUM).
045890*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045900*     STEST-PARAMS (STEST-PARAM-NUM).
045910*     PERFORM STEST-PARAM-CHECK.
045920*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
045930*     = FUNCTION LENG (YES-NO).
045940*     MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
045950*     STEST-PARAMS (STEST-PARAM-NUM).
045960*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
045970*     STEST-PARAMS (STEST-PARAM-NUM).
045980*     PERFORM STEST-PARAM-CHECK.
045990*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046000*     = FUNCTION LENG (YES-NO).
046010*     MOVE FLEN OF STEST-SPECS (10) TO STEST-PARAM-W-SIZE OF 
046020*     STEST-PARAMS (STEST-PARAM-NUM).
046030*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
046040*     STEST-PARAMS (STEST-PARAM-NUM).
046050*     PERFORM STEST-PARAM-CHECK.
046060*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046070*     = FUNCTION LENG (YES-NO).
046080*     MOVE FLEN OF STEST-SPECS (11) TO STEST-PARAM-W-SIZE OF 
046090*     STEST-PARAMS (STEST-PARAM-NUM).
046100*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
046110*     STEST-PARAMS (STEST-PARAM-NUM).
046120*     PERFORM STEST-PARAM-CHECK.
046130*     PERFORM STEST-FINAL.
046140*       STEST-b0100xhp-cbl-3015.
046150*     MOVE "b0100xhp.cbl              3015" TO STEST-KEY.
046160*     MOVE SPECS-5 TO STEST-SCRN-SPECS.
046170*     MOVE FUNCTION ADDR(SPECS-5) TO STEST-PTR.
046180*     PERFORM STEST-BEGIN.
046190*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046200*     = FUNCTION LENG (FLAG).
046210*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
046220*     STEST-PARAMS (STEST-PARAM-NUM).
046230*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
046240*     STEST-PARAMS (STEST-PARAM-NUM).
046250*     PERFORM STEST-PARAM-CHECK.
046260*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046270*     = FUNCTION LENG (FKEYS).
046280*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
046290*     STEST-PARAMS (STEST-PARAM-NUM).
046300*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
046310*     STEST-PARAMS (STEST-PARAM-NUM).
046320*     PERFORM STEST-PARAM-CHECK.
046330*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046340*     = FUNCTION LENG (SPECS-5).
046350*     MOVE 28 TO STEST-PARAM-W-SIZE OF 
046360*     STEST-PARAMS (STEST-PARAM-NUM).
046370*     MOVE "SPECS-5" TO STEST-PARAM-NAME OF 
046380*     STEST-PARAMS (STEST-PARAM-NUM).
046390*     PERFORM STEST-PARAM-CHECK.
046400*     PERFORM STEST-SKIP.
046410*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046420*     = FUNCTION LENG (ACCEPT-OPTS).
046430*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
046440*     STEST-PARAMS (STEST-PARAM-NUM).
046450*     MOVE "ACCEPT-OPTS" TO STEST-PARAM-NAME OF 
046460*     STEST-PARAMS (STEST-PARAM-NUM).
046470*     PERFORM STEST-PARAM-CHECK.
046480*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
046490*     = FUNCTION LENG (YES-NO).
046500*     MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
046510*     STEST-PARAMS (STEST-PARAM-NUM).
046520*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
046530*     STEST-PARAMS (STEST-PARAM-NUM).
046540*     PERFORM STEST-PARAM-CHECK.
046550*     PERFORM STEST-FINAL.
