000100 IDENTIFICATION DIVISION. 
000200 PROGRAM-ID.    M0300 IS INITIAL.
000300 AUTHOR.        MJD                 . 
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION. 
           COPY "EXCEL.CS".
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
000800*REMARKS. 
000900***************************************************************** 
001000* 
001100* M0300 - Salesman Master File Maintenance
001200* VERSION 4.00
040590*  UPD  KWS  - CHANGED SLSMN TO 3 DIGIT COMP-3                  *
040192*  UPD  BOB  - COMM PCT BY 5 PRICING LEVELS                     *
011998* MOD KWS V2.7 - INDMETAL - 1.6.3 IF X0, SHOW X1-X9 AS ONE TOTAL*
011998* UPD KWS V2.7 - ADD GROSS PROFIT %                             *
032098* UPD BOB V2.7 - ADD COMM PAY A/P OR P/R CHECK LOGIC            *
032899* UPD KWS V2.8 - Y2K DATE CHANGES                                *
040100* MOD KWS V2.8C- REDEFINE FIELD TO GET GL-DEPT FOR EACH SLSMN    *
122100* MOD BOB V2.9 - ADD LAST-YEAR FIELDS                            *
122002* FIX KWS V2.9A- INIT SLSMN-COMM-PAY-NUMBER, HAD LOW-VALUES      *
030604* UPD SKI V4.0 - MIGRATE SALESMAN NUMBER FROM COMP-3             *
052804* UPD KWS      - INIT NEW PENDING FIELDS                         *
021509* UPD KWS V4.4.2- LIBERTYU - ADD TERRITORY FIELD USING FILLER    *
071510* UPD KWS V4.5.1- CLEAR COMMISSION FILE IF SLSMN DELETED         *
080111* UPD KWS V4.5.3- COMMIS-OPT NOT BEING SAVED WHEN CHANGED        *
001400****************************************************************** 
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700     COPY "SALEF.SL". 
001800     COPY "SHSTF.SL". 
001900     COPY "CNTLF.SL". 
002000     COPY "USERF.SL".
071510     COPY "COMMF.SL". 
           COPY "STEST.SL".
002100
002200 DATA DIVISION. 
       BASED-STORAGE SECTION.
           COPY "STEST.BS".
002300 FILE SECTION.
002400     COPY "SALEF.FD". 
002500     COPY "SHSTF.FD". 
002600     COPY "CNTLF.FD". 
002700     COPY "USERF.FD". 
071510     COPY "COMMF.FD". 
           COPY "STEST.FD".
002800
002900
003000 WORKING-STORAGE SECTION. 
CVT    01  PROG-NAME    PIC X(6) VALUE    "M0300".                      
003300 
003400 01  SCRN-1.
003500     05  SCRN-1-01        PIC X(80) VALUE "Salesman Number        
003600-    "                                                         ". 
003700     05  SCRN-1-02        PIC X(80) VALUE "                       
003800-    "                                                         ". 
003900     05  SCRN-1-03        PIC X(80) VALUE "Name                   
004000-    "                                                         ". 
004100     05  SCRN-1-04        PIC X(80) VALUE "Commission Percentage  
040192-    "  Level 1   Level 2   Level 3   Level 4   Level 5        ". 
004300     05  SCRN-1-05        PIC X(80) VALUE "                       
004400-    "                                                         ". 
004500     05  SCRN-1-06        PIC X(80) VALUE "                       
004600-    "                                                         ". 
004700     05  SCRN-1-07        PIC X(80) VALUE "                       
122100-    "           Current    Year-to-Date     Last Year         ". 
004900     05  SCRN-1-08        PIC X(80) VALUE "                   Orde
005000-    "rs                                                       ". 
005100     05  SCRN-1-09        PIC X(80) VALUE "                   Sale
005200-    "s                                                        ". 
005300     05  SCRN-1-10        PIC X(80) VALUE "                   Cost
005400-    "                                                         ". 
005500     05  SCRN-1-11        PIC X(80) VALUE "                   Comm
005600-    "issions                                                  ". 
011998     05  SCRN-1-12        PIC X(80) VALUE "                   Marg
021509*    "in %                                                     ". 
021509-    "in %                                 Territory           ". 
032098     05  SCRN-1-13        PIC X(80) VALUE "                   Comm
032098-    "ission paid thru                     Empl/Vend#          ". 
005700
005800 01  INPUT-SPECS-1. 
030604*    05  FILLER      PIC X(14)  VALUE "0318P02030E   ". 
030604     05  FILLER      PIC X(14)  VALUE "0318D03030E   ". 
006000
006100 01  SPECS-1 REDEFINES INPUT-SPECS-1. 
006200     05  SPEC-1 OCCURS 1 TIMES. 
006300         10  ROW         PIC 99.
006400         10  COL         PIC 99.
006500         10  TYP         PIC X. 
006600         10  FLEN        PIC 99.
006700         10  SLEN        PIC 99.
006800         10  OPTION      PIC 9. 
006900         10  ATTR1       PIC XX.
007000         10  ATTR2       PIC XX.
007100
007200 01  INPUT-SPECS-2. 
007300     05  FILLER      PIC X(14)  VALUE "0507X25250    ". 
040192     05  FILLER      PIC X(14)  VALUE "0728P03052    ". 
040192     05  FILLER      PIC X(14)  VALUE "0738P03052    ". 
040192     05  FILLER      PIC X(14)  VALUE "0748P03052    ". 
040192     05  FILLER      PIC X(14)  VALUE "0758P03052    ". 
040192     05  FILLER      PIC X(14)  VALUE "0768P03052    ". 
007500     05  FILLER      PIC X(14)  VALUE "1038P03050N   ". 
007600     05  FILLER      PIC X(14)  VALUE "1051P04070N   ". 
122100     05  FILLER      PIC X(14)  VALUE "1066P04070N   ".

007700     05  FILLER      PIC X(14)  VALUE "1133P05102N   ". 
007800     05  FILLER      PIC X(14)  VALUE "1146P06122N   ". 
122100     05  FILLER      PIC X(14)  VALUE "1161P06122N   ". 

007900     05  FILLER      PIC X(14)  VALUE "1233P05102N   ". 
008000     05  FILLER      PIC X(14)  VALUE "1246P06122N   ". 
122100     05  FILLER      PIC X(14)  VALUE "1261P06122N   ".

008100     05  FILLER      PIC X(14)  VALUE "1333P05102N   ". 
008200     05  FILLER      PIC X(14)  VALUE "1346P06122N   ". 
122100     05  FILLER      PIC X(14)  VALUE "1361P06122N   ".

021509     05  FILLER      PIC X(14)  VALUE "1472X05050    ".
032098     05  FILLER      PIC X(14)  VALUE "1541O03161    ".
032098     05  FILLER      PIC X(14)  VALUE "1572X08080    ".
008300
008400 01  SPECS-2 REDEFINES INPUT-SPECS-2. 
021509*    05  SPEC-2 OCCURS 20 TIMES.
021509     05  SPEC-2 OCCURS 21 TIMES.
008600         10  ROW         PIC 99.
008700         10  COL         PIC 99.
008800         10  TYP         PIC X. 
008900         10  FLEN        PIC 99.
009000         10  SLEN        PIC 99.
009100         10  OPTION      PIC 9. 
009200         10  ATTR1       PIC XX.
009300         10  ATTR2       PIC XX.
009400
009500     COPY "CONSTANT.DTA". 
009600     COPY "ERROR.DTA".
009700     COPY "SCREEN.DTA". 
009800     COPY "STATUS.DTA". 
009900     COPY "COMMON.HLP". 
010000     COPY "M0300.HLP".
010100
071510     COPY "COMMF.DTA".
010200 77  SALEF-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".
010300 77  SHSTF-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".
010400 77  CNTLF-STATUS        PIC XX.
010500 77  USERF-STATUS        PIC XX.
040590 77  SLSMN-NUMBER-DSP    PIC 999 VALUE ZEROES.
011998 01  WS-SLSMN-NO.
011998     05  FIRST-TWO       PIC 99.
011998     05  LAST-DIGIT      PIC 9.
011998 77  WS-HOLD-FIRST-TWO   PIC 99.
011998 01  WS-HOLD-VARS.
           05  HOLD-CUR-ORDERS     PIC S9(5)    VALUE ZERO.
           05  HOLD-YTD-ORDERS     PIC S9(7)    VALUE ZERO.
           05  HOLD-CUR-DOL        PIC S9(7)V99 VALUE ZERO.
           05  HOLD-YTD-DOL        PIC S9(9)V99 VALUE ZERO.
           05  HOLD-CUR-COST       PIC S9(7)V99 VALUE ZERO.
           05  HOLD-YTD-COST       PIC S9(9)V99 VALUE ZERO.
           05  HOLD-CUR-COMM       PIC S9(7)V99 VALUE ZERO.
           05  HOLD-YTD-COMM       PIC S9(9)V99 VALUE ZERO.
010600 01  OK-FLAG                 PIC 9. 
010700     88  OK           VALUE 1.
010800     88  NOT-OK       VALUE 2.
010900 01  DELETE-FLAG             PIC 9. 
011000     88  DELETED      VALUE 1.
011100     88  NOT-DELETED  VALUE 2.
011200 01  MAINT-INQ-FLAG      PIC X. 
011300     88  MAINTENANCE     VALUE "M". 
011400     88  INQUIRY         VALUE "I". 
011700
040590 01  DEL-SLSMN-NO             PIC 999. 
011900 01  DELETED-TOTALS.
012000     05  DEL-CUR-ORDERS       PIC S9(5)           COMP-3. 
012100     05  DEL-YTD-ORDERS       PIC S9(7)           COMP-3. 
012200     05  DEL-CUR-DOL          PIC S9(7)V99        COMP-3. 
012300     05  DEL-YTD-DOL          PIC S9(9)V99        COMP-3. 
012400     05  DEL-CUR-COST         PIC S9(9)V99        COMP-3. 
012500     05  DEL-YTD-COST         PIC S9(9)V99        COMP-3. 
012600     05  DEL-CUR-COMM         PIC S9(7)V99        COMP-3. 
012700     05  DEL-YTD-COMM         PIC S9(9)V99        COMP-3. 
012800 01  DELETED-HIST-TOTALS. 
012900     05  DEL-SHST-SALES  PIC S9(7)  COMP-3  OCCURS 24 TIMES.
013000 01  NO-FIND-MSG PIC X(30) VALUE "This salesman does not exist.". 
013100 01  ADD-QUESTION PIC X(25) VALUE "Do you wish to add it?". 
013200 01  DELETE-QUESTION PIC X(41)
013300     VALUE "Are you sure you want to delete this one?". 
013400 01  INQ-MSG       PIC X(25) VALUE " Press ENTER when ready. ". 
019700 01  DUP-MSG PIC X(55) VALUE
019800     " Salesman already exists, please re-enter information. ". 
040590 01  HOLD-SLSMN-NO           PIC 9(3).
016200 77  SRCH-NONE PIC X(52)
016300     VALUE " No salesmen exist with this number, please retry. ". 
016400 77  SRCH-ROW    PIC 99.
016400 77  SRCH-COL    PIC 99.
016400 77  SRCH-COL2   PIC 99.
040192 77  PCT1                    PIC 9(3)V9(2)   COMP-3. 
040192 77  PCT2                    PIC 9(3)V9(2)   COMP-3. 
040192 77  PCT3                    PIC 9(3)V9(2)   COMP-3. 
040192 77  PCT4                    PIC 9(3)V9(2)   COMP-3. 
040192 77  PCT5                    PIC 9(3)V9(2)   COMP-3. 
011998 77  WS-GP-PCT               PIC S9(3)V99 VALUE ZERO.
011998 77  PR-GP-PCT               PIC -ZZZ.99  VALUE ZERO.
011998 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
011998     88 INDMETALS           VALUE 00138.
040100     88 PIERCE              VALUE 00181.
032098 01  COMMIS-OPTS.
032098     05 FILLER PIC X(16) VALUE "Do not generate ".
032098     05 FILLER PIC X(16) VALUE "Accounts Payable".
032098     05 FILLER PIC X(16) VALUE "Payroll         ".
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  SALEF--NAME PIC X(15) VALUE "SALESMAN.FIL" .
CLNUP1 77  SALEF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  SHSTF--NAME PIC X(15) VALUE "SALEHIST.FIL" .
CLNUP1 77  SHSTF-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                         
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-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.
       01 SCR-m0300-cbl-251-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 3
             COLUMN 40 SIZE IS 40.
       01 SCR-m0300-cbl-259-23 VALUE IS "Record inuse, Please try later!
      -     "" CONTROL DSPL--CONTROL LINE 21.
       01 SCR-m0300-cbl-262-24 PIC IS X(30) FROM NO-FIND-MSG CONTROL 
            DSPL--CONTROL LINE 3 COLUMN 40.
       01 SCR-m0300-cbl-298-23 PIC IS X(7) FROM PR-GP-PCT CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 36.
       01 SCR-m0300-cbl-304-23 PIC IS X(7) FROM PR-GP-PCT CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 51.
       01 SCR-m0300-cbl-349-24 PIC IS X(52) FROM SRCH-NONE CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-m0300-cbl-350-25 VALUE IS "Existing Salesmen" CONTROL 
            DSPL--CONTROL LINE 8 COLUMN 31.
       01 SCR-m0300-cbl-351-20 VALUE IS "Ä" CONTROL DSPL--CONTROL LINE 9
             COLUMN 1 SIZE IS 80.
       01 SCR-m0300-cbl-351-51 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 10 COLUMN 1.
       01 SCR-m0300-cbl-352-16 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 11 COLUMN 1.
       01 SCR-m0300-cbl-352-32 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 12 COLUMN 1.
       01 SCR-m0300-cbl-352-48 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 13 COLUMN 1.
       01 SCR-m0300-cbl-353-16 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 14 COLUMN 1.
       01 SCR-m0300-cbl-353-32 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 15 COLUMN 1.
       01 SCR-m0300-cbl-353-48 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 16 COLUMN 1.
       01 SCR-m0300-cbl-354-16 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 17 COLUMN 1.
       01 SCR-m0300-cbl-354-32 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 18 COLUMN 1.
       01 SCR-m0300-cbl-354-48 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 19 COLUMN 1.
       01 SCR-m0300-cbl-371-24 PIC IS X(3) FROM SLSMN-NUMBER-DSP CONTROL
             DSPL--CONTROL LINE SRCH-ROW COLUMN SRCH-COL.
       01 SCR-m0300-cbl-372-24 PIC IS X(25) FROM SLSMN-NAME CONTROL 
            DSPL--CONTROL LINE SRCH-ROW COLUMN SRCH-COL2.
       01 SCR-m0300-cbl-388-20 PIC IS X(25) FROM ADD-QUESTION CONTROL 
            DSPL--CONTROL LINE 4 COLUMN 40.
       01 SCR-m0300-cbl-397-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 3
             COLUMN 40 SIZE IS 40.
       01 SCR-m0300-cbl-398-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 4
             COLUMN 40 SIZE IS 40.
       01 SCR-m0300-cbl-401-20 PIC IS X(41) FROM DELETE-QUESTION CONTROL
             DSPL--CONTROL LINE 21 COLUMN 15.
       01 SCR-m0300-cbl-478-20 PIC IS X(25) FROM INQ-MSG CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
       01 SCR-m0300-cbl-491-20 PIC IS X(80) FROM SCRN-1-01 CONTROL 
            DSPL--CONTROL LINE 3.
       01 SCR-m0300-cbl-493-24 PIC IS X(55) FROM DUP-MSG CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-m0300-cbl-498-20 PIC IS X(80) FROM SCRN-1-02 CONTROL 
            DSPL--CONTROL LINE 4.
       01 SCR-m0300-cbl-498-38 PIC IS X(80) FROM SCRN-1-03 CONTROL 
            DSPL--CONTROL LINE 5 COLUMN 1.
       01 SCR-m0300-cbl-498-49 PIC IS X(80) FROM SCRN-1-04 CONTROL 
            DSPL--CONTROL LINE 6 COLUMN 1.
       01 SCR-m0300-cbl-498-60 PIC IS X(80) FROM SCRN-1-05 CONTROL 
            DSPL--CONTROL LINE 7 COLUMN 1.
       01 SCR-m0300-cbl-499-14 PIC IS X(80) FROM SCRN-1-06 CONTROL 
            DSPL--CONTROL LINE 8 COLUMN 1.
       01 SCR-m0300-cbl-499-25 PIC IS X(80) FROM SCRN-1-07 CONTROL 
            DSPL--CONTROL LINE 9 COLUMN 1.
       01 SCR-m0300-cbl-499-36 PIC IS X(80) FROM SCRN-1-08 CONTROL 
            DSPL--CONTROL LINE 10 COLUMN 1.
       01 SCR-m0300-cbl-499-47 PIC IS X(80) FROM SCRN-1-09 CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 1.
       01 SCR-m0300-cbl-499-58 PIC IS X(80) FROM SCRN-1-10 CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 1.
       01 SCR-m0300-cbl-500-14 PIC IS X(80) FROM SCRN-1-11 CONTROL 
            DSPL--CONTROL LINE 13 COLUMN 1.
       01 SCR-m0300-cbl-500-25 PIC IS X(80) FROM SCRN-1-12 CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 1.
       01 SCR-m0300-cbl-500-36 PIC IS X(80) FROM SCRN-1-13 CONTROL 
            DSPL--CONTROL LINE 15 COLUMN 1.
       01 SCR-m0300-cbl-500-47 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 16 COLUMN 1.
       01 SCR-m0300-cbl-501-14 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 17 COLUMN 1.
       01 SCR-m0300-cbl-501-30 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 18 COLUMN 1.
       01 SCR-m0300-cbl-501-46 VALUE IS " " CONTROL DSPL--CONTROL 
            SIZE IS 80 LINE 19 COLUMN 1.
013600
013700 PROCEDURE DIVISION.
013800 DECLARATIVES.
013900     COPY "CNTLF.DS". 
014000     COPY "USERF.DS". 
014100     COPY "SALEF.DS". 
014200     COPY "SHSTF.DS". 
071510     COPY "COMMF.DS". 
014300
014400     GO TO STATUS-EXIT. 
014500
014600     COPY "ERRORFIL.SR".
014700 STATUS-EXIT. EXIT. 
014800 END DECLARATIVES.
014900
015000 MAIN-PROG SECTION. 
015100 OPEN-FILES.
071510     MOVE "SALECOMM.FIL" TO COMMF--NAME.
           PERFORM USERF-FILL-FULLPATH.
015200     PERFORM PGM-INIT.
040100     IF USER-SN = 00138 OR 00181
011998        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
011998     IF WS-CUSTOMIZED-FLAG NOT = ZERO
011998        MOVE "M0300M" TO PROG-NAME.
021509*    IF PIERCE
021509*       INSPECT SCRN-1-13 REPLACING FIRST "Empl/Vend#" BY
021509*                                         "Sales GL #"
021509*       MOVE "1572D07070    " TO SPEC-2(20).
015300     PERFORM    OPEN-SALEF. 
015400     IF MAINTENANCE
071510        PERFORM OPEN-COMMF 
015500         IF EXT-SLSMN-SALES 
015600             PERFORM OPEN-SHSTF.
011998     IF NOT USER-SHOW-GP-YES
011998        MOVE SPACES TO SCRN-1-12.
015700 BEGIN-RUN. 
DEBUG      ACCEPT DATE-ACCP FROM DATE.
015800     PERFORM SLSMN-MAINT
015900         UNTIL FLAG = 2 OR FLAG = 4.
016000
016100 END-RUN. 
016200     PERFORM CLOSE-FILES. 
016300     IF FLAG = 2
016400         MOVE "M0310" TO NEXT-PROG. 
016500 EXIT-RUN.
016600     COPY "FINISH.SR".
016700
016800     COPY "CONTROL.SR". 
071189     COPY "CLRUSERF.SR".
016900
017000 SLSMN-MAINT SECTION. 
017100 SLSMN-MAINT-START. 
017200     PERFORM SCREEN-INIT. 
017300     PERFORM DISPLAY-SCREEN-1.
017400 SLSMN-MAINT-LOOP.
017500     IF MAINTENANCE 
017600         UNLOCK SALEF 
017700         IF EXT-SLSMN-SALES 
017800             UNLOCK SHSTF.
100794     DISPLAY SCR-m0300-cbl-251-20   . 
017900     PERFORM ACCEPT-DATA-1. 
018000     IF FLAG = 4 OR FLAG = 2 GO TO SLSMN-MAINT-EXIT.
028800     IF FLAG = 10 
028800         PERFORM SLSMN-SEARCH 
028800         GO TO SLSMN-MAINT-LOOP.
018100     PERFORM    READ-SALEF. 
           IF SALEF-STATUS = RECORD-LOCK
              DISPLAY SCR-m0300-cbl-259-23 
              GO TO SLSMN-MAINT-LOOP.
018200     IF SALEF-STATUS = NOT-FOUND
018300         DISPLAY SCR-m0300-cbl-262-24   
018400         IF INQUIRY 
018500             GO TO SLSMN-MAINT-LOOP 
018600         ELSE PERFORM ADD-CHECK 
018700             IF NOT-OK OR FLAG = 3
018800                 GO TO SLSMN-MAINT-EXIT 
018900             ELSE PERFORM INIT-SLSMN. 
011998     IF LAST-OPTION = 010603 AND INDMETALS
011998        MOVE SLSMN-NUMBER TO SLSMN-NUMBER-DSP
              MOVE SLSMN-NUMBER-DSP TO WS-SLSMN-NO
              IF LAST-DIGIT = ZERO
011998           MOVE FIRST-TWO    TO WS-HOLD-FIRST-TWO
011998           MOVE SLSMN-CUR-ORDERS TO HOLD-CUR-ORDERS
011998           MOVE SLSMN-YTD-ORDERS TO HOLD-YTD-ORDERS
011998           MOVE SLSMN-CUR-DOL    TO HOLD-CUR-DOL
011598           MOVE SLSMN-YTD-DOL    TO HOLD-YTD-DOL
011998           MOVE SLSMN-CUR-COST   TO HOLD-CUR-COST
011998           MOVE SLSMN-YTD-COST   TO HOLD-YTD-COST
011998           MOVE SLSMN-CUR-COMM   TO HOLD-CUR-COMM
011998           MOVE SLSMN-YTD-COMM   TO HOLD-YTD-COMM
                 PERFORM READ-SALEF-NEXT
011998           PERFORM ADD-LOOP THRU ADD-LOOP-EXIT
                 STRING "Salesman No "  DELIMITED BY SIZE
                        WS-HOLD-FIRST-TWO DELIMITED BY SIZE
                        "0 Thru "         DELIMITED BY SIZE
                        WS-HOLD-FIRST-TWO DELIMITED BY SIZE
                        "9.     "         DELIMITED BY SIZE
                        INTO SLSMN-NAME.

019000     PERFORM MOVE-VARS-TO-FIELDS. 
019100     PERFORM DISPLAY-SCREEN-2.
011998     COMPUTE WS-GP-PCT ROUNDED =
011998        ((SLSMN-CUR-DOL   - SLSMN-CUR-COST) /
011998          SLSMN-CUR-DOL) * 100.00000 ON SIZE ERROR MOVE ZERO TO 
                WS-GP-PCT END-COMPUTE.
011998     MOVE WS-GP-PCT TO PR-GP-PCT.
011998     IF USER-SHOW-GP-YES
011998        DISPLAY SCR-m0300-cbl-298-23  .
011998     COMPUTE WS-GP-PCT ROUNDED =
011998        ((SLSMN-YTD-DOL   - SLSMN-YTD-COST) /
011998          SLSMN-YTD-DOL) * 100.00000 ON SIZE ERROR MOVE ZERO TO 
                WS-GP-PCT END-COMPUTE.
011998     MOVE WS-GP-PCT TO PR-GP-PCT.
011998     IF USER-SHOW-GP-YES
011998        DISPLAY SCR-m0300-cbl-304-23  .
019200     PERFORM ACCEPT-DATA-2. 
019300     IF MAINTENANCE 
019400         IF FLAG NOT = 3 AND NOT DELETED
019500             PERFORM MOVE-FIELDS-TO-VARS
019600             IF SALEF-STATUS = NOT-FOUND
019700                 PERFORM WRITE-SALEF
019800             ELSE PERFORM REWRITE-SALEF.
019900
020000 SLSMN-MAINT-EXIT. EXIT.
011998 ADD-LOOP SECTION.
011998 ADD-LOOP-BEGIN.
011998     MOVE SLSMN-NUMBER TO SLSMN-NUMBER-DSP.
           MOVE SLSMN-NUMBER-DSP TO WS-SLSMN-NO.
           IF FIRST-TWO = WS-HOLD-FIRST-TWO AND
              NOT C-AT-END OF SALEF-STATUS
011998        ADD SLSMN-CUR-ORDERS TO HOLD-CUR-ORDERS
011998        ADD SLSMN-YTD-ORDERS TO HOLD-YTD-ORDERS
011998        ADD SLSMN-CUR-DOL    TO HOLD-CUR-DOL
011598        ADD SLSMN-YTD-DOL    TO HOLD-YTD-DOL
011998        ADD SLSMN-CUR-COST   TO HOLD-CUR-COST
011998        ADD SLSMN-YTD-COST   TO HOLD-YTD-COST
011998        ADD SLSMN-CUR-COMM   TO HOLD-CUR-COMM
011998        ADD SLSMN-YTD-COMM   TO HOLD-YTD-COMM
              PERFORM READ-SALEF-NEXT
              GO TO ADD-LOOP-BEGIN
           ELSE
              MOVE 0 TO LAST-DIGIT
              MOVE WS-HOLD-FIRST-TWO TO FIRST-TWO
              PERFORM READ-SALEF
011998        MOVE HOLD-CUR-ORDERS TO SLSMN-CUR-ORDERS
011998        MOVE HOLD-YTD-ORDERS TO SLSMN-YTD-ORDERS
011998        MOVE HOLD-CUR-DOL    TO SLSMN-CUR-DOL
011598        MOVE HOLD-YTD-DOL    TO SLSMN-YTD-DOL
011998        MOVE HOLD-CUR-COST   TO SLSMN-CUR-COST
011998        MOVE HOLD-YTD-COST   TO SLSMN-YTD-COST
011998        MOVE HOLD-CUR-COMM   TO SLSMN-CUR-COMM
011998        MOVE HOLD-YTD-COMM   TO SLSMN-YTD-COMM.

011998 ADD-LOOP-EXIT. EXIT.
020000
031500 SLSMN-SEARCH SECTION.
031600 SLSMN-SEARCH-START.
033200     PERFORM START-SALEF. 
033300     IF C-AT-END OF SALEF-STATUS 
033400         DISPLAY SCR-m0300-cbl-349-24  
033500     ELSE 
            DISPLAY SCR-m0300-cbl-350-25
            DISPLAY SCR-m0300-cbl-351-20
            DISPLAY SCR-m0300-cbl-351-51
            DISPLAY SCR-m0300-cbl-352-16
            DISPLAY SCR-m0300-cbl-352-32
            DISPLAY SCR-m0300-cbl-352-48
            DISPLAY SCR-m0300-cbl-353-16
            DISPLAY SCR-m0300-cbl-353-32
            DISPLAY SCR-m0300-cbl-353-48
            DISPLAY SCR-m0300-cbl-354-16
            DISPLAY SCR-m0300-cbl-354-32
            DISPLAY SCR-m0300-cbl-354-48 
033700         PERFORM PAGE-SLSMN.
025600     MOVE 0 TO SLSMN-NUMBER.
032600     GO TO SLSMN-SEARCH-EXIT. 
033800
033900 PAGE-SLSMN.
034200     PERFORM PAGE-LOOP
034300       VARYING SRCH-COL FROM 1 BY 40
034300         UNTIL SRCH-COL > 41 OR C-AT-END OF SALEF-STATUS 
034300       AFTER SRCH-ROW FROM 10 BY 1
034300         UNTIL SRCH-ROW > 19 OR C-AT-END OF SALEF-STATUS.
034500
034600 PAGE-LOOP. 
034800     PERFORM READ-SALEF-NEXT. 
034900     IF NOT C-AT-END OF SALEF-STATUS 
040590         COMPUTE SRCH-COL2 = SRCH-COL + 4 
040590         MOVE SLSMN-NUMBER TO SLSMN-NUMBER-DSP
040590         
            DISPLAY SCR-m0300-cbl-371-24
            DISPLAY SCR-m0300-cbl-372-24. 
035300
035400 SLSMN-SEARCH-EXIT. EXIT. 
020100
020200 SUBROUTINE SECTION.
020300
020400 PGM-INIT.
020500     PERFORM CONTROL-INIT.
071189     PERFORM CLR-CHN-USERF.
020700     IF LAST-OPTION = 010103
020800         MOVE "M" TO MAINT-INQ-FLAG 
020900     ELSE MOVE "I" TO MAINT-INQ-FLAG. 
021000
081894     COPY "SCRNINIT.SR". 
021500
021600 ADD-CHECK. 
021700     DISPLAY SCR-m0300-cbl-388-20  . 
021800     MOVE 4 TO ROW OF YES-NO-SPEC.
021900     MOVE 70 TO COL OF YES-NO-SPEC. 
022000     MOVE 2 TO OPTION OF YES-NO-SPEC. 
022100     MOVE 0 TO FLAG.
022200     MOVE "1010000000" TO FKEYS.
           PERFORM STEST-m0300-cbl-394
022300     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, ADD-HELP,
022400       YES-NO
           PERFORM STEST-AFTER-CALL.
022500     MOVE OPTION OF YES-NO-SPEC TO OK-FLAG. 
022600     
            DISPLAY SCR-m0300-cbl-397-20
            DISPLAY SCR-m0300-cbl-398-20. 
022800
022900 DELETE-CHECK.
023000     DISPLAY SCR-m0300-cbl-401-20  . 
023100     MOVE 21 TO ROW OF YES-NO-SPEC. 
023200     MOVE 60 TO COL OF YES-NO-SPEC. 
023300     MOVE 2 TO OPTION OF YES-NO-SPEC. 
023400     MOVE 0 TO FLAG.
023500     MOVE "1010000000" TO FKEYS.
           PERFORM STEST-m0300-cbl-407
023600     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, 
            DELETE-HELP,                                                
023700       YES-NO
           PERFORM STEST-AFTER-CALL.
023800     IF FLAG = 3 MOVE 2 TO OPTION OF YES-NO-SPEC. 
023900     MOVE OPTION OF YES-NO-SPEC TO DELETE-FLAG. 
024000     IF DELETED AND SALEF-STATUS NOT = NOT-FOUND
024100         PERFORM DELETE-RECORDS.
024200
024300 INIT-SLSMN.
024400     MOVE SPACES TO SLSMN-NAME. 
024500     MOVE 0 TO SLSMN-COMM-PCT, SLSMN-CUR-ORDERS, SLSMN-YTD-ORDERS,
024600       SLSMN-CUR-DOL, SLSMN-YTD-DOL, SLSMN-CUR-COST,
024700       SLSMN-YTD-COST, SLSMN-CUR-COMM, SLSMN-YTD-COMM.
122002     MOVE SPACES TO SLSMN-COMM-PAY-NUMBER.
052804     MOVE ZERO TO SLSMN-PEND-ORDERS, SLSMN-PEND-DOL,
052804        SLSMN-PEND-COST, SLSMN-PEND-COMM.
021509     MOVE SPACES TO SLSMN-TERRITORY.
024800
024900 MOVE-VARS-TO-FIELDS. 
040192     MOVE SLSMN-COMMISSION-PCT(1) TO PCT1.
040192     MOVE SLSMN-COMMISSION-PCT(2) TO PCT2.
040192     MOVE SLSMN-COMMISSION-PCT(3) TO PCT3.
040192     MOVE SLSMN-COMMISSION-PCT(4) TO PCT4.
040192     MOVE SLSMN-COMMISSION-PCT(5) TO PCT5.
032098     IF SLSMN-COMM-PAY-TYPE < 1 OR SLSMN-COMM-PAY-TYPE > 3
032098        MOVE 1 TO SLSMN-COMM-PAY-TYPE.
021509*    MOVE SLSMN-COMM-PAY-TYPE TO OPTION OF SPEC-2(19).
021509     MOVE SLSMN-COMM-PAY-TYPE TO OPTION OF SPEC-2(20).
025000
025100 MOVE-FIELDS-TO-VARS. 
040192     MOVE PCT1 TO SLSMN-COMMISSION-PCT(1).
040192     MOVE PCT2 TO SLSMN-COMMISSION-PCT(2).
040192     MOVE PCT3 TO SLSMN-COMMISSION-PCT(3).
040192     MOVE PCT4 TO SLSMN-COMMISSION-PCT(4).
040192     MOVE PCT5 TO SLSMN-COMMISSION-PCT(5).
021509*    MOVE OPTION OF SPEC-2(19) TO SLSMN-COMM-PAY-TYPE.
021509     MOVE OPTION OF SPEC-2(20) TO SLSMN-COMM-PAY-TYPE.
025200
025300 END-SUBROUTINE-EXIT. EXIT. 
025400
025500 ACCEPT-DATA-1 SECTION. 
025600 ACCEPT-1.
025800     MOVE 0 TO FLAG.
025900     MOVE "1101000001" TO FKEYS.
           PERFORM STEST-m0300-cbl-447
026000     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP1, 
026100       SLSMN-NUMBER
           PERFORM STEST-AFTER-CALL.
026200 ACCEPT-DATA-1-EXIT. EXIT.
026300
026400 ACCEPT-DATA-2 SECTION. 
026500 ACCEPT-2.
026600     IF MAINTENANCE 
026700         MOVE 0 TO FLAG 
026800     ELSE MOVE 1 TO FLAG. 
026900     MOVE "1010000100" TO FKEYS.
080111*    PERFORM STEST-m0300-cbl-457.
021509*    CALL "SCRN20" USING FLAG, FKEYS, SPECS-2, HELP2, 
021509     CALL "SCRN21" USING FLAG, FKEYS, SPECS-2, HELP2, 
             SLSMN-NAME,                                                 
040192       PCT1, PCT2, PCT3, PCT4, PCT5,
122100       SLSMN-CUR-ORDERS, SLSMN-YTD-ORDERS, SLSMN-LYR-ORDERS,
122100       SLSMN-CUR-DOL, SLSMN-YTD-DOL, SLSMN-LYR-DOL,
122100       SLSMN-CUR-COST, SLSMN-YTD-COST, SLSMN-LYR-COST,
122100       SLSMN-CUR-COMM, SLSMN-YTD-COMM, SLSMN-LYR-COMM,
021509       SLSMN-TERRITORY,
032098       COMMIS-OPTS, SLSMN-COMM-PAY-NUMBER.
080111*    PERFORM STEST-AFTER-CALL.
027400     IF INQUIRY 
027500         PERFORM ACCEPT-DATA-2-INQ
027600         GO TO ACCEPT-DATA-2-EXIT.
027700     IF FLAG = 3 GO TO ACCEPT-DATA-2-EXIT.
027800     IF FLAG = 8 AND SLSMN-NUMBER NOT = 0 
027900         PERFORM DELETE-CHECK 
028000         IF DELETED 
028100             GO TO ACCEPT-DATA-2-EXIT 
028200         ELSE GO TO ACCEPT-DATA-2 
028300     ELSE MOVE 2 TO DELETE-FLAG.
028400 ACCEPT-DATA-2-EXIT. EXIT.
028500
028600 ACCEPT-DATA-2-INQ SECTION. 
028700 ACCEPT-2-INQ.
028800     DISPLAY SCR-m0300-cbl-478-20   .
028900     MOVE 21 TO ROW OF YES-NO-SPEC. 
029000     MOVE 40 TO COL OF YES-NO-SPEC. 
029100     MOVE "IE" TO ATTR1 OF YES-NO-SPEC. 
029200     MOVE 0 TO FLAG.
029300     MOVE "1010000000" TO FKEYS.
           PERFORM STEST-m0300-cbl-484
029400     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, INQ-HELP,
029500       YES-NO
           PERFORM STEST-AFTER-CALL.
029600     MOVE "  " TO ATTR1 OF YES-NO-SPEC. 
029700 ACCEPT-DATA-2-INQ-EXIT. EXIT.
029800
029900 DISPLAY-SCREENS SECTION. 
030000 DISPLAY-SCREEN-1.
030100     DISPLAY SCR-m0300-cbl-491-20 .
045400     IF SALEF-STATUS = DUPLICATE-RECORD 
045400         DISPLAY SCR-m0300-cbl-493-24  
CLNUP1         MOVE FOUND     TO SALEF-STATUS 
045400     ELSE MOVE ZEROES TO SLSMN-NUMBER.
030200
030300 DISPLAY-SCREEN-2.
030400     
            DISPLAY SCR-m0300-cbl-498-20
            DISPLAY SCR-m0300-cbl-498-38
            DISPLAY SCR-m0300-cbl-498-49
            DISPLAY SCR-m0300-cbl-498-60
            DISPLAY SCR-m0300-cbl-499-14
            DISPLAY SCR-m0300-cbl-499-25
            DISPLAY SCR-m0300-cbl-499-36
            DISPLAY SCR-m0300-cbl-499-47
            DISPLAY SCR-m0300-cbl-499-58
            DISPLAY SCR-m0300-cbl-500-14
            DISPLAY SCR-m0300-cbl-500-25
            DISPLAY SCR-m0300-cbl-500-36
            DISPLAY SCR-m0300-cbl-500-47
            DISPLAY SCR-m0300-cbl-501-14
            DISPLAY SCR-m0300-cbl-501-30
            DISPLAY SCR-m0300-cbl-501-46.
030700
030800 DISPLAY-SCREENS-EXIT. EXIT.
030900
031000 DELETE-RECORDS SECTION.
031100 DELETE-RECORDS-START.
031200     MOVE SLSMN-NUMBER TO DEL-SLSMN-NO. 
031300     MOVE SLSMN-CUR-ORDERS TO DEL-CUR-ORDERS. 
031400     MOVE SLSMN-YTD-ORDERS TO DEL-YTD-ORDERS. 
031500     MOVE SLSMN-CUR-DOL TO DEL-CUR-DOL. 
031600     MOVE SLSMN-YTD-DOL TO DEL-YTD-DOL. 
031700     MOVE SLSMN-CUR-COST TO DEL-CUR-COST. 
031800     MOVE SLSMN-YTD-COST TO DEL-YTD-COST. 
031900     MOVE SLSMN-CUR-COMM TO DEL-CUR-COMM. 
032000     MOVE SLSMN-YTD-COMM TO DEL-YTD-COMM. 
071510     MOVE SLSMN-NUMBER   TO  COMM-SLSMN-NO.
071510     MOVE ZERO           TO  COMM-INV-NO.
071510     PERFORM START-COMMF.
071510     PERFORM WITH TEST BEFORE UNTIL C-AT-END OF COMMF-STATUS
071510        PERFORM READ-COMMF-NEXT
071510        IF COMM-SLSMN-NO = SLSMN-NUMBER
071510           PERFORM DELETE-COMMF
071510        END-IF
071510     END-PERFORM.
032100     PERFORM DELETE-SALEF.
032200     MOVE 0 TO SLSMN-NUMBER.
032300     PERFORM READ-SALEF.
CLNUP1     IF C-RECORD-OK OF SALEF-STATUS
032500         ADD DEL-CUR-ORDERS TO SLSMN-CUR-ORDERS 
032600         ADD DEL-YTD-ORDERS TO SLSMN-YTD-ORDERS 
032700         ADD DEL-CUR-DOL TO SLSMN-CUR-DOL 
032800         ADD DEL-YTD-DOL TO SLSMN-YTD-DOL 
032900         ADD DEL-CUR-COST TO SLSMN-CUR-COST 
033000         ADD DEL-YTD-COST TO SLSMN-YTD-COST 
033100         ADD DEL-CUR-COMM TO SLSMN-CUR-COMM 
033200         ADD DEL-YTD-COMM TO SLSMN-YTD-COMM 
033300         PERFORM REWRITE-SALEF. 
033400     IF EXT-SLSMN-SALES 
033500         MOVE DEL-SLSMN-NO TO SHST-SLSMN-NO 
033600         PERFORM READ-SHSTF 
CLNUP1         IF C-RECORD-OK OF SHSTF-STATUS
033800             PERFORM SAVE-HIST-TOTALS 
033900             MOVE DEL-SLSMN-NO TO SHST-SLSMN-NO 
034000             PERFORM DELETE-SHSTF.

034100     GO TO DELETE-RECORDS-EXIT. 
034200
034300 SAVE-HIST-TOTALS.
034400     PERFORM HOLD-HIST-TOTALS 
034500         VARYING I FROM 1 BY 1 UNTIL I > 24.
034600     MOVE 0 TO SHST-SLSMN-NO. 
034700     PERFORM READ-SHSTF.
CLNUP1     IF C-RECORD-OK OF SHSTF-STATUS
034900         PERFORM ADD-HIST-TOTALS
035000             VARYING I FROM 1 BY 1 UNTIL I > 24 
035100         PERFORM REWRITE-SHSTF
035200     ELSE PERFORM MOVE-HIST-TOTALS
035300             VARYING I FROM 1 BY 1 UNTIL I > 24 
035400         PERFORM WRITE-SHSTF. 
035500
035600 HOLD-HIST-TOTALS.
035700     MOVE SHST-SALES(I) TO DEL-SHST-SALES(I). 
035800
035900 ADD-HIST-TOTALS. 
036000     ADD DEL-SHST-SALES(I) TO SHST-SALES(I).
036100
036200 MOVE-HIST-TOTALS.
036300     MOVE DEL-SHST-SALES(I) TO SHST-SALES(I). 
036400
036500 DELETE-RECORDS-EXIT. EXIT. 
036600
036700 IN-OUT SECTION.
036800
036900 OPEN-SALEF.
037000     IF MAINTENANCE 
037100         OPEN I-O SALEF 
037200     ELSE OPEN INPUT SALEF. 
037300 OPEN-SHSTF.
037400     OPEN I-O SHSTF.
037500
071510 OPEN-COMMF.
037400     OPEN I-O COMMF.
037500
033000 START-SALEF. 
033100     START SALEF KEY NOT < SALEF-KEY
033200         INVALID KEY MOVE AT-END TO SALEF-STATUS. 
071510 START-COMMF. 
071510     START COMMF KEY NOT < COMMF-KEY
071510         INVALID KEY MOVE AT-END TO COMMF-STATUS. 
037600 READ-SALEF.
CLNUP1     SET IO-WAIT-OFF TO TRUE.
037700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      SALEF-STATUS OR IO-WAIT-OFF 
           READ SALEF INVALID KEY 
037800         MOVE NOT-FOUND TO SALEF-STATUS
           END-READ END-PERFORM.
CLNUP1     SET IO-WAIT-ON TO TRUE.
071500 READ-SALEF-NEXT. 
071600     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      SALEF-STATUS OR IO-WAIT-OFF 
           READ SALEF NEXT NO LOCK
071700         AT END MOVE AT-END TO SALEF-STATUS
           END-READ END-PERFORM.
037900 READ-SHSTF.
038000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      SHSTF-STATUS OR IO-WAIT-OFF 
           READ SHSTF INVALID KEY 
038100         MOVE NOT-FOUND TO SHSTF-STATUS
           END-READ END-PERFORM.
071510 READ-COMMF-NEXT. 
071510     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
071510          COMMF-STATUS OR IO-WAIT-OFF 
071510       READ COMMF NEXT NO LOCK
071510            AT END MOVE AT-END TO COMMF-STATUS
071510       END-READ
071510     END-PERFORM.
071510     IF COMM-SLSMN-NO > SLSMN-NUMBER
071510        MOVE AT-END TO COMMF-STATUS.

055000 WRITE-SALEF. 
055100     WRITE SALEF-REC INVALID KEY
055100         MOVE DUPLICATE-RECORD TO SALEF-STATUS. 
038400 WRITE-SHSTF. 
038500     WRITE SHSTF-REC. 
038600 REWRITE-SALEF. 
038700     REWRITE SALEF-REC. 
038800 REWRITE-SHSTF. 
038900     REWRITE SHSTF-REC. 
039000 DELETE-SALEF.
039100     DELETE SALEF 
039200         INVALID KEY MOVE NOT-FOUND TO SALEF-STATUS.
039300 DELETE-SHSTF.
039400     DELETE SHSTF 
039500         INVALID KEY MOVE NOT-FOUND TO SHSTF-STATUS.
039600
071510 DELETE-COMMF.
039400     DELETE COMMF 
039500         INVALID KEY MOVE AT-END TO COMMF-STATUS.
039600
039700 CLOSE-FILES. 
039800     CLOSE SALEF. 
039900     IF MAINTENANCE 
071510        CLOSE COMMF
040000         IF EXT-SLSMN-SALES 
040100             CLOSE SHSTF. 
040200
040300 IN-OUT-EXIT. EXIT. 
       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 SALEF-FILL-FULLPATH.
            PERFORM SHSTF-FILL-FULLPATH.
071510      PERFORM COMMF-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.
       SALEF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO SALEF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" SALEF--NAME 
            DELIMITED BY SPACES INTO SALEF-FULLPATH.
       SHSTF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO SHSTF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" SHSTF--NAME 
            DELIMITED BY SPACES INTO SHSTF-FULLPATH.
071510 COMMF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO COMMF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" COMMF--NAME 
            DELIMITED BY SPACES INTO COMMF-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==.

       SCRN-TEST SECTION.
            COPY "STEST.SR".
CLNUP1*STEST-errorfil-sr-46.
CLNUP1*     MOVE "   m0300.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.
       STEST-m0300-cbl-394.
            MOVE "   m0300.cbl               394" 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.
       STEST-m0300-cbl-407.
            MOVE "   m0300.cbl               407" 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.
       STEST-m0300-cbl-447.
            MOVE "   m0300.cbl               447" 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 14 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 (SLSMN-NUMBER).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-NUMBER" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m0300-cbl-457.
            MOVE "   m0300.cbl               457" TO STEST-KEY.
            MOVE SPECS-2 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(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 (SPECS-2).
            MOVE 280 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "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 (SLSMN-NAME).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-NAME" 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 (PCT1).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PCT1" 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 (PCT2).
            MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PCT2" 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 (PCT3).
            MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PCT3" 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 (PCT4).
            MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PCT4" 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 (PCT5).
            MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PCT5" 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 (SLSMN-CUR-ORDERS).
            MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-CUR-ORDERS" 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 (SLSMN-YTD-ORDERS).
            MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-YTD-ORDERS" 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 (SLSMN-LYR-ORDERS).
            MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-LYR-ORDERS" 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 (SLSMN-CUR-DOL).
            MOVE FLEN OF STEST-SPECS (10) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-CUR-DOL" 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 (SLSMN-YTD-DOL).
            MOVE FLEN OF STEST-SPECS (11) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-YTD-DOL" 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 (SLSMN-LYR-DOL).
            MOVE FLEN OF STEST-SPECS (12) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-LYR-DOL" 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 (SLSMN-CUR-COST).
            MOVE FLEN OF STEST-SPECS (13) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-CUR-COST" 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 (SLSMN-YTD-COST).
            MOVE FLEN OF STEST-SPECS (14) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-YTD-COST" 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 (SLSMN-LYR-COST).
            MOVE FLEN OF STEST-SPECS (15) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-LYR-COST" 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 (SLSMN-CUR-COMM).
            MOVE FLEN OF STEST-SPECS (16) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-CUR-COMM" 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 (SLSMN-YTD-COMM).
            MOVE FLEN OF STEST-SPECS (17) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-YTD-COMM" 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 (SLSMN-LYR-COMM).
            MOVE FLEN OF STEST-SPECS (18) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-LYR-COMM" 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 (COMMIS-OPTS).
            MOVE FLEN OF STEST-SPECS (19) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "COMMIS-OPTS" 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 (SLSMN-COMM-PAY-NUMBER).
            MOVE FLEN OF STEST-SPECS (20) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SLSMN-COMM-PAY-NUMBER" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-m0300-cbl-484.
            MOVE "   m0300.cbl               484" 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.
040400*END-OF-FILE* 
