000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID.    B0200XHP 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* B0200XHP  - LASER PICK/PACK FORMS  (REWRITE AT V2.9A) 1/6/03  *
000130*                                                               *
000140* KWS      - USE PCX FORM GRAPHIC FOR FAXWARE, REDUCE PCL CNVRSN *
000150* KWS      - USED FORM-FILENAME AS FAX .PCX IMAGE NAME           *
000160* MOD KWS V3.0 - ATHENS- NEW DETAIL PRINT LINE                   *
000170* MOD KWS V3.0 - ATHENS- TOTAL WGT WAS ADDING FOR EACH COPY      *
000180* FIX SKI V3.0 - FUIJTSU MODS                                    *
000190* MOD KWS V3.0 - CHANGES TO ALLOW CALLING BY B0060  (2.2.5)      *
000200* FIX KWS V3.0 - ADDRESS LINES NEED TO BE AT 1600 FOR ENVELOPE   *
000210* UPD KWS V3.0 - ADDED SUPPORT FOR PICK204.MAC LAYOUT            *
000220* UPD KWS V3.0 - ADD LOGIC FOR PDF COPY                          *
000230* MOD KWS V3.0 - JEREMIE - ADD THANK YOU LINE                    *
000240* MOD KWS V3.0 - JEREMIE - PRINT FRT-DISC MESSAGE                *
000250* MOD KWS V3.0 - JEREMIE - BLANK LINE BEFORE PARENT ITEM         *
000260* MOD KWS V3.0 - JEREMIE - PRINT SPC SHIP LINES TOP LEFT         *
000270* MOD KWS V3.0 - JEREMIE - PRINT STARSHIP INFO ON TOP RIGHT      *
000280* MOD KWS V3.0 - JEREMIE - ASK PACKER WHEN FROM 2.7.3            *
000290* MOD KWS V3.0 - JEREMIE - CALLED FROM SM030 FOR PACKSLIP        *
000300* MOD KWS V3.0 - JEREMIE - PRINT CREDIT CARD INFO AT BOTTOM      *
000310* FIX KWS V3.0 - JEREMIE - SUBSCIRPT ON 'CUST PICKUP'            *
000320* FIX KWS V3.0 - JEREMIE - C/S SHIP COMMENT1 REPEATING           *
000330* FIX KWS V3.0C- JEREMIE - ASKS COPY ? FOR EACH COPY 2-2-5       *
000340* UPD KWS V3.1 - PDF IN WINXP                                    *
000350* UPD KWS V3.1 - NOT SHOWING SHIPPING COMMENTS                   *
000360* UPD KWS V3.1 - REPLACE CC INFO AT BOTTOM WITH ORDER COMMENTS   *
000370* UPD KWS V4.0 - REPLACE CGTIMES WITH TIMESNEWROMAN 4110>1690    *
000380* UPD KWS V4.1 - REVISED MSG NOT PRINTING                        *
000390* UPD KWS v4.1 - Add Linkage Section for interface with SM030    *
000400* UPD KWS V4.1 - DO NOT ALLOW PICKTICK FOR CREDITMEMO/RGA        *
000410* MOD KWS V4.2 - USER-BATCH CHANGED TO 2 DIGITS                  *
000420* MOD KWS V4.2 - ALLOW ATHENS TO PRINT PICKTICK FOR CREDIT MEMO  *
000430* UPD KWS V4.2 - UPDATE TO INTERFACE WITH SM030                  *
000440* FIX KWS V4.3 - JEREMIE PACKER NOT BEING UPDATED CORRECTLY      *
000450* UPD SKI V4.2 - POWERFORM                                       *
000460* MOD KWS V4.4 - MFGEQUIP - BLOCK DATES, CHANGE FORM NAME        *
000470* UPD KWS V4.4 - TEMP CHANGE UNTIL LFPR FINISHED                 *
000480* UPD KWS V4.4 - DUMMY PARAGRAPH NEEDED FOR LFPR FORM PRINTING   *
000490* UPD KWS V4.4 - LOGIC FOR PDFCREATOR                            *
000500* UPD KWS V4.4 - FIX MISC FORM ISSUES, NAME, TAIL-DATE, WGT      *
000510* UPD KWS V4.4.1- ZIP CUT OFF IF LONG CITY NAME                  *
000520* FIX KWS V4.4.2- ERROR 48 ON PRINTER, REMOVE WATERMARK LOGIC    *
000530* FIX SKI V4.4 -  CLOSE-LO                                       *
000530* UPD SKI V4.4 -  ADD APPAREL LOGIC                              *
051309* MOD KWS V4.4.3- SUNBELTS - FORCE FORM NAME TO PACKING LIST     *
051309* MOD KWS V4.4.3- SUNBELTS - PRINT RANGE NO MATTER WHAT          *
061609* UPD KWS V4.4.4- PRINT DETAIL IN LARGER FONT                    *
061709* UPD SKI V4.4.4- MIGRATE FROM PARAGRAPH BASED ITEM PRINT TO ARRAY
071409* UPD SKI V4.5  - MOVE APPAREL TO LONGOPTION                     *
010710* UPD KWS V4.5  - ALLOW VEND/CLASS/DEPT TO BE CHANGED IN B0200XHP*
010710* UPD KWS V4.5  - USE PICK201 FORM FOR APPAREL SYSTEM ALSO       *
010810* FIX KWS V4.5  - RANGE OF PICK'S TO PDF ONLY FIRST ON SHOWS     *
010910* MOD KWS V4.5  - MOVE JEREMIE MODS TO V4.5.0                    *
030310* UPD KWS V4.5.1- PRINT CUST-PHONE ABOVE SOLDTO ADDRESS          *
042710* FIX KWS V4.5.1-JEREMIE- DROPPING LINE, PRINTS 2 LINES EACH TIME*
062510* MOD KWS V4.5.1-JEREMIE- NOT PRINTING 'SEE ROUTING GUIDE'       *
072910* MOD KWS V4.5.1- SUNBELTS - ADD WGT EVEN FOR DROPSHIPS          *
000540******************************************************************
000550 INPUT-OUTPUT SECTION.
000560 FILE-CONTROL.
000570
000580     COPY "ORDHF.SL".
000590     COPY "ORDLF.SL".
000600     COPY "SALEF.SL".
000610     COPY "CUSTF.SL".
000620     COPY "ITEMF.SL".
000630     SELECT TAGMF                ASSIGN TO TAGMF-FULLPATH
000640                                 ORGANIZATION IS INDEXED
000650                                 ACCESS MODE IS DYNAMIC
000660                                 RECORD KEY IS TAG-KEY
000670                                 FILE STATUS IS TAGMF-STATUS 
000680                                 LOCK MODE IS AUTOMATIC.
000690     COPY "CNTLF.SL".
000700     COPY "USERF.SL".
000710*    COPY "PRNTR.SL". 
000720     COPY "PFPRNTR.SL".
000730     COPY "ORAUF.SL".
000740     COPY "STEST.SL".
071409*    COPY "MUCTF.SL".
071409     COPY "SCATF.SL".
010710     COPY "COLRF.SL".
000750
000760 DATA DIVISION.
000770 BASED-STORAGE SECTION.
000780     COPY "STEST.BS".
000790 FILE SECTION.
000800
000810
000820*FD  LO
000830*    LABEL RECORDS ARE OMITTED.
000840
000850*01  PRINT-REC           PIC X(140).
000860     COPY "PFPRNTR.FD".
000870     COPY PICK201 OF XMDLIB.
000880
000890     COPY "ORDHF.FD".
000900     COPY "ORDLF.FD".
000910     COPY "SALEF.FD".
000920     COPY "CUSTF.FD".
000930     COPY "ITEMF.FD".
000940     COPY "TAGMF.FD".
000950 01  TAGMF-REC.
000960     05 TAG-KEY        PIC X(12).
000970     05 TAG-ONHAND     PIC S9(8)V9(5) COMP-3.
000980
000990     COPY "CNTLF.FD".
001000*    COPY "LFCTF.FD".
001010     COPY "USERF.FD".
001020     COPY "ORAUF.FD".
001030     COPY "STEST.FD".
071409*    COPY "MUCTF.FD".
071409     COPY "SCATF.FD".
010710     COPY "COLRF.FD".
001040
001050 WORKING-STORAGE SECTION.
001060 01  PROG-NAME.
001070     05 FILLER           PIC X(9) VALUE "B0200XHP".
001080
001090 01  SYSTEM-TIME.
001100     03 SYSTEM-HOUR          PIC 99.
001110     03 SYSTEM-MINUTE        PIC 99.
001120     03 SYSTEM-SECONDS       PIC 99.
001130     03 FILLER               PIC 99.
001140
001150 01  PR-CNDSE            PIC X(9)  VALUE SPACES.
001160 01  LINE-NO             PIC 9(2)  VALUE ZERO.
001170 01  PAGE-NO             PIC 9(4)  VALUE ZERO.
001180 01  PR-PAGE-NO          PIC Z(2)  VALUE ZERO.
001190 01  SKIP                PIC 99    VALUE ZERO.
001200 01  LO-STATUS           PIC XX    VALUE SPACES.
001210 01  CNTLF-STATUS        PIC XX    VALUE SPACES.
001220 01  USERF-STATUS        PIC XX    VALUE SPACES.
001230 01  SALEF-STATUS        PIC XX    VALUE SPACES.
001240 01  CUSTF-STATUS        PIC XX    VALUE SPACES.
001250 01  ORAUF-STATUS        PIC XX    VALUE SPACES.
001260     88 C-RECORD-OK VALUES "00", "02".
001270     88 C-FOUND VALUES "00", "02".
001280     88 C-AT-END VALUES "10", "14".
001290     88 C-END-OF-FILE VALUES "10", "14".
001300 01  ITEMF-STATUS        PIC XX    VALUE SPACES.
001310     88 C-RECORD-OK VALUES "00", "02".
001320     88 C-FOUND VALUES "00", "02".
001330     88 C-AT-END VALUES "10", "14".
001340     88 C-END-OF-FILE VALUES "10", "14".
001350 01  TAGMF-STATUS        PIC XX    VALUE SPACES.
001360     88 C-RECORD-OK VALUES "00", "02".
001370     88 C-FOUND VALUES "00", "02".
001380     88 C-AT-END VALUES "10", "14".
001390     88 C-END-OF-FILE VALUES "10", "14".
001400 01  ORDHF-STATUS        PIC XX    VALUE SPACES.
001410     88 C-RECORD-OK VALUES "00", "02".
001420     88 C-FOUND VALUES "00", "02".
001430     88 C-AT-END VALUES "10", "14".
001440     88 C-END-OF-FILE VALUES "10", "14".
001450 01  ORDLF-STATUS        PIC XX    VALUE SPACES.
001460     88 C-RECORD-OK VALUES "00", "02".
001470     88 C-FOUND VALUES "00", "02".
001480     88 C-AT-END VALUES "10", "14".
001490     88 C-END-OF-FILE VALUES "10", "14".
071409*01  MUCTF-STATUS        PIC XX    VALUE SPACES.
071409*    88 C-RECORD-OK VALUES "00", "02".
071409*    88 C-FOUND VALUES "00", "02".
071409*    88 C-AT-END VALUES "10", "14".
071409*    88 C-END-OF-FILE VALUES "10", "14".
071409     COPY "SCATF.DTA".
010710     COPY "COLRF.DTA".
001500 01  ORDHF-NAME          PIC X(5)  VALUE "ORDHF".
001510 01  ORDLF-NAME          PIC X(5)  VALUE "ORDLF".
001520 01  EXT-HDR-FILE        PIC X(12) VALUE SPACES.
001530 01  EXT-LIN-FILE        PIC X(12) VALUE SPACES.
001540 01  ESC-FLAG            PIC 9    VALUE ZERO.
001550 01  LOW-ORDHF-KEY.
001560     05  LOW-ORDER.
001570         10 LOW-SLSMN    PIC 9(3) VALUE ZERO.
001580         10 FILLER       PIC 9(3) VALUE ZERO.
001590     05  LOW-SUB-ORDER   PIC 9(2) VALUE ZERO.
001600 01  HIGH-ORDHF-KEY.
001610     05  HIGH-ORDER.
001620         10 HIGH-SLSMN   PIC 9(3) VALUE ZERO.
001630         10 FILLER       PIC 9(3) VALUE ZERO.
001640     05  HIGH-SUB-ORDER   PIC 9(2) VALUE ZERO.
001650 77  NUMBER-DECIMALS     PIC 9 VALUE ZERO.
001660 77  NEXT-PROG2          PIC    X(20)           VALUE SPACES.
001670 01  WS-PDF-CD                    PIC 9 VALUE 2.
001680     88  PDF-YES    VALUE 1.
001690     88  PDF-NO     VALUE 2.
001700 01  YES-NO-PDF.
001710     05  FILLER              PIC X(3)           VALUE "Yes".
001720     05  FILLER              PIC X(3)           VALUE "No ".
001730     05  FILLER              PIC X(3)           VALUE "PDF".
001740
001750 01  PROCESS-ORDERS-FLAG    PIC X VALUE "O".
001760     88  PROCESS-OPEN-ORDERS      VALUE "O".
001770     88  PROCESS-INVOICES         VALUE "I".
001780     88  PROCESS-HISTORY          VALUE "H".
001790     88  MXFR-HISTORY             VALUE "M".
001800 01  RANGE-TYPE-FLAG        PIC X VALUE "1".
001810     88  POS-PRINTING             VALUE "P".
001820     88  PRINT-ALL-ORDERS         VALUE "1".
001830     88  RANGE-PRINTING           VALUE "2".
001840     88  SELECTIVE-PRINTING       VALUE "3".
001850     88  BY-BATCH-NO              VALUE "4".
001860     88  BY-SALESMAN-PRINTING     VALUE "5".
001870     88  OPEN-ORDERS-ONLY         VALUE "6".
001880     88  RELEASED-ORDERS-ONLY     VALUE "7".
001890     88  ONHAND-INVENTORY         VALUE "8".
001900 01  FORM-TYPE-FLAG         PIC 9 VALUE 1.
001910     88 PICK-FORM                 VALUE 1.
001920     88 PACK-FORM                 VALUE 2.
001930
001940 01  RANGE-DATA.
001950     05  RANGE-MSG      PIC X(21) VALUE "Do you want to print?".
001960     05  RANGE-CODES.
001970         10  FILLER     PIC X(17) VALUE "All Orders".
001980         10  FILLER     PIC X(17) VALUE "A Range of Orders".
001990         10  FILLER     PIC X(17) VALUE "Selective Orders".
002000         10  BY-BATCH   PIC X(17) VALUE "By Batch Number  ".
002010         10  FILLER     PIC X(17) VALUE "A Range of Slsmn ".
002020         10  FILLER     PIC X(17) VALUE "'Open Orders'".
002030         10  FILLER     PIC X(17) VALUE "'Released' Orders".
002040*       10  FILLER     PIC X(17) VALUE "Onhand Inventory ".
002050        10  FILLER     PIC X(17) VALUE "  ".
002060     05  ORDER-CODES.
002070         10  FILLER     PIC X(13) VALUE "Order Number".
002080         10  FILLER     PIC X(13) VALUE "Customer Name".
002090     05  RANGE-SPECS-1.
002100         10  FILLER     PIC X(14) VALUE "1143O05171    ".
002110         10  FILLER     PIC X(14) VALUE "1043O02131    ".
002120     05  RANGE-SPECS-1-REDEF REDEFINES RANGE-SPECS-1.
002130         10  RANGE-SPEC-1  OCCURS 2 TIMES.
002140             15  ROW         PIC 99.
002150             15  COL         PIC 99.
002160             15  TYP         PIC X.
002170             15  FLEN        PIC 99.
002180             15  SLEN        PIC 99.
002190             15  OPTION      PIC 9   .
002200             15  ATTR1       PIC X(2).
002210             15  ATTR2       PIC X(2).
002220     05  RANGE-LOW-MSG  PIC X(16) VALUE "First to print -".
002230     05  RANGE-HIGH-MSG PIC X(16) VALUE "Last  to print -".
002240     05  RANGE-SPECS-2.
002250         10  FILLER     PIC X(14) VALUE "1243D06060    ".
002260         10  FILLER     PIC X(14) VALUE "1343D06060    ".
002270     05  RANGE-SPECS-2-REDEF REDEFINES RANGE-SPECS-2.
002280         10  RANGE-SPEC-2  OCCURS 2 TIMES.
002290             15  ROW         PIC 99.
002300             15  COL         PIC 99.
002310             15  TYP         PIC X.
002320             15  FLEN        PIC 99.
002330             15  SLEN        PIC 99.
002340             15  OPTION      PIC 9   .
002350             15  ATTR1       PIC X(2).
002360             15  ATTR2       PIC X(2).
002370     05  SELECT-QUES    PIC X(35)
002380         VALUE "Order Number to print:             ".
002390     05  RANGE-SPECS-3.
002400         10  FILLER     PIC X(14) VALUE "1243D06060E   ".
002410         10  FILLER     PIC X(14) VALUE "1250D02020IP  ".
002420         10  FILLER     PIC X(14) VALUE "1343X02020IP  ".
002430     05  RANGE-SPECS-3-REDEF REDEFINES RANGE-SPECS-3.
002440         10  RANGE-SPEC-3  OCCURS 3 TIMES.
002450             15  FILLER     PIC X(9).
002460             15  OPTION     PIC 9   .
002470             15  ATTR1      PIC X(2).
002480             15  ATTR2      PIC X(2).
002490 01  WS-ORDER-FLAG PIC 9 VALUE 2.
002500     88 PRINT-IN-ORDER-SEQUENCE    VALUE 1.
002510     88 PRINT-IN-NAME-SEQUENCE     VALUE 2.
002520 01  HELP1.
002530     05  FILLER PIC X(02)    VALUE " $".
002540     05  FILLER PIC X(02)    VALUE " $".
002550 01  HELP2.
002560     05  FILLER PIC X(120)   VALUE " Enter the number of the first
002570-    " and last order to print.  If you want to print    one order
002580-    ", enter it's number as the fir".
002590     05  FILLER PIC X(021) VALUE "st and last number.$$".
002600 01  HELP3.
002610     05  FILLER PIC X(120)   VALUE " Enter the order number to pri
002620-    "nt.  Each order will print after you enter the     number.  
002630-    "You may enter as many orders a".
002640     05  FILLER PIC X(080)   VALUE "s you want to be printed at on
002650-    "e time.    Use the END key to return to the Menu.$".
002660     05  RANGE-ERR-1    PIC X(47) VALUE
002670         " That is an invalid range, please try another. ".
002680     05  RANGE-ERR-2    PIC X(51) VALUE
002690         " There are none in this range, please try another. ".
002700     05  RANGE-ERR-3    PIC X(48) VALUE
002710         " This order does not exist, please try another. ".
002720     05  RANGE-ERR-4    PIC X(62) VALUE " This order is not releas
002730-        "ed to be billed, please try another. ".
002740
002750*--- BATCH NO VARIABLES ---*
002760 01  BATCH-SPECS.
002770         10  FILLER     PIC X(5)  VALUE "1645D".
002780*        10  FILLER     PIC 99    VALUE 01.
002790*        10  FILLER     PIC 99    VALUE 01.
002800         10  FILLER     PIC 99    VALUE 02.
002810         10  FILLER     PIC 99    VALUE 02.
002820         10  FILLER     PIC 9     VALUE 0.
002830         10  FILLER     PIC X(4)  VALUE "E   ".
002840 01  BATCH-HELP.
002850     05 FILLER          PIC X(40) VALUE
002860*       " Enter the batch number that you want to ".
002870        " Enter the batch number that you want to".
002880     05 FILLER          PIC X(40) VALUE
002890*       "print.  It must be from 1 to 9.          ".
002900        " print.  It must be from 1 to 9.        ".
002910     05 FILLER          PIC X(40) VALUE
002920*       "                                        $".
002930        "                                       $".
002940 01  DISPLAY-MESSAGES.
002950     05 PRINTING-REPORT  PIC X(30) VALUE "Printing Forms...".
002960     05 NO-ORDERS-MSG    PIC X(37) VALUE
002970        " No Orders were found in this range! ".
002980
002990     COPY "CONSTANT.DTA".
003000     COPY "TAG.DTA".
003010     COPY "SCREEN.DTA".
003020     COPY "STATUS.DTA".
003030     COPY "ERROR.DTA".
003040     COPY "BOX.DTA".   
003050
003060     COPY "ERRORP.DTA".
003070     COPY "DATE.DTA".
003080     COPY "DAYWEEK.DTA".
003090*    COPY "PRINT2.DTA".
003100     COPY "LFPRF.DTA".
003110     COPY "PRINT.DTA".
003120     COPY "PAUSE.DTA".
003130     COPY "CENTER.DTA".
003140     COPY "SPCITEM.DTA".
003150     COPY "FAX.DTA".
003160     COPY "CHAINR.DTA".
003170     COPY "AUTHNO.DTA".
003180     COPY "STARSHIP.OPT".
003190     COPY "MSGBOX.DTA".
003200
003210 01  MSG-BOX-MESSAGE.
003220     05 MSG-BOX-1        PIC X(40) VALUE
003230       "       ** THIS IS A CREDIT MEMO **     ".
003240     05 FILLER           PIC X(02) VALUE X"0A0A".
003250     05 MSG-BOX-2        PIC X(40) VALUE
003260       "You cannot print a Picking Ticket for a ".
003270     05 FILLER           PIC X(01) VALUE X"0A".
003280     05 MSG-BOX-3        PIC X(42) VALUE
003290       "Credit Memo.  Please verify that the".
003300     05 FILLER           PIC X(01) VALUE X"0A".
003310     05 MSG-BOX-4        PIC X(40) VALUE
003320       "order type is correct!              ".
003330
003340 77  WS-SERVICE                  PIC X(18) VALUE SPACES.
003350
003360 01  WEIGHT                      PIC S9(7)V999  VALUE ZERO.
003370 01  PR-TOTALS.
003380     05 TS-WEIGHT                PIC S9(9)V9(3) VALUE ZERO.
003390*01  HP-CTRL-CODES.
003400*    05 HP-RESET         PIC X(02) VALUE X"1B45".
003410*-- FOLLOWING LINES ADDED TO ALLOW DOWNLOAD OF MACRO TO PRINTER --
003420*    05 HP-DEFINE-MACRO.
003430*       10  FILLER       PIC X(03) VALUE X"1B2666".
003440*       10  MACRO-NUMBER PIC 9(5)  VALUE 00201.
003450*       10  FILLER       PIC X(3)  VALUE X"793058".
003460
003470*    05 HP-STOP-DEFINE   PIC X(05) VALUE X"1B26663158".
003480     COPY "LASRFORM.DTA".
003490
003500     03 PR-SYS-DATE-11         PIC X(11)  VALUE SPACES.
003510     03 PR-ORDER-NUMBER.
003520        05 PR-ORDER-NO         PIC 9(6)  VALUE ZERO BLANK ZERO.
003530        05 PR-ORDER-DASH       PIC X     VALUE "-".
003540        05 PR-ORDER-SUB        PIC 9(2)  VALUE ZERO BLANK ZERO.
003550*    03 PR-FORM-TYPE           PIC X(19) VALUE SPACES.
003560     03 PR-SALESMAN.
003570        05 PR-SLSMN-NO         PIC 9(3)  VALUE ZERO.
003580        05 FILLER              PIC X     VALUE "-".
003590        05 PR-SLSMN-NAME       PIC X(25) VALUE SPACES.
003600     03 PR-TOT-WEIGHT            PIC ZZZ,ZZZ,ZZZ.999- BLANK ZERO.
003610
003620
003630 01  WS-PRINT-QTY        PIC S9(7)V9(5)  COMP-3.
003640 77  WS-QTY-NEEDED       PIC S9(7)V9(5)  COMP-3.
003650 77  WS-TEMP-11          PIC X(11)       VALUE SPACES.
003660*01  DSP-HEADER.
003670*    05  FILLER          PIC X(25)  VALUE "Copy Name".
003680*    05  FILLER          PIC X(04)  VALUE "Tray".
003690*    05  FILLER          PIC X(01)       VALUE SPACES.
003700*    05  FILLER          PIC X(23)  VALUE "Device Name".
003710*    05  FILLER          PIC X(01)       VALUE SPACES.
003720*    05  FILLER          PIC X(08)  VALUE "Knockout".
003730*    05  FILLER          PIC X(02)       VALUE SPACES.
003740*    05  FILLER          PIC X(05)  VALUE "Print".
003750*01  DSP-HEADER2.
003760*    05  FILLER          PIC X(73)  VALUE ALL "Ä".
003770*01  DSP-LINE.
003780*    05  DSP-CNT         PIC ZZ          VALUE ZERO.
003790*    05  FILLER          PIC X(01)       VALUE SPACES.
003800*    05  DSP-COPY-MSG    PIC X(25)       VALUE SPACES.
003810*    05  FILLER          PIC X(02)       VALUE SPACES.
003820*    05  DSP-TRAY        PIC 9           VALUE ZERO.
003830*    05  FILLER          PIC X(02)       VALUE SPACES.
003840*    05  DSP-DEVICE-NAME PIC X(25)       VALUE SPACES.
003850*    05  FILLER          PIC X(02)       VALUE SPACES.
003860*    05  DSP-KNOCKOUT    PIC X(3)        VALUE SPACES.
003870*    
003880
003890 01  DETAIL-LINE.
010710*    04 DETAIL-LINE-STD.
010710     03 DETAIL-LINE-STD.
061609*        05 FILLER                 PIC X(02).
061609         05 FILLER                 PIC X(01).
003920         05 PR-ORDER-QTY           PIC ZZ,ZZZ,ZZ9-
003930                                       BLANK ZERO.
003940         05 PR-ORDER-QTY-1 REDEFINES PR-ORDER-QTY
003950               PIC ZZZZ,ZZZ.9- BLANK ZERO.
003960         05 PR-ORDER-QTY-2 REDEFINES PR-ORDER-QTY
003970               PIC ZZZ,ZZZ.99- BLANK ZERO.
003980         05 PR-ORDER-QTY-3 REDEFINES PR-ORDER-QTY
003990               PIC ZZ,ZZZ.999- BLANK ZERO.
004000         05 PR-ORDER-QTY-4 REDEFINES PR-ORDER-QTY
004010               PIC Z,ZZZ.9999- BLANK ZERO.
004020         05 PR-ORDER-QTY-5 REDEFINES PR-ORDER-QTY
004030               PIC ZZZZ.99999- BLANK ZERO.
004040
004050         05 FILLER                PIC X(01).
004060         05 PR-ITEM-UOM           PIC X(03).
061609*        05 FILLER                PIC X(04).
061609         05 FILLER                PIC X(01).
004080         05 PR-SHIP-QTY           PIC ZZ,ZZZ,ZZ9-
004090                                       BLANK ZERO.
004100         05 PR-SHIP-QTY-1 REDEFINES PR-SHIP-QTY
004110               PIC ZZZZ,ZZZ.9- BLANK ZERO.
004120         05 PR-SHIP-QTY-2 REDEFINES PR-SHIP-QTY
004130               PIC ZZZ,ZZZ.99- BLANK ZERO.
004140         05 PR-SHIP-QTY-3 REDEFINES PR-SHIP-QTY
004150               PIC ZZ,ZZZ.999- BLANK ZERO.
004160         05 PR-SHIP-QTY-4 REDEFINES PR-SHIP-QTY
004170               PIC Z,ZZZ.9999- BLANK ZERO.
004180         05 PR-SHIP-QTY-5 REDEFINES PR-SHIP-QTY
004190               PIC ZZZZ.99999- BLANK ZERO.
004200         05  FILLER                PIC X(01).
004210
004220         05 PR-BO-QTY           PIC ZZ,ZZZ,ZZ9-
004230                                       BLANK ZERO.
004240         05 PR-BO-QTY-1 REDEFINES PR-BO-QTY
004250               PIC ZZZZ,ZZZ.9- BLANK ZERO.
004260         05 PR-BO-QTY-2 REDEFINES PR-BO-QTY
004270               PIC ZZZ,ZZZ.99- BLANK ZERO.
004280         05 PR-BO-QTY-3 REDEFINES PR-BO-QTY
004290               PIC ZZ,ZZZ.999- BLANK ZERO.
004300         05 PR-BO-QTY-4 REDEFINES PR-BO-QTY
004310               PIC Z,ZZZ.9999- BLANK ZERO.
004320         05 PR-BO-QTY-5 REDEFINES PR-BO-QTY
004330               PIC ZZZZ.99999- BLANK ZERO.
061609*        05  FILLER                PIC X(04).
061609         05  FILLER                PIC X(02).
010710       04 DETAIL-LINE-STD-PART2.
004350         05 PR-ITEM-NO             PIC X(12).
061609*        05 FILLER                 PIC X(09).
061609         05 FILLER                 PIC X(05).
004370         05 PR-ITEM-DESC           PIC X(28).
061609*        05 FILLER                 PIC X(02).
061609         05 FILLER                 PIC X(05).
061609*        05 PR-ITEM-BIN            PIC X(11).
061609         05 PR-ITEM-BIN            PIC X(06).
004400         05 FILLER                 PIC X(05).
004410         05 PR-ITEM-WEIGHT         PIC Z(5)9.999-
004420                                       BLANK ZERO.
004430         05 FILLER                 PIC X(03).
010710*      04 DETAIL-LINE-APPAREL REDEFINES DETAIL-LINE-STD.
010710*        05 FILLER PIC X(43).  
010710       04 DETAIL-LINE-APPAREL REDEFINES DETAIL-LINE-STD-PART2.
310309          05 PR-ORDL-STYLE          PIC X(08)   .
310309          05 FILLER                 PIC X(02)    .
092809*         05 PR-CATEGORY            PIC X(10)    .
092809*         05 FILLER                 PIC X(06)    .
010710*         05 PR-COLOR               PIC X(02)    .
010710*         05 FILLER                 PIC X(11)     .
010710          05 PR-COLOR               PIC X(13).
071409*         05 PR-SIZE                PIC X(04)    .
071409*         05 FILLER                 PIC X(3)     .
071409          05 PR-SIZE                PIC X(05)    .
071409          05 FILLER                 PIC X(2)     .
092809          05 PR-CATEGORY            PIC X(10)    .
010710*         05 FILLER                 PIC X(06)    .
010710          05 FILLER                 PIC X(02)    .
310309          05 PR-ORDL-ITEM-DESC-B    PIC X(28).    
010710*         05 FILLER                 PIC X(02).
010710*         05 PR-BIN-LOC             PIC X(05).
004440*-- PICK204.MAC DETAILS LINE --*
010710*      04 204-LINE-REDEF REDEFINES DETAIL-LINE-STD.
010710       03 204-LINE-REDEF REDEFINES DETAIL-LINE-STD.
004460          05 FILLER               PIC X(02).
004470          05 PR-204-ITEM-BIN      PIC X(06).
                05 FILLER               PIC X(03).
004490          05 PR-204-ITEM-NO       PIC X(12).
010910*         05 FILLER               PIC X(02).
010910          05 FILLER               PIC X(09).
004510          05 PR-204-ITEM-DESC     PIC X(28).
010910*         05 FILLER               PIC X(02).
010910          05 FILLER               PIC X(04).
004530          05 PR-204-ITEM-UOM      PIC X(03).            
010910*         05 FILLER               PIC X(02).
010910          05 FILLER               PIC X(06).
004550          05 PR-204-ORDER-QTY     PIC ZZZ,ZZ9- BLANK ZERO.
010910*         05 FILLER               PIC X(02).
010910          05 FILLER               PIC X(09).
004570          05 PR-204-SHIP-QTY      PIC ZZZ,ZZ9- BLANK ZERO.
010910*         05 FILLER               PIC X(01).
010910          05 FILLER               PIC X(07).
004590          05 PR-204-BO-QTY        PIC ZZZ,ZZ9- BLANK ZERO.
010910*         05 FILLER               PIC X(37).
010910          05 FILLER               PIC X(11).

004610 01  JEREMIE-LINE.
004620     05  FILLER                   PIC X(05) VALUE SPACES.
004630     05  PR-SHIP-COMMENT          PIC X(35) VALUE SPACES.
004640
004750

004760 01  FORMATTED-TIME.
004770     05  FMT-HOUR    PIC 99 VALUE ZERO.
004780     05  FILLER      PIC X  VALUE ":".
004790     05  FMT-MIN     PIC 99 VALUE ZERO.
004800     05  FILLER      PIC X  VALUE ":".
004810     05  FMT-SEC     PIC 99 VALUE ZERO.
004820
004830     COPY "B0750.DTA".
004840 01  CHAINED-FROM-CD      PIC 9 VALUE ZERO.
004850     88 FROM-B0750        VALUE 1.
004860     88 FROM-SM030        VALUE 2.
004870     88 FROM-B0060        VALUE 3.
004880 77  LASER-COPY-CD        PIC 9 VALUE 2.
004890
004900*01  HELP4.
004910*    05  FILLER PIC X(080)   VALUE " Select [Yes] for each of the 
004920*    "copies that you would like to print.  If you      ".
004930*    05  FILLER PIC X(080)   VALUE " select [No] that copy will be
004940*    " skipped.                                        $".
004950
004960*01  SPECS-4.
004970*    05  FILLER      PIC X(14)  VALUE "0772O02031    ".
004980*    05  FILLER      PIC X(14)  VALUE "0772O03031    ".
004990*    05  FILLER      PIC X(14)  VALUE "0872O02031    ".
005000*    05  FILLER      PIC X(14)  VALUE "0972O02031    ".
005010*    05  FILLER      PIC X(14)  VALUE "1072O02031    ".
005020*    05  FILLER      PIC X(14)  VALUE "1172O02031    ".
005030*    05  FILLER      PIC X(14)  VALUE "1272O02031    ".
005040*    05  FILLER      PIC X(14)  VALUE "1372O02031    ".
005050*    05  FILLER      PIC X(14)  VALUE "1472O02031    ".
005060*    05  FILLER      PIC X(14)  VALUE "1572O02031    ".
005070*    05  FILLER      PIC X(14)  VALUE "1672O02031    ".
005080*    05  FILLER      PIC X(14)  VALUE "1772O02032    ".
005090*01  SPECS-4-REDEF REDEFINES SPECS-4.
005100*    05  SPEC-4    OCCURS 11 TIMES.
005110*         15  FILLER     PIC X(9).
005120*         15  OPTION     PIC 9   .
005130*         15  ATTR1      PIC X(2).
005140*         15  ATTR2      PIC X(2).
005150
005160 01  WS-PRINT-COPY-CODES.
005170     05  WS-PRINT-COPY-CD          PIC 9 OCCURS 10 TIMES.
005180
005190 01  WS-PRINT-ENVELOPE-CD PIC 9    VALUE 2.
005200     88 PRINT-ENVELOPE-YES         VALUE 1.
005210
005220 01  HELP5.
005230     05  FILLER PIC X(080)   VALUE " Select [Accept Defaults] to p
005240-    "rint the copies set to YES above.  If you want to ".
005250     05  FILLER PIC X(080)   VALUE " change what copies will print
005260-    " press ESC or the Spacebar and Ctrl-Enter        $".
005270     05  FILLER PIC X(080)   VALUE " Select [Yes] if you want to f
005280-    "ax a copy of this form in addition to printing    ".
005290     05  FILLER PIC X(080)   VALUE " whatever copies are set to [Y
005300-    "es].  You will be prompted for the Phone Number. $".
005310
005320 01  SPECS-5.
005330     05  FILLER      PIC X(14)  VALUE "2032O02151    ".
005340     05  FILLER      PIC X(14)  VALUE "1672O02031    ".
005350 01  SPECS-5-REDEF REDEFINES SPECS-5.
005360     05  SPEC-5    OCCURS 11 TIMES.
005370          15  FILLER     PIC X(9).
005380          15  OPTION     PIC 9   .
005390          15  ATTR1      PIC X(2).
005400          15  ATTR2      PIC X(2).
005410
005420 01  ACCEPT-OPTS.
005430     05  FILLER          PIC X(15)   VALUE "Accept Defaults".
005440     05  FILLER          PIC X(15)   VALUE "Change Defaults".
005450*01  CC-CARD-LINE.
005460*    05 FILLER           PIC X(04) VALUE SPACES.
005470*    05 CC-CARD-TYPE     PIC X(22) VALUE SPACES.
005480*    05 FILLER           PIC X(02) VALUE SPACES.
005490*01  CC-DESC.
005500*    05 FILLER           PIC X(08) VALUE SPACES.
005510*    05  CC-NO.
005520*       10  CC-NO-BLANK     PIC X(12).
005530*       10  FILLER          PIC X(04).
005540*    05 FILLER           PIC X(04) VALUE SPACES.
005550*01  CC-VCODE-LINE.
005560*    05 FILLER           PIC X(11) VALUE SPACES.
005570*    05 CC-VCODE         PIC X(15) VALUE SPACES.
005580*    05 FILLER           PIC X(02) VALUE SPACES.
005590*01  CC-EXPIRE-LINE.
005600*    05 FILLER           PIC X(15) VALUE SPACES.
005610*    05 CC-EXPIRE        PIC X(04) VALUE SPACES.
005620*    05 FILLER           PIC X(09) VALUE SPACES. 
005630
005640 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
005650     88 JEREMIE             VALUE 00112.
005660     88 MFGEQUIP            VALUE 00218.
051309     88 SUNBELTS            VALUE 00010, 00011.

005670 77  CUSTF--NAME PIC X(15) VALUE "CUSTOMER.FIL" .
005680 77  CUSTF-FULLPATH PIC X(35) VALUE SPACES .
005690 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
005700 77  TEMP-SUB-DIR PIC X(14) VALUE SPACES .
005710 77  ORDHF--NAME PIC X(15) VALUE "ORDERH.FIL" .
005720 77  ORDHF-FULLPATH PIC X(35) VALUE SPACES .
005730 77  ORDLF--NAME PIC X(15) VALUE "ORDERL.FIL" .
005740 77  ORDLF-FULLPATH PIC X(35) VALUE SPACES .
005750 77  CNTLF--NAME PIC X(15) VALUE "CONTROL.FIL" .
005760 77  CNTLF-FULLPATH PIC X(35) VALUE SPACES .
005770 77  USERF--NAME PIC X(15) VALUE "USER.FIL" .
005780 77  USERF-FULLPATH PIC X(35) VALUE SPACES .
005790 77  ITEMF--NAME PIC X(15) VALUE "ITEM.FIL" .
005800 77  ITEMF-FULLPATH PIC X(35) VALUE SPACES .
071409*01  MUCTF-KEY            PIC 9(5) VALUE 1.
071409*77  MUCTF--NAME PIC X(15) VALUE "MUCNTL.FIL" .
071409*77  MUCTF-FULLPATH PIC X(35) VALUE SPACES .
005810 01  IO-WAIT-CD  PIC X VALUE "1"                                  
005820     88 IO-WAIT-ON VALUE IS "1".
005830     88 IO-WAIT-OFF VALUE IS "0".
005840      COPY "STEST.DTA".
005850 77  SALEF--NAME PIC X(15) VALUE "SALESMAN.FIL" .
005860 77  SALEF-FULLPATH PIC X(35) VALUE SPACES .
005870 77  ORAUF--NAME PIC X(15) VALUE "ORDRAUTH.FIL" .
005880 77  ORAUF-FULLPATH PIC X(35) VALUE SPACES .
005890 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
005900 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
005910 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.
005920*01 SUFFIX-CHECK-PARAM-LEN PIC S9(4) COMP-5.
005930
005940 LINKAGE SECTION.
005950 01  Pass-Data.
005960     05  LS-ORDER-NO                   PIC 9(6).
005970*    05  LS-PACKER-NO                  PIC 9(6).
005980     05  LS-PACKER-NO                  PIC X(2).
005990     05  LS-FILE-CD                    PIC 9   .
006000
006010 SCREEN SECTION.
006020     COPY "CONSTANT.SCR".
006030     COPY "SCRNINIT.SCR".
006040     COPY "ERRORFIL.SCR".
006050*    COPY "PRINT.SCR".   
006060     COPY "CHAINR.SCR".  
006070     COPY "PAUSE.SCR".
006080                         
006090*01 SCR-errorfil-sr-14-20 PIC IS X(51) FROM BOX-TOP CONTROL 
006100*     DSPL--CONTROL LINE 08 COLUMN 14 REVERSE-VIDEO.
006110*01 SCR-errorfil-sr-15-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006120*     DSPL--CONTROL LINE 09 COLUMN 14 REVERSE-VIDEO.
006130*01 SCR-errorfil-sr-16-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006140*     DSPL--CONTROL LINE 10 COLUMN 14 REVERSE-VIDEO.
006150*01 SCR-errorfil-sr-17-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006160*     DSPL--CONTROL LINE 11 COLUMN 14 REVERSE-VIDEO.
006170*01 SCR-errorfil-sr-18-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006180*     DSPL--CONTROL LINE 12 COLUMN 14 REVERSE-VIDEO.
006190*01 SCR-errorfil-sr-19-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006200*     DSPL--CONTROL LINE 13 COLUMN 14 REVERSE-VIDEO.
006210*01 SCR-errorfil-sr-20-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006220*     DSPL--CONTROL LINE 14 COLUMN 14 REVERSE-VIDEO.
006230*01 SCR-errorfil-sr-21-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
006240*     DSPL--CONTROL LINE 15 COLUMN 14 REVERSE-VIDEO.
006250*01 SCR-errorfil-sr-35-20 PIC IS X(40) FROM ERROR-MSG CONTROL 
006260*     DSPL--CONTROL LINE 10 COLUMN 17 REVERSE-VIDEO.
006270*01 SCR-errorfil-sr-36-20 PIC IS X(35) FROM ERROR-LINE-1 CONTROL 
006280*     DSPL--CONTROL LINE 11 COLUMN 17 REVERSE-VIDEO.
006290*01 SCR-errorfil-sr-37-20 PIC IS X(41) FROM ERROR-LINE-2 CONTROL 
006300*     DSPL--CONTROL LINE 12 COLUMN 17 REVERSE-VIDEO.
006310*01 SCR-errorfil-sr-38-20 PIC IS X(40) FROM ERROR-CONTACT CONTROL 
006320*     DSPL--CONTROL LINE 13 COLUMN 17 REVERSE-VIDEO.
006330*01 SCR-errorfil-sr-39-20 PIC IS X(40) FROM ERROR-RESUME CONTROL 
006340*     DSPL--CONTROL LINE 14 COLUMN 17 REVERSE-VIDEO.
006350*01 SCR-errorfil-sr-40-20 VALUE IS "Program Name = " CONTROL 
006360*     DSPL--CONTROL LINE 09 COLUMN 17 REVERSE-VIDEO.
006370*01 SCR-errorfil-sr-41-20 PIC IS X(6) FROM PROG-NAME CONTROL 
006380*     DSPL--CONTROL LINE 09 COLUMN 32 REVERSE-VIDEO.
006390*01 SCR-scrninit-sr-13-20 PIC IS X(80) FROM SCRN-TITLE-1 CONTROL 
006400*     DSPL--CONTROL LINE 01 COLUMN 01.
006410*01 SCR-scrninit-sr-14-20 PIC IS X(80) FROM SCRN-TITLE-2 CONTROL 
006420*     DSPL--CONTROL LINE 02 COLUMN 01.
006430*01 SCR-scrninit-sr-15-20 VALUE IS " PGM=" CONTROL DSPL--CONTROL 
006440*     LINE 02 COLUMN 04.
006450*01 SCR-scrninit-sr-16-20 PIC IS X(6) FROM PROG-NAME CONTROL 
006460*     DSPL--CONTROL LINE 02 COLUMN 09.
006470*01 SCR-scrninit-sr-17-20 VALUE IS " Station " CONTROL 
006480*     DSPL--CONTROL LINE 02 COLUMN 19.
006490*01 SCR-scrninit-sr-18-20 PIC IS X(2) FROM USER-TERMID CONTROL 
006500*     DSPL--CONTROL LINE 02 COLUMN 28.
006510*01 SCR-scrninit-sr-21-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 
006520*     TIMER-CNT COLUMN 1 SIZE IS 80.
006530*01 SCR-print-sr-100-20 PIC IS X(6) FROM PROG-NAME CONTROL 
006540*     DSPL--CONTROL LINE 2 COLUMN 9.
006550*01 SCR-print-sr-114-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
006560*     DSPL--CONTROL LINE CNT COLUMN 2.
006570*01 SCR-print-sr-145-20 PIC IS X(80) FROM PAUSE-SCRN-2 CONTROL 
006580*     DSPL--CONTROL LINE 19 COLUMN 1.
006590*01 SCR-chainr-sr-15-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 21
006600*      COLUMN 1.
006610*01 SCR-chainr-sr-28-23 PIC IS X(2) FROM DOS-RET-CODE CONTROL 
006620*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
006630*01 SCR-chainr-sr-29-23 VALUE IS " COULD NOT LOAD COMMAND.COM OR P
006640*01 SCR-chainr-sr-29-23 VALUE IS " COULD NOT LOAD COMMA
006650*     REVERSE-VIDEO.
006660*01 SCR-chainr-sr-31-23 CONTROL DSPL--CONTROL LOWLIGHT.
006670*01 SCR-chainr-sr-31-23 CONTROL DSPL--CONTROL LOWLIG
006680* 02 PIC X(80) FROM DOS-CALL-81-160 LINE 23 COLUMN 1 .
006690*01 SCR-chainr-sr-34-23 VALUE IS " E3 - INSUFFICIENT MEMORY " 
006700*     CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
006710*01 SCR-chainr-sr-38-23 VALUE IS "COPY FAILED - " CONTROL 
006720*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
006730*01 SCR-chainr-sr-39-26 PIC IS X(2) FROM DOS-RET-CODE CONTROL 
006740*     DSPL--CONTROL LINE 21 COLUMN 15.
006750 01 SCR-authno-sr-52-20 PIC IS X(51) FROM BOX-TOP CONTROL 
006760      DSPL--CONTROL LINE 8 COLUMN 14.
006770 01 SCR-authno-sr-53-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006780      DSPL--CONTROL LINE 9 COLUMN 14.
006790 01 SCR-authno-sr-54-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006800      DSPL--CONTROL LINE 10 COLUMN 14.
006810 01 SCR-authno-sr-55-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006820      DSPL--CONTROL LINE 11 COLUMN 14.
006830 01 SCR-authno-sr-56-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006840      DSPL--CONTROL LINE 12 COLUMN 14.
006850 01 SCR-authno-sr-57-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006860      DSPL--CONTROL LINE 13 COLUMN 14.
006870 01 SCR-authno-sr-58-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006880      DSPL--CONTROL LINE 14 COLUMN 14.
006890 01 SCR-authno-sr-59-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
006900      DSPL--CONTROL LINE 15 COLUMN 14.
006910 01 SCR-authno-sr-60-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
006920      DSPL--CONTROL LINE 16 COLUMN 14.
006930 01 SCR-authno-sr-61-20 VALUE IS "Authorization Required" CONTROL 
006940      DSPL--CONTROL LINE 9 COLUMN 28.
006950 01 SCR-authno-sr-62-20 VALUE IS "Customer # " CONTROL 
006960      DSPL--CONTROL LINE 12 COLUMN 16.
006970 01 SCR-authno-sr-63-20 VALUE IS "Customer Name" CONTROL 
006980      DSPL--CONTROL LINE 13 COLUMN 16.
006990 01 SCR-authno-sr-64-20 VALUE IS "Order #" CONTROL DSPL--CONTROL 
007000      LINE 14 COLUMN 16.
007010 01 SCR-authno-sr-65-20 VALUE IS "Amount " CONTROL DSPL--CONTROL 
007020      LINE 14 COLUMN 32.
007030 01 SCR-authno-sr-69-20 PIC IS X(8) FROM ORDH-CUST-NO CONTROL 
007040      DSPL--CONTROL LINE 12 COLUMN 27.
007050 01 SCR-authno-sr-70-20 PIC IS X(30) FROM ORDH-CUST-NAME CONTROL 
007060      DSPL--CONTROL LINE 13 COLUMN 30.
007070 01 SCR-authno-sr-71-20 PIC IS X(6) FROM ORDH-ORDER-NO CONTROL 
007080      DSPL--CONTROL LINE 14 COLUMN 24.
007090 01 SCR-authno-sr-73-20 PIC IS X(13) FROM WS-GROSS-AMT CONTROL 
007100      DSPL--CONTROL LINE 14 COLUMN 39.
007110 01 SCR-authno-sr-74-20 PIC IS X(25) FROM WS-AUTH-REASON CONTROL 
007120      DSPL--CONTROL BLINK LINE 11 COLUMN 27.
007130 01 SCR-authno-sr-79-20 VALUE IS "Action " CONTROL DSPL--CONTROL 
007140      LINE 15 COLUMN 16.
007150 01 SCR-authno-sr-93-20 VALUE IS "Enter Code  " CONTROL 
007160      DSPL--CONTROL LINE 15 COLUMN 45.
007170 01 SCR-authno-sr-104-23 VALUE IS " This number is not valid! " 
007180      CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
007190 01 SCR-authno-sr-108-23 VALUE IS " This number has already been u
007200-     "sed! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO
007210      .
007220 01 SCR-b0200xhp-cbl-550-20 PIC IS X(9) FROM PROG-NAME CONTROL 
007230      DSPL--CONTROL LINE 2 COLUMN 9.
007240 01 SCR-b0200xhp-cbl-622-23 VALUE IS "Packing Slip Printed for Ord
007250-     "er: " CONTROL DSPL--CONTROL LINE 20 COLUMN 1.
007260 01 SCR-b0200xhp-cbl-624-23 PIC IS X(6) FROM ORDH-ORDER-NO CONTROL
007270       DSPL--CONTROL LINE 20 COLUMN 33.
007280 01 SCR-b0200xhp-cbl-635-23 VALUE IS "Picking Ticket Printed for O
007290-     "rder: " CONTROL DSPL--CONTROL LINE 20 COLUMN 1.
007300 01 SCR-b0200xhp-cbl-637-23 PIC IS X(6) FROM ORDH-ORDER-NO CONTROL
007310       DSPL--CONTROL LINE 20 COLUMN 35.
007320 01 SCR-b0200xhp-cbl-728-20 VALUE IS "Enter Batch Number" CONTROL 
007330      DSPL--CONTROL LINE 16 COLUMN 25.
007340 01 SCR-b0200xhp-cbl-734-23 VALUE IS " Batch Number must be greate
007350-     "r than zero! " CONTROL DSPL--CONTROL LINE 21 COLUMN 1 
007360      REVERSE-VIDEO.
007370 01 SCR-b0200xhp-cbl-1402-23 PIC IS X(37) FROM NO-ORDERS-MSG 
007380      CONTROL DSPL--CONTROL LINE 21 REVERSE-VIDEO.
007390 01 SCR-b0200xhp-cbl-1500-23 VALUE IS "Printing Order #: " CONTROL
007400       DSPL--CONTROL LINE 13 COLUMN 28.
007410 01 SCR-b0200xhp-cbl-1548-29 PIC IS X(48) FROM RANGE-ERR-3 CONTROL
007420       DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
007430*01 SCR-b0200xhp-cbl-1791-23 PIC IS X(69) FROM DSP-HEADER CONTROL 
007440*     DSPL--CONTROL LINE 5 COLUMN 8.
007450*01 SCR-b0200xhp-cbl-1792-23 PIC IS X(73) FROM DSP-HEADER2 CONTROL
007460*      DSPL--CONTROL LINE 6 COLUMN 5.
007470*01 SCR-b0200xhp-cbl-1799-23 PIC IS X(63) FROM DSP-LINE CONTROL 
007480*     DSPL--CONTROL LINE 17 COLUMN 5.
007490 01 SCR-b0200xhp-cbl-1820-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
007500      DSPL--CONTROL LINE 20 COLUMN 1.
007510 01 SCR-b0200xhp-cbl-1832-23 PIC IS X(80) FROM CLEAR-21 CONTROL 
007520      DSPL--CONTROL LINE 20 COLUMN 1.
007530 01 SCR-b0200xhp-cbl-1856-23 VALUE IS " No Copies have been select
007540-     "ed to print! " CONTROL DSPL--CONTROL LINE 20 COLUMN 20 
007550      REVERSE-VIDEO.
007560*01 SCR-b0200xhp-cbl-1874-20 PIC IS X(63) FROM DSP-LINE CONTROL 
007570*     DSPL--CONTROL LINE CNT2 COLUMN 5.
007580 01 SCR-b0200xhp-cbl-1905-23 PIC IS X(21) FROM RANGE-MSG CONTROL 
007590      DSPL--CONTROL LINE 11 COLUMN 20.
007600 01 SCR-b0200xhp-cbl-1906-23 VALUE IS "Print Forms by:   " CONTROL
007610       DSPL--CONTROL LINE 10 COLUMN 20.
007620 01 SCR-b0200xhp-cbl-1937-20 PIC IS X(16) FROM RANGE-LOW-MSG 
007630      CONTROL DSPL--CONTROL LINE 12 COLUMN 20.
007640 01 SCR-b0200xhp-cbl-1938-20 PIC IS X(16) FROM RANGE-HIGH-MSG 
007650      CONTROL DSPL--CONTROL LINE 13 COLUMN 20.
007660 01 SCR-b0200xhp-cbl-1950-24 PIC IS X(47) FROM RANGE-ERR-1 CONTROL
007670       DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
007680 01 SCR-b0200xhp-cbl-1957-24 PIC IS X(51) FROM RANGE-ERR-2 CONTROL
007690       DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
007700 01 SCR-b0200xhp-cbl-1960-20 PIC IS X(30) FROM PRINTING-REPORT 
007710      CONTROL DSPL--CONTROL LINE 12 COLUMN 30.
007720 01 SCR-b0200xhp-cbl-1969-20 PIC IS X(35) FROM SELECT-QUES CONTROL
007730       DSPL--CONTROL LINE 12 COLUMN 20.
007740 01 SCR-b0200xhp-cbl-1971-23 VALUE IS "Packer:" CONTROL 
007750      DSPL--CONTROL LINE 13 COLUMN 35.
007760 01 SCR-b0200xhp-cbl-1975-23 VALUE IS "-" CONTROL DSPL--CONTROL 
007770      LINE 12 COLUMN 56.
007780 01 SCR-b0200xhp-cbl-2082-20 PIC IS X(9) FROM PROG-NAME CONTROL 
007790      DSPL--CONTROL LINE 2 COLUMN 9.
007800 01 SCR-b0200xhp-cbl-2155-20 VALUE IS "Checking Order #: " CONTROL
007810       DSPL--CONTROL LINE 13 COLUMN 28.
007820 01 SCR-b0200xhp-cbl-2156-20 PIC IS X(6) FROM ORDH-ORDER-NO 
007830      CONTROL DSPL--CONTROL LINE 13 COLUMN 46.
310309 01 SCR-LOCKED PIC IS X(44) FROM LOCKED-MSG CONTROL 
310309      DSPL--CONTROL LINE 21 REVERSE-VIDEO.
007840
007850 PROCEDURE DIVISION USING PASS-DATA.
007860 DECLARATIVES.
007870
007880
007890*    PRNTR.DS   PRINTER DECLARATIVES PROCEDURE.
007900
007910 Z-PRNTR SECTION.
007920     USE AFTER ERROR PROCEDURE ON LO.
007930 Z-PRNTR-D.
007940     COPY "ERRORPRT.SR".
007950     GO TO STATUS-EXIT.
007960     COPY "ORDHF.DS".
007970     COPY "ORDLF.DS".
007980     COPY "SALEF.DS".
007990     COPY "CUSTF.DS".
008000     COPY "ITEMF.DS".
008010     COPY "TAGMF.DS".
008020     COPY "CNTLF.DS".
008030     COPY "USERF.DS".
008040     COPY "ORAUF.DS".
008050     COPY "LFPRF.DS".
071409*    COPY "MUCTF.DS".
071409     COPY "SCATF.DS".
010710     COPY "COLRF.DS".
008060     GO TO STATUS-EXIT.
008070
008080     COPY "ERRORFIL.SR".
008090
008100 STATUS-EXIT. EXIT.
008110
008120 END DECLARATIVES.
008130
008140 MAIN-PROG SECTION.
008150 OPEN-FILES.
071409     MOVE "SIZECAT.FIL"      TO  SCATF--NAME.
010710     MOVE "COLOR.FIL  "      TO  COLRF--NAME.
008160      PERFORM USERF-FILL-FULLPATH.
008170     PERFORM PGM-INIT.
008180     PERFORM SCREEN-INIT.
051309     IF USER-SN = 00112 OR 00218 OR 00010 OR 00011
008200        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
008210     IF WS-CUSTOMIZED-FLAG > ZERO
008220        MOVE "B0200XHPM" TO PROG-NAME.
008230     DISPLAY SCR-b0200xhp-cbl-550-20  .
008240     COMPUTE NUMBER-DECIMALS = CNTL-DECIMAL-POS - 1.
008250     PERFORM  OPEN-ORDHF.
008260     PERFORM  OPEN-ORDLF.
008270     PERFORM  OPEN-SALEF.
008280     PERFORM  OPEN-CUSTF.
008290     PERFORM  OPEN-ITEMF.
008300*    PERFORM  OPEN-TAGMF.
008310     PERFORM LFPRF-INIT.
010710     PERFORM STRING-DETAIL-HDR.
310309     IF PROFITS-APPAREL-YES
071409*       PERFORM MUCTF-FILL-FULLPATH
071409*       OPEN INPUT  MUCTF
071409*       PERFORM READ-MUCTF
071409*       CLOSE MUCTF 
071409        OPEN INPUT SCATF
010710        OPEN INPUT COLRF
310309     END-IF.
008320     MOVE "PICKTICK" TO LFPR-FORM-TO-PRINT.
008330 BEGIN-REPORT.
062510     IF JEREMIE
062510        MOVE "SEE ROUTING GUIDE" TO CARRIERS(6).
008340*    IF PACK-FORM AND JEREMIE
008350*       MOVE "PACKSLIP" TO WS-DEVICE-NAME(1)
008360*       MOVE NORM-ATTR TO ATTR1 OF RANGE-SPEC-3(3)
008370*                         ATTR1 OF RANGE-SPEC-3(1).
008380     MOVE TODAYS-DATE TO DATE-IN.
008390     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
008400     MOVE DATE-OUT-11 TO PR-SYS-DATE-11.
008410     IF POS-PRINTING
008420        MOVE USER-POS-ORDER TO LOW-ORDHF-KEY
008430        MOVE USER-POS-SUB-ORDER TO LOW-SUB-ORDER.
008440     PERFORM SCREEN-INIT.
008450     MOVE "1001000000" TO FKEYS
008460
008470*-- INSERT LOGIC TO ASK Y/N FOR EACH COPY --*
008480     PERFORM ASK-COPIES THRU ASK-COPIES-EXIT.
008490     IF FLAG = 4 OR 3
008500        GO TO EXIT-RUN.
008510

008520**** PERFORM PREPARE-PRINT-FILE.
008530     PERFORM PROCESS-REPORT THRU PROCESS-REPORT-EXIT.
008540
008550
008560 END-REPORT.
008570     PERFORM CLOSE-FILES.
008580     MOVE "PMENU" TO NEXT-PROG.
008590
008600 EXIT-RUN.
008610     IF POS-PRINTING
008620        IF LAST-OPTION = 020702
008630           MOVE "B0025" TO NEXT-PROG
008640        ELSE
008650        IF LAST-OPTION = 020303
008660           MOVE "B0600" TO NEXT-PROG
008670        ELSE
008680           MOVE "B0000" TO NEXT-PROG.
008690
010810     IF POSTING-OPTION
010810        SET USER-PDF-INFO-NOT-PROMPTED TO TRUE
010810        REWRITE USERF-REC.

008700     COPY "FINISH.SR".
008710
008720     COPY "CONTROL.SR".
008730     COPY "DATECVT.SR".
008740     COPY "CTJULIAN.SR".
008750     COPY "DAYWEEK.SR".
008760     COPY "CENTER.SR".
008770
008780 SUBROUTINE SECTION.
008790 PGM-INIT.
008800     PERFORM CONTROL-INIT.
008810     MOVE TERM-ID TO TAG-NO, SORT-NO.
008820     MOVE "Y" TO FORM-STOCK-FLAG.
008830*    0 = NO ESCAPE, 1 = ESCAPABLE
008840     MOVE 1 TO ESC-FLAG.
008850     MOVE 40 TO SOURCE-LEN.
008860     MOVE CNTL-CONAME TO SOURCE-FIELD.
008870     PERFORM LEFT-JUST-FIELD THRU LEFT-JUST-FIELD-EXIT.
008880     MOVE DEST-FIELD TO PR-CONAME-LEFT.
008890
008900*-- NEEDED TO AUTOMATICALLY PRINT PACKSLIP FROM SM030 --*
008910*    IF LAST-OPTION = 000000 OR 020401
008920*       PERFORM GETCP-B0750-PASS-DATA
008930*       MOVE B0750-ORDER-NO TO USER-POS-ORDER
008940*       MOVE B0750-SUB-ORDER-NO TO USER-POS-SUB-ORDER
008950*       MOVE 2      TO CHAINED-FROM-CD
008960*       MOVE "P" TO RANGE-TYPE-FLAG
008970*       
008980*     DISPLAY SCR-b0200xhp-cbl-622-23
008990*     DISPLAY SCR-b0200xhp-cbl-624-23
009000*       IF B0750-FILE-CD = 1
009010*          MOVE 020101 TO LAST-OPTION
009020*       ELSE
009030*       IF B0750-FILE-CD = 2
009040*          MOVE 020204 TO LAST-OPTION.
009050     IF LAST-OPTION = 000000 OR 020401
009060        MOVE LS-ORDER-NO    TO USER-POS-ORDER
009070        MOVE ZERO           TO USER-POS-SUB-ORDER
009080        MOVE "1112222222"   TO B0750-PRINT-COPY-CODES
009090        MOVE 2              TO CHAINED-FROM-CD
009100        MOVE "P" TO RANGE-TYPE-FLAG
009110        IF LS-FILE-CD = 1
009120           MOVE 020101 TO LAST-OPTION
009130        ELSE
009140        IF LS-FILE-CD = 2
009150           MOVE 020204 TO LAST-OPTION.
009160
009170*-- NEEDED TO AUTOMATICALLY PRINT PACKSLIP FROM SM030 --*
009180     IF LAST-OPTION = 020205
009190        MOVE 3   TO CHAINED-FROM-CD
009200        MOVE "P" TO RANGE-TYPE-FLAG
009210        
009220      DISPLAY SCR-b0200xhp-cbl-635-23
009230      DISPLAY SCR-b0200xhp-cbl-637-23
009240        MOVE 020204 TO LAST-OPTION.
009250
009260     IF LAST-OPTION = 030205
009270        PERFORM GETCP-B0750-PASS-DATA
009280        MOVE 1      TO CHAINED-FROM-CD
009290        MOVE 020101 TO LAST-OPTION
009300        MOVE 1      TO WS-RESET-CD.
009310
009320     MOVE "O" TO PROCESS-ORDERS-FLAG.                             64K
009330     IF LAST-OPTION = 020101 OR 020102 OR 020303
009340        MOVE "I" TO PROCESS-ORDERS-FLAG
009350     ELSE
009360     IF LAST-OPTION = 020601 
009370        MOVE "H" TO PROCESS-ORDERS-FLAG
009380        MOVE NORM-ATTR TO ATTR1 OF RANGE-SPEC-3(1),
009390                          ATTR1 OF RANGE-SPEC-3(2)
009400     ELSE
009410     IF LAST-OPTION = 020608
009420        MOVE "M" TO PROCESS-ORDERS-FLAG.
009430
009440     IF LAST-OPTION = 020101 OR 020204 OR 020601 OR 020702 OR
009450*       020303 OR 020608
009460*       020303 OR 020608 OR 020205
009470        020303 OR 020608 
009480        MOVE "P" TO RANGE-TYPE-FLAG.
009490
009500*- IF UPS SM, TREAT AS POS --*
009510     IF LAST-OPTION = 020702
009520        MOVE "P" TO RANGE-TYPE-FLAG
009530*-- USER-ORDER-TYPE-FLAG TELLS WHICH FILE ORDER IS IN --*
009540        IF USER-INVOICING
009550           MOVE "I" TO PROCESS-ORDERS-FLAG
009560        ELSE
009570           MOVE "O" TO PROCESS-ORDERS-FLAG.
009580
009590     IF LAST-OPTION = 020703 OR 020702 OR FROM-SM030
009600        MOVE 2  TO FORM-TYPE-FLAG
009610     ELSE MOVE 1 TO FORM-TYPE-FLAG.
009620     IF MFGEQUIP
009630        MOVE 2 TO FORM-TYPE-FLAG.
009640
009650     IF PICK-FORM
009660        MOVE "PICKTICK" TO QUEUE-DEFAULT-NAME
009670     ELSE
009680        MOVE "PACKSLIP" TO QUEUE-DEFAULT-NAME.
009690
009700     IF PROCESS-OPEN-ORDERS
009710         MOVE 8 TO FLEN OF RANGE-SPEC-1(1)
009720         MOVE "OPENHDR.FIL" TO EXT-HDR-FILE
009730         MOVE "OPENLINE.FIL" TO EXT-LIN-FILE
009740     ELSE
009750     IF PROCESS-INVOICES
009760         MOVE "ORDERH.FIL" TO EXT-HDR-FILE
009770         MOVE "ORDERL.FIL" TO EXT-LIN-FILE
009780     ELSE
009790     IF PROCESS-HISTORY
009800         MOVE "ORDHSTH.FIL" TO EXT-HDR-FILE
009810         MOVE "ORDHSTL.FIL" TO EXT-LIN-FILE
009820     ELSE
009830     IF MXFR-HISTORY
009840         MOVE "MXFRHSTH.FIL" TO EXT-HDR-FILE
009850         MOVE "MXFRHSTL.FIL" TO EXT-LIN-FILE.
009860
009870     MOVE EXT-LIN-FILE TO ORDLF--NAME
009880      PERFORM ORDLF-FILL-FULLPATH.
009890     PERFORM CALL-ASSIGN-HDR.
009900     IF POST-BY-BATCH-BOTH OR
009910        (POST-BY-BATCH-NEW AND PROCESS-INVOICES) OR
009920        (POST-BY-BATCH-OPEN AND PROCESS-OPEN-ORDERS)
009930           NEXT SENTENCE
009940     ELSE
009950        MOVE SPACES TO BY-BATCH.
009960
009970*    MOVE SPACES  TO ON-SCREEN.
009980*    MOVE "FaxWare" TO EZFAX. 
009990*    MOVE 4    TO WS-DEFAULT-CODES.
010000     MOVE ZERO TO COPIES-PRINTED.
010010
010020*- Read Form Control Record --*
010030*    MOVE 14 TO CNTLF-KEY.
010040*    PERFORM READ-LASER-CNTLF-REC.
010050*    CLOSE CNTLF.
010060*    OPEN I-O CNTLF.
010070*    MOVE 1 TO CNTLF-KEY.
010080*    PERFORM READ-CNTLF.
010090
010100*-- NEEDED UNTIL LFPR FINISHED --*
010110*    MOVE 14 TO CNTLF-KEY.
010120*    PERFORM READ-LASER-CNTLF-REC.
010130
010140
010150     COPY "SCRNINIT.SR".
010160     COPY "STRGFAX.SR".
010170     COPY "MSGBOX.SR".
010180
010190 CALL-ASSIGN-HDR.
010200     MOVE EXT-HDR-FILE TO ORDHF--NAME
010210      PERFORM ORDHF-FILL-FULLPATH.
010220
010230 GET-BATCH-NO.
010240     DISPLAY SCR-b0200xhp-cbl-728-20  .
010250     MOVE "1010000000" TO FKEYS.
010260     MOVE 0 TO FLAG.
010270     PERFORM STEST-b0200xhp-cbl-731
010280     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
010290      BATCH-HELP,
010300          USER-BATCH-NO
010310     PERFORM STEST-AFTER-CALL.
010320     IF USER-BATCH-NO = ZERO AND FLAG NOT = 3
010330        DISPLAY SCR-b0200xhp-cbl-734-23
010340              
010350        GO TO GET-BATCH-NO.
010360
010370 MOVE-204-DETAIL.
010380     MOVE SPACES TO DETAIL-LINE.
010390     MOVE WS-PRINT-QTY TO PR-204-ORDER-QTY.
010400     MOVE ORDL-SHIP-QTY TO PR-204-SHIP-QTY.
010410     MOVE ORDL-BO-QTY   TO PR-204-BO-QTY.
010420     MOVE ORDL-ITEM-DESC TO PR-204-ITEM-DESC.
010430     IF NOT COMMENT
010440        MOVE ORDL-ITEM-BIN TO PR-204-ITEM-BIN
010450        MOVE ORDL-ITEM-NO  TO PR-204-ITEM-NO
010460        MOVE ORDL-ITEM-UOM TO PR-204-ITEM-UOM.
010910     IF JEREMIE AND PR-FORM-TYPE = "PICKING TICKET"
010910        MOVE ZEROES    TO PR-204-SHIP-QTY,
010910                          PR-204-BO-QTY.
DEBUG *     MOVE 123456  TO PR-204-SHIP-QTY, PR-204-BO-QTY.
010470
010480 CHAINR-PROG.
010490     PERFORM CHNR--PARM-BLOCK-DOS-RET-CODE.
010500
010510*    COPY "COPYFILE.SR".
010520     COPY "COPYFIL2.SR".
010530
010540 PREPARE-PRINT-FILE.
010550     ADD 1 TO COPIES-PRINTED.
010560     PERFORM LFPR-PREPARE-PRINT-NEXT.
010580     IF NOT LFPR-NO-MORE-COPY
010600        IF LFPR-DONTPRINT-THIS-COPY
010610           GO TO PREPARE-PRINT-FILE.
010630     IF NOT LFPR-NO-MORE-COPY
010640        MOVE 9 TO USER-PTR-CHN
010650        PERFORM OPEN-LO-LASER.
010690
011640
010910 GET-COMMENTS-SHIPPING.
010910     MOVE ORDH-SHIP-COMMENT-1 TO PR-SHIP-COMMENT-1.
010910     MOVE ORDH-SHIP-COMMENT-2 TO PR-SHIP-COMMENT-2.
010910     MOVE ORDH-SHIP-COMMENT-3 TO PR-SHIP-COMMENT-3.

030310     IF STARSHIP
030310        PERFORM MOVE-STARSHIP-DATA
030310     ELSE
030310        MOVE SPACES TO PR-CARRIER, PR-COD, PR-SAT.

010710 STRING-DETAIL-HDR.
010710     MOVE SPACES TO PR-DETAIL-HDR.
010910     IF JEREMIE
010910        STRING " LOC.  "         DELIMITED BY SIZE
010910               "ITEM NUMBER   "  DELIMITED BY SIZE
010910               " DESCRIPTION"    DELIMITED BY SIZE
010910               "         "       DELIMITED BY SIZE
010910               "  UOM  "         DELIMITED BY SIZE
010910               "ORDERED    "     DELIMITED BY SIZE
010910               "SHIPPED "        DELIMITED BY SIZE
010910               "      B/O"       DELIMITED BY SIZE
010910               INTO PR-DETAIL-HDR
010910     ELSE
010710     IF PROFITS-APPAREL-YES
010710        STRING "ORDERED"         DELIMITED BY SIZE
010710               "    SHIPPED"     DELIMITED BY SIZE
010710               "     B/O  "      DELIMITED BY SIZE
010710               " STYLE  "        DELIMITED BY SIZE
010710               "COLOR   "        DELIMITED BY SIZE
010710               "SIZE"            DELIMITED BY SIZE
010710               " CATEGORY"       DELIMITED BY SIZE
010710               " DESCRIPTION"    DELIMITED BY SIZE
010710               "   "             DELIMITED BY SIZE
010710*              "BIN LOC"         DELIMITED BY SIZE
010710               INTO PR-DETAIL-HDR
010710     ELSE
010710        STRING "ORDERED"         DELIMITED BY SIZE
010710               "     SHIPPED"    DELIMITED BY SIZE
010710               "     B/O  "      DELIMITED BY SIZE
010710               "ITEM NUMBER"     DELIMITED BY SIZE
010710               " DESCRIPTION"    DELIMITED BY SIZE
010710               "           "     DELIMITED BY SIZE
010710               " LOCATION "      DELIMITED BY SIZE
010710               "WEIGHT"          DELIMITED BY SIZE
010710               INTO PR-DETAIL-HDR.

030310 MOVE-STARSHIP-DATA.
010910*-- PRINT STARSHIP INFO AT TOP RIGHT OF FORM --*
010910     IF ORDH-CARRIER = 1
010910        MOVE UPS-DOM-SERVICE(ORDH-SERVICE) TO WS-SERVICE
010910     ELSE
010910     IF ORDH-CARRIER = 2
010910        MOVE "Ground"                      TO WS-SERVICE
010910     ELSE
010910     IF ORDH-CARRIER = 3
010910        MOVE FDX-DOM-SERVICE(ORDH-SERVICE) TO WS-SERVICE
010910     ELSE
010910     IF ORDH-CARRIER = 4
010910        MOVE USM-DOM-SERVICE-CODE(ORDH-SERVICE) TO WS-SERVICE
010910     ELSE
010910        MOVE SPACES TO WS-SERVICE.
06
010910     STRING 
010910            "Carrier: "        DELIMITED BY SIZE
010910            CARRIERS(ORDH-CARRIER) DELIMITED BY "  "
010910            " - "              DELIMITED BY "  "
010910            WS-SERVICE         DELIMITED BY "  "
010910            INTO PR-CARRIER.
010910 
010910     STRING 
010910            "COD: "            DELIMITED BY SIZE
010910            COD-CHOICE(ORDH-COD) DELIMITED BY SIZE
010910            "      "                    DELIMITED BY SIZE
010910            B-R-CHOICE(ORDH-RESIDENTIAL) DELIMITED BY SIZE
010910            INTO PR-COD.
010910 
010910     STRING 
010910            "SatDel: "           DELIMITED BY "  "
010910            YES-NO-OPT(ORDH-SAT) DELIMITED BY SIZE
010910            "     Signature Req: "   DELIMITED BY SIZE
010910            YES-NO-OPT(ORDH-SIGNATURE-REQ) DELIMITED BY SIZE
010910            INTO PR-SAT.
010910
011650 SUBROUTINE-EXIT. EXIT.
011660
011670******************************************************************
011680 PRINT-FORM SECTION.
011690******************************************************************
011700
011710     COPY "LASRHDR.SR" REPLACING LASER-IO-FORM BY PICK201.
011720
011730 PRINT-HEADER-INFO.
011740*-- SET CAP (CURRENT ACTIVE POSITION) TO 0,0 --*
011750*    WRITE PRINT-REC FROM HP-SET-MARGIN BEFORE ZERO.
011760
011770*    IF COPIES-PRINTED = 10 AND FAX-A-COPY-YES
011780*       PERFORM STRING-FAX-TAG-LINE
011790*       WRITE PRINT-REC BEFORE ADVANCING 1. 
011800*    IF USE-FAX AND NEED-HARD-COPY-YES
011810*    IF COPIES-PRINTED = 10 AND FAX-A-COPY-YES
011820*       MOVE SPACES TO PRINT-REC
011830*       STRING "@@SETFORM 3 "              DELIMITED BY SIZE
011840*              WS-FORM-FILENAME            DELIMITED BY SPACE
011850*              "@@ "                       DELIMITED BY SIZE
011860*              "@@FORM 3@@"                DELIMITED BY SIZE
011870*              INTO PRINT-REC
011880*       INSPECT PRINT-REC REPLACING FIRST ".MAC" BY ".PCX"
011890*       WRITE PRINT-REC BEFORE ZERO.
011900*    IF FAX-A-COPY-YES AND NEED-HARD-COPY-YES AND
011910*       COPIES-PRINTED = 10
011920*         MOVE "@@PROTOCOL 1@@" TO PRINT-REC
011930*         WRITE PRINT-REC BEFORE ZERO.
011940
011950*-- Print ORDER Date and ORDER NO. --*
011960*    MOVE 0500 TO VERT-POS.
011970*    MOVE 3600 TO HORZ-POS.
011980*    MOVE 16   TO POINT-SIZE.
011990*    MOVE 1690 TO FONT-NUMBER.
012000*    MOVE SPACES TO PRINT-REC.
012010*    STRING HP-SYMBOL-SET    DELIMITED BY SIZE,
012020*           HP-FONT          DELIMITED BY SIZE,
012030*           HP-UPRIGHT       DELIMITED BY SIZE,
012040*           HP-MEDIUM        DELIMITED BY SIZE,
012050*           HP-PORPORTIONAL  DELIMITED BY SIZE,
012060*           HP-VERT-POSITION DELIMITED BY SIZE,
012070*           HP-HORZ-POSITION DELIMITED BY SIZE,
012080*           HP-POINT-SIZE    DELIMITED BY SIZE,
012090*           PR-SYS-DATE-11   DELIMITED BY SIZE,
012100*           INTO PRINT-REC.
012110*    WRITE PRINT-REC BEFORE 0.
012120     MOVE PR-SYS-DATE-11 TO PR-DATE-11.
012130     IF MFGEQUIP
012140        MOVE SPACES TO PR-DATE-11.
012150
012160     MOVE ORDH-ORDER-NO TO PR-ORDER-NO.
012170     IF ORDH-SUB-ORDER-NO > ZERO
012180*       MOVE 4760 TO HORZ-POS
012190        MOVE "-" TO PR-ORDER-DASH
012200        MOVE ORDH-SUB-ORDER-NO TO PR-ORDER-SUB
012210     ELSE
012220        MOVE " "  TO PR-ORDER-DASH
012230        MOVE ZERO TO PR-ORDER-SUB.
012240     MOVE PR-ORDER-NUMBER TO PR-PT-NO.
012250
012260     STRING ORDH-ORDER-NO DELIMITED BY SIZE
012270           INTO PR-ORDER-BAR.
012280
012290*-- Print Name of Form --*
012300     IF DUPLICATE-ORDER
012310        MOVE "MATERIAL TRANSFER" TO PR-FORM-TYPE
012320     ELSE
012330     IF RGA-TYPE
012340        MOVE "Return Goods Ticket" TO PR-FORM-TYPE
012350     ELSE
012360     IF PICK-FORM
012370        MOVE "PICKING TICKET"  TO PR-FORM-TYPE
012380     ELSE
012390        MOVE " PACKING LIST "  TO PR-FORM-TYPE.
012400
051309     IF SUNBELTS
051309        MOVE " PACKING LIST "  TO PR-FORM-TYPE.
012410
030310     MOVE ORDH-CUST-NO TO CUST-NUMBER.
030310     PERFORM READ-CUSTF.
030310     MOVE SPACES TO PR-CUST-PHONE.
030310     STRING  "("               DELIMITED BY SIZE
030310             CUST-PHONE(1:3)   DELIMITED BY SIZE
                   ")"               DELIMITED BY SIZE
030310             CUST-PHONE(4:3)   DELIMITED BY SIZE
030310             "-"               DELIMITED BY SIZE
030310             CUST-PHONE(7:4)   DELIMITED BY SIZE
030310             INTO PR-CUST-PHONE. 

012420*-- Print Sold To/Ship To Address LInes --*
012430*    MOVE 1400 TO VERT-POS.
012440*    MOVE 1600 TO VERT-POS.
012450*    MOVE 0500 TO HORZ-POS.
012460*    MOVE 12   TO POINT-SIZE.
012470*    MOVE SPACES TO PRINT-REC.
012480*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
012490*           HP-HORZ-POSITION DELIMITED BY SIZE,
012500*           HP-POINT-SIZE    DELIMITED BY SIZE,
012510*           ORDH-CUST-NAME   DELIMITED BY SIZE,
012520*           INTO PRINT-REC.
012530*    WRITE PRINT-REC BEFORE 0.
012540     MOVE ORDH-CUST-NAME TO PR-CUST-NAME.
012550*    MOVE 3070 TO HORZ-POS.
012560*    MOVE SPACES TO PRINT-REC.
012570*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
012580*           ORDH-SHIP-NAME   DELIMITED BY SIZE,
012590*           INTO PRINT-REC.
012600*    WRITE PRINT-REC BEFORE 1.
012610     MOVE ORDH-SHIP-NAME TO PR-SHIP-NAME.
012620
012630*    MOVE 0500 TO HORZ-POS.
012640*    MOVE SPACES TO PRINT-REC.
012650*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
012660*           ORDH-CUST-ADDR1  DELIMITED BY SIZE,
012670*           INTO PRINT-REC.
012680*    WRITE PRINT-REC BEFORE 0.
012690     MOVE ORDH-CUST-ADDR1 TO PR-CUST-ADDR1.
012700*    MOVE 3070 TO HORZ-POS.
012710*    MOVE SPACES TO PRINT-REC.
012720*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
012730*           ORDH-SHIP-ADDR1  DELIMITED BY SIZE,
012740*           INTO PRINT-REC.
012750*    WRITE PRINT-REC BEFORE 1.
012760     MOVE ORDH-SHIP-ADDR1 TO PR-SHIP-ADDR1.
012770
012780*    MOVE 0500 TO HORZ-POS.
012790*    MOVE SPACES TO PRINT-REC.
012800*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
012810*           ORDH-CUST-ADDR2  DELIMITED BY SIZE,
012820*           INTO PRINT-REC.
012830*    WRITE PRINT-REC BEFORE 0.
012840     MOVE ORDH-CUST-ADDR2 TO PR-CUST-ADDR2.
012850*    MOVE 3070 TO HORZ-POS.
012860*    MOVE SPACES TO PRINT-REC.
012870*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
012880*           ORDH-SHIP-ADDR2  DELIMITED BY SIZE,
012890*           INTO PRINT-REC.
012900*    WRITE PRINT-REC BEFORE 1.
012910     MOVE ORDH-SHIP-ADDR2 TO PR-SHIP-ADDR2.
012920
012930*    MOVE 0500 TO HORZ-POS.
012940*    MOVE SPACES TO PRINT-REC.
012950*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
012960     STRING 
012970            ORDH-CUST-CITY   DELIMITED BY "  ",
012980            ", "           DELIMITED BY SIZE,
012990            ORDH-CUST-STATE  DELIMITED BY SIZE,
013000            "  "          DELIMITED BY SIZE,
013010            ORDH-CUST-ZIP    DELIMITED BY SIZE
013020*           INTO PRINT-REC.
013030            SPACES DELIMITED BY SIZE
013040            INTO PR-CUST-CSZ.
013050*    WRITE PRINT-REC BEFORE 0.
013060*    MOVE 3070 TO HORZ-POS.
013070*    MOVE SPACES TO PRINT-REC.
013080*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
013090     STRING 
013100            ORDH-SHIP-CITY   DELIMITED BY "  ",
013110            ", "           DELIMITED BY SIZE,
013120            ORDH-SHIP-STATE  DELIMITED BY SIZE,
013130            "  "          DELIMITED BY SIZE,
013140            ORDH-SHIP-ZIP    DELIMITED BY SIZE
013150*           INTO PRINT-REC.
013160            SPACES DELIMITED BY SIZE
013170            INTO PR-SHIP-CSZ.
013180     IF ORDH-SHIP-CITY = SPACES
013190*       MOVE SPACES TO PRINT-REC.
013200        MOVE SPACES TO PR-SHIP-CSZ.
013210*    WRITE PRINT-REC BEFORE 1.
013220
010910     PERFORM GET-COMMENTS-SHIPPING.
013230*-- Print ** Revised ** Line --*
013240*    MOVE 2400 TO VERT-POS.
013250*    MOVE 1900 TO HORZ-POS.
013260*    MOVE 1200 TO VERT-POS.
013270*    MOVE 4000 TO HORZ-POS.
013280*    MOVE SPACES TO PRINT-REC.
013290*    STRING HP-VERT-POSITION   DELIMITED BY SIZE,
013300*           HP-HORZ-POSITION   DELIMITED BY SIZE,
013310*           HP-POINT-SIZE      DELIMITED BY SIZE,
013320*           HP-BOLD            DELIMITED BY SIZE,
013330*           "* *  REVISED * *" DELIMITED BY SIZE,
013340*           INTO PRINT-REC.
013350     IF ORDH-PICK-TICK-PRINTED-CD > 3
013360*       WRITE PRINT-REC BEFORE 0.
013370        MOVE "* *  REVISED * *" TO PR-IS-REVISED
013380     ELSE
013390        MOVE SPACES TO PR-IS-REVISED
013400     END-IF.
013410
013420
013520     IF JEREMIE
013530        NEXT SENTENCE
013540     ELSE
013550     IF ORDH-JOB-NUM NOT = SPACES
013560*       WRITE PRINT-REC BEFORE 0.
013570        MOVE ORDH-JOB-NUM TO PR-JOB-NUM
013580     ELSE
013590        MOVE SPACES TO PR-JOB-NUM
013600     END-IF.
013610
013620*-- Print First Line of Header Info --*
013630*    MOVE 2730 TO VERT-POS.
013640*    MOVE 2720 TO VERT-POS.
013650*    IF JEREMIE
013660*       ADD 30 TO VERT-POS.
013670*    MOVE 0090 TO HORZ-POS.
013680*    MOVE 10   TO POINT-SIZE.
013690*    MOVE SPACES TO PRINT-REC.
013700*    STRING HP-VERT-HORZ-POINT DELIMITED BY SIZE
013710*           HP-MEDIUM        DELIMITED BY SIZE,
013720*           ORDH-CUST-NO     DELIMITED BY SIZE,
013730*           INTO PRINT-REC.
013740*    WRITE PRINT-REC BEFORE 0.
013750     MOVE ORDH-CUST-NO TO PR-CUST-NO.
013760
013770*    MOVE 0810 TO HORZ-POS.
013780*    MOVE SPACES TO PRINT-REC.
013790*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
013800*           ORDH-PO-NUM      DELIMITED BY SIZE,
013810*           INTO PRINT-REC.
013820*    WRITE PRINT-REC BEFORE 0.
013830     MOVE ORDH-PO-NUM TO PR-PO-NUM.
013840
013850     MOVE ORDH-ORD-DATE TO DATE-IN.
013860     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
013870*    MOVE 2000 TO HORZ-POS.
013880*    MOVE SPACES TO PRINT-REC.
013890*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
013900*           DATE-OUT-11      DELIMITED BY SIZE,
013910*           INTO PRINT-REC.
013920*    WRITE PRINT-REC BEFORE 0.
013930     MOVE DATE-OUT-11 TO PR-ORD-DATE.
013940
013950     MOVE ORDH-SHIP-DATE TO DATE-IN.
013960     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
013970*    MOVE 2760 TO HORZ-POS.
013980*    MOVE SPACES TO PRINT-REC.
013990*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014000*           DATE-OUT-11      DELIMITED BY SIZE,
014010*           INTO PRINT-REC.
014020*    WRITE PRINT-REC BEFORE 0.
014030     MOVE DATE-OUT-11 TO PR-SHIP-DATE.
014040
014050     MOVE ORDH-BEGIN-SHIP-DATE TO DATE-IN.
014060     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
014070*    MOVE 3500 TO HORZ-POS.
014080*    MOVE SPACES TO PRINT-REC.
014090*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014100*           DATE-OUT-11      DELIMITED BY SIZE,
014110*           INTO PRINT-REC.
014120*    WRITE PRINT-REC BEFORE 0.
014130     MOVE DATE-OUT-11 TO PR-BEGIN-SHIP-DATE.
014140
014150     IF ORDH-SLSMN-NO NOT = SLSMN-NUMBER
014160        MOVE ORDH-SLSMN-NO TO SLSMN-NUMBER
014170        PERFORM READ-SALEF.
014180     MOVE ORDH-SLSMN-NO TO PR-SLSMN-NO.
014190     MOVE SLSMN-NAME    TO PR-SLSMN-NAME.
014200*    MOVE 4200 TO HORZ-POS.
014210*    MOVE SPACES TO PRINT-REC.
014220*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014230*           PR-SALESMAN      DELIMITED BY SIZE,
014240*           INTO PRINT-REC.
014250*    WRITE PRINT-REC BEFORE 2.
014260     MOVE PR-SALESMAN TO PR-SALESPERSON.
014270
014280*-- Print Second Line of Header Info --*
014290     MOVE ORDH-CANCEL-DATE TO DATE-IN.
014300     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
014310*    MOVE DATE-OUT-11  TO WS-TEMP-11.
014320*    MOVE 0150 TO HORZ-POS.
014330*    MOVE SPACES TO PRINT-REC.
014340*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014350*           WS-TEMP-11       DELIMITED BY SIZE,
014360*           INTO PRINT-REC.
014370*    WRITE PRINT-REC BEFORE 0.
014380     MOVE DATE-OUT-11 TO PR-CANCEL-DATE.
014390
014400*    MOVE 1300 TO HORZ-POS.
014410*    MOVE 1000 TO HORZ-POS.
014420*    MOVE SPACES TO PRINT-REC.
014430*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014440*           ORDH-SHIP-INST   DELIMITED BY SIZE,
014450*           INTO PRINT-REC.
014460*    WRITE PRINT-REC BEFORE 0.
014470     MOVE ORDH-SHIP-INST TO PR-SHIP-INST.
014480
014490*    MOVE 3450 TO HORZ-POS.
014500*    MOVE SPACES TO PRINT-REC.
014510*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014520*           ORDH-VENDOR      DELIMITED BY SIZE,
014530*           INTO PRINT-REC.
014540*    IF NOT JEREMIE
014550*       WRITE PRINT-REC BEFORE 0.
014560     MOVE ORDH-VENDOR TO PR-VENDOR
014570
014580*    MOVE 4300 TO HORZ-POS.
014590*    MOVE SPACES TO PRINT-REC.
014600*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014610*           ORDH-CLASS       DELIMITED BY SIZE,
014620*           INTO PRINT-REC.
014630*    IF NOT JEREMIE
014640*       WRITE PRINT-REC BEFORE 0.
014650     MOVE ORDH-CLASS TO PR-CLASS
014660
014670
014680*    MOVE 5075 TO HORZ-POS.
014690*    MOVE SPACES TO PRINT-REC.
014700*    STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014710*           ORDH-DEPT        DELIMITED BY SIZE,
014720*           INTO PRINT-REC.
014730*    IF NOT JEREMIE
014740*       WRITE PRINT-REC BEFORE 1.
014750     MOVE ORDH-DEPT TO PR-DEPT
014760
014770*    IF JEREMIE
014780*       MOVE 3200 TO HORZ-POS
014790*       MOVE SPACES TO PRINT-REC
014800*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014810*              ORDH-VENDOR      DELIMITED BY SIZE,
014820*              INTO PRINT-REC
014830*       WRITE PRINT-REC BEFORE 0
014840*       MOVE 4000 TO HORZ-POS
014850*       MOVE SPACES TO PRINT-REC
014860*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014870*              ORDH-CLASS       DELIMITED BY SIZE,
014880*              INTO PRINT-REC
014890*       WRITE PRINT-REC BEFORE 0
014900*       MOVE 4450 TO HORZ-POS
014910*       MOVE SPACES TO PRINT-REC
014920*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014930*              ORDH-DEPT        DELIMITED BY SIZE,
014940*              INTO PRINT-REC
014950*       WRITE PRINT-REC BEFORE 0
014960*       MOVE 5250 TO HORZ-POS
014970*       MOVE SPACES TO PRINT-REC
014980*       STRING HP-HORZ-POSITION DELIMITED BY SIZE,
014990*              ORDH-PACKER-NO   DELIMITED BY SIZE,
015000*              INTO PRINT-REC
015010*       WRITE PRINT-REC BEFORE 1.
015020     MOVE ORDH-PACKER-NO TO PR-PACKER-NO
015030*    MOVE "WMARK" TO PFRPT-GROUP.
010910     IF JEREMIE
010910        MOVE "C/S"      TO PR-VENDOR-HDR
010910        MOVE "PULLER"   TO PR-CLASS-HDR
010910        MOVE "INSPECTOR" TO PR-DEPT-HDR
010910        MOVE "PACKER"    TO PR-PACKER-HDR
010910     ELSE
010710        MOVE "VENDOR"   TO PR-VENDOR-HDR
010710        MOVE "CLASS"    TO PR-CLASS-HDR
010710        MOVE "DEPT."    TO PR-DEPT-HDR.
015040*    WRITE PICK201.
015050     MOVE "HEAD" TO PFRPT-GROUP.
015060     WRITE PICK201 AFTER ADVANCING 0 LINES.
015070         
015080
015090 SETUP-FOR-DETAIL-LINES.
015100*    MOVE 3230 TO VERT-POS.
015110*    MOVE 3100 TO VERT-POS.
015120*    MOVE 0090 TO HORZ-POS.
015130
015140*-- FORM 204 REQUIRES HP5 OR GREATER, USES SCALEABLE COURIER FONT --*
015150*    IF WS-FORM-ID = 204 OR WS-FORM-FILENAME = "PICK204.MAC"
015160*       MOVE 4099 TO FONT-NUMBER
015170*       MOVE 8.5  TO POINT-SIZE
015180*       MOVE 11.00 TO PITCH-SIZE
015190*    ELSE
015200*       MOVE 0    TO FONT-NUMBER
015210*       MOVE 8.5  TO POINT-SIZE
015220*       MOVE 16.67 TO PITCH-SIZE.
015230*    IF ATHENS OR JEREMIE
015240*       MOVE 4099 TO FONT-NUMBER
015250*       MOVE 8.5  TO POINT-SIZE
015260*       MOVE 11.00 TO PITCH-SIZE.
015270*    MOVE SPACES TO PRINT-REC
015280*    STRING HP-VERT-POSITION  DELIMITED BY SIZE
015290*           HP-HORZ-POSITION DELIMITED BY SIZE,
015300*           HP-SYMBOL-SET    DELIMITED BY SIZE,
015310*           HP-FONT          DELIMITED BY SIZE,
015320*           HP-UPRIGHT       DELIMITED BY SIZE,
015330*           HP-FIXED         DELIMITED BY SIZE,
015340*           HP-PITCH-SIZE    DELIMITED BY SIZE
015350*           HP-POINT-SIZE    DELIMITED BY SIZE
015360*           HP-MEDIUM        DELIMITED BY SIZE
015370*           HP-8-LPI         DELIMITED BY SIZE
015380*           INTO PRINT-REC
015390*    WRITE PRINT-REC BEFORE 1.
015400
015410 PRINT-TOTALS.
015560
015570     MOVE ORDH-SHIP-DATE TO DATE-IN.
015580     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
015590     PERFORM COMPUTE-DAY-OF-WEEK THRU COMPUTE-DAY-OF-WEEK-EXIT.
015650     STRING  
015680            "Ship Date  "    DELIMITED BY SIZE,
015690            ALPHA-DAY(WS-DAY-OF-WEEK)  DELIMITED BY SIZE,
015700            "  "             DELIMITED BY SIZE
015710            DATE-OUT-11      DELIMITED BY SIZE
015730            SPACES DELIMITED BY SIZE
015740            INTO PR-TAIL-SHIP-DATE.
015770     IF JEREMIE OR MFGEQUIP
015780        MOVE SPACES TO PR-TAIL-SHIP-DATE.
015790
015800     MOVE TS-WEIGHT TO PR-TOT-WEIGHT.
015830     IF JEREMIE
015840        MOVE ZERO TO PR-TAIL-TOT-WEIGHT
010910        MOVE SPACES TO PR-TOT-WEIGHT-HDR
010910        MOVE "Thank you... Jeremie" TO PR-THANKYOU
015850     ELSE
010910        MOVE SPACES        TO PR-THANKYOU
015860        MOVE PR-TOT-WEIGHT TO PR-TAIL-TOT-WEIGHT.
015870
010910     IF JEREMIE
010910         STRING "Items not shipped, totaling less than $50, "
                      "will not be backordered.  Defective or "
                      X"0A"
                      "short-shipped orders must be reported to "
                      "Customer Service within ten (10) days of "
                      X"0A"
                      "receipt of shipment or credit will not be "
                      "honored." DELIMITED BY SIZE
                      INTO PR-JEREMIE-TERMS OF PICK201.

015880*-- JEREMIE THANKYOU MSG  --*
015890*    IF JEREMIE
015900*       MOVE 6900 TO VERT-POS
015910*       MOVE 3500 TO HORZ-POS
015920*       MOVE SPACES TO PRINT-REC
015930*       STRING HP-VERT-POSITION DELIMITED BY SIZE,
015940*             HP-HORZ-POSITION DELIMITED BY SIZE,
015950*             "THANK YOU...  "        DELIMITED BY SIZE,
015960*             "JEREMIE"               DELIMITED BY SIZE,
015970*              INTO PRINT-REC
015980*       WRITE PRINT-REC BEFORE ADVANCING 1
015990        IF ORDH-FRT-DISC-PCT NOT = ZERO
016000           MOVE "** QUALIFIES FOR FREIGHT DISCOUNT **" 
016010             TO PR-FRT-DISC-PCT
016020        ELSE
016030           MOVE SPACES TO PR-FRT-DISC-PCT
016040        ENd-IF.
016050*          MOVE 6900 TO VERT-POS
016060*          MOVE 0600 TO HORZ-POS
016070*          MOVE SPACES TO PRINT-REC
016080*          STRING HP-VERT-POSITION DELIMITED BY SIZE,
016090*                HP-HORZ-POSITION DELIMITED BY SIZE,
016100*                HP-BOLD          DELIMITED BY SIZE
016110*                "** QUALIFIES FOR "     DELIMITED BY SIZE,
016120*                "FREIGHT DISCOUNT **"   DELIMITED BY SIZE,
016130*                HP-MEDIUM              DELIMITED BY SIZE
016140*                INTO PRINT-REC
016150*          WRITE PRINT-REC BEFORE ADVANCING 1.
016160   
016170*       IF ORDH-CC-ORDER AND JEREMIE
016180*          MOVE SPACES TO PRINT-REC
016190*          MOVE 1200 TO HORZ-POS
016200*          MOVE 12    TO POINT-SIZE
016210*          STRING HP-MEDIUM        DELIMITED BY SIZE
016220*                 HP-HORZ-POSITION DELIMITED BY SIZE,
016230*                 HP-POINT-SIZE    DELIMITED BY SIZE,
016240*                 HP-ITALIC        DELIMITED BY SIZE
016250*                 CC-CARD-TYPE     DELIMITED BY "  "
016260*                 " # "            DELIMITED BY SIZE
016270*                 CC-NO            DELIMITED BY "  "
016280*                 " / VC "         DELIMITED BY SIZE 
016290*                 CC-VCODE         DELIMITED BY SIZE
016300*                 " /Expires "     DELIMITED BY SIZE
016310*                 CC-EXPIRE        DELIMITED BY SIZE
016320*                 HP-UPRIGHT       DELIMITED BY SIZE
016330*                 INTO PRINT-REC
016340*          WRITE PRINT-REC BEFORE ADVANCING 1.
016350  
016360*    MOVE SPACES TO PRINT-REC.
016370*    MOVE 0600 TO HORZ-POS.
016380*    MOVE 10    TO POINT-SIZE.
016390*    STRING HP-HORZ-POSITION       DELIMITED BY SIZE,
016400     STRING 
016410*           HP-POINT-SIZE          DELIMITED BY SIZE,
016420*           HP-ITALIC              DELIMITED BY SIZE
016430            ORDH-ORDER-COMMENT-1   DELIMITED BY SIZE
016440            " / "                  DELIMITED BY SIZE
016450            ORDH-ORDER-COMMENT-2   DELIMITED BY SIZE
016460            " / "                  DELIMITED BY SIZE
016470            ORDH-ORDER-COMMENT-3   DELIMITED BY SIZE
016480*           HP-UPRIGHT             DELIMITED BY SIZE
016490*           INTO PRINT-REC.
016500            SPACES DELIMITED BY SIZE
016510            INTO PR-ORDER-COMMENT.
016520*    WRITE PRINT-REC BEFORE ADVANCING 1.
016530
016540*-- Print CODE 3OF9 BARCODE - F9 --*
016550*    MOVE 7360 TO VERT-POS.
016560*    MOVE 4300 TO HORZ-POS.
016570*    MOVE SPACES TO PRINT-REC.
016580*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
016590*     STRING 
016600*           HP-HORZ-POSITION DELIMITED BY SIZE,
016610*           SET-BARCODE-ON          DELIMITED BY SIZE,
016620*           "{"                     DELIMITED BY SIZE,
016630*           "QXW"                   DELIMITED BY SIZE,
016640*           "}"                     DELIMITED BY SIZE,
016650*           INTO PRINT-REC.
016660     MOVE  "QXW" TO PR-END-ORDER-BAR.
016670*    IF ATHENS
016680*       NEXT SENTENCE
016690*    ELSE
016700*       WRITE PRINT-REC BEFORE ADVANCING 0
016710*       INSPECT PRINT-REC REPLACING ALL "7360" BY "7430"
016720*       WRITE PRINT-REC BEFORE ADVANCING 0.
016730
016740         
016750
016760 PRINT-FORM-EXIT. EXIT.
016770
016780******************************************************************
016790 PROCESS-REPORT SECTION.
016800******************************************************************
016810 PROCESS-REPORT-BEGIN.
016820     PERFORM RANGE-SELECT THRU RANGE-SELECT-EXIT.
016830     MOVE 1 TO FLAG.
016840     CALL "KBDCHK" USING FLAG, FKEYS.
016850     MOVE 0 TO FLAG.
016860     MOVE LOW-ORDHF-KEY TO ORDHF-KEY.
016870*    IF USE-FAX AND (NOT POS-PRINTING AND NOT SELECTIVE-PRINTING)
016880*    IF FAX-A-COPY-YES
016890*       IF (NOT POS-PRINTING AND NOT SELECTIVE-PRINTING)
016900*          MOVE 1 TO WS-FAX-ASK-CD     
016910*          MOVE 1  TO PRINT-TYPE-FLAG
016920*          MOVE SPACES TO ORDH-CUST-NO
016930*          PERFORM GET-FAX-INFO THRU GET-FAX-INFO-EXIT
016940*          MOVE 2 TO WS-FAX-ASK-CD     
016950*          PERFORM SCREEN-INIT
016960*          IF RETURN-FLAG = 3
016970*             MOVE 3 TO FLAG
016980*             GO TO PROCESS-REPORT-EXIT.
016990
017000     IF SELECTIVE-PRINTING
017010        GO TO PROCESS-REPORT-READ
017020     ELSE
017030     IF POS-PRINTING
017040        PERFORM READ-ORDHF
017050        GO TO PROCESS-REPORT-NEXT
017060     ELSE
017070     IF PRINT-IN-NAME-SEQUENCE
017080        PERFORM START-ORDHF-NAME
017090     ELSE
017100     IF BY-SALESMAN-PRINTING
017110        MOVE LOW-VALUES TO ORDHF-KEY
017120        PERFORM START-ORDHF
017130     ELSE
017140        MOVE LOW-ORDHF-KEY TO ORDHF-KEY
017150        PERFORM START-ORDHF.
017160
017170     IF C-AT-END OF ORDHF-STATUS
017180        PERFORM SET-ERROR-COLORS
017190        DISPLAY SCR-b0200xhp-cbl-1402-23  
017200        PERFORM SET-NORM-COLORS
017210        GO TO PROCESS-REPORT-EXIT
017220     ELSE
017230        PERFORM READ-ORDHF-NEXT.
017240
017250
017260 PROCESS-REPORT-NEXT.
017270     IF C-AT-END OF ORDHF-STATUS
017280        GO TO PROCESS-REPORT-EXIT.
017290
017300     IF ORDH-TYPE-CD = 4
017310        MOVE "Profits Alert" TO WS-MSG-BOX-TITLE
017320        MOVE ZERO            TO WS-MSG-BOX-STYLE
017330        ADD POW-DMOK         TO WS-MSG-BOX-STYLE
017340        ADD POW-DMICONINFORMATION TO WS-MSG-BOX-STYLE
017350        MOVE MSG-BOX-MESSAGE TO WS-MSG-BOX-TEXT
017360        PERFORM CALL-MSG-BOX
017370        GO TO PROCESS-REPORT-EXIT.
017380
017390*-- Check for Needed Authorization --* 
017400     IF POS-PRINTING
017410        IF AUTH-REQ-IF-OVER-CRLIM OR AUTH-REQ-AR
017420           PERFORM CUST-CR-LIM-CHK
017430           PERFORM SCREEN-INIT
017440           IF CUST-AUTH-OK
017450              NEXT SENTENCE
017460           ELSE
017470           IF SUBMIT-REQUEST
017480              MOVE 2 TO PASS-FORM-TYPE
017490              PERFORM SUBMIT-AUTH-REQUEST THRU 
017500                      SUBMIT-AUTH-REQUEST-EXIT
017510              GO TO PROCESS-REPORT-EXIT
017520           ELSE
017530              GO TO PROCESS-REPORT-EXIT.
017540        
017550     IF SELECTIVE-PRINTING OR POS-PRINTING
017560        NEXT SENTENCE
017570     ELSE
017580     IF BY-SALESMAN-PRINTING
017590        IF ORDH-SLSMN-NO > HIGH-SLSMN OR
017600           ORDH-SLSMN-NO < LOW-SLSMN
017610              GO TO PROCESS-REPORT-READ
017620        ELSE NEXT SENTENCE
017630     ELSE
017640     IF PRINT-IN-ORDER-SEQUENCE
017650       IF ORDHF-KEY > HIGH-ORDHF-KEY
017660         GO TO PROCESS-REPORT-EXIT
017670       ELSE NEXT SENTENCE
017680     ELSE
017690     IF PRINT-IN-NAME-SEQUENCE
017700       IF ORDHF-KEY > HIGH-ORDHF-KEY OR ORDHF-KEY < LOW-ORDHF-KEY
017710         GO TO PROCESS-REPORT-READ.
017720
017730     IF BY-BATCH-NO
017740        IF USER-BATCH-NO NOT = ORDH-BATCH-NO
017750           GO TO PROCESS-REPORT-READ.
017760
017770*-- IF 2-1-2, SKIP OPEN ORDERS --*
017780     IF POS-PRINTING OR SELECTIVE-PRINTING
017790        NEXT SENTENCE
017800     ELSE
051309     IF SUNBELTS
051309        NEXT SENTENCE
051309     ELSE
017810     IF (PROCESS-INVOICES AND OPEN-ORDER) OR
017820        (OPEN-ORDERS-ONLY AND NOT OPEN-ORDER) OR
017830        (RELEASED-ORDERS-ONLY AND NOT RELEASED-ORDER) OR
017840        CREDIT-MEMO
017850           GO TO PROCESS-REPORT-READ.
017860
017870
017880     MOVE 1         TO PAGE-NO.
017890     MOVE SPACES TO DETAIL-LINE.
017900     MOVE ORDHF-KEY TO ORDLF-KEY.
017910     MOVE ZERO      TO ORDL-SEQ-NO.
017920*    MOVE 1 TO ORDH-PICK-TICK-PRINTED-CD.
017930     IF ORDH-PICK-TICK-PRINTED-CD < 9
017940        ADD  1 TO ORDH-PICK-TICK-PRINTED-CD.
017950     PERFORM REWRITE-ORDHF.
017960     PERFORM START-ORDLF-GREATER.
017970     IF NOT C-AT-END OF ORDLF-STATUS
017980        PERFORM READ-ORDLF-NEXT.
017990
018000*    IF USE-FAX
018010*    IF FAX-A-COPY-YES
018020*       MOVE ORDH-CUST-NO TO CUST-NUMBER
018030*       PERFORM READ-CUSTF
018040*       MOVE CUST-FAX   TO TEMP-PHONE
018050*       MOVE CUST-AR-CONTACT TO WS-FAX-TO
018060******  MOVE 1 TO COPIES-TO-PRINT
018070*       IF POS-PRINTING OR SELECTIVE-PRINTING
018080*          MOVE 1 TO WS-FAX-ASK-CD     
018090*          MOVE 2 TO PRINT-TYPE-FLAG
018100*          PERFORM GET-FAX-INFO THRU GET-FAX-INFO-EXIT
018110*          IF RETURN-FLAG = 3
018120*             MOVE 3 TO FLAG
018130*             GO TO PROCESS-REPORT-READ.
018140
018150*    MOVE WS-FORM-ID TO MACRO-NUMBER.
018160*    IF MACRO-NUMBER = ZERO
018170*       MOVE 00201 TO MACRO-NUMBER.
018180
018190*    IF USE-FAX AND NEED-FAX-COVER-YES 
018200*    IF FAX-A-COPY-YES AND NEED-FAX-COVER-YES
018210*       IF NOT POS-PRINTING AND NOT SELECTIVE-PRINTING
018220*          PERFORM GET-FAX-INFO THRU GET-FAX-INFO-EXIT.
018230     MOVE ZERO TO COPIES-PRINTED.
018240     PERFORM LFPR-START-COPY-4-FORM.
018250     MOVE SPACES TO PF-DOCU-ID.
018260     STRING 
018270          "PT" DELIMITED BY SIZE
018280          ORDH-ORDER-NO DELIMITED BY SIZE
018290          INTO PF-DOCU-ID.
018300     PERFORM PREPARE-PRINT-FILE.
018310     IF LFPR-NO-MORE-COPY
018320        GO TO PROCESS-REPORT-EXIT
018330     END-IF.
018340
018350 DETAIL-LOOP.
018360     IF NOT POS-PRINTING AND NOT SELECTIVE-PRINTING
018370        DISPLAY SCR-b0200xhp-cbl-1500-23  .
018380*    IF FAX-A-COPY-YES AND COPIES-PRINTED = 10
018390*       IF NEED-FAX-COVER-YES
018400*          PERFORM COVER-SHEET THRU COVER-SHEET-EXIT
018410*          MOVE SPACES TO PRINT-REC
018420*          WRITE PRINT-REC BEFORE ADVANCING PAGE.
018430     PERFORM PRINT-FORM-AND-HEADER THRU 
018440             PRINT-FORM-AND-HEADER-EXIT.
010910*    IF JEREMIE
010910*       PERFORM GET-SPC-SHIPPING.
018470     PERFORM SETUP-FOR-DETAIL-LINES.
018480*    MOVE SPACES TO CC-CARD-LINE, CC-VCODE-LINE, CC-EXPIRE-LINE,
018490*         CC-DESC.
018500     PERFORM MOVE-DETAIL THRU MOVE-DETAIL-EXIT.
018510     PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT
018520*-- Used in CopyFil2.SR for PDF filename --*
018530*    MOVE SPACES      TO PCL-FILENAME.
018540*    STRING "SO"          DELIMITED BY SIZE
018550*           ORDH-ORDER-NO DELIMITED BY SIZE
018560*           ".PCL"        DELIMITED BY SIZE
018570*           INTO PCL-FILENAME.
018580
018590*-- Done Printing an entire Copy, Send to Print Device --*
018600*    MOVE HP-RESET TO PRINT-REC.
018610*    WRITE PRINT-REC BEFORE ZERO.
018620     PERFORM COPY-FILE.
018630
018640*    IF COPIES-PRINTED < 11
018650     IF NOT LFPR-NO-MORE-COPY
018660        MOVE ORDHF-KEY TO ORDLF-KEY
018670        MOVE ZERO TO ORDL-SEQ-NO, LINE-NO
018680        MOVE 1         TO PAGE-NO
018690        PERFORM START-ORDLF-GREATER
018700        PERFORM READ-ORDLF-NEXT
018710        PERFORM PREPARE-PRINT-FILE
018720*       IF COPIES-PRINTED < 11
018730        IF NOT LFPR-NO-MORE-COPY
018740           GO TO DETAIL-LOOP.
018750
018760 PROCESS-REPORT-READ.
018770     IF POS-PRINTING
018780        GO TO PROCESS-REPORT-EXIT.
018790
018800     IF SELECTIVE-PRINTING
018810        PERFORM SELECTIVE-ORDER THRU SELECTIVE-ORDER-EXIT
018820        IF FLAG = 9
018830           GO TO PROCESS-REPORT-EXIT
018840        ELSE
018850           PERFORM FIND-ORDER THRU FIND-ORDER-EXIT
018860           IF C-AT-END OF ORDHF-STATUS
018870              DISPLAY SCR-b0200xhp-cbl-1548-29   
018880              GO TO PROCESS-REPORT-READ
018890           ELSE
018900              NEXT SENTENCE
018910      ELSE
018920         PERFORM READ-ORDHF-NEXT.
018930     IF ESC-FLAG = 1
018940        CALL "KBDCHK" USING FLAG, FKEYS
018950        IF FLAG = 3
018960          PERFORM ACCEPT-PAUSE
018970           IF OPTION OF PAUSE-SPEC(1) = 1
018980              MOVE 3 TO FLAG
018990              GO TO PROCESS-REPORT-EXIT.
019000
019010**** MOVE ZERO TO COPIES-PRINTED.
019020**** PERFORM PREPARE-PRINT-FILE.
019030     GO TO PROCESS-REPORT-NEXT.
019040
019050 PROCESS-REPORT-EXIT. EXIT.
019060
019070 PRINT-FORM-AND-HEADER SECTION.
019080 PRINT-FORM-AND-HDR-BEGIN.
019090*-- EXECUTE OVERLAY --*
019170
019200     IF WS-LOGO-ID NOT = ZERO OR WS-LOGO-FILENAME NOT = SPACES
019220        MOVE WS-LOGO-FILENAME TO PR-COMPANY-LOGO OF PICK201
019230        MOVE WS-LOGO-IMAGE-TYPE TO 
019240             EDIT-MODE OF PR-COMPANY-LOGO OF PICK201
019250     ELSE
010810        MOVE "X" TO EDIT-MODE OF PR-COMPANY-LOGO OF PICK201
019260        PERFORM PRINT-COMPANY-INFO.
019270     IF WS-WMARK-FILENAME NOT = SPACES
019280        MOVE WS-WMARK-FILENAME TO PR-WATERMARK   OF PICK201
019290        MOVE WS-WMARK-IMAGE-TYPE TO
019300             EDIT-MODE OF PR-WATERMARK    OF PICK201
010810     ELSE
010810        MOVE "X" TO EDIT-MODE OF PR-WATERMARK OF PICK201.

019310     PERFORM PRINT-HEADER-INFO.
019320 PRINT-FORM-AND-HEADER-EXIT. EXIT.
019330
019340******************************************************************
019350 MOVE-DETAIL SECTION.
019360******************************************************************
019370 MOVE-DETAIL-START.
061709*    MOVE "ITEM" TO PFRPT-GROUP.
019390     IF C-AT-END OF ORDLF-STATUS
019400        GO TO MOVE-DETAIL-EXIT.
019410
019420     IF JEREMIE
019430        IF (ORDL-SEQ-NO > 099800 AND ORDL-SEQ-NO < 099804) OR
019440           (ORDL-SEQ-NO > 32 AND ORDL-SEQ-NO < 40)
019450           GO TO MOVE-DETAIL-END
019460        ELSE
019480        IF ORDL-PARENT-SEQ-NO = ORDL-SEQ-NO AND PICK-FORM
019530           ADD 1 TO LINE-NO
061709           MOVE SPACES TO PR-DETAIL-LINE(LINE-NO)
061709        END-IF
061709        END-IF
061709     END-IF.
019540     MOVE ORDL-ITEM-BIN TO PR-ITEM-BIN.
019550
019560     IF OPEN-ORDER OR RELEASED-ORDER
019570        IF USE-REMAINING-BAL-QTY
019580           COMPUTE WS-PRINT-QTY = ORDL-ORDER-QTY -
019590                                  ORDL-PREVSHIP-QTY
019600        ELSE
019610        IF USE-ORIGINAL-QTY
019620            MOVE ORDL-ORDER-QTY TO WS-PRINT-QTY
019630        ELSE
019640           MOVE ORDL-SHIP-QTY TO WS-PRINT-QTY
019650     ELSE
019660     IF USE-SHIPPED-QTY
019670        MOVE ORDL-SHIP-QTY TO WS-PRINT-QTY
019680     ELSE
019690        MOVE ORDL-ORDER-QTY TO WS-PRINT-QTY.
019700     IF ONHAND-INVENTORY
019710         PERFORM CHECK-ITEM THRU CHECK-ITEM-EXIT
019720         PERFORM SET-PRINT-QTY THRU SET-PRINT-QTY.
019730
019740     MOVE ORDL-ITEM-NO TO SPC-ITEM-NO.
019750     IF NOT SPC-ITEM
019760       IF NO-DECIMALS
019770             MOVE WS-PRINT-QTY  TO PR-ORDER-QTY
019780             MOVE ORDL-SHIP-QTY TO PR-SHIP-QTY
019790             MOVE ORDL-BO-QTY   TO PR-BO-QTY
019800       ELSE
019810         IF ONE-DECIMAL
019820             MOVE WS-PRINT-QTY   TO PR-ORDER-QTY-1
019830             MOVE ORDL-SHIP-QTY  TO PR-SHIP-QTY-1
019840             MOVE ORDL-BO-QTY    TO PR-BO-QTY-1
019850         ELSE
019860         IF TWO-DECIMALS
019870             MOVE WS-PRINT-QTY   TO PR-ORDER-QTY-2
019880             MOVE ORDL-SHIP-QTY  TO PR-SHIP-QTY-2
019890             MOVE ORDL-BO-QTY    TO PR-BO-QTY-2
019900         ELSE
019910         IF THREE-DECIMALS
019920             MOVE WS-PRINT-QTY   TO PR-ORDER-QTY-3
019930             MOVE ORDL-SHIP-QTY  TO PR-SHIP-QTY-3
019940             MOVE ORDL-BO-QTY    TO PR-BO-QTY-3
019950         ELSE
019960         IF FOUR-DECIMALS
019970             MOVE WS-PRINT-QTY   TO PR-ORDER-QTY-4
019980             MOVE ORDL-SHIP-QTY  TO PR-SHIP-QTY-4
019990             MOVE ORDL-BO-QTY    TO PR-BO-QTY-4
020000         ELSE
020010         IF FIVE-DECIMALS
020020             MOVE WS-PRINT-QTY   TO PR-ORDER-QTY-5
020030             MOVE ORDL-SHIP-QTY  TO PR-SHIP-QTY-5
020040             MOVE ORDL-BO-QTY    TO PR-BO-QTY-5.
020050
020060     IF COMMENT
020070         IF NO-DECIMALS
020080             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY
020090         ELSE
020100         IF ONE-DECIMAL
020110             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-1
020120         ELSE
020130         IF TWO-DECIMALS
020140             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-2
020150         ELSE
020160         IF THREE-DECIMALS
020170             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-3
020180         ELSE
020190         IF FOUR-DECIMALS
020200             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-4
020210         ELSE
020220         IF FIVE-DECIMALS
020230             MOVE ORDL-ORDER-QTY TO PR-ORDER-QTY-5.
020240
020250
020260     IF OPEN-ORDER
020270        COMPUTE WEIGHT = ORDL-ITEM-WEIGHT * ORDL-ORDER-QTY
020280     ELSE
020290        COMPUTE WEIGHT = ORDL-ITEM-WEIGHT * ORDL-SHIP-QTY.
020300
020310     MOVE ORDL-ITEM-UOM TO PR-ITEM-UOM.
020320     MOVE WEIGHT TO PR-ITEM-WEIGHT.
020330
020340*    IF WS-FORM-ID = 202 OR WS-FORM-FILENAME = "PICK202.MAC"
020350     IF LFPR-I-FORM-NAME = "PICK202"
020360        MOVE ORDL-ITEM-PRICE TO PR-ITEM-WEIGHT.
020370
072910     IF SUNBELTS
072910        IF COPIES-PRINTED = 1
072910           ADD WEIGHT TO TS-WEIGHT
072910        END-IF
072910     ELSE
020380     IF ORDL-DROPSHIP-CD = 2
020390        IF COPIES-PRINTED = 1
020400           ADD WEIGHT TO TS-WEIGHT.
020410
020420     IF LAST-OPTION NOT = 020703 AND LAST-OPTION NOT = 020702
020430           MOVE ZERO TO PR-SHIP-QTY,
020440                        PR-BO-QTY.
020450
310309*    MOVE ORDL-ITEM-NO TO PR-ITEM-NO.
310309     IF PROFITS-APPAREL-YES
310309        MOVE ORDL-STYLE   TO PR-ORDL-STYLE
310309        MOVE ORDL-COLOR   TO PR-COLOR
010710        IF ORDL-COLOR NOT = SPACES
010710           PERFORM READ-COLRF
010710        END-IF
071409*       IF ORDL-CATEGORY NOT = ZERO
071409        IF NOT ORDL-CAT-NOTAPPAREL
071409           MOVE ORDL-GROUP-NAME TO SCAT-GROUP-NBR
071409           MOVE ORDL-CATEGORY TO SCAT-CAT-NUM
071409           PERFORM READ-SCAT-GC
071409*          MOVE MUCT-CATEGORIES(ORDL-GROUP-NAME, ORDL-CATEGORY)
071409           MOVE SCAT-CAT
310309             TO PR-CATEGORY
071409           MOVE ORDL-SIZE TO SCAT-SIZE-NUM
071409           MOVE ORDL-GROUP-NAME TO SCAT-GROUP-NBR
071409           PERFORM READ-SCAT-GS
071409*          MOVE MUCT-SIZES(ORDL-GROUP-NAME, ORDL-SIZE) TO PR-SIZE
071409           MOVE SCAT-SIZE TO PR-SIZE
310309        ELSE
310309           MOVE SPACES TO PR-SIZE, PR-CATEGORY
310309     ELSE
310309        MOVE ORDL-ITEM-NO TO PR-ITEM-NO
310309     END-IF.

310309*    MOVE ORDL-ITEM-DESC TO PR-ITEM-DESC.
310309     IF PROFITS-APPAREL-YES
310309        MOVE ORDL-ITEM-DESC TO PR-ORDL-ITEM-DESC-B
010710*       MOVE ORDL-ITEM-BIN  TO PR-BIN-LOC
310309     ELSE
310309        MOVE ORDL-ITEM-DESC TO PR-ITEM-DESC
310309     END-IF.
020480
020490     IF SPC-ITEM
020500        MOVE SPACES TO PR-ITEM-NO.
020520     IF JEREMIE OR LFPR-I-FORM-NAME = "PICK204" 
020530        PERFORM MOVE-204-DETAIL.
020540
061709     ADD 1 TO LINE-NO.
061709*    MOVE DETAIL-LINE TO PR-DETAIL-LINE
061709     MOVE DETAIL-LINE TO PR-DETAIL-LINE(LINE-NO)
020560     IF JEREMIE
020570        IF ORDL-PARENT-SEQ-NO = ORDL-SEQ-NO
061709*          MOVE DETAIL-LINE TO PR-DETAIL-LINE-BOLD
061709           MOVE DETAIL-LINE TO PR-DETAIL-LINE-BOLD(LINE-NO)
061709*          MOVE SPACES TO PR-DETAIL-LINE
061709           MOVE SPACES TO PR-DETAIL-LINE(LINE-NO)
020610        ELSE 
061709*          MOVE SPACES TO PR-DETAIL-LINE-BOLD
061709           MOVE SPACES TO PR-DETAIL-LINE-BOLD(LINE-NO)
020650        END-IF
020660     END-IF.
061709*    WRITE PICK201.
061709*    ADD 1 TO LINE-NO.
020700
020710 MOVE-DETAIL-END.
020720
020730     PERFORM READ-ORDLF-NEXT .
020740     IF C-AT-END OF ORDLF-STATUS
061709        PERFORM PRINT-ITEM
020750        GO TO MOVE-DETAIL-EXIT.
061609*    IF LINE-NO < 39
042710*    IF LINE-NO < 39
042710     IF LINE-NO < 38
020770        GO TO MOVE-DETAIL-START
020780     ELSE
061709        PERFORM PRINT-ITEM
061809        MOVE "QXW" TO PR-END-ORDER-BAR
061809        MOVE "X" TO EDIT-MODE OF PR-END-ORDER-BAR
020790        PERFORM PRINT-THE-PAGE THRU PRINT-THE-PAGE-EXIT
061809        MOVE " " TO EDIT-MODE OF PR-END-ORDER-BAR
020800        PERFORM PRINT-FORM-AND-HEADER THRU 
020810                PRINT-FORM-AND-HEADER-EXIT
020820        MOVE ZERO TO LINE-NO
020830        PERFORM SETUP-FOR-DETAIL-LINES
020840        GO TO MOVE-DETAIL-START.
020850
020860 MOVE-DETAIL-EXIT. EXIT.
020870
061709******************************************************************
061709 PRINT-THE-ITEM SECTION.
061709******************************************************************
061709 PRINT-ITEM.
061709     MOVE "ITEM" TO PFRPT-GROUP
061709     WRITE PICK201
061709     PERFORM UNTIL LINE-NO < 1
061709        MOVE SPACES TO PR-DETAIL-LINE-BOLD(LINE-NO)
061709        MOVE SPACES TO PR-DETAIL-LINE(LINE-NO)
061709        ADD -1 TO LINE-NO
061709     END-PERFORM.

020880******************************************************************
020890 PRINT-THE-PAGE SECTION.
020900******************************************************************
020910 PRINT-THE-PAGE-START.
020920     IF C-AT-END OF ORDLF-STATUS
020930        PERFORM PRINT-TOTALS.
020940
020950*-- PRINT COPY-MSG LINE --*
020960*    MOVE 7150 TO VERT-POS.
020970*    MOVE 2380 TO HORZ-POS.
020980*    MOVE 08   TO POINT-SIZE
020990*    MOVE 1690 TO FONT-NUMBER.
021000*    MOVE SPACES TO PRINT-REC.
021010*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
021020*           HP-HORZ-POSITION DELIMITED BY SIZE,
021030*           HP-SYMBOL-SET    DELIMITED BY SIZE,
021040*           HP-FONT          DELIMITED BY SIZE,
021050*           HP-UPRIGHT       DELIMITED BY SIZE,
021060*           HP-MEDIUM        DELIMITED BY SIZE,
021070*           HP-PORPORTIONAL  DELIMITED BY SIZE,
021080*           HP-POINT-SIZE    DELIMITED BY SIZE,
021090*           COPY-MSG(COPIES-PRINTED)  DELIMITED BY SIZE,
021100*           INTO PRINT-REC.
021110*    WRITE PRINT-REC BEFORE 0.
021120     MOVE LFPR-COPY-TO-PRINT TO PR-COPY-MSG.
021130
021140     MOVE PAGE-NO TO PR-PAGE-NO.
021150*    MOVE 0400 TO HORZ-POS.
021160*    MOVE 10   TO POINT-SIZE
021170*    MOVE SPACES TO PRINT-REC.
021180*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
021190*           HP-HORZ-POSITION DELIMITED BY SIZE,
021200*           HP-POINT-SIZE    DELIMITED BY SIZE,
021210     STRING 
021220            "Page No. "      DELIMITED BY SIZE,
021230            PR-PAGE-NO       DELIMITED BY SIZE
021240*           INTO PRINT-REC.
021250            INTO PR-PAGE.
021260*    WRITE PRINT-REC BEFORE 0.
021270     ADD 1 TO PAGE-NO.
021280
021290*    MOVE 3800 TO HORZ-POS.
021300*    MOVE 10   TO POINT-SIZE
021310*    MOVE SPACES TO PRINT-REC.
021320*    STRING HP-VERT-POSITION DELIMITED BY SIZE,
021330     STRING 
021340*           HP-HORZ-POSITION DELIMITED BY SIZE,
021350*           HP-POINT-SIZE    DELIMITED BY SIZE,
021360            "Buyers Name: "  DELIMITED BY SIZE,
021370            ORDH-JOB-NUM     DELIMITED BY SIZE
021380*           INTO PRINT-REC.
021390            INTO PR-BUYER-NUM.
021400*    IF JEREMIE
021410*       WRITE PRINT-REC BEFORE 0.
021420     MOVE "TAIL" TO PFRPT-GROUP.
021430     WRITE PICK201.
021440
021450 PRINT-THE-PAGE-EXIT. EXIT.
021460
021470*ASK-COPIES SECTION.
021480*ASK-COPIES-BEGIN.
021490*    IF NOT FROM-SM030
021500*    IF NOT FROM-SM030 AND NOT FROM-B0060
021510*     PERFORM SCREEN-INIT
021520*     IF USER-ASK-LF-COPIES-YES
021530*       DISPLAY SCR-b0200xhp-cbl-1791-23  
021540*       DISPLAY SCR-b0200xhp-cbl-1792-23  
021550*       PERFORM DISPLAY-INFO VARYING CNT FROM 1 BY 1
021560*          UNTIL CNT > 10
021570*       MOVE ZERO               TO DSP-CNT
021580*       MOVE "Envelope"         TO DSP-COPY-MSG
021590*       MOVE WS-ENVELOPE-TRAY   TO DSP-TRAY
021600*       MOVE WS-ENV-DEVICE      TO DSP-DEVICE-NAME
021610*       DISPLAY SCR-b0200xhp-cbl-1799-23  
021620*       IF RETURN-ADDR-YES
021630*          MOVE "Yes"           TO DSP-KNOCKOUT
021640*       ELSE
021650*          MOVE "No "              TO DSP-KNOCKOUT.
021660*-- Force Display of Data-4 without stopping --*
021670*    MOVE 1 TO FLAG.
021680
021690*    PERFORM SET-PROTECT-CD VARYING CNT FROM 1 BY 1 
021700*         UNTIL CNT > 10.
021710*    IF FROM-B0750
021720*       MOVE B0750-PRINT-ENVELOPE-CD TO OPTION OF SPEC-4(11).
021730*ACCEPT-YN.
021740*    IF USER-ASK-LF-COPIES-YES AND NOT FROM-SM030
021750*    IF USER-ASK-LF-COPIES-YES AND
021760*       (NOT FROM-SM030 AND NOT FROM-B0060)
021770*           PERFORM ACCEPT-DATA-4.
021780*    IF FLAG = 4
021790*       GO TO END-REPORT.
021800
021810*ACCEPT-5.
021820*    DISPLAY SCR-b0200xhp-cbl-1820-20  .
021830*    MOVE 1 TO OPTION OF SPEC-5(1).
021840*    MOVE OPTION OF SPEC-4(10) TO OPTION OF SPEC-5(2).
021850*    IF PACK-FORM AND JEREMIE
021860*    IF (PACK-FORM AND JEREMIE) OR FROM-B0060
021870*       NEXT SENTENCE
021880*    ELSE
021890*    IF USER-ASK-LF-COPIES-YES
021900*       PERFORM ACCEPT-DATA-5.
021910*    IF OPTION OF SPEC-5(1) = 2
021920*       MOVE 3 TO FLAG.
021930*    IF FLAG = 3
021940*       DISPLAY SCR-b0200xhp-cbl-1832-23  
021950*       GO TO ACCEPT-YN.
021960
021970*    MOVE OPTION OF SPEC-5(2) TO OPTION OF SPEC-4(10).
021980*    MOVE OPTION OF SPEC-4(1) TO WS-PRINT-COPY-CD(01).
021990*    MOVE OPTION OF SPEC-4(2) TO WS-PRINT-COPY-CD(02).
022000*    MOVE OPTION OF SPEC-4(3) TO WS-PRINT-COPY-CD(03).
022010*    MOVE OPTION OF SPEC-4(4) TO WS-PRINT-COPY-CD(04).
022020*    MOVE OPTION OF SPEC-4(5) TO WS-PRINT-COPY-CD(05).
022030*    MOVE OPTION OF SPEC-4(6) TO WS-PRINT-COPY-CD(06).
022040*    MOVE OPTION OF SPEC-4(7) TO WS-PRINT-COPY-CD(07).
022050*    MOVE OPTION OF SPEC-4(8) TO WS-PRINT-COPY-CD(08).
022060*    MOVE OPTION OF SPEC-4(9) TO WS-PRINT-COPY-CD(09).
022070*    MOVE OPTION OF SPEC-4(10) TO WS-PRINT-COPY-CD(10).
022080*    MOVE OPTION OF SPEC-4(11) TO WS-PRINT-ENVELOPE-CD. 
022090
022100*    IF OPTION OF SPEC-4(1) = 3
022110*       MOVE 1 TO WS-PDF-CD
022120*       MOVE 2 TO WS-PRINT-COPY-CD(01)
022130*       MOVE 1 TO WS-PRINT-COPY-CD(10).
022140
022150*    GO TO ASK-COPIES-EXIT.
022160
022170*    IF WS-PRINT-COPY-CODES = "2222222222"
022180*       DISPLAY SCR-b0200xhp-cbl-1856-23
022190*             
022200*       GO TO ACCEPT-YN.
022210
022220*    IF WS-PDF-CD NOT = 1
022230*       MOVE WS-PRINT-COPY-CD(10) TO FAX-COPY-CD.
022240*    GO TO ASK-COPIES-EXIT.
022250
022260*DISPLAY-INFO.
022270*    MOVE CNT                 TO DSP-CNT.
022280*    MOVE COPY-MSG-LEFT(CNT)  TO DSP-COPY-MSG.
022290*    MOVE WS-TRAY(CNT)        TO DSP-TRAY.
022300*    MOVE WS-DEVICE-NAME(CNT) TO DSP-DEVICE-NAME.
022310*    IF WS-KNOCKOUT-CD(CNT) = 1
022320*       MOVE "Yes" TO DSP-KNOCKOUT
022330*    ELSE
022340*       MOVE "No " TO DSP-KNOCKOUT.
022350*    COMPUTE CNT2 = CNT + 6.
022360*    DISPLAY SCR-b0200xhp-cbl-1874-20  .
022370
022380*SET-PROTECT-CD.
022390*    IF CNT NOT > COPIES-TO-PRINT
022400*       MOVE NORM-ATTR TO ATTR1 OF SPEC-4(CNT)
022410*       MOVE 1         TO OPTION OF SPEC-4(CNT)
022420*       IF FROM-B0750
022430*          MOVE B0750-PRINT-COPY-CD(CNT) TO OPTION OF SPEC-4(CNT)
022440*       ELSE
022450*          NEXT SENTENCE
022460*    ELSE 
022470*       MOVE 2         TO OPTION OF SPEC-4(CNT)
022480*       MOVE "P "      TO ATTR1 OF SPEC-4(CNT)
022490*       IF FROM-B0750
022500*          MOVE B0750-PRINT-COPY-CD(CNT) TO OPTION OF SPEC-4(CNT).
022510
022520*ASK-COPIES-EXIT. EXIT.
022530     COPY "ASKCOPY.SR".
022540*    COPY "LFPRF.SR".
022550******************************************************************
022560 RANGE-SELECT SECTION.
022570******************************************************************
022580 GET-RANGE.
022590     IF POS-PRINTING
022600        GO TO RANGE-SELECT-EXIT.
022610     PERFORM SCREEN-INIT.
022620     MOVE "1010000000" TO FKEYS.
022630     MOVE 0 TO FLAG.
022640*     IF PROCESS-HISTORY
022650      IF PROCESS-HISTORY OR PACK-FORM      
022660         MOVE 3 TO OPTION OF RANGE-SPEC-1(1)
022670         MOVE 1 TO OPTION OF RANGE-SPEC-1(2)
022680      ELSE
022690        DISPLAY SCR-b0200xhp-cbl-1905-23             
022700        DISPLAY SCR-b0200xhp-cbl-1906-23  
022710        PERFORM STEST-b0200xhp-cbl-1907
022720        CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
022730          HELP1, RANGE-CODES, ORDER-CODES
022740        PERFORM STEST-AFTER-CALL.
022750     MOVE OPTION OF RANGE-SPEC-1(1) TO RANGE-TYPE-FLAG.
022760     MOVE OPTION OF RANGE-SPEC-1(2) TO WS-ORDER-FLAG.
022770     IF FLAG = 3 GO TO RANGE-SELECT-EXIT.
022780     IF PRINT-ALL-ORDERS OR OPEN-ORDERS-ONLY OR
022790        RELEASED-ORDERS-ONLY OR ONHAND-INVENTORY
022800          MOVE LOW-VALUES TO LOW-ORDHF-KEY
022810          MOVE HIGH-VALUES TO HIGH-ORDHF-KEY
022820          GO TO RANGE-SELECT-EXIT.
022830     IF SELECTIVE-PRINTING
022840          GO TO RANGE-SELECT-EXIT.
022850     IF BY-BATCH-NO
022860          MOVE ZERO TO LOW-ORDHF-KEY
022870          MOVE 999999 TO HIGH-ORDHF-KEY
022880          PERFORM GET-BATCH-NO
022890          IF FLAG = 3
022900             GO TO GET-RANGE
022910          ELSE
022920             GO TO RANGE-SELECT-EXIT.
022930     IF BY-SALESMAN-PRINTING
022940        MOVE 03 TO FLEN OF RANGE-SPEC-2(1),
022950                   SLEN OF RANGE-SPEC-2(1)
022960                   FLEN OF RANGE-SPEC-2(2),
022970                   SLEN OF RANGE-SPEC-2(2)
022980     ELSE
022990        MOVE 06 TO FLEN OF RANGE-SPEC-2(1),
023000                   SLEN OF RANGE-SPEC-2(1)
023010                   FLEN OF RANGE-SPEC-2(2),
023020                   SLEN OF RANGE-SPEC-2(2).
023030     DISPLAY SCR-b0200xhp-cbl-1937-20  .
023040     DISPLAY SCR-b0200xhp-cbl-1938-20  .
023050     MOVE SPACES TO LOW-ORDHF-KEY, HIGH-ORDHF-KEY.
023060 GET-LOW-HIGH.
023070     MOVE "1010000000" TO FKEYS.
023080     MOVE 0 TO FLAG.
023090     PERFORM STEST-b0200xhp-cbl-1943
023100     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
023110       HELP2, LOW-ORDER, HIGH-ORDER
023120     PERFORM STEST-AFTER-CALL.
023130     MOVE ZERO TO LOW-SUB-ORDER.
023140     MOVE 99   TO HIGH-SUB-ORDER.
023150     IF FLAG = 3
023160        GO TO GET-RANGE.
023170     IF LOW-ORDHF-KEY > HIGH-ORDHF-KEY
023180         DISPLAY SCR-b0200xhp-cbl-1950-24   
023190         GO TO GET-LOW-HIGH.
023200     IF BY-SALESMAN-PRINTING
023210        GO TO RANGE-SELECT-EXIT.
023220     MOVE LOW-ORDHF-KEY TO ORDHF-KEY.
023230     PERFORM START-ORDHF.
023240     IF C-AT-END OF ORDHF-STATUS
023250         DISPLAY SCR-b0200xhp-cbl-1957-24   
023260         GO TO GET-LOW-HIGH.
023270     PERFORM SCREEN-INIT.
023280     DISPLAY SCR-b0200xhp-cbl-1960-20  .
023290     GO TO RANGE-SELECT-EXIT.
023300
023310 RANGE-SELECT-EXIT. EXIT.
023320
023330******************************************************************
023340 SELECTIVE-ORDER SECTION.
023350******************************************************************
023360 SELECTIVE-ORDERS.
023370     DISPLAY SCR-b0200xhp-cbl-1969-20  .
023380     IF PACK-FORM AND JEREMIE
023390        DISPLAY SCR-b0200xhp-cbl-1971-23  .
023400
023410     IF PROCESS-HISTORY
023420        MOVE 1 TO ORDH-SUB-ORDER-NO
023430        DISPLAY SCR-b0200xhp-cbl-1975-23  .
023440     MOVE "1000000010" TO FKEYS.
023450     MOVE 0 TO FLAG.
023460     PERFORM STEST-b0200xhp-cbl-1978
023470     CALL "SCRN03" USING FLAG, FKEYS, STEST-SCRN-SPECS,
023480*      HELP3, ORDH-ORDER-NO, ORDH-SUB-ORDER-NO, B0750-PACKER
023490       HELP3, ORDH-ORDER-NO, ORDH-SUB-ORDER-NO, LS-PACKER-NO
023500     PERFORM STEST-AFTER-CALL.
023510     IF FLAG = 9 GO TO SELECTIVE-ORDER-EXIT.
023520     IF ORDH-ORDER-NO = ZERO
023530        GO TO SELECTIVE-ORDERS.
023540
023550 SELECTIVE-ORDER-EXIT. EXIT.
023560
023570******************************************************************
023580 FIND-ORDER SECTION.
023590******************************************************************
023600 FIND-ORDER-START.
023610     CLOSE ORDHF.
023620     CALL "CHGDIR" USING MASTER-DIR, RETURN-CD.
023630     CALL "CHGDIR" USING SUB-DIR, RETURN-CD.
023640
023650*-- CHECK BILLING FILE --*
023660     MOVE "ORDERH.FIL" TO EXT-HDR-FILE.
023670     PERFORM CALL-ASSIGN-HDR.
023680     PERFORM OPEN-ORDHF.
023690     PERFORM READ-ORDHF.
023700     IF C-FOUND OF ORDHF-STATUS
023710        MOVE "I" TO PROCESS-ORDERS-FLAG
023720        MOVE "ORDERL.FIL" TO EXT-LIN-FILE
023730        GO TO FIND-ORDER-CLEANUP.
023740
023750*-- CHECK OPEN ORDERS FILE --*
023760     CLOSE ORDHF.
023770     MOVE "OPENHDR.FIL" TO EXT-HDR-FILE.
023780     PERFORM CALL-ASSIGN-HDR.
023790     PERFORM OPEN-ORDHF.
023800     PERFORM READ-ORDHF.
023810     IF C-FOUND OF ORDHF-STATUS
023820        MOVE "O" TO PROCESS-ORDERS-FLAG
023830        MOVE "OPENLINE.FIL" TO EXT-LIN-FILE
023840        GO TO FIND-ORDER-CLEANUP.
023850
023860     GO TO FIND-ORDER-EXIT.
023870
023880 FIND-ORDER-CLEANUP.
023890     CLOSE ORDLF.
023900     MOVE EXT-LIN-FILE TO ORDLF--NAME
023910      PERFORM ORDLF-FILL-FULLPATH.
023920     PERFORM OPEN-ORDLF.
023930
023940 FIND-ORDER-EXIT. EXIT.
023950
023960
023970******************************************************************
023980 CHECK-ITEM SECTION.
023990******************************************************************
024000 CIS.
024010     MOVE ORDL-ITEM-NO TO TAG-KEY.
024020     PERFORM READ-TAGMF.
024030     IF TAGMF-STATUS = NOT-FOUND
024040         PERFORM SET-ITEM
024050         IF C-RECORD-OK OF ITEMF-STATUS
024060             MOVE ITEM-ONHAND TO TAG-ONHAND
024070         ELSE MOVE 0 TO TAG-ONHAND.
024080     GO TO CHECK-ITEM-EXIT.
024090
024100 SET-ITEM.
024110     MOVE ORDL-ITEM-NO TO ITEM-NUMBER.
024120     PERFORM READ-ITEMF.
024130
024140 CHECK-ITEM-EXIT. EXIT.
024150
024160******************************************************************
024170 SET-PRINT-QTY SECTION.
024180******************************************************************
024190 SPQ.
024200     IF WS-PRINT-QTY > TAG-ONHAND
024210         MOVE TAG-ONHAND TO WS-PRINT-QTY.
024220     COMPUTE TAG-ONHAND = TAG-ONHAND - WS-PRINT-QTY.
024230     IF TAG-ONHAND < 0 MOVE 0 TO TAG-ONHAND.
024240     IF C-RECORD-OK OF TAGMF-STATUS
024250         PERFORM REWRITE-TAGMF
024260     ELSE PERFORM WRITE-TAGMF.
024270 SET-PRINT-QTY-EXIT. EXIT.
024280
024290
024300*-- Subroutines --*
024310     COPY "CHAINR.SR".
024320     COPY "PRINT.SR".
024330     COPY "PAUSE.SR".
024340     COPY "FAXMSG.SR".
024350     COPY "AUTHNO.SR".
024360******************************************************************
024370*GET-FAX-INFO SECTION.
024380******************************************************************
024390*GET-FAX-INFO-START.
024400*    PERFORM SCREEN-INIT.    
024410*    MOVE ZERO TO FLAG.
024420*    MOVE "\PROFITS\FAXINFO" TO NEXT-PROG2.
024430*    REWRITE USERF-REC.
024440*    CLOSE USERF, CNTLF, CLOSE LO.
024450*    CLOSE USERF, CNTLF.
024460*    MOVE 1                  TO CHAINED-FLAG.
024470*    MOVE ORDH-CUST-NO       TO WS-RECORD-KEY.
024480*    MOVE CUST-PHONE         TO TEMP2-PHONE.
024490*    PERFORM CHNR-NEXT-PROG2-WS-FAX-SHARED.
024500*    OPEN I-O USERF.
024510*    OPEN I-O CNTLF.
024520*    MOVE 1  TO USER-PTR-CHN.
024530*    PERFORM OPEN-LO-LASER.
024540*    MOVE "PMENU" TO NEXT-PROG.
024550*    DISPLAY SCR-b0200xhp-cbl-2082-20  .
024560*    MOVE SPACES TO WS-FAX-SUBJECT.
024570*    STRING "PickTick No: "      DELIMITED BY SIZE
024580*           ORDH-ORDER-NO       DELIMITED BY SIZE
024590*           INTO WS-FAX-SUBJECT.
024600*    IF RETURN-FLAG = 0
024610*       PERFORM STRING-FAX-TAG-LINE
024620*       IF COPIES-PRINTED = 10
024630*          WRITE PRINT-REC BEFORE ADVANCING 1. 
024640*GET-FAX-INFO-EXIT. EXIT.
024650*SCREEN-ACCEPT SECTION.
024660*ACCEPT-DATA-4.
024670*    MOVE "1001000000" TO FKEYS.
024680*    PERFORM STEST-b0200xhp-cbl-2095
024690*    CALL "SCRN11" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP4,
024700*         YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
024710*         YES-NO-PDF, YES-NO, YES-NO, YES-NO, YES-NO,
024720*         YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
024730*         YES-NO
024740*    PERFORM STEST-AFTER-CALL.
024750*    
024760*ACCEPT-DATA-5.
024770*    MOVE ZERO TO FLAG.
024780*    MOVE "1010000000" TO FKEYS.
024790*    PERFORM STEST-b0200xhp-cbl-2104
024800*    CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP5,
024810*         ACCEPT-OPTS, YES-NO
024820*    PERFORM STEST-AFTER-CALL.
024830*    
024840*SCREEN-ACCEPT-EXIT. EXIT.
024850
024860 IN-OUT SECTION.
024870 OPEN-ORDHF.
024880     OPEN I-O    ORDHF.
024890 OPEN-ORDLF.
024900     OPEN INPUT  ORDLF.
024910 OPEN-SALEF.
024920     OPEN INPUT SALEF.
024930 OPEN-CUSTF.
024940     OPEN INPUT CUSTF.
024950 OPEN-ITEMF.
024960     OPEN INPUT  ITEMF.
024970 OPEN-TAGMF.
024980*    PERFORM TAGMF-NAMESUFFIXCHECK
024990     OPEN OUTPUT TAGMF.
025000     CLOSE TAGMF.
025010*    PERFORM TAGMF-NAMESUFFIXCHECK
025020     OPEN I-O TAGMF.
025030 OPEN-ORAUF.
025040     OPEN I-O ORAUF.
025050 START-ORDHF.
025060     START ORDHF KEY NOT < ORDHF-KEY
025070         INVALID KEY MOVE AT-END TO ORDHF-STATUS.
025080 START-ORDHF-NAME.
025090     MOVE LOW-VALUES TO ORDH-CUST-NAME-KEY.
025100     START ORDHF KEY NOT < ORDH-CUST-NAME-KEY
025110            INVALID KEY MOVE AT-END TO ORDHF-STATUS.
025120 START-ORDLF-GREATER.
025130     START ORDLF KEY > ORDLF-KEY
025140            INVALID KEY MOVE AT-END TO ORDLF-STATUS.
071409*READ-MUCTF.
071409*    PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
071409*     MUCTF-STATUS OR IO-WAIT-OFF 
071409*    READ MUCTF NO LOCK INVALID KEY
071409*        MOVE MUCTF-STATUS TO MUCTF-STATUS
071409*    END-READ END-PERFORM.
071409*      IF FILE-STATUS = FILE-LOCK   OR
071409*         FILE-STATUS = RECORD-LOCK
071409*            PERFORM SET-ERROR-COLORS
071409*            DISPLAY SCR-LOCKED  
071409*            PERFORM SET-NORM-COLORS
071409*            PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
071409*                UNTIL TIMER-CNT > TIMER-MAX
071409*                  CALL "PAUSE" USING BY VALUE 100
071409*                  GO TO READ-MUCTF.
025150 READ-CNTLF.
025160     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025170      CNTLF-STATUS OR IO-WAIT-OFF 
025180     READ CNTLF NO LOCK
025190        INVALID KEY MOVE CNTLF-STATUS TO CNTLF-STATUS
025200     END-READ END-PERFORM.
025210 READ-ORDHF.
025220     IF FROM-SM030
025230        MOVE ZEROES TO ORDH-SUB-ORDER-NO.
025240     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025250      ORDHF-STATUS OR IO-WAIT-OFF 
025260     READ ORDHF KEY IS ORDHF-KEY
025270         INVALID KEY MOVE AT-END TO ORDHF-STATUS
025280     END-READ END-PERFORM.
025290     IF FROM-SM030 AND JEREMIE
025300*       MOVE B0750-PACKER TO ORDH-PACKER-NO.
025310        MOVE LS-PACKER-NO TO ORDH-PACKER-NO.
025320 READ-ORDHF-NEXT.
025330     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025340      ORDHF-STATUS OR IO-WAIT-OFF 
025350     READ ORDHF NEXT
025360         AT END MOVE AT-END TO ORDHF-STATUS
025370     END-READ END-PERFORM.
025380     IF C-AT-END OF ORDHF-STATUS
025390         MOVE AT-END TO ORDHF-STATUS.
025400     IF RANGE-PRINTING
025410        IF ORDHF-KEY < LOW-ORDHF-KEY OR
025420           ORDHF-KEY > HIGH-ORDHF-KEY
025430              MOVE AT-END TO ORDHF-STATUS.
025440     DISPLAY SCR-b0200xhp-cbl-2155-20  .
025450     DISPLAY SCR-b0200xhp-cbl-2156-20         .
025460 READ-ORDLF-NEXT.
025470     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025480      ORDLF-STATUS OR IO-WAIT-OFF 
025490     READ ORDLF NEXT
025500          AT END MOVE AT-END TO ORDLF-STATUS
025510     END-READ END-PERFORM.
025520
025530     IF NOT C-AT-END OF ORDLF-STATUS
025540         IF ORDL-ORDER-NO NOT = ORDH-ORDER-NO OR
025550            ORDL-SUB-ORDER-NO NOT = ORDH-SUB-ORDER-NO
025560             MOVE AT-END TO ORDLF-STATUS.
025570*    IF ORDL-SEQ-NO = 35
025580*       MOVE ORDL-ITEM-DESC TO CC-DESC
025590*       MOVE "xxxxxxxxxxxx" TO CC-NO-BLANK
025600*       MOVE CC-DESC  TO ORDL-ITEM-DESC.
025610*    IF ORDL-SEQ-NO = 34
025620*       MOVE ORDL-ITEM-DESC TO CC-CARD-LINE.
025630*    IF ORDL-SEQ-NO = 36
025640*       MOVE ORDL-ITEM-DESC TO CC-VCODE-LINE.
025650*    IF ORDL-SEQ-NO = 37
025660*       MOVE ORDL-ITEM-DESC TO CC-EXPIRE-LINE.
025670
025680 READ-ORDLF.
025690     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025700      ORDLF-STATUS OR IO-WAIT-OFF 
025710     READ ORDLF INVALID KEY
025720         MOVE NOT-FOUND TO ORDLF-STATUS
025730     END-READ END-PERFORM.
025740     IF ORDLF-STATUS = NOT-FOUND
025750        MOVE SPACES TO ORDL-ITEM-DESC, ORDL-ITEM-NO.
025760 READ-SALEF.
025770     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025780      SALEF-STATUS OR IO-WAIT-OFF 
025790     READ SALEF KEY IS SALEF-KEY
025800         INVALID KEY MOVE SALEF-STATUS TO SALEF-STATUS
025810     END-READ END-PERFORM.
025820     IF SALEF-STATUS = NOT-FOUND
025830        MOVE SPACES TO SLSMN-NAME.
025840 READ-CUSTF.
025850     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025860      CUSTF-STATUS OR IO-WAIT-OFF 
025870     READ CUSTF INVALID KEY
025880         MOVE 0 TO CUST-CREDIT-LIMIT
025890         MOVE NOT-FOUND TO CUSTF-STATUS
025900     END-READ END-PERFORM.
025910 READ-ITEMF.
025920     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
025930      ITEMF-STATUS OR IO-WAIT-OFF 
025940     READ ITEMF INVALID KEY
025950         MOVE NOT-FOUND TO ITEMF-STATUS
025960         MOVE SPACES TO ITEMF-REC
025970     END-READ END-PERFORM.
025980 READ-TAGMF.
025990     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
026000      TAGMF-STATUS OR IO-WAIT-OFF 
026010     READ TAGMF INVALID KEY
026020         MOVE NOT-FOUND TO TAGMF-STATUS
026030     END-READ END-PERFORM.
026040 READ-ORAUF.
026050     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
026060      ORAUF-STATUS OR IO-WAIT-OFF 
026070     READ ORAUF INVALID KEY
026080         MOVE NOT-FOUND TO ORAUF-STATUS
026090     END-READ END-PERFORM.
010710 READ-COLRF.
010710     MOVE ORDL-COLOR TO COLRF-KEY.
010710     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
010710      COLRF-STATUS OR IO-WAIT-OFF 
010710     READ COLRF INVALID KEY
010710         MOVE NOT-FOUND TO COLRF-STATUS
010710         MOVE SPACES TO COLRF-REC
010710     END-READ END-PERFORM.
0          IF C-FOUND OF COLRF-STATUS
010710        MOVE COLR-NAME TO PR-COLOR.
026100 WRITE-TAGMF.
026110     WRITE TAGMF-REC.
026120 REWRITE-ORDHF.
026130     REWRITE ORDHF-REC.
026140 REWRITE-TAGMF.
026150     REWRITE TAGMF-REC.
026160 REWRITE-ORAUF.
026170     REWRITE ORAUF-REC.
026180
026190 CLOSE-ORAUF.
026200     CLOSE ORAUF.
026210
026220 CLOSE-FILES.
026230     CLOSE ORDHF.
026240     CLOSE ORDLF.
071409     IF PROFITS-APPAREL-YES
071409        CLOSE SCATF
010710        CLOSE COLRF
071409     END-IF.
026250     PERFORM LFPRF-CLOSE.
026260*CLOSE-LO.
026270*    PERFORM PDFCR-BEFORE-CLOSE.
026280*    CLOSE LO   .
026290*     CALL "PRNTFILECLOSED" USING PRNT-FILENAME
026300*    PERFORM PDFCR-AFTER-CLOSE.
026310 IN-OUT-EXIT. EXIT.
026320 LOAD-LFPR-DATA.
071409     COPY "APPARELD.SR".
026330 FILENAMES SECTION.
026340 FILL-PATHS.
026350      MOVE SPACES TO TEMP-SUB-DIR.
026360      STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
026370      PERFORM CUSTF-FILL-FULLPATH.
026380      PERFORM ORDHF-FILL-FULLPATH.
026390      PERFORM ORDLF-FILL-FULLPATH.
026400      PERFORM CNTLF-FILL-FULLPATH.
026410      PERFORM ITEMF-FILL-FULLPATH.
026420      PERFORM SALEF-FILL-FULLPATH.
026430      PERFORM ORAUF-FILL-FULLPATH.
071409      PERFORM SCATF-FILL-FULLPATH.
010710      PERFORM COLRF-FILL-FULLPATH.
071409 SCATF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO SCATF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" SCATF--NAME 
            DELIMITED BY SPACES INTO SCATF-FULLPATH.
010710 COLRF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO COLRF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" COLRF--NAME 
            DELIMITED BY SPACES INTO COLRF-FULLPATH.
026440 CUSTF-FILL-FULLPATH.
026450      MOVE SPACES TO TEMP-MASTER-DIR.
026460      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026470      TEMP-MASTER-DIR.
026480      MOVE SPACES TO CUSTF-FULLPATH.
026490      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CUSTF--NAME 
026500      DELIMITED BY SPACES INTO CUSTF-FULLPATH.
026510 ORDHF-FILL-FULLPATH.
026520      MOVE SPACES TO TEMP-MASTER-DIR.
026530      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026540      TEMP-MASTER-DIR.
026550      MOVE SPACES TO ORDHF-FULLPATH.
026560      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORDHF--NAME 
026570      DELIMITED BY SPACES INTO ORDHF-FULLPATH.
026580 ORDLF-FILL-FULLPATH.
026590      MOVE SPACES TO TEMP-MASTER-DIR.
026600      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026610      TEMP-MASTER-DIR.
026620      MOVE SPACES TO ORDLF-FULLPATH.
026630      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORDLF--NAME 
026640      DELIMITED BY SPACES INTO ORDLF-FULLPATH.
026650 CNTLF-FILL-FULLPATH.
026660      MOVE SPACES TO TEMP-MASTER-DIR.
026670      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026680      TEMP-MASTER-DIR.
026690      MOVE SPACES TO CNTLF-FULLPATH.
026700      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
026710      DELIMITED BY SPACES INTO CNTLF-FULLPATH.
026720 USERF-FILL-FULLPATH.
026730      MOVE SPACES TO TEMP-MASTER-DIR.
026740      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026750      TEMP-MASTER-DIR.
026760      MOVE SPACES TO USERF-FULLPATH.
026770      STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
026780      INTO USERF-FULLPATH.
026790 ITEMF-FILL-FULLPATH.
026800      MOVE SPACES TO TEMP-MASTER-DIR.
026810      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026820      TEMP-MASTER-DIR.
026830      MOVE SPACES TO ITEMF-FULLPATH.
026840      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ITEMF--NAME 
026850      DELIMITED BY SPACES INTO ITEMF-FULLPATH.
026860 SALEF-FILL-FULLPATH.
026870      MOVE SPACES TO TEMP-MASTER-DIR.
026880      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026890      TEMP-MASTER-DIR.
026900      MOVE SPACES TO SALEF-FULLPATH.
026910      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" SALEF--NAME 
026920      DELIMITED BY SPACES INTO SALEF-FULLPATH.
026930 ORAUF-FILL-FULLPATH.
026940      MOVE SPACES TO TEMP-MASTER-DIR.
026950      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
026960      TEMP-MASTER-DIR.
026970      MOVE SPACES TO ORAUF-FULLPATH.
026980      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ORAUF--NAME 
026990      DELIMITED BY SPACES INTO ORAUF-FULLPATH.
071409*MUCTF-FILL-FULLPATH.
071409*     MOVE SPACES TO TEMP-MASTER-DIR.
071409*     STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
071409*     TEMP-MASTER-DIR.
071409*     MOVE SPACES TO MUCTF-FULLPATH.
071409*     STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" MUCTF--NAME 
071409*     DELIMITED BY SPACES INTO MUCTF-FULLPATH.
027000 CHAINCALLS SECTION.
027010 CHN--PARM-BLOCK.
027020      COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
027030      .
027040
027050 CHN--PARM-BLK.
027060      COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.
027070
027080 CHNR--WS-PASSED.
027090      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==WS-PASSED==
027100      .
027110
027120 CHNR-DOS-CALL-PARAM-BLOCK-DOS.
027130      COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==DOS-CALL== 
027140      ==RETURN-CD== BY ==DOS-RET-CODE==.
027150
027160 CHNR--PASS-REC-DOS-RET-CODE.
027170      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==PASS-REC== 
027180      ==RETURN-CD== BY ==DOS-RET-CODE==.
027190
027200 CHNR--PARM-BLOCK-DOS-RET-CODE.
027210      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY 
027220      ==PARM-BLOCK== ==RETURN-CD== BY ==DOS-RET-CODE==.
027230
027240 CHNR-NEXT-PROG2-WS-FAX-SHARED.
027250      COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==NEXT-PROG2== 
027260      ==PARAM-BLOCK== BY ==WS-FAX-SHARED==.
027270
027280 GETCP-B0750-PASS-DATA.
027290      COPY "GETCP.CBL" REPLACING ==PARAM-BLOCK== BY 
027300      ==B0750-PASS-DATA==.
027310
027320 SCRN-TEST SECTION.
027330      COPY "STEST.SR".
027340*STEST-errorfil-sr-46.
027350*     MOVE "b0200xhp.cbl  errorfil.sr   46" TO STEST-KEY.
027360*     MOVE ERROR-FIELD TO STEST-SCRN-SPECS.
027370*     MOVE FUNCTION ADDR(ERROR-FIELD) TO STEST-PTR.
027380*     PERFORM STEST-BEGIN.
027390*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027400*     = FUNCTION LENG (FLAG).
027410*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
027420*     STEST-PARAMS (STEST-PARAM-NUM).
027430*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
027440*     STEST-PARAMS (STEST-PARAM-NUM).
027450*     PERFORM STEST-PARAM-CHECK.
027460*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027470*     = FUNCTION LENG (FKEYS).
027480*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
027490*     STEST-PARAMS (STEST-PARAM-NUM).
027500*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
027510*     STEST-PARAMS (STEST-PARAM-NUM).
027520*     PERFORM STEST-PARAM-CHECK.
027530*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027540*     = FUNCTION LENG (ERROR-FIELD).
027550*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
027560*     STEST-PARAMS (STEST-PARAM-NUM).
027570*     MOVE "ERROR-FIELD" TO STEST-PARAM-NAME OF 
027580*     STEST-PARAMS (STEST-PARAM-NUM).
027590*     PERFORM STEST-PARAM-CHECK.
027600*     PERFORM STEST-SKIP.
027610*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027620*     = FUNCTION LENG (ERROR-ANSWER).
027630*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
027640*     STEST-PARAMS (STEST-PARAM-NUM).
027650*     MOVE "ERROR-ANSWER" TO STEST-PARAM-NAME OF 
027660*     STEST-PARAMS (STEST-PARAM-NUM).
027670*     PERFORM STEST-PARAM-CHECK.
027680*     PERFORM STEST-FINAL.
027690*STEST-print-sr-148.
027700*     MOVE "b0200xhp.cbl     print.sr  148" TO STEST-KEY.
027710*     MOVE PAUSE-SPECS TO STEST-SCRN-SPECS.
027720*     MOVE FUNCTION ADDR(PAUSE-SPECS) TO STEST-PTR.
027730*     PERFORM STEST-BEGIN.
027740*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027750*     = FUNCTION LENG (FLAG).
027760*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
027770*     STEST-PARAMS (STEST-PARAM-NUM).
027780*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
027790*     STEST-PARAMS (STEST-PARAM-NUM).
027800*     PERFORM STEST-PARAM-CHECK.
027810*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027820*     = FUNCTION LENG (FKEYS).
027830*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
027840*     STEST-PARAMS (STEST-PARAM-NUM).
027850*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
027860*     STEST-PARAMS (STEST-PARAM-NUM).
027870*     PERFORM STEST-PARAM-CHECK.
027880*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027890*     = FUNCTION LENG (PAUSE-SPECS).
027900*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
027910*     STEST-PARAMS (STEST-PARAM-NUM).
027920*     MOVE "PAUSE-SPECS" TO STEST-PARAM-NAME OF 
027930*     STEST-PARAMS (STEST-PARAM-NUM).
027940*     PERFORM STEST-PARAM-CHECK.
027950*     PERFORM STEST-SKIP.
027960*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
027970*     = FUNCTION LENG (ABORT-CONTINUE).
027980*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
027990*     STEST-PARAMS (STEST-PARAM-NUM).
028000*     MOVE "ABORT-CONTINUE" TO STEST-PARAM-NAME OF 
028010*     STEST-PARAMS (STEST-PARAM-NUM).
028020*     PERFORM STEST-PARAM-CHECK.
028030*     PERFORM STEST-FINAL.
028040 STEST-authno-sr-82.
028050      MOVE "b0200xhp.cbl    authno.sr   82" TO STEST-KEY.
028060      MOVE CR-SPECS TO STEST-SCRN-SPECS.
028070      MOVE FUNCTION ADDR(CR-SPECS) TO STEST-PTR.
028080      PERFORM STEST-BEGIN.
028090      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028100      = FUNCTION LENG (FLAG).
028110      MOVE 4 TO STEST-PARAM-W-SIZE OF 
028120      STEST-PARAMS (STEST-PARAM-NUM).
028130      MOVE "FLAG" TO STEST-PARAM-NAME OF 
028140      STEST-PARAMS (STEST-PARAM-NUM).
028150      PERFORM STEST-PARAM-CHECK.
028160      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028170      = FUNCTION LENG (FKEYS).
028180      MOVE 10 TO STEST-PARAM-W-SIZE OF 
028190      STEST-PARAMS (STEST-PARAM-NUM).
028200      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
028210      STEST-PARAMS (STEST-PARAM-NUM).
028220      PERFORM STEST-PARAM-CHECK.
028230      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028240      = FUNCTION LENG (CR-SPECS).
028250      MOVE 14 TO STEST-PARAM-W-SIZE OF 
028260      STEST-PARAMS (STEST-PARAM-NUM).
028270      MOVE "CR-SPECS" TO STEST-PARAM-NAME OF 
028280      STEST-PARAMS (STEST-PARAM-NUM).
028290      PERFORM STEST-PARAM-CHECK.
028300      PERFORM STEST-SKIP.
028310      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028320      = FUNCTION LENG (CR-OPTS).
028330      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
028340      STEST-PARAMS (STEST-PARAM-NUM).
028350      MOVE "CR-OPTS" TO STEST-PARAM-NAME OF 
028360      STEST-PARAMS (STEST-PARAM-NUM).
028370      PERFORM STEST-PARAM-CHECK.
028380      PERFORM STEST-FINAL.
028390 STEST-authno-sr-96.
028400      MOVE "b0200xhp.cbl    authno.sr   96" TO STEST-KEY.
028410      MOVE AUTH-SPECS TO STEST-SCRN-SPECS.
028420      MOVE FUNCTION ADDR(AUTH-SPECS) TO STEST-PTR.
028430      PERFORM STEST-BEGIN.
028440      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028450      = FUNCTION LENG (FLAG).
028460      MOVE 4 TO STEST-PARAM-W-SIZE OF 
028470      STEST-PARAMS (STEST-PARAM-NUM).
028480      MOVE "FLAG" TO STEST-PARAM-NAME OF 
028490      STEST-PARAMS (STEST-PARAM-NUM).
028500      PERFORM STEST-PARAM-CHECK.
028510      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028520      = FUNCTION LENG (FKEYS).
028530      MOVE 10 TO STEST-PARAM-W-SIZE OF 
028540      STEST-PARAMS (STEST-PARAM-NUM).
028550      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
028560      STEST-PARAMS (STEST-PARAM-NUM).
028570      PERFORM STEST-PARAM-CHECK.
028580      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028590      = FUNCTION LENG (AUTH-SPECS).
028600      MOVE 14 TO STEST-PARAM-W-SIZE OF 
028610      STEST-PARAMS (STEST-PARAM-NUM).
028620      MOVE "AUTH-SPECS" TO STEST-PARAM-NAME OF 
028630      STEST-PARAMS (STEST-PARAM-NUM).
028640      PERFORM STEST-PARAM-CHECK.
028650      PERFORM STEST-SKIP.
028660      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028670      = FUNCTION LENG (ORAU-AUTH-NO).
028680      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
028690      STEST-PARAMS (STEST-PARAM-NUM).
028700      MOVE "ORAU-AUTH-NO" TO STEST-PARAM-NAME OF 
028710      STEST-PARAMS (STEST-PARAM-NUM).
028720      PERFORM STEST-PARAM-CHECK.
028730      PERFORM STEST-FINAL.
028740 STEST-b0200xhp-cbl-731.
028750      MOVE "b0200xhp.cbl               731" TO STEST-KEY.
028760      MOVE BATCH-SPECS TO STEST-SCRN-SPECS.
028770      MOVE FUNCTION ADDR(BATCH-SPECS) TO STEST-PTR.
028780      PERFORM STEST-BEGIN.
028790      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028800      = FUNCTION LENG (FLAG).
028810      MOVE 4 TO STEST-PARAM-W-SIZE OF 
028820      STEST-PARAMS (STEST-PARAM-NUM).
028830      MOVE "FLAG" TO STEST-PARAM-NAME OF 
028840      STEST-PARAMS (STEST-PARAM-NUM).
028850      PERFORM STEST-PARAM-CHECK.
028860      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028870      = FUNCTION LENG (FKEYS).
028880      MOVE 10 TO STEST-PARAM-W-SIZE OF 
028890      STEST-PARAMS (STEST-PARAM-NUM).
028900      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
028910      STEST-PARAMS (STEST-PARAM-NUM).
028920      PERFORM STEST-PARAM-CHECK.
028930      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
028940      = FUNCTION LENG (BATCH-SPECS).
028950      MOVE 14 TO STEST-PARAM-W-SIZE OF 
028960      STEST-PARAMS (STEST-PARAM-NUM).
028970      MOVE "BATCH-SPECS" TO STEST-PARAM-NAME OF 
028980      STEST-PARAMS (STEST-PARAM-NUM).
028990      PERFORM STEST-PARAM-CHECK.
029000      PERFORM STEST-SKIP.
029010      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029020      = FUNCTION LENG (USER-BATCH-NO).
029030      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
029040      STEST-PARAMS (STEST-PARAM-NUM).
029050      MOVE "USER-BATCH-NO" TO STEST-PARAM-NAME OF 
029060      STEST-PARAMS (STEST-PARAM-NUM).
029070      PERFORM STEST-PARAM-CHECK.
029080      PERFORM STEST-FINAL.
029090 STEST-b0200xhp-cbl-1907.
029100      MOVE "b0200xhp.cbl              1907" TO STEST-KEY.
029110      MOVE RANGE-SPECS-1 TO STEST-SCRN-SPECS.
029120      MOVE FUNCTION ADDR(RANGE-SPECS-1) TO STEST-PTR.
029130      PERFORM STEST-BEGIN.
029140      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029150      = FUNCTION LENG (FLAG).
029160      MOVE 4 TO STEST-PARAM-W-SIZE OF 
029170      STEST-PARAMS (STEST-PARAM-NUM).
029180      MOVE "FLAG" TO STEST-PARAM-NAME OF 
029190      STEST-PARAMS (STEST-PARAM-NUM).
029200      PERFORM STEST-PARAM-CHECK.
029210      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029220      = FUNCTION LENG (FKEYS).
029230      MOVE 10 TO STEST-PARAM-W-SIZE OF 
029240      STEST-PARAMS (STEST-PARAM-NUM).
029250      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
029260      STEST-PARAMS (STEST-PARAM-NUM).
029270      PERFORM STEST-PARAM-CHECK.
029280      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029290      = FUNCTION LENG (RANGE-SPECS-1).
029300      MOVE 28 TO STEST-PARAM-W-SIZE OF 
029310      STEST-PARAMS (STEST-PARAM-NUM).
029320      MOVE "RANGE-SPECS-1" TO STEST-PARAM-NAME OF 
029330      STEST-PARAMS (STEST-PARAM-NUM).
029340      PERFORM STEST-PARAM-CHECK.
029350      PERFORM STEST-SKIP.
029360      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029370      = FUNCTION LENG (RANGE-CODES).
029380      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
029390      STEST-PARAMS (STEST-PARAM-NUM).
029400      MOVE "RANGE-CODES" TO STEST-PARAM-NAME OF 
029410      STEST-PARAMS (STEST-PARAM-NUM).
029420      PERFORM STEST-PARAM-CHECK.
029430      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029440      = FUNCTION LENG (ORDER-CODES).
029450      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
029460      STEST-PARAMS (STEST-PARAM-NUM).
029470      MOVE "ORDER-CODES" TO STEST-PARAM-NAME OF 
029480      STEST-PARAMS (STEST-PARAM-NUM).
029490      PERFORM STEST-PARAM-CHECK.
029500      PERFORM STEST-FINAL.
029510 STEST-b0200xhp-cbl-1943.
029520      MOVE "b0200xhp.cbl              1943" TO STEST-KEY.
029530      MOVE RANGE-SPECS-2 TO STEST-SCRN-SPECS.
029540      MOVE FUNCTION ADDR(RANGE-SPECS-2) TO STEST-PTR.
029550      PERFORM STEST-BEGIN.
029560      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029570      = FUNCTION LENG (FLAG).
029580      MOVE 4 TO STEST-PARAM-W-SIZE OF 
029590      STEST-PARAMS (STEST-PARAM-NUM).
029600      MOVE "FLAG" TO STEST-PARAM-NAME OF 
029610      STEST-PARAMS (STEST-PARAM-NUM).
029620      PERFORM STEST-PARAM-CHECK.
029630      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029640      = FUNCTION LENG (FKEYS).
029650      MOVE 10 TO STEST-PARAM-W-SIZE OF 
029660      STEST-PARAMS (STEST-PARAM-NUM).
029670      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
029680      STEST-PARAMS (STEST-PARAM-NUM).
029690      PERFORM STEST-PARAM-CHECK.
029700      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029710      = FUNCTION LENG (RANGE-SPECS-2).
029720      MOVE 28 TO STEST-PARAM-W-SIZE OF 
029730      STEST-PARAMS (STEST-PARAM-NUM).
029740      MOVE "RANGE-SPECS-2" TO STEST-PARAM-NAME OF 
029750      STEST-PARAMS (STEST-PARAM-NUM).
029760      PERFORM STEST-PARAM-CHECK.
029770      PERFORM STEST-SKIP.
029780      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029790      = FUNCTION LENG (LOW-ORDER).
029800      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
029810      STEST-PARAMS (STEST-PARAM-NUM).
029820      MOVE "LOW-ORDER" TO STEST-PARAM-NAME OF 
029830      STEST-PARAMS (STEST-PARAM-NUM).
029840      PERFORM STEST-PARAM-CHECK.
029850      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029860      = FUNCTION LENG (HIGH-ORDER).
029870      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
029880      STEST-PARAMS (STEST-PARAM-NUM).
029890      MOVE "HIGH-ORDER" TO STEST-PARAM-NAME OF 
029900      STEST-PARAMS (STEST-PARAM-NUM).
029910      PERFORM STEST-PARAM-CHECK.
029920      PERFORM STEST-FINAL.
029930 STEST-b0200xhp-cbl-1978.
029940      MOVE "b0200xhp.cbl              1978" TO STEST-KEY.
029950      MOVE RANGE-SPECS-3 TO STEST-SCRN-SPECS.
029960      MOVE FUNCTION ADDR(RANGE-SPECS-3) TO STEST-PTR.
029970      PERFORM STEST-BEGIN.
029980      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
029990      = FUNCTION LENG (FLAG).
030000      MOVE 4 TO STEST-PARAM-W-SIZE OF 
030010      STEST-PARAMS (STEST-PARAM-NUM).
030020      MOVE "FLAG" TO STEST-PARAM-NAME OF 
030030      STEST-PARAMS (STEST-PARAM-NUM).
030040      PERFORM STEST-PARAM-CHECK.
030050      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030060      = FUNCTION LENG (FKEYS).
030070      MOVE 10 TO STEST-PARAM-W-SIZE OF 
030080      STEST-PARAMS (STEST-PARAM-NUM).
030090      MOVE "FKEYS" TO STEST-PARAM-NAME OF 
030100      STEST-PARAMS (STEST-PARAM-NUM).
030110      PERFORM STEST-PARAM-CHECK.
030120      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030130      = FUNCTION LENG (RANGE-SPECS-3).
030140      MOVE 42 TO STEST-PARAM-W-SIZE OF 
030150      STEST-PARAMS (STEST-PARAM-NUM).
030160      MOVE "RANGE-SPECS-3" TO STEST-PARAM-NAME OF 
030170      STEST-PARAMS (STEST-PARAM-NUM).
030180      PERFORM STEST-PARAM-CHECK.
030190      PERFORM STEST-SKIP.
030200      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030210      = FUNCTION LENG (ORDH-ORDER-NO).
030220      MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
030230      STEST-PARAMS (STEST-PARAM-NUM).
030240      MOVE "ORDH-ORDER-NO" TO STEST-PARAM-NAME OF 
030250      STEST-PARAMS (STEST-PARAM-NUM).
030260      PERFORM STEST-PARAM-CHECK.
030270      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030280      = FUNCTION LENG (ORDH-SUB-ORDER-NO).
030290      MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
030300      STEST-PARAMS (STEST-PARAM-NUM).
030310      MOVE "ORDH-SUB-ORDER-NO" TO STEST-PARAM-NAME OF 
030320      STEST-PARAMS (STEST-PARAM-NUM).
030330      PERFORM STEST-PARAM-CHECK.
030340      COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030350      = FUNCTION LENG (B0750-PACKER).
030360      MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
030370      STEST-PARAMS (STEST-PARAM-NUM).
030380      MOVE "B0750-PACKER" TO STEST-PARAM-NAME OF 
030390      STEST-PARAMS (STEST-PARAM-NUM).
030400      PERFORM STEST-PARAM-CHECK.
030410      PERFORM STEST-FINAL.
030420*STEST-b0200xhp-cbl-2095.
030430*     MOVE "b0200xhp.cbl              2095" TO STEST-KEY.
030440*     MOVE SPECS-4 TO STEST-SCRN-SPECS.
030450*     MOVE FUNCTION ADDR(SPECS-4) TO STEST-PTR.
030460*     PERFORM STEST-BEGIN.
030470*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030480*     = FUNCTION LENG (FLAG).
030490*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
030500*     STEST-PARAMS (STEST-PARAM-NUM).
030510*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
030520*     STEST-PARAMS (STEST-PARAM-NUM).
030530*     PERFORM STEST-PARAM-CHECK.
030540*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030550*     = FUNCTION LENG (FKEYS).
030560*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
030570*     STEST-PARAMS (STEST-PARAM-NUM).
030580*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
030590*     STEST-PARAMS (STEST-PARAM-NUM).
030600*     PERFORM STEST-PARAM-CHECK.
030610*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030620*     = FUNCTION LENG (SPECS-4).
030630*     MOVE 154 TO STEST-PARAM-W-SIZE OF 
030640*     STEST-PARAMS (STEST-PARAM-NUM).
030650*     MOVE "SPECS-4" TO STEST-PARAM-NAME OF 
030660*     STEST-PARAMS (STEST-PARAM-NUM).
030670*     PERFORM STEST-PARAM-CHECK.
030680*     PERFORM STEST-SKIP.
030690*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030700*     = FUNCTION LENG (YES-NO-PDF).
030710*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
030720*     STEST-PARAMS (STEST-PARAM-NUM).
030730*     MOVE "YES-NO-PDF" TO STEST-PARAM-NAME OF 
030740*     STEST-PARAMS (STEST-PARAM-NUM).
030750*     PERFORM STEST-PARAM-CHECK.
030760*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030770*     = FUNCTION LENG (YES-NO).
030780*     MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
030790*     STEST-PARAMS (STEST-PARAM-NUM).
030800*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
030810*     STEST-PARAMS (STEST-PARAM-NUM).
030820*     PERFORM STEST-PARAM-CHECK.
030830*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030840*     = FUNCTION LENG (YES-NO).
030850*     MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
030860*     STEST-PARAMS (STEST-PARAM-NUM).
030870*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
030880*     STEST-PARAMS (STEST-PARAM-NUM).
030890*     PERFORM STEST-PARAM-CHECK.
030900*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030910*     = FUNCTION LENG (YES-NO).
030920*     MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
030930*     STEST-PARAMS (STEST-PARAM-NUM).
030940*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
030950*     STEST-PARAMS (STEST-PARAM-NUM).
030960*     PERFORM STEST-PARAM-CHECK.
030970*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
030980*     = FUNCTION LENG (YES-NO).
030990*     MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
031000*     STEST-PARAMS (STEST-PARAM-NUM).
031010*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031020*     STEST-PARAMS (STEST-PARAM-NUM).
031030*     PERFORM STEST-PARAM-CHECK.
031040*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031050*     = FUNCTION LENG (YES-NO).
031060*     MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
031070*     STEST-PARAMS (STEST-PARAM-NUM).
031080*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031090*     STEST-PARAMS (STEST-PARAM-NUM).
031100*     PERFORM STEST-PARAM-CHECK.
031110*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031120*     = FUNCTION LENG (YES-NO).
031130*     MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
031140*     STEST-PARAMS (STEST-PARAM-NUM).
031150*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031160*     STEST-PARAMS (STEST-PARAM-NUM).
031170*     PERFORM STEST-PARAM-CHECK.
031180*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031190*     = FUNCTION LENG (YES-NO).
031200*     MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
031210*     STEST-PARAMS (STEST-PARAM-NUM).
031220*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031230*     STEST-PARAMS (STEST-PARAM-NUM).
031240*     PERFORM STEST-PARAM-CHECK.
031250*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031260*     = FUNCTION LENG (YES-NO).
031270*     MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
031280*     STEST-PARAMS (STEST-PARAM-NUM).
031290*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031300*     STEST-PARAMS (STEST-PARAM-NUM).
031310*     PERFORM STEST-PARAM-CHECK.
031320*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031330*     = FUNCTION LENG (YES-NO).
031340*     MOVE FLEN OF STEST-SPECS (10) TO STEST-PARAM-W-SIZE OF 
031350*     STEST-PARAMS (STEST-PARAM-NUM).
031360*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031370*     STEST-PARAMS (STEST-PARAM-NUM).
031380*     PERFORM STEST-PARAM-CHECK.
031390*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031400*     = FUNCTION LENG (YES-NO).
031410*     MOVE FLEN OF STEST-SPECS (11) TO STEST-PARAM-W-SIZE OF 
031420*     STEST-PARAMS (STEST-PARAM-NUM).
031430*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031440*     STEST-PARAMS (STEST-PARAM-NUM).
031450*     PERFORM STEST-PARAM-CHECK.
031460*     PERFORM STEST-FINAL.
031470*STEST-b0200xhp-cbl-2104.
031480*     MOVE "b0200xhp.cbl              2104" TO STEST-KEY.
031490*     MOVE SPECS-5 TO STEST-SCRN-SPECS.
031500*     MOVE FUNCTION ADDR(SPECS-5) TO STEST-PTR.
031510*     PERFORM STEST-BEGIN.
031520*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031530*     = FUNCTION LENG (FLAG).
031540*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
031550*     STEST-PARAMS (STEST-PARAM-NUM).
031560*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
031570*     STEST-PARAMS (STEST-PARAM-NUM).
031580*     PERFORM STEST-PARAM-CHECK.
031590*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031600*     = FUNCTION LENG (FKEYS).
031610*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
031620*     STEST-PARAMS (STEST-PARAM-NUM).
031630*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
031640*     STEST-PARAMS (STEST-PARAM-NUM).
031650*     PERFORM STEST-PARAM-CHECK.
031660*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031670*     = FUNCTION LENG (SPECS-5).
031680*     MOVE 28 TO STEST-PARAM-W-SIZE OF 
031690*     STEST-PARAMS (STEST-PARAM-NUM).
031700*     MOVE "SPECS-5" TO STEST-PARAM-NAME OF 
031710*     STEST-PARAMS (STEST-PARAM-NUM).
031720*     PERFORM STEST-PARAM-CHECK.
031730*     PERFORM STEST-SKIP.
031740*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031750*     = FUNCTION LENG (ACCEPT-OPTS).
031760*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
031770*     STEST-PARAMS (STEST-PARAM-NUM).
031780*     MOVE "ACCEPT-OPTS" TO STEST-PARAM-NAME OF 
031790*     STEST-PARAMS (STEST-PARAM-NUM).
031800*     PERFORM STEST-PARAM-CHECK.
031810*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
031820*     = FUNCTION LENG (YES-NO).
031830*     MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
031840*     STEST-PARAMS (STEST-PARAM-NUM).
031850*     MOVE "YES-NO" TO STEST-PARAM-NAME OF 
031860*     STEST-PARAMS (STEST-PARAM-NUM).
031870*     PERFORM STEST-PARAM-CHECK.
031880*     PERFORM STEST-FINAL.
031890*FILESUFFIX SECTION.
031900*TAGMF-NAMESUFFIXCHECK.
031910*     COPY "SUFFIXS.CBL" REPLACING ==FILENAME== BY 
031920*     ==TAGMF-FULLPATH==.
