000100 IDENTIFICATION DIVISION. 
000200 PROGRAM-ID.    M2235 IS INITIAL.
000300 AUTHOR.        AHK.
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION. 
           COPY "EXCEL.CS".
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
000800*REMARKS. 
000900 COPY "LEGAL.DTA".
001000*--                 M2235  EMPLOYEE MASTERFILE LISTING 
001100*--                        LABELS, AVG.LISTING, B-DAY LISTING   -
PROFIT*--  CVT AHK  - CONVERT PR110 TO PROFITS MENU OPTION 1.3.2.     -
PROFIT*--           - F2 NEW PRINT OPTIONS.
121294*--  MOD AHK  - ADD DEPT RANGE SELECT FOR COMAR INDUSTRIES.     -
121294*--           - (LAST-NAME KEY PARTIALLY INTRODUCED-SEE M2220). -
042595*--  FIX AHK  - EMPLOYEE RANGE SPEC ONLY 6 CHARS, SH BE 8.      -
091895* UPD KWS V2.3B- TREAT INACTIVE AND PURGE THE SAME              -
031896* UPD KWS V2.4A- IF HPLASER MOVE NON TO BARCODE                 *
011998* UPD KWS V2.7 - SHRINK C3OF9 BARCODE TO ONLY 8 CHARACTERS      *
032899* UPD KWS V2.8 - Y2K DATE CHANGES                                *
122399* UPD KWS V2.8C- PRINT HOURS ALSO                                *
011702* FIX KWS V2.9A- STIRNG EMPL NAME CORRECTLY                      *
100907* UPD KWS V4.4 - REMOVED BARCODE LOGIC                           *
010909* FIX KWS V4.4.1- ADDED CLOSE-LO                                 *
001900******************************************************************
002000 INPUT-OUTPUT SECTION.
002100 FILE-CONTROL.
002200
TP2PF      COPY "EMPLF.SL". 
PROFIT     COPY "USERF.SL". 
TP2PF      COPY "CNTLF.SL". 
PROFIT     COPY "LPFPRNTR.SL". 
            COPY "STEST.SL".
002600
002700 DATA DIVISION. 
       BASED-STORAGE SECTION.
            COPY "STEST.BS".
002800 FILE SECTION.
002900
003000*    PRNTR.FD   PRINT FILE DESCRIPTION. 
003100
070907     COPY "LPFPRNTR.FD".
070907*FD  LO 
070907*    LABEL RECORDS ARE OMITTED. 
003400
070907*01  PRINT-REC. 
070907*    03 FILLER           PIC X(132).
070907*01  PRINT-REC-LABEL.
070907*    03 SCREEN-REC       PIC X(40).
003700
070907*------ THE FOLLOWING ARE USED TO CONTROL 2410p BAR CODE PRINTING ------
070907*01  LINE-REC  .
070907*    05  FILLER               PIC XXXX.
070907*01  PITCH-REC    .
070907*    05  FILLER               PIC X(8).
070907*01  DENSITY-REC.
070907*    05  FILLER               PIC XX.
070907*01  ON-REC.
070907*    05  FILLER               PIC X.
070907*01  OFF-REC.
070907*    05  FILLER               PIC XXXXXXX.
070907*01  LPI-REC.
070907*    05  FILLER               PIC XX.
070907*01  BLANK-REC.
070907*    05  FILLER               PIC X.
070907*01  NULL-REC.
070907*    05  FILLER               PIC X(5).
070907*01  LABEL-REC.
070907*    05  FILLER               PIC X(09).

003800     COPY "EMPLF.FD". 
PROFIT     COPY "USERF.FD". 
TP2PF      COPY "CNTLF.FD". 
PROFIT     COPY "PWCTF.FD". 
            COPY "STEST.FD".
004200 WORKING-STORAGE SECTION. 
004300
004400 01  EMPLF-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".
PROFIT 01  USERF-STATUS        PIC XX.
PROFIT 01  CNTLF-STATUS        PIC XX.
PROFIT 01  LO-STATUS           PIC XX.
004500 01  PAGE-NO             PIC 9(4).
004600 01  LINE-COUNT          PIC 99     VALUE 0.
042595 01  LOW-KEY             PIC X(08)  VALUE LOW-VALUES. 
042595 01  HIGH-KEY            PIC X(08)  VALUE HIGH-VALUES.
121294 01  LOW-KEY-LNAME       PIC X(15) VALUE LOW-VALUES.
121294 01  HIGH-KEY-LNAME      PIC X(15) VALUE HIGH-VALUES.
121294 01  LAST-DEPT           PIC 9(3) VALUE 999.
121294 01  LOW-DEPT            PIC 9(3) VALUE 0.
121294 01  HIGH-DEPT           PIC 9(3) VALUE 999.
050996*01  JULIAN-DATE. 
050996*    05 JULIAN-MONTH     PIC 99.
050996*    05 JULIAN-DAY       PIC 99.
050996*    05 JULIAN-YEAR      PIC 99.
050996*01  JULIAN-DAYS         PIC 9999.
050390 01  TO-DAYS             PIC 9(9) COMP VALUE ZERO.
050390 01  FROM-DAYS           PIC 9(9) COMP VALUE ZERO.
050390 01  BIRTH-DAYS          PIC 9(9) COMP VALUE ZERO.
050390 01  TOTAL-DAYS          PIC 9(9) COMP VALUE ZERO.
110188 01  FROM-DATE. 
110188     05  FROM-MONTH      PIC 99.
110188     05  FROM-DAY        PIC 99.
110188     05  FROM-YEAR       PIC 99.
101788 01  TO-DATE. 
110188     05  TO-MONTH        PIC 99.
110188     05  TO-DAY          PIC 99.
110188     05  TO-YEAR         PIC 99.
101788 77  ALIGNMENT           PIC X(03)  VALUE "NO". 
101788 77  NUM-LABEL           PIC S9(02)  VALUE  1.
101988 77  LABEL-CNT            PIC 9(5)  VALUE  0.
101788 77  PIECE-WK-CNT        PIC S9(02)  VALUE  0.
101788 77  HOURLY-WK-CNT       PIC S9(02)  VALUE  0.
011193 77  EMPL-COUNT          PIC 9(4)    VALUE  0.
122291*--- OKI 2410P BARCODE (   ) ---*
070907*01  SPACES-LINE      PIC XXX VALUE SPACES.
070907*01  ON-CODE               COMP-1 VALUE 3.
070907*01  ON-CODE-REDEF REDEFINES ON-CODE.
070907*    05 ON-CHAR               PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  PITCH                    COMP-1 VALUE 54.
070907*01  PITCH-REDEF REDEFINES PITCH.
070907*    05 PITCH-CHAR            PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  PITCH-12                 COMP-1 VALUE 65.
070907*01  PITCH-12-REDEF REDEFINES PITCH-12.
070907*    05 PITCH-12-CHAR         PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  OFF-CODE                 COMP-1 VALUE 2.
070907*01  OFF-CODE-REDEF REDEFINES OFF-CODE.
070907*    05 OFF-CHAR              PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  ESC-CODE                 COMP-1 VALUE 27.
070907*01  ESC-CODE-REDEF REDEFINES ESC-CODE.
070907*    05 ESC-CHAR              PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  DENSITY-CODE                 COMP-1 VALUE 80.
070907*01  DENSITY-CODE-REDEF REDEFINES DENSITY-CODE.
070907*    05 DENSITY-CHAR              PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  ESC2-CODE                COMP-1 VALUE 37.
070907*01  ESC2-CODE-REDEF REDEFINES ESC2-CODE.
070907*    05 ESC2-CHAR             PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  ESC3-CODE                COMP-1 VALUE 57.
070907*01  ESC3-CODE-REDEF REDEFINES ESC3-CODE.
070907*    05 ESC3-CHAR             PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  LINE-CODE                COMP-1 VALUE 12.
070907*01  LINE-CODE-REDEF REDEFINES LINE-CODE.
070907*    05 LINE-CHAR             PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  LPI-CODE                COMP-1 VALUE 52.
070907*01  LPI-CODE-REDEF REDEFINES LPI-CODE.
070907*    05 LPI-CHAR             PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  LPI-CODE-8              COMP-1 VALUE 53.
070907*01  LPI-CODE-REDEF-8 REDEFINES LPI-CODE-8.
070907*    05 LPI-CHAR-8            PIC X.
070907*    05 FILLER                PIC X.
122291
070907*01  LINE-SETUP  .
070907*    05  LINE-CODE-1          PIC X.
070907*    05  LINE-CODE-2          PIC X.
070907*    05  LINE-CODE-3          PIC X.
070907*    05  LINE-CODE-4          PIC X.
070907*01  PITCH-SETUP    .
070907*    05  PITCH-CODE-1         PIC X.
070907*    05  PITCH-CODE-2         PIC X.
070907*01  DENSITY-SETUP.
070907*    05  DENSITY-CODE-1       PIC X.
070907*    05  DENSITY-CODE-2       PIC X.
070907*01  ON-SETUP.
070907*    05   ON-CODE-1           PIC X.
070907*01  OFF-SETUP.
070907*    05   OFF-CODE-1          PIC X.
070907*    05   OFF-CODE-2          PIC X.
070907*    05   RES-NULLS               PIC X(5) VALUE SPACES.
070907*01  LPI-SETUP.
070907*    05   LPI-CODE-1          PIC X.
070907*    05   LPI-CODE-2          PIC X.
122291
070907*01  BAR-CODE-LABELS.
070907*    05  BAR-LABEL-1          PIC X(08) VALUE SPACES.
070907*    05  BAR-LABEL-2          PIC X(08) VALUE SPACES.
070907*    05  BAR-LABEL-3          PIC X(08) VALUE SPACES.
070907*    05  BAR-LABEL-4          PIC X(08) VALUE SPACES.
070907*77  BAR-RET-CODE             COMP-1 VALUE 0.
111403*77  MARGIN-1                 COMP-1 VALUE 10.
111403*77  MARGIN-2                 COMP-1 VALUE 10.
111403*77  MARGIN-3                 COMP-1 VALUE 395.
111403*77  MARGIN-4                 COMP-1 VALUE 606.
070907*01  BAR-CODE-LABELS-OTHER.
070907*    05  FILLER               PIC X(1) VALUE X"09". 
070907*    05  BAR-LABEL-1-O        PIC X(08) VALUE SPACES.
007600
007700 01  DISPLAY-MESSAGES.
007800     03 PRINTING-REPORT  PIC X(16) VALUE "Printing Report.".
101788     03 ALIGN-MSG        PIC X(32) VALUE
008000                         "Do you wish to align the labels?".
008100
101788     03 DATE-MSG         PIC X(38) VALUE
008300                     " FROM date must be less than TO date. ".
053089     03 INACTIVE-MSG     PIC X(08) VALUE
053089        "Include?". 
053088 01  INCLUDE-INACTIVE-FLAG   PIC 9   VALUE 1. 
053089      88  ACTIVE-YES       VALUE 1. 
053089      88  INACTIVE-YES     VALUE 2. 
053089      88  ALL-EMPLOYEES    VALUE 3. 
053089 01  STATUS-TYPES.
053089     05 FILLER            PIC X(13) VALUE "Active Only".
053089     05 FILLER            PIC X(13) VALUE "InActive Only".
053089     05 FILLER            PIC X(13) VALUE "All Employees".
053089 01  STATUS-TYPES-REDEF REDEFINES STATUS-TYPES. 
053089     05 STATUS-OPT        PIC X(13) OCCURS 3 TIMES. 
053089
053089 01  ACTIVE-SPECS.
053089         10  FILLER     PIC X(9)  VALUE "1629O0313".
053089         10  OPTION     PIC 9     VALUE 3.
053089         10  FILLER     PIC X(4)  VALUE "E   ". 
053089 77  STATUS-HELP        PIC X(66) VALUE " You may choose to print 
      -    " All Employees, or Active/Inactive only.$".
008400     COPY "BOARDER.DSP".
      ******************************************************************
CS0050 01  SCRN-1.
      ******************************************************************
CS0100     05  SCRN-1-01        PIC X(80) VALUE "                  FROM 
CS0150-    "Date                 TO Date                             ". 
CS0200     05  SCRN-1-02        PIC X(80) VALUE "                       
CS0250-    "   Number of labels for :                                ". 
CS0300     05  SCRN-1-03        PIC X(80) VALUE "                       
CS0350-    "        Piecework                                        ". 
CS0400     05  SCRN-1-04        PIC X(80) VALUE "                       
CS0450-    "        Hourly                                           ". 
CS0400     05  SCRN-1-04        PIC X(80) VALUE "                       
CS0450-    " Include Barcodes                                        ". 
        01 REDEFINES SCRN-1 .
        02 SCRN-1-1-80 PIC X(80) .
        02 SCRN-1-81-160 PIC X(80) .
        02 SCRN-1-161-240 PIC X(80) .
        02 SCRN-1-241-320 PIC X(80) .
        02 SCRN-1-321-400 PIC X(80) .
      *-----------------------------------------------------------------
CS0050 01  INPUT-SPECS-1. 
CS0100     05  FILLER      PIC X(14)  VALUE "1129D06060    ". 
CS0150     05  FILLER      PIC X(14)  VALUE "1153D06060    ". 
CS0200     05  FILLER      PIC X(14)  VALUE "1345D02020    ". 
CS0250     05  FILLER      PIC X(14)  VALUE "1445D02020    ". 
122291     05  FILLER      PIC X(14)  VALUE "1542O02032    ". 
CS0300
CS0350 01  SPECS-1 REDEFINES INPUT-SPECS-1. 
122291     05  SPEC-1 OCCURS 5 TIMES. 
CS0450         10  ROW         PIC 99.
CS0500         10  COL         PIC 99.
CS0550         10  TYP         PIC X. 
CS0600         10  FLEN        PIC 99.
CS0650         10  SLEN        PIC 99.
CS0700         10  OPTION      PIC 9. 
CS0750         10  ATTR1       PIC XX.
CS0800         10  ATTR2       PIC XX.
PROFIT     COPY "CONSTANT.DTA". 
070907*    COPY "BARCODE.DTA". 
PROFIT     COPY "PWFILES.DTA". 
PROFIT     COPY "STATUS.DTA". 

      ******************************************************************
CS0250 01  HELP2. 
CS0300     05  FILLER PIC X(060)   VALUE " FROM DATE is the beginning da
CS0350-    "te this label is authorized. $".
CS0400     05  FILLER PIC X(060)   VALUE " TO DATE is the ending date th
CS0450-    "is label is authorized.      $". 
CS0500     05  FILLER PIC X(059)   VALUE " PIECEWORK is the number of la
CS0550-    "bels per piecework employee.$". 
CS0600     05  FILLER PIC X(053)   VALUE " HOURLY is the number of label
CS0650-    "s per hourly employee.$". 
CS0600     05  FILLER PIC X(068)   VALUE " BARCODE will print the barcod
CS0650-    "e for the employee# to be scanned.  $". 
CS0250 01  HELP3. 
CS0300     05  FILLER PIC X(063)   VALUE " FROM DATE is the beginning da
CS0350-    "te to start printing birthdays.$".
CS0400     05  FILLER PIC X(063)   VALUE " TO DATE is the ending date of
CS0450-    "birthdays to include.          $". 
      ****************************************************************** 
009100
009200     COPY "EMPLTYPE.OPT". 
062203     COPY "WAIT.OPT".
009300
TP2PF      COPY "SCREEN.DTA". 
TP2PF      COPY "ERROR.DTA".
TP2PF      COPY "ERRORP.DTA". 
TP2PF      COPY "DATE.DTA". 
PROFIT     COPY "PFPRINT.DTA". 
070907     COPY "PAUSE.DTA".
011800 01  RANGE-DATA.
121294     05  ORDER-MSG   PIC X(23) VALUE "Do you want to print by".
121294     05  ORDER-CODES. 
121294         10  FILLER     PIC X(10)  VALUE "Employee #".
121294         10  FILLER     PIC X(10)  VALUE "          ".
121294*        10  FILLER     PIC X(10)  VALUE "Last Name ".
121294         10  FILLER     PIC X(10)  VALUE "Department".
121294     05  ORDER-SPECS-1. 
121294         10  FILLER     PIC X(9)  VALUE "1044O0310".
121294         10  OPTION     PIC 9     VALUE 1.
121294         10  FILLER     PIC X(4)  VALUE "E   ". 
121294     05  ORDER-HELP-1   PIC X(50) VALUE " Select to print either b
121294-    "y Empl #, or Department.$". 
121294     05  ORDER-FLAG     PIC 9     VALUE 1.
121294         88  BY-EMPL    VALUE 1.
121294         88  BY-LNAME   VALUE 2.
121294         88  BY-DEPT    VALUE 3.
011900     05  RANGE-MSG      PIC X(23) VALUE "Do you want report by?". 
012000     05  RANGE-CODES. 
012100         10  FILLER     PIC X(7)  VALUE "All".
012200         10  FILLER     PIC X(7)  VALUE "A range".
012300     05  RANGE-SPECS-1. 
012400         10  FILLER     PIC X(9)  VALUE "1143O0207".
012500         10  OPTION     PIC 9     VALUE 1.
012600         10  FILLER     PIC X(4)  VALUE "E   ". 
012700     05  RANGE-HELP-1   PIC X(50) VALUE " Select to print either a
012800-    "ll employees or a range.$". 
121294     05  RANGE-LOW-MSG  PIC X(22) VALUE "First to Print   - ".
121294     05  RANGE-HIGH-MSG PIC X(22) VALUE "Last  to Print   - ".
013100     05  RANGE-SPECS-2. 
013200         10  FILLER     PIC X(14) VALUE "1343X06060    ". 
013300         10  FILLER     PIC X(14) VALUE "1443X06060    ". 
013400 01  RANGE-HELP-2.
013500     05  SCRN2-1   PIC X(116) VALUE " Enter the number of the firs
013600-    "t one to print.  To print a single one, make the    first an
013700-    "d the last one the same.$ ".
013800     05  SCRN2-1   PIC X(116) VALUE " Enter the number of the last
013900-    "  one to print.  To print a single one, make the    first an
014000-    "d the last one the same.$ ".
014100 01  RANGE-ERR-1    PIC X(47) VALUE 
014200      " That is an invalid range, please try another. ".
014300 01  RANGE-ERR-2    PIC X(51) VALUE 
014400      " There are none in this range, please try another. ".
101788 01  PR-SETUP.
014600     03 PR-SIZE-CODE     PIC X(4). 
014700     03 PR-COLOR-CODE    PIC X(4).
PROFIT 01  PR-CNDSE            PIC X(9).
014800
014900 01  PR-HEADER1.
015000     03 FILLER           PIC X(7)  VALUE "DATE - ". 
032899     03 PR-DATE-11       PIC X(11). 
015200     03 FILLER           PIC X(28)  VALUE SPACES. 
015300     03 PR-CONAME        PIC X(40)  VALUE SPACES. 
032899     03 FILLER           PIC X(44)  VALUE SPACES. 
015500
015600 01  PR-HEADER1A. 
015700     03 FILLER           PIC X(7)  VALUE "TIME - ". 
015800     03 PR-HOUR          PIC 99.
015900     03 FILLER           PIC X      VALUE ":".
016000     03 PR-MINUTE        PIC 99.
016100     03 FILLER           PIC X      VALUE ":".
016200     03 PR-SECONDS       PIC 99.
016300     03 FILLER           PIC X(22) VALUE SPACES.
016400     03 PR-TITLE         PIC X(58). 
016500     03 FILLER           PIC X(28) VALUE SPACES.
016600     03 FILLER           PIC X(5)   VALUE "PAGE ".
016700     03 PR-PAGE-NO       PIC ZZZ9.
016800
110188 01  BIRTH-TITLE  PIC X(58) VALUE 
110188     "    E M P L O Y E E   B I R T H D A Y   L I S T I N G    ". 
110188 01  AVG-TITLE  PIC X(58) VALUE 
110188     "    E M P L O Y E E   A V E R A G E     L I S T I N G    ". 
017500*                                ^
017600 01  PR-DETAIL1.
017700     05  FILLER  PIC X(06) VALUE "EMPL #".
017800     05  FILLER  PIC X(2) VALUE SPACES. 
017900     05  FILLER  PIC X(30) VALUE "EMPLOYEE NAME". 
018000     05  FILLER  PIC X(1) VALUE SPACES. 
018100     05  FILLER  PIC X(30) VALUE "EMPLOYEE ADDRESS".
018200     05  FILLER  PIC X(1)  VALUE SPACES.
018300     05  FILLER  PIC X(15) VALUE "   CITY". 
018400     05  FILLER  PIC X(1)  VALUE SPACES.
018500     05  FILLER  PIC X(2)  VALUE "ST".
018600     05  FILLER  PIC X(1)  VALUE SPACES.
018700     05  FILLER  PIC X(10)  VALUE "   ZIP". 
018800     05  FILLER  PIC X(2)  VALUE SPACES.
018900     05  FILLER  PIC X(13) VALUE "  PHONE". 
019000     05  FILLER  PIC X(2)  VALUE SPACES.
019100     05  FILLER  PIC X(8) VALUE "HIRED".
019200     05  FILLER  PIC X(2)  VALUE SPACES.
019300     05  FILLER  PIC X(8) VALUE "BIRTH".
019400
019500 01  DATA-DETAIL1.
019600     05 PR-EMPL-NUM       PIC X(08) VALUE SPACES. 
019700     05 FILLER                    PIC X(01) VALUE SPACES. 
011702*    05 PR-EMPL-NAME      PIC X(30) VALUE SPACES. 
011702     05 PR-NAME           PIC X(30) VALUE SPACES. 
019900     05 FILLER                    PIC X(01) VALUE SPACES. 
020000     05 PR-EMPL-ADDR      PIC X(30) VALUE SPACES. 
020100     05 FILLER            PIC X(01) VALUE SPACES. 
020200     05 PR-EMPL-CITY      PIC X(15) VALUE SPACES. 
020300     05 FILLER            PIC X(01) VALUE SPACES. 
020400     05 PR-EMPL-STATE     PIC X(02) VALUE SPACES. 
020500     05 FILLER            PIC X(01) VALUE SPACES. 
020600     05 PR-EMPL-ZIP       PIC X(10) VALUE SPACES. 
020700     05 PR-PHONE. 
020800        10 FILLER         PIC X VALUE "(".
020900        10 PR-AREA-CODE   PIC XXX VALUE SPACES. 
021000        10 FILLER         PIC X VALUE ")".
021100        10 PR-PREFIX      PIC XXX VALUE SPACES. 
021200        10 FILLER         PIC X VALUE "-".
021300        10 PR-SUFFIX      PIC XXXX VALUE SPACES.
021400     05 FILLER            PIC X(02) VALUE SPACES. 
021500     05 PR-HIRED-MON      PIC XX    VALUE SPACES. 
021600     05 FILLER            PIC X     VALUE "/".
021700     05 PR-HIRED-DAY      PIC XX    VALUE SPACES. 
021800     05 FILLER            PIC X     VALUE "/".
021900     05 PR-HIRED-YEAR     PIC XX    VALUE SPACES. 
022000     05 FILLER            PIC X     VALUE SPACES. 
022100     05 PR-BIRTH-MON      PIC XX    VALUE SPACES. 
022200     05 FILLER            PIC X     VALUE "/".
022300     05 PR-BIRTH-DAY      PIC XX    VALUE SPACES. 
022400     05 FILLER            PIC X     VALUE "/".
022500     05 PR-BIRTH-YEAR     PIC XX    VALUE SPACES. 
022600
101788 01  PR-LABEL-DETAIL1.
022800     05 FILLER            PIC X(06) VALUE "DEPT: ". 
051293     05 PR-LABEL-EMPL-DEPT PIC 9(03) VALUE ZEROES.
023000     05 FILLER            PIC X(04) VALUE SPACES. 
           05 FILLER            PIC X(06) VALUE "EMPL: ". 
023200     05 PR-LABEL-EMPL-NUM PIC X(08) VALUE SPACES. 
023300
101788 01  PR-LABEL-DETAIL2.
011702     05 PR-LABEL-EMPL-NAME PIC X(33) VALUE SPACES. 
023600
101788 01  PR-LABEL-DETAIL3.
032899*    05 PR-FROM-MON       PIC X(02)  VALUE SPACES.
032899*    05 FILLER            PIC X      VALUE "/". 
032899*    05 PR-FROM-DAY       PIC X(02)  VALUE SPACES.
032899*    05 FILLER            PIC X      VALUE "/". 
032899*    05 PR-FROM-YEAR      PIC X(02)  VALUE SPACES.
032899*    05 FILLER            PIC X(04)  VALUE " TO ".
032899*    05 PR-TO-MON         PIC X(02)  VALUE SPACES.
032899*    05 FILLER            PIC X      VALUE "/". 
032899*    05 PR-TO-DAY         PIC X(02)  VALUE SPACES.
032899*    05 FILLER            PIC X      VALUE "/". 
032899*    05 PR-TO-YEAR        PIC X(02)  VALUE SPACES.
032899     05 PR-FROM-DATE-11   PIC X(11)  VALUE SPACES.
032899     05 FILLER            PIC X(06)  VALUE "  TO  ".
032899     05 PR-TO-DATE-11     PIC X(11)  VALUE SPACES.
101788 01  PR-ALIGN-REC.
025000     05 POSITION-1        PIC X      VALUE "X". 
025100     05 FILLER            PIC X(33)  VALUE SPACES.
025200     05 POSITION-85       PIC X      VALUE "X". 
025300
111088 01  PR-AVG1. 
025500     05  FILLER              PIC X(06) VALUE "EMPL #".
025600     05  FILLER              PIC X(1) VALUE SPACES. 
025700
025800     05  FILLER              PIC X(10) VALUE "NAME      ".
025900     05  FILLER              PIC X(1) VALUE SPACES. 
026000     05  FILLER              PIC X(7) VALUE "WEEK 1 ".
026100     05  FILLER              PIC X(1) VALUE SPACES. 
026200     05  FILLER              PIC X(7) VALUE "WEEK 2 ".
026300     05  FILLER              PIC X(1) VALUE SPACES. 
026400     05  FILLER              PIC X(7) VALUE "WEEK 3 ".
026500     05  FILLER              PIC X(1) VALUE SPACES. 
026600     05  FILLER              PIC X(7) VALUE "WEEK 4 ".
026700     05  FILLER              PIC X(1) VALUE SPACES. 
026800     05  FILLER              PIC X(7) VALUE "WEEK 5 ".
026900     05  FILLER              PIC X(1) VALUE SPACES. 
027000     05  FILLER              PIC X(7) VALUE "WEEK 6 ".
027100     05  FILLER              PIC X(1) VALUE SPACES. 
027200     05  FILLER              PIC X(7) VALUE "WEEK 7 ".
027300     05  FILLER              PIC X(1) VALUE SPACES. 
027400     05  FILLER              PIC X(7) VALUE "WEEK 8 ".
027500     05  FILLER              PIC X(1) VALUE SPACES. 
027600     05  FILLER              PIC X(7) VALUE "WEEK 9 ".
027700     05  FILLER              PIC X(1) VALUE SPACES. 
027800     05  FILLER              PIC X(7) VALUE "WEEK 10".
027900     05  FILLER              PIC X(1) VALUE SPACES. 
028000     05  FILLER              PIC X(7) VALUE "WEEK 11".
028100     05  FILLER              PIC X(1) VALUE SPACES. 
028200     05  FILLER              PIC X(7) VALUE "WEEK 12".
028300     05  FILLER              PIC X(1) VALUE SPACES. 
028400     05  FILLER              PIC X(7) VALUE "WEEK 13".
028500     05  FILLER              PIC X(1) VALUE SPACES. 
028600     05  FILLER              PIC X(7) VALUE "QTR AVG".
011193 01  PR-EMPL-TOTAL-CNT.
011193     05 FILLER               PIC X(17) VALUE "TOTAL EMPLOYEES: ".
011193     05 PR-EMPL-TOTAL        PIC ZZZ9 VALUE ZERO.
111088 01  DATA-AVG1. 
028800     05 EMPL-AVG-NUM         PIC X(06) VALUE SPACES.
028900     05 FILLER                       PIC X(01) VALUE SPACES.
029000     05 EMPL-AVG-NAME        PIC X(10) VALUE SPACES.
029100     05 FILLER                       PIC X(02) VALUE SPACES.
029200     05 PR-EMPL-WKLY-AVG-1   PIC Z9.99- VALUE ZERO. 
029300     05  FILLER              PIC X(2) VALUE SPACES. 
029400     05 PR-EMPL-WKLY-AVG-2   PIC Z9.99- VALUE ZERO. 
029500     05  FILLER              PIC X(2) VALUE SPACES. 
029600     05 PR-EMPL-WKLY-AVG-3   PIC Z9.99- VALUE ZERO. 
029700     05  FILLER              PIC X(2) VALUE SPACES. 
029800     05 PR-EMPL-WKLY-AVG-4   PIC Z9.99- VALUE ZERO. 
029900     05  FILLER              PIC X(2) VALUE SPACES. 
030000     05 PR-EMPL-WKLY-AVG-5   PIC Z9.99- VALUE ZERO. 
030100     05  FILLER              PIC X(2) VALUE SPACES. 
030200     05 PR-EMPL-WKLY-AVG-6   PIC Z9.99- VALUE ZERO. 
030300     05  FILLER              PIC X(2) VALUE SPACES. 
030400     05 PR-EMPL-WKLY-AVG-7   PIC Z9.99- VALUE ZERO. 
030500     05  FILLER              PIC X(2) VALUE SPACES. 
030600     05 PR-EMPL-WKLY-AVG-8   PIC Z9.99- VALUE ZERO. 
030700     05  FILLER              PIC X(2) VALUE SPACES. 
030800     05 PR-EMPL-WKLY-AVG-9   PIC Z9.99- VALUE ZERO. 
030900     05  FILLER              PIC X(3) VALUE SPACES. 
031000     05 PR-EMPL-WKLY-AVG-10  PIC Z9.99- VALUE ZERO. 
031100     05  FILLER              PIC X(2) VALUE SPACES. 
031200     05 PR-EMPL-WKLY-AVG-11  PIC Z9.99- VALUE ZERO. 
031300     05  FILLER              PIC X(2) VALUE SPACES. 
031400     05 PR-EMPL-WKLY-AVG-12  PIC Z9.99- VALUE ZERO. 
031500     05  FILLER              PIC X(2) VALUE SPACES. 
031600     05 PR-EMPL-WKLY-AVG-13  PIC Z9.99- VALUE ZERO. 
031700     05  FILLER              PIC X(2) VALUE SPACES. 
031800     05 PR-EMPL-QTR-AVG      PIC Z9.99- VALUE ZERO. 
031900
TP2PF  77  PROG-NAME           PIC X(8) VALUE "M2235   ".
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 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  EMPLF--NAME PIC X(15) VALUE "EMPLOYEE.FIL" .
CLNUP1 77  EMPLF-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                         
CLNUP1*01 SCR-errorfil-sr-14-20 PIC IS X(51) FROM BOX-TOP CONTROL 
CLNUP1*     DSPL--CONTROL LINE 08 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-15-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-16-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 10 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-17-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 11 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-18-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 12 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-19-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 13 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-20-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 14 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-21-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
CLNUP1*     DSPL--CONTROL LINE 15 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-35-20 PIC IS X(40) FROM ERROR-MSG CONTROL 
CLNUP1*     DSPL--CONTROL LINE 10 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-36-20 PIC IS X(35) FROM ERROR-LINE-1 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 11 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-37-20 PIC IS X(41) FROM ERROR-LINE-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 12 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-38-20 PIC IS X(40) FROM ERROR-CONTACT CONTROL 
CLNUP1*     DSPL--CONTROL LINE 13 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-39-20 PIC IS X(40) FROM ERROR-RESUME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 14 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-40-20 VALUE IS "Program Name = " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-41-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 32 REVERSE-VIDEO.
CLNUP1*01 SCR-datechk-sr-35-23 PIC IS X(29) FROM DATE-ERROR CONTROL 
CLNUP1*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
CLNUP1*01 SCR-scrninit-sr-13-20 PIC IS X(80) FROM SCRN-TITLE-1 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 01 COLUMN 01.
CLNUP1*01 SCR-scrninit-sr-14-20 PIC IS X(80) FROM SCRN-TITLE-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 01.
CLNUP1*01 SCR-scrninit-sr-15-20 VALUE IS " PGM=" CONTROL DSPL--CONTROL 
CLNUP1*     LINE 02 COLUMN 04.
CLNUP1*01 SCR-scrninit-sr-16-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 09.
CLNUP1*01 SCR-scrninit-sr-17-20 VALUE IS " Station " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 19.
CLNUP1*01 SCR-scrninit-sr-18-20 PIC IS X(2) FROM USER-TERMID CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 28.
CLNUP1*01 SCR-scrninit-sr-21-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 
CLNUP1*     TIMER-CNT COLUMN 1 SIZE IS 80.
CLNUP1*01 SCR-print-sr-100-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 2 COLUMN 9.
CLNUP1*01 SCR-print-sr-114-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
CLNUP1*     DSPL--CONTROL LINE CNT COLUMN 2.
CLNUP1*01 SCR-print-sr-145-20 PIC IS X(80) FROM PAUSE-SCRN-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 19 COLUMN 1.
CLNUP1*01 SCR-wait-sr-4-21 VALUE IS "Press         to Continue!" CONTROL
CLNUP1*      DSPL--CONTROL LINE 19 COLUMN 27.
CLNUP1*01 SCR-wait-sr-7-21 PIC IS X(78) FROM CLEAR-19 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 19 COLUMN 2.
       01 SCR-m2235-cbl-553-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 2.
       01 SCR-m2235-cbl-554-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 2.
       01 SCR-m2235-cbl-555-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 2.
       01 SCR-m2235-cbl-556-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 15 COLUMN 2.
       01 SCR-m2235-cbl-586-23 PIC IS X(38) FROM DATE-MSG CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-m2235-cbl-639-24 VALUE IS "OKI2410 PRINTER IS NO LONGER SU
      -     "PPORTED" CONTROL DSPL--CONTROL LINE 21 COLUMN 1.
       01 SCR-m2235-cbl-644-20 PIC IS X(16) FROM PRINTING-REPORT CONTROL
             DSPL--CONTROL LINE 10 COLUMN 30.
       01 SCR-m2235-cbl-705-20 CONTROL DSPL--CONTROL.
        02 PIC X(80) FROM SCRN-1-1-80 LINE 11 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-81-160 LINE 12 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-161-240 LINE 13 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-241-320 LINE 14 COLUMN 1 .
        02 PIC X(80) FROM SCRN-1-321-400 LINE 15 COLUMN 1 .
       01 SCR-m2235-cbl-712-20 PIC IS X(80) FROM SCRN-1-01 CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 1.
       01 SCR-m2235-cbl-724-20 PIC IS X(23) FROM ORDER-MSG CONTROL 
            DSPL--CONTROL LINE 10 COLUMN 20.
       01 SCR-m2235-cbl-735-20 PIC IS X(23) FROM RANGE-MSG CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 20.
       01 SCR-m2235-cbl-745-20 PIC IS X(22) FROM RANGE-LOW-MSG CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 19.
       01 SCR-m2235-cbl-746-20 PIC IS X(22) FROM RANGE-HIGH-MSG CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 19.
       01 SCR-m2235-cbl-780-24 PIC IS X(47) FROM RANGE-ERR-1 CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-m2235-cbl-785-24 PIC IS X(51) FROM RANGE-ERR-2 CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-m2235-cbl-791-20 PIC IS X(8) FROM INACTIVE-MSG CONTROL 
            DSPL--CONTROL LINE 16 COLUMN 20.
       01 SCR-m2235-cbl-806-20 PIC IS X(8) FROM EMPLF-KEY CONTROL 
            DSPL--CONTROL LINE 4 COLUMN 73.
       01 SCR-m2235-cbl-1040-20 VALUE IS " THE OKIDATA 2410 PRINTER IS N
      -     "O LONGER SUPPORTED " CONTROL DSPL--CONTROL LINE 14 COLUMN 
            10.
       01 SCR-m2235-cbl-1042-20 VALUE IS "PRESS ENTER TO RETURN TO THE M
      -     "ENU" CONTROL DSPL--CONTROL LINE 15 COLUMN 10.
       01 SCR-m2235-cbl-1081-28 PIC IS X(44) FROM LOCKED-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-m2235-cbl-1086-25 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-m2235-cbl-1093-20 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 2.
       01 SCR-m2235-cbl-1094-20 PIC IS X(32) FROM ALIGN-MSG CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 20.
       01 SCR-m2235-cbl-1113-23 PIC IS X(78) FROM CLEAR-19 CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 2.
032100
032200 PROCEDURE DIVISION.
032300 DECLARATIVES.
032500
032600*    PRNTR.DS   PRINTER DECLARATIVES PROCEDURE. 
032700
032800 Z-PRNTR SECTION. 
032900     USE AFTER ERROR PROCEDURE ON LO.
033000 Z-PRNTR-D. 
TP2PF      COPY "ERRORPRT.SR". 
PROFIT     GO TO STATUS-EXIT.
033300     COPY "EMPLF.DS". 
PROFIT     COPY "USERF.DS". 
TP2PF      COPY "CNTLF.DS". 
PROFIT     GO TO STATUS-EXIT.
TP2PF      COPY "ERRORFIL.SR".
033800 STATUS-EXIT. EXIT. 
033900
034000 END DECLARATIVES.
034100
034200 MAIN-PROG SECTION. 
034300 OPEN-FILES.
           PERFORM USERF-FILL-FULLPATH.
034400     PERFORM PGM-INIT.
034600     PERFORM  OPEN-EMPLF. 
034700 BEGIN-REPORT.
           PERFORM SCREEN-INIT.
101788 RETRY-ENTRY. 
TS0322     IF PARM-BLK = 8
TS0322        MOVE PR-AVG1 TO PR-DETAIL1 
111088        MOVE AVG-TITLE TO PR-TITLE
TS0322        GO TO LOOK-FOR-CHAIN.
TS0322     IF PARM-BLK = 7
TS0322        PERFORM BIRTH-DATE
110188        MOVE BIRTH-TITLE TO PR-TITLE
TS0322     ELSE
TS0322     IF PARM-BLK = 6
TS0322        PERFORM TYPE-DATE 
TS0322     ELSE
TS0322        GO TO LOOK-FOR-CHAIN.
101788     
            DISPLAY SCR-m2235-cbl-553-20
            DISPLAY SCR-m2235-cbl-554-20
            DISPLAY SCR-m2235-cbl-555-20
            DISPLAY SCR-m2235-cbl-556-20.
037300     MOVE FROM-DATE TO DATE-IN.
TP2PF      PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
037500     MOVE DATE-IN TO FROM-DATE. 
037600     IF DATE-FLAG = "N"
037700        MOVE ERROR-ATTR TO ATTR1 OF SPEC-1(1)
037800        GO TO RETRY-ENTRY.
032899*    MOVE I-MONTH TO MONTH-1. 
032899*    MOVE I-DAY TO DAY-1.
032899*    MOVE I-YEAR TO YEAR-1. 
032899     MOVE JULIAN-DAYS TO JULIAN-DAYS-1.
032899     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
032899     MOVE DATE-OUT-11 TO PR-FROM-DATE-11.

038500     MOVE TO-DATE TO DATE-IN. 
TP2PF      PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
038700     MOVE DATE-IN TO TO-DATE. 
038800     IF DATE-FLAG = "N"
038900        MOVE ERROR-ATTR TO ATTR1 OF SPEC-1(2)
039000        GO TO RETRY-ENTRY.
039200     MOVE NORM-ATTR TO ATTR1 OF SPEC-1(2).
032899*    MOVE I-MONTH TO MONTH-2. 
032899*    MOVE I-DAY TO DAY-2. 
032899*    MOVE I-YEAR TO YEAR-2. 
032899     MOVE JULIAN-DAYS TO JULIAN-DAYS-2.
032899     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
032899     MOVE DATE-OUT-11 TO PR-TO-DATE-11.
032899*    IF DATE1 > DATE2 
032899     IF JULIAN-DAYS-1 > JULIAN-DAYS-2
039900        PERFORM SET-ERROR-COLORS 
040000        DISPLAY SCR-m2235-cbl-586-23   
040100        PERFORM SET-NORM-COLORS
040200        MOVE ERROR-ATTR TO ATTR1 OF SPEC-1(1)
040300        MOVE ERROR-ATTR TO ATTR1 OF SPEC-1(2)
040400        GO TO RETRY-ENTRY.
040600     MOVE NORM-ATTR TO ATTR1 OF SPEC-1(1) 
040700     MOVE NORM-ATTR TO ATTR1 OF SPEC-1(2).
091092 LOOK-FOR-CHAIN.
036100     IF FLAG = 3 
036200        GO TO END-REPORT.
034500     PERFORM SCREEN-INIT. 
           MOVE "1010000000" TO FKEYS.
043400     PERFORM PRINT-SELECT.
043500     IF FLAG = 3
TS0322        GO TO END-REPORT.
070907*    IF USER-PTR-CODES = 4
070907*       MOVE 1 TO BARCODE-PRINTER-CD
070907*    ELSE
070907*    MOVE CNTL-BARCODE-EMULATION(USER-PTR-CODES) TO 
070907*         BARCODE-PRINTER-CD.
PROFIT     PERFORM PF-OPEN-LO. 
043000 REDO-RANGE.
           PERFORM SCREEN-INIT.
121294     IF PARM-BLK = 6
121294        PERFORM ORDER-SELECT.
TS0322     IF PARM-BLK NOT = 7
TS0322        PERFORM RANGE-SELECT THRU RANGE-SELECT-EXIT.
043300     IF FLAG = 3
              CLOSE LO
TS0322        GO TO BEGIN-REPORT.
053089     PERFORM ASK-INCLUDE-INACTIVE. 
053089     IF FLAG = 3
TS0322        GO TO REDO-RANGE.
           PERFORM SCREEN-INIT.
TS0322     IF PARM-BLK = 6
TS0322        PERFORM ALIGN.
           IF FLAG = 3
              GO TO REDO-RANGE.
034500     PERFORM SCREEN-INIT. 
043700     MOVE 61 TO LINE-COUNT. 
043800     MOVE 0 TO PAGE-NO. 
070907*    IF OKI-590 OR OKI-3410
070907*       WRITE PRINT-REC FROM
070907*             OKI590-C39-SETUP BEFORE 0
070907*    ELSE
070907*    IF AMT-OTC
070907*       WRITE PRINT-REC FROM
070907*             AMT535-C39-SETUP BEFORE 0
070907*    ELSE
070907*    IF OKI-2410P
111403*        CALL "SETMAR9" USING MARGIN-1, MARGIN-2,
111403*                             MARGIN-3, MARGIN-4
111403*        WRITE PRINT-REC FROM PR-STD BEFORE 0.
070907*        DISPLAY SCR-m2235-cbl-639-24
070907*              
070907*    PERFORM WAIT-ENTER
070907*    GO TO EXIT-RUN.

044000     DISPLAY SCR-m2235-cbl-644-20  . 
044100     MOVE "0010000000" TO FKEYS.
044300     MOVE 1 TO FLAG.
044400     CALL "KBDCHK" USING FLAG, FKEYS. 
044500     MOVE 0 TO FLAG.
044600     PERFORM PROCESS-REPORT.
011193     IF PARM-BLK = 8
011193        PERFORM PRINT-EMPL-COUNT.
044800     MOVE SPACES TO PRINT-REC.
044900     IF PAGE-NO > 0 
070907        PERFORM PF-REC-CHECK
045000        WRITE PFRPT BEFORE ADVANCING PAGE.
010909     PERFORM CLOSE-LO.
045100     GO TO END-REPORT.
045200
045300 END-REPORT.
045400     PERFORM CLOSE-FILES. 
045500
045600 EXIT-RUN.
061395*    IF LAST-OPTION = "010304"
061395*       MOVE "M2270" TO NEXT-PROG
061395*    ELSE
061395*    MOVE "M2200" TO NEXT-PROG. 
PROFIT     COPY "FINISH.SR". 
PROFIT     COPY "CONTROL.SR".
062203     COPY "WAIT.SR".
046100
046200 SUBROUTINE SECTION.
046300 PGM-INIT.
046400     PERFORM CONTROL-INIT.
PROFIT     PERFORM GETCP-PARM-BLK-RET-CODE.
TS0322     IF PARM-BLK = 6
PROFIT        MOVE "Employee Label Print     " TO PGM-NAME.
TS0322     IF PARM-BLK = 7
PROFIT        MOVE "Employee Birthday Listing" TO PGM-NAME.
TS0322     IF PARM-BLK = 8
PROFIT        MOVE "Employee Average Listing " TO PGM-NAME.
032899     MOVE PGM-DATE-11 TO PR-DATE-11.
PROFIT     ACCEPT TIME-ACCP FROM TIME. 
PROFIT     MOVE A-HOUR TO PR-HOUR 
PROFIT     MOVE A-MINUTE TO PR-MINUTE.
PROFIT     MOVE A-SECONDS TO PR-SECONDS.
047800     MOVE CNTL-CONAME TO PR-CONAME. 
070907*    PERFORM PRINTER-INIT.
058400*-------------------------------------------------*
058500*----- SETUP FOR OKI 2410P BAR CODE GRAPHICS -----*
058600*-------------------------------------------------*
070907*    MOVE ESC-CHAR TO LINE-CODE-1,
070907*                      DENSITY-CODE-1, LPI-CODE-1.
070907*    MOVE ESC2-CHAR TO LINE-CODE-2.
070907*    MOVE ESC3-CHAR TO LINE-CODE-3.
070907*    MOVE LINE-CHAR TO LINE-CODE-4.
070907*    MOVE DENSITY-CHAR TO DENSITY-CODE-2.
070907*    MOVE ON-CHAR TO ON-CODE-1, OFF-CODE-1.
070907*    MOVE OFF-CHAR TO OFF-CODE-2.
070907*    MOVE LPI-CHAR TO LPI-CODE-2.
048500
PROFIT     COPY "SCRNINIT.SR".
011702     COPY "STRGEMPL.SR".
048700
048800 SUBROUTINE-EXIT. EXIT. 
048900
049600 TYPE-DATE. 
049700     DISPLAY SCR-m2235-cbl-705-20   . 
049800     MOVE "1010000000" TO FKEYS.
049900     MOVE 0 TO FLAG.
           PERFORM STEST-m2235-cbl-708
122291     CALL "SCRN05" USING FLAG, FKEYS, STEST-SCRN-SPECS,
050100           HELP2, FROM-DATE, TO-DATE, PIECE-WK-CNT, 
PROFIT           HOURLY-WK-CNT, YES-NO
           PERFORM STEST-AFTER-CALL. 
110188 BIRTH-DATE.
110188     DISPLAY SCR-m2235-cbl-712-20   .
110188     MOVE "1010000000" TO FKEYS.
110188     MOVE 0 TO FLAG.
           PERFORM STEST-m2235-cbl-715
110188     CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
110188           HELP3, FROM-DATE, TO-DATE
           PERFORM STEST-AFTER-CALL. 
050900
051000
      ******************************************************************
121294 ORDER-SELECT SECTION.
      ******************************************************************
       GET-ORDER. 
           PERFORM SCREEN-INIT. 
           DISPLAY SCR-m2235-cbl-724-20   .
           MOVE "1010000000" TO FKEYS.
           MOVE 0 TO FLAG.
           PERFORM STEST-m2235-cbl-727
           CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS,
             ORDER-HELP-1, ORDER-CODES
           PERFORM STEST-AFTER-CALL. 
           MOVE OPTION OF ORDER-SPECS-1 TO ORDER-FLAG.
       ORDER-SELECT-EXIT. EXIT. 
      ******************************************************************
051100 RANGE-SELECT SECTION.
051200
051300 GET-RANGE. 
051400     DISPLAY SCR-m2235-cbl-735-20   . 
051500     MOVE "1010000000" TO FKEYS.
051600     MOVE 0 TO FLAG.
           PERFORM STEST-m2235-cbl-738
051700     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS,
051800       RANGE-HELP-1, RANGE-CODES
           PERFORM STEST-AFTER-CALL. 
051900     IF FLAG = 3 GO TO RANGE-SELECT-EXIT. 
052000     IF OPTION OF RANGE-SPECS-1 = 1 
052100          MOVE LOW-VALUES TO LOW-KEY
052200          MOVE HIGH-VALUES TO HIGH-KEY
052300          GO TO RANGE-SELECT-EXIT.
052400     DISPLAY SCR-m2235-cbl-745-20   . 
052500     DISPLAY SCR-m2235-cbl-746-20   .
052600     MOVE SPACES TO LOW-KEY.
052700     MOVE SPACES TO HIGH-KEY. 
121294     IF BY-DEPT
121294        MOVE ZEROES TO LOW-DEPT, HIGH-DEPT
121294        MOVE "1344D03030    1444D03030    " TO RANGE-SPECS-2.
042595     IF BY-EMPL
042595        MOVE "1344X08080    1444X08080    " TO RANGE-SPECS-2.
121294*    IF BY-LNAME
121294*       MOVE "1344X15150    1444X15150    " TO RANGE-SPECS-2.
052800 GET-LOW-HIGH.
052900     MOVE "1010000000" TO FKEYS.
053000     MOVE 0 TO FLAG.
121294     IF BY-EMPL
              PERFORM STEST-m2235-cbl-760
053100        CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
121294          RANGE-HELP-2, LOW-KEY, HIGH-KEY
              PERFORM STEST-AFTER-CALL 
121294*    ELSE 
121294*    IF BY-LNAME
121294*       CALL "SCRN02" USING FLAG, FKEYS, RANGE-SPECS-2,
121294*         RANGE-HELP-2, LOW-KEY-LNAME, HIGH-KEY-LNAME
121294     ELSE 
              PERFORM STEST-m2235-cbl-767
121294        CALL "SCRN02" USING FLAG, FKEYS, STEST-SCRN-SPECS,
121294          RANGE-HELP-2, LOW-DEPT, HIGH-DEPT
              PERFORM STEST-AFTER-CALL.
053300     IF FLAG = 3 GO TO GET-RANGE. 
121294     IF HIGH-KEY = SPACES AND BY-EMPL
121294        IF LOW-KEY = SPACES
121294           MOVE LOW-VALUES TO LOW-KEY
121294           MOVE HIGH-VALUES TO HIGH-KEY
121294        ELSE
121294           MOVE LOW-KEY TO HIGH-KEY. 
121294     IF HIGH-DEPT = ZEROES AND BY-DEPT
121294        MOVE LOW-DEPT TO HIGH-DEPT.
121294     IF (BY-EMPL AND LOW-KEY > HIGH-KEY) OR
121294        (BY-DEPT AND LOW-DEPT > HIGH-DEPT)
121294         DISPLAY SCR-m2235-cbl-780-24    
121294         GO TO GET-LOW-HIGH.
121294*    MOVE LOW-KEY TO EMPLF-KEY.
054300     PERFORM START-EMPLF.
CLNUP1     IF C-END-OF-FILE OF EMPLF-STATUS
054500         DISPLAY SCR-m2235-cbl-785-24    
054600         GO TO GET-LOW-HIGH.
054700
054800 RANGE-SELECT-EXIT. EXIT. 

053089 ASK-INCLUDE-INACTIVE.
053089     DISPLAY SCR-m2235-cbl-791-20   .
053089     MOVE 0 TO FLAG.
053089     MOVE "1010000000" TO FKEYS.
           PERFORM STEST-m2235-cbl-794
053089     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
            STATUS-HELP,
053089          STATUS-TYPES
           PERFORM STEST-AFTER-CALL. 
053089     IF FLAG = 0
053089        MOVE OPTION OF ACTIVE-SPECS  TO INCLUDE-INACTIVE-FLAG.
054900
055000 PROCESS-REPORT SECTION.
055100 PROCESS-REPORT-BEGIN.
121294*    MOVE LOW-KEY TO EMPLF-KEY.
055700     PERFORM START-EMPLF.
055800     PERFORM  READ-EMPLF-NEXT.
055900
056000 PROCESS-REPORT-NEXT. 
           DISPLAY SCR-m2235-cbl-806-20  .
121294     IF (C-AT-END OF EMPLF-STATUS) 
121294        GO TO PROCESS-REPORT-EXIT
121294     ELSE
121294     IF BY-DEPT
121294        IF EMPL-DEPT > HIGH-DEPT
121294           GO TO PROCESS-REPORT-EXIT
121294        ELSE
121294           NEXT SENTENCE
121294*    ELSE
121294*    IF BY-LNAME
121294*       IF EMPL-LAST-NAME-KEY > HIGH-KEY-LNAME
121294*          GO TO PROCESS-REPORT-EXIT
121294*       ELSE
121294*          NEXT SENTENCE
121294     ELSE
121294        IF EMPLF-KEY > HIGH-KEY
121294           GO TO PROCESS-REPORT-EXIT. 
053089     IF ALL-EMPLOYEES 
053089        NEXT SENTENCE 
053089     ELSE 
091895        IF (INACTIVE-EMPL OR PURGE-EMPL) AND INACTIVE-YES
053089           NEXT SENTENCE
053089        ELSE
091895        IF (NOT INACTIVE-EMPL AND NOT PURGE-EMPL) AND ACTIVE-YES
053089           NEXT SENTENCE
053089        ELSE
053089           GO TO PROCESS-REPORT-READ. 
TS0322     IF PARM-BLK = 8 AND
TS0322        NOT PIECE-WORK
056500        PERFORM PROCESS-REPORT-READ.
121294*    IF EMPLF-KEY > HIGH-KEY
121294*       GO TO PROCESS-REPORT-EXIT.
TS0322     IF PARM-BLK = 7
TS0322          PERFORM JULIAN
110188          PERFORM BIRTH-SEARCH
057600          GO TO PROCESS-REPORT-READ.
TS0322     IF PARM-BLK = 8
TS0322        PERFORM MOVE-AVG-DETAIL 
057900     ELSE 
TS0322       IF PARM-BLK = 6
TS0322          PERFORM MOVE-LABEL-DETAIL. 

058400 PROCESS-REPORT-READ. 
058600     CALL "KBDCHK" USING FLAG, FKEYS
058700     IF GO-BACK
058800        PERFORM ACCEPT-PAUSE 
058900        IF OPTION OF PAUSE-SPEC(1) = 1
059200            GO TO PROCESS-REPORT-EXIT.
059300     PERFORM  READ-EMPLF-NEXT.
059400     GO TO PROCESS-REPORT-NEXT. 
059500
059600 PROCESS-REPORT-EXIT. EXIT. 
059700
059800 PRINT-REPORT SECTION.
059900 PRINT-DETAIL.
060000     PERFORM PRINT-REPORT-DETAIL. 
060100
060200
060300 PAGE-CHECK.
060400     IF LINE-COUNT > 60 AND PAGE-NO IS NOT = 0
060500         MOVE SPACES TO PRINT-REC 
070907               PERFORM PF-REC-CHECK
060600         WRITE PFRPT AFTER ADVANCING PAGE.
060700     IF LINE-COUNT > 60 
060800         MOVE 5 TO LINE-COUNT 
060900         ADD 1 TO PAGE-NO 
061000         MOVE PAGE-NO TO PR-PAGE-NO 
061100         MOVE PR-SETUP TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT BEFORE 0 
061200         MOVE PR-HEADER1 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT
061300         MOVE PR-HEADER1A TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT 
061400         MOVE SPACES TO PRINT-REC 
070907               PERFORM PF-REC-CHECK
061500         WRITE PFRPT
061600         MOVE PR-DETAIL1 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT
061700         MOVE SPACES TO PRINT-REC 
070907               PERFORM PF-REC-CHECK
061800         WRITE PFRPT. 
061900
062000 PRINT-REPORT-EXIT. EXIT. 
062100
062200 MOVE-DETAIL. 
062300       MOVE EMPLF-KEY TO PR-EMPL-NUM. 
017102*      MOVE EMPL-NAME TO PR-EMPL-NAME.
011702       PERFORM STRING-EMPL-NAME.
062500       MOVE EMPL-ADDR TO PR-EMPL-ADDR. 
062600       MOVE EMPL-CITY    TO PR-EMPL-CITY. 
062700       MOVE EMPL-STATE      TO PR-EMPL-STATE.
062800       MOVE EMPL-ZIP     TO PR-EMPL-ZIP.
062900       MOVE 1 TO CNT2.
063000       UNSTRING EMPL-PHONE INTO PR-AREA-CODE. 
063100       MOVE 4 TO CNT2.
063200       UNSTRING EMPL-PHONE INTO PR-PREFIX POINTER CNT2. 
063300       MOVE 7 TO CNT2.
063400       UNSTRING EMPL-PHONE INTO PR-SUFFIX POINTER CNT2. 
063500       MOVE EMPLOY-MON TO PR-HIRED-MON. 
063600       MOVE EMPLOY-DAY TO PR-HIRED-DAY. 
063700       MOVE EMPLOY-YEAR TO PR-HIRED-YEAR. 
063800       MOVE BIRTH-MON  TO PR-BIRTH-MON. 
063900       MOVE BIRTH-DAY  TO PR-BIRTH-DAY. 
064000       MOVE BIRTH-YEAR TO PR-BIRTH-YEAR.
064100       PERFORM PRINT-DETAIL.
064200
111088 MOVE-AVG-DETAIL. 
111088       MOVE EMPLF-KEY TO EMPL-AVG-NUM.
111088       MOVE EMPL-NAME-KEY TO EMPL-AVG-NAME. 
111088       MOVE EMPL-WKLY-AVG(1) TO PR-EMPL-WKLY-AVG-1. 
111088       MOVE EMPL-WKLY-AVG(2) TO PR-EMPL-WKLY-AVG-2. 
111088       MOVE EMPL-WKLY-AVG(3) TO PR-EMPL-WKLY-AVG-3. 
111088       MOVE EMPL-WKLY-AVG(4) TO PR-EMPL-WKLY-AVG-4. 
111088       MOVE EMPL-WKLY-AVG(5) TO PR-EMPL-WKLY-AVG-5. 
111088       MOVE EMPL-WKLY-AVG(6) TO PR-EMPL-WKLY-AVG-6. 
111088       MOVE EMPL-WKLY-AVG(7) TO PR-EMPL-WKLY-AVG-7. 
111088       MOVE EMPL-WKLY-AVG(8) TO PR-EMPL-WKLY-AVG-8. 
111088       MOVE EMPL-WKLY-AVG(9) TO PR-EMPL-WKLY-AVG-9. 
111088       MOVE EMPL-WKLY-AVG(10) TO PR-EMPL-WKLY-AVG-10. 
111088       MOVE EMPL-WKLY-AVG(11) TO PR-EMPL-WKLY-AVG-11. 
111088       MOVE EMPL-WKLY-AVG(12) TO PR-EMPL-WKLY-AVG-12. 
111088       MOVE EMPL-WKLY-AVG(13) TO PR-EMPL-WKLY-AVG-13. 
111088       MOVE EMPL-QTR-AVG TO PR-EMPL-QTR-AVG.
066000       PERFORM PRINT-DETAIL.

111088       MOVE SPACES      TO EMPL-AVG-NUM.
111088       MOVE "Hours "    TO EMPL-AVG-NAME. 
111088       MOVE EMPL-WEEKLY-HOURS(1) TO PR-EMPL-WKLY-AVG-1. 
111088       MOVE EMPL-WEEKLY-HOURS(2) TO PR-EMPL-WKLY-AVG-2. 
111088       MOVE EMPL-WEEKLY-HOURS(3) TO PR-EMPL-WKLY-AVG-3. 
111088       MOVE EMPL-WEEKLY-HOURS(4) TO PR-EMPL-WKLY-AVG-4. 
111088       MOVE EMPL-WEEKLY-HOURS(5) TO PR-EMPL-WKLY-AVG-5. 
111088       MOVE EMPL-WEEKLY-HOURS(6) TO PR-EMPL-WKLY-AVG-6. 
111088       MOVE EMPL-WEEKLY-HOURS(7) TO PR-EMPL-WKLY-AVG-7. 
111088       MOVE EMPL-WEEKLY-HOURS(8) TO PR-EMPL-WKLY-AVG-8. 
111088       MOVE EMPL-WEEKLY-HOURS(9) TO PR-EMPL-WKLY-AVG-9. 
111088       MOVE EMPL-WEEKLY-HOURS(10) TO PR-EMPL-WKLY-AVG-10. 
111088       MOVE EMPL-WEEKLY-HOURS(11) TO PR-EMPL-WKLY-AVG-11. 
111088       MOVE EMPL-WEEKLY-HOURS(12) TO PR-EMPL-WKLY-AVG-12. 
111088       MOVE EMPL-WEEKLY-HOURS(13) TO PR-EMPL-WKLY-AVG-13. 
111088       MOVE ZERO         TO PR-EMPL-QTR-AVG.
066000       PERFORM PRINT-DETAIL.
066100
101788 MOVE-LABEL-DETAIL. 
066300       IF PIECE-WORK
066400          MOVE PIECE-WK-CNT TO NUM-LABEL. 
066500       IF HOURLY
066600          MOVE HOURLY-WK-CNT TO NUM-LABEL.
091895       IF ((INACTIVE-EMPL OR PURGE-EMPL)  AND INACTIVE-YES) OR
091895          ((NOT INACTIVE-EMPL AND NOT PURGE-EMPL) AND ACTIVE-YES)
                  OR
091895          ((NOT INACTIVE-EMPL AND NOT PURGE-EMPL) AND
                  ALL-EMPLOYEES) AND NOT SALARIED 
053089             NEXT SENTENCE 
053089       ELSE 
053089          MOVE ZERO TO NUM-LABEL. 
066900       MOVE EMPL-DEPT TO PR-LABEL-EMPL-DEPT.
067000       MOVE EMPLF-KEY TO PR-LABEL-EMPL-NUM. 
011702*      MOVE EMPL-NAME TO PR-LABEL-EMPL-NAME.
011702       PERFORM STRING-EMPL-NAME.
011702       MOVE PR-NAME TO PR-LABEL-EMPL-NAME.
032899*      MOVE FROM-DATE TO DATE-IN. 
032899*      MOVE I-MONTH TO PR-FROM-MON.
032899*      MOVE I-DAY TO PR-FROM-DAY.
032899*      MOVE I-YEAR TO PR-FROM-YEAR.
032899*      MOVE TO-DATE TO DATE-IN. 
032899*      MOVE I-MONTH TO PR-TO-MON.
032899*      MOVE I-DAY TO PR-TO-DAY.
032899*      MOVE I-YEAR TO PR-TO-YEAR.
102088       PERFORM LABEL-NUM. 
068100
068200 PRINT-REPORT-DETAIL. 
068300     PERFORM PAGE-CHECK.
TS0322     IF PARM-BLK = 8
TS0322       MOVE DATA-AVG1 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER 1 LINES 
011193       ADD 1 TO EMPL-COUNT 
068600     ELSE 
011193       MOVE DATA-DETAIL1 TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER 1 LINES. 
068800     MOVE SPACES TO PRINT-REC.
068900     ADD 1 TO LINE-COUNT. 
069000
101788 PRINT-LABEL-DETAIL.
070907*    WRITE PRINT-REC-LABEL FROM PR-STD BEFORE 0.
070907     PERFORM PFRPT-SET-STANDARD.
070907*    WRITE PRINT-REC-LABEL FROM PR-LABEL-DETAIL2 BEFORE 1.
070907     MOVE PR-LABEL-DETAIL2 TO PRINT-REC.
070907     PERFORM PF-REC-CHECK.
           WRITE PFRPT BEFORE 1.
070907*    IF OPTION OF SPEC-1(5) = 2 OR NO-BARCODE
070907     IF OPTION OF SPEC-1(5) = 2
070907*       MOVE SPACES TO PRINT-REC-LABEL 
070907*       MOVE SPACES TO PRINT-REC       
070907*       WRITE PRINT-REC-LABEL BEFORE 1.
070907        PERFORM PF-REC-CHECK
070907        WRITE PFRPT       BEFORE 1.
070907*    WRITE PRINT-REC-LABEL FROM PR-LABEL-DETAIL1 BEFORE 1.
070907     MOVE PR-LABEL-DETAIL1 TO PRINT-REC
070907     PERFORM PF-REC-CHECK
           WRITE PFRPT BEFORE 1.
070907*    IF OPTION OF SPEC-1(5) = 2 OR NO-BARCODE
070907     IF OPTION OF SPEC-1(5) = 2
070907*       MOVE SPACES TO PRINT-REC-LABEL
070907        MOVE SPACES TO PRINT-REC
070907*       WRITE PRINT-REC-LABEL BEFORE 1.
070907        PERFORM PF-REC-CHECK
070907        WRITE PFRPT       BEFORE 1.
070907*    WRITE PRINT-REC-LABEL FROM PR-LABEL-DETAIL3 BEFORE 1.
070907     MOVE PR-LABEL-DETAIL3 TO PRINT-REC
070907     PERFORM PF-REC-CHECK
           WRITE PFRPT BEFORE 1.
070907*    IF OPTION OF SPEC-1(5) = 2 OR NO-BARCODE
070907     IF OPTION OF SPEC-1(5) = 2
070907*       MOVE SPACES TO PRINT-REC-LABEL 
070907        MOVE SPACES TO PRINT-REC 
070907*       WRITE PRINT-REC-LABEL BEFORE 1
070907        PERFORM PF-REC-CHECK
070907        WRITE PFRPT       BEFORE 1
122291     ELSE
122291        PERFORM PRINT-BAR-CODE.
120292*       WRITE PRINT-REC-LABEL FROM PR-STD BEFORE 1.
069700
122291 PRINT-BAR-CODE.
070907        MOVE EMPLF-KEY TO I0025-BAR-LABEL-ITEM-NO
070907        MOVE "BC0004" TO PFRPT-GROUP
070907               PERFORM PF-REC-CHECK
070907        WRITE PFRPT 
070907               PERFORM PF-REC-CHECK
070907        WRITE PFRPT 
070907        SET PFRPT-DEF-GROUP TO TRUE
070907*    IF OKI-2410P
070907*        PERFORM PRINT-BAR-CODE-2410.
070907*    IF OKI-590 OR OKI-3410
011998*        MOVE EMPLF-KEY TO OKI590-BAR-LABEL-ITEM-NO
011998*        WRITE PRINT-REC FROM OKI590-I0025-ITEM-NO BEFORE 0
011998*        WRITE PRINT-REC FROM OKI590-I0025-ITEM-NO BEFORE 1
070907*        MOVE  EMPLF-KEY TO   OKI590-BAR-LABEL-X8
070907*        WRITE PRINT-REC FROM OKI590-C39-X8 BEFORE 0
070907*        WRITE PRINT-REC FROM OKI590-C39-X8 BEFORE 1
070907*    ELSE IF AMT-OTC
070907*       MOVE EMPLF-KEY TO AMT535-BAR-LABEL-ITEM-NO
070907*       WRITE PRINT-REC FROM AMT535-I0025-ITEM-NO BEFORE 1
070907*       WRITE PRINT-REC FROM AMT535-I0025-ITEM-NO BEFORE 2.

070907*PRINT-BAR-CODE-2410.
062203*    MOVE ESC-CHAR TO PITCH-CODE-1.
062203*    MOVE PITCH-12-CHAR TO PITCH-CODE-2.
062203*    WRITE PITCH-REC FROM PITCH-SETUP BEFORE 0.
062203*    WRITE DENSITY-REC FROM DENSITY-SETUP.
062203*    MOVE 2 TO BAR-RET-CODE.
062203*    CALL "C39" USING PR-LABEL-EMPL-NUM, PR-LABEL-EMPL-NUM,
062203*             BAR-LABEL-3, BAR-LABEL-4, BAR-RET-CODE.
062203*    MOVE LPI-CHAR-8 TO LPI-CODE-2.
062203*    WRITE LINE-REC FROM LINE-SETUP BEFORE 0.
062203*    WRITE ON-REC FROM ON-SETUP BEFORE 0.
062203*    CALL "BARPRN9".
062203*    CALL "PUTCHA9" USING ON-CODE.
062203*    CALL "PUTCHA9" USING OFF-CODE.
062203*    WRITE LINE-REC FROM LINE-SETUP BEFORE 0
062203*    WRITE LINE-REC FROM SPACES-LINE BEFORE 1
062203*    WRITE ON-REC FROM ON-SETUP BEFORE 0
062203*    CALL "BARPRN9"
062203*    CALL "PUTCHA9" USING ON-CODE
062203*    CALL "PUTCHA9" USING OFF-CODE
062203*    WRITE LINE-REC FROM SPACES-LINE BEFORE 1.
062203*    MOVE LPI-CHAR TO LPI-CODE-2.
062203*    WRITE LPI-REC FROM LPI-SETUP BEFORE 0.
062203*    MOVE ESC-CHAR TO PITCH-CODE-1.
062203*    MOVE PITCH-CHAR TO PITCH-CODE-2.
062203*    WRITE PITCH-REC FROM PITCH-SETUP BEFORE 1.
070907*    DISPLAY SCR-m2235-cbl-1040-20
070907*             .
070907*    DISPLAY SCR-m2235-cbl-1042-20
070907*             .
070907*    PERFORM WAIT-ENTER.
070907*    GO TO EXIT-RUN.           
069800
069900 EMPLF-REPORT-EXIT. EXIT. 
070000
070100
PROFIT     COPY "PFPRINT.SR".
070200
070300 IN-OUT SECTION.
070400 OPEN-EMPLF.
TS0311     MOVE EMPL TO EMPL-FILENAME.
071100     OPEN INPUT EMPLF.
071200
071400
071500 START-EMPLF. 
121294     IF BY-DEPT
121294        MOVE LOW-DEPT TO EMPL-DEPT
121294        MOVE LOW-VALUES TO EMPL-NUMBER2
121294        START EMPLF KEY NOT < EMPL-DEPT-KEY
121294            INVALID KEY MOVE AT-END TO EMPLF-STATUS
121294     ELSE
121294*    IF BY-LNAME
121294*       MOVE LOW-KEY-LNAME TO EMPL-LAST-NAME-KEY
121294*       START EMPLF KEY NOT < EMPL-LAST-NAME-KEY
121294*           INVALID KEY MOVE AT-END TO EMPLF-STATUS
121294*    ELSE
121294        MOVE LOW-KEY TO EMPLF-KEY
              START EMPLF KEY NOT < EMPLF-KEY
                  INVALID KEY MOVE AT-END TO EMPLF-STATUS.
042387 START-SEARCH-FIELD.
071900       START EMPLF KEY NOT < EMPL-NAME-KEY
CLNUP1           INVALID KEY MOVE AT-END      TO EMPLF-STATUS.
072100 READ-EMPLF-NEXT. 
072200       PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1       EMPLF-STATUS OR IO-WAIT-OFF 
             READ EMPLF NEXT NO LOCK
CLNUP1         AT END MOVE AT-END      TO EMPLF-STATUS
             END-READ END-PERFORM. 
072400       IF EMPLF-STATUS = FILE-LOCKED OR 
072500          EMPLF-STATUS = RECORD-LOCKED
072600             DISPLAY SCR-m2235-cbl-1081-28   
072700             PERFORM TIME-LOOP VARYING TIMER-CNT FROM 1 BY 1
072800                 UNTIL TIMER-CNT > TIMER-MAX
072900             GO TO READ-EMPLF-NEXT
073000       ELSE 
073100          DISPLAY SCR-m2235-cbl-1086-25 . 
073200 CLOSE-FILES. 
073300     CLOSE EMPLF. 
073400 IN-OUT-EXIT. EXIT. 
TP2PF      COPY "DATECVT.SR".
TP2PF      COPY "DATECHK.SR".
101788 ALIGN. 
073800     DISPLAY SCR-m2235-cbl-1093-20   . 
073900     DISPLAY SCR-m2235-cbl-1094-20   . 
074000     MOVE 0 TO FLAG.
074100     MOVE "1010000000" TO FKEYS.
074200     MOVE 62 TO COL OF YES-NO-SPEC. 
074300     MOVE 11 TO ROW OF YES-NO-SPEC. 
074400     MOVE "E " TO ATTR1 OF YES-NO-SPECS.
           PERFORM STEST-m2235-cbl-1100
074500     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
            YES-NO-HELP,                                                
074600          YES-NO
           PERFORM STEST-AFTER-CALL. 
074800     IF OPTION OF YES-NO-SPEC = 1 
074900        MOVE "YES" TO ALIGNMENT 
070907*       WRITE PRINT-REC-LABEL FROM PR-ALIGN-REC BEFORE 0
070907        MOVE PR-ALIGN-REC TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT BEFORE 0
075800        GO TO ALIGN. 
011289*-- alignment X's on last line of previous label     -
011289*-- must advance 2 lines to first line of next label -
050692     IF ALIGNMENT = "YES"
070907*       MOVE SPACES TO PRINT-REC-LABEL
070907        MOVE SPACES TO PRINT-REC
070907*       WRITE PRINT-REC-LABEL BEFORE 2.
070907               PERFORM PF-REC-CHECK
070907        WRITE PFRPT       BEFORE 2.
075900     MOVE "NO " TO ALIGNMENT. 
101788 LABEL-NUM. 
076100        DISPLAY SCR-m2235-cbl-1113-23   .
076200        PERFORM PRINT-LABEL-DETAIL VARYING LABEL-CNT
076300         FROM 1 BY 1 UNTIL LABEL-CNT > NUM-LABEL. 
110188 JULIAN.
110188     IF A-YEAR < TO-YEAR
076600       MOVE TO-YEAR TO I-YEAR
076700     ELSE 
076800       MOVE A-YEAR TO I-YEAR.
076900     MOVE BIRTH-MON TO I-MONTH.
077000     MOVE BIRTH-DAY TO I-DAY.
077100     MOVE ZERO TO BIRTH-DAYS. 
050996*    PERFORM JULIAN-CALCULATION.
050996     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
077300     MOVE JULIAN-DAYS TO BIRTH-DAYS.
077400
110188     MOVE FROM-YEAR TO I-YEAR. 
077600     MOVE FROM-MONTH TO I-MONTH. 
077700     MOVE FROM-DAY TO I-DAY. 
050996*    PERFORM JULIAN-CALCULATION.
050996     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
077900     MOVE JULIAN-DAYS TO FROM-DAYS. 
078000
110188     MOVE TO-YEAR TO I-YEAR. 
078200     MOVE TO-MONTH TO I-MONTH. 
078300     MOVE TO-DAY TO I-DAY. 
050996*    PERFORM JULIAN-CALCULATION.
050996     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
078500     MOVE JULIAN-DAYS TO TO-DAYS. 
078600
079300
011193 PRINT-EMPL-COUNT.
011193     MOVE EMPL-COUNT TO PR-EMPL-TOTAL.
011193     MOVE PR-EMPL-TOTAL-CNT TO PRINT-REC
070907               PERFORM PF-REC-CHECK
              WRITE PFRPT AFTER 3.
110188 BIRTH-SEARCH.
110188     IF BIRTH-DAYS > TO-DAYS
080200     OR BIRTH-DAYS < FROM-DAYS
080300     NEXT SENTENCE
080400      ELSE
080500     PERFORM MOVE-DETAIL. 
       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 EMPLF-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.
       EMPLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO EMPLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EMPLF--NAME 
            DELIMITED BY SPACES INTO EMPLF-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==
            .

       GETCP-PARM-BLK-RET-CODE.
            COPY "GETCP.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK== 
            ==RETURN-CD== BY ==RET-CODE==.

       SCRN-TEST SECTION.
            COPY "STEST.SR".
CLNUP1*STEST-errorfil-sr-46.
CLNUP1*     MOVE "   m2235.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 "   m2235.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 "   m2235.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-m2235-cbl-708.
            MOVE "   m2235.cbl               708" TO STEST-KEY.
            MOVE SPECS-1 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(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 (SPECS-1).
            MOVE 70 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "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 (FROM-DATE).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FROM-DATE" 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 (TO-DATE).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "TO-DATE" 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 (PIECE-WK-CNT).
            MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PIECE-WK-CNT" 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 (HOURLY-WK-CNT).
            MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HOURLY-WK-CNT" 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).
            MOVE FLEN OF STEST-SPECS (5) 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.
       STEST-m2235-cbl-715.
            MOVE "   m2235.cbl               715" TO STEST-KEY.
            MOVE SPECS-1 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(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 (SPECS-1).
            MOVE 28 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "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 (FROM-DATE).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FROM-DATE" 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 (TO-DATE).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "TO-DATE" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m2235-cbl-727.
            MOVE "   m2235.cbl               727" TO STEST-KEY.
            MOVE ORDER-SPECS-1 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(ORDER-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 (ORDER-SPECS-1).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "ORDER-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 (ORDER-CODES).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "ORDER-CODES" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m2235-cbl-738.
            MOVE "   m2235.cbl               738" 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-m2235-cbl-760.
            MOVE "   m2235.cbl               760" 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-KEY).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "LOW-KEY" 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-KEY).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HIGH-KEY" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m2235-cbl-767.
            MOVE "   m2235.cbl               767" 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-DEPT).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "LOW-DEPT" 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-DEPT).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "HIGH-DEPT" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m2235-cbl-794.
            MOVE "   m2235.cbl               794" TO STEST-KEY.
            MOVE ACTIVE-SPECS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(ACTIVE-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 (ACTIVE-SPECS).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "ACTIVE-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 (STATUS-TYPES).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "STATUS-TYPES" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m2235-cbl-1100.
            MOVE "   m2235.cbl              1100" 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.
080600*END-OF-PROGRAM*
