000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    PI305 IS INITIAL.
000300 AUTHOR.        KEN SILER, JR.
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION.
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
000800*REMARKS.
000900 COPY "LEGAL.DTA".
001000*-      PI305   PRINTS RATE SHEET TICKETS   OTC PRINTER
001100*-
110603* FIX SKI V3.0 - FUJITSU MODS                                    *
111706* UPD KWS V4.1 - ALLOW DIRECT PRINTING TO LPT PORTS              *
072009* UPD KWS V4.4 - MAKE WORK UNDER V4.4 USING DIRECT PRINTING      *
062510* UPD KWS V4.5.1 - MAKE WORK IN V4.5 USING DIRECT PRINTING       *
022511* FIX KWS V4.5.3 - FIX ITRN LOGIC                                *
005500******************************************************************
005600 INPUT-OUTPUT SECTION.
005700 FILE-CONTROL.
005800
005900     COPY "RATEF.SL".
006000     COPY "PRNTR.SL".
PROFIT     COPY "USERF.SL".
PROFIT     COPY "CNTLF.SL".
121586     COPY "CUT2F.SL".
006300     COPY "CUTTF.SL".
081287     COPY "STYLF.SL".
112390     COPY "ITRNF.SL".
112390     COPY "ITEMF.SL".
062510*    COPY "MUCTF.SL".
062510     COPY "SCATF.SL".
           COPY "STEST.SL".
006500 DATA DIVISION.
       BASED-STORAGE SECTION.
           COPY "STEST.BS".
006600 FILE SECTION.
006700
006800*    PRNTR.FD   PRINT FILE DESCRIPTION.
006900
007000 FD  LO
007100     LABEL RECORDS ARE OMITTED.
007200
007300 01  PRINT-REC.
080394*    03 SCREEN-REC       PIC X(152).
080394     03 SCREEN-REC       PIC X(156).
080596 01  PRINT-REC-90        PIC X(90).
004100 01  PITCH-REC    .
004200     05  FILLER               PIC X(8).
040793 01  SETUP-REC.
040793     05  FILLER               PIC X(50).
003800*------ THE FOLLOWING ARE USED TO CONTROL BAR CODE PRINTING ------
003900 01  LINE-REC  .
004000     05  FILLER               PIC XXXX.
003900 01  BAR-REC-2.
061494     05  FILLER               PIC X(27).
061494*    05  FILLER               PIC X(36).
       01  BAR-REC-4   .
061494     05  FILLER               PIC X(55).
061494*    05  FILLER               PIC X(72).
061494 01  BAR-REC-2-OKI3410.
061494     05  FILLER               PIC X(36).
061494 01  BAR-REC-4-OKI3410.
061494     05  FILLER               PIC X(72).
007500
009200     COPY "RATEF.FD".
009300     COPY "CUTTF.FD".
121586     COPY "CUT2F.FD".
081287     COPY "STYLF.FD".
PROFIT     COPY "USERF.FD".
PROFIT     COPY "CNTLF.FD".
PROFIT     COPY "PWCTF.FD".
112390     COPY "ITRNF.FD".
112390     COPY "ITEMF.FD".
062510*    COPY "MUCTF.FD".
062510     COPY "SCATF.FD".
           COPY "STEST.FD".
009700 WORKING-STORAGE SECTION.
009800
PROFIT 01  USERF-STATUS        PIC XX.
PROFIT 01  CNTLF-STATUS        PIC XX.
009900 01  RATEF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
010000 01  CUTTF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
010100 01  CUT2F-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
081287 01  STYLF-STATUS        PIC XX.
112390 01  ITEMF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
112390 01  ITRNF-STATUS        PIC XX.
062510*01  ITRNF-KEY            PIC 9(5) VALUE 1.
062501*77  MUCTF-STATUS        PIC XX VALUE SPACES.
062501*77  MUCTF-KEY            PIC 9(5) VALUE 1.
062510     COPY "SCATF.DTA".
062510     COPY "APPAREL.DTA".

080696 77  INVENTORY-INTERFACE-FLAG   PIC 9   VALUE 2.
080696     88 INTERFACE-TO-INVENTORY          VALUE 1.
111706 77  WS-PTR-PORT         PIC X(05)      VALUE "LPT1:".
PROFIT 01  PR-CNDSE            PIC X(9).
PROFIT 01  WS-RED              PIC X(4).
PROFIT 01  WS-BLACK            PIC X(4).
071398 77  HOLD-BARCODE-EMULATION PIC 9 VALUE 5.
010300 01  LINE-NO             PIC 9(2).
010400 01  PAGE-NO             PIC 9(4).
010500 01  RATE-COUNT          PIC 99     VALUE 0.
010600 01  TOTAL-RATE          PIC 999999 VALUE 0.
102991 01  TOT-SAM-SAH-4       PIC 9(3)V9(4) VALUE ZERO.
102991 01  TOT-SAM-SAH-2       PIC 9(3)V9(2) VALUE ZERO.
010700 01  LAST-RATE-STYLE     PIC X(8) VALUE "########".
010800 01  SKIP                PIC 9      VALUE 1.
010900 01  LO-STATUS           PIC XX.
011000 01  INDEX-OCCURS        PIC 9(1).
011100 01  INDEX-PERFORM       PIC 9(1).
011200 01  ESC-FLAG            PIC 9     VALUE ZERO.
011300 01  LOW-CUT             PIC X(5)  VALUE LOW-VALUES.
       01  HIGH-CUT            PIC X(5)  VALUE HIGH-VALUES.
       01  LOW-BUNDLE          PIC X(6)  VALUE ZEROES.
       01  HIGH-BUNDLE         PIC X(6)  .
011700 01  NAME1              PIC X(32) VALUE SPACES.
011800 01  NAME2              PIC X(32) VALUE SPACES.
011900 01  NAME3              PIC X(32) VALUE SPACES.
012000 01  NAME4              PIC X(32) VALUE SPACES.
022789 01  NAME5.
012200     05  BAR-RATE-NUM   PIC X(6) VALUE SPACES.
013089     05  BAR-BUNDLE-NUM PIC X(6) VALUE SPACES.
012400 01  NAME6              PIC X(32) VALUE SPACES.
012500 01  INAME1             PIC X(6) VALUE SPACES.
012600 01  INAME2.
012700     05  INAME2-PART1   PIC X(5) VALUE SPACES.
012800     05  INAME2-PART2   PIC X VALUE SPACES.
012900 01  INAME3             PIC X(6) VALUE SPACES.
013000 01  INAME4             PIC X(6) VALUE SPACES.
013100 01  INAME6             PIC X(6) VALUE SPACES.
013200 01  QTY                PIC 999 USAGE IS COMP.
030586 01  PAY-RATE           PIC 999V9999  USAGE IS COMP.
022092 01  PAY-AMOUNT         PIC 999V9(5)  USAGE IS COMP.
022092 01  RND-2-DECIMAL      PIC 999V99    COMP-3.
022092 01  RND-3-DECIMAL      PIC 999V999   COMP-3.
013500 01  NUMBER-ACROSS      PIC 9.
013089 01  BUNDLE-NUM      PIC 999999.
013700 01  SPACES-LINE      PIC XXX VALUE SPACES.
042987 01  STATUS-MESSAGES.
013900     05  PRINTING-COUPONS PIC X(16) VALUE "Printing Coupons".
014000     05  DELETE-CUT2-MSG  PIC X(29) VALUE
014100         "Deleting Old Cutting2 Records".
014200     05  WRITE-CUT2-MSG   PIC X(24) VALUE
014300         "Writing Cutting2 Records".
014400     05  SEARCHING-MSG    PIC X(25) VALUE
014500         "Searching For Next Bundle".
070987     05  DUP-BUNDLE-MSG   PIC X(55) VALUE
014700      " Bundle # already inuse wtih different cut # in CUT2F! ".
042987     COPY "PI3001.DSP".
PROFIT*    COPY "BOARDER.DSP".
PROFIT     COPY "CONSTANT.DTA".
111706     COPY "CHAINR.DTA".
PROFIT     COPY "PWFILES.DTA".
003800*------ THE FOLLOWING ARE USED TO CONTROL BAR CODE PRINTING ------
004300 01  BARCODE-SETUP-STRING.
           05  FILLER               PIC X VALUE X"1B".
           05  FILLER               PIC X VALUE "[".
      *-- TYPE OF BAR CODE - C39=4; I25=0; UPCA=13----*
004400     05  BAR-CODE             PIC X VALUE X"30".
           05  FILLER               PIC X VALUE ";".
      *-- BAR HEIGHT - n/12 OF AN INCH --*
           05  HEIGHT                PIC X VALUE X"31".
           05  FILLER               PIC X VALUE ";".
      *-- HUMAN READABLE LINE - 0=NO; 1=YES --*
           05  READABLE             PIC X VALUE X"30".
           05  FILLER               PIC X VALUE "}".
040793     05  FILLER               PIC X(06) VALUE LOW-VALUES.
004500 01  ON-REC.
004600     05  FILLER               PIC X VALUE X"1B".
040793*    05  FILLER               PIC X(3) VALUE "[3t".
040793     05  ON-REC-STRING        PIC X(3) VALUE X"5B3374".
004700 01  OFF-REC.
000000     05  FILLER               PIC X VALUE X"1B".
           05  FILLER               PIC X(3) VALUE "[0t".
       01  TAB-SETUP-STRING.
           05  FILLER               PIC X(7) VALUE X"1B440327406400".
101392*    05  FILLER               PIC X(7) VALUE X"1B440328406400".

040793 01  OKI-3410-SETUP-STRING.
040793     05  OKI-3410-SETUP       PIC X(04) VALUE X"1B104138".
040793*    05  OKI-3410-CODE-39     PIC X(02) VALUE  X"3230".
040793     05  OKI-3410-CODE-2OF5   PIC X(02) VALUE  X"3330".
040793*--- VERTICAL SIZE, 01 = .0833, 10 = .8333, 24 = 2" (MAX) ---*    
040793     05  OKI-3410-HEIGHT      PIC X(02) VALUE X"3031".
040793     05  OKI-3410-BAR-WIDTH   PIC X(03) VALUE X"313131".
040793*--- HUMAN READABLE 0=NONE, 1=UTIL, 2=NLQ                  ---*
040793     05  OKI-3410-HUMAN-READ  PIC X(01) VALUE X"30".
018200
018300 01  BAR-CODE-LABELS.
           03 BAR-CODE-LABELS-2.
              05  FILLER            PIC X(1) VALUE X"09".
018400        05  BAR-LABEL-1       PIC X(12) VALUE SPACES.
              05  FILLER            PIC X(1) VALUE ",".
              05  FILLER            PIC X(1) VALUE X"09".
018500        05  BAR-LABEL-2       PIC X(12) VALUE SPACES.
           03  FILLER               PIC X(1) VALUE ",".
           03  FILLER               PIC X(1) VALUE X"09".
018600     03  BAR-LABEL-3          PIC X(12) VALUE SPACES.
           03  FILLER               PIC X(1) VALUE ",".
           03  FILLER               PIC X(1) VALUE X"09".
018700     03  BAR-LABEL-4          PIC X(12) VALUE SPACES.

040793 01  OKI-BAR-CODE-LABELS.
040793     03 OKI-BAR-CODE-LABELS-2.
040793        05  FILLER            PIC X(1) VALUE X"09".
071393        05  FILLER            PIC X(4) VALUE X"1B10420C".
040793        05  OKI-BAR-LABEL-1   PIC X(12) VALUE SPACES.
071393*       05  FILLER            PIC X(1) VALUE "@".
040793        05  FILLER            PIC X(1) VALUE X"09".
071393        05  FILLER            PIC X(4) VALUE X"1B10420C".
040793        05  OKI-BAR-LABEL-2   PIC X(12) VALUE SPACES.
071393*       05  FILLER            PIC X(1) VALUE "@".
040793     03  FILLER               PIC X(1) VALUE X"09".
040793     03  FILLER               PIC X(4) VALUE X"1B10420C".
040793     03  OKI-BAR-LABEL-3      PIC X(12) VALUE SPACES.
071393*    03  FILLER               PIC X(1) VALUE "@".
040793     03  FILLER               PIC X(1) VALUE X"09".
040793     03  FILLER               PIC X(4) VALUE X"1B10420C".
040793     03  OKI-BAR-LABEL-4      PIC X(12) VALUE SPACES.

121586 77  ARRAY-CNT                PIC 99 VALUE 0.
121586 77  SEQ-NUM                  PIC 99 VALUE 0.
101303*77  OUTPUT-FILE              PIC X(12) VALUE "TICKETS.PRN".
023600
023700     COPY "SCREEN.DTA".
023800     COPY "ERROR.DTA".
023900     COPY "ERRORP.DTA".
024000     COPY "DATE.DTA".
PROFIT     COPY "STATUS.DTA".
072009     COPY "LPPRINT.DTA".
070987     COPY "WAIT.INP".
070987     COPY "WAIT.OPT".
072009*     COPY "PAUSE.DTA".
062510      COPY "PAUSE.DTA".
062510*77  PAUSE-LINE          PIC 99   VALUE 19.
024500
024600
024700 01  RANGE-DATA.
024800     05  RANGE-MSG      PIC X(23) VALUE "Do you want tickets by?".
024900     05  RANGE-CODES.
062187         10  RC-1       PIC X(12)  VALUE "All-Bundles".
062187         10  RC-2       PIC X(12)  VALUE "All-Cuts ".
062187         10  RC-3       PIC X(12) VALUE "Bundle Range".
062187         10  RC-4ER     PIC X(12) VALUE "Cut Range".
025400     05  RANGE-SPECS-1.
025500         10  FILLER     PIC X(9)  VALUE "1143O0412".
025600         10  OPTION     PIC 9     VALUE 1.
025700         10  FILLER     PIC X(4)  VALUE "E   ".
025800 01  RANGE-HELP-1.
025900     05  FILLER PIC X(103)   VALUE " Select ALL to print all unpri
026000-    "nted tickets or RANGE to print one or a group      of unprin
026100-    "ted tickets.$".
026200 01  RANGE-STUFF.
026300     05 RANGE-LOW-MSG  PIC X(23) VALUE "First Bundle to print -".
026400     05 RANGE-HIGH-MSG PIC X(23) VALUE "Last  Bundle to print -".
026500     05  RANGE-SPECS-2.
013089         10  FILLER     PIC X(14) VALUE "1343D06060    ".
013089         10  FILLER     PIC X(14) VALUE "1443D06060    ".
026800 01  RANGE-STUFF2.
026900     05 RANGE-LOW-MSG-3  PIC X(23) VALUE "First Cut # to print -".
027000     05 RANGE-HIGH-MSG-3 PIC X(23) VALUE "Last  Cut # to print -".
027100     05 RANGE-SPECS-3.
027200         10  FILLER     PIC X(14) VALUE "1343X05050    ".
027300         10  FILLER     PIC X(14) VALUE "1443X05050    ".
027400 01  RANGE-HELP-3.
027500     05        HELP-1   PIC X(116) VALUE " Enter the number of the
027600-    " first Cut.     To print a single one, make the   first and 
027700-    " the last one the same.$ ".
027800     05        HELP-1   PIC X(116) VALUE " Enter the number of the
027900-    " last  Cut.     To print a single one, make the   first and 
028000-    " the last one the same.$".
028100 01  RANGE-HELP-2.
028200     05        HELP-1   PIC X(116) VALUE " Enter the number of the
028300-    " first Bundle.  To print a single one, make the   first and 
028400-    " the last one the same.$ ".
028500     05        HELP-1   PIC X(116) VALUE " Enter the number of the
028600-    " last  Bundle.  To print a single one, make the   first and 
028700-    " the last one the same.$".
028800 01  RANGE-ERR-1    PIC X(47) VALUE
028900         " That is an invalid range, please try another. ".
029000 01  RANGE-ERR-2    PIC X(51) VALUE
029100         " There are none in this range, please try another. ".
029200 01  FORM-STYLE.
029300     05 FORM-MSG  PIC X(31)
029400        VALUE "Print on          ticket stock".
029500     05 FORM-ANSWER.
029600        10 FILLER  PIC X(6) VALUE "2 Wide".
029700        10 FILLER  PIC X(6) VALUE "4 Wide".
029800     05 FORM-SPECS.
029900        10 FILLER   PIC X(9) VALUE "1135O0206".
030000        10 OPTION   PIC X(1) VALUE "1".
030100        10 FILLER   PIC X(4) VALUE "E   ".
030200 01  FORM-HELP .
030300     05  FILLER PIC X(071)   VALUE " Select the type of ticket sto
030400-    "ck you are using.  Either 2 or 4 across.$".
030500 01  INSERT-MSG.
030600     05  FILLER PIC X(026)  VALUE
030700         "Insert tickets in printer!".
030800 01  VALUE-QUESTION.
030900     05 VALUE-MSG  PIC X(21)
031000        VALUE "Print coupon value? ".
021689     05 VALUE-ANSWER.
021689        10 FILLER  PIC X(18) VALUE "Rate Only         ".
021689        10 FILLER  PIC X(18) VALUE "Extended Amt. Only".
021689        10 FILLER  PIC X(18) VALUE "Rate & Extention  ".
021689        10 FILLER  PIC X(18) VALUE "Neither           ".
021689     05 VALUE-SPECS.
021689        10 FILLER   PIC X(9) VALUE "1250O0418".
021689        10 OPTION   PIC X(1) VALUE "3".
021689        10 FILLER   PIC X(4) VALUE "E   ".
031800 01  VALUE-HELP .
031000     05  FILLER PIC X(071)   VALUE " Select the type of coupon val
031100-    "ue you would like to have printed.      $".
032100
032200
032300 01  CONTROL-TICKET.
032400     03 C-LINE1.
020386        05 CRTL-RED1          PIC X(4).
033089        05 FILLER             PIC X(05)    VALUE " ****".
082289        05 CRTL-CUT           PIC X(05)    VALUE SPACES.
082289        05 FILLER             PIC X(03)    VALUE "***".
033089        05 CRTL-BUNDLE        PIC 999999.
082289        05 FILLER             PIC X(05)  VALUE "**** ".
020386        05 CRTL-BLACK1        PIC X(4).
032900     03 C-LINE2.
020386        05 CRTL-RED2          PIC X(4).
033100        05 FILLER             PIC X(2) VALUE " *".
033200        05 CRTL-DESC          PIC X(20).
033300        05 FILLER             PIC X(2) VALUE "* ".
020386        05 CRTL-BLACK2        PIC X(4).
033500     03 C-LINE3.
020386        05 CRTL-RED3          PIC X(4) VALUE SPACES.
033700        05 FILLER             PIC X(5) VALUE " *   ".
033800        05 CRTL-STYLE-NUM     PIC X(8).
033900        05 FILLER             PIC XX VALUE SPACE.
034000        05 CRTL-QTY           PIC ZZ9.
034100        05 FILLER             PIC X(6) VALUE "    * ".
020386        05 CRTL-BLACK3        PIC X(4).
034300     03 C-LINE4.
020386        05 CRTL-RED4          PIC X(4).
034500        05 FILLER             PIC X(9) VALUE " ********".
034600        05 CRTL-DATE.
034700          07 CRTL-MONTH       PIC XX.
034800          07 FILLER           PIC X VALUE "/".
034900          07 CRTL-DAY         PIC XX.
035000          07 FILLER           PIC X VALUE "/".
035100          07 CRTL-YEAR        PIC XX.
035200        05 FILLER             PIC X(7) VALUE "****** ".
020386        05 CRTL-BLACK4        PIC X(4).
030686     03 C-LINE6.
020386        05 CRTL-BLACK6A       PIC X(4).
030686        05 FILLER             PIC X(24) VALUE SPACES.
020386        05 CRTL-BLACK6B       PIC X(4).
035800
035900
036000  01 OPER-TICKET.
036100     03 O-LINE1.
020386        05 OPER-BLACK1A       PIC X(4).
036300        05 FILLER             PIC X VALUE " ".
036400        05 OPER-OPER-NUM      PIC X(6).
036500        05 FILLER             PIC X(2) VALUE "  ".
036600        05 OPER-TICK-NAME     PIC X(8).
036700        05 FILLER             PIC X(3) VALUE SPACES.
036800        05 OPER-QTY           PIC ZZ9.
036900        05 FILLER             PIC X VALUE SPACES.
020386        05 OPER-BLACK1B       PIC X(4).
037100    03 O-LINE2.
020386        05 OPER-BLACK2A       PIC X(4).
037300        05 FILLER             PIC X VALUE SPACES.
037400        05 OPER-CUT-NUM       PIC X(5).
037500        05 FILLER             PIC X(3) VALUE SPACE.
037600        05 OPER-COLOR         PIC X(6).
037700        05 FILLER             PIC X(1) VALUE SPACE.
037800        05 OPER-RATE          PIC Z9.9999 BLANK ZERO.
020386        05 OPER-BLACK2B       PIC X(4).
038000     03 O-LINE3.
              05 OPER-RED           PIC X(4).
013089        05 OPER-BUNDLE-NUM    PIC BZZZZZ9.
              05 OPER-BLACK         PIC X(4).
038400        05 FILLER             PIC X(2) VALUE SPACES.
038500        05 OPER-SIZE          PIC X(5).
060894        05 OPER-DUP-DESIGN    PIC X VALUE SPACES.
038700        05 FILLER             PIC X VALUE SPACES.
              05 OPER-VALUE         PIC ZZ9.999B BLANK ZERO.
030392*       05 OPER-BLACK3B       PIC X(4).
039000     03 O-LINE4.
020386        05 OPER-BLACK4A       PIC X(4).
039200        05 FILLER             PIC X VALUE SPACES.
039300        05 OPER-MISC-1        PIC X(10).
039400        05 FILLER             PIC X(2) VALUE SPACES.
039500        05 OPER-MISC-2        .
061891           10 OPER-TOT-SAM        PIC BBZZZ.9999.
020386        05 OPER-BLACK4B       PIC X(4).
030686     03 O-LINE6.
030686        05 OPER-BLACK6A       PIC X(4).
030686        05 FILLER             PIC X VALUE SPACES.
030686        05 OPER-COUP-MISC     PIC X(20).
030686        05 FILLER             PIC X(1) VALUE SPACES.
030686        05 OPER-BLACK6B       PIC X(4).
040300
040400  01 VOID-TICKET.
040500     03 V-LINE1.
020386        05 VOID-BLACK1A       PIC X(4).
040700        05 FILLER             PIC X VALUE " ".
040800        05 VOID-OPER-NUM      PIC X(6).
040900        05 FILLER             PIC X(2) VALUE "  ".
041000        05 VOID-TICK-NAME     PIC X(8).
041100        05 FILLER             PIC X(3) VALUE SPACES.
041200        05 VOID-QTY           PIC ZZ9.
041300        05 FILLER             PIC X VALUE SPACES.
020386        05 VOID-BLACK1B       PIC X(4).
041500     03 V-LINE2.
020386        05 VOID-BLACK2A       PIC X(4).
041700        05 FILLER             PIC X VALUE SPACES.
041800        05 VOID-CUT-NUM       PIC X(5).
041900        05 FILLER             PIC X(5) VALUE SPACE.
042000        05 VOID-COLOR         PIC X(6).
042100        05 VOID-RATE          PIC XXXXXXX VALUE SPACES.
020386        05 VOID-BLACK2B       PIC X(4).
042300     03 V-LINE3.
042400        05 VOID-RED           PIC X(4).
041295        05 VOID-BUNDLE-NUM    PIC BZZZZZ9.
042600        05 VOID-BLACK         PIC X(4).
042700        05 FILLER             PIC X(2) VALUE SPACES.
042800        05 VOID-SIZE          PIC X(5).
042900        05 VOID-DUP-DESIGN    PIC X.
043000        05 FILLER             PIC X VALUE SPACES.
043100        05 VOID-VALUE         PIC XXXXXXXX VALUE SPACES.
043200     03 V-LINE4.
020386        05 VOID-BLACK4A       PIC X(4).
043400        05 FILLER             PIC X VALUE SPACES.
043500        05 VOID-MISC-1        PIC X(10).
043600        05 FILLER             PIC X(2) VALUE SPACES.
043700        05 VOID-MISC-2        PIC X(10).
020386        05 VOID-BLACK4B       PIC X(4).
030686     03 V-LINE6.
030686        05 VOID-BLACK6A       PIC X(4).
030686        05 FILLER             PIC XX VALUE SPACES.
030686        05 VOID-COUP-MISC     PIC X(20).
030686        05 FILLER             PIC X(1) VALUE SPACES.
030686        05 VOID-BLACK6B       PIC X(4).
044500
044600
044700 01  PR-LINE1.
044800     05 L1-TICKET-1       PIC X(32) VALUE SPACES.
060894     05 L1-FILLER-1       PIC X(01) VALUE SPACES.
044900     05 L1-INIT-1         PIC X(6) VALUE SPACES.
045000     05 L1-INIT-2         PIC X(6) VALUE SPACES.
060894     05 L1-FILLER-2       PIC X(01) VALUE SPACES.
045100     05 L1-TICKET-2       PIC X(32) VALUE SPACES.
045200     05 L1-TICKET-3       PIC X(32) VALUE SPACES.
060894     05 L1-FILLER-3       PIC X(01) VALUE SPACES.
045300     05 L1-INIT-3         PIC X(6) VALUE SPACES.
045400     05 L1-INIT-4         PIC X(6) VALUE SPACES.
060894     05 L1-FILLER-4       PIC X(01) VALUE SPACES.
045500     05 L1-TICKET-4       PIC X(32) VALUE SPACES.
045600 01  PR-LINE2.
045700     05 L2-TICKET-1       PIC X(32) VALUE SPACES.
060894     05 L2-FILLER-1       PIC X(01) VALUE SPACES.
045800     05 L2-INIT-1         PIC X(6) VALUE SPACES.
045900     05 L2-INIT-2         PIC X(6) VALUE SPACES.
060894     05 L2-FILLER-2       PIC X(01) VALUE SPACES.
046000     05 L2-TICKET-2       PIC X(32) VALUE SPACES.
046100     05 L2-TICKET-3       PIC X(32) VALUE SPACES.
060894     05 L2-FILLER-3       PIC X(01) VALUE SPACES.
046200     05 L2-INIT-3         PIC X(6) VALUE SPACES.
046300     05 L2-INIT-4         PIC X(6) VALUE SPACES.
060894     05 L2-FILLER-4       PIC X(01) VALUE SPACES.
046400     05 L2-TICKET-4       PIC X(32) VALUE SPACES.
046500 01  PR-LINE3.
046600     05 L3-TICKET-1      PIC X(32) VALUE SPACES.
060894     05 L3-FILLER-1       PIC X(01) VALUE SPACES.
046700     05 L3-INIT-1         PIC X(6) VALUE SPACES.
046800     05 L3-INIT-2         PIC X(6) VALUE SPACES.
060894     05 L3-FILLER-2       PIC X(01) VALUE SPACES.
046900     05 L3-TICKET-2       PIC X(32) VALUE SPACES.
047000     05 L3-TICKET-3       PIC X(32) VALUE SPACES.
060894     05 L3-FILLER-3       PIC X(01) VALUE SPACES.
047100     05 L3-INIT-3         PIC X(6) VALUE SPACES.
047200     05 L3-INIT-4         PIC X(6) VALUE SPACES.
060894     05 L3-FILLER-4       PIC X(01) VALUE SPACES.
047300     05 L3-TICKET-4       PIC X(32) VALUE SPACES.
047400 01  PR-LINE4.
047500     05 L4-TICKET-1       PIC X(32) VALUE SPACES.
060894     05 L4-FILLER-1       PIC X(01) VALUE SPACES.
047600     05 L4-INIT-1         PIC X(6) VALUE SPACES.
047700     05 L4-INIT-2         PIC X(6) VALUE SPACES.
060894     05 L4-FILLER-2       PIC X(01) VALUE SPACES.
047800     05 L4-TICKET-2       PIC X(32) VALUE SPACES.
047900     05 L4-TICKET-3       PIC X(32) VALUE SPACES.
060894     05 L4-FILLER-3       PIC X(01) VALUE SPACES.
048000     05 L4-INIT-3         PIC X(6) VALUE SPACES.
048100     05 L4-INIT-4         PIC X(6) VALUE SPACES.
060894     05 L4-FILLER-4       PIC X(01) VALUE SPACES.
048200     05 L4-TICKET-4       PIC X(32) VALUE SPACES.
048300 01  PR-LINE6.
048400     05 L6-TICKET-1       PIC X(32) VALUE SPACES.
060894     05 L6-FILLER-1       PIC X(01) VALUE SPACES.
048500     05 L6-INIT-1         PIC X(6) VALUE SPACES.
048600     05 L6-INIT-2         PIC X(6) VALUE SPACES.
060894     05 L6-FILLER-2       PIC X(01) VALUE SPACES.
048700     05 L6-TICKET-2       PIC X(32) VALUE SPACES.
048800     05 L6-TICKET-3       PIC X(32) VALUE SPACES.
060894     05 L6-FILLER-3       PIC X(01) VALUE SPACES.
048900     05 L6-INIT-3         PIC X(6) VALUE SPACES.
049000     05 L6-INIT-4         PIC X(6) VALUE SPACES.
060894     05 L6-FILLER-4       PIC X(01) VALUE SPACES.
049100     05 L6-TICKET-4       PIC X(32) VALUE SPACES.
049200
049300 01  SET-PITCH.
049400     03 PR-SIZE-CODE     PIC X(4).
049500     03 PR-COLOR-CODE    PIC X(4).
049600
062187 01  FUNCTION-FLAG            PIC 9 VALUE 1.
049800     88 NEW-TICKETS     VALUE 1.
049900     88 REPRINT-TICKETS VALUE 2.
PROFIT 77  PROG-NAME           PIC X(8) VALUE "PI305 ".
CLNUP1 77  CNTLF--NAME PIC X(15) VALUE "CONTROL.FIL" .
CLNUP1 77  CNTLF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  TEMP-SUB-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  USERF--NAME PIC X(15) VALUE "USER.FIL" .
CLNUP1 77  USERF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  ITEMF--NAME PIC X(15) VALUE "ITEM.FIL" .
CLNUP1 77  ITEMF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 01  IO-WAIT-CD  PIC X VALUE "1"                                  
CLNUP1     88 IO-WAIT-ON VALUE IS "1".
CLNUP1     88 IO-WAIT-OFF VALUE IS "0".
            COPY "STEST.DTA".
CLNUP1 77  ITRNF--NAME PIC X(15) VALUE "INVTRAN.FIL" .
CLNUP1 77  ITRNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
CLNUP1 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
CLNUP1 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.
       SCREEN SECTION.
CLNUP1     COPY "CONSTANT.SCR".
CLNUP1     COPY "SCRNINIT.SCR".
CLNUP1     COPY "ERRORFIL.SCR".
CLNUP1     COPY "PRINT.SCR".   
CLNUP1     COPY "WAIT.SCR".    
CLNUP1     COPY "CHAINR.SCR".
072009     COPY "PAUSE.SCR".  
CLNUP1                         
       01 SCR-pi305-cbl-576-23 PIC IS X(45) FROM NOT-PURCHASED-MSG 
            CONTROL DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-732-20 PIC IS X(23) FROM RANGE-MSG CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 19.
       01 SCR-pi305-cbl-750-23 PIC IS X(23) FROM RANGE-LOW-MSG CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 19.
       01 SCR-pi305-cbl-751-23 PIC IS X(23) FROM RANGE-HIGH-MSG CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 19.
       01 SCR-pi305-cbl-755-23 PIC IS X(23) FROM RANGE-LOW-MSG-3 CONTROL
             DSPL--CONTROL LINE 13 COLUMN 19.
       01 SCR-pi305-cbl-756-23 PIC IS X(23) FROM RANGE-HIGH-MSG-3 
            CONTROL DSPL--CONTROL LINE 14 COLUMN 19.
       01 SCR-pi305-cbl-763-24 PIC IS X(47) FROM RANGE-ERR-1 CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-pi305-cbl-768-24 PIC IS X(47) FROM RANGE-ERR-1 CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-pi305-cbl-775-24 PIC IS X(51) FROM RANGE-ERR-2 CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-pi305-cbl-782-20 CONTROL DSPL--CONTROL.
        02 PIC X(80) FROM SCRN-1-1-80 LINE 4 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-81-160 LINE 5 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-161-240 LINE 6 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-241-320 LINE 7 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-321-400 LINE 8 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-401-480 LINE 9 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-481-560 LINE 10 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-561-640 LINE 11 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-641-720 LINE 12 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-721-800 LINE 13 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-801-880 LINE 14 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-881-960 LINE 15 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-961-1040 LINE 16 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-1041-1120 LINE 17 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-1121-1200 LINE 18 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-1201-1280 LINE 19 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-1281-1360 LINE 20 COLUMN 1 .
       01 SCR-pi305-cbl-791-20 PIC IS X(25) FROM SEARCHING-MSG CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 27.
       01 SCR-pi305-cbl-792-20 VALUE IS "        " CONTROL DSPL--CONTROL
             LINE 10 COLUMN 42.
       01 SCR-pi305-cbl-793-20 VALUE IS "     " CONTROL DSPL--CONTROL 
            LINE 11 COLUMN 45.
       01 SCR-pi305-cbl-796-20 PIC IS X(5) FROM CUTT-CUT-NUMBER CONTROL 
            DSPL--CONTROL LINE 8 COLUMN 45.
       01 SCR-pi305-cbl-797-20 PIC IS X(6) FROM CUTT-BUNDLE-NUM CONTROL 
            DSPL--CONTROL LINE 9 COLUMN 46.
       01 SCR-pi305-cbl-802-24 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 19 COLUMN 1.
       01 SCR-pi305-cbl-826-20 PIC IS X(5) FROM CUTT-CUT-NUMBER CONTROL 
            DSPL--CONTROL LINE 8 COLUMN 45.
       01 SCR-pi305-cbl-827-20 PIC IS X(6) FROM CUTT-BUNDLE CONTROL 
            DSPL--CONTROL LINE 9 COLUMN 46.
       01 SCR-pi305-cbl-837-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 2.
       01 SCR-pi305-cbl-844-20 PIC IS X(8) FROM CUTT-STYLE-NUM CONTROL 
            DSPL--CONTROL LINE 10 COLUMN 42.
       01 SCR-pi305-cbl-845-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 2.
       01 SCR-pi305-cbl-851-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 2.
       01 SCR-pi305-cbl-852-20 PIC IS X(16) FROM PRINTING-COUPONS 
            CONTROL DSPL--CONTROL LINE 13 COLUMN 32.
       01 SCR-pi305-cbl-893-23 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 2.
       01 SCR-pi305-cbl-894-23 PIC IS X(16) FROM PRINTING-COUPONS 
            CONTROL DSPL--CONTROL LINE 13 COLUMN 32.
       01 SCR-pi305-cbl-897-20 PIC IS X(6) FROM RATE-NUM CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 45.
       01 SCR-pi305-cbl-918-24 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 19 COLUMN 1.
       01 SCR-pi305-cbl-1319-29 PIC IS X(55) FROM DUP-BUNDLE-MSG CONTROL
             DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1434-28 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1439-25 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-pi305-cbl-1458-28 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1463-25 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-pi305-cbl-1470-28 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1475-25 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-pi305-cbl-1483-23 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1488-23 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-pi305-cbl-1493-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 2.
       01 SCR-pi305-cbl-1495-23 PIC IS X(24) FROM WRITE-CUT2-MSG CONTROL
             DSPL--CONTROL LINE 13 COLUMN 27.
       01 SCR-pi305-cbl-1496-23 PIC IS X(13) FROM CUT2F-KEY CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 35.
       01 SCR-pi305-cbl-1508-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 2.
       01 SCR-pi305-cbl-1517-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 2.
       01 SCR-pi305-cbl-1519-23 PIC IS X(29) FROM DELETE-CUT2-MSG 
            CONTROL DSPL--CONTROL LINE 13 COLUMN 26.
       01 SCR-pi305-cbl-1530-20 PIC IS X(13) FROM CUT2F-KEY CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 35.
       01 SCR-pi305-cbl-1545-28 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1550-25 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-pi305-cbl-1564-28 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-pi305-cbl-1569-25 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-pi305-cbl-1578-20 PIC IS X(31) FROM FORM-MSG CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 26.
       01 SCR-pi305-cbl-1591-20 PIC IS X(21) FROM VALUE-MSG CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 27.
       01 SCR-pi305-cbl-1600-20 PIC IS X(26) FROM INSERT-MSG CONTROL 
            DSPL--CONTROL LINE 09 COLUMN 27.
       01 SCR-pi305-cbl-1601-20 VALUE IS "Print a test pattern? " 
            CONTROL DSPL--CONTROL LINE 11 COLUMN 26.
050100

050200 PROCEDURE DIVISION.
050300 DECLARATIVES.
050400
050500
050600*    PRNTR.DS   PRINTER DECLARATIVES PROCEDURE.
050700
050800 Z-PRNTR SECTION.
050900     USE AFTER ERROR PROCEDURE ON LO.
051000 Z-PRNTR-D.
TP2PF      COPY "ERRORPRT.SR".
051200
051300     COPY "RATEF.DS".
121586     COPY "CUT2F.DS".
PROFIT     COPY "USERF.DS".
PROFIT     COPY "CNTLF.DS".
051600     COPY "CUTTF.DS".
081287     COPY "STYLF.DS".
112390     COPY "ITRNF.DS".
112390     COPY "ITEMF.DS".
062510*    COPY "MUCTF.DS".
062510     COPY "SCATF.DS".
TP2PF      COPY "ERRORFIL.SR".
051900 STATUS-EXIT. EXIT.
052000
052100 END DECLARATIVES.
052200
052300 MAIN-PROG SECTION.
052400 OPEN-FILES.
062510     MOVE "SIZECAT.FIL"      TO  SCATF--NAME.
           PERFORM USERF-FILL-FULLPATH.
052500     PERFORM PGM-INIT.
111689     IF PWI-NO
              PERFORM SET-ERROR-COLORS
PROFIT        DISPLAY SCR-pi305-cbl-576-23  
              PERFORM SET-NORM-COLORS
              MOVE 4 TO FLAG
              GO TO EXIT-RUN.
052800     PERFORM  OPEN-RATEF.
052900     PERFORM  OPEN-CUTTF.
081287     PERFORM  OPEN-STYLF.
053100     IF PWII-YES
053200        PERFORM OPEN-CUT2F.
112390     PERFORM OPEN-PROFITS-FILES.
020797*    MOVE " " TO FORM-STOCK-FLAG.
091988     PERFORM SCREEN-INIT.
102694     MOVE 1 TO CNTLF-KEY.
050197     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF NO LOCK
           END-READ END-PERFORM.
062510*    PERFORM OPEN-MUCTF.
062510*    PERFORM READ-MUCTF.
010495     MOVE "1010000000" TO FKEYS.
091988     PERFORM PRINT-SELECT.
110794     MOVE PR-STD   TO PR-SIZE-CODE.
110794     MOVE PR-BLACK TO WS-BLACK, PR-COLOR-CODE.
110794     MOVE PR-RED   TO WS-RED.
           MOVE WS-RED          TO VOID-RED, CRTL-RED1, OPER-RED,
059500                             CRTL-RED2, CRTL-RED3, CRTL-RED4.
           MOVE WS-BLACK        TO OPER-BLACK,
059700                        VOID-BLACK, CRTL-BLACK1,
059800                        CRTL-BLACK2, CRTL-BLACK3, CRTL-BLACK4,
059900                        OPER-BLACK1A, OPER-BLACK1B, OPER-BLACK2A,
060000                        OPER-BLACK2B,
060100                        OPER-BLACK4A, OPER-BLACK4B,
060200                        OPER-BLACK6A, OPER-BLACK6B,
060300                        VOID-BLACK1A, VOID-BLACK1B, VOID-BLACK2A,
060400                        VOID-BLACK2B,
060500                        VOID-BLACK4A, VOID-BLACK4B,
060600                        VOID-BLACK6A, VOID-BLACK6B,
060700                        CRTL-BLACK6A, CRTL-BLACK6B.
040793     IF BAR-YES-OKI3410
071393*       MOVE X"10420C" TO ON-REC-STRING
040793        MOVE LOW-VALUES TO OFF-REC.
091988     IF FLAG = 3 GO TO END-REPORT.
053700     PERFORM  OPEN-LO.
070398     MOVE CNTL-BARCODE-EMULATION(USER-PTR-CODES) TO
071398          HOLD-BARCODE-EMULATION.
PROFIT     MOVE 2 TO CNTLF-KEY.
PROFIT     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF NO LOCK
           END-READ END-PERFORM.
PROFIT     IF LAST-OPTION = 050202
053900        MOVE 2 TO FUNCTION-FLAG
054000        MOVE SPACES TO RC-1, RC-2
054100        MOVE 3 TO OPTION OF RANGE-SPECS-1
054200     ELSE
054300        MOVE 1 TO FUNCTION-FLAG.
           IF INVENTORY-INTERFACE-YES
              MOVE 1 TO INVENTORY-INTERFACE-FLAG.
071398     MOVE HOLD-BARCODE-EMULATION TO CNTL-BAR-CODES.
060894     PERFORM SET-LOW-VALUES.
022510     MOVE 1 TO ITRNF-KEY.
054400 BEGIN-REPORT.
           IF EXTRA-BAR-CODE
040793        IF BAR-YES-OTHER
                 MOVE X"33" TO HEIGHT
040793        ELSE
040793        IF BAR-YES-OKI3410
040793           MOVE X"3033"  TO OKI-3410-HEIGHT.
040793*       ELSE
040793*          MOVE X"31" TO HIGHT
040793     IF BAR-YES-OKI3410
060894        IF 2-WIDE-GUM
071393           MOVE X"1B44042B446900" TO TAB-SETUP-STRING
080596        ELSE
080596        IF 2-WIDE-PAINLESS
080596           MOVE X"1B440436446900" TO TAB-SETUP-STRING
060894        ELSE
                 MOVE X"1B440428416500" TO TAB-SETUP-STRING
060894     ELSE
060894     IF 2-WIDE-GUM
060894        MOVE X"1B440329436700" TO TAB-SETUP-STRING
080596     ELSE
080596        IF 2-WIDE-PAINLESS
080596        MOVE X"1B440334436700" TO TAB-SETUP-STRING.
102290     IF BAR-YES-OTHER
012195*-- PROBLEM WAS PRINT-REC WAS SO LONG WITH SPACES FORCED LINE FEED --*
012195*       WRITE PRINT-REC FROM TAB-SETUP-STRING BEFORE 0
012195*       WRITE PRINT-REC FROM BARCODE-SETUP-STRING BEFORE 0
012195        WRITE SETUP-REC FROM TAB-SETUP-STRING BEFORE 0
012195        WRITE SETUP-REC FROM BARCODE-SETUP-STRING BEFORE 0
040793     ELSE
040793     IF BAR-YES-OKI3410
              WRITE SETUP-REC FROM TAB-SETUP-STRING BEFORE 0
              WRITE SETUP-REC FROM OKI-3410-SETUP-STRING BEFORE 0.
           WRITE PITCH-REC FROM SET-PITCH  BEFORE 0.
054500     PERFORM RANGE-SELECT.
054600     IF FLAG = 3 GO TO END-REPORT.
071087     PERFORM FORM-SELECT.
054800     PERFORM VALUE-SELECT.
054900     PERFORM ALIGN.
055000     PERFORM SCREEN-INIT.
055300     IF ESC-FLAG = 1 MOVE "0010000000" TO FKEYS
055400                ELSE MOVE "0000000000" TO FKEYS.
055500     MOVE 1 TO FLAG.
055600     CALL "KBDCHK" USING FLAG, FKEYS.
055700     MOVE 0 TO FLAG.
055800     PERFORM PROCESS-REPORT THRU PROCESS-REPORT-EXIT.
022711     IF USER-PTR-OUT = 4 OR 5 OR 6
022711        PERFORM COPY-TO-LPT
022711        GO TO END-REPORT
022711     ELSE
056000        GO TO END-REPORT.
056100
111706*     IF USER-PTR-OUT < 4
111706*        PERFORM COPY-TO-LPT.

056200 END-REPORT.
056300     PERFORM CLOSE-FILES.
056400
056500 EXIT-RUN.
056800     MOVE "PMENU" TO NEXT-PROG.
PROFIT     COPY "FINISH.SR".
PROFIT*    CALL "CHAIN" USING NEXT-PROG, PARM-BLK.
057000
TP2PF      COPY "DATECVT.SR".
PROFIT     COPY "CONTROL.SR".

111706 COPY-TO-LPT.
111706     CLOSE LO.
111706     MOVE 1  TO USER-PTR-CHN.
111706     REWRITE USERF-REC.
111706*     MOVE 1  TO WS-RESET-CD.
111706     MOVE SPACES TO DOS-COMMAND.
111706*     CALL "CHGDIR" USING MASTER-DIR, RETURN-CD.
111706*     IF USER-PTR-OUT = 1
111706*        MOVE "LPT1:" TO WS-PTR-PORT
111706*     ELSE
111706*     IF USER-PTR-OUT = 2
111706*        MOVE "LPT2:" TO WS-PTR-PORT
111706*     ELSE
111706*     IF USER-PTR-OUT = 3
111706*        MOVE "LPT3:" TO WS-PTR-PORT.
      *
111706*     STRING "COPY /B "                DELIMITED BY SIZE
111706*            PRNT-FILENAME             DELIMITED BY SPACE
111706*            " "                       DELIMITED BY SIZE
111706*            WS-PTR-PORT               DELIMITED BY SIZE
111706*            " > NUL"                  DELIMITED BY SIZE
111706*            INTO DOS-COMMAND.
022711      IF USER-PTR-OUT = 4
022711         MOVE "LPT1" TO WS-PTR-PORT
022711      ELSE
022711      IF USER-PTR-OUT = 5
022711         MOVE "LPT2" TO WS-PTR-PORT
022711      ELSE
022711      IF USER-PTR-OUT = 6
022711         MOVE "LPT3" TO WS-PTR-PORT.
022711     STRING "COPY "       DELIMITED BY SIZE
022711            PRNT-FILENAME DELIMITED BY SIZE
022711            " /B "        DELIMITED BY SIZE
022711            WS-PTR-PORT   DELIMITED BY SIZE
022711            INTO DOS-COMMAND.
111706     PERFORM CALL-CHAINR THRU CALL-CHAINR-EXIT.
111706     CALL "CHGDIR" USING SUB-DIR, RETURN-CD.
111706     CALL "CHECKCAPPRNT" USING PRNT-FILENAME
111706     OPEN OUTPUT LO.
111706     CLOSE LO.
111706     CALL "PRNTFILECLOSED" USING PRNT-FILENAME
111706     CALL "CHGDIR" USING MASTER-DIR, RETURN-CD.

057200
057300 SUBROUTINE SECTION.
057400 PGM-INIT.
057500     PERFORM CONTROL-INIT.
020797     MOVE "PWTICKETS" TO QUEUE-DEFAULT-NAME.
020797     MOVE "Y" TO FORM-STOCK-FLAG.
059300     MOVE "Print Piece Work Tickets" TO PGM-NAME.
060800*    0 = NO ESCAPE, 1 = ESCAPABLE
060900     MOVE 1 TO ESC-FLAG.
062500
060894 SET-LOW-VALUES.
060894     IF 2-WIDE-GUM
060894        MOVE SPACES     TO L1-FILLER-1, L1-FILLER-2,
                                 L2-FILLER-1, L2-FILLER-2,
                                 L3-FILLER-1, L3-FILLER-2,
                                 L4-FILLER-1, L4-FILLER-2,
                                 L6-FILLER-1, L6-FILLER-2,
060894                           L1-FILLER-3, L1-FILLER-4,
                                 L2-FILLER-3, L2-FILLER-4,
                                 L3-FILLER-3, L3-FILLER-4,
                                 L4-FILLER-3, L4-FILLER-4,
                                 L6-FILLER-3, L6-FILLER-4
              MOVE LOW-VALUES TO L1-TICKET-3, L1-TICKET-4,
                                 L2-TICKET-3, L2-TICKET-4,
                                 L3-TICKET-3, L3-TICKET-4,
                                 L4-TICKET-3, L4-TICKET-4,
                                 L6-TICKET-3, L6-TICKET-4
           ELSE
060894        MOVE LOW-VALUES TO L1-FILLER-1, L1-FILLER-2,
                                 L2-FILLER-1, L2-FILLER-2,
                                 L3-FILLER-1, L3-FILLER-2,
                                 L4-FILLER-1, L4-FILLER-2,
                                 L6-FILLER-1, L6-FILLER-2,
060894                           L1-FILLER-3, L1-FILLER-4,
                                 L2-FILLER-3, L2-FILLER-4,
                                 L3-FILLER-3, L3-FILLER-4,
                                 L4-FILLER-3, L4-FILLER-4,
                                 L6-FILLER-3, L6-FILLER-4.
062700
022511 SET-ITRN-FILENAME.
022511     MOVE SPACES TO ITRNF--NAME.
022511     STRING "ITRN"      DELIMITED BY SIZE
022511            USER-TERMID DELIMITED BY SIZE
022511            ".FIL"      DELIMITED BY SIZE
022511            INTO ITRNF--NAME.
022511     PERFORM ITRNF-FILL-FULLPATH.

062800 SUBROUTINE-EXIT. EXIT.
062900
063000 RANGE-SELECT SECTION.
063100 GET-RANGE.
063200     PERFORM SCREEN-INIT.
063300     DISPLAY SCR-pi305-cbl-732-20  .
063400     MOVE "1010000000" TO FKEYS.
063500     MOVE 0 TO FLAG.
           PERFORM STEST-pi305-cbl-735
063600     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS,
063700       RANGE-HELP-1, RANGE-CODES
           PERFORM STEST-AFTER-CALL.
063800     IF FLAG = 3 GO TO RANGE-SELECT-EXIT.
063900     IF OPTION OF RANGE-SPECS-1 = 1 OR
064000        OPTION OF RANGE-SPECS-1 = 2
064100          MOVE LOW-VALUES TO LOW-CUT, LOW-BUNDLE
064200          MOVE HIGH-VALUES TO HIGH-CUT, HIGH-BUNDLE
064300          GO TO RANGE-SELECT-EXIT.
052292     MOVE LOW-VALUES TO LOW-BUNDLE.
052292     MOVE SPACES TO LOW-CUT.
011790     MOVE SPACES TO HIGH-CUT, HIGH-BUNDLE.
064600 GET-LOW-HIGH.
064700     MOVE "1010000000" TO FKEYS.
064800     MOVE 0 TO FLAG.
064900     IF OPTION OF RANGE-SPECS-1 = 3
065000        DISPLAY SCR-pi305-cbl-750-23  
065100        DISPLAY SCR-pi305-cbl-751-23  
              PERFORM STEST-pi305-cbl-752
065200        CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
065300        RANGE-HELP-2, LOW-BUNDLE, HIGH-BUNDLE
              PERFORM STEST-AFTER-CALL
065400     ELSE
065500        DISPLAY SCR-pi305-cbl-755-23  
065600        DISPLAY SCR-pi305-cbl-756-23  
              PERFORM STEST-pi305-cbl-757
065700        CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
042486        RANGE-HELP-3, LOW-CUT, HIGH-CUT
              PERFORM STEST-AFTER-CALL.
065900     IF FLAG = 3 GO TO GET-RANGE.
052292     IF HIGH-CUT = SPACES  OR HIGH-VALUES
066100        MOVE LOW-CUT TO HIGH-CUT.
066300     IF LOW-CUT > HIGH-CUT
066400         DISPLAY SCR-pi305-cbl-763-24   
066500         GO TO GET-LOW-HIGH.
011790     IF HIGH-BUNDLE = ZEROS
066100        MOVE LOW-BUNDLE TO HIGH-BUNDLE.
066300     IF LOW-BUNDLE > HIGH-BUNDLE
066400         DISPLAY SCR-pi305-cbl-768-24   
066500         GO TO GET-LOW-HIGH.
066600     IF OPTION OF RANGE-SPECS-1 = 3
066700        PERFORM START-BUNDLE-ORDER
066800     ELSE
066900        PERFORM START-CUTT-ORDER.
CLNUP1     IF C-END-OF-FILE OF CUTTF-STATUS
067100         DISPLAY SCR-pi305-cbl-775-24   
067200         GO TO GET-LOW-HIGH.
067300
067400 RANGE-SELECT-EXIT. EXIT.
067500
067600 PROCESS-REPORT SECTION.
067700 PROCESS-REPORT-BEGIN.
042987     DISPLAY SCR-pi305-cbl-782-20 .
067900     IF OPTION OF RANGE-SPECS-1 = 3
068000        PERFORM START-BUNDLE-ORDER
068100     ELSE
068200        PERFORM START-CUTT-ORDER.
CLNUP1     IF C-END-OF-FILE OF CUTTF-STATUS
068400        GO TO PROCESS-REPORT-EXIT.
068500
068600 PROCESS-NEXT-BUNDLE.
042987     DISPLAY SCR-pi305-cbl-791-20   .
042987     DISPLAY SCR-pi305-cbl-792-20     .
042987     DISPLAY SCR-pi305-cbl-793-20        .
069000     MOVE 0 TO CNT.
069100     PERFORM  READ-CUTTF-NEXT.
042987     DISPLAY SCR-pi305-cbl-796-20  .
042987     DISPLAY SCR-pi305-cbl-797-20  .
042987     IF ESC-FLAG = 1
069500         CALL "KBDCHK" USING FLAG, FKEYS
069600         IF FLAG = 3
069700            PERFORM ACCEPT-PAUSE
PROFIT         DISPLAY SCR-pi305-cbl-802-24  
069800         IF OPTION OF PAUSE-SPEC(1) = 1
070100            GO TO PROCESS-REPORT-EXIT.
CLNUP1     IF C-END-OF-FILE OF CUTTF-STATUS
070300        GO TO PROCESS-REPORT-EXIT.
070400     IF OPTION OF RANGE-SPECS-1 = 3
070500       IF CUTT-BUNDLE > HIGH-BUNDLE
070600          GO TO PROCESS-REPORT-EXIT
070700       ELSE
070800          NEXT SENTENCE
070900     ELSE
071000     IF OPTION OF RANGE-SPECS-1 = 4
071100        IF CUTT-CUT-NUMBER > HIGH-CUT
071200           GO TO PROCESS-REPORT-EXIT.
071300     IF CUTT-DATE-PRINTED NOT = ZEROES
071400        AND CUTT-DATE-PRINTED NOT = SPACE
062187        IF NEW-TICKETS
071600           GO TO PROCESS-NEXT-BUNDLE.
081287     MOVE CUTT-STYLE-NUM TO STYLE-NUMBER.
081287     PERFORM READ-STYLF.
081287     MOVE 1 TO CNT2.
072000     PERFORM START-RATEF.
CLNUP1     IF C-END-OF-FILE OF RATEF-STATUS
072200        GO TO PROCESS-NEXT-BUNDLE.
042987     DISPLAY SCR-pi305-cbl-826-20  .
042987     DISPLAY SCR-pi305-cbl-827-20  .
072500*=========================================
072600*= CLEAR ANY OLD CUT2F RECORDS BEFORE    =
072700*= PRINTING TICKETS.  THIS WAY WHEN      =
072800*= TICKETS REPRINTED FILE REWRITTEN      =
072900*=========================================
073000*--- THIS NEXT LINE CHECKS TO SEE IF BUNDLE ALREADY IN CUT2 FILE -
102290     IF PWII-YES
102290        PERFORM CHECK-FOR-DUP-BUNDLE
102290        PERFORM CLEAR-CUT2F.
042987     DISPLAY SCR-pi305-cbl-837-20  .
121586     MOVE 0 TO SEQ-NUM.
121586     MOVE 1 TO ARRAY-CNT.
121586     MOVE CUTT-CUT-NUMBER TO CUT2-CUT-NUMBER.
121586     MOVE CUTT-BUNDLE TO CUT2-BUNDLE.
073900     MOVE LOW-VALUES TO CUT2F-DATA1.
121586     MOVE CUTT-STYLE-NUM TO CUT2-STYLE-NUMBER.
042987     DISPLAY SCR-pi305-cbl-844-20  .
042987     DISPLAY SCR-pi305-cbl-845-20  .
051393     IF HDR-ON-TCKTS-YES
051393         PERFORM PRINT-HDR.
           PERFORM PROCESS-REPORT-READ.
074400
074500 PROCESS-REPORT-NEXT.
042987     DISPLAY SCR-pi305-cbl-851-20  .
042987     DISPLAY SCR-pi305-cbl-852-20  .
CLNUP1     IF C-END-OF-FILE OF RATEF-STATUS OR
081287       STYLE-STRUCTURE(CNT2) NOT = RATE-STYLE
081287       IF CNT2 < 10
081287          ADD 1 TO CNT2
081287          PERFORM START-RATEF
081287          PERFORM PROCESS-REPORT-READ
PROFIT          IF USER-SN = 00196 AND
031293            (STYLE-STRUCTURE(CNT2) = RATE-STYLE)
031293             PERFORM PRINT-HDR
031293             GO TO PROCESS-REPORT-NEXT
031293          ELSE
081287             GO TO PROCESS-REPORT-NEXT
081287       ELSE
121586*      MOVE "E" TO CUT2-BUNDLE-COMPLETE-FLAG
042197       MOVE "E" TO CUT2-LAST-RECORD-FLAG
121586       PERFORM WRITE-CUT2F
075800       IF CNT = 0
100186          MOVE SPACES TO PRINT-REC
100186          MOVE SYS-MONTH TO PRINTED-MON
100186          MOVE SYS-DAY TO PRINTED-DAY
100186          MOVE SYS-YEAR TO PRINTED-YEAR
100186          REWRITE CUTTF-REC
112390          PERFORM WRITE-FG-ORDER THRU WRITE-FG-ORDER-EXIT
076400          GO TO PROCESS-NEXT-BUNDLE
076500       ELSE
076600          PERFORM PRINT-TICKETS
076700          MOVE SPACES TO PR-LINE1, PR-LINE2,
076800               PR-LINE3, PR-LINE4, PR-LINE6
060894          PERFORM SET-LOW-VALUES
100186          MOVE SPACES TO PRINT-REC
100186          MOVE SYS-MONTH TO PRINTED-MON
100186          MOVE SYS-DAY TO PRINTED-DAY
100186          MOVE SYS-YEAR TO PRINTED-YEAR
100186          REWRITE CUTTF-REC
112390          PERFORM WRITE-FG-ORDER THRU WRITE-FG-ORDER-EXIT
077400          GO TO PROCESS-NEXT-BUNDLE.
060488     IF ARRAY-CNT = 21
060488*       MOVE "C" TO CUT2-BUNDLE-COMPLETE-FLAG
042197        MOVE "C" TO CUT2-LAST-RECORD-FLAG
060488        PERFORM WRITE-CUT2F
060488        DISPLAY SCR-pi305-cbl-893-23  
040688        DISPLAY SCR-pi305-cbl-894-23  
060488        MOVE LOW-VALUES TO CUT2F-DATA1
060488        MOVE CUTT-STYLE-NUM TO CUT2-STYLE-NUMBER.
042987     DISPLAY SCR-pi305-cbl-897-20  .
078300     ADD 1 TO CNT.
078400     PERFORM MOVE-TICKET-TYPE.
078500     IF CNT = NUMBER-ACROSS
078600        PERFORM PRINT-TICKETS
078700        MOVE 0 TO CNT.
121586     IF RATE-RECORD-TYPE NOT = 2
121586         MOVE RATE-NUM TO CUT2-OPER-NUM(ARRAY-CNT)
070791         MOVE QTY TO CUT2-ORDER-QTY(ARRAY-CNT)
070791*        MOVE CUTT-QTY-ORDERED TO CUT2-ORDER-QTY(ARRAY-CNT)
121586         ADD 1 TO ARRAY-CNT.
079200     PERFORM PROCESS-REPORT-READ.
080000     GO TO PROCESS-REPORT-NEXT.
080100
080200 PROCESS-REPORT-EXIT. EXIT.
080300
080400 PROCESS-REPORT-READ.
080500     IF ESC-FLAG = 1
080600         CALL "KBDCHK" USING FLAG, FKEYS
080700         IF FLAG = 3
080800            PERFORM ACCEPT-PAUSE
PROFIT         DISPLAY SCR-pi305-cbl-918-24  
080900         IF OPTION OF PAUSE-SPEC(1) = 1
081200          GO TO PROCESS-REPORT-EXIT.
CLNUP1     IF NOT C-END-OF-FILE OF RATEF-STATUS
081400        PERFORM  READ-RATEF-NEXT.
081500
081600 MOVE-TICKET-TYPE.
081700     IF RATE-RECORD-TYPE = 2
081800        PERFORM MOVE-CONTROL.
081900     IF RATE-RECORD-TYPE = 1
082000        PERFORM MOVE-OPERATION .
082100     IF RATE-RECORD-TYPE = 3
082200        PERFORM MOVE-VOID.
082300
082400 MOVE-CONTROL.
070791     COMPUTE QTY ROUNDED = CUTT-QTY-ORDERED * RATE-FACTOR.
082500     MOVE RATE-NAME TO CRTL-DESC.
033089     MOVE CUTT-BUNDLE-NUM TO CRTL-BUNDLE.
082289     MOVE CUTT-CUT-KEY TO CRTL-CUT.
082600     MOVE RATE-STYLE TO CRTL-STYLE-NUM.
070791     MOVE QTY TO CRTL-QTY.
070791*    MOVE CUTT-QTY-ORDERED TO CRTL-QTY.
082800     MOVE SYS-MONTH TO CRTL-MONTH.
082900     MOVE SYS-DAY TO CRTL-DAY.
083000     MOVE SYS-YEAR TO CRTL-YEAR.
083100     MOVE C-LINE1 TO NAME1.
083200     MOVE C-LINE2 TO NAME2.
083300     MOVE C-LINE3 TO NAME3.
083400     MOVE C-LINE4 TO NAME4.
012387     MOVE C-LINE6 TO NAME6.
083600     MOVE RATE-NUM TO INAME1.
083700     MOVE CUTT-SIZE TO INAME4, INAME6.
084000     MOVE CUTT-BUNDLE-NUM TO BUNDLE-NUM.
084100     MOVE SPACES TO INAME3.
084200*---- THE FOLLOWING MAKE UP NAME5 ----*
084300     MOVE RATE-NUM TO BAR-RATE-NUM.
022789     MOVE CUTT-BUNDLE-NUM TO BAR-BUNDLE-NUM.
060894     IF CNTL-COUPON-SIZE = 2 OR 4 OR 7
042594           MOVE CUTT-BUNDLE-NUM TO INAME2.
084600     PERFORM MOVE-TO-PRINT-LINE.
084700     PERFORM CLEAR-PRINT-LINES.
084800
084900 MOVE-VOID.
070791     COMPUTE QTY ROUNDED = CUTT-QTY-ORDERED * RATE-FACTOR.
085000     MOVE RATE-NUM TO VOID-OPER-NUM.
085100     MOVE "**VOID**" TO VOID-TICK-NAME.
070791     MOVE QTY TO VOID-QTY.
051193*    MOVE CUTT-QTY-ORDERED TO VOID-QTY.
085300     MOVE CUTT-CUT-KEY TO VOID-CUT-NUM.
085400     MOVE CUTT-THREAD-COLOR TO VOID-COLOR.
085500     MOVE SPACES TO VOID-RATE.
085600     MOVE CUTT-BUNDLE-NUM TO VOID-BUNDLE-NUM.
085700     MOVE CUTT-SIZE TO VOID-SIZE.
070791*    MOVE CUTT-QTY-ORDERED TO QTY.
086000     MOVE CUTT-MISC-1 TO VOID-MISC-1.
021894     IF CUTT-MISC-2 = SPACES
021894        MOVE RATE-SECTION TO VOID-MISC-2
021894     ELSE
086100        MOVE CUTT-MISC-2 TO VOID-MISC-2.
120986     IF OPERATION-MISC
030686        MOVE RATE-SECTION TO VOID-COUP-MISC
120986     ELSE
120986     IF OPERATION-DESC
120986        MOVE RATE-NAME TO VOID-COUP-MISC
120986     ELSE
120986        MOVE SPACES TO VOID-COUP-MISC.
086900     MOVE V-LINE1 TO NAME1.
087000     MOVE V-LINE2 TO NAME2.
087100     MOVE V-LINE3 TO NAME3.
087200     MOVE V-LINE4 TO NAME4.
030686     MOVE V-LINE6 TO NAME6.
087400     MOVE RATE-NUM TO INAME1.
082289     MOVE "      " TO INAME2.
087600     MOVE "      " TO INAME3.
082289     MOVE " VOID " TO INAME4.
082289     MOVE "      " TO INAME6.
087900*---- THE FOLLOWING MAKE UP NAME5 ----*
088000     MOVE RATE-NUM TO BAR-RATE-NUM.
022789     MOVE CUTT-BUNDLE-NUM TO BAR-BUNDLE-NUM.
060894     IF CNTL-COUPON-SIZE = 2 OR 4 OR 7
042594           MOVE CUTT-BUNDLE-NUM TO INAME2.
088200     PERFORM MOVE-TO-PRINT-LINE.
088300     PERFORM CLEAR-PRINT-LINES.
088400
088500 MOVE-OPERATION.
070791     COMPUTE QTY ROUNDED = CUTT-QTY-ORDERED * RATE-FACTOR.
088600     MOVE RATE-NUM TO OPER-OPER-NUM.
088700     MOVE RATE-TICKET-NAME TO OPER-TICK-NAME.
070791     MOVE QTY TO OPER-QTY.
070791*    MOVE CUTT-QTY-ORDERED TO OPER-QTY.
088900     MOVE CUTT-CUT-KEY TO OPER-CUT-NUM.
089000     MOVE CUTT-THREAD-COLOR TO OPER-COLOR.
089100     MOVE RATE-PAY-RATE TO OPER-RATE.
089200     MOVE CUTT-BUNDLE-NUM TO OPER-BUNDLE-NUM.
089300     MOVE CUTT-SIZE TO OPER-SIZE.
070791*    MOVE CUTT-QTY-ORDERED TO QTY.
089600     MOVE RATE-PAY-RATE TO PAY-RATE.
089700     MOVE 0 TO PAY-AMOUNT.
089800*--- DOLLARS PER HUNDRED ---*
089900     IF CNTL-PAY-TYPE-CD = 1
090000       COMPUTE PAY-AMOUNT ROUNDED = QTY * ( PAY-RATE / 100.00000 )
              ON SIZE ERROR MOVE ZERO TO PAY-AMOUNT END-COMPUTE
090100     ELSE
090200*--- DOLLARS PER DOZEN ---*
090300     IF CNTL-PAY-TYPE-CD = 2
090400       COMPUTE PAY-AMOUNT ROUNDED = QTY * ( PAY-RATE / 12 ) 
             ON SIZE ERROR MOVE ZERO TO PAY-AMOUNT END-COMPUTE
090500     ELSE
090600*--- SAH PER HUNDRED ---*
090700     IF CNTL-PAY-TYPE-CD = 3
102991       COMPUTE TOT-SAM-SAH-2 ROUNDED = PAY-RATE * QTY / 100.00000 
             ON SIZE ERROR MOVE ZERO TO TOT-SAM-SAH-2 END-COMPUTE
102991       COMPUTE TOT-SAM-SAH-4 ROUNDED = PAY-RATE * QTY / 100.00000 
             ON SIZE ERROR MOVE ZERO TO TOT-SAM-SAH-4 END-COMPUTE
090800       COMPUTE PAY-AMOUNT ROUNDED =
090900         (QTY * ( PAY-RATE *
KEN                     PWCT-BASE-RATE(RATE-PAY-LEVEL)) / 100.00000) 
                        ON SIZE ERROR MOVE ZERO TO PAY-AMOUNT 
                        END-COMPUTE
091000     ELSE
091100*--- SAM PER DOZEN ---*
091200     IF CNTL-PAY-TYPE-CD = 4
102991       COMPUTE TOT-SAM-SAH-2 ROUNDED = PAY-RATE * QTY / 12 
             ON SIZE ERROR MOVE ZERO TO TOT-SAM-SAH-2 END-COMPUTE
102991       COMPUTE TOT-SAM-SAH-4 ROUNDED = PAY-RATE * QTY / 12 
             ON SIZE ERROR MOVE ZERO TO TOT-SAM-SAH-4 END-COMPUTE
091300       COMPUTE PAY-AMOUNT ROUNDED =
032586         (QTY * (PAY-RATE *
KEN                   (PWCT-BASE-RATE(RATE-PAY-LEVEL) / 60)) / 12) 
                      ON SIZE ERROR MOVE ZERO TO PAY-AMOUNT END-COMPUTE
091600     ELSE
091700*--- SAH PER UNIT ---*
091800     IF CNTL-PAY-TYPE-CD = 5
102991       COMPUTE TOT-SAM-SAH-2 ROUNDED = PAY-RATE * QTY
102991       COMPUTE TOT-SAM-SAH-4 ROUNDED = PAY-RATE * QTY
091900       COMPUTE PAY-AMOUNT ROUNDED =
KEN               QTY * (PAY-RATE * PWCT-BASE-RATE(RATE-PAY-LEVEL))
092100     ELSE
092200*--- SAM PER UNIT ---*
092300     IF CNTL-PAY-TYPE-CD = 6
102991       COMPUTE TOT-SAM-SAH-2 ROUNDED = PAY-RATE * QTY
102991       COMPUTE TOT-SAM-SAH-4 ROUNDED = PAY-RATE * QTY
092400       COMPUTE PAY-AMOUNT ROUNDED =
032586          QTY * ((PAY-RATE *
KEN                     PWCT-BASE-RATE(RATE-PAY-LEVEL)) / 60) 
                        ON SIZE ERROR MOVE ZERO TO PAY-AMOUNT 
                        END-COMPUTE
092600     ELSE
092700       MOVE 0 TO PAY-AMOUNT.
022092     IF 2-DECIMALS
022092        COMPUTE RND-2-DECIMAL ROUNDED = PAY-AMOUNT
022092        MOVE RND-2-DECIMAL TO PAY-AMOUNT
022092     ELSE
022092        COMPUTE RND-3-DECIMAL ROUNDED = PAY-AMOUNT
022092        MOVE RND-3-DECIMAL TO PAY-AMOUNT.
021689     IF OPTION OF VALUE-SPECS = 1
021689        MOVE ZEROS TO OPER-VALUE
021689        MOVE RATE-PAY-RATE TO OPER-RATE
           ELSE
021689     IF OPTION OF VALUE-SPECS = 2
021689        MOVE ZEROS TO OPER-RATE
021689        MOVE PAY-AMOUNT TO OPER-VALUE
           ELSE
021689     IF OPTION OF VALUE-SPECS = 4
021689        MOVE ZEROS TO OPER-VALUE
021689        MOVE ZEROS TO OPER-RATE
           ELSE
021689        MOVE PAY-AMOUNT TO OPER-VALUE
021689        MOVE RATE-PAY-RATE TO OPER-RATE .
093200     MOVE CUTT-MISC-1 TO OPER-MISC-1.
093300     MOVE CUTT-MISC-2 TO OPER-MISC-2.
052794     IF CUTT-MISC-2 = SPACES
052794        MOVE RATE-SECTION TO OPER-MISC-2.
061891     IF PRINT-SAM-YES
102991        MOVE TOT-SAM-SAH-4 TO OPER-TOT-SAM
061891     ELSE
102991     IF PRINT-SAM-2-DEC
102991        MOVE TOT-SAM-SAH-2 TO OPER-TOT-SAM.
120986     IF OPERATION-MISC
030686        MOVE RATE-SECTION TO OPER-COUP-MISC
120986     ELSE
120986     IF OPERATION-DESC
120986        MOVE RATE-NAME TO OPER-COUP-MISC
120986     ELSE
120986        MOVE SPACES TO OPER-COUP-MISC.
094100     MOVE O-LINE1 TO NAME1.
094200     MOVE O-LINE2 TO NAME2.
094300     MOVE O-LINE3 TO NAME3.
094400     MOVE O-LINE4 TO NAME4.
030686     MOVE O-LINE6 TO NAME6.
094600     MOVE RATE-NUM TO INAME1.
094700     MOVE "      " TO INAME2.
094800     MOVE "      " TO INAME3.
111486     MOVE RATE-TICKET-NAME TO INAME4.
030686     MOVE "      " TO INAME6.
062510*    IF INTERFACE-TO-INVENTORY
062510*       MOVE MUCT-CATEGORIES(STYLE-GROUP-NAME, CUTT-CATEGORY)
062510*            TO INAME6.
062510     IF INTERFACE-TO-INVENTORY
062510        MOVE STYLE-GROUP-NAME TO SCAT-GROUP-NBR
062510        PERFORM APPAREL-LOAD-SC4GROUP
062510        MOVE CUTT-CATEGORY TO LOPT-X
062510        MOVE CATEGORY-OPT(LOPT-BIN) TO INAME6.
095100*---- THE FOLLOWING MAKE UP NAME5 ----*
095200     MOVE RATE-NUM TO BAR-RATE-NUM.
022789     MOVE CUTT-BUNDLE-NUM TO BAR-BUNDLE-NUM.
060894     IF CNTL-COUPON-SIZE = 2 OR 4 OR 7
042594           MOVE CUTT-BUNDLE-NUM TO INAME2.
095400     PERFORM MOVE-TO-PRINT-LINE.
095500     PERFORM CLEAR-PRINT-LINES.
095600
095700 MOVE-TO-PRINT-LINE.
095800     IF CNT = 1
095900        MOVE NAME1 TO L1-TICKET-1
096000        MOVE NAME2 TO L2-TICKET-1
096100        MOVE NAME3 TO L3-TICKET-1
096200        MOVE NAME4 TO L4-TICKET-1
030686        MOVE NAME6 TO L6-TICKET-1
096400        MOVE INAME1 TO L1-INIT-1
096500        MOVE INAME2 TO L2-INIT-1
096600        MOVE INAME3 TO L3-INIT-1
096700        MOVE INAME4 TO L4-INIT-1
030686        MOVE INAME6 TO L6-INIT-1
040793        MOVE NAME5  TO BAR-LABEL-1, OKI-BAR-LABEL-1.
097000     IF CNT = 2
097100        MOVE NAME1 TO L1-TICKET-2
097200        MOVE NAME2 TO L2-TICKET-2
097300        MOVE NAME3 TO L3-TICKET-2
097400        MOVE NAME4 TO L4-TICKET-2
030686        MOVE NAME6 TO L6-TICKET-2
097600        MOVE INAME1 TO L1-INIT-2
097700        MOVE INAME2 TO L2-INIT-2
097800        MOVE INAME3 TO L3-INIT-2
097900        MOVE INAME4 TO L4-INIT-2
030686        MOVE INAME6 TO L6-INIT-2
042694        MOVE NAME5  TO BAR-LABEL-2, OKI-BAR-LABEL-2.
098200     IF CNT = 3
098300        MOVE NAME1 TO L1-TICKET-3
098400        MOVE NAME2 TO L2-TICKET-3
098500        MOVE NAME3 TO L3-TICKET-3
098600        MOVE NAME4 TO L4-TICKET-3
030686        MOVE NAME6 TO L6-TICKET-3
098800        MOVE INAME1 TO L1-INIT-3
098900        MOVE INAME2 TO L2-INIT-3
099000        MOVE INAME3 TO L3-INIT-3
099100        MOVE INAME4 TO L4-INIT-3
030686        MOVE INAME6 TO L6-INIT-3
040793        MOVE NAME5  TO BAR-LABEL-3, OKI-BAR-LABEL-3.
099400     IF CNT = 4
099500        MOVE NAME1 TO L1-TICKET-4
099600        MOVE NAME2 TO L2-TICKET-4
099700        MOVE NAME3 TO L3-TICKET-4
099800        MOVE NAME4 TO L4-TICKET-4
030686        MOVE NAME6 TO L6-TICKET-4
100000        MOVE INAME1 TO L1-INIT-4
100100        MOVE INAME2 TO L2-INIT-4
100200        MOVE INAME3 TO L3-INIT-4
100300        MOVE INAME4 TO L4-INIT-4
040793        MOVE NAME5  TO BAR-LABEL-4, OKI-BAR-LABEL-4
030686        MOVE INAME6 TO L6-INIT-4.
100600
100700
100800 PRINT-TICKETS.
041295     IF CNT = 1 OR 3
041295        STRING WS-BLACK    DELIMITED BY SIZE,
041295               WS-BLACK    DELIMITED BY SIZE
041295               INTO NAME1
041295        STRING WS-BLACK    DELIMITED BY SIZE,
041295               WS-BLACK    DELIMITED BY SIZE
041295               INTO NAME2
041295        STRING WS-BLACK    DELIMITED BY SIZE,
041295               WS-BLACK    DELIMITED BY SIZE
041295               INTO NAME3
041295        STRING WS-BLACK    DELIMITED BY SIZE,
041295               WS-BLACK    DELIMITED BY SIZE
041295               INTO NAME4
041295        STRING WS-BLACK    DELIMITED BY SIZE,
041295               WS-BLACK    DELIMITED BY SIZE
041295               INTO NAME6
041295        ADD 1 TO CNT
041295        PERFORM MOVE-TO-PRINT-LINE VARYING CNT FROM CNT BY 1 UNTIL
041295            CNT > NUMBER-ACROSS.
080596*    IF CNTL-COUPON-SIZE = 1 OR CNTL-COUPON-SIZE = 3
080596     IF NON-BAR-2-WIDE OR NON-BAR-4-WIDE
101000        PERFORM PRINT-TICKETS-STD
101100     ELSE
080596     IF 2-WIDE-PAINLESS
080596        PERFORM PRINT-PAINLESS
080596     ELSE
101200        PERFORM PRINT-TICKETS-STD-BAR.
101300
096800 PRINT-TICKETS-STD.
096900     WRITE PRINT-REC FROM PR-LINE1 BEFORE 1.
097000     WRITE PRINT-REC FROM PR-LINE2 BEFORE 1.
097100     WRITE PRINT-REC FROM PR-LINE3 BEFORE 1.
097200     WRITE PRINT-REC FROM PR-LINE4 BEFORE 1.
097300     MOVE SPACES TO PRINT-REC.
           MOVE SPACES TO PR-LINE1, PR-LINE2, PR-LINE3, PR-LINE4.
060894     PERFORM SET-LOW-VALUES.
097500
097600 PRINT-TICKETS-STD-BAR.
097700     WRITE PRINT-REC FROM PR-LINE1  BEFORE 1.
097800     WRITE PRINT-REC FROM PR-LINE2  BEFORE 1.
097900     WRITE PRINT-REC FROM PR-LINE3  BEFORE 1.
102290     IF BAR-YES-OTHER OR BAR-YES-OKI3410
121586        PERFORM PRINT-BAR-CODE.
040793     IF EXTRA-BAR-CODE AND BAR-YES-OKI3410
047093        MOVE SPACES TO SETUP-REC
040793        WRITE SETUP-REC BEFORE 1.
098200     WRITE PRINT-REC FROM PR-LINE4 BEFORE 1.
062087     IF NOT EXTRA-BAR-CODE
098400        WRITE PRINT-REC FROM PR-LINE6 BEFORE 1.
098500     MOVE SPACES TO PRINT-REC.
040793     IF BAR-NO
121586        WRITE PRINT-REC BEFORE 1.
           MOVE SPACES TO PR-LINE1, PR-LINE2, PR-LINE3,
                     PR-LINE4, PR-LINE6.
060894     PERFORM SET-LOW-VALUES.
099000
080596 PRINT-PAINLESS.
080596     MOVE SPACES TO PRINT-REC-90.
080596     STRING L1-TICKET-1     DELIMITED BY SIZE
                  "    "          DELIMITED BY SIZE
                  L1-INIT-1       DELIMITED BY SIZE
                  "       "       DELIMITED BY SIZE
                  L1-INIT-2       DELIMITED BY SIZE
                  "   "           DELIMITED BY SIZE
080596            L1-TICKET-2     DELIMITED BY SIZE
                  INTO PRINT-REC-90.
080596     WRITE PRINT-REC-90 BEFORE 1.
080596     MOVE SPACES TO PRINT-REC-90.
080596     STRING L2-TICKET-1     DELIMITED BY SIZE
                  "    "          DELIMITED BY SIZE
                  L2-INIT-1       DELIMITED BY SIZE
                  "       "       DELIMITED BY SIZE
                  L2-INIT-2       DELIMITED BY SIZE
                  "   "           DELIMITED BY SIZE
080596            L2-TICKET-2     DELIMITED BY SIZE
                  INTO PRINT-REC-90.
080596     WRITE PRINT-REC-90 BEFORE 1.
080596     MOVE SPACES TO PRINT-REC-90.
080596     STRING L3-TICKET-1     DELIMITED BY SIZE
                  "    "          DELIMITED BY SIZE
                  L3-INIT-1       DELIMITED BY SIZE
                  "       "       DELIMITED BY SIZE
                  L3-INIT-2       DELIMITED BY SIZE
                  "   "           DELIMITED BY SIZE
080596            L3-TICKET-2     DELIMITED BY SIZE
                  INTO PRINT-REC-90.
080596     WRITE PRINT-REC-90 BEFORE 1.
080596     IF BAR-YES-OTHER OR BAR-YES-OKI3410
080596           PERFORM PRINT-BAR-CODE.
080596     IF EXTRA-BAR-CODE AND BAR-YES-OKI3410
080596        MOVE SPACES TO SETUP-REC
080596        WRITE SETUP-REC BEFORE 1.
080596     MOVE SPACES TO PRINT-REC-90.
080596     STRING L4-TICKET-1     DELIMITED BY SIZE
                  "    "          DELIMITED BY SIZE
                  L4-INIT-1       DELIMITED BY SIZE
                  "       "       DELIMITED BY SIZE
                  L4-INIT-2       DELIMITED BY SIZE
                  "   "           DELIMITED BY SIZE
080596            L4-TICKET-2     DELIMITED BY SIZE
                  INTO PRINT-REC-90.
080596     WRITE PRINT-REC-90 BEFORE 1.
080596     MOVE SPACES TO PRINT-REC-90.
080596     STRING L6-TICKET-1     DELIMITED BY SIZE
                  "    "          DELIMITED BY SIZE
                  L6-INIT-1       DELIMITED BY SIZE
                  "       "       DELIMITED BY SIZE
                  L6-INIT-2       DELIMITED BY SIZE
                  "   "           DELIMITED BY SIZE
080596            L6-TICKET-2     DELIMITED BY SIZE
                  INTO PRINT-REC-90.
080596     IF NOT EXTRA-BAR-CODE
080596        WRITE PRINT-REC-90 BEFORE 1.
080596     MOVE SPACES TO PRINT-REC-90.
080596     IF BAR-NO
080596        WRITE PRINT-REC-90 BEFORE 1.
080596     MOVE SPACES TO PR-LINE1, PR-LINE2, PR-LINE3,
080596               PR-LINE4, PR-LINE6.
080596     PERFORM SET-LOW-VALUES.

099100 RATEL-REPORT-EXIT. EXIT.
099200
121586 PRINT-BAR-CODE.
040793     IF BAR-YES-OTHER
040793        IF NUMBER-ACROSS = 2
041492           WRITE LINE-REC FROM ON-REC BEFORE 0
091596           WRITE BAR-REC-2 FROM BAR-CODE-LABELS-2 BEFORE 0
091596*          WRITE BAR-REC-2 FROM BAR-CODE-LABELS-2 BEFORE 1
                 WRITE LINE-REC FROM OFF-REC BEFORE 0
040793        ELSE
              IF NUMBER-ACROSS = 4
041492           WRITE LINE-REC FROM ON-REC BEFORE 0
091596           WRITE BAR-REC-4 FROM BAR-CODE-LABELS BEFORE 0
091596*          WRITE BAR-REC-4 FROM BAR-CODE-LABELS BEFORE 1
                 WRITE LINE-REC FROM OFF-REC BEFORE 0.
040793     IF BAR-YES-OKI3410
040793        IF NUMBER-ACROSS = 2
                 WRITE BAR-REC-2-OKI3410
                       FROM OKI-BAR-CODE-LABELS-2 BEFORE 1
040793        ELSE
              IF NUMBER-ACROSS = 4
                 WRITE BAR-REC-4-OKI3410
                       FROM OKI-BAR-CODE-LABELS BEFORE 1.

070987 CHECK-FOR-DUP-BUNDLE.
106400     MOVE CUTT-CUT-NUMBER TO CUT2-CUT-NUMBER.
106500     MOVE CUTT-BUNDLE-NUM TO CUT2-BUNDLE.
106600     MOVE 1 TO SEQ-NUM.
106700     MOVE SEQ-NUM TO CUT2-SEQ-NUM.
100287     IF PWII-YES
106900        PERFORM READ-CUT2F-BUNDLE-KEY
107000        IF C-FOUND OF CUT2F-STATUS
107100           IF CUTT-CUT-NUMBER NOT = CUT2-CUT-NUMBER
107200              PERFORM SET-ERROR-COLORS
107300              DISPLAY SCR-pi305-cbl-1319-29  
107400              PERFORM SET-NORM-COLORS.
107500*             CALL "SCIOBEEP"
022588*             PERFORM WAIT-ENTER.
107900
032392 PRINT-HDR.
           PERFORM CLEAR-PRINT-LINES.
041492     MOVE LOW-VALUES TO NAME6, INAME6.
041492     MOVE SPACES TO NAME5.
           MOVE 1 TO CNT.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(1)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME1.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(2)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME2.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(3)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME3.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(4)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME4.
           PERFORM MOVE-TO-PRINT-LINE.
           ADD 1 TO CNT.
041492     MOVE LOW-VALUES TO NAME6, INAME6.
041492     MOVE SPACES TO NAME5.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(5)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME1.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(6)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME2.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(7)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME3.
           STRING WS-BLACK            DELIMITED BY SIZE,
                  STYLE-DESC(8)       DELIMITED BY SIZE,
                  WS-BLACK            DELIMITED BY SIZE
                  INTO NAME4.
           PERFORM MOVE-TO-PRINT-LINE.
031492     PERFORM PRINT-TICKETS.
           MOVE ZERO TO CNT.

PROFIT     COPY "WAIT.SR".
062510     COPY "PAUSE.SR".
108100
072009*    COPY "PRINT.SR".
072009     COPY "LPPRINT.SR".
111706     COPY "CHAINR.SR".
062510     COPY "APPAREL.SR".
108200 IN-OUT SECTION.
108300 OPEN-RATEF.
090186     MOVE RATE TO PN-FILE.
PROFIT     PERFORM STRING-FILENAMES.
090186     MOVE PATHNAME TO RATE-FILENAME.
109000     OPEN INPUT  RATEF.
109100
109200 OPEN-CUTTF.
090186     MOVE CUTT TO PN-FILE.
PROFIT     PERFORM STRING-FILENAMES.
090186     MOVE PATHNAME TO CUTT-FILENAME.
109900     OPEN I-O CUTTF.
110000
110100 OPEN-CUT2F.
090186     MOVE CUT2 TO PN-FILE.
PROFIT     PERFORM STRING-FILENAMES.
090186     MOVE PATHNAME TO CUT2-FILENAME.
110800     OPEN I-O CUT2F.
110900
081287 OPEN-STYLF.
090186     MOVE STYLE TO PN-FILE.
PROFIT     PERFORM STRING-FILENAMES.
090186     MOVE PATHNAME TO STYLE-FILENAME.
080891     OPEN INPUT STYLF.
062510*OPEN-MUCTF.
062510*    MOVE MUCT TO PN-FILE.
062510*    PERFORM STRING-FILENAMES.
062510*    MOVE PATHNAME TO MUCT-FILENAME.
062510*    OPEN INPUT MUCTF.
111800
112390 OPEN-PROFITS-FILES.
PROFIT     MOVE 2 TO CNTLF-KEY.
050197     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CNTLF-STATUS OR IO-WAIT-OFF 
           READ CNTLF NO LOCK
           END-READ END-PERFORM.
112390     IF PROFITS-FG-ORDER-YES
PROFIT       MOVE 1 TO CNTLF-KEY
050197       PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1       CNTLF-STATUS OR IO-WAIT-OFF 
             READ CNTLF NO LOCK
             END-READ END-PERFORM
PROFIT       MOVE ITEM TO PN-FILE
PROFIT       PERFORM STRING-FILENAMES
PROFIT       MOVE PATHNAME TO ITEM-FILENAME
112390       OPEN INPUT ITEMF
022511*      MOVE ITRN TO PN-FILE
022511*      PERFORM STRING-FILENAMES
022511*      MOVE PATHNAME TO ITRN-FILENAME
022511       PERFORM SET-ITRN-FILENAME
112390       OPEN I-O ITRNF.

PROFIT       COPY "STRGFILE.SR".
PROFIT       COPY "SCRNINIT.SR".
111900
112000 START-RATEF.
081287       MOVE STYLE-STRUCTURE(CNT2) TO RATE-TICKET-STYLE.
110295*      MOVE SPACES TO RATE-TICKET-LOC.
110295       MOVE ZERO   TO RATE-TICKET-LOC.
030196*      IF RATE-TICKET-LOC-KEY = SPACES
030196       IF RATE-TICKET-STYLE = SPACES
CLNUP1          MOVE AT-END      TO RATEF-STATUS
081287       ELSE
112600       START RATEF KEY NOT < RATE-TICKET-LOC-KEY
112700           INVALID KEY MOVE RATEF-STATUS TO RATEF-STATUS.
112800 READ-RATEF-NEXT.
112900     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      RATEF-STATUS OR IO-WAIT-OFF 
           READ RATEF NEXT
113000         AT END MOVE RATEF-STATUS TO RATEF-STATUS
           END-READ END-PERFORM.
113100       IF RATEF-STATUS = FILE-LOCKED OR
113200          RATEF-STATUS = RECORD-LOCKED
113300             DISPLAY SCR-pi305-cbl-1434-28  
113400             PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
113500                 UNTIL TIMER-CNT > TIMER-MAX
113600             GO TO READ-RATEF-NEXT
113700       ELSE
113800          DISPLAY SCR-pi305-cbl-1439-25 .
113900 START-BUNDLE-ORDER.
114000       MOVE LOW-BUNDLE TO CUTTF-KEY.
114100       START CUTTF KEY NOT < CUTTF-KEY
114200           INVALID KEY MOVE CUTTF-STATUS TO CUTTF-STATUS.
092487       IF CUTTF-STATUS = NOT-FOUND
CLNUP1          MOVE AT-END      TO CUTTF-STATUS.
114500 START-CUTT-ORDER.
114600       MOVE LOW-CUT TO CUTT-CUT-NUMBER.
110703*      MOVE LOW-VALUES TO CUTT-BUNDLE.
114800       START CUTTF KEY NOT < CUTT-CUT-NUM-KEY
114900           INVALID KEY MOVE CUTTF-STATUS TO CUTTF-STATUS.
092487       IF CUTTF-STATUS = NOT-FOUND
CLNUP1          MOVE AT-END      TO CUTTF-STATUS.
115200 READ-CUTTF-NEXT.
115300     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CUTTF-STATUS OR IO-WAIT-OFF 
           READ CUTTF NEXT
115400         AT END MOVE CUTTF-STATUS TO CUTTF-STATUS
           END-READ END-PERFORM.
115500       IF CUTTF-STATUS = FILE-LOCKED OR
115600          CUTTF-STATUS = RECORD-LOCKED
115700             DISPLAY SCR-pi305-cbl-1458-28  
115800             PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
115900                 UNTIL TIMER-CNT > TIMER-MAX
116000             GO TO READ-CUTTF-NEXT
116100       ELSE
116200          DISPLAY SCR-pi305-cbl-1463-25 .
116300
070987 READ-CUT2F-BUNDLE-KEY.
116500     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CUT2F-STATUS OR IO-WAIT-OFF 
           READ CUT2F KEY IS CUT2-BUNDLE-NUM-KEY
116600          INVALID KEY MOVE CUT2F-STATUS TO CUT2F-STATUS
           END-READ END-PERFORM.
116700       IF CUTTF-STATUS = FILE-LOCKED OR
116800          CUTTF-STATUS = RECORD-LOCKED
116900             DISPLAY SCR-pi305-cbl-1470-28  
117000             PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
117100                 UNTIL TIMER-CNT > TIMER-MAX
117200             GO TO READ-CUT2F-BUNDLE-KEY
117300       ELSE
117400          DISPLAY SCR-pi305-cbl-1475-25 .
117500
062510*READ-MUCTF.
062510*    MOVE 1 TO MUCTF-KEY.
062510*    PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
062510*     MUCTF-STATUS OR IO-WAIT-OFF 
062510*    READ MUCTF NO LOCK
062510*       INVALID KEY MOVE MUCTF-STATUS TO MUCTF-STATUS
062510*    END-READ END-PERFORM.
062510*    IF MUCTF-STATUS = RECORD-LOCKED OR
062510*       MUCTF-STATUS = FILE-LOCKED
062510*       DISPLAY SCR-pi305-cbl-1483-23  
062510*       PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1 UNTIL
062510*            TIMER-CNT > TIMER-MAX
062510*       GO TO READ-MUCTF
062510*    ELSE
062510*       DISPLAY SCR-pi305-cbl-1488-23 .
117600
121586 WRITE-CUT2F.
117800     ADD 1 TO SEQ-NUM.
117900     MOVE SEQ-NUM TO CUT2-SEQ-NUM.
042987     DISPLAY SCR-pi305-cbl-1493-20  .
042987     IF PWII-YES
042987        DISPLAY SCR-pi305-cbl-1495-23  
042987        DISPLAY SCR-pi305-cbl-1496-23  
118400        WRITE CUT2F-REC
118500            INVALID KEY MOVE CUT2F-STATUS TO CUT2F-STATUS
042987     ELSE
042987        MOVE FOUND TO CUT2F-STATUS.
118800     IF CUT2F-STATUS = DUP-RECORD
118900        ADD 1 TO SEQ-NUM
119000        MOVE SEQ-NUM TO CUT2-SEQ-NUM
119100        GO TO WRITE-CUT2F.
119200     MOVE 1 TO ARRAY-CNT.
119300     MOVE LOW-VALUES TO CUT2F-DATA1.
119400     MOVE RATE-STYLE TO CUT2-STYLE-NUMBER.
042987     DISPLAY SCR-pi305-cbl-1508-20  .

061793     COPY "FGORDER.SR".

121586 CLEAR-CUT2F.
121586     MOVE CUTT-CUT-NUMBER TO CUT2-CUT-NUMBER.
121586     MOVE CUTT-BUNDLE-NUM TO CUT2-BUNDLE.
121586     MOVE 1 TO SEQ-NUM.
120000     MOVE SEQ-NUM TO CUT2-SEQ-NUM.
042987     DISPLAY SCR-pi305-cbl-1517-20  .
042987     IF PWII-YES
042987        DISPLAY SCR-pi305-cbl-1519-23  
093087        START CUT2F KEY NOT < CUT2-BUNDLE-NUM-KEY
120500           INVALID KEY MOVE CUT2F-STATUS TO CUT2F-STATUS
042987     ELSE
042987        MOVE NOT-FOUND TO CUT2F-STATUS.
100187     IF PWII-YES
120900        IF C-FOUND OF CUT2F-STATUS
121000          PERFORM DELETE-CUT2F UNTIL CUT2F-STATUS = NOT-FOUND.
121586 DELETE-CUT2F.
121200     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      CUT2F-STATUS OR IO-WAIT-OFF 
           READ CUT2F NEXT
121300         AT END MOVE CUT2F-STATUS TO CUT2F-STATUS
           END-READ END-PERFORM.
042987     DISPLAY SCR-pi305-cbl-1530-20  .
121500     IF C-FOUND OF CUT2F-STATUS AND PWII-YES
121600        IF CUT2-BUNDLE = CUTT-BUNDLE-NUM
121700           DELETE CUT2F
121800              INVALID KEY MOVE CUT2F-STATUS TO CUT2F-STATUS
121900        ELSE
122000           MOVE NOT-FOUND TO CUT2F-STATUS
122100     ELSE
122200        MOVE NOT-FOUND TO CUT2F-STATUS.
122300
112390 READ-ITEMF.
112390     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      ITEMF-STATUS OR IO-WAIT-OFF 
           READ ITEMF
112390        INVALID KEY MOVE ITEMF-STATUS TO ITEMF-STATUS
           END-READ END-PERFORM.
112390       IF ITEMF-STATUS = FILE-LOCKED OR
112390          ITEMF-STATUS = RECORD-LOCKED
112390             DISPLAY SCR-pi305-cbl-1545-28  
112390             PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
112390                 UNTIL TIMER-CNT > 5
112390             GO TO READ-ITEMF
112390       ELSE
112390          DISPLAY SCR-pi305-cbl-1550-25 .

112390 WRITE-ITRNF.
112390     WRITE ITRNF-REC
112390         INVALID KEY MOVE ITRNF-STATUS TO ITRNF-STATUS.
112390     IF ITRNF-STATUS = DUP-RECORD
112390        ADD 1 TO ITRNF-KEY
112390        GO TO WRITE-ITRNF.

081287 READ-STYLF.
122500     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      STYLF-STATUS OR IO-WAIT-OFF 
           READ STYLF KEY IS STYLF-KEY
122600          INVALID KEY MOVE STYLF-STATUS TO STYLF-STATUS
           END-READ END-PERFORM.
122700       IF CUTTF-STATUS = FILE-LOCKED OR
122800          CUTTF-STATUS = RECORD-LOCKED
122900             DISPLAY SCR-pi305-cbl-1564-28  
123000             PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
123100                 UNTIL TIMER-CNT > TIMER-MAX
123200             GO TO READ-STYLF
123300       ELSE
123400          DISPLAY SCR-pi305-cbl-1569-25 .
123500
123600
123700 CLOSE-FILES.
123800     CLOSE RATEF, CUTTF.
124000 IN-OUT-EXIT. EXIT.
124100
124200 FORM-SELECT.
124300     PERFORM SCREEN-INIT.
124500     DISPLAY SCR-pi305-cbl-1578-20  .
124600     MOVE "1010000000" TO FKEYS.
124700     MOVE 0 TO FLAG.
           PERFORM STEST-pi305-cbl-1581
124800     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, FORM-HELP,
124900          FORM-ANSWER
           PERFORM STEST-AFTER-CALL.
125000     IF FLAG = 3
125100          GO TO BEGIN-REPORT.
125200     IF OPTION OF FORM-SPECS = 1
125300          MOVE 2 TO NUMBER-ACROSS
125400     ELSE
125500          MOVE 4 TO NUMBER-ACROSS.
125600
125700 VALUE-SELECT.
125800     DISPLAY SCR-pi305-cbl-1591-20  .
125900     MOVE "1010000000" TO FKEYS.
126000     MOVE 0 TO FLAG.
           PERFORM STEST-pi305-cbl-1594
126100     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
            VALUE-HELP,
126200          VALUE-ANSWER
           PERFORM STEST-AFTER-CALL.
126300     IF FLAG = 3
126400          GO TO BEGIN-REPORT.
126500 ALIGN.
126600     PERFORM SCREEN-INIT.
126700     DISPLAY SCR-pi305-cbl-1600-20  .
126800     DISPLAY SCR-pi305-cbl-1601-20  .
126900     MOVE "1010000000" TO FKEYS.
127000     MOVE 11 TO ROW OF YES-NO-SPECS.
127100     MOVE 48 TO COL OF YES-NO-SPECS.
127200     MOVE 0 TO FLAG.
           PERFORM STEST-pi305-cbl-1606
127300     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
            YES-NO-HELP,
PROFIT           YES-NO
           PERFORM STEST-AFTER-CALL.
127500     IF FLAG = 3 GO TO BEGIN-REPORT.
127600     IF OPTION OF YES-NO-SPEC = 1
127700           GO TO DO-ALIGN.
127800
127900 DO-ALIGN.
128000     MOVE ",,,,!---------------------!,,,," TO NAME1,
128100          NAME2, NAME4.
041492     MOVE ",,,,!---------------------!,,,," TO NAME3.
128300     INSPECT NAME1 REPLACING ALL ",,,," BY CRTL-BLACK1.
128400     INSPECT NAME2 REPLACING ALL ",,,," BY CRTL-BLACK1.
128500     INSPECT NAME3 REPLACING ALL ",,,," BY CRTL-BLACK1.
128600     INSPECT NAME4 REPLACING ALL ",,,," BY CRTL-BLACK1.
041492     MOVE LOW-VALUES TO NAME6.
128700     MOVE "******" TO INAME1, INAME4.
052595     MOVE " **** " TO INAME2.
052595*    MOVE " **** " TO INAME2, INAME3.
060894     IF CNTL-COUPON-SIZE = 2 OR 4 OR 7
042594         MOVE "******" TO INAME2.
091696     MOVE "123456789012" TO NAME5.
128900     PERFORM MOVE-TO-PRINT-LINE VARYING CNT FROM 1 BY 1 UNTIL
129000         CNT > NUMBER-ACROSS.
129100     PERFORM PRINT-TICKETS.
129200*    MOVE SPACES TO PRINT-REC.
129300*    WRITE PRINT-REC BEFORE ADVANCING 0 LINES.
129400     MOVE 0 TO CNT.
129500     GO TO ALIGN.
129600
129700
129800 CLEAR-PRINT-LINES.
041295     MOVE SPACES TO INAME1, INAME2, INAME3, INAME4, INAME6,
041295                    NAME1, NAME2, NAME3, NAME4, NAME5, NAME6.
       FILENAMES SECTION.
       FILL-PATHS.
            MOVE SPACES TO TEMP-SUB-DIR.
            STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
            PERFORM CNTLF-FILL-FULLPATH.
            PERFORM ITEMF-FILL-FULLPATH.
022511*    PERFORM ITRNF-FILL-FULLPATH.
062510      PERFORM SCATF-FILL-FULLPATH.
       CNTLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CNTLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
            DELIMITED BY SPACES INTO CNTLF-FULLPATH.
       USERF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO USERF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
            INTO USERF-FULLPATH.
       ITEMF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ITEMF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ITEMF--NAME 
            DELIMITED BY SPACES INTO ITEMF-FULLPATH.
       ITRNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO ITRNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" ITRNF--NAME 
            DELIMITED BY SPACES INTO ITRNF-FULLPATH.

062510 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.

       CHAINCALLS SECTION.
       CHN--PARM-BLOCK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
            .

       CHN--PARM-BLK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.

       CHNR--WS-PASSED.
            COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==WS-PASSED==
            .

111706 CHNR-DOS-CALL-PARAM-BLOCK-DOS.
111706      COPY "CHAINR.CBL" REPLACING ==NEXT-PROG== BY ==DOS-CALL== 
111706      ==RETURN-CD== BY ==DOS-RET-CODE==.


       SCRN-TEST SECTION.
            COPY "STEST.SR".
CLNUP1*STEST-errorfil-sr-46.
CLNUP1*     MOVE "   pi305.cbl  errorfil.sr   46" TO STEST-KEY.
CLNUP1*     MOVE ERROR-FIELD TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(ERROR-FIELD) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ERROR-FIELD).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ERROR-FIELD" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ERROR-ANSWER).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ERROR-ANSWER" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
CLNUP1*STEST-print-sr-148.
CLNUP1*     MOVE "   pi305.cbl     print.sr  148" TO STEST-KEY.
CLNUP1*     MOVE PAUSE-SPECS TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(PAUSE-SPECS) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (PAUSE-SPECS).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "PAUSE-SPECS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ABORT-CONTINUE).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ABORT-CONTINUE" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
CLNUP1*STEST-wait-sr-5.
CLNUP1*     MOVE "   pi305.cbl      wait.sr    5" TO STEST-KEY.
CLNUP1*     MOVE WAIT-SPECS TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(WAIT-SPECS) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (WAIT-SPECS).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "WAIT-SPECS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ENTER-QUESTION).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ENTER-QUESTION" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
       STEST-pi305-cbl-735.
            MOVE "   pi305.cbl               735" TO STEST-KEY.
            MOVE RANGE-SPECS-1 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(RANGE-SPECS-1) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (RANGE-SPECS-1).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "RANGE-SPECS-1" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (RANGE-CODES).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "RANGE-CODES" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-pi305-cbl-752.
            MOVE "   pi305.cbl               752" TO STEST-KEY.
            MOVE RANGE-SPECS-2 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(RANGE-SPECS-2) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (RANGE-SPECS-2).
            MOVE 28 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "RANGE-SPECS-2" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (LOW-BUNDLE).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "LOW-BUNDLE" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (HIGH-BUNDLE).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HIGH-BUNDLE" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-pi305-cbl-757.
            MOVE "   pi305.cbl               757" TO STEST-KEY.
            MOVE RANGE-SPECS-3 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(RANGE-SPECS-3) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (RANGE-SPECS-3).
            MOVE 28 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "RANGE-SPECS-3" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (LOW-CUT).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "LOW-CUT" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (HIGH-CUT).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HIGH-CUT" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-pi305-cbl-1581.
            MOVE "   pi305.cbl              1581" TO STEST-KEY.
            MOVE FORM-SPECS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(FORM-SPECS) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FORM-SPECS).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FORM-SPECS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FORM-ANSWER).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FORM-ANSWER" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-pi305-cbl-1594.
            MOVE "   pi305.cbl              1594" TO STEST-KEY.
            MOVE VALUE-SPECS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(VALUE-SPECS) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (VALUE-SPECS).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "VALUE-SPECS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (VALUE-ANSWER).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "VALUE-ANSWER" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-pi305-cbl-1606.
            MOVE "   pi305.cbl              1606" TO STEST-KEY.
            MOVE YES-NO-FIELDS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(YES-NO-FIELDS) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO-FIELDS).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO-FIELDS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
130100
130200
130300
