[Search for users] [Overall Top Noters] [List of all Conferences] [Download this site]

Conference clt::cobol

Title:	VAX/DEC COBOL
Notice:	Kit,doc,performance talk info-->DIR/KEY=KIT or DOC or PERF_TALK
Moderator:	PACKED::BRAFFITT

Created:	Mon Feb 03 1986
Last Modified:	Fri Jun 06 1997
Last Successful Update:	Fri Jun 06 1997
Number of topics:	3250
Total number of notes:	13077

3244.0. "INDEXED READ differences on VAX and ALPHA" by SWAM1::COHEN_RO (Ron Cohen: DTN 531-3742) Wed May 28 1997 11:12

       Customer environment: VMS 5.2/Cobol 4.4        Alpha 6.2/Cobol 2.4

	The customer creates a table which is displayed by sequentially reading
	all item records matching the users starting key. The user then selects
	an item from the screen which is used to read the file again and 
	display the details of the record chosen. On the VAX this works fine
	but on the Alpha the same read aborts the program (see below). 
        To fix this problem, the customer had to specify the key at the 
        READ statement. Code, abort message and fix follows.
        Why is this happening? Is this a compiler bug? Thanks for any
	information.

        What follows is pretty lengthy but we tried to include all pertinent
	information.
	 
The item selection screen follows:

05/28/97 PGM: IMQ00100         FAMILIAN PIPE & SUPPLY                BAKERSFIELD
                               *ITEM MASTER INQUIRY*                            
+------------------------------------------------------------------------------+
| Item No      9050000                                                         |
| Plate No                             List                                    |
| Cat/grp/seq                          Cost             On Hand                |
| P.O.               REC                                Alloc                  |
| Pri. Vendor                                           Backord                |
--------------------------- BRANCH INVENTORY SEARCH ----------------------------
ACTION: Enter line #, ARROW key for scrolling, <PF4> to exit : _____
                                                                                
       ITEM #      po#    inv#     CAT/GRP        ITEM DESCRIPTION              
      -------   ----------------   --------   --------------------------------- 
   1. 9051068           436711 *   005-L      LASCO #1960420 ELYPSUS TUB ONLY   
   2. 9051977   000476  134414 *   005-       LASCO PB WH 460421 ROSE           
   3. 9053675   801762  442181 *   005-L      #2603-30 LH  W/FHA BACKING- WHITE 
   4. 9053676   801762  442181 *   005-L      #2603-30 RH  W/FHA BACKING- WHITE 
   5. 9053795   174444  443458 *   005-A      AMERICH BERMUDA BLDER W/SYTEM WHT 
   6. 9053833   174567  443891 *   005-L1     LASCO BELICIA T/ONLY 4860620 WHT  
   7. 9053862   801775  444088 *   005-AM     AMERICH BERMUDA BUILDER TUB ONLY  
   8. 9053926   174823  444593 *   005-E2     FLORESTONE #40-40H R/H ADA SHWR   
   9. 9053927   174823  444593 *   005-E2     FLORESTONE #40-40H L/H ADA SHWR   
  10. 9053980           445330 *   005-H      H/S    OVATION  W/POOL            
                                                                                

200-INQ-BY-CATEGORY.

...	sets up key IM50-PRIMARY-VENDOR-75, starts the file on that key and
...	reads the next record.  if record found performs display routine.
	START  IM0050 KEY IS NOT < IM50-PRIMARY-VENDOR-75
            INVALID KEY SET NO-RECORD   TO  TRUE.

	IF NOT NO-RECORD
	    READ  IM0050 NEXT RECORD
		AT  END  SET NO-RECORD        TO  TRUE
	    END-READ.

	IF  NOT NO-RECORD AND W1-CAT NOT = IM50-CATEGORY
	    SET NO-RECORD   TO TRUE
	END-IF.
        
	IF  NOT NO-RECORD
	    MOVE IM50-LOC-NO-01     TO W1-LOCATION
	    PERFORM 1000-DISPLAY-ITEM-DATA


1000-DISPLAY-ITEM-DATA.

...	builds screen area to display list of matching item records.
...	performs routine to pick up and display matching item records.
	PERFORM 4100-READ-ITEM-RECORD

...	performs routine to prompt user for which item to display.
	PERFORM 1500-GET-INPUT TEST AFTER UNTIL (W1-FIELD     > 0        AND 
						 W1-FIELD NOT > W1-MAX   AND
						 VKBD-RETURN-NORMAL)     OR
						 VKBD-RETURN-PF4         OR
						 VKBD-RETURN-TIME-OUT.


4100-READ-ITEM-RECORD.

...	sets up display line for matching item record.  gets item information
...	and displays line.
	PERFORM 4200-READ-NEXT-SEQ-RECORDS.


4200-READ-NEXT-SEQ-RECORDS.

...	performs item detail formatting and i/o until we exceed the maximum
...	number of lines on the screen or find no more matching records.
	PERFORM 4400-SET-DETAIL-LINE UNTIL W1-SUB = W1-SEQ-LIMIT OR
					   W1-NO-MORE-RECORD.


4400-SET-DETAIL-LINE.

...	formats item display line and displays it.  reads the next
...	IM0050 record sequentially.
	READ  IM0050 NEXT RECORD
	    AT END SET W1-NO-MORE-RECORD        TO TRUE
	END-READ.

...	(we're inquiring by category) when category changes, force end of file.
	IF  IMG00101-INQ-BY-CAT
	AND IM50-CATEGORY > W1-CAT
	    SET W1-NO-MORE-RECORD           TO TRUE
	END-IF.

...	if exceeded maximum screen size, force end of file.
	IF  W1-MAX NOT < 9999
	    SET  W1-NO-MORE-RECORD          TO TRUE
	END-IF.


1500-GET-INPUT.

...	the item selection screen is displayed (as above).  the program
...	prompts the user to select a detail line for inquiry.  the program
...	permits arrow keys to scroll through displayed data.

...	the user enters '1' at 'ACTION:' prompt.

...	if a valid 'line' is entered, picks up displayed detail line
...	and attempts to randomly read item data...
	IF  W1-FIELD > 0 AND W1-FIELD NOT > W1-MAX AND VKBD-RETURN-NORMAL

...	    the following line is read back from the screen:

   1. 9051068           436711 *   005-L      LASCO #1960420 ELYPSUS TUB ONLY   

	    MOVE  W1-FIELD                  TO SMG-ROWS
	    SET   SMG-READ-FROM-VID         TO TRUE
	    MOVE  85                        TO SMG-DATA-SIZE
	    MOVE W1-VID                     TO SMG-VID
	    ADD  1                          TO SMG-VID
	    CALL 'SMGDSP' USING SMG-DATA-SIZE,W1-DETAIL,SMG-BUFFER
	    INITIALIZE IMG00101-ITEM-RECORD

...	    build primary key
	    MOVE W1-LOCATION                TO IM50-LOC-NO-01
	    MOVE W1-DETAIL-ITEM             TO IM50-ITEM-NO-02
	    READ IM0050
		INVALID KEY
		    SET IMG00101-INQ-EXIT   TO TRUE
		NOT INVALID KEY
		    MOVE IM50-INVENTORY-MASTER-RECORD TO IMG00101-ITEM-RECORD
		    SET IMG00101-INQ-SUCCESS TO TRUE
	    END-READ

...	program aborts in the 'read' statement:

05/28/97 PGM: IMQ00100         FAMILIAN PIPE & SUPPLY                BAKERSFIELD
                               *ITEM MASTER INQUIRY*      
lqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqk
x Item No      9050000                                                         x
x Plate No                             List                                    x
x Cat/grp/seq                          Cost             On Hand                x
x P.O.               REC                                Alloc                  x
x Pri. Vendor                                           Backord                x
qqqqqqqqqqqqqqqqqqqqqqqqqqq BRANCH INVENTORY SEARCH qqqqqqqqqqqqqqqqqqqqqqqqqqqq
ACTION: Enter line #, ARROW key for scrolling, <PF4> to exit :  0001            
%SYSTEM-F-ACCVIO, access violation, reason mask=04, virtual address=00202104, PC
=005B0044, PS=0000001B    inv#     CAT/GRP        ITEM DESCRIPTION              
      -------   ----------------   --------   --------------------------------- 
  Improperly handled condition, image exit forced.O #1960420 ELYPSUS TUB ONLY
    Signal arguments:   Number = 00000005     LASCO PB WH 460421 ROSE
                        Name   = 0000000C     #2603-30 LH  W/FHA BACKING- WHITE
                                 00000004     #2603-30 RH  W/FHA BACKING- WHITE
                                 00202104     AMERICH BERMUDA BLDER W/SYTEM WHT
                                 005B0044     LASCO BELICIA T/ONLY 4860620 WHT
                                 0000001B     AMERICH BERMUDA BUILDER TUB ONLY
   8. 9053926   174823  444593 *   005-E2     FLORESTONE #40-40H R/H ADA SHWR
    Register dump:4823  444593 *   005-E2     FLORESTONE #40-40H L/H ADA SHWR  
    R0  = 0000000000000001  R1  = 0000000048383630  R2  = 0000000000615930
    R3  = 000000000008C318  R4  = 00000000000241C0  R5  = 000000000008C980
    R6  = 00000000000242D8  R7  = 0000000000000000  R8  = 000000000008C8E4
    R9  = 0000000000202071  R10 = 0000000000000021  R11 = 0000000000202071
    R12 = 0000000000000016  R13 = 000000000008C0E8  R14 = 000000005C5C5C5C
    R15 = 00000000001CBD38  R16 = 0000000000202071  R17 = 0000000000202071
    R18 = 0000000000202071  R19 = 0000000000202071  R20 = 0000000000202071
    R21 = 0000000000000001  R22 = 00000000000021DA  R23 = 0000000046AD0415
    R24 = 0000000000202104  R25 = 0000000000000005  R26 = 00000000001CC61C
    R27 = 0000000000202105  R28 = 0000000000202071  R29 = 000000007F96B7E0
    SP  = 000000007F96B7E0  PC  = 00000000005B0044  PS  = 200000000000001B
%SYSTEM-F-ACCVIO, access violation, reason mask=04, virtual address=00202104, PC
=005A01E8, PS=0000001B 

  Improperly handled condition, image exit forced. 
    Signal arguments:   Number = 00000005 
                        Name   = 0000000C 
                                 00000004 
                                 00202104 
                                 005A01E8 
                                 0000001B 

    Register dump: 
    R0  = 0000000000622060  R1  = 0000000000202071  R2  = 00000000006137E8 
    R3  = 000000000008C318  R4  = 0000000000622330  R5  = 0000000000202071 
    R6  = 000000000000001C  R7  = 0000000000202071  R8  = 0000000000000016 
    R9  = 0000000000202071  R10 = 0000000000000021  R11 = 0000000000202071 
    R12 = 0000000000000016  R13 = FFFFFFFF840F9680  R14 = 000000005C5C5C5C 
    R15 = 00000000001CBD38  R16 = 0000000000202071  R17 = 0000000000202071 
    R18 = 0000000000000000  R19 = 0000000000202071  R20 = 0000000000202071 
    R21 = 0000000000000001  R22 = 0000000000001CDA  R23 = 0000000046AD0415 
    R24 = 0000000000202104  R25 = 0000000000000005  R26 = 00000000005A0570 
    R27 = 0000000000202105  R28 = 0000000000000000  R29 = 000000007F96B2C0 
    SP  = 000000007F96B2C0  PC  = 00000000005A01E8  PS  = 000000000000001B 


...	    the read statement was changed in to following manner to prevent
...	    the abort.  w1-sleep-time is defined as 'VALUE 1.0 COMP-1'.
	    MOVE W1-LOCATION                TO IM50-LOC-NO-01
	    MOVE W1-DETAIL-ITEM             TO IM50-ITEM-NO-02
	    call "lib$wait"              using w1-sleep-time
	    READ IM0050 key is im50-master-key
		INVALID KEY
		    SET IMG00101-INQ-EXIT   TO TRUE
		NOT INVALID KEY
		    MOVE IM50-INVENTORY-MASTER-RECORD TO IMG00101-ITEM-RECORD
		    SET IMG00101-INQ-SUCCESS TO TRUE
	    END-READ

T.R	Title	User	Personal Name	Date	Lines
3244.1	We need a program example we can compile	PACKED::BRAFFITT		`Wed May 28 1997 12:02`	5
	> Why is this happening? Is this a compiler bug? Thanks for any There is insufficient information in .0 for us to evaluate this question. Please post an entire program example that we can compile/link/run on our systems.
3244.2	Source listing of .0	SWAM1::COHEN_RO	Ron Cohen: DTN 531-3742	`Wed May 28 1997 12:59`	1088
	IDENTIFICATION DIVISION. PROGRAM-ID. IMG00108. ******************************************************************************* * * * PROPRIETORY INFORMATION * * THIS IS THE SOLE PROPERTY OF FAMILIAN PIPE AND SUPPLY CORPORATION AND * * IS NOT TO BE REPRODUCED IN ANY MANNER WITHOUT THE PRIOR WRITTEN CON- * * SENT OF FAMILIAN PIPE AND SUPPLY CORPORATION. * ******************************************************************************* * PROGRAM NAME : IMG00108 * * * * DESCRIPTION : is a subroutine called for branch IM0050 search. * * * AUTHOR : CAROL LI * * * * DATE : FEB. 19, 1993 * * * * FILES : IM0050_FILE - BRANCH INVENTORY MASTER FILE * * * * LINK INSTR : See caller's opt file. * * * ******************************************************************************* * * * R E V I S I O N L O G * * * * * NUMBER DATE PROGRAMMER D E S C R I P T I O N * * -------- -------- ----------------- ----------------------------------- * * 01 06/96 BELINDA DUONG 1852 PRICE COST SYSTEM CHANGES. ******************************************************************************* ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. FILE-CONTROL. * COPY IM50FC OF COPYBOOK. SELECT IM0050 ASSIGN TO IM0050_FILE ACCESS MODE IS DYNAMIC ORGANIZATION IS INDEXED FILE STATUS IS FILE-STATUS RECORD KEY IS IM50-MASTER-KEY ALTERNATE RECORD KEY IS IM50-ALTERNATE-ID-03 WITH DUPLICATES ALTERNATE RECORD KEY IS IM50-BIN-LOC-1-17 ALTERNATE RECORD KEY IS IM50-PRIMARY-VENDOR-75 WITH DUPLICATES ALTERNATE RECORD KEY IS IM50-VENDOR-NUMBER-76. * COPY IM45FC OF COPYBOOK. SELECT IM0045 ASSIGN TO IM0045_FILE ACCESS MODE IS DYNAMIC ORGANIZATION IS INDEXED FILE STATUS IS FILE-STATUS RECORD KEY IS IM45-ITEM ALTERNATE RECORD KEY IS IM45-PLATE ALTERNATE RECORD KEY IS IM45-CAT-GRP-SEQ ALTERNATE RECORD KEY IS IM45-UPC-CODE WITH DUPLICATES. DATA DIVISION. FILE SECTION. FD IM0050. * COPY IM50RC OF COPYBOOK. 01 IM50-INVENTORY-MASTER-RECORD. 05 IM50-MASTER-KEY PIC X(11). 05 IM50-MASTER-KEY-XX REDEFINES IM50-MASTER-KEY. 10 IM50-LOC-NO-01 PIC X(04). 10 IM50-LOC-NO-01-XX REDEFINES IM50-LOC-NO-01. 15 IM50-CO-LOC PIC X(02). 15 IM50-BR-LOC PIC X(02). 10 IM50-ITEM-NO-02 PIC X(07). 10 IM50-XS-ITEM REDEFINES IM50-ITEM-NO-02. 15 IM50-XS-ITEM-IND PIC 9(01). 15 IM50-XS-ITEM-CAT PIC 9(02). 15 IM50-XS-ITEM-SEQ PIC 9(04). 05 IM50-ALTERNATE-ID-03 PIC X(16). 05 IM50-XS-ALTERNATE REDEFINES IM50-ALTERNATE-ID-03. 10 IM50-XS-PO PIC 9(06). 10 IM50-XS-PO-LINE PIC 9(02). 10 IM50-XS-OE PIC 9(06). 10 IM50-XS-OE-LINE PIC 9(02). 05 IM50-ABC-CLASS-10 PIC X(01). 05 IM50-SELL-UNIT-MSR-12 PIC X(02). 05 IM50-BIN-LOC-1-17 PIC X(08). 05 IM50-BIN-LOC-1-17-XX REDEFINES IM50-BIN-LOC-1-17. 10 IM50-AREA1 PIC X(02). 10 IM50-ROW1 PIC X(02). 10 IM50-BIN1 PIC X(02). 10 IM50-SHELF1 PIC X(02). 05 IM50-BIN-LOC-2-18 PIC X(08). 05 IM50-BIN-LOC-2-18-XX REDEFINES IM50-BIN-LOC-2-18. 10 IM50-AREA2 PIC X(02). 10 IM50-ROW2 PIC X(02). 10 IM50-BIN2 PIC X(02). 10 IM50-SHELF2 PIC X(02). 05 IM50-NS-UPDATE PIC 9(06) COMP-3. 05 FILLER PIC X(02). 05 IM50-RESTOCK-FLAG PIC X(01). 05 IM50-IB-IN-TRANSIT PIC S9(07)V9(2) COMP-3. 05 IM50-TAX-STATUS-CODE-29 PIC X(01). 05 IM50-CASH-DISC-IND-96 PIC X(01). 05 IM50-ON-HAND-1-35 PIC S9(09)V9(2) COMP-3. 05 IM50-ALLOC-36 PIC S9(09)V9(2) COMP-3. 05 IM50-ON-ORDR-37 PIC S9(09)V9(2) COMP-3. 05 IM50-CURR-MO-RCPT-38 PIC S9(09)V9(2) COMP-3. 05 IM50-CURR-MO-RTRN-39 PIC S9(09)V9(2) COMP-3. 05 IM50-BO-QTY-40 PIC S9(09)V9(2) COMP-3. 05 IM50-CURR-MO-SALES-45 PIC S9(09)V9(2) COMP-3. 05 IM50-CURR-MO-ISSUES-46 PIC S9(09)V9(2) COMP-3. 05 IM50-XS-ITEM-DESC PIC X(35). 05 IM50-MISC-INFO REDEFINES IM50-XS-ITEM-DESC. 10 IM50-CURR-SALES-AMT-47 PIC S9(07)V9(2) COMP-3. 10 IM50-CURR-RETURN-AMT-48 PIC S9(07)V9(2) COMP-3. 10 IM50-CURR-NO-ORDER-49 PIC S9(05) COMP-3. 10 IM50-CURR-QTY-ORDERED-50 PIC S9(11) COMP-3. 10 IM50-CURR-COST-AMT-51 PIC S9(05)V9(4) COMP-3. 10 IM50-WEIGHT-63 PIC S9(06)V9(1) COMP-3. 10 IM50-HEIGHT-64 PIC S9(03) COMP-3. 10 IM50-LENGTH-65 PIC S9(04)V9(1) COMP-3. 10 IM50-WIDTH-66 PIC S9(03) COMP-3. 05 IM50-DATE-OF-ENTRY-67 PIC 9(06) COMP-3. 05 IM50-ID-OF-ENTRY-68 PIC X(04). 05 IM50-DATE-OF-LAST-INV-69 PIC 9(06) COMP-3. 05 IM50-PRIMARY-VENDOR-75 PIC X(12). 05 IM50-CGS-REDF REDEFINES IM50-PRIMARY-VENDOR-75. 10 IM50-CATEGORY PIC 9(03). 10 IM50-GROUP PIC X(04). 10 IM50-SEQUENCE PIC 9(05). 05 IM50-MIN-FACTOR-98 PIC 9(01)V9(1). 05 IM50-MAX-FACTOR-99 PIC 9(01)V9(1). 05 IM50-ORDER-QTY-NAME-1-82 PIC X(02). 05 IM50-ORDER-QTY-AMT-1-83 PIC S9(05) COMP-3. 05 IM50-ORDER-QTY-NAME-2-84 PIC X(02). 05 IM50-ORDER-QTY-AMT-2-85 PIC S9(05) COMP-3. 05 IM50-MIN-STOCK-LVL-88 PIC S9(09)V9(2) COMP-3. 05 IM50-CUBIC-MSR-89 PIC S9(05)V9(2) COMP-3. 05 IM50-MIN-STK-ACTUAL-97 PIC S9(07)V9(2) COMP-3. 05 IM50-VENDOR-NUMBER-76 PIC 9(05). 05 IM50-ALT-VENDOR-100 PIC 9(05). 05 IM50-MIN-MAINT-101 PIC X(01). 05 IM50-RCVD-THIS-PER-102 PIC S9(09)V9(2) COMP-3. 05 IM50-LAST-REG-PO-NO PIC X(06). 05 FILLER REDEFINES IM50-LAST-REG-PO-NO. 10 IM50-XS-GROUP PIC X(04). 10 IM50-XS-FILLER PIC X(02). 05 IM50-CHANGE-DATE PIC 9(06) COMP-3. 05 IM50-LAST-REG-REC-DATE PIC 9(06) COMP-3. * NUMBER OF CHARACTERS IN RECORD = 227 FD IM0045. * COPY IM45RC OF COPYBOOK. 01 IM45-RECORD. 05 IM45-ITEM PIC X(07). 05 IM45-PLATE PIC X(16). 05 IM45-CAT-GRP-SEQ. 10 IM45-CATEGORY PIC 9(03). 10 IM45-GROUP PIC X(04). 10 IM45-SEQ-NO PIC 9(05). 05 IM45-UPC-CODE. 10 IM45-UPC-VENDOR PIC 9(06). 10 IM45-UPC-ITEM PIC 9(05). 05 IM45-ITEM-PRICE. 10 IM45-MODERN-LIST PIC S9(07)V9(04) COMP. 10 IM45-MFG-LIST PIC S9(07)V9(04) COMP. 10 IM45-MFG-FACTOR PIC S9(03)V9(04) COMP. 10 IM45-DB-COST PIC S9(07)V9(04) COMP. 10 IM45-SURCHARGE PIC S9(07)V9(04) COMP. 10 IM45-LIFO-COST PIC S9(07)V9(04) COMP. 10 IM45-SALES-GROUP PIC X(04). 05 IM45-PREV-MODERN-LIST PIC S9(07)V9(04) COMP. 05 IM45-PREV-MFG-LIST PIC S9(07)V9(04) COMP. 05 IM45-PREV-MFG-FACTOR PIC S9(07)V9(04) COMP. 05 IM45-DESCRIPTION PIC X(36). 05 IM45-BOX-PACK-QTY PIC S9(05) COMP. 05 IM45-LIFT-CTN-QTY PIC S9(05) COMP. 05 IM45-ITEM-NOTE PIC 9(02). 05 IM45-VENDOR-ONE PIC X(05). 05 IM45-PREV-VENDOR-ONE PIC X(05). 05 IM45-UOM PIC X(02). 05 IM45-BOX-PACK-DIMENSIONS. 10 IM45-WEIGHT PIC S9(04)V9(02) COMP. 10 IM45-HEIGHT PIC S9(04)V9(02) COMP. 10 IM45-LENGTH PIC S9(04)V9(02) COMP. 10 IM45-WIDTH PIC S9(04)V9(02) COMP. 10 IM45-CUBIC PIC S9(04)V9(02) COMP. 05 IM45-TAXABLE-ITEM PIC X(01). 05 IM45-OBSOLETE-ITEM PIC X(01). 05 IM45-UPDATE-DATE PIC 9(08) COMP. 05 IM45-COST-CHG-DATE PIC 9(08) COMP. 05 IM45-WMS-CHG-DATE PIC 9(08) COMP. 05 IM45-PROD-CODE PIC X(01). 05 IM45-WMS-CHG-TIME PIC 9(04) COMP. 05 IM45-LIFT-CTN-DIMENSIONS. 10 IM45-LC-WEIGHT PIC S9(04)V9(02) COMP. 10 IM45-LC-HEIGHT PIC S9(04)V9(02) COMP. 10 IM45-LC-LENGTH PIC S9(04)V9(02) COMP. 10 IM45-LC-WIDTH PIC S9(04)V9(02) COMP. 10 IM45-LC-CUBIC PIC S9(04)V9(02) COMP. 05 FILLER PIC X(13). WORKING-STORAGE SECTION. * COPY 'GTVMS' OF COPYBOOK. 01 GTVMS-PARAMETERS. 03 GTVMS-ATTRIBUTES PIC 9(004). 88 GTVMS-PID VALUE 0100. 88 GTVMS-PRCNAM VALUE 0101. 88 GTVMS-USRNAM VALUE 0102. 88 GTVMS-IMGNAM VALUE 0103. 88 GTVMS-PRCMODE VALUE 0104. 88 GTVMS-PRCTERM VALUE 0105. 88 GTVMS-SETPRCNAM VALUE 0106. 88 GTVMS-GETPRCNODE VALUE 0110. 88 GTVMS-GETSYM VALUE 0201. 88 GTVMS-SETSYM VALUE 0202. 88 GTVMS-DELSYM VALUE 0203. 88 GTVMS-GETLOG VALUE 0301. 88 GTVMS-SETLOG VALUE 0302. 88 GTVMS-DELLOG VALUE 0303. 88 GTVMS-RECLCK VALUE 1001. 88 GTVMS-SETPWD VALUE 2001. 88 GTVMS-VERPWD VALUE 2002. 88 GTVMS-GETMSG VALUE 9901. 03 GTVMS-ATTR REDEFINES GTVMS-ATTRIBUTES. 05 GTVMS-GROUP PIC 9(002). 05 GTVMS-FUNCTION PIC 9(002). 03 GTVMS-INPUT. 05 GTVMS-IN-LEN. 10 GTVMS-IN-LEN1 PIC 9(002) VALUE 0. 10 GTVMS-IN-LEN2 PIC 9(002) VALUE 0. 10 GTVMS-IN-LEN3 PIC 9(002) VALUE 0. 05 GTVMS-IN-LENGTHS REDEFINES GTVMS-IN-LEN PIC X(006). 05 GTVMS-IN-RDF. 10 FILLER PIC X(090). 10 GTVMS-IN-VALUE PIC S9(009) COMP VALUE 0. 05 GTVMS-IN-STRING REDEFINES GTVMS-IN-RDF PIC X(094). 03 GTVMS-OUTPUT. 05 GTVMS-OUT-LENGTH PIC 9(002) VALUE 0. 05 GTVMS-OUT-RDF. 10 FILLER PIC X(094). 10 GTVMS-OUT-VALUE PIC S9(009) COMP VALUE 0. 05 GTVMS-OUT-STRING REDEFINES GTVMS-OUT-RDF PIC X(098). 03 FILLER PIC X(100). 03 GTVMS-STATUS PIC S9(009) COMP VALUE 0. 88 GTVMS-AMBSYMDEF VALUE EXTERNAL LIB$_AMBSYMDEF. 88 GTVMS-STRTRU VALUE EXTERNAL LIB$_STRTRU. 88 GTVMS-INPCONERR VALUE EXTERNAL OTS$_INPCONERR. 88 GTVMS-ACCVIO VALUE EXTERNAL SS$_ACCVIO. 88 GTVMS-BADPARAM VALUE EXTERNAL SS$_BADPARAM. 88 GTVMS-BUFFEROVF VALUE EXTERNAL SS$_BUFFEROVF. 88 GTVMS-DUPLNAM VALUE EXTERNAL SS$_DUPLNAM. 88 GTVMS-EXASTLM VALUE EXTERNAL SS$_EXASTLM. 88 GTVMS-INSFARG VALUE EXTERNAL SS$_INSFARG. 88 GTVMS-IVLOGNAM VALUE EXTERNAL SS$_IVLOGNAM. 88 GTVMS-IVLOGTAB VALUE EXTERNAL SS$_IVLOGTAB. 88 GTVMS-MSGNOTFND VALUE EXTERNAL SS$_MSGNOTFND. 88 GTVMS-NOLOGNAM VALUE EXTERNAL SS$_NOLOGNAM. 88 GTVMS-NOLOGTAB VALUE EXTERNAL SS$_NOLOGTAB. 88 GTVMS-NOMORENODE VALUE EXTERNAL SS$_NOMORENODE. 88 GTVMS-NOMOREPROC VALUE EXTERNAL SS$_NOMOREPROC. 88 GTVMS-NONEXPR VALUE EXTERNAL SS$_NONEXPR. 88 GTVMS-NOPRIV VALUE EXTERNAL SS$_NOPRIV. 88 GTVMS-NORMAL VALUE EXTERNAL SS$_NORMAL. 88 GTVMS-NOSUCHNODE VALUE EXTERNAL SS$_NOSUCHNODE. 88 GTVMS-NOSUCHSYM VALUE EXTERNAL LIB$_NOSUCHSYM. 88 GTVMS-SUSPENDED VALUE EXTERNAL SS$_SUSPENDED. 88 GTVMS-SUPERSEDE VALUE EXTERNAL SS$_SUPERSEDE. 88 GTVMS-TOOMANYLNAM VALUE EXTERNAL SS$_TOOMANYLNAM. * COPY 'IOEHBS' OF COPYBOOK. 01 IOEHBS-RECORD. 05 STATUS-TO-RETURN PIC X(2). 88 SUCCESSFUL VALUE "00" THRU "02". 88 ENDOFFILE VALUE "13" THRU "16". 88 SEQUENCE-ER VALUE "21". 88 ALTERED-INDX VALUE "21". 88 DUP-KEY VALUE "22". 88 NO-RECORD VALUE "23". 88 BOUND-VIOL VALUE "24". 88 PERM-I-O-ER VALUE "30". 88 RECORD-LOCK VALUE "92", "LO". 88 RECORD-LOCKED VALUE "92", "LO". 88 LOCKED-REC VALUE "92", "LO". 88 INDX-NO-MATCH VALUE "94". 88 DISK-FULL VALUE "95". 05 FILE-STATUS REDEFINES STATUS-TO-RETURN. 10 FILE-STATUS-1 PIC XX. 05 IOE-STATUS REDEFINES STATUS-TO-RETURN. 10 IOE-STATUS-1 PIC XX. * SORRY FOLKS - 'ADD WS-KILL-THE-RUN TO WS-KILL-THE-RUN' NO LONGER WORKS * (ON THE ALPHA SYSTEMS). USE 'CALL "LIB$STOP" USING BY VALUE 4' INSTEAD. * JEF NORTON - 1 MAY 1997. 01 WS-A-SPACE VALUE SPACES. 05 WS-KILL-THE-RUN PIC 9(1). 01 SYERROR-PARM-LIST. 05 SYERROR-SEVERITY PIC X(01). 88 SYERROR-WARNING VALUE "W". 88 SYERROR-ERROR VALUE "A". 05 SYERROR-PROGRAM PIC X(08). 05 SYERROR-MESSAGE-1 PIC X(75) VALUE SPACES. 05 SYERROR-MESSAGE-2 PIC X(75) VALUE SPACES. 05 SYERROR-MESSAGE-3 PIC X(75) VALUE SPACES. 05 SYERROR-FILE PIC X(12). 05 SYERROR-STATUS PIC X(02). 05 SYERROR-STS PIC S9(09) USAGE IS COMP. 05 SYERROR-STV PIC S9(09) USAGE IS COMP. 05 SYERROR-KEY PIC X(20) VALUE SPACES. * COPY 'SMGDSP' OF COPYBOOK. 01 SMG-DATA-SIZE PIC 99 COMP. 01 SMG-DATA. 03 SMG-DATA-STRING OCCURS 1 TO 80 TIMES DEPENDING ON SMG-DATA-SIZE PIC X. 01 SMG-BUFFER. 03 SMG-FUNCTION PIC 99. 88 SMG-REFRESH VALUE 00. 88 SMG-SET-CURSOR-ABS VALUE 01. 88 SMG-ERASE-DISPLAY VALUE 02. 88 SMG-ERASE-LINE VALUE 03. 88 SMG-PUT-CHARS VALUE 04. 88 SMG-DISPLAY-CLEAR-SCREEN VALUE 05. 88 SMG-DISPLAY-CLEAR-LINE VALUE 06. 88 SMG-RING-BELL VALUE 07. 88 SMG-ERASE-COLUMN VALUE 08. 88 SMG-CREATE-VID VALUE 21. 88 SMG-PASTE-VID VALUE 22. 88 SMG-UNPASTE-VID VALUE 23. 88 SMG-DELETE-VID VALUE 24. 88 SMG-CREATE-VIEWPORT VALUE 25. 88 SMG-SCROLL-VIEWPORT VALUE 26. 88 SMG-DELETE-VIEWPORT VALUE 27. 88 SMG-MOVE-VID VALUE 28. 88 SMG-POP-VID VALUE 29. 88 SMG-PUT-CHARS-WIDE VALUE 31. 88 SMG-PUT-CHARS-HIGHWIDE VALUE 32. 88 SMG-CHANGE-RENDITION VALUE 33. 88 SMG-FIND-CURSOR VALUE 41. 88 SMG-SET-CURSOR VALUE 42. 88 SMG-DRAW-BOX VALUE 43. 88 SMG-DRAW-LINE VALUE 44. 88 SMG-BEGIN-BATCHING VALUE 45. 88 SMG-END-BATCHING VALUE 46. 88 SMG-PUT-HELP VALUE 47. 88 SMG-MESSAGE-LINE VALUE 48. 88 SMG-CHANGE-VID VALUE 49. 88 SMG-READ-FROM-VID VALUE 50. 88 SMG-DISABLE-CONTROL-Y VALUE 51. 88 SMG-ENABLE-CONTROL-Y VALUE 52. 88 SMG-SAVE-KBID VALUE 91. 88 SMG-GET-VID VALUE 92. 88 SMG-GET-PBD VALUE 93. 88 SMG-GET-KBID VALUE 94. 03 SMG-ROW. 05 SMG-ROWS PIC S9(4) VALUE ZEROS. 88 SMG-SCROLL-UP VALUE 0001. 88 SMG-SCROLL-DOWN VALUE 0002. 88 SMG-SCROLL-RIGHT VALUE 0004. 88 SMG-SCROLL-LEFT VALUE 0008. 88 SMG-CR-TO-ABORT VALUE 1. 88 SMG-CR-TO-CONTINUE VALUE 2. 88 SMG-CR-TO-RECOVER VALUE 3. 05 SMG-ROWX REDEFINES SMG-ROWS. 07 SMG-ROW1 PIC S99. 07 SMG-ROW2 PIC S99. 03 SMG-COL. 05 SMG-COLS PIC S9(4) VALUE ZEROS. 05 SMG-COLX REDEFINES SMG-COLS. 07 SMG-COL1 PIC S99. 07 SMG-COL2 PIC S99. 03 SMG-ATT. 05 SMG-ATTRIBUTES PIC 9(9) COMP VALUE ZEROS. 88 SMG-NORMAL VALUE ZERO. 88 SMG-BLINK VALUE EXTERNAL SMG$M_BLINK. 88 SMG-BOLD VALUE EXTERNAL SMG$M_BOLD. 88 SMG-REVERSE VALUE EXTERNAL SMG$M_REVERSE. 88 SMG-UNDERLINE VALUE EXTERNAL SMG$M_UNDERLINE. 88 SMG-INVISIBLE VALUE EXTERNAL SMG$M_INVISIBLE. 03 SMG-VIRTUAL-ID. 05 SMG-VID PIC S9(4) COMP. 03 SMG-LABEL. 05 SMG-SIDES PIC X VALUE SPACE. 88 SMG-TOP VALUE 'T'. 88 SMG-BOTTOM VALUE 'B'. 88 SMG-RIGHT VALUE 'R'. 88 SMG-LEFT VALUE 'L'. 05 SMG-POSITION PIC 99 VALUE ZEROS. 03 SMG-TOP-VIRTUAL-ID. 05 SMG-TOP-VID PIC 9(9) COMP VALUE ZEROS. 03 SMG-RETURN-STATUS PIC 9(9) COMP. 88 SMG-RETURN-SUCCESS VALUE 1. * COPY 'VKBD' OF COPYBOOK. 01 VKBD-DATA-SIZE PIC 99 COMP VALUE 0. 01 VKBD-DATA. 03 VKBD-DATA-STRING OCCURS 1 TO 80 TIMES DEPENDING ON VKBD-DATA-SIZE PIC X. 01 VKBD-BUFFER. 03 VKBD-TYPE-OF-INPUT PIC 99 VALUE 0. 88 VKBD-NUMERIC VALUE 01. 88 VKBD-ALPHA VALUE 02. 88 VKBD-PASSWORD VALUE 03. 88 VKBD-NUMERIC-FUNCTION VALUE 11. 88 VKBD-ALPHA-FUNCTION VALUE 12. 88 VKBD-PASSWORD-FUNCTION VALUE 13. 88 VKBD-NUMERIC-FUNCTION-FULL VALUE 21. 88 VKBD-ALPHA-FUNCTION-FULL VALUE 22. 88 VKBD-NUMERIC-FUNCTION-VAL VALUE 31. 88 VKBD-ALPHA-FUNCTION-VAL VALUE 32. 88 VKBD-NUMERIC-FUNC-VAL-DEF VALUE 41. 88 VKBD-ALPHA-FUNC-VAL-DEF VALUE 42. 88 VKBD-NUMERIC-FUNC-VAL-DEF-NF VALUE 51. 88 VKBD-ALPHA-FUNC-VAL-DEF-NF VALUE 52. 03 VKBD-ROW PIC 9(4) COMP VALUE 0. 03 VKBD-COL PIC 9(4) COMP VALUE 0. 03 VKBD-TIME-OUT PIC 9(4) COMP VALUE 0. 03 VKBD-VID PIC 9(4) COMP VALUE 0. 03 VKBD-ATT PIC 9(9) COMP VALUE 0. 88 VKBD-BLINK VALUE EXTERNAL SMG$M_BLINK. 88 VKBD-BOLD VALUE EXTERNAL SMG$M_BOLD. 88 VKBD-REVERSE VALUE EXTERNAL SMG$M_REVERSE. 88 VKBD-UNDERLINE VALUE EXTERNAL SMG$M_UNDERLINE. 88 VKBD-INVISIBLE VALUE EXTERNAL SMG$M_INVISIBLE. 03 VKBD-DECIMALS PIC S9(1) VALUE 0. 03 VKBD-RETURNS PIC 9(2) COMP VALUE 0. 88 VKBD-RETURN-NORMAL VALUE 00. 88 VKBD-RETURN-BACKSPACE VALUE 01. 88 VKBD-RETURN-UP-ARROW VALUE 02. 88 VKBD-RETURN-DOWN-ARROW VALUE 03. 88 VKBD-RETURN-LEFT-ARROW VALUE 04. 88 VKBD-RETURN-RIGHT-ARROW VALUE 05. 88 VKBD-RETURN-TAB VALUE 06. 88 VKBD-RETURN-PF2 VALUE 07. 88 VKBD-RETURN-PF3 VALUE 08. 88 VKBD-RETURN-PF4 VALUE 09. 88 VKBD-RETURN-TIME-OUT VALUE 10. 88 VKBD-RETURN-PAGE-UP VALUE 11. 88 VKBD-RETURN-PAGE-DOWN VALUE 12. 88 VKBD-VALID-RETURNS VALUE 00 THRU 12. 01 RECORD-LIT. 03 LIT-1. 05 FILLER PIC X(63) VALUE 'ACTION: Enter line #, ARROW key for scrolling, <PF4> to exit : '. 03 LIT-3 PIC X(59) VALUE 'ITEM # PLATE # CAT/GRP ITEM DESCRIPTION'. 03 LIT-4 PIC X(75) VALUE ' ------- ---------------- -------- ----------------------------------'. 03 LIT-5 PIC X(59) VALUE 'ITEM # po# inv# CAT/GRP ITEM DESCRIPTION'. 01 FILLER. 03 W1-LOCATION PIC X(04). 03 W1-PLATE-NO PIC X(16). 03 W1-CAT-GRP-SEQ. 05 W1-CAT PIC 9(3). 05 W1-GRP PIC X(4). 05 W1-SEQ PIC 9(5). 03 W1-FIELD PIC S9(4). 03 W1-ALPHA-FIELD REDEFINES W1-FIELD PIC X(4). 03 W1-WINDOW-SIZE PIC 9(4) COMP. 03 W1-SEQ-LIMIT PIC 9(4) COMP VALUE 30. 03 W1-MAX PIC 9(4) COMP. 03 W1-SUB PIC 9(4) COMP. 03 W1-POINTER PIC S9(9) COMP. 03 W1-SCROLL-LINES PIC S9(9) COMP. 03 W1-VID PIC 9(4) COMP. 03 W1-VID-SIZE PIC 9(4) COMP. 03 W1-WINDOW PIC 9(4) COMP. 03 W1-VIDSX OCCURS 2 TIMES. 05 W1-VIDS PIC 9. 03 W1-INIT-SW PIC 9. 88 W1-INIT VALUE 1. 03 W1-NO-MORE-RECORD-SW PIC X. 88 W1-NO-MORE-RECORD VALUE 'N'. 03 W1-AT-POS PIC 9(2) COMP. 88 W1-AT-FOUND VALUE 2 THRU 24. 03 W1-SAVE-FUNCTION PIC 9(2). 03 W1-SAVE-KEY-DATA PIC X(12). 03 W1-DETAIL. 05 W1-DETAIL-NUM PIC ZZZZ.. 05 W1-DETAIL-NUMX REDEFINES W1-DETAIL-NUM PIC X(5). 05 FILLER PIC X(1) VALUE SPACE. 05 W1-DETAIL-ITEM PIC X(7). 05 FILLER PIC X(3) VALUE SPACES. 05 W1-DETAIL-PLATE PIC X(16). 05 FILLER PIC X(3) VALUE SPACES. 05 W1-DETAIL-CAT PIC X(3). 05 FILLER PIC X(1) VALUE '-'. 05 W1-DETAIL-GRP PIC X(4). 05 FILLER PIC X(3) VALUE SPACES. 05 W1-DETAIL-DESC PIC X(34). LINKAGE SECTION. * COPY 'IMG00101' OF COPYBOOK. 01 IMG00101-HELP-PARAMETERS. 05 IMG00101-INQ-FUNCTION PIC 9(2). 88 IMG00101-INQ-BY-PLATE VALUE 01. 88 IMG00101-INQ-BY-CAT VALUE 02. 88 IMG00101-INQ-BY-ITEM VALUE 03. 88 IMG00101-INQ-BY-NEXT-ITEM VALUE 04. 88 IMG00101-INQ-BY-UPC VALUE 05. 88 IMG00101-CLOSE-FILE VALUE 09. 05 IMG00101-STARTING-VID PIC 9(4) COMP. 05 IMG00101-KEY-DATA PIC X(16). 05 IMG00101-ITEM-RECORD PIC X(246). 05 IMG00101-RETURNS PIC 9. 88 IMG00101-INQ-SUCCESS VALUE 0. 88 IMG00101-ITEM-NOT-FOUND VALUE 1. 88 IMG00101-INQ-EXIT VALUE 2. 05 IMG00101-ITEM-IND PIC 9. 88 IMG00101-ALL-ITEM VALUE 0. 88 IMG00101-SQ-ITEM VALUE 1. 88 IMG00101-NS-ITEM VALUE 2. PROCEDURE DIVISION USING IMG00101-HELP-PARAMETERS. DECLARATIVES. * COPY IM50DC OF COPYBOOK. IM0050-ERROR-SECTION SECTION. USE AFTER STANDARD ERROR PROCEDURE ON IM0050. IM0050-ERROR. IF FILE-STATUS NOT = "02" AND "90" AND "92" DISPLAY " " DISPLAY "I/O ERROR ON IM0050_FILE" DISPLAY "FILE STATUS = " FILE-STATUS DISPLAY "RMS-STS VALUE = " RMS-STS OF IM0050 WITH CONVERSION DISPLAY "RMS-STV VALUE = " RMS-STV OF IM0050 WITH CONVERSION SET GTVMS-GETMSG TO TRUE MOVE RMS-STS OF IM0050 TO GTVMS-IN-VALUE CALL "GTVMS" USING GTVMS-PARAMETERS DISPLAY GTVMS-OUT-STRING(1:GTVMS-OUT-LENGTH) DISPLAY " " CALL "LIB$STOP" USING BY VALUE 4. * COPY IM45DC OF COPYBOOK. IM0045-ERROR-SECTION SECTION. USE AFTER STANDARD ERROR PROCEDURE ON IM0045. IM0045-ERROR. IF FILE-STATUS NOT = "02" AND "90" AND "92" DISPLAY " " DISPLAY "I/O ERROR ON IM0045_FILE" DISPLAY "FILE STATUS = " FILE-STATUS DISPLAY "RMS-STS VALUE = " RMS-STS OF IM0045 WITH CONVERSION DISPLAY "RMS-STV VALUE = " RMS-STV OF IM0045 WITH CONVERSION SET GTVMS-GETMSG TO TRUE MOVE RMS-STS OF IM0045 TO GTVMS-IN-VALUE CALL "GTVMS" USING GTVMS-PARAMETERS DISPLAY GTVMS-OUT-STRING(1:GTVMS-OUT-LENGTH) DISPLAY " " CALL "LIB$STOP" USING BY VALUE 4. END DECLARATIVES. MAIN-PROGRAM SECTION. MAIN-START-00. IF NOT W1-INIT SET W1-INIT TO TRUE OPEN INPUT IM0050 ALLOWING ALL OPEN INPUT IM0045 ALLOWING ALL END-IF. MOVE 500 TO W1-WINDOW-SIZE. MOVE IMG00101-STARTING-VID TO W1-VID. MOVE ZERO TO W1-VIDS(1),W1-VIDS(2). MOVE SPACES TO W1-PLATE-NO. MOVE 0 TO W1-CAT, W1-SEQ. MOVE SPACES TO W1-GRP. EVALUATE IMG00101-INQ-FUNCTION WHEN 1 PERFORM 100-INQ-BY-PLATE WHEN 2 PERFORM 200-INQ-BY-CATEGORY END-EVALUATE. IF W1-VIDS(2) = 1 MOVE W1-VID TO SMG-VID ADD 1 TO SMG-VID SET SMG-DELETE-VID TO TRUE CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. IF W1-VIDS(1) = 1 MOVE W1-VID TO SMG-VID SET SMG-DELETE-VID TO TRUE CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. PERFORM 300-CLOSE-FILES. EXIT PROGRAM. 100-INQ-BY-PLATE. MOVE 16 TO W1-AT-POS. PERFORM UNTIL W1-AT-POS = 1 OR IMG00101-KEY-DATA(W1-AT-POS:1) = '@' SUBTRACT 1 FROM W1-AT-POS END-PERFORM. IF W1-AT-FOUND MOVE IMG00101-KEY-DATA(1:W1-AT-POS - 1) TO IM50-ALTERNATE-ID-03 ELSE MOVE IMG00101-KEY-DATA TO IM50-ALTERNATE-ID-03. START IM0050 KEY IS NOT < IM50-ALTERNATE-ID-03 INVALID KEY SET NO-RECORD TO TRUE. IF NOT NO-RECORD READ IM0050 NEXT RECORD AT END SET NO-RECORD TO TRUE END-READ. IF NOT NO-RECORD IF W1-AT-FOUND IF IM50-ALTERNATE-ID-03(1:W1-AT-POS - 1) = IMG00101-KEY-DATA(1:W1-AT-POS - 1) MOVE IM50-LOC-NO-01 TO W1-LOCATION PERFORM 1000-DISPLAY-ITEM-DATA ELSE PERFORM 400-KEY-NOT-FOUND ELSE IF IM50-ALTERNATE-ID-03 = IMG00101-KEY-DATA SET IMG00101-INQ-SUCCESS TO TRUE MOVE IM50-INVENTORY-MASTER-RECORD TO IMG00101-ITEM-RECORD ELSE PERFORM 400-KEY-NOT-FOUND. 200-INQ-BY-CATEGORY. MOVE IMG00101-KEY-DATA(1:12) TO W1-CAT-GRP-SEQ. INSPECT W1-CAT REPLACING ALL SPACES BY ZEROES INSPECT W1-SEQ REPLACING ALL SPACES BY ZEROES. MOVE W1-CAT TO IM50-CATEGORY. MOVE W1-GRP TO IM50-GROUP. MOVE W1-SEQ TO IM50-SEQUENCE. START IM0050 KEY IS NOT < IM50-PRIMARY-VENDOR-75 INVALID KEY SET NO-RECORD TO TRUE. IF NOT NO-RECORD READ IM0050 NEXT RECORD AT END SET NO-RECORD TO TRUE END-READ. IF NOT NO-RECORD AND W1-CAT NOT = IM50-CATEGORY SET NO-RECORD TO TRUE END-IF. IF NOT NO-RECORD MOVE IM50-LOC-NO-01 TO W1-LOCATION PERFORM 1000-DISPLAY-ITEM-DATA ELSE PERFORM 400-KEY-NOT-FOUND. 300-CLOSE-FILES. IF W1-INIT CLOSE IM0045 CLOSE IM0050. MOVE ZERO TO W1-INIT-SW. 400-KEY-NOT-FOUND. SET SMG-MESSAGE-LINE TO TRUE. SET SMG-CR-TO-RECOVER TO TRUE. MOVE 60 TO SMG-DATA-SIZE. MOVE 'Record not found in your branch inventory file' TO SMG-DATA. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE 1 TO IMG00101-RETURNS. 1000-DISPLAY-ITEM-DATA. SET VKBD-REVERSE TO TRUE. MOVE SPACE TO W1-NO-MORE-RECORD-SW. MOVE ZERO TO W1-MAX,W1-VID-SIZE MOVE W1-VID TO SMG-VID. MOVE 15 TO SMG-ROWS. MOVE 80 TO SMG-COLS. SET SMG-CREATE-VID TO TRUE. SET SMG-TOP TO TRUE. MOVE 25 TO SMG-DATA-SIZE. MOVE ' BRANCH INVENTORY SEARCH ' TO SMG-DATA. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE SPACE TO SMG-SIDES. SET SMG-PASTE-VID TO TRUE. MOVE 10 TO SMG-ROWS. MOVE 1 TO SMG-COLS. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE 1 TO W1-VIDS(1). SET SMG-PUT-CHARS TO TRUE. MOVE 3 TO SMG-ROWS. MOVE 8 TO SMG-COLS. MOVE 59 TO SMG-DATA-SIZE. IF W1-GRP = '\\\\' CALL 'SMGDSP' USING SMG-DATA-SIZE,LIT-5,SMG-BUFFER ELSE CALL 'SMGDSP' USING SMG-DATA-SIZE,LIT-3,SMG-BUFFER END-IF. MOVE 4 TO SMG-ROWS. MOVE 6 TO SMG-COLS. MOVE 74 TO SMG-DATA-SIZE. CALL 'SMGDSP' USING SMG-DATA-SIZE,LIT-4,SMG-BUFFER. MOVE W1-VID TO SMG-VID. ADD 1 TO SMG-VID. MOVE W1-WINDOW-SIZE TO SMG-ROWS. MOVE 85 TO SMG-COLS. SET SMG-CREATE-VID TO TRUE. MOVE SPACE TO SMG-SIDES. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE SPACE TO SMG-SIDES. MOVE 0180 TO SMG-COLS. MOVE 0110 TO SMG-ROWS. SET SMG-CREATE-VIEWPORT TO TRUE. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE 1 TO W1-VIDS(2). PERFORM 4100-READ-ITEM-RECORD MOVE W1-VID TO W1-WINDOW. ADD 1 TO W1-WINDOW. MOVE 10 TO W1-POINTER. PERFORM 1500-GET-INPUT TEST AFTER UNTIL ( W1-FIELD > 0 AND W1-FIELD NOT > W1-MAX AND VKBD-RETURN-NORMAL) OR VKBD-RETURN-PF4 OR VKBD-RETURN-TIME-OUT. IF VKBD-RETURN-PF4 OR VKBD-RETURN-TIME-OUT MOVE 2 TO IMG00101-RETURNS ELSE MOVE W1-FIELD TO SMG-ROWS SET SMG-READ-FROM-VID TO TRUE MOVE 85 TO SMG-DATA-SIZE MOVE W1-VID TO SMG-VID ADD 1 TO SMG-VID CALL 'SMGDSP' USING SMG-DATA-SIZE,W1-DETAIL,SMG-BUFFER INITIALIZE IMG00101-ITEM-RECORD MOVE W1-LOCATION TO IM50-LOC-NO-01 MOVE W1-DETAIL-ITEM TO IM50-ITEM-NO-02 READ IM0050 INVALID KEY SET IMG00101-INQ-EXIT TO TRUE NOT INVALID KEY MOVE IM50-INVENTORY-MASTER-RECORD TO IMG00101-ITEM-RECORD SET IMG00101-INQ-SUCCESS TO TRUE END-READ END-IF. 1500-GET-INPUT. SET VKBD-NUMERIC-FUNCTION-VAL TO TRUE. MOVE W1-VID TO VKBD-VID. MOVE 1 TO VKBD-ROW. MOVE 65 TO VKBD-COL. MOVE 4 TO VKBD-DATA-SIZE. MOVE 300 TO VKBD-TIME-OUT. CALL 'VKBD' USING VKBD-DATA-SIZE,W1-ALPHA-FIELD,VKBD-BUFFER. EVALUATE VKBD-RETURNS WHEN 2 PERFORM 2000-UP-ARROW WHEN 3 PERFORM 2100-DOWN-ARROW WHEN 4 PERFORM 2200-LEFT-ARROW WHEN 5 PERFORM 2300-RIGHT-ARROW END-EVALUATE. IF W1-FIELD > 0 AND W1-FIELD NOT > W1-MAX AND VKBD-RETURN-NORMAL MOVE W1-FIELD TO SMG-ROWS SET SMG-READ-FROM-VID TO TRUE MOVE 85 TO SMG-DATA-SIZE MOVE W1-VID TO SMG-VID ADD 1 TO SMG-VID CALL 'SMGDSP' USING SMG-DATA-SIZE,W1-DETAIL,SMG-BUFFER INITIALIZE IMG00101-ITEM-RECORD MOVE W1-LOCATION TO IM50-LOC-NO-01 MOVE W1-DETAIL-ITEM TO IM50-ITEM-NO-02 READ IM0050 INVALID KEY SET IMG00101-INQ-EXIT TO TRUE NOT INVALID KEY MOVE IM50-INVENTORY-MASTER-RECORD TO IMG00101-ITEM-RECORD SET IMG00101-INQ-SUCCESS TO TRUE END-READ ELSE NEXT SENTENCE. 2000-UP-ARROW. MOVE W1-WINDOW TO SMG-VID. SET SMG-SCROLL-VIEWPORT TO TRUE. SET SMG-SCROLL-DOWN TO TRUE. IF W1-FIELD > 0 AND W1-POINTER > 10 MOVE W1-FIELD TO W1-SCROLL-LINES COMPUTE W1-POINTER = W1-POINTER - W1-FIELD IF W1-POINTER < 10 ADD W1-FIELD TO W1-POINTER COMPUTE W1-SCROLL-LINES = W1-POINTER - 10 COMPUTE W1-POINTER = W1-POINTER - W1-SCROLL-LINES ELSE NEXT SENTENCE ELSE IF W1-POINTER > 10 SUBTRACT 1 FROM W1-POINTER MOVE 1 TO W1-SCROLL-LINES ELSE MOVE 0 TO W1-SCROLL-LINES. IF W1-SCROLL-LINES > 0 MOVE W1-SCROLL-LINES TO SMG-COLS CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. 2100-DOWN-ARROW. MOVE W1-WINDOW TO SMG-VID. SET SMG-SCROLL-VIEWPORT TO TRUE. SET SMG-SCROLL-UP TO TRUE. IF W1-FIELD > 0 MOVE W1-FIELD TO W1-SCROLL-LINES ADD W1-FIELD TO W1-POINTER ELSE ADD 1 TO W1-POINTER MOVE 1 TO W1-SCROLL-LINES. IF W1-POINTER NOT > W1-MAX MOVE W1-SCROLL-LINES TO SMG-COLS CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE IF NOT W1-NO-MORE-RECORD PERFORM 4700-EXPAND-VID UNTIL W1-NO-MORE-RECORD OR W1-POINTER NOT > W1-MAX IF W1-POINTER NOT > W1-MAX MOVE W1-WINDOW TO SMG-VID SET SMG-SCROLL-VIEWPORT TO TRUE SET SMG-SCROLL-UP TO TRUE MOVE W1-SCROLL-LINES TO SMG-COLS CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE SUBTRACT W1-SCROLL-LINES FROM W1-POINTER IF W1-POINTER < W1-MAX COMPUTE W1-SCROLL-LINES = W1-MAX - W1-POINTER SET SMG-SCROLL-VIEWPORT TO TRUE SET SMG-SCROLL-UP TO TRUE MOVE W1-SCROLL-LINES TO SMG-COLS ADD W1-SCROLL-LINES TO W1-POINTER CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE NEXT SENTENCE ELSE SUBTRACT W1-SCROLL-LINES FROM W1-POINTER IF W1-POINTER < W1-MAX COMPUTE W1-SCROLL-LINES = W1-MAX - W1-POINTER SET SMG-SCROLL-VIEWPORT TO TRUE SET SMG-SCROLL-UP TO TRUE MOVE W1-SCROLL-LINES TO SMG-COLS ADD W1-SCROLL-LINES TO W1-POINTER CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE NEXT SENTENCE. 2200-LEFT-ARROW. MOVE W1-WINDOW TO SMG-VID. SET SMG-SCROLL-VIEWPORT TO TRUE. SET SMG-SCROLL-DOWN TO TRUE. IF W1-FIELD > 0 AND W1-POINTER > 10 COMPUTE W1-SCROLL-LINES = W1-FIELD * 10 COMPUTE W1-POINTER = W1-POINTER - W1-SCROLL-LINES IF W1-POINTER < 10 ADD W1-SCROLL-LINES TO W1-POINTER COMPUTE W1-SCROLL-LINES = W1-POINTER - 10 COMPUTE W1-POINTER = W1-POINTER - W1-SCROLL-LINES ELSE NEXT SENTENCE ELSE IF W1-POINTER > 10 MOVE 10 TO W1-SCROLL-LINES SUBTRACT W1-SCROLL-LINES FROM W1-POINTER IF W1-POINTER < 10 ADD W1-SCROLL-LINES TO W1-POINTER COMPUTE W1-SCROLL-LINES = W1-POINTER - 10 SUBTRACT W1-SCROLL-LINES FROM W1-POINTER ELSE NEXT SENTENCE ELSE MOVE 0 TO W1-SCROLL-LINES. IF W1-SCROLL-LINES > 0 MOVE W1-SCROLL-LINES TO SMG-COLS CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. 2300-RIGHT-ARROW. MOVE W1-WINDOW TO SMG-VID. SET SMG-SCROLL-VIEWPORT TO TRUE. SET SMG-SCROLL-UP TO TRUE. IF W1-FIELD > 0 COMPUTE W1-SCROLL-LINES = W1-FIELD * 10 ADD W1-SCROLL-LINES TO W1-POINTER ELSE ADD 10 TO W1-POINTER MOVE 10 TO W1-SCROLL-LINES. IF W1-POINTER NOT > W1-MAX MOVE W1-SCROLL-LINES TO SMG-COLS CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE IF NOT W1-NO-MORE-RECORD PERFORM 4700-EXPAND-VID UNTIL W1-NO-MORE-RECORD OR W1-POINTER NOT > W1-MAX IF W1-POINTER NOT > W1-MAX MOVE W1-WINDOW TO SMG-VID SET SMG-SCROLL-VIEWPORT TO TRUE SET SMG-SCROLL-UP TO TRUE MOVE W1-SCROLL-LINES TO SMG-COLS CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE SUBTRACT W1-SCROLL-LINES FROM W1-POINTER IF W1-POINTER < W1-MAX COMPUTE W1-SCROLL-LINES = W1-MAX - W1-POINTER SET SMG-SCROLL-VIEWPORT TO TRUE SET SMG-SCROLL-UP TO TRUE MOVE W1-SCROLL-LINES TO SMG-COLS ADD W1-SCROLL-LINES TO W1-POINTER CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE NEXT SENTENCE ELSE SUBTRACT W1-SCROLL-LINES FROM W1-POINTER IF W1-POINTER < W1-MAX COMPUTE W1-SCROLL-LINES = W1-MAX - W1-POINTER SET SMG-SCROLL-VIEWPORT TO TRUE SET SMG-SCROLL-UP TO TRUE MOVE W1-SCROLL-LINES TO SMG-COLS ADD W1-SCROLL-LINES TO W1-POINTER CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE NEXT SENTENCE. 4100-READ-ITEM-RECORD. MOVE W1-VID TO SMG-VID. ADD 1 TO SMG-VID. MOVE 1 TO SMG-ROWS,SMG-COLS. SET SMG-PUT-CHARS TO TRUE. MOVE 85 TO SMG-DATA-SIZE. PERFORM 4200-READ-NEXT-SEQ-RECORDS. MOVE W1-VID TO SMG-VID. MOVE 1 TO SMG-ROWS,SMG-COLS. SET SMG-DISPLAY-CLEAR-LINE TO TRUE. MOVE 63 TO SMG-DATA-SIZE. MOVE LIT-1 TO SMG-DATA. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. ADD 1 TO SMG-VID. MOVE 14 TO SMG-ROWS. MOVE 1 TO SMG-COLS. SET SMG-PASTE-VID TO TRUE. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. 4200-READ-NEXT-SEQ-RECORDS. MOVE ZERO TO W1-SUB. SET SMG-PUT-CHARS TO TRUE. PERFORM 4400-SET-DETAIL-LINE UNTIL W1-SUB = W1-SEQ-LIMIT OR W1-NO-MORE-RECORD. 4400-SET-DETAIL-LINE. IF IMG00101-SQ-ITEM AND IM50-ITEM-NO-02(1:1) = '9' NEXT SENTENCE ELSE IF ( W1-AT-FOUND AND IMG00101-INQ-BY-PLATE AND IM50-ALTERNATE-ID-03(1:W1-AT-POS - 1) = IMG00101-KEY-DATA(1:W1-AT-POS - 1) ) OR ( NOT W1-AT-FOUND AND IMG00101-INQ-BY-PLATE AND IM50-ALTERNATE-ID-03 = IMG00101-KEY-DATA ) OR (IMG00101-INQ-BY-CAT AND IM50-CATEGORY = W1-CAT AND IM50-GROUP = W1-GRP ) ADD 1 TO W1-MAX,W1-SUB MOVE W1-MAX TO W1-DETAIL-NUM MOVE IM50-ITEM-NO-02 TO W1-DETAIL-ITEM, IM45-ITEM MOVE IM50-ALTERNATE-ID-03 TO W1-DETAIL-PLATE MOVE IM50-CATEGORY TO W1-DETAIL-CAT MOVE IM50-GROUP TO W1-DETAIL-GRP PERFORM TEST AFTER UNTIL NOT RECORD-LOCK READ IM0045 INVALID KEY MOVE '* No description * ' TO W1-DETAIL-DESC NOT INVALID KEY MOVE IM45-DESCRIPTION(1:34) TO W1-DETAIL-DESC END-READ END-PERFORM IF IM50-GROUP = '\\\\' MOVE IM50-XS-ITEM-DESC(1:34) TO W1-DETAIL-DESC MOVE IM50-XS-GROUP TO W1-DETAIL-GRP MOVE SPACES TO W1-DETAIL-PLATE MOVE IM50-ALTERNATE-ID-03(1:6) TO W1-DETAIL-PLATE MOVE IM50-ALTERNATE-ID-03(9:6) TO W1-DETAIL-PLATE(9:6) MOVE '' TO W1-DETAIL-PLATE(16:1) END-IF CALL 'SMGDSP' USING SMG-DATA-SIZE,W1-DETAIL,SMG-BUFFER ADD 1 TO SMG-ROWS END-IF. READ IM0050 NEXT RECORD AT END SET W1-NO-MORE-RECORD TO TRUE END-READ. IF IMG00101-INQ-BY-CAT AND IM50-CATEGORY > W1-CAT SET W1-NO-MORE-RECORD TO TRUE. IF W1-MAX NOT < 9999 SET W1-NO-MORE-RECORD TO TRUE. 4700-EXPAND-VID. MOVE W1-VID TO SMG-VID. MOVE 35 TO SMG-DATA-SIZE. MOVE 'Reading more records. Please wait..' TO SMG-DATA. MOVE 2 TO SMG-ROWS. MOVE 24 TO SMG-COLS. SET SMG-PUT-CHARS TO TRUE. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE W1-WINDOW TO SMG-VID. IF W1-MAX NOT < W1-VID-SIZE COMPUTE W1-WINDOW-SIZE = W1-WINDOW-SIZE 2 MOVE W1-WINDOW-SIZE TO SMG-ROWS MOVE 53 TO SMG-COLS MOVE W1-WINDOW TO SMG-VID SET SMG-CHANGE-VID TO TRUE CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ADD W1-WINDOW-SIZE TO W1-VID-SIZE ELSE NEXT SENTENCE. IF NOT SMG-RETURN-SUCCESS SET W1-NO-MORE-RECORD TO TRUE SET SMG-MESSAGE-LINE TO TRUE SET SMG-CR-TO-RECOVER TO TRUE MOVE 31 TO SMG-DATA-SIZE MOVE 'Virtual memory allocation error' TO SMG-DATA CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER ELSE MOVE W1-MAX TO SMG-ROWS ADD 1 TO SMG-ROWS SET SMG-PUT-CHARS TO TRUE MOVE 1 TO SMG-COLS MOVE 85 TO SMG-DATA-SIZE PERFORM 4200-READ-NEXT-SEQ-RECORDS. MOVE W1-VID TO SMG-VID. MOVE 2 TO SMG-ROWS. MOVE 1 TO SMG-COLS. SET SMG-ERASE-LINE TO TRUE. CALL 'SMGDSP' USING SMG-DATA-SIZE,SMG-DATA,SMG-BUFFER. MOVE W1-WINDOW TO SMG-VID. PROGRAM-ERROR-RTN SECTION.
3244.3	GTVMS, SMGDSP, VKBD	PACKED::BRAFFITT		`Wed May 28 1997 13:21`	8
	$ cobol c3244 $ link c3244 %LINK-W-NUDFSYMS, 3 undefined symbols: %LINK-I-UDFSYM, GTVMS %LINK-I-UDFSYM, SMGDSP %LINK-I-UDFSYM, VKBD We need the sources to these 3 routines called from the .COB in .2.
3244.4	Problem resolved but another one arises	SWAM1::COHEN_RO	Ron Cohen: DTN 531-3742	`Wed May 28 1997 13:39`	71
	The customer attempted to compile the program, using an out of date record layout for one of the files. This caused a 'COBOL-F-' compiler error. Note in the following listing that a second 'COBOL-F-' error was detected. Both VAX Cobol 4.4-64 and DEC Cobol 2.4-863 failed to detect the second 'COBOL-F' error when the first error was corrected. When I corrected the error (by changing 'NEXT SENTENCE' to 'CONTINUE') the problem with the program aborting (.0) resolved. 992 4400-SET-DETAIL-LINE. 993 994 IF IMG00101-SQ-ITEM AND IM50-ITEM-NO-02(1:1) = '9' 995 NEXT SENTENCE 996 ELSE 997 IF ( W1-AT-FOUND AND IMG00101-INQ-BY-PLATE AND 998 IM50-ALTERNATE-ID-03(1:W1-AT-POS - 1) = IMG00101-KEY-DATA(1:W1-AT-POS - 1) ) 999 1000 OR ( NOT W1-AT-FOUND AND IMG00101-INQ-BY-PLATE AND 1001 IM50-ALTERNATE-ID-03 = IMG00101-KEY-DATA ) 1002 1003 OR (IMG00101-INQ-BY-CAT AND 1004 IM50-CATEGORY = W1-CAT AND IM50-GROUP = W1-GRP ) 1005 1006 ADD 1 TO W1-MAX,W1-SUB 1007 MOVE W1-MAX TO W1-DETAIL-NUM 1008 MOVE IM50-ITEM-NO-02 TO W1-DETAIL-ITEM, IM45-ITEM 1009 MOVE IM50-ALTERNATE-ID-03 TO W1-DETAIL-PLATE 1010 MOVE IM50-CATEGORY TO W1-DETAIL-CAT 1011 MOVE IM50-GROUP TO W1-DETAIL-GRP 1012 1013 PERFORM TEST AFTER UNTIL NOT RECORD-LOCK 1014 READ IM0045 1015 INVALID KEY 1016 MOVE '* No description * ' TO W1-DETAIL-DESC 1017 NOT INVALID KEY 1018 MOVE IM45-DESCRIPTION(1:34) TO W1-DETAIL-DESC 1019 END-READ 1020 END-PERFORM 1021 1022 IF IM50-GROUP = '\\\\' 1023 MOVE IM50-XS-ITEM-DESC(1:34) TO W1-DETAIL-DESC 1024 MOVE IM50-XS-GROUP TO W1-DETAIL-GRP .....................1 %COBOL-F-UNDEFSYM, (1) Undefined name 1025 MOVE SPACES TO W1-DETAIL-PLATE ................1 %COBOL-W-RESTART, (1) Processing of source program resumes at this point 1026 MOVE IM50-ALTERNATE-ID-03(1:6) TO W1-DETAIL-PLATE 1027 MOVE IM50-ALTERNATE-ID-03(9:6) TO W1-DETAIL-PLATE(9:6) 1028 MOVE '*' TO W1-DETAIL-PLATE(16:1) 1029 END-IF 1030 1031 CALL 'SMGDSP' USING SMG-DATA-SIZE,W1-DETAIL,SMG-BUFFER 1032 ADD 1 TO SMG-ROWS 1033 END-IF. ........1 %COBOL-F-ILLENDIF, (1) END-IF may not be used if NEXT SENTENCE is used %COBOL-F-MISSING, (1) "." required at this point 1034 1035 READ IM0050 NEXT RECORD ....1 %COBOL-W-RESTART, (1) Processing of source program resumes at this point 1036 AT END SET W1-NO-MORE-RECORD TO TRUE 1037 END-READ. 1038
3244.5	Some info on the parser error recover to "next statement"	PACKED::BRAFFITT		`Wed May 28 1997 14:51`	13
	>The customer attempted to compile the program, using an out of >date record layout for one of the files. This caused a 'COBOL-F-' compiler >error. Note in the following listing that a second 'COBOL-F-' error was >detected. Both VAX Cobol 4.4-64 and DEC Cobol 2.4-863 failed to detect the >second 'COBOL-F' error when the first error was corrected. When the compiler detects an error, it attempts to resume parsing at what could be the next statement. However, the initial error may make it difficult for the compiler to determine the start of the next statement. This is why subsequent compilations done after some number of errors have been corrected may give the compiler the opportunity to detect errors in sections of code that were previously skipped during the error recovery from an earlier error in an earlier compilation.
3244.6	Claification of problem in .4	SWAM1::COHEN_RO	Ron Cohen: DTN 531-3742	`Wed May 28 1997 16:34`	20
	In the last few weeks we were compiling the program on the ALPHA without any compile errors. Yesterday, we went live using production branches in which the abort happened as mentioned in .0. There were no problems when running the same program on the VAX. The scenario in .4 happened when a dated copybook was pointed to in the program in the Alpha where an error occurred with an undefined variable. In addition to that error the compiler noted the other error "end-if may not be used if next sentence exists". By replacing NEXT SENTENCE with CONTINUE the program functioned on the ALPHA as it did on the VAX. This incorrect coding has been in this and other source programs on the ALPHA but the compiler by-passed it and we always got clean compiles (until today). The question is then....why does th compiler ignore this incorrect syntax and give clean compiles? I hope this clarifies the problem somewhat...... The proble
3244.7	I'm not sure, but I think this is the explanation	WIBBIN::NOYCE	Pulling weeds, pickin' stones	`Thu May 29 1997 08:41`	34
	Here's the structure of your program: IF ... NEXT SENTENCE ELSE IF ... ADD, MOVE, PERFORM/END-PERFORM... IF ... MOVE... END-IF CALL, ADD... END-IF .(period) The two inner IF's are ended with "END-IF", and the outer IF is ended with the period. The compiler complained about one of the MOVEs in the innermost IF. When it resumed processing, it seems to have assumed that the innermost IF was already closed. Thus, it thought the first END-IF closed the middle IF, and the last END-IF closed the first IF -- which would be an error. In other words, the complaint about NEXT SENTENCE isn't valid for your real program, but only for the program the compiler thought it saw: IF ... NEXT SENTENCE ELSE IF ... ADD, MOVE, PERFORM/END-PERFORM... IF ... MOVE... (error) END-IF CALL, ADD... END-IF .(period)
3244.8	Suggest get rid of NEXT SENTENCE in code	PACKED::MASLANKA		`Thu May 29 1997 11:09`	17
	Re .4 > 1033 END-IF. > ........1 >%COBOL-F-ILLENDIF, (1) END-IF may not be used if NEXT SENTENCE is used > >%COBOL-F-MISSING, (1) "." required at this point The period following this END-IF was discarded. That is why it was not taken into account. Inthis situation it appears that the compiler discarded the entire remainder of the line in its recovery process. However, the diagnostic message is clear. You cannot use END-IF when you use NEXT SENTENCE. This requirement is not from DEC COBOL, it's the ANSI standard. This code has to be upgraded. It should not be difficult to rewrite the logic so that it does not require NEXT SENTENCE.
3244.9	more clarification	WENDYL::BLATT		`Thu May 29 1997 13:39`	40
	> The question is then....why does th compiler ignore this incorrect > syntax and give clean compiles? I don't see anything that indicates a clean compile occurred with one of these NEXT SENTENCE constructs. Both VAX COBOL and DEC COBOL have been producing the %COBOL-F-ILLENDIF error for quite some time. I think perhaps there are more unknown pieces to the puzzle, but the coding change makes it a moot point now I guess. Keep in mind that the rationale behind the ILLENDIF error is because the addition of the END-IF construct to the language (ANSI-85), confuses the behavior oF NEXT SENTENCE. You should ensure that your coding change produces the desired behavior under various conditions. Consider this example: 1 IF ... 2 NEXT SENTENCE 3 ELSE 4 IF ... 5 ADD, MOVE, PERFORM/END-PERFORM... 6 END-IF 7 CALL... 8 . 9 PERFORM .... If line 2 is executed, should the next "sentence" be 4 or 9? Because delimited statements (4 thru 6) are a sentence, an argument could be made that line 4 is the NEXT SENTENCE. As this is not likely the intention of the programmer, ANSI-85 determined that NEXT SENTENCE and END-IFs cannot be used together. Pre-ANSI-85, a sentence would have been impossible to code inside an IF statement. NEXT SENTENCE is retained for compatibility with older programs, but is excluded from interacting with END-IF.