000100 IDENTIFICATION DIVISION. 
031611 PROGRAM-ID.    S0170 IS INITIAL    . 
000300 AUTHOR.        MJD                 . 
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION. 
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
031611 Repository.
031611 Class COM AS "*COM".
000800*REMARKS. 
000900***************************************************************** 
001000*                                                               *
001100* S0170 - Item Sales Report - LIBERTY UNIFORMS                  * 
001200* VERSION 2.9                                                   *
110305* UPD KWS V3.2 - MOVE FROM V2.9A TO V3.2                        *
031611* UPD KWS V4.5.3- UPGRADE FROM V3.2 TO V4.5 (PRINTING CHANGES)  *
001400*****************************************************************
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700
001800     COPY "ITEMF.SL".   
001900     COPY "CLASF.SL". 
110305*    COPY "TAGMF.SL". 
110305     COPY "TAGKF.SL". 
002100
031611*    COPY "PRNTR.SL".
031611     COPY "LPFPRNTR.SL".
031611     COPY "STEST.SL".
003000     COPY "CNTLF.SL". 
003100     COPY "USERF.SL". 
003200     COPY "SORTF.SL". 
031611*    COPY "MUCTF.SL".
031611     COPY "SCATF.SL".
050692     COPY "STYLF.SL".
003300
003400 DATA DIVISION. 
031611 BASED-STORAGE SECTION.
031611      COPY "STEST.BS".
003500 FILE SECTION.
003600
003700*    PRNTR.FD   PRINT FILE DESCRIPTION. 
003800
031611*FD  LO 
031611*    LABEL RECORDS ARE OMITTED. 
031611*
031611*01  PRINT-REC. 
031611*    03 SCREEN-REC       PIC X(80). 
031611*    03 FILLER           PIC X(52). 
031611     COPY "LPFPRNTR.FD".
004500
004600     COPY "ITEMF.FD". 
004700     COPY "CLASF.FD". 
004800     COPY "TAGMF.FD". 
004900 01  TAGMF-REC. 
101403     05 TAGMF-KEY.
101403         10 TAG-SORT PIC X(14).
101403         10 FILLER REDEFINES TAG-SORT.
101403             15 TAG-SORT-BY-ITEM PIC X(12).
110305             15 FILLER PIC X(2).
101403         10 FILLER REDEFINES TAG-SORT.
101403             15 TAG-SORT-BY-CLASS PIC 99.
101403            15 TAG-SORT-BY-CLASS-ITEM-NUMBER PIC X(12).
101403         10 FILLER REDEFINES TAG-SORT.
101403             15 TAG-SORT-BY-PROFITS PIC S9(9)V99.
110305             15 FILLER PIC X(3).
101403         10 FILLER REDEFINES TAG-SORT.
101403             15 TAG-SORT-BY-SALES PIC S9(9)V99.
110305             15 FILLER PIC X(3).
101403         10 TAG-SEQ-NO PIC 9(9).
002800     05 TAG-DATA       PIC X(12). 

005300     COPY "CNTLF.FD". 
005400     COPY "USERF.FD". 
005500     COPY "SORTF.FD". 
031611*    COPY "MUCTF.FD".
031611     COPY "SCATF.FD".
050692     COPY "STYLF.FD".
031611     COPY "STEST.FD".
005600
005700 WORKING-STORAGE SECTION. 
CVT    01  PROG-NAME    PIC X(6) VALUE    "S0170".                      
005800
005900 01  ITEMF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".
031611 77  ITEMF--NAME PIC X(15) VALUE "ITEM.FIL" .
031611 77  ITEMF-FULLPATH PIC X(35) VALUE SPACES .
006000 01  CLASF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".
031611 77  CLASF--NAME PIC X(15) VALUE "CLASS.FIL" .
031611 77  CLASF-FULLPATH PIC X(35) VALUE SPACES .
006100 01  TAGMF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".
006300 01  LINE-NO             PIC 9(2)  VALUE ZERO.
006400 01  PAGE-NO             PIC 9(4)  VALUE ZERO.
070198 01  PAGE-SIZE           PIC 99    VALUE 55. 
006600 01  SKIP                PIC 9     VALUE 1.
006700 01  LO-STATUS           PIC XX    VALUE SPACES.
006800 01  CNTLF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".
006900 01  USERF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".
007000 01  SORTF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".

031611*01  MUCTF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "SCATF.DTA".

050692 01  STYLF-STATUS        PIC XX    VALUE SPACES.
031611     COPY "FSTATUS88.DTA".
101191 01  STYLE-FILENAME.
101191     05  STYL-DRIVE      PIC X VALUE SPACES.
TP2PF      05  FILLER          PIC X(10) VALUE ":\PROFITS\".
101191     05  STYL-DIRECTORY  PIC X(08) VALUE SPACES.
101191     05  FILLER          PIC X(13) VALUE "\STYLEHDR.FIL".
031611 01  STYLF--NAME    REDEFINES STYLE-FILENAME PIC X(32) .
031611 01  STYLF-FULLPATH REDEFINES STYLE-FILENAME PIC X(32) .

031611*01  MUCTF-KEY           COMP-1    VALUE 1.
031611*01  MUCT-FILENAME.
031611*    05  MUCT-DRIVE      PIC X VALUE SPACES.
031611*    05  FILLER          PIC X(10) VALUE ":\PROFITS\".
031611*    05  MUCT-DIRECTORY  PIC X(08) VALUE SPACES.
031611*    05  FILLER          PIC X(11) VALUE "\MUCNTL.FIL".

007100 01  INDEX-OCCURS        PIC 9(1).
007200 01  INDEX-PERFORM       PIC 9(1) VALUE 1.
007300 01  ESC-FLAG            PIC 9    VALUE ZERO. 
007400 01  LOW-KEY             PIC X(8) VALUE LOW-VALUES. 
007500 01  HIGH-KEY            PIC X(8) VALUE HIGH-VALUES.
010191 77  NUMBER-DECIMALS     PIC 9 VALUE ZERO.
007600
020600 01  SUMM-DETAIL-INFO.
020600     05  SUMM-DETAIL-OPT.
103000         10  FILLER     PIC X(19) VALUE "ITEM SALES REPORT".
103000         10  FILLER     PIC X(19) VALUE "STOCK STATUS REPORT".
020600     05  SPECS-1. 
020600         10  FILLER     PIC X(9)  VALUE "1236O0219".
020600         10  OPTION     PIC 9     VALUE 1.
                   88 ITEM-SALES-REPORT       VALUE 1.
                   88 STOCK-STATUS-REPORT     VALUE 2.
020600         10  FILLER     PIC X(4)  VALUE "E   ". 
020600     05  HELP-1   PIC X(02) VALUE " $". 


007700 01  DISPLAY-MESSAGES.
007800     03 PRINTING-REPORT  PIC X(16) VALUE "Printing Report.".
007900
008000     COPY "CONSTANT.DTA". 
020996     COPY "TAG.DTA".
008100     COPY "SCREEN.DTA". 
008200     COPY "STATUS.DTA". 
008300     COPY "ERROR.DTA".
008400     COPY "ERRORP.DTA". 
031611*    COPY "PRINT.DTA".
031611     COPY "PFPRINT.DTA".
031611     COPY "PAUSE.DTA".
031611     COPY "DATE.DTA".
031611     COPY "STEST.DTA".
008500
008600 01  SYSTEM-TIME. 
008700     03 SYSTEM-HOUR          PIC 99.
008800     03 SYSTEM-MINUTE        PIC 99.
008900     03 SYSTEM-SECONDS       PIC 99.
009000     03 FILLER               PIC 99.
009100
009200 01  PR-HEADER1.
031611*    03 PR-CNDSE         PIC X(9).
009400     03 FILLER           PIC X(7)   VALUE "DATE - ".
052399     03 PR-DATE-11       PIC X(11).
009600     03 FILLER           PIC X(10)  VALUE "   TIME - ". 
009700     03 PR-HOUR          PIC 99.
009800     03 FILLER           PIC X      VALUE ":".
009900     03 PR-MINUTE        PIC 99.
010000     03 FILLER           PIC X      VALUE ":".
010100     03 PR-SECONDS       PIC 99.
010200     03 FILLER           PIC X(10)  VALUE SPACES. 
010300     03 PR-CONAME        PIC X(40)  VALUE SPACES. 
052399     03 FILLER           PIC X(27)  VALUE SPACES. 
010500     03 FILLER           PIC X(5)   VALUE "PAGE ".
010600     03 PR-PAGE-NO       PIC ZZZ9.
010700 01  PR-HEADER1A. 
010800     03 FILLER           PIC X(41) VALUE SPACES.
010900     03 PR-TITLE         PIC X(50). 
011000 01  PR-HEADER1B. 
011100     03 FILLER           PIC X(41) VALUE SPACES.
011200     03 PR-INFO-LINE     PIC X(50). 
011700
011800 01  REPORT-TITLE PIC X(50) 
011900     VALUE "                ITEM SALES REPORT". 
103000 01  REPORT-TITLE-SS PIC X(50) 
011900     VALUE "             STOCK STATUS REPORT". 
012000
012100 01  PR-HEADER2.
012200     03 FILLER            PIC X(11) VALUE "           ".
013300     03 FILLER            PIC X(11) VALUE "           ".
           03 FILLER            PIC X(03) VALUE SPACES.
012300     03 FILLER            PIC X(07) VALUE "       ".
012400     03 FILLER            PIC X(11) VALUE "---- QUANTI".
012500     03 FILLER            PIC X(11) VALUE "TY SOLD ---".
012600     03 FILLER            PIC X(11) VALUE "-       ---".
012700     03 FILLER            PIC X(11) VALUE "------- SAL".
012800     03 FILLER            PIC X(11) VALUE "ES ------- ".
012900     03 FILLER            PIC X(11) VALUE "           ".
013000     03 FILLER            PIC X(11) VALUE "           ".
103000     03 FILLER            PIC X(23) VALUE SPACES.

013400 01  PR-HEADER3.
013500     03 FILLER            PIC X(11) VALUE "STYLE     C".
014600     03 FILLER            PIC X(11) VALUE "ATAGORY   C".
013600     03 FILLER            PIC X(11) VALUE "LR  SIZE   ".
           03 FILLER            PIC X(02) VALUE SPACES.
013700     03 FILLER            PIC X(11) VALUE "CURRENT    ".
013800     03 FILLER            PIC X(11) VALUE "    YTD    ".
021396     03 FILLER            PIC X(11) VALUE "       CURR".
014000     03 FILLER            PIC X(11) VALUE "ENT        ".
014100     03 FILLER            PIC X(11) VALUE " YTD       ".
014200     03 FILLER            PIC X(11) VALUE " AVG PRICE ".
103000     03 FILLER            PIC X(31) VALUE SPACES.
103000 01  PR-HEADER2-SS.
103000     03 FILLER            PIC X(11) VALUE "           ".
103000     03 FILLER            PIC X(11) VALUE "           ".
103000     03 FILLER            PIC X(02) VALUE SPACES.
103000     03 FILLER            PIC X(10) VALUE "          ".
103000     03 FILLER            PIC X(10) VALUE "          ".
103000     03 FILLER            PIC X(10) VALUE "          ".
103000     03 FILLER            PIC X(10) VALUE "          ".
103000     03 FILLER            PIC X(10) VALUE "          ".
103000     03 FILLER            PIC X(10) VALUE "          ".
103000     03 FILLER            PIC X(19) VALUE "          ".
103000     03 FILLER            PIC X(10) VALUE "  REORDER ".
103000     03 FILLER            PIC X(10) VALUE "STATUS    ".

103000 01  PR-HEADER3-SS.
013500     03 FILLER            PIC X(11) VALUE "STYLE     C".
014600     03 FILLER            PIC X(11) VALUE "ATAGORY   C".
013600     03 FILLER            PIC X(11) VALUE "LR  SIZE   ".
103000     03 FILLER            PIC X(02) VALUE SPACES.
103000     03 FILLER            PIC X(11) VALUE "INVENTORY ".
103000     03 FILLER            PIC X(11) VALUE "   ATS    ".
103000     03 FILLER            PIC X(11) VALUE " ON ORDER ".
103000     03 FILLER            PIC X(11) VALUE "STK STATUS".
103000     03 FILLER            PIC X(11) VALUE "  MINIMUM ".
103000     03 FILLER            PIC X(11) VALUE "  MAXIMUM ".
103000     03 FILLER            PIC X(11) VALUE "  MINIMUM ".
103000     03 FILLER            PIC X(11) VALUE "  MAXIMUM ".
014700
014800 01  PR-DETAIL1.
050692     03 PR-ITEM-STYLE                         PIC X(08).
050692     03 FILLER                      PIC X(02) VALUE SPACES.
           03 PR-TOTAL-MSG.
050692        05 PR-ITEM-CATEGORY                      PIC X(10).
050692        05 FILLER                      PIC X(02) VALUE SPACES.
050692        05 PR-ITEM-COLOR                         PIC X(02).
050692     03 FILLER                      PIC X(02) VALUE SPACES.
050692     03 PR-ITEM-SIZE                          PIC X(04).
050692     03 FILLER                      PIC X(02) VALUE SPACES.

015200     03 PR-ITEM-CUR-QTY-SOLD                  PIC ZZ,ZZZ,ZZ9-.
015300     03 PR-ITEM-YTD-QTY-SOLD                  PIC ZZZ,ZZZ,ZZ9-. 
010191     03 FILLER            PIC X(5)            VALUE SPACES. 

015600     03 PR-ITEM-CUR-DOL-SOLD                  PIC ZZZZ,ZZZ.99-. 
015700     03 PR-ITEM-YTD-DOL-SOLD                  PIC ZZ,ZZZ,ZZZ.99-. 
015900     03 FILLER            PIC X(5)            VALUE SPACES. 
           03 PR-AVG-PRICE      PIC ZZZ,ZZZ.99-   VALUE ZERO.     
           03 FILLER            PIC X(30)         VALUE SPACES.

103000 01  PR-DETAIL1-SS.
103000     03 PR-ITEM-STYLE-SS            PIC X(08).
103000     03 FILLER                      PIC X(02) VALUE SPACES.
           03 PR-TOTAL-MSG-SS.
050692        05 PR-ITEM-CATEGORY-SS      PIC X(10).
050692        05 FILLER                   PIC X(02) VALUE SPACES.
050692        05 PR-ITEM-COLOR-SS         PIC X(02).
103000     03 FILLER                      PIC X(02) VALUE SPACES.
103000     03 PR-ITEM-SIZE-SS             PIC X(04).
103000     03 FILLER                      PIC X(04) VALUE SPACES.
103000     03 PR-ONHAND-QTY               PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-ATS-QTY                  PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-ONORDER-QTY              PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-STOCK-STATUS-QTY         PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-MINIMUM-QTY              PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-MAXIMUM-QTY              PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-REORDER-MIN-QTY          PIC ZZ,ZZZ,ZZ9-.
103000     03 PR-REORDER-MAX-QTY          PIC ZZ,ZZZ,ZZ9-.
016900
014800 01  PR-DASHES.
           03 FILLER            PIC X(32)      VALUE SPACES.
015200     03 FILLER            PIC X(11)      VALUE "---------- ".
015300     03 FILLER            PIC X(12)      VALUE "----------- ". 
010191     03 FILLER            PIC X(5)       VALUE SPACES. 

015600     03 FILLER            PIC X(12)      VALUE "----------- ". 
015700     03 FILLER            PIC X(12)      VALUE "----------- ". 
015900     03 FILLER            PIC X(5)       VALUE SPACES. 
           03 FILLER            PIC X(11)      VALUE "---------- ".     
           03 FILLER            PIC X(30)      VALUE SPACES.

103000 01  PR-DASHES-SS.
103000     03 FILLER                 PIC X(24)  VALUE SPACES.
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
103000     03 FILLER                 PIC X(11)  VALUE "---------- ".
016900
019000 01  TOTALS VALUE ZERO. 
019100     03 TOTAL-LINE OCCURS 2 TIMES.
019200        05 TOT-ITEM-CUR-DOL-SOLD              PIC S9(9)V9(2). 
019300        05 TOT-ITEM-YTD-DOL-SOLD              PIC S9(9)V9(2). 
019500        05 TOT-CUR-QTY                        PIC S9(9)V9(2). 
019600        05 TOT-YTD-QTY                        PIC S9(9)V9(2). 
019600        05 TOT-AVG-PRICE                      PIC S9(9)V9(2). 
103000*-- USED FOR STOCK STATUS REPORT --*
103000        05 TOT-ONHAND-QTY                     PIC S9(9). 
103000        05 TOT-ATS-QTY                        PIC S9(9). 
103000        05 TOT-ONORDER-QTY                    PIC S9(9). 
103000        05 TOT-STOCK-QTY                      PIC S9(9). 
103000        05 TOT-MINIMUM-QTY                    PIC S9(9). 
103000        05 TOT-MAXIMUM-QTY                    PIC S9(9). 
103000        05 TOT-REORDER-MIN-QTY                PIC S9(9). 
103000        05 TOT-REORDER-MAX-QTY                PIC S9(9). 
019700
019800 01  WORK-AREAS.
019900     03 AVG-PRICE                 PIC S9(9)V99 VALUE ZEROES.
020100     03 ITEM-COUNT                PIC 9(5) VALUE 0.
020200     03 PREV-STYLE                PIC X(8) VALUE ZERO.
           03 PREV-CLASS                PIC 99.
103000     03 REORD-MAX                 PIC S9(7) VALUE ZERO.
103000     03 REORD-MIN                 PIC S9(7) VALUE ZERO.
103000     03 STOCK-STATUS              PIC S9(7) VALUE ZERO.
103000     03 ATS                       PIC S9(7) VALUE ZERO.
020300 01  TAG-READ-FLAG        PIC X  VALUE "N". 
020400     88  TAG-READ         VALUE "Y".
020500 01  BY-CLASS-FLAG        PIC X  VALUE "N". 
020600     88  BY-CLASS         VALUE "Y".
021396 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
020700
031611 77  CNTLF--NAME     PIC X(15) VALUE "CONTROL.FIL" .
031611 77  CNTLF-FULLPATH  PIC X(35) VALUE SPACES .
031611 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
031611 77  TEMP-SUB-DIR    PIC X(14) VALUE SPACES .
031611 77  USERF--NAME     PIC X(15) VALUE "USER.FIL" .
031611 77  USERF-FULLPATH  PIC X(35) VALUE SPACES .
031611 01  IO-WAIT-CD      PIC X VALUE "1"                                  
031611     88 IO-WAIT-ON  VALUE IS "1".
031611     88 IO-WAIT-OFF VALUE IS "0".
031611 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
031611 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
031611 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.
020800
       SCREEN SECTION.
031611     COPY "CONSTANT.SCR".
031611     COPY "SCRNINIT.SCR".
031611     COPY "ERRORFIL.SCR".
031611     COPY "PRINT.SCR".   
031611                         
031611 01 PRINTING-RPT-MSG PIC IS X(16) FROM PRINTING-REPORT CONTROL
031611       DSPL--CONTROL LINE 13 COLUMN 30.
031611 01 PRINT-A-MSG     CONTROL DSPL--CONTROL.
031611    05  VALUE IS "Print a" LINE 12 COLUMN 28.
020900 PROCEDURE DIVISION.
021000 DECLARATIVES.
021100
021200
021300*    PRNTR.DS   PRINTER DECLARATIVES PROCEDURE. 
021400
021500 Z-PRNTR SECTION. 
021600     USE AFTER ERROR PROCEDURE ON LO. 
021700 Z-PRNTR-D. 
021800     COPY "ERRORPRT.SR".
021900     GO TO STATUS-EXIT. 
022000     COPY "ITEMF.DS". 
022100     COPY "CLASF.DS". 
022200     COPY "TAGMF.DS". 
022300     COPY "CNTLF.DS". 
022400     COPY "USERF.DS". 
022500     COPY "SORTF.DS". 
031611*    COPY "MUCTF.DS".
031611     COPY "SCATF.DS".
050692     COPY "STYLF.DS".
022600     GO TO STATUS-EXIT. 
022700
022800     COPY "ERRORFIL.SR".
022900
023000 STATUS-EXIT. EXIT. 
023100
023200 END DECLARATIVES.
023300
023400 MAIN-PROG SECTION. 
023500 OPEN-FILES.
071409     MOVE "SIZECAT.FIL"      TO  SCATF--NAME.
031611     PERFORM USERF-FILL-FULLPATH.
023600     PERFORM PGM-INIT.
021396     IF USER-SN = 00117 
021396        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
021396     IF WS-CUSTOMIZED-FLAG > ZERO
021396        MOVE "S0170M" TO PROG-NAME.
010191     IF NO-DECIMALS  MOVE 0 TO NUMBER-DECIMALS. 
010191     IF ONE-DECIMAL  MOVE 1 TO NUMBER-DECIMALS. 
010191     IF TWO-DECIMALS MOVE 2 TO NUMBER-DECIMALS. 
010191     IF THREE-DECIMALS MOVE 3 TO NUMBER-DECIMALS. 
010191     IF FOUR-DECIMALS  MOVE 4 TO NUMBER-DECIMALS. 
010191     IF FIVE-DECIMALS  MOVE 5 TO NUMBER-DECIMALS. 
023700     PERFORM  OPEN-ITEMF     .
023800     PERFORM  OPEN-CLASF     .
023900     PERFORM  OPEN-TAGMF     .
101191     IF PROFITS-APPAREL-YES
031611        MOVE CNTL-TP-DRIVE     TO  STYL-DRIVE
031611        MOVE CNTL-TP-DIRECTORY TO  STYL-DIRECTORY
031611*       OPEN INPUT MUCTF
101191        OPEN INPUT STYLF
031611*        PERFORM READ-MUCTF.
024200     PERFORM SCREEN-INIT. 
024100 BEGIN-REPORT.
           MOVE "1001000000" TO FKEYS.
060889     PERFORM PRINT-SELECT.
060889     IF FLAG = 4 GO TO END-REPORT.
024200     PERFORM SCREEN-INIT. 
020600     PERFORM GET-SUMM-DETAIL.
020600     IF FLAG = 3 GO TO BEGIN-REPORT.
           IF FLAG = 9 GO TO END-REPORT.
031611*    PERFORM OPEN-LO.
060289     PERFORM PF-OPEN-LO.
024200     PERFORM SCREEN-INIT. 
103000     IF ITEM-SALES-REPORT
103000        NEXT SENTENCE
103000     ELSE
103000        MOVE PR-HEADER2-SS TO PR-HEADER2
103000        MOVE PR-HEADER3-SS TO PR-HEADER3
103000        MOVE REPORT-TITLE-SS  TO PR-TITLE.

024300     MOVE 99 TO LINE-NO.
024400     MOVE 0 TO PAGE-NO. 
031611*    DISPLAY PRINTING-REPORT LINE 13 POSITION 32. 
031611     DISPLAY PRINTING-RPT-MSG.
024600     IF ESC-FLAG = 1 MOVE "0010000000" TO FKEYS 
024700                ELSE MOVE "0000000000" TO FKEYS.
024800     MOVE 1 TO FLAG.
024900     CALL "KBDCHK" USING FLAG, FKEYS. 
025000     MOVE 0 TO FLAG.
025100     PERFORM PROCESS-REPORT.
031611*    WRITE PRINT-REC BEFORE ADVANCING PAGE. 
031611     MOVE SPACES TO PRINT-REC.
031611     PERFORM PF-REC-CHECK.
031611     WRITE PFRPT BEFORE ADVANCING PAGE.
031611     PERFORM CLOSE-LO.
025400     GO TO END-REPORT.
025500
025600 END-REPORT.
025700     PERFORM CLOSE-FILES. 
025800
025900 EXIT-RUN.
           IF FLAG = 9
              MOVE "PMENU" TO NEXT-PROG
           ELSE 
              MOVE "S0170" TO NEXT-PROG.
026000     COPY "FINISH.SR".
026100
026200     COPY "CONTROL.SR". 
026300 SUBROUTINE SECTION.
026400 PGM-INIT.
026500     PERFORM CONTROL-INIT.
020996     MOVE TERM-ID TO TAG-NO, SORT-NO.
052399*    MOVE PGM-DATE TO PR-DATE.
052399     MOVE PGM-DATE-11 TO PR-DATE-11.
026700     ACCEPT SYSTEM-TIME FROM TIME.
026800     MOVE SYSTEM-HOUR TO PR-HOUR. 
026900     MOVE SYSTEM-MINUTE TO PR-MINUTE. 
027000     MOVE SYSTEM-SECONDS TO PR-SECONDS. 
027100     MOVE CNTL-CONAME TO PR-CONAME. 
027200     MOVE REPORT-TITLE TO PR-TITLE. 
027300*    MOVE CNTL-PR-CNDSE TO PR-CNDSE.
027400*    0 = NO ESCAPE, 1 = ESCAPABLE 
027500     MOVE 1 TO ESC-FLAG.
027600     OPEN INPUT SORTF.
027700     READ SORTF.
027800     MOVE SORT-TITLE TO PR-INFO-LINE. 
027900     IF SORT-TYPE = 2 
028000         MOVE "Y" TO BY-CLASS-FLAG. 
028100     CLOSE SORTF. 
028200     MOVE "Y" TO TAG-READ-FLAG. 
028300
PROFIT     COPY "SCRNINIT.SR".
028800
020600 GET-SUMM-DETAIL.
031611*    DISPLAY "Print a " LINE 12 POSITION 28.
031611     DISPLAY PRINT-A-MSG.
020600     MOVE 0 TO FLAG.
           MOVE "1010000010" TO FKEYS.
028300     CALL "SCRN01" USING FLAG, FKEYS, SPECS-1, HELP-1,
028400          SUMM-DETAIL-OPT.
028900 SUBROUTINE-EXIT. EXIT. 
029000
029100
029200 PROCESS-REPORT SECTION.
029300 PROCESS-REPORT-BEGIN.
029400     PERFORM  READ-ITEMF-NEXT.
029500     IF BY-CLASS
029600         MOVE ITEM-CLASS TO PREV-CLASS. 
           MOVE ITEM-STYLE     TO PREV-STYLE.
029700
029800 PROCESS-REPORT-NEXT. 
029900     IF ITEMF-STATUS = AT-END 
030000         PERFORM AT-END-CHECK 
030100         GO TO PROCESS-REPORT-EXIT. 
           PERFORM BREAK-CHECK.
030400     PERFORM MOVE-DETAIL. 
030500 PROCESS-REPORT-READ. 
030600     IF ESC-FLAG = 1
030700         CALL "KBDCHK" USING FLAG, FKEYS
060889         IF FLAG = 3 
060889            PERFORM ACCEPT-PAUSE 
060889            IF OPTION OF PAUSE-SPEC(1) = 1 
060889               MOVE 3 TO FLAG 
060889               GO TO PROCESS-REPORT-EXIT.
030900     PERFORM  READ-ITEMF-NEXT.
031000     GO TO PROCESS-REPORT-NEXT. 
031100
031200 PROCESS-REPORT-EXIT. EXIT. 
031300
031400 PRINT-REPORT SECTION.
031500 PRINT-DETAIL.
031600     PERFORM PAGE-CHECK.
031700     PERFORM PRINT-REPORT-DETAIL. 
031800
031900
032000 PRINT-TOTALS.
032100     PERFORM PAGE-CHECK.
           ADD 1 TO LINE-NO.
           IF STOCK-STATUS-REPORT
031611*       WRITE PRINT-REC FROM PR-DASHES-SS BEFORE ADVANCING 1 LINE
031611        MOVE  PR-DASHES-SS TO PRINT-REC                          
031611        PERFORM PF-REC-CHECK
031611        WRITE PFRPT BEFORE ADVANCING 1 LINE
           ELSE
031611*       WRITE PRINT-REC FROM PR-DASHES    BEFORE ADVANCING 1 LINE.
031611        MOVE  PR-DASHES    TO PRINT-REC                          
031611        PERFORM PF-REC-CHECK
031611        WRITE PFRPT BEFORE ADVANCING 1 LINE.

032200     ADD 1 TO LINE-NO.
031611*    WRITE PRINT-REC FROM PR-DETAIL1 BEFORE ADVANCING 1 LINES.
031611     MOVE PR-DETAIL1 TO PRINT-REC
031611     PERFORM PF-REC-CHECK.
031611     WRITE PFRPT BEFORE ADVANCING 1 LINE.
032400     MOVE SPACES TO PRINT-REC, PR-DETAIL1, PR-DETAIL1-SS.
031611*    WRITE PRINT-REC                 BEFORE ADVANCING 1 LINES. 
031611     PERFORM PF-REC-CHECK.
031611     WRITE PFRPT BEFORE ADVANCING 1 LINE.
032600     ADD 1 TO LINE-NO.
032700
032800 PAGE-CHECK.
032900     IF LINE-NO > PAGE-SIZE AND PAGE-NO IS NOT = 0
033000         MOVE SPACES TO PRINT-REC 
031611*        WRITE PRINT-REC BEFORE ADVANCING PAGE.
031611         PERFORM PF-REC-CHECK
031611         WRITE PFRPT BEFORE ADVANCING PAGE.
033200     IF LINE-NO > PAGE-SIZE 
033300         MOVE 0 TO LINE-NO
033400         ADD 1 TO PAGE-NO 
033500         MOVE PAGE-NO TO PR-PAGE-NO 
031611*        WRITE PRINT-REC FROM PR-HEADER1 BEFORE 1
031611         MOVE PR-HEADER1 TO PRINT-REC
031611         PERFORM PF-REC-CHECK
031611         WRITE PFRPT BEFORE 1
031611*        WRITE PRINT-REC FROM PR-HEADER1A BEFORE 1
031611         MOVE PR-HEADER1A TO PRINT-REC
031611         PERFORM PF-REC-CHECK
031611         WRITE PFRPT BEFORE 1
031611*        WRITE PRINT-REC FROM PR-HEADER1B BEFORE 2
031611         MOVE PR-HEADER1B TO PRINT-REC
031611         PERFORM PF-REC-CHECK
031611         WRITE PFRPT BEFORE 1
050692         ADD 4 TO LINE-NO 
034000         PERFORM PRINT-REPORT-HEADERS 
034100         MOVE SPACES TO PRINT-REC 
031611*        WRITE PRINT-REC                  BEFORE 1
031611         PERFORM PF-REC-CHECK
031611         WRITE PFRPT BEFORE 1
034300         ADD 1 TO LINE-NO.
034400
034500 PRINT-REPORT-EXIT. EXIT. 
034600
034700*    COPY "S0170.RP". 
034800
034900
035000*    S0170.RP                   ITEM SALES REP
035100
035200 S0170-REPORT SECTION.
035300
035400
035500 AT-END-CHECK.
035600     IF ITEMF-STATUS = AT-END 
035700         MOVE 2 TO INDEX-PERFORM
035800         PERFORM MOVE-TOTALS. 
035900
036000 BREAK-CHECK. 
            IF ITEM-STYLE NOT = PREV-STYLE
               MOVE 1 TO INDEX-PERFORM
               PERFORM MOVE-TOTALS
               MOVE ITEM-STYLE TO PREV-STYLE.
37100
037200 MOVE-DETAIL. 
037300     COMPUTE AVG-PRICE ROUNDED = 
037400         ITEM-YTD-DOL-SOLD / ITEM-YTD-QTY-SOLD. 
           MOVE AVG-PRICE TO PR-AVG-PRICE.
010191     MOVE ITEM-CUR-QTY-SOLD      TO PR-ITEM-CUR-QTY-SOLD. 
038700     MOVE ITEM-YTD-QTY-SOLD      TO PR-ITEM-YTD-QTY-SOLD. 
039100     MOVE ITEM-CUR-DOL-SOLD      TO PR-ITEM-CUR-DOL-SOLD. 
039300     MOVE ITEM-YTD-DOL-SOLD      TO PR-ITEM-YTD-DOL-SOLD. 
050692     IF PROFITS-APPAREL-YES
050692       IF ITEM-CATEGORY = ZERO
050692          MOVE ITEM-STYLE TO PR-ITEM-STYLE, PR-ITEM-STYLE-SS
050692       ELSE
050692          MOVE ITEM-STYLE TO PR-ITEM-STYLE, PR-ITEM-STYLE-SS
101191          IF ITEM-STYLE NOT = STYLF-KEY 
050592             MOVE ITEM-STYLE TO STYLF-KEY
050692             PERFORM READ-STYLF
050692             IF STYLF-STATUS = FOUND
031611*               MOVE MUCT-CATEGORIES(STYLE-GROUP-NAME, ITEM-CATEGORY)
031611*                 TO PR-ITEM-CATEGORY, PR-ITEM-CATEGORY-SS
031611*               MOVE MUCT-SIZES(STYLE-GROUP-NAME, ITEM-SIZE)
031611*                 TO PR-ITEM-SIZE, PR-ITEM-SIZE-SS   
050692                MOVE ITEM-COLOR TO PR-ITEM-COLOR, PR-ITEM-COLOR-SS
050692             ELSE
050692                MOVE SPACES TO PR-ITEM-COLOR, PR-ITEM-SIZE,
050692                               PR-ITEM-CATEGORY
                      MOVE SPACES TO PR-ITEM-COLOR-SS, PR-ITEM-SIZE-SS
                                     PR-ITEM-CATEGORY-SS
050692          ELSE
031611*            MOVE MUCT-CATEGORIES(STYLE-GROUP-NAME, ITEM-CATEGORY)
031611*                 TO PR-ITEM-CATEGORY, PR-ITEM-CATEGORY-SS
031611*            MOVE MUCT-SIZES(STYLE-GROUP-NAME, ITEM-SIZE)
031611*                 TO PR-ITEM-SIZE, PR-ITEM-SIZE-SS
050692             MOVE ITEM-COLOR TO PR-ITEM-COLOR, PR-ITEM-COLOR-SS.
102500*    MOVE ITEM-DESC              TO PR-ITEM-DESC, PR-STYLE-DESC. 
103000     IF STOCK-STATUS-REPORT
103000        PERFORM MOVE-DETAIL-SS.
040700     PERFORM PRINT-DETAIL.
040800     PERFORM ADD-TOTALS.
040900
103000 MOVE-DETAIL-SS.
103000     MOVE ITEM-ONHAND      TO   PR-ONHAND-QTY.
103000     MOVE ITEM-ONORD       TO   PR-ONORDER-QTY.
103000     MOVE ITEM-MIN         TO   PR-MINIMUM-QTY.
103000     MOVE ITEM-MAX         TO   PR-MAXIMUM-QTY.
103000     COMPUTE ATS ROUNDED = 
                   ITEM-ONHAND - ITEM-ALLOC - ITEM-BACKORD.
           MOVE ATS TO PR-ATS-QTY.
           COMPUTE STOCK-STATUS ROUNDED =
                   ITEM-ONHAND - ITEM-ALLOC - ITEM-BACKORD + ITEM-ONORD.
           MOVE STOCK-STATUS TO PR-STOCK-STATUS-QTY.
           COMPUTE REORD-MIN ROUNDED =
                   ITEM-MIN - (ITEM-ONHAND - ITEM-ALLOC -
                     ITEM-BACKORD + ITEM-ONORD).
           IF REORD-MIN < 1 MOVE ZERO TO REORD-MIN.
           MOVE REORD-MIN  TO PR-REORDER-MIN-QTY.
           COMPUTE REORD-MAX ROUNDED =
                   ITEM-MAX - (ITEM-ONHAND - ITEM-ALLOC -
                     ITEM-BACKORD + ITEM-ONORD).
           IF REORD-MAX < 1 MOVE ZERO TO REORD-MAX.
           MOVE REORD-MAX  TO PR-REORDER-MAX-QTY.
103000     MOVE PR-DETAIL1-SS    TO PR-DETAIL1.
041000 ADD-TOTALS.
041100     MOVE 1 TO INDEX-OCCURS.
041200     PERFORM ADD-TOTAL 2 TIMES. 
041300 ADD-TOTAL. 
041400     ADD  ITEM-CUR-DOL-SOLD TO TOT-ITEM-CUR-DOL-SOLD(INDEX-OCCURS). 
041600     ADD  ITEM-YTD-DOL-SOLD TO TOT-ITEM-YTD-DOL-SOLD(INDEX-OCCURS). 
           ADD  ITEM-CUR-QTY-SOLD TO TOT-CUR-QTY(INDEX-OCCURS).
           ADD  ITEM-YTD-QTY-SOLD  TO TOT-YTD-QTY(INDEX-OCCURS).
042500     IF STOCK-STATUS-REPORT
103000        ADD ITEM-ONHAND     TO TOT-ONHAND-QTY(INDEX-OCCURS)
              ADD ATS             TO TOT-ATS-QTY(INDEX-OCCURS)
              ADD ITEM-ONORD      TO TOT-ONORDER-QTY(INDEX-OCCURS)
              ADD STOCK-STATUS    TO TOT-STOCK-QTY(INDEX-OCCURS)
              ADD ITEM-MIN        TO TOT-MINIMUM-QTY(INDEX-OCCURS)
              ADD ITEM-MAX        TO TOT-MAXIMUM-QTY(INDEX-OCCURS)
              ADD REORD-MIN       TO TOT-REORDER-MIN-QTY(INDEX-OCCURS)
              ADD REORD-MAX       TO TOT-REORDER-MAX-QTY(INDEX-OCCURS).
042400     ADD 1 TO INDEX-OCCURS. 
           
042600 MOVE-TOTALS. 
043000     MOVE 1 TO INDEX-OCCURS. 
043100     PERFORM MOVE-TOTAL INDEX-PERFORM TIMES.
043200 MOVE-TOTAL.
           MOVE SPACES TO PR-DETAIL1, PR-DETAIL1-SS.
043300     IF INDEX-OCCURS = 1
043400         MOVE "STYLE TOTAL"  TO PR-TOTAL-MSG, PR-TOTAL-MSG-SS.
043500     IF INDEX-OCCURS = 2
043600         MOVE "COMPANY TOTAL" TO PR-TOTAL-MSG, PR-TOTAL-MSG-SS.
           IF ITEM-SALES-REPORT
037300        COMPUTE AVG-PRICE ROUNDED = 
037400            TOT-ITEM-YTD-DOL-SOLD(INDEX-OCCURS) /
                  TOT-YTD-QTY(INDEX-OCCURS) 
              MOVE AVG-PRICE TO PR-AVG-PRICE
04450         MOVE TOT-ITEM-CUR-DOL-SOLD(INDEX-OCCURS)
044600             TO PR-ITEM-CUR-DOL-SOLD             
044700        MOVE 0  TO TOT-ITEM-CUR-DOL-SOLD(INDEX-OCCURS) 
044800        MOVE TOT-ITEM-YTD-DOL-SOLD(INDEX-OCCURS)
044900             TO PR-ITEM-YTD-DOL-SOLD             
045000        MOVE 0  TO TOT-ITEM-YTD-DOL-SOLD(INDEX-OCCURS) 
              MOVE TOT-CUR-QTY(INDEX-OCCURS) TO PR-ITEM-CUR-QTY-SOLD
              MOVE TOT-YTD-QTY(INDEX-OCCURS) TO PR-ITEM-YTD-QTY-SOLD
              MOVE ZERO TO TOT-CUR-QTY(INDEX-OCCURS), 
                           TOT-YTD-QTY(INDEX-OCCURS)
           ELSE
              MOVE TOT-ONHAND-QTY(INDEX-OCCURS) TO PR-ONHAND-QTY
              MOVE TOT-ATS-QTY(INDEX-OCCURS)    TO PR-ATS-QTY
              MOVE TOT-ONORDER-QTY(INDEX-OCCURS) TO PR-ONORDER-QTY
              MOVE TOT-STOCK-QTY(INDEX-OCCURS)  TO PR-STOCK-STATUS-QTY
              MOVE TOT-MINIMUM-QTY(INDEX-OCCURS) TO PR-MINIMUM-QTY
              MOVE TOT-MAXIMUM-QTY(INDEX-OCCURS) TO PR-MAXIMUM-QTY
              MOVE TOT-REORDER-MIN-QTY(INDEX-OCCURS) TO
                        PR-REORDER-MIN-QTY
              MOVE TOT-REORDER-MAX-QTY(INDEX-OCCURS) TO 
                        PR-REORDER-MAX-QTY
              MOVE ZERO TO TOT-ONHAND-QTY(INDEX-OCCURS), 
                           TOT-ATS-QTY(INDEX-OCCURS),
                           TOT-ONORDER-QTY(INDEX-OCCURS),
                           TOT-STOCK-QTY(INDEX-OCCURS),
                           TOT-MINIMUM-QTY(INDEX-OCCURS),
                           TOT-MAXIMUM-QTY(INDEX-OCCURS),
                           TOT-REORDER-MIN-QTY(INDEX-OCCURS),
                           TOT-REORDER-MAX-QTY(INDEX-OCCURS)

              MOVE PR-DETAIL1-SS TO PR-DETAIL1.
046000     PERFORM PRINT-TOTALS.
046100     ADD  1 TO INDEX-OCCURS.
046200
046300 PRINT-REPORT-HEADERS.
050692     ADD 1 TO LINE-NO.
031611*    WRITE PRINT-REC FROM PR-HEADER2 BEFORE ADVANCING 1 LINES. 
031611     MOVE PR-HEADER2 TO PRINT-REC.
031611     PERFORM PF-REC-CHECK.
031611     WRITE PFRPT BEFORE ADVANCING 1 LINE.
050692     ADD 1 TO LINE-NO.

031611*    WRITE PRINT-REC FROM PR-HEADER3 BEFORE ADVANCING 1 LINE . 
031611     MOVE PR-HEADER3 TO PRINT-REC.
031611     PERFORM PF-REC-CHECK.
031611     WRITE PFRPT BEFORE ADVANCING 1 LINE.
046800
046900 PRINT-REPORT-DETAIL. 
050692*    ADD SKIP TO LINE-NO. 
050692     ADD 1 TO LINE-NO.
031611*    WRITE PRINT-REC FROM PR-DETAIL1 BEFORE ADVANCING 1 LINES.
031611     MOVE PR-DETAIL1 TO PRINT-REC.
031611     PERFORM PF-REC-CHECK.
031611     WRITE PFRPT BEFORE ADVANCING 1 LINE.
047400
047500 S0170-REPORT-EXIT. EXIT. 
047600
031611*    COPY "PRINT.SR".
031611     COPY "PFPRINT.SR".
031611     COPY "DATECVT.SR".
047700
047800 IN-OUT SECTION.
047900 OPEN-ITEMF.
048000     OPEN INPUT  ITEMF. 
048100 OPEN-CLASF.
048200     OPEN INPUT  CLASF. 
048300 OPEN-TAGMF.
048400     OPEN INPUT  TAGMF. 
048500
048800 READ-ITEMF-NEXT. 
048900     IF NOT TAG-READ
049000         READ ITEMF NEXT
049100             AT END MOVE AT-END TO ITEMF-STATUS 
110305     ELSE
110305         READ TAGMF NEXT 
110305         AT END  MOVE AT-END TO TAGMF-STATUS.
049400     IF TAG-READ
049500         IF TAGMF-STATUS NOT = AT-END 
049600             PERFORM MOVE-ACCESS
049700         ELSE MOVE AT-END TO ITEMF-STATUS.
049800 MOVE-ACCESS.  
049900     MOVE TAG-DATA  TO ITEM-NUMBER. 
031611*    READ ITEMF INVALID KEY 
031611*       MOVE SPACES TO ITEMF-DATA1.
031611     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
031611            ITEMF-STATUS OR IO-WAIT-OFF 
031611        READ ITEMF INVALID KEY
031611                   MOVE SPACES TO ITEMF-DATA1
031611        END-READ
031611     END-PERFORM.
050300 READ-CLASF.
050400     MOVE PREV-CLASS TO CLAS-NUMBER.
031611*    READ CLASF INVALID KEY 
031611*        MOVE SPACES TO CLASF-DATA1.
031611     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
031611            CLASF-STATUS OR IO-WAIT-OFF 
031611        READ CLASF INVALID KEY
031611                   MOVE SPACES TO CLASF-DATA1
031611        END-READ
031611     END-PERFORM.
031611*READ-MUCTF. 
031611*    READ MUCTF NO LOCK INVALID KEY
031611*        MOVE NOT-FOUND TO MUCTF-STATUS.
050592 READ-STYLF. 
031611*    READ STYLF NO LOCK INVALID KEY
031611*        MOVE NOT-FOUND TO STYLF-STATUS.
031611     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
031611            STYLF-STATUS OR IO-WAIT-OFF 
031611        READ STYLF INVALID KEY
031611                   MOVE NOT-FOUND TO STYLF-DATA1
031611        END-READ
031611     END-PERFORM.
050700 CLOSE-FILES. 
050800     CLOSE ITEMF. 
050900     CLOSE CLASF. 
051000     CLOSE TAGMF. 
051200 IN-OUT-EXIT. EXIT. 
031611 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 SCATF-FILL-FULLPATH.
       CNTLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CNTLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
            DELIMITED BY SPACES INTO CNTLF-FULLPATH.
       USERF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO USERF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
            INTO USERF-FULLPATH.
       SCATF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO SCATF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" SCATF--NAME 
            DELIMITED BY SPACES INTO SCATF-FULLPATH.

       CHAINCALLS SECTION.
       CHN--PARM-BLOCK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
            .
      
       CHN--PARM-BLK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.
      
      * CHNR--WS-PASSED.
      *      COPY "CHAINR.CBL" REPLACING ==PARAM-BLOCK== BY ==WS-PASSED==
      *      .
      *
       SCRN-TEST SECTION.
            COPY "STEST.SR".
