Normally, data items defined using the Based-Storage Section make use of pointers in order to be referenced. However, using the BASED ON clause to specify specific pointer data items enables data to be referenced without the pointer' qualification.
000010 @OPTIONS MAIN 000020*---------------------------------------------------------------------- 000030* The BASED ON clause enables referencing with an implicit pointer. 000040*---------------------------------------------------------------------- 000050 IDENTIFICATION DIVISION. 000060 PROGRAM-ID. SAMPLE. 000070 DATA DIVISION. 000080*---------------------------------------------------------------------- 000090* Specifying the BASED ON clause enables defined items to be referenced 000100* with implicit pointing. 000110*---------------------------------------------------------------------- 000120 BASED-STORAGE SECTION. 000130 01 BASED ON MENU-PTR. 000140 02 MENU OCCURS 3 TIMES. 000150 03 M-NAME PIC X(20). 000160 03 M-DETAIL PIC X(30). 000170*---------------------------------------------------------------------- 000180 WORKING-STORAGE SECTION. 000190 01 MENU-NO PIC 9(1). 000200 01 MENU-PTR POINTER. 000210 CONSTANT SECTION. 000220 01 SAMPLE-DATA. 000230 02 MENU-1. 000240 03 PIC X(20) VALUE "A-Lunch". 000250 03 PIC X(30) VALUE "Curry rice, Salad, Fruit". 000260 02 MENU-2. 000270 03 PIC X(20) VALUE "B-Lunch". 000280 03 PIC X(30) VALUE "Sandwich, Salad, Coffee". 000290 02 MENU-3. 000300 03 PIC X(20) VALUE "C-Lunch". 000310 03 PIC X(30) VALUE "Spaghetti, Salad, Ice Cream". 000320 PROCEDURE DIVISION. 000330 DISPLAY "*** Today's Lunch Menu ***". 000340 MOVE FUNCTION ADDR (SAMPLE-DATA) TO MENU-PTR. 000350 PERFORM TEST BEFORE 000360 VARYING MENU-NO FROM 1 BY 1 UNTIL MENU-NO > 3 000370*---------------------------------------------------------------------- 000380* Reference with implicit pointing is enabled. 000390* For the following, coding MENU-PTR->M-NAME is the same as MENU-NAME 000400* and MEMU-PTR->M-DETAIL is the same as M-DETAIL. 000410*---------------------------------------------------------------------- 000420 DISPLAY " " 000430 DISPLAY "Name : " M-NAME(MENU-NO) 000440 DISPLAY "Details: " M-DETAIL(MENU-NO) 000450*---------------------------------------------------------------------- 000460 END-PERFORM. 000470 EXIT PROGRAM. 000480 END PROGRAM SAMPLE.
